Floyd-Warshall algorithm: Difference between revisions
→{{header|REXX}}
Line 2,837:
4 → 3 1 4 → 2 → 1 → 3
</pre>
=={{header|RATFOR}}==
{{trans|Fortran}}
{{works with|ratfor77|[https://sourceforge.net/p/chemoelectric/ratfor77/ public domain 1.0]}}
{{works with|gfortran|11.3.0}}
{{works with|f2c|20100827}}
<lang ratfor>#
# Floyd-Warshall algorithm.
#
# See https://en.wikipedia.org/w/index.php?title=Floyd%E2%80%93Warshall_algorithm&oldid=1082310013
#
#
# A C programmer might take note that the most rapid stride in an
# array is on the *leftmost* index, rather than the *rightmost* as in
# C.
#
# (In other words, Fortran has "column-major order", whereas C has
# "row-major order". I prefer to think of it in terms of strides. For
# one thing, in my opinion, which index is for a "column" and which
# for a "row" should be considered arbitrary unless dictated by
# context.)
#
# VLIMIT = the maximum number of vertices the program can handle.
define(VLIMIT, 100)
# NILVTX = the nil vertex.
define(NILVTX, 0)
# STRSZ = a buffer size used in some character-handling routines.
define(STRSZ, 300)
# BUFSZ = a buffer size used in some character-handling routines.
define(BUFSZ, 20)
function maxvtx (numedg, edges)
# Find the maximum vertex number.
implicit none
integer numedg
real edges(1:3, 1:numedg) # Notice Fortran's column-major order!
integer maxvtx
integer n, i
n = 1
for (i = 1; i <= numedg; i = i + 1)
{
n = max (n, int (edges(1, i)))
n = max (n, int (edges(3, i)))
}
maxvtx = n
end
subroutine floyd (numedg, edges, n, dist, nxtvtx)
# Floyd-Warshall.
implicit none
integer numedg
real edges(1:3, 1:numedg) # Notice Fortran's column-major order!
integer n
real dist(1:VLIMIT, 1:VLIMIT)
integer nxtvtx(1:VLIMIT, 1:VLIMIT)
#
# This implementation does NOT initialize elements of "dist" that
# would be set "infinite" in the original Fortran 90. Such elements
# are left uninitialized. Instead you should use the "nxtvtx" array
# to determine whether there exists a finite path from one vertex to
# another.
#
# See also the Icon and Object Icon implementations that use "&null"
# as a stand-in for "infinity". This implementation is similar to
# those. In this Ratfor, the nil entry in "nxtvtx" is used instead
# of one in "dist".
#
integer i, j, k
integer u, v
real dstikj
# Initialization.
for (i = 1; i <= n; i = i + 1)
for (j = 1; j <= n; j = j + 1)
nxtvtx(i, j) = NILVTX
for (i = 1; i <= numedg; i = i + 1)
{
u = int (edges(1, i))
v = int (edges(3, i))
dist(u, v) = edges(2, i)
nxtvtx(u, v) = v
}
for (i = 1; i <= n; i = i + 1)
{
dist(i, i) = 0.0 # Distance from a vertex to itself.
nxtvtx(i, i) = i
}
# Perform the algorithm.
for (k = 1; k <= n; k = k + 1)
for (i = 1; i <= n; i = i + 1)
for (j = 1; j <= n; j = j + 1)
if (nxtvtx(i, k) != NILVTX && nxtvtx(k, j) != NILVTX)
{
dstikj = dist(i, k) + dist(k, j)
if (nxtvtx(i, j) == NILVTX)
{
dist(i, j) = dstikj
nxtvtx(i, j) = nxtvtx(i, k)
}
else if (dstikj < dist(i, j))
{
dist(i, j) = dstikj
nxtvtx(i, j) = nxtvtx(i, k)
}
}
end
subroutine cpy (chr, str, j)
# A helper subroutine for pthstr.
implicit none
character*BUFSZ chr
character str*STRSZ
integer j
integer i
i = 1
while (chr(i:i) == ' ')
{
if (i == BUFSZ)
{
write (*, *) "character* boundary exceeded in cpy"
stop
}
i = i + 1
}
while (i <= BUFSZ)
{
if (STRSZ < j)
{
write (*, *) "character* boundary exceeded in cpy"
stop
}
str(j:j) = chr(i:i)
j = j + 1
i = i + 1
}
end
subroutine pthstr (nxtvtx, u, v, str, k)
# Construct a string for a path from u to v. Start at str(k).
implicit none
integer nxtvtx(1:VLIMIT, 1:VLIMIT)
integer u, v
character str*STRSZ
integer k
integer i, j
character*BUFSZ chr
character*25 fmt10
character*25 fmt20
write (fmt10, '(''(I'', I15, '')'')') BUFSZ - 1
write (fmt20, '(''(A'', I15, '')'')') BUFSZ
if (nxtvtx(u, v) != NILVTX)
{
j = k
i = u
chr = ' '
write (chr, fmt10) i
call cpy (chr, str, j)
while (i != v)
{
write (chr, fmt20) "-> "
call cpy (chr, str, j)
i = nxtvtx(i, v)
write (chr, fmt10) i
call cpy (chr, str, j)
}
}
end
function trimr (str)
# Find the length of a character*, if one ignores trailing spaces.
implicit none
character str*STRSZ
integer trimr
logical done
trimr = STRSZ
done = .false.
while (!done)
{
if (trimr == 0)
done = .true.
else if (str(trimr:trimr) != ' ')
done = .true.
else
trimr = trimr - 1
}
end
program demo
implicit none
integer maxvtx
integer trimr
integer exmpsz
real exampl(1:3, 1:5)
integer n
real dist(1:VLIMIT, 1:VLIMIT)
integer nxtvtx(1:VLIMIT, 1:VLIMIT)
character str*STRSZ
integer u, v
integer j
exmpsz = 5
data exampl / 1, -2.0, 3, _
3, +2.0, 4, _
4, -1.0, 2, _
2, +4.0, 1, _
2, +3.0, 3 /
n = maxvtx (exmpsz, exampl)
call floyd (exmpsz, exampl, n, dist, nxtvtx)
1000 format (I2, ' ->', I2, 5X, F4.1, 6X)
write (*, '('' pair distance path'')')
write (*, '(''---------------------------------------'')')
for (u = 1; u <= n; u = u + 1)
for (v = 1; v <= n; v = v + 1)
if (u != v)
{
str = ' '
write (str, 1000) u, v, dist(u, v)
call pthstr (nxtvtx, u, v, str, 23)
write (* , '(1000A1)') (str(j:j), j = 1, trimr (str))
}
end</lang>
{{out}}
I get slightly different output, depending on whether I use gfortran or f2c to compile the generated FORTRAN code. The two outputs differ in how 0.0 is printed.
First gfortran:
<pre>$ ratfor77 -6x floyd_warshall_task.r > floyd_warshall_task.f && gfortran -std=legacy floyd_warshall_task.f && ./a.out
pair distance path
---------------------------------------
1 -> 2 -1.0 1 -> 3 -> 4 -> 2
1 -> 3 -2.0 1 -> 3
1 -> 4 0.0 1 -> 3 -> 4
2 -> 1 4.0 2 -> 1
2 -> 3 2.0 2 -> 1 -> 3
2 -> 4 4.0 2 -> 1 -> 3 -> 4
3 -> 1 5.0 3 -> 4 -> 2 -> 1
3 -> 2 1.0 3 -> 4 -> 2
3 -> 4 2.0 3 -> 4
4 -> 1 3.0 4 -> 2 -> 1
4 -> 2 -1.0 4 -> 2
4 -> 3 1.0 4 -> 2 -> 1 -> 3</pre>
Now f2c:
<pre>$ ratfor77 -6x floyd_warshall_task.r > floyd_warshall_task.f && f2c floyd_warshall_task.f && cc floyd_warshall_task.c -lf2c && ./a.out
floyd_warshall_task.f:
maxvtx:
floyd:
cpy:
pthstr:
trimr:
MAIN demo:
pair distance path
---------------------------------------
1 -> 2 -1.0 1 -> 3 -> 4 -> 2
1 -> 3 -2.0 1 -> 3
1 -> 4 .0 1 -> 3 -> 4
2 -> 1 4.0 2 -> 1
2 -> 3 2.0 2 -> 1 -> 3
2 -> 4 4.0 2 -> 1 -> 3 -> 4
3 -> 1 5.0 3 -> 4 -> 2 -> 1
3 -> 2 1.0 3 -> 4 -> 2
3 -> 4 2.0 3 -> 4
4 -> 1 3.0 4 -> 2 -> 1
4 -> 2 -1.0 4 -> 2
4 -> 3 1.0 4 -> 2 -> 1 -> 3</pre>
=={{header|REXX}}==
| |||