Day 8 was all about equivalence relations and union-find structures, and not worrying about brute-force.

We're given some points ("junction boxes") in 3D space and have to find sets of groups of them, based on mutual distance. Take the two closest objects and form them into a group. Then take the two objects with the next-smallest distance, form them into a group, and so on. It could be that the two objects being joined are themselves already in groups, in which case the two groups merge.

The first thing is to find all the distances. As I'd be needed them again for the group-forming stage, I decided to record them all in a Map, going from distance to the pair of junction boxes.

type Position = V3 Int -- x, y, z

type Distances = M.Map Int (Position, Position)

Reading the input is a simple parser:

junctionsP = junctionP `sepBy` endOfLine
junctionP = V3 <$> decimal <* "," <*> decimal <* "," <*> decimal

I walk over all pairs of junctions, using qd function that returns the square of the Euclidian distance between two points. As I'm only ordering by distance, that's good enough.

mkDistances :: [Position] -> Distances
mkDistances junctions = M.fromList distances
  where distances = [(qd a b, (a, b)) | a <- junctions, b <- junctions
                                      , a < b
                                      ]

I did wonder how fast that would be, but there are only a thousand junctions in the input so about half a million pairwise distances. I also checked and found that my input had no duplicated distances, meaning the simple Map from distance to pair was good enough. Calculating and storing the distances goes fast enough.

Union-find

With that in place, time to join the junctions.

The connected groups are equivalence classes of junctions, so we need a way of keeping track of those classes, and adding objects or classes to a class when needed.

It turns out, I did the same thing in my solution to the 2024 day 12 puzzle, so I grabbed that code again, with a Union-Find structure.

The idea is that each equivalence class of objects (e.g. "circuit", in this problem's terminology) is represented by an exemplar object. If objects are in the same class, they share the exemplar. That's implemented by each object in the group pointing to its "parent", and the parent points to a grandparent, and so on until you reach the ancestor of them all, the exemplar (which points to itself).

To merge groups, make the exemplar of one point to the exemplar of the other.

I implement that structure as a Map from object to its parent. That also carries some "rank" information (the depth of the tree from here to the exemplar) to keep the tress somewhat balanced.

data UFElement = UFElement Position Int -- the rank
  deriving (Show, Eq, Ord)

type UFind = M.Map Position UFElement

Finding an exemplar follows the logic above: keep walking the links until you reach one that points to itself.

exemplar :: UFind -> Position -> Position
exemplar uf x 
  | x == parent = x
  | otherwise = exemplar uf parent
  where UFElement parent _ = uf ! x

I can build the equivalence classes by turning each object into an equivalence class on its own, then joining objects as needed.

ufStart :: [Position] -> UFind
ufStart xs = M.fromList [(x, UFElement x 0) | x <- xs]

join :: UFind -> Position -> Position -> UFind
join uf x y
  | x' == y' = uf
  | rankX < rankY = M.insert x' (UFElement y' rankX) uf
  | rankX > rankY = M.insert y' (UFElement x' rankY) uf
  | otherwise = M.insert y' (UFElement x' rankY) $ M.insert x' newRoot uf
  where x' = exemplar uf x
        y' = exemplar uf y
        UFElement _ rankX = uf ! x'
        UFElement _ rankY = uf ! y'
        newRoot = UFElement x' (rankX + 1)

Once I've got the union-find structure, I can find the exemplars and the equivalence sets. These aren't efficient, but they're good enough.

exemplars :: UFind -> [Position]
exemplars uf = filter (\x -> x == exemplar uf x) $ M.keys uf

distinctSets :: UFind -> [[Position]]
distinctSets uf = fmap go es
  where es = exemplars uf
        go e = filter (\x -> exemplar uf x == e) $ M.keys uf

Solving

With that in place, time to solve the problems.

For part 1, I follow the problem specification.

1. Find the thousand smallest distances
2. Use them to find the equivalence classes
3. Find the three largest classes
4. Multiply their sizes.

Note the use of foldl' to build up the union-find structure as I add connections.

part1, part2 :: [Position] -> Distances -> Int
part1 junctions distances = product $ take 3 $ sortBy (comparing Down) $ fmap length $ distinctSets ufMap
  where connections = fmap snd $ take 1000 $ M.toAscList distances
        ufMap0 = ufStart junctions
        ufMap = foldl' go ufMap0 connections
        go u (a, b) = join u a b

For part 2, I need to keep track of the connections as they're added and keep the last one that means there are no singleton equivalence classes.

That means the foldl' becomes a scanl', so I keep all the stages of the union-find structure as it's built up. I also thread through the connection used to form this version of the union-find map.

I then throw away all the partial results that have singleton equivalence classes ("does any distinct set have a length of 1?"). That gives me the final union-find structure, and the connection that was used to complete it.

part2 junctions distances = x1 * x2
  where connections = fmap snd $ M.toAscList distances
        ufMap0 = ufStart junctions
        ufMaps = scanl' go (ufMap0, (V3 0 0 0, V3 0 0 0)) connections
        go (u, _)  (a, b) = (join u a b, (a, b))
        lastConnection = snd $ head $ dropWhile hasIsolates ufMaps
        (V3 x1 _ _, V3 x2 _ _) = lastConnection

hasIsolates :: (UFind, (Position, Position)) -> Bool
hasIsolates (ufMap, _) = any ((== 1) . length) $ distinctSets ufMap

Code

You can get the code from Codeberg.