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 _ =
-  Aoc.main vm_of_file
-    [ (string_of_output, execute_until_halted); (string_of_a, scan_all) ]
+let _ = Aoc.main vm_of_file [ (Fun.id, part1); (Fun.id, part2) ]

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
-
-(** [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)
+  | Some 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/day2421.ml

@@ -74,51 +74,37 @@ let find_paths (sx, sy) (fx, fy) =
   in
   result
 
+(** [cartesian f initial_acc lst lst'] calls [f acc h h'] for the cross-product
+    of all elements [h], [h'] in [lst] and [lst']. [acc] is updated in each call
+    with the result of all previous calls to [f]. The result is the final [acc].
+*)
+let cartesian f initial_acc lst lst' =
+  let rec impl' acc h = function
+    | [] -> acc
+    | h' :: t' -> impl' (f acc h h') h t'
+  in
+  let rec impl acc = function
+    | [] -> acc
+    | h :: t -> impl (impl' acc h lst') t
+  in
+  impl initial_acc lst
+
 (** [routes pos_of_grid locs] returns a map of [(start, finish)] pairs mapping
     to a list of paths for getting to that route. [locs] are the locations on
     the grid to investiagte. [pos_of_grid] gives the location of each of the
     [locs]. The returned map contains routes from each element in [locs] to
     every element. *)
 let routes pos_of_grid locs =
-  let rec impl acc pos =
-    let start = pos_of_grid pos in
-    function
-    | [] -> acc
-    | h :: t ->
-        impl
-          (CharPairMap.add (pos, h) (find_paths start (pos_of_grid h)) acc)
-          pos t
+  let impl acc h h' =
+    CharPairMap.add (h, h') (find_paths (pos_of_grid h) (pos_of_grid h')) acc
   in
-  let rec impl' acc = function
-    | [] -> acc
-    | h :: t -> impl' (impl acc h locs) t
-  in
-  impl' CharPairMap.empty locs
-
-(** Elements on the number grid *)
-let num_grid = [ '0'; '1'; '2'; '3'; '4'; '5'; '6'; '7'; '8'; '9'; 'A' ]
-
-(** Routes between positions on the number grid *)
-let num_routes = routes pos_of_numeric_grid num_grid
-
-(** Elements on the direction grid *)
-let dir_grid = [ '<'; '>'; 'v'; '^'; 'A' ]
-
-(** Routes between positions on the direction grid. *)
-let dir_routes = routes pos_of_dir_grid dir_grid
+  cartesian impl CharPairMap.empty locs locs
 
 (** [initial_cost_map grid] returns a map for the initial costs (1) of moving
     between different positions on [grid]. *)
 let initial_cost_map grid =
-  let rec impl' acc f = function
-    | [] -> acc
-    | h :: t -> impl' (CharPairMap.add (f, h) 1 acc) f t
-  in
-  let rec impl acc = function
-    | [] -> acc
-    | h :: t -> impl (impl' acc h grid) t
-  in
-  impl CharPairMap.empty grid
+  let update acc h h' = CharPairMap.add (h, h') 1 acc in
+  cartesian update CharPairMap.empty grid grid
 
 (** [calc_cost cost_map steps] calculates the cost of following [steps].
     [cost_map] gives the cost of moving between each position. *)
@@ -142,13 +128,17 @@ let get_next_level_costs route_map cost_map =
 (** [min_code_cost count code] returns the number of buttons a human needs to
     press to get [code] entered when indirected through [count] robots. *)
 let min_code_cost count code =
-  let number_costs =
+  let num_grid = [ '0'; '1'; '2'; '3'; '4'; '5'; '6'; '7'; '8'; '9'; 'A' ] in
+  let num_routes = routes pos_of_numeric_grid num_grid in
+  let dir_grid = [ '<'; '>'; 'v'; '^'; 'A' ] in
+  let dir_routes = routes pos_of_dir_grid dir_grid in
+  let costs =
     Aoc.apply_n count
       (get_next_level_costs dir_routes)
       (initial_cost_map dir_grid)
   in
-  let number_costs = get_next_level_costs num_routes number_costs in
-  calc_cost number_costs code
+  let costs = get_next_level_costs num_routes costs in
+  calc_cost costs code
 
 (** [get_code_complexity count code] returns the complexity of a given code when
     there are [count] robots involved. *)

bin/day2422.ml

@@ -0,0 +1,60 @@
+(** Module describing a tuple of four integers, used for the map keys later. *)
+module Int4Tuple = struct
+  type t = int * int * int * int
+
+  let compare = Stdlib.compare
+end
+
+module Int4Map = Map.Make (Int4Tuple)
+(** Map keyed by a tuple of 4 integers *)
+
+(** [next_secret secret] returns the next secret value after [secret]. *)
+let next_secret secret =
+  let secret = secret * 64 lxor secret mod 16777216 in
+  let secret = secret / 32 lxor secret mod 16777216 in
+  let secret = secret * 2048 lxor secret mod 16777216 in
+  secret
+
+let part1 n nums =
+  List.map (Aoc.apply_n n next_secret) nums |> List.fold_left ( + ) 0
+
+(** [secret_list n secret] returns a list containing the [n] secrets after
+    [secret]. *)
+let secret_list n secret =
+  let rec impl s () = Seq.Cons (s, impl (next_secret s)) in
+  Seq.drop 1 (impl secret) |> Seq.take n |> List.of_seq
+
+(** [find_sequence_values map lst] updates [map] to contain the value of the
+    sale for the first occurance in each sequence of 4 differences in [lst]. *)
+let rec find_sequence_values map =
+  let update_value amt = function None -> Some amt | x -> x in
+  function
+  | a :: b :: c :: d :: e :: t ->
+      find_sequence_values
+        (Int4Map.update (b - a, c - b, d - c, e - d) (update_value e) map)
+        (b :: c :: d :: e :: t)
+  | _ -> map
+
+let part2 n secrets =
+  let merge_values _ x y =
+    match (x, y) with
+    | Some x, Some y -> Some (x + y)
+    | Some x, None -> Some x
+    | None, Some y -> Some y
+    | None, None -> None
+  in
+  let costs =
+    List.map (secret_list n) secrets (* list of lists of secrets *)
+    |> List.map (List.map (fun x -> x mod 10)) (* list of lists of values *)
+    |> List.map (find_sequence_values Int4Map.empty) (* sequence -> value map *)
+    |> List.fold_left (* merge maps - adding values of same key *)
+         (fun acc map -> Int4Map.merge merge_values acc map)
+         Int4Map.empty
+  in
+  Int4Map.fold (fun _ v acc -> max acc v) costs 0 (* find max value *)
+
+let read_file fname = Aoc.strings_of_file fname |> List.map int_of_string
+
+let _ =
+  Aoc.main read_file
+    [ (string_of_int, part1 2000); (string_of_int, part2 2000) ]

bin/day2423.ml

@@ -0,0 +1,93 @@
+module StringMap = Map.Make (String)
+module StringSet = Set.Make (String)
+
+let add_connection map (a, b) =
+  let update s = function
+    | None -> Some (StringSet.add s StringSet.empty)
+    | Some set -> Some (StringSet.add s set)
+  in
+  let map = StringMap.update a (update b) map in
+  let map = StringMap.update b (update a) map in
+  map
+
+let make_pairs = function
+  | [ a; b ] -> (a, b)
+  | _ -> raise (invalid_arg "make_pairs")
+
+let load_file fname =
+  Aoc.strings_of_file fname
+  |> List.map (String.split_on_char '-')
+  |> List.map make_pairs
+  |> List.fold_left add_connection StringMap.empty
+
+let rec find_second_member acc connections visited a candidates =
+  let rec impl acc set = function
+    | [] -> acc
+    | c :: t -> impl (StringSet.add c set :: acc) set t
+  in
+  match StringSet.choose_opt candidates with
+  | None -> acc
+  | Some h ->
+      let candidates = StringSet.remove h candidates in
+      if StringSet.mem h visited then
+        find_second_member acc connections visited a candidates
+      else
+        let visited = StringSet.add h visited in
+        let anh = StringSet.inter (StringMap.find h connections) candidates in
+        let acc =
+          impl acc (StringSet.of_list [ a; h ]) (StringSet.to_list anh)
+        in
+        find_second_member acc connections visited a candidates
+
+let rec find_rings acc visited connections = function
+  | [] -> acc
+  | h :: t ->
+      if StringSet.mem h visited then find_rings acc visited connections t
+      else
+        let visited = StringSet.add h visited in
+        let acc =
+          find_second_member acc connections visited h
+            (StringMap.find h connections)
+        in
+        find_rings acc visited connections t
+
+(** [starts_with_t set] returns true if any member of [set] starts with the
+    letter ['t']. *)
+let starts_with_t = StringSet.exists (fun x -> x.[0] = 't')
+
+let part1 connections =
+  StringMap.to_list connections
+  |> List.map fst
+  |> find_rings [] StringSet.empty connections
+  |> List.filter starts_with_t |> List.length |> string_of_int
+
+(** [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).
+
+    [connections] is the map of connections keyed by computer with the value
+    being a set of all direct connections. [connections] must be bi-directional
+    that is if: [StringSet.mem a (StringMap.find b connections)] then
+    [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 search_candidate max_lst current candidates =
+    (* recursion invariant: all nodes in the list [current] are in a clique with
+       each other.  [current] unioned with any individual element of 
+       [candidates] is also a valid clique. *)
+    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 current' candidates' in
+        search_candidate max_lst current t
+  in
+  StringMap.to_list connections |> List.map fst |> search_candidate [] []
+
+let part2 connections =
+  find_max_set connections |> List.sort compare |> String.concat ","
+
+let _ = Aoc.main load_file [ (Fun.id, part1); (Fun.id, part2) ]

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

@@ -20,7 +20,11 @@
   day2418
   day2419
   day2420
-  day2421)
+  day2421
+  day2422
+  day2423
+  day2424
+  day2425)
  (names
   day2401
   day2402
@@ -42,5 +46,9 @@
   day2418
   day2419
   day2420
-  day2421)
+  day2421
+  day2422
+  day2423
+  day2424
+  day2425)
  (libraries str aoc))