diff --git a/package.yaml b/package.yaml index b1710aa..fb42f8d 100644 --- a/package.yaml +++ b/package.yaml @@ -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 diff --git a/src/Sudoku.hs b/src/Sudoku.hs index bfd22d2..b384722 100644 --- a/src/Sudoku.hs +++ b/src/Sudoku.hs @@ -14,6 +14,8 @@ import qualified Data.Bits import Data.Vector.Unboxed ((!)) import qualified Data.Vector.Unboxed.Mutable import qualified Data.Vector.Unboxed +import qualified Data.Maybe +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' @@ -250,10 +252,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