Jump to content

Sudoku

From Rosetta Code
Revision as of 21:45, 1 October 2024 by Peak (talk | contribs) ({{header|DuckDB}})
(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)
Task
Sudoku
You are encouraged to solve this task according to the task description, using any language you may know.
Task

Solve a partially filled-in normal   9x9   Sudoku grid   and display the result in a human-readable format.

references



11l

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

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

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

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

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

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

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

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

      R 1B

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

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

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

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

Solution:

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

8th

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

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

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

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

: search  \ b -- n
  null swap
  ( dup -rot b:bit@ if rot drop break else nip then ) 0 8 loop
  swap ;

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

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

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

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

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

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

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

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

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

\ Store move history
a:new constant history

\ Possible numbers for a cell
: candidates?  \ n -- s
  dup dup 9 n:/ n:int swap 9 n:mod \ row col  
  board swap col b-any
  board rot row b-any
  b-or
  board rot sub b-any
  b-or
  b-not ;
              
\ If found:     -- n T  
\ If not found: -- T
: find-free-cell
  false 
  board ( 0 posbit? b:= if nip true break else drop then ) a:each drop ;

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

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

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

Ada

Translation of: C++
with Ada.Text_IO;

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

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


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

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

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



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


   procedure solve(sudoku_ar: in out sudoku_ar_t)
   is
   begin
      placeNumber( 0, sudoku_ar );
      Ada.Text_IO.Put_Line("Unresolvable !");
   exception
      when FINISH_EXCEPTION =>
         Ada.Text_IO.Put_Line("Finished !");
         prettyprint(sudoku_ar);
   end solve;




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

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

begin
   solve( sudoku_ar );
end Sudoku;
Output:
Finished !
 8 5 9| 6 1 2| 4 3 7
 7 2 3| 8 5 4| 1 6 9
 1 6 4| 3 7 9| 5 2 8
------+------+------
 9 8 6| 1 4 7| 3 5 2
 3 7 5| 2 6 8| 9 1 4
 2 4 1| 5 9 3| 7 8 6
------+------+------
 4 3 2| 9 8 1| 6 7 5
 6 1 7| 4 2 5| 8 9 3
 5 9 8| 7 3 6| 2 4 1

ALGOL 68

Translation of: D

Note: This specimen retains the original D coding style.

Works with: ALGOL 68 version Revision 1 - no extensions to language used.
Works with: ALGOL 68G version Any - tested with release 1.18.0-9h.tiny.
MODE AVAIL = [9]BOOL;
MODE BOX = [3, 3]CHAR;

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

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

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

CHAR empty = "_";

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

#  these two functions assume that the number has not already been found #
PROC avail slice = (REF[]CHAR slice, REF AVAIL available)REF AVAIL:(
        FOR ele FROM LWB slice TO UPB slice DO
                IF slice[ele] /= empty THEN available-:=slice[ele] FI
        OD;
        available
);
 
PROC avail box = (INT x, y, REF AVAIL available)REF AVAIL:(
        #  x designates row, y designates column #
        #  get a base index for the boxes #
        INT bx := x - (x-1) MOD 3;
        INT by := y - (y-1) MOD 3;
        REF BOX box = puzzle[bx:bx+2, by:by+2];
        FOR i FROM LWB box TO UPB box DO
          FOR j FROM 2 LWB box TO 2 UPB box DO
                IF box[i, j] /= empty THEN available-:=box[i, j] FI
          OD
        OD;
        available
);
 
[9, 9]CHAR puzzle;
PROC solve = ([,]CHAR in puzzle)VOID:(
        puzzle := in puzzle;
        TO UPB puzzle UP 2 DO
                BOOL done := TRUE;
                FOR i FROM LWB puzzle TO UPB puzzle DO
                  FOR j FROM 2 LWB puzzle TO 2 UPB puzzle DO 
                    CHAR ele := puzzle[i, j];
                    IF ele = empty THEN
                        #  poke at the elements that are "_" #
                        AVAIL remaining := avail box(i, j, 
                                           avail slice(puzzle[i, ], 
                                           avail slice(puzzle[, j], 
                                           LOC AVAIL := gen full)));
                        STRING s = REPR remaining;
                        IF UPB s = 1 THEN puzzle[i, j] := s[LWB s]
                        ELSE done := FALSE
                        FI
                    FI
                  OD
                OD;
                IF done THEN break FI
        OD;
break:
        #  write out completed puzzle #
        printf(($gl$, "Completed puzzle:"));
        printf((puzzle fmt, puzzle))
);
main:(
   solve(("394__267_",
          "___3__4__",
          "5__69__2_",
          "_45___9__",
          "6_______7",
          "__7___58_",
          "_1__67__8",
          "__9__8___",
          "_264__735"))
CO # note: This codes/algorithm does not [yet] solve: #
   solve(("9__2__5__",
          "_4__6__3_",
          "__3_____6",
          "___9__2__",
          "____5__8_",
          "__7__4__3",
          "7_____1__",
          "_5__2__4_",
          "__1__6__9"))
END CO
)
Output:
Completed puzzle:
+-------+-------+-------+
| 3 9 4 | 8 5 2 | 6 7 1 |
| 2 6 8 | 3 7 1 | 4 5 9 |
| 5 7 1 | 6 9 4 | 8 2 3 |
+-------+-------+-------+
| 1 4 5 | 7 8 3 | 9 6 2 |
| 6 8 2 | 9 4 5 | 3 1 7 |
| 9 3 7 | 1 2 6 | 5 8 4 |
+-------+-------+-------+
| 4 1 3 | 5 6 7 | 2 9 8 |
| 7 5 9 | 2 3 8 | 1 4 6 |
| 8 2 6 | 4 1 9 | 7 3 5 |
+-------+-------+-------+

AutoHotkey

#SingleInstance, Force
SetBatchLines, -1
SetTitleMatchMode, 3

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

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

GuiClose:
    ExitApp

Again:
    Reload

#IfWinActive, Sudoku Solver
~*Enter::GoSub % GetKeyState( "Shift", "P" ) ? "~Up" : "~Down"
~Up::
    GuiControlGet, f, focus
    StringTrimLeft, f, f, 4
    f := ((f >= 1 && f <= 9) ? f+72 : f-9)
    GuiControl, Focus, Edit%f%
return
~Down::
    GuiControlGet, f, focus
    StringTrimLeft, f, f, 4
    f := ((f >= 73 && f <= 81) ? f-72 : f + 9)
    GuiControl, Focus, Edit%f%
return
~Left::
    GuiControlGet, f, focus
    StringTrimLeft, f, f, 4
    f := Mod(f + 79, 81) + 1
    GuiControl, Focus, Edit%f%
return
Next:
~Right::
    GuiControlGet, f, focus
    StringTrimLeft, f, f, 4
    f := Mod(f, 81) + 1
    GuiControl, Focus, Edit%f%
return
#IfWinActive

; Functions Start here

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

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

AWK

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

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

BBC BASIC

      VDU 23,22,453;453;8,20,16,128
      *FONT Arial,28
      
      DIM Board%(8,8)
      Board%() = %111111111
      
      FOR L% = 0 TO 9:P% = L%*100
        LINE 2,P%+2,902,P%+2
        IF (L% MOD 3)=0 LINE 2,P%,902,P% : LINE 2,P%+4,902,P%+4
        LINE P%+2,2,P%+2,902
        IF (L% MOD 3)=0 LINE P%,2,P%,902 : LINE P%+4,2,P%+4,902
      NEXT
      
      DATA "  4 5  6 "
      DATA " 6 1  8 9"
      DATA "3    7   "
      DATA " 8    5  "
      DATA "   4 3   "
      DATA "  6    7 "
      DATA "   2    6"
      DATA "1 5  4 3 "
      DATA " 2  7 1  "
      
      FOR R% = 8 TO 0 STEP -1
        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%

BCPL

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

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

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

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

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

// A typical problem is:

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

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

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

SECTION "sudoku"

GET "libhdr"

GLOBAL { count:ug

// The 9x9 board

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

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

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

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

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

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

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

  newline()

//abort(1000)
}

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

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

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

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

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

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

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

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

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

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

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

Befunge

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

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

Bracmat

The program:

{sudokuSolver.bra

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

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

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

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

Solution:

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

C

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

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

#include <stdio.h>

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

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

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

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

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

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

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

	x[pos] = 0;
	return 0;
}

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

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

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

	return 0;
}

C#

Backtracking

Translation of: Java
using System;

class SudokuSolver
{
    private int[] grid;

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

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

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

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

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

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

Best First Search

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

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

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

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

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

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

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

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

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

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

        private static CacheGrid Parse(string input) =>
            input
            .Select((c, i) => (index: i, val: int.Parse(c.ToString())))
            .GroupBy(id => id.index / 9)
            .Select(grp => grp.Select(id => id.val).ToArray())
            .ToArray()
            .Fwd(grid => new CacheGrid(grid, new Cache()));
            
        public static string AsString(this int[][] grid) =>
            string.Join('\n', grid.Select(row => string.Concat(row)));

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

Usage

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

namespace SodukoFastMemoBFS {
    static class Program {

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

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

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

Output

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

Solver

using Microsoft.SolverFoundation.Solvers;

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

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

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

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

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

Produces:

975 342 861
861 759 432
324 168 957

219 584 673
487 236 519
653 971 284

738 425 196
592 613 748
146 897 325

"Dancing Links"/Algorithm X

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

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

    private DLX dlx;

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

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

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

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

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

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

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

}

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

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

    public void AddHeader() {
        Header h = new Header(root.Left, root);
        h.AttachLeftRight();
        columns.Add(h);
    }

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    }

    private class Header : Node
    {
        public Header(Node left, Node right) : base(left, right, null, null, null, -1) { }
        
        public int Size { get; set; }
    }

}

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

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

C++

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

class SudokuSolver {
private:
    int grid[81];

public:

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

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

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

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

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

};

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

Clojure

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

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

(defn solve [m]
  (let [c (count m)]
    (loop [m m, x 0, y 0]
      (if (= y c) m
        (let [ng (->> (range 1 c)
                      (filter #(compatible? m x y %))
                      first
                      (assoc-in m [y x]))]
          (if (= x (dec c))
            (recur ng 0 (inc y))
            (recur ng (inc x) y)))))))
sudoku>(cl-format true "~{~{~a~^ ~}~%~}"
 (solve [[3 9 4 0 0 2 6 7 0]
         [0 0 0 3 0 0 4 0 0]
         [5 0 0 6 9 0 0 2 0]
         [0 4 5 0 0 0 9 0 0]
         [6 0 0 0 0 0 0 0 7]
         [0 0 7 0 0 0 5 8 0]
         [0 1 0 0 6 7 0 0 8]
         [0 0 9 0 0 8 0 0 0]
         [0 2 6 4 0 0 7 3 5]])
3  9  4  8  5  2  6  7  1  
2  6  8  3  7  1  4  5  9  
5  7  1  6  9  4  8  2  3  
1  4  5  7  8  3  9  6  2  
6  8  2  9  4  5  3  1  7  
9  3  7  1  2  6  5  8  4  
4  1  3  5  6  7  2  9  8  
7  5  9  2  3  8  1  4  6  
8  2  6  4  1  9  7  3  5  

nil

Common Lisp

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

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

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

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

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

(defun solve (grid &optional (row 0) (column 0))
  (cond
   ((= row 9)
    grid)
   ((= column 9)
    (solve grid (1+ row) 0))
   ((not (eq '_ (aref grid row column)))
    (solve grid row (1+ column)))
   (t (dolist (choice (choices row column grid) (setf (aref grid row column) '_))
        (setf (aref grid row column) choice)
        (when (eq grid (solve grid row (1+ column)))
          (return grid))))))

Example:

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

> (pprint (solve *puzzle*))

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

Crystal

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

GRID_SIZE = 9

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

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

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

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

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

printBoard(board)
if(solveBoard(board))
  printBoard(board)
end
Output:
702|050|600
000|003|000
100|009|500
-----------
800|000|090
043|000|750
090|000|008
-----------
009|700|005
000|200|000
007|040|203

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

Curry

Copied from Curry: Example Programs.

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

import CLPFD
import List

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

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

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

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

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

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

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

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


Alternative version

Works with: PAKCS

Minimal w/o read or show utilities.

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


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

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


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

D

Translation of: C++

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

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

struct Digit {
    immutable char d;

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

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

    alias d this;
}

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


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

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

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

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

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

        return true;
    }

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

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

        return false;
    }

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

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

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

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

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

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

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

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

Short Version

Adapted from: http://code.activestate.com/recipes/576725-brute-force-sudoku-solver/

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

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

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

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

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

No-Heap Version

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

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

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

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

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

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

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

Same output.

Delphi

Example taken from C++

type
  TIntArray = array of Integer;

  { TSudokuSolver }

  TSudokuSolver = class
  private
    FGrid: TIntArray;

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

    procedure Solve;
  end;

implementation

uses
  Dialogs;

{ TSudokuSolver }

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

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

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

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

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

Usage:

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

DuckDB

Works with: DuckDB version V1.0
Works with: DuckDB version V1.1

The focus of this entry is the adaptation of the "all-solutions" program at #SQL on this page, with a focus on identifying any issues that are likely to be of interest to others adapting similar programs originally targeted for Oracle SQL.

In brief, the syntactic changes were minor, but DuckDB does not have a built-in equivalent of instr/3. Although it was easy enough to write a DuckDB function (here named instr3) to provide identical functionality, this function is probably not as efficient as one would like.

The only other changes compared to the version for Oracle are as follows:

  • RECURSIVE keyword added;
  • DuckDB does not have the 'CONNECT BY' construct, so range() is used to initialize the `symbols` and `board` tables;
  • DuckDB does not support the 'DUAL' table;
  • getvariable('game') used instead of `:game`.

Note on DuckDB compatibility

The use of getvariable() presupposes the availability of DuckDB V1.1 but is inessential. The program will run under DuckDB V1.0 if the following is substituted for the `SET VARIABLE` line:

create or replace function getvariable(foo) as (
  '85   24  72      9  4         1 7  23 5   9   4           8  7  17          36 4 '
);
# An example
.maxwidth 100
set variable game='85   24  72      9  4         1 7  23 5   9   4           8  7  17          36 4 ';

create or replace function instr3(s,t,j) as (
  select case when n = 0 then 0
              else n + j - 1
         end
  from (select instr(substr(s,j), t) as n)
);

with recursive
  symbols (d) as (select level::VARCHAR from range(1,10) t(level) )
, board   (i) as (select level          from range(1,82) t(level) )
, neighbors (i, j) as (
    select b1.i, b2.i
    from   board b1 inner join board b2
      on   b1.i != b2.i
           and (
                    mod(b1.i - b2.i, 9) = 0
                 or ceil(b1.i /  9) = ceil(b2.i /  9)
                 or ceil(b1.i / 27) = ceil(b2.i / 27) and trunc(mod(b1.i - 1, 9) / 3) = trunc(mod(b2.i - 1, 9) / 3)
               )
  )
, r (str, pos) as (
    select  getvariable('game'), instr(getvariable('game'), ' ')

    union all
    select  substr(r.str, 1, r.pos - 1) || s.d || substr(r.str, r.pos + 1), instr3(r.str, ' ', r.pos + 1)
      from  r inner join symbols s
        on  r.pos > 0 and not exists (
                                       select *
                                       from   neighbors n
                                       where  r.pos = n.i and s.d = substr(r.str, n.j, 1)
                                     )
  )
select str
from   r
where  pos = 0
;
Output:
100% ▕████████████████████████████████████████████████████████████▏ 
┌───────────────────────────────────────────────────────────────────────────────────┐
│                                        str                                        │
│                                      varchar                                      │
├───────────────────────────────────────────────────────────────────────────────────┤
│ 859612437723854169164379528986147352375268914241593786432981675617425893598736241 │
└───────────────────────────────────────────────────────────────────────────────────┘

EasyLang

len row[] 90
len col[] 90
len box[] 90
len grid[] 82
# 
proc init . .
   for pos = 1 to 81
      if pos mod 9 = 1
         s$ = input
         if s$ = ""
            s$ = input
         .
         len inp[] 0
         for i = 1 to len s$
            if substr s$ i 1 <> " "
               inp[] &= number substr s$ i 1
            .
         .
      .
      dig = number inp[(pos - 1) mod 9 + 1]
      if dig > 0
         grid[pos] = dig
         r = (pos - 1) div 9
         c = (pos - 1) 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
      .
   .
.
init
# 
proc display . .
   for i = 1 to 81
      write grid[i] & " "
      if i mod 3 = 0
         write " "
      .
      if i mod 9 = 0
         print ""
      .
      if i mod 27 = 0
         print ""
      .
   .
.
# 
proc solve pos . .
   while grid[pos] <> 0
      pos += 1
   .
   if pos > 81
      # solved
      display
      return
   .
   r = (pos - 1) div 9
   c = (pos - 1) 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
         solve pos + 1
         row[r + d] = 0
         col[c + d] = 0
         box[b + d] = 0
      .
   .
   grid[pos] = 0
.
solve 1
# 
input_data
5 3 0  0 2 4  7 0 0
0 0 2  0 0 0  8 0 0
1 0 0  7 0 3  9 0 2

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

0 0 0  0 3 0  5 0 6
9 6 0  0 1 0  3 0 0
0 5 0  6 9 0  0 1 0

Elixir

Translation of: Erlang
defmodule Sudoku do
  def display( grid ), do: ( for y <- 1..9, do: display_row(y, grid) )
  
  def start( knowns ), do: Enum.into( knowns, Map.new )
  
  def solve( grid ) do
    sure = solve_all_sure( grid )
    solve_unsure( potentials(sure), sure )
  end
  
  def task( knowns ) do
    IO.puts "start"
    start = start( knowns )
    display( start )
    IO.puts "solved"
    solved = solve( start )
    display( solved )
    IO.puts ""
  end
  
  defp bt( grid ), do: bt_reject( is_not_allowed(grid), grid )
  
  defp bt_accept( true, board ), do: throw( {:ok, board} )
  defp bt_accept( false, grid ), do: bt_loop( potentials_one_position(grid), grid )
  
  defp bt_loop( {position, values}, grid ), do: ( for x <- values, do: bt( Map.put(grid, position, x) ) )
  
  defp bt_reject( true, _grid ), do: :backtrack
  defp bt_reject( false, grid ), do: bt_accept( is_all_correct(grid), grid )
  
  defp display_row( row, grid ) do
    for x <- [1, 4, 7], do: display_row_group( x, row, grid )
    display_row_nl( row )
  end
  
  defp display_row_group( start, row, grid ) do
    Enum.each(start..start+2, &IO.write " #{Map.get( grid, {&1, row}, ".")}")
    IO.write " "
  end
  
  defp display_row_nl( n ) when n in [3,6,9], do: IO.puts "\n"
  defp display_row_nl( _n ), do: IO.puts ""
  
  defp is_all_correct( grid ), do: map_size( grid ) == 81
  
  defp is_not_allowed( grid ) do
    is_not_allowed_rows( grid ) or is_not_allowed_columns( grid ) or is_not_allowed_groups( grid )
  end
  
  defp is_not_allowed_columns( grid ), do: values_all_columns(grid) |> Enum.any?(&is_not_allowed_values/1)
  
  defp is_not_allowed_groups( grid ),  do: values_all_groups(grid)  |> Enum.any?(&is_not_allowed_values/1)
  
  defp is_not_allowed_rows( grid ),    do: values_all_rows(grid)    |> Enum.any?(&is_not_allowed_values/1)
  
  defp is_not_allowed_values( values ), do: length( values ) != length( Enum.uniq(values) )
  
  defp group_positions( {x, y} ) do
    for colum <- group_positions_close(x), row <- group_positions_close(y), do: {colum, row}
  end
  
  defp group_positions_close( n ) when n < 4, do: [1,2,3]
  defp group_positions_close( n ) when n < 7, do: [4,5,6]
  defp group_positions_close( _n )          , do: [7,8,9]
  
  defp positions_not_in_grid( grid ) do
    keys = Map.keys( grid )
    for x <- 1..9, y <- 1..9, not {x, y} in keys, do: {x, y}
  end
  
  defp potentials_one_position( grid ) do
    Enum.min_by( potentials( grid ), fn {_position, values} -> length(values) end )
  end
  
  defp potentials( grid ), do: List.flatten( for x <- positions_not_in_grid(grid), do: potentials(x, grid) )
  
  defp potentials( position, grid ) do
    useds = potentials_used_values( position, grid )
    {position, Enum.to_list(1..9) -- useds }
  end
  
  defp potentials_used_values( {x, y}, grid ) do
    row_values    = (for row <- 1..9, row != x, do: {row, y})          |> potentials_values( grid )
    column_values = (for column <- 1..9, column != y, do: {x, column}) |> potentials_values( grid )
    group_values  = group_positions({x, y}) -- [ {x, y} ]              |> potentials_values( grid )
    row_values ++ column_values ++ group_values
  end
  
  defp potentials_values( keys, grid ) do
    for x <- keys, val = grid[x], do: val
  end
  
  defp values_all_columns( grid ) do
    for x <- 1..9, do:
      ( for y <- 1..9, do: {x, y} ) |> potentials_values( grid )
  end
  
  defp values_all_groups( grid ) do
    [[g1,g2,g3], [g4,g5,g6], [g7,g8,g9]] = for x <- [1,4,7], do: values_all_groups(x, grid)
    [g1,g2,g3,g4,g5,g6,g7,g8,g9]
  end
  
  defp values_all_groups( x, grid ) do
    for x_offset <- x..x+2, do: values_all_groups(x, x_offset, grid)
  end
  
  defp values_all_groups( _x, x_offset, grid ) do
    ( for y_offset <- group_positions_close(x_offset), do: {x_offset, y_offset} )
    |> potentials_values( grid )
  end
  
  defp values_all_rows( grid ) do
    for y <- 1..9, do:
      ( for x <- 1..9, do: {x, y} ) |> potentials_values( grid )
  end
  
  defp solve_all_sure( grid ), do: solve_all_sure( solve_all_sure_values(grid), grid )
  
  defp solve_all_sure( [], grid ), do: grid
  defp solve_all_sure( sures, grid ) do
    solve_all_sure( Enum.reduce(sures, grid, &solve_all_sure_store/2) )
  end
  
  defp solve_all_sure_values( grid ), do: (for{position, [value]} <- potentials(grid), do: {position, value} )
  
  defp solve_all_sure_store( {position, value}, acc ), do: Map.put( acc, position, value )
  
  defp solve_unsure( [], grid ), do: grid
  defp solve_unsure( _potentials, grid ) do
    try do
      bt( grid )
    catch
      {:ok, board} -> board
    end
  end
end
  
simple = [{{1, 1}, 3}, {{2, 1}, 9}, {{3, 1},4}, {{6, 1}, 2}, {{7, 1}, 6}, {{8, 1}, 7},
          {{4, 2}, 3}, {{7, 2}, 4},
          {{1, 3}, 5}, {{4, 3}, 6}, {{5, 3}, 9}, {{8, 3}, 2},
          {{2, 4}, 4}, {{3, 4}, 5}, {{7, 4}, 9},
          {{1, 5}, 6}, {{9, 5}, 7},
          {{3, 6}, 7}, {{7, 6}, 5}, {{8, 6}, 8},
          {{2, 7}, 1}, {{5, 7}, 6}, {{6, 7}, 7}, {{9, 7}, 8},
          {{3, 8}, 9}, {{6, 8}, 8},
          {{2, 9}, 2}, {{3, 9}, 6}, {{4, 9}, 4}, {{7, 9}, 7}, {{8, 9}, 3}, {{9, 9}, 5}]
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 )
Output:
start
 3 9 4  . . 2  6 7 .
 . . .  3 . .  4 . .
 5 . .  6 9 .  . 2 .

 . 4 5  . . .  9 . .
 6 . .  . . .  . . 7
 . . 7  . . .  5 8 .

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

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

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

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


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

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

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

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

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

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

Erlang

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

-module( sudoku ).

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

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

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

task() ->
	Simple = [{{1, 1}, 3}, {{2, 1}, 9}, {{3, 1},4}, {{6, 1}, 2}, {{7, 1}, 6}, {{8, 1}, 7},
		{{4, 2}, 3}, {{7, 2}, 4},
		{{1, 3}, 5}, {{4, 3}, 6}, {{5, 3}, 9}, {{8, 3}, 2},
		{{2, 4}, 4}, {{3, 4}, 5}, {{7, 4}, 9},
		{{1, 5}, 6}, {{9, 5}, 7},
		{{3, 6}, 7}, {{7, 6}, 5}, {{8, 6}, 8},
		{{2, 7}, 1}, {{5, 7}, 6}, {{6, 7}, 7}, {{9, 7}, 8},
		{{3, 8}, 9}, {{6, 8}, 8},
		{{2, 9}, 2}, {{3, 9}, 6}, {{4, 9}, 4}, {{7, 9}, 7}, {{8, 9}, 3}, {{9, 9}, 5}],
	task( Simple ),
	Difficult = [{{6, 2}, 3}, {{8, 2}, 8}, {{9, 2}, 5},
		{{3, 3}, 1}, {{5, 3}, 2},
		{{4, 4}, 5}, {{6, 4}, 7},
		{{3, 5}, 4}, {{7, 5}, 1},
		{{2, 6}, 9},
		{{1, 7}, 5}, {{8, 7}, 7}, {{9, 7}, 3},
		{{3, 8}, 2}, {{5, 8}, 1},
		{{5, 9}, 4}, {{9, 9}, 9}],
	task( Difficult ).



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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    catch
    _:{ok, Board} -> Board

    end.

task( Knowns ) ->
	io:fwrite( "Start~n" ),
	Start = start( Knowns ),
	display( Start ),
	io:fwrite( "Solved~n" ),
	Solved = solve( Start ),
	display( Solved ),
	io:nl().
Output:
5> sudoku:task().
Start
 3 9 4  . . 2  6 7 . 
 . . .  3 . .  4 . . 
 5 . .  6 9 .  . 2 . 

 . 4 5  . . .  9 . . 
 6 . .  . . .  . . 7 
 . . 7  . . .  5 8 . 

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

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

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

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


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

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

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

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

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

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

ERRE

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

Example of SUDOKU.TXT

503600009

010002600

900000080

000700005

006804100

200003000

030000008

004300050

800006702

0 is the empty cell.

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

PROGRAM SUDOKU

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

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

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

!$INCLUDE="PC.LIB"

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

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

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


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

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

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

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

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

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

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

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

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

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

!.... e infine i quadranti
     FOR QUADRANTE=1 TO 9 DO
         ZZ$=""
         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

F#

Backtracking

module SudokuBacktrack

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

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

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

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

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

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

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

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

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

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

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

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

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

Usage:

open System
open SudokuBacktrack 

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

     printfn "Press any key to exit"
     Console.ReadKey() |> ignore
     0
Output:

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

Constraint Satisfaction (Norvig)

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

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

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

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

/// List of all row, cols and boxes:  aka units
let unitlist = 
    [for c in cols -> cross rows [|c|] ]@
    [for r in rows -> cross [|r|] cols ]@
    [for rs in boxi do for cs in boxi do cross rs cs ]
   
/// Dictionary of units for each square
let units = 
    [|for s in squares do [| for u in unitlist do if u |> Array.contains s then u |] |] 
    
/// Dictionary of all peer squares in the relevant units wrt square in question
let peers = 
    [| for s in squares do units[s] |> Array.concat |> Array.distinct |> Array.except [s] |] 

/// folds folder returning Some on completion or returns None if not
let rec all folder state source = 
    match state, source with
    | None, _ -> None 
    | Some st, [] -> Some st
    | Some st , hd::rest -> folder st hd |> (fun st1 -> all folder st1 rest)

/// Assign digit d to values[s] and propagate (via eliminate)
/// Return Some values, except None if a contradiction is detected.
let rec assign (values:int[][]) (s) d =
    values[s]
    |> Array.filter ((<>)d)
    |> List.ofArray |> all (fun vx d1 -> eliminate vx s d1) (Some values) 
    
/// Eliminate digit d from values[s] and propagate when values[s] size is 1.
/// Return Some values, except return None if a contradiction is detected.
and eliminate (values:int[][]) s d =  
    let peerElim (values1:int[][]) = // If a square s is reduced to one value d, then *eliminate* d from the peers. 
        match Seq.length values1[s] with 
        | 0 -> None // contradiction - removed last value
        | 1 -> peers[s] |> List.ofArray |> all (fun vx1 s1 ->  eliminate vx1 s1 (values1[s] |> Seq.head) ) (Some values1)
        | _ -> Some values1
    
    let unitsElim values1 = // If a unit u is reduced to only one place for a value d, then *assign* it there.
        units[s] 
        |> List.ofArray 
        |> all (fun (vx1:int[][]) u -> 
           let sx = [for s in u do if vx1[s] |> Seq.contains d then s] 
           match Seq.length sx with
           | 0 -> None
           | 1 -> assign vx1 (Seq.head sx) d
           | _ -> Some vx1) (Some values1) 

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

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

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

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

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

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

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

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

let run n g f = parseGrid >> function None -> n | Some m -> f m |> g 
let solver = run "Parse Error" (Option.fold (fun _ t -> t |> prettyPrint) "No Solution")
let solveNoSearch: string -> string = solver applyCPS    
let solveWithSearch: string -> string = solver (applyCPS >> (Option.bind search)) 
let solveWithSearchToMapOnly:string -> int[][] option = run None id (applyCPS >> (Option.bind search))

Usage

open System
open SudokuCPSArray
open System.Diagnostics
open System.IO

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

     printfn "Simple elimination not possible"
     let simple = "4.....8.5.3..........7......2.....6.....8.4......1.......6.3.7.5..2.....1.4......"
     simple |> run "Parse Error" asString id |> printfn "%s"
     simple |> solveNoSearch |> printfn "%s"
          
     printfn "Try again with search:"
     simple |> solveWithSearch |> printfn "%s"
    
     let watch = Stopwatch()

     let hard = "85...24..72......9..4.........1.7..23.5...9...4...........8..7..17..........36.4."
     printfn "Hard"
     watch.Start()
     hard |> solveWithSearch |> printfn "%s"
     watch.Stop()
     printfn $"Elapsed milliseconds = {watch.ElapsedMilliseconds } ms"
     watch.Reset()
     
     let puzzles  = 
        if Seq.length argv = 1 then 
            let num = argv[0] |> int
            printfn $"First {num} puzzles in sudoku17 (http://staffhome.ecm.uwa.edu.au/~00013890/sudoku17)"     
            File.ReadLines(@"sudoku17.txt") |> Seq.take num |>Array.ofSeq
        else 
            printfn $"All puzzles in sudoku17 (http://staffhome.ecm.uwa.edu.au/~00013890/sudoku17)"     
            File.ReadLines(@"sudoku17.txt") |>Array.ofSeq
     watch.Start()
     let result = puzzles |> Array.map solveWithSearchToMapOnly
     watch.Stop()
     if result |> Seq.forall Option.isSome then
        let total = watch.ElapsedMilliseconds
        let avg = (float total) /(float result.Length)
        printfn $"\nPuzzles:{result.Length}, Total:%.2f{((float)total)/1000.0} s, Average:%.2f{avg} ms"
     else
        printfn "Some sudoku17 puzzles failed"
     Console.ReadKey() |> ignore
     0
Output:

Timings run on i7500U @2.75Ghz CPU, 16GB RAM

Easy board solution automatic with constraint propagation

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

Simple elimination not possible 400000805030000000000700000020000060000080400000010000000603070500200000104000000

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

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

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

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

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

SLPsolve

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

Usage: Given sud1.csv:

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

then

let n=SLPsolve (fE ([1..9]|>List.map(string)) 9 3 3 "sud1.csv")
printSLP ([1..9]|>List.map(string)) (Seq.item 0 n)
Output:
7|1|8|4|3|6|9|2|5|
5|6|2|9|7|8|4|1|3|
4|3|9|5|2|1|6|8|7|
6|8|5|7|1|3|2|4|9|
3|9|1|2|4|5|7|6|8|
2|4|7|8|6|9|5|3|1|
8|2|6|1|5|7|3|9|4|
9|5|4|3|8|2|1|7|6|
1|7|3|6|9|4|8|5|2|

Forth

Works with: 4tH version 3.60.0
include lib/interprt.4th
include lib/istype.4th
include lib/argopen.4th

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

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

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

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

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

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

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


\ Grid Related

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

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

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

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

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

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

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

\ Adds number to grid and sets
: addnumber                            \ number position --
    2dup setnumber
    2dup getrow addbits_row
    2dup getcol addbits_col
         getbox addbits_box
;

\ Remove number from grid, and sets
: removenumber                         \ position --
    dup getnumber swap    
    2dup getrow removebits_row
    2dup getcol removebits_col
    2dup getbox removebits_box
    nip 0 swap setnumber
;

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

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

\ position -- composite bitmap  (or'ed)
: getbits
    dup getrow_bits
    over getcol_bits
    rot getbox_bits or or
;

\ algorithm from c.l.f circa 1995 ? Will Baden
: countbits    ( number -- bits )
        [HEX] DUP  55555555 AND  SWAP  1 RSHIFT  55555555 AND  +
              DUP  33333333 AND  SWAP  2 RSHIFT  33333333 AND  +
              DUP  0F0F0F0F AND  SWAP  4 RSHIFT  0F0F0F0F AND  +
        [DECIMAL] 255 MOD
;

\ Try tests a number in a said position of grid
\ Returns true if it's possible, else false.
: try                                  \ number position -- true/false
      getbits 1 rot lshift and 0=
;

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

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

: morespaces?
     0  sudokugrid 81 bounds do i c@  0= if 1+ then loop ;

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

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

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

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

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

             else                      \ else prev_possibilities < new possibilities, so:

                 drop                  \ new_index new_possibilies --        

             then                
      THEN
   loop
   drop
;

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

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

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

     drop FALSE
;

\ SOLVER

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

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

\ Prints grid nicely

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

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

: checkifoccupied                      ( offset -- t/f)
    sudokugrid + c@
;

: add                                  ( n x y --)
    xy 2dup
      dup checkifoccupied if
        dup removenumber
      then
    try if
      addnumber
      .sudokugrid
    else
      CR ." Not a valid move. " CR
      2drop
    then
;

: rm
    xy removenumber
    .sudokugrid
;

: clearit
    cleargrid
    clearbitmaps
    .sudokugrid
;

: solveit
  CR 
  startsolving
  if
    ." Solution found!" CR .sudokugrid
  else
    ." No solution found!" CR CR
  then
;

: showit .sudokugrid ;

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

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

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

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

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

: bye quit ;

create wordlist                        \ dictionary
  ," clearit" ' clearit ,
  ," add"     ' add ,
  ," rm"      ' rm ,
  ," showit"  ' showit ,
  ," solveit" ' solveit ,
  ," quit"    ' bye ,
  ," exit"    ' bye ,
  ," bye"     ' bye ,
  ," q"       ' bye ,
  ," help"    ' help ,
  NULL ,

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

sudoku

Fortran

Works with: Fortran version 90 and later

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

program sudoku

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

contains

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

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

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

end program sudoku
Output:

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

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


FreeBASIC

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

Function isSafe(i As Integer, j As Integer, n As Integer) As Boolean
    Dim As Integer iMin, jMin, f, c
    
    If cuadricula(i, j) <> 0 Then Return (cuadricula(i, j) = n)
    
    'cuadricula(i, j) es una celda vacía. Compruebe si n está OK
    'primero revisa la fila i
    For f = 1 To 9
        If cuadricula(i, f) = n Then Return False
    Next f
    
    'ahora comprueba la columna j
    For c = 1 To 9
        If cuadricula(c, j) = n Then Return False
    Next c
    
    '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
Output:
Solucion:
---------+---------+---------
 6  3  1 | 2  4  5 | 9  7  8
 9  2  5 | 6  7  8 | 1  4  3
 4  7  8 | 3  1  9 | 6  5  2
---------+---------+---------
 7  9  6 | 5  2  3 | 4  8  1
 1  8  2 | 9  6  4 | 5  3  7
 3  5  4 | 7  8  1 | 2  9  6
---------+---------+---------
 8  6  7 | 4  9  2 | 3  1  5
 2  4  3 | 1  5  7 | 8  6  9
 5  1  9 | 8  3  6 | 7  2  4
---------+---------+---------


FutureBasic

First is a short version:

include "Util_Containers.incl"

begin globals
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

short solution
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

HandleEvents

Output:

Sudoku challenge:

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


Sudoku solved:

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

More code in this one, but faster execution:

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

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

Board quiz
CFTimeInterval t
end globals


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

local fn prepare( b as ^Board )
  short i, j, n
  
  for i = 1 to _digits
    for j = 1 to _digits
      for n = 1 to _digits
        b.match[i, j] = 0
        b.f[i, j, n] = _true
      next n
    next j
  next i
end fn

local fn printBoard( b as ^Board )
  short i, j
  
  for i = 1 to _digits
    for j = 1 to _digits
      Print b.match[i, j];
    next j
    print
  next i
end fn

local fn verifica( b as ^Board )
  short i, j, n, first, x, y, ii
  Boolean check
  
  check = _true
  
  for i = 1 to _digits
    for j = 1 to _digits
      if ( b.match[i, j] == 0 )
        check = _false
        for n = 1 to _digits
          if ( b.f[i, j, n] != _false )
            check = _true
          end if
        next n
        if ( check == _false ) then exit fn
      end if
    next j
  next i
  
  check = _true
  for j = 1 to _digits
    for n = 1 to _digits
      first = 0
      for i = 1 to _digits
        if ( b.match[i, j] == n )
          if ( first == 0 )
            first = i
          else
            check = _false
            exit fn
          end if
        end if
      next i
    next n
  next j
  
  for i = 1 to _digits
    for n = 1 to _digits
      first = 0
      for j = 1 to _digits
        if ( b.match[i, j] == n )
          if ( first == 0 )
            first = j
          else
            check = _false
            exit fn
          end if
        end if
      next j
    next n
  next i
  
  for x = 0 to ( _nSetH - 1 )
    for y = 0 to ( _nSetV - 1 )
      first = 0
      for ii = 0 to ( _digits - 1 )
        i = x * _setH + ii mod _setH + 1
        j = y * _setV + ii / _setH + 1
        if ( b.match[i, j] == n )
          if ( first == 0 )
            first = j
          else
            check = _false
            exit fn
          end if
        end if
      next ii
    next y
  next x
  
end fn = check


local fn setCell( b as ^Board, x as short, y as short, n as short) as boolean
  short   i, j, rx, ry
  Boolean check
  
  b.match[x, y] = n
  for i = 1 to _digits
    b.f[x, i, n] = _false
    b.f[i, y, n] = _false
  next i
  
  rx = (x - 1) / _setH
  ry = (y - 1) / _setV
  
  for i = 1 to _setH
    for j = 1 to _setV
      b.f[ rx * _setH + i, ry * _setV + j, n ] = _false
    next j
  next i
  
  check = fn verifica( #b )
  if ( check == _false ) then exit fn
  
end fn = check


local fn solve( b as ^Board )
  short i, j, n, first, x, y, ii, ppi, ppj
  Boolean check
  
  check = _true
  
  for i = 1 to _digits
    for j = 1 to _digits
      if ( b.match[i, j] == 0 )
        first = 0
        for n = 1 to _digits
          if ( b.f[i, j, n] != _false )
            if ( first == 0 )
              first = n
            else
              first = -1
              exit for
            end if
          end if
        next n
        
        if ( first > 0 )
          check = fn setCell( #b, i, j, first )
          if ( check == _false ) then exit fn
          check = fn solve(#b)
          if ( check == _false ) then exit fn
        end if
        
      end if
    next j
  next i
  
  for i = 1 to _digits
    for n = 1 to _digits
      first = 0
      
      for j = 1 to _digits
        if ( b.match[i, j] == n ) then exit for
        
        if ( b.f[i, j, n] != _false ) and ( b.match[i, j] == 0 )
          if ( first == 0 )
            first = j
          else
            first = -1
            exit for
          end if
          
        end if
        
      next j
      
      if ( first > 0 )
        check = fn setCell( #b, i, first, n )
        if ( check == _false ) then exit fn
        check = fn solve(#b)
        if ( check == _false ) then exit fn
      end if
      
    next n
  next i
  
  
  for j = 1 to _digits
    for n = 1 to _digits
      first = 0
      
      for i = 1 to _digits
        if ( b.match[i, j] == n ) then exit for
        
        if ( b.f[i, j, n] != _false ) and ( b.match[i, j] == 0 )
          if ( first == 0 )
            first = i
          else
            first = -1
            exit for
          end if
          
        end if
        
      next i
      
      if ( first > 0 )
        check = fn setCell( #b, first, j, n )
        if ( check == _false ) then exit fn
        check = fn solve(#b)
        if ( check == _false ) then exit fn
      end if
      
    next n
  next j
  
  
  for x = 0 to ( _nSetH - 1 )
    for y = 0 to ( _nSetV - 1 )
      
      for n = 1 to _digits
        first = 0
        
        for ii = 0 to ( _digits - 1 )
          
          i = x * _setH + ii mod _setH + 1
          j = y * _setV + ii / _setH + 1
          
          if ( b.match[i, j] == n ) then exit for
          
          if ( b.f[i, j, n] != _false ) and ( b.match[i, j] == 0 )
            if ( first == 0 )
              first = n
              ppi = i
              ppj = j
            else
              first = -1
              exit for
            end if
          end if
          
          
        next ii
        
        if ( first > 0 )
          check = fn setCell( #b, ppi, ppj, n )
          if ( check == _false ) then exit fn
          check = fn solve(#b)
          if ( check == _false ) then exit fn
        end if
        
      next n
      
    next y
  next x
  
end fn = check


local fn resolve( b as ^Board )
  Boolean check, daFinire
  long i, j, n
  Board localBoard
  
  check = fn solve(b)
  
  if ( check == _false )
    exit fn
  end if
  
  daFinire = _false
  
  for i = 1 to _digits
    for j = 1 to _digits
      if ( b.match[i, j] == 0 )
        
        daFinire = _true
        
        for n = 1 to _digits
          if ( b.f[i, j, n] != _false )
            
            fn CopyBoard( b, @localBoard )
            
            check = fn setCell(@localBoard, i, j, n)
            
            if ( check != _false )
              check = fn resolve( @localBoard )
              if ( check == -1 )
                fn CopyBoard( @localBoard, b )
                
                exit fn
              end if
            end if
            
          end if
          
        next n
        
      end if
    next j
  next i
  
  if daFinire
  else
    check = -1
  end if
  
end fn = check


fn prepare( @quiz )

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

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

Print : print "quiz:"
fn printBoard( @quiz )
print : print "-------------------" : print
Boolean check

t = fn CACurrentMediaTime
check = fn resolve(@quiz)
t = (fn CACurrentMediaTime - t) * 1000

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

HandleEvents

Output:

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

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

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

Go

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

package main

import "fmt"

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

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

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

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

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

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

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

// extracts 81 character sudoku string
func (d *dlx) text() string {
    b := make([]byte, len(d.o))
    for _, r := range d.o {
        x0 := r.x0
        b[x0.c.n] = byte(x0.r.c.n%9) + '1'
    }
    return string(b)
}   
    
// the dlx algorithm 
func (d *dlx) search() bool {
    h := d.h
    j := h.r.c
    if j == h {
        return true
    }
    c := j 
    for minS := j.s; ; {
        j = j.r.c
        if j == h {
            break
        }
        if j.s < minS {
            c, minS = j, j.s
        }
    }

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

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

func uncover(c *y) {
    for i := c.u; i != &c.x; i = i.u {
        for j := i.l; j != i; j = j.l {
            j.c.s++
            j.d.u, j.u.d = j, j
        }
    }
    c.r.l, c.l.r = &c.x, &c.x
}
Output:
puzzle:
3 9 4 |     2 | 6 7  
      | 3     | 4    
5     | 6 9   |   2  
------+-------+------
  4 5 |       | 9    
6     |       |     7
    7 |       | 5 8  
------+-------+------
  1   |   6 7 |     8
    9 |     8 |      
  2 6 | 4     | 7 3 5
solved:
3 9 4 | 8 5 2 | 6 7 1
2 6 8 | 3 7 1 | 4 5 9
5 7 1 | 6 9 4 | 8 2 3
------+-------+------
1 4 5 | 7 8 3 | 9 6 2
6 8 2 | 9 4 5 | 3 1 7
9 3 7 | 1 2 6 | 5 8 4
------+-------+------
4 1 3 | 5 6 7 | 2 9 8
7 5 9 | 2 3 8 | 1 4 6
8 2 6 | 4 1 9 | 7 3 5

Golfscript

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

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

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

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

Groovy

Adaptive "Non-guessing Then Guessing" Solution

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

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

final CELL_VALUES = ('1'..'9')
 
class GridException extends Exception {
    GridException(String message) { super(message) }
}
 
def string2grid = { string ->
    assert string.size() == 81
    (0..8).collect { i -> (0..8).collect { j -> string[9*i+j] } }
}
 
def gridRow = { grid, slot -> grid[slot.i] as Set }
 
def gridCol = { grid, slot -> grid.collect { it[slot.j] } as Set }
 
def gridBox = { grid, slot ->
    def t, l; (t, l) = [slot.i.intdiv(3)*3, slot.j.intdiv(3)*3]
    (0..2).collect { row -> (0..2).collect { col -> grid[t+row][l+col] } }.flatten() as Set
}
 
def slotList = { grid ->
    def slots = (0..8).collect { i -> (0..8).findAll { j -> grid[i][j] == '.' } \
            .collect {j -> [i: i, j: j] } }.flatten()
}
 
def assignCandidates = { grid, slots = slotList(grid) ->
    slots.each { slot ->
        def unavailable = [gridRow, gridCol, gridBox].collect { it(grid, slot) }.sum() as Set
        slot.candidates = CELL_VALUES - unavailable
    }
    slots.sort { - it.candidates.size() }
    if (slots && ! slots[-1].candidates) {
        throw new GridException('Invalid Sudoku Grid, overdetermined slot: ' + slots[-1])
    }
    slots
}
 
def isSolved = { grid -> ! (grid.flatten().find { it == '.' }) }
 
def solve 
solve = { grid ->
    def slots = assignCandidates(grid)
    if (! slots) { return grid }
    while (slots[-1].candidates.size() == 1) {
        def slot = slots.pop()
        grid[slot.i][slot.j] = slot.candidates[0]
        if (! slots) { return grid }
        slots = assignCandidates(grid, slots)
    }
    if (! slots) { return grid } 
    def slot = slots.pop()
    slot.candidates.each {
        if (! isSolved(grid)) {
            try {
                def sGrid = grid.collect { row -> row.collect { cell -> cell } }
                sGrid[slot.i][slot.j] = it
                grid = solve(sGrid)
            } catch (GridException ge) {
                grid[slot.i][slot.j] = '.'
            }
        }
    }
    if (!isSolved(grid)) {
        slots = assignCandidates(grid)
        throw new GridException('Invalid Sudoku Grid, underdetermined slots: ' + slots)
    }
    grid
}

Test/Benchmark Cases

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

def sudokus = [
  //Used in Curry solution:                             ~ 0.1 seconds
    '819..5.....2...75..371.4.6.4..59.1..7..3.8..2..3.62..7.5.7.921..64...9.....2..438',
 
  //Used in Perl and PicoLisp solutions:                ~ 0.1 seconds
    '53..247....2...8..1..7.39.2..8.72.49.2.98..7.79.....8.....3.5.696..1.3...5.69..1.',
 
  //Used in Fortran solution:                           ~ 0.1 seconds
    '..3.2.6..9..3.5..1..18.64....81.29..7.......8..67.82....26.95..8..2.3..9..5.1.3..',
 
  //Used in many other solutions, notably Algol 68:     ~ 0.1 seconds
    '394..267....3..4..5..69..2..45...9..6.......7..7...58..1..67..8..9..8....264..735',
 
  //Used in C# solution:                                ~ 0.2 seconds
    '97.3...6..6.75.........8.5.......67.....3.....539..2..7...25.....2.1...8.4...73..',
 
  //Used in Oz solution:                                ~ 0.2 seconds
    '4......6.5...8.9..3....1....2.7....1.9.....4.8....3.5....2....7..6.5...8.1......6',
 
  //Used in many other solutions, notably C++:          ~ 0.3 seconds
    '85...24..72......9..4.........1.7..23.5...9...4...........8..7..17..........36.4.',
 
  //Used in VBA solution:                               ~ 0.3 seconds
    '..1..5.7.92.6.......8...6...9..2.4.1.........3.4.8..9...7...3.......7.69.1.8..7..',
 
  //Used in Forth solution:                             ~ 0.8 seconds
    '.9...4..7.....79..8........4.58.....3.......2.....97.6........4..35.....2..6...8.',
 
  //3rd "exceptionally difficult" example in Wikipedia: ~ 2.3 seconds
    '12.3....435....1....4........54..2..6...7.........8.9...31..5.......9.7.....6...8',
 
  //Used in Curry solution:                             ~ 2.4 seconds
    '9..2..5...4..6..3...3.....6...9..2......5..8...7..4..37.....1...5..2..4...1..6..9',
 
  //"AL Escargot", so-called "hardest sudoku" (HA!):    ~ 3.0 seconds
    '1....7.9..3..2...8..96..5....53..9...1..8...26....4...3......1..4......7..7...3..',
 
  //1st "exceptionally difficult" example in Wikipedia: ~ 6.5 seconds
    '12.4..3..3...1..5...6...1..7...9.....4.6.3.....3..2...5...8.7....7.....5.......98',
 
  //Used in Bracmat and Scala solutions:                ~ 6.7 seconds
    '..............3.85..1.2.......5.7.....4...1...9.......5......73..2.1........4...9',
 
  //2nd "exceptionally difficult" example in Wikipedia: ~ 8.8 seconds
    '.......39.....1..5..3.5.8....8.9...6.7...2...1..4.......9.8..5..2....6..4..7.....',
 
  //Used in MATLAB solution:                            ~15   seconds
    '....839..1......3...4....7..42.3....6.......4....7..1..2........8...92.....25...6',
 
  //4th "exceptionally difficult" example in Wikipedia: ~29   seconds
    '..3......4...8..36..8...1...4..6..73...9..........2..5..4.7..686........7..6..5..']
 
sudokus.each { sudoku ->
    def grid = string2grid(sudoku)
    println '\nPUZZLE'
    grid.each { println it }
 
    println '\nSOLUTION'
    def start = System.currentTimeMillis()
    def solution = solve(grid)
    def elapsed = (System.currentTimeMillis() - start)/1000
    solution.each { println it }
    println "\nELAPSED: ${elapsed} seconds"
}
Output:

(last only)

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

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

ELAPSED: 28.978 seconds

Haskell

Visit the Haskell wiki Sudoku

J

See Solving Sudoku in J.

Java

public class Sudoku
{
    private int mBoard[][];
    private int mBoardSize;
    private int mBoxSize;
    private boolean mRowSubset[][];
    private boolean mColSubset[][];
    private boolean mBoxSubset[][];
 
    public Sudoku(int board[][]) {
        mBoard = board;
        mBoardSize = mBoard.length;
        mBoxSize = (int)Math.sqrt(mBoardSize);
        initSubsets();
    }
 
    public void initSubsets() {
        mRowSubset = new boolean[mBoardSize][mBoardSize];
        mColSubset = new boolean[mBoardSize][mBoardSize];
        mBoxSubset = new boolean[mBoardSize][mBoardSize];
        for(int i = 0; i < mBoard.length; i++) {
            for(int j = 0; j < mBoard.length; j++) {
                int value = mBoard[i][j];
                if(value != 0) {
                    setSubsetValue(i, j, value, true);
                }
            }
        }
    }
 
    private void setSubsetValue(int i, int j, int value, boolean present) {
        mRowSubset[i][value - 1] = present;
        mColSubset[j][value - 1] = present;
        mBoxSubset[computeBoxNo(i, j)][value - 1] = present;
    }
 
    public boolean solve() {
        return solve(0, 0);
    }
 
    public boolean solve(int i, int j) {
        if(i == mBoardSize) {
            i = 0;
            if(++j == mBoardSize) {
                return true;
            }
        }
        if(mBoard[i][j] != 0) {
            return solve(i + 1, j);
        }
        for(int value = 1; value <= mBoardSize; value++) {
            if(isValid(i, j, value)) {
                mBoard[i][j] = value;
                setSubsetValue(i, j, value, true);
                if(solve(i + 1, j)) {
                    return true;
                }
                setSubsetValue(i, j, value, false);
            }
        }
 
        mBoard[i][j] = 0;
        return false;
    }
 
    private boolean isValid(int i, int j, int val) {
        val--;
        boolean isPresent = mRowSubset[i][val] || mColSubset[j][val] || mBoxSubset[computeBoxNo(i, j)][val];
        return !isPresent;
    }
 
    private int computeBoxNo(int i, int j) {
        int boxRow = i / mBoxSize;
        int boxCol = j / mBoxSize;
        return boxRow * mBoxSize + boxCol;
    }
 
    public void print() {
        for(int i = 0; i < mBoardSize; i++) {
            if(i % mBoxSize == 0) {
                System.out.println(" -----------------------");
            }
            for(int j = 0; j < mBoardSize; j++) {
                if(j % mBoxSize == 0) {
                    System.out.print("| ");
                }
                System.out.print(mBoard[i][j] != 0 ? ((Object) (Integer.valueOf(mBoard[i][j]))) : "-");
                System.out.print(' ');
            }
 
            System.out.println("|");
        }
 
        System.out.println(" -----------------------");
    }

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

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

JavaScript

ES6

//-------------------------------------------[ Dancing Links and Algorithm X ]--
/**
 * The doubly-doubly circularly linked data object.
 * Data object X
 */
class DoX {
  /**
   * @param {string} V
   * @param {!DoX=} H
   */
  constructor(V, H) {
    this.V = V;
    this.L = this;
    this.R = this;
    this.U = this;
    this.D = this;
    this.S = 1;
    this.H = H || this;
    H && (H.S += 1);
  }
}

/**
 * Helper function to help build a horizontal doubly linked list.
 * @param {!DoX} e An existing node in the list.
 * @param {!DoX} n A new node to add to the right of the existing node.
 * @return {!DoX}
 */
const addRight = (e, n) => {
  n.R = e.R;
  n.L = e;
  e.R.L = n;
  return e.R = n;
};

/**
 * Helper function to help build a vertical doubly linked list.
 * @param {!DoX} e An existing node in the list.
 * @param {!DoX} n A new node to add below the existing node.
 */
const addBelow = (e, n) => {
  n.D = e.D;
  n.U = e;
  e.D.U = n;
  return e.D = n;
};

/**
 * Verbatim copy of DK's search algorithm. The meat of the DLX algorithm.
 * @param {!DoX} h The root node.
 * @param {!Array<!DoX>} s The solution array.
 */
const search = function(h, s) {
  if (h.R == h) {
    printSol(s);
  } else {
    let c = chooseColumn(h);
    cover(c);
    for (let r = c.D;