abhin4v/hasdoku
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merges two pruning strategies for speedup

Browse Source
This commit is contained in:
Abhinav Sarkar 2018-07-17 23:13:30 +05:30
parent 08f51aa82e
commit a320a7874c
1 changed files with 14 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
src/Sudoku.hs
View File

@ -97,30 +97,27 @@ makeCell ys
| Data.Bits.popCount ys == 1 = Just $ Fixed ys | Data.Bits.popCount ys == 1 = Just $ Fixed ys
| otherwise = Just $ Possible ys | otherwise = Just $ Possible ys
pruneCellsByFixed :: Grid -> CellIxs -> Maybe Grid pruneCells :: Grid -> CellIxs -> Maybe Grid
pruneCellsByFixed grid cellIxs = pruneCells grid cellIxs = Control.Monad.foldM pruneCell grid cellIxs
Control.Monad.foldM pruneCell grid . map (\i -> (i, grid ! i)) $ cellIxs
where 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 =
pruneCell g (i, Possible xs) 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 | xs' == xs = Just g
| otherwise = flip (replaceCell i) g <$> makeCell xs' | otherwise = flip (replaceCell i) g <$> makeCell xs'
where where
xs' = xs Data.Bits..&. Data.Bits.complement fixeds xs' = xs Data.Bits..&. Data.Bits.complement fixeds
pruneCellsByExclusives :: Grid -> CellIxs -> Maybe Grid pruneCellByExclusives g (_, Fixed _) = Just g
pruneCellsByExclusives grid cellIxs = case exclusives of pruneCellByExclusives g (i, Possible xs)
[] -> Just grid | null exclusives = Just g
_ -> 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)
| intersection == xs = Just g | intersection == xs = Just g
| intersection `elem` exclusives = | intersection `elem` exclusives =
flip (replaceCell i) g <$> makeCell intersection flip (replaceCell i) g <$> makeCell intersection
@ -128,11 +125,6 @@ pruneCellsByExclusives grid cellIxs = case exclusives of
where where
intersection = xs Data.Bits..&. allExclusives 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 -> Maybe Grid
pruneGrid' grid = pruneGrid' grid =
Control.Monad.foldM pruneCells grid allRowIxs Control.Monad.foldM pruneCells grid allRowIxs