BrowserUk:
Prompted by LanX's suggestion to use a genetic algorithm, I put one together (code in the readmore section below).
So far, both times I ran it, it found a path totalling 84860. I just started a longer run (100,000 generations with a larger population (300) to see if anything interesting pops up.
#!/usr/bin/perl
#
# trv... travelling salesman problem
#
use strict;
use warnings;
use List::Util qw( shuffle );
# Read data
my %D;
my ($R, $C) = (0);
while (<DATA>) {
my @t = split /\s+/, $_;
$C=0;
shift @t; # remove row hdr
while (@t) {
my ($dist, $a, $b);
$dist = shift @t;
($a,$b) = ($R>$C) ? ($C, $R) : ($R, $C);
if ($a != $b) {
if (exists $D{$a}{$b}) {
die "Mismatch ($R,$C)=$dist, but ($C,$R)=$D{$a}{$b}\n"
+ if $dist != $D{$a}{$b};
}
$D{$a}{$b} = $dist;
}
++$C;
}
++$R;
}
sub dist {
my ($r, $c) = @_;
die "Eh? $r == $c!\n" if $r eq $c;
($r, $c) = ($c, $r) if $c < $r;
die "$r,$c entry DNE?\n" unless exists $D{$r}{$c};
$D{$r}{$c};
}
my @population;
my ($sum_min, $sum_max) = (0, 0);
goofy_naive_genetic_algorithm();
print "bounds: $sum_min .. $sum_max\n";
sub goofy_naive_genetic_algorithm {
# first populate the dataset
push @population, [ undef, [ generate_random_path() ] ] for 0 .. 1
+00;
# compute absolute best and worst bounds
for my $i (1 .. 24) {
my ($min, $max) = (99999999, -1);
for my $j (1 .. 24) {
next if $j == $i;
my $d = dist($i, $j);
$min = $d if $min > $d;
$max = $d if $max < $d;
}
$sum_min += $min;
$sum_max += $max;
}
print "bounds: $sum_min .. $sum_max\n";
for my $gen (1 .. 1000) {
@population = @population[0 .. 100];
# for each generation, make "children" of the various items
for my $i (0 .. $#population) {
my ($beg, $end) = (1 + int 22*rand, 1 + int 22*rand);
redo if $end == $beg;
($beg, $end) = ($end, $beg) if $end<$beg;
my @path = @{$population[$i][1]};
my @newpath;
if (0.3 > rand) {
# Randomize the middle section
@newpath = ( @path[0 .. $beg-1], shuffle(@path[$beg..$
+end]), @path[$end+1 .. $#path] );
}
else {
# reverse the middle section
@newpath = ( @path[0 .. $beg-1], reverse(@path[$beg..$
+end]), @path[$end+1 .. $#path] );
}
push @population, [ undef, [ @newpath ] ];
}
# Evaluate and display all the paths
my $cnt=0;
my %dedup;
for my $r (@population) {
# evaluate only if not already done
$r->[0] = eval_path(@{$r->[1]}) if ! defined $r->[0];
++$cnt;
my $t = path_2_str(@{$r->[1]});
$dedup{$t} = $r;
}
@population = sort { $a->[0] <=> $b->[0] } values %dedup;
my $worst = $population[-1][0];
print "GEN $gen best: ($population[0][0]) : ", path_2_str(@{$p
+opulation[0][1]}), " (worst=$worst)\n";
}
}
print "Final population:\n\n";
for my $i (0 .. $#population) {
my $t = path_2_str(@{$population[$i][1]});
printf "% 4u (% 7u) : %s\n", $i, ,$population[$i][0], $t;
}
sub path_2_str {
my @p = map { sprintf "% 2u", $_ } @_;
return join("->",@p);
}
sub eval_path {
my $dist = 0;
my @path = @_;
my $cur = shift @path;
while (@path) {
my $next = shift @path;
$dist += dist($cur,$next);
$cur = $next;
}
$dist;
}
sub generate_random_path {
( 1, shuffle(2 .. 23), 24 )
}
# Matrix shows distance from pt on left to dest column
__DATA__
0 1 2 3 4 5 6 7 8 9 10
+11 12 13 14 15 16 17 18 19 20 21 22
+ 23 24
1 0 3812 13902 8619 15811 5015 5230 9615 10624 13346 75
+75 6170 6812 9487 18135 8030 5409 17959 12822 17136 3267 12882
+11223 11078
2 3812 0 11527 12431 15446 8057 4519 8761 14398 12569 37
+64 6668 10603 11117 14805 5154 8276 18175 9367 14840 7056 9698
+13603 7266
3 13902 11527 0 13638 10220 18405 8675 4611 12993 11970 87
+98 8226 15087 16591 6859 6381 11223 7602 3236 3457 14535 8830
+14748 6655
4 8619 12431 13638 0 9965 5555 11256 11549 2157 10917 161
+94 9609 1926 7111 12565 14906 5737 9378 16868 11899 5402 15921
+ 5765 19675
5 15811 15446 10220 9965 0 11122 18683 14599 7873 2940 131
+19 17793 11057 6374 3517 14973 15565 3627 10307 7077 14478 6475
+ 5155 10235
6 5015 8057 18405 5555 11122 0 10109 13856 6744 9617 113
+48 10270 3811 4858 14594 12975 7186 13212 17301 17106 3881 12658
+ 6210 14138
7 5230 4519 8675 11256 18683 10109 0 4584 13284 16923 60
+18 2299 10267 14709 15205 3741 5549 15863 8377 11981 6865 12543
+16177 8600
8 9615 8761 4611 11549 14599 13856 4584 0 12503 16548 82
+40 3619 11888 18524 11444 4627 6948 11282 6102 7523 9992 12321
+16782 8550
9 10624 14398 12993 2157 7873 6744 13284 12503 0 9231 180
+70 11405 3813 6447 10427 16699 7735 7340 15982 10421 7492 14151
+ 4374 18092
10 13346 12569 11970 10917 2940 9617 16923 16548 9231 0 110
+52 19220 11199 4874 5269 14093 16358 6543 10709 9458 13488 5008
+ 5170 9146
11 7575 3764 8798 16194 13119 11348 6018 8240 18070 11052
+ 0 8220 14354 12490 11186 3614 11306 14452 5954 11533 10801 6649
+14987 3508
12 6170 6668 8226 9609 17793 10270 2299 3619 11405 19220 82
+20 0 9124 15115 15059 5330 3975 14165 9100 10994 6469 14453
+15268 10326
13 6812 10603 15087 1926 11057 3811 10267 11888 3813 11199 143
+54 9124 0 6645 14126 13999 5168 11153 17968 13808 3728 15782
+ 6168 17749
14 9487 11117 16591 7111 6374 4858 14709 18524 6447 4874 124
+90 15115 6645 0 9754 15942 11588 9288 15400 13331 8652 9157
+ 2621 12782
15 18135 14805 6859 12565 3517 14594 15205 11444 10427 5269 111
+86 15059 14126 9754 0 11725 16484 3379 6883 4250 17835 5311
+ 8643 7729
16 8030 5154 6381 14906 14973 12975 3741 4627 16699 14093 36
+14 5330 13999 15942 11725 0 9173 13841 4874 9780 10451 9122
+18555 5003
17 5409 8276 11223 5737 15565 7186 5549 6948 7735 16358 113
+06 3975 5168 11588 16484 9173 0 13413 12955 12642 3450 17931
+11293 14142
18 17959 18175 7602 9378 3627 13212 15863 11282 7340 6543 144
+52 14165 11153 9288 3379 13841 13413 0 9181 4145 14775 8581
+ 7147 10945
19 12822 9367 3236 16868 10307 17301 8377 6102 15982 10709 59
+54 9100 17968 15400 6883 4874 12955 9181 0 5593 15242 6278
+15447 3419
20 17136 14840 3457 11899 7077 17106 11981 7523 10421 9458 115
+33 10994 13808 13331 4250 9780 12642 4145 5593 0 15914 8478
+11291 8453
21 3267 7056 14535 5402 14478 3881 6865 9992 7492 13488 108
+01 6469 3728 8652 17835 10451 3450 14775 15242 15914 0 15624
+ 9326 14308
22 12882 9698 8830 15921 6475 12658 12543 12321 14151 5008 66
+49 14453 15782 9157 5311 9122 17931 8581 6278 8478 15624 0
+10157 4139
23 11223 13603 14748 5765 5155 6210 16177 16782 4374 5170 149
+87 15268 6168 2621 8643 18555 11293 7147 15447 11291 9326 10157
+ 0 14265
24 11078 7266 6655 19675 10235 14138 8600 8550 18092 9146 35
+08 10326 17749 12782 7729 5003 14142 10945 3419 8453 14308 4139
+14265 0
Update: Oops! Replied to the wrong node. Also, should've refreshed the page. When I started coding, there weren't so many replies!
Update 2: I let the other run go for about 80K generations, but it never found anything better.
...roboticus
When your only tool is a hammer, all problems look like your thumb.
