I'm working on modernizing Rosetta Code's infrastructure. Starting with communications. Please accept this time-limited open invite to RC's Slack.. --Michael Mol (talk) 20:59, 30 May 2020 (UTC)

# Sudoku

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.

references

## 11l

Translation of: Kotlin
T Sudoku
solved = 0B
grid = [0] * 81

F (rows)
assert(rows.len == 9 & all(rows.map(row -> row.len == 9)), ‘Grid must be 9 x 9’)
L(i) 9
L(j) 9
.grid[9 * i + j] = Int(rows[i][j])

F solve()
print("Starting grid:\n\n"(.))
.placeNumber(0)
print(I .solved {"Solution:\n\n"(.)} E ‘Unsolvable!’)

F placeNumber(pos)
I .solved
R
I pos == 81
.solved = 1B
R

I .grid[pos] > 0
.placeNumber(pos + 1)
R

L(n) 1..9
I .checkValidity(n, pos % 9, pos I/ 9)
.grid[pos] = n
.placeNumber(pos + 1)
I .solved
R
.grid[pos] = 0

F checkValidity(v, x, y)
L(i) 9
I .grid[y * 9 + i] == v |
.grid[i * 9 + x] == v
R 0B

V startX = (x I/ 3) * 3
V startY = (y I/ 3) * 3
L(i) startY .< startY + 3
L(j) startX .< startX + 3
I .grid[i * 9 + j] == v
R 0B

R 1B

F String()
V s = ‘’
L(i) 9
L(j) 9
s ‘’= .grid[i * 9 + j]‘ ’
I j C (2, 5)
s ‘’= ‘| ’
s ‘’= "\n"
I i C (2, 5)
s ‘’= "------+-------+------\n"
R s

V rows = [‘850002400’,
‘720000009’,
‘004000000’,
‘000107002’,
‘305000900’,
‘040000000’,
‘000080070’,
‘017000000’,
‘000036040’]

Sudoku(rows).solve()
Output:
Starting grid:

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

Solution:

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

## 8th

\
\ Simple iterative backtracking Sudoku solver for 8th
\
needs array/each-slice

[ 00, 00, 00, 03, 03, 03, 06, 06, 06,
00, 00, 00, 03, 03, 03, 06, 06, 06,
00, 00, 00, 03, 03, 03, 06, 06, 06,
27, 27, 27, 30, 30, 30, 33, 33, 33,
27, 27, 27, 30, 30, 30, 33, 33, 33,
27, 27, 27, 30, 30, 30, 33, 33, 33,
54, 54, 54, 57, 57, 57, 60, 60, 60,
54, 54, 54, 57, 57, 57, 60, 60, 60,
54, 54, 54, 57, 57, 57, 60, 60, 60 ] constant top-left-cell

\ Bit number presentations
a:new 2 b:new b:clear a:push ( 2 b:new b:clear swap 1 b:bit! a:push ) 0 8 loop constant posbit

: posbit? \ n -- s
posbit swap a:@ nip ;

: search \ b -- n
null swap
( dup -rot b:[email protected] if rot drop break else nip then ) 0 8 loop
swap ;

: b-or \ b b -- b
' n:bor b:op ;

: b-and \ b b -- b
' n:band b:op ;

: b-xor \ b b -- b
b:xor
[ xff, x01 ] b:new
b-and ;

: b-not \ b -- b
xff b:xor
[ xff, x01 ] b:new
b-and ;

: b-any \ a -- b
' b-or 0 posbit? a:reduce ;

: row \ a row -- a
9 n:* 9 a:slice ;

: col \ a col -- a
-1 9 a:slice+ ;

\ For testing sub boards
: sub \ a n -- a
top-left-cell swap a:@ nip over over 3 a:slice
-rot 9 n:+ 2dup 3 a:slice
-rot 9 n:+ 3 a:slice
a:+ a:+ ;

a:new 0 args "Give Sudoku text file as param" thrownull
f:slurp "Cannot read file" thrownull >s "" s:/
' >n a:map ( posbit? a:push ) a:each! drop constant board

: display-board
board ( search nip -1 ?: n:1+ ) a:map
"+-----+-----+-----+\n"
"|%d %d %d|%d %d %d|%d %d %d|\n" s:+
"|%d %d %d|%d %d %d|%d %d %d|\n" s:+
"|%d %d %d|%d %d %d|%d %d %d|\n" s:+
"+-----+-----+-----+\n" s:+
"|%d %d %d|%d %d %d|%d %d %d|\n" s:+
"|%d %d %d|%d %d %d|%d %d %d|\n" s:+
"|%d %d %d|%d %d %d|%d %d %d|\n" s:+
"+-----+-----+-----+\n" s:+
"|%d %d %d|%d %d %d|%d %d %d|\n" s:+
"|%d %d %d|%d %d %d|%d %d %d|\n" s:+
"|%d %d %d|%d %d %d|%d %d %d|\n" s:+
"+-----+-----+-----+\n" s:+
s:strfmt . ;

\ Store move history
a:new constant history

\ Possible numbers for a cell
: candidates? \ n -- s
dup dup 9 n:/ n:int swap 9 n:mod \ row col
board swap col b-any
board rot row b-any
b-or
board rot sub b-any
b-or
b-not ;

\ If found: -- n T
: find-free-cell
false
board ( 0 posbit? b:= if nip true break else drop then ) a:each drop ;

: validate
true
board
( dup -rot a:@ swap 2 pick 0 posbit? a:! 2 pick candidates? 2 pick b:= if
-rot a:!
else
2drop drop
false swap
break
then ) 0 80 loop drop ;

: solve
repeat
find-free-cell if
dup candidates?
repeat
search null? if
drop board -rot a:! drop
history a:len 0 n:= if
drop false ;;
then
a:pop nip
a:open
else
n:1+ posbit?
dup
board 4 pick rot a:! drop
b-xor
2 a:close
history swap a:push drop
break
then
again
else
validate
break
then
again ;

: app:main
"Sudoku puzzle:\n" .
display-board cr
solve if
"Sudoku solved:\n" .
display-board
else
"No solution!\n" .
then ;

Translation of: C++

procedure Sudoku is
type sudoku_ar_t is array ( integer range 0..80 ) of integer range 0..9;
FINISH_EXCEPTION : exception;

procedure prettyprint(sudoku_ar: sudoku_ar_t);
function checkValidity( val : integer; x : integer; y : integer; sudoku_ar: in sudoku_ar_t) return Boolean;
procedure placeNumber(pos: Integer; sudoku_ar: in out sudoku_ar_t);
procedure solve(sudoku_ar: in out sudoku_ar_t);

function checkValidity( val : integer; x : integer; y : integer; sudoku_ar: in sudoku_ar_t) return Boolean
is
begin
for i in 0..8 loop

if ( sudoku_ar( y * 9 + i ) = val or sudoku_ar( i * 9 + x ) = val ) then
return False;
end if;
end loop;

declare
startX : constant integer := ( x / 3 ) * 3;
startY : constant integer := ( y / 3 ) * 3;
begin
for i in startY..startY+2 loop
for j in startX..startX+2 loop
if ( sudoku_ar( i * 9 +j ) = val ) then
return False;
end if;
end loop;
end loop;
return True;
end;
end checkValidity;

procedure placeNumber(pos: Integer; sudoku_ar: in out sudoku_ar_t)
is
begin
if ( pos = 81 ) then
raise FINISH_EXCEPTION;
end if;
if ( sudoku_ar(pos) > 0 ) then
placeNumber(pos+1, sudoku_ar);
return;
end if;
for n in 1..9 loop
if( checkValidity( n, pos mod 9, pos / 9 , sudoku_ar ) ) then
sudoku_ar(pos) := n;
placeNumber(pos + 1, sudoku_ar );
sudoku_ar(pos) := 0;
end if;
end loop;
end placeNumber;

procedure solve(sudoku_ar: in out sudoku_ar_t)
is
begin
placeNumber( 0, sudoku_ar );
exception
when FINISH_EXCEPTION =>
prettyprint(sudoku_ar);
end solve;

procedure prettyprint(sudoku_ar: sudoku_ar_t)
is
line_sep  : constant String  := "------+------+------";
begin
for i in sudoku_ar'Range loop
if (i+1) mod 3 = 0 and not((i+1) mod 9 = 0) then
end if;
if (i+1) mod 9 = 0 then
end if;
if (i+1) mod 27 = 0 then
end if;
end loop;
end prettyprint;

sudoku_ar : sudoku_ar_t :=
(
8,5,0,0,0,2,4,0,0,
7,2,0,0,0,0,0,0,9,
0,0,4,0,0,0,0,0,0,
0,0,0,1,0,7,0,0,2,
3,0,5,0,0,0,9,0,0,
0,4,0,0,0,0,0,0,0,
0,0,0,0,8,0,0,7,0,
0,1,7,0,0,0,0,0,0,
0,0,0,0,3,6,0,4,0
);

begin
solve( sudoku_ar );
end Sudoku;

Output:
Finished !
8 5 9| 6 1 2| 4 3 7
7 2 3| 8 5 4| 1 6 9
1 6 4| 3 7 9| 5 2 8
------+------+------
9 8 6| 1 4 7| 3 5 2
3 7 5| 2 6 8| 9 1 4
2 4 1| 5 9 3| 7 8 6
------+------+------
4 3 2| 9 8 1| 6 7 5
6 1 7| 4 2 5| 8 9 3
5 9 8| 7 3 6| 2 4 1

## ALGOL 68

Translation of: D
Note: This specimen retains the original D coding style.
Works with: ALGOL 68 version Revision 1 - no extensions to language used.
Works with: ALGOL 68G version Any - tested with release 1.18.0-9h.tiny.
MODE AVAIL = [9]BOOL;
MODE BOX = [3, 3]CHAR;

FORMAT row fmt = \$"|"3(" "3(g" ")"|")l\$;
FORMAT line = \$"+"3(7"-","+")l\$;
FORMAT puzzle fmt = \$f(line)3(3(f(row fmt))f(line))\$;

AVAIL gen full = (TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE);

OP REPR = (AVAIL avail)STRING: (
STRING out := "";
FOR i FROM LWB avail TO UPB avail DO
IF avail[i] THEN out +:= REPR(ABS "0" + i) FI
OD;
out
);

CHAR empty = "_";

OP -:= = (REF AVAIL set, CHAR index)VOID: (
set[ABS index - ABS "0"]:=FALSE
);

# these two functions assume that the number has not already been found #
PROC avail slice = (REF[]CHAR slice, REF AVAIL available)REF AVAIL:(
FOR ele FROM LWB slice TO UPB slice DO
IF slice[ele] /= empty THEN available-:=slice[ele] FI
OD;
available
);

PROC avail box = (INT x, y, REF AVAIL available)REF AVAIL:(
# x designates row, y designates column #
# get a base index for the boxes #
INT bx := x - (x-1) MOD 3;
INT by := y - (y-1) MOD 3;
REF BOX box = puzzle[bx:bx+2, by:by+2];
FOR i FROM LWB box TO UPB box DO
FOR j FROM 2 LWB box TO 2 UPB box DO
IF box[i, j] /= empty THEN available-:=box[i, j] FI
OD
OD;
available
);

[9, 9]CHAR puzzle;
PROC solve = ([,]CHAR in puzzle)VOID:(
puzzle := in puzzle;
TO UPB puzzle UP 2 DO
BOOL done := TRUE;
FOR i FROM LWB puzzle TO UPB puzzle DO
FOR j FROM 2 LWB puzzle TO 2 UPB puzzle DO
CHAR ele := puzzle[i, j];
IF ele = empty THEN
# poke at the elements that are "_" #
AVAIL remaining := avail box(i, j,
avail slice(puzzle[i, ],
avail slice(puzzle[, j],
LOC AVAIL := gen full)));
STRING s = REPR remaining;
IF UPB s = 1 THEN puzzle[i, j] := s[LWB s]
ELSE done := FALSE
FI
FI
OD
OD;
IF done THEN break FI
OD;
break:
# write out completed puzzle #
printf((\$gl\$, "Completed puzzle:"));
printf((puzzle fmt, puzzle))
);
main:(
solve(("394__267_",
"___3__4__",
"5__69__2_",
"_45___9__",
"6_______7",
"__7___58_",
"_1__67__8",
"__9__8___",
"_264__735"))
CO # note: This codes/algorithm does not [yet] solve: #
solve(("9__2__5__",
"_4__6__3_",
"__3_____6",
"___9__2__",
"____5__8_",
"__7__4__3",
"7_____1__",
"_5__2__4_",
"__1__6__9"))
END CO
)
Output:
Completed puzzle:
+-------+-------+-------+
| 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 |
+-------+-------+-------+

## 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
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,, 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:

#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
#IfWinActive

; Functions Start here

Sudoku( p ) { ;ErrorLevel contains the number of iterations
p := RegExReplace(p, "[^[email protected]]"), 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
}

## AWK

# syntax: GAWK -f SUDOKU_RC.AWK
BEGIN {
# row1 row2 row3 row4 row5 row6 row7 row8 row9
# puzzle = "111111111 111111111 111111111 111111111 111111111 111111111 111111111 111111111 111111111" # NG duplicate hints
# puzzle = "1........ ..274.... ...5....4 .3....... 75....... .....96.. .4...6... .......71 .....1.30" # NG can't use zero
# puzzle = "1........ ..274.... ...5....4 .3....... 75....... .....96.. .4...6... .......71 .....1.39" # no solution
# puzzle = "1........ ..274.... ...5....4 .3....... 75....... .....96.. .4...6... .......71 .....1.3." # OK
puzzle = "123456789 456789123 789123456 ......... ......... ......... ......... ......... ........." # OK
gsub(/ /,"",puzzle)
if (length(puzzle) != 81) { error("length of puzzle is not 81") }
if (puzzle !~ /^[1-9\.]+\$/) { error("only 1-9 and . are valid") }
if (gsub(/[1-9]/,"&",puzzle) < 17) { error("too few hints") }
if (errors > 0) {
exit(1)
}
plot(puzzle,"unsolved")
if (dup_hints_check(puzzle) == 1) {
if (solve(puzzle) == 1) {
dup_hints_check(sos)
plot(sos,"solved")
printf("\nbef: %s\naft: %s\n",puzzle,sos)
exit(0)
}
else {
error("no solution")
}
}
exit(1)
}
function dup_hints_check(ss, esf,msg,Rarr,Carr,Barr,i,r_row,r_col,r_pos,r_hint,c_row,c_col,c_pos,c_hint,box) {
esf = errors # errors so far
for (i=0; i<81; i++) {
# row
r_row = int(i/9) + 1 # determine row: 1..9
r_col = i%9 + 1 # determine column: 1..9
r_pos = i + 1 # determine hint position: 1..81
r_hint = substr(ss,r_pos,1) # extract 1 character; the hint
Rarr[r_row,r_hint]++ # save row
# column
c_row = i%9 + 1 # determine row: 1..9
c_col = int(i/9) + 1 # determine column: 1..9
c_pos = (c_row-1) * 9 + c_col # determine hint position: 1..81
c_hint = substr(ss,c_pos,1) # extract 1 character; the hint
Carr[c_col,c_hint]++ # save column
# box (there has to be a better way)
if ((r_row r_col) ~ /[123][123]/) { box = 1 }
else if ((r_row r_col) ~ /[123][456]/) { box = 2 }
else if ((r_row r_col) ~ /[123][789]/) { box = 3 }
else if ((r_row r_col) ~ /[456][123]/) { box = 4 }
else if ((r_row r_col) ~ /[456][456]/) { box = 5 }
else if ((r_row r_col) ~ /[456][789]/) { box = 6 }
else if ((r_row r_col) ~ /[789][123]/) { box = 7 }
else if ((r_row r_col) ~ /[789][456]/) { box = 8 }
else if ((r_row r_col) ~ /[789][789]/) { box = 9 }
else { box = 0 }
Barr[box,r_hint]++ # save box
}
dup_hints_print(Rarr,"row")
dup_hints_print(Carr,"column")
dup_hints_print(Barr,"box")
return((errors == esf) ? 1 : 0)
}
function dup_hints_print(arr,rcb, hint,i) {
# rcb - Row Column Box
for (i=1; i<=9; i++) { # "i" is either the row, column, or box
for (hint=1; hint<=9; hint++) { # 1..9 only; don't care about "." place holder
if (arr[i,hint]+0 > 1) { # was a digit specified more than once
error(sprintf("duplicate hint in %s %d",rcb,i))
}
}
}
}
function plot(ss,text1,text2, a,b,c,d,ou) {
# 1st call prints the unsolved puzzle.
# 2nd call prints the solved puzzle
printf("| - - - + - - - + - - - | %s\n",text1)
for (a=0; a<3; a++) {
for (b=0; b<3; b++) {
ou = "|"
for (c=0; c<3; c++) {
for (d=0; d<3; d++) {
ou = sprintf("%s %1s",ou,substr(ss,1+d+3*c+9*b+27*a,1))
}
ou = ou " |"
}
print(ou)
}
printf("| - - - + - - - + - - - | %s\n",(a==2)?text2:"")
}
}
function solve(ss, a,b,c,d,e,r,co,ro,bi,bl,nss) {
i = 0
# first, use some simple logic to fill grid as much as possible
do {
i++
didit = 0
delete nr
delete nc
delete nb
delete ca
for (a=0; a<81; a++) {
b = substr(ss,a+1,1)
if (b == ".") { # construct row, column and block at cell
c = a % 9
r = int(a/9)
ro = substr(ss,r*9+1,9)
co = ""
for (d=0; d<9; d++) { co = co substr(ss,d*9+c+1,1) }
bi = int(c/3)*3+(int(r/3)*3)*9+1
bl = ""
for (d=0; d<3; d++) { bl = bl substr(ss,bi+d*9,3) }
e = 0
# count non-occurrences of digits 1-9 in combined row, column and block, per row, column and block, and flag cell/digit as candidate
for (d=1; d<10; d++) {
if (index(ro co bl, d) == 0) {
e++
nr[r,d]++
nc[c,d]++
nb[bi,d]++
ca[c,r,d] = bi
}
}
if (e == 0) { # in case no candidate is available, give up
return(0)
}
}
}
# go through all cell/digit candidates
# hidden singles
for (crd in ca) {
# a candidate may have been deleted after the loop started
if (ca[crd] != "") {
split(crd,spl,SUBSEP)
c = spl[1]
r = spl[2]
d = spl[3]
bi = ca[crd]
a = c + r * 9
# unique solution if at least one non-occurrence counter is exactly 1
if ((nr[r,d] == 1) || (nc[c,d] == 1) || (nb[bi,d] == 1)) {
ss = substr(ss,1,a) d substr(ss,a+2,length(ss))
didit = 1
# remove candidates from current row, column, block
for (e=0; e<9; e++) {
delete ca[c,e,d]
delete ca[e,r,d]
}
for (e=0; e<3; e++) {
for (b=0; b<3; b++) {
delete ca[int(c/3)*3+b,int(r/3)*3+e,d]
}
}
}
}
}
} while (didit == 1)
# second, pick a viable solution for the next empty cell and see if it leads to a solution
a = index(ss,".")-1
if (a == -1) { # no more empty cells, done
sos = ss
return(1)
}
else {
c = a % 9
r = int(a/9)
# concatenate current row, column and block
# row
co = substr(ss,r*9+1,9)
# column
for (d=0; d<9; d++) { co = co substr(ss,d*9+c+1,1) }
# block
c = int(c/3)*3+(int(r/3)*3)*9+1
for (d=0; d<3; d++) { co = co substr(ss,c+d*9,3) }
for (b=1; b<10; b++) { # get a viable digit
if (index(co,b) == 0) { # check if candidate digit already exists
# is viable, put in cell
nss = substr(ss,1,a) b substr(ss,a+2,length(ss))
d = solve(nss) # try to solve
if (d == 1) { # if successful, return
return(1)
}
}
}
}
return(0) # no digits viable, no solution
}
function error(message) { printf("error: %s\n",message) ; errors++ }

Output:
| - - - + - - - + - - - | unsolved
| 1 2 3 | 4 5 6 | 7 8 9 |
| 4 5 6 | 7 8 9 | 1 2 3 |
| 7 8 9 | 1 2 3 | 4 5 6 |
| - - - + - - - + - - - |
| . . . | . . . | . . . |
| . . . | . . . | . . . |
| . . . | . . . | . . . |
| - - - + - - - + - - - |
| . . . | . . . | . . . |
| . . . | . . . | . . . |
| . . . | . . . | . . . |
| - - - + - - - + - - - |
| - - - + - - - + - - - | solved
| 1 2 3 | 4 5 6 | 7 8 9 |
| 4 5 6 | 7 8 9 | 1 2 3 |
| 7 8 9 | 1 2 3 | 4 5 6 |
| - - - + - - - + - - - |
| 2 1 4 | 3 6 5 | 8 9 7 |
| 3 6 5 | 8 9 7 | 2 1 4 |
| 8 9 7 | 2 1 4 | 3 6 5 |
| - - - + - - - + - - - |
| 5 3 1 | 6 4 2 | 9 7 8 |
| 6 4 2 | 9 7 8 | 5 3 1 |
| 9 7 8 | 5 3 1 | 6 4 2 |
| - - - + - - - + - - - |

bef: 123456789456789123789123456......................................................
aft: 123456789456789123789123456214365897365897214897214365531642978642978531978531642

## BBC BASIC

VDU 23,22,453;453;8,20,16,128
*FONT Arial,28

DIM Board%(8,8)
Board%() = %111111111

FOR L% = 0 TO 9:P% = L%*100
LINE 2,P%+2,902,P%+2
IF (L% MOD 3)=0 LINE 2,P%,902,P% : LINE 2,P%+4,902,P%+4
LINE P%+2,2,P%+2,902
IF (L% MOD 3)=0 LINE P%,2,P%,902 : LINE P%+4,2,P%+4,902
NEXT

DATA " 4 5 6 "
DATA " 6 1 8 9"
DATA "3 7 "
DATA " 8 5 "
DATA " 4 3 "
DATA " 6 7 "
DATA " 2 6"
DATA "1 5 4 3 "
DATA " 2 7 1 "

FOR R% = 8 TO 0 STEP -1
FOR C% = 0 TO 8
A% = ASCMID\$(A\$,C%+1) AND 15
IF A% Board%(R%,C%) = 1 << (A%-1)
NEXT
NEXT R%

GCOL 4
PROCshow
WAIT 200
dummy% = FNsolve(Board%(), TRUE)
GCOL 2
PROCshow
REPEAT WAIT 1 : UNTIL FALSE
END

DEF PROCshow
LOCAL C%,P%,R%
FOR C% = 0 TO 8
FOR R% = 0 TO 8
P% = Board%(R%,C%)
IF (P% AND (P%-1)) = 0 THEN
IF P% P% = LOGP%/LOG2+1.5
MOVE C%*100+30,R%*100+90
VDU 5,P%+48,4
ENDIF
NEXT
NEXT
ENDPROC

DEF FNsolve(P%(),F%)
LOCAL C%,D%,M%,N%,R%,X%,Y%,Q%()
DIM Q%(8,8)
REPEAT
Q%() = P%()
FOR R% = 0 TO 8
FOR C% = 0 TO 8
D% = P%(R%,C%)
IF (D% AND (D%-1))=0 THEN
M% = NOT D%
FOR X% = 0 TO 8
IF X%<>C% P%(R%,X%) AND= M%
IF X%<>R% P%(X%,C%) AND= M%
NEXT
FOR X% = C%DIV3*3 TO C%DIV3*3+2
FOR Y% = R%DIV3*3 TO R%DIV3*3+2
IF X%<>C% IF Y%<>R% P%(Y%,X%) AND= M%
NEXT
NEXT
ENDIF
NEXT
NEXT
Q%() -= P%()
UNTIL SUMQ%()=0
M% = 10
FOR R% = 0 TO 8
FOR C% = 0 TO 8
D% = P%(R%,C%)
IF D%=0 M% = 0
IF D% AND (D%-1) THEN
N% = 0
REPEAT N% += D% AND 1
D% DIV= 2
UNTIL D% = 0
IF N%<M% M% = N% : X% = C% : Y% = R%
ENDIF
NEXT
NEXT
IF M%=0 THEN = 0
IF M%=10 THEN = 1
D% = 0
FOR M% = 0 TO 8
IF P%(Y%,X%) AND (2^M%) THEN
Q%() = P%()
Q%(Y%,X%) = 2^M%
C% = FNsolve(Q%(),F%)
D% += C%
IF C% IF F% P%() = Q%() : = D%
ENDIF
NEXT
= D%

## BCPL

// This can be run using Cintcode BCPL freely available from www.cl.cam.ac.uk/users/mr10.
// Implemented by Martin Richards.

// If you have cintcode BCPL installed on a Linux system you can compile and run this program
// execute the following sequence of commands.

// cd \$BCPLROOT
// cintsys
// c bc sudoku
// sudoku

// This is a really naive program to solve SuDoku problems. Even so it is usually quite fast.

// SuDoku consists of a 9x9 grid of cells. Each cell should contain
// a digit in the range 1..9. Every row, column and major 3x3
// square should contain all the digits 1..9. Some cells have
// given values. The problem is to find digits to place in
// the unspecified cells satisfying the constraints.

// A typical problem is:

// - - - 6 3 8 - - -
// 7 - 6 - - - 3 - 5
// - 1 - - - - - 4 -

// - - 8 7 1 2 4 - -
// - 9 - - - - - 5 -
// - - 2 5 6 9 1 - -

// - 3 - - - - - 1 -
// 1 - 5 - - - 6 - 8
// - - - 1 8 4 - - -

SECTION "sudoku"

GET "libhdr"

GLOBAL { count:ug

// The 9x9 board

a1; a2; a3; a4; a5; a6; a7; a8; a9
b1; b2; b3; b4; b5; b6; b7; b8; b9
c1; c2; c3; c4; c5; c6; c7; c8; c9
d1; d2; d3; d4; d5; d6; d7; d8; d9
e1; e2; e3; e4; e5; e6; e7; e8; e9
f1; f2; f3; f4; f5; f6; f7; f8; f9
g1; g2; g3; g4; g5; g6; g7; g8; g9
h1; h2; h3; h4; h5; h6; h7; h8; h9
i1; i2; i3; i4; i5; i6; i7; i8; i9
}

MANIFEST {
N1=1<<0; N2=1<<1; N3=1<<2;
N4=1<<3; N5=1<<4; N6=1<<5;
N7=1<<6; N8=1<<7; N9=1<<8
}

LET start() = VALOF
{ count := 0
initboard()
prboard()
ta1()
writef("*n*nTotal number of solutions: %n*n", count)
RESULTIS 0
}

AND initboard() BE {
a1, a2, a3, a4, a5, a6, a7, a8, a9 := 0, 0, 0, N6,N3,N8, 0, 0, 0
b1, b2, b3, b4, b5, b6, b7, b8, b9 := N7, 0,N6, 0, 0, 0, N3, 0,N5
c1, c2, c3, c4, c5, c6, c7, c8, c9 := 0,N1, 0, 0, 0, 0, 0,N4, 0
d1, d2, d3, d4, d5, d6, d7, d8, d9 := 0, 0,N8, N7,N1,N2, N4, 0, 0
e1, e2, e3, e4, e5, e6, e7, e8, e9 := 0,N9, 0, 0, 0, 0, 0,N5, 0
f1, f2, f3, f4, f5, f6, f7, f8, f9 := 0, 0,N2, N5,N6,N9, N1, 0, 0
g1, g2, g3, g4, g5, g6, g7, g8, g9 := 0,N3, 0, 0, 0, 0, 0,N1, 0
h1, h2, h3, h4, h5, h6, h7, h8, h9 := N1, 0,N5, 0, 0, 0, N6, 0,N8
i1, i2, i3, i4, i5, i6, i7, i8, i9 := 0, 0, 0, N1,N8,N4, 0, 0, 0

// Un-comment the following to test that the backtracking works
// giving 184 solutions.
//h1, h2, h3, h4, h5, h6, h7, h8, h9 := N1, 0,N5, 0, 0, 0, N6, 0, 0
//i1, i2, i3, i4, i5, i6, i7, i8, i9 := 0, 0, 0, 0, 0, 0, 0, 0, 0
}

AND c(n) = VALOF SWITCHON n INTO
{ DEFAULT: RESULTIS '?'
CASE 0: RESULTIS '-'
CASE N1: RESULTIS '1'
CASE N2: RESULTIS '2'
CASE N3: RESULTIS '3'
CASE N4: RESULTIS '4'
CASE N5: RESULTIS '5'
CASE N6: RESULTIS '6'
CASE N7: RESULTIS '7'
CASE N8: RESULTIS '8'
CASE N9: RESULTIS '9'
}

AND prboard() BE
{ LET form = "%c %c %c  %c %c %c  %c %c %c*n"
writef("*ncount = %n*n", count)
newline()
writef(form, c(a1),c(a2),c(a3),c(a4),c(a5),c(a6),c(a7),c(a8),c(a9))
writef(form, c(b1),c(b2),c(b3),c(b4),c(b5),c(b6),c(b7),c(b8),c(b9))
writef(form, c(c1),c(c2),c(c3),c(c4),c(c5),c(c6),c(c7),c(c8),c(c9))
newline()
writef(form, c(d1),c(d2),c(d3),c(d4),c(d5),c(d6),c(d7),c(d8),c(d9))
writef(form, c(e1),c(e2),c(e3),c(e4),c(e5),c(e6),c(e7),c(e8),c(e9))
writef(form, c(f1),c(f2),c(f3),c(f4),c(f5),c(f6),c(f7),c(f8),c(f9))
newline()
writef(form, c(g1),c(g2),c(g3),c(g4),c(g5),c(g6),c(g7),c(g8),c(g9))
writef(form, c(h1),c(h2),c(h3),c(h4),c(h5),c(h6),c(h7),c(h8),c(h9))
writef(form, c(i1),c(i2),c(i3),c(i4),c(i5),c(i6),c(i7),c(i8),c(i9))

newline()

//abort(1000)
}

AND try(p, f, row, col, sq) BE
{ LET x = !p
TEST x
THEN f()
ELSE { LET bits = row|col|sq
//prboard()
// writef("x=%n %b9*n", x, bits)
//abort(1000)
IF (N1&bits)=0 DO { !p:=N1; f() }
IF (N2&bits)=0 DO { !p:=N2; f() }
IF (N3&bits)=0 DO { !p:=N3; f() }
IF (N4&bits)=0 DO { !p:=N4; f() }
IF (N5&bits)=0 DO { !p:=N5; f() }
IF (N6&bits)=0 DO { !p:=N6; f() }
IF (N7&bits)=0 DO { !p:=N7; f() }
IF (N8&bits)=0 DO { !p:=N8; f() }
IF (N9&bits)=0 DO { !p:=N9; f() }
!p := 0
}
}

AND ta1() BE try(@a1, ta2, a1+a2+a3+a4+a5+a6+a7+a8+a9,
a1+b1+c1+d1+e1+f1+g1+h1+i1,
a1+a2+a3+b1+b2+b3+c1+c2+c3)
AND ta2() BE try(@a2, ta3, a1+a2+a3+a4+a5+a6+a7+a8+a9,
a2+b2+c2+d2+e2+f2+g2+h2+i2,
a1+a2+a3+b1+b2+b3+c1+c2+c3)
AND ta3() BE try(@a3, ta4, a1+a2+a3+a4+a5+a6+a7+a8+a9,
a3+b3+c3+d3+e3+f3+g3+h3+i3,
a1+a2+a3+b1+b2+b3+c1+c2+c3)
AND ta4() BE try(@a4, ta5, a1+a2+a3+a4+a5+a6+a7+a8+a9,
a4+b4+c4+d4+e4+f4+g4+h4+i4,
a4+a5+a6+b4+b5+b6+c4+c5+c6)
AND ta5() BE try(@a5, ta6, a1+a2+a3+a4+a5+a6+a7+a8+a9,
a5+b5+c5+d5+e5+f5+g5+h5+i5,
a4+a5+a6+b4+b5+b6+c4+c5+c6)
AND ta6() BE try(@a6, ta7, a1+a2+a3+a4+a5+a6+a7+a8+a9,
a6+b6+c6+d6+e6+f6+g6+h6+i6,
a4+a5+a6+b4+b5+b6+c4+c5+c6)
AND ta7() BE try(@a7, ta8, a1+a2+a3+a4+a5+a6+a7+a8+a9,
a7+b7+c7+d7+e7+f7+g7+h7+i7,
a7+a8+a9+b7+b8+b9+c7+c8+c9)
AND ta8() BE try(@a8, ta9, a1+a2+a3+a4+a5+a6+a7+a8+a9,
a8+b8+c8+d8+e8+f8+g8+h8+i8,
a7+a8+a9+b7+b8+b9+c7+c8+c9)
AND ta9() BE try(@a9, tb1, a1+a2+a3+a4+a5+a6+a7+a8+a9,
a9+b9+c9+d9+e9+f9+g9+h9+i9,
a7+a8+a9+b7+b8+b9+c7+c8+c9)

AND tb1() BE try(@b1, tb2, b1+b2+b3+b4+b5+b6+b7+b8+b9,
a1+b1+c1+d1+e1+f1+g1+h1+i1,
a1+a2+a3+b1+b2+b3+c1+c2+c3)
AND tb2() BE try(@b2, tb3, b1+b2+b3+b4+b5+b6+b7+b8+b9,
a2+b2+c2+d2+e2+f2+g2+h2+i2,
a1+a2+a3+b1+b2+b3+c1+c2+c3)
AND tb3() BE try(@b3, tb4, b1+b2+b3+b4+b5+b6+b7+b8+b9,
a3+b3+c3+d3+e3+f3+g3+h3+i3,
a1+a2+a3+b1+b2+b3+c1+c2+c3)
AND tb4() BE try(@b4, tb5, b1+b2+b3+b4+b5+b6+b7+b8+b9,
a4+b4+c4+d4+e4+f4+g4+h4+i4,
a4+a5+a6+b4+b5+b6+c4+c5+c6)
AND tb5() BE try(@b5, tb6, b1+b2+b3+b4+b5+b6+b7+b8+b9,
a5+b5+c5+d5+e5+f5+g5+h5+i5,
a4+a5+a6+b4+b5+b6+c4+c5+c6)
AND tb6() BE try(@b6, tb7, b1+b2+b3+b4+b5+b6+b7+b8+b9,
a6+b6+c6+d6+e6+f6+g6+h6+i6,
a4+a5+a6+b4+b5+b6+c4+c5+c6)
AND tb7() BE try(@b7, tb8, b1+b2+b3+b4+b5+b6+b7+b8+b9,
a7+b7+c7+d7+e7+f7+g7+h7+i7,
a7+a8+a9+b7+b8+b9+c7+c8+c9)
AND tb8() BE try(@b8, tb9, b1+b2+b3+b4+b5+b6+b7+b8+b9,
a8+b8+c8+d8+e8+f8+g8+h8+i8,
a7+a8+a9+b7+b8+b9+c7+c8+c9)
AND tb9() BE try(@b9, tc1, b1+b2+b3+b4+b5+b6+b7+b8+b9,
a9+b9+c9+d9+e9+f9+g9+h9+i9,
a7+a8+a9+b7+b8+b9+c7+c8+c9)

AND tc1() BE try(@c1, tc2, c1+c2+c3+c4+c5+c6+c7+c8+c9,
a1+b1+c1+d1+e1+f1+g1+h1+i1,
a1+a2+a3+b1+b2+b3+c1+c2+c3)
AND tc2() BE try(@c2, tc3, c1+c2+c3+c4+c5+c6+c7+c8+c9,
a2+b2+c2+d2+e2+f2+g2+h2+i2,
a1+a2+a3+b1+b2+b3+c1+c2+c3)
AND tc3() BE try(@c3, tc4, c1+c2+c3+c4+c5+c6+c7+c8+c9,
a3+b3+c3+d3+e3+f3+g3+h3+i3,
a1+a2+a3+b1+b2+b3+c1+c2+c3)
AND tc4() BE try(@c4, tc5, c1+c2+c3+c4+c5+c6+c7+c8+c9,
a4+b4+c4+d4+e4+f4+g4+h4+i4,
a4+a5+a6+b4+b5+b6+c4+c5+c6)
AND tc5() BE try(@c5, tc6, c1+c2+c3+c4+c5+c6+c7+c8+c9,
a5+b5+c5+d5+e5+f5+g5+h5+i5,
a4+a5+a6+b4+b5+b6+c4+c5+c6)
AND tc6() BE try(@c6, tc7, c1+c2+c3+c4+c5+c6+c7+c8+c9,
a6+b6+c6+d6+e6+f6+g6+h6+i6,
a4+a5+a6+b4+b5+b6+c4+c5+c6)
AND tc7() BE try(@c7, tc8, c1+c2+c3+c4+c5+c6+c7+c8+c9,
a7+b7+c7+d7+e7+f7+g7+h7+i7,
a7+a8+a9+b7+b8+b9+c7+c8+c9)
AND tc8() BE try(@c8, tc9, c1+c2+c3+c4+c5+c6+c7+c8+c9,
a8+b8+c8+d8+e8+f8+g8+h8+i8,
a7+a8+a9+b7+b8+b9+c7+c8+c9)
AND tc9() BE try(@c9, td1, c1+c2+c3+c4+c5+c6+c7+c8+c9,
a9+b9+c9+d9+e9+f9+g9+h9+i9,
a7+a8+a9+b7+b8+b9+c7+c8+c9)

AND td1() BE try(@d1, td2, d1+d2+d3+d4+d5+d6+d7+d8+d9,
a1+b1+c1+d1+e1+f1+g1+h1+i1,
d1+d2+d3+e1+e2+e3+f1+f2+f3)
AND td2() BE try(@d2, td3, d1+d2+d3+d4+d5+d6+d7+d8+d9,
a2+b2+c2+d2+e2+f2+g2+h2+i2,
d1+d2+d3+e1+e2+e3+f1+f2+f3)
AND td3() BE try(@d3, td4, d1+d2+d3+d4+d5+d6+d7+d8+d9,
a3+b3+c3+d3+e3+f3+g3+h3+i3,
d1+d2+d3+e1+e2+e3+f1+f2+f3)
AND td4() BE try(@d4, td5, d1+d2+d3+d4+d5+d6+d7+d8+d9,
a4+b4+c4+d4+e4+f4+g4+h4+i4,
d4+d5+d6+e4+e5+e6+f4+f5+f6)
AND td5() BE try(@d5, td6, d1+d2+d3+d4+d5+d6+d7+d8+d9,
a5+b5+c5+d5+e5+f5+g5+h5+i5,
d4+d5+d6+e4+e5+e6+f4+f5+f6)
AND td6() BE try(@d6, td7, d1+d2+d3+d4+d5+d6+d7+d8+d9,
a6+b6+c6+d6+e6+f6+g6+h6+i6,
d4+d5+d6+e4+e5+e6+f4+f5+f6)
AND td7() BE try(@d7, td8, d1+d2+d3+d4+d5+d6+d7+d8+d9,
a7+b7+c7+d7+e7+f7+g7+h7+i7,
d7+d8+d9+e7+e8+e9+f7+f8+f9)
AND td8() BE try(@d8, td9, d1+d2+d3+d4+d5+d6+d7+d8+d9,
a8+b8+c8+d8+e8+f8+g8+h8+i8,
d7+d8+d9+e7+e8+e9+f7+f8+f9)
AND td9() BE try(@d9, te1, d1+d2+d3+d4+d5+d6+d7+d8+d9,
a9+b9+c9+d9+e9+f9+g9+h9+i9,
d7+d8+d9+e7+e8+e9+f7+f8+f9)

AND te1() BE try(@e1, te2, e1+e2+e3+e4+e5+e6+e7+e8+e9,
a1+b1+c1+d1+e1+f1+g1+h1+i1,
d1+d2+d3+e1+e2+e3+f1+f2+f3)
AND te2() BE try(@e2, te3, e1+e2+e3+e4+e5+e6+e7+e8+e9,
a2+b2+c2+d2+e2+f2+g2+h2+i2,
d1+d2+d3+e1+e2+e3+f1+f2+f3)
AND te3() BE try(@e3, te4, e1+e2+e3+e4+e5+e6+e7+e8+e9,
a3+b3+c3+d3+e3+f3+g3+h3+i3,
d1+d2+d3+e1+e2+e3+f1+f2+f3)
AND te4() BE try(@e4, te5, e1+e2+e3+e4+e5+e6+e7+e8+e9,
a4+b4+c4+d4+e4+f4+g4+h4+i4,
d4+d5+d6+e4+e5+e6+f4+f5+f6)
AND te5() BE try(@e5, te6, e1+e2+e3+e4+e5+e6+e7+e8+e9,
a5+b5+c5+d5+e5+f5+g5+h5+i5,
d4+d5+d6+e4+e5+e6+f4+f5+f6)
AND te6() BE try(@e6, te7, e1+e2+e3+e4+e5+e6+e7+e8+e9,
a6+b6+c6+d6+e6+f6+g6+h6+i6,
d4+d5+d6+e4+e5+e6+f4+f5+f6)
AND te7() BE try(@e7, te8, e1+e2+e3+e4+e5+e6+e7+e8+e9,
a7+b7+c7+d7+e7+f7+g7+h7+i7,
d7+d8+d9+e7+e8+e9+f7+f8+f9)
AND te8() BE try(@e8, te9, e1+e2+e3+e4+e5+e6+e7+e8+e9,
a8+b8+c8+d8+e8+f8+g8+h8+i8,
d7+d8+d9+e7+e8+e9+f7+f8+f9)
AND te9() BE try(@e9, tf1, e1+e2+e3+e4+e5+e6+e7+e8+e9,
a9+b9+c9+d9+e9+f9+g9+h9+i9,
d7+d8+d9+e7+e8+e9+f7+f8+f9)

AND tf1() BE try(@f1, tf2, f1+f2+f3+f4+f5+f6+f7+f8+f9,
a1+b1+c1+d1+e1+f1+g1+h1+i1,
d1+d2+d3+e1+e2+e3+f1+f2+f3)
AND tf2() BE try(@f2, tf3, f1+f2+f3+f4+f5+f6+f7+f8+f9,
a2+b2+c2+d2+e2+f2+g2+h2+i2,
d1+d2+d3+e1+e2+e3+f1+f2+f3)
AND tf3() BE try(@f3, tf4, f1+f2+f3+f4+f5+f6+f7+f8+f9,
a3+b3+c3+d3+e3+f3+g3+h3+i3,
d1+d2+d3+e1+e2+e3+f1+f2+f3)
AND tf4() BE try(@f4, tf5, f1+f2+f3+f4+f5+f6+f7+f8+f9,
a4+b4+c4+d4+e4+f4+g4+h4+i4,
d4+d5+d6+e4+e5+e6+f4+f5+f6)
AND tf5() BE try(@f5, tf6, f1+f2+f3+f4+f5+f6+f7+f8+f9,
a5+b5+c5+d5+e5+f5+g5+h5+i5,
d4+d5+d6+e4+e5+e6+f4+f5+f6)
AND tf6() BE try(@f6, tf7, f1+f2+f3+f4+f5+f6+f7+f8+f9,
a6+b6+c6+d6+e6+f6+g6+h6+i6,
d4+d5+d6+e4+e5+e6+f4+f5+f6)
AND tf7() BE try(@f7, tf8, f1+f2+f3+f4+f5+f6+f7+f8+f9,
a7+b7+c7+d7+e7+f7+g7+h7+i7,
d7+d8+d9+e7+e8+e9+f7+f8+f9)
AND tf8() BE try(@f8, tf9, f1+f2+f3+f4+f5+f6+f7+f8+f9,
a8+b8+c8+d8+e8+f8+g8+h8+i8,
d7+d8+d9+e7+e8+e9+f7+f8+f9)
AND tf9() BE try(@f9, tg1, f1+f2+f3+f4+f5+f6+f7+f8+f9,
a9+b9+c9+d9+e9+f9+g9+h9+i9,
d7+d8+d9+e7+e8+e9+f7+f8+f9)

AND tg1() BE try(@g1, tg2, g1+g2+g3+g4+g5+g6+g7+g8+g9,
a1+b1+c1+d1+e1+f1+g1+h1+i1,
g1+g2+g3+h1+h2+h3+i1+i2+i3)
AND tg2() BE try(@g2, tg3, g1+g2+g3+g4+g5+g6+g7+g8+g9,
a2+b2+c2+d2+e2+f2+g2+h2+i2,
g1+g2+g3+h1+h2+h3+i1+i2+i3)
AND tg3() BE try(@g3, tg4, g1+g2+g3+g4+g5+g6+g7+g8+g9,
a3+b3+c3+d3+e3+f3+g3+h3+i3,
g1+g2+g3+h1+h2+h3+i1+i2+i3)
AND tg4() BE try(@g4, tg5, g1+g2+g3+g4+g5+g6+g7+g8+g9,
a4+b4+c4+d4+e4+f4+g4+h4+i4,
g4+g5+g6+h4+h5+h6+i4+i5+i6)
AND tg5() BE try(@g5, tg6, g1+g2+g3+g4+g5+g6+g7+g8+g9,
a5+b5+c5+d5+e5+f5+g5+h5+i5,
g4+g5+g6+h4+h5+h6+i4+i5+i6)
AND tg6() BE try(@g6, tg7, g1+g2+g3+g4+g5+g6+g7+g8+g9,
a6+b6+c6+d6+e6+f6+g6+h6+i6,
g4+g5+g6+h4+h5+h6+i4+i5+i6)
AND tg7() BE try(@g7, tg8, g1+g2+g3+g4+g5+g6+g7+g8+g9,
a7+b7+c7+d7+e7+f7+g7+h7+i7,
g7+g8+g9+h7+h8+h9+i7+i8+i9)
AND tg8() BE try(@g8, tg9, g1+g2+g3+g4+g5+g6+g7+g8+g9,
a8+b8+c8+d8+e8+f8+g8+h8+i8,
g7+g8+g9+h7+h8+h9+i7+i8+i9)
AND tg9() BE try(@g9, th1, g1+g2+g3+g4+g5+g6+g7+g8+g9,
a9+b9+c9+d9+e9+f9+g9+h9+i9,
g7+g8+g9+h7+h8+h9+i7+i8+i9)

AND th1() BE try(@h1, th2, h1+h2+h3+h4+h5+h6+h7+h8+h9,
a1+b1+c1+d1+e1+f1+g1+h1+i1,
g1+g2+g3+h1+h2+h3+i1+i2+i3)
AND th2() BE try(@h2, th3, h1+h2+h3+h4+h5+h6+h7+h8+h9,
a2+b2+c2+d2+e2+f2+g2+h2+i2,
g1+g2+g3+h1+h2+h3+i1+i2+i3)
AND th3() BE try(@h3, th4, h1+h2+h3+h4+h5+h6+h7+h8+h9,
a3+b3+c3+d3+e3+f3+g3+h3+i3,
g1+g2+g3+h1+h2+h3+i1+i2+i3)
AND th4() BE try(@h4, th5, h1+h2+h3+h4+h5+h6+h7+h8+h9,
a4+b4+c4+d4+e4+f4+g4+h4+i4,
g4+g5+g6+h4+h5+h6+i4+i5+i6)
AND th5() BE try(@h5, th6, h1+h2+h3+h4+h5+h6+h7+h8+h9,
a5+b5+c5+d5+e5+f5+g5+h5+i5,
g4+g5+g6+h4+h5+h6+i4+i5+i6)
AND th6() BE try(@h6, th7, h1+h2+h3+h4+h5+h6+h7+h8+h9,
a6+b6+c6+d6+e6+f6+g6+h6+i6,
g4+g5+g6+h4+h5+h6+i4+i5+i6)
AND th7() BE try(@h7, th8, h1+h2+h3+h4+h5+h6+h7+h8+h9,
a7+b7+c7+d7+e7+f7+g7+h7+i7,
g7+g8+g9+h7+h8+h9+i7+i8+i9)
AND th8() BE try(@h8, th9, h1+h2+h3+h4+h5+h6+h7+h8+h9,
a8+b8+c8+d8+e8+f8+g8+h8+i8,
g7+g8+g9+h7+h8+h9+i7+i8+i9)
AND th9() BE try(@h9, ti1, h1+h2+h3+h4+h5+h6+h7+h8+h9,
a9+b9+c9+d9+e9+f9+g9+h9+i9,
g7+g8+g9+h7+h8+h9+i7+i8+i9)

AND ti1() BE try(@i1, ti2, i1+i2+i3+i4+i5+i6+i7+i8+i9,
a1+b1+c1+d1+e1+f1+g1+h1+i1,
g1+g2+g3+h1+h2+h3+i1+i2+i3)
AND ti2() BE try(@i2, ti3, i1+i2+i3+i4+i5+i6+i7+i8+i9,
a2+b2+c2+d2+e2+f2+g2+h2+i2,
g1+g2+g3+h1+h2+h3+i1+i2+i3)
AND ti3() BE try(@i3, ti4, i1+i2+i3+i4+i5+i6+i7+i8+i9,
a3+b3+c3+d3+e3+f3+g3+h3+i3,
g1+g2+g3+h1+h2+h3+i1+i2+i3)
AND ti4() BE try(@i4, ti5, i1+i2+i3+i4+i5+i6+i7+i8+i9,
a4+b4+c4+d4+e4+f4+g4+h4+i4,
g4+g5+g6+h4+h5+h6+i4+i5+i6)
AND ti5() BE try(@i5, ti6, i1+i2+i3+i4+i5+i6+i7+i8+i9,
a5+b5+c5+d5+e5+f5+g5+h5+i5,
g4+g5+g6+h4+h5+h6+i4+i5+i6)
AND ti6() BE try(@i6, ti7, i1+i2+i3+i4+i5+i6+i7+i8+i9,
a6+b6+c6+d6+e6+f6+g6+h6+i6,
g4+g5+g6+h4+h5+h6+i4+i5+i6)
AND ti7() BE try(@i7, ti8, i1+i2+i3+i4+i5+i6+i7+i8+i9,
a7+b7+c7+d7+e7+f7+g7+h7+i7,
g7+g8+g9+h7+h8+h9+i7+i8+i9)
AND ti8() BE try(@i8, ti9, i1+i2+i3+i4+i5+i6+i7+i8+i9,
a8+b8+c8+d8+e8+f8+g8+h8+i8,
g7+g8+g9+h7+h8+h9+i7+i8+i9)
AND ti9() BE try(@i9, suc, i1+i2+i3+i4+i5+i6+i7+i8+i9,
a9+b9+c9+d9+e9+f9+g9+h9+i9,
g7+g8+g9+h7+h8+h9+i7+i8+i9)

AND suc() BE
{ count := count + 1
prboard()
}

## Befunge

Input should be provided as a sequence of 81 digits (optionally separated by whitespace), with zero representing an unknown value.

99*>1-:0>:#\$"0"\# #~`#\$_"0"-\::9%:9+00p3/\9/:99++10p3vv%2g\g01<
2%v|:p+9/9\%9:\p\g02\1p\g01\1:p\g00\1:+8:\p02+*93+*3/<>\20g\g#:
v<+>:0\`>v >\::9%:9+00p3/\9/:99++10p3/3*+39*+20p\:8+::00g\g2%\^
v^+^pppp\$_:|v<::<_>1-::9%\9/9+g.::9%!\3%+>>#v_>" "v..v,<<<+55<<
03!\$v9:_>1v\$>9%\v^|:<_v#<%<9<:<<_v#+%*93\!::<,,"|"<\/>:#^_>>>v^
p|<\$0.0^!g+:#9/9<^@ ^,>#+5<5_>#!<>#\$0"------+-------+-----":#<^
<>v\$v1:::0<>"P"`!^>0g#0v#p+9/9\%9:p04:\pg03g021pg03g011pg03g001
::>^_:#<0#!:p#-\#1:#g0<>30g010g30g020g30g040g:9%\:9/9+\01-\1+0:
Input:
8 5 0 0 0 2 4 0 0
7 2 0 0 0 0 0 0 9
0 0 4 0 0 0 0 0 0
0 0 0 1 0 7 0 0 2
3 0 5 0 0 0 9 0 0
0 4 0 0 0 0 0 0 0
0 0 0 0 8 0 0 7 0
0 1 7 0 0 0 0 0 0
0 0 0 0 3 6 0 4 0
Output:
8 5 9 | 6 1 2 | 4 3 7
7 2 3 | 8 5 4 | 1 6 9
1 6 4 | 3 7 9 | 5 2 8
------+-------+------
9 8 6 | 1 4 7 | 3 5 2
3 7 5 | 2 6 8 | 9 1 4
2 4 1 | 5 9 3 | 7 8 6
------+-------+------
4 3 2 | 9 8 1 | 6 7 5
6 1 7 | 4 2 5 | 8 9 3
5 9 8 | 7 3 6 | 2 4 1

## Bracmat

The program:

{sudokuSolver.bra

Solves any 9x9 sudoku, using backtracking.
Not a simple brute force algorithm!}

sudokuSolver=
( sudoku
= ( new
= create
. ( create
= a
.  !arg:%(<3:?a) ?arg
& ( !a
.  !arg:
& 1 2 3 4 5 6 7 8 9
| create\$!arg
)
create\$(!a+1 !arg)
|
)
& create\$(0 0 0 0):?(its.Tree)
& ( init
= cell remainingCells remainingRows x y
.  !arg
: ( ?y
. ?x
. (.%?cell ?remainingCells) ?remainingRows
)
& (  !cell:#
& ( !cell
. mod\$(!x,3)
div\$(!x,3)
mod\$(!y,3)
div\$(!y,3)
)
|
)
(  !remainingCells:
& init\$(!y+1.0.!remainingRows)
| init
\$ ( !y
. !x+1
. (.!remainingCells) !remainingRows
)
)
|
)
& out\$!arg
& (its.Set)\$(!(its.Tree).init\$(0.0.!arg))
: ?(its.Tree)
)
( Display
= val
. put\$(str\$("|~~~|~~~|~~~|" \n))
&  !(its.Tree)
:  ?
( ?
.  ?
( ?&put\$"|"
.  ?
( ?
.  ?
( ( ?
.  ?val
& !val:% %
& put\$"-"
|  !val:
& put\$" "
| put\$!val
)
& ~
)
?
| ?&put\$"|"&~
)
?
| ?&put\$\n&~
)
?
|  ?
& put\$(str\$("|~~~|~~~|~~~|" \n))
& ~
)
?
|
)
( Set
= update certainValue a b c d
, tree branch todo DOING loop dcba minlen len minp
. ( update
= path rempath value tr
, k z x y trc p v branch s n
.  !arg:(?path.?value.?tr.?trc)
& (  !path:%?path ?rempath
& `(  !tr
: ?k (!path:?p.?branch) ?z
& `( update\$(!rempath.!value.!branch.!p !trc)
: ?s
& update
\$ (!path !rempath.!value.!z.!trc)
: ?n
& !k (!p.!s) !n
)
| !tr
)
| !DOING:(?.!trc)&!value
|  !tr:?x !value ?y
& `( !x !y
: ( ~:@
& (  !todo:? (?v.!trc) ?
& ( !v:!x !y
| out
\$ (mismatch v !v "<>" x y !x !y)
& get'
)
| (!x !y.!trc) !todo:?todo
)
| % %
| &!DOING:(?.!trc)
)
)
| !tr
)
)
& !arg:(?tree.?todo)
& ( loop
=  !todo:
|  !todo
: ((?certainValue.%?d %?c %?b %?a):?DOING) ?todo
& update\$(!a ? !c ?.!certainValue.!tree.)
: ?tree
& update\$(!a !b <>!c ?.!certainValue.!tree.)
: ?tree
& update\$(<>!a ? !c !d.!certainValue.!tree.)
: ?tree
& !loop
)
& !loop
& ( ~( !tree
:  ?
(?.? (?.? (?.? (?.% %) ?) ?) ?)
?
)
| 9:?minlen
& :?minp
& ( len
=
.  !arg:% %?arg&1+len\$!arg
| 1
)
& (  !tree
:  ?
( ?a
.  ?
( ?b
.  ?
( ?c
.  ?
( ?d
.  % %:?p
& len\$!p:<!minlen:?minlen
& !d !c !b !a:?dcba
& !p:?:?minp
& ~
)
?
)
?
)
?
)
?
|  !minp
:  ?
( %@?n
& (its.Set)\$(!tree.!n.!dcba):?tree
)
?
)
)
& !tree
)
(Tree=)
)
( new
= puzzle
. new\$((its.sudoku),!arg):?puzzle
& (puzzle..Display)\$
);

Solve a sudoku that is hard for a brute force solver:

new'( sudokuSolver
, (.- - - - - - - - -)
(.- - - - - 3 - 8 5)
(.- - 1 - 2 - - - -)
(.- - - 5 - 7 - - -)
(.- - 4 - - - 1 - -)
(.- 9 - - - - - - -)
(.5 - - - - - - 7 3)
(.- - 2 - 1 - - - -)
(.- - - - 4 - - - 9)
);

Solution:

|~~~|~~~|~~~|
|987|654|321|
|246|173|985|
|351|928|746|
|~~~|~~~|~~~|
|128|537|694|
|634|892|157|
|795|461|832|
|~~~|~~~|~~~|
|519|286|473|
|472|319|568|
|863|745|219|
|~~~|~~~|~~~|

## C

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

The following code is really only good for size 3 puzzles. A longer, even less readable version here could handle size 4s.

#include <stdio.h>

void show(int *x)
{
int i, j;
for (i = 0; i < 9; i++) {
if (!(i % 3)) putchar('\n');
for (j = 0; j < 9; j++)
printf(j % 3 ? "%2d" : "%3d", *x++);
putchar('\n');
}
}

int trycell(int *x, int pos)
{
int row = pos / 9;
int col = pos % 9;
int i, j, used = 0;

if (pos == 81) return 1;
if (x[pos]) return trycell(x, pos + 1);

for (i = 0; i < 9; i++)
used |= 1 << (x[i * 9 + col] - 1);

for (j = 0; j < 9; j++)
used |= 1 << (x[row * 9 + j] - 1);

row = row / 3 * 3;
col = col / 3 * 3;
for (i = row; i < row + 3; i++)
for (j = col; j < col + 3; j++)
used |= 1 << (x[i * 9 + j] - 1);

for (x[pos] = 1; x[pos] <= 9; x[pos]++, used >>= 1)
if (!(used & 1) && trycell(x, pos + 1)) return 1;

x[pos] = 0;
return 0;
}

void solve(const char *s)
{
int i, x[81];
for (i = 0; i < 81; i++)
x[i] = s[i] >= '1' && s[i] <= '9' ? s[i] - '0' : 0;

if (trycell(x, 0))
show(x);
else
puts("no solution");
}

int main(void)
{
solve( "5x..7...."
"6..195..."
".98....6."
"8...6...3"
"4..8.3..1"
"7...2...6"
".6....28."
"...419..5"
"....8..79" );

return 0;
}

## C#

### Backtracking

Translation of: Java
using System;

class SudokuSolver
{
private int[] grid;

public SudokuSolver(String s)
{
grid = new int[81];
for (int i = 0; i < s.Length; i++)
{
grid[i] = int.Parse(s[i].ToString());
}
}

public void solve()
{
try
{
placeNumber(0);
Console.WriteLine("Unsolvable!");
}
catch (Exception ex)
{
Console.WriteLine(ex.Message);
Console.WriteLine(this);
}
}

public void placeNumber(int pos)
{
if (pos == 81)
{
throw new Exception("Finished!");
}
if (grid[pos] > 0)
{
placeNumber(pos + 1);
return;
}
for (int n = 1; n <= 9; n++)
{
if (checkValidity(n, pos % 9, pos / 9))
{
grid[pos] = n;
placeNumber(pos + 1);
grid[pos] = 0;
}
}
}

public bool checkValidity(int val, int x, int y)
{
for (int i = 0; i < 9; i++)
{
if (grid[y * 9 + i] == val || grid[i * 9 + x] == val)
return false;
}
int startX = (x / 3) * 3;
int startY = (y / 3) * 3;
for (int i = startY; i < startY + 3; i++)
{
for (int j = startX; j < startX + 3; j++)
{
if (grid[i * 9 + j] == val)
return false;
}
}
return true;
}

public override string ToString()
{
string sb = "";
for (int i = 0; i < 9; i++)
{
for (int j = 0; j < 9; j++)
{
sb += (grid[i * 9 + j] + " ");
if (j == 2 || j == 5)
sb += ("| ");
}
sb += ('\n');
if (i == 2 || i == 5)
sb += ("------+-------+------\n");
}
return sb;
}

public static void Main(String[] args)
{
new SudokuSolver("850002400" +
"720000009" +
"004000000" +
"000107002" +
"305000900" +
"040000000" +
"000080070" +
"017000000" +
"000036040").solve();
}
}

### Best First Search

using System.Linq;
using static System.Linq.Enumerable;
using System.Collections.Generic;
using System;
using System.Runtime.CompilerServices;

namespace SodukoFastMemoBFS {
internal readonly record struct Square (int Row, int Col);
internal record Constraints (IEnumerable<int> ConstrainedRange, Square Square);
internal class Cache : Dictionary<Square, Constraints> { };
internal record CacheGrid (int[][] Grid, Cache Cache);

internal static class SudokuFastMemoBFS {
internal static U Fwd<T, U>(this T data, Func<T, U> f) => f(data);

[MethodImpl(MethodImplOptions.AggressiveInlining)]
private static int RowCol(int rc) => rc <= 2 ? 0 : rc <= 5 ? 3 : 6;

private static bool Solve(this CacheGrid cg, Constraints constraints, int finished) {
var (row, col) = constraints.Square;
foreach (var i in constraints.ConstrainedRange) {
cg.Grid[row][col] = i;
if (cg.Cache.Count == finished || cg.Solve(cg.Next(constraints.Square), finished))
return true;
}
cg.Grid[row][col] = 0;
return false;
}

private static readonly int[] domain = Range(0, 9).ToArray();
private static readonly int[] range = Range(1, 9).ToArray();

private static bool Valid(this int[][] grid, int row, int col, int val) {
for (var i = 0; i < 9; i++)
if (grid[row][i] == val || grid[i][col] == val)
return false;
for (var r = RowCol(row); r < RowCol(row) + 3; r++)
for (var c = RowCol(col); c < RowCol(col) + 3; c++)
if (grid[r][c] == val)
return false;
return true;
}

private static IEnumerable<int> Constraints(this int[][] grid, int row, int col) =>
range.Where(val => grid.Valid(row, col, val));

private static Constraints Next(this CacheGrid cg, Square square) =>
cg.Cache.ContainsKey(square)
? cg.Cache[square]
: cg.Cache[square]=cg.Grid.SortedCells();

private static Constraints SortedCells(this int[][] grid) =>
(from row in domain
from col in domain
where grid[row][col] == 0
let cell = new Constraints(grid.Constraints(row, col), new Square(row, col))
orderby cell.ConstrainedRange.Count() ascending
select cell).First();

private static CacheGrid Parse(string input) =>
input
.Select((c, i) => (index: i, val: int.Parse(c.ToString())))
.GroupBy(id => id.index / 9)
.Select(grp => grp.Select(id => id.val).ToArray())
.ToArray()
.Fwd(grid => new CacheGrid(grid, new Cache()));

public static string AsString(this int[][] grid) =>
string.Join('\n', grid.Select(row => string.Concat(row)));

public static int[][] Run(string input) {
var cg = Parse(input);
var marked = cg.Grid.SelectMany(row => row.Where(c => c > 0)).Count();
return cg.Solve(cg.Grid.SortedCells(), 80 - marked) ? cg.Grid : new int[][] { Array.Empty<int>() };
}
}
}

Usage

using System.Linq;
using static System.Linq.Enumerable;
using static System.Console;
using System.IO;

namespace SodukoFastMemoBFS {
static class Program {

static void Main(string[] args) {
var num = int.Parse(args[0]);
var puzzles = File.ReadLines(@"sudoku17.txt").Take(num);
var single = puzzles.First();

var watch = new System.Diagnostics.Stopwatch();
watch.Start();
WriteLine(SudokuFastMemoBFS.Run(single).AsString());
watch.Stop();
WriteLine(\$"{single}: {watch.ElapsedMilliseconds} ms");

WriteLine(\$"Doing {num} puzzles");
var total = 0.0;
watch.Start();
foreach (var puzzle in puzzles) {
watch.Reset();
watch.Start();
SudokuFastMemoBFS.Run(puzzle);
watch.Stop();
total += watch.ElapsedMilliseconds;
Write(".");
}
watch.Stop();
WriteLine(\$"\nPuzzles:{num}, Total:{total} ms, Average:{total / num:0.00} ms");
}
}
}

Output

693784512
487512936
125963874
932651487
568247391
741398625
319475268
856129743
274836159
000000010400000000020000000000050407008000300001090000300400200050100000000806000: 336 ms
Doing 100 puzzles
....................................................................................................
Puzzles:100, Total:5316 ms, Average:53.16 ms

### Solver

using Microsoft.SolverFoundation.Solvers;

namespace Sudoku
{
class Program
{
private static int[,] B = new int[,] {{9,7,0, 3,0,0, 0,6,0},
{0,6,0, 7,5,0, 0,0,0},
{0,0,0, 0,0,8, 0,5,0},

{0,0,0, 0,0,0, 6,7,0},
{0,0,0, 0,3,0, 0,0,0},
{0,5,3, 9,0,0, 2,0,0},

{7,0,0, 0,2,5, 0,0,0},
{0,0,2, 0,1,0, 0,0,8},
{0,4,0, 0,0,7, 3,0,0}};

private static CspTerm[] GetSlice(CspTerm[][] sudoku, int Ra, int Rb, int Ca, int Cb)
{
CspTerm[] slice = new CspTerm[9];
int i = 0;
for (int row = Ra; row < Rb + 1; row++)
for (int col = Ca; col < Cb + 1; col++)
{
{
slice[i++] = sudoku[row][col];
}
}
return slice;
}

static void Main(string[] args)
{
ConstraintSystem S = ConstraintSystem.CreateSolver();
CspDomain Z = S.CreateIntegerInterval(1, 9);
CspTerm[][] sudoku = S.CreateVariableArray(Z, "cell", 9, 9);
for (int row = 0; row < 9; row++)
{
for (int col = 0; col < 9; col++)
{
if (B[row, col] > 0)
{
}
}
S.AddConstraints(S.Unequal(GetSlice(sudoku, row, row, 0, 8)));
}
for (int col = 0; col < 9; col++)
{
S.AddConstraints(S.Unequal(GetSlice(sudoku, 0, 8, col, col)));
}
for (int a = 0; a < 3; a++)
{
for (int b = 0; b < 3; b++)
{
S.AddConstraints(S.Unequal(GetSlice(sudoku, a * 3, a * 3 + 2, b * 3, b * 3 + 2)));
}
}
ConstraintSolverSolution soln = S.Solve();
object[] h = new object[9];
for (int row = 0; row < 9; row++)
{
if ((row % 3) == 0) System.Console.WriteLine();
for (int col = 0; col < 9; col++)
{
soln.TryGetValue(sudoku[row][col], out h [col]);
}
System.Console.WriteLine("{0}{1}{2} {3}{4}{5} {6}{7}{8}", h[0],h[1],h[2],h[3],h[4],h[5],h[6],h[7],h[8]);
}
}
}
}

Produces:

975 342 861
861 759 432
324 168 957

219 584 673
487 236 519
653 971 284

738 425 196
592 613 748
146 897 325

### "Dancing Links"/Algorithm X

using System;
using System.Collections.Generic;
using System.Text;
using static System.Linq.Enumerable;

public class Sudoku
{
public static void Main2() {
string puzzle = "....7.94.....9...53....5.7...74..1..463...........7.8.8........7......28.5.26....";
string solution = new Sudoku().Solutions(puzzle).FirstOrDefault() ?? puzzle;
Print(puzzle, solution);
}

private DLX dlx;

public void Build() {
const int rows = 9 * 9 * 9, columns = 4 * 9 * 9;
dlx = new DLX(rows, columns);
for (int i = 0; i < columns; i++) dlx.AddHeader();

for (int cell = 0, row = 0; row < 9; row++) {
for (int column = 0; column < 9; column++) {
int box = row / 3 * 3 + column / 3;
for (int digit = 0; digit < 9; digit++) {
dlx.AddRow(cell, 81 + row * 9 + digit, 2 * 81 + column * 9 + digit, 3 * 81 + box * 9 + digit);
}
cell++;
}
}
}

public IEnumerable<string> Solutions(string puzzle) {
if (puzzle == null) throw new ArgumentNullException(nameof(puzzle));
if (puzzle.Length != 81) throw new ArgumentException("The input is not of the correct length.");
if (dlx == null) Build();

for (int i = 0; i < puzzle.Length; i++) {
if (puzzle[i] == '0' || puzzle[i] == '.') continue;
if (puzzle[i] < '1' && puzzle[i] > '9') throw new ArgumentException(\$"Input contains an invalid character: ({puzzle[i]})");
int digit = puzzle[i] - '0' - 1;
dlx.Give(i * 9 + digit);
}
return Iterator();

IEnumerable<string> Iterator() {
var sb = new StringBuilder(new string('.', 81));
foreach (int[] rows in dlx.Solutions()) {
foreach (int r in rows) {
sb[r / 81 * 9 + r / 9 % 9] = (char)(r % 9 + '1');
}
yield return sb.ToString();
}
}
}

static void Print(string left, string right) {
foreach (string line in GetPrintLines(left).Zip(GetPrintLines(right), (l, r) => l + "\t" + r)) {
Console.WriteLine(line);
}

IEnumerable<string> GetPrintLines(string s) {
int r = 0;
foreach (string row in s.Cut(9)) {
yield return r == 0
? "╔═══╤═══╤═══╦═══╤═══╤═══╦═══╤═══╤═══╗"
: r % 3 == 0
? "╠═══╪═══╪═══╬═══╪═══╪═══╬═══╪═══╪═══╣"
: "╟───┼───┼───╫───┼───┼───╫───┼───┼───╢";
yield return "║ " + row.Cut(3).Select(segment => segment.DelimitWith(" │ ")).DelimitWith(" ║ ") + " ║";
r++;
}
yield return "╚═══╧═══╧═══╩═══╧═══╧═══╩═══╧═══╧═══╝";
}
}

}

public class DLX //Some functionality elided
{
private readonly Header root = new Header(null, null) { Size = int.MaxValue };
private readonly List<Node> rows;
private readonly Stack<Node> solutionNodes = new Stack<Node>();
private int initial = 0;

public DLX(int rowCapacity, int columnCapacity) {
columns = new List<Header>(columnCapacity);
rows = new List<Node>(rowCapacity);
}

h.AttachLeftRight();
}

public void AddRow(params int[] newRow) {
Node first = null;
if (newRow != null) {
for (int i = 0; i < newRow.Length; i++) {
if (newRow[i] < 0) continue;
if (first == null) first = AddNode(rows.Count, newRow[i]);
}
}
}

private Node AddNode(int row, int column) {
Node n = new Node(null, null, columns[column].Up, columns[column], columns[column], row);
n.AttachUpDown();
return n;
}

private void AddNode(Node firstNode, int column) {
Node n = new Node(firstNode.Left, firstNode, columns[column].Up, columns[column], columns[column], firstNode.Row);
n.AttachLeftRight();
n.AttachUpDown();
}

public void Give(int row) {
solutionNodes.Push(rows[row]);
CoverMatrix(rows[row]);
initial++;
}

public IEnumerable<int[]> Solutions() {
try {
Node node = ChooseSmallestColumn().Down;
do {
if (node == node.Head) {
if (node == root) {
yield return solutionNodes.Select(n => n.Row).ToArray();
}
if (solutionNodes.Count > initial) {
node = solutionNodes.Pop();
UncoverMatrix(node);
node = node.Down;
}
} else {
solutionNodes.Push(node);
CoverMatrix(node);
node = ChooseSmallestColumn().Down;
}
} while(solutionNodes.Count > initial || node != node.Head);
} finally {
Restore();
}
}

private void Restore() {
while (solutionNodes.Count > 0) UncoverMatrix(solutionNodes.Pop());
initial = 0;
}

private Header ChooseSmallestColumn() {
Header traveller = root, choice = root;
do {
if (traveller.Size < choice.Size) choice = traveller;
} while (traveller != root && choice.Size > 0);
return choice;
}

private void CoverRow(Node row) {
Node traveller = row.Right;
while (traveller != row) {
traveller.DetachUpDown();
traveller = traveller.Right;
}
}

private void UncoverRow(Node row) {
Node traveller = row.Left;
while (traveller != row) {
traveller.AttachUpDown();
traveller = traveller.Left;
}
}

private void CoverColumn(Header column) {
column.DetachLeftRight();
Node traveller = column.Down;
while (traveller != column) {
CoverRow(traveller);
traveller = traveller.Down;
}
}

private void UncoverColumn(Header column) {
Node traveller = column.Up;
while (traveller != column) {
UncoverRow(traveller);
traveller = traveller.Up;
}
column.AttachLeftRight();
}

private void CoverMatrix(Node node) {
Node traveller = node;
do {
traveller = traveller.Right;
} while (traveller != node);
}

private void UncoverMatrix(Node node) {
Node traveller = node;
do {
traveller = traveller.Left;
} while (traveller != node);
}

private class Node
{
public Node(Node left, Node right, Node up, Node down, Header head, int row) {
Left = left ?? this;
Right = right ?? this;
Up = up ?? this;
Down = down ?? this;
Row = row;
}

public Node Left { get; set; }
public Node Right { get; set; }
public Node Up { get; set; }
public Node Down { get; set; }
public int Row { get; }

public void AttachLeftRight() {
this.Left.Right = this;
this.Right.Left = this;
}

public void AttachUpDown() {
this.Up.Down = this;
this.Down.Up = this;
}

public void DetachLeftRight() {
this.Left.Right = this.Right;
this.Right.Left = this.Left;
}

public void DetachUpDown() {
this.Up.Down = this.Down;
this.Down.Up = this.Up;
}

}

private class Header : Node
{
public Header(Node left, Node right) : base(left, right, null, null, null, -1) { }

public int Size { get; set; }
}

}

static class Extensions
{
public static IEnumerable<string> Cut(this string input, int length)
{
for (int cursor = 0; cursor < input.Length; cursor += length) {
if (cursor + length > input.Length) yield return input.Substring(cursor);
else yield return input.Substring(cursor, length);
}
}

public static string DelimitWith<T>(this IEnumerable<T> source, string separator) => string.Join(separator, source);
}
Output:
╔═══╤═══╤═══╦═══╤═══╤═══╦═══╤═══╤═══╗	╔═══╤═══╤═══╦═══╤═══╤═══╦═══╤═══╤═══╗
║ . │ . │ . ║ . │ 7 │ . ║ 9 │ 4 │ . ║	║ 2 │ 1 │ 5 ║ 8 │ 7 │ 6 ║ 9 │ 4 │ 3 ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢	╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ . │ . │ . ║ . │ 9 │ . ║ . │ . │ 5 ║	║ 6 │ 7 │ 8 ║ 3 │ 9 │ 4 ║ 2 │ 1 │ 5 ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢	╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ 3 │ . │ . ║ . │ . │ 5 ║ . │ 7 │ . ║	║ 3 │ 4 │ 9 ║ 1 │ 2 │ 5 ║ 8 │ 7 │ 6 ║
╠═══╪═══╪═══╬═══╪═══╪═══╬═══╪═══╪═══╣	╠═══╪═══╪═══╬═══╪═══╪═══╬═══╪═══╪═══╣
║ . │ . │ 7 ║ 4 │ . │ . ║ 1 │ . │ . ║	║ 5 │ 8 │ 7 ║ 4 │ 3 │ 2 ║ 1 │ 6 │ 9 ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢	╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ 4 │ 6 │ 3 ║ . │ . │ . ║ . │ . │ . ║	║ 4 │ 6 │ 3 ║ 9 │ 8 │ 1 ║ 7 │ 5 │ 2 ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢	╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ . │ . │ . ║ . │ . │ 7 ║ . │ 8 │ . ║	║ 1 │ 9 │ 2 ║ 6 │ 5 │ 7 ║ 3 │ 8 │ 4 ║
╠═══╪═══╪═══╬═══╪═══╪═══╬═══╪═══╪═══╣	╠═══╪═══╪═══╬═══╪═══╪═══╬═══╪═══╪═══╣
║ 8 │ . │ . ║ . │ . │ . ║ . │ . │ . ║	║ 8 │ 2 │ 6 ║ 7 │ 4 │ 3 ║ 5 │ 9 │ 1 ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢	╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ 7 │ . │ . ║ . │ . │ . ║ . │ 2 │ 8 ║	║ 7 │ 3 │ 4 ║ 5 │ 1 │ 9 ║ 6 │ 2 │ 8 ║
╟───┼───┼───╫───┼───┼───╫───┼───┼───╢	╟───┼───┼───╫───┼───┼───╫───┼───┼───╢
║ . │ 5 │ . ║ 2 │ 6 │ . ║ . │ . │ . ║	║ 9 │ 5 │ 1 ║ 2 │ 6 │ 8 ║ 4 │ 3 │ 7 ║
╚═══╧═══╧═══╩═══╧═══╧═══╩═══╧═══╧═══╝	╚═══╧═══╧═══╩═══╧═══╧═══╩═══╧═══╧═══╝

## C++

Translation of: Java
#include <iostream>
using namespace std;

class SudokuSolver {
private:
int grid[81];

public:

SudokuSolver(string s) {
for (unsigned int i = 0; i < s.length(); i++) {
grid[i] = (int) (s[i] - '0');
}
}

void solve() {
try {
placeNumber(0);
cout << "Unsolvable!" << endl;
} catch (char* ex) {
cout << ex << endl;
cout << this->toString() << endl;
}
}

void placeNumber(int pos) {
if (pos == 81) {
throw (char*) "Finished!";
}
if (grid[pos] > 0) {
placeNumber(pos + 1);
return;
}
for (int n = 1; n <= 9; n++) {
if (checkValidity(n, pos % 9, pos / 9)) {
grid[pos] = n;
placeNumber(pos + 1);
grid[pos] = 0;
}
}
}

bool checkValidity(int val, int x, int y) {
for (int i = 0; i < 9; i++) {
if (grid[y * 9 + i] == val || grid[i * 9 + x] == val)
return false;
}
int startX = (x / 3) * 3;
int startY = (y / 3) * 3;
for (int i = startY; i < startY + 3; i++) {
for (int j = startX; j < startX + 3; j++) {
if (grid[i * 9 + j] == val)
return false;
}
}
return true;
}

string toString() {
string sb;
for (int i = 0; i < 9; i++) {
for (int j = 0; j < 9; j++) {
char c[2];
c[0] = grid[i * 9 + j] + '0';
c[1] = '\0';
sb.append(c);
sb.append(" ");
if (j == 2 || j == 5)
sb.append("| ");
}
sb.append("\n");
if (i == 2 || i == 5)
sb.append("------+-------+------\n");
}
return sb;
}

};

int main() {
SudokuSolver ss("850002400"
"720000009"
"004000000"
"000107002"
"305000900"
"040000000"
"000080070"
"017000000"
"000036040");
ss.solve();
return EXIT_SUCCESS;
}

## Clojure

(ns rosettacode.sudoku
(:use [clojure.pprint :only (cl-format)]))

(defn- compatible? [m x y n]
(let [n= #(= n (get-in m [%1 %2]))]
(or (n= y x)
(let [c (count m)]
(and (zero? (get-in m [y x]))
(not-any? #(or (n= y %) (n= % x)) (range c))
(let [zx (* c (quot x c)), zy (* c (quot y c))]
(every? false?
(map n= (range zy (+ zy c)) (range zx (+ zx c))))))))))

(defn solve [m]
(let [c (count m)]
(loop [m m, x 0, y 0]
(if (= y c) m
(let [ng (->> (range 1 c)
(filter #(compatible? m x y %))
first
(assoc-in m [y x]))]
(if (= x (dec c))
(recur ng 0 (inc y))
(recur ng (inc x) y)))))))
sudoku>(cl-format true "~{~{~a~^ ~}~%~}"
(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]])
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

## Common Lisp

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

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

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

## Crystal

Based on the Java implementation presented in the video "Create a Sudoku Solver In Java...".

GRID_SIZE = 9

def isNumberInRow(board, number, row)
board[row].includes?(number)
end
def isNumberInColumn(board, number, column)
board.any?{|row| row[column] == number }
end
def isNumberInBox(board, number, row, column)
localBoxRow = row - row % 3
localBoxColumn = column - column % 3
(localBoxRow...(localBoxRow+3)).each do |i|
(localBoxColumn...(localBoxColumn+3)).each do |j|
return true if board[i][j] == number
end
end
false
end

def isValidPlacement(board, number, row, column)
return !isNumberInRow(board, number, row) &&
!isNumberInColumn(board, number, column) &&
!isNumberInBox(board, number, row, column)
end

def solveBoard(board)
board.each_with_index do |row, i|
row.each_with_index do |cell, j|
if(cell == 0)
(1..GRID_SIZE).each do |n|
if(isValidPlacement(board,n,i,j))
board[i][j]=n
if(solveBoard(board))
return true
else
board[i][j]=0
end
end
end
return false
end
end
end
return true
end

def printBoard(board)
board.each_with_index do |row, i|
row.each_with_index do |cell, j|
print cell
print '|' if j == 2 || j == 5
print '\n' if j == 8
end
print "-"*11 + '\n' if i == 2 || i == 5
end
print '\n'
end

board = [
[7, 0, 2, 0, 5, 0, 6, 0, 0],
[0, 0, 0, 0, 0, 3, 0, 0, 0],
[1, 0, 0, 0, 0, 9, 5, 0, 0],
[8, 0, 0, 0, 0, 0, 0, 9, 0],
[0, 4, 3, 0, 0, 0, 7, 5, 0],
[0, 9, 0, 0, 0, 0, 0, 0, 8],
[0, 0, 9, 7, 0, 0, 0, 0, 5],
[0, 0, 0, 2, 0, 0, 0, 0, 0],
[0, 0, 7, 0, 4, 0, 2, 0, 3]]

printBoard(board)
if(solveBoard(board))
printBoard(board)
end

Output:
702|050|600
000|003|000
100|009|500
-----------
800|000|090
043|000|750
090|000|008
-----------
009|700|005
000|200|000
007|040|203

732|458|619
956|173|824
184|629|537
-----------
871|564|392
643|892|751
295|317|468
-----------
329|786|145
418|235|976
567|941|283

## Curry

Copied from Curry: Example Programs.

-----------------------------------------------------------------------------
--- Solving Su Doku puzzles in Curry with FD constraints
---
--- @author Michael Hanus
--- @version December 2005
-----------------------------------------------------------------------------

import CLPFD
import List

-- Solving a Su Doku puzzle represented as a matrix of numbers (possibly free
-- variables):
sudoku :: [[Int]] -> Success
sudoku m =
domain (concat m) 1 9 & -- define domain of all digits
foldr1 (&) (map allDifferent m) & -- all rows contain different digits
foldr1 (&) (map allDifferent (transpose m)) & -- all columns have different digits
foldr1 (&) (map allDifferent (squaresOfNine m)) & -- all 3x3 squares are different
labeling [FirstFailConstrained] (concat m)

-- translate a matrix into a list of small 3x3 squares
squaresOfNine :: [[a]] -> [[a]]
squaresOfNine [] = []
squaresOfNine (l1:l2:l3:ls) = group3Rows [l1,l2,l3] ++ squaresOfNine ls

group3Rows l123 = if null (head l123) then [] else
concatMap (take 3) l123 : group3Rows (map (drop 3) l123)

-- read a Su Doku specification written as a list of strings containing digits
-- and spaces
readSudoku :: [String] -> [[Int]]
readSudoku s = map (map transDigit) s
where
transDigit c = if c==' ' then x else ord c - ord '0'
where x free

-- show a solved Su Doku matrix
showSudoku :: [[Int]] -> String
showSudoku = unlines . map (concatMap (\i->[chr (i + ord '0'),' ']))

-- the main function, e.g., evaluate (main s1):
main s | sudoku m = putStrLn (showSudoku m)
where m = readSudoku s

s1 = ["9 2 5 ",
" 4 6 3 ",
" 3 6",
" 9 2 ",
" 5 8 ",
" 7 4 3",
"7 1 ",
" 5 2 4 ",
" 1 6 9"]

s2 = ["819 5 ",
" 2 75 ",
" 371 4 6 ",
"4 59 1 ",
"7 3 8 2",
" 3 62 7",
" 5 7 921 ",
" 64 9 ",
" 2 438"]

### Alternative version

Works with: PAKCS

Minimal w/o read or show utilities.

import CLPFD
import Constraint (allC)
import List (transpose)

sudoku :: [[Int]] -> Success
sudoku rows =
domain (concat rows) 1 9
& different rows
& different (transpose rows)
& different blocks
& labeling [] (concat rows)
where
different = allC allDifferent

blocks = [concat ys | xs <- each3 rows
, ys <- transpose \$ map each3 xs
]
each3 xs = case xs of
(x:y:z:rest) -> [x,y,z] : each3 rest
rest -> [rest]

test = [ [_,_,3,_,_,_,_,_,_]
, [4,_,_,_,8,_,_,3,6]
, [_,_,8,_,_,_,1,_,_]
, [_,4,_,_,6,_,_,7,3]
, [_,_,_,9,_,_,_,_,_]
, [_,_,_,_,_,2,_,_,5]
, [_,_,4,_,7,_,_,6,8]
, [6,_,_,_,_,_,_,_,_]
, [7,_,_,6,_,_,5,_,_]
]
main | sudoku xs = xs where xs = test
Output:
Execution time: 0 msec. / elapsed: 10 msec.
[[1,2,3,4,5,6,7,8,9],[4,5,7,1,8,9,2,3,6],[9,6,8,3,2,7,1,5,4],[2,4,9,5,6,1,8,7,3],[5,7,6,9,3,8,4,1,2],[8,3,1,7,4,2,6,9,5],[3,1,4,2,7,5,9,6,8],[6,9,5,8,1,4,3,2,7],[7,8,2,6,9,3,5,4,1]]

## D

Translation of: C++

A little over-engineered solution, that shows some strong static typing useful in larger programs.

import std.stdio, std.range, std.string, std.algorithm, std.array,
std.ascii, std.typecons;

struct Digit {
immutable char d;

this(in char d_) pure nothrow @safe @nogc
in { assert(d_ >= '0' && d_ <= '9'); }
body { this.d = d_; }

this(in int d_) pure nothrow @safe @nogc
in { assert(d_ >= '0' && d_ <= '9'); }
body { this.d = cast(char)d_; } // Required cast.

alias d this;
}

enum size_t sudokuUnitSide = 3;
enum size_t sudokuSide = sudokuUnitSide ^^ 2; // Sudoku grid side.
alias SudokuTable = Digit[sudokuSide ^^ 2];

Nullable!SudokuTable sudokuSolver(in ref SudokuTable problem)
pure nothrow {
alias Tgrid = uint;
Tgrid[SudokuTable.length] grid = void;
problem[].map!(c => c - '0').copy(grid[]);

// DMD doesn't inline this function. Performance loss.
Tgrid access(in size_t x, in size_t y) nothrow @safe @nogc {
return grid[y * sudokuSide + x];
}

// DMD doesn't inline this function. If you want to retain
// the same performance as the C++ entry and you use the DMD
// compiler then this function must be manually inlined.
bool checkValidity(in Tgrid val, in size_t x, in size_t y)
pure nothrow @safe @nogc {
/*static*/ foreach (immutable i; staticIota!(0, sudokuSide))
if (access(i, y) == val || access(x, i) == val)
return false;

immutable startX = (x / sudokuUnitSide) * sudokuUnitSide;
immutable startY = (y / sudokuUnitSide) * sudokuUnitSide;

/*static*/ foreach (immutable i; staticIota!(0, sudokuUnitSide))
/*static*/ foreach (immutable j; staticIota!(0, sudokuUnitSide))
if (access(startX + j, startY + i) == val)
return false;

return true;
}

bool canPlaceNumbers(in size_t pos=0) nothrow @safe @nogc {
if (pos == SudokuTable.length)
return true;
if (grid[pos] > 0)
return canPlaceNumbers(pos + 1);

foreach (immutable n; 1 .. sudokuSide + 1)
if (checkValidity(n, pos % sudokuSide, pos / sudokuSide)) {
grid[pos] = n;
if (canPlaceNumbers(pos + 1))
return true;
grid[pos] = 0;
}

return false;
}

if (canPlaceNumbers) {
//return typeof(return)(grid[]
// .map!(c => Digit(c + '0'))
// .array);
immutable SudokuTable result = grid[]
.map!(c => Digit(c + '0'))
.array;
return typeof(return)(result);
} else
return typeof(return)();
}

string representSudoku(in ref SudokuTable sudo)
pure nothrow @safe out(result) {
assert(result.countchars("1-9") == sudo[].count!q{a != '0'});
assert(result.countchars(".") == sudo[].count!q{a == '0'});
} body {
static assert(sudo.length == 81,
"representSudoku works only with a 9x9 Sudoku.");
string result;

foreach (immutable i; 0 .. sudokuSide) {
foreach (immutable j; 0 .. sudokuSide) {
result ~= sudo[i * sudokuSide + j];
result ~= ' ';
if (j == 2 || j == 5)
result ~= "| ";
}
result ~= "\n";
if (i == 2 || i == 5)
result ~= "------+-------+------\n";
}

return result.replace("0", ".");
}

void main() {
enum ValidateCells(string s) = s.map!Digit.array;

immutable SudokuTable problem = ValidateCells!("
850002400
720000009
004000000
000107002
305000900
040000000
000080070
017000000
000036040"
.removechars(whitespace));
problem.representSudoku.writeln;

immutable solution = problem.sudokuSolver;
if (solution.isNull)
writeln("Unsolvable!");
else
solution.get.representSudoku.writeln;
}
Output:
8 5 . | . . 2 | 4 . .
7 2 . | . . . | . . 9
. . 4 | . . . | . . .
------+-------+------
. . . | 1 . 7 | . . 2
3 . 5 | . . . | 9 . .
. 4 . | . . . | . . .
------+-------+------
. . . | . 8 . | . 7 .
. 1 7 | . . . | . . .
. . . | . 3 6 | . 4 .

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

### Short Version

import std.stdio, std.algorithm, std.range;

const(int)[] solve(immutable int[] s) pure nothrow @safe {
immutable i = s.countUntil(0);
if (i == -1)
return s;

enum B = (int i, int j) => i / 27 ^ j / 27 | (i%9 / 3 ^ j%9 / 3);
immutable c = iota(81)
.filter!(j => !((i - j) % 9 * (i/9 ^ j/9) * B(i, j)))
.map!(j => s[j]).array;

foreach (immutable v; 1 .. 10)
if (!c.canFind(v)) {
const r = solve(s[0 .. i] ~ v ~ s[i + 1 .. \$]);
if (!r.empty)
return r;
}
return null;
}

void main() {
immutable problem = [
8, 5, 0, 0, 0, 2, 4, 0, 0,
7, 2, 0, 0, 0, 0, 0, 0, 9,
0, 0, 4, 0, 0, 0, 0, 0, 0,
0, 0, 0, 1, 0, 7, 0, 0, 2,
3, 0, 5, 0, 0, 0, 9, 0, 0,
0, 4, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 8, 0, 0, 7, 0,
0, 1, 7, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 3, 6, 0, 4, 0];
writefln("%(%s\n%)", problem.solve.chunks(9));
}
Output:
[8, 5, 9, 6, 1, 2, 4, 3, 7]
[7, 2, 3, 8, 5, 4, 1, 6, 9]
[1, 6, 4, 3, 7, 9, 5, 2, 8]
[9, 8, 6, 1, 4, 7, 3, 5, 2]
[3, 7, 5, 2, 6, 8, 9, 1, 4]
[2, 4, 1, 5, 9, 3, 7, 8, 6]
[4, 3, 2, 9, 8, 1, 6, 7, 5]
[6, 1, 7, 4, 2, 5, 8, 9, 3]
[5, 9, 8, 7, 3, 6, 2, 4, 1]

### No-Heap Version

This version is similar to the precedent one, but it shows idioms to avoid memory allocations on the heap. This is enforced by the use of the @nogc attribute.

import std.stdio, std.algorithm, std.range, std.typecons;

Nullable!(const ubyte[81]) solve(in ubyte[81] s) pure nothrow @safe @nogc {
immutable i = s[].countUntil(0);
if (i == -1)
return typeof(return)(s);

static immutable B = (in int i, in int j) pure nothrow @safe @nogc =>
i / 27 ^ j / 27 | (i % 9 / 3 ^ j % 9 / 3);

ubyte[81] c = void;
size_t len = 0;
foreach (immutable int j; 0 .. c.length)
if (!((i - j) % 9 * (i/9 ^ j/9) * B(i, j)))
c[len++] = s[j];

foreach (immutable ubyte v; 1 .. 10)
if (!c[0 .. len].canFind(v)) {
ubyte[81] s2 = void;
s2[0 .. i] = s[0 .. i];
s2[i] = v;
s2[i + 1 .. \$] = s[i + 1 .. \$];
const r = solve(s2);
if (!r.isNull)
return typeof(return)(r);
}
return typeof(return)();
}

void main() {
immutable ubyte[81] problem = [
8, 5, 0, 0, 0, 2, 4, 0, 0,
7, 2, 0, 0, 0, 0, 0, 0, 9,
0, 0, 4, 0, 0, 0, 0, 0, 0,
0, 0, 0, 1, 0, 7, 0, 0, 2,
3, 0, 5, 0, 0, 0, 9, 0, 0,
0, 4, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 8, 0, 0, 7, 0,
0, 1, 7, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 3, 6, 0, 4, 0];
writefln("%(%s\n%)", problem.solve.get[].chunks(9));
}

Same output.

## Delphi

Example taken from C++

type
TIntArray = array of Integer;

{ TSudokuSolver }

TSudokuSolver = class
private
FGrid: TIntArray;

function CheckValidity(val: Integer; x: Integer; y: Integer): Boolean;
function ToString: string; reintroduce;
function PlaceNumber(pos: Integer): Boolean;
public
constructor Create(s: string);

procedure Solve;
end;

implementation

uses
Dialogs;

{ TSudokuSolver }

function TSudokuSolver.CheckValidity(val: Integer; x: Integer; y: Integer
): Boolean;
var
i: Integer;
j: Integer;
StartX: Integer;
StartY: Integer;
begin
for i := 0 to 8 do
begin
if (FGrid[y * 9 + i] = val) or
(FGrid[i * 9 + x] = val) then
begin
Result := False;
Exit;
end;
end;
StartX := (x div 3) * 3;
StartY := (y div 3) * 3;
for i := StartY to Pred(StartY + 3) do
begin
for j := StartX to Pred(StartX + 3) do
begin
if FGrid[i * 9 + j] = val then
begin
Result := False;
Exit;
end;
end;
end;
Result := True;
end;

function TSudokuSolver.ToString: string;
var
sb: string;
i: Integer;
j: Integer;
c: char;
begin
sb := '';
for i := 0 to 8 do
begin
for j := 0 to 8 do
begin
c := (IntToStr(FGrid[i * 9 + j]) + '0')[1];
sb := sb + c + ' ';
if (j = 2) or (j = 5) then sb := sb + '| ';
end;
sb := sb + #13#10;
if (i = 2) or (i = 5) then
sb := sb + '-----+-----+-----' + #13#10;
end;
Result := sb;
end;

function TSudokuSolver.PlaceNumber(pos: Integer): Boolean;
var
n: Integer;
begin
Result := False;
if Pos = 81 then
begin
Result := True;
Exit;
end;
if FGrid[pos] > 0 then
begin
Result := PlaceNumber(Succ(pos));
Exit;
end;
for n := 1 to 9 do
begin
if CheckValidity(n, pos mod 9, pos div 9) then
begin
FGrid[pos] := n;
Result := PlaceNumber(Succ(pos));
if not Result then
FGrid[pos] := 0;
end;
end;
end;

constructor TSudokuSolver.Create(s: string);
var
lcv: Cardinal;
begin
SetLength(FGrid, 81);
for lcv := 0 to Pred(Length(s)) do
FGrid[lcv] := StrToInt(s[Succ(lcv)]);
end;

procedure TSudokuSolver.Solve;
begin
if not PlaceNumber(0) then
ShowMessage('Unsolvable')
else
ShowMessage('Solved!');
end;
end;

Usage:

var
SudokuSolver: TSudokuSolver;
begin
SudokuSolver := TSudokuSolver.Create('850002400' +
'720000009' +
'004000000' +
'000107002' +
'305000900' +
'040000000' +
'000080070' +
'017000000' +
'000036040');
try
SudokuSolver.Solve;
finally
FreeAndNil(SudokuSolver);
end;
end;

## EasyLang

len row[] 810
len col[] 810
len box[] 810
len grid[] 82
#
func init . .
for pos range 81
if pos mod 9 = 0
s\$[] = strsplit input " "
.
dig = number s\$[pos mod 9]
grid[pos] = dig
r = pos div 9
c = pos mod 9
b = r div 3 * 3 + c div 3
row[r * 10 + dig] = 1
col[c * 10 + dig] = 1
box[b * 10 + dig] = 1
.
.
call init
#
func display . .
for i range 81
write grid[i] & " "
if i mod 3 = 2
write " "
.
if i mod 9 = 8
print ""
.
if i mod 27 = 26
print ""
.
.
.
#
func solve pos . .
while grid[pos] <> 0
pos += 1
.
if pos = 81
# solved
call display
break 1
.
r = pos div 9
c = pos mod 9
b = r div 3 * 3 + c div 3
r *= 10
c *= 10
b *= 10
for d = 1 to 9
if row[r + d] = 0 and col[c + d] = 0 and box[b + d] = 0
grid[pos] = d
row[r + d] = 1
col[c + d] = 1
box[b + d] = 1
call solve pos + 1
row[r + d] = 0
col[c + d] = 0
box[b + d] = 0
.
.
grid[pos] = 0
.
call solve 0
#
input_data
5 3 0 0 2 4 7 0 0
0 0 2 0 0 0 8 0 0
1 0 0 7 0 3 9 0 2
0 0 8 0 7 2 0 4 9
0 2 0 9 8 0 0 7 0
7 9 0 0 0 0 0 8 0
0 0 0 0 3 0 5 0 6
9 6 0 0 1 0 3 0 0
0 5 0 6 9 0 0 1 0

## Elixir

Translation of: Erlang
defmodule Sudoku do
def display( grid ), do: ( for y <- 1..9, do: display_row(y, grid) )

def start( knowns ), do: Enum.into( knowns, Map.new )

def solve( grid ) do
sure = solve_all_sure( grid )
solve_unsure( potentials(sure), sure )
end

def task( knowns ) do
IO.puts "start"
start = start( knowns )
display( start )
IO.puts "solved"
solved = solve( start )
display( solved )
IO.puts ""
end

defp bt( grid ), do: bt_reject( is_not_allowed(grid), grid )

defp bt_accept( true, board ), do: throw( {:ok, board} )
defp bt_accept( false, grid ), do: bt_loop( potentials_one_position(grid), grid )

defp bt_loop( {position, values}, grid ), do: ( for x <- values, do: bt( Map.put(grid, position, x) ) )

defp bt_reject( true, _grid ), do: :backtrack
defp bt_reject( false, grid ), do: bt_accept( is_all_correct(grid), grid )

defp display_row( row, grid ) do
for x <- [1, 4, 7], do: display_row_group( x, row, grid )
display_row_nl( row )
end

defp display_row_group( start, row, grid ) do
Enum.each(start..start+2, &IO.write " #{Map.get( grid, {&1, row}, ".")}")
IO.write " "
end

defp display_row_nl( n ) when n in [3,6,9], do: IO.puts "\n"
defp display_row_nl( _n ), do: IO.puts ""

defp is_all_correct( grid ), do: map_size( grid ) == 81

defp is_not_allowed( grid ) do
is_not_allowed_rows( grid ) or is_not_allowed_columns( grid ) or is_not_allowed_groups( grid )
end

defp is_not_allowed_columns( grid ), do: values_all_columns(grid) |> Enum.any?(&is_not_allowed_values/1)

defp is_not_allowed_groups( grid ), do: values_all_groups(grid) |> Enum.any?(&is_not_allowed_values/1)

defp is_not_allowed_rows( grid ), do: values_all_rows(grid) |> Enum.any?(&is_not_allowed_values/1)

defp is_not_allowed_values( values ), do: length( values ) != length( Enum.uniq(values) )

defp group_positions( {x, y} ) do
for colum <- group_positions_close(x), row <- group_positions_close(y), do: {colum, row}
end

defp group_positions_close( n ) when n < 4, do: [1,2,3]
defp group_positions_close( n ) when n < 7, do: [4,5,6]
defp group_positions_close( _n ) , do: [7,8,9]

defp positions_not_in_grid( grid ) do
keys = Map.keys( grid )
for x <- 1..9, y <- 1..9, not {x, y} in keys, do: {x, y}
end

defp potentials_one_position( grid ) do
Enum.min_by( potentials( grid ), fn {_position, values} -> length(values) end )
end

defp potentials( grid ), do: List.flatten( for x <- positions_not_in_grid(grid), do: potentials(x, grid) )

defp potentials( position, grid ) do
useds = potentials_used_values( position, grid )
{position, Enum.to_list(1..9) -- useds }
end

defp potentials_used_values( {x, y}, grid ) do
row_values = (for row <- 1..9, row != x, do: {row, y}) |> potentials_values( grid )
column_values = (for column <- 1..9, column != y, do: {x, column}) |> potentials_values( grid )
group_values = group_positions({x, y}) -- [ {x, y} ] |> potentials_values( grid )
row_values ++ column_values ++ group_values
end

defp potentials_values( keys, grid ) do
for x <- keys, val = grid[x], do: val
end

defp values_all_columns( grid ) do
for x <- 1..9, do:
( for y <- 1..9, do: {x, y} ) |> potentials_values( grid )
end

defp values_all_groups( grid ) do
[[g1,g2,g3], [g4,g5,g6], [g7,g8,g9]] = for x <- [1,4,7], do: values_all_groups(x, grid)
[g1,g2,g3,g4,g5,g6,g7,g8,g9]
end

defp values_all_groups( x, grid ) do
for x_offset <- x..x+2, do: values_all_groups(x, x_offset, grid)
end

defp values_all_groups( _x, x_offset, grid ) do
( for y_offset <- group_positions_close(x_offset), do: {x_offset, y_offset} )
|> potentials_values( grid )
end

defp values_all_rows( grid ) do
for y <- 1..9, do:
( for x <- 1..9, do: {x, y} ) |> potentials_values( grid )
end

defp solve_all_sure( grid ), do: solve_all_sure( solve_all_sure_values(grid), grid )

defp solve_all_sure( [], grid ), do: grid
defp solve_all_sure( sures, grid ) do
solve_all_sure( Enum.reduce(sures, grid, &solve_all_sure_store/2) )
end

defp solve_all_sure_values( grid ), do: (for{position, [value]} <- potentials(grid), do: {position, value} )

defp solve_all_sure_store( {position, value}, acc ), do: Map.put( acc, position, value )

defp solve_unsure( [], grid ), do: grid
defp solve_unsure( _potentials, grid ) do
try do
bt( grid )
catch
{:ok, board} -> board
end
end
end

simple = [{{1, 1}, 3}, {{2, 1}, 9}, {{3, 1},4}, {{6, 1}, 2}, {{7, 1}, 6}, {{8, 1}, 7},
{{4, 2}, 3}, {{7, 2}, 4},
{{1, 3}, 5}, {{4, 3}, 6}, {{5, 3}, 9}, {{8, 3}, 2},
{{2, 4}, 4}, {{3, 4}, 5}, {{7, 4}, 9},
{{1, 5}, 6}, {{9, 5}, 7},
{{3, 6}, 7}, {{7, 6}, 5}, {{8, 6}, 8},
{{2, 7}, 1}, {{5, 7}, 6}, {{6, 7}, 7}, {{9, 7}, 8},
{{3, 8}, 9}, {{6, 8}, 8},
{{2, 9}, 2}, {{3, 9}, 6}, {{4, 9}, 4}, {{7, 9}, 7}, {{8, 9}, 3}, {{9, 9}, 5}]

difficult = [{{6, 2}, 3}, {{8, 2}, 8}, {{9, 2}, 5},
{{3, 3}, 1}, {{5, 3}, 2},
{{4, 4}, 5}, {{6, 4}, 7},
{{3, 5}, 4}, {{7, 5}, 1},
{{2, 6}, 9},
{{1, 7}, 5}, {{8, 7}, 7}, {{9, 7}, 3},
{{3, 8}, 2}, {{5, 8}, 1},
{{5, 9}, 4}, {{9, 9}, 9}]
Output:
start
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

start
. . .  . . .  . . .
. . .  . . 3  . 8 5
. . 1  . 2 .  . . .

. . .  5 . 7  . . .
. . 4  . . .  1 . .
. 9 .  . . .  . . .

5 . .  . . .  . 7 3
. . 2  . 1 .  . . .
. . .  . 4 .  . . 9

solved
9 8 7  6 5 4  3 2 1
2 4 6  1 7 3  9 8 5
3 5 1  9 2 8  7 4 6

1 2 8  5 3 7  6 9 4
6 3 4  8 9 2  1 5 7
7 9 5  4 6 1  8 3 2

5 1 9  2 8 6  4 7 3
4 7 2  3 1 9  5 6 8
8 6 3  7 4 5  2 1 9

## Erlang

I first try to solve the Sudoku grid without guessing. For the guessing part I eschew spawning a process for each guess, instead opting for backtracking. It is fun trying new things.

-module( sudoku ).

-export( [display/1, start/1, solve/1, task/0] ).

display( Grid ) -> [display_row(Y, Grid) || Y <- lists:seq(1, 9)].
%% A known value is {{Column, Row}, Value}
%% Top left corner is {1, 1}, Bottom right corner is {9,9}
start( Knowns ) -> dict:from_list( Knowns ).

solve( Grid ) ->
Sure = solve_all_sure( Grid ),
solve_unsure( potentials(Sure), Sure ).

Simple = [{{1, 1}, 3}, {{2, 1}, 9}, {{3, 1},4}, {{6, 1}, 2}, {{7, 1}, 6}, {{8, 1}, 7},
{{4, 2}, 3}, {{7, 2}, 4},
{{1, 3}, 5}, {{4, 3}, 6}, {{5, 3}, 9}, {{8, 3}, 2},
{{2, 4}, 4}, {{3, 4}, 5}, {{7, 4}, 9},
{{1, 5}, 6}, {{9, 5}, 7},
{{3, 6}, 7}, {{7, 6}, 5}, {{8, 6}, 8},
{{2, 7}, 1}, {{5, 7}, 6}, {{6, 7}, 7}, {{9, 7}, 8},
{{3, 8}, 9}, {{6, 8}, 8},
{{2, 9}, 2}, {{3, 9}, 6}, {{4, 9}, 4}, {{7, 9}, 7}, {{8, 9}, 3}, {{9, 9}, 5}],
Difficult = [{{6, 2}, 3}, {{8, 2}, 8}, {{9, 2}, 5},
{{3, 3}, 1}, {{5, 3}, 2},
{{4, 4}, 5}, {{6, 4}, 7},
{{3, 5}, 4}, {{7, 5}, 1},
{{2, 6}, 9},
{{1, 7}, 5}, {{8, 7}, 7}, {{9, 7}, 3},
{{3, 8}, 2}, {{5, 8}, 1},
{{5, 9}, 4}, {{9, 9}, 9}],

bt( Grid ) -> bt_reject( is_not_allowed(Grid), Grid ).

bt_accept( true, Board ) -> erlang:throw( {ok, Board} );
bt_accept( false, Grid ) -> bt_loop( potentials_one_position(Grid), Grid ).

bt_loop( {Position, Values}, Grid ) -> [bt( dict:store(Position, X, Grid) ) || X <- Values].

bt_reject( true, _Grid ) -> backtrack;
bt_reject( false, Grid ) -> bt_accept( is_all_correct(Grid), Grid ).

display_row( Row, Grid ) ->
[display_row_group( X, Row, Grid ) || X <- [1, 4, 7]],
display_row_nl( Row ).

display_row_group( Start, Row, Grid ) ->
[io:fwrite(" ~c", [display_value(X, Row, Grid)]) || X <- [Start, Start+1, Start+2]],
io:fwrite( " " ).

display_row_nl( N ) when N =:= 3; N =:= 6; N =:= 9 -> io:nl(), io:nl();
display_row_nl( _N ) -> io:nl().

display_value( X, Y, Grid ) -> display_value( dict:find({X, Y}, Grid) ).

display_value( error ) -> \$.;
display_value( {ok, Value} ) -> Value + \$0.

is_all_correct( Grid ) -> dict:size( Grid ) =:= 81.

is_not_allowed( Grid ) ->
is_not_allowed_rows( Grid )
orelse is_not_allowed_columns( Grid )
orelse is_not_allowed_groups( Grid ).

is_not_allowed_columns( Grid ) -> lists:any( fun is_not_allowed_values/1, values_all_columns(Grid) ).

is_not_allowed_groups( Grid ) -> lists:any( fun is_not_allowed_values/1, values_all_groups(Grid) ).

is_not_allowed_rows( Grid ) -> lists:any( fun is_not_allowed_values/1, values_all_rows(Grid) ).

is_not_allowed_values( Values ) -> erlang:length( Values ) =/= erlang:length( lists:usort(Values) ).

group_positions( {X, Y} ) -> [{Colum, Row} || Colum <- group_positions_close(X), Row <- group_positions_close(Y)].

group_positions_close( N ) when N < 4 -> [1,2,3];
group_positions_close( N ) when N < 7 -> [4,5,6];
group_positions_close( _N ) -> [7,8,9].

positions_not_in_grid( Grid ) ->
Keys = dict:fetch_keys( Grid ),
[{X, Y} || X <- lists:seq(1, 9), Y <- lists:seq(1, 9), not lists:member({X, Y}, Keys)].

potentials_one_position( Grid ) ->
[{_Shortest, Position, Values} | _T] = lists:sort( [{erlang:length(Values), Position, Values} || {Position, Values} <- potentials( Grid )] ),
{Position, Values}.

potentials( Grid ) -> lists:flatten( [potentials(X, Grid) || X <- positions_not_in_grid(Grid)] ).

potentials( Position, Grid ) ->
Useds = potentials_used_values( Position, Grid ),
{Position, [Value || Value <- lists:seq(1, 9) -- Useds]}.

potentials_used_values( {X, Y}, Grid ) ->
Row_positions = [{Row, Y} || Row <- lists:seq(1, 9), Row =/= X],
Row_values = potentials_values( Row_positions, Grid ),
Column_positions = [{X, Column} || Column <- lists:seq(1, 9), Column =/= Y],
Column_values = potentials_values( Column_positions, Grid ),
Group_positions = lists:delete( {X, Y}, group_positions({X, Y}) ),
Group_values = potentials_values( Group_positions, Grid ),
Row_values ++ Column_values ++ Group_values.

potentials_values( Keys, Grid ) ->
Row_values_unfiltered = [dict:find(X, Grid) || X <- Keys],
[Value || {ok, Value} <- Row_values_unfiltered].

values_all_columns( Grid ) -> [values_all_columns(X, Grid) || X <- lists:seq(1, 9)].

values_all_columns( X, Grid ) ->
Positions = [{X, Y} || Y <- lists:seq(1, 9)],
potentials_values( Positions, Grid ).

values_all_groups( Grid ) ->
[G123, G456, G789] = [values_all_groups(X, Grid) || X <- [1, 4, 7]],
[G1,G2,G3] = G123,
[G4,G5,G6] = G456,
[G7,G8,G9] = G789,
[G1,G2,G3,G4,G5,G6,G7,G8,G9].

values_all_groups( X, Grid ) ->[values_all_groups(X, X_offset, Grid) || X_offset <- [X, X+1, X+2]].

values_all_groups( _X, X_offset, Grid ) ->
Positions = [{X_offset, Y_offset} || Y_offset <- group_positions_close(X_offset)],
potentials_values( Positions, Grid ).

values_all_rows( Grid ) ->[values_all_rows(Y, Grid) || Y <- lists:seq(1, 9)].

values_all_rows( Y, Grid ) ->
Positions = [{X, Y} || X <- lists:seq(1, 9)],
potentials_values( Positions, Grid ).

solve_all_sure( Grid ) -> solve_all_sure( solve_all_sure_values(Grid), Grid ).

solve_all_sure( [], Grid ) -> Grid;
solve_all_sure( Sures, Grid ) -> solve_all_sure( lists:foldl(fun solve_all_sure_store/2, Grid, Sures) ).

solve_all_sure_values( Grid ) -> [{Position, Value} || {Position, [Value]} <- potentials(Grid)].

solve_all_sure_store( {Position, Value}, Acc ) -> dict:store( Position, Value, Acc ).

solve_unsure( [], Grid ) -> Grid;
solve_unsure( _Potentials, Grid ) ->
try
bt( Grid )

catch
_:{ok, Board} -> Board

end.

task( Knowns ) ->
io:fwrite( "Start~n" ),
Start = start( Knowns ),
display( Start ),
io:fwrite( "Solved~n" ),
Solved = solve( Start ),
display( Solved ),
io:nl().

Output:
Start
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

Start
. . .  . . .  . . .
. . .  . . 3  . 8 5
. . 1  . 2 .  . . .

. . .  5 . 7  . . .
. . 4  . . .  1 . .
. 9 .  . . .  . . .

5 . .  . . .  . 7 3
. . 2  . 1 .  . . .
. . .  . 4 .  . . 9

Solved
9 8 7  6 5 4  3 2 1
2 4 6  1 7 3  9 8 5
3 5 1  9 2 8  7 4 6

1 2 8  5 3 7  6 9 4
6 3 4  8 9 2  1 5 7
7 9 5  4 6 1  8 3 2

5 1 9  2 8 6  4 7 3
4 7 2  3 1 9  5 6 8
8 6 3  7 4 5  2 1 9

## ERRE

Sudoku solver. Program solves Sudoku grid with an iterative method: it's taken from ERRE distribution disk and so comments are in Italian. Grid data are contained in the file SUDOKU.TXT

Example of SUDOKU.TXT

503600009

010002600

900000080

000700005

006804100

200003000

030000008

004300050

800006702

0 is the empty cell.

!--------------------------------------------------------------------
! risolve Sudoku: in input il file SUDOKU.TXT
! Metodo seguito : cancellazioni successive e quando non possibile
! ricerca combinatoria sulle celle con due valori
! possibili - max. 30 livelli di ricorsione
! Non risolve se,dopo l'analisi per la cancellazione,
! restano solo celle a 4 valori
!--------------------------------------------------------------------

PROGRAM SUDOKU

LABEL 76,77,88,91,97,99

DIM TAV\$[9,9]  ! 81 caselle in nove quadranti
! cella non definita --> 0/. nel file SUDOKU.TXT
! diventa 123456789 dopo LEGGI_SCHEMA

!---------------------------------------------------------------------------
! tabelle per gestire la ricerca combinatoria
! (primo indice--> livelli ricorsione)
!---------------------------------------------------------------------------
DIM TAV2\$[30,9,9],INFO[30,4]

!\$INCLUDE="PC.LIB"

PROCEDURE MESSAGGI(MEX%)
CASE MEX% OF
1-> LOCATE(21,1) PRINT("Cancellazione successiva - liv. 1") END ->
2-> LOCATE(21,1) PRINT("Cancellazione successiva - liv. 2") END ->
3-> LOCATE(22,1) PRINT("Ricerca combinatoria - liv.";LIVELLO;" ") END ->
END CASE
END PROCEDURE

PROCEDURE VISUALIZZA_SCHEMA
LOCATE(1,1)
PRINT("+---+---+---+---+---+---+---+---+----+")
FOR I=1 TO 9 DO
FOR J=1 TO 9 DO
PRINT("|";)
IF LEN(TAV\$[I,J])=1 THEN
PRINT(" ";TAV\$[I,J];" ";)
ELSE
PRINT(" ";)
END IF
END FOR
PRINT("³")
IF I<>9 THEN PRINT("+---+---+---+---+---+---+---+---+----+") END IF
END FOR
PRINT("+---+---+---+---+---+---+---+---+----+")
END PROCEDURE

!------------------------------------------------------------------------
! in input la cella (riga,colonna)
! in output se ha un valore definito
!------------------------------------------------------------------------
PROCEDURE VALORE_DEFINITO
FLAG%=FALSE
IF LEN(TAV\$[RIGA,COLONNA])=1 THEN FLAG%=TRUE END IF
END PROCEDURE

PROCEDURE SALVA_CONFIG
LIVELLO=LIVELLO+1
FOR R=1 TO 9 DO
FOR S=1 TO 9 DO
TAV2\$[LIVELLO,R,S]=TAV\$[R,S]
END FOR
END FOR
INFO[LIVELLO,0]=1 INFO[LIVELLO,1]=RIGA INFO[LIVELLO,2]=COLONNA
INFO[LIVELLO,3]=SECOND INFO[LIVELLO,4]=THIRD
END PROCEDURE

PROCEDURE RIPRISTINA_CONFIG
91:
LIVELLO=LIVELLO-1
IF INFO[LIVELLO,0]=3 THEN GOTO 91 END IF
FOR R=1 TO 9 DO
FOR S=1 TO 9 DO
TAV\$[R,S]=TAV2\$[LIVELLO,R,S]
END FOR
END FOR
RIGA=INFO[LIVELLO,1] COLONNA=INFO[LIVELLO,2]
SECOND=INFO[LIVELLO,3] THIRD=INFO[LIVELLO,4]
IF INFO[LIVELLO,0]=1 THEN
TAV\$[RIGA,COLONNA]=MID\$(STR\$(SECOND),2)
END IF
IF INFO[LIVELLO,0]=2 THEN
IF THIRD<>0 THEN
TAV\$[RIGA,COLONNA]=MID\$(STR\$(THIRD),2)
ELSE
GOTO 91
END IF
END IF
INFO[LIVELLO,0]=INFO[LIVELLO,0]+1
VISUALIZZA_SCHEMA
END PROCEDURE

PROCEDURE VERIFICA_SE_FINITO
COMPLETO%=TRUE
FOR RIGA=1 TO 9 DO
PRD#=1
FOR COLONNA=1 TO 9 DO
PRD#=PRD#*VAL(TAV\$[RIGA,COLONNA])
END FOR
IF PRD#<>362880 THEN COMPLETO%=FALSE EXIT END IF
END FOR
IF NOT COMPLETO% THEN EXIT PROCEDURE END IF
FOR COLONNA=1 TO 9 DO
PRD#=1
FOR RIGA=1 TO 9 DO
PRD#=PRD#*VAL(TAV\$[RIGA,COLONNA])
END FOR
IF PRD#<>362880 THEN COMPLETO%=FALSE EXIT END IF
END FOR
END PROCEDURE

!-------------------------------------------------------------------
! toglie i valore certi dalle celle sulla
! stessa riga-stessa colonna-stesso quadrante
!-------------------------------------------------------------------
PROCEDURE TOGLI_VALORE

!iniziamo a togliere il valore dalla stessa riga ....
FOR J=1 TO 9 DO
CH\$=TAV\$[RIGA,J] CH=VAL(Z\$)
IF LEN(CH\$)<>1 THEN
CHANGE(CH\$,CH,"-"->CH\$)
TAV\$[RIGA,J]=CH\$
END IF
END FOR
!... iniziamo a togliere il valore dalla stessa colonna ...
FOR I=1 TO 9 DO
CH\$=TAV\$[I,COLONNA] CH=VAL(Z\$)
IF LEN(CH\$)<>1 THEN
CHANGE(CH\$,CH,"-"->CH\$)
TAV\$[I,COLONNA]=CH\$
END IF
END FOR
!... iniziamo a togliere il valore dallo stesso quadrante
R=INT(RIGA/3.1)*3+1
S=INT(COLONNA/3.1)*3+1
FOR I=R TO R+2 DO
FOR J=S TO S+2 DO
CH\$=TAV\$[I,J] CH=VAL(Z\$)
IF LEN(CH\$)<>1 THEN
CHANGE(CH\$,CH,"-"->CH\$)
TAV\$[I,J]=CH\$
END IF
END FOR
END FOR
MESSAGGI(1)
END PROCEDURE

PROCEDURE ESAMINA_SCHEMA
FOR RIGA=1 TO 9 DO
FOR COLONNA=1 TO 9 DO
VALORE_DEFINITO
IF FLAG% THEN
Z\$=TAV\$[RIGA,COLONNA]
TOGLI_VALORE
END IF
END FOR
END FOR
END PROCEDURE

PROCEDURE IDENTIFICA_UNICO
FOR KL=1 TO 9 DO
KL\$=MID\$(STR\$(KL),2)
NN=0
FOR H=1 TO LEN(ZZ\$) DO
IF MID\$(ZZ\$,H,1)=KL\$ THEN NN=NN+1 END IF
END FOR
IF NN=1 THEN Q=INSTR(ZZ\$,KL\$) KL=9 END IF
END FOR
END PROCEDURE

!----------------------------------------------------------------------------
! intercetta i valori unici per le celle ancora non definite
!----------------------------------------------------------------------------
PROCEDURE TOGLI_VALORE2

MESSAGGI(2)
! iniziamo dalle righe ....
OK%=FALSE
FOR RIGA=1 TO 9 DO
ZZ\$=""
FOR COLONNA=1 TO 9 DO
IF LEN(TAV\$[RIGA,COLONNA])<>1 THEN
ZZ\$=ZZ\$+TAV\$[RIGA,COLONNA]
ELSE
ZZ\$=ZZ\$+STRING\$(9," ")
END IF
END FOR
Q=0 IDENTIFICA_UNICO
IF Q<>0 THEN
COLONNA=INT(Q/9.1)+1
TAV\$[RIGA,COLONNA]=KL\$
OK%=TRUE EXIT
END IF
END FOR
IF OK% THEN GOTO 76 END IF

! .... poi dalle colonne ....
FOR COLONNA=1 TO 9 DO
ZZ\$=""
FOR RIGA=1 TO 9 DO
IF LEN(TAV\$[RIGA,COLONNA])<>1 THEN
ZZ\$=ZZ\$+TAV\$[RIGA,COLONNA]
ELSE
ZZ\$=ZZ\$+STRING\$(9," ")
END IF
END FOR
Q=0 IDENTIFICA_UNICO
IF Q<>0 THEN
RIGA=INT(Q/9.1)+1
TAV\$[RIGA,COLONNA]=KL\$ OK%=TRUE EXIT
END IF
END FOR
IF OK% THEN GOTO 76 END IF

!.... e infine i quadranti
FOR QUADRANTE=1 TO 9 DO
ZZ\$=""
1-> R=1 S=1 END ->
2-> R=1 S=4 END ->
3-> R=1 S=7 END ->
4-> R=4 S=1 END ->
5-> R=4 S=4 END ->
6-> R=4 S=7 END ->
7-> R=7 S=1 END ->
8-> R=7 S=4 END ->
9-> R=7 S=7 END ->
END CASE
FOR RIGA=R TO R+2 DO
FOR COLONNA=S TO S+2 DO
IF LEN(TAV\$[RIGA,COLONNA])<>1 THEN
ZZ\$=ZZ\$+TAV\$[RIGA,COLONNA]
ELSE
ZZ\$=ZZ\$+STRING\$(9," ")
END IF
END FOR
END FOR
Q=0 IDENTIFICA_UNICO
IF Q<>0 THEN
CASE Q OF
1..9-> ALFA=R BETA=S END ->
10..18-> ALFA=R BETA=S+1 END ->
19..27-> ALFA=R BETA=S+2 END ->
28..36-> ALFA=R+1 BETA=S END ->
37..45-> ALFA=R+1 BETA=S+1 END ->
46..54-> ALFA=R+1 BETA=S+2 END ->
55..63-> ALFA=R+2 BETA=S END ->
64..72-> ALFA=R+2 BETA=S+1 END ->
OTHERWISE
ALFA=R+2 BETA=S+2
END CASE
77:
TAV\$[ALFA,BETA]=KL\$ EXIT
END IF
END FOR
76:
MESSAGGI(2)
END PROCEDURE

PROCEDURE CONVERTI_VALORE
FINE%=TRUE NESSUNO%=TRUE
FOR RIGA=1 TO 9 DO
FOR COLONNA=1 TO 9 DO
CH\$=TAV\$[RIGA,COLONNA]
IF LEN(CH\$)<>1 THEN
FINE%=FALSE ! flag per fine partita -- trovati tutti
Q=0  ! conta i '-' nella stringa se ce ne sono 8,
! trovato valore
FOR Z=1 TO LEN(CH\$) DO
IF MID\$(CH\$,Z,1)="-" THEN Q=Q+1 ELSE LAST=Z END IF
END FOR
IF Q=8 THEN
CH\$=MID\$(STR\$(LAST),2)
TAV\$[RIGA,COLONNA]=CH\$
NESSUNO%=FALSE
END IF
END IF
END FOR
END FOR
END PROCEDURE

PROCEDURE LEGGI_SCHEMA
OPEN("I",1,"sudoku.txt")
FOR I=1 TO 9 DO
INPUT(LINE,#1,RIGA\$)
FOR J=1 TO 9 DO
CH\$=MID\$(RIGA\$,J,1)
IF CH\$="0" OR CH\$="." THEN
TAV\$[I,J]="123456789"
ELSE
TAV\$[I,J]=CH\$
END IF
END FOR
END FOR
CLOSE(1)
END PROCEDURE

!---------------------------------------------------------------------------
! Praticamente - visita di un albero binario (caso con cella a 2 valori
! possibili)
!---------------------------------------------------------------------------
PROCEDURE RICERCA_COMBINATORIA
TRE%=TRUE
FOR RIGA=1 TO 9 DO
FOR COLONNA=1 TO 9 DO
CH\$=TAV\$[RIGA,COLONNA]
IF LEN(CH\$)<>1 THEN
Q=0 FIRST=0 SECOND=0 THIRD=0
FOR Z=1 TO LEN(CH\$) DO
IF MID\$(CH\$,Z,1)="-" THEN
Q=Q+1
ELSE
IF FIRST=0 THEN
FIRST=Z
ELSE
SECOND=Z
END IF
END IF
END FOR
IF Q=7 THEN
SALVA_CONFIG
TAV\$[RIGA,COLONNA]=MID\$(STR\$(FIRST),2)
TRE%=FALSE
GOTO 97
END IF
END IF
END FOR
END FOR
IF TRE% THEN GOTO 88 END IF
97:
MESSAGGI(3)
EXIT PROCEDURE
88:
QUATTRO%=TRUE
FOR RIGA=1 TO 9 DO
FOR COLONNA=1 TO 9 DO
CH\$=TAV\$[RIGA,COLONNA]
IF LEN(CH\$)<>1 THEN
Q=0 FIRST=0 SECOND=0 THIRD=0
FOR Z=1 TO LEN(CH\$) DO
IF MID\$(CH\$,Z,1)="-" THEN
Q=Q+1
ELSE
IF FIRST=0 THEN
FIRST=Z
ELSE
IF SECOND=0 THEN
SECOND=Z
ELSE
THIRD=Z
END IF
END IF
END IF
END FOR
IF Q=6 THEN
SALVA_CONFIG
TAV\$[RIGA,COLONNA]=MID\$(STR\$(FIRST),2)
QUATTRO%=FALSE
GOTO 97
END IF
END IF
END FOR
END FOR
IF QUATTRO% THEN
LIVELLO=LIVELLO+1
RIPRISTINA_CONFIG
GOTO 97
END IF
! se restano solo celle con 4 valori,forza la chiusura del ramo dell'albero
!\$RCODE="STOP"
END PROCEDURE

BEGIN
CLS
LIVELLO=1 NZ%=0
LEGGI_SCHEMA
WHILE TRUE DO
VISUALIZZA_SCHEMA
99:
NZ%=NZ%+1
ESAMINA_SCHEMA
CONVERTI_VALORE
EXIT IF FINE%
IF NESSUNO% THEN
TOGLI_VALORE2
IF OK%=0 THEN
RICERCA_COMBINATORIA  ! cerca altri celle da assegnare
END IF
END IF
END WHILE
VISUALIZZA_SCHEMA
VERIFICA_SE_FINITO
IF NOT COMPLETO% THEN
LIVELLO=LIVELLO+1
RIPRISTINA_CONFIG
GOTO 99
END IF
END PROGRAM

## F#

### Backtracking

module SudokuBacktrack

//Helpers
let tuple2 a b = a,b
let flip f a b = f b a
let (>>=) f g = Option.bind g f

/// "A1" to "I9" squares as key in values dictionary
let key a b = \$"{a}{b}"

/// Cross product of elements in ax and elements in bx
let cross ax bx = [| for a in ax do for b in bx do key a b |]

// constants
let valid = "1234567890.,"
let rows = "ABCDEFGHI"
let cols = "123456789"
let squares = cross rows cols

// List of all row, cols and boxes: aka units
let unitList =
[for c in cols do cross rows (string c) ]@ // row units
[for r in rows do cross (string r) cols ]@ // col units
[for rs in ["ABC";"DEF";"GHI"] do for cs in ["123";"456";"789"] do cross rs cs ] // box units

/// Dictionary of units for each square
let units =
[for s in squares do s, [| for u in unitList do if u |> Array.contains s then u |] ] |> Map.ofSeq

/// Dictionary of all peer squares in the relevant units wrt square in question
let peers =
[for s in squares do units[s] |> Array.concat |> Array.distinct |> Array.except [s] |> tuple2 s] |> Map.ofSeq

/// Should parse grid in many input formats or return None
let parseGrid grid =
let ints = [for c in grid do if valid |> Seq.contains c then if ",." |> Seq.contains c then 0 else (c |> string |> int)]
if Seq.length ints = 81 then ints |> Seq.zip squares |> Map.ofSeq |> Some else None

/// Outputs single line puzzle with 0 as empty squares
let asString = function
| Some values -> values |> Map.toSeq |> Seq.map (snd>>string) |> String.concat ""
| _ -> "No solution or Parse Failure"

/// Outputs puzzle in 2D format with 0 as empty squares
let prettyPrint = function
| Some (values:Map<_,_>) ->
[for r in rows do [for c in cols do (values[key r c] |> string) ] |> String.concat " " ] |> String.concat "\n"
| _ -> "No solution or Parse Failure"

/// Is digit allowed in the square in question? !!! hot path !!!!
/// Array/Array2D no faster and they need explicit copy since not immutable
let constraints (values:Map<_,_>) s d = peers[s] |> Seq.map (fun p -> values[p]) |> Seq.exists ((=) d) |> not

/// Move to next square or None if out of bounds
let next s = squares |> Array.tryFindIndex ((=)s) |> function Some i when i + 1 < 81 -> Some squares[i + 1] | _ -> None

/// Backtrack recursively and immutably from index
let rec backtracker (values:Map<_,_>) = function
| None -> Some values // solved!
| Some s when values[s] > 0 -> backtracker values (next s) // square not empty
| Some s ->
let rec tracker = function
| [] -> None
| d::dx ->
values
|> Map.change s (Option.map (fun _ -> d))
|> flip backtracker (next s)
|> function
| None -> tracker dx
| success -> success
[for d in 1..9 do if constraints values s d then d] |> tracker

/// solve sudoku using simple backtracking
let solve grid = grid |> parseGrid >>= flip backtracker (Some "A1")

Usage:

open System
open SudokuBacktrack

[<EntryPoint>]
let main argv =
let puzzle = "000028000800010000000000700000600403200004000100700000030400500000000010060000000"
puzzle |> printfn "Puzzle:\n%s"
puzzle |> parseGrid |> prettyPrint |> printfn "Formatted:\n%s"
puzzle |> solve |> prettyPrint |> printfn "Solution:\n%s"

printfn "Press any key to exit"
0
Output:

Puzzle: 000028000800010000000000700000600403200004000100700000030400500000000010060000000 Formatted: 0 0 0 0 2 8 0 0 0 8 0 0 0 1 0 0 0 0 0 0 0 0 0 0 7 0 0 0 0 0 6 0 0 4 0 3 2 0 0 0 0 4 0 0 0 1 0 0 7 0 0 0 0 0 0 3 0 4 0 0 5 0 0 0 0 0 0 0 0 0 1 0 0 6 0 0 0 0 0 0 0 Solution: 6 1 7 3 2 8 9 4 5 8 9 4 5 1 7 2 3 6 3 2 5 9 4 6 7 8 1 9 7 8 6 5 1 4 2 3 2 5 6 8 3 4 1 7 9 1 4 3 7 9 2 6 5 8 7 3 1 4 8 9 5 6 2 4 8 9 2 6 5 3 1 7 5 6 2 1 7 3 8 9 4 Press any key to exit

### Constraint Satisfaction (Norvig)

// https://norvig.com/sudoku.html
// using array O(1) lookup & mutable instead of map O(logn) immutable - now 6 times faster
module SudokuCPSArray
open System

/// from 11 to 99 as squares key maps to 0 to 80 in arrays
let key a b = (9*a + b) - 10

/// Keys generator
let cross ax bx = [| for a in ax do for b in bx do key a b |]

let digits = [|1..9|]
let rows = digits
let cols = digits
let empty = "0,."
let valid = "123456789"+empty
let boxi = [for b in 1..3..9 -> [|b..b+2|]]
let squares = cross rows cols

/// List of all row, cols and boxes: aka units
let unitlist =
[for c in cols -> cross rows [|c|] ]@
[for r in rows -> cross [|r|] cols ]@
[for rs in boxi do for cs in boxi do cross rs cs ]

/// Dictionary of units for each square
let units =
[|for s in squares do [| for u in unitlist do if u |> Array.contains s then u |] |]

/// Dictionary of all peer squares in the relevant units wrt square in question
let peers =
[| for s in squares do units[s] |> Array.concat |> Array.distinct |> Array.except [s] |]

/// 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, [] -> Some st
| 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.
let rec assign (values:int[][]) (s) d =
values[s]
|> Array.filter ((<>)d)
|> List.ofArray |> all (fun vx d1 -> eliminate vx s d1) (Some values)

/// Eliminate digit d from values[s] and propagate when values[s] size is 1.
/// Return Some values, except return None if a contradiction is detected.
and eliminate (values:int[][]) s d =
let peerElim (values1:int[][]) = // If a square s is reduced to one value d, then *eliminate* d from the peers.
match Seq.length values1[s] with
| 0 -> None // contradiction - removed last value
| 1 -> peers[s] |> List.ofArray |> all (fun vx1 s1 -> eliminate vx1 s1 (values1[s] |> Seq.head) ) (Some values1)
| _ -> Some values1

let unitsElim values1 = // If a unit u is reduced to only one place for a value d, then *assign* it there.
units[s]
|> List.ofArray
|> all (fun (vx1:int[][]) u ->
let sx = [for s in u do if vx1[s] |> Seq.contains d then s]
match Seq.length sx with
| 0 -> None
| 1 -> assign vx1 (Seq.head sx) d
| _ -> Some vx1) (Some values1)

match values[s] |> Seq.contains d with
| false -> Some values // Already eliminated, nothing to do
| true ->
values[s] <- values[s]|> Array.filter ((<>)d)
values
|> peerElim
|> Option.bind unitsElim

/// Convert grid into a Map of {square: char} with "0","."or"," for empties.
let parseGrid grid =
let cells = [for c in grid do if valid |> Seq.contains c then if empty |> Seq.contains c then 0 else ((string>>int)c)]
if Seq.length cells = 81 then cells |> Seq.zip squares |> Map.ofSeq |> Some else None

/// Convert grid to a Map of constraint propagated possible values, or return None if a contradiction is detected.
let applyCPS (parsedGrid:Map<_,_>) =
let values = [| for s in squares do digits |]
parsedGrid
|> Seq.filter (fun (KeyValue(_,d)) -> digits |> Seq.contains d)
|> List.ofSeq
|> all (fun vx (KeyValue(s,d)) -> assign vx s d) (Some values)

/// Calculate string centre for each square - which can contain more than 1 digit when debugging
let centre s width =
let n = width - (Seq.length s)
if n <= 0 then s
else
let half = n/2 + (if (n%2>0 && width%2>0) then 1 else 0)
sprintf "%s%s%s" (String(' ',half)) s (String(' ', n - half))

/// Display these values as a 2-D grid. Used for debugging
let prettyPrint (values:int[][]) =
let asString = Seq.map string >> String.concat ""
let width = 1 + ([for s in squares do Seq.length values[s]] |> List.max)
let line = sprintf "%s\n" ((String('-',width*3) |> Seq.replicate 3) |> String.concat "+")
[for r in rows do
for c in cols do
sprintf "%s%s" (centre (asString values[key r c]) width) (if List.contains c [3;6] then "|" else "")
sprintf "\n%s"(if List.contains r [3;6] then line else "") ]
|> String.concat ""

/// Outputs single line puzzle with 0 as empty squares
let asString values = values |> Map.toSeq |> Seq.map (snd>>string) |> String.concat ""

let copy values = values |> Array.map Array.copy

/// Using depth-first search and propagation, try all possible values.
let rec search (values:int[][])=
[for s in squares do if Seq.length values[s] > 1 then Seq.length values[s] ,s]
|> function
| [] -> Some values // Solved!
| list -> // tryPick ~ Norvig's `some`
list |> List.minBy fst
|> fun (_,s) -> values[s] |> Seq.tryPick (fun d -> assign (copy values) s d |> (Option.bind search))

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 -> int[][] option = run None id (applyCPS >> (Option.bind search))
Usage
open System
open SudokuCPSArray
open System.Diagnostics
open System.IO

[<EntryPoint>]
let main argv =
printfn "Easy board solution automatic with constraint propagation"
let easy = "..3.2.6..9..3.5..1..18.64....81.29..7.......8..67.82....26.95..8..2.3..9..5.1.3.."
easy |> solveNoSearch |> printfn "%s"

printfn "Simple elimination not possible"
let simple = "4.....8.5.3..........7......2.....6.....8.4......1.......6.3.7.5..2.....1.4......"
simple |> run "Parse Error" asString id |> printfn "%s"
simple |> solveNoSearch |> printfn "%s"

printfn "Try again with search:"
simple |> solveWithSearch |> printfn "%s"

let watch = Stopwatch()

let hard = "85...24..72......9..4.........1.7..23.5...9...4...........8..7..17..........36.4."
printfn "Hard"
watch.Start()
hard |> solveWithSearch |> printfn "%s"
watch.Stop()
printfn \$"Elapsed milliseconds = {watch.ElapsedMilliseconds } ms"
watch.Reset()

let puzzles =
if Seq.length argv = 1 then
let num = argv[0] |> int
printfn \$"First {num} puzzles in sudoku17 (http://staffhome.ecm.uwa.edu.au/~00013890/sudoku17)"
File.ReadLines(@"sudoku17.txt") |> Seq.take num |>Array.ofSeq
else
printfn \$"All puzzles in sudoku17 (http://staffhome.ecm.uwa.edu.au/~00013890/sudoku17)"
watch.Start()
let result = puzzles |> Array.map solveWithSearchToMapOnly
watch.Stop()
if result |> Seq.forall Option.isSome then
let total = watch.ElapsedMilliseconds
let avg = (float total) /(float result.Length)
printfn \$"\nPuzzles:{result.Length}, Total:%.2f{((float)total)/1000.0} s, Average:%.2f{avg} ms"
else
printfn "Some sudoku17 puzzles failed"
0
Output:
Timings run on i7500U @2.75Ghz CPU, 16GB RAM
Easy board solution automatic with constraint propagation

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

Simple elimination not possible 400000805030000000000700000020000060000080400000010000000603070500200000104000000

4      1679   12679  |  139     2369    269   |   8      1239     5
26789     3    1256789 | 14589   24569   245689 | 12679    1249   124679
2689   15689   125689 |   7     234569  245689 | 12369   12349   123469
------------------------+------------------------+------------------------
3789     2     15789  |  3459   34579    4579  | 13579     6     13789
3679   15679   15679  |  359      8     25679  |   4     12359   12379
36789     4     56789  |  359      1     25679  | 23579   23589   23789
------------------------+------------------------+------------------------
289      89     289   |   6      459      3    |  1259     7     12489
5      6789     3    |   2      479      1    |   69     489     4689
1      6789     4    |  589     579     5789  | 23569   23589   23689

Try again with search: 4 1 7 |3 6 9 |8 2 5 6 3 2 |1 5 8 |9 4 7 9 5 8 |7 2 4 |3 1 6 ------+------+------ 8 2 5 |4 3 7 |1 6 9 7 9 1 |5 8 6 |4 3 2 3 4 6 |9 1 2 |7 5 8 ------+------+------ 2 8 9 |6 4 3 |5 7 1 5 7 3 |2 9 1 |6 8 4 1 6 4 |8 7 5 |2 9 3

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

Elapsed milliseconds = 8 ms All puzzles in sudoku17 (http://staffhome.ecm.uwa.edu.au/~00013890/sudoku17)

Puzzles:49151, Total:80.99 s, Average:1.65 ms

### SLPsolve

// Solve Sudoku Like Puzzles. Nigel Galloway: September 6th., 2018
let fN y n g=let _q n' g'=[for n in n*n'..n*n'+n-1 do for g in g*g'..g*g'+g-1 do yield (n,g)]
let N=[|for n in 0..(y/n)-1 do for g in 0..(y/g)-1 do yield _q n g|]
(fun n' g'->N.[((n'/n)*n+g'/g)])
let fI n=let _q g=[for n in 0..n-1 do yield (g,n)]
let N=[|for n in 0..n-1 do yield _q n|]
(fun g (_:int)->N.[g])
let fG n=let _q g=[for n in 0..n-1 do yield (n,g)]
let N=[|for n in 0..n-1 do yield _q n|]
(fun (_:int) n->N.[n])
let fE v z n g fn=let N,G,B,fn=fI z,fG z,fN z n g,readCSV ',' fn|>List.ofSeq
let fG n g mask=List.except (N n [email protected] n [email protected] n g) mask
let b=List.except(List.map(fun n->(n.row,n.col))fn)[for n in 0..z-1 do for g in 0..z-1 do yield (n,g)]
let q=Map.ofList[for v' in v do yield ((v'),List.choose(fun n->if n.value=v' then Some(n.row,n.col) else None)fn|>List.fold(fun z (n,g)->(n,g)::fG n g z)b)]
(fG,(fun n->Map.find n q),z,v)
let SLPsolve (N,G,z,l)=
let rec nQueens col mask res=[
if col=z then yield res else
yield! List.filter(fun(n,_)->n=col)mask|>List.collect(fun(n,g)->nQueens (col+1) (N n g mask) ((n,g)::res))]
let rec sudoku l res=seq{
match l with
|h::t->let n=nQueens 0 (List.except (List.concat res) (G h)) []
yield! n|>Seq.collect(fun n->sudoku t (n::res))
|_->yield res}
sudoku l []
let printSLP n g=
List.map2(fun n g->List.map(fun(n'
,g')->((n',g'),n))g) (List.rev n) g|>List.concat|>List.sortBy (fun ((_,n),_)->n)|>List.groupBy(fun ((n,_),_)->n)|>List.sortBy(fun(n,_)->n)
|>List.iter(fun (_,n)->n|>Seq.fold(fun z ((_,g),v)->[z..g-1]|>Seq.iter(fun _->printf " |");printf "%s|" v; g+1 ) 0 |>ignore;printfn "")

Usage: Given sud1.csv:

7,1,,4,,6,,2
,,,,7,,,,3
4,,,,,1,,8
,,,,1,3,,,9
,,1,,,,7
2,,,8,6
,2,,1,,,,,4
9,,,,8
,7,,6,,4,,5,2

then

let n=SLPsolve (fE ([1..9]|>List.map(string)) 9 3 3 "sud1.csv")
printSLP ([1..9]|>List.map(string)) (Seq.item 0 n)

Output:
7|1|8|4|3|6|9|2|5|
5|6|2|9|7|8|4|1|3|
4|3|9|5|2|1|6|8|7|
6|8|5|7|1|3|2|4|9|
3|9|1|2|4|5|7|6|8|
2|4|7|8|6|9|5|3|1|
8|2|6|1|5|7|3|9|4|
9|5|4|3|8|2|1|7|6|
1|7|3|6|9|4|8|5|2|

## Forth

Works with: 4tH version 3.60.0
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 + [email protected] 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 + [email protected] ;

: 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
;

\ 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 + [email protected]
dup if
dup i try if
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 [email protected] 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 + [email protected] 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
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 + [email protected] .
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 + [email protected]
;

: add ( n x y --)
xy 2dup
dup checkifoccupied if
dup removenumber
then
try if
.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
\ -------------

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

: bye quit ;

create wordlist \ dictionary
," clearit" ' clearit ,
," 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

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

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

## FreeBASIC

Translation of: VBA
Dim Shared As Integer cuadricula(9, 9), cuadriculaResuelta(9, 9)

Function isSafe(i As Integer, j As Integer, n As Integer) As Boolean
Dim As Integer iMin, jMin, f, c

If cuadricula(i, j) <> 0 Then Return (cuadricula(i, j) = n)

'cuadricula(i, j) es una celda vacía. Compruebe si n está OK
'primero revisa la fila i
For f = 1 To 9
If cuadricula(i, f) = n Then Return False
Next f

'ahora comprueba la columna j
For c = 1 To 9
If cuadricula(c, j) = n Then Return False
Next c

iMin = 1 + 3 * Int((i - 1) / 3)
jMin = 1 + 3 * Int((j - 1) / 3)
For c = iMin To iMin + 2
For f = jMin To jMin + 2
If cuadricula(c, f) = n Then Return False
Next f
Next c

'todas las pruebas estuvieron OK
Return True
End Function

Sub Resolver(i As Integer, j As Integer)
Dim As Integer f, c, n, temp
If i > 9 Then
For c = 1 To 9
For f = 1 To 9
Next f
Next c
Exit Sub
End If
For n = 1 To 9
If isSafe(i, j, n) Then
temp = cuadricula(i, j)
cuadricula(i, j) = n
If j = 9 Then
Resolver i + 1, 1
Else
Resolver i, j + 1
End If
cuadricula(i, j) = temp
End If
Next n
End Sub

Dim As String s(9)
'inicializar la cuadrícula usando 9 cadenas, una por fila
s(1) = "001005070"
s(2) = "920600000"
s(3) = "008000600"
s(4) = "090020401"
s(5) = "000000000"
s(6) = "304080090"
s(7) = "007000300"
s(8) = "000007069"
s(9) = "010800700"

Dim As Integer i, j
For i = 1 To 9
For j = 1 To 9
cuadricula(i, j) = Int(Val(Mid(s(i), j, 1)))
Next j
Next i

Resolver 1, 1
Print "Solucion:"
Color 12: Print "---------+---------+---------"
For i = 1 To 9
For j = 1 To 9
Color 7: Print cuadriculaResuelta(i, j); " ";
Color 12
If (j Mod 3 = 0) And (j <> 9) Then Color 12: Print "|";
Next j
If (i Mod 3 = 0) Then Print !"\n---------+---------+---------" Else Print
Next i
Sleep
Output:
Solucion:
---------+---------+---------
6  3  1 | 2  4  5 | 9  7  8
9  2  5 | 6  7  8 | 1  4  3
4  7  8 | 3  1  9 | 6  5  2
---------+---------+---------
7  9  6 | 5  2  3 | 4  8  1
1  8  2 | 9  6  4 | 5  3  7
3  5  4 | 7  8  1 | 2  9  6
---------+---------+---------
8  6  7 | 4  9  2 | 3  1  5
2  4  3 | 1  5  7 | 8  6  9
5  1  9 | 8  3  6 | 7  2  4
---------+---------+---------

## FutureBasic

First is a short version:

include "ConsoleWindow"
include "NSLog.incl"
include "Util_Containers.incl"

begin globals
dim as container gC
end globals

BeginCDeclaration
short solve_sudoku(short i);
short check_sudoku(short r, short c);
CFMutableStringRef print_sudoku();
EndC

BeginCFunction
short sudoku[9][9] = {
{3,0,0,0,0,1,4,0,9},
{7,0,0,0,0,4,2,0,0},
{0,5,0,2,0,0,0,1,0},
{5,7,0,0,4,3,0,6,0},
{0,9,0,0,0,0,0,3,0},
{0,6,0,7,9,0,0,8,5},
{0,8,0,0,0,5,0,4,0},
{0,0,6,4,0,0,0,0,7},
{9,0,5,6,0,0,0,0,3},
};

short check_sudoku( short r, short c )
{
short i;
short rr, cc;

for (i = 0; i < 9; i++)
{
if (i != c && sudoku[r][i] == sudoku[r][c]) return 0;
if (i != r && sudoku[i][c] == sudoku[r][c]) return 0;
rr = r/3 * 3 + i/3;
cc = c/3 * 3 + i%3;
if ((rr != r || cc != c) && sudoku[rr][cc] == sudoku[r][c]) return 0;
}
return -1;
}

short solve_sudoku( short i )
{
short r, c;

if (i < 0) return 0;
else if (i >= 81) return -1;

r = i / 9;
c = i % 9;

if (sudoku[r][c])
return check_sudoku(r, c) && solve_sudoku(i + 1);
else
for (sudoku[r][c] = 9; sudoku[r][c] > 0; sudoku[r][c]--)
{
if ( solve_sudoku(i) ) return -1;
}
return 0;
}

CFMutableStringRef print_sudoku()
{
short i, j;
CFMutableStringRef mutStr;

mutStr = CFStringCreateMutable( kCFAllocatorDefault, 0 );

for (i = 0; i < 9; i++)
{
for (j = 0; j < 9; j++)
{
CFStringAppendFormat( mutStr, NULL, (CFStringRef)@" %d", sudoku[i][j] );
}
CFStringAppendFormat( mutStr, NULL, (CFStringRef)@"\r" );
}
return( mutStr );
}
EndC

toolbox fn solve_sudoku( short i ) = short
toolbox fn check_sudoku( short r, short c ) = short
toolbox fn print_sudoku() = CFMutableStringRef

dim as short solution
dim as CFMutableStringRef cfRef

gC = " "
cfRef = fn print_sudoku()
fn ContainerCreateWithCFString( cfRef, gC )
print : print "Sudoku challenge:" : print : print gC

solution = fn solve_sudoku(0)

print : print "Sudoku solved:" : print
if ( solution )
gC = " "
cfRef = fn print_sudoku()
fn ContainerCreateWithCFString( cfRef, gC )
print gC
else
print "No solution found"
end if

Output:

Sudoku challenge:

3 0 0 0 0 1 4 0 9
7 0 0 0 0 4 2 0 0
0 5 0 2 0 0 0 1 0
5 7 0 0 4 3 0 6 0
0 9 0 0 0 0 0 3 0
0 6 0 7 9 0 0 8 5
0 8 0 0 0 5 0 4 0
0 0 6 4 0 0 0 0 7
9 0 5 6 0 0 0 0 3

Sudoku solved:

3 2 8 5 6 1 4 7 9
7 1 9 3 8 4 2 5 6
6 5 4 2 7 9 3 1 8
5 7 1 8 4 3 9 6 2
8 9 2 1 5 6 7 3 4
4 6 3 7 9 2 1 8 5
2 8 7 9 3 5 6 4 1
1 3 6 4 2 8 5 9 7
9 4 5 6 1 7 8 2 3

More code in this one, but faster execution:

include "ConsoleWindow"
include "Tlbx Timer.incl"

begin globals
_digits = 9
_setH = 3
_setV = 3
_nSetH = 3
_nSetV = 3

begin record Board
dim as boolean f(_digits,_digits,_digits)
dim as char    match(_digits,_digits)
dim as pointer previousBoard // singly-linked list used to discover repetitions
dim &&
end record

dim quiz as board
dim as long t
dim as double       sProgStartTime

end globals

// 'ordinary' timer used for playing
local fn Milliseconds as long // time in ms since prog start
'~'1
dim as UnsignedWide us

long if ( sProgStartTime == 0.0 )
Microseconds( @us )
sProgStartTime = 4294967296.0*us.hi + us.lo
end if
Microseconds( @us )
end fn = (4294967296.0*us.hi + us.lo - sProgStartTime)'*1e-3

local fn InitMilliseconds
'~'1
sProgStartTime = 0.0
fn Milliseconds
end fn

local mode
local fn CopyBoard( source as ^Board, dest as ^Board )
'~'1
BlockMoveData( source, dest, sizeof( Board ) )
dest.previousBoard = source // linked list
end fn

local fn prepare( b as ^Board )
'~'1
dim as short i, j, n

for i = 1 to _digits
for j = 1 to _digits
for n = 1 to _digits
b.match[i, j] = 0
b.f[i, j, n] = _true
next n
next j
next i
end fn

local fn printBoard( b as ^Board )
'~'1
dim as short i, j

for i = 1 to _digits
for j = 1 to _digits
Print b.match[i, j];
next j
print
next i
end fn

local fn verifica( b as ^Board )
'~'1
dim as short i, j, n, first, x, y, ii
dim as boolean check

check = _true

for i = 1 to _digits
for j = 1 to _digits
long if ( b.match[i, j] == 0 )
check = _false
for n = 1 to _digits
long if ( b.f[i, j, n] != _false )
check = _true
end if
next n
if ( check == _false ) then exit fn
end if
next j
next i

check = _true
for j = 1 to _digits
for n = 1 to _digits
first = 0
for i = 1 to _digits
long if ( b.match[i, j] == n )
long if ( first == 0 )
first = i
xelse
check = _false
exit fn
end if
end if
next i
next n
next j

for i = 1 to _digits
for n = 1 to _digits
first = 0
for j = 1 to _digits
long if ( b.match[i, j] == n )
long if ( first == 0 )
first = j
xelse
check = _false
exit fn
end if
end if
next j
next n
next i

for x = 0 to ( _nSetH - 1 )
for y = 0 to ( _nSetV - 1 )
first = 0
for ii = 0 to ( _digits - 1 )
i = x * _setH + ii mod _setH + 1
j = y * _setV + ii / _setH + 1
long if ( b.match[i, j] == n )
long if ( first == 0 )
first = j
xelse
check = _false
exit fn
end if
end if
next ii
next y
next x

end fn = check

local fn setCell( b as ^Board, x as short, y as short, n as short) as boolean
dim as short   i, j, rx, ry
dim as boolean check

b.match[x, y] = n
for i = 1 to _digits
b.f[x, i, n] = _false
b.f[i, y, n] = _false
next i

rx = (x - 1) / _setH
ry = (y - 1) / _setV

for i = 1 to _setH
for j = 1 to _setV
b.f[ rx * _setH + i, ry * _setV + j, n ] = _false
next j
next i

check = fn verifica( #b )
if ( check == _false ) then exit fn

end fn = check

local fn solve( b as ^Board )
dim as short i, j, n, first, x, y, ii, ppi, ppj
dim as boolean check

check = _true

for i = 1 to _digits
for j = 1 to _digits
long if ( b.match[i, j] == 0 )
first = 0
for n = 1 to _digits
long if ( b.f[i, j, n] != _false )
long if ( first == 0 )
first = n
xelse
first = -1
exit for
end if
end if
next n

long if ( first > 0 )
check = fn setCell( #b, i, j, first )
if ( check == _false ) then exit fn
check = fn solve(#b)
if ( check == _false ) then exit fn
end if

end if
next j
next i

for i = 1 to _digits
for n = 1 to _digits
first = 0

for j = 1 to _digits
if ( b.match[i, j] == n ) then exit for

long if ( b.f[i, j, n] != _false ) and ( b.match[i, j] == 0 )
long if ( first == 0 )
first = j
xelse
first = -1
exit for
end if

end if

next j

long if ( first > 0 )
check = fn setCell( #b, i, first, n )
if ( check == _false ) then exit fn
check = fn solve(#b)
if ( check == _false ) then exit fn
end if

next n
next i

for j = 1 to _digits
for n = 1 to _digits
first = 0

for i = 1 to _digits
if ( b.match[i, j] == n ) then exit for

long if ( b.f[i, j, n] != _false ) and ( b.match[i, j] == 0 )
long if ( first == 0 )
first = i
xelse
first = -1
exit for
end if

end if

next i

long if ( first > 0 )
check = fn setCell( #b, first, j, n )
if ( check == _false ) then exit fn
check = fn solve(#b)
if ( check == _false ) then exit fn
end if

next n
next j

for x = 0 to ( _nSetH - 1 )
for y = 0 to ( _nSetV - 1 )

for n = 1 to _digits
first = 0

for ii = 0 to ( _digits - 1 )

i = x * _setH + ii mod _setH + 1
j = y * _setV + ii / _setH + 1

if ( b.match[i, j] == n ) then exit for

long if ( b.f[i, j, n] != _false ) and ( b.match[i, j] == 0 )
long if ( first == 0 )
first = n
ppi = i
ppj = j
xelse
first = -1
exit for
end if
end if

next ii

long if ( first > 0 )
check = fn setCell( #b, ppi, ppj, n )
if ( check == _false ) then exit fn
check = fn solve(#b)
if ( check == _false ) then exit fn
end if

next n

next y
next x

end fn = check

local fn resolve( b as ^Board )
dim as boolean check, daFinire
dim as long i, j, n
dim as board localBoard

check = fn solve(b)

long if ( check == _false )
exit fn
end if

daFinire = _false

for i = 1 to _digits
for j = 1 to _digits
long if ( b.match[i, j] == 0 )

daFinire = _true

for n = 1 to _digits
long if ( b.f[i, j, n] != _false )

fn CopyBoard( b, @localBoard )

check = fn setCell(@localBoard, i, j, n)

long if ( check != _false )
check = fn resolve( @localBoard )
long if ( check == -1 )
fn CopyBoard( @localBoard, b )

exit fn
end if
end if

end if

next n

end if
next j
next i

long if daFinire
xelse
check = -1
end if

end fn = check

fn InitMilliseconds

fn prepare( @quiz )

DATA 0,0,0,0,2,9,0,8,7
DATA 0,9,7,3,0,0,0,0,0
DATA 0,0,2,0,0,0,4,0,9
DATA 0,0,3,9,0,1,0,0,6
DATA 0,4,0,0,0,0,0,9,0
DATA 9,0,0,7,0,3,1,0,0
DATA 0,0,9,0,0,0,6,0,0
DATA 0,0,0,0,0,5,8,2,0
DATA 2,8,0,1,3,0,0,0,0

dim as short i, j, d
for i = 1 to _digits
for j = 1 to _digits
fn setCell(@quiz, j, i, d)
next j
next i

Print : print "quiz:"
fn printBoard( @quiz )
print : print "-------------------" : print
dim as boolean check

t = fn Milliseconds
check = fn resolve(@quiz)
t = fn Milliseconds - t

if ( check )
print "solution:"; str\$( t/1000.0 ) + " ms"
else
print "No solution found"
end if
fn printBoard( @quiz )

Output:

quiz:
0 0 0 0 0 9 0 0 2
0 9 0 0 4 0 0 0 8
0 7 2 3 0 0 9 0 0
0 3 0 9 0 7 0 0 1
2 0 0 0 0 0 0 0 3
9 0 0 1 0 3 0 5 0
0 0 4 0 0 1 6 8 0
8 0 0 0 9 0 0 2 0
7 0 9 6 0 0 0 0 0

-------------------

solution: 6.956 ms
3 8 6 5 7 9 4 1 2
1 9 5 2 4 6 3 7 8
4 7 2 3 1 8 9 6 5
6 3 8 9 5 7 2 4 1
2 5 1 8 6 4 7 9 3
9 4 7 1 2 3 8 5 6
5 2 4 7 3 1 6 8 9
8 6 3 4 9 5 1 2 7
7 1 9 6 8 2 5 3 4

## Go

Solution using Knuth's DLX. This code follows his paper fairly closely. Input to function solve is an 81 character string. This seems to be a conventional computer representation for Sudoku puzzles.

package main

import "fmt"

// sudoku puzzle representation is an 81 character string
var puzzle = "" +
"394 267 " +
" 3 4 " +
"5 69 2 " +
" 45 9 " +
"6 7" +
" 7 58 " +
" 1 67 8" +
" 9 8 " +
" 264 735"

func main() {
printGrid("puzzle:", puzzle)
if s := solve(puzzle); s == "" {
fmt.Println("no solution")
} else {
printGrid("solved:", s)
}
}

// print grid (with title) from 81 character string
func printGrid(title, s string) {
fmt.Println(title)
for r, i := 0, 0; r < 9; r, i = r+1, i+9 {
fmt.Printf("%c %c %c | %c %c %c | %c %c %c\n", s[i], s[i+1], s[i+2],
s[i+3], s[i+4], s[i+5], s[i+6], s[i+7], s[i+8])
if r == 2 || r == 5 {
fmt.Println("------+-------+------")
}
}
}

// solve puzzle in 81 character string format.
// if solved, result is 81 character string.
// if not solved, result is the empty string.
func solve(u string) string {
// construct an dlx object with 324 constraint columns.
// other than the number 324, this is not specific to sudoku.
d := newDlxObject(324)
// now add constraints that define sudoku rules.
for r, i := 0, 0; r < 9; r++ {
for c := 0; c < 9; c, i = c+1, i+1 {
b := r/3*3 + c/3
n := int(u[i] - '1')
if n >= 0 && n < 9 {
d.addRow([]int{i, 81 + r*9 + n, 162 + c*9 + n,
243 + b*9 + n})
} else {
for n = 0; n < 9; n++ {
d.addRow([]int{i, 81 + r*9 + n, 162 + c*9 + n,
243 + b*9 + n})
}
}
}
}
// run dlx. not sudoku specific.
d.search()
// extract the sudoku-specific 81 character result from the dlx solution.
return d.text()
}

// Knuth's data object
type x struct {
c *y
u, d, l, r *x
// except x0 is not Knuth's. it's pointer to first constraint in row,
// so that the sudoku string can be constructed from the dlx solution.
x0 *x
}

// Knuth's column object
type y struct {
x
s int // size
n int // name
}

// an object to hold the matrix and solution
type dlx struct {
ch []y // all column headers
h *y // ch[0], the root node
o []*x // solution
}

// constructor creates the column headers but no rows.
func newDlxObject(nCols int) *dlx {
ch := make([]y, nCols+1)
h := &ch[0]
d := &dlx{ch, h, nil}
h.c = h
h.l = &ch[nCols].x
ch[nCols].r = &h.x
nh := ch[1:]
for i := range ch[1:] {
hi := &nh[i]
ix := &hi.x
hi.n = i
hi.c = hi
hi.u = ix
hi.d = ix
hi.l = &h.x
h.r = ix
h = hi
}
return d
}

// rows define constraints
func (d *dlx) addRow(nr []int) {
if len(nr) == 0 {
return
}
r := make([]x, len(nr))
x0 := &r[0]
for x, j := range nr {
ch := &d.ch[j+1]
ch.s++
np := &r[x]
np.c = ch
np.u = ch.u
np.d = &ch.x
np.l = &r[(x+len(r)-1)%len(r)]
np.r = &r[(x+1)%len(r)]
np.u.d, np.d.u, np.l.r, np.r.l = np, np, np, np
np.x0 = x0
}
}

// extracts 81 character sudoku string
func (d *dlx) text() string {
b := make([]byte, len(d.o))
for _, r := range d.o {
x0 := r.x0
b[x0.c.n] = byte(x0.r.c.n%9) + '1'
}
return string(b)
}

// the dlx algorithm
func (d *dlx) search() bool {
h := d.h
j := h.r.c
if j == h {
return true
}
c := j
for minS := j.s; ; {
j = j.r.c
if j == h {
break
}
if j.s < minS {
c, minS = j, j.s
}
}

cover(c)
k := len(d.o)
d.o = append(d.o, nil)
for r := c.d; r != &c.x; r = r.d {
d.o[k] = r
for j := r.r; j != r; j = j.r {
cover(j.c)
}
if d.search() {
return true
}
r = d.o[k]
c = r.c
for j := r.l; j != r; j = j.l {
uncover(j.c)
}
}
d.o = d.o[:len(d.o)-1]
uncover(c)
return false
}

func cover(c *y) {
c.r.l, c.l.r = c.l, c.r
for i := c.d; i != &c.x; i = i.d {
for j := i.r; j != i; j = j.r {
j.d.u, j.u.d = j.u, j.d
j.c.s--
}
}
}

func uncover(c *y) {
for i := c.u; i != &c.x; i = i.u {
for j := i.l; j != i; j = j.l {
j.c.s++
j.d.u, j.u.d = j, j
}
}
c.r.l, c.l.r = &c.x, &c.x
}
Output:
puzzle:
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

## Golfscript

Código sacado de http://www.golfscript.com/

Imprime todas las soluciones posibles, sale con un error, pero funciona.

'Solution:'
;'2 8 4 3 7 5 1 6 9
0 0 9 2 0 0 0 0 7
0 0 1 0 0 4 0 0 2
0 5 0 0 0 0 8 0 0
0 0 8 0 0 0 9 0 0
0 0 6 0 0 0 0 4 0
9 0 0 1 0 0 5 0 0
8 0 0 0 0 7 6 0 4
4 2 5 6 8 9 7 3 1'
{9/[n]*puts}:p; #optional formatting

~]{:@0?:^~!{@p}*10,@9/^9/[email protected]^9%>9%[email protected]/^9%3/>3%3/^27/={+}*-{@^<\[email protected]^+>+}/1}do

## Groovy

Adaptive "Non-guessing Then Guessing" Solution

Non-guessing part is iterative. Guessing part is recursive. Implementation uses exception handling to back out of bad guesses.

I consider this a "brute force" solution of sorts, in that it is the same method I use when solving Sudokus manually.

final CELL_VALUES = ('1'..'9')

class GridException extends Exception {
GridException(String message) { super(message) }
}

def string2grid = { string ->
assert string.size() == 81
(0..8).collect { i -> (0..8).collect { j -> string[9*i+j] } }
}

def gridRow = { grid, slot -> grid[slot.i] as Set }

def gridCol = { grid, slot -> grid.collect { it[slot.j] } as Set }

def gridBox = { grid, slot ->
def t, l; (t, l) = [slot.i.intdiv(3)*3, slot.j.intdiv(3)*3]
(0..2).collect { row -> (0..2).collect { col -> grid[t+row][l+col] } }.flatten() as Set
}

def slotList = { grid ->
def slots = (0..8).collect { i -> (0..8).findAll { j -> grid[i][j] == '.' } \
.collect {j -> [i: i, j: j] } }.flatten()
}

def assignCandidates = { grid, slots = slotList(grid) ->
slots.each { slot ->
def unavailable = [gridRow, gridCol, gridBox].collect { it(grid, slot) }.sum() as Set
slot.candidates = CELL_VALUES - unavailable
}
slots.sort { - it.candidates.size() }
if (slots && ! slots[-1].candidates) {
throw new GridException('Invalid Sudoku Grid, overdetermined slot: ' + slots[-1])
}
slots
}

def isSolved = { grid -> ! (grid.flatten().find { it == '.' }) }

def solve
solve = { grid ->
def slots = assignCandidates(grid)
if (! slots) { return grid }
while (slots[-1].candidates.size() == 1) {
def slot = slots.pop()
grid[slot.i][slot.j] = slot.candidates[0]
if (! slots) { return grid }
slots = assignCandidates(grid, slots)
}
if (! slots) { return grid }
def slot = slots.pop()
slot.candidates.each {
if (! isSolved(grid)) {
try {
def sGrid = grid.collect { row -> row.collect { cell -> cell } }
sGrid[slot.i][slot.j] = it
grid = solve(sGrid)
} catch (GridException ge) {
grid[slot.i][slot.j] = '.'
}
}
}
if (!isSolved(grid)) {
slots = assignCandidates(grid)
throw new GridException('Invalid Sudoku Grid, underdetermined slots: ' + slots)
}
grid
}

Test/Benchmark Cases

Mentions of "exceptionally difficult" example in Wikipedia refer to this (former) page: [Exceptionally difficult Sudokus]

def sudokus = [
//Used in Curry solution: ~ 0.1 seconds
'819..5.....2...75..371.4.6.4..59.1..7..3.8..2..3.62..7.5.7.921..64...9.....2..438',

//Used in Perl and PicoLisp solutions: ~ 0.1 seconds
'53..247....2...8..1..7.39.2..8.72.49.2.98..7.79.....8.....3.5.696..1.3...5.69..1.',

//Used in Fortran solution: ~ 0.1 seconds
'..3.2.6..9..3.5..1..18.64....81.29..7.......8..67.82....26.95..8..2.3..9..5.1.3..',

//Used in many other solutions, notably Algol 68: ~ 0.1 seconds
'394..267....3..4..5..69..2..45...9..6.......7..7...58..1..67..8..9..8....264..735',

//Used in C# solution: ~ 0.2 seconds
'97.3...6..6.75.........8.5.......67.....3.....539..2..7...25.....2.1...8.4...73..',

//Used in Oz solution: ~ 0.2 seconds
'4......6.5...8.9..3....1....2.7....1.9.....4.8....3.5....2....7..6.5...8.1......6',

//Used in many other solutions, notably C++: ~ 0.3 seconds
'85...24..72......9..4.........1.7..23.5...9...4...........8..7..17..........36.4.',

//Used in VBA solution: ~ 0.3 seconds
'..1..5.7.92.6.......8...6...9..2.4.1.........3.4.8..9...7...3.......7.69.1.8..7..',

//Used in Forth solution: ~ 0.8 seconds
'.9...4..7.....79..8........4.58.....3.......2.....97.6........4..35.....2..6...8.',

//3rd "exceptionally difficult" example in Wikipedia: ~ 2.3 seconds
'12.3....435....1....4........54..2..6...7.........8.9...31..5.......9.7.....6...8',

//Used in Curry solution: ~ 2.4 seconds
'9..2..5...4..6..3...3.....6...9..2......5..8...7..4..37.....1...5..2..4...1..6..9',

//"AL Escargot", so-called "hardest sudoku" (HA!): ~ 3.0 seconds
'1....7.9..3..2...8..96..5....53..9...1..8...26....4...3......1..4......7..7...3..',

//1st "exceptionally difficult" example in Wikipedia: ~ 6.5 seconds
'12.4..3..3...1..5...6...1..7...9.....4.6.3.....3..2...5...8.7....7.....5.......98',

//Used in Bracmat and Scala solutions: ~ 6.7 seconds
'..............3.85..1.2.......5.7.....4...1...9.......5......73..2.1........4...9',

//2nd "exceptionally difficult" example in Wikipedia: ~ 8.8 seconds
'.......39.....1..5..3.5.8....8.9...6.7...2...1..4.......9.8..5..2....6..4..7.....',

//Used in MATLAB solution: ~15 seconds
'....839..1......3...4....7..42.3....6.......4....7..1..2........8...92.....25...6',

//4th "exceptionally difficult" example in Wikipedia: ~29 seconds
'..3......4...8..36..8...1...4..6..73...9..........2..5..4.7..686........7..6..5..']

sudokus.each { sudoku ->
def grid = string2grid(sudoku)
println '\nPUZZLE'
grid.each { println it }

println '\nSOLUTION'
def start = System.currentTimeMillis()
def solution = solve(grid)
def elapsed = (System.currentTimeMillis() - start)/1000
solution.each { println it }
println "\nELAPSED: \${elapsed} seconds"
}
Output:
(last only):
PUZZLE
[., ., 3, ., ., ., ., ., .]
[4, ., ., ., 8, ., ., 3, 6]
[., ., 8, ., ., ., 1, ., .]
[., 4, ., ., 6, ., ., 7, 3]
[., ., ., 9, ., ., ., ., .]
[., ., ., ., ., 2, ., ., 5]
[., ., 4, ., 7, ., ., 6, 8]
[6, ., ., ., ., ., ., ., .]
[7, ., ., 6, ., ., 5, ., .]

SOLUTION
[1, 2, 3, 4, 5, 6, 7, 8, 9]
[4, 5, 7, 1, 8, 9, 2, 3, 6]
[9, 6, 8, 3, 2, 7, 1, 5, 4]
[2, 4, 9, 5, 6, 1, 8, 7, 3]
[5, 7, 6, 9, 3, 8, 4, 1, 2]
[8, 3, 1, 7, 4, 2, 6, 9, 5]
[3, 1, 4, 2, 7, 5, 9, 6, 8]
[6, 9, 5, 8, 1, 4, 3, 2, 7]
[7, 8, 2, 6, 9, 3, 5, 4, 1]

ELAPSED: 28.978 seconds

Visit the Haskell wiki Sudoku

## Java

public class Sudoku
{
private int mBoard[][];
private int mBoardSize;
private int mBoxSize;
private boolean mRowSubset[][];
private boolean mColSubset[][];
private boolean mBoxSubset[][];

public Sudoku(int board[][]) {
mBoard = board;
mBoardSize = mBoard.length;
mBoxSize = (int)Math.sqrt(mBoardSize);
initSubsets();
}

public void initSubsets() {
mRowSubset = new boolean[mBoardSize][mBoardSize];
mColSubset = new boolean[mBoardSize][mBoardSize];
mBoxSubset = new boolean[mBoardSize][mBoardSize];
for(int i = 0; i < mBoard.length; i++) {
for(int j = 0; j < mBoard.length; j++) {
int value = mBoard[i][j];
if(value != 0) {
setSubsetValue(i, j, value, true);
}
}
}
}

private void setSubsetValue(int i, int j, int value, boolean present) {
mRowSubset[i][value - 1] = present;
mColSubset[j][value - 1] = present;
mBoxSubset[computeBoxNo(i, j)][value - 1] = present;
}

public boolean solve() {
return solve(0, 0);
}

public boolean solve(int i, int j) {
if(i == mBoardSize) {
i = 0;
if(++j == mBoardSize) {
return true;
}
}
if(mBoard[i][j] != 0) {
return solve(i + 1, j);
}
for(int value = 1; value <= mBoardSize; value++) {
if(isValid(i, j, value)) {
mBoard[i][j] = value;
setSubsetValue(i, j, value, true);
if(solve(i + 1, j)) {
return true;
}
setSubsetValue(i, j, value, false);
}
}

mBoard[i][j] = 0;
return false;
}

private boolean isValid(int i, int j, int val) {
val--;
boolean isPresent = mRowSubset[i][val] || mColSubset[j][val] || mBoxSubset[computeBoxNo(i, j)][val];
return !isPresent;
}

private int computeBoxNo(int i, int j) {
int boxRow = i / mBoxSize;
int boxCol = j / mBoxSize;
return boxRow * mBoxSize + boxCol;
}

public void print() {
for(int i = 0; i < mBoardSize; i++) {
if(i % mBoxSize == 0) {
System.out.println(" -----------------------");
}
for(int j = 0; j < mBoardSize; j++) {
if(j % mBoxSize == 0) {
System.out.print("| ");
}
System.out.print(mBoard[i][j] != 0 ? ((Object) (Integer.valueOf(mBoard[i][j]))) : "-");
System.out.print(' ');
}

System.out.println("|");
}

System.out.println(" -----------------------");
}

public static void main(String[] args) {
int[][] board = {
{8, 5, 0, 0, 0, 2, 4, 0, 0},
{7, 2, 0, 0, 0, 0, 0, 0, 9},
{0, 0, 4, 0, 0, 0, 0, 0, 0},
{0, 0, 0, 1, 0, 7, 0, 0, 2},
{3, 0, 5, 0, 0, 0, 9, 0, 0},
{0, 4, 0, 0, 0, 0, 0, 0, 0},
{0, 0, 0, 0, 8, 0, 0, 7, 0},
{0, 1, 7, 0, 0, 0, 0, 0, 0},
{0, 0, 0, 0, 3, 6, 0, 4, 0}
};
Sudoku s = new Sudoku(board);
System.out.print("Starting grid:\n");
s.print();
if (s.solve()) {
System.out.print("\nSolution:\n");
s.print();
} else {
System.out.println("\nUnsolvable!");
}
}
}
Output:
Starting grid:
-----------------------
| 8 5 - | - - 2 | 4 - - |
| 7 2 - | - - - | - - 9 |
| - - 4 | - - - | - - - |
-----------------------
| - - - | 1 - 7 | - - 2 |
| 3 - 5 | - - - | 9 - - |
| - 4 - | - - - | - - - |
-----------------------
| - - - | - 8 - | - 7 - |
| - 1 7 | - - - | - - - |
| - - - | - 3 6 | - 4 - |
-----------------------

Solution:
-----------------------
| 8 5 9 | 6 1 2 | 4 3 7 |
| 7 2 3 | 8 5 4 | 1 6 9 |
| 1 6 4 | 3 7 9 | 5 2 8 |
-----------------------
| 9 8 6 | 1 4 7 | 3 5 2 |
| 3 7 5 | 2 6 8 | 9 1 4 |
| 2 4 1 | 5 9 3 | 7 8 6 |
-----------------------
| 4 3 2 | 9 8 1 | 6 7 5 |
| 6 1 7 | 4 2 5 | 8 9 3 |
| 5 9 8 | 7 3 6 | 2 4 1 |
-----------------------

## JavaScript

#### ES6

//-------------------------------------------[ Dancing Links and Algorithm X ]--
/**
* The doubly-doubly circularly linked data object.
* Data object X
*/

class DoX {
/**
* @param {string} V
* @param {!DoX=} H
*/

constructor(V, H) {
this.V = V;
this.L = this;
this.R = this;
this.U = this;
this.D = this;
this.S = 1;
this.H = H || this;
H && (H.S += 1);
}
}

/**
* Helper function to help build a horizontal doubly linked list.
* @param {!DoX} e An existing node in the list.
* @param {!DoX} n A new node to add to the right of the existing node.
* @return {!DoX}
*/

const addRight = (e, n) => {
n.R = e.R;
n.L = e;
e.R.L = n;
return e.R = n;
};

/**
* Helper function to help build a vertical doubly linked list.
* @param {!DoX} e An existing node in the list.
* @param {!DoX} n A new node to add below the existing node.
*/

const addBelow = (e, n) => {
n.D = e.D;
n.U = e;
e.D.U = n;
return e.D = n;
};

/**
* Verbatim copy of DK's search algorithm. The meat of the DLX algorithm.
* @param {!DoX} h The root node.
* @param {!Array<!DoX>} s The solution array.
*/

const search = function(h, s) {
if (h.R == h) {
printSol(s);
} else {
let c = chooseColumn(h);
cover(c);
for (let r = c.D; r != c; r = r.D) {
s.push(r);
for (let j = r.R; r !=j; j = j.R) {
cover(j.H);
}
search(h, s);
r = s.pop();
for (let j = r.R; j != r; j = j.R) {
uncover(j.H);
}
}
uncover(c);
}
};

/**
* Verbatim copy of DK's algorithm for choosing the next column object.
* @param {!DoX} h
* @return {!DoX}
*/

const chooseColumn = h => {
let s = Number.POSITIVE_INFINITY;
let c = h;
for(let j = h.R; j != h; j = j.R) {
if (j.S < s) {
c = j;
s = j.S;
}
}
return c;
};

/**
* Verbatim copy of DK's cover algorithm
* @param {!DoX} c
*/

const cover = c => {
c.L.R = c.R;
c.R.L = c.L;
for (let i = c.D; i != c; i = i.D) {
for (let j = i.R; j != i; j = j.R) {
j.U.D = j.D;
j.D.U = j.U;
j.H.S = j.H.S - 1;
}
}
};

/**
* Verbatim copy of DK's cover algorithm
* @param {!DoX} c
*/

const uncover = c => {
for (let i = c.U; i != c; i = i.U) {
for (let j = i.L; i != j; j = j.L) {
j.H.S = j.H.S + 1;
j.U.D = j;
j.D.U = j;
}
}
c.L.R = c;
c.R.L = c;
};

//-----------------------------------------------------------[ Print Helpers ]--
/**
* Given the standard string format of a grid, print a formatted view of it.
* @param {!string|!Array} a
*/

const printGrid = function(a) {

const getChar = c => {
let r = Number(c);
if (isNaN(r)) { return c }

let o = 48;
if (r > 9 && r < 36) { o = 55 }
if (r >= 36) { o = 61 }
return String.fromCharCode(r + o)
};

a = 'string' == typeof a ? a.split('') : a;

let U = Math.sqrt(a.length);
let N = Math.sqrt(U);
let line = new Array(N).fill('+').reduce((p, c) => {
p.push(... Array.from(new Array(1 + N*2).fill('-')));
p.push(c);
return p;
}, ['\n+']).join('') + '\n';

a = a.reduce(function(p, c, i) {
let d = i && !(i % U), G = i && !(i % N);
i = !(i % (U * N));
d && !i && (p += '|\n| ');
d && i && (p += '|');
i && (p = '' + p + line + '| ');
return '' + p + (G && !d ? '| ' : '') + getChar(c) + ' ';
}, '') + '|' + line;
console.log(a);

};

/**
* Given a search solution, print the resultant grid.
* @param {!Array<!DoX>} a An array of data objects
*/

const printSol = a => {
printGrid(a.reduce((p, c) => {
let [i, v] = c.V.split(':');
p[i * 1] = v;
return p;
}, new Array(a.length).fill('.')));
};

//----------------------------------------------[ Grid to Exact cover Matrix ]--
/**
* Helper to get some meta about the grid.
* @param {!string} s The standard string representation of a grid.
* @return {!Array}
*/

const gridMeta = s => {
const g = s.split('');
const cellCount = g.length;
const tokenCount = Math.sqrt(cellCount);
const N = Math.sqrt(tokenCount);
const g2D = g.map(e => isNaN(e * 1) ?
new Array(tokenCount).fill(1).map((_, i) => i + 1) :
[e * 1]);
return [cellCount, N, tokenCount, g2D];
};

/**
* Given a cell grid index, return the row, column and box indexes.
* @param {!number} n The n-value of the grid. 3 for a 9x9 sudoku.
* @return {!function(!number): !Array<!number>}
*/

const indexesN = n => i => {
let c = Math.floor(i / (n * n));
i %= n * n;
return [c, i, Math.floor(c / n) * n + Math.floor(i / n)];
};

/**
* Given a puzzle string, reduce it to an exact-cover matrix and use
* Donald Knuth's DLX algorithm to solve it.
* @param puzString
*/

const reduceGrid = puzString => {

printGrid(puzString);
const [
numCells, // The total number of cells in a grid (81 for a 9x9 grid)
N, // the 'n' value of the grid. (3 for a 9x9 grid)
U, // The total number of unique tokens to be placed.
g2D // A 2D array representation of the grid, with each element
// being an array of candidates for a cell. Known cells are
// single element arrays.
] = gridMeta(puzString);

const getIndex = indexesN(N);

/**
* The DLX Header row.
* Its length is 4 times the grid's size. This is to be able to encode
* each of the 4 Sudoku constrains, onto each of the cells of the grid.
* The array is initialised with unlinked DoX nodes, but in the next step
* those nodes are all linked.
* @type {!Array.<!DoX>}
*/

const headRow = new Array(4 * numCells)
.fill('')
.map((_, i) => new DoX(`H\${i}`));

/**
* The header row root object. This is circularly linked to be to the left
* of the first header object in the header row array.
* It is used as the entry point into the DLX algorithm.
* @type {!DoX}
*/

let H = new DoX('ROOT');

/**
* Transposed the sudoku puzzle into a exact cover matrix, so it can be passed
* to the DLX algorithm to solve.
*/

for (let i = 0; i < numCells; i++) {
const [ri, ci, bi] = getIndex(i);
g2D[i].forEach(num => {
let id = `\${i}:\${num}`;
let candIdx = num - 1;

// The 4 columns that we will populate.
const A = headRow[i];
const B = headRow[numCells + candIdx + (ri * U)];
const C = headRow[(numCells * 2) + candIdx + (ci * U)];
const D = headRow[(numCells * 3) + candIdx + (bi * U)];

// The Row-Column Constraint
let rcc = addBelow(A.U, new DoX(id, A));

// The Row-Number Constraint
let rnc = addBelow(B.U, addRight(rcc, new DoX(id, B)));

// The Column-Number Constraint
let cnc = addBelow(C.U, addRight(rnc, new DoX(id, C)));

// The Block-Number Constraint
});
}
search(H, []);
};

[
'819..5.....2...75..371.4.6.4..59.1..7..3.8..2..3.62..7.5.7.921..64...9.....2..438',
'53..247....2...8..1..7.39.2..8.72.49.2.98..7.79.....8.....3.5.696..1.3...5.69..1.',
'..3.2.6..9..3.5..1..18.64....81.29..7.......8..67.82....26.95..8..2.3..9..5.1.3..',
'394..267....3..4..5..69..2..45...9..6.......7..7...58..1..67..8..9..8....264..735',
'97.3...6..6.75.........8.5.......67.....3.....539..2..7...25.....2.1...8.4...73..',
'4......6.5...8.9..3....1....2.7....1.9.....4.8....3.5....2....7..6.5...8.1......6',
'85...24..72......9..4.........1.7..23.5...9...4...........8..7..17..........36.4.',
'..1..5.7.92.6.......8...6...9..2.4.1.........3.4.8..9...7...3.......7.69.1.8..7..',
'.9...4..7.....79..8........4.58.....3.......2.....97.6........4..35.....2..6...8.',
'12.3....435....1....4........54..2..6...7.........8.9...31..5.......9.7.....6...8',
'9..2..5...4..6..3...3.....6...9..2......5..8...7..4..37.....1...5..2..4...1..6..9',
'1....7.9..3..2...8..96..5....53..9...1..8...26....4...3......1..4......7..7...3..',
'12.4..3..3...1..5...6...1..7...9.....4.6.3.....3..2...5...8.7....7.....5.......98',
'..............3.85..1.2.......5.7.....4...1...9.......5......73..2.1........4...9',
'.......39.....1..5..3.5.8....8.9...6.7...2...1..4.......9.8..5..2....6..4..7.....',
'....839..1......3...4....7..42.3....6.......4....7..1..2........8...92.....25...6',
'..3......4...8..36..8...1...4..6..73...9..........2..5..4.7..686........7..6..5..'
].forEach(reduceGrid);

// Or of you want to create all the grids of a particular n-size.
// I run out of stack space at n = 9
let n = 2;
let s = new Array(Math.pow(n, 4)).fill('.').join('');
reduceGrid(s);

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

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

## Julia

function check(i, j)
id, im = div(i, 9), mod(i, 9)
jd, jm = div(j, 9), mod(j, 9)

jd == id && return true
jm == im && return true

div(id, 3) == div(jd, 3) &&
div(jm, 3) == div(im, 3)
end

const lookup = zeros(Bool, 81, 81)

for i in 1:81
for j in 1:81
lookup[i,j] = check(i-1, j-1)
end
end

function solve_sudoku(callback::Function, grid::Array{Int64})
(function solve()
for i in 1:81
if grid[i] == 0
t = Dict{Int64, Void}()

for j in 1:81
if lookup[i,j]
t[grid[j]] = nothing
end
end

for k in 1:9
grid[i] = k
solve()
end
end

grid[i] = 0
return
end
end

callback(grid)
end)()
end

function display(grid)
for i in 1:length(grid)
print(grid[i], " ")
i % 3 == 0 && print(" ")
i % 9 == 0 && print("\n")
i % 27 == 0 && print("\n")
end
end

grid = Int64[5, 3, 0, 0, 2, 4, 7, 0, 0,
0, 0, 2, 0, 0, 0, 8, 0, 0,
1, 0, 0, 7, 0, 3, 9, 0, 2,
0, 0, 8, 0, 7, 2, 0, 4, 9,
0, 2, 0, 9, 8, 0, 0, 7, 0,
7, 9, 0, 0, 0, 0, 0, 8, 0,
0, 0, 0, 0, 3, 0, 5, 0, 6,
9, 6, 0, 0, 1, 0, 3, 0, 0,
0, 5, 0, 6, 9, 0, 0, 1, 0]

solve_sudoku(display, grid)
Output:
5 3 9  8 2 4  7 6 1
6 7 2  1 5 9  8 3 4
1 8 4  7 6 3  9 5 2

3 1 8  5 7 2  6 4 9
4 2 5  9 8 6  1 7 3
7 9 6  3 4 1  2 8 5

8 4 1  2 3 7  5 9 6
9 6 7  4 1 5  3 2 8
2 5 3  6 9 8  4 1 7

## Kotlin

Translation of: C++
// version 1.2.10

class Sudoku(rows: List<String>) {
private val grid = IntArray(81)
private var solved = false

init {
require(rows.size == 9 && rows.all { it.length == 9 }) {
"Grid must be 9 x 9"
}
for (i in 0..8) {
for (j in 0..8 ) grid[9 * i + j] = rows[i][j] - '0'
}
}

fun solve() {
println("Starting grid:\n\n\$this")
placeNumber(0)
println(if (solved) "Solution:\n\n\$this" else "Unsolvable!")
}

private fun placeNumber(pos: Int) {
if (solved) return
if (pos == 81) {
solved = true
return
}
if (grid[pos] > 0) {
placeNumber(pos + 1)
return
}
for (n in 1..9) {
if (checkValidity(n, pos % 9, pos / 9)) {
grid[pos] = n
placeNumber(pos + 1)
if (solved) return
grid[pos] = 0
}
}
}

private fun checkValidity(v: Int, x: Int, y: Int): Boolean {
for (i in 0..8) {
if (grid[y * 9 + i] == v || grid[i * 9 + x] == v) return false
}
val startX = (x / 3) * 3
val startY = (y / 3) * 3
for (i in startY until startY + 3) {
for (j in startX until startX + 3) {
if (grid[i * 9 + j] == v) return false
}
}
return true
}

override fun toString(): String {
val sb = StringBuilder()
for (i in 0..8) {
for (j in 0..8) {
sb.append(grid[i * 9 + j])
sb.append(" ")
if (j == 2 || j == 5) sb.append("| ")
}
sb.append("\n")
if (i == 2 || i == 5) sb.append("------+-------+------\n")
}
return sb.toString()
}
}

fun main(args: Array<String>) {
val rows = listOf(
"850002400",
"720000009",
"004000000",
"000107002",
"305000900",
"040000000",
"000080070",
"017000000",
"000036040"
)
Sudoku(rows).solve()
}
Output:
Starting grid:

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

Solution:

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

## Lua

### without FFI, slow

--9x9 sudoku solver in lua
--based on a branch and bound solution
--fields are not tried in plain order
--but in a way to detect dead ends earlier
concat=table.concat
insert=table.insert
constraints = { } --contains a table with 3 constraints for every field
-- a contraint "cons" is a table containing all fields which must not have the same value
-- a field "f" is an integer from 1 to 81
columns = { } --contains all column-constraints variable "c"
rows = { } --contains all row-constraints variable "r"
blocks = { } --contains all block-constraints variable "b"

--initialize all constraints
for f = 1, 81 do
constraints[f] = { }
end
all_constraints = { } --union of colums, rows and blocks
for i = 1, 9 do
columns[i] = {
unknown = 9, --number of fields not yet solved
unknowns = { } --fields not yet solved
}
insert(all_constraints, columns[i])
rows[i] = {
unknown = 9, -- see l.15
unknowns = { } -- see l.16
}
insert(all_constraints, rows[i])
blocks[i] = {
unknown = 9, --see l.15
unknowns = { } --see l.16
}
insert(all_constraints, blocks[i])
end
constraints_by_unknown = { } --contraints sorted by their number of unknown fields
for i = 0, 9 do
constraints_by_unknown[i] = {
count = 0 --how many contraints are in here
}
end
for r = 1, 9 do
for c = 1, 9 do
local f = (r - 1) * 9 + c
insert(rows[r], f)
insert(constraints[f], rows[r])
insert(columns[c], f)
insert(constraints[f], columns[c])
end
end
for i = 1, 3 do
for j = 1, 3 do
local r = (i - 1) * 3 + j
for k = 1, 3 do
for l = 1, 3 do
local c = (k - 1) * 3 + l
local f = (r - 1) * 9 + c
local b = (i - 1) * 3 + k
insert(blocks[b], f)
insert(constraints[f], blocks[b])
end
end
end
end
working = { } --save the read values in here
function read() --read the values from stdin
local f = 1
local l = io.read("*a")
for d in l:gmatch("(%d)") do
local n = tonumber(d)
if n > 0 then
working[f] = n
for _,cons in pairs(constraints[f]) do
cons.unknown = cons.unknown - 1
end
else
for _,cons in pairs(constraints[f]) do
cons.unknowns[f] = f
end
end
f = f + 1
end
assert((f == 82), "Wrong number of digits")
end
function printer(t) --helper function for printing a 1-81 table
local pattern = {1,2,3,false,4,5,6,false,7,8,9} --place seperators for better readability
for _,r in pairs(pattern) do
if r then
local function p(c)
return c and t[(r - 1) * 9 + c] or "|"
end
local line={}
for k,v in pairs(pattern) do
line[k]=p(v)
end
print(concat(line))
else
print("---+---+---")
end
end
end
order = { } --when to try a field
for _,cons in pairs(all_constraints) do --put all constraints in the corresponding constraints_by_unknown set
local level = constraints_by_unknown[cons.unknown]
level[cons] = cons
level.count = level.count + 1
end
function first(t) --helper function to get a value from a set
for k, v in pairs(t) do
if k == v then
return k
end
end
end
function establish_order() -- determine the sequence in which the fields are to be tried
local solved = constraints_by_unknown[0].count
while solved < 27 do --there 27 constraints
--contraints with no unknown fields are considered "solved"
--keep in mind the actual solving happens in function branch
local i = 1
while constraints_by_unknown[i].count == 0 do
i = i + 1
-- find a unsolved contraint with the least number of unsolved fields
end
local cons = first(constraints_by_unknown[i])
local f = first(cons.unknowns)
-- take one of its unknown fields and append it to "order"
insert(order, f)
for _,c in pairs(constraints[f]) do
--each constraint "c" of "f" is moved up one "level"
--delete "f" from the constraints unknown fields
--decrease unknown of "c"
c.unknowns[f] = nil
local level = constraints_by_unknown[c.unknown]
level[c] = nil
level.count = level.count - 1
c.unknown = c.unknown - 1
level = constraints_by_unknown[c.unknown]
level[c] = c
level.count = level.count + 1
constraints_by_unknown[c.unknown][c] = c
end
solved = constraints_by_unknown[0].count
end
end
establish_order()
max = #order --how many fields are to be solved
function bound(f,i)
for _,c in pairs(constraints[f]) do
for _,x in pairs(c) do
if i == working[x] then
return false --i is already used in fs column/row/block
end
end
end
return true
end
function branch(n)
local f = order[n] --recursively iterate over fields in order
if n > max then
return working --all fields solved without collision
else
for i = 1, 9 do --check all values
if bound(f, i) then --if there is no collision
working[f] = i
local res = branch(n + 1) --try next field
if res then
return res --all fields solved without collision
else
working[f] = nil --this lead to a dead end
end
else
working[f] = nil --reset field because of a collision
end
end
return false --this is a dead end
end
end
x = branch(1)
if x then
return printer(x)
end

Input:

003 000 000
400 080 036
008 000 100

040 060 073
000 900 000
000 002 005

004 070 068
600 000 000
700 600 500
Output:
123|456|789
457|189|236
968|327|154
---+---+---
249|561|873
576|938|412
831|742|695
---+---+---
314|275|968
695|814|327
782|693|541

Time with luajit: 9.245s

### with FFI, fast

#!/usr/bin/env luajit
ffi=require"ffi"
local printf=function(fmt, ...) io.write(string.format(fmt, ...)) end
local band, bor, lshift, rshift=bit.band, bit.bor, bit.lshift, bit.rshift
local function show(x)
for i=0,8 do
if i%3==0 then print() end
for j=0,8 do
printf(j%3~=0 and "%2d" or "%3d", x[j+9*i])
end
print()
end
end
local function trycell(x, pos)
local row=math.floor(pos/9)
local col=pos%9
local used=0
if pos==81 then return true end
if x[pos]~=0 then return trycell(x, pos+1) end
for i=0,8 do
used=bor(used,lshift(1,x[i*9+col]-1))
end
for j=0,8 do
used=bor(used,lshift(1,x[row*9+j]-1))
end
row=math.floor(row/3)*3
col=math.floor(col/3)*3
for i=row,row+2 do
for j=col,col+2 do
used=bor(used, lshift(1, x[i*9+j]-1))
end
end
x[pos]=1
while x[pos]<=9 do
if band(used,1)==0 and trycell(x, pos+1) then return true end
used=rshift(used,1)
x[pos]=x[pos]+1
end
x[pos]=0
return false
end
local function solve(str)
local x=ffi.new("char[?]", 81)
str=str:gsub("[%c%s]","")
for i=0,81 do
x[i]=tonumber(str:sub(i+1, i+1)) or 0
end
if trycell(x, 0) then
show(x)
else
print("no solution")
end
end

do -- MAIN
solve([[
5.. .7. ...
6.. 195 ...
.98 ... .6.

8.. .6. ..3
4.. 8.3 ..1
7.. .2. ..6

.6. ... 28.
... 419 ..5
... .8. .79
]])
end
Output:
> time ./sudoku_fast.lua

5 3 4  6 7 8  9 1 2
6 7 2  1 9 5  3 4 8
1 9 8  3 4 2  5 6 7

8 5 9  7 6 1  4 2 3
4 2 6  8 5 3  7 9 1
7 1 3  9 2 4  8 5 6

9 6 1  5 3 7  2 8 4
2 8 7  4 1 9  6 3 5
3 4 5  2 8 6  1 7 9
./sudoku_fast.lua  0,01s user 0,00s system 90% cpu 0,007 total

Speed is about the speed of unoptimized C, half as fast as optimized C (C normal=0.007 C opt=0.004)

## Mathematica/Wolfram Language

solve[sudoku_] :=
NestWhile[
Join @@ Table[
Table[ReplacePart[s, #1 -> n], {n, #2}] & @@
[email protected][{#,
Complement[[email protected], s[[[email protected]#]], s[[;; , [email protected]#]],
[email protected]
Extract[Partition[s, {3, 3}], Quotient[#, 3, -2]]]} & /@
Position[s, 0, {2}],
[email protected]@# &], {s, #}] &, {sudoku}, ! FreeQ[#, 0] &]

Example:

solve[{{9, 7, 0, 3, 0, 0, 0, 6, 0},
{0, 6, 0, 7, 5, 0, 0, 0, 0},
{0, 0, 0, 0, 0, 8, 0, 5, 0},
{0, 0, 0, 0, 0, 0, 6, 7, 0},
{0, 0, 0, 0, 3, 0, 0, 0, 0},
{0, 5, 3, 9, 0, 0, 2, 0, 0},
{7, 0, 0, 0, 2, 5, 0, 0, 0},
{0, 0, 2, 0, 1, 0, 0, 0, 8},
{0, 4, 0, 0, 0, 7, 3, 0, 0}}]
Output:
{{{9, 7, 5, 3, 4, 2, 8, 6, 1}, {8, 6, 1, 7, 5, 9, 4, 3, 2}, {3, 2, 4,
1, 6, 8, 9, 5, 7}, {2, 1, 9, 5, 8, 4, 6, 7, 3}, {4, 8, 7, 2, 3, 6,
5, 1, 9}, {6, 5, 3, 9, 7, 1, 2, 8, 4}, {7, 3, 8, 4, 2, 5, 1, 9,
6}, {5, 9, 2, 6, 1, 3, 7, 4, 8}, {1, 4, 6, 8, 9, 7, 3, 2, 5}}}

## MATLAB

This solution impliments a recursive, depth-first search of the possible values unfilled sudoku cells can take. The search tree is pruned using logical deduction rules and takes about a minute to solve some of the more difficult puzzles. This code can be cleaned by making the main code blocks, denoted by "%% [Block Title]," into their own separate functions. This can also be further improved by implementing a Sudoku class and making this solver a member function. There are also several lines of code that can be vectorized to improve efficiency, but at the expense of readability.

For this to work, this code must be placed in a file named "sudokuSolver.m"

function solution = sudokuSolver(sudokuGrid)

%Define what each of the sub-boxes of the sudoku grid are by defining
%the start and end coordinates of each sub-box. The indecies represent
%the column and row of a grid coordinate on the actual sudoku grid.
%The contents of each cell with the same grid coordinates contain the
%information to determine which sub-box that grid coordinate is
%contained in on the sudoku grid. The array in position 1, i.e.
%subBoxes{row,column}(1), represents the row indecies of the subbox.
%The array in position 2, i.e. subBoxes{row,column}(2),represents the
%column indecies of the subbox.

subBoxes(1:9,1:9) = {{(1:3),(1:3)}};
subBoxes(4:6,:)= {{(4:6),(1:3)}};
subBoxes(7:9,:)= {{(7:9),(1:3)}};

for column = (4:6)
for row = (1:9)
subBoxes{row,column}(2)= {4:6};
end
end
for column = (7:9)
for row = (1:9)
subBoxes{row,column}(2)= {7:9};
end
end

%Generate a cell of arrays which contain the possible values of the
%sudoku grid for each cell in the grid. The possible values a specific
%grid coordinate can take share the same indices as the sudoku grid
%coordinate they represent.
%For example sudokuGrid(m,n) can be possibly filled in by the
%values stored in the array at possibleValues(m,n).
possibleValues(1:9,1:9) = { (1:9) };

%Filter the possibleValues so that no entry exists for coordinates that
%have already been filled in. This will replace any array with an empty
%array in the possibleValues cell matrix at the coordinates of a grid
%already filled in the sudoku grid.
possibleValues( ~isnan(sudokuGrid) )={[]};

%Iterate through each grid coordinate and filter out the possible
%values for that grid point that aren't alowed by the rules given the
%current values that are filled in. Or, if there is only one possible
%value for the current coordinate, fill it in.

solution = sudokuGrid; %so the original sudoku input isn't modified
memory = 0; %contains the previous iterations possibleValues
dontStop = true; %stops the while loop when nothing else can be reasoned about the sudoku

while( dontStop )

%% Process of elimination deduction method

while( ~isequal(possibleValues,memory) ) %Stops using the process of elimination deduction method when this deduction rule stops working

memory = possibleValues; %Copies the current possibleValues into memory, for the above conditional on the next iteration.

%Iterate through everything
for row = (1:9)
for column = (1:9)

if isnan( solution(row,column) ) %If grid coordinate hasn't been filled in, try to determine it's value.

%Look at column to see what values have already
%been filled in and thus the current grid
%coordinate can't be
removableValues = solution( ~isnan(solution(:,column)),column );

%If there are any values that have been assigned to
%other cells in the same column, filter those out
%of the current cell's possiblValues
if ~isempty(removableValues)
for m = ( 1:numel(removableValues) )
possibleValues{row,column}( possibleValues{row,column}==removableValues(m) )=[];
end
end

%If the current grid coordinate can only atain one
%possible value, assign it that value
if numel( possibleValues{row,column} ) == 1
solution(row,column) = possibleValues{row,column};
possibleValues(row,column)={[]};
end
end %end if

if isnan( solution(row,column) ) %If grid coordinate hasn't been filled in, try to determine it's value.

%Look at row to see what values have already
%been filled in and thus the current grid
%coordinate can't be
removableValues = solution( row,~isnan(solution(row,:)) );

%If there are any values that have been assigned to
%other cells in the same row, filter those out
%of the current cell's possiblValues
if ~isempty(removableValues)
for m = ( 1:numel(removableValues) )
possibleValues{row,column}( possibleValues{row,column}==removableValues(m) )=[];
end
end

%If the current grid coordinate can only atain one
%possible value, assign it that value
if numel( possibleValues{row,column} ) == 1
solution(row,column) = possibleValues{row,column};
possibleValues(row,column)={[]};
end
end %end if

if isnan( solution(row,column) ) %If grid coordinate hasn't been filled in, try to determine it's value.

%Look at sub-box to see if any possible values can be
%filtered out. First pull the boundaries of the sub-box
%containing the current array coordinate
currentBoxBoundaries=subBoxes{row,column};

%Then pull the sub-boxes values out of the solution
box = solution(currentBoxBoundaries{:});

%Look at sub-box to see what values have already
%been filled in and thus the current grid
%coordinate can't be
removableValues = box( ~isnan(box) );

%If there are any values that have been assigned to
%other cells in the same sub-box, filter those out
%of the current cell's possiblValues
if ~isempty(removableValues)
for m = ( 1:numel(removableValues) )
possibleValues{row,column}( possibleValues{row,column}==removableValues(m) )=[];
end
end

%If the current grid coordinate can only atain one
%possible value, assign it that value
if numel( possibleValues{row,column} ) == 1
solution(row,column) = possibleValues{row,column};
possibleValues(row,column)={[]};
end
end %end if

end %end for column
end %end for row
end %stop process of elimination

%% Check that there are no contradictions in the solved grid coordinates.

%Check that each row at most contains one of each of the integers
%from 1 to 9
if ~isempty( find( histc( solution,(1:9),1 )>1 ) )
solution = false;
return
end

%Check that each column at most contains one of each of the integers
%from 1 to 9
if ~isempty( find( histc( solution,(1:9),2 )>1 ) )
solution = false;
return
end

%Check that each sub-box at most contains one of each of the integers
%from 1 to 9
subBoxBins = zeros(9,9);
counter = 0;
for row = [2 5 8]
for column = [2 5 8]
counter = counter +1;

%because the sub-boxes are extracted as square matricies,
%we need to reshape them into row vectors so all of the
%boxes can be input into histc simultaneously
subBoxBins(counter,:) = reshape( solution(subBoxes{row,column}{:}),1,9 );
end
end
if ~isempty( find( histc( subBoxBins,(1:9),2 )>1 ) )
solution = false;
return
end

%Check to make sure there are no grid coordinates that are not
%filled in and have no possible values.

[rowStack,columnStack] = find(isnan(solution)); %extracts the indicies of the unsolved grid coordinates
if (numel(rowStack) > 0)

for counter = (1:numel(rowStack))
if isempty(possibleValues{rowStack(counter),columnStack(counter)})
solution = false;
return
end
end

%if there are no more grid coordinates to be filed in then the
%sudoku is solved and we can return the solution without further
%computation
elseif (numel(rowStack) == 0)
return
end

%% Use the unique relative compliment of sets deduction method

%Because no more information can be determined by the process of
%ellimination we have to try a new method of reasoning. Now we will
%look at the possible values a cell can take. If there is a value that
%that grid coordinate can take but no other coordinates in the same row,
%column or sub-box can take that value then we assign that coordinate
%that value.

keepGoing = true; %signals to keep applying rules to the current grid-coordinate because it hasn't been solved using previous rules
dontStop = false; %if this method doesn't figure anything out, this will terminate the top level while loop

[rowStack,columnStack] = find(isnan(solution)); %This will also take care of the case where the sudoku is solved
counter = 0; %makes sure the loop terminates when there are no more cells to consider

while( keepGoing && (counter < numel(rowStack)) ) %stop this method of reasoning when the value of one of the cells has been determined and return to the process of elimination method

counter = counter + 1;

row = rowStack(counter);
column = columnStack(counter);

gridPossibles = [possibleValues{row,column}];

coords = (1:9);
coords(column) = [];
rowPossibles = [possibleValues{row,coords}]; %extract possible values for everything in the same row except the current grid coordinate

totalMatches = zeros( numel(gridPossibles),1 ); %preallocate for speed

%count how many times a possible value for the current cell
%appears as a possible value for the cells in the same row
for n = ( 1:numel(gridPossibles) )
totalMatches(n) = sum( (rowPossibles == gridPossibles(n)) );
end

%remove any possible values for the current cell that have
%matches in other cells
gridPossibles = gridPossibles(totalMatches==0);

%if there is only one possible value that the current cell can
%take that aren't shared by other cells, assign that value to
%the current cell.
if numel(gridPossibles) == 1

solution(row,column) = gridPossibles;
possibleValues(row,column)={[]};
keepGoing = false; %stop this method of deduction and return to the process of elimination
dontStop = true; %keep the top level loop going

end

if(keepGoing) %do the same as above but for the current cell's column

gridPossibles = [possibleValues{row,column}];

coords = (1:9);
coords(row) = [];
columnPossibles = [possibleValues{coords,column}];

totalMatches = zeros( numel(gridPossibles),1 );
for n = ( 1:numel(gridPossibles) )
totalMatches(n) = sum( (columnPossibles == gridPossibles(n)) );
end

gridPossibles = gridPossibles(totalMatches==0);

if numel(gridPossibles) == 1

solution(row,column) = gridPossibles;
possibleValues(row,column)={[]};
keepGoing = false;
dontStop = true;

end
end

if(keepGoing) %do the same as above but for the current cell's sub-box

gridPossibles = [possibleValues{row,column}];

currentBoxBoundaries = subBoxes{row,column};
subBoxPossibles = [];
for m = currentBoxBoundaries{1}
for n = currentBoxBoundaries{2}
if ~((m == row) && (n == column))
subBoxPossibles = [subBoxPossibles possibleValues{m,n}];
end
end
end

totalMatches = zeros( numel(gridPossibles),1 );
for n = ( 1:numel(gridPossibles) )
totalMatches(n) = sum( (subBoxPossibles == gridPossibles(n)) );
end

gridPossibles = gridPossibles(totalMatches==0);

if numel(gridPossibles) == 1

solution(row,column) = gridPossibles;
possibleValues(row,column)={[]};
keepGoing = false;
dontStop = true;

end
end %end

end %end set comliment rule while loop
end %end top-level while loop

%% Depth-first search of the solution tree

%There is no more reasoning that can solve the puzzle so now it is time
%for a depth-first search of the possible answers, basically
%guess-and-check. This is implimented recursively.

[rowStack,columnStack] = find(isnan(solution)); %Get all of the unsolved cells

if (numel(rowStack) > 0) %If all of the above stuff terminates then there will be at least one grid coordinate not filled in

%Treat the rowStack and columnStack like stacks, and pop the top
%value off the stack to act as the current node whose
%possibleValues to search through, then assign the possible values
%of that grid coordinate to a variable that holds that values to
%search through
searchTreeNodes = possibleValues{rowStack(1),columnStack(1)};

keepSearching = true; %used to continue the search
counter = 0; %counts the amount of possible values searched for the current node
tempSolution = solution; %used so that the solution is not overriden until a solution hase been found

while( keepSearching && (counter < numel(searchTreeNodes)) ) %stop recursing if we run out of possible values for the current node

counter = counter + 1;
tempSolution(rowStack(1),columnStack(1)) = searchTreeNodes(counter); %assign a possible value to the current node in the tree
tempSolution = sudokuSolver(tempSolution); %recursively call the solver with the current guess value for the current grid coordinate

if ~islogical(tempSolution) %if tempSolution is not a boolean but a valid sudoku stop recursing and set solution to tempSolution
keepSearching = false;
solution = tempSolution;
elseif counter == numel(searchTreeNodes) %if we have run out of guesses for the current node, stop recursing and return a value of "false" for the solution
solution = false;
else %reset tempSolution to the current state of the board and try the next guess for the possible value of the current cell
tempSolution = solution;
end

end %end recursion
end %end if

%% End of program
end %end sudokuSolver

Test Input: All empty cells must have a value of NaN.

sudoku = [NaN   NaN   NaN   NaN     8     3     9   NaN   NaN
1 NaN NaN NaN NaN NaN NaN 3 NaN
NaN NaN 4 NaN NaN NaN NaN 7 NaN
NaN 4 2 NaN 3 NaN NaN NaN NaN
6 NaN NaN NaN NaN NaN NaN NaN 4
NaN NaN NaN NaN 7 NaN NaN 1 NaN
NaN 2 NaN NaN NaN NaN NaN NaN NaN
NaN 8 NaN NaN NaN 9 2 NaN NaN
NaN NaN NaN 2 5 NaN NaN NaN 6]
solution =

7 6 5 4 8 3 9 2 1
1 9 8 7 2 6 4 3 5
2 3 4 9 1 5 6 7 8
8 4 2 5 3 1 7 6 9
6 1 7 8 9 2 3 5 4
3 5 9 6 7 4 8 1 2
9 2 6 1 4 7 5 8 3
5 8 1 3 6 9 2 4 7
4 7 3 2 5 8 1 9 6

## Nim

Translation of: Kotlin
{.this: self.}

type
Sudoku = ref object
grid : array[81, int]
solved : bool

proc `\$`(self: Sudoku): string =
var sb: string = ""
for i in 0..8:
for j in 0..8:
sb &= \$grid[i * 9 + j]
sb &= " "
if j == 2 or j == 5:
sb &= "| "
sb &= "\n"
if i == 2 or i == 5:
sb &= "------+------+------\n"
sb

proc init(self: Sudoku, rows: array[9, string]) =
for i in 0..8:
for j in 0..8:
grid[9 * i + j] = rows[i][j].int - '0'.int

proc checkValidity(self: Sudoku, v, x, y: int): bool =
for i in 0..8:
if grid[y * 9 + i] == v or grid[i * 9 + x] == v:
return false
var startX = (x div 3) * 3
var startY = (y div 3) * 3
for i in startY..startY + 2:
for j in startX..startX + 2:
if grid[i * 9 + j] == v:
return false
result = true

proc placeNumber(self: Sudoku, pos: int) =
if solved:
return
if pos == 81:
solved = true
return
if grid[pos] > 0:
placeNumber(pos + 1)
return
for n in 1..9:
if checkValidity(n, pos mod 9, pos div 9):
grid[pos] = n
placeNumber(pos + 1)
if solved:
return
grid[pos] = 0

proc solve(self: Sudoku) =
echo "Starting grid:\n\n", \$self
placeNumber(0)
if solved:
echo "Solution:\n\n", \$self
else:
echo "Unsolvable!"

var rows = ["850002400",
"720000009",
"004000000",
"000107002",
"305000900",
"040000000",
"000080070",
"017000000",
"000036040"]

var puzzle = Sudoku()
puzzle.init(rows)
puzzle.solve()
Output:
Starting grid:

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

Solution:

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

## OCaml

uses the library ocamlgraph

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

## Oz

Using built-in constraint propagation and search.

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}

## PARI/GP

Build plugin for PARI's function interface from C code: sudoku.c

#include <pari/pari.h>

typedef int SUDOKU [9][9];

static inline int check_num(SUDOKU s, int row, int col, int num)
{
int i, r = (row/3)*3, c = (col/3)*3;

for (i = 0; i < 9; i++)
if (s[row][i] == num || s[i][col] == num || s[i%3 + r][i/3 + c] == num)
return 0;

return 1;
}

static int sudoku_solve(SUDOKU s, int row, int col)
{
int num;

if (row < 9 && col < 9) {
if (s[row][col]) {
if (col < 8)
return sudoku_solve(s, row, col+1);
if (row < 8)
return sudoku_solve(s, row+1, 0);
return 1;
}
else
for (num = 1; num < 10; num++)
if (check_num(s, row, col, num)) {
s[row][col] = num;
if (sudoku_solve(s, row, col))
return 1;
else
s[row][col] = 0;
}
return 0;
}
return 1;
}

GEN plug_sudoku(GEN M)
{
SUDOKU s;
GEN S;
int i, k;

if (typ(M) != t_MAT)
pari_err(e_MISC, "parameter not matrix");

S = matsize(M);

if (itos(gel(S, 1)) < 9 || itos(gel(S, 2)) < 9)
pari_err(e_MISC, "parameter not 9x9 matrix");

for (i = 0; i < 9; i++)
for (k = 0; k < 9; k++)
s[i][k] = itos(gcoeff(M, i+1, k+1)); /* get sudoku */

if (sudoku_solve(s, 0, 0)) { /* solve sudoku */
S = cgetg(10, t_MAT);
for (k = 0; k < 9; k++) { /* create 9x9 matrix */
gel(S, k+1) = cgetg(10, t_COL);
for (i = 0; i < 9; i++)
gcoeff(S, i+1, k+1) = stoi(s[i][k]); /* fill in elements */
}
return S;
}
return gen_0; /* no solution */
}

Compile plugin: gcc -O2 -Wall -fPIC -shared sudoku.c -o libsudoku.so -lpari

Install plugin from home directory and play:

install("plug_sudoku", "G", "sudoku", "~/libsudoku.so")
Output:
gp > S=[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]
[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]

gp > sudoku(S)
[5 3 4 6 7 8 9 1 2]
[6 7 2 1 9 5 3 4 8]
[1 9 8 3 4 2 5 6 7]
[8 5 9 7 6 1 4 2 3]
[4 2 6 8 5 3 7 9 1]
[7 1 3 9 2 4 8 5 6]
[9 6 1 5 3 7 2 8 4]
[2 8 7 4 1 9 6 3 5]
[3 4 5 2 8 6 1 7 9]

## Pascal

Works with: Free Pascal

Simple backtracking implimentation, therefor it must be fast to be competetive.With doReverse = true same sequence for trycell. nearly 5 times faster than C-Version.

Program soduko;
{\$IFDEF FPC}
{\$CODEALIGN proc=16,loop=8}
{\$ENDIF}
uses
sysutils,crt;
const
carreeSize = 3;
maxCoor = carreeSize*carreeSize;
maxValue = maxCoor;
maxMask = 1 shl (maxCoor+1)-1;
type
tLimit = 0..maxCoor-1;
tValue = 0..maxCoor;
tSteps = 0..maxCoor*maxCoor;
tValField = array[tLimit,tLimit] of NativeInt;//tValue;
tcol = array[tLimit] of NativeInt;// tBitrepr;
trow = array[tLimit] of NativeInt;// tBitrepr;
tcar = array[tLimit] of NativeInt;// tBitrepr;
tpValue = ^NativeInt;//^tValue;
tpLimit = ^tLimit;
tpBitrepr= ^NativeInt;//^tBitrepr;
tchgVal = record
cvCol,
cvRow,
cvCar : tpBitrepr;
cvVal : tpValue;
end;
tpChgVal = ^tchgVal;
tchgList = array[tSteps] of tchgVal;

tField = record
fdChgList: tchgList;
fdCol : tcol;
fdRow : trow;
fdcar : tcar;
fdVal : tValField;
fdChgIdx : tSteps;

end;
const
Expl0:tValField = ((9,0,7,0,0,0,3,0,0),
(0,0,0,1,0,0,2,0,0),
(6,0,0,0,0,8,0,0,0),
(0,0,5,0,3,0,0,0,0),
(0,0,0,0,0,0,0,8,4),
(0,0,0,0,0,0,0,6,0),
(0,0,0,2,7,0,0,0,0),
(8,4,0,0,0,0,0,0,0),
(0,6,0,0,0,0,0,0,0));
Expl1:tValField=((0,0,0,1,0,0,0,3,8),
(2,0,0,0,0,5,0,0,0),
(0,0,0,0,0,0,0,0,0),
(0,5,0,0,0,0,4,0,0),
(4,0,0,0,3,0,0,0,0),
(0,0,0,7,0,0,0,0,6),
(0,0,1,0,0,0,0,5,0),
(0,0,0,0,6,0,2,0,0),
(0,6,0,0,0,4,0,0,0));

var
F,
solF : TField;
solCnt,
callCnt: NativeUint;
solFound : Boolean;

procedure OutField(const F:tField);
var
rw,cl : tLimit;
rowS: AnsiString;
Begin
GotoXy(1,1);
For rw := low(tLimit) to High(tLimit) do
Begin
rowS := ' ';
For cl := low(tLimit) to High(tLimit) do
RowS :=RowS+IntToStr(F.fdVal[rw,cl]);
writeln(RowS);
end;
end;

function CarIdx(rw,cl: NativeInt):NativeInt;
begin
CarIdx:= (rw DIV carreeSize)*carreeSize +cl DIV carreeSize;
end;
function InsertTest(const F:tField;rw,cl:tLimit;value:tValue):boolean;
var
msk: tBitrepr;
Begin
result := (Value = 0);
IF result then
EXIT;
msk := 1 shl (value-1);
with F do
Begin
result := fdRow[rw] AND msk = 0;
result := result AND (fdCol[cl] AND msk = 0);
rw :=CarIdx(rw,cl);
result := result AND (fdCar[rw] AND msk = 0);
end;
end;

function InitField(var F:tField;const InFd:tValField;DoReverse:boolean):boolean;
var
TmpchgVal:tchgVal;
rw,cl,
value,
msk : NativeInt;
leftSteps:tSteps;
Begin
Fillchar(F,SizeOf(F),#0);
leftSteps := High(tSteps)-1;
//unknown fields inserted from end
For rw := low(tLimit) to High(tLimit) do
For cl := low(tLimit) to High(tLimit) do
Begin
value := InFd[rw,cl];
IF InsertTest(F,rw,cl,value) then
Begin
with F do
Begin
if value > 0 then
Begin
msk := 1 shl (value-1);
//given state
//use pointer to the relevant places and mark as occupied
with fdChgList[fdChgIdx] do
begin
cvCol := @fdCol[cl];
cvCol^ +=Msk;
cvRow := @fdRow[rw];
cvRow^ +=Msk;
cvCar := @fdCar[CarIdx(rw,cl)];
cvCar^ +=Msk;
cvVal := @fdVal[rw,cl];
cvVal^ := value;
end;
inc(fdChgIdx);
end
else
Begin
//use pointer to the relevant places
with fdChgList[leftSteps] do
begin
cvCol := @fdCol[cl];
cvRow := @fdRow[rw];
cvCar := @fdCar[CarIdx(rw,cl)];
cvVal := @fdVal[rw,cl];
end;
dec(leftSteps);
end;
end
end
else
Begin
writeln(rw:10,cl:10,value:10);
Writeln(' not solvable SuDoKu ');
delay(2000);
result := false;
EXIT;
end;
end;
//reverse direction of left over
IF DoReverse then
Begin
leftSteps := High(tSteps)-1;
rw := F.fdChgIdx;
repeat
TmpchgVal:= F.fdChgList[leftSteps];
F.fdChgList[leftSteps]:= F.fdChgList[rw];
F.fdChgList[rw] :=TmpchgVal;
dec(leftSteps);
inc(rw);
until rw>=leftSteps;
end;
//OutField(F);
solFound := false;
result := true;
end;
procedure SolIsFound;
begin
solF := F;
inc(solCnt);
solFound := True;
end;

procedure TryCell(var ChgVal:tpchgVal);
var
value :NativeInt;
poss,msk: NativeInt;
Begin
IF solFound then EXIT;
with ChgVal^ do
poss:= (cvRow^ OR cvCol^ OR cvCar^) XOR maxMask;
IF Poss = 0 then
EXIT;

value := 1;
msk := 1;

repeat
IF Poss AND MSK <>0 then
Begin
inc(callCnt);
//insert test value
with ChgVal^ do
Begin
cvCol^ := cvCol^ OR msk;
cvRow^ := cvRow^ OR msk;
cvCar^ := cvCar^ OR msk;
cvVAl^ := value;
end;
//try next in list, if beyond last
inc(ChgVal);

IF ChgVal^.cvCol <> NIL then
TryCell(ChgVal)
else
SolIsFound;
//remove test value
dec(ChgVal);
with ChgVal^ do
Begin
cvCol^ := cvCol^ XOR msk;
cvRow^ := cvRow^ XOR msk;
cvCar^ := cvCar^ XOR msk;
cvVAl^ := 0;
end;
end;
inc(msk,msk);
inc(value);
until value> maxValue;
end;

var
ChangeBegin : tpChgVal;
k : NativeInt;
T1,T0: TDateTime;
begin
randomize;
ClrScr;
solCnt := 0;
callCnt:= 0;
T0 := time;
k := 0;
repeat
InitField(F,Expl1,FALSE);
ChangeBegin := @F.fdChgList[F.fdChgIdx];
TryCell(ChangeBegin);
inc(k);
until k >= 5;
T1 := time;
Outfield(solF);
writeln(86400*1000*(T1-T0)/k:10:3,' ms Test calls :',callCnt/k:8:0);
end.
Output:
Expl0
927465318
458193276
613728459
185634792
376912584
294587163
539276841
841359627
762841935
// InitField  doReverse = true
9.850 ms Test calls :  532466
// InitField  doReverse = false
2609.000 ms Test calls :135196346
...
Expl1
594126738
237895164
618473925
859612473
476539812
123748596
341287659
985361247
762954381
// InitField  doReverse = true
857.600 ms Test calls :40980572
// InitField  doReverse = false
21.400 ms Test calls : 1089986

## Perl

#!/usr/bin/perl
use integer;
use strict;

my @A = qw(
5 3 0 0 2 4 7 0 0
0 0 2 0 0 0 8 0 0
1 0 0 7 0 3 9 0 2

0 0 8 0 7 2 0 4 9
0 2 0 9 8 0 0 7 0
7 9 0 0 0 0 0 8 0

0 0 0 0 3 0 5 0 6
9 6 0 0 1 0 3 0 0
0 5 0 6 9 0 0 1 0
);

sub solve {
my \$i;
foreach \$i ( 0 .. 80 ) {
next if \$A[\$i];
my %t = map {
\$_ / 9 == \$i / 9 ||
\$_ % 9 == \$i % 9 ||
\$_ / 27 == \$i / 27 && \$_ % 9 / 3 == \$i % 9 / 3
? \$A[\$_] : 0,
1;
} 0 .. 80;
solve( \$A[\$i] = \$_ ) for grep !\$t{\$_}, 1 .. 9;
return \$A[\$i] = 0;
}
\$i = 0;
foreach (@A) {
print "-----+-----+-----\n" if !(\$i%27) && \$i;
print !(\$i%9) ? '': \$i%3 ? ' ' : '|', \$_;
print "\n" unless ++\$i%9;
}
}
solve();
Output:
5 3 9|8 2 4|7 6 1
6 7 2|1 5 9|8 3 4
1 8 4|7 6 3|9 5 2
-----+-----+-----
3 1 8|5 7 2|6 4 9
4 2 5|9 8 6|1 7 3
7 9 6|3 4 1|2 8 5
-----+-----+-----
8 4 1|2 3 7|5 9 6
9 6 7|4 1 5|3 2 8
2 5 3|6 9 8|4 1 7

## Phix

Simple brute force solution. Generally quite good but will struggle on some puzzles (eg see "the beast" below)

with javascript_semantics
sequence board = split("""
.......39
.....1..5
..3.5.8..
..8.9...6
.7...2...
1..4.....
..9.8..5.
.2....6..
4..7.....""",'\n')

function valid_move(integer y, x, ch)
for i=1 to 9 do
if ch=board[i][x] then return false end if
if ch=board[y][i] then return false end if
end for
y -= mod(y-1,3)
x -= mod(x-1,3)
for ys=y to y+2 do
for xs=x to x+2  do
if ch=board[ys][xs] then return false end if
end for
end for
return true
end function

sequence solution = {}

procedure brute_solve()
for y=1 to 9 do
for x=1 to 9 do
if board[y][x]<='0' then
for ch='1' to '9' do
if valid_move(y,x,ch) then
board[y][x] = ch
brute_solve()
board[y][x] = ' '
if length(solution) then return end if
end if
end for
return
end if
end for
end for
solution = deep_copy(board) -- (already solved case)
end procedure

atom t0 = time()
brute_solve()
printf(1,"%s\n(solved in %3.2fs)\n",{join(solution,"\n"),time()-t0})
Output:
751846239
892371465
643259871
238197546
974562318
165438927
319684752
527913684
486725193
(solved in 0.95s)

OTT solution. Implements line/col and set exclusion, and x-wings. Blisteringly fast
The included program demo\rosetta\Sudoku.exw is an extended version of this that performs extended validation, contains 339 puzzles, can be run as a command-line or gui program, check for multiple solutions, and produce a more readable single-puzzle output (example below).

with javascript_semantics
-- Working directly on 81-character strings ultimately proves easier: Originally I
--  just wanted to simplify the final display, but later I realised that a 9x9 grid
--  encourages laborious indexing/looping everwhere whereas using a flat 81-element
--  approach encourages precomputation of index sets, and once you commit to that,
--  the rest of the code starts to get a whole lot cleaner. Below we create 27+18
--  sets and 5 tables of lookup indexes to locate them quickly.

sequence nines = {},                -- will be 27 in total
cols = repeat(0,9*9),      -- remainder(i-1,9)+1
rows = repeat(0,9*9),      -- floor((i-1)/9)+10
squares = repeat(0,9*9),
sixes = {},                -- will be 18 in total
dotcol = repeat(0,9*9),    -- same col, diff square
dotrow = repeat(0,9*9)     -- same row, diff square

procedure set_nines()
sequence nine, six
integer idx, ndx
for x=0 to 8 do                     -- columns
nine = {}
ndx = length(nines)+1
for y=1 to 81 by 9 do
idx = y+x
nine = append(nine,idx)
cols[idx] = ndx
end for
nines = append(nines,nine)
end for
for y=1 to 81 by 9 do               -- rows
nine = {}
ndx = length(nines)+1
for x=0 to 8 do
idx = y+x
nine = append(nine,idx)
rows[idx] = ndx
end for
nines = append(nines,nine)
end for
if length(nines)!=18 then ?9/0 end if
for y=0 to 8 by 3 do                -- small squares [19..27]
for x=0 to 8 by 3 do
nine = {}
ndx = length(nines)+1
for sy=y*9 to y*9+18 by 9 do
for sx=x to x+2 do
idx = sy+sx+1
nine = append(nine,idx)
squares[idx] = ndx
end for
end for
nines = append(nines,nine)
end for
end for
if length(nines)!=27 then ?9/0 end if
for i=1 to 9*9 do
six = {}
nine = nines[cols[i]]           -- dotcol
for j=1 to length(nine) do
if squares[i]!=squares[nine[j]] then
six = append(six,nine[j])
end if
end for
ndx = find(six,sixes)
if ndx=0 then
sixes = append(sixes,six)
ndx = length(sixes)
end if
dotcol[i] = ndx
six = {}
nine = nines[rows[i]]           -- dotrow
for j=1 to length(nine) do
if squares[i]!=squares[nine[j]] then
six = append(six,nine[j])
end if
end for
ndx = find(six,sixes)
if ndx=0 then
sixes = append(sixes,six)
ndx = length(sixes)
end if
dotrow[i] = ndx
end for
end procedure
set_nines()

integer improved = 0

function eliminate_in(sequence valid, set, integer ch)
for i=1 to length(set) do
integer idx = set[i]
if string(valid[idx]) then
integer k = find(ch,valid[idx])
if k!=0 then
valid[idx][k..k] = ""
improved = 1
end if
end if
end for
return valid
end function

function test_comb(sequence chosen, pool, valid)
--
-- (see deep_logic()/set elimination)
-- chosen is a sequence of length 2..4 of integers 1..9: ordered elements of pool.
-- pool is a set of elements of the sequence valid, each of which is a sequence.
-- (note that elements of valid in pool not in chosen are not necessarily sequences)
--
sequence contains = repeat(0,9)
integer ccount = 0, ch
object set

for i=1 to length(chosen) do
set = valid[pool[chosen[i]]]
for j=1 to length(set) do
ch = set[j]-'0'
if contains[ch]=0 then
contains[ch] = 1
ccount += 1
end if
end for
end for
if ccount=length(chosen) then
valid = deep_copy(valid)
for i=1 to length(pool) do
if find(i,chosen)=0 then
set = valid[pool[i]]
if sequence(set) then
-- (reverse order so deletions don't foul indexes)
for j=length(set) to 1 by -1 do
ch = set[j]-'0'
if contains[ch] then
valid[pool[i]][j..j] = ""
improved = 1
end if
end for
end if
end if
end for
end if
return valid
end function

function comb(sequence pool, valid, integer needed, done=0, sequence chosen={})
-- (used by deep_logic()/set elimination)
if needed=0 then    -- got a full set
return test_comb(chosen,pool,valid)
end if
if done+needed>length(pool) then return valid end if -- cannot fulfil
-- get all combinations with and without the next item:
done += 1
if sequence(valid[pool[done]]) then
valid = comb(pool,valid,needed-1,done,append(deep_copy(chosen),done))
end if
return comb(pool,valid,needed,done,chosen)
end function

function deep_logic(string board, sequence valid)
--
--  Create a grid of valid moves. Note this does not modify board, but instead creates
--  sets of permitted values for each cell, which can also be and are used for hints.
--  Apply standard eliminations of known cells, then try some more advanced tactics:
--
--  1) row/col elimination
--      If in any of the 9 small squares a number can only occur in one row or column,
--      then that number cannot occur in that row or column in two other corresponding
--      small squares. Example (this one with significant practical benefit):
--              000|000|036
--              840|000|000
--              000|000|020
--              ---+---+---
--              000|203|000
--              010|000|700
--              000|600|400
--              ---+---+---
--              000|410|050
--              003|000|200
--              600|000|000 <-- 3
--                        ^-- 3
--      Naively, the br can contain a 3 in the four corners, but looking at mid-right and
--      mid-bottom leads us to eliminating 3s in column 9 and row 9, leaving 7,7 as the
--      only square in the br that can be a 3. Uses dotcol and dotrow.
--      Without this, brute force on the above takes ~8s, but with it ~0s
--
--  2) set elimination
--      If in any 9-set there is a set of n blank squares that can only contain n digits,
--      then no other squares can contain those digits. Example (with some benefit):
--              75.|.9.|.46
--              961|...|352
--              4..|...|79.
--              ---+---+---
--              2..|6.1|..7
--              .8.|...|.2.
--              1..|328|.65
--              ---+---+---
--              ...|...|...     <-- [7,8] is {1,3,8}, [7,9] is {1,3,8}
--              3.9|...|2.4     <-- [8,8] is {1,8}
--              84.|.3.|.79
--      The three cells above the br 479 can only contain {1,3,8}, so the .. of the .2.
--      in column 7 of that square are {5,6} (not 1) and hence [9,4] must be a 1.
--      (Relies on plain_logic to spot that "must be a 1", and serves as a clear example
--       of why this routine should not bother to attempt updating the board itself - as
--       it spends almost all of its time looking in a completely different place.)
--      (One could argue that [7,7] and [9,7] are the only places that can hold {5,6} and
--       therefore we should eliminate all non-{5,6} from those squares, as an alternative
--       strategy. However I think that would be harder to code and cannot imagine a case
--       said complementary logic covers, that the above does not, cmiiw.)
--
--  3) x-wings
--      If a pair of rows or columns can only contain a given number in two matching places,
--      then once filled they will occupy opposite diagonal corners, hence that said number
--      cannot occur elsewhere in those two columns/rows. Example (with a benefit):
--              .43|98.|25. <-- 6 in [1,{6,9}]
--              6..|425|...
--              2..|..1|.94
--              ---+---+---
--              9..|..4|.7.                     <-- hence 6 not in [4,9]
--              3..|6.8|...
--              41.|2.9|..3
--              ---+---+---
--              82.|5..|...                     <-- hence 6 not in [7,6],[7,9]
--              ...|.4.|..5                     <-- hence 6 not in [8,6]
--              534|89.|71. <-- 6 in [9,{6,9}]
--      A 6 must be in [1,6] or [1,9] and [9,6] or [9,9], hence [7,9] is not 6 and must be 9.
--      (we also eliminate 6 from [4,9], [7,6] and [8,6] to no great use)
--      In practice this offers little benefit over a single trial-and-error step, as
--       obviously trying either 6 in row 1 or 9 immediately pinpoints that 9 anyway.
--
--  4) swordfish (not attempted)
--      There is an extension to x-wings known as swordfish: three (or more) pairs form
--      a staggered pair (or more) of rectangles that exhibit similar properties, eg:
--              8-1|-5-|-3-
--              953|-68|---
--              -4-|-*3|5*8
--              ---+---+---
--              6--|9-2|---
--              -8-|-3-|-4-
--              3*-|5-1|-*7     <-- hence [6,3] is not 9, must be 4
--              ---+---+---
--              5*2|-*-|-8-
--              --8|37-|--9
--              -3-|82-|1--
--               ^---^---^-- 3 pairs of 9s (marked with *) on 3 rows (only)
--      It is not a swordfish if the 3 pairs are on >3 rows, I trust that is obvious.
--      Logically you can extend this to N pairs on N rows, however I cannot imagine a
--      case where this is not immediately solved by a single trial-step being invalid.
--      (eg above if you try [3,5]:=9 it is quickly proved to be invalid, and the same
--       goes for [6,8]:=9 and [7,2]:=9, since they are all entirely inter-dependent.)
--      Obviously where I have said rows, the same concept can be applied to columns.
--      Likewise there are "Alternate Pairs" and "Hook or X-Y wing" strategies, which
--      are easily solved with a single trial-and-error step, and of course the brute
--      force algorithm is going to select pairs first anyway. [Erm, no it doesn't,
--      it selects shortest - I've noted the possible improvement below.]
--
integer k -- (scratch)
if length(valid)=0 then
-- initialise/start again from scratch
valid = repeat("123456789",9*9)
end if
--
-- First perform standard eliminations of any known cells:
--  (repeated every time so plain_logic() does not have to worry about it)
--
for i=1 to 9*9 do
integer ch = board[i]
if ch>'0'
and string(valid[i]) then
valid[i] = ch
valid = eliminate_in(valid,nines[cols[i]],ch)
valid = eliminate_in(valid,nines[rows[i]],ch)
valid = eliminate_in(valid,nines[squares[i]],ch)
end if
end for
--
-- 1) row/col elimination
--
for s=19 to 27 do
sequence c = repeat(0,9), -- 0 = none seen, 1..9 this col only, -1: >1 col
r = repeat(0,9), -- ""                       row              row
nine = nines[s]
integer row, col, ch
for n=1 to 9 do
k = nine[n]
object vk = valid[k]
if string(vk) then
for i=1 to length(vk) do
ch = vk[i]-'0'
col = dotcol[k]
row = dotrow[k]
c[ch] = iff(find(c[ch],{0,col})!=0?col:-1)
r[ch] = iff(find(r[ch],{0,row})!=0?row:-1)
end for
end if
end for
for i=1 to 9 do
ch = i+'0'
col = c[i]
if col>0 then
valid = eliminate_in(valid,sixes[col],ch)
end if
row = r[i]
if row>0 then
valid = eliminate_in(valid,sixes[row],ch)
end if
end for
end for
--
-- 2) set elimination
--
for i=1 to length(nines) do
--
--  Practical note: Meticulously counting empties to eliminate larger set sizes
--                  would at best reduce 6642 tests to 972, not deemed worth it.
--
for set_size=2 to 4 do
--if floor(count_empties(nines[i])/2)>=set_size then -- (untested)
valid = comb(nines[i],valid,set_size)
--end if
end for
end for
--
-- 3) x-wings
--
for ch='1' to '9' do
sequence prevsets = repeat(0,9), set
integer count, idx
for x=1 to 9 do
count = 0
set = repeat(0,9)
for y=0 to 8 do
idx = y*9+x
if sequence(valid[idx]) and find(ch,valid[idx]) then
set[y+1] = 1
count += 1
end if
end for
if count=2 then
k = find(set,prevsets)
if k!=0 then
for y=0 to 8 do
if set[y+1]=1 then
for sx=1 to 9 do
if sx!=k and sx!=x then
valid = eliminate_in(valid,{y*9+sx},ch)
end if
end for
end if
end for
else
prevsets[x] = set
end if
end if
end for
prevsets = repeat(0,9)
for y=0 to 8 do
count = 0
set = repeat(0,9)
for x=1 to 9 do
idx = y*9+x
if sequence(valid[idx]) and find(ch,valid[idx]) then
set[x] = 1
count += 1
end if
end for
if count=2 then
k = find(set,prevsets)
if k!=0 then
for x=1 to 9 do
if set[x]=1 then
for sy=0 to 8 do
if sy+1!=k and sy!=y then
valid = eliminate_in(valid,{sy*9+x},ch)
end if
end for
end if
end for
else
prevsets[y+1] = set
end if
end if
end for
end for
return valid
end function

function permitted_in(string board, sequence sets, valid, integer ch)
for i=1 to 9 do
sequence set = nines[sets[i]]
integer pos = 0
for j=1 to 9 do
integer idx = set[j],
bch = board[idx]
if bch>'0' then
if bch=ch then pos = -1 exit end if
elsif find(ch,valid[idx]) then
if pos!=0 then pos = -1 exit end if
pos = idx
end if
end for
if pos>0 then
board[pos] = ch
improved = 1
end if
end for
return board
end function

enum INVALID = -1, INCOMPLETE = 0, SOLVED = 1, MULTIPLE = 2, BRUTE = 3

function plain_logic(string board)
--
-- Responsible for:
--  1) cells with only one option
--  2) numbers with only one home
--
integer solved
sequence valid = {}
while true do
solved = SOLVED
improved = 0
valid = deep_logic(board,valid)

-- 1) cells with only one option:
for i=1 to length(valid) do
object vi = valid[i]
if string(vi) then
if length(vi)=0 then return {board,{},INVALID} end if
if length(vi)=1 then
board[i] = vi[1]
improved = 1
end if
end if
if board[i]<='0' then
solved = INCOMPLETE
end if
end for
if solved=SOLVED then return {board,{},SOLVED} end if

-- 2) numbers with only one home
for ch='1' to '9' do
board = permitted_in(board,cols,valid,ch)
board = permitted_in(board,rows,valid,ch)
board = permitted_in(board,squares,valid,ch)
end for
if not improved then exit end if
end while
return {board,valid,solved}
end function

function validate(string board)
-- (sum9 should be sufficient - if you want, get rid of nine/nines)
integer ch, sum9
sequence nine, nines = tagset(9)

for x=0 to 8 do                 -- columns
sum9 = 0
nine = repeat(0,9)
for y=1 to 81 by 9 do
ch = board[y+x]-'0'
if ch<1 or ch>9 then return false end if
sum9 += ch
nine[ch] = ch
end for
if sum9!=45 then return false end if
if nine!=nines then return false end if
end for
for y=1 to 81 by 9 do           -- rows
sum9 = 0
nine = repeat(0,9)
for x=0 to 8 do
ch = board[y+x]-'0'
sum9 += ch
nine[ch] = ch
end for
if sum9!=45 then return false end if
if nine!=nines then return false end if
end for
for y=0 to 8 by 3 do            -- small squares
for x=0 to 8 by 3 do
sum9 = 0
nine = repeat(0,9)
for sy=y*9 to y*9+18 by 9 do
for sx=x to x+2 do
ch = board[sy+sx+1]-'0'
sum9 += ch
nine[ch] = ch
end for
end for
if sum9!=45 then return false end if
if nine!=nines then return false end if
end for
end for
return true
end function

function solve(string board)
{sequence solution, sequence valid, integer solved} = plain_logic(board)
if solved=INVALID then return {{},INVALID} end if
if solved=SOLVED then return {{solution},SOLVED} end if
if solved=BRUTE then return {{solution},BRUTE} end if
if solved!=INCOMPLETE then ?9/0 end if
-- find the cell with the fewest options:
-- (a possible improvement here would be to select the shortest
--  with the "most pairs" set, see swordfish etc above.)
integer minopt = 10, mindx
for i=1 to 9*9 do
object vi = valid[i]
if string(vi) then
if length(vi)<=1 then ?9/0 end if   -- should be caught above
if length(vi)<minopt then
minopt = length(vi)
mindx = i
end if
end if
end for
sequence solutions = {}
for i=1 to minopt do
board[mindx] = valid[mindx][i]
{solution,solved} = solve(board)
if solved=MULTIPLE then
return {solution,MULTIPLE}
elsif solved=SOLVED
or solved=BRUTE then
if not find(solution[1],solutions)
and validate(solution[1]) then
solutions = append(solutions,solution[1])
end if
if length(solutions)>1 then
return {solutions,MULTIPLE}
elsif length(solutions) then
return {solutions,BRUTE}
end if
end if
end for
if length(solutions)=1 then
return {solutions,BRUTE}
end if
return {{},INVALID}
end function

function test_one(string board)
{sequence solutions, integer solved} = solve(board)
string solution, desc
if solved=SOLVED then
desc = "(logic)"
elsif solved=BRUTE then
desc = "(brute force)"
else
desc = "???" -- INVALID/INCOMPLETE/MULTIPLE
end if
if length(solutions)=0 then
solution = board
desc = "*** NO SOLUTIONS ***"
elsif length(solutions)=1 then
solution = solutions[1]
if not validate(solution) then
desc = "*** ERROR ***"  -- (should never happen)
end if
else
solution = board
desc = "*** MULTIPLE SOLUTIONS ***"
end if
return {solution,desc}
end function

--NB Blank cells can be represented by any character <'1'. Spaces are not recommended since
--   they can all too easily be converted to tabs by copy/paste/save. In particular, ? and
--   _ are NOT valid characters for representing a blank square. Use any of .0-* instead.

constant tests = {
"..............3.85..1.2.......5.7.....4...1...9.......5......73..2.1........4...9",    -- (0.01s, (logic))
-- row/col elimination (was 8s w/o logic first)
"000000036840000000000000020000203000010000700000600400000410050003000200600000000",    -- (0.04s, (brute force))
".......39.....1..5..3.5.8....8.9...6.7...2...1..4.......9.8..5..2....6..4..7.....",    -- (1.12s, (brute force))
"000037600000600090008000004090000001600000009300000040700000800010009000002540000",    -- (0.00s, (logic))
"....839..1......3...4....7..42.3....6.......4....7..1..2........8...92.....25...6",    -- (0.04s, (brute force))
"..1..5.7.92.6.......8...6...9..2.4.1.........3.4.8..9...7...3.......7.69.1.8..7..",    -- (0.00s, (logic))
-- (the following takes ~8s when checking for multiple solutions)
"--3------4---8--36--8---1---4--6--73---9----------2--5--4-7--686--------7--6--5--",    -- (0.01s, (brute force))
"..3.2.6..9..3.5..1..18.64....81.29..7.......8..67.82....26.95..8..2.3..9..5.1.3..",    -- (0.00s, (logic))
"--4-5--6--6-1--8-93----7----8----5-----4-3-----6----7----2----61-5--4-3--2--7-1--",    -- (0.00s, (logic))
-- x-wings
".4398.25.6..425...2....1.949....4.7.3..6.8...41.2.9..382.5.........4...553489.71.",    -- (0.00s, (logic))
".9...4..7.....79..8........4.58.....3.......2.....97.6........4..35.....2..6...8.",    -- (0.00s, (logic))
-- "AL Escargot", so-called "hardest sudoku"
"1....7.9..3..2...8..96..5....53..9...1..8...26....4...3......1..4......7..7...3..",    -- (0.26s, (brute force))
"12.3....435....1....4........54..2..6...7.........8.9...31..5.......9.7.....6...8",    -- (0.48s, (brute force))
"12.4..3..3...1..5...6...1..7...9.....4.6.3.....3..2...5...8.7....7.....5.......98",    -- (1.07s, (brute force))
"394..267....3..4..5..69..2..45...9..6.......7..7...58..1..67..8..9..8....264..735",    -- (0.00s, (logic))
"4......6.5...8.9..3....1....2.7....1.9.....4.8....3.5....2....7..6.5...8.1......6",    -- (0.01s, (brute force))
"5...7....6..195....98....6.8...6...34..8.3..17...2...6.6....28....419..5....8..79",    -- (0.00s, (logic))
"503600009010002600900000080000700005006804100200003000030000008004300050800006702",    -- (0.00s, (logic))
"53..247....2...8..1..7.39.2..8.72.49.2.98..7.79.....8.....3.5.696..1.3...5.69..1.",    -- (0.00s, (logic))
"530070000600195000098000060800060003400803001700020006060000280000419005000080079",    -- (0.00s, (logic))
-- set exclusion
"75..9..46961...3524.....79.2..6.1..7.8.....2.1..328.65.........3.9...2.484..3..79",    -- (0.00s, (logic))
-- Worlds hardest sudoku:
"800000000003600000070090200050007000000045700000100030001000068008500010090000400",    -- (0.21s, (brute force))
"819--5-----2---75--371-4-6-4--59-1--7--3-8--2--3-62--7-5-7-921--64---9-----2--438",    -- (0.00s, (logic))
"85...24..72......9..4.........1.7..23.5...9...4...........8..7..17..........36.4.",    -- (0.01s, (logic))
"9..2..5...4..6..3...3.....6...9..2......5..8...7..4..37.....1...5..2..4...1..6..9",    -- (0.17s, (brute force))
"97.3...6..6.75.........8.5.......67.....3.....539..2..7...25.....2.1...8.4...73..",    -- (0.00s, (logic))
-- "the beast" (an earlier algorithm took 318s (5min 18s) on this):
"000060080020000000001000000070000102500030000000000400004201000300700600000000050",    -- (0.03s, (brute force))
\$},

lt = length(tests),
run_one_test = 0

constant l = " x x x | x x x | x x x ",
s = "-------+-------+-------",
l3 = join({l,l,l},"\n"),
fmt = substitute(join({l3,s,l3,s,l3},"\n"),"x","%c")&"\n"

procedure test()
string board,   -- (81 characters)
solution, desc
atom t0 = time()
if run_one_test then
board = tests[run_one_test]
printf(1,fmt,board)
{solution,desc} = test_one(board)
if length(solution)!=0 then
printf(1,"solution:\n")
printf(1,fmt,solution)
end if
printf(1,"%s, %3.2fs\n",{desc,time()-t0})
else
for i=1 to lt do
atom t1 = time()
board = tests[i]
{solution,desc} = test_one(board)
printf(1,"    \"%s\",    -- (%3.2fs, %s)\n",{board,time()-t1,desc})
--          printf(1,"    \"%s\",    -- (%3.2fs, %s)\n",{solution,time()-t1,desc})
end for
t0 = time()-t0
printf(1,"%d puzzles solved in %3.2fs (av %3.2fs)\n",{lt,t0,t0/lt})
end if
end procedure
test()
Output:
"..............3.85..1.2.......5.7.....4...1...9.......5......73..2.1........4...9",    -- (0.02s, (logic))
"000000036840000000000000020000203000010000700000600400000410050003000200600000000",    -- (0.03s, (brute force))
".......39.....1..5..3.5.8....8.9...6.7...2...1..4.......9.8..5..2....6..4..7.....",    -- (1.31s, (brute force))
"000037600000600090008000004090000001600000009300000040700000800010009000002540000",    -- (0.00s, (logic))
"....839..1......3...4....7..42.3....6.......4....7..1..2........8...92.....25...6",    -- (0.03s, (brute force))
"..1..5.7.92.6.......8...6...9..2.4.1.........3.4.8..9...7...3.......7.69.1.8..7..",    -- (0.00s, (logic))
"--3------4---8--36--8---1---4--6--73---9----------2--5--4-7--686--------7--6--5--",    -- (0.03s, (brute force))
"..3.2.6..9..3.5..1..18.64....81.29..7.......8..67.82....26.95..8..2.3..9..5.1.3..",    -- (0.00s, (logic))
"--4-5--6--6-1--8-93----7----8----5-----4-3-----6----7----2----61-5--4-3--2--7-1--",    -- (0.01s, (logic))
".4398.25.6..425...2....1.949....4.7.3..6.8...41.2.9..382.5.........4...553489.71.",    -- (0.00s, (logic))
".9...4..7.....79..8........4.58.....3.......2.....97.6........4..35.....2..6...8.",    -- (0.00s, (logic))
"1....7.9..3..2...8..96..5....53..9...1..8...26....4...3......1..4......7..7...3..",    -- (0.26s, (brute force))
"12.3....435....1....4........54..2..6...7.........8.9...31..5.......9.7.....6...8",    -- (0.40s, (brute force))
"12.4..3..3...1..5...6...1..7...9.....4.6.3.....3..2...5...8.7....7.....5.......98",    -- (1.12s, (brute force))
"394..267....3..4..5..69..2..45...9..6.......7..7...58..1..67..8..9..8....264..735",    -- (0.00s, (logic))
"4......6.5...8.9..3....1....2.7....1.9.....4.8....3.5....2....7..6.5...8.1......6",    -- (0.03s, (brute force))
"5...7....6..195....98....6.8...6...34..8.3..17...2...6.6....28....419..5....8..79",    -- (0.00s, (logic))
"503600009010002600900000080000700005006804100200003000030000008004300050800006702",    -- (0.01s, (logic))
"53..247....2...8..1..7.39.2..8.72.49.2.98..7.79.....8.....3.5.696..1.3...5.69..1.",    -- (0.00s, (logic))
"530070000600195000098000060800060003400803001700020006060000280000419005000080079",    -- (0.00s, (logic))
"75..9..46961...3524.....79.2..6.1..7.8.....2.1..328.65.........3.9...2.484..3..79",    -- (0.01s, (logic))
"800000000003600000070090200050007000000045700000100030001000068008500010090000400",    -- (0.21s, (brute force))
"819--5-----2---75--371-4-6-4--59-1--7--3-8--2--3-62--7-5-7-921--64---9-----2--438",    -- (0.00s, (logic))
"85...24..72......9..4.........1.7..23.5...9...4...........8..7..17..........36.4.",    -- (0.01s, (logic))
"9..2..5...4..6..3...3.....6...9..2......5..8...7..4..37.....1...5..2..4...1..6..9",    -- (0.18s, (brute force))
"97.3...6..6.75.........8.5.......67.....3.....539..2..7...25.....2.1...8.4...73..",    -- (0.00s, (logic))
"000060080020000000001000000070000102500030000000000400004201000300700600000000050",    -- (0.01s, (brute force))
27 puzzles solved in 3.74s (av 0.14s)

Running the fuller version mentioned above:

"008002000000600040064000092017005004200000008800100730470000910080001000000900200",    -- (0.05s, *** MULTIPLE SOLUTIONS ***)
338 puzzles solved in 36.20s (av 0.11s)
--or
338 puzzles solved in 16.46s (av 0.05s) (w/o check for multiple solutions)

Running a single puzzle (run_one_test set non-zero) produces:

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