Day 4 was, I think, the most straightforward day so far. The challenge was about representing a set of occupied positions and finding the number of occupied neighbours of each.

I only need to track the presence or absence of a roll of paper in each position. That suggests representing the whole grid as a Set of Positions and manipulating that. Reading the input is a case of iterating over the text file, adding elements to the set as needed.

type Position = V2 Int -- r, c
type Rolls = S.Set Position

mkRolls :: String -> Rolls
mkRolls text = rolls
  where rows = takeWhile (not . null) $ lines text
        rMax = length rows - 1
        cMax = (length $ head rows) - 1
        rolls = S.fromList [ V2 r c | r <- [0..rMax]
                                    , c <- [0..cMax]
                                    , rows !! r !! c == '@' ]

This has the advantage that I don't need to worry about bounds checking in an array of positions.

Part 1

A roll is accessible if it has fewer than four neighbours; in other words, fewer than four of its neighbouring positions are occupied. That definition translates fairly directly into Haskell. neighbours generates a set of neighbouring positions of here. accessible intersects that set with the set of occupied positions, and returns True if there are fewer than four of them

accessible :: Rolls -> Position -> Bool
accessible rolls here = (S.size $ S.intersection (neighbours here) rolls) < 4

neighbours :: Position -> Rolls
neighbours here = 
  S.fromList $ fmap (here ^+^) [V2 r c | r <- [-1 .. 1], c <- [-1 .. 1]
                                       , r /= 0 || c /= 0
                                       ]

The solution to part 1 is the number of accessible rolls. Again, a direct translation into Haskell: find the accessible rolls, then count them.

part1 :: Rolls -> Int
part1 rolls = S.size $ S.filter (accessible rolls) rolls

Part 2

This requires me to remove the accessible rolls, and keep going until no more rolls are accessible.

The overall shape of of the solution is to do a removeStep to remove all the immediately accessible rolls, then iterate to do the removal again and again. The problem is that iterate generates an infinite list of solutions, so I need to detect when no more rolls are accessible. That's easy enough to track by having removeStep return a pair of values: whether any rolls are accessible, and the result of removing the accessible ones.

removeStep :: (Bool, Rolls) -> (Bool, Rolls)
removeStep (_, rolls) = 
  let removable = S.filter (accessible rolls) rolls
  in (not $ S.null removable, rolls S.\\ removable)

removeAll does an iterate over the steps, throwing away configurations that still have accessible rolls, and returning the first one without.

removeAll :: Rolls -> Rolls
removeAll rolls = snd $ head $ dropWhile fst $ iterate removeStep (True, rolls)

The solution is comparing the sizes of the sets before and after the removals.

part2 :: Rolls -> Int
part2 rolls = (S.size rolls) - (S.size afterRemoval)
  where afterRemoval = removeAll rolls

Code

You can get the code from Codeberg.