$ time perl tsp2_v6.pl 2 95383: 1 2 11 16 7 12 8 3 19 20 18 15 5 10 14 23 9 4 13 21 17 6 22 24 Tue Dec 24 09:35:20 2013 95166: 1 21 17 12 7 16 11 2 6 13 4 9 23 14 10 5 15 18 20 3 19 8 22 24 Tue Dec 24 09:35:20 2013 92839: 1 21 13 4 9 23 14 6 17 12 7 16 11 2 8 3 19 20 18 15 5 10 22 24 Tue Dec 24 09:35:20 2013 90498: 1 21 17 12 7 16 11 2 6 13 4 9 23 14 10 5 15 18 20 3 8 19 22 24 Tue Dec 24 09:35:20 2013 89483: 1 21 13 4 9 23 14 6 17 12 7 2 11 16 8 3 19 20 18 15 5 10 22 24 Tue Dec 24 09:35:20 2013 88838: 1 21 13 4 9 23 14 6 17 12 7 2 11 16 8 19 3 20 18 15 5 10 22 24 Tue Dec 24 09:35:20 2013 86867: 1 2 11 16 7 12 17 21 6 13 4 9 23 14 10 5 15 18 20 3 8 19 22 24 Tue Dec 24 09:35:22 2013 85294: 1 2 11 16 7 8 12 17 21 6 13 4 9 23 14 10 5 15 18 20 3 19 22 24 Tue Dec 24 09:35:24 2013 84860: 1 2 11 16 8 7 12 17 21 6 13 4 9 23 14 10 5 15 18 20 3 19 22 24 Tue Dec 24 09:35:32 2013 Perl exited with active threads: 5 running and unjoined 194 finished and unjoined 0 running and detached real 0m32.107s user 1m18.492s sys 0m24.782s #### use strict; use warnings; use threads; use threads::shared; use List::Util qw( sum min ); my $glength :shared; my @dist = ; $_ = [ split /\s+/ ] and shift @$_ for @dist; $glength = 0.5 * sum map { sum @$_ } @dist; sub path_recursive { my( $bound, $len, $path, $end, $tbv, $dist ) = @_; if( !@$tbv ) { $len += $dist->[ $path->[-1] ]->[$end]; if( $len < $glength ) { lock $glength; $glength = $len; print "$len: @$path $end ",scalar(localtime),"\n"; } return; } my $last = $dist->[ $path->[-1] ]; my @nextedge = sort { $last->[$a] <=> $last->[$b] } @$tbv; my @threads; for (1..min($bound,@nextedge)){ my $next = shift @nextedge; if( scalar( threads->list(threads::running) ) < 3 ) { push @threads, threads->create( \&path_recursive, $bound, $len + $last->[$next], [ @$path, $next ], $end, [ @nextedge ], $dist ); } else { path_recursive( $bound, $len + $last->[$next], [ @$path, $next ], $end, [ @nextedge ], $dist ); } push @nextedge, $next; } $_->is_joinable() and $_->join() for @threads; } path_recursive shift(), 0, [ 1 ], 24, [ 2..23 ], \@dist; $_->join() for threads->list(threads::all); __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 7575 6170 6812 9487 18135 8030 5409 17959 12822 17136 3267 12882 11223 11078 2 3812 0 11527 12431 15446 8057 4519 8761 14398 12569 3764 6668 10603 11117 14805 5154 8276 18175 9367 14840 7056 9698 13603 7266 3 13902 11527 0 13638 10220 18405 8675 4611 12993 11970 8798 8226 15087 16591 6859 6381 11223 7602 3236 3457 14535 8830 14748 6655 4 8619 12431 13638 0 9965 5555 11256 11549 2157 10917 16194 9609 1926 7111 12565 14906 5737 9378 16868 11899 5402 15921 5765 19675 5 15811 15446 10220 9965 0 11122 18683 14599 7873 2940 13119 17793 11057 6374 3517 14973 15565 3627 10307 7077 14478 6475 5155 10235 6 5015 8057 18405 5555 11122 0 10109 13856 6744 9617 11348 10270 3811 4858 14594 12975 7186 13212 17301 17106 3881 12658 6210 14138 7 5230 4519 8675 11256 18683 10109 0 4584 13284 16923 6018 2299 10267 14709 15205 3741 5549 15863 8377 11981 6865 12543 16177 8600 8 9615 8761 4611 11549 14599 13856 4584 0 12503 16548 8240 3619 11888 18524 11444 4627 6948 11282 6102 7523 9992 12321 16782 8550 9 10624 14398 12993 2157 7873 6744 13284 12503 0 9231 18070 11405 3813 6447 10427 16699 7735 7340 15982 10421 7492 14151 4374 18092 10 13346 12569 11970 10917 2940 9617 16923 16548 9231 0 11052 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 8220 0 9124 15115 15059 5330 3975 14165 9100 10994 6469 14453 15268 10326 13 6812 10603 15087 1926 11057 3811 10267 11888 3813 11199 14354 9124 0 6645 14126 13999 5168 11153 17968 13808 3728 15782 6168 17749 14 9487 11117 16591 7111 6374 4858 14709 18524 6447 4874 12490 15115 6645 0 9754 15942 11588 9288 15400 13331 8652 9157 2621 12782 15 18135 14805 6859 12565 3517 14594 15205 11444 10427 5269 11186 15059 14126 9754 0 11725 16484 3379 6883 4250 17835 5311 8643 7729 16 8030 5154 6381 14906 14973 12975 3741 4627 16699 14093 3614 5330 13999 15942 11725 0 9173 13841 4874 9780 10451 9122 18555 5003 17 5409 8276 11223 5737 15565 7186 5549 6948 7735 16358 11306 3975 5168 11588 16484 9173 0 13413 12955 12642 3450 17931 11293 14142 18 17959 18175 7602 9378 3627 13212 15863 11282 7340 6543 14452 14165 11153 9288 3379 13841 13413 0 9181 4145 14775 8581 7147 10945 19 12822 9367 3236 16868 10307 17301 8377 6102 15982 10709 5954 9100 17968 15400 6883 4874 12955 9181 0 5593 15242 6278 15447 3419 20 17136 14840 3457 11899 7077 17106 11981 7523 10421 9458 11533 10994 13808 13331 4250 9780 12642 4145 5593 0 15914 8478 11291 8453 21 3267 7056 14535 5402 14478 3881 6865 9992 7492 13488 10801 6469 3728 8652 17835 10451 3450 14775 15242 15914 0 15624 9326 14308 22 12882 9698 8830 15921 6475 12658 12543 12321 14151 5008 6649 14453 15782 9157 5311 9122 17931 8581 6278 8478 15624 0 10157 4139 23 11223 13603 14748 5765 5155 6210 16177 16782 4374 5170 14987 15268 6168 2621 8643 18555 11293 7147 15447 11291 9326 10157 0 14265 24 11078 7266 6655 19675 10235 14138 8600 8550 18092 9146 3508 10326 17749 12782 7729 5003 14142 10945 3419 8453 14308 4139 14265 0