2025 Day 10.1 & Day 11

Author: viandoxdev

2025/.gitignore

@@ -3,3 +3,4 @@ inputs
 flamegraph.svg
 stacks.folded
 perf.data
+perf.data.old

2025/days/Day10.ml

@@ -1,6 +1,86 @@
 open Utils
 
-let day10 input =
-  ("TODO", "TODO")
+let parse_int_list s = String.split_on_char ',' s |> List.map int_of_string
+let parse_lights s =
+    String.fold_right (fun c a -> match c with
+        | '#' -> 2 * a + 1
+        | '.' -> 2 * a
+        | _ -> a) s 0
+let parse_buttons s =
+    String.split_on_char ' ' (trim_end_nl s) 
+        |> List.map (fun s -> 
+            parse_int_list (String.sub s 1 (String.length s - 2)) 
+                |> List.fold_left (fun a d -> a + Int.shift_left 1 d) 0)
+
+let parse input =
+    let input = trim_end_nl input in
+    String.split_on_char '\n' input 
+        |> List.map (fun l -> 
+            let a, b = string_split_once " " l in
+            let b, c = string_split_once "{" b in
+            let c = String.sub c 0 (String.length c - 1) in
+
+            String.length a - 2,
+            parse_lights a,
+            parse_buttons b |> Array.of_list,
+            parse_int_list c |> Array.of_list)
+
+type 'a control = Continue of 'a | Stop of 'a
+
+let select i a =
+    let rec aux i o = 
+        if i = 0 then [] 
+        else if Int.logand i 1 = 1 then a.(o) :: aux (Int.shift_right i 1) (o + 1)
+        else aux (Int.shift_right i 1) (o + 1) in
+    aux i 0
+
+let bin_of_int n =
+    if n = 0 then "0" else
+    let rec aux n = if n = 0 then "" else aux (n / 2) ^ if n mod 2 = 0 then "0" else "1" in
+    aux n
+
+let turn_on (n, lights, buttons, _) =
+    let k = Array.length buttons in
+    let m = Int.shift_left 1 k in
+    range 0 (m - 1) 
+        |> List.filter (fun i -> List.fold_left Int.logxor 0 (select i buttons) = lights)
+        |> List.map Ocaml_intrinsics.Int.count_set_bits
+        |> List.fold_left min (k + 1)
 
+let fold_bin f acc bin =
+    let rec aux off bin acc = 
+        if bin = 0 then acc
+        else 
+            let skip = Ocaml_intrinsics.Int.count_trailing_zeros bin in
+            aux (off + skip + 1) (Int.shift_right bin (skip + 1))  (f acc (off + skip))
+    in aux 0 bin acc
 
+let string_of_button b = "(" ^ (fold_bin (fun a i -> string_of_int i :: a) [] b |> String.concat ",") ^ ")"
+let string_of_buttons bs = String.concat " " @@ List.map string_of_button @@ Array.to_list  bs
+let string_of_joltages jolts = "{" ^ (String.concat " " @@ List.map string_of_int @@ Array.to_list jolts) ^ "}"
+
+let push_button b jolts =
+    fold_bin (fun _ i -> jolts.(i) <- jolts.(i) - 1) () b
+
+let can_press b jolts = fold_bin (fun f i -> f && jolts.(i) >= 1) true b
+
+let min_joltage (_, _, buttons, joltage) =
+    let k = Array.length buttons in
+    let constraints = Array.mapi 
+        (fun i j -> 
+            range 0 (k - 1) 
+                |> List.filter (fun l -> Int.logand buttons.(l) (Int.shift_left 1 i) = 1),
+            j
+        ) joltage in
+    failwith ""
+
+let solve_part1 machines =
+    List.map turn_on machines |> List.fold_left (+) 0
+let solve_part2 machines =
+    List.map min_joltage machines |> List.fold_left (+) 0
+
+let day10 input =
+    let machines = parse input in
+    let part1 = solve_part1 machines in
+    let part2 = solve_part2 machines in
+    (string_of_int part1, string_of_int part2)

2025/days/Day11.ml

@@ -1,6 +1,96 @@
 open Utils
 
-let day11 input =
-  ("TODO", "TODO")
+type graph = { edges: int list array; flipped: int list array }
+type checkpoint = { node: int; ancestors: bool array }
+
+let you = 0
+let out = 1
+let svr = 2
+let dac = 3
+let fft = 4
+
+let flip_edges edges =
+    let n = Array.length edges in
+    let flipped = Array.make n [] in
+
+    Array.iteri (fun i -> List.iter (fun j -> flipped.(j) <- i :: flipped.(j))) edges;
+
+    flipped
+
+let parse input =
+    let input = trim_end_nl input in
+    let name_tbl = Hashtbl.create 100 in
+    let id_of_name name = match Hashtbl.find_opt name_tbl name with
+        | Some id -> id
+        | None -> (let id = Hashtbl.length name_tbl in Hashtbl.add name_tbl name id; id)
+    in
+
+    ignore @@ id_of_name "you";
+    ignore @@ id_of_name "out";
+    ignore @@ id_of_name "svr";
+    ignore @@ id_of_name "dac";
+    ignore @@ id_of_name "fft";
+
+    let edges = String.split_on_char '\n' input 
+        |> List.map (fun l -> 
+            let self, b = string_split_once ": " l in
+            let outputs = String.split_on_char ' ' b in
+            id_of_name self, List.map id_of_name outputs) in
+    let graph = Array.make (Hashtbl.length name_tbl) [] in
+
+    List.iter (fun (self, outputs) -> 
+        graph.(self) <- outputs @ graph.(self)
+    ) edges;
+
+    { edges = graph; flipped = flip_edges graph }
+
+let children edges node =
+    let n = Array.length edges in
+    let visited = Array.make n false in
 
+    visited.(node) <- true;
 
+    let rec explore i = List.iter (fun n ->
+        if not visited.(n) then begin
+            visited.(n) <- true;
+            explore n 
+        end) edges.(i)
+    in
+
+    explore node;
+
+    visited
+
+let checkpoint_of graph node = { node = node; ancestors = children graph.flipped node }
+
+let count_paths graph goal from =
+    let n = Array.length graph.edges in
+    let memo = Array.make n (-1) in
+
+    let rec aux i =
+        if memo.(i) <> -1 then memo.(i)
+        else begin
+            let res = 
+                if i = goal.node then 1
+                else if not goal.ancestors.(i) then 0
+                else List.map aux graph.edges.(i) |> List.fold_left (+) 0
+            in
+            memo.(i) <- res;
+            res
+        end
+    in
+    aux from
+
+let solve_part1 graph = count_paths graph (checkpoint_of graph out) you
+let solve_part2 graph =
+    let checkpoints = Array.map (checkpoint_of graph) [|fft; dac; out|] in
+
+    Array.sort (fun i j -> if j.ancestors.(i.node) then -1 else 1) checkpoints;
+
+    Array.fold_left (fun (n, from) goal -> n * (count_paths graph goal from), goal.node) (1, svr) checkpoints |> fst
+
+let day11 input =
+    let graph = parse input in
+    let part1 = solve_part1 graph in
+    let part2 = solve_part2 graph in
+    (string_of_int part1, string_of_int part2)

2025/lib/Aoc.ml

@@ -54,7 +54,7 @@ let days =
     (8, Day08.day08);
     (9, Day09.day09);
     (* (10, Day10.day10); *)
-    (* (11, Day11.day11); *)
+    (11, Day11.day11);
     (* (12, Day12.day12); *)
   ]