Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask
 
PerlMonks  

(Golf) Per Mutations

by MeowChow (Vicar)
on May 03, 2001 at 23:45 UTC ( #77751=perlmeditation: print w/ replies, xml ) Need Help??

Another deceptively easy challenge: compose a golfed sub that takes an arbitrary list, and returns a list of all arrays that are permutations of that list. My best attempt is currently 72 chars:

sub p {@_?do{my$x=pop;map{my@l=@$_;map[@l[0..$_-1],$x,@l[$_..$#l]],0..@l}&p}:[]}

p(1, 2, 3) should return: ( [3, 2, 1], [2, 3, 1], [2, 1, 3], [3, 1, 2], [1, 3, 2], [1, 2, 3] )
Extra Credit: Produce a non-recursive solution.
   MeowChow                                   
               s aamecha.s a..a\u$&owag.print

Comment on (Golf) Per Mutations
Select or Download Code
Re: (Golf) Per Mutations
by arhuman (Vicar) on May 04, 2001 at 02:09 UTC
    You're too good for me !
    My best one is 85 (between curly brackets).
    sub t{!@_&&print@r,"\n";for my $i(0..$#_){push@r,$_[$i];t(@_[0..$i-1], +@_[$i+1..$#_]);pop@r}}

    "Only Bad Coders Badly Code In Perl" (OBC2IP)
      Perhaps you'll be able to knock off a few more chars, since the sub isn't supposed to print anything - it only needs to return the data structure specified in the problem description.

      A brief reduction of this sub gives 79 chars though:

      sub t{!@_&&print@r,"\n";for my$i(1..@_){push@r,$_[$i-1];t(@_[0..$i-2,$ +i..$#_]);pop@r}}
         MeowChow                                   
                     s aamecha.s a..a\u$&owag.print
        Well done !
        But you should know that I leave a space between my and $i to get rid of a:
        'Missing $ on loop variable' error message with my Perl(5.0 patchlevel 5 subversion 3 on linux)

        "Only Bad Coders Badly Code In Perl" (OBC2IP)
Re: (Golf) Per Mutations
by Masem (Monsignor) on May 04, 2001 at 03:03 UTC
    57!
    #!/usr/bin/perl -w use strict; use Data::Dumper; my @b = p(1,2,3,4); print Dumper( @b ); sub p { $#_<1?[@_]:map{my$a=$_;map{[$a,@$_]}p(grep{$_!=$a}@_)}@_ }


    Dr. Michael K. Neylon - mneylon-pm@masemware.com || "You've left the lens cap of your mind on again, Pinky" - The Brain
      Awesome :) We can even bring that down to 49:
      sub p { @_?map{my$a=$_;map[$a,@$_],p(grep$_!=$a,@_)}@_:[] }
         MeowChow                                   
                     s aamecha.s a..a\u$&owag.print
        Make that 48:
        sub p { @_?map{my$a=$_;map[$a,@$_],p(grep$_^$a,@_)}@_:[] }
      Didn't the rules say arbitrary list? Try this with the list (1,2,3,1) and you get incorrect output.

      However here is another 57 char solution that does not suffer from this deficiency.

      sub p{ @_?map{my$x=shift;@r=map[$x,@$_],&p;push@_,$x;@r}1..@_:[] }
Re: (Golf) Per Mutations
by wardk (Deacon) on May 04, 2001 at 04:30 UTC
Re: (Golf) Per Mutations
by Masem (Monsignor) on May 04, 2001 at 18:57 UTC
    A non-recursive solution, 138 characters, and doesn't suffer from problems with repeated elements.
    #!/usr/bin/perl -w use strict; use Data::Dumper; my @b = p( 1, 2, 3 ); print Dumper( @b ); sub p { my@a=[];for(0..@_){@a=map{my@b=@$_;my@c=@_;for(@b){my$e=$_;for(1..@c +){my$d=shift@c;last if$d eq$e;push @c,$d}}@c?map{[@b,$_]}@c:[@b]}@a}@ +a }

    Dr. Michael K. Neylon - mneylon-pm@masemware.com || "You've left the lens cap of your mind on again, Pinky" - The Brain
      Non-recursive, handles repeated elements?
      sub permute{ @r=[];$e=$_,@r=map{@a=@$_;map{@b=@a;splice(@b,$_,0,$e);[@b]}0..@a}@r f +or@_;@r }
      77 chars...

      UPDATE
      75...

      sub permute{ @r=[];$e=$_,@r=map{@a=@$_;map[@a[0..$_-1],$e,@a[$_..$#a]],0..@a}@r for +@_;@r }

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlmeditation [id://77751]
Approved by root
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (13)
As of 2014-12-22 14:31 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (119 votes), past polls