Floyd-Warshall algorithm: Difference between revisions
Line 1,355: | Line 1,355: | ||
<pre> |
<pre> |
||
C:\rosettaCode>fwGraph.exe fwGraph.txt |
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> |
|||
VERSION 2. Usando una librería experimental, que pronto será liberada en GitHub, desarrollé la versión anterior del programa. La librería trabaja con memoria dinámica, tanto para strings, como para arrays de un tipo y multitipo. En el ejemplo, se usan funciones para arrays de un tipo. Lo que busco con esta librería experimental, es simplificar la programación, elevar el nivel de abstracción del lenguaje C (un poco), y lograr código elegante. |
|||
<lang C> |
|||
#include<limits.h> |
|||
#include "gadget.h" |
|||
/* algunos datos globales */ |
|||
int vertices,edges; |
|||
/* algunos prototipos */ |
|||
F_STAT DatosdeArchivo( char *cFile); |
|||
void SeteaRangosLectura(F_STAT dataFile); |
|||
int * CargaMatriz(int * mat, DS_ARRAY * mat_data, char * cFile, F_STAT stat ); |
|||
int * CargaGrafo(int * graph, DS_ARRAY * graph_data, char *cFile); |
|||
void Floyd_Warshall(int * graph, DS_ARRAY graph_data); |
|||
/* bloque principal */ |
|||
Main |
|||
GetArgStr(cFile,1); |
|||
SetTokSep(' '); |
|||
Cls; |
|||
if(ExistFile(cFile)){ |
|||
New Array graph as int; |
|||
graph = CargaGrafo(graph, &graph_data, cFile); |
|||
if(graph){ |
|||
/* calcula Floyd-Warshall */ |
|||
printf("Vertices=%d, edges=%d\n",vertices,edges); |
|||
Floyd_Warshall(graph, graph_data); |
|||
Free Array graph; |
|||
} |
|||
}else{ |
|||
MsgRedf("No existe el archivo %s",cFile); |
|||
} |
|||
Free Secure cFile; |
|||
End |
|||
void Floyd_Warshall(int * graph, DS_ARRAY graph_data){ |
|||
Array processWeights, processedVertices as int(vertices,vertices); |
|||
ROWS 0:1:vertices-1; COLS 0:1:vertices-1; |
|||
COMPUTE_MAT ( MAT( processWeights ) = SHRT_MAX; |
|||
MAT( processedVertices ) = (i!=j)?j+1:0; ); |
|||
#define VERT_ORIG 0 |
|||
#define VERT_DEST 1 |
|||
#define WEIGHT 2 |
|||
VECT 0:1:edges-1; |
|||
IterVec( i, |
|||
int vert_origen = Cell(graph,i,VERT_ORIG)-1; |
|||
int vert_destino = Cell(graph,i,VERT_DEST)-1; |
|||
Cell( processWeights, vert_origen, vert_destino ) = Cell( graph,i,WEIGHT) ); |
|||
PAGS 0:1:vertices-1; |
|||
COMPUTE_BLK ( if( Cell(processWeights,j,i) + Cell(processWeights,i,k) < Cell(processWeights,j,k) ) |
|||
{ |
|||
Cell(processWeights,j,k) = Cell(processWeights,j,i) + Cell(processWeights,i,k); |
|||
Cell(processedVertices,j,k) = Cell(processedVertices,j,i); |
|||
} |
|||
); |
|||
printf("pair dist path"); |
|||
COMPUTE_MAT ( if(i!=j) |
|||
{ |
|||
printf("\n%d -> %d %3d %5d",i+1,j+1, Cell(processWeights,i,j),i+1); |
|||
int k = i+1; |
|||
do{ |
|||
k = Cell(processedVertices,k-1,j); |
|||
printf("->%d",k); |
|||
}while(k!=j+1); |
|||
} |
|||
); |
|||
Free Array processWeights, processedVertices; |
|||
} |
|||
F_STAT DatosdeArchivo( char *cFile){ |
|||
return StatFile(cFile); |
|||
} |
|||
void SeteaRangosLectura(F_STAT df){ |
|||
ROWS 0:1:df.total_lines-1 ; |
|||
COLS 0:1:df.max_tokens_per_line-1; |
|||
PAGS NONE; |
|||
} |
|||
int * CargaMatriz(int * mat, DS_ARRAY * mat_data, char * cFile, F_STAT stat ){ |
|||
return LoadMatrix_int( mat, mat_data, cFile, stat); |
|||
} |
|||
int * CargaGrafo(int * graph, DS_ARRAY * graph_data, char *cFile){ |
|||
F_STAT dataFile = DatosdeArchivo(cFile); |
|||
if(dataFile.is_matrix){ |
|||
SeteaRangosLectura(dataFile); |
|||
graph = CargaMatriz( graph, graph_data, cFile, dataFile); |
|||
if( graph ){ |
|||
/* obtengo vertices y edges */ |
|||
edges = dataFile.total_lines; |
|||
/* busco entre los vertices, el último nodo, el mayor. |
|||
Uso un "Block", para no llamar una función */ |
|||
Block( vertices, COLS 0:1:1; // busque en las 2 primeras columnas del array vertices |
|||
ROWS 0:1:graph_data->rows-1; // busque en todas las filas |
|||
PAGS NONE; // no hay páginas |
|||
DS_MAXMIN maxNode = MaxArray_int( graph,graph_data ); |
|||
OutInt( Cell(graph, maxNode.local) ) ); |
|||
}else{ |
|||
MsgRedf("Archivo \"%s\" no ha podido ser cargado",cFile); |
|||
} |
|||
}else{ |
|||
MsgRedf("Archivo \"%s\" no es cuadrado",cFile); |
|||
} |
|||
return graph; |
|||
} |
|||
</lang> |
|||
{{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 floy_data.txt |
|||
Vertices=4, edges=5 |
|||
pair dist path |
pair dist path |
||
1 -> 2 -1 1->3->4->2 |
1 -> 2 -1 1->3->4->2 |
Revision as of 06:10, 19 May 2022
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
<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)])</lang>
- 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
<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</lang>
- 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
<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;</lang>
- 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
ATS
A first implementation
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.
<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</lang>
- 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
A second version. An explanation of "Why a second version?" is contained in the program text.
<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
(*------------------------------------------------------------------*)</lang>
- 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. <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;
} </lang> 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
VERSION 2. Usando una librería experimental, que pronto será liberada en GitHub, desarrollé la versión anterior del programa. La librería trabaja con memoria dinámica, tanto para strings, como para arrays de un tipo y multitipo. En el ejemplo, se usan funciones para arrays de un tipo. Lo que busco con esta librería experimental, es simplificar la programación, elevar el nivel de abstracción del lenguaje C (un poco), y lograr código elegante. <lang C>
- include<limits.h>
- include "gadget.h"
/* algunos datos globales */ int vertices,edges;
/* algunos prototipos */ F_STAT DatosdeArchivo( char *cFile); void SeteaRangosLectura(F_STAT dataFile); int * CargaMatriz(int * mat, DS_ARRAY * mat_data, char * cFile, F_STAT stat ); int * CargaGrafo(int * graph, DS_ARRAY * graph_data, char *cFile); void Floyd_Warshall(int * graph, DS_ARRAY graph_data);
/* bloque principal */ Main
GetArgStr(cFile,1); SetTokSep(' '); Cls; if(ExistFile(cFile)){ New Array graph as int; graph = CargaGrafo(graph, &graph_data, cFile); if(graph){ /* calcula Floyd-Warshall */ printf("Vertices=%d, edges=%d\n",vertices,edges);
Floyd_Warshall(graph, graph_data);
Free Array graph; }
}else{ MsgRedf("No existe el archivo %s",cFile); } Free Secure cFile;
End
void Floyd_Warshall(int * graph, DS_ARRAY graph_data){
Array processWeights, processedVertices as int(vertices,vertices); ROWS 0:1:vertices-1; COLS 0:1:vertices-1; COMPUTE_MAT ( MAT( processWeights ) = SHRT_MAX; MAT( processedVertices ) = (i!=j)?j+1:0; );
- define VERT_ORIG 0
- define VERT_DEST 1
- define WEIGHT 2
VECT 0:1:edges-1; IterVec( i, int vert_origen = Cell(graph,i,VERT_ORIG)-1; int vert_destino = Cell(graph,i,VERT_DEST)-1; Cell( processWeights, vert_origen, vert_destino ) = Cell( graph,i,WEIGHT) );
PAGS 0:1:vertices-1; COMPUTE_BLK ( if( Cell(processWeights,j,i) + Cell(processWeights,i,k) < Cell(processWeights,j,k) ) { Cell(processWeights,j,k) = Cell(processWeights,j,i) + Cell(processWeights,i,k); Cell(processedVertices,j,k) = Cell(processedVertices,j,i); } );
printf("pair dist path");
COMPUTE_MAT ( if(i!=j) { printf("\n%d -> %d %3d %5d",i+1,j+1, Cell(processWeights,i,j),i+1); int k = i+1; do{ k = Cell(processedVertices,k-1,j); printf("->%d",k); }while(k!=j+1); } );
Free Array processWeights, processedVertices;
}
F_STAT DatosdeArchivo( char *cFile){
return StatFile(cFile);
}
void SeteaRangosLectura(F_STAT df){
ROWS 0:1:df.total_lines-1 ; COLS 0:1:df.max_tokens_per_line-1; PAGS NONE;
}
int * CargaMatriz(int * mat, DS_ARRAY * mat_data, char * cFile, F_STAT stat ){
return LoadMatrix_int( mat, mat_data, cFile, stat);
}
int * CargaGrafo(int * graph, DS_ARRAY * graph_data, char *cFile){
F_STAT dataFile = DatosdeArchivo(cFile); if(dataFile.is_matrix){ SeteaRangosLectura(dataFile);
graph = CargaMatriz( graph, graph_data, cFile, dataFile);
if( graph ){ /* obtengo vertices y edges */ edges = dataFile.total_lines; /* busco entre los vertices, el último nodo, el mayor. Uso un "Block", para no llamar una función */ Block( vertices, COLS 0:1:1; // busque en las 2 primeras columnas del array vertices ROWS 0:1:graph_data->rows-1; // busque en todas las filas PAGS NONE; // no hay páginas DS_MAXMIN maxNode = MaxArray_int( graph,graph_data ); OutInt( Cell(graph, maxNode.local) ) );
}else{ MsgRedf("Archivo \"%s\" no ha podido ser cargado",cFile); }
}else{ MsgRedf("Archivo \"%s\" no es cuadrado",cFile); } return graph;
} </lang>
- Output:
Archivo fuente: floyd_data.txt
1 3 -2 3 4 2 4 2 -1 2 1 4 2 3 3
Salida:
$ ./floydWarshall floy_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#
<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); } }
}</lang>
C++
<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;
}</lang>
- 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
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.
<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:</lang>
- 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
<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); } } }
}</lang>
- 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. <lang scheme> (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))
</lang>
- 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
<lang 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)</lang>
- 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
<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}))
</lang>
The Task
<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)))) </lang>
- 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
<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</lang>
- 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
<lang freebasic>' 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</lang>
- 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
<lang 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))) } } }
}</lang>
- 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
<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) } } } }
}</lang>
- 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 <lang haskell>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)</lang>
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...)
<lang haskell>data Shortest b a = Shortest { distance :: a, path :: [b] }
deriving Show</lang>
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
a <> b = case distance a `compare` distance b of GT -> b LT -> a EQ -> a { path = path a `union` path b }</lang>
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
:
<lang haskell>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</lang>
The floydWarshall
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
where buildPath (i,j) | i == j = j | otherwise = do k <- path $ fromJust $ lookup (i,j) d p <- buildPath (k,j) [i : p]</lang>
All pre- and postprocessing is done by the main function findMinDistances
:
<lang haskell>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)</lang>
Examples:
The sample graph: <lang haskell>g = fromList [((2,1), 4)
,((2,3), 3) ,((1,3), -2) ,((3,4), 2) ,((4,2), -1)]</lang>
the helper function <lang haskell>showShortestPaths v g = mapM_ print $ toList $ findMinDistances v g</lang>
- 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:
<lang haskell>g2 = fromList [(('A','S'), 1)
,(('A','D'), -1) ,(('S','E'), 2) ,(('D','E'), 4)]</lang>
λ> 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
<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</lang>
- 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
<lang J>floyd=: verb define
for_j. i.#y do. y=. y <. j ({"1 +/ {) y end.
)</lang>
Example use:
<lang J>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</lang>
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:
<lang J>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
)</lang>
Draft output:
<lang J> 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</lang>
Java
<lang 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); } } } }
}</lang>
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
<lang javascript>var graph = [];
for (i = 0; i < 10; ++i) {
graph.push([]); for (j = 0; j < 10; ++j) graph[i].push(i == j ? 0 : 9999999);
}
for (i = 1; i < 10; ++i) {
graph[0][i] = graph[i][0] = parseInt(Math.random() * 9 + 1);
}
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] } }
}
console.log(graph);</lang>
jq
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: <lang jq> def weights: {
"1": {"3": -2}, "2": {"1" : 4, "3": 3}, "3": {"4": 2}, "4": {"2": -1}
};</lang>
The algorithm given here is a direct implementation of the definitional algorithm: <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</lang>
- 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
<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)</lang>
Kotlin
<lang scala>// 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)
}</lang>
- 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
<lang lua>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)</lang>
- 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
<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[{vli, vlj, dmi, j}, {i, Length[vl]}, {j, Length[vl]}]], {x_, x_, _}]]]</lang>
- 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
<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:</lang>
- 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
<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.</lang>
Nim
<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)</lang>
- 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
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.
<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)
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</lang>
- 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
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.
<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
- </lang>
- 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
<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); } }
}
my $graph = [[1, 3, -2], [2, 1, 4], [2, 3, 3], [3, 4, 2], [4, 2, -1]]; FloydWarshall($graph);</lang>
- 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
<lang 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); ?></lang>
Prolog
Works with SWI-Prolog as of Jan 2019 <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]))).</lang>
- 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
<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]])</lang>
- 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
<lang racket>#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))</lang>
- 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)
<lang perl6>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]]);</lang>
- 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
<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</lang>
- 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
<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. */</lang>
- 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
<lang 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)</lang>
- 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.
<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);
} </lang>
- 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
Scheme
I have run this program successfully in Chibi, Gauche, and CHICKEN 5 Schemes. (One may need an extension to run R7RS code in CHICKEN.)
<lang scheme>;;; Floyd-Warshall algorithm.
(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)))))</lang>
- 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
<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);</lang>
- Output:
[[0,-1,-2,0],[4,0,2,4],[5,1,0,2],[3,-1,1,0]]
Sidef
<lang 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)</lang>
- 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
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.)
<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: *)</lang>
- 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
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:
<lang Tcl>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</lang>
- 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
<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</lang>
- 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
<lang ecmascript>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)</lang>
- 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
<lang 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()) }</lang> <lang zkl>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();
}</lang>
- 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)
- Programming Tasks
- Routing algorithms
- 11l
- 360 Assembly
- Ada
- ATS
- C
- C sharp
- C++
- Common Lisp
- D
- EchoLisp
- Elixir
- F Sharp
- Fortran
- FreeBASIC
- Go
- Groovy
- Haskell
- Icon
- J
- Java
- JavaScript
- Javascript examples needing attention
- Examples needing attention
- Jq
- Julia
- Kotlin
- Lua
- Mathematica
- Wolfram Language
- Mercury
- Modula-2
- Nim
- ObjectIcon
- OCaml
- Perl
- Phix
- PHP
- Prolog
- Python
- Racket
- Raku
- RATFOR
- REXX
- Ruby
- Rust
- Scheme
- SequenceL
- Sidef
- Standard ML
- Tcl
- Tcllib
- Visual Basic .NET
- Wren
- Wren-fmt
- Zkl