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
)


#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, "[^[email protected]]"), ErrorLevel := 0 ;format puzzle as single line string
   return Sudoku_Display(Sudoku_Solve(p))
}

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

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

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


      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%


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

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

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

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

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

// A typical problem is:

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

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

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

SECTION "sudoku"

GET "libhdr"

GLOBAL { count:ug

// The 9x9 board

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

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

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

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

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

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

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

  newline()

//abort(1000)
}

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

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

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

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

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

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

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

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

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

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

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


{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)$
  );


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


#include <iostream>
using namespace std;

class SudokuSolver {
private:
    int grid[81];

public:

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

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

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

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

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

};

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


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


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


GRID_SIZE = 9

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

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

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

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

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

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


-----------------------------------------------------------------------------
--- 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"]


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

struct Digit {
    immutable char d;

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

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

    alias d this;
}

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

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

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

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

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

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

        return true;
    }

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

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

        return false;
    }

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

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

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

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

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

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

    immutable solution = problem.sudokuSolver;
    if (solution.isNull)
        writeln("Unsolvable!");
    else
        solution.get.representSudoku.writeln;
}


type
  TIntArray = array of Integer;

  { TSudokuSolver }

  TSudokuSolver = class
  private
    FGrid: TIntArray;

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

    procedure Solve;
  end;

implementation

uses
  Dialogs;

{ TSudokuSolver }

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

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

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

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

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


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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

simple = [{{1, 1}, 3}, {{2, 1}, 9}, {{3, 1},4}, {{6, 1}, 2}, {{7, 1}, 6}, {{8, 1}, 7},
          {{4, 2}, 3}, {{7, 2}, 4},
          {{1, 3}, 5}, {{4, 3}, 6}, {{5, 3}, 9}, {{8, 3}, 2},
          {{2, 4}, 4}, {{3, 4}, 5}, {{7, 4}, 9},
          {{1, 5}, 6}, {{9, 5}, 7},
          {{3, 6}, 7}, {{7, 6}, 5}, {{8, 6}, 8},
          {{2, 7}, 1}, {{5, 7}, 6}, {{6, 7}, 7}, {{9, 7}, 8},
          {{3, 8}, 9}, {{6, 8}, 8},
          {{2, 9}, 2}, {{3, 9}, 6}, {{4, 9}, 4}, {{7, 9}, 7}, {{8, 9}, 3}, {{9, 9}, 5}]
Sudoku.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}]
Sudoku.task( difficult )


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

PROGRAM SUDOKU

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

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

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

!$INCLUDE="PC.LIB"

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


module SudokuBacktrack

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

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

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

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

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

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

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

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

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

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

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

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

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

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


include lib/interprt.4th
include lib/istype.4th
include lib/argopen.4th

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

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

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

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

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

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

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

\ Grid Related

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

\ Puts and gets numbers from/to grid only
: setnumber sudokugrid + c! ;          \ n position --
: getnumber sudokugrid + [email protected] ;

: cleargrid sudokugrid 81 bounds do 0 i c! loop ;

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

\ ie x y --   ;  adds x into bitmap y
: addbits_row cells sudoku_row + dup @ rot 1 swap lshift or swap ! ;
: addbits_col cells sudoku_col + dup @ rot 1 swap lshift or swap ! ;
: addbits_box cells sudoku_box + dup @ rot 1 swap lshift or swap ! ;

\ ie x y --  ; remove number x from bitmap y
: removebits_row cells sudoku_row + dup @ rot 1 swap lshift invert and swap ! ;
: removebits_col cells sudoku_col + dup @ rot 1 swap lshift invert and swap ! ;
: removebits_box cells sudoku_box + dup @ rot 1 swap lshift invert and swap ! ;

\ clears all bitsmaps to 0
: clearbitmaps 9 0 do i cells
                     0 over sudoku_row + !
                     0 over sudoku_col + !
                     0 swap sudoku_box + !
           loop ;

\ Adds number to grid and sets
: addnumber                            \ number position --
    2dup setnumber
    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 + [email protected]
       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 [email protected]  0= if 1+ then loop ;

: findnextmove                         \  -- n ; n = index next item, if -1 finished.

   -1  10                              \  index  prev_possibilities  --
                                       \  err... yeah... local variables, kind of...

   81 0 do
      i sudokugrid + [email protected] 0= IF
             i getbits countbits 9 swap -

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

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

             else                      \ else prev_possibilities < new possibilities, so:

                 drop                  \ new_index new_possibilies --

             then
      THEN
   loop
   drop
;

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

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

     10 1 do
        i over try if
           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 + [email protected] .
    i 1+
      dup 3 mod 0= if
         dup 9 mod 0= if
            CR
            dup 27 mod 0= if
              dup 81 < if ." ------+-------+------" CR then
            then
         else
           ." | "
         then
      then
    drop
  loop
  drop
  CR
;

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

: checkifoccupied                      ( offset -- t/f)
    sudokugrid + [email protected]
;

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


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


Dim Shared As Integer cuadricula(9, 9), cuadriculaResuelta(9, 9)

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

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

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

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

    'finalmente, compruebe el subcuadrado de 3x3 que contiene cuadricula(i,j)
    iMin = 1 + 3 * Int((i - 1) / 3)
    jMin = 1 + 3 * Int((j - 1) / 3)
    For c = iMin To iMin + 2
        For f = jMin To jMin + 2
            If cuadricula(c, f) = n Then Return False
        Next f
    Next c

    'todas las pruebas estuvieron OK
    Return True
End Function

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

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

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

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


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

begin globals
dim as container gC
end globals

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

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

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

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

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

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

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

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

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

  mutStr = CFStringCreateMutable( kCFAllocatorDefault, 0 );

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

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

dim as short solution
dim as CFMutableStringRef cfRef

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

solution = fn solve_sudoku(0)

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


[(Int, Int) = BigInt] computed

F sterling2(n, k)
   V key = (n, k)

   I key C :computed
      R :computed[key]
   I n == k == 0
      R BigInt(1)
   I (n > 0 & k == 0) | (n == 0 & k > 0)
      R BigInt(0)
   I n == k
      R BigInt(1)
   I k > n
      R BigInt(0)
   V result = k * sterling2(n - 1, k) + sterling2(n - 1, k - 1)
   :computed[key] = result
   R result

print(‘Stirling numbers of the second kind:’)
V MAX = 12
print(‘n/k’.ljust(10), end' ‘’)
L(n) 0 .. MAX
   print(String(n).rjust(10), end' ‘’)
print()
L(n) 0 .. MAX
   print(String(n).ljust(10), end' ‘’)
   L(k) 0 .. n
      print(String(sterling2(n, k)).rjust(10), end' ‘’)
   print()
print(‘The maximum value of S2(100, k) = ’)
BigInt previous = 0
L(k) 1 .. 100
   V current = sterling2(100, k)
   I current > previous
      previous = current
   E
      print("#.\n(#. digits, k = #.)\n".format(previous, String(previous).len, k - 1))
      L.break


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
}


BEGIN
    # show some Stirling numbers of the second kind                          #

    # specify the precision of LONG LONG INT, somewhat under 160 digits are  #
    # needed for Stirling numbers of the second kind with n, k = 100         #
    PR precision 160 PR
    MODE SINT = LONG LONG INT;

    # returns a triangular matrix of Stirling numbers up to max n, max n #
    PROC make s2 = ( INT max n )REF[,]SINT:
    BEGIN
        REF[,]SINT s2 := HEAP[ 0 : max n, 0 : max n ]SINT;
        FOR n FROM 0 TO max n DO FOR k FROM 0 TO max n DO s2[ n, k ] := 0 OD OD;
        FOR n FROM 0 TO max n DO s2[ n, n ] := 1 OD;
        FOR n FROM 0 TO max n - 1 DO
            FOR k FROM 1 TO n DO
                s2[ n + 1, k ] := k * s2[ n, k ] + s2[ n, k - 1 ]
            OD
        OD;
        s2
    END # make s2 # ;
    # task requirements:                                                     #
    # print Stirling numbers up to n, k = 12                                 #
    BEGIN
        INT max stirling = 12;
        REF[,]SINT s2 = make s2( max stirling );
        print( ( "Stirling numbers of the second kind:", newline ) );
        print( ( " k" ) );
        FOR k FROM 0 TO max stirling DO print( ( whole( k, -10 ) ) ) OD;
        print( ( newline, " n", newline ) );
        FOR n FROM 0 TO max stirling DO
            print( ( whole( n, -2 ) ) );
            FOR k FROM 0 TO n DO
                print( ( whole( s2[ n, k ], -10 ) ) )
            OD;
            print( ( newline ) )
        OD
    END;
    # find the maximum Stirling number with n = 100                          #
    BEGIN
        INT max stirling = 100;
        REF[,]SINT s2 = make s2( max stirling );
        SINT max 100 := 0;
        FOR k FROM 0 TO max stirling DO
            IF s2[ max stirling, k ] > max 100 THEN max 100 := s2[ max stirling, k ] FI
        OD;
        print( ( "Maximum Stirling number of the second kind with n = 100:", newline ) );
        print( ( whole( max 100, 0 ), newline ) )
    END
END


begin % show some Stirling numbers of the second kind                         %
    integer MAX_STIRLING;
    MAX_STIRLING := 12;
    begin
        % construct a matrix of Stirling numbers up to max n, max n           %
        integer array s2 ( 0 :: MAX_STIRLING, 0 :: MAX_STIRLING );
        for n := 0 until MAX_STIRLING do begin
            for k := 0 until MAX_STIRLING do s2( n, k ) := 0
        end for_n ;
        for n := 0 until MAX_STIRLING do s2( n, n ) := 1;
        for n := 0 until MAX_STIRLING - 1 do begin
            for k := 1 until n do begin
                s2( n + 1, k ) := k * s2( n, k ) + s2( n, k - 1 );
            end for_k
        end for_n ;
        % print the Stirling numbers                                          %
        write( "Stirling numbers of the second kind:" );
        write( " k" );
        for k := 0 until MAX_STIRLING do writeon( i_w := 10, s_w := 0, k );
        write( " n" );
        for n := 0 until MAX_STIRLING do begin
            write( i_w := 2, s_w := 0, n );
            for k := 0 until n do writeon( i_w := 10, s_w := 0, s2( n, k ) );
        end for_n
    end
end.


#include <stdbool.h>
#include <stdio.h>
#include <stdlib.h>

typedef struct stirling_cache_tag {
    int max;
    int* values;
} stirling_cache;

int stirling_number2(stirling_cache* sc, int n, int k) {
    if (k == n)
        return 1;
    if (k == 0 || k > n || n > sc->max)
        return 0;
    return sc->values[n*(n-1)/2 + k - 1];
}

bool stirling_cache_create(stirling_cache* sc, int max) {
    int* values = calloc(max * (max + 1)/2, sizeof(int));
    if (values == NULL)
        return false;
    sc->max = max;
    sc->values = values;
    for (int n = 1; n <= max; ++n) {
        for (int k = 1; k < n; ++k) {
            int s1 = stirling_number2(sc, n - 1, k - 1);
            int s2 = stirling_number2(sc, n - 1, k);
            values[n*(n-1)/2 + k - 1] = s1 + s2 * k;
        }
    }
    return true;
}

void stirling_cache_destroy(stirling_cache* sc) {
    free(sc->values);
    sc->values = NULL;
}

void print_stirling_numbers(stirling_cache* sc, int max) {
    printf("Stirling numbers of the second kind:\nn/k");
    for (int k = 0; k <= max; ++k)
        printf(k == 0 ? "%2d" : "%8d", k);
    printf("\n");
    for (int n = 0; n <= max; ++n) {
        printf("%2d ", n);
        for (int k = 0; k <= n; ++k)
            printf(k == 0 ? "%2d" : "%8d", stirling_number2(sc, n, k));
        printf("\n");
    }
}

int main() {
    stirling_cache sc = { 0 };
    const int max = 12;
    if (!stirling_cache_create(&sc, max)) {
        fprintf(stderr, "Out of memory\n");
        return 1;
    }
    print_stirling_numbers(&sc, max);
    stirling_cache_destroy(&sc);
    return 0;
}


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
}