diff --git a/.gitignore b/.gitignore index 0f108df..e76d45e 100644 --- a/.gitignore +++ b/.gitignore @@ -6,4 +6,5 @@ input bin dist lib +share *.sublime-workspace diff --git a/SudokuSolver.hs b/SudokuSolver.hs index 4ee1ac5..3eb1104 100644 --- a/SudokuSolver.hs +++ b/SudokuSolver.hs @@ -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 diff --git a/rubyquiz.cabal b/rubyquiz.cabal index ad2078f..b6d6c97 100644 --- a/rubyquiz.cabal +++ b/rubyquiz.cabal @@ -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 diff --git a/rubyquiz.sublime-project b/rubyquiz.sublime-project index 48c851c..dbbea4e 100644 --- a/rubyquiz.sublime-project +++ b/rubyquiz.sublime-project @@ -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"] } ]