let flatten (array2d: 'a[,]) = array2d |> Array2D.mapi (fun i j value -> (i, j, value)) |> Seq.cast<int*int*'a> |> Seq.toList
let toLists array2d = List.init (Array2D.length1 array2d) (fun row -> List.init (Array2D.length2 array2d) (fun col -> array2d.[row, col]))

type Cell = {Number : int; PossibleNumbers : int list}
let newCell = {Number = 0; PossibleNumbers = [1..9]}
let setNumber number cell = {cell with Number = number; PossibleNumbers = List<int>.Empty}
let removePossible number cell = {cell with PossibleNumbers = cell.PossibleNumbers |> List.filter (fun x -> x <> number)}

type Board = {Cells : Cell[,]}
let newBoard = { Cells = Array2D.init<Cell> 9 9 (fun _ _ -> newCell) }

let getAdjacentCells i j =
    let rowIter = List.init 9 (fun index -> (i, index)) |> List.filter (fun tuple -> snd tuple <> j)
    let colIter = List.init 9 (fun index -> (index, j)) |> List.filter (fun tuple -> fst tuple <> i)
    let topLeft = (i-i%3, j-j%3)
    let sqrIter = List.init 9 (fun index -> (fst topLeft + index/3, snd topLeft + index%3))|> List.filter (fun tuple -> fst tuple <> i || snd tuple <> j)
    Seq.distinct(rowIter @ colIter @ sqrIter) |> Seq.toList

let setCell i j value board =
    let adjCells = getAdjacentCells i j
    let newArray = board.Cells |> Array2D.mapi (fun row col cell ->
        match (row, col, value) with
        | a, b, v when v <> 0 && a = i && b = j -> cell |> setNumber v
        | a, b, v when v <> 0 && adjCells |> List.contains (a, b) -> cell |> removePossible v
        | _, _, _ -> cell)
    {board with Cells = newArray}

let rec setBoard values board =
    match values with
        | [] -> board
        | (i, j, value)::tail -> setBoard tail (setCell i j value board)

let printBoard board = board.Cells |> toLists |> List.iter (fun row -> row |> List.iter (fun cell -> printf "%i " cell.Number); printfn "")

let solveSudoku board =
    let getUnknownCells board = Array2D.zeroCreate 9 9 |> flatten |> List.filter (fun (i, j, _) -> board.Cells.[i, j].Number = 0)
    let rec fillSudoku boardList board =
        let cellsWithPossible = board |> getUnknownCells |> List.map (fun (i, j, _) -> (i, j, board.Cells.[i, j].PossibleNumbers))
        match cellsWithPossible with
        | [(i, j, list)] -> boardList @ (list |> List.map (fun opt -> setCell i j opt board))
        | (i, j, list)::_ -> boardList @ (list |> List.map (fun opt -> fillSudoku boardList (setCell i j opt board)) |> List.concat)
        | [] -> boardList
    let possibleSolutions = (fillSudoku [] board) |> List.tryFind (fun board -> board |> getUnknownCells |> List.length = 0)
    match possibleSolutions with
    | None -> printfn "No solution"
    | Some(b) -> (printfn "Solved"; printBoard b)

[<EntryPoint>]
let main _ =
    let start = array2D [
                    [|0; 0; 7; 8; 6; 1; 0; 5; 0|];
                    [|0; 1; 8; 4; 5; 3; 0; 0; 0|];
                    [|5; 6; 0; 7; 9; 2; 8; 1; 0|];
                    [|1; 0; 0; 0; 7; 6; 3; 8; 5|];
                    [|0; 0; 0; 3; 4; 5; 0; 0; 1|];
                    [|6; 3; 5; 0; 1; 8; 0; 0; 7|];
                    [|0; 5; 0; 1; 2; 4; 0; 9; 8|];
                    [|0; 0; 1; 6; 8; 9; 5; 0; 0|];
                    [|0; 0; 0; 5; 3; 7; 1; 0; 0|]
                ]
    let board = newBoard |> setBoard (flatten start)
    printBoard board
    let stopWatch = System.Diagnostics.Stopwatch.StartNew()
    solveSudoku board
    stopWatch.Stop()
    printfn "Elapsed time: %f ms" stopWatch.Elapsed.TotalMilliseconds
    0