Tom Says: Safe code is boring code!
I wrote a modest sudoku solver in OCaml to keep my mind sharp by learning a programming language. OCaml comments are surrounded by (* and *) so you should be able to copy everything beneath this rule directly into a .ml file and execute it with OCaml.
(* sudoku.ml *) (* Range helper: (1--3) -> [1; 2; 3] *) let (--) a b = Array.to_list (Array.init (b - a + 1) ((+) a));;
(* The data structure I use for a sudoku grid is a map from (col, row) coordinates to sets of integers. A grid will have all the coordinates (1, 1), (1, 2), … (9, 9) present; each square is a set of the integers which are candidates for the actual value of the square. For a solved puzzle, each set will have exactly one integer. *)
(* Map from (x, y) -> Set *) let coord_compare (x1, y1) (x2, y2) = compare (x1 + y1 * 9) (x2 + y2 * 9);; module CoordMap = Map.Make(struct type t = (int * int) let compare = coord_compare end);; (* set of ints *) module IntSet = Set.Make(struct type t = int let compare = compare end);;
(* There is basic visualization support while the puzzle is being solved. A 9x9 grid is shown, each square containing up to 9 filled circles (one for each candidate for that square) with the exception of squares with only one number — in those the number itself is displayed. This way a solved puzzle looks as it would on paper. *)
(* graphics *)
open Graphics;;
let box_width = 40;;
let box_x col = col * box_width + (15 * ((col - 1) / 3));;
let box_y row = (9 - row + 1) * box_width + (15 * ((9 - row) / 3));;
let display_possibility (col, row) num =
let props n = (((n * 2) + 1) * box_width) / 6 in
let xoff = props ((num - 1) mod 3) in
let yoff = box_width - (props ((num - 1) / 3)) in
set_color (rgb 0 0 128) ;
fill_circle ((box_x col) + xoff) ((box_y row) + yoff) (box_width / 8);;
let display_box (col, row) possibilities =
set_color black ;
draw_rect (box_x col) (box_y row) box_width box_width ;
if IntSet.cardinal possibilities = 1 then (
moveto ((box_x col) + box_width / 2) ((box_y row) + box_width / 2) ;
draw_string (string_of_int (IntSet.choose possibilities))
) else IntSet.iter (display_possibility (col, row)) possibilities;;
let display_grid grid = clear_graph () ; CoordMap.iter display_box grid;;
(* creating a grid (map of coordinates to sets of possible numbers) *)
(* grid coordinates are 1-indexed *)
let init_box () = List.fold_right IntSet.add (1--9) IntSet.empty;;
let coord_seq = List.concat (List.map (fun x -> List.map (fun y -> (x, y)) (1--9)) (1--9));;
let grid = List.fold_right (fun x -> CoordMap.add x (init_box ())) coord_seq CoordMap.empty;;
(* grid displaying functions *)
let string_of_coords (x, y) =
"(" ^ (string_of_int x) ^ ", " ^ (string_of_int y) ^ ")";;
let string_of_possibilities possibilities =
IntSet.fold (fun x -> (^) (string_of_int x ^ " ")) possibilities "";;
let string_of_box coords possibilities =
(string_of_coords coords) ^ ": " ^ (string_of_possibilities possibilities);;
let print_grid grid =
for y = 1 to 9 do
for x = 1 to 9 do
print_endline (string_of_box (x, y) (CoordMap.find (x, y) grid))
done
done;;
(* solved? *)
let is_inconsistent grid =
let any_empty k v m = m || (IntSet.cardinal v = 0) in
CoordMap.fold any_empty grid false;;
let is_complete grid =
let all_done k v m = m && (IntSet.cardinal v = 1) in
CoordMap.fold all_done grid true;;
let is_done grid =
is_inconsistent grid || is_complete grid;;
(* eliminate_box num coords grid returns a grid with the box at the given coordinates having the given number removed from its set. eliminate_all_but num coords grid removes every number except the one given. These are the basis for the other functions which do the same for rows, columns, and sectors (one of the 3x3 sub-sections of the grid).
select num (col, row) grid is the function actually used for manipulating a game grid. It is the equivalent of writing in a number as "for sure" and crossing out the ones in its column, row, and sector which it makes impossible. It also 'cascades' once so that if more "for sures" are found, the same selection process is performed on them. )*
(* elimination *)
(* sectors are 0-indexed *)
let sector_coords col row = (col - 1) / 3, (row - 1) / 3;;
let rec eliminate_box num coords grid =
CoordMap.add coords (IntSet.remove num (CoordMap.find coords grid)) grid
and eliminate_all_but num coords grid =
CoordMap.add coords
(IntSet.inter
(CoordMap.find coords grid)
(IntSet.add num IntSet.empty))
grid
and eliminate_in_row num except_coords row grid =
let doit grid col =
if (col, row) = except_coords then grid
else eliminate_box num (col, row) grid
in
List.fold_left doit grid (1--9)
and eliminate_in_col num except_coords col grid =
let doit grid row =
if (col, row) = except_coords then grid
else eliminate_box num (col, row) grid
in
List.fold_left doit grid (1--9)
and eliminate_in_sector num except_coords (sector_x, sector_y) grid =
let doit grid (col, row) =
if (col, row) = except_coords then grid
else eliminate_box num (col, row) grid
in
let coords = [sector_x * 3 + 1, sector_y * 3 + 1;
sector_x * 3 + 2, sector_y * 3 + 1;
sector_x * 3 + 3, sector_y * 3 + 1;
sector_x * 3 + 1, sector_y * 3 + 2;
sector_x * 3 + 2, sector_y * 3 + 2;
sector_x * 3 + 3, sector_y * 3 + 2;
sector_x * 3 + 1, sector_y * 3 + 3;
sector_x * 3 + 2, sector_y * 3 + 3;
sector_x * 3 + 3, sector_y * 3 + 3;] in
List.fold_left doit grid coords
and select_without_cascade num (col, row) grid =
let grid = eliminate_in_row num (col, row) row grid in
let grid = eliminate_in_col num (col, row) col grid in
let grid = eliminate_in_sector num (col, row) (sector_coords col row) grid in
let grid = eliminate_all_but num (col, row) grid in
grid
and cascaded_select grid =
let f coords possibilities grid =
if IntSet.cardinal possibilities = 1 then
select_without_cascade (IntSet.choose possibilities) coords grid
else
grid
in
CoordMap.fold f grid grid
and select num (col, row) grid =
let grid = select_without_cascade num (col, row) grid in
cascaded_select grid;; (* TODO: repeat until cascading has no effect *)
(* For some puzzles, you just have to start guessing. solve_by_guessing grid does it in a fairly naïve way: at each level of recursion, a list of all the possible guess is made, then each is made and the resulting grid is again passed to solve_by_guessing grid. This is a depth-first search of all the possible ways to solve the puzzle – much worse than typical brute-force – and is far too inefficient to ever solve problems that require more than a few numbers to be guessed. *)
(* Warning: just pretend that this code doesn't exist. *)
(* still too many choices? guess! *)
let possible_moves grid =
let possibility_list coords possibilities =
let f p arr = (coords, p) :: arr in
if IntSet.cardinal possibilities > 1 then
IntSet.fold f possibilities []
else []
in
let f coords possibilities arr =
(possibility_list coords possibilities) :: arr
in
let lcompare a b = compare (List.length a) (List.length b) in
let p = List.sort lcompare (CoordMap.fold f grid []) in
List.concat p;;
let solve_by_guessing grid =
let rec recurse grid =
display_grid grid ;
(* wait_next_event [Key_pressed] ; *)
if is_complete grid then (grid, "solved")
else if is_inconsistent grid then (grid, "inconsistent")
else try_possibilities grid
and try_possibilities grid =
let rec loop moves =
(* print_moves moves ; *)
match moves with
[] -> (grid, "no solution")
| (coords, num) :: rest ->
(* print_endline ("trying " ^ (string_of_int num) ^ " at " ^ (string_of_coords coords)) ; *)
let new_grid, state = recurse (select num coords grid) in
if state = "solved" then (new_grid, "solved")
else loop rest
in
loop (possible_moves grid)
in
recurse grid;;
(* End of horribly bad and evil code. *)
(* ask the user for the numbers already on the grid *)
let rec ask_loop grid =
try
print_string "Num: " ;
let num = read_int () in
print_string "Col: " ;
let col = read_int () in
print_string "Row: " ;
let row = read_int () in
print_endline ("Selecting " ^ (string_of_int num) ^
" @ (" ^ (string_of_int col) ^ ", " ^ (string_of_int row) ^ ")") ;
display_grid grid ;
(* wait_next_event [Key_pressed] ; *)
let new_grid = select num (col, row) grid in
if is_done new_grid then new_grid
else ask_loop new_grid
with
Failure "int_of_string" -> grid
| End_of_file -> grid;;
(* begin *)
open_graph " 470x470";;
let grid = ask_loop grid;;
let grid = if is_done grid then grid else (
print_endline "** TIME FOR GUESSING **" ;
let grid, solved = solve_by_guessing grid in
print_endline solved ;
grid
);;
print_endline "** FINISHED **";;
display_grid grid ;;
wait_next_event [Key_pressed] ;;
Posted Jul 18, 2008, in the night.