finish day 17 part 2

- printer callback includes Vec2.t in the arguments now
- added optional rev_x and rev_y params

.ocamlinit

@@ -1,2 +1,2 @@
 #install_printer Aoc.Vec2.pp;;
-#install_printer Aoc.Vec2.pp_grid;;
+#install_printer Aoc.Grid.pp;;

src/day14.ml

@@ -9,7 +9,7 @@ type tile =
   | Path_L
   | Path_R
 
-let char_of_tile = function
+let char_of_tile _ = function
   | Empty -> '-'
   | Rock -> '#'
   | Sand -> 'o'

src/day17.ml

@@ -0,0 +1,172 @@
+open Containers
+
+let cave_width = 7
+let example_lines = [ ">>><<><>><<<>><>>><<<>>><<<><<<>><>><<>>" ]
+
+let dir_of_char = function
+  | '<' -> Vec2.left
+  | '>' -> Vec2.right
+  | _ -> failwith "oof"
+;;
+
+let next_stream_idx stream idx = (idx + 1) mod Array.length stream
+
+type shape =
+  | Row
+  | Plus
+  | Angle
+  | Col
+  | Square
+
+let next_shape_idx idx = (idx + 1) mod 5
+let get_shape idx = [| Row; Plus; Angle; Col; Square |].(idx)
+
+(*[{
+                       #
+         #       #     #
+        ###      #     #     ##
+ ####    #     ###     #     ##
+
+ row    plus   angle   col   square
+
+}]*)
+let shape_points shape pos =
+  let points =
+    match shape with
+    | Row -> [ 0, 0; 1, 0; 2, 0; 3, 0 ]
+    | Plus -> [ 0, 1; 1, 0; 1, 1; 1, 2; 2, 1 ]
+    | Angle -> [ 0, 0; 1, 0; 2, 0; 2, 1; 2, 2 ]
+    | Col -> [ 0, 0; 0, 1; 0, 2; 0, 3 ]
+    | Square -> [ 0, 0; 1, 0; 0, 1; 1, 1 ]
+  in
+  points |> List.map (fun point -> Vec2.(pos + of_tuple point))
+;;
+
+type cache_key =
+  { stream_idx : int
+  ; rock_idx : int
+  ; normalized_topo : int array
+  }
+
+type cave =
+  { grid : char Grid.t
+  ; loop_cache : (cache_key, int * int) Hashtbl.t
+  ; mutable grid_topo : int array
+  ; mutable grid_height : int
+  ; mutable height : int
+  ; mutable rock_idx : int
+  ; mutable stream_idx : int
+  ; mutable dropped_rocks : int
+  ; mutable remaining_rocks : int
+  }
+
+let init_cave max_height remaining_rocks =
+  let grid = Grid.init ~width:7 ~height:max_height (Fun.const '.') in
+  { grid
+  ; height = -1
+  ; grid_height = -1
+  ; rock_idx = 0
+  ; dropped_rocks = 0
+  ; stream_idx = 0
+  ; grid_topo = Array.init cave_width (Fun.const 0)
+  ; loop_cache = Hashtbl.create max_height
+  ; remaining_rocks
+  }
+;;
+
+let draw_cave cave = Grid.draw cave.grid ~rev_y:true (fun _ contents -> contents)
+
+let place_shape cave shape pos =
+  shape_points shape pos
+  |> List.iter (fun point ->
+    let delta = point.Vec2.y - cave.grid_height in
+    if delta > 0
+    then (
+      cave.height <- cave.height + delta;
+      cave.grid_height <- cave.grid_height + delta);
+    cave.grid_topo.(point.x) <- max point.y cave.grid_topo.(point.x);
+    Grid.set_e cave.grid point '#')
+;;
+
+let can_place_shape cave shape pos =
+  shape_points shape pos
+  |> List.fold_while
+       (fun _ point ->
+         match cave.grid.Grid.%(point) with
+         | Some '.' -> true, `Continue
+         | _ -> false, `Stop)
+       false
+;;
+
+let drop_shape cave stream =
+  let shape = get_shape cave.rock_idx in
+  let rec drop pos =
+    let stream_pos = Vec2.(pos + stream.(cave.stream_idx)) in
+    cave.stream_idx <- next_stream_idx stream cave.stream_idx;
+    let pos = if can_place_shape cave shape stream_pos then stream_pos else pos in
+    let drop_pos = Vec2.(pos + Vec2.up) in
+    if can_place_shape cave shape drop_pos
+    then drop drop_pos
+    else place_shape cave shape pos
+  in
+  cave.rock_idx <- next_shape_idx cave.rock_idx;
+  cave.dropped_rocks <- cave.dropped_rocks + 1;
+  cave.remaining_rocks <- cave.remaining_rocks - 1;
+  drop Vec2.{ x = 2; y = Int.(cave.grid_height + 4) }
+;;
+
+let normalize_topo topo =
+  let min = Array.min_exn Int.compare topo in
+  Array.map (fun x -> x - min) topo
+;;
+
+let rec drop_shapes cave stream =
+  let cache_key =
+    { rock_idx = cave.rock_idx
+    ; stream_idx = cave.stream_idx
+    ; normalized_topo = normalize_topo cave.grid_topo
+    }
+  in
+  match Hashtbl.get cave.loop_cache cache_key with
+  | Some (cached_height, cached_dropped_rocks)
+    when let rock_delta = cave.dropped_rocks - cached_dropped_rocks in
+         rock_delta < cave.remaining_rocks ->
+    let rock_delta = cave.dropped_rocks - cached_dropped_rocks in
+    let height_delta = cave.height - cached_height in
+    cave.height <- cave.height + height_delta;
+    cave.dropped_rocks <- cave.dropped_rocks + rock_delta;
+    cave.remaining_rocks <- cave.remaining_rocks - rock_delta;
+    drop_shapes cave stream
+  | _ when cave.remaining_rocks > 0 ->
+    Hashtbl.add cave.loop_cache cache_key (cave.height, cave.dropped_rocks);
+    drop_shape cave stream;
+    drop_shapes cave stream
+  | _ -> ()
+;;
+
+let solve remaining_rocks lines =
+  let stream = lines |> List.hd |> Iter.of_str |> Iter.map dir_of_char |> Iter.to_array in
+  let cave = init_cave 100_000 remaining_rocks in
+  drop_shapes cave stream;
+  cave.height + 1
+;;
+
+let%expect_test "Day 17.1 Example" =
+  Printf.printf "height: %i\n" @@ solve 2022 example_lines;
+  [%expect {| height: 3068 |}]
+;;
+
+let%expect_test "Day 17.1" =
+  Printf.printf "height: %i\n" @@ solve 2022 (Utils.lines_of_input 17);
+  [%expect {| height: 3227 |}]
+;;
+
+let%expect_test "Day 17.2 Example" =
+  Printf.printf "height: %i\n" @@ solve 1_000_000_000_000 example_lines;
+  [%expect {| height: 1514285714288 |}]
+;;
+
+let%expect_test "Day 17.2" =
+  Printf.printf "height: %i\n" @@ solve 1_000_000_000_000 (Utils.lines_of_input 17);
+  [%expect {| height: 1597714285698 |}]
+;;

src/grid.ml

@@ -27,13 +27,14 @@ let at grid point =
 ;;
 
 let at_e (grid : 'a t) (point : Vec2.t) =
-  Option.get_exn_or "point out of bounds!" @@ at grid point
+  Option.get_exn_or (Format.sprintf "point %a out of bounds!" Vec2.pp point)
+  @@ at grid point
 ;;
 
 let set_e grid point item =
   if in_bounds grid point
   then Array.set grid.items (idx_of_vec2 grid.width point) item
-  else failwith "point out of bounds!"
+  else failwith (Format.sprintf "point %a out of bounds!" Vec2.pp point)
 ;;
 
 let ( .%() ) = at
@@ -82,12 +83,16 @@ let iter grid callback =
   iter_region grid a b callback
 ;;
 
-let draw grid printer =
-  let str = ref [] in
+let draw grid ?(rev_y = false) ?(rev_x = false) printer =
+  let line = ref [] in
+  let lines = ref [] in
   iter grid (fun point ->
     let item = grid.%(point) in
-    let char = printer @@ Option.get_exn_or "iter is broken" item in
-    str := !str @ [ char ];
-    if point.x = grid.width - 1 then str := !str @ [ '\n' ]);
-  String.of_list !str
+    let char = printer point (Option.get_exn_or "iter is broken" item) in
+    line := if rev_x then char :: !line else !line @ [ char ];
+    if List.length !line = grid.width
+    then (
+      lines := !lines @ [ String.of_list !line ];
+      line := []));
+  String.concat "\n" (if rev_y then List.rev !lines else !lines)
 ;;

src/grid.mli

@@ -11,4 +11,4 @@ val find : 'a t -> ('a -> bool) -> (Vec2.t * 'a) option
 val count : 'a t -> ('a -> bool) -> int
 val iter_region : 'a t -> Vec2.t -> Vec2.t -> (Vec2.t -> unit) -> unit
 val iter : 'a t -> (Vec2.t -> unit) -> unit
-val draw : 'a t -> ('a -> char) -> string
+val draw : 'a t -> ?rev_y:bool -> ?rev_x:bool -> (Vec2.t -> 'a -> char) -> string