Replaces list with vector, naively

package.yaml

@@ -14,6 +14,7 @@ description:         Please see the README on GitHub at <https://github.com/abhi
 dependencies:
 - base >= 4.7 && < 5
 - containers
+- vector
 
 executables:
   sudoku:

src/Sudoku.hs

@@ -5,11 +5,12 @@ import Data.Function ((&))
 import qualified Control.Monad
 import qualified Data.Char
 import qualified Data.Function
-import qualified Data.List.Split
 import qualified Data.List
 import qualified Data.Map.Strict as Map
 import qualified Data.Word
 import qualified Data.Bits
+import qualified Data.Vector
+import Data.Vector ((!))
 
 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'
@@ -21,8 +22,8 @@ data Cell = Fixed Data.Word.Word16
           | Possible Data.Word.Word16
           deriving (Show, Eq)
 
-type Row  = [Cell]
+type Grid = Data.Vector.Vector Cell
-type Grid = [Row]
+type CellIxs = [Int]
 
 isPossible :: Cell -> Bool
 isPossible (Possible _) = True
@@ -30,7 +31,7 @@ isPossible _            = False
 
 readGrid :: String -> Maybe Grid
 readGrid s
-  | length s == 81 = traverse (traverse readCell) . Data.List.Split.chunksOf 9 $ s
+  | length s == 81 = Data.Vector.fromList <$> traverse readCell s
   | otherwise      = Nothing
   where
     allBitsSet = 1022
@@ -40,14 +41,31 @@ readGrid s
       | Data.Char.isDigit c && c > '0' = Just . Fixed . Data.Bits.bit . Data.Char.digitToInt $ c
       | otherwise = Nothing
 
+fromXY :: (Int, Int) -> Int
+fromXY (x, y) = x * 9 + y
+
+allRowIxs, allColIxs, allSubGridIxs :: [CellIxs]
+allRowIxs = [getRow i | i <- [0..8]]
+  where getRow n = [ fromXY (n, i) | i <- [0..8] ]
+
+allColIxs = [getCol i | i <- [0..8]]
+  where getCol n = [ fromXY (i, n) | i <- [0..8] ]
+
+allSubGridIxs = [getSubGrid i | i <- [0..8]]
+  where getSubGrid n = let (r, c) = (n `quot` 3, n `mod` 3)
+                       in [ fromXY (3 * r + i, 3 * c + j) | i <- [0..2], j <- [0..2] ]
+
+replaceCell :: Int -> Cell -> Grid -> Grid
+replaceCell i c g = g Data.Vector.// [(i, c)]
+
 showGrid :: Grid -> String
-showGrid = unlines . map (unwords . map showCell)
+showGrid grid = unlines . map (unwords . map (showCell . (grid !))) $ allRowIxs
   where
     showCell (Fixed x) = show . Data.Bits.countTrailingZeros $ x
     showCell _         = "."
 
 showGridWithPossibilities :: Grid -> String
-showGridWithPossibilities = unlines . map (unwords . map showCell)
+showGridWithPossibilities grid = unlines . map (unwords . map (showCell . (grid !))) $ allRowIxs
   where
     showCell (Fixed x)     = (show . Data.Bits.countTrailingZeros $ x) ++ "          "
     showCell (Possible xs) =
@@ -79,55 +97,59 @@ makeCell ys
   | Data.Bits.popCount ys == 1 = Just $ Fixed ys
   | otherwise                  = Just $ Possible ys
 
-pruneCellsByFixed :: [Cell] -> Maybe [Cell]
+pruneCellsByFixed :: Grid -> CellIxs -> Maybe Grid
-pruneCellsByFixed cells = traverse pruneCell cells
+pruneCellsByFixed grid cellIxs =
+  Control.Monad.foldM pruneCell grid . map (\i -> (i, grid ! i)) $ cellIxs
   where
-    fixeds = setBits Data.Bits.zeroBits [x | Fixed x <- cells]
+    fixeds = setBits Data.Bits.zeroBits [x | Fixed x <- map (grid !) cellIxs]
 
-    pruneCell (Possible xs) = makeCell (xs Data.Bits..&. Data.Bits.complement fixeds)
+    pruneCell g (_, Fixed _) = Just g
-    pruneCell x             = Just x
+    pruneCell 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 :: [Cell] -> Maybe [Cell]
+pruneCellsByExclusives :: Grid -> CellIxs -> Maybe Grid
-pruneCellsByExclusives cells = case exclusives of
+pruneCellsByExclusives grid cellIxs = case exclusives of
-  [] -> Just cells
+  [] -> Just grid
-  _  -> traverse pruneCell cells
+  _  -> Control.Monad.foldM pruneCell grid . zip cellIxs $ cells
   where
+    cells         = map (grid !) cellIxs
     exclusives    = exclusivePossibilities cells
     allExclusives = setBits Data.Bits.zeroBits exclusives
 
-    pruneCell cell@(Fixed _) = Just cell
+    pruneCell g (_, Fixed _) = Just g
-    pruneCell cell@(Possible xs)
+    pruneCell g (i, Possible xs)
-      | intersection `elem` exclusives = makeCell intersection
+      | intersection == xs             = Just g
-      | otherwise                      = Just cell
+      | intersection `elem` exclusives =
+          flip (replaceCell i) g <$> makeCell intersection
+      | otherwise                      = Just g
       where
         intersection = xs Data.Bits..&. allExclusives
 
-pruneCells :: [Cell] -> Maybe [Cell]
+pruneCells :: Grid -> CellIxs -> Maybe Grid
-pruneCells cells = fixM pruneCellsByFixed cells >>= fixM pruneCellsByExclusives
+pruneCells grid cellIxs =
-
+  fixM (flip pruneCellsByFixed cellIxs) grid
-subGridsToRows :: Grid -> Grid
+  >>= fixM (flip pruneCellsByExclusives cellIxs)
-subGridsToRows =
-  concatMap (\rows -> let [r1, r2, r3] = map (Data.List.Split.chunksOf 3) rows
-                      in zipWith3 (\a b c -> a ++ b ++ c) r1 r2 r3)
-  . Data.List.Split.chunksOf 3
 
 pruneGrid' :: Grid -> Maybe Grid
 pruneGrid' grid =
-  traverse pruneCells grid
+  Control.Monad.foldM pruneCells grid allRowIxs
-  >>= fmap Data.List.transpose . traverse pruneCells . Data.List.transpose
+  >>= flip (Control.Monad.foldM pruneCells) allColIxs
-  >>= fmap subGridsToRows . traverse pruneCells . subGridsToRows
+  >>= flip (Control.Monad.foldM pruneCells) allSubGridIxs
 
 pruneGrid :: Grid -> Maybe Grid
 pruneGrid = fixM pruneGrid'
 
 isGridFilled :: Grid -> Bool
-isGridFilled grid = null [ () | Possible _ <- concat grid ]
+isGridFilled = not . Data.Vector.any isPossible
 
 isGridInvalid :: Grid -> Bool
 isGridInvalid grid =
-  any isInvalidRow grid
+  any isInvalidRow (map (map (grid !)) allRowIxs)
-  || any isInvalidRow (Data.List.transpose grid)
+  || any isInvalidRow (map (map (grid !)) allColIxs)
-  || any isInvalidRow (subGridsToRows grid)
+  || any isInvalidRow (map (map (grid !)) allSubGridIxs)
   where
     isInvalidRow row =
       let fixeds         = [x  | Fixed x <- row]
@@ -145,12 +167,10 @@ nextGrids :: Grid -> (Grid, Grid)
 nextGrids grid =
   let (i, first@(Fixed _), rest) =
         fixCell
-        . Data.List.minimumBy (compare `Data.Function.on` (possibilityCount . snd))
+        . Data.Vector.minimumBy (compare `Data.Function.on` (possibilityCount . snd))
-        . filter (isPossible . snd)
+        . Data.Vector.imapMaybe (\j cell -> if isPossible cell then Just (j, cell) else Nothing)
-        . zip [0..]
-        . concat
         $ grid
-  in (replace2D i first grid, replace2D i rest grid)
+  in (replaceCell i first grid, replaceCell i rest grid)
   where
     possibilityCount (Possible xs) = Data.Bits.popCount xs
     possibilityCount (Fixed _)     = 1
@@ -161,10 +181,6 @@ nextGrids grid =
         Nothing -> error "Impossible case"
         Just cell -> (i, Fixed (Data.Bits.bit x), cell)
 
-    replace2D :: Int -> a -> [[a]] -> [[a]]
-    replace2D i v = let (x, y) = (i `quot` 9, i `mod` 9) in replace x (replace y (const v))
-    replace p f xs = [if i == p then f x else x | (x, i) <- zip xs [0..]]
-
 solve :: Grid -> Maybe Grid
 solve grid = pruneGrid grid >>= solve'
   where