Sudoku

Solve a partially filled-in normal 9x9 Sudoku grid and display the result in a human-readable format. Algorithmics of Sudoku may help implement this.

C

See e.g. this GPLed solver written in C.

Common Lisp

A simple solver without optimizations (except for pre-computing the possible entries of a cell).

<lang lisp>(defun row-neighbors (row column grid &aux (neighbors '()))

 (dotimes (i 9 neighbors)
   (let ((x (aref grid row i)))
     (unless (or (eq '_ x) (= i column))
       (push x neighbors)))))

(defun column-neighbors (row column grid &aux (neighbors '()))

 (dotimes (i 9 neighbors)
   (let ((x (aref grid i column)))
     (unless (or (eq x '_) (= i row))
       (push x neighbors)))))

(defun square-neighbors (row column grid &aux (neighbors '()))

 (let* ((rmin (* 3 (floor row 3)))    (rmax (+ rmin 3))
        (cmin (* 3 (floor column 3))) (cmax (+ cmin 3)))
   (do ((r rmin (1+ r))) ((= r rmax) neighbors)
     (do ((c cmin (1+ c))) ((= c cmax))
       (let ((x (aref grid r c)))
         (unless (or (eq x '_) (= r row) (= c column))
           (push x neighbors)))))))

(defun choices (row column grid)

 (nset-difference
  (list 1 2 3 4 5 6 7 8 9)
  (nconc (row-neighbors row column grid)
         (column-neighbors row column grid)
         (square-neighbors row column grid))))

(defun solve (grid &optional (row 0) (column 0))

 (cond
  ((= row 9)
   grid)
  ((= column 9)
   (solve grid (1+ row) 0))
  ((not (eq '_ (aref grid row column)))
   (solve grid row (1+ column)))
  (t (dolist (choice (choices row column grid) (setf (aref grid row column) '_))
       (setf (aref grid row column) choice)
       (when (eq grid (solve grid row (1+ column)))
         (return grid))))))</lang>

Example:

> (defparameter *puzzle*
  #2A((3 9 4    _ _ 2    6 7 _)
      (_ _ _    3 _ _    4 _ _)
      (5 _ _    6 9 _    _ 2 _)
    
      (_ 4 5    _ _ _    9 _ _)
      (6 _ _    _ _ _    _ _ 7)
      (_ _ 7    _ _ _    5 8 _)
    
      (_ 1 _    _ 6 7    _ _ 8)
      (_ _ 9    _ _ 8    _ _ _)
      (_ 2 6    4 _ _    7 3 5)))
*PUZZLE*

> (pprint (solve *puzzle*))

#2A((3 9 4 8 5 2 6 7 1)
    (2 6 8 3 7 1 4 5 9)
    (5 7 1 6 9 4 8 2 3)
    (1 4 5 7 8 3 9 6 2)
    (6 8 2 9 4 5 3 1 7)
    (9 3 7 1 2 6 5 8 4)
    (4 1 3 5 6 7 2 9 8)
    (7 5 9 2 3 8 1 4 6)
    (8 2 6 4 1 9 7 3 5))

Fortran

Works with: Fortran version 90 and later

This implementation uses a brute force method. The subroutine solve recursively checks valid entries using the rules defined in the function is_safe. When solve is called beyond the end of the sudoku, we know that all the currently entered values are valid. Then the result is displayed. <lang fortran>program sudoku

 implicit none
 integer, dimension (9, 9) :: grid
 integer, dimension (9, 9) :: grid_solved
 grid = reshape ((/               &
   & 0, 0, 3, 0, 2, 0, 6, 0, 0,   &
   & 9, 0, 0, 3, 0, 5, 0, 0, 1,   &
   & 0, 0, 1, 8, 0, 6, 4, 0, 0,   &
   & 0, 0, 8, 1, 0, 2, 9, 0, 0,   &
   & 7, 0, 0, 0, 0, 0, 0, 0, 8,   &
   & 0, 0, 6, 7, 0, 8, 2, 0, 0,   &
   & 0, 0, 2, 6, 0, 9, 5, 0, 0,   &
   & 8, 0, 0, 2, 0, 3, 0, 0, 9,   &
   & 0, 0, 5, 0, 1, 0, 3, 0, 0/), &
   & shape = (/9, 9/),            &
   & order = (/2, 1/))
 call pretty_print (grid)
 call solve (1, 1)
 write (*, *)
 call pretty_print (grid_solved)

contains

 recursive subroutine solve (i, j)
   implicit none
   integer, intent (in) :: i
   integer, intent (in) :: j
   integer :: n
   integer :: n_tmp
   if (i > 9) then
     grid_solved = grid
   else
     do n = 1, 9
       if (is_safe (i, j, n)) then
         n_tmp = grid (i, j)
         grid (i, j) = n
         if (j == 9) then
           call solve (i + 1, 1)
         else
           call solve (i, j + 1)
         end if
         grid (i, j) = n_tmp
       end if
     end do
   end if
 end subroutine solve

 function is_safe (i, j, n) result (res)
   implicit none
   integer, intent (in) :: i
   integer, intent (in) :: j
   integer, intent (in) :: n
   logical :: res
   integer :: i_min
   integer :: j_min
   if (grid (i, j) == n) then
     res = .true.
     return
   end if
   if (grid (i, j) /= 0) then
     res = .false.
     return
   end if
   if (any (grid (i, :) == n)) then
     res = .false.
     return
   end if
   if (any (grid (:, j) == n)) then
     res = .false.
     return
   end if
   i_min = 1 + 3 * ((i - 1) / 3)
   j_min = 1 + 3 * ((j - 1) / 3)
   if (any (grid (i_min : i_min + 2, j_min : j_min + 2) == n)) then
     res = .false.
     return
   end if
   res = .true.
 end function is_safe

 subroutine pretty_print (grid)
   implicit none
   integer, dimension (9, 9), intent (in) :: grid
   integer :: i
   integer :: j
   character (*), parameter :: bar = '+-----+-----+-----+'
   character (*), parameter :: fmt = '(3 ("|", i0, 1x, i0, 1x, i0), "|")'
   write (*, '(a)') bar
   do j = 0, 6, 3
     do i = j + 1, j + 3
       write (*, fmt) grid (i, :)
     end do
     write (*, '(a)') bar
   end do
 end subroutine pretty_print

end program sudoku</lang> Output:

+-----+-----+-----+
|0 0 3|0 2 0|6 0 0|
|9 0 0|3 0 5|0 0 1|
|0 0 1|8 0 6|4 0 0|
+-----+-----+-----+
|0 0 8|1 0 2|9 0 0|
|7 0 0|0 0 0|0 0 8|
|0 0 6|7 0 8|2 0 0|
+-----+-----+-----+
|0 0 2|6 0 9|5 0 0|
|8 0 0|2 0 3|0 0 9|
|0 0 5|0 1 0|3 0 0|
+-----+-----+-----+

+-----+-----+-----+
|4 8 3|9 2 1|6 5 7|
|9 6 7|3 4 5|8 2 1|
|2 5 1|8 7 6|4 9 3|
+-----+-----+-----+
|5 4 8|1 3 2|9 7 6|
|7 2 9|5 6 4|1 3 8|
|1 3 6|7 9 8|2 4 5|
+-----+-----+-----+
|3 7 2|6 8 9|5 1 4|
|8 1 4|2 5 3|7 6 9|
|6 9 5|4 1 7|3 8 2|
+-----+-----+-----+

Haskell

Visit the Haskell wiki Sudoku

J

See Solving Sudoku in J.

OCaml

uses the library ocamlgraph <lang ocaml>(* Ocamlgraph demo program: solving the Sudoku puzzle using graph coloring

  Copyright 2004-2007 Sylvain Conchon, Jean-Christophe Filliatre, Julien Signoles

  This software is free software; you can redistribute it and/or modify 
  it under the terms of the GNU Library General Public License version 2,
  with the special exception on linking described in file LICENSE.

  This software is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *)

open Format open Graph

(* We use undirected graphs with nodes containing a pair of integers

  (the cell coordinates in 0..8 x 0..8).
  The integer marks of the nodes will store the colors. *)

module G = Imperative.Graph.Abstract(struct type t = int * int end)

(* The Sudoku grid = a graph with 9x9 nodes *) let g = G.create ()

(* We create the 9x9 nodes, add them to the graph and keep them in a matrix

  for later access *)

let nodes =

 let new_node i j = let v = G.V.create (i, j) in G.add_vertex g v; v in
 Array.init 9 (fun i -> Array.init 9 (new_node i))

let node i j = nodes.(i).(j) (* shortcut for easier access *)

(* We add the edges:

  two nodes are connected whenever they can't have the same value,
  i.e. they belong to the same line, the same column or the same 3x3 group *)

let () =

 for i = 0 to 8 do for j = 0 to 8 do
   for k = 0 to 8 do
     if k <> i then G.add_edge g (node i j) (node k j);
     if k <> j then G.add_edge g (node i j) (node i k);
   done;
   let gi = 3 * (i / 3) and gj = 3 * (j / 3) in
   for di = 0 to 2 do for dj = 0 to 2 do
     let i' = gi + di and j' = gj + dj in
     if i' <> i || j' <> j then G.add_edge g (node i j) (node i' j')
   done done
 done done

(* Displaying the current state of the graph *) let display () =

 for i = 0 to 8 do
   for j = 0 to 8 do printf "%d" (G.Mark.get (node i j)) done;
   printf "\n";
 done;
 printf "@?"

(* We read the initial constraints from standard input and we display g *) let () =

 for i = 0 to 8 do
   let s = read_line () in
   for j = 0 to 8 do match s.[j] with
     | '1'..'9' as ch -> G.Mark.set (node i j) (Char.code ch - Char.code '0')
     | _ -> ()
   done
 done;
 display ();
 printf "---------@."

(* We solve the Sudoku by 9-coloring the graph g and we display the solution *) module C = Coloring.Mark(G)

let () = C.coloring g 9; display ()</lang>

Python

See Solving Sudoku puzzles with Python for GPL'd solvers of increasing complexity of algorithm.

Tcl

Adapted from a page on the Tcler's Wiki to use a standard object system.

Note that you can implement more rules if you want. Just make another subclass of Rule and the solver will pick it up and use it automatically.

Works with: Tcl version 8.6

<lang tcl>package require Tcl 8.6 oo::class create Sudoku {

   variable idata

   method clear {} {

for {set y 0} {$y < 9} {incr y} { for {set x 0} {$x < 9} {incr x} { my set $x $y {} } }

   }
   method load {data} {

set error "data must be a 9-element list, each element also being a\ list of 9 numbers from 1 to 9 or blank or an @ symbol." if {[llength $data] != 9} { error $error } for {set y 0} {$y<9} {incr y} { set row [lindex $data $y] if {[llength $row] != 9} { error $error } for {set x 0} {$x<9} {incr x} { set d [lindex $row $x] if {![regexp {^[@1-9]?$} $d]} { error $d-$error } if {$d eq "@"} {set d ""} my set $x $y $d } }

   }
   method dump {} {

set rows {} for {set y 0} {$y < 9} {incr y} { lappend rows [my getRow 0 $y] } return $rows

   method Log msg {

# Chance to print message

   method set {x y value} {

if {[catch {set value [format %d $value]}]} {set value 0} if {$value<1 || $value>9} { set idata(sq$x$y) {} } else { set idata(sq$x$y) $value }

   }
   method get {x y} {

if {![info exists idata(sq$x$y)]} { return {} } return $idata(sq$x$y)

   method getRow {x y} {

set row {} for {set x 0} {$x<9} {incr x} { lappend row [my get $x $y] } return $row

   }
   method getCol {x y} {

set col {} for {set y 0} {$y<9} {incr y} { lappend col [my get $x $y] } return $col

   }
   method getRegion {x y} {

set xR [expr {($x/3)*3}] set yR [expr {($y/3)*3}] set regn {} for {set x $xR} {$x < $xR+3} {incr x} { for {set y $yR} {$y < $yR+3} {incr y} { lappend regn [my get $x $y] } } return $regn

}

SudokuSolver inherits from Sudoku, and adds the ability to filter
possibilities for a square by looking at all the squares in the row, column,
and region that the square is a part of. The method 'solve' contains a list
of rule-objects to use, and iterates over each square on the board, applying
each rule sequentially until the square is allocated.

oo::class create SudokuSolver {

   superclass Sudoku
   method validchoices {x y} {

if {[my get $x $y] ne {}} { return [my get $x $y] }

set row [my getRow $x $y] set col [my getCol $x $y] set regn [my getRegion $x $y] set eliminate [list {*}$row {*}$col {*}$regn] set eliminate [lsearch -all -inline -not $eliminate {}] set eliminate [lsort -unique $eliminate]

set choices {} for {set c 1} {$c < 10} {incr c} { if {$c ni $eliminate} { lappend choices $c } } if {[llength $choices]==0} { error "No choices left for square $x,$y" } return $choices

   }
   method completion {} {

return [expr { 81-[llength [lsearch -all -inline [join [my dump]] {}]] }]

   }
   method solve {} {

foreach ruleClass [info class subclass Rule] { lappend rules [$ruleClass new] }

while {1} { set begin [my completion] for {set y 0} {$y < 9} {incr y} { for {set x 0} {$x < 9} {incr x} { if {[my get $x $y] eq ""} { foreach rule $rules { set c [$rule solve [self] $x $y] if {$c} { my set $x $y $c my Log "[info object class $rule] solved [self] at $x,$y for $c" break } } } } } set end [my completion] if {$end==81} { my Log "Finished solving!" break } elseif {$begin==$end} { my Log "A round finished without solving any squares, giving up." break } } foreach rule $rules { $rule destroy }

}

Rule is the template for the rules used in Solver. The other rule-objects
apply their logic to the values passed in and return either '0' or a number
to allocate to the requested square.

oo::class create Rule {

   method solve {hSudoku x y} {

if {![info object isa typeof $hSudoku SudokuSolver]} { error "hSudoku must be an instance of class SudokuSolver." }

tailcall my Solve $hSudoku $x $y [$hSudoku validchoices $x $y]

}

Get all the allocated numbers for each square in the the row, column, and
region containing $x,$y. If there is only one unallocated number among all
three groups, it must be allocated at $x,$y

oo::class create RuleOnlyChoice {

   superclass Rule
   method Solve {hSudoku x y choices} {

if {[llength $choices]==1} { return $choices } else { return 0 }

}

Test each column to determine if $choice is an invalid choice for all other
columns in row $X. If it is, it must only go in square $x,$y.

oo::class create RuleColumnChoice {

   superclass Rule
   method Solve {hSudoku x y choices} {

foreach choice $choices { set failed 0 for {set x2 0} {$x2<9} {incr x2} { if {$x2 != $x && $choice in [$hSudoku validchoices $x2 $y]} { set failed 1 break } } if {!$failed} {return $choice} } return 0

}

Test each row to determine if $choice is an invalid choice for all other
rows in column $y. If it is, it must only go in square $x,$y.

oo::class create RuleRowChoice {

   superclass Rule
   method Solve {hSudoku x y choices} {

foreach choice $choices { set failed 0 for {set y2 0} {$y2<9} {incr y2} { if {$y2 != $y && $choice in [$hSudoku validchoices $x $y2]} { set failed 1 break } } if {!$failed} {return $choice} } return 0

}

Test each square in the region occupied by $x,$y to determine if $choice is
an invalid choice for all other squares in that region. If it is, it must
only go in square $x,$y.

oo::class create RuleRegionChoice {

   superclass Rule
   method Solve {hSudoku x y choices} {

foreach choice $choices { set failed 0 set regnX [expr {($x/3)*3}] set regnY [expr {($y/3)*3}] for {set y2 $regnY} {$y2 < $regnY+3} {incr y2} { for {set x2 $regnX} {$x2 < $regnX+3} {incr x2} { if { ($x2!=$x || $y2!=$y) && $choice in [$hSudoku validchoices $x2 $y2] } then { set failed 1 break } } } if {!$failed} {return $choice} } return 0

}</lang> Demonstration code: <lang tcl>SudokuSolver create sudoku sudoku load {

   {3 9 4    @ @ 2    6 7 @}
   {@ @ @    3 @ @    4 @ @}
   {5 @ @    6 9 @    @ 2 @}

   {@ 4 5    @ @ @    9 @ @}
   {6 @ @    @ @ @    @ @ 7}
   {@ @ 7    @ @ @    5 8 @}

   {@ 1 @    @ 6 7    @ @ 8}
   {@ @ 9    @ @ 8    @ @ @}
   {@ 2 6    4 @ @    7 3 5}

} sudoku solve

Simple pretty-printer for completed sudokus

puts +-----+-----+-----+ foreach line [sudoku dump] postline {0 0 1 0 0 1 0 0 1} {

   puts |[lrange $line 0 2]|[lrange $line 3 5]|[lrange $line 6 8]|
   if {$postline} {

puts +-----+-----+-----+

} sudoku destroy</lang> Sample output:

+-----+-----+-----+
|3 9 4|8 5 2|6 7 1|
|2 6 8|3 7 1|4 5 9|
|5 7 1|6 9 4|8 2 3|
+-----+-----+-----+
|1 4 5|7 8 3|9 6 2|
|6 8 2|9 4 5|3 1 7|
|9 3 7|1 2 6|5 8 4|
+-----+-----+-----+
|4 1 3|5 6 7|2 9 8|
|7 5 9|2 3 8|1 4 6|
|8 2 6|4 1 9|7 3 5|
+-----+-----+-----+

If we'd added a logger method (after creating the sudoku object but before running the solver) like this: <lang tcl>oo::objdefine sudoku method Log msg {puts $msg}</lang> Then this additional logging output would have been produced prior to the result being printed:

::RuleOnlyChoice solved ::sudoku at 8,0 for 1
::RuleColumnChoice solved ::sudoku at 1,1 for 6
::RuleRegionChoice solved ::sudoku at 4,1 for 7
::RuleRowChoice solved ::sudoku at 7,1 for 5
::RuleOnlyChoice solved ::sudoku at 8,1 for 9
::RuleColumnChoice solved ::sudoku at 1,2 for 7
::RuleColumnChoice solved ::sudoku at 5,2 for 4
::RuleRowChoice solved ::sudoku at 6,2 for 8
::RuleOnlyChoice solved ::sudoku at 8,2 for 3
::RuleColumnChoice solved ::sudoku at 3,3 for 7
::RuleRowChoice solved ::sudoku at 1,4 for 8
::RuleRowChoice solved ::sudoku at 5,4 for 5
::RuleRowChoice solved ::sudoku at 6,4 for 3
::RuleRowChoice solved ::sudoku at 0,5 for 9
::RuleOnlyChoice solved ::sudoku at 1,5 for 3
::RuleOnlyChoice solved ::sudoku at 0,6 for 4
::RuleOnlyChoice solved ::sudoku at 2,6 for 3
::RuleColumnChoice solved ::sudoku at 3,6 for 5
::RuleOnlyChoice solved ::sudoku at 6,6 for 2
::RuleOnlyChoice solved ::sudoku at 7,6 for 9
::RuleOnlyChoice solved ::sudoku at 0,7 for 7
::RuleOnlyChoice solved ::sudoku at 1,7 for 5
::RuleColumnChoice solved ::sudoku at 4,7 for 3
::RuleOnlyChoice solved ::sudoku at 6,7 for 1
::RuleOnlyChoice solved ::sudoku at 0,8 for 8
::RuleOnlyChoice solved ::sudoku at 4,8 for 1
::RuleOnlyChoice solved ::sudoku at 5,8 for 9
::RuleOnlyChoice solved ::sudoku at 3,0 for 8
::RuleOnlyChoice solved ::sudoku at 4,0 for 5
::RuleColumnChoice solved ::sudoku at 2,1 for 8
::RuleOnlyChoice solved ::sudoku at 5,1 for 1
::RuleOnlyChoice solved ::sudoku at 2,2 for 1
::RuleRowChoice solved ::sudoku at 0,3 for 1
::RuleColumnChoice solved ::sudoku at 4,3 for 8
::RuleColumnChoice solved ::sudoku at 5,3 for 3
::RuleOnlyChoice solved ::sudoku at 7,3 for 6
::RuleOnlyChoice solved ::sudoku at 8,3 for 2
::RuleOnlyChoice solved ::sudoku at 2,4 for 2
::RuleColumnChoice solved ::sudoku at 3,4 for 9
::RuleOnlyChoice solved ::sudoku at 4,4 for 4
::RuleOnlyChoice solved ::sudoku at 7,4 for 1
::RuleColumnChoice solved ::sudoku at 3,5 for 1
::RuleOnlyChoice solved ::sudoku at 4,5 for 2
::RuleOnlyChoice solved ::sudoku at 5,5 for 6
::RuleOnlyChoice solved ::sudoku at 8,5 for 4
::RuleOnlyChoice solved ::sudoku at 3,7 for 2
::RuleOnlyChoice solved ::sudoku at 7,7 for 4
::RuleOnlyChoice solved ::sudoku at 8,7 for 6
::RuleOnlyChoice solved ::sudoku at 0,1 for 2
Finished solving!

Ursala

<lang Ursala>#import std

import nat

sudoku =

@FL mat0+ block3+ mat` *+ block3*+ block9+ -+

  ~&rSL+ (psort (nleq+)* <~&blrl,~&blrr>)+ ~&arg^& -+
     ~&al?\~&ar ~&aa^&~&afahPRPfafatPJPRY+ ~&farlthlriNCSPDPDrlCS2DlrTS2J,
     ^|J/~& ~&rt!=+ ^= ~&s+ ~&H(
        -+.|=&lrr;,|=&lrl;,|=≪+-,
        ~&rgg&& ~&irtPFXlrjrXPS; ~&lrK2tkZ2g&& ~&llrSL2rDrlPrrPljXSPTSL)+-,
  //~&p ^|DlrDSLlrlPXrrPDSL(~&,num*+ rep2 block3)*= num block27 ~&iiK0 iota9,
  * `0?=\~&iNC ! ~&t digits+-</lang>

test program: <lang Ursala>#show+

example =

sudoku

-[ 394002670 000300400 500690020 045000900 600000007 007000580 010067008 009008000 026400735]-</lang> output:

394 852 671
268 371 459
571 694 823

145 783 962
682 945 317
937 126 584

413 567 298
759 238 146
826 419 735