X-Git-Url: http://git.euphorik.ch/?p=sudokuSolver.git;a=blobdiff_plain;f=SudokuSolver%2FVersion1.fs;fp=SudokuSolver%2FVersion1.fs;h=86f50d0ebb5e3bb0a42a9f0a2be441eb17828adb;hp=f0216ada32bf8da17aa6bc58ff7ee1b67d1b2cd7;hb=0434576455bb0eb8b7593c892d69fe0cf63a6b20;hpb=93c2731de053d0698800eb8a7ba1a475a38e58cc diff --git a/SudokuSolver/Version1.fs b/SudokuSolver/Version1.fs index f0216ad..86f50d0 100644 --- a/SudokuSolver/Version1.fs +++ b/SudokuSolver/Version1.fs @@ -1,99 +1,100 @@ module SudokuSolver.Version1 open System +open System.Threading open System.IO open System.Collections.Generic -let printUsage progname = +let printUsage progname = printfn "Usage: %A " 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 = +[] +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) = - 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 @@ -102,18 +103,18 @@ type Board (values : seq) = // 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 @@ -121,31 +122,54 @@ type Board (values : seq) = 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 = + 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