Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation

Permutations and combinations

by merlyn (Sage)
on Jul 25, 2000 at 16:49 UTC ( [id://24270]=CUFP: print w/replies, xml ) Need Help??

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
Domain Nodelet?
Node Status?
node history
Node Type: CUFP [id://24270]
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others pondering the Monastery: (5)
As of 2024-05-19 04:50 GMT
Find Nodes?
    Voting Booth?

    No recent polls found