Fixed the bugs.

Made solution check more stringent.
Fixed the out of order display bug in showBoard because of using HashMap.
master
Abhinav Sarkar 2012-10-24 22:27:50 +05:30
parent 24ca158bb7
commit 11c234c4ac
1 changed files with 28 additions and 11 deletions

View File

@ -30,9 +30,10 @@ import Control.Concurrent (forkIO, newEmptyMVar, putMVar, takeMVar)
import Control.Monad (foldM, forM_, forM, (>=>)) import Control.Monad (foldM, forM_, forM, (>=>))
import Data.Bits (testBit, (.&.), complement, popCount, bit) import Data.Bits (testBit, (.&.), complement, popCount, bit)
import Data.Char (digitToInt, intToDigit, isDigit) import Data.Char (digitToInt, intToDigit, isDigit)
import Data.List (foldl', intersperse, intercalate, find) import Data.List (foldl', intersperse, intercalate, find, sortBy)
import Data.List.Split (chunksOf) import Data.List.Split (chunksOf)
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
import Data.Ord (comparing)
import Data.Word (Word16) import Data.Word (Word16)
import System.CPUTime (getCPUTime) import System.CPUTime (getCPUTime)
import Text.Printf (printf) import Text.Printf (printf)
@ -66,6 +67,26 @@ instance Ord Cell where
firstSol :: Word16 -> Int firstSol :: Word16 -> Int
firstSol val = fromJust . find (testBit val) $ [1..9] firstSol val = fromJust . find (testBit val) $ [1..9]
cells :: Board -> [Int] -> [Cell]
cells board = map (fromJust . flip M.lookup (ixMap board))
rowIxs, columnIxs, boxIxs, unitIxs :: [[Int]]
rowIxs = chunksOf 9 [0..80]
columnIxs = map (\i -> take 9 [i, i + 9 ..]) [0..8]
boxIxs = concatMap (\(x:y:z:_) -> zipWith3 (\a b c -> a ++ b ++ c) x y z)
. chunksOf 3 . map (chunksOf 3) $ rowIxs
unitIxs = rowIxs ++ columnIxs ++ boxIxs
-- Checks if a Sudoku board is solved.
-- A board is solved if all the cells have only one possible value and all rows,
-- columns and boxes follow the rule of Sudoku.
isBoardSolved :: Board -> Bool
isBoardSolved board =
(all (\(Cell _ _ vl) -> vl == 1) . M.elems . ixMap $ board)
&& all (isUnitSolved . cells board) unitIxs
where
isUnitSolved unit = S.size (S.fromList unit) == 9
-- An empty Sudoku board where all cells have all possible values. -- An empty Sudoku board where all cells have all possible values.
emptyBoard :: Board emptyBoard :: Board
emptyBoard = emptyBoard =
@ -114,7 +135,6 @@ constrainBoard board cell@(Cell ix _ _) =
(rowIx, colIx) = ix `divMod` 9 (rowIx, colIx) = ix `divMod` 9
(rowIx', colIx') = ((rowIx `div` 3) * 3, (colIx `div` 3) * 3) (rowIx', colIx') = ((rowIx `div` 3) * 3, (colIx `div` 3) * 3)
cells board = map (fromJust . flip M.lookup (ixMap board))
row board = cells board $ take 9 [rowIx * 9 ..] row board = cells board $ take 9 [rowIx * 9 ..]
column board = cells board $ take 9 [colIx, colIx + 9 ..] column board = cells board $ take 9 [colIx, colIx + 9 ..]
box board = box board =
@ -138,7 +158,7 @@ showBoard :: Board -> String
showBoard board = showBoard board =
zipWith (\(Cell _ val vl) dot -> zipWith (\(Cell _ val vl) dot ->
if vl == 1 then intToDigit . firstSol $ val else dot) if vl == 1 then intToDigit . firstSol $ val else dot)
(M.elems . ixMap $ board) (map snd . sortBy (comparing fst) . M.toList . ixMap $ board)
(repeat '.') (repeat '.')
-- Pretty prints a Sudoku board. -- Pretty prints a Sudoku board.
@ -157,7 +177,7 @@ printBoard board =
solveSudoku :: Board -> Maybe Board solveSudoku :: Board -> Maybe Board
solveSudoku board solveSudoku board
-- if solved, return the board -- if solved, return the board
| isSolved board = Just board | isBoardSolved board = Just board
-- if no more unsolved cells left then return Nothing -- if no more unsolved cells left then return Nothing
| S.null (ambCells board) = Nothing | S.null (ambCells board) = Nothing
-- if the current cell has no possible values, solve with rest cells -- if the current cell has no possible values, solve with rest cells
@ -175,21 +195,18 @@ solveSudoku board
-- if failed, continue with the current cell with the rest values -- if failed, continue with the current cell with the rest values
Nothing -> solveSudoku boardR Nothing -> solveSudoku boardR
-- if solved, return the board -- if solved, return the board
Just board' | isSolved board' -> Just board' Just board' | isBoardSolved board' -> Just board'
-- else try to recursively solve the board further -- else try to recursively solve the board further
| otherwise -> case solveSudoku board' of | otherwise -> case solveSudoku board' of
-- if solved, return the board -- if solved, return the board
Just board'' -> Just board'' Just board'' -> Just board''
-- else try to solve the board with the current cell -- else try to solve the board with the current cell
-- with the rest values -- with the rest values
Nothing -> solveSudoku boardR Nothing -> solveSudoku boardR
where where
-- Finds the cell which has fewest possible values. -- Finds the cell which has fewest possible values.
(Cell ix val vl, cs) = S.deleteFindMin (ambCells board) (Cell ix val vl, cs) = S.deleteFindMin (ambCells board)
-- A Sudoku is solved if all the cells have only one possible value.
isSolved = all (\(Cell _ _ vl) -> vl == 1) . M.elems . ixMap
-- Reads the puzzles from stdin and solves them -- Reads the puzzles from stdin and solves them
main :: IO () main :: IO ()
main = do main = do