Adds parallelism

This commit is contained in:
Abhinav Sarkar 2018-07-27 16:58:45 +05:30
parent 4a9a1531d5
commit 49126a1f3a
2 changed files with 23 additions and 7 deletions

View File

@ -15,6 +15,8 @@ dependencies:
- base >= 4.7 && < 5
- containers
- vector
- parallel
- deepseq
executables:
sudoku:
@ -22,6 +24,9 @@ executables:
source-dirs: src
ghc-options:
- -O2
- -threaded
- -rtsopts
- -with-rtsopts=-N
dependencies:
- split

View File

@ -15,6 +15,9 @@ import qualified Data.Vector
import qualified Data.Vector.Unboxed
import qualified Data.Vector.Unboxed.Mutable
import qualified Data.STRef
import qualified Data.Maybe
import qualified Control.DeepSeq
import Control.Parallel.Strategies (withStrategy, rdeepseq, parBuffer)
fixM :: (Eq t, Monad m) => (t -> m t) -> t -> m t
fixM f x = f x >>= \x' -> if x' == x then return x else fixM f x'
@ -26,6 +29,10 @@ data Cell = Fixed Data.Word.Word16
| Possible Data.Word.Word16
deriving (Show, Eq)
instance Control.DeepSeq.NFData Cell where
rnf (Fixed w) = Control.DeepSeq.rnf w
rnf (Possible w) = Control.DeepSeq.rnf w
type Grid = Data.Vector.Vector Cell
type CellIxs = [Int]
@ -197,10 +204,14 @@ solve grid = pruneGrid grid >>= solve'
main :: IO ()
main = do
inputs <- lines <$> getContents
Control.Monad.forM_ inputs $ \input ->
case readGrid input of
Nothing -> putStrLn "Invalid input"
Just grid -> case solve grid of
Nothing -> putStrLn "No solution found"
Just grid' -> putStrLn $ showGrid grid'
grids <- lines <$> getContents
let solutions = parMap readAndSolve grids
putStrLn $
show (length $ filter Data.Maybe.isJust solutions) ++ "/" ++ show (length grids) ++ " solved"
where
readAndSolve grid = case readGrid grid of
Nothing -> Nothing
Just b -> solve b
chunkSize = 1000
parMap f = withStrategy (parBuffer chunkSize rdeepseq) . map f