P is for Practical PerlMonks

Permutations and combinations

by merlyn (Sage)
 on Jul 25, 2000 at 16:49 UTC Need Help??
 Description: Here's a couple of code snippets I keep handy when I want to generate all combinations (no replacement) and permutations (all possible ways of combining a list of varying things). Enjoy. You can probably see that I speak Perl with a lisp sometimes.
```
print "permute:\n";
print "[", join(", ", @\$_), "]\n" for permute([1,2,3], [4,5,6], [7,8,9
+]);
print "combinations:\n";
print  "[", join(", ", @\$_), "]\n" for combinations(1..5);

sub permute {
my \$last = pop @_;
unless (@_) {
return map [\$_], @\$last;
}
return map { my \$left = \$_; map [@\$left, \$_], @\$last } permute(@_);
}
sub combinations {
return [] unless @_;
my \$first = shift;
my @rest = combinations(@_);
return @rest, map { [\$first, @\$_] } @rest;
}
```
Replies are listed 'Best First'.
RE: Permutations and combinations
by AltBlue (Chaplain) on Aug 21, 2000 at 13:19 UTC
interesting approach that reminded me about some old project that needed some permutations generations stuff... so, i've checked up that code and here i come with a reviewed standalone version:
```#!/usr/bin/perl -w
# DESCRIPTION: Generate permutations in lexicographic order
#       USAGE: ./permlex.pl <term1> <term2> <term3> .....

use strict;

die "bleah... nothing to permutate\n" if \$#ARGV<0;
my @terms = @ARGV; my \$n = \$#ARGV; my @a = (0..\$n);
genperm(); exit(0);

sub genperm {
print join(" ",@terms[@a]),"\n";
my (\$k,\$j) = (\$n-1,\$n);
\$k-- while (\$k>=0 and \$a[\$k]>\$a[\$k+1]);
return(0) if (\$k<0);
\$j--    while (\$a[\$k]>\$a[\$j]);
swap(\$j,\$k++); \$j=\$n;
swap(\$j--,\$k++) while (\$j>\$k);
genperm();
}

sub swap {
my (\$i,\$j) = @_; my \$t = \$a[\$i];
(\$a[\$i],\$a[\$j]) = (\$a[\$j],\$t);
}

as you may see, it's a pure lexicographic permutations generator algorithm, as in the books ;-)

oh, not to forget, just checked up on cpan and found out there is a Algorithm::Permute module. here is a lame example for module users ;-)

```#!/usr/bin/perl -w
use strict;
die "bleah... nothing to permutate\n" unless defined @ARGV;
use Algorithm::Permute qw(permute permute_ref);
print join(" ", @\$_), "\n" for permute(\@ARGV);

--
AltBlue.

your sub swap can be written without \$t:
```sub swap {
my (\$i,\$j) = @_;
@a[\$i,\$j] = @a[\$j,\$i];
}
lol, you bother to look upon this old piece of code :))

heh, of course that your snippet is good, but a swap routine could be written even simpler:

```sub swap { reverse @_ }
... heh, it's not the case for that code thou, as the array is a global one :) cheers.

--
AltBlue.

Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: snippet [id://24270]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?