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
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:
- In a particular position and falling
- In a particular position and blocked from falling further
- 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)
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
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
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)