Uses custom accumulator in exclusivePossibilities for speedup

src/Sudoku.hs

@@ -53,20 +53,43 @@ showGridWithPossibilities = unlines . map (unwords . map showCell)
     showCell (Possible xs) =
       "[" ++ map (\i -> if Data.Bits.testBit xs i then Data.Char.intToDigit i else ' ') [1..9] ++ "]"
 
+-- Exclusive Possibilities Accumulator
+data ExPosAcc = ExPosAcc ![Int] ![Int] ![Int] ![Int] ![Int] ![Int] ![Int] ![Int] ![Int]
+
+exPosAccEmpty :: ExPosAcc
+exPosAccEmpty = ExPosAcc [] [] [] [] [] [] [] [] []
+
+exPosAccInsert :: Int -> Int -> ExPosAcc -> ExPosAcc
+exPosAccInsert 1 i (ExPosAcc v1 v2 v3 v4 v5 v6 v7 v8 v9) = ExPosAcc (i:v1) v2 v3 v4 v5 v6 v7 v8 v9
+exPosAccInsert 2 i (ExPosAcc v1 v2 v3 v4 v5 v6 v7 v8 v9) = ExPosAcc v1 (i:v2) v3 v4 v5 v6 v7 v8 v9
+exPosAccInsert 3 i (ExPosAcc v1 v2 v3 v4 v5 v6 v7 v8 v9) = ExPosAcc v1 v2 (i:v3) v4 v5 v6 v7 v8 v9
+exPosAccInsert 4 i (ExPosAcc v1 v2 v3 v4 v5 v6 v7 v8 v9) = ExPosAcc v1 v2 v3 (i:v4) v5 v6 v7 v8 v9
+exPosAccInsert 5 i (ExPosAcc v1 v2 v3 v4 v5 v6 v7 v8 v9) = ExPosAcc v1 v2 v3 v4 (i:v5) v6 v7 v8 v9
+exPosAccInsert 6 i (ExPosAcc v1 v2 v3 v4 v5 v6 v7 v8 v9) = ExPosAcc v1 v2 v3 v4 v5 (i:v6) v7 v8 v9
+exPosAccInsert 7 i (ExPosAcc v1 v2 v3 v4 v5 v6 v7 v8 v9) = ExPosAcc v1 v2 v3 v4 v5 v6 (i:v7) v8 v9
+exPosAccInsert 8 i (ExPosAcc v1 v2 v3 v4 v5 v6 v7 v8 v9) = ExPosAcc v1 v2 v3 v4 v5 v6 v7 (i:v8) v9
+exPosAccInsert 9 i (ExPosAcc v1 v2 v3 v4 v5 v6 v7 v8 v9) = ExPosAcc v1 v2 v3 v4 v5 v6 v7 v8 (i:v9)
+exPosAccInsert _ _ _                                     = error "Impossible"
+
+exPosAccToList :: ExPosAcc -> [(Int, [Int])]
+exPosAccToList (ExPosAcc v1 v2 v3 v4 v5 v6 v7 v8 v9) =
+  [(1, v1), (2, v2), (3, v3), (4, v4), (5, v5), (6, v6), (7, v7), (8, v8), (9, v9)]
+
 exclusivePossibilities :: [Cell] -> [Data.Word.Word16]
 exclusivePossibilities row =
   row
-  & zip [1..9]
+  & zip ([1..9] :: [Int])
   & filter (isPossible . snd)
   & Data.List.foldl'
       (\acc ~(i, Possible xs) ->
         Data.List.foldl'
-          (\acc' n -> if Data.Bits.testBit xs n then Map.insertWith prepend n [i] acc' else acc')
+          (\acc' n -> if Data.Bits.testBit xs n then exPosAccInsert n i acc' else acc')
           acc
           [1..9])
-      Map.empty
+      exPosAccEmpty
-  & Map.filter ((< 4) . length)
+  & exPosAccToList
-  & Map.foldlWithKey'(\acc x is -> Map.insertWith prepend is [x] acc) Map.empty
+  & filter ((< 4) . length . snd)
+  & Data.List.foldl' (\acc (x, is) -> Map.insertWith prepend is [x] acc) Map.empty
   & Map.filterWithKey (\is xs -> length is == length xs)
   & Map.elems
   & map (Data.List.foldl' Data.Bits.setBit Data.Bits.zeroBits)