sudoku.hs

module NumberPlate where

import Data.List

data Cell = Cell {num :: Int, row :: Int, col :: Int, block :: Int} deriving Eq
data Tree = Node Board [Tree] deriving Show
type Board = [Cell]
type Ploblem = [Int]

instance Show Cell where
    show (Cell n _ _ _) = show n

-----------  initilize  -----------


easy :: Ploblem
easy =      [5,1,7, 6,0,0, 0,3,4,
             2,8,9, 0,0,4, 0,0,0,
             3,4,6, 2,0,5, 0,9,0,

             6,0,2, 0,0,0, 0,1,0,
             0,3,8, 0,0,6, 0,4,7,
             0,0,0, 0,0,0, 0,0,0,

             0,9,0, 0,0,0, 0,7,8,
             7,0,3, 4,0,0, 5,6,0,
             0,0,0, 0,0,0, 0,0,0]

difficult :: Ploblem
difficult = [0,0,5, 3,0,0, 0,0,0,
             8,0,0, 0,0,0, 0,2,0,
             0,7,0, 0,1,0, 5,0,0,

             4,0,0, 0,0,5, 3,0,0,
             0,1,0, 0,7,0, 0,0,6,
             0,0,3, 2,0,0, 0,8,0,

             0,6,0, 5,0,0, 0,0,9,
             0,0,4, 0,0,0, 0,3,0,
             0,0,0, 0,0,9, 7,0,0]


positions :: [(Int,Int,Int)]
positions = [(r,c,b) | r <- [0..8], c <- [0..8], let b = 3 * (classify r) + (classify c)]
    where classify = flip div 3

board :: Ploblem -> Board
board nums = zipWith initialize nums positions
    where initialize n (r,c,b) = Cell n r c b

b = board easy
----------- tree -----------


tree :: Board -> Tree
tree b = Node b (map tree $ newBoards b empties)
    where empties = filter ((== 0) . num) b

newBoards :: Board -> [Cell] -> [Board]
newBoards b [] = []
newBoards b (e:_) = map (fill b) candidates
    where candidates = getCandidates b e
          fill b n = [if c /= e then c else c {num = n} | c <- b]

getCandidates :: Board -> Cell -> [Int]
getCandidates b c = [1..9] \\ (inSameRow ++ inSameCol ++ inSameBlock)
  where inSameRow   = map num $ filter ((== row c)   . row)   b
        inSameCol   = map num $ filter ((== col c)   . col)   b
        inSameBlock = map num $ filter ((== block c) . block) b


----------- solve -----------

solve :: Board -> Board
solve = head . flatten . tree

flatten :: Tree -> [Board]
flatten (Node b []) = if isSolved b then [b] else []
flatten (Node b ts) = concat $ map flatten ts

isSolved :: Board -> Bool
isSolved b = null empties
    where empties = filter ((== 0) . num) b



----------- display -----------

display :: Board -> IO ()
display [] = return ()
display list = do
    let (x,xs) = splitAt 9 list
    print x
    display xs