Advent of Code 2025
drubery.com
1module Day7 where
2
3import Util
4import Data.Map (Map)
5import qualified Data.Map as Map
6import Data.Set (Set)
7import qualified Data.Set as Set
8import Debug.Trace
9
10-- New beam positions and number of splits
11splitBeams :: Grid -> (Set Point2, Int) -> (Set Point2, Int)
12splitBeams g (beams,splits) =
13 foldl (\(beams',splits') (x,y) ->
14 if Map.lookup (x,y+1) g == Just '^' then
15 (Set.insert (x-1,y+1) $ Set.insert (x+1,y+1) beams', splits' + 1)
16 else
17 (Set.insert (x,y+1) beams', splits'))
18 (Set.empty, splits)
19 beams
20
21part1 :: String -> String
22part1 input =
23 let grid = toGrid input
24 starts = map fst $ filter ((== 'S') . snd) (Map.toList grid)
25 rows = maximum $ map snd $ Map.keys grid
26 (_, splits) = foldl
27 (\(beams', splits') _ -> splitBeams grid (beams', splits'))
28 (Set.fromList starts, 0)
29 [0..rows]
30 in show splits
31
32splitTime :: Grid -> Map Point2 Int -> Map Point2 Int
33splitTime g beams =
34 Map.foldlWithKey (\beams' (x,y) times ->
35 if Map.lookup (x,y+1) g == Just '^' then
36 Map.insertWith (+) (x-1,y+1) times $
37 Map.insertWith (+) (x+1,y+1) times $
38 beams'
39 else
40 Map.insertWith (+) (x,y+1) times beams')
41 Map.empty
42 beams
43
44part2 :: String -> String
45part2 input =
46 let grid = toGrid input
47 starts = map fst $ filter ((== 'S') . snd) (Map.toList grid)
48 rows = maximum $ map snd $ Map.keys grid
49 beams = foldl
50 (\beams' _ -> splitTime grid beams')
51 (Map.fromList [(s,1) | s <- starts])
52 [0..rows]
53 in
54 show $
55 sum $
56 map snd $
57 Map.toList beams