Sudoku: Difference between revisions

From Rosetta Code
Content added Content deleted
(→‎{{header|PicoLisp}}: Added PureBasic)
Line 148: Line 148:
return r
return r
}</lang>
}</lang>

=={{header|BCPL}}==
<lang BCPL>// This can be run using Cintcode BCPL freely available from www.cl.cam.ac.uk/users/mr10.

GET "libhdr.h"
</lang>



=={{header|C}}==
=={{header|C}}==

Revision as of 11:53, 19 May 2010

Task
Sudoku
You are encouraged to solve this task according to the task description, using any language you may know.

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.

AutoHotkey

<lang AutoHotkey>#SingleInstance, Force SetBatchLines, -1 SetTitleMatchMode, 3 

   Loop 9 {
      r := A_Index, y := r*17-8 + (A_Index >= 7 ? 4 : A_Index >= 4 ? 2 : 0)
      Loop 9 {
         c := A_Index, x := c*17+5 + (A_Index >= 7 ? 4 : A_Index >= 4 ? 2 : 0)
         Gui, Add, Edit, x%x% y%y% w17 h17 v%r%_%c% Center Number Limit1 gNext
      }
   }
   Gui, Add, Button, vButton gSolve w175 x10 Center, Solve
   Gui, Add, Text, vMsg r3, Enter Sudoku puzzle and click Solve
   Gui, Show,, Sudoku Solver

Return

Solve: 

   Gui, Submit, NoHide
   Loop 9
   {
      r := A_Index
      Loop 9
         If (%r%_%A_Index% = "")
            puzzle .= "@"
         Else
            puzzle .= %r%_%A_Index%
   }
   s := A_TickCount
   answer := Sudoku(puzzle)
   iterations := ErrorLevel
   e := A_TickCount
   seconds := (e-s)/1000
   StringSplit, a, answer, |
   Loop 9
   {
      r := A_Index
      Loop 9
      {
         b := (r*9)+A_Index-9
         GuiControl,, %r%_%A_Index%, % a%b%
         GuiControl, +ReadOnly, %r%_%A_Index%
       }
   }
   if answer
       GuiControl,, Msg, Solved!`nTime: %seconds%s`nIterations: %iterations%
   else
       GuiControl,, Msg, Failed! :(`nTime: %seconds%s`nIterations: %iterations%
   GuiControl,, Button, Again!
   GuiControl, +gAgain, Button

return

GuiClose: 

   ExitApp

Again: 

   Reload
  1. IfWinActive, Sudoku Solver

~*Enter::GoSub % GetKeyState( "Shift", "P" ) ? "~Up" : "~Down" ~Up:: 

   GuiControlGet, f, focus
   StringTrimLeft, f, f, 4
   f := ((f >= 1 && f <= 9) ? f+72 : f-9)
   GuiControl, Focus, Edit%f%

return ~Down:: 

   GuiControlGet, f, focus
   StringTrimLeft, f, f, 4
   f := ((f >= 73 && f <= 81) ? f-72 : f + 9)
   GuiControl, Focus, Edit%f%

return ~Left:: 

   GuiControlGet, f, focus
   StringTrimLeft, f, f, 4
   f := Mod(f + 79, 81) + 1
   GuiControl, Focus, Edit%f%

return Next: ~Right:: 

   GuiControlGet, f, focus
   StringTrimLeft, f, f, 4
   f := Mod(f, 81) + 1
   GuiControl, Focus, Edit%f%

return

  1. IfWinActive
Functions Start here

Sudoku( p ) { ;ErrorLevel contains the number of iterations 

  p := RegExReplace(p, "[^1-9@]"), ErrorLevel := 0 ;format puzzle as single line string
  return Sudoku_Display(Sudoku_Solve(p))

}

Sudoku_Solve( p, d = 0 ) { ;d is 0-based

http://www.autohotkey.com/forum/topic46679.html
p
81 character puzzle string
(concat all 9 rows of 9 chars each)
givens represented as chars 1-9
fill-ins as any non-null, non 1-9 char
d
used internally. omit on initial call
returns
81 char string with non-givens replaced with valid solution
  If (d >= 81), ErrorLevel++
     return p  ;this is 82nd iteration, so it has successfully finished iteration 81
  If InStr( "123456789", SubStr(p, d+1, 1) ) ;this depth is a given, skip through
     return Sudoku_Solve(p, d+1)
  m := Sudoku_Constraints(p,d) ;a string of this level's constraints. 
  ; (these will not change for all 9 loops)
  Loop 9
  {
     If InStr(m, A_Index)
        Continue
     NumPut(Asc(A_Index), p, d, "Char")
     If r := Sudoku_Solve(p, d+1)
        return r
  }
  return 0

}

Sudoku_Constraints( ByRef p, d ) {

returns a string of the constraints for a particular position
    c := Mod(d,9)
  , r := (d - c) // 9
  , b := r//3*27 + c//3*3 + 1
  ;convert to 1-based
  , c++
  return ""
  ; row:
     . SubStr(p, r * 9 + 1, 9)
  ; column: 
     . SubStr(p,c   ,1) SubStr(p,c+9 ,1) SubStr(p,c+18,1)
     . SubStr(p,c+27,1) SubStr(p,c+36,1) SubStr(p,c+45,1)
     . SubStr(p,c+54,1) SubStr(p,c+63,1) SubStr(p,c+72,1)
  ;box
     . SubStr(p, b, 3) SubStr(p, b+9, 3) SubStr(p, b+18, 3)

}

Sudoku_Display( p ) { 

  If StrLen(p) = 81
     loop 81
        r .= SubStr(p, A_Index, 1) . "|"
  return r

}</lang>

BCPL

<lang BCPL>// This can be run using Cintcode BCPL freely available from www.cl.cam.ac.uk/users/mr10.

GET "libhdr.h"

</lang>


C

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

Clojure

<lang clojure>(ns sudoku 

 (:use [clojure.contrib.math :only (sqrt)]))

(defn print-grid [grid] 

 (doseq [y (range (count grid))]
   (doseq [x (range (count grid))]
     (print (retrieve grid x y) " "))
   (println))
 (println))

(defn retrieve [grid x y] 

 (get (get grid y) x))

(defn store [grid x y n] 

 (assoc grid y (assoc (get grid y) x n)))

(defn coordinates [grid x y] 

 (let [n (sqrt (count grid))
       zx (* n (quot x n))
       zy (* n (quot y n))]
   (for [x (range zx (+ zx n)) y (range zy (+ zy n))]
     [x y])))

(defn compatible? [grid x y n] 

 (or
  (= n (retrieve grid x y))
  (and
   (zero? (retrieve grid x y))
   (every? #(and (not= n (retrieve grid % y)) (not= n (retrieve grid x %))) (range (count grid)))
   (every? #(not= n (retrieve grid (first %) (second %))) (coordinates grid x y)))))

(defn solve [grid x y] 

 (let [m (count grid)]
   (if (= y m)
     (print-grid grid)
     (doseq [n (range 1 (inc m))]
       (when (compatible? grid x y n)
         (let [new-grid (store grid x y n)]
           (if (= x (dec m))
             (solve new-grid 0 (inc y))
             (solve new-grid (inc x) y))))))))

</lang>

<lang clojure>sudoku> (solve [[3 9 4 0 0 2 6 7 0] 

              [0 0 0 3 0 0 4 0 0]
              [5 0 0 6 9 0 0 2 0]
              [0 4 5 0 0 0 9 0 0]
              [6 0 0 0 0 0 0 0 7]
              [0 0 7 0 0 0 5 8 0]
              [0 1 0 0 6 7 0 0 8]
              [0 0 9 0 0 8 0 0 0]
              [0 2 6 4 0 0 7 3 5]]
              0 0)

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

nil </lang>

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))

D

<lang d>import std.stdio;

bool[char]genFull() { 

       return ['1':true,
               '2':true,
               '3':true,
               '4':true,
               '5':true,
               '6':true,
               '7':true,
               '8':true,
               '9':true];

} // these three functions assume that the number has not already been found bool[char]availRow(int x,int y,bool[char]available=genFull()) { 

       // x designates row, y designates column
       foreach(ele;puzzle[x]) {
               if (ele != '_') available.remove(ele);
       }
       return available;

}

bool[char]availCol(int x,int y,bool[char]available=genFull()) { 

       // x designates row, y designates column
       for(int i = 0;i<9;i++) {
               if (puzzle[i][y] != '_') available.remove(puzzle[i][y]);
       }
       return available;

}

bool[char]availBox(int x,int y,bool[char]available=genFull()) { 

       // x designates row, y designates column
       // get a base index for the boxes
       int bx = x/3;bx*=3;
       int by = y/3;by*=3;
       for(int i = 0;i<3;i++) for(int j = 0;j<3;j++) {
               if (puzzle[bx+i][by+j] != '_') available.remove(puzzle[bx+i][by+j]);
       }
       return available;

}

char[][]puzzle; void main() { 

       puzzle ~= "394__267_".dup;
       puzzle ~= "___3__4__".dup;
       puzzle ~= "5__69__2_".dup;
       puzzle ~= "_45___9__".dup;
       puzzle ~= "6_______7".dup;
       puzzle ~= "__7___58_".dup;
       puzzle ~= "_1__67__8".dup;
       puzzle ~= "__9__8___".dup;
       puzzle ~= "_264__735".dup;
       while(1) {
               bool done = true;
               foreach(i,row;puzzle) foreach(j,ref ele;row) if (ele == '_') {
                       // poke at the elements that are _
                       auto remaining = availBox(i,j,availRow(i,j,availCol(i,j)));
                       if (remaining.keys.length == 1) ele = remaining.keys[0];
                       else done = false;
               }
               if (done) break;
       }
       // write out completed puzzle
       writefln("Completed puzzle:");
       foreach(row;puzzle) writefln("%s",row);

}</lang>

Forth

Works with: 4tH version 3.60.0

<lang forth>include lib/interprt.4th include lib/istype.4th include lib/argopen.4th

\ --------------------- \ Variables \ ---------------------

81 string sudokugrid 9 array sudoku_row 9 array sudoku_col 9 array sudoku_box

\ ------------- \ 4tH interface \ -------------

>grid ( n2 a1 n1 -- n3)
 rot dup >r 9 chars * sudokugrid + dup >r swap
 0 do                                 ( a1 a2)
   over i chars + c@ dup is-digit     ( a1 a2 c f)
   if [char] 0 - over c! char+ else drop then
 loop                                 ( a1 a2)
 nip r> - 9 /  r> +                   ( n3)

0 s" 090004007" >grid s" 000007900" >grid s" 800000000" >grid s" 405800000" >grid s" 300000002" >grid s" 000009706" >grid s" 000000004" >grid s" 003500000" >grid s" 200600080" >grid drop

\ --------------------- \ Logic \ --------------------- \ Basically : \ Grid is parsed. All numbers are put into sets, which are \ implemented as bitmaps (sudoku_row, sudoku_col, sudoku_box) \ which represent sets of numbers in each row, column, box. \ only one specific instance of a number can exist in a \ particular set.

\ SOLVER is recursively called \ SOLVER looks for the next best guess using FINDNEXTSPACE \ tries this trail down... if fails, backtracks... and tries \ again.


\ Grid Related

xy 9 * + ; \ x y -- offset ;
getrow 9 / ;
getcol 9 mod ;
getbox dup getrow 3 / 3 * swap getcol 3 / + ;

\ Puts and gets numbers from/to grid only

setnumber sudokugrid + c! ; \ n position --
getnumber sudokugrid + c@ ;
cleargrid sudokugrid 81 bounds do 0 i c! loop ;

\ -------------- \ Set related: sets are sudoku_row, sudoku_col, sudoku_box

\ ie x y --  ; adds x into bitmap y

addbits_row cells sudoku_row + dup @ rot 1 swap lshift or swap ! ;
addbits_col cells sudoku_col + dup @ rot 1 swap lshift or swap ! ;
addbits_box cells sudoku_box + dup @ rot 1 swap lshift or swap ! ;

\ ie x y --  ; remove number x from bitmap y

removebits_row cells sudoku_row + dup @ rot 1 swap lshift invert and swap ! ;
removebits_col cells sudoku_col + dup @ rot 1 swap lshift invert and swap ! ;
removebits_box cells sudoku_box + dup @ rot 1 swap lshift invert and swap ! ;

\ clears all bitsmaps to 0

clearbitmaps 9 0 do i cells
                    0 over sudoku_row + !
                    0 over sudoku_col + !
                    0 swap sudoku_box + !
          loop ;

\ Adds number to grid and sets

addnumber \ number position --
   2dup setnumber
   2dup getrow addbits_row
   2dup getcol addbits_col
        getbox addbits_box

\ Remove number from grid, and sets

removenumber \ position --
   dup getnumber swap    
   2dup getrow removebits_row
   2dup getcol removebits_col
   2dup getbox removebits_box
   nip 0 swap setnumber

\ gets bitmap at position, ie \ position -- bitmap

getrow_bits getrow cells sudoku_row + @ ;
getcol_bits getcol cells sudoku_col + @ ;
getbox_bits getbox cells sudoku_box + @ ;

\ position -- composite bitmap (or'ed)

getbits
   dup getrow_bits
   over getcol_bits
   rot getbox_bits or or

\ algorithm from c.l.f circa 1995 ? Will Baden

countbits ( number -- bits )
       [HEX] DUP  55555555 AND  SWAP  1 RSHIFT  55555555 AND  +
             DUP  33333333 AND  SWAP  2 RSHIFT  33333333 AND  +
             DUP  0F0F0F0F AND  SWAP  4 RSHIFT  0F0F0F0F AND  +
       [DECIMAL] 255 MOD

\ Try tests a number in a said position of grid \ Returns true if it's possible, else false.

try \ number position -- true/false
     getbits 1 rot lshift and 0=

\ --------------

parsegrid \ Parses Grid to fill sets.. Run before solver.
  sudokugrid                          \ to ensure all numbers are parsed into sets/bitmaps
  81 0 do
    dup i + c@                            
      dup if                              
        dup i try if                    
          i addnumber                          
        else
          unloop drop drop FALSE exit      
        then  
      else
        drop
      then
  loop
  drop
  TRUE

\ Morespaces? manually checks for spaces ... \ Obviously this can be optimised to a count var, done initially \ Any additions/subtractions made to the grid could decrement \ a 'spaces' variable.

morespaces?
    0  sudokugrid 81 bounds do i c@  0= if 1+ then loop ;
findnextmove \ -- n ; n = index next item, if -1 finished.
  -1  10                              \  index  prev_possibilities  --
                                      \  err... yeah... local variables, kind of...

  81 0 do
     i sudokugrid + c@ 0= IF
            i getbits countbits 9 swap -

            \ get bitmap and see how many possibilities
            \ stack diagram:
            \ index prev_possibilities  new_possiblities --

            2dup > if          
                                      \ if new_possibilities < prev_possibilities...
                nip nip i swap  
                                      \ new_index new_possibilies --

            else                      \ else prev_possibilities < new possibilities, so:

                drop                  \ new_index new_possibilies --        

            then                
     THEN
  loop
  drop

\ findnextmove returns index of best next guess OR returns -1 \ if no more guesses. You then have to check to see if there are \ spaces left on the board unoccupied. If this is the case, you \ need to back up the recursion and try again.

solver
    findnextmove
        dup 0< if
            morespaces? if
               drop false exit
            else
               drop true exit
            then
        then

    10 1 do
       i over try if          
          i over addnumber
          recurse  if
               drop unloop TRUE EXIT
          else
               dup removenumber
          then
       then
    loop

    drop FALSE

\ SOLVER

startsolving
  clearbitmaps                        \ reparse bitmaps and reparse grid
  parsegrid                           \ just in case..
  solver
  AND

\ --------------------- \ Display Grid \ ---------------------

\ Prints grid nicely

.sudokugrid
 CR CR
 sudokugrid
 81 0 do
   dup i + c@ .
   i 1+
     dup 3 mod 0= if
        dup 9 mod 0= if
           CR
           dup 27 mod 0= if
             dup 81 < if ." ------+-------+------" CR then
           then
        else
          ." | "
        then      
     then
   drop
 loop
 drop
 CR

\ --------------------- \ Higher Level Words \ ---------------------

checkifoccupied ( offset -- t/f)
   sudokugrid + c@
add ( n x y --)
   xy 2dup
     dup checkifoccupied if
       dup removenumber
     then
   try if
     addnumber
     .sudokugrid
   else
     CR ." Not a valid move. " CR
     2drop
   then
rm
   xy removenumber
   .sudokugrid
clearit
   cleargrid
   clearbitmaps
   .sudokugrid
solveit
 CR 
 startsolving
 if
   ." Solution found!" CR .sudokugrid
 else
   ." No solution found!" CR CR
 then
showit .sudokugrid ;

\ Print help menu

help
 CR
 ." Type clearit     ; to clear grid " CR
 ."      1-9 x y add ; to add 1-9 to grid at x y (0 based) " CR
 ."      x y rm      ; to remove number at x y " CR
 ."      showit      ; redisplay grid " CR
 ."      solveit     ; to solve " CR
 ."      help        ; for help " CR
 CR

\ --------------------- \ Execution starts here \ ---------------------

godoit
   clearbitmaps
   parsegrid if
     CR ." Grid valid!"
   else
     CR ." Warning: grid invalid!"
   then
   .sudokugrid
   help

\ ------------- \ 4tH interface \ -------------

read-sudoku
 input 1 arg-open 0
 begin dup 9 < while refill while 0 parse >grid repeat
 drop close
bye quit ;

create wordlist \ dictionary 

 ," clearit" ' clearit ,
 ," add"     ' add ,
 ," rm"      ' rm ,
 ," showit"  ' showit ,
 ," solveit" ' solveit ,
 ," quit"    ' bye ,
 ," exit"    ' bye ,
 ," bye"     ' bye ,
 ," q"       ' bye ,
 ," help"    ' help ,
 NULL ,

wordlist to dictionary

noname ." Unknown command '" type ." '" cr ; is NotFound
                                      \ sudoku interpreter
sudoku
 argn 1 > if read-sudoku then
 godoit
 begin
   ." OK" cr
   refill drop ['] interpret
   catch if ." Error" cr then
 again

sudoku</lang>

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>

Oz

Using built-in constraint propagation and search.

<lang oz>declare 

 %% a puzzle is a function that returns an initial board configuration
 fun {Puzzle1}
    %% a board is a list of 9 rows
    [[4 _ _  _ _ _  _ 6 _]
     [5 _ _  _ 8 _  9 _ _]
     [3 _ _  _ _ 1  _ _ _]
   
     [_ 2 _  7 _ _  _ _ 1]
     [_ 9 _  _ _ _  _ 4 _]
     [8 _ _  _ _ 3  _ 5 _]
   
     [_ _ _  2 _ _  _ _ 7]
     [_ _ 6  _ 5 _  _ _ 8] 
     [_ 1 _  _ _ _  _ _ 6]]
 end

 %% Returns a list of solutions for the given puzzle.
 fun {Solve Puzzle}
    {SearchAll {GetScript Puzzle}}
 end

 %% Creates a solver script for a puzzle.
 fun {GetScript Puzzle}
    proc {$ Board}
       %% Every row is a list of nine finite domain vars
       %% with the domain 1..9.
       Board = {MapRange fun {$ _} {FD.list 9 1#9} end}
       %% Post initial configuration.
       Board = {Puzzle}
       
       %% The core constraints:
       {ForAll {Rows Board} FD.distinct}
       {ForAll {Columns Board} FD.distinct}
       {ForAll {Boxes Board} FD.distinct}

       %% Search if necessary.
       {FD.distribute ff {Flatten Board}}
    end
 end

 %% Returns the board as a list of rows.
 fun {Rows Board}
    Board %% This is already the representation we have chosen.
 end

 %% Returns the board as a list of columns.
 fun {Columns Board}
    {MapRange fun {$ I} {Column Board I} end}
 end

 %% Returns the board as a list of boxes (sub-grids).
 fun {Boxes Board}
    {MapRange fun {$ I} {Box Board I} end}
 end

 %% Helper function: map the range 1..9 to something.
 fun {MapRange F}
    {Map [1 2 3 4 5 6 7 8 9] F}
 end

 %% Returns a column of the board as a list of fields.
 fun {Column Board Index}
    {Map Board
     fun {$ Row}
        {Nth Row Index}
     end
    }
 end

 %% Returns a box of the board as a list of fields.
 fun {Box Board Index}
    Index0 = Index-1
    Fields = {Flatten Board}
    Start = (Index0 div 3) * 27 + (Index0 mod 3)*3   
 in
    {Flatten
     for I in 0..2 collect:C do
        {C {List.take {List.drop Fields Start+I*9} 3}}
     end
    }
 end

in 

 {Inspect {Solve Puzzle1}.1}</lang>

PicoLisp

<lang PicoLisp>(load "lib/simul.l")

      1. Fields/Board ###
  2. val lst

(setq 

  *Board (grid 9 9)
  *Fields (apply append *Board) )
  1. Init values to zero (empty)

(for L *Board 

  (for This L
     (=: val 0) ) )
  1. Build lookup lists

(for (X . L) *Board 

  (for (Y . This) L
     (=: lst
        (make
           (let A (* 3 (/ (dec X) 3))
              (do 3
                 (inc 'A)
                 (let B (* 3 (/ (dec Y) 3))
                    (do 3
                       (inc 'B)
                       (unless (and (= A X) (= B Y))
                          (link
                             (prop (get *Board A B) 'val) ) ) ) ) ) )
           (for Dir '(`west `east `south `north)
              (for (This (Dir This)  This  (Dir This))
                 (unless (memq (:: val) (made))
                    (link (:: val)) ) ) ) ) ) ) )
  1. Cut connections (for display only)

(for (X . L) *Board 

  (for (Y . This) L
     (when (member X (3 6))
        (con (car (val This))) )
     (when (member Y (4 7))
        (set (cdr (val This))) ) ) )
  1. Display board

(de display () 

  (disp *Board 0
     '((This)
        (if (=0 (: val))
           "   "
           (pack " " (: val) " ") ) ) ) )
  1. Initialize board

(de main (Lst) 

  (for (Y . L) Lst
     (for (X . N) L
        (put *Board X (- 10 Y) 'val N) ) )
  (display) )
  1. Find solution

(de go () 

  (unless
     (recur (*Fields)
        (with (car *Fields)
           (if (=0 (: val))
              (loop
                 (NIL
                    (or
                       (assoc (inc (:: val)) (: lst))
                       (recurse (cdr *Fields)) ) )
                 (T (= 9 (: val)) (=: val 0)) )
              (recurse (cdr *Fields)) ) ) )
     (display) ) )

(main 

  (quote
     (5 3 0 0 7 0 0 0 0)
     (6 0 0 1 9 5 0 0 0)
     (0 9 8 0 0 0 0 6 0)
     (8 0 0 0 6 0 0 0 3)
     (4 0 0 8 0 3 0 0 1)
     (7 0 0 0 2 0 0 0 6)
     (0 6 0 0 0 0 2 8 0)
     (0 0 0 4 1 9 0 0 5)
     (0 0 0 0 8 0 0 7 9) ) )</lang>

Output: 

   +---+---+---+---+---+---+---+---+---+
 9 | 5   3     |     7     |           |
   +   +   +   +   +   +   +   +   +   +
 8 | 6         | 1   9   5 |           |
   +   +   +   +   +   +   +   +   +   +
 7 |     9   8 |           |     6     |
   +---+---+---+---+---+---+---+---+---+
 6 | 8         |     6     |         3 |
   +   +   +   +   +   +   +   +   +   +
 5 | 4         | 8       3 |         1 |
   +   +   +   +   +   +   +   +   +   +
 4 | 7         |     2     |         6 |
   +---+---+---+---+---+---+---+---+---+
 3 |     6     |           | 2   8     |
   +   +   +   +   +   +   +   +   +   +
 2 |           | 4   1   9 |         5 |
   +   +   +   +   +   +   +   +   +   +
 1 |           |     8     |     7   9 |
   +---+---+---+---+---+---+---+---+---+
     a   b   c   d   e   f   g   h   i

<lang>(go)</lang> Output: 

   +---+---+---+---+---+---+---+---+---+
 9 | 5   3   4 | 6   7   8 | 9   1   2 |
   +   +   +   +   +   +   +   +   +   +
 8 | 6   7   2 | 1   9   5 | 3   4   8 |
   +   +   +   +   +   +   +   +   +   +
 7 | 1   9   8 | 3   4   2 | 5   6   7 |
   +---+---+---+---+---+---+---+---+---+
 6 | 8   5   9 | 7   6   1 | 4   2   3 |
   +   +   +   +   +   +   +   +   +   +
 5 | 4   2   6 | 8   5   3 | 7   9   1 |
   +   +   +   +   +   +   +   +   +   +
 4 | 7   1   3 | 9   2   4 | 8   5   6 |
   +---+---+---+---+---+---+---+---+---+
 3 | 9   6   1 | 5   3   7 | 2   8   4 |
   +   +   +   +   +   +   +   +   +   +
 2 | 2   8   7 | 4   1   9 | 6   3   5 |
   +   +   +   +   +   +   +   +   +   +
 1 | 3   4   5 | 2   8   6 | 1   7   9 |
   +---+---+---+---+---+---+---+---+---+
     a   b   c   d   e   f   g   h   i

PureBasic

A brute force method is used, it seemed the fastest as well as the simplest. <lang PureBasic>DataSection 

 puzzle:
 Data.s "394002670"
 Data.s "000300400"
 Data.s "500690020"
 Data.s "045000900"
 Data.s "600000007"
 Data.s "007000580"
 Data.s "010067008"
 Data.s "009008000"
 Data.s "026400735"

EndDataSection

  1. IsPossible = 0
  2. IsNotPossible = 1
  3. Unknown = 0

Global Dim sudoku(8, 8)

-declarations

Declare readSudoku() Declare displaySudoku() Declare.s buildpossible(x, y, Array possible.b(1)) Declare solvePuzzle(x = 0, y = 0)

-procedures

Procedure readSudoku() 

 Protected a$, row, column
 
 Restore puzzle
 For row = 0 To 8 
   Read.s a$  
   For column = 0 To 8
     sudoku(column, row) = Val(Mid(a$, column + 1, 1))
   Next
 Next

EndProcedure

Procedure displaySudoku() 

 Protected row, column 
 Static border.s = "+-----+-----+-----+"
 For row = 0 To 8
   If row % 3 = 0: PrintN(border): EndIf
   For column = 0 To 8
     If column % 3 = 0: Print("|"): Else: Print(" "): EndIf
     If sudoku(column, row): Print(Str(sudoku(column, row))): Else: Print("."): EndIf
   Next
   PrintN("|")
 Next
 PrintN(border)

EndProcedure

Procedure.s buildpossible(x, y, Array possible.b(1)) 

 Protected index, column, row, boxColumn = (x / 3) * 3, boxRow = (y / 3) * 3
 Dim possible.b(9)

 For index = 0 To 8 
   possible(sudoku(index, y)) = #IsNotPossible ;record possibles in column
   possible(sudoku(x, index)) = #IsNotPossible ;record possibles in row
 Next
 
 ;record possibles in box
 For row = boxRow To boxRow + 2
   For column = boxColumn To boxColumn + 2 
     possible(sudoku(column, row)) = #IsNotPossible
   Next 
 Next

EndProcedure

Procedure solvePuzzle(x = 0, y = 0) 

 Protected row, column, spot, digit
 Dim possible.b(9)
 
 For row = y To 8
   For column = x To 8
     If sudoku(column, row) = #Unknown
       buildpossible(column, row, possible())
       
       For digit =  1 To 9                                   
         If possible(digit) = #IsPossible
           sudoku(column, row) = digit
           spot = row * 9 + column + 1
           If solvePuzzle(spot % 9, spot / 9)
             Break 3
           EndIf   
         EndIf
       Next

       If digit = 10
         sudoku(column, row) = #Unknown
         ProcedureReturn #False
       EndIf 
     EndIf 
   Next 
   x = 0 ;reset column start point
 Next 
 ProcedureReturn #True

EndProcedure

If OpenConsole() 

 readSudoku()
 displaySudoku()
 If solvePuzzle()
   PrintN("Solved.")
   displaySudoku()
 Else
   PrintN("Unable to solve puzzle") ;due to bad starting data
 EndIf 
 
 Print(#CRLF$ + #CRLF$ + "Press ENTER to exit")
 Input()
 CloseConsole()

EndIf </lang> Sample output: 

+-----+-----+-----+
|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|
+-----+-----+-----+
Solved.
+-----+-----+-----+
|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|
+-----+-----+-----+

Python

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

Ruby

Example of a back-tracking solver, from wp:Algorithmics of sudoku

Works with: Ruby version 1.8.7+

<lang ruby>def read_matrix(fh) 

 matrix = []

 (0..8).each { |i|
   l = fh.readline
   matrix[i] = []
   (0..8).each { |j|
     matrix[i][j] = l[j..j].to_i
   }
 }
 matrix

end

def permissible(matrix, i, j) 

 ok = [true] * 9
 # Same as another in the column isn't permissible...
 (0..8).each { |i2|
   next if matrix[i2][j] == 0
   ok[matrix[i2][j] - 1] = false
 }
 # Same as another in the row isn't permissible...
 (0..8).each { |j2|
   next if matrix[i][j2] == 0
   ok[matrix[i][j2] - 1] = false
 }
 # Same as another in the 3x3 block isn't permissible...
 igroup = (i / 3) * 3
 jgroup = (j / 3) * 3
 (igroup..(igroup + 2)).each { |i2|
   (jgroup..(jgroup + 2)).each { |j2|
     next if matrix[i2][j2] == 0
     ok[matrix[i2][j2] - 1] = false
   }
 }
 # Convert to the array format...
 (1..9).select { |i2| ok[i2-1] }

end

def deep_copy_sudoku(matrix) 

 matrix.collect { |row| row.dup }

end

def solve_sudoku(matrix) 

 loop do
   options = []
   (0..8).each { |i|
     (0..8).each { |j|
       next if matrix[i][j] != 0
       p = permissible(matrix, i, j)
       # If nothing is permissible, there is no solution at this level.
       return nil if p.length == 0
       options.push({:i => i, :j => j, :permissible => p})
     }
   }
   # If the matrix is complete, we have a solution...
   return matrix if options.length == 0

   omin = options.min_by { |x| x[:permissible].length }

   # If there is an option with only one solution, set it and re-check permissibility
   if omin[:permissible].length == 1
     matrix[omin[:i]][omin[:j]] = omin[:permissible][0]
     next
   end

   # We have two or more choices. We need to search both...
   omin[:permissible].each { |v|
     mtmp = deep_copy_sudoku(matrix)
     mtmp[omin[:i]][omin[:j]] = v
     ret = solve_sudoku(mtmp)
     return ret if ret
   }

   # We did an exhaustive search on this branch and nothing worked out.
   return nil
 end

end

def print_matrix(matrix) 

 if not matrix
   puts "Impossible"
   return
 end

 border = "+-----+-----+-----+"
 (0..8).each { |i|
   puts border if i%3 == 0
   (0..8).each { |j|
     print(j%3 == 0 ? "|" : " ")
     print(matrix[i][j] == 0 ? "." : matrix[i][j])
   }
   print "|\n"
 }
 puts border

end

matrix = read_matrix(DATA) print_matrix(matrix) puts print_matrix(solve_sudoku(matrix))

__END__ 394__267_ ___3__4__ 5__69__2_ _45___9__ 6_______7 __7___58_ _1__67__8 __9__8___ _264__735</lang>

output 

+-----+-----+-----+
|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|
+-----+-----+-----+

+-----+-----+-----+
|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|
+-----+-----+-----+

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 

   }

}

  1. SudokuSolver inherits from Sudoku, and adds the ability to filter
  2. possibilities for a square by looking at all the squares in the row, column,
  3. and region that the square is a part of. The method 'solve' contains a list
  4. of rule-objects to use, and iterates over each square on the board, applying
  5. 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 } 

   }

}

  1. Rule is the template for the rules used in Solver. The other rule-objects
  2. apply their logic to the values passed in and return either '0' or a number
  3. 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] 

   }

}

  1. Get all the allocated numbers for each square in the the row, column, and
  2. region containing $x,$y. If there is only one unallocated number among all
  3. 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 } 

   }

}

  1. Test each column to determine if $choice is an invalid choice for all other
  2. 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 

   }

}

  1. Test each row to determine if $choice is an invalid choice for all other
  2. 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 

   }

}

  1. Test each square in the region occupied by $x,$y to determine if $choice is
  2. an invalid choice for all other squares in that region. If it is, it must
  3. 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

  1. 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

  1. 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
Retrieved from "https://rosettacode.org/wiki/Sudoku?oldid=121082"