feat: solve day8 part 2

app/Day8.hs

@@ -29,21 +29,21 @@ instance Read Pos where
 dist :: Pos -> Pos -> Double
 dist (Pos (x1, y1, z1)) (Pos (x2, y2, z2)) = sum . map ((^ (2 :: Integer)) . fromIntegral) $ [x2 - x1, y2 - y1, z2 - z1]
 
+distances :: [Pos] -> [(Double, (Pos, Pos))]
+distances bs = S.toList . S.map (\(a, b) -> (dist a b, (a, b))) $ pairs bs S.empty
+  where
+    pairs :: [Pos] -> Set (Pos, Pos) -> Set (Pos, Pos)
+    pairs [] ps = ps
+    pairs (a : as) ps =
+      pairs as $
+        foldl' (\ps' b -> if a /= b then S.insert (max a b, min a b) ps' else ps') ps bs
+
 -- | Idea: Combine all positions to a cartesian product and
 -- calculate the distances between them. Pick the n shortest distances
 -- and connect them.
 part1 :: Int -> String -> Int
 part1 n = go [] . take n . sortBy (compare `on` fst) . distances . map (read @Pos) . lines
   where
-    generatePairs :: [Pos] -> [Pos] -> Set (Pos, Pos) -> Set (Pos, Pos)
-    generatePairs [] _ pairs = pairs
-    generatePairs (a : as) bs pairs =
-      generatePairs as bs $
-        foldl' (\pairs' b -> if a /= b then S.insert (max a b, min a b) pairs' else pairs') pairs bs
-
-    distances :: [Pos] -> [(Double, (Pos, Pos))]
-    distances bs = S.toList . S.map (\(a, b) -> (dist a b, (a, b))) $ generatePairs bs bs S.empty
-
     go :: [(Set Pos, Int)] -> [(Double, (Pos, Pos))] -> Int
     go circuits [] = product . take 3 . sortBy (flip compare) $ map (S.size . fst) $ circuits
     go circuits ((d, (a, b)) : rest) = go (connect circuits a b (round d)) rest
@@ -71,8 +71,50 @@ part1 n = go [] . take n . sortBy (compare `on` fst) . distances . map (read @Po
         (([], _), ([(c, l)], rest)) -> (S.insert a c, l + d) : rest
         _ -> error "Not implemented"
 
+dupl :: a -> (a, a)
+dupl a = (a, a)
+
+(***) :: (a -> b) -> (c -> d) -> (a, c) -> (b, d)
+(***) f1 f2 (a, b) = (f1 a, f2 b)
+
+-- | Idea: Combine all positions to a cartesian product and calculate
+-- the distances between them. Sort them in increasing distances and
+-- connect them until there are no more separate circuits. Keep track
+-- of unconnected fuse boxes as well.
 part2 :: String -> Int
-part2 = error "Not implemented"
+part2 = uncurry (go []) . (***) (sortBy (compare `on` fst) . distances) (S.fromList) . dupl . map (read @Pos) . lines
+  where
+    go :: [(Set Pos)] -> [(Double, (Pos, Pos))] -> Set Pos -> Int
+    go _ [] _ = error "unreachable"
+    go circuits ((_, (a, b)) : pairs) unconnected = case connect (circuits, unconnected) a b of
+      (circuits', unconnected')
+        | S.null unconnected' -> x a * x b
+        | otherwise -> go circuits' pairs unconnected'
+
+    x :: Pos -> Int
+    x (Pos (x', _, _)) = x'
+
+    -- check if the fuse boxes are already part of a circuit.
+    --
+    -- There are a few possible scenarios:
+    -- \* both fuse boxes are part of the same circuit => nothing happens.
+    -- \* both fuse boxes are part of different circuits => merge circuits.
+    -- \* one fuse box is part of a circuit, the other is not => add the unconnected fuse box to the circuit.
+    -- \* none of the fuse boxes are part of any circuits => create a new circuit with the new boxes.
+    connect :: ([(Set Pos)], Set Pos) -> Pos -> Pos -> ([(Set Pos)], Set Pos)
+    connect (circuits, unconnected) a b =
+      case (partition (\c -> S.member a c) circuits, partition (\c -> S.member b c) circuits) of
+        -- a & b is part of a circuit
+        (([c], rest), ([c'], rest'))
+          | c == c' -> (circuits, unconnected)
+          | otherwise -> (S.union c c' : intersect rest rest', unconnected)
+        -- no fuse box is part of any circuits
+        (([], _), ([], _)) -> (S.fromList [a, b] : circuits, S.delete b $ S.delete a unconnected)
+        -- a is part of a circuit
+        (([c], rest), ([], _)) -> (S.insert b c : rest, S.delete b unconnected)
+        -- b is part of a circuit
+        (([], _), ([c], rest)) -> (S.insert a c : rest, S.delete a unconnected)
+        _ -> error "Not implemented"
 
 testInput :: String
 testInput =