Permutations

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

Write a program that generates all permutations of n different objects. (Practically numerals!)

Cf.

See Also:

The number of samples of size k from n objects.
With combinations and permutations generation tasks.
Order Unimportant Order Important
Without replacement  \binom nk = ^n\operatorname C_k = \frac{n(n-1)\ldots(n-k+1)}{k(k-1)\dots1} ^n\operatorname P_k = n\cdot(n-1)\cdot(n-2)\cdots(n-k+1)
Task: Combinations Task: Permutations
With replacement  \binom {n+k-1}k = ^{n+k-1}\operatorname C_k = {(n+k-1)! \over (n-1)!k!} nk
Task: Combinations with repetitions Task: Permutations with repetitions

Contents

[edit] ABAP

data: lv_flag type c,
lv_number type i,
lt_numbers type table of i.
 
append 1 to lt_numbers.
append 2 to lt_numbers.
append 3 to lt_numbers.
 
do.
perform permute using lt_numbers changing lv_flag.
if lv_flag = 'X'.
exit.
endif.
loop at lt_numbers into lv_number.
write (1) lv_number no-gap left-justified.
if sy-tabix <> '3'.
write ', '.
endif.
endloop.
skip.
enddo.
 
" Permutation function - this is used to permute:
" Can be used for an unbounded size set.
form permute using iv_set like lt_numbers
changing ev_last type c.
data: lv_len type i,
lv_first type i,
lv_third type i,
lv_count type i,
lv_temp type i,
lv_temp_2 type i,
lv_second type i,
lv_changed type c,
lv_perm type i.
describe table iv_set lines lv_len.
 
lv_perm = lv_len - 1.
lv_changed = ' '.
" Loop backwards through the table, attempting to find elements which
" can be permuted. If we find one, break out of the table and set the
" flag indicating a switch.
do.
if lv_perm <= 0.
exit.
endif.
" Read the elements.
read table iv_set index lv_perm into lv_first.
add 1 to lv_perm.
read table iv_set index lv_perm into lv_second.
subtract 1 from lv_perm.
if lv_first < lv_second.
lv_changed = 'X'.
exit.
endif.
subtract 1 from lv_perm.
enddo.
 
" Last permutation.
if lv_changed <> 'X'.
ev_last = 'X'.
exit.
endif.
 
" Swap tail decresing to get a tail increasing.
lv_count = lv_perm + 1.
do.
lv_first = lv_len + lv_perm - lv_count + 1.
if lv_count >= lv_first.
exit.
endif.
 
read table iv_set index lv_count into lv_temp.
read table iv_set index lv_first into lv_temp_2.
modify iv_set index lv_count from lv_temp_2.
modify iv_set index lv_first from lv_temp.
add 1 to lv_count.
enddo.
 
lv_count = lv_len - 1.
do.
if lv_count <= lv_perm.
exit.
endif.
 
read table iv_set index lv_count into lv_first.
read table iv_set index lv_perm into lv_second.
read table iv_set index lv_len into lv_third.
if ( lv_first < lv_third ) and ( lv_first > lv_second ).
lv_len = lv_count.
endif.
 
subtract 1 from lv_count.
enddo.
 
read table iv_set index lv_perm into lv_temp.
read table iv_set index lv_len into lv_temp_2.
modify iv_set index lv_perm from lv_temp_2.
modify iv_set index lv_len from lv_temp.
endform.
Output:
1,  3,  2

2,  1,  3

2,  3,  1

3,  1,  2

3,  2,  1

[edit] Ada

We split the task into two parts: The first part is to represent permutations, to initialize them and to go from one permutation to another one, until the last one has been reached. This can be used elsewhere, e.g., for the Topswaps [[1]] task. The second part is to read the N from the command line, and to actually print all permutations over 1 .. N.

[edit] The generic package Generic_Perm

When given N, this package defines the Element and Permutation types and exports procedures to set a permutation P to the first one, and to change P into the next one:

generic
N: positive;
package Generic_Perm is
subtype Element is Positive range 1 .. N;
type Permutation is array(Element) of Element;
 
procedure Set_To_First(P: out Permutation; Is_Last: out Boolean);
procedure Go_To_Next(P: in out Permutation; Is_Last: out Boolean);
end Generic_Perm;

Here is the implementation of the package:

package body Generic_Perm is
 
 
procedure Set_To_First(P: out Permutation; Is_Last: out Boolean) is
begin
for I in P'Range loop
P (I) := I;
end loop;
Is_Last := P'Length = 1;
-- if P has a single element, the fist permutation is the last one
end Set_To_First;
 
procedure Go_To_Next(P: in out Permutation; Is_Last: out Boolean) is
 
procedure Swap (A, B : in out Integer) is
C : Integer := A;
begin
A := B;
B := C;
end Swap;
 
I, J, K : Element;
begin
-- find longest tail decreasing sequence
-- after the loop, this sequence is I+1 .. n,
-- and the ith element will be exchanged later
-- with some element of the tail
Is_Last := True;
I := N - 1;
loop
if P (I) < P (I+1)
then
Is_Last := False;
exit;
end if;
 
-- next instruction will raise an exception if I = 1, so
-- exit now (this is the last permutation)
exit when I = 1;
I := I - 1;
end loop;
 
-- if all the elements of the permutation are in
-- decreasing order, this is the last one
if Is_Last then
return;
end if;
 
-- sort the tail, i.e. reverse it, since it is in decreasing order
J := I + 1;
K := N;
while J < K loop
Swap (P (J), P (K));
J := J + 1;
K := K - 1;
end loop;
 
-- find lowest element in the tail greater than the ith element
J := N;
while P (J) > P (I) loop
J := J - 1;
end loop;
J := J + 1;
 
-- exchange them
-- this will give the next permutation in lexicographic order,
-- since every element from ith to the last is minimum
Swap (P (I), P (J));
end Go_To_Next;
 
end Generic_Perm;

[edit] The procedure Print_Perms

with Ada.Text_IO, Ada.Command_Line, Generic_Perm;
 
procedure Print_Perms is
package CML renames Ada.Command_Line;
package TIO renames Ada.Text_IO;
begin
declare
package Perms is new Generic_Perm(Positive'Value(CML.Argument(1)));
P : Perms.Permutation;
Done : Boolean := False;
 
procedure Print(P: Perms.Permutation) is
begin
for I in P'Range loop
TIO.Put (Perms.Element'Image (P (I)));
end loop;
TIO.New_Line;
end Print;
begin
Perms.Set_To_First(P, Done);
loop
Print(P);
exit when Done;
Perms.Go_To_Next(P, Done);
end loop;
end;
exception
when Constraint_Error
=> TIO.Put_Line ("*** Error: enter one numerical argument n with n >= 1");
end Print_Perms;
Output:
>./print_perms 3
 1 2 3
 1 3 2
 2 1 3
 2 3 1
 3 1 2
 3 2 1
 3 2 1

[edit] ALGOL 68

Works with: ALGOL 68 version Revision 1 - one minor extension to language used - PRAGMA READ, similar to C's #include directive.
Works with: ALGOL 68G version Any - tested with release algol68g-2.6.
File: prelude_permutations.a68
# -*- coding: utf-8 -*- #
 
COMMENT REQUIRED BY "prelude_permutations.a68"
MODE PERMDATA = ~;
PROVIDES:
# PERMDATA*=~* #
# perm*=~ list* #
END COMMENT
 
MODE PERMDATALIST = REF[]PERMDATA;
MODE PERMDATALISTYIELD = PROC(PERMDATALIST)VOID;
 
# Generate permutations of the input data list of data list #
PROC perm gen permutations = (PERMDATALIST data list, PERMDATALISTYIELD yield)VOID: (
# Warning: this routine does not correctly handle duplicate elements #
IF LWB data list = UPB data list THEN
yield(data list)
ELSE
FOR elem FROM LWB data list TO UPB data list DO
PERMDATA first = data list[elem];
data list[LWB data list+1:elem] := data list[:elem-1];
data list[LWB data list] := first;
# FOR PERMDATALIST next data list IN # perm gen permutations(data list[LWB data list+1:] # ) DO #,
## (PERMDATALIST next)VOID:(
yield(data list)
# OD #));
data list[:elem-1] := data list[LWB data list+1:elem];
data list[elem] := first
OD
FI
);
 
SKIP
File: test_permutations.a68
#!/usr/bin/a68g --script #
# -*- coding: utf-8 -*- #
 
CO REQUIRED BY "prelude_permutations.a68" CO
MODE PERMDATA = INT;
#PROVIDES:#
# PERM*=INT* #
# perm *=int list *#
PR READ "prelude_permutations.a68" PR;
 
main:(
FLEX[0]PERMDATA test case := (1, 22, 333, 44444);
 
INT upb data list = UPB test case;
FORMAT
data fmt := $g(0)$,
data list fmt := $"("n(upb data list-1)(f(data fmt)", ")f(data fmt)")"$;
 
# FOR DATALIST permutation IN # perm gen permutations(test case#) DO (#,
## (PERMDATALIST permutation)VOID:(
printf((data list fmt, permutation, $l$))
# OD #))
 
)
Output:
(1, 22, 333, 44444)
(1, 22, 44444, 333)
(1, 333, 22, 44444)
(1, 333, 44444, 22)
(1, 44444, 22, 333)
(1, 44444, 333, 22)
(22, 1, 333, 44444)
(22, 1, 44444, 333)
(22, 333, 1, 44444)
(22, 333, 44444, 1)
(22, 44444, 1, 333)
(22, 44444, 333, 1)
(333, 1, 22, 44444)
(333, 1, 44444, 22)
(333, 22, 1, 44444)
(333, 22, 44444, 1)
(333, 44444, 1, 22)
(333, 44444, 22, 1)
(44444, 1, 22, 333)
(44444, 1, 333, 22)
(44444, 22, 1, 333)
(44444, 22, 333, 1)
(44444, 333, 1, 22)
(44444, 333, 22, 1)

[edit] AutoHotkey

from the forum topic http://www.autohotkey.com/forum/viewtopic.php?t=77959

#NoEnv
StringCaseSense On
 
o := str := "Hello"
 
Loop
{
str := perm_next(str)
If !str
{
MsgBox % clipboard := o
break
}
o.= "`n" . str
}
 
perm_Next(str){
p := 0, sLen := StrLen(str)
Loop % sLen
{
If A_Index=1
continue
t := SubStr(str, sLen+1-A_Index, 1)
n := SubStr(str, sLen+2-A_Index, 1)
If ( t < n )
{
p := sLen+1-A_Index, pC := SubStr(str, p, 1)
break
}
}
If !p
return false
Loop
{
t := SubStr(str, sLen+1-A_Index, 1)
If ( t > pC )
{
n := sLen+1-A_Index, nC := SubStr(str, n, 1)
break
}
}
return SubStr(str, 1, p-1) . nC . Reverse(SubStr(str, p+1, n-p-1) . pC . SubStr(str, n+1))
}
 
Reverse(s){
Loop Parse, s
o := A_LoopField o
return o
}
Output:
Hello
Helol
Heoll
Hlelo
Hleol
Hlleo
Hlloe
Hloel
Hlole
Hoell
Holel
Holle
eHllo
eHlol
eHoll
elHlo
elHol
ellHo
elloH
eloHl
elolH
eoHll
eolHl
eollH
lHelo
lHeol
lHleo
lHloe
lHoel
lHole
leHlo
leHol
lelHo
leloH
leoHl
leolH
llHeo
llHoe
lleHo
lleoH
lloHe
lloeH
loHel
loHle
loeHl
loelH
lolHe
loleH
oHell
oHlel
oHlle
oeHll
oelHl
oellH
olHel
olHle
oleHl
olelH
ollHe
olleH

[edit] Alternate Version

Alternate version to produce numerical permutations of combinations.

P(n,k="",opt=0,delim="",str="") { ; generate all n choose k permutations lexicographically
;1..n = range, or delimited list, or string to parse
; to process with a different min index, pass a delimited list, e.g. "0`n1`n2"
;k = length of result
;opt 0 = no repetitions
;opt 1 = with repetitions
;opt 2 = run for 1..k
;opt 3 = run for 1..k with repetitions
;str = string to prepend (used internally)
;returns delimited string, error message, or (if k > n) a blank string
i:=0
If !InStr(n,"`n")
If n in 2,3,4,5,6,7,8,9
Loop, %n%
n := A_Index = 1 ? A_Index : n "`n" A_Index
Else
Loop, Parse, n, %delim%
n := A_Index = 1 ? A_LoopField : n "`n" A_LoopField
If (k = "")
RegExReplace(n,"`n","",k), k++
If k is not Digit
Return "k must be a digit."
If opt not in 0,1,2,3
Return "opt invalid."
If k = 0
Return str
Else
Loop, Parse, n, `n
If (!InStr(str,A_LoopField) || opt & 1)
s .= (!i++ ? (opt & 2 ? str "`n" : "") : "`n" )
. P(n,k-1,opt,delim,str . A_LoopField . delim)
Return s
}
Output:
MsgBox % P(3)
---------------------------
permute.ahk
---------------------------
123
132
213
231
312
321
---------------------------
OK   
---------------------------
MsgBox % P("Hello",3)
---------------------------
permute.ahk
---------------------------
Hel
Hel
Heo
Hle
Hlo
Hle
Hlo
Hoe
Hol
Hol
eHl
eHl
eHo
elH
elo
elH
elo
eoH
eol
eol
lHe
lHo
leH
leo
loH
loe
lHe
lHo
leH
leo
loH
loe
oHe
oHl
oHl
oeH
oel
oel
olH
ole
olH
ole
---------------------------
OK   
---------------------------
MsgBox % P("2`n3`n4`n5",2,3)
---------------------------
permute.ahk
---------------------------

2
22
23
24
25
3
32
33
34
35
4
42
43
44
45
5
52
53
54
55
---------------------------
OK   
---------------------------
MsgBox % P("11 a text ] u+z",3,0," ")
---------------------------
permute.ahk
---------------------------
11 a text 
11 a ] 
11 a u+z 
11 text a 
11 text ] 
11 text u+z 
11 ] a 
11 ] text 
11 ] u+z 
11 u+z a 
11 u+z text 
11 u+z ] 
a 11 text 
a 11 ] 
a 11 u+z 
a text 11 
a text ] 
a text u+z 
a ] 11 
a ] text 
a ] u+z 
a u+z 11 
a u+z text 
a u+z ] 
text 11 a 
text 11 ] 
text 11 u+z 
text a 11 
text a ] 
text a u+z 
text ] 11 
text ] a 
text ] u+z 
text u+z 11 
text u+z a 
text u+z ] 
] 11 a 
] 11 text 
] 11 u+z 
] a 11 
] a text 
] a u+z 
] text 11 
] text a 
] text u+z 
] u+z 11 
] u+z a 
] u+z text 
u+z 11 a 
u+z 11 text 
u+z 11 ] 
u+z a 11 
u+z a text 
u+z a ] 
u+z text 11 
u+z text a 
u+z text ] 
u+z ] 11 
u+z ] a 
u+z ] text 
---------------------------
OK   
---------------------------

[edit] BBC BASIC

The procedure PROC_NextPermutation() will give the next lexicographic permutation of an integer array.

      DIM List%(3)
List%() = 1, 2, 3, 4
FOR perm% = 1 TO 24
FOR i% = 0 TO DIM(List%(),1)
PRINT List%(i%);
NEXT
PRINT
PROC_NextPermutation(List%())
NEXT
END
 
DEF PROC_NextPermutation(A%())
LOCAL first, last, elementcount, pos
elementcount = DIM(A%(),1)
IF elementcount < 1 THEN ENDPROC
pos = elementcount-1
WHILE A%(pos) >= A%(pos+1)
pos -= 1
IF pos < 0 THEN
PROC_Permutation_Reverse(A%(), 0, elementcount)
ENDPROC
ENDIF
ENDWHILE
last = elementcount
WHILE A%(last) <= A%(pos)
last -= 1
ENDWHILE
SWAP A%(pos), A%(last)
PROC_Permutation_Reverse(A%(), pos+1, elementcount)
ENDPROC
 
DEF PROC_Permutation_Reverse(A%(), first, last)
WHILE first < last
SWAP A%(first), A%(last)
first += 1
last -= 1
ENDWHILE
ENDPROC

Output:

         1         2         3         4
         1         2         4         3
         1         3         2         4
         1         3         4         2
         1         4         2         3
         1         4         3         2
         2         1         3         4
         2         1         4         3
         2         3         1         4
         2         3         4         1
         2         4         1         3
         2         4         3         1
         3         1         2         4
         3         1         4         2
         3         2         1         4
         3         2         4         1
         3         4         1         2
         3         4         2         1
         4         1         2         3
         4         1         3         2
         4         2         1         3
         4         2         3         1
         4         3         1         2
         4         3         2         1

[edit] Bracmat

  ( perm
= prefix List result original A Z
.  !arg:(?.)
|  !arg:(?prefix.?List:?original)
& :?result
& whl
' ( !List:%?A ?Z
& !result perm$(!prefix !A.!Z):?result
& !Z !A:~!original:?List
)
& !result
)
& out$(perm$(.a 2 "]" u+z);

Output:

  (a 2 ] u+z.)
  (a 2 u+z ].)
  (a ] u+z 2.)
  (a ] 2 u+z.)
  (a u+z 2 ].)
  (a u+z ] 2.)
  (2 ] u+z a.)
  (2 ] a u+z.)
  (2 u+z a ].)
  (2 u+z ] a.)
  (2 a ] u+z.)
  (2 a u+z ].)
  (] u+z a 2.)
  (] u+z 2 a.)
  (] a 2 u+z.)
  (] a u+z 2.)
  (] 2 u+z a.)
  (] 2 a u+z.)
  (u+z a 2 ].)
  (u+z a ] 2.)
  (u+z 2 ] a.)
  (u+z 2 a ].)
  (u+z ] a 2.)
  (u+z ] 2 a.)

[edit] C

See lexicographic generation of permutations.

#include <stdio.h>
#include <stdlib.h>
 
/* print a list of ints */
int show(int *x, int len)
{
int i;
for (i = 0; i < len; i++)
printf("%d%c", x[i], i == len - 1 ? '\n' : ' ');
return 1;
}
 
/* next lexicographical permutation */
int next_lex_perm(int *a, int n) {
# define swap(i, j) {t = a[i]; a[i] = a[j]; a[j] = t;}
int k, l, t;
 
/* 1. Find the largest index k such that a[k] < a[k + 1]. If no such
index exists, the permutation is the last permutation. */

for (k = n - 1; k && a[k - 1] >= a[k]; k--);
if (!k--) return 0;
 
/* 2. Find the largest index l such that a[k] < a[l]. Since k + 1 is
such an index, l is well defined */

for (l = n - 1; a[l] <= a[k]; l--);
 
/* 3. Swap a[k] with a[l] */
swap(k, l);
 
/* 4. Reverse the sequence from a[k + 1] to the end */
for (k++, l = n - 1; l > k; l--, k++)
swap(k, l);
return 1;
# undef swap
}
 
void perm1(int *x, int n, int callback(int *, int))
{
do {
if (callback) callback(x, n);
} while (next_lex_perm(x, n));
}
 
/* Boothroyd method; exactly N! swaps, about as fast as it gets */
void boothroyd(int *x, int n, int nn, int callback(int *, int))
{
int c = 0, i, t;
while (1) {
if (n > 2) boothroyd(x, n - 1, nn, callback);
if (c >= n - 1) return;
 
i = (n & 1) ? 0 : c;
c++;
t = x[n - 1], x[n - 1] = x[i], x[i] = t;
if (callback) callback(x, nn);
}
}
 
/* entry for Boothroyd method */
void perm2(int *x, int n, int callback(int*, int))
{
if (callback) callback(x, n);
boothroyd(x, n, n, callback);
}
 
/* same as perm2, but flattened recursions into iterations */
void perm3(int *x, int n, int callback(int*, int))
{
/* calloc isn't strictly necessary, int c[32] would suffice
for most practical purposes */

int d, i, t, *c = calloc(n, sizeof(int));
 
/* curiously, with GCC 4.6.1 -O3, removing next line makes
it ~25% slower */

if (callback) callback(x, n);
for (d = 1; ; c[d]++) {
while (d > 1) c[--d] = 0;
while (c[d] >= d)
if (++d >= n) goto done;
 
t = x[ i = (d & 1) ? c[d] : 0 ], x[i] = x[d], x[d] = t;
if (callback) callback(x, n);
}
done: free(c);
}
 
#define N 4
 
int main()
{
int i, x[N];
for (i = 0; i < N; i++) x[i] = i + 1;
 
/* three different methods */
perm1(x, N, show);
perm2(x, N, show);
perm3(x, N, show);
 
return 0;
}

[edit] C++

The C++ standard library provides for this in the form of std::next_permutation and std::prev_permutation.

#include <algorithm>
#include <string>
#include <vector>
#include <iostream>
 
template<class T>
void print(const std::vector<T> &vec)
{
for (typename std::vector<T>::const_iterator i = vec.begin(); i != vec.end(); ++i)
{
std::cout << *i;
if ((i + 1) != vec.end())
std::cout << ",";
}
std::cout << std::endl;
}
 
int main()
{
//Permutations for strings
std::string example("Hello");
std::sort(example.begin(), example.end());
do {
std::cout << example << '\n';
} while (std::next_permutation(example.begin(), example.end()));
 
// And for vectors
std::vector<int> another;
another.push_back(1234);
another.push_back(4321);
another.push_back(1234);
another.push_back(9999);
 
std::sort(another.begin(), another.end());
do {
print(another);
} while (std::next_permutation(another.begin(), another.end()));
 
return 0;
}
Output:
Hello
Helol
Heoll
Hlelo
Hleol
Hlleo
Hlloe
Hloel
Hlole
Hoell
Holel
Holle
eHllo
eHlol
eHoll
elHlo
elHol
ellHo
elloH
eloHl
elolH
eoHll
eolHl
eollH
lHelo
lHeol
lHleo
lHloe
lHoel
lHole
leHlo
leHol
lelHo
leloH
leoHl
leolH
llHeo
llHoe
lleHo
lleoH
lloHe
lloeH
loHel
loHle
loeHl
loelH
lolHe
loleH
oHell
oHlel
oHlle
oeHll
oelHl
oellH
olHel
olHle
oleHl
olelH
ollHe
olleH
1234,1234,4321,9999
1234,1234,9999,4321
1234,4321,1234,9999
1234,4321,9999,1234
1234,9999,1234,4321
1234,9999,4321,1234
4321,1234,1234,9999
4321,1234,9999,1234
4321,9999,1234,1234
9999,1234,1234,4321
9999,1234,4321,1234
9999,4321,1234,1234

[edit] C#

A recursive Iterator. Runs under C#2 (VS2005), i.e. no `var`, no lambdas,...

public class Permutations<T>
{
public static System.Collections.Generic.IEnumerable<T[]> AllFor(T[] array)
{
if (array == null || array.Length == 0)
{
yield return new T[0];
}
else
{
for (int pick = 0; pick < array.Length; ++pick)
{
T item = array[pick];
int i = -1;
T[] rest = System.Array.FindAll<T>(
array, delegate(T p) { return ++i != pick; }
);
foreach (T[] restPermuted in AllFor(rest))
{
i = -1;
yield return System.Array.ConvertAll<T, T>(
array,
delegate(T p) {
return ++i == 0 ? item : restPermuted[i - 1];
}
);
}
}
}
}
}

Usage:

namespace Permutations_On_RosettaCode
{
class Program
{
static void Main(string[] args)
{
string[] list = "a b c d".Split();
foreach (string[] permutation in Permutations<string>.AllFor(list))
{
System.Console.WriteLine(string.Join(" ", permutation));
}
}
}
}

[edit] Clojure

In an REPL:

user=> (require 'clojure.contrib.combinatorics)
nil
user=> (clojure.contrib.combinatorics/permutations [1 2 3])
((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1))

[edit] CoffeeScript

# Returns a copy of an array with the element at a specific position
# removed from it.
arrayExcept = (arr, idx) ->
res = arr[0..]
res.splice idx, 1
res
 
# The actual function which returns the permutations of an array-like
# object (or a proper array).
permute = (arr) ->
arr = Array::slice.call arr, 0
return [[]] if arr.length == 0
 
permutations = (for value,idx in arr
[value].concat perm for perm in permute arrayExcept arr, idx)
 
# Flatten the array before returning it.
[].concat permutations...

This implementation utilises the fact that the permutations of an array could be defined recursively, with the fixed point being the permutations of an empty array.

Usage:
coffee> console.log (permute "123").join "\n"
1,2,3
1,3,2
2,1,3
2,3,1
3,1,2
3,2,1

[edit] Common Lisp

(defun permute (list)
(if list
(mapcan #'(lambda (x)
(mapcar #'(lambda (y) (cons x y))
(permute (remove x list))))
list)
'(()))) ; else
 
(print (permute '(A B Z)))
Output:
((A B Z) (A Z B) (B A Z) (B Z A) (Z A B) (Z B A))

Lexicographic next permutation:

(defun next-perm (vec cmp)  ; modify vector
(declare (type (simple-array * (*)) vec))
(macrolet ((el (i) `(aref vec ,i))
(cmp (i j) `(funcall cmp (el ,i) (el ,j))))
(loop with len = (1- (length vec))
for i from (1- len) downto 0
when (cmp i (1+ i)) do
(loop for k from len downto i
when (cmp i k) do
(rotatef (el i) (el k))
(setf k (1+ len))
(loop while (< (incf i) (decf k)) do
(rotatef (el i) (el k)))
(return-from next-perm vec)))))
 
;;; test code
(loop for a = "1234" then (next-perm a #'char<) while a do
(write-line a))

[edit] D

[edit] Simple Eager version

Compile with -version=permutations1_main to see the output.

T[][] permutations(T)(T[] items) pure nothrow {
T[][] result;
 
void perms(T[] s, T[] prefix=[]) nothrow {
if (s.length)
foreach (immutable i, immutable c; s)
perms(s[0 .. i] ~ s[i+1 .. $], prefix ~ c);
else
result ~= prefix;
}
 
perms(items);
return result;
}
 
version (permutations1_main) {
void main() {
import std.stdio;
writefln("%(%s\n%)", [1, 2, 3].permutations);
}
}
Output:
[1, 2, 3]
[1, 3, 2]
[2, 1, 3]
[2, 3, 1]
[3, 1, 2]
[3, 2, 1]

[edit] Fast Lazy Version

Compiled with -version=permutations2_main produces its output.

import std.algorithm, std.conv, std.traits;
 
struct Permutations(bool doCopy=true, T) if (isMutable!T) {
private immutable size_t num;
private T[] items;
private uint[31] indexes;
private ulong tot;
 
this (in T[] items) pure nothrow
in {
static enum string L = indexes.length.text;
assert(items.length >= 0 && items.length <= indexes.length,
"Permutations: items.length must be >= 0 && < " ~ L);
} body {
static ulong factorial(in uint n) pure nothrow {
ulong result = 1;
foreach (immutable i; 2 .. n + 1)
result *= i;
return result;
}
 
this.num = items.length;
this.items = items.dup;
foreach (immutable i; 0 .. cast(typeof(indexes[0]))this.num)
this.indexes[i] = i;
this.tot = factorial(this.num);
}
 
@property T[] front() pure nothrow {
static if (doCopy) {
return items.dup;
} else
return items;
}
 
@property bool empty() const pure nothrow {
return tot == 0;
}
 
void popFront() pure nothrow {
tot--;
if (tot > 0) {
size_t j = num - 2;
 
while (indexes[j] > indexes[j + 1])
j--;
size_t k = num - 1;
while (indexes[j] > indexes[k])
k--;
swap(indexes[k], indexes[j]);
swap(items[k], items[j]);
 
size_t r = num - 1;
size_t s = j + 1;
while (r > s) {
swap(indexes[s], indexes[r]);
swap(items[s], items[r]);
r--;
s++;
}
}
}
}
 
Permutations!(doCopy,T) permutations(bool doCopy=true, T)
(in T[] items)
pure nothrow if (isMutable!T) {
return Permutations!(doCopy, T)(items);
}
 
version (permutations2_main) {
void main() {
import std.stdio, std.bigint;
alias B = BigInt;
foreach (p; [B(1), B(2), B(3)].permutations)
assert((p[0] + 1) > 0);
[1, 2, 3].permutations!false.writeln;
[B(1), B(2), B(3)].permutations!false.writeln;
}
}

[edit] Standard Version

import std.stdio, std.algorithm;
 
void main() {
auto items = [1, 2, 3];
do
writeln(items);
while (items.nextPermutation());
}

[edit] Delphi

program TestPermutations;
 
{$APPTYPE CONSOLE}
 
type
TItem = Integer; // declare ordinal type for array item
TArray = array[0..3] of TItem;
 
const
Source: TArray = (1, 2, 3, 4);
 
procedure Permutation(K: Integer; var A: TArray);
var
I, J: Integer;
Tmp: TItem;
 
begin
for I:= Low(A) + 1 to High(A) + 1 do begin
J:= K mod I;
Tmp:= A[J];
A[J]:= A[I - 1];
A[I - 1]:= Tmp;
K:= K div I;
end;
end;
 
var
A: TArray;
I, K, Count: Integer;
S, S1, S2: ShortString;
 
begin
Count:= 1;
I:= Length(A);
while I > 1 do begin
Count:= Count * I;
Dec(I);
end;
 
S:= '';
for K:= 0 to Count - 1 do begin
A:= Source;
Permutation(K, A);
S1:= '';
for I:= Low(A) to High(A) do begin
Str(A[I]:1, S2);
S1:= S1 + S2;
end;
S:= S + ' ' + S1;
if Length(S) > 40 then begin
Writeln(S);
S:= '';
end;
end;
 
if Length(S) > 0 then Writeln(S);
Readln;
end.
Output:
  4123  4213  4312  4321  4132  4231  3421
  3412  2413  1423  2431  1432  3142  3241
  2341  1342  2143  1243  3124  3214  2314
  1324  2134  1234

[edit] Erlang

Shortest form:

-module(permute).
-export([permute/1]).
 
permute([]) -> [[]];
permute(L) -> [[X|Y] || X<-L, Y<-permute(L--[X])].

Y-combinator (for shell):

F = fun(L) -> G = fun(_, []) -> [[]]; (F, L) -> [[X|Y] || X<-L, Y<-F(F, L--[X])] end, G(G, L) end.

More efficient zipper implementation:

-module(permute).
 
-export([permute/1]).
 
permute([]) -> [[]];
permute(L) -> zipper(L, [], []).
 
% Use zipper to pick up first element of permutation
zipper([], _, Acc) -> lists:reverse(Acc);
zipper([H|T], R, Acc) ->
% place current member in front of all permutations
% of rest of set - both sides of zipper
prepend(H, permute(lists:reverse(R, T)),
% pass zipper state for continuation
T, [H|R], Acc).
 
prepend(_, [], T, R, Acc) -> zipper(T, R, Acc); % continue in zipper
prepend(X, [H|T], ZT, ZR, Acc) -> prepend(X, T, ZT, ZR, [[X|H]|Acc]).

Demonstration (escript):

main(_) -> io:fwrite("~p~n", [permute:permute([1,2,3])]).
Output:
[[1,2,3],[1,3,2],[2,1,3],[2,3,1],[3,1,2],[3,2,1]]

[edit] Euphoria

Translation of: PureBasic
function reverse(sequence s, integer first, integer last)
object x
while first < last do
x = s[first]
s[first] = s[last]
s[last] = x
first += 1
last -= 1
end while
return s
end function
 
function nextPermutation(sequence s)
integer pos, last
object x
if length(s) < 1 then
return 0
end if
 
pos = length(s)-1
while compare(s[pos], s[pos+1]) >= 0 do
pos -= 1
if pos < 1 then
return -1
end if
end while
 
last = length(s)
while compare(s[last], s[pos]) <= 0 do
last -= 1
end while
x = s[pos]
s[pos] = s[last]
s[last] = x
 
return reverse(s, pos+1, length(s))
end function
 
object s
s = "abcd"
puts(1, s & '\t')
while 1 do
s = nextPermutation(s)
if atom(s) then
exit
end if
puts(1, s & '\t')
end while
Output:
abcd    abdc    acbd    acdb    adbc    adcb    bacd    badc    bcad    bcda
bdac    bdca    cabd    cadb    cbad    cbda    cdab    cdba    dabc    dacb
dbac    dbca    dcab    dcba

[edit] F#

 
let rec insert left x right = seq {
match right with
| [] -> yield left @ [x]
| head :: tail ->
yield left @ [x] @ right
yield! insert (left @ [head]) x tail
}
 
let rec perms permute =
seq {
match permute with
| [] -> yield []
| head :: tail -> yield! Seq.collect (insert [] head) (perms tail)
}
 
[<EntryPoint>]
let main argv =
perms (Seq.toList argv)
|> Seq.iter (fun x -> printf "%A\n" x)
0
 
>RosettaPermutations 1 2 3
["1"; "2"; "3"]
["2"; "1"; "3"]
["2"; "3"; "1"]
["1"; "3"; "2"]
["3"; "1"; "2"]
["3"; "2"; "1"]

[edit] Factor

The all-permutations word is part of factor's standard library. See http://docs.factorcode.org/content/word-all-permutations,math.combinatorics.html

[edit] Fortran

program permutations
 
implicit none
integer, parameter :: value_min = 1
integer, parameter :: value_max = 3
integer, parameter :: position_min = value_min
integer, parameter :: position_max = value_max
integer, dimension (position_min : position_max) :: permutation
 
call generate (position_min)
 
contains
 
recursive subroutine generate (position)
 
implicit none
integer, intent (in) :: position
integer :: value
 
if (position > position_max) then
write (*, *) permutation
else
do value = value_min, value_max
if (.not. any (permutation (: position - 1) == value)) then
permutation (position) = value
call generate (position + 1)
end if
end do
end if
 
end subroutine generate
 
end program permutations
Output:
           1           2           3
           1           3           2
           2           1           3
           2           3           1
           3           1           2
           3           2           1

Here is an alternate, iterative version in Fortran 77.

Translation of: Ada
      program nptest
integer n,i,a
logical nextp
external nextp
parameter(n=4)
dimension a(n)
do i=1,n
a(i)=i
enddo
10 print *,(a(i),i=1,n)
if(nextp(n,a)) go to 10
end
 
function nextp(n,a)
integer n,a,i,j,k,t
logical nextp
dimension a(n)
i=n-1
10 if(a(i).lt.a(i+1)) go to 20
i=i-1
if(i.eq.0) go to 20
go to 10
20 j=i+1
k=n
30 t=a(j)
a(j)=a(k)
a(k)=t
j=j+1
k=k-1
if(j.lt.k) go to 30
j=i
if(j.ne.0) go to 40
nextp=.false.
return
40 j=j+1
if(a(j).lt.a(i)) go to 40
t=a(i)
a(i)=a(j)
a(j)=t
nextp=.true.
end

[edit] GAP

GAP can handle permutations and groups. Here is a straightforward implementation : for each permutation p in S(n) (symmetric group), compute the images of 1 .. n by p. As an alternative, List(SymmetricGroup(n)) would yield the permutations as GAP Permutation objects, which would probably be more manageable in later computations.

gap>List(SymmetricGroup(4), p -> Permuted([1 .. 4], p));
perms(4);
[ [ 1, 2, 3, 4 ], [ 4, 2, 3, 1 ], [ 2, 4, 3, 1 ], [ 3, 2, 4, 1 ], [ 1, 4, 3, 2 ], [ 4, 1, 3, 2 ], [ 2, 1, 3, 4 ],
[ 3, 1, 4, 2 ], [ 1, 3, 4, 2 ], [ 4, 3, 1, 2 ], [ 2, 3, 1, 4 ], [ 3, 4, 1, 2 ], [ 1, 2, 4, 3 ], [ 4, 2, 1, 3 ],
[ 2, 4, 1, 3 ], [ 3, 2, 1, 4 ], [ 1, 4, 2, 3 ], [ 4, 1, 2, 3 ], [ 2, 1, 4, 3 ], [ 3, 1, 2, 4 ], [ 1, 3, 2, 4 ],
[ 4, 3, 2, 1 ], [ 2, 3, 4, 1 ], [ 3, 4, 2, 1 ] ]

GAP has also built-in functions to get permutations

# All arrangements of 4 elements in 1 .. 4
Arrangements([1 .. 4], 4);
# All permutations of 1 .. 4
PermutationsList([1 .. 4]);

Here is an implementation using a function to compute next permutation in lexicographic order:

NextPermutation := function(a)
local i, j, k, n, t;
n := Length(a);
i := n - 1;
while i > 0 and a[i] > a[i + 1] do
i := i - 1;
od;
j := i + 1;
k := n;
while j < k do
t := a[j];
a[j] := a[k];
a[k] := t;
j := j + 1;
k := k - 1;
od;
if i = 0 then
return false;
else
j := i + 1;
while a[j] < a[i] do
j := j + 1;
od;
t := a[i];
a[i] := a[j];
a[j] := t;
return true;
fi;
end;
 
Permutations := function(n)
local a, L;
a := List([1 .. n], x -> x);
L := [ ];
repeat
Add(L, ShallowCopy(a));
until not NextPermutation(a);
return L;
end;
 
Permutations(3);
[ [ 1, 2, 3 ], [ 1, 3, 2 ],
[ 2, 1, 3 ], [ 2, 3, 1 ],
[ 3, 1, 2 ], [ 3, 2, 1 ] ]

[edit] Go

package main
 
import "fmt"
 
func main() {
demoPerm(3)
}
 
func demoPerm(n int) {
// create a set to permute. for demo, use the integers 1..n.
s := make([]int, n)
for i := range s {
s[i] = i + 1
}
// permute them, calling a function for each permutation.
// for demo, function just prints the permutation.
permute(s, func(p []int) { fmt.Println(p) })
}
 
// permute function. takes a set to permute and a function
// to call for each generated permutation.
func permute(s []int, emit func([]int)) {
if len(s) == 0 {
emit(s)
return
}
// Steinhaus, implemented with a recursive closure.
// arg is number of positions left to permute.
// pass in len(s) to start generation.
// on each call, weave element at pp through the elements 0..np-2,
// then restore array to the way it was.
var rc func(int)
rc = func(np int) {
if np == 1 {
emit(s)
return
}
np1 := np - 1
pp := len(s) - np1
// weave
rc(np1)
for i := pp; i > 0; i-- {
s[i], s[i-1] = s[i-1], s[i]
rc(np1)
}
// restore
w := s[0]
copy(s, s[1:pp+1])
s[pp] = w
}
rc(len(s))
}
Output:
[1 2 3]
[1 3 2]
[3 1 2]
[2 1 3]
[2 3 1]
[3 2 1]

[edit] Groovy

Solution:

def makePermutations = { l -> l.permutations() }

Test:

def list = ['Crosby', 'Stills', 'Nash', 'Young']
def permutations = makePermutations(list)
assert permutations.size() == (1..<(list.size()+1)).inject(1) { prod, i -> prod*i }
permutations.each { println it }
Output:
[Young, Crosby, Stills, Nash]
[Crosby, Stills, Young, Nash]
[Nash, Crosby, Young, Stills]
[Stills, Nash, Crosby, Young]
[Young, Stills, Crosby, Nash]
[Stills, Crosby, Nash, Young]
[Stills, Crosby, Young, Nash]
[Stills, Young, Nash, Crosby]
[Nash, Stills, Young, Crosby]
[Crosby, Young, Nash, Stills]
[Crosby, Nash, Young, Stills]
[Crosby, Nash, Stills, Young]
[Nash, Young, Stills, Crosby]
[Young, Nash, Stills, Crosby]
[Nash, Young, Crosby, Stills]
[Young, Stills, Nash, Crosby]
[Crosby, Stills, Nash, Young]
[Stills, Young, Crosby, Nash]
[Young, Nash, Crosby, Stills]
[Nash, Stills, Crosby, Young]
[Young, Crosby, Nash, Stills]
[Nash, Crosby, Stills, Young]
[Crosby, Young, Stills, Nash]
[Stills, Nash, Young, Crosby]

[edit] Haskell

import Data.List (permutations)
 
main = mapM_ print (permutations [1,2,3])

A simple implementation, that assumes elements are unique and support equality:

import Data.List (delete)
 
permutations :: Eq a => [a] -> [[a]]
permutations [] = [[]]
permutations xs = [ x:ys | x <- xs, ys <- permutations (delete x xs)]

A slightly more efficient implementation that doesn't have the above restrictions:

permutations :: [a] -> [[a]]
permutations [] = [[]]
permutations xs = [ y:zs | (y,ys) <- select xs, zs <- permutations ys]
where select [] = []
select (x:xs) = (x,xs) : [ (y,x:ys) | (y,ys) <- select xs ]

The above are all selection-based approaches. The following is an insertion-based approach:

permutations :: [a] -> [[a]]
permutations = foldr (concatMap . insertEverywhere) [[]]
where insertEverywhere :: a -> [a] -> [[a]]
insertEverywhere x [] = [[x]]
insertEverywhere x l@(y:ys) = (x:l) : map (y:) (insertEverywhere x ys)

[edit] Icon and Unicon

procedure main(A)
every p := permute(A) do every writes((!p||" ")|"\n")
end
 
procedure permute(A)
if *A <= 1 then return A
suspend [(A[1]<->A[i := 1 to *A])] ||| permute(A[2:0])
end
Output:
->permute Aardvarks eat ants      
Aardvarks eat ants 
Aardvarks ants eat 
eat Aardvarks ants 
eat ants Aardvarks 
ants eat Aardvarks 
ants Aardvarks eat 
->

[edit] J

perms=: A.&i.~ !
Example use:
   perms 2
0 1
1 0
({~ perms@#)&.;: 'some random text'
some random text
some text random
random some text
random text some
text some random
text random some

[edit] Java

Using the code of Michael Gilleland.

public class PermutationGenerator {
private int[] array;
private int firstNum;
private boolean firstReady = false;
 
public PermutationGenerator(int n, int firstNum_) {
if (n < 1) {
throw new IllegalArgumentException("The n must be min. 1");
}
firstNum = firstNum_;
array = new int[n];
reset();
}
 
public void reset() {
for (int i = 0; i < array.length; i++) {
array[i] = i + firstNum;
}
firstReady = false;
}
 
public boolean hasMore() {
boolean end = firstReady;
for (int i = 1; i < array.length; i++) {
end = end && array[i] < array[i-1];
}
return !end;
}
 
public int[] getNext() {
 
if (!firstReady) {
firstReady = true;
return array;
}
 
int temp;
int j = array.length - 2;
int k = array.length - 1;
 
// Find largest index j with a[j] < a[j+1]
 
for (;array[j] > array[j+1]; j--);
 
// Find index k such that a[k] is smallest integer
// greater than a[j] to the right of a[j]
 
for (;array[j] > array[k]; k--);
 
// Interchange a[j] and a[k]
 
temp = array[k];
array[k] = array[j];
array[j] = temp;
 
// Put tail end of permutation after jth position in increasing order
 
int r = array.length - 1;
int s = j + 1;
 
while (r > s) {
temp = array[s];
array[s++] = array[r];
array[r--] = temp;
}
 
return array;
} // getNext()
 
// For testing of the PermutationGenerator class
public static void main(String[] args) {
PermutationGenerator pg = new PermutationGenerator(3, 1);
 
while (pg.hasMore()) {
int[] temp = pg.getNext();
for (int i = 0; i < temp.length; i++) {
System.out.print(temp[i] + " ");
}
System.out.println();
}
}
 
} // class
Output:
1 2 3 
1 3 2 
2 1 3 
2 3 1 
3 1 2 
3 2 1 

optimized

Following needs: Utils.java

public class Permutations {
public static void main(String[] args) {
System.out.println(Utils.Permutations(Utils.mRange(1, 3)));
}
}
Output:
[[1, 2, 3], [1, 3, 2], [2, 1, 3], [2, 3, 1], [3, 1, 2], [3, 2, 1]]

[edit] JavaScript

Copy the following as an HTML file and load in a browser.

<html><head><title>Permutations</title></head>
<body><pre id="result"></pre>
<script type="text/javascript">
var d = document.getElementById('result');
 
function perm(list, ret)
{
if (list.length == 0) {
var row = document.createTextNode(ret.join(' ') + '\n');
d.appendChild(row);
return;
}
for (var i = 0; i < list.length; i++) {
var x = list.splice(i, 1);
ret.push(x);
perm(list, ret);
ret.pop();
list.splice(i, 0, x);
}
}
 
perm([1, 2, 'A', 4], []);
</script></body></html>

[edit] K

Translation of: J
   perm:{:[1<x;,/(>:'(x,x)#1,x#0)[;0,'1+_f x-1];,!x]}
perm 2
(0 1
1 0)
 
`0:{1_,/" ",/:x}'r@perm@#r:("some";"random";"text")
some random text
some text random
random some text
random text some
text some random
text random some

[edit] Liberty BASIC

Permuting numerical array (non-recursive):

Translation of: PowerBASIC
 
n=3
dim a(n+1) '+1 needed due to bug in LB that checks loop condition
' until (i=0) or (a(i)<a(i+1))
'before executing i=i-1 in loop body.
for i=1 to n: a(i)=i: next
do
for i=1 to n: print a(i);: next: print
i=n
do
i=i-1
loop until (i=0) or (a(i)<a(i+1))
j=i+1
k=n
while j<k
'swap a(j),a(k)
tmp=a(j): a(j)=a(k): a(k)=tmp
j=j+1
k=k-1
wend
if i>0 then
j=i+1
while a(j)<a(i)
j=j+1
wend
'swap a(i),a(j)
tmp=a(j): a(j)=a(i): a(i)=tmp
end if
loop until i=0
 
Output:
123
132
213
231
312
321

Permuting string (recursive):

 
n = 3
 
s$=""
for i = 1 to n
s$=s$;i
next
 
res$=permutation$("", s$)
 
Function permutation$(pre$, post$)
lgth = Len(post$)
If lgth < 2 Then
print pre$;post$
Else
For i = 1 To lgth
tmp$=permutation$(pre$+Mid$(post$,i,1),Left$(post$,i-1)+Right$(post$,lgth-i))
Next i
End If
End Function
 
 
Output:
123
132
213
231
312
321

[edit] Logtalk

:- object(list).
 
:- public(permutation/2).
 
permutation(List, Permutation) :-
same_length(List, Permutation),
permutation2(List, Permutation).
 
permutation2([], []).
permutation2(List, [Head| Tail]) :-
select(Head, List, Remaining),
permutation2(Remaining, Tail).
 
same_length([], []).
same_length([_| Tail1], [_| Tail2]) :-
same_length(Tail1, Tail2).
 
select(Head, [Head| Tail], Tail).
select(Head, [Head2| Tail], [Head2| Tail2]) :-
select(Head, Tail, Tail2).
 
:- end_object.
Usage example:
| ?- forall(list::permutation([1, 2, 3], Permutation), (write(Permutation), nl)).
 
[1,2,3]
[1,3,2]
[2,1,3]
[2,3,1]
[3,1,2]
[3,2,1]
yes

[edit] Lua

 
local function permutation(a, n, cb)
if n == 0 then
cb(a)
else
for i = 1, n do
a[i], a[n] = a[n], a[i]
permutation(a, n - 1, cb)
a[i], a[n] = a[n], a[i]
end
end
end
 
--Usage
local function callback(a)
print('{'..table.concat(a, ', ')..'}')
end
permutation({1,2,3}, 3, callback)
 
Output:
{2, 3, 1}
{3, 2, 1}
{3, 1, 2}
{1, 3, 2}
{2, 1, 3}
{1, 2, 3}

[edit] Maple

 
> combinat:-permute( 3 );
[[1, 2, 3], [1, 3, 2], [2, 1, 3], [2, 3, 1], [3, 1, 2], [3, 2, 1]]
 
> combinat:-permute( [a,b,c] );
[[a, b, c], [a, c, b], [b, a, c], [b, c, a], [c, a, b], [c, b, a]]
 

[edit] Mathematica

Permutations[{1,2,3,4}]
Output:
{{1, 2, 3, 4}, {1, 2, 4, 3}, {1, 3, 2, 4}, {1, 3, 4, 2}, {1, 4, 2, 3}, {1, 4, 3, 2}, {2, 1, 3, 4}, {2, 1, 4, 3}, {2, 3, 1, 4}, {2, 3, 
  4, 1}, {2, 4, 1, 3}, {2, 4, 3, 1}, {3, 1, 2, 4}, {3, 1, 4, 2}, {3, 2, 1, 4}, {3, 2, 4, 1}, {3, 4, 1, 2}, {3, 4, 2, 1}, {4, 1, 2, 
  3}, {4, 1, 3, 2}, {4, 2, 1, 3}, {4, 2, 3, 1}, {4, 3, 1, 2}, {4, 3, 2, 1}}

[edit] MATLAB / Octave

perms([1,2,3,4])
Output:
4321
4312
4231
4213
4123
4132
3421
3412
3241
3214
3124
3142
2341
2314
2431
2413
2143
2134
1324
1342
1234
1243
1423
1432

[edit] Maxima

next_permutation(v) := block([n, i, j, k, t],
n: length(v), i: 0,
for k: n - 1 thru 1 step -1 do (if v[k] < v[k + 1] then (i: k, return())),
j: i + 1, k: n,
while j < k do (t: v[j], v[j]: v[k], v[k]: t, j: j + 1, k: k - 1),
if i = 0 then return(false),
j: i + 1,
while v[j] < v[i] do j: j + 1,
t: v[j], v[j]: v[i], v[i]: t,
true
)$
 
print_perm(n) := block([v: makelist(i, i, 1, n)],
disp(v),
while next_permutation(v) do disp(v)
)$
 
print_perm(3);
/* [1, 2, 3]
[1, 3, 2]
[2, 1, 3]
[2, 3, 1]
[3, 1, 2]
[3, 2, 1] */

[edit] Builtin version

 
(%i1) permutations([1, 2, 3]);
(%o1) {[1, 2, 3], [1, 3, 2], [2, 1, 3], [2, 3, 1], [3, 1, 2], [3, 2, 1]}
 

[edit] NetRexx

/* NetRexx */
options replace format comments java crossref symbols nobinary
 
import java.util.List
import java.util.ArrayList
 
-- =============================================================================
/**
* Permutation Iterator
* <br />
* <br />
* Algorithm by E. W. Dijkstra, "A Discipline of Programming", Prentice-Hall, 1976, p.71
*/

class RPermutationIterator implements Iterator
 
-- ---------------------------------------------------------------------------
properties indirect
perms = List
permOrders = int[]
maxN
currentN
first = boolean
 
-- ---------------------------------------------------------------------------
properties constant
isTrue = boolean (1 == 1)
isFalse = boolean (1 \= 1)
 
-- ---------------------------------------------------------------------------
method RPermutationIterator(initial = List) public
setUp(initial)
return
 
-- ---------------------------------------------------------------------------
method RPermutationIterator(initial = Object[]) public
init = ArrayList(initial.length)
loop elmt over initial
init.add(elmt)
end elmt
setUp(init)
return
 
-- ---------------------------------------------------------------------------
method RPermutationIterator(initial = Rexx[]) public
init = ArrayList(initial.length)
loop elmt over initial
init.add(elmt)
end elmt
setUp(init)
return
 
-- ---------------------------------------------------------------------------
method setUp(initial = List) private
setFirst(isTrue)
setPerms(initial)
setPermOrders(int[getPerms().size()])
setMaxN(getPermOrders().length)
setCurrentN(0)
po = getPermOrders()
loop i_ = 0 while i_ < po.length
po[i_] = i_
end i_
return
 
-- ---------------------------------------------------------------------------
method hasNext() public returns boolean
status = isTrue
if getCurrentN() == factorial(getMaxN()) then status = isFalse
setCurrentN(getCurrentN() + 1)
return status
 
-- ---------------------------------------------------------------------------
method next() public returns Object
if isFirst() then setFirst(isFalse)
else do
po = getPermOrders()
i_ = getMaxN() - 1
loop while po[i_ - 1] >= po[i_]
i_ = i_ - 1
end
 
j_ = getMaxN()
loop while po[j_ - 1] <= po[i_ - 1]
j_ = j_ - 1
end
 
swap(i_ - 1, j_ - 1)
 
i_ = i_ + 1
j_ = getMaxN()
loop while i_ < j_
swap(i_ - 1, j_ - 1)
i_ = i_ + 1
j_ = j_ - 1
end
end
return reorder()
 
-- ---------------------------------------------------------------------------
method remove() public signals UnsupportedOperationException
signal UnsupportedOperationException()
 
-- ---------------------------------------------------------------------------
method swap(i_, j_) private
po = getPermOrders()
save = po[i_]
po[i_] = po[j_]
po[j_] = save
return
 
-- ---------------------------------------------------------------------------
method reorder() private returns List
result = ArrayList(getPerms().size())
loop ix over getPermOrders()
result.add(getPerms().get(ix))
end ix
return result
 
-- ---------------------------------------------------------------------------
/**
* Calculate n factorial: {@code n! = 1 * 2 * 3 .. * n}
* @param n
* @return n!
*/

method factorial(n) public static
fact = 1
if n > 1 then loop i = 1 while i <= n
fact = fact * i
end i
return fact
 
-- ---------------------------------------------------------------------------
method main(args = String[]) public static
thing02 = RPermutationIterator(['alpha', 'omega'])
thing03 = RPermutationIterator([String 'one', 'two', 'three'])
thing04 = RPermutationIterator(Arrays.asList([Integer(1), Integer(2), Integer(3), Integer(4)]))
things = [thing02, thing03, thing04]
loop thing over things
N = thing.getMaxN()
say 'Permutations:' N'! =' factorial(N)
loop lineCount = 1 while thing.hasNext()
prm = thing.next()
say lineCount.right(8)':' prm.toString()
end lineCount
say 'Permutations:' N'! =' factorial(N)
say
end thing
return
 
Output:
Permutations: 2! = 2
       1: [alpha, omega]
       2: [omega, alpha]
Permutations: 2! = 2

Permutations: 3! = 6
       1: [one, two, three]
       2: [one, three, two]
       3: [two, one, three]
       4: [two, three, one]
       5: [three, one, two]
       6: [three, two, one]
Permutations: 3! = 6

Permutations: 4! = 24
       1: [1, 2, 3, 4]
       2: [1, 2, 4, 3]
       3: [1, 3, 2, 4]
       4: [1, 3, 4, 2]
       5: [1, 4, 2, 3]
       6: [1, 4, 3, 2]
       7: [2, 1, 3, 4]
       8: [2, 1, 4, 3]
       9: [2, 3, 1, 4]
      10: [2, 3, 4, 1]
      11: [2, 4, 1, 3]
      12: [2, 4, 3, 1]
      13: [3, 1, 2, 4]
      14: [3, 1, 4, 2]
      15: [3, 2, 1, 4]
      16: [3, 2, 4, 1]
      17: [3, 4, 1, 2]
      18: [3, 4, 2, 1]
      19: [4, 1, 2, 3]
      20: [4, 1, 3, 2]
      21: [4, 2, 1, 3]
      22: [4, 2, 3, 1]
      23: [4, 3, 1, 2]
      24: [4, 3, 2, 1]
Permutations: 4! = 24

[edit] OCaml

(* Iterative, though loops are implemented as auxiliary recursive functions.
Translation of Ada version. *)

let next_perm p =
let n = Array.length p in
let i = let rec aux i =
if (i < 0) || (p.(i) < p.(i+1)) then i
else aux (i - 1) in aux (n - 2) in
let rec aux j k = if j < k then
let t = p.(j) in
p.(j) <- p.(k);
p.(k) <- t;
aux (j + 1) (k - 1)
else () in aux (i + 1) (n - 1);
if i < 0 then false else
let j = let rec aux j =
if p.(j) > p.(i) then j
else aux (j + 1) in aux (i + 1) in
let t = p.(i) in
p.(i) <- p.(j);
p.(j) <- t;
true;;
 
let print_perm p =
let n = Array.length p in
for i = 0 to n - 2 do
print_int p.(i);
print_string " "
done;
print_int p.(n - 1);
print_newline ();;
 
let print_all_perm n =
let p = Array.init n (function i -> i + 1) in
print_perm p;
while next_perm p do
print_perm p
done;;
 
print_all_perm 3;;
(* 1 2 3
1 3 2
2 1 3
2 3 1
3 1 2
3 2 1 *)

Permutations can also be defined on lists recursively:

let rec permutations l =
let n = List.length l in
if n = 1 then [l] else
let rec sub e = function
| [] -> failwith "sub"
| h :: t -> if h = e then t else h :: sub e t in
let rec aux k =
let e = List.nth l k in
let subperms = permutations (sub e l) in
let t = List.map (fun a -> e::a) subperms in
if k < n-1 then List.rev_append t (aux (k+1)) else t in
aux 0;;
 
let print l = List.iter (Printf.printf " %d") l; print_newline() in
List.iter print (permutations [1;2;3;4])

or permutations indexed independently:

let rec pr_perm k n l =
let a, b = let c = k/n in c, k-(n*c) in
let e = List.nth l b in
let rec sub e = function
| [] -> failwith "sub"
| h :: t -> if h = e then t else h :: sub e t in
(Printf.printf " %d" e; if n > 1 then pr_perm a (n-1) (sub e l))
 
let show_perms l =
let n = List.length l in
let rec fact n = if n < 3 then n else n * fact (n-1) in
for i = 0 to (fact n)-1 do
pr_perm i n l;
print_newline()
done
 
let () = show_perms [1;2;3;4]

[edit] PARI/GP

vector(n!,k,numtoperm(n,k))

[edit] Pascal

program perm;
 
var
p: array[1 .. 12] of integer;
is_last: boolean;
n: integer;
 
procedure next;
var i, j, k, t: integer;
begin
is_last := true;
i := n - 1;
while i > 0 do
begin
if p[i] < p[i + 1] then
begin
is_last := false;
break;
end;
i := i - 1;
end;
 
if not is_last then
begin
j := i + 1;
k := n;
while j < k do
begin
t := p[j];
p[j] := p[k];
p[k] := t;
j := j + 1;
k := k - 1;
end;
 
j := n;
while p[j] > p[i] do j := j - 1;
j := j + 1;
 
t := p[i];
p[i] := p[j];
p[j] := t;
end;
end;
 
procedure print;
var i: integer;
begin
for i := 1 to n do write(p[i], ' ');
writeln;
end;
 
procedure init;
var i: integer;
begin
n := 0;
while (n < 1) or (n > 10) do
begin
write('Enter n (1 <= n <= 10): ');
readln(n);
end;
for i := 1 to n do p[i] := i;
end;
 
begin
init;
repeat
print;
next;
until is_last;
end.

[edit] Perl

# quick and dirty recursion
sub permutation(){
my ($perm,@set) = @_;
print "$perm\n" || return unless (@set);
&permutation($perm.$set[$_],@set[0..$_-1],@set[$_+1..$#set]) foreach (0..$#set);
}
@input = (a,2,c,4);
&permutation('',@input);
Output:
a2c4
a24c
ac24
ac42
a42c
a4c2
2ac4
2a4c
2ca4
2c4a
24ac
24ca
ca24
ca42
c2a4
c24a
c4a2
c42a
4a2c
4ac2
42ac
42ca
4ca2
4c2a

[edit] Perl 6

Works with: rakudo version 2014-1-24

First, you can just use the built-in method on any list type.

.say for <a b c>.permutations
Output:
a b c
a c b
b a c
b c a
c a b
c b a

Here is some generic code that works with any ordered type. To force lexicographic ordering, change after to gt. To force numeric order, replace it with >.

sub next_perm ( @a is copy ) {
my $j = @a.end - 1;
return Nil if --$j < 0 while @a[$j] after @a[$j+1];
 
my $aj = @a[$j];
my $k = @a.end;
$k-- while $aj after @a[$k];
@a[ $j, $k ] .= reverse;
 
my $r = @a.end;
my $s = $j + 1;
@a[ $r--, $s++ ] .= reverse while $r > $s;
return $(@a);
}
 
.say for [<a b c>], &next_perm ...^ !*;
Output:
a b c
a c b
b a c
b c a
c a b
c b a

Here is another non-recursive implementation, which returns a lazy list. It also works with any type.

sub permute(@items) {
my @seq := 1..+@items;
gather for (^[*] @seq) -> $n is copy {
my @order;
for @seq {
unshift @order, $n mod $_;
$n div= $_;
}
my @i-copy = @items;
take [ map { @i-copy.splice($_, 1) }, @order ];
}
}
.say for permute( 'a'..'c' )
Output:
a b c
a c b
b a c
b c a
c a b
c b a

Finally, if you just want zero-based numbers, you can call the built-in function:

.say for permutations(3);
Output:
0 1 2
0 2 1
1 0 2
1 2 0
2 0 1
2 1 0

[edit] PicoLisp

(load "@lib/simul.l")
 
(permute (1 2 3))
Output:
-> ((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1))

[edit] PowerBASIC

Works with: PowerBASIC version 10.00+
  #COMPILE EXE
#DIM ALL
GLOBAL a, i, j, k, n AS INTEGER
GLOBAL d, ns, s AS STRING 'dynamic string
FUNCTION PBMAIN () AS LONG
ns = INPUTBOX$(" n =",, "3") 'input n
n = VAL(ns)
DIM a(1 TO n) AS INTEGER
FOR i = 1 TO n: a(i)= i: NEXT
DO
s = " "
FOR i = 1 TO n
d = STR$(a(i))
s = BUILD$(s, d) ' s & d concatenate
NEXT
 ? s 'print and pause
i = n
DO
DECR i
LOOP UNTIL i = 0 OR a(i) < a(i+1)
j = i+1
k = n
DO WHILE j < k
SWAP a(j), a(k)
INCR j
DECR k
LOOP
IF i > 0 THEN
j = i+1
DO WHILE a(j) < a(i)
INCR j
LOOP
SWAP a(i), a(j)
END IF
LOOP UNTIL i = 0
END FUNCTION
Output:
 1 2 3
 1 3 2
 2 1 3
 2 3 1
 3 1 2
 3 2 1

[edit] Prolog

Works with SWI-Prolog and library clpfd,

:- use_module(library(clpfd)).
 
permut_clpfd(L, N) :-
length(L, N),
L ins 1..N,
all_different(L),
label(L).
Output:
?- permut_clpfd(L, 3), writeln(L), fail.
[1,2,3]
[1,3,2]
[2,1,3]
[2,3,1]
[3,1,2]
[3,2,1]
false.
 

A declarative way of fetching permutations:

% permut_Prolog(P, L)
% P is a permutation of L
 
permut_Prolog([], []).
permut_Prolog([H | T], NL) :-
select(H, NL, NL1),
permut_Prolog(T, NL1).
Output:
 ?- permut_Prolog(P, [ab, cd, ef]), writeln(P), fail.
[ab,cd,ef]
[ab,ef,cd]
[cd,ab,ef]
[cd,ef,ab]
[ef,ab,cd]
[ef,cd,ab]
false.

[edit] PureBasic

The procedure nextPermutation() takes an array of integers as input and transforms its contents into the next lexicographic permutation of it's elements (i.e. integers). It returns #True if this is possible. It returns #False if there are no more lexicographic permutations left and arranges the elements into the lowest lexicographic permutation. It also returns #False if there is less than 2 elemetns to permute.

The integer elements could be the addresses of objects that are pointed at instead. In this case the addresses will be permuted without respect to what they are pointing to (i.e. strings, or structures) and the lexicographic order will be that of the addresses themselves.

Macro reverse(firstIndex, lastIndex)
first = firstIndex
last = lastIndex
While first < last
Swap cur(first), cur(last)
first + 1
last - 1
Wend
EndMacro
 
Procedure nextPermutation(Array cur(1))
Protected first, last, elementCount = ArraySize(cur())
If elementCount < 1
ProcedureReturn #False ;nothing to permute
EndIf
 
;Find the lowest position pos such that [pos] < [pos+1]
Protected pos = elementCount - 1
While cur(pos) >= cur(pos + 1)
pos - 1
If pos < 0
reverse(0, elementCount)
ProcedureReturn #False ;no higher lexicographic permutations left, return lowest one instead
EndIf
Wend
 
;Swap [pos] with the highest positional value that is larger than [pos]
last = elementCount
While cur(last) <= cur(pos)
last - 1
Wend
Swap cur(pos), cur(last)
 
;Reverse the order of the elements in the higher positions
reverse(pos + 1, elementCount)
ProcedureReturn #True ;next lexicographic permutation found
EndProcedure
 
Procedure display(Array a(1))
Protected i, fin = ArraySize(a())
For i = 0 To fin
Print(Str(a(i)))
If i = fin: Continue: EndIf
Print(", ")
Next
PrintN("")
EndProcedure
 
If OpenConsole()
Dim a(2)
a(0) = 1: a(1) = 2: a(2) = 3
display(a())
While nextPermutation(a()): display(a()): Wend
 
Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()
CloseConsole()
EndIf
Output:
1, 2, 3
1, 3, 2
2, 1, 3
2, 3, 1
3, 1, 2
3, 2, 1

[edit] Python

Works with: Python version 2.6+
import itertools
for values in itertools.permutations([1,2,3]):
print (values)
Output:
(1, 2, 3)
(1, 3, 2)
(2, 1, 3)
(2, 3, 1)
(3, 1, 2)
(3, 2, 1)

[edit] Qi

Translation of: Erlang
 
(define insert
L 0 E -> [E|L]
[L|Ls] N E -> [L|(insert Ls (- N 1) E)])
 
(define seq
Start Start -> [Start]
Start End -> [Start|(seq (+ Start 1) End)])
 
(define append-lists
[] -> []
[A|B] -> (append A (append-lists B)))
 
(define permutate
[] -> [[]]
[H|T] -> (append-lists (map (/. P
(map (/. N
(insert P N H))
(seq 0 (length P))))
(permute T))))

[edit] R

next.perm <- function(p) {
n <- length(p)
i <- n - 1
r = TRUE
for(i in (n-1):1) {
if(p[i] < p[i+1]) {
r = FALSE
break
}
}
 
j <- i + 1
k <- n
while(j < k) {
x <- p[j]
p[j] <- p[k]
p[k] <- x
j <- j + 1
k <- k - 1
}
 
if(r) return(NULL)
 
j <- n
while(p[j] > p[i]) j <- j - 1
j <- j + 1
 
x <- p[i]
p[i] <- p[j]
p[j] <- x
return(p)
}
 
print.perms <- function(n) {
p <- 1:n
while(!is.null(p)) {
cat(p,"\n")
p <- next.perm(p)
}
}
 
print.perms(3)
# 1 2 3
# 1 3 2
# 2 1 3
# 2 3 1
# 3 1 2
# 3 2 1

[edit] Racket

 
#lang racket
 
;; using a builtin
(permutations '(A B C))
;; -> '((A B C) (B A C) (A C B) (C A B) (B C A) (C B A))
 
;; a random simple version (which is actually pretty good for a simple version)
(define (perms l)
(let loop ([l l] [tail '()])
(if (null? l) (list tail)
(append-map (λ(x) (loop (remq x l) (cons x tail))) l))))
(perms '(A B C))
;; -> '((C B A) (B C A) (C A B) (A C B) (B A C) (A B C))
 

[edit] REXX

[edit] names

This program could be simplified quite a bit if the "things" were just restricted to numbers (numerals),
but that would make it specific to numbers and not "things" or objects.

/*REXX program generates all permutations of   N   different objects.   */
parse arg things bunch inbetweenChars names
 
/* inbetweenChars (optional) defaults to a [null]. */
/* names (optional) defaults to digits (and letters). */
 
call permSets things, bunch, inbetweenChars, names
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────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= /*X can't be > length(@0abcs). */
@abc = 'abcdefghijklmnopqrstuvwxyz'; @abcU=@abc; upper @abcU
@abcS = @abcU || @abc; @0abcS=123456789 || @abcS
 
do k=1 for x /*build a list of (perm) symbols.*/
_=p(word(uSyms,k) p(substr(@0abcS,k,1) k)) /*get|generate a symbol.*/
if length(_)\==1 then sep='_' /*if not 1st char, then use sep. */
$.k=_ /*append it to the symbol list. */
end
 
if between=='' then between=sep /*use the appropriate separator. */
list='$. @. between x y'
call .permset 1
return
/*──────────────────────────────────.PERMSET subroutine─────────────────*/
.permset: procedure expose (list); parse arg ?
if ?>y then do; _=@.1; do j=2 to y; _=_||between||@.j; end; say _; end
else do q=1 for x /*build permutation recursively. */
do k=1 for ?-1; if @.k==$.q then iterate q; end /*k*/
@.?=$.q; call .permset ?+1
end /*q*/
return

output when the following was used for input: 3 3

123
132
213
231
312
321

output when the following was used for input: 4 4 --- A B C D

A---B---C---D
A---B---D---C
A---C---B---D
A---C---D---B
A---D---B---C
A---D---C---B
B---A---C---D
B---A---D---C
B---C---A---D
B---C---D---A
B---D---A---C
B---D---C---A
C---A---B---D
C---A---D---B
C---B---A---D
C---B---D---A
C---D---A---B
C---D---B---A
D---A---B---C
D---A---C---B
D---B---A---C
D---B---C---A
D---C---A---B
D---C---B---A

output when the following was used for input: 4 3 - aardvark gnu stegosaurus platypus

aardvark-gnu-stegosaurus
aardvark-gnu-platypus
aardvark-stegosaurus-gnu
aardvark-stegosaurus-platypus
aardvark-platypus-gnu
aardvark-platypus-stegosaurus
gnu-aardvark-stegosaurus
gnu-aardvark-platypus
gnu-stegosaurus-aardvark
gnu-stegosaurus-platypus
gnu-platypus-aardvark
gnu-platypus-stegosaurus
stegosaurus-aardvark-gnu
stegosaurus-aardvark-platypus
stegosaurus-gnu-aardvark
stegosaurus-gnu-platypus
stegosaurus-platypus-aardvark
stegosaurus-platypus-gnu
platypus-aardvark-gnu
platypus-aardvark-stegosaurus
platypus-gnu-aardvark
platypus-gnu-stegosaurus
platypus-stegosaurus-aardvark
platypus-stegosaurus-gnu

[edit] numbers

This version is modeled after the Maxima program (as far as output).

It doesn't have the formatting capabilities of REXX version 1, nor can it handle taking X items taken Y at-a-time.

/*REXX program shows permutations of  N  number of objects (1,2,3, ...).*/
parse arg n .; if n=='' then n=3 /*Not specified? Assume default.*/
/*populate the first permutation.*/
do pop=1 for n; @.pop=pop  ; end; call tell n
 
do while nextperm(n,0); call tell n; end
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────NEXTPERM subroutine─────────────────*/
nextperm: procedure expose @.; parse arg n,i; nm=n-1
 
do k=nm by -1 for nm; kp=k+1
if @.k<@.kp then do; i=k; leave; end
end /*k*/
 
do j=i+1 while j<n; parse value @.j @.n with @.n @.j; n=n-1; end
 
if i==0 then return 0
do j=i+1 while @.j<@.i; end
parse value @.j @.i with @.i @.j
return 1
/*──────────────────────────────────TELL subroutine─────────────────────*/
tell: procedure expose @.; _=; do j=1 for arg(1);_=_ @.j;end; say _;return

output

 1 2 3
 1 3 2
 2 1 3
 2 3 1
 3 1 2
 3 2 1

[edit] Ruby

Works with: Ruby version 1.8.7+
p [1,2,3].permutation.to_a
Output:
[[1, 2, 3], [1, 3, 2], [2, 1, 3], [2, 3, 1], [3, 1, 2], [3, 2, 1]]

However, this method will produce indistinct permutations if the array has indistinct elements. If you need to find all the permutations of an array of which many elements are the same, the method below will be more efficient.

class Array
# Yields distinct permutations of _self_ to the block.
# This method requires that all array elements be Comparable.
def distinct_permutation # :yields: _ary_
# If no block, return an enumerator. Works with Ruby 1.8.7.
block_given? or return enum_for(:distinct_permutation)
 
copy = self.sort
yield copy.dup
return if size < 2
 
while true
# from: "The Art of Computer Programming" by Donald Knuth
j = size - 2;
j -= 1 while j > 0 && copy[j] >= copy[j+1]
if copy[j] < copy[j+1]
l = size - 1
l -= 1 while copy[j] >= copy[l]
copy[j] , copy[l] = copy[l] , copy[j]
copy[j+1..-1] = copy[j+1..-1].reverse
yield copy.dup
else
break
end
end
end
end
 
permutations = []
[1,1,2].distinct_permutation do |p| permutations << p end
p permutations
# => [[1, 1, 2], [1, 2, 1], [2, 1, 1]]
 
if RUBY_VERSION >= "1.8.7"
p [1,1,2].distinct_permutation.to_a
# => [[1, 1, 2], [1, 2, 1], [2, 1, 1]]
end

[edit] Run BASIC

Works with Run BASIC, Liberty BASIC and Just BASIC

list$ = "h,e,l,l,o"		' supply list seperated with comma's
 
while word$(list$,d+1,",") <> "" 'Count how many in the list
d = d + 1
wend
 
dim theList$(d) ' place list in array
for i = 1 to d
theList$(i) = word$(list$,i,",")
next i
 
for i = 1 to d ' print the Permutations
for j = 2 to d
perm$ = ""
for k = 1 to d
perm$ = perm$ + theList$(k)
next k
if instr(perm2$,perm$+",") = 0 then print perm$ ' only list 1 time
perm2$ = perm2$ + perm$ + ","
h$ = theList$(j)
theList$(j) = theList$(j - 1)
theList$(j - 1) = h$
next j
next i
end
Output:
hello
ehllo
elhlo
ellho
elloh
leloh
lleoh
lloeh
llohe
lolhe
lohle
lohel
olhel
ohlel
ohell
hoell
heoll
helol

[edit] SAS

/* Store permutations in a SAS dataset. Translation of Fortran 77 */
data perm;
n=6;
array a{6} p1-p6;
do i=1 to n;
a(i)=i;
end;
L1:
output;
link L2;
if next then goto L1;
stop;
L2:
next=0;
i=n-1;
L10:
if a(i)<a(i+1) then goto L20;
i=i-1;
if i=0 then goto L20;
goto L10;
L20:
j=i+1;
k=n;
L30:
t=a(j);
a(j)=a(k);
a(k)=t;
j=j+1;
k=k-1;
if j<k then goto L30;
j=i;
if j=0 then return;
L40:
j=j+1;
if a(j)<a(i) then goto L40;
t=a(i);
a(i)=a(j);
a(j)=t;
next=1;
return;
keep p1-p6;
run;

[edit] Scala

There is a built-in function that works on any sequential collection. It could be used as follows given a List of symbols:

List('a, 'b, 'c).permutations foreach println
Output:
List('a, 'b, 'c)
List('a, 'c, 'b)
List('b, 'a, 'c)
List('b, 'c, 'a)
List('c, 'a, 'b)
List('c, 'b, 'a)

[edit] Scheme

Translation of: Erlang
(define (insert l n e)
(if (= 0 n)
(cons e l)
(cons (car l)
(insert (cdr l) (- n 1) e))))
 
(define (seq start end)
(if (= start end)
(list end)
(cons start (seq (+ start 1) end))))
 
(define (permute l)
(if (null? l)
'(())
(apply append (map (lambda (p)
(map (lambda (n)
(insert p n (car l)))
(seq 0 (length p))))
(permute (cdr l))))))
Translation of: OCaml
; translation of ocaml : mostly iterative, with auxiliary recursive functions for some loops
(define (vector-swap! v i j)
(let ((tmp (vector-ref v i)))
(vector-set! v i (vector-ref v j))
(vector-set! v j tmp)))
 
(define (next-perm p)
(let* ((n (vector-length p))
(i (let aux ((i (- n 2)))
(if (or (< i 0) (< (vector-ref p i) (vector-ref p (+ i 1))))
i (aux (- i 1))))))
(let aux ((j (+ i 1)) (k (- n 1)))
(if (< j k) (begin (vector-swap! p j k) (aux (+ j 1) (- k 1)))))
(if (< i 0) #f (begin
(vector-swap! p i (let aux ((j (+ i 1)))
(if (> (vector-ref p j) (vector-ref p i)) j (aux (+ j 1)))))
#t))))
 
(define (print-perm p)
(let ((n (vector-length p)))
(do ((i 0 (+ i 1))) ((= i n)) (display (vector-ref p i)) (display " "))
(newline)))
 
(define (print-all-perm n)
(let ((p (make-vector n)))
(do ((i 0 (+ i 1))) ((= i n)) (vector-set! p i i))
(print-perm p)
(do ( ) ((not (next-perm p))) (print-perm p))))
 
(print-all-perm 3)
; 0 1 2
; 0 2 1
; 1 0 2
; 1 2 0
; 2 0 1
; 2 1 0
 
;a more recursive implementation
(define (permute p i)
(let ((n (vector-length p)))
(if (= i (- n 1)) (print-perm p)
(begin
(do ((j i (+ j 1))) ((= j n))
(vector-swap! p i j)
(permute p (+ i 1)))
(do ((j (- n 1) (- j 1))) ((< j i))
(vector-swap! p i j))))))
 
 
(define (print-all-perm-rec n)
(let ((p (make-vector n)))
(do ((i 0 (+ i 1))) ((= i n)) (vector-set! p i i))
(permute p 0)))
 
(print-all-perm-rec 3)
; 0 1 2
; 0 2 1
; 1 0 2
; 1 2 0
; 2 0 1
; 2 1 0

Completely recursive on lists:

(define (perm s)
(cond ((null? s) '())
((null? (cdr s)) (list s))
(else ;; extract each item in list in turn and perm the rest
(let splice ((l '()) (m (car s)) (r (cdr s)))
(append
(map (lambda (x) (cons m x)) (perm (append l r)))
(if (null? r) '()
(splice (cons m l) (car r) (cdr r))))))))
 
(display (perm '(1 2 3)))

[edit] Seed7

$ include "seed7_05.s7i";
 
const type: permutations is array array integer;
 
const func permutations: permutations (in array integer: items) is func
result
var permutations: permsList is 0 times 0 times 0;
local
const proc: perms (in array integer: sequence, in array integer: prefix) is func
local
var integer: element is 0;
var integer: index is 0;
begin
if length(sequence) <> 0 then
for element key index range sequence do
perms(sequence[.. pred(index)] & sequence[succ(index) ..], prefix & [] (element));
end for;
else
permsList &:= prefix;
end if;
end func;
begin
perms(items, 0 times 0);
end func;
 
const proc: main is func
local
var array integer: perm is 0 times 0;
var integer: element is 0;
begin
for perm range permutations([] (1, 2, 3)) do
for element range perm do
write(element <& " ");
end for;
writeln;
end for;
end func;
Output:
1 2 3 
1 3 2 
2 1 3 
2 3 1 
3 1 2 
3 2 1 

[edit] Smalltalk

Works with: Squeak
Works with: Pharo
(1 to: 4) permutationsDo: [ :x | 
Transcript show: x printString; cr ].

[edit] Tcl

Library: Tcllib (Package: struct::list)
package require struct::list
 
# Make the sequence of digits to be permuted
set n [lindex $argv 0]
for {set i 1} {$i <= $n} {incr i} {lappend sequence $i}
 
# Iterate over the permutations, printing as we go
struct::list foreachperm p $sequence {
puts $p
}

Testing with tclsh listPerms.tcl 3 produces this output:

1 2 3
1 3 2
2 1 3
2 3 1
3 1 2
3 2 1

[edit] Ursala

In practice there's no need to write this because it's in the standard library.

#import std
 
permutations =
 
~&itB^?a( # are both the input argument list and its tail non-empty?
@ahPfatPRD *= refer ^C( # yes, recursively generate all permutations of the tail, and for each one
~&a, # insert the head at the first position
~&ar&& ~&arh2falrtPXPRD), # if the rest is non-empty, recursively insert at all subsequent positions
~&aNC) # no, return the singleton list of the argument

test program:

#cast %nLL
 
test = permutations <1,2,3>
Output:
<
   <1,2,3>,
   <2,1,3>,
   <2,3,1>,
   <1,3,2>,
   <3,1,2>,
   <3,2,1>>

[edit] VBA

Translation of: Pascal
Public Sub Permute(n As Integer, Optional printem As Boolean = True)
'generate, count and print (if printem is not false) all permutations of first n integers
 
Dim P() As Integer
Dim count As Long
dim Last as boolean
Dim t, i, j, k As Integer
 
If n <= 1 Then
Debug.Print "give a number greater than 1!"
Exit Sub
End If
 
'initialize
ReDim P(n)
For i = 1 To n: P(i) = i: Next
count = 0
Last = False
 
Do While Not Last
'print?
If printem Then
For t = 1 To n: Debug.Print P(t);: Next
Debug.Print
End If
count = count + 1
 
Last = True
i = n - 1
Do While i > 0
If P(i) < P(i + 1) Then
Last = False
Exit Do
End If
i = i - 1
Loop
 
If Not Last Then
j = i + 1
k = n
While j < k
' swap p(j) and p(k)
t = P(j)
P(j) = P(k)
P(k) = t
j = j + 1
k = k - 1
Wend
j = n
While P(j) > P(i)
j = j - 1
Wend
j = j + 1
'swap p(i) and p(j)
t = P(i)
P(i) = P(j)
P(j) = t
End If 'not last
 
Loop 'while not last
 
Debug.Print "Number of permutations: "; count
 
End Sub
Sample dialogue:
permute 1
give a number greater than 1!
permute 2
 1  2 
 2  1 
Number of permutations:  2 
permute 4
 1  2  3  4 
 1  2  4  3 
 1  3  2  4 
 1  3  4  2 
 1  4  2  3 
 1  4  3  2 
 2  1  3  4 
 2  1  4  3 
 2  3  1  4 
 2  3  4  1 
 2  4  1  3 
 2  4  3  1 
 3  1  2  4 
 3  1  4  2 
 3  2  1  4 
 3  2  4  1 
 3  4  1  2 
 3  4  2  1 
 4  1  2  3 
 4  1  3  2 
 4  2  1  3 
 4  2  3  1 
 4  3  1  2 
 4  3  2  1 
Number of permutations:  24 
permute 10,False
Number of permutations:  3628800 

[edit] XPL0

code ChOut=8, CrLf=9;
def N=4; \number of objects (letters)
char S0, S1(N);
 
proc Permute(D); \Display all permutations of letters in S0
int D; \depth of recursion
int I, J;
[if D=N then
[for I:= 0 to N-1 do ChOut(0, S1(I));
CrLf(0);
return;
];
for I:= 0 to N-1 do
[for J:= 0 to D-1 do \check if object (letter) already used
if S1(J) = S0(I) then J:=100;
if J<100 then
[S1(D):= S0(I); \object (letter) not used so append it
Permute(D+1); \recurse next level deeper
];
];
];
 
[S0:= "rose "; \N different objects (letters)
Permute(0); \(space char avoids MSb termination)
]

Output:

rose
roes
rsoe
rseo
reos
reso
orse
ores
osre
oser
oers
oesr
sroe
sreo
sore
soer
sero
seor
eros
erso
eors
eosr
esro
esor

[edit] zkl

Using the solution from task Permutations by swapping:

zkl: Utils.Helpers.permute("rose").apply("concat")
L("rose","roes","reos","eros","erso","reso","rseo","rsoe","sroe","sreo",...)
 
zkl: Utils.Helpers.permute("rose").len()
24
 
zkl: Utils.Helpers.permute(T(1,2,3,4))
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),...)
Personal tools
Namespaces

Variants
Actions
Community
Explore
Misc
Toolbox