158 lines
5.4 KiB
OCaml
158 lines
5.4 KiB
OCaml
(** A Pair of characters *)
|
|
module CharPair = struct
|
|
type t = char * char
|
|
|
|
let compare (x, y) (x', y') =
|
|
match compare y y' with 0 -> compare x x' | c -> c
|
|
end
|
|
|
|
module CharPairMap = Map.Make (CharPair)
|
|
|
|
(** [pos_of_numeric_grid c] returns the [(x, y)] position of [c] in the numeric
|
|
grid. *)
|
|
let pos_of_numeric_grid c =
|
|
match c with
|
|
| '7' -> (0, 0)
|
|
| '8' -> (1, 0)
|
|
| '9' -> (2, 0)
|
|
| '4' -> (0, 1)
|
|
| '5' -> (1, 1)
|
|
| '6' -> (2, 1)
|
|
| '1' -> (0, 2)
|
|
| '2' -> (1, 2)
|
|
| '3' -> (2, 2)
|
|
| '0' -> (1, 3)
|
|
| 'A' -> (2, 3)
|
|
| _ -> raise (invalid_arg "pos_of_numeric_grid")
|
|
|
|
(** [pos_of_numeric_grid c] returns the [(x, y)] position of [c] in the
|
|
direction grid. *)
|
|
let pos_of_dir_grid c =
|
|
(* Implementation note: We chose 'A' to have the same position in both grids
|
|
so that there is only one location for the hole. *)
|
|
match c with
|
|
| '^' -> (1, 3)
|
|
| 'A' -> (2, 3)
|
|
| '<' -> (0, 4)
|
|
| 'v' -> (1, 4)
|
|
| '>' -> (2, 4)
|
|
| _ -> raise (invalid_arg "pos_of_dir_grid")
|
|
|
|
(** Location of the hole which the robot can not go to. *)
|
|
let invalid_x, invalid_y = (0, 3)
|
|
|
|
(** [find_paths start finish] returns a list of paths (using the direction
|
|
keypad to get from [start] to [finish] positions.
|
|
|
|
The routing is picked to avoid the invalid location. *)
|
|
let find_paths (sx, sy) (fx, fy) =
|
|
let b = Buffer.create 6 in
|
|
let result = [] in
|
|
let result =
|
|
if fx <> invalid_x || sy <> invalid_y then begin
|
|
Buffer.reset b;
|
|
if fx > sx then Buffer.add_string b (String.make (fx - sx) '>')
|
|
else if fx < sx then Buffer.add_string b (String.make (sx - fx) '<');
|
|
if fy > sy then Buffer.add_string b (String.make (fy - sy) 'v')
|
|
else if fy < sy then Buffer.add_string b (String.make (sy - fy) '^');
|
|
Buffer.add_char b 'A';
|
|
Buffer.contents b :: result
|
|
end
|
|
else result
|
|
in
|
|
let result =
|
|
if sx <> invalid_x || fy <> invalid_y then begin
|
|
Buffer.reset b;
|
|
if fy > sy then Buffer.add_string b (String.make (fy - sy) 'v')
|
|
else if fy < sy then Buffer.add_string b (String.make (sy - fy) '^');
|
|
if fx > sx then Buffer.add_string b (String.make (fx - sx) '>')
|
|
else if fx < sx then Buffer.add_string b (String.make (sx - fx) '<');
|
|
Buffer.add_char b 'A';
|
|
Buffer.contents b :: result
|
|
end
|
|
else result
|
|
in
|
|
result
|
|
|
|
(** [cartesian f initial_acc lst lst'] calls [f acc h h'] for the cross-product
|
|
of all elements [h], [h'] in [lst] and [lst']. [acc] is updated in each call
|
|
with the result of all previous calls to [f]. The result is the final [acc].
|
|
*)
|
|
let cartesian f initial_acc lst lst' =
|
|
let rec impl' acc h = function
|
|
| [] -> acc
|
|
| h' :: t' -> impl' (f acc h h') h t'
|
|
in
|
|
let rec impl acc = function
|
|
| [] -> acc
|
|
| h :: t -> impl (impl' acc h lst') t
|
|
in
|
|
impl initial_acc lst
|
|
|
|
(** [routes pos_of_grid locs] returns a map of [(start, finish)] pairs mapping
|
|
to a list of paths for getting to that route. [locs] are the locations on
|
|
the grid to investiagte. [pos_of_grid] gives the location of each of the
|
|
[locs]. The returned map contains routes from each element in [locs] to
|
|
every element. *)
|
|
let routes pos_of_grid locs =
|
|
let impl acc h h' =
|
|
CharPairMap.add (h, h') (find_paths (pos_of_grid h) (pos_of_grid h')) acc
|
|
in
|
|
cartesian impl CharPairMap.empty locs locs
|
|
|
|
(** [initial_cost_map grid] returns a map for the initial costs (1) of moving
|
|
between different positions on [grid]. *)
|
|
let initial_cost_map grid =
|
|
let update acc h h' = CharPairMap.add (h, h') 1 acc in
|
|
cartesian update CharPairMap.empty grid grid
|
|
|
|
(** [calc_cost cost_map steps] calculates the cost of following [steps].
|
|
[cost_map] gives the cost of moving between each position. *)
|
|
let calc_cost cost_map steps =
|
|
let rec impl acc from seq =
|
|
match Seq.uncons seq with
|
|
| None -> acc
|
|
| Some (h, t) -> impl (acc + CharPairMap.find (from, h) cost_map) h t
|
|
in
|
|
impl 0 'A' (String.to_seq steps)
|
|
|
|
(** [get_next_level_costs route_map cost_map] gets the cost map which
|
|
corresponds to [route_map] with costs [cost_map]. *)
|
|
let get_next_level_costs route_map cost_map =
|
|
let impl routes =
|
|
List.map (calc_cost cost_map) routes
|
|
|> List.fold_left (fun acc x -> min acc x) max_int
|
|
in
|
|
CharPairMap.map impl route_map
|
|
|
|
(** [min_code_cost count code] returns the number of buttons a human needs to
|
|
press to get [code] entered when indirected through [count] robots. *)
|
|
let min_code_cost count code =
|
|
let num_grid = [ '0'; '1'; '2'; '3'; '4'; '5'; '6'; '7'; '8'; '9'; 'A' ] in
|
|
let num_routes = routes pos_of_numeric_grid num_grid in
|
|
let dir_grid = [ '<'; '>'; 'v'; '^'; 'A' ] in
|
|
let dir_routes = routes pos_of_dir_grid dir_grid in
|
|
let costs =
|
|
Aoc.apply_n count
|
|
(get_next_level_costs dir_routes)
|
|
(initial_cost_map dir_grid)
|
|
in
|
|
let costs = get_next_level_costs num_routes costs in
|
|
calc_cost costs code
|
|
|
|
(** [get_code_complexity count code] returns the complexity of a given code when
|
|
there are [count] robots involved. *)
|
|
let get_code_complexity count code =
|
|
let len = min_code_cost count code in
|
|
let num = int_of_string (String.sub code 0 (String.length code - 1)) in
|
|
num * len
|
|
|
|
(** [part count codes] returns the puzzle rest when there are [count] robots,
|
|
and you need to enter [codes]. *)
|
|
let part count codes =
|
|
List.map (get_code_complexity count) codes |> List.fold_left ( + ) 0
|
|
|
|
let _ =
|
|
Aoc.main Aoc.strings_of_file
|
|
[ (string_of_int, part 2); (string_of_int, part 25) ]
|