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

[BrowserUk]

Here's my second attempt at a threaded version. Running it with -T=24 won't be fastest unless you have 24 cores, but it has the interesting side effect of running all first picks in parallel.

Ignore this! (I was forgetting to add the last distance :( )which yields several better than 84860 scores in just a few minutes:

C:\test>junk16 -T=24
[1]  91244: 0 1 10 15 6 11 7 2 18 19 17 14 4 9 13 22 8 3 12 20 16 5 21
[1]  89379: 0 1 10 15 6 11 7 2 18 19 17 14 4 9 13 22 8 3 12 16 20 5 21
[12] 88662: 0 12 3 8 22 13 5 20 16 11 6 15 10 1 7 2 18 19 17 14 4 9 21
[16] 86046: 0 16 20 12 3 8 22 13 5 1 10 15 6 11 7 2 18 19 17 14 4 9 21
[16] 85401: 0 16 20 12 3 8 22 13 5 1 10 15 6 11 7 18 2 19 17 14 4 9 21
[1]  84655: 0 1 10 15 6 11 7 2 18 19 17 14 4 9 21 13 22 8 3 12 5 20 16
[1]  83907: 0 1 10 15 6 11 7 2 18 19 17 14 4 21 9 13 22 8 3 12 5 20 16
[1]  83666: 0 1 10 15 6 11 7 2 18 19 17 14 21 9 4 13 22 8 3 12 5 20 16
[1]  83633: 0 1 10 15 6 11 7 2 18 19 17 14 21 4 9 13 22 8 3 12 5 20 16
[1]  82991: 0 1 10 15 6 11 7 2 18 19 17 4 14 21 9 13 22 8 3 12 5 20 16

Source:

#! perl -slw
use strict;
use threads;
use threads::shared;

my @dists = map[ split ' ' ], <DATA>;

sub totalEm {
    my $aref = shift;
    my $total = 0;
    $total += $dists[ $aref->[ $_ - 1] ][ $aref->[ $_ ] ] for 1 .. $#{
+ $aref };
    return $total;
}

my $best :shared = 1e9;
sub rPath {
    my( $soFar, $path, $toAdd, $tid ) = @_;
    return if $soFar > $best;

    unless( @$toAdd ) {
        $soFar += $dists[ $path->[ -1 ] ][ 23 ];
        if( $soFar < $best ) {
            printf "[%2u] %u: @$path 23\n", $tid, $soFar,;
            $best = $soFar;
        }
        return;
    }

    my $last = $dists[ $path->[-1] ];
    my @ordered = sort { $last->[$a] <=> $last->[$b] } @$toAdd;

    for( 1 .. @ordered ) {
        my $next = shift @ordered;
        rPath( $soFar + $dists[ $path->[-1] ][ $next ], [ @$path, $nex
+t ], \@ordered, $tid );
        push @ordered, $next;
    }
}

our $T //= 4;
my $running :shared = 0;
for( 1 .. 22 ) {
    {lock $running; ++$running }
    async{
        my $tid = threads->tid;
        rPath( $dists[ 0 ][ $_ ], [ 0, $_ ], [ 1..$_-1, $_+1 .. 22 ], 
+$tid );
        { lock $running; --$running; }
    }->detach;
    sleep 1 while $running > $T-1
}

sleep 1 while $running;

__DATA__

I've also recoded the algorithm into C which runs very quickly, but so far I haven't threaded it.