Common Lisp Programming

双方向リスト

前回は一般的なオブジェクト指向の基本的な考え方と、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 でプログラムしてみましょう。最初に作成するメソッドを下表に示します。

引数 D は双方向リストクラスのインスタンスです。引数 N は正整数 (添字) を表します。多くのメソッドでキーワード引数 :from-end を指定することができます。:from-end が真の場合は、双方向リストを後ろから前へたどります。:form-end が指定されていない、または値が偽の場合は前から後ろへたどります。

たとえば、(dlist-ref d 0) は先頭の要素を参照し、(dlist-ref d 0 :from-end t) は最後尾の要素を参照します。(dlist-insert d 0 x) は双方向リストの先頭に X を追加します。(dlist-insert d 0 x :from-end t) は双方向リストの最後尾に X を追加します。つまり、追加するデータ X が N 番目の要素になるわけです。

(dlist-for-each d fn) は先頭の要素から順番に関数 FN を適用します。:from-end に T を指定すると、末尾の要素から順番に関数 FN を適用します。(dlist-fold d fn) は先頭から畳み込みを行い、:form-end に T を指定すると末尾から畳み込みを行います。(dlist-iterator d) は要素を順番に取り出す関数 (イテレータ) を返します。:from-end に T を指定すると、末尾から順番に要素を取り出して返します。

●クラスの定義

次はクラスを定義します。

リスト : 双方向リストの定義

;;; セルの定義
(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 は空の双方向リストを作って返します。DLIST の :initform で (make-empty) を指定すれば、(make-instance 'dlist) で新しいインスタンスを生成するたびに (make-empty) が評価されて、新しいヘッダセルが TOP にセットされます。

●データの参照

次はデータを参照するメソッド dlist-ref を作ります。

リスト : データの参照

;;; 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))))

最初にメソッドから呼び出す関数 cell-nth を作ります。この関数は N 番目のセルを返します。引数 ITER には次のセルを求めるメソッドを渡します。メソッド #'cell-next を渡せば前から、#'cell-prev を渡せば後ろから数えることになります。cell-nth はヘッダセルを -1 番目とし、その次のセルを 0 から数え始めます。双方向リストに N + 1 個の要素がない場合、変数 cp はヘッダセルに戻るのでエラーを通知します。

メソッド dlist-ref の引数 N は整数値なので、引数特定子に integer を指定します。cell-nth を呼び出すとき、:from-end が真の場合は引数 ITER に #'cell-prev を渡し、偽の場合は #'cell-next を渡します。あとは、メソッド cell-item でセルの ITEM を取り出すだけです。

●データの更新

データの更新処理も cell-nth を使うと簡単です。次のリストを見てください。

リスト : データの更新

(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))

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 がセットされるのです。これで、空リストにデータを挿入することができます。

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

リスト : データの挿入

;;; セルの挿入
(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))))

cell-nth で N - 1 番目のセルを求め、変数 P にセットします。さらに、次のセルを求めて変数 Q にセットします。そして、新しいセル CP を生成して、P と Q の間に挿入します。挿入処理は関数 cell-insert で行います。これは図で説明したことをそのままプログラムしただけなので簡単です。:from-end が真の場合は、Q と P の間に CP を挿入すると考えて cell-insert を呼び出すだけです。

●データの削除

次は、データを削除するメソッド 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 に書き換えられるので、双方向リストは空の状態になります。

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

リスト : データの削除

;;; セルの削除
(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)))

nth-cell で N - 1 番目のセルを求めて変数 P にセットします。さらに、次のセル (削除するセル) を求めて変数 CP にセットし、その次のセルを変数 Q にセットします。削除処理は関数 cell-delete で行います。これは図で説明したことをそのままプログラムしただけなので簡単です。:from-end が真の場合は、Q -> CP -> P とつながっているセル CP を削除すると考えて cell-delete を呼び出します。最後に CP のスロット ITEM の値を返します。

●畳み込みと巡回

次は畳み込みと巡回を行うメソッドを作りましょう。

リスト : 高階関数

;;; 畳み込み
(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-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)))))

メソッド dlist-fold は :from-end の値が真ならば後ろから前へ、そうでなければ前から後ろへ畳み込みを行います。:form-end の値が真ならば変数 ITER に #'cell-prev を、そうでなければ #'cell-next をセットします。

あとは do ループでセルを順番にたどり、要素に関数 FUNC を適用して、その結果を累積変数 A にセットします。このとき、:from-end の値をチェックして、真ならば FUNC の第 1 引数が要素、第 2 引数が A になります。偽の場合は逆になるので注意してください。

dlist-for-each は dlist-fold と同じように do ループでセルを順番にたどり、要素に関数 FUNC を適用するだけです。

●データの変換

次は双方向リストをリストに変換するメソッド dlist-to-list と、その逆変換を行う list-to-dlist を作ります。

リスト : データの変換

;;; リストを双方向リストに変換
(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))

リストを双方向リストに変換するメソッド list-to-dlist は簡単です。make-instance で dlist のインスタンスを生成し、dolist でリストの要素を取り出して dlist-insert で最後尾に追加していくだけです。メソッド dlist-to-list は dlist-fold を呼び出すと簡単です。双方向リストの最後尾から順番にアクセスし、その要素 X を累積変数 Y の先頭に追加していくだけです。

●イテレータ

次はイテレータを生成するメソッド dlist-iterator を作ります。

リスト : イテレータの生成

(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)))))))

dlist-iterator は双方向リストから要素を順番に取り出す関数 (イテレータ) を返します。:from-end が真ならば、変数 ITER に #'cell-prev を、偽ならば #'cell-next をセットし、変数 CP にヘッダセルの次のセルをセットします。あとはラムダ式でクロージャを生成して返します。

この中で、CP がヘッダセルと等しいかチェックします。そうであれば、要素をすべて取り出したので多値 NIL, NIL を返します。そうでなければ、multiple-value-prog1 で多値 要素, T を返し、CP の値を次のセルに更新します。

●その他のメソッド

最後に、dlist-length, dlist-clear, dlist-emptyp を作ります。

リスト : その他のメソッド

;;; サイズ
(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 でチェックするだけです。

最後に双方向リストを表示するメソッドを作ります。

リスト : データの表示

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

print-object はデータを表示するとき Common Lisp 処理系から呼び出されるメソッドです。print-object を定義しておくと、双方向リストの内容を print などの出力関数で表示することができます。

●実行例

それでは、簡単な実行例を示しましょう。なお、プログラムはパッケージ DLIST にまとめておき、カレントディレクトリにあるものとします。

* (require :dlist "dlist.lisp")

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

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 0 x :from-end t))

NIL
* a

#<dlist: (0 1 2 3 4 5 6 7)>
* (dotimes (x 8) (format t "~D " (dlist-ref a x :from-end t)))
7 6 5 4 3 2 1 0
NIL
* (dotimes (x 8) (format t "~D " (dlist-delete a 0 :from-end t)))
7 6 5 4 3 2 1 0
NIL
* (dlist-emptyp a)

T
* (setq a (list-to-dlist '(a b c d e f)))

#<dlist: (A B C D E F)>
* (dlist-for-each a (lambda (x) (format t "~A " x)))
A B C D E F
NIL
* (dlist-for-each a (lambda (x) (format t "~A " x)) :from-end t)
F E D C B A
NIL
* (dlist-fold a #'cons nil :from-end t)

(A B C D E F)
* (dlist-fold a (lambda (a x) (cons x a)) nil)

(F E D C B A)
* (setq it (dlist-iterator a))

#<CLOSURE (LAMBDA () :IN DLIST-ITERATOR) {1003511B5B}>
* (funcall it)

A
T
* (funcall it)

B
T
* (funcall it)

C
T
* (funcall it)

D
T
* (funcall it)

E
T
* (funcall it)

F
T
* (funcall it)

NIL
NIL

双方向リストの場合、データの入出力を片側に限定すると「スタック」の動作になります。また、データの入力を後ろから (または前から)、データの出力を前から (または後ろから) 行うと「キュー」の動作になります。

ただし、これらのデータ構造を双方向リストで実現する場合、クラス DLIST をそのまま使うことはおすすめしません。なぜならば、スタックまたはキューの構造を簡単に破壊できるメソッド dlist-insert と dlist-delete があるからです。双方向リストの途中にデータを挿入したり、途中からデータを取り除くと、スタックやキューの構造は破壊されてしまいます。

DLIST を使ってスタックやキューを作る話は、継承のところで取り上げます。

●プログラムリスト

;;;
;;; 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))

;;; メソッドの宣言
(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 list-to-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)))