0 people like it.

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

Link:http://fssnip.net/6q
Posted:9 years ago
Author:dave jones
Tags: puzzle