Anonymous user
Sudoku: Difference between revisions
m
→Constraint Satisfaction (Norvig)
Line 4,141:
module SudokuCPS
open System
let tuple2 a b = a,b▼
/// folds folder returning Some on completion or returns None if not▼
let rec all folder state source = ▼
match state, source with▼
| None, _ -> None ▼
| Some st , hd::rest -> folder st hd |> (fun st1 -> all folder st1 rest)▼
///
let key a b = 10*a + b// $"{a}{b}"
Line 4,180 ⟶ 4,171:
/// Dictionary of all peer squares in the relevant units wrt square in question
let peers =
▲ let tuple2 a b = a,b
[for s in squares do units[s] |> Array.concat |> Array.distinct |> Array.except [s] |> tuple2 s]
|> Map.ofList
▲/// folds folder returning Some on completion or returns None if not
/// Eliminate d from values[s] and propagate when values = 1.▼
▲let rec all folder state source =
/// Return Some values, except return None if a contradiction is detected.▼
▲ match state, source with
let rec eliminate (values:Map<_,_>) s d = ▼
match Seq.length vx[s] with // (1) If a square s is reduced to one value d, then eliminate d from the peers. ▼
▲ | Some st , hd::rest -> folder st hd |> (fun st1 -> all folder st1 rest)
/// Assign digit d to values[s] and propagate (via eliminate)
/// Return Some values, except None if a contradiction is detected.▼
values[s]▼
|> Seq.filter ((<>)d)▼
|> List.ofSeq |> all (fun st d2 -> eliminate st s d2) (Some values) ▼
▲ let peerElim
match Seq.length vx[s] with
| 0 -> None // removed last value
| 1 -> peers[s] |> List.ofArray |> all (fun st
| _ -> Some vx
let unitsElim vx = // If a unit u is reduced to only one place for a value d, then *assign* it there.
units[s]
|> List.ofArray |> all (fun (st:Map<_,_>) u ->
let dKeys = [for s in u do if st[s] |> Seq.contains d then s]
Line 4,204 ⟶ 4,210:
| false -> Some values // Already eliminated, nothing to do
| true ->
let
peerElim
▲/// Return Some values, except None if a contradiction is detected.
▲and assign (values:Map<_,_>) (s) d =
▲ values[s]
▲ |> Seq.filter ((<>)d)
▲ |> List.ofSeq |> all (fun st d2 -> eliminate st s d2) (Some values)
/// Convert grid into a Map of {square: char} with "0","."or"," for empties.
Line 4,257 ⟶ 4,254:
| [] -> Some values // Solved!
| list -> // tryPick ~ Norvig's `some`
list |> List.minBy fst |> fun (_,s) -> values[s] |> Seq.tryPick (fun d -> assign values s d |>
let run n g f = parseGrid >> function None -> n | Some m -> f m |> g ▼
▲let run n g f = parseGrid >> function None -> n | Some m -> f m |> g
let solver = run "Parse Error" (Option.fold (fun _ t -> t |> prettyPrint) "No Solution")
let solveNoSearch: string -> string = solver applyCPS
let solveWithSearch: string -> string = solver (applyCPS >> (Option.bind search))
let solveWithSearchToMapOnly:string -> Map<int,int[]> option = run None id (applyCPS >> (Option.bind search))
'''Usage'''<lang fsharp>open System
open SudokuCPS
| |||