M.Hiroi's Home Page
F# Programming
F# Junk Scripts
二分木
今回は「二分木 (binary tree)」というデータ構造を作ってみましょう。F# のモジュール Map や Set の実装には「平衡木 (balanced binary tree)」が用いられていますが、単純な二分木であれば私達でも簡単にプログラムすることができます。二分木の詳しい説明は、以下に示す拙作のページをお読みくださいませ。
●モジュールによる immutable な実装
●プログラムリスト
//
// tree.fsx : 二分木 (immutable)
//
// Copyright (C) 2022 Makoto Hiroi
//
module Tree
// 二分木の定義
type 'a tree = private Nil | Node of 'a * 'a tree * 'a tree
// 空の木
let empty () = Nil
// 木は空か？
let isEmpty = function
Nil -> true
| _ -> false
// 追加
let rec add x = function
Nil -> Node (x, Nil, Nil)
| (Node (y, _, _)) as node when x = y -> node
| Node (y, l, r) when x < y -> Node (y, (add x l), r)
| Node (y, l, r) -> Node (y, l, (add x r))
// 探索
let rec contains x = function
Nil -> false
| Node (y, _, _) when x = y -> true
| Node (y, l, _) when x < y -> contains x l
| Node (_, _, r) -> contains x r
// 最小値を求める
let rec min = function
Nil -> failwith "empty tree"
| Node (x, Nil, _) -> x
| Node (_, l, _) -> min l
// 最大値を求める
let rec max = function
Nil -> failwith "empty tree"
| Node (x, _, Nil) -> x
| Node (_, _, r) -> max r
// 最小値を削除する
let rec deleteMin = function
Nil -> failwith "empty tree"
| Node (x, Nil, r) -> r
| Node (x, l, r) -> Node (x, (deleteMin l), r)
// 最大値を削除する
let rec deleteMax = function
Nil -> failwith "empty tree"
| Node (x, l, Nil) -> l
| Node (x, l, r) -> Node (x, l, (deleteMax r))
// データの削除
let rec delete x = function
Nil -> failwith "not delete"
| Node(y, l, r) ->
if x = y then
if l = Nil then r
else if r = Nil then l
else
let min_data = min r
Node (min_data, l, (deleteMin r))
else if x < y then
Node (y, (delete x l), r)
else
Node (y, l, (delete x r))
// 二分木の巡回
let rec iter f = function
Nil -> ()
| Node (x, l, r) -> iter f l; f x; iter f r
// 二分木の畳み込み
let rec fold f a = function
Nil -> a
| Node (x, l, r) -> fold f (f (fold f a l) x) r
●実行例
> open Tree;;
> let a = empty() |> add 5 |> add 3 |> add 7 |> add 4 |> add 6;;
val a: int tree =
Node (5, Node (3, Nil, Node (4, Nil, Nil)), Node (7, Node (6, Nil, Nil), Nil))
> isEmpty a;;
val it: bool = false
> contains 4 a;;
val it: bool = true
> contains 2 a;;
val it: bool = false
> contains 8 a;;
val it: bool = false
> min a;;
val it: int = 3
> max a;;
val it: int = 7
> let b = deleteMin a;;
val b: int tree =
Node (5, Node (4, Nil, Nil), Node (7, Node (6, Nil, Nil), Nil))
> contains 3 b;;
val it: bool = false
> let c = deleteMax b;;
val c: int tree = Node (5, Node (4, Nil, Nil), Node (6, Nil, Nil))
> contains 7 c;;
val it: bool = false
> let d = a |> delete 3 |> delete 4 |> delete 5 |> delete 6 |> delete 7;;
val d: int tree = Nil
> isEmpty d;;
val it: bool = true
> iter (fun x -> printfn "%d" x) a;;
3
4
5
6
7
val it: unit = ()
> fold (fun a x -> x::a) [] a;;
val it: int list = [7; 6; 5; 4; 3]
●クラスによる immutable な実装
●プログラムリスト
//
// tree1.fsx : 二分木 (クラスによる実装, immutable)
//
// Copyright (C) 2022 Makoto Hiroi
//
module Tree1
[<AbstractClass>]
type Tree<'a when 'a: comparison>() =
// 空の木
static let nil = new Empty<'a>()
static member empty() = nil
abstract isEmpty: unit -> bool
abstract Item : 'a with get
abstract Left : Tree<'a> with get
abstract Right : Tree<'a> with get
member this.add(x: 'a) =
if this.isEmpty() then new Node<'a>(x, this, this)
else if x = this.Item then this :?> Node<'a>
else if x < this.Item then new Node<'a>(this.Item, this.Left.add(x), this.Right)
else new Node<'a>(this.Item, this.Left, this.Right.add(x))
member this.contains(x: 'a) =
if this.isEmpty() then false
else if x = this.Item then true
else if x < this.Item then this.Left.contains(x)
else this.Right.contains(x)
member this.min () =
if this.isEmpty() then failwith "empty tree"
else if this.Left.isEmpty() then this.Item
else this.Left.min()
member this.max () =
if this.isEmpty() then failwith "empty tree"
else if this.Right.isEmpty() then this.Item
else this.Right.max()
member this.deleteMin () =
if this.isEmpty() then failwith "empty tree"
else if this.Left.isEmpty() then this.Right :?> Node<'a>
else new Node<'a>(this.Item, this.Left.deleteMin(), this.Right)
member this.deleteMax () =
if this.isEmpty() then failwith "empty tree"
else if this.Right.isEmpty() then this.Left :?> Node<'a>
else new Node<'a>(this.Item, this.Left, this.Right.deleteMax())
member this.delete (x: 'a) =
if this.isEmpty() then failwith "not delete"
else if x = this.Item then
if this.Left.isEmpty() then this.Right
else if this.Right.isEmpty() then this.Left
else let min_data = this.Right.min()
new Node<'a>(min_data, this.Left, this.Right.deleteMin())
else if x < this.Item then new Node<'a>(this.Item, this.Left.delete(x), this.Right)
else new Node<'a>(this.Item, this.Left, this.Right.delete(x))
member this.iter f =
if this.isEmpty() then ()
else (
this.Left.iter f
f this.Item
this.Right.iter f
)
member this.fold f a =
if this.isEmpty() then a
else this.Right.fold f (f (this.Left.fold f a) this.Item)
and Node<'a when 'a: comparison>(x: 'a, l: Tree<'a>, r: Tree<'a>) =
inherit Tree<'a>()
let mutable item = x
let mutable left = l
let mutable right = r
override this.isEmpty () = false
override this.Item with get() = item
override this.Left with get() = left
override this.Right with get() = right
and Empty<'a when 'a: comparison>() =
inherit Tree<'a>()
override this.isEmpty() = true
override this.Item with get() = raise EmptyTree
override this.Left with get() = raise EmptyTree
override this.Right with get() = raise EmptyTree
●実行例
> open Tree1;;
> let a = Tree<int>.empty();;
val a: Empty<int>
> a.isEmpty();;
val it: bool = true
> let b = a.add(5).add(3).add(7).add(4).add(6);;
val b: Node<int>
> b;;
val it: Node<int> =
FSI_0006.Tree1+Node`1[System.Int32]
{Item = 5;
Left = FSI_0006.Tree1+Node`1[System.Int32];
Right = FSI_0006.Tree1+Node`1[System.Int32];}
> b.iter (fun x -> printfn "%d" x);;
3
4
5
6
7
val it: unit = ()
> b.contains 3;;
val it: bool = true
> b.contains 7;;
val it: bool = true
> b.contains 0;;
val it: bool = false
> b.contains 8;;
val it: bool = false
> b.max();;
val it: int = 7
> b.min();;
val it: int = 3
> let c = b.deleteMax();;
val c: Node<int>
> c.contains 7;;
val it: bool = false
> let d = b.deleteMin();;
val d: Node<int>
> d.contains 3;;
val it: bool = false
> let e = b.delete(3).delete(4).delete(5).delete(6).delete(7);;
val e: Tree<int>
> e.isEmpty();;
val it: bool = true
> b.fold (fun a x -> x::a) [];;
val it: int list = [7; 6; 5; 4; 3]
カッコ列と二分木
カッコ列は ( と ) からなる列のことで、バランスが取れているカッコ列は、右カッコで閉じることができる、つまり右カッコに対応する左カッコがある状態のことをいいます。たとえば n = 1 の場合、( ) はバランスの取れたカッコ列ですが、) ( はバランスが取れていません。今回はカッコ列と二分木に関する問題を出題するので、F# で解答プログラムを作ってください。
以下に二分木の定義を示します。
リスト : 二分木の定義
type tree = L | N of tree * tree
N は節を、L は葉を表します。
●問題
- 二分木 xs の葉を数える関数 countLeaf xs
- 二分木 xs の高さを求める関数 treeHeight xs
- 文字列 s がバランスの取れたカッコ列か判定する述語 isKakko s
- バランスの取れた n 対のカッコ列を生成する高階関数 createKakko func n
- 二分木をカッコ列に変換する関数 treeToKakko ls
- treeToKakko の逆変換を行う関数 treeFromKakko xs
●解答１
リスト : 葉の個数を求める
let rec countLeaf = function
L -> 1
| N (l, r) -> countLeaf l + countLeaf r
> countLeaf L;;
val it: int = 1
> countLeaf (N (L, L));;
val it: int = 2
> countLeaf (N (N (L, L), N (L, L)));;
val it: int = 4
> countLeaf (N (N (L, L), N (L, N (L, L))));;
val it: int = 5
countLeaf の引数が葉 L ならば 1 を返します。節 N ならば、countLeaf を再帰呼び出しして、左部分木と右部分木の葉の個数を求め、それを足し算して返すだけです。
●解答２
リスト : 木の高さを求める
let rec treeHeight = function
L -> 0
| N (l, r) -> let a = treeHeight l
let b = treeHeight r
1 + max a b
> treeHeight L;;
val it: int = 0
> treeHeight (N (L, L));;
val it: int = 1
> treeHeight (N (N (L, L), L));;
val it: int = 2
> treeHeight (N (N (N (L, L), L), L));;
val it: int = 3
treeHeight の引数が葉 L ならば 0 を返します。節 N ならば、treeHeight を再帰呼び出しして、右部分木と左部分木の高さを求めます。あとは、大きいほうの値に 1 を足して返すだけです。これで二分木の高さを求めることができます。
●解答３
リスト : カッコ列の判定
let isKakko s =
let rec iter i l r =
if String.length s = i then l = r
else if s.[i] = '(' then iter (i + 1) (l + 1) r
else if s.[i] = ')' then
if l < r + 1 then false
else iter (i + 1) l (r + 1)
else failwith "illegal charcter"
iter 0 0 0
> isKakko "()";;
val it: bool = true
> isKakko ")(";;
val it: bool = false
> isKakko "((()))";;
val it: bool = true
> isKakko "((())";;
val it: bool = false
> isKakko "((())))";;
val it: bool = false
> isKakko "()()()()";;
val it: bool = true
> isKakko "()(())()";;
val it: bool = true
> isKakko "()()))()";;
val it: bool = false
カッコ列の判定は左右のカッコの個数を調べることで簡単に判定することができます。左カッコの個数を iter の引数 l で、右カッコの個数を引数 r でカウントします。バランスの取れた n 対のカッコ列の場合、l, r, n には r <= l <= n の関係が成り立ちます。
r を +1 したとき、r が l よりも大きくなるとバランスが取れていません。false を返します。文字列を最後まで読み込んだら、l と r の値が等しいかチェックします。そうでなければバランスが取れていない (左カッコが多い) ので false を返します。
●解答４
リスト : カッコ列の生成
let createKakko f n =
let rec kakkoSub l r a =
if l = r && r = n then f a
else (
if l < n then kakkoSub (l + 1) r (a + "(") else ()
if r < l then kakkoSub l (r + 1) (a + ")") else ()
)
kakkoSub 0 0 ""
> createKakko (fun s -> printfn "%s" s) 1;;
()
val it: unit = ()
> createKakko (fun s -> printfn "%s" s) 2;;
(())
()()
val it: unit = ()
> createKakko (fun s -> printfn "%s" s) 3;;
((()))
(()())
(())()
()(())
()()()
val it: unit = ()
> createKakko (fun s -> printfn "%s" s) 4;;
(((())))
((()()))
((())())
((()))()
(()(()))
(()()())
(()())()
(())(())
(())()()
()((()))
()(()())
()(())()
()()(())
()()()()
val it: unit = ()
実際の処理は局所関数 kakkoSub で行います。引数 l が左カッコの個数、r が右カッコの個数を表します。l = r = n の場合、カッコ列がひとつ完成しました。引数の関数 f を呼び出します。そうでなければ、kakkoSub を再帰呼び出しします。l < n であれば左カッコを追加し、r < l であれば右カッコを追加します。これでカッコ列を生成することができます。
●解答５
リスト : 二分木をカッコ列に変換
type tree = L | N * tree * tree
let treeToKakko xs =
let rec toKakko = function
L -> ")"
| N (l, r) -> "(" + (toKakko l) + (toKakko r)
let a = toKakko xs
a.[0 .. (String.length a - 2)]
> N (L, L) |> treeToKakko;;
val it: string = "()"
> N (N (L, L), L) |> treeToKakko;;
val it: string = "(())"
> N (L, N (L, L)) |> treeToKakko;;
val it: string = "()()"
> N (N (N (L, L), L), L) |> treeToKakko;;
val it: string = "((()))"
> N (N (L, N (L, L)), L) |> treeToKakko;;
val it: string = "(()())"
> N (N (L, L), N (L, L)) |> treeToKakko;;
val it: string = "(())()"
バランスの取れたカッコ列と二分木は 1 対 1 に対応します。二分木を行きがけ順で巡回するとき、途中の節では左カッコ ( を出力して左右の枝をたどり、葉に到達したら右カッコ ) を出力すると、カッコ列を生成することができます。
実際の処理は局所関数 toKakko で行います。引数が節 N の場合、先頭文字が "(" になり、そのあと iter を再帰呼び出しして左部分木 l をたどり、それから右部分木 r をたどります。その結果を演算子 + で連結すればいいわけです。
葉 (要素) の場合は ")" を返します。ただし、このままでは最後に余分な右カッコが付いてくるので、文字列のスライス操作を使って末尾文字を削除します。
●解答６
リスト : カッコ列を二分木に変換
let treeFromKakko s =
let rec iter i =
if i = String.length s then (L, i)
else if s.[i] = ')' then (L, i + 1)
else if s.[i] = '(' then
let (a, b) = iter (i + 1)
let (c, d) = iter b
(N (a, c), d)
else failwith "illegal character"
iter 0
> treeFromKakko "()";;
val it: tree * int = (N (L, L), 2)
> treeFromKakko "(())";;
val it: tree * int = (N (N (L, L), L), 4)
> treeFromKakko "((()))";;
val it: tree * int = (N (N (N (L, L), L), L), 6)
> treeFromKakko "()()()";;
val it: tree * int = (N (L, N (L, N (L, L))), 6)
> treeFromKakko "(())()";;
val it: tree * int = (N (N (L, L), N (L, L)), 6)
> treeFromKakko "(())(())";;
val it: tree * int = (N (N (L, L), N (N (L, L), L)), 8)
> treeFromKakko "(((())))";;
val it: tree * int = (N (N (N (N (L, L), L), L), L), 8)
実際の処理は局所関数 iter で行います。iter は生成した二分木と文字の位置を格納したタプルを返します。i 番目の文字が '(' の場合、iter を再帰呼び出しして左部分木 a を生成し、それから右部分木 c を生成します。あとは (N (a, c), d) を返すだけです。
i 番目の文字が ')' の場合は葉なので、L と i + 1 を返すだけです。ただし、右カッコがひとつ少ないので、i が文字列 s の終端に到達したら、葉 L と i を返すようにします。
経路の探索
下記経路図において、A から G までの経路を深さ優先探索、幅優先探索、反復深化で求めます。アルゴリズムの詳しい説明は、以下の拙作のページをお読みくださいませ。
図 : 経路図
●プログラムリスト
//
// keiro.fsx : 経路の探索
//
// Copyright (C) 2022 Makoto Hiroi
//
#load "queue.fs"
open Queue
// 隣接リスト (int list array)
let adjacent = [|
[1; 2] // A
[0; 2; 3] // B
[0; 1; 4] // C
[1; 4; 5] // D
[2; 3; 6] // E
[3] // F
[4] |] // G
// 深さ優先探索
let depth_first_search start goal =
let rec dfs p path =
if p = goal then printfn "%A" (List.rev path)
else List.iter (fun x -> if not (List.contains x path) then dfs x (x::path))
adjacent.[p]
dfs start [start]
// 幅優先探索 (Queue のかわりにリストで代用)
let breadth_first_search start goal =
let rec bfs = function
[] -> ()
| path::qs ->
let p = List.head path
if p = goal then (
printfn "%A" (List.rev path)
bfs qs
) else List.fold (fun a x -> if List.contains x path then a else (a @ [x::path]))
qs
adjacent.[p] |> bfs
bfs [[start]]
// モジュール Queue を使用
let breadth_first_search1 start goal =
let rec bfs que =
if is_empty que then ()
else
let path = top que
let p = List.head path
if p = goal then (
printfn "%A" (List.rev path)
bfs (dequeue que)
) else List.fold (fun q x -> if List.contains x path then q else enqueue (x::path) q)
(dequeue que)
adjacent.[p] |> bfs
create |> enqueue [start] |> bfs
// 反復深化
let id_search start goal =
let rec dfs limit p path =
if List.length path = limit then
if p = goal then printfn "%A" (List.rev path)
else List.iter (fun x -> if not (List.contains x path) then dfs limit x (x::path))
adjacent.[p]
for i = 1 to 7 do
printfn "----- move %d -----" (i - 1)
dfs i start [start]
●実行結果
> #load "keiro.fsx";;
[読み込み中 /home/mhiroi/fsharp/queue.fs
読み込み中 /home/mhiroi/fsharp/keiro.fsx]
namespace FSI_0002
exception Empty
type 'a queue = private | Q of 'a list * 'a list
val create: 'a queue
val enqueue: a: 'a -> _arg1: 'a queue -> 'a queue
val dequeue: _arg1: 'a queue -> 'a queue
val top: _arg1: 'a queue -> 'a
val is_empty: q: 'a queue -> bool when 'a: equality
namespace FSI_0002
val adjacent: int list[]
val depth_first_search: start: int -> goal: int -> unit
val breadth_first_search: start: int -> goal: int -> unit
val breadth_first_search1: start: int -> goal: int -> unit
val id_search: start: int -> goal: int -> unit
> open Keiro;;
> depth_first_search 0 6;;
[0; 1; 2; 4; 6]
[0; 1; 3; 4; 6]
[0; 2; 1; 3; 4; 6]
[0; 2; 4; 6]
val it: unit = ()
> depth_first_search 6 0;;
[6; 4; 2; 0]
[6; 4; 2; 1; 0]
[6; 4; 3; 1; 0]
[6; 4; 3; 1; 2; 0]
val it: unit = ()
> breadth_first_search 0 6;;
[0; 2; 4; 6]
[0; 1; 2; 4; 6]
[0; 1; 3; 4; 6]
[0; 2; 1; 3; 4; 6]
val it: unit = ()
> breadth_first_search 6 0;;
[6; 4; 2; 0]
[6; 4; 2; 1; 0]
[6; 4; 3; 1; 0]
[6; 4; 3; 1; 2; 0]
val it: unit = ()
> breadth_first_search1 0 6;;
[0; 2; 4; 6]
[0; 1; 2; 4; 6]
[0; 1; 3; 4; 6]
[0; 2; 1; 3; 4; 6]
val it: unit = ()
> breadth_first_search1 6 0;;
[6; 4; 2; 0]
[6; 4; 2; 1; 0]
[6; 4; 3; 1; 0]
[6; 4; 3; 1; 2; 0]
val it: unit = ()
> id_search 0 6;;
----- move 0 -----
----- move 1 -----
----- move 2 -----
----- move 3 -----
[0; 2; 4; 6]
----- move 4 -----
[0; 1; 2; 4; 6]
[0; 1; 3; 4; 6]
----- move 5 -----
[0; 2; 1; 3; 4; 6]
----- move 6 -----
val it: unit = ()
> id_search 6 0;;
----- move 0 -----
----- move 1 -----
----- move 2 -----
----- move 3 -----
[6; 4; 2; 0]
----- move 4 -----
[6; 4; 2; 1; 0]
[6; 4; 3; 1; 0]
----- move 5 -----
[6; 4; 3; 1; 2; 0]
----- move 6 -----
val it: unit = ()
深さ優先探索
今回は深さ優先探索の例題として、簡単なパズルを解いてみましょう。
●騎士の巡歴 (Knight's Tour)
騎士はチェスの駒のひとつで、将棋の桂馬の動きを前後左右にとることができます。次の図を見てください。
図 : 騎士の巡歴
この騎士を動かして、N 行 M 列の盤面のどのマスにもちょうど一回ずつ訪れるような経路を求めるのが問題です。ちなみに、3 行 3 列、4 行 4 列の盤面には解がありませんが、5 行 5 列の盤面には解があります。大きな盤面を解くのは大変なので、3 行 4 列の盤面で騎士の移動経路を求めてください。プログラムを作る前に、自分で考えてみるのも面白いでしょう。
それではプログラムを作りましょう。次の図を見てください。
図 (A) のように、3 行 4 列盤の各マスに記号を付けて表します。すると、騎士の移動は図 (B) のようにグラフで表すことができます。これならば、コンピュータを使わなくても解くことができますね。プログラムも隣接リストを定義すれば簡単です。記号は数字 0 - 11 で表せばいいでしょう。あとは単純な深さ優先探索で騎士の経路を探すだけです。
リスト : 騎士の巡歴 (puzzle01.fsx)
// 隣接リスト
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 knight start =
let rec dfs n path =
if n = 12 then printfn "%A" (List.rev path)
else
let p = List.head path
List.iter (fun x -> if List.contains x path then () else dfs (n+1) (x::path))
adjacent.[p]
dfs 1 [start]
経路はリストで表します。局所関数 dfs の引数 n が訪れたマスの個数を表し、次の引数 path が経路を表します。n が 12 になったら見つけた経路を printfn で表示します。そうでなければ、騎士を次のマスへ進めます。この処理は経路の探索と同じです。
プログラムはこれだけです。とても簡単ですね。それでは実行してみましょう。
> open Puzzle01;;
> knight 0;;
[0; 7; 2; 3; 10; 5; 6; 1; 8; 9; 4; 11]
[0; 7; 2; 3; 10; 5; 6; 11; 4; 9; 8; 1]
val it: unit = ()
2 通りの経路を見つけることができました。
このほかに、どのマスにもちょうど一回ずつ訪れたのち、最初のマスに戻ってくることを条件にする「騎士の周遊」という問題もあります。この場合、3 行 4 列盤には解がありません。また、N 行 M 列の盤面でマスの個数が奇数のときにも、最初のマスに戻ることはできません。これは簡単に証明できるので、息抜きや気分転換に考えてみてください。
解答はこちら
●ナンバープレース
皆さんお馴染みのパズル「ナンバープレース (数独)」の解法プログラムです。ナンバープレースは単純な深さ優先探索で簡単に解くことができます。説明は割愛しますので、詳細はプログラムリストをお読みください。
リスト : ナンバープレースの解法
// 盤面の表示
let print_board (board: int array array) =
for y = 0 to 8 do
for x = 0 to 8 do
printf "%d " board.[y].[x]
printfn ""
// 縦横枠に同じ数字がないことを確認する
let check (board: int array array) 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)
let x1 = (x / 3) * 3
let y1 = (y / 3) * 3
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
(check1 0) && (check2 0 0)
let number_place board =
let rec dfs x y =
if y = 9 then
print_board board
else if x = 9 then
dfs 0 (y + 1)
else if board.[y].[x] = 0 then
for n = 1 to 9 do
if check board x y n then (
board.[y].[x] <- n
dfs (x + 1) y
board.[y].[x] <- 0
) else ()
else dfs (x + 1) y
print_board board
printfn "--------------------"
dfs 0 0
// 問題 出典: 数独 - 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|] |]
> open Puzzle01;;
> number_place 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
--------------------
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
val it: unit = ()
●マスターマインド
最後に、「マスターマインド」というゲームを解くプログラムを作りましょう。マスターマインドは 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
図 : マスターマインドの動作例
今回は、私達が出した問題をコンピュータに答えてもらうことにします。それはちょっと難しいのではないか、と思った人もいるかもしれませんね。ところが、とても簡単な方法があるのです。このゲームでは、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] に矛盾しないコードを選択するのです。
●プログラムリスト
リスト : マスターマインドの解法
// 順列の生成
let rec select = function
[] -> []
| [x] -> [(x, [])]
| x::xs -> (x, xs) :: List.map (fun (y, ys) -> (y, x::ys)) (select xs)
let rec permutations n xs =
if n = 0 then [[]]
else List.collect
(fun (y, ys) -> List.map (fun zs -> y::zs) (permutations (n - 1) ys))
(select xs)
// bulls を数える
let count_bulls xs ys =
List.fold2 (fun a x y -> if x = y then a + 1 else a) 0 xs ys
// 同じ数字の個数を数える
let count_same_number xs ys =
List.fold (fun a x -> if List.contains x ys then a + 1 else a) 0 xs
// 質問のチェック
let rec check_query code = function
[] -> true
| (q, bulls, cows)::qs ->
let b = count_bulls q code
let c = count_same_number q code - b
if b = bulls && c = cows then check_query code qs
else false
let master_mind ans =
let rec iter n qs = function
[] -> failwith "not found"
| code::xs ->
if check_query code qs then (
let bulls = count_bulls code ans
let cows = count_same_number code ans - bulls
printfn "%d: %A bulls = %d, cows %d" n code bulls cows
if bulls = 4 then printfn "Good Job!!"
else iter (n+1) ((code,bulls,cows)::qs) xs
) else iter n qs xs
iter 1 [] (permutations 4 [0..9])
●実行例
> open Puzzle01;;
> master_mind [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
Good Job!!
val it: unit = ()
> master_mind [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
Good Job!!
val it: unit = ()
Copyright (C) 2022 Makoto Hiroi
All rights reserved.