Optimized by using Chan instead of MVar

This commit is contained in:
Abhinav Sarkar 2012-10-28 14:31:43 +05:30
parent aa10f43dab
commit 9bd95eb2c4
4 changed files with 26 additions and 15 deletions

1
.gitignore vendored
View File

@ -6,4 +6,5 @@ input
bin
dist
lib
share
*.sublime-workspace

View File

@ -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

View File

@ -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

View File

@ -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"]
}
]