# Permutations

Discussion in 'Perl Misc' started by Bertilo Wennergren, Nov 4, 2005.

1. ### Bertilo WennergrenGuest

As part of an application I had to solve a permutations problem
that gave me much more trouble than I had anticipated. I did
solve the problem, but I have a very strong feeling that my
solution is very far from the best one. It seems very cumbersome
and inefficient. If anyone has any ideas on how to do this in a
better way, I'd be glad for some input.

Here's what I want to do:

#!/usr/bin/perl -w
use strict;

my @numbers = (
[ 1, 2, 3, ],
[ 4, 5, ],
[ 6, 7, ],
);

my \$permutations = CreatePermutations(\@numbers);

for (@\$permutations) {
print \$_ . "\n";
}

sub CreatePermutations {
my \$numbers = shift;
my @permutations;
# Magic stuff goes here!
return \@permutations;
}

The print result should be this exciting bunch of numbers:

1 4 6
1 4 7
1 5 6
1 5 7
2 4 6
2 4 7
2 5 6
2 5 7
3 4 6
3 4 7
3 5 6
3 5 7

As you can see the program lists all possible permutations of
picking one number from each group of numbers in the array
"@numbers". The problem for me was that the subroutine
"CreatePermutations" must work for any number of groups, and for
any number of numbers in each group (at least one group though,
and at least one number in each group).

Here's my working but probably very inefficient version of the
subroutine:

sub CreatePermutations {
my \$numbers = shift;

my @permutations;
my \$h = 1;
for (@\$numbers) {
\$h = \$h * @\$_;
}
\$#permutations = \$h-1;

for (my \$i = 0; \$i < @\$numbers; \$i++) {
my \$k = 1;
my \$l = 0;
my \$m = 0;
for (my \$j = \$i+1; \$j < @\$numbers; \$j++) {
\$k = \$k * @{\$\$numbers[\$j]};
}
for (@permutations) {
\$_ .= \${\$\$numbers[\$i]}[\$l] . ' ';
\$m++;
if (\$m == \$k) {
\$l++;
if (\$l > @{\$\$numbers[\$i]}-1) {
\$l = 0;
}
\$m = 0;
}
}
}
return \@permutations;
}

Any ideas on how to do that in a better way? The major issue is
speed since the number of permutations rise quickly when there
are lots of groups with lots of numbers.

--
Bertilo Wennergren <http://bertilow.com>

Bertilo Wennergren, Nov 4, 2005

2. ### John BokmaGuest

John Bokma, Nov 4, 2005

3. ### Bertilo WennergrenGuest

John Bokma wrote:

> Bertilo Wennergren <> wrote:

>> Any ideas on how to do that in a better way?

> Yup, don't invent wheels:
> http://search.cpan.org/search?query=permutation&mode=all

I did look in CPAN for permutation modules before, but I couldn't find
anything that actually does the kind of permutation that I'm looking for.
Either that, or I misunderstood the explanations that I read.

I did look through the list you indicated again, but I still can't find
anything that fits my bill. "List:ermutor::LOL" at first seems to be the
right choice, but a closer look shows that it does something entirely
different.

If one of those modules actually does the kind of permutation I asked about,
then I'd be happy for a pointer.

--
Bertilo Wennergren <http://bertilow.com>

Bertilo Wennergren, Nov 4, 2005
4. ### Anno SiegelGuest

Bertilo Wennergren <> wrote in comp.lang.perl.misc:
> As part of an application I had to solve a permutations problem
> that gave me much more trouble than I had anticipated. I did
> solve the problem, but I have a very strong feeling that my
> solution is very far from the best one. It seems very cumbersome
> and inefficient. If anyone has any ideas on how to do this in a
> better way, I'd be glad for some input.
>
> Here's what I want to do:
>
> #!/usr/bin/perl -w
> use strict;
>
> my @numbers = (
> [ 1, 2, 3, ],
> [ 4, 5, ],
> [ 6, 7, ],
> );
>
> my \$permutations = CreatePermutations(\@numbers);

[...]

> The print result should be this exciting bunch of numbers:
>
> 1 4 6
> 1 4 7
> 1 5 6
> 1 5 7
> 2 4 6
> 2 4 7
> 2 5 6
> 2 5 7
> 3 4 6
> 3 4 7
> 3 5 6
> 3 5 7

Well, these aren't permutations. (In permutations you consider all
possible orderings of the elements of a single set.) Combinatorics
certainly has a term for what you are doing, but I don't remember
what it is. That would be the key to finding a solution on
CPAN. Combinatorics being as popular as it is, I'm sure there
is one.

> Here's my working but probably very inefficient version of the
> subroutine:

[snip code with lots of array-indexing]

In Perl you're usually better off treating arrays as sequences of elements
instead of something that associates an index with a value. Here is a
recursive solution along these lines:

my @numbers = (
[ 1, 2, 3, ],
[ 4, 5, ],
[ 6, 7, ],
);

print "@\$_\n" for combine( @numbers);
exit;

sub combine {
my ( \$first, @rest) = @_;
return map [ \$_], @\$first unless @rest;
my @res;
for my \$part ( combine( @rest) ) {
push @res, map [ \$_, @\$part], @\$first;
}
return @res;
}

It lists the result in a different order than yours. If you must
have them in that order, the code is slightly longer:

sub combine {
my ( \$first, @rest) = @_;
return map [ \$_], @\$first unless @rest;
my @res;
my @part = combine( @rest);
for my \$el ( @\$first ) {
push @res, map [ \$el, @\$_], @part;
}
return @res;
}

Anno
--
If you want to post a followup via groups.google.com, don't use
the broken "Reply" link at the bottom of the article. Click on
"show options" at the top of the article, then click on the

Anno Siegel, Nov 4, 2005
5. ### Anno SiegelGuest

Anno Siegel <-berlin.de> wrote in comp.lang.perl.misc:
> Bertilo Wennergren <> wrote in comp.lang.perl.misc:

> > The print result should be this exciting bunch of numbers:
> >
> > 1 4 6
> > 1 4 7
> > 1 5 6
> > 1 5 7
> > 2 4 6
> > 2 4 7
> > 2 5 6
> > 2 5 7
> > 3 4 6
> > 3 4 7
> > 3 5 6
> > 3 5 7

>
> Well, these aren't permutations. (In permutations you consider all
> possible orderings of the elements of a single set.) Combinatorics
> certainly has a term for what you are doing, but I don't remember
> what it is.

Oh, sure. Look for "cartesian product".

Anno
--
If you want to post a followup via groups.google.com, don't use
the broken "Reply" link at the bottom of the article. Click on
"show options" at the top of the article, then click on the

Anno Siegel, Nov 4, 2005
6. ### Bertilo WennergrenGuest

Anno Siegel:

> Bertilo Wennergren <> wrote in comp.lang.perl.misc:
>> As part of an application I had to solve a permutations problem
>> [...]

> Well, these aren't permutations. (In permutations you consider all
> possible orderings of the elements of a single set.) Combinatorics
> certainly has a term for what you are doing, but I don't remember
> what it is. That would be the key to finding a solution on
> CPAN. Combinatorics being as popular as it is, I'm sure there
> is one.

> Oh, sure. Look for "cartesian product".

Oh. Thank you.

>> Here's my working but probably very inefficient version of the
>> subroutine:

> [snip code with lots of array-indexing]

Yes, all those indexes really bothered me.

> In Perl you're usually better off treating arrays as sequences of elements
> instead of something that associates an index with a value. Here is a
> recursive solution along these lines:
> [...]

Thanks a lot! I'll try to understand your code. I'll also benchmark it to
see how much better than my index-ridden code it is. In the meantime I've
got some new ideas how to do it. We'll see what turns out to be the fastest
solution.

--
Bertilo Wennergren <http://bertilow.com>

Bertilo Wennergren, Nov 4, 2005
7. ### Guest

Bertilo Wennergren <> wrote:
> As part of an application I had to solve a permutations problem
> that gave me much more trouble than I had anticipated.

....
>
> Here's what I want to do:
>
> #!/usr/bin/perl -w
> use strict;
>
> my @numbers = (
> [ 1, 2, 3, ],
> [ 4, 5, ],
> [ 6, 7, ],
> );
>

....
> The print result should be this exciting bunch of numbers:
>
> 1 4 6
> 1 4 7
> 1 5 6
> 1 5 7

Those aren't really permuations, because the order is not varied.
I think it would be more of combinatorics, but that also might not
be exactly right. In databases, it would be cartesian join.

> Any ideas on how to do that in a better way? The major issue is
> speed since the number of permutations rise quickly when there
> are lots of groups with lots of numbers.

That being the case, I would think that memory usage would be much
more of an issue than speed. Your code is building the entire set in
memory.

A couple years ago I posted a module here that does what you want as an
iterator, so it doesn't hog memory. (There may be something on CPAN that
does this, too, but it is easier for me to google my own code).

616f90cc8c

Xho

--
Usenet Newsgroup Service \$9.95/Month 30GB

, Nov 4, 2005
8. ### MrReallyVeryNiceGuest

Bertilo Wennergren wrote:
> As part of an application I had to solve a permutations problem
> that gave me much more trouble than I had anticipated. I did
> solve the problem, but I have a very strong feeling that my
> solution is very far from the best one. It seems very cumbersome
> and inefficient. If anyone has any ideas on how to do this in a
> better way, I'd be glad for some input.
>
> Here's what I want to do:
>

DELETED CODE
>
> The print result should be this exciting bunch of numbers:
>
> 1 4 6
> 1 4 7
> 1 5 6
> 1 5 7
> 2 4 6
> 2 4 7
> 2 5 6
> 2 5 7
> 3 4 6
> 3 4 7
> 3 5 6
> 3 5 7
>
> As you can see the program lists all possible permutations of
> picking one number from each group of numbers in the array
> "@numbers". The problem for me was that the subroutine
> "CreatePermutations" must work for any number of groups, and for
> any number of numbers in each group (at least one group though,
> and at least one number in each group).
>
> Here's my working but probably very inefficient version of the
> subroutine:
>

DELETED CODE
> }
>
> Any ideas on how to do that in a better way? The major issue is
> speed since the number of permutations rise quickly when there
> are lots of groups with lots of numbers.
>

I did not benchmark my code or yours and I did not test my code fully. I
believe that my code would require less memory because it is not storing
anything in an array before printing the results. It seems that the

use strict;
use warnings;

my \$string1 = '123';
my \$string2 = '45';
my \$string3 = '67';

for ("000" .. "999")
{
my \$s1 = substr(\$_,0,1);
my \$s2 = substr(\$_,1,1);
my \$s3 = substr(\$_,2,1);
if ( grep(/\$s1/, \$string1) && grep(/\$s2/, \$string2) && grep(/\$s3/,
\$string3))
{
print \$s1 . " " . \$s2 . " " . \$s3 ."\n";
}
}

This code assumes that:
1. you only have numbers in your "permutation" (\$string1 = '1A23'; would
not work in the sense that it would ignore the character 'A')
2. it ignores strings with the same number listed more than once
(\$string1 = '1231114' I think that the result should ignore these
repetitive characters but I'm not really sure what you mean by
'permutations'.

Expanding my code for any number of groups, any numbers in each group
should not be too difficult.

MrReallyVeryNice

MrReallyVeryNice, Nov 4, 2005
9. ### MrReallyVeryNiceGuest

Bertilo Wennergren wrote:
> As part of an application I had to solve a permutations problem
> that gave me much more trouble than I had anticipated. I did
> solve the problem, but I have a very strong feeling that my
> solution is very far from the best one. It seems very cumbersome
> and inefficient. If anyone has any ideas on how to do this in a
> better way, I'd be glad for some input.
>
> Here's what I want to do:
>

DELETED CODE
>
> The print result should be this exciting bunch of numbers:
>
> 1 4 6
> 1 4 7
> 1 5 6
> 1 5 7
> 2 4 6
> 2 4 7
> 2 5 6
> 2 5 7
> 3 4 6
> 3 4 7
> 3 5 6
> 3 5 7
>
> As you can see the program lists all possible permutations of
> picking one number from each group of numbers in the array
> "@numbers". The problem for me was that the subroutine
> "CreatePermutations" must work for any number of groups, and for
> any number of numbers in each group (at least one group though,
> and at least one number in each group).
>
> Here's my working but probably very inefficient version of the
> subroutine:
>

DELETED CODE
> }
>
> Any ideas on how to do that in a better way? The major issue is
> speed since the number of permutations rise quickly when there
> are lots of groups with lots of numbers.
>

I did not benchmark my code or yours and I did not test my code fully. I
believe that my code would require less memory because it is not storing
anything in an array before printing the results. It seems that the

use strict;
use warnings;

my \$string1 = '123';
my \$string2 = '45';
my \$string3 = '67';

for ("000" .. "999")
{
my \$s1 = substr(\$_,0,1);
my \$s2 = substr(\$_,1,1);
my \$s3 = substr(\$_,2,1);
if ( grep(/\$s1/, \$string1) && grep(/\$s2/, \$string2) && grep(/\$s3/,
\$string3))
{
print \$s1 . " " . \$s2 . " " . \$s3 ."\n";
}
}

This code assumes that:
1. you only have numbers in your "permutation" (\$string1 = '1A23'; would
not work in the sense that it would ignore the character 'A')
2. it ignores strings with the same number listed more than once
(\$string1 = '1231114' I think that the result should ignore these
repetitive characters but I'm not really sure what you mean by
'permutations'.

Expanding my code for any number of groups, any numbers in each group
should not be too difficult.

MrReallyVeryNice

MrReallyVeryNice, Nov 4, 2005
10. ### Bertilo WennergrenGuest

Xho wrote:

> Bertilo Wennergren <> wrote:
>> [...]
>> The print result should be this exciting bunch of numbers:
>>
>> 1 4 6
>> 1 4 7
>> 1 5 6
>> 1 5 7

>> Any ideas on how to do that in a better way? The major issue is
>> speed since the number of permutations rise quickly when there
>> are lots of groups with lots of numbers.

> That being the case, I would think that memory usage would be much
> more of an issue than speed. Your code is building the entire set in
> memory.

OK. I'll have to watch out for that.

> A couple years ago I posted a module here that does what you want as an
> iterator, so it doesn't hog memory. (There may be something on CPAN that
> does this, too, but it is easier for me to google my own code).
>
>b83886616f90cc8c

Perfect. That thread deals with the exact same problem that I have.

I tried out most of the solutions there, including your nice one, and also a
crazy new idea of my own. It turned out that my original code wasn't bad at
all, which really surprised me. However, I finally tried the simple and
elegant solution offered by "bd", and that turned out to be the fastest one
by far: