経路の探索
今回は A 地点から B 地点までの道順を求めるといった「経路の探索」と呼ばれる問題を取り上げます。探索にはいろいろな問題があります。たとえば、M.Hiroi's Home Page の主なコンテンツに「パズルの解法」がありますが、あらゆる可能性の中から正解を見つける作業は探索のひとつと考えることができます。
そして、探索でよく用いられる最も基本的なアルゴリズムがバックトラックと幅優先探索です。今回は、この 2 つのアルゴリズムで問題を解いてみましょう。
●グラフとは？
経路はグラフ (graph) というデータ構造を使って表すことができます。一般にグラフというと、 円グラフや折れ線グラフといった図表を思い出す人が多いと思います。数学の「グラフ理論」では、いくつかの点とそれを結ぶ線でできた図形を「グラフ」といいます。次の図を見てください。
図 1 : グラフの例
上図に示すように、グラフは点とそれを接続する線から構成されています。点のことを頂点 (vertex) や節点 (node) と呼び、線のことを辺 (edge) や弧 (arc) と呼びます。また、グラフには 2 種類あって、辺に向きの無いグラフを無向グラフといい、辺に向きがあるグラフを有向グラフといいます。有向グラフは一方通行の道と考えればいいでしょう。 次の図を見てください。
図 2 : 有向グラフと無向グラフ
たとえば、上図の (1) では A 地点から B 地点へ行くことができますが、一方通行のため B 地点から A 地点に戻ることはできません。これが有効グラフです。(2) の無効グラフでは、A 地点から B 地点へ行くことができるし、逆に B 地点から A 地点に戻ることもできます。
データ間のさまざまな関係を表す場合、グラフはとても役に立ちます。たとえば、下図のように経路をグラフで表すことができます。
図 3 : 経路図
上図ではアルファベットで頂点を表しています。この例では経路をグラフで表していますが、このほかにもいろいろな問題をグラフで表現することができます。
●グラフの表現方法
グラフをプログラムする場合、よく使われる方法が隣接行列と隣接リストです。隣接行列は 2 次元配列で頂点の連結を表す方法です。頂点が N 個ある場合、隣接行列は N 行 N 列の行列で表すことができます。上の経路図を隣接行列で表すと次のようになります。
│A B C D E F G
─┼───────
A│0 1 1 0 0 0 0
B│1 0 1 1 0 0 0
C│1 1 0 0 1 0 0
D│0 1 0 0 1 1 0
E│0 0 1 1 0 0 1
F│0 0 0 1 0 0 0
G│0 0 0 0 1 0 0
図 4 : 隣接行列
A に接続している頂点は B と C なので、A 行の B と C に 1 をセットし、接続していない頂点には 0 をセットします。経路が一方通行ではない無向グラフの場合は、A 列の B と C にも 1 がセットされます。これを Lisp でプログラムすると、次のようになります。
List 1 : 隣接行列
(defvar *adjacent*
#2A((0 1 1 0 0 0 0) ; A
(1 0 1 1 0 0 0) ; B
(1 1 0 0 1 0 0) ; C
(0 1 0 0 1 1 0) ; D
(0 0 1 1 0 0 1) ; E
(0 0 0 1 0 0 0) ; F
(0 0 0 0 1 0 0))) ; G
頂点 A から G を数値 0 から 6 に対応させるところがポイントです。隣接行列は 2 次元配列で表します。内容は図 4 の隣接行列と同じです。
隣接行列の欠点は、辺の数が少ない場合でも N 行 N 列の行列が必要になることです。つまり、ほとんどの要素が 0 になってしまい、メモリを浪費してしまうのです。この欠点を補う方法に隣接リストがあります。これはつながっている頂点を格納する方法です。
A => (B C)
B => (A C D)
C => (A B E)
D => (B E F)
E => (C D G)
F => (D)
G => (E)
図 5 : 隣接リスト
これを Lisp でプログラムすると次のようになります。
List 2 : 隣接リスト
(defvar *adjacent*
#((1 2) ; A
(0 2 3) ; B
(0 1 4) ; C
(1 4 5) ; D
(2 3 6) ; E
(3) ; F
(1))) ; G
隣接行列と同様に、頂点 A から G を数値 0 から 6 に対応させます。この場合、ベクタの要素がリストであることに注意してください。
ところで、隣接リストにも欠点があります。たとえば、E と G が接続しているか調べるには、データを順番に調べていくしか方法がありません。このため、接続の判定に時間がかかることがあるのです。まあ、頂点に接続されている辺の数が少なければ、処理速度が極端に遅くなることはないでしょう。
●Lisp らしくグラフを表現する
さて、Lisp でグラフをプログラムするのであれば、わざわざ頂点を数値に変換する必要はありません。頂点はシンボルで表せばいいのです。頂点と隣接リストの対応は、いろいろな方法で表すことができます。たとえば、次のリストを見てください。
List 3 : 連想リスト
(defvar *adjacent*
'((A B C)
(B A C D)
(C A B E)
(D B E F)
(E C D G)
(F D)
(G E)))
List 4 : 属性リスト
(setf (get 'A 'adjacent) '(B C)
(get 'B 'adjacent) '(A C D)
(get 'C 'adjacent) '(A B E)
(get 'D 'adjacent) '(B E F)
(get 'E 'adjacent) '(C D G)
(get 'F 'adjacent) '(D)
(get 'G 'adjacent) '(E))
List 5 : スペシャル変数
(defvar A '(B C))
(defvar B '(A C D))
(defvar C '(A B E))
(defvar D '(B E F))
(defvar E '(C D G))
(defvar F '(D))
(defvar G '(E))
List 3 はグラフを連想リストで表しています。キーが頂点を表すシンボルでデータが隣接リストです。この方法では関数 assoc で頂点の隣接リストを求めることになります。次の例を見てください。
(dolist (node '(A B C D E F G))
(print (cdr (assoc node *adjacent*))))
(B C)
(A C D)
(A B E)
(B E F)
(C D G)
(D)
(E)
nil
assoc で頂点 node を検索して cdr で隣接リストを取り出しています。
List 4 は頂点の隣接リストを属性リストに格納する方法です。ここでは属性名を adjacent としました。隣接リストは関数 get で求めることができます。次の例を見てください。
(dolist (node '(A B C D E F G))
(print (get node 'adjacent)))
(B C)
(A C D)
(A B E)
(B E F)
(C D G)
(D)
(E)
nil
List 5 は隣接リストをスペシャル変数に格納する方法です。この場合、関数 symbol-value を使うと簡単に隣接リストを求めることができます。
symbol-value symbol
symbol-value は引数 symbol のスペシャル変数の値を取り出します。symbol-value は関数なので引数 symbol は評価されることに注意してください。次の例を見てください。
(dolist (node '(A B C D E F G))
(print (symbol-value node)))
(B C)
(A C D)
(A B E)
(B E F)
(C D G)
(D)
(E)
nil
symbol-value の引数 node が評価されると、その値は頂点を表すシンボルになります。そして、symbol-value はそのシンボルのスペシャル変数の値 (隣接リスト) を返します。
●バックトラック
次はバックトラックについて簡単に説明します。たとえば、ある地点 A で道が左右に分かれていたとします。左の道を選んで先へ進むと行き止まりになってしまいました。この場合、A 地点まで戻って右の道へ進まなければいけませんね。このように、失敗したら後戻りして別の選択肢を選び直す、という試行錯誤を繰り返して解を求めるアルゴリズムをバックトラック (backtrack) といいます。
バックトラックは経路の探索だけではなく、いろいろな分野の問題に応用できるアルゴリズムです。そして、バックトラックは再帰呼び出しを使うと簡単にプログラムすることができます。今回は次の経路図で A から G までの経路をバックトラックで求めてみましょう。
図 3 : 経路図 (再掲)
経路の表し方ですが、これはシンボルを並べたリストで表せばいいでしょう。たとえば、A 地点から G 地点までの経路は次のようになります。
A - C - E - G ─→ (A C E G) ==> (G E C A) ; 逆順で管理する
ただし、そのまま並べただけでは探索中の処理が面倒になります。というのは、経路 A - C を E へ延ばす場合、リスト (A C) の最後にシンボル E を追加しなければいけないからです。リストの先頭にデータを追加することは cons や push を使って簡単にできますが、それ以外の場所にデータを追加するのはちょっと面倒です。そこで、経路を逆順に管理することにします。
バックトラックを再帰呼び出しで実現する場合、経路を「進む」ことを再帰呼び出しに対応させるのがポイントです。経路を探索する関数を search としましょう。search は引数としてゴール地点と経路を受け取ることにします。最初は次のように呼び出します。
(search 'G '(A))
経路を逆順で表しているので、リストの先頭要素が現在地点 (経路の先端) を表わしていることに注意してください。そして、A から B へ進むにはリストの先頭に B を追加して search を再帰呼び出しします。
(search 'G '(A)) ─ Call → (search 'G '(B A))
これで A から B へ進むことができます。それでは、A に戻るにはどうしたらいいのでしょう。(search 'G '(B A)) は (search 'G '(A)) から呼び出されたので、(search 'G '(B A)) の実行を終了すれば呼び出し元である (search 'G '(A)) に戻ることができます。
(search 'G '(A)) ─ Call → (search 'G '(B A))
← Return ─
つまり、関数の実行を終了すれば、ひとつ手前の地点にバックトラックできるのです。このように、再帰呼び出しを使うと、進むことと戻ることを関数呼び出しで簡単に実現することができます。プログラムは次のようになります。
List 6 : 経路の探索
; 隣接リストを属性リストに設定
(setf (get 'A 'adjacent) '(B C)
(get 'B 'adjacent) '(A C D)
(get 'C 'adjacent) '(A B E)
(get 'D 'adjacent) '(B E F)
(get 'E 'adjacent) '(C D G)
(get 'F 'adjacent) '(D)
(get 'G 'adjacent) '(E))
; 経路の探索（バックトラック）
(defun search (goal path)
(dolist (node (get (car path) 'adjacent))
(if (eq goal node)
; 経路を表示する
(print (reverse (cons node path)))
(unless (member node path)
; 再帰呼び出し
(search goal (cons node path))))))
経路図を表す隣接リストは属性リストにセットします。関数 search は dolist を使って隣接リスト内の節点をひとつずつ取り出し、ゴールに到達したかチェックします。goal と同じシンボルであれば print で経路を表示します。path にはまだ goal が含まれていないので、先頭に goal を追加してから reverse でリストを反転しています。そして、経路を求めたあとバックトラックすることにより、A から G までの経路をすべて求めることができます。
ゴールに到達していない場合は経路を延ばして探索を進めます。このとき、節点 node が経路 path に含まれていないかチェックすることを忘れないで下さい。そうしないと、同じ道をぐるぐると回る巡回経路が発生し、ゴールである G 地点にたどり着くことができなくなります。それから、path の先頭に node を追加して search を再帰呼び出しします。
search を実行すると、次のような経路を表示します。
(A B C E G)
(A B D E G)
(A C B D E G)
(A C E G)
4 通りの経路を見つけることができました。バックトラックによる探索は経路を先へ先へ進めるので、縦形探索とか深さ優先探索と呼ばれています。このため、結果を見てもわかるように、最初に見つかる経路が最短経路とは限りません。最短経路を求めるには幅優先探索というアルゴリズムが適しています。
●幅優先探索
幅優先探索はすべての経路について平行に探索を進めます。このため、最初に見つかる経路が最短経路になります。幅優先探索の様子を下図に示します。
まず、出発点 A からひとつ進んだ経路 (2 節点) をすべて求めます。この場合は、(A B) と (A C) の 2 つあり、これをすべて記憶しておきます。次に、これらの経路からひとつ進めた経路 (3 節点) をすべて求めます。経路 (A B) は (A B C) と (A B D) へ進めることができますね。ほかの経路 (A C) も同様に進めて、すべての経路を記憶します。あとは、この作業をゴールに達するまで繰り返せばいいのです。
上図では、4 節点の経路 (A C E G) でゴールに達していることがわかります。このように幅優先探索では、最初に見つかった経路が最短距離 (または最小手数) となるのです。この性質は、すべての経路を平行に進めていく探索順序から考えれば当然のことといえるでしょう。このことから、バックトラックの縦形探索に対して幅優先探索は横形探索と呼ばれます。このあとも探索を繰り返せばすべての経路を求めることができます。
ただし、探索を進めるにしたがって、記憶しておかなければならないデータの総数が爆発的に増加する、つまりメモリを大量消費することに注意してください。上図の場合ではメモリを大量消費することはありませんが、問題によってはマシンに搭載されているメモリが不足するため、幅優先探索を実行できない場合もあるでしょう。したがって、幅優先探索を使う場合はメモリの消費量を抑える工夫も必要になります。
幅優先探索のプログラムはキューを使うと簡単です。キューの説明は リストの破壊的修正 の「リストによるキューの実装」をお読みください。幅優先探索でのキューの動作を下図に示します。
最初は、(1) のように出発点をキューにセットしておきます。次に、キューから経路を取り出し、(2) のように経路 (A) をひとつ進めて、経路 (A B) (A C) を作り、それをキューに追加します。(3) では、経路 (A B) を取り出して、ひとつ進めた経路 (A B C) と (A B D) をキューに追加します。あとはキューに経路があるあいだ処理を繰り返せばいいわけです。
キューは先入れ先出し (FIFO) の性質を持つデータ構造なので、距離の短い経路から順番に処理されるため「幅優先探索」として機能するのです。
それではプログラムを作りましょう。
List 7 : キューと幅優先探索
; ***** キューの定義 (再掲) *****
(defstruct Queue (front nil) (rear nil))
; データを入れる
(defun enqueue (queue item)
(let ((new-cell (list item)))
(if (Queue-front queue)
; 最終セルを書き換える
(setf (cdr (Queue-rear queue)) new-cell)
; キューは空の状態
(setf (Queue-front queue) new-cell))
(setf (Queue-rear queue) new-cell)))
; データを取り出す
(defun dequeue (queue)
(if (Queue-front queue)
(prog1
(pop (Queue-front queue))
(unless (Queue-front queue)
; キューは空になった
(setf (Queue-rear queue) nil)))))
; ***** 幅優先探索 *****
(defun breadth-search (goal start)
(let ((queue (make-Queue)) path)
; 出発点をキューにセット
(enqueue queue (list start))
(while (setq path (dequeue queue))
(dolist (node (get (car path) 'adjacent))
(if (eq goal node)
; 経路を表示する
(print (reverse (cons node path)))
(unless (member node path)
; 経路をキューに追加
(enqueue queue (cons node path))))))))
関数 breadth-search は start から goal までの経路を幅優先探索で求めます。最初に make-Queue でキューを生成し、出発点 (start) だけの経路をキューにセットします。そして while でキューからデータを取り出して経路をのばしていきます。あとはバックトラックのプログラム (List 6) とほぼ同じですが、ひとつのばした経路は enqueue でキューに追加するところに注意してください。それでは実行してみましょう。
(breadth-search 'G 'A)
(A C E G)
(A B C E G)
(A B D E G)
(A C B D E G)
nil
結果を見ればおわかりのように、最初に見つかる経路が最短で、最後に見つかる経路が最長となります。当然ですが経路の総数は 4 通りになります。
ちょっと寄り道
■反復深化
幅優先探索は最短手数を求めるのに適したアルゴリズムですが、生成する局面数が多くなると大量のメモリを必要とします。このため、メモリが不足するときには使うことができないという欠点があります。逆に深さ優先探索の場合、メモリの消費量は少ないのですが、最初に見つかる解が最短手数とは限らないという問題点があります。
それでは、大量のメモリを使わずに最短手数を求める方法はないのでしょうか。実は、とても簡単な方法があるのです。それは、深さ優先探索の「深さ」に上限値を設定し、解が見つかるまで上限値を段階的に増やしていくという方法です。
たとえば、1 手で解が見つからない場合は 2 手までを探索し、それでも見つからない場合は 3 手までを探索するというように、制限値を 1 手ずつ増やしていくわけです。このアルゴリズムを反復深化 (iterative deeping) といいます。
反復深化は最短手数を求めることができるアルゴリズムですが、幅優先探索と違って局面を保存する必要がないため、必要となるメモリは深さ優先探索と同程度で済みます。また、プログラムも深さ優先探索と同じくらい簡単に作成することができます。ただし、同じ探索を何度も繰り返すため実行時間が増大する、という欠点があります。ようするに、使用するメモリは少ないが実行時間が長くなるアルゴリズムなのです。
■反復深化による経路の探索
それでは、次の経路図で A から G までの経路を反復深化で求めてみましょう。
図 3 : 経路図 (再掲)
反復深化のプログラムはとても簡単です。設定した上限値まで深さ優先探索を行う関数を作り、上限値を 1 手ずつ増やしてその関数を呼び出せばいいのです。プログラムは次のようになります。
List 8 : 反復深化による経路の探索
; 隣接リストを属性リストに設定
(setf (get 'A 'adjacent) '(B C)
(get 'B 'adjacent) '(A C D)
(get 'C 'adjacent) '(A B E)
(get 'D 'adjacent) '(B E F)
(get 'E 'adjacent) '(C D G)
(get 'F 'adjacent) '(D)
(get 'G 'adjacent) '(E))
; 経路の探索（反復深化）
(defun search-id (limit goal path)
(if (= limit (length path))
(if (eq goal (car path))
; 経路を表示
(print (reverse path)))
(dolist (node (get (car path) 'adjacent))
(unless (member node path)
; 再帰呼び出し
(search-id limit goal (cons node path))))))
関数 search-id の引数 limit が上限値を表します。search-id は limit まで深さ優先探索を行います。経路の長さを length で求めて、これが上限値 limit に達したら探索を打ち切ります。このとき goal に到達したかチェックします。あとは、limit の値を増やしながら search-id を呼び出せばいいわけです。それでは実行結果を示しましょう。
(dotimes (x 7)
(format t "~%~D手の探索" (1+ x))
(search-id (1+ x) 'G '(A)))
1手の探索
2手の探索
3手の探索
4手の探索
(A C E G)
5手の探索
(A B C E G)
(A B D E G)
6手の探索
(A C B D E G)
7手の探索
nil
結果を見ればおわかりのように、最初に見つかる解が最短手数になります。このプログラムではすべての経路を求めましたが、最短手数を求めるだけでよい場合は、解が見つかった時点で探索を終了すればいいでしょう。
生成検定法
今回は生成検定法（generate and test) という方法を説明します。生成検定法は問題を解くときによく用いられる方法で、正解の可能性があるデータを生成してチェックすることで正解をひとつ、またはすべて見つけ出すことができます。可能性のあるデータをもれなく作るのにバックトラックは最適です。ただし、「生成するデータ数が多くなると時間がとてもかかる」という弱点があるので注意してください。今回は簡単な「小町算」を解いてみましょう。
●小町算
パズルの世界では、1 から 9 までの数字を 1 個ずつすべて使った数字を小町数といいます。たとえば、123456789 とか 321654987 のような数字です。また、123 + 456 + 789 とか 321 * 654 + 987 のように、1 から 9 までの数字を 1 個ずつすべて使った式を小町算といいます。
小町算のパズルでは『1 から 9 までの数字を順番に並べ、間に＋、－を補って 100 になる式を作る』という問題が有名です。このパズルは拙作のページ ちょっと寄り道「小町数と小町算」 で取り上げています。興味のある方は読んでみてください。それでは今回の問題です。
[問題] 小町虫食い算
下図の A から I の場所に 1 から 9 までの数字をひとつずつ配置する。3 つの数値 ABC, DEF, GHI を足したら 999 になる配置をすべて求めよ。
A B C
D E F
+ G H I
----------
9 9 9
ただし、3 つの数値は奇数で ABC < DEF < GHI の条件を満たすものとする。
●プログラムを作る
数字の配置は 1 から 9 までの順列を生成すればいいでしょう。今回のプログラムは生成した順列をリストに格納します。そして、リストの要素と場所を下図のように対応させます。
場所 A B C D E F G H I
----------------------------
リスト (1 8 9 2 6 7 5 4 3)
----- ----- -----
数値 189 267 543
場所と要素の対応
あとはリストから 3 つの数値を求めて、条件を満たしているかチェックすればいいわけです。プログラムは次のようになります。
List 9 : パズル「小町虫食い算」の解法（遅いバージョン）
(defun solve (&optional (numbers '(1 2 3 4 5 6 7 8 9)) perm)
(if numbers
(dolist (x numbers)
(solve (remove x numbers) (cons x perm)))
(check perm)))
; 先頭の 3 つの要素を数値に変換
(defun make-number (perm)
(let ((value 0))
(dotimes (x 3 value)
(setq value (+ (* value 10) (pop perm))))))
; チェック
(defun check (perm)
(let ((abc (make-number perm))
(def (make-number (nthcdr 3 perm)))
(ghi (make-number (nthcdr 6 perm))))
(if (and (oddp abc)
(oddp def)
(oddp ghi)
(< abc def ghi)
(= (+ abc def ghi) 999))
(format t "~D + ~D + ~D = 999~%" abc def ghi))))
関数 solve で順列を生成して、関数 check で条件を満たしているかチェックします。単純なプログラムなので、とくに難しいところはないと思います。それでは実行してみましょう。処理系は xyzzy Lisp で、M.Hiroi のオンボロマシン (Pentium 166 MHz) で実行しました。
(solve)
189 + 267 + 543 = 999
169 + 287 + 543 = 999
・・・省略・・・
163 + 247 + 589 = 999
143 + 267 + 589 = 999
解はぜんぶで 36 とおりで、実行時間は約 160 秒でした。オンボロマシンとはいえ、けっこう時間がかかっていますね。なぜかというと、失敗することがわかっている順列も生成してしまうからです。数値は 3 つとも奇数なので、1 桁目の C, F, I は奇数でなければいけませんね。ところが、このプログラムでは C, F, I のどれかが偶数でも順列を生成してしまいます。順列を発生させてからチェックする方法では、このような無駄を省くことができないのです。
●枝刈りによる高速化
それではプログラムを改良してみましょう。今度は数値をひとつ生成するたびに条件を満たしているかチェックすることにします。プログラムは次のようになります。
List 10 : パズル「小町虫食い算」の解法（改良バージョン）
(defun solve-fast (&optional (n 0) (numbers '(1 2 3 4 5 6 7 8 9)) (value 0) num-list)
(if numbers
(if (= n 3)
; 数値がひとつ完成した
(if (and (oddp value)
(apply #'> value num-list))
(solve-fast 0 numbers 0 (cons value num-list)))
; 数値を作っている途中
(dolist (x numbers)
(solve-fast (1+ n) (remove x numbers) (+ (* value 10) x) num-list)))
; 数値が３つ完成した
(if (and (oddp value)
(apply #'> value num-list)
(= (apply #'+ value num-list) 999))
(format t "~D + ~D + ~D = 999~%" (second num-list) (first num-list) value))))
関数 solve-fast の引数 value は数値を計算するための累算変数です。solve-fast を再帰呼び出しするときに、value を 10 倍して選んだ数字 x を足していけば数値を計算することができます。
3 つの数字を選ぶと引数 n は 3 になります。数値がひとつ完成したので、value が奇数であることと前に求めた数値より大きいことをチェックします。num-list の値が nil だと関数 > の引数はひとつになりますが、Common Lisp の仕様で (> number) は真を返すので問題ありません。それから、ここで solve-fast を再帰呼び出しするときは、引数 n と value には 0 を渡すことと、求めた数値 value は num-list のリストへ追加することに注意してください。
数値が 3 つ完成すると numbers は空リスト (nil) になります。3 つめの数値 value をチェックしたら、3 つの数値の合計が 999 になることを確かめます。これでプログラムは完成です。
実際に実行してみたところ、時間は 19.3 秒に短縮されました。このように、できるだけ早い段階でチェックを入れることで、無駄なデータをカットすることを枝刈りと呼びます。生成検定法で問題を解く場合、この枝刈りのよしあしによって実行時間が大きく左右されます。ところが、枝刈りのやり方は問題によって大きく変わります。問題固有の性質をよく調べて、適切な枝刈りを考えることが重要なのです。
ところで、関数名に fast をつけましたが、実行時間はまだまだ遅いですね。実をいうと、この問題ではもっと効率の良い枝刈りの方法があります。その方法でプログラムを作ると、M.Hiroi のオンボロマシンでも 1 秒もかからずに解を求めることができます。
●小町虫食い算の高速化
それではプログラムの高速化に挑戦します。今回は 2 つの方法を試してみましょう。ひとつめは solve-fast (List 10) の改良バージョンです。solve-fast は 3 つの数値を生成してからチェックしていますが、2 つの数値 abc と def を決めてしまえば、残りの数値 ghi は計算で求めることができますね。あとは求めた ghi が小町数の条件を満たすかチェックすればいいわけです。プログラムは次のようになります。
List 11 : パズル「小町虫食い算」の解法（高速バージョン）
; ２つの数値を生成する
(defun solve-very-fast (&optional (n 0) (numbers '(1 2 3 4 5 6 7 8 9)) (value 0) (abc 0))
(if (= n 3)
(if (and (oddp value) (< abc value))
(if (plusp abc)
(check-fast abc value numbers)
(solve-very-fast 0 numbers 0 value)))
(dolist (x numbers)
(solve-very-fast (1+ n) (remove x numbers) (+ (* 10 value) x) abc))))
; 小町算の条件を満たすかチェックする
(defun check-fast (abc def numbers)
(let ((ghi (- 999 abc def)) n)
(when (< def ghi)
(dotimes (x 3 (format t "~D + ~D + ~D = 999~%" abc def (- 999 abc def)))
(setq n (mod ghi 10)
ghi (truncate ghi 10))
(if (member n numbers)
(setq numbers (remove n numbers))
(return))))))
関数 solve-very-fast は 2 つの数値 abc と def を生成します。引数 abc が 0 ならば value はひとつめの数値で、abc が 0 より大きければ value はふたつめの数値です。2 つの数値を生成したら関数 check-fast を呼び出して条件を満たしているかチェックします。
check-fast は最初に ghi を計算で求めます。ghi は必ず奇数になるので (oddp ghi) のチェックは必要ありません。ghi が def より大きいことを確かめたら、ghi が残りの数字 numbers で生成できるかチェックします。この処理は ghi を 1 桁ずつ分解して、数字 n が numbers にあるか member で確認します。見つけた場合は numbers から n を削除します。見つからない場合は条件を満たさないので return で dotimes から脱出します。dotimes が正常に終了すれば小町数の条件を満たしているので format で解を出力します。
これでプログラムは完成です。さっそく実行してみたところ時間は 5.5 秒までに短縮されました。solve-fast よりも 3.5 倍の高速化に成功しましたが、very-fast というにはまだまだ遅いですね。そこで、もうひとつの方法を試してみましょう。
●小町虫食い算の超高速化
もうひとつの方法は数値をひとつずつ生成するのではなく、最初に 1 桁目 (C, F, I) の数字、次に 2 桁目の数字 (B, E, H)、最後に 3 桁目の数字を選んでいく方法です。そして、1, 2 桁目の場合は数字の合計が 9 または 19、3 桁目の場合は数字の合計が 9 になることをチェックします。これで効率よく枝刈りを行うことができます。ただし、数字の合計が 19 の場合は桁上がりの処理が必要になることをお忘れなく。プログラムは次のようになります。
List 12 : パズル「小町虫食い算」の解法（超高速バージョン）
; １桁目の数字を選ぶ
(defun solve-1 (&optional (n 0) (numbers '(1 2 3 4 5 6 7 8 9)) perm)
(if (= n 3)
(multiple-value-bind
(q r)
(truncate (apply #'+ perm) 10)
(if (= r 9)
(solve-2 0 numbers perm q)))
(dolist (x numbers)
(if (oddp x)
(solve-1 (1+ n) (remove x numbers) (cons x perm))))))
; ２桁目の数字を選ぶ
(defun solve-2 (n numbers perm over)
(if (= n 3)
(multiple-value-bind
(q r)
(truncate (apply #'+ over (subseq perm 0 3)) 10)
(if (= r 9)
(solve-3 0 numbers perm q)))
(dolist (x numbers)
(solve-2 (1+ n) (remove x numbers) (cons x perm) over))))
; ３桁目の数字を確認する
(defun solve-3 (n numbers perm over)
(when (= 9 (apply #'+ over numbers))
(dolist (x numbers) (push x perm))
(print-answer perm)))
; 解を表示する
(defun print-answer (perm)
(let ((abc 0) (def 0) (ghi 0))
(dotimes (x 3 (format t "~D + ~D + ~D = 999~%" abc def ghi))
(setq ghi (+ (* ghi 10) (pop perm))
def (+ (* def 10) (pop perm))
abc (+ (* abc 10) (pop perm))))))
関数 solve-1 は 1 桁目の数字 (C, F, I) を選びます。3 つの数値は奇数なので、1 桁目の数字は奇数を選ぶように oddp でチェックしています。選んだ数字は引数 perm のリストに格納します。数字を 3 つ選んだら合計が 9 または 19 になることを確認します。multiple-value-bind は複数の値 (多値) を受け取るためのマクロです。
一般に、関数の返り値はひとつしかありません。複数の値を返す場合、Lisp ではリストに格納して返すのがふつうです。ところが、Common Lisp の多値 (Multiple Values) という機能を使うと、複数の値を簡単にやり取りすることができます。
関数 truncate は割り算を行って商と余りを返します。ふつうに truncate を呼び出すと商を返すだけですが、multiple-value-bind を使うと商のほかに余りも受け取ることができます。q と r は truncate が返す値を受け取る変数です。多値の詳しい説明は拙作のページ 複数の値を返す方法（多値） をお読みくださいませ。
apply でリストに格納された 3 つの数値を足し算し、それを truncate で割り算します。商は q に余りは r に格納されるので、r が 9 になることをチェックすればいいわけです。合計が 19 の場合は桁上がりの処理が必要になります。変数 q には 0 または 1 がセットされているので、それを solve-2 に渡して足し算すれば大丈夫です。
関数 solve-2 は 2 桁目の数字 (B, E, H) を選びます。数字を 3 つ選んだら合計が 9 または 19 になることを確かめます。perm には (H E B I F C) の順番で数字が格納されているので、先頭の 3 つの数字だけを足し算します。このとき、solve-1 からの桁上がり over をいっしょに加算することを忘れないで下さいね。
3 桁目の数字を選ぶ関数 solve-3 はとても簡単です。残りの数字 numbers と over の合計が 9 になることを確認するだけです。numbers に格納された数字は昇順に並んでいるので、先頭から a, d, g に割り当てれば abc < def < ghi を満たすことができます。dolist で数字をひとつずつ取り出して perm へ追加します。これで perm には (G D A H E B I F C) の順番に数字が格納されます。これを関数 print-answer に渡して、数値に変換して解を表示します。
これでプログラムは完成です。さっそく実行してみたところ時間は 0.3 - 0.5 秒までに短縮されました。とても速くなりましたね。このほかにも、もっと効率の良い枝刈りがあるかもしれません。興味のある方は考えてみてください。
ちょっと寄り道
■大町数と大町算
パズルの世界では小町数に 0 を加えた数を大町数といいます。そして、0 から 9 までの 10 個の数字を 1 個ずつ使った計算を大町算といいます。ただし、0123456789 のように最上位の桁に 0 を入れることはできません。今回は大町数のパズルを生成検定法で解いてみましょう。それでは問題です。
[問題] ３数で大町どうさま
ある連続した３数 (n, n+1, n+2) を掛け合わせたら、大町数になったという。そのような３数をすべて見つけてほしい。もちろん、負の数は考えない。
出典：『Ｃマガ電脳クラブ』 Ｃマガジン 1998 年 2 月号（ソフトバンク）
Ｃ言語でプログラムを作る場合、大町数は整数 (32 bit) の範囲を超えるためちょっとした工夫が必要になりますが、Common Lisp だと簡単にプログラムを作ることができます。
それではプログラムを作りましょう。最初に整数 n の範囲を絞り込みます。大町数の最大値は 9876543210 で最小値は 1023456789 ですから、n の値は次の範囲内になります。
(expt 1023456789 1/3) => 1007.759
(* 1006 1007 1008) => 1021146336 < 1023456789
(expt 9876543210 1/3) => 2145.532
(* 2145 2146 2147) => 9883005990 > 9876543210
(expt x y) は x の y 乗を返します。これらの計算結果から n は 1007 以上 2144 以下であることがわかります。n の範囲がぐっと狭くなりましたね。これならば、あとは単純に計算して大町数になるかチェックすればいいでしょう。プログラムは次のようになります。
List 13 : パズル「３数で大町どうさま」の解法
(defun solve ()
(do ((n 1007 (1+ n)))
((> n 2144))
(check n (1+ n) (+ n 2))))
(defun check (n1 n2 n3)
(let ((value (* n1 n2 n3)) numbers)
(dotimes (x 10 (format t "~D * ~D * ~D = ~D~%" n1 n2 n3 (* n1 n2 n3)))
(multiple-value-bind
(q r)
(truncate value 10)
(if (member r numbers) (return))
(push r numbers)
(setq value q)))))
プログラムは単純な生成検定法です。関数 solve で 1007 から 2144 までの数値を生成して、関数 check で大町数になるかチェックします。check は 3 つの数字を受け取り、それらを掛け算して value にセットします。value は 10 桁の数値になるので、大町数であれば 10 個の数字がちょうどひとつずつあるはずです。したがって、数字が重複していないことを確認すればいいわけです。
truncate で 1 桁ずつ数字を取り出して、新しい数字を numbers に格納します。このとき、同じ数字がないか member でチェックします。同じ数字が見つかれば大町数ではないので、return で dotimes から脱出します。新しい数字であれば、その数字を numbers に格納して value の値を更新します。value が大町数の条件を満たしていれば dotimes は正常に終了するので、最後に format で解を出力します。
これでプログラムは完成です。さっそく実行してみましょう。
(solve)
1267 * 1268 * 1269 = 2038719564
1332 * 1333 * 1334 = 2368591704
nil
2 通りの解を見つけることができました。
