Beefy Boxes and Bandwidth Generously Provided by pair Networks
Come for the quick hacks, stay for the epiphanies.

(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.
               s aamecha.s a..a\u$&owag.print

Replies are listed 'Best First'.
Re: (Golf) Per Mutations
by Masem (Monsignor) on May 04, 2001 at 03:03 UTC
    #!/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 - || "You've left the lens cap of your mind on again, Pinky" - The Brain
      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..@_:[] }
      Awesome :) We can even bring that down to 49:
      sub p { @_?map{my$a=$_;map[$a,@$_],p(grep$_!=$a,@_)}@_:[] }
                     s aamecha.s a..a\u$&owag.print
        Make that 48:
        sub p { @_?map{my$a=$_;map[$a,@$_],p(grep$_^$a,@_)}@_:[] }
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 - || "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...


      sub permute{ @r=[];$e=$_,@r=map{@a=@$_;map[@a[0..$_-1],$e,@a[$_..$#a]],0..@a}@r for +@_;@r }
Re: (Golf) Per Mutations
by wardk (Deacon) on May 04, 2001 at 04:30 UTC
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}}
                     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)

Log In?

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

How do I use this?Last hourOther CB clients
Other Users?
Others exploiting the Monastery: (4)
As of 2023-12-01 06:42 GMT
Find Nodes?
    Voting Booth?

    No recent polls found