Add 2025 day 25.

We want to change Aoc.main to take a single printer parameter to
simplify the run process.

bin/day2417.ml

@@ -129,7 +129,8 @@ let rec execute_until_halted vm =
   | false -> execute_until_halted (execute_insn vm)
 
 (** [string_of_ouput vm] gives the output of [vm]. *)
-let string_of_output vm =
+let part1 vm =
+  let vm = execute_until_halted vm in
   List.rev vm.out |> List.map string_of_int |> String.concat ","
 
 (** [scan_digit acc ip vm] updates the acc for A so that the output of running
@@ -159,8 +160,8 @@ let scan_all vm =
   impl 0 (Array.length vm.code - 1)
 
 (** [string_of_a vm] returns the A register of [vm]. *)
-let string_of_a vm = string_of_int vm.a
+let part2 vm =
+  let vm = scan_all vm in
+  string_of_int vm.a
 
-let _ =
+let _ = Aoc.main vm_of_file [ (Fun.id, part1); (Fun.id, part2) ]
-  Aoc.main vm_of_file
-    [ (string_of_output, execute_until_halted); (string_of_a, scan_all) ]

bin/day2418.ml

@@ -104,12 +104,12 @@ let find_route_length count grid =
 let part1 count rocks =
   match find_route_length count rocks with
   | None -> failwith "part1"
-  | Some (cost, _) -> cost
+  | Some (cost, _) -> string_of_int cost
 
 (** [part2 start_count grid] returns the location of the first rock to fall into
     [grid] which makes it impossible to get from the top-left to bottom-right.
 *)
-let part2 start_count grid =
+let part2 width start_count grid =
   (* Implementation notes:
   
      We do this by binary search in impl.  The left_count is a known count of
@@ -137,16 +137,11 @@ let part2 start_count grid =
   let count = impl start_count (1 + count_rocks 0 0) in
   match Array.find_index (( = ) (count - 1)) grid.grid with
   | None -> failwith "part2"
-  | Some idx -> idx
+  | Some idx -> Printf.sprintf "%d,%d" (idx mod width) (idx / width)
-
-(** [string_of_idx width idx] prints the (x, y) location for a given index in a
-    grid. *)
-let string_of_idx width idx =
-  Printf.sprintf "%d,%d" (idx mod width) (idx / width)
 
 (** Width of grid *)
 let width = 71
 
 let _ =
   Aoc.main (grid_of_file width)
-    [ (string_of_int, part1 1024); (string_of_idx width, part2 1024) ]
+    [ (Fun.id, part1 1024); (Fun.id, part2 width 1024) ]

bin/day2423.ml

@@ -53,7 +53,7 @@ let rec find_rings acc visited connections = function
 
 (** [starts_with_t set] returns true if any member of [set] starts with the
     letter ['t']. *)
-let starts_with_t set = StringSet.exists (fun x -> x.[0] = 't') set
+let starts_with_t = StringSet.exists (fun x -> x.[0] = 't')
 
 let part1 connections =
   StringMap.to_list connections
@@ -61,27 +61,6 @@ let part1 connections =
   |> find_rings [] StringSet.empty connections
   |> List.filter starts_with_t |> List.length |> string_of_int
 
-(** [search_candidate max_lst connections current candidates] searches for the
-    longest star network that contains all the computers in [current] and maybe
-    some of the elements of [candidates].
-
-    [max_lst] is the biggest network found so far. [connections] is the map of
-    computers to direct connections.
-
-    The initial call should look something like:
-
-    [search_candidate [] connections k (StringSet.to_list (StringMap.find k
-     connections))] *)
-let rec search_candidate max_lst connections current candidates =
-  match candidates with
-  | [] -> if List.length current > List.length max_lst then current else max_lst
-  | h :: t ->
-      let map = StringMap.find h connections in
-      let current' = h :: current in
-      let candidates' = List.filter (Fun.flip StringSet.mem map) candidates in
-      let max_lst = search_candidate max_lst connections current' candidates' in
-      search_candidate max_lst connections current t
-
 (** [find_max_set connections] returns a list containing the largest number of
     computers in a star network (that is for every pair of elements in the list
     there is a connection between them).
@@ -92,14 +71,21 @@ let rec search_candidate max_lst connections current candidates =
     [StringSet.mem b (StringMap.find a connections)]. Note that
     [StringSet.mem a (StringMap.find a connections)] must return [false]. *)
 let find_max_set connections =
-  let rec impl max_lst = function
+  let rec search_candidate max_lst current candidates =
-    | [] -> max_lst
+    (* recursion invariant: all nodes in the list [current] are in a clique with
-    | (k, v) :: t ->
+       each other.  [current] unioned with any individual element of 
-        impl
+       [candidates] is also a valid clique. *)
-          (search_candidate max_lst connections [ k ] (StringSet.to_list v))
+    match candidates with
-          t
+    | [] ->
+        if List.length current > List.length max_lst then current else max_lst
+    | h :: t ->
+        let map = StringMap.find h connections in
+        let current' = h :: current in
+        let candidates' = List.filter (Fun.flip StringSet.mem map) candidates in
+        let max_lst = search_candidate max_lst current' candidates' in
+        search_candidate max_lst current t
   in
-  impl [] (StringMap.to_list connections)
+  StringMap.to_list connections |> List.map fst |> search_candidate [] []
 
 let part2 connections =
   find_max_set connections |> List.sort compare |> String.concat ","

bin/day2424.ml

@@ -0,0 +1,134 @@
+type op = And | Or | Xor
+type gate = { in1 : string; in2 : string; op : op; out : string }
+
+module StringMap = Map.Make (String)
+
+let get_wire_value str =
+  let re = Str.regexp {|\(.+\): \([01]\)|} in
+  let _ = Str.search_forward re str 0 in
+  let v = if Str.matched_group 2 str = "0" then 0 else 1 in
+  (Str.matched_group 1 str, v)
+
+let get_gate_op = function
+  | "AND" -> And
+  | "OR" -> Or
+  | "XOR" -> Xor
+  | _ -> failwith "get_gate_op"
+
+let[@warning "-32"] string_of_op = function
+  | And -> "AND"
+  | Or -> "OR"
+  | Xor -> "XOR"
+
+let get_gate_config str =
+  let re = Str.regexp {|\(.+\) \(AND\|OR\|XOR\) \(.+\) -> \(.+\)|} in
+  let _ = Str.search_forward re str 0 in
+  let in1 = Str.matched_group 1 str in
+  let op = get_gate_op (Str.matched_group 2 str) in
+  let in2 = Str.matched_group 3 str in
+  let out = Str.matched_group 4 str in
+  { in1; in2; op; out }
+
+let initial_wires_of_strings =
+  let rec impl acc = function
+    | "" :: t -> (acc, t)
+    | h :: t ->
+        let wire, v = get_wire_value h in
+        impl (StringMap.add wire v acc) t
+    | _ -> failwith "initial_wires_of_strings"
+  in
+  impl StringMap.empty
+
+let gates_from_strings =
+  let rec impl acc = function
+    | [] -> acc
+    | h :: t -> impl (get_gate_config h :: acc) t
+  in
+  impl []
+
+let config_of_file fname =
+  let lst = Aoc.strings_of_file fname in
+  let wires, lst = initial_wires_of_strings lst in
+  let gates = gates_from_strings lst in
+  (wires, gates)
+
+let process_gate wires gate =
+  match
+    ( gate.op,
+      StringMap.find_opt gate.in1 wires,
+      StringMap.find_opt gate.in2 wires )
+  with
+  | And, Some a, Some b -> if a = 1 && b = 1 then Some 1 else Some 0
+  | Or, Some a, Some b -> if a = 1 || b = 1 then Some 1 else Some 0
+  | Xor, Some a, Some b -> if a <> b then Some 1 else Some 0
+  | _, _, _ -> None
+
+let process_gates wires =
+  let rec impl wires acc = function
+    | [] -> (wires, acc)
+    | h :: t -> begin
+        match process_gate wires h with
+        | None -> impl wires (h :: acc) t
+        | Some x ->
+            let wires = StringMap.add h.out x wires in
+            impl wires acc t
+      end
+  in
+  impl wires []
+
+let rec repeat_to_end wires gates =
+  let old_len = List.length gates in
+  let wires, gates = process_gates wires gates in
+  if gates = [] then Some wires
+  else if old_len = List.length gates then begin
+    Printf.printf "Loop detected: %d\n" (List.length gates);
+    None
+  end
+  else begin
+    repeat_to_end wires gates
+  end
+
+let calc_value = Fun.flip (List.fold_right (fun x acc -> x + (2 * acc))) 0
+
+let k_wires wires x =
+  StringMap.filter (fun k _ -> k.[0] = x) wires
+  |> StringMap.bindings |> List.map snd |> calc_value
+
+let wires_set wires x v' =
+  let set_v k v =
+    if k.[0] = x then
+      let idx = int_of_string (String.sub k 1 (String.length k - 1)) in
+      (v' lsr idx) land 1
+    else v
+  in
+  StringMap.mapi set_v wires
+
+let part1 (wires, gates) =
+  match repeat_to_end wires gates with
+  | None -> failwith "part1"
+  | Some wires -> k_wires wires 'z'
+
+let part2 (wires, gates) =
+  let run_test x y =
+    let wires = wires_set wires 'x' x in
+    let wires = wires_set wires 'y' y in
+    Printf.printf "%d + %d = " (k_wires wires 'x') (k_wires wires 'y');
+    match repeat_to_end wires gates with
+    | None -> print_endline "(infinite loop)"
+    | Some wires ->
+        let z = k_wires wires 'z' in
+        print_int z;
+        if z <> x + y then print_string " (wrong answer)";
+        print_newline ()
+  in
+  let tst n =
+    Printf.printf "Test for n = %d\n" n;
+    run_test (1 lsl n) 0;
+    run_test 0 (1 lsl n);
+    run_test (1 lsl n) (1 lsl n)
+  in
+  Seq.ints 0 |> Seq.take 45 |> Seq.iter tst;
+  0
+
+let _ =
+  Aoc.main config_of_file [ (string_of_int, part1); (string_of_int, part2) ]

bin/day2425.ml

@@ -0,0 +1,34 @@
+let pin_count = 5
+let height = 7
+
+let read_lock_or_key lst =
+  let result = Array.make pin_count 0 in
+  let add_node i c = if c = '#' then result.(i) <- result.(i) + 1 in
+  List.iter (String.iteri add_node) lst;
+  result |> Array.to_list
+
+let locks_and_keys_of_list =
+  let rec impl locks keys = function
+    | [] -> (locks, keys)
+    | "" :: t -> impl locks keys t
+    | a :: b :: c :: d :: e :: f :: g :: t ->
+        let h = read_lock_or_key [ a; b; c; d; e; f; g ] in
+        if a = String.make pin_count '#' then impl locks (h :: keys) t
+        else impl (h :: locks) keys t
+    | _ -> failwith "locks_and_keys_of_list"
+  in
+  impl [] []
+
+let locks_and_keys_of_file fname =
+  Aoc.strings_of_file fname |> locks_and_keys_of_list
+
+let lock_key_fit lock key =
+  List.map2 ( + ) lock key |> List.for_all (( >= ) height)
+
+let count_keys keys lock = List.filter (lock_key_fit lock) keys |> List.length
+
+let count_locks_and_keys (locks, keys) =
+  List.map (count_keys keys) locks |> List.fold_left ( + ) 0
+
+let _ =
+  Aoc.main locks_and_keys_of_file [ (string_of_int, count_locks_and_keys) ]

bin/dune

@@ -22,7 +22,9 @@
   day2420
   day2421
   day2422
-  day2423)
+  day2423
+  day2424
+  day2425)
  (names
   day2401
   day2402
@@ -46,5 +48,7 @@
   day2420
   day2421
   day2422
-  day2423)
+  day2423
+  day2424
+  day2425)
  (libraries str aoc))