Advent of Code 2022 day 17

    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.

    Neil Smith

    Read more posts by this author.