Permutations

[Bertilo Wennergren]

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.

 

[John Bokma]

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

 

[Bertilo Wennergren]

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.

 

[Anno Siegel]

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

 

[Anno Siegel]

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

 

[Bertilo Wennergren]

Anno Siegel:

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.

[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.

 

[xhoster]

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).


http://groups.google.com/group/comp.lang.perl.misc/browse_frm/thread/b83886
616f90cc8c


Xho

 

[MrReallyVeryNice]

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
following would meet your requirements:

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]

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
following would meet your requirements:

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

 

[Bertilo Wennergren]

[...]
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).

http://groups.google.com/group/comp.lang.perl.misc/browse_frm/thread/
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:

http://groups.google.com/group/comp.lang.perl.misc/browse_frm/thread/
b83886616f90cc8c

Thanks for all the input!