Home > Uncategorized > Yet another Sudoku solver (in Haskell this time)

Yet another Sudoku solver (in Haskell this time)

I have looked into some Haskell libraries lately. I have not used Haskell in a long time so I felt I needed to shape up and what could be a better exercise than writing a Sudoku solver. The entire source code is available on bitbucket but let me just walk through the important parts.

The board is represented using the following types:

type Cell = (Int,Int,[Int])
type Board = [Cell]

A cell keeps track of its row and column index along with the possible values that fit into the cell. A board is then simply a list of cells.

The solve method is invoked on a board and returns all possible solutions. It relies on back tracking.

solve :: Board -> [Board]
solve xs =
    let xs’ = propagateConstraints xs in
    if invalid xs’ then
        []
    else if unique xs’ then
        [xs’]
    else
        let (r,c,vs) = leastAmbiguousCell xs’ in
        let xs” = filter (\(r’,c’,_)->not(r’==r&&c’==c)) xs’ in
        concatMap solve [ (r,c,[v]):xs” | v <- vs ]

The most important helper method here is the function for constraint propagation.

propagateConstraints :: Board -> Board   
propagateConstraints xs =
    [ cell |
       (row,col,vals) <- xs,
       let rowValues = getRow row col xs,
       let colValues = getCol row col xs,
       let blockValues = getBlock row col xs,
       let vals’ = vals \\ (rowValues `union` colValues `union` blockValues),
       let cell = (row, col, vals’) ]

Note that it is expressed entirely using a single list comprehension. Nice! List comprehensions in Haskell almost seem magical sometimes. Helper functions for row, column and block extraction are very simple:

getRow r c = unify . filter (\(r’,c’,_)->r’==r && c’ /= c) . singularOnly

getCol r c = unify . filter (\(r’,c’,_)->c’==c && r’ /= r) . singularOnly

getBlock r c = unify . filter (\(r’,c’,_)->bi==(blockIndex r’ c’) && not(r’==r && c’==c)) . singularOnly
               where bi = blockIndex r c

Finding the least ambiguous cell is also simple:

leastAmbiguousCell = minimumBy (\(_,_,vs1) (_,_,vs2) -> compare (length vs1) (length vs2)) . filter (\(_,_,vs)->length vs > 1)

Ok, that’s about it. Thanks for reading.

Advertisements
Categories: Uncategorized
  1. No comments yet.
  1. No trackbacks yet.

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

%d bloggers like this: