1 -- Writeup at https://work.njae.me.uk/2022/12/19/advent-of-code-2022-day-17/
6 import qualified Data.Set as S
7 import qualified Data.Map.Strict as M
8 import Linear hiding (Trace, trace, distance)
12 type Position = V2 Int -- x, y; y increasing upwards
13 type Chamber = S.Set Position
14 type Rock = S.Set Position
16 data SimulationState = SimulationState
20 , _droppedCount :: Int
22 makeLenses ''SimulationState
24 instance Show SimulationState where
25 show sState = "SimState { _chamber = "
26 ++ (show $ sState ^. chamber)
28 ++ (show (take 5 (sState ^. jets)))
30 ++ (show (take 5 (sState ^. rocks)))
31 ++ ", _droppedCount = "
32 ++ (show (sState ^. droppedCount))
37 do dataFileName <- getDataFileName
38 text <- readFile dataFileName
39 let oneJetCycle = mkJets text
40 print $ part1 oneJetCycle
41 -- print $ (length oneJetCycle) * (length rockPics)
42 print $ part2 oneJetCycle
44 part1, part2 :: [Position] -> Int
45 part1 oneJetCycle = rocksHeight $ simulate mkRocks (cycle oneJetCycle) 2022
47 part2 oneJetCycle = calculatedHeight
48 where initState = SimulationState
50 , _jets = (cycle oneJetCycle)
54 (cycleStartState, _) = findEarliestRepeat (length oneJetCycle) initState
55 cycleRepeatState = findCycleRepeat (length oneJetCycle) cycleStartState
56 cycleStart = cycleStartState ^. droppedCount
57 cycleLength = (cycleRepeatState ^. droppedCount) - cycleStart
58 startHeight = rocksHeight cycleStartState
59 differenceHeight = (rocksHeight cycleRepeatState) - startHeight
60 afterStart = 1000000000000 - cycleStart
61 (numCycles, remainingDrops) = afterStart `divMod` cycleLength
62 finalState = (!!remainingDrops) $ iterate dropFromTop cycleStartState
63 finalHeight = rocksHeight finalState
64 calculatedHeight = finalHeight + (differenceHeight * numCycles)
66 rocksHeight :: SimulationState -> Int
67 rocksHeight state = fromMaybe -1 $ maximumOf (folded . _y) (state ^. chamber)
69 simSome :: [Position] -> Int -> Int
70 simSome oneJetCycle n = fromMaybe -1 $ maximumOf (folded . _y) (final ^. chamber)
71 where final = simulate mkRocks (cycle oneJetCycle) n
73 simulate :: [Rock] -> [Position] -> Int -> SimulationState
74 simulate rocks jets n = (!!n) $ iterate dropFromTop initState
75 where initState = SimulationState { _chamber = S.empty, _jets = jets, _rocks = rocks, _droppedCount = 0}
77 dropFromTop :: SimulationState -> SimulationState
78 dropFromTop simState = (dropRock simState (initialPlace simState))
80 & droppedCount %~ (+ 1)
82 dropRock :: SimulationState -> Rock -> SimulationState
83 dropRock simState rock
84 | rock2 == Nothing = simState & chamber %~ (S.union rock1)
86 | otherwise = dropRock (simState & jets %~ tail) $ fromJust rock2
87 where rock1 = push (simState ^. chamber) rock (head (simState ^. jets))
88 rock2 = fall (simState ^. chamber) rock1
90 initialPlace :: SimulationState -> Rock
91 initialPlace simState = S.map (^+^ (V2 2 startHeight)) rock
92 where startHeight = 4 + (fromMaybe 0 $ maximumOf (folded . _y) (simState ^. chamber))
93 rock = head $ simState ^. rocks
95 push :: Chamber -> Rock -> Position -> Rock
96 push chamber rock direction
97 -- | trace ("Before push " ++ (intercalate " : " $ [show chamber, show rock, show direction])) False = undefined
98 | disjoint && inLeft && inRight = pushedRock
100 where pushedRock = S.map (^+^ direction) rock
101 disjoint = S.null $ S.intersection pushedRock chamber
102 inLeft = (fromJust $ minimumOf (folded . _x) pushedRock) >= 0
103 inRight = (fromJust $ maximumOf (folded . _x) pushedRock) <= 6
105 fall :: Chamber -> Rock -> Maybe Rock
107 -- | trace ("Before fall " ++ (intercalate " : " $ [show chamber, show rock, show disjoint, show aboveFloor, show droppedRock])) False = undefined
108 | disjoint && aboveFloor = Just droppedRock
109 | otherwise = Nothing
110 where droppedRock = S.map (^+^ (V2 0 -1)) rock
111 disjoint = S.null $ S.intersection droppedRock chamber
112 aboveFloor = (fromJust $ minimumOf (folded . _y) droppedRock) > 0
115 findCycleRepeat :: Int -> SimulationState -> SimulationState
116 findCycleRepeat jetLength cycleStart = head $ dropWhile (differentProfiles jetLength cycleStart) hares
117 where hares = drop 1 $ iterate dropFromTop cycleStart
120 findEarliestRepeat :: Int -> SimulationState -> (SimulationState, SimulationState)
121 findEarliestRepeat jetLength simState = head $ dropWhile (uncurry (differentProfiles jetLength)) pairs
122 where tortoises = drop 1 $ iterate dropFromTop simState
123 hares = drop 1 $ iterate (dropFromTop . dropFromTop) simState
124 pairs = zip tortoises hares
126 differentProfiles :: Int -> SimulationState -> SimulationState -> Bool
127 differentProfiles jetLength t h = (simulationProfile jetLength t) /= (simulationProfile jetLength h)
129 simulationProfile :: Int -> SimulationState -> (Chamber, [Position], Rock)
130 simulationProfile jetLength state =
131 ( surfaceProfile state
132 , take jetLength $ state ^. jets
133 , head $ state ^. rocks
136 surfaceProfile :: SimulationState -> Chamber
137 surfaceProfile state = S.fromList $ map (^-^ (V2 0 peak)) rawProfile
138 where ch = state ^. chamber
139 rawProfile = [V2 i (fromMaybe -1 $ maximumOf (folded . filteredBy (_x . only i) . _y) ch) | i <- [0..6] ]
140 peak = fromJust $ maximumOf (folded . _y) rawProfile
142 showChamber :: Chamber -> String
143 showChamber chamber = unlines
144 [ [showCell x y | x <- [0..6]]
145 | y <- reverse [1..yMax]
147 where yMax = fromMaybe 0 $ maximumOf (folded . _y) chamber
149 | (V2 x y) `S.member` chamber = '#'
152 mkJets :: String -> [Position]
154 where mkJet '<' = V2 -1 0
156 mkJet _ = error "Illegal jet character"
159 mkRocks = cycle $ fmap mkRock rockPics
161 mkRock :: String -> Rock
162 mkRock rockPic = S.fromList
164 | x <- [0..((length (rockLines!!0)) - 1)]
165 , y <- [0..((length rockLines) - 1)]
166 , (rockLines!!y)!!x == '#'
168 where rockLines = reverse $ lines rockPic
171 rockPics = ["####", ".#.\n###\n.#.", "..#\n..#\n###", "#\n#\n#\n#", "##\n##"]