Data commit
This commit is contained in:
parent
7387c8f97b
commit
cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
3
Task/Floyd-Warshall-algorithm/00-META.yaml
Normal file
3
Task/Floyd-Warshall-algorithm/00-META.yaml
Normal file
|
|
@ -0,0 +1,3 @@
|
|||
---
|
||||
from: http://rosettacode.org/wiki/Floyd-Warshall_algorithm
|
||||
note: Routing algorithms
|
||||
28
Task/Floyd-Warshall-algorithm/00-TASK.txt
Normal file
28
Task/Floyd-Warshall-algorithm/00-TASK.txt
Normal file
|
|
@ -0,0 +1,28 @@
|
|||
The [[wp:Floyd–Warshall_algorithm|Floyd–Warshall algorithm]] is an algorithm for finding shortest paths in a weighted graph with positive or negative edge weights.
|
||||
<br><br>
|
||||
;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.
|
||||
|
||||
[[File:Floyd_warshall_graph.gif|||center]]
|
||||
|
||||
Print the pair, the distance and (optionally) the path.
|
||||
<br><br>
|
||||
;Example
|
||||
<pre>pair dist path
|
||||
1 -> 2 -1 1 -> 3 -> 4 -> 2
|
||||
1 -> 3 -2 1 -> 3
|
||||
1 -> 4 0 1 -> 3 -> 4
|
||||
2 -> 1 4 2 -> 1
|
||||
2 -> 3 2 2 -> 1 -> 3
|
||||
2 -> 4 4 2 -> 1 -> 3 -> 4
|
||||
3 -> 1 5 3 -> 4 -> 2 -> 1
|
||||
3 -> 2 1 3 -> 4 -> 2
|
||||
3 -> 4 2 3 -> 4
|
||||
4 -> 1 3 4 -> 2 -> 1
|
||||
4 -> 2 -1 4 -> 2
|
||||
4 -> 3 1 4 -> 2 -> 1 -> 3</pre>
|
||||
<br><br>
|
||||
;See also
|
||||
* [https://www.youtube.com/watch?v=8WSZQwNtXPU Floyd-Warshall Algorithm - step by step guide (youtube)]
|
||||
<br><br>
|
||||
|
||||
|
|
@ -0,0 +1,23 @@
|
|||
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)])
|
||||
|
|
@ -0,0 +1,76 @@
|
|||
* 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
|
||||
293
Task/Floyd-Warshall-algorithm/ATS/floyd-warshall-algorithm-1.ats
Normal file
293
Task/Floyd-Warshall-algorithm/ATS/floyd-warshall-algorithm-1.ats
Normal file
|
|
@ -0,0 +1,293 @@
|
|||
(*
|
||||
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
|
||||
543
Task/Floyd-Warshall-algorithm/ATS/floyd-warshall-algorithm-2.ats
Normal file
543
Task/Floyd-Warshall-algorithm/ATS/floyd-warshall-algorithm-2.ats
Normal file
|
|
@ -0,0 +1,543 @@
|
|||
(*
|
||||
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
|
||||
|
||||
(*------------------------------------------------------------------*)
|
||||
183
Task/Floyd-Warshall-algorithm/Ada/floyd-warshall-algorithm.ada
Normal file
183
Task/Floyd-Warshall-algorithm/Ada/floyd-warshall-algorithm.ada
Normal file
|
|
@ -0,0 +1,183 @@
|
|||
--
|
||||
-- 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;
|
||||
|
|
@ -0,0 +1,74 @@
|
|||
#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;
|
||||
}
|
||||
|
|
@ -0,0 +1,65 @@
|
|||
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);
|
||||
}
|
||||
}
|
||||
}
|
||||
75
Task/Floyd-Warshall-algorithm/C/floyd-warshall-algorithm-1.c
Normal file
75
Task/Floyd-Warshall-algorithm/C/floyd-warshall-algorithm-1.c
Normal file
|
|
@ -0,0 +1,75 @@
|
|||
#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;
|
||||
}
|
||||
121
Task/Floyd-Warshall-algorithm/C/floyd-warshall-algorithm-2.c
Normal file
121
Task/Floyd-Warshall-algorithm/C/floyd-warshall-algorithm-2.c
Normal file
|
|
@ -0,0 +1,121 @@
|
|||
#include <limits.h>
|
||||
#include <gadget/gadget.h>
|
||||
|
||||
LIB_GADGET_START
|
||||
|
||||
/* algunos datos globales */
|
||||
int vertices,edges;
|
||||
|
||||
/* algunos prototipos */
|
||||
F_STAT DatosdeArchivo( const char *cFile);
|
||||
int * CargaMatriz(int * mat, DS_ARRAY * mat_data, const char * cFile, F_STAT stat );
|
||||
int * CargaGrafo(int * graph, DS_ARRAY * graph_data, const char *cFile);
|
||||
void Floyd_Warshall(int * graph, DS_ARRAY graph_data);
|
||||
|
||||
/* bloque principal */
|
||||
Main
|
||||
if ( Arg_count != 2 ){
|
||||
Msg_yellow("Modo de uso:\n ./floyd <archivo_de_vertices>\n");
|
||||
Stop(1);
|
||||
}
|
||||
Get_arg_str (cFile,1);
|
||||
Set_token_sep(' ');
|
||||
Cls;
|
||||
if(Exist_file(cFile)){
|
||||
New array graph as int;
|
||||
graph = CargaGrafo( pSDS(graph), cFile);
|
||||
if(graph){
|
||||
/* calcula Floyd-Warshall */
|
||||
Print "Vertices=%d, edges=%d\n",vertices,edges;
|
||||
|
||||
Floyd_Warshall( SDS(graph) ); Prnl;
|
||||
|
||||
Free array graph;
|
||||
}
|
||||
|
||||
}else{
|
||||
Msg_redf("No existe el archivo %s",cFile);
|
||||
}
|
||||
Free secure cFile;
|
||||
End
|
||||
|
||||
void Floyd_Warshall( RDS(int,graph) ){
|
||||
|
||||
Array processedVertices as int(vertices,vertices);
|
||||
Fill array processWeights as int(vertices,vertices) with SHRT_MAX;
|
||||
|
||||
int i,j,k;
|
||||
Range for processWeights [0:1:vertices, 0:1:vertices ];
|
||||
|
||||
Compute_for( processWeights, i,j,
|
||||
$processedVertices[i,j] = (i!=j)?j+1:0;
|
||||
)
|
||||
|
||||
#define VERT_ORIG 0
|
||||
#define VERT_DEST 1
|
||||
#define WEIGHT 2
|
||||
|
||||
Iterator up i [0:1:edges] {
|
||||
$2processWeights[ $graph[i,VERT_ORIG]-1, $graph[i,VERT_DEST]-1 ] = $graph[i,WEIGHT];
|
||||
}
|
||||
|
||||
Compute_for (processWeights,i,j,
|
||||
Iterator up k [0:1:vertices] {
|
||||
if( $processWeights[j,i] + $processWeights[i,k] < $processWeights[j,k] )
|
||||
{
|
||||
$processWeights[j,k] = $processWeights[j,i] + $processWeights[i,k];
|
||||
$processedVertices[j,k] = $processedVertices[j,i];
|
||||
}
|
||||
} );
|
||||
|
||||
Print "pair dist path";
|
||||
|
||||
// ya existen rangos definios para "processWeights":
|
||||
Compute_for(processWeights, i, j,
|
||||
if(i!=j)
|
||||
{
|
||||
Print "\n%d -> %d %3d %5d", i+1, j+1, $processWeights[i,j], i+1;
|
||||
int k = i+1;
|
||||
do{
|
||||
k = $processedVertices[k-1,j];
|
||||
Print " -> %d", k;
|
||||
}while(k!=j+1);
|
||||
}
|
||||
);
|
||||
|
||||
Free array processWeights, processedVertices;
|
||||
}
|
||||
|
||||
F_STAT DatosdeArchivo( const char *cFile){
|
||||
return Stat_file(cFile);
|
||||
}
|
||||
|
||||
int * CargaMatriz( pRDS(int, mat), const char * cFile, F_STAT stat ){
|
||||
return Load_matrix( SDS(mat), cFile, stat);
|
||||
}
|
||||
|
||||
int * CargaGrafo( pRDS(int, graph), const char *cFile){
|
||||
|
||||
F_STAT dataFile = DatosdeArchivo(cFile);
|
||||
if(dataFile.is_matrix){
|
||||
|
||||
Range ptr graph [0:1:dataFile.total_lines-1, 0:1:dataFile.max_tokens_per_line-1];
|
||||
|
||||
graph = CargaMatriz( SDS(graph), cFile, dataFile);
|
||||
|
||||
if( graph ){
|
||||
/* obtengo vertices = 4 y edges = 5 */
|
||||
edges = dataFile.total_lines;
|
||||
|
||||
Block( vertices, Range ptr graph [ 0:1:pRows(graph), 0:1:1 ];
|
||||
DS_MAXMIN maxNode = Max_array( SDS(graph) );
|
||||
Out_int( $graph[maxNode.local] ) );
|
||||
}else{
|
||||
Msg_redf("Archivo \"%s\" no ha podido ser cargado",cFile);
|
||||
}
|
||||
|
||||
}else{
|
||||
Msg_redf("Archivo \"%s\" no es cuadrado",cFile);
|
||||
}
|
||||
return graph;
|
||||
}
|
||||
|
|
@ -0,0 +1,186 @@
|
|||
#!/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:
|
||||
70
Task/Floyd-Warshall-algorithm/D/floyd-warshall-algorithm.d
Normal file
70
Task/Floyd-Warshall-algorithm/D/floyd-warshall-algorithm.d
Normal file
|
|
@ -0,0 +1,70 @@
|
|||
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);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -0,0 +1,41 @@
|
|||
(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))
|
||||
|
|
@ -0,0 +1,44 @@
|
|||
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)
|
||||
|
|
@ -0,0 +1,15 @@
|
|||
//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}))
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
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))))
|
||||
153
Task/Floyd-Warshall-algorithm/Fortran/floyd-warshall-algorithm.f
Normal file
153
Task/Floyd-Warshall-algorithm/Fortran/floyd-warshall-algorithm.f
Normal file
|
|
@ -0,0 +1,153 @@
|
|||
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
|
||||
|
|
@ -0,0 +1,62 @@
|
|||
' 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
|
||||
113
Task/Floyd-Warshall-algorithm/Go/floyd-warshall-algorithm.go
Normal file
113
Task/Floyd-Warshall-algorithm/Go/floyd-warshall-algorithm.go
Normal file
|
|
@ -0,0 +1,113 @@
|
|||
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)))
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -0,0 +1,61 @@
|
|||
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)
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
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)
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
data Shortest b a = Shortest { distance :: a, path :: [b] }
|
||||
deriving Show
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
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 }
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
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
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
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]
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
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)
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
g = fromList [((2,1), 4)
|
||||
,((2,3), 3)
|
||||
,((1,3), -2)
|
||||
,((3,4), 2)
|
||||
,((4,2), -1)]
|
||||
|
|
@ -0,0 +1 @@
|
|||
showShortestPaths v g = mapM_ print $ toList $ findMinDistances v g
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
g2 = fromList [(('A','S'), 1)
|
||||
,(('A','D'), -1)
|
||||
,(('S','E'), 2)
|
||||
,(('D','E'), 4)]
|
||||
117
Task/Floyd-Warshall-algorithm/Icon/floyd-warshall-algorithm.icon
Normal file
117
Task/Floyd-Warshall-algorithm/Icon/floyd-warshall-algorithm.icon
Normal file
|
|
@ -0,0 +1,117 @@
|
|||
#
|
||||
# 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
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
floyd=: verb define
|
||||
for_j. i.#y do.
|
||||
y=. y <. j ({"1 +/ {) y
|
||||
end.
|
||||
)
|
||||
12
Task/Floyd-Warshall-algorithm/J/floyd-warshall-algorithm-2.j
Normal file
12
Task/Floyd-Warshall-algorithm/J/floyd-warshall-algorithm-2.j
Normal file
|
|
@ -0,0 +1,12 @@
|
|||
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
|
||||
33
Task/Floyd-Warshall-algorithm/J/floyd-warshall-algorithm-3.j
Normal file
33
Task/Floyd-Warshall-algorithm/J/floyd-warshall-algorithm-3.j
Normal file
|
|
@ -0,0 +1,33 @@
|
|||
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
|
||||
)
|
||||
14
Task/Floyd-Warshall-algorithm/J/floyd-warshall-algorithm-4.j
Normal file
14
Task/Floyd-Warshall-algorithm/J/floyd-warshall-algorithm-4.j
Normal file
|
|
@ -0,0 +1,14 @@
|
|||
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
|
||||
|
|
@ -0,0 +1,58 @@
|
|||
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);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -0,0 +1,21 @@
|
|||
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);
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
def weights: {
|
||||
"1": {"3": -2},
|
||||
"2": {"1" : 4, "3": 3},
|
||||
"3": {"4": 2},
|
||||
"4": {"2": -1}
|
||||
};
|
||||
|
|
@ -0,0 +1,21 @@
|
|||
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
|
||||
|
|
@ -0,0 +1,38 @@
|
|||
# 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)
|
||||
|
|
@ -0,0 +1,58 @@
|
|||
// 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)
|
||||
}
|
||||
|
|
@ -0,0 +1,65 @@
|
|||
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)
|
||||
|
|
@ -0,0 +1,12 @@
|
|||
g = Graph[{1 \[DirectedEdge] 3, 3 \[DirectedEdge] 4,
|
||||
4 \[DirectedEdge] 2, 2 \[DirectedEdge] 1, 2 \[DirectedEdge] 3},
|
||||
EdgeWeight -> {(1 \[DirectedEdge] 3) -> -2, (3 \[DirectedEdge] 4) ->
|
||||
2, (4 \[DirectedEdge] 2) -> -1, (2 \[DirectedEdge] 1) ->
|
||||
4, (2 \[DirectedEdge] 3) -> 3}]
|
||||
vl = VertexList[g];
|
||||
dm = GraphDistanceMatrix[g];
|
||||
Grid[LexicographicSort[
|
||||
DeleteCases[
|
||||
Catenate[
|
||||
Table[{vl[[i]], vl[[j]], dm[[i, j]]}, {i, Length[vl]}, {j,
|
||||
Length[vl]}]], {x_, x_, _}]]]
|
||||
|
|
@ -0,0 +1,206 @@
|
|||
:- 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:
|
||||
|
|
@ -0,0 +1,85 @@
|
|||
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.
|
||||
|
|
@ -0,0 +1,55 @@
|
|||
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)
|
||||
|
|
@ -0,0 +1,210 @@
|
|||
(*
|
||||
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
|
||||
;;
|
||||
|
|
@ -0,0 +1,117 @@
|
|||
#
|
||||
# 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
|
||||
|
|
@ -0,0 +1,23 @@
|
|||
<?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);
|
||||
?>
|
||||
|
|
@ -0,0 +1,50 @@
|
|||
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);
|
||||
|
|
@ -0,0 +1,49 @@
|
|||
(phixonline)-->
|
||||
<span style="color: #008080;">constant</span> <span style="color: #000000;">inf</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">1e300</span><span style="color: #0000FF;">*</span><span style="color: #000000;">1e300</span>
|
||||
|
||||
<span style="color: #008080;">function</span> <span style="color: #000000;">Path</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">u</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">v</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">sequence</span> <span style="color: #000000;">next</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">if</span> <span style="color: #000000;">next</span><span style="color: #0000FF;">[</span><span style="color: #000000;">u</span><span style="color: #0000FF;">,</span><span style="color: #000000;">v</span><span style="color: #0000FF;">]=</span><span style="color: #004600;">null</span> <span style="color: #008080;">then</span>
|
||||
<span style="color: #008080;">return</span> <span style="color: #008000;">""</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
|
||||
<span style="color: #004080;">sequence</span> <span style="color: #000000;">path</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #7060A8;">sprintf</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"%d"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">u</span><span style="color: #0000FF;">)}</span>
|
||||
<span style="color: #008080;">while</span> <span style="color: #000000;">u</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">v</span> <span style="color: #008080;">do</span>
|
||||
<span style="color: #000000;">u</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">next</span><span style="color: #0000FF;">[</span><span style="color: #000000;">u</span><span style="color: #0000FF;">,</span><span style="color: #000000;">v</span><span style="color: #0000FF;">]</span>
|
||||
<span style="color: #000000;">path</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">path</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">sprintf</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"%d"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">u</span><span style="color: #0000FF;">))</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
|
||||
<span style="color: #008080;">return</span> <span style="color: #7060A8;">join</span><span style="color: #0000FF;">(</span><span style="color: #000000;">path</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"->"</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
|
||||
|
||||
<span style="color: #008080;">procedure</span> <span style="color: #000000;">FloydWarshall</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">V</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">sequence</span> <span style="color: #000000;">weights</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #004080;">sequence</span> <span style="color: #000000;">dist</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #000000;">inf</span><span style="color: #0000FF;">,</span><span style="color: #000000;">V</span><span style="color: #0000FF;">),</span><span style="color: #000000;">V</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #004080;">sequence</span> <span style="color: #000000;">next</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #004600;">null</span><span style="color: #0000FF;">,</span><span style="color: #000000;">V</span><span style="color: #0000FF;">),</span><span style="color: #000000;">V</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">for</span> <span style="color: #000000;">k</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">weights</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
|
||||
<span style="color: #004080;">integer</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">u</span><span style="color: #0000FF;">,</span><span style="color: #000000;">v</span><span style="color: #0000FF;">,</span><span style="color: #000000;">w</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">weights</span><span style="color: #0000FF;">[</span><span style="color: #000000;">k</span><span style="color: #0000FF;">]</span>
|
||||
<span style="color: #000000;">dist</span><span style="color: #0000FF;">[</span><span style="color: #000000;">u</span><span style="color: #0000FF;">,</span><span style="color: #000000;">v</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">:=</span> <span style="color: #000000;">w</span> <span style="color: #000080;font-style:italic;">-- the weight of the edge (u,v)</span>
|
||||
<span style="color: #000000;">next</span><span style="color: #0000FF;">[</span><span style="color: #000000;">u</span><span style="color: #0000FF;">,</span><span style="color: #000000;">v</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">:=</span> <span style="color: #000000;">v</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
|
||||
<span style="color: #000080;font-style:italic;">-- standard Floyd-Warshall implementation</span>
|
||||
<span style="color: #008080;">for</span> <span style="color: #000000;">k</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">V</span> <span style="color: #008080;">do</span>
|
||||
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">V</span> <span style="color: #008080;">do</span>
|
||||
<span style="color: #008080;">for</span> <span style="color: #000000;">j</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">V</span> <span style="color: #008080;">do</span>
|
||||
<span style="color: #004080;">atom</span> <span style="color: #000000;">d</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">dist</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">,</span><span style="color: #000000;">k</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">+</span> <span style="color: #000000;">dist</span><span style="color: #0000FF;">[</span><span style="color: #000000;">k</span><span style="color: #0000FF;">,</span><span style="color: #000000;">j</span><span style="color: #0000FF;">]</span>
|
||||
<span style="color: #008080;">if</span> <span style="color: #000000;">dist</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">,</span><span style="color: #000000;">j</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">></span> <span style="color: #000000;">d</span> <span style="color: #008080;">then</span>
|
||||
<span style="color: #000000;">dist</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">,</span><span style="color: #000000;">j</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">:=</span> <span style="color: #000000;">d</span>
|
||||
<span style="color: #000000;">next</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">,</span><span style="color: #000000;">j</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">:=</span> <span style="color: #000000;">next</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">,</span><span style="color: #000000;">k</span><span style="color: #0000FF;">]</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
|
||||
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"pair dist path\n"</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">for</span> <span style="color: #000000;">u</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">V</span> <span style="color: #008080;">do</span>
|
||||
<span style="color: #008080;">for</span> <span style="color: #000000;">v</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">V</span> <span style="color: #008080;">do</span>
|
||||
<span style="color: #008080;">if</span> <span style="color: #000000;">u</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">v</span> <span style="color: #008080;">then</span>
|
||||
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%d->%d %2d %s\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">u</span><span style="color: #0000FF;">,</span><span style="color: #000000;">v</span><span style="color: #0000FF;">,</span><span style="color: #000000;">dist</span><span style="color: #0000FF;">[</span><span style="color: #000000;">u</span><span style="color: #0000FF;">,</span><span style="color: #000000;">v</span><span style="color: #0000FF;">],</span><span style="color: #000000;">Path</span><span style="color: #0000FF;">(</span><span style="color: #000000;">u</span><span style="color: #0000FF;">,</span><span style="color: #000000;">v</span><span style="color: #0000FF;">,</span><span style="color: #000000;">next</span><span style="color: #0000FF;">)})</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
|
||||
|
||||
<span style="color: #008080;">constant</span> <span style="color: #000000;">V</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">4</span>
|
||||
<span style="color: #008080;">constant</span> <span style="color: #000000;">weights</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{{</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">3</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">2</span><span style="color: #0000FF;">},</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">2</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">4</span><span style="color: #0000FF;">},</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">2</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">3</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">3</span><span style="color: #0000FF;">},</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">3</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">4</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">2</span><span style="color: #0000FF;">},</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">4</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">2</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">}}</span>
|
||||
<span style="color: #000000;">FloydWarshall</span><span style="color: #0000FF;">(</span><span style="color: #000000;">V</span><span style="color: #0000FF;">,</span><span style="color: #000000;">weights</span><span style="color: #0000FF;">)</span>
|
||||
<!--
|
||||
|
|
@ -0,0 +1,27 @@
|
|||
:- 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]))).
|
||||
|
|
@ -0,0 +1,29 @@
|
|||
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]])
|
||||
|
|
@ -0,0 +1,254 @@
|
|||
#
|
||||
# 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
|
||||
|
|
@ -0,0 +1,26 @@
|
|||
/*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. */
|
||||
|
|
@ -0,0 +1,76 @@
|
|||
#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))
|
||||
|
|
@ -0,0 +1,27 @@
|
|||
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]]);
|
||||
|
|
@ -0,0 +1,35 @@
|
|||
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)
|
||||
213
Task/Floyd-Warshall-algorithm/Rust/floyd-warshall-algorithm.rust
Normal file
213
Task/Floyd-Warshall-algorithm/Rust/floyd-warshall-algorithm.rust
Normal file
|
|
@ -0,0 +1,213 @@
|
|||
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);
|
||||
}
|
||||
138
Task/Floyd-Warshall-algorithm/Scheme/floyd-warshall-algorithm.ss
Normal file
138
Task/Floyd-Warshall-algorithm/Scheme/floyd-warshall-algorithm.ss
Normal file
|
|
@ -0,0 +1,138 @@
|
|||
;;; Floyd-Warshall algorithm.
|
||||
;;;
|
||||
;;; See https://en.wikipedia.org/w/index.php?title=Floyd%E2%80%93Warshall_algorithm&oldid=1082310013
|
||||
;;;
|
||||
|
||||
(import (scheme base))
|
||||
(import (scheme cxr))
|
||||
(import (scheme write))
|
||||
|
||||
;;;
|
||||
;;; A square array will be represented by a cons-pair:
|
||||
;;;
|
||||
;;; (vector-of-length n-squared . n)
|
||||
;;;
|
||||
;;; Arrays are indexed *starting at one*.
|
||||
;;;
|
||||
|
||||
(define (make-arr n fill)
|
||||
(cons (make-vector (* n n) fill) n))
|
||||
|
||||
(define (arr-set! arr i j x)
|
||||
(let ((vec (car arr))
|
||||
(n (cdr arr)))
|
||||
(vector-set! vec (+ (- i 1) (* n (- j 1))) x)))
|
||||
|
||||
(define (arr-ref arr i j)
|
||||
(let ((vec (car arr))
|
||||
(n (cdr arr)))
|
||||
(vector-ref vec (+ (- i 1) (* n (- j 1))))))
|
||||
|
||||
;;;
|
||||
;;; Floyd-Warshall.
|
||||
;;;
|
||||
;;; Input is a list of length-3 lists representing edges; each entry
|
||||
;;; is:
|
||||
;;;
|
||||
;;; (start-vertex edge-weight end-vertex)
|
||||
;;;
|
||||
;;; where vertex identifiers are (to help keep this example brief)
|
||||
;;; integers from 1 .. n.
|
||||
;;;
|
||||
|
||||
(define (floyd-warshall edges)
|
||||
|
||||
(define n
|
||||
;; Set n to the maximum vertex number. By design, n also equals
|
||||
;; the number of vertices.
|
||||
(max (apply max (map car edges))
|
||||
(apply max (map caddr edges))))
|
||||
|
||||
(define distance (make-arr n +inf.0))
|
||||
(define next-vertex (make-arr n #f))
|
||||
|
||||
;; Initialize "distance" and "next-vertex".
|
||||
(for-each (lambda (edge)
|
||||
(let ((u (car edge))
|
||||
(weight (cadr edge))
|
||||
(v (caddr edge)))
|
||||
(arr-set! distance u v weight)
|
||||
(arr-set! next-vertex u v v)))
|
||||
edges)
|
||||
(do ((v 1 (+ v 1)))
|
||||
((< n v))
|
||||
(arr-set! distance v v 0)
|
||||
(arr-set! next-vertex v v v))
|
||||
|
||||
;; Perform the algorithm.
|
||||
(do ((k 1 (+ k 1)))
|
||||
((< n k))
|
||||
(do ((i 1 (+ i 1)))
|
||||
((< n i))
|
||||
(do ((j 1 (+ j 1)))
|
||||
((< n j))
|
||||
(let ((dist-ij (arr-ref distance i j))
|
||||
(dist-ik (arr-ref distance i k))
|
||||
(dist-kj (arr-ref distance k j)))
|
||||
(let ((dist-ik+dist-kj (+ dist-ik dist-kj)))
|
||||
(when (< dist-ik+dist-kj dist-ij)
|
||||
(arr-set! distance i j dist-ik+dist-kj)
|
||||
(arr-set! next-vertex i j
|
||||
(arr-ref next-vertex i k))))))))
|
||||
|
||||
;; Return the results.
|
||||
(values n distance next-vertex))
|
||||
|
||||
;;;
|
||||
;;; Path reconstruction from the "next-vertex" array.
|
||||
;;;
|
||||
;;; The return value is a list of vertices.
|
||||
;;;
|
||||
|
||||
(define (find-path next-vertex u v)
|
||||
(if (not (arr-ref next-vertex u v))
|
||||
(list)
|
||||
(let loop ((u u)
|
||||
(path (list u)))
|
||||
(if (= u v)
|
||||
(reverse path)
|
||||
(let ((u^ (arr-ref next-vertex u v)))
|
||||
(loop u^ (cons u^ path)))))))
|
||||
|
||||
(define (display-path path)
|
||||
(let loop ((p path))
|
||||
(cond ((null? p))
|
||||
((null? (cdr p)) (display (car p)))
|
||||
(else (display (car p))
|
||||
(display " -> ")
|
||||
(loop (cdr p))))))
|
||||
|
||||
(define example-graph
|
||||
'((1 -2 3)
|
||||
(3 2 4)
|
||||
(4 -1 2)
|
||||
(2 4 1)
|
||||
(2 3 3)))
|
||||
|
||||
(let-values (((n distance next-vertex)
|
||||
(floyd-warshall example-graph)))
|
||||
(display " pair distance path")
|
||||
(newline)
|
||||
(display "------------------------------------")
|
||||
(newline)
|
||||
(do ((u 1 (+ u 1)))
|
||||
((< n u))
|
||||
(do ((v 1 (+ v 1)))
|
||||
((< n v))
|
||||
(unless (= u v)
|
||||
(display u)
|
||||
(display " -> ")
|
||||
(display v)
|
||||
(let* ((s (number->string (arr-ref distance u v)))
|
||||
(slen (string-length s))
|
||||
(padding (- 7 slen)))
|
||||
(display (make-string padding #\space))
|
||||
(display s))
|
||||
(display " ")
|
||||
(display-path (find-path next-vertex u v))
|
||||
(newline)))))
|
||||
|
|
@ -0,0 +1,57 @@
|
|||
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);
|
||||
|
|
@ -0,0 +1,33 @@
|
|||
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)
|
||||
|
|
@ -0,0 +1,326 @@
|
|||
(*
|
||||
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: *)
|
||||
|
|
@ -0,0 +1,31 @@
|
|||
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
|
||||
|
|
@ -0,0 +1,63 @@
|
|||
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
|
||||
|
|
@ -0,0 +1,50 @@
|
|||
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)
|
||||
|
|
@ -0,0 +1,22 @@
|
|||
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()) }
|
||||
|
|
@ -0,0 +1,21 @@
|
|||
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();
|
||||
}
|
||||
Loading…
Add table
Add a link
Reference in a new issue