Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation
 
PerlMonks  

Comment on

( #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":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

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

    How do I use this? | Other CB clients
    Other Users?
    Others examining the Monastery: (15)
    As of 2014-08-29 12:50 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      The best computer themed movie is:











      Results (280 votes), past polls