前回は一般的なオブジェクト指向の基本的な考え方と、CLOS の基本的なオブジェクト指向機能について説明しました。今回はオブジェクト指向機能を使った簡単な例題として、「双方向リスト (doubly-linked list) 」というデータ構造を作ってみましょう。
Lisp / Scheme のリストはデータを格納する CAR 部と次のセルを格納する CDR 部から構成されています。これに対し、双方向リストは次のセルだけでなく、前のセルも格納するデータ構造です。次の図を見てください。
preV NEXT preV NEXT preV NEXT
┌─┬─┬─┐ ┌─┬─┬─┐ ┌─┬─┬─┐
←─┼ │ │ │←─┼ │ │ │←─┼ │ │ │←─
─→│ │ │ ┼─→│ │ │ ┼─→│ │ │ ┼─→
└─┴─┴─┘ └─┴─┴─┘ └─┴─┴─┘
DATA DATA DATA
図 1 : 双方向リスト
Lisp / Scheme のリストは後方向にしかセルをたどることができませんが、双方向リストは前後どちらの方向へもセルをたどることができます。また、セルを削除する場合も、前後のセルがわかるので簡単に削除することができます。
双方向リストを使う場合、ヘッダセルを用意してリストを環状に構成する方法が一般的です。次の図を見てください。
変数 ──┐
↓
ヘッダセル
┌─┬─┬─┐
┌←─┼ │ │ │←───────────────────┐
│┌→│ │ │ ┼─→─────────────────┐│
││ └─┴─┴─┘ ││
││ NEXT preV ││
││ ││
││ cell A cell B cell C ││
││ ┌─┬─┬─┐ ┌─┬─┬─┐ ┌─┬─┬─┐ ││
│└←┼ │Ａ│ │←─┼ │Ｂ│ │←─┼ │Ｃ│ │←┘│
└─→│ │ │ ┼─→│ │ │ ┼─→│ │ │ ┼─→┘
└─┴─┴─┘ └─┴─┴─┘ └─┴─┴─┘
preV NEXT preV NEXT preV NEXT
図 2 : 環状リスト (1)
ヘッダセルにはデータを格納しません。ヘッダセルの NEXT が参照するセルが先頭で、preV が参照するセルが最後尾になります。ヘッダセルが先頭と最後尾のセルを参照しているので、両端でのデータ操作が簡単にできます。
データがない空リストの場合は、次の図に示すようにセルを参照する NEXT と preV の値はヘッダセル自身になります。
┌───────────┐
│ ┌─┬─┬─┐ │
└←─┼ │ │ │←─┘
┌─→│ │ │ ┼─→┐
│ └─┴─┴─┘ │
└───────────┘
データがない場合はヘッダセル自身を格納
図 3 : 環状リスト (2)
このようにすると、空リストへデータを挿入する場合や、データを削除して空リストになる場合で、プログラムが簡単になるという利点があります。これは、実際にプログラムを作ってみるとわかります。
それでは実際に双方向リストを CLOS でプログラムしてみましょう。最初に作成するメソッドを表 1 に示します。
| メソッド | 機能 |
|---|---|
| dlist-ref d n | n 番目のデータを参照する |
| dlist-set d n x | n 番目のデータを x に書き換える |
| dlist-insert d n x | n 番目にデータ x を挿入する |
| dlist-delete d n | n 番目のデータを削除する |
| dlist-length d | 要素の個数を返す |
| dlist-clear d | 双方向リストを空にする |
| dlist-emptyp d | 双方向リストが空ならば #t を返す |
| dlist-to-list d | 双方向リストをリストに変換する |
| list-to-dlist xs | リスト xs を双方向リストに変換する |
| dlist-for-each d fn | 双方向リストの要素に関数 fn を適用する |
| dlist-fold d fn init | 畳み込みを行う |
引数 d は双方向リストクラスのインスタンスです。メソッド dlist-ref, dlist-set, dlist-insert, dlist-delete の引数 n は整数値で、負の場合は後ろから数えることにします。たとえば、(dlist-ref d 0) は先頭の要素を、(dlist-ref d -1) は最後尾の要素を参照します。
dlist-insert は指定した位置 n にデータを挿入します。たとえば、(dlist-insert d 0 x) は双方向リストの先頭に x を追加します。(dlist-insert d -1 x) は双方向リストの最後尾に x を追加します。つまり、追加するデータ x が n 番目の要素になるわけです。
dlist-for-each と dlist-fold はキーワード引数 :from-end を指定することができます。:from-end が真の場合は、双方向リストを後ろから前へたどります。:form-end が指定されていない、またはその値が偽の場合は、前から後ろへたどります。
次はクラスを定義します。
リスト 1 : 双方向リストの定義
;;; セルの定義
(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))))
双方向リストのクラス名は dlist で、セルを表すクラスを cell とします。cell のスロット item にデータを格納し、スロット prev と next に前後のセルを格納します。そして、dlist のスロット top にヘッダセルを格納します。
関数 make-empty は空の双方向リストを作って返します。:initform で (make-empty) を指定すれば、(make-instance 'dlist) で新しいインスタンスを生成するたびに (make-empty) が評価されて、新しいヘッダセルが top にセットされます。
次はデータを参照するメソッド dlist-ref を作ります。
リスト 2 : データの参照
; n 番目のセルを求める (操作用関数)
(defun cell-nth (d n next)
(do ((i -1 (1+ i))
(cp (dlist-top d) (funcall next cp)))
((= i n) cp)
(if (and (<= 0 i) (eq (dlist-top d) cp))
(error "cell-nth --- oops!"))))
; 参照
(defmethod dlist-ref ((d dlist) (n integer))
(cell-item
(if (minusp n)
(cell-nth d (abs (1+ n)) #'cell-prev)
(cell-nth d n #'cell-next))))
最初にメソッドから呼び出す関数 cell-nth を作ります。この関数は n 番目のセルを返します。引数 next には次のセルを求めるメソッドを渡します。メソッド #'cell-next を渡せば前から、#'cell-prev を渡せば後ろから数えることになります。cell-nth はヘッダセルを -1 番目とし、その次のセルを 0 から数え始めます。双方向リストに n + 1 個の要素がない場合、変数 cp はヘッダセルに戻るのでエラーを送出します。
メソッド dlist-ref の引数 n は整数値なので、引数特定子に integer を指定します。n が負の場合、-1 は最後尾のセルで後ろから数えて 0 番目、-2 は後ろから数えて 1 番目になります。つまり、後ろから数えて (abs (1+ n)) 番目のセルを求めればよいわけです。cell-nth を呼び出すとき、n が負の場合は引数に #'cell-prev を渡し、n が 0 以上の場合は #'cell-next を渡します。あとは、セルの item をメソッド cell-item で取り出すだけです。
データの更新処理も cell-nth を使うと簡単です。次のリストを見てください。
リスト 3 : データの更新
(defmethod dlist-set ((d dlist) (n integer) value)
(setf (cell-item (if (minusp n)
(cell-nth d (abs (1+ n)) #'cell-prev)
(cell-nth d n #'cell-next)))
value))
cell-nth で書き換えるセルを求めて cell-item に渡します。これで item の値を setf で value に書き換えることができます。
次は、データを挿入するメソッド dlist-insert を作ります。たとえば、セル X の次 (next) にデータを挿入する場合を考えてみましょう。
X Y
W <--> [W| |Y] <--> [X| |Z] <--> Z
X の next に A を挿入
X A Y
W <--> [W| |A] <--> [X| |Y] <--> [A| |Z] <--> Z
【注意】[P| |N] はセルを表す。P : prev, N : next
図 4 : データの挿入
この場合は X の next と Y の prev を A に書き換え、A の prev と next には X と Y をセットします。また、このままの処理で空リストにデータを挿入することもできます。次の図を見てください。
H A [H| |H] [?| |?] H A [A| |A] <--> [H| |H] 図 5 : 空リストへデータを挿入
上図に示すように、ヘッダセル H の prev と next は自分自身を格納しているので、(cell-next H) は H 自身となります。したがって、A の prev と next には H がセットされ、H の prev と next には A がセットされるのです。これで、空リストにデータを挿入することができます。
プログラムは次のようになります。
リスト 4 : データの挿入
(defmethod dlist-insert ((d dlist) (n integer) value)
(labels ((cell-insert (n next)
(let* ((p (cell-nth d (- n 1) next))
(q (funcall next p))
(cp (make-instance 'cell :item value)))
(if (eq #'cell-next next)
(setf (cell-next cp) q
(cell-prev cp) p
(cell-prev q) cp
(cell-next p) cp)
(setf (cell-prev cp) q
(cell-next cp) p
(cell-next q) cp
(cell-prev p) cp)))))
(if (minusp n)
(cell-insert (abs (1+ n)) #'cell-prev)
(cell-insert n #'cell-next))))
実際の処理は局所関数 cell-insert で行います。cell-insert は双方向リスト d の n 番目にデータ value を挿入します。引数 next は次のセルをアクセスするメソッドです。最初に、n - 1 番目のセルを cell-nth で求めて変数 p にセットします。変数 q は p の次のセルで、cp が挿入する新しいセルです。
next が #'cell-next の場合、cp の next に q を、prev に p をセットします。そして、q の prev に cp を、p の next に cp をセットします。そうでなければ、cp の next に p を、prev に q をセットし、q の next と p の prev に cp をセットします。これで p と q の間に cp を挿入することができます。
次は、データを削除するメソッド dlist-delete を作ります。次の図を見てください。
X A Y
W <--> [W| |A] <--> [X| |Y] <--> [A| |Z] <--> Z
H の next のセル A を削除
X A Y
W <--> [W| |Y] [X| |Y] [X| |Z] <--> Z
↑ ↑
└─────────┘
図 6 : データの削除
データの削除はとても簡単です。削除するセル A の前後のセルの next と prev を書き換えるだけです。上図の場合、X の next を Y に、Y の prev を X に書き換えます。これでセル A を双方向リストから外すことができます。
ところで、最後のデータを削除する場合もこのままの処理で大丈夫です。次の図を見てください。
H A H
[A| |A] <--> [H| |H] ===> [H| |H]
図 7 : 最後のデータを削除
セル A の next と prev はヘッダセル H を格納しています。したがって、A の次のセル (cell-next A) は H になり、その prev は H に書き換えられます。A の後ろのセル (cell-prev A) も H になり、その next は H に書き換えられるので、双方向リストは空の状態になります。
プログラムは次のようになります。
リスト 5 : データの削除
(defmethod dlist-delete ((d dlist) (n integer))
(labels ((cell-delete (n next prev)
(let* ((cp (cell-nth d n next))
(p (funcall prev cp))
(q (funcall next cp)))
(if (eq next #'cell-next)
(setf (cell-next p) q
(cell-prev q) p)
(setf (cell-prev p) q
(cell-next q) p))
(cell-item cp))))
(if (minusp n)
(cell-delete (abs (1+ n)) #'cell-prev #'cell-next)
(cell-delete n #'cell-next #'cell-prev))))
実際の処理は局所関数 cell-delete で行います。cell-nth で削除するセルを変数 cp にセットし、その前後のセルを変数 p, q にセットします。next が #'cell-next の場合、p の next を q に、q の prev を p に書き換えます。そうでなければ、p の prev を q に、q の next を p に書き換えます。これで cp を双方向リストから外すことができます。最後に、cp に格納されているデータ item を返します。
次は畳み込みと巡回を行うメソッドを作りましょう。
リスト 6 : 高階関数
(defmethod dlist-fold ((d dlist) func init &key from-end)
(let ((next (if from-end #'cell-prev #'cell-next)))
(do ((cp (funcall next (dlist-top d)) (funcall next cp))
(a init))
((eq cp (dlist-top d)) a)
(setq a (if (eq next #'cell-prev)
(funcall func (cell-item cp) a)
(funcall func a (cell-item cp)))))))
; 巡回
(defmethod dlist-for-each ((d dlist) func &key from-end)
(if from-end
(dlist-fold d #'(lambda (x y) (funcall func x)) nil :from-end t)
(dlist-fold d #'(lambda (x y) (funcall func y)) nil)))
メソッド dlist-fold はキーワード引数 from-end の値が真ならば後ろから前へ、そうでなければ前から後ろへ畳み込みを行います。form-end の値が真ならば変数 next に #'cell-prev を、そうでなければ #'cell-next をセットします。あとは do ループでセルを順番にたどり、要素に関数 func を適用して、その結果を累積変数 a にセットします。
このとき、next の値をチェックして、#'cell-prev ならば func の第 1 引数が要素、第 2 引数が a になります。#'cell-next の場合は逆になるので注意してください。dlist-for-each は dlist-fold を呼び出すだけなので簡単です。from-end の値によって、func に渡す引数が異なることに注意してください。
次は双方向リストをリストに変換するメソッド dlist-to-list と、その逆変換を行う list-to-dlist を作ります。
リスト 7 : データの変換
; リストを双方向リストに変換
(defmethod list-to-dlist ((xs list))
(let ((d (make-instance 'dlist)))
(dolist (x xs d)
(dlist-insert d -1 x))))
; 双方向リストをリストに変換
(defmethod dlist-to-list ((d dlist))
(dlist-fold d
#'(lambda (x y) (cons x y))
nil
:from-end t))
リストを双方向リストに変換するメソッド list-to-dlist は簡単です。make-instance で dlist のインスタンスを生成し、dolist でリストの要素を取り出して dlist-insert で最後尾に追加していくだけです。メソッド dlist-to-list は dlist-fold を呼び出すと簡単です。双方向リストの最後尾から順番にアクセスし、その要素 x を累積変数 y の先頭に追加していくだけです。
最後に、dlist-length, dlist-clear, dlist-emptyp を作ります。
リスト 8 : その他のメソッド
; サイズ
(defmethod dlist-length ((d dlist))
(dlist-fold d #'(lambda (x 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))))
dlist-length は dlist-fold を呼び出すだけです。dlist-clear はヘッダセル cp のスロット prev と next の値を cp に書き換えるだけです。dlist-emptyp はヘッダセル cp とスロット next (または prev) の値が等しいか eq でチェックするだけです。
最後に双方向リストを表示するメソッドを作ります。
リスト 9 : データの表示 (defmethod print-object ((x dlist) stream) (format stream "#<dlist: ~S>" (dlist-to-list x)))
print-object はデータを表示するとき Common Lisp 処理系から呼び出されるメソッドです。print-object を定義しておくと、双方向リストの内容を print などの出力関数で表示することができます。
それでは、簡単な実行例を示しましょう。なお、プログラムはパッケージ DLIST にまとめておき、compile-file でコンパイルしてカレントディレクトリにあるものとします。
> (require :dlist "dlist") ; 修正 (2010/09/19) ;; ... ;; ... T > (use-package :dlist) ; 修正 (2010/09/19) T > (setq a (make-instance 'dlist)) #<dlist: NIL> > (dotimes (x 8) (dlist-insert a 0 x)) NIL > a #<dlist: (7 6 5 4 3 2 1 0)> > (dlist-emptyp a) NIL > (dotimes (x 8) (format t "~D " (dlist-ref a x))) 7 6 5 4 3 2 1 0 NIL > (dotimes (x 8) (format t "~D " (dlist-delete a 0))) 7 6 5 4 3 2 1 0 NIL > (dlist-emptyp a) T > (dotimes (x 8) (dlist-insert a -1 x)) NIL > a #<dlist: (0 1 2 3 4 5 6 7)> > (dotimes (x 8) (format t "~D " (dlist-ref a (- x 8)))) 0 1 2 3 4 5 6 7 NIL > (dotimes (x 8) (format t "~D " (dlist-delete a -1))) 7 6 5 4 3 2 1 0 NIL > (dlist-emptyp a) T > (setq b (list-to-dlist '(a b c d e f))) #<dlist: (A B C D E F)> > (dlist-for-each b #'(lambda (x) (format t "~D " x))) A B C D E F NIL > (dlist-for-each b #'(lambda (x) (format t "~D " x)) :from-end t) F E D C B A NIL
双方向リストの場合、データの入出力を片側に限定すると「スタック」の動作になります。また、データの入力を後ろから (または前から)、データの出力を前から (または後ろから) 行うと「キュー」の動作になります。
ただし、これらのデータ構造を双方向リストで実現する場合、クラス <dlist> をそのまま使うことはお勧めしません。なぜならば、スタックまたはキューの構造を簡単に破壊できるメソッド dlist-insert と dlist-delete があるからです。双方向リストの途中にデータを挿入したり、途中からデータを取り除くと、スタックやキューの構造は破壊されてしまいます。dlist を使ってスタックやキューを作る話は、継承のところで取り上げます。
;
; dlist.l : 双方向リスト
;
; Copyright (C) 2010 Makoto Hiroi
;
; 修正 2010/09/19
;
; 1. パッケージ名を "DLIST" に変更
; 2. defpackage に (:use "COMMON-LISP") を追加
; 3. :export の指定を文字列に変更
;
(provide "DLIST")
(defpackage "DLIST"
(:use "COMMON-LISP")
(: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" "PRINT-OBJECT"
))
(in-package "DLIST")
; メソッドの宣言
(defgeneric dlist-ref (d n))
(defgeneric dlist-set (d n value))
(defgeneric dlist-insert (d n value))
(defgeneric dlist-delete (d n))
(defgeneric dlist-fold (d func init &key from-end))
(defgeneric dlist-length (d))
(defgeneric dlist-clear (d))
(defgeneric dlist-emptyp (d))
(defgeneric list-to-dlist (ls))
(defgeneric dlist-to-list (d))
(defgeneric dlist-for-each (d func &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 next)
(do ((i -1 (1+ i))
(cp (dlist-top d) (funcall next cp)))
((= i n) cp)
(if (and (<= 0 i) (eq (dlist-top d) cp))
(error "cell-nth --- oops!"))))
; 参照
(defmethod dlist-ref ((d dlist) (n integer))
(cell-item
(if (minusp n)
(cell-nth d (abs (1+ n)) #'cell-prev)
(cell-nth d n #'cell-next))))
; 書き換え
(defmethod dlist-set ((d dlist) (n integer) value)
(setf (cell-item (if (minusp n)
(cell-nth d (abs (1+ n)) #'cell-prev)
(cell-nth d n #'cell-next)))
value))
; 挿入
(defmethod dlist-insert ((d dlist) (n integer) value)
(labels ((cell-insert (n next)
(let* ((p (cell-nth d (- n 1) next))
(q (funcall next p))
(cp (make-instance 'cell :item value)))
(if (eq #'cell-next next)
(setf (cell-next cp) q
(cell-prev cp) p
(cell-prev q) cp
(cell-next p) cp)
(setf (cell-prev cp) q
(cell-next cp) p
(cell-next q) cp
(cell-prev p) cp)))))
(if (minusp n)
(cell-insert (abs (1+ n)) #'cell-prev)
(cell-insert n #'cell-next))))
; 削除
(defmethod dlist-delete ((d dlist) (n integer))
(labels ((cell-delete (n next prev)
(let* ((cp (cell-nth d n next))
(p (funcall prev cp))
(q (funcall next cp)))
(if (eq next #'cell-next)
(setf (cell-next p) q
(cell-prev q) p)
(setf (cell-prev p) q
(cell-next q) p))
(cell-item cp))))
(if (minusp n)
(cell-delete (abs (1+ n)) #'cell-prev #'cell-next)
(cell-delete n #'cell-next #'cell-prev))))
; 畳み込み
(defmethod dlist-fold ((d dlist) func init &key from-end)
(let ((next (if from-end #'cell-prev #'cell-next)))
(do ((cp (funcall next (dlist-top d)) (funcall next cp))
(a init))
((eq cp (dlist-top d)) a)
(setq a (if (eq next #'cell-prev)
(funcall func (cell-item cp) a)
(funcall func a (cell-item cp)))))))
; サイズ
(defmethod dlist-length ((d dlist))
(dlist-fold d #'(lambda (x 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 -1 x))))
; 双方向リストをリストに変換
(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)
(if from-end
(dlist-fold d #'(lambda (x y) (funcall func x)) nil :from-end t)
(dlist-fold d #'(lambda (x y) (funcall func y)) nil)))
; 表示
(defmethod print-object ((x dlist) stream)
(format stream "#<dlist: ~S>" (dlist-to-list x)))