M.Hiroi's Home Page

Functional Programming

お気楽 Standard ML of New Jersey 入門

[ PrevPage | SML/NJ | NextPage ]

反復深化と下限値枝刈り法

今回は反復深化で 8 パズルを解いてみましょう。経路の探索 で説明したように、反復深化は最短手数を求めることができるアルゴリズムです。幅優先探索と違って局面を保存する必要が無いため、必要となるメモリは深さ優先探索と同程度で済みます。また、プログラムも深さ優先探索と同じくらい簡単に作成することができます。

ただし、同じ探索を何度も繰り返すため実行時間が増大する、という欠点があります。ようするに、使用するメモリは少ないが実行時間が長くなるアルゴリズムなのです。実行時間が長くなるといっても、枝刈りを工夫することでパズルを高速に解くことができます。メモリ不足になる場合には、積極的に使ってみたいアルゴリズムといえるでしょう。

●反復深化による 8 パズルの解法

幅優先探索では全ての局面を保存しましたが、反復深化ではその必要はありません。盤面は配列 board で表します。駒の移動は board を書き換えて、バックトラックする時は元に戻すことにします。動かした駒はリスト moves に格納します。動かした駒がわかれば局面を再現できるので、それで移動手順を表すことにします。

それでは、解を求める関数 solver を作りましょう。次のリストを見てください。

リスト : 単純な反復深化による解法

fun ids(n, limit, board, space, goal, moves) =
  if n = limit then
    if equal_board board goal then print_intlist (List.tl (rev moves)) else ()
  else
    app (fn x => let
                   val p = Array.sub(board, x)
                 in
                   if p = List.hd moves then ()
                   else (
                     Array.update(board, space, p);
                     Array.update(board, x, 0);
                     ids(n + 1, limit, board, x, goal, p::moves);
                     Array.update(board, x, p);
                     Array.update(board, space, 0)
                   )
                 end)
        (Vector.sub(adjacent, space))

fun solver () =
  let 
    val a = Timer.startRealTimer()
    val board = Array.fromList [8,6,7,2,5,4,3,0,1]
    val goal  = Array.fromList [1,2,3,4,5,6,7,8,0]
    val limit = ref 1
  in
    while !limit <= 31 do (
      print(Int.toString(!limit) ^ " moves\n");
      ids(0, !limit, board, get_space board, goal, [0]);
      limit := !limit + 1
    );
    Timer.checkRealTimer a
  end

探索処理は関数 ids で行います。ids の引数 n が手数、limit が反復深化の上限値、board が盤面、space が空き場所の位置、goal はゴールの盤面、moves が移動手順を表します。n が limit に達したら、パズルが解けたかチェックします。ゴールに到達したら、print_intlist で手順を表示します。解をひとつ求めるだけでよければ、例外処理を使って処理を中断すればいいでしょう。

limit に達していない場合は、駒を移動して新しい局面を作ります。8 パズルのように、元の局面に戻すことが可能 (可逆的) なパズルの場合、単純な深さ優先探索では同じ移動手順を何度も繰り返すことがあります。そうなると、とんでもない解を出力するだけではなく、再帰呼び出しが深くなるとスタックがオーバーフローしてプログラムの実行が停止してしまいます。

このような場合、局面の履歴を保存しておいて同じ局面がないかチェックすることで、解を求めることができるようになります。ただし、同一局面をチェックする分だけ時間が余分にかかりますし、最初に見つかる解が最短手数とは限りません。

反復深化では深さが制限されているため、同一局面のチェックを行わなくてもスタックオーバーフローが発生することはありません。そのかわり、無駄な探索はどうしても避けることができません。8 パズルの場合、1 手前に動かした駒を再度動かすと 2 手前の局面に戻ってしまいます。完全ではありませんが、このチェックを入れるだけでもかなりの無駄を省くことができます。

プログラムでは、リスト moves に移動した駒を格納しているので、1 手前と同じ駒は動かさないようにチェックしています。なお、moves の初期値はダミーデータを入れて [0] としています。あとは関数 solver で上限値 limit を 1 手ずつ増やして関数 ids を呼び出すだけです。

●実行結果

それでは実行してみましょう。

- solver ();
1 moves
2 moves
3 moves

・・・省略・・・

29 moves
30 moves
31 moves
5 6 8 2 3 5 1 4 7 8 6 3 5 1 4 7 8 6 3 5 1 4 7 8 6 3 2 1 4 7 8
5 6 7 4 6 2 3 5 1 6 2 3 8 7 4 2 3 1 5 8 7 4 1 5 8 7 4 1 2 3 6
5 2 3 5 1 4 7 6 8 3 2 8 3 2 5 1 4 7 8 5 1 4 7 8 6 3 2 1 4 7 8

・・・省略・・・

1 4 5 2 3 1 4 5 7 6 8 3 2 8 3 2 1 4 5 7 8 5 7 8 6 3 2 1 4 7 8
1 4 5 2 3 1 4 5 7 6 2 3 8 2 3 8 1 4 8 7 5 8 7 5 6 3 2 1 4 7 8
1 4 5 2 3 1 4 5 7 6 2 3 8 2 3 8 1 4 5 7 8 5 7 8 6 3 2 1 4 7 8
val it = TIME {usec=12757582} : Time.time

当然ですが最短手数は 31 手で 40 通りの手順が表示されました。実行時間は 12.8 秒 (SML/NJ v110.98, Windows 10, Intel Core i5-6200U 2.30GHz) かかりました。10 秒以上かかるのですから、やっぱり遅いですね。反復深化の場合、枝刈りを工夫しないと高速に解くことはできません。そこで、反復深化の常套手段である「下限値枝刈り法」を使うことにしましょう。

●下限値枝刈り法

下限値枝刈り法は難しいアルゴリズムではありません。たとえば、5 手進めた局面を考えてみます。探索の上限値が 10 手とすると、あと 5 手だけ動かすことができますね。この時、パズルを解くのに 6 手以上かかることがわかれば、ここで探索を打ち切ることができます。

このように、必要となる最低限の手数が明確にわかる場合、この値を「下限値 (Lower Bound)」と呼びます。この下限値を求めることができれば、「今の移動手数+下限値」が探索手数を超えた時点で、枝刈りすることが可能になります。これが下限値枝刈り法の基本的な考え方です。

さて、下限値を求める方法ですが、これにはいろいろな方法が考えられます。今回は、各駒が正しい位置へ移動するまでの手数 (移動距離) [*1] を下限値として利用することにしましょう。次の図を見てください。


          図 1 : 下限値の求め方

たとえば、右下にある 1 の駒を左上の正しい位置に移動するには、最低でも 4 手必要です。もちろん、ほかの駒との関連で、それ以上の手数が必要になる場合もあるでしょうが、4 手より少なくなることは絶対にありません。同じように、各駒について最低限必要な手数を求めることができます。そして、その合計値はパズルを解くのに最低限必要な手数となります。これを下限値として利用することができます。ちなみに、図 1 (2) の初期状態の下限値は 21 手になります。

下限値枝刈り法を使う場合、下限値の計算を間違えると正しい解を求めることができなくなります。たとえば、10 手で解ける問題の下限値を 11 手と計算すれば、最短手数を求めることができなくなります。それどころか、10 手の解しかない場合は、答えを求めることすらできなくなります。下限値の計算には十分に注意してください。

-- note -----
[*1] これを「マンハッタン距離」と呼ぶことがあります。

●下限値枝刈り法のプログラム

それでは、プログラムを作りましょう。下限値の求め方ですが、駒を動かすたびに各駒の移動距離を計算していたのでは時間がかかります。8 パズルの場合、1 回に一つの駒しか移動しないので、初期状態の下限値を求めておいて、動かした駒の差分だけ計算すればいいでしょう。

また、駒の移動距離はいちいち計算するのではなく、あらかじめ計算した結果を配列に格納しておきます。この配列を distance とすると、盤面から移動距離を求めるプログラムは次のようになります。

リスト : 移動距離を求める

val 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]
]

fun get_distance board =
  Array.foldl (fn(n, a) => a + Vector.sub(Vector.sub(distance, Array.sub(board, n)), n)) 0 board

distance は 2 次元配列で「駒の種類×駒の位置」を表しています。配列のアクセスをC言語のように角カッコ [ ] で表記すると、空き場所は関係ないので、distance[0] はダミー (要素が 0 の配列) となります。関数 get_distance は盤面 board にある駒と位置から移動距離を求めます。この処理は distance[board[n]][n] の合計値を Array.foldl で求めるだけです。

次は、下限値枝刈り法による反復深化を行う関数 solver を作ります。次のリストを見てください。

リスト : 下限値枝刈り法

fun ids1(n, limit, board, space, goal, moves, lower) =
  if n = limit then
    if equal_board board goal then print_intlist (List.tl (rev moves)) else ()
  else
    app (fn x => let
                   val p = Array.sub(board, x)
                 in
                   if p = List.hd moves then ()
                   else
                     let
                       val newlower = lower - Vector.sub(Vector.sub(distance, p), x) 
                                            + Vector.sub(Vector.sub(distance, p), space)
                     in
                       if newlower + n <= limit then (
                         Array.update(board, space, p);
                         Array.update(board, x, 0);
                         ids1(n + 1, limit, board, x, goal, p::moves, newlower);
                         Array.update(board, x, p);
                         Array.update(board, space, 0)
                       ) else ()
                     end
                 end)
        (Vector.sub(adjacent, space))

fun solver1 () =
  let 
    val a = Timer.startRealTimer()
    val board = Array.fromList [8,6,7,2,5,4,3,0,1]
    val goal  = Array.fromList [1,2,3,4,5,6,7,8,0]
    val lower = get_distance board
    val limit = ref lower
  in
    while !limit <= 31 do (
      print(Int.toString(!limit) ^ " moves\n");
      ids1(0, !limit, board, get_space board, goal, [0], lower);
      limit := !limit + 1
    );
    Timer.checkRealTimer a
  end

関数 ids1 の引数 lower は現在の盤面 board の下限値を表しています。動かす駒の差分を計算して、新しい下限値 newlower を求めます。そして、newlower + n が上限値 limit を越えたら枝刈りを行います。limit 以下であれば ids1 を再帰呼び出しします。

最後に ids1 を呼び出す処理を修正します。関数 get_distance で初期状態の下限値 lower を求めます。下限値がわかるのですから、上限値 limit は 1 手からではなく下限値 lower からスタートします。あとは ids1 に下限値 lower を渡して呼び出すだけです。

●実行結果 (2)

それでは実行してみましょう。

- solver1 ();
21 moves
22 moves
23 moves
24 moves
25 moves
26 moves
27 moves
28 moves
29 moves
30 moves
31 moves
5 6 8 2 3 5 1 4 7 8 6 3 5 1 4 7 8 6 3 5 1 4 7 8 6 3 2 1 4 7 8
5 6 7 4 6 2 3 5 1 6 2 3 8 7 4 2 3 1 5 8 7 4 1 5 8 7 4 1 2 3 6
5 2 3 5 1 4 7 6 8 3 2 8 3 2 5 1 4 7 8 5 1 4 7 8 6 3 2 1 4 7 8

・・・省略・・・

1 4 5 2 3 1 4 5 7 6 8 3 2 8 3 2 1 4 5 7 8 5 7 8 6 3 2 1 4 7 8
1 4 5 2 3 1 4 5 7 6 2 3 8 2 3 8 1 4 8 7 5 8 7 5 6 3 2 1 4 7 8
1 4 5 2 3 1 4 5 7 6 2 3 8 2 3 8 1 4 5 7 8 5 7 8 6 3 2 1 4 7 8
val it = TIME {usec=109269} : Time.time

実行時間は 0.11 秒、約 120 倍という高速化に驚いてしまいました。下限値枝刈り法の効果はとても高いですね。

●参考文献

  1. 高橋謙一郎, 『特集 悩めるプログラマに効くアルゴリズム』, C MAGAZINE 2000 年 11 月号, ソフトバンク

●プログラムリスト

(*
 * eight1.sml : 反復深化による 8 パズルの解法
 *
 *              Copright (C) 2020 Makoto Hiroi
 *)

(* 隣接リスト *)
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 *)
]

(* 同じ盤面か? *)
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 print_intlist xs =
  (app (fn x => print (Int.toString x ^ " ")) xs; print "\n")

(* 単純な反復深化 *)
fun ids(n, limit, board, space, goal, moves) =
  if n = limit then
    if equal_board board goal then print_intlist (List.tl (rev moves)) else ()
  else
    app (fn x => let
                   val p = Array.sub(board, x)
                 in
                   if p = List.hd moves then ()
                   else (
                     Array.update(board, space, p);
                     Array.update(board, x, 0);
                     ids(n + 1, limit, board, x, goal, p::moves);
                     Array.update(board, x, p);
                     Array.update(board, space, 0)
                   )
                 end)
        (Vector.sub(adjacent, space))

fun solver () =
  let 
    val a = Timer.startRealTimer()
    val board = Array.fromList [8,6,7,2,5,4,3,0,1]
    val goal  = Array.fromList [1,2,3,4,5,6,7,8,0]
    val limit = ref 1
  in
    while !limit <= 31 do (
      print(Int.toString(!limit) ^ " moves\n");
      ids(0, !limit, board, get_space board, goal, [0]);
      limit := !limit + 1
    );
    Timer.checkRealTimer a
  end

(* 移動距離 *)
val 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]
]

fun get_distance board =
  Array.foldl (fn(n, a) => a + Vector.sub(Vector.sub(distance, Array.sub(board, n)), n)) 0 board

(* 下限値枝刈り法 *)
fun ids1(n, limit, board, space, goal, moves, lower) =
  if n = limit then
    if equal_board board goal then print_intlist (List.tl (rev moves)) else ()
  else
    app (fn x => let
                   val p = Array.sub(board, x)
                 in
                   if p = List.hd moves then ()
                   else
                     let
                       val newlower = lower - Vector.sub(Vector.sub(distance, p), x) 
                                            + Vector.sub(Vector.sub(distance, p), space)
                     in
                       if newlower + n <= limit then (
                         Array.update(board, space, p);
                         Array.update(board, x, 0);
                         ids1(n + 1, limit, board, x, goal, p::moves, newlower);
                         Array.update(board, x, p);
                         Array.update(board, space, 0)
                       ) else ()
                     end
                 end)
        (Vector.sub(adjacent, space))

fun solver1 () =
  let 
    val a = Timer.startRealTimer()
    val board = Array.fromList [8,6,7,2,5,4,3,0,1]
    val goal  = Array.fromList [1,2,3,4,5,6,7,8,0]
    val lower = get_distance board
    val limit = ref lower
  in
    while !limit <= 31 do (
      print(Int.toString(!limit) ^ " moves\n");
      ids1(0, !limit, board, get_space board, goal, [0], lower);
      limit := !limit + 1
    );
    Timer.checkRealTimer a
  end

●問題

次のパズルを幅優先探索または反復深化で解いてください。

  1. 水差し問題

    大きな容器に水が入っています。目盛の付いていない 8 リットルと 5 リットルの容器を使って、大きな容器から 4 リットルの水を汲み出してください。4 リットルの水は、どちらの容器に入れてもかまいません。水をはかる最短手順を求めてください。なお、水の総量に制限はありません。

  2. 農夫と山羊と狼とキャベツの問題

    農夫が狼と山羊とキャベツを持って川の左岸にいます。農夫はこれらを川の右岸へ運ばなければいけませんが、ボートにはそのうちのひとつしか乗せることができません。狼は山羊を好んで食べるため、この 2 つを同じ岸に残すことはできません。また、山羊はキャベツを好んで食べるため、この 2 つも同じ岸に残すことはできません。この条件で、荷物をすべて右岸へ運ぶ手順を求めてください。

  3. 騎士の交換

    下図の START から GOAL までの最短手順を求めてください。

    
                                  図 : 騎士の交換
    
  4. Hoppers (ペグ・ソリティア 13 穴盤)

    ペグ・ソリテアは、盤上に配置されたペグ (駒) を、最後にはひとつ残るように取り除いていく、古典的なパズルです。Hoppers は芦ヶ原伸之氏が考案されたペグ・ソリテアです。次の図を見てください。

    
         図 : Hoppers
    

    Hoppers は穴を 13 個に減らしていて、遊ぶのに手頃な大きさになっています。上図に示したように、最初に中央のペグを取り除きます。この状態から始めて、最後のペグが中央の位置に残る跳び方の最小手数を求めてください。

パズルの詳しい説明は拙作のページ Puzzle DE Programming をお読みください。













●解答 1 - 3

リスト : パズルの解法 (幅優先探索)

(* 例外 *)
exception Found

(* 探索 *)
fun member(_, nil) = false
|   member(x, y::ys) = if x = y then true else member(x, ys)

(***** 水差し問題 *****)

(* 容器のサイズ*)
val max_a = 8
val max_b = 5

(* 容器の操作関数 *)
fun move1 (_, b) = (0, b)
fun move2 (_, b) = (max_a, b)
fun move3 (a, b) =
  let 
    val d = max_b - b
  in
    if a > d then (a - d, max_b)
    else (0, a + b)
  end

fun move4 (a, _) = (a, 0)
fun move5 (a, _) = (a, max_b)
fun move6 (a, b) =
  let 
    val d = max_a - a
  in
    if b > d then (max_a, b - d)
    else (a + b, 0)
  end

(* 手順の表示 *)
fun print_tuple (a, b) =
  print ("(" ^ Int.toString a ^ ", " ^ Int.toString b ^ ")")

fun print_move move =
  (app print_tuple move; print "\n"; raise Found)

(* 
 * 幅優先探索
 * キューは The Util Library の Queue を使う
 *)
fun solver1 goal =
  let
    val que: (int * int) list Queue.queue = Queue.mkQueue ()
  in
    Queue.enqueue(que, [(0, 0)]);
    while not (Queue.isEmpty que) do
      let 
        val move = Queue.dequeue que
        val state as (a, b) = hd move
      in
        if a = goal orelse b = goal then print_move (rev move)
        else
          app (fn f => let
                         val newstate = f state
                       in
                         if member(newstate, move) then ()
                         else Queue.enqueue(que, newstate::move)
                       end)
              [move1, move2, move3, move4, move5, move6]
      end
  end

(***** 農夫と山羊と狼とキャベツの問題 *****)
(* F : 農夫
   G : 山羊
   W : 狼
   C : キャベツ *)
datatype item = F | G | W | C

(* xs の要素がすべて ys に含まれていれば真を返す *)
fun find2 nil _ = true
|   find2 (x::xs1) ys = if member(x, ys) then find2 xs1 ys else false

fun remove x xs = List.filter (fn y => x <> y) xs

(* xs の要素を ys から取り除く *)
fun remove2 nil ys = ys
|   remove2 (x::xs1) ys = remove2 xs1 (remove x ys)

(* ボートで移動する *)
fun boat (left, right) xs =
  if find2 xs left then SOME (remove2 xs left, xs @ right)
  else if find2 xs right then SOME (xs @ left, remove2 xs right)
  else NONE

(* 山羊またはキャベツが食べられるか *)
fun attack (left, right) =
  if member(F, left) then
    (find2 [W, G] right) orelse (find2 [G, C] right)
  else
    (find2 [W, G] left) orelse (find2 [G, C] left)

(* item の表示 *)
fun print_item x =
  case x
    of F => print "Farmer "
     | W => print "Wolf "
     | G => print "Goat "
     | C => print "Cabbage "

(* item list の表示 *)
fun print_itemlist xs = (print "[ "; app print_item xs; print "]")

(* 手順の表示 *)
fun print_move2 nil = (print "\n"; raise Found)
|   print_move2 ((left, right)::xs) =
  (
    print "left: "; print_itemlist left;
    print "  right: "; print_itemlist right;
    print "\n";
    print_move2 xs
  )

(* 幅優先探索 *)
fun solver2 () =
  let
    val que: (item list * item list) list Queue.queue = Queue.mkQueue ()
  in
    Queue.enqueue(que, [([F,G,W,C], [])]);
    while not(Queue.isEmpty que) do
      let 
        val move = Queue.dequeue que
        val state as (left, right) = hd move
      in
        if null left then print_move2 (rev move)
        else
          app (fn xs =>
                 case boat state xs
                   of NONE => ()
                    | SOME newstate => 
                        if not(attack newstate) andalso not (member(newstate, move))
                        then Queue.enqueue (que, newstate::move)
                        else ())
              [[F], [F,W], [F,G], [F,C]]
      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

(* 隣接リスト *)
val adjacent = #[
  [5, 7],
  [6, 8],
  [3, 7],
  [2, 8, 10],
  [9, 11],
  [0, 6, 10],
  [1, 5, 11],
  [0, 2],
  [1, 3, 9],
  [4, 8],
  [3, 5],
  [4, 6] 
]

(* 局面 *)
datatype state = Nil | S of int array * 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 move_piece board src dst =
  let
    val newb = Array.array(Array.length board, 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_move3 Nil = ()
|   print_move3(S(board, prev)) = (print_move3 prev; print_board board)

(* ハッシュ表の生成 *)
structure ArrayItem: HASHITEM = struct
  type item = int array
  val size = 18493
  fun hash_func board = 
    (Array.foldl (fn(x, a) => a * 3 + x) 0 board) mod size
  fun equal(a, b) = equal_board a b
end

structure ArrayHash = makeHashtbl(ArrayItem)

(* 幅優先探索 *)
fun solver3 () =
  let 
    val start = Array.fromList [1,1,1,0,0,0,0,0,0,2,2,2]
    val goal  = Array.fromList [2,2,2,0,0,0,0,0,0,1,1,1]
    val que: state Queue.queue = Queue.mkQueue ()
    val ht: (int array, bool) ArrayHash.hash = ArrayHash.create ()
    val st_s = S(start, Nil)
  in
    Queue.enqueue(que, st_s);
    ArrayHash.insert(start, true, ht);
    while not(Queue.isEmpty que) do
      let
        val st as S(board, prev) = Queue.dequeue que
      in
        if equal_board board goal then (print_move3 st; raise Found)
        else
          app (fn x => if Array.sub(board, x) = 0 then ()
                       else
                         app (fn y => if Array.sub(board, y) = 0 then
                                        let
                                          val newb = move_piece board x y
                                        in
                                          if ArrayHash.member(newb, ht) then ()
                                          else (
                                            ArrayHash.insert(newb, true, ht);
                                            Queue.enqueue(que, S(newb, st)))
                                        end
                                      else ())
                             (Vector.sub(adjacent, x)))
              [0,1,2,3,4,5,6,7,8,9,10,11]
      end
  end
- solver1 4
= ;
(0, 0)(0, 5)(5, 0)(5, 5)(8, 2)(0, 2)(2, 0)(2, 5)(7, 0)(7, 5)(8, 4)

uncaught exception Found

- solver2 ();
left: [ Farmer Goat Wolf Cabbage ]  right: [ ]
left: [ Wolf Cabbage ]  right: [ Farmer Goat ]
left: [ Farmer Wolf Cabbage ]  right: [ Goat ]
left: [ Cabbage ]  right: [ Farmer Wolf Goat ]
left: [ Farmer Goat Cabbage ]  right: [ Wolf ]
left: [ Goat ]  right: [ Farmer Cabbage Wolf ]
left: [ Farmer Goat ]  right: [ Cabbage Wolf ]
left: [ ]  right: [ Farmer Goat Cabbage Wolf ]


uncaught exception Found

- solver3 ();
1 1 1 0 0 0 0 0 0 2 2 2
0 1 1 0 0 1 0 0 0 2 2 2
0 1 0 1 0 1 0 0 0 2 2 2
0 1 0 0 0 1 0 0 1 2 2 2
0 1 0 2 0 1 0 0 1 2 0 2
0 1 2 0 0 1 0 0 1 2 0 2
0 1 2 0 0 0 0 0 1 2 1 2
0 1 2 1 0 0 0 0 0 2 1 2
0 1 2 1 0 0 0 0 2 0 1 2
0 1 2 1 0 0 2 0 2 0 1 0
0 1 2 1 0 2 0 0 2 0 1 0
0 0 2 1 0 2 1 0 2 0 1 0
2 0 2 1 0 0 1 0 2 0 1 0
2 0 2 1 0 0 0 0 2 0 1 1
2 2 2 1 0 0 0 0 0 0 1 1
2 2 2 0 0 0 0 0 1 0 1 1
2 2 2 0 0 0 0 0 0 1 1 1

uncaught exception Found

問題 3 の手順を書き直すと次のようになります。

 1 1 1
 0 0 0
 0 0 0
 2 2 2
[START]

 0 1 1    0 1 0    0 1 0    0 1 0    0 1 2    0 1 2    0 1 2    0 1 2
 0 0 1    1 0 1    0 0 1    2 0 1    0 0 1    0 0 0    1 0 0    1 0 0
 0 0 0    0 0 0    0 0 1    0 0 1    0 0 1    0 0 1    0 0 0    0 0 2
 2 2 2    2 2 2    2 2 2    2 0 2    2 0 2    2 1 2    2 1 2    0 1 2

 0 -> 5   2 -> 3   3 -> 8   10 -> 3  3 -> 2   5 -> 10  8 -> 3   9 -> 8

 0 1 2    0 1 2    0 0 2    2 0 2    2 0 2    2 2 2    2 2 2    2 2 2
 1 0 0    1 0 2    1 0 2    1 0 0    1 0 0    1 0 0    0 0 0    0 0 0
 2 0 2    0 0 2    1 0 2    1 0 2    0 0 2    0 0 0    0 0 1    0 0 0
 0 1 0    0 1 0    0 1 0    0 1 0    0 1 1    0 1 1    0 1 1    1 1 1
                                                                [GOAL]
 11 -> 6  6 -> 5   1 -> 6   5 -> 0   6 -> 11  8 -> 1   3 -> 8   8 -> 9

●解答 4

今回はペグの有無を bool (true, false) で表します。盤面のデータ型は bool array になります。盤面と配列の対応は下図を見てください。


            図 : Hoppers の盤面

ペグの移動は跳び先表 (配列 jump_table) を用意すると簡単です。配列の要素はリストであることに注意してください。リストの要素は、跳び越されるペグの位置と跳び先の位置を格納したタプルです。たとえば、0 番の位置にあるペグは、1 番を跳び越して 2 番へ移動する場合と、3 番を跳び越して 6 番へ移動する場合と、5 番を飛び越して 10 番へ移動する場合の 3 通りがあります。これをリスト [(1, 2), (3, 6), (5, 10)] で表しています。

あとは単純な反復深化で最短手順を求めるだけです。詳細はプログラムリストをお読みくださいませ。

リスト : Hoppers の解法

(* 例外 *)
exception Found

(* 跳び先表 *)
val 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)]
]

val size = 13      (* 盤面の大きさ *)
val max_jump = 11  (* ペグがジャンプする回数 *)
val hole = 6       (* 中央の穴の位置 *)

(* 手順の表示 *)
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 limit = ref 2
    val board = Array.array(size, true)
    fun dfs jc limit move =
      if jc <= limit then
        if length move = max_jump then
          if Array.sub(board, hole) then
            (print_move(~1, rev move); raise Found)
          else ()
        else
          app (fn from => 
                if Array.sub(board, from) then
                  app (fn(del, to) =>
                        if Array.sub(board, del) andalso not(Array.sub(board, to)) then
                          (
                            Array.update(board, from, false);
                            Array.update(board, del, false);
                            Array.update(board, to, true);
                            dfs
                              (if #2(hd move) = from then jc else jc + 1)
                              limit
                              ((from, to)::move);
                            Array.update(board, to, false);
                            Array.update(board, del, true);
                            Array.update(board, from, true)
                          )
                        else ())
                      (Vector.sub(jump_table, from))
                else ())
              [0,1,2,3,4,5,6,7,8,9,10,11,12]
      else ()
  in
    (* 初手を 0 -> (3) -> 6: hole に限定 *)
    Array.update(board, 0, false);
    Array.update(board, 3, false);
    Array.update(board, hole, true);
    while !limit <= max_jump do
    (
      print (Int.toString(!limit) ^ " moves\n");
      dfs 1 (!limit) [(0, hole)];
      limit := !limit + 1
    )
  end
- solver();
2 moves
3 moves
4 moves
5 moves
6 moves
7 moves
(0,6)(9,3)(2,0,6)(11,1)(10,0,2,6)(8,4)(12,2,6)

uncaught exception Found

7 手で解くことができました。最近のパソコンは高性能なので、穴の数が少ない盤面であれば、単純な反復深化でも高速に解くことができるようです。


初版 2005 年 7 月 9 日
改訂 2020 年 8 月 23 日

Copyright (C) 2005-2020 Makoto Hiroi
All rights reserved.

[ PrevPage | SML/NJ | NextPage ]