Simulated annealing: Difference between revisions
Added Perl example
SqrtNegInf (talk | contribs) (→{{header|Perl 6}}: city count configurable, code more idiomatic, even fewer sigils) |
SqrtNegInf (talk | contribs) (Added Perl example) |
||
Line 644:
path: @[0, 10, 11, 22, 21, 20, 30, 31, 41, 40, 50, 51, 61, 60, 70, 71, 81, 80, 90, 91, 92, 93, 82, 83, 73, 72, 62, 63, 53, 52, 42, 32, 33, 23, 13, 14, 24, 34, 35, 25, 15, 16, 26, 36, 47, 48, 38, 39, 49, 59, 58, 57, 68, 69, 79, 89, 99, 98, 97, 96, 95, 94, 84, 74, 75, 85, 86, 87, 88, 78, 77, 67, 76, 66, 65, 64, 54, 43, 44, 45, 55, 56, 46, 37, 27, 28, 29, 19, 9, 8, 18, 17, 7, 6, 5, 4, 3, 2, 12, 1, 0]
</pre>
=={{header|Perl}}==
{{trans|Perl 6}}
<lang perl>use utf8;
use strict;
use warnings;
use List::Util qw(shuffle sum);
# simulation setup
my $cities = 100; # number of cities
my $kmax = 1e6; # iterations to run
my $kT = 1; # initial 'temperature'
die 'City count must be a perfect square.' if sqrt($cities) != int sqrt($cities);
# locations of (up to) 8 neighbors, with grid size derived from number of cities
my $gs = sqrt $cities;
my @neighbors = (1, -1, $gs, -$gs, $gs-1, $gs+1, -($gs+1), -($gs-1));
# matrix of distances between cities
my @D;
for my $j (0 .. $cities**2 - 1) {
my ($ab, $cd) = (int($j/$cities), int($j%$cities));
my ($a, $b, $c, $d) = (int($ab/$gs), int($ab%$gs), int($cd/$gs), int($cd%$gs));
$D[$ab][$cd] = sqrt(($a - $c)**2 + ($b - $d)**2);
}
# temperature function, decreases to 0
sub T {
my($k, $kmax, $kT) = @_;
(1 - $k/$kmax) * $kT
}
# probability to move from s to s_next
sub P {
my($ΔE, $k, $kmax, $kT) = @_;
exp -$ΔE / T($k, $kmax, $kT)
}
# energy at s, to be minimized
sub Es {
my(@path) = @_;
sum map { $D[ $path[$_] ] [ $path[$_+1] ] } 0 .. @path-2
}
# variation of E, from state s to state s_next
sub delta_E {
my($u, $v, @s) = @_;
my ($a, $b, $c, $d) = ($D[$s[$u-1]][$s[$u]], $D[$s[$u+1]][$s[$u]], $D[$s[$v-1]][$s[$v]], $D[$s[$v+1]][$s[$v]]);
my ($na, $nb, $nc, $nd) = ($D[$s[$u-1]][$s[$v]], $D[$s[$u+1]][$s[$v]], $D[$s[$v-1]][$s[$u]], $D[$s[$v+1]][$s[$u]]);
if ($v == $u+1) { return ($na + $nd) - ($a + $d) }
elsif ($u == $v+1) { return ($nc + $nb) - ($c + $b) }
else { return ($na + $nb + $nc + $nd) - ($a + $b + $c + $d) }
}
# E(s0), initial state
my @s = 0; map { push @s, $_ } shuffle 1..$cities-1; push @s, 0;
my $E_min_global = my $E_min = Es(@s);
for my $k (0 .. $kmax-1) {
push @res, sprintf "k:%8u T:%4.1f Es: %3.1f" , $k, T($k, $kmax, $kT), Es(@s)
if $k % ($kmax/10) == 0;
# valid candidate cities (exist, adjacent)
my $u = 1 + int rand $cities-1;
my $cv = $neighbors[int rand 8] + $s[$u];
next if $cv <= 0 or $cv >= $cities or $D[$s[$u]][$cv] > sqrt(2);
my $v = $s[$cv];
my $ΔE = delta_E($u, $v, @s);
if ($ΔE < 0 or P($ΔE, $k, $kmax, $kT) >= rand) { # always move if negative
($s[$u], $s[$v]) = ($s[$v], $s[$u]);
$E_min += $ΔE;
$E_min_global = $E_min if $E_min < $E_min_global;
}
}
printf "\nE(s_final): %.1f\n", $E_min_global;
for my $l (0..4) {
printf "@{['%4d' x 20]}\n", @s[$l*20 .. ($l+1)*20 - 1];
}
printf " 0\n";</lang>
{{out}}
<pre>k: 0 T: 1.0 Es: 519.2
k: 100000 T: 0.9 Es: 188.2
k: 200000 T: 0.8 Es: 178.5
k: 300000 T: 0.7 Es: 162.3
k: 400000 T: 0.6 Es: 157.0
k: 500000 T: 0.5 Es: 148.9
k: 600000 T: 0.4 Es: 128.7
k: 700000 T: 0.3 Es: 129.5
k: 800000 T: 0.2 Es: 119.8
k: 900000 T: 0.1 Es: 119.5
E(s_final): 119.1
0 12 23 24 35 36 26 27 16 7 8 9 19 29 28 18 17 6 14 13
22 32 33 34 25 15 5 4 3 2 1 11 20 21 31 30 40 51 50 60
61 62 53 43 44 54 56 57 48 49 39 38 37 46 45 55 65 64 63 74
84 83 82 81 80 90 91 92 93 94 95 85 66 47 58 59 69 89 88 87
77 67 68 78 79 99 98 97 96 86 76 75 73 72 70 71 52 42 41 10
0</pre>
=={{header|Perl 6}}==
{{trans|Go}}
| |||