Floyd-Warshall algorithm: Difference between revisions

From Rosetta Code
Content added Content deleted
(Added Kotlin)
(Add Scala implementation)
 
(93 intermediate revisions by 27 users not shown)
Line 5: Line 5:
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.
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.


[[File:Floyd_warshall_graph.gif]]
[[File:Floyd_warshall_graph.gif|||center]]


Print the pair, the distance and (optionally) the path.
Print the pair, the distance and (optionally) the path.
Line 27: Line 27:
* [https://www.youtube.com/watch?v=8WSZQwNtXPU Floyd-Warshall Algorithm - step by step guide (youtube)]
* [https://www.youtube.com/watch?v=8WSZQwNtXPU Floyd-Warshall Algorithm - step by step guide (youtube)]
<br><br>
<br><br>

=={{header|11l}}==
{{trans|Python}}

<syntaxhighlight lang="11l">F floyd_warshall(n, edge)
V rn = 0 .< n
V dist = rn.map(i -> [1'000'000] * @n)
V nxt = rn.map(i -> [0] * @n)
L(i) rn
dist[i][i] = 0
L(u, v, w) edge
dist[u - 1][v - 1] = w
nxt[u - 1][v - 1] = v - 1
L(k, i, j) cart_product(rn, rn, rn)
V sum_ik_kj = dist[i][k] + dist[k][j]
I dist[i][j] > sum_ik_kj
dist[i][j] = sum_ik_kj
nxt[i][j] = nxt[i][k]
print(‘pair dist path’)
L(i, j) cart_product(rn, rn)
I i != j
V path = [i]
L path.last != j
path.append(nxt[path.last][j])
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)])</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|360 Assembly}}==
{{trans|Rexx}}
<syntaxhighlight lang="360asm">* Floyd-Warshall algorithm - 06/06/2018
FLOYDWAR CSECT
USING FLOYDWAR,R13 base register
B 72(R15) skip savearea
DC 17F'0' savearea
SAVE (14,12) save previous context
ST R13,4(R15) link backward
ST R15,8(R13) link forward
LR R13,R15 set addressability
MVC A+8,=F'-2' a(1,3)=-2
MVC A+VV*4,=F'4' a(2,1)= 4
MVC A+VV*4+8,=F'3' a(2,3)= 3
MVC A+VV*8+12,=F'2' a(3,4)= 2
MVC A+VV*12+4,=F'-1' a(4,2)=-1
LA R8,1 k=1
DO WHILE=(C,R8,LE,V) do k=1 to v
LA R10,A @a
LA R6,1 i=1
DO WHILE=(C,R6,LE,V) do i=1 to v
LA R7,1 j=1
DO WHILE=(C,R7,LE,V) do j=1 to v
LR R1,R6 i
BCTR R1,0
MH R1,=AL2(VV)
AR R1,R8 k
SLA R1,2
L R9,A-4(R1) a(i,k)
LR R1,R8 k
BCTR R1,0
MH R1,=AL2(VV)
AR R1,R7 j
SLA R1,2
L R3,A-4(R1) a(k,j)
AR R9,R3 w=a(i,k)+a(k,j)
L R2,0(R10) a(i,j)
IF CR,R2,GT,R9 THEN if a(i,j)>w then
ST R9,0(R10) a(i,j)=w
ENDIF , endif
LA R10,4(R10) next @a
LA R7,1(R7) j++
ENDDO , enddo j
LA R6,1(R6) i++
ENDDO , enddo i
LA R8,1(R8) k++
ENDDO , enddo k
LA R10,A @a
LA R6,1 f=1
DO WHILE=(C,R6,LE,V) do f=1 to v
LA R7,1 t=1
DO WHILE=(C,R7,LE,V) do t=1 to v
IF CR,R6,NE,R7 THEN if f^=t then do
LR R1,R6 f
XDECO R1,XDEC edit f
MVC PG+0(4),XDEC+8 output f
LR R1,R7 t
XDECO R1,XDEC edit t
MVC PG+8(4),XDEC+8 output t
L R2,0(R10) a(f,t)
XDECO R2,XDEC edit a(f,t)
MVC PG+12(4),XDEC+8 output a(f,t)
XPRNT PG,L'PG print
ENDIF , endif
LA R10,4(R10) next @a
LA R7,1(R7) t++
ENDDO , enddo t
LA R6,1(R6) f++
ENDDO , enddo f
L R13,4(0,R13) restore previous savearea pointer
RETURN (14,12),RC=0 restore registers from calling sav
VV EQU 4
V DC A(VV)
A DC (VV*VV)F'99999999' a(vv,vv)
PG DC CL80' . -> . .'
XDEC DS CL12
YREGS
END FLOYDWAR</syntaxhighlight>
{{out}}
<pre>
1 -> 2 -1
1 -> 3 -2
1 -> 4 0
2 -> 1 4
2 -> 3 2
2 -> 4 4
3 -> 1 5
3 -> 2 1
3 -> 4 2
4 -> 1 3
4 -> 2 -1
4 -> 3 1
</pre>

=={{header|Ada}}==
{{trans|Scheme}}


<syntaxhighlight lang="ada">--
-- Floyd-Warshall algorithm.
--
-- See https://en.wikipedia.org/w/index.php?title=Floyd%E2%80%93Warshall_algorithm&oldid=1082310013
--

with Ada.Containers.Vectors;
with Ada.Text_IO; use Ada.Text_IO;
with Interfaces; use Interfaces;

with Ada.Numerics.Generic_Elementary_Functions;

procedure floyd_warshall_task
is
Floyd_Warshall_Exception : exception;

-- The floating point type we shall use is one that has infinities.
subtype FloatPt is IEEE_Float_32;
package FloatPt_Elementary_Functions is new Ada.Numerics
.Generic_Elementary_Functions
(FloatPt);
use FloatPt_Elementary_Functions;

-- The following should overflow and give us an IEEE infinity. But I
-- have kept the code so you could use some non-IEEE floating point
-- format and set ENORMOUS_FloatPt to some value that is finite but
-- much larger than actual graph traversal distances.
ENORMOUS_FloatPt : constant FloatPt :=
(FloatPt (1.0) / FloatPt (1.0e-37))**1.0e37;

--
-- Input is a Vector of records representing the edges of a graph.
--
-- Vertices are identified by integers from 1 .. n.
--

type edge is record
u : Positive;
weight : FloatPt;
v : Positive;
end record;

package Edge_Vectors is new Ada.Containers.Vectors
(Index_Type => Positive, Element_Type => edge);
use Edge_Vectors;
subtype edge_vector is Edge_Vectors.Vector;

--
-- Floyd-Warshall.
--

type distance_array is
array (Positive range <>, Positive range <>) of FloatPt;

type next_vertex_array is
array (Positive range <>, Positive range <>) of Natural;
Nil_Vertex : constant Natural := 0;

function find_max_vertex -- Find the maximum vertex number.
(edges : in edge_vector)
return Positive
is
max_vertex : Positive;
begin
if Is_Empty (edges) then
raise Floyd_Warshall_Exception with "no edges";
end if;
max_vertex := 1;
for i in edges.First_Index .. edges.Last_Index loop
max_vertex := Positive'Max (max_vertex, edges.Element (i).u);
max_vertex := Positive'Max (max_vertex, edges.Element (i).v);
end loop;
return max_vertex;
end find_max_vertex;

procedure floyd_warshall -- Perform Floyd-Warshall.
(edges : in edge_vector;
max_vertex : in Positive;
distance : out distance_array;
next_vertex : out next_vertex_array)
is
u, v : Positive;
dist_ikj : FloatPt;
begin

-- Initialize.

for i in 1 .. max_vertex loop
for j in 1 .. max_vertex loop
distance (i, j) := ENORMOUS_FloatPt;
next_vertex (i, j) := Nil_Vertex;
end loop;
end loop;
for i in edges.First_Index .. edges.Last_Index loop
u := edges.Element (i).u;
v := edges.Element (i).v;
distance (u, v) := edges.Element (i).weight;
next_vertex (u, v) := v;
end loop;
for i in 1 .. max_vertex loop
distance (i, i) :=
FloatPt (0.0); -- Distance from a vertex to itself.
next_vertex (i, i) := i;
end loop;

-- Perform the algorithm.

for k in 1 .. max_vertex loop
for i in 1 .. max_vertex loop
for j in 1 .. max_vertex loop
dist_ikj := distance (i, k) + distance (k, j);
if dist_ikj < distance (i, j) then
distance (i, j) := dist_ikj;
next_vertex (i, j) := next_vertex (i, k);
end if;
end loop;
end loop;
end loop;

end floyd_warshall;

--
-- Path reconstruction.
--

procedure put_path
(next_vertex : in next_vertex_array;
u, v : in Positive)
is
i : Positive;
begin
if next_vertex (u, v) /= Nil_Vertex then
i := u;
Put (Positive'Image (i));
while i /= v loop
Put (" ->");
i := next_vertex (i, v);
Put (Positive'Image (i));
end loop;
end if;
end put_path;

example_graph : edge_vector;
max_vertex : Positive;

begin
Append (example_graph, (u => 1, weight => FloatPt (-2.0), v => 3));
Append (example_graph, (u => 3, weight => FloatPt (+2.0), v => 4));
Append (example_graph, (u => 4, weight => FloatPt (-1.0), v => 2));
Append (example_graph, (u => 2, weight => FloatPt (+4.0), v => 1));
Append (example_graph, (u => 2, weight => FloatPt (+3.0), v => 3));

max_vertex := find_max_vertex (example_graph);

declare

distance : distance_array (1 .. max_vertex, 1 .. max_vertex);
next_vertex : next_vertex_array
(1 .. max_vertex, 1 .. max_vertex);

begin

floyd_warshall (example_graph, max_vertex, distance, next_vertex);

Put_Line (" pair distance path");
Put_Line ("---------------------------------------------");
for u in 1 .. max_vertex loop
for v in 1 .. max_vertex loop
if u /= v then
Put (Positive'Image (u));
Put (" ->");
Put (Positive'Image (v));
Put (" ");
Put (FloatPt'Image (distance (u, v)));
Put (" ");
put_path (next_vertex, u, v);
Put_Line ("");
end if;
end loop;
end loop;

end;
end floyd_warshall_task;</syntaxhighlight>

{{out}}
<pre>$ gnatmake -q floyd_warshall_task.adb && ./floyd_warshall_task
pair distance path
---------------------------------------------
1 -> 2 -1.00000E+00 1 -> 3 -> 4 -> 2
1 -> 3 -2.00000E+00 1 -> 3
1 -> 4 0.00000E+00 1 -> 3 -> 4
2 -> 1 4.00000E+00 2 -> 1
2 -> 3 2.00000E+00 2 -> 1 -> 3
2 -> 4 4.00000E+00 2 -> 1 -> 3 -> 4
3 -> 1 5.00000E+00 3 -> 4 -> 2 -> 1
3 -> 2 1.00000E+00 3 -> 4 -> 2
3 -> 4 2.00000E+00 3 -> 4
4 -> 1 3.00000E+00 4 -> 2 -> 1
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>
#include<stdio.h>

typedef struct{
int sourceVertex, destVertex;
int edgeWeight;
}edge;

typedef struct{
int vertices, edges;
edge* edgeMatrix;
}graph;

graph loadGraph(char* fileName){
FILE* fp = fopen(fileName,"r");
graph G;
int i;
fscanf(fp,"%d%d",&G.vertices,&G.edges);
G.edgeMatrix = (edge*)malloc(G.edges*sizeof(edge));
for(i=0;i<G.edges;i++)
fscanf(fp,"%d%d%d",&G.edgeMatrix[i].sourceVertex,&G.edgeMatrix[i].destVertex,&G.edgeMatrix[i].edgeWeight);
fclose(fp);
return G;
}

void floydWarshall(graph g){
int processWeights[g.vertices][g.vertices], processedVertices[g.vertices][g.vertices];
int i,j,k;
for(i=0;i<g.vertices;i++)
for(j=0;j<g.vertices;j++){
processWeights[i][j] = SHRT_MAX;
processedVertices[i][j] = (i!=j)?j+1:0;
}
for(i=0;i<g.edges;i++)
processWeights[g.edgeMatrix[i].sourceVertex-1][g.edgeMatrix[i].destVertex-1] = g.edgeMatrix[i].edgeWeight;
for(i=0;i<g.vertices;i++)
for(j=0;j<g.vertices;j++)
for(k=0;k<g.vertices;k++){
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];
}
}
printf("pair dist path");
for(i=0;i<g.vertices;i++)
for(j=0;j<g.vertices;j++){
if(i!=j){
printf("\n%d -> %d %3d %5d",i+1,j+1,processWeights[i][j],i+1);
k = i+1;
do{
k = processedVertices[k-1][j];
printf("->%d",k);
}while(k!=j+1);
}
}
}

int main(int argC,char* argV[]){
if(argC!=2)
printf("Usage : %s <file containing graph data>");
else
floydWarshall(loadGraph(argV[1]));
return 0;
}
</syntaxhighlight>
Input file, first row specifies number of vertices and edges.
<pre>
4 5
1 3 -2
3 4 2
4 2 -1
2 1 4
2 3 3
</pre>
Invocation and output:
<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
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|C sharp|C#}}==
{{trans|Java}}
<syntaxhighlight lang="csharp">using System;

namespace FloydWarshallAlgorithm {
class Program {
static void FloydWarshall(int[,] weights, int numVerticies) {
double[,] dist = new double[numVerticies, numVerticies];
for (int i = 0; i < numVerticies; i++) {
for (int j = 0; j < numVerticies; j++) {
dist[i, j] = double.PositiveInfinity;
}
}

for (int i = 0; i < weights.GetLength(0); i++) {
dist[weights[i, 0] - 1, weights[i, 1] - 1] = weights[i, 2];
}

int[,] next = new int[numVerticies, numVerticies];
for (int i = 0; i < numVerticies; i++) {
for (int j = 0; j < numVerticies; j++) {
if (i != j) {
next[i, j] = j + 1;
}
}
}

for (int k = 0; k < numVerticies; k++) {
for (int i = 0; i < numVerticies; i++) {
for (int j = 0; j < numVerticies; j++) {
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);
}

static void PrintResult(double[,] dist, int[,] next) {
Console.WriteLine("pair dist path");
for (int i = 0; i < next.GetLength(0); i++) {
for (int j = 0; j < next.GetLength(1); j++) {
if (i != j) {
int u = i + 1;
int v = j + 1;
string path = string.Format("{0} -> {1} {2,2:G} {3}", u, v, dist[i, j], u);
do {
u = next[u - 1, v - 1];
path += " -> " + u;
} while (u != v);
Console.WriteLine(path);
}
}
}
}

static void Main(string[] args) {
int[,] weights = { { 1, 3, -2 }, { 2, 1, 4 }, { 2, 3, 3 }, { 3, 4, 2 }, { 4, 2, -1 } };
int numVerticies = 4;

FloydWarshall(weights, numVerticies);
}
}
}</syntaxhighlight>

=={{header|C++}}==
<syntaxhighlight lang="cpp">#include <iostream>
#include <vector>
#include <sstream>

void print(std::vector<std::vector<double>> dist, std::vector<std::vector<int>> next) {
std::cout << "(pair, dist, path)" << std::endl;
const auto size = std::size(next);
for (auto i = 0; i < size; ++i) {
for (auto j = 0; j < size; ++j) {
if (i != j) {
auto u = i + 1;
auto v = j + 1;
std::cout << "(" << u << " -> " << v << ", " << dist[i][j]
<< ", ";
std::stringstream path;
path << u;
do {
u = next[u - 1][v - 1];
path << " -> " << u;
} while (u != v);
std::cout << path.str() << ")" << std::endl;
}
}
}
}

void solve(std::vector<std::vector<int>> w_s, const int num_vertices) {
std::vector<std::vector<double>> dist(num_vertices);
for (auto& dim : dist) {
for (auto i = 0; i < num_vertices; ++i) {
dim.push_back(INT_MAX);
}
}
for (auto& w : w_s) {
dist[w[0] - 1][w[1] - 1] = w[2];
}
std::vector<std::vector<int>> next(num_vertices);
for (auto i = 0; i < num_vertices; ++i) {
for (auto j = 0; j < num_vertices; ++j) {
next[i].push_back(0);
}
for (auto j = 0; j < num_vertices; ++j) {
if (i != j) {
next[i][j] = j + 1;
}
}
}
for (auto k = 0; k < num_vertices; ++k) {
for (auto i = 0; i < num_vertices; ++i) {
for (auto j = 0; j < num_vertices; ++j) {
if (dist[i][j] > dist[i][k] + dist[k][j]) {
dist[i][j] = dist[i][k] + dist[k][j];
next[i][j] = next[i][k];
}
}
}
}
print(dist, next);
}

int main() {
std::vector<std::vector<int>> w = {
{ 1, 3, -2 },
{ 2, 1, 4 },
{ 2, 3, 3 },
{ 3, 4, 2 },
{ 4, 2, -1 },
};
int num_vertices = 4;
solve(w, num_vertices);
std::cin.ignore();
std::cin.get();
return 0;
}</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|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}}
<syntaxhighlight lang="d">import std.stdio;

void main() {
int[][] weights = [
[1, 3, -2],
[2, 1, 4],
[2, 3, 3],
[3, 4, 2],
[4, 2, -1]
];
int numVertices = 4;

floydWarshall(weights, numVertices);
}

void floydWarshall(int[][] weights, int numVertices) {
import std.array;

real[][] dist = uninitializedArray!(real[][])(numVertices, numVertices);
foreach(dim; dist) {
dim[] = real.infinity;
}

foreach (w; weights) {
dist[w[0]-1][w[1]-1] = w[2];
}

int[][] next = uninitializedArray!(int[][])(numVertices, numVertices);
for (int i=0; i<next.length; i++) {
for (int j=0; j<next.length; j++) {
if (i != j) {
next[i][j] = j+1;
}
}
}

for (int k=0; k<numVertices; k++) {
for (int i=0; i<numVertices; i++) {
for (int j=0; j<numVertices; j++) {
if (dist[i][j] > dist[i][k] + dist[k][j]) {
dist[i][j] = dist[i][k] + dist[k][j];
next[i][j] = next[i][k];
}
}
}
}

printResult(dist, next);
}

void printResult(real[][] dist, int[][] next) {
import std.conv;
import std.format;

writeln("pair dist path");
for (int i=0; i<next.length; i++) {
for (int j=0; j<next.length; j++) {
if (i!=j) {
int u = i+1;
int v = j+1;
string path = format("%d -> %d %2d %s", u, v, cast(int) dist[i][j], u);
do {
u = next[u-1][v-1];
path ~= text(" -> ", u);
} while (u != v);
writeln(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|EchoLisp}}==
=={{header|EchoLisp}}==
Transcription of the Floyd-Warshall algorithm, with best path computation.
Transcription of the Floyd-Warshall algorithm, with best path computation.
<lang scheme>
<syntaxhighlight lang="scheme">
(lib 'matrix)
(lib 'matrix)


Line 37: Line 2,102:


(define (floyd-with-path n dist next (d 0))
(define (floyd-with-path n dist next (d 0))
(for* ((k n) (i n) (j n))
(for* ((k n) (i n) (j n))
#:break (< (array-ref dist j j) 0) => 'negative-cycle
#:break (< (array-ref dist j j) 0) => 'negative-cycle
(set! d (+ (array-ref dist i k) (array-ref dist k j)))
(set! d (+ (array-ref dist i k) (array-ref dist k j)))
(when (< d (array-ref dist i j))
(when (< d (array-ref dist i j))
(array-set! dist i j d)
(array-set! dist i j d)
(array-set! next i j (array-ref next i k)))))
(array-set! next i j (array-ref next i k)))))


;; utilities
;; utilities
Line 49: Line 2,114:
(define (init-edges n dist next)
(define (init-edges n dist next)
(for* ((i n) (j n))
(for* ((i n) (j n))
(array-set! dist i i 0)
(array-set! dist i i 0)
(array-set! next i j null)
(array-set! next i j null)
#:continue (= j i)
#:continue (= j i)
(array-set! dist i j Infinity)
(array-set! dist i j Infinity)
#:continue (< (random) 0.3)
#:continue (< (random) 0.3)
(array-set! dist i j (1+ (random 100)))
(array-set! dist i j (1+ (random 100)))
(array-set! next i j j)))
(array-set! next i j j)))


;; show path from u to v
;; show path from u to v
(define (path u v)
(define (path u v)
(cond
(cond
((= u v) (list u))
((= u v) (list u))
((null? (array-ref next u v)) null)
((null? (array-ref next u v)) null)
(else (cons u (path (array-ref next u v) v)))))
(else (cons u (path (array-ref next u v) v)))))


(define( mdist u v) ;; show computed distance
(define( mdist u v) ;; show computed distance
(array-ref dist u v))
(array-ref dist u v))
(define (task)
(define (task)
(init-edges n dist next)
(init-edges n dist next)
(array-print dist) ;; show init distances
(array-print dist) ;; show init distances
(floyd-with-path n dist next))
(floyd-with-path n dist next))
</syntaxhighlight>
</lang>
{{out}}
{{out}}
<pre>
<pre>
Line 110: Line 2,175:


=={{header|Elixir}}==
=={{header|Elixir}}==
<lang elixir>defmodule Floyd_Warshall do
<syntaxhighlight lang="elixir">defmodule Floyd_Warshall do
def main(n, edge) do
def main(n, edge) do
{dist, next} = setup(n, edge)
{dist, next} = setup(n, edge)
Line 153: Line 2,218:


edge = [{1, 3, -2}, {2, 1, 4}, {2, 3, 3}, {3, 4, 2}, {4, 2, -1}]
edge = [{1, 3, -2}, {2, 1, 4}, {2, 3, 3}, {3, 4, 2}, {4, 2, -1}]
Floyd_Warshall.main(4, edge)</lang>
Floyd_Warshall.main(4, edge)</syntaxhighlight>


{{out}}
{{out}}
Line 171: Line 2,236:
4 -> 3 1 4 -> 2 -> 1 -> 3
4 -> 3 1 4 -> 2 -> 1 -> 3
</pre>
</pre>

=={{header|F_Sharp|F#}}==
===Floyd's algorithm===
<syntaxhighlight lang="fsharp">
//Floyd's algorithm: Nigel Galloway August 5th 2018
let Floyd (n:'a[]) (g:Map<('a*'a),int>)= //nodes graph(Map of adjacency list)
let ix n g=Seq.init (pown g n) (fun x->List.unfold(fun (a,b)->if a=0 then None else Some(b%g,(a-1,b/g)))(n,x))
let fN w (i,j,k)=match Map.tryFind(i,j) w,Map.tryFind(i,k) w,Map.tryFind(k,j) w with
|(None ,Some j,Some k)->Some(j+k)
|(Some i,Some j,Some k)->if (j+k) < i then Some(j+k) else None
|_ ->None
let n,z=ix 3 (Array.length n)|>Seq.choose(fun (i::j::k::_)->if i<>j&&i<>k&&j<>k then Some(n.[i],n.[j],n.[k]) else None)
|>Seq.fold(fun (n,n') ((i,j,k) as g)->match fN n g with |Some g->(Map.add (i,j) g n,Map.add (i,j) k n')|_->(n,n')) (g,Map.empty)
(n,(fun x y->seq{
let rec fN n g=seq{
match Map.tryFind (n,g) z with
|Some r->yield! fN n r; yield Some r;yield! fN r g
|_->yield None}
yield! fN x y |> Seq.choose id; yield y}))
</syntaxhighlight>

===The Task===
<syntaxhighlight lang="fsharp">
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>
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|Fortran}}==
{{trans|Ada}}
{{works with|gfortran|11.3.0}}


<syntaxhighlight lang="fortran">module floyd_warshall_algorithm

use, intrinsic :: ieee_arithmetic

implicit none

integer, parameter :: floating_point_kind = &
& ieee_selected_real_kind (6, 37)
integer, parameter :: fpk = floating_point_kind

integer, parameter :: nil_vertex = 0

type :: edge
integer :: u
real(kind = fpk) :: weight
integer :: v
end type edge

type :: edge_list
type(edge), allocatable :: element(:)
end type edge_list

contains

subroutine make_example_graph (edges)
type(edge_list), intent(out) :: edges

allocate (edges%element(1:5))
edges%element(1) = edge (1, -2.0, 3)
edges%element(2) = edge (3, +2.0, 4)
edges%element(3) = edge (4, -1.0, 2)
edges%element(4) = edge (2, +4.0, 1)
edges%element(5) = edge (2, +3.0, 3)
end subroutine make_example_graph

function find_max_vertex (edges) result (n)
type(edge_list), intent(in) :: edges
integer n

integer i

n = 1
do i = lbound (edges%element, 1), ubound (edges%element, 1)
n = max (n, edges%element(i)%u)
n = max (n, edges%element(i)%v)
end do
end function find_max_vertex

subroutine floyd_warshall (edges, max_vertex, distance, next_vertex)

type(edge_list), intent(in) :: edges
integer, intent(out) :: max_vertex
real(kind = fpk), allocatable, intent(out) :: distance(:,:)
integer, allocatable, intent(out) :: next_vertex(:,:)

integer :: n
integer :: i, j, k
integer :: u, v
real(kind = fpk) :: dist_ikj
real(kind = fpk) :: infinity

n = find_max_vertex (edges)
max_vertex = n

allocate (distance(1:n, 1:n))
allocate (next_vertex(1:n, 1:n))

infinity = ieee_value (1.0_fpk, ieee_positive_inf)

! Initialize.

do i = 1, n
do j = 1, n
distance(i, j) = infinity
next_vertex (i, j) = nil_vertex
end do
end do
do i = lbound (edges%element, 1), ubound (edges%element, 1)
u = edges%element(i)%u
v = edges%element(i)%v
distance(u, v) = edges%element(i)%weight
next_vertex(u, v) = v
end do
do i = 1, n
distance(i, i) = 0.0_fpk ! Distance from a vertex to itself.
next_vertex(i, i) = i
end do

! Perform the algorithm.

do k = 1, n
do i = 1, n
do j = 1, n
dist_ikj = distance(i, k) + distance(k, j)
if (dist_ikj < distance(i, j)) then
distance(i, j) = dist_ikj
next_vertex(i, j) = next_vertex(i, k)
end if
end do
end do
end do

end subroutine floyd_warshall

subroutine print_path (next_vertex, u, v)
integer, intent(in) :: next_vertex(:,:)
integer, intent(in) :: u, v

integer i

if (next_vertex(u, v) /= nil_vertex) then
i = u
write (*, '(I0)', advance = 'no') i
do while (i /= v)
i = next_vertex(i, v)
write (*, '('' -> '', I0)', advance = 'no') i
end do
end if
end subroutine print_path

end module floyd_warshall_algorithm

program floyd_warshall_task

use, non_intrinsic :: floyd_warshall_algorithm

implicit none

type(edge_list) :: example_graph
integer :: max_vertex
real(kind = fpk), allocatable :: distance(:,:)
integer, allocatable :: next_vertex(:,:)
integer :: u, v

call make_example_graph (example_graph)
call floyd_warshall (example_graph, max_vertex, distance, &
& next_vertex)

1000 format (1X, I0, ' -> ', I0, 5X, F4.1, 6X)

write (*, '('' pair distance path'')')
write (*, '(''---------------------------------------'')')
do u = 1, max_vertex
do v = 1, max_vertex
if (u /= v) then
write (*, 1000, advance = 'no') u, v, distance(u, v)
call print_path (next_vertex, u, v)
write (*, '()', advance = 'yes')
end if
end do
end do

end program floyd_warshall_task</syntaxhighlight>

{{out}}
<pre>$ gfortran -g -std=f2018 -fcheck=all -fno-unsafe-math-optimizations -frounding-math -fsignaling-nans floyd_warshall_task.f90 && ./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|FreeBASIC}}==
=={{header|FreeBASIC}}==
{{trans|Java}}
{{trans|Java}}
<lang freebasic>' FB 1.05.0 Win64
<syntaxhighlight lang="freebasic">' FB 1.05.0 Win64


Const POSITIVE_INFINITY As Double = 1.0/0.0
Const POSITIVE_INFINITY As Double = 1.0/0.0
Line 235: Line 2,518:
Print
Print
Print "Press any key to quit"
Print "Press any key to quit"
Sleep</lang>
Sleep</syntaxhighlight>


{{out}}
{{out}}
Line 255: Line 2,538:


=={{header|Go}}==
=={{header|Go}}==
<lang go>package main
<syntaxhighlight lang="go">package main

import (
import (
"fmt"
"fmt"
"math"
"strconv"
)
)

// A Graph is the interface implemented by graphs that
type arc struct {
// this algorithm can run on.
to int
type Graph interface {
wt float64
Vertices() []Vertex
Neighbors(v Vertex) []Vertex
Weight(u, v Vertex) int
}
}

// Nonnegative integer ID of vertex
func fw(g [][]arc) [][]float64 {
type Vertex int
dist := make([][]float64, len(g))
for i := range dist {
// ig is a graph of integers that satisfies the Graph interface.
di := make([]float64, len(g))
type ig struct {
for j := range di {
vert []Vertex
di[j] = math.Inf(1)
edges map[Vertex]map[Vertex]int
}
}
di[i] = 0
dist[i] = di
func (g ig) edge(u, v Vertex, w int) {
if _, ok := g.edges[u]; !ok {
g.edges[u] = make(map[Vertex]int)
}
g.edges[u][v] = w
}
func (g ig) Vertices() []Vertex { return g.vert }
func (g ig) Neighbors(v Vertex) (vs []Vertex) {
for k := range g.edges[v] {
vs = append(vs, k)
}
return vs
}
func (g ig) Weight(u, v Vertex) int { return g.edges[u][v] }
func (g ig) path(vv []Vertex) (s string) {
if len(vv) == 0 {
return ""
}
s = strconv.Itoa(int(vv[0]))
for _, v := range vv[1:] {
s += " -> " + strconv.Itoa(int(v))
}
return s
}
const Infinity = int(^uint(0) >> 1)
func FloydWarshall(g Graph) (dist map[Vertex]map[Vertex]int, next map[Vertex]map[Vertex]*Vertex) {
vert := g.Vertices()
dist = make(map[Vertex]map[Vertex]int)
next = make(map[Vertex]map[Vertex]*Vertex)
for _, u := range vert {
dist[u] = make(map[Vertex]int)
next[u] = make(map[Vertex]*Vertex)
for _, v := range vert {
dist[u][v] = Infinity
}
}
for u, arcs := range g {
dist[u][u] = 0
for _, v := range arcs {
for _, v := range g.Neighbors(u) {
dist[u][v.to] = v.wt
v := v
}
dist[u][v] = g.Weight(u, v)
next[u][v] = &v
}
}
}
for k, dk := range dist {
for _, di := range dist {
for _, k := range vert {
for j, dij := range di {
for _, i := range vert {
if d := di[k] + dk[j]; dij > d {
for _, j := range vert {
di[j] = d
if dist[i][k] < Infinity && dist[k][j] < Infinity {
}
if dist[i][j] > dist[i][k]+dist[k][j] {
}
dist[i][j] = dist[i][k] + dist[k][j]
next[i][j] = next[i][k]
}
}
}
}
}
}
}
return dist
return dist, next
}
}

func Path(u, v Vertex, next map[Vertex]map[Vertex]*Vertex) (path []Vertex) {
if next[u][v] == nil {
return
}
path = []Vertex{u}
for u != v {
u = *next[u][v]
path = append(path, u)
}
return path
}
func main() {
func main() {
g := ig{[]Vertex{1, 2, 3, 4}, make(map[Vertex]map[Vertex]int)}
g := [][]arc{
1: {{3, -2}},
g.edge(1, 3, -2)
2: {{1, 4}, {3, 3}},
g.edge(3, 4, 2)
3: {{4, 2}},
g.edge(4, 2, -1)
4: {{2, -1}},
g.edge(2, 1, 4)
g.edge(2, 3, 3)
dist, next := FloydWarshall(g)
fmt.Println("pair\tdist\tpath")
for u, m := range dist {
for v, d := range m {
if u != v {
fmt.Printf("%d -> %d\t%3d\t%s\n", u, v, d, g.path(Path(u, v, next)))
}
}
}
}
dist := fw(g)
}</syntaxhighlight>
for _, d := range dist {
fmt.Printf("%4g\n", d)
}
}</lang>
{{out}}
{{out}}
<pre>
<pre>
[ 0 +Inf +Inf +Inf +Inf]
pair dist path
[+Inf 0 -1 -2 0]
1 -> 2 -1 1 -> 3 -> 4 -> 2
[+Inf 4 0 2 4]
1 -> 3 -2 1 -> 3
[+Inf 5 1 0 2]
1 -> 4 0 1 -> 3 -> 4
[+Inf 3 -1 1 0]
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>
</pre>

=={{header|Groovy}}==
{{trans|Java}}
<syntaxhighlight lang="groovy">class FloydWarshall {
static void main(String[] args) {
int[][] weights = [[1, 3, -2], [2, 1, 4], [2, 3, 3], [3, 4, 2], [4, 2, -1]]
int numVertices = 4

floydWarshall(weights, numVertices)
}

static void floydWarshall(int[][] weights, int numVertices) {
double[][] dist = new double[numVertices][numVertices]
for (double[] row : dist) {
Arrays.fill(row, Double.POSITIVE_INFINITY)
}

for (int[] w : weights) {
dist[w[0] - 1][w[1] - 1] = w[2]
}

int[][] next = new int[numVertices][numVertices]
for (int i = 0; i < next.length; i++) {
for (int j = 0; j < next.length; j++) {
if (i != j) {
next[i][j] = j + 1
}
}
}

for (int k = 0; k < numVertices; k++) {
for (int i = 0; i < numVertices; i++) {
for (int j = 0; j < numVertices; j++) {
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)
}

static void printResult(double[][] dist, int[][] next) {
println("pair dist path")
for (int i = 0; i < next.length; i++) {
for (int j = 0; j < next.length; j++) {
if (i != j) {
int u = i + 1
int v = j + 1
String path = String.format("%d -> %d %2d %s", u, v, (int) dist[i][j], u)
boolean loop = true
while (loop) {
u = next[u - 1][v - 1]
path += " -> " + u
loop = u != v
}
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>


=={{header|Haskell}}==
=={{header|Haskell}}==


Necessary imports
Necessary imports
<lang haskell>import Control.Monad (join)
<syntaxhighlight lang="haskell">import Control.Monad (join)
import Data.List (union)
import Data.List (union)
import Data.Map hiding (foldr, union)
import Data.Map hiding (foldr, union)
import Data.Maybe (fromJust, isJust)
import Data.Maybe (fromJust, isJust)
import Data.Semigroup
import Data.Semigroup
import Prelude hiding (lookup, filter)</lang>
import Prelude hiding (lookup, filter)</syntaxhighlight>


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...)
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...)


<lang haskell>data Shortest b a = Shortest { distance :: a, path :: [b] }
<syntaxhighlight lang="haskell">data Shortest b a = Shortest { distance :: a, path :: [b] }
deriving Show</lang>
deriving Show</syntaxhighlight>


Next we note that shortest paths form a semigroup with following "addition" rule:
Next we note that shortest paths form a semigroup with following "addition" rule:


<lang haskell>instance (Ord a, Eq b) => Semigroup (Shortest b a) where
<syntaxhighlight lang="haskell">instance (Ord a, Eq b) => Semigroup (Shortest b a) where
a <> b = case distance a `compare` distance b of
a <> b = case distance a `compare` distance b of
GT -> b
GT -> b
LT -> a
LT -> a
EQ -> a { path = path a `union` path b }</lang>
EQ -> a { path = path a `union` path b }</syntaxhighlight>


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.
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 343: Line 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>:
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>:
<lang haskell>floydWarshall v dist = foldr innerCycle (Just <$> dist) v
<syntaxhighlight lang="haskell">floydWarshall v dist = foldr innerCycle (Just <$> dist) v
where
where
innerCycle k dist = (newDist <$> v <*> v) `setTo` dist
innerCycle k dist = (newDist <$> v <*> v) `setTo` dist
Line 352: Line 2,783:
return $ Shortest (distance a <> distance b) (path a))
return $ Shortest (distance a <> distance b) (path a))


setTo = unionWith (<>) . fromList</lang>
setTo = unionWith (<>) . fromList</syntaxhighlight>


The <code>floydWarshall</code> produces only first steps of shortest paths. Whole paths are build by following function:
The <code>floydWarshall</code> produces only first steps of shortest paths. Whole paths are build by following function:


<lang haskell>buildPaths d = mapWithKey (\pair s -> s { path = buildPath pair}) d
<syntaxhighlight lang="haskell">buildPaths d = mapWithKey (\pair s -> s { path = buildPath pair}) d
where
where
buildPath (i,j)
buildPath (i,j)
Line 362: Line 2,793:
| otherwise = do k <- path $ fromJust $ lookup (i,j) d
| otherwise = do k <- path $ fromJust $ lookup (i,j) d
p <- buildPath (k,j)
p <- buildPath (k,j)
[i : p]</lang>
[i : p]</syntaxhighlight>


All pre- and postprocessing is done by the main function <code>findMinDistances</code>:
All pre- and postprocessing is done by the main function <code>findMinDistances</code>:
<lang haskell>findMinDistances v g =
<syntaxhighlight lang="haskell">findMinDistances v g =
let weights = mapWithKey (\(_,j) w -> Shortest w [j]) g
let weights = mapWithKey (\(_,j) w -> Shortest w [j]) g
trivial = fromList [ ((i,i), Shortest mempty []) | i <- v ]
trivial = fromList [ ((i,i), Shortest mempty []) | i <- v ]
clean d = fromJust <$> filter isJust (d \\ trivial)
clean d = fromJust <$> filter isJust (d \\ trivial)
in buildPaths $ clean $ floydWarshall v (weights <> trivial)</lang>
in buildPaths $ clean $ floydWarshall v (weights <> trivial)</syntaxhighlight>


'''Examples''':
'''Examples''':


The sample graph:
The sample graph:
<lang haskell>g = fromList [((2,1), 4)
<syntaxhighlight lang="haskell">g = fromList [((2,1), 4)
,((2,3), 3)
,((2,3), 3)
,((1,3), -2)
,((1,3), -2)
,((3,4), 2)
,((3,4), 2)
,((4,2), -1)]</lang>
,((4,2), -1)]</syntaxhighlight>
the helper function
the helper function
<lang haskell>showShortestPaths v g = mapM_ print $ toList $ findMinDistances v g</lang>
<syntaxhighlight lang="haskell">showShortestPaths v g = mapM_ print $ toList $ findMinDistances v g</syntaxhighlight>


{{Out}}
{{Out}}
Line 431: Line 2,862:
Graph labeled by chars:
Graph labeled by chars:


<lang haskell>g2 = fromList [(('A','S'), 1)
<syntaxhighlight lang="haskell">g2 = fromList [(('A','S'), 1)
,(('A','D'), -1)
,(('A','D'), -1)
,(('S','E'), 2)
,(('S','E'), 2)
,(('D','E'), 4)]</lang>
,(('D','E'), 4)]</syntaxhighlight>


<pre>λ> showShortestPaths "ASDE" (Sum <$> g2)
<pre>λ> showShortestPaths "ASDE" (Sum <$> g2)
Line 442: Line 2,873:
(('D','E'),Shortest {distance = Sum {getSum = 4}, path = ["DE"]})
(('D','E'),Shortest {distance = Sum {getSum = 4}, path = ["DE"]})
(('S','E'),Shortest {distance = Sum {getSum = 2}, path = ["SE"]})</pre>
(('S','E'),Shortest {distance = Sum {getSum = 2}, path = ["SE"]})</pre>

=={{header|Icon}}==
{{trans|Scheme}}
{{works with|Icon|9.5.20i}}


<syntaxhighlight lang="icon">#
# Floyd-Warshall algorithm.
#
# See https://en.wikipedia.org/w/index.php?title=Floyd%E2%80%93Warshall_algorithm&oldid=1082310013
#

record fw_results (n, distance, next_vertex)

link array
link numbers
link printf

procedure main ()
local example_graph
local fw
local u, v

example_graph := [[1, -2.0, 3],
[3, +2.0, 4],
[4, -1.0, 2],
[2, +4.0, 1],
[2, +3.0, 3]]

fw := floyd_warshall (example_graph)

printf (" pair distance path\n")
printf ("-------------------------------------\n")
every u := 1 to fw.n do {
every v := 1 to fw.n do {
if u ~= v then {
printf (" %d -> %d %4s %s\n", u, v,
string (ref_array (fw.distance, u, v)),
path_to_string (find_path (fw.next_vertex, u, v)))
}
}
}
end

procedure floyd_warshall (edges)
local n, distance, next_vertex
local e
local i, j, k
local dist_ij, dist_ik, dist_kj, dist_ikj

n := max_vertex (edges)
distance := create_array ([1, 1], [n, n], &null)
next_vertex := create_array ([1, 1], [n, n], &null)

# Initialization.
every e := !edges do {
ref_array (distance, e[1], e[3]) := e[2]
ref_array (next_vertex, e[1], e[3]) := e[3]
}
every i := 1 to n do {
ref_array (distance, i, i) := 0.0 # Distance to self = 0.
ref_array (next_vertex, i, i) := i
}

# Perform the algorithm. Here &null will play the role of
# "infinity": "\" means a value is finite, "/" that it is infinite.
every k := 1 to n do {
every i := 1 to n do {
every j := 1 to n do {
dist_ij := ref_array (distance, i, j)
dist_ik := ref_array (distance, i, k)
dist_kj := ref_array (distance, k, j)
if \dist_ik & \dist_kj then {
dist_ikj := dist_ik + dist_kj
if /dist_ij | dist_ikj < dist_ij then {
ref_array (distance, i, j) := dist_ikj
ref_array (next_vertex, i, j) :=
ref_array (next_vertex, i, k)
}
}
}
}
}

return fw_results (n, distance, next_vertex)
end

procedure find_path (next_vertex, u, v)
local path

if / (ref_array (next_vertex, u, v)) then {
path := []
} else {
path := [u]
while u ~= v do {
u := ref_array (next_vertex, u, v)
put (path, u)
}
}
return path
end

procedure path_to_string (path)
local s

if *path = 0 then {
s := ""
} else {
s := string (path[1])
every s ||:= (" -> " || !path[2 : 0])
}
return s
end

procedure max_vertex (edges)
local e
local m

*edges = 0 & stop ("no edges")
m := 1
every e := !edges do m := max (m, e[1], e[3])
return m
end</syntaxhighlight>

{{out}}
<pre>$ icon floyd-warshall-in-Icon.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|J}}==
=={{header|J}}==


<lang J>floyd=: verb define
<syntaxhighlight lang="j">floyd=: verb define
for_j. i.#y do.
for_j. i.#y do.
y=. y <. j ({"1 +/ {) y
y=. y <. j ({"1 +/ {) y
end.
end.
)</lang>
)</syntaxhighlight>

Alternate implementation (same behavior):

<syntaxhighlight lang=J>floyd=: ]F..(]<.{"1+/{) i.@#</syntaxhighlight>


Example use:
Example use:


<lang J>graph=: ".;._2]0 :0
<syntaxhighlight lang="j">graph=: ".;._2]0 :0
0 _ _2 _ NB. 1->3 costs _2
0 _ _2 _ NB. 1->3 costs _2
4 0 3 _ NB. 2->1 costs 4; 2->3 costs 3
4 0 3 _ NB. 2->1 costs 4; 2->3 costs 3
Line 464: Line 3,039:
4 0 2 4
4 0 2 4
5 1 0 2
5 1 0 2
3 _1 1 0</lang>
3 _1 1 0</syntaxhighlight>


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.
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 474: Line 3,049:
This draft task currently asks for path reconstruction, which is a different (related) algorithm:
This draft task currently asks for path reconstruction, which is a different (related) algorithm:


<lang J>floydrecon=: verb define
<syntaxhighlight lang="j">floydrecon=: verb define
n=. ((|i.@,~)#y)*1>.y->./(,y)-._
n=. ($y)$_(I._=,y)},($$i.@#)y
for_j. i.#y do.
for_j. i.#y do.
d=. y <. j ({"1 +/ {) y
d=. y <. j ({"1 +/ {) y
Line 506: Line 3,081:
end.
end.
i.0 0
i.0 0
)</lang>
)</syntaxhighlight>


Draft output:
Draft output:


<lang J> task graph
<syntaxhighlight lang="j"> task graph
pair dist path
pair dist path
1->2 _1 1->3->4->2
1->2 _1 1->3->4->2
Line 523: Line 3,098:
4->1 3 4->2->1
4->1 3 4->2->1
4->2 _1 4->2
4->2 _1 4->2
4->3 1 4->2->1->3</lang>
4->3 1 4->2->1->3</syntaxhighlight>


=={{header|Java}}==
=={{header|Java}}==
<lang java>import static java.lang.String.format;
<syntaxhighlight lang="java">import static java.lang.String.format;
import java.util.Arrays;
import java.util.Arrays;


Line 583: Line 3,158:
}
}
}
}
}</lang>
}</syntaxhighlight>
<pre>pair dist path
<pre>pair dist path
1 -> 2 -1 1 -> 3 -> 4 -> 2
1 -> 2 -1 1 -> 3 -> 4 -> 2
Line 599: Line 3,174:


=={{header|JavaScript}}==
=={{header|JavaScript}}==
Using output code translated from the Lua sample.
<lang javascript>var graph = [];
<syntaxhighlight lang="javascript">'use strict'
for (i = 0; i < 10; ++i) {
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([]);
graph.push([]);
for (j = 0; j < 10; ++j)
for (let j = 0; j < numVertices; ++j)
graph[i].push(i == j ? 0 : 9999999);
graph[i].push(i == j ? 0 : 9999999);
}
}


for (i = 1; i < 10; ++i) {
for (let i = 0; i < weights.length; ++i) {
let w = weights[i];
graph[0][i] = graph[i][0] = parseInt(Math.random() * 9 + 1);
graph[w[0] - 1][w[1] - 1] = w[2];
}
}


let nxt = [];
for (k = 0; k < 10; ++k) {
for (i = 0; i < 10; ++i) {
for (let i = 0; i < numVertices; ++i) {
nxt.push([]);
for (j = 0; j < 10; ++j) {
if (graph[i][j] > graph[i][k] + graph[k][j])
for (let j = 0; j < numVertices; ++j)
graph[i][j] = graph[i][k] + graph[k][j]
nxt[i].push(i == j ? 0 : j + 1);
}

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(graph);</lang>
console.log("pair dist path");
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},
"2": {"1" : 4, "3": 3},
"3": {"4": 2},
"4": {"2": -1}
};</syntaxhighlight>

The algorithm given here is a direct implementation of the definitional algorithm:
<syntaxhighlight lang="jq">def fwi:
. as $weights
| keys_unsorted as $nodes
# construct the dist matrix
| reduce $nodes[] as $u ({};
reduce $nodes[] as $v (.;
.[$u][$v] = infinite))
| reduce $nodes[] as $u (.; .[$u][$u] = 0 )
| reduce $nodes[] as $u (.;
reduce ($weights[$u]|keys_unsorted[]) as $v (.;
.[$u][$v] = $weights[$u][$v] ))
| reduce $nodes[] as $w (.;
reduce $nodes[] as $u (.;
reduce $nodes[] as $v (.;
(.[$u][$w] + .[$w][$v]) as $x
| if .[$u][$v] > $x then .[$u][$v] = $x
else . end )))
;


weights | fwi</syntaxhighlight>
{{out}}
<pre>{
"1": {
"1": 0,
"2": -1,
"3": -2,
"4": 0
},
"2": {
"1": 4,
"2": 0,
"3": 2,
"4": 4
},
"3": {
"1": 5,
"2": 1,
"3": 0,
"4": 2
},
"4": {
"1": 3,
"2": -1,
"3": 1,
"4": 0
}
}</pre>

=={{header|Julia}}==
{{trans|Java}}
<syntaxhighlight lang="julia"># Floyd-Warshall algorithm: https://rosettacode.org/wiki/Floyd-Warshall_algorithm
# v0.6

function floydwarshall(weights::Matrix, nvert::Int)
dist = fill(Inf, nvert, nvert)
for i in 1:size(weights, 1)
dist[weights[i, 1], weights[i, 2]] = weights[i, 3]
end
# return dist
next = collect(j != i ? j : 0 for i in 1:nvert, j in 1:nvert)

for k in 1:nvert, i in 1:nvert, j in 1:nvert
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]
end
end

# return next
function printresult(dist, next)
println("pair dist path")
for i in 1:size(next, 1), j in 1:size(next, 2)
if i != j
u = i
path = @sprintf "%d -> %d %2d %s" i j dist[i, j] i
while true
u = next[u, j]
path *= " -> $u"
if u == j break end
end
println(path)
end
end
end
printresult(dist, next)
end

floydwarshall([1 3 -2; 2 1 4; 2 3 3; 3 4 2; 4 2 -1], 4)</syntaxhighlight>


=={{header|Kotlin}}==
=={{header|Kotlin}}==
{{trans|Java}}
{{trans|Java}}
<lang scala>// version 1.0.6
<syntaxhighlight lang="scala">// version 1.1


object FloydWarshall {
object FloydWarshall {
fun doCalcs(weights: Array<IntArray>, nVertices: Int) {
fun doCalcs(weights: Array<IntArray>, nVertices: Int) {
val dist = Array(nVertices) { DoubleArray(nVertices) { Double.POSITIVE_INFINITY } }
val dist = Array(nVertices) { DoubleArray(nVertices) { Double.POSITIVE_INFINITY } }
for (w in weights) dist[w[0] - 1][w[1] - 1] = w[2].toDouble()
for (w in weights) dist[w[0] - 1][w[1] - 1] = w[2].toDouble()
val next = Array(nVertices) { IntArray(nVertices) }
val next = Array(nVertices) { IntArray(nVertices) }
for (i in 0 until next.size)
for (i in 0 until next.size) {
for (j in 0 until next.size)
for (j in 0 until next.size) {
if (i != j) next[i][j] = j + 1
if (i != j) next[i][j] = j + 1
for (k in 0 until nVertices)
}
}
for (i in 0 until nVertices)
for (j in 0 until nVertices)
for (k in 0 until nVertices) {
for (i in 0 until nVertices) {
for (j in 0 until nVertices) {
if (dist[i][k] + dist[k][j] < dist[i][j]) {
if (dist[i][k] + dist[k][j] < dist[i][j]) {
dist[i][j] = dist[i][k] + dist[k][j]
dist[i][j] = dist[i][k] + dist[k][j]
next[i][j] = next[i][k]
next[i][j] = next[i][k]
}
}
}
}
}
printResult(dist, next)
printResult(dist, next)
}
}
Line 648: Line 3,377:
var path: String
var path: String
println("pair dist path")
println("pair dist path")
for (i in 0 until next.size)
for (i in 0 until next.size) {
for (j in 0 until next.size)
for (j in 0 until next.size) {
if (i != j) {
if (i != j) {
u = i + 1
u = i + 1
v = j + 1
v = j + 1
path = ("%d -> %d %2d %s").format(u, v, dist[i][j].toInt(), u)
path = ("%d -> %d %2d %s").format(u, v, dist[i][j].toInt(), u)
do {
do {
u = next[u - 1][v - 1]
u = next[u - 1][v - 1]
path += " -> " + u
path += " -> " + u
}
} while (u != v)
while (u != v)
println(path)
println(path)
}
}
}
}
}
}
}
}


fun main(args: Array<String>) {
fun main(args: Array<String>) {
val weights = arrayOf(
val weights = arrayOf(
intArrayOf(1, 3, -2),
intArrayOf(1, 3, -2),
intArrayOf(2, 1, 4),
intArrayOf(2, 1, 4),
intArrayOf(2, 3, 3),
intArrayOf(2, 3, 3),
intArrayOf(3, 4, 2),
intArrayOf(3, 4, 2),
intArrayOf(4, 2, -1)
intArrayOf(4, 2, -1)
)
)
val nVertices = 4
val nVertices = 4
FloydWarshall.doCalcs(weights, nVertices)
FloydWarshall.doCalcs(weights, nVertices)
}</lang>
}</syntaxhighlight>


{{out}}
{{out}}
Line 693: Line 3,423:
</pre>
</pre>


=={{header|Perl 6}}==
=={{header|Lua}}==
{{trans|D}}
{{works with|Rakudo|2016.12}}
<syntaxhighlight lang="lua">function printResult(dist, nxt)
{{trans|Ruby}}
print("pair dist path")
for i=0, #nxt do
for j=0, #nxt do
if i ~= j then
u = i + 1
v = j + 1
path = string.format("%d -> %d %2d %s", u, v, dist[i][j], u)
repeat
u = nxt[u-1][v-1]
path = path .. " -> " .. u
until (u == v)
print(path)
end
end
end
end


function floydWarshall(weights, numVertices)
<lang perl6>sub Floyd-Warshall (Int $n, @edge) {
dist = {}
my @dist = [0, |(Inf xx $n-1)], *.Array.rotate(-1) … !*[*-1];
my @next = [0 xx $n] xx $n;
for i=0, numVertices-1 do
dist[i] = {}
for j=0, numVertices-1 do
dist[i][j] = math.huge
end
end


for @edge -> ($u, $v, $w) {
for _,w in pairs(weights) do
@dist[$u-1;$v-1] = $w;
-- the weights array is one based
@next[$u-1;$v-1] = $v-1;
dist[w[1]-1][w[2]-1] = w[3]
end

nxt = {}
for i=0, numVertices-1 do
nxt[i] = {}
for j=0, numVertices-1 do
if i ~= j then
nxt[i][j] = j+1
end
end
end

for k=0, numVertices-1 do
for i=0, numVertices-1 do
for j=0, numVertices-1 do
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]
end
end
end
end

printResult(dist, nxt)
end

weights = {
{1, 3, -2},
{2, 1, 4},
{2, 3, 3},
{3, 4, 2},
{4, 2, -1}
}
numVertices = 4
floydWarshall(weights, numVertices)</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|Mathematica}} / {{header|Wolfram Language}}==
<syntaxhighlight lang="mathematica">g = Graph[{1 \[DirectedEdge] 3, 3 \[DirectedEdge] 4,
4 \[DirectedEdge] 2, 2 \[DirectedEdge] 1, 2 \[DirectedEdge] 3},
EdgeWeight -> {(1 \[DirectedEdge] 3) -> -2, (3 \[DirectedEdge] 4) ->
2, (4 \[DirectedEdge] 2) -> -1, (2 \[DirectedEdge] 1) ->
4, (2 \[DirectedEdge] 3) -> 3}]
vl = VertexList[g];
dm = GraphDistanceMatrix[g];
Grid[LexicographicSort[
DeleteCases[
Catenate[
Table[{vl[[i]], vl[[j]], dm[[i, j]]}, {i, Length[vl]}, {j,
Length[vl]}]], {x_, x_, _}]]]</syntaxhighlight>
{{out}}
<pre>1 2 -1.
1 3 -2.
1 4 0.
2 1 4.
2 3 2.
2 4 4.
3 1 5.
3 2 1.
3 4 2.
4 1 3.
4 2 -1.
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}}==
<syntaxhighlight lang="modula2">MODULE FloydWarshall;
FROM FormatString IMPORT FormatString;
FROM SpecialReals IMPORT Infinity;
FROM Terminal IMPORT ReadChar,WriteString,WriteLn;

CONST NUM_VERTICIES = 4;
TYPE
IntArray = ARRAY[0..NUM_VERTICIES-1],[0..NUM_VERTICIES-1] OF INTEGER;
RealArray = ARRAY[0..NUM_VERTICIES-1],[0..NUM_VERTICIES-1] OF REAL;

PROCEDURE FloydWarshall(weights : ARRAY OF ARRAY OF INTEGER);
VAR
dist : RealArray;
next : IntArray;
i,j,k : INTEGER;
BEGIN
FOR i:=0 TO NUM_VERTICIES-1 DO
FOR j:=0 TO NUM_VERTICIES-1 DO
dist[i,j] := Infinity;
END
END;
k := HIGH(weights);
FOR i:=0 TO k DO
dist[weights[i,0]-1,weights[i,1]-1] := FLOAT(weights[i,2]);
END;
FOR i:=0 TO NUM_VERTICIES-1 DO
FOR j:=0 TO NUM_VERTICIES-1 DO
IF i#j THEN
next[i,j] := j+1;
END
END
END;
FOR k:=0 TO NUM_VERTICIES-1 DO
FOR i:=0 TO NUM_VERTICIES-1 DO
FOR j:=0 TO NUM_VERTICIES-1 DO
IF dist[i,j] > dist[i,k] + dist[k,j] THEN
dist[i,j] := dist[i,k] + dist[k,j];
next[i,j] := next[i,k];
END
END
END
END;
PrintResult(dist, next);
END FloydWarshall;

PROCEDURE PrintResult(dist : RealArray; next : IntArray);
VAR
i,j,u,v : INTEGER;
buf : ARRAY[0..63] OF CHAR;
BEGIN
WriteString("pair dist path");
WriteLn;
FOR i:=0 TO NUM_VERTICIES-1 DO
FOR j:=0 TO NUM_VERTICIES-1 DO
IF i#j THEN
u := i + 1;
v := j + 1;
FormatString("%i -> %i %2i %i", buf, u, v, TRUNC(dist[i,j]), u);
WriteString(buf);
REPEAT
u := next[u-1,v-1];
FormatString(" -> %i", buf, u);
WriteString(buf);
UNTIL u=v;
WriteLn
END
END
END
END PrintResult;

TYPE WeightArray = ARRAY[0..4],[0..2] OF INTEGER;
VAR weights : WeightArray;
BEGIN
weights := WeightArray{
{1, 3, -2},
{2, 1, 4},
{2, 3, 3},
{3, 4, 2},
{4, 2, -1}
};

FloydWarshall(weights);

ReadChar
END FloydWarshall.</syntaxhighlight>

=={{header|Nim}}==
{{trans|D}}
<syntaxhighlight lang="nim">import sequtils, strformat

type
Weight = tuple[src, dest, value: int]
Weights = seq[Weight]


#---------------------------------------------------------------------------------------------------

proc printResult(dist: seq[seq[float]]; next: seq[seq[int]]) =

echo "pair dist path"
for i in 0..next.high:
for j in 0..next.high:
if i != j:
var u = i + 1
let v = j + 1
var path = fmt"{u} -> {v} {dist[i][j].toInt:2d} {u}"
while true:
u = next[u-1][v-1]
path &= fmt" -> {u}"
if u == v: break
echo path


#---------------------------------------------------------------------------------------------------

proc floydWarshall(weights: Weights; numVertices: Positive) =

var dist = repeat(repeat(Inf, numVertices), numVertices)
for w in weights:
dist[w.src - 1][w.dest - 1] = w.value.toFloat

var next = repeat(newSeq[int](numVertices), numVertices)
for i in 0..<numVertices:
for j in 0..<numVertices:
if i != j:
next[i][j] = j + 1

for k in 0..<numVertices:
for i in 0..<numVertices:
for j in 0..<numVertices:
if dist[i][j] > dist[i][k] + dist[k][j]:
dist[i][j] = dist[i][k] + dist[k][j]
next[i][j] = next[i][k]

printResult(dist, next)


#———————————————————————————————————————————————————————————————————————————————————————————————————

let weights: Weights = @[(1, 3, -2), (2, 1, 4), (2, 3, 3), (3, 4, 2), (4, 2, -1)]
let numVertices = 4

floydWarshall(weights, numVertices)</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|ObjectIcon}}==
{{trans|Icon}}


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.

<syntaxhighlight lang="objecticon">#
# Floyd-Warshall algorithm.
#
# See https://en.wikipedia.org/w/index.php?title=Floyd%E2%80%93Warshall_algorithm&oldid=1082310013
#

import io
import ipl.array
import ipl.printf

record fw_results (n, distance, next_vertex)

procedure main ()
local example_graph
local fw
local u, v

example_graph := [[1, -2.0, 3],
[3, +2.0, 4],
[4, -1.0, 2],
[2, +4.0, 1],
[2, +3.0, 3]]

fw := floyd_warshall (example_graph)

printf (" pair distance path\n")
printf ("-------------------------------------\n")
every u := 1 to fw.n do {
every v := 1 to fw.n do {
if u ~= v then {
printf (" %d -> %d %4s %s\n", u, v,
string (ref_array (fw.distance, u, v)),
path_to_string (find_path (fw.next_vertex, u, v)))
}
}
}
}
end


procedure floyd_warshall (edges)
for [X] ^$n xx 3 -> ($k, $i, $j) {
local n, distance, next_vertex
if @dist[$i;$j] > my $sum = @dist[$i;$k] + @dist[$k;$j] {
local e
@dist[$i;$j] = $sum;
local i, j, k
@next[$i;$j] = @next[$i;$k];
local dist_ij, dist_ik, dist_kj, dist_ikj

n := max_vertex (edges)
distance := create_array ([1, 1], [n, n], &null)
next_vertex := create_array ([1, 1], [n, n], &null)

# Initialization.
every e := !edges do {
ref_array (distance, e[1], e[3]) := e[2]
ref_array (next_vertex, e[1], e[3]) := e[3]
}
every i := 1 to n do {
ref_array (distance, i, i) := 0.0 # Distance to self = 0.
ref_array (next_vertex, i, i) := i
}

# Perform the algorithm. Here &null will play the role of
# "infinity": "\" means a value is finite, "/" that it is infinite.
every k := 1 to n do {
every i := 1 to n do {
every j := 1 to n do {
dist_ij := ref_array (distance, i, j)
dist_ik := ref_array (distance, i, k)
dist_kj := ref_array (distance, k, j)
if \dist_ik & \dist_kj then {
dist_ikj := dist_ik + dist_kj
if /dist_ij | dist_ikj < dist_ij then {
ref_array (distance, i, j) := dist_ikj
ref_array (next_vertex, i, j) :=
ref_array (next_vertex, i, k)
}
}
}
}
}
}
}


return fw_results (n, distance, next_vertex)
say ' Pair Distance Path';
end
for [X] ^$n xx 2 -> ($i, $j){

next if $i == $j;
procedure find_path (next_vertex, u, v)
my @path = $i;
local path
@path.push: @next[@path[*-1];$j] until @path[*-1] == $j;

printf("%d → %d %4d %s\n", $i+1, $j+1, @dist[$i;$j],
if / (ref_array (next_vertex, u, v)) then {
@path.map( *+1 ).join(' → '));
path := []
} else {
path := [u]
while u ~= v do {
u := ref_array (next_vertex, u, v)
put (path, u)
}
}
return path
end

procedure path_to_string (path)
local s

if *path = 0 then {
s := ""
} else {
s := string (path[1])
every s ||:= (" -> " || !path[2 : 0])
}
return s
end

procedure max_vertex (edges)
local e
local m

*edges = 0 & stop ("no edges")
m := 1
every e := !edges do m := max (m, e[1], e[3])
return m
end</syntaxhighlight>

{{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}}==
<syntaxhighlight lang="perl">sub FloydWarshall{
my $edges = shift;
my (@dist, @seq);
my $num_vert = 0;
# insert given dists into dist matrix
map {
$dist[$_->[0] - 1][$_->[1] - 1] = $_->[2];
$num_vert = $_->[0] if $num_vert < $_->[0];
$num_vert = $_->[1] if $num_vert < $_->[1];
} @$edges;
my @vertices = 0..($num_vert - 1);
# init sequence/"next" table
for my $i(@vertices){
for my $j(@vertices){
$seq[$i][$j] = $j if $i != $j;
}
}
# diagonal of dists matrix
#map {$dist[$_][$_] = 0} @vertices;
for my $k(@vertices){
for my $i(@vertices){
next unless defined $dist[$i][$k];
for my $j(@vertices){
next unless defined $dist[$k][$j];
if($i != $j && (!defined($dist[$i][$j])
|| $dist[$i][$j] > $dist[$i][$k] + $dist[$k][$j])){
$dist[$i][$j] = $dist[$i][$k] + $dist[$k][$j];
$seq[$i][$j] = $seq[$i][$k];
}
}
}
}
# print table
print "pair dist path\n";
for my $i(@vertices){
for my $j(@vertices){
next if $i == $j;
my @path = ($i + 1);
while($seq[$path[-1] - 1][$j] != $j){
push @path, $seq[$path[-1] - 1][$j] + 1;
}
push @path, $j + 1;
printf "%d -> %d %4d %s\n",
$path[0], $path[-1], $dist[$i][$j], join(' -> ', @path);
}
}
}
}
}


Floyd-Warshall(4, [[1, 3, -2], [2, 1, 4], [2, 3, 3], [3, 4, 2], [4, 2, -1]]);</lang>
my $graph = [[1, 3, -2], [2, 1, 4], [2, 3, 3], [3, 4, 2], [4, 2, -1]];
FloydWarshall($graph);</syntaxhighlight>
{{out}}
{{out}}
<pre> Pair Distance Path
<pre>pair dist path
1 2 -1 1 3 4 2
1 -> 2 -1 1 -> 3 -> 4 -> 2
1 3 -2 1 3
1 -> 3 -2 1 -> 3
1 4 0 1 3 4
1 -> 4 0 1 -> 3 -> 4
2 1 4 2 1
2 -> 1 4 2 -> 1
2 3 2 2 1 3
2 -> 3 2 2 -> 1 -> 3
2 4 4 2 1 3 4
2 -> 4 4 2 -> 1 -> 3 -> 4
3 1 5 3 4 2 1
3 -> 1 5 3 -> 4 -> 2 -> 1
3 2 1 3 4 2
3 -> 2 1 3 -> 4 -> 2
3 4 2 3 4
3 -> 4 2 3 -> 4
4 1 3 4 2 1
4 -> 1 3 4 -> 2 -> 1
4 2 -1 4 2
4 -> 2 -1 4 -> 2
4 3 1 4 2 1 3
4 -> 3 1 4 -> 2 -> 1 -> 3</pre>

=={{header|Phix}}==
Direct translation of the wikipedia pseudocode
<!--<syntaxhighlight lang="phix">(phixonline)-->
<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>
<span style="color: #008080;">function</span> <span style="color: #000000;">Path</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">u</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">v</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">sequence</span> <span style="color: #000000;">next</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">next</span><span style="color: #0000FF;">[</span><span style="color: #000000;">u</span><span style="color: #0000FF;">,</span><span style="color: #000000;">v</span><span style="color: #0000FF;">]=</span><span style="color: #004600;">null</span> <span style="color: #008080;">then</span>
<span style="color: #008080;">return</span> <span style="color: #008000;">""</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">path</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #7060A8;">sprintf</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"%d"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">u</span><span style="color: #0000FF;">)}</span>
<span style="color: #008080;">while</span> <span style="color: #000000;">u</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">v</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">u</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">next</span><span style="color: #0000FF;">[</span><span style="color: #000000;">u</span><span style="color: #0000FF;">,</span><span style="color: #000000;">v</span><span style="color: #0000FF;">]</span>
<span style="color: #000000;">path</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">path</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">sprintf</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"%d"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">u</span><span style="color: #0000FF;">))</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #008080;">return</span> <span style="color: #7060A8;">join</span><span style="color: #0000FF;">(</span><span style="color: #000000;">path</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"-&gt;"</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">FloydWarshall</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">V</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">sequence</span> <span style="color: #000000;">weights</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">dist</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #000000;">inf</span><span style="color: #0000FF;">,</span><span style="color: #000000;">V</span><span style="color: #0000FF;">),</span><span style="color: #000000;">V</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">next</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #004600;">null</span><span style="color: #0000FF;">,</span><span style="color: #000000;">V</span><span style="color: #0000FF;">),</span><span style="color: #000000;">V</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">k</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">weights</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
<span style="color: #004080;">integer</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">u</span><span style="color: #0000FF;">,</span><span style="color: #000000;">v</span><span style="color: #0000FF;">,</span><span style="color: #000000;">w</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">weights</span><span style="color: #0000FF;">[</span><span style="color: #000000;">k</span><span style="color: #0000FF;">]</span>
<span style="color: #000000;">dist</span><span style="color: #0000FF;">[</span><span style="color: #000000;">u</span><span style="color: #0000FF;">,</span><span style="color: #000000;">v</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">:=</span> <span style="color: #000000;">w</span> <span style="color: #000080;font-style:italic;">-- the weight of the edge (u,v)</span>
<span style="color: #000000;">next</span><span style="color: #0000FF;">[</span><span style="color: #000000;">u</span><span style="color: #0000FF;">,</span><span style="color: #000000;">v</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">:=</span> <span style="color: #000000;">v</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #000080;font-style:italic;">-- standard Floyd-Warshall implementation</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">k</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">V</span> <span style="color: #008080;">do</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">V</span> <span style="color: #008080;">do</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">j</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">V</span> <span style="color: #008080;">do</span>
<span style="color: #004080;">atom</span> <span style="color: #000000;">d</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">dist</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">,</span><span style="color: #000000;">k</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">+</span> <span style="color: #000000;">dist</span><span style="color: #0000FF;">[</span><span style="color: #000000;">k</span><span style="color: #0000FF;">,</span><span style="color: #000000;">j</span><span style="color: #0000FF;">]</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">dist</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">,</span><span style="color: #000000;">j</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">></span> <span style="color: #000000;">d</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">dist</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">,</span><span style="color: #000000;">j</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">:=</span> <span style="color: #000000;">d</span>
<span style="color: #000000;">next</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">,</span><span style="color: #000000;">j</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">:=</span> <span style="color: #000000;">next</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">,</span><span style="color: #000000;">k</span><span style="color: #0000FF;">]</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"pair dist path\n"</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">u</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">V</span> <span style="color: #008080;">do</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">v</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">V</span> <span style="color: #008080;">do</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">u</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">v</span> <span style="color: #008080;">then</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%d-&gt;%d %2d %s\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">u</span><span style="color: #0000FF;">,</span><span style="color: #000000;">v</span><span style="color: #0000FF;">,</span><span style="color: #000000;">dist</span><span style="color: #0000FF;">[</span><span style="color: #000000;">u</span><span style="color: #0000FF;">,</span><span style="color: #000000;">v</span><span style="color: #0000FF;">],</span><span style="color: #000000;">Path</span><span style="color: #0000FF;">(</span><span style="color: #000000;">u</span><span style="color: #0000FF;">,</span><span style="color: #000000;">v</span><span style="color: #0000FF;">,</span><span style="color: #000000;">next</span><span style="color: #0000FF;">)})</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">V</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">4</span>
<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>
<!--</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>
</pre>


=={{header|PHP}}==
=={{header|PHP}}==
<lang php><?php
<syntaxhighlight lang="php"><?php
$graph = array();
$graph = array();
for ($i = 0; $i < 10; ++$i) {
for ($i = 0; $i < 10; ++$i) {
Line 763: Line 4,457:


print_r($graph);
print_r($graph);
?></lang>
?></syntaxhighlight>

=={{header|Prolog}}==
Works with SWI-Prolog as of Jan 2019
<syntaxhighlight lang="prolog">:- use_module(library(clpfd)).

path(List, To, From, [From], W) :-
select([To,From,W],List,_).
path(List, To, From, [Link|R], W) :-
select([To,Link,W1],List,Rest),
W #= W1 + W2,
path(Rest, Link, From, R, W2).

find_path(Din, From, To, [From|Pout], Wout) :-
between(1, 4, From),
between(1, 4, To),
dif(From, To),
findall([W,P], (
path(Din, From, To, P, W),
all_distinct(P)
), Paths),
sort(Paths, [[Wout,Pout]|_]).


print_all_paths :-
D = [[1, 3, -2], [2, 3, 3], [2, 1, 4], [3, 4, 2], [4, 2, -1]],
format('Pair\t Dist\tPath~n'),
forall(
find_path(D, From, To, Path, Weight),(
atomic_list_concat(Path, ' -> ', PPath),
format('~p -> ~p\t ~p\t~w~n', [From, To, Weight, PPath]))).</syntaxhighlight>
{{output}}
<pre>?- print_all_paths.
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
true.

?- </pre>

=={{header|Python}}==
{{trans|Ruby}}
<syntaxhighlight lang="python">from math import inf
from itertools import product

def floyd_warshall(n, edge):
rn = range(n)
dist = [[inf] * n for i in rn]
nxt = [[0] * n for i in rn]
for i in rn:
dist[i][i] = 0
for u, v, w in edge:
dist[u-1][v-1] = w
nxt[u-1][v-1] = v-1
for k, i, j in product(rn, repeat=3):
sum_ik_kj = dist[i][k] + dist[k][j]
if dist[i][j] > sum_ik_kj:
dist[i][j] = sum_ik_kj
nxt[i][j] = nxt[i][k]
print("pair dist path")
for i, j in product(rn, repeat=2):
if i != j:
path = [i]
while path[-1] != j:
path.append(nxt[path[-1]][j])
print("%d → %d %4d %s"
% (i + 1, j + 1, dist[i][j],
' → '.join(str(p + 1) for p in path)))

if __name__ == '__main__':
floyd_warshall(4, [[1, 3, -2], [2, 1, 4], [2, 3, 3], [3, 4, 2], [4, 2, -1]])</syntaxhighlight>

{{output}}
<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|Racket}}==
=={{header|Racket}}==
{{trans|EchoLisp}}
{{trans|EchoLisp}}
<lang racket>#lang typed/racket
<syntaxhighlight lang="racket">#lang typed/racket
(require math/array)
(require math/array)
Line 842: Line 4,631:
(mdist dist+ 1 3)
(mdist dist+ 1 3)
(path next+ 7 6)
(path next+ 7 6)
(path next+ 6 7))</lang>
(path next+ 6 7))</syntaxhighlight>


{{out}}
{{out}}
Line 881: Line 4,670:
'(7 0 3 6)
'(7 0 3 6)
'(6 7)</pre>
'(6 7)</pre>

=={{header|Raku}}==
(formerly Perl 6)
{{works with|Rakudo|2016.12}}
{{trans|Ruby}}

<syntaxhighlight lang="raku" line>sub Floyd-Warshall (Int $n, @edge) {
my @dist = [0, |(Inf xx $n-1)], *.Array.rotate(-1) … !*[*-1];
my @next = [0 xx $n] xx $n;

for @edge -> ($u, $v, $w) {
@dist[$u-1;$v-1] = $w;
@next[$u-1;$v-1] = $v-1;
}

for [X] ^$n xx 3 -> ($k, $i, $j) {
if @dist[$i;$j] > my $sum = @dist[$i;$k] + @dist[$k;$j] {
@dist[$i;$j] = $sum;
@next[$i;$j] = @next[$i;$k];
}
}

say ' Pair Distance Path';
for [X] ^$n xx 2 -> ($i, $j){
next if $i == $j;
my @path = $i;
@path.push: @next[@path[*-1];$j] until @path[*-1] == $j;
printf("%d → %d %4d %s\n", $i+1, $j+1, @dist[$i;$j],
@path.map( *+1 ).join(' → '));
}
}

Floyd-Warshall(4, [[1, 3, -2], [2, 1, 4], [2, 3, 3], [3, 4, 2], [4, 2, -1]]);</syntaxhighlight>
{{out}}
<pre> Pair Distance 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|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}}==
<syntaxhighlight lang="rexx">/*REXX program uses Floyd─Warshall algorithm to find shortest distance between vertices.*/
v= 4 /*███ {1} ███*/ /*number of vertices in weighted graph.*/
@.= 99999999 /*███ 4 / \ -2 ███*/ /*the default distance (edge weight). */
@.1.3= -2 /*███ / 3 \ ███*/ /*the distance (weight) for an edge. */
@.2.1= 4 /*███ {2} ────► {3} ███*/ /* " " " " " " */
@.2.3= 3 /*███ \ / ███*/ /* " " " " " " */
@.3.4= 2 /*███ -1 \ / 2 ███*/ /* " " " " " " */
@.4.2= -1 /*███ {4} ███*/ /* " " " " " " */

do k=1 for v
do i=1 for v
do j=1 for v; _= @.i.k + @.k.j /*add two nodes together. */
if @.i.j>_ then @.i.j= _ /*use a new distance (weight) for edge.*/
end /*j*/
end /*i*/
end /*k*/
w= 12; $= left('', 20) /*width of the columns for the output. */
say $ center('vertices',w) center('distance', w) /*display the 1st line of the title. */
say $ center('pair' ,w) center('(weight)', w) /* " " 2nd " " " " */
say $ copies('═' ,w) copies('═' , w) /* " " 3rd " " " " */
/* [↓] display edge distances (weight)*/
do f=1 for v /*process each of the "from" vertices. */
do t=1 for v; if f==t then iterate /* " " " " "to" " */
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. */</syntaxhighlight>
{{out|output|text=&nbsp; when using the default inputs:}}
<pre>
vertices distance
pair (weight)
════════════ ════════════
1 ───► 2 -1
1 ───► 3 -2
1 ───► 4 0
2 ───► 1 4
2 ───► 3 2
2 ───► 4 4
3 ───► 1 5
3 ───► 2 1
3 ───► 4 2
4 ───► 1 3
4 ───► 2 -1
4 ───► 3 1
</pre>


=={{header|Ruby}}==
=={{header|Ruby}}==
<lang ruby>def floyd_warshall(n, edge)
<syntaxhighlight lang="ruby">def floyd_warshall(n, edge)
dist = Array.new(n){|i| Array.new(n){|j| i==j ? 0 : Float::INFINITY}}
dist = Array.new(n){|i| Array.new(n){|j| i==j ? 0 : Float::INFINITY}}
nxt = Array.new(n){Array.new(n)}
nxt = Array.new(n){Array.new(n)}
Line 917: Line 5,106:
n = 4
n = 4
edge = [[1, 3, -2], [2, 1, 4], [2, 3, 3], [3, 4, 2], [4, 2, -1]]
edge = [[1, 3, -2], [2, 1, 4], [2, 3, 3], [3, 4, 2], [4, 2, -1]]
floyd_warshall(n, edge)</lang>
floyd_warshall(n, edge)</syntaxhighlight>


{{out}}
{{out}}
Line 934: Line 5,123:
4 -> 2 -1 4 -> 2
4 -> 2 -1 4 -> 2
4 -> 3 1 4 -> 2 -> 1 -> 3
4 -> 3 1 4 -> 2 -> 1 -> 3
</pre>

=={{header|Rust}}==
The lack of built-in support for multi-dimensional arrays makes the task in Rust
a bit lengthy (without additional crates). The used graph representation leverages
Rust's generics, so that it works with any type that defines addition and ordering
and it requires no special value for infinity.

<syntaxhighlight lang="rust">pub type Edge = (usize, usize);

#[derive(Clone, Debug, PartialEq, Eq, Hash)]
pub struct Graph<T> {
size: usize,
edges: Vec<Option<T>>,
}

impl<T> Graph<T> {
pub fn new(size: usize) -> Self {
Self {
size,
edges: std::iter::repeat_with(|| None).take(size * size).collect(),
}
}

pub fn new_with(size: usize, f: impl FnMut(Edge) -> Option<T>) -> Self {
let edges = (0..size)
.flat_map(|i| (0..size).map(move |j| (i, j)))
.map(f)
.collect();

Self { size, edges }
}

pub fn with_diagonal(mut self, mut f: impl FnMut(usize) -> Option<T>) -> Self {
self.edges
.iter_mut()
.step_by(self.size + 1)
.enumerate()
.for_each(move |(vertex, edge)| *edge = f(vertex));

self
}

pub fn size(&self) -> usize {
self.size
}

pub fn edge(&self, edge: Edge) -> &Option<T> {
let index = self.edge_index(edge);
&self.edges[index]
}

pub fn edge_mut(&mut self, edge: Edge) -> &mut Option<T> {
let index = self.edge_index(edge);
&mut self.edges[index]
}

fn edge_index(&self, (row, col): Edge) -> usize {
assert!(row < self.size && col < self.size);
row * self.size() + col
}
}

impl<T> std::ops::Index<Edge> for Graph<T> {
type Output = Option<T>;

fn index(&self, index: Edge) -> &Self::Output {
self.edge(index)
}
}

impl<T> std::ops::IndexMut<Edge> for Graph<T> {
fn index_mut(&mut self, index: Edge) -> &mut Self::Output {
self.edge_mut(index)
}
}

#[derive(Clone, Debug, PartialEq, Eq)]
pub struct Paths(Graph<usize>);

impl Paths {
pub fn new<T>(graph: &Graph<T>) -> Self {
Self(Graph::new_with(graph.size(), |(i, j)| {
graph[(i, j)].as_ref().map(|_| j)
}))
}

pub fn vertices(&self, from: usize, to: usize) -> Path<'_> {
assert!(from < self.0.size() && to < self.0.size());

Path {
graph: &self.0,
from: Some(from),
to,
}
}

fn update(&mut self, from: usize, to: usize, via: usize) {
self.0[(from, to)] = self.0[(from, via)];
}
}

#[derive(Clone, Copy, Debug, PartialEq, Eq)]
pub struct Path<'a> {
graph: &'a Graph<usize>,
from: Option<usize>,
to: usize,
}

impl<'a> Iterator for Path<'a> {
type Item = usize;

fn next(&mut self) -> Option<Self::Item> {
self.from.map(|from| {
let result = from;

self.from = if result != self.to {
self.graph[(result, self.to)]
} else {
None
};

result
})
}
}

pub fn floyd_warshall<W>(mut result: Graph<W>) -> (Graph<W>, Option<Paths>)
where
W: Copy + std::ops::Add<W, Output = W> + std::cmp::Ord + Default,
{
let mut without_negative_cycles = true;
let mut paths = Paths::new(&result);
let n = result.size();

for k in 0..n {
for i in 0..n {
for j in 0..n {
// Negative cycle detection with T::default as the negative boundary
if i == j && result[(i, j)].filter(|&it| it < W::default()).is_some() {
without_negative_cycles = false;
continue;
}

if let (Some(ik_weight), Some(kj_weight)) = (result[(i, k)], result[(k, j)]) {
let ij_edge = result.edge_mut((i, j));
let ij_weight = ik_weight + kj_weight;

if ij_edge.is_none() {
*ij_edge = Some(ij_weight);
paths.update(i, j, k);
} else {
ij_edge
.as_mut()
.filter(|it| ij_weight < **it)
.map_or((), |it| {
*it = ij_weight;
paths.update(i, j, k);
});
}
}
}
}
}

(result, Some(paths).filter(|_| without_negative_cycles)) // No paths for negative cycles
}

fn format_path<T: ToString>(path: impl Iterator<Item = T>) -> String {
path.fold(String::new(), |mut acc, x| {
if !acc.is_empty() {
acc.push_str(" -> ");
}

acc.push_str(&x.to_string());
acc
})
}

fn print_results<W, V>(weights: &Graph<W>, paths: Option<&Paths>, vertex: impl Fn(usize) -> V)
where
W: std::fmt::Display + Default + Eq,
V: std::fmt::Display,
{
let n = weights.size();

for from in 0..n {
for to in 0..n {
if let Some(weight) = &weights[(from, to)] {
// Skip trivial information (i.e., default weight on the diagonal)
if from == to && *weight == W::default() {
continue;
}

println!(
"{} -> {}: {} \t{}",
vertex(from),
vertex(to),
weight,
format_path(paths.iter().flat_map(|p| p.vertices(from, to)).map(&vertex))
);
}
}
}
}

fn main() {
let graph = {
let mut g = Graph::new(4).with_diagonal(|_| Some(0));
g[(0, 2)] = Some(-2);
g[(1, 0)] = Some(4);
g[(1, 2)] = Some(3);
g[(2, 3)] = Some(2);
g[(3, 1)] = Some(-1);
g
};

let (weights, paths) = floyd_warshall(graph);
// Fixup the vertex name (as we use zero-based indices)
print_results(&weights, paths.as_ref(), |index| index + 1);
}
</syntaxhighlight>

{{out}}
<pre>
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|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>

=={{header|Scheme}}==
{{works with|Scheme|R7RS small}}

I have run this program successfully in Chibi, Gauche, and CHICKEN 5 Schemes. (One may need an extension to run R7RS code in CHICKEN.)

<syntaxhighlight lang="scheme">;;; Floyd-Warshall algorithm.
;;;
;;; See https://en.wikipedia.org/w/index.php?title=Floyd%E2%80%93Warshall_algorithm&oldid=1082310013
;;;

(import (scheme base))
(import (scheme cxr))
(import (scheme write))

;;;
;;; A square array will be represented by a cons-pair:
;;;
;;; (vector-of-length n-squared . n)
;;;
;;; Arrays are indexed *starting at one*.
;;;

(define (make-arr n fill)
(cons (make-vector (* n n) fill) n))

(define (arr-set! arr i j x)
(let ((vec (car arr))
(n (cdr arr)))
(vector-set! vec (+ (- i 1) (* n (- j 1))) x)))

(define (arr-ref arr i j)
(let ((vec (car arr))
(n (cdr arr)))
(vector-ref vec (+ (- i 1) (* n (- 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 (to help keep this example brief)
;;; integers from 1 .. n.
;;;

(define (floyd-warshall edges)

(define n
;; Set n to the maximum vertex number. By design, n also equals
;; the number of vertices.
(max (apply max (map car edges))
(apply max (map caddr edges))))

(define distance (make-arr n +inf.0))
(define next-vertex (make-arr n #f))

;; Initialize "distance" and "next-vertex".
(for-each (lambda (edge)
(let ((u (car edge))
(weight (cadr edge))
(v (caddr edge)))
(arr-set! distance u v weight)
(arr-set! next-vertex u v v)))
edges)
(do ((v 1 (+ v 1)))
((< n v))
(arr-set! distance v v 0)
(arr-set! next-vertex v v v))

;; Perform the algorithm.
(do ((k 1 (+ k 1)))
((< n k))
(do ((i 1 (+ i 1)))
((< n i))
(do ((j 1 (+ j 1)))
((< n j))
(let ((dist-ij (arr-ref distance i j))
(dist-ik (arr-ref distance i k))
(dist-kj (arr-ref distance k j)))
(let ((dist-ik+dist-kj (+ dist-ik dist-kj)))
(when (< dist-ik+dist-kj dist-ij)
(arr-set! distance i j dist-ik+dist-kj)
(arr-set! next-vertex i j
(arr-ref next-vertex 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.
;;;

(define (find-path next-vertex u v)
(if (not (arr-ref next-vertex u v))
(list)
(let loop ((u u)
(path (list u)))
(if (= u v)
(reverse path)
(let ((u^ (arr-ref next-vertex u v)))
(loop u^ (cons u^ path)))))))

(define (display-path path)
(let loop ((p path))
(cond ((null? p))
((null? (cdr p)) (display (car p)))
(else (display (car p))
(display " -> ")
(loop (cdr p))))))

(define example-graph
'((1 -2 3)
(3 2 4)
(4 -1 2)
(2 4 1)
(2 3 3)))

(let-values (((n distance next-vertex)
(floyd-warshall example-graph)))
(display " pair distance path")
(newline)
(display "------------------------------------")
(newline)
(do ((u 1 (+ u 1)))
((< n u))
(do ((v 1 (+ v 1)))
((< n v))
(unless (= u v)
(display u)
(display " -> ")
(display v)
(let* ((s (number->string (arr-ref distance u v)))
(slen (string-length s))
(padding (- 7 slen)))
(display (make-string padding #\space))
(display s))
(display " ")
(display-path (find-path next-vertex u v))
(newline)))))</syntaxhighlight>

{{out}}
<pre>$ gosh floyd-warshall.scm
pair distance 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|SequenceL}}==
{{trans|Go}}
<syntaxhighlight lang="sequencel">import <Utilities/Sequence.sl>;
import <Utilities/Math.sl>;

ARC ::= (To: int, Weight: float);
arc(t,w) := (To: t, Weight: w);
VERTEX ::= (Label: int, Arcs: ARC(1));
vertex(l,arcs(1)) := (Label: l, Arcs: arcs);

getArcsFrom(vertex, graph(1)) :=
let
index := firstIndexOf(graph.Label, vertex);
in
[] when index = 0
else
graph[index].Arcs;

getWeightTo(vertex, arcs(1)) :=
let
index := firstIndexOf(arcs.To, vertex);
in
0 when index = 0
else
arcs[index].Weight;
throughK(k, dist(2)) :=
let
newDist[i, j] := min(dist[i][k] + dist[k][j], dist[i][j]);
in
dist when k > size(dist)
else
throughK(k + 1, newDist);

floydWarshall(graph(1)) :=
let
initialResult[i,j] := 1.79769e308 when i /= j else 0
foreach i within 1 ... size(graph),
j within 1 ... size(graph);
singleResult[i,j] := getWeightTo(j, getArcsFrom(i, graph))
foreach i within 1 ... size(graph),
j within 1 ... size(graph);
start[i,j] :=
initialResult[i,j] when singleResult[i,j] = 0
else
singleResult[i,j];
in
throughK(1, start);

main() :=
let
graph := [vertex(1, [arc(3,-2)]),
vertex(2, [arc(1,4), arc(3,3)]),
vertex(3, [arc(4,2)]),
vertex(4, [arc(2,-1)])];
in
floydWarshall(graph);</syntaxhighlight>

{{out}}
<pre>
[[0,-1,-2,0],[4,0,2,4],[5,1,0,2],[3,-1,1,0]]
</pre>
</pre>


=={{header|Sidef}}==
=={{header|Sidef}}==
{{trans|Ruby}}
{{trans|Ruby}}
<lang ruby>func floyd_warshall(n, edge) {
<syntaxhighlight lang="ruby">func floyd_warshall(n, edge) {
var dist = n.of { |i| n.of { |j| i == j ? 0 : Inf }}
var dist = n.of {|i| n.of { |j| i == j ? 0 : Inf }}
var nxt = n.of { n.of(nil) }
var nxt = n.of { n.of(nil) }
for u,v,w in edge {
for u,v,w in edge {
Line 946: Line 5,671:
}
}


for k in ^n {
[^n] * 3 -> cartesian { |k, i, j|
for i in ^n {
if (dist[i][j] > dist[i][k]+dist[k][j]) {
for j in ^n {
dist[i][j] = dist[i][k]+dist[k][j]
if (dist[i][j] > dist[i][k]+dist[k][j]) {
nxt[i][j] = nxt[i][k]
dist[i][j] = dist[i][k]+dist[k][j]
nxt[i][j] = nxt[i][k]
}
}
}
}
}
}

var summary = "pair dist path\n"
var summary = "pair dist path\n"
for i in ^n {
for i,j (^n ~X ^n) {
for j in ^n {
i==j && next
i==j && next
var u = i
var u = i
var path = [u]
var path = [u]
while (u != j) {
while (u != j) {
path << (u = nxt[u][j])
path << (u = nxt[u][j])
}
path.map!{|u| u+1 }.join!(" -> ")
summary += ("%d -> %d %4d %s\n" % (i+1, j+1, dist[i][j], path))
}
}
path.map!{|u| u+1 }.join!(" -> ")
summary += ("%d -> %d %4d %s\n" % (i+1, j+1, dist[i][j], path))
}
}


Line 976: Line 5,695:
var n = 4
var n = 4
var edge = [[1, 3, -2], [2, 1, 4], [2, 3, 3], [3, 4, 2], [4, 2, -1]]
var edge = [[1, 3, -2], [2, 1, 4], [2, 3, 3], [3, 4, 2], [4, 2, -1]]
print floyd_warshall(n, edge)</lang>
print floyd_warshall(n, edge)</syntaxhighlight>
{{out}}
{{out}}
<pre>
<pre>
Line 993: Line 5,712:
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}}
{{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}}==
=={{header|Tcl}}==
Line 1,000: Line 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:
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:


<lang Tcl>package require Tcl 8.5 ;# for {*} and [dict]
<syntaxhighlight lang="tcl">package require Tcl 8.5 ;# for {*} and [dict]
package require struct::graph
package require struct::graph
package require struct::graph::op
package require struct::graph::op
Line 1,030: Line 6,104:
set paths [dict filter $paths value {[0-9]*}] ;# whose cost is not "Inf"
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
set paths [lsort -stride 2 -index 1 -real -decreasing $paths] ;# and print the longest first
puts $paths</lang>
puts $paths</syntaxhighlight>


{{out}}
{{out}}
<pre>{a q} 6.0 {a g} 6.0 {a f} 5.0 {a e} 4.0 {a d} 3.0 {a m} 2.0 {a c} 2.0 {a p} 1.0 {a b} 1.0 {a a} 0</pre>
<pre>{a q} 6.0 {a g} 6.0 {a f} 5.0 {a e} 4.0 {a d} 3.0 {a m} 2.0 {a c} 2.0 {a p} 1.0 {a b} 1.0 {a a} 0</pre>

=={{header|Visual Basic .NET}}==
{{trans|C#}}
<syntaxhighlight lang="vbnet">Module Module1

Sub PrintResult(dist As Double(,), nxt As Integer(,))
Console.WriteLine("pair dist path")
For i = 1 To nxt.GetLength(0)
For j = 1 To nxt.GetLength(1)
If i <> j Then
Dim u = i
Dim v = j
Dim path = String.Format("{0} -> {1} {2,2:G} {3}", u, v, dist(i - 1, j - 1), u)
Do
u = nxt(u - 1, v - 1)
path += String.Format(" -> {0}", u)
Loop While u <> v
Console.WriteLine(path)
End If
Next
Next
End Sub

Sub FloydWarshall(weights As Integer(,), numVerticies As Integer)
Dim dist(numVerticies - 1, numVerticies - 1) As Double
For i = 1 To numVerticies
For j = 1 To numVerticies
dist(i - 1, j - 1) = Double.PositiveInfinity
Next
Next

For i = 1 To weights.GetLength(0)
dist(weights(i - 1, 0) - 1, weights(i - 1, 1) - 1) = weights(i - 1, 2)
Next

Dim nxt(numVerticies - 1, numVerticies - 1) As Integer
For i = 1 To numVerticies
For j = 1 To numVerticies
If i <> j Then
nxt(i - 1, j - 1) = j
End If
Next
Next

For k = 1 To numVerticies
For i = 1 To numVerticies
For j = 1 To numVerticies
If dist(i - 1, k - 1) + dist(k - 1, j - 1) < dist(i - 1, j - 1) Then
dist(i - 1, j - 1) = dist(i - 1, k - 1) + dist(k - 1, j - 1)
nxt(i - 1, j - 1) = nxt(i - 1, k - 1)
End If
Next
Next
Next

PrintResult(dist, nxt)
End Sub

Sub Main()
Dim weights = {{1, 3, -2}, {2, 1, 4}, {2, 3, 3}, {3, 4, 2}, {4, 2, -1}}
Dim numVeritices = 4

FloydWarshall(weights, numVeritices)
End Sub

End Module</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|Wren}}==
{{trans|Kotlin}}
{{libheader|Wren-fmt}}
<syntaxhighlight lang="wren">import "./fmt" for Fmt

class FloydWarshall {
static doCalcs(weights, nVertices) {
var dist = List.filled(nVertices, null)
for (i in 0...nVertices) dist[i] = List.filled(nVertices, 1/0)
for (w in weights) dist[w[0] - 1][w[1] - 1] = w[2]
var next = List.filled(nVertices, null)
for (i in 0...nVertices) next[i] = List.filled(nVertices, 0)
for (i in 0...next.count) {
for (j in 0...next.count) {
if (i != j) next[i][j] = j + 1
}
}
for (k in 0...nVertices) {
for (i in 0...nVertices) {
for (j in 0...nVertices) {
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)
}

static printResult_(dist, next) {
System.print("pair dist path")
for (i in 0...next.count) {
for (j in 0...next.count) {
if (i != j) {
var u = i + 1
var v = j + 1
var path = Fmt.swrite("$d -> $d $2d $s", u, v, dist[i][j].truncate, u)
while (true) {
u = next[u - 1][v - 1]
path = path + " -> " + u.toString
if (u == v) break
}
System.print(path)
}
}
}
}
}

var weights = [ [1, 3, -2], [2, 1, 4], [2, 3, 3], [3, 4, 2], [4, 2, -1] ]
var nVertices = 4
FloydWarshall.doCalcs(weights, nVertices)</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|zkl}}==
=={{header|zkl}}==
<lang zkl>fcn FloydWarshallWithPathReconstruction(dist){ // dist is munged
<syntaxhighlight lang="zkl">fcn FloydWarshallWithPathReconstruction(dist){ // dist is munged
V:=dist[0].len();
V:=dist[0].len();
next:=V.pump(List,V.pump(List,Void.copy).copy); // VxV matrix of Void
next:=V.pump(List,V.pump(List,Void.copy).copy); // VxV matrix of Void
Line 1,043: Line 6,268:
a,b,c:=dist[i][j],dist[i][k],dist[k][j];
a,b,c:=dist[i][j],dist[i][k],dist[k][j];
if( (a!=Void and b!=Void and c!=Void and a>b+c) or // Inf math
if( (a!=Void and b!=Void and c!=Void and a>b+c) or // Inf math
(a==Void and b!=Void and c!=Void) ){
(a==Void and b!=Void and c!=Void) ){
dist[i][j] = b+c;
dist[i][j] = b+c;
next[i][j] = next[i][k];
next[i][j] = next[i][k];
}
}
}
}
Line 1,057: Line 6,282:
}
}
fcn printM(m){ m.pump(Console.println,rowFmt) }
fcn printM(m){ m.pump(Console.println,rowFmt) }
fcn rowFmt(row){ ("%5s "*row.len()).fmt(row.xplode()) }</lang>
fcn rowFmt(row){ ("%5s "*row.len()).fmt(row.xplode()) }</syntaxhighlight>
<lang zkl>const V=4;
<syntaxhighlight lang="zkl">const V=4;
dist:=V.pump(List,V.pump(List,Void.copy).copy); // VxV matrix of Void
dist:=V.pump(List,V.pump(List,Void.copy).copy); // VxV matrix of Void
foreach i in (V){ dist[i][i] = 0 } // zero vertexes
foreach i in (V){ dist[i][i] = 0 } // zero vertexes


/* Graph from the Wikipedia:
/* Graph from the Wikipedia:
Line 1,074: Line 6,299:
dist,next:=FloydWarshallWithPathReconstruction(dist);
dist,next:=FloydWarshallWithPathReconstruction(dist);
println("Shortest distance array:"); printM(dist);
println("Shortest distance array:"); printM(dist);
println("\nPath array:"); printM(next);
println("\nPath array:"); printM(next);
println("\nAll paths:");
println("\nAll paths:");
foreach u,v in (V,V){
foreach u,v in (V,V){
if(p:=path(next,u,v)) p.println();
if(p:=path(next,u,v)) p.println();
}</lang>
}</syntaxhighlight>
{{out}}
{{out}}
<pre>
<pre>

Latest revision as of 10:49, 1 February 2024

Task
Floyd-Warshall algorithm
You are encouraged to solve this task according to the task description, using any language you may know.

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



11l

Translation of: Python
F floyd_warshall(n, edge)
   V rn = 0 .< n
   V dist = rn.map(i -> [1'000'000] * @n)
   V nxt  = rn.map(i -> [0]         * @n)
   L(i) rn
      dist[i][i] = 0
   L(u, v, w) edge
      dist[u - 1][v - 1] = w
      nxt[u - 1][v - 1] = v - 1
   L(k, i, j) cart_product(rn, rn, rn)
      V sum_ik_kj = dist[i][k] + dist[k][j]
      I dist[i][j] > sum_ik_kj
         dist[i][j] = sum_ik_kj
         nxt[i][j] = nxt[i][k]
   print(‘pair      dist     path’)
   L(i, j) cart_product(rn, rn)
      I i != j
         V path = [i]
         L path.last != j
            path.append(nxt[path.last][j])
         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)])
Output:
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

360 Assembly

Translation of: Rexx
*        Floyd-Warshall algorithm - 06/06/2018
FLOYDWAR CSECT
         USING  FLOYDWAR,R13       base register
         B      72(R15)            skip savearea
         DC     17F'0'             savearea
         SAVE   (14,12)            save previous context
         ST     R13,4(R15)         link backward
         ST     R15,8(R13)         link forward
         LR     R13,R15            set addressability
         MVC    A+8,=F'-2'         a(1,3)=-2
         MVC    A+VV*4,=F'4'       a(2,1)= 4
         MVC    A+VV*4+8,=F'3'     a(2,3)= 3
         MVC    A+VV*8+12,=F'2'    a(3,4)= 2
         MVC    A+VV*12+4,=F'-1'   a(4,2)=-1
         LA     R8,1               k=1
       DO WHILE=(C,R8,LE,V)        do k=1 to v
         LA     R10,A                @a
         LA     R6,1                 i=1
       DO WHILE=(C,R6,LE,V)          do i=1 to v
         LA     R7,1                   j=1
       DO WHILE=(C,R7,LE,V)            do j=1 to v
         LR     R1,R6                    i
         BCTR   R1,0
         MH     R1,=AL2(VV)
         AR     R1,R8                    k
         SLA    R1,2
         L      R9,A-4(R1)               a(i,k)
         LR     R1,R8                    k
         BCTR   R1,0
         MH     R1,=AL2(VV)
         AR     R1,R7                    j
         SLA    R1,2
         L      R3,A-4(R1)               a(k,j)
         AR     R9,R3                    w=a(i,k)+a(k,j)
         L      R2,0(R10)                a(i,j)
       IF CR,R2,GT,R9 THEN               if a(i,j)>w then
         ST     R9,0(R10)                  a(i,j)=w
       ENDIF    ,                        endif
         LA     R10,4(R10)               next @a
         LA     R7,1(R7)                 j++
       ENDDO    ,                      enddo j
         LA     R6,1(R6)               i++
       ENDDO    ,                    enddo i
         LA     R8,1(R8)             k++
       ENDDO    ,                  enddo k
         LA     R10,A              @a
         LA     R6,1               f=1
       DO WHILE=(C,R6,LE,V)        do f=1 to v
         LA     R7,1                 t=1
       DO WHILE=(C,R7,LE,V)          do t=1 to v
       IF CR,R6,NE,R7 THEN             if f^=t then do
         LR     R1,R6                    f
         XDECO  R1,XDEC                  edit f
         MVC    PG+0(4),XDEC+8           output f
         LR     R1,R7                    t
         XDECO  R1,XDEC                  edit t
         MVC    PG+8(4),XDEC+8           output t
         L      R2,0(R10)                a(f,t)
         XDECO  R2,XDEC                  edit a(f,t)
         MVC    PG+12(4),XDEC+8          output a(f,t)
         XPRNT  PG,L'PG                  print
       ENDIF    ,                      endif
         LA     R10,4(R10)             next @a
         LA     R7,1(R7)               t++
       ENDDO    ,                    enddo t
         LA     R6,1(R6)             f++
       ENDDO    ,                  enddo f
         L      R13,4(0,R13)       restore previous savearea pointer
         RETURN (14,12),RC=0       restore registers from calling sav
VV       EQU    4
V        DC     A(VV)
A        DC     (VV*VV)F'99999999' a(vv,vv)
PG       DC     CL80'   . ->    .   .'
XDEC     DS     CL12
         YREGS
         END    FLOYDWAR
Output:
   1 ->    2  -1
   1 ->    3  -2
   1 ->    4   0
   2 ->    1   4
   2 ->    3   2
   2 ->    4   4
   3 ->    1   5
   3 ->    2   1
   3 ->    4   2
   4 ->    1   3
   4 ->    2  -1
   4 ->    3   1

Ada

Translation of: Scheme


--
-- Floyd-Warshall algorithm.
--
-- See https://en.wikipedia.org/w/index.php?title=Floyd%E2%80%93Warshall_algorithm&oldid=1082310013
--

with Ada.Containers.Vectors;
with Ada.Text_IO; use Ada.Text_IO;
with Interfaces;  use Interfaces;

with Ada.Numerics.Generic_Elementary_Functions;

procedure floyd_warshall_task
is
  Floyd_Warshall_Exception : exception;

  -- The floating point type we shall use is one that has infinities.
  subtype FloatPt is IEEE_Float_32;
  package FloatPt_Elementary_Functions is new Ada.Numerics
   .Generic_Elementary_Functions
   (FloatPt);
  use FloatPt_Elementary_Functions;

  -- The following should overflow and give us an IEEE infinity. But I
  -- have kept the code so you could use some non-IEEE floating point
  -- format and set ENORMOUS_FloatPt to some value that is finite but
  -- much larger than actual graph traversal distances.
  ENORMOUS_FloatPt : constant FloatPt :=
   (FloatPt (1.0) / FloatPt (1.0e-37))**1.0e37;

  --
  -- Input is a Vector of records representing the edges of a graph.
  --
  -- Vertices are identified by integers from 1 .. n.
  --

  type edge is record
    u      : Positive;
    weight : FloatPt;
    v      : Positive;
  end record;

  package Edge_Vectors is new Ada.Containers.Vectors
   (Index_Type => Positive, Element_Type => edge);
  use Edge_Vectors;
  subtype edge_vector is Edge_Vectors.Vector;

  --
  -- Floyd-Warshall.
  --

  type distance_array is
   array (Positive range <>, Positive range <>) of FloatPt;

  type next_vertex_array is
   array (Positive range <>, Positive range <>) of Natural;
  Nil_Vertex : constant Natural := 0;

  function find_max_vertex      -- Find the maximum vertex number.
   (edges : in edge_vector)
    return Positive
  is
    max_vertex : Positive;
  begin
    if Is_Empty (edges) then
      raise Floyd_Warshall_Exception with "no edges";
    end if;
    max_vertex := 1;
    for i in edges.First_Index .. edges.Last_Index loop
      max_vertex := Positive'Max (max_vertex, edges.Element (i).u);
      max_vertex := Positive'Max (max_vertex, edges.Element (i).v);
    end loop;
    return max_vertex;
  end find_max_vertex;

  procedure floyd_warshall      -- Perform Floyd-Warshall.
   (edges       : in     edge_vector;
    max_vertex  : in     Positive;
    distance    :    out distance_array;
    next_vertex :    out next_vertex_array)
  is
    u, v     : Positive;
    dist_ikj : FloatPt;
  begin

    -- Initialize.

    for i in 1 .. max_vertex loop
      for j in 1 .. max_vertex loop
        distance (i, j)    := ENORMOUS_FloatPt;
        next_vertex (i, j) := Nil_Vertex;
      end loop;
    end loop;
    for i in edges.First_Index .. edges.Last_Index loop
      u                  := edges.Element (i).u;
      v                  := edges.Element (i).v;
      distance (u, v)    := edges.Element (i).weight;
      next_vertex (u, v) := v;
    end loop;
    for i in 1 .. max_vertex loop
      distance (i, i) :=
       FloatPt (0.0);           -- Distance from a vertex to itself.
      next_vertex (i, i) := i;
    end loop;

    -- Perform the algorithm.

    for k in 1 .. max_vertex loop
      for i in 1 .. max_vertex loop
        for j in 1 .. max_vertex loop
          dist_ikj := distance (i, k) + distance (k, j);
          if dist_ikj < distance (i, j) then
            distance (i, j)    := dist_ikj;
            next_vertex (i, j) := next_vertex (i, k);
          end if;
        end loop;
      end loop;
    end loop;

  end floyd_warshall;

  --
  -- Path reconstruction.
  --

  procedure put_path
   (next_vertex : in next_vertex_array;
    u, v        : in Positive)
  is
    i : Positive;
  begin
    if next_vertex (u, v) /= Nil_Vertex then
      i := u;
      Put (Positive'Image (i));
      while i /= v loop
        Put (" ->");
        i := next_vertex (i, v);
        Put (Positive'Image (i));
      end loop;
    end if;
  end put_path;

  example_graph : edge_vector;
  max_vertex    : Positive;

begin
  Append (example_graph, (u => 1, weight => FloatPt (-2.0), v => 3));
  Append (example_graph, (u => 3, weight => FloatPt (+2.0), v => 4));
  Append (example_graph, (u => 4, weight => FloatPt (-1.0), v => 2));
  Append (example_graph, (u => 2, weight => FloatPt (+4.0), v => 1));
  Append (example_graph, (u => 2, weight => FloatPt (+3.0), v => 3));

  max_vertex := find_max_vertex (example_graph);

  declare

    distance    : distance_array (1 .. max_vertex, 1 .. max_vertex);
    next_vertex : next_vertex_array
     (1 .. max_vertex, 1 .. max_vertex);

  begin

    floyd_warshall (example_graph, max_vertex, distance, next_vertex);

    Put_Line ("  pair       distance        path");
    Put_Line ("---------------------------------------------");
    for u in 1 .. max_vertex loop
      for v in 1 .. max_vertex loop
        if u /= v then
          Put (Positive'Image (u));
          Put (" ->");
          Put (Positive'Image (v));
          Put ("    ");
          Put (FloatPt'Image (distance (u, v)));
          Put ("    ");
          put_path (next_vertex, u, v);
          Put_Line ("");
        end if;
      end loop;
    end loop;

  end;
end floyd_warshall_task;
Output:
$ gnatmake -q floyd_warshall_task.adb && ./floyd_warshall_task
  pair       distance        path
---------------------------------------------
 1 -> 2    -1.00000E+00     1 -> 3 -> 4 -> 2
 1 -> 3    -2.00000E+00     1 -> 3
 1 -> 4     0.00000E+00     1 -> 3 -> 4
 2 -> 1     4.00000E+00     2 -> 1
 2 -> 3     2.00000E+00     2 -> 1 -> 3
 2 -> 4     4.00000E+00     2 -> 1 -> 3 -> 4
 3 -> 1     5.00000E+00     3 -> 4 -> 2 -> 1
 3 -> 2     1.00000E+00     3 -> 4 -> 2
 3 -> 4     2.00000E+00     3 -> 4
 4 -> 1     3.00000E+00     4 -> 2 -> 1
 4 -> 2    -1.00000E+00     4 -> 2
 4 -> 3     1.00000E+00     4 -> 2 -> 1 -> 3

ALGOL 68

Translation of: Lua
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
Output:
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

ATS

A first implementation

Translation of: Ada
Translation of: 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.


(*
  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
Output:
$ 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


A second implementation

Translation of: Standard ML


A second version. An explanation of "Why a second version?" is contained in the program text.


(*
  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

(*------------------------------------------------------------------*)
Output:
$ 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

C

Reads the graph from a file, prints out usage on incorrect invocation.

#include<limits.h>
#include<stdlib.h>
#include<stdio.h>

typedef struct{
    int sourceVertex, destVertex;
    int edgeWeight;
}edge;

typedef struct{
    int vertices, edges;
    edge* edgeMatrix;
}graph;

graph loadGraph(char* fileName){
    FILE* fp = fopen(fileName,"r");
    
    graph G;
    int i;
    
    fscanf(fp,"%d%d",&G.vertices,&G.edges);
    
    G.edgeMatrix = (edge*)malloc(G.edges*sizeof(edge));
    
    for(i=0;i<G.edges;i++)
        fscanf(fp,"%d%d%d",&G.edgeMatrix[i].sourceVertex,&G.edgeMatrix[i].destVertex,&G.edgeMatrix[i].edgeWeight);
    
    fclose(fp);
    
    return G;
}

void floydWarshall(graph g){
    int processWeights[g.vertices][g.vertices], processedVertices[g.vertices][g.vertices];
    int i,j,k;
    
    for(i=0;i<g.vertices;i++)
        for(j=0;j<g.vertices;j++){
            processWeights[i][j] = SHRT_MAX;
            processedVertices[i][j] = (i!=j)?j+1:0;
        }
        
    for(i=0;i<g.edges;i++)
        processWeights[g.edgeMatrix[i].sourceVertex-1][g.edgeMatrix[i].destVertex-1] = g.edgeMatrix[i].edgeWeight;
        
    for(i=0;i<g.vertices;i++)
        for(j=0;j<g.vertices;j++)
            for(k=0;k<g.vertices;k++){
                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];
                }
            }
        
    printf("pair    dist   path");
    for(i=0;i<g.vertices;i++)
        for(j=0;j<g.vertices;j++){
            if(i!=j){
                printf("\n%d -> %d %3d %5d",i+1,j+1,processWeights[i][j],i+1);
                k = i+1;
                do{
                    k = processedVertices[k-1][j];
                    printf("->%d",k);
                }while(k!=j+1);
            }
        }
}

int main(int argC,char* argV[]){
    if(argC!=2)
        printf("Usage : %s <file containing graph data>");
    else
        floydWarshall(loadGraph(argV[1]));
    return 0;
}

Input file, first row specifies number of vertices and edges.

4 5
1 3 -2
3 4 2
4 2 -1
2 1 4
2 3 3

Invocation and output:

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

Library: Gadget

VERSION 2. Using Gadget, an a "C" library.

#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;
}
Output:

Archivo fuente: floyd_data.txt

1 3 -2
3 4 2
4 2 -1
2 1 4
2 3 3

Salida:

$ ./floydWarshall floyd_data.txt
Vertices=4, edges=5
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

C#

Translation of: Java
using System;

namespace FloydWarshallAlgorithm {
    class Program {
        static void FloydWarshall(int[,] weights, int numVerticies) {
            double[,] dist = new double[numVerticies, numVerticies];
            for (int i = 0; i < numVerticies; i++) {
                for (int j = 0; j < numVerticies; j++) {
                    dist[i, j] = double.PositiveInfinity;
                }
            }

            for (int i = 0; i < weights.GetLength(0); i++) {
                dist[weights[i, 0] - 1, weights[i, 1] - 1] = weights[i, 2];
            }

            int[,] next = new int[numVerticies, numVerticies];
            for (int i = 0; i < numVerticies; i++) {
                for (int j = 0; j < numVerticies; j++) {
                    if (i != j) {
                        next[i, j] = j + 1;
                    }
                }
            }

            for (int k = 0; k < numVerticies; k++) {
                for (int i = 0; i < numVerticies; i++) {
                    for (int j = 0; j < numVerticies; j++) {
                        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);
        }

        static void PrintResult(double[,] dist, int[,] next) {
            Console.WriteLine("pair     dist    path");
            for (int i = 0; i < next.GetLength(0); i++) {
                for (int j = 0; j < next.GetLength(1); j++) {
                    if (i != j) {
                        int u = i + 1;
                        int v = j + 1;
                        string path = string.Format("{0} -> {1}    {2,2:G}     {3}", u, v, dist[i, j], u);
                        do {
                            u = next[u - 1, v - 1];
                            path += " -> " + u;
                        } while (u != v);
                        Console.WriteLine(path);
                    }
                }
            }
        }

        static void Main(string[] args) {
            int[,] weights = { { 1, 3, -2 }, { 2, 1, 4 }, { 2, 3, 3 }, { 3, 4, 2 }, { 4, 2, -1 } };
            int numVerticies = 4;

            FloydWarshall(weights, numVerticies);
        }
    }
}

C++

#include <iostream>
#include <vector>
#include <sstream>

void print(std::vector<std::vector<double>> dist, std::vector<std::vector<int>> next) {
  std::cout << "(pair, dist, path)" << std::endl;
  const auto size = std::size(next);
  for (auto i = 0; i < size; ++i) {
    for (auto j = 0; j < size; ++j) {
      if (i != j) {
        auto u = i + 1;
        auto v = j + 1;
        std::cout << "(" << u << " -> " << v << ", " << dist[i][j]
          << ", ";
        std::stringstream path;
        path << u;
        do {
          u = next[u - 1][v - 1];
          path << " -> " << u;
        } while (u != v);
        std::cout << path.str() << ")" << std::endl;
      }
    }
  }
}

void solve(std::vector<std::vector<int>> w_s, const int num_vertices) {
  std::vector<std::vector<double>> dist(num_vertices);
  for (auto& dim : dist) {
    for (auto i = 0; i < num_vertices; ++i) {
      dim.push_back(INT_MAX);
    }
  }
  for (auto& w : w_s) {
    dist[w[0] - 1][w[1] - 1] = w[2];
  }
  std::vector<std::vector<int>> next(num_vertices);
  for (auto i = 0; i < num_vertices; ++i) {
    for (auto j = 0; j < num_vertices; ++j) {
      next[i].push_back(0);
    }
    for (auto j = 0; j < num_vertices; ++j) {
      if (i != j) {
        next[i][j] = j + 1;
      }
    }
  }
  for (auto k = 0; k < num_vertices; ++k) {
    for (auto i = 0; i < num_vertices; ++i) {
      for (auto j = 0; j < num_vertices; ++j) {
        if (dist[i][j] > dist[i][k] + dist[k][j]) {
          dist[i][j] = dist[i][k] + dist[k][j];
          next[i][j] = next[i][k];
        }
      }
    }
  }
  print(dist, next);
}

int main() {
  std::vector<std::vector<int>> w = {
    { 1, 3, -2 },
    { 2, 1, 4 },
    { 2, 3, 3 },
    { 3, 4, 2 },
    { 4, 2, -1 },
  };
  int num_vertices = 4;
  solve(w, num_vertices);
  std::cin.ignore();
  std::cin.get();
  return 0;
}
Output:
(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)

Common Lisp

Translation of: Scheme


I have wrapped the Common Lisp program in a 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.


#!/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:
Output:
$ ./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

D

Translation of: Java
import std.stdio;

void main() {
    int[][] weights = [
        [1, 3, -2],
        [2, 1, 4],
        [2, 3, 3],
        [3, 4, 2],
        [4, 2, -1]
    ];
    int numVertices = 4;

    floydWarshall(weights, numVertices);
}

void floydWarshall(int[][] weights, int numVertices) {
    import std.array;

    real[][] dist = uninitializedArray!(real[][])(numVertices, numVertices);
    foreach(dim; dist) {
        dim[] = real.infinity;
    }

    foreach (w; weights) {
        dist[w[0]-1][w[1]-1] = w[2];
    }

    int[][] next = uninitializedArray!(int[][])(numVertices, numVertices);
    for (int i=0; i<next.length; i++) {
        for (int j=0; j<next.length; j++) {
            if (i != j) {
                next[i][j] = j+1;
            }
        }
    }

    for (int k=0; k<numVertices; k++) {
        for (int i=0; i<numVertices; i++) {
            for (int j=0; j<numVertices; j++) {
                if (dist[i][j] > dist[i][k] + dist[k][j]) {
                    dist[i][j] = dist[i][k] + dist[k][j];
                    next[i][j] = next[i][k];
                }
            }
        }
    }

    printResult(dist, next);
}

void printResult(real[][] dist, int[][] next) {
    import std.conv;
    import std.format;

    writeln("pair     dist    path");
    for (int i=0; i<next.length; i++) {
        for (int j=0; j<next.length; j++) {
            if (i!=j) {
                int u = i+1;
                int v = j+1;
                string path = format("%d -> %d    %2d     %s", u, v, cast(int) dist[i][j], u);
                do {
                    u = next[u-1][v-1];
                    path ~= text(" -> ", u);
                } while (u != v);
                writeln(path);
            }
        }
    }
}
Output:
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

EchoLisp

Transcription of the Floyd-Warshall algorithm, with best path computation.

(lib 'matrix)

;; in : initialized dist and next matrices
;; out : dist and next matrices
;; O(n^3)

(define (floyd-with-path n dist next (d 0))
    (for* ((k n) (i n) (j n))
     #:break (< (array-ref dist j j) 0) => 'negative-cycle
    (set! d (+ (array-ref dist i k) (array-ref dist k j)))
     (when (< d (array-ref dist i j))
         (array-set! dist i j d)
         (array-set! next i j (array-ref next i k)))))

;; utilities

;; init random edges costs, matrix 66% filled
(define (init-edges n dist next)
   (for* ((i n) (j n))
    (array-set! dist i i 0)
    (array-set! next i j null)
    #:continue (= j i)
    (array-set! dist i j Infinity)
     #:continue (< (random) 0.3)
     (array-set! dist i j (1+ (random 100)))
    (array-set! next i j j)))

;; show path from u to v
(define (path u v)
    (cond 
     ((= u v) (list u))
     ((null? (array-ref next u v)) null)        
     (else (cons u (path (array-ref next u v) v)))))

(define( mdist u v) ;; show computed distance
      (array-ref dist u v))
    
(define (task)
     (init-edges n dist next)
     (array-print dist) ;; show init distances
     (floyd-with-path n dist next))
Output:
(define n 8)
(define next (make-array n n))
(define dist (make-array n n))
(task)

  0    Infinity   Infinity   13         98         Infinity   35         47       
  8    0          Infinity   Infinity   83         77         16         3        
  73   3          0          3          76         84         91         Infinity 
  30   49         Infinity   0          41         Infinity   4          4        
  22   83         92         Infinity   0          30         27         98       
  6    Infinity   Infinity   24         59         0          Infinity   Infinity 
  60   Infinity   45         Infinity   67         100        0          Infinity 
  72   15         95         21         Infinity   Infinity   27         0        


(array-print dist) ;; computed distances

  0    32   62   13   54   84   17   17 
  8    0    61   21   62   77   16   3  
  11   3    0    3    44   74   7    6  
  27   19   49   0    41   71   4    4  
  22   54   72   35   0    30   27   39 
  6    38   68   19   59   0    23   23 
  56   48   45   48   67   97   0    51 
  23   15   70   21   62   92   25   0  

(path 1 3)  → (1 0 3)
(mdist 1 0) → 8
(mdist 0 3) → 13
(mdist 1 3) → 21 ;; = 8 + 13
(path 7 6) → (7 3 6)
(path 6 7) → (6 2 1 7)

Elixir

defmodule Floyd_Warshall do
  def main(n, edge) do
    {dist, next} = setup(n, edge)
    {dist, next} = shortest_path(n, dist, next)
    print(n, dist, next)
  end
  
  defp setup(n, edge) do
    big = 1.0e300
    dist = for i <- 1..n, j <- 1..n, into: %{}, do: {{i,j},(if i==j, do: 0, else: big)}
    next = for i <- 1..n, j <- 1..n, into: %{}, do: {{i,j}, nil}
    Enum.reduce(edge, {dist,next}, fn {u,v,w},{dst,nxt} ->
      { Map.put(dst, {u,v}, w), Map.put(nxt, {u,v}, v) }
    end)
  end
  
  defp shortest_path(n, dist, next) do
    (for k <- 1..n, i <- 1..n, j <- 1..n, do: {k,i,j})
    |> Enum.reduce({dist,next}, fn {k,i,j},{dst,nxt} ->
         if dst[{i,j}] > dst[{i,k}] + dst[{k,j}] do
           {Map.put(dst, {i,j}, dst[{i,k}] + dst[{k,j}]), Map.put(nxt, {i,j}, nxt[{i,k}])}
         else
           {dst, nxt}
         end
       end)
  end
  
  defp print(n, dist, next) do
    IO.puts "pair     dist    path"
    for i <- 1..n, j <- 1..n, i != j,
        do: :io.format "~w -> ~w  ~4w     ~s~n", [i, j, dist[{i,j}], path(next, i, j)]
  end
  
  defp path(next, i, j), do: path(next, i, j, [i]) |> Enum.join(" -> ")
  
  defp path(_next, i, i, list), do: Enum.reverse(list)
  defp path(next, i, j, list) do
    u = next[{i,j}]
    path(next, u, j, [u | list])
  end
end

edge = [{1, 3, -2}, {2, 1, 4}, {2, 3, 3}, {3, 4, 2}, {4, 2, -1}]
Floyd_Warshall.main(4, edge)
Output:
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

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)
  let ix n g=Seq.init (pown g n) (fun x->List.unfold(fun (a,b)->if a=0 then None else Some(b%g,(a-1,b/g)))(n,x))
  let fN w (i,j,k)=match Map.tryFind(i,j) w,Map.tryFind(i,k) w,Map.tryFind(k,j) w with
                        |(None  ,Some j,Some k)->Some(j+k)
                        |(Some i,Some j,Some k)->if (j+k) < i then Some(j+k) else None
                        |_                     ->None
  let n,z=ix 3 (Array.length n)|>Seq.choose(fun (i::j::k::_)->if i<>j&&i<>k&&j<>k then Some(n.[i],n.[j],n.[k]) else None)
       |>Seq.fold(fun (n,n') ((i,j,k) as g)->match fN n g with |Some g->(Map.add (i,j) g n,Map.add (i,j) k n')|_->(n,n')) (g,Map.empty)
  (n,(fun x y->seq{
               let rec fN n g=seq{
                 match Map.tryFind (n,g) z with
                 |Some r->yield! fN n r; yield Some r;yield! fN r g
                 |_->yield None}
               yield! fN x y |> Seq.choose id; yield y}))

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))))
Output:
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]

Fortran

Translation of: Ada
Works with: gfortran version 11.3.0


module floyd_warshall_algorithm

  use, intrinsic :: ieee_arithmetic

  implicit none

  integer, parameter :: floating_point_kind = &
       & ieee_selected_real_kind (6, 37)
  integer, parameter :: fpk = floating_point_kind

  integer, parameter :: nil_vertex = 0

  type :: edge
     integer :: u
     real(kind = fpk) :: weight
     integer :: v
  end type edge

  type :: edge_list
     type(edge), allocatable :: element(:)
  end type edge_list

contains

  subroutine make_example_graph (edges)
    type(edge_list), intent(out) :: edges

    allocate (edges%element(1:5))
    edges%element(1) = edge (1, -2.0, 3)
    edges%element(2) = edge (3, +2.0, 4)
    edges%element(3) = edge (4, -1.0, 2)
    edges%element(4) = edge (2, +4.0, 1)
    edges%element(5) = edge (2, +3.0, 3)
  end subroutine make_example_graph

  function find_max_vertex (edges) result (n)
    type(edge_list), intent(in) :: edges
    integer n

    integer i

    n = 1
    do i = lbound (edges%element, 1), ubound (edges%element, 1)
       n = max (n, edges%element(i)%u)
       n = max (n, edges%element(i)%v)
    end do
  end function find_max_vertex

  subroutine floyd_warshall (edges, max_vertex, distance, next_vertex)

    type(edge_list), intent(in) :: edges
    integer, intent(out) :: max_vertex
    real(kind = fpk), allocatable, intent(out) :: distance(:,:)
    integer, allocatable, intent(out) :: next_vertex(:,:)

    integer :: n
    integer :: i, j, k
    integer :: u, v
    real(kind = fpk) :: dist_ikj
    real(kind = fpk) :: infinity

    n = find_max_vertex (edges)
    max_vertex = n

    allocate (distance(1:n, 1:n))
    allocate (next_vertex(1:n, 1:n))

    infinity = ieee_value (1.0_fpk,  ieee_positive_inf)

    ! Initialize.

    do i = 1, n
       do j = 1, n
          distance(i, j) = infinity
          next_vertex (i, j) = nil_vertex
       end do
    end do
    do i = lbound (edges%element, 1), ubound (edges%element, 1)
       u = edges%element(i)%u
       v = edges%element(i)%v
       distance(u, v) = edges%element(i)%weight
       next_vertex(u, v) = v
    end do
    do i = 1, n
       distance(i, i) = 0.0_fpk ! Distance from a vertex to itself.
       next_vertex(i, i) = i
    end do

    ! Perform the algorithm.

    do k = 1, n
       do i = 1, n
          do j = 1, n
             dist_ikj = distance(i, k) + distance(k, j)
             if (dist_ikj < distance(i, j)) then
                distance(i, j) = dist_ikj
                next_vertex(i, j) = next_vertex(i, k)
             end if
          end do
       end do
    end do

  end subroutine floyd_warshall

  subroutine print_path (next_vertex, u, v)
    integer, intent(in) :: next_vertex(:,:)
    integer, intent(in) :: u, v

    integer i

    if (next_vertex(u, v) /= nil_vertex) then
       i = u
       write (*, '(I0)', advance = 'no') i
       do while (i /= v)
          i = next_vertex(i, v)
          write (*, '('' -> '', I0)', advance = 'no') i
       end do
    end if
  end subroutine print_path

end module floyd_warshall_algorithm

program floyd_warshall_task

  use, non_intrinsic :: floyd_warshall_algorithm

  implicit none

  type(edge_list) :: example_graph
  integer :: max_vertex
  real(kind = fpk), allocatable :: distance(:,:)
  integer, allocatable :: next_vertex(:,:)
  integer :: u, v

  call make_example_graph (example_graph)
  call floyd_warshall (example_graph, max_vertex, distance, &
       &               next_vertex)

1000 format (1X, I0, ' -> ', I0, 5X, F4.1, 6X)

  write (*, '(''  pair     distance    path'')')
  write (*, '(''---------------------------------------'')')
  do u = 1, max_vertex
     do v = 1, max_vertex
        if (u /= v) then
           write (*, 1000, advance = 'no') u, v, distance(u, v)
           call print_path (next_vertex, u, v)
           write (*, '()', advance = 'yes')
        end if
     end do
  end do

end program floyd_warshall_task
Output:
$ gfortran -g -std=f2018 -fcheck=all -fno-unsafe-math-optimizations -frounding-math -fsignaling-nans floyd_warshall_task.f90 && ./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

FreeBASIC

Translation of: Java
' FB 1.05.0 Win64

Const POSITIVE_INFINITY As Double = 1.0/0.0

Sub printResult(dist(any, any) As Double, nxt(any, any) As Integer)
  Dim As Integer u, v
  Print("pair     dist    path")
  For i As Integer = 0 To UBound(nxt, 1)
    For j As Integer = 0 To UBound(nxt, 1)
      If i <> j Then
        u = i + 1
        v = j + 1
        Print Str(u); " -> "; Str(v); "    "; dist(i, j); "     "; Str(u);
        Do
          u = nxt(u - 1, v - 1)
          Print " -> "; Str(u);
        Loop While u <> v
        Print
      End If
    Next j
  Next i
End Sub

Sub floydWarshall(weights(Any, Any) As Integer, numVertices As Integer)
  Dim dist(0 To numVertices - 1, 0 To numVertices - 1) As Double
  For i As Integer = 0 To numVertices - 1
    For j As Integer = 0 To numVertices - 1
      dist(i, j) = POSITIVE_INFINITY
    Next j
  Next i

  For x As Integer = 0 To UBound(weights, 1)
    dist(weights(x, 0) - 1, weights(x, 1) - 1) = weights(x, 2)
  Next x

  Dim nxt(0 To numVertices - 1, 0 To numVertices - 1) As Integer
  For i As Integer = 0 To numVertices - 1
    For j As Integer = 0 To numVertices - 1
      If i <> j Then nxt(i, j) = j + 1
    Next j
  Next i 

  For k As Integer = 0 To numVertices - 1
    For i As Integer = 0 To numVertices - 1
      For j As Integer = 0 To numVertices - 1
        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)
        End If
      Next j
    Next i
  Next k

  printResult(dist(), nxt())
End Sub

Dim weights(4, 2) As Integer = {{1, 3, -2}, {2, 1, 4}, {2, 3, 3}, {3, 4, 2}, {4, 2, -1}}
Dim numVertices As Integer = 4
floydWarshall(weights(), numVertices)
Print
Print "Press any key to quit"
Sleep
Output:
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

Go

package main
 
import (
  "fmt"
  "strconv"
)
 
// A Graph is the interface implemented by graphs that
// this algorithm can run on.
type Graph interface {
  Vertices() []Vertex
  Neighbors(v Vertex) []Vertex
  Weight(u, v Vertex) int
}
 
// Nonnegative integer ID of vertex
type Vertex int
 
// ig is a graph of integers that satisfies the Graph interface.
type ig struct {
  vert  []Vertex
  edges map[Vertex]map[Vertex]int
}
 
func (g ig) edge(u, v Vertex, w int) {
  if _, ok := g.edges[u]; !ok {
    g.edges[u] = make(map[Vertex]int)
  }
  g.edges[u][v] = w
}
func (g ig) Vertices() []Vertex { return g.vert }
func (g ig) Neighbors(v Vertex) (vs []Vertex) {
  for k := range g.edges[v] {
    vs = append(vs, k)
  }
  return vs
}
func (g ig) Weight(u, v Vertex) int { return g.edges[u][v] }
func (g ig) path(vv []Vertex) (s string) {
  if len(vv) == 0 {
    return ""
  }
  s = strconv.Itoa(int(vv[0]))
  for _, v := range vv[1:] {
    s += " -> " + strconv.Itoa(int(v))
  }
  return s
}
 
const Infinity = int(^uint(0) >> 1)
 
func FloydWarshall(g Graph) (dist map[Vertex]map[Vertex]int, next map[Vertex]map[Vertex]*Vertex) {
  vert := g.Vertices()
  dist = make(map[Vertex]map[Vertex]int)
  next = make(map[Vertex]map[Vertex]*Vertex)
  for _, u := range vert {
    dist[u] = make(map[Vertex]int)
    next[u] = make(map[Vertex]*Vertex)
    for _, v := range vert {
      dist[u][v] = Infinity
    }
    dist[u][u] = 0
    for _, v := range g.Neighbors(u) {
      v := v
      dist[u][v] = g.Weight(u, v)
      next[u][v] = &v
    }
  }
  for _, k := range vert {
    for _, i := range vert {
      for _, j := range vert {
        if dist[i][k] < Infinity && dist[k][j] < Infinity {
          if dist[i][j] > dist[i][k]+dist[k][j] {
            dist[i][j] = dist[i][k] + dist[k][j]
            next[i][j] = next[i][k]
          }
        }
      }
    }
  }
  return dist, next
}
 
func Path(u, v Vertex, next map[Vertex]map[Vertex]*Vertex) (path []Vertex) {
  if next[u][v] == nil {
    return
  }
  path = []Vertex{u}
  for u != v {
    u = *next[u][v]
    path = append(path, u)
  }
  return path
}
 
func main() {
  g := ig{[]Vertex{1, 2, 3, 4}, make(map[Vertex]map[Vertex]int)}
  g.edge(1, 3, -2)
  g.edge(3, 4, 2)
  g.edge(4, 2, -1)
  g.edge(2, 1, 4)
  g.edge(2, 3, 3)
 
  dist, next := FloydWarshall(g)
  fmt.Println("pair\tdist\tpath")
  for u, m := range dist {
    for v, d := range m {
      if u != v {
        fmt.Printf("%d -> %d\t%3d\t%s\n", u, v, d, g.path(Path(u, v, next)))
      }
    }
  }
}
Output:
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

Groovy

Translation of: Java
class FloydWarshall {
    static void main(String[] args) {
        int[][] weights = [[1, 3, -2], [2, 1, 4], [2, 3, 3], [3, 4, 2], [4, 2, -1]]
        int numVertices = 4

        floydWarshall(weights, numVertices)
    }

    static void floydWarshall(int[][] weights, int numVertices) {
        double[][] dist = new double[numVertices][numVertices]
        for (double[] row : dist) {
            Arrays.fill(row, Double.POSITIVE_INFINITY)
        }

        for (int[] w : weights) {
            dist[w[0] - 1][w[1] - 1] = w[2]
        }

        int[][] next = new int[numVertices][numVertices]
        for (int i = 0; i < next.length; i++) {
            for (int j = 0; j < next.length; j++) {
                if (i != j) {
                    next[i][j] = j + 1
                }
            }
        }

        for (int k = 0; k < numVertices; k++) {
            for (int i = 0; i < numVertices; i++) {
                for (int j = 0; j < numVertices; j++) {
                    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)
    }

    static void printResult(double[][] dist, int[][] next) {
        println("pair     dist    path")
        for (int i = 0; i < next.length; i++) {
            for (int j = 0; j < next.length; j++) {
                if (i != j) {
                    int u = i + 1
                    int v = j + 1
                    String path = String.format("%d -> %d    %2d     %s", u, v, (int) dist[i][j], u)
                    boolean loop = true
                    while (loop) {
                        u = next[u - 1][v - 1]
                        path += " -> " + u
                        loop = u != v
                    }
                    println(path)
                }
            }
        }
    }
}
Output:
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

Haskell

Necessary imports

import Control.Monad (join)
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 a represents a distance. It could be a number, in case of weighted graph or boolean value for just a directed graph. Type b goes for vertice labels (integers, chars, strings...)

data Shortest b a = Shortest { distance :: a, path :: [b] }
                  deriving Show

Next we note that shortest paths form a semigroup with following "addition" rule:

instance (Ord a, Eq b) => Semigroup (Shortest b a) where
  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 distance, and in case of equal distances joins both paths. We will lift this semigroup to monoid using Maybe wrapper.

Graph is represented as a Map, containing pairs of vertices and corresponding weigts. The distance table is a Map, containing pairs of joint vertices and corresponding shortest paths.

Now we are ready to define the main part of the Floyd-Warshall algorithm, which processes properly prepared distance table dist for given list of vertices v:

floydWarshall v dist = foldr innerCycle (Just <$> dist) v
  where
    innerCycle k dist = (newDist <$> v <*> v) `setTo` dist
      where
        newDist i j =
          ((i,j), do a <- join $ lookup (i, k) dist
                     b <- join $ lookup (k, j) dist
                     return $ Shortest (distance a <> distance b) (path a))

        setTo = unionWith (<>) . fromList

The floydWarshall produces only first steps of shortest paths. Whole paths are build by following function:

buildPaths d = mapWithKey (\pair s -> s { path = buildPath pair}) d
  where
    buildPath (i,j)
      | i == j    = [[j]]
      | 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 findMinDistances:

findMinDistances v g =
  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:

g = fromList [((2,1), 4)
             ,((2,3), 3)
             ,((1,3), -2)
             ,((3,4), 2)
             ,((4,2), -1)]

the helper function

showShortestPaths v g = mapM_ print $ toList $ findMinDistances v g
Output:

Weights as distances:

λ> showShortestPaths [1..4] (Sum <$> g)
((1,2),Shortest {distance = Sum {getSum = -1}, path = [[1,3,4,2]]})
((1,3),Shortest {distance = Sum {getSum = -2}, path = [[1,3]]})
((1,4),Shortest {distance = Sum {getSum = 0}, path = [[1,3,4]]})
((2,1),Shortest {distance = Sum {getSum = 4}, path = [[2,1]]})
((2,3),Shortest {distance = Sum {getSum = 2}, path = [[2,1,3]]})
((2,4),Shortest {distance = Sum {getSum = 4}, path = [[2,1,3,4]]})
((3,1),Shortest {distance = Sum {getSum = 5}, path = [[3,4,2,1]]})
((3,2),Shortest {distance = Sum {getSum = 1}, path = [[3,4,2]]})
((3,4),Shortest {distance = Sum {getSum = 2}, path = [[3,4]]})
((4,1),Shortest {distance = Sum {getSum = 3}, path = [[4,2,1]]})
((4,2),Shortest {distance = Sum {getSum = -1}, path = [[4,2]]})
((4,3),Shortest {distance = Sum {getSum = 1}, path = [[4,2,1,3]]})

Unweighted directed graph

λ> showShortestPaths [1..4] (Any . (/= 0) <$> g)
((1,2),Shortest {distance = Any {getAny = True}, path = [[1,3,4,2]]})
((1,3),Shortest {distance = Any {getAny = True}, path = [[1,3]]})
((1,4),Shortest {distance = Any {getAny = True}, path = [[1,3,4]]})
((2,1),Shortest {distance = Any {getAny = True}, path = [[2,1]]})
((2,3),Shortest {distance = Any {getAny = True}, path = [[2,1,3],[2,3]]})
((2,4),Shortest {distance = Any {getAny = True}, path = [[2,1,3,4],[2,3,4]]})
((3,1),Shortest {distance = Any {getAny = True}, path = [[3,4,2,1]]})
((3,2),Shortest {distance = Any {getAny = True}, path = [[3,4,2]]})
((3,4),Shortest {distance = Any {getAny = True}, path = [[3,4]]})
((4,1),Shortest {distance = Any {getAny = True}, path = [[4,2,1]]})
((4,2),Shortest {distance = Any {getAny = True}, path = [[4,2]]})
((4,3),Shortest {distance = Any {getAny = True}, path = [[4,2,1,3],[4,2,3]]})

For some pairs several possible paths are found.

Uniformly weighted graph:

λ> showShortestPaths [1..4] (const (Sum 1) <$> g)
((1,2),Shortest {distance = Sum {getSum = 3}, path = [[1,3,4,2]]})
((1,3),Shortest {distance = Sum {getSum = 1}, path = [[1,3]]})
((1,4),Shortest {distance = Sum {getSum = 2}, path = [[1,3,4]]})
((2,1),Shortest {distance = Sum {getSum = 1}, path = [[2,1]]})
((2,3),Shortest {distance = Sum {getSum = 1}, path = [[2,3]]})
((2,4),Shortest {distance = Sum {getSum = 2}, path = [[2,3,4]]})
((3,1),Shortest {distance = Sum {getSum = 3}, path = [[3,4,2,1]]})
((3,2),Shortest {distance = Sum {getSum = 2}, path = [[3,4,2]]})
((3,4),Shortest {distance = Sum {getSum = 1}, path = [[3,4]]})
((4,1),Shortest {distance = Sum {getSum = 2}, path = [[4,2,1]]})
((4,2),Shortest {distance = Sum {getSum = 1}, path = [[4,2]]})
((4,3),Shortest {distance = Sum {getSum = 2}, path = [[4,2,3]]})

Graph labeled by chars:

g2 = fromList [(('A','S'), 1)
             ,(('A','D'), -1)
             ,(('S','E'), 2)
             ,(('D','E'), 4)]
λ> showShortestPaths "ASDE" (Sum <$> g2)
(('A','D'),Shortest {distance = Sum {getSum = -1}, path = ["AD"]})
(('A','E'),Shortest {distance = Sum {getSum = 3}, path = ["ASE","ADE"]})
(('A','S'),Shortest {distance = Sum {getSum = 1}, path = ["AS"]})
(('D','E'),Shortest {distance = Sum {getSum = 4}, path = ["DE"]})
(('S','E'),Shortest {distance = Sum {getSum = 2}, path = ["SE"]})

Icon

Translation of: Scheme
Works with: Icon version 9.5.20i


#
# Floyd-Warshall algorithm.
#
# See https://en.wikipedia.org/w/index.php?title=Floyd%E2%80%93Warshall_algorithm&oldid=1082310013
#

record fw_results (n, distance, next_vertex)

link array
link numbers
link printf

procedure main ()
  local example_graph
  local fw
  local u, v

  example_graph := [[1, -2.0, 3],
                    [3, +2.0, 4],
                    [4, -1.0, 2],
                    [2, +4.0, 1],
                    [2, +3.0, 3]]

  fw := floyd_warshall (example_graph)

  printf ("  pair    distance   path\n")
  printf ("-------------------------------------\n")
  every u := 1 to fw.n do {
    every v := 1 to fw.n do {
      if u ~= v then {
        printf (" %d -> %d    %4s     %s\n", u, v,
                string (ref_array (fw.distance, u, v)),
                path_to_string (find_path (fw.next_vertex, u, v)))
      }
    }
  }
end

procedure floyd_warshall (edges)
  local n, distance, next_vertex
  local e
  local i, j, k
  local dist_ij, dist_ik, dist_kj, dist_ikj

  n := max_vertex (edges)
  distance := create_array ([1, 1], [n, n], &null)
  next_vertex := create_array ([1, 1], [n, n], &null)

  # Initialization.
  every e := !edges do {
    ref_array (distance, e[1], e[3]) := e[2]
    ref_array (next_vertex, e[1], e[3]) := e[3]
  }
  every i := 1 to n do {
    ref_array (distance, i, i) := 0.0 # Distance to self = 0.
    ref_array (next_vertex, i, i) := i
  }

  # Perform the algorithm. Here &null will play the role of
  # "infinity": "\" means a value is finite, "/" that it is infinite.
  every k := 1 to n do {
    every i := 1 to n do {
      every j := 1 to n do {
        dist_ij := ref_array (distance, i, j)
        dist_ik := ref_array (distance, i, k)
        dist_kj := ref_array (distance, k, j)
        if \dist_ik & \dist_kj then {
          dist_ikj := dist_ik + dist_kj
          if /dist_ij | dist_ikj < dist_ij then {
            ref_array (distance, i, j) := dist_ikj
            ref_array (next_vertex, i, j) :=
                ref_array (next_vertex, i, k)
          }
        }
      }
    }
  }

  return fw_results (n, distance, next_vertex)
end

procedure find_path (next_vertex, u, v)
  local path

  if / (ref_array (next_vertex, u, v)) then {
    path := []
  } else {
    path := [u]
    while u ~= v do {
      u := ref_array (next_vertex, u, v)
      put (path, u)
    }
  }
  return path
end

procedure path_to_string (path)
  local s

  if *path = 0 then {
    s := ""
  } else {
    s := string (path[1])
    every s ||:= (" -> " || !path[2 : 0])
  }
  return s
end

procedure max_vertex (edges)
  local e
  local m

  *edges = 0 & stop ("no edges")
  m := 1
  every e := !edges do m := max (m, e[1], e[3])
  return m
end
Output:
$ icon floyd-warshall-in-Icon.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

J

floyd=: verb define
  for_j. i.#y do.
    y=. y <. j ({"1 +/ {) y
  end.
)

Alternate implementation (same behavior):

floyd=: ]F..(]<.{"1+/{) i.@#

Example use:

graph=: ".;._2]0 :0
  0  _ _2 _  NB. 1->3 costs _2
  4  0  3 _  NB. 2->1 costs 4; 2->3 costs 3
  _  _  0 2  NB. 3->4 costs 2
  _ _1  _ 0  NB. 4->2 costs _1
)

   floyd graph
0 _1 _2 0
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.

This approach turns out to be faster than the more concise <./ .+~^:_ for many relatively small graphs (though floyd happens to be slightly slower for the task example).

Path Reconstruction

This draft task currently asks for path reconstruction, which is a different (related) algorithm:

floydrecon=: verb define
  n=. ($y)$_(I._=,y)},($$i.@#)y
  for_j. i.#y do.
    d=. y <. j ({"1 +/ {) y
    b=. y~:d
    y=. d
    n=. (n*-.b)+b * j{"1 n
  end.
)

task=: verb define
  dist=. floyd y
  next=. floydrecon y
  echo 'pair  dist   path'
  for_i. i.#y do.
    for_k. i.#y do.
      ndx=. <i,k
      if. (i~:k)*_>ndx{next do.
        txt=. (":1+i),'->',(":1+k)
        txt=. txt,_5{.":ndx{dist
        txt=. txt,'    ',":1+i
        j=. i
        while. j~:k do.
          assert. j~:(<j,k){next
          j=. (<j,k){next
          txt=. txt,'->',":1+j
        end.
        echo txt
      end.
    end.
  end.
  i.0 0
)

Draft output:

   task graph
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

Java

import static java.lang.String.format;
import java.util.Arrays;

public class FloydWarshall {

    public static void main(String[] args) {
        int[][] weights = {{1, 3, -2}, {2, 1, 4}, {2, 3, 3}, {3, 4, 2}, {4, 2, -1}};
        int numVertices = 4;

        floydWarshall(weights, numVertices);
    }

    static void floydWarshall(int[][] weights, int numVertices) {

        double[][] dist = new double[numVertices][numVertices];
        for (double[] row : dist)
            Arrays.fill(row, Double.POSITIVE_INFINITY);

        for (int[] w : weights)
            dist[w[0] - 1][w[1] - 1] = w[2];

        int[][] next = new int[numVertices][numVertices];
        for (int i = 0; i < next.length; i++) {
            for (int j = 0; j < next.length; j++)
                if (i != j)
                    next[i][j] = j + 1;
        }

        for (int k = 0; k < numVertices; k++)
            for (int i = 0; i < numVertices; i++)
                for (int j = 0; j < numVertices; j++)
                    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);
    }

    static void printResult(double[][] dist, int[][] next) {
        System.out.println("pair     dist    path");
        for (int i = 0; i < next.length; i++) {
            for (int j = 0; j < next.length; j++) {
                if (i != j) {
                    int u = i + 1;
                    int v = j + 1;
                    String path = format("%d -> %d    %2d     %s", u, v,
                            (int) dist[i][j], u);
                    do {
                        u = next[u - 1][v - 1];
                        path += " -> " + u;
                    } while (u != v);
                    System.out.println(path);
                }
            }
        }
    }
}
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

JavaScript

Using output code translated from the Lua sample.

'use strict'
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 < numVertices; ++j)
    graph[i].push(i == j ? 0 : 9999999);
}

for (let i = 0; i < weights.length; ++i) {
  let w = weights[i];
  graph[w[0] - 1][w[1] - 1] = w[2];
}

let nxt = [];
for (let i = 0; i < numVertices; ++i) {
  nxt.push([]);
  for (let j = 0; j < numVertices; ++j)
    nxt[i].push(i == j ? 0 : j + 1);
}

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("pair     dist    path");
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)
    }
  }
}
Output:
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

jq

Works with: jq version 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:

def weights: {
  "1": {"3": -2},
  "2": {"1" : 4, "3": 3},
  "3": {"4": 2},
  "4": {"2": -1}
};

The algorithm given here is a direct implementation of the definitional algorithm:

def fwi:
  . as $weights
  | keys_unsorted as $nodes
  # construct the dist matrix
  | reduce $nodes[] as $u ({};
      reduce $nodes[] as $v (.;
        .[$u][$v] = infinite))
  | reduce $nodes[] as $u (.; .[$u][$u] = 0 )
  | reduce $nodes[] as $u (.;
      reduce ($weights[$u]|keys_unsorted[]) as $v (.;
        .[$u][$v] = $weights[$u][$v] ))
  | reduce $nodes[] as $w (.;
      reduce $nodes[] as $u (.;
        reduce $nodes[] as $v (.;
      (.[$u][$w] + .[$w][$v]) as $x
      | if .[$u][$v] > $x then .[$u][$v] = $x
        else . end )))
;


weights | fwi
Output:
{
  "1": {
    "1": 0,
    "2": -1,
    "3": -2,
    "4": 0
  },
  "2": {
    "1": 4,
    "2": 0,
    "3": 2,
    "4": 4
  },
  "3": {
    "1": 5,
    "2": 1,
    "3": 0,
    "4": 2
  },
  "4": {
    "1": 3,
    "2": -1,
    "3": 1,
    "4": 0
  }
}

Julia

Translation of: Java
# Floyd-Warshall algorithm: https://rosettacode.org/wiki/Floyd-Warshall_algorithm
# v0.6

function floydwarshall(weights::Matrix, nvert::Int)
    dist = fill(Inf, nvert, nvert)
    for i in 1:size(weights, 1)
        dist[weights[i, 1], weights[i, 2]] = weights[i, 3]
    end
    # return dist
    next = collect(j != i ? j : 0 for i in 1:nvert, j in 1:nvert)

    for k in 1:nvert, i in 1:nvert, j in 1:nvert
        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]
        end
    end

    # return next
    function printresult(dist, next)
        println("pair     dist    path")
        for i in 1:size(next, 1), j in 1:size(next, 2)
            if i != j
                u = i
                path = @sprintf "%d -> %d    %2d     %s" i j dist[i, j] i
                while true
                    u = next[u, j]
                    path *= " -> $u"
                    if u == j break end
                end
                println(path)
            end
        end
    end
    printresult(dist, next)
end

floydwarshall([1 3 -2; 2 1 4; 2 3 3; 3 4 2; 4 2 -1], 4)

Kotlin

Translation of: Java
// version 1.1

object FloydWarshall {
    fun doCalcs(weights: Array<IntArray>, nVertices: Int) {
        val dist = Array(nVertices) { DoubleArray(nVertices) { Double.POSITIVE_INFINITY } }
        for (w in weights) dist[w[0] - 1][w[1] - 1] = w[2].toDouble()
        val next = Array(nVertices) { IntArray(nVertices) }
        for (i in 0 until next.size) {
            for (j in 0 until next.size) {
                if (i != j) next[i][j] = j + 1
            }
        }
        for (k in 0 until nVertices) {
            for (i in 0 until nVertices) {
                for (j in 0 until nVertices) {
                    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)
    }

    private fun printResult(dist: Array<DoubleArray>, next: Array<IntArray>) {
        var u: Int
        var v: Int
        var path: String
        println("pair     dist    path")
        for (i in 0 until next.size) {
            for (j in 0 until next.size) {
                if (i != j) {
                    u = i + 1
                    v = j + 1
                    path = ("%d -> %d    %2d     %s").format(u, v, dist[i][j].toInt(), u)
                    do {
                        u = next[u - 1][v - 1]
                        path += " -> " + u
                    } while (u != v)
                    println(path)
                }
            }
        }
    }
}

fun main(args: Array<String>) {
    val weights = arrayOf(
            intArrayOf(1, 3, -2),
            intArrayOf(2, 1, 4),
            intArrayOf(2, 3, 3),
            intArrayOf(3, 4, 2),
            intArrayOf(4, 2, -1)
    )
    val nVertices = 4
    FloydWarshall.doCalcs(weights, nVertices)
}
Output:
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

Lua

Translation of: D
function printResult(dist, nxt)
    print("pair     dist    path")
    for i=0, #nxt do
        for j=0, #nxt do
            if i ~= j then
                u = i + 1
                v = j + 1
                path = string.format("%d -> %d    %2d     %s", u, v, dist[i][j], u)
                repeat
                    u = nxt[u-1][v-1]
                    path = path .. " -> " .. u
                until (u == v)
                print(path)
            end
        end
    end
end

function floydWarshall(weights, numVertices)
    dist = {}
    for i=0, numVertices-1 do
        dist[i] = {}
        for j=0, numVertices-1 do
            dist[i][j] = math.huge
        end
    end

    for _,w in pairs(weights) do
        -- the weights array is one based
        dist[w[1]-1][w[2]-1] = w[3]
    end

    nxt = {}
    for i=0, numVertices-1 do
        nxt[i] = {}
        for j=0, numVertices-1 do
            if i ~= j then
                nxt[i][j] = j+1
            end
        end
    end

    for k=0, numVertices-1 do
        for i=0, numVertices-1 do
            for j=0, numVertices-1 do
                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]
                end
            end
        end
    end

    printResult(dist, nxt)
end

weights = {
    {1, 3, -2},
    {2, 1, 4},
    {2, 3, 3},
    {3, 4, 2},
    {4, 2, -1}
}
numVertices = 4
floydWarshall(weights, numVertices)
Output:
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


Mathematica / Wolfram Language

g = Graph[{1 \[DirectedEdge] 3, 3 \[DirectedEdge] 4, 
   4 \[DirectedEdge] 2, 2 \[DirectedEdge] 1, 2 \[DirectedEdge] 3}, 
  EdgeWeight -> {(1 \[DirectedEdge] 3) -> -2, (3 \[DirectedEdge] 4) ->
      2, (4 \[DirectedEdge] 2) -> -1, (2 \[DirectedEdge] 1) -> 
     4, (2 \[DirectedEdge] 3) -> 3}]
vl = VertexList[g];
dm = GraphDistanceMatrix[g];
Grid[LexicographicSort[
  DeleteCases[
   Catenate[
    Table[{vl[[i]], vl[[j]], dm[[i, j]]}, {i, Length[vl]}, {j, 
      Length[vl]}]], {x_, x_, _}]]]
Output:
1	2	-1.
1	3	-2.
1	4	0.
2	1	4.
2	3	2.
2	4	4.
3	1	5.
3	2	1.
3	4	2.
4	1	3.
4	2	-1.
4	3	1.


Mercury

Translation of: Scheme
Works with: Mercury version 20.06.1


:- 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:
Output:
$ 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

Modula-2

MODULE FloydWarshall;
FROM FormatString IMPORT FormatString;
FROM SpecialReals IMPORT Infinity;
FROM Terminal IMPORT ReadChar,WriteString,WriteLn;

CONST NUM_VERTICIES = 4;
TYPE
    IntArray = ARRAY[0..NUM_VERTICIES-1],[0..NUM_VERTICIES-1] OF INTEGER;
    RealArray = ARRAY[0..NUM_VERTICIES-1],[0..NUM_VERTICIES-1] OF REAL;

PROCEDURE FloydWarshall(weights : ARRAY OF ARRAY OF INTEGER);
VAR
    dist : RealArray;
    next : IntArray;
    i,j,k : INTEGER;
BEGIN
    FOR i:=0 TO NUM_VERTICIES-1 DO
        FOR j:=0 TO NUM_VERTICIES-1 DO
            dist[i,j] := Infinity;
        END
    END;
    k := HIGH(weights);
    FOR i:=0 TO k DO
        dist[weights[i,0]-1,weights[i,1]-1] := FLOAT(weights[i,2]);
    END;
    FOR i:=0 TO NUM_VERTICIES-1 DO
        FOR j:=0 TO NUM_VERTICIES-1 DO
            IF i#j THEN
                next[i,j] := j+1;
            END
        END
    END;
    FOR k:=0 TO NUM_VERTICIES-1 DO
        FOR i:=0 TO NUM_VERTICIES-1 DO
            FOR j:=0 TO NUM_VERTICIES-1 DO
                IF dist[i,j] > dist[i,k] + dist[k,j] THEN
                    dist[i,j] := dist[i,k] + dist[k,j];
                    next[i,j] := next[i,k];
                END
            END
        END
    END;
    PrintResult(dist, next);
END FloydWarshall;

PROCEDURE PrintResult(dist : RealArray; next : IntArray);
VAR
    i,j,u,v : INTEGER;
    buf : ARRAY[0..63] OF CHAR;
BEGIN
    WriteString("pair     dist    path");
    WriteLn;
    FOR i:=0 TO NUM_VERTICIES-1 DO
        FOR j:=0 TO NUM_VERTICIES-1 DO
            IF i#j THEN
                u := i + 1;
                v := j + 1;
                FormatString("%i -> %i    %2i     %i", buf, u, v, TRUNC(dist[i,j]), u);
                WriteString(buf);
                REPEAT
                    u := next[u-1,v-1];
                    FormatString(" -> %i", buf, u);
                    WriteString(buf);
                UNTIL u=v;
                WriteLn
            END
        END
    END
END PrintResult;

TYPE WeightArray = ARRAY[0..4],[0..2] OF INTEGER;
VAR weights : WeightArray;
BEGIN
    weights := WeightArray{
        {1,  3, -2},
        {2,  1,  4},
        {2,  3,  3},
        {3,  4,  2},
        {4,  2, -1}
    };

    FloydWarshall(weights);

    ReadChar
END FloydWarshall.

Nim

Translation of: D
import sequtils, strformat

type
  Weight = tuple[src, dest, value: int]
  Weights = seq[Weight]


#---------------------------------------------------------------------------------------------------

proc printResult(dist: seq[seq[float]]; next: seq[seq[int]]) =

  echo "pair     dist    path"
  for i in 0..next.high:
    for j in 0..next.high:
      if i != j:
        var u = i + 1
        let v = j + 1
        var path = fmt"{u} -> {v}    {dist[i][j].toInt:2d}     {u}"
        while true:
          u = next[u-1][v-1]
          path &= fmt" -> {u}"
          if u == v: break
        echo path


#---------------------------------------------------------------------------------------------------

proc floydWarshall(weights: Weights; numVertices: Positive) =

  var dist = repeat(repeat(Inf, numVertices), numVertices)
  for w in weights:
    dist[w.src - 1][w.dest - 1] = w.value.toFloat

  var next = repeat(newSeq[int](numVertices), numVertices)
  for i in 0..<numVertices:
    for j in 0..<numVertices:
      if i != j:
        next[i][j] = j + 1

  for k in 0..<numVertices:
    for i in 0..<numVertices:
      for j in 0..<numVertices:
        if dist[i][j] > dist[i][k] + dist[k][j]:
          dist[i][j] = dist[i][k] + dist[k][j]
          next[i][j] = next[i][k]

  printResult(dist, next)


#———————————————————————————————————————————————————————————————————————————————————————————————————

let weights: Weights = @[(1, 3, -2), (2, 1, 4), (2, 3, 3), (3, 4, 2), (4, 2, -1)]
let numVertices = 4

floydWarshall(weights, numVertices)
Output:
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

ObjectIcon

Translation of: Icon


The only changes needed from 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.
#
# See https://en.wikipedia.org/w/index.php?title=Floyd%E2%80%93Warshall_algorithm&oldid=1082310013
#

import io
import ipl.array
import ipl.printf

record fw_results (n, distance, next_vertex)

procedure main ()
  local example_graph
  local fw
  local u, v

  example_graph := [[1, -2.0, 3],
                    [3, +2.0, 4],
                    [4, -1.0, 2],
                    [2, +4.0, 1],
                    [2, +3.0, 3]]

  fw := floyd_warshall (example_graph)

  printf ("  pair    distance   path\n")
  printf ("-------------------------------------\n")
  every u := 1 to fw.n do {
    every v := 1 to fw.n do {
      if u ~= v then {
        printf (" %d -> %d    %4s     %s\n", u, v,
                string (ref_array (fw.distance, u, v)),
                path_to_string (find_path (fw.next_vertex, u, v)))
      }
    }
  }
end

procedure floyd_warshall (edges)
  local n, distance, next_vertex
  local e
  local i, j, k
  local dist_ij, dist_ik, dist_kj, dist_ikj

  n := max_vertex (edges)
  distance := create_array ([1, 1], [n, n], &null)
  next_vertex := create_array ([1, 1], [n, n], &null)

  # Initialization.
  every e := !edges do {
    ref_array (distance, e[1], e[3]) := e[2]
    ref_array (next_vertex, e[1], e[3]) := e[3]
  }
  every i := 1 to n do {
    ref_array (distance, i, i) := 0.0 # Distance to self = 0.
    ref_array (next_vertex, i, i) := i
  }

  # Perform the algorithm. Here &null will play the role of
  # "infinity": "\" means a value is finite, "/" that it is infinite.
  every k := 1 to n do {
    every i := 1 to n do {
      every j := 1 to n do {
        dist_ij := ref_array (distance, i, j)
        dist_ik := ref_array (distance, i, k)
        dist_kj := ref_array (distance, k, j)
        if \dist_ik & \dist_kj then {
          dist_ikj := dist_ik + dist_kj
          if /dist_ij | dist_ikj < dist_ij then {
            ref_array (distance, i, j) := dist_ikj
            ref_array (next_vertex, i, j) :=
                ref_array (next_vertex, i, k)
          }
        }
      }
    }
  }

  return fw_results (n, distance, next_vertex)
end

procedure find_path (next_vertex, u, v)
  local path

  if / (ref_array (next_vertex, u, v)) then {
    path := []
  } else {
    path := [u]
    while u ~= v do {
      u := ref_array (next_vertex, u, v)
      put (path, u)
    }
  }
  return path
end

procedure path_to_string (path)
  local s

  if *path = 0 then {
    s := ""
  } else {
    s := string (path[1])
    every s ||:= (" -> " || !path[2 : 0])
  }
  return s
end

procedure max_vertex (edges)
  local e
  local m

  *edges = 0 & stop ("no edges")
  m := 1
  every e := !edges do m := max (m, e[1], e[3])
  return m
end
Output:
$ 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

OCaml

Translation of: ATS


This implementation was written by referring frequently to 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.

(*
  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
;;
Output:
$ 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

Perl

sub FloydWarshall{
    my $edges = shift;
    my (@dist, @seq);
    my $num_vert = 0;
    # insert given dists into dist matrix
    map {
        $dist[$_->[0] - 1][$_->[1] - 1] = $_->[2];
        $num_vert = $_->[0] if $num_vert < $_->[0];
        $num_vert = $_->[1] if $num_vert < $_->[1];
    } @$edges;
    my @vertices = 0..($num_vert - 1);
    # init sequence/"next" table
    for my $i(@vertices){
        for my $j(@vertices){
            $seq[$i][$j] = $j if $i != $j;
        }
    }
    # diagonal of dists matrix
    #map {$dist[$_][$_] = 0} @vertices;
    for my $k(@vertices){
        for my $i(@vertices){
            next unless defined $dist[$i][$k];
            for my $j(@vertices){
                next unless defined $dist[$k][$j];
                if($i != $j && (!defined($dist[$i][$j]) 
                        || $dist[$i][$j] > $dist[$i][$k] + $dist[$k][$j])){
                    $dist[$i][$j] = $dist[$i][$k] + $dist[$k][$j];
                    $seq[$i][$j] = $seq[$i][$k];
                }
            }
        }
    }
    # print table
    print "pair     dist    path\n";
    for my $i(@vertices){
        for my $j(@vertices){
            next if $i == $j;
            my @path = ($i + 1);
            while($seq[$path[-1] - 1][$j] != $j){
                push @path, $seq[$path[-1] - 1][$j] + 1;
            }
            push @path, $j + 1;
            printf "%d -> %d  %4d     %s\n", 
                $path[0], $path[-1], $dist[$i][$j], join(' -> ', @path);
        }
    }
}

my $graph = [[1, 3, -2], [2, 1, 4], [2, 3, 3], [3, 4, 2], [4, 2, -1]];
FloydWarshall($graph);
Output:
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

Phix

Direct translation of the wikipedia pseudocode

constant inf = 1e300*1e300
 
function Path(integer u, integer v, sequence next)
    if next[u,v]=null then
       return ""
    end if
    sequence path = {sprintf("%d",u)}
    while u!=v do
       u = next[u,v]
       path = append(path,sprintf("%d",u))
    end while
    return join(path,"->")
end function
 
procedure FloydWarshall(integer V, sequence weights)
    sequence dist = repeat(repeat(inf,V),V)
    sequence next = repeat(repeat(null,V),V)
    for k=1 to length(weights) do
      integer {u,v,w} = weights[k]
      dist[u,v] := w  -- the weight of the edge (u,v)
      next[u,v] := v
    end for
    -- standard Floyd-Warshall implementation
    for k=1 to V do
      for i=1 to V do
        for j=1 to V do
          atom d = dist[i,k] + dist[k,j]
          if dist[i,j] > d then
            dist[i,j] := d
            next[i,j] := next[i,k]
          end if
        end for
      end for
    end for
    printf(1,"pair  dist  path\n")
    for u=1 to V do
      for v=1 to V do
        if u!=v then
          printf(1,"%d->%d   %2d   %s\n",{u,v,dist[u,v],Path(u,v,next)})
        end if
      end for
    end for
end procedure   
 
constant V = 4
constant weights = {{1, 3, -2}, {2, 1, 4}, {2, 3, 3}, {3, 4, 2}, {4, 2, -1}}
FloydWarshall(V,weights)
Output:
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

PHP

<?php
$graph = array();
for ($i = 0; $i < 10; ++$i) {
    $graph[] = array();
    for ($j = 0; $j < 10; ++$j)
        $graph[$i][] = $i == $j ? 0 : 9999999;
}

for ($i = 1; $i < 10; ++$i) {
    $graph[0][$i] = $graph[$i][0] = rand(1, 9);
}

for ($k = 0; $k < 10; ++$k) {
    for ($i = 0; $i < 10; ++$i) {
        for ($j = 0; $j < 10; ++$j) {
            if ($graph[$i][$j] > $graph[$i][$k] + $graph[$k][$j])
                $graph[$i][$j] = $graph[$i][$k] + $graph[$k][$j];
        }
    }
}

print_r($graph);
?>

Prolog

Works with SWI-Prolog as of Jan 2019

:- use_module(library(clpfd)).

path(List, To, From, [From], W) :-
    select([To,From,W],List,_).
path(List, To, From, [Link|R], W) :-
    select([To,Link,W1],List,Rest),
    W #= W1 + W2,
    path(Rest, Link, From, R, W2).

find_path(Din, From, To, [From|Pout], Wout) :-
    between(1, 4, From),
    between(1, 4, To),
    dif(From, To),
    findall([W,P], (
                path(Din, From, To, P, W),
                all_distinct(P)
            ), Paths),
    sort(Paths, [[Wout,Pout]|_]).


print_all_paths :-
    D = [[1, 3, -2], [2, 3, 3], [2, 1, 4], [3, 4, 2], [4, 2, -1]],
    format('Pair\t  Dist\tPath~n'),
    forall(
        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:
?- print_all_paths.
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
true.

?- 

Python

Translation of: Ruby
from math import inf
from itertools import product

def floyd_warshall(n, edge):
    rn = range(n)
    dist = [[inf] * n for i in rn]
    nxt  = [[0]   * n for i in rn]
    for i in rn:
        dist[i][i] = 0
    for u, v, w in edge:
        dist[u-1][v-1] = w
        nxt[u-1][v-1] = v-1
    for k, i, j in product(rn, repeat=3):
        sum_ik_kj = dist[i][k] + dist[k][j]
        if dist[i][j] > sum_ik_kj:
            dist[i][j] = sum_ik_kj
            nxt[i][j]  = nxt[i][k]
    print("pair     dist    path")
    for i, j in product(rn, repeat=2):
        if i != j:
            path = [i]
            while path[-1] != j:
                path.append(nxt[path[-1]][j])
            print("%d%d  %4d       %s" 
                  % (i + 1, j + 1, dist[i][j], 
                     ' → '.join(str(p + 1) for p in path)))

if __name__ == '__main__':
    floyd_warshall(4, [[1, 3, -2], [2, 1, 4], [2, 3, 3], [3, 4, 2], [4, 2, -1]])
Output:
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

Racket

Translation of: EchoLisp
#lang typed/racket
(require math/array)
 
;; in : initialized dist and next matrices
;; out : dist and next matrices
;; O(n^3)
(define-type Next-T (Option Index))
(define-type Dist-T Real)
(define-type Dists (Array Dist-T))
(define-type Nexts (Array Next-T))
(define-type Settable-Dists (Settable-Array Dist-T))
(define-type Settable-Nexts (Settable-Array Next-T))

(: floyd-with-path (-> Index Dists Nexts (Values Dists Nexts)))
(: init-edges (-> Index (Values Settable-Dists Settable-Nexts)))

(define (floyd-with-path n dist-in next-in)
  (define dist : Settable-Dists (array->mutable-array dist-in))
  (define next : Settable-Nexts (array->mutable-array next-in))
  (for* ((k n) (i n) (j n))
    (when (negative? (array-ref dist (vector j j)))
      (raise 'negative-cycle))
    (define i.k (vector i k))
    (define i.j (vector i j))
    (define d (+ (array-ref dist i.k) (array-ref dist (vector k j))))
    (when (< d (array-ref dist i.j))
      (array-set! dist i.j d)
      (array-set! next i.j (array-ref next i.k))))
  (values dist next))
 
;; utilities
 
;; init random edges costs, matrix 66% filled
(define (init-edges n)
  (define dist : Settable-Dists (array->mutable-array (make-array (vector n n) 0)))
  (define next : Settable-Nexts (array->mutable-array (make-array (vector n n) #f)))  
  (for* ((i n) (j n) #:unless (= i j))
    (define i.j (vector i j))
    (array-set! dist i.j +Inf.0)
    (unless (< (random) 0.3)
      (array-set! dist i.j (add1 (random 100)))
      (array-set! next i.j j)))
  (values dist next))
 
;; show path from u to v
(: path (-> Nexts Index Index (Listof Index)))
(define (path next u v)
  (let loop : (Listof Index) ((u : Index u) (rv : (Listof Index) null))
    (if (= u v)
        (reverse (cons u rv))
        (let ((nxt (array-ref next (vector u v))))
          (if nxt (loop nxt (cons u rv)) null)))))

;; show computed distance
(: mdist (-> Dists Index Index Dist-T))
(define (mdist dist u v)
  (array-ref dist (vector u v)))

(module+ main
  (define n 8)
  (define-values (dist next) (init-edges n))
  (define-values (dist+ next+) (floyd-with-path n dist next))
  (displayln "original dist")
  dist
  (displayln "new dist and next")
  dist+
  next+
  ;; note, these path and dist calls are not as carefully crafted as
  ;; the echolisp ones (in fact they're verbatim copied)
  (displayln "paths and distances")
  (path  next+ 1 3)
  (mdist dist+ 1 0)
  (mdist dist+ 0 3)
  (mdist dist+ 1 3)
  (path next+ 7 6)
  (path next+ 6 7))
Output:
original dist
(mutable-array
 #[#[0 51 +inf.0 11 44 13 +inf.0 86]
   #[48 0 70 +inf.0 65 78 77 54]
   #[29 +inf.0 0 +inf.0 78 14 +inf.0 24]
   #[40 79 52 0 +inf.0 99 37 88]
   #[71 62 +inf.0 7 0 +inf.0 +inf.0 +inf.0]
   #[89 65 83 +inf.0 91 0 41 70]
   #[69 34 +inf.0 49 +inf.0 89 0 20]
   #[2 56 +inf.0 60 +inf.0 75 +inf.0 0]])
new dist and next
(mutable-array
 #[#[0 51 63 11 44 13 48 68]
   #[48 0 70 59 65 61 77 54]
   #[26 77 0 37 70 14 55 24]
   #[40 71 52 0 84 53 37 57]
   #[47 62 59 7 0 60 44 64]
   #[63 65 83 74 91 0 41 61]
   #[22 34 85 33 66 35 0 20]
   #[2 53 65 13 46 15 50 0]])
(mutable-array
 #[#[#f 1 3 3 4 5 3 3]
   #[0 #f 2 0 4 0 6 7]
   #[7 7 #f 7 7 5 5 7]
   #[0 6 2 #f 0 0 6 6]
   #[3 1 3 3 #f 3 3 3]
   #[6 1 2 6 4 #f 6 6]
   #[7 1 7 7 7 7 #f 7]
   #[0 0 0 0 0 0 0 #f]])
paths and distances
'(1 0 3)
48
11
59
'(7 0 3 6)
'(6 7)

Raku

(formerly Perl 6)

Works with: Rakudo version 2016.12
Translation of: Ruby
sub Floyd-Warshall (Int $n, @edge) {
    my @dist = [0, |(Inf xx $n-1)], *.Array.rotate(-1) … !*[*-1];
    my @next = [0 xx $n] xx $n;

    for @edge -> ($u, $v, $w) {
        @dist[$u-1;$v-1] = $w;
        @next[$u-1;$v-1] = $v-1;
    }

    for [X] ^$n xx 3 -> ($k, $i, $j) {
        if @dist[$i;$j] > my $sum = @dist[$i;$k] + @dist[$k;$j] {
            @dist[$i;$j] = $sum;
            @next[$i;$j] = @next[$i;$k];
        }
    }

    say ' Pair  Distance     Path';
    for [X] ^$n xx 2 -> ($i, $j){
        next if $i == $j;
        my @path = $i;
        @path.push: @next[@path[*-1];$j] until @path[*-1] == $j;
        printf("%d → %d  %4d       %s\n", $i+1, $j+1, @dist[$i;$j],
          @path.map( *+1 ).join(' → '));
    }
}

Floyd-Warshall(4, [[1, 3, -2], [2, 1, 4], [2, 3, 3], [3, 4, 2], [4, 2, -1]]);
Output:
 Pair  Distance     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

RATFOR

Translation of: Fortran
Works with: ratfor77 version public domain 1.0
Works with: gfortran version 11.3.0
Works with: f2c version 20100827


#
# 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
Output:

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:

$ 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

Now f2c:

$ 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

REXX

/*REXX program uses Floyd─Warshall algorithm to find shortest distance between vertices.*/
v= 4             /*███       {1}       ███*/     /*number of vertices in weighted graph.*/
@.= 99999999     /*███    4 /   \ -2   ███*/     /*the default distance  (edge weight). */
@.1.3= -2        /*███     /  3  \     ███*/     /*the distance (weight) for an edge.   */
@.2.1=  4        /*███  {2} ────► {3}  ███*/     /* "     "         "     "   "   "     */
@.2.3=  3        /*███     \     /     ███*/     /* "     "         "     "   "   "     */
@.3.4=  2        /*███   -1 \   / 2    ███*/     /* "     "         "     "   "   "     */
@.4.2= -1        /*███       {4}       ███*/     /* "     "         "     "   "   "     */

            do     k=1  for v
              do   i=1  for v
                do j=1  for v;  _= @.i.k + @.k.j /*add two nodes together.              */
                if @.i.j>_  then @.i.j= _        /*use a new distance (weight) for edge.*/
                end   /*j*/
              end     /*i*/
            end       /*k*/
w= 12;                     $= left('', 20)       /*width of the columns for the output. */
say $ center('vertices',w) center('distance', w) /*display the  1st  line of the title. */
say $ center('pair'    ,w) center('(weight)', w) /*   "     "   2nd    "   "  "    "    */
say $ copies('═'       ,w) copies('═'       , w) /*   "     "   3rd    "   "  "    "    */
                                                 /* [↓]  display edge distances (weight)*/
   do   f=1  for v                               /*process each of the "from" vertices. */
     do t=1  for v;    if f==t  then iterate     /*   "      "   "  "   "to"      "     */
     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. */
output   when using the default inputs:
                       vertices     distance
                         pair       (weight)
                     ════════════ ════════════
                       1 ───► 2       -1
                       1 ───► 3       -2
                       1 ───► 4        0
                       2 ───► 1        4
                       2 ───► 3        2
                       2 ───► 4        4
                       3 ───► 1        5
                       3 ───► 2        1
                       3 ───► 4        2
                       4 ───► 1        3
                       4 ───► 2       -1
                       4 ───► 3        1

Ruby

def floyd_warshall(n, edge)
  dist = Array.new(n){|i| Array.new(n){|j| i==j ? 0 : Float::INFINITY}}
  nxt = Array.new(n){Array.new(n)}
  edge.each do |u,v,w|
    dist[u-1][v-1] = w
    nxt[u-1][v-1] = v-1
  end
  
  n.times do |k|
    n.times do |i|
      n.times do |j|
        if dist[i][j] > dist[i][k] + dist[k][j]
          dist[i][j] = dist[i][k] + dist[k][j]
          nxt[i][j] = nxt[i][k]
        end
      end
    end
  end
  
  puts "pair     dist    path"
  n.times do |i|
    n.times do |j|
      next  if i==j
      u = i
      path = [u]
      path << (u = nxt[u][j])  while u != j
      path = path.map{|u| u+1}.join(" -> ")
      puts "%d -> %d  %4d     %s" % [i+1, j+1, dist[i][j], path]
    end
  end
end

n = 4
edge = [[1, 3, -2], [2, 1, 4], [2, 3, 3], [3, 4, 2], [4, 2, -1]]
floyd_warshall(n, edge)
Output:
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

Rust

The lack of built-in support for multi-dimensional arrays makes the task in Rust a bit lengthy (without additional crates). The used graph representation leverages Rust's generics, so that it works with any type that defines addition and ordering and it requires no special value for infinity.

pub type Edge = (usize, usize);

#[derive(Clone, Debug, PartialEq, Eq, Hash)]
pub struct Graph<T> {
    size: usize,
    edges: Vec<Option<T>>,
}

impl<T> Graph<T> {
    pub fn new(size: usize) -> Self {
        Self {
            size,
            edges: std::iter::repeat_with(|| None).take(size * size).collect(),
        }
    }

    pub fn new_with(size: usize, f: impl FnMut(Edge) -> Option<T>) -> Self {
        let edges = (0..size)
            .flat_map(|i| (0..size).map(move |j| (i, j)))
            .map(f)
            .collect();

        Self { size, edges }
    }

    pub fn with_diagonal(mut self, mut f: impl FnMut(usize) -> Option<T>) -> Self {
        self.edges
            .iter_mut()
            .step_by(self.size + 1)
            .enumerate()
            .for_each(move |(vertex, edge)| *edge = f(vertex));

        self
    }

    pub fn size(&self) -> usize {
        self.size
    }

    pub fn edge(&self, edge: Edge) -> &Option<T> {
        let index = self.edge_index(edge);
        &self.edges[index]
    }

    pub fn edge_mut(&mut self, edge: Edge) -> &mut Option<T> {
        let index = self.edge_index(edge);
        &mut self.edges[index]
    }

    fn edge_index(&self, (row, col): Edge) -> usize {
        assert!(row < self.size && col < self.size);
        row * self.size() + col
    }
}

impl<T> std::ops::Index<Edge> for Graph<T> {
    type Output = Option<T>;

    fn index(&self, index: Edge) -> &Self::Output {
        self.edge(index)
    }
}

impl<T> std::ops::IndexMut<Edge> for Graph<T> {
    fn index_mut(&mut self, index: Edge) -> &mut Self::Output {
        self.edge_mut(index)
    }
}

#[derive(Clone, Debug, PartialEq, Eq)]
pub struct Paths(Graph<usize>);

impl Paths {
    pub fn new<T>(graph: &Graph<T>) -> Self {
        Self(Graph::new_with(graph.size(), |(i, j)| {
            graph[(i, j)].as_ref().map(|_| j)
        }))
    }

    pub fn vertices(&self, from: usize, to: usize) -> Path<'_> {
        assert!(from < self.0.size() && to < self.0.size());

        Path {
            graph: &self.0,
            from: Some(from),
            to,
        }
    }

    fn update(&mut self, from: usize, to: usize, via: usize) {
        self.0[(from, to)] = self.0[(from, via)];
    }
}

#[derive(Clone, Copy, Debug, PartialEq, Eq)]
pub struct Path<'a> {
    graph: &'a Graph<usize>,
    from: Option<usize>,
    to: usize,
}

impl<'a> Iterator for Path<'a> {
    type Item = usize;

    fn next(&mut self) -> Option<Self::Item> {
        self.from.map(|from| {
            let result = from;

            self.from = if result != self.to {
                self.graph[(result, self.to)]
            } else {
                None
            };

            result
        })
    }
}

pub fn floyd_warshall<W>(mut result: Graph<W>) -> (Graph<W>, Option<Paths>)
where
    W: Copy + std::ops::Add<W, Output = W> + std::cmp::Ord + Default,
{
    let mut without_negative_cycles = true;
    let mut paths = Paths::new(&result);
    let n = result.size();

    for k in 0..n {
        for i in 0..n {
            for j in 0..n {
                // Negative cycle detection with T::default as the negative boundary
                if i == j && result[(i, j)].filter(|&it| it < W::default()).is_some() {
                    without_negative_cycles = false;
                    continue;
                }

                if let (Some(ik_weight), Some(kj_weight)) = (result[(i, k)], result[(k, j)]) {
                    let ij_edge = result.edge_mut((i, j));
                    let ij_weight = ik_weight + kj_weight;

                    if ij_edge.is_none() {
                        *ij_edge = Some(ij_weight);
                        paths.update(i, j, k);
                    } else {
                        ij_edge
                            .as_mut()
                            .filter(|it| ij_weight < **it)
                            .map_or((), |it| {
                                *it = ij_weight;
                                paths.update(i, j, k);
                            });
                    }
                }
            }
        }
    }

    (result, Some(paths).filter(|_| without_negative_cycles)) // No paths for negative cycles
}

fn format_path<T: ToString>(path: impl Iterator<Item = T>) -> String {
    path.fold(String::new(), |mut acc, x| {
        if !acc.is_empty() {
            acc.push_str(" -> ");
        }

        acc.push_str(&x.to_string());
        acc
    })
}

fn print_results<W, V>(weights: &Graph<W>, paths: Option<&Paths>, vertex: impl Fn(usize) -> V)
where
    W: std::fmt::Display + Default + Eq,
    V: std::fmt::Display,
{
    let n = weights.size();

    for from in 0..n {
        for to in 0..n {
            if let Some(weight) = &weights[(from, to)] {
                // Skip trivial information (i.e., default weight on the diagonal)
                if from == to && *weight == W::default() {
                    continue;
                }

                println!(
                    "{} -> {}: {} \t{}",
                    vertex(from),
                    vertex(to),
                    weight,
                    format_path(paths.iter().flat_map(|p| p.vertices(from, to)).map(&vertex))
                );
            }
        }
    }
}

fn main() {
    let graph = {
        let mut g = Graph::new(4).with_diagonal(|_| Some(0));
        g[(0, 2)] = Some(-2);
        g[(1, 0)] = Some(4);
        g[(1, 2)] = Some(3);
        g[(2, 3)] = Some(2);
        g[(3, 1)] = Some(-1);
        g
    };

    let (weights, paths) = floyd_warshall(graph);
    // Fixup the vertex name (as we use zero-based indices)
    print_results(&weights, paths.as_ref(), |index| index + 1);
}
Output:
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


Scala

Translation of: Java
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)
    }
  }
}
Output:
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

Scheme

Works with: Scheme version R7RS small

I have run this program successfully in Chibi, Gauche, and CHICKEN 5 Schemes. (One may need an extension to run R7RS code in CHICKEN.)

;;; Floyd-Warshall algorithm.
;;;
;;; See https://en.wikipedia.org/w/index.php?title=Floyd%E2%80%93Warshall_algorithm&oldid=1082310013
;;;

(import (scheme base))
(import (scheme cxr))
(import (scheme write))

;;;
;;; A square array will be represented by a cons-pair:
;;;
;;;    (vector-of-length n-squared . n)
;;;
;;; Arrays are indexed *starting at one*.
;;;

(define (make-arr n fill)
  (cons (make-vector (* n n) fill) n))

(define (arr-set! arr i j x)
  (let ((vec (car arr))
        (n (cdr arr)))
    (vector-set! vec (+ (- i 1) (* n (- j 1))) x)))

(define (arr-ref arr i j)
  (let ((vec (car arr))
        (n (cdr arr)))
    (vector-ref vec (+ (- i 1) (* n (- 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 (to help keep this example brief)
;;; integers from 1 .. n.
;;;

(define (floyd-warshall edges)

  (define n
    ;; Set n to the maximum vertex number. By design, n also equals
    ;; the number of vertices.
    (max (apply max (map car edges))
         (apply max (map caddr edges))))

  (define distance (make-arr n +inf.0))
  (define next-vertex (make-arr n #f))

  ;; Initialize "distance" and "next-vertex".
  (for-each (lambda (edge)
              (let ((u (car edge))
                    (weight (cadr edge))
                    (v (caddr edge)))
                (arr-set! distance u v weight)
                (arr-set! next-vertex u v v)))
            edges)
  (do ((v 1 (+ v 1)))
      ((< n v))
    (arr-set! distance v v 0)
    (arr-set! next-vertex v v v))

  ;; Perform the algorithm.
  (do ((k 1 (+ k 1)))
      ((< n k))
    (do ((i 1 (+ i 1)))
        ((< n i))
      (do ((j 1 (+ j 1)))
          ((< n j))
        (let ((dist-ij (arr-ref distance i j))
              (dist-ik (arr-ref distance i k))
              (dist-kj (arr-ref distance k j)))
          (let ((dist-ik+dist-kj (+ dist-ik dist-kj)))
            (when (< dist-ik+dist-kj dist-ij)
              (arr-set! distance i j dist-ik+dist-kj)
              (arr-set! next-vertex i j
                        (arr-ref next-vertex 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.
;;;

(define (find-path next-vertex u v)
  (if (not (arr-ref next-vertex u v))
      (list)
      (let loop ((u u)
                 (path (list u)))
        (if (= u v)
            (reverse path)
            (let ((u^ (arr-ref next-vertex u v)))
              (loop u^ (cons u^ path)))))))

(define (display-path path)
  (let loop ((p path))
    (cond ((null? p))
          ((null? (cdr p)) (display (car p)))
          (else (display (car p))
                (display " -> ")
                (loop (cdr p))))))

(define example-graph
  '((1 -2 3)
    (3 2 4)
    (4 -1 2)
    (2 4 1)
    (2 3 3)))

(let-values (((n distance next-vertex)
              (floyd-warshall example-graph)))
  (display " pair   distance    path")
  (newline)
  (display "------------------------------------")
  (newline)
  (do ((u 1 (+ u 1)))
      ((< n u))
    (do ((v 1 (+ v 1)))
        ((< n v))
      (unless (= u v)
        (display u)
        (display " -> ")
        (display v)
        (let* ((s (number->string (arr-ref distance u v)))
               (slen (string-length s))
               (padding (- 7 slen)))
          (display (make-string padding #\space))
          (display s))
        (display "      ")
        (display-path (find-path next-vertex u v))
        (newline)))))
Output:
$ gosh floyd-warshall.scm
 pair   distance    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

SequenceL

Translation of: Go
import <Utilities/Sequence.sl>;
import <Utilities/Math.sl>;

ARC ::= (To: int, Weight: float);
arc(t,w) := (To: t, Weight: w);
VERTEX ::= (Label: int, Arcs: ARC(1));
vertex(l,arcs(1)) := (Label: l, Arcs: arcs);

getArcsFrom(vertex, graph(1)) :=
    let
        index := firstIndexOf(graph.Label, vertex);
    in
        [] when index = 0
    else
        graph[index].Arcs;

getWeightTo(vertex, arcs(1)) :=
    let
        index := firstIndexOf(arcs.To, vertex);
    in
        0 when index = 0
    else
        arcs[index].Weight;
        
throughK(k, dist(2)) :=
    let
        newDist[i, j] := min(dist[i][k] + dist[k][j], dist[i][j]);
    in
        dist when k > size(dist)
    else
        throughK(k + 1, newDist);

floydWarshall(graph(1)) :=
    let
        initialResult[i,j] := 1.79769e308 when i /= j else 0
                              foreach i within 1 ... size(graph),
                                      j within 1 ... size(graph);
                                        
        singleResult[i,j] := getWeightTo(j, getArcsFrom(i, graph))
                             foreach i within 1 ... size(graph),
                                     j within 1 ... size(graph);
        
        start[i,j] := 
                initialResult[i,j] when singleResult[i,j] = 0
            else
                singleResult[i,j];    
    in
        throughK(1, start);

main() :=
    let
        graph := [vertex(1, [arc(3,-2)]),
                  vertex(2, [arc(1,4), arc(3,3)]),
                  vertex(3, [arc(4,2)]),
                  vertex(4, [arc(2,-1)])];
    in
        floydWarshall(graph);
Output:
[[0,-1,-2,0],[4,0,2,4],[5,1,0,2],[3,-1,1,0]]

Sidef

Translation of: Ruby
func floyd_warshall(n, edge) {
    var dist = n.of {|i| n.of { |j| i == j ? 0 : Inf }}
    var nxt  = n.of { n.of(nil) }
    for u,v,w in edge {
        dist[u-1][v-1] = w
         nxt[u-1][v-1] = v-1
    }

    [^n] * 3 -> cartesian { |k, i, j|
        if (dist[i][j] > dist[i][k]+dist[k][j]) {
            dist[i][j] = dist[i][k]+dist[k][j]
            nxt[i][j] = nxt[i][k]
        }
    }
 
    var summary = "pair     dist    path\n"
    for i,j (^n ~X ^n) {
        i==j && next
        var u = i
        var path = [u]
        while (u != j) {
            path << (u = nxt[u][j])
        }
        path.map!{|u| u+1 }.join!(" -> ")
        summary += ("%d -> %d  %4d     %s\n" % (i+1, j+1, dist[i][j], path))
    }

    return summary
}

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)
Output:
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

Standard ML

Translation of: OCaml
Works with: MLton version 20210117
Works with: Poly/ML version 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.)


(*
  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: *)
Output:
$ 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

Tcl

Library: Tcllib (Package: struct::graph::op)

The implementation of Floyd-Warshall in tcllib is quite readable; this example merely initialises a graph from an adjacency list then calls the tcllib code:

package require Tcl 8.5     ;# for {*} and [dict]
package require struct::graph
package require struct::graph::op

struct::graph g

set arclist {
    a b
    a p
    b m
    b c
    c d
    d e
    e f
    f q
    f g
}

g node insert {*}$arclist

foreach {from to} $arclist {
    set a [g arc insert $from $to]
    g arc setweight $a 1.0
}

set paths [::struct::graph::op::FloydWarshall g]

set paths [dict filter $paths key {a *}]        ;# filter for paths starting at "a"
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
Output:
{a q} 6.0 {a g} 6.0 {a f} 5.0 {a e} 4.0 {a d} 3.0 {a m} 2.0 {a c} 2.0 {a p} 1.0 {a b} 1.0 {a a} 0

Visual Basic .NET

Translation of: C#
Module Module1

    Sub PrintResult(dist As Double(,), nxt As Integer(,))
        Console.WriteLine("pair     dist    path")
        For i = 1 To nxt.GetLength(0)
            For j = 1 To nxt.GetLength(1)
                If i <> j Then
                    Dim u = i
                    Dim v = j
                    Dim path = String.Format("{0} -> {1}    {2,2:G}     {3}", u, v, dist(i - 1, j - 1), u)
                    Do
                        u = nxt(u - 1, v - 1)
                        path += String.Format(" -> {0}", u)
                    Loop While u <> v
                    Console.WriteLine(path)
                End If
            Next
        Next
    End Sub

    Sub FloydWarshall(weights As Integer(,), numVerticies As Integer)
        Dim dist(numVerticies - 1, numVerticies - 1) As Double
        For i = 1 To numVerticies
            For j = 1 To numVerticies
                dist(i - 1, j - 1) = Double.PositiveInfinity
            Next
        Next

        For i = 1 To weights.GetLength(0)
            dist(weights(i - 1, 0) - 1, weights(i - 1, 1) - 1) = weights(i - 1, 2)
        Next

        Dim nxt(numVerticies - 1, numVerticies - 1) As Integer
        For i = 1 To numVerticies
            For j = 1 To numVerticies
                If i <> j Then
                    nxt(i - 1, j - 1) = j
                End If
            Next
        Next

        For k = 1 To numVerticies
            For i = 1 To numVerticies
                For j = 1 To numVerticies
                    If dist(i - 1, k - 1) + dist(k - 1, j - 1) < dist(i - 1, j - 1) Then
                        dist(i - 1, j - 1) = dist(i - 1, k - 1) + dist(k - 1, j - 1)
                        nxt(i - 1, j - 1) = nxt(i - 1, k - 1)
                    End If
                Next
            Next
        Next

        PrintResult(dist, nxt)
    End Sub

    Sub Main()
        Dim weights = {{1, 3, -2}, {2, 1, 4}, {2, 3, 3}, {3, 4, 2}, {4, 2, -1}}
        Dim numVeritices = 4

        FloydWarshall(weights, numVeritices)
    End Sub

End Module
Output:
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

Wren

Translation of: Kotlin
Library: Wren-fmt
import "./fmt" for Fmt

class FloydWarshall {
    static doCalcs(weights, nVertices) {
        var dist = List.filled(nVertices, null)
        for (i in 0...nVertices) dist[i] = List.filled(nVertices, 1/0)
        for (w in weights) dist[w[0] - 1][w[1] - 1] = w[2]
        var next = List.filled(nVertices, null)
        for (i in 0...nVertices) next[i] = List.filled(nVertices, 0)
        for (i in 0...next.count) {
            for (j in 0...next.count) {
                if (i != j) next[i][j] = j + 1
            }
        }
        for (k in 0...nVertices) {
            for (i in 0...nVertices) {
                for (j in 0...nVertices) {
                    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)
    }

    static printResult_(dist,  next) {
        System.print("pair     dist    path")
        for (i in 0...next.count) {
            for (j in 0...next.count) {
                if (i != j) {
                    var u = i + 1
                    var v = j + 1
                    var path = Fmt.swrite("$d -> $d    $2d     $s", u, v, dist[i][j].truncate, u)
                    while (true) {
                        u = next[u - 1][v - 1]
                        path = path +  " -> " + u.toString
                        if (u == v) break
                    }
                    System.print(path)
                }
            }
        }
    }
}

var weights = [ [1, 3, -2], [2, 1, 4], [2, 3, 3], [3, 4, 2], [4, 2, -1] ]
var nVertices = 4
FloydWarshall.doCalcs(weights, nVertices)
Output:
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

zkl

fcn FloydWarshallWithPathReconstruction(dist){ // dist is munged
   V:=dist[0].len();
   next:=V.pump(List,V.pump(List,Void.copy).copy);  // VxV matrix of Void
   foreach u,v in (V,V){ if(dist[u][v]!=Void and u!=v) next[u][v] = v }
   foreach k,i,j in (V,V,V){
      a,b,c:=dist[i][j],dist[i][k],dist[k][j];
      if( (a!=Void and b!=Void and c!=Void and a>b+c) or  // Inf math
      (a==Void and b!=Void and c!=Void) ){
     dist[i][j] = b+c;
     next[i][j] = next[i][k];
      }
   }
   return(dist,next)
} 
fcn path(next,u,v){
   if(Void==next[u][v]) return(T);
   path:=List(u);
   while(u!=v){ path.append(u = next[u][v]) }
   path
}
fcn printM(m){ m.pump(Console.println,rowFmt) }
fcn rowFmt(row){ ("%5s "*row.len()).fmt(row.xplode()) }
const V=4;
dist:=V.pump(List,V.pump(List,Void.copy).copy);  // VxV matrix of Void
foreach i in (V){ dist[i][i] = 0 }     // zero vertexes

/* Graph from the Wikipedia:
   1  2  3  4
 d ----------
1| 0  X -2  X
2| 4  0  3  X
3| X  X  0  2
4| X -1  X  0
*/
dist[0][2]=-2; dist[1][0]=4; dist[1][2]=3; dist[2][3]=2; dist[3][1]=-1; 

dist,next:=FloydWarshallWithPathReconstruction(dist);
println("Shortest distance array:"); printM(dist);
println("\nPath array:");        printM(next);
println("\nAll paths:");
foreach u,v in (V,V){
   if(p:=path(next,u,v)) p.println();
}
Output:
Shortest distance array:
    0    -1    -2     0 
    4     0     2     4 
    5     1     0     2 
    3    -1     1     0 

Path array:
 Void     2     2     2 
    0  Void     0     0 
    3     3  Void     3 
    1     1     1  Void 

All paths:
L(0,2,3,1)
L(0,2)
L(0,2,3)
L(1,0)
L(1,0,2)
L(1,0,2,3)
L(2,3,1,0)
L(2,3,1)
L(2,3)
L(3,1,0)
L(3,1)
L(3,1,0,2)