Switched to unboxed vector
parent
bf80a77cd8
commit
73aee36b4d
|
|
@ -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'
|
||||
|
|
|
|||
Loading…
Reference in New Issue