diff --git a/bin/day2406.ml b/bin/day2406.ml
new file mode 100644
index 0000000..f4ea2e1
--- /dev/null
+++ b/bin/day2406.ml
@@ -0,0 +1,47 @@
+let find_pos map =
+  let rec impl row =
+    if row >= Array.length map then failwith "find_pos"
+    else
+      match Array.find_index (fun x -> x = '^') map.(row) with
+      | Some i -> (i, row)
+      | None -> impl (row + 1)
+  in
+  impl 0
+
+let read_file fname =
+  let lst = Aoc.strings_of_file fname in
+  let map1 = Array.of_list lst in
+  let map2 =
+    Array.map (fun s -> Array.init (String.length s) (String.get s)) map1
+  in
+  let pos = find_pos map2 in
+  (map2, pos, (0, -1))
+
+let is_valid_pos map (x, y) =
+  if y < 0 || y >= Array.length map then false
+  else if x < 0 || x >= Array.length map.(y) then false
+  else true
+
+let rec move (map, (x, y), (dx, dy)) =
+  let () = map.(y).(x) <- 'X' in
+  let x', y' = (x + dx, y + dy) in
+  if is_valid_pos map (x', y') && map.(y').(x') = '#' then
+    move (map, (x, y), (-dy, dx))
+  else (map, (x', y'), (dx, dy))
+
+let part1 (map, pos, vel) =
+  let rec impl (map, pos, vel) =
+    if is_valid_pos map pos then impl (move (map, pos, vel)) else (map, pos, vel)
+  in
+  let _ = impl (map, pos, vel) in
+  Array.iter
+    (fun y ->
+      Array.iter (fun x -> print_char x) y;
+      print_newline ())
+    map;
+  Array.fold_left
+    (fun acc y ->
+      Array.fold_left (fun acc x -> if x = 'X' then acc + 1 else acc) acc y)
+    0 map
+
+let _ = Aoc.main read_file [ (string_of_int, part1) ]
diff --git a/bin/dune b/bin/dune
index 0c63a6c..01e6c77 100644
--- a/bin/dune
+++ b/bin/dune
@@ -1,4 +1,4 @@
 (executables
- (public_names day2401 day2402 day2403 day2404 day2405)
- (names day2401 day2402 day2403 day2404 day2405)
+ (public_names day2401 day2402 day2403 day2404 day2405 day2406)
+ (names day2401 day2402 day2403 day2404 day2405 day2406)
  (libraries str aoc))