2024 day 6 part 2

bin/day2406.ml

@@ -1,6 +1,7 @@
-let find_pos map =
+(** [find_start map] returns the location [(x, y)] of the starting position. *)
+let find_start map =
   let rec impl row =
-    if row >= Array.length map then failwith "find_pos"
+    if row >= Array.length map then failwith "find_start"
     else
       match Array.find_index (fun x -> x = '^') map.(row) with
       | Some i -> (i, row)
@@ -8,40 +9,93 @@ let find_pos map =
   in
   impl 0
 
+(** [read_file fname] reads the input map from [fname]. It returns a
+    [(map, pos, vel)] tuple, consisting of the obsticle map, initial position,
+    and initial velocity. *)
 let read_file fname =
   let lst = Aoc.strings_of_file fname in
   let map1 = Array.of_list lst in
   let map2 =
     Array.map (fun s -> Array.init (String.length s) (String.get s)) map1
   in
-  let pos = find_pos map2 in
+  let pos = find_start map2 in
   (map2, pos, (0, -1))
 
+(** [is_valid_pos map pos] returns true if the position [pos] is valid for the
+    map [map]. *)
 let is_valid_pos map (x, y) =
   if y < 0 || y >= Array.length map then false
   else if x < 0 || x >= Array.length map.(y) then false
   else true
 
-let rec move (map, (x, y), (dx, dy)) =
+(** [move map (pos, vel)] moves [pos] one step forward on the [map]. [vel] gives
-  let () = map.(y).(x) <- 'X' in
+    the movement vector. If the movement will cause an obstacle to be hit then
-  let x', y' = (x + dx, y + dy) in
+    [vel] is rotated right by 90 degrees and we move in that direction. Returns
-  if is_valid_pos map (x', y') && map.(y').(x') = '#' then
+    the updated [(pos, vel)] pair. *)
-    move (map, (x, y), (-dy, dx))
+let rec move map ((x, y), (dx, dy)) =
-  else (map, (x', y'), (dx, dy))
+  if is_valid_pos map (x, y) then
+    let x', y' = (x + dx, y + dy) in
+    if is_valid_pos map (x', y') && map.(y').(x') = '#' then
+      move map ((x, y), (-dy, dx))
+    else ((x', y'), (dx, dy))
+  else ((x, y), (dx, dy))
+
+(** [compare_pos pos pos'] provides a total ordering on the positions [pos] and
+    [pos']. *)
+let compare_pos (x, y) (x', y') =
+  if y < y' then -1
+  else if y > y' then 1
+  else if x < x' then -1
+  else if x > x' then 1
+  else 0
+
+(** [walk_map map (pos, vel)] walks around [map] starting at [pos] moving in the
+    direction [vel]. It returns a list of all positions visited before falling
+    off one of the sides. *)
+let walk_map map (pos, vel) =
+  let rec impl acc (pos, vel) =
+    if is_valid_pos map pos then impl (pos :: acc) (move map (pos, vel))
+    else acc
+  in
+  impl [] (pos, vel)
+
+(** [has_cycles map (pos, vel)] returns true if walking around [map] starting at
+    [pos] going in [vel] direction will end up in a never ending cycle.*)
+let has_cycles map (pos, vel) =
+  (* We detect a cycle by walking two 'agents' around the map from the same
+     starting position.  Agent 1 moves 1 step at a time, agent 2 moves 2.  If
+     the agents ever end up on the same square facing the same direction we have
+     a cycle.  This works even if the cycle doesn't start immediately. *)
+  let rec impl (pos, vel) (pos', vel') =
+    if not (is_valid_pos map pos) then false
+    else if not (is_valid_pos map pos') then false
+    else if pos = pos' && vel = vel' then true
+    else impl (move map (pos, vel)) (move map (move map (pos', vel')))
+  in
+  (* Start Agent 2 a step ahead of Agent 1 so we don't fail at the start 
+     position. *)
+  impl (pos, vel) (move map (pos, vel))
+
+(** [map_copy map] returns a deep copy of [map]. *)
+let map_copy = Array.map Array.copy
+
+(** [walk_block map (pos, vel) bpos] adds a block to the map [map] at [bpos] and
+    then sees if walking the map starting with [(pos, vel)] has a cycle. *)
+let walk_block map (pos, vel) ((bx, by) as bpos) =
+  if bpos = pos then false
+  else
+    let map' = map_copy map in
+    map'.(by).(bx) <- '#';
+    has_cycles map' (pos, vel)
 
 let part1 (map, pos, vel) =
-  let rec impl (map, pos, vel) =
+  walk_map map (pos, vel) |> List.sort_uniq compare_pos |> List.length
-    if is_valid_pos map pos then impl (move (map, pos, vel)) else (map, pos, vel)
-  in
-  let _ = impl (map, pos, vel) in
-  Array.iter
-    (fun y ->
-      Array.iter (fun x -> print_char x) y;
-      print_newline ())
-    map;
-  Array.fold_left
-    (fun acc y ->
-      Array.fold_left (fun acc x -> if x = 'X' then acc + 1 else acc) acc y)
-    0 map
 
-let _ = Aoc.main read_file [ (string_of_int, part1) ]
+let part2 (map, pos, vel) =
+  let map' = Array.copy map in
+  walk_map map' (pos, vel)
+  |> List.sort_uniq compare_pos
+  |> List.filter (walk_block map' (pos, vel))
+  |> List.length
+
+let _ = Aoc.main read_file [ (string_of_int, part1); (string_of_int, part2) ]