Optimized by using Chan instead of MVar
This commit is contained in:
parent
aa10f43dab
commit
9bd95eb2c4
1
.gitignore
vendored
1
.gitignore
vendored
@ -6,4 +6,5 @@ input
|
||||
bin
|
||||
dist
|
||||
lib
|
||||
share
|
||||
*.sublime-workspace
|
||||
|
@ -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
|
||||
let !sol = printf "%s -> %s [%0.3f ms]" line
|
||||
(maybe "Unsolvable" showBoard res) diff
|
||||
putMVar solutionsV solutions
|
||||
return solutionsV
|
||||
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
|
||||
|
@ -115,7 +115,7 @@ executable SudokuSolver
|
||||
split == 0.2.1.*,
|
||||
unordered-containers == 0.2.1.*
|
||||
main-is : SudokuSolver.hs
|
||||
ghc-options : -threaded -rtsopts -main-is SudokuSolver
|
||||
ghc-options : -threaded -rtsopts -fllvm -main-is SudokuSolver
|
||||
default-language : Haskell2010
|
||||
|
||||
executable NumericMaze
|
||||
|
@ -3,7 +3,7 @@
|
||||
[
|
||||
{
|
||||
"path": "/home/abhinav/projects/rubyquiz",
|
||||
"folder_exclude_patterns": ["bin", "dist"],
|
||||
"folder_exclude_patterns": ["bin", "dist", "lib", "share"],
|
||||
"file_exclude_patterns": ["*.hi", "*.o"]
|
||||
}
|
||||
]
|
||||
|
Loading…
Reference in New Issue
Block a user