1
module SudokuSolver.Version1
6 open System.Collections.Generic
8 let printUsage progname
=
9 printfn
"Usage: %A <filename>" progname
12 type Pos (i
: int, j
: int) =
15 member this
.Next : Pos option =
16 match this
.I, this
.J with
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
25 | 0 | 1 | 2 -> [ 0 .. 2 ]
26 | 3 | 4 | 5 -> [ 3 .. 5 ]
29 // All possible positions.
32 for j
in 0 .. 8 -> Pos(i
, j
) ]
36 type Board (values
: int [,]) =
37 let board = Array2D.create
size size 0
40 Array2D.blit
values 0 0 board 0 0 size size
42 let get (pos
: Pos) = board.[pos
.I, pos
.J]
43 let set (pos
: Pos) (value
: int) = board.[pos
.I, pos
.J] <- value
45 let rec nextFree
(pos
: Pos) : Pos option =
47 | Some pos
-> if get pos = 0 then Some pos else nextFree pos
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' ]
57 let validNumbers pos = seq
{
58 let valid = isValid pos
60 if valid n
then yield n
}
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
70 if (i
+ 1) % 3 = 0 && i
<> size - 1 then
71 output.WriteLine "-----------"
74 let (|OnlyOneNumber|_|) (pos : Pos) =
78 let numbers = Array.create
10 false
81 if not
numbers.[n
] then
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
92 | 9 -> Array.tryFindIndex not
numbers
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) []
99 let rec findNumber
numbers =
103 // If there is no other valid position, then the current is the only one.
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 ||
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 ||
115 for i
in zoneRange pos.I do
116 for j
in zoneRange pos.J do
118 if pos' <> pos && get pos' = 0
119 then yield not (isValid pos' n) } |> Seq.forall
id
123 findNumber remainingNumbers
125 while allPos |> List.exists
(fun pos ->
127 | OnlyOneNumber n -> set pos n; true
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)
137 |> List.take
(size * size)
139 |> List.iter
(fun (pos, value
) -> matrix.[pos.I, pos.J] <- value
)
142 member this.Show = show
144 member this.Values : int [,] =
147 member this.SolveAsync (token
: CancellationToken) : Async<bool> =
149 let rec solveFrom
pos : bool = // Returns true if the solution is valid and complete.
150 if token
.IsCancellationRequested then
153 match nextFree pos with
155 if validNumbers pos' |> Seq.exists
(fun n -> set pos' n; solveFrom pos') then
162 allPos |> List.forall (
165 if n = 0 then true else isValid p n)
171 solveFrom (Pos(0, -1)) }
173 member this.Solve () : bool =
174 let cancellation = new CancellationTokenSource()
175 this.SolveAsync(cancellation.Token) |> Async.RunSynchronously