Anonymous user
Sudoku: Difference between revisions
Added backtrack F# solution
(Added backtrack F# solution) |
|||
Line 3,983:
=={{header|F_Sharp|F#}}==
===Simple Backtracker===
<lang fsharp>module SudokuBacktrack
//Helpers
let tuple2 a b = a,b
let (>>=) f g = Option.bind g f
/// "A1" to "I9" squares as key in values dictionary
let key a b = $"{a}{b}"
/// 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 |]
// constants
let valid = "1234567890.,"
let rows = "ABCDEFGHI"
let cols = "123456789"
let squares = cross rows cols
// List of all row, cols and boxes: aka units
let unitList =
[for c in cols do cross rows (string c) ]@ // row units
[for r in rows do cross (string r) cols ]@ // col units
[for rs in ["ABC";"DEF";"GHI"] do for cs in ["123";"456";"789"] do cross rs cs ] // box units
/// Dictionary of units for each square
let units =
[for s in squares do s, [| for u in unitList do if u |> Array.contains s then u |] ] |> Map.ofSeq
/// Distionary of all peer squares in the relevant units wrt square in question
let peers =
[for s in squares do units[s] |> Array.concat |> Array.distinct |> Array.except [s] |> tuple2 s] |> Map.ofSeq
/// Should parse grid in many input formats or return None
let parseGrid grid =
let ints = [for c in grid do if valid |> Seq.contains c then if ",." |> Seq.contains c then 0 else (c |> string |> int)]
if Seq.length ints = 81 then ints |> Seq.zip squares |> Map.ofSeq |> Some else None
/// Outputs single line puzzle with 0 as empty squares
let asString = function
| Some values' -> values' |> Map.toSeq |> Seq.map (snd>>string) |> String.concat ""
| _ -> "No solution or Parse Failure"
/// Outputs puzzle in 2D format with 0 as empty squares
let prettyPrint = function
| Some (values':Map<_,_>) ->
[for r in rows do [for c in cols do (values'[key r c] |> string) ] |> String.concat " " ] |> String.concat "\n"
| _ -> "No solution or Parse Failure"
/// Is digit allowed in the square in question? !!! hot path !!!! Array/Array2D no faster and they need explicit copy since not immutable
let constraints (values:Map<_,_>) s d = seq {for p in peers[s] do values[p] = d} |> Seq.exists ((=) true) |> not
/// Move to next square or None if out of bounds
let next s = squares |> Array.tryFindIndex ((=)s) |> function Some i when i + 1 < 81 -> Some squares[i + 1] | _ -> None
/// Backtrack recursvely and immutably from index
let rec backtrack s (values:Map<string,int>) =
match s with
| None -> Some values // solved!
| Some s' when values[s'] > 0 -> backtrack (next s') values // square not empty
| Some s' ->
let rec tracker (vx:Map<_,_>) dx =
match dx with
| [] -> None
| d::dx' ->
let vx' = vx |> Map.change s' (Option.map (fun _ -> d))
match backtrack (next s') vx' with
| None -> tracker vx dx'
| success -> success
[1..9]
|> List.filter (constraints values s')
|> tracker values
/// solve sudoku using simple backtracking
let solve grid = grid |> parseGrid >>= backtrack (Some "A1")
</lang>
Usage<lang fsharp>open System
open SudokuBacktrack
[<EntryPoint>]
let main argv =
let puzzle = "000028000800010000000000700000600403200004000100700000030400500000000010060000000"
puzzle |> printfn "Puzzle:\n%s"
puzzle |> parseGrid |> prettyPrint |> printfn "Formated:\n%s"
puzzle |> solve |> prettyPrint |> printfn "Solution:\n%s"
printfn "Press any key to exit"
Console.ReadKey() |> ignore
0</lang>
Output<pre>
Puzzle:
000028000800010000000000700000600403200004000100700000030400500000000010060000000
Formatted:
0 0 0 0 2 8 0 0 0
8 0 0 0 1 0 0 0 0
0 0 0 0 0 0 7 0 0
0 0 0 6 0 0 4 0 3
2 0 0 0 0 4 0 0 0
1 0 0 7 0 0 0 0 0
0 3 0 4 0 0 5 0 0
0 0 0 0 0 0 0 1 0
0 6 0 0 0 0 0 0 0
Solution:
6 1 7 3 2 8 9 4 5
8 9 4 5 1 7 2 3 6
3 2 5 9 4 6 7 8 1
9 7 8 6 5 1 4 2 3
2 5 6 8 3 4 1 7 9
1 4 3 7 9 2 6 5 8
7 3 1 4 8 9 5 6 2
4 8 9 2 6 5 3 1 7
5 6 2 1 7 3 8 9 4
Press any key to exit
</pre>
===The Function SLPsolve===
<lang fsharp>
Line 4,014 ⟶ 4,129:
|>List.iter(fun (_,n)->n|>Seq.fold(fun z ((_,g),v)->[z..g-1]|>Seq.iter(fun _->printf " |");printf "%s|" v; g+1 ) 0 |>ignore;printfn "")
</lang>
===Demonstration===
Given sud1.csv:
| |||