Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical

Permutations and combinations

by merlyn (Sage)
on Jul 25, 2000 at 16:49 UTC ( #24270=snippet: print w/replies, xml ) 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: ./ <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);


      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.


Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: snippet [id://24270]
GotToBTru thinks erix & MySql ... talk about a database trigger
[GotToBTru]: wow .. outta votes and it's not even lunchtime yet
[stevieb]: berrybrew has been updated with the new perl checksums. Now I'm going to implement dynamic loading of perls thanks to their new JSON releases file

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (15)
As of 2017-03-30 15:56 GMT
Find Nodes?
    Voting Booth?
    Should Pluto Get Its Planethood Back?

    Results (360 votes). Check out past polls.