Day 17 was another problem where the approach to part 2 had to be very different from part 1. Part 1 was a simulation of the rocks dropping. Part 2 was about finding repeated states in that process, and using that to avoid doing excessive computation.
Part 1
Representation
The simulation relies a lot on Haskell's laziness. I generate infinite lists of gas jets, rocks, and simulated states, then pick out just the elements of these that I need. I greatly simplifies the code, as I don't need to keep caching particular states of the simulation.
The core of the simulation is the SimulationState
, that represents the current simulation: the chamber containing dropped rocks, the infinite list of upcoming gas jets, the infinite list of upcoming rocks, and the number of rocks that have been dropped so far. There's also a custom Show
instance, to show the state without asking Haskell to print the entire infinite lists!
type Position = V2 Int -- x, y; y increasing upwards
type Chamber = S.Set Position
type Rock = S.Set Position
data SimulationState = SimulationState
{ _chamber :: Chamber
, _jets :: [Position]
, _rocks :: [Rock]
, _droppedCount :: Int
} deriving (Eq, Ord)
makeLenses ''SimulationState
instance Show SimulationState where
show sState = "SimState { _chamber = "
++ (show $ sState ^. chamber)
++ ", _jets = "
++ (show (take 5 (sState ^. jets)))
++ ", _rocks = "
++ (show (take 5 (sState ^. rocks)))
++ ", _droppedCount = "
++ (show (sState ^. droppedCount))
++ " }"
Making the list of jets and rocks is simple enough, using cycle
to generate the infinite lists.
mkJets :: String -> [Position]
mkJets = fmap mkJet
where mkJet '<' = V2 -1 0
mkJet '>' = V2 1 0
mkJet _ = error "Illegal jet character"
mkRocks :: [Rock]
mkRocks = cycle $ fmap mkRock rockPics
mkRock :: String -> Rock
mkRock rockPic = S.fromList
[ V2 x y
| x <- [0..((length (rockLines!!0)) - 1)]
, y <- [0..((length rockLines) - 1)]
, (rockLines!!y)!!x == '#'
]
where rockLines = reverse $ lines rockPic
rockPics :: [String]
rockPics = ["####", ".#.\n###\n.#.", "..#\n..#\n###", "#\n#\n#\n#", "##\n##"]
Finally, I have a utility function for drawing pictures of hte chamber, which was useful for debugging the simulation.
showChamber :: Chamber -> String
showChamber chamber = unlines
[ [showCell x y | x <- [0..6]]
| y <- reverse [1..yMax]
] ++ "-------"
where yMax = fromMaybe 0 $ maximumOf (folded . _y) chamber
showCell x y
| (V2 x y) `S.member` chamber = '#'
| otherwise = '.'
Simulation
Each sub-step of the simulation, pushing and falling, is a function. push
checks that the pushed rock is still inside the chamber and doesn't overlap any static rocks. fall
drops the rock if possible, and returns Nothing
if the rock should come to rest.
push chamber rock direction
| disjoint && inLeft && inRight = pushedRock
| otherwise = rock
where pushedRock = S.map (^+^ direction) rock
disjoint = S.null $ S.intersection pushedRock chamber
inLeft = (fromJust $ minimumOf (folded . _x) pushedRock) >= 0
inRight = (fromJust $ maximumOf (folded . _x) pushedRock) <= 6
fall chamber rock
| disjoint && aboveFloor = Just droppedRock
| otherwise = Nothing
where droppedRock = S.map (^+^ (V2 0 -1)) rock
disjoint = S.null $ S.intersection droppedRock chamber
aboveFloor = (fromJust $ minimumOf (folded . _y) droppedRock) > 0
dropRock
combines these two stages, updating the simulation state as it goes.
dropRock simState rock
| rock2 == Nothing = simState & chamber %~ (S.union rock1)
& jets %~ tail
| otherwise = dropRock (simState & jets %~ tail) $ fromJust rock2
where rock1 = push (simState ^. chamber) rock (head (simState ^. jets))
rock2 = fall (simState ^. chamber) rock1
Finally, dropFromTop
simulates the entire fall of a rock, from when it appears to when it comes to rest.
dropFromTop simState = (dropRock simState (initialPlace simState))
& rocks %~ tail
& droppedCount %~ (+ 1)
initialPlace simState = S.map (^+^ (V2 2 startHeight)) rock
where startHeight = 4 + (fromMaybe 0 $ maximumOf (folded . _y) (simState ^. chamber))
rock = head $ simState ^. rocks
The simulate
function creates the initial simulation state and uses iterate
to find the desired state, and rocksHeight
makes heavy use of lenses to find the height of a pile of rocks.
part1 oneJetCycle = rocksHeight $ simulate mkRocks (cycle oneJetCycle) 2022
rocksHeight state = fromMaybe -1 $ maximumOf (folded . _y) (state ^. chamber)
simulate rocks jets n = (!!n) $ iterate dropFromTop initState
where initState = SimulationState { _chamber = S.empty, _jets = jets, _rocks = rocks, _droppedCount = 0}
Part 2
Obviously, simulating 1012 rocks is infeasible, so I need another approach. The good news is I don't need to know the detail of all the dropped rocks to know where the next rock will end up. All that's needed is the shape of the top of the pile, alongside where I am in the cycle of jets and rocks. As the chamber isn't very wide, that arrangement will reappear fairly soon.
First, I need to capture the salient parts of the simulation into a "simulation profile", using the heights in each column relative to the highest column, along with the next bunch of jets and the next rock.
simulationProfile jetLength state =
( surfaceProfile state
, take jetLength $ state ^. jets
, head $ state ^. rocks
)
surfaceProfile state = S.fromList $ map (^-^ (V2 0 peak)) rawProfile
where ch = state ^. chamber
rawProfile = [V2 i (fromMaybe -1 $ maximumOf (folded . filteredBy (_x . only i) . _y) ch) | i <- [0..6] ]
peak = fromJust $ maximumOf (folded . _y) rawProfile
I use Floyd's "tortoise and hare" algorithm for finding those repeated states, and the cycle length. The first stage is to find a repeated state, by running two simulations in parallel. I check on the second after every two simulation steps. These two simulations will be the same profile after some multiple of the repeating-cycle length.
Again, laziness is useful as I can just declare two infinite simulations and throw away the states that don't match.
findEarliestRepeat jetLength simState = head $ dropWhile (uncurry (differentProfiles jetLength)) pairs
where tortoises = drop 1 $ iterate dropFromTop simState
hares = drop 1 $ iterate (dropFromTop . dropFromTop) simState
pairs = zip tortoises hares
differentProfiles jetLength t h = (simulationProfile jetLength t) /= (simulationProfile jetLength h)
Once I have the state where the cycle starts, I can find the cycle length by doing another simulation from there.
findCycleRepeat jetLength cycleStart = head $ dropWhile (differentProfiles jetLength cycleStart) hares
where hares = drop 1 $ iterate dropFromTop cycleStart
Given these two simulation states, I can find the final height with a bit of arithmetic.
For the example given in the problem, the cycle starts after 35 rocks have dropped (for a height of 60), and the same profile is reached after 70 rocks have dropped (with a height of 113). That means that, after 35 rocks, each additional 70 - 35 = 35 rocks increases the height of the pile by 113 - 60 = 53.
I can make a pile of 1,000,000,000,000 rocks by dropping the initial 35, then 2,8571,428,570 repeats of 35 rocks, then a final 15 rocks. Those repeated cycles add 1,514,285,714,210 to the height of the pile.
If I drop the initial 35 rocks, then the final 15, that gives me a height of 78. If I add the 1,514,285,714,210 from the repeated groups, that gives a final pile height of 1,514,285,714,288. And that's the answer!
part2 oneJetCycle = calculatedHeight
where initState = SimulationState
{ _chamber = S.empty
, _jets = (cycle oneJetCycle)
, _rocks = mkRocks
, _droppedCount = 0
}
(cycleStartState, _) = findEarliestRepeat (length oneJetCycle) initState
cycleRepeatState = findCycleRepeat (length oneJetCycle) cycleStartState
cycleStart = cycleStartState ^. droppedCount
cycleLength = (cycleRepeatState ^. droppedCount) - cycleStart
startHeight = rocksHeight cycleStartState
differenceHeight = (rocksHeight cycleRepeatState) - startHeight
afterStart = 1000000000000 - cycleStart
(numCycles, remainingDrops) = afterStart `divMod` cycleLength
finalState = (!!remainingDrops) $ iterate dropFromTop cycleStartState
finalHeight = rocksHeight finalState
calculatedHeight = finalHeight + (differenceHeight * numCycles)
Code
You can get the code from my locally-hosted Git repo, or from Gitlab.