Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
PerlMonks  

combinations of VARYING multiple arrays

by Anonymous Monk
on Nov 16, 2010 at 14:51 UTC ( #871750=perlquestion: print w/ replies, xml ) Need Help??
Anonymous Monk has asked for the wisdom of the Perl Monks concerning the following question:

Suppose I have a shell script which takes any combination of switches say -a -b -c -d -e (but these are mnemonic in practice) all of which take arguments. I want to test the script using various test arguments numbering p(a) thru p(e) e.g. if I have 2 test cases for switch -a then p(a) is 2. Although I also have say 1 "break it" test for option -a.

In fact I have 220 shell scripts to test whose allowed switches overlap, but if I can make just one test for one script then I can figure out later how to replicate the process.

So I would configure the first test using a hash like:

%valid = ( 'a' => { goodcase => [ 'a1Case', 'a2Case', ... 'aNGoodaCase +' ], badcase => [ 'a1BadaCase', ..., 'aNBadaCase' ] }, etc. );
So how do I generate all combinations of switches, good cases and badcases?, bearing in mind that different options require different sets of cases (of differing cardinality) to test them.

I know I probably need something like Algorithm::Loops, but I can't fit the module to the particular requirement in my head because of the varying counts i.e. it's not the standard combination of multiple arrays situation published elsewhere on this site. There are additional issues such as managing conflicting option choices and generating test data that works for options in combination, but I have to start somewhere and this seems the most salient obstacle.

Thanks for any help!

-S

Comment on combinations of VARYING multiple arrays
Download Code
Re: combinations of VARYING multiple arrays
by tod222 (Pilgrim) on Nov 16, 2010 at 17:43 UTC
      The problem isnt which module but how to call the module recursively to manage nested dynamic sets. I think the constructor for Algorithm::Loops, say, has to be called in a recursive routine that exhausts the different sets being permuted. But that is going to be very slow so I hesitate to put that as a serious solution. I have to think on! Update: maybe traverse with Parse::RecDescent and have that permute each set encountered.

      One world, one people

Re: combinations of VARYING multiple arrays
by SimonClinch (Chaplain) on Nov 18, 2010 at 14:53 UTC
    The set of numbers from 0 to 2^N-1 represents all combinations of N items. 0 represents the empty combination and 2^N-1 is the complete combination of all N items. So we already cycle through the possibilities for a single set just by adding 1 and unpacking the number from binary into a selection mask. To iterate all combinations selected from a tree instead of a flat set, without flattening the selections, we therefore simply have to extend the concept of a register or memory address or scalar in perl to be a matching tree of values. This can be done simply by adding an extra scalar at each node of the structure, we'll call this a combination register, and incrementing it with the carry rule that when it reaches 2^N-1 (where N is the number of elements locally in the set)it reverts to zero and one is added to the parent's combination register. When the outer register reaches 2^N+1 (N being the local cardinality), all combinations will have been iterated. So for example, if a local combination register has value 5, this unpacks to 0 ... 0 1 0 1, so we select the first and third items in the local list as the current combination. These have substructures to be iterated as well of course. When they have been exhaustively iterated by simple recursion we increment and go to 6 = 1 1 0 and repeat until the local register reaches 2^N+1. If it is a low level register, we will set back to 0, the parent will increment and if below its 2^N+1 and then reiterate us through all our local combinations. For example:-
    package testpack; sub new { my $ppref = {}; my $instance = { TSTPRFL => $ppref }; %$ppref = ( configid => { good => { 'identifier' => [ { 'goodconfig' => 0} +, ], }, bad => { 'identifier' => [ { '987nonexist789' => 13}, ], }, }, fileonly => { good => { 'file' => [ {'testfilename.tst' => 0}, + ] }, bad => { '/usr/bin/perl' => '', '987nonexist789.tst' => 1, }, }, fullpath1 => {good => { '/home/me/testfiles/testfilename.tst' => 0, }, bad => { '987nonexist789.tst' => 1, 'testfilename.tst' => '', }, }, # and so on for all testcases ); return bless $instance; } sub tst { my $self = shift; my %opts = @_; my $script = $opts{ script }; $self -> infest( $opts{ options } ); $self -> { options } = $opts{ options }; do { $self -> tstCombi; } while( $self -> nextCombi ); } sub tstCombi { my $self = shift; # the combination to be tested here is # indicated by the current mask values in the # test configuration structure you created and # then infested with combination registers and maxima } sub infest { # infest a structure with combination registers # and pre-count each set for efficiency and store its max of +2**N-1 my $self = shift; my $ref = shift; my $count = 0; if ( ref( $ref ) eq 'HASH' ) { while ( my ( $k, $v ) = each %$ref ) { $self -> infest( $v ); $k =~ /^\_/ or $count++; } $ref -> { _reserved_combi } = 0; $ref -> { _reserved_limit } = (2**$count) - 1 ; } elsif ( ref( $ref ) eq 'ARRAY' ) { for my $v ( @$ref ) { $self -> infest( $v ); ref( $v ) eq 'SCALAR' and $count++; } push @$ref, { _reserved_combi => 0, _reserved_limit => ( 2 ** $count ) - 1 }; } } sub nextCombi { my $self = shift; $self -> increment ( $self -> { options } ); } sub increment { my $self = shift; my $node = shift; if ( ref( $node ) eq 'HASH' ) { for my $k ( sort ( grep !/^\_/, ( keys %$node ))) { $self -> increment( $node -> { $k } ) and return 1; } if ( $node -> { _reserved_combi } == $node -> { _reserved_limi +t } ) { return ( $node -> { _reserved_combi } = 0 ); } else { return ( $node -> { _reserved_combi } ++ ); } elsif ( ref( $node ) eq 'ARRAY' ) { if ( $node -> [ $#node ]{ _reserved_combi } == $node -> [ $#node ]{ _reserved_limit } ) { return ( $node -> [ $#node ]{ _reserved_combi } = 0 ); } else { return ( $node -> [ $#node ]{ _reserved_combi } ++ ); } } die "something went wrong with the structure"; } 1;

    One world, one people

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others wandering the Monastery: (4)
As of 2014-11-26 00:22 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My preferred Perl binaries come from:














    Results (160 votes), past polls