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 Data.Bits (testBit, (.&.), complement, popCount, bit)
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.Maybe (fromJust)
import Data.Ord (comparing)
import Data.Word (Word16)
import System.CPUTime (getCPUTime)
import Text.Printf (printf)
@ -66,6 +67,26 @@ instance Ord Cell where
firstSol :: Word16 -> Int
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.
emptyBoard :: Board
emptyBoard =
@ -114,7 +135,6 @@ constrainBoard board cell@(Cell ix _ _) =
(rowIx, colIx) = ix `divMod` 9
(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 ..]
column board = cells board $ take 9 [colIx, colIx + 9 ..]
box board =
@ -138,7 +158,7 @@ showBoard :: Board -> String
showBoard board =
zipWith (\(Cell _ val vl) dot ->
if vl == 1 then intToDigit . firstSol $ val else dot)
(M.elems . ixMap $ board)
(map snd . sortBy (comparing fst) . M.toList . ixMap $ board)
(repeat '.')
-- Pretty prints a Sudoku board.
@ -157,7 +177,7 @@ printBoard board =
solveSudoku :: Board -> Maybe Board
solveSudoku board
-- if solved, return the board
| isSolved board = Just board
| isBoardSolved board = Just board
-- if no more unsolved cells left then return Nothing
| S.null (ambCells board) = Nothing
-- 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
Nothing -> solveSudoku boardR
-- 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
| otherwise -> case solveSudoku board' of
| otherwise -> case solveSudoku board' of
-- if solved, return the board
Just board'' -> Just board''
Just board'' -> Just board''
-- else try to solve the board with the current cell
-- with the rest values
Nothing -> solveSudoku boardR
Nothing -> solveSudoku boardR
where
-- Finds the cell which has fewest possible values.
(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
main :: IO ()
main = do