Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

Re: Generalizing Code: Generating Unique Permutations (iterator)

by tye (Sage)
on Oct 07, 2003 at 21:42 UTC ( [id://297402]=note: print w/replies, xml ) Need Help??


in reply to Generalizing Code: Generating Unique Permutations

I hope to make a future version of Algorithm::Loops such that this is easier to write. However, you can still avoid having to generate the entire list into memory by avoiding duplicates as you go:

#!/usr/bin/perl -w use strict; use Algorithm::Loops qw( NestedLoops ); my $permlist= [ 'a' .. shift(@ARGV)||'c' ]; my $max= $#$permlist; my $card= shift(@ARGV) || 1; my $iter= NestedLoops( [ [ 0 .. $max+1-2*$card ], sub { [ $_+1 .. $max ] }, map { my $left= $card - $_; sub { my %used; @used{@_}= (1) x @_; [ grep !$used{$_}, $_[-2]+1 .. $max+1-2*$left ]; }, sub { my %used; @used{@_}= (1) x @_; [ grep !$used{$_}, $_+1 .. $max ]; }, } 1 .. $card-1, ], ); ## my @data; my @idx; my $count; { my $prod= 1; my $mult= @$permlist; for( 1..$card ) { $prod *= $mult--; $prod /= $_; } for( 1..$card ) { $prod *= $mult--; $prod /= 2; } print "$prod pairings:\n"; } while( @idx= $iter->() ) { my @group; while( @idx ) { my @pair= @{$permlist}[ splice(@idx,0,2) ]; push @group, \@pair; } printf "( %s )\n", join ", ", map sprintf("(%s,%s)",@$_), @group; ## push @data, \@group; }
See how easy that is? ;)

A sample use is:

> perl pairs.pl e 2 15 pairings: ( (a,b), (c,d) ) ( (a,b), (c,e) ) ( (a,b), (d,e) ) ( (a,c), (b,d) ) ( (a,c), (b,e) ) ( (a,c), (d,e) ) ( (a,d), (b,c) ) ( (a,d), (b,e) ) ( (a,d), (c,e) ) ( (a,e), (b,c) ) ( (a,e), (b,d) ) ( (a,e), (c,d) ) ( (b,c), (d,e) ) ( (b,d), (c,e) ) ( (b,e), (c,d) )

Uncomment two lines to have the list of groups saved into @data.

Update: Note that you can actually make that a bit faster such that most of the loop list constructors don't need the %used trick, but it makes the code a bit more complex to read:

#!/usr/bin/perl -w use strict; use Algorithm::Loops qw( NestedLoops ); my $permlist= [ 'a' .. shift(@ARGV)||'c' ]; my $max= $#$permlist; my $card= shift(@ARGV) || 1; my $iter= NestedLoops( [ [ 0 .. $max+1-2*$card ], map( { my $left= $card - $_; sub { [ $_+1 .. $max+1-2*$left ] }, } 1 .. $card-1 ), ( sub { my %used; @used{@_}= (1) x @_; [ grep !$used{$_}, $_[-$card]+1 .. $max ]; }, ) x $card, ], ); ## my @data; my @idx; while( @idx= $iter->() ) { my @group= map { [ @{$permlist}[ @idx[$_,$_+$card] ] ] } 0 .. $card-1; printf "( %s )\n", join ", ", map sprintf("(%s,%s)",@$_), @group; ## push @data, \@group; }
Which produces the same results though sorted in a different order.

                - tye

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others learning in the Monastery: (7)
As of 2024-03-19 10:11 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found