Permutations by swapping

From Rosetta Code
Jump to: navigation, search
Task
Permutations by swapping
You are encouraged to solve this task according to the task description, using any language you may know.

Generate permutations of n items in which successive permutations differ from each other by the swapping of any two items. Also generate the sign of the permutation which is +1 when the permutation is generated from an even number of swaps from the initial state, and -1 for odd. Show the permutations and signs of three items, in order of generation here.

Such data are of use in generating the determinant of a square matrix and any functions created should bear this in mind.

Note: The Steinhaus–Johnson–Trotter algorithm generates successive permutations where adjacent items are swapped, but from this discussion adjacency is not a requirement.

References
Cf.

Contents

[edit] BBC BASIC

      PROCperms(3)
PRINT
PROCperms(4)
END
 
DEF PROCperms(n%)
LOCAL p%(), i%, k%, s%
DIM p%(n%)
FOR i% = 1 TO n%
p%(i%) = -i%
NEXT
s% = 1
REPEAT
PRINT "Perm: [ ";
FOR i% = 1 TO n%
PRINT ;ABSp%(i%) " ";
NEXT
PRINT "] Sign: ";s%
k% = 0
FOR i% = 2 TO n%
IF p%(i%)<0 IF ABSp%(i%)>ABSp%(i%-1) IF ABSp%(i%)>ABSp%(k%) k% = i%
NEXT
FOR i% = 1 TO n%-1
IF p%(i%)>0 IF ABSp%(i%)>ABSp%(i%+1) IF ABSp%(i%)>ABSp%(k%) k% = i%
NEXT
IF k% THEN
FOR i% = 1 TO n%
IF ABSp%(i%)>ABSp%(k%) p%(i%) *= -1
NEXT
i% = k%+SGNp%(k%)
SWAP p%(k%),p%(i%)
s% = -s%
ENDIF
UNTIL k% = 0
ENDPROC

Output:

Perm: [ 1 2 3 ] Sign: 1
Perm: [ 1 3 2 ] Sign: -1
Perm: [ 3 1 2 ] Sign: 1
Perm: [ 3 2 1 ] Sign: -1
Perm: [ 2 3 1 ] Sign: 1
Perm: [ 2 1 3 ] Sign: -1

Perm: [ 1 2 3 4 ] Sign: 1
Perm: [ 1 2 4 3 ] Sign: -1
Perm: [ 1 4 2 3 ] Sign: 1
Perm: [ 4 1 2 3 ] Sign: -1
Perm: [ 4 1 3 2 ] Sign: 1
Perm: [ 1 4 3 2 ] Sign: -1
Perm: [ 1 3 4 2 ] Sign: 1
Perm: [ 1 3 2 4 ] Sign: -1
Perm: [ 3 1 2 4 ] Sign: 1
Perm: [ 3 1 4 2 ] Sign: -1
Perm: [ 3 4 1 2 ] Sign: 1
Perm: [ 4 3 1 2 ] Sign: -1
Perm: [ 4 3 2 1 ] Sign: 1
Perm: [ 3 4 2 1 ] Sign: -1
Perm: [ 3 2 4 1 ] Sign: 1
Perm: [ 3 2 1 4 ] Sign: -1
Perm: [ 2 3 1 4 ] Sign: 1
Perm: [ 2 3 4 1 ] Sign: -1
Perm: [ 2 4 3 1 ] Sign: 1
Perm: [ 4 2 3 1 ] Sign: -1
Perm: [ 4 2 1 3 ] Sign: 1
Perm: [ 2 4 1 3 ] Sign: -1
Perm: [ 2 1 4 3 ] Sign: 1
Perm: [ 2 1 3 4 ] Sign: -1

[edit] C++

/*
The following code generates the permutations of the first 4 natural numbers.
The permutations are displayed in lexical order, smallest to largest, with appropriate signs
*/

 
#include <iostream>
#include <conio.h>
 
//factorial function
long
fact(int size)
{
int i;
long tmp = 1;
 
if(size<=1)
return 1;
else
for(i = size;i > 0;i--)
tmp *= i;
return tmp;
}
 
 
//function to display the permutations.
void
Permutations(int N)
{
//indicates sign
short sign = 1;
 
//Tracks when to change sign.
unsigned short change_sign = 0;
 
//loop variables
short i = 0,j = 0,k = 0;
 
//iterations
long loops = fact(N);
 
//Array of pointers to hold the digits
int **Index_Nos_ptr = new int*[N];
 
//Repetition of each digit (Master copy)
int *Digit_Rep_Master = new int[N];
 
//Repetition of each digit (Local copy)
int *Digit_Rep_Local = new int[N];
 
//Index for Index_Nos_ptr
int *Element_Num = new int[N];
 
 
//Initialization
for(i = 0;i < N;i++){
//Allocate memory to hold the subsequent digits in the form of a LUT
//For N = N, memory required for LUT = N(N+1)/2
Index_Nos_ptr[i] = new int[N-i];
 
//Initialise the repetition value of each digit (Master and Local)
//Each digit repeats for (i-1)!, where 1 is the position of the digit
Digit_Rep_Local[i] = Digit_Rep_Master[i] = fact(N-i-1);
 
//Initialise index values to access the arrays
Element_Num[i] = N-i-1;
 
//Initialise the arrays with the required digits
for(j = 0;j < N-i;j++)
*(Index_Nos_ptr[i] +j) = N-j-1;
}
 
while(loops-- > 0){
std::cout << "Perm: [";
for(i = 0;i < N;i++){
//Print from MSD to LSD
std::cout << " " << *(Index_Nos_ptr[i] + Element_Num[i]);
 
//Decrement the repetition count for each digit
if(--Digit_Rep_Local[i] <= 0){
//Refill the repitition factor
Digit_Rep_Local[i] = Digit_Rep_Master[i];
 
//And the index to access the required digit is also 0...
if(Element_Num[i] <= 0 && i != 0){
//Reset the index
Element_Num[i] = N-i-1;
 
//Update the numbers held in Index_Nos_ptr[]
for(j = 0,k = 0;j <= N-i;j++){
//Exclude the preceeding digit (from the previous array) already printed.
if(j != Element_Num[i-1]){
*(Index_Nos_ptr[i]+k)= *(Index_Nos_ptr[i-1]+j);
k++;
}
}
}else
//Decrement the index value so as to print the appropriate digit
//in the same array
Element_Num[i]--;
}
}
std::cout<<"] Sign: "<< sign <<"\n";
 
if(!(change_sign-- > 0)){
//Update the sign value.
sign = -sign;
 
change_sign = 1;
}
 
}
 
}
 
int
main()
{
Permutations(4);
getch();
return 0;
}
Output:
Perm: [ 0 1 2 3]  Sign: 1
Perm: [ 0 1 3 2]  Sign: -1
Perm: [ 0 2 1 3]  Sign: -1
Perm: [ 0 2 3 1]  Sign: 1
Perm: [ 0 3 1 2]  Sign: 1
Perm: [ 0 3 2 1]  Sign: -1
Perm: [ 1 0 2 3]  Sign: -1
Perm: [ 1 0 3 2]  Sign: 1
Perm: [ 1 2 0 3]  Sign: 1
Perm: [ 1 2 3 0]  Sign: -1
Perm: [ 1 3 0 2]  Sign: -1
Perm: [ 1 3 2 0]  Sign: 1
Perm: [ 2 0 1 3]  Sign: 1
Perm: [ 2 0 3 1]  Sign: -1
Perm: [ 2 1 0 3]  Sign: -1
Perm: [ 2 1 3 0]  Sign: 1
Perm: [ 2 3 0 1]  Sign: 1
Perm: [ 2 3 1 0]  Sign: -1
Perm: [ 3 0 1 2]  Sign: -1
Perm: [ 3 0 2 1]  Sign: 1
Perm: [ 3 1 0 2]  Sign: 1
Perm: [ 3 1 2 0]  Sign: -1
Perm: [ 3 2 0 1]  Sign: -1
Perm: [ 3 2 1 0]  Sign: 1

[edit] D

[edit] Iterative Version

This isn't a Range yet.

Translation of: Python
import std.algorithm, std.array, std.typecons, std.range;
 
struct Spermutations(bool doCopy=true) {
private immutable uint n;
alias TResult = Tuple!(int[], int);
 
int opApply(in int delegate(in ref TResult) nothrow dg) nothrow {
int result;
 
int sign = 1;
alias Int2 = Tuple!(int, int);
auto p = n.iota.map!(i => Int2(i, i ? -1 : 0)).array;
TResult aux;
 
aux[0] = p.map!(pi => pi[0]).array;
aux[1] = sign;
result = dg(aux);
if (result)
goto END;
 
while (p.any!q{ a[1] }) {
// Failed to use std.algorithm here, too much complex.
auto largest = Int2(-100, -100);
int i1 = -1;
foreach (immutable i, immutable pi; p)
if (pi[1])
if (pi[0] > largest[0]) {
i1 = i;
largest = pi;
}
immutable n1 = largest[0],
d1 = largest[1];
 
sign *= -1;
int i2;
if (d1 == -1) {
i2 = i1 - 1;
p[i1].swap(p[i2]);
if (i2 == 0 || p[i2 - 1][0] > n1)
p[i2][1] = 0;
} else if (d1 == 1) {
i2 = i1 + 1;
p[i1].swap(p[i2]);
if (i2 == n - 1 || p[i2 + 1][0] > n1)
p[i2][1] = 0;
}
 
if (doCopy) {
aux[0] = p.map!(pi => pi[0]).array;
} else {
foreach (immutable i, immutable pi; p)
aux[0][i] = pi[0];
}
aux[1] = sign;
result = dg(aux);
if (result)
goto END;
 
foreach (immutable i3, ref pi; p) {
immutable n3 = pi[0],
d3 = pi[1];
if (n3 > n1)
pi[1] = (i3 < i2) ? 1 : -1;
}
}
 
END: return result;
}
}
 
Spermutations!doCopy spermutations(bool doCopy=true)(in uint n) {
return typeof(return)(n);
}
 
version (permutations_by_swapping1) {
void main() {
import std.stdio;
foreach (immutable n; [3, 4]) {
writefln("\nPermutations and sign of %d items", n);
foreach (const tp; n.spermutations)
writefln("Perm: %s Sign: %2d", tp[]);
}
}
}

Compile with version=permutations_by_swapping1 to see the demo output.

Output:
Permutations and sign of 3 items
Perm: [0, 1, 2]  Sign:  1
Perm: [0, 2, 1]  Sign: -1
Perm: [2, 0, 1]  Sign:  1
Perm: [2, 1, 0]  Sign: -1
Perm: [1, 2, 0]  Sign:  1
Perm: [1, 0, 2]  Sign: -1

Permutations and sign of 4 items
Perm: [0, 1, 2, 3]  Sign:  1
Perm: [0, 1, 3, 2]  Sign: -1
Perm: [0, 3, 1, 2]  Sign:  1
Perm: [3, 0, 1, 2]  Sign: -1
Perm: [3, 0, 2, 1]  Sign:  1
Perm: [0, 3, 2, 1]  Sign: -1
Perm: [0, 2, 3, 1]  Sign:  1
Perm: [0, 2, 1, 3]  Sign: -1
Perm: [2, 0, 1, 3]  Sign:  1
Perm: [2, 0, 3, 1]  Sign: -1
Perm: [2, 3, 0, 1]  Sign:  1
Perm: [3, 2, 0, 1]  Sign: -1
Perm: [3, 2, 1, 0]  Sign:  1
Perm: [2, 3, 1, 0]  Sign: -1
Perm: [2, 1, 3, 0]  Sign:  1
Perm: [2, 1, 0, 3]  Sign: -1
Perm: [1, 2, 0, 3]  Sign:  1
Perm: [1, 2, 3, 0]  Sign: -1
Perm: [1, 3, 2, 0]  Sign:  1
Perm: [3, 1, 2, 0]  Sign: -1
Perm: [3, 1, 0, 2]  Sign:  1
Perm: [1, 3, 0, 2]  Sign: -1
Perm: [1, 0, 3, 2]  Sign:  1
Perm: [1, 0, 2, 3]  Sign: -1

[edit] Recursive Version

Translation of: Python
import std.algorithm, std.array, std.typecons, std.range;
 
auto sPermutations(in uint n) pure nothrow @safe {
static immutable(int[])[] inner(in int items) pure nothrow @safe {
if (items <= 0)
return [[]];
typeof(return) r;
foreach (immutable i, immutable item; inner(items - 1)) {
//r.put((i % 2 ? iota(item.length.signed, -1, -1) :
// iota(item.length + 1))
// .map!(i => item[0 .. i] ~ (items - 1) ~ item[i .. $]));
immutable f = (in size_t i) pure nothrow @safe =>
item[0 .. i] ~ (items - 1) ~ item[i .. $];
r ~= (i % 2) ?
//iota(item.length.signed, -1, -1).map!f.array :
iota(item.length + 1).retro.map!f.array :
iota(item.length + 1).map!f.array;
}
return r;
}
 
return inner(n).zip([1, -1].cycle);
}
 
void main() {
import std.stdio;
foreach (immutable n; [2, 3, 4]) {
writefln("Permutations and sign of %d items:", n);
foreach (immutable tp; n.sPermutations)
writefln("  %s Sign: %2d", tp[]);
writeln;
}
}
Output:
Permutations and sign of 2 items:
  [1, 0] Sign:  1
  [0, 1] Sign: -1

Permutations and sign of 3 items:
  [2, 1, 0] Sign:  1
  [1, 2, 0] Sign: -1
  [1, 0, 2] Sign:  1
  [0, 1, 2] Sign: -1
  [0, 2, 1] Sign:  1
  [2, 0, 1] Sign: -1

Permutations and sign of 4 items:
  [3, 2, 1, 0] Sign:  1
  [2, 3, 1, 0] Sign: -1
  [2, 1, 3, 0] Sign:  1
  [2, 1, 0, 3] Sign: -1
  [1, 2, 0, 3] Sign:  1
  [1, 2, 3, 0] Sign: -1
  [1, 3, 2, 0] Sign:  1
  [3, 1, 2, 0] Sign: -1
  [3, 1, 0, 2] Sign:  1
  [1, 3, 0, 2] Sign: -1
  [1, 0, 3, 2] Sign:  1
  [1, 0, 2, 3] Sign: -1
  [0, 1, 2, 3] Sign:  1
  [0, 1, 3, 2] Sign: -1
  [0, 3, 1, 2] Sign:  1
  [3, 0, 1, 2] Sign: -1
  [3, 0, 2, 1] Sign:  1
  [0, 3, 2, 1] Sign: -1
  [0, 2, 3, 1] Sign:  1
  [0, 2, 1, 3] Sign: -1
  [2, 0, 1, 3] Sign:  1
  [2, 0, 3, 1] Sign: -1
  [2, 3, 0, 1] Sign:  1
  [3, 2, 0, 1] Sign: -1

[edit] Go

package permute
 
// Iter takes a slice p and returns an iterator function. The iterator
// permutes p in place and returns the sign. After all permutations have
// been generated, the iterator returns 0 and p is left in its initial order.
func Iter(p []int) func() int {
f := pf(len(p))
return func() int {
return f(p)
}
}
 
// Recursive function used by perm, returns a chain of closures that
// implement a loopless recursive SJT.
func pf(n int) func([]int) int {
sign := 1
switch n {
case 0, 1:
return func([]int) (s int) {
s = sign
sign = 0
return
}
default:
p0 := pf(n - 1)
i := n
var d int
return func(p []int) int {
switch {
case sign == 0:
case i == n:
i--
sign = p0(p[:i])
d = -1
case i == 0:
i++
sign *= p0(p[1:])
d = 1
if sign == 0 {
p[0], p[1] = p[1], p[0]
}
default:
p[i], p[i-1] = p[i-1], p[i]
sign = -sign
i += d
}
return sign
}
}
}
package main
 
import (
"fmt"
"permute"
)
 
func main() {
p := []int{11, 22, 33}
i := permute.Iter(p)
for sign := i(); sign != 0; sign = i() {
fmt.Println(p, sign)
}
}
Output:
[11 22 33] 1
[11 33 22] -1
[33 11 22] 1
[33 22 11] -1
[22 33 11] 1
[22 11 33] -1

[edit] Haskell

 
s_permutations :: [a] -> [([a], Int)]
s_permutations = flip zip (cycle [1, -1]) . (foldl aux [[]])
where aux items x = do
(f,item) <- zip (cycle [reverse,id]) items
f (insertEv x item)
insertEv x [] = [[x]]
insertEv x l@(y:ys) = (x:l) : map (y:) $ insertEv x ys
 
main :: IO ()
main = do
putStrLn "3 items:"
mapM_ print $ s_permutations [0..2]
putStrLn "4 items:"
mapM_ print $ s_permutations [0..3]
Output:
3 items:
([0,1,2],1)
([0,2,1],-1)
([2,0,1],1)
([2,1,0],-1)
([1,2,0],1)
([1,0,2],-1)
4 items:
([0,1,2,3],1)
([0,1,3,2],-1)
([0,3,1,2],1)
([3,0,1,2],-1)
([3,0,2,1],1)
([0,3,2,1],-1)
([0,2,3,1],1)
([0,2,1,3],-1)
([2,0,1,3],1)
([2,0,3,1],-1)
([2,3,0,1],1)
([3,2,0,1],-1)
([3,2,1,0],1)
([2,3,1,0],-1)
([2,1,3,0],1)
([2,1,0,3],-1)
([1,2,0,3],1)
([1,2,3,0],-1)
([1,3,2,0],1)
([3,1,2,0],-1)
([3,1,0,2],1)
([1,3,0,2],-1)
([1,0,3,2],1)
([1,0,2,3],-1)

[edit] Icon and Unicon

Works in both languages.

Translation of: Python
procedure main(A)
every write("Permutations of length ",n := !A) do
every p := permute(n) do write("\t",showList(p[1])," -> ",right(p[2],2))
end
 
procedure permute(n)
items := [[]]
every (j := 1 to n, new_items := []) do {
every item := items[i := 1 to *items] do {
if *item = 0 then put(new_items, [j])
else if i%2 = 0 then
every k := 1 to *item+1 do {
new_item := item[1:k] ||| [j] ||| item[k:0]
put(new_items, new_item)
}
else
every k := *item+1 to 1 by -1 do {
new_item := item[1:k] ||| [j] ||| item[k:0]
put(new_items, new_item)
}
}
items := new_items
}
suspend (i := 0, [!items, if (i+:=1)%2 = 0 then 1 else -1])
end
 
procedure showList(A)
every (s := "[") ||:= image(!A)||", "
return s[1:-2]||"]"
end

Sample run:

->pbs 3 4
Permutations of length 3
        [1, 2, 3] -> -1
        [1, 3, 2] ->  1
        [3, 1, 2] -> -1
        [3, 2, 1] ->  1
        [2, 3, 1] -> -1
        [2, 1, 3] ->  1
Permutations of length 4
        [1, 2, 3, 4] -> -1
        [1, 2, 4, 3] ->  1
        [1, 4, 2, 3] -> -1
        [4, 1, 2, 3] ->  1
        [4, 1, 3, 2] -> -1
        [1, 4, 3, 2] ->  1
        [1, 3, 4, 2] -> -1
        [1, 3, 2, 4] ->  1
        [3, 1, 2, 4] -> -1
        [3, 1, 4, 2] ->  1
        [3, 4, 1, 2] -> -1
        [4, 3, 1, 2] ->  1
        [4, 3, 2, 1] -> -1
        [3, 4, 2, 1] ->  1
        [3, 2, 4, 1] -> -1
        [3, 2, 1, 4] ->  1
        [2, 3, 1, 4] -> -1
        [2, 3, 4, 1] ->  1
        [2, 4, 3, 1] -> -1
        [4, 2, 3, 1] ->  1
        [4, 2, 1, 3] -> -1
        [2, 4, 1, 3] ->  1
        [2, 1, 4, 3] -> -1
        [2, 1, 3, 4] ->  1
->

[edit] J

J has a built in mechanism for representing permutations (which is designed around the idea of selecting a permutation uniquely by an integer) but it does not seem seem to have an obvious mapping to Steinhaus–Johnson–Trotter. Perhaps someone with a sufficiently deep view of the subject of permutations can find a direct mapping?

Meanwhile, here's an inductive approach, using negative integers to look left and positive integers to look right:

bfsjt0=: _1 - i.
lookingat=: 0 >. <:@# <. i.@# + *
next=: | >./@:* | > | {~ lookingat
bfsjtn=: (((] <@, ] + *@{~) | i. next) C. ] * _1 ^ next < |)^:(*@next)

Here, bfsjt0 N gives the initial permutation of order N, and bfsjtn^:M bfsjt0 N gives the Mth Steinhaus–Johnson–Trotter permutation of order N. (bf stands for "brute force".)

To convert from the Steinhaus–Johnson–Trotter representation of a permutation to J's representation, use <:@|, or to find J's anagram index of a Steinhaus–Johnson–Trotter representation of a permutation, use A.@:<:@:|

Example use:

   bfsjtn^:(i.!3) bfjt0 3
_1 _2 _3
_1 _3 _2
_3 _1 _2
3 _2 _1
_2 3 _1
_2 _1 3
<:@| bfsjtn^:(i.!3) bfjt0 3
0 1 2
0 2 1
2 0 1
2 1 0
1 2 0
1 0 2
A. <:@| bfsjtn^:(i.!3) bfjt0 3
0 1 4 5 3 2

Here's an example of the Steinhaus–Johnson–Trotter representation of 3 element permutation, with sign (sign is the first column):

   (_1^2|i.!3),. bfsjtn^:(i.!3) bfjt0 3
1 _1 _2 _3
_1 _1 _3 _2
1 _3 _1 _2
_1 3 _2 _1
1 _2 3 _1
_1 _2 _1 3

Alternatively, J defines C.!.2 as the parity of a permutation:

   (,.~C.!.2)<:| bfsjtn^:(i.!3) bfjt0 3
1 0 1 2
_1 0 2 1
1 2 0 1
_1 2 1 0
1 1 2 0
_1 1 0 2

[edit] Recursive Implementation

This is based on the python recursive implementation:

rsjt=: 3 :0
if. 2>y do. i.2#y
else. ((!y)$(,~|.)-.=i.y)#inv!.(y-1)"1 y#rsjt y-1
end.
)

Example use (here, prefixing each row with its parity):

   (,.~ C.!.2) rsjt 3
1 0 1 2
_1 0 2 1
1 2 0 1
_1 2 1 0
1 1 2 0
_1 1 0 2

[edit] Mathematica

[edit] Recursive

perms[0] = {{{}, 1}}; 
perms[n_] :=
Flatten[If[#2 == 1, Reverse, # &]@
Table[{Insert[#1, n, i], (-1)^(n + i) #2}, {i, n}] & @@@
perms[n - 1], 1];

Example:

Print["Perm: ", #[[1]], " Sign: ", #[[2]]] & /@ perms@4;

Output:

Perm: {1,2,3,4} Sign: 1
Perm: {1,2,4,3} Sign: -1
Perm: {1,4,2,3} Sign: 1
Perm: {4,1,2,3} Sign: -1
Perm: {4,1,3,2} Sign: 1
Perm: {1,4,3,2} Sign: -1
Perm: {1,3,4,2} Sign: 1
Perm: {1,3,2,4} Sign: -1
Perm: {3,1,2,4} Sign: 1
Perm: {3,1,4,2} Sign: -1
Perm: {3,4,1,2} Sign: 1
Perm: {4,3,1,2} Sign: -1
Perm: {4,3,2,1} Sign: 1
Perm: {3,4,2,1} Sign: -1
Perm: {3,2,4,1} Sign: 1
Perm: {3,2,1,4} Sign: -1
Perm: {2,3,1,4} Sign: 1
Perm: {2,3,4,1} Sign: -1
Perm: {2,4,3,1} Sign: 1
Perm: {4,2,3,1} Sign: -1
Perm: {4,2,1,3} Sign: 1
Perm: {2,4,1,3} Sign: -1
Perm: {2,1,4,3} Sign: 1
Perm: {2,1,3,4} Sign: -1

[edit] Nimrod

# iterative Boothroyd method
iterator permutations*[T](ys: openarray[T]): tuple[perm: seq[T], sign: int] =
var
d = 1
c = newSeq[int](ys.len)
xs = newSeq[T](ys.len)
sign = 1
 
for i, y in ys: xs[i] = y
yield (xs, sign)
 
block outter:
while true:
while d > 1:
dec d
c[d] = 0
while c[d] >= d:
inc d
if d >= ys.len: break outter
 
let i = if (d and 1) == 1: c[d] else: 0
swap xs[i], xs[d]
sign *= -1
yield (xs, sign)
inc c[d]
 
if isMainModule:
for i in permutations([0,1,2]):
echo i
 
echo ""
 
for i in permutations([0,1,2,3]):
echo i

Output:

(perm: @[0, 1, 2], sign: 1)
(perm: @[1, 0, 2], sign: -1)
(perm: @[2, 0, 1], sign: 1)
(perm: @[0, 2, 1], sign: -1)
(perm: @[1, 2, 0], sign: 1)
(perm: @[2, 1, 0], sign: -1)

(perm: @[0, 1, 2, 3], sign: 1)
(perm: @[1, 0, 2, 3], sign: -1)
(perm: @[2, 0, 1, 3], sign: 1)
(perm: @[0, 2, 1, 3], sign: -1)
(perm: @[1, 2, 0, 3], sign: 1)
(perm: @[2, 1, 0, 3], sign: -1)
(perm: @[3, 1, 0, 2], sign: 1)
(perm: @[1, 3, 0, 2], sign: -1)
(perm: @[0, 3, 1, 2], sign: 1)
(perm: @[3, 0, 1, 2], sign: -1)
(perm: @[1, 0, 3, 2], sign: 1)
(perm: @[0, 1, 3, 2], sign: -1)
(perm: @[0, 2, 3, 1], sign: 1)
(perm: @[2, 0, 3, 1], sign: -1)
(perm: @[3, 0, 2, 1], sign: 1)
(perm: @[0, 3, 2, 1], sign: -1)
(perm: @[2, 3, 0, 1], sign: 1)
(perm: @[3, 2, 0, 1], sign: -1)
(perm: @[3, 2, 1, 0], sign: 1)
(perm: @[2, 3, 1, 0], sign: -1)
(perm: @[1, 3, 2, 0], sign: 1)
(perm: @[3, 1, 2, 0], sign: -1)
(perm: @[2, 1, 3, 0], sign: 1)
(perm: @[1, 2, 3, 0], sign: -1)

[edit] Perl

[edit] S-J-T Based

 
#!perl
use strict;
use warnings;
 
# This code uses "Even's Speedup," as described on
# the Wikipedia page about the Steinhaus–Johnson–
# Trotter algorithm.
 
# Any resemblance between this code and the Python
# code elsewhere on the page is purely a coincidence,
# caused by them both implementing the same algorithm.
 
# The code was written to be read relatively easily
# while demonstrating some common perl idioms.
 
sub perms(&@) {
my $callback = shift;
my @perm = map [$_, -1], @_;
$perm[0][1] = 0;
 
my $sign = 1;
while( ) {
$callback->($sign, map $_->[0], @perm);
$sign *= -1;
 
my ($chosen, $index) = (-1, -1);
for my $i ( 0 .. $#perm ) {
($chosen, $index) = ($perm[$i][0], $i)
if $perm[$i][1] and $perm[$i][0] > $chosen;
}
return if $index == -1;
 
my $direction = $perm[$index][1];
my $next = $index + $direction;
 
@perm[ $index, $next ] = @perm[ $next, $index ];
 
if( $next <= 0 or $next >= $#perm ) {
$perm[$next][1] = 0;
} elsif( $perm[$next + $direction][0] > $chosen ) {
$perm[$next][1] = 0;
}
 
for my $i ( 0 .. $next - 1 ) {
$perm[$i][1] = +1 if $perm[$i][0] > $chosen;
}
for my $i ( $next + 1 .. $#perm ) {
$perm[$i][1] = -1 if $perm[$i][0] > $chosen;
}
}
}
 
my $n = shift(@ARGV) || 4;
 
perms {
my ($sign, @perm) = @_;
print "[", join(", ", @perm), "]";
print $sign < 0 ? " => -1\n" : " => +1\n";
} 1 .. $n;
 
Output:

[1, 2, 3, 4] => +1 [1, 2, 4, 3] => -1 [1, 4, 2, 3] => +1 [4, 1, 2, 3] => -1 [4, 1, 3, 2] => +1 [1, 4, 3, 2] => -1 [1, 3, 4, 2] => +1 [1, 3, 2, 4] => -1 [3, 1, 2, 4] => +1 [3, 1, 4, 2] => -1 [3, 4, 1, 2] => +1 [4, 3, 1, 2] => -1 [4, 3, 2, 1] => +1 [3, 4, 2, 1] => -1 [3, 2, 4, 1] => +1 [3, 2, 1, 4] => -1 [2, 3, 1, 4] => +1 [2, 3, 4, 1] => -1 [2, 4, 3, 1] => +1 [4, 2, 3, 1] => -1 [4, 2, 1, 3] => +1 [2, 4, 1, 3] => -1 [2, 1, 4, 3] => +1 [2, 1, 3, 4] => -1

[edit] Alternative Iterative version

This is based on the perl6 recursive version, but without recursion.

#!perl
use strict;
use warnings;
 
sub perms {
my ($xx) = (shift);
my @perms = ([+1]);
for my $x ( 1 .. $xx ) {
my $sign = -1;
@perms = map {
my ($s, @p) = @$_;
map [$sign *= -1, @p[0..$_-1], $x, @p[$_..$#p]],
$s < 0 ? 0 .. @p : reverse 0 .. @p;
} @perms;
}
@perms;
}
 
my $n = shift() || 4;
 
for( perms($n) ) {
my $s = shift @$_;
$s = '+1' if $s > 0;
print "[", join(", ", @$_), "] => $s\n";
}
 
Output:

The output is the same as the first perl solution.

[edit] Perl 6

[edit] Recursive

This example is broken. It fails to compile or causes a runtime error. Please fix the code and remove this message.


sub insert($x, @xs) { [@xs[0..$_-1], $x, @xs[$_..*]] for 0..+@xs }
sub order($sg, @xs) { $sg > 0 ?? @xs !! @xs.reverse }
 
multi perms([]) {
[] => +1
}
 
multi perms([$x, *@xs]) {
perms(@xs).map({ order($_.value, insert($x, $_.key)) }) Z=> (+1,-1) xx *
}
 
.say for perms([0..2]);
Output:
[0, 1, 2] => 1
[1, 0, 2] => -1
[1, 2, 0] => 1
[2, 1, 0] => -1
[2, 0, 1] => 1
[0, 2, 1] => -1

[edit] Python

[edit] Python: iterative

When saved in a file called spermutations.py it is used in the Python example to the Matrix arithmetic task and so any changes here should also be reflected and checked in that task example too.

from operator import itemgetter
 
DEBUG = False # like the built-in __debug__
 
def spermutations(n):
"""permutations by swapping. Yields: perm, sign"""
sign = 1
p = [[i, 0 if i == 0 else -1] # [num, direction]
for i in range(n)]
 
if DEBUG: print ' #', p
yield tuple(pp[0] for pp in p), sign
 
while any(pp[1] for pp in p): # moving
i1, (n1, d1) = max(((i, pp) for i, pp in enumerate(p) if pp[1]),
key=itemgetter(1))
sign *= -1
if d1 == -1:
# Swap down
i2 = i1 - 1
p[i1], p[i2] = p[i2], p[i1]
# If this causes the chosen element to reach the First or last
# position within the permutation, or if the next element in the
# same direction is larger than the chosen element:
if i2 == 0 or p[i2 - 1][0] > n1:
# The direction of the chosen element is set to zero
p[i2][1] = 0
elif d1 == 1:
# Swap up
i2 = i1 + 1
p[i1], p[i2] = p[i2], p[i1]
# If this causes the chosen element to reach the first or Last
# position within the permutation, or if the next element in the
# same direction is larger than the chosen element:
if i2 == n - 1 or p[i2 + 1][0] > n1:
# The direction of the chosen element is set to zero
p[i2][1] = 0
if DEBUG: print ' #', p
yield tuple(pp[0] for pp in p), sign
 
for i3, pp in enumerate(p):
n3, d3 = pp
if n3 > n1:
pp[1] = 1 if i3 < i2 else -1
if DEBUG: print ' # Set Moving'
 
 
if __name__ == '__main__':
from itertools import permutations
 
for n in (3, 4):
print '\nPermutations and sign of %i items' % n
sp = set()
for i in spermutations(n):
sp.add(i[0])
print('Perm: %r Sign: %2i' % i)
#if DEBUG: raw_input('?')
# Test
p = set(permutations(range(n)))
assert sp == p, 'Two methods of generating permutations do not agree'
Output:
Permutations and sign of 3 items
Perm: (0, 1, 2) Sign:  1
Perm: (0, 2, 1) Sign: -1
Perm: (2, 0, 1) Sign:  1
Perm: (2, 1, 0) Sign: -1
Perm: (1, 2, 0) Sign:  1
Perm: (1, 0, 2) Sign: -1

Permutations and sign of 4 items
Perm: (0, 1, 2, 3) Sign:  1
Perm: (0, 1, 3, 2) Sign: -1
Perm: (0, 3, 1, 2) Sign:  1
Perm: (3, 0, 1, 2) Sign: -1
Perm: (3, 0, 2, 1) Sign:  1
Perm: (0, 3, 2, 1) Sign: -1
Perm: (0, 2, 3, 1) Sign:  1
Perm: (0, 2, 1, 3) Sign: -1
Perm: (2, 0, 1, 3) Sign:  1
Perm: (2, 0, 3, 1) Sign: -1
Perm: (2, 3, 0, 1) Sign:  1
Perm: (3, 2, 0, 1) Sign: -1
Perm: (3, 2, 1, 0) Sign:  1
Perm: (2, 3, 1, 0) Sign: -1
Perm: (2, 1, 3, 0) Sign:  1
Perm: (2, 1, 0, 3) Sign: -1
Perm: (1, 2, 0, 3) Sign:  1
Perm: (1, 2, 3, 0) Sign: -1
Perm: (1, 3, 2, 0) Sign:  1
Perm: (3, 1, 2, 0) Sign: -1
Perm: (3, 1, 0, 2) Sign:  1
Perm: (1, 3, 0, 2) Sign: -1
Perm: (1, 0, 3, 2) Sign:  1
Perm: (1, 0, 2, 3) Sign: -1

[edit] Python: recursive

After spotting the pattern of highest number being inserted into each perm of lower numbers from right to left, then left to right, I developed this recursive function:

def s_permutations(seq):
def s_perm(seq):
if not seq:
return [[]]
else:
new_items = []
for i, item in enumerate(s_perm(seq[:-1])):
if i % 2:
# step up
new_items += [item[:i] + seq[-1:] + item[i:]
for i in range(len(item) + 1)]
else:
# step down
new_items += [item[:i] + seq[-1:] + item[i:]
for i in range(len(item), -1, -1)]
return new_items
 
return [(tuple(item), -1 if i % 2 else 1)
for i, item in enumerate(s_perm(seq))]
Sample output

The output is the same as before except it is a list of all results rather than yielding each result from a generator function.

[edit] Python: Iterative version of the recursive

Replacing the recursion in the example above produces this iterative version function:

def s_permutations(seq):
items = [[]]
for j in seq:
new_items = []
for i, item in enumerate(items):
if i % 2:
# step up
new_items += [item[:i] + [j] + item[i:]
for i in range(len(item) + 1)]
else:
# step down
new_items += [item[:i] + [j] + item[i:]
for i in range(len(item), -1, -1)]
items = new_items
 
return [(tuple(item), -1 if i % 2 else 1)
for i, item in enumerate(items)]
Sample output

The output is the same as before and is a list of all results rather than yielding each result from a generator function.

[edit] Racket

 
#lang racket
 
(define (add-at l i x)
(if (zero? i) (cons x l) (cons (car l) (add-at (cdr l) (sub1 i) x))))
 
(define (permutations l)
(define (loop l)
(cond [(null? l) '(())]
[else (for*/list ([(p i) (in-indexed (loop (cdr l)))]
[i ((if (odd? i) identity reverse)
(range (add1 (length p))))])
(add-at p i (car l)))]))
(for/list ([p (loop (reverse l))] [i (in-cycle '(1 -1))]) (cons i p)))
 
(define (show-permutations l)
(printf "Permutations of ~s:\n" l)
(for ([p (permutations l)])
(printf " ~a (~a)\n" (apply ~a (add-between (cdr p) ", ")) (car p))))
 
(for ([n (in-range 3 5)]) (show-permutations (range n)))
 

Output:

Permutations of (0 1 2):
  0, 1, 2 (1)
  0, 2, 1 (-1)
  2, 0, 1 (1)
  2, 1, 0 (-1)
  1, 2, 0 (1)
  1, 0, 2 (-1)
Permutations of (0 1 2 3):
  0, 1, 2, 3 (1)
  0, 1, 3, 2 (-1)
  0, 3, 1, 2 (1)
  3, 0, 1, 2 (-1)
  3, 0, 2, 1 (1)
  0, 3, 2, 1 (-1)
  0, 2, 3, 1 (1)
  0, 2, 1, 3 (-1)
  2, 0, 1, 3 (1)
  2, 0, 3, 1 (-1)
  2, 3, 0, 1 (1)
  3, 2, 0, 1 (-1)
  3, 2, 1, 0 (1)
  2, 3, 1, 0 (-1)
  2, 1, 3, 0 (1)
  2, 1, 0, 3 (-1)
  1, 2, 0, 3 (1)
  1, 2, 3, 0 (-1)
  1, 3, 2, 0 (1)
  3, 1, 2, 0 (-1)
  3, 1, 0, 2 (1)
  1, 3, 0, 2 (-1)
  1, 0, 3, 2 (1)
  1, 0, 2, 3 (-1)

[edit] REXX

/*REXX pgm generates all permutations of N different objects by swapping*/
parse arg things bunch inbetween names /*get optional C.L. args*/
if things=='' | things==',' then things=4 /*use the default? */
if bunch =='' | bunch ==',' then bunch =things /* " " " */
/* ┌────────────────────────────────────────────────────────────────┐
│ things (optional) defaults to 4. │
│ bunch (optional) defaults to THINGS. │
│ inbetween (optional) defaults to a [null]. │
│ names (optional) defaults to digits (and letters). │
└────────────────────────────────────────────────────────────────┘ */

upper inbetween; if inbetween=='NONE' | inbetween="NULL" then inbetween=
call permSets things, bunch, inbetween, names
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────! {factorial} subroutine────────────*/
!: procedure; parse arg x; !=1; do j=2 to x; !=!*j; end; return !
/*──────────────────────────────────GETONE subroutine───────────────────*/
getOne: if length(z)==y then return substr(z,arg(1),1)
else return sep||word(translate(z,,','),arg(1) )
/*──────────────────────────────────P subroutine (Pick one)─────────────*/
p: return word(arg(1),1)
/*──────────────────────────────────PERMSETS subroutine─────────────────*/
permSets: procedure; parse arg x,y,between,uSyms /*X things Y at a time.*/
sep=;  !.=0 /*X can't be > length(@0abcs). */
@abc = 'abcdefghijklmnopqrstuvwxyz'; parse upper var @abc @abcU
@abcS= @abcU || @abc; @0abcS=123456789 || @abcS
z=
do i=1 for x /*build a list of (perm) symbols.*/
_=p(word(uSyms,i) p(substr(@0abcS,i,1) k)) /*get or gen a symbol.*/
if length(_)\==1 then sep=',' /*if not 1st char, then use sep. */
z=z || sep || _ /*append it to the symbol list. */
end /*i*/
 
if sep\=='' then z=strip(z,'L', ",")
!.z=1; #=1; times=!(x)%!(x-y); q=z; s=1; w=max(length(z),length('permute'))
say center('permutations for ' x ' with ' y "at a time",60,'═')
say
say 'permutation' center("permute",w,'─') 'sign'
say '───────────' center("───────",w,'─') '────'
say center(#,11) center(z ,w) right(s,4)
 
do step=1 until #==times
do k=1 for x-1
do m=k+1 to x /*method doesn't use adjaceny. */
 ?=
do n=1 for x /*build a new permutation by swap*/
if n\==k & n\==m then  ?=? || getOne(n)
else if n==k then ?=? || getOne(m)
else ?=? || getOne(k)
end /*n*/
if sep\=='' then ?=strip(?,'L',sep)
z=? /*save this permute for next swap*/
if !.? then iterate m /*if defined before, try next one*/
#=#+1; s=-s; say center(#,11) center(?,w) right(s,4)
 !.?=1
iterate step
end /*m*/
end /*k*/
end /*step*/
 
return

output when using the default inputs:

════════════permutations for  4  with  4  at a time════════════

permutation permute sign
─────────── ─────── ────
     1       1234      1
     2       2134     -1
     3       3214      1
     4       2314     -1
     5       4231      1
     6       2431     -1
     7       3241      1
     8       2341     -1
     9       1324      1
    10       3124     -1
    11       4312      1
    12       3412     -1
    13       1342      1
    14       3142     -1
    15       2413      1
    16       4213     -1
    17       1423      1
    18       4123     -1
    19       4321      1
    20       3421     -1
    21       1432      1
    22       4132     -1
    23       2143      1
    24       1243     -1

output when using the input:   4 4 , leopard liger lion lynx

═══════════permutations for  4  with  4 at a time═══════════

permutation ────────permute──────── sign
─────────── ─────────────────────── ────
     1      leopard,liger,lion,lynx    1
     2      liger,leopard,lion,lynx   -1
     3      lion,liger,leopard,lynx    1
     4      liger,lion,leopard,lynx   -1
     5      lynx,liger,lion,leopard    1
     6      liger,lynx,lion,leopard   -1
     7      lion,liger,lynx,leopard    1
     8      liger,lion,lynx,leopard   -1
     9      leopard,lion,liger,lynx    1
    10      lion,leopard,liger,lynx   -1
    11      lynx,lion,leopard,liger    1
    12      lion,lynx,leopard,liger   -1
    13      leopard,lion,lynx,liger    1
    14      lion,leopard,lynx,liger   -1
    15      liger,lynx,leopard,lion    1
    16      lynx,liger,leopard,lion   -1
    17      leopard,lynx,liger,lion    1
    18      lynx,leopard,liger,lion   -1
    19      lynx,lion,liger,leopard    1
    20      lion,lynx,liger,leopard   -1
    21      leopard,lynx,lion,liger    1
    22      lynx,leopard,lion,liger   -1
    23      liger,leopard,lynx,lion    1
    24      leopard,liger,lynx,lion   -1

[A liger is a cross between a lion and tiger.]

[edit] Ruby

Translation of: BBC BASIC
def perms(n)
p = Array.new(n+1){|i| -i}
s = 1
loop do
yield p[1..-1].map(&:abs), s
k = 0
for i in 2..n
k = i if p[i] < 0 and p[i].abs > p[i-1].abs and p[i].abs > p[k].abs
end
for i in 1...n
k = i if p[i] > 0 and p[i].abs > p[i+1].abs and p[i].abs > p[k].abs
end
break if k.zero?
for i in 1..n
p[i] *= -1 if p[i].abs > p[k].abs
end
i = k + (p[k] <=> 0)
p[k], p[i] = p[i], p[k]
s = -s
end
end
 
for i in 3..4
perms(i){|perm, sign| puts "Perm: #{perm} Sign: #{sign}"}
puts
end
Output:
Perm: [1, 2, 3]  Sign: 1
Perm: [1, 3, 2]  Sign: -1
Perm: [3, 1, 2]  Sign: 1
Perm: [3, 2, 1]  Sign: -1
Perm: [2, 3, 1]  Sign: 1
Perm: [2, 1, 3]  Sign: -1

Perm: [1, 2, 3, 4]  Sign: 1
Perm: [1, 2, 4, 3]  Sign: -1
Perm: [1, 4, 2, 3]  Sign: 1
Perm: [4, 1, 2, 3]  Sign: -1
Perm: [4, 1, 3, 2]  Sign: 1
Perm: [1, 4, 3, 2]  Sign: -1
Perm: [1, 3, 4, 2]  Sign: 1
Perm: [1, 3, 2, 4]  Sign: -1
Perm: [3, 1, 2, 4]  Sign: 1
Perm: [3, 1, 4, 2]  Sign: -1
Perm: [3, 4, 1, 2]  Sign: 1
Perm: [4, 3, 1, 2]  Sign: -1
Perm: [4, 3, 2, 1]  Sign: 1
Perm: [3, 4, 2, 1]  Sign: -1
Perm: [3, 2, 4, 1]  Sign: 1
Perm: [3, 2, 1, 4]  Sign: -1
Perm: [2, 3, 1, 4]  Sign: 1
Perm: [2, 3, 4, 1]  Sign: -1
Perm: [2, 4, 3, 1]  Sign: 1
Perm: [4, 2, 3, 1]  Sign: -1
Perm: [4, 2, 1, 3]  Sign: 1
Perm: [2, 4, 1, 3]  Sign: -1
Perm: [2, 1, 4, 3]  Sign: 1
Perm: [2, 1, 3, 4]  Sign: -1

[edit] Tcl

# A simple swap operation
proc swap {listvar i1 i2} {
upvar 1 $listvar l
set tmp [lindex $l $i1]
lset l $i1 [lindex $l $i2]
lset l $i2 $tmp
}
 
proc permswap {n v1 v2 body} {
upvar 1 $v1 perm $v2 sign
 
# Initialize
set sign -1
for {set i 0} {$i < $n} {incr i} {
lappend items $i
lappend dirs -1
}
 
while 1 {
# Report via callback
set perm $items
set sign [expr {-$sign}]
uplevel 1 $body
 
# Find the largest mobile integer (lmi) and its index (idx)
set i [set idx -1]
foreach item $items dir $dirs {
set j [expr {[incr i] + $dir}]
if {$j < 0 || $j >= [llength $items]} continue
if {$item > [lindex $items $j] && ($idx == -1 || $item > $lmi)} {
set lmi $item
set idx $i
}
}
 
# If none, we're done
if {$idx == -1} break
 
# Swap the largest mobile integer with "what it is looking at"
set nextIdx [expr {$idx + [lindex $dirs $idx]}]
swap items $idx $nextIdx
swap dirs $idx $nextIdx
 
# Reverse directions on larger integers
set i -1
foreach item $items dir $dirs {
lset dirs [incr i] [expr {$item > $lmi ? -$dir : $dir}]
}
}
}

Demonstrating:

permswap 4 p s {
puts "$s\t$p"
}
Output:
1	0 1 2 3
-1	0 1 3 2
1	0 3 1 2
-1	3 0 1 2
1	3 0 2 1
-1	0 3 2 1
1	0 2 3 1
-1	0 2 1 3
1	2 0 1 3
-1	2 0 3 1
1	2 3 0 1
-1	3 2 0 1
1	3 2 1 0
-1	2 3 1 0
1	2 1 3 0
-1	2 1 0 3
1	1 2 0 3
-1	1 2 3 0
1	1 3 2 0
-1	3 1 2 0
1	3 1 0 2
-1	1 3 0 2
1	1 0 3 2
-1	1 0 2 3

[edit] XPL0

Translation of BBC BASIC example, which uses the Johnson-Trotter algorithm.

include c:\cxpl\codes;
 
proc PERMS(N);
int N; \number of elements
int I, K, S, T, P;
[P:= Reserve((N+1)*4);
for I:= 0 to N do P(I):= -I; \initialize facing left (also set P(0)=0)
S:= 1;
repeat Text(0, "Perm: [ ");
for I:= 1 to N do
[IntOut(0, abs(P(I))); ChOut(0, ^ )];
Text(0, "] Sign: "); IntOut(0, S); CrLf(0);
 
K:= 0; \find largest mobile element
for I:= 2 to N do \for left-facing elements
if P(I) < 0 and
abs(P(I)) > abs(P(I-1)) and \ greater than neighbor
abs(P(I)) > abs(P(K)) then K:= I; \ get largest element
for I:= 1 to N-1 do \for right-facing elements
if P(I) > 0 and
abs(P(I)) > abs(P(I+1)) and \ greater than neighbor
abs(P(I)) > abs(P(K)) then K:= I; \ get largest element
if K # 0 then \mobile element found
[for I:= 1 to N do \reverse elements > K
if abs(P(I)) > abs(P(K)) then P(I):= P(I)*-1;
I:= K + (if P(K)<0 then -1 else 1);
T:= P(K); P(K):= P(I); P(I):= T; \swap K with element looked at
S:= -S; \alternate signs
];
until K = 0; \no mobile element remains
];
 
[PERMS(3);
CrLf(0);
PERMS(4);
]

Output:

Perm: [ 1 2 3 ] Sign: 1
Perm: [ 1 3 2 ] Sign: -1
Perm: [ 3 1 2 ] Sign: 1
Perm: [ 3 2 1 ] Sign: -1
Perm: [ 2 3 1 ] Sign: 1
Perm: [ 2 1 3 ] Sign: -1

Perm: [ 1 2 3 4 ] Sign: 1
Perm: [ 1 2 4 3 ] Sign: -1
Perm: [ 1 4 2 3 ] Sign: 1
Perm: [ 4 1 2 3 ] Sign: -1
Perm: [ 4 1 3 2 ] Sign: 1
Perm: [ 1 4 3 2 ] Sign: -1
Perm: [ 1 3 4 2 ] Sign: 1
Perm: [ 1 3 2 4 ] Sign: -1
Perm: [ 3 1 2 4 ] Sign: 1
Perm: [ 3 1 4 2 ] Sign: -1
Perm: [ 3 4 1 2 ] Sign: 1
Perm: [ 4 3 1 2 ] Sign: -1
Perm: [ 4 3 2 1 ] Sign: 1
Perm: [ 3 4 2 1 ] Sign: -1
Perm: [ 3 2 4 1 ] Sign: 1
Perm: [ 3 2 1 4 ] Sign: -1
Perm: [ 2 3 1 4 ] Sign: 1
Perm: [ 2 3 4 1 ] Sign: -1
Perm: [ 2 4 3 1 ] Sign: 1
Perm: [ 4 2 3 1 ] Sign: -1
Perm: [ 4 2 1 3 ] Sign: 1
Perm: [ 2 4 1 3 ] Sign: -1
Perm: [ 2 1 4 3 ] Sign: 1
Perm: [ 2 1 3 4 ] Sign: -1

[edit] zkl

Translation of: Python
Translation of: Haskell
fcn permute(seq)
{
insertEverywhere := fcn(x,list){ //(x,(a,b))-->((x,a,b),(a,x,b),(a,b,x))
(0).pump(list.len()+1,List,'wrap(n){list[0,n].extend(x,list[n,*]) })};
insertEverywhereB := fcn(x,t){ //--> insertEverywhere().reverse()
[t.len()..-1,-1].pump(t.len()+1,List,'wrap(n){t[0,n].extend(x,t[n,*])})};
 
seq.reduce('wrap(items,x){
f := Utils.Helpers.cycle(insertEverywhereB,insertEverywhere);
items.pump(List,'wrap(item){f.next()(x,item)},
T.fp(Void.Write,Void.Write));
},T(T));
}

A cycle of two "build list" functions is used to insert x forward or reverse. reduce loops over the items and retains the enlarging list of permuations. pump loops over the existing set of permutations and inserts/builds the next set (into a list sink). (Void.Write,Void.Write,list) is a sentinel that says to write the contents of the list to the sink (ie sink.extend(list)). T.fp is a partial application of ROList.create (read only list) and the parameters VW,VW. It will be called (by pump) with a list of lists --> T.create(VM,VM,list) --> list

p := permute(T(1,2,3));
p.println();
 
p := permute([1..4]);
p.len().println();
p.toString(*).println()
Output:
L(L(1,2,3),L(1,3,2),L(3,1,2),L(3,2,1),L(2,3,1),L(2,1,3))

24
L(
L(1,2,3,4), L(1,2,4,3), L(1,4,2,3), L(4,1,2,3), L(4,1,3,2), L(1,4,3,2),
L(1,3,4,2), L(1,3,2,4), L(3,1,2,4), L(3,1,4,2), L(3,4,1,2), L(4,3,1,2), 
L(4,3,2,1), L(3,4,2,1), L(3,2,4,1), L(3,2,1,4), L(2,3,1,4), L(2,3,4,1), 
L(2,4,3,1), L(4,2,3,1), L(4,2,1,3), L(2,4,1,3), L(2,1,4,3), L(2,1,3,4) )

An iterative, lazy version, which is handy as the number of permutations is n!. Uses "Even's Speedup" as described in the Wikipedia article:

 fcn [private] _permuteW(seq){	// lazy version
N:=seq.len(); NM1:=N-1;
ds:=(0).pump(N,List,T(Void,-1)).copy(); ds[0]=0; // direction to move e: -1,0,1
es:=(0).pump(N,List).copy(); // enumerate seq
 
while(1) {
vm.yield(es.pump(List,seq.__sGet));
 
// find biggest e with d!=0
reg i=Void, c=-1;
foreach n in (N){ if(ds[n] and es[n]>c) { c=es[n]; i=n; } }
if(Void==i) return();
 
d:=ds[i]; j:=i+d;
es.swap(i,j); ds.swap(i,j); // d tracks e
if(j==NM1 or j==0 or es[j+d]>c) ds[j]=0;
foreach e in (N){ if(es[e]>c) ds[e]=(i-e).sign }
}
}
 
fcn permuteW(seq) { Utils.Generator(_permuteW,seq) }
foreach p in (permuteW(T("a","b","c"))){ println(p) }
Output:
L("a","b","c")
L("a","c","b")
L("c","a","b")
L("c","b","a")
L("b","c","a")
L("b","a","c")
Personal tools
Namespaces

Variants
Actions
Community
Explore
Misc
Toolbox