今回は幅優先探索の具体的な例題として、15 パズルでお馴染みの「スライドパズル (スライディングブロックパズル)」を SML/NJ で解いてみましょう。
参考文献『世界のパズル百科イラストパズルワンダーランド』によると、15 パズルはアメリカのサム・ロイドが 1870 年代に考案したパズルで、彼はパズルの神様と呼ばれるほど有名なパズル作家だそうです。
┌─┬─┬─┬─┐ │1│2│3│4│ ├─┼─┼─┼─┤ │5│6│7│8│ ├─┼─┼─┼─┤ │9│10│11│12│ ├─┼─┼─┼─┤ │13│14│15│ │ └─┴─┴─┴─┘ 図 1 : 15 パズル
15 パズルは上図に示すように、1 から 15 までの駒を並べるパズルです。駒の動かし方は、1 回に 1 個の駒を空いている隣の場所に滑らせる、というものです。駒を跳び越したり持ち上げたりすることはできません。
15 パズルの場合、駒の配置は空き場所がどこでもいいことにすると、16! (約 2e13) 通りもあります。実際には、15 パズルの性質からその半分になるのですが、それでもパソコンで扱うにはあまりにも大きすぎる数です。そこで、盤面を一回り小さくした、1 から 8 までの数字を並べる「8 パズル」を考えることにします。
┌─┬─┬─┐ ┌─┬─┬─┐ │1│2│3│ │1│2│3│ ├─┼─┼─┤ ├─┼─┼─┤ │4│5│6│ │4│5│6│ ├─┼─┼─┤ ├─┼─┼─┤ │7│8│ │ │8│7│ │ └─┴─┴─┘ └─┴─┴─┘ (1)完成形 (2)不可能な局面 図 2 : 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│6│7│ │1│2│3│ ├─┼─┼─┤ ├─┼─┼─┤ │2│5│4│ │4│5│6│ ├─┼─┼─┤ ├─┼─┼─┤ │3│ │1│ │7│8│ │ └─┴─┴─┘ └─┴─┴─┘ スタート ゴール 図 3 : 8 パズル
8 パズルの盤面は配列を使って表します。盤面の位置と配列の添字の対応は下図を見てください。
┌─┬─┬─┐ ┌─┬─┬─┐ │1│2│3│ │0│1│2│ ├─┼─┼─┤ ├─┼─┼─┤ │4│5│6│ │3│4│5│ ├─┼─┼─┤ ├─┼─┼─┤ │7│8│ │ │6│7│8│ └─┴─┴─┘ └─┴─┴─┘ 盤面:[1; 2; 3; 盤面と配列の対応 4; 5; 6; 7; 8; 0] 図 4 : 8 パズルの盤面
空き場所は 0 で表します。隣接リストの定義は次のようになります。
リスト : 隣接リスト val 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 *) ]
次は局面を表すデータ型を定義します。
リスト : 局面の定義 datatype state = Nil | S of int array * int * state
型名は state としました。最初の int array は盤面を表す配列、次の int は空き場所の位置、最後の state は 1 手前の局面を格納します。ゴールに到達したら、最後の state をたどって手順を表示します。終端は Nil で表します。
それでは幅優先探索のプログラムを作りましょう。次のリストを見てください。
リスト : 幅優先探索 (* キューの生成 *) structure StateQueue = makeQueue(type item = state) (* ハッシュ表の生成 *) structure ArrayItem: HASHITEM = struct type item = int array val size = 181499 fun hash_func board = (Array.foldl (fn(x, a) => a * 9 + x) 0 board) mod size fun equal(a, b) = equal_board a b end structure ArrayHash = makeHashtbl(ArrayItem) (* 幅優先探索 *) fun bfs start goal = let val q = ref StateQueue.create val ht: (int array, bool) ArrayHash.hash = ArrayHash.create () in q := StateQueue.enqueue(!q, S(start, get_space start, Nil)); ArrayHash.insert(start, true, ht); while not(StateQueue.isEmpty(!q)) do ( let val st as S(board, sp, _) = StateQueue.front(!q) in q := StateQueue.dequeue(!q); if equal_board board goal then (print_answer st; raise Found) else app (fn x => let val newb = move_piece board x sp in if ArrayHash.member(newb, ht) then () else ( q := StateQueue.enqueue(!q, S(newb, x, st)); ArrayHash.insert(newb, true, ht) ) end) (Vector.sub(adjacent, sp)) end ) end
プログラムの骨格は「経路の探索」で説明した幅優先探索と同じです。変数 q にキューをセットし、変数 ht は同一局面をチェックするためのハッシュ表 (Hashtbl) を格納します。ファンクタ makeQueue は「モジュール (3)」で作成したものを、makeHashtbl は「ハッシュ法」で作成したものを使用します。
幅優先探索の場合、手数 を 1 つずつ増やしながら探索を行います。このため、n 手目の移動で作られた局面が n 手以前の局面で出現している場合、n 手より短い手数で到達する移動手順が必ず存在します。最短手順を求めるのであれば、この n 手の手順を探索する必要はありません。ハッシュ表 ht をチェックして新しい局面だけキューに登録します。
まず、start の局面を生成してハッシュとキューに登録します。それから、while ループでゴール (goal) に到達するまで探索を繰り返します。キューが空になり while ループが終了する場合、start は goal に到達できない、つまり解くことができなかったことになります。
キューから局面を取り出して変数 st にセットします。次に、盤面 board が goal と等しいか関数 equal_board でチェックします。SML/NJ の場合、配列の等値判定に演算子 =, <> を使用することはできません。たとえば、[1, 2, 3] = [1, 2, 3] は false になります。equal_board は配列の要素を順番に比較するだけです。goal に到達した場合、print_answer で手順を表示して例外 Found を送出します。
まだゴールに到達していない場合は、駒を動かして新しい局面を生成します。この処理を app で行います。動かせる駒の位置は空き場所の隣なので、Vector.sub(adjacent, sp) で求めることができます。匿名関数の引数 x が動かす駒の位置になります。駒を動かして新しい盤面を作る処理は関数 move_piece で行います。
リスト : 駒の移動 fun move_piece board src dst = let val newb = Array.array(9, 0) in Array.copy {src = board, dst = newb, di = 0}; Array.update(newb, dst, Array.sub(newb, src)); Array.update(newb, src, 0); newb end
最初に新しい盤面 newb を Array.array で作成します。次に、関数 Array.copy で board の要素を newb にコピーします。copy の引数はレコードです。src に転送元の配列を、dst に転送先の配列を指定します。そして、src の要素を dst の di 番目から順番に転送します。簡単な使用例を示しましょう。
- val a = Array.array(10, 0); val a = [|0,0,0,0,0,0,0,0,0,0|] : int array - val b = Array.fromList [1,2,3]; val b = [|1,2,3|] : int array - Array.copy {src = b, dst = a, di = 0}; val it = () : unit - a; val it = [|1,2,3,0,0,0,0,0,0,0|] : int array - Array.copy {src = b, dst = a, di = 5}; val it = () : unit - a; val it = [|1,2,3,0,0,1,2,3,0,0|] : int array
newb を作成したら、dst (空き場所) に src の駒をセットし、src に空き場所 (0) をセットします。最後に newb を返します。
move_piece の返り値を変数 newb にセットし、同一の盤面がないかハッシュ表の関数 Hashtbl.member でチェックします。同じ盤面が見つからない場合、局面 S(newb, x, st) をキューに、newb をハッシュに登録します。
あとは特に難しいところはないでしょう。詳細はプログラムリストをお読みください。
これでプログラムは完成です。それでは実行してみましょう。
- solver (); 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
31 手で解くことができました。生成した局面は全部で 181440 通りで、実行時間は 0.64 秒 (SML/NJ ver 110.98, Window 10, Intel Core i5-6200U 2.30GHz) かかりました。8 パズルの場合、最長手数は 31 手で、下図に示す 2 通りの局面があります。スタートの局面はその一つです。
┌─┬─┬─┐ ┌─┬─┬─┐ │8│6│7│ │6│4│7│ ├─┼─┼─┤ ├─┼─┼─┤ │2│5│4│ │8│5│ │ ├─┼─┼─┤ ├─┼─┼─┤ │3│ │1│ │3│2│1│ └─┴─┴─┘ └─┴─┴─┘ 図 5 : 31 手で解ける局面
最長手数の局面は、幅優先探索を使って求めることができます。これはあとで試してみましょう。
ところで、今回の 8 パズルようにゴールの状態が明確な場合、スタートから探索するだけではなくゴールからも探索を行うことで、幅優先探索を高速化することができます。これを「双方向探索 (bi-directional search)」といいます。
その理由を説明するために、簡単なシミュレーションをしてみましょう。たとえば、1 手進むたびに 3 つの局面が生成され、5 手で解けると仮定します。すると、n 手目で生成される局面は 3 の n 乗個になるので、初期状態から単純に探索すると、生成される局面の総数は、3 + 9 + 27 + 81 + 243 = 363 個となります。
これに対し、初期状態と終了状態から同時に探索を始めた場合、お互い 3 手まで探索した時点で同じ局面に到達する、つまり、解を見つけることができます。この場合、生成される局面の総数は 3 手目までの局面数を 2 倍した 78 個となります。
生成される局面数はぐっと少なくなりますね。局面数が減少すると同一局面の探索処理に有利なだけではなく、「キューからデータを取り出して新しい局面を作る」という根本的な処理のループ回数を減らすことになるので、処理速度は大幅に向上するのです。
それではプログラムを作りましょう。単純に考えると、2 つの探索処理を交互に行うことになりますが、そうするとプログラムの大幅な修正が必要になります。ここは、探索方向を示すフラグを用意することで、一つのキューだけで処理することにしましょう。局面を表すクラスに方向を格納するデータ型 dir を追加します。
リスト : 局面の定義 (双方向からの探索) datatype dir = For | Back datatype state2 = Nil2 | S2 of dir * int array * int * state2
スタートからの探索を For で、ゴールからの探索を Back で表ます。双方向探索のプログラムは次のようになります。
リスト : 双方向探索 fun bfs2 start goal = let val q = ref StateQueue2.create val ht: (int array, state2) ArrayHash.hash = ArrayHash.create () val st_s = S2(For, start, get_space start, Nil2) val st_g = S2(Back, goal, get_space goal, Nil2) in q := StateQueue2.enqueue(!q, st_s); q := StateQueue2.enqueue(!q, st_g); ArrayHash.insert(start, st_s, ht); ArrayHash.insert(goal, st_g, ht); while not(StateQueue2.isEmpty(!q)) do ( let val st as S2(d, board, sp, _) = StateQueue2.front(!q) in q := StateQueue2.dequeue(!q); app (fn x => let val newb = move_piece board x sp val olds = ArrayHash.search(newb, ht) in if check_goal d olds then (print_answer2 st (valOf olds); raise Found) else if not(isSome olds) then let val newst = S2(d, newb, x, st) in q := StateQueue2.enqueue(!q, newst); ArrayHash.insert(newb, newst, ht) end else () end) (Vector.sub(adjacent, sp)) end ) end
スタートとゴールの局面 st_s と st_g を生成してキューとハッシュにセットします。ここで、ハッシュには局面をセットすることに注意してください。最初に、スタートの状態から 1 手目の局面が生成され、次にゴールの状態から 1 手目の局面が生成されます。あとは、交互に探索が行われます。
駒の移動と局面の生成処理は幅優先探索と同じです。ArrayHash.search の検索結果を変数 olds にセットします。そして、関数 check_goal で st と olds の探索方向が異なるかチェックします。そうであれば、双方向の探索で同一局面に到達したことがわかります。見つけた最短手順を関数 print_answer2 で出力します。同じ探索方向であれば、キューへの追加は行いません。
check_goal と print_answer2 は簡単なプログラムなので説明は割愛いたします。詳細はプログラムリストをお読みください。
さっそく実行してみると、生成された局面数は 16088 個で、実行時間は 62 msec でした。局面数は約 1 / 11 になり、実行時間も約 10 倍と高速になりました。
次は最長手数の局面を求めてみましょう。最長手数の求め方ですが、181440 通りの配置の最短手数がすべてわかれば、最長の手数となる配置を求めることができます。しかし、この方法では時間がとてもかかりそうです。そこで、完成形から始めていちばん長い手数の局面を生成することにします。
まず、完成形から駒を動かして 1 手で到達する局面をすべて作ります。次に、これらの局面から駒を動かして新しい局面を作れば、完成形から 2 手で到達する局面となります。このように、手数を 1 手ずつ伸ばしていき、新しい局面が生成できなくなった時点での手数が求める最長手数となります。この処理は幅優先探索を使えばぴったりです。
このプログラムの目的は、いちばん長い手数となる配置を求めることなので、その手順を表示することは行いません。このため、一手前の局面は格納しないで、その局面までの手数を格納することにします。一つ前の局面の手数に 1 を足せば、現在の局面の手数となります。
それではプログラムを作ります。次のリストを見てください。
リスト : 8 パズルの最長手数を求める (* データ型 Smax(space, board, move) *) datatype state_max = Smax of int * int array * int fun bfs_max ht xs = let val ys = List.foldl (fn(Smax(sp, board, m), a) => List.foldl (fn(x, b) => let val newb = move_piece board x sp in if ArrayHash.member(newb, ht) then b else ( ArrayHash.insert(newb, true, ht); Smax(x, newb, m + 1)::b) end) a (Vector.sub(adjacent, sp))) nil xs in if null ys then print_max xs else bfs_max ht ys end fun solver_max () = let val a = Timer.startRealTimer() val start = Array.fromList [1,2,3,4,5,6,7,8,0] val ht: (int array, bool) ArrayHash.hash = ArrayHash.create () in ArrayHash.insert(start, true, ht); bfs_max ht [Smax(8, start, 0)]; Timer.checkRealTimer a end
関数 bfs_max は n 手の局面を格納したリストを引数 xs に受け取ります。そして、そこから n + 1 手の局面を生成してリストに格納し、変数 ys にセットします。もしも、ys が空リストであれば、xs の局面が最長手数の局面となります。そうでなければ、探索処理を続行します。この処理を再帰呼び出しで実現しています。
新しい局面の生成は List.foldl を使うと簡単です。ここで foldl を二重で使っていることに注意してください。最初の foldl で xs から局面を一つずつ取り出します。匿名関数の第 2 引数 a が新しい局面を格納する累積変数 (リスト) で、第 1 引数が局面 state です。パターンマッチングで空き場所の位置、盤面、手数を取り出して変数 sp, board, m にセットします。
次の foldl で盤面の駒を動かして新しい局面を生成します。匿名関数の第 2 引数 b が新しい局面を格納する累積変数 (リスト) で、第 1 引数 x が移動する駒の位置です。b の初期値は最初の foldl の累積変数が渡されるので、新しい局面をここに蓄積して返すことができます。
匿名関数の中で新しい盤面を生成し、ハッシュ表 ht をチェックします。同一の盤面がなければ、新しい局面を b に追加して返します。そうでなければ b をそのまま返します。あとは関数 solver_max から bfs_max を呼び出すだけです。
さっそく実行してみましょう。
- solver_max (); 31 8 6 7 2 5 4 3 0 1 31 6 4 7 8 5 0 3 2 1
最長手数は 31 手で、その配置は全部で 2 通りになります。実行時間は 0.58 秒でした。
(* * eight.sml : 8 パズルの解法 * * Copyright (C) 2020 Makoto Hiroi *) (***** キュー *****) functor makeQueue(type item) = struct abstype 'a queue = Q of 'a list * 'a list with exception EmptyQueue val create = Q(nil: item list, nil: item list) fun enqueue(Q(front, rear), x) = Q(front, x::rear) fun dequeue(Q(nil, nil)) = raise EmptyQueue | dequeue(Q(nil, rear)) = dequeue(Q(rev rear, nil)) | dequeue(Q(x::xs, rear)) = Q(xs, rear) fun front(Q(nil, nil)) = raise EmptyQueue | front(Q(nil, rear)) = front(Q(rev rear, nil)) | front(Q(x::xs, _)) = x fun isEmpty(Q(nil, nil)) = true | isEmpty _ = false end end (***** ハッシュ表 *****) (* シグネチャ *) signature HASHITEM = sig type item val size : int val hash_func : item -> int val equal : item * item -> bool end (* ファンクタ *) functor makeHashtbl(Item: HASHITEM) = struct (* データ型の定義 *) datatype ('a, 'b) hash = Hash of ('a * 'b) list array (* ハッシュ表の生成 *) fun create () = Hash(Array.array(Item.size, nil: ('a * 'b) list)) (* データの探索 *) fun search(k, Hash table) = let val n = Item.hash_func k val xs = Array.sub(table, n) in case List.find (fn(x, _) => Item.equal(x, k)) xs of NONE => NONE | SOME (_, v) => SOME v end fun member(k, ht) = isSome (search(k, ht)) (* データの挿入 *) fun insert(k, v, Hash table) = let val n = Item.hash_func k val xs = Array.sub(table, n) in Array.update(table, n, (k, v)::xs) end (* データの削除 *) fun delete(k, Hash table) = let val n = Item.hash_func k val xs = Array.sub(table, n) in Array.update(table, n, List.filter (fn(x, _) => not(Item.equal(x, k))) xs) end end (* 例外 *) exception Found (* 隣接リスト *) val 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 *) ] (* 局面 S (盤面, 空き場所の位置, 1手前の局面) *) datatype state = Nil | S of int array * int * state (* 同じ盤面か? *) fun equal_board a b = let fun iter i = if i = Array.length a then true else if Array.sub(a, i) <> Array.sub(b, i) then false else iter (i + 1) in iter 0 end (* 空き場所の位置 *) fun get_space board = let fun iter i = if i = Array.length board then ~1 else if Array.sub(board, i) = 0 then i else iter (i + 1) in iter 0 end (* コマの移動 *) fun move_piece board src dst = let val newb = Array.array(9, 0) in Array.copy {src = board, dst = newb, di = 0}; Array.update(newb, dst, Array.sub(newb, src)); Array.update(newb, src, 0); newb end (* 手順の表示 *) fun print_board board = (Array.app (fn x => print (Int.toString x ^ " ")) board; print "\n") fun print_answer Nil = () | print_answer (S(board, _, prev)) = (print_answer prev; print_board board) (* キューの生成 *) structure StateQueue = makeQueue(type item = state) (* ハッシュ表の生成 *) structure ArrayItem: HASHITEM = struct type item = int array val size = 181499 fun hash_func board = (Array.foldl (fn(x, a) => a * 9 + x) 0 board) mod size fun equal(a, b) = equal_board a b end structure ArrayHash = makeHashtbl(ArrayItem) (* 幅優先探索 *) fun bfs start goal = let val q = ref StateQueue.create val ht: (int array, bool) ArrayHash.hash = ArrayHash.create () in q := StateQueue.enqueue(!q, S(start, get_space start, Nil)); ArrayHash.insert(start, true, ht); while not(StateQueue.isEmpty(!q)) do ( let val st as S(board, sp, _) = StateQueue.front(!q) in q := StateQueue.dequeue(!q); if equal_board board goal then (print_answer st; raise Found) else app (fn x => let val newb = move_piece board x sp in if ArrayHash.member(newb, ht) then () else ( q := StateQueue.enqueue(!q, S(newb, x, st)); ArrayHash.insert(newb, true, ht) ) end) (Vector.sub(adjacent, sp)) end ) end fun solver () = let val a = Timer.startRealTimer() in bfs (Array.fromList [8,6,7,2,5,4,3,0,1]) (Array.fromList [1,2,3,4,5,6,7,8,0]) handle Found => (); Timer.checkRealTimer a end (***** 双方向探索 *****) datatype dir = For | Back datatype state2 = Nil2 | S2 of dir * int array * int * state2 (* キューの生成 *) structure StateQueue2 = makeQueue(type item = state2) (* 手順の表示 *) fun print_for Nil2 = () | print_for (S2(_, board, _, prev)) = (print_for prev; print_board board) fun print_back Nil2 = () | print_back (S2(_, board, _, next)) = (print_board board; print_back next) fun print_answer2 (st1 as S2(For, _, _, _)) st2 = (print_for st1; print_back st2) | print_answer2 (st1 as S2(Back, _, _, _)) st2 = (print_for st2; print_back st1) (* ゴールの確認 *) fun check_goal dx NONE = false | check_goal dx (SOME Nil2) = false | check_goal dx (SOME (S2(dy, _, _, _))) = dx <> dy (* 双方向探索 *) fun bfs2 start goal = let val q = ref StateQueue2.create val ht: (int array, state2) ArrayHash.hash = ArrayHash.create () val st_s = S2(For, start, get_space start, Nil2) val st_g = S2(Back, goal, get_space goal, Nil2) in q := StateQueue2.enqueue(!q, st_s); q := StateQueue2.enqueue(!q, st_g); ArrayHash.insert(start, st_s, ht); ArrayHash.insert(goal, st_g, ht); while not(StateQueue2.isEmpty(!q)) do ( let val st as S2(d, board, sp, _) = StateQueue2.front(!q) in q := StateQueue2.dequeue(!q); app (fn x => let val newb = move_piece board x sp val olds = ArrayHash.search(newb, ht) in if check_goal d olds then (print_answer2 st (valOf olds); raise Found) else if not(isSome olds) then let val newst = S2(d, newb, x, st) in q := StateQueue2.enqueue(!q, newst); ArrayHash.insert(newb, newst, ht) end else () end) (Vector.sub(adjacent, sp)) end ) end fun solver2 () = let val a = Timer.startRealTimer() in bfs2 (Array.fromList [8,6,7,2,5,4,3,0,1]) (Array.fromList [1,2,3,4,5,6,7,8,0]) handle Found => (); Timer.checkRealTimer a end (* 最長手数の探索 *) (* データ型 Smax(space, board, move) *) datatype state_max = Smax of int * int array * int fun print_max xs = app (fn(Smax(_, board, m)) => ( print (Int.toString m); print ("\n"); print_board board)) xs fun bfs_max ht xs = let val ys = List.foldl (fn(Smax(sp, board, m), a) => List.foldl (fn(x, b) => let val newb = move_piece board x sp in if ArrayHash.member(newb, ht) then b else ( ArrayHash.insert(newb, true, ht); Smax(x, newb, m + 1)::b) end) a (Vector.sub(adjacent, sp))) nil xs in if null ys then print_max xs else bfs_max ht ys end fun solver_max () = let val a = Timer.startRealTimer() val start = Array.fromList [1,2,3,4,5,6,7,8,0] val ht: (int array, bool) ArrayHash.hash = ArrayHash.create () in ArrayHash.insert(start, true, ht); bfs_max ht [Smax(8, start, 0)]; Timer.checkRealTimer a end