116 lines
3.9 KiB
OCaml
116 lines
3.9 KiB
OCaml
open Printf;;
|
|
|
|
let rec list_of_lines in_file =
|
|
try
|
|
let line = input_line in_file in
|
|
line :: list_of_lines(in_file)
|
|
with End_of_file ->
|
|
close_in in_file;
|
|
[]
|
|
|
|
let parse_tuple line =
|
|
let nums = line |> String.split_on_char ',' |> List.map int_of_string in
|
|
(List.hd nums, List.nth nums 1)
|
|
|
|
let build_map (width, height) obstacles =
|
|
let arr = Array.make_matrix height width '.' in
|
|
List.iter (fun (x, y) -> arr.(y).(x) <- '#') obstacles;
|
|
arr
|
|
|
|
module IntPair =
|
|
struct
|
|
type t = int * int
|
|
let compare (x0,y0) (x1,y1) =
|
|
match Stdlib.compare x0 x1 with
|
|
0 -> Stdlib.compare y0 y1
|
|
| c -> c
|
|
end
|
|
|
|
module IntPairScore =
|
|
struct
|
|
type t = IntPair.t * int * int
|
|
let compare (pos0, score0, h_score0) (pos1, score1, h_score1) =
|
|
match Stdlib.compare score0 score1 with
|
|
0 -> IntPair.compare pos0 pos1
|
|
| c -> c
|
|
end
|
|
module IntPairsScoreSet = Set.Make(IntPairScore)
|
|
|
|
let generate_next_moves_pos (x, y) =
|
|
[(x - 1, y); (x, y - 1); (x + 1, y); (x, y + 1)]
|
|
|
|
let can_go_to layout (x, y) =
|
|
try
|
|
layout.(y).(x) <> '#'
|
|
with Invalid_argument _ -> false
|
|
|
|
let manhattan_distance (x1, y1) (x2, y2) =
|
|
(Int.abs (x2 - x1)) + (Int.abs (y2 - y1))
|
|
|
|
let generate_next_moves layout end_pos (pos, score, h_score) =
|
|
generate_next_moves_pos pos
|
|
|> List.filter (can_go_to layout)
|
|
|> List.map (fun p ->
|
|
let h = manhattan_distance p end_pos in
|
|
(p, score - h_score + 1 + h, h))
|
|
|
|
let rec a_star_find_path layout visited_array end_pos next_move_queue =
|
|
match IntPairsScoreSet.min_elt_opt next_move_queue with
|
|
| Some state ->
|
|
let ((x, y), score, _) = state in
|
|
let queue_with_removed = IntPairsScoreSet.remove state next_move_queue in
|
|
if visited_array.(y).(x) then
|
|
a_star_find_path layout visited_array end_pos queue_with_removed
|
|
else begin
|
|
visited_array.(y).(x) <- true;
|
|
let next_states = generate_next_moves layout end_pos state in
|
|
let solution_states = List.filter (fun (pos, _, _) -> pos = end_pos) next_states in
|
|
if List.length solution_states > 0 then
|
|
let (_, score, _) = List.hd solution_states in
|
|
score
|
|
else
|
|
let new_queue = List.fold_left (fun queue pos -> IntPairsScoreSet.add pos queue) queue_with_removed next_states in
|
|
a_star_find_path layout visited_array end_pos new_queue
|
|
end
|
|
| None -> (-1)
|
|
|
|
let find_best_path layout start_pos end_pos =
|
|
let visited_array = Array.make_matrix (Array.length layout) (Array.length layout.(0)) false in
|
|
let begin_h_score = manhattan_distance start_pos end_pos in
|
|
a_star_find_path layout visited_array end_pos (IntPairsScoreSet.add (start_pos, begin_h_score, begin_h_score) IntPairsScoreSet.empty)
|
|
|
|
let apply_first_n_obstacles map_size obstacles n =
|
|
obstacles
|
|
|> List.to_seq
|
|
|> Seq.take n
|
|
|> List.of_seq
|
|
|> build_map (map_size, map_size)
|
|
|
|
let rec binary_search_find_min_satisfying pred lower_bound upper_bound =
|
|
if lower_bound = upper_bound then
|
|
lower_bound
|
|
else
|
|
let midpoint = (lower_bound + upper_bound) / 2 in
|
|
if pred midpoint then
|
|
binary_search_find_min_satisfying pred lower_bound midpoint
|
|
else
|
|
binary_search_find_min_satisfying pred (midpoint + 1) upper_bound
|
|
|
|
let blocked_by_obstacles map_size obstacles n =
|
|
let map = apply_first_n_obstacles map_size obstacles n in
|
|
find_best_path map (0, 0) (map_size - 1, map_size - 1) < 0
|
|
|
|
let find_path_cutoff map_size obstacles =
|
|
binary_search_find_min_satisfying (blocked_by_obstacles map_size obstacles) 1 (List.length obstacles)
|
|
|
|
let () =
|
|
let f = open_in "input.txt" in
|
|
let obstacles = list_of_lines f |> List.map parse_tuple in
|
|
let map_size = 71 in
|
|
let first_elems = 1024 in
|
|
let part1_map = apply_first_n_obstacles map_size obstacles first_elems in
|
|
let result = find_best_path part1_map (0, 0) (map_size - 1, map_size - 1) in
|
|
let result2_index = find_path_cutoff map_size obstacles in
|
|
let result2 = List.nth obstacles (result2_index - 1) in
|
|
printf "%d\n%d,%d\n" result (fst result2) (snd result2)
|