Advent of Code 2023 day 12

Day 12 was the first time that a different algorithm was needed for part 2 (though day 5's solution came close, as it needed a different representation using the same algorithm).

Data structures and parsing

Not a great deal to see here. I define a new type for the springs, and a Record to record a row of the input, split between the springs and the signature.

data Spring = Unknown | Damaged | Operational deriving (Show, Eq, Ord)
data Record = Record [Spring] [Int] deriving (Show, Eq, Ord)

recordsP = recordP `sepBy` endOfLine
recordP = Record <$> (many1 springP <* " ") <*> (decimal `sepBy` ",")
springP = (Unknown <$ "?") <|> (Damaged <$ "#") <|> (Operational <$ ".")

Part 1

I used a brute-force approach here, making all possible assignments of Unknown springs to Damaged or Operational, and counting how many matched the given signature.

I could generate the signature of a set of springs (assuming all the Unknown ones have been assigned) by grouping them, finding the groups of Damaged springs, then finding the length of each of them.

matchesSignature :: Record -> Bool
matchesSignature (Record springs signature) = signSprings springs == signature

signSprings :: [Spring] -> [Int]
signSprings = fmap (length) . filter ((== Damaged) . head) . group

Then I needed to find all possible assignments of Unknown springs. Rather than go through all 2ⁿ possible assignments, I decided to be a bit clever. The signature shows how many Damaged springs there are in total, and therefore I can tell how many Unknown springs need to be Damaged to reach that total. Therefore, I find all ways to pick that many springs from the possible ones.

numDamagedToPlace :: Record -> Int
numDamagedToPlace (Record springs signature) = totalDamaged - knownDamaged
  where knownDamaged = length $ filter (== Damaged) springs
        totalDamaged = sum signature
        
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)

candidates :: Record -> [[Int]]
candidates r@(Record springs _) = 
  choose (numDamagedToPlace r) (elemIndices Unknown springs)

Once I know where to assign Unknown springs to be Damaged, I can do the assignment and use that to generate all the possible assignments for a particular record:

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

With that, I can count the number of possible assignments that match that record's signature, and apply that to all the records.

part1 :: [Record] -> Int
part1 = sum . fmap countViableAssignments

countViableAssignments :: Record -> Int
countViableAssignments = length . filter matchesSignature . possibleAssignments

Part 2

The above does the small examples of part 1, but fails dismally on part 2. A better approach is needed.

The key idea is that I don't need to know how to assign the Unknown springs to be either Damaged or Operational, I just need to know how many assignments there are. If I know that for a particular Record, I can find how many assignments there are for a slightly longer Record that has this one as a suffix.

For instance, if I have a record that looks like Record (..###..:_) (3,2,:_), it has the same number of assignments as Record (.###..:_) (3,2,:_) (having dropped the first Operational spring). Similarly, if I have a record that looks like Record (###..#:_) (3,2,:_), it has the same number of assignments as Record (.#:_) (2,:_) (having dropped the first group of three Damaged springs + the next Operational spring, and the first signature). If there are Unknown springs, I should be able to fit them into one or both of the two patterns; in that case, the number of assignments for this record is the sum of each matching pattern.

That's a simple recursive relationship. I can turn that into a dynamic programming one by having a table that stores these intermediate results. If I build up the table from the shortest tails of the springs and signatures, each new Record I encounter will always have its suffixes in the table.

In this case the table is a Map from Record to number of assignments.

type Cache = M.Map Record Int

But first, a couple of utility functions that indicate if a spring (or chunk of springs) matches that pattern I want. possibleDamagedChunk checks that the next n springs can be Damaged and the one after Operational, or the next n springs can be Damaged and there are no more.

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

I then go about creating the dynamic programming table. I start by filling the outer edges, where the springs or signature are null. Most of these are zero, apart from the small section of no signature and the last few springs are Operational.

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

I fill the table first by taking each suffix of the springs; for each, I take each suffix of the signatures; for each particular combination of spring and suffix, I find the number of arrangements by looking up the values in the two relevant table cells already found.

fillTable, fillTableSigs, fillTableCell :: Cache -> Record -> Cache
fillTable table (Record springs signatures) = 
  foldr (\ss t -> fillTableSigs t (Record ss signatures)) table $ tails springs 

fillTableSigs table (Record springs signatures) = 
  foldr (\gs t -> fillTableCell t (Record springs gs)) table $ tails signatures

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

Once the table is full, I can find the number of possible arrangements by looking up the full record in the table.

countViable :: Record -> Int
countViable record = table M.! record
  where table0 = initialCache record
        table = fillTable table0 record

Unfolding the record is a combination of replicate and intercalate.

unfoldRecord :: Record -> Record
unfoldRecord (Record springs signature) = Record uSprings uSignature
  where uSprings = intercalate [Unknown] $ replicate 5 springs
        uSignature = concat $ replicate 5 signature

and the two parts are solved:

part1, part2 :: [Record] -> Int
part1 = sum . fmap countViable
part2 = sum . fmap (countViable . unfoldRecord)

Code

You can get the code from my locally-hosted Git repo, or from Gitlab.