Задача о восьми ферзях

open System
 
let [<Literal>] N = 8
 
let solve() = 
    let q = Array.create N 0
    let rec succ h = function
        | -1 -> true
        | x when q.[x] = q.[h] || abs(q.[x] - q.[h]) = abs(x - h) -> false
        | x  -> succ h (x - 1)
    let acc = ref []
    let rec back x y = 
        match x , y with
        | N, N  -> ()
        | N , _ -> if succ (N - 1) (N - 2) 
                   then acc := Array.map id q :: !acc 
                   //else ()
        | -1, _ -> ()
        | _ , N -> q.[x] <- 0 
        | x , y -> q.[x] <- y
                   if succ x (x - 1)
                   then back (x + 1) 0 
                        back x (y + 1) 
                   else back (x) (y + 1) 
    back 0 0
    !acc
 
let rec gen list n = 
    if n=8 then[list] else
        let n'=n+1
        [0..7] |> List.filter (fun c -> 
            let rec chk lst l r = 
                let l',r'=l-1,r+1
                match lst with
                | [] -> true
                | x::_ when x=c || x=l' || x=r' -> false 
                | _::t -> chk t l' r'
            chk list c c)
        |> List.map (fun i -> gen (i::list) n') |> List.concat
 
let solve1 () = gen [] 0
 
let show res =
    for b in res do
        for e in b do
            String.replicate e ". " + "W " + String.replicate (7 - e) ". "
            |> printfn "%s"
    printfn ""
 
let bench f =
    let stopWatch = System.Diagnostics.Stopwatch.StartNew()
    show (f ()) 
    stopWatch.Stop()
    stopWatch.Elapsed.TotalMilliseconds
 
let rec benchTest cnt t0 t1 =
    if cnt=100 then (t0,t1) 
    else let t0n=t0 + bench solve
         let t1n=t1 + bench solve1
         benchTest (cnt+1) t0n t1n
 
let res0,res1=benchTest 0 0.0 0.0
printfn "pycture        :  %f mS" res0
printfn "KolodeznyDiver :  %f mS" res1

let solveArr () = 
    let rec gen (brd : int []) cs n = 
        if n=8 then [brd] else
            let nn=n+1
            cs |> List.filter (fun c -> 
                let rec chk y l r = 
                    if y=0 then true else
                        let yn=y-1                            
                        let x=brd.[yn]
                        let ln=l-1
                        if x=ln then false else
                            let rn=r+1
                            if x=rn then false else chk yn ln rn
                chk n c c)
            |> List.map (fun c -> gen (Array.concat [brd;[|c|]]) 
                                    (List.filter(fun i -> i <> c) cs) nn)
            |> List.concat
    gen Array.empty [0..7] 0

let getX brd y = (brd >>> (y*3)) &&& 7
let setX brd y x = brd ||| (x <<< (y*3))
 
type ChessBoardEnumerator (v: int) = 
        let mutable i = -1
        interface IEnumerator<int> with
            member x.Current = getX v i
        interface System.Collections.IEnumerator with
            member x.Current = box (getX v i)
            member x.MoveNext() = if i=7 then false else (i <- i + 1; true)
            member x.Reset() = i <- -1
        interface System.IDisposable with
            member x.Dispose() = () 
 
type ChessBoard (v: int) =
    interface IEnumerable<int> with
        member this.GetEnumerator() = (new ChessBoardEnumerator(v) :> IEnumerator<int>)
    interface System.Collections.IEnumerable with
        member this.GetEnumerator() = (new ChessBoardEnumerator(v) :> System.Collections.IEnumerator)
 
let solveBits () = 
    let rec gen brd cs n = 
        if n=8 then [brd] else
            let nn=n+1
            cs |> List.filter (fun c -> 
                let rec chk y l r = 
                    if y=0 then true else
                        let yn=y-1                            
                        let x=getX brd yn
                        let ln=l-1
                        if x=ln then false else
                            let rn=r+1
                            if x=rn then false else chk yn ln rn
                chk n c c)
            |> List.map (fun c -> gen (setX brd n c) 
                                    (List.filter(fun i -> i <> c) cs) nn)
            |> List.concat
    gen 0 [0..7] 0 |> List.map (fun b -> new ChessBoard(b))