Advent of Code 2025
drubery.com
1module Day8 where
2
3import Util
4import Debug.Trace
5import Data.Ord
6import Data.Tuple (swap)
7import Data.List (tails, sortBy, sort)
8import Data.Map (Map)
9import qualified Data.Map as Map
10
11parseLine :: [String] -> Point3
12parseLine [a,b,c] = (read a, read b, read c)
13
14parse :: String -> [Point3]
15parse s =
16 map (parseLine . split ',') $ lines s
17
18dist2 :: Point3 -> Point3 -> Int
19dist2 (x,y,z) (x',y',z') = (x-x') ^ 2 + (y-y') ^ 2 + (z-z') ^ 2
20
21pairs :: [a] -> [(a,a)]
22pairs xs = [(x, y) | (x:ys) <- tails xs, y <- ys]
23
24merge :: (Point3, Point3) -> Map Point3 Int -> Map Point3 Int
25merge (p, q) m =
26 let pid = m Map.! p
27 qid = m Map.! q
28 in if pid == qid then
29 m
30 else
31 Map.map (\c -> if c == pid then qid else c) m
32
33part1 :: String -> String
34part1 input =
35 let boxes = parse input
36 connectionOrder =
37 dropWhile (\(p,q) -> p == q) $
38 sortBy (comparing (\(p,q) -> dist2 p q)) $
39 pairs boxes
40 circuits =
41 foldl (\ids' edge -> merge edge ids')
42 (Map.fromList $ zip boxes [1..])
43 (take 1000 connectionOrder)
44 sizes =
45 reverse $
46 sort $
47 map snd $
48 Map.toList $
49 Map.foldl (\sizes' c -> Map.insertWith (+) c 1 sizes')
50 Map.empty
51 circuits
52 in show $ product $ take 3 sizes
53
54part2 :: String -> String
55part2 input =
56 let boxes = parse input
57 connectionOrder =
58 dropWhile (\(p,q) -> p == q) $
59 sortBy (comparing (\(p,q) -> dist2 p q)) $
60 pairs boxes
61 circuits =
62 scanl (\ids' edge -> merge edge ids')
63 (Map.fromList $ zip boxes [1..])
64 connectionOrder
65 merges =
66 filter (\((p,q),ids) -> ids Map.! p /= ids Map.! q)
67 $ zip connectionOrder circuits
68 ((p,q),_) = merges !! (length boxes - 2)
69 (x,_,_) = p
70 (x',_,_) = q
71 in show (x * x')
72