Add a GUI. Use FAKE to manage the build and paket for dependencies.
[sudokuSolver.git] / SudokuSolver / Version1.fs
1 module SudokuSolver.Version1
2
3 open System
4 open System.Threading
5 open System.IO
6 open System.Collections.Generic
7
8 let printUsage progname =
9 printfn "Usage: %A <filename>" progname
10
11 [<Struct>]
12 type Pos (i: int, j: int) =
13 member this.I = i
14 member this.J = j
15 member this.Next : Pos option =
16 match this.I, this.J with
17 | 8, 8 -> None
18 | _, 8 -> Some (Pos(this.I + 1, 0))
19 | _ -> Some (Pos(this.I, this.J + 1))
20 override this.ToString() =
21 sprintf "Pos(i = %i, j = %i)" this.I this.J
22
23 let zoneRange c =
24 match c with
25 | 0 | 1 | 2 -> [ 0 .. 2 ]
26 | 3 | 4 | 5 -> [ 3 .. 5 ]
27 | _ -> [ 6 .. 8 ]
28
29 // All possible positions.
30 let allPos = [
31 for i in 0 .. 8 do
32 for j in 0 .. 8 -> Pos(i, j) ]
33
34 let size = 9
35
36 type Board (values: int [,]) =
37 let board = Array2D.create size size 0
38
39 do
40 Array2D.blit values 0 0 board 0 0 size size
41
42 let get (pos: Pos) = board.[pos.I, pos.J]
43 let set (pos: Pos) (value: int) = board.[pos.I, pos.J] <- value
44
45 let rec nextFree (pos: Pos) : Pos option =
46 match pos.Next with
47 | Some pos -> if get pos = 0 then Some pos else nextFree pos
48 | _ -> None
49
50 let isValid (pos: Pos) (n: int) =
51 List.forall (fun j -> if j = pos.J then true else get (Pos(pos.I, j)) <> n) [ 0 .. 8 ] &&
52 List.forall (fun i -> if i = pos.I then true else get (Pos(i, pos.J)) <> n) [ 0 .. 8 ] &&
53 List.forall (fun (i, j) -> if i = pos.I && j = pos.J then true else get (Pos(i, j)) <> n) [
54 for i' in zoneRange pos.I do
55 for j' in zoneRange pos.J -> i', j' ]
56
57 let validNumbers pos = seq {
58 let valid = isValid pos
59 for n in 1 .. 9 do
60 if valid n then yield n }
61
62 let show (output: TextWriter) =
63 for i in 0 .. size - 1 do
64 for j in 0 .. size - 1 do
65 if board.[i, j] = 0 then output.Write '.'
66 else output.Write board.[i, j]
67 if (j + 1) % 3 = 0 && j <> size - 1 then
68 output.Write '|'
69 output.WriteLine()
70 if (i + 1) % 3 = 0 && i <> size - 1 then
71 output.WriteLine "-----------"
72
73 let presolve () =
74 let (|OnlyOneNumber|_|) (pos : Pos) =
75 if get pos <> 0 then
76 None
77 else
78 let numbers = Array.create 10 false
79 let mutable nb = 0
80 let add n =
81 if not numbers.[n] then
82 numbers.[n] <- true
83 nb <- nb + 1
84
85 for i in 0 .. 8 do get (Pos(i, pos.J)) |> add
86 for j in 0 .. 8 do get (Pos(pos.I, j)) |> add
87 for i in zoneRange pos.I do
88 for j in zoneRange pos.J do
89 get (Pos(i, j)) |> add
90
91 match nb with
92 | 9 -> Array.tryFindIndex not numbers
93 | 10 -> None
94 | _ ->
95 // For all remaining numbers.
96 let remainingNumbers = Array.mapi(fun i p -> i, p) numbers
97 |> Array.fold(fun acc (i, p) -> if not p then i :: acc else acc) []
98
99 let rec findNumber numbers =
100 match numbers with
101 | [] -> None
102 | n :: tail ->
103 // If there is no other valid position, then the current is the only one.
104 if seq {
105 for i in 0 .. 8 do
106 let pos' = Pos(i, pos.J)
107 if i <> pos.I && get pos' = 0
108 then yield not (isValid pos' n) } |> Seq.forall id ||
109 seq {
110 for j in 0 .. 8 do
111 let pos' = Pos(pos.I, j)
112 if j <> pos.J && get pos' = 0
113 then yield not (isValid pos' n) } |> Seq.forall id ||
114 seq {
115 for i in zoneRange pos.I do
116 for j in zoneRange pos.J do
117 let pos' = Pos(i, j)
118 if pos' <> pos && get pos' = 0
119 then yield not (isValid pos' n) } |> Seq.forall id
120 then Some n
121 else findNumber tail
122
123 findNumber remainingNumbers
124
125 while allPos |> List.exists (fun pos ->
126 match pos with
127 | OnlyOneNumber n -> set pos n; true
128 | _ -> false) do ()
129
130 new (input: TextReader) =
131 let matrix = Array2D.create size size 0
132 [ while input.Peek () <> -1 do
133 match char (input.Read()) with
134 | ' ' | '.' | '0' -> yield 0
135 | a when Char.IsDigit a -> yield int (Char.GetNumericValue a)
136 | _ -> () ]
137 |> List.take (size * size)
138 |> List.zip allPos
139 |> List.iter(fun (pos, value) -> matrix.[pos.I, pos.J] <- value)
140 Board(matrix)
141
142 member this.Show = show
143
144 member this.Values : int [,] =
145 Array2D.copy board
146
147 member this.SolveAsync (token: CancellationToken) : Async<bool> =
148 async {
149 let rec solveFrom pos : bool = // Returns true if the solution is valid and complete.
150 if token.IsCancellationRequested then
151 false
152 else
153 match nextFree pos with
154 | Some pos' ->
155 if validNumbers pos' |> Seq.exists (fun n -> set pos' n; solveFrom pos') then
156 true
157 else
158 set pos' 0
159 false
160 | _ -> true
161 let valid =
162 allPos |> List.forall (
163 fun p ->
164 let n = get p
165 if n = 0 then true else isValid p n)
166 return
167 if not valid then
168 false
169 else
170 presolve ()
171 solveFrom (Pos(0, -1)) }
172
173 member this.Solve () : bool =
174 let cancellation = new CancellationTokenSource()
175 this.SolveAsync(cancellation.Token) |> Async.RunSynchronously