|
|
|
@ -30,6 +30,7 @@ where
|
|
|
|
|
import qualified Data.Set as S
|
|
|
|
|
import qualified Data.HashMap.Strict as M
|
|
|
|
|
import Control.Concurrent (forkIO, newEmptyMVar, putMVar, takeMVar)
|
|
|
|
|
import Control.Concurrent.Chan (newChan, writeChan, getChanContents)
|
|
|
|
|
import Control.Monad (foldM, forM_, forM, (>=>))
|
|
|
|
|
import Data.Bits (testBit, (.&.), complement, popCount, bit)
|
|
|
|
|
import Data.Char (digitToInt, intToDigit, isDigit)
|
|
|
|
@ -218,30 +219,39 @@ solveSudoku board
|
|
|
|
|
-- Reads the puzzles from stdin and solves them
|
|
|
|
|
main :: IO ()
|
|
|
|
|
main = do
|
|
|
|
|
-- read the puzzles in chunks of 10
|
|
|
|
|
chunks <- fmap (chunksOf 10 . lines) getContents
|
|
|
|
|
-- read the puzzles in chunks of 100
|
|
|
|
|
chunks <- fmap (chunksOf 100 . lines) getContents
|
|
|
|
|
solChan <- newChan
|
|
|
|
|
done <- newEmptyMVar
|
|
|
|
|
|
|
|
|
|
-- print the solutions (or errors) and wait for all thread to finish
|
|
|
|
|
forkIO $ do
|
|
|
|
|
solutions <- getChanContents solChan
|
|
|
|
|
printSolutions solutions (length chunks)
|
|
|
|
|
putMVar done ()
|
|
|
|
|
|
|
|
|
|
-- spawn a thread for each chunk
|
|
|
|
|
solutionsVs <- forM chunks $ \chunk -> do
|
|
|
|
|
solutionsV <- newEmptyMVar
|
|
|
|
|
forkIO $ do
|
|
|
|
|
forM_ chunks $ \chunk -> forkIO $ do
|
|
|
|
|
-- 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 an error if invalid board
|
|
|
|
|
solutions <- forM chunk $ \line -> do
|
|
|
|
|
forM_ chunk $ \line -> do
|
|
|
|
|
start <- getCPUTime
|
|
|
|
|
let sudoku = readBoard line
|
|
|
|
|
case sudoku of
|
|
|
|
|
Nothing -> return $ "Invalid input sudoku: " ++ line
|
|
|
|
|
Nothing -> writeChan solChan $ "Invalid input sudoku: " ++ line
|
|
|
|
|
Just board -> do
|
|
|
|
|
let !res = solveSudoku board
|
|
|
|
|
end <- getCPUTime
|
|
|
|
|
let diff = fromIntegral (end - start) / (10 ^ 9) :: Double
|
|
|
|
|
|
|
|
|
|
return $ printf "%s -> %s [%0.3f ms]" line
|
|
|
|
|
(maybe "Unsolvable" showBoard res) diff
|
|
|
|
|
putMVar solutionsV solutions
|
|
|
|
|
return solutionsV
|
|
|
|
|
let !sol = printf "%s -> %s [%0.3f ms]" line
|
|
|
|
|
(maybe "Unsolvable" showBoard res) diff
|
|
|
|
|
writeChan solChan sol
|
|
|
|
|
writeChan solChan "DONE"
|
|
|
|
|
|
|
|
|
|
-- wait for all thread to finish and print the solutions (or errors)
|
|
|
|
|
forM_ solutionsVs $ takeMVar >=> mapM_ putStrLn
|
|
|
|
|
takeMVar done
|
|
|
|
|
where
|
|
|
|
|
printSolutions _ 0 = return ()
|
|
|
|
|
printSolutions ("DONE":xs) l = printSolutions xs (l - 1)
|
|
|
|
|
printSolutions (x:xs) l = putStrLn x >> printSolutions xs l
|
|
|
|
|