refactor generalized djikstra out of day 12

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,45 @@ 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))
+  |> List.filter_map (fun dir ->
-  |> List.iter (fun neighbor ->
+    let neighbor_pos = Vec2.(node_pos + dir) in
-    match Grid.at grid neighbor with
+    match Grid.at grid neighbor_pos with
-    | Some node when (not node.visited) && reachable current_node.char node.char ->
+    | Some neighbor when reachable node.char neighbor.char -> Some neighbor_pos
-      let new_distance = current_node.distance + 1 in
+    | _ -> None)
-      if new_distance < node.distance then node.distance <- new_distance;
+;;
-      if Option.is_none @@ List.find_opt (fun x -> Vec2.(x = neighbor)) !unvisited
+
-      then unvisited := neighbor :: !unvisited
+let path_distance grid goal start_nodes =
-    | _ -> ());
+  let set_info position (dist, visited) =
-  current_node.visited <- true;
+    let node = Grid.at_e grid position in
-  unvisited
+    node.distance <- dist;
-    := List.sort
+    node.visited <- visited
-         (fun a b ->
+  in
-           let a = Grid.at_e grid a in
+  let get_info position =
-           let b = Grid.at_e grid b in
+    let { char = _; distance; visited } = Grid.at_e grid position in
-           a.distance - b.distance)
+    distance, visited
-         !unvisited;
+  in
-  match !unvisited with
+  Utils.djikstra
-  | shortest :: _ when Vec2.(shortest = goal) -> Grid.at grid shortest
+    ~set_info
-  | shortest :: rest -> path grid goal shortest @@ ref rest
+    ~get_info
-  | [] -> None
+    ~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 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 goal start_nodes;
-  Printf.printf "%d" solution.distance;
   [%expect {| 492 |}]
 ;;

src/utils.ml

@@ -44,6 +44,61 @@ let%expect_test "fib memoized" =
   [%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
+    |> List.iter (fun neighbor ->
+      let n_dist, n_visited = get_info neighbor in
+      if not n_visited
+      then (
+        let new_dist = c_dist + get_weight 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 !seen with
+    | next :: _ when eq next goal ->
+      let dist, _ = get_info next in
+      Some dist
+    | next :: rest ->
+      seen := rest;
+      djikstra' next
+    | [] -> 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"
+;;
+
+(* not used anywhere so far, but cool as a reference for
+   using locally abstract types!
+*)
+let djikstra_hash (type k) ?(hash = Hashtbl.hash) ?(eq = Stdlib.( = )) slots =
+  let module Tbl =
+    CCHashtbl.Make (struct
+      type t = k
+
+      let equal = eq
+      let hash = hash
+    end)
+  in
+  let info_tbl = Tbl.create slots in
+  let get_info node = Tbl.get_or ~default:(Int.max_int, false) info_tbl node in
+  let set_info node info = Tbl.replace info_tbl node info in
+  djikstra ~eq ~get_info ~set_info
+;;
+
 module Parse = struct
   include Angstrom