One problem is that this:
for (1..min($bound,@nextedge)){
Isn't doing what you think. (I believe) It should be:
for( 1 .. min( $bound, scalar( @nextedge ) ) ){
(That kept me guessing for an inordinate amount of time :)
Threading recursive routines is difficult. My usual process is to break the routine into two parts; one which starts threads and the other that does simple recursion within those threads. Your routine wasn't written with that in mind, so the result is that the simplest refactoring is to duplicate the subroutine like this:
#! perl -slw use strict; use threads; use threads::shared; use List::Util qw( sum min ); my $running :shared = 0; my $glength :shared; sub _path_recursive { my( $bound, $len, $path, $end, $tbv, $dist ) = @_; if( !@$tbv ) { $len += $dist->[ $path->[-1] ][$end]; lock $glength; if( $len < $glength ) { $glength = $len; print "$len: @$path $end ",scalar(localtime); } return; } my $last = $dist->[ $path->[-1] ]; my @sorted = sort { $last->[$a] <=> $last->[$b] } @$tbv; for( 1 .. min( $bound, scalar( @sorted ) ) ){ my $next = shift @sorted; _path_recursive( $bound, $len + $last->[$next], [ @$path, $nex +t ], $end, [ @sorted ], $dist ); push @sorted, $next; } } sub path_recursive { my( $bound, $len, $path, $end, $tbv, $dist ) = @_; if( !@$tbv ) { $len += $dist->[ $path->[-1] ][$end]; if( $len < $glength ) { $glength = $len; print "$len: @$path $end ",scalar(localtime); } return; } my $last = $dist->[ $path->[-1] ]; my @sorted = sort { $last->[$a] <=> $last->[$b] } @$tbv; for( 1 .. min( $bound, scalar( @sorted ) ) ){ my $next = shift @sorted; sleep 1 while $running > 3; async { { lock $running; ++$running; } my $tid = threads->tid; print "[$tid] started"; _path_recursive( $bound, $len + $last->[$next], [ @$path, +$next ], $end, [ @sorted ], $dist ); { lock $running; --$running; } print "[$tid] ended"; }->detach; sleep 1; ## give the thread a timeslice to get going. push @sorted, $next; } sleep 1 while $running; } my @dist = <DATA>; $_ = [ split /\s+/ ] and shift @$_ for @dist; $glength = 0.5 * sum map { sum @$_ } @dist; path_recursive shift(), 0, [ 1 ], 24, [ 2..23 ], \@dist; __DATA__ ...
I'll try and do a better job of it after xmas.
In reply to Re^10: Travelling problem (Anyone better 86850?)
by BrowserUk
in thread Travelling problem
by Dirk80
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |