Simulated annealing: Difference between revisions
Content added Content deleted
SqrtNegInf (talk | contribs) (→{{header|Perl 6}}: city count configurable, code more idiomatic, even fewer sigils) |
SqrtNegInf (talk | contribs) (Added Perl example) |
||
Line 644: | 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] |
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> |
</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}}== |
=={{header|Perl 6}}== |
||
{{trans|Go}} |
{{trans|Go}} |