--- Writeup at https://work.njae.me.uk/2023/12/08/advent-of-code-2023-day-8/
+-- Writeup at https://work.njae.me.uk/2023/12/15/advent-of-code-2023-day-12/
import AoC
import Data.Text (Text)
import Control.Applicative
import Data.List
import qualified Data.Map.Strict as M
-import Data.Maybe
data Spring = Unknown | Damaged | Operational deriving (Show, Eq, Ord)
data Record = Record [Spring] [Int] deriving (Show, Eq, Ord)
type Cache = M.Map Record Int
--- type CacheState = State Cache
main :: IO ()
text <- TIO.readFile dataFileName
let records = successfulParse text
-- print records
- -- print $ fmap numDamagedToPlace records
- -- print $ fmap candidates records
- -- print $ possibleAssignments (records !! 1)
- -- print $ fmap countViableAssignments records
print $ part1 records
- print $ unfoldRecord $ head records
- -- print $ part2 records
+ print $ part2 records
-part1 :: [Record] -> Int
-part1 = sum . fmap countViableAssignments
--- part2 = sum . fmap (countViableAssignments . unfoldRecord)
+part1, part2 :: [Record] -> Int
+part1 = sum . fmap countViable
+part2 = sum . fmap (countViable . unfoldRecord)
unfoldRecord :: Record -> Record
unfoldRecord (Record springs signature) = Record uSprings uSignature
where uSprings = intercalate [Unknown] $ replicate 5 springs
uSignature = concat $ replicate 5 signature
-
+countViable :: Record -> Int
+countViable record = table M.! record
+ where table0 = initialCache record
+ table = fillTable table0 record
initialCache :: Record -> Cache
initialCache (Record springs signature) = M.union lastOperational cache0
lastOperational =
M.fromList $ fmap (\s -> (Record s [], 1)) $ tails lastOperationalChunk
+fillTableCell, fillTableSigs, fillTable :: Cache -> Record -> Cache
+fillTableCell table record
+ | record `M.member` table = table
+ | otherwise = M.insert record (opN + signN) table
+ where (Record springs@(s:ss) signatures@(g:gs)) = record
+ opN = if (isPossOperational s) then table M.! (Record ss signatures) else 0
+ signN = if (possibleDamagedChunk springs g) then table M.! (Record (drop (g + 1) springs) gs) else 0
+
+fillTableSigs table (Record springs signatures) = foldr (\gs t -> fillTableCell t (Record springs gs)) table $ tails signatures
+
+fillTable table (Record springs signatures) = foldr (\ss t -> fillTableSigs t (Record ss signatures)) table $ tails springs
+
isPossOperational :: Spring -> Bool
isPossOperational Operational = True
isPossOperational Unknown = True
possibleDamagedChunk :: [Spring] -> Int -> Bool
possibleDamagedChunk springs n =
- isDamagedChunk && ((null afterChunk) || (possOperational $ head afterChunk))
+ isDamagedChunk && ((null afterChunk) || (isPossOperational $ head afterChunk))
where isDamagedChunk = (length $ filter isPossDamaged $ take n springs) == n
- afterChunk = take 1 $ drop n springs
-
-
--- countViable previousSprings (Record (s:springs) (g:signature)) =
-
-
--- count: either consume this group or not
-
-
--- cache is how many ways to assign unknowns, leaving this partial record.
--- first item of springs is unknown or damaged
--- count = count_consuming_group + count_leaving_group
--- if first spring is damaged: count = count_consuming_group
-
-
-
--- if first spring is damaged and next few springs can match next group:
--- consume springs (including all following operational ones), consume group
--- Add to cache: record' -> cache ! original
--- return countViable record'
--- if first spring is unknown
--- assume it's damaged, consume springs, consume group
-
-
-
-
-
--- countViable (springs after group) (tail groups) + countViable (tail springs) groups
--- else
--- countViable (tail springs) groups
-
-
-
-countViableAssignments :: Record -> Int
-countViableAssignments = length . filter matchesSignature . possibleAssignments
-
-matchesSignature :: Record -> Bool
-matchesSignature (Record springs signature) = signSprings springs == signature
-
-signSprings :: [Spring] -> [Int]
-signSprings = fmap (length) . filter ((== Damaged) . head) . group
-
-choose :: Int -> [a] -> [[a]]
-choose 0 _ = [[]]
-choose n (x:xs)
- | length xs == n - 1 = [(x:xs)]
- | otherwise = (fmap (x:) (choose (n-1) xs)) ++ (choose n xs)
-
--- unknownIndices :: [Spring] -> [Int]
--- unknownIndices = elemIndices Unknown
-
-numDamagedToPlace :: Record -> Int
-numDamagedToPlace (Record springs signature) = totalDamaged - knownDamaged
- where knownDamaged = length $ filter (== Damaged) springs
- totalDamaged = sum signature
-
-candidates :: Record -> [[Int]]
-candidates r@(Record springs _) =
- choose (numDamagedToPlace r) (elemIndices Unknown springs)
-
-replaceUnknowns :: [Spring] -> [Int] -> [Spring]
-replaceUnknowns springs indices = foldr go [] indexedSprings
- where indexedSprings = zip [0..] springs
- go (i, Unknown) acc = if (i `elem` indices) then Damaged:acc
- else Operational:acc
- go (_, s) acc = s:acc
-
-possibleAssignments :: Record -> [Record]
-possibleAssignments r@(Record springs signature) =
- fmap (\p -> Record p signature) possibles
- where cands = candidates r
- possibles = fmap (replaceUnknowns springs) cands
-
+ afterChunk = drop n springs
+
-- Parse the input file
recordsP :: Parser [Record]