Reformatted the code
This commit is contained in:
parent
412d6286d7
commit
24ca158bb7
|
@ -59,8 +59,8 @@ instance Show Cell where
|
||||||
instance Ord Cell where
|
instance Ord Cell where
|
||||||
(Cell i1 v1 vl1) `compare` (Cell i2 v2 vl2) =
|
(Cell i1 v1 vl1) `compare` (Cell i2 v2 vl2) =
|
||||||
if i1 == i2 && v1 == v2
|
if i1 == i2 && v1 == v2
|
||||||
then EQ
|
then EQ
|
||||||
else (vl1, i1) `compare`(vl2, i2)
|
else (vl1, i1) `compare`(vl2, i2)
|
||||||
|
|
||||||
-- Gets the index of the lowest bit set as 1.
|
-- Gets the index of the lowest bit set as 1.
|
||||||
firstSol :: Word16 -> Int
|
firstSol :: Word16 -> Int
|
||||||
|
@ -76,7 +76,7 @@ emptyBoard =
|
||||||
-- Updates the given cell in the board.
|
-- Updates the given cell in the board.
|
||||||
updateBoard :: Board -> Cell -> Board
|
updateBoard :: Board -> Cell -> Board
|
||||||
updateBoard board@Board{..} cell@(Cell ix _ vl) = case M.lookup ix ixMap of
|
updateBoard board@Board{..} cell@(Cell ix _ vl) = case M.lookup ix ixMap of
|
||||||
Nothing -> board
|
Nothing -> board
|
||||||
Just oldCell | oldCell == cell -> board
|
Just oldCell | oldCell == cell -> board
|
||||||
| vl == 1 -> Board (M.insert ix cell ixMap)
|
| vl == 1 -> Board (M.insert ix cell ixMap)
|
||||||
(S.delete oldCell ambCells)
|
(S.delete oldCell ambCells)
|
||||||
|
@ -87,13 +87,12 @@ updateBoard board@Board{..} cell@(Cell ix _ vl) = case M.lookup ix ixMap of
|
||||||
-- another cell (first argument) in the given board.
|
-- another cell (first argument) in the given board.
|
||||||
-- If there is a conflict in the values of the cells, returns Nothing.
|
-- If there is a conflict in the values of the cells, returns Nothing.
|
||||||
constrainCell :: Cell -> Board -> Cell -> Maybe Board
|
constrainCell :: Cell -> Board -> Cell -> Maybe Board
|
||||||
constrainCell cell@(Cell _ val vl) board@Board{..} c@(Cell i pos pl) =
|
constrainCell cell@(Cell _ val vl) board@Board{..} c@(Cell i pos pl)
|
||||||
case () of _
|
| c == cell = return board
|
||||||
| c == cell -> return board
|
| pos' == 0 && vl == 1 = Nothing
|
||||||
| pos' == 0 && vl == 1 -> Nothing
|
| pos' == 0 = return board
|
||||||
| pos' == 0 -> return board
|
| pl' == 1 && pl > 1 = constrainBoard board (Cell i pos' pl')
|
||||||
| pl' == 1 && pl > 1 -> constrainBoard board (Cell i pos' pl')
|
| otherwise = return $ updateBoard board (Cell i pos' pl')
|
||||||
| otherwise -> return $ updateBoard board (Cell i pos' pl')
|
|
||||||
where
|
where
|
||||||
pos' = pos .&. complement val
|
pos' = pos .&. complement val
|
||||||
pl' = popCount pos'
|
pl' = popCount pos'
|
||||||
|
@ -109,7 +108,7 @@ constrainCells cell = foldM (constrainCell cell)
|
||||||
-- one cell where a unit is a row, cell or a 3x3 box.
|
-- one cell where a unit is a row, cell or a 3x3 box.
|
||||||
constrainBoard :: Board -> Cell -> Maybe Board
|
constrainBoard :: Board -> Cell -> Maybe Board
|
||||||
constrainBoard board cell@(Cell ix _ _) =
|
constrainBoard board cell@(Cell ix _ _) =
|
||||||
foldM (\board'' unitf -> constrainCells cell board'' (unitf board''))
|
foldM (\board' unitf -> constrainCells cell board' (unitf board'))
|
||||||
(updateBoard board cell) [row, column, box]
|
(updateBoard board cell) [row, column, box]
|
||||||
where
|
where
|
||||||
(rowIx, colIx) = ix `divMod` 9
|
(rowIx, colIx) = ix `divMod` 9
|
||||||
|
@ -174,7 +173,7 @@ solveSudoku board
|
||||||
-- try to constrain with the current cell with only one value
|
-- try to constrain with the current cell with only one value
|
||||||
in case constrainBoard board nextPos of
|
in case constrainBoard board nextPos of
|
||||||
-- 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' | isSolved board' -> Just board'
|
||||||
-- else try to recursively solve the board further
|
-- else try to recursively solve the board further
|
||||||
|
@ -198,13 +197,13 @@ main = do
|
||||||
chunks <- fmap (chunksOf 10 . lines) getContents
|
chunks <- fmap (chunksOf 10 . lines) getContents
|
||||||
|
|
||||||
-- spawn a thread for each chunk
|
-- spawn a thread for each chunk
|
||||||
threads <- forM chunks $ \chunk -> do
|
solutionsVs <- forM chunks $ \chunk -> do
|
||||||
done <- newEmptyMVar
|
solutionsV <- newEmptyMVar
|
||||||
forkIO $ do
|
forkIO $ do
|
||||||
-- for each line in the chunk, read it as a Sudoku board and solve it.
|
-- for each line in the chunk, read it as a Sudoku board and solve it
|
||||||
-- return solution as a string represented by showBoard if solvable else "Unsolvable"
|
-- return solution as a string represented by showBoard if solvable else "Unsolvable"
|
||||||
-- return an error if invalid board.
|
-- return an error if invalid board
|
||||||
sols <- forM chunk $ \line -> do
|
solutions <- forM chunk $ \line -> do
|
||||||
start <- getCPUTime
|
start <- getCPUTime
|
||||||
let sudoku = readBoard line
|
let sudoku = readBoard line
|
||||||
case sudoku of
|
case sudoku of
|
||||||
|
@ -216,8 +215,8 @@ main = do
|
||||||
|
|
||||||
return $ printf "%s -> %s [%0.3f ms]" line
|
return $ printf "%s -> %s [%0.3f ms]" line
|
||||||
(maybe "Unsolvable" showBoard res) diff
|
(maybe "Unsolvable" showBoard res) diff
|
||||||
putMVar done sols
|
putMVar solutionsV solutions
|
||||||
return done
|
return solutionsV
|
||||||
|
|
||||||
-- wait for all thread to finish and print the solutions (or errors).
|
-- wait for all thread to finish and print the solutions (or errors)
|
||||||
forM_ threads $ takeMVar >=> mapM_ putStrLn
|
forM_ solutionsVs $ takeMVar >=> mapM_ putStrLn
|
||||||
|
|
Loading…
Reference in New Issue