幅優先探索とスライドパズル
今回は幅優先探索の具体的な例題として、15 パズルでお馴染みのスライドパズル（スライディングブロックパズル）を Lisp で解いてみましょう。なお、このドキュメントは拙作の パズルでプログラミング 「第 2 回 幅優先探索と 15 パズル」 のプログラムを Lisp で書き直したものです。内容は重複していますが、ご了承くださいませ。
●スライドパズルの説明
図 1 : 15 パズル
文献 [1] によると、15 パズルはアメリカのサム・ロイドが 1870 年代に考案したパズルで、彼はパズルの神様と呼ばれるほど有名なパズル作家だそうです。15 パズルは上図に示すように、1 から 15 までの駒を並べるパズルです。駒の動かし方は、1 回に 1 個の駒を空いている隣の場所に滑らせる、というものです。駒を飛び越したり持ち上げたりすることはできません。
15 パズルの場合、駒の配置は空き場所がどこでもいいことにすると、16! (約 2e13) 通りもあります。実際には、15 パズルの性質 [*1] からその半分になるのですが、それでもパソコンで扱うにはあまりにも大きすぎる数です。そこで、盤面を六角形に変形し、1 から 6 までの数字を並べる 6 パズルを考えることにします。
図 2 : 6 パズル
上図は 6 パズルをグラフで表したものです。0 が空き場所を表します。ここには 3, 4, 6 の駒を動かすことができます。6 パズルは単純に考えると駒の配置は 7! = 5040 通りとなります。これならば簡単に解くことができそうです。
●6 パズルの解法
6 パズルの盤面はリストを使って表します。盤面の位置とリストの対応は下図を見てください。
盤面:(1 5 2 6 3 4 0) 盤面とリストの対応 図 3 : 6 パズルの盤面
隣接リストとキューの定義は次のようになります。
List 1 : 隣接リストとキューの定義
; 隣接リスト
(defvar *adjacent* #((1 2 3) ; 0
(0 3 4) ; 1
(0 3 5) ; 2
(0 1 2 4 5 6) ; 3
(1 3 6) ; 4
(2 3 6) ; 5
(3 4 5))) ; 6
; キューの定義
(defvar *state* (make-array 5040)) ; 局面を格納する
(defvar *prev* (make-array 5040)) ; ひとつ前の局面
(defvar *space* (make-array 5040)) ; 空き場所の位置
このプログラムではベクタを使ってキューを定義します。ベクタによるキューの実装は拙作のページ ちょっと寄り道「ベクタによるキューの実装」 で詳しく説明しているので参考にしてください。6 パズルの局面は最大で 5040 通りなので、キュー（ベクタ）の大きさは 5040 とします。
次は移動手順の管理を考えます。最短手順を求めるだけならば、すべての手順を記憶しておく必要はありません。n 手目の移動で作られた局面が n 手目以前の局面で出現しているのであれば、n 手より短い手数で到達する移動手順があるはずです。したがって、この n 手の手順を記憶しておく必要はないのです。そこで、キューには局面だけを格納し、手順は番号で管理することにします。
| No | *state* | *prev* |
|---|---|---|
| 0 | (1 5 2 6 3 4 0) | -1 |
| 1 | (1 5 2 0 3 4 6) | 0 |
| 2 | (1 5 2 6 0 4 3) | 0 |
| 3 | (1 5 2 6 3 0 4) | 0 |
| 4 | (0 5 2 1 3 4 6) | 1 |
| 5 | (1 0 2 5 3 4 6) | 1 |
| 6 | (1 5 0 2 3 4 6) | 1 |
| 7 | (1 5 2 3 0 4 6) | 1 |
| 8 | (1 5 2 4 3 0 6) | 1 |
上表を使って具体的に説明しましょう。局面はベクタ *state* に格納します。このときの添字がその局面の番号になります。そして、その 1 手前の局面の番号をベクタ *prev* に格納します。まず最初の局面を (aref *state* 0) にセットします。(aref *prev* 0) には終端を表すため -1 をセットします。
それから、駒を移動して 1 手目の局面を生成します。移動できる駒は 3 種類あるので、新しく生成される局面は 3 つとなります。それぞれ、(aref *state* 1) から (aref *state* 3) にセットし、*prev* には元になった局面 (aref *state* 0) の番号 0 をセットします。
次に、2 手目の局面を生成します。(aref *state* 1) で駒を動かして生成される局面は 6 つありますが、そのうちのひとつは元の局面に戻るので、新しい局面は 5 つになります。これらを (aref *state* 4) から (aref *state* 8) にセットします。このときの *prev* には、元になった局面 (aref *state* 1) の番号 1 がセットされます。
あとは同様に、キューから局面を取り出して駒を動かし、新しい局面であればキューに登録することを繰り返します。最終状態と同じ局面になったときは、*prev* をたどることで手順を再現することができます。
駒の移動は動かすことができる駒を探すよりも、空き場所を基準に考えた方が簡単です。その局面での空き場所の位置をベクタ *space* に記憶しておきます。新しい局面を作るときは、空き場所に隣接している駒を隣接リストから求め、それを空き場所に移動させればいいわけです。
●プログラムの作成
それではプログラムを作りましょう。最初に、駒を移動して新しい局面を作る関数 move-piece を作ります。
List 2 : 駒を動かす
(defun move-piece (piece board)
(cond ((null board) nil)
((= piece (car board))
(cons 0 (move-piece piece (cdr board))))
((= 0 (car board))
(cons piece (move-piece piece (cdr board))))
(t (cons (car board) (move-piece piece (cdr board))))))
関数 move-piece は局面 board の駒 piece を動かした局面を生成して返します。駒の移動はリストをコピーして空き場所 (0) と piece を交換するだけですが、move-piece はこの処理を再帰呼び出しで実現しています。リストをコピーしている途中で、0 を見つけたら piece に、piece を見つけたら 0 に置き換えます。これで piece を動かした局面を生成することができます。
次は、幅優先探索を行う関数 solve-b を作ります。
List 3 : 6 パズルの解法(1)
; 幅優先探索
(defun solve-b (start goal)
(let ((rear 1) (front 0))
; 初期化
(setf (aref *state* 0) start
(aref *prev* 0) -1
(aref *space* 0) (position 0 start))
; キューにデータがある間繰り返す
(while (< front rear)
(let ((space (aref *space* front))
(board (aref *state* front)) new-board)
(dolist (pos (aref *adjacent* space))
(setq new-board (move-piece (nth pos board) board))
; 同一局面のチェック
(unless (find new-board *state* :end rear :test #'equal)
; キューに書き込む
(setf (aref *state* rear) new-board
(aref *space* rear) pos
(aref *prev* rear) front)
(incf rear)
; ゴールの判定
(when (equal new-board goal)
(print-answer (1- rear))
(return-from solve-b)))))
(incf front))))
プログラムの骨格は 経路の探索 で説明した幅優先探索と同じです。関数 solve-b の引数 start がスタートの局面で、goal がゴールの局面です。変数 front と rear はキューの先頭と末尾を表します。最初に初期状態 start をキューに登録するので rear の値は 1 に初期化します。あとはキューから局面を取り出して、駒を動かした局面が新しい局面ならばキューに登録する処理を繰り返します。
move-piece で駒を動かして変数 new-board に局面をセットします。次に、関数 find で *state* に new-board と同じ局面がないかチェックします。比較するデータはリストなので、キーワード :test には equal を設定します。また、ベクタ *state* を全部探索する必要はないので、キーワード :end で探索範囲 (0 から rear まで) を指定します。
new-board が新しい局面であればキューに登録します。そして、ゴールに到達したか equal でチェックします。そうであれば、関数 print-answer で解を表示し、return-from で solve-b から脱出します。
解を表示する関数 print-answer は簡単です。
List 4 : 解の表示
(defun print-answer (pos)
(if (/= pos 0)
(print-answer (aref *prev* pos)))
(print (aref *state* pos)))
局面を表すリストを print でそのまま出力します。*prev* を順番にたどって出力すると、手順は逆順に表示されてしまいます。そこで、再帰呼び出しを使って最初の状態に戻り、そこから局面を順番に出力させます。
●実行結果
これでプログラムは完成です。それでは実行してみましょう。
(solve-b '(1 5 2 6 3 4 0) '(1 2 3 4 5 6 0)) (1 5 2 6 3 4 0) (1 5 2 0 3 4 6) (0 5 2 1 3 4 6) (2 5 0 1 3 4 6) (2 5 1 0 3 4 6) (2 5 1 3 0 4 6) (2 0 1 3 5 4 6) (0 2 1 3 5 4 6) (1 2 0 3 5 4 6) (1 2 3 0 5 4 6) (1 2 3 4 5 0 6) (1 2 3 4 5 6 0) nil
11 手で解くことができました。このときの実行時間は 13.2 秒 (Pentium 166 MHz) もかかっています。簡単に解けると思っていたのですが、けっこう時間がかかりますね。
時間がかかる理由のひとつは、同一局面のチェックを行う関数 find にあります。線形探索は配列の先頭から順番にデータを比較していくため、その実行時間はデータ数に比例します。今回生成された局面は 2818 個だったのですが、ひとつの局面から複数の局面を生成し、それを検索するのですから、データの比較回数は相当の数になるでしょう。時間がかかるのは当然のことなのです。
●6 パズルの高速化
このようなときの常套手段が、線形探索に代えて高速な検索アルゴリズムを使うことです。ハッシュ法や二分探索木など、優れたアルゴリズムを使うことで、実行時間を大幅に短縮することができます。ところが、幅優先探索の場合にはもうひとつ方法があります。出発点から探索するだけではなくゴール地点からも探索を行うことで、生成される局面数を大幅に減らすことができるのです。
その理由を説明するために、簡単なシミュレーションをしてみましょう。たとえば、1 手進むたびに 3 つの局面が生成され、5 手で解けると仮定します。すると、n 手目で生成される局面は 3 の n 乗個になるので、初期状態から単純に探索すると、生成される局面の総数は、3 + 9 + 27 + 81 + 243 = 363 個となります。
これに対し、初期状態と終了状態から同時に探索を始めた場合、お互い 3 手まで探索した時点で同じ局面に到達する、つまり、解を見つけることができます。この場合、生成される局面の総数は 3 手目までの局面数を 2 倍した 78 個となります。
生成される局面数はぐっと少なくなりますね。局面数が減少すると同一局面の検索処理に有利なだけではなく、「キューからデータを取り出して新しい局面を作る」という根本的な処理のループ回数を減らすことになるので、処理速度は大幅に向上するのです。
●プログラムの修正
それではプログラムを作りましょう。単純に考えると、2 つの探索処理を交互に行うことになりますが、そうするとプログラムの大幅な修正が必要になります。ここは、探索方向を示すフラグを用意することで、ひとつのキューだけで処理することにしましょう。メモリを余分に使うことになりますが、プログラムの修正は最小限で済みます。
(defvar *direction* (make-array 5040)) ; 探索の方向
探索方向はベクタ *direction* に格納します。初期状態からの探索はシンボル forward を、終了状態からの探索はシンボル backward をセットします。探索プログラムは次のようになります
List 5 : 6 パズルの解法(2)
; 幅優先探索 (start, goal 双方向からの探索)
(defun solve-b1 (start goal)
(let ((rear 2) (front 0))
; 初期化
(setf (aref *state* 0) start
(aref *prev* 0) -1
(aref *space* 0) (position 0 start)
(aref *direction* 0) 'forward
(aref *state* 1) goal
(aref *prev* 1) -1
(aref *space* 1) (position 0 goal)
(aref *direction* 1) 'backward)
;
(while (< front rear)
(let ((space (aref *space* front))
(board (aref *state* front)) new-board x)
(dolist (pos (aref *adjacent* space))
(setq new-board (move-piece (nth pos board) board))
; 同一局面のチェック
(setq x (position new-board *state* :end rear :test #'equal))
(cond ((null x)
; キューに書き込む
(setf (aref *state* rear) new-board
(aref *space* rear) pos
(aref *prev* rear) front
(aref *direction* rear) (aref *direction* front))
(incf rear))
((not (eq (aref *direction* x) (aref *direction* front)))
; 発見
(print-answer1 front x)
(return-from solve-b1)))))
(incf front))))
キューの初期化では最初に初期状態を、次に終了状態をセットします。2 つのデータをセットしたのですから、変数 rear の値は 2 に初期化することに注意してください。最初に、初期状態から 1 手目の局面が生成され、次に最終状態から 1 手目の局面が生成されます。あとは、交互に探索が行われます。
駒の移動は同じなので説明は省略しますが、*direction* の値をセットする処理を追加していることに注意してください。*direction* の値を比較するため、同一局面の検索には find ではなく position を使って、見つけた局面の番号を返すようにします。同じ局面を見つけたとき、*direction* を比較して探索方向が異なっていれば、2 方向の探索で同一局面に到達したことがわかります。見つけた最短手順を print-answer1 で出力します。同じ探索方向であれば、キューへの追加は行いません。
手順の表示は探索方向によって処理が異なるので、print-answer1 で振り分けます。
List 6 : 解の表示
(defun print-answer-forward (pos)
(if (/= pos 0)
(print-answer-forward (aref *prev* pos)))
(print (aref *state* pos)))
(defun print-answer-backward (pos)
(while (/= pos -1)
(print (aref *state* pos))
(setq pos (aref *prev* pos))))
(defun print-answer1 (p1 p2)
(cond ((eq (aref *direction* p1) 'forward)
(print-answer-forward p1)
(print-answer-backward p2))
(t (print-answer-forward p2)
(print-answer-backward p1))))
初期状態からの手順を表示する関数が print-answer-forward です。この処理は、今までの print-answer と同じです。終了状態までの手順を表示するのが print-answer-backward です。これは *prev* を順番にたどって表示するだけなので、繰り返しで簡単にプログラムできます。これでプログラムは完成です。
さっそく実行してみると、生成された局面数は 341 個で、実行時間は 0.28 秒でした。50 倍弱の高速化ですね。予想していた以上の効果に、M.Hiroi もたいへん驚きました。
●参考文献
- 井上うさぎ 『世界のパズル百科イラストパズルワンダーランド』 東京堂出版 1997
●プログラムリスト
;
; six_b.l : 幅優先探索による 6 パズルの解法
;
; Copyright (C) 2002 Makoto Hiroi
;
; キューの定義
(defvar *state* (make-array 5040)) ; 局面を格納する
(defvar *prev* (make-array 5040)) ; ひとつ前の局面
(defvar *space* (make-array 5040)) ; 空き場所の位置
(defvar *direction* (make-array 5040)) ; 探索の方向
; 隣接リスト
(defvar *adjacent* #((1 2 3) ; 0
(0 3 4) ; 1
(0 3 5) ; 2
(0 1 2 4 5 6) ; 3
(1 3 6) ; 4
(2 3 6) ; 5
(3 4 5))) ; 6
; 駒を動かす（リストはコピーされる）
(defun move-piece (piece board)
(cond ((null board) nil)
((= piece (car board))
(cons 0 (move-piece piece (cdr board))))
((= 0 (car board))
(cons piece (move-piece piece (cdr board))))
(t (cons (car board) (move-piece piece (cdr board))))))
; 解の表示
(defun print-answer (pos)
(if (/= pos 0)
(print-answer (aref *prev* pos)))
(print (aref *state* pos)))
; 幅優先探索
(defun solve-b (start goal)
(let ((rear 1) (front 0))
; 初期化
(setf (aref *state* 0) start
(aref *prev* 0) -1
(aref *space* 0) (position 0 start))
; キューにデータがある間繰り返す
(while (< front rear)
(let ((space (aref *space* front))
(board (aref *state* front)) new-board)
(dolist (pos (aref *adjacent* space))
(setq new-board (move-piece (nth pos board) board))
; 同一局面のチェック
(unless (find new-board *state* :end rear :test #'equal)
; キューに書き込む
(setf (aref *state* rear) new-board
(aref *space* rear) pos
(aref *prev* rear) front)
(incf rear)
; ゴールの判定
(when (equal new-board goal)
(print-answer (1- rear))
(return-from solve-b)))))
(incf front))))
; 解の表示
(defun print-answer-forward (pos)
(if (/= pos 0)
(print-answer-forward (aref *prev* pos)))
(print (aref *state* pos)))
(defun print-answer-backward (pos)
(while (/= pos -1)
(print (aref *state* pos))
(setq pos (aref *prev* pos))))
(defun print-answer1 (p1 p2)
(cond ((eq (aref *direction* p1) 'forward)
(print-answer-forward p1)
(print-answer-backward p2))
(t (print-answer-forward p2)
(print-answer-backward p1))))
; 幅優先探索 (start, goal 双方向からの探索)
(defun solve-b1 (start goal)
(let ((rear 2) (front 0))
; 初期化
(setf (aref *state* 0) start
(aref *prev* 0) -1
(aref *space* 0) (position 0 start)
(aref *direction* 0) 'forward
(aref *state* 1) goal
(aref *prev* 1) -1
(aref *space* 1) (position 0 goal)
(aref *direction* 1) 'backward)
;
(while (< front rear)
(let ((space (aref *space* front))
(board (aref *state* front)) new-board x)
(dolist (pos (aref *adjacent* space))
(setq new-board (move-piece (nth pos board) board))
; 同一局面のチェック
(setq x (position new-board *state* :end rear :test #'equal))
(cond ((null x)
; キューに書き込む
(setf (aref *state* rear) new-board
(aref *space* rear) pos
(aref *prev* rear) front
(aref *direction* rear) (aref *direction* front))
(incf rear))
((not (eq (aref *direction* x) (aref *direction* front)))
; 発見
(print-answer1 front x)
(return-from solve-b1)))))
(incf front))))
