リストとクロージャを使ったスタック (stack) とキュー (queue) の実装です。
最初にスタックについて簡単に説明します。スタックの例として、バネ付きのトレイを取り上げます。
図 : スタックの動作例
初めはトレイが入っていない空の状態です。ここにトレイを上から入れると、重さによってバネを圧縮し、次のトレイを追加できるようになります。もうひとつトレイを乗せると、さらにバネを圧縮し次のトレイを追加できるようになります。バネが限界まで圧縮されると、トレイは追加できません。トレイを取り出す場合は、上にあるトレイから取り出していきます。ひとつ取り出すと、その分バネが伸びて下にあるトレイが上に出てくるので、次のトレイを取り出すことができます。
このトレイをデータと考えてください。データ A をスタックに追加し(2)、次にデータ B を追加します(3)。データを取り出す場合、後から入れたデータ B が先に取り出され(4)、その次にデータ A が取り出されて、スタックが空になります(5)。このように、スタックは後から入れたデータが先に取り出されるので、後入れ先出し (Last-In First-Out : LIFO) と呼ばれます。スタックにデータを追加する操作をプッシュ (PUSH) といい、スタックからデータを取り出す操作をポップ (POP) というます。スタックはリストを使うと簡単に実現することができます。
次はキューについて簡単に説明します。
キューは「待ち行列」といわれるデータ構造です。たとえば、チケットを買う場合窓口に長い列ができますが、それと同じだと考えてください。チケットを買うときは、列の途中に割り込むことはできませんね。いちばん後ろに並んで順番を待たなければいけません。列の先頭まで進むと、チケットを購入することができます。
このように、要素を取り出す場合は列の先頭から行い、要素を追加する場合は列の後ろに行うデータ構造がキューなのです。キューは先入れ先出し (FIFO : first-in, first-out) とも呼ばれます。
図 : キュー
図 : キューの構造
キューにデータを入れることを enqueue といい、キューからデータを取り出すことを dequeue といいます。リストを使ってキューを実装する場合、上図のようにキューの先頭とリストの先頭を対応させます。すると、キューからデータを取り出すには、リストの先頭からデータを取り出すだけですみます。これはとても簡単ですね。ただし、キューにデータを入れるには、リストの最後尾にデータを追加することになるため、ちょっとした工夫が必要になります。
そこで、最後尾のセルを格納する変数を用意することにします。上図に示すように、リストを保持する変数 front のほかに、最後尾のセルを格納する変数 rear を用意します。rear の示すセルの CDR を書き換えることで、リストの末尾にデータを簡単に追加することができます。
リスト : スタックとキュー ;;; スタック (define-record-type Stack (make-stack top) stack? (top top set-top!)) (define (stack-push! st x) (set-top! st (cons x (top st)))) (define (stack-pop! st) (let ((x (car (top st)))) (set-top! st (cdr (top st))) x)) (define (stack-length st) (length (top st))) (define (stack-empty? st) (null? (top st))) ;;; キュー (define-record-type Queue (make-queue front rear) queue? (front front set-front!) (rear rear set-rear!)) (define (queue-empty? q) (null? (front q))) (define (enqueue! q x) (let ((cell (list x))) (if (queue-empty? q) (set-front! q cell) (set-cdr! (rear q) cell)) (set-rear! q cell))) (define (dequeue! q) (if (queue-empty? q) (error "dequeue!: empty queue") (let ((x (car (front q)))) (set-front! q (cdr (front q))) (when (null? (front q)) (set-rear! q '())) x))) (define (queue-length q) (length (front q)))
gosh[r7rs.user]> (define s (make-stack '())) s gosh[r7rs.user]> s #<Stack 0x7f87ff880000> gosh[r7rs.user]> (do ((i 0 (+ i 1))) ((> i 7)) (stack-push! s i)) #t gosh[r7rs.user]> (stack-empty? s) #f gosh[r7rs.user]> (stack-length s) 8 gosh[r7rs.user]> (do () ((stack-empty? s)) (display (stack-pop! s)) (newline)) 7 6 5 4 3 2 1 0 #t gosh[r7rs.user]> (stack-length s) 0 gosh[r7rs.user]> (define q (make-queue '() '())) q gosh[r7rs.user]> q #<Queue 0x7f87008b02a0> gosh[r7rs.user]> (do ((i 0 (+ i 1))) ((> i 7)) (enqueue! q i)) #t gosh[r7rs.user]> (queue-empty? q) #f gosh[r7rs.user]> (queue-length q) 8 gosh[r7rs.user]> (do () ((queue-empty? q)) (display (dequeue! q)) (newline)) 0 1 2 3 4 5 6 7 #t gosh[r7rs.user]> (queue-length q) 0
リストは要素を一列に並べたデータ構造ですが、最後尾のセルと先頭のセルを連結することで要素をリング状に並べることができます。これを「循環リスト (circular list)」といいます。次の図を見てください。
図 : 循環リスト
リスト (a b c) は '() で終端されています。このリストで、最後尾のセルの CDR 部を先頭のセル A に書き換えると、循環リストを作ることができます。循環リストは環状に並んだデータを表すのに便利なデータ構造です。
リスト : 循環リスト ;;; 循環リストの検出 (define (circular-list? ls) (let loop ((xs ls) (ys ls)) (if (and (pair? xs) (pair? (cdr xs))) (if (eq? (cddr xs) (cdr ys)) #t (loop (cddr xs) (cdr ys))) #f))) ;;; 循環リストによるキューの実装 (define-record-type Que (make-que rear-c) que? (rear-c rear-c set-rear-c!)) (define (que-empty? q) (null? (rear-c q))) (define (enq! q x) (let ((xs (list x))) (cond ((que-empty? q) (set-cdr! xs xs)) (else (set-cdr! xs (cdr (rear-c q))) (set-cdr! (rear-c q) xs))) (set-rear-c! q xs))) (define (deq! q) (if (que-empty? q) (error "deq!: empty queue") (let ((front (cdr (rear-c q)))) (if (eq? front (rear-c q)) (set-rear-c! q '()) (set-cdr! (rear-c q) (cdr front))) (car front)))) (define (que-length q) (if (que-empty? q) 0 (let loop ((c 1) (xs (cdr (rear-c q)))) (if (eq? xs (rear-c q)) c (loop (+ c 1) (cdr xs))))))
gosh[r7rs.user]> (define a (list 1 2 3 4 5)) a gosh[r7rs.user]> (circular-list? a) #f gosh[r7rs.user]> (set-cdr! (last-pair a) a) #<undef> gosh[r7rs.user]> (circular-list? a) #t gosh[r7rs.user]> (define q (make-que '())) q gosh[r7rs.user]> q #<Que 0x7f8700a1a320> gosh[r7rs.user]> (do ((i 0 (+ i 1))) ((> i 7)) (enq! q i)) #t gosh[r7rs.user]> (que-empty? q) #f gosh[r7rs.user]> (que-length q) 8 gosh[r7rs.user]> (do () ((que-empty? q)) (display (deq! q)) (newline)) 0 1 2 3 4 5 6 7 #t gosh[r7rs.user]> (que-empty? q) #t gosh[r7rs.user]> (que-length q) 0
「木構造 (tree structer)」は「木 (tree)」とも呼ばれるデータ構造で、節 (ノード) と呼ばれる要素に対して、階層的な関係を表したものです。身近な例では、ディレクトリの階層構造が木にあたります。ディレクトリに「ルートディレクトリ」があるように、木にも「根 (ルート)」と呼ばれる節が存在します。
図 : 一般的な木構造の一例
木を図示する場合、階層関係がはっきりわかるように、根を上にして、同じ階層にある節を並べて書きます。根からレベル 0、レベル 1 と階層を数えていき、最下層の節までの階層数を「木の高さ」といいます。木は、ある節から下の部分を切り出したものも、木としての性質を持っています。これを「部分木」といいます。
木は、ある節からほかの節に至る「経路」を考えることができます。たとえば、A から J には、A - B - G - J という経路がありますね。これは、ディレクトリやファイルを指定するときのパスと同じです。
ある節から根の方向にさかのぼるとき、途中で通っていく節を「先祖」といい、直接繋がっている節を「親」といます。これは、逆から見ると「子孫」と「子」という関係になります。子を持たない節をとくに「葉」と呼ぶことがあります。上図でいうと、G は J, K の親で、J は G の子になります。J は子を持っていないので葉となります。
子は、「左 < 右」の順番で節に格納するのが一般的です。これを「順序木」といいます。また、順番がない木を「無順序木」と呼びます。節が持っている子の数を「次数」といいます。上図の場合、A は 3 つの子 B, C, D を持っているので、A の次数は 3 となります。すべての節の次数を n に揃えた順序木を「 n 分木」と呼びます。とくに、次数が 2 の二分木は、プログラムでよく使われるデータ構造です。
図 : 二分木の一例
上図に二分木の例を示します。二分木では、節にひとつのデータを格納します。そして、その節の左側の子には小さいデータを、右側の子には大きいデータが配置されるように木を構成します。
この二分木をデータの探索に使うアルゴリズムが「二分探索木」です。二分探索木はデータの探索・挿入を高速に行うことができます。たとえば、上図の木から 19 を探してみましょう。まず root の 18 と比較します。18 < 19 ですから、右側の子をたどり 22 と比較します。今度は 19 < 22 なので左側の子をたどります。次は 20 と比較し 19 < 20 なので左側の子をたどり、ここで 19 を見つけることができます。
二分探索木の探索は二分探索と同じ原理です。左右どちらかの子をたどるたびに、探索するデータ数は半分になります。上図の場合でも、探索するデータ数が 15, 7, 3, 1 となり、最後に見つけることができました。
データ数を N とすると、単純な線形探索では平均で N / 2 回の比較が必要になりますが、二分探索木を使うと log 2 N 程度の回数で収まります。たとえば、データが 100個ある場合、線形探索では 50 回データを比較しなければいけないのに、二分探索木では 7 回程度の比較で済むわけです。
ただし、これは左右の部分木のバランスがとれている理想的な状態での話です。バランスが崩れると二分探索木の性能は劣化し、最悪の場合は線形探索と同じになってしまいます。そこで、左右のバランスを一定の範囲に収める「平衡木」が考案されています。有名なところでは AVL 木、2 色木 (赤黒木)、2-3 木、B 木、B* 木などがあります。
以下のプログラムは拙作のページ Scheme 入門: 二分木 と同じです。詳しい説明はそちらをお読みくださいませ。
リスト : 二分木 ;;; 節 (define-record-type Node (make-node data left right) node? (data data set-data!) (left left set-left!) (right right set-right!)) ;;; データの探索 (define (search-node node x comp) (if (null? node) #f (let ((r (comp x (data node)))) (cond ((zero? r) (data node)) ((negative? r) (search-node (left node) x comp)) (else (search-node (right node) x comp)))))) ;;; データの挿入 (define (insert-node! node x comp) (if (null? node) (make-node x '() '()) (let ((r (comp x (data node)))) (cond ((zero? r) node) ((negative? r) (set-left! node (insert-node! (left node) x comp)) node) (else (set-right! node (insert-node! (right node) x comp)) node))))) ;;; 最大値の探索 (define (search-max-node node) (if (null? (right node)) (data node) (search-max-node (right node)))) ;;; 最大値の削除 (define (delete-max-node! node) (cond ((null? (right node)) (left node)) (else (set-right! node (delete-max-node! (right node))) node))) ;;; 最小値の探索 (define (search-min-node node) (if (null? (left node)) (data node) (search-min-node (left node)))) ;;; 最小値の削除 (define (delete-min-node! node) (cond ((null? (left node)) (right node)) (else (set-left! node (delete-min-node! (left node))) node))) ;;; データの削除 (define (delete-node! node x comp) (if (null? node) node (let ((r (comp x (data node)))) (cond ((zero? r) (cond ((null? (left node)) (right node)) ((null? (right node)) (left node)) (else (set-data! node (search-min-node (right node))) (set-right! node (delete-min-node! (right node))) node))) ((negative? r) (set-left! node (delete-node! (left node) x comp)) node) (else (set-right! node (delete-node! (right node) x comp)) node))))) ;;; 巡回 (define (for-each-node fn node) (when (node? node) (for-each-node fn (left node)) (fn (data node)) (for-each-node fn (right node)))) ;;; ;;; 二分木 ;;; (define-record-type Tree (create-tree root comp) tree? (root root set-root!) (comp comp)) ;;; 生成 (define (make-tree cmp) (create-tree '() cmp)) ;;; 探索 (define (search-tree tree x) (search-node (root tree) x (comp tree))) (define (max-tree tree) (if (null? (root tree)) #f (search-max-node (root tree)))) (define (min-tree tree) (if (null? (root tree)) #f (search-min-node (root tree)))) ;;; 挿入 (define (insert-tree! tree x) (set-root! tree (insert-node! (root tree) x (comp tree)))) ;;; 削除 (define (delete-tree! tree x) (set-root! tree (delete-node! (root tree) x (comp tree)))) (define (delete-max-tree! tree) (when (node? (root tree)) (set-root! tree (delete-max-node! (root tree))))) (define (delete-min-tree! tree) (when (node? (root tree)) (set-root! tree (delete-min-node! (root tree))))) ;;; 巡回 (define (for-each-tree fn tree) (for-each-node fn (root tree)))
gosh[r7rs.user]> (define a (make-tree -)) a gosh[r7rs.user]> (for-each-tree display a) #<undef> gosh[r7rs.user]> (for-each (lambda (x) (insert-tree! a x)) '(5 7 3 6 4 8 2 9 1 0)) #<undef> gosh[r7rs.user]> (for-each (lambda (x) (display (search-tree a x)) (newline)) '(5 7 3 6 4 8 2 9 1 0)) 5 7 3 6 4 8 2 9 1 0 #<undef> gosh[r7rs.user]> (search-tree a 10) #f gosh[r7rs.user]> (for-each-tree display a) 0123456789#<undef> gosh[r7rs.user]> (min-tree a) 0 gosh[r7rs.user]> (max-tree a) 9 gosh[r7rs.user]> (delete-min-tree! a) #<undef> gosh[r7rs.user]> (for-each-tree display a) 123456789#<undef> gosh[r7rs.user]> (delete-max-tree! a) #<undef> gosh[r7rs.user]> (for-each-tree display a) 12345678#<undef> gosh[r7rs.user]> (for-each (lambda (x) (delete-tree! a x) (for-each-tree display a) (newline)) '(1 2 3 4 5 6 7 8)) 2345678 345678 45678 5678 678 78 8 #<undef>
;;; ;;; junk2.scm : Scheme Junk Scripts 2 (R7RS-small 対応版) ;;; ;;; Copyright (C) 2006-2021 Makoto Hiroi ;;; (import (scheme base)) ;;; ;;; スタック ;;; (define-record-type Stack (make-stack top) stack? (top top set-top!)) (define (stack-push! st x) (set-top! st (cons x (top st)))) (define (stack-pop! st) (let ((x (car (top st)))) (set-top! st (cdr (top st))) x)) (define (stack-length st) (length (top st))) (define (stack-empty? st) (null? (top st))) ;;; ;;; キュー ;;; (define-record-type Queue (make-queue front rear) queue? (front front set-front!) (rear rear set-rear!)) (define (queue-empty? q) (null? (front q))) (define (enqueue! q x) (let ((cell (list x))) (if (queue-empty? q) (set-front! q cell) (set-cdr! (rear q) cell)) (set-rear! q cell))) (define (dequeue! q) (if (queue-empty? q) (error "dequeue!: empty queue") (let ((x (car (front q)))) (set-front! q (cdr (front q))) (when (null? (front q)) (set-rear! q '())) x))) (define (queue-length q) (length (front q))) ;;; ;;; 循環リスト ;;; ;;; 循環リストの検出 (define (circular-list? ls) (let loop ((xs ls) (ys ls)) (if (and (pair? xs) (pair? (cdr xs))) (if (eq? (cddr xs) (cdr ys)) #t (loop (cddr xs) (cdr ys))) #f))) ;;; 循環リストによるキューの実装 (define-record-type Que (make-que rear-c) que? (rear-c rear-c set-rear-c!)) (define (que-empty? q) (null? (rear-c q))) (define (enq! q x) (let ((xs (list x))) (cond ((que-empty? q) (set-cdr! xs xs)) (else (set-cdr! xs (cdr (rear-c q))) (set-cdr! (rear-c q) xs))) (set-rear-c! q xs))) (define (deq! q) (if (que-empty? q) (error "deq!: empty queue") (let ((front (cdr (rear-c q)))) (if (eq? front (rear-c q)) (set-rear-c! q '()) (set-cdr! (rear-c q) (cdr front))) (car front)))) (define (que-length q) (if (que-empty? q) 0 (let loop ((c 1) (xs (cdr (rear-c q)))) (if (eq? xs (rear-c q)) c (loop (+ c 1) (cdr xs)))))) ;;; ;;; 二分木 ;;; ;;; 節 (define-record-type Node (make-node data left right) node? (data data set-data!) (left left set-left!) (right right set-right!)) ;;; データの探索 (define (search-node node x comp) (if (null? node) #f (let ((r (comp x (data node)))) (cond ((zero? r) (data node)) ((negative? r) (search-node (left node) x comp)) (else (search-node (right node) x comp)))))) ;;; データの挿入 (define (insert-node! node x comp) (if (null? node) (make-node x '() '()) (let ((r (comp x (data node)))) (cond ((zero? r) node) ((negative? r) (set-left! node (insert-node! (left node) x comp)) node) (else (set-right! node (insert-node! (right node) x comp)) node))))) ;;; 最大値の探索 (define (search-max-node node) (if (null? (right node)) (data node) (search-max-node (right node)))) ;;; 最大値の削除 (define (delete-max-node! node) (cond ((null? (right node)) (left node)) (else (set-right! node (delete-max-node! (right node))) node))) ;;; 最小値の探索 (define (search-min-node node) (if (null? (left node)) (data node) (search-min-node (left node)))) ;;; 最小値の削除 (define (delete-min-node! node) (cond ((null? (left node)) (right node)) (else (set-left! node (delete-min-node! (left node))) node))) ;;; データの削除 (define (delete-node! node x comp) (if (null? node) node (let ((r (comp x (data node)))) (cond ((zero? r) (cond ((null? (left node)) (right node)) ((null? (right node)) (left node)) (else (set-data! node (search-min-node (right node))) (set-right! node (delete-min-node! (right node))) node))) ((negative? r) (set-left! node (delete-node! (left node) x comp)) node) (else (set-right! node (delete-node! (right node) x comp)) node))))) ;;; 巡回 (define (for-each-node fn node) (when (node? node) (for-each-node fn (left node)) (fn (data node)) (for-each-node fn (right node)))) ;;; ;;; 二分木 ;;; (define-record-type Tree (create-tree root comp) tree? (root root set-root!) (comp comp)) ;;; 生成 (define (make-tree cmp) (create-tree '() cmp)) ;;; 探索 (define (search-tree tree x) (search-node (root tree) x (comp tree))) (define (max-tree tree) (if (null? (root tree)) #f (search-max-node (root tree)))) (define (min-tree tree) (if (null? (root tree)) #f (search-min-node (root tree)))) ;;; 挿入 (define (insert-tree! tree x) (set-root! tree (insert-node! (root tree) x (comp tree)))) ;;; 削除 (define (delete-tree! tree x) (set-root! tree (delete-node! (root tree) x (comp tree)))) (define (delete-max-tree! tree) (when (node? (root tree)) (set-root! tree (delete-max-node! (root tree))))) (define (delete-min-tree! tree) (when (node? (root tree)) (set-root! tree (delete-min-node! (root tree))))) ;;; 巡回 (define (for-each-tree fn tree) (for-each-node fn (root tree)))