Beefy Boxes and Bandwidth Generously Provided by pair Networks vroom
The stupid question is the question not asked
 
PerlMonks  

Challenge: Generate fixed size combination across groups without duplicates

by Limbic~Region (Chancellor)
on Nov 16, 2011 at 02:48 UTC ( #938298=perlquestion: print w/ replies, xml ) Need Help??
Limbic~Region has asked for the wisdom of the Perl Monks concerning the following question:

All,
Assume you have a variable number of groups. Each group has a variable number of members. Your task is to create all possible combinations of a fixed size such that no combination includes multiple members from the same group.

Ensuring that you don't get multiple member from the same group is easy - just used Algorithm::Loops NestedLoops. Getting all possible combinations of a fixed size is easy, use an iterator such as mine. The problem with this approach is that it generates duplicates.

for my $first (@group1) { for my $second (@group2) { for my $third (@group3) { for my $fourth (@group4) { # Assume fixed size = 2 # $first, $second and $third repeat here for each memb +er in @group4 # $first, $second pairings happen multiple times } } } }

Using a %seen hash won't work for two reasons. First, you will likely run out of memory given how quickly the number of possible results can grow with just a small input size. Second, generating a combination just to skip is bad for performance of a program that will already likely not finish before the heat death of the universe.

Your challenge then is to develop an algorithm that can iterate over the possible solutions without generating duplicates. Keep in mind that the following things are variable (number of groups, number of members in each group, the fixed size of each combination).

A sample to work with: group_1 = A B C group_2 = 1 2 3 4 group_3 = yellow blue green group_4 = tiny small medium large gigantic fixed_size = 2

Cheers - L~R

Comment on Challenge: Generate fixed size combination across groups without duplicates
Select or Download Code
Re: Challenge: Generate fixed size combination across groups without duplicates
by BrowserUk (Pope) on Nov 16, 2011 at 03:58 UTC

    Is this a solution? Update: To answer my own question. No. It produces duplicates! :(

    #! perl -slw use strict; use Data::Dump qw[ pp ]; use Algorithm::Combinatorics qw[ variations ]; sub nFor(&@) { my $code = shift; die "First argument must be a code ref" unless ref( $code ) eq 'CO +DE'; my @limits = @_; my @indices = ( 0 ) x @limits; for( my $i = $#limits; $i >= 0; ) { $i = $#limits; $code->( @indices ), ++$indices[ $i ] while $indices[ $i ] < $limits[ $i ]; $i = $#limits; $indices[ $i ] = 0, ++$indices[ --$i ] while $i >= 0 and $indices[ $i ] == $limits[ $i ]; } } my @g = ( [ qw[ A B C ] ], [ qw[ 1 2 3 4 ] ], [ qw[ yellow blue green ] ], [ qw[ tiny small medium large gigantic ] ], ); my $fSize = 2; my @varies = variations( [ 0 .. $#g ], $fSize ); nFor { for my $v ( @varies ) { print join ' ', map{ $g[ $_ ][ $_[ $_ ] ] } @$v } } map scalar @$_, @g;

    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.
Re: Challenge: Generate fixed size combination across groups without duplicates
by GrandFather (Cardinal) on Nov 16, 2011 at 04:03 UTC

    If I correctly understand what you want then the following does the trick:

    #!/usr/lib/perl use strict; use warnings; my @groups; my $size; while (<DATA>) { chomp; my ($type, $value) = split /\s*=\s*/, $_, 2; next if ! defined $value; if ($type eq 'fixed_size') { $size = $value; next; } push @groups, [split (/ /, $value), undef]; } pickem ($size, [], @groups); sub pickem { my ($needed, $givenList, @options) = @_; my $list = shift @options; for my $item (@$list) { if (! defined $item) { pickem ($needed, $givenList, @options); next; } if ($needed == 1) { print "@$givenList $item\n"; next; } pickem ($needed - 1, [@$givenList, $item], @options); } } __DATA__ group_1 = A B C group_2 = 1 2 3 4 group_3 = yellow blue green group_4 = tiny small medium large gigantic fixed_size = 2
    True laziness is hard work
      GrandFather,
      Ah yes, recursion - that thing my brain finds so confusing. Thanks - this appears to be perfect.

      Cheers - L~R

        The real trick is adding the "no-op" entry to each group.

        True laziness is hard work
Re: Challenge: Generate fixed size combination across groups without duplicates
by JavaFan (Canon) on Nov 16, 2011 at 07:29 UTC
    A sample to work with:

    group_1 = A B C group_2 = 1 2 3 4 group_3 = yellow blue green group_4 = tiny small medium large gigantic fixed_size = 2
    Can't you just use standard techniques to pick all combinations of 2 out of a set of 4, picking pairs of groups, then for each pair, calculate the Cartesian product?
      JavaFan,
      Well, that only works for the sample provided and not the larger problem of a variable number of groups but it is trivial to extend it to the general case. I simply need to reverse the solution I provided in the original problem description:
      • Use any fixed size combination iterator to produce the combination of groups matching the fixed size target
      • Use Algorithm::Loops or similar to generate the cartesian product

      This is also much simpler than the odometer model solution I came up with last night after posting this. Thanks.

      Cheers - L~R

        I arrived at the same solution:
        use Algorithm::Loops; use Math::Combinatorics; my $fixed_size = 2; my @groups = ( [qw( A B C )], [qw( 1 2 3 4 )], [qw( yellow blue green )], [qw( tiny small medium large gigantic )], ); for my $fixed_size_groups ( combine( $fixed_size, @groups ) ) { Algorithm::Loops::NestedLoops $fixed_size_groups, sub { print "@_\n"; }; }
Re: Challenge: Generate fixed size combination across groups without duplicates
by Khen1950fx (Canon) on Nov 16, 2011 at 15:35 UTC
    I tried Math::Combinatorics:
    #!/usr/bin/perl use strict; use warnings; use Math::Combinatorics; my(@aoa) = ( qw(A B C), qw(1 2 3 4), qw(yellow blue green), qw(tiny small medium large gigantic), ); my @n = combine(2, @aoa); print "[", join(", ", @$_), "]\n" for @n;
      Khen1950fx,
      This fails to produce a correct solution. The last output is: [large, gigantic] which is two items from the same group.

      Cheers - L~R

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://938298]
Approved by BrowserUk
Front-paged by davido
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others perusing the Monastery: (9)
As of 2014-04-16 05:59 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    April first is:







    Results (414 votes), past polls