diff --git a/2022/day17.hs b/2022/day17.hs new file mode 100644 index 0000000..0e32481 --- /dev/null +++ b/2022/day17.hs @@ -0,0 +1,98 @@ +import qualified Data.Set as S +import Debug.Trace (traceShow) + +type Coord = (Integer, Integer) +type Rock = [Coord] + +rockFix :: Rock -> Rock +rockFix xs = let maxy = maximum (map snd xs) in map (\(x,y) -> (x+2, y-maxy)) xs + +rocks :: [Rock] +rocks = map rockFix + [ [(0,0), (1,0), (2,0), (3,0)] + , [(1,0), (0,1), (1,1), (2,1), (1,2)] + , [(2,0), (2,1), (0,2), (1,2), (2,2)] + , [(0,0), (0,1), (0,2), (0,3)] + , [(0,0), (0,1), (1,0), (1,1)] + ] + +simulate :: [Rock] -> Maybe Rock -> String -> S.Set Coord -> Integer -> S.Set Coord +simulate [] _ _ _ _ = error "finite stream of rocks" +simulate (r:rs) Nothing jets occupied 0 = occupied +simulate (r:rs) Nothing jets occupied n = simulate rs (Just next) jets occupied (n-1) where + height = minimum (1 : map snd (S.toList occupied)) - 4 + next = map (\(x,y) -> (x, y+height)) r +simulate (r:rs) (Just rock) (j:js) occupied remaining = if valid dropped + then simulate (r:rs) (Just dropped) js occupied remaining + else simulate (r:rs) Nothing js occupied' remaining + where + pushF = case j of + '>' -> \(x,y) -> (x+1, y) + '<' -> \(x,y) -> (x-1, y) + _ -> error ("invalid char" ++ show j) + dropF (x,y) = (x, y+1) + valid = all (\c@(x,y) -> c `S.notMember` occupied + && x >= 0 && x < 7 && y <= 0) + pushed = if valid (map pushF rock) then map pushF rock else rock + dropped = map dropF pushed + occupied' = foldr S.insert occupied pushed + + +-- simulate2 :: [Rock] -> String -> [Rock] -> Maybe Rock -> String -> S.Set Coord -> Integer -> Integer -> Integer +-- simulate2 origR origJ [] _ _ _ _ _ = error "finite stream of rocks" +-- simulate2 origR origJ (r:rs) Nothing jets occupied 0 iters = undefined +-- simulate2 origR origJ (r:rs) Nothing jets occupied n iters = if iters > 0 && matchesR && matchesJ +-- then let h = minimum (map snd (S.toList occupied)) in +-- let repetitions = n `div` iters in +-- let addedHeight = h * repetitions in addedHeight + simulate2 origR origJ (r:rs) Nothing jets occupied (n `mod` iters) 0 +-- else simulate2 origR origJ rs (Just next) jets occupied (n-1) (iters+1) where +-- height = minimum (1 : map snd (S.toList occupied)) - 4 +-- next = map (\(x,y) -> (x, y+height)) r +-- matchesR = origR == take (length origR) (r:rs) +-- matchesJ = origJ == take (length origJ) jets +-- simulate2 origR origJ (r:rs) (Just rock) (j:js) occupied remaining iters = if valid dropped +-- then simulate2 origR origJ (r:rs) (Just dropped) js occupied remaining iters +-- else simulate2 origR origJ (r:rs) Nothing js occupied' remaining iters +-- where +-- pushF = case j of +-- '>' -> \(x,y) -> (x+1, y) +-- '<' -> \(x,y) -> (x-1, y) +-- _ -> error ("invalid char" ++ show j) +-- dropF (x,y) = (x, y+1) +-- valid = all (\c@(x,y) -> c `S.notMember` occupied +-- && x >= 0 && x < 7 && y <= 0) +-- pushed = if valid (map pushF rock) then map pushF rock else rock +-- dropped = map dropF pushed +-- occupied' = foldr S.insert occupied pushed + + +main :: IO () +main = do + jets <- head . lines <$> getContents + let height set = -(minimum $ map snd (S.toList set)) + 1 + + putStr "part 1: " + let tower = simulate (cycle rocks) Nothing (cycle jets) S.empty 2022 + print (height tower) + + -- part 2 + let repIters = lcm (fromIntegral $ length jets) (fromIntegral $ length rocks) :: Integer + putStr "repeated: " >> print repIters + + let initial = simulate (cycle rocks) Nothing (cycle jets) S.empty repIters + let repeated = simulate (cycle rocks) Nothing (cycle jets) S.empty (2*repIters) + + let diff ls = zipWith (-) (tail ls) ls + print $ diff $ map (\i -> height $ simulate (cycle rocks) Nothing (cycle jets) S.empty (i*repIters)) [1..20] + + let initHeight = height initial + let repHeight = height repeated - initHeight + putStr "repeated structure height: " >> print (initHeight, repHeight) + let remIters = 1000000000000 `mod` repIters + let remaining = simulate (cycle rocks) Nothing (cycle jets) S.empty remIters + let remHeight = if remIters > 0 then -(minimum $ map snd (S.toList remaining)) + 1 else 0 + -- let tower = simulate2 rocks jets (cycle rocks) Nothing (cycle jets) S.empty 2022 0 + + putStr "part 2: " + let repNum = 1000000000000 `div` repIters + print $ (repNum * repHeight) + remHeight \ No newline at end of file