Sudoku

February 19, 2009

Sudoku puzzles are a simple and popular amusement given as a nine-by-nine grid of cells, some of them containing digits:

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

The challenge is to fill the empty cells with the digits 1 through 9 in such a way that no row, column, or three-by-three sub-grid contains the same digit two or more times.

Write a program to solve sudoku puzzles; your program may assume the puzzle is well-formed. What is the solution of the above puzzle?

About these ads

Pages: 1 2

9 Responses to “Sudoku”

  1. Some time back I had read Peter Norvig’s beautiful post Solving Every Sudoku Puzzle, and tried to convert his program into Haskell. His idea, in short, was to use constraint propagation to fill up as many values as possible; and then ultimately search.

    Though the resulting Haskell program was not as succinct as his original Python, I thought it wasn’t too bad either. Perhaps using some monad trick (that I yet have to learn!) all the checks against ‘Nothing’ can be eliminated.

    One (only?) answer, got in under a second, is:

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

    And my Haskell translation is (gist):


    import List (elem, nub, filter, delete, intersperse, replicate)
    import Data.Map (Map, fromList, (!), insert, keys, elems, toList)
    import Data.List (intercalate)
    import Data.Maybe

    type Val = Char -- Value of a cell
    type Square = String -- two-character square ID
    type Board = Maybe (Map Square String) -- The board state

    cross xs ys = [[x,y] | x <- xs, y <- ys]
    rows = "ABCDEFGHI"
    cols = "123456789"
    digits = "123456789"
    squares = cross rows cols
    unitlist = [cross rows [c] | c <- cols]
               ++ [cross [r] cols | r <- rows]
               ++ [cross rs cs | rs <- ["ABC", "DEF", "GHI"], cs <- ["123","456","789"]]
    units sq = filter (elem sq) unitlist
    peers sq = delete sq . nub . concat $ units sq

    -- Check for places where d appears in the units of sq
    checkplaces :: Board -> Square -> Val -> Board
    checkplaces b0 sq d = foldl f b0 (units sq)
        where f b u
                  | isNothing b || len == 0 = Nothing
                  | len == 1 = assign b (head dplaces) d
                  | otherwise = b
                  where dplaces = [s | s <- u, elem d ((fromJust b)!s)]
                        -- dplaces is all squares in the unit u possibly containing d
                        len = length dplaces

    eliminate :: Board -> Square -> Val -> Board
    eliminate Nothing _ _ = Nothing
    eliminate (Just b0) sq d
        | notElem d v = Just b0 -- Already Eliminated
        | length v' == 0 = Nothing -- Contradiction: Removed last value
        | length v' == 1 = checkplaces b'' sq d -- Only 1 left: Remove from peers
        | otherwise = checkplaces (Just b') sq d
        where v = b0 ! sq
              v' = delete d v
              b' = insert sq v' b0
              h = (head v')
              b'' = foldl (\b p -> eliminate b p h) (Just b') (peers sq)

    assign :: Board -> Square -> Val -> Board
    assign Nothing _ _ = Nothing
    assign b0 sq d0 = foldl f b0 ((fromJust b0) ! sq)
        where f b d = if d0 == d then b else eliminate b sq d

    parsegr :: String -> Board
    parsegr s = foldl f b0 (zip squares s')
        where s' = filter (\x -> elem x "0.-123456789") s
              b0 = Just (fromList [(s, digits) | s <- squares])
              f b (sq, d)
                  | isNothing b = Nothing
                  | notElem d digits = b
                  | otherwise = assign b sq d

    search :: Board -> Board
    search Nothing = Nothing
    search (Just b) =
        if all ((==1) . length) $ elems b then Just b else search' (b!s)
        where minl = minimum [l | v <- elems b, let l = length v, l > 1]
              s = head [sq | (sq, v) <- toList b, length v == minl]
              search' [] = Nothing
              search' (d:ds) = if isJust b' then b' else search' ds
                  where b' = search $ assign (Just b) s d

    printgr :: Board -> String
    printgr Nothing = "Unsolvable"
    printgr (Just b) = concat [(fr r) ++ (if elem r "CF" then line else "") ++ "\n" | r<-rows]
        where w = 1 + maximum [length (b!sq) | sq <- squares]
              line = (++) "\n" $ intercalate "+" $ replicate 3 $ replicate (3 * w) '-'
              fr r = concat [(fmt (b![r,c])) ++ (if elem c "36" then "|" else "") | c<-cols]
              fmt s = s ++ replicate (w - (length s)) ' '

    solve :: String -> IO ()
    solve s = putStrLn $ printgr $ search $ parsegr s

    -- Instance from http://programmingpraxis.com/2009/02/19/sudoku/2/
    grid = "7..1......2.....15.....639.2...18....4..9..7....75...3.785.....56.....4......1..2"

    main = solve grid

  2. Matt said

    Here’s my implementation, based on the Dlx algorithm:

    http://codepad.org/a1lsh3ga

  3. David said

    Implementation of DLX in PLT Scheme. This solves the sample problem in about 20ms on my machine.

    http://github.com/d3zd3z/praxis/blob/master/2009/02-19-sudoku.ss

  4. Jos Koot said
    #lang racket ; By Jos Koot.
    
    #|
    Procedure: (sudoku p) -> (s ...) or "erroneous puzzle"
    p : puzzle : 9x9 matrix of digits.
    s : solution : like p but not containing zeros.
    digit : one of the exact integer numbers from 0 up to and including 9.
    nxm matrix : vector of n vectors of m elements each.
    
    Purpose:
    To solve sudoku puzzle represented by p. In p 0 represents an unoccupied field.
    The procedure first displays the puzzle and the number of solutions,
    then returns the list of all solutions.
    |#
    
    (define (sudoku p)
      
      ; (get x y) -> element (x,y) of matrix p.
      
      (define (get x y) (vector-ref (vector-ref p x) y))
      
      ; (put! x y n) -> stores n in element (x,y) of matrix p.
      
      (define (put! x y n) (vector-set! (vector-ref p x) y n))
      
      ; (copy) -> copy of p
      
      (define (copy)
        (let copy ((p p))
          (if (vector? p)
              (apply vector (map copy (vector->list p)))
              p)))
      
      ; hash : hash-table with fields (x y) for keys and providing a list of all
      ; other fields (x' y') that must not contain the same digit as field (x y).
      
      (define hash
        (let ((hash (make-hash)))
          (for* ((x (in-range 0 9)) (y (in-range 0 9)))
            (hash-set!
             hash (list x y)
             (remove
              (list x y)
              (remove-duplicates
               (append
                (for*/list ((z (in-range 0 9))) (list x z))
                (for*/list ((z (in-range 0 9))) (list z y))
                (let ((x (* 3 (quotient x 3))) (y (* 3 (quotient y 3))))
                  (for*/list ((x (in-range x (+ x 3))) (y (in-range y (+ y 3))))
                    (list x y))))))))
          hash))
      
      ; (occ x y) -> list of non zero digits
      ; To be used for unoccupied fields.
      ; Returns the list of digits field (x y) must not contain.
      
      (define (occ x y)
        (remove-duplicates
         (filter
          positive?
          (map
           (λ (xy) (apply get xy))
           (hash-ref hash (list x y))))))
      
      ; (free x y) -> list of non zero digits
      ; To be used for unoccupied fields.
      ; Returns the list of digits field (x y) stiull feasible during the search.
      
      (define (free x y) (remove* (occ x y) '(1 2 3 4 5 6 7 8 9)))
      
      ; n-occ : number of occupied (non zero) elements in the original puzzle.
      
      (define n-occ
        (let ((n-occ 0))
          (for* ((x (in-range 0 9)) (y (in-range 0 9)))
            (when (positive? (get x y))
              (set! n-occ (add1 n-occ))))
          n-occ))
      
      ; (solve x y n-occ sols) -> (s ...)
      ; Does a depth first search on all free fields and all allowed digits.
      
      (define (solve x y n-occ sols)
        ; try loops allong the free digits allowed in free field (x y).
        (define (try frees sols)
          (if (null? frees)
              (begin (put! x y 0) sols)
              (begin
                (put! x y (car frees))
                (let ((sols (solve x (add1 y) (add1 n-occ) sols)))
                  (try (cdr frees) sols)))))
        (cond
          ((= n-occ 81) (cons (copy) sols))
          ((= x 9) sols)
          ((= y 9) (solve (add1 x) 0 n-occ sols))
          ((positive? (get x y)) (solve x (add1 y) n-occ sols))
          (else (try (free x y) sols))))
      
      ; (test) checks that the puzzle is correct.
      
      (define (test)
        (and (vector? p) (= (vector-length p) 9)
             (for*/and ((x (in-range 0 9)))
               (let ((row (vector-ref p x)))
                 (and (vector? row) (= (vector-length row) 9)
                      (andmap digit? (vector->list row)))))
             (for*/and ((x (in-range 0 9))(y (in-range 0 9)))
               (let ((n (get x y)))
                 (or
                  (zero? n)
                  (not (member n (occ x y))))))))
      
      (define (digit? x) (and (number? x) (exact? x) (integer? x) (<= 0 x 9)))
      
      (printf "~nPuzzle:~n~n")
      (pretty-display p)
      (newline)
      (if (test)
          (begin
            (let ((sols (solve 0 0 n-occ '())))
              (printf "has ~s solutions:~n~n" (length sols))
              sols))
          (printf "is inconsistent.~n~n")))
    
    (sudoku ; 1 sol
     #(#(7 0 0 1 0 0 0 0 0)
       #(0 2 0 0 0 0 0 1 5)
       #(0 0 0 0 0 6 3 9 0)
       #(2 0 0 0 1 8 0 0 0)
       #(0 4 0 0 9 0 0 7 0)
       #(0 0 0 7 5 0 0 0 3)
       #(0 7 8 5 0 0 0 0 0)
       #(5 6 0 0 0 0 0 4 0)
       #(0 0 0 0 0 1 0 0 2)))
    
    (sudoku ; no solutions
     #(#(7 0 0 1 0 0 0 0 0)
       #(0 2 0 0 0 0 0 1 5)
       #(0 0 0 0 0 6 3 9 0)
       #(2 0 0 0 1 8 0 0 0)
       #(0 4 0 0 9 0 0 7 0)
       #(0 0 0 7 5 0 0 0 3)
       #(0 7 8 5 0 0 0 0 0)
       #(5 6 0 0 0 0 0 4 0)
       #(0 0 3 0 0 1 0 0 2)))
    
    (sudoku ; 50 solutions
     #(#(7 0 0 1 0 0 0 0 0)
       #(0 2 0 0 0 0 0 1 5)
       #(0 0 0 0 0 6 3 9 0)
       #(2 0 0 0 1 8 0 0 0)
       #(0 4 0 0 9 0 0 7 0)
       #(0 0 0 7 5 0 0 0 3)
       #(0 7 8 5 0 0 0 0 0)
       #(5 6 0 0 0 0 0 4 0)
       #(0 0 0 0 0 1 0 0 0)))
    
    (sudoku ; 12 solutions
     #(#(7 8 9 1 3 5 6 2 4)
       #(0 2 0 0 0 0 0 1 5)
       #(0 0 0 0 0 6 3 9 0)
       #(2 0 0 0 1 8 0 0 0)
       #(0 4 0 0 9 0 0 7 0)
       #(0 0 0 7 5 0 0 0 3)
       #(0 7 8 5 0 0 0 0 0)
       #(5 6 0 0 0 0 0 4 0)
       #(0 0 0 0 0 1 0 0 0)))
    
    (sudoku ; erroneous puzzle
     #(#(7 8 9 1 1 0 0 0 0)
       #(0 2 0 0 0 0 0 1 5)
       #(0 0 0 0 0 6 3 9 0)
       #(2 0 0 0 1 8 0 0 0)
       #(0 4 0 0 9 0 0 7 0)
       #(0 0 0 7 5 0 0 0 3)
       #(0 7 8 5 0 0 0 0 0)
       #(5 6 0 0 0 0 0 4 0)
       #(0 0 0 0 0 1 0 0 2)))
    
    (sudoku ; 14 solutions
     #(#(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 3 1 0 0 0 0 0 0)
       #(5 6 4 0 3 0 0 0 0)
       #(8 9 7 0 0 5 0 0 0)
       #(3 1 2 0 0 0 9 0 0)
       #(6 4 5 0 0 0 0 7 0)
       #(9 7 8 0 0 0 0 0 1)))
    
    (sudoku
     #(#(7 0 0 0 0 0 0 1 9)
       #(4 6 0 1 9 0 0 0 0)
       #(0 0 0 6 8 2 7 0 4)
       #(0 9 0 0 0 0 0 0 7)
       #(0 0 0 3 0 0 4 0 5)
       #(0 0 6 7 0 0 0 0 0)
       #(0 0 1 0 0 0 0 0 0)
       #(2 0 0 0 7 4 0 0 0)
       #(0 0 0 2 0 0 3 0 0)))
    
    
  5. Jos Koot said

    Solving sudoku is interseting.
    How about designing sudoku puzzles that have exactly one solution?
    Does anyone have an idea how to do that?
    I can think of the following:
    0: Initially all fields are unoccupied.
    1: Randomly choose an unoccupied field.
    2: Take all consistent digits in arbitrary order.
    3: If there are no consistent digits backtrack from step 1.
    4: Try the digits in arbitrary order.
    5: For each trial solve the puzzle to a maximum of two solutions.
    6: If there is no solution, try the next consistent digit or backtrack from step 1 if no digits are left.
    7: If there is one solution we are ready.
    9: If there is more than one solution, try to complete the puzzle from step 1.

    Jos

  6. Vatsa said

    This is a solution in php that uses backtracking.
    You start with a first empty cell and the least number that fits there (i.e. with no conflict from other numbers that are already supplied in the puzzle).
    And apply the same logic to the next empty cell, till you’re not able to fill any number in an empty cell – at which time you backtrack to the previous cell, change the number there and try again.

    So for the above Sudoku puzzle, since the first empty cell is in (1,2), the function below will first be invoked as:
    solve(1,1,2)
    $game_table is just an array of 9X9 that already contains supplied numbers in the puzzle
    $complete will be set to FALSE before calling solve() for the first time

    function solve($number,$row,$column)
    {
    global $game_table;
    global $complete;

    while($number<=9 && !$complete)
    {
    //check is this number can fit into this cell
    if(check_horizontal($number,$row,$column) && check_vertical($number,$row,$column) && check_square($number,$row,$column))
    {
    $game_table[$row][$column]=$number; //no conflict, so fill the cell with this number
    //find the next blank cell
    $i=1;$j=1;$found=false;

    for($i=1;$i<=9;$i++)
    {
    for($j=1;$j<=9;$j++)
    {
    if($game_table[$i][$j]==0)
    {
    $found=true;
    break;
    }
    }
    if ($found) break;
    }

    if($found)
    solve(1,$i,$j); //recursive call
    else
    {
    $complete= true;
    return;
    }
    }
    //recursive call will return here – so here either the puzzle is complete or there was no possibility to fill the next cell
    if(!$complete)
    $number++;
    }
    if(!$complete)
    $game_table[$row][$column]=0; //reset this cell
    }

    function check_horizontal($n,$r,$c)
    {
    global $game_table;
    for($j=1;$j<=9;$j++)
    if($game_table[$r][$j]==$n) return false;
    return true;
    }

    function check_vertical($n,$r,$c)
    {
    global $game_table;
    for($i=1;$i<=9;$i++)
    if($game_table[$i][$c]==$n) return false;
    return true;
    }

    function check_square($n,$r,$c)
    {
    global $game_table;
    $a = $r%3;
    $b = floor($r/3);
    if($a==0)
    {
    $r1 = (3*($b-1))+1;
    $r2 = $r;
    }
    else
    {
    $r1 = $r-$a+1;
    $r2 = 3*($b+1);
    }

    $a = $c%3;
    $b = floor($c/3);
    if($a==0)
    {
    $c1 = (3*($b-1))+1;
    $c2 = $c;
    }
    else
    {
    $c1 = $c-$a+1;
    $c2 = 3*($b+1);
    }

    for($i=$r1;$i<=$r2;$i++)
    for($j=$c1;$j<=$c2;$j++)
    if($game_table[$i][$j] == $n) return false;

    return true;
    }

  7. j0sejuan said

    golang

    package main
    
    import "fmt"
    
    const PROBLEM = "7..1......2.....15.....639.2...18....4..9..7....75...3.785.....56.....4......1..2"
    
    func solve(p []uint8, i int) {
    	for i < 81 && p[i] != '.' { i++ }
    	if i > 80 {
    		fmt.Println("---------")
    		for i := 0; i < 9; i++ {
    			fmt.Println(string(p[i * 9: (i + 1) * 9]))
    		}
    	} else {
    		w, v := make([] bool, 58), i % 9
    		h, b := i - v, ((i / 9) / 3) * 27 + (v / 3) * 3
    		for n := 0; n < 9; n++ {
    			w[p[v]] = true; w[p[h]] = true; w[p[b]] = true
    			v += 9; h += 1; if n % 3 == 2 { b += 7 } else { b += 1 }
    		}
    		for j := 49; j < 58; j++ {
    			if !w[j] {
    				p[i] = uint8(j); solve(p, i + 1); p[i] = '.'
    			}
    		}
    	}
    }
    
    func main() {
    	solve([]uint8(PROBLEM), 0)
    }
    
  8. ftt said

    Python: https://github.com/ftt/programming-praxis/blob/master/20090219-sudoku/sudoku.py

    This is roughly based on an article by P. Norvig I read once (Ashutosh Mehra mentions that article), but I’ve tried to implement it from memory, so the result is not as clean as the original.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

Follow

Get every new post delivered to your Inbox.

Join 631 other followers

%d bloggers like this: