From 64b22c52d39a19316c096080777d989c28e4f0ba Mon Sep 17 00:00:00 2001
From: Acvaxoort <rutiousag@gmail.com>
Date: Tue, 17 Dec 2024 01:29:43 +0100
Subject: [PATCH] day 15, 16

---
 15/main.ml | 213 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 16/main.ml | 217 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 430 insertions(+)
 create mode 100644 15/main.ml
 create mode 100644 16/main.ml

diff --git a/15/main.ml b/15/main.ml
new file mode 100644
index 0000000..96dee1c
--- /dev/null
+++ b/15/main.ml
@@ -0,0 +1,213 @@
+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 lines_to_2d_array lines =
+  let size_x = String.length @@ List.hd lines in
+  let size_y = List.length lines in
+  let arr = Array.make_matrix size_x size_y '?' in
+  List.iteri (fun j line -> String.iteri (fun i c -> arr.(j).(i) <- c) line) lines;
+  arr
+
+let rec take_nonempty_lines lines =
+  match lines with
+  | head :: tail ->
+    if String.length head = 0 then
+      ([], tail)
+    else
+      let rest_of_list, remaining_lines = take_nonempty_lines tail in
+      (head :: rest_of_list, remaining_lines)
+  | _ -> ([], lines)
+
+let print_layout arr =
+  arr
+    |> Array.iter (fun row -> row
+      |> Array.iter (fun x -> print_char x);
+      print_endline "")
+
+let rec find_index_inner elem arr pos =
+  try
+    if arr.(pos) = elem then
+      Some pos
+    else
+      find_index_inner elem arr (pos + 1)
+  with Invalid_argument _ -> None
+
+let find_index elem arr =
+  find_index_inner elem arr 0
+
+let rec find_index_2d_inner elem arr pos =
+  try
+    match find_index elem arr.(pos) with
+    | Some pos_x -> Some (pos_x, pos)
+    | None -> find_index_2d_inner elem arr (pos + 1)
+  with Invalid_argument _ -> None
+
+let find_index_2d elem arr =
+  find_index_2d_inner elem arr 0
+
+let get_dir_vector dir =
+  match dir with
+  | '<' -> (-1, 0)
+  | '>' -> (1, 0)
+  | '^' -> (0, -1)
+  | 'v' -> (0, 1)
+  | _ -> raise (Invalid_argument "Invalid direction")
+
+let add_int_pair (x1, y1) (x2, y2) =
+  (x1 + x2, y1 + y2)
+
+let rec skip_through_boxes (x, y) (dir_x, dir_y) arr =
+  if arr.(y).(x) <> 'O' then
+    (x, y)
+  else
+    let new_pos = add_int_pair (x, y) (dir_x, dir_y) in
+    skip_through_boxes new_pos (dir_x, dir_y) arr
+
+let robot_move arr pos dir =
+  let dir_vector = get_dir_vector dir in
+  let new_pos = add_int_pair pos dir_vector in
+  let pos_behind_boxes = skip_through_boxes new_pos dir_vector arr in
+  if arr.(snd pos_behind_boxes).(fst pos_behind_boxes) <> '#' then begin
+    arr.(snd pos).(fst pos) <- '.';
+    arr.(snd new_pos).(fst new_pos) <- '@';
+    if new_pos <> pos_behind_boxes then
+      arr.(snd pos_behind_boxes).(fst pos_behind_boxes) <- 'O';
+    new_pos
+  end else
+    pos
+
+let process_warehouse_tile c =
+  match c with
+  | '#' -> ['#'; '#']
+  | 'O' -> ['['; ']']
+  | '.' -> ['.'; '.']
+  | '@' -> ['@'; '.']
+  | _ -> raise (Invalid_argument "Invalid tile")
+
+let process_warehouse arr =
+  arr
+    |> Array.map (fun row -> row
+      |> Array.map process_warehouse_tile
+      |> Array.to_seq
+      |> List.of_seq
+      |> List.concat
+      |> List.to_seq
+      |> Array.of_seq
+    )
+
+let rec try_push_horizontal (x, y) dir_x arr =
+  let next_elem = arr.(y).(x) in
+  if next_elem = '#' then
+    false
+  else if next_elem = '.' then
+    true
+  else
+    let new_pos = (x + dir_x * 2, y) in
+    if try_push_horizontal new_pos dir_x arr then begin
+      let intermediate_pos = (x + dir_x, y) in
+      arr.(snd new_pos).(fst new_pos) <- arr.(snd intermediate_pos).(fst intermediate_pos);
+      arr.(snd intermediate_pos).(fst intermediate_pos) <- next_elem;
+      true
+    end else
+      false
+
+let rec possible_to_push_box_vertical (x, y) dir_y arr =
+  let new_y = y + dir_y in
+  possible_to_push_vertical (x, new_y) dir_y arr
+  && possible_to_push_vertical (x + 1, new_y) dir_y arr
+
+and possible_to_push_vertical (x, y) dir_y arr =
+  let next_elem = arr.(y).(x) in
+  if next_elem = '#' then
+    false
+  else if next_elem = '.' then
+    true
+  else if next_elem = '[' then
+    possible_to_push_box_vertical (x, y) dir_y arr
+  else
+    possible_to_push_box_vertical (x - 1, y) dir_y arr
+
+let rec do_push_box_vertical (x, y) dir_y arr =
+  let new_y = y + dir_y in begin
+  do_push_vertical (x, new_y) dir_y arr;
+  do_push_vertical (x + 1, new_y) dir_y arr;
+  arr.(new_y).(x) <- '[';
+  arr.(new_y).(x + 1) <- ']';
+  arr.(y).(x) <- '.';
+  arr.(y).(x + 1) <- '.'
+  end
+
+and do_push_vertical (x, y) dir_y arr =
+  let next_elem = arr.(y).(x) in
+  if next_elem = '#' || next_elem = '.' then
+    ()
+  else if next_elem = '[' then
+    do_push_box_vertical (x, y) dir_y arr
+  else
+    do_push_box_vertical (x - 1, y) dir_y arr
+
+let try_push pos (dir_x, dir_y) arr =
+  if dir_y = 0 then
+    try_push_horizontal pos dir_x arr
+  else
+    if possible_to_push_vertical pos dir_y arr then begin
+      do_push_vertical pos dir_y arr;
+      true
+    end else
+      false
+
+let robot_move_alt arr pos dir =
+  let dir_vector = get_dir_vector dir in
+  let new_pos = add_int_pair pos dir_vector in
+  if try_push new_pos dir_vector arr then begin
+    arr.(snd new_pos).(fst new_pos) <- '@';
+    arr.(snd pos).(fst pos) <- '.';
+    new_pos
+  end else begin
+    pos
+  end
+
+let array_copy_2d arr =
+  Array.init (Array.length arr) (fun i -> Array.copy arr.(i))
+
+let find_all_indices_of elem arr =
+  arr |> Array.to_seq
+      |> Seq.mapi (fun i x -> (i, x))
+      |> Seq.filter_map (fun (i, x) -> if x = elem then Some i else None)
+
+let find_all_indices_of_2d elem arr =
+  arr |> Array.to_seq
+      |> Seq.mapi (fun j row -> Seq.map (fun i -> (i, j)) (find_all_indices_of elem row))
+      |> Seq.concat
+
+let get_gps_index (x, y) =
+  x + 100 * y
+
+let () =
+  let f = open_in "input.txt" in
+  let layout_lines, remaining_lines = take_nonempty_lines @@ list_of_lines f in
+  let arr = lines_to_2d_array layout_lines in
+  let moves = String.concat "" remaining_lines in
+  let pos = find_index_2d '@' arr |> Option.get in
+  let warehouse1 = array_copy_2d arr in
+  let _ = String.fold_left (robot_move warehouse1) pos moves in
+  let result = warehouse1
+    |> find_all_indices_of_2d 'O'
+    |> Seq.map get_gps_index
+    |> Seq.fold_left Int.add 0 in
+  printf "%d\n" result;
+  let warehouse2 = process_warehouse arr in
+  let pos2 = find_index_2d '@' warehouse2 |> Option.get in
+  let _ = String.fold_left (robot_move_alt warehouse2) pos2 moves in
+  let result2 = warehouse2
+    |> find_all_indices_of_2d '['
+    |> Seq.map get_gps_index
+    |> Seq.fold_left Int.add 0 in
+  printf "%d\n" result2
diff --git a/16/main.ml b/16/main.ml
new file mode 100644
index 0000000..427ae72
--- /dev/null
+++ b/16/main.ml
@@ -0,0 +1,217 @@
+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 lines_to_2d_array lines =
+  let size_x = String.length @@ List.hd lines in
+  let size_y = List.length lines in
+  let arr = Array.make_matrix size_y size_x '?' in
+  List.iteri (fun j line -> String.iteri (fun i c -> arr.(j).(i) <- c) line) lines;
+  arr
+
+let print_layout arr =
+  arr
+    |> Array.iter (fun row -> row
+      |> Array.iter (fun x -> print_char x);
+      print_endline "")
+
+let rec find_index_inner elem arr pos =
+  try
+    if arr.(pos) = elem then
+      Some pos
+    else
+      find_index_inner elem arr (pos + 1)
+  with Invalid_argument _ -> None
+
+let find_index elem arr =
+  find_index_inner elem arr 0
+
+let rec find_index_2d_inner elem arr pos =
+  try
+    match find_index elem arr.(pos) with
+    | Some pos_x -> Some (pos_x, pos)
+    | None -> find_index_2d_inner elem arr (pos + 1)
+  with Invalid_argument _ -> None
+
+let find_index_2d elem arr =
+  find_index_2d_inner elem arr 0
+
+let add_int_pair (x1, y1) (x2, y2) =
+  (x1 + x2, y1 + y2)
+
+let array_copy_2d arr =
+  Array.init (Array.length arr) (fun i -> Array.copy arr.(i))
+
+let find_all_indices_of elem arr =
+  arr |> Array.to_seq
+      |> Seq.mapi (fun i x -> (i, x))
+      |> Seq.filter_map (fun (i, x) -> if x = elem then Some i else None)
+
+let find_all_indices_of_2d elem arr =
+  arr |> Array.to_seq
+      |> Seq.mapi (fun j row -> Seq.map (fun i -> (i, j)) (find_all_indices_of elem row))
+      |> Seq.concat
+
+let rec chain_comparison comp1 comp2 arg1 arg2 =
+  match comp1 arg1 arg2 with
+  | 0 -> comp2 arg1 arg2
+  | c -> c
+
+type maze_walk_state = {
+  pos: (int * int);
+  dir: char;
+  score: int
+}
+
+module MazeWalkState =
+struct
+  type t = maze_walk_state
+  let compare arg0 arg1 =
+    chain_comparison (fun arg1 arg2 -> Stdlib.compare arg1.score arg2.score) (
+      chain_comparison (fun arg1 arg2 -> Stdlib.compare (fst arg1.pos) (fst arg2.pos)) (
+        chain_comparison (fun arg1 arg2 -> Stdlib.compare (snd arg1.pos) (snd arg2.pos))
+                           (fun arg1 arg2 -> Stdlib.compare arg1.dir arg2.dir)
+      )
+    ) arg0 arg1
+end
+module MazeWalkStateSet = Set.Make(MazeWalkState)
+module IntMap = Map.Make(Int)
+module IntSet = Set.Make(Int)
+
+let get_dir_vector dir =
+  match dir with
+  | '<' -> (-1, 0)
+  | '>' -> (1, 0)
+  | '^' -> (0, -1)
+  | 'v' -> (0, 1)
+  | _ -> raise (Invalid_argument "Invalid direction")
+
+let rotate_dir_right dir =
+  match dir with
+  | '<' -> '^'
+  | '>' -> 'v'
+  | '^' -> '>'
+  | 'v' -> '<'
+  | _ -> raise (Invalid_argument "Invalid direction")
+
+let rotate_dir_left dir =
+  match dir with
+  | '<' -> 'v'
+  | '>' -> '^'
+  | '^' -> '<'
+  | 'v' -> '>'
+  | _ -> raise (Invalid_argument "Invalid direction")
+
+let rotate_dir_back dir = 
+  match dir with
+  | '<' -> '>'
+  | '>' -> '<'
+  | '^' -> 'v'
+  | 'v' -> '^'
+  | _ -> raise (Invalid_argument "Invalid direction")
+
+let walk_forward state =
+  {state with pos = add_int_pair state.pos (get_dir_vector state.dir); score = state.score + 1 }
+
+let turn_right state =
+  walk_forward {state with score = state.score + 1000; dir = rotate_dir_right state.dir}
+ 
+let turn_left state =
+  walk_forward {state with score = state.score + 1000; dir = rotate_dir_left state.dir}
+
+let dir_index dir =
+  match dir with
+  | '<' -> 0
+  | '>' -> 1
+  | '^' -> 2
+  | 'v' -> 3
+  | _ -> raise (Invalid_argument "Invalid direction")
+
+let generate_next_moves maze state =
+  [walk_forward state; turn_left state; turn_right state]
+    |> List.filter (fun state -> let (x, y) = state.pos in maze.(y).(x) <> '#')
+
+let get_state_index maze {pos=(x, y); dir=dir; score=_} =
+  ((Array.length maze) * x + y) * 4 + (dir_index dir)
+
+let state_index_remove_rotation state_index =
+  state_index / 4
+
+let decode_position_index maze position_index = 
+  let height = Array.length maze in
+  (position_index / height, position_index mod height)
+
+let add_prev maze prev_state next_state prev_move_map =
+  let prev_index = get_state_index maze prev_state in
+  let next_index = get_state_index maze next_state in
+  let update_fun lst_opt =
+    match lst_opt with
+    | Some (score, lst) ->
+        if next_state.score = score then
+          Some (score, prev_index :: lst)
+        else if next_state.score < score then
+          Some (next_state.score, [prev_index])
+        else
+          Some (score, lst)
+    | None -> Some (next_state.score, [prev_index]) in
+  IntMap.update next_index update_fun prev_move_map
+
+let worse_than_final_score final_score_opt score =
+  match final_score_opt with
+  | Some final_score -> score > final_score
+  | None -> false
+
+let rec dijkstra_find_path maze visited_array end_pos final_score_opt prev_move_map next_move_queue =
+  match MazeWalkStateSet.min_elt_opt next_move_queue with
+  | Some state ->
+    let queue_with_removed = MazeWalkStateSet.remove state next_move_queue in
+    if visited_array.(get_state_index maze state) then
+      dijkstra_find_path maze visited_array end_pos final_score_opt prev_move_map queue_with_removed
+    else
+      if worse_than_final_score final_score_opt state.score then
+        (Option.get final_score_opt, prev_move_map)
+      else begin
+        visited_array.(get_state_index maze state) <- true;
+        let next_states = generate_next_moves maze state in
+        let new_prev_move_map = List.fold_left (fun map s -> add_prev maze state s map) prev_move_map next_states in
+        let solution_states = List.filter (fun s -> s.pos = end_pos) next_states in
+        if List.length solution_states > 0 then
+          let final_score = (List.hd solution_states).score in
+          dijkstra_find_path maze visited_array end_pos (Some final_score) new_prev_move_map queue_with_removed
+        else
+          let new_queue = List.fold_left (fun queue s -> MazeWalkStateSet.add s queue) queue_with_removed next_states in
+          dijkstra_find_path maze visited_array end_pos final_score_opt new_prev_move_map new_queue
+    end
+  | None -> (-1, prev_move_map)
+
+let rec backtrack_and_fill_position_set prev_move_map state_index pos_set =
+  let new_pos_set = IntSet.add (state_index_remove_rotation state_index) pos_set in
+  match IntMap.find_opt state_index prev_move_map with
+  | Some (_, prev_list) ->
+    List.fold_left (fun set idx -> backtrack_and_fill_position_set prev_move_map idx set) new_pos_set prev_list
+  | None -> new_pos_set
+
+let count_tiles_on_best_paths maze end_pos prev_move_map =
+  ['<'; '>'; '^'; 'v']
+  |> List.map (fun dir -> get_state_index maze {pos=end_pos; dir=dir; score=0})
+  |> List.fold_left (fun set state_index -> backtrack_and_fill_position_set prev_move_map state_index set) IntSet.empty
+
+let find_best_path maze start_pos end_pos =
+  let visited_array = Array.make ((Array.length maze) * (Array.length maze.(0) * 4)) false in
+  let start_state = {pos=start_pos; dir='>'; score=0} in
+  dijkstra_find_path maze visited_array end_pos None IntMap.empty (MazeWalkStateSet.add start_state MazeWalkStateSet.empty)
+
+let () =
+  let f = open_in "input.txt" in
+  let maze = lines_to_2d_array @@ list_of_lines f in
+  let start_pos = find_index_2d 'S' maze |> Option.get in
+  let end_pos = find_index_2d 'E' maze |> Option.get in
+  let (result, prev_move_map) = find_best_path maze start_pos end_pos in
+  let result2 = prev_move_map |> count_tiles_on_best_paths maze end_pos |> IntSet.cardinal in
+  printf "%d\n%d\n" result result2