Floyd-Warshall algorithm: Difference between revisions
Content added Content deleted
Line 4,313: | Line 4,313: | ||
4 -> 3 1 4 -> 2 -> 1 -> 3 |
4 -> 3 1 4 -> 2 -> 1 -> 3 |
||
</pre> |
</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}}== |
=={{header|Tcl}}== |