Contact me

Twitter  ⟐  LinkedIn
Christophe Delord


News!

Monday 18. july 2016: Updates on my new simulation framework project in Haskell.

Friday 25. march 2016: Dear backers, unfortunately, the FUN project was not successfully funded. I will now focus on FRP (Functional Reactive Programming) applied to real-time critical system specification and simulation.

CDSoft :: CV/Resume :: Free softwares Essays Haskell Handy Calc pp TPG BonaLuna Calculadoira todo pwd w Live :: AI tools in Prolog AI dialog

License

This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version.

This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.

You should have received a copy of the GNU General Public License along with this program. If not, see http://www.gnu.org/licenses/.

Introduction

To practice Haskell I decided to port a small Sudoku solver I wrote in Python. The solver is a basic brute force backtracking solver.

The solver is written in literate Haskell, which is cool for documenting a software. The document is written in Markdown and converted to HTML with Pandoc.

module Main where

import Data.Char
import Data.Array
import Data.List
import Data.List.Split
import Data.List.Utils
import System.Environment

Sudoku representation

We will use a 4 dimension space to describe a Sudoku grid. A grid is basically a 2D 9x9 array. But a grid has a more complex structure. It has rows, columns and smaller 3x3 squares. Rows, columns and 3x3 squares are in fact the intersections of a 4D plane (row, column or 3x3 square) and a 4D hypercube (the whole grid).

We will see a grid either as a 2D array indexed by (i,j)[0,8]2(i,j) \in [0, 8]^2, either as a 4D array indexed by (x,y,x,y)[0,2]4(x,y,x',y') \in [0, 2]^4.

type Indice4D = (Int,Int,Int,Int)
type Indice2D = (Int,Int)
type Digit = Int
type Grid =  Array Indice4D Digit

(i,j)(i,j) are the coordinates of a digit in the big 9x9 grid. (x,y)(x,y) are the coordinates of a small 3x3 square in the grid and (x,y)(x',y') are the coordinates of a digit in the (x,y)(x,y) small square.

The relation between (i,j)(i,j) and (x,y,x,y)(x,y,x',y') is:

ij :: Indice4D -> Indice2D
ij (x,y,x',y') = (i,j)
    where i = 3*x+x'
          j = 3*y+y'
xy :: Indice2D -> Indice4D
xy (i,j) = (x,y,x',y')
    where (x,x') = divMod i 3
          (y,y') = divMod j 3

Input format

A grid is a file containing digits from 1 to 9 and underscores (_) for empty cells. Internally a grid is a 4D array.

The function parseGrid turns a string into a 4D array.

i4D = ((0,0,0,0),(2,2,2,2))   -- 4D indices
r4D = range i4D               -- list of all the 4D indices
i2D = ((0,0),(8,8))           -- 2D indices
r2D = range i2D               -- list of all the 2D indices

parseGrid :: String -> Grid
parseGrid s = array i4D $ zip (map xy r2D) s'
    where s' = map digit $ filter (not.isSpace) s
          digit '_' = 0
          digit d = read [d]

Inputs

The solver has three built-in grids. These grids are supposed to be difficult (well, you may find them difficult to solve with a pen).

The first one is called easy. I found it there: http://www.telegraph.co.uk/science/science-news/9359579/Worlds-hardest-sudoku-can-you-crack-it.html

easy :: Grid
easy = parseGrid (" 8__ ___ ___ " ++
                  " __3 6__ ___ " ++
                  " _7_ _9_ 2__ " ++

                  " _5_ __7 ___ " ++
                  " ___ _45 7__ " ++
                  " ___ 1__ _3_ " ++

                  " __1 ___ _68 " ++
                  " __8 5__ _1_ " ++
                  " _9_ ___ 4__ ")

The second one - called hard - seems harder (the solver takes longer to find the solution). Shame on me, I don’t remember where I found it.

hard :: Grid
hard = parseGrid (" 7_8 ___ 3__ " ++
                  " ___ 2_1 ___ " ++
                  " 5__ ___ ___ " ++

                  " _4_ ___ _26 " ++
                  " 3__ _8_ ___ " ++
                  " ___ 1__ _9_ " ++

                  " _9_ 6__ __4 " ++
                  " ___ _7_ 5__ " ++
                  " ___ ___ ___ ")

The last one - called worst - is supposed to be very difficult for brute force algorithms. I found it here: https://github.com/manastech/crystal/blob/master/samples/sudoku.cr

worst :: Grid
worst = parseGrid (" ___ ___ ___ " ++
                   " ___ __3 _85 " ++
                   " __1 _2_ ___ " ++

                   " ___ 5_7 ___ " ++
                   " __4 ___ 1__ " ++
                   " _9_ ___ ___ " ++

                   " 5__ ___ _73 " ++
                   " __2 _1_ ___ " ++
                   " ___ _4_ __9 ")

The Sudoku grids are given on the command line. easy, hard and worst are the built-in grids. Other parameters are filenames. A Sudoku file shall contain one grid with digits and underscores. For instance:

7_8 ___ 3__
___ 2_1 ___
5__ ___ ___

_4_ ___ _26
3__ _8_ ___
___ 1__ _9_

_9_ 6__ __4
___ _7_ 5__
___ ___ ___

The main functions just solves each Sudoku grid given as parameters.

main :: IO ()
main = getArgs >>= mapM_ sudoku

sudoku :: String -> IO ()
-- builtin grids
sudoku "easy" = solveGrid easy
sudoku "hard" = solveGrid hard
sudoku "worst" = solveGrid worst
-- user defined grids
sudoku filename = readFile filename >>= (solveGrid . parseGrid)

solveGrid :: Grid -> IO ()
solveGrid grid = do putStrLn "\nGrid:\n"
                    putGrid grid
                    putGrids $ zip [1..] $ solve grid

Output

The solutions are printed to stdout.

Currently only the first solution is printed (printing all the solution may take a long time).

putGrids :: [(Int,Grid)] -> IO ()
putGrids ((i,g):gs) = do putStrLn ("\nSolution "++show i++":\n")
                         putGrid g
                         -- uncomment the following line to print all the solutions
                         --putGrids gs
putGrids [] = return ()

To print a grid we shall get its elements in the right order (i.e. rows by rows, columns by columns).

putGrid :: Grid -> IO ()
putGrid g = putStr $ showGrid $ chunksOf 9 $ map ((g!) . xy) r2D

Lines are grouped by 3 and separated by an horizontal line.

showGrid :: [[Digit]] -> String
showGrid = intercalate "------+-------+------\n"
         . map unlines
         . chunksOf 3
         . map showLine

Digits are also grouped by 3 and separated by a vertical line.

showLine :: [Digit] -> String
showLine = intercalate " | "
         . map unwords
         . chunksOf 3
         . map (replace "0" "_" . show)

Solver

The solver is a brute force backtracking solver. For every positions in the grid it tries all the possible digits. It starts with the initial grid and tries to fill the first position (0,0,0,0)(0,0,0,0). For each possible digit, it continues as this with the following positions until it reaches the last one (2,2,2,2)(2,2,2,2).

solve tries to fill the grid at all positions (r4D), except for the positions that already contain a non null digit.

solve :: Grid -> [Grid]
solve g = fillGrid' g ps
    where
        -- remove already filled positions
        ps = filter (\p -> g!p == 0) r4D

fillGrid tries to fill in a cell. There are several cases:

fillGrid :: Grid -> [Indice4D] -> [Grid]
fillGrid g [] = [g]
fillGrid g (p:ps) = concat [fillGrid (g // [(p, d)]) ps | d <- candidates g p]

fillGrid can be very slow because positions are always tested in the same order. It would more clever to first try positions that have the minimum number of possible candidates. fillGrid' is very similar to fillGrid but p is now the position that has the minimum candidates.

fillGrid' :: Grid -> [Indice4D] -> [Grid]
fillGrid' g [] = [g]
fillGrid' g ps = concat [fillGrid' (g // [(p, d)]) ps' | d <- qs]
    where
        (_, p, qs) = minimum [(length qs, p, qs) | p <- ps, let qs = candidates g p]
        ps' = delete p ps

candidates lists all the possible digits in a cell according to the current state of the grid. A value is “possible” if it does not appear in the same row, column or small square.

The 4D representation of the Sudoku grid helps in defining rows, columns and squares.

The equation of the row containing (a,b,a,b)(a,b,a',b') is

In the same vein we can find the equations for the column and the square containing a specific 4D point.

candidates lists all the digits that can be good candidates for a position. Candidates are all the digits in [1,9][1, 9] that are not in the row, the column and the square that contain the position.

candidates :: Grid -> Indice4D -> [Digit]
candidates g (x,y,x',y') = [1..9] \\ (row++col++sqr)
    where row = [n | x  <- r3, x' <- r3, let n = g!(x,y,x',y'), n /= 0]
          col = [n | y  <- r3, y' <- r3, let n = g!(x,y,x',y'), n /= 0]
          sqr = [n | x' <- r3, y' <- r3, let n = g!(x,y,x',y'), n /= 0]
          r3 = [0..2]

Example

Let’s try to solve the easy Sudoku grid.

$ runhaskell sudoku.lhs easy
Grid:

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

Solution 1:

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

After a few optimizations, the compiled version is pretty fast:

Grid Time
easy 0.672 s
hard 1.176 s
worst 4.574 s

Tests made on a core I5 processor powered by Debian Wheezy.

Source

The Haskell source code is here: sudoku.lhs

Feedback

Please let me know what you think about this way of coding/documenting? Do you like my way of writting literate Haskell? And the explanation about my implementation of a Sudoku solver?

I’m rather new to the fabulous world of Haskell, your feedback is welcome.