module SudokuSolver.Version1

open System
open System.IO
open System.Collections.Generic

let printUsage progname = 
    printfn "Usage: %A <filename>" progname

type Pos = 
    { i: int; j: int }
    member this.Next : Pos option = 
        match this with
        | { i = 8; j = 8 } -> None
        | { i = i; j = 8 } -> Some { i = i + 1; j = 0 }
        | { i = _; j = j } -> Some { this with j = j + 1 }

let zoneRange c = 
    match c with
    | 0 | 1 | 2 -> [0 .. 2]
    | 3 | 4 | 5 -> [3 .. 5]
    | _ -> [6 .. 8]

// All possible positions.
let AllPos = seq {
    for i in 0 .. 8 do
       for j in 0 .. 8 -> { i = i; j = j } }

type Board (values : seq<int>) =
    let size = 9
    let board = Array2D.create size size 0

    do
        Seq.take (size * size) values |> Seq.zip AllPos |> Seq.iter (fun ({ i = iVal; j = jVal}, value) -> 
            board.[iVal, jVal] <- value)

    let get pos = board.[pos.i, pos.j]
    let set pos value = board.[pos.i, pos.j] <- value

    let rec nextFree (pos : Pos) : Pos option =
        match pos.Next with
        | Some pos -> if get pos = 0 then Some pos else nextFree pos
        | _ -> None

    let isValid pos n =
        List.forall (fun j -> get { pos with j = j } <> n) [0 .. 8] && 
        List.forall (fun i -> get { pos with i = i } <> n) [0 .. 8] &&
        List.forall (fun (i, j) -> get { i = i; j = j } <> n) [ 
            for i' in zoneRange pos.i do
                for j' in zoneRange pos.j -> i', j' ]

    let validNumbers pos =
        [
            let valid = isValid pos
            for n in 1 .. 9 do
                if valid n then yield n ]

    let show (output : TextWriter) =
        for i in 0 .. size - 1 do
            for j in 0 .. size - 1 do
                if board.[i, j] = 0
                then output.Write '.' 
                else output.Write board.[i, j]
                if (j + 1) % 3 = 0 && j <> size - 1 then
                    output.Write '|'
            output.WriteLine ()
            if (i + 1) % 3 = 0 && i <> size - 1 then
                output.WriteLine "-----------"         


    let presolve () =
        let (|OnlyOneNumber|_|) (pos : Pos) =
            if get pos <> 0
            then None
            else
                let numbers = Array.create 10 false
                let nb = ref 0
                let add n = 
                    if not numbers.[n]
                    then
                        numbers.[n] <- true
                        nb := !nb + 1

                for i in 0 .. 8 do get { pos with i = i } |> add
                for j in 0 .. 8 do get { pos with j = j } |> add
                for i in zoneRange pos.i do
                    for j in zoneRange pos.j do
                        get { i = i; j = j } |> add

                match !nb with
                | 9 -> try Some (Array.findIndex not numbers) with _ -> None
                | 10 -> None
                | _ ->
                    // For all remaining numbers.
                    let remainingNumbers = Array.mapi (fun i p -> i, p) numbers 
                                            |> Array.fold (fun acc (i, p) -> if not p then i :: acc else acc) []

                    let rec findNumber numbers =
                        match numbers with
                        | [] -> None
                        | n :: tail ->
                            // If there is no other valid position, then the current is the only one.
                            if seq {
                                    for i in 0 .. 8 do
                                        let pos' = { pos with i = i }
                                        if i <> pos.i && get pos' = 0
                                        then yield not (isValid pos' n) } |> Seq.forall id ||
                               seq {
                                    for j in 0 .. 8 do
                                        let pos' = { pos with j = j }
                                        if j <> pos.j && get pos' = 0
                                        then yield not (isValid pos' n) } |> Seq.forall id ||
                               seq {
                                    for i in zoneRange pos.i do
                                        for j in zoneRange pos.j do
                                            let pos' = { i = i; j = j }
                                            if pos' <> pos && get pos' = 0
                                            then yield not (isValid pos' n) } |> Seq.forall id
                            then Some n
                            else findNumber tail

                    findNumber remainingNumbers

        while Seq.exists (fun pos -> 
            match pos with
            | OnlyOneNumber n -> set pos n; true
            | _ -> false) AllPos do ()

    new (input : TextReader) =
        Board (seq {
            while input.Peek () <> -1 do
                match char (input.Read ()) with
                | ' ' | '.' | '0' -> yield 0
                | a when Char.IsDigit a -> yield int (Char.GetNumericValue a)
                | _ -> () } |> Seq.take 81)

    member this.Show = show
    
    member this.Solve () =
        let rec solveFrom pos : bool = // Returns true if the solution is valid and complete.
            match nextFree pos with
            | Some pos' -> 
                if List.exists (fun n -> set pos' n; solveFrom pos') (validNumbers pos')
                then true
                else 
                    set pos' 0
                    false
            | _ -> true
        presolve ()
        solveFrom { i = 0; j = -1 }