Reimplement 2024 day 6 to use a set.

This seems "better" from a functional perspective.  However, it runs
substantially slower for part 2.
This commit is contained in:
2024-12-06 16:26:32 +00:00
parent 590637e0de
commit 38d0781c7e

View File

@@ -1,31 +1,59 @@
(** [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_start"
else
match Array.find_index (fun x -> x = '^') map.(row) with
(** [IntPair] is a module describing pairs of ints, suitable for using with
[Set.Make]. *)
module IntPair = struct
type t = int * int
let compare (x, y) (x', y') =
match compare y y' with 0 -> compare x x' | c -> c
end
module PosSet = Set.Make (IntPair)
(** [PosSet] represents a set of positions. *)
type map = { blocks : PosSet.t; width : int; height : int }
(** [map] represents a map with [blocks] and a [width] and [height]. *)
(** [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)
| None -> impl (row + 1) t)
in
impl 0
impl 0 strs
(** [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 (PosSet.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 PosSet.empty 0 strs in
let width = String.length (List.hd strs) in
{ blocks; height; width }
(** [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_start map2 in
(map2, pos, (0, -1))
let map = map_of_strings lst in
let pos = find_start lst in
(map, 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
if y < 0 || y >= map.height then false
else if x < 0 || x >= map.width then false
else true
(** [move map (pos, vel)] moves [pos] one step forward on the [map]. [vel] gives
@@ -33,21 +61,9 @@ let is_valid_pos map (x, y) =
[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)) =
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))
if PosSet.mem (x', y') map.blocks 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
@@ -76,26 +92,21 @@ let has_cycles map (pos, vel) =
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) =
let walk_block map (pos, vel) bpos =
if bpos = pos then false
else
let map' = map_copy map in
map'.(by).(bx) <- '#';
let map' = { map with blocks = PosSet.add bpos map.blocks } in
has_cycles map' (pos, vel)
let part1 (map, pos, vel) =
walk_map map (pos, vel) |> List.sort_uniq compare_pos |> List.length
walk_map map (pos, vel) |> List.sort_uniq IntPair.compare |> List.length
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))
walk_map map (pos, vel)
|> List.sort_uniq IntPair.compare
|> List.filter (walk_block map (pos, vel))
|> List.length
let _ = Aoc.main read_file [ (string_of_int, part1); (string_of_int, part2) ]