Uses custom accumulator in exclusivePossibilities for speedup

custom-accumulator
Abhinav Sarkar 2018-07-17 11:17:34 +05:30
parent 5a3044e09c
commit 9cd590b172
1 changed files with 28 additions and 5 deletions

View File

@ -53,20 +53,43 @@ showGridWithPossibilities = unlines . map (unwords . map showCell)
showCell (Possible xs) =
"[" ++ map (\i -> if Data.Bits.testBit xs i then Data.Char.intToDigit i else ' ') [1..9] ++ "]"
-- Exclusive Possibilities Accumulator
data ExPosAcc = ExPosAcc ![Int] ![Int] ![Int] ![Int] ![Int] ![Int] ![Int] ![Int] ![Int]
exPosAccEmpty :: ExPosAcc
exPosAccEmpty = ExPosAcc [] [] [] [] [] [] [] [] []
exPosAccInsert :: Int -> Int -> ExPosAcc -> ExPosAcc
exPosAccInsert 1 i (ExPosAcc v1 v2 v3 v4 v5 v6 v7 v8 v9) = ExPosAcc (i:v1) v2 v3 v4 v5 v6 v7 v8 v9
exPosAccInsert 2 i (ExPosAcc v1 v2 v3 v4 v5 v6 v7 v8 v9) = ExPosAcc v1 (i:v2) v3 v4 v5 v6 v7 v8 v9
exPosAccInsert 3 i (ExPosAcc v1 v2 v3 v4 v5 v6 v7 v8 v9) = ExPosAcc v1 v2 (i:v3) v4 v5 v6 v7 v8 v9
exPosAccInsert 4 i (ExPosAcc v1 v2 v3 v4 v5 v6 v7 v8 v9) = ExPosAcc v1 v2 v3 (i:v4) v5 v6 v7 v8 v9
exPosAccInsert 5 i (ExPosAcc v1 v2 v3 v4 v5 v6 v7 v8 v9) = ExPosAcc v1 v2 v3 v4 (i:v5) v6 v7 v8 v9
exPosAccInsert 6 i (ExPosAcc v1 v2 v3 v4 v5 v6 v7 v8 v9) = ExPosAcc v1 v2 v3 v4 v5 (i:v6) v7 v8 v9
exPosAccInsert 7 i (ExPosAcc v1 v2 v3 v4 v5 v6 v7 v8 v9) = ExPosAcc v1 v2 v3 v4 v5 v6 (i:v7) v8 v9
exPosAccInsert 8 i (ExPosAcc v1 v2 v3 v4 v5 v6 v7 v8 v9) = ExPosAcc v1 v2 v3 v4 v5 v6 v7 (i:v8) v9
exPosAccInsert 9 i (ExPosAcc v1 v2 v3 v4 v5 v6 v7 v8 v9) = ExPosAcc v1 v2 v3 v4 v5 v6 v7 v8 (i:v9)
exPosAccInsert _ _ _ = error "Impossible"
exPosAccToList :: ExPosAcc -> [(Int, [Int])]
exPosAccToList (ExPosAcc v1 v2 v3 v4 v5 v6 v7 v8 v9) =
[(1, v1), (2, v2), (3, v3), (4, v4), (5, v5), (6, v6), (7, v7), (8, v8), (9, v9)]
exclusivePossibilities :: [Cell] -> [Data.Word.Word16]
exclusivePossibilities row =
row
& zip [1..9]
& zip ([1..9] :: [Int])
& filter (isPossible . snd)
& Data.List.foldl'
(\acc ~(i, Possible xs) ->
Data.List.foldl'
(\acc' n -> if Data.Bits.testBit xs n then Map.insertWith prepend n [i] acc' else acc')
(\acc' n -> if Data.Bits.testBit xs n then exPosAccInsert n i acc' else acc')
acc
[1..9])
Map.empty
& Map.filter ((< 4) . length)
& Map.foldlWithKey'(\acc x is -> Map.insertWith prepend is [x] acc) Map.empty
exPosAccEmpty
& exPosAccToList
& filter ((< 4) . length . snd)
& Data.List.foldl' (\acc (x, is) -> Map.insertWith prepend is [x] acc) Map.empty
& Map.filterWithKey (\is xs -> length is == length xs)
& Map.elems
& map (Data.List.foldl' Data.Bits.setBit Data.Bits.zeroBits)