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:
@@ -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) ]
|
||||
|
Reference in New Issue
Block a user