複雑な問題を厳密に解こうとするときや、条件を満たす解をすべて求める必要があるとき、可能性のあるパターンをすべて生成して、条件を満たしているかチェックするしか方法がない場合があります。このようなとき用いる手法に「バックトラック法 (backtracking)」があります。
たとえば、簡単な例として迷路を考えてみましょう。ある地点 A で道が左右に分かれているとします。ここで、左の道を選んで先へ進むと、行き止まりになってしまいました。この場合は A 地点まで戻って右の道へ進まないといけません。
このように、失敗したら元に戻って別の選択枝を選ぶ、という試行錯誤を繰り返して解を見つける方法がバックトラック法なのです。バックトラック法は、いろいろな分野の問題に応用できる方法です。そして、再帰定義を使うと簡単にプログラムを作ることができます。今回は簡単な例題として、バックトラック法でパズルを解いてみましょう。
パズルの世界では、1 から 9 までの数字を 1 個ずつすべて使った数字を「小町数」といいます。123456789 とか 321654987 のような数字が小町数です。「小町算」というものもあり、123 + 456 + 789 とか 321 * 654 + 987 のようなものです。今回は小町算の中でも特に有名なパズルを解いてみましょう。
1 から 9 までの数字を順番に並べ、間に + と - を補って 100 になる式をすべて求めよ。今回は 1 の先頭に - 符号は付けないものとする。
例 : 1 + 2 + 3 - 4 + 5 + 6 + 78 + 9 = 100
この問題は演算子が + と - だけしかないので、式はリストで表すことにします。OCaml の場合、異なるデータ型をリストに格納することはできないので、+ と - と数値を表すデータ型を定義します。
リスト 5 : データ型の定義 type term = Plus | Minus | Num of int
term を使うと数式は次のように表すことができます。
1 + 2 + 3 - 4 + 5 + 6 + 78 + 9
=> [Num 1; Plus; Num 2; Plus; Num 3; Minus; Num 4; Plus;
Num 5; Plus; Num 6; Plus; Num 78; Plus; Num 9]
あとは、式を生成して値を計算するだけです。式を生成するとき、リストを逆順で管理すると簡単です。次の図を見てください。
[Num 1] => [Num 2, Plus, Num 1] => [Num 3, Plus, Num 2, Plus, Num 1]
=> [Num 3, Minus, Num 2, Plus, Num 1]
=> [Num 23, Plus, Num 1]
=> [Num 2, Minus, Num 1] => [Num 3, Plus, Num 2, Minus, Num 1]
=> [Num 3, Minus, Num 2, Minus, Num 1]
=> [Num 23, Minus, Num 1]
=> [Num 12] => [Num 3, Plus, Num 12]
=> [Num 3, Minus, Num 12]
=> [Num 123]
図 1 : 式の生成
式を生成するとき、リストに数字と演算子を順番に追加していきます。Num と Plus, Minus を追加する処理は簡単です。プログラムのポイントは数字を連結する処理、たとえば 1 と 2 を連結して一つの数値 12 にする処理です。この処理はリストの先頭の数字 Num 1 を Num 12 (= 1 * 10 + 2) に置き換えることで実現できます。リストが [Num 2, Plus, Num 1] であれば、Num 2 を Num 23 (= 2 * 10 + 3) に置き換えます。
式を生成するプログラムは次のようになります。
リスト 6 : 式の生成
let rec make_expr n expr =
if n = 10 then
let expr1 = List.rev expr in
if calc_expr expr1 = 100 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_exp の引数 n が追加する数字、expr が生成する式（リスト）です。n が 10 になったら式が完成したので値を計算します。関数 List.rev で式を元に戻し、関数 calc_expr で式 expr1 を計算します。その結果が 100 になれば関数 print_expr で式を出力します。
n が 10 より小さい場合は数値と演算子をリストにセットします。最初に Num n と Plus をセットして make_expr を再帰呼び出しします。その次に、Num n と Minsu をセットして make_expr を呼び出します。最後に、Num x を Num (x * 10 + n) に置き換えてから make_expr を呼び出します。これで、全部の数式を生成することができます。
次は式を計算する関数 calc_exp を作ります。今回の問題は演算子に + と - しかないので、リストで表現した式を計算することは簡単です。次のプログラムを見てください。
リスト 7 : 式の計算
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")
実際の計算処理は局所関数 calc_expr_sub で行います。第 1 引数が数式 (リスト) で、第 2 引数が計算結果です。calc_expr は先頭の数値 x を取り出し、残りの数式を calc_expr_sub の第 1 引数に、x を第 2 引数に渡します。すると、数式の先頭は Plus か Minus になります。
calc_expr_sub では、Plus の場合は次の数値 x を sum に加算し、Minus の場合は sum から減算します。あとは calc_expr_sub を再帰呼び出しするだけです。
あとのプログラムは簡単なので説明は省略いたします。詳細はプログラムリスト１をお読みください。
それでは実行結果を示します。
# make_expr 2 [Num 1];; 1 + 2 + 3 - 4 + 5 + 6 + 78 + 9 = 100 1 + 2 + 34 - 5 + 67 - 8 + 9 = 100 1 + 23 - 4 + 5 + 6 + 78 - 9 = 100 1 + 23 - 4 + 56 + 7 + 8 + 9 = 100 12 + 3 + 4 + 5 - 6 - 7 + 89 = 100 12 + 3 - 4 + 5 + 67 + 8 + 9 = 100 12 - 3 - 4 + 5 - 6 + 7 + 89 = 100 123 + 4 - 5 + 67 - 89 = 100 123 + 45 - 67 + 8 - 9 = 100 123 - 4 - 5 - 6 - 7 + 8 - 9 = 100 123 - 45 - 67 + 89 = 100 - : unit = ()
全部で 11 通りの解が出力されます。この他にも、いろいろな解き方があると思います。興味のある方は、もっとクールな方法を考えてみてください。
もう一つ、有名なパズルを解いてみましょう。8 クイーンはコンピュータに解かせるパズルの中でも特に有名な問題です。8 クイーンは、8 行 8 列のチェスの升目に、8 個のクイーンを互いの利き筋が重ならないように配置する問題です。クイーンは将棋の飛車と角をあわせた駒で、縦横斜めに任意に動くことができます。解答の一例を示します。
列
1 2 3 4 5 6 7 8
*-----------------*
1 | Q . . . . . . . |
2 | . . . . Q . . . |
3 | . . . . . . . Q |
行 4 | . . . . . Q . . |
5 | . . Q . . . . . |
6 | . . . . . . Q . |
7 | . Q . . . . . . |
8 | . . . Q . . . . |
*-----------------*
図 2 : 8 クイーンの解答例
8 クイーンを解くには、すべての置き方を試してみるしか方法はありません。最初のクイーンは、盤上の好きなところへ置くことができるので、64 通りの置き方があります。次のクイーンは 63 通り、その次は 62 通りあります。したがって、置き方の総数は 64 から 57 までの整数を掛け算した 178462987637760 通りもあります。
ところが、解答例を見ればわかるように、同じ行と列に 2 つ以上のクイーンを置くことはできません。上図の解答例をリストを使って表すと、 次のようになります。
1 2 3 4 5 6 7 8 <--- 列の位置
---------------------------
[1, 7, 5, 8, 2, 4, 6, 3] <--- 要素が行の位置を表す
図 3 : リストでの行と列の表現方法
列をリストの位置に、行番号を要素に対応させれば、各要素には 1 から 8 までの数字が重複しないで入ることになります。すなわち、1 から 8 までの順列の総数である 8! = 40320 通りの置き方を調べるだけでよいのです。パズルを解く場合は、そのパズル固有の性質をうまく使って、調べなければならない場合の数を減らすように工夫することが大切です。
順列を生成するプログラムは「順列と組み合わせ」で作成しました。あとは、その順列が 8 クイーンの条件を満たしているかチェックすればいいわけです。このように、正解の可能性があるデータを作りそれをチェックするという方法を「生成検定法 (generate and test)」といいます。
可能性のあるデータをもれなく作るような場合、バックトラック法は最適です。ただし、「生成するデータ数が多くなると時間がとてもかかる」という弱点があるので注意してください。
それでは、プログラムを作りましょう。次のリストを見てください。
リスト 8 : 8 クイーンの解法
(* 盤面の表示 *)
let rec print_board = function
[] -> print_newline ()
| x :: xs -> print_int x; print_string " "; print_board xs
(* 安全確認 *)
let rec safe = function
[] -> true
| x :: xs -> if attack x xs then safe xs else false
let rec queen f nums board =
if nums = [] then
if safe board then f board else ()
else
List.iter (fun x -> queen f (remove x nums) (x :: board)) nums
関数 queen は順列を生成するプログラムと同じです。順列を一つ生成したら、述語 safe で 8 クイーンの条件を満たしているかチェックします。そうであれば、関数 f を呼び出します。print_board を渡すと盤面 (リスト) を表示します。
述語 safe はリストの先頭の要素からチェックしていきます。衝突のチェックは斜めの利き筋を調るだけです。端にあるクイーンから順番に調べるとすると、斜めの利き筋は次のように表せます。
1 2 3 --> 調べる方向
*-------------
| . . . . . .
| . . . -3. . 5 - 3 = 2
| . . -2. . . 5 - 2 = 3
| . -1. . . . 5 - 1 = 4
| Q . . . . . Q の位置は 5
| . +1. . . . 5 + 1 = 6
| . . +2. . . 5 + 2 = 7
| . . . +3. . 5 + 2 = 8
*-------------
図 4 : 衝突の検出
図を見てもらえばおわかりのように、Q が行 5 にある場合、ひとつ隣の列は 4 と 6 が利き筋に当たります。2 つ隣の列の場合は 3 と 7 が利き筋に当たります。このように単純な足し算と引き算で、利き筋を計算することができます。これをプログラムすると次のようになります。
リスト 9 : 衝突の検出
let attack x xs =
let rec attack_sub x n = function
[] -> true
| y :: ys -> if x = y + n || x = y - n then false
else attack_sub x (n + 1) ys
in
attack_sub x 1 xs
attack は、斜めの利き筋に当たった場合に false を返し、利き筋に当たらない場合は true を返します。実際の処理は局所関数 attack_sub で行います。attack_sub はリストの先頭から斜めの利き筋に当たるか調べます。第 1 引数がクイーンの位置、第 2 引数が位置の差分、第 3 引数がリストになります。
最初の節がクイーンを全て調べた場合です。クイーンは衝突していないので true を返します。次の節で、リストから先頭の要素 y を取りだし、利き筋に当たるか調べます。これは、y + n または y - n が x と等しいかチェックするだけです。衝突している場合は false を返します。そうでなければ、attack_sub を再帰呼び出しして次のクイーンを調べます。このとき、差分 n の値を +1 することをお忘れなく。
これでプログラムは完成です。それでは実行してみましょう。
# queen print_board [1; 2; 3; 4; 5; 6; 7; 8] [];; 4 2 7 3 6 8 5 1 ... 省略 ... 5 7 2 6 3 1 4 8 val it = () : unit
解は全部で 92 通りあります。ところで、このプログラムはクイーンの個数を増やすと極端に遅くなります。ocaml でクイーンの個数を増やして試してみたところ、実行時間は次のようになりました。
リスト : N Queens Problem let rec iota n m = if n > m then [] else n :: iota (n + 1) m let test_queen f n = let c = ref 0 in let s = Sys.time () in f (fun _ -> c := !c + 1) (iota 1 n) []; print_float (Sys.time () -. s); !c
| 個数 | 8 | 9 | 10 |
|---|---|---|---|
| 解の個数 | 92 | 352 | 724 |
| queen() | 0.047 | 0.344 | 3.859 |
実はこのプログラム、とても非効率なことをやっているのです。
実行速度が遅い理由は、失敗することがわかっている順列も生成してしまうからです。たとえば、最初 (1, 1) の位置にクイーンを置くと、次のクイーンは (2, 2) の位置に置くことはできませんね。したがって、[1; 2; X; X; X; X; X; X] という配置はすべて失敗するのですが、順列を発生させてからチェックする今の方法では、このような無駄を省くことができません。
そこで、クイーンの配置を決めるたびに衝突のチェックを行うことにします。これをプログラムすると次のようになります。
リスト : 8 クイーン (改良版)
let rec queen_fast f nums board =
if nums = [] then f board
else List.iter (fun x ->
if attack x board then queen_fast (remove x nums) (x :: board) else ()) nums
匿名関数の中で、追加したクイーンが board 内のクイーンと衝突していないか関数 attack でチェックします。順列を生成している途中でチェックを入れることで、無駄な順列を生成しないようにするわけです。この場合、safe は必要ありません。
このように、できるだけ早い段階でチェックを入れることで、無駄なデータをカットすることを「枝刈り」と呼びます。バックトラックを使って問題を解く場合、この枝刈りのよしあしによって実行時間が大きく左右されます。ところが、枝刈りの方法はパズルによって違います。パズル固有の性質をよく調べて、適切な枝刈りを考えることが重要なのです。
パズル自体はコンピュータに解かせるのですが、枝刈りの条件は私達が考えるわけです。これも「パズルの解法」の面白いところでしょう。解を求めるだけでなく、いかに効率の良い条件を見つけて実行時間を短縮するか、ということでも楽しむことができます。
それでは、実行結果を表 3 に示します。
| 個数 | 8 | 9 | 10 | 11 | 12 |
|---|---|---|---|---|---|
| 解の個数 | 92 | 352 | 724 | 2680 | 14200 |
| queen | 0.047 | 0.344 | 3.859 | ---- | ---- |
| queen_fast | 0.016 | 0,016 | 0.016 | 0.203 | 1.203 |
このように、枝刈りを行うことで実行時間を大幅に短縮することができます。ところで、今回は単純にリストを出力するだけなので、ちょっと面白くありません。興味のある方は、解答例のような図を出力するプログラムを作ってみてください。
(*
* komachi.ml : 小町算の解法
*
* Copyright (C) 2008-2020 Makoto Hiroi
*)
(* データ型の定義 *)
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 " = 100\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 = 10 then
let expr1 = List.rev expr in
if calc_expr expr1 = 100 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")
(*
* queen.ml : ８クイーンの解法
*
* Copyright (C) 2008-2020 Makoto Hiroi
*)
(* 盤面の表示 *)
let rec print_board = function
[] -> print_newline ()
| x :: xs -> print_int x; print_string " "; print_board xs
(* 要素の削除 *)
let rec remove n xs = List.filter (fun x -> x <> n) xs
(* 衝突の検出 *)
let attack x xs =
let rec attack_sub x n = function
[] -> true
| y :: ys -> if x = y + n || x = y - n then false
else attack_sub x (n + 1) ys
in
attack_sub x 1 xs
(* 安全確認 *)
let rec safe = function
[] -> true
| x :: xs -> if attack x xs then safe xs else false
(* 単純な生成検定法 *)
let rec queen f nums board =
if nums = [] then
if safe board then f board else ()
else
List.iter (fun x -> queen (remove x nums) (x :: board)) nums
(* 高速バージョン *)
let rec queen_fast f nums board =
if nums = [] then f board
else List.iter (fun x ->
if attack x board then queen_fast (remove x nums) (x :: board) else ()) nums
(* 整数列の生成 *)
let rec iota n m =
if n > m then []
else n :: iota (n + 1) m
(* 時間計測 *)
let test_queen f n =
let c = ref 0 in
let s = Sys.time () in
f (fun _ -> c := !c + 1) (iota 1 n) [];
print_float (Sys.time () -. s);
!c