finish day 17 part 2

src/day17.ml

@@ -1,5 +1,6 @@
 open Containers
 
+let cave_width = 7
 let example_lines = [ ">>><<><>><<<>><>>><<<>>><<<><<<>><>><<>>" ]
 
 let dir_of_char = function
@@ -41,17 +42,36 @@ let shape_points shape pos =
   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
-  ; cache : (int * int * Vec2.t list, string) Hashtbl.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 =
+let init_cave max_height remaining_rocks =
   let grid = Grid.init ~width:7 ~height:max_height (Fun.const '.') in
-  { grid; height = -1; rock_idx = 0; stream_idx = 0; cache = Hashtbl.create max_height }
+  { 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)
@@ -59,7 +79,12 @@ 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 ->
-    if cave.height < point.Vec2.y then cave.height <- point.y;
+    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 '#')
 ;;
 
@@ -75,7 +100,6 @@ let can_place_shape cave shape pos =
 
 let drop_shape cave stream =
   let shape = get_shape cave.rock_idx in
-  cave.rock_idx <- next_shape_idx cave.rock_idx;
   let rec drop pos =
     let stream_pos = Vec2.(pos + stream.(cave.stream_idx)) in
     cave.stream_idx <- next_stream_idx stream cave.stream_idx;
@@ -85,24 +109,64 @@ let drop_shape cave stream =
     then drop drop_pos
     else place_shape cave shape pos
   in
-  drop Vec2.{ x = 2; y = Int.(cave.height + 4) }
+  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 part1 cave_capacity lines =
+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 cave_capacity in
-  for _ = 1 to 2022 do
-    drop_shape cave stream
-  done;
+  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" @@ part1 4000 example_lines;
+  Printf.printf "height: %i\n" @@ solve 2022 example_lines;
   [%expect {| height: 3068 |}]
 ;;
 
 let%expect_test "Day 17.1" =
-  Printf.printf "height: %i\n" @@ part1 4000 (Utils.lines_of_input 17);
+  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