speed up day 15.1 with intersections

also update the vec module to use Iter in some places

aoc.opam

@@ -10,11 +10,11 @@ homepage: "https://github.com/username/reponame"
 doc: "https://url/to/documentation"
 bug-reports: "https://github.com/username/reponame/issues"
 depends: [
-  "ocaml"
-  "dune" {>= "3.10"}
   "utop"
   "ocaml-lsp-server"
   "ocamlformat"
+  "ocaml"
+  "dune" {>= "3.10"}
   "re"
   "containers"
   "iter"

src/day14.ml

@@ -43,9 +43,9 @@ 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 Vec2.{ x = lx; y = ly }, Vec2.{ x = hx; y = hy } =
-    points |> List.flatten |> List.append [ start ] |> Vec2.bounds 0
+    points |> Iter.flatten |> Iter.cons start |> Vec2.find_bounds 0
   in
   let pad_floor = 1 in
   let pad_x = 2 in
@@ -58,8 +58,9 @@ let parse_grid lines start =
   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
 ;;
 
@@ -118,7 +119,9 @@ let rec drop_all_sand drop grid start =
 ;;
 
 let%expect_test "Day 14.1 example" =
-  let lines = [ "498,4 -> 498,6 -> 496,6"; "503,4 -> 502,4 -> 502,9 -> 494,9" ] 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 (drop_sand_abyss false) grid start;
@@ -142,7 +145,9 @@ let%expect_test "Day 14.1 example" =
 ;;
 
 let%expect_test "Day 14.2 example" =
-  let lines = [ "498,4 -> 498,6 -> 496,6"; "503,4 -> 502,4 -> 502,9 -> 494,9" ] 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 drop_sand_floor grid start;
@@ -165,7 +170,7 @@ let%expect_test "Day 14.2 example" =
 ;;
 
 let%expect_test "Day 14.1" =
-  let lines = Utils.lines_of_input 14 in
+  let lines = Iter.of_list @@ Utils.lines_of_input 14 in
   let start = Vec2.of_tuple (500, 0) in
   let grid, start = parse_grid lines start in
   drop_all_sand (drop_sand_abyss false) grid start;
@@ -175,7 +180,7 @@ let%expect_test "Day 14.1" =
 ;;
 
 let%expect_test "Day 14.2" =
-  let lines = Utils.lines_of_input 14 in
+  let lines = Iter.of_list @@ Utils.lines_of_input 14 in
   let start = Vec2.of_tuple (500, 0) in
   let grid, start = parse_grid lines start in
   drop_all_sand drop_sand_floor grid start;

src/day15.ml

@@ -13,48 +13,16 @@ let taxicab_dist a b =
 ;;
 
 let parse_sensor line =
-  let open Utils.Parse in
+  match List.map int_of_string Re.(matches (Pcre.regexp {|-?\d+|}) line) with
-  let parse =
+  | [ sx; sy; bx; by ] ->
-    many1 (not_int *> int)
+    let pos, beacon = Vec2.(of_tuple (sx, sy), of_tuple (bx, by)) in
-    >>= function
+    { pos; beacon; dist = taxicab_dist pos beacon }
-    | [ sx; sy; bx; by ] ->
+  | _ -> failwith "parse error"
-      let pos = Vec2.of_tuple (sx, sy) in
-      let beacon = Vec2.of_tuple (bx, by) in
-      return { pos; beacon; dist = taxicab_dist pos beacon }
-    | _ -> failwith "should be four ints"
-  in
-  Result.get_or_failwith @@ parse_string ~consume:All parse line
-;;
-
-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"
-  ]
-;;
-
-let bounds sensors =
-  let max_dist = sensors |> List.fold_left (fun acc s -> max acc s.dist) 0 in
-  sensors
-  |> List.flat_map (fun sensor -> [ sensor.pos; sensor.beacon ])
-  |> Vec2.bounds max_dist
 ;;
 
 let could_be_beacon sensors ignore_known pos =
-  let open Iter in
+  sensors
-  of_list sensors
+  |> Iter.fold_while
-  |> fold_while
        (fun _ s ->
          let d = taxicab_dist pos s.pos in
          if d <= s.dist && (ignore_known || not Vec2.(pos = s.beacon))
@@ -63,95 +31,108 @@ let could_be_beacon sensors ignore_known pos =
        true
 ;;
 
-(* let%expect_test "Day 15.1" = *)
+(*{[
-(*   let sensors = Utils.lines_of_input 15 |> List.map parse_sensor in *)
+    equation for line
-(*   let scan_row = 2000000 in *)
+      y = m*x + c
-(*   let Vec2.{ x = lx; _ }, Vec2.{ x = hx; _ } = bounds sensors in *)
-(*   Vec2.fold_region *)
-(*     Vec2.{ x = lx; y = scan_row } *)
-(*     Vec2.{ x = hx; y = scan_row } *)
-(*     (fun acc pos -> if could_be_beacon sensors false pos then acc else acc + 1) *)
-(*     0 *)
-(*   |> Printf.printf "%i\n"; *)
-(*   [%expect {| 5525990 |}] *)
-(* ;; *)
 
-(* module VecTbl = Hashtbl.Make (Vec2) *)
+    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
 
-(* let points_on_border tbl sensor = *)
+    to find constant given slope, plug point into
-(*   let points = ref [] in *)
+      c = y - m*x
-(*   let dist = sensor.dist + 1 in *)
-(*   for d1 = 0 to dist do *)
-(*     let d2 = dist - d1 in *)
-(*     let open Vec2 in *)
-(*     let p1 = of_tuple (d1, d2) in *)
-(*     let p2 = of_tuple (d1, Int.(-d2)) in *)
-(*     let new_points = *)
-(*       [ sensor.pos + p1; sensor.pos - p1; sensor.pos + p2; sensor.pos - p2 ] *)
-(*       |> List.fold_left *)
-(*            (fun acc point -> *)
-(*              match VecTbl.find_opt tbl point with *)
-(*              | Some false -> acc *)
-(*              | Some true -> *)
-(*                VecTbl.replace tbl point false; *)
-(*                point :: acc *)
-(*              | None -> *)
-(*                VecTbl.add tbl point true; *)
-(*                acc) *)
-(*            [] *)
-(*     in *)
-(*     points := !points @ new_points *)
-(*   done; *)
-(*   !points *)
-(* ;; *)
 
-(* let%expect_test "Day 15.2 brute force" = *)
+    constants are store separately for pos and neg slope boundaries
-(*   let sensors = Utils.lines_of_input 15 |> List.map parse_sensor in *)
+    so that they can be handled separately
-(*   let mult = 4000000 in *)
+      p1 = y - bx - dist - 1
-(*   let range = mult in *)
+      p2 = y - bx + dist + 1
-(*   let in_bounds = Vec2.(in_bounds origin @@ of_tuple (range, range)) in *)
+      n1 = y + bx + dist + 1
-(*   let tbl = VecTbl.create (range * 10) in *)
+      n2 = y + bx - dist - 1
-(*   let point = *)
+  ]}*)
-(*     sensors *)
+let get_coeffs sensors =
-(*     |> Iter.of_list *)
+  sensors
-(*     |> Iter.flat_map_l @@ points_on_border tbl *)
+  |> Iter.fold
-(*     |> Iter.fold_while *)
+       (fun (pos_coeffs, neg_coeffs) { pos; beacon = _; dist } ->
-(*          (fun _ v -> *)
+         let p1 = pos.y - pos.x + dist + 1 in
-(*            if in_bounds v && could_be_beacon sensors true v *)
+         let p2 = pos.y - pos.x - dist - 1 in
-(*            then Some v, `Stop *)
+         let n1 = pos.y + pos.x + dist + 1 in
-(*            else None, `Continue) *)
+         let n2 = pos.y + pos.x - dist - 1 in
-(*          None *)
+         Iter.(
-(*     |> Option.get_exn_or "fucc :(" *)
+           append pos_coeffs (of_list [ p1; p2 ]), append neg_coeffs (of_list [ n1; n2 ])))
-(*   in *)
+       (Iter.empty, Iter.empty)
-(*   Printf.printf "%i\n" ((mult * point.x) + point.y); *)
+;;
-(*   [%expect {| 11756174628223 |}] *)
-(* ;; *)
 
-module IntSet = Set.Make (Int)
+let%expect_test "Day 15.1" =
+  let sensors = Utils.lines_of_input 15 |> Iter.of_list |> Iter.map parse_sensor in
+  let scan_y = 2000000 in
+  let pos_coeffs, neg_coeffs = get_coeffs sensors in
+  (*{[
+      for a line y = c to intersect with a positive slope boundary:
+        y = c
+        y = x + n
+        c = x + p
+        x = c - p
+
+      and for a negative slop boundary
+        y = c
+        y = -x + n
+        c = -x + n
+        x = n - c
+    ]}*)
+  let intersection_xs =
+    Iter.append
+      (Iter.map (fun p -> scan_y - p) pos_coeffs)
+      (Iter.map (fun n -> n - scan_y) neg_coeffs)
+    |> Iter.sort_uniq ~cmp:Int.compare
+  in
+  (* iterate thru the intersections by ascending x.
+     if a point in the region can be a beacon,
+     then every point in the region is. *)
+  let rec count_not_beacons count xs =
+    match xs with
+    | lx :: hx :: rest ->
+      let count =
+        if could_be_beacon sensors false @@ Vec2.of_tuple (lx + 1, scan_y)
+        then count
+        else count + hx - lx
+      in
+      count_not_beacons count @@ (hx :: rest)
+    | _ -> count
+  in
+  let possible_beacons = count_not_beacons 0 @@ Iter.to_list intersection_xs in
+  Printf.printf "%i\n" @@ possible_beacons;
+  [%expect {| 5525990 |}]
+;;
 
 let%expect_test "Day 15.2" =
-  let sensors = Utils.lines_of_input 15 |> List.map parse_sensor in
+  let sensors = Utils.lines_of_input 15 |> Iter.of_list |> Iter.map parse_sensor in
   let mult = 4000000 in
   let range = mult in
   let in_bounds = Vec2.(in_bounds origin @@ of_tuple (range, range)) in
-  let pos_coeffs, neg_coeffs =
+  let pos_coeffs, neg_coeffs = get_coeffs sensors in
-    sensors
+  (*{[
-    |> Iter.of_list
+      boundaries only itersect if they have opposite slope.
-    |> Iter.fold
+      to find the intersection, set equations to be equal and solve.
-         (fun (pos_coeffs, neg_coeffs) { pos; beacon = _; dist } ->
+         y =  1*x + p
-           let p1 = pos.y - pos.x + dist + 1 in
+         y = -1*x + n      // set equal
-           let p2 = pos.y - pos.x - dist - 1 in
+         x + p = -x + n    // add x
-           let n1 = pos.y + pos.x + dist + 1 in
+         2x + p = n        // subtract p
-           let n2 = pos.y + pos.x - dist - 1 in
+         2x = n - p        // divide 2
-           Iter.(
+         x = (n - p)/2     // substitute x into original
-             ( append pos_coeffs (of_list [ p1; p2 ])
+
-             , append neg_coeffs (of_list [ n1; n2 ]) )))
+         y = (n - p)/2 + p // multiply 2
-         (Iter.empty, Iter.empty)
+         2y = n + p        // div 2
-  in
+         y = (n + p)/2
+
+      intersection point is at
+        x = (n - p)/2
+        y = (n + p)/2
+    ]}*)
   let point =
-    let open Iter in
+    Iter.product pos_coeffs neg_coeffs
-    product pos_coeffs neg_coeffs
+    |> Iter.fold_while
-    |> 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

src/utils.ml

@@ -10,6 +10,40 @@ 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 1000 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 |}]
+;;
+
 module Parse = struct
   include Angstrom
 

src/vec2.ml

@@ -35,10 +35,10 @@ let fold_region a b callback init =
   !acc
 ;;
 
-let bounds padding points =
+let find_bounds padding points =
   let lx, hx, ly, hy =
     points
-    |> List.fold_left
+    |> Iter.fold
          (fun (lx, hx, ly, hy) { x; y } ->
            let lx = min lx x in
            let hx = max hx x in

src/vec2.mli

@@ -20,5 +20,5 @@ 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 bounds : int -> t list -> t * t
+val find_bounds : int -> t Iter.t -> t * t
 val in_bounds : t -> t -> t -> bool