commit 4b7029a3b031ec13de13bd68b868efab12650e15 · drubery.com/aoc2025

+26 -30
src/Day8.hs
···

       21
       21
        
       pairs :: [a] -> [(a,a)]

     

       22
       22
        
       pairs xs = [(x, y) | (x:ys) <- tails xs, y <- ys]

     

       23
       23
        
       

     

       24
       24
       -
       lastParent :: (Ord a, Show a) => a -> Map a a -> a

     

       25
       25
       -
       lastParent a m =

     

       26
       26
       -
         case Map.lookup a m of

     

       27
       27
       -
           Just a' -> lastParent a' m

     

       28
       28
       -
           Nothing -> a

     

       24
       24
       +
       merge :: (Point3, Point3) -> Map Point3 Int -> Map Point3 Int

     

       25
       25
       +
       merge (p, q) m =

     

       26
       26
       +
         let pid = m Map.! p

     

       27
       27
       +
             qid = m Map.! q

     

       28
       28
       +
          in if pid == qid then

     

       29
       29
       +
               m

     

       30
       30
       +
             else

     

       31
       31
       +
               Map.map (\c -> if c == pid then qid else c) m

     

       29
       32
        
       

     

       30
       33
        
       part1 :: String -> String

     

       31
       34
        
       part1 input =

     
···

       34
       37
        
               dropWhile (\(p,q) -> p == q) $

     

       35
       38
        
               sortBy (comparing (\(p,q) -> dist2 p q)) $

     

       36
       39
        
               pairs boxes

     

       37
       37
       -
             parents =

     

       38
       38
       -
               foldl (\parents' (a,b) -> let a' = lastParent a parents'

     

       39
       39
       -
                                             b' = lastParent b parents'

     

       40
       40
       -
       	                           in if a' == b' then

     

       41
       41
       -
       				        parents'

     

       42
       42
       -
       			              else

     

       43
       43
       -
       				        Map.insert b' a' parents')

     

       44
       44
       -
                 Map.empty

     

       40
       40
       +
             circuits =

     

       41
       41
       +
               foldl (\ids' edge -> merge edge ids')

     

       42
       42
       +
                 (Map.fromList $ zip boxes [1..])

     

       45
       43
        
                 (take 1000 connectionOrder)

     

       46
       44
        
             sizes =

     

       47
       45
        
               reverse $

     

       48
       46
        
               sort $

     

       49
       47
        
               map snd $

     

       50
       50
       -
       	Map.toList $

     

       51
       51
       -
               foldl (\sizes' b -> Map.insertWith (+) (lastParent b parents) 1 sizes')

     

       48
       48
       +
               Map.toList $

     

       49
       49
       +
               Map.foldl (\sizes' c -> Map.insertWith (+) c 1 sizes')

     

       52
       50
        
                 Map.empty

     

       53
       53
       -
                 boxes

     

       51
       51
       +
                 circuits

     

       54
       52
        
          in show $ product $ take 3 sizes

     

       55
       53
        
       

     

       56
       54
        
       part2 :: String -> String

     
···

       60
       58
        
               dropWhile (\(p,q) -> p == q) $

     

       61
       59
        
               sortBy (comparing (\(p,q) -> dist2 p q)) $

     

       62
       60
        
               pairs boxes

     

       63
       63
       -
             parents =

     

       64
       64
       -
               foldl (\parents' (a,b) -> let a' = lastParent a parents'

     

       65
       65
       -
                                             b' = lastParent b parents'

     

       66
       66
       -
       	                           in if a' == b' then

     

       67
       67
       -
       				        parents'

     

       68
       68
       -
       			              else

     

       69
       69
       -
       				        Map.insert b' a' parents')

     

       70
       70
       -
                 Map.empty

     

       71
       71
       -
                 (take 4791 connectionOrder)

     

       72
       72
       -
             groups = length $

     

       73
       73
       -
               foldl (\sizes' b -> Map.insertWith (+) (lastParent b parents) 1 sizes')

     

       74
       74
       -
                 Map.empty

     

       75
       75
       -
                 boxes

     

       76
       76
       -
          in show $ (connectionOrder !! 4791)

     

       61
       61
       +
             circuits =

     

       62
       62
       +
               scanl (\ids' edge -> merge edge ids')

     

       63
       63
       +
                 (Map.fromList $ zip boxes [1..])

     

       64
       64
       +
                 connectionOrder

     

       65
       65
       +
             merges =

     

       66
       66
       +
               filter (\((p,q),ids) -> ids Map.! p /= ids Map.! q)

     

       67
       67
       +
       	  $ zip connectionOrder circuits

     

       68
       68
       +
             ((p,q),_) = merges !! (length boxes - 2)

     

       69
       69
       +
             (x,_,_) = p

     

       70
       70
       +
             (x',_,_) = q

     

       71
       71
       +
          in show (x * x')

     

       72
       72
       +