Reformatted the code
This commit is contained in:
parent
412d6286d7
commit
24ca158bb7
|
@ -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
|
||||||
|
@ -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