Functional Programming

継承 (2)

今回は継承の簡単な例題として、前々回作成した双方向リスト <dlist> を継承して、格納する要素数を制限する双方向リスト <fixed-dlist> というクラスを作ってみましょう。そのあとで基本的なデータ構造である「スタック (stack) 」、「キュー (queue) 」、「ディーキュー (deque) 」を作成します。

●制限付き双方向リスト

制限付き双方向リストクラス <fixed-dist> は指定した上限値までしか要素を格納できません。<dlist> で要素を追加するメソッドは dlist-insert! で、削除するメソッドは dlist-delete! です。この 2 つのメソッドをオーバーライドすることで、<fixed-dlist> の機能を実現することができます。リスト 1 を見てください。

リスト 1 : 制限付き双方向リスト

; クラス定義
(define-class <fixed-dlist> (<dlist>)
  ((limit :accessor dlist-limit :init-value 8 :init-keyword :limit)
   (size  :accessor dlist-size  :init-value 0 :init-keyword :size)))

; 挿入
(define-method dlist-insert! ((d <fixed-dlist>) (n <integer>) value)
  (if (< (dlist-size d) (dlist-limit d))
      (begin0 (next-method) (inc! (dlist-size d)))
    (error "<fixed-dlist> : size over")))

; 削除
(define-method dlist-delete! ((d <fixed-dlist>) (n <integer>))
  (begin0 (next-method) (dec! (dlist-size d))))

クラス <fixed-dlist> は <dlist> を継承するので、クラス名の後のカッコで <dlist> を指定します。スロット limit は要素数の上限値を表し、スロット size は双方向リストに格納されている要素数を表します。なお、make で <fixed-dlist> のインスタンスを生成するとき、スーパークラス <dlist> のスロットもきちんと初期化されます。

dlist-insert! は limit と size を比較して、size が limit よりも小さい場合はデータを挿入します。next-method でスーパークラスの dlist-insert! を呼び出して、size の値を +1 します。dlist-delete! の場合、スーパークラスの dlist-delete! を呼び出してから size の値を -1 します。

inc! と dec! は値を +1, -1 するマクロで、set! と同様に汎変数を使うことができます。

inc! (アクセス関数 引数 ...) [value]
dec! (アクセス関数 引数 ...) [value]

inc! と dec! は value を指定すると値を +value, -value します。value を省略すると値を +1, -1 します。value は評価されることに注意してください。簡単な例を示しましょう。

gosh> (define a '(1 2 3 4 5))
a
gosh> (inc! (car a))
#<undef>
gosh> a
(2 2 3 4 5)
gosh> (inc! (cadr a) (+ 1 2 3))
#<undef>
gosh> a
(2 8 3 4 5)

このほかに、dlist-length と dlist-clear をオーバーライドし、dlist-full? と list->fixed-dlist を新しく作ります。

リスト 2 : 制限付き双方向リスト (2)

; サイズ
(define-method dlist-length ((d <fixed-dlist>))
  (dlist-size d))

; クリア
(define-method dlist-clear ((d <fixed-dlist>))
  (next-method)
  (set! (dlist-size d) 0))

; 満杯か？
(define-method dlist-full? ((d <fixed-dlist>))
  (= (dlist-size d) (dlist-limit d)))

; 変換
(define-method list->fixed-dlist ((xs <list>))
  (let ((d (make <fixed-dlist> :limit (length xs))))
    (for-each
      (lambda (x) (dlist-insert! d -1 x))
      xs)
    d))

要素の個数を求める dlist-length はスロット size の値を返すだけです。dlist-clear は <dlist> のメソッドを呼び出してから、size の値を 0 にします。dlist-full? は双方向リストが満杯ならば #t を返します。list->fixed-dlist はリスト xs を制限付き双方向リストに変換します。

簡単な実行例を示しましょう。

gosh> (define a (make <fixed-dlist> :limit 5))
a
gosh> a
#<<fixed-dlist> 0pbe1278>
gosh> (dlist-empty? a)
#t
gosh> (dotimes (x 5) (dlist-insert! a -1 x))
#t
gosh> (dlist-empty? a)
#f
gosh> (dlist-full? a)
#t
gosh> (dlist-insert! a -1 10)
*** ERROR: <fixed-dlist> : size over

gosh> (dlist->list a)
(0 1 2 3 4)
gosh> (dotimes (x 5) (format #t "~D " (dlist-delete! a 0)))
0 1 2 3 4 #t
gosh> (dlist-empty? a)
#t
gosh> (dlist-full? a)
#f

このように <dlist> を継承することで、<fixed-dlist> を簡単にプログラムすることができます。

●継承は is-a 関係を表す

今まで説明したように、オブジェクトは関数とデータをひとつにまとめたものです。オブジェクト指向プログラミングはこのオブジェクトを部品として扱います。実際には、クラス単位でプログラムを作るので、クラス間の関係がとても重要になります。ここで、クラス間の関係 is-a と has-a を簡単に説明します。

is-a 関係は X is a Y. の略で、「X は Y の一種である」という意味になります。X がサブクラスで Y をスーパークラスと考えると、is-a 関係は継承で表すことができます。たとえば、<fixed-dlist> は格納する要素数に制限がありますが双方向リストの一種であることは明らかです。<fixed-dlist> クラスは <dlist> クラスを継承することで簡単に実装できましたが、それは双方向リストとの間に is-a 関係があるからです。

has-a 関係は X has a Y. の略で、「X は Y を持っている」という意味です。たとえば、車にはエンジンやタイヤがありますが、車とエンジンやタイヤに成り立つ関係が has-a です。車はエンジンやタイヤがないと走ることができません。このように、has-a 関係は「X が成立するのに欠かせない要素が Y である」という関係を表しています。

has-a 関係のほかに、is-implemented-using という関係があります。これは X is implemented using Y. の略で、「X は Y を使って実装される」という意味です。たとえばスタックの場合、配列でもリストでも実装することが可能です。つまり、Y の種類によらず X を実現できる関係が is-implemented-using 関係なのです。

一般に、has-a 関係や is-implemented-using 関係は、クラス X のスロット (インスタンス変数) にクラス Y のインスタンス（オブジェクト）を格納することで表します。これを「X は Y を包含している」といいます。そして、これらの関係を表すのに継承を使ってはいけない、ということに注意してください。

たとえば、双方向リストを継承してスタックを作ることを考えてみましょう。PUSH は双方向リストの先頭にデータを追加することで、POP は双方向リストの先頭からデータを取り出すことで簡単に実現できます。しかし、双方向リストを継承すると、ほかの操作も可能になります。スタックの途中にデータを追加したり、途中からデータを取り出すなど、スタックを破壊する危険な操作が可能になってしまいます。

また、クラスの関係を考えた場合、スタックと双方向リストには is-a 関係は成り立ちません。ところが、継承を使うとデータ型も引き継がれるため、プログラムの上でもスタックは双方向リストの一種になってしまいます。継承は強力な機能ですが万能ではありません。クラス間の関係を考えて、適切に使うことが大切です。

●スタックの実装

それでは、実際に双方向リストを使ってスタックを実装してみましょう。クラス名は <stack> とし、表 1 に示すメソッドを定義します。プログラムはリスト 3 のようになります。

リスト 3 : スタック

; クラス定義
(define-class <stack> ()
  ((top :accessor stack-top :init-form (make <dlist>) :init-keyword :top)))

; 追加
(define-method stack-push! ((s <stack>) x)
  (dlist-insert! (stack-top s) 0 x))

; 取り出し
(define-method stack-pop! ((s <stack>))
  (dlist-delete! (stack-top s) 0))

; 空か？
(define-method stack-empty? ((s <stack>))
  (dlist-empty? (stack-top s)))

; サイズ
(define-method stack-length ((s <stack>))
  (dlist-length (stack-top s)))

<stack> のスロット top に <dlist> のインスタンスをセットします。<stack> の操作は、このインスタンスに <dlist> のメソッドを適用することで実現します。

メソッド stack-push! はスタックにデータ x を追加します。これは双方向リストの先頭に x を追加すればいいので、(dlist-insert! (stack-top s) 0 x) を呼び出すだけです。メソッド stack-pop! は双方向リストの先頭の要素を削除してそれを返せばよいので、(dlist-delete! (stack-top s) 0) を呼び出すだけです。メソッド stack-empty? と stack-length は dlist-empty? と dlist-length を呼び出すだけです。

それでは実行してみましょう。

gosh> (define a (make <stack>))
a
gosh> a
#<<stack> 0pbea098>
gosh> (dotimes (x 5) (stack-push! a x))
#t
gosh> (stack-length a)
5
gosh> (stack-empty? a)
#f
gosh> (dotimes (x 5) (format #t "~D " (stack-pop! a)))
4 3 2 1 0 #t
gosh> (stack-length a)
0
gosh> (stack-empty? a)
#t

スタックに 0 から 4 まで stack-push! で格納し stack-pop! でデータを取り出すと 4, 3, 2, 1, 0 になります。このように、スタックは後から入れたデータが先に取り出されます。

●キューの実装

次は、双方向リスト <dlist> を使ってキューを作ってみましょう。定義するメソッドを表 2 に、プログラムをリスト 4 に示します。

リスト 4 : キュー

(define-class <queue> ()
  ((top :accessor queue-top :init-form (make <dlist>) :init-keyword :top)))

; 追加
(define-method enqueue! ((q <queue>) x)
  (dlist-insert! (queue-top q) -1 x))

; 取り出し
(define-method dequeue! ((q <queue>))
  (dlist-delete! (queue-top q) 0))

; 空か？
(define-method queue-empty? ((q <queue>))
  (dlist-empty? (queue-top q)))

; サイズ
(define-method queue-length ((q <queue>))
  (dlist-length (queue-top q)))

<queue> のスロット top に <dlist> のインスタンスをセットします。<queue> の操作は、このインスタンスに <dlist> のメソッドを適用することで実現します。

メソッド enqueue! はキューにデータ x を追加します。これは双方向リストの最後尾に x を追加すればいいので、(dlist-insert! (queue-top s) -1 x) を呼び出すだけです。メソッド dequeue! は双方向リストの先頭の要素を削除してそれを返せばよいので、(dlist-delete! (queue-top s) 0) を呼び出すだけです。メソッド queue-empty? と queue-length は dlist-empty? と dlist-length を呼び出すだけです。

簡単な実行例を示します。

gosh> (define a (make <queue>))
a
gosh> a
#<<queue> 0pbf6f98>
gosh> (dotimes (x 5) (enqueue! a x))
#t
gosh> (queue-empty? a)
#f
gosh> (queue-length a)
5
gosh> (dotimes (x 5) (format #t "~D " (dequeue! a)))
0 1 2 3 4 #t
gosh> (queue-empty? a)
#t
gosh> (queue-length a)
0

キューに 0 から 4 まで enqueue! で格納して、dequeue! でデータを取り出すと 0, 1, 2, 3, 4 になります。スタックとは逆に、キューはデータを入れた順番にデータが取り出されます。

●ディーキューの実装

最後に、「ディーキュー : deque (double ended queue) 」というデータ構造を双方向リストを使って実装しましょう。ディーキューは「両端キュー」のことで、「デック」と呼ばれることもあります。キューの場合、データの追加は最後尾に、データの取り出しは先頭に対してのみ行えます。これに対しディーキューは、先頭および最後尾のどちらでもデータの追加と取り出しが行えるデータ構造です。ディーキューは双方向リストを使うと簡単に実現できます。

最初に作成するメソッドを表 3 に示します。データを追加するメソッドには push を、取り出すメソッドには pop を付けました。

プログラムはリスト 5 のようになります。

リスト 5 : ディーキュー

; クラス定義
(define-class <deque> ()
  ((top :accessor deque-top :init-form (make <dlist>) :init-keyword :top)))

; 追加
(define-method push-front! ((d <deque>) x)
  (dlist-insert! (deque-top d) 0 x))

(define-method push-back! ((d <deque>) x)
  (dlist-insert! (deque-top d) -1 x))

; 取り出し
(define-method pop-front! ((d <deque>))
  (dlist-delete! (deque-top d) 0))

(define-method pop-back! ((d <deque>))
  (dlist-delete! (deque-top d) -1))

; 参照
(define-method peek-front ((d <deque>))
  (dlist-ref (deque-top d) 0))

(define-method peek-back ((d <deque>))
  (dlist-ref (deque-top d) -1))

; 空か
(define-method deque-empty? ((d <deque>))
  (dlist-empty? (deque-top d)))

; サイズ
(define-method deque-length ((d <deque>))
  (dlist-length (deque-top d)))

スタックとキューのプログラムとあまり変わりがないので、詳しい説明は不要でしょう。

簡単な実行例を示します。

gosh> (define a (make <deque>))
a
gosh> a
#<<deque> 0pbf8a40>
gosh> (dotimes (x 5) (push-back! a x))
#t
gosh> (peek-front a)
0
gosh> (peek-back a)
4
gosh> (pop-front! a)
0
gosh> (peek-front a)
1
gosh> (pop-back! a)
4
gosh> (peek-back a)
3
gosh> (deque-length a)
3
gosh> (dotimes (x 3) (format #t "~D " (pop-front! a)))
1 2 3 #t
gosh> (deque-empty? a)
#t

●プログラムリスト

;
; dlist.scm : 双方向リスト
;
;             Copyright (C) 2010 Makoto Hiroi
;

; セルの定義
(define-class <cell> ()
  ((item :accessor cell-item :init-value #f :init-keyword :item)
   (prev :accessor cell-prev :init-value #f :init-keyword :prev)
   (next :accessor cell-next :init-value #f :init-keyword :next)))

; 空リストを作る
(define (make-empty)
  (let ((cp (make <cell>)))
    (set! (cell-prev cp) cp)
    (set! (cell-next cp) cp)
    cp))

; 双方向リストの定義
(define-class <dlist> ()
  ((top :accessor dlist-top :init-form (make-empty))))

; n 番目のセルを返す (作業用関数)
(define (cell-nth d n next)
  (let loop ((i -1) (cp (dlist-top d)))
    (cond ((and (<= 0 i) (eq? (dlist-top d) cp))
           (error "cell-nth --- oops!"))
          ((= n i) cp)
          (else
           (loop (+ i 1) (next cp))))))

; 参照
(define-method dlist-ref ((d <dlist>) (n <integer>))
  (cell-item
    (if (negative? n)
        (cell-nth d (abs (+ n 1)) cell-prev)       
      (cell-nth d n cell-next))))

; 書き換え
(define-method dlist-set! ((d <dlist>) (n <integer>) value)
  (set! (cell-item (if (negative? n)
                       (cell-nth d (abs (+ n 1)) cell-prev)
                     (cell-nth d n cell-next)))
        value))

; 挿入
(define-method dlist-insert! ((d <dlist>) (n <integer>) value)
  (define (cell-insert! n next prev)
    (let* ((p (cell-nth d (- n 1) next))
           (q (next p))
           (cp (make <cell> :item value)))
    (set! (next cp) q)
    (set! (prev cp) p)
    (set! (prev q) cp)
    (set! (next p) cp)))
  ;
  (if (negative? n)
      (cell-insert! (abs (+ n 1)) cell-prev cell-next)
    (cell-insert! n cell-next cell-prev)))

; 削除
(define-method dlist-delete! ((d <dlist>) (n <integer>))
  (define (cell-delete! n next prev)
    (let* ((cp (cell-nth d n next))
           (p (prev cp))
           (q (next cp)))
      (set! (next p) q)
      (set! (prev q) p)
      (cell-item cp)))
  ;
  (if (negative? n)
      (cell-delete! (abs (+ n 1)) cell-prev cell-next)
    (cell-delete! n cell-next cell-prev)))

; 畳み込み
(define-method dlist-fold ((d <dlist>) func init . args)
  (let ((next (if (get-keyword :from-end args #f) cell-prev cell-next)))
    (let loop ((cp (next (dlist-top d))) (a init))
      (if (eq? cp (dlist-top d))
          a
        (loop (next cp)
              (if (eq? next cell-prev)
                  (func (cell-item cp) a)
                (func a (cell-item cp))))))))

; サイズ
(define-method dlist-length ((d <dlist>))
  (dlist-fold d (lambda (x y) (+ x 1)) 0))

; クリア
(define-method dlist-clear ((d <dlist>))
  (let ((cp (dlist-top d)))
    (set! (cell-next cp) cp)
    (set! (cell-prev cp) cp)))

; 空リストか？
(define-method dlist-empty? ((d <dlist>))
  (let ((cp (dlist-top d)))
    (eq? cp (cell-next cp))))

; 変換
(define-method list->dlist ((xs <list>))
  (let ((d (make <dlist>)))
    (for-each
      (lambda (x) (dlist-insert! d -1 x))
      xs)
    d))

;
(define-method dlist->list ((d <dlist>))
  (dlist-fold d
              (lambda (x y) (cons x y))
              '()
              :from-end #t))


; 巡回
(define-method dlist-for-each ((d <dlist>) func . args)
  (if (get-keyword :from-end args #f)
      (dlist-fold d (lambda (x y) (func x)) #f :from-end #t)
    (dlist-fold d (lambda (x y) (func y)) #f)))


;;; 制限付き双方向リスト

(define-class <fixed-dlist> (<dlist>)
  ((limit :accessor dlist-limit :init-value 8 :init-keyword :limit)
   (size  :accessor dlist-size  :init-value 0 :init-keyword :size)))

; 挿入
(define-method dlist-insert! ((d <fixed-dlist>) (n <integer>) value)
  (if (< (dlist-size d) (dlist-limit d))
      (begin0 (next-method)
              (set! (dlist-size d) (+ (dlist-size d) 1)))
    (error "<fixed-dlist> : size over")))

; 削除
(define-method dlist-delete! ((d <fixed-dlist>) (n <integer>))
  (begin0 (next-method)
          (set! (dlist-size d) (- (dlist-size d) 1))))

; サイズ
(define-method dlist-length ((d <fixed-dlist>))
  (dlist-size d))

; クリア
(define-method dlist-clear ((d <fixed-dlist>))
  (next-method)
  (set! (dlist-size d) 0))

; 変換
(define-method list->fixed-dlist ((xs <list>))
  (let ((d (make <fixed-dlist> :limit (length xs))))
    (for-each
      (lambda (x) (dlist-insert! d -1 x))
      xs)
    d))

; 満杯か？
(define-method dlist-full? ((d <fixed-dlist>))
  (= (dlist-size d) (dlist-limit d)))


;;; スタック

(define-class <stack> ()
  ((top :accessor stack-top :init-form (make <dlist>) :init-keyword :top)))

; 追加
(define-method stack-push! ((s <stack>) x)
  (dlist-insert! (stack-top s) 0 x))

; 取り出し
(define-method stack-pop! ((s <stack>))
  (dlist-delete! (stack-top s) 0))

; 空か？
(define-method stack-empty? ((s <stack>))
  (dlist-empty? (stack-top s)))

; サイズ
(define-method stack-length ((s <stack>))
  (dlist-length (stack-top s)))


;;; キュー

(define-class <queue> ()
  ((top :accessor queue-top :init-form (make <dlist>) :init-keyword :top)))

; 追加
(define-method enqueue! ((q <queue>) x)
  (dlist-insert! (queue-top q) -1 x))

; 取り出し
(define-method dequeue! ((q <queue>))
  (dlist-delete! (queue-top q) 0))

; 空か？
(define-method queue-empty? ((q <queue>))
  (dlist-empty? (queue-top q)))

; サイズ
(define-method queue-length ((q <queue>))
  (dlist-length (queue-top q)))


;;; ディーキュー

(define-class <deque> ()
  ((top :accessor deque-top :init-form (make <dlist>) :init-keyword :top)))

; 追加
(define-method push-front! ((d <deque>) x)
  (dlist-insert! (deque-top d) 0 x))

(define-method push-back! ((d <deque>) x)
  (dlist-insert! (deque-top d) -1 x))

; 取り出し
(define-method pop-front! ((d <deque>))
  (dlist-delete! (deque-top d) 0))

(define-method pop-back! ((d <deque>))
  (dlist-delete! (deque-top d) -1))

; 参照
(define-method peek-front ((d <deque>))
  (dlist-ref (deque-top d) 0))

(define-method peek-back ((d <deque>))
  (dlist-ref (deque-top d) -1))

; 空か？
(define-method deque-empty? ((d <deque>))
  (dlist-empty? (deque-top d)))

; サイズ
(define-method deque-length ((d <deque>))
  (dlist-length (deque-top d)))