commit 5282b630802ea5427815b57c86f59da7d31a7bdc · drubery.com/aoc2025

+52 -2
src/Day7.hs
···

       1
       1
        
       module Day7 where

     

       2
       2
        
       

     

       3
       3
       +
       import Util

     

       4
       4
       +
       import Data.Map (Map)

     

       5
       5
       +
       import qualified Data.Map as Map

     

       6
       6
       +
       import Data.Set (Set)

     

       7
       7
       +
       import qualified Data.Set as Set

     

       8
       8
       +
       import Debug.Trace

     

       9
       9
       +
       

     

       10
       10
       +
       -- New beam positions and number of splits

     

       11
       11
       +
       splitBeams :: Grid -> (Set Point2, Int) -> (Set Point2, Int)

     

       12
       12
       +
       splitBeams g (beams,splits) =

     

       13
       13
       +
         foldl (\(beams',splits') (x,y) ->

     

       14
       14
       +
                 if Map.lookup (x,y+1) g == Just '^' then

     

       15
       15
       +
                   (Set.insert (x-1,y+1) $ Set.insert (x+1,y+1) beams', splits' + 1)

     

       16
       16
       +
                 else

     

       17
       17
       +
                   (Set.insert (x,y+1) beams', splits'))

     

       18
       18
       +
               (Set.empty, splits)

     

       19
       19
       +
               beams

     

       20
       20
       +
       

     

       3
       21
        
       part1 :: String -> String

     

       4
       4
       -
       part1 _ = "Day 7 part 1"

     

       22
       22
       +
       part1 input =

     

       23
       23
       +
         let grid = toGrid input

     

       24
       24
       +
             starts = map fst $ filter ((== 'S') . snd) (Map.toList grid)

     

       25
       25
       +
             rows = maximum $ map snd $ Map.keys grid

     

       26
       26
       +
             (_, splits) = foldl

     

       27
       27
       +
                                 (\(beams', splits') _ -> splitBeams grid (beams', splits'))

     

       28
       28
       +
                                 (Set.fromList starts, 0)

     

       29
       29
       +
                                 [0..rows]

     

       30
       30
       +
          in show splits

     

       5
       31
        
       

     

       32
       32
       +
       splitTime :: Grid -> Map Point2 Int -> Map Point2 Int

     

       33
       33
       +
       splitTime g beams =

     

       34
       34
       +
         Map.foldlWithKey (\beams' (x,y) times ->

     

       35
       35
       +
                          if Map.lookup (x,y+1) g == Just '^' then

     

       36
       36
       +
                            Map.insertWith (+) (x-1,y+1) times $

     

       37
       37
       +
       		     Map.insertWith (+) (x+1,y+1) times $

     

       38
       38
       +
       		     beams'

     

       39
       39
       +
                          else

     

       40
       40
       +
       		     Map.insertWith (+) (x,y+1) times beams')

     

       41
       41
       +
       	Map.empty

     

       42
       42
       +
       	beams

     

       43
       43
       +
       		  

     

       6
       44
        
       part2 :: String -> String

     

       7
       7
       -
       part2 _ = "Day 7 part 2"

     

       45
       45
       +
       part2 input =

     

       46
       46
       +
         let grid = toGrid input

     

       47
       47
       +
             starts = map fst $ filter ((== 'S') . snd) (Map.toList grid)

     

       48
       48
       +
             rows = maximum $ map snd $ Map.keys grid

     

       49
       49
       +
             beams = foldl

     

       50
       50
       +
                        (\beams' _ -> splitTime grid beams')

     

       51
       51
       +
                        (Map.fromList [(s,1) | s <- starts])

     

       52
       52
       +
                        [0..rows]

     

       53
       53
       +
          in

     

       54
       54
       +
            show $

     

       55
       55
       +
            sum $

     

       56
       56
       +
            map snd $

     

       57
       57
       +
            Map.toList beams