Keep It Simple, Stupid PerlMonks

### (Golf) Per Mutations

by MeowChow (Vicar)
 on May 03, 2001 at 23:45 UTC 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```

Replies are listed 'Best First'.
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
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,@_)}@_:[]
}
```   MeowChow
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 - 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
}
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}}

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)

Create A New User
Domain Nodelet?
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 meditating upon the Monastery: (7)
As of 2023-09-28 14:16 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?

No recent polls found

Notices?