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.
This commit is contained in:
2024-12-07 10:12:50 +00:00
parent 8a454e2082
commit 799a25464b

View File

@@ -1,32 +1,21 @@
type map = { blocks : Aoc.IntPairSet.t; width : int; height : int } type map = { map : string; width : int; height : int }
(** [map] represents a map with [blocks] and a [width] and [height]. *) (** [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. *) (** [find_start strs] returns the location [(x, y)] of the starting position. *)
let find_start strs = let find_start map =
let rec impl row = function match String.index_from_opt map.map 0 '^' with
| [] -> failwith "find_start" | Some i -> (i mod map.width, i / map.width)
| h :: t -> ( | None -> failwith "find_start"
match String.index_from_opt h 0 '^' with
| Some i -> (i, row)
| None -> impl (row + 1) t)
in
impl 0 strs
(** [map_of_strings strs] returns the map generated from the input map described (** [map_of_strings strs] returns the map generated from the input map described
by the list of strings [strs] *) by the list of strings [strs] *)
let map_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 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 (** [read_file fname] reads the input map from [fname]. It returns a
[(map, pos, vel)] tuple, consisting of the obsticle map, initial position, [(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 read_file fname =
let lst = Aoc.strings_of_file fname in let lst = Aoc.strings_of_file fname in
let map = map_of_strings lst in let map = map_of_strings lst in
let pos = find_start lst in let pos = find_start map in
(map, pos, (0, -1)) (map, pos, (0, -1))
(** [is_valid_pos map pos] returns true if the position [pos] is valid for the (** [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 if x < 0 || x >= map.width then false
else true 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 (** [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 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 [vel] is rotated right by 90 degrees and we move in that direction. Returns
the updated [(pos, vel)] pair. *) the updated [(pos, vel)] pair. *)
let rec move map ((x, y), (dx, dy)) = let rec move map ((x, y), (dx, dy)) =
let x', y' = (x + dx, y + dy) in 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)) else ((x', y'), (dx, dy))
(** [walk_map map (pos, vel)] walks around [map] starting at [pos] moving in the (** [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 (** [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.*) [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 (* 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 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 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. *) a cycle. This works even if the cycle doesn't start immediately. *)
let rec impl (pos, vel) (pos', vel') = let rec impl agent1 ((pos', _) as agent2) =
if not (is_valid_pos map pos) then false (* Only need to check pos' for validity because if pos is not valid then
else if not (is_valid_pos map pos') then false pos' must also be invalid, and have been invalid before this. *)
else if pos = pos' && vel = vel' then true if not (is_valid_pos map pos') then false
else impl (move map (pos, vel)) (move map (move map (pos', vel'))) else if agent1 = agent2 then true
else impl (move map agent1) (move map (move map agent2))
in in
(* Start Agent 2 a step ahead of Agent 1 so we don't fail at the start (* Start Agent 2 a step ahead of Agent 1 so we don't fail at the start
position. *) 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 (** [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. *) then sees if walking the map starting with [(pos, vel)] has a cycle. *)
let walk_block map (pos, vel) bpos = let walk_block map (pos, vel) bpos =
if bpos = pos then false if bpos = pos then false
else 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) has_cycles map' (pos, vel)
let part1 (map, pos, vel) = let part1 (map, pos, vel) =