Simulated annealing: Difference between revisions
→{{header|Scheme}}
Line 2,643:
28 38 48 49 39 29 19 9 8 7 6 5 4 14 13 12 11 2 3 1
0</pre>
=={{header|RATFOR}}==
{{trans|Fortran}}
{{works with|ratfor77|[https://sourceforge.net/p/chemoelectric/ratfor77/ public domain 1.0]}}
{{works with|gfortran|11.3.0}}
<lang ratfor>#
# The Rosetta Code simulated annealing task, in Ratfor 77.
#
# This implementation uses the RANDOM_NUMBER intrinsic and therefore
# will not work with f2c. It will work with gfortran. (One could
# substitute a random number generator from the Fullerton Function
# Library, or from elsewhere.)
#
function rndint (imin, imax)
implicit none
integer imin, imax, rndint
real rndnum
call random_number (rndnum)
rndint = imin + floor ((imax - imin + 1) * rndnum)
end
function icoord (loc)
implicit none
integer loc, icoord
icoord = loc / 10
end
function jcoord (loc)
implicit none
integer loc, jcoord
jcoord = mod (loc, 10)
end
function locatn (i, j) # Location.
implicit none
integer i, j, locatn
locatn = (10 * i) + j
end
subroutine rndpth (path) # Randomize a path.
implicit none
integer path(0:99)
integer rndint
integer i, j, xi, xj
for (i = 0; i <= 99; i = i + 1)
path(i) = i
# Fisher-Yates shuffle of elements 1 .. 99.
for (i = 1; i <= 98; i = i + 1)
{
j = rndint (i + 1, 99)
xi = path(i)
xj = path(j)
path(i) = xj
path(j) = xi
}
end
function dstnce (loc1, loc2) # Distance.
implicit none
integer loc1, loc2
real dstnce
integer icoord, jcoord
integer i1, j1
integer i2, j2
integer di, dj
i1 = icoord (loc1)
j1 = jcoord (loc1)
i2 = icoord (loc2)
j2 = jcoord (loc2)
di = i1 - i2
dj = j1 - j2
dstnce = sqrt (real ((di * di) + (dj * dj)))
end
function pthlen (path) # Path length.
implicit none
integer path(0:99)
real pthlen
real dstnce
real len
integer i
len = dstnce (path(0), path(99))
for (i = 0; i <= 98; i = i + 1)
len = len + dstnce (path(i), path(i + 1))
pthlen = len
end
subroutine addnbr (nbrs, numnbr, nbr) # Add neighbor.
implicit none
integer nbrs(1:8)
integer numnbr
integer nbr
if (nbr != 0)
{
numnbr = numnbr + 1
nbrs(numnbr) = nbr
}
end
subroutine fndnbr (loc, nbrs, numnbr) # Find neighbors.
implicit none
integer loc
integer nbrs(1:8)
integer numnbr
integer icoord, jcoord
integer locatn
integer i, j
integer c1, c2, c3, c4, c5, c6, c7, c8
c1 = 0
c2 = 0
c3 = 0
c4 = 0
c5 = 0
c6 = 0
c7 = 0
c8 = 0
i = icoord (loc)
j = jcoord (loc)
if (i < 9)
{
c1 = locatn (i + 1, j)
if (j < 9)
c2 = locatn (i + 1, j + 1)
if (0 < j)
c3 = locatn (i + 1, j - 1)
}
if (0 < i)
{
c4 = locatn (i - 1, j)
if (j < 9)
c5 = locatn (i - 1, j + 1)
if (0 < j)
c6 = locatn (i - 1, j - 1)
}
if (j < 9)
c7 = locatn (i, j + 1)
if (0 < j)
c8 = locatn (i, j - 1)
numnbr = 0
call addnbr (nbrs, numnbr, c1)
call addnbr (nbrs, numnbr, c2)
call addnbr (nbrs, numnbr, c3)
call addnbr (nbrs, numnbr, c4)
call addnbr (nbrs, numnbr, c5)
call addnbr (nbrs, numnbr, c6)
call addnbr (nbrs, numnbr, c7)
call addnbr (nbrs, numnbr, c8)
end
subroutine nbrpth (path, nbrp) # Make a neighbor path.
implicit none
integer path(0:99), nbrp(0:99)
integer rndint
integer u, v
integer nbrs(1:8)
integer numnbr
integer j, iu, iv
for (j = 0; j <= 99; j = j + 1)
nbrp(j) = path(j)
u = rndint (1, 99)
call fndnbr (u, nbrs, numnbr)
v = nbrs(rndint (1, numnbr))
j = 1
iu = 0
iv = 0
while (iu == 0 || iv == 0)
{
if (nbrp(j) == u)
iu = j
else if (nbrp(j) == v)
iv = j
j = j + 1
}
nbrp(iu) = v
nbrp(iv) = u
end
function temp (kT, kmax, k) # Temperature.
implicit none
real kT
integer kmax, k
real temp
real kf, kmaxf
kf = real (k)
kmaxf = real (kmax)
temp = kT * (1.0 - (kf / kmaxf))
end
function prob (deltaE, T) # Probability.
implicit none
real deltaE, T, prob
real x
if (T == 0.0)
prob = 0.0
else
{
x = -(deltaE / T)
if (x < -80)
prob = 0 # Avoid underflow.
else
prob = exp (-(deltaE / T))
}
end
subroutine show (k, T, E)
implicit none
integer k
real T, E
10 format (1X, I7, 1X, F7.1, 1X, F10.2)
write (*, 10) k, T, E
end
subroutine dsplay (path)
implicit none
integer path(0:99)
100 format (8(I2, ' -> '))
write (*, 100) path
end
subroutine sa (kT, kmax, path)
implicit none
real kT
integer kmax
integer path(0:99)
real pthlen
real temp, prob
integer kshow
integer k
integer j
real E, Etrial, T
integer trial(0:99)
real rndnum
kshow = kmax / 10
E = pthlen (path)
for (k = 0; k <= kmax; k = k + 1)
{
T = temp (kT, kmax, k)
if (mod (k, kshow) == 0)
call show (k, T, E)
call nbrpth (path, trial)
Etrial = pthlen (trial)
if (Etrial <= E)
{
for (j = 0; j <= 99; j = j + 1)
path(j) = trial(j)
E = Etrial
}
else
{
call random_number (rndnum)
if (rndnum <= prob (Etrial - E, T))
{
for (j = 0; j <= 99; j = j + 1)
path(j) = trial(j)
E = Etrial
}
}
}
end
program simanl
implicit none
real pthlen
integer path(0:99)
real kT
integer kmax
kT = 1.0
kmax = 1000000
10 format ()
20 format (' kT: ', F0.2)
30 format (' kmax: ', I0)
40 format (' k T E(s)')
50 format (' --------------------------')
60 format ('Final E(s): ', F0.2)
write (*, 10)
write (*, 20) kT
write (*, 30) kmax
write (*, 10)
write (*, 40)
write (*, 50)
call rndpth (path)
call sa (kT, kmax, path)
write (*, 10)
call dsplay (path)
write (*, 10)
write (*, 60) pthlen (path)
write (*, 10)
end</lang>
{{out}}
An example run:
<pre>$ ratfor77 simanneal.r > sa.f && gfortran -O3 -std=legacy sa.f && ./a.out
kT: 1.00
kmax: 1000000
k T E(s)
--------------------------
0 1.0 547.76
100000 0.9 190.62
200000 0.8 187.74
300000 0.7 171.72
400000 0.6 153.08
500000 0.5 131.15
600000 0.4 119.57
700000 0.3 111.20
800000 0.2 105.31
900000 0.1 103.07
1000000 0.0 102.89
0 -> 1 -> 2 -> 12 -> 11 -> 32 -> 33 -> 43 ->
42 -> 52 -> 51 -> 41 -> 31 -> 30 -> 40 -> 50 ->
60 -> 61 -> 62 -> 63 -> 53 -> 54 -> 44 -> 34 ->
24 -> 25 -> 14 -> 15 -> 16 -> 26 -> 36 -> 35 ->
45 -> 55 -> 56 -> 46 -> 47 -> 57 -> 58 -> 68 ->
67 -> 77 -> 86 -> 76 -> 66 -> 65 -> 64 -> 74 ->
75 -> 85 -> 84 -> 83 -> 73 -> 72 -> 71 -> 70 ->
80 -> 90 -> 91 -> 81 -> 82 -> 92 -> 93 -> 94 ->
95 -> 96 -> 97 -> 87 -> 98 -> 99 -> 89 -> 88 ->
78 -> 79 -> 69 -> 59 -> 49 -> 48 -> 39 -> 38 ->
37 -> 27 -> 17 -> 18 -> 28 -> 29 -> 19 -> 9 ->
8 -> 7 -> 6 -> 5 -> 4 -> 3 -> 13 -> 23 ->
22 -> 21 -> 20 -> 10 ->
Final E(s): 102.89
</pre>
=={{header|Scheme}}==
| |||