Common Lisp Programming

継承 (2)

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

●制限付き双方向リスト

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

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

;;; 制限付き双方向リスト
(defclass fixed-dlist (dlist)
  ((limit :accessor dlist-limit :initform 8 :initarg :limit)
   (size  :accessor dlist-size  :initform 0 :initarg :size)))

;;; データの挿入
(defmethod dlist-insert ((d fixed-dlist) (n integer) value &key (from-end nil))
  (cond ((not (dlist-fullp d))
         (prog1 
             (call-next-method d n value from-end)
           (incf (dlist-size d))))
        (t (error "fixed-dlist: size over~%"))))

;;; データの削除
(defmethod dlist-delete ((d fixed-dlist) (n integer) &key (from-end nil))
  (prog1 
      (call-next-method d n value from-end)
    (decf (dlist-size d))))

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

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

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

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

;;; 双方向リストの要素数を求める
(defmethod dlist-length ((d fixed-dlist))
  (dlist-size d))

;;; 双方向リストを空にする
(defmethod dlist-clear ((d fixed-dlist))
  (call-next-method)
  (setf (dlist-size d) 0))

;;; 満杯か？
(defmethod dlist-fullp ((d dlist)) nil)

(defmethod dlist-fullp ((d fixed-dlist))
  (= (dlist-limit d) (dlist-size d)))

;;; リストを制限付き双方向リストに変換
(defmethod list-to-fixed-dlist ((xs list))
  (let ((d (make-instance 'fixed-dlist :limit (length xs))))
    (dolist (x xs d) (dlist-insert d 0 x :from-end t))))

;;; 表示
(defmethod print-object ((x fixed-dlist) stream)
  (format stream "#<fixed-dlist: ~D ~S>" (dlist-size x) (dlist-to-list x)))

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

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

* (require :dlist "dlist.lisp")

("DLIST")
* (use-package :dlist)

T
* (setq a (make-instance 'fixed-dlist))

#<fixed-dlist: 0 NIL>
* (dlist-emptyp a)

T
* (dlist-fullp a)

NIL
* (dotimes (x 8) (dlist-insert a 0 x :from-end t))

NIL
* a

#<fixed-dlist: 8 (0 1 2 3 4 5 6 7)>
* (dlist-emptyp a)

NIL
* (dlist-fullp a)

T
* (dlist-insert a 0 10 :from-end t)

=> エラー "fixed-dlist: size over"
* (dotimes (x 8) (format t "~D " (dlist-delete a 0)))
0 1 2 3 4 5 6 7
NIL
* (dlist-emptyp a)

T
* (dlist-fullp a)

NIL

このように 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 とし、下表に示すメソッドを定義します。

プログラムは次のようになります。

リスト : スタック

;;; クラス定義
(defclass stack ()
  ((top :accessor stack-top :initform (make-instance 'dlist))))

;;; データの追加
(defmethod stack-push ((s stack) value)
  (dlist-insert (stack-top s) 0 value))

;;; データの取り出し
(defmethod stack-pop ((s stack))
  (dlist-delete (stack-top s) 0))

;;; 先頭データの参照
(defmethod stack-peek ((s stack))
  (dlist-ref (stack-top s) 0))

;;; 要素数を求める
(defmethod stack-length ((s stack)) (dlist-length (stack-top s)))

;;; スタックを空にする
(defmethod stack-clear ((s stack)) (dlist-clear (stack-top s)))

;;; スタックは空か？
(defmethod stack-emptyp ((s stack)) (dlist-emptyp (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-peek は双方向リストの先頭データを返せばいいので、(dlist-ref (stack-top s) 0) を呼び出すだけです。あとのメソッドも DLIST の適切なメソッドを呼び出すだけです。

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

* (setq a (make-instance 'stack))

#<STACK {1002C725A3}>
* (stack-emptyp a)

T
* (dotimes (x 8) (stack-push a x))

NIL
* (stack-emptyp a)

NIL
* (stack-length a)

8
* (stack-peek a)

7
* (dotimes (x 8) (format t "~D " (stack-pop a)))
7 6 5 4 3 2 1 0
NIL
* (stack-emptyp a)

T
* (stack-length a)

0

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

●キューの実装

次は、双方向リスト DLIST を使ってキューを作ってみましょう。定義するメソッドを上表に示します。プログラムは次のようになります。

リスト : キュー

;;; クラス定義
(defclass queue ()
  ((top :accessor queue-top :initform (make-instance 'dlist))))

;;; データの追加
(defmethod enqueue ((q queue) value)
  (dlist-insert (queue-top q) 0 value :from-end t))

;;; データの取り出し
(defmethod dequeue ((q queue))
  (dlist-delete (queue-top q) 0))

;;; 先頭データを求める
(defmethod queue-peek ((q queue))
  (dlist-ref (queue-top q) 0))

;;; 要素数を求める
(defmethod queue-length ((q queue)) (dlist-length (queue-top q)))

;;; キューを空にする
(defmethod queue-clear ((q queue)) (dlist-clear (queue-top q)))

;;; キューは空か？
(defmethod queue-emptyp ((q queue)) (dlist-emptyp (queue-top q)))

QUEUE のスロット TOP に DLIST のインスタンスをセットします。QUEUE の操作は、このインスタンスに DLIST のメソッドを適用することで実現します。

メソッド enqueue はキューにデータ X を追加します。これは双方向リストの最後尾に X を追加すればいいので、(dlist-insert (queue-top q) 0 x :from-end) を呼び出すだけです。

メソッド dequeue は双方向リストの先頭の要素を削除してそれを返せばよいので、(dlist-delete (queue-top q) 0) を呼び出すだけです。メソッド queue-peek は先頭データを返せばいいので、(dlist-ref (queue-top q) 0) を呼び出すだけです。あとのメソッドも DLIST の適切なメソッドを呼び出すだけです。

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

* (setq a (make-instance 'queue))

#<QUEUE {1002E0E493}>
* (queue-emptyp a)

T
* (dotimes (x 8) (enqueue a x))

NIL
* (queue-emptyp a)

NIL
* (queue-length a)

8
*  (dotimes (x 8) (format t "~D " (dequeue a)))
0 1 2 3 4 5 6 7
NIL
* (queue-emptyp a)

T
* (queue-length a)

0

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

●ディーキューの実装

最後に、「ディーキュー : deque (double ended queue)」というデータ構造を双方向リストを使って実装しましょう。ディーキューは「両端キュー」のことで、「デック」と呼ばれることもあります。

キューの場合、データの追加は最後尾に、データの取り出しは先頭に対してのみ行えます。これに対しディーキューは、先頭および最後尾のどちらでもデータの追加と取り出しが行えるデータ構造です。ディーキューは双方向リストを使うと簡単に実現できます。

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

プログラムは次のようになります。

リスト : ディーキュー

;;; クラス定義
(defclass deque ()
  ((top :accessor deque-top :initform (make-instance 'dlist))))

;;; データの追加
(defmethod push-front ((d deque) value)
  (dlist-insert (deque-top d) 0 value))

(defmethod push-back ((d deque) value)
  (dlist-insert (deque-top d) 0 value :from-end t))

;;; データの取り出し
(defmethod pop-front ((d deque))
  (dlist-delete (deque-top d) 0))

(defmethod pop-back ((d deque))
  (dlist-delete (deque-top d) 0 :from-end t))

;;; データの参照
(defmethod peek-front ((d deque))
  (dlist-ref (deque-top d) 0))

(defmethod peek-back ((d deque))
  (dlist-ref (deque-top d) 0 :from-end t))

;;; 要素数を求める
(defmethod deque-length ((q deque)) (dlist-length (deque-top q)))

;;; ディーキューを空にする
(defmethod deque-clear ((q deque)) (dlist-clear (deque-top q)))

;;; ディーキューは空か？
(defmethod deque-emptyp ((q deque)) (dlist-emptyp (deque-top q)))

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

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

* (setq a (make-instance 'deque))

#<DEQUE {100306A7E3}>
* (dotimes (x 5) (push-front a x))

NIL
* (peek-front a)

4
* (peek-back a)

0
* (pop-front a)

4
* (pop-back a)

0
* (deque-length a)

3
* (dotimes (x 3) (format t "~D " (pop-front a)))
3 2 1
NIL
* (deque-emptyp a)

T
* (deque-length a)

0

●プログラムリスト１

;;;
;;; dlist.lisp : 双方向リスト
;;;
;;;              Copyright (C) 2010-2020 Makoto Hiroi
;;;
(provide :dlist)
(defpackage :dlist (:use :cl))
(in-package :dlist)
(export '(dlist dlist-ref dlist-set dlist-insert dlist-delete
          dlist-fold dlist-length dlist-clear dlist-emptyp list-to-dlist
          dlist-to-list dlist-for-each dlist-iterator print-object
          fixed-dlist dlist-fullp list-to-fixed-dlist))

;;; メソッドの宣言
(defgeneric dlist-ref (d n &key from-end))
(defgeneric dlist-set (d n value &key from-end))
(defgeneric dlist-insert (d n value &key from-end))
(defgeneric dlist-delete (d n &key from-end))
(defgeneric dlist-fold (d func init &key from-end))
(defgeneric dlist-length (d))
(defgeneric dlist-clear (d))
(defgeneric dlist-emptyp (d))
(defgeneric dlist-fullp (d))
(defgeneric list-to-dlist (ls))
(defgeneric list-to-fixed-dlist (ls))
(defgeneric dlist-to-list (d))
(defgeneric dlist-for-each (d func &key from-end))
(defgeneric dlist-iterator (d &key from-end))

;;; セルの定義
(defclass cell ()
  ((item :accessor cell-item :initform nil :initarg :item)
   (next :accessor cell-next :initform nil :initarg :next)
   (prev :accessor cell-prev :initform nil :initarg :prev)))

;;; 空リストの生成
(defun make-empty ()
  (let ((cp (make-instance 'cell)))
    (setf (cell-next cp) cp
          (cell-prev cp) cp)
    cp))

;;; 双方向リストクラスの定義
(defclass dlist ()
  ((top :accessor dlist-top :initform (make-empty))))

;;; n 番目のセルを求める (操作用関数)
(defun cell-nth (d n iter)
  (do ((i -1 (1+ i))
       (cp (dlist-top d) (funcall iter cp)))
      ((= i n) cp)
    (if (and (<= 0 i) (eq (dlist-top d) cp))
         (error "cell-nth --- oops!"))))

;;; 参照
(defmethod dlist-ref ((d dlist) (n integer) &key (from-end nil))
  (cell-item (cell-nth d n (if from-end #'cell-prev #'cell-next))))

;;; 書き換え
(defmethod dlist-set ((d dlist) (n integer) value &key (from-end nil))
  (setf (cell-item (cell-nth d n (if from-end #'cell-prev #'cell-next)))
        value))

;;; セルの挿入
;;; p - next -> cp - next -> q
(defun cell-insert (p cp q)
  (setf (cell-next cp) q
        (cell-prev cp) p
        (cell-prev q) cp
        (cell-next p) cp))

;;; 挿入
(defmethod dlist-insert ((d dlist) (n integer) value &key (from-end nil))
  (let* ((iter (if from-end #'cell-prev #'cell-next))
         (p (cell-nth d (1- n) iter))
         (q (funcall iter p))
         (cp (make-instance 'cell :item value)))
    (if from-end
        (cell-insert q cp p)
      (cell-insert p cp q))))

;;; セルの削除
;;; p - next -> [cp] - next -> q
(defun cell-delete (p q)
  (setf (cell-next p) q
        (cell-prev q) p))

;;; 削除
(defmethod dlist-delete ((d dlist) (n integer) &key (from-end nil))
  (let* ((iter (if from-end #'cell-prev #'cell-next))
         (p  (cell-nth d (1- n) iter))
         (cp (funcall iter p))
         (q  (funcall iter cp)))
    (if from-end (cell-delete q p) (cell-delete p q))
    (cell-item cp)))

;;; 畳み込み
(defmethod dlist-fold ((d dlist) func init &key from-end)
  (let ((iter (if from-end #'cell-prev #'cell-next)))
    (do ((cp (funcall iter (dlist-top d)) (funcall iter cp))
         (a init))
        ((eq cp (dlist-top d)) a)
      (setq a (if from-end
                  (funcall func (cell-item cp) a)
                (funcall func a (cell-item cp)))))))

;;; サイズ
(defmethod dlist-length ((d dlist))
  (dlist-fold d (lambda (x y) (declare (ignore y)) (1+ x)) 0))

;;; クリア
(defmethod dlist-clear ((d dlist))
  (let ((cp (dlist-top d)))
    (setf (cell-next cp) cp
          (cell-prev cp) cp)))

;;; 空リストか？
(defmethod dlist-emptyp ((d dlist))
  (let ((cp (dlist-top d)))
    (eq cp (cell-next cp))))

;;; リストを双方向リストに変換
(defmethod list-to-dlist ((xs list))
  (let ((d (make-instance 'dlist)))
    (dolist (x xs d)
      (dlist-insert d 0 x :from-end t))))

;;; 双方向リストをリストに変換
(defmethod dlist-to-list ((d dlist))
  (dlist-fold d (lambda (x y) (cons x y)) nil :from-end t))

;;; 巡回
(defmethod dlist-for-each ((d dlist) func &key (from-end nil))
  (let ((iter (if from-end #'cell-prev #'cell-next)))
    (do ((cp (funcall iter (dlist-top d)) (funcall iter cp)))
        ((eq (dlist-top d) cp))
        (funcall func (cell-item cp)))))

;;; イテレータの生成
(defmethod dlist-iterator ((d dlist) &key (from-end nil))
  (let* ((iter (if from-end #'cell-prev #'cell-next))
         (cp   (funcall iter (dlist-top d))))
    (lambda ()
      (if (eq (dlist-top d) cp)
          (values nil nil)
        (multiple-value-prog1
            (values (cell-item cp) t)
          (setq cp (funcall iter cp)))))))

;;; 表示
(defmethod print-object ((x dlist) stream)
  (format stream "#<dlist: ~S>" (dlist-to-list x)))

;;; 制限付き双方向リスト
(defclass fixed-dlist (dlist)
  ((limit :accessor dlist-limit :initform 8 :initarg :limit)
   (size  :accessor dlist-size  :initform 0 :initarg :size)))

;;; 満杯か
(defmethod dlist-fullp ((d dlist))
  nil)

(defmethod dlist-fullp ((d fixed-dlist))
  (= (dlist-limit d) (dlist-size d)))

;;; データ変換
(defmethod list-to-fixed-dlist ((xs list))
  (let ((d (make-instance 'fixed-dlist :limit (length xs))))
    (dolist (x xs d) (dlist-insert d 0 x :from-end t))))

;;; データの挿入
(defmethod dlist-insert ((d fixed-dlist) (n integer) value &key (from-end nil))
  (cond ((not (dlist-fullp d))
         (prog1
             (call-next-method d n value :from-end from-end)
           (incf (dlist-size d))))
        (t (error "fixed-dlist: size over~%"))))

;;; データの削除
(defmethod dlist-delete ((d fixed-dlist) (n integer) &key (from-end nil))
  (prog1
      (call-next-method d n :from-end from-end)
    (decf (dlist-size d))))

;;; 空にする
(defmethod dlist-clear ((d fixed-dlist))
  (call-next-method)
  (setf (dlist-size d) 0))

;;; 要素数を求める
(defmethod dlist-length ((d fixed-dlist))
  (dlist-size d))

;;; 表示
(defmethod print-object ((x fixed-dlist) stream)
  (format stream "#<fixed-dlist: ~D ~S>" (dlist-size x) (dlist-to-list x)))

●プログラムリスト２

;;;
;;; sample_dlist.lisp : 双方向リストの使用例
;;;
;;;                     Copyright (C) 2010-2020 Makoto Hiroi
;;;
(require :dlist "dlist.lisp")
(use-package :dlist)

;;; スタック

;;; クラス定義
(defclass stack ()
  ((top :accessor stack-top :initform (make-instance 'dlist))))

;;; データの追加
(defmethod stack-push ((s stack) value)
  (dlist-insert (stack-top s) 0 value))

;;; データの取り出し
(defmethod stack-pop ((s stack))
  (dlist-delete (stack-top s) 0))

;;; 先頭データの参照
(defmethod stack-peek ((s stack))
  (dlist-ref (stack-top s) 0))

;;; 要素数を求める
(defmethod stack-length ((s stack)) (dlist-length (stack-top s)))

;;; スタックを空にする
(defmethod stack-clear ((s stack)) (dlist-clear (stack-top s)))

;;; スタックは空か？
(defmethod stack-emptyp ((s stack)) (dlist-emptyp (stack-top s)))

;;; キュー

;;; クラス定義
(defclass queue ()
  ((top :accessor queue-top :initform (make-instance 'dlist))))

;;; データの追加
(defmethod enqueue ((q queue) value)
  (dlist-insert (queue-top q) 0 value :from-end t))

;;; データの取り出し
(defmethod dequeue ((q queue))
  (dlist-delete (queue-top q) 0))

;;; 先頭データを求める
(defmethod queue-peek ((q queue))
  (dlist-ref (queue-top q) 0))

;;; 要素数を求める
(defmethod queue-length ((q queue)) (dlist-length (queue-top q)))

;;; キューを空にする
(defmethod queue-clear ((q queue)) (dlist-clear (queue-top q)))

;;; キューは空か？
(defmethod queue-emptyp ((q queue)) (dlist-emptyp (queue-top q)))

;;; ディーキュー

;;; クラス定義
(defclass deque ()
  ((top :accessor deque-top :initform (make-instance 'dlist))))

;;; データの追加
(defmethod push-front ((d deque) value)
  (dlist-insert (deque-top d) 0 value))

(defmethod push-back ((d deque) value)
  (dlist-insert (deque-top d) 0 value :from-end t))

;;; データの取り出し
(defmethod pop-front ((d deque))
  (dlist-delete (deque-top d) 0))

(defmethod pop-back ((d deque))
  (dlist-delete (deque-top d) 0 :from-end t))

;;; データの参照
(defmethod peek-front ((d deque))
  (dlist-ref (deque-top d) 0))

(defmethod peek-back ((d deque))
  (dlist-ref (deque-top d) 0 :from-end t))

;;; 要素数を求める
(defmethod deque-length ((q deque)) (dlist-length (deque-top q)))

;;; ディーキューを空にする
(defmethod deque-clear ((q deque)) (dlist-clear (deque-top q)))

;;; ディーキューは空か？
(defmethod deque-emptyp ((q deque)) (dlist-emptyp (deque-top q)))