diff --git a/bin/day2418.ml b/bin/day2418.ml
index 4997046..3e8b355 100644
--- a/bin/day2418.ml
+++ b/bin/day2418.ml
@@ -110,12 +110,31 @@ let part1 count rocks =
     [grid] which makes it impossible to get from the top-left to bottom-right.
 *)
 let part2 start_count grid =
-  let rec impl count =
-    match find_route_length count grid with
-    | None -> count
-    | Some _ -> impl (count + 1)
+  (* Implementation notes:
+  
+     We do this by binary search in impl.  The left_count is a known count of
+     rocks that is passable, right_count is a known count that is impassable.
+
+     Once left_count + 1 = right_count we know that right_count is the first
+     rock to fall that causes the route to be blocked.
+
+     count_rocks is used to find the number of rocks (and so give an initial
+     right_count).
+  *)
+  let rec count_rocks acc idx =
+    if idx >= Array.length grid.grid then acc
+    else if grid.grid.(idx) = max_int then count_rocks acc (idx + 1)
+    else count_rocks (max acc grid.grid.(idx)) (idx + 1)
   in
-  let count = impl start_count in
+  let rec impl left_count right_count =
+    if right_count - left_count = 1 then right_count
+    else
+      let count = (left_count + right_count) / 2 in
+      match find_route_length count grid with
+      | None -> impl left_count count
+      | Some _ -> impl count right_count
+  in
+  let count = impl start_count (1 + count_rocks 0 0) in
   match Array.find_index (( = ) (count - 1)) grid.grid with
   | None -> failwith "part2"
   | Some idx -> idx