Permutations

Discussion in 'Perl Misc' started by Bertilo Wennergren, Nov 4, 2005.

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

    --
    Bertilo Wennergren <http://bertilow.com>
    Bertilo Wennergren, Nov 4, 2005
    #1
    1. Advertising

  2. Bertilo Wennergren

    John Bokma Guest

    John Bokma, Nov 4, 2005
    #2
    1. Advertising

  3. John Bokma wrote:

    > Bertilo Wennergren <> wrote:


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


    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::permutor::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.

    --
    Bertilo Wennergren <http://bertilow.com>
    Bertilo Wennergren, Nov 4, 2005
    #3
  4. Bertilo Wennergren

    Anno Siegel Guest

    Bertilo Wennergren <> wrote in comp.lang.perl.misc:
    > 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
    --
    If you want to post a followup via groups.google.com, don't use
    the broken "Reply" link at the bottom of the article. Click on
    "show options" at the top of the article, then click on the
    "Reply" at the bottom of the article headers.
    Anno Siegel, Nov 4, 2005
    #4
  5. Bertilo Wennergren

    Anno Siegel Guest

    Anno Siegel <-berlin.de> wrote in comp.lang.perl.misc:
    > Bertilo Wennergren <> wrote in comp.lang.perl.misc:


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


    Oh, sure. Look for "cartesian product".

    Anno
    --
    If you want to post a followup via groups.google.com, don't use
    the broken "Reply" link at the bottom of the article. Click on
    "show options" at the top of the article, then click on the
    "Reply" at the bottom of the article headers.
    Anno Siegel, Nov 4, 2005
    #5
  6. Anno Siegel:

    > Bertilo Wennergren <> wrote in comp.lang.perl.misc:
    >> 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.

    >> Here's my working but probably very inefficient version of the
    >> subroutine:


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

    --
    Bertilo Wennergren <http://bertilow.com>
    Bertilo Wennergren, Nov 4, 2005
    #6
  7. Bertilo Wennergren

    Guest

    Bertilo Wennergren <> wrote:
    > 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

    --
    -------------------- http://NewsReader.Com/ --------------------
    Usenet Newsgroup Service $9.95/Month 30GB
    , Nov 4, 2005
    #7
  8. Bertilo Wennergren wrote:
    > 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, Nov 4, 2005
    #8
  9. Bertilo Wennergren wrote:
    > 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, Nov 4, 2005
    #9
  10. Xho wrote:

    > Bertilo Wennergren <> wrote:
    >> [...]
    >> 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!

    --
    Bertilo Wennergren <http://bertilow.com>
    Bertilo Wennergren, Nov 5, 2005
    #10
    1. Advertising

Want to reply to this thread or ask your own question?

It takes just 2 minutes to sign up (and it's free!). Just click the sign up button to choose a username and then you can ask your own questions on the forum.
Similar Threads
  1. Karsten Wutzke

    Permutations of instances in array

    Karsten Wutzke, Mar 2, 2004, in forum: Java
    Replies:
    5
    Views:
    17,709
    Chris Lamprecht
    Mar 4, 2004
  2. Hendrik Maryns
    Replies:
    0
    Views:
    336
    Hendrik Maryns
    Mar 3, 2006
  3. Roger
    Replies:
    1
    Views:
    413
    Martin Magnusson
    Sep 24, 2003
  4. Ed Neukirch

    Permutations

    Ed Neukirch, Dec 24, 2003, in forum: C++
    Replies:
    7
    Views:
    605
    Mike Hewson
    Dec 27, 2003
  5. Daniel Fortin
    Replies:
    3
    Views:
    360
    Frank Schmitt
    Feb 18, 2004
Loading...

Share This Page