Floyd-Warshall algorithm: Difference between revisions
Add Scala implementation
(Add Scala implementation) |
|||
| (32 intermediate revisions by 6 users not shown) | |||
Line 31:
{{trans|Python}}
<
V rn = 0 .< n
V dist = rn.map(i -> [1'000'000] * @n)
Line 53:
print(‘#. -> #. #4 #.’.format(i + 1, j + 1, dist[i][j], path.map(p -> String(p + 1)).join(‘ -> ’)))
floyd_warshall(4, [(1, 3, -2), (2, 1, 4), (2, 3, 3), (3, 4, 2), (4, 2, -1)])</
{{out}}
Line 74:
=={{header|360 Assembly}}==
{{trans|Rexx}}
<
FLOYDWAR CSECT
USING FLOYDWAR,R13 base register
Line 149:
XDEC DS CL12
YREGS
END FLOYDWAR</
{{out}}
<pre>
Line 170:
<
-- Floyd-Warshall algorithm.
--
Line 352:
end;
end floyd_warshall_task;</
{{out}}
Line 370:
4 -> 2 -1.00000E+00 4 -> 2
4 -> 3 1.00000E+00 4 -> 2 -> 1 -> 3</pre>
=={{header|ALGOL 68}}==
{{Trans|Lua}}
<syntaxhighlight lang="algol68">
BEGIN # Floyd-Warshall algorithm - translated from the Lua sample #
OP FMT = ( REAL v )STRING:
BEGIN
STRING result := fixed( ABS v, 0, 15 );
IF result[ LWB result ] = "." THEN "0" +=: result FI;
WHILE result[ UPB result ] = "0" DO result := result[ : UPB result - 1 ] OD;
IF result[ UPB result ] = "." THEN result := result[ : UPB result - 1 ] FI;
IF v < 0 THEN "-" ELSE " " FI + result
END # FMT # ;
PROC print result = ( [,]REAL dist, [,]INT nxt )VOID:
BEGIN
print( ( "pair dist path", newline ) );
FOR i FROM 1 LWB nxt TO 1 UPB nxt DO
FOR j FROM 2 LWB nxt TO 2 UPB nxt DO
IF i /= j THEN
INT u := i + 1;
INT v = j + 1;
print( ( whole( u, 0 ), " -> ", whole( v, 0 ), " "
, FMT dist[ i, j ], " ", whole( u, 0 )
)
);
WHILE u := nxt[ u - 1, v - 1 ];
print( ( " -> " +whole( u, 0 ) ) );
u /= v
DO SKIP OD;
print( ( newline ) )
FI
OD
OD
END # print result # ;
PROC floyd warshall = ( [,]INT weights, INT num vertices )VOID:
BEGIN
REAL infinity = max real;
[ 0 : num vertices - 1, 0 : num vertices - 1 ]REAL dist;
FOR i FROM LWB dist TO 1 UPB dist DO
FOR j FROM 2 LWB dist TO 2 UPB dist DO
dist[ i, j ] := infinity
OD
OD;
FOR i FROM 1 LWB weights TO 1 UPB weights DO
# the weights array is one based #
[]INT w = weights[ i, : ];
dist[ w[ 1 ] - 1, w[ 2 ] - 1 ] := w[ 3 ]
OD;
[ 0 : num vertices - 1, 0 : num vertices - 1 ]INT nxt;
FOR i FROM LWB nxt TO 1 UPB nxt DO
FOR j FROM 2 LWB nxt TO 2 UPB nxt DO
nxt[ i, j ] := IF i /= j THEN j + 1 ELSE 0 FI
OD
OD;
FOR k FROM 2 LWB dist TO 2 UPB dist DO
FOR i FROM 1 LWB dist TO 1 UPB dist DO
FOR j FROM 2 LWB dist TO 2 UPB dist DO
IF dist[ i, k ] /= infinity AND dist[ k, j ] /= infinity THEN
IF dist[ i, k ] + dist[ k, j ] < dist[ i, j ] THEN
dist[ i, j ] := dist[ i, k ] + dist[ k, j ];
nxt[ i, j ] := nxt[ i, k ]
FI
FI
OD
OD
OD;
print result( dist, nxt )
END # floyd warshall # ;
[,]INT weights = ( ( 1, 3, -2 )
, ( 2, 1, 4 )
, ( 2, 3, 3 )
, ( 3, 4, 2 )
, ( 4, 2, -1 )
);
INT num vertices = 4;
floyd warshall( weights, num vertices )
END
</syntaxhighlight>
{{out}}
<pre>
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
</pre>
=={{header|ATS}}==
===A first implementation===
{{trans|Ada}}
{{trans|RATFOR}}
This implementation uses non-linear types that will leak memory. However, such memory leaks are what Boehm GC is made to deal with. (Also, such leaks are inconsequential in a program like this one.)
Removing one of the runtime assertions ('''assertloc''') might prevent compilation. This is a difference between ATS and most other languages. For the template functions '''square_array_get_at''' and '''square_array_set_at''', there is a '''praxi''' (an axiom) instead of assertions, and so, by contrast, there is no runtime penalty. A proof of the "axiom" could have been derived from the properties of multiplication, in case I had any doubts (and one may be surprised how often one is wrong about a lemma), but I simply declared it as an axiom.
<syntaxhighlight lang="ats">(*
Floyd-Warshall algorithm.
See https://en.wikipedia.org/w/index.php?title=Floyd%E2%80%93Warshall_algorithm&oldid=1082310013
*)
#include "share/atspre_staload.hats"
#define NIL list_nil ()
#define :: list_cons
typedef Pos = [i : pos] int i
(*------------------------------------------------------------------*)
(* Square arrays with 1-based indexing. *)
extern praxi
lemma_square_array_indices {n : pos}
{i, j : pos | i <= n; j <= n}
() :<prf>
[0 <= (i - 1) + ((j - 1) * n);
(i - 1) + ((j - 1) * n) < n * n]
void
typedef square_array (t : t@ype+, n : int) =
'{
side_length = int n,
elements = arrayref (t, n * n)
}
fn {t : t@ype}
make_square_array {n : nat}
(n : int n,
fill : t) : square_array (t, n) =
let
prval () = mul_gte_gte_gte {n, n} ()
in
'{
side_length = n,
elements = arrayref_make_elt (i2sz (n * n), fill)
}
end
fn {t : t@ype}
square_array_get_at {n : pos}
{i, j : pos | i <= n; j <= n}
(arr : square_array (t, n),
i : int i,
j : int j) : t =
let
prval () = lemma_square_array_indices {n} {i, j} ()
in
arrayref_get_at (arr.elements,
(i - 1) + ((j - 1) * arr.side_length))
end
fn {t : t@ype}
square_array_set_at {n : pos}
{i, j : pos | i <= n; j <= n}
(arr : square_array (t, n),
i : int i,
j : int j,
x : t) : void =
let
prval () = lemma_square_array_indices {n} {i, j} ()
in
arrayref_set_at (arr.elements,
(i - 1) + ((j - 1) * arr.side_length),
x)
end
overload [] with square_array_get_at
overload [] with square_array_set_at
(*------------------------------------------------------------------*)
typedef floatpt = float
extern castfn i2floatpt : int -<> floatpt
macdef arbitrary_floatpt = i2floatpt (12345)
typedef distance_array (n : int) = square_array (floatpt, n)
typedef vertex = [i : nat] int i
#define NIL_VERTEX 0
typedef next_vertex_array (n : int) = square_array (vertex, n)
typedef edge =
'{ (* The ' means this is allocated by the garbage collector.*)
u = vertex,
weight = floatpt,
v = vertex
}
typedef edge_list (n : int) = list (edge, n)
typedef edge_list = [n : int] edge_list (n)
prfn (* edge_list have non-negative size. *)
lemma_edge_list_param {n : int} (edges : edge_list n)
:<prf> [0 <= n] void =
lemma_list_param edges
(*------------------------------------------------------------------*)
fn
find_max_vertex (edges : edge_list) : vertex =
let
fun
loop {n : nat} .<n>.
(p : edge_list n,
u : vertex) : vertex =
case+ p of
| NIL => u
| head :: tail =>
loop (tail, max (max (u, (head.u)), (head.v)))
prval () = lemma_edge_list_param edges
in
assertloc (isneqz edges);
loop (edges, 0)
end
fn
floyd_warshall {n : int}
(edges : edge_list,
n : int n,
distance : distance_array n,
next_vertex : next_vertex_array n) : void =
let
val () = assertloc (1 <= n)
in
(* This implementation does NOT initialize (to any meaningful
value) elements of "distance" that would be set "infinite" in
the Wikipedia pseudocode. Instead you should use the
"next_vertex" array to determine whether there exists a finite
path from one vertex to another.
Thus we avoid any dependence on IEEE floating point or on the
settings of the FPU. *)
(* Initialize. *)
let
var i : Pos
in
for (i := 1; i <= n; i := succ i)
let
var j : Pos
in
for (j := 1; j <= n; j := succ j)
next_vertex[i, j] := NIL_VERTEX
end
end;
let
var p : edge_list
in
for (p := edges; list_is_cons p; p := list_tail p)
let
val head = list_head p
val u = head.u
val () = assertloc (u <> NIL_VERTEX)
val () = assertloc (u <= n)
val v = head.v
val () = assertloc (v <> NIL_VERTEX)
val () = assertloc (v <= n)
in
distance[u, v] := head.weight;
next_vertex[u, v] := v
end
end;
let
var i : Pos
in
for (i := 1; i <= n; i := succ i)
begin
(* Distance from a vertex to itself is zero. *)
distance[i, i] := i2floatpt (0);
next_vertex[i, i] := i
end
end;
(* Perform the algorithm. *)
let
var k : Pos
in
for (k := 1; k <= n; k := succ k)
let
var i : Pos
in
for (i := 1; i <= n; i := succ i)
let
var j : Pos
in
for (j := 1; j <= n; j := succ j)
if next_vertex[i, k] <> NIL_VERTEX
&& next_vertex[k, j] <> NIL_VERTEX then
let
val dist_ikj = distance[i, k] + distance[k, j]
in
if next_vertex[i, j] = NIL_VERTEX
|| dist_ikj < distance[i, j] then
begin
distance[i, j] := dist_ikj;
next_vertex[i, j] := next_vertex[i, k]
end
end
end
end
end
end
fn
print_path {n : int}
(n : int n,
next_vertex : next_vertex_array n,
u : Pos,
v : Pos) : void =
if 0 < n then
let
val () = assertloc (u <= n)
val () = assertloc (v <= n)
in
if next_vertex[u, v] <> NIL_VERTEX then
let
var i : Int
in
i := u;
print! (i);
while (i <> v)
let
val () = assertloc (1 <= i)
val () = assertloc (i <= n)
in
print! (" -> ");
i := next_vertex[i, v];
print! (i)
end
end
end
implement
main0 () =
let
(* One might notice that (because consing prepends rather than
appends) the order of edges here is *opposite* to that of some
other languages' implementations. But the order of the edges is
immaterial. *)
val example_graph = NIL
val example_graph =
'{u = 1, weight = i2floatpt (~2), v = 3} :: example_graph
val example_graph =
'{u = 3, weight = i2floatpt (2), v = 4} :: example_graph
val example_graph =
'{u = 4, weight = i2floatpt (~1), v = 2} :: example_graph
val example_graph =
'{u = 2, weight = i2floatpt (4), v = 1} :: example_graph
val example_graph =
'{u = 2, weight = i2floatpt (3), v = 3} :: example_graph
val n = find_max_vertex (example_graph)
val distance = make_square_array<floatpt> (n, arbitrary_floatpt)
val next_vertex = make_square_array<vertex> (n, NIL_VERTEX)
in
floyd_warshall (example_graph, n, distance, next_vertex);
println! (" pair distance path");
println! ("------------------------------------------");
let
var u : Pos
in
for (u := 1; u <= n; u := succ u)
let
var v : Pos
in
for (v := 1; v <= n; v := succ v)
if u <> v then
begin
print! (" ", u, " -> ", v, " ");
if i2floatpt (0) <= distance[u, v] then
print! (" ");
print! (distance[u, v], " ");
print_path (n, next_vertex, u, v);
println! ()
end
end
end
end</syntaxhighlight>
{{out}}
<pre>$ patscc -O3 -DATS_MEMALLOC_GCBDW floyd_warshall_task.dats -lgc && ./a.out
pair distance path
------------------------------------------
1 -> 2 -1.000000 1 -> 3 -> 4 -> 2
1 -> 3 -2.000000 1 -> 3
1 -> 4 0.000000 1 -> 3 -> 4
2 -> 1 4.000000 2 -> 1
2 -> 3 2.000000 2 -> 1 -> 3
2 -> 4 4.000000 2 -> 1 -> 3 -> 4
3 -> 1 5.000000 3 -> 4 -> 2 -> 1
3 -> 2 1.000000 3 -> 4 -> 2
3 -> 4 2.000000 3 -> 4
4 -> 1 3.000000 4 -> 2 -> 1
4 -> 2 -1.000000 4 -> 2
4 -> 3 1.000000 4 -> 2 -> 1 -> 3</pre>
===A second implementation===
{{trans|Standard ML}}
A second version. An explanation of "Why a second version?" is contained in the program text.
<syntaxhighlight lang="ats">(*
Floyd-Warshall algorithm.
See https://en.wikipedia.org/w/index.php?title=Floyd%E2%80%93Warshall_algorithm&oldid=1082310013
-------------------------
WHY A SECOND ATS VERSION?
-------------------------
From the first ATS version, I derived a version in OCaml, which
modularized the code. From the OCaml, I produced a Standard ML
implementation that also made the types abstract.
Now I am returning to the ATS, to backport (among other things) the
abstraction of types. In fact I increase the abstraction, in a way
that protects the programmer against accidentally using the
"uninitialized" entries of the "distance" array.
Thus one can follow the chain of improvement, and also compare how
type abstraction is done Standard ML and in ATS. In ATS, type
abstraction can be done using "assume" statements or type casts.
*)
#include "share/atspre_staload.hats"
#define NIL list_nil ()
#define :: list_cons
typedef Pos = [i : pos] int i
(*------------------------------------------------------------------*)
(* You can change floatpt from "float" to "double" or another type,
if you wish. *)
typedef floatpt = float
extern castfn int2floatpt : int -<> floatpt
overload i2fp with int2floatpt
(*------------------------------------------------------------------*)
(* Square arrays with 1-based indexing. *)
local
typedef _square_array (t : t@ype+, n : int) =
(* '{ ... } with a "'" means the type is pointer to a record
allocated by the garbage collector. *)
'{
side_length = int n,
elements = arrayref (t, n * n)
}
in
abstype square_array (t : t@ype+, n : int)
assume square_array (t, n) = _square_array (t, n)
extern praxi
lemma_square_array_indices {n : pos}
{i, j : pos | i <= n; j <= n}
() :<prf>
[0 <= (i - 1) + ((j - 1) * n);
(i - 1) + ((j - 1) * n) < n * n]
void
fn {t : t@ype}
square_array_make {n : nat}
(n : int n,
fill : t) :<!wrt> square_array (t, n) =
let
prval () = mul_gte_gte_gte {n, n} ()
in
'{
side_length = n,
elements = arrayref_make_elt (i2sz (n * n), fill)
}
end
fn {t : t@ype}
square_array_get_at {n : pos}
{i, j : pos | i <= n; j <= n}
(arr : square_array (t, n),
i : int i,
j : int j) :<!ref> t =
let
prval () = lemma_square_array_indices {n} {i, j} ()
in
arrayref_get_at (arr.elements,
(i - 1) + ((j - 1) * arr.side_length))
end
fn {t : t@ype}
square_array_set_at {n : pos}
{i, j : pos | i <= n; j <= n}
(arr : square_array (t, n),
i : int i,
j : int j,
x : t) :<!refwrt> void =
let
prval () = lemma_square_array_indices {n} {i, j} ()
in
arrayref_set_at (arr.elements,
(i - 1) + ((j - 1) * arr.side_length),
x)
end
overload [] with square_array_get_at
overload [] with square_array_set_at
end (* local *)
(*------------------------------------------------------------------*)
(* A vertex made more abstract than simply identifying it with an
integer. *)
(* The following "abst@ype" tells the compiler that "vertex" is the
same size as "int" (as opposed to the size of a pointer, which
"abstype" assumes). It does *not* identify "vertex" with "int". *)
abst@ype vertex (i : int) = int
typedef vertex = [i : nat] vertex i
(* These casts let us convert between int and the abstract type. *)
extern castfn int2vertex : {i : nat} int i -<> vertex i
extern castfn vertex2int : {i : nat} vertex i -<> int i
macdef nil_vertex = int2vertex 0
fn
vertex_is_nil {u : nat}
(u : vertex u) :<> bool (u == 0) =
vertex2int u = vertex2int nil_vertex
fn
vertex_isnot_nil {u : nat}
(u : vertex u) :<> bool (u != 0) =
~vertex_is_nil u
fn
vertex_eq {u, v : nat}
(u : vertex u,
v : vertex v) :<> bool (u == v) =
vertex2int u = vertex2int v
fn
vertex_neq {u, v : nat}
(u : vertex u,
v : vertex v) :<> bool (u <> v) =
~vertex_eq (u, v)
fn
vertex_max {u, v : nat}
(u : vertex u,
v : vertex v) :<> vertex (max (u, v)) =
int2vertex (max (vertex2int u, vertex2int v))
fn
tostring_vertex (u : vertex) :<> string =
tostring_int (vertex2int u)
fn
tostring_directed_vertex_list (lst : List vertex) :<!wrt> string =
let
fun
loop {n : nat} .<n>.
(lst : list (vertex, n),
s : string) :<!wrt> string =
case+ lst of
| NIL => s
| u :: tail =>
let
val s_u = tostring_vertex u
in
if s = "" then
loop (tail, s_u)
else
let
val s1 = strptr2string (string_append (s, " -> ", s_u))
in
loop (tail, s1)
end
end
prval () = lemma_list_param lst
in
loop (lst, "")
end
overload iseqz with vertex_is_nil
overload isneqz with vertex_isnot_nil
overload = with vertex_eq
overload <> with vertex_neq
overload max with vertex_max
(*------------------------------------------------------------------*)
(* Graph edges, with weights. *)
local
typedef _edge (u : int, v : int) =
(* The type is pointer to a tuple allocated by the garbage
collector. *)
[1 <= u; 1 <= v] '(vertex u, floatpt, vertex v)
in
abstype edge (u : int, v : int)
typedef edge = [u, v : pos] edge (u, v)
assume edge (u, v) = _edge (u, v)
fn
edge_make {u, v : pos}
(u : vertex u,
weight : floatpt,
v : vertex v) :<> edge (u, v) =
'(u, weight, v)
fn
edge_first {u, v : pos}
(edge : edge (u, v)) :<> vertex u =
edge.0
fn
edge_weight (edge : edge) :<> floatpt =
edge.1
fn
edge_second {u, v : pos}
(edge : edge (u, v)) :<> vertex v =
edge.2
fn
max_vertex_in_edge_list (lst : List edge) :<> vertex =
let
fun
loop {n : nat} .<n>.
(lst : list (edge, n),
x : vertex) :<> vertex =
case+ lst of
| NIL => x
| edge :: tail =>
loop (tail,
max (max (edge_first edge, edge_second edge), x))
prval () = lemma_list_param lst
in
loop (lst, nil_vertex)
end
end (* local *)
(*------------------------------------------------------------------*)
(* Floyd-Warshall. *)
local
typedef _floyd_warshall_result (n : int) =
'{
n = int n,
dist = square_array (floatpt, n),
next = square_array (vertex, n)
}
fn {}
_dist_get_at {n : pos}
{i, j : pos | i <= n; j <= n}
(dist : square_array (floatpt, n),
i : int i,
j : int j) :<!ref> floatpt =
square_array_get_at (dist, i, j)
fn
_dist_set_at {n : pos}
{i, j : pos | i <= n; j <= n}
(dist : square_array (floatpt, n),
i : int i,
j : int j,
x : floatpt) :<!refwrt> void =
square_array_set_at (dist, i, j, x)
fn {}
_next_get_at {n : pos}
{i, j : pos | i <= n; j <= n}
(next : square_array (vertex, n),
i : int i,
j : int j) :<!ref> vertex =
square_array_get_at (next, i, j)
fn
_next_set_at {n : pos}
{i, j : pos | i <= n; j <= n}
(next : square_array (vertex, n),
i : int i,
j : int j,
x : vertex) :<!refwrt> void =
square_array_set_at (next, i, j, x)
in
abstype floyd_warshall_result (n : int)
typedef floyd_warshall_result = [n : nat] floyd_warshall_result n
assume floyd_warshall_result n = _floyd_warshall_result n
exception FloydWarshallError of (string)
fn
vertex_count {n : pos}
(fw : floyd_warshall_result n) :<> int n =
fw.n
fn
get_distance {n : pos}
{i, j : pos | i <= n; j <= n}
(fw : floyd_warshall_result n,
i : vertex i,
j : vertex j) :<!ref> Option floatpt =
(* Notice there is *no way* to return one of the "uninitialized"
values in the "dist" array (which were actually set to a
meaningless value, or could have been set to positive
infinity). Instead you get "None()".
This kind of behavior is better than returning "positive
infinity", because it does not depend on any particular sort of
floating point. Indeed, in Ada you could use fixed point. *)
let
val i = vertex2int i
val j = vertex2int j
val u = _next_get_at (fw.next, i, j)
in
if iseqz u then
None () (* There is no finite path. *)
else
Some (_dist_get_at (fw.dist, i, j))
end
fn
get_next_vertex {n : pos}
{i, j : pos | i <= n; j <= n}
(fw : floyd_warshall_result n,
i : vertex i,
j : vertex j) :<!ref> vertex =
_next_get_at (fw.next, vertex2int i, vertex2int j)
fn
floyd_warshall (edges : List edge)
:<1> [n : pos] floyd_warshall_result n =
let
val n = vertex2int (max_vertex_in_edge_list edges)
in
if n = 0 then
$raise FloydWarshallError ("no vertices")
else
let
macdef arbitrary_floatpt = i2fp (12345)
val dist = square_array_make<floatpt> (n, arbitrary_floatpt)
val next = square_array_make<vertex> (n, nil_vertex)
in
(* Initialize. *)
let
var i : Pos
in
for (i := 1; i <= n; i := succ i)
let
var j : Pos
in
for (j := 1; j <= n; j := succ j)
next[i, j] := nil_vertex
end
end;
let
var p : List edge
in
for (p := edges; list_is_cons p; p := list_tail p)
let
val edge = list_head p
val u = edge_first edge
val () = assertloc (isneqz u)
val () = assertloc (vertex2int u <= n)
val v = edge_second edge
val () = assertloc (isneqz v)
val () = assertloc (vertex2int v <= n)
in
dist[vertex2int u, vertex2int v] := edge_weight edge;
next[vertex2int u, vertex2int v] := v
end
end;
let
var i : Pos
in
for (i := 1; i <= n; i := succ i)
begin
(* Distance from a vertex to itself is zero. *)
dist[i, i] := int2floatpt (0);
next[i, i] := int2vertex i
end
end;
(* Perform the algorithm. *)
let
var k : Pos
in
for (k := 1; k <= n; k := succ k)
let
var i : Pos
in
for (i := 1; i <= n; i := succ i)
let
var j : Pos
in
for (j := 1; j <= n; j := succ j)
if isneqz next[i, k] && isneqz next[k, j] then
let
val dist_ikj = dist[i, k] + dist[k, j]
in
if iseqz next[i, j]
|| dist_ikj < dist[i, j] then
begin
dist[i, j] := dist_ikj;
next[i, j] := next[i, k]
end
end
end
end
end;
(* Return the result. *)
'{ n = n, dist = dist, next = next }
end
end
fn
get_path {n : int}
{u, v : pos}
(fw : floyd_warshall_result n,
u : vertex u,
v : vertex v) :<!refwrt,!exn> List vertex =
if (fw.n) < vertex2int u then
$raise FloydWarshallError ("vertex not found")
else if (fw.n) < vertex2int v then
$raise FloydWarshallError ("vertex not found")
else
if iseqz (get_next_vertex (fw, u, v)) then
NIL
else
let
fun
loop (w : vertex,
lst : List0 vertex) :<!ntm,!refwrt> List vertex =
if w = v then
list_vt2t (list_reverse lst)
else
let
val () =
$effmask_exn assertloc (isneqz w)
val () =
$effmask_exn assertloc (vertex2int w <= (fw.n))
val w = get_next_vertex (fw, w, v)
in
loop (w, w :: lst)
end
in
$effmask_ntm loop (u, u :: NIL)
end
end (* local *)
(*------------------------------------------------------------------*)
implement
main0 () =
let
val example_graph =
$list (edge_make (int2vertex 1, i2fp (~2), int2vertex 3),
edge_make (int2vertex 3, i2fp (2), int2vertex 4),
edge_make (int2vertex 4, i2fp (~1), int2vertex 2),
edge_make (int2vertex 2, i2fp (4), int2vertex 1),
edge_make (int2vertex 2, i2fp (3), int2vertex 3))
val fw = floyd_warshall example_graph
in
println! (" pair distance path");
println! ("------------------------------------------");
let
var i : Pos
in
for (i := 1; i <= (fw.n); i := succ i)
let
var j : Pos
in
for (j := 1; j <= (fw.n); j := succ j)
let
val u = int2vertex i
val v = int2vertex j
in
if u <> v then
let
val s_edge =
tostring_directed_vertex_list ($list (u, v))
val distance_opt = get_distance (fw, u, v)
in
print! (" ", s_edge, " ");
begin
case+ distance_opt of
| None () => print! " no path"
| Some distance =>
let
val path = get_path (fw, u, v)
val s_path =
tostring_directed_vertex_list path
in
if int2floatpt (0) <= distance then
print! " ";
print! distance;
print! " ";
print! s_path
end
end;
println! ()
end
end
end
end
end
(*------------------------------------------------------------------*)</syntaxhighlight>
{{out}}
<pre>$ patscc -O3 -DATS_MEMALLOC_GCBDW floyd_warshall_task_2.dats -lgc && ./a.out
pair distance path
------------------------------------------
1 -> 2 -1.000000 1 -> 3 -> 4 -> 2
1 -> 3 -2.000000 1 -> 3
1 -> 4 0.000000 1 -> 3 -> 4
2 -> 1 4.000000 2 -> 1
2 -> 3 2.000000 2 -> 1 -> 3
2 -> 4 4.000000 2 -> 1 -> 3 -> 4
3 -> 1 5.000000 3 -> 4 -> 2 -> 1
3 -> 2 1.000000 3 -> 4 -> 2
3 -> 4 2.000000 3 -> 4
4 -> 1 3.000000 4 -> 2 -> 1
4 -> 2 -1.000000 4 -> 2
4 -> 3 1.000000 4 -> 2 -> 1 -> 3</pre>
=={{header|C}}==
Reads the graph from a file, prints out usage on incorrect invocation.
<syntaxhighlight lang="c">
#include<limits.h>
#include<stdlib.h>
Line 449 ⟶ 1,447:
return 0;
}
</syntaxhighlight>
Input file, first row specifies number of vertices and edges.
<pre>
Line 462 ⟶ 1,460:
<pre>
C:\rosettaCode>fwGraph.exe fwGraph.txt
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
</pre>
==={{libheader|Gadget}}===
VERSION 2. Using Gadget, an a "C" library.
<syntaxhighlight lang="c">
#include <limits.h>
#include <gadget/gadget.h>
LIB_GADGET_START
/* algunos datos globales */
int vertices,edges;
/* algunos prototipos */
F_STAT DatosdeArchivo( const char *cFile);
int * CargaMatriz(int * mat, DS_ARRAY * mat_data, const char * cFile, F_STAT stat );
int * CargaGrafo(int * graph, DS_ARRAY * graph_data, const char *cFile);
void Floyd_Warshall(int * graph, DS_ARRAY graph_data);
/* bloque principal */
Main
if ( Arg_count != 2 ){
Msg_yellow("Modo de uso:\n ./floyd <archivo_de_vertices>\n");
Stop(1);
}
Get_arg_str (cFile,1);
Set_token_sep(' ');
Cls;
if(Exist_file(cFile)){
New array graph as int;
graph = CargaGrafo( pSDS(graph), cFile);
if(graph){
/* calcula Floyd-Warshall */
Print "Vertices=%d, edges=%d\n",vertices,edges;
Floyd_Warshall( SDS(graph) ); Prnl;
Free array graph;
}
}else{
Msg_redf("No existe el archivo %s",cFile);
}
Free secure cFile;
End
void Floyd_Warshall( RDS(int,graph) ){
Array processedVertices as int(vertices,vertices);
Fill array processWeights as int(vertices,vertices) with SHRT_MAX;
int i,j,k;
Range for processWeights [0:1:vertices, 0:1:vertices ];
Compute_for( processWeights, i,j,
$processedVertices[i,j] = (i!=j)?j+1:0;
)
#define VERT_ORIG 0
#define VERT_DEST 1
#define WEIGHT 2
Iterator up i [0:1:edges] {
$2processWeights[ $graph[i,VERT_ORIG]-1, $graph[i,VERT_DEST]-1 ] = $graph[i,WEIGHT];
}
Compute_for (processWeights,i,j,
Iterator up k [0:1:vertices] {
if( $processWeights[j,i] + $processWeights[i,k] < $processWeights[j,k] )
{
$processWeights[j,k] = $processWeights[j,i] + $processWeights[i,k];
$processedVertices[j,k] = $processedVertices[j,i];
}
} );
Print "pair dist path";
// ya existen rangos definios para "processWeights":
Compute_for(processWeights, i, j,
if(i!=j)
{
Print "\n%d -> %d %3d %5d", i+1, j+1, $processWeights[i,j], i+1;
int k = i+1;
do{
k = $processedVertices[k-1,j];
Print " -> %d", k;
}while(k!=j+1);
}
);
Free array processWeights, processedVertices;
}
F_STAT DatosdeArchivo( const char *cFile){
return Stat_file(cFile);
}
int * CargaMatriz( pRDS(int, mat), const char * cFile, F_STAT stat ){
return Load_matrix( SDS(mat), cFile, stat);
}
int * CargaGrafo( pRDS(int, graph), const char *cFile){
F_STAT dataFile = DatosdeArchivo(cFile);
if(dataFile.is_matrix){
Range ptr graph [0:1:dataFile.total_lines-1, 0:1:dataFile.max_tokens_per_line-1];
graph = CargaMatriz( SDS(graph), cFile, dataFile);
if( graph ){
/* obtengo vertices = 4 y edges = 5 */
edges = dataFile.total_lines;
Block( vertices, Range ptr graph [ 0:1:pRows(graph), 0:1:1 ];
DS_MAXMIN maxNode = Max_array( SDS(graph) );
Out_int( $graph[maxNode.local] ) );
}else{
Msg_redf("Archivo \"%s\" no ha podido ser cargado",cFile);
}
}else{
Msg_redf("Archivo \"%s\" no es cuadrado",cFile);
}
return graph;
}
</syntaxhighlight>
{{out}}
Archivo fuente: floyd_data.txt
<pre>
1 3 -2
3 4 2
4 2 -1
2 1 4
2 3 3
</pre>
Salida:
<pre>
$ ./floydWarshall floyd_data.txt
Vertices=4, edges=5
pair dist path
1 -> 2 -1 1->3->4->2
Line 479 ⟶ 1,632:
=={{header|C sharp|C#}}==
{{trans|Java}}
<
namespace FloydWarshallAlgorithm {
Line 543 ⟶ 1,696:
}
}
}</
=={{header|C++}}==
<
#include <vector>
#include <sstream>
Line 619 ⟶ 1,772:
std::cin.get();
return 0;
}</
{{out}}
Line 635 ⟶ 1,788:
(4 -> 2, -1, 4 -> 2)
(4 -> 3, 1, 4 -> 2 -> 1 -> 3)</pre>
=={{header|Common Lisp}}==
{{trans|Scheme}}
I have wrapped the Common Lisp program in a [https://roswell.github.io/ Roswell] script.
Notice how in Common Lisp you have to specially quote the name of a function to call that function as an argument, whereas in Scheme no such thing is necessary. (In fact, a Scheme procedure does not really have a name; you are giving the name of a variable that holds the procedure.)
"Looping" (or tail recursion) is done differently, although it is common for a Common Lisp-like '''loop''' macro to be available in Scheme. A Common Lisp-like '''format''' also often is available.
<syntaxhighlight lang="lisp">#!/bin/sh
#|-*- mode:lisp -*-|#
#|
exec ros -Q -- $0 "$@"
|#
(progn ;;init forms
(ros:ensure-asdf)
#+quicklisp(ql:quickload '() :silent t)
)
(defpackage :ros.script.floyd-warshall.3861181636
(:use :cl))
(in-package :ros.script.floyd-warshall.3861181636)
;;;
;;; Floyd-Warshall algorithm.
;;;
;;; See https://en.wikipedia.org/w/index.php?title=Floyd%E2%80%93Warshall_algorithm&oldid=1082310013
;;;
;;; Translated from the Scheme. Small improvements (or what might be
;;; considered improvements), and some type specialization, have been
;;; added.
;;;
;;;-------------------------------------------------------------------
;;;
;;; A square array will be represented by an ordinary Common Lisp
;;; array, but accessed through our own functions (which look similar
;;; to, although not identical to, the corresponding Scheme
;;; functions).
;;;
;;; Square arrays are indexed *starting at one*.
;;;
(defun make-arr (n &key (element-type t) initial-element)
(make-array (list n n) :element-type element-type
:initial-element initial-element))
(defun arr-set (arr i j x)
(setf (aref arr (- i 1) (- j 1)) x))
(defun arr-ref (arr i j)
(aref arr (- i 1) (- j 1)))
;;;-------------------------------------------------------------------
;;;
;;; Floyd-Warshall.
;;;
;;; Input is a list of length-3 lists representing edges; each entry
;;; is:
;;;
;;; (start-vertex edge-weight end-vertex)
;;;
;;; where vertex identifiers are integers from 1 .. n.
;;;
;;; A difference from the Scheme implementation is that here we do not
;;; assume the floating point supports "infinities". In the Scheme we
;;; did, because in R7RS small there is support for such infinities
;;; (although the standard does not *require* them). Also because
;;; alternatives were not yet apparent to this author. :)
;;;
(defvar *floatpt* 'single-float)
(defconstant nil-vertex 0)
(defun floyd-warshall (edges)
(let* ((n
;; Set n to the maximum vertex number. By design, n also
;; equals the number of vertices.
(max (apply #'max (mapcar #'car edges))
(apply #'max (mapcar #'caddr edges))))
(distance
;; The distances are initialized to a purely arbitrary
;; value. An entry in the "distance" array is meaningful
;; *only* if the corresponding entry in "next-vertex" is
;; not the nil-vertex.
(make-arr n :element-type *floatpt*
:initial-element (coerce 12345 *floatpt*)))
(next-vertex
;; Unless later set otherwise, an entry in "next-vertex"
;; will be the nil-vertex.
(make-arr n :element-type 'fixnum
:initial-element nil-vertex)))
(defun dist (p q) (arr-ref distance p q))
(defun next (p q) (arr-ref next-vertex p q))
(defun set-dist (p q x) (arr-set distance p q x))
(defun set-next (p q x) (arr-set next-vertex p q x))
(defun nilnext (p q) (= (next p q) nil-vertex))
;; Initialize "distance" and "next-vertex".
(loop for edge in edges
do (let ((u (car edge))
(weight (cadr edge))
(v (caddr edge)))
(set-dist u v weight)
(set-next u v v)))
(loop for v from 1 to n
do (progn
;; The distance from a vertex to itself = 0.0.
(set-dist v v (coerce 0 *floatpt*))
(set-next v v v)))
;; Perform the algorithm.
(loop
for k from 1 to n
do (loop
for i from 1 to n
do (loop
for j from 1 to n
do (and (not (nilnext i k))
(not (nilnext k j))
(let* ((dist-ikj (+ (dist i k) (dist k j))))
(when (or (nilnext i j)
(< dist-ikj (dist i j)))
(set-dist i j dist-ikj)
(set-next i j (next i k))))))))
;; Return the results.
(values n distance next-vertex)))
;;;-------------------------------------------------------------------
;;;
;;; Path reconstruction from the "next-vertex" array.
;;;
;;; The return value is a list of vertices.
;;;
(defun find-path (next-vertex u v)
(if (= (arr-ref next-vertex u v) nil-vertex)
(list)
(cons u (let ((i u))
(loop while (/= i v)
do (setf i (arr-ref next-vertex i v))
collect i)))))
;;;-------------------------------------------------------------------
(defun directed-vertex-list-to-string (lst)
(if (not lst)
""
(let ((s (write-to-string (car lst))))
(loop for u in (cdr lst)
do (setf s (concatenate 'string s " -> "
(write-to-string u))))
s)))
;;;-------------------------------------------------------------------
(defun main (&rest argv)
(declare (ignorable argv))
(let ((example-graph
(mapcar (lambda (x) (list (coerce (car x) 'fixnum)
(coerce (cadr x) *floatpt*)
(coerce (caddr x) 'fixnum)))
'((1 -2 3)
(3 2 4)
(4 -1 2)
(2 4 1)
(2 3 3)))))
(multiple-value-bind (n distance next-vertex)
(floyd-warshall example-graph)
(princ " pair distance path")
(terpri)
(princ "-------------------------------------")
(terpri)
(loop
for u from 1 to n
do (loop
for v from 1 to n
do (unless (= u v)
(format
t " ~A ~7@A ~A~%"
(directed-vertex-list-to-string (list u v))
(if (= (arr-ref next-vertex u v) nil-vertex)
" no path"
(write-to-string (arr-ref distance u v)))
(directed-vertex-list-to-string
(find-path next-vertex u v)))))))))
;;;-------------------------------------------------------------------
;;; vim: set ft=lisp lisp:</syntaxhighlight>
{{out}}
<pre>$ ./floyd-warshall.ros
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|D}}==
{{trans|Java}}
<
void main() {
Line 707 ⟶ 2,075:
}
}
}</
{{out}}
Line 726 ⟶ 2,094:
=={{header|EchoLisp}}==
Transcription of the Floyd-Warshall algorithm, with best path computation.
<
(lib 'matrix)
Line 768 ⟶ 2,136:
(array-print dist) ;; show init distances
(floyd-with-path n dist next))
</syntaxhighlight>
{{out}}
<pre>
Line 807 ⟶ 2,175:
=={{header|Elixir}}==
<
def main(n, edge) do
{dist, next} = setup(n, edge)
Line 850 ⟶ 2,218:
edge = [{1, 3, -2}, {2, 1, 4}, {2, 3, 3}, {3, 4, 2}, {4, 2, -1}]
Floyd_Warshall.main(4, edge)</
{{out}}
Line 871 ⟶ 2,239:
=={{header|F_Sharp|F#}}==
===Floyd's algorithm===
<
//Floyd's algorithm: Nigel Galloway August 5th 2018
let Floyd (n:'a[]) (g:Map<('a*'a),int>)= //nodes graph(Map of adjacency list)
Line 887 ⟶ 2,255:
|_->yield None}
yield! fN x y |> Seq.choose id; yield y}))
</syntaxhighlight>
===The Task===
<
let fW=Map[((1,3),-2);((3,4),2);((4,2),-1);((2,1),4);((2,3),3)]
let N,G=Floyd [|1..4|] fW
List.allPairs [1..4] [1..4]|>List.filter(fun (n,g)->n<>g)|>List.iter(fun (n,g)->printfn "%d->%d %d %A" n g N.[(n,g)] (n::(List.ofSeq (G n g))))
</syntaxhighlight>
{{out}}
<pre>
Line 916 ⟶ 2,284:
<
use, intrinsic :: ieee_arithmetic
Line 1,068 ⟶ 2,436:
end do
end program floyd_warshall_task</
{{out}}
Line 1,089 ⟶ 2,457:
=={{header|FreeBASIC}}==
{{trans|Java}}
<
Const POSITIVE_INFINITY As Double = 1.0/0.0
Line 1,150 ⟶ 2,518:
Print
Print "Press any key to quit"
Sleep</
{{out}}
Line 1,170 ⟶ 2,538:
=={{header|Go}}==
<
import (
Line 1,282 ⟶ 2,650:
}
}
}</
{{out}}
<pre>
Line 1,302 ⟶ 2,670:
=={{header|Groovy}}==
{{trans|Java}}
<
static void main(String[] args) {
int[][] weights = [[1, 3, -2], [2, 1, 4], [2, 3, 3], [3, 4, 2], [4, 2, -1]]
Line 1,362 ⟶ 2,730:
}
}
}</
{{out}}
<pre>pair dist path
Line 1,381 ⟶ 2,749:
Necessary imports
<
import Data.List (union)
import Data.Map hiding (foldr, union)
import Data.Maybe (fromJust, isJust)
import Data.Semigroup
import Prelude hiding (lookup, filter)</
First we define a general datatype to represent the shortest path. Type <code>a</code> represents a distance. It could be a number, in case of weighted graph or boolean value for just a directed graph. Type <code>b</code> goes for vertice labels (integers, chars, strings...)
<
deriving Show</
Next we note that shortest paths form a semigroup with following "addition" rule:
<
a <> b = case distance a `compare` distance b of
GT -> b
LT -> a
EQ -> a { path = path a `union` path b }</
It finds minimal path by <code>distance</code>, and in case of equal distances joins both paths. We will lift this semigroup to monoid using <code>Maybe</code> wrapper.
Line 1,406 ⟶ 2,774:
Now we are ready to define the main part of the Floyd-Warshall algorithm, which processes properly prepared distance table <code>dist</code> for given list of vertices <code>v</code>:
<
where
innerCycle k dist = (newDist <$> v <*> v) `setTo` dist
Line 1,415 ⟶ 2,783:
return $ Shortest (distance a <> distance b) (path a))
setTo = unionWith (<>) . fromList</
The <code>floydWarshall</code> produces only first steps of shortest paths. Whole paths are build by following function:
<
where
buildPath (i,j)
Line 1,425 ⟶ 2,793:
| otherwise = do k <- path $ fromJust $ lookup (i,j) d
p <- buildPath (k,j)
[i : p]</
All pre- and postprocessing is done by the main function <code>findMinDistances</code>:
<
let weights = mapWithKey (\(_,j) w -> Shortest w [j]) g
trivial = fromList [ ((i,i), Shortest mempty []) | i <- v ]
clean d = fromJust <$> filter isJust (d \\ trivial)
in buildPaths $ clean $ floydWarshall v (weights <> trivial)</
'''Examples''':
The sample graph:
<
,((2,3), 3)
,((1,3), -2)
,((3,4), 2)
,((4,2), -1)]</
the helper function
<
{{Out}}
Line 1,494 ⟶ 2,862:
Graph labeled by chars:
<
,(('A','D'), -1)
,(('S','E'), 2)
,(('D','E'), 4)]</
<pre>λ> showShortestPaths "ASDE" (Sum <$> g2)
Line 1,511 ⟶ 2,879:
<
# Floyd-Warshall algorithm.
#
Line 1,627 ⟶ 2,995:
every e := !edges do m := max (m, e[1], e[3])
return m
end</
{{out}}
Line 1,648 ⟶ 3,016:
=={{header|J}}==
<
for_j. i.#y do.
y=. y <. j ({"1 +/ {) y
end.
)</
Alternate implementation (same behavior):
<syntaxhighlight lang=J>floyd=: ]F..(]<.{"1+/{) i.@#</syntaxhighlight>
Example use:
<
0 _ _2 _ NB. 1->3 costs _2
4 0 3 _ NB. 2->1 costs 4; 2->3 costs 3
Line 1,667 ⟶ 3,039:
4 0 2 4
5 1 0 2
3 _1 1 0</
The graph matrix holds the costs of each directed node. Row index corresponds to starting node. Column index corresponds to ending node. Unconnected nodes have infinite cost.
Line 1,677 ⟶ 3,049:
This draft task currently asks for path reconstruction, which is a different (related) algorithm:
<
n=. ($y)$_(I._=,y)},($$i.@#)y
for_j. i.#y do.
Line 1,709 ⟶ 3,081:
end.
i.0 0
)</
Draft output:
<
pair dist path
1->2 _1 1->3->4->2
Line 1,726 ⟶ 3,098:
4->1 3 4->2->1
4->2 _1 4->2
4->3 1 4->2->1->3</
=={{header|Java}}==
<
import java.util.Arrays;
Line 1,786 ⟶ 3,158:
}
}
}</
<pre>pair dist path
1 -> 2 -1 1 -> 3 -> 4 -> 2
Line 1,802 ⟶ 3,174:
=={{header|JavaScript}}==
Using output code translated from the Lua sample.
<syntaxhighlight lang
let numVertices = 4;
let weights = [ [ 1, 3, -2 ], [ 2, 1, 4 ], [ 2, 3, 3 ], [ 3, 4, 2 ], [ 4, 2, -1 ] ];
let graph = [];
for (let i = 0; i < numVertices; ++i) {
graph.push([]);
for (let j = 0; j <
graph[i].push(i == j ? 0 : 9999999);
}
for (let i =
let w = weights[i];
graph[w[0] - 1][w[1] - 1] = w[2];
}
let nxt = [];
nxt.push([]);
for (let j =
}
for (let k = 0; k < numVertices; ++k) {
for (let i = 0; i < numVertices; ++i) {
for (let j = 0; j < numVertices; ++j) {
if (graph[i][j] > graph[i][k] + graph[k][j]) {
graph[i][j] = graph[i][k] + graph[k][j];
nxt[i][j] = nxt[i][k];
}
}
}
}
console.log(
for (let i = 0; i < numVertices; ++i) {
for (let j = 0; j < numVertices; ++j) {
if (i != j) {
let u = i + 1;
let v = j + 1;
let path = u + " -> " + v + " " + graph[i][j].toString().padStart(2) + " " + u;
do {
u = nxt[u - 1][v - 1];
path = path + " -> " + u;
} while (u != v);
console.log(path)
}
}
}
</syntaxhighlight>
{{out}}
<pre>
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
</pre>
=={{header|jq}}==
{{works with|jq|1.5}}
In this section, we represent the graph by a JSON object giving the weights: if u and v are the (string) labels of two nodes connected with an arrow from u to v, then .[u][v] is the associated weight:
<syntaxhighlight lang="jq">
def weights: {
"1": {"3": -2},
Line 1,834 ⟶ 3,252:
"3": {"4": 2},
"4": {"2": -1}
};</
The algorithm given here is a direct implementation of the definitional algorithm:
<
. as $weights
| keys_unsorted as $nodes
Line 1,857 ⟶ 3,275:
weights | fwi</
{{out}}
<pre>{
Line 1,888 ⟶ 3,306:
=={{header|Julia}}==
{{trans|Java}}
<
# v0.6
Line 1,925 ⟶ 3,343:
end
floydwarshall([1 3 -2; 2 1 4; 2 3 3; 3 4 2; 4 2 -1], 4)</
=={{header|Kotlin}}==
{{trans|Java}}
<
object FloydWarshall {
Line 1,986 ⟶ 3,404:
val nVertices = 4
FloydWarshall.doCalcs(weights, nVertices)
}</
{{out}}
Line 2,007 ⟶ 3,425:
=={{header|Lua}}==
{{trans|D}}
<
print("pair dist path")
for i=0, #nxt do
Line 2,071 ⟶ 3,489:
}
numVertices = 4
floydWarshall(weights, numVertices)</
{{out}}
<pre>pair dist path
Line 2,089 ⟶ 3,507:
=={{header|Mathematica}} / {{header|Wolfram Language}}==
<
4 \[DirectedEdge] 2, 2 \[DirectedEdge] 1, 2 \[DirectedEdge] 3},
EdgeWeight -> {(1 \[DirectedEdge] 3) -> -2, (3 \[DirectedEdge] 4) ->
Line 2,100 ⟶ 3,518:
Catenate[
Table[{vl[[i]], vl[[j]], dm[[i, j]]}, {i, Length[vl]}, {j,
Length[vl]}]], {x_, x_, _}]]]</
{{out}}
<pre>1 2 -1.
Line 2,115 ⟶ 3,533:
4 3 1.</pre>
=={{header|Mercury}}==
{{trans|Scheme}}
{{works with|Mercury|20.06.1}}
<syntaxhighlight lang="mercury">:- module floyd_warshall_task.
:- interface.
:- import_module io.
:- pred main(io, io).
:- mode main(di, uo) is det.
:- implementation.
:- import_module float.
:- import_module int.
:- import_module list.
:- import_module string.
:- import_module version_array2d.
%%%-------------------------------------------------------------------
%% Square arrays with 1-based indexing.
:- func arr_init(int, T) = version_array2d(T).
arr_init(N, Fill) = version_array2d.init(N, N, Fill).
:- func arr_get(version_array2d(T), int, int) = T.
arr_get(Arr, I, J) = Elem :-
I1 = I - 1,
J1 = J - 1,
Elem = Arr^elem(I1, J1).
:- func arr_set(version_array2d(T), int, int, T) = version_array2d(T).
arr_set(Arr0, I, J, Elem) = Arr :-
I1 = I - 1,
J1 = J - 1,
Arr = (Arr0^elem(I1, J1) := Elem).
%%%-------------------------------------------------------------------
:- func find_max_vertex(list({int, float, int})) = int.
find_max_vertex(Edges) = find_max_vertex_(Edges, 0).
:- func find_max_vertex_(list({int, float, int}), int) = int.
find_max_vertex_([], MaxVertex0) = MaxVertex0.
find_max_vertex_([{U, _, V} | Tail], MaxVertex0) = MaxVertex :-
MaxVertex = find_max_vertex_(Tail, max(max(MaxVertex0, U), V)).
%%%-------------------------------------------------------------------
:- func arbitrary_float = float.
arbitrary_float = (12345.0).
:- func nil_vertex = int.
nil_vertex = 0.
:- func floyd_warshall(list({int, float, int})) =
{int, version_array2d(float), version_array2d(int)}.
floyd_warshall(Edges) = {N, Dist, Next} :-
N = find_max_vertex(Edges),
Dist0 = arr_init(N, arbitrary_float),
Next0 = arr_init(N, nil_vertex),
(if (N = 0) then (Dist = Dist0,
Next = Next0)
else ({Dist1, Next1} = floyd_warshall_initialize(Edges, N,
Dist0, Next0),
{Dist, Next} = floyd_warshall_loop_k(N, 1, Dist1, Next1))).
:- func floyd_warshall_initialize(list({int, float, int}),
int,
version_array2d(float),
version_array2d(int)) =
{version_array2d(float), version_array2d(int)}.
floyd_warshall_initialize(Edges, N, Dist0, Next0) = {Dist1, Next1} :-
floyd_warshall_read_edges(Edges, Dist0, Next0) = {D1, X1},
floyd_warshall_diagonals(N, 1, D1, X1) = {Dist1, Next1}.
:- func floyd_warshall_read_edges(list({int, float, int}),
version_array2d(float),
version_array2d(int)) =
{version_array2d(float), version_array2d(int)}.
floyd_warshall_read_edges([], Dist0, Next0) = {Dist0, Next0}.
floyd_warshall_read_edges([{U, Weight, V} | Tail],
Dist0, Next0) = {Dist1, Next1} :-
D1 = arr_set(Dist0, U, V, Weight),
X1 = arr_set(Next0, U, V, V),
floyd_warshall_read_edges(Tail, D1, X1) = {Dist1, Next1}.
:- func floyd_warshall_diagonals(int, int,
version_array2d(float),
version_array2d(int)) =
{version_array2d(float), version_array2d(int)}.
floyd_warshall_diagonals(N, I, Dist0, Next0) = {Dist1, Next1} :-
N1 = N + 1,
(if (I = N1) then (Dist1 = Dist0,
Next1 = Next0)
else (
%% The distance from a vertex to itself = 0.0.
D1 = arr_set(Dist0, I, I, 0.0),
X1 = arr_set(Next0, I, I, I),
I1 = I + 1,
floyd_warshall_diagonals(N, I1, D1, X1) = {Dist1, Next1})).
:- func floyd_warshall_loop_k(int, int,
version_array2d(float),
version_array2d(int)) =
{version_array2d(float), version_array2d(int)}.
floyd_warshall_loop_k(N, K, Dist0, Next0) = {Dist1, Next1} :-
N1 = N + 1,
(if (K = N1) then (Dist1 = Dist0,
Next1 = Next0)
else ({D1, X1} = floyd_warshall_loop_i(N, K, 1, Dist0, Next0),
K1 = K + 1,
{Dist1, Next1} = floyd_warshall_loop_k(N, K1, D1, X1))).
:- func floyd_warshall_loop_i(int, int, int,
version_array2d(float),
version_array2d(int)) =
{version_array2d(float), version_array2d(int)}.
floyd_warshall_loop_i(N, K, I, Dist0, Next0) = {Dist1, Next1} :-
N1 = N + 1,
(if (I = N1) then (Dist1 = Dist0,
Next1 = Next0)
else ({D1, X1} = floyd_warshall_loop_j(N, K, I, 1, Dist0, Next0),
I1 = I + 1,
{Dist1, Next1} = floyd_warshall_loop_i(N, K, I1, D1, X1))).
:- func floyd_warshall_loop_j(int, int, int, int,
version_array2d(float),
version_array2d(int)) =
{version_array2d(float), version_array2d(int)}.
floyd_warshall_loop_j(N, K, I, J, Dist0, Next0) = {Dist1, Next1} :-
J1 = J + 1,
N1 = N + 1,
(if (J = N1) then (Dist1 = Dist0,
Next1 = Next0)
else (if ((arr_get(Next0, I, K) = nil_vertex);
(arr_get(Next0, K, J) = nil_vertex))
then ({Dist1, Next1} =
floyd_warshall_loop_j(N, K, I, J1, Dist0, Next0))
else (Dist_ikj = arr_get(Dist0, I, K) + arr_get(Dist0, K, J),
(if (arr_get(Next0, I, J) = nil_vertex;
Dist_ikj < arr_get(Dist0, I, J))
then (D1 = arr_set(Dist0, I, J, Dist_ikj),
X1 = arr_set(Next0, I, J, arr_get(Next0, I, K)),
{Dist1, Next1} =
floyd_warshall_loop_j(N, K, I, J1, D1, X1))
else ({Dist1, Next1} =
floyd_warshall_loop_j(N, K, I, J1,
Dist0, Next0)))))).
%%%-------------------------------------------------------------------
:- func path_string(version_array2d(int), int, int) = string.
path_string(Next, U, V) = S :-
if (arr_get(Next, U, V) = nil_vertex) then S = ""
else S = path_string_(Next, U, V, int_to_string(U)).
:- func path_string_(version_array2d(int), int, int, string) = string.
path_string_(Next, U, V, S0) = S :-
(if (U = V) then (S = S0)
else (U1 = arr_get(Next, U, V),
S1 = append(append(S0, " -> "), int_to_string(U1)),
path_string_(Next, U1, V, S1) = S)).
%%%-------------------------------------------------------------------
main(!IO) :-
Example_graph = [{1, -2.0, 3},
{3, 2.0, 4},
{4, -1.0, 2},
{2, 4.0, 1},
{2, 3.0, 3}],
{N, Dist, Next} = floyd_warshall(Example_graph),
format(" pair distance path\n", [], !IO),
format("-------------------------------------\n", [], !IO),
main_loop_u(N, 1, Dist, Next, !IO).
:- pred main_loop_u(int, int,
version_array2d(float),
version_array2d(int),
io, io).
:- mode main_loop_u(in, in, in, in, di, uo) is det.
main_loop_u(N, U, Dist, Next, !IO) :-
N1 = N + 1,
(if (U = N1) then true
else (main_loop_v(N, U, 1, Dist, Next, !IO),
U1 = U + 1,
main_loop_u(N, U1, Dist, Next, !IO))).
:- pred main_loop_v(int, int, int,
version_array2d(float),
version_array2d(int),
io, io).
:- mode main_loop_v(in, in, in, in, in, di, uo) is det.
main_loop_v(N, U, V, Dist, Next, !IO) :-
V1 = V + 1,
N1 = N + 1,
(if (V = N1) then true
else if (U = V) then main_loop_v(N, U, V1, Dist, Next, !IO)
else (format(" %d -> %d %4.1f %s\n",
[i(U), i(V), f(arr_get(Dist, U, V)),
s(path_string(Next, U, V))],
!IO),
main_loop_v(N, U, V1, Dist, Next, !IO))).
%%%-------------------------------------------------------------------
%%% local variables:
%%% mode: mercury
%%% prolog-indent-width: 2
%%% end:</syntaxhighlight>
{{out}}
<pre>$ mmc floyd_warshall_task.m && ./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|Modula-2}}==
<
FROM FormatString IMPORT FormatString;
FROM SpecialReals IMPORT Infinity;
Line 2,201 ⟶ 3,848:
ReadChar
END FloydWarshall.</
=={{header|Nim}}==
{{trans|D}}
<
type
Line 2,259 ⟶ 3,906:
let numVertices = 4
floydWarshall(weights, numVertices)</
{{out}}
Line 2,280 ⟶ 3,927:
The only changes needed from [[#Icon|the classical Icon]] were in library linkage and code order. (The '''record''' definition had to come ''after'' the library linkages.)
Certainly there are better ways to write an Object Icon implementation (for example, using a class instead of '''record'''), but this helps show that most of the classical dialect is still there.
<
# Floyd-Warshall algorithm.
#
Line 2,398 ⟶ 4,047:
every e := !edges do m := max (m, e[1], e[3])
return m
end</
{{out}}
<pre>$ oiscript floyd-warshall-in-OI.icn
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|OCaml}}==
{{trans|ATS}}
This implementation was written by referring frequently to [[#ATS|the ATS]], but differs from it considerably. For example, it assumes IEEE floating point, whereas the ATS purposely avoided that assumption. However, the "square array" and "edge" types are very similar to the ATS equivalents.
<syntaxhighlight lang="ocaml">(*
Floyd-Warshall algorithm.
See https://en.wikipedia.org/w/index.php?title=Floyd%E2%80%93Warshall_algorithm&oldid=1082310013
*)
module Square_array =
(* Square arrays with 1-based indexing. *)
struct
type 'a t =
{
n : int;
r : 'a Array.t
}
let make n fill =
let r = Array.make (n * n) fill in
{ n = n; r = r }
let get arr (i, j) =
Array.get arr.r ((i - 1) + (arr.n * (j - 1)))
let set arr (i, j) x =
Array.set arr.r ((i - 1) + (arr.n * (j - 1))) x
end
module Vertex =
(* A vertex is a positive integer, or 0 for the nil object. *)
struct
type t = int
let nil = 0
let print_vertex u =
print_int u
let rec print_directed_list lst =
match lst with
| [] -> ()
| [u] -> print_vertex u
| u :: tail ->
begin
print_vertex u;
print_string " -> ";
print_directed_list tail
end
end
module Edge =
(* A graph edge. *)
struct
type t =
{
u : Vertex.t;
weight : Float.t;
v : Vertex.t
}
let make u weight v =
{ u = u; weight = weight; v = v }
end
module Paths =
(* The "next vertex" array and its operations. *)
struct
type t = Vertex.t Square_array.t
let make n =
Square_array.make n Vertex.nil
let get = Square_array.get
let set = Square_array.set
let path paths u v =
(* Path reconstruction. In the finest tradition of the standard
List module, this implementation is *not* tail recursive. *)
if Square_array.get paths (u, v) = Vertex.nil then
[]
else
let rec build_path paths u v =
if u = v then
[v]
else
let i = Square_array.get paths (u, v) in
u :: build_path paths i v
in
build_path paths u v
let print_path paths u v =
Vertex.print_directed_list (path paths u v)
end
module Distances =
(* The "distance" array and its operations. *)
struct
type t = Float.t Square_array.t
let make n =
Square_array.make n Float.infinity
let get = Square_array.get
let set = Square_array.set
end
let find_max_vertex edges =
(* This implementation is *not* tail recursive. *)
let rec find_max =
function
| [] -> Vertex.nil
| edge :: tail -> max (max Edge.(edge.u) Edge.(edge.v))
(find_max tail)
in
find_max edges
let floyd_warshall edges =
(* This implementation assumes IEEE floating point. The OCaml Float
module explicitly specifies 64-bit IEEE floating point. *)
let _ = assert (edges <> []) in
let n = find_max_vertex edges in
let dist = Distances.make n in
let next = Paths.make n in
let rec read_edges =
function
| [] -> ()
| edge :: tail ->
let u = Edge.(edge.u) in
let v = Edge.(edge.v) in
let weight = Edge.(edge.weight) in
begin
Distances.set dist (u, v) weight;
Paths.set next (u, v) v;
read_edges tail
end
in
begin
(* Initialization. *)
read_edges edges;
for i = 1 to n do
(* Distance from a vertex to itself = 0.0 *)
Distances.set dist (i, i) 0.0;
Paths.set next (i, i) i
done;
(* Perform the algorithm. *)
for k = 1 to n do
for i = 1 to n do
for j = 1 to n do
let dist_ij = Distances.get dist (i, j) in
let dist_ik = Distances.get dist (i, k) in
let dist_kj = Distances.get dist (k, j) in
let dist_ikj = dist_ik +. dist_kj in
if dist_ikj < dist_ij then
begin
Distances.set dist (i, j) dist_ikj;
Paths.set next (i, j) (Paths.get next (i, k))
end
done
done
done;
(* Return the results, as a 3-tuple. *)
(n, dist, next)
end
let example_graph =
[Edge.make 1 (-2.0) 3;
Edge.make 3 (+2.0) 4;
Edge.make 4 (-1.0) 2;
Edge.make 2 (+4.0) 1;
Edge.make 2 (+3.0) 3]
;;
let (n, dist, next) =
floyd_warshall example_graph
;;
print_string " pair distance path";
print_newline ();
print_string "---------------------------------------";
print_newline ();
for u = 1 to n do
for v = 1 to n do
if u <> v then
begin
print_string " ";
Vertex.print_directed_list [u; v];
print_string " ";
Printf.printf "%4.1f" (Distances.get dist (u, v));
print_string " ";
Paths.print_path next u v;
print_newline ()
end
done
done
;;</syntaxhighlight>
{{out}}
<pre>$ ocamlopt floyd_warshall_task.ml && ./a.out
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|Perl}}==
<
my $edges = shift;
my (@dist, @seq);
Line 2,452 ⟶ 4,350:
my $graph = [[1, 3, -2], [2, 1, 4], [2, 3, 3], [3, 4, 2], [4, 2, -1]];
FloydWarshall($graph);</
{{out}}
<pre>pair dist path
Line 2,470 ⟶ 4,368:
=={{header|Phix}}==
Direct translation of the wikipedia pseudocode
<!--<
<span style="color: #008080;">constant</span> <span style="color: #000000;">inf</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">1e300</span><span style="color: #0000FF;">*</span><span style="color: #000000;">1e300</span>
Line 2,518 ⟶ 4,416:
<span style="color: #008080;">constant</span> <span style="color: #000000;">weights</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{{</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">3</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">2</span><span style="color: #0000FF;">},</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">2</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">4</span><span style="color: #0000FF;">},</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">2</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">3</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">3</span><span style="color: #0000FF;">},</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">3</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">4</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">2</span><span style="color: #0000FF;">},</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">4</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">2</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">}}</span>
<span style="color: #000000;">FloydWarshall</span><span style="color: #0000FF;">(</span><span style="color: #000000;">V</span><span style="color: #0000FF;">,</span><span style="color: #000000;">weights</span><span style="color: #0000FF;">)</span>
<!--</
{{out}}
<pre>
Line 2,537 ⟶ 4,435:
=={{header|PHP}}==
<
$graph = array();
for ($i = 0; $i < 10; ++$i) {
Line 2,559 ⟶ 4,457:
print_r($graph);
?></
=={{header|Prolog}}==
Works with SWI-Prolog as of Jan 2019
<
path(List, To, From, [From], W) :-
Line 2,589 ⟶ 4,487:
find_path(D, From, To, Path, Weight),(
atomic_list_concat(Path, ' -> ', PPath),
format('~p -> ~p\t ~p\t~w~n', [From, To, Weight, PPath]))).</
{{output}}
<pre>?- print_all_paths.
Line 2,611 ⟶ 4,509:
=={{header|Python}}==
{{trans|Ruby}}
<
from itertools import product
Line 2,639 ⟶ 4,537:
if __name__ == '__main__':
floyd_warshall(4, [[1, 3, -2], [2, 1, 4], [2, 3, 3], [3, 4, 2], [4, 2, -1]])</
{{output}}
Line 2,658 ⟶ 4,556:
=={{header|Racket}}==
{{trans|EchoLisp}}
<
(require math/array)
Line 2,733 ⟶ 4,631:
(mdist dist+ 1 3)
(path next+ 7 6)
(path next+ 6 7))</
{{out}}
Line 2,778 ⟶ 4,676:
{{trans|Ruby}}
<syntaxhighlight lang="raku"
my @dist = [0, |(Inf xx $n-1)], *.Array.rotate(-1) … !*[*-1];
my @next = [0 xx $n] xx $n;
Line 2,804 ⟶ 4,702:
}
Floyd-Warshall(4, [[1, 3, -2], [2, 1, 4], [2, 3, 3], [3, 4, 2], [4, 2, -1]]);</
{{out}}
<pre> Pair Distance Path
Line 2,820 ⟶ 4,718:
4 → 3 1 4 → 2 → 1 → 3
</pre>
=={{header|RATFOR}}==
{{trans|Fortran}}
{{works with|ratfor77|[https://sourceforge.net/p/chemoelectric/ratfor77/ public domain 1.0]}}
{{works with|gfortran|11.3.0}}
{{works with|f2c|20100827}}
<syntaxhighlight lang="ratfor">#
# Floyd-Warshall algorithm.
#
# See https://en.wikipedia.org/w/index.php?title=Floyd%E2%80%93Warshall_algorithm&oldid=1082310013
#
#
# A C programmer might take note that the most rapid stride in an
# array is on the *leftmost* index, rather than the *rightmost* as in
# C.
#
# (In other words, Fortran has "column-major order", whereas C has
# "row-major order". I prefer to think of it in terms of strides. For
# one thing, in my opinion, which index is for a "column" and which
# for a "row" should be considered arbitrary unless dictated by
# context.)
#
# VLIMIT = the maximum number of vertices the program can handle.
define(VLIMIT, 100)
# NILVTX = the nil vertex.
define(NILVTX, 0)
# STRSZ = a buffer size used in some character-handling routines.
define(STRSZ, 300)
# BUFSZ = a buffer size used in some character-handling routines.
define(BUFSZ, 20)
function maxvtx (numedg, edges)
# Find the maximum vertex number.
implicit none
integer numedg
real edges(1:3, 1:numedg) # Notice Fortran's column-major order!
integer maxvtx
integer n, i
n = 1
for (i = 1; i <= numedg; i = i + 1)
{
n = max (n, int (edges(1, i)))
n = max (n, int (edges(3, i)))
}
maxvtx = n
end
subroutine floyd (numedg, edges, n, dist, nxtvtx)
# Floyd-Warshall.
implicit none
integer numedg
real edges(1:3, 1:numedg) # Notice Fortran's column-major order!
integer n
real dist(1:VLIMIT, 1:VLIMIT)
integer nxtvtx(1:VLIMIT, 1:VLIMIT)
#
# This implementation does NOT initialize elements of "dist" that
# would be set "infinite" in the original Fortran 90. Such elements
# are left uninitialized. Instead you should use the "nxtvtx" array
# to determine whether there exists a finite path from one vertex to
# another.
#
# See also the Icon and Object Icon implementations that use "&null"
# as a stand-in for "infinity". This implementation is similar to
# those. In this Ratfor, the nil entry in "nxtvtx" is used instead
# of one in "dist".
#
integer i, j, k
integer u, v
real dstikj
# Initialization.
for (i = 1; i <= n; i = i + 1)
for (j = 1; j <= n; j = j + 1)
nxtvtx(i, j) = NILVTX
for (i = 1; i <= numedg; i = i + 1)
{
u = int (edges(1, i))
v = int (edges(3, i))
dist(u, v) = edges(2, i)
nxtvtx(u, v) = v
}
for (i = 1; i <= n; i = i + 1)
{
dist(i, i) = 0.0 # Distance from a vertex to itself.
nxtvtx(i, i) = i
}
# Perform the algorithm.
for (k = 1; k <= n; k = k + 1)
for (i = 1; i <= n; i = i + 1)
for (j = 1; j <= n; j = j + 1)
if (nxtvtx(i, k) != NILVTX && nxtvtx(k, j) != NILVTX)
{
dstikj = dist(i, k) + dist(k, j)
if (nxtvtx(i, j) == NILVTX)
{
dist(i, j) = dstikj
nxtvtx(i, j) = nxtvtx(i, k)
}
else if (dstikj < dist(i, j))
{
dist(i, j) = dstikj
nxtvtx(i, j) = nxtvtx(i, k)
}
}
end
subroutine cpy (chr, str, j)
# A helper subroutine for pthstr.
implicit none
character*BUFSZ chr
character str*STRSZ
integer j
integer i
i = 1
while (chr(i:i) == ' ')
{
if (i == BUFSZ)
{
write (*, *) "character* boundary exceeded in cpy"
stop
}
i = i + 1
}
while (i <= BUFSZ)
{
if (STRSZ < j)
{
write (*, *) "character* boundary exceeded in cpy"
stop
}
str(j:j) = chr(i:i)
j = j + 1
i = i + 1
}
end
subroutine pthstr (nxtvtx, u, v, str, k)
# Construct a string for a path from u to v. Start at str(k).
implicit none
integer nxtvtx(1:VLIMIT, 1:VLIMIT)
integer u, v
character str*STRSZ
integer k
integer i, j
character*BUFSZ chr
character*25 fmt10
character*25 fmt20
write (fmt10, '(''(I'', I15, '')'')') BUFSZ - 1
write (fmt20, '(''(A'', I15, '')'')') BUFSZ
if (nxtvtx(u, v) != NILVTX)
{
j = k
i = u
chr = ' '
write (chr, fmt10) i
call cpy (chr, str, j)
while (i != v)
{
write (chr, fmt20) "-> "
call cpy (chr, str, j)
i = nxtvtx(i, v)
write (chr, fmt10) i
call cpy (chr, str, j)
}
}
end
function trimr (str)
# Find the length of a character*, if one ignores trailing spaces.
implicit none
character str*STRSZ
integer trimr
logical done
trimr = STRSZ
done = .false.
while (!done)
{
if (trimr == 0)
done = .true.
else if (str(trimr:trimr) != ' ')
done = .true.
else
trimr = trimr - 1
}
end
program demo
implicit none
integer maxvtx
integer trimr
integer exmpsz
real exampl(1:3, 1:5)
integer n
real dist(1:VLIMIT, 1:VLIMIT)
integer nxtvtx(1:VLIMIT, 1:VLIMIT)
character str*STRSZ
integer u, v
integer j
exmpsz = 5
data exampl / 1, -2.0, 3, _
3, +2.0, 4, _
4, -1.0, 2, _
2, +4.0, 1, _
2, +3.0, 3 /
n = maxvtx (exmpsz, exampl)
call floyd (exmpsz, exampl, n, dist, nxtvtx)
1000 format (I2, ' ->', I2, 5X, F4.1, 6X)
write (*, '('' pair distance path'')')
write (*, '(''---------------------------------------'')')
for (u = 1; u <= n; u = u + 1)
for (v = 1; v <= n; v = v + 1)
if (u != v)
{
str = ' '
write (str, 1000) u, v, dist(u, v)
call pthstr (nxtvtx, u, v, str, 23)
write (* , '(1000A1)') (str(j:j), j = 1, trimr (str))
}
end</syntaxhighlight>
{{out}}
I get slightly different output, depending on whether I use gfortran or f2c to compile the generated FORTRAN code. The two outputs differ in how 0.0 is printed.
First gfortran:
<pre>$ ratfor77 -6x floyd_warshall_task.r > floyd_warshall_task.f && gfortran -std=legacy floyd_warshall_task.f && ./a.out
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>
Now f2c:
<pre>$ ratfor77 -6x floyd_warshall_task.r > floyd_warshall_task.f && f2c floyd_warshall_task.f && cc floyd_warshall_task.c -lf2c && ./a.out
floyd_warshall_task.f:
maxvtx:
floyd:
cpy:
pthstr:
trimr:
MAIN demo:
pair distance path
---------------------------------------
1 -> 2 -1.0 1 -> 3 -> 4 -> 2
1 -> 3 -2.0 1 -> 3
1 -> 4 .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|REXX}}==
<
v= 4 /*███ {1} ███*/ /*number of vertices in weighted graph.*/
@.= 99999999 /*███ 4 / \ -2 ███*/ /*the default distance (edge weight). */
Line 2,847 ⟶ 5,051:
say $ center(f '───►' t, w) right(@.f.t, w % 2)
end /*t*/ /* [↑] the distance between 2 vertices*/
end /*f*/ /*stick a fork in it, we're all done. */</
{{out|output|text= when using the default inputs:}}
<pre>
Line 2,868 ⟶ 5,072:
=={{header|Ruby}}==
<
dist = Array.new(n){|i| Array.new(n){|j| i==j ? 0 : Float::INFINITY}}
nxt = Array.new(n){Array.new(n)}
Line 2,902 ⟶ 5,106:
n = 4
edge = [[1, 3, -2], [2, 1, 4], [2, 3, 3], [3, 4, 2], [4, 2, -1]]
floyd_warshall(n, edge)</
{{out}}
Line 2,927 ⟶ 5,131:
and it requires no special value for infinity.
<
#[derive(Clone, Debug, PartialEq, Eq, Hash)]
Line 3,140 ⟶ 5,344:
print_results(&weights, paths.as_ref(), |index| index + 1);
}
</syntaxhighlight>
{{out}}
Line 3,156 ⟶ 5,360:
4 -> 2: -1 4 -> 2
4 -> 3: 1 4 -> 2 -> 1 -> 3
</pre>
=={{header|Scala}}==
{{trans|Java}}
<syntaxhighlight lang="Scala">
import java.lang.String.format;
object FloydWarshall extends App {
val weights = Array(Array(1, 3, -2), Array(2, 1, 4), Array(2, 3, 3), Array(3, 4, 2), Array(4, 2, -1))
val numVertices = 4
floydWarshall(weights, numVertices)
def floydWarshall(weights: Array[Array[Int]], numVertices: Int): Unit = {
val dist = Array.fill(numVertices, numVertices)(Double.PositiveInfinity)
for (w <- weights)
dist(w(0) - 1)(w(1) - 1) = w(2)
val next = Array.ofDim[Int](numVertices, numVertices)
for (i <- 0 until numVertices; j <- 0 until numVertices if i != j)
next(i)(j) = j + 1
for {
k <- 0 until numVertices
i <- 0 until numVertices
j <- 0 until numVertices
if dist(i)(k) + dist(k)(j) < dist(i)(j)
} {
dist(i)(j) = dist(i)(k) + dist(k)(j)
next(i)(j) = next(i)(k)
}
printResult(dist, next)
}
def printResult(dist: Array[Array[Double]], next: Array[Array[Int]]): Unit = {
println("pair dist path")
for {
i <- 0 until next.length
j <- 0 until next.length if i != j
} {
var u = i + 1
val v = j + 1
var path = format("%d -> %d %2d %s", u, v,
(dist(i)(j)).toInt, u);
while (u != v) {
u = next(u - 1)(v - 1)
path += s" -> $u"
}
println(path)
}
}
}
</syntaxhighlight>
{{out}}
<pre>
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
</pre>
Line 3,163 ⟶ 5,440:
I have run this program successfully in Chibi, Gauche, and CHICKEN 5 Schemes. (One may need an extension to run R7RS code in CHICKEN.)
<
;;;
;;; See https://en.wikipedia.org/w/index.php?title=Floyd%E2%80%93Warshall_algorithm&oldid=1082310013
Line 3,300 ⟶ 5,577:
(display " ")
(display-path (find-path next-vertex u v))
(newline)))))</
{{out}}
Line 3,321 ⟶ 5,598:
=={{header|SequenceL}}==
{{trans|Go}}
<
import <Utilities/Math.sl>;
Line 3,377 ⟶ 5,654:
vertex(4, [arc(2,-1)])];
in
floydWarshall(graph);</
{{out}}
Line 3,386 ⟶ 5,663:
=={{header|Sidef}}==
{{trans|Ruby}}
<
var dist = n.of {|i| n.of { |j| i == j ? 0 : Inf }}
var nxt = n.of { n.of(nil) }
Line 3,418 ⟶ 5,695:
var n = 4
var edge = [[1, 3, -2], [2, 1, 4], [2, 3, 3], [3, 4, 2], [4, 2, -1]]
print floyd_warshall(n, edge)</
{{out}}
<pre>
Line 3,435 ⟶ 5,712:
4 -> 3 1 4 -> 2 -> 1 -> 3
</pre>
=={{header|Standard ML}}==
{{trans|OCaml}}
{{works with|MLton|20210117}}
{{works with|Poly/ML|5.9}}
You have to comment out the call to '''main ()''' if you are using Poly/ML. The code as is works with MLton.
(Poly/ML is a separate compiler that, by itself, looks for a '''main''' function to start the program at.)
<syntaxhighlight 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;
(* 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: *)</syntaxhighlight>
{{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}}==
Line 3,442 ⟶ 6,074:
The implementation of Floyd-Warshall in tcllib is [https://core.tcl.tk/tcllib/finfo?name=modules/struct/graphops.tcl quite readable]; this example merely initialises a graph from an adjacency list then calls the tcllib code:
<
package require struct::graph
package require struct::graph::op
Line 3,472 ⟶ 6,104:
set paths [dict filter $paths value {[0-9]*}] ;# whose cost is not "Inf"
set paths [lsort -stride 2 -index 1 -real -decreasing $paths] ;# and print the longest first
puts $paths</
{{out}}
Line 3,479 ⟶ 6,111:
=={{header|Visual Basic .NET}}==
{{trans|C#}}
<
Sub PrintResult(dist As Double(,), nxt As Integer(,))
Line 3,541 ⟶ 6,173:
End Sub
End Module</
{{out}}
<pre>pair dist path
Line 3,560 ⟶ 6,192:
{{trans|Kotlin}}
{{libheader|Wren-fmt}}
<
class FloydWarshall {
Line 3,609 ⟶ 6,241:
var weights = [ [1, 3, -2], [2, 1, 4], [2, 3, 3], [3, 4, 2], [4, 2, -1] ]
var nVertices = 4
FloydWarshall.doCalcs(weights, nVertices)</
{{out}}
Line 3,629 ⟶ 6,261:
=={{header|zkl}}==
<
V:=dist[0].len();
next:=V.pump(List,V.pump(List,Void.copy).copy); // VxV matrix of Void
Line 3,650 ⟶ 6,282:
}
fcn printM(m){ m.pump(Console.println,rowFmt) }
fcn rowFmt(row){ ("%5s "*row.len()).fmt(row.xplode()) }</
<
dist:=V.pump(List,V.pump(List,Void.copy).copy); // VxV matrix of Void
foreach i in (V){ dist[i][i] = 0 } // zero vertexes
Line 3,671 ⟶ 6,303:
foreach u,v in (V,V){
if(p:=path(next,u,v)) p.println();
}</
{{out}}
<pre>
| |||