[F#] 数独をF#で作る

投稿日: 2014/01/19 作成者: masuda

数独をF#で解く – Moonmile Solutions Blog
http://www.moonmile.net/blog/archives/5304

の続き。二次元トラスは別途「Visual Basicでわかる やさしい有限要素法の基礎」が届いたので、これを見てから。この本、VB6 なのかと思ったら、VB2008 で書かれた新しい本でした。これだったら、結構流用がきくかも。元ネタは Fortran らしいのですが、グラフィックな部分とか .NET で書かれているので助かる。XAMLのPATHあたりに直すと結構いいかもという感じですね。

さて、

数独の問題を作るほうは、

  1. 矛盾なくNxNを敷き詰める。
  2. ランダムに1個空白にする。
  3. 解が1つしかないことを確認する。再び2へ

を地道に実装したのが次です。やっぱり、再帰のところがうまく作れなくて、excepiton で抜けていますが、これはいずれ修正する…かも。 

open System

let bsize = 3
let size = bsize * bsize
let size2 = size * size
let pazzle = Array2D.zeroCreate<int> size size

// ルールにマッチする数を取り出す
let rec rule (m:int[,]) x y v (lst:int list) =
    // 横一列をチェック
    let rule_x (m:int[,]) x y v =
        [|for i in 0..size-1 -> m.[y,i]|] |> Array.exists (fun t -> t = v)
    // 縦一列をチェック
    let rule_y (m:int[,]) x y v =
        [|for i in 0..size-1 -> m.[i,x]|] |> Array.exists (fun t -> t = v)
    // boxをチェック
    let rule_box (m:int[,]) x y v = 
        let x' = x/bsize*bsize
        let y' = y/bsize*bsize
        [| for i in 0..bsize-1 do
            for j in 0..bsize-1 -> m.[y'+j,x'+i] |] |> Array.exists (fun t -> t = v)

    if v = 0 then 
        []
    elif rule_x m x y v = false &&
        rule_y m x y v = false &&
        rule_box m x y v = false then
        v::rule m x y (v-1) lst
    else
        rule m x y (v-1) lst

// ランダムに1つ選ぶ
let rnd = new Random()

let rec remove i (l:'a list) =
     match i,l with
     | 0, x::xs -> xs
     | i, x::xs -> x::remove (i-1) xs
     | i, [] -> failwith "index out of range"

let rec shaffle (l:'a list) =
    match l with
    | x::[] -> [x]
    | x::xs -> 
        let i = rnd.Next(l.Length)
        let l' = remove i l
        l.[i]::shaffle l'
    | [] -> []

let rec quest (m:int[,]) x y =
    // printfn "%d %d" x y
    // printfn "%A" m
    if x = 9 && y = 8 then
        // 完成
        printfn "success."
        printfn "%A" m
        raise (new Exception("ok"))
    elif x = 9 then
        quest m 0 (y+1) 
    else
        let lst = rule m x y size []
        if lst.Length > 0 then
            let lst' = shaffle lst
            for i in 0..lst'.Length-1 do
                let v = lst'.[i]
                let m' = Array2D.copy m
                m'.[y,x] <- v
                quest m' (x+1) y 
        
let Quest (m:int&#91;,&#93;) =
    try 
        quest m 0 0
    with
        | _ -> printfn "ok."

// 数字の敷き詰めを作成
Quest pazzle

ごちゃごちゃしていますが、1番の数の敷き詰めを作っているところです。左上から順番に番号をいれて、ルールに沿って（縦/横/ボックス）候補の数を配置しています。配置するときにランダムに数値を選ばせるために、shaffle を使っています。単純に数え上げのところは、この部分はいらないのですが、それだと同じ問題になってしまうし。
3×3の場合には、結構なスピードで敷き詰めができあがります…が、4×4にすると途端に遅くなりますね。1分程度で終わる場合もあれば、30分やってやっと終わる場合もあります。このあたり、最適化の山を登っている感じ。達成しない準最適化の山に登ってしまうと一度降りるのに時間がかかります。将棋の枝切りとかこのあたりのロジックなのかも。そうそう、やねうらおさんの「探索の深さが強さのイコールとはならない」というのは、このあたりの話で、完全に探索ができない場合には「探索自体の深さ」は「強さ」＝正解そのものとは違っていて、さらに将棋の指し手が極めて少ない（２，３手とか）のであれば、その探索の深さ（指し手の多さ）は、強さに比例しない…だろう、ってことだと思います。まあ、実装できるのがすごいんですが。なんとなく想像で。

一旦敷き詰めができた配列をコピーして、今度は問題を作っていきます。 

let ans' = 
    [[7; 3; 1; 2; 6; 4; 9; 8; 5]
     [9; 4; 2; 5; 3; 8; 7; 6; 1]
     [8; 6; 5; 7; 1; 9; 3; 2; 4]
     [2; 7; 9; 8; 5; 3; 4; 1; 6]
     [6; 5; 4; 9; 7; 1; 8; 3; 2]
     [1; 8; 3; 6; 4; 2; 5; 7; 9]
     [5; 2; 8; 3; 9; 6; 1; 4; 7]
     [4; 9; 6; 1; 8; 7; 2; 5; 3]
     [3; 1; 7; 4; 2; 5; 6; 9; 8]]
let A' = Array2D.init 9 9 (fun i j -> ans'.[i].[j])

let mutable scnt = 0

let rec solve (m:int[,]) x y = 
    // printfn "%d %d" x y
    if x = 9 && y = 8 then
        // 完成
        scnt <- scnt + 1
    elif x = 9 then
        solve m 0 (y+1)
    elif m.&#91;x,y&#93; <> 0 then
        solve m (x+1) y 
    else 
        // 縦/横/boxをチェック
        let mutable v = [|0..9|]
        for i in 0..8 do v.[m.[i,y]] <- 0
        for i in 0..8 do v.&#91;m.&#91;x,i&#93;&#93; <- 0
        let x0 = x/3*3
        let y0 = y/3*3
        for i in 0..2 do
            for j in 0..2 do
                v.&#91;m.&#91;x0+i,y0+j&#93;&#93; <- 0

        let m' = Array2D.copy m
        for i in 0..9 do
            if v.&#91;i&#93; <> 0 then
                m'.[x,y] <- v.&#91;i&#93;
                solve m' (x+1) y

let make_pazzle (A0:int&#91;,&#93;) =
    let A = Array2D.copy A0 
    
    // (x,y)をランダムに決める
    let slst = 
        shaffle &#91;for y in 0..size-1 do
                    for x in 0..size-1 -> (x,y) ]
    // 一つずつ取り出して、解法が2以上になった時にやめる
    for i in 0..size2-1 do
        printfn "%d" i
        printfn "%A" A'
        let A' = Array2D.copy A
        let (x,y) = slst.[i]

        A.[x,y] <- 0
        scnt <- 0
        solve A 0 0 
        if scnt > 1 then
            printfn "%A" A'
            raise (new Exception("ok"))

make_pazzle A'

問題の手順も簡単で、ランダムに1個空白（0にする）して、それをいちいち解いていきます。このとき、解法が2つ以上あれば、そこでストップしているだけです。これも非常に（コンピュータにとって）手間がかかる方法なのですが、なんか他に思いつかなかったので、これで。
空白にするコマをランダムに決めてしまうので、いわゆる数独の難しさを考慮していません。なので、これも低い最適化の山に登ってしまうと、途端につまらない≒空白の数の少ない問題を作成してしまいます。このあたりは、一定量の空白になるまで問題作成を繰り返せばいいんでしょうが、それだといつまでやっても終わらないって感じになりそうです。これも適当な足切りが必要でしょうね。

同じものをC#で書いたらどうなるんだろう？という疑問もありますが、このぐらいだと多分似た感じで書けそうです。
F#で書いてみてわかったんですが、配列を

F(x+1) = F(x) + a

の問題で書き直すとうまくいきます…つーか、逆な話で、この形の数式が出てくる場合は F# の再帰関数を使うと便利なわけです。実はこの形って、フィードバックそのもなので、F(1)の結果がF(2)に影響して、さらにF(2)の結果がF(3)に影響して、最終的にF(n)に影響する≒結果が出る、というパターンですね。F(F(F(F(…)))) な感じ。これを再帰の終端が、N から始まって 0 にして終わるのが F# の再帰関数のコツ（F#に限らないけど）、通常の for ループの場合は、0 から始まって max で終わるけど、再帰関数の場合は max を渡してやって減算していって 0 の時に終了、ってやるとうまくいきます…ってのは何処かにあるだろうか。

たとえば、フィボナッチ数列は 

let rec fibo n =
    match n with
    | 0 -> 1
    | 1 -> 1
    | x -> fibo(x-1) + fibo(x-2) 

let fibonacci n =
    for i in 0..n do
        let ans = fibo i
        printf "%d," ans

fibonacci 20

とできるわけで、計算量はさておき、数式のシンプルさをそのまま表せるのが便利ですよね。

カテゴリー: F# パーマリンク