お気楽 Scheme プログラミング入門

前回は一般的なオブジェクト指向の基本的な考え方と、Gauche の基本的なオブジェクト指向機能について説明しました。今回はオブジェクト指向機能を使った簡単な例題として、「双方向リスト (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)

このようにすると、空リストへデータを挿入する場合や、データを削除して空リストになる場合で、プログラムが簡単になるという利点があります。これは、実際にプログラムを作ってみるとわかります。

●双方向リストのメソッド

それでは実際に双方向リストを Gauche でプログラムしてみましょう。最初に作成するメソッドを表 1 に示します。

引数 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 : 双方向リストの定義

; セルの定義
(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))))

双方向リストのクラス名は <dlist> で、セルを表すクラス名を <cell> とします。<cell> のスロット item にデータを格納し、スロット prev と next に前後のセルを格納します。そして、<dlist> のスロット top にヘッダセルを格納します。

関数 make-empty は空の双方向リストを作って返します。top を初期化する場合、:init-form で (make-empty) を指定します。これで (make <dlist>) を評価するたびに (make-empty) が評価されて、新しいヘッダセルが top にセットされます。

●データの参照

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

リスト 2 : データの参照

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

最初にメソッドから呼び出す関数 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 (+ n 1)) 番目のセルを求めればよいわけです。cell-nth を呼び出すとき、n が負の場合は引数に cell-prev を渡し、n が 0 以上の場合は cell-next を渡します。あとは、セルの item をメソッド cell-item で取り出すだけです。

●データの更新

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

リスト 3 : データの更新

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

cell-nth で書き換えるセルを求めて cell-item に渡します。このように、拡張された set! は汎変数を使えるので、値の書き換えはとても簡単です。

●データの挿入

次は、データを挿入するメソッド 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 : データの挿入

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

実際の処理は局所関数 cell-insert! で行います。cell-insert! は双方向リスト d の n 番目にデータ value を挿入します。引数 next と prev は前後のセルをアクセスするメソッドです。最初に、n - 1 番目のセルを cell-nth で求めて変数 p にセットします。変数 q は p の次のセルで、cp が挿入する新しいセルです。

p と q の間に cp を挿入するので、cp の next に q を、prev に p をセットします。このとき、next に cell-next がセットされていれば、セルの next に q がセットされ、cell-prev がセットされていればセルの prev に q がセットされることに注意してください。そして、q の prev に cp を、p の next に 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 : データの削除

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

実際の処理は局所関数 cell-delete! で行います。cell-nth で削除するセルを変数 cp にセットし、その前後のセルを変数 p, q にセットします。あとは、p の next を q に、q の prev を p に書き換えれば、cp を双方向リストから外すことができます。最後に、cp に格納されているデータ item を返します。

●畳み込みと巡回

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

リスト 6 : 高階関数

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

メソッド dlist-fold はキーワードの値を get-keyword で求め、その値が真ならば後ろから前へ、そうでなければ前から後ろへ畳み込みを行います。:form-end の値が真ならば変数 next に cell-prev を、そうでなければ cell-next をセットします。あとは named-let でセルを順番にたどり、要素に関数 func を適用して、その結果を累積変数 a にセットします。

このとき、next の値をチェックして、cell-prev ならば func の第 1 引数が要素、第 2 引数が a になります。cell-next の場合は逆になるので注意してください。dlist-for-each は dlist-fold を呼び出すだけなので簡単です。:from-end の値によって、func に渡す引数が異なることに注意してください。

●データの変換

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

リスト 7 : データの変換

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

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

<list> は Scheme の述語 list? が真となるデータ (空リストとコンスセル) を表すクラスです。Gauche の場合、空リストを表すクラス <null> とコンスセルを表すクラス <pair> があり、<list> はこれらのクラスのスーパークラスになります。スーパークラスについては「継承」で詳しく説明します。

●その他のメソッド

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

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

; サイズ
(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)))
    (eq? cp (cell-next cp))))

dlist-length は dlist-fold を呼び出すだけです。dlist-clear はヘッダセル cp のスロット prev と next の値を cp に書き換えるだけです。dlist-empty? はヘッダセル cp とスロット next (または prev) の値が等しいか eq? でチェックするだけです。

●実行例

それでは、簡単な実行例を示しましょう。

gosh> (define a (make <dlist>))
a
gosh> (dotimes (x 8) (dlist-insert! a 0 x))
#t
gosh> (dlist->list a)
(7 6 5 4 3 2 1 0)
gosh> (dlist-empty? a)
#f
gosh> (dotimes (x 8) (format #t "~A " (dlist-ref a x)))
7 6 5 4 3 2 1 0 #t
gosh> (dotimes (x 8) (format #t "~A " (dlist-delete! a 0)))
7 6 5 4 3 2 1 0 #t
gosh> (dlist-empty? a)
#t
gosh> (dotimes (x 8) (dlist-insert! a -1 x))
#t
gosh> (dlist->list a)
(0 1 2 3 4 5 6 7)
gosh> (dotimes (x 8) (format #t "~A " (dlist-delete! a 0)))
0 1 2 3 4 5 6 7 #t
gosh> (define b (list->dlist '(a b c d e f g h)))
b
gosh> (dlist-for-each b (lambda (x) (display x)))
abcdefgh#<undef>
gosh> (dlist-for-each b (lambda (x) (display x)) :from-end #t)
hgfedcba#<undef>
gosh> (dlist->list b)
(a b c d e f g h)

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

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

●プログラムリスト

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