From 49126a1f3a416f2ffeaaef69cc001be7d2327717 Mon Sep 17 00:00:00 2001
From: Abhinav Sarkar <abhinav@abhinavsarkar.net>
Date: Fri, 27 Jul 2018 16:58:45 +0530
Subject: [PATCH] Adds parallelism

---
 package.yaml  |  5 +++++
 src/Sudoku.hs | 25 ++++++++++++++++++-------
 2 files changed, 23 insertions(+), 7 deletions(-)

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 9b7e74f..92b4ed7 100644
--- a/src/Sudoku.hs
+++ b/src/Sudoku.hs
@@ -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