Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

Re: Permuting with duplicates and no memory

by spx2 (Chaplain)
on Mar 02, 2010 at 03:26 UTC ( #826060=note: print w/ replies, xml ) Need Help??


in reply to Permuting with duplicates and no memory

I feel a bit indebted to write the results of a benchmark I made to find out which of the permutation generators are fast, Algorithm::Permute , tye's implementation , dragonchild's implementation and of course my Steinhaus Johnson Trotter XS implementation:

Rate tye SJT dchld A::P tye 1.27/s -- -22% -46% -81% SJT 1.63/s 28% -- -30% -76% dchld 2.34/s 84% 44% -- -65% A::P 6.67/s 423% 310% 185% --
Here's the code I used to make the benchmark:
use strict; use warnings; use Benchmark qw/cmpthese timethese/; use Algorithm::Permute; use SJT; my $n = 8; # objects to permute my $iter=4; sub nextPermute(\@) { my( $vals )= @_; my $last= $#{$vals}; return "" if $last < 1; # Find last item not in reverse-sorted order: my $i= $last-1; $i-- until $i < 0 || $vals->[$i] lt $vals->[$i+1]; # If complete reverse sort, we are done! return "" if -1 == $i; # Re-sort the reversely-sorted tail of the list: @{$vals}[$i+1..$last]= reverse @{$vals}[$i+1..$last] if $vals->[$i+1] gt $vals->[$last]; # Find next item that will make us "greater": my $j= $i+1; $j++ until $vals->[$i] lt $vals->[$j]; # Swap: @{$vals}[$i,$j]= @{$vals}[$j,$i]; return 1; } sub make_orderings { my $num = shift; my @arr = (1 .. $num); return sub { my $last = $#arr; my $i = $last - 1; $i-- while 0 <= $i && $arr[$i] >= $arr[$i+1]; return if $i == -1; @arr[$i+1..$last] = reverse @arr[$i+1..$last] if $arr[$i+1] > $arr[$last]; my $j=$i+1; $j++ while $arr[$i] >= $arr[$j]; @arr[$i,$j] = @arr[$j,$i]; return @arr; } } cmpthese( $iter, { 'A::P' => sub { use Algorithm::Permute; my $p = new Algorithm::Permute([1..$n], $n); while (my @res = $p->next) { #print join(", ", @res), "\n"; } }, 'SJT' => sub { my $s = SJT->new($n); while($s->next_perm()){ my @p = @{$s->{permutation}}; #$s->print_perm; }; }, 'tye' => sub { my @w= (1..$n); do { } while( nextPermute(@w) ); }, 'dchld' => sub { my $i = make_orderings($n); while(my @a = $i->()){ }; }, } );


Comment on Re: Permuting with duplicates and no memory
Select or Download Code

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others taking refuge in the Monastery: (4)
As of 2015-07-05 08:09 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (61 votes), past polls