From a320a7874c6fa0c39665151cc8e073532cc750a1 Mon Sep 17 00:00:00 2001
From: Abhinav Sarkar <abhinav@abhinavsarkar.net>
Date: Tue, 17 Jul 2018 23:13:30 +0530
Subject: [PATCH] Merges two pruning strategies for speedup

---
 src/Sudoku.hs | 36 ++++++++++++++----------------------
 1 file changed, 14 insertions(+), 22 deletions(-)

diff --git a/src/Sudoku.hs b/src/Sudoku.hs
index c85541c..ac0f846 100644
--- a/src/Sudoku.hs
+++ b/src/Sudoku.hs
@@ -97,30 +97,27 @@ makeCell ys
   | Data.Bits.popCount ys == 1 = Just $ Fixed ys
   | otherwise                  = Just $ Possible ys
 
-pruneCellsByFixed :: Grid -> CellIxs -> Maybe Grid
-pruneCellsByFixed grid cellIxs =
-  Control.Monad.foldM pruneCell grid . map (\i -> (i, grid ! i)) $ cellIxs
+pruneCells :: Grid -> CellIxs -> Maybe Grid
+pruneCells grid cellIxs = Control.Monad.foldM pruneCell grid cellIxs
   where
-    fixeds = setBits Data.Bits.zeroBits [x | Fixed x <- map (grid !) cellIxs]
+    cells         = map (grid !) cellIxs
+    exclusives    = exclusivePossibilities cells
+    allExclusives = setBits Data.Bits.zeroBits exclusives
+    fixeds        = setBits Data.Bits.zeroBits [x | Fixed x <- cells]
 
-    pruneCell g (_, Fixed _) = Just g
-    pruneCell g (i, Possible xs)
+    pruneCell g i =
+      pruneCellByFixed g (i, g ! i) >>= \g' -> pruneCellByExclusives g' (i, g' ! i)
+
+    pruneCellByFixed g (_, Fixed _) = Just g
+    pruneCellByFixed g (i, Possible xs)
       | xs' == xs = Just g
       | otherwise = flip (replaceCell i) g <$> makeCell xs'
       where
         xs' = xs Data.Bits..&. Data.Bits.complement fixeds
 
-pruneCellsByExclusives :: Grid -> CellIxs -> Maybe Grid
-pruneCellsByExclusives grid cellIxs = case exclusives of
-  [] -> Just grid
-  _  -> Control.Monad.foldM pruneCell grid . zip cellIxs $ cells
-  where
-    cells         = map (grid !) cellIxs
-    exclusives    = exclusivePossibilities cells
-    allExclusives = setBits Data.Bits.zeroBits exclusives
-
-    pruneCell g (_, Fixed _) = Just g
-    pruneCell g (i, Possible xs)
+    pruneCellByExclusives g (_, Fixed _) = Just g
+    pruneCellByExclusives g (i, Possible xs)
+      | null exclusives                = Just g
       | intersection == xs             = Just g
       | intersection `elem` exclusives =
           flip (replaceCell i) g <$> makeCell intersection
@@ -128,11 +125,6 @@ pruneCellsByExclusives grid cellIxs = case exclusives of
       where
         intersection = xs Data.Bits..&. allExclusives
 
-pruneCells :: Grid -> CellIxs -> Maybe Grid
-pruneCells grid cellIxs =
-  fixM (flip pruneCellsByFixed cellIxs) grid
-  >>= fixM (flip pruneCellsByExclusives cellIxs)
-
 pruneGrid' :: Grid -> Maybe Grid
 pruneGrid' grid =
   Control.Monad.foldM pruneCells grid allRowIxs