(* This module implements Dijkstra's algorithm over a graph with labeled weighted edges. (We assume the weight is contained in the label.) *) module Make (G : sig (* This is the type of graph vertices. *) type vertex include Hashtbl.HashedType with type t := vertex (* This is the type of graph labels. *) type label (* The source vertex (or vertices). *) val sources: (vertex -> unit) -> unit (* The weighted outgoing edges of a vertex. *) val successors: vertex -> (label -> int -> vertex -> unit) -> unit end) = struct open G (* The priority queue contains triples of a total weight, a vertex, and the discovery path for this vertex -- a list of labels. *) module Element = struct type t = int * vertex * label list let compare (w1, _, _) (w2, _, _) = Pervasives.compare w2 w1 (* switched because [Heap] uses the wrong convention *) end module PQ = Heap.Imperative(Element) (* A hash table maps vertices to distances. Another table maps vertices to unit values, indicating whether this distance is final. *) module H = Hashtbl.Make(struct include G type t = vertex end) let search f = (* Create the data structures. *) let queue = PQ.create 1024 in let dist : int H.t = H.create 1023 in let fixed : unit H.t = H.create 1023 in (* A handy accessor. *) let distance v = try H.find dist v with Not_found -> max_int in (* Insert the initial vertices. *) sources (fun source -> PQ.add queue (0, source, []); H.add dist source 0 ); (* As long as the queue is nonempty, ... *) while not (PQ.is_empty queue) do (* Extract one vertex. *) let (w, v, p) = PQ.pop_maximum queue in (* Check if this vertex is final already. If so, nothing to do. *) if not (H.mem fixed v) then begin (* Mark it final. *) H.add fixed v (); (* Let the client know about it. *) f (w, v, p); (* Examine its outgoing edges. *) successors v (fun label weight v' -> let w' = weight + w in if w' < distance v' then begin assert (not (H.mem fixed v')); H.replace dist v' w'; PQ.add queue (w', v', label :: p) end ) end done; distance end