0 people like it.
Like the snippet!
Sudoku with general solve function
Using the general solve function to solve Sudoku. The puzzle specific code was translated from Norvig's Sudoku code, but any errors are mine. Reuses code from fssnip.net/6m and fssnip.net/6n
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
|
let solve next_f done_f initial =
let rec go state =
seq {
if done_f state then
yield state
else
for state' in next_f state do
yield! go state'
}
go initial
let get_row idx = idx / 9
let get_col idx = idx % 9
let get_box idx =
let r = get_row idx / 3
let c = get_col idx / 3
3 * r + c
let get_neighbors idx =
let r = get_row idx
let c = get_col idx
let b = get_box idx
[0 .. 80]
|> List.filter (fun x ->
x <> idx &&
(get_row x = r || get_col x = c || get_box x = b))
let squares = [|0 .. 80|]
let unit_list =
Array.concat [[|0 .. 8|]
|> Array.map (fun r -> Array.filter (fun x -> get_row x = r) squares);
[|0 .. 8|]
|> Array.map (fun r -> Array.filter (fun x -> get_col x = r) squares);
[|0 .. 8|]
|> Array.map (fun r -> Array.filter (fun x -> get_box x = r) squares)]
let units =
squares
|> Array.map (fun idx ->
unit_list
|> Array.filter (fun xs ->
xs
|> Array.exists (fun x -> x = idx)))
let neighbor_table =
[|0 .. 80|]
|> Array.map get_neighbors
type Board = string []
let initial_board () = Array.create 81 "123456789"
let sudoku_show (board:Board) =
for r in 0 .. 8 do
if r = 3 || r = 6 then
printfn "-------------------"
for c in 0 .. 8 do
if c = 3 || c = 6 then
printf " |"
printf " %A" (board.[r * 9 + c])
printfn ""
let rec assign (board:Board) idx value =
board.[idx].Replace(value, "")
|> String.forall (fun c -> eliminate board idx (string c))
and eliminate board idx value =
if not (board.[idx].Contains(value)) then
true
else
board.[idx] <- board.[idx].Replace(value, "")
if board.[idx].Length = 0 then
false // cannot set here
else
let r1 = if board.[idx].Length = 1 then
let v = board.[idx]
(neighbor_table.[idx]
|> Seq.forall (fun i ->
eliminate board i v))
else true
let r2 = r1 &&
units.[idx]
|> Array.forall (fun un ->
let dplaces = un |>
Array.filter (fun x -> board.[x].Contains(value))
if Array.isEmpty dplaces then
false
elif Array.length dplaces = 1 then
assign board dplaces.[0] value
else true)
r2
let val_count (board:Board) idx =
board.[idx].Length
let sudoku_next_2 (board:Board) =
let best_count, best_idx =
seq { 0 .. 80 }
|> Seq.map (fun idx ->
val_count board idx, idx)
|> Seq.filter (fun (c, idx) -> c <> 1)
|> Seq.min
// printfn "best_idx: %A, best_count: %A" best_idx best_count
seq {
for v in board.[best_idx] do
let board' = Array.copy board
if assign board' best_idx (string v) then
yield board'
}
let sudoku_done_2 (board:Board) =
board |> Array.forall (fun x -> x.Length = 1)
let sudoku_read str =
let board = initial_board()
Seq.fold (fun idx c ->
if c = '.' || c = '0' then
idx + 1
elif c < '1' || c > '9' then
idx
else
assign board idx (string c) |> ignore
idx + 1) 0 str
|> fun c ->
if c <> 81 then failwithf "%d chars read" c
else
board
let sudoku board =
board
|> sudoku_read
|> solve sudoku_next_2 sudoku_done_2
|> Seq.head
|> sudoku_show
let ex2 = "003020600900305001001806400008102900700000008006708200002609500800203009005010300"
sudoku ex2
|
val solve : next_f:('a -> #seq<'a>) -> done_f:('a -> bool) -> initial:'a -> seq<'a>
Full name: Script.solve
val next_f : ('a -> #seq<'a>)
val done_f : ('a -> bool)
val initial : 'a
val go : ('a -> seq<'a>)
val state : 'a
Multiple items
val seq : sequence:seq<'T> -> seq<'T>
Full name: Microsoft.FSharp.Core.Operators.seq
--------------------
type seq<'T> = System.Collections.Generic.IEnumerable<'T>
Full name: Microsoft.FSharp.Collections.seq<_>
val state' : 'a
val get_row : idx:int -> int
Full name: Script.get_row
val idx : int
val get_col : idx:int -> int
Full name: Script.get_col
val get_box : idx:int -> int
Full name: Script.get_box
val r : int
val c : int
val get_neighbors : idx:int -> int list
Full name: Script.get_neighbors
val b : int
Multiple items
module List
from Microsoft.FSharp.Collections
--------------------
type List<'T> =
| ( [] )
| ( :: ) of Head: 'T * Tail: 'T list
interface IEnumerable
interface IEnumerable<'T>
member Head : 'T
member IsEmpty : bool
member Item : index:int -> 'T with get
member Length : int
member Tail : 'T list
static member Cons : head:'T * tail:'T list -> 'T list
static member Empty : 'T list
Full name: Microsoft.FSharp.Collections.List<_>
val filter : predicate:('T -> bool) -> list:'T list -> 'T list
Full name: Microsoft.FSharp.Collections.List.filter
val x : int
val squares : int []
Full name: Script.squares
val unit_list : int [] []
Full name: Script.unit_list
module Array
from Microsoft.FSharp.Collections
val concat : arrays:seq<'T []> -> 'T []
Full name: Microsoft.FSharp.Collections.Array.concat
val map : mapping:('T -> 'U) -> array:'T [] -> 'U []
Full name: Microsoft.FSharp.Collections.Array.map
val filter : predicate:('T -> bool) -> array:'T [] -> 'T []
Full name: Microsoft.FSharp.Collections.Array.filter
val units : int [] [] []
Full name: Script.units
val xs : int []
val exists : predicate:('T -> bool) -> array:'T [] -> bool
Full name: Microsoft.FSharp.Collections.Array.exists
val neighbor_table : int list []
Full name: Script.neighbor_table
type Board = string []
Full name: Script.Board
Multiple items
val string : value:'T -> string
Full name: Microsoft.FSharp.Core.Operators.string
--------------------
type string = System.String
Full name: Microsoft.FSharp.Core.string
val initial_board : unit -> string []
Full name: Script.initial_board
val create : count:int -> value:'T -> 'T []
Full name: Microsoft.FSharp.Collections.Array.create
val sudoku_show : board:Board -> unit
Full name: Script.sudoku_show
val board : Board
val r : int32
val printfn : format:Printf.TextWriterFormat<'T> -> 'T
Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn
val c : int32
val printf : format:Printf.TextWriterFormat<'T> -> 'T
Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printf
val assign : board:Board -> idx:int -> value:string -> bool
Full name: Script.assign
val value : string
module String
from Microsoft.FSharp.Core
val forall : predicate:(char -> bool) -> str:string -> bool
Full name: Microsoft.FSharp.Core.String.forall
val c : char
val eliminate : board:Board -> idx:int -> value:string -> bool
Full name: Script.eliminate
val not : value:bool -> bool
Full name: Microsoft.FSharp.Core.Operators.not
val r1 : bool
val v : string
module Seq
from Microsoft.FSharp.Collections
val forall : predicate:('T -> bool) -> source:seq<'T> -> bool
Full name: Microsoft.FSharp.Collections.Seq.forall
val i : int
val r2 : bool
val forall : predicate:('T -> bool) -> array:'T [] -> bool
Full name: Microsoft.FSharp.Collections.Array.forall
val un : int []
val dplaces : int []
val isEmpty : array:'T [] -> bool
Full name: Microsoft.FSharp.Collections.Array.isEmpty
val length : array:'T [] -> int
Full name: Microsoft.FSharp.Collections.Array.length
val val_count : board:Board -> idx:int -> int
Full name: Script.val_count
val sudoku_next_2 : board:Board -> seq<string []>
Full name: Script.sudoku_next_2
val best_count : int
val best_idx : int
val map : mapping:('T -> 'U) -> source:seq<'T> -> seq<'U>
Full name: Microsoft.FSharp.Collections.Seq.map
val filter : predicate:('T -> bool) -> source:seq<'T> -> seq<'T>
Full name: Microsoft.FSharp.Collections.Seq.filter
val min : source:seq<'T> -> 'T (requires comparison)
Full name: Microsoft.FSharp.Collections.Seq.min
val v : char
val board' : string []
val copy : array:'T [] -> 'T []
Full name: Microsoft.FSharp.Collections.Array.copy
val sudoku_done_2 : board:Board -> bool
Full name: Script.sudoku_done_2
val x : string
property System.String.Length: int
val sudoku_read : str:seq<char> -> string []
Full name: Script.sudoku_read
val str : seq<char>
val board : string []
val fold : folder:('State -> 'T -> 'State) -> state:'State -> source:seq<'T> -> 'State
Full name: Microsoft.FSharp.Collections.Seq.fold
val ignore : value:'T -> unit
Full name: Microsoft.FSharp.Core.Operators.ignore
val failwithf : format:Printf.StringFormat<'T,'Result> -> 'T
Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.failwithf
val sudoku : board:seq<char> -> unit
Full name: Script.sudoku
val board : seq<char>
val head : source:seq<'T> -> 'T
Full name: Microsoft.FSharp.Collections.Seq.head
val ex2 : string
Full name: Script.ex2
More information