Antimatroid, The

thoughts on mathematics, computer science and business

Sudoku Solver in Haskell

with 6 comments

This month will be a bit of short article since I haven’t had a whole lot of time on my hands lately. Haskell is a wonderful little language that has begun to pick up a bit of moment in the past year that I’ve been playing with on-and-off now for several years. Since I don’t post enough on Haskell, I figured I’d post my bare-bones Haskell Sudoku Solver.

import Data.List
import Data.Maybe

toRowColumn :: Int -> (Int, Int)
toRowColumn index = (r, c)
	where	r = div index 9
		c = mod index 9

toIndex :: (Int, Int) -> Int
toIndex (r, c) = r * 9 + c

toRegion :: (Int, Int) -> Int
toRegion (r, c) = (div r 3) * 3 + (div c 3)

columnIndicies :: Int -> [Int]
columnIndicies c = [c, c + 9..80]

regionIndicies :: Int -> [Int]
regionIndicies g = [toIndex(r + x, c + y) |
		x <- [0..2],
		y <- [0..2]
	]
	where	r = (div g 3) * 3
		c = (mod g 3) * 3

rowIndicies :: Int -> [Int]
rowIndicies r = [9 * r..9 * (r + 1) - 1]

values :: [Int] -> [Int] -> [Int]
values board indicies = filter (>0) (map (board!!) indicies)

possibleValues :: [Int] -> (Int, Int) -> [Int]
possibleValues board rowColumn = 
	foldl (\\) [1..9] (
		map (values board) (
			map (\f -> (fst f . snd f) rowColumn) (
				zip [rowIndicies, columnIndicies, regionIndicies]
					[fst, snd, toRegion]
			)
		)
	)

validBoard :: [Int] -> Bool
validBoard board = (length board == 81) && (and $ map (==0) l)
	where	l = map length s
		s = map (\\[1..9]) v
		v = [values board (xIndicies x) |
			x <- [0..8],
			xIndicies <- [rowIndicies, columnIndicies, regionIndicies]]

solvedBoard :: [Int] -> Bool
solvedBoard board = and $ map (>0) board

hasUnassigned :: [Int] -> Bool
hasUnassigned board = isJust $ elemIndex 0 board

assignFirstUnassigned :: [Int] -> Int -> [Int]
assignFirstUnassigned (b:bs) value
	| b == 0 = value : bs
	| otherwise = b : (assignFirstUnassigned bs value)

possibleBoards :: [Int] -> [Int] -> [[Int]]
possibleBoards board possibleAssignments = map (assignFirstUnassigned board)
	possibleAssignments

solve :: [Int] -> [[Int]]
solve board
	| not (validBoard board) = [[]]
	| solvedBoard board = [board]
	| not (hasUnassigned board) = [[]]
	| otherwise = concated
	where	concated = concat mapped
		mapped = map solve filtered
		filtered = filter (not . null) possibleSolved
		possibleSolved = possibleBoards board possibleAssignments
		possibleAssignments = possibleValues board unassignedRowColumn
		unassignedRowColumn = toRowColumn unassignedIndex
		unassignedIndex = fromJust $ elemIndex 0 board

demo :: [Int]
demo = [2,0,0,0,8,0,3,0,0,
	0,6,0,0,7,0,0,8,4,
	0,3,0,5,0,0,2,0,9,
	0,0,0,1,0,5,4,0,8,
	0,0,0,0,0,0,0,0,0,
	4,0,2,7,0,6,0,0,0,
	3,0,1,0,0,7,0,4,0,
	7,2,0,0,4,0,0,6,0,
	0,0,4,0,1,0,0,0,3]
About these ads

Written by lewellen

2009-06-01 at 12:00 am

Posted in Algorithms

Tagged with ,

6 Responses

Subscribe to comments with RSS.

  1. ohh interesting!!!.

    hsbrowser

    2010-05-01 at 3:38 pm

  2. there is a syntax error on function regionIndicies.

    gcarlos

    2010-05-01 at 4:49 pm

  3. Thanks for spotting the error. I’ve updated the post with the corrected code.

    lewellen

    2010-05-01 at 7:41 pm

  4. Bird’s “Pearls of Functional Algorithm Design” has an excellent chapter on the Sudoku solver. I recommend picking it up from a library or bookstore near you if you’re interested.

    Jason

    2011-01-02 at 8:08 pm

  5. And of course, for those interested: http://www.haskell.org/haskellwiki/Sudoku

    Jason

    2011-01-02 at 8:08 pm

  6. I think you lost some syntax in the list comprehension here:

    columnIndicies :: Int -> [Int]
    columnIndicies c = [c, c + 9..80]

    bill

    2011-01-03 at 6:00 am


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.

%d bloggers like this: