Matthew Gretton-Dann
831bbf4f63
These are obviously generic enough and useful for the future that they can be moved to a shared library.
101 lines
3.9 KiB
OCaml
101 lines
3.9 KiB
OCaml
type map = { blocks : Aoc.IntPairSet.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) t)
|
|
in
|
|
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 (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 }
|
|
|
|
(** [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 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 >= 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
|
|
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))
|
|
else ((x', y'), (dx, dy))
|
|
|
|
(** [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))
|
|
|
|
(** [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
|
|
has_cycles map' (pos, vel)
|
|
|
|
let part1 (map, pos, vel) =
|
|
walk_map map (pos, vel) |> List.sort_uniq Aoc.IntPair.compare |> List.length
|
|
|
|
let part2 (map, pos, vel) =
|
|
walk_map map (pos, vel)
|
|
|> List.sort_uniq Aoc.IntPair.compare
|
|
|> List.filter (walk_block map (pos, vel))
|
|
|> List.length
|
|
|
|
let _ = Aoc.main read_file [ (string_of_int, part1); (string_of_int, part2) ]
|