Beefy Boxes and Bandwidth Generously Provided by pair Networks
go ahead... be a heretic

Conglomerate of arrays with no duplicates

by saberworks (Curate)
on Jan 30, 2004 at 23:37 UTC ( #325451=perlquestion: print w/replies, xml ) Need Help??
saberworks has asked for the wisdom of the Perl Monks concerning the following question:

Banging my head over this all day. Basically, I have a list of products (an arbitrary list stored in a database), which I pull out into an array called @products. Each product can have a number of attributes, as shown below. I made a simple loop to go through colors and sizes and print exactly what I'm look for in terms of output. Unfortunately, the number of attributes is also arbitrary, so there could be sizes, colors, styles, flair, etc. So I need to come up with a way to print the list of products with every available option dynamically. Here is the simple code that prints what I want.
#!/usr/bin/perl use strict; my @products = ('tshirt', 'pants', 'sweatshirt'); my @sizes = ('small', 'medium', 'large'), my @colors = ('red', 'green', 'blue'); foreach my $product (@products) { foreach my $size (@sizes) { foreach my $color (@colors) { print "$product $size $color\n"; } } }
Here is the output I want
tshirt small red
tshirt small green
tshirt small blue
tshirt medium red
tshirt medium green
tshirt medium blue
tshirt large red
tshirt large green
tshirt large blue
pants small red
pants small green
pants small blue
pants medium red
pants medium green
pants medium blue
pants large red
pants large green
pants large blue
sweatshirt small red
sweatshirt small green
sweatshirt small blue
sweatshirt medium red
sweatshirt medium green
sweatshirt medium blue
sweatshirt large red
sweatshirt large green
sweatshirt large blue
Here is an example (%options) of the structure I will be building dynamically from the database. I am simply stuck on how to get from this structure to the output listed above! Any help would be greatly appreciated. Please note that the hard part seems to be the fact that the %options has can grow and shrink!
my @products = ('tshirt', 'pants', 'sweatshirt'); my %options = ( 'sizes' => ['small', 'medium', 'large'], 'colors' => ['red', 'green', 'blue'] );

Replies are listed 'Best First'.
Re: Conglomerate of arrays with no duplicates
by Limbic~Region (Chancellor) on Jan 31, 2004 at 00:03 UTC
    I believe this does what you want and more:
    #!/usr/bin/perl use strict; use warnings; use Algorithm::Loops qw( NestedLoops ); my @products = qw(tshirt pants sweatshirt socks shoes); my %options = ( sizes => [ qw(small medium large extra-large) ], colors => [ qw(red green blue) ], brands => [ qw(foo bar blah asdf) ] ); my @Loops; push @Loops , \@products; push @Loops , $options{$_} for keys %options; my $iter = NestedLoops( \@Loops ); my @combo; print "@combo\n" while ( @combo = $iter->() );
    Cheers - L~R
Re: Conglomerate of arrays with no duplicates
by Roger (Parson) on Jan 31, 2004 at 00:17 UTC
    You could use Set::CrossProduct.

    use strict; use warnings; use Set::CrossProduct; my @products = ('tshirt', 'pants', 'sweatshirt'); my %options = ( 'sizes' => ['small', 'medium', 'large'], 'colors' => ['red', 'green', 'blue'] ); # build an array of array my @p = (); push @p, \@products; push @p, $options{$_} for sort keys %options; # get all combinations my $iterator = Set::CrossProduct->new( \@p ); # print the combinations local $, = ' '; print "@$_\n" for (@{$iterator->combinations});

Re: Conglomerate of arrays with no duplicates
by saberworks (Curate) on Jan 31, 2004 at 02:12 UTC
    Thanks Limbic~Region and Roger, both of those solutions work flawlessly. I really appreciate the help.
Re: Conglomerate of arrays with no duplicates
by ysth (Canon) on Feb 01, 2004 at 09:04 UTC
    I can't resist the opportunity to post an Abigailish solution:
    $" = ','; $\ = "\n"; print for <{@products},@{[map "{@$_}", values %options]}>;
      Why does this script break if I change $" back to a space?
        For two reasons. It produces , within {} that must stay that way, and glob("foo bar") produces "foo","bar"; I don't know if there's a way to escape that space. I meant to put in a post-process y/,/ / but forgot.

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://325451]
Approved by Roger
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others scrutinizing the Monastery: (7)
As of 2017-05-28 13:27 GMT
Find Nodes?
    Voting Booth?