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

Merges two pruning strategies for speedup

master
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
| 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