電車の中で

- 作者: Bruce A. Tate,まつもとゆきひろ,田和勝
- 出版社/メーカー: オーム社
- 発売日: 2011/07/23
- メディア: 単行本(ソフトカバー)
- 購入: 9人 クリック: 230回
- この商品を含むブログ (65件) を見る
を読んでいて, Prolog で数独や8クイーンを解いているのを見て, そういえば8クイーンという問題があったなというのを思い出して, そういえば OCaml で書けるなというのに気づいてさっき確認した
Nクイーン問題というのは, N * N の大きさのチェス盤に N 個のクイーンを, どの2つも互いに相手を取られないような位置に置く, という問題で, 昔 id:sifi_border に教えてもらいました. N = 8 のときは解が92通りある
こういうパズルっぽい問題でブルートフォースしたいときは, リストモナドを使って非決定性計算を表現するとカッコよく求めることができます. カッコいいだけであって, アルゴリズムが優れているわけでは全然ない...
では書きます
まず縦横に同じ列に駒があったらアウトなので, (1, a), (2, b) ... (8, h) に駒がある(a, ..., h は1から8をちょうど1回ずつ使う)としてよい
この 8! 通りを全部試します
type 'a m = 'a list let (>>=) x f = List.concat (List.map f x) let return x = [x] let guard b = if b then return () else []
リストモナドと guard
. guard
は制約を設定するために使う
let numbers = [1; 2; 3; 4; 5; 6; 7; 8] let rec remove l n = match l with | [] -> [] | x :: xs -> if x = n then xs else x :: (remove xs n)
候補の数のリストと, 候補を減らすための関数
let not_diagonal (p, q) (r, s) = if ((p - r) = (q - s)) || ((p - r) = (s - q)) then false else true let rec not_diagonal_all l (r, s) = match l with | [] -> true | (p, q) :: rest -> if not_diagonal (p, q) (r, s) then not_diagonal_all rest (r,s) else false
対角線上に 2 つの駒が無い場合 true
を返すような関数
let find = numbers >>= (fun a -> let numbers2 = remove numbers a in numbers2 >>= (fun b -> (guard (not_diagonal_all [(1, a)] (2, b))) >>= (fun _ -> let numbers3 = remove numbers2 b in numbers3 >>= (fun c -> (guard (not_diagonal_all [(1, a); (2, b)] (3, c))) >>= (fun _ -> let numbers4 = remove numbers3 c in numbers4 >>= (fun d -> (guard (not_diagonal_all [(1, a); (2, b); (3, c)] (4, d))) >>= (fun _ -> let numbers5 = remove numbers4 d in numbers5 >>= (fun e -> (guard (not_diagonal_all [(1, a); (2, b); (3, c); (4, d)] (5, e))) >>= (fun _ -> let numbers6 = remove numbers5 e in numbers6 >>= (fun f -> (guard (not_diagonal_all [(1, a); (2, b); (3, c); (4, d); (5, e)] (6, f))) >>= (fun _ -> let numbers7 = remove numbers6 f in numbers7 >>= (fun g -> (guard (not_diagonal_all [(1, a); (2, b); (3, c); (4, d); (5, e); (6, f)] (7, g))) >>= (fun _ -> let numbers8 = remove numbers7 g in numbers8 >>= (fun h -> (guard (not_diagonal_all [(1, a); (2, b); (3, c); (4, d); (5, e); (6, f); (7, g)] (8, h))) >>= (fun _ -> return ((1, a), (2, b), (3, c), (4, d), (5, e), (6, f), (7, g), (8, h)))))))))))))))))
これで計算おしまい. このfind
というのが答えが格納されたリストになっています
以上を 8queen.ml
として, インタプリタを起動
# #use "8queen.ml";; type 'a m = 'a list val ( >>= ) : 'a list -> ('a -> 'b list) -> 'b list = <fun> val return : 'a -> 'a list = <fun> val guard : bool -> unit list = <fun> val numbers : int list = [1; 2; 3; 4; 5; 6; 7; 8] val remove : 'a list -> 'a -> 'a list = <fun> val not_diagonal : int * int -> int * int -> bool = <fun> val not_diagonal_all : (int * int) list -> int * int -> bool = <fun> val find : ((int * int) * (int * int) * (int * int) * (int * int) * (int * int) * (int * int) * (int * int) * (int * int)) list = [((1, 1), (2, 5), (3, 8), (4, 6), (5, 3), (6, 7), (7, 2), (8, 4)); ((1, 1), (2, 6), (3, 8), (4, 3), (5, 7), (6, 4), (7, 2), (8, 5)); ((1, 1), (2, 7), (3, 4), (4, 6), (5, 8), (6, 2), (7, 5), (8, 3)); ((1, 1), (2, 7), (3, 5), (4, 8), (5, 2), (6, 4), (7, 6), (8, 3)); ((1, 2), (2, 4), (3, 6), (4, 8), (5, 3), (6, 1), (7, 7), (8, 5)); ((1, 2), (2, 5), (3, 7), (4, 1), (5, 3), (6, 8), (7, 6), (8, 4)); ((1, 2), (2, 5), (3, 7), (4, 4), (5, 1), (6, 8), (7, 6), (8, 3)); ((1, 2), (2, 6), (3, 1), (4, 7), (5, 4), (6, 8), (7, 3), (8, 5)); ((1, 2), (2, 6), (3, 8), (4, 3), (5, 1), (6, 4), (7, 7), (8, 5)); ((1, 2), (2, 7), (3, 3), (4, 6), (5, 8), (6, 5), (7, 1), (8, 4)); ((1, 2), (2, 7), (3, 5), (4, 8), (5, 1), (6, 4), (7, 6), (8, 3)); ((1, 2), (2, 8), (3, 6), (4, 1), (5, 3), (6, 5), (7, 7), (8, ...)); ...] # List.length find;; - : int = 92
念のため N = 10 でチェック. Wikipedia によると 724 通りあります
10queen.ml
type 'a m = 'a list let (>>=) x f = List.concat (List.map f x) let return x = [x] let guard b = if b then return () else [] let numbers = [1; 2; 3; 4; 5; 6; 7; 8; 9; 10] let rec remove l n = match l with | [] -> [] | x :: xs -> if x = n then xs else x :: (remove xs n) (* 対角線上に2駒が無いかどうかの判定 *) let not_diagonal (p, q) (r, s) = if ((p - r) = (q - s)) || ((p - r) = (s - q)) then false else true let rec not_diagonal_all l (r, s) = match l with | [] -> true | (p, q) :: rest -> if not_diagonal (p, q) (r, s) then not_diagonal_all rest (r,s) else false let find = numbers >>= (fun a -> let numbers2 = remove numbers a in numbers2 >>= (fun b -> (guard (not_diagonal_all [(1, a)] (2, b))) >>= (fun _ -> let numbers3 = remove numbers2 b in numbers3 >>= (fun c -> (guard (not_diagonal_all [(1, a); (2, b)] (3, c))) >>= (fun _ -> let numbers4 = remove numbers3 c in numbers4 >>= (fun d -> (guard (not_diagonal_all [(1, a); (2, b); (3, c)] (4, d))) >>= (fun _ -> let numbers5 = remove numbers4 d in numbers5 >>= (fun e -> (guard (not_diagonal_all [(1, a); (2, b); (3, c); (4, d)] (5, e))) >>= (fun _ -> let numbers6 = remove numbers5 e in numbers6 >>= (fun f -> (guard (not_diagonal_all [(1, a); (2, b); (3, c); (4, d); (5, e)] (6, f))) >>= (fun _ -> let numbers7 = remove numbers6 f in numbers7 >>= (fun g -> (guard (not_diagonal_all [(1, a); (2, b); (3, c); (4, d); (5, e); (6, f)] (7, g))) >>= (fun _ -> let numbers8 = remove numbers7 g in numbers8 >>= (fun h -> (guard (not_diagonal_all [(1, a); (2, b); (3, c); (4, d); (5, e); (6, f); (7, g)] (8, h))) >>= (fun _ -> let numbers9 = remove numbers8 h in numbers9 >>= (fun i -> (guard (not_diagonal_all [(1, a); (2, b); (3, c); (4, d); (5, e); (6, f); (7, g); (8, h)] (9, i))) >>= (fun _ -> let numbers10 = remove numbers9 i in numbers10 >>= (fun j -> (guard (not_diagonal_all [(1, a); (2, b); (3, c); (4, d); (5, e); (6, f); (7, g); (8, h); (9, i)] (10, j))) >>= (fun _ -> return ((1, a), (2, b), (3, c), (4, d), (5, e), (6, f), (7, g), (8, h), (9, i), (10, j)))))))))))))))))))))
# #use "10queen.ml";; type 'a m = 'a list val ( >>= ) : 'a list -> ('a -> 'b list) -> 'b list = <fun> val return : 'a -> 'a list = <fun> val guard : bool -> unit list = <fun> val numbers : int list = [1; 2; 3; 4; 5; 6; 7; 8; 9; 10] val remove : 'a list -> 'a -> 'a list = <fun> val not_diagonal : int * int -> int * int -> bool = <fun> val not_diagonal_all : (int * int) list -> int * int -> bool = <fun> val find : ((int * int) * (int * int) * (int * int) * (int * int) * (int * int) * (int * int) * (int * int) * (int * int) * (int * int) * (int * int)) list = [((1, 1), (2, 3), (3, 6), (4, 8), (5, 10), (6, 5), (7, 9), (8, 2), (9, 4), (10, 7)); ((1, 1), (2, 3), (3, 6), (4, 9), (5, 7), (6, 10), (7, 4), (8, 2), (9, 5), (10, 8)); ((1, 1), (2, 3), (3, 6), (4, 9), (5, 7), (6, 10), (7, 4), (8, 2), (9, 8), (10, 5)); ((1, 1), (2, 3), (3, 9), (4, 7), (5, 10), (6, 4), (7, 2), (8, 5), (9, 8), (10, 6)); ((1, 1), (2, 4), (3, 6), (4, 9), (5, 3), (6, 10), (7, 8), (8, 2), (9, 5), (10, 7)); ((1, 1), (2, 4), (3, 7), (4, 10), (5, 2), (6, 9), (7, 5), (8, 3), (9, 8), (10, 6)); ((1, 1), (2, 4), (3, 7), (4, 10), (5, 3), (6, 9), (7, 2), (8, 5), (9, 8), (10, 6)); ((1, 1), (2, 4), (3, 7), (4, 10), (5, 6), (6, 9), (7, 2), (8, 5), (9, 3), (10, 8)); ((1, 1), (2, 4), (3, 7), (4, 10), (5, 8), (6, 2), (7, 5), (8, 3), (9, 6), (10, 9)); ((1, 1), (2, 4), (3, 7), (4, 10), (5, 8), (6, 3), (...), ...); ...] # List.length find;; - : int = 724