M.Hiroi's Home Page
http://www.geocities.jp/m_hiroi/

Functional Programming

お気楽 Standard ML of New Jersey 入門

[ PrevPage | SML/NJ | NextPage ]

パズルに挑戦!!

今回も 4 つのパズルを出題します。SML/NJ で解法プログラムを作成してください。

●問題5「マスターマインド」

マスターマインドは Scheme 入門 : 数当てゲーム [2] で作成した、0 から 9 までの重複しない 4 つの数字からなる隠しコードを当てるゲームです。数字は合っているが位置が間違っている個数を cows で表し、数字も位置も合っている個数を bulls で表します。bulls が 4 になると正解です。

     (6 2 8 1) : 正解
---------------------------------
1.   (0 1 2 3) : cows 2 : bulls 0
2.   (1 0 4 5) : cows 1 : bulls 0
3.   (2 3 5 6) : cows 2 : bulls 0
4.   (3 2 7 4) : cows 0 : bulls 1
5.   (3 6 0 8) : cows 2 : bulls 0
6.   (6 2 8 1) : cows 0 : bulls 4

  図 : マスターマインドの動作例

マスターマインドを解くプログラムを作ってください。

解答


●問題6「カークマンの 15 人の女生徒」

15 人の女生徒が毎日 3 人ずつ 5 組に分かれて散歩をするとき、1 週間 (7 日) のうちに、どの女生徒も他のすべての女生徒と 1 回ずつ同じ組になるような組み合わせを作ってください。(出典 : 大村平 (著), 『数理パズルの話』, 日科技連出版社, 1998)

「カークマンの 15 人の女生徒」を解くプログラムを作ってください。

解答


●問題7「ナンバープレース」

下図に示す 6 行 6 列盤のナンバープレース (数独) において、解となる盤面の総数を求めてください。

  ┏━┯━┯━┳━┯━┯━┓
  ┃1│2│3┃4│5│6┃
  ┠─┼─┼─╂─┼─┼─┨
  ┃4│5│6┃1│2│3┃
  ┣━┿━┿━╋━┿━┿━┫
  ┃2│1│4┃3│6│5┃
  ┠─┼─┼─╂─┼─┼─┨
  ┃3│6│5┃2│1│4┃
  ┣━┿━┿━╋━┿━┿━┫
  ┃5│3│1┃6│4│2┃
  ┠─┼─┼─╂─┼─┼─┨
  ┃6│4│2┃5│3│1┃
  ┗━┷━┷━┻━┷━┷━┛

 図 : 数独 (6 行 6 列盤) の解 (一例)

余裕のある方は 9 行 9 列盤の数独を解くプログラムも作ってみてください。

解答


●問題8「三目並べ」

三目並べは、皆さんお馴染みの二人で対戦するゲームです。ひとりが○側でもうひとりが×側を受け持ち、3 行 3 列のマス目に○×を書いて、3 つ並べた方が勝ちというゲームです。

 ┌─┬─┬─┐ 
 │×│○│○│ 
 ├─┼─┼─┤ 
 │○│○│×│ 
 ├─┼─┼─┤ 
 │×│×│○│ 
 └─┴─┴─┘ 

  図:三目並べ

上図は○側が先手で引き分けになった例です。三目並べは、両者が最善を尽くすと引き分けになることが知られています。本当に引き分けになるのか、プログラムを作って確かめてください。

解答


●解答5「マスターマインド」

それではプログラムを作りましょう。正解を見つけるアルゴリズムですが、簡単な方法があります。質問したコードとその結果を覚えておいて、それと矛盾しないコードを作るようにします。具体的には、4 つの数字の順列を生成し、それが今まで質問したコードと矛盾しないことを確かめます。これは生成検定法と同じですね。

矛盾しているかチェックする方法も簡単で、以前に質問したコードと比較して、bulls と cows が等しいときは矛盾していません。たとえば、次の例を考えてみてください。

(6 2 8 1) が正解の場合

(0 1 2 3) => bulls = 0, cows = 2

           (0 1 2 3)  と比較する
     --------------------------------------------------------
           (0 X X X)  0 から始まるコードは bulls = 1
                      になるので矛盾する。
           ・・・・

           (1 0 3 4)  cows = 3, bulls = 0 になるので矛盾する

           ・・・・

           (1 0 4 5)  cows = 2, bulls = 0 で矛盾しない。
     --------------------------------------------------------

(1 0 4 5) => bulls = 0, cows = 1

次は、(0 1 2 3) と (1 0 4 5) に矛盾しない数字を選ぶ

        図 : マスターマインドの推測アルゴリズム

(0 1 2 3) で bulls が 0 ですから、その位置にその数字は当てはまりません。したがって、(0 X X X) というコードは (0 1 2 3) と比較すると bulls が 1 となるので、矛盾していることがわかります。

次に (1 0 3 4) というコードを考えてみます。(0 1 2 3) の結果は cows が 2 ですから、その中で合っている数字は 2 つしかないわけです。ところが、(1 0 3 4) と (0 1 2 3) と比較すると cows が 3 になります。当たっている数字が 2 つしかないのに、同じ数字を 3 つ使うのでは矛盾していることになりますね。

次に (1 0 4 5) というコードと比較すると、bulls が 0 で cows が 2 となります。これは矛盾していないので、このコードを質問することにします。その結果が bulls = 0, cows = 1 となり、今度は (0 1 2 3) と (1 0 4 5) に矛盾しないコードを選択するのです。

まず最初に bulls と cows を求める関数を作ります。

リスト : bulls と cows を求める

(* 等しい要素があるか *)
fun mem(_, []) = false
|   mem(x, y::ys) = if x = y then true else mem(x, ys)

(* bulls を数える *)
fun count_bulls(xs, ys) =
    ListPair.foldl (fn(x, y, a) => if x = y then a + 1 else a) 0 (xs, ys)

(* 同じ数字を数える *)
fun count_same_number(xs, ys) =
    foldl (fn(x, a) => if mem(x, ys) then a + 1 else a) 0 xs

関数 count_bulls は ListPair.foldl を使うと簡単です。ListPair.foldl の型を示します。

val it = fn : ('a * 'b * 'c -> 'c) -> 'c -> 'a list * 'b list -> 'c

ListPair.foldl は 2 つのリストを引数に受け取ります。ListPair モジュールには map や foldr など 2 つのリストを引数に受け取る高階関数が定義されています。匿名関数の引数 a が bulls の個数で、x と y がリストの要素になります。x と y が等しい場合、a を +1 すれば bulls の個数を求めることができます。

次は、cows を数える処理を作ります。いきなり cows を数えようとすると難しいのですが、2 つのリストに共通の数字を数えることは簡単にできます。この方法では、bulls の個数を含んだ数を求めることになりますが、そこから bulls を引けば cows を求めることができます。関数名は count_same_number としました。この処理は foldl を使うと簡単です。匿名関数の引数 a が共通の数字の個数で、x がリスト xs の要素です。関数 mem で x が ys に含まれていれば、a の値を +1 します。

次は生成したコードが今までの結果と矛盾していないか調べる関数 check を作ります。次のリストを見てください。

リスト : 今までの質問と矛盾しているか

fun check(_, []) = true
|   check(q, (qcode, qbulls, qcows)::query) =
    let
      val bulls = count_bulls(q, qcode)
      val cows = count_same_number(q, qcode) - bulls
    in
      if bulls = qbulls andalso cows = qcows then check(q, query) else false
    end

質問したコードとその結果は組にまとめてリストに格納します。最初が質問したコード、次が bulls の個数、最後が cows の個数です。データはパターンマッチングで取り出して、局所変数 qcode, qbulls, qcows にセットします。そして、code と qcolde から bulls と cows を count_bulls と count_same_number で求めます。

bulls と qbulls が等しくて、cows と qcows が等しい場合、code は矛盾していないので、次のデータを調べます。そうでなれば code は矛盾しているので false を返します。すべてのデータを調べたら true を返します。

マスターマインドを解くプログラムは次のようになります。

リスト : マスターマインドの解法

fun mastermind(code) =
    let
      fun iter([], _) = 0
      |   iter(x::xs, query) =
          if check(x, query) then
            let
              val bulls = count_bulls(x, code)
              val cows = count_same_number(x, code) - bulls
            in
              print_intlist(x);
              print(": bulls " ^ Int.toString(bulls));
              print(", cows " ^ Int.toString(cows) ^ "\n");
              if bulls = 4 then length(query) + 1
              else iter(xs, (x, bulls, cows)::query)
            end
          else iter(xs, query)
    in
      iter(permutation(4, [0,1,2,3,4,5,6,7,8,9]), [])
    end

関数 mastermind の引数 code が正解のコードで、実際の処理は局所関数 iter で行います。関数 permutation はリストの中から 4 個の要素を選ぶ順列を生成し、それをリストに格納して返します。

あとは iter でコードを順番に取り出して、今まで質問したコードと矛盾していないか調べます。引数 query が今までに質問したコードと結果を格納したリストで、x が質問するコードです。check が true を返す場合、x は矛盾していないので、x と code を比較して bulls と cows を求めます。そして、その結果を表示します。

もしも、bulls が 4 ならば正解なので質問回数を返して処理を終了します。そうでなければ、query に今回の結果を追加して iter を再帰呼び出しします。x が矛盾している場合は iter を再帰呼び出しするだけです。

●何回で当たるか

これでプログラムは完成です。それでは実行例を示しましょう。

- mastermind([0,1,2,3]);
0 1 2 3 : bulls 4, cows 0
val it = 1 : int
- mastermind([9,8,7,6]);
0 1 2 3 : bulls 0, cows 0
4 5 6 7 : bulls 0, cows 2
5 4 8 9 : bulls 0, cows 2
6 7 9 8 : bulls 0, cows 4
8 9 7 6 : bulls 2, cows 2
9 8 7 6 : bulls 4, cows 0
val it = 6 : int
- mastermind([9,4,3,1]);
0 1 2 3 : bulls 0, cows 2
1 0 4 5 : bulls 0, cows 2
2 3 5 4 : bulls 0, cows 2
3 4 0 6 : bulls 1, cows 1
3 5 6 1 : bulls 1, cows 1
6 5 0 2 : bulls 0, cows 0
7 4 3 1 : bulls 3, cows 0
8 4 3 1 : bulls 3, cows 0
9 4 3 1 : bulls 4, cows 0
val it = 9 : int

肝心の質問回数ですが、5, 6 回で当たる場合が多いようです。実際に、5040 個のコードをすべて試してみたところ、平均は 5.56 回になりました。これは 参考文献 1 の結果と同じです。質問回数の最大値は 9 回で、そのときのコードは [9, 4, 3, 1], [9, 2, 4, 1], [5, 2, 9, 3], [9, 2, 0, 4], [9, 2, 1, 4] でした。

なお、参考文献 1 には平均質問回数がこれよりも少なくなる方法が紹介されています。単純な数当てゲームと思っていましたが、その奥はけっこう深いようです。興味のある方はいろいろ試してみてください。

●参考文献

  1. 田中哲郎, 「数当てゲーム (MOO, マスターマインド) 」, 松原仁、竹内郁雄 編 『bit 別冊 ゲームプログラミング』 pp150 - 157, 共立出版, 1997

●プログラムリスト

(*
 * mastermind.sml :  MaterMind 解答プログラム
 *
 *                   Copyright (C) 2012 Makoto Hiroi
 *)

(* 表示 *)
fun print_intlist([]) = ()
|   print_intlist(x::xs) = (print(Int.toString(x) ^ " "); print_intlist(xs))

(* 要素を削除する *)
fun remove(_, []) = []
|   remove(x, y::ys) =
    if x = y then remove(x, ys) else y :: remove(x, ys)

(* 等しい要素があるか *)
fun mem(_, []) = false
|   mem(x, y::ys) = if x = y then true else mem(x, ys)

(* 順列の生成 *)
fun permutation(n, ls) =
    let
      fun perm_sub(0, _, y, z) = (rev y)::z
      |   perm_sub(n, xs, y, z) =
          foldr (fn(a, b) => perm_sub(n - 1, remove(a, xs), a::y, b)) z xs
    in
      perm_sub(n, ls, [], [])
    end

(* bulls を数える *)
fun count_bulls(xs, ys) =
    ListPair.foldl (fn(x, y, a) => if x = y then a + 1 else a) 0 (xs, ys)

(* 同じ数字を数える *)
fun count_same_number(xs, ys) =
    foldl (fn(x, a) => if mem(x, ys) then a + 1 else a) 0 xs

(* 矛盾していないか *)
fun check(_, []) = true
|   check(q, (qcode, qbulls, qcows)::query) =
    let
      val bulls = count_bulls(q, qcode)
      val cows = count_same_number(q, qcode) - bulls
    in
      if bulls = qbulls andalso cows = qcows then check(q, query) else false
    end

(* マスターマインドを解く *)
fun mastermind(code) =
    let
      fun iter([], _) = 0
      |   iter(x::xs, query) =
          if check(x, query) then
            let
              val bulls = count_bulls(x, code)
              val cows = count_same_number(x, code) - bulls
            in
              print_intlist(x);
              print(": bulls " ^ Int.toString(bulls));
              print(", cows " ^ Int.toString(cows) ^ "\n");
              if bulls = 4 then length(query) + 1
              else iter(xs, (x, bulls, cows)::query)
            end
          else iter(xs, query)
    in
      iter(permutation(4, [0,1,2,3,4,5,6,7,8,9]), [])
    end

●解答6「カークマンの 15 人の女生徒」

「カークマンの 15 人の女生徒」の解法プログラムは Yet Another SML/NJ Problems (4) 問題 74 で作成した関数 group_partition を改造すると簡単に作成することができます。次のリストを見てください。

リスト : カークマンの 15 人の女生徒

fun remove(x, []) = []
|   remove(x, y::ys) = 
  if x = y then remove(x, ys) else y :: remove(x, ys)

fun iota(n, m) =
  let
    fun iter i a =
      if i < n then a else iter (i - 1) (i::a)
  in
    iter m []
  end

fun mem(_, []) = false
|   mem(x, y::ys) = if x = y then true else mem(x, ys)

fun print_intlist2([]) = print("\n")
|   print_intlist2(x::xs) = (
      print("( "); 
      List.app (fn y => print(Int.toString(y) ^ " ")) x;
      print(")");
      print_intlist2(xs)
    )

exception Kirkman_exit

val check_table : int list array = Array.array(16, [])

fun check_person([], _) = true
|   check_person(y::ys, x) =
    if mem(x, Array.sub(check_table, y)) then false
    else check_person(ys, x)

fun add_person(ls, x) =
    List.app (fn y => (
                 Array.update(check_table, x, y::Array.sub(check_table, x));
                 Array.update(check_table, y, x::Array.sub(check_table, y))
               ))
             ls

fun del_person(ls, x) =
    List.app (fn y => (
                 Array.update(check_table, x, tl (Array.sub(check_table, x)));
                 Array.update(check_table, y, tl (Array.sub(check_table, y)))
               ))
             ls

fun kirkman () =
    let
      fun kirkman_sub([], a, b) =
          if length(b) = 6 then (
              List.app (fn x => print_intlist2(x)) (rev (a::b));
              raise Kirkman_exit
            )
          else kirkman_sub(iota(2, 15), [[1]], a::b)
      |   kirkman_sub(x::xs, a, b) = (
            List.app (fn y => if length(y) < 3 andalso check_person(y, x) then
                              (
                                add_person(y, x);
                                kirkman_sub(xs, (x::y) :: remove(y, a), b);
                                del_person(y, x)
                              )
                              else ())
                     a;
            if length(a) < 5 then kirkman_sub(xs, [x]::a, b) else ()
          )
      val s = Timer.startRealTimer()
    in
      kirkman_sub(iota(2, 15), [[1]], []) handle _ => ();
      Timer.checkRealTimer(s)
    end

15 人の女生徒を 1 から 15 までの数値で表します。変数 check_table は、いっしょに散歩した人を格納する配列です。0 番目はダミーです。たとえば、[1, 2, 3] というグループを作った場合、check_table の 1 番目には [2, 3] を、2 番目には [1, 3] を、3 番目には [2, 3] をセットします。この check_table を使って、同じ女生徒と 2 回以上散歩しないようにグループ分けを行います。

関数 check_person(ys, x) はグループ ys に x を追加するとき、既に散歩した女生徒がいるかチェックします。check_table の y 番目からリストを取り出し、それに x が含まれていれば、y は既に x と散歩をしています。この場合は false を返します。x が ys の女生徒達とまだ散歩していない場合は true を返します。

関数 add_person(ys, x) は check_table にグループ ys と x の関係を追加します。ys の要素を y とすると、check_table の x 番目のリストに y を、y 番目のリストに x を追加するだけです。関数 del_person(ys, x) は ys と x の関係を削除します。ys の要素を y とすると、check_table の x 番目の先頭要素と、y 番目の先頭要素を削除します。

解法プログラム kirkman の実際の処理は局所関数 kirkman_sub で行います。第 1 引数が女生徒を格納したリスト、a が作成中のグループ分けを格納するリスト、b が完成したグループ分けを格納するリストです。b の長さが 7 になれば解を見つけたことになります。

プログラムでは第 1 引数が空リストになり (a がひとつ完成する)、b の長さが 6 の場合、完成した a を b に追加し、それを rev で反転して要素を print_intlist2 で表示します。そうでなければ、a を b に追加して kirkman_sub を再帰呼び出しして次の日のグループ分けを作成します。グループ分けの処理は group_partition とほぼ同じですが、check_person でチェックを行い、add_person で check_table を更新してから、kirkman_sub を再帰呼び出しします。再帰呼び出しから戻ってきたら、del_person で check_table を元に戻します。

それでは実行結果を示します。

- kirkman ();
( 15 14 13 )( 12 11 10 )( 9 8 7 )( 6 5 4 )( 3 2 1 )
( 15 4 3 )( 14 10 9 )( 13 11 8 )( 12 5 2 )( 7 6 1 )
( 15 12 7 )( 14 11 1 )( 13 10 6 )( 9 4 2 )( 8 5 3 )
( 15 11 2 )( 14 7 5 )( 13 9 3 )( 12 8 6 )( 10 4 1 )
( 15 9 6 )( 14 12 3 )( 13 5 1 )( 11 7 4 )( 10 8 2 )
( 15 10 5 )( 14 8 4 )( 13 7 2 )( 12 9 1 )( 11 6 3 )
( 15 8 1 )( 14 6 2 )( 13 12 4 )( 11 9 5 )( 10 7 3 )
val it = TIME {usec=15210000} : Time.time

実行時間は 15.21 秒 (Windows 7, Core i7-2670QM 2.20GHz, SML/NJ ver 110.74) でした。興味のある方は高速化に挑戦してみてください。


●解答7「ナンバープレース」

解の総数を求める場合、単純な方法では 6 * 6 のナンバープレースでも大変です。そこでラテン方陣のような標準形を考えることにします。ナンバープレースの場合、数字 N と数字 M を交換しても数独の条件を満たすので、数字の配置を下図のように限定することにします。

  1 2 3 4 5 6
  4 5 6 0 0 0
  0 0 0 0 0 0
  0 0 0 0 0 0
  0 0 0 0 0 0
  0 0 0 0 0 0

図 : 数字の配置

一番上の行で数字を交換することで 6! = 720 通り、右上のグループの残り 3 つの数字を交換することで 6 通りの解が生成されます。したがって、上図の解の総数を I とすると、解の総数は I * 720 * 6 になります。

ナンバープレースの解法プログラムは拙作のページ Scheme Programming パズルの解法 [4] で詳しく説明しています。そのプログラムを SML/NJ で書き直すと次のようになります。

リスト : 数独 (6 行 6 列盤) の解の総数を求める

(* 大きさ *)
val SIZE = 6

(* 盤面 *)
(*  0  1  2 |  3  4  5
    6  7  8 |  9 10 11
   ---------+---------
   12 13 14 | 15 16 17
   18 19 20 | 21 22 23
   ---------+---------
   24 25 26 | 27 28 29
   30 31 32 | 33 34 35
*)
val board = Array.array(SIZE * SIZE, 0w0)

(* 初期値 *)
val init_board_data = [
    1, 2, 3,  4, 5, 6,
    4, 5, 6,  0, 0, 0,

    0, 0, 0,  0, 0, 0,
    0, 0, 0,  0, 0, 0,

    0, 0, 0,  0, 0, 0,
    0, 0, 0,  0, 0, 0
]

(* フラグ *)
val xflag = Array.array(SIZE, 0w0)
val yflag = Array.array(SIZE, 0w0)
val gflag = Array.array(SIZE, 0w0)

(* アクセス関数 *)
fun get_x(pos) = pos mod SIZE
fun get_y(pos) = pos div SIZE
fun get_g(pos) = (get_y(pos) div 2) * 2 + (get_x(pos) div 3)

(* 置くことができる数字を求める *)
fun get_numbers(pos) =
    let
      val x = Array.sub(xflag, get_x(pos))
      val y = Array.sub(yflag, get_y(pos))
      val g = Array.sub(gflag, get_g(pos))
    in
      Word.andb(Word.andb(x, y), g)
    end

(* フラグを反転する *)
fun revFlag(vec, pos, num) =
    Array.update(vec, pos, Word.xorb(Array.sub(vec, pos), num))

(* 盤面に数字を書き込む *)
fun number_set(pos, num) = (
      Array.update(board, pos, num);
      revFlag(xflag, get_x(pos), num);
      revFlag(yflag, get_y(pos), num);
      revFlag(gflag, get_g(pos), num)
    )

(* 盤面から数字を消す *)
fun number_delete(pos) =
    let
      val num = Array.sub(board, pos)
    in
      Array.update(board, pos, 0w0);
      revFlag(xflag, get_x(pos), num);
      revFlag(yflag, get_y(pos), num);
      revFlag(gflag, get_g(pos), num)
    end

(* フラグの初期化 *)
fun init_flag () =
    let
      fun iter(n) =
          if n < SIZE then (
              Array.update(xflag, n, 0wx7e);
              Array.update(yflag, n, 0wx7e);
              Array.update(gflag, n, 0wx7e);
              iter(n + 1)
            )
          else ()
    in
      iter(0)
    end


(* データの読み込み *)
fun init_data(xs) =
    let
      fun iter(_, []) = ()
      |   iter(i, x::xs) = (
            if x = 0 then Array.update(board, i, 0w0)
            else number_set(i, Word.<<(0w01, Word.fromInt(x)));
            iter(i + 1, xs)
          )
    in
      init_flag();
      iter(0, xs)
    end

(* ビット用高階関数 *)
fun bit_fold f a n =
    if n = 0w0 then a
    else
      let
        val m = Word.andb(~n, n)
      in
        bit_fold f (f(m, a)) (Word.xorb(n, m))
      end

(* 実行 *)
fun solve_exec() =
    let
      fun solve(36) = 1
      |   solve(n) =
          bit_fold (fn(num, a) => (
                     number_set(n, num);
                     let
                       val m = solve(n + 1)
                     in
                       number_delete(n);
                       m + a
                     end))
                   0
                   (get_numbers(n))
    in
      init_data(init_board_data);
      solve(9)
    end

実行結果は次のようになりました。

- solve_exec();
val it = 6528 : int

解の総数は 6528 * 720 * 6 = 28200960 になります。

9 行 9 列盤のナンバープレースを単純なバックトラック法だけで解く場合、プログラムは次のようになります。

リスト : ナンバープレースの解法

(* 大きさ *)
val SIZE = 9

(* 盤面 *)
val board = Array.array(SIZE * SIZE, 0w0)

(* フラグ *)
val xflag = Array.array(SIZE, 0w0)
val yflag = Array.array(SIZE, 0w0)
val gflag = Array.array(SIZE, 0w0)

fun get_x(pos) = pos mod SIZE
fun get_y(pos) = pos div SIZE
fun get_g(pos) = (get_y(pos) div 3) * 3 + (get_x(pos) div 3)

(* 置くことができる数字を求める *)
fun get_numbers(pos) =
    let
      val x = Array.sub(xflag, get_x(pos))
      val y = Array.sub(yflag, get_y(pos))
      val g = Array.sub(gflag, get_g(pos))
    in
      Word.andb(Word.andb(x, y), g)
    end

(* フラグを反転する *)
fun revFlag(vec, pos, num) =
    Array.update(vec, pos, Word.xorb(Array.sub(vec, pos), num))

(* 盤面に数字を書き込む *)
fun number_set(pos, num) = (
      Array.update(board, pos, num);
      revFlag(xflag, get_x(pos), num);
      revFlag(yflag, get_y(pos), num);
      revFlag(gflag, get_g(pos), num)
    )

(* 盤面から数字を消す *)
fun number_delete(pos) =
    let
      val num = Array.sub(board, pos)
    in
      Array.update(board, pos, 0w0);
      revFlag(xflag, get_x(pos), num);
      revFlag(yflag, get_y(pos), num);
      revFlag(gflag, get_g(pos), num)
    end

(* ON bit の位置を求める *)
fun bit_position(n) =
    let
      fun iter(n, a) =
          if Word.andb(n, 0w1) = 0w1 then a else iter(Word.>>(n, 0w1), a + 1)
    in
      if n > 0w0 then iter(n, 0) else 0
    end

(* 盤面の表示 *)
fun print_board () =
    let
      fun iter(i) =
          if SIZE * SIZE = i then print("\n")
          else (
            if i mod SIZE = 0 then print("\n") else ();
            print(Int.toString(bit_position(Array.sub(board, i))) ^ " ");
            iter(i + 1)
          )
    in
      iter(0)
    end

(* フラグの初期化 *)
fun init_flag () =
    let
      fun iter(n) =
          if n < SIZE then (
              Array.update(xflag, n, 0wx3fe);
              Array.update(yflag, n, 0wx3fe);
              Array.update(gflag, n, 0wx3fe);
              iter(n + 1)
            )
          else ()
    in
      iter(0)
    end

(* データの読み込み *)
fun init_data(xs) =
    let
      fun iter(_, []) = ()
      |   iter(i, x::xs) = (
            if x = 0 then Array.update(board, i, 0w0)
            else number_set(i, Word.<<(0w01, Word.fromInt(x)));
            iter(i + 1, xs)
          )
    in
      init_flag();
      iter(0, xs)
    end

(* 空き場所を求める *)
fun get_space () =
    let
      fun iter(i, a) =
          if i = SIZE * SIZE then rev a
          else if Array.sub(board, i) = 0w0 then iter(i + 1, i::a)
          else iter(i + 1, a)
    in
      iter(0, [])
    end

(* ビット用高階関数 *)
fun bit_for_each f n =
    if n > 0w0 then 
      let
        val m = Word.andb(~n, n)
      in
        f(m);
        bit_for_each f (Word.xorb(n, m))
      end
    else ()

(* 解法 *)
fun solve([]) = print_board ()
|   solve(x::xs) =
    bit_for_each
      (fn num => (number_set(x, num); solve(xs); number_delete(x)))
      (get_numbers(x))

(* 実行 *)
fun solve_exec(q) =
    let
      val a = Timer.startRealTimer()
    in
      init_data(q);
      solve(get_space());
      Timer.checkRealTimer( a )
    end

それでは、実際に数独を解いてみましょう。Puzzle Generater Japan にある Java版標準問題集 より問題 8-a, 8-b, 9-a, 9-b, 10-a, 10-b を試してみたところ、実行時間は次のようになりました。

  表 : 実行結果 (単位 : ミリ秒)

  問題 : Hint : 時間
 ------+------+------
   8-a :  20  :  62
   8-b :  20  :  99
   9-a :  20  :  88
   9-b :  21  :  63
  10-a :  22  :  37
  10-b :  22  :  37

実行環境 : Windows 7, Core i7-2670QM 2.20GHz, SML/NJ ver 110.74

盤面が 9 * 9 の場合、単純なバックトラック法だけでも高速に解くことができました。もちろん、バックトラック法を使わずに解く方法もあります。興味のある方は拙作のページ Scheme Programming パズルの解法 [4] [5] [6] [7] をお読みください。


●解答8「三目並べ」

三目並べは簡単なゲームなので、ゲーム終了まで読み切ることができます。局面の状態は、○側の勝ち、×側の勝ち、引き分けの 3 通りしかありません。あとは、ミニマックス法により最善手を選択させ、その結果を求めればいいわけです。とりあえず、プログラムでは指し手を保存しないで、評価値の結果だけを出力することにします。初手をどこに選んでも、引き分けの評価値が出力されるはずです。

三目並べとミニにマックス法については、拙作のページ Scheme Programming ミニマックス法と三目並べ で詳しく説明しています。そのプログラムを SML/NJ で書き直すと次のようになります。

リスト : 三目並べ

(* 駒 *)
datatype Piece = Maru | Batu | Kara

(* 定数 *)
val MaxValue = 2
val MaruWin  = 1
val Draw     = 0
val BatuWin  = ~1
val MinValue = ~2

(* 盤面 *)
(*
 *  0 1 2
 *  3 4 5
 *  6 7 8
 *)
val SIZE = 9
val board = Array.array(SIZE, Kara)

(* 直線 *)
val line = Array.fromList(
    [[(1, 2), (3, 6), (4, 8)],         (* 0 *)
     [(0, 2), (4, 7)],                 (* 1 *)
     [(0, 1), (5, 8), (4, 6)],         (* 2 *)
     [(0, 6), (4, 5)],                 (* 3 *)
     [(1, 7), (3, 5), (0, 8), (2, 6)], (* 4 *)
     [(2, 8), (3, 4)],                 (* 5 *)
     [(0, 3), (2, 4), (7, 8)],         (* 6 *)
     [(1, 4), (6, 8)],                 (* 7 *)
     [(0, 4), (2, 5), (6, 7)]]         (* 8 *)
)

(* アクセス関数 *)
fun get_piece(n) = Array.sub(board, n)
fun put_piece(n, p) = Array.update(board, n, p)
fun del_piece(n) = Array.update(board, n, Kara)

(* 3 つ同じ駒が並ぶか *)
fun check_line(p, a, b) = 
    get_piece(a) = p andalso get_piece(b) = p

(* 勝負の判定 *)
fun check_win(n, p) =
    let
      fun iter([]) = Draw
      |   iter((a, b)::xs) =
          if check_line(p, a, b) then
             if p = Maru then MaruWin else BatuWin
             (* if p = Maru then BatuWin else MaruWin *)
          else iter(xs)
    in
      iter(Array.sub(line, n))
    end

(* 先手 *)
fun think_maru () =
    let
      fun iter(9, value) = 
          if value = MinValue then Draw else value
      |   iter(n, value) =
          if get_piece(n) = Kara then
            let
              val v = check_win(n, Maru)
            in
              if v = MaruWin then v
              else if v = BatuWin then iter(n + 1, Int.max(v, value))
              else (
                put_piece(n, Maru);
                let
                  val v = think_batu ()
                in
                  del_piece(n);
                  iter(n + 1, Int.max(v, value))
                end
              )
            end
          else iter(n + 1, value)
    in
      iter(0, MinValue)
    end
(* 後手 *)
and think_batu () =
    let
      fun iter(9, value) =
          if value = MaxValue then Draw else value
      |   iter(n, value) =
          if get_piece(n) = Kara then
            let
              val v = check_win(n, Batu)
            in
              if v = BatuWin then v
              else if v = MaruWin then iter(n + 1, Int.min(v, value))
              else (
                put_piece(n, Batu);
                let
                  val v = think_maru ()
                in
                  del_piece(n);
                  iter(n + 1, Int.min(v, value))
                end
              )
            end
          else iter(n + 1, value)
    in
      iter(0, MaxValue)
    end

(* 解法 *)
fun solve(9) = ()
|   solve(n) = (
      put_piece(n, Maru);
      print(Int.toString(n) ^ " : " ^ Int.toString(think_batu()) ^ "\n");
      del_piece(n);
      solve(n + 1)
    )

それでは実行結果を示しましょう。

- solve(0);
0 : 0
1 : 0
2 : 0
3 : 0
4 : 0
5 : 0
6 : 0
7 : 0
8 : 0
val it = () : unit

初手がどこでも、結果は引き分けとなりました。これで、両者が最善を尽くすと引き分けになることが確かめられました。

それでは、ルールを「3 つ並べた方が負け」に変更すると、結果はどうなるでしょうか。プログラムは簡単に改造できます。関数 check_win では、Maru が 3 つ並んでいたら MaruWin を出力していましたが、これを BatuWin に変更します。逆に、Batu が 3 つ並んでいたら MaruWin を出力します。ようするに、勝敗の判定を逆にするだけです。

このルールでは先手が不利なように思いますが、それでも引き分けになるのでしょうか。さっそく実行してみましょう。

- solve(0);
0 : ~1
1 : ~1
2 : ~1
3 : ~1
4 : 0
5 : ~1
6 : ~1
7 : ~1
8 : ~1
val it = () : unit

初手が中央の場合のみ引き分けで、あとは後手の勝ちとなりました。後手必勝にはなりませんでしたね。興味のある方は、実際にプレイして確かめてみてください。また、今回のプログラムは評価値を出力するだけでしたが、指し手を表示するように改造してみるのも面白いと思います。


Copyright (C) 2012 Makoto Hiroi
All rights reserved.

[ PrevPage | SML/NJ | NextPage ]