Floyd-Warshall algorithm: Difference between revisions
→{{header|Tcl}}
Line 4,313:
4 -> 3 1 4 -> 2 -> 1 -> 3
</pre>
=={{header|Standard ML}}==
{{trans|OCaml}}
{{works with|MLton|20210117}}
<lang sml>(*
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;
main ();
(*------------------------------------------------------------------*)
(* local variables: *)
(* mode: sml *)
(* sml-indent-level: 2 *)
(* sml-indent-args: 2 *)
(* end: *)</lang>
{{out}}
<pre>$ mlton floyd_warshall_task.sml && ./floyd_warshall_task
pair distance path
---------------------------------------
1 -> 2 -1.0 1 -> 3 -> 4 -> 2
1 -> 3 -2.0 1 -> 3
1 -> 4 0.0 1 -> 3 -> 4
2 -> 1 4.0 2 -> 1
2 -> 3 2.0 2 -> 1 -> 3
2 -> 4 4.0 2 -> 1 -> 3 -> 4
3 -> 1 5.0 3 -> 4 -> 2 -> 1
3 -> 2 1.0 3 -> 4 -> 2
3 -> 4 2.0 3 -> 4
4 -> 1 3.0 4 -> 2 -> 1
4 -> 2 -1.0 4 -> 2
4 -> 3 1.0 4 -> 2 -> 1 -> 3</pre>
=={{header|Tcl}}==
| |||