Sudoku
![Task](http://static.miraheze.org/rosettacodewiki/thumb/b/ba/Rcode-button-task-crushed.png/64px-Rcode-button-task-crushed.png)
You are encouraged to solve this task according to the task description, using any language you may know.
Solve a partially filled-in normal 9x9 Sudoku grid and display the result in a human-readable format. Algorithmics of Sudoku may help implement this.
ALGOL 68
Note: This specimen retains the original D coding style.
<lang algol68>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 )</lang> 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
<lang AutoHotkey>#SingleInstance, Force SetBatchLines, -1 SetTitleMatchMode, 3
Loop 9 { r := A_Index, y := r*17-8 + (A_Index >= 7 ? 4 : A_Index >= 4 ? 2 : 0) Loop 9 { c := A_Index, x := c*17+5 + (A_Index >= 7 ? 4 : A_Index >= 4 ? 2 : 0) Gui, Add, Edit, x%x% y%y% w17 h17 v%r%_%c% Center Number Limit1 gNext } } Gui, Add, Button, vButton gSolve w175 x10 Center, Solve Gui, Add, Text, vMsg r3, Enter Sudoku puzzle and click Solve Gui, Show,, Sudoku Solver
Return
Solve:
Gui, Submit, NoHide Loop 9 { r := A_Index Loop 9 If (%r%_%A_Index% = "") puzzle .= "@" Else puzzle .= %r%_%A_Index% } s := A_TickCount answer := Sudoku(puzzle) iterations := ErrorLevel e := A_TickCount seconds := (e-s)/1000 StringSplit, a, answer, | Loop 9 { r := A_Index Loop 9 { b := (r*9)+A_Index-9 GuiControl,, %r%_%A_Index%, % a%b% GuiControl, +ReadOnly, %r%_%A_Index% } } if answer GuiControl,, Msg, Solved!`nTime: %seconds%s`nIterations: %iterations% else GuiControl,, Msg, Failed! :(`nTime: %seconds%s`nIterations: %iterations% GuiControl,, Button, Again! GuiControl, +gAgain, Button
return
GuiClose:
ExitApp
Again:
Reload
- 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, "[^1-9@]"), ErrorLevel := 0 ;format puzzle as single line string return Sudoku_Display(Sudoku_Solve(p))
}
Sudoku_Solve( p, d = 0 ) { ;d is 0-based
- http://www.autohotkey.com/forum/topic46679.html
- p
- 81 character puzzle string
- (concat all 9 rows of 9 chars each)
- givens represented as chars 1-9
- fill-ins as any non-null, non 1-9 char
- d
- used internally. omit on initial call
- returns
- 81 char string with non-givens replaced with valid solution
If (d >= 81), ErrorLevel++ return p ;this is 82nd iteration, so it has successfully finished iteration 81 If InStr( "123456789", SubStr(p, d+1, 1) ) ;this depth is a given, skip through return Sudoku_Solve(p, d+1) m := Sudoku_Constraints(p,d) ;a string of this level's constraints. ; (these will not change for all 9 loops) Loop 9 { If InStr(m, A_Index) Continue NumPut(Asc(A_Index), p, d, "Char") If r := Sudoku_Solve(p, d+1) return r } return 0
}
Sudoku_Constraints( ByRef p, d ) {
- returns a string of the constraints for a particular position
c := Mod(d,9) , r := (d - c) // 9 , b := r//3*27 + c//3*3 + 1 ;convert to 1-based , c++ return "" ; row: . SubStr(p, r * 9 + 1, 9) ; column: . SubStr(p,c ,1) SubStr(p,c+9 ,1) SubStr(p,c+18,1) . SubStr(p,c+27,1) SubStr(p,c+36,1) SubStr(p,c+45,1) . SubStr(p,c+54,1) SubStr(p,c+63,1) SubStr(p,c+72,1) ;box . SubStr(p, b, 3) SubStr(p, b+9, 3) SubStr(p, b+18, 3)
}
Sudoku_Display( p ) {
If StrLen(p) = 81 loop 81 r .= SubStr(p, A_Index, 1) . "|" return r
}</lang>
BBC BASIC
![](http://static.miraheze.org/rosettacodewiki/3/3a/Sudoku_bbc.gif)
<lang bbcbasic> 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 READ A$ 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%</lang>
BCPL
<lang BCPL>// This can be run using Cintcode BCPL freely available from www.cl.cam.ac.uk/users/mr10.
// This is a really naive program to solve Su Doku 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()
}</lang>
Bracmat
The program: <lang bracmat>{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)$ );</lang>
Solve a sudoku that is hard for a brute force solver: <lang bracmat>new'( sudokuSolver
, (.- - - - - - - - -) (.- - - - - 3 - 8 5) (.- - 1 - 2 - - - -) (.- - - 5 - 7 - - -) (.- - 4 - - - 1 - -) (.- 9 - - - - - - -) (.5 - - - - - - 7 3) (.- - 2 - 1 - - - -) (.- - - - 4 - - - 9) );</lang>
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. <lang c>#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; }</lang>
C_sharp
“Manual” Solution
<lang csharp>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(); Console.Read(); }
}</lang>
“Automatic” Solution
<lang csharp>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.Equal(B[row, col], sudoku[row][col])); } } 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]); } } }
}</lang> 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
C++
<lang cpp>#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( (string) "850002400" + (string) "720000009" + (string) "004000000" + (string) "000107002" + (string) "305000900" + (string) "040000000" + (string) "000080070" + (string) "017000000" + (string) "000036040" ); ss.solve();
}</lang>
Clojure
<lang 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)))))))</lang>
<lang clojure>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</lang>
Common Lisp
A simple solver without optimizations (except for pre-computing the possible entries of a cell). <lang lisp>(defun row-neighbors (row column grid &aux (neighbors '()))
(dotimes (i 9 neighbors) (let ((x (aref grid row i))) (unless (or (eq '_ x) (= i column)) (push x neighbors)))))
(defun column-neighbors (row column grid &aux (neighbors '()))
(dotimes (i 9 neighbors) (let ((x (aref grid i column))) (unless (or (eq x '_) (= i row)) (push x neighbors)))))
(defun square-neighbors (row column grid &aux (neighbors '()))
(let* ((rmin (* 3 (floor row 3))) (rmax (+ rmin 3)) (cmin (* 3 (floor column 3))) (cmax (+ cmin 3))) (do ((r rmin (1+ r))) ((= r rmax) neighbors) (do ((c cmin (1+ c))) ((= c cmax)) (let ((x (aref grid r c))) (unless (or (eq x '_) (= r row) (= c column)) (push x neighbors)))))))
(defun choices (row column grid)
(nset-difference (list 1 2 3 4 5 6 7 8 9) (nconc (row-neighbors row column grid) (column-neighbors row column grid) (square-neighbors row column grid))))
(defun solve (grid &optional (row 0) (column 0))
(cond ((= row 9) grid) ((= column 9) (solve grid (1+ row) 0)) ((not (eq '_ (aref grid row column))) (solve grid row (1+ column))) (t (dolist (choice (choices row column grid) (setf (aref grid row column) '_)) (setf (aref grid row column) choice) (when (eq grid (solve grid row (1+ column))) (return grid))))))</lang>
Example:
> (defparameter *puzzle* #2A((3 9 4 _ _ 2 6 7 _) (_ _ _ 3 _ _ 4 _ _) (5 _ _ 6 9 _ _ 2 _) (_ 4 5 _ _ _ 9 _ _) (6 _ _ _ _ _ _ _ 7) (_ _ 7 _ _ _ 5 8 _) (_ 1 _ _ 6 7 _ _ 8) (_ _ 9 _ _ 8 _ _ _) (_ 2 6 4 _ _ 7 3 5))) *PUZZLE* > (pprint (solve *puzzle*)) #2A((3 9 4 8 5 2 6 7 1) (2 6 8 3 7 1 4 5 9) (5 7 1 6 9 4 8 2 3) (1 4 5 7 8 3 9 6 2) (6 8 2 9 4 5 3 1 7) (9 3 7 1 2 6 5 8 4) (4 1 3 5 6 7 2 9 8) (7 5 9 2 3 8 1 4 6) (8 2 6 4 1 9 7 3 5))
Curry
Copied from Curry: Example Programs. <lang curry>----------------------------------------------------------------------------- --- 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"]</lang>
Alternative version
Minimal w/o read or show utilities. <lang curry>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</lang>
- 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
A little over-engineered solution, that shows some strong static typing useful in larger programs. <lang d>import std.stdio, std.range, std.string, std.algorithm, std.array,
std.typetuple, std.ascii, std.typecons;
template Range(size_t stop) { // For loop unrolling.
static if (stop == 0) alias Range = TypeTuple!(); else alias Range = TypeTuple!(Range!(stop - 1), stop - 1);
}
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) nothrow @safe @nogc { /*static*/ foreach (immutable i; Range!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; Range!sudokuUnitSide) /*static*/ foreach (immutable j; Range!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 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;
}</lang>
- 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
Adapted from: http://code.activestate.com/recipes/576725-brute-force-sudoku-solver/ <lang d>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));
}</lang>
- 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. <lang d>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));
}</lang> Same output.
Delphi
Example taken from C++ <lang delphi>type
TIntArray = array of Integer;
{ TSudokuSolver }
TSudokuSolver = class private FGrid: TIntArray;
function CheckValidity(val: Integer; x: Integer; y: Integer): Boolean; function ToString: string; reintroduce; procedure PlaceNumber(pos: Integer); 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;
procedure TSudokuSolver.PlaceNumber(pos: Integer); var
n: Integer;
begin
if Pos = 81 then raise Exception.Create('Finished!'); if FGrid[pos] > 0 then begin 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; PlaceNumber(Succ(pos)); 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
try PlaceNumber(0); ShowMessage('Unsolvable'); except ShowMessage((ExceptObject as Exception).Message); ShowMessage(ToString); end;
end;</lang> Usage: <lang delphi>var
SudokuSolver: TSudokuSolver;
begin
SudokuSolver := TSudokuSolver.Create('850002400' + '720000009' + '004000000' + '000107002' + '305000900' + '040000000' + '000080070' + '017000000' + '000036040'); try SudokuSolver.Solve; finally FreeAndNil(SudokuSolver); end;
end;</lang>
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. <lang Erlang> -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 ).
task() -> 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}], task( Simple ), 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}], task( Difficult ).
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(). </lang>
- Output:
5> sudoku:task(). 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
Forth
<lang forth>include lib/interprt.4th include lib/istype.4th include lib/argopen.4th
\ --------------------- \ Variables \ ---------------------
81 string sudokugrid 9 array sudoku_row 9 array sudoku_col 9 array sudoku_box
\ ------------- \ 4tH interface \ -------------
- >grid ( n2 a1 n1 -- n3)
rot dup >r 9 chars * sudokugrid + dup >r swap 0 do ( a1 a2) over i chars + c@ dup is-digit ( a1 a2 c f) if [char] 0 - over c! char+ else drop then loop ( a1 a2) nip r> - 9 / r> + ( n3)
0 s" 090004007" >grid s" 000007900" >grid s" 800000000" >grid s" 405800000" >grid s" 300000002" >grid s" 000009706" >grid s" 000000004" >grid s" 003500000" >grid s" 200600080" >grid drop
\ --------------------- \ Logic \ --------------------- \ Basically : \ Grid is parsed. All numbers are put into sets, which are \ implemented as bitmaps (sudoku_row, sudoku_col, sudoku_box) \ which represent sets of numbers in each row, column, box. \ only one specific instance of a number can exist in a \ particular set.
\ SOLVER is recursively called \ SOLVER looks for the next best guess using FINDNEXTSPACE \ tries this trail down... if fails, backtracks... and tries \ again.
\ Grid Related
- xy 9 * + ; \ x y -- offset ;
- getrow 9 / ;
- getcol 9 mod ;
- getbox dup getrow 3 / 3 * swap getcol 3 / + ;
\ Puts and gets numbers from/to grid only
- setnumber sudokugrid + c! ; \ n position --
- getnumber sudokugrid + c@ ;
- cleargrid sudokugrid 81 bounds do 0 i c! loop ;
\ -------------- \ Set related: sets are sudoku_row, sudoku_col, sudoku_box
\ ie x y -- ; adds x into bitmap y
- addbits_row cells sudoku_row + dup @ rot 1 swap lshift or swap ! ;
- addbits_col cells sudoku_col + dup @ rot 1 swap lshift or swap ! ;
- addbits_box cells sudoku_box + dup @ rot 1 swap lshift or swap ! ;
\ ie x y -- ; remove number x from bitmap y
- removebits_row cells sudoku_row + dup @ rot 1 swap lshift invert and swap ! ;
- removebits_col cells sudoku_col + dup @ rot 1 swap lshift invert and swap ! ;
- removebits_box cells sudoku_box + dup @ rot 1 swap lshift invert and swap ! ;
\ clears all bitsmaps to 0
- clearbitmaps 9 0 do i cells
0 over sudoku_row + ! 0 over sudoku_col + ! 0 swap sudoku_box + ! loop ;
\ Adds number to grid and sets
- addnumber \ number position --
2dup setnumber 2dup getrow addbits_row 2dup getcol addbits_col getbox addbits_box
\ Remove number from grid, and sets
- removenumber \ position --
dup getnumber swap 2dup getrow removebits_row 2dup getcol removebits_col 2dup getbox removebits_box nip 0 swap setnumber
\ gets bitmap at position, ie \ position -- bitmap
- getrow_bits getrow cells sudoku_row + @ ;
- getcol_bits getcol cells sudoku_col + @ ;
- getbox_bits getbox cells sudoku_box + @ ;
\ position -- composite bitmap (or'ed)
- getbits
dup getrow_bits over getcol_bits rot getbox_bits or or
\ algorithm from c.l.f circa 1995 ? Will Baden
- countbits ( number -- bits )
[HEX] DUP 55555555 AND SWAP 1 RSHIFT 55555555 AND + DUP 33333333 AND SWAP 2 RSHIFT 33333333 AND + DUP 0F0F0F0F AND SWAP 4 RSHIFT 0F0F0F0F AND + [DECIMAL] 255 MOD
\ Try tests a number in a said position of grid \ Returns true if it's possible, else false.
- try \ number position -- true/false
getbits 1 rot lshift and 0=
\ --------------
- parsegrid \ Parses Grid to fill sets.. Run before solver.
sudokugrid \ to ensure all numbers are parsed into sets/bitmaps 81 0 do dup i + c@ dup if dup i try if i addnumber else unloop drop drop FALSE exit then else drop then loop drop TRUE
\ Morespaces? manually checks for spaces ... \ Obviously this can be optimised to a count var, done initially \ Any additions/subtractions made to the grid could decrement \ a 'spaces' variable.
- morespaces?
0 sudokugrid 81 bounds do i c@ 0= if 1+ then loop ;
- findnextmove \ -- n ; n = index next item, if -1 finished.
-1 10 \ index prev_possibilities -- \ err... yeah... local variables, kind of...
81 0 do i sudokugrid + c@ 0= IF i getbits countbits 9 swap -
\ get bitmap and see how many possibilities \ stack diagram: \ index prev_possibilities new_possiblities --
2dup > if \ if new_possibilities < prev_possibilities... nip nip i swap \ new_index new_possibilies --
else \ else prev_possibilities < new possibilities, so:
drop \ new_index new_possibilies --
then THEN loop drop
\ findnextmove returns index of best next guess OR returns -1 \ if no more guesses. You then have to check to see if there are \ spaces left on the board unoccupied. If this is the case, you \ need to back up the recursion and try again.
- solver
findnextmove dup 0< if morespaces? if drop false exit else drop true exit then then
10 1 do i over try if i over addnumber recurse if drop unloop TRUE EXIT else dup removenumber then then loop
drop FALSE
\ SOLVER
- startsolving
clearbitmaps \ reparse bitmaps and reparse grid parsegrid \ just in case.. solver AND
\ --------------------- \ Display Grid \ ---------------------
\ Prints grid nicely
- .sudokugrid
CR CR sudokugrid 81 0 do dup i + c@ . i 1+ dup 3 mod 0= if dup 9 mod 0= if CR dup 27 mod 0= if dup 81 < if ." ------+-------+------" CR then then else ." | " then then drop loop drop CR
\ --------------------- \ Higher Level Words \ ---------------------
- checkifoccupied ( offset -- t/f)
sudokugrid + c@
- add ( n x y --)
xy 2dup dup checkifoccupied if dup removenumber then try if addnumber .sudokugrid else CR ." Not a valid move. " CR 2drop then
- rm
xy removenumber .sudokugrid
- clearit
cleargrid clearbitmaps .sudokugrid
- solveit
CR startsolving if ." Solution found!" CR .sudokugrid else ." No solution found!" CR CR then
- showit .sudokugrid ;
\ Print help menu
- help
CR ." Type clearit ; to clear grid " CR ." 1-9 x y add ; to add 1-9 to grid at x y (0 based) " CR ." x y rm ; to remove number at x y " CR ." showit ; redisplay grid " CR ." solveit ; to solve " CR ." help ; for help " CR CR
\ --------------------- \ Execution starts here \ ---------------------
- godoit
clearbitmaps parsegrid if CR ." Grid valid!" else CR ." Warning: grid invalid!" then .sudokugrid help
\ ------------- \ 4tH interface \ -------------
- read-sudoku
input 1 arg-open 0 begin dup 9 < while refill while 0 parse >grid repeat drop close
- bye quit ;
create wordlist \ dictionary
," clearit" ' clearit , ," add" ' add , ," rm" ' rm , ," showit" ' showit , ," solveit" ' solveit , ," quit" ' bye , ," exit" ' bye , ," bye" ' bye , ," q" ' bye , ," help" ' help , NULL ,
wordlist to dictionary
- noname ." Unknown command '" type ." '" cr ; is NotFound
\ sudoku interpreter
- sudoku
argn 1 > if read-sudoku then godoit begin ." OK" cr refill drop ['] interpret catch if ." Error" cr then again
sudoku</lang>
Fortran
This implementation uses a brute force method. The subroutine solve
recursively checks valid entries using the rules defined in the function is_safe
. When solve
is called beyond the end of the sudoku, we know that all the currently entered values are valid. Then the result is displayed.
<lang fortran>program sudoku
implicit none integer, dimension (9, 9) :: grid integer, dimension (9, 9) :: grid_solved grid = reshape ((/ & & 0, 0, 3, 0, 2, 0, 6, 0, 0, & & 9, 0, 0, 3, 0, 5, 0, 0, 1, & & 0, 0, 1, 8, 0, 6, 4, 0, 0, & & 0, 0, 8, 1, 0, 2, 9, 0, 0, & & 7, 0, 0, 0, 0, 0, 0, 0, 8, & & 0, 0, 6, 7, 0, 8, 2, 0, 0, & & 0, 0, 2, 6, 0, 9, 5, 0, 0, & & 8, 0, 0, 2, 0, 3, 0, 0, 9, & & 0, 0, 5, 0, 1, 0, 3, 0, 0/), & & shape = (/9, 9/), & & order = (/2, 1/)) call pretty_print (grid) call solve (1, 1) write (*, *) call pretty_print (grid_solved)
contains
recursive subroutine solve (i, j) implicit none integer, intent (in) :: i integer, intent (in) :: j integer :: n integer :: n_tmp if (i > 9) then grid_solved = grid else do n = 1, 9 if (is_safe (i, j, n)) then n_tmp = grid (i, j) grid (i, j) = n if (j == 9) then call solve (i + 1, 1) else call solve (i, j + 1) end if grid (i, j) = n_tmp end if end do end if end subroutine solve
function is_safe (i, j, n) result (res) implicit none integer, intent (in) :: i integer, intent (in) :: j integer, intent (in) :: n logical :: res integer :: i_min integer :: j_min if (grid (i, j) == n) then res = .true. return end if if (grid (i, j) /= 0) then res = .false. return end if if (any (grid (i, :) == n)) then res = .false. return end if if (any (grid (:, j) == n)) then res = .false. return end if i_min = 1 + 3 * ((i - 1) / 3) j_min = 1 + 3 * ((j - 1) / 3) if (any (grid (i_min : i_min + 2, j_min : j_min + 2) == n)) then res = .false. return end if res = .true. end function is_safe
subroutine pretty_print (grid) implicit none integer, dimension (9, 9), intent (in) :: grid integer :: i integer :: j character (*), parameter :: bar = '+-----+-----+-----+' character (*), parameter :: fmt = '(3 ("|", i0, 1x, i0, 1x, i0), "|")' write (*, '(a)') bar do j = 0, 6, 3 do i = j + 1, j + 3 write (*, fmt) grid (i, :) end do write (*, '(a)') bar end do end subroutine pretty_print
end program sudoku</lang> Output:
+-----+-----+-----+ |0 0 3|0 2 0|6 0 0| |9 0 0|3 0 5|0 0 1| |0 0 1|8 0 6|4 0 0| +-----+-----+-----+ |0 0 8|1 0 2|9 0 0| |7 0 0|0 0 0|0 0 8| |0 0 6|7 0 8|2 0 0| +-----+-----+-----+ |0 0 2|6 0 9|5 0 0| |8 0 0|2 0 3|0 0 9| |0 0 5|0 1 0|3 0 0| +-----+-----+-----+ +-----+-----+-----+ |4 8 3|9 2 1|6 5 7| |9 6 7|3 4 5|8 2 1| |2 5 1|8 7 6|4 9 3| +-----+-----+-----+ |5 4 8|1 3 2|9 7 6| |7 2 9|5 6 4|1 3 8| |1 3 6|7 9 8|2 4 5| +-----+-----+-----+ |3 7 2|6 8 9|5 1 4| |8 1 4|2 5 3|7 6 9| |6 9 5|4 1 7|3 8 2| +-----+-----+-----+
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. <lang go>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
}</lang> 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
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. <lang groovy>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
}</lang> Test/Benchmark Cases
Mentions of "exceptionally difficult" example in Wikipedia refer to this page: Exceptionally difficult Sudokus <lang groovy>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 Ada: ~ 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"
}</lang>
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
Haskell
Visit the Haskell wiki Sudoku
J
See Solving Sudoku in J.
Java
<lang 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); }
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(" -----------------------"); }
}</lang>
Lua
<lang lua>--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 read() 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</lang> 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
Mathematica
<lang mathematica>solve[array_] :=
NestWhile[ Join @@ Function[newarray, Function[{i, j}, Table[ReplacePart[newarray, Position[newarray, 0, {2}, 1]1 -> n], {n, Select[Range@9, FreeQ[newarrayi, #] && FreeQ[newarrayAll, j, #] && FreeQ[Partition[ newarray, {3, 3}][[Sequence @@ Quotient[{i, j}, 3, -2]]], #] &]}]] @@ Position[newarray, 0, {2}, 1]1] /@ # &, {array}, ! FreeQ[#, 0] &]</lang>
Example: <lang>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}}]</lang>
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" <lang MATLAB>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) = Template:(1:3),(1:3); subBoxes(4:6,:)= Template:(4:6),(1:3); subBoxes(7:9,:)= Template:(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</lang> Test Input: All empty cells must have a value of NaN. <lang MATLAB>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]</lang>
Output: <lang MATLAB>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</lang>
OCaml
uses the library ocamlgraph <lang ocaml>(* Ocamlgraph demo program: solving the Sudoku puzzle using graph coloring
Copyright 2004-2007 Sylvain Conchon, Jean-Christophe Filliatre, Julien Signoles
This software is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License version 2, with the special exception on linking described in file LICENSE.
This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *)
open Format open Graph
(* We use undirected graphs with nodes containing a pair of integers
(the cell coordinates in 0..8 x 0..8). The integer marks of the nodes will store the colors. *)
module G = Imperative.Graph.Abstract(struct type t = int * int end)
(* The Sudoku grid = a graph with 9x9 nodes *) let g = G.create ()
(* We create the 9x9 nodes, add them to the graph and keep them in a matrix
for later access *)
let nodes =
let new_node i j = let v = G.V.create (i, j) in G.add_vertex g v; v in Array.init 9 (fun i -> Array.init 9 (new_node i))
let node i j = nodes.(i).(j) (* shortcut for easier access *)
(* We add the edges:
two nodes are connected whenever they can't have the same value, i.e. they belong to the same line, the same column or the same 3x3 group *)
let () =
for i = 0 to 8 do for j = 0 to 8 do for k = 0 to 8 do if k <> i then G.add_edge g (node i j) (node k j); if k <> j then G.add_edge g (node i j) (node i k); done; let gi = 3 * (i / 3) and gj = 3 * (j / 3) in for di = 0 to 2 do for dj = 0 to 2 do let i' = gi + di and j' = gj + dj in if i' <> i || j' <> j then G.add_edge g (node i j) (node i' j') done done done done
(* Displaying the current state of the graph *) let display () =
for i = 0 to 8 do for j = 0 to 8 do printf "%d" (G.Mark.get (node i j)) done; printf "\n"; done; printf "@?"
(* We read the initial constraints from standard input and we display g *) let () =
for i = 0 to 8 do let s = read_line () in for j = 0 to 8 do match s.[j] with | '1'..'9' as ch -> G.Mark.set (node i j) (Char.code ch - Char.code '0') | _ -> () done done; display (); printf "---------@."
(* We solve the Sudoku by 9-coloring the graph g and we display the solution *) module C = Coloring.Mark(G)
let () = C.coloring g 9; display ()</lang>
Oz
Using built-in constraint propagation and search. <lang oz>declare
%% a puzzle is a function that returns an initial board configuration fun {Puzzle1} %% a board is a list of 9 rows [[4 _ _ _ _ _ _ 6 _] [5 _ _ _ 8 _ 9 _ _] [3 _ _ _ _ 1 _ _ _] [_ 2 _ 7 _ _ _ _ 1] [_ 9 _ _ _ _ _ 4 _] [8 _ _ _ _ 3 _ 5 _] [_ _ _ 2 _ _ _ _ 7] [_ _ 6 _ 5 _ _ _ 8] [_ 1 _ _ _ _ _ _ 6]] end
%% Returns a list of solutions for the given puzzle. fun {Solve Puzzle} {SearchAll {GetScript Puzzle}} end
%% Creates a solver script for a puzzle. fun {GetScript Puzzle} proc {$ Board} %% Every row is a list of nine finite domain vars %% with the domain 1..9. Board = {MapRange fun {$ _} {FD.list 9 1#9} end} %% Post initial configuration. Board = {Puzzle} %% The core constraints: {ForAll {Rows Board} FD.distinct} {ForAll {Columns Board} FD.distinct} {ForAll {Boxes Board} FD.distinct}
%% Search if necessary. {FD.distribute ff {Flatten Board}} end end %% Returns the board as a list of rows. fun {Rows Board} Board %% This is already the representation we have chosen. end %% Returns the board as a list of columns. fun {Columns Board} {MapRange fun {$ I} {Column Board I} end} end %% Returns the board as a list of boxes (sub-grids). fun {Boxes Board} {MapRange fun {$ I} {Box Board I} end} end %% Helper function: map the range 1..9 to something. fun {MapRange F} {Map [1 2 3 4 5 6 7 8 9] F} end %% Returns a column of the board as a list of fields. fun {Column Board Index} {Map Board fun {$ Row} {Nth Row Index} end } end %% Returns a box of the board as a list of fields. fun {Box Board Index} Index0 = Index-1 Fields = {Flatten Board} Start = (Index0 div 3) * 27 + (Index0 mod 3)*3 in {Flatten for I in 0..2 collect:C do {C {List.take {List.drop Fields Start+I*9} 3}} end } end
in
{Inspect {Solve Puzzle1}.1}</lang>
Perl
<lang 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();</lang> 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
Perl 6
<lang perl6>use v6; my @A = <
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
>;
my &I = * div 9; # line number my &J = * % 9; # column number my &K = { ($_ div 27) * 3 + $_ % 9 div 3 }; # bloc number
sub solve {
for ^@A -> $i {
next if @A[$i]; my @taken-values = @A[ grep { I($_) == I($i) || J($_) == J($i) || K($_) == K($i) }, ^@A ]; for grep none(@taken-values), 1..9 { @A[$i] = $_; solve; } return @A[$i] = 0;
} my $i = 1; for ^@A {
print "@A[$_] "; print " " if $i %% 3; print "\n" if $i %% 9; print "\n" if $i++ %% 27;
}
} solve;</lang>
- 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
PicoLisp
<lang PicoLisp>(load "lib/simul.l")
- Fields/Board ###
- val lst
(setq
*Board (grid 9 9) *Fields (apply append *Board) )
- Init values to zero (empty)
(for L *Board
(for This L (=: val 0) ) )
- Build lookup lists
(for (X . L) *Board
(for (Y . This) L (=: lst (make (let A (* 3 (/ (dec X) 3)) (do 3 (inc 'A) (let B (* 3 (/ (dec Y) 3)) (do 3 (inc 'B) (unless (and (= A X) (= B Y)) (link (prop (get *Board A B) 'val) ) ) ) ) ) ) (for Dir '(`west `east `south `north) (for (This (Dir This) This (Dir This)) (unless (memq (:: val) (made)) (link (:: val)) ) ) ) ) ) ) )
- Cut connections (for display only)
(for (X . L) *Board
(for (Y . This) L (when (member X (3 6)) (con (car (val This))) ) (when (member Y (4 7)) (set (cdr (val This))) ) ) )
- Display board
(de display ()
(disp *Board 0 '((This) (if (=0 (: val)) " " (pack " " (: val) " ") ) ) ) )
- Initialize board
(de main (Lst)
(for (Y . L) Lst (for (X . N) L (put *Board X (- 10 Y) 'val N) ) ) (display) )
- Find solution
(de go ()
(unless (recur (*Fields) (with (car *Fields) (if (=0 (: val)) (loop (NIL (or (assoc (inc (:: val)) (: lst)) (recurse (cdr *Fields)) ) ) (T (= 9 (: val)) (=: val 0)) ) (recurse (cdr *Fields)) ) ) ) (display) ) )
(main
(quote (5 3 0 0 7 0 0 0 0) (6 0 0 1 9 5 0 0 0) (0 9 8 0 0 0 0 6 0) (8 0 0 0 6 0 0 0 3) (4 0 0 8 0 3 0 0 1) (7 0 0 0 2 0 0 0 6) (0 6 0 0 0 0 2 8 0) (0 0 0 4 1 9 0 0 5) (0 0 0 0 8 0 0 7 9) ) )</lang>
Output:
+---+---+---+---+---+---+---+---+---+ 9 | 5 3 | 7 | | + + + + + + + + + + 8 | 6 | 1 9 5 | | + + + + + + + + + + 7 | 9 8 | | 6 | +---+---+---+---+---+---+---+---+---+ 6 | 8 | 6 | 3 | + + + + + + + + + + 5 | 4 | 8 3 | 1 | + + + + + + + + + + 4 | 7 | 2 | 6 | +---+---+---+---+---+---+---+---+---+ 3 | 6 | | 2 8 | + + + + + + + + + + 2 | | 4 1 9 | 5 | + + + + + + + + + + 1 | | 8 | 7 9 | +---+---+---+---+---+---+---+---+---+ a b c d e f g h i
<lang PicoLisp>(go)</lang> Output:
+---+---+---+---+---+---+---+---+---+ 9 | 5 3 4 | 6 7 8 | 9 1 2 | + + + + + + + + + + 8 | 6 7 2 | 1 9 5 | 3 4 8 | + + + + + + + + + + 7 | 1 9 8 | 3 4 2 | 5 6 7 | +---+---+---+---+---+---+---+---+---+ 6 | 8 5 9 | 7 6 1 | 4 2 3 | + + + + + + + + + + 5 | 4 2 6 | 8 5 3 | 7 9 1 | + + + + + + + + + + 4 | 7 1 3 | 9 2 4 | 8 5 6 | +---+---+---+---+---+---+---+---+---+ 3 | 9 6 1 | 5 3 7 | 2 8 4 | + + + + + + + + + + 2 | 2 8 7 | 4 1 9 | 6 3 5 | + + + + + + + + + + 1 | 3 4 5 | 2 8 6 | 1 7 9 | +---+---+---+---+---+---+---+---+---+ a b c d e f g h i
PL/I
Working PL/I version, derived from the Rosetta Fortran version. <lang PL/I>sudoku: procedure options (main); /* 27 July 2014 */
declare grid (9,9) fixed (1) static initial ( 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 );
declare grid_solved (9,9) fixed (1);
call print_sudoku (grid); call solve (1, 1); put skip (2); call print_sudoku (grid_solved);
solve: procedure (i, j) recursive options (reorder);
declare (i, j) fixed binary; declare (n, n_tmp) fixed binary;
if i > 9 then grid_solved = grid; else do n = 1 to 9; if is_safe (i, j, n) then do; n_tmp = grid (i, j); grid (i, j) = n; if j = 9 then call solve (i + 1, 1); else call solve (i, j + 1); grid (i, j) = n_tmp; end; end;
end solve;
is_safe: procedure (i, j, n) returns (bit(1) aligned) options (reorder);
declare (i, j, n) fixed binary; declare (true value ('1'b), false value ('0'b) ) bit (1); declare (i_min, j_min, ii, jj) fixed binary; declare kk bit(1) aligned;
if grid (i, j) = n then return (true); if grid (i, j) ^= 0 then return (false); if any (grid (i, *) = n) then return (false); if any (grid (*, j) = n) then return (false);
/* i_min and j_min are the co-ordinates of the top left-hand corner */ /* of 3 x 3 grid in which element (i,j) exists. */ i_min = 1 + 3 * trunc((i - 1) / 3); j_min = 1 + 3 * trunc((j - 1) / 3);
begin; declare sub_grid(3,3) fixed (1) defined grid(1sub+i_min-1,2sub+j_min-1);
kk = true; if any(sub_grid = n) then kk = false; end; return (kk); end is_safe;
print_sudoku: procedure (grid);
declare grid (*,*) fixed (1); declare ( i, j, ii) fixed binary; declare bar character (19) initial ( '+-----+-----+-----+' ); declare frame (9) character (1) initial (' ', ' ', '|', ' ', ' ', '|', ' ', ' ', '|' );
put skip list (bar); do i = 1 to 7 by 3; do ii = i to i + 2; put skip edit ( '|', (grid (ii, j), frame(j) do j = 1 to 9) ) (a, f(1)); end; put skip list (bar); end; end print_sudoku;
end sudoku; </lang> Output:
+-----+-----+-----+ |0 0 3|0 2 0|6 0 0| |9 0 0|3 0 5|0 0 1| |0 0 1|8 0 6|4 0 0| +-----+-----+-----+ |0 0 8|1 0 2|9 0 0| |7 0 0|0 0 0|0 0 8| |0 0 6|7 0 8|2 0 0| +-----+-----+-----+ |0 0 2|6 0 9|5 0 0| |8 0 0|2 0 3|0 0 9| |0 0 5|0 1 0|3 0 0| +-----+-----+-----+ +-----+-----+-----+ |4 8 3|9 2 1|6 5 7| |9 6 7|3 4 5|8 2 1| |2 5 1|8 7 6|4 9 3| +-----+-----+-----+ |5 4 8|1 3 2|9 7 6| |7 2 9|5 6 4|1 3 8| |1 3 6|7 9 8|2 4 5| +-----+-----+-----+ |3 7 2|6 8 9|5 1 4| |8 1 4|2 5 3|7 6 9| |6 9 5|4 1 7|3 8 2| +-----+-----+-----+
Another PL/I version, reads sudoku from the text data file as 81 character record. <lang PL/I>
- PROCESS MARGINS(1,120) LIBS(SINGLE,STATIC);
- PROCESS OPTIMIZE(2) DFT(REORDER);
sudoku: proc(parms) options(main); dcl parms char (100) var;
define alias bits bit (9) aligned; dcl total (81) type bits; dcl matrix (9, 9) type bits based(addr(total)); dcl box (9, 3, 3) type bits defined (total(trunc((1sub-1) /3) * 27 + mod(1sub-1, 3) * 3 + (2sub-1) * 9 + 3sub));
dcl posbit (0:9) type bits init('000000000'b, '100000000'b, '010000000'b, '001000000'b, '000100000'b, '000010000'b, '000001000'b, '000000100'b, '000000010'b, '000000001'b);
dcl (i, j, k) fixed bin(31); dcl (start, finish) float(18); dcl result fixed dec(5,3);
dcl buffer char(81); dcl in file;
/* ON UNIT for the Sudoku data conversion */ on conversion begin; put skip list('Sudoku data not valid.'); stop; end;
/* ON UNIT to display info about the usage */ on undefinedfile(in) begin; put skip list('Usage: ' || procedurename() || ' /filename'); stop; end;
open file(in) title ('/'||parms||',type(fixed), recsize(81)') record input;
/* Ignore the endfile condition */ on endfile(in);
/* Read the Sudoku data into buffer as one record */ read file(in) into(buffer); close file(in);
/* Convert numbers -> position bit presentation and assign into the Sudoku board */ do k = 1 to 81; total(k) = posbit(substr(buffer, k, 1)); end;
/* Start solving the Sudoku */ start = secs(); if solve() then do; finish = secs(); result = finish - start + 0.0005; put skip list('Sudoku solved! Time: ' || trim(result) || ' seconds'); put skip(2);
/* display the solved Sudoku if solution exist */ do i = 1 to 9; do j = 1 to 9; put edit(trim(index(matrix(i, j), '1'b))) (a(3)); end; put skip(2); end; end; else put skip list('Impossible!');
/*************************************/ /* Simple backtracking sudoku solver */ /*************************************/ solve: proc recursive returns(bit(1)); dcl (i, j, k) fixed bin(31); dcl result type bits;
/* find free cell */ do i = 1 to 9; do j = 1 to 9; if matrix(i, j) = posbit(0) then goto skip; end; end;
/* No more free cells. Check if the completed Sudoku is valid. */ /* Number in the cell is valid if the matching position bit is set. */ do i = 1 to 9; do j = 1 to 9; k = index(matrix(i, j), '1'b); matrix(i, j) = posbit(0); result = ^(any(matrix(i, *)) | any(matrix(*, j)) | any(box(numbox(i, j), *, *))); if substr(result, k, 1) = '0'b then return('0'b); matrix(i, j) = posbit(k); end; end;
return('1'b); skip:
/* Go through and test possible values for the free cell untill the Sudoku is completed */ result = ^(any(matrix(i, *)) | any(matrix(*, j)) | any(box(numbox(i, j), *, *))); k = 0; do forever; k = search(result, '1'b, k+1); if k = 0 then leave; matrix(i, j) = posbit(k); if solve() then return('1'b); else matrix(i, j) = posbit(0); end;
return('0'b); end solve;
/********************************************/ /* Returns box number for the sudoku coords */ /********************************************/ numbox: proc(i, j) returns(fixed bin(31)); dcl (i, j) fixed bin(31);
dcl lookup (9, 9) fixed bin(31) static init( (3)1, (3)2, (3)3, (3)1, (3)2, (3)3, (3)1, (3)2, (3)3, (3)4, (3)5, (3)6, (3)4, (3)5, (3)6, (3)4, (3)5, (3)6, (3)7, (3)8, (3)9, (3)7, (3)8, (3)9, (3)7, (3)8, (3)9 );
return(lookup(i, j)); end numbox;
end sudoku;
</lang>
Prolog
<lang Prolog>:- use_module(library(clpfd)).
sudoku(Rows) :-
length(Rows, 9), maplist(length_(9), Rows), append(Rows, Vs), Vs ins 1..9, maplist(all_distinct, Rows), transpose(Rows, Columns), maplist(all_distinct, Columns), Rows = [A,B,C,D,E,F,G,H,I], blocks(A, B, C), blocks(D, E, F), blocks(G, H, I).
length_(L, Ls) :- length(Ls, L).
blocks([], [], []). blocks([A,B,C|Bs1], [D,E,F|Bs2], [G,H,I|Bs3]) :-
all_distinct([A,B,C,D,E,F,G,H,I]), blocks(Bs1, Bs2, Bs3).
problem(1, [[_,_,_,_,_,_,_,_,_],
[_,_,_,_,_,3,_,8,5], [_,_,1,_,2,_,_,_,_], [_,_,_,5,_,7,_,_,_], [_,_,4,_,_,_,1,_,_], [_,9,_,_,_,_,_,_,_], [5,_,_,_,_,_,_,7,3], [_,_,2,_,1,_,_,_,_], [_,_,_,_,4,_,_,_,9]]).</lang>
GNU Prolog version
<lang Prolog>:- initialization(main).
solve(Rows) :-
maplist(domain_1_9, Rows) , different(Rows) , transpose(Rows,Cols), different(Cols) , blocks(Rows,Blocks) , different(Blocks) , maplist(fd_labeling, Rows) .
domain_1_9(Rows) :- fd_domain(Rows,1,9). different(Rows) :- maplist(fd_all_different, Rows).
blocks(Rows,Blocks) :-
maplist(split3,Rows,Xs), transpose(Xs,Ys) , concat(Ys,Zs), concat_map(split3,Zs,Blocks) . % where split3([X,Y,Z|L],[[X,Y,Z]|R]) :- split3(L,R). split3([],[]).
% utils/list
concat_map(F,Xs,Ys) :- call(F,Xs,Zs), maplist(concat,Zs,Ys).
concat([],[]). concat([X|Xs],Ys) :- append(X,Zs,Ys), concat(Xs,Zs).
transpose([],[]). transpose([[X]|Col], Row) :- transpose(Col,[Row]). transpose(Row, [[X]|Col]) :- transpose([Row],Col). transpose([[X|Row]|Xs], [[X|Col]|Ys]) :-
maplist(bind_head, Row, Ys, YX) , maplist(bind_head, Col, Xs, XY) , transpose(XY,YX) . % where bind_head(H,[H|T],T). bind_head([],[],[]).
% tests
test([ [_,_,3,_,_,_,_,_,_]
, [4,_,_,_,8,_,_,3,6] , [_,_,8,_,_,_,1,_,_] , [_,4,_,_,6,_,_,7,3] , [_,_,_,9,_,_,_,_,_] , [_,_,_,_,_,2,_,_,5] , [_,_,4,_,7,_,_,6,8] , [6,_,_,_,_,_,_,_,_] , [7,_,_,6,_,_,5,_,_] ]).
main :- test(T), solve(T), maplist(show,T), halt. show(X) :- write(X), nl.</lang>
- Output:
[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]
Runs in: time: 0.02 memory: 68352 (adapted for gprolog 1.3.1)
PureBasic
A brute force method is used, it seemed the fastest as well as the simplest. <lang PureBasic>DataSection
puzzle: Data.s "394002670" Data.s "000300400" Data.s "500690020" Data.s "045000900" Data.s "600000007" Data.s "007000580" Data.s "010067008" Data.s "009008000" Data.s "026400735"
EndDataSection
- IsPossible = 0
- IsNotPossible = 1
- Unknown = 0
Global Dim sudoku(8, 8)
- -declarations
Declare readSudoku() Declare displaySudoku() Declare.s buildpossible(x, y, Array possible.b(1)) Declare solvePuzzle(x = 0, y = 0)
- -procedures
Procedure readSudoku()
Protected a$, row, column Restore puzzle For row = 0 To 8 Read.s a$ For column = 0 To 8 sudoku(column, row) = Val(Mid(a$, column + 1, 1)) Next Next
EndProcedure
Procedure displaySudoku()
Protected row, column Static border.s = "+-----+-----+-----+" For row = 0 To 8 If row % 3 = 0: PrintN(border): EndIf For column = 0 To 8 If column % 3 = 0: Print("|"): Else: Print(" "): EndIf If sudoku(column, row): Print(Str(sudoku(column, row))): Else: Print("."): EndIf Next PrintN("|") Next PrintN(border)
EndProcedure
Procedure.s buildpossible(x, y, Array possible.b(1))
Protected index, column, row, boxColumn = (x / 3) * 3, boxRow = (y / 3) * 3 Dim possible.b(9)
For index = 0 To 8 possible(sudoku(index, y)) = #IsNotPossible ;record possibles in column possible(sudoku(x, index)) = #IsNotPossible ;record possibles in row Next ;record possibles in box For row = boxRow To boxRow + 2 For column = boxColumn To boxColumn + 2 possible(sudoku(column, row)) = #IsNotPossible Next Next
EndProcedure
Procedure solvePuzzle(x = 0, y = 0)
Protected row, column, spot, digit Dim possible.b(9) For row = y To 8 For column = x To 8 If sudoku(column, row) = #Unknown buildpossible(column, row, possible()) For digit = 1 To 9 If possible(digit) = #IsPossible sudoku(column, row) = digit spot = row * 9 + column + 1 If solvePuzzle(spot % 9, spot / 9) Break 3 EndIf EndIf Next
If digit = 10 sudoku(column, row) = #Unknown ProcedureReturn #False EndIf EndIf Next x = 0 ;reset column start point Next ProcedureReturn #True
EndProcedure
If OpenConsole()
readSudoku() displaySudoku() If solvePuzzle() PrintN("Solved.") displaySudoku() Else PrintN("Unable to solve puzzle") ;due to bad starting data EndIf Print(#CRLF$ + #CRLF$ + "Press ENTER to exit") Input() CloseConsole()
EndIf</lang> Sample output:
+-----+-----+-----+ |3 9 4|. . 2|6 7 .| |. . .|3 . .|4 . .| |5 . .|6 9 .|. 2 .| +-----+-----+-----+ |. 4 5|. . .|9 . .| |6 . .|. . .|. . 7| |. . 7|. . .|5 8 .| +-----+-----+-----+ |. 1 .|. 6 7|. . 8| |. . 9|. . 8|. . .| |. 2 6|4 . .|7 3 5| +-----+-----+-----+ Solved. +-----+-----+-----+ |3 9 4|8 5 2|6 7 1| |2 6 8|3 7 1|4 5 9| |5 7 1|6 9 4|8 2 3| +-----+-----+-----+ |1 4 5|7 8 3|9 6 2| |6 8 2|9 4 5|3 1 7| |9 3 7|1 2 6|5 8 4| +-----+-----+-----+ |4 1 3|5 6 7|2 9 8| |7 5 9|2 3 8|1 4 6| |8 2 6|4 1 9|7 3 5| +-----+-----+-----+
Python
See Solving Sudoku puzzles with Python for GPL'd solvers of increasing complexity of algorithm.
A simple backtrack algorithm -- Quick but may take longer if the grid had been more than 9 x 9 <lang python> def initiate():
box.append([0, 1, 2, 9, 10, 11, 18, 19, 20]) box.append([3, 4, 5, 12, 13, 14, 21, 22, 23]) box.append([6, 7, 8, 15, 16, 17, 24, 25, 26]) box.append([27, 28, 29, 36, 37, 38, 45, 46, 47]) box.append([30, 31, 32, 39, 40, 41, 48, 49, 50]) box.append([33, 34, 35, 42, 43, 44, 51, 52, 53]) box.append([54, 55, 56, 63, 64, 65, 72, 73, 74]) box.append([57, 58, 59, 66, 67, 68, 75, 76, 77]) box.append([60, 61, 62, 69, 70, 71, 78, 79, 80]) for i in range(0, 81, 9): row.append(range(i, i+9)) for i in range(9): column.append(range(i, 80+i, 9))
def valid(n, pos):
current_row = pos/9 current_col = pos%9 current_box = (current_row/3)*3 + (current_col/3) for i in row[current_row]: if (grid[i] == n): return False for i in column[current_col]: if (grid[i] == n): return False for i in box[current_box]: if (grid[i] == n): return False return True
def solve():
i = 0 proceed = 1 while(i < 81): if given[i]: if proceed: i += 1 else: i -= 1 else: n = grid[i] prev = grid[i] while(n < 9): if (n < 9): n += 1 if valid(n, i): grid[i] = n proceed = 1 break if (grid[i] == prev): grid[i] = 0 proceed = 0 if proceed: i += 1 else: i -=1
def inputs():
nextt = 'T' number = 0 pos = 0 while(not(nextt == 'N' or nextt == 'n')): print "Enter the position:", pos = int(raw_input()) given[pos - 1] = True print "Enter the numerical:", number = int(raw_input()) grid[pos - 1] = number print "Do you want to enter another given?(Y, for yes: N, for no)" nextt = raw_input()
grid = [0]*81
given = [False]*81
box = []
row = []
column = []
initiate()
inputs()
solve()
for i in range(9):
print grid[i*9:i*9+9]
raw_input() </lang>
Racket
Rascal
![](http://static.miraheze.org/rosettacodewiki/thumb/b/bb/Sudoku.jpeg/200px-Sudoku.jpeg)
A sudoku is represented as a matrix, see Rascal solutions to matrix related problems for examples.
<lang Rascal>import Prelude; import vis::Figure; import vis::Render;
public rel[int,int,int] sudoku(rel[int x, int y, int v] sudoku){ annotated= annotateGrid(sudoku); solved = {<0,0,0,0,{0}>};
while(!isEmpty(solved)){ for (n <- [0 ..8]){ column = domainR(annotated, {n}); annotated -= column; annotated += reduceOptions(column);
row = {<x,y,v,g,p> | <x,y,v,g,p> <- annotated, y==n}; annotated -= row; annotated += reduceOptions(row);
grid1 = {<x,y,v,g,p> | <x,y,v,g,p> <- annotated, g==n}; annotated -= grid1; annotated += reduceOptions(grid1); }
solved = {<x,y,v,g,p> | <x,y,v,g,p> <- annotated, size(p)==1}; annotated -= solved; annotated += {<x,y,getOneFrom(p),g,{*[1 .. 9]}> | <x,y,v,g,p> <- solved}; }
result = {<x,y,v> | <x,y,v,g,p> <- annotated}; return result; }
//adds gridnumber and default set of options
public rel[int,int,int,int,set[int]] annotateGrid(rel[int x, int y, int v] sudoku){
result = {};
for (<x, y, v> <- sudoku){
g = 0;
if (x<3 && y<3) g = 0;
if (2<x && x<6 && y<3) g = 1;
if (x>5 && y<3) g = 2;
if (x<3 && 2<y && y<6) g = 3; if (2<x && x<6 && 2<y && y<6) g = 4; if (x>5 && 2<y && y<6) g = 5;
if (x<3 && y>5) g=6; if (2<x && x<6 && y>5) g=7; if (x>5 && y>5) g=8;
result += <x,y,v,g,{*[1 .. 9]}>; } return result; }
//reduces set of options public rel[int,int,int,int,set[int]] reduceOptions(rel[int x, int y, int v, int g, set[int] p] subSudoku){ solved = {<x,y,v,g,p> | <x,y,v,g,p> <- subSudoku, v!=0}; numbers = {*[1 .. 9]} - {v | <x,y,v,g,p> <- solved}; remaining = {<x,y,v,g,numbers&p> | <x,y,v,g,p> <- subSudoku-solved}; result = remaining + solved; return result; }
//a function to visualize the result public void displaySudoku(rel[int x, int y, int v] sudoku){ points = [box(text("<v>"), align(0.111111*(x+1),0.111111*(y+1)),shrink(0.1)) | <x,y,v> <- sudoku]; print(points); render(overlay([*points], aspectRatio(1.0))); }
//a sudoku public rel[int, int, int] sudokuA = { <0,0,3>, <1,0,9>, <2,0,4>, <3,0,0>, <4,0,0>, <5,0,2>, <6,0,6>, <7,0,7>, <8,0,0>, <0,1,0>, <1,1,0>, <2,1,0>, <3,1,3>, <4,1,0>, <5,1,0>, <6,1,4>, <7,1,0>, <8,1,0>, <0,2,5>, <1,2,0>, <2,2,0>, <3,2,6>, <4,2,9>, <5,2,0>, <6,2,0>, <7,2,2>, <8,2,0>, <0,3,0>, <1,3,4>, <2,3,5>, <3,3,0>, <4,3,0>, <5,3,0>, <6,3,9>, <7,3,0>, <8,3,0>, <0,4,6>, <1,4,0>, <2,4,0>, <3,4,0>, <4,4,0>, <5,4,0>, <6,4,0>, <7,4,0>, <8,4,7>, <0,5,0>, <1,5,0>, <2,5,7>, <3,5,0>, <4,5,0>, <5,5,0>, <6,5,5>, <7,5,8>, <8,5,0>, <0,6,0>, <1,6,1>, <2,6,0>, <3,6,0>, <4,6,6>, <5,6,7>, <6,6,0>, <7,6,0>, <8,6,8>, <0,7,0>, <1,7,0>, <2,7,9>, <3,7,0>, <4,7,0>, <5,7,8>, <6,7,0>, <7,7,0>, <8,7,0>, <0,8,0>, <1,8,2>, <2,8,6>, <3,8,4>, <4,8,0>, <5,8,0>, <6,8,7>, <7,8,3>, <8,8,5> };</lang>
Example
rascal>displaySudoku(sudoku(sudokuA)) See picture
REXX
version 1
The $SUDOKU REXX program is included here ──► $SUDOKU.REX.
output when using the input of:
row 1 .5..7.89 row 2 9...3 row 3 1...89.4 row 4 ..9.....1 row 5 ..13.52 row 6 6.....5 row 7 .6.89...3 row 8 ....5...7 row 9 .98.2..5 pruneALL
$SUDOKU is showing the puzzle ┌───────┬───────┬───────┐┌───────┬───────┬───────┐┌───────┬───────┬───────┐ │ │ │ ││ │ │ ││ │ │ │ │ │ 5 │ ││ │ 7 │ ││ 8 │ 9 │ │ │ │ │ ││ │ │ ││ │ │ │ ├───────┼───────┼───────┤├───────┼───────┼───────┤├───────┼───────┼───────┤ │ │ │ ││ │ │ ││ │ │ │ │ 9 │ │ ││ │ 3 │ ││ │ │ │ │ │ │ ││ │ │ ││ │ │ │ ├───────┼───────┼───────┤├───────┼───────┼───────┤├───────┼───────┼───────┤ │ │ │ ││ │ │ ││ │ │ │ │ 1 │ │ ││ │ 8 │ 9 ││ │ 4 │ │ │ │ │ ││ │ │ ││ │ │ │ └───────┴───────┴───────┘└───────┴───────┴───────┘└───────┴───────┴───────┘ ┌───────┬───────┬───────┐┌───────┬───────┬───────┐┌───────┬───────┬───────┐ │ │ │ ││ │ │ ││ │ │ │ │ │ │ 9 ││ │ │ ││ │ │ 1 │ │ │ │ ││ │ │ ││ │ │ │ ├───────┼───────┼───────┤├───────┼───────┼───────┤├───────┼───────┼───────┤ │ │ │ ││ │ │ ││ │ │ │ │ │ │ 1 ││ 3 │ │ 5 ││ 2 │ │ │ │ │ │ ││ │ │ ││ │ │ │ ├───────┼───────┼───────┤├───────┼───────┼───────┤├───────┼───────┼───────┤ │ │ │ ││ │ │ ││ │ │ │ │ 6 │ │ ││ │ │ ││ 5 │ │ │ │ │ │ ││ │ │ ││ │ │ │ └───────┴───────┴───────┘└───────┴───────┴───────┘└───────┴───────┴───────┘ ┌───────┬───────┬───────┐┌───────┬───────┬───────┐┌───────┬───────┬───────┐ │ │ │ ││ │ │ ││ │ │ │ │ │ 6 │ ││ 8 │ 9 │ ││ │ │ 3 │ │ │ │ ││ │ │ ││ │ │ │ ├───────┼───────┼───────┤├───────┼───────┼───────┤├───────┼───────┼───────┤ │ │ │ ││ │ │ ││ │ │ │ │ │ │ ││ │ 5 │ ││ │ │ 7 │ │ │ │ ││ │ │ ││ │ │ │ ├───────┼───────┼───────┤├───────┼───────┼───────┤├───────┼───────┼───────┤ │ │ │ ││ │ │ ││ │ │ │ │ │ 9 │ 8 ││ │ 2 │ ││ │ 5 │ │ │ │ │ ││ │ │ ││ │ │ │ └───────┴───────┴───────┘└───────┴───────┴───────┘└───────┴───────┴───────┘ $SUDOKU is starting prune pass # 1 $SUDOKU found the digit 8 by exclusiveness at cell 2,2 (2478) $SUDOKU found the digit 3 by exclusiveness at cell 3,7 (367) $SUDOKU found the digit 5 by exclusiveness at cell 4,1 (234578) $SUDOKU found the digit 8 by exclusiveness at cell 5,1 (478) $SUDOKU found the digit 9 by exclusiveness at cell 6,4 (12479) $SUDOKU found the digit 9 by exclusiveness at cell 5,9 (469) $SUDOKU found the digit 5 by exclusiveness at cell 7,3 (2457) $SUDOKU found the digit 1 by exclusiveness at cell 8,2 (1234) $SUDOKU found the digit 9 by exclusiveness at cell 8,7 (469) $SUDOKU found the digit 8 by exclusiveness at cell 8,8 (268) $SUDOKU found the digit 8 by exclusiveness at cell 6,9 (48) $SUDOKU found the digit 8 by exclusiveness at cell 4,6 (24678) $SUDOKU found the digit 4 by exclusiveness at cell 4,7 (467) $SUDOKU found the digit 2 by exclusiveness at cell 7,8 (12) $SUDOKU found the digit 4 by exclusiveness at cell 9,9 (46) $SUDOKU found the digit 6 by exclusiveness at cell 9,7 (16) $SUDOKU found the digit 1 by exclusiveness at cell 7,7 (1) $SUDOKU found the digit 1 by exclusiveness at cell 2,8 (167) $SUDOKU found the digit 7 by exclusiveness at cell 2,7 (7) ∙ ∙ ∙ some output elided ∙∙∙ ∙ ∙ ∙ ┌───────┬───────┬───────┐┌───────┬───────┬───────┐┌───────┬───────┬───────┐ │ │ │ ││ │ │ ││ │ │ │ │ 4 │ 5 │ 3 ││ 1 │ 7 │ 6 ││ 8 │ 9 │ 2 │ │ │ │ ││ │ │ ││ │ │ │ ├───────┼───────┼───────┤├───────┼───────┼───────┤├───────┼───────┼───────┤ │ │ │ ││ │ │ ││ │ │ │ │ 9 │ 8 │ 6 ││ 4 │ 3 │ 2 ││ 7 │ 1 │ 5 │ │ │ │ ││ │ │ ││ │ │ │ ├───────┼───────┼───────┤├───────┼───────┼───────┤├───────┼───────┼───────┤ │ │ │ ││ │ │ ││ │ │ │ │ 1 │ 2 │ 7 ││ 5 │ 8 │ 9 ││ 3 │ 4 │ 6 │ │ │ │ ││ │ │ ││ │ │ │ └───────┴───────┴───────┘└───────┴───────┴───────┘└───────┴───────┴───────┘ ┌───────┬───────┬───────┐┌───────┬───────┬───────┐┌───────┬───────┬───────┐ │ │ │ ││ │ │ ││ │ │ │ │ 5 │ 3 │ 9 ││ 2 │ 6 │ 8 ││ 4 │ 7 │ 1 │ │ │ │ ││ │ │ ││ │ │ │ ├───────┼───────┼───────┤├───────┼───────┼───────┤├───────┼───────┼───────┤ │ │ │ ││ │ │ ││ │ │ │ │ 8 │ 7 │ 1 ││ 3 │ 4 │ 5 ││ 2 │ 6 │ 9 │ │ │ │ ││ │ │ ││ │ │ │ ├───────┼───────┼───────┤├───────┼───────┼───────┤├───────┼───────┼───────┤ │ │ │ ││ │ │ ││ │ │ │ │ 6 │ 4 │ 2 ││ 9 │ 1 │ 7 ││ 5 │ 3 │ 8 │ │ │ │ ││ │ │ ││ │ │ │ └───────┴───────┴───────┘└───────┴───────┴───────┘└───────┴───────┴───────┘ ┌───────┬───────┬───────┐┌───────┬───────┬───────┐┌───────┬───────┬───────┐ │ │ │ ││ │ │ ││ │ │ │ │ 7 │ 6 │ 5 ││ 8 │ 9 │ 4 ││ 1 │ 2 │ 3 │ │ │ │ ││ │ │ ││ │ │ │ ├───────┼───────┼───────┤├───────┼───────┼───────┤├───────┼───────┼───────┤ │ │ │ ││ │ │ ││ │ │ │ │ 2 │ 1 │ 4 ││ 6 │ 5 │ 3 ││ 9 │ 8 │ 7 │ │ │ │ ││ │ │ ││ │ │ │ ├───────┼───────┼───────┤├───────┼───────┼───────┤├───────┼───────┼───────┤ │ │ │ ││ │ │ ││ │ │ │ │ 3 │ 9 │ 8 ││ 7 │ 2 │ 1 ││ 6 │ 5 │ 4 │ │ │ │ ││ │ │ ││ │ │ │ └───────┴───────┴───────┘└───────┴───────┴───────┘└───────┴───────┴───────┘ $SUDOKU is starting prune pass # 4 sudoku puzzle solved.
version 2
<lang rexx>
Parse Arg g.0fid Select When g.0fid='?' Then Do Say 'This program solves any (valid) SUDOKU puzzle' Say 'Specify the name of the file containing the puzzle as argument' Exit End When g.0fid= Then Call exit 'no input specified' When lines(g.0fid)=0 Then Call exit 'specified input does not exist' Otherwise Nop End instr= Do While lines(g.0fid)>0 instr=instr||linein(g.0fid) End Call lineout g.0fid digits='123456789' buffer=translate(instr,digits'000',digits'0.x'||xrange('00'x,'ff'x)) buffer=space(buffer,0) If length(buffer)<>81 Then Call exit 'invalid input from file' g.0fid Call set_geometry
posbit.=copies('0',9) z=posbit.0 d.z=0
Do i=1 To 9 posbit.i=overlay('1',posbit.i,i,1) z=posbit.i d.z=i End
Do r=1 To 9 Do c=1 To 9 Parse Var buffer d +1 buffer matrix.r.c=posbit.d End End
nn=0 Call show_matrix 'input from' g.0fid res=solve() If res Then Do Call dbg 'nn='format(nn,5) 'res='res Call show_matrix 'solution' End Else Say 'impossible' Exit
solve: Procedure Expose g. matrix. posbit. nn box. boxlr. boxlc.
nn=nn+1 Call dbg 'solve nn='format(nn,5) do i = 1 to 9 do j = 1 to 9 if matrix.i.j=posbit.0 Then Leave i End End If i>9 Then Do do i = 1 to 9 do j = 1 to 9 k = pos('1',matrix.i.j) Call dbg 'sudoku', Format(nn,9) Format(i,9) Format(j,9) Format(k,9) matrix.i.j=posbit.0 result_=neg(or(any_col(i),any_row(j),any_box(i,j))) If substr(result_,k,1)=0 Then Return 0 matrix.i.j=posbit.k End End Return 1 End Else Do result_=neg(or(any_col(i),any_row(j),any_box(i,j))) Call dbg 'resulta='result_ k=0; do Until k=0 Call dbg 'resultb='result_ k=pos('1',result_,k+1) Call dbg 'k='Format(k,2)Format(i,2)Format(j,2) if k>0 then Do; matrix.i.j=posbit.k Call dbg 'setting matrix('i','j')->'k res=solve() Call dbg 'A nn='format(nn,5) 'res='res if res then return 1 else Do; matrix.i.j=posbit.0 Call dbg 'setting matrix('i','j')->'0 End; end; end; return 0 end;
set_geometry:
box.= Do j=1 To 9 /* build the box bounds. */ rr=(((j*3)%10)+1)*3-2 /* compute row lower bound. */ cc=(((j-1)//3)+1)*3-2 /* compute col lower bound. */ boxr.j=rr boxc.j=cc Do r=rr To rr+2 /* build boxes with cell #s. */ Do c=cc To cc+2 box.r.c=j End End End /* j */ rowlb.=10 /* row R, low box number=b. */ collb.=10 /* col R, low box number=b. */ boxlr.=10 /* box B, low row number=r. */ boxlc.=10 /* box B, low col number=c. */
Do r=1 To 9 Do c=1 To 9 b=box.r.c /* what box is this R,C in ? */ rowlb.r=min(rowlb.r,b) /* find min box # for row R. */ collb.c=min(collb.c,b) /* find min box # for col C. */ boxlr.b=min(boxlr.b,r) /* find min row # for box B. */ boxlc.b=min(boxlc.b,c) /* find min col # for box B. */ End End
Return
any_col: Procedure Expose matrix.
Parse Arg r res='000000000' Do c=1 To 9 p=pos('1',matrix.r.c) If p>0 Then res=overlay('1',res,p,1) End Return res
any_row: Procedure Expose matrix.
Parse Arg c res='000000000' Do r=1 To 9 p=pos('1',matrix.r.c) If p>0 Then res=overlay('1',res,p,1) End Return res
any_box: Procedure Expose matrix. box. boxlr. boxlc.
Parse Arg r,c b=box.r.c res='000000000' Do r=boxlr.b For 3 Do c=boxlc.b For 3 p=pos('1',matrix.r.c) If p>0 Then res=overlay('1',res,p,1) End End Return res
or: Procedure
res='000000000' Do ia=1 To 3 a=arg(ia) Do p=1 To 9 If substr(a,p,1)=1 Then res=overlay('1',res,p,1) End End Return res
neg: Procedure
Parse Arg s res= Do p=1 To 9 If substr(s,p,1)=1 Then res=res'0' Else res=res'1' End Return res
o: Say arg(1)
Return
show_matrix:
Call o arg(1) Do r=1 To 9 ol= Do c=1 To 9 m=matrix.r.c ol=ol||d.m' ' If c//3=0 Then ol=ol' ' End Call o ol If r//3=0 Then Call o ' ' End Return
dbg:
If debug=1 Then Say arg(1) Return
exit: Say '*ERROR*' arg(1)</lang>
- Output:
input from d:\_sudoku\in\sdk001.in 4 6 0 0 0 1 0 0 0 0 0 2 0 9 6 0 0 0 0 3 0 0 0 0 0 6 8 0 0 0 0 0 0 0 3 7 0 0 0 6 0 7 0 0 0 5 1 0 0 0 0 0 0 0 8 4 0 0 0 0 0 5 0 0 0 0 7 1 0 9 0 0 0 0 0 3 0 0 0 2 4 solution 4 6 5 8 3 1 2 7 9 7 8 2 4 9 6 3 1 5 1 3 9 5 7 2 4 6 8 6 9 4 1 2 5 8 3 7 3 2 8 6 4 7 5 9 1 5 1 7 9 8 3 6 4 2 8 4 1 2 6 9 7 5 3 2 5 3 7 1 4 9 8 6 9 7 6 3 5 8 1 2 4
version 3
This is version 1 (thanks) cut to the essentials, restructured, and modified <lang rexx>/* REXX ---------------------------------------------------------------
- program to solve nearly every SUDOKU puzzle
- using a number of strategies learned from REXX version 1
- and one rather efficient algorithm created by me: prunewalt
- see solve: for details
- 03.10.2014 Walter Pachl tested with Regina and ooRexx
- --------------------------------------------------------------------*/
Signal on Halt Signal on Novalue Signal on Syntax Parse Arg fid debug Select When fid='?' Then Do Say 'This program solves many (nearly every?) SUDOKU puzzle' Say 'rexx sudoku file [DEBUG]' Say 'Input: file.in' Say 'Debug: file.dbg' Say 'Known: file.sol' Say 'Incomplete solution (if applicable): fileF.in' Say 'Output: on screen' Say 'Adapt subroutine get_input if necessary!' Say 'See version 2 for a brute force program', 'solving EVERY valid SUDOKU' Exit End When fid= Then Do Say 'Input file not specified' Say 'Enter "rexx sudoku ?" for help' Exit End Otherwise Nop End
g.=0 g.0debug=(translate(debug)='DEBUG')
Call get_input fid /* get input and set up file names */ /* Please adapt to your environment */ Numeric Digits 50 /* because of huge # of combinations */
Call set_geometry
Call show_aa 'the puzzle' /* show the grid to screen */ Call build_poss /* build possible values */ g.0todo_init=g.0todo Call show_poss 'puzzle possibles' /* show 1st possibles */
Call solve /* now try to solve it */
If g.0todo=0 Then Do /* no cell left empty */ Call o g.0fid 'puzzle solved.' /* tell it */ Call o left(g.0fid,12) 'puzzle solved.' Call show_aa 'solved' /* show the solution */ End Else Do /* some cells couldn't be filled */ Call show_poss 'failed' /* show the possibilities left */ Call o left(g.0fid,12) 'puzzle failed g.0todo='g.0todo Call show_aa 'failed','.' /* show the partly solved puzzle */ End
Call write_summary
Exit
build_poss: Procedure Expose g. s. aa. poss.,
box. boxr. boxc. boxlr. boxlc.
/*---------------------------------------------------------------------
- aa.r.c contains the known digits
- we determine which digits are possible for empty positions
- and put them into poss.r.c
- --------------------------------------------------------------------*/
all='123456789' Parse Value With dr. dc. db. /* initialize strings built here */ poss.= Do r=1 To 9 Do c=1 To 9 dr.r=dr.r||aa.r.c /* all digits in row r */ End End Do c=1 To 9 Do r=1 To 9 dc.c=dc.c||aa.r.c /* all digits in col c */ End End Do b=1 To 9 Do r=boxlr.b For 3 Do c=boxlc.b For 3 db.b=db.b||aa.r.c /* all digits in box b */ End End End
g.0tot=0 /* total # of possible digits */ g.0todo=0 /* number of cells to be filled */ g.0comb=1 /* # of possible combinations */
Do r=1 To 9 Do c=1 To 9 /* do this for every r.c */ b=box.r.c /* the box this cell is in */ If aa.r.c= Then Do /* cell not yet known */ used=compress(dr.r||dc.c||db.b) /* all digits already used */ poss.r.c=diff(all,used) /* all others are still possible */ g.0todo=g.0todo+1 /* number of cells yet to fill */ g.0tot=g.0tot+length(poss.r.c) g.0comb=g.0comb*length(poss.r.c) End End End If g.0sol<> Then /* if we know the solution */ Call check_all /* check if everything fits */ Return
solve: /*---------------------------------------------------------------------
- Use several algorithms to determine which cell(s) can safely be set
- prunewalt: if a digit occurs just once
- in a row's, col's or box's list of possible digits
- prunesing: if there is only one possible digit in a cell
- pruneexcl ) Algorithms of version 1 only partly understood (by me!)
- prunemats ) but faithfully restructured to avoid many Iterate
- pruneline ) instructions.
- --------------------------------------------------------------------*/
Call build_poss /* re-build the possibles */ Do g.0pass=1 By 1 Until g.0todo=0 Call o g.0fn 'is starting prune pass #' g.0pass found_pass=0
found=prunewalt() /* find any singles ? */ found_pass=found_pass+found If g.0todo=0 Then Leave If found>0 Then Call show_grid 'after prunewalt'
found=prunesing() /* find any singles ? */ found_pass=found_pass+found If g.0todo=0 Then Leave If found>0 Then Call show_grid 'after prunesing'
found=pruneexcl() /* find any excluives ? */ found_pass=found_pass+found If g.0todo=0 Then Leave If found>0 Then Call show_grid 'after pruneexcl'
found=prunemats(2) /* find any matches (len=2) */ found_pass=found_pass+found If g.0todo=0 Then Leave If found>0 Then Call show_grid 'after prunemats'
found=pruneline() /* find 2 or more on a line? */ found_pass=found_pass+found If g.0todo=0 Then Leave If found>0 Then Call show_grid 'after pruneline'
If found_pass>0 Then Do Call o found_pass 'hits in g.0pass' g.0pass If g.0debug Then Call write_summary End Else Do Call o 'Nothing found in g.0pass' g.0pass Leave End End /* prunes */ Return
prunewalt: Call o '>>>>>> prunewalt tot='g.0tot 'todo='g.0todo /*---------------------------------------------------------------------
- find digits that have only one occurrence in a row or column
- row_poss.r digits in row r
- col_poss.c digits in column c
- box_poss.b digits in box b
- --------------------------------------------------------------------*/
foundwalt=0 /* no matches found so far. */ Do Until changed=0 /* keep searching ... */ changed=0 /* changes made in this routine */ row_poss.= /* build str for each row */ col_poss.= /* build str for each column */ box_poss.= /* build str for each box */
Do r=1 To 9 Do c=1 To 9 b=box.r.c If poss.r.c\== Then Do row_poss.r=row_poss.r poss.r.c col_poss.c=col_poss.c poss.r.c box_poss.b=box_poss.b poss.r.c End End End rl= Do r=1 To 9 ol='row'r':' Do d=1 To 9 cnt=count(d,row_poss.r) ol=ol cnt If cnt=1 Then Do rl=rl r dr.r=d End End End cl= Do c=1 To 9 ol='col'c':' Do d=1 To 9 cnt=count(d,col_poss.c) ol=ol cnt If cnt=1 Then Do dc.c=d cl=cl c End End End
bl= Do b=1 To 9 ol='box'||b':' Do d=1 To 9 cnt=count(d,box_poss.b) ol=ol cnt If cnt=1 Then Do z=r'.'c db.z=d bl=bl z End End End
Do While rl<> Parse Var rl r rl Do c=1 To 9 If pos(dr.r,poss.r.c)>0 Then Do Call set_aa r,c,dr.r,'prunewalt new R' changed=changed+1 foundwalt=foundwalt+1 Call build_poss /* re-build the possibles */ End End End Do While cl<> Parse Var cl c cl Do r=1 To 9 If pos(dc.c,poss.r.c)>0 Then Do Call set_aa r,c,dc.c,'prunewalt new C' changed=changed+1 foundwalt=foundwalt+1 Call build_poss /* re-build the possibles */ End End End Do While bl<> Parse Var bl z cb bl Parse Var z rb '.' cb Do r=boxlr.b For 3 Do c=boxlc.b For 3 If r=rb &, c=cb &, pos(db.z,poss.r.c)>0 Then Do Say 'z='r 'c='c 'poss.'r'.'c'='poss.r.c 'db.b='db.b Call set_aa r,c,db.b,'prunewalt new B' changed=changed+1 foundwalt=foundwalt+1 Call build_poss /* re-build the possibles */ End End End End End Call show_poss 'after prunewalt'
If foundwalt>0 Then Call o '>>>>>> prunewalt foundwalt='foundwalt Else Call o '>>>>>> prunewalt found nothing' g.0foundwalt=g.0foundwalt+foundwalt Return foundwalt
prunesing: Call o '>>>>>> prunesing tot='g.0tot 'todo='g.0todo /*---------------------------------------------------------------------
- look if there are cells with a single possible digit and put these
- into the grid. Return the number of changes made.
- --------------------------------------------------------------------*/
foundsing=0 Do r=1 To 9 Do c=1 To 9 If length(poss.r.c)=1 Then Do /* only possible digit */ Call set_aa r,c,poss.r.c,'prunesing' /* put it into the cell */ foundsing=foundsing+1 /* indicate success */ End End End If foundsing>0 Then Do Call build_poss /* re-build the possibles */ Call o '>>>>>> prunesing foundsing='foundsing End Else Call o '>>>>>> prunesing found nothing' g.0foundsing=g.0foundsing+foundsing Return foundsing
pruneexcl: Call o '>>>>>> pruneexcl tot='g.0tot 'todo='g.0todo /*---------------------------------------------------------------------
- --------------------------------------------------------------------*/
foundexcl=0 Do exclusives=1 /* keep building possibles. */ Do r=1 For 9 Do c=1 For 9 z=poss.r.c lz=length(z) /* get length of possible. */ If lz>0 Then Do y= b=box.r.c Do br=boxr.b For 3 Do bc=boxc.b For 3 /* for every cell in box b */ If br'.'bc<>r'.'c Then y=y||aa.br.bc||poss.br.bc End End Do t=1 For lz q=substr(z,t,1) If pos(q,y)==0 Then Do foundexcl=foundexcl+1 If aa.r.c=q Then Call o 'pruneexcl ??? aa.'r'.'c'='q 'already set' Call o 'foundexcl='foundexcl Call set_aa r,c,q,'pruneexcl' /* a singularity, a sol */ Call o 'pruneexcl found the digit' q, 'by exclusiveness at cell' drc(r,c,z) Call build_poss /* re-build the possibles */ Iterate exclusives End End End End End Leave End If foundexcl>0 Then Do Call o '>>>>>> pruneexcl foundexcl='foundexcl End Else Call o '>>>>>> prunesing found nothing' g.0foundexcl=g.0foundexcl+foundexcl Return foundexcl
prunemats: Call o '>>>>>> prunemats tot='g.0tot 'todo='g.0todo /*---------------------------------------------------------------------
- This example illustrates the working of this strategy:
- Column 1 2 3 4 5 6 7 8 9
- Row 7: . . 1369 29 26 29 137 . 136
- remove 29 from drc 7.3=1369 giving drc 7.3=136 (matches 7.4 7.6)
- Row 7: . . 136 29 26 29 137 . 136
- remove 29 from drc 7.5=26 giving drc 7.5=6 (matches 7.4 7.6) HIT
- Row 7: . . 136 29 6 29 137 . 136
- Row 7: . . 139 29 . 29 137 . 13
- remove 29 from drc 7.3=139 giving drc 7.3=13 (matches 7.4 7.6)
- Row 7: . . 13 29 . 29 137 . 13
- remove 13 from drc 7.7=137 giving drc 7.7=7 (matches 7.9 7.3) HIT
- Row 7: . . 13 29 . 29 7 . 13
- Row 7: . . 139 29 . 29 . . 13
- --------------------------------------------------------------------*/
setmats=0 foundmats=0 /* no matches found so far. */ Parse Arg l /* length of match, L=2,pair */ Do matches=1 Do r=1 For 9 Do c=1 For 9 _=length(poss.r.c) /* get length of possible. */ If _=l Then Do qq=poss.r.c m=0 /* count of matches so far. */ mla=r'.'c Do _c=1 For 9 /* a match in same row? */ If _c<>c &, qq==poss.r._c Then Do m=m+1 /* up count if it's a match. */ mla=mla r'.'_c End End If m>0 Then Do Call o 'AAAA mla='mla Call show_poss_r r Do pc=1 For 9 /* remove other possibles. */ old=poss.r.pc /* save the "old" value. */ If old<>qq & old<> Then Do new=diff(old,qq) /* remove mat's digs from X. */ Call o 'AAAA' r'.'pc':'old '-' qq '-->' new If new<>old Then Do If length(new)=1 Then tag='HIT'; Else tag= Call o 'remove' qq 'from' drc(r,pc,old), 'giving' drc(r,pc,new) '(matches' mla')' tag poss.r.pc=new /* store new value into old. */ Call show_poss 'AAAA1' Call show_poss_r r setmats=setmats+1 /* indicate match was found. */ If length(new)==1 Then Do /*reduce if L=1*/ Call set_aa r,pc,new,'prunemats R' /*store single*/ foundmats=foundmats+1 /* indicate match was found*/ Call build_poss /* re-build the possibles */ Call show_poss 'AAAA2' Call show_poss_r r Iterate matches /* start over. */ End End End End End m=0 mlb=r'.'c Do _r=1 For 9 If _r<>r &, qq==poss._r.c Then Do m=m+1 mlb=_r'.'c End End
If m>0 Then Do Call o 'BBBB mlb='mlb Call show_poss_r r Do pr=1 For 9 old=poss.pr.c If old<>qq & old<> Then Do new=diff(old,qq) Call o 'BBBB' pr'.'c':'old '-' qq '-->' new If new<>old Then Do If length(new)=1 Then tag='HIT'; Else tag= Call o 'remove' qq 'from' drc(pr,c,old), 'giving' drc(pr,c,new) '(matches' mlb')' tag poss.pr.c=new Call show_poss_r r Call show_poss 'BBBB1' setmats=setmats+1 If length(new)==1 Then Do foundmats=foundmats+1 Call set_aa pr,c,new,'prunemats C' Call build_poss /* re-build the possibles */ Call show_poss 'BBBB2' Call show_poss_r r Iterate matches End End End End End End End End Leave End
If foundmats>0 Then Do Call o '>>>>>> prunemats foundmats='foundmats End Else Call o '>>>>>> prunesing found nothing' g.0foundmats=g.0foundmats+foundmats Return setmats
pruneline: Call o '>>>>>> pruneline tot='g.0tot 'todo='g.0todo /*---------------------------------------------------------------------
- --------------------------------------------------------------------*/
Call show_poss ' vor pruneline' pruned=0 foundline=0 /* no matches found so far. */ Do Until changes=0 /* terminate if no changes made */ changes=0 /* initialize number of changes */ poss_boxr.= /* build str for each boxrow */ poss_boxc.= /* build str for each boxcol */ Do r=1 To 9 Do c=1 To 9 b=box.r.c If poss.r.c\== Then Do poss_boxr.r.b=strip(poss_boxr.r.b poss.r.c) poss_boxc.c.b=strip(poss_boxc.c.b poss.r.c) End End End Do r=1 To 9 /* search all rows for twins */ Do cb=1 To 7 By 3 /* 3 boxes containing row r */ b=box.r.cb aline=poss_boxr.r.b /* all poss strings: row r box b */ If words(aline)>=2 Then Do /* more than one */ Call o 'aline' r'.'||b'='aline '(cb='cb')' Do k=1 To 9 /* search for each digit. */ If count(k,aline)>=2 Then Do /* more than one occurrence */ Do jr=rowlb.r For 3 /* look at the other 2 rows. */ If jr<>r &, pos(k,poss_boxr.jr.b)>0 Then /* digit k found */ Iterate k /* continue with the next digit */ End Do jb=rowlb.r For 3 /* search boxes of row R for K. */ If jb<>b &, pos(k,poss_boxr.r.jb)>0 Then Do Do kc=1 To 9 /* find which cell K is in. */ If box.r.kc<>b Then Do If poss.r.kc<> &, pos(k,poss.r.kc)>0 Then Do old=drc(r,kc,poss.r.kc) row_a=poss_r(r) poss.r.kc=diff(poss.r.kc,k) /* remove digit k*/ Call o g.0fn 'row' r': removing' k 'from' old, 'resulting in' drc(r,kc,poss.r.kc) row_b=poss_r(r) Call o ' ' row_a Call o '>>' row_b pruned=pruned+1 If length(poss.r.kc)==1 Then Do Call set_aa r,kc,poss.r.kc,'pruneline R' foundline=foundline+1 Call build_poss /* re-build the possibles */ changes=changes+1 End End End End End End End End End End End
Do c=1 To 9 /* search all cols for twins */ Do b=collb.c By 3 For 3 /* for each col, search box. */ aline=poss_boxc.c.b If words(aline)>=2 Then Do Do k=1 To 9 /* search for each digit. */ If count(k,aline)>=2 Then Do Do jc=boxlc.b For 3 /* look at the other 2 cols. */ If jc<>c&pos(k,poss_boxc.jc.b)<>0 Then Iterate k /* if no digit K, ignore */ End /* jc */ /*found 2 Ks in col C box B */ Do jb=collb.c By 3 For 3 /*search boxes col C for K. */ If jb<>b&pos(k,poss_boxc.c.jb)<>0 Then Do Do kr=1 To 9 /* find which cell K is in. */ If box.kr.c<>b Then Do If poss.kr.c>&, pos(k,poss.kr.c)>0 Then Do old=drc(kr,c,poss.kr.c) col_a=poss_c(c) poss.kr.c=diff(poss.kr.c,k) /* remove digit k*/ Call o g.0fn 'col' c': removing' k 'from' old, 'resulting in' drc(kr,c,poss.kr.c) col_b=poss_c(c) Call o ' ' col_a Call o '>>' col_b pruned=pruned+1 If length(poss.kr.c)==1 Then Do Call set_aa kr,c,poss.kr.c,'pruneline C' foundline=foundline+1 Call build_poss /* re-build the possibles */ changes=changes+1 End End End End End End End End End End End End Call show_poss 'nach pruneline' If foundline>0 Then Call o '>>>>>> pruneline new foundline='foundline 'pruned='pruned Else Call o '>>>>>> pruneline new found nothing' 'pruned='pruned g.0foundline=g.0foundline+foundline Return foundline
show_grid: /*---------------------------------------------------------------------
- show what's known so far
- and what's still to be done
- --------------------------------------------------------------------*/
Parse Arg title Call show_aa title Call show_poss title Return
show_aa: Procedure Expose g. aa. s. /*---------------------------------------------------------------------
- Show all cells that are known already
- and determine the number of cells yet to be filled (g.0todo)
- --------------------------------------------------------------------*/
Parse Arg txt blank='.' Select When txt='the puzzle' |, /* initial call */ txt='solved' Then /* final call (success) */ g.0say=1 /* show on screen */ When txt='failed' Then Do /* final call (failure) */ g.0say=1 /* show on screen */ g.0fail=1 /* write to incomplete solution */ End Otherwise g.0say=0 /* don't show on screen */ End Call o txt /* write to dbg/screen/inco */ g.0todo=0 Do r=1 To 9 /* for all rows */ ol= Do c=1 To 9 /* build a line */ If aa.r.c= Then Do g.0todo=g.0todo+1 ol=ol blank End Else ol=ol aa.r.c If c//3=0 Then /* a blank column */ ol=ol' ' End Call o ol If r//3=0 Then /* a blank line */ Call o ' ' End g.0say=0 /* reset the flags */ g.0fail=0 If g.0todo>0 Then Call o right('to be done:',40) g.0todo Else Call o 'all done' Return
show_poss: Procedure Expose poss. g. s. /*---------------------------------------------------------------------
- show all possible digits of the grid
- --------------------------------------------------------------------*/
Parse Arg txt If g.0todo=0 Then Return Call o copies('-',70) 'todo='g.0todo Call o txt Do r=1 To 9 ol=r Do c=1 To 9 ol=ol left(poss.r.c,7) If c//3=0 Then ol=ol '|' End Call o ol If r//3=0 Then Call o ' ' End Call o ' tot='g.0tot 'todo='g.0todo Call o 'combinations:' g.0comb Return
show_poss_r: Procedure Expose g. poss. /*---------------------------------------------------------------------
- show possible digits in row r
'--------------------------------------------------------------------*/
Parse Arg r Call o poss_r(r) Return
poss_r: Procedure Expose g. poss. /*---------------------------------------------------------------------
- compute possible digits in row r
'--------------------------------------------------------------------*/
Parse Arg r ol='Row' r':' Do c=1 To 9 prc=poss.r.c If prc= Then prc='.' ol=ol left(prc,6) End Return ol
show_poss_c: Procedure Expose g. poss. /*---------------------------------------------------------------------
- show possible digits in column c
'--------------------------------------------------------------------*/
Parse Arg c Call o poss_c(c) Return
poss_c: Procedure Expose g. poss. /*---------------------------------------------------------------------
- compute possible digits in column c
'--------------------------------------------------------------------*/
Parse Arg c ol='Col' c':' Do r=1 To 9 prc=poss.r.c If prc= Then prc='.' ol=ol left(prc,6) End Return ol
compress: Procedure /*---------------------------------------------------------------------
- build a string containing the digits found in s
- Example: compress('11 9 33 55') -> '1359'
- --------------------------------------------------------------------*/
Parse Arg s res= Do d=1 To 9 If pos(d,s)>0 Then res=res||d End Return left(res,9)
diff: /*---------------------------------------------------------------------
- build the 'difference' of two strings (same as squish in version 1)
- Return a string of digits contained in arg(1) not existant in arg(2)
- Example: diff('13895','35') -> '189'
- --------------------------------------------------------------------*/
Return space(translate(arg(1),,word(arg(2) ',',1)),0)
check_all: /*---------------------------------------------------------------------
- check the current status against the target (if this is known)
- --------------------------------------------------------------------*/
error=0 Do r=1 To 9 Do c=1 To 9 If aa.r.c=|aa.r.c=s.r.c Then Nop Else Do Call o 'r='r 'c='c 'soll='s.r.c 'ist='aa.r.c error=1 End End End Do r=1 To 9 Do c=1 To 9 Select When poss.r.c= Then Nop When pos(s.r.c,poss.r.c)>0 Then Nop Otherwise Do Call o 'r='r 'c='c aa.r.c 'not in poss:'poss.r.c error=1 End End End End If error Then Call exit 'an error in check_all' Return
o: /*---------------------------------------------------------------------
- write to the debug file (when g.0debug is true)
- and, if applicable, to the screen (when g.0say is true)
- and to the incomplete solution (when g.0fail is true)
- --------------------------------------------------------------------*/
If g.0say Then Say arg(1) If g.0fail Then Call lineout g.0inco,arg(1) If g.0debug Then Call lineout g.0dbg,arg(1) Return
set_aa: Procedure Expose g. aa. poss. box. boxr. boxc. boxlr. boxlc.,
s. sigl
/*---------------------------------------------------------------------
- put a digit into the cell r.c and show the text given
- --------------------------------------------------------------------*/
Parse Arg r,c,d,text from=sigl If s.r.c<>'*' &, d<>s.r.c Then Do call o 'Trying t set aa.'r'.'c 'to' d 'but should be' s.r.c Call o 'from='from Exit End
Call o 'setting aa.'r'.'c' to d='d '('text')' If g.0done.r.c=1 Then Do Call o 'cell' r'.'c'='aa.r.c '>' d '?????' 'called_from='sigl, 'in pass' g.0pass End aa.r.c=d /* put the digit into the cell */ poss.r.c= /* remove cell's possible digits */ g.0done.r.c=1 /* note that cell was set */ Return
count: Procedure /*---------------------------------------------------------------------
- Return the number of occurrences of d in s (all digits)
- Example: count(3,'123 567 399 13') -> 3
- --------------------------------------------------------------------*/
Parse Arg d,s s=translate(s,'*',d) s=translate(s,,'123456789') s=space(s,0) Return length(s)
drc: Procedure /*---------------------------------------------------------------------
- return coordinates and contents of a cell as r.c=string
- --------------------------------------------------------------------*/
Parse Arg r,c,s Return 'drc' r'.'c'='s
set_geometry: /*---------------------------------------------------------------------
- set miscellaneous relations and limits
- --------------------------------------------------------------------*/
box.= Do b=1 For 9 /* build the box bounds. */ rr=(((b*3)%10)+1)*3-2 /* compute row lower bound. */ cc=(((b-1)//3)+1)*3-2 /* compute col lower bound. */ boxr.b=rr boxc.b=cc Do r=rr To rr+2 /* build boxes with cell #s. */ Do c=cc To cc+2 rc=r||c box.b=box.b rc box.r.c=b End End box.b=strip(box.b) End
rowlb.=9 /* row R, low box number=b. */ collb.=9 /* col R, low box number=b. */ boxlr.=9 /* box B, low row number=r. */ boxlc.=9 /* box B, low col number=c. */ Do r=1 To 9 Do c=1 To 9 b=box.r.c /* what box is this R,C in ? */ rowlb.r=min(rowlb.r,b) /* find min box # for row R. */ collb.c=min(collb.c,b) /* find min box # for col C. */ boxlr.b=min(boxlr.b,r) /* find min row # for box B. */ boxlc.b=min(boxlc.b,c) /* find min col # for box B. */ End /* c */ End /* r */ Return
get_input: Procedure Expose g. aa. s. /*---------------------------------------------------------------------
- get the given puzzle
- 9 rows with 9 columns each containing a digit or a place holder (.x0)
- set the miscellaneous file-ids
- and get the known solution (if available) for checking in get_sol
- --------------------------------------------------------------------*/
Parse Arg g.0fid Parse Var g.0fid g.0fn '.' If g.0debug Then Do g.0dbg=g.0fn'.dbg' /* file to contain debug output */ /********************************* Call lineout g.0dbg If lines(g.0dbg)>0 Then /* if the file exists */ 'erase' g.0dbg /* erase it */ *********************************/ End If pos('.',g.0fid)=0 Then g.0fid=g.0fid'.in' digits='123456789' g.0fidx=g.0fid Say 'process file' g.0fidx If lines(g.0fidx)=0 Then Call exit 'Input file does not exist' instr= Do While lines(g.0fidx)>0 instr=instr linein(g.0fidx) End Call lineout g.0fidx instr=translate(instr,digits'000',digits'.x0'||xrange('00'x,'ff'x)) instr=space(instr,0) Select When length(instr)<81 Then Do Say 'instr='instr'<' Call exit 'Incorrect input - not enough data' End When length(instr)>81 Then Do Say 'instr='instr'<' Call exit 'Incorrect input - too much data' End Otherwise Do Call o ' instr='instr'<' instr=translate(instr,' ','0') End End Do r=1 To 9 Do c=1 To 9 Parse Var instr aa.r.c +1 instr End End g.0inco=g.0fn'f.in' /* file to contain failed res */ if lines(g.0inco)>0 Then /* if the file exists */ 'erase' g.0inco /* erase it */ g.0summ='sudoku.summary' /* file to get statistics */ g.0sol= 'sol\'g.0fn'.sol' /* known solution for checking */ If lines(g.0sol)>0 Then /* if that file is found */ Call get_sol /* get its data */ Else Do /* otherwise */ g.0sol= /* don't check */ s.='*' End Say 'Input from ' g.0fidx Say 'Debug output to ' g.0dbg If lines(g.0sol)>0 Then /* if that file is found */ Say 'Given solution from' g.0sol Say 'Statistics to ' g.0summ Say 'Incomplete solution' g.0inco '(if applicable)' Say 'Hit enter to proceed' Return
get_sol: Procedure Expose g. s. /*---------------------------------------------------------------------
- get the known solution
- (9 rows with 9 columns each containing a digit)
- --------------------------------------------------------------------*/
solvstr= If lines(g.0sol)>0 Then Do Do While lines(g.0sol)>0 solvstr=solvstr linein(g.0sol) End Call lineout g.0sol solvstr=space(solvstr,0) Call o 'solution='solvstr Do r=1 To 9 Do c=1 To 9 Parse Var solvstr s.r.c +1 solvstr End End Do r=1 To 9 ol=s.r.1 Do c=2 To 9 ol=ol s.r.c If c//3=0 Then ol=ol' ' End Call o ol If r//3=0 Then Call o ' ' End End Return
exit: Say 'EXIT' arg(1)
Exit
write_summary: Procedure Expose g. /*---------------------------------------------------------------------
- add a line to the statistics
- file init walt sing excl mats line todo pass
- sdk002.in 56 56 0 0 0 0 0 1
- sdk007.in 61 16 0 0 1 5 39 1 <---
- sdk007.in 61 55 0 0 1 5 0 2 solved
- sdk088.in 50 14 2 34 0 0 0 1
- sdk093.in 55 2 2 1 0 0 50 2 <---
- sdk093.in 55 2 2 1 0 0 50 2 <--- no success
- --------------------------------------------------------------------*/
If lines(g.0summ)=0 Then /* write header line */ Call lineout g.0summ,, 'file init walt sing excl mats line todo pass' If g.0todo>0 Then tag='<---' /* mark a failure */ Else tag= /* show # of hits for each strategy */ summline=left(g.0fid,10) right(g.0todo_init,4), right(g.0foundwalt,4), right(g.0foundsing,4), right(g.0foundexcl,4), right(g.0foundline,4), right(g.0foundmats,4), right(g.0todo,4), right(g.0pass,4) tag /* Say summline */ Call lineout g.0summ,summline Call lineout g.0summ /* close the file */ Return
novalue:
Say 'Novalue raised in line' sigl Say sourceline(sigl) Say 'Variable' condition('D') Signal lookaround
syntax:
Say 'Syntax raised in line' sigl Say sourceline(sigl) Say 'rc='rc '('errortext(rc)')'
halt: lookaround:
If fore() Then Do Say 'You can look around now.' Trace ?R Nop End Exit 12</lang>
- Output:
process file sdk087.inInput from sdk087.in Debug output to 0 Given solution from Statistics to sudoku.summary Incomplete solution sdk087f.in (if applicable) Hit enter to proceed the puzzle
. . . . . . 3 . . . . . . 7 1 5 . . . . 2 4 . 6 . 1 8
. . . . . 9 . 4 6 . 9 . 6 1 8 . 3 . 6 1 . 7 . . . . 9
4 3 . 8 . 7 6 . . . . 8 1 4 . . . . . . 9 . . . . . .solved
7 4 1 9 8 5 3 6 2 3 8 6 2 7 1 5 9 4 9 5 2 4 3 6 7 1 8
8 2 7 3 5 9 1 4 6 5 9 4 6 1 8 2 3 7 6 1 3 7 2 4 8 5 9
4 3 5 8 9 7 6 2 1 2 6 8 1 4 3 9 7 51 7 9 5 6 2 4 8 3
RPN (HP-15c)
This is a back-tracking solver written in RPN for the HP-15C calculator. It is highly optimized for size, rather than speed, as the target platform only has 448 bytes of memory for code and data combined.
Latest version and usage notes kept at: [Sudoku Solver for the HP 15-C]
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Register And Flag Usage ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; 0 General purpose variable used for miscelaneous purposes ; 1 Current index (0-80) in the pseudo-recursion ; 2 Row (0-8) of current index ; 3 Column (0-8) of current index ; 4 Block # (0-8) of current index ; 5 Power of 10 of current column index ; 6 Value in the test solution at current index ; 7 Value of start clue at current index (0 if not set) ; 8 – 16 Starting row data ; 17 – 25 Current test solution ; 26 – 34 Flag matrix (bit set if digit used in a row/column/block) ; ; Flag 2 Indicates that a digit has been used in cur row/column/block ; Flag 3 Input to Subroutine B (whether to set or clear flags) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; setU(x) ; Set/clear flag matrix values (show that x is used in a row/column/block) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; LBL D GSB 5 ; calc bit value we need to set/clear in existing row RCL 2 ; Get the current row index into x GSB B ; set flag matrix value and calc new bit value for the column RCL 3 ; Get the current column index into x GSB B ; set flag matrix values and calc new bit value for the block RCL 4 ; Get the current block index into x ; MUST IMMEDIATELY FOLLOW PRECEEDING SUBROUTINE ; utility subroutine for setting flag matrix values LBL B GSB 1 ; get the current flag matrix row at index x RCL 0 ; get temp register (holds the bit value we will be setting) F? 3 ; flag 3 indicates if we are setting or clearing the flag CHS ; if we are clearing, we will do a subtraction instead + ; set/clear the flag X<>Y ; bring the row index back into x 2 ; 26 is the starting register for the flag matrix 6 GSB 3 ; set I so that we are ready to store the new value STO (i) ; store the new value into the flag matrix RDN ; get rid of the new value to restore the stack 9 ; the next bit value will be 9 bits to the left + ; set the next bit index GTO 5 ; calculate the value with that bit set ; we GTO instead of GSB and it will do the RTN ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; putA(x) ; Set the value x into the current row/column in the trial solution. ; Does it by subtracting the previous value and adding the new one. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; LBL 7 X<>6 ; swap new value with register that holds current value STO 0 ; store the old value in the temp register RCL 2 ; Get the current row index into x 1 ; 17 is the starting register for the current trial solution 7 GSB 3 ; Set the indirect register RCL (i) ; Get the current value for the entire row RCL 6 ; Get the new value RCL- 0 ; subtract the old value from the new value RCL* 5 ; shift the power of 10 to the appropriate column + ; add to the old value STO (i) ; store the new row value from where we got it RTN ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; change(x) ; Increments or decrements the current position in the trial solution. ; Updates the registers containing the current row, column and block index, ; and the one with the power of 10 factor for the current column and others ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; LBL 6 STO+ 1 ; x holds +1 or -1; Register 1 is the current index RCL 1 ; get the current index (0 to 80) RCL 1 ; get the current index (0 to 80) 9 ; integer divide by 9 to get the row index (0 to 8) / ; no integer divide on 15c so do a floating point divide INT ; use the INT operator to finish of the integer divide STO 2 ; register 2 contains the current row index 9 * - ; col = index - 9 * row STO 3 ; register 3 contains the current column index 3 ; calculate the block index from the row & column indexes / ; TODO: save a couple of bytes in this section of code RCL 2 3 / INT 3 * + STO 4 ; register 4 holds the block index 8 ; now calculate the power of 10 of the current column RCL- 3 ; Get the digit (from right) based on the column 10^X ; calculate the exponent STO 5 ; save in register 5 which is used throughout the code RCL 2 ; get the current row 1 ; 17 is the start register of the current trial solution 7 GSB 4 ; extract the value at the current column STO 6 ; reg 6: the current trial value at the current row/column RCL 2 ; get the current row 8 ; 8 is the start register of the input data from the user GSB 4 ; extract the value at the current column STO 7 ; reg 7: starting value at the current row/column (0 if none) RTN ; Extract value at the current column from the matrix indirectly specified by x&y LBL 4 GSB 3 ; set the indirect register based on x & y RCL (i) ; get the row from the matrix passed in RCL / 5 ; shift the row to the right INT ; trim off the digits shifted to the right of the decimal 1 ; we will do a modulus 10 to extract the last digit 0 / ; do the equivalent of a mod 10 FRAC 1 0 * RTN ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; main() ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; LBL A CF 2 ; make sure flag 2 is unset - CLR REG does not do this CF 3 ; make sure flag 3 is unset - CLR REG does not do this 1 ; start with a index in register 1 of -1 (0 to 80) CHS ; that way we can start with an increment operation STO 1 ; and actually start at 0 where we want. LBL 2 ; set the flags to show the input values are set 1 ; go forward one position at a time GSB 6 ; go to the next position in the trial solution RCL 7 ; get the starting input value at this row/col GSB 7 ; set the value in the trial solution RCL 7 ; get starting input value because the last call destroyed it TEST 1 ; if > 0 then the user input a value for this row/col GSB D ; set the flags to indicate this value is set 8 ; 80 is the upper bound of the indexes (9x9 = 80 = 0:80) 0 RCL 1 ; get the current index TEST 6 ; if the current index hasn't reached 80 GTO 2 ; do the next value 1 ; reset the starting value CHS ; to -1 as we did at the beginning of the program STO 1 ; register 1 holds the current index LBL E ; main solution loop 8 ; when we reach the last index (80) we are done 0 RCL 1 ; register 1 holds the current index TEST 5 ; see if we are at the end RTN ; finished ; woohoo - we are done! 1 ; Go forward one spot GSB 6 ; Do the position increment RCL 7 ; get the starting input value at this row/col TEST 1 ; if it's > 0, the user specified a value here GTO E ; go forward, since this value was specified by the user GSB 7 ; Set the value in the trial solution LBL 8 9 ; check the possible digits in order 1-9. RCL 6 ; Get the current trial solution value TEST 5 ; Check to see if it is 9 GTO C ; If it is, backup one step 1 ; We weren't at 9 yet, so increment the value by 1 + GSB 7 ; Set the value in the trial solution RCL 6 ; Get the current trial solution value GSB 5 ; Calc 2^x-1 to get the bit mask CF 2 ; Clear the flag thats used as a return value RCL 2 ; Get the current row index into x GSB 9 ; see if the current value has already been used in the row F? 2 ; If number has been used in the block, try the next value GTO 8 RCL 3 ; Get the current column index into x GSB 9 ; see if current value has already been used in the column F? 2 ; If number has been used in the block, try the next value GTO 8 RCL 4 ; Get the current block index into x GSB 9 ; see if the current value has already been used in the block F? 2 ; If number has been used in the block, try the next value GTO 8 RCL 6 ; Get the current trial solution value GSB D ; set the flags to indicate this value is set GTO E ; move on to the next position in the puzzle LBL C ; Come here to back up to the previous position 1 ; We will go one spot backwards CHS GSB 6 ; Set the new current position and all temp values TEST 1 ; previous call leaves the starting value in X GTO C ; if value is > 0, it was set, backup one more spot RCL 6 ; Get the current trial solution value SF 3 ; flag 3: clear the flag matrix bits, instead of setting them GSB D ; Set/Clear the flag matrix bits CF 3 ; unset the 3 flag GTO 8 ; check the next digit LBL 9 GSB 1 ; get the appropriate row (x) from the flag matrix RCL / 0 ; divide by the temp register - right shifts value INT 2 ; if bit is set, fractional part will be non 0 when / 2 / FRAC TEST 1 ; if bit is set, set flag 2 which is used as a return value SF 2 RDN ; move the stack down to prepare the caller for the next call RDN ; move the stack down to prepare the caller for the next call 9 ; bit flags for row/col/block are << by 9 from each other + ; calculates the appropriate bit offset for the next call GTO 5 ; calc 2^x-1 to get the bit mask ; do a GTO instead of GSB and it will return for us ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; setPow2(x) ; Sets the utility temp register to 2^(x-1). Leaves x in place. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; LBL 5 STO 0 ; store the input X in the temp register 1 ; we want to subtract 1 from the exponent - ; calculate x-1 2 ; set the base as 2 X<>Y ; the y^x function wants x and y reversed y^x ; calculate the value X<>0 ; stuff result in temp register and restore the input x RTN ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; getPart(x) ; Returns the integer representing the entire Xth row of the flag matrix ; Row numbers start at 0. ; returns value in x - input parameter x ends up in y ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; LBL 1 ENTER ENTER ; duplicate the parameter so we can leave it for the caller 2 ; 26 is the starting register for the flag matrix 6 GSB 3 ; set the indirect register to the row specified by x RCL (i) ; retrieve the entire row from the flag matrix RTN ; Set the indirect register and remove the parameters from the stack LBL 3 + ; x+y is the memory offset we want STO I ; put it in the indirect register RDN ; get rid of the sum from the stack RTN
Ruby
Example of a back-tracking solver, from wp:Algorithmics of sudoku
<lang ruby>def read_matrix(fh)
matrix = [] (0..8).each { |i| l = fh.readline matrix[i] = [] (0..8).each { |j| matrix[i][j] = l[j..j].to_i } } matrix
end
def permissible(matrix, i, j)
ok = [true] * 9 # Same as another in the column isn't permissible... (0..8).each { |i2| next if matrix[i2][j] == 0 ok[matrix[i2][j] - 1] = false } # Same as another in the row isn't permissible... (0..8).each { |j2| next if matrix[i][j2] == 0 ok[matrix[i][j2] - 1] = false } # Same as another in the 3x3 block isn't permissible... igroup = (i / 3) * 3 jgroup = (j / 3) * 3 (igroup..(igroup + 2)).each { |i2| (jgroup..(jgroup + 2)).each { |j2| next if matrix[i2][j2] == 0 ok[matrix[i2][j2] - 1] = false } } # Convert to the array format... (1..9).select { |i2| ok[i2-1] }
end
def deep_copy_sudoku(matrix)
matrix.collect { |row| row.dup }
end
def solve_sudoku(matrix)
loop do options = [] (0..8).each { |i| (0..8).each { |j| next if matrix[i][j] != 0 p = permissible(matrix, i, j) # If nothing is permissible, there is no solution at this level. return nil if p.length == 0 options.push({:i => i, :j => j, :permissible => p}) } } # If the matrix is complete, we have a solution... return matrix if options.length == 0 omin = options.min_by { |x| x[:permissible].length } # If there is an option with only one solution, set it and re-check permissibility if omin[:permissible].length == 1 matrix[omin[:i]][omin[:j]] = omin[:permissible][0] next end # We have two or more choices. We need to search both... omin[:permissible].each { |v| mtmp = deep_copy_sudoku(matrix) mtmp[omin[:i]][omin[:j]] = v ret = solve_sudoku(mtmp) return ret if ret } # We did an exhaustive search on this branch and nothing worked out. return nil end
end
def print_matrix(matrix)
if not matrix puts "Impossible" return end border = "+-----+-----+-----+" (0..8).each { |i| puts border if i%3 == 0 (0..8).each { |j| print(j%3 == 0 ? "|" : " ") print(matrix[i][j] == 0 ? "." : matrix[i][j]) } print "|\n" } puts border
end
matrix = read_matrix(DATA) print_matrix(matrix) puts print_matrix(solve_sudoku(matrix))
__END__ 394__267_ ___3__4__ 5__69__2_ _45___9__ 6_______7 __7___58_ _1__67__8 __9__8___ _264__735</lang> Output:
+-----+-----+-----+ |3 9 4|. . 2|6 7 .| |. . .|3 . .|4 . .| |5 . .|6 9 .|. 2 .| +-----+-----+-----+ |. 4 5|. . .|9 . .| |6 . .|. . .|. . 7| |. . 7|. . .|5 8 .| +-----+-----+-----+ |. 1 .|. 6 7|. . 8| |. . 9|. . 8|. . .| |. 2 6|4 . .|7 3 5| +-----+-----+-----+ +-----+-----+-----+ |3 9 4|8 5 2|6 7 1| |2 6 8|3 7 1|4 5 9| |5 7 1|6 9 4|8 2 3| +-----+-----+-----+ |1 4 5|7 8 3|9 6 2| |6 8 2|9 4 5|3 1 7| |9 3 7|1 2 6|5 8 4| +-----+-----+-----+ |4 1 3|5 6 7|2 9 8| |7 5 9|2 3 8|1 4 6| |8 2 6|4 1 9|7 3 5| +-----+-----+-----+
Scala
I use the following slightly modified code for creating new sudokus and it seems to me usable for solving given sudokus. It doesn't look like elegant and functional programming - so what! it works! This solver works with normally 9x9 sudokus as well as with sudokus of jigsaw type or sudokus with additional condition like diagonal constraint.
<lang scala>object SudokuSolver extends App {
class Solver {
var solution = new Array[Int](81) //listOfFields toArray
val fp2m: Int => Tuple2[Int,Int] = pos => Pair(pos/9+1,pos%9+1) //get row, col from array position val setAll = (1 to 9) toSet //all possibilities
val arrayGroups = new Array[List[List[Int]]](81) val sv: Int => Int = (row: Int) => (row-1)*9 //start value group row val ev: Int => Int = (row: Int) => sv(row)+8 //end value group row val fgc: (Int,Int) => Int = (i,col) => i*9+col-1 //get group col val fgs: Int => (Int,Int) = p => Pair(p, p/(27)*3+p%9/3) //get group square box for (pos <- 0 to 80) { val (row,col) = fp2m(pos) val gRow = (sv(row) to ev(row)).toList val gCol = ((0 to 8) toList) map (fgc(_,col)) val gSquare = (0 to 80 toList) map fgs filter (_._2==(fgs(pos))._2) map (_._1) arrayGroups(pos) = List(gRow,gCol,gSquare) } val listGroups = arrayGroups toList val fpv4s: (Int) => List[Int] = pos => { //get possible values for solving val setRow = (listGroups(pos)(0) map (solution(_))).toSet val setCol = listGroups(pos)(1).map(solution(_)).toSet val setSquare = listGroups(pos)(2).map(solution(_)).toSet val setG = setRow++setCol++setSquare--Set(0) val setPossible = setAll--setG setPossible.toList.sortWith(_<_) } //solve the riddle: Nil ==> solution does not exist def solve(listOfFields: List[Int]): List[Int] = { solution = listOfFields toArray
def checkSol(uncheckedSol: List[Int]): List[Int] = { if (uncheckedSol == Nil) return Nil solution = uncheckedSol toArray val check = (0 to 80).map(fpv4s(_)).filter(_.size>0) if (check == Nil) return uncheckedSol return Nil } val f1: Int => Pair[Int,Int] = p => Pair(p,listOfFields(p)) val numFields = (0 to 80 toList) map f1 filter (_._2==0) val iter = numFields map ((_: (Int,Int))._1) var p_iter = 0
val first: () => Int = () => { val ret = numFields match { case Nil => -1 case _ => numFields(0)._1 } ret } val last: () => Int = () => { val ret = numFields match { case Nil => -1 case _ => numFields(numFields.size-1)._1 } ret } val hasPrev: () => Boolean = () => p_iter > 0 val prev: () => Int = () => {p_iter -= 1; iter(p_iter)} val hasNext: () => Boolean = () => p_iter < iter.size-1 val next: () => Int = () => {p_iter += 1; iter(p_iter)} val fixed: Int => Boolean = pos => listOfFields(pos) != 0 val possiArray = new Array[List[Int]](numFields.size) val firstUF = first() //first unfixed if (firstUF < 0) return checkSol(solution.toList) //that is it! var pif = iter(p_iter) //pos in fields val lastUF = last() //last unfixed val (row,col) = fp2m(pif) possiArray(p_iter) = fpv4s(pif).toList.sortWith(_<_)
while(pif <= lastUF) { val (row,col) = fp2m(pif) if (possiArray(p_iter) == null) possiArray(p_iter) = fpv4s(pif).toList.sortWith(_<_) val possis = possiArray(p_iter) if (possis.isEmpty) { if (hasPrev()) { possiArray(p_iter) = null solution(pif) = 0 pif = prev() } else { return Nil } } else { solution(pif) = possis(0) possiArray(p_iter) = (possis.toSet - possis(0)).toList.sortWith(_<_) if (hasNext()) { pif = next() } else { return checkSol(solution.toList) } } } checkSol(solution.toList) } }
val f2Str: List[Int] => String = fields => { val sepLine = "+---+---+---+" val sepPoints = Set(2,5,8) val fs: (Int, Int) => String = (i, v) => v.toString.replace("0"," ")+(if (sepPoints.contains(i%9)) "|" else "") sepLine+"\n"+(0 to fields.size-1).map(i => (if (i%9==0) "|" else "")+fs(i,fields(i))+(if (i%9==8) if (sepPoints.contains(i/9)) "\n"+sepLine+"\n" else "\n" else "")).foldRight("")(_+_) } val solver = new Solver()
val riddle = List(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)
println("riddle:") println(f2Str(riddle)) var solution = solver.solve(riddle)
println("solution:") println(solution match {case Nil => "no solution!!!" case _ => f2Str(solution)})
}</lang> Output:
riddle: +---+---+---+ |394| 2|67 | | |3 |4 | |5 |69 | 2 | +---+---+---+ | 45| |9 | |6 | | 7| | 7| |58 | +---+---+---+ | 1 | 67| 8| | 9| 8| | | 26|4 |735| +---+---+---+ solution: +---+---+---+ |394|852|671| |268|371|459| |571|694|823| +---+---+---+ |145|783|962| |682|945|317| |937|126|584| +---+---+---+ |413|567|298| |759|238|146| |826|419|735| +---+---+---+
The implementation above doesn't work so effective for sudokus like Bracmat version, therefore I implemented a second version inspired by Java section:
<lang scala>object SudokuSolver extends App {
object Solver { var solution = new Array[Int](81)
val fap: (Int, Int) => Int = (row, col) => (row)*9+col //function array position
def solve(listOfFields: List[Int]): List[Int] = { solution = listOfFields toArray val mRowSubset = new Array[Boolean](81) val mColSubset = new Array[Boolean](81) val mBoxSubset = new Array[Boolean](81)
def initSubsets: Unit = { for (row <- 0 to 8) { for (col <- 0 to 8) { val value = solution(fap(row, col)) if (value != 0) setSubsetValue(row, col, value, true) } } } def setSubsetValue(r: Int, c: Int, value: Int, present: Boolean): Unit = { mRowSubset(fap(r, value - 1)) = present mColSubset(fap(c, value - 1)) = present mBoxSubset(fap(computeBoxNo(r, c), value - 1)) = present }
def computeBoxNo(r: Int, c: Int): Int = { val boxRow = r / 3 val boxCol = c / 3 return boxRow * 3 + boxCol }
def isValid(r: Int, c: Int, value: Int): Boolean = { val vVal = value - 1 val isPresent = mRowSubset(fap(r, vVal)) || mColSubset(fap(c, vVal)) || mBoxSubset(fap(computeBoxNo(r, c), vVal)) return !isPresent }
def solve(row: Int, col: Int): Boolean = { var r = row var c = col
if (r == 9) { r = 0 c += 1 if (c == 9) return true } if(solution(fap(r,c)) != 0) return solve(r+1,c) for(value <- 1 to 9) if(isValid(r, c, value)) { solution(fap(r,c)) = value setSubsetValue(r, c, value, true) if(solve(r+1,c)) return true setSubsetValue(r, c, value, false) } solution(fap(r,c)) = 0 return false } def checkSol: Boolean = { initSubsets if ((mRowSubset.exists(_==false)) || (mColSubset.exists(_==false)) || (mBoxSubset.exists(_==false))) return false true }
initSubsets val ret = solve(0,0) if (ret) if (checkSol) return solution.toList else Nil else return Nil } } val f2Str: List[Int] => String = fields => { val f2Stri: List[Int] => String = fields => { val sepLine = "+---+---+---+" val sepPoints = Set(2,5,8) val fs: (Int, Int) => String = (i, v) => v.toString.replace("0"," ")+(if (sepPoints.contains(i%9)) "|" else "") val s = sepLine+"\n"+(0 to fields.size-1).map(i => (if (i%9==0) "|" else "")+fs(i,fields(i))+(if (i%9==8) if (sepPoints.contains(i/9)) "\n"+sepLine+"\n" else "\n" else "")).foldRight("")(_+_) s } val s = fields match {case Nil => "no solution!!!" case _ => f2Stri(fields)} s }
val elapsedtime: (=> Unit) => Long = f => {val s = System.currentTimeMillis; f; (System.currentTimeMillis - s)/1000}
var sol = List[Int]() val sudokus = List( ("riddle used in Ada section:", "394..267....3..4..5..69..2..45...9..6.......7..7...58..1..67..8..9..8....264..735"), ("riddle used in Bracmat section:", "..............3.85..1.2.......5.7.....4...1...9.......5......73..2.1........4...9"), ("riddle from Groovy section: 4th exceptionally difficult example in Wikipedia: ~80 seconds", "..3......4...8..36..8...1...4..6..73...9..........2..5..4.7..686........7..6..5.."), ("riddle used in Ada section with incorrect modifactions - it should fail:", "3943.267....3..4..5..69..2..45...9..6.......7..7...58..1..67..8..9..8....264..735"), ("riddle constructed with mess - it should fail too:", "123456789456789123789123456.45..89..6.......72.7...58.31..67..8..9..8....264..735"))
for (sudoku <- sudokus) { val desc = sudoku._1 val riddle = sudoku._2.replace(".","0").toList.map(_.toString.toInt) println(desc+"\n"+f2Str(riddle)+"\n" +"elapsed time: "+elapsedtime(sol = Solver.solve(riddle))+" sec"+"\n"+"solution:"+"\n"+f2Str(sol) +("\n"*2)) }
}</lang> Output:
riddle used in Ada section: +---+---+---+ |394| 2|67 | | |3 |4 | |5 |69 | 2 | +---+---+---+ | 45| |9 | |6 | | 7| | 7| |58 | +---+---+---+ | 1 | 67| 8| | 9| 8| | | 26|4 |735| +---+---+---+ elapsed time: 0 sec solution: +---+---+---+ |394|852|671| |268|371|459| |571|694|823| +---+---+---+ |145|783|962| |682|945|317| |937|126|584| +---+---+---+ |413|567|298| |759|238|146| |826|419|735| +---+---+---+ riddle used in Bracmat section: +---+---+---+ | | | | | | 3| 85| | 1| 2 | | +---+---+---+ | |5 7| | | 4| |1 | | 9 | | | +---+---+---+ |5 | | 73| | 2| 1 | | | | 4 | 9| +---+---+---+ elapsed time: 43 sec 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| +---+---+---+ riddle from Groovy section: 4th exceptionally difficult example in Wikipedia: ~80 seconds +---+---+---+ | 3| | | |4 | 8 | 36| | 8| |1 | +---+---+---+ | 4 | 6 | 73| | |9 | | | | 2| 5| +---+---+---+ | 4| 7 | 68| |6 | | | |7 |6 |5 | +---+---+---+ elapsed time: 3 sec solution: +---+---+---+ |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| +---+---+---+ riddle used in Ada section with incorrect modifactions - it should fail: +---+---+---+ |394|3 2|67 | | |3 |4 | |5 |69 | 2 | +---+---+---+ | 45| |9 | |6 | | 7| | 7| |58 | +---+---+---+ | 1 | 67| 8| | 9| 8| | | 26|4 |735| +---+---+---+ elapsed time: 0 sec solution: no solution!!! riddle constructed with mess - it should fail too: +---+---+---+ |123|456|789| |456|789|123| |789|123|456| +---+---+---+ | 45| 8|9 | |6 | | 7| |2 7| |58 | +---+---+---+ |31 | 67| 8| | 9| 8| | | 26|4 |735| +---+---+---+ elapsed time: 0 sec solution: no solution!!!
Tcl
Adapted from a page on the Tcler's Wiki to use a standard object system.
Note that you can implement more rules if you want. Just make another subclass of Rule
and the solver will pick it up and use it automatically.
or
<lang tcl>package require Tcl 8.6 oo::class create Sudoku {
variable idata
method clear {} {
for {set y 0} {$y < 9} {incr y} { for {set x 0} {$x < 9} {incr x} { my set $x $y {} } }
} method load {data} {
set error "data must be a 9-element list, each element also being a\ list of 9 numbers from 1 to 9 or blank or an @ symbol." if {[llength $data] != 9} { error $error } for {set y 0} {$y<9} {incr y} { set row [lindex $data $y] if {[llength $row] != 9} { error $error } for {set x 0} {$x<9} {incr x} { set d [lindex $row $x] if {![regexp {^[@1-9]?$} $d]} { error $d-$error } if {$d eq "@"} {set d ""} my set $x $y $d } }
} method dump {} {
set rows {} for {set y 0} {$y < 9} {incr y} { lappend rows [my getRow 0 $y] } return $rows
}
method Log msg {
# Chance to print message
}
method set {x y value} {
if {[catch {set value [format %d $value]}]} {set value 0} if {$value<1 || $value>9} { set idata(sq$x$y) {} } else { set idata(sq$x$y) $value }
} method get {x y} {
if {![info exists idata(sq$x$y)]} { return {} } return $idata(sq$x$y)
}
method getRow {x y} {
set row {} for {set x 0} {$x<9} {incr x} { lappend row [my get $x $y] } return $row
} method getCol {x y} {
set col {} for {set y 0} {$y<9} {incr y} { lappend col [my get $x $y] } return $col
} method getRegion {x y} {
set xR [expr {($x/3)*3}] set yR [expr {($y/3)*3}] set regn {} for {set x $xR} {$x < $xR+3} {incr x} { for {set y $yR} {$y < $yR+3} {incr y} { lappend regn [my get $x $y] } } return $regn
}
}
- SudokuSolver inherits from Sudoku, and adds the ability to filter
- possibilities for a square by looking at all the squares in the row, column,
- and region that the square is a part of. The method 'solve' contains a list
- of rule-objects to use, and iterates over each square on the board, applying
- each rule sequentially until the square is allocated.
oo::class create SudokuSolver {
superclass Sudoku method validchoices {x y} {
if {[my get $x $y] ne {}} { return [my get $x $y] }
set row [my getRow $x $y] set col [my getCol $x $y] set regn [my getRegion $x $y] set eliminate [list {*}$row {*}$col {*}$regn] set eliminate [lsearch -all -inline -not $eliminate {}] set eliminate [lsort -unique $eliminate]
set choices {} for {set c 1} {$c < 10} {incr c} { if {$c ni $eliminate} { lappend choices $c } } if {[llength $choices]==0} { error "No choices left for square $x,$y" } return $choices
} method completion {} {
return [expr { 81-[llength [lsearch -all -inline [join [my dump]] {}]] }]
} method solve {} {
foreach ruleClass [info class subclass Rule] { lappend rules [$ruleClass new] }
while {1} { set begin [my completion] for {set y 0} {$y < 9} {incr y} { for {set x 0} {$x < 9} {incr x} { if {[my get $x $y] eq ""} { foreach rule $rules { set c [$rule solve [self] $x $y] if {$c} { my set $x $y $c my Log "[info object class $rule] solved [self] at $x,$y for $c" break } } } } } set end [my completion] if {$end==81} { my Log "Finished solving!" break } elseif {$begin==$end} { my Log "A round finished without solving any squares, giving up." break } } foreach rule $rules { $rule destroy }
}
}
- Rule is the template for the rules used in Solver. The other rule-objects
- apply their logic to the values passed in and return either '0' or a number
- to allocate to the requested square.
oo::class create Rule {
method solve {hSudoku x y} {
if {![info object isa typeof $hSudoku SudokuSolver]} { error "hSudoku must be an instance of class SudokuSolver." }
tailcall my Solve $hSudoku $x $y [$hSudoku validchoices $x $y]
}
}
- Get all the allocated numbers for each square in the the row, column, and
- region containing $x,$y. If there is only one unallocated number among all
- three groups, it must be allocated at $x,$y
oo::class create RuleOnlyChoice {
superclass Rule method Solve {hSudoku x y choices} {
if {[llength $choices]==1} { return $choices } else { return 0 }
}
}
- Test each column to determine if $choice is an invalid choice for all other
- columns in row $X. If it is, it must only go in square $x,$y.
oo::class create RuleColumnChoice {
superclass Rule method Solve {hSudoku x y choices} {
foreach choice $choices { set failed 0 for {set x2 0} {$x2<9} {incr x2} { if {$x2 != $x && $choice in [$hSudoku validchoices $x2 $y]} { set failed 1 break } } if {!$failed} {return $choice} } return 0
}
}
- Test each row to determine if $choice is an invalid choice for all other
- rows in column $y. If it is, it must only go in square $x,$y.
oo::class create RuleRowChoice {
superclass Rule method Solve {hSudoku x y choices} {
foreach choice $choices { set failed 0 for {set y2 0} {$y2<9} {incr y2} { if {$y2 != $y && $choice in [$hSudoku validchoices $x $y2]} { set failed 1 break } } if {!$failed} {return $choice} } return 0
}
}
- Test each square in the region occupied by $x,$y to determine if $choice is
- an invalid choice for all other squares in that region. If it is, it must
- only go in square $x,$y.
oo::class create RuleRegionChoice {
superclass Rule method Solve {hSudoku x y choices} {
foreach choice $choices { set failed 0 set regnX [expr {($x/3)*3}] set regnY [expr {($y/3)*3}] for {set y2 $regnY} {$y2 < $regnY+3} {incr y2} { for {set x2 $regnX} {$x2 < $regnX+3} {incr x2} { if { ($x2!=$x || $y2!=$y) && $choice in [$hSudoku validchoices $x2 $y2] } then { set failed 1 break } } } if {!$failed} {return $choice} } return 0
}
}</lang> Demonstration code: <lang tcl>SudokuSolver create sudoku sudoku load {
{3 9 4 @ @ 2 6 7 @} {@ @ @ 3 @ @ 4 @ @} {5 @ @ 6 9 @ @ 2 @}
{@ 4 5 @ @ @ 9 @ @} {6 @ @ @ @ @ @ @ 7} {@ @ 7 @ @ @ 5 8 @}
{@ 1 @ @ 6 7 @ @ 8} {@ @ 9 @ @ 8 @ @ @} {@ 2 6 4 @ @ 7 3 5}
} sudoku solve
- Simple pretty-printer for completed sudokus
puts +-----+-----+-----+ foreach line [sudoku dump] postline {0 0 1 0 0 1 0 0 1} {
puts |[lrange $line 0 2]|[lrange $line 3 5]|[lrange $line 6 8]| if {$postline} {
puts +-----+-----+-----+
}
} sudoku destroy</lang> Sample output:
+-----+-----+-----+ |3 9 4|8 5 2|6 7 1| |2 6 8|3 7 1|4 5 9| |5 7 1|6 9 4|8 2 3| +-----+-----+-----+ |1 4 5|7 8 3|9 6 2| |6 8 2|9 4 5|3 1 7| |9 3 7|1 2 6|5 8 4| +-----+-----+-----+ |4 1 3|5 6 7|2 9 8| |7 5 9|2 3 8|1 4 6| |8 2 6|4 1 9|7 3 5| +-----+-----+-----+
If we'd added a logger method (after creating the sudoku
object but before running the solver) like this:
<lang tcl>oo::objdefine sudoku method Log msg {puts $msg}</lang>
Then this additional logging output would have been produced prior to the result being printed:
::RuleOnlyChoice solved ::sudoku at 8,0 for 1 ::RuleColumnChoice solved ::sudoku at 1,1 for 6 ::RuleRegionChoice solved ::sudoku at 4,1 for 7 ::RuleRowChoice solved ::sudoku at 7,1 for 5 ::RuleOnlyChoice solved ::sudoku at 8,1 for 9 ::RuleColumnChoice solved ::sudoku at 1,2 for 7 ::RuleColumnChoice solved ::sudoku at 5,2 for 4 ::RuleRowChoice solved ::sudoku at 6,2 for 8 ::RuleOnlyChoice solved ::sudoku at 8,2 for 3 ::RuleColumnChoice solved ::sudoku at 3,3 for 7 ::RuleRowChoice solved ::sudoku at 1,4 for 8 ::RuleRowChoice solved ::sudoku at 5,4 for 5 ::RuleRowChoice solved ::sudoku at 6,4 for 3 ::RuleRowChoice solved ::sudoku at 0,5 for 9 ::RuleOnlyChoice solved ::sudoku at 1,5 for 3 ::RuleOnlyChoice solved ::sudoku at 0,6 for 4 ::RuleOnlyChoice solved ::sudoku at 2,6 for 3 ::RuleColumnChoice solved ::sudoku at 3,6 for 5 ::RuleOnlyChoice solved ::sudoku at 6,6 for 2 ::RuleOnlyChoice solved ::sudoku at 7,6 for 9 ::RuleOnlyChoice solved ::sudoku at 0,7 for 7 ::RuleOnlyChoice solved ::sudoku at 1,7 for 5 ::RuleColumnChoice solved ::sudoku at 4,7 for 3 ::RuleOnlyChoice solved ::sudoku at 6,7 for 1 ::RuleOnlyChoice solved ::sudoku at 0,8 for 8 ::RuleOnlyChoice solved ::sudoku at 4,8 for 1 ::RuleOnlyChoice solved ::sudoku at 5,8 for 9 ::RuleOnlyChoice solved ::sudoku at 3,0 for 8 ::RuleOnlyChoice solved ::sudoku at 4,0 for 5 ::RuleColumnChoice solved ::sudoku at 2,1 for 8 ::RuleOnlyChoice solved ::sudoku at 5,1 for 1 ::RuleOnlyChoice solved ::sudoku at 2,2 for 1 ::RuleRowChoice solved ::sudoku at 0,3 for 1 ::RuleColumnChoice solved ::sudoku at 4,3 for 8 ::RuleColumnChoice solved ::sudoku at 5,3 for 3 ::RuleOnlyChoice solved ::sudoku at 7,3 for 6 ::RuleOnlyChoice solved ::sudoku at 8,3 for 2 ::RuleOnlyChoice solved ::sudoku at 2,4 for 2 ::RuleColumnChoice solved ::sudoku at 3,4 for 9 ::RuleOnlyChoice solved ::sudoku at 4,4 for 4 ::RuleOnlyChoice solved ::sudoku at 7,4 for 1 ::RuleColumnChoice solved ::sudoku at 3,5 for 1 ::RuleOnlyChoice solved ::sudoku at 4,5 for 2 ::RuleOnlyChoice solved ::sudoku at 5,5 for 6 ::RuleOnlyChoice solved ::sudoku at 8,5 for 4 ::RuleOnlyChoice solved ::sudoku at 3,7 for 2 ::RuleOnlyChoice solved ::sudoku at 7,7 for 4 ::RuleOnlyChoice solved ::sudoku at 8,7 for 6 ::RuleOnlyChoice solved ::sudoku at 0,1 for 2 Finished solving!
Ursala
<lang Ursala>#import std
- import nat
sudoku =
@FL mat0+ block3+ mat` *+ block3*+ block9+ -+
~&rSL+ (psort (nleq+)* <~&blrl,~&blrr>)+ ~&arg^& -+ ~&al?\~&ar ~&aa^&~&afahPRPfafatPJPRY+ ~&farlthlriNCSPDPDrlCS2DlrTS2J, ^|J/~& ~&rt!=+ ^= ~&s+ ~&H( -+.|=&lrr;,|=&lrl;,|=≪+-, ~&rgg&& ~&irtPFXlrjrXPS; ~&lrK2tkZ2g&& ~&llrSL2rDrlPrrPljXSPTSL)+-, //~&p ^|DlrDSLlrlPXrrPDSL(~&,num*+ rep2 block3)*= num block27 ~&iiK0 iota9, * `0?=\~&iNC ! ~&t digits+-</lang>
test program: <lang Ursala>#show+
example =
sudoku
-[ 394002670 000300400 500690020 045000900 600000007 007000580 010067008 009008000 026400735]-</lang> output:
394 852 671 268 371 459 571 694 823 145 783 962 682 945 317 937 126 584 413 567 298 759 238 146 826 419 735
VBA
<lang VB>Dim grid(9, 9) Dim gridSolved(9, 9)
Public Sub Solve(i, j)
If i > 9 Then 'exit with gridSolved = Grid For r = 1 To 9 For c = 1 To 9 gridSolved(r, c) = grid(r, c) Next c Next r Exit Sub End If For n = 1 To 9 If isSafe(i, j, n) Then nTmp = grid(i, j) grid(i, j) = n If j = 9 Then Solve i + 1, 1 Else Solve i, j + 1 End If grid(i, j) = nTmp End If Next n
End Sub
Public Function isSafe(i, j, n) As Boolean Dim iMin As Integer Dim jMin As Integer
If grid(i, j) <> 0 Then
isSafe = (grid(i, j) = n) Exit Function
End If
'grid(i,j) is an empty cell. Check if n is OK 'first check the row i For c = 1 To 9
If grid(i, c) = n Then isSafe = False Exit Function End If
Next c
'now check the column j For r = 1 To 9
If grid(r, j) = n Then isSafe = False Exit Function End If
Next r
'finally, check the 3x3 subsquare containing grid(i,j) iMin = 1 + 3 * Int((i - 1) / 3) jMin = 1 + 3 * Int((j - 1) / 3) For r = iMin To iMin + 2
For c = jMin To jMin + 2 If grid(r, c) = n Then isSafe = False Exit Function End If Next c
Next r
'all tests were OK isSafe = True End Function
Public Sub Sudoku()
'main routine 'to use, fill in the grid and 'type "Sudoku" in the Immediate panel of the Visual Basic for Applications window
Dim s(9) As String
'initialise grid using 9 strings,one per row 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" For i = 1 To 9 For j = 1 To 9 grid(i, j) = Int(Val(Mid$(s(i), j, 1))) Next j Next i 'solve it! Solve 1, 1 'print solution Debug.Print "Solution:" For i = 1 To 9 For j = 1 To 9 Debug.Print Format$(gridSolved(i, j)); " "; Next j Debug.Print Next i
End Sub</lang> Output:
Sudoku Solution: 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
XPL0
This is a translation of the C example, but with a solution that can be verified by several other examples.
<lang XPL0>code ChOut=8, CrLf=9, IntOut=11, Text=12;
proc Show(X); char X; int I, J; [for I:= 0 to 8 do
[if rem(I/3) = 0 then CrLf(0); for J:= 0 to 8 do [if rem(J/3) = 0 then ChOut(0, ^ ); ChOut(0, ^ ); IntOut(0, X(0)); X:= X+1; ]; CrLf(0); ];
];
func TryCell(X, Pos); char X; int Pos; int Row, Col, I, J, Used; [Row:= Pos/9; Col:= rem(0); Used:= 0;
if Pos = 81 then return true; if X(Pos) then return TryCell(X, Pos+1);
for I:= 0 to 8 do Used:= Used ! 1 << (X(I*9+Col)-1); for J:= 0 to 8 do Used:= Used ! 1 << (X(Row*9+J)-1);
Row:= Row/3*3; Col:= Col/3*3; for I:= Row to Row+2 do
for J:= Col to Col+2 do Used:= Used ! 1 << (X(I*9+J)-1);
for I:= 1 to 9 do
[X(Pos):= I; if (Used&1)=0 & TryCell(X, Pos+1) then return true; Used:= Used>>1; ];
X(Pos):= 0; return false; ];
proc Solve(S); char S; int I, J, C; char X(81); [J:= 0; for I:= 0 to 80 do
[repeat C:= S(J); J:= J+1; until C>=^1 & C<=^9 ! C=^.; X(I):= if C=^. then 0 else C-^0; ];
if TryCell(X, 0) then Show(X) else Text(0, "No solution"); ];
[Solve("394 ..2 67.
... 3.. 4.. 5.. 69. .2. .45 ... 9.. 6.. ... ..7 ..7 ... 58. .1. .67 ..8 ..9 ..8 ... .26 4.. 735 ");
]</lang>
Output:
3 9 4 8 5 2 6 7 1 2 6 8 3 7 1 4 5 9 5 7 1 6 9 4 8 2 3 1 4 5 7 8 3 9 6 2 6 8 2 9 4 5 3 1 7 9 3 7 1 2 6 5 8 4 4 1 3 5 6 7 2 9 8 7 5 9 2 3 8 1 4 6 8 2 6 4 1 9 7 3 5
- Programming Tasks
- Games
- ALGOL 68
- AutoHotkey
- BBC BASIC
- BCPL
- Bracmat
- C
- C sharp
- Microsoft Solver Foundation
- C++
- Clojure
- Common Lisp
- Curry
- D
- Delphi
- Erlang
- Forth
- Fortran
- Go
- Groovy
- Haskell
- J
- Java
- Lua
- Mathematica
- MATLAB
- OCaml
- Oz
- Perl
- Perl 6
- PicoLisp
- PL/I
- Prolog
- PureBasic
- Python
- Racket
- Rascal
- REXX
- RPN (HP-15c)
- Ruby
- Scala
- Tcl
- TclOO
- Ursala
- VBA
- XPL0
- GUISS/Omit