solve day 18!

it was kinda ez

.envrc

@@ -1 +1 @@
-eval $(opam config env)
+eval $(opam env --switch=.)

.gitignore

@@ -1,2 +1,3 @@
 .DS_Store
 _build/
+_opam/

.ocamlformat

@@ -1,2 +1 @@
 profile = janestreet
-version = 0.26.0

.ocamlinit

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

README.md

@@ -0,0 +1,6 @@
+## 2022 AOC problems in Ocaml 
+
+```sh
+$ opam switch create . --deps-only -y
+$ dune build
+```

aoc.opam

@@ -10,8 +10,21 @@ homepage: "https://github.com/username/reponame"
 doc: "https://url/to/documentation"
 bug-reports: "https://github.com/username/reponame/issues"
 depends: [
+  "utop"
+  "ocaml-lsp-server"
+  "ocamlformat"
   "ocaml"
   "dune" {>= "3.10"}
+  "re"
+  "containers"
+  "iter"
+  "dune-site"
+  "angstrom"
+  "ppx_deriving"
+  "ppx_deriving_hash"
+  "ppx_regexp"
+  "ppx_expect"
+  "ppx_inline_test"
   "odoc" {with-doc}
 ]
 build: [

dune-project

@@ -21,7 +21,28 @@
  (name aoc)
  (synopsis "A short synopsis")
  (description "A longer description")
- (depends ocaml dune)
+ (depends
+   ;; development env
+   utop
+   ocaml-lsp-server
+   ocamlformat
+
+   ;; deps
+   ocaml
+   dune
+   re
+   containers
+   iter
+   dune-site
+   angstrom
+
+   ;; ppx
+   ppx_deriving
+   ppx_deriving_hash
+   ppx_regexp
+   ppx_expect
+   ppx_inline_test
+ )
  (sites (lib inputs))
  (tags
   (topics "to describe" your project)))

inputs/day15.tt

@@ -0,0 +1,36 @@
+Sensor at x=13820, y=3995710: closest beacon is at x=1532002, y=3577287
+Sensor at x=3286002, y=2959504: closest beacon is at x=3931431, y=2926694
+Sensor at x=3654160, y=2649422: closest beacon is at x=3702627, y=2598480
+Sensor at x=3702414, y=2602790: closest beacon is at x=3702627, y=2598480
+Sensor at x=375280, y=2377181: closest beacon is at x=2120140, y=2591883
+Sensor at x=3875726, y=2708666: closest beacon is at x=3931431, y=2926694
+Sensor at x=3786107, y=2547075: closest beacon is at x=3702627, y=2598480
+Sensor at x=2334266, y=3754737: closest beacon is at x=2707879, y=3424224
+Sensor at x=1613400, y=1057722: closest beacon is at x=1686376, y=-104303
+Sensor at x=3305964, y=2380628: closest beacon is at x=3702627, y=2598480
+Sensor at x=1744420, y=3927424: closest beacon is at x=1532002, y=3577287
+Sensor at x=3696849, y=2604845: closest beacon is at x=3702627, y=2598480
+Sensor at x=2357787, y=401688: closest beacon is at x=1686376, y=-104303
+Sensor at x=2127900, y=1984887: closest beacon is at x=2332340, y=2000000
+Sensor at x=3705551, y=2604421: closest beacon is at x=3702627, y=2598480
+Sensor at x=1783014, y=2978242: closest beacon is at x=2120140, y=2591883
+Sensor at x=2536648, y=2910642: closest beacon is at x=2707879, y=3424224
+Sensor at x=3999189, y=2989409: closest beacon is at x=3931431, y=2926694
+Sensor at x=3939169, y=2382534: closest beacon is at x=3702627, y=2598480
+Sensor at x=2792378, y=2002602: closest beacon is at x=2332340, y=2000000
+Sensor at x=3520934, y=3617637: closest beacon is at x=2707879, y=3424224
+Sensor at x=2614525, y=1628105: closest beacon is at x=2332340, y=2000000
+Sensor at x=2828931, y=3996545: closest beacon is at x=2707879, y=3424224
+Sensor at x=2184699, y=2161391: closest beacon is at x=2332340, y=2000000
+Sensor at x=2272873, y=1816621: closest beacon is at x=2332340, y=2000000
+Sensor at x=1630899, y=3675405: closest beacon is at x=1532002, y=3577287
+Sensor at x=3683190, y=2619409: closest beacon is at x=3702627, y=2598480
+Sensor at x=180960, y=185390: closest beacon is at x=187063, y=-1440697
+Sensor at x=1528472, y=3321640: closest beacon is at x=1532002, y=3577287
+Sensor at x=3993470, y=2905566: closest beacon is at x=3931431, y=2926694
+Sensor at x=1684313, y=20931: closest beacon is at x=1686376, y=-104303
+Sensor at x=2547761, y=2464195: closest beacon is at x=2120140, y=2591883
+Sensor at x=3711518, y=845968: closest beacon is at x=3702627, y=2598480
+Sensor at x=3925049, y=2897039: closest beacon is at x=3931431, y=2926694
+Sensor at x=1590740, y=3586256: closest beacon is at x=1532002, y=3577287
+Sensor at x=1033496, y=3762565: closest beacon is at x=1532002, y=3577287

inputs/day16.tt

@@ -0,0 +1,60 @@
+Valve XB has flow rate=0; tunnels lead to valves WZ, LE
+Valve BM has flow rate=0; tunnels lead to valves PL, RI
+Valve GC has flow rate=0; tunnels lead to valves HN, IT
+Valve RM has flow rate=0; tunnels lead to valves ZQ, YL
+Valve ZM has flow rate=5; tunnels lead to valves SN, KE, UW, MY, GW
+Valve UH has flow rate=0; tunnels lead to valves HM, HN
+Valve GW has flow rate=0; tunnels lead to valves LE, ZM
+Valve HN has flow rate=19; tunnels lead to valves UW, UH, GL, WZ, GC
+Valve VT has flow rate=0; tunnels lead to valves ZD, PE
+Valve VI has flow rate=0; tunnels lead to valves JS, AA
+Valve YL has flow rate=12; tunnels lead to valves PM, MH, RM, CM
+Valve LA has flow rate=0; tunnels lead to valves SN, IY
+Valve CM has flow rate=0; tunnels lead to valves YL, UL
+Valve JI has flow rate=24; tunnels lead to valves UV, WH, XW, OJ
+Valve ZD has flow rate=25; tunnels lead to valves VB, XW, VT
+Valve VB has flow rate=0; tunnels lead to valves QX, ZD
+Valve FO has flow rate=0; tunnels lead to valves WH, PE
+Valve JS has flow rate=0; tunnels lead to valves VI, IY
+Valve RI has flow rate=0; tunnels lead to valves PE, BM
+Valve XD has flow rate=14; tunnel leads to valve CP
+Valve ES has flow rate=11; tunnels lead to valves GU, WU
+Valve WZ has flow rate=0; tunnels lead to valves XB, HN
+Valve HW has flow rate=0; tunnels lead to valves QY, LE
+Valve KE has flow rate=0; tunnels lead to valves AA, ZM
+Valve IY has flow rate=22; tunnels lead to valves JS, AB, LA, IT
+Valve XW has flow rate=0; tunnels lead to valves ZD, JI
+Valve BE has flow rate=0; tunnels lead to valves AB, LE
+Valve QY has flow rate=23; tunnels lead to valves AM, HW, MY
+Valve MH has flow rate=0; tunnels lead to valves YL, AM
+Valve IT has flow rate=0; tunnels lead to valves GC, IY
+Valve DA has flow rate=0; tunnels lead to valves QR, CP
+Valve PM has flow rate=0; tunnels lead to valves LE, YL
+Valve WU has flow rate=0; tunnels lead to valves SM, ES
+Valve UL has flow rate=0; tunnels lead to valves CM, QR
+Valve SM has flow rate=13; tunnel leads to valve WU
+Valve XC has flow rate=0; tunnels lead to valves ZJ, AA
+Valve OJ has flow rate=0; tunnels lead to valves GI, JI
+Valve SN has flow rate=0; tunnels lead to valves LA, ZM
+Valve WH has flow rate=0; tunnels lead to valves JI, FO
+Valve UW has flow rate=0; tunnels lead to valves HN, ZM
+Valve HM has flow rate=0; tunnels lead to valves UH, PE
+Valve AB has flow rate=0; tunnels lead to valves BE, IY
+Valve QR has flow rate=8; tunnels lead to valves WW, UL, DA
+Valve UV has flow rate=0; tunnels lead to valves JI, FF
+Valve ZQ has flow rate=20; tunnel leads to valve RM
+Valve ZJ has flow rate=0; tunnels lead to valves PE, XC
+Valve GL has flow rate=0; tunnels lead to valves HN, PL
+Valve CP has flow rate=0; tunnels lead to valves DA, XD
+Valve AM has flow rate=0; tunnels lead to valves QY, MH
+Valve PL has flow rate=17; tunnels lead to valves GL, YE, BM, FF, QX
+Valve YE has flow rate=0; tunnels lead to valves PL, AA
+Valve PE has flow rate=4; tunnels lead to valves FO, RI, ZJ, VT, HM
+Valve MY has flow rate=0; tunnels lead to valves QY, ZM
+Valve QX has flow rate=0; tunnels lead to valves VB, PL
+Valve GI has flow rate=0; tunnels lead to valves OJ, AA
+Valve WW has flow rate=0; tunnels lead to valves GU, QR
+Valve FF has flow rate=0; tunnels lead to valves UV, PL
+Valve LE has flow rate=6; tunnels lead to valves HW, GW, XB, BE, PM
+Valve GU has flow rate=0; tunnels lead to valves ES, WW
+Valve AA has flow rate=0; tunnels lead to valves KE, GI, VI, YE, XC

inputs/day17.tt

@@ -0,0 +1 @@
+><<<<>>>><>>><<><<<<>>>><<>>><>>><<<<>>>><<>>>><<<>>>><<<>>>><<<>>><<<<>><>><<<<>>><><<<><><>>>><<<<><<<<>><<<>>>><<>><><>>>><<<>>><<<>>><<>>>><>>>><>><>>><<>><><<<<><>><<<>>>><<<>>><<<>><>><<<>>><<<<>>>><><<<>>><<<>>><<<<><<<<>>><<<<>>><<<>>><<<<>>><<>>><<><<<>><<<>>><<<<><<<<>>><<<><<>>>><<<>><>>><<>>><<<><<<<>>><<><<<<>>>><<>>>><<>>>><<<<>>><><<<<><>><<<>>>><<<<>><>>>><>><>><>><<<>><<<>>>><<<>><<>><<<<><<<<><<>>>><<<<><<<>>><>><<<>>><<<><<<><<<<><<><<<>>><<<<>>>><<<<><<>><<<<>>><>>><<<<><<<>>>><<><>><<<<>><<<<>>>><<<><<<<><<<<>>><<<><<>>><>>><<<<>>><<>><<<<>>><<<><<<>><<<<>>>><<<<><<><<<<>>>><>>>><<<<>>>><<<>>>><<<><<>>><>>><<<<>><<<<>>><><>><<<>>>><<<<>><<<>><<>><<<>>><<<>>>><<<<>>>><<>>>><<>>>><><<<<>><<<<>>>><<<<>>><<<<>><>><<<>>><>>>><><<>><<>>><<<>>>><>>><<>><<<>><>>><>>><><>><>><<<><<<>>>><>><<<><<<>>><<<<><<>>>><<<><<<>>>><>><<<>>>><<<>>>><>>><><>>>><>><<><<<>>>><<>>>><<<>>><<<<>>><<<>><>>>><<<<>>>><>><<>>><<<<>>>><<<<><>>>><<>><<>>>><>><<<<>>>><<<<>><<<>>>><<>><><>><<<<>><<<>>>><<<>>><<>><><<<>>>><<>><>><<>><>><<<<>><<<>>><<<<>>><<>>>><<>>><<<<>>><>><<><<<>><>>><<<>><<<<>>>><<<>>><<>>><<<>>><<<<>>>><<<<>>><<<>>><<>>>><<>>><<<>>><<><<>>>><<>>>><<><<>>><<><<<>>>><<<<><<<<>><<<>>>><>>><<<<>>><<<<>>>><<>><<<<>>>><<<><<<><<>>>><<<>>>><<<>>>><<<>><<>>><>>><<<<>>><<<<>><<<>>><<<>><<<<>>><<<<><<><>>><<<<>>><<<<>>>><>><<<<>><<<<>>>><<<<><<<>>>><>><<<<><<<<>>>><>><<><<<>>><<>>><<<<>><<<><<<><>><<>>>><<<><<<<><<<>>>><<<<>><<>><<<<>>>><><<<><<<>>>><<>>>><<>><<<<>>>><><><<<<><><<>>><<><<>>><>>><<>><><<><<>>>><<<<><<<>>>><<>><><<>>>><<<<><><<<>>>><<>>><<<><<<>>>><>><<<<>>>><>>><<><>>>><>>>><<<><>>><>>>><<<>><<<>>><<<<>>>><<>>>><<<<>>>><<><>><<<<>><<<<>>><<>>><>>>><<><<>>><>>>><<><<><<><><<<>><>><<<<>>><<<>>>><<<><<<<>><>><>>><<<<><<<>>>><<<>>><><<<<>>><<<<><<<<>>>><>><>>><<<><<>><<<><>>><<<<>><><<<<><>><<>><<>><>><<<<><<<>><>>>><<>><<<<>>><><<<>><<>><<>><>>><>>>><<><>><<<<>>><>>><<>>><<>>>><<>><<<<>>><>><<<>>><<<>>><<<<>>>><<<><<<<>><<><<<><<<>>><<><<>><>><>>><<<>>><<>><<>>><<>><<>><>><<<<>>>><<<<>>><<<>>>><<<<>>><<<>><<<>><<<<>>>><<>><<<<><<<<>><<>>><><<><<<<>>>><><>>>><<<<>>>><<<<>>>><<>><<<<>>>><<<><>><<>>>><<>>>><<<<>>>><<<>>><>><<>>>><<<>>>><<<<>>><<<<>><<<<>>>><<>>><<>>>><>>><>>>><><>><<<<>>>><<<>>>><<<>><<>>><<<<>>><>>>><<>>>><<<><>>><><<>>>><<>>>><<<>>>><<<<><<<<>>>><>>>><>><<<>>><<<>>>><<<>><<<>>><>><<>>><<><><<><<>>>><>>><<<<>><><>><>>><<<<><>>><<<>>><<<><<<<>>><<<>><<<>>><<>>><<<<><<<<><>><><<<<>>><<<>><<>><<<>><<<<>><>><>>>><<>>><<<>><<<>><<<<>><><<<<>>><<<>>>><<<<>>><<>><>><<>>><><<>>><<<>>><<<>><<>>>><<<<>><<<<>>>><<<><<><<<<>><<<<>><<<>>>><>><<<><>>>><<>>>><<><<<>>>><<<<>><<<>>>><<>>><>><<<<>>>><<<<>>><>>>><<<<><<><<>><>><>>><<<><<<<><<<<>><<<>>><<<<>><<><<<<>>>><<<>>>><<<>>>><<<<>>><<><<>><<><<<<>>>><<<><<<<>>>><<>>><<<<>><>>>><<<<>><<<>>>><<><<<<>>>><<<>><>>>><><<<>><<<><<<>>><>>>><>>><<<<><<<<>>><<>>><<<>>><<<<><<<<>>>><<>>><<<>><<>>><><<<>>>><<><>>><<>><<<>>>><<<><>><<<>>><<>>>><<<>>>><>><<><>><<>>>><<<>>>><<<<>>>><<<>>><<<>><<<<><<<<>><><<><<<>><>>><<<<>>><<<<>><<<>>><<>><<<<><<<><<<><<<>>><<<<>>><<<<>><<>>><<>><<<<>>>><<>>>><<>>>><<>><>>><>>>><<>>>><<<>>><<<<>>><>>><>>>><<<>><<>>><<>>>><<>>>><<<>>><<>>><<<><<<>><>>>><<<>><>>><<<>>><>>>><>><<>>><<<<>>><<<<>><>>><<<<>>><<<<><<<>>><><>>><<<>>><>><>>>><<>>>><<<>><<>>><<>><<<<>><<<<><>>><<>><<<<>>><<<>>><<>>>><>>>><<<><>>>><<><><>>><<>>>><<<>>>><><>><<<<>><<<>>>><<<<><<<<>>>><<<<>><>>>><<<>>>><<><<>>>><<<<>>>><<<<>>><>><>>>><>>>><>><<>>>><>>>><<>>><<<<>>>><<>>><><<>>>><<>><<<<><<><>>>><<<<>><<><<><<>><<<><<<>><<<<>>><<<<>><<>><>>><<<<>>>><<<<>>>><<<<>>><><<<<><<<<><><<<<><<<<>>>><<<<>>>><><>>><<<<><<<<><<<><><<<<>><><<<><<<<>><>>><><><<<><>>><<><<>><<<>><<<>>>><<<<>>><<>><<<<><>>><>>><<>>>><<<<>>><<<>>>><<<>>>><<<>><<<>><<<<>>><<<<>><>>><<<<><>>>><<<>><>>><<>>><<<<>><<><<<>><>>><<<>><<<<>>><<<>>>><>>><><<<><<<>>>><<>>><<><>>>><>>>><<<<>>><><><>>>><<<<>><<<<>>><<>>><<<><<<>>>><<><<<>><<<>>>><<<<>>>><>>><<<>>><><<<>><<<<>><<<>>>><>><<><><<>><<<>><<<>>><<<<>>>><<<><<<<>><<<<>>>><<<<>>>><<><<<<>>><<<<>><<<<>><<<>><<<<>>><<>>>><<>>><>><<>>>><>>><>>><<<><>>>><<<>>><<<<><<<<>>><<><><>>>><<>>>><<>>>><<<<>>>><<><<><<<>>><<<>>>><<><<<><<>>><<<><<<>>>><<<<>>><<>>>><<>><><<<><<>><<>>><<<<>><>><<<>><<<<>><<<<><<>>><<><<<<>>>><<<>><<<<>><<>>>><>>>><>>><>>>><<<>>><<<>>>><<>>>><>><>><<<>><<<>>><<>>><<<<>>><<<<>>><<>>>><>>><>><<<<>>>><<>>>><<>>>><<<<>>>><>>>><><>>><<>>>><<<<><<>>>><<<<>><<<<>>>><<>><<<<><<<<>>><<<<>><<>>>><<<>>>><<<><>><<<><<>>><<<<>><<<>>><><<<<>><<<<>><>>><<<<>>><<<<>>>><>>>><<>>>><<>>><>>>><<<<>>><<>><<<><<><<<>>>><<<>>>><<<<><<>>><>><<<<><<<>>><>><><<<><<>>>><>>>><>><<>>><<>>>><<>>>><<<<>><<>><><<>>><<>><<>><<>>><>><<<<>>>><<>>>><<<<>>><<>><><<<><>><<<>><>>><>><<>>><><>>><<>>>><<<>>><<<<>>><<<>><<>><<<<>>><<<><<<>><<<<><<>><>><<<<>><<>>>><<<>><<<>>>><<<<>>>><<<<>><<>>><<<>>><<<>>>><<<<>>><<<<>>>><>><<<<>>>><<>>><><<>>>><<<<>>>><<<<>>>><>><<>><<<<><<<<>>><><>>><<<<>>><<><>>>><<<<><<<>>>><>>>><<<>>>><<<>>>><<>>><<>>><<<<><<<>><>>><<<><<<>>><Line truncated

src/day12.ml

@@ -1,7 +1,5 @@
 open Containers
 
-let infinity = 1000000000
-
 type node =
   { char : char
   ; mutable visited : bool
@@ -10,25 +8,20 @@ type node =
 [@@deriving show]
 
 let parse_grid start_anywhere =
-  let s = ref @@ Vec2.origin in
+  let start_nodes = ref [] in
-  let e = ref @@ Vec2.origin in
+  let end_node = ref @@ Vec2.origin in
-  let unvisited = ref [] in
   let grid =
     Utils.lines_of_input 12
-    |> Grid.of_lines (fun char -> { char; visited = false; distance = infinity })
+    |> Grid.of_lines (fun char -> { char; visited = false; distance = Int.max_int })
   in
   Grid.iter grid (fun pos ->
-    let n = Grid.at_e grid pos in
+    let node = Grid.at_e grid pos in
-    match n.char with
+    match node.char with
-    | 'E' -> e := pos
+    | 'E' -> end_node := pos
-    | 'S' ->
+    | 'S' -> start_nodes := pos :: !start_nodes
-      n.distance <- 0;
+    | 'a' when start_anywhere -> start_nodes := pos :: !start_nodes
-      s := pos
-    | 'a' when start_anywhere ->
-      n.distance <- 0;
-      unvisited := pos :: !unvisited
     | _ -> ());
-  grid, !e, !s, !unvisited
+  grid, !end_node, !start_nodes
 ;;
 
 let reachable f t =
@@ -41,42 +34,67 @@ let reachable f t =
   Char.compare (height f) (height t) >= -1
 ;;
 
-let rec path grid goal current unvisited =
+let get_neighbors grid node_pos =
-  let current_node = Grid.at_e grid current in
+  let node = Grid.at_e grid node_pos in
   Vec2.directions
-  |> List.map (fun dir -> Vec2.(current + dir))
+  |> Iter.of_list
-  |> List.iter (fun neighbor ->
+  |> Iter.filter_map (fun dir ->
-    match Grid.at grid neighbor with
+    let neighbor_pos = Vec2.(node_pos + dir) in
-    | Some node when (not node.visited) && reachable current_node.char node.char ->
+    match Grid.at grid neighbor_pos with
-      let new_distance = current_node.distance + 1 in
+    | Some neighbor when reachable node.char neighbor.char -> Some neighbor_pos
-      if new_distance < node.distance then node.distance <- new_distance;
+    | _ -> None)
-      if Option.is_none @@ List.find_opt (fun x -> Vec2.(x = neighbor)) !unvisited
+;;
-      then unvisited := neighbor :: !unvisited
+
-    | _ -> ());
+let path_distance grid goal start_nodes =
-  current_node.visited <- true;
+  let set_info position (dist, visited) =
-  unvisited
+    let node = Grid.at_e grid position in
-    := List.sort
+    node.distance <- dist;
-         (fun a b ->
+    node.visited <- visited
-           let a = Grid.at_e grid a in
+  in
-           let b = Grid.at_e grid b in
+  let get_info position =
-           a.distance - b.distance)
+    let { char = _; distance; visited } = Grid.at_e grid position in
-         !unvisited;
+    distance, visited
-  match !unvisited with
+  in
-  | shortest :: _ when Vec2.(shortest = goal) -> Grid.at grid shortest
+  Utils.djikstra
-  | shortest :: rest -> path grid goal shortest @@ ref rest
+    ~set_info
-  | [] -> None
+    ~get_info
+    ~eq:Vec2.( = )
+    ~get_weight:(fun _ _ -> 1)
+    ~get_neighbors:(get_neighbors grid)
+    ~goal
+    ~start_nodes
+  |> Option.get_exn_or "couldn't find"
 ;;
 
 let%expect_test "Day 12.1" =
-  let grid, e, s, unvisited = parse_grid false in
+  let grid, goal, start_nodes = parse_grid false in
-  let solution = Option.get_exn_or "coulnd't find" @@ path grid e s @@ ref unvisited in
+  Printf.printf "%i" @@ path_distance grid (Some goal) start_nodes;
-  Printf.printf "%d" solution.distance;
   [%expect {| 497 |}]
 ;;
 
 let%expect_test "Day 12.2" =
-  let grid, e, s, unvisited = parse_grid true in
+  let grid, goal, start_nodes = parse_grid true in
-  let solution = Option.get_exn_or "coulnd't find" @@ path grid e s @@ ref unvisited in
+  Printf.printf "%i" @@ path_distance grid (Some goal) start_nodes;
-  Printf.printf "%d" solution.distance;
   [%expect {| 492 |}]
 ;;
+
+let%expect_test "Day 12 test" =
+  let grid, goal, start_nodes = parse_grid false in
+  let _ = path_distance grid None start_nodes in
+  let print_dist_to pos =
+    let node = Option.get_exn_or "invalid pos!" grid.Grid.%(pos) in
+    Printf.printf "%s %c %i\n" (Vec2.show pos) node.char node.distance
+  in
+  print_dist_to goal;
+  print_dist_to Vec2.(goal + right);
+  print_dist_to Vec2.(goal + down);
+  print_dist_to Vec2.(of_tuple (121, 23));
+  print_dist_to Vec2.(origin + right);
+  [%expect
+    {|
+    (149, 20) E 497
+    (150, 20) z 498
+    (149, 21) y 496
+    (121, 23) a 138
+    (1, 0) b 21 |}]
+;;

src/day14.ml

@@ -9,8 +9,8 @@ type tile =
   | Path_L
   | Path_R
 
-let char_of_tile = function
+let char_of_tile _ = function
-  | Empty -> ' '
+  | Empty -> '-'
   | Rock -> '#'
   | Sand -> 'o'
   | Start -> 'v'
@@ -19,6 +19,11 @@ let char_of_tile = function
   | Path_R -> '\\'
 ;;
 
+let is_sand = function
+  | Sand -> true
+  | _ -> false
+;;
+
 let parse_line line =
   let open Utils.Parse in
   let vec = Vec2.of_tuple <$> both int (char ',' *> int) in
@@ -38,277 +43,148 @@ let draw_rocks grid points =
 ;;
 
 let parse_grid lines start =
-  let points = List.map parse_line lines in
+  let points = Iter.map Fun.(parse_line %> Iter.of_list) lines in
-  let lx, hx, ly, hy =
+  let Vec2.{ x = lx; y = ly }, Vec2.{ x = hx; y = hy } =
-    points
+    points |> Iter.flatten |> Iter.cons start |> Vec2.find_bounds 0
-    |> List.flatten
-    |> List.append [ start ]
-    |> List.fold_left
-         (fun (lx, hx, ly, hy) Vec2.{ x; y } ->
-           let lx = min lx x in
-           let hx = max hx x in
-           let ly = min ly y in
-           let hy = max hy y in
-           lx, hx, ly, hy)
-         (Int.max_int, 0, Int.max_int, 0)
   in
+  let pad_floor = 1 in
   let pad_x = 2 in
+  let height = 1 + hy - ly + pad_floor in
+  let lx = min lx (start.x - height) in
+  let hx = max hx (start.x + height) in
+  let width = 1 + hx - lx + (pad_x * 2) in
   let extra = Vec2.of_tuple (lx - pad_x, ly) in
-  let width = hx - lx + (pad_x * 2) + 1 in
-  let height = hy - ly + 1 in
   let start = Vec2.(start - extra) in
   let open Grid in
   let grid = init ~width ~height (fun _ -> Empty) in
   grid.%(start) <- Start;
-  points
+  Iter.iter
-  |> List.iter Fun.(List.map (fun point -> Vec2.(point - extra)) %> draw_rocks grid);
+    Fun.(Iter.map (fun point -> Vec2.(point - extra)) %> Iter.to_list %> draw_rocks grid)
+    points;
   grid, start
 ;;
 
-let rec drop_sand grid start draw_path =
+type is_done =
+  | Continue
+  | Done
+
+let rec drop_sand_abyss draw_path grid start =
   let d = Vec2.(start + down) in
   let l = Vec2.(d + left) in
   let r = Vec2.(d + right) in
   let open Grid in
-  match grid.%(start), grid.%(l), grid.%(d), grid.%(r) with
+  match grid.%(l), grid.%(d), grid.%(r) with
-  | _, _, Some Empty, _ ->
+  | _, None, _ -> Done
+  | _, Some Empty, _ ->
     if draw_path then grid.%(d) <- Path_D;
-    drop_sand grid d draw_path
+    drop_sand_abyss draw_path grid d
-  | _, Some Empty, _, _ ->
+  | Some Empty, _, _ ->
     if draw_path then grid.%(l) <- Path_L;
-    drop_sand grid l draw_path
+    drop_sand_abyss draw_path grid l
-  | _, _, _, Some Empty ->
+  | _, _, Some Empty ->
     if draw_path then grid.%(r) <- Path_R;
-    drop_sand grid r draw_path
+    drop_sand_abyss draw_path grid r
-  | _, _, None, _ -> Error ()
+  | _, _, _ ->
-  | Some Empty, _, _, _ ->
+    (match grid.%(start) with
+     | Some Empty ->
        grid.%(start) <- Sand;
-    Ok ()
+       Continue
-  | _, _, _, _ -> failwith "pain"
+     | _ -> failwith "oh no!")
 ;;
 
-let rec drop_all_sand grid start =
+let rec drop_sand_floor grid start =
-  match drop_sand grid start false with
+  let d = Vec2.(start + down) in
-  | Ok () -> drop_all_sand grid start
+  let l = Vec2.(d + left) in
-  | Error _ -> ()
+  let r = Vec2.(d + right) in
+  let open Grid in
+  match grid.%(l), grid.%(d), grid.%(r) with
+  | _, Some Empty, _ -> drop_sand_floor grid d
+  | Some Empty, _, _ -> drop_sand_floor grid l
+  | _, _, Some Empty -> drop_sand_floor grid r
+  | _, _, _ ->
+    (match grid.%(start) with
+     | Some Empty ->
+       grid.%(start) <- Sand;
+       Continue
+     | Some Start ->
+       grid.%(start) <- Sand;
+       Done
+     | _ -> failwith "oh no!")
 ;;
 
-let%expect_test "Day 14 example" =
+let rec drop_all_sand drop grid start =
-  let lines = [ "498,4 -> 498,6 -> 496,6"; "503,4 -> 502,4 -> 502,9 -> 494,9" ] in
+  match drop grid start with
+  | Continue -> drop_all_sand drop grid start
+  | Done -> ()
+;;
+
+let%expect_test "Day 14.1 example" =
+  let lines =
+    Iter.of_list [ "498,4 -> 498,6 -> 496,6"; "503,4 -> 502,4 -> 502,9 -> 494,9" ]
+  in
   let start = Vec2.of_tuple (500, 0) in
   let grid, start = parse_grid lines start in
-  let show_grid () = Printf.printf "%s" @@ Grid.draw grid char_of_tile in
+  drop_all_sand (drop_sand_abyss false) grid start;
-  show_grid ();
+  let _ = drop_sand_abyss true grid start in
+  let count = Grid.count grid is_sand in
+  Printf.printf "%i grains\n%s" count @@ Grid.draw grid char_of_tile;
   [%expect
     {|
-          v
+    24 grains
-
+    -------------v-------------
-
+    -------------|-------------
-
+    ------------/o-------------
-        #   ##
+    -----------/ooo------------
-        #   #
+    ----------/#ooo##----------
-      ###   #
+    ---------/o#ooo#-----------
-            #
+    --------/###ooo#-----------
-            #
+    --------|--oooo#-----------
-    ######### |}];
+    -------/o-ooooo#-----------
-  drop_all_sand grid start;
+    ------/#########-----------
-  let _ = drop_sand grid start true in
+    ------|-------------------- |}]
-  show_grid ();
-  [%expect
-    {|
-           v
-           |
-          /o
-         /ooo
-        /#ooo##
-       /o#ooo#
-      /###ooo#
-      |  oooo#
-     /o ooooo#
-    /######### |}]
 ;;
 
-let%expect_test "Day 14 example" =
+let%expect_test "Day 14.2 example" =
-  let lines = Utils.lines_of_input 14 in
+  let lines =
+    Iter.of_list [ "498,4 -> 498,6 -> 496,6"; "503,4 -> 502,4 -> 502,9 -> 494,9" ]
+  in
   let start = Vec2.of_tuple (500, 0) in
   let grid, start = parse_grid lines start in
-  drop_all_sand grid start;
+  drop_all_sand drop_sand_floor grid start;
-  let _ = drop_sand grid start true in
+  let count = Grid.count grid is_sand in
-  Printf.printf "%s" @@ Grid.draw grid char_of_tile;
+  Printf.printf "%i grains\n%s" count @@ Grid.draw grid char_of_tile;
   [%expect
     {|
-            v
+    93 grains
-            |
+    -------------o-------------
-            |
+    ------------ooo------------
-            |
+    -----------ooooo-----------
-            |
+    ----------ooooooo----------
-            |
+    ---------oo#ooo##o---------
-            |
+    --------ooo#ooo#ooo--------
-            |
+    -------oo###ooo#oooo-------
-            |
+    ------oooo-oooo#ooooo------
-           oo\
+    -----oooooooooo#oooooo-----
-          oooo\
+    ----ooo#########ooooooo----
-         oooooo\
+    ---ooooo-------ooooooooo--- |}]
-        oooooooo\
+;;
-       ooo#oo#ooo\
+
-      oooo#oo#oooo\
+let%expect_test "Day 14.1" =
-    #######oo######\
+  let lines = Iter.of_list @@ Utils.lines_of_input 14 in
-    #     oooo    #o\
+  let start = Vec2.of_tuple (500, 0) in
-    #    oooooo   #oo\
+  let grid, start = parse_grid lines start in
-    #   oooooooo  #ooo\
+  drop_all_sand (drop_sand_abyss false) grid start;
-    #  oooooooooo #oooo\
+  let count = Grid.count grid is_sand in
-    # oooooooooooo#ooooo\
+  Printf.printf "%i" count;
-    #ooooooooooooo#oooooo\
+  [%expect {| 683 |}]
-    #ooooooooooooo#ooooooo\
+;;
-    ###############oooooooo\
+
-                  oooooooooo\
+let%expect_test "Day 14.2" =
-                 oooooooooooo\
+  let lines = Iter.of_list @@ Utils.lines_of_input 14 in
-                ######oooooooo\
+  let start = Vec2.of_tuple (500, 0) in
-                     oooooooooo\
+  let grid, start = parse_grid lines start in
-             ###### ######oooooo\
+  drop_all_sand drop_sand_floor grid start;
-                         oooooooo\
+  let count = Grid.count grid is_sand in
-          ###### ###### ######oooo\
+  Printf.printf "%i" count;
-                             oooooo\
+  [%expect {| 28821 |}]
-       ###### ###### ###### ######oo\
-                                 oooo\
-    ###### ###### ###### ###### ######\
-                                      |
-                                      |
-                                      |
-                                      |
-                                     /# #
-                                    /o# #
-                                   /#o# #
-                                  /o#o# #
-                                 /#o#o# #
-                                 |#o#o# #
-                                 |#o#o# #
-                                 |#o#o# #
-                                 |#######
-                                 |
-                                oo\
-                               #ooo\
-                               #oooo\
-                           #   #ooooo\
-                           #   #ooo#o#\
-                           #   #ooo#o#|
-                           # # #ooo#o#|
-                           # # #o#o#o#|
-                           # # #o#o#o#|
-                           # # #o#o#o#|
-                           # # #o#o#o#|
-                           ###########|
-                                     oo\
-                                    oooo\
-                                   #oooo#\
-                                   #oooo#|
-                                   #oooo#|
-                           #########oooo##\
-                           #       oooooo#|
-                           #      ooooooo#|
-                           #     oooooooo#|
-                           #    ooooooooo#|
-                           ###############|
-                                          |
-                                          |
-                                        #oo\
-                                    #   #ooo\
-                                  # #   #oooo\
-                                  # #   #ooo#o\
-                                  # #   #ooo#o#\
-                                  # #   #o#o#o#o\
-                                  # #   #o#o#o#o#\
-                                  # # # #o#o#o#o#|
-                                  # # # #o#o#o#o#o\
-                                  # # # #o#o#o#o#oo\
-                                  ###############ooo\
-                                                ooooo\
-                                               ooooooo\
-                                           #  ooooooooo\
-                                           #############\
-                                                       oo\
-                                                      oooo\
-                                                     ######\
-                                                          /o
-                                                         /ooo
-                                                  ######/######
-                                                       /o
-                                                      /ooo
-                                               ######/###### ######
-                                                    /o
-                                                   /ooo
-                                            ######/###### ###### ######
-                                                 /o
-                                                /ooo
-                                         ######/###### ###### ###### ######
-                                               |
-                                               |
-                                              /o
-                                             /ooo
-                                            /#oooo#
-                                           /o######
-                                          /ooo
-                                         /ooooo
-                                        /#ooooo#
-                                        |#ooooo#
-                                       /o#ooooo#
-                                      /oo#ooooo#
-                                     /####ooooo#######
-                                     |#  ooooooo     #
-                                     |# ooooooooo    #
-                                     |#ooooooooooo   #
-                                     |#oooooooooooo  #
-                                     |#ooooooooooooo #
-                                     |################
-                                    /o
-                                   /ooo
-                                  /ooooo
-                                 /oo#ooo#
-                                /ooo#####
-                               /ooooo
-                              /ooooooo
-                             /oo#oooo#o
-                            /ooo#oooo#oo
-                           /oooo#oooo#ooo
-                          /######oooo#########
-                          |#    oooooo       #
-                          |#   oooooooo      #
-                          |#  oooooooooo     #
-                         /o# oooooooooooo    #
-                        /oo###################
-                       /oooo
-                      /oooooo
-                     /######oo
-                     |     oooo
-                     |    oooooo
-                     |   ######oo
-                     |        oooo
-                    /o###### ######
-                   /ooo
-                  /###### ###### ######
-                  |
-                  |
-                  |
-             #   oo\
-             #  oooo\
-             # oooo#o\
-             #ooo#o#o#\
-             #ooo#o#o#|
-             #o#o#o#o#|
-             #o#o#o#o#|
-             #o#o#o#o#|
-             #o#o#o#o#|
-             #########|
-                     oo\
-                    oooo\
-                   ######\
-                        /o
-                       /ooo
-                ######/######
-                     /o
-                    /ooo
-             ######/###### ######
-                  /o
-                 /ooo
-          ######/###### ###### ###### |}]
 ;;

src/day15.ml

@@ -0,0 +1,167 @@
+open Containers
+
+let example_lines =
+  [ "Sensor at x=2, y=18: closest beacon is at x=-2, y=15"
+  ; "Sensor at x=9, y=16: closest beacon is at x=10, y=16"
+  ; "Sensor at x=13, y=2: closest beacon is at x=15, y=3"
+  ; "Sensor at x=12, y=14: closest beacon is at x=10, y=16"
+  ; "Sensor at x=10, y=20: closest beacon is at x=10, y=16"
+  ; "Sensor at x=14, y=17: closest beacon is at x=10, y=16"
+  ; "Sensor at x=8, y=7: closest beacon is at x=2, y=10"
+  ; "Sensor at x=2, y=0: closest beacon is at x=2, y=10"
+  ; "Sensor at x=0, y=11: closest beacon is at x=2, y=10"
+  ; "Sensor at x=20, y=14: closest beacon is at x=25, y=17"
+  ; "Sensor at x=17, y=20: closest beacon is at x=21, y=22"
+  ; "Sensor at x=16, y=7: closest beacon is at x=15, y=3"
+  ; "Sensor at x=14, y=3: closest beacon is at x=15, y=3"
+  ; "Sensor at x=20, y=1: closest beacon is at x=15, y=3"
+  ]
+;;
+
+type sensor =
+  { pos : Vec2.t
+  ; beacon : Vec2.t
+  ; dist : int
+  }
+[@@deriving show { with_path = false }]
+
+let taxicab_dist a b =
+  let x, y = Vec2.(abs (a - b) |> to_tuple) in
+  x + y
+;;
+
+let parse_sensor line =
+  match List.map int_of_string Re.(matches (Pcre.regexp {|-?\d+|}) line) with
+  | [ sx; sy; bx; by ] ->
+    let pos, beacon = Vec2.(of_tuple (sx, sy), of_tuple (bx, by)) in
+    { pos; beacon; dist = taxicab_dist pos beacon }
+  | _ -> failwith "parse error"
+;;
+
+let could_be_beacon sensors ignore_known pos =
+  sensors
+  |> Iter.fold_while
+       (fun _ s ->
+         let d = taxicab_dist pos s.pos in
+         if d <= s.dist && (ignore_known || not Vec2.(pos = s.beacon))
+         then false, `Stop
+         else true, `Continue)
+       true
+;;
+
+(*{[
+    equation for line
+      y = m*x + c
+
+    beacon range boundaries are made up of four lines:
+      slope  1 passing thru bx + dist + 1, by
+      slope  1 passing thru bx - dist - 1, by
+      slope -1 passing thru bx + dist + 1, by
+      slope -1 passing thru bx - dist - 1, by
+
+    to find the constant given a slope, plug a point into
+      c = y - m*x
+
+    constants are stored separately for boundaries with positive and negative
+    slope so that they can be handled separately
+      p1 = y - bx - dist - 1
+      p2 = y - bx + dist + 1
+      n1 = y + bx + dist + 1
+      n2 = y + bx - dist - 1
+  ]}*)
+let get_consts sensors extra =
+  sensors
+  |> Iter.fold
+       (fun (p_slope_consts, n_slope_consts) { pos; beacon = _; dist } ->
+         let p1 = pos.y - pos.x + dist + extra in
+         let p2 = pos.y - pos.x - dist - extra in
+         let n1 = pos.y + pos.x + dist + extra in
+         let n2 = pos.y + pos.x - dist - extra in
+         Iter.(
+           ( append p_slope_consts (of_list [ p1; p2 ])
+           , append n_slope_consts (of_list [ n1; n2 ]) )))
+       (Iter.empty, Iter.empty)
+;;
+
+let solve_part_1 lines scan_y =
+  let sensors = lines |> Iter.of_list |> Iter.map parse_sensor in
+  let p_slope_consts, n_slope_consts = get_consts sensors 0 in
+  (*{[
+      for a known y to intersect with a positive slope boundary:
+        y = x + p
+        x = y - p
+
+      and for a negative slope boundary:
+        y = -x + n
+        x = n - y
+    ]}*)
+  let intersection_xs =
+    Iter.append
+      (Iter.map (fun p -> scan_y - p) p_slope_consts)
+      (Iter.map (fun n -> n - scan_y) n_slope_consts)
+    |> Iter.sort_uniq ~cmp:Int.compare
+  in
+  let check x = could_be_beacon sensors false @@ Vec2.of_tuple (x, scan_y) in
+  let rec count_not_beacons count xs =
+    match xs with
+    | x :: next :: rest ->
+      (* if there is a region [x+1, next), the value of check
+         is the same for each point within it. intersection points
+         must be checked separately from the regions between them  *)
+      let intersection = if check x then 0 else 1 in
+      let region = if x + 1 < next && check (x + 1) then 0 else next - (x + 1) in
+      count_not_beacons (count + intersection + region) (next :: rest)
+    | _ -> count
+  in
+  count_not_beacons 0 @@ Iter.to_list intersection_xs
+;;
+
+let%expect_test "Day 15.1 example" =
+  Printf.printf "%i\n" @@ solve_part_1 example_lines 10;
+  [%expect {| 26 |}]
+;;
+
+let%expect_test "Day 15.1" =
+  Printf.printf "%i\n" @@ solve_part_1 (Utils.lines_of_input 15) 2000000;
+  [%expect {| 5525990 |}]
+;;
+
+let solve_part_2 lines range mult =
+  let sensors = lines |> Iter.of_list |> Iter.map parse_sensor in
+  let in_bounds = Vec2.(in_bounds origin @@ of_tuple (range, range)) in
+  let p_slope_consts, n_slope_consts = get_consts sensors 1 in
+  (*{[
+      boundaries only itersect if they have opposite slope.
+      to find the intersection, set equations to be equal and solve.
+         y =  x + p
+         y = -x + n        // set equal
+         x + p = -x + n    // add x and subtract p
+         2x = n - p        // divide 2
+      -> x = (n - p)/2     // substitute x into original
+         y = (n - p)/2 + p // multiply 2
+         2y = n + p        // div 2
+      -> y = (n + p)/2
+    ]}*)
+  let point =
+    Iter.product p_slope_consts n_slope_consts
+    |> Iter.fold_while
+         (fun _ (p, n) ->
+           let i = Vec2.of_tuple ((n - p) / 2, (n + p) / 2) in
+           if in_bounds i && could_be_beacon sensors true i
+           then Some i, `Stop
+           else None, `Continue)
+         None
+    |> Option.get_exn_or "no distress beacon found :("
+  in
+  (mult * point.x) + point.y
+;;
+
+let%expect_test "Day 15.2 example" =
+  Printf.printf "%i\n" @@ solve_part_2 example_lines 20 4000000;
+  [%expect {| 56000011 |}]
+;;
+
+let%expect_test "Day 15.2" =
+  Printf.printf "%i\n" @@ solve_part_2 (Utils.lines_of_input 15) 4000000 4000000;
+  [%expect {| 11756174628223 |}]
+;;

src/day16.ml

@@ -0,0 +1,141 @@
+open Containers
+
+let example_lines =
+  String.lines
+    {|Valve AA has flow rate=0; tunnels lead to valves DD, II, BB
+Valve BB has flow rate=13; tunnels lead to valves CC, AA
+Valve CC has flow rate=2; tunnels lead to valves DD, BB
+Valve DD has flow rate=20; tunnels lead to valves CC, AA, EE
+Valve EE has flow rate=3; tunnels lead to valves FF, DD
+Valve FF has flow rate=0; tunnels lead to valves EE, GG
+Valve GG has flow rate=0; tunnels lead to valves FF, HH
+Valve HH has flow rate=22; tunnel leads to valve GG
+Valve II has flow rate=0; tunnels lead to valves AA, JJ
+Valve JJ has flow rate=21; tunnel leads to valve II
+|}
+;;
+
+type valve =
+  { flow : int
+  ; mask : int
+  }
+
+let parse_valves lines =
+  let rooms = Hashtbl.create 100 in
+  lines
+  |> List.iter (fun line ->
+    let int_matches = List.map int_of_string Re.(matches (Pcre.regexp {|\d+|}) line) in
+    let valve_matches = Re.(matches (Pcre.regexp {|[A-Z]{2}|}) line) in
+    match int_matches, valve_matches with
+    | [ flow ], name :: tunnels -> Hashtbl.add rooms name (flow, tunnels)
+    | _ -> failwith "parse error");
+  let valves =
+    Hashtbl.to_list rooms
+    |> List.filter (fun (_, (flow, _)) -> flow > 0)
+    |> List.mapi (fun i (name, (flow, _)) ->
+      let mask = Int.(1 lsl i) in
+      name, { flow; mask })
+  in
+  let distances = Hashtbl.create 100 in
+  valves
+  |> List.map (fun (valve, _) -> valve)
+  |> List.cons "AA"
+  |> List.iter (fun from ->
+    let dist_of =
+      Fun.(
+        Utils.djikstra_hash
+          ~get_weight:(fun _ _ -> 1)
+          ~get_neighbors:(fun room ->
+            match Hashtbl.get rooms room with
+            | Some (_, tunnels) -> Iter.of_list tunnels
+            | None -> failwith "sad")
+          ~start_nodes:[ from ]
+          ()
+        %> Option.get_exn_or "big sad")
+    in
+    valves
+    |> List.remove_assoc ~eq:String.equal from
+    |> List.iter (fun (valve, _) ->
+      Hashtbl.replace distances (from, valve) (dist_of valve)));
+  let get_dist f t =
+    match Hashtbl.get distances (f, t) with
+    | Some dist -> dist
+    | None -> failwith @@ Printf.sprintf "cant find distance %s -> %s" f t
+  in
+  valves, get_dist
+;;
+
+let traverse
+  get_dist
+  (valves : (string * valve) list)
+  ?(current = "AA")
+  ?(released = 0)
+  ?(opened = 0)
+  time
+  =
+  let states = Hashtbl.create 1000 in
+  let rec traverse' current time released opened =
+    Hashtbl.update
+      states
+      ~f:(fun _ current ->
+        match current with
+        | Some r when r >= released -> Some r
+        | _ -> Some released)
+      ~k:opened;
+    valves
+    |> List.iter (fun (name, { flow; mask }) ->
+      if Int.(mask land opened) = 0
+      then (
+        let dist = get_dist current name in
+        let time' = time - (dist + 1) in
+        if time' > 0
+        then (
+          let released' = released + (flow * time') in
+          let opened' = Int.(mask lor opened) in
+          traverse' name time' released' opened')))
+  in
+  traverse' current time released opened;
+  states
+  |> Iter.of_hashtbl
+  |> Iter.sort ~cmp:(fun (_, a_score) (_, b_score) -> b_score - a_score)
+;;
+
+let solve_part_1 lines =
+  let valves, get_dist = parse_valves lines in
+  let states = traverse get_dist valves 30 in
+  match states |> Iter.take 1 |> Iter.to_list with
+  | [ (_, score) ] -> score
+  | _ -> failwith "no traversals ?"
+;;
+
+let%expect_test "Day 16.1 example" =
+  Printf.printf "%i\n" @@ solve_part_1 example_lines;
+  [%expect {| 1651 |}]
+;;
+
+let%expect_test "Day 16.1" =
+  Printf.printf "%i\n" @@ solve_part_1 @@ Utils.lines_of_input 16;
+  [%expect {| 2265 |}]
+;;
+
+let solve_part_2 lines =
+  let valves, get_dist = parse_valves @@ lines in
+  let states = traverse get_dist valves 26 in
+  states
+  |> Iter.filter_map (fun (a_set, a_score) ->
+    match Iter.find_pred (fun (b_set, _) -> Int.(a_set land b_set) = 0) states with
+    | Some (_, b_score) -> Some (a_score + b_score)
+    | None -> None)
+  |> Iter.fold Int.max 0
+;;
+
+let%expect_test "Day 16.2 example" =
+  Printf.printf "%i\n" @@ solve_part_2 example_lines;
+  [%expect {| 1707 |}]
+;;
+
+(* god damn bitmasks are fast, 30x speedup from StrSet! down to 50ms now *)
+let%expect_test "Day 16.2" =
+  Printf.printf "%i\n" @@ solve_part_2 @@ Utils.lines_of_input 16;
+  [%expect {| 2811 |}]
+;;

src/day17.ml

@@ -0,0 +1,201 @@
+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
+
+(*[{
+                       #
+         #       #     #
+        ###      #     #     ##
+ ####    #     ###     #     ##
+
+ row    plus   angle   col   square
+
+}]*)
+type shape =
+  | Row
+  | Plus
+  | Angle
+  | Col
+  | Square
+
+let get_shape idx = [| Row; Plus; Angle; Col; Square |].(idx mod 5)
+
+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 loop_key =
+  { rock : shape
+  ; stream_idx : int
+  ; normalized_topo : int array
+  }
+
+type loop =
+  { rock_idx : int
+  ; height : int
+  }
+
+type cave =
+  { grid : char Grid.t
+  ; mutable grid_topo : int array
+  ; mutable grid_height : int
+  ; total_rocks : int
+  ; mutable rocks : int
+  ; mutable stream_idx : int
+  ; loop_cache : (loop_key, loop) Hashtbl.t
+  ; mutable height : int
+  }
+
+let init_cave max_height total_rocks =
+  let grid = Grid.init ~width:7 ~height:max_height (Fun.const '.') in
+  { grid
+  ; height = -1
+  ; grid_height = -1
+  ; rocks = 0
+  ; stream_idx = 0
+  ; grid_topo = Array.init cave_width (Fun.const 0)
+  ; loop_cache = Hashtbl.create max_height
+  ; total_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.rocks 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.rocks <- cave.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 loop_key =
+    { rock = get_shape cave.rocks
+    ; stream_idx = cave.stream_idx
+    ; normalized_topo = normalize_topo cave.grid_topo
+    }
+  in
+  let remaining_rocks cave = cave.total_rocks - cave.rocks in
+  let loop_rocks loop = cave.rocks - loop.rock_idx in
+  let loop_fits loop = loop_rocks loop < remaining_rocks cave in
+  match Hashtbl.get cave.loop_cache loop_key with
+  | Some loop when loop_fits loop ->
+    let loop_height = cave.height - loop.height in
+    cave.height <- cave.height + loop_height;
+    cave.rocks <- cave.rocks + loop_rocks loop;
+    drop_shapes cave stream
+  | _ when remaining_rocks cave > 0 ->
+    let loop = { height = cave.height; rock_idx = cave.rocks } in
+    Hashtbl.add cave.loop_cache loop_key loop;
+    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 |}]
+;;
+
+let%expect_test "Smol tower" =
+  let stream =
+    example_lines |> List.hd |> Iter.of_str |> Iter.map dir_of_char |> Iter.to_array
+  in
+  let cave = init_cave 18 8 in
+  drop_shapes cave stream;
+  Printf.printf "%s" @@ draw_cave cave;
+  [%expect
+    {|
+    .......
+    .......
+    .......
+    .....#.
+    .....#.
+    ..####.
+    .###...
+    ..#....
+    .####..
+    ....##.
+    ....##.
+    ....#..
+    ..#.#..
+    ..#.#..
+    #####..
+    ..###..
+    ...#...
+    ..####. |}]
+;;

src/day18.ml

@@ -0,0 +1,121 @@
+open Containers
+
+let example_lines =
+  String.lines
+    {|2,2,2
+1,2,2
+3,2,2
+2,1,2
+2,3,2
+2,2,1
+2,2,3
+2,2,4
+2,2,6
+1,2,5
+3,2,5
+2,1,5
+2,3,5|}
+;;
+
+module Vec3 = struct
+  type t = int * int * int [@@deriving show, eq, ord, hash]
+
+  let directions = [ 1, 0, 0; -1, 0, 0; 0, 1, 0; 0, -1, 0; 0, 0, 1; 0, 0, -1 ]
+  let ( + ) (x1, y1, z1) (x2, y2, z2) = x1 + x2, y1 + y2, z1 + z2
+  let ( - ) (x1, y1, z1) (x2, y2, z2) = x1 - x2, y1 - y2, z1 - z2
+  let ( = ) = equal
+
+  let iter_region (ax, ay, az) (bx, by, bz) callback =
+    for z = az to bz do
+      for y = ay to by do
+        for x = ax to bx do
+          let p = x, y, z in
+          callback p
+        done
+      done
+    done
+  ;;
+
+  let in_bounds (lx, ly, lz) (hx, hy, hz) (x, y, z) =
+    not (x < lx || x > hx || y < ly || y > hy || z < lz || z > hz)
+  ;;
+
+  let find_bounds points =
+    let first = Iter.head_exn points in
+    let padding = 1, 1, 1 in
+    let min, max =
+      points
+      |> Iter.drop 1
+      |> Iter.fold
+           (fun ((lx, ly, lz), (hx, hy, hz)) (x, y, z) ->
+             (min lx x, min ly y, min lz z), (max hx x, max hy y, max hz z))
+           (first, first)
+    in
+    min - padding, max + padding
+  ;;
+end
+
+module Vec3Set = Set.Make (Vec3)
+
+let parse_points lines =
+  lines
+  |> List.map (fun line ->
+    match List.map Int.of_string_exn Re.(matches (Pcre.regexp {|\d+|}) line) with
+    | [ x; y; z ] -> x, y, z
+    | _ -> failwith "oopzi doopers")
+  |> Vec3Set.of_list
+;;
+
+let solve_part_1 lines =
+  let points = parse_points lines in
+  let min, max = Vec3.find_bounds @@ Vec3Set.to_iter points in
+  let surface_area = ref 0 in
+  Vec3.iter_region min max (fun point ->
+    if not @@ Vec3Set.mem point points
+    then
+      Vec3.directions
+      |> List.iter (fun dir ->
+        let n = Vec3.(point + dir) in
+        if Vec3Set.mem n points then incr surface_area));
+  !surface_area
+;;
+
+let%expect_test "Day 18.1 example" =
+  Format.printf "%i" @@ solve_part_1 example_lines;
+  [%expect {| 64 |}]
+;;
+
+let%expect_test "Day 18.1" =
+  Format.printf "%i" @@ solve_part_1 @@ Utils.lines_of_input 18;
+  [%expect {| 3662 |}]
+;;
+
+let solve_part_2 lines =
+  let points = parse_points lines in
+  let min, max = Vec3.find_bounds @@ Vec3Set.to_iter points in
+  let in_bounds = Vec3.in_bounds min max in
+  let surface_area = ref 0 in
+  let directions_iter = Iter.of_list Vec3.directions in
+  let get_neighbors point =
+    directions_iter
+    |> Iter.map Vec3.(fun dir -> point + dir)
+    |> Iter.filter (fun neighbor ->
+      let in_droplet = Vec3Set.mem neighbor points in
+      if in_droplet then incr surface_area;
+      (not in_droplet) && in_bounds neighbor)
+  in
+  let _ignore =
+    Utils.djikstra_hash ~get_weight:(fun _ _ -> 1) ~get_neighbors ~start_nodes:[ min ] ()
+  in
+  !surface_area
+;;
+
+let%expect_test "Day 18.2 example" =
+  Format.printf "%i" @@ solve_part_2 example_lines;
+  [%expect {| 58 |}]
+;;
+
+let%expect_test "Day 18.2" =
+  Format.printf "%i" @@ solve_part_2 @@ Utils.lines_of_input 18;
+  [%expect {| 2060 |}]
+;;

src/dune

@@ -1,10 +1,13 @@
 (library
  (name aoc)
- (libraries re containers dune-site angstrom)
+ (libraries re containers iter dune-site angstrom)
  (inline_tests)
  (preprocess (pps
                ppx_regexp
                ppx_deriving.show
+               ppx_deriving.eq
+               ppx_deriving.ord
+               ppx_deriving_hash
                ppx_expect
                ppx_inline_test)))
 

src/grid.ml

@@ -27,13 +27,15 @@ let at grid point =
 ;;
 
 let at_e (grid : 'a t) (point : Vec2.t) =
-  Option.get_exn_or "point out of bounds!" @@ at grid point
+  match at grid point with
+  | Some point -> point
+  | None -> failwith @@ Format.sprintf "point %a out of bounds!" Vec2.pp 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
@@ -45,6 +47,10 @@ let find (grid : 'a t) pred =
   Some (vec2_of_idx ~width:grid.width ~idx, item)
 ;;
 
+let count grid pred =
+  Array.fold (fun count item -> if pred item then count + 1 else count) 0 grid.items
+;;
+
 let init ~width ~height init =
   { width
   ; height
@@ -69,13 +75,7 @@ let of_lines parse_char lines : 'a t =
 ;;
 
 let iter_region grid a b callback =
-  let open Vec2 in
+  Vec2.iter_region a b (fun pos -> if in_bounds grid pos then callback pos)
-  for y = min a.y b.y to max a.y b.y do
-    for x = min a.x b.x to max a.x b.x do
-      let pos = { x; y } in
-      if in_bounds grid pos then callback pos
-    done
-  done
 ;;
 
 let iter grid callback =
@@ -84,12 +84,16 @@ let iter grid callback =
   iter_region grid a b callback
 ;;
 
-let draw grid printer =
+let draw grid ?(rev_y = false) ?(rev_x = false) printer =
-  let str = ref [] in
+  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
+    let char = printer point (Option.get_exn_or "iter is broken" item) in
-    str := !str @ [ char ];
+    line := if rev_x then char :: !line else !line @ [ char ];
-    if point.x = grid.width - 1 then str := !str @ [ '\n' ]);
+    if List.length !line = grid.width
-  String.of_list !str
+    then (
+      lines := !lines @ [ String.of_list !line ];
+      line := []));
+  String.concat "\n" (if rev_y then List.rev !lines else !lines)
 ;;

src/grid.mli

@@ -8,6 +8,7 @@ val ( .%()<- ) : 'a t -> Vec2.t -> 'a -> unit
 val init : width:int -> height:int -> (Vec2.t -> 'a) -> 'a t
 val of_lines : (char -> 'a) -> string list -> 'a t
 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

src/utils.ml

@@ -10,14 +10,123 @@ let lines_of_input day =
   IO.(with_in path read_lines_l)
 ;;
 
+(** [f] in [memo f] should be a function that makes recursive calls
+    via the memoized function passed as its first argument. ie:
+    {[
+      let fib_m =
+        memo (fun self x ->
+          match x with
+          | 0 | 1 -> 1
+          | x -> self (x - 1) + self (x - 2))
+      ;;
+    ]} *)
+let memo f =
+  let open Hashtbl in
+  let cache = create 100000 in
+  let rec f_mem k =
+    try find cache k with
+    | Not_found ->
+      let v = f f_mem k in
+      add cache k v;
+      v
+  in
+  f_mem
+;;
+
+let%expect_test "fib memoized" =
+  let fib_m =
+    memo (fun fib_m x ->
+      match x with
+      | 0 | 1 -> 1
+      | x -> fib_m (x - 1) + fib_m (x - 2))
+  in
+  Printf.printf "%i\n" @@ fib_m 100;
+  [%expect {| 1298777728820984005 |}]
+;;
+
+let djikstra ~eq ~get_info ~set_info ~get_weight ~get_neighbors ~goal ~start_nodes =
+  let seen = ref [] in
+  let rec djikstra' c_node =
+    let c_dist, _ = get_info c_node in
+    set_info c_node (c_dist, true);
+    get_neighbors c_node
+    |> Iter.iter (fun neighbor ->
+      let n_dist, n_visited = get_info neighbor in
+      if not n_visited
+      then (
+        let new_dist = c_dist + get_weight c_node neighbor in
+        if new_dist < n_dist then set_info neighbor (new_dist, n_visited);
+        seen := List.add_nodup ~eq neighbor !seen));
+    seen
+    := List.fast_sort
+         (fun a b ->
+           let a_dist, _ = get_info a in
+           let b_dist, _ = get_info b in
+           Int.compare a_dist b_dist)
+         !seen;
+    match goal, !seen with
+    | Some goal_node, next :: _ when eq goal_node next ->
+      let dist, _ = get_info next in
+      Some dist
+    | None, [] -> Some 0
+    | _, next :: rest ->
+      seen := rest;
+      djikstra' next
+    | Some _, [] -> None
+  in
+  List.iter (fun node -> set_info node (0, false)) start_nodes;
+  match start_nodes with
+  | first :: rest ->
+    seen := rest;
+    djikstra' first
+  | _ -> failwith "start_nodes cannot be empty"
+;;
+
+let djikstra_hash
+  (type k)
+  ?(hash = Hashtbl.hash)
+  ?(eq = Stdlib.( = ))
+  ?(slots = 100)
+  ~get_weight
+  ~get_neighbors
+  ~start_nodes
+  ()
+  =
+  let module Tbl =
+    CCHashtbl.Make (struct
+      type t = k
+
+      let equal = eq
+      let hash = hash
+    end)
+  in
+  let table = Tbl.create slots in
+  let get_info node = Tbl.get_or ~default:(Int.max_int, false) table node in
+  let set_info node info = Tbl.replace table node info in
+  let dist_of node = Option.(Tbl.get table node >|= fun (dist, _) -> dist) in
+  let _ =
+    djikstra ~eq ~get_info ~set_info ~get_weight ~get_neighbors ~goal:None ~start_nodes
+  in
+  dist_of
+;;
+
 module Parse = struct
   include Angstrom
 
-  let int =
+  let sign = option 1 (char '-' >>= fun _ -> return (-1))
+
+  let digits =
     take_while1 (function
       | '0' .. '9' -> true
       | _ -> false)
     >>| int_of_string
-    <?> "int"
+  ;;
+
+  let int = map2 sign digits ~f:( * )
+
+  let not_int =
+    skip_while (function
+      | '0' .. '9' | '-' -> false
+      | _ -> true)
   ;;
 end

src/vec2.ml

@@ -4,8 +4,10 @@ type t =
   { x : int
   ; y : int
   }
-[@@deriving show]
+[@@deriving eq, ord, hash]
 
+let pp (fmt : Format.formatter) v = Format.fprintf fmt "(%i, %i)" v.x v.y
+let show v = Format.asprintf "%a" pp v
 let origin = { x = 0; y = 0 }
 let up = { x = 0; y = -1 }
 let down = { x = 0; y = 1 }
@@ -16,4 +18,40 @@ let of_tuple (x, y) = { x; y }
 let to_tuple { x; y } = x, y
 let ( + ) a b = { x = a.x + b.x; y = a.y + b.y }
 let ( - ) a b = { x = a.x - b.x; y = a.y - b.y }
-let ( = ) a b = a.x = b.x && a.y = b.y
+let ( = ) = equal
+let abs a = Int.{ x = abs a.x; y = abs a.y }
+
+let iter_region a b callback =
+  for y = min a.y b.y to max a.y b.y do
+    for x = min a.x b.x to max a.x b.x do
+      callback { x; y }
+    done
+  done
+;;
+
+let fold_region a b callback init =
+  let acc = ref init in
+  iter_region a b (fun pos -> acc := callback !acc pos);
+  !acc
+;;
+
+let find_bounds padding points =
+  let lx, hx, ly, hy =
+    points
+    |> Iter.fold
+         (fun (lx, hx, ly, hy) { x; y } ->
+           let lx = min lx x in
+           let hx = max hx x in
+           let ly = min ly y in
+           let hy = max hy y in
+           lx, hx, ly, hy)
+         (Int.max_int, 0, Int.max_int, 0)
+  in
+  let lx = Int.(lx - padding) in
+  let hx = Int.(hx + padding) in
+  let ly = Int.(ly - padding) in
+  let hy = Int.(hy + padding) in
+  of_tuple (lx, ly), of_tuple (hx, hy)
+;;
+
+let in_bounds l h p = p.x >= l.x && p.x <= h.x && p.y >= l.y && p.y <= h.y

src/vec2.mli

@@ -2,8 +2,10 @@ type t =
   { x : int
   ; y : int
   }
-[@@deriving show]
+[@@deriving eq, ord, hash]
 
+val show : t -> string
+val pp : Format.formatter -> t -> unit
 val origin : t
 val up : t
 val down : t
@@ -15,3 +17,8 @@ val to_tuple : t -> int * int
 val ( + ) : t -> t -> t
 val ( - ) : t -> t -> t
 val ( = ) : t -> t -> bool
+val abs : t -> t
+val iter_region : t -> t -> (t -> unit) -> unit
+val fold_region : t -> t -> ('a -> t -> 'a) -> 'a -> 'a
+val find_bounds : int -> t Iter.t -> t * t
+val in_bounds : t -> t -> t -> bool