Performant solution to 2024 day 11.

We notice that we're repeating calculations at each step, so use a
map to ensure we do each stone ID once per step.

bin/day2411.ml

@@ -1,47 +1,53 @@
+module IntMap = Map.Make (Int)
+
 let load_file fname =
   match In_channel.with_open_text fname In_channel.input_line with
   | Some x -> x
   | None -> failwith "load_file"
 
-let log10i i =
-  let rec impl acc = function 0 -> acc | x -> impl (acc + 1) (x / 10) in
-  assert (i > 0);
-  impl ~-1 i
-
-let digits10 i = 1 + log10i i
-
-(** [pow10 n] returns [10] raised to the [n]th power. [n] must be non-negative.
-*)
-let pow10 n =
-  let rec impl acc = function 0 -> acc | x -> impl (acc * 10) (x - 1) in
-  assert (n >= 0);
-  impl 1 n
-
 let rec apply_n n fn arg = if n <= 0 then arg else apply_n (n - 1) fn (fn arg)
+let update_count n = function None -> Some n | Some x -> Some (x + n)
 
-(*
-let print_int_list lst =
-  List.iter
-    (fun i ->
-      print_int i;
-      print_char ' ')
-    lst;
-  print_newline ();
-  ()
-*)
-let calc n input =
-  let rec step_rec acc = function
+let map_of_ints =
+  let rec impl acc = function
     | [] -> acc
-    | 0 :: t -> step_rec (1 :: acc) t
-    | x :: t when digits10 x mod 2 = 0 ->
-        let pow = pow10 (digits10 x / 2) in
-        let left = x / pow in
-        let right = x mod pow in
-        step_rec (right :: left :: acc) t
-    | x :: t -> step_rec ((x * 2024) :: acc) t
+    | h :: t -> impl (IntMap.update h (update_count 1) acc) t
   in
-  apply_n n (step_rec []) input
+  impl IntMap.empty
 
-let part1 str = Aoc.ints_of_string str |> calc 25 |> List.length
-let part2 str = Aoc.ints_of_string str |> calc 75 |> List.length
-let _ = Aoc.main load_file [ (string_of_int, part1); (string_of_int, part2) ]
+(** [calc_blink_rec acc lst] returns an updated map based off [acc] with the
+    result of apply a blink step to the stones in [lst]. Entries in [lst] are
+    pairs of [(stone id, count)]. [acc] and the resulting map have keys which
+    are stone id, and values which are count. *)
+let rec calc_blink_rec acc = function
+  | [] -> acc
+  | (0, n) :: t -> calc_blink_rec (IntMap.update 1 (update_count n) acc) t
+  | (x, n) :: t when Aoc.digits10 x mod 2 = 0 ->
+      let pow = Aoc.pow10 (Aoc.digits10 x / 2) in
+      let acc = IntMap.update (x / pow) (update_count n) acc in
+      let acc = IntMap.update (x mod pow) (update_count n) acc in
+      calc_blink_rec acc t
+  | (x, n) :: t ->
+      calc_blink_rec (IntMap.update (x * 2024) (update_count n) acc) t
+
+(** [calc_blink map] calculates how a collection of stones changes in a blink.
+    [map] is a map with key of stone ID, and value number of times that stone
+    appears. The result is a map with similar key, value pairs.
+
+    This improves performance because we find that the transformation stones go
+    through ends up producing repeated numbers. e.g.: 0 -> 1 -> 2024 -> 20 24 ->
+    2 0 2 4 which has two 2s in it.
+
+    We also note that despite the problem description saying stones stay in
+    order, the result we are asked for (number of stones) does not require them
+    to be in order. *)
+let calc_blink map = IntMap.to_list map |> calc_blink_rec IntMap.empty
+
+(** [part n str] returns the number of stones after [n] blinks, given an initial
+    string [str] of space seperated stone IDs. *)
+let part n str =
+  let map = Aoc.ints_of_string str |> map_of_ints |> apply_n n calc_blink in
+  IntMap.fold (fun _ v acc -> v + acc) map 0
+
+let _ =
+  Aoc.main load_file [ (string_of_int, part 25); (string_of_int, part 75) ]