(Golf) Per Mutations

[MeowChow]

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

[Masem]

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 - [e-mail] || "You've left the lens cap of your mind on again, Pinky" - The Brain

[tilly]

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..@_:[]
}

[MeowChow]

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

[dws]

Make that 48:

sub p
{
  @_?map{my$a=$_;map[$a,@$_],p(grep$_^$a,@_)}@_:[]
}

[Masem]

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 - [e-mail] || "You've left the lens cap of your mind on again, Pinky" - The Brain

[tilly]

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
}

[wardk]

Apologies to Abigail... http://www.foad.org/~abigail/Perl/Combinatorial/Permutations.pm

#!/bin/perl
use Combinatorial::Permutations;
my @t = p(1,2,3);
foreach $p (@t) { print @$p, "\n"; }

sub p { 
    return Permutations::permutate(@_); 
} 
------
xdev$ ./perm.pl
123
213
231
132
312
321

[arhuman]

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)

[MeowChow]

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

[arhuman]

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)