今回は反復深化で 8 パズルを解いてみましょう。「経路の探索」で説明したように、反復深化は最短手数を求めることができるアルゴリズムです。幅優先探索と違って局面を保存する必要が無いため、必要となるメモリは深さ優先探索と同程度で済みます。また、プログラムも深さ優先探索と同じくらい簡単に作成することができます。
ただし、同じ探索を何度も繰り返すため実行時間が増大する、という欠点があります。ようするに、使用するメモリは少ないが実行時間が長くなるアルゴリズムなのです。実行時間が長くなるといっても、枝刈りを工夫することでパズルを高速に解くことができます。メモリ不足になる場合には、積極的に使ってみたいアルゴリズムといえるでしょう。
幅優先探索では全ての局面を保存しましたが、反復深化ではその必要はありません。盤面は配列 board で表します。駒の移動は board を書き換えて、バックトラックする時は元に戻すことにします。動かした駒はリスト move_list に格納します。動かした駒がわかれば局面を再現できるので、それで移動手順を表すことにします。
それでは、解を求める関数 solver を作りましょう。次のリストを見てください。
リスト 1 : 単純な反復深化による解法
let solver board goal =
let count = ref 0 in
let rec ids n limit space move_list =
if n = limit then
if board = goal then
begin
count := !count + 1;
print_answer (List.tl (List.rev move_list))
end
else ()
else
List.iter
(fun x ->
let p = board.(x) in
if p <> List.hd move_list then
begin
(* 駒を動かす *)
board.(space) <- p;
board.(x) <- 0;
(* 再帰呼び出し *)
ids (n+1) limit x (p::move_list);
(* 元に戻す *)
board.(space) <- 0;
board.(x) <- p
end
else ())
adjacent.(space)
in
let i = ref 1 in
while (!i <= 31 && !count = 0) done
ids 0 !i (position 0 board) [-1];
i := !i + 1
done
探索処理は局所関数 ids で行います。ids の引数 n が手数、limit が反復深化の上限値、space が空き場所の位置、move_list が移動手順を表します。n が limit に達したら、パズルが解けたかチェックします。solver の引数 goal が完成形を表す配列です。完成形に到達したら、変数 count の値を +1 してから関数 print_answer で手順を表示します。上限値に達していない場合は、駒を移動して新しい局面を作ります。
8 パズルのように、元の局面に戻すことが可能（可逆的）なパズルの場合、単純な深さ優先探索では同じ移動手順を何度も繰り返すことがあります。そうなると、とんでもない解を出力するだけではなく、再帰呼び出しが深くなるとスタックがオーバーフローしてプログラムの実行が停止してしまいます。
このような場合、局面の履歴を保存しておいて同じ局面がないかチェックすることで、解を求めることができるようになります。ただし、同一局面をチェックする分だけ時間が余分にかかりますし、最初に見つかる解が最短手数とは限りません。
反復深化では深さが制限されているため、同一局面のチェックを行わなくてもスタックオーバーフローが発生することはありません。そのかわり、無駄な探索はどうしても避けることができません。8 パズルの場合、1 手前に動かした駒を再度動かすと 2 手前の局面に戻ってしまいます。完全ではありませんが、このチェックを入れるだけでもかなりの無駄を省くことができます。
プログラムでは、リスト move_list に移動した駒を格納しているので、1 手前と同じ駒は動かさないようにチェックしています。なお、move_list の初期値はダミーデータを入れて [-1] としています。
最後に、関数 ids を呼び出します。変数 i が上限値を表します。i を 1 手ずつ増やして関数 ids を呼び出します。変数 count が 0 より大きい場合、解が見つかったので while ループを終了します。プログラムはこれで完成です。
それでは実行してみましょう。
let () = let a = Sys.time () in solver [|8;6;7;2;5;4;3;0;1|] [|1;2;3;4;5;6;7;8;0|]; print_float (Sys.time () -. a);;
当然ですが最短手数は 31 手で 40 通りの手順が表示されました。実行時間は 53.8 秒 (ocamlc version 4.05.0, Ubunts 18.04 (Windows Subsystem for Linux), Intel Core i5-6200U 2.30GHz) かかりました。1 分ちかくかかるのですから、やっぱり遅いですね。反復深化の場合、枝刈りを工夫しないと高速に解くことはできません。そこで、反復深化の常套手段である「下限値枝刈り法」を使うことにしましょう。
下限値枝刈り法は難しいアルゴリズムではありません。たとえば、5 手進めた局面を考えてみます。探索の上限値が 10 手とすると、あと 5 手だけ動かすことができますね。この時、パズルを解くのに 6 手以上かかることがわかれば、ここで探索を打ち切ることができます。
このように、必要となる最低限の手数が明確にわかる場合、この値を「下限値 (Lower Bound)」と呼びます。この下限値を求めることができれば、「今の移動手数＋下限値」が探索手数を超えた時点で、枝刈りすることが可能になります。これが下限値枝刈り法の基本的な考え方です。
さて、下限値を求める方法ですが、これにはいろいろな方法が考えられます。今回は、各駒が正しい位置へ移動するまでの手数 (移動距離) [*1] を下限値として利用することにしましょう。次の図を見てください。
たとえば、右下にある 1 の駒を左上の正しい位置に移動するには、最低でも 4 手必要です。もちろん、ほかの駒との関連で、それ以上の手数が必要になる場合もあるでしょうが、4 手より少なくなることは絶対にありません。同じように、各駒について最低限必要な手数を求めることができます。そして、その合計値はパズルを解くのに最低限必要な手数となります。これを下限値として利用することができます。ちなみに、図 1 (2) の初期状態の下限値は 21 手になります。
下限値枝刈り法を使う場合、下限値の計算を間違えると正しい解を求めることができなくなります。たとえば、10 手で解ける問題の下限値を 11 手と計算すれば、最短手数を求めることができなくなります。それどころか、10 手の解しかない場合は、答えを求めることすらできなくなります。下限値の計算には十分に注意してください。
┌─┬─┬─┐ ┌──┬──┬──┐
│１│２│３│ │8(3)│6(2)│7(4)│
├─┼─┼─┤ ├──┼──┼──┤
│４│５│６│ │2(2)│5(0)│4(2)│
├─┼─┼─┤ ├──┼──┼──┤
│７│８│ │ │3(4)│ │1(4)│
└─┴─┴─┘ └──┴──┴──┘
(n) : n は移動距離
(1) 完成形 (2) 初期状態：合計 21
図 1 : 下限値の求め方
それでは、プログラムを作りましょう。下限値の求め方ですが、駒を動かすたびに各駒の移動距離を計算していたのでは時間がかかります。8 パズルの場合、1 回に一つの駒しか移動しないので、初期状態の下限値を求めておいて、動かした駒の差分だけ計算すればいいでしょう。
また、駒の移動距離はいちいち計算するのではなく、あらかじめ計算した結果を配列に格納しておきます。この配列を distance とすると、盤面から移動距離を求めるプログラムは次のようになります。
リスト 2 : 移動距離を求める let distance = [| [|0; 0; 0; 0; 0; 0; 0; 0; 0|]; [|0; 1; 2; 1; 2; 3; 2; 3; 4|]; [|1; 0; 1; 2; 1; 2; 3; 2; 3|]; [|2; 1; 0; 3; 2; 1; 4; 3; 2|]; [|1; 2; 3; 0; 1; 2; 1; 2; 3|]; [|2; 1; 2; 1; 0; 1; 2; 1; 2|]; [|3; 2; 1; 2; 1; 0; 3; 2; 1|]; [|2; 3; 4; 1; 2; 3; 0; 1; 2|]; [|3; 2; 3; 2; 1; 2; 1; 0; 1|] |] (* 移動距離を求める *) let get_distance board = Array.fold_left (fun a n -> a + distance.(board.(n)).(n)) 0 board
distance は 2 次元配列で「駒の種類×駒の位置」を表しています。空き場所は関係ないので、distance.(0) はダミー (要素が 0 の配列) となります。関数 get_distance は盤面 board にある駒と位置から移動距離を求めます。この処理は distance.(board.(n)).(n) の合計値を Array.fold_left で求めるだけです。
次は、下限値枝刈り法による反復深化を行う関数 solver を作ります。次のリストを見てください。
リスト 3 : 下限値枝刈り法
let solver board goal =
let count = ref 0 in
let rec ids n limit space move_list lower =
if n = limit then
if board = goal then
begin
count := !count + 1;
print_answer (List.tl (List.rev move_list))
end
else ()
else
List.iter
(fun x ->
let p = board.(x) in
if p <> List.hd move_list then
let new_lower = lower - distance.(p).(x) + distance.(p).(space) in
if new_lower + n <= limit then
begin
(* 駒を動かす *)
board.(space) <- p;
board.(x) <- 0;
(* 再帰呼び出し *)
ids (n+1) limit x (p::move_list) new_lower;
(* 元に戻す *)
board.(space) <- 0;
board.(x) <- p
end
else ()
else ())
adjacent.(space)
in
let lower = get_distance board in
let i = ref lower in
while (!i <= 31 && !count = 0) do
ids 0 !i (position 0 board) [-1] lower;
i := !i + 1
done
局所関数 ids の引数 lower は現在の盤面 board の下限値を表しています。動かす駒の差分を計算して、新しい下限値 new_lower を求めます。そして、new_lower + n が上限値 limit を越えたら枝刈りを行います。limit 以下であれば ids を再帰呼び出しします。
最後に ids を呼び出す処理を修正します。関数 get_distance で初期状態の下限値 lower を求めます。下限値がわかるのですから、上限値 i は 1 手からではなく下限値 lower からスタートします。あとは ids に下限値 lower を渡して呼び出すだけです。
プログラムの主な修正はこれだけです。実際に実行してみると、実行時間は 0.063 秒でした。約 850 倍という高速化に驚いてしまいました。下限値枝刈り法の効果は極めて高いですね。
(*
* eight3.ml : 8 Puzzle (反復深化)
*
* Copyright (C) 2008 Makoto Hiroi
*)
(* 隣接リスト *)
let adjacent = [|
[1; 3];
[0; 2; 4];
[1; 5];
[0; 4; 6];
[1; 3; 5; 7];
[2; 4; 8];
[3; 7];
[4; 6; 8];
[5; 7]
|]
(* 駒の位置を返す *)
let position x ary =
let rec iter n =
if n = Array.length ary then raise Not_found
else if x = ary.(n) then n
else iter (n + 1)
in
iter 0
(* 手順の表示 *)
let print_answer ls =
List.iter (fun x -> print_int x; print_string " ") ls;
print_newline ()
(* 反復深化 *)
let solver board goal =
let count = ref 0 in
let rec ids n limit space move_list =
if n = limit then
if board = goal then
print_answer (List.tl (List.rev move_list))
else ()
else
List.iter
(fun x ->
let p = board.(x) in
if p <> List.hd move_list then
begin
(* 駒を動かす *)
board.(space) <- p;
board.(x) <- 0;
(* 再帰呼び出し *)
ids (n+1) limit x (p::move_list);
(* 元に戻す *)
board.(space) <- 0;
board.(x) <- p
end
else ())
adjacent.(space)
in
let i = ref 1 in
while (!i <= 31 && !count = 0) do
ids 0 !i (position 0 board) [-1];
i := !i + 1
done
(* 実行 *)
let () =
let a = Sys.time () in
solver [|8;6;7;2;5;4;3;0;1|] [|1;2;3;4;5;6;7;8;0|];
print_float (Sys.time () -. a)
(*
* eight4.ml : 8 Puzzle (反復深化 + 下限値枝刈り法)
*
* Copyright (C) 2008 Makoto Hiroi
*)
(* 隣接リスト *)
let adjacent = [|
[1; 3];
[0; 2; 4];
[1; 5];
[0; 4; 6];
[1; 3; 5; 7];
[2; 4; 8];
[3; 7];
[4; 6; 8];
[5; 7]
|]
(* 移動距離 *)
let distance = [|
[|0; 0; 0; 0; 0; 0; 0; 0; 0|];
[|0; 1; 2; 1; 2; 3; 2; 3; 4|];
[|1; 0; 1; 2; 1; 2; 3; 2; 3|];
[|2; 1; 0; 3; 2; 1; 4; 3; 2|];
[|1; 2; 3; 0; 1; 2; 1; 2; 3|];
[|2; 1; 2; 1; 0; 1; 2; 1; 2|];
[|3; 2; 1; 2; 1; 0; 3; 2; 1|];
[|2; 3; 4; 1; 2; 3; 0; 1; 2|];
[|3; 2; 3; 2; 1; 2; 1; 0; 1|]
|]
(* 駒の位置を返す *)
let position x ary =
let rec iter n =
if n = Array.length ary then raise Not_found
else if x = ary.(n) then n
else iter (n + 1)
in
iter 0
(* 手順の表示 *)
let print_answer ls =
List.iter (fun x -> print_int x; print_string " ") ls;
print_newline ()
(* 移動距離を求める *)
let get_distance board =
Array.fold_left (fun a n -> a + distance.(board.(n)).(n)) 0 board
(* 反復深化 *)
let solver board goal =
let count = ref 0 in
let rec ids n limit space move_list lower =
if n = limit then
if board = goal then
begin
count := !count + 1;
print_answer (List.tl (List.rev move_list))
end
else ()
else
List.iter
(fun x ->
let p = board.(x) in
if p <> List.hd move_list then
let new_lower = lower - distance.(p).(x) + distance.(p).(space) in
if new_lower + n <= limit then
begin
(* 駒を動かす *)
board.(space) <- p;
board.(x) <- 0;
(* 再帰呼び出し *)
ids (n+1) limit x (p::move_list) new_lower;
(* 元に戻す *)
board.(space) <- 0;
board.(x) <- p
end
else ()
else ())
adjacent.(space)
in
let lower = get_distance board in
let i = ref lower in
while (!i <= 31 && !count = 0) do
ids 0 !i (position 0 board) [-1] lower;
i := !i + 1
done
let () =
let a = Sys.time () in
solver [|8;6;7;2;5;4;3;0;1|] [|1;2;3;4;5;6;7;8;0|];
print_float (Sys.time () -. a)
次のパズルを反復深化を使って解いてください。
ペグ・ソリテアは、盤上に配置されたペグ (駒) を、最後にはひとつ残るように取り除いていく、古典的なパズルです。ルールの説明は拙作のページ Puzzle DE Programming:「ペグ・ソリティア」をお読みください。Hoppers は芦ヶ原伸之氏が考案されたペグ・ソリテアです。次の図を見てください。
●───●───● │＼ ／│＼ ／│ │ ● │ ● │ │／ ＼│／ ＼│ ●───○───● │＼ ／│＼ ／│ │ ● │ ● │ │／ ＼│／ ＼│ ●───●───● 図 : Hoppers
Hoppers は穴を 13 個に減らしていて、遊ぶのに手頃な大きさになっています。上図に示したように、最初に中央のペグを取り除きます。この状態から始めて、最後のペグが中央の位置に残る跳び方の最小手数を求めてください。
今回はペグの有無を bool (true, false) で表します。盤面のデータ型は bool array になります。盤面と配列の対応は下図を見てください。
●───●───● ０───１───２
│＼ ／│＼ ／│ │＼ ／│＼ ／│
│ ● │ ● │ │ ３ │ ４ │
│／ ＼│／ ＼│ │／ ＼│／ ＼│
●───○───● ５───６───７
│＼ ／│＼ ／│ │＼ ／│＼ ／│
│ ● │ ● │ │ ８ │ ９ │
│／ ＼│／ ＼│ │／ ＼│／ ＼│
●───●───● 10───11───12
(1) Hoppers (2) ビットの位置
図 : Hoppers の盤面
ペグの移動は跳び先表 (配列 jump_table) を用意すると簡単です。配列の要素はリストであることに注意してください。リストの要素は、跳び越されるペグの位置と跳び先の位置を格納したタプルです。たとえば、0 番の位置にあるペグは、1 番を跳び越して 2 番へ移動する場合と、3 番を跳び越して 6 番へ移動する場合と、5 番を飛び越して 10 番へ移動する場合の 3 通りがあります。これをリスト [(1, 2); (3, 6); (5, 10)] で表しています。
あとは単純な反復深化で最短手順を求めるだけです。詳細はプログラムリストをお読みくださいませ。
リスト : Hoppers の解法
(* 跳び先表 *)
let jump_table = [|
[(1, 2); (3, 6); (5, 10)];
[(3, 5); (6, 11); (4, 7)];
[(1, 0); (4, 6); (7, 12)];
[(6, 9)];
[(6, 8)];
[(3, 1); (6, 7); (8, 11)];
[(3, 0); (4, 2); (8, 10); (9, 12)];
[(4, 1); (6, 5); (9, 11)];
[(6, 4)];
[(6, 3)];
[(5, 0); (8, 6); (11, 12)];
[(8, 5); (6, 1); (9, 7)];
[(11, 10); (9, 6); (7, 2)] |]
let size = 13 (* 盤面の大きさ *)
let max_jump = 11 (* ペグがジャンプする回数 *)
let hole = 6 (* 中央の穴の位置 *)
(* 手順の表示 *)
(* 連続跳びは [i,j,k,...] で表す *)
let print_move1 move =
let rec _print_move prev = function
[] -> print_endline "]"
| (from, to_)::xs -> if prev = from then Printf.printf ",%d" to_
else Printf.printf "][%d,%d" from to_;
_print_move to_ xs
in
match move with
[] -> ()
| (from, to_)::xs -> Printf.printf "[%d,%d" from to_;
_print_move to_ xs
(* 反復深化 *)
let solver1 () =
let count = ref 0 in
let board = Array.make size true in
let rec dfs jc limit move =
if jc <= limit then
if List.length move = max_jump then
if board.(hole) then
(count := !count + 1;
print_move1 (List.rev move))
else ()
else
for from = 0 to size - 1 do
if not board.(from) then ()
else
List.iter
(fun (del, to_) ->
if board.(del) && not board.(to_) then
(board.(from) <- false;
board.(del) <- false;
board.(to_) <- true;
dfs
(if snd (List.hd move) = from then jc else jc + 1)
limit
((from, to_)::move);
board.(to_) <- false;
board.(del) <- true;
board.(from) <- true)
else ())
jump_table.(from)
done
in
(* 初手を 0 -> (3) -> 6: hole に限定 *)
board.(0) <- false;
board.(3) <- false;
board.(hole) <- true;
let i = ref 2 in
while !i <= max_jump && !count = 0 do
Printf.printf "----- %d -----\n" !i;
dfs 1 !i [(0, hole)];
i := !i + 1
done
# solver1 ();; ----- 2 ----- ----- 3 ----- ----- 4 ----- ----- 5 ----- ----- 6 ----- ----- 7 ----- [0,6][9,3][2,0,6][11,1][10,0,2,6][8,4][12,2,6] [0,6][9,3][2,0,6][11,1][10,6][4,8][12,2,0,10,6] [0,6][9,3][2,0,6][11,1][12,2,6][8,4][10,0,2,6] [0,6][9,3][2,6][8,4][10,0,2,6][7,5][12,10,0,6] [0,6][9,3][2,6][8,4][10,0,2,6][11,1][12,2,0,6] [0,6][9,3][2,6][8,4][10,0,6][7,5][12,10,0,2,6] [0,6][9,3][2,6][8,4][12,2,0,6][5,7][10,12,2,6] [0,6][9,3][2,6][8,4][12,2,0,6][11,1][10,0,2,6] [0,6][9,3][2,6][8,4][12,2,6][5,7][10,12,2,0,6] [0,6][9,3][10,0,6][7,5][2,0,10,6][4,8][12,10,6] [0,6][9,3][10,0,6][7,5][2,6][8,4][12,10,0,2,6] [0,6][9,3][10,0,6][7,5][12,10,6][4,8][2,0,10,6] [0,6][9,3][10,6][4,8][2,0,6][11,1][12,2,0,10,6] [0,6][9,3][10,6][4,8][2,0,10,6][7,5][12,10,0,6] [0,6][9,3][10,6][4,8][2,0,10,6][11,1][12,2,0,6] [0,6][9,3][10,6][4,8][12,10,0,6][1,11][2,12,10,6] [0,6][9,3][10,6][4,8][12,10,0,6][7,5][2,0,10,6] [0,6][9,3][10,6][4,8][12,10,6][1,11][2,12,10,0,6] - : unit = ()
7 手で解くことができました。解は全部で 18 通りになりました。最近のパソコンは高性能なので、穴の数が少ない盤面であれば、単純な反復深化でも高速に解くことができるようです。