Simulated annealing: Difference between revisions
Content deleted Content added
Line 2,643: | Line 2,643: | ||
28 38 48 49 39 29 19 9 8 7 6 5 4 14 13 12 11 2 3 1 |
28 38 48 49 39 29 19 9 8 7 6 5 4 14 13 12 11 2 3 1 |
||
0</pre> |
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}}== |
=={{header|Scheme}}== |