From 73aee36b4dff680544f32357569b98eba0314e58 Mon Sep 17 00:00:00 2001 From: Abhinav Sarkar Date: Wed, 18 Jul 2018 12:27:43 +0530 Subject: [PATCH] Switched to unboxed vector --- src/Sudoku.hs | 91 ++++++++++++++++++++++++++------------------------- 1 file changed, 47 insertions(+), 44 deletions(-) diff --git a/src/Sudoku.hs b/src/Sudoku.hs index 429b39d..7ab87a8 100644 --- a/src/Sudoku.hs +++ b/src/Sudoku.hs @@ -9,10 +9,9 @@ import qualified Data.List import qualified Data.Map.Strict as Map import qualified Data.Word import qualified Data.Bits -import qualified Data.Foldable -import qualified Data.Vector -import Data.Vector ((!)) -import qualified Data.Vector.Mutable +import Data.Vector.Unboxed ((!)) +import qualified Data.Vector.Unboxed.Mutable +import qualified Data.Vector.Unboxed 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' @@ -20,27 +19,28 @@ fixM f x = f x >>= \x' -> if x' == x then return x else fixM f x' setBits :: Data.Word.Word16 -> [Data.Word.Word16] -> Data.Word.Word16 setBits = Data.List.foldl' (Data.Bits..|.) -data Cell = Fixed {-# UNPACK #-} !Data.Word.Word16 - | Possible {-# UNPACK #-} !Data.Word.Word16 - deriving (Show, Eq) - -type Grid = Data.Vector.Vector Cell +type Cell = Data.Word.Word16 +type Grid = Data.Vector.Unboxed.Vector Cell type CellIxs = [Int] -isPossible :: Cell -> Bool -isPossible (Possible _) = True -isPossible _ = False +isPossible, isFixed :: Cell -> Bool +isPossible = flip Data.Bits.testBit 15 +isFixed = not . isPossible + +makePossible, makeFixed :: Data.Word.Word16 -> Cell +makePossible = flip Data.Bits.setBit 15 +makeFixed = flip Data.Bits.clearBit 15 readGrid :: String -> Maybe Grid readGrid s - | length s == 81 = Data.Vector.fromList <$> traverse readCell s + | length s == 81 = Data.Vector.Unboxed.fromList <$> traverse readCell s | otherwise = Nothing where allBitsSet = 1022 - readCell '.' = Just $ Possible allBitsSet + readCell '.' = Just $ makePossible allBitsSet readCell c - | Data.Char.isDigit c && c > '0' = Just . Fixed . Data.Bits.bit . Data.Char.digitToInt $ c + | Data.Char.isDigit c && c > '0' = Just . Data.Bits.bit . Data.Char.digitToInt $ c | otherwise = Nothing fromXY :: (Int, Int) -> Int @@ -58,20 +58,22 @@ allSubGridIxs = [getSubGrid i | i <- [0..8]] in [ fromXY (3 * r + i, 3 * c + j) | i <- [0..2], j <- [0..2] ] replaceCell :: Int -> Cell -> Grid -> Grid -replaceCell i c = Data.Vector.modify (\v -> Data.Vector.Mutable.write v i c) +replaceCell i c = Data.Vector.Unboxed.modify (\v -> Data.Vector.Unboxed.Mutable.write v i c) showGrid :: Grid -> String showGrid grid = unlines . map (unwords . map (showCell . (grid !))) $ allRowIxs where - showCell (Fixed x) = show . Data.Bits.countTrailingZeros $ x - showCell _ = "." + showCell xs + | isPossible xs = "." + | otherwise = show . Data.Bits.countTrailingZeros $ xs showGridWithPossibilities :: Grid -> String showGridWithPossibilities grid = unlines . map (unwords . map (showCell . (grid !))) $ allRowIxs where - showCell (Fixed x) = (show . Data.Bits.countTrailingZeros $ x) ++ " " - showCell (Possible xs) = + showCell xs + | isPossible xs = "[" ++ map (\i -> if Data.Bits.testBit xs i then Data.Char.intToDigit i else ' ') [1..9] ++ "]" + | otherwise = (show . Data.Bits.countTrailingZeros $ xs) ++ " " -- Exclusive Possibilities Accumulator data ExPosAcc = ExPosAcc ![Int] ![Int] ![Int] ![Int] ![Int] ![Int] ![Int] ![Int] ![Int] @@ -102,7 +104,7 @@ exclusivePossibilities grid cellIxs = & zip ([1..9] :: [Int]) & filter (isPossible . snd) & Data.List.foldl' - (\acc ~(i, Possible xs) -> + (\acc (i, xs) -> Data.List.foldl' (\acc' n -> if Data.Bits.testBit xs n then exPosAccInsert n i acc' else acc') acc @@ -119,32 +121,32 @@ exclusivePossibilities grid cellIxs = makeCell :: Data.Word.Word16 -> Maybe Cell makeCell ys - | ys == Data.Bits.zeroBits = Nothing - | Data.Bits.popCount ys == 1 = Just $ Fixed ys - | otherwise = Just $ Possible ys + | ys == Data.Bits.zeroBits = Nothing + | Data.Bits.popCount (makeFixed ys) == 1 = Just $ makeFixed ys + | otherwise = Just $ makePossible ys pruneCells :: Grid -> CellIxs -> Maybe Grid pruneCells grid cellIxs = Control.Monad.foldM pruneCell grid cellIxs where exclusives = exclusivePossibilities grid cellIxs allExclusives = setBits Data.Bits.zeroBits exclusives - fixeds = setBits Data.Bits.zeroBits [x | Fixed x <- map (grid !) cellIxs] + fixeds = setBits Data.Bits.zeroBits . filter isFixed . map (grid !) $ cellIxs 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' + pruneCellByFixed g (i, xs) + | isFixed xs = Just g + | xs' == xs = Just g + | otherwise = flip (replaceCell i) g <$> makeCell xs' where xs' = xs Data.Bits..&. Data.Bits.complement fixeds - pruneCellByExclusives g (_, Fixed _) = Just g - pruneCellByExclusives g (i, Possible xs) - | null exclusives = Just g - | intersection == xs = Just g - | intersection `elem` exclusives = + pruneCellByExclusives g (i, xs) + | isFixed xs = Just g + | null exclusives = Just g + | makePossible intersection == xs = Just g + | intersection `elem` exclusives = flip (replaceCell i) g <$> makeCell intersection | otherwise = Just g where @@ -160,7 +162,7 @@ pruneGrid :: Grid -> Maybe Grid pruneGrid = fixM pruneGrid' isGridFilled :: Grid -> Bool -isGridFilled = not . Data.Foldable.any isPossible +isGridFilled = not . Data.Vector.Unboxed.any isPossible isGridInvalid :: Grid -> Bool isGridInvalid grid = @@ -169,8 +171,8 @@ isGridInvalid grid = || any isInvalidRow (map (map (grid !)) allSubGridIxs) where isInvalidRow row = - let fixeds = [x | Fixed x <- row] - emptyPossibles = [() | Possible x <- row, x == Data.Bits.zeroBits] + let fixeds = filter isFixed row + emptyPossibles = filter (== 32768) . filter isPossible $ row in hasDups fixeds || not (null emptyPossibles) hasDups l = hasDups' l [] @@ -182,21 +184,22 @@ isGridInvalid grid = nextGrids :: Grid -> (Grid, Grid) nextGrids grid = - let (i, first@(Fixed _), rest) = + let (i, first, rest) = fixCell - . Data.Foldable.minimumBy (compare `Data.Function.on` (possibilityCount . snd)) - . Data.Vector.imapMaybe (\j cell -> if isPossible cell then Just (j, cell) else Nothing) + . Data.Vector.Unboxed.minimumBy (compare `Data.Function.on` (possibilityCount . snd)) + . Data.Vector.Unboxed.imapMaybe (\j cell -> if isPossible cell then Just (j, cell) else Nothing) $ grid in (replaceCell i first grid, replaceCell i rest grid) where - possibilityCount (Possible xs) = Data.Bits.popCount xs - possibilityCount (Fixed _) = 1 + possibilityCount xs + | isPossible xs = Data.Bits.popCount xs - 1 + | otherwise = 1 - fixCell ~(i, Possible xs) = + fixCell (i, xs) = let x = Data.Bits.countTrailingZeros xs in case makeCell (Data.Bits.clearBit xs x) of Nothing -> error "Impossible case" - Just cell -> (i, Fixed (Data.Bits.bit x), cell) + Just cell -> (i, Data.Bits.bit x, cell) solve :: Grid -> Maybe Grid solve grid = pruneGrid grid >>= solve'