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

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;
} 
Comment on Permutations and combinations
Download Code
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.

Back to Snippets Section

Log In?
Username:
Password:

What's my password?
Create A New User
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?
Others surveying the Monastery: (8)
As of 2014-07-31 10:16 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (248 votes), past polls