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

Non- recursive permutation of arrays.

by shotgunefx (Parson)
on Mar 25, 2002 at 03:32 UTC ( #154008=snippet: print w/replies, xml ) Need Help??
Description: Takes a list or array of array references and returns a function that will return successive permutations of the referenced arrays. Avoids recursion so will work on abitrarily huge sets of data. Runtime scales linearly with the number of sets. Minimal memory usage.
my @aoa = (

my $iter = make_permutator(@aoa);

while (my @els = $iter->() ){
    print @els,"\n";

sub make_permutator{
    my @arefs = @_;
    my @arrayindexes = ();
    foreach (@arefs){
        push @arrayindexes,[$_,0,$#{$_}];
    return sub {
            return if $arrayindexes[0]->[1] > $arrayindexes[0]->[2]; 
            my @els =  map { $_->[0]->[ $_->[1]] } @arrayindexes;
            # Check for out of bounds....
            for (my $i = $#arrayindexes; $i > 0; $i--){
                    if ($arrayindexes[$i]->[1] > $arrayindexes[$i]->[2
                        $arrayindexes[$i]->[1] = 0;
            return @els;
Replies are listed 'Best First'.
Re: Non- recursive permutation of arrays.
by ariels (Curate) on Mar 25, 2002 at 08:08 UTC

    Or, you could just count up to the product of the array sizes, and use the count to compute the offsets into the arrays (I think a note described this, but no code). If you have lists of lengths l1,...,lk, think of the numbers 0..(l1*...*lk-1). You want to convert them to a variable-base number system, where the first digit can be 0..l1-1, the second digit can be 0..l2-1,...

    #!/usr/local/bin/perl -w use strict; my @aoa = ( [('a'..'f')], [('A'..'C')], [(1..2)], ); my $iter = make_permutator(@aoa); while (my @els = $iter->() ){ print "@els\n"; } # ariels' code from here sub make_permutator { use integer; my @idx_link = (0, @_); return sub { my $idx = $idx_link[0]++; my @ret; for my $i (1..$#idx_link) { push @ret, $idx_link[$i][$idx % @{$idx_link[$i]}]; $idx /= @{$idx_link[$i]}; } return $idx ? () : @ret; } }
      Interesting take. That way solution wouldn't have occured to me. I do think it's a bit more obfu though. I had to stare at it for a minute (Maybe just me though!). The best thing (IMHO) about Perl is how many different ways you can accomplish a single goal.


      "To be civilized is to deny one's nature."
Log In?

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: snippet [id://154008]
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (5)
As of 2023-12-10 00:39 GMT
Find Nodes?
    Voting Booth?
    What's your preferred 'use VERSION' for new CPAN modules in 2023?

    Results (38 votes). Check out past polls.