# Antimatroid, The

thoughts on computer science, electronics, mathematics

## Archive for June 2009

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]
```

Written by lewellen

2009-06-01 at 12:00 am

Posted in Algorithms

Tagged with ,