Permutations by swapping: Difference between revisions

m
(Added Wren)
 
(33 intermediate revisions by 16 users not shown)
Line 16:
* [[wp:Steinhaus–Johnson–Trotter algorithm|Steinhaus–Johnson–Trotter algorithm]]
* [http://www.cut-the-knot.org/Curriculum/Combinatorics/JohnsonTrotter.shtml Johnson-Trotter Algorithm Listing All Permutations]
* [[wp:Heap's algorithm|Heap's algorithm]]
* [http://stackoverflow.com/a/29044942/10562 Correction to] Heap's algorithm as presented in Wikipedia and widely distributed.
* [http://www.gutenberg.org/files/18567/18567-h/18567-h.htm#ch7] Tintinnalogia
 
Line 24:
*   [[Gray code]]
<br><br>
 
=={{header|11l}}==
{{trans|Python: Iterative version of the recursive}}
 
<syntaxhighlight lang="11l">F s_permutations(seq)
V items = [[Int]()]
L(j) seq
[[Int]] new_items
L(item) items
I L.index % 2
new_items [+]= (0..item.len).map(i -> @item[0 .< i] [+] [@j] [+] @item[i..])
E
new_items [+]= (item.len..0).step(-1).map(i -> @item[0 .< i] [+] [@j] [+] @item[i..])
items = new_items
 
R enumerate(items).map((i, item) -> (item, I i % 2 {-1} E 1))
 
L(n) (3, 4)
print(‘Permutations and sign of #. items’.format(n))
L(perm, sgn) s_permutations(Array(0 .< n))
print(‘Perm: #. Sign: #2’.format(perm, sgn))
print()</syntaxhighlight>
 
{{out}}
<pre>
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
</pre>
 
=={{header|ALGOL 68}}==
Based on the pseudo-code for the recursive version of Heap's algorithm.
<syntaxhighlight lang="algol68">BEGIN # Heap's algorithm for generating permutations - from the pseudo-code on the Wikipedia page #
# generate permutations of a #
PROC generate = ( INT k, REF[]INT a, REF INT swap count )VOID:
IF k = 1 THEN
output permutation( a, swap count )
ELSE
# Generate permutations with kth unaltered #
# Initially k = length a #
generate( k - 1, a, swap count );
# Generate permutations for kth swapped with each k-1 initial #
FOR i FROM 0 TO k - 2 DO
# Swap choice dependent on parity of k (even or odd) #
swap count +:= 1;
INT swap item = IF ODD k THEN 0 ELSE i FI;
INT t = a[ swap item ];
a[ swap item ] := a[ k - 1 ];
a[ k - 1 ] := t;
generate( k - 1, a, swap count )
OD
FI # generate # ;
# generate permutations of a #
PROC permute = ( REF[]INT a )VOID:
BEGIN
INT swap count := 0;
generate( ( UPB a + 1 ) - LWB a, a[ AT 0 ], swap count )
END # permute # ;
# handle a permutation #
PROC output permutation = ( REF[]INT a, INT swap count )VOID:
BEGIN
print( ( "[" ) );
FOR i FROM LWB a TO UPB a DO
print( ( whole( a[ i ], 0 ) ) );
IF i = UPB a THEN print( ( "]" ) ) ELSE print( ( ", " ) ) FI
OD;
print( ( " sign: ", IF ODD swap count THEN "-1" ELSE " 1" FI, newline ) )
END # output permutation # ;
 
[ 1 : 3 ]INT a := ( 1, 2, 3 );
permute( a )
 
END</syntaxhighlight>
{{out}}
<pre>
[1, 2, 3] sign: 1
[2, 1, 3] sign: -1
[3, 1, 2] sign: 1
[1, 3, 2] sign: -1
[2, 3, 1] sign: 1
[3, 2, 1] sign: -1
</pre>
 
=={{header|Arturo}}==
 
<syntaxhighlight lang="rebol">permutations: function [arr][
d: 1
c: array.of: size arr 0
xs: new arr
sign: 1
 
ret: new @[@[xs, sign]]
 
while [true][
while [d > 1][
d: d-1
c\[d]: 0
]
 
while [c\[d] >= d][
d: d+1
if d >= size arr -> return ret
]
 
i: (1 = and d 1)? -> c\[d] -> 0
tmp: xs\[i]
xs\[i]: xs\[d]
xs\[d]: tmp
 
sign: neg sign
'ret ++ @[new @[xs, sign]]
c\[d]: c\[d] + 1
]
 
return ret
]
 
loop permutations 0..2 'row ->
print [row\0 "-> sign:" row\1]
 
print ""
 
loop permutations 0..3 'row ->
print [row\0 "-> sign:" row\1]</syntaxhighlight>
 
{{out}}
 
<pre>[0 1 2] -> sign: 1
[1 0 2] -> sign: -1
[2 0 1] -> sign: 1
[0 2 1] -> sign: -1
[1 2 0] -> sign: 1
[2 1 0] -> sign: -1
 
[0 1 2 3] -> sign: 1
[1 0 2 3] -> sign: -1
[2 0 1 3] -> sign: 1
[0 2 1 3] -> sign: -1
[1 2 0 3] -> sign: 1
[2 1 0 3] -> sign: -1
[3 1 0 2] -> sign: 1
[1 3 0 2] -> sign: -1
[0 3 1 2] -> sign: 1
[3 0 1 2] -> sign: -1
[1 0 3 2] -> sign: 1
[0 1 3 2] -> sign: -1
[0 2 3 1] -> sign: 1
[2 0 3 1] -> sign: -1
[3 0 2 1] -> sign: 1
[0 3 2 1] -> sign: -1
[2 3 0 1] -> sign: 1
[3 2 0 1] -> sign: -1
[3 2 1 0] -> sign: 1
[2 3 1 0] -> sign: -1
[1 3 2 0] -> sign: 1
[3 1 2 0] -> sign: -1
[2 1 3 0] -> sign: 1
[1 2 3 0] -> sign: -1</pre>
 
=={{header|AutoHotkey}}==
<langsyntaxhighlight AutoHotkeylang="autohotkey">Permutations_By_Swapping(str, list:=""){
ch := SubStr(str, 1, 1) ; get left-most charachter of str
for i, line in StrSplit(list, "`n") ; for each line in list
Line 35 ⟶ 224:
return list ; done if str is empty
return Permutations_By_Swapping(str, list) ; else recurse
}</langsyntaxhighlight>
Examples:<langsyntaxhighlight AutoHotkeylang="autohotkey">for each, line in StrSplit(Permutations_By_Swapping(1234), "`n")
result .= line "`tSign: " (mod(A_Index,2)? 1 : -1) "`n"
MsgBox, 262144, , % result
return</langsyntaxhighlight>
Outputs:<pre>1234 Sign: 1
1243 Sign: -1
Line 64 ⟶ 253:
2143 Sign: 1
2134 Sign: -1</pre>
 
=={{header|BASIC}}==
==={{header|BASIC256}}===
{{trans|Free BASIC}}
<syntaxhighlight lang="basic256">call perms(3)
print
call perms(4)
end
 
subroutine perms(n)
dim p((n+1)*4)
for i = 1 to n
p[i] = -i
next i
s = 1
do
print "Perm: [ ";
for i = 1 to n
print abs(p[i]); " ";
next i
print "] Sign: "; s
 
k = 0
for i = 2 to n
if p[i] < 0 and (abs(p[i]) > abs(p[i-1])) and (abs(p[i]) > abs(p[k])) then k = i
next i
for i = 1 to n-1
if p[i] > 0 and (abs(p[i]) > abs(p[i+1])) and (abs(p[i]) > abs(p[k])) then k = i
next i
if k then
for i = 1 to n #reverse elements > k
if abs(p[i]) > abs(p[k]) then p[i] = -p[i]
next i
if p[k] < 0 then i = k-1 else i = k+1
temp = p[k]
p[k] = p[i]
p[i] = temp
s = -s
end if
until k = 0
end subroutine</syntaxhighlight>
 
==={{header|QBasic}}===
{{works with|QBasic|1.1}}
{{works with|QuickBasic|4.5}}
{{trans|Free BASIC}}
<syntaxhighlight lang="qbasic">SUB perms (n)
DIM p((n + 1) * 4)
FOR i = 1 TO n
p(i) = -i
NEXT i
s = 1
DO
PRINT "Perm: (";
FOR i = 1 TO n
PRINT ABS(p(i)); "";
NEXT i
PRINT ") Sign: "; s
 
k = 0
FOR i = 2 TO n
IF p(i) < 0 AND (ABS(p(i)) > ABS(p(i - 1))) AND (ABS(p(i)) > ABS(p(k))) THEN k = i
NEXT i
FOR i = 1 TO n - 1
IF p(i) > 0 AND (ABS(p(i)) > ABS(p(i + 1))) AND (ABS(p(i)) > ABS(p(k))) THEN k = i
NEXT i
IF k THEN
FOR i = 1 TO n 'reverse elements > k
IF ABS(p(i)) > ABS(p(k)) THEN p(i) = -p(i)
NEXT i
'if p(k) < 0 then i = k-1 else i = k+1
i = k + SGN(p(k))
SWAP p(k), p(i)
'temp = p(k)
'p(k) = p(i)
'p(i) = temp
s = -s
END IF
LOOP UNTIL k = 0
END SUB
 
perms (3)
PRINT
perms (4)</syntaxhighlight>
 
==={{header|Run BASIC}}===
{{trans|Free BASIC}}
<syntaxhighlight lang="runbasic">sub perms n
dim p((n+1)*4)
for i = 1 to n : p(i) = i*-1 : next i
s = 1
while 1
print "Perm: [ ";
for i = 1 to n
print abs(p(i)); " ";
next i
print "] Sign: "; s
 
k = 0
for i = 2 to n
if p(i) < 0 and (abs(p(i)) > abs(p(i-1))) and (abs(p(i)) > abs(p(k))) then k = i
next i
for i = 1 to n-1
if p(i) > 0 and (abs(p(i)) > abs(p(i+1))) and (abs(p(i)) > abs(p(k))) then k = i
next i
if k then
for i = 1 to n 'reverse elements > k
if abs(p(i)) > abs(p(k)) then p(i) = p(i)*-1
next i
if p(k) < 0 then i = k-1 else i = k+1 'swap K with element looked at
temp = p(k)
p(k) = p(i)
p(i) = temp
s = s*-1 'alternate signs
end if
if k = 0 then exit while
wend
end sub
 
call perms 3
print
call perms 4</syntaxhighlight>
 
==={{header|Yabasic}}===
{{trans|Free BASIC}}
<syntaxhighlight lang="freebasic">perms(3)
print
perms(4)
end
 
sub perms(n)
dim p((n+1)*4)
for i = 1 to n
p(i) = -i
next i
s = 1
repeat
print "Perm: [ ";
for i = 1 to n
print abs(p(i)), " ";
next i
print "] Sign: ", s
 
k = 0
for i = 2 to n
if p(i) < 0 and (abs(p(i)) > abs(p(i-1))) and (abs(p(i)) > abs(p(k))) k = i
next i
for i = 1 to n-1
if p(i) > 0 and (abs(p(i)) > abs(p(i+1))) and (abs(p(i)) > abs(p(k))) k = i
next i
if k then
for i = 1 to n //reverse elements > k
if abs(p(i)) > abs(p(k)) p(i) = -p(i)
next i
i = k + sig(p(k))
temp = p(k)
p(k) = p(i)
p(i) = temp
s = -s
endif
until k = 0
end sub</syntaxhighlight>
 
=={{header|BBC BASIC}}==
{{works with|BBC BASIC for Windows}}
<langsyntaxhighlight lang="bbcbasic"> PROCperms(3)
PRINT
PROCperms(4)
Line 101 ⟶ 456:
ENDIF
UNTIL k% = 0
ENDPROC</langsyntaxhighlight>
{{out}}
<pre>
Line 139 ⟶ 494:
=={{header|C}}==
Implementation of Heap's Algorithm, array length has to be passed as a parameter for non character arrays, as sizeof() will not give correct results when malloc is used. Prints usage on incorrect invocation.
<syntaxhighlight lang="c">
<lang C>
#include<stdlib.h>
#include<string.h>
Line 207 ⟶ 562:
return 0;
}
</syntaxhighlight>
</lang>
Output:
<pre>
Line 222 ⟶ 577:
=={{header|C++}}==
Direct implementation of Johnson-Trotter algorithm from the reference link.
<langsyntaxhighlight lang="cpp">
#include <iostream>
#include <vector>
Line 285 ⟶ 640:
} while (!state.IsComplete());
}
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 314 ⟶ 669:
=={{header|Clojure}}==
===Recursive version===
<langsyntaxhighlight lang="clojure">
(defn permutation-swaps
"List of swap indexes to generate all permutations of n elements"
Line 352 ⟶ 707:
(doseq [n [2 3 4]]
(dorun (map println (permutations n))))
</syntaxhighlight>
</lang>
 
{{out}}
Line 393 ⟶ 748:
===Modeled After Python version===
{{trans|Python}}
<langsyntaxhighlight lang="clojure">
(ns test-p.core)
 
Line 456 ⟶ 811:
(println (format "Permutations and sign of %d items " n))
(doseq [q (spermutations n)] (println (format "Perm: %s Sign: %2d" (first q) (second q))))))
</syntaxhighlight>
</lang>
 
{{out}}
Line 501 ⟶ 856:
 
=={{header|Common Lisp}}==
<langsyntaxhighlight lang="lisp">(defstruct (directed-number (:conc-name dn-))
(number nil :type integer)
(direction nil :type (member :left :right)))
Line 559 ⟶ 914:
 
(permutations 3)
(permutations 4)</langsyntaxhighlight>
{{out}}
<pre>#(<1 <2 <3) sign: +1
Line 596 ⟶ 951:
This isn't a Range yet.
{{trans|Python}}
<langsyntaxhighlight lang="d">import std.algorithm, std.array, std.typecons, std.range;
 
struct Spermutations(bool doCopy=true) {
Line 679 ⟶ 1,034:
}
}
}</langsyntaxhighlight>
Compile with version=permutations_by_swapping1 to see the demo output.
{{out}}
Line 719 ⟶ 1,074:
===Recursive Version===
{{trans|Python}}
<langsyntaxhighlight lang="d">import std.algorithm, std.array, std.typecons, std.range;
 
auto sPermutations(in uint n) pure nothrow @safe {
Line 751 ⟶ 1,106:
writeln;
}
}</langsyntaxhighlight>
{{out}}
<pre>Permutations and sign of 2 items:
Line 790 ⟶ 1,145:
[2, 3, 0, 1] Sign: 1
[3, 2, 0, 1] Sign: -1
</pre>
 
=={{header|Dart}}==
{{trans|Java}}
<syntaxhighlight lang="Dart">
void main() {
List<int> array = List.generate(4, (i) => i);
HeapsAlgorithm algorithm = HeapsAlgorithm();
algorithm.recursive(array);
print('');
algorithm.loop(array);
}
 
class HeapsAlgorithm {
void recursive(List array) {
_recursive(array, array.length, true);
}
 
void _recursive(List array, int n, bool plus) {
if (n == 1) {
_output(array, plus);
} else {
for (int i = 0; i < n; i++) {
_recursive(array, n - 1, i == 0);
_swap(array, n % 2 == 0 ? i : 0, n - 1);
}
}
}
 
void _output(List array, bool plus) {
print(array.toString() + (plus ? ' +1' : ' -1'));
}
 
void _swap(List array, int a, int b) {
var temp = array[a];
array[a] = array[b];
array[b] = temp;
}
 
void loop(List array) {
_loop(array, array.length);
}
 
void _loop(List array, int n) {
List<int> c = List.filled(n, 0);
_output(array, true);
bool plus = false;
int i = 0;
while (i < n) {
if (c[i] < i) {
if (i % 2 == 0) {
_swap(array, 0, i);
} else {
_swap(array, c[i], i);
}
_output(array, plus);
plus = !plus;
c[i]++;
i = 0;
} else {
c[i] = 0;
i++;
}
}
}
}
</syntaxhighlight>
{{out}}
<pre>
[0, 1, 2, 3] +1
[1, 0, 2, 3] -1
[2, 0, 1, 3] +1
[0, 2, 1, 3] -1
[1, 2, 0, 3] +1
[2, 1, 0, 3] -1
[3, 1, 2, 0] +1
[1, 3, 2, 0] -1
[2, 3, 1, 0] +1
[3, 2, 1, 0] -1
[1, 2, 3, 0] +1
[2, 1, 3, 0] -1
[3, 0, 2, 1] +1
[0, 3, 2, 1] -1
[2, 3, 0, 1] +1
[3, 2, 0, 1] -1
[0, 2, 3, 1] +1
[2, 0, 3, 1] -1
[3, 0, 1, 2] +1
[0, 3, 1, 2] -1
[1, 3, 0, 2] +1
[3, 1, 0, 2] -1
[0, 1, 3, 2] +1
[1, 0, 3, 2] -1
 
[3, 0, 1, 2] +1
[0, 3, 1, 2] -1
[1, 3, 0, 2] +1
[3, 1, 0, 2] -1
[0, 1, 3, 2] +1
[1, 0, 3, 2] -1
[2, 0, 3, 1] +1
[0, 2, 3, 1] -1
[3, 2, 0, 1] +1
[2, 3, 0, 1] -1
[0, 3, 2, 1] +1
[3, 0, 2, 1] -1
[3, 1, 2, 0] +1
[1, 3, 2, 0] -1
[2, 3, 1, 0] +1
[3, 2, 1, 0] -1
[1, 2, 3, 0] +1
[2, 1, 3, 0] -1
[2, 1, 0, 3] +1
[1, 2, 0, 3] -1
[0, 2, 1, 3] +1
[2, 0, 1, 3] -1
[1, 0, 2, 3] +1
[0, 1, 2, 3] -1
 
</pre>
 
=={{header|Delphi}}==
{{works with|Delphi|6.0}}
{{libheader|SysUtils,StdCtrls}}
 
 
<syntaxhighlight lang="Delphi">
 
 
{These routines would normally be in a separate library; they are presented here for clarity}
 
 
{Permutator based on the Johnson and Trotter algorithm.}
{Which only permutates by swapping a pair of elements at a time}
{object steps through all permutation of array items}
{Zero-Based = True = 0..Permutions-1 False = 1..Permutaions}
{Permutation set on "Create(Size)" or by "Permutations" property}
{Permutation are contained in the array "Indices"}
 
type TDirection = (drLeftToRight,drRightToLeft);
type TDirArray = array of TDirection;
 
 
type TJTPermutator = class(TObject)
private
Dir: TDirArray;
FZeroBased: boolean;
FBase: integer;
FPermutations: integer;
procedure SetZeroBased(const Value: boolean);
procedure SetPermutations(const Value: integer);
protected
FMax: integer;
public
NextCount: Integer;
Indices: TIntegerDynArray;
constructor Create(Size: integer);
procedure Reset;
function Next: boolean;
property ZeroBased: boolean read FZeroBased write SetZeroBased;
property Permutations: integer read FPermutations write SetPermutations;
end;
 
 
{==============================================================================}
 
function Fact(N: integer): integer;
{Get factorial of N}
var I: integer;
begin
Result:=1;
for I:=1 to N do Result:=Result * I;
end;
 
 
procedure SwapIntegers(var A1,A2: integer);
{Swap integer arguments}
var T: integer;
begin
T:=A1; A1:=A2; A2:=T;
end;
 
 
procedure TJTPermutator.Reset;
var I: integer;
begin
{ Preset items 0..n-1 or 1..n depending on base}
for I:=0 to High(Indices) do Indices[I]:=I + FBase;
{ initially all directions are set to RIGHT TO LEFT }
for I:=0 to High(Indices) do Dir[I]:=drRightToLeft;
NextCount:=0;
end;
 
 
procedure TJTPermutator.SetPermutations(const Value: integer);
begin
if FPermutations<>Value then
begin
FPermutations := Value;
SetLength(Indices,Value);
SetLength(Dir,Value);
Reset;
end;
end;
 
 
 
constructor TJTPermutator.Create(Size: integer);
begin
ZeroBased:=True;
Permutations:=Size;
Reset;
end;
 
 
 
procedure TJTPermutator.SetZeroBased(const Value: boolean);
begin
if FZeroBased<>Value then
begin
FZeroBased := Value;
if Value then FBase:=0
else FBase:=1;
Reset;
end;
end;
 
 
function TJTPermutator.Next: boolean;
{Step to next permutation}
{Returns true when sequence completed}
var Mobile,Pos,I: integer;
var S: string;
 
function FindLargestMoble(Mobile: integer): integer;
{Find position of largest mobile integer in A}
var I: integer;
begin
for I:=0 to High(Indices) do
if Indices[I] = Mobile then
begin
Result:=I + 1;
exit;
end;
Result:=-1;
end;
 
 
function GetMobile: integer;
{ find the largest mobile integer.}
var LastMobile, Mobile: integer;
var I: integer;
begin
LastMobile:= 0; Mobile:= 0;
for I:=0 to High(Indices) do
begin
{ direction 0 represents RIGHT TO LEFT.}
if (Dir[Indices[I] - 1] = drRightToLeft) and (I<>0) then
begin
if (Indices[I] > Indices[I - 1]) and (Indices[I] > LastMobile) then
begin
Mobile:=Indices[I];
LastMobile:=Mobile;
end;
end;
 
{ direction 1 represents LEFT TO RIGHT.}
if (dir[Indices[I] - 1] = drLeftToRight) and (i<>(Length(Indices) - 1)) then
begin
if (Indices[I] > Indices[I + 1]) and (Indices[I] > LastMobile) then
begin
Mobile:=Indices[I];
LastMobile:=Mobile;
end;
end;
end;
 
if (Mobile = 0) and (LastMobile = 0) then Result:=0
else Result:=Mobile;
end;
 
 
 
begin
Inc(NextCount);
Result:=NextCount>=Fact(Length(Indices));
if Result then
begin
Reset;
exit;
end;
Mobile:=GetMobile;
Pos:=FindLargestMoble(Mobile);
 
{ Swap elements according to the direction in Dir}
if (Dir[Indices[pos - 1] - 1] = drRightToLeft) then SwapIntegers(Indices[Pos - 1], Indices[Pos - 2])
else if (dir[Indices[pos - 1] - 1] = drLeftToRight) then SwapIntegers(Indices[Pos], Indices[Pos - 1]);
 
{ changing the directions for elements}
{ greater than largest Mobile integer.}
for I:=0 to High(Indices) do
if Indices[I] > Mobile then
begin
if Dir[Indices[I] - 1] = drLeftToRight then Dir[Indices[I] - 1]:=drRightToLeft
else if (Dir[Indices[i] - 1] = drRightToLeft) then Dir[Indices[I] - 1]:=drLeftToRight;
end;
end;
 
 
{==============================================================================}
 
 
 
 
function GetPermutationStr(PM: TJTPermutator): string;
var I: integer;
begin
Result:=Format('%2d - [',[PM.NextCount+1]);
for I:=0 to High(PM.Indices) do Result:=Result+IntToStr(PM.Indices[I]);
Result:=Result+'] Sign: ';
if (PM.NextCount and 1)=0 then Result:=Result+'+1'
else Result:=Result+'-1';
end;
 
 
 
procedure SwapPermutations(Memo: TMemo);
var PM: TJTPermutator;
begin
PM:=TJTPermutator.Create(3);
try
repeat Memo.Lines.Add(GetPermutationStr(PM))
until PM.Next;
Memo.Lines.Add('');
 
PM.Permutations:=4;
repeat Memo.Lines.Add(GetPermutationStr(PM))
until PM.Next;
finally PM.Free; end;
end;
 
 
 
</syntaxhighlight>
{{out}}
<pre>
1 - [012] Sign: +1
2 - [021] Sign: -1
3 - [201] Sign: +1
4 - [210] Sign: -1
5 - [120] Sign: +1
6 - [102] Sign: -1
 
1 - [0123] Sign: +1
2 - [0132] Sign: -1
3 - [0312] Sign: +1
4 - [3012] Sign: -1
5 - [3021] Sign: +1
6 - [0321] Sign: -1
7 - [0231] Sign: +1
8 - [0213] Sign: -1
9 - [2013] Sign: +1
10 - [2031] Sign: -1
11 - [2301] Sign: +1
12 - [3201] Sign: -1
13 - [3210] Sign: +1
14 - [2310] Sign: -1
15 - [2130] Sign: +1
16 - [2103] Sign: -1
17 - [1203] Sign: +1
18 - [1230] Sign: -1
19 - [1320] Sign: +1
20 - [3120] Sign: -1
21 - [3102] Sign: +1
22 - [1302] Sign: -1
23 - [1032] Sign: +1
24 - [1023] Sign: -1
 
Elapsed Time: 60.734 ms.
</pre>
 
 
=={{header|EasyLang}}==
<syntaxhighlight>
# Heap's Algorithm
sig = 1
proc generate k . ar[] .
if k = 1
print ar[] & " " & sig
sig = -sig
return
.
generate k - 1 ar[]
for i to k - 1
if k mod 2 = 0
swap ar[i] ar[k]
else
swap ar[1] ar[k]
.
generate k - 1 ar[]
.
.
ar[] = [ 1 2 3 ]
generate len ar[] ar[]
</syntaxhighlight>
 
{{out}}
<pre>
[ 1 2 3 ] 1
[ 2 1 3 ] -1
[ 3 1 2 ] 1
[ 1 3 2 ] -1
[ 2 3 1 ] 1
[ 3 2 1 ] -1
</pre>
 
=={{header|EchoLisp}}==
The function '''(in-permutations n)''' returns a stream which delivers permutations according to the Steinhaus–Johnson–Trotter algorithm.
<langsyntaxhighlight lang="lisp">
(lib 'list)
 
Line 824 ⟶ 1,593:
perm: (1 0 3 2) count: 22 sign: 1
perm: (1 0 2 3) count: 23 sign: -1
</syntaxhighlight>
</lang>
 
=={{header|Elixir}}==
{{trans|Ruby}}
<langsyntaxhighlight lang="elixir">defmodule Permutation do
def by_swap(n) do
p = Enum.to_list(0..-n) |> List.to_tuple
Line 867 ⟶ 1,636:
Permutation.by_swap(n)
IO.puts ""
end)</langsyntaxhighlight>
 
{{out}}
Line 906 ⟶ 1,675:
=={{header|F_Sharp|F#}}==
See [http://www.rosettacode.org/wiki/Zebra_puzzle#F.23] for an example using this module
<langsyntaxhighlight lang="fsharp">
(*Implement Johnson-Trotter algorithm
Nigel Galloway January 24th 2017*)
Line 925 ⟶ 1,694:
yield! _Ni gel 0 1
}
</syntaxhighlight>
</lang>
A little code for the purpose of this task demonstrating the algorithm
<langsyntaxhighlight lang="fsharp">
for n in Ring.PlainChanges [|1;2;3;4|] do printfn "%A" n
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 962 ⟶ 1,731:
{{works with|gforth|0.7.9_20170308}}
{{trans|BBC BASIC}}
<langsyntaxhighlight lang="forth">S" fsl-util.fs" REQUIRED
S" fsl/dynmem.seq" REQUIRED
 
Line 1,028 ⟶ 1,797:
 
3 ' .perm perms CR
4 ' .perm perms</langsyntaxhighlight>
 
=={{header|FreeBASIC}}==
{{trans|BBC BASIC}}
<langsyntaxhighlight lang="freebasic">' version 31-03-2017
' compile with: fbc -s console
 
Line 1,091 ⟶ 1,860:
Sleep
End
</syntaxhighlight>
</lang>
{{out}}
<pre>output is edited to show results side by side
Line 1,126 ⟶ 1,895:
 
=={{header|Go}}==
<langsyntaxhighlight lang="go">package permute
 
// Iter takes a slice p and returns an iterator function. The iterator
Line 1,175 ⟶ 1,944:
}
}
}</langsyntaxhighlight>
<langsyntaxhighlight lang="go">package main
 
import (
Line 1,189 ⟶ 1,958:
fmt.Println(p, sign)
}
}</langsyntaxhighlight>
{{out}}
<pre>
Line 1,201 ⟶ 1,970:
 
=={{header|Haskell}}==
<langsyntaxhighlight lang="haskell">sPermutations :: [a] -> [([a], Int)]
sPermutations = flip zip (cycle [-1, 1]) . foldr aux [[]]
where
Line 1,215 ⟶ 1,984:
mapM_ print $ sPermutations [1 .. 3]
putStrLn "\n4 items:"
mapM_ print $ sPermutations [1 .. 4]</langsyntaxhighlight>
{{Out}}
<pre>3 items:
Line 1,256 ⟶ 2,025:
{{trans|Python}}
 
<langsyntaxhighlight lang="unicon">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))
Line 1,285 ⟶ 2,054:
every (s := "[") ||:= image(!A)||", "
return s[1:-2]||"]"
end</langsyntaxhighlight>
 
Sample run:
Line 1,330 ⟶ 2,099:
Meanwhile, here's an inductive approach, using negative integers to look left and positive integers to look right:
 
<langsyntaxhighlight Jlang="j">bfsjt0=: _1 - i.
lookingat=: 0 >. <:@# <. i.@# + *
next=: | >./@:* | > | {~ lookingat
bfsjtn=: (((] <@, ] + *@{~) | i. next) C. ] * _1 ^ next < |)^:(*@next)</langsyntaxhighlight>
 
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".)
Line 1,341 ⟶ 2,110:
Example use:
 
<langsyntaxhighlight Jlang="j"> bfsjtn^:(i.!3) bfjt0 3
_1 _2 _3
_1 _3 _2
Line 1,356 ⟶ 2,125:
1 0 2
A. <:@| bfsjtn^:(i.!3) bfjt0 3
0 1 4 5 3 2</langsyntaxhighlight>
 
Here's an example of the Steinhaus–Johnson–Trotter representation of 3 element permutation, with sign (sign is the first column):
 
<langsyntaxhighlight Jlang="j"> (_1^2|i.!3),. bfsjtn^:(i.!3) bfjt0 3
1 _1 _2 _3
_1 _1 _3 _2
Line 1,366 ⟶ 2,135:
_1 3 _2 _1
1 _2 3 _1
_1 _2 _1 3</langsyntaxhighlight>
 
Alternatively, J defines [http://www.jsoftware.com/help/dictionary/dccapdot.htm C.!.2] as the parity of a permutation:
 
<langsyntaxhighlight Jlang="j"> (,.~C.!.2)<:| bfsjtn^:(i.!3) bfjt0 3
1 0 1 2
_1 0 2 1
Line 1,376 ⟶ 2,145:
_1 2 1 0
1 1 2 0
_1 1 0 2</langsyntaxhighlight>
 
===Recursive Implementation===
Line 1,382 ⟶ 2,151:
This is based on the python recursive implementation:
 
<langsyntaxhighlight Jlang="j">rsjt=: 3 :0
if. 2>y do. i.2#y
else. ((!y)$(,~|.)-.=i.y)#inv!.(y-1)"1 y#rsjt y-1
end.
)</langsyntaxhighlight>
 
Example use (here, prefixing each row with its parity):
 
<langsyntaxhighlight Jlang="j"> (,.~ C.!.2) rsjt 3
1 0 1 2
_1 0 2 1
Line 1,396 ⟶ 2,165:
_1 2 1 0
1 1 2 0
_1 1 0 2</langsyntaxhighlight>
 
=={{header|Java}}==
Line 1,402 ⟶ 2,171:
Heap's Algorithm, recursive and looping implementations
 
<langsyntaxhighlight Javalang="java">package org.rosettacode.java;
 
import java.util.Arrays;
Line 1,469 ⟶ 2,238:
}
}
}</langsyntaxhighlight>
{{out}}
<pre>
Line 1,530 ⟶ 2,299:
input array. This array may contain any JSON entities, which are regarded as distinct.
 
<langsyntaxhighlight lang="jq"># The helper function, _recurse, is tail-recursive and therefore in
# versions of jq with TCO (tail call optimization) there is no
# overhead associated with the recursion.
Line 1,574 ⟶ 2,343:
| .[1] = reduce range(0; $n) as $i ([]; . + [$in[$p[$i] - 1]]) ;
 
def count(stream): reduce stream as $x (0; .+1);</langsyntaxhighlight>
'''Examples:'''
<langsyntaxhighlight lang="jq">(["a", "b", "c"] | permutations),
"There are \(count( [range(1;6)] | permutations )) permutations of 5 items."</langsyntaxhighlight>
{{out}}
<langsyntaxhighlight lang="sh">$ jq -c -n -f Permutations_by_swapping.jq
[1,["a","b","c"]]
[-1,["a","c","b"]]
Line 1,587 ⟶ 2,356:
[-1,["b","a","c"]]
 
"There are 32 permutations of 5 items."</langsyntaxhighlight>
 
=={{header|Julia}}==
Nonrecursive (interative):
<langsyntaxhighlight lang="julia">
function johnsontrottermove!(ints, isleft)
len = length(ints)
Line 1,650 ⟶ 2,419:
end
johnsontrotter(1,4)
</syntaxhighlight>
</lang>
Recursive (note this uses memory of roughtly (n+1)! bytes, where n is the number of elements, in order to store the accumulated permutations in a list, and so the above, iterative solution is to be preferred for numbers of elements over 9 or so):
<langsyntaxhighlight lang="julia">
function johnsontrotter(low, high)
function permutelevel(vec)
Line 1,676 ⟶ 2,445:
println("""$sequence, $(i & 1 == 1 ? "+1" : "-1")""")
end
</syntaxhighlight>
</lang>
 
=={{header|Kotlin}}==
This is based on the recursive Java code found at http://introcs.cs.princeton.edu/java/23recursion/JohnsonTrotter.java.html
<langsyntaxhighlight lang="scala">// version 1.1.2
 
fun johnsonTrotter(n: Int): Pair<List<IntArray>, List<Int>> {
Line 1,725 ⟶ 2,494:
val (perms2, signs2) = johnsonTrotter(4)
printPermsAndSigns(perms2, signs2)
}</langsyntaxhighlight>
 
{{out}}
Line 1,764 ⟶ 2,533:
=={{header|Lua}}==
{{trans|C++}}
<langsyntaxhighlight Lualang="lua">_JT={}
function JT(dim)
local n={ values={}, positions={}, directions={}, sign=1 }
Line 1,804 ⟶ 2,573:
repeat
print(unpack(perm.values))
until not perm:next()</langsyntaxhighlight>
{{out}}
<pre>1 2 3 4
Line 1,832 ⟶ 2,601:
===Coroutine Implementation===
This is adapted from the [https://www.lua.org/pil/9.3.html Lua Book ].
<langsyntaxhighlight lang="lua">local wrap, yield = coroutine.wrap, coroutine.yield
local function perm(n)
local r = {}
Line 1,852 ⟶ 2,621:
end)
end
for sign,r in perm(3) do print(sign,table.unpack(r))end</langsyntaxhighlight>
 
=={{header|Mathematica}}/{{header|Wolfram Language}}==
=== Recursive ===
<syntaxhighlight lang="text">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];</langsyntaxhighlight>
Example:
<syntaxhighlight lang="text">Print["Perm: ", #[[1]], " Sign: ", #[[2]]] & /@ perms@4;</langsyntaxhighlight>
{{out}}
<pre>Perm: {1,2,3,4} Sign: 1
Line 1,890 ⟶ 2,659:
 
=={{header|Nim}}==
<langsyntaxhighlight lang="nim"># iterative Boothroyd method
iterator permutations*[T](ys: openarray[T]): tuple[perm: seq[T], sign: int] =
var
Line 1,923 ⟶ 2,692:
 
for i in permutations([0,1,2,3]):
echo i</langsyntaxhighlight>
{{out}}
<pre>(perm: @[0, 1, 2], sign: 1)
Line 1,956 ⟶ 2,725:
(perm: @[2, 1, 3, 0], sign: 1)
(perm: @[1, 2, 3, 0], sign: -1)</pre>
 
=={{header|ooRexx}}==
===Recursive===
<syntaxhighlight lang="oorexx">/* REXX Compute permutations of things elements */
/* implementing Heap's algorithm nicely shown in */
/* https://en.wikipedia.org/wiki/Heap%27s_algorithm */
/* Recursive Algorithm */
Parse Arg things
e.=''
Select
When things='?' Then
Call help
When things='' Then
things=4
When words(things)>1 Then Do
elements=things
things=words(things)
Do i=0 By 1 While elements<>''
Parse Var elements e.i elements
End
End
Otherwise
If datatype(things)<>'NUM' Then Call help 'bunch ('bunch') must be numeric'
End
n=0
Do i=0 To things-1
a.i=i
End
Call generate things
Say time('R') 'seconds'
Exit
 
generate: Procedure Expose a. n e. things
Parse Arg k
If k=1 Then
Call show
Else Do
Call generate k-1
Do i=0 To k-2
ka=k-1
If k//2=0 Then
Parse Value a.i a.ka With a.ka a.i
Else
Parse Value a.0 a.ka With a.ka a.0
Call generate k-1
End
End
Return
 
show: Procedure Expose a. n e. things
n=n+1
ol=''
Do i=0 To things-1
z=a.i
If e.0<>'' Then
ol=ol e.z
Else
ol=ol z
End
Say strip(ol)
Return
Exit
 
help:
Parse Arg msg
If msg<>'' Then Do
Say 'ERROR:' msg
Say ''
End
Say 'rexx permx -> Permutations of 1 2 3 4 '
Say 'rexx permx 2 -> Permutations of 1 2 '
Say 'rexx permx a b c d -> Permutations of a b c d in 2 positions'
Exit</syntaxhighlight>
{{out}}
<pre>H:\>rexx permx ?
rexx permx -> Permutations of 1 2 3 4
rexx permx 2 -> Permutations of 1 2
rexx permx a b c d -> Permutations of a b c d in 2 positions
 
H:\>rexx permx 2
0 1
1 0
0 seconds
 
H:\>rexx permx a b c
a b c
b a c
c a b
a c b
b c a
c b a
0 seconds</pre>
===Iterative===
<syntaxhighlight lang="oorexx">/* REXX Compute permutations of things elements */
/* implementing Heap's algorithm nicely shown in */
/* https://en.wikipedia.org/wiki/Heap%27s_algorithm */
/* Iterative Algorithm */
Parse Arg things
e.=''
Select
When things='?' Then
Call help
When things='' Then
things=4
When words(things)>1 Then Do
elements=things
things=words(things)
Do i=0 By 1 While elements<>''
Parse Var elements e.i elements
End
End
Otherwise
If datatype(things)<>'NUM' Then Call help 'bunch ('bunch') must be numeric'
End
Do i=0 To things-1
a.i=i
End
Call time 'R'
Call generate things
Say time('E') 'seconds'
Exit
 
generate:
Parse Arg n
Call show
c.=0
i=0
Do While i<n
If c.i<i Then Do
if i//2=0 Then
Parse Value a.0 a.i With a.i a.0
Else Do
z=c.i
Parse Value a.z a.i With a.i a.z
End
Call show
c.i=c.i+1
i=0
End
Else Do
c.i=0
i=i+1
End
End
Return
 
show:
ol=''
Do j=0 To n-1
z=a.j
If e.0<>'' Then
ol=ol e.z
Else
ol=ol z
End
Say strip(ol)
Return
Exit
 
help:
Parse Arg msg
If msg<>'' Then Do
Say 'ERROR:' msg
Say ''
End
Say 'rexx permxi -> Permutations of 1 2 3 4 '
Say 'rexx permxi 2 -> Permutations of 1 2 '
Say 'rexx permxi a b c d -> Permutations of a b c d in 2 positions'
Exit</syntaxhighlight>
 
=={{header|Perl}}==
 
===S-J-T Based===
<syntaxhighlight lang="perl">use strict;
<lang perl>
#!perl
use strict;
use warnings;
 
Line 1,976 ⟶ 2,912:
# while demonstrating some common perl idioms.
 
sub perms :prototype(&@) {
my $callback = shift;
my @perm = map [$_, -1], @_;
Line 2,020 ⟶ 2,956:
print $sign < 0 ? " => -1\n" : " => +1\n";
} 1 .. $n;
</syntaxhighlight>
</lang>
{{out}}<pre>
[1, 2, 3, 4] => +1
Line 2,051 ⟶ 2,987:
This is based on the Raku recursive version, but without recursion.
 
<langsyntaxhighlight lang="perl">#!perl
use strict;
use warnings;
Line 2,076 ⟶ 3,012:
print "[", join(", ", @$_), "] => $s\n";
}
</syntaxhighlight>
</lang>
{{out}}
The output is the same as the first perl solution.
Line 2,084 ⟶ 3,020:
Only once finished did I properly grasp that odd/even permutation idea, and that it is very nearly the same algorithm.<br>
Only difference is my version directly calculates where to insert p, without using the parity (which I added in last).
<!--<syntaxhighlight lang="phix">(phixonline)-->
<lang Phix>function spermutations(integer p, integer i)
<span style="color: #008080;">function</span> <span style="color: #000000;">spermutations</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">p</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">)</span>
-- generate the i'th permutation of [1..p]:
<span style="color: #000080;font-style:italic;">--
-- first obtain the appropriate permutation of [1..p-1],
-- generate the i'th permutation of [1..p]:
-- then insert p/move it down k(=0..p-1) places from the end.
-- first obtain the appropriate permutation of [1..p-1],
integer k = mod(i-1,2*p)
-- then insert p/move ifit k>=p thendown k(=2*0..p-1-k) places from endthe ifend.
-- </span>
sequence res
<span style="color: #004080;">sequence</span> <span style="color: #000000;">res</span>
integer parity
<span style="color: #004080;">integer</span> <span style="color: #000000;">k</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">mod</span><span style="color: #0000FF;">(</span><span style="color: #000000;">i</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">2</span><span style="color: #0000FF;">*</span><span style="color: #000000;">p</span><span style="color: #0000FF;">)</span>
if p>1 then
<span style="color: #008080;">if</span> <span style="color: #000000;">k</span><span style="color: #0000FF;">>=</span><span style="color: #000000;">p</span> <span style="color: #008080;">then</span> <span style="color: #000000;">k</span><span style="color: #0000FF;">=</span><span style="color: #000000;">2</span><span style="color: #0000FF;">*</span><span style="color: #000000;">p</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">-</span><span style="color: #000000;">k</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
{res,parity} = spermutations(p-1,floor((i-1)/p)+1)
<span style="color: #008080;">if</span> <span style="color: #000000;">p</span><span style="color: #0000FF;">></span><span style="color: #000000;">1</span> <span style="color: #008080;">then</span>
res = res[1..length(res)-k]&p&res[length(res)-k+1..$]
<span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">spermutations</span><span style="color: #0000FF;">(</span><span style="color: #000000;">p</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">floor</span><span style="color: #0000FF;">((</span><span style="color: #000000;">i</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)/</span><span style="color: #000000;">p</span><span style="color: #0000FF;">)+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)</span>
else
<span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">res</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">..</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">res</span><span style="color: #0000FF;">)-</span><span style="color: #000000;">k</span><span style="color: #0000FF;">]&</span><span style="color: #000000;">p</span><span style="color: #0000FF;">&</span><span style="color: #000000;">res</span><span style="color: #0000FF;">[</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">res</span><span style="color: #0000FF;">)-</span><span style="color: #000000;">k</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">..$]</span>
res = {1}
<span style="color: #008080;">else</span>
end if
<span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">1</span><span style="color: #0000FF;">}</span>
return {res,iff(and_bits(i,1)?1:-1)}
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
end function
<span style="color: #008080;">return</span> <span style="color: #000000;">res</span>
 
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
for p=1 to 4 do
printf(1,"==%d==\n",p)
<span style="color: #008080;">for</span> <span style="color: #000000;">p</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">4</span> <span style="color: #008080;">do</span>
for i=1 to factorial(p) do
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"==%d==\n"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">p</span><span style="color: #0000FF;">)</span>
?{i,spermutations(p,i)}
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">factorial</span><span style="color: #0000FF;">(</span><span style="color: #000000;">p</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
end for
<span style="color: #004080;">integer</span> <span style="color: #000000;">parity</span> <span style="color: #0000FF;">=</span> <span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">and_bits</span><span style="color: #0000FF;">(</span><span style="color: #000000;">i</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)?</span><span style="color: #000000;">1</span><span style="color: #0000FF;">:-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)</span>
end for</lang>
<span style="color: #0000FF;">?{</span><span style="color: #000000;">i</span><span style="color: #0000FF;">,</span><span style="color: #000000;">spermutations</span><span style="color: #0000FF;">(</span><span style="color: #000000;">p</span><span style="color: #0000FF;">,</span><span style="color: #000000;">i</span><span style="color: #0000FF;">),</span><span style="color: #000000;">parity</span><span style="color: #0000FF;">}</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<!--</syntaxhighlight>-->
{{out}}
<pre>
"started"
==1==
{1,{{1},1}}
==2==
{1,{{1,2},1}}
{2,{{2,1},-1}}
==3==
{1,{{1,2,3},1}}
{2,{{1,3,2},-1}}
{3,{{3,1,2},1}}
{4,{{3,2,1},-1}}
{5,{{2,3,1},1}}
{6,{{2,1,3},-1}}
==4==
{1,{{1,2,3,4},1}}
{2,{{1,2,4,3},-1}}
{3,{{1,4,2,3},1}}
{4,{{4,1,2,3},-1}}
{5,{{4,1,3,2},1}}
{6,{{1,4,3,2},-1}}
{7,{{1,3,4,2},1}}
{8,{{1,3,2,4},-1}}
{9,{{3,1,2,4},1}}
{10,{{3,1,4,2},-1}}
{11,{{3,4,1,2},1}}
{12,{{4,3,1,2},-1}}
{13,{{4,3,2,1},1}}
{14,{{3,4,2,1},-1}}
{15,{{3,2,4,1},1}}
{16,{{3,2,1,4},-1}}
{17,{{2,3,1,4},1}}
{18,{{2,3,4,1},-1}}
{19,{{2,4,3,1},1}}
{20,{{4,2,3,1},-1}}
{21,{{4,2,1,3},1}}
{22,{{2,4,1,3},-1}}
{23,{{2,1,4,3},1}}
{24,{{2,1,3,4},-1}}
</pre>
 
=={{header|PicoLisp}}==
<syntaxhighlight lang="picolisp">(let
<lang PicoLisp>(let
(N 4
L
Line 2,191 ⟶ 3,130:
(printsp (car I)) )
(prinl) ) )
(bye)</langsyntaxhighlight>
 
=={{header|PowerShell}}==
<syntaxhighlight lang="powershell">
<lang PowerShell>
function permutation output([Object[]]$A, [Int]$k, [ref]$arraysign) {
{
function sign($A) {
"Perm: [$([String]::Join(', ', $A))] Sign: $($sign.Value)"
$size = $A.Count
}
$sign = 1
 
for($i = 0; $i -lt $size; $i++) {
function permutation([Object[]]$array)
for($j = $i+1; $j -lt $size ; $j++) {
{
if($A[$j] -lt $A[$i]) { $sign *= -1}
function generate([Object[]]$A, [Int]$k, [ref]$sign)
}
{
if($k -eq 1)
{
output $A $k $sign
$sign.Value = -$sign.Value
}
$signelse
} {
function generate($n, $A, $i1, $i2, $cnt)k -= {1
if( generate $nA -eq 1)$k {$sign
iffor([Int]$cnti -gt= 0); {$i -lt $k; $i += 1)
{
"$A -- swapped positions: $i1 $i2 -- sign = $(sign $A)`n"
} else { if($i % 2 -eq 0)
"$A -- sign = $(sign $A)`n"{
} $A[$i], $A[$k] = $A[$k], $A[$i]
}
else{
for( $i = 0; $i -lt ($n - 1); $i += 1) {
generate ($n - 1) $A $i1 $i2 $cnt
if($n % 2 -eq 0){
$i1, $i2 = $i, ($n-1)
$A[$i1], $A[$i2] = $A[$i2], $A[$i1]
$cnt = 1
}
else{
$i1, $i2 = 0, ($n-1){
$A[$i10], $A[$i2k] = $A[$i2k], $A[$i10]
$cnt = 1
}
generate $A $k $sign
}
generate ($n - 1) $A $i1 $i2 $cnt
}
}
generate $n =array $array.Count ([ref]1)
if($n -gt 0) {
(generate $n $array 0 ($n-1) 0)
} else {$array}
}
permutation @(0, 1, 2,3,4)
""
</lang>
permutation @(0, 1, 2, 3)
</syntaxhighlight>
<b>Output:</b>
<pre>Perm: [1, 0, 2] Sign: -1
<pre>
1Perm: [2, 30, 4 -- sign1] =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
2 1 3 4 -- swapped positions: 0 1 -- sign = -1
Perm: [1, 0, 2, 3] Sign: -1
 
Perm: [2, 0, 1, 3] Sign: 1
3 1 2 4 -- swapped positions: 0 2 -- sign = 1
Perm: [0, 2, 1, 3] Sign: -1
 
Perm: [1, 2, 0, 3] Sign: 1
1 3 2 4 -- swapped positions: 0 1 -- sign = -1
Perm: [2, 1, 0, 3] Sign: -1
 
2Perm: [3, 1 4 -- swapped positions:, 0, 2] -- sign =Sign: 1
Perm: [1, 3, 0, 2] Sign: -1
 
Perm: [0, 3, 1, 2] Sign: 1
3 2 1 4 -- swapped positions: 0 1 -- sign = -1
Perm: [3, 0, 1, 2] Sign: -1
 
Perm: [1, 0, 3, 2] Sign: 1
4 2 1 3 -- swapped positions: 0 3 -- sign = 1
Perm: [0, 1, 3, 2] Sign: -1
 
Perm: [2, 1, 3, 0] Sign: 1
2 4 1 3 -- swapped positions: 0 1 -- sign = -1
Perm: [1, 2, 3, 0] Sign: -1
 
Perm: [3, 2, 1, 0] Sign: 1
1 4 2 3 -- swapped positions: 0 2 -- sign = 1
Perm: [2, 3, 1, 0] Sign: -1
 
Perm: [1, 3, 2, 0] Sign: 1
4 1 2 3 -- swapped positions: 0 1 -- sign = -1
Perm: [3, 1, 2, 0] Sign: -1
 
2 1 4Perm: [3, -- swapped positions:1, 0, 2] -- sign =Sign: 1
Perm: [1, 3, 0, 2] Sign: -1
 
Perm: [0, 3, 1, 2] Sign: 1
1 2 4 3 -- swapped positions: 0 1 -- sign = -1
Perm: [3, 0, 1, 2] Sign: -1
 
Perm: [1, 0, 3, 2] Sign: 1
1 3 4 2 -- swapped positions: 1 3 -- sign = 1
Perm: [0, 1, 3, 2] Sign: -1</pre>
 
3 1 4 2 -- swapped positions: 0 1 -- sign = -1
 
4 1 3 2 -- swapped positions: 0 2 -- sign = 1
 
1 4 3 2 -- swapped positions: 0 1 -- sign = -1
 
3 4 1 2 -- swapped positions: 0 2 -- sign = 1
 
4 3 1 2 -- swapped positions: 0 1 -- sign = -1
 
4 3 2 1 -- swapped positions: 2 3 -- sign = 1
 
3 4 2 1 -- swapped positions: 0 1 -- sign = -1
 
2 4 3 1 -- swapped positions: 0 2 -- sign = 1
 
4 2 3 1 -- swapped positions: 0 1 -- sign = -1
 
3 2 4 1 -- swapped positions: 0 2 -- sign = 1
 
2 3 4 1 -- swapped positions: 0 1 -- sign = -1
</pre>
 
=={{header|Python}}==
Line 2,293 ⟶ 3,208:
When saved in a file called spermutations.py it is used in the Python example to the [[Matrix arithmetic#Python|Matrix arithmetic]] task and so any changes here should also be reflected and checked in that task example too.
 
<langsyntaxhighlight lang="python">from operator import itemgetter
DEBUG = False # like the built-in __debug__
Line 2,352 ⟶ 3,267:
# Test
p = set(permutations(range(n)))
assert sp == p, 'Two methods of generating permutations do not agree'</langsyntaxhighlight>
{{out}}
<pre>Permutations and sign of 3 items
Line 2,390 ⟶ 3,305:
===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:
<langsyntaxhighlight lang="python">def s_permutations(seq):
def s_perm(seq):
if not seq:
Line 2,408 ⟶ 3,323:
 
return [(tuple(item), -1 if i % 2 else 1)
for i, item in enumerate(s_perm(seq))]</langsyntaxhighlight>
 
{{out|Sample output}}
Line 2,415 ⟶ 3,330:
===Python: Iterative version of the recursive===
Replacing the recursion in the example above produces this iterative version function:
<langsyntaxhighlight lang="python">def s_permutations(seq):
items = [[]]
for j in seq:
Line 2,431 ⟶ 3,346:
 
return [(tuple(item), -1 if i % 2 else 1)
for i, item in enumerate(items)]</langsyntaxhighlight>
 
{{out|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.
 
=={{header|Quackery}}==
 
<syntaxhighlight lang="Quackery"> [ stack ] is parity ( --> s )
 
[ 1 & ] is odd ( n --> b )
 
[ [] swap witheach
[ nested
i odd 2 * 1 -
join nested join ] ] is +signs ( [ --> [ )
 
[ dup
[ dup 0 = iff
[ drop ' [ [ ] ] ]
done
dup temp put
1 - recurse
[] swap
witheach
[ i odd parity put
temp share times
[ temp share 1 -
over
parity share
iff i else i^
stuff
nested rot join
swap ]
drop
parity release ]
temp release ]
swap odd if reverse
+signs ] is perms ( n --> [ )
 
3 perms witheach [ echo cr ]
cr
4 perms witheach [ echo cr ]</syntaxhighlight>
 
{{out}}
 
<pre>[ [ 0 1 2 ] 1 ]
[ [ 0 2 1 ] -1 ]
[ [ 2 0 1 ] 1 ]
[ [ 2 1 0 ] -1 ]
[ [ 1 2 0 ] 1 ]
[ [ 1 0 2 ] -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 ] -1 ]
</pre>
 
=={{header|Racket}}==
<syntaxhighlight lang="racket">
<lang Racket>
#lang racket
 
Line 2,458 ⟶ 3,446:
 
(for ([n (in-range 3 5)]) (show-permutations (range n)))
</syntaxhighlight>
</lang>
 
{{out}}
Line 2,501 ⟶ 3,489:
=== Recursive ===
{{works with|rakudo|2015-09-25}}
<syntaxhighlight lang="raku" perl6line>sub insert($x, @xs) { ([flat @xs[0 ..^ $_], $x, @xs[$_ .. *]] for 0 .. +@xs) }
sub order($sg, @xs) { $sg > 0 ?? @xs !! @xs.reverse }
Line 2,512 ⟶ 3,500:
}
.say for perms([0..2]);</langsyntaxhighlight>
 
{{out}}
Line 2,523 ⟶ 3,511:
 
=={{header|REXX}}==
===Version 1===
<lang rexx>/*REXX program generates all permutations of N different objects by swapping. */
This program does not work asdescribed in the comment section
and I can't get it working for 5 things. -:( --Walter Pachl 13:40, 25 January 2022 (UTC)
 
<syntaxhighlight lang="rexx">/*REXX program generates all permutations of N different objects by swapping. */
parse arg things bunch . /*obtain optional arguments from the CL*/
if things=='' | things=="," then things=4 /*Not specified? Then use the default.*/
Line 2,568 ⟶ 3,560:
end /*k*/
end /*$*/
return /*we're all finished with permutating. */</langsyntaxhighlight>
{{out|output|text=&nbsp; when using the default input:}}
<pre>
Line 2,601 ⟶ 3,593:
</pre>
 
===Version 2===
 
See program shown for ooRexx
=={{header|Ruby}}==
{{trans|BBC BASIC}}
<langsyntaxhighlight lang="ruby">def perms(n)
p = Array.new(n+1){|i| -i}
s = 1
Line 2,628 ⟶ 3,623:
perms(i){|perm, sign| puts "Perm: #{perm} Sign: #{sign}"}
puts
end</langsyntaxhighlight>
{{out}}
<pre>
Line 2,662 ⟶ 3,657:
Perm: [2, 1, 4, 3] Sign: 1
Perm: [2, 1, 3, 4] Sign: -1
</pre>
 
=={{header|Rust}}==
<syntaxhighlight lang="rust">// Implementation of Heap's algorithm.
// See https://en.wikipedia.org/wiki/Heap%27s_algorithm#Details_of_the_algorithm
fn generate<T, F>(a: &mut [T], output: F)
where
F: Fn(&[T], isize),
{
let n = a.len();
let mut c = vec![0; n];
let mut i = 1;
let mut sign = 1;
output(a, sign);
while i < n {
if c[i] < i {
if (i & 1) == 0 {
a.swap(0, i);
} else {
a.swap(c[i], i);
}
sign = -sign;
output(a, sign);
c[i] += 1;
i = 1;
} else {
c[i] = 0;
i += 1;
}
}
}
 
fn print_permutation<T: std::fmt::Debug>(a: &[T], sign: isize) {
println!("{:?} {}", a, sign);
}
 
fn main() {
println!("Permutations and signs for three items:");
let mut a = vec![0, 1, 2];
generate(&mut a, print_permutation);
 
println!("\nPermutations and signs for four items:");
let mut b = vec![0, 1, 2, 3];
generate(&mut b, print_permutation);
}</syntaxhighlight>
 
{{out}}
<pre>
[0, 1, 2] 1
[1, 0, 2] -1
[2, 0, 1] 1
[0, 2, 1] -1
[1, 2, 0] 1
[2, 1, 0] -1
 
Permutations and signs for four items:
[0, 1, 2, 3] 1
[1, 0, 2, 3] -1
[2, 0, 1, 3] 1
[0, 2, 1, 3] -1
[1, 2, 0, 3] 1
[2, 1, 0, 3] -1
[3, 1, 0, 2] 1
[1, 3, 0, 2] -1
[0, 3, 1, 2] 1
[3, 0, 1, 2] -1
[1, 0, 3, 2] 1
[0, 1, 3, 2] -1
[0, 2, 3, 1] 1
[2, 0, 3, 1] -1
[3, 0, 2, 1] 1
[0, 3, 2, 1] -1
[2, 3, 0, 1] 1
[3, 2, 0, 1] -1
[3, 2, 1, 0] 1
[2, 3, 1, 0] -1
[1, 3, 2, 0] 1
[3, 1, 2, 0] -1
[2, 1, 3, 0] 1
[1, 2, 3, 0] -1
</pre>
 
=={{header|Scala}}==
<langsyntaxhighlight Scalalang="scala">object JohnsonTrotter extends App {
 
private def perm(n: Int): Unit = {
Line 2,700 ⟶ 3,775:
perm(4)
 
}</langsyntaxhighlight>
{{Out}}See it in running in your browser by [https://scastie.scala-lang.org/DdM4xnUnQ2aNGP481zwcrw Scastie (JVM)].
 
=={{header|Sidef}}==
{{trans|Perl}}
<langsyntaxhighlight lang="ruby">func perms(n) {
var perms = [[+1]]
for x in (1..n) {
Line 2,726 ⟶ 3,801:
s > 0 && (s = '+1')
say "#{p} => #{s}"
}</langsyntaxhighlight>
 
{{out}}
Line 2,754 ⟶ 3,829:
[2, 1, 4, 3] => +1
[2, 1, 3, 4] => -1
</pre>
 
=={{header|Swift}}==
<syntaxhighlight lang="swift">// Implementation of Heap's algorithm.
// See https://en.wikipedia.org/wiki/Heap%27s_algorithm#Details_of_the_algorithm
func generate<T>(array: inout [T], output: (_: [T], _: Int) -> Void) {
let n = array.count
var c = Array(repeating: 0, count: n)
var i = 1
var sign = 1
output(array, sign)
while i < n {
if c[i] < i {
if (i & 1) == 0 {
array.swapAt(0, i)
} else {
array.swapAt(c[i], i)
}
sign = -sign
output(array, sign)
c[i] += 1
i = 1
} else {
c[i] = 0
i += 1
}
}
}
 
func printPermutation<T>(array: [T], sign: Int) {
print("\(array) \(sign)")
}
 
print("Permutations and signs for three items:")
var a = [0, 1, 2]
generate(array: &a, output: printPermutation)
 
print("\nPermutations and signs for four items:")
var b = [0, 1, 2, 3]
generate(array: &b, output: printPermutation)</syntaxhighlight>
 
{{out}}
<pre>
Permutations and signs for three items:
[0, 1, 2] 1
[1, 0, 2] -1
[2, 0, 1] 1
[0, 2, 1] -1
[1, 2, 0] 1
[2, 1, 0] -1
 
Permutations and signs for four items:
[0, 1, 2, 3] 1
[1, 0, 2, 3] -1
[2, 0, 1, 3] 1
[0, 2, 1, 3] -1
[1, 2, 0, 3] 1
[2, 1, 0, 3] -1
[3, 1, 0, 2] 1
[1, 3, 0, 2] -1
[0, 3, 1, 2] 1
[3, 0, 1, 2] -1
[1, 0, 3, 2] 1
[0, 1, 3, 2] -1
[0, 2, 3, 1] 1
[2, 0, 3, 1] -1
[3, 0, 2, 1] 1
[0, 3, 2, 1] -1
[2, 3, 0, 1] 1
[3, 2, 0, 1] -1
[3, 2, 1, 0] 1
[2, 3, 1, 0] -1
[1, 3, 2, 0] 1
[3, 1, 2, 0] -1
[2, 1, 3, 0] 1
[1, 2, 3, 0] -1
</pre>
 
=={{header|Tcl}}==
<langsyntaxhighlight lang="tcl"># A simple swap operation
proc swap {listvar i1 i2} {
upvar 1 $listvar l
Line 2,806 ⟶ 3,957:
}
}
}</langsyntaxhighlight>
Demonstrating:
<langsyntaxhighlight lang="tcl">permswap 4 p s {
puts "$s\t$p"
}</langsyntaxhighlight>
{{out}}
<pre>
Line 2,841 ⟶ 3,992:
=={{header|Wren}}==
{{trans|Kotlin}}
<langsyntaxhighlight ecmascriptlang="wren">var johnsonTrotter = Fn.new { |n|
var p = List.filled(n, 0) // permutation
var q = List.filled(n, 0) // inverse permutation
Line 2,889 ⟶ 4,040:
perms = res[0]
signs = res[1]
printPermsAndSigns.call(perms, signs)</langsyntaxhighlight>
 
{{out}}
Line 2,928 ⟶ 4,079:
=={{header|XPL0}}==
Translation of BBC BASIC example, which uses the Johnson-Trotter algorithm.
<langsyntaxhighlight XPL0lang="xpl0">include c:\cxpl\codes;
 
proc PERMS(N);
Line 2,963 ⟶ 4,114:
CrLf(0);
PERMS(4);
]</langsyntaxhighlight>
 
{{out}}
Line 3,003 ⟶ 4,154:
{{trans|Python}}
{{trans|Haskell}}
<langsyntaxhighlight lang="zkl">fcn permute(seq)
{
insertEverywhere := fcn(x,list){ //(x,(a,b))-->((x,a,b),(a,x,b),(a,b,x))
Line 3,015 ⟶ 4,166:
T.fp(Void.Write,Void.Write));
},T(T));
}</langsyntaxhighlight>
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
<langsyntaxhighlight lang="zkl">p := permute(T(1,2,3));
p.println();
 
p := permute([1..4]);
p.len().println();
p.toString(*).println()</langsyntaxhighlight>
{{out}}
<pre>
Line 3,035 ⟶ 4,186:
</pre>
An iterative, lazy version, which is handy as the number of permutations is n!. Uses "Even's Speedup" as described in the Wikipedia article:
<langsyntaxhighlight lang="zkl"> 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
Line 3,055 ⟶ 4,206:
}
 
fcn permuteW(seq) { Utils.Generator(_permuteW,seq) }</langsyntaxhighlight>
<langsyntaxhighlight lang="zkl">foreach p in (permuteW(T("a","b","c"))){ println(p) }</langsyntaxhighlight>
{{out}}
<pre>
1,978

edits