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