Sudoku: Difference between revisions
Content added Content deleted
m (→Constraint Satisfaction (Norvig): 3.7 ms looked too good, even if could not find issue but this 6.7 ms timings with updated code I trust better) |
|||
Line 4,146: | Line 4,146: | ||
/// folds folder returning Some on completion or returns None if not |
/// folds folder returning Some on completion or returns None if not |
||
let rec all folder state |
let rec all folder state source = |
||
match state, source with |
|||
| None, _ -> None |
|||
⚫ | |||
| Some st, [] -> Some st |
|||
⚫ | |||
/// "A1" to "I9" squares as key in values dictionary |
/// "A1" to "I9" squares as key in values dictionary |
||
let key a b = $"{a}{b}" |
let key a b = 10*a + b// $"{a}{b}" |
||
/// Keys generator |
|||
/// Cross product of elements in ax and elements in bx |
|||
let cross ax bx = [| for a in ax do for b in bx do key a b |] |
let cross ax bx = [| for a in ax do for b in bx do key a b |] |
||
// constants |
// constants |
||
let digits = [|1..9|] |
let digits = [|1..9|] |
||
let rows = |
let rows = digits |
||
let cols = |
let cols = digits |
||
let empty = "0,." |
let empty = "0,." |
||
let valid = |
let valid = "123456789"+empty |
||
let boxi = [for b in 1..3..9 -> [|b..b+2|]] |
|||
let squares = cross rows cols |
let squares = cross rows cols |
||
// List of all row, cols and boxes: aka units |
// List of all row, cols and boxes: aka units |
||
let unitlist = |
let unitlist = |
||
[for c in cols |
[for c in cols -> cross rows [|c|] ]@ |
||
[for r in rows |
[for r in rows -> cross [|r|] cols ]@ |
||
[for rs in |
[for rs in boxi do for cs in boxi do cross rs cs ] |
||
/// Dictionary of units for each square |
/// Dictionary of units for each square |
||
let units = |
let units = |
||
Line 4,182: | Line 4,185: | ||
/// Eliminate d from values[s] and propagate when values = 1. |
/// Eliminate d from values[s] and propagate when values = 1. |
||
/// Return Some values, except return None if a contradiction is detected. |
/// Return Some values, except return None if a contradiction is detected. |
||
let rec eliminate (values:Map<_,_>) |
let rec eliminate (values:Map<_,_>) s d = |
||
let peerElim (vx:Map<_,_>) = |
let peerElim (vx:Map<_,_>) = |
||
match Seq.length vx[s] with // (1) If a square s is reduced to one value d, then eliminate d from the peers. |
match Seq.length vx[s] with // (1) If a square s is reduced to one value d, then eliminate d from the peers. |
||
Line 4,209: | Line 4,212: | ||
/// Eliminate all the other values (except d) from values[s] and propagate. |
/// Eliminate all the other values (except d) from values[s] and propagate. |
||
/// Return Some values, except None if a contradiction is detected. |
/// Return Some values, except None if a contradiction is detected. |
||
and assign (values:Map<_,_>) (s |
and assign (values:Map<_,_>) (s) d = |
||
values[s] |
values[s] |
||
|> Seq.filter ((<>)d) |
|> Seq.filter ((<>)d) |
||
Line 4,216: | Line 4,219: | ||
/// Convert grid into a Map of {square: char} with "0","."or"," for empties. |
/// Convert grid into a Map of {square: char} with "0","."or"," for empties. |
||
let parseGrid grid = |
let parseGrid grid = |
||
let cells = [for c in grid do if valid |> Seq.contains c then if empty |> Seq.contains c then 0 else ((string>>int) |
let cells = [for c in grid do if valid |> Seq.contains c then if empty |> Seq.contains c then 0 else ((string>>int)c)] |
||
if Seq.length cells = 81 then cells |> Seq.zip squares |> Map.ofSeq |> Some else None |
if Seq.length cells = 81 then cells |> Seq.zip squares |> Map.ofSeq |> Some else None |
||
/// Convert grid to a Map of constraint popagated possible values, or return None if a contradiction is detected. |
/// Convert grid to a Map of constraint popagated possible values, or return None if a contradiction is detected. |
||
let applyCPS (parsedGrid:Map<_, |
let applyCPS (parsedGrid:Map<_,int>) = |
||
let values = [for s in squares do s, digits]|> Map.ofList |
let values = [for s in squares do s, digits]|> Map.ofList |
||
parsedGrid |
parsedGrid |
||
|> (Seq.filter (fun |
|> (Seq.filter (fun (KeyValue(_,d)) -> digits |> Seq.contains d) |
||
>> List.ofSeq >> all (fun vx |
>> List.ofSeq >> all (fun vx (KeyValue(s,d)) -> assign vx s d) (Some values) ) |
||
/// Calculate string centre for each square - which can contain more than 1 digit when debugging |
/// Calculate string centre for each square - which can contain more than 1 digit when debugging |
||
Line 4,231: | Line 4,234: | ||
if n <= 0 then s |
if n <= 0 then s |
||
else |
else |
||
let half = n/2 + ( |
let half = n/2 + (if (n%2>0 && width%2>0) then 1 else 0) |
||
sprintf "%s%s%s" (String(' ',half)) s (String(' ', n - half)) |
sprintf "%s%s%s" (String(' ',half)) s (String(' ', n - half)) |
||
Line 4,241: | Line 4,244: | ||
[for r in rows do |
[for r in rows do |
||
for c in cols do |
for c in cols do |
||
sprintf "%s%s" (centre (asString values[key r c]) width) (if |
sprintf "%s%s" (centre (asString values[key r c]) width) (if List.contains c [3;6] then "|" else "") |
||
sprintf "\n%s"(if |
sprintf "\n%s"(if List.contains r [3;6] then line else "") ] |
||
|> String.concat "" |
|> String.concat "" |
||
Line 4,250: | Line 4,253: | ||
/// Using depth-first search and propagation, try all possible values. |
/// Using depth-first search and propagation, try all possible values. |
||
let rec search (values:Map<_,_>)= |
let rec search (values:Map<_,_>)= |
||
let rec some |
let rec some = function |
||
| [] -> None // No Solution |
|||
| s::sx -> |
|||
⚫ | |||
values[s] |
|||
⚫ | |||
|> function |
|> function |
||
| Some seqx when Seq.isEmpty seqx -> some |
| Some seqx when Seq.isEmpty seqx -> some sx // reduces calls to find fewest possibilities |
||
| Some seq -> Some seq |
| Some seq -> Some seq // returns Some in previous stack's tryPick |
||
| _ -> None |
| _ -> None // returns None in previous stack's tryPick |
||
// Choose the unfilled square |
// Choose the unfilled square s with the fewest possibilities |
||
[for s in squares do if Seq.length values[s] > 1 then Seq.length values[s] ,s] |
[for s in squares do if Seq.length values[s] > 1 then Seq.length values[s] ,s] |
||
|> function |
|> function |
||
| [] -> Some values // |
| [] -> Some values // Solved! |
||
| list -> list |> List.sortBy fst |> List.map snd |> some |
| list -> list |> List.sortBy fst |> List.map snd |> some |
||
// Core API |
|||
// Option functions glue/ Command Line Helpers (Could be clearer!) |
|||
let |
let run error stringF applyF = parseGrid >> function None -> error | Some m -> applyF m |> stringF |
||
⚫ | |||
let solveNoSearch = |
|||
let solveNoSearch: string -> string = solver applyCPS |
|||
⚫ | |||
let solveWithSearch: string -> string = solver (applyCPS >> (Option.bind search)) |
|||
let solve = |
|||
let solveWithSearchToMapOnly:string -> Map<int,int[]> option = run None id (applyCPS >> (Option.bind search)) </lang> |
|||
'''Usage'''<lang fsharp>open System |
'''Usage'''<lang fsharp>open System |
||
open SudokuCPS |
open SudokuCPS |
||
Line 4,278: | Line 4,283: | ||
printfn "Easy board solution automatic with constraint propagation" |
printfn "Easy board solution automatic with constraint propagation" |
||
let easy = "..3.2.6..9..3.5..1..18.64....81.29..7.......8..67.82....26.95..8..2.3..9..5.1.3.." |
let easy = "..3.2.6..9..3.5..1..18.64....81.29..7.......8..67.82....26.95..8..2.3..9..5.1.3.." |
||
easy |
easy |> solveNoSearch |> printfn "%s" |
||
printfn "Simple elimination not possible" |
printfn "Simple elimination not possible" |
||
let simple = "4.....8.5.3..........7......2.....6.....8.4......1.......6.3.7.5..2.....1.4......" |
let simple = "4.....8.5.3..........7......2.....6.....8.4......1.......6.3.7.5..2.....1.4......" |
||
simple |> |
simple |> run "Parse Error" asString id |> printfn "%s" |
||
simple |
simple |> solveNoSearch |> printfn "%s" |
||
printfn "Try again with search:" |
printfn "Try again with search:" |
||
simple |> |
simple |> run "Parse Error" prettyPrint (Map.toSeq >> Seq.map (fun (k,v) -> k , string v) >> Map.ofSeq) |> printfn "%s" |
||
simple |> |
simple |> solveWithSearch |> printfn "%s" |
||
let watch = Stopwatch() |
let watch = Stopwatch() |
||
Line 4,294: | Line 4,299: | ||
printfn "Hard" |
printfn "Hard" |
||
watch.Start() |
watch.Start() |
||
hard |> |
hard |> solveWithSearch |> printfn "%s" |
||
watch.Stop() |
watch.Stop() |
||
printfn $"Elapsed milliseconds = {watch.ElapsedMilliseconds } ms" |
printfn $"Elapsed milliseconds = {watch.ElapsedMilliseconds } ms" |
||
watch.Reset() |
watch.Reset() |
||
let puzzles = |
|||
if Seq.length argv = 1 then |
|||
⚫ | |||
let num = argv[0] |> int |
|||
printfn $"First {num} puzzles in sudoku17" |
|||
File.ReadLines(@"sudoku17.txt") |> Seq.take num |>Array.ofSeq |
|||
else |
|||
printfn $"All puzzles in sudoku17" |
|||
⚫ | |||
watch.Start() |
watch.Start() |
||
let result = puzzles |> Array.map |
let result = puzzles |> Array.map solveWithSearchToMapOnly |
||
watch.Stop() |
watch.Stop() |
||
if result |> Seq.forall Option.isSome then |
|||
let total = watch.ElapsedMilliseconds |
let total = watch.ElapsedMilliseconds |
||
printfn $"\nPuzzles:{result.Length}, Total:{total} |
printfn $"\nPuzzles:{result.Length}, Total:%.2f{((float)total)/1000.0} s, Average:%.2f{((float total) /(float result.Length))} ms" |
||
else |
|||
printfn "Some sudoku17 puzzles failed" |
|||
Console.ReadKey() |> ignore |
Console.ReadKey() |> ignore |
||
0</lang> |
0</lang> |
||
Line 4,374: | Line 4,387: | ||
5 9 8 |7 3 6 |2 4 1 |
5 9 8 |7 3 6 |2 4 1 |
||
Elapsed milliseconds = |
Elapsed milliseconds = 11 ms |
||
All puzzles in sudoku17 |
All puzzles in sudoku17 |
||
Puzzles:49151, Total: |
Puzzles:49151, Total:332.50 s, Average:6.76 ms</pre> |
||
</pre> |
|||
===SLPsolve=== |
===SLPsolve=== |