Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options
 
PerlMonks  

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

by roboticus (Canon)
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 surveying the Monastery: (12)
As of 2014-08-20 17:42 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (121 votes), past polls