Advent of Code 2022 day 14

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


    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)


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

    Neil Smith

    Read more posts by this author.