Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

Re^2: Travelling problem (Anyone better 86850?)

by roboticus (Chancellor)
on Dec 23, 2013 at 18:11 UTC ( #1068237=note: print w/ replies, xml ) Need Help??


in reply to Re: Travelling problem (Anyone better 86850?)
in thread Travelling problem

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.


Comment on Re^2: Travelling problem (Anyone better 86850?)
Download Code
Re^3: Travelling problem (Anyone better 86850?)
by BrowserUk (Pope) on Dec 23, 2013 at 20:08 UTC

    Similar methodology to mine, and the same problem.

    Many times it will find the minima well within your 1000 generations; but on those occasions where it settles into a false minima; it doesn't (seem to; limited runs) matter how many more generations you run it for; it will never find it.

    That's what I've been trying to find a solution to for the last couple of days. So far, without much success.

    The problem appears to be that if you discard too vigorously, you settle into re-trying variations of the same paths over and over without ever introducing any "new blood".


    With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://1068237]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (6)
As of 2015-07-07 06:42 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (87 votes), past polls