Do not use a set to record blocks in 2406.ml

Instead of using a set of locations to store the blocks in day2406.ml
return to using a string.

Sets have an O(lg n) lookup time in number of blocks.

Instead we use a single string which contains the whole map, which means
we can do O(1) lookup on a block.  This significantly improves
performance.

bin/day2406.ml

@@ -1,32 +1,21 @@
-type map = { blocks : Aoc.IntPairSet.t; width : int; height : int }
-(** [map] represents a map with [blocks] and a [width] and [height]. *)
+type map = { map : string; width : int; height : int }
+(** [map] represents a map with layout [map] and a [width] and [height].
+    [map.map] is a string of length [width * height] with the [i]th character
+    describing the position [(i mod map.width, i / map.width)]. *)
 
 (** [find_start strs] returns the location [(x, y)] of the starting position. *)
-let find_start strs =
-  let rec impl row = function
-    | [] -> failwith "find_start"
-    | h :: t -> (
-        match String.index_from_opt h 0 '^' with
-        | Some i -> (i, row)
-        | None -> impl (row + 1) t)
-  in
-  impl 0 strs
+let find_start map =
+  match String.index_from_opt map.map 0 '^' with
+  | Some i -> (i mod map.width, i / map.width)
+  | None -> failwith "find_start"
 
 (** [map_of_strings strs] returns the map generated from the input map described
     by the list of strings [strs] *)
 let map_of_strings strs =
-  let rec row_scan acc y pos s =
-    match String.index_from_opt s pos '#' with
-    | Some x -> row_scan (Aoc.IntPairSet.add (x, y) acc) y (x + 1) s
-    | None -> acc
-  in
-  let rec impl acc y = function
-    | h :: t -> impl (row_scan acc y 0 h) (y + 1) t
-    | [] -> (acc, y)
-  in
-  let blocks, height = impl Aoc.IntPairSet.empty 0 strs in
   let width = String.length (List.hd strs) in
-  { blocks; height; width }
+  let map = List.fold_left String.cat "" strs in
+  let height = String.length map / width in
+  { map; width; height }
 
 (** [read_file fname] reads the input map from [fname]. It returns a
     [(map, pos, vel)] tuple, consisting of the obsticle map, initial position,
@@ -34,7 +23,7 @@ let map_of_strings strs =
 let read_file fname =
   let lst = Aoc.strings_of_file fname in
   let map = map_of_strings lst in
-  let pos = find_start lst in
+  let pos = find_start map in
   (map, pos, (0, -1))
 
 (** [is_valid_pos map pos] returns true if the position [pos] is valid for the
@@ -44,13 +33,26 @@ let is_valid_pos map (x, y) =
   else if x < 0 || x >= map.width then false
   else true
 
+(** [is_block map pos] returns [true] iff the location [pos] is a blockages in
+    [map]. *)
+let is_block map (x, y) =
+  if is_valid_pos map (x, y) then map.map.[x + (y * map.width)] = '#' else false
+
+(** [insert_block map pos] inserts a blockage at [pos] into [map] and returns
+    the new map. *)
+let insert_block map (x, y) =
+  let idx = x + (y * map.width) in
+  let start = String.sub map.map 0 idx in
+  let e = String.sub map.map (idx + 1) (String.length map.map - idx - 1) in
+  { map with map = start ^ "#" ^ e }
+
 (** [move map (pos, vel)] moves [pos] one step forward on the [map]. [vel] gives
     the movement vector. If the movement will cause an obstacle to be hit then
     [vel] is rotated right by 90 degrees and we move in that direction. Returns
     the updated [(pos, vel)] pair. *)
 let rec move map ((x, y), (dx, dy)) =
   let x', y' = (x + dx, y + dy) in
-  if Aoc.IntPairSet.mem (x', y') map.blocks then move map ((x, y), (-dy, dx))
+  if is_block map (x', y') then move map ((x, y), (-dy, dx))
   else ((x', y'), (dx, dy))
 
 (** [walk_map map (pos, vel)] walks around [map] starting at [pos] moving in the
@@ -65,27 +67,28 @@ let walk_map map (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) =
+let has_cycles map start =
   (* 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')))
+  let rec impl agent1 ((pos', _) as agent2) =
+    (* Only need to check pos' for validity because if pos is not valid then
+       pos' must also be invalid, and have been invalid before this. *)
+    if not (is_valid_pos map pos') then false
+    else if agent1 = agent2 then true
+    else impl (move map agent1) (move map (move map agent2))
   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))
+  impl start (move map start)
 
 (** [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) bpos =
   if bpos = pos then false
   else
-    let map' = { map with blocks = Aoc.IntPairSet.add bpos map.blocks } in
+    let map' = insert_block map bpos in
     has_cycles map' (pos, vel)
 
 let part1 (map, pos, vel) =