module SudokuSolver.Version1
open System
+open System.Threading
open System.IO
open System.Collections.Generic
-let printUsage progname =
+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 =
+[<Struct>]
+type Pos (i: int, j: int) =
+ member this.I = i
+ member this.J = j
+ member this.Next : Pos option =
+ match this.I, this.J with
+ | 8, 8 -> None
+ | _, 8 -> Some (Pos(this.I + 1, 0))
+ | _ -> Some (Pos(this.I, this.J + 1))
+ override this.ToString() =
+ sprintf "Pos(i = %i, j = %i)" this.I this.J
+
+let zoneRange c =
match c with
- | 0 | 1 | 2 -> [0 .. 2]
- | 3 | 4 | 5 -> [3 .. 5]
- | _ -> [6 .. 8]
+ | 0 | 1 | 2 -> [ 0 .. 2 ]
+ | 3 | 4 | 5 -> [ 3 .. 5 ]
+ | _ -> [ 6 .. 8 ]
// All possible positions.
-let AllPos = seq {
+let allPos = [
for i in 0 .. 8 do
- for j in 0 .. 8 -> { i = i; j = j } }
+ for j in 0 .. 8 -> Pos(i, j) ]
+
+let size = 9
-type Board (values : seq<int>) =
- let size = 9
+type Board (values: int [,]) =
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)
+ Array2D.blit values 0 0 board 0 0 size size
- let get pos = board.[pos.i, pos.j]
- let set pos value = board.[pos.i, pos.j] <- value
+ let get (pos: Pos) = board.[pos.I, pos.J]
+ let set (pos: Pos) (value: int) = board.[pos.I, pos.J] <- value
- let rec nextFree (pos : Pos) : Pos option =
+ 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 isValid (pos: Pos) (n: int) =
+ List.forall (fun j -> if j = pos.J then true else get (Pos(pos.I, j)) <> n) [ 0 .. 8 ] &&
+ List.forall (fun i -> if i = pos.I then true else get (Pos(i, pos.J)) <> n) [ 0 .. 8 ] &&
+ List.forall (fun (i, j) -> if i = pos.I && j = pos.J then true else get (Pos(i, 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 validNumbers pos = seq {
+ let valid = isValid pos
+ for n in 1 .. 9 do
+ if valid n then yield n }
- let show (output : TextWriter) =
+ 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 '.'
+ 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 ()
+ output.WriteLine()
if (i + 1) % 3 = 0 && i <> size - 1 then
- output.WriteLine "-----------"
-
+ output.WriteLine "-----------"
let presolve () =
let (|OnlyOneNumber|_|) (pos : Pos) =
- if get pos <> 0
- then None
+ 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
+ let mutable nb = 0
+ let add n =
+ if not numbers.[n] then
numbers.[n] <- true
- nb := !nb + 1
+ 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
+ for i in 0 .. 8 do get (Pos(i, pos.J)) |> add
+ for j in 0 .. 8 do get (Pos(pos.I, j)) |> add
+ for i in zoneRange pos.I do
+ for j in zoneRange pos.J do
+ get (Pos(i, j)) |> add
- match !nb with
- | 9 -> try Some (Array.findIndex not numbers) with _ -> None
+ match nb with
+ | 9 -> Array.tryFindIndex not numbers
| 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 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
// 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
+ let pos' = Pos(i, pos.J)
+ 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
+ let pos' = Pos(pos.I, 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 }
+ for i in zoneRange pos.I do
+ for j in zoneRange pos.J do
+ let pos' = Pos(i, j)
if pos' <> pos && get pos' = 0
then yield not (isValid pos' n) } |> Seq.forall id
then Some n
findNumber remainingNumbers
- while Seq.exists (fun pos ->
+ while allPos |> List.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)
+ | _ -> false) do ()
+
+ new (input: TextReader) =
+ let matrix = Array2D.create size size 0
+ [ while input.Peek () <> -1 do
+ match char (input.Read()) with
+ | ' ' | '.' | '0' -> yield 0
+ | a when Char.IsDigit a -> yield int (Char.GetNumericValue a)
+ | _ -> () ]
+ |> List.take (size * size)
+ |> List.zip allPos
+ |> List.iter(fun (pos, value) -> matrix.[pos.I, pos.J] <- value)
+ Board(matrix)
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
+
+ member this.Values : int [,] =
+ Array2D.copy board
+
+ member this.SolveAsync (token: CancellationToken) : Async<bool> =
+ async {
+ let rec solveFrom pos : bool = // Returns true if the solution is valid and complete.
+ if token.IsCancellationRequested then
+ false
+ else
+ match nextFree pos with
+ | Some pos' ->
+ if validNumbers pos' |> Seq.exists (fun n -> set pos' n; solveFrom pos') then
+ true
+ else
+ set pos' 0
+ false
+ | _ -> true
+ let valid =
+ allPos |> List.forall (
+ fun p ->
+ let n = get p
+ if n = 0 then true else isValid p n)
+ return
+ if not valid then
false
- | _ -> true
- presolve ()
- solveFrom { i = 0; j = -1 }
+ else
+ presolve ()
+ solveFrom (Pos(0, -1)) }
+ member this.Solve () : bool =
+ let cancellation = new CancellationTokenSource()
+ this.SolveAsync(cancellation.Token) |> Async.RunSynchronously
\ No newline at end of file
projects / sudokuSolver.git / blobdiff