advent of code, haskell

Advent of Code 2022 day 14

Day 14 was more about finding a good representation for the problem than hard algorithms.

Representation

Positions were again represented as V2 Int objects, with the format like V2 x y. The cave complex was a Set of Positions, showing the occupied spaces in the cave. The input showed the initially-occupied spaces, with more spaces occupied as the sand piles up.

I parsed the input into the straight-line segments, then used those in some folds to add the "stone" spaces. Note the use of range from the Ix class to yield all the spaces in the segment.

-- Data

type Position = V2 Int -- x, y, y increasing down.

type Cave = S.Set Position

-- Parser

wallsP = wallP `sepBy` endOfLine
wallP = cornerP `sepBy` " -> "
cornerP = V2 <$> (decimal <* ",") <*> decimal

-- Cave construction

mkCave :: [[Position]] -> Cave
mkCave walls = foldl' addWall S.empty walls

addWall :: Cave -> [Position] -> Cave
addWall cave wall = foldl' addSegment cave segments
  where segments = zip wall $ tail wall

addSegment :: Cave -> (Position, Position) -> Cave
addSegment cave segment = S.union cave segments
  where segments = S.fromList $ range (uncurry min segment, uncurry max segment)

It took a while to work out how to represent a grain of sand. While a grain of sand is moving, it has three possible states:

  1. In a particular position and falling
  2. In a particular position and blocked from falling further
  3. Escaped below the open floor.

Similarly, the floor was either Open, allowing sand to fall into the bottomless void, or Closed, allowing sand to pile up. In both cases, the floor has a height of interest.

data Sand = Falling Position | Blocked Position | Escaped
  deriving (Eq, Show)

-- open floor: sand escapes below given level
-- closed floor: sand blocked by floor with this y
data Floor = Open Int | Closed Int deriving (Eq, Show)

Simulating sand

I started at the lowest level I could, simulating one step of the movement of one grain of sand. What it does depends on whether the sand is falling, where it is, and the type and position of the floor.

The simple cases are simple: if a grain is blocked, it remains blocked there. If it has escaped, it remains escaped.

If it is Falling towards an Open floor, and is now below the level of that floor, we can call it Escaped. Otherwise, I look for the places it could fall to (in priority order) and move the grain to the first of them that's vacant, where the grain is still Falling. If there are no vacant places to fall into, the grain becomes Blocked.

If the grain is Falling towards a Closed floor, the process is similar. However, rather than checking if the grain has escaped, I define a vacant space to be one that has no sand or stone, and is above the implicit floor level.

fallDirections :: [Position]
fallDirections = [V2 0 1, V2 -1 1, V2 1 1]

fallStep :: Sand -> Cave -> Floor -> Sand
fallStep (Blocked here) _ _ = Blocked here
fallStep Escaped _ _ = Escaped
fallStep (Falling here) cave (Open floorY)
  | here ^. _y > floorY = Escaped
  | otherwise = maybe (Blocked here) Falling $ find vacant 
                                             $ fmap (here ^+^) fallDirections  
  where vacant there = there `S.notMember` cave
fallStep (Falling here) cave (Closed floorY) = 
  maybe (Blocked here) Falling $ find vacant $ fmap (here ^+^) fallDirections
  where vacant there = (there ^. _y < floorY) && (there `S.notMember` cave)

Given the motion of one step of one grain, I can find where a grain ends up by calling fallStep repeatedly. That's what fallsTo does, reporting either where the grain is Blocked at rest, or that it's Escaped.

fallsTo :: Sand -> Cave -> Floor -> Sand
fallsTo here cave floorY =
  case fallStep here cave floorY of
    Escaped -> Escaped
    Blocked there -> Blocked there
    Falling there -> fallsTo (Falling there) cave floorY

dropOneSand handles updating the cave with where the sand grain rests. If the grain is blocked, it's added to the cave and Just cave is returned. If the grain escapes, Nothing is returned.

sandOrigin :: Position
sandOrigin = V2 500 0

dropOneSand :: Cave -> Floor -> Maybe Cave
dropOneSand cave floorY = 
  case (fallsTo (Falling sandOrigin) cave floorY) of
    Escaped -> Nothing
    Blocked there -> Just (S.insert there cave)
    Falling _ -> error "sand still falling"

dropManySand uses that return value to drop all the sand until nothing changes. That's when either the start position is occupied, or a sand grain has escaped.

dropManySand :: Cave -> Floor -> Cave
dropManySand cave floorY 
  | sandOrigin `S.member` cave = cave
  | otherwise = case dropOneSand cave floorY of
                  Nothing -> cave
                  Just cave' -> dropManySand cave' floorY

All that's left is to put the parts together, by starting the simulation with the apporpriate floor and counting how much more is in the cave after the simulation has finished.

main :: IO ()
main = 
  do  dataFileName <- getDataFileName
      text <- TIO.readFile dataFileName
      let corners = successfulParse text
      let stone = mkCave corners
      let floorY = fromJust $ maximumOf (folded . _y) stone 
      print $ part1 stone floorY 
      print $ part2 stone floorY 

part1, part2 :: Cave -> Int -> Int
part1 stone floorY = sandQty
  where filledCave = dropManySand stone (Open floorY)
        sandQty = (S.size filledCave) - (S.size stone)
part2 stone floorY = sandQty
  where filledCave = dropManySand stone (Closed (floorY + 2))
        sandQty = (S.size filledCave) - (S.size stone)

Code

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