今回は 4 つのパズルを出題します。SML/NJ で解法プログラムを作成してください。
騎士 (ナイト) はチェスの駒のひとつで、将棋の桂馬の動きを前後左右にとることができます。次の図を見てください。
┌─┬─┬─┬─┬─┐ ┌─┬─┐
│ │●│ │●│ │ │Ｋ│ │
├─┼─┼─┼─┼─┤ ┌─┼─┼─┼─┐
│●│ │ │ │●│ │ │ │ │ │
├─┼─┼─┼─┼─┤ ├─┼─┼─┼─┤
│ │ │Ｋ│ │ │ │ │×│×│ │
├─┼─┼─┼─┼─┤ ├─┼─┼─┼─┤
│●│ │ │ │●│ │ │ │ │ │
├─┼─┼─┼─┼─┤ └─┼─┼─┼─┘
│ │●│ │●│ │ │ │ │
└─┴─┴─┴─┴─┘ └─┴─┘
●：ナイト (K) が動ける位置 問題Ａ
図 : 騎士の周遊
このナイトを動かして、どのマスにもちょうど一回ずつ訪れて出発点に戻る周遊経路を求めるのが問題です。ちなみに、4 行 4 列の盤面には解がありませんが、6 行 6 列、8 行 8 列の盤面には解が存在します。大きな盤面を解くのは大変なので、問題 A の盤面でナイトの周遊経路を求めてください。なお、ナイトは×印のマスに移動することはできません。
次は三角形の魔方陣です。下図を見てください。
Ａ
／ ＼ A + B + D + F = 20
Ｂ Ｃ
／ ＼ A + C + E + I = 20
Ｄ Ｅ
／ ＼ F + G + H + I = 20
Ｆ───Ｇ───Ｈ───Ｉ
図 : 変形魔方陣
上図の三角形の A から I の場所に 1 から 9 までの数字をひとつずつ配置します。直線上にある 4 つの数字の和が、3 本の直線で 20 になる配置を求めてください。
チャイニーズ・チェッカーは「ペグ・ソリテア」と呼ばれるパズルのひとつです。ペグ・ソリテアは、盤上に配置されたペグ (駒) を、最後にはひとつ残るように取り除いていく古典的なパズルです。ペグは次のルールに従って移動し、除去することができます。
盤は今までに多数考案されていますが、33 穴英国盤、37 穴フランス盤、41 穴盤が有名でしょう。33 穴英国盤とチャイニーズ・チェッカーを図に示します。
●─●─●
│ │ │
●─●─●
│ │ │ ●
●─●─●─●─●─●─● ／ ＼
│ │ │ │ │ │ │ ●───●
●─●─●─○─●─●─● ／ ＼ ／ ＼
│ │ │ │ │ │ │ ●───●───●
●─●─●─●─●─●─● ／ ＼ ／ ＼ ／ ＼
│ │ │ ●───●───●───●
●─●─● ／ ＼ ／ ＼ ／ ＼ ／ ＼
│ │ │ ●───●───○───●───●
●─●─●
(1) 33 穴英国盤 (2) チャイニーズ・チェッカー
図 : ペグ・ソリテア
それぞれのマスにペグがありますが、そこからひとつペグを取り除いてゲームを始めます。図では黒丸でペグを表し、白丸で空き場所を表しています。ルールに従ってペグを移動し、最後にひとつだけ残ればクリアとなります。
それでは問題です。図 (2) に示したように、下辺の中央のペグを取り除きます。この状態から始めて、最後のペグが最初に取り除いた位置に残る跳び方の最小手数を求めてください。
最後の問題はスライドパズルです。1 から 7 までの数字を並べる７パズルを考えます。次の図を見てください。
┌─┬─┬─┬─┐ ┌─┬─┬─┬─┐
│１│２│３│４│ │？│？│？│？│
├─┼─┼─┼─┤ => ├─┼─┼─┼─┤
│５│６│７│ │ │？│？│？│？│
└─┴─┴─┴─┘ └─┴─┴─┴─┘
完成形 最長手数の局面
図 : ７パズル
７パズルの最長手数の局面を求めてください。
┌─┬─┐ ┌─┬─┐
│Ｋ│ │ │０│１│
┌─┼─┼─┼─┐ ┌─┼─┼─┼─┐
│ │ │ │ │ │２│３│４│５│
├─┼─┼─┼─┤ ├─┼─┼─┼─┤
│ │×│×│ │ │６│×│×│７│
├─┼─┼─┼─┤ ├─┼─┼─┼─┤
│ │ │ │ │ │８│９│10│11│
└─┼─┼─┼─┘ └─┼─┼─┼─┘
│ │ │ │12│13│
└─┴─┘ └─┴─┘
盤面 番号
図 : 盤面と番号の関係
それではプログラムを作りましょう。この問題は盤面が小さいので、単純な深さ優先探索で簡単に解くことができます。上図に示すように、盤面のマスに番号をつけます。
あとは隣接リストを定義して、深さ優先探索で周遊経路を探索するだけです。プログラムは次のようになります。
リスト : 「騎士の周遊」解法プログラム
(* 隣接リスト *)
val adjacent = #[
[5, 6], (* 0 *)
[2, 7], (* 1 *)
[1, 9], (* 2 *)
[7, 8, 10], (* 3 *)
[6, 9, 11], (* 4 *)
[0, 10], (* 5 *)
[0, 4, 10, 12], (* 6 *)
[1, 3, 9, 13], (* 7 *)
[3, 13], (* 8 *)
[2, 4, 7], (* 9 *)
[3, 5, 6], (* 10 *)
[4, 12], (* 11 *)
[6, 11], (* 12 *)
[7, 8] (* 13 *)
]
(* int list の表示 *)
fun print_intlist nil = print "\n"
| print_intlist( x::xs ) = (print(Int.toString(x) ^ " "); print_intlist xs)
(* 深さ優先探索 *)
fun knight_tour(n, goal, path) =
let
val xs = Vector.sub(adjacent, hd path)
in
if n = 14 then
if List.exists (fn x => x = goal) xs then print_intlist (goal::path) else ()
else
app (fn(x) => if List.exists (fn y => x = y) path then ()
else knight_tour(n + 1, goal, x :: path))
xs
end
fun solver() = knight_tour(1, 0, [0])
隣接リストはベクタ adjacent に定義します。要素はリストであることに注意してください。関数 knight_tour は深さ優先探索で騎士の周遊経路を求めます。引数 n は訪れたマスの個数、goal はゴール地点 (出発点)、path は経路 (リスト) を表します。周遊経路を求めるので出発点はどこでもいいのですが、今回は 0 を出発点としてます。
全部のマスを 1 回ずつ訪れると n の値は 14 になります。最後のマスから出発点 (goal) に戻ることができれば周遊経路になります。これは最後のマスの隣接リストに goal が含まれているかチェックすればいいですね。この処理を List.exists で行っています。そうであれば周遊経路になるので、関数 print_intlist で path を表示します。
n が 14 より小さい場合は、深さ優先で騎士を進めていきます。この処理は経路の探索と同じなので、詳しく説明する必要はないでしょう。これでプログラムは完成です。
それでは、実行してみましょう。
- solver(); 0 6 12 11 4 9 2 1 7 13 8 3 10 5 0 0 5 10 3 8 13 7 1 2 9 4 11 12 6 0 val it = () : unit
2 通りの周遊経路が表示されましたが、逆回りの経路があるので、実際の経路は次の 1 通りしかありません。「騎士の周遊」は、拙作のページ Puzzle DE Programming の「騎士の巡歴 (Knight's Tour)」でも取り上げています。興味のある方は参考にしてください。
┌─┬─┐
│０│７│
┌─┼─┼─┼─┐
│６│11│４│13│
├─┼─┼─┼─┤
│１│×│×│８│
├─┼─┼─┼─┤
│10│５│12│３│
└─┼─┼─┼─┘
│２│９│
└─┴─┘
図 : 周遊経路
それではプログラムを作りましょう。今回は重複解をチェックすることにします。次の図を見てください。
０
／ ＼
１ ８
／ ＼
２ ７
／ ＼
３───４───５───６
図 : 変形魔方陣の盤面
変形魔方陣の場合、回転解が 3 種類あって、鏡像解が 2 種類あります。3 つの頂点の大小関係をチェックすることで、これらの対称解を排除することができます。盤面を配列 board で表すことにすると、具体的には次の条件を満たす解を探します。
Array.sub(board, 0) < Array.sub(board, 3) < Array.sub(board, 6)
このほかに、頂点の間にある 2 つの数字を入れ替えただけの解もあります。これらを重複解と考えて排除することにしましょう。具体的には、次の条件を追加します。
Array.sub(board, 1) < Array.sub(board, 2) Array.sub(board, 4) < Array.sub(board, 5) Array.sub(board, 7) < Array.sub(board, 8)
このように、数字の大小関係をチェックすることで、重複解を排除することができます。あとは順列を生成する途中で、条件を満たしているかチェックするだけです。プログラムは次のようになります。
リスト : 変形魔方陣の解法
(* 盤面 *)
val board = Array.array(9, 0)
(* 要素の削除 *)
fun remove(_, nil) = nil
| remove(n, x::xs) =
if x = n then xs else x::remove(n, xs)
(* 盤面の表示 *)
fun print_board () = (
Array.app (fn x => print (Int.toString(x) ^ " ")) board;
print "\n")
(* 数字の加算 *)
fun add_number(nil, sum) = sum
| add_number(x::xs, sum) = add_number(xs, sum + Array.sub(board, x))
(* 条件チェック *)
val check_func_list = [
fn x => true, (* 0 *)
fn x => true, (* 1 *)
fn x => Array.sub(board, 1) < x, (* 2 *)
fn x => Array.sub(board, 0) < x andalso
add_number([0,1,2], 0) + x = 20, (* 3 *)
fn x => true, (* 4 *)
fn x => Array.sub(board, 4) < x, (* 5 *)
fn x => Array.sub(board, 3) < x andalso
add_number([3,4,5], 0) + x = 20, (* 6 *)
fn x => true, (* 7 *)
fn x => Array.sub(board, 7) < x andalso
add_number([0,6,7], 0) + x = 20 ] (* 8 *)
(* 盤面の生成 *)
fun make_board(_, nil, _) = print_board()
| make_board(n, f::fs, nums) =
app (fn(x) => if f x
then (Array.update(board, n, x);
make_board(n + 1, fs, remove(x, nums)))
else ())
nums
fun solver() = make_board(0, check_func_list, [1,2,3,4,5,6,7,8,9])
関数 make_board で順列を生成します。条件はリスト check_func_list に格納されている関数を使ってチェックします。第 1 引数 n が盤面の位置、第 2 引数がチェック関数のリスト、第 3 引数が数字のリストです。第 2 引数が nil になると条件を全て満たしているので、関数 print_board で盤面を表示します。
数字を一つ選ぶ場合は、第 2 引数の関数 f を呼び出して条件を満たしているかチェックします。条件を満たしている場合は配列 board の n 番目に x を書き込み、make_board を再帰呼び出しして次の数字を選びます。
チェック関数は匿名関数を使って定義します。引数 x が選んだ数字です。0, 1, 4, 7 番目の数字を選ぶ場合は無条件で true を返します。2 番目の数字を選ぶ場合は、1 番目の数字よりも大きいかチェックします。3 番目の数字を選ぶ場合は、0 番目の数字よりも大きいことと、0, 1, 2, 3 番目の数字の合計値が 20 になるかチェックします。board にセットされた数字の足し算は関数 add_number で行います。あとは同様に、5, 6, 8 番目の数字を選ぶときに条件を満たしているかチェックします。
それでは、実行結果を示します。
- solver(); 1 6 8 5 2 4 9 3 7 2 4 9 5 1 6 8 3 7 2 6 7 5 3 4 8 1 9 3 4 8 5 2 6 7 1 9 4 2 9 5 1 8 6 3 7 4 3 8 5 2 7 6 1 9 val it = () : unit
解は全部で 6 通りになりました。
ところで、直線の値は 20 のほかにもいくつかあります。check_func_list を次のように修正するだけで簡単に求めることができます。
リスト：変形魔方陣の解法 (2)
val check_func_list = [
fn x => true, (* 0 *)
fn x => true, (* 1 *)
fn x => Array.sub(board, 1) < x, (* 2 *)
fn x => Array.sub(board, 0) < x, (* 3 *)
fn x => true, (* 4 *)
fn x => Array.sub(board, 4) < x, (* 5 *)
fn x => Array.sub(board, 3) < x andalso
add_number([3,4,5], 0) + x = add_number([0,1,2,3], 0), (* 6 *)
fn x => true, (* 7 *)
fn x => Array.sub(board, 7) < x andalso
add_number([0,6,7], 0) + x = add_number([0,1,2,3], 0)] (* 8 *)
それでは、実行結果を示します。
- solver(); 17:1 5 9 2 4 8 3 6 7 19:1 5 9 4 2 6 7 3 8 17:1 6 8 2 5 7 3 4 9 19:1 6 8 4 3 5 7 2 9 20:1 6 8 5 2 4 9 3 7 20:2 4 9 5 1 6 8 3 7 19:2 5 9 3 1 8 7 4 6 20:2 6 7 5 3 4 8 1 9 19:2 6 8 3 4 5 7 1 9 21:3 2 9 7 1 5 8 4 6 20:3 4 8 5 2 6 7 1 9 21:3 4 8 6 1 5 9 2 7 21:3 5 6 7 2 4 8 1 9 21:3 5 7 6 2 4 9 1 8 20:4 2 9 5 1 8 6 3 7 20:4 3 8 5 2 7 6 1 9 23:7 2 6 8 1 5 9 3 4 23:7 3 5 8 2 4 9 1 6 val it = () : unit
直線の値は 17, 19, 20, 21, 23 の 5 通りで、解は全部で 18 通りになりました。頂点に配置される数字の組み合わせは次のようになります。
17: (1, 2, 3) 19: (1, 4, 7), (2, 3, 7) 20: (1, 5, 9), (2, 5, 8), (3, 5, 7), (4, 5, 6) 21: (3, 6, 9), (3, 7, 8) 23: (7, 8, 9)
それでは、プログラムを作りましょう。最小手数を求めるアルゴリズムといえば「幅優先探索」ですが、チャイニーズ・チェッカーは単純な「反復深化」でも解くことができます。
プログラムのポイントは、ペグを跳び越すときに手数も同時に数えていくことです。直前に動かしたペグと違うペグを動かすときは手数をカウントし、同じペグを動かすときは手数をカウントしません。これで連続跳び越しを 1 手と数えることができます。そして、この手数を使って反復深化を実行するわけです。
今回は、チャイニーズ・チェッカーの盤面をリストではなく、整数値のビットを使って表すことにします。つまり、ペグがある状態をビットオンで、ペグがない状態をビットオフで表します。位置とビットの対応は、下図の座標を参照してください。
● ０
／ ＼ ／ ＼
●───● １───２
／ ＼ ／ ＼ ／ ＼ ／ ＼
●───●───● ３───４───５
／ ＼ ／ ＼ ／ ＼ ／ ＼ ／ ＼ ／ ＼
●───●───●───● ６───７───８───９
／ ＼ ／ ＼ ／ ＼ ／ ＼ ／ ＼ ／ ＼ ／ ＼ ／ ＼
●───●───○───●───● 10───11───12───13───14
(1) 盤面 (2) 座標
図 : チャイニーズ・チェッカー
ペグの移動は跳び先表を用意すると簡単です。次のリストを見てください。
リスト : 跳び先表 (* 跳び先表 *) val jump_table = #[ [(1, 3), (2, 5)], (* 0 *) [(3, 6), (4, 8)], (* 1 *) [(4, 7), (5, 9)], (* 2 *) [(1, 0), (4, 5), (6, 10), (7, 12)], (* 3 *) [(7, 11), (8, 13)], (* 4 *) [(2, 0), (4, 3), (8, 12), (9, 14)], (* 5 *) [(3, 1), (7, 8)], (* 6 *) [(4, 2), (8, 9)], (* 7 *) [(4, 1), (7, 6)], (* 8 *) [(5, 2), (8, 7)], (* 9 *) [(6, 3), (11, 12)], (* 10 *) [(7, 4), (12, 13)], (* 11 *) [(7, 3), (8, 5), (11, 10), (13, 14)], (* 12 *) [(8, 4), (12, 11)], (* 13 *) [(9, 5), (13, 12)]] (* 14 *)
ペグの跳び先表はベクタ jump_table で定義します。ベクタの要素はリストであることに注意してください。リストの要素は、跳び越されるペグの位置と跳び先の位置を格納した組 (int * int) です。たとえば、0 番の位置にあるペグは、1 番を跳び越して 3 番へ移動する場合と、2 番を跳び越して 5 番へ移動する場合の 2 通りがあります。これを組 (1, 3) と (2, 5) で表しています。
次はペグを操作する関数を作ります。
リスト : ペグの操作関数 (* ペグをセットする *) fun set_bit n = Word.<<(0w1, Word.fromInt n) (* ペグの有無を返す *) fun check_peg(board, n) = Word.andb(board, set_bit n) <> 0w0 (* ペグを動かす *) fun move_peg(board, from, del, to) = Word.xorb(board, set_bit from + set_bit del + set_bit to) (* 動かすペグを探す *) fun search_peg(_, _, 0w0) = () | search_peg(f, n, board) = ( if Word.andb(board, 0w1) <> 0w0 then f n else (); search_peg(f, n + 1, Word.>>(board, 0w1)))
今回のプログラムはペグをビットで表すので、盤面を表すデータ型は Word を使います。関数 set_bit は引数 n の位置のビットを 1 にセットした Word 型データを返します。関数 check_peg は盤面 board の n 番目にペグがあるかチェックします。関数 move_peg は盤面 board のペグを動かして、新しい盤面を返します。from は跳ぶペグの位置、del は跳び越されるペグの位置、to は跳び先の位置です。この処理は from, del, to の位置のビットを 1 にセットし、board との排他的論理和 (xor) を計算するだけです。
関数 search_peg は盤面 board にあるペグを探す関数です。第 1 引数がペグを見つけたときに実行する関数です。この関数には引数として見つけたペグの位置を渡します。第 2 引数がペグの位置、第 3 引数が盤面を表すデータです。search_peg は board を 1 ビット右シフトしながらペグを探していることに注意してください。第 3 引数が 0w0 の場合、board にペグは存在しないので再帰呼び出しを終了します。
次は反復深化で解を探す関数 ids を作ります。
リスト : 反復深化
fun ids(board, n, jc, limit, history) =
if n = max_jump
then if check_peg(board, 12)
then (print_move(~1, rev history); raise Exit)
else ()
else
search_peg(fn from =>
app (fn(del,to) =>
if check_peg(board, del) andalso not(check_peg(board, to))
then
let
val new_board = move_peg(board, from, del, to)
val new_jc = jump_count(jc, from, history)
in
if new_jc <= limit
then ids(new_board, n + 1, new_jc, limit, (from,to)::history)
else ()
end
else ())
(Vector.sub( jump_table, from )),
0, board)
引数 board が盤面、n がペグを動かした回数、jc が手数 (跳んだ回数)、limit が反復深化の上限値、history がペグの移動手順 (履歴) を表します。移動手順は (跳ぶペグの位置, 跳び先の位置) を組にしてリストに格納して表します。
チャイニーズ・チェッカーの場合、ペグの総数は 14 個なので、13 回 (max_jump) ペグを移動するとペグの個数は 1 つになります。そして、そのペグが 12 番目にあるならば、解を見つけることができました。print_move で手順を表示し、raise で例外 Exit を送出して処理を終了します。
そうでなければペグを移動します。search_peg でペグを探し、匿名関数 fn(from) => app (fn(del,to) => ... ) ... でペグを移動します。最初の匿名関数は search_peg から呼び出され、引数 from には動かすペグの位置が与えられます。次に関数 app で、跳び先表 jump_table から跳び越すペグの位置 del と跳び先の位置 to を求め、2 番目の匿名関数 fn(del, to) => ... に渡します。
ここで、del の位置にペグがあり to の位置が空であればペグを移動することができます。関数 move_peg でペグを移動し、関数 jump_count で連続跳び越しの回数を求めます。history の先頭要素 (PrevFrom, PrevTo) を求め、PrevTo が from と等しい場合は連続跳び越しと判断することができます。そして、new_jc <= limit であれば solve_id を再帰呼び出しします。ペグ・ソリテアを反復深化で解く場合、上限値 limit に達していても連続跳びによりペグを移動できることに注意してください。
最後に、手順を表示する関数 print_move と ids を呼び出す関数 solver を作ります。
リスト : チャイニーズ・チェッカーの解法
(* 手順を表示 *)
fun print_move(x, nil) = print ")\n"
| print_move(x, (from, to)::z) =
if x = ~1
then (print("(" ^ Int.toString from ^ "," ^ Int.toString to);
print_move(to, z))
else if x = from
then (print("," ^ Int.toString to); print_move(to, z))
else (print(")(" ^ Int.toString from ^ "," ^ Int.toString to); print_move(to, z))
(* チャイニーズ・チェッカーの解法 *)
fun solver() =
let
val a = Timer.startRealTimer()
val limit = ref 1
val board = Word.xorb(0wx7fff, set_bit 12)
in
(while !limit <= max_jump do (
print(Int.toString (!limit) ^ "moves\n");
ids(board, 0, 0, !limit, nil);
limit := !limit + 1)) handle Exit => ();
Timer.checkRealTimer a
end
移動手順は 1 手を (from, to) で表し、連続跳び越しの場合は (from, to1, to2, ..., to3) とします。print_move の第 1 引数 x が 1 手前の跳び先の位置を表します。~1 の場合は最初の移動です。"(from, to" を表示して print_move を再帰呼び出しします。このとき、第 1 引数の値に to を渡します。
x と from が等しい場合は連続跳び越しです。", to" を表示して print_move を再帰呼び出しします。それ以外の場合は連続跳び越しではないので、")(form,to" を表示して print_move を再帰呼び出しします。最後に第 2 引数が nil になったら ")\n" を表示して終了します。
関数 solve の ref 変数 limit が上限値、変数 board が盤面を表します。0wx7fff は全ての位置にペグがある状態で、set_bit( 12 ) と排他的論理和 (xor) を計算することで 12 番目のビットを 0 にしています。あとは while ループで上限値 limit を一つずつ増やしながら、チャイニーズ・チェッカーの解を探索します。
あとは特に難しいところはないと思います。詳細はプログラムリストをお読みくださいませ。
これでプログラムは完成です。実行結果は次のようになりました。
- solver ();
1moves
2moves
3moves
4moves
5moves
6moves
7moves
8moves
9moves
(10,12)(13,11)(3,10,12,3)(1,6)(5,3)(6,1)(14,5)(2,9,7)(0,3,12)
val it = TIME {usec=359192} : Time.time
最短手数は 9 手になりました。実行時間は 0.36 秒 (SML/NJ v110.98, Windows 10, Intel Core i5-6200U 2.30GHz) でした。最近のパソコンは高性能なので、穴の数が少ない盤面であれば、単純な反復深化でも高速に解くことができるようです。
(*
* peg15.sml : チャイニーズ・チェッカーの解法
*
* Copyright (C) 2005-2020 Makoto Hiroi
*)
(* 例外 *)
exception Exit
(* 定数 *)
val max_jump = 13
(* 跳び先表 (del, to) *)
val jump_table = #[
[(1, 3), (2, 5)], (* 0 *)
[(3, 6), (4, 8)], (* 1 *)
[(4, 7), (5, 9)], (* 2 *)
[(1, 0), (4, 5), (6, 10), (7, 12)], (* 3 *)
[(7, 11), (8, 13)], (* 4 *)
[(2, 0), (4, 3), (8, 12), (9, 14)], (* 5 *)
[(3, 1), (7, 8)], (* 6 *)
[(4, 2), (8, 9)], (* 7 *)
[(4, 1), (7, 6)], (* 8 *)
[(5, 2), (8, 7)], (* 9 *)
[(6, 3), (11, 12)], (* 10 *)
[(7, 4), (12, 13)], (* 11 *)
[(7, 3), (8, 5), (11, 10), (13, 14)], (* 12 *)
[(8, 4), (12, 11)], (* 13 *)
[(9, 5), (13, 12)]] (* 14 *)
(* ペグをセットする *)
fun set_bit n = Word.<<(0w1, Word.fromInt n)
(* ペグの有無を返す *)
fun check_peg(board, n) = Word.andb(board, set_bit n) <> 0w0
(* ペグを動かす *)
fun move_peg(board, from, del, to) =
Word.xorb(board, set_bit from + set_bit del + set_bit to)
(* 手順を表示 *)
fun print_move(x, nil) = print ")\n"
| print_move(x, (from, to)::z) =
if x = ~1
then (print("(" ^ Int.toString from ^ "," ^ Int.toString to);
print_move(to, z))
else if x = from
then (print("," ^ Int.toString to); print_move(to, z))
else (print(")(" ^ Int.toString from ^ "," ^ Int.toString to); print_move(to, z))
(* ジャンプのカウント *)
fun jump_count(jc, _, nil) = jc + 1
| jump_count(jc, from, (x, y)::z) = if from = y then jc else jc + 1
(* 動かすペグを探す *)
fun search_peg(_, _, 0w0) = ()
| search_peg(f, n, board) = (
if Word.andb(board, 0w1) <> 0w0 then f n else ();
search_peg(f, n + 1, Word.>>(board, 0w1)))
(* 反復深化 *)
fun ids(board, n, jc, limit, history) =
if n = max_jump
then if check_peg(board, 12)
then (print_move(~1, rev history); raise Exit)
else ()
else
search_peg(fn from =>
app (fn(del,to) =>
if check_peg(board, del) andalso not(check_peg(board, to))
then
let
val new_board = move_peg(board, from, del, to)
val new_jc = jump_count(jc, from, history)
in
if new_jc <= limit
then ids(new_board, n + 1, new_jc, limit, (from,to)::history)
else ()
end
else ())
(Vector.sub( jump_table, from )),
0, board)
(* チャイニーズ・チェッカーの解法 *)
fun solver() =
let
val a = Timer.startRealTimer()
val limit = ref 1
val board = Word.xorb(0wx7fff, set_bit 12)
in
(while !limit <= max_jump do (
print(Int.toString (!limit) ^ "moves\n");
ids(board, 0, 0, !limit, nil);
limit := !limit + 1)) handle Exit => ();
Timer.checkRealTimer a
end
それではプログラムを作りましょう。７パズルの盤面はリストで表します。盤面の位置と隣接リストは次のようになります。
┌─┬─┬─┬─┐
│０│１│２│３│
├─┼─┼─┼─┤
│４│５│６│７│
└─┴─┴─┴─┘
盤面の位置
図 : ７パズルの盤面
リスト : 隣接リスト val adjacent = #[ [1, 4], (* 0 *) [0, 2, 5], (* 1 *) [1, 6, 3], (* 2 *) [2, 7], (* 3 *) [0, 5], (* 4 *) [1, 4, 6], (* 5 *) [2, 5, 7], (* 6 *) [3, 6]] (* 7 *)
あとは「幅優先探索とスライドパズル」で作成した「８パズル」の最長手数を求めるプログラムとほとんど同じです。特に難しいところはないので、説明は省略いたします。詳細はプログラムリストをお読みくださいませ。
それでは実行結果を示します。
- solver_max ();
36
0 7 2 1 4 3 6 5
val it = TIME {usec=62446} : Time.time
最長手数は 36 手で、その配置は 1 通りしかありません。図に示すと次のようになります。
┌─┬─┬─┬─┐ ┌─┬─┬─┬─┐
│１│２│３│４│ │ │７│２│１│
├─┼─┼─┼─┤ => ├─┼─┼─┼─┤
│５│６│７│ │ │４│３│６│５│
└─┴─┴─┴─┘ └─┴─┴─┴─┘
完成形 最長手数 (36手)
図 : ７パズルの最長手数
興味のある方は 36 手で解く手順を求めてみてください。
(*
* seven.sml : 7 パズル
*
* Copyright (C) 2005-2020 Makoto Hiroi
*)
(***** ハッシュ表 *****)
(* シグネチャ *)
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
(* 隣接リスト *)
val adjacent = #[
[1, 4], (* 0 *)
[0, 2, 5], (* 1 *)
[1, 6, 3], (* 2 *)
[2, 7], (* 3 *)
[0, 5], (* 4 *)
[1, 4, 6], (* 5 *)
[2, 5, 7], (* 6 *)
[3, 6]] (* 7 *)
(* 同じ盤面か？ *)
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(8, 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")
(* ハッシュ表の生成 *)
structure ArrayItem: HASHITEM = struct
type item = int array
val size = 20201
fun hash_func board =
(Array.foldl (fn(x, a) => a * 8 + x) 0 board) mod size
fun equal(a, b) = equal_board a b
end
structure ArrayHash = makeHashtbl(ArrayItem)
(* データ型 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 isSome(ArrayHash.search(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,0]
val ht: (int array, bool) ArrayHash.hash = ArrayHash.create ()
in
ArrayHash.insert(start, true, ht);
bfs_max ht [Smax(7, start, 0)];
Timer.checkRealTimer a
end