Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??

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

In reply to Re: Generalizing Code: Generating Unique Permutations (iterator) by tye
in thread Generalizing Code: Generating Unique Permutations by Anonymous Monk

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others about the Monastery: (3)
As of 2024-03-19 07:36 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found