--- a/2023/day08.ml	Thu Dec 14 13:10:22 2023 +0100
+++ b/2023/day08.ml	Thu Dec 14 14:27:40 2023 +0100
@@ -27,7 +27,7 @@
 module Parse = struct
   let directionP = char 'L' *> return L <|> char 'R' *> return R
   let instructionsP = many1 directionP <* char '\n'
-  let pointerP = take_while Char.is_uppercase
+  let pointerP = take_while (fun c -> Char.is_uppercase c || Char.is_digit c)
 
   let nodeP =
     let open Angstrom.Let_syntax in
@@ -58,7 +58,7 @@
 end
 
 module Part1 = struct
-  let rec traverse_once network current count instrs =
+  let rec traverse_once network count current instrs =
     match current with
     | "ZZZ" -> (current, count)
     | _ -> (
@@ -67,13 +67,13 @@
         | [] -> (current, count)
         | x :: xs -> (
             match x with
-            | L -> traverse_once network node.left (count + 1) xs
-            | R -> traverse_once network node.right (count + 1) xs))
+            | L -> traverse_once network (count + 1) node.left xs
+            | R -> traverse_once network (count + 1) node.right xs))
 
   let initial_node : pointer = "AAA"
 
   let traverse network instructions =
-    let rec do_it from count0 =
+    let rec do_it count0 from =
       match traverse_once network from count0 instructions with
       | "ZZZ", count -> count
       | from', count -> do_it from' count
@@ -81,8 +81,88 @@
     do_it initial_node 0
 end
 
+module Part2 = struct
+  type state = pointer Array.t * int Array.t
+
+  let find_start_ptrs network =
+    let keys = Hashtbl.keys network in
+    let f = String.is_suffix ~suffix:"A" in
+    Array.of_list (List.filter ~f keys)
+
+  let is_end_ptr = String.is_suffix ~suffix:"Z"
+
+  let rec all ~f ?(ix = 0) a =
+    if Int.(ix = Array.length a) then true
+    else if not (f a.(ix)) then false
+    else all ~ix:(ix + 1) ~f a
+
+  let print_initial ((st, _) : state) =
+    let f ix e = Out_channel.printf "Path %d => %s\n" ix e in
+    Array.iteri ~f st
+
+  let print_period count ((st, _) : state) =
+    let f ix e =
+      if is_end_ptr e then Out_channel.printf "%d => %d\n" ix count else ()
+    in
+    Array.iteri ~f st
+
+  let update_periods ((st, periods) : state) count =
+    let f ix e =
+      if is_end_ptr e && Int.(periods.(ix) = 0) then periods.(ix) <- count
+      else ()
+    in
+    Array.iteri ~f st
+
+  let periods_complete = all ~f:(fun x -> Int.(x <> 0))
+  let is_finished ((st, _) : state) = all ~f:is_end_ptr st
+
+  let next network ptr =
+    let node = Hashtbl.find_exn network ptr in
+    function L -> node.left | R -> node.right
+
+  let rec gcd a b = if b = 0 then a else gcd b (a mod b)
+  let lcm a b = Int.abs (a * b) / gcd a b
+  let rec multi_lcm = function [] -> 1 | x :: xs -> lcm x (multi_lcm xs)
+
+  let rec traverse_once network count ((st, periods) as state : state) instrs =
+    if periods_complete periods then (count, state, true)
+    else
+      let f instr p = next network p instr in
+      match instrs with
+      | [] -> (count, state, false)
+      | x :: xs ->
+          update_periods state count;
+          Array.map_inplace ~f:(f x) st;
+          traverse_once network (count + 1) state xs
+
+  (* Same algorithm as above, but now we also track the period of each
+     path. Each path is determined by its initial node. The period is set once the
+     a destination node (ending in Z) has been reached. Once all periods are discovered,
+     the number of turns it takes to finish all paths is the lowest common multiple of
+     all periods. *)
+  let traverse network instrs =
+    let initial_ptrs = find_start_ptrs network in
+    let periods = Array.create ~len:(Array.length initial_ptrs) 0 in
+    let rec do_it count st =
+      match traverse_once network count st instrs with
+      | count', st', false -> do_it count' st'
+      | count', _, true -> count'
+    in
+    let state = (initial_ptrs, periods) in
+    print_initial state;
+    ignore @@ do_it 0 state;
+    periods
+
+  let solve network instrs =
+    let periods = traverse network instrs in
+    multi_lcm (Array.to_list periods)
+end
+
 let () =
   let network, instructions = Parse.parse_all In_channel.stdin in
+  Out_channel.output_string Out_channel.stdout (string_of_network network);
+  Out_channel.output_string Out_channel.stdout "\n";
   let count = Part1.traverse network instructions in
-  Out_channel.output_string Out_channel.stdout (string_of_network network);
-  Out_channel.printf "Took %d turns\n" count
+  Out_channel.printf "1: Took %d turns\n" count;
+  let count2 = Part2.solve network instructions in
+  Out_channel.printf "2: Would take %d turns\n" count2