前回は幅優先探索で「6 パズル」を解きました。[1, 5, 2, 6, 3, 4, 0] は 11 手で解くことができましたが、5040 通りの配置の中では、これよりも短い手数で解けるものもあるでしょうし、もっと長い手数がかかるものもあるでしょう。そこで、今度は単純に解くのではなく、パズルが完成するまでにいちばん手数がかかる配置を求めることにします。つまり、最短手数で解いてもいちばん長い手数（最長手数）となる、いちばん難しい配置を求めます。
なお、このドキュメントは拙作のページ パズルでプログラミング 「第 2 回 幅優先探索と 15 パズル」 のプログラムを SML/NJ で書き直したものです。内容は重複していますが、ご了承くださいませ。
最長手数の求め方ですが、5040 通りの配置の最短手数がすべてわかれば、最長の手数となる配置を求めることができます。しかしながら、この方法では時間がとてもかかりそうです。そこで、完成形から始めていちばん長い手数の局面を生成することにします。
まず、完成形から駒を動かして 1 手で到達する局面をすべて作ります。次に、これらの局面から駒を動かして新しい局面を作れば、完成形から 2 手で到達する局面となります。このように、手数を 1 手ずつ伸ばしていき、新しい局面が生成できなくなった時点での手数が求める最長手数となります。この処理は幅優先探索を使えばぴったりです。ただし、初期状態からの探索しかできないので、同一局面のチェックが線形探索のままでは時間がかかる、ということは覚悟してください。
このプログラムの目的は、いちばん長い手数となる配置を求めることなので、その手順を表示することは行いません。このため、一つ前の局面番号を格納する配列 prev_table は定義しません。その代わり、その局面までの手数を格納する配列 move_table を用意します。一つ前の局面の手数を move_table から求め、それに 1 を足せば現在の局面の手数となります。
それではプログラムを作ります。次のリストを見てください。
リスト : 6 パズルの最長手数を求める (1)
fun make_new_state( rear, front, nil ) = rear
| make_new_state( rear, front, x::xs ) =
let
val state = Array.sub( state_table, front )
val new_state = move_piece( List.nth( state, x ), state )
in
if check_same_state( new_state, rear - 1 )
then make_new_state( rear, front, xs )
else (
Array.update( state_table, rear, new_state );
Array.update( move_table, rear, Array.sub( move_table, front ) + 1 );
Array.update( space_table, rear, x );
make_new_state( rear + 1, front, xs )
)
end
fun solve_b( front, rear ) =
if front = rear then print_answer( rear - 1 )
else solve_b( front + 1,
make_new_state( rear, front,
List.nth( adjacent, Array.sub( space_table, front ))))
fun solve() = (
(* 初期化 *)
Array.update( state_table, 0, [1,2,3,4,5,6,0] );
Array.update( move_table, 0, 0 );
Array.update( space_table, 0, 6 );
solve_b( 0, 1 )
)
関数 solve は完成形 [1, 2, 3, 4, 5, 6, 0] をキューにセットして、幅優先探索を行う関数 solve_b を呼び出します。solve_b は生成できる局面がなくなるまで、つまりキューが空になるまで処理を繰り返します。キューが空になったら print_answer で最長手数の局面を表示します。それから、関数 make_new_state は最終状態をチェックする処理がないことに注意してください。キューに追加するときは、配列 move_table に手数 sub( move_table, front ) + 1 をセットします。
あとは特に難しいところはないでしょう。詳細は プログラムリスト１ をお読みくださいませ。
これでプログラムは完成です。さっそく実行してみましょう。
- solve(); max move = 15 4 6 5 1 3 2 0 4 3 5 0 6 2 1 0 6 5 4 3 2 1 4 6 2 0 3 5 1 4 3 2 1 6 5 0 0 3 2 4 6 5 1 4 6 0 5 3 2 1 0 6 4 5 3 1 2 0 6 3 4 5 1 2 4 0 5 6 3 2 1 0 4 6 5 3 2 1 4 6 5 0 2 3 1 0 4 5 6 1 2 3 0 5 4 6 3 2 1 6 0 3 4 5 2 1 5 2 0 4 3 6 1 0 2 5 4 1 6 3 0 5 6 4 2 3 1 0 3 1 4 6 2 5 1 6 2 4 3 5 0 3 6 1 4 0 2 5 0 1 2 4 3 5 6 1 3 5 4 6 2 0 2 1 5 4 3 0 6 val it = () : unit
最長手数は 15 手で、その配置は全部で 24 通りになりました。そのうちの一つを図に示すと次のようになります。
４------６
／ ＼ ／ ＼
５------１------３
＼ ／ ＼ ／
２------０
図 : いちばん難しい配置の例
ちなみに、生成した全局面は 5040 個になりました。しがたって、6 パズルでは数字をランダムに配置しても、必ず完成形に到達できることがわかります。実行時間ですが、M.Hiroi のオンボロマシン (Windows95, Pentium 166 MHz) では 12.9 秒 と時間がかかります。生成した局面は 5040 個もあるのですから、データの比較は相当の回数になります。実行時間の短縮には、同一局面のチェックに高速な探索アルゴリズムを使う必要があります。
それでは同一局面のチェックにハッシュ法を使ってみましょう。ハッシュ法のプログラムは、拙作のページ ハッシュ法 で作成したプログラムを使います。ハッシュ法の詳しい説明は、そちらをお読みくださいませ。プログラムは次のようになります。
リスト : ストラクチャの生成
structure IntListItem : HASHITEM = struct
type item = int list
val size = 503
fun hash_func( x ) =
(foldl (fn(a, b) => b * 10 + a) 0 x) mod size
fun equal( a, b ) = a = b
end
structure IntListHash = makeHash( IntListItem )
(* ハッシュ表の生成 *)
val hash_table = IntListHash.create()
ファンクタ makeHash を使って int list 用のハッシュ IntListHash を生成します。ハッシュ関数 hash_func は局面を表すリストを 10 進数の数値として計算し、ハッシュ表の大きさ 503 (素数) で割った余りをハッシュ値として返します。単純なハッシュ関数ですが、これでもハッシュ法は十分に機能します。ハッシュ表は関数 create で生成し、変数 hash_table にセットします。
ハッシュ法を使ったプログラムは次のようになります。
リスト : 6 パズルの最長手数を求める (2)
fun make_new_state( rear, front, nil ) = rear
| make_new_state( rear, front, x::xs ) =
let
val state = Array.sub( state_table, front )
val new_state = move_piece( List.nth( state, x ), state )
in
if IntListHash.insert( new_state, hash_table )
then (
Array.update( state_table, rear, new_state );
Array.update( move_table, rear, Array.sub( move_table, front ) + 1 );
Array.update( space_table, rear, x );
make_new_state( rear + 1, front, xs )
)
else make_new_state( rear, front, xs )
end
fun solve_b( front, rear ) =
if front = rear then print_answer( rear - 1 )
else solve_b( front + 1,
make_new_state( rear, front,
List.nth( adjacent, Array.sub( space_table, front ))))
fun solve() = (
(* 初期化 *)
Array.update( state_table, 0, [1,2,3,4,5,6,0] );
Array.update( move_table, 0, 0 );
Array.update( space_table, 0, 6 );
IntListHash.insert( [1,2,3,4,5,6,0], hash_table );
solve_b( 0, 1 )
)
関数 solve では、完成形を関数 IntListHash.insert でハッシュ表に登録します。insert はハッシュ表にデータが見つからない場合はデータを登録して真を返し、データを見つけた場合は偽を返します。あとは make_new_state の同一局面のチェックで IntListHash.insert を呼び出して、new_state が新しい局面であればキューに登録します。
あとは特に難しいところはないでしょう。詳細は プログラムリスト２ をお読みください。
さっそく実行してみたところ、実行時間は 1.3 秒 (Windows95, Pentium 166 MHz) まで短縮しました。約 10 倍弱の高速化ですね。ハッシュ法の効果は十分に出ていると思います。ところで、今回のプログラムはハッシュ表の大きさを 503 としましたが、実行速度はハッシュ表の大きさやハッシュ関数によって大きく変化します。興味のある方はいろいろ試してみてください。
(*
* six_max.sml : 6 パズルの最長手数を求める (1)
*
* Copyright (C) 2005 Makoto Hiroi
*)
(* 例外の定義 *)
exception Exit
(* 隣接リスト *)
val 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 *)
(* キューの定義 *)
val max_state = 5040
val state_table = Array.array( max_state, nil: int list )
val move_table = Array.array( max_state, 0 );
val space_table = Array.array( max_state, 0 );
(* 駒の移動 *)
fun move_piece( _, nil ) = nil
| move_piece( a, x::xs ) =
if x = a then 0 :: move_piece( a, xs )
else if x = 0 then a :: move_piece( a, xs )
else x :: move_piece( a, xs )
(* 同一局面のチェック：線形探索 *)
fun check_same_state( state, ~1 ) = false
| check_same_state( state, n ) =
if Array.sub( state_table, n ) = state
then true
else check_same_state( state, n - 1 )
(* int list の表示 *)
fun print_intlist( nil ) = print( "\n" )
| print_intlist( x::xs ) =
( print( Int.toString(x) ^ " " ); print_intlist( xs ) )
(* 最長手数の局面を表示する *)
fun print_answer( n ) =
let
val max = Array.sub( move_table, n )
val i = ref n
in
print( "max move = " ^ Int.toString( max ) ^ "\n" );
while Array.sub( move_table, !i ) = max do (
print_intlist( Array.sub( state_table, !i ) );
i := !i - 1
)
end
(* 新しい局面を作る *)
fun make_new_state( rear, front, nil ) = rear
| make_new_state( rear, front, x::xs ) =
let
val state = Array.sub( state_table, front )
val new_state = move_piece( List.nth( state, x ), state )
in
if check_same_state( new_state, rear - 1 )
then make_new_state( rear, front, xs )
else (
Array.update( state_table, rear, new_state );
Array.update( move_table, rear, Array.sub( move_table, front ) + 1 );
Array.update( space_table, rear, x );
make_new_state( rear + 1, front, xs )
)
end
(* 幅優先探索 *)
fun solve_b( front, rear ) =
if front = rear then print_answer( rear - 1 )
else solve_b( front + 1,
make_new_state( rear, front,
List.nth( adjacent, Array.sub( space_table, front ))))
fun solve() = (
(* 初期化 *)
Array.update( state_table, 0, [1,2,3,4,5,6,0] );
Array.update( move_table, 0, 0 );
Array.update( space_table, 0, 6 );
solve_b( 0, 1 )
)
fun solve_exe() =
let
val a = Timer.startRealTimer()
in
solve();
Timer.checkRealTimer( a )
end
(*
* six_max2.sml : 6 パズルの最長手数を求める (2)
*
* Copyright (C) 2005 Makoto Hiroi
*)
(* 例外の定義 *)
exception Exit
(* ハッシュ法 *)
signature HASHITEM = sig
type item
val size : int
val hash_func : item -> int
val equal : item * item -> bool
end
functor makeHash( Item: HASHITEM ) = struct
(* データ型の定義 *)
datatype 'a hash = Hash of 'a array
(* ハッシュ表の生成 *)
fun create() = Hash( Array.array( Item.size, nil: Item.item list ) )
(* データの探索 *)
fun search( data, Hash( table ) ) =
let
val n = Item.hash_func( data )
val L = Array.sub( table, n )
in
List.find (fn(x) => Item.equal( x, data )) L
end
(* データの挿入 *)
fun insert( data, Hash( table ) ) =
let
val n = Item.hash_func( data )
val L = Array.sub( table, n )
in
if List.exists (fn(x) => Item.equal( x, data )) L
then false
else (Array.update( table, n, data::L ); true)
end
(* データの削除 *)
fun delete( data, Hash( table ) ) =
let
fun remove( nil ) = nil
| remove( x::xs ) =
if Item.equal( data, x ) then xs else remove( xs )
val n = Item.hash_func( data )
val L = Array.sub( table, n )
in
Array.update( table, n, remove( L ) )
end
end
structure IntListItem : HASHITEM = struct
type item = int list
val size = 503
fun hash_func( x ) =
(foldl (fn(a, b) => b * 10 + a) 0 x) mod size
fun equal( a, b ) = a = b
end
structure IntListHash = makeHash( IntListItem )
(* 隣接リスト *)
val 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 *)
(* キューの定義 *)
val max_state = 5040 (* 7! *)
val state_table = Array.array( max_state, nil: int list )
val move_table = Array.array( max_state, 0 );
val space_table = Array.array( max_state, 0 );
val hash_table = IntListHash.create()
(* 駒の移動 *)
fun move_piece( _, nil ) = nil
| move_piece( a, x::xs ) =
if x = a then 0 :: move_piece( a, xs )
else if x = 0 then a :: move_piece( a, xs )
else x :: move_piece( a, xs )
(* int list の表示 *)
fun print_intlist( nil ) = print( "\n" )
| print_intlist( x::xs ) =
( print( Int.toString(x) ^ " " ); print_intlist( xs ) )
(* 最長手数の局面を表示する *)
fun print_answer( n ) =
let
val max = Array.sub( move_table, n )
val i = ref n
in
print( "state is " ^ Int.toString( n + 1 ) ^ "\n" );
print( "max move is " ^ Int.toString( max ) ^ "\n" );
while Array.sub( move_table, !i ) = max do (
print_intlist( Array.sub( state_table, !i ) );
i := !i - 1
)
end
(* 新しい局面を作る *)
fun make_new_state( rear, front, nil ) = rear
| make_new_state( rear, front, x::xs ) =
let
val state = Array.sub( state_table, front )
val new_state = move_piece( List.nth( state, x ), state )
in
if IntListHash.insert( new_state, hash_table )
then (
Array.update( state_table, rear, new_state );
Array.update( move_table, rear, Array.sub( move_table, front ) + 1 );
Array.update( space_table, rear, x );
make_new_state( rear + 1, front, xs )
)
else make_new_state( rear, front, xs )
end
(* 幅優先探索 *)
fun solve_b( front, rear ) =
if front = rear then print_answer( rear - 1 )
else solve_b( front + 1,
make_new_state( rear, front,
List.nth( adjacent, Array.sub( space_table, front ))))
fun solve() = (
(* 初期化 *)
Array.update( state_table, 0, [1,2,3,4,5,6,0] );
Array.update( move_table, 0, 0 );
Array.update( space_table, 0, 6 );
IntListHash.insert( [1,2,3,4,5,6,0], hash_table );
solve_b( 0, 1 )
)
fun solve_exe() =
let
val a = Timer.startRealTimer()
in
solve();
Timer.checkRealTimer( a )
end
次は反復深化で「6 パズル」を解いてみましょう。反復深化で問題を解く場合、短い手数で解ける簡単な問題であれば、とくに工夫しなくても高速に解くことができます。ところが、複雑な問題を反復深化で解く場合、枝刈りを工夫しないと高速に解くことはできません。そこで、6 パズルを例題にして、反復深化の常套手段である「下限値枝刈り法」を説明します。
なお、このドキュメントは拙作のページ Common Lisp 入門 ちょっと寄り道「反復深化と下限値枝刈り法」 のプログラムを SML/NJ で書き直したものです。内容は重複していますが、ご了承くださいませ。
まず最初に、単純な反復深化で 6 パズルを解いてみましょう。プログラムは次のようになります。
リスト : 反復深化による 6 パズルの解法
fun solve_id( n, limit, goal, state, space, history ) =
if n = limit
then if state = goal
then (print_intlist(rev history); raise Exit) else ()
else app (fn(x) =>
let
val piece = List.nth( state, x )
in
if piece <> hd( history )
then solve_id( n + 1, limit, goal, move_piece( piece, state ),
x, piece :: history )
else ()
end)
(List.nth( adjacent, space ))
関数 solve_id は引数が多くてちょっと複雑ですが、内容はそれほど難しくありません。引数 n が手数、limit が反復深化の上限値、goal がゴールの局面、state が現在の局面、space が空き場所の位置、history が動かした駒の履歴を表します。
手数 n が limit に達したら、ゴールに到達したかチェックします。そうであれば、history を rev で逆順にして移動手順を表示します。移動手順は動かした駒の種類 (1 - 6) を表示するだけです。興味のある方は、この移動手順から局面を再現するプログラムを作ってみてください。そのあと、探索を終了するため raise で例外 Exit を送出します。
手数 n が limit よりも小さければ、駒を移動して新しい局面を生成します。反復深化では深さが制限されているため、同一局面のチェックを行わなくてもプログラムは正常に動作します。そのかわり、無駄な探索はどうしても避けることができません。6 パズルや 15 パズルの場合、1 手前に動かした駒を再度動かすと 2 手前の局面に戻ってしまいます。完全ではありませんが、このチェックを入れるだけでもかなりの無駄を省くことができます。
このプログラムは移動した駒を history に格納しているので、駒 piece が 1 手前の駒 hd( history ) と同じ場合は動かさないようにチェックしています。このため、solve_id を呼び出すとき、history は空リストではなく [0] に設定します。history を nil に設定すると動作しません。ご注意ください。
最後に、上限値を 1 手ずつ増やすプログラムを作ります。
リスト : 上限値を増やして探索を行う
fun solve( start, goal ) =
let
val limit = ref 1
val space = position_if( fn(x) => x = 0, start )
in
(while !limit < 16 do (
print( Int.toString( !limit ) ^ " moves\n" );
solve_id( 0, !, goal, start, space, [0] );
limit := !limit + 1
)) handle Exit => ()
end
ref 変数 limit が上限値を表し、while ループで limit の値を +1 していきます。例外 Exit の補足は while 式に対して行います。while ... do ( ... ) handle Exit => () とすると、do の後ろの式に対して handle が設定されるため、while ループを脱出することはできません。ご注意ください。
それでは実行してみましょう。
- solve( [4, 6, 5, 1, 3, 2, 0], [1, 2, 3, 4, 5, 6, 0] ); 1 moves 2 moves 3 moves 4 moves 5 moves 6 moves 7 moves 8 moves 9 moves 10 moves 11 moves 12 moves 13 moves 14 moves 15 moves 0 1 3 1 2 5 3 6 1 2 5 6 4 1 2 5
15 手で解くことができました。初期状態 [4, 6, 5, 1, 3, 2, 0] は前回求めた最長手数の局面です。実行時間は M.Hiroi のオンボロマシン (Windows95, Pentium 166 MHz) で約 33 秒かかりました。やっぱり単純な反復深化では遅いですね。それでは下限値枝刈り法を使ってみましょう。
下限値枝刈り法は難しいアルゴリズムではありません。たとえば、5 手進めた局面を考えてみます。探索の上限値が 10 手とすると、あと 5 手だけ動かすことができますね。このとき、パズルを解くのに 6 手以上かかることがわかれば、ここで探索を打ち切ることができます。
このように、必要となる最低限の手数が明確にわかる場合、この値を「下限値 (Lower Bound) 」と呼びます。この下限値を求めることができれば、「今の移動手数＋下限値」が探索手数を超えた時点で枝刈りすることが可能になります。これが下限値枝刈り法の基本的な考え方です。
下限値を求める方法はいろいろありますが、今回は各駒が正しい位置へ移動するまでの手数を下限値として利用することにしましょう。次の図を見てください。
4(1)───6(2) １───２
／ ＼ ／ ＼ ／ ＼ ／ ＼
5(2)───1(1)───3(2) ──→ ３───４───５
＼ ／ ＼ ／ ＼ ／ ＼ ／
2(2)─── ０ ６───０
(1)初期状態(下限値 10 手) (2)完成形
図 : 下限値の求め方
たとえば、右上にある 6 の駒を左下の正しい位置へ移動するには、最低でも 2 手必要です。もちろん、ほかの駒との関連で、それ以上の手数が必要になる場合もあるでしょうが、2 手より少なくなることは絶対にありません。同じように、各駒について最低限必要な手数を求めることができます。そして、その合計値はパズルを解くのに最低限必要な手数、つまり下限値として利用することができます。ちなみに、上図の初期状態の下限値は 10 手になります。
下限値の求め方ですが、駒を動かすたびに各駒の手数を計算していたのでは時間がかかりそうです。6 パズルの場合、1 回に一つの駒しか移動しないので、初期状態の下限値を求めておいて、動かした駒の差分だけを計算することにします。次のリストを見てください。
リスト : 移動手数
val distance = [
[0, 0, 0, 0, 0, 0, 0], (* 0 : dummy *)
[0, 1, 1, 1, 2, 2, 2], (* 1 *)
[1, 0, 2, 1, 1, 2, 2], (* 2 *)
[1, 2, 0, 1, 2, 1, 2], (* 3 *)
[1, 1, 1, 0, 1, 1, 1], (* 4 *)
[2, 1, 2, 1, 0, 2, 1], (* 5 *)
[2, 2, 1, 1, 2, 0, 1]] (* 6 *)
各駒の移動手数を変数 distance (int list list) に定義します。そうすると、駒の移動手数は次のように求めることができます。
List.nth( List.nth( distance, 駒 ), 位置 )
駒 piece を位置 x から空き場所 space に動かす場合、下限値は次のように計算することができます。
val dis = List.nth( distance, piece ) val new_low = low - List.nth( dis, x ) + List.nth( dis, space )
low が現在の局面の下限値を表します。位置 x と space での移動手数の差分を計算すれば、新しい下限値 new_low を求めることができます。
次に、下限値枝刈り法を行う関数 solve_id を作ります。
リスト : 下限値枝刈り法による反復深化
fun solve_id( n, limit, goal, low, state, space, history ) =
if n = limit
then if state = goal
then (print_intlist(rev history); raise Exit) else ()
else app (fn(x) =>
let
val piece = List.nth( state, x )
val dis = List.nth( distance, piece )
val new_low = low - List.nth( dis, x ) + List.nth( dis, space )
in
if piece <> hd( history )
then
if limit > n + new_low
then solve_id( n + 1, limit, goal, new_low,
move_piece( piece, state ), x, piece :: history )
else ()
else ()
end)
(List.nth( adjacent, space ))
関数 solve_id の引数 low は局面 state の下限値を表します。駒 piece を動かしたときの下限値 new_low を計算し、new_low + n が上限値 limit 以上になったならば探索を打ち切ります。limit より小さければ、solve_id を再帰呼び出しして探索を続行します。あとは今までのプログラムと同じです。
最後に、solve_id を呼び出す関数 solve を作ります。
リスト : 上限値を増やして探索を行う
fun solve( start, goal ) =
let
val space = position_if( fn(x) => x = 0, start )
val low = calc_lower_value( 0, start, 0 )
val limit = ref low
in
(while !limit < 16 do (
print( Int.toString( !limit ) ^ " moves\n" );
solve_id( 0, !limit, goal, low, start, space, [0] );
limit := !limit + 1
)) handle Exit => ()
end
関数 calc_lower_value は与えられた局面 start の下限値を求めます。簡単なプログラムなので詳細は プログラムリスト４ をお読みください。求めた下限値は low にセットします。下限値がわかるのですから、上限値 limit は 1 手からではなく low から始めます。
これでプログラムは完成です。さっそく実行してみましょう。
- solve([4, 6, 5, 1, 3, 2, 0], [1, 2, 3, 4, 5, 6, 0]); 10 moves 11 moves 12 moves 13 moves 14 moves 15 moves 0 1 3 1 2 5 3 6 1 2 5 6 4 1 2 5 val it = () : unit
実行時間は M.Hiroi のオンボロマシン (Windows 95, Pentium 166 MHz) で約 30 msec でした。単純な反復深化と比べて 1000 倍以上の高速化に M.Hiroi も驚いてしまいました。6 パズルの場合、下限値枝刈り法の効果は極めて高いようです。
(*
* six_id.sml : 6 パズルを反復深化で解く
*
* Copyright (C) 2005 Makoto Hiroi
*)
(* 例外の定義 *)
exception Exit
fun position_if( f, l ) =
let
fun position_if_sub( _, nil ) = ~1
| position_if_sub( n, x::xs ) =
if f( x ) then n else position_if_sub( n + 1, xs )
in
position_if_sub( 0, l )
end
(* 隣接リスト *)
val 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 *)
(* 駒の移動 *)
fun move_piece( _, nil ) = nil
| move_piece( a, x::xs ) =
if x = a then 0 :: move_piece( a, xs )
else if x = 0 then a :: move_piece( a, xs )
else x :: move_piece( a, xs )
(* int list の表示 *)
fun print_intlist( nil ) = print( "\n" )
| print_intlist( x::xs ) =
( print( Int.toString(x) ^ " " ); print_intlist( xs ) )
(* 反復深化 *)
fun solve_id( n, limit, goal, state, space, history ) =
if n = limit
then if state = goal
then (print_intlist(rev history); raise Exit) else ()
else app (fn(x) =>
let
val piece = List.nth( state, x )
in
if piece <> hd( history )
then solve_id( n + 1, limit, goal, move_piece( piece, state ),
x, piece :: history )
else ()
end)
(List.nth( adjacent, space ))
fun solve( start, goal ) =
let
val limit = ref 1
val space = position_if( fn(x) => x = 0, start )
in
(while !limit < 16 do (
print( Int.toString( !limit ) ^ " moves\n" );
solve_id( 0, !limit, goal, start, space, [0] );
limit := !limit + 1
)) handle Exit => ()
end
fun solve_exe() =
let
val a = Timer.startRealTimer()
in
solve( [4, 6, 5, 1, 3, 2, 0], [1, 2, 3, 4, 5, 6, 0] );
Timer.checkRealTimer( a )
end
(*
* six_id2.sml : 6 パズルを「反復深化＋下限値枝刈り法」で解く
*
* Copyright (C) 2005 Makoto Hiroi
*)
(* 例外の定義 *)
exception Exit
fun position_if( f, l ) =
let
fun position_if_sub( _, nil ) = ~1
| position_if_sub( n, x::xs ) =
if f( x ) then n else position_if_sub( n + 1, xs )
in
position_if_sub( 0, l )
end
(* 隣接リスト *)
val 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 *)
(* 移動手数 *)
val distance = [
[0, 0, 0, 0, 0, 0, 0], (* 0 : dummy *)
[0, 1, 1, 1, 2, 2, 2], (* 1 *)
[1, 0, 2, 1, 1, 2, 2], (* 2 *)
[1, 2, 0, 1, 2, 1, 2], (* 3 *)
[1, 1, 1, 0, 1, 1, 1], (* 4 *)
[2, 1, 2, 1, 0, 2, 1], (* 5 *)
[2, 2, 1, 1, 2, 0, 1]] (* 6 *)
(* 下限値の計算 *)
fun calc_lower_value( _, nil, low ) = low
| calc_lower_value( n, x::xs, low ) =
calc_lower_value( n + 1, xs, low + List.nth( List.nth( distance, x ), n ) )
(* 駒の移動 *)
fun move_piece( _, nil ) = nil
| move_piece( a, x::xs ) =
if x = a then 0 :: move_piece( a, xs )
else if x = 0 then a :: move_piece( a, xs )
else x :: move_piece( a, xs )
(* int list の表示 *)
fun print_intlist( nil ) = print( "\n" )
| print_intlist( x::xs ) =
( print( Int.toString(x) ^ " " ); print_intlist( xs ) )
(* 反復深化 + 下限値枝刈り法 *)
fun solve_id( n, limit, goal, low, state, space, history ) =
if n = limit
then if state = goal
then (print_intlist(rev history); raise Exit) else ()
else app (fn(x) =>
let
val piece = List.nth( state, x )
val dis = List.nth( distance, piece )
val new_low = low - List.nth( dis, x ) + List.nth( dis, space )
in
if piece <> hd( history )
then
if limit > n + new_low
then solve_id( n + 1, limit, goal, new_low,
move_piece( piece, state ), x, piece :: history )
else ()
else ()
end)
(List.nth( adjacent, space ))
fun solve( start, goal ) =
let
val space = position_if( fn(x) => x = 0, start )
val low = calc_lower_value( 0, start, 0 )
val limit = ref low
in
(while !limit < 16 do (
print( Int.toString( !limit ) ^ " moves\n" );
solve_id( 0, !limit, goal, low, start, space, [0] );
limit := !limit + 1
)) handle Exit => ()
end
fun solve_exe() =
let
val a = Timer.startRealTimer()
in
solve( [4, 6, 5, 1, 3, 2, 0], [1, 2, 3, 4, 5, 6, 0] );
Timer.checkRealTimer( a )
end