2025 Day 8

Author: viandoxdev

2025/.gitignore

@@ -1,2 +1,5 @@
 _build
 inputs
+flamegraph.svg
+stacks.folded
+perf.data

2025/days/Day08.ml

@@ -1,6 +1,61 @@
 open Utils
 
-let day08 input =
-  ("TODO", "TODO")
+let parse input =
+    trim_end_nl input
+        |> String.split_on_char '\n'
+        |> List.map (fun l ->
+            let a, b = string_split_once "," l in
+            let b, c = string_split_once "," b in
+            tmap3 int_of_string (a, b, c))
+        |> Array.of_list
+
+let sq_dist (ax, ay, az) (bx, by, bz) =
+    let dx, dy, dz = ax - bx, ay - by, az - bz in
+    dx * dx + dy * dy + dz * dz
+
+let prep verts = 
+    let n = Array.length verts in
+    let arr = Array.make (n * (n - 1) / 2) (0, 0, 0) in
+    
+    let rec populate a b i = if a < n - 1 then begin
+        if b >= n then populate (a + 1) (a + 2) i
+        else begin
+            arr.(i) <- (sq_dist verts.(a) verts.(b), a, b);
+            populate a (b + 1) (i + 1)
+        end
+    end in
+
+    populate 0 1 0;
+    Array.fast_sort (fun (a, _, _) (b, _, _) -> Int.compare a b) arr;
+
+    Array.to_list arr
 
+let solve_part1 verts pairs = 
+    let n = Array.length verts in
+    let sets = UnionFind.make n in
 
+    List.take 1000 pairs
+        |> List.iter (fun (_, a, b) -> UnionFind.union a b sets);
+
+    UnionFind.sizes sets
+        |> List.sort (fun a b -> Int.compare b a)
+        |> List.take 3
+        |> List.fold_left ( * ) 1
+
+let solve_part2 verts pairs =
+    let n = Array.length verts in
+    let sets = UnionFind.make n in
+
+    let rec aux (ax, _, _) (bx, _, _) = function
+        | _ when UnionFind.components sets = 1 -> ax * bx
+        | (_, a, b) :: r -> (UnionFind.union a b sets; aux verts.(a) verts.(b) r)
+        | [] -> failwith "Made every connection without connecting everything, interesting."
+    in
+    aux (0, 0, 0) (0, 0, 0) pairs
+
+let day08 input =
+    let verts = parse input in
+    let pairs = prep verts in
+    let part1 = solve_part1 verts pairs in
+    let part2 = solve_part2 verts pairs in
+    (string_of_int part1, string_of_int part2)

2025/days/Utils.ml

@@ -90,3 +90,39 @@ let transpose = function
     | [] -> []
     | x::xs -> List.(fold_right (fun l a -> map2 cons l a) (x::xs) (map (fun _ -> []) x))
 
+let id x = x
+
+let range a b = List.init (b - a + 1) ((+) a)
+
+let range_pairs a b = 
+    range a (b - 1) 
+        |> List.(
+            concat_map (fun i -> range (i + 1) b 
+                |> map (fun j -> i, j)))
+
+module UnionFind = struct
+    type t = {parents: int array; sizes: int array; mutable components: int}
+
+    let make n = { parents = Array.init n id; sizes = Array.make n 1; components = n }
+    let rec find x s = 
+        let parent = s.parents.(x) in
+        if parent <> x then (
+            let res = find parent s in
+            s.parents.(x) <- res;
+            res
+        ) else x
+    let union x y s =
+        let x, y = find x s, find y s in
+        if x <> y then begin
+            let sx, sy = s.sizes.(x), s.sizes.(y) in
+            let x, y, rx, ry = if sx < sy then y, x, sy, sx else x, y, sx, sy in
+
+            s.components <- s.components - 1;
+            s.parents.(y) <- x;
+            s.sizes.(x) <- rx + ry;
+            s.sizes.(y) <- 0;
+        end
+    let sizes s = Array.to_list s.sizes |> List.filter ((<) 0)
+    let size x s = s.sizes.(find x s)
+    let components s = s.components
+end

2025/lib/Aoc.ml

@@ -51,7 +51,7 @@ let days =
     (5, Day05.day05);
     (6, Day06.day06);
     (7, Day07.day07);
-    (* (8, Day08.day08); *)
+    (8, Day08.day08);
     (* (9, Day09.day09); *)
     (* (10, Day10.day10); *)
     (* (11, Day11.day11); *)