[WIP] Sudoku solver

test/sudoku.fs

@@ -0,0 +1,94 @@
+module sudoku
+
+open System.Collections.Generic
+
+type Box = int
+type Sudoku = Box array array
+
+let rows = id
+let cols (sudoku:Sudoku) =
+    sudoku
+    |> Array.mapi (fun a row -> row |> Array.mapi (fun b cell -> sudoku.[b].[a]))
+
+let getBoxIndex count row col = 
+   let n = row/count
+   let m = col/count
+   n * count + m
+
+let boxes (sudoku:Sudoku) = 
+    let d = sudoku |> Array.length |> float |> System.Math.Sqrt |> int
+    let list = new List<_>()
+    for a in 0..(d*d) - 1 do list.Add(new List<_>())
+
+    for a in 0..(Array.length sudoku - 1) do
+        for b in 0..(Array.length sudoku - 1) do
+            list.[getBoxIndex d a b].Add(sudoku.[a].[b])
+
+    list 
+      |> Seq.map Seq.toArray
+
+let toSudoku x : Sudoku = 
+    x
+    |> Seq.map Seq.toArray
+    |> Seq.toArray
+
+let allUnique numbers =
+    let set = new HashSet<_>()
+    numbers
+    |> Seq.filter ((<>) 0)
+    |> Seq.forall set.Add
+
+let solvable sudoku =
+    rows sudoku
+    |> Seq.append (cols sudoku)
+    |> Seq.append (boxes sudoku)
+    |> Seq.forall allUnique
+
+let replaceAtPos (x:Sudoku) row col newValue :Sudoku =     
+    [| for a in 0..(Array.length x - 1) ->
+        [| for b in 0..(Array.length x - 1) -> 
+            if a = row && b = col then newValue else x.[a].[b] |] |]
+
+let rec substitute row col (x:Sudoku) = 
+    let a,b = if col >= Array.length x then row+1,0 else row,col
+    if a >= Array.length x then seq { yield x } else
+    if x.[a].[b] = 0 then 
+        [1..Array.length x]           
+            |> Seq.map (replaceAtPos x a b)  
+            |> Seq.filter solvable                     
+            |> Seq.map (substitute a (b+1))
+            |> Seq.concat
+     else substitute a (b+1) x
+
+let getFirstSolution = substitute 0 0 >> Seq.head
+
+let solve sudoku =
+    let start = System.DateTime.Now
+    let solution = getFirstSolution sudoku
+
+    printfn "%As" <| System.Math.Round((System.DateTime.Now - start).TotalSeconds,2)
+    printfn "%A" solution
+
+let s1 =
+    [[1; 2; 3; 4]
+     [0; 4; 1; 2]
+     [0; 3; 0; 0]
+     [2; 0; 0; 0]]
+      |> toSudoku
+
+let s2 =
+    [[0; 0; 8;  3; 0; 0;  6; 0; 0]
+     [0; 0; 4;  0; 0; 0;  0; 1; 0]
+     [6; 7; 0;  0; 8; 0;  0; 0; 0]
+
+     [0; 1; 6;  4; 3; 0;  0; 0; 0]
+     [0; 0; 0;  7; 9; 0;  0; 2; 0]
+     [0; 9; 0;  0; 0; 0;  4; 0; 1]
+
+     [0; 0; 0;  9; 1; 0;  0; 0; 5]
+     [0; 0; 3;  0; 5; 0;  0; 0; 2]
+     [0; 5; 0;  0; 0; 0;  0; 7; 4]]
+      |> toSudoku
+
+
+solve s2

test/test.fsproj

@@ -8,6 +8,7 @@
     <Compile Include="Aether.fs" />
     <Compile Include="aether_test.fs" />
     <Compile Include="wip.fs" />
+    <Compile Include="sudoku.fs" />
     <Compile Include="basics.fs" />
     <Compile Include="demo.fs" />
   </ItemGroup>