今回は幅優先探索の例題として、15 パズルで有名な「スライドパズル (スライディングブロックパズル)」を解いてみましょう。
参考文献 1 『世界のパズル百科イラストパズルワンダーランド』によると、15 パズルはアメリカのサム・ロイドが 1870 年代に考案したパズルで、彼はパズルの神様と呼ばれるほど有名なパズル作家だそうです。
┌─┬─┬─┬─┐ │１│２│３│４│ ├─┼─┼─┼─┤ │５│６│７│８│ ├─┼─┼─┼─┤ │９│10│11│12│ ├─┼─┼─┼─┤ │13│14│15│ │ └─┴─┴─┴─┘ 図 : 15 パズル
15 パズルは上図に示すように、1 から 15 までの駒を並べるパズルです。駒の動かし方は、1 回に 1 個の駒を空いている隣の場所に滑らせる、というものです。駒を跳び越したり持ち上げたりすることはできません。
15 パズルの場合、駒の配置は空き場所がどこでもいいことにすると、16! (約 2e13) 通りもあります。実際には、15 パズルの性質からその半分になるのですが、それでもパソコンで扱うにはあまりにも大きすぎる数です。そこで、盤面を一回り小さくした、1 から 8 までの数字を並べる「8 パズル」を考えることにします。
┌─┬─┬─┐ ┌─┬─┬─┐
│１│２│３│ │１│２│３│
├─┼─┼─┤ ├─┼─┼─┤
│４│５│６│ │４│５│６│
├─┼─┼─┤ ├─┼─┼─┤
│７│８│ │ │８│７│ │
└─┴─┴─┘ └─┴─┴─┘
（１）完成形 （２）不可能な局面
図 : 8 パズル
15 パズルは 4 行 4 列の盤ですが、8 パズルは 3 行 3 列の盤になります。8 パズルの場合、駒の配置は空き場所がどこでもいいことにすると、9! = 362880 通りあります。15 パズルや 8 パズルの場合、参考文献 2 『特集コンピュータパズルへの招待 スライディングブロック編』によると 『適当な 2 つの駒をつまみ上げて交換する動作を偶数回行った局面にしか移行できない』 とのことです。
上図 (2) は 7 と 8 を入れ替えただけの配置です。この場合、交換の回数が奇数回のため完成形に到達することができない、つまり解くことができないのです。このような性質を「偶奇性 (パリティ)」といいます。詳しい説明は拙作のページ Puzzle DE Programming: 「偶奇性 (パリティ) のお話」をお読みください。8 パズルの場合、完成形に到達する局面の総数は 9! / 2 = 181440 個となります。
それでは、プログラムを作りましょう。下図に示すスタートから完成形 (ゴール) に到達するまでの最短手数を幅優先探索で求めます。
┌─┬─┬─┐ ┌─┬─┬─┐
│８│６│７│ │１│２│３│
├─┼─┼─┤ ├─┼─┼─┤
│２│５│４│ │４│５│６│
├─┼─┼─┤ ├─┼─┼─┤
│３│ │１│ │７│８│ │
└─┴─┴─┘ └─┴─┴─┘
スタート ゴール
図 : 8 パズル
8 パズルの盤面はベクタを使って表します。盤面の位置とベクタの添字の対応は下図を見てください。
┌─┬─┬─┐ ┌─┬─┬─┐
│１│２│３│ │０│１│２│
├─┼─┼─┤ ├─┼─┼─┤
│４│５│６│ │３│４│５│
├─┼─┼─┤ ├─┼─┼─┤
│７│８│ │ │６│７│８│
└─┴─┴─┘ └─┴─┴─┘
盤面: #(1 2 3 盤面と配列の対応
4 5 6
7 8 0)
図 : 8 パズルの盤面
隣接リストの定義は次のようになります。
リスト : 隣接リスト
(defconstant adjacent
#((1 3) ; 0
(0 2 4) ; 1
(1 5) ; 2
(0 4 6) ; 3
(1 3 5 7) ; 4
(2 4 8) ; 5
(3 7) ; 6
(4 6 8) ; 7
(5 7))) ; 8
次は局面を表す構造体を定義します。
リスト : 局面の定義 (defstruct state board space prev)
スロット BOARD は盤面を表すベクタ、スロット SPACE は空き場所の位置、スロット PREV は 1 手前の局面を格納します。ゴールに到達したら、prev をたどって手順を表示します。
それでは幅優先探索のプログラムを作りましょう。次のリストを見てください。
リスト : 幅優先探索
(defun solver-bfs (start goal)
(let ((q (make-queue))
(ht (make-hash-table :test #'equalp)))
(setf (gethash start ht)
(enqueue q (make-state :board start :space (position 0 start) :prev nil)))
(loop
(if (emptyp q) (return))
(let* ((st (dequeue q))
(bd (state-board st))
(sp (state-space st)))
(dolist (x (aref adjacent sp))
(let ((newbd (move-piece bd x sp)) newst)
(unless (gethash newbd ht)
(setq newst (make-state :board newbd :space x :prev st))
(cond
((equalp newbd goal)
(print-answer newst)
(return-from solver-bfs))
(t
(setf (gethash newbd ht)
(enqueue q newst)))))))))))
関数 solver-bfs の引数 START がスタートの盤面で、GOAL がゴールの盤面です。幅優先探索はキューを使うと簡単にプログラムできます。今回は拙作のページ「構造体」で作成したプログラムをちょっと改造して使うことにします。
最初に、関数 make-queue でキューを生成して変数 Q にセットします。それから、START の局面を関数 make-state で生成してキューに登録します。enqueue は挿入した要素を返すように修正しています。変数 HT は同一盤面をチェックするためのハッシュ表を格納します。盤面はベクタで表しているので、:test には #'equalp を指定します。
幅優先探索の場合、手数を 1 つずつ増やしながら探索を行います。このため、n 手目の移動で作られた局面が n 手以前の局面で出現している場合、n 手より短い手数で到達する移動手順が必ず存在します。最短手順を求めるのであれば、この n 手の手順を探索する必要はありません。ハッシュ表 HT をチェックして新しい局面だけキューに登録します。
次の loop で、GOAL に到達するまで探索を繰り返します。キューが空になり loop が終了する場合、START は GOAL に到達できない、つまり解くことができなかったことになります。キューから局面を取り出して変数 ST にセットします。そして、盤面を変数 BD に、空き場所の位置を変数 SP にセットします。
駒の移動は関数 move-piece で行います。動かせる駒の位置は空き場所の隣なので、隣接リストから求めることができます。move-piece に空き場所の位置 SP と移動する駒の位置 X を渡して、新しい盤面 NEWBD を作成します。同じ盤面が無い場合、GOAL に到達したか述語 equalp でチェックします。GOAL と等しい場合は、関数 print-answer で手順を表示してから return-from でループを脱出します。GOAL に到達していない場合はハッシュ表とキューに新しい局面を登録します。
あとのプログラムは簡単なので、説明は省略いたします。詳細はプログラムリスト１をお読みください。
これでプログラムは完成です。それでは実行してみましょう。
* (time (solver-bfs #(8 6 7 2 5 4 3 0 1) #(1 2 3 4 5 6 7 8 0))) #(8 6 7 2 5 4 3 0 1) #(8 6 7 2 0 4 3 5 1) #(8 0 7 2 6 4 3 5 1) #(0 8 7 2 6 4 3 5 1) #(2 8 7 0 6 4 3 5 1) #(2 8 7 3 6 4 0 5 1) #(2 8 7 3 6 4 5 0 1) #(2 8 7 3 6 4 5 1 0) #(2 8 7 3 6 0 5 1 4) #(2 8 0 3 6 7 5 1 4) #(2 0 8 3 6 7 5 1 4) #(2 6 8 3 0 7 5 1 4) #(2 6 8 0 3 7 5 1 4) #(2 6 8 5 3 7 0 1 4) #(2 6 8 5 3 7 1 0 4) #(2 6 8 5 3 7 1 4 0) #(2 6 8 5 3 0 1 4 7) #(2 6 0 5 3 8 1 4 7) #(2 0 6 5 3 8 1 4 7) #(2 3 6 5 0 8 1 4 7) #(2 3 6 0 5 8 1 4 7) #(2 3 6 1 5 8 0 4 7) #(2 3 6 1 5 8 4 0 7) #(2 3 6 1 5 8 4 7 0) #(2 3 6 1 5 0 4 7 8) #(2 3 0 1 5 6 4 7 8) #(2 0 3 1 5 6 4 7 8) #(0 2 3 1 5 6 4 7 8) #(1 2 3 0 5 6 4 7 8) #(1 2 3 4 5 6 0 7 8) #(1 2 3 4 5 6 7 0 8) #(1 2 3 4 5 6 7 8 0) Evaluation took: 0.345 seconds of real time 0.343750 seconds of total run time (0.328125 user, 0.015625 system) [ Run times consist of 0.046 seconds GC time, and 0.298 seconds non-GC time. ] 99.71% CPU 829,444,199 processor cycles 76,190,848 bytes consed NIL 実行環境 : Ubunts 18.04 (Windows Subsystem for Linux), Intel Core i5-6200U 2.30GHz
31 手で解くことができました。生成した局面はゴールを含めて 181440 通りで、実行時間は 0.35 秒かかりました。8 パズルの場合、最長手数は 31 手で、下図に示す 2 通りの局面があります。スタートの局面はその一つです。
┌─┬─┬─┐ ┌─┬─┬─┐
│８│６│７│ │６│４│７│
├─┼─┼─┤ ├─┼─┼─┤
│２│５│４│ │８│５│ │
├─┼─┼─┤ ├─┼─┼─┤
│３│ │１│ │３│２│１│
└─┴─┴─┘ └─┴─┴─┘
図 : 31 手で解ける局面
最長手数の局面は、幅優先探索を使って求めることができます。これはあとで試してみましょう。
ところで、今回の 8 パズルのようにゴールの状態が明確な場合、スタートから探索するだけではなくゴールからも探索を行うことで、幅優先探索を高速化することができます。これを「双方向探索 (bi-directional search)」といいます。
その理由を説明するために、簡単なシミュレーションをしてみましょう。たとえば、1 手進むたびに 3 つの局面が生成され、5 手で解けると仮定します。すると、n 手目で生成される局面は 3 の n 乗個になるので、初期状態から単純に探索すると、生成される局面の総数は、3 + 9 + 27 + 81 + 243 = 363 個となります。
これに対し、初期状態と終了状態から同時に探索を始めた場合、お互い 3 手まで探索した時点で同じ局面に到達する、つまり、解を見つけることができます。この場合、生成される局面の総数は 3 手目までの局面数を 2 倍した 78 個となります。
生成される局面数はぐっと少なくなりますね。局面数が減少すると同一局面の探索処理に有利なだけではなく、「キューからデータを取り出して新しい局面を作る」という根本的な処理のループ回数を減らすことになるので、処理速度は大幅に向上するのです。
それではプログラムを作りましょう。単純に考えると、2 つの探索処理を交互に行うことになりますが、そうするとプログラムの大幅な修正が必要になります。ここは、探索方向を示すフラグを用意することで、一つのキューだけで処理することにしましょう。局面を表す構造体に方向を示すスロット DIR を追加します。
リスト : 局面の定義 (双方向からの探索) (defstruct bi-state board space dir prev)
スタートからの探索をシンボル F で、ゴールからの探索をシンボル B で表ます。双方向探索のプログラムは次のようになります。
リスト : 双方向探索
(defun solver-bi (start goal)
(let ((q (make-queue))
(ht (make-hash-table :test #'equalp)))
(setf (gethash start ht)
(enqueue q (make-bi-state :board start :space (position 0 start) :dir 'f :prev nil))
(gethash goal ht)
(enqueue q (make-bi-state :board goal :space (position 0 goal) :dir 'b :prev nil)))
(loop
(if (emptyp q) (return))
(let* ((st (dequeue q))
(bd (bi-state-board st))
(sp (bi-state-space st)))
(dolist (x (aref adjacent sp))
(let* ((newbd (move-piece bd x sp))
(st2 (gethash newbd ht)))
(cond
((not st2)
;; 同じ局面がない
(setf (gethash newbd ht)
(enqueue q (make-bi-state :board newbd :space x :dir (bi-state-dir st) :prev st))))
((not (eq (bi-state-dir st) (bi-state-dir st2)))
;; 方向が異なっている同じ盤面がある
(print-bi-answer st st2)
(return-from solver-bi)))))))))
スタートとゴールの局面を生成してキューとハッシュ表に登録します。最初に、スタートの状態から 1 手目の局面が生成され、次にゴールの状態から 1 手目の局面が生成されます。あとは、交互に探索が行われます。それから、同一局面を見つけたとき、その局面の方向を比較する必要があるので、ハッシュ表には局面を表す構造体をセットします。
駒の移動と局面の生成処理は幅優先探索と同じです。新しい局面 NEWBD を生成して、同じ局面がないかハッシュ表を探索して結果を変数 ST2 にセットします。同じ局面を見つけたとき、ST と ST2 の探索方向が異なっていれば、双方向からの探索で同一局面に到達したことがわかります。見つけた最短手順を関数 print-bi-answer で出力します。同じ探索方向であれば、キューへの追加は行いません。
あとのプログラムは簡単なので、説明は省略いたします。詳細はプログラムリスト１をお読みください。
それでは実行してみましょう。
* (time (solver-bi #(8 6 7 2 5 4 3 0 1) #(1 2 3 4 5 6 7 8 0))) #(8 6 7 2 5 4 3 0 1) #(8 6 7 2 0 4 3 5 1) #(8 0 7 2 6 4 3 5 1) ・・・省略・・・ #(1 2 3 4 5 6 0 7 8) #(1 2 3 4 5 6 7 0 8) #(1 2 3 4 5 6 7 8 0) Evaluation took: 0.032 seconds of real time 0.031250 seconds of total run time (0.015625 user, 0.015625 system) 96.88% CPU 75,777,642 processor cycles 5,083,696 bytes consed NIL
生成された局面数は 16088 個で、実行時間は 0.032 秒でした。局面数は約 1 / 11 になり、実行時間も約 11 倍と高速になりました。
今度は最長手数の局面を求めてみましょう。最長手数の求め方ですが、181440 通りの配置の最短手数がすべてわかれば、最長の手数となる配置を求めることができます。しかし、この方法では時間がとてもかかりそうです。そこで、完成形から始めていちばん長い手数の局面を生成することにします。
まず、完成形から駒を動かして 1 手で到達する局面をすべて作ります。次に、これらの局面から駒を動かして新しい局面を作れば、完成形から 2 手で到達する局面となります。このように、手数を 1 手ずつ伸ばしていき、新しい局面が生成できなくなった時点での手数が求める最長手数となります。この処理は幅優先探索を使えばぴったりです。このプログラムの目的は、いちばん長い手数となる配置を求めることなので、その手順を表示することは行いません。このため、1 手前の局面を格納する第 3 要素 prev は不要になります。
それではプログラムを作ります。次のリストを見てください。
リスト : 8 パズルの最長手数を求める
(defun solver-max (start)
(let ((ht (make-hash-table :test #'equalp))
(old-states (list (make-state :board start :space (position 0 start))))
(new-states nil)
(m 0))
(loop
(dolist (st old-states)
(let ((bd (state-board st))
(sp (state-space st)))
(dolist (x (aref adjacent sp))
(let ((newbd (move-piece bd x sp)))
(unless (gethash newbd ht)
(setf (gethash newbd ht) t)
(push (make-state :board newbd :space x) new-states))))))
(unless new-states
;; old-state が最長手数
(format t "max moves = ~d~%" m)
(dolist (st old-states)
(format t "~A~%" (state-board st)))
(return))
(setq old-states new-states
new-states nil)
(incf m))))
関数 solver-max にはゴールをチェックする処理がないことに注意してください。生成できる局面がなくなるまで処理を繰り返します。このプログラムではキューを使わないで、OLD-STATES と NEW-STATES という 2 つのリストに局面を格納することにします。
OLD-STATES にある局面から新しい局面を生成して、それを NEW-STATES にセットします。NEW-STATES にデータがない場合、新しい局面は生成されなかったので繰り返しを終了します。このとき、OLD-STATES に格納されている局面が最長手数となります。手数は変数 M でカウントします。
さっそく実行してみましょう。
* (time (solver-max #(1 2 3 4 5 6 7 8 0))) max moves = 31 #(8 6 7 2 5 4 3 0 1) #(6 4 7 8 5 0 3 2 1) Evaluation took: 0.417 seconds of real time 0.421875 seconds of total run time (0.328125 user, 0.093750 system) [ Run times consist of 0.093 seconds GC time, and 0.329 seconds non-GC time. ] 101.20% CPU 1,001,091,460 processor cycles 76,122,944 bytes consed NIL
最長手数は 31 手で、その配置は全部で 2 通りになります。実行時間は 0.42 秒でした。
┌┬┬┬┬┬┐ ┌─┬─┬─┐
├┘│││└┤ │┌┼─┼┐│
├─┼┴┼─┤ ├┼┼─┼┼┤
├─┤ ├─┤ │││ │││
├─┼┬┼─┤ ├┼┼─┼┼┤
├┐│││┌┤ │└┼─┼┘│
└┴┴┴┴┴┘ └─┴─┴─┘
ＳＴＡＲＴ ＧＯＡＬ
図 : スライドパズル
「8 パズル」の変形バージョンです。このスライドパズルは数字ではなく 6 種類の駒 (┘┐┌└│─) を使います。─と│は 2 個ずつあるので駒は全部で 8 個になります。START から GOAL までの最短手順を求めてください。
問題 A, B から GOAL までの最短手順を求めてください。
┌───┬─┬─┐ ┌─┬─┬───┐ ┌───┬─┬─┐
│ 電球 │Ｏ│Ｎ│ │Ｎ│Ｏ│ 電球 │ │ 電球 │Ｎ│Ｏ│
├─┬─┼─┼─┤ ├─┼─┼─┬─┤ ├─┬─┼─┼─┤
│Ｏ│Ｆ│Ｆ│ │ │Ｆ│Ｏ│Ｆ│ │ │Ｏ│Ｆ│Ｆ│ │
└─┴─┴─┴─┘ └─┴─┴─┴─┘ └─┴─┴─┴─┘
問題Ａ 問題Ｂ ＧＯＡＬ
図 : NO-OFF
スライドパズル NO-OFF は、問題 A の "ON-OFF" を GOAL のように "NO-OFF" にチェンジするパズルです。NO-OFF は芦ヶ原伸之氏が考案されたパズルで、C MAGAZINE 1991 年 1 月号の「Ｃマガ電脳クラブ」でも出題されています。問題 B は GOAL からの最長手数の局面のひとつです。このパズルは局面の総数が少ないにもかかわらず、手数がけっこうかかる面白いパズルです。
;;;
;;; eight.lisp : 幅優先探索による 8 パズルの解法
;;;
;;; Copyright (C) 2020 Makoto Hiroi
;;;
;;;
;;; キュー
;;;
(defstruct queue (front nil) (rear nil))
;;; キューは空か？
(defun emptyp (q)
(null (queue-front q)))
;;; データの挿入
(defun enqueue (q item)
(let ((new-cell (list item)))
(if (emptyp q)
;; キューは空の状態
(setf (queue-front q) new-cell)
;; 最終セルを書き換える
(setf (cdr (queue-rear q)) new-cell))
(setf (queue-rear q) new-cell))
;; item を返すように変更
item)
;;; データを取得
(defun dequeue (q)
(unless (emptyp q)
(prog1
(pop (queue-front q))
(when (emptyp q)
;; キューは空になった
(setf (queue-rear q) nil)))))
;;; 盤面
;;; 0 1 2
;;; 3 4 5
;;; 6 7 8
;;; 隣接リスト
(defconstant adjacent
#((1 3) ; 0
(0 2 4) ; 1
(1 5) ; 2
(0 4 6) ; 3
(1 3 5 7) ; 4
(2 4 8) ; 5
(3 7) ; 6
(4 6 8) ; 7
(5 7))) ; 8
;;; 局面
(defstruct state board space prev)
;;; 駒の移動
(defun move-piece (board x space)
(let ((newbd (copy-seq board)))
(setf (aref newbd space) (aref newbd x)
(aref newbd x) 0)
newbd))
;;; 解の表示
(defun print-answer (st)
(when (state-prev st)
(print-answer (state-prev st)))
(format t "~A~%" (state-board st)))
;;; 幅優先探索
(defun solver-bfs (start goal)
;; 初期化
(let ((q (make-queue))
(ht (make-hash-table :test #'equalp)))
(setf (gethash start ht)
(enqueue q (make-state :board start :space (position 0 start) :prev nil)))
(loop
(if (emptyp q) (return))
(let* ((st (dequeue q))
(bd (state-board st))
(sp (state-space st)))
(dolist (x (aref adjacent sp))
(let ((newbd (move-piece bd x sp)) newst)
(unless (gethash newbd ht)
(setq newst (make-state :board newbd :space x :prev st))
(cond
((equalp newbd goal)
(print-answer newst)
(return-from solver-bfs))
(t
(setf (gethash newbd ht)
(enqueue q newst)))))))))))
;;;
;;; 双方向探索
;;;
;;; 局面
(defstruct bi-state board space dir prev)
;;; 解の表示
(defun print-fw-answer (st)
(when (bi-state-prev st)
(print-fw-answer (bi-state-prev st)))
(format t "~A~%" (bi-state-board st)))
(defun print-bk-answer (st)
(when st
(format t "~A~%" (bi-state-board st))
(print-bk-answer (bi-state-prev st))))
(defun print-bi-answer (st1 st2)
(cond
((eq (bi-state-dir st1) 'f)
(print-fw-answer st1)
(print-bk-answer st2))
(t
(print-fw-answer st2)
(print-bk-answer st1))))
;;; 双方向探索
(defun solver-bi (start goal)
;; 初期化
(let ((q (make-queue))
(ht (make-hash-table :test #'equalp)))
(setf (gethash start ht)
(enqueue q (make-bi-state :board start :space (position 0 start) :dir 'f :prev nil))
(gethash goal ht)
(enqueue q (make-bi-state :board goal :space (position 0 goal) :dir 'b :prev nil)))
(loop
(if (emptyp q) (return))
(let* ((st (dequeue q))
(bd (bi-state-board st))
(sp (bi-state-space st)))
(dolist (x (aref adjacent sp))
(let* ((newbd (move-piece bd x sp))
(st2 (gethash newbd ht)))
(cond
((not st2)
;; 同じ局面がない
(setf (gethash newbd ht)
(enqueue q (make-bi-state :board newbd :space x :dir (bi-state-dir st) :prev st))))
((not (eq (bi-state-dir st) (bi-state-dir st2)))
;; 方向が異なっている同じ盤面がある
(print-bi-answer st st2)
(return-from solver-bi)))))))))
;;;
;;; 最長手数の局面を求める
;;;
(defun solver-max (start)
(let ((ht (make-hash-table :test #'equalp))
(old-states (list (make-state :board start :space (position 0 start))))
(new-states nil)
(m 0))
(loop
(dolist (st old-states)
(let ((bd (state-board st))
(sp (state-space st)))
(dolist (x (aref adjacent sp))
(let ((newbd (move-piece bd x sp)))
(unless (gethash newbd ht)
(setf (gethash newbd ht) t)
(push (make-state :board newbd :space x) new-states))))))
(unless new-states
;; old-state が最長手数
(format t "max moves = ~d~%" m)
(dolist (st old-states)
(format t "~A~%" (state-board st)))
(return))
(setq old-states new-states
new-states nil)
(incf m))))
このスライドパズルは 6 種類の駒 (┘┐┌└│─) を使っています。─と│は 2 個ずつあるので、局面の総数は次のようになります。
駒は次のように整数で表すことにします。
0: 空き場所 1: ┌ 2: ─ 3: ┐ 4: │ 5: └ 6: ┘
そうすると、8 パズルで作成したプログラムをそのまま利用することができます。それでは実行してみましょう。
* (time (solver-bi #(6 4 5 2 0 2 3 4 1) #(1 2 3 4 0 4 5 2 6))) #(6 4 5 2 0 2 3 4 1) #(6 4 5 2 4 2 3 0 1) #(6 4 5 2 4 2 0 3 1) #(6 4 5 0 4 2 2 3 1) #(0 4 5 6 4 2 2 3 1) #(4 0 5 6 4 2 2 3 1) #(4 5 0 6 4 2 2 3 1) #(4 5 2 6 4 0 2 3 1) #(4 5 2 6 4 1 2 3 0) #(4 5 2 6 4 1 2 0 3) #(4 5 2 6 0 1 2 4 3) #(4 0 2 6 5 1 2 4 3) #(4 2 0 6 5 1 2 4 3) #(4 2 1 6 5 0 2 4 3) #(4 2 1 6 5 3 2 4 0) #(4 2 1 6 5 3 2 0 4) #(4 2 1 6 0 3 2 5 4) #(4 2 1 0 6 3 2 5 4) #(4 2 1 2 6 3 0 5 4) #(4 2 1 2 6 3 5 0 4) #(4 2 1 2 0 3 5 6 4) #(4 0 1 2 2 3 5 6 4) #(4 1 0 2 2 3 5 6 4) #(4 1 3 2 2 0 5 6 4) #(4 1 3 2 2 4 5 6 0) #(4 1 3 2 2 4 5 0 6) #(4 1 3 2 0 4 5 2 6) #(4 1 3 0 2 4 5 2 6) #(0 1 3 4 2 4 5 2 6) #(1 0 3 4 2 4 5 2 6) #(1 2 3 4 0 4 5 2 6) Evaluation took: 0.015 seconds of real time 0.015625 seconds of total run time (0.015625 user, 0.000000 system) 106.67% CPU 36,005,642 processor cycles 4,790,240 bytes consed NIL
最小手数は 30 手になりました。実は、GOAL から最長手数となる局面が START なのです。生成した局面数は 14560 個、実行時間は 0.015 秒でした。双方向探索はやっぱり速いですね。手順を図で示すと次のようになります。空き場所は □ で表しています。
┘│└ ─□─ ┐│┌ ┘│└ ┘│└ ┘│└ □│└ │□└ │└□ │└─ │└─ │└─ │└─ ─│─ ─│─ □│─ ┘│─ ┘│─ ┘│─ ┘│□ ┘│┌ ┘│┌ ┘□┌ ┐□┌ □┐┌ ─┐┌ ─┐┌ ─┐┌ ─┐┌ ─┐┌ ─┐□ ─□┐ ─│┐ │□─ │─□ │─┌ │─┌ │─┌ │─┌ │─┌ │─┌ │─┌ │─┌ ┘└┌ ┘└┌ ┘└□ ┘└┐ ┘└┐ ┘□┐ □┘┐ ─┘┐ ─┘┐ ─□┐ ─│┐ ─│┐ ─│┐ ─│□ ─□│ ─└│ ─└│ □└│ └□│ └┘│ │□┌ │┌□ │┌┐ │┌┐ │┌┐ │┌┐ │┌┐ □┌┐ ┌□┐ ┌─┐ ──┐ ──┐ ──□ ──│ ──│ ─□│ □─│ │─│ │─│ │□│ └┘│ └┘│ └┘│ └┘□ └□┘ └─┘ └─┘ └─┘ └─┘ └─┘
ちなみに、最長手数の局面は全部で次の 6 通りあります。
* (time (solver-max #(1 2 3 4 0 4 5 2 6))) max moves = 30 #(6 4 5 2 0 4 3 2 1) #(6 4 5 4 0 2 3 2 1) #(6 2 5 4 0 4 3 2 1) #(6 2 5 2 0 4 3 4 1) #(6 2 5 4 0 2 3 4 1) #(6 4 5 2 0 2 3 4 1) Evaluation took: 0.139 seconds of real time 0.140625 seconds of total run time (0.140625 user, 0.000000 system) 101.44% CPU 334,767,307 processor cycles 38,071,728 bytes consed NIL
これを図に示すと次のようになります。
┘─└ ┘─└ ┘│└ ┘│└ ┘│└ ┘─└ │□─ ─□│ ─□│ ─□─ │□─ │□│ ┐│┌ ┐│┌ ┐─┌ ┐│┌ ┐─┌ ┐─┌
生成した局面数は 90720 個になりました。しがたって、 このパズルは駒をランダムに配置しても、必ずゴールに到達できることがわかります。
このパズルは局面の総数が 540 通りしかありません。
電球(3 通り) * 空き場所(6 通り) * N (5 通り) * O (4C2 = 6 通り) = 540 通り
解は幅優先探索で簡単に求めることができます。詳細はプログラムリスト２をお読みください。ちなみに、GOAL までの最長手数は 56 手で、局面は全部で 3 通りあります。問題 B はその中の 1 つです。
* (solver-max #(L1 L2 N O O F F S)) max moves = 56 #(N O L1 L2 F O F S) #(F N L1 L2 O O F S) #(O F L1 L2 N O F S) 540
┌─┬─┬───┐ ┌─┬─┬───┐ ┌─┬─┬───┐
│Ｆ│Ｎ│ 電球 │ │Ｎ│Ｏ│ 電球 │ │Ｏ│Ｆ│ 電球 │
├─┼─┼─┬─┤ ├─┼─┼─┬─┤ ├─┼─┼─┬─┤
│Ｏ│Ｏ│Ｆ│ │ │Ｆ│Ｏ│Ｆ│ │ │Ｎ│Ｏ│Ｆ│ │
└─┴─┴─┴─┘ └─┴─┴─┴─┘ └─┴─┴─┴─┘
図 : 最長手数の局面
L L が電球を表し、_ が空き場所を表します。
(0) (1) (2) (3) (4) (5) (6) (7) L L O N L L O _ L L _ O _ L L O O L L O O L L O O L L O O L L O O F F _ O F F N O F F N O F F N _ F F N F _ F N F F _ N F F N _ (8) (9) (10) (11) (12) (13) (14) (15) O L L _ O _ L L _ O L L F O L L F O L L F _ L L F L L _ F L L O F F N O F F N O F F N O _ F N O F _ N O F O N O F O N O F O N _ (16) (17) (18) (19) (20) (21) (22) (23) F L L O F L L O F L L O _ L L O L L _ O L L O _ L L O N L L O N F O _ N F _ O N _ F O N F F O N F F O N F F O N F F O _ F F _ O (24) (25) (26) (27) (28) (29) (30) (31) L L _ N _ L L N F L L N F L L N F L L N F L L N F L L _ F _ L L F F O O F F O O _ F O O F _ O O F O _ O F O O _ F O O N F O O N (32) (33) (34) (35) (36) (37) (38) (39) F O L L F O L L _ O L L O _ L L O L L _ O L L N O L L N O L L N F _ O N _ F O N F F O N F F O N F F O N F F O _ F F _ O F _ F O (40) (41) (42) (43) (44) O L L N _ L L N L L _ N L L N _ L L N O _ F F O O F F O O F F O O F F O O F F _
L L が電球を表し、_ が空き場所を表します。
(0) (1) (2) (3) (4) (5) (6) (7) N O L L N O L L N O L L N _ L L N L L _ N L L F N L L F N L L F F O F _ F O _ F F _ O F F O O F F O O F F O O _ F O _ O F _ O O (8) (9) (10) (11) (12) (13) (14) (15) N L L F _ L L F L L _ F L L F _ L L F O L L F O L L _ O _ L L O _ F O O N F O O N F O O N F O O N F O _ N F _ O N F F O N F F O (16) (17) (18) (19) (20) (21) (22) (23) N L L O N L L O N L L O N L L O N L L _ N _ L L _ N L L F N L L _ F F O F _ F O F F _ O F F O _ F F O O F F O O F F O O _ F O O (24) (25) (26) (27) (28) (29) (30) (31) F N L L F _ L L F L L _ F L L O F L L O F L L O F L L O _ L L O F _ O O F N O O F N O O F N O _ F N _ O F _ N O _ F N O F F N O (32) (33) (34) (35) (36) (37) (38) (39) L L _ O L L N O L L N O L L N _ L L _ N _ L L N F L L N F L L N F F N O F F _ O F F O _ F F O O F F O O F F O O _ F O O F _ O O (40) (41) (42) (43) (44) (45) (46) (47) F L L N F L L N F L L _ F _ L L F O L L F O L L _ O L L O _ L L F O _ O F O O _ F O O N F O O N F _ O N _ F O N F F O N F F O N (48) (49) (50) (51) (52) (53) (54) (55) O L L _ O L L N O L L N O L L N O L L N _ L L N L L _ N L L N _ F F O N F F O _ F F _ O F _ F O _ F F O O F F O O F F O O F F O (56) L L N O O F F _
;;;
;;; nooff.lisp : NO-OFF パズルの解法
;;;
;;; Copyright (C) 2020 Makoto Hiroi
;;;
;;;
;;; キュー
;;;
(defstruct queue (front nil) (rear nil))
;;; キューは空か？
(defun emptyp (q)
(null (queue-front q)))
;;; データの挿入
(defun enqueue (q item)
(let ((new-cell (list item)))
(if (emptyp q)
;; キューは空の状態
(setf (queue-front q) new-cell)
;; 最終セルを書き換える
(setf (cdr (queue-rear q)) new-cell))
(setf (queue-rear q) new-cell))
;; item を返すように変更
item)
;;; データを取得
(defun dequeue (q)
(unless (emptyp q)
(prog1
(pop (queue-front q))
(when (emptyp q)
;; キューは空になった
(setf (queue-rear q) nil)))))
;;; 盤面
;;; 0 1 2 3
;;; 4 5 6 7
;;; 駒
;;; S : 空, L1, L2 : 電球
;;; N, F, O
;;; 隣接リスト
(defconstant adjacent
#((1 4) ; 0
(0 2 5) ; 1
(1 3 6) ; 2
(2 7) ; 3
(0 5) ; 4
(1 4 6) ; 5
(2 5 7) ; 6
(3 6))) ; 7
;;; 局面
(defstruct state board space prev)
;;; 駒の移動
(defun move-piece (board x space)
(let ((newbd (copy-seq board))
(piece (aref board x)))
(cond
((eq piece 'L1) ; 電球を左へ
(when (= (1- x) space)
(setf (aref newbd space) 'L1
(aref newbd x) 'L2
(aref newbd (1+ x)) 'S)))
((eq piece 'L2) ; 電球を右へ
(when (= (1+ x) space)
(setf (aref newbd space) 'L2
(aref newbd x) 'L1
(aref newbd (1- x)) 'S)))
(t
(setf (aref newbd space) (aref newbd x)
(aref newbd x) 'S)))
newbd))
;;; 解の表示
(defun print-answer (st)
(when (state-prev st)
(print-answer (state-prev st)))
(format t "~A~%" (state-board st)))
;;; 幅優先探索
(defun solver-bfs (start goal)
(let ((q (make-queue))
(ht (make-hash-table :test #'equalp)))
(setf (gethash start ht)
(enqueue q (make-state :board start :space (position 'S start) :prev nil)))
(loop
(if (emptyp q) (return))
(let* ((st (dequeue q))
(bd (state-board st))
(sp (state-space st)))
(dolist (x (aref adjacent sp))
(let ((newbd (move-piece bd x sp)) newst)
(unless (gethash newbd ht)
(setq newst (make-state :board newbd :space (position 'S newbd) :prev st))
(cond
((equalp newbd goal)
(print-answer newst)
(return-from solver-bfs (hash-table-count ht)))
(t
(setf (gethash newbd ht)
(enqueue q newst)))))))))))
;;;
;;; 最長手数の局面を求める
;;;
(defun solver-max (start)
(let ((ht (make-hash-table :test #'equalp))
(old-states (list (make-state :board start :space (position 's start))))
(new-states nil)
(m 0))
(loop
(dolist (st old-states)
(let ((bd (state-board st))
(sp (state-space st)))
(dolist (x (aref adjacent sp))
(let ((newbd (move-piece bd x sp)))
(unless (gethash newbd ht)
(setf (gethash newbd ht) t)
(push (make-state :board newbd :space (position 's newbd)) new-states))))))
(unless new-states
;; old-state が最長手数
(format t "max moves = ~d~%" m)
(dolist (st old-states)
(format t "~A~%" (state-board st)))
(return (hash-table-count ht)))
(setq old-states new-states
new-states nil)
(incf m))))