X-Git-Url: https://git.njae.me.uk/?a=blobdiff_plain;f=advent12%2FMain.hs;h=2c07b389c78b434da585a14d2c2bc5d40a3bf214;hb=1d4b99f4d671d943b51a1a1e5f48c906f6da7aa6;hp=78af0a1657468e17b47be9506d0fb650fa7d27bd;hpb=eec28208f9b74e65a360b374fcd90b5406fdf527;p=advent-of-code-23.git diff --git a/advent12/Main.hs b/advent12/Main.hs index 78af0a1..2c07b38 100644 --- a/advent12/Main.hs +++ b/advent12/Main.hs @@ -1,20 +1,17 @@ --- 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 qualified Data.Text.IO as TIO -import Data.Attoparsec.Text -- hiding (take) +import Data.Attoparsec.Text hiding (take, takeWhile) import Control.Applicative import Data.List import qualified Data.Map.Strict as M -import Data.Maybe -import Control.Monad.State.Strict -data Spring = Unknown | Damaged | Operational deriving (Show, Eq) -data Record = Record [Spring] [Int] deriving (Show) +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 () @@ -23,77 +20,61 @@ main = 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 part1, part2 :: [Record] -> Int -part1 = sum . fmap countViableAssignments -part2 = sum . fmap (countViableAssignments . unfoldRecord) +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 -> CacheState Int - - -countViable previousSprings (Record (s:springs) (g:signature)) = - - --- if next few springs can match next 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 - +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 + where cache0 = M.union sprs sigs + sprs = M.fromList $ fmap (\s -> (Record s [], 0)) $ tails springs + sigs = M.fromList $ fmap (\g -> (Record [] g, 0)) $ tails signature + lastOperationalChunk = + reverse $ takeWhile isPossOperational $ reverse springs + 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 +isPossOperational _ = False + +isPossDamaged :: Spring -> Bool +isPossDamaged Damaged = True +isPossDamaged Unknown = True +isPossDamaged _ = False + +possibleDamagedChunk :: [Spring] -> Int -> Bool +possibleDamagedChunk springs n = + isDamagedChunk && ((null afterChunk) || (isPossOperational $ head afterChunk)) + where isDamagedChunk = (length $ filter isPossDamaged $ take n springs) == n + afterChunk = drop n springs + -- Parse the input file recordsP :: Parser [Record]