The Floyd–Warshall algorithm is an algorithm for finding shortest paths in a weighted graph with positive or negative edge weights.




Task
Find the lengths of the shortest paths between all pairs of vertices of the given directed graph. Your code may assume that the input has already been checked for loops, parallel edges and negative cycles.


Print the pair, the distance and (optionally) the path.




Example
pair     dist    path
1 -> 2    -1     1 -> 3 -> 4 -> 2
1 -> 3    -2     1 -> 3
1 -> 4     0     1 -> 3 -> 4
2 -> 1     4     2 -> 1
2 -> 3     2     2 -> 1 -> 3
2 -> 4     4     2 -> 1 -> 3 -> 4
3 -> 1     5     3 -> 4 -> 2 -> 1
3 -> 2     1     3 -> 4 -> 2
3 -> 4     2     3 -> 4
4 -> 1     3     4 -> 2 -> 1
4 -> 2    -1     4 -> 2
4 -> 3     1     4 -> 2 -> 1 -> 3


See also
 Floyd-Warshall Algorithm - step by step guide (youtube)


(*
  Floyd-Warshall algorithm.
 
  See https://en.wikipedia.org/w/index.php?title=Floyd%E2%80%93Warshall_algorithm&oldid=1082310013
 *)
 
(*------------------------------------------------------------------(*
 
   In this program, I introduce more "abstraction" than there was in
   earlier versions, which were written in the SML-like languages
   OCaml and ATS. This is an example of proceeding from where one has
   gotten so far, to turn a program into a better one. The
   improvements made here could be backported to the other languages.
 
   In most respects, though, this program is very similar to the
   OCaml.
 
   Standard ML seems to specify its REAL signature is for IEEE
   floating point, so this program assumes there is a positive
   "infinity". (The difference is tiny between an algorithm with
   "infinity" and one without.)
 
*)------------------------------------------------------------------*)
 
(* Square arrays with 1-based indexing. *)
 
signature SQUARE_ARRAY =
sig
  type 'a squareArray
  val make : int * 'a -> 'a squareArray
  val get : 'a squareArray -> int * int -> 'a
  val set : 'a squareArray -> int * int -> 'a -> unit
end
 
structure SquareArray : SQUARE_ARRAY =
struct
 
type 'a squareArray = int * 'a array
 
fun make (n, fill) =
    (n, Array.array (n * n, fill))
 
fun get (n, r) (i, j) =
    Array.sub (r, (i - 1) + (n * (j - 1)))
 
fun set (n, r) (i, j) x =
    Array.update (r, (i - 1) + (n * (j - 1)), x)
 
end
 
(*------------------------------------------------------------------*)
 
(* A vertex is, internally, a positive integer, or 0 for the nil
   object. *)
 
signature VERTEX =
sig
  exception VertexError
  eqtype vertex
  val nilVertex : vertex
  val isNil : vertex -> bool
  val max : vertex * vertex -> vertex
  val toInt : vertex -> int
  val fromInt : int -> vertex
  val toString : vertex -> string
  val directedListToString : vertex list -> string
end
 
structure Vertex : VERTEX =
struct
 
exception VertexError
 
type vertex = int
 
val nilVertex = 0
 
fun isNil u = u = nilVertex
fun max (u, v) = Int.max (u, v)
fun toInt u = u
 
fun fromInt i =
    if i < nilVertex then
      raise VertexError
    else
      i
 
fun toString u = Int.toString u
 
fun directedListToString [] = ""
  | directedListToString [u] = toString u
  | directedListToString (u :: tail) =
    (* This implementation is *not* tail recursive. *)
    (toString u) ^ " -> " ^ (directedListToString tail)
 
end
 
(*------------------------------------------------------------------*)
 
(* Graph edges, with weights. *)
 
signature EDGE =
sig
  type edge
  val make : Vertex.vertex * real * Vertex.vertex -> edge
  val first : edge -> Vertex.vertex
  val weight : edge -> real
  val second : edge -> Vertex.vertex
end
 
structure Edge : EDGE =
struct
 
type edge = Vertex.vertex * real * Vertex.vertex
 
fun make edge = edge
fun first (u, _, _) = u
fun weight (_, w, _) = w
fun second (_, _, v) = v
 
end
 
(*------------------------------------------------------------------*)
 
(* The "dist" array and its operations. *)
 
signature DISTANCES =
sig
  type distances
  val make : int -> distances
  val get : distances -> int * int -> real
  val set : distances -> int * int -> real -> unit
end
 
structure Distances : DISTANCES =
struct
 
type distances = real SquareArray.squareArray
 
fun make n = SquareArray.make (n, Real.posInf)
val get = SquareArray.get
val set = SquareArray.set
 
end
 
(*------------------------------------------------------------------*)
 
(* The "next" array and its operations. It lets you look up optimum
   paths. *)
 
signature PATHS =
sig
  type paths
  val make : int -> paths
  val get : paths -> int * int -> Vertex.vertex
  val set : paths -> int * int -> Vertex.vertex -> unit
  val path : (paths * int * int) -> Vertex.vertex list
  val pathString : (paths * int * int) -> string
end
 
structure Paths : PATHS =
struct
 
type paths = Vertex.vertex SquareArray.squareArray
 
fun make n = SquareArray.make (n, Vertex.nilVertex)
val get = SquareArray.get
val set = SquareArray.set
 
fun path (p, u, v) =
    if Vertex.isNil (get p (u, v)) then
      []
    else
      let
        fun
        build_path (p, u, v) =
        if u = v then
          [v]
        else
          let
            val i = get p (u, v)
          in
            u :: build_path (p, i, v)
          end
      in
        build_path (p, u, v)
      end
 
fun pathString (p, u, v) =
    Vertex.directedListToString (path (p, u, v))
 
end
 
(*------------------------------------------------------------------*)
 
(* Floyd-Warshall. *)
 
exception FloydWarshallError
 
fun find_max_vertex [] = Vertex.nilVertex
  | find_max_vertex (edge :: tail) =
    (* This implementation is *not* tail recursive. *)
    Vertex.max (Vertex.max (Edge.first edge, Edge.second edge),
                find_max_vertex tail)
 
fun floyd_warshall [] = raise FloydWarshallError
  | floyd_warshall edges =
    let
      val n = find_max_vertex edges
      val dist = Distances.make n
      val next = Paths.make n
 
      fun read_edges [] = ()
        | read_edges (edge :: tail) =
          let
            val u = Edge.first edge
            val v = Edge.second edge
            val weight = Edge.weight edge
          in
            (Distances.set dist (u, v) weight;
             Paths.set next (u, v) v;
             read_edges tail)
          end
 
      val indices =
          (* Indices in order from 1 .. n. *)
          List.tabulate (n, fn i => i + 1)
    in
 
      (* Initialization. *)
 
      read_edges edges;
      List.app (fn i => (Distances.set dist (i, i) 0.0;
                         Paths.set next (i, i) i))
               indices;
 
      (* Perform the algorithm. *)
 
      List.app
        (fn k =>
            List.app
              (fn i =>
                  List.app
                    (fn j =>
                        let
                          val dist_ij = Distances.get dist (i, j)
                          val dist_ik = Distances.get dist (i, k)
                          val dist_kj = Distances.get dist (k, j)
                          val dist_ikj = dist_ik + dist_kj
                        in
                          if dist_ikj < dist_ij then
                            let
                              val new_dist = dist_ikj
                              val new_next = Paths.get next (i, k)
                            in
                              Distances.set dist (i, j) new_dist;
                              Paths.set next (i, j) new_next
                            end
                          else
                            ()
                        end)
                    indices)
              indices)
        indices;
 
      (* Return the results, as a 3-tuple. *)
 
      (n, dist, next)
 
    end
 
(*------------------------------------------------------------------*)
 
fun tilde_to_minus s =
    String.translate (fn c => if c = #"~" then "-" else str c) s
 
fun main () =
    let
      val example_graph =
          [Edge.make (Vertex.fromInt 1, ~2.0, Vertex.fromInt 3),
           Edge.make (Vertex.fromInt 3, 2.0, Vertex.fromInt 4),
           Edge.make (Vertex.fromInt 4, ~1.0, Vertex.fromInt 2),
           Edge.make (Vertex.fromInt 2, 4.0, Vertex.fromInt 1),
           Edge.make (Vertex.fromInt 2, 3.0, Vertex.fromInt 3)]
 
      val (n, dist, next) = floyd_warshall example_graph
 
      val indices =
          (* Indices in order from 1 .. n. *)
          List.tabulate (n, fn i => i + 1)
    in
      print "  pair     distance    path\n";
      print "---------------------------------------\n";
      List.app
        (fn u =>
            List.app
              (fn v =>
                  if u <> v then
                    (print " ";
                     print (Vertex.directedListToString [u, v]);
                     print "     ";
                     if 0.0 <= Distances.get dist (u, v) then
                       print " "
                     else
                       ();
                     print (tilde_to_minus
                              (Real.fmt (StringCvt.FIX (SOME 1))
                                        (Distances.get dist (u, v))));
                     print "      ";
                     print (Paths.pathString (next, u, v));
                     print "\n")
                  else
                    ())
              indices)
        indices
    end;
 
(* Comment out the following line, if you are using Poly/ML. *)
main ();
 
(*------------------------------------------------------------------*)
(* local variables: *)
(* mode: sml *)
(* sml-indent-level: 2 *)
(* sml-indent-args: 2 *)
(* end: *)