Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
PerlMonks  

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

by BrowserUk (Pope)
on Dec 24, 2013 at 03:24 UTC ( #1068283=note: print w/ replies, xml ) Need Help??


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

Initial reaction (more later if life doesn't intercede:):

  1. You have a 15-core system?
  2. You are doing no locking on your shared variables?
  3. What do you think that threads->exit does that return doesn't?
  4. Isn't pushing a value to an array called @sorted violating the expectations of the reader, even if not those of the algorithm?
  5. You neither threads::detach() nor threads::join() your threads.

    Have you run this code to completion yet?

  6. Why past $end as a parameter, when it is never modified?

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.


Comment on Re^8: Travelling problem (Anyone better 86850?)
Select or Download Code
Re^9: Travelling problem (Anyone better 86850?)
by hdb (Parson) on Dec 24, 2013 at 08:39 UTC

    Thanks for your help. I have tried to implement 1. - 5. but I now get the following:

    $ 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

    Any idea?

    Here is my updated code:

      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.


      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.

        Thanks for your good advice. I have adapted your approach in a slight modification where I introduce an indicator whether or not the recursive function is called from itself or from the outside. In the latter case, it starts threads otherwise it just calls itself within the same thread. This is at the cost of an additional if which I hope is not material (I have not run any benchmarks).

        As a consequence, the script has successfully completed the restricted branching based on the shortest two or three next available edges (the latter took 12hrs), but it has not found any better solution than 84860.

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others browsing the Monastery: (8)
As of 2014-07-14 07:01 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    When choosing user names for websites, I prefer to use:








    Results (255 votes), past polls