今回は「パズル」を題材にプログラムを作ってみましょう。どのプログラミング言語でもそうですが、上達の秘訣は実際にプログラムを作って動作を確認してみることです。ところが、いざとなると「さて何を作ろうか」と困ってしまう方もいるのではないでしょうか。
このようなときにぴったりな題材が「パズルの解法」です。なんといっても、実際にパズルが解けたときの喜びはとても大きく、プログラムを作る意欲をかきたててくれます。そこで、今回はバックトラック法を使って簡単なパズルを解いてみましょう。
計算式の数字を文字や記号に置き換えて、それを元の数字に戻すパズルを「覆面算」といいます。異なる文字は異なる数字を表し、同じ文字は同じ数字を表します。使用する数字は 0 から 9 までで、最上位の桁に 0 を入れることはできません。
問題はデュードニーが 1924 年に発表したもので、覆面算の古典といわれる有名なパズルです。
S E N D
+ M O R E
-------------
M O N E Y
図 1 : 覆面算
それではプログラムを作りましょう。式 SEND + MORE = MONEY は足し算なので、M が 1 であることはすぐにわかります。ここでは、それ以外の数字を求めるプログラムを作ります。単純な生成検定法でプログラムを作ると、次のようになります。
リスト 1 : 覆面算 (send.ml)
(* データの検定 *)
let check = function
s::e::n::d::o::r::y::[] ->
let send = s*1000+e*100+n*10+d and
more = 1000+o*100+r*10+e and
money = 10000+o*1000+n*100+e*10+y in
if send + more = money then
Printf.printf "%d + %d = %d\n" send more money
else ()
| _ -> raise (Failure "check")
(* 要素の削除 *)
let remove n ls = List.filter (fun x -> n <> x) ls
(* データの生成 *)
let rec permutation n nums perm =
if n = 0 then check perm
else List.iter (fun x -> permutation (n - 1) (remove x nums) (x::perm)) nums
(* 実行 *)
let () = permutation 7 [0;2;3;4;5;6;7;8;9] []
1 を除いた 9 個の数字の中から 7 個の数字を選んで順列を生成します。あとは関数 check で数値 send, more, money を計算して、send + more = money を満たしているかチェックします。とても簡単なプログラムですね。さっそく実行してみましょう。
$ ocaml send.ml 9567 + 1085 = 10652
答えは 9567 + 1085 = 10652 の 1 通りしかありません。興味のある方は、もっとクールな方法でプログラムを作ってみてください。
次は魔方陣を解いてみましょう。下図の A から I の場所に 1 から 9 までの数字をひとつずつ配置します。縦横斜めの合計が等しくなるように数字を配置してください。
┌─┬─┬─┐
│Ａ│Ｂ│Ｃ│ 式
├─┼─┼─┤ A + B + C = N, B + E + H = N
│Ｄ│Ｅ│Ｆ│ D + E + F = N, C + F + I = N
├─┼─┼─┤ G + H + I = N, A + E + I = N
│Ｇ│Ｈ│Ｉ│ A + D + G = N, C + E + G = N
└─┴─┴─┘
図 2 : 魔方陣
3 行 3 列の魔方陣は生成検定法で簡単に解くことができます。次のリストを見てください。
リスト 2 : 魔方陣 (mahou.ml) (* 盤面 * 0 1 2 * 3 4 5 * 6 7 8 *) (* 直線を表すデータ *) let line = [(0,1,2); (3,4,5); (6,7,8); (0,3,6); (1,4,7); (2,5,8); (0,4,8); (2,4,6)] (* 直線の和を求める *) let add_line (n1, n2, n3) ls = List.nth ls n1 + List.nth ls n2 + List.nth ls n3 (* 引数 n と同じ要素をカウントする *) let count n ls = List.fold_left (fun a b -> if n = b then a + 1 else a) 0 ls (* 盤面を表示する *) let print_board ls = Printf.printf "%d %d %d\n" (List.nth ls 0) (List.nth ls 1) (List.nth ls 2); Printf.printf "%d %d %d\n" (List.nth ls 3) (List.nth ls 4) (List.nth ls 5); Printf.printf "%d %d %d\n\n" (List.nth ls 6) (List.nth ls 7) (List.nth ls 8) (* データの検定 *) let check ls = let result = List.map (fun x -> add_line x ls) line in if count (List.hd result) result = 8 then print_board ls else () (* 要素を取り除く *) let remove n ls = List.filter (fun x -> n <> x) ls (* データの生成 *) let rec permutation nums perm = if nums = [] then check perm else List.iter (fun x -> permutation (remove x nums) (x::perm)) nums (* 実行 *) let () = permutation [1;2;3;4;5;6;7;8;9] []
関数 permutation で 1 から 9 までの数字の順列を生成します。それを関数 check に渡して、魔方陣の条件を満たしているかチェックします。List.map で各直線の和を関数 add_line で求めてリストに格納します。リストの要素がすべて同じ値であれば魔方陣の条件を満たすので、関数 print_board で盤面を表示します。
それでは実行結果を示します。
$ ocamlc -o mahou mahou.ml $ ./mahou 8 3 4 1 5 9 6 7 2 8 1 6 3 5 7 4 9 2 6 7 2 1 5 9 8 3 4 6 1 8 7 5 3 2 9 4 4 9 2 3 5 7 8 1 6 4 3 8 9 5 1 2 7 6 2 9 4 7 5 3 6 1 8 2 7 6 9 5 1 4 3 8
対称解を含めると、解は 8 通りあります。実行時間は ocamlc (4.05.0), Ubunts 18.04 (Windows Subsystem for Linux), Intel Core i5-6200U 2.30GHz で 1.7 秒でした。けっこう時間がかかりますね。対称解を排除すると、枝刈りの効果によりプログラムを高速に実行することができます。
対称解のチェックは、下図のように四隅の大小関係を利用すると簡単です。
┌─┬─┬─┐
│Ａ│Ｂ│Ｃ│
├─┼─┼─┤ A < C < G
│Ｄ│Ｅ│Ｆ│
├─┼─┼─┤ A < I
│Ｇ│Ｈ│Ｉ│
└─┴─┴─┘
図 3 : 対称解のチェック
魔方陣の場合、回転解が 4 種類あって、鏡像解が 2 種類あります。四隅の大小関係をチェックすることで、これらの対称解を排除することができます。また、早い段階で枝刈りを行うため、盤面の番号と試行順序を工夫します。
┌─┬─┬─┐
│０│４│１│
├─┼─┼─┤
│５│８│６│
├─┼─┼─┤
│２│７│３│
└─┴─┴─┘
図 4 : 盤面の番号と試行順序
盤面を 1 次元配列で表すことにします。試行順序を上図のように定義し、配列の添字と対応させます。そうすると、最初に四隅 (0, 1, 2, 3) の数字が選択されますね。ここで対称解のチェックが行われるので、枝刈りの効率は良くなります。プログラムは次のようになります。
リスト 3 : 魔方陣 (mahou1.ml)
(* 直線の定義 *)
let line = [(0,4,1); (5,8,6); (2,7,3); (0,5,2);
(4,8,7); (1,6,3); (0,8,3); (1,8,2)]
(* 直線の和を求める *)
let add_line (n1, n2, n3) board =
board.(n1) + board.(n2) + board.(n3)
(* 引数 n と同じ要素の個数を求める *)
let count n ls =
List.fold_left (fun a b -> if n = b then a + 1 else a) 0 ls
(* 盤面を表示する *)
let print_board board =
Printf.printf "%d %d %d\n" board.(0) board.(4) board.(1);
Printf.printf "%d %d %d\n" board.(5) board.(8) board.(6);
Printf.printf "%d %d %d\n\n" board.(2) board.(7) board.(3)
(* データの検定 *)
let check board =
let result = List.map (fun x -> add_line x board) line in
if count (List.hd result) result = 8 then print_board board else ()
(* 同じ要素を削除する *)
let remove n ls = List.filter (fun x -> n <> x) ls
(* データの生成 *)
let rec permutation n nums board =
match n with
2 when board.(0) > board.(1) -> ()
| 3 when board.(1) > board.(2) -> ()
| 4 when board.(0) > board.(3) -> ()
| 9 -> check board
| _ -> List.iter
(fun x ->
board.(n) <- x;
permutation (n + 1) (remove x nums) board)
nums
(* 実行 *)
let () = permutation 0 [1;2;3;4;5;6;7;8;9] (Array.make 9 0)
実行結果を示します。
$ ocamlc -o mahou1 mahou1.ml $ ./mahou1 2 9 4 7 5 3 6 1 8
実行時間は 0.10 秒でした。枝刈りの効果は十分に出ていると思います。
騎士はチェスの駒のひとつで、将棋の桂馬の動きを前後左右にとることができます。次の図を見てください。
┌─┬─┬─┬─┬─┐
│ │●│ │●│ │
├─┼─┼─┼─┼─┤ ┌─┬─┬─┐
│●│ │ │ │●│ │Ｋ│ │ │
├─┼─┼─┼─┼─┤ ├─┼─┼─┤
│ │ │Ｋ│ │ │ │ │ │ │
├─┼─┼─┼─┼─┤ ├─┼─┼─┤
│●│ │ │ │●│ │ │ │ │
├─┼─┼─┼─┼─┤ ├─┼─┼─┤
│ │●│ │●│ │ │ │ │ │
└─┴─┴─┴─┴─┘ └─┴─┴─┘
●：騎士 (K) が動ける位置 問題
図 5 : 騎士の巡歴
この騎士を動かして、N 行 M 列の盤面のどのマスにもちょうど一回ずつ訪れるような経路を求めるのが問題です。ちなみに、3 行 3 列、4 行 4 列の盤面には解がありませんが、5 行 5 列の盤面には解があります。大きな盤面を解くのは大変なので、3 行 4 列の盤面で騎士の移動経路を求めてください。プログラムを作る前に、自分で考えてみるのも面白いでしょう。
それではプログラムを作りましょう。次の図を見てください。
┌─┬─┬─┐
│０│１│２│ ０──７──２
├─┼─┼─┤ │ │
│３│４│５│ ５──10──３
├─┼─┼─┤ │ │
│６│７│８│ ６──１──８
├─┼─┼─┤ │ │
│９│10│11│ 11──４──９
└─┴─┴─┘
（Ａ）３行４列盤 （Ｂ）経路図
図 6 : 騎士の移動
図 6 (A) のように、3 行 4 列盤の各マスに番号を付けて表します。すると、騎士の移動は (B) のようにグラフで表すことができます。これならば、コンピュータを使わなくても解くことができますね。プログラムも隣接リストを定義すれば簡単です。あとは単純な深さ優先探索で騎士の経路を探すだけです。
リスト 4 : 騎士の巡歴 (knight.ml)
(* 隣接リスト *)
let 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]
|]
(* 経路の表示 *)
let print_path path =
List.iter (fun x -> print_int x; print_string " ") path;
print_newline ()
(* 深さ優先探索 *)
let rec dfs n path =
if n = 12 then print_path (List.rev path)
else
let p = List.hd path in
List.iter (fun x -> if List.mem x path then () else dfs (n+1) (x::path))
adjacent.(p)
(* 実行 *)
let () = dfs 1 [0]
経路はリストで表します。関数 dfs の引数 n が訪れたマスの個数を表し、次の引数 path が経路を表します。n が 12 になったら見つけた経路を関数 print_path で表示します。そうでなければ、騎士を次のマスへ進めます。この処理は経路の探索と同じです。
プログラムはこれだけです。とても簡単ですね。それでは実行してみましょう。
C>knight 0 7 2 3 10 5 6 1 8 9 4 11 0 7 2 3 10 5 6 11 4 9 8 1
2 通りの経路を見つけることができました。
このほかに、どのマスにもちょうど一回ずつ訪れたのち、最初のマスに戻ってくることを条件にする「騎士の周遊」という問題もあります。この場合、3 行 4 列盤には解がありません。
また、N 行 M 列の盤面でマスの個数が奇数のときにも、最初のマスに戻ることはできません。これは簡単に証明できるので、息抜きや気分転換に考えてみてください。
パズルではありませんが、簡単な例題として「マスターマインド」を解くプログラムを作りましょう。マスターマインドは 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
図 7 : マスターマインドの動作例
今回は、私達が出した問題をコンピュータに答えてもらうことにします。それはちょっと難しいのではないか、と思った人もいるかもしれませんね。ところが、とても簡単な方法があるのです。このゲームでは、10 個の数字の中から 4 個選ぶわけですから、全体では 10 * 9 * 8 * 7 = 5040 通りのコードしかありません。コードを生成する処理は順列と同じですから、簡単にプログラムできます。
次に、この中から正解を見つける方法ですが、質問したコードとその結果を覚えておいて、それと矛盾しないコードを作るようにします。具体的には、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] に矛盾しない数字を選ぶ
図 8 : マスターマインドの推測アルゴリズム
[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 を求める関数を作ります。
リスト 5 : bulls と cows を求める (* bulls を数える *) let count_bulls ls1 ls2 = List.fold_left2 (fun a b c -> if b = c then a + 1 else a) 0 ls1 ls2 (* 同じ数字を数える *) let count_same_number ls1 ls2 = List.fold_left (fun a b -> if List.mem b ls2 then a + 1 else a) 0 ls1
関数 count_bulls は List.fold_left2 を使うと簡単です。fold_left2 の型を示します。
val fold_left2 : ('a -> 'b -> 'c -> 'a) -> 'a -> 'b list -> 'c list -> 'a = <fun>
fold_left2 は 2 つのリストを引数に受け取ります。List モジュールには map2 や fold_right2 など 2 つのリストを引数に受け取る高階関数が定義されています。匿名関数の引数 a が bulls の個数で、b と c がリストの要素になります。b と c が等しいい場合、a を +1 すれば bulls の個数を求めることができます。
次は、cows を数える処理を作ります。いきなり cows を数えようとすると難しいのですが、2 つのリストに共通の数字を数えることは簡単にできます。この方法では、bulls の個数を含んだ数を求めることになりますが、そこから bulls を引けば cows を求めることができます。関数名は count_same_numberとしました。この処理は List.fold_left を使うと簡単です。匿名関数の引数 a が共通の数字の個数で、b がリスト ls1 の要素です。List.mem で b が ls2 に含まれていれば、a の値を +1 します。
次は生成したコードが今までの結果と矛盾していないか調べる関数 check_query を作ります。次のリストを見てください。
リスト 6 : 今までの質問と矛盾しているか let rec check_query code = function [] -> true | (old_bulls, old_cows, old_code)::qs -> let bulls = count_bulls code old_code in let cows = (count_same_number code old_code) - bulls in if bulls = old_bulls && cows = old_cows then check_query code qs else false
質問したコードとその結果は組にまとめてリストに格納します。最初が bulls の個数、次が cows の個数、最後が質問したコードです。データはパターンマッチングで取り出して、局所変数 old_bulls, old_cows, old_code にセットします。そして、code と old_colde から bulls と cows を count_bulls と count_same_number で求めます。
bulls と old_bulls が等しくて、cows と old_cows が等しい場合、code は矛盾していないので、次のデータを調べます。そうでなれば code は矛盾しているので false を返します。すべてのデータを調べたら true を返します。
マスターマインドを解くプログラムは次のようになります。
リスト 7 : マスターマインドの解法
exception Finish
let solve collect =
List.fold_left
(fun query code ->
if check_query code query then
(* 矛盾していない *)
let bulls = count_bulls code collect in
let cows = (count_same_number code collect) - bulls in
Printf.printf "%d: " (1 + List.length query);
print_intlist code;
Printf.printf ": bulls = %d, cows = %d\n" bulls cows;
if bulls = 4 then raise Finish else ();
(bulls, cows, code)::query
else
query)
[]
(permutation_list 4 [0;1;2;3;4;5;6;7;8;9])
関数 solve の引数 collect が正解のコードです。関数 permutation_list は拙作のページ「順列と組み合わせ」で作成したものと同じです。リストの中から 4 個の要素を選ぶ順列を生成し、それをリストに格納して返します。
あとは fold_left でコードを順番に取り出して、今まで質問したコードと矛盾していないか調べます。匿名関数の引数 query が今までに質問したコードと結果を格納したリストで、code が質問するコードです。check_query が true を返す場合、code は矛盾していないので、code と collect を比較して bulls と cows を求めます。そして、その結果を表示します。
もしも、bulls が 4 ならば正解なので raise で例外 Finish を送出して処理を終了します。そうでなければ、query に今回の結果を追加して返します。code が矛盾している場合は query をそのまま返すだけです。
これでプログラムは完成です。それでは実行例を示しましょう。
# solve [9; 8; 7; 6];; 1 : 0 1 2 3 : bulls 0, cows 0 2 : 4 5 6 7 : bulls 0, cows 2 3 : 5 4 8 9 : bulls 0, cows 2 4 : 6 7 9 8 : bulls 0, cows 4 5 : 8 9 7 6 : bulls 2, cows 2 6 : 9 8 7 6 : bulls 4, cows 0 Exception Finish. # solve [9; 4; 3; 1];; 1 : 0 1 2 3 : bulls 0, cows 2 2 : 1 0 4 5 : bulls 0, cows 2 3 : 2 3 5 4 : bulls 0, cows 2 4 : 3 4 0 6 : bulls 1, cows 1 5 : 3 5 6 1 : bulls 1, cows 1 6 : 6 5 0 2 : bulls 0, cows 0 7 : 7 4 3 1 : bulls 3, cows 0 8 : 8 4 3 1 : bulls 3, cows 0 9 : 9 4 3 1 : bulls 4, cows 0 Exception Finish.
肝心の質問回数ですが、5, 6 回で当たる場合が多いようです。実際に、5040 個のコードをすべて試してみたところ、平均は 5.56 回になりました。これは参考文献「数当てゲーム (MOO, マスターマインド)」の結果と同じです。質問回数の最大値は 9 回で、そのときのコードは [9; 4; 3; 1], [9; 2; 4; 1], [5; 2; 9; 3], [9; 2; 0; 4], [9; 2; 1; 4] でした。
なお、参考文献 1 には平均質問回数がこれよりも少なくなる方法が紹介されています。単純な数当てゲームと思っていましたが、その奥はけっこう深いようです。興味のある方はいろいろ試してみてください。
(*
* master.ml : マスターマインドの解法
*
* Copyright (C) 2008 Makoto Hiroi
*)
(* bulls を数える *)
let count_bulls ls1 ls2 =
List.fold_left2 (fun a b c -> if b = c then a + 1 else a) 0 ls1 ls2
(* 同じ数字を数える *)
let count_same_number ls1 ls2 =
List.fold_left (fun a b -> if List.mem b ls2 then a + 1 else a) 0 ls1
(* 今までの質問と矛盾しているか *)
let rec check_query code = function
[] -> true
| (old_bulls, old_cows, old_code)::qs ->
let bulls = count_bulls code old_code in
let cows = (count_same_number code old_code) - bulls in
if bulls = old_bulls && cows = old_cows then check_query code qs else false
(* リストの表示 *)
let print_intlist ls =
List.iter (fun x -> print_int x; print_string " ") ls
(* 要素の削除 *)
let rec remove x = function
[] -> []
| y :: ys -> if x = y then remove x ys else y :: remove x ys
(* 順列をリストに格納する *)
let permutation_list n xs =
let rec perm n xs a b =
if n = 0 then (List.rev a)::b
else List.fold_right (fun x y -> perm (n-1) (remove x xs) (x::a) y) xs b
in
perm n xs [] []
(* 例外の定義 *)
exception Finish
(* マスターマインドの解法 *)
let solve collect =
List.fold_left
(fun query code ->
if check_query code query then
(* 矛盾していない *)
let bulls = count_bulls code collect in
let cows = (count_same_number code collect) - bulls in
Printf.printf "%d: " (1 + List.length query);
print_intlist code;
Printf.printf ": bulls = %d, cows = %d\n" bulls cows;
if bulls = 4 then raise Finish else ();
(bulls, cows, code)::query
else
query)
[]
(permutation_list 4 [0;1;2;3;4;5;6;7;8;9])
次のパズルを解くプログラムを作成してください。
例 : 9 + 8 + 7 + 654 + 321 +(-) 0 = 999
パズルの世界では 1 から 9 までの数字が 1 回ずつすべて登場する数を「小町数」といいますが、これに 0 を加えた数を「大町数」といいます。そして、0 から 9 までの 10 個の数字を 1 個ずつ使った計算を「大町算」といいます。プログラムは拙作のページ「バックトラック法」で作成した小町算のプログラムをちょっと改造するだけです。
リスト : 大町算の解法
type term = Plus | Minus | Num of int
(* 式の計算 *)
let calc_expr expr =
let rec calc_expr_sub expr a =
match expr with
[] -> a
| Plus :: Num x :: xs -> calc_expr_sub xs (a + x)
| Minus :: Num x :: xs -> calc_expr_sub xs (a - x)
| _ -> raise (Failure "calc_expr_sub")
in
match expr with
Num x :: xs -> calc_expr_sub xs x
| _ -> raise (Failure "calc_expr")
(* 式の表示 *)
let rec print_expr = function
[] -> print_string " = 999\n"
| Num x :: xs -> print_int x; print_expr xs
| Plus :: xs -> print_string " + "; print_expr xs
| Minus :: xs -> print_string " - "; print_expr xs
(* 式の生成 *)
let rec make_expr n expr =
if n < 0 then
let expr1 = List.rev expr in
if calc_expr expr1 = 999 then print_expr expr1 else ()
else
match expr with
Num x :: xs ->
make_expr (n - 1) (Num n :: Plus :: expr);
make_expr (n - 1) (Num n :: Minus :: expr);
make_expr (n - 1) (Num (x * 10 + n) :: xs)
| _ -> raise (Failure "make_expr")
# make_expr 8 [Num 9];; 9 + 8 + 7 + 654 + 321 + 0 = 999 9 + 8 + 7 + 654 + 321 - 0 = 999 9 + 8 + 765 + 4 + 3 + 210 = 999 987 + 6 + 5 - 4 - 3 - 2 + 10 = 999 987 + 6 - 5 - 4 + 3 + 2 + 10 = 999 987 - 6 + 5 + 4 - 3 + 2 + 10 = 999 - : unit = ()
このパズルは、N が小さいときには単純な生成検定法でも解けそうですが、N が大きくなるにつれて時間がかかるようになります。そこで、隣接リストと同じように、隣に置くことができる数字をあらかじめ求めておくことにしましょう。プログラムは次のようになります。
リスト : 隣接リストの生成
(* n 以下の平方数の生成 *)
let make_squares n =
let rec _make m =
if m * m > n then []
else (m * m) :: _make (m + 1)
in _make 2
(* 隣接リストの生成 *)
let make_neighbors n =
let table = Array.make (n + 1) [] in
let xs = make_squares (n + n - 1) in
for i = 1 to n do
table.(i) <- List.filter
(fun x -> (x <> i) && (1 <= x) && (x <= n))
(List.map (fun j -> j - i) xs)
done;
table
関数 make_squares は引数 n 以下の平方数を格納したリストを生成します。たとえば、1 から 15 までの数字でパズルを解く場合、最大値は 15 + 14 = 29 になります。make_squares に 29 を渡すと、1 を除いた平方数を格納したリスト [4; 9; 16; 25] を返します。
関数 make_neighbors は隣に置くことができる数字を格納した隣接リストを返します。隣接リストは配列 table に格納します。変数 xs には n + n - 1 以下の平方数を格納したリストをセットします。あとは、for ループで 1 から n までの数字に対して、隣に置くことができる数字を求めて table にセットします。
まず List.map で平方数 j から i を引いた数を求め、その中から 1 から n の範囲内に入る数を List.fiter で選択します。たとえば、n が 15 で i が 1 の場合、リスト [4; 9; 16; 25] は map で [3; 8; 15; 24] に変換され、filter で 24 が取り除かれて [3; 8; 15] が残ります。
それでは試してみましょう。
# make_neighbors 6;; - : int list array = [|[]; [3]; []; [1; 6]; [5]; [4]; [3]|] # make_neighbors 7;; - : int list array = [|[]; [3]; [7]; [1; 6]; [5]; [4]; [3]; [2]|] # make_neighbors 14;; - : int list array = [|[]; [3; 8]; [7; 14]; [1; 6; 13]; [5; 12]; [4; 11]; [3; 10]; [2; 9]; [1]; [7]; [6]; [5; 14]; [4; 13]; [3; 12]; [2; 11]|] # make_neighbors 15;; - : int list array = [|[]; [3; 8; 15]; [7; 14]; [1; 6; 13]; [5; 12]; [4; 11]; [3; 10]; [2; 9]; [1]; [7]; [6; 15]; [5; 14]; [4; 13]; [3; 12]; [2; 11]; [1; 10]|]
n が 2, 3 の場合、解が無いことはすぐにわかります。n が 4, 5, 6 の場合、隣接リストに [] が含まれているので、解は存在しません。また、隣に置くことができる数字がひとつしかない場合、その数字は両端に置くことしかできません。つまり、長さが 1 のリストが 2 つより多いと、解が無いことがわかります。n が 7 から 14 の場合がこれに該当します。
n が 15 の場合、両端の数字が 8 と 9 であれば解があるかもしれません。なお、ほとんどのリストは長さが 2 なので、手作業でも簡単に解くことができると思います。興味のある方は挑戦してみてください。
あとは深さ優先探索で解を求めます。次のリストを見てください。
リスト : パズルの解法
exception Found
let print_board board =
Array.iter (fun x -> Printf.printf "%d " x) board;
print_newline ();
raise Found
let rec dfs n board neighbors used =
if Array.length board = n then
print_board board
else
List.iter
(fun x -> if not (List.mem x used) then
(board.(n) <- x;
dfs (n + 1) board neighbors (x::used);
board.(n) <- 0)
else ())
neighbors.(board.(n - 1))
let solver () =
for n = 15 to 20 do
Printf.printf "----- %d -----\n" n;
let neighbors = make_neighbors n in
let board = Array.make n 0 in
for i = 1 to n do
board.(0) <- i;
dfs 1 board neighbors [i]
done
done
関数 dfs の引数 n が数字を置く場所、board が盤面を表す配列 neighbors が隣接リスト、used が使用した数字を格納したリストです。dfs は board の 0 番目の数字を決めてから呼び出すことに注意してください。
n が board の長さと同じ値になったならば、解を見つけたので print_board で表示します。そうでなければ、board の n - 1 番目の数字の隣接リストを neighbors から求め、List.iter で順番に取り出して変数 x にセットします。x が未使用ならば board の n 番目に x を書き込んで dfs を再帰呼び出しします。
関数 solver は for ループで n の値を増やし、次の for ループで board の 0 番目に数字 i をセットしてから dfs を呼び出します。
それでは実行してみましょう。
# solver ();; ----- 15 ----- 8 1 15 10 6 3 13 12 4 5 11 14 2 7 9 Exception: Found.
n が 15 のとき、条件を満たすように数字を並べることができました。
ナンバープレースは単純な深さ優先探索で簡単に解くことができます。説明は割愛しますので、詳細はプログラムリストをお読みください。
リスト : ナンバープレースの解法
let rec print_board board =
for y = 0 to 8 do
for x = 0 to 8 do
Printf.printf "%d " board.(y).(x)
done;
print_newline()
done
let check board x y n =
let rec check1 i =
if i = 9 then true
else if board.(y).(i) = n || board.(i).(x) = n then false
else check1 (i + 1)
in
let x1 = (x / 3) * 3 in
let y1 = (y / 3) * 3 in
let rec check2 i j =
if j = 3 then true
else if i = 3 then check2 0 (j + 1)
else if board.(y1 + j).(x1 + i) = n then false
else check2 (i + 1) j
in (check1 0) && (check2 0 0)
let rec solver board x y =
if y = 9 then print_board board
else if x = 9 then solver board 0 (y + 1)
else
match board.(y).(x) with
0 -> for n = 1 to 9 do
if check board x y n then
(board.(y).(x) <- n;
solver board (x + 1) y;
board.(y).(x) <- 0)
else ()
done
| _ -> solver board (x + 1) y
(* 問題 出典: 数独 - Wikipedia の問題例 *)
let q00 = [|
[|5; 3; 0; 0; 7; 0; 0; 0; 0|];
[|6; 0; 0; 1; 9; 5; 0; 0; 0|];
[|0; 9; 8; 0; 0; 0; 0; 6; 0|];
[|8; 0; 0; 0; 6; 0; 0; 0; 3|];
[|4; 0; 0; 8; 0; 3; 0; 0; 1|];
[|7; 0; 0; 0; 2; 0; 0; 0; 6|];
[|0; 6; 0; 0; 0; 0; 2; 8; 0|];
[|0; 0; 0; 4; 1; 9; 0; 0; 5|];
[|0; 0; 0; 0; 8; 0; 0; 7; 9|]
|]
# solver q00 0 0;; 5 3 4 6 7 8 9 1 2 6 7 2 1 9 5 3 4 8 1 9 8 3 4 2 5 6 7 8 5 9 7 6 1 4 2 3 4 2 6 8 5 3 7 9 1 7 1 3 9 2 4 8 5 6 9 6 1 5 3 7 2 8 4 2 8 7 4 1 9 6 3 5 3 4 5 2 8 6 1 7 9 - : unit = ()