Permutations by swapping: Difference between revisions
Content deleted Content added
m minor edit |
|||
(23 intermediate revisions by 14 users not shown) | |||
Line 28:
{{trans|Python: Iterative version of the recursive}}
<
V items = [[Int]()]
L(j) seq
Line 45:
L(perm, sgn) s_permutations(Array(0 .< n))
print(‘Perm: #. Sign: #2’.format(perm, sgn))
print()</
{{out}}
Line 82:
Perm: [1, 0, 3, 2] Sign: 1
Perm: [1, 0, 2, 3] Sign: -1
</pre>
=={{header|Ada}}==
<syntaxhighlight lang="ada">
-- Permutations by swapping
-- J. Carter 2024 Jun
-- Uses the PragmAda Reusable Components (https://github.com/jrcarter/PragmARC)
with Ada.Text_IO;
with PragmARC.Permutations;
procedure Permutations_By_Swapping is
package Permutations is new PragmARC.Permutations (Element => Positive);
Permutation : Permutations.Sequence_Lists.Vector;
begin -- Permutations_By_Swapping
Permutations.Generate (Initial => (1, 2, 3), Result => Permutation);
Output : for I in 1 .. Permutation.Last_Index loop
One_Permutation : declare
Sequence : Permutations.Sequence renames Permutation.Element (I);
begin -- One_Permutation
Ada.Text_IO.Put (Item => '(');
Print : for J in Sequence'Range loop
Ada.Text_IO.Put (Item => (if J > 1 then "," else "") & Sequence (J)'Image);
end loop Print;
Ada.Text_IO.Put_Line (Item => ") " & (if I rem 2 = 0 then '-' else '+') & '1');
end One_Permutation;
end loop Output;
end Permutations_By_Swapping;
</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|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}}==
<
d: 1
c: array.of: size arr 0
Line 124 ⟶ 220:
loop permutations 0..3 'row ->
print [row\0 "-> sign:" row\1]</
{{out}}
Line 161 ⟶ 257:
=={{header|AutoHotkey}}==
<
ch := SubStr(str, 1, 1) ; get left-most charachter of str
for i, line in StrSplit(list, "`n") ; for each line in list
Line 170 ⟶ 266:
return list ; done if str is empty
return Permutations_By_Swapping(str, list) ; else recurse
}</
Examples:<
result .= line "`tSign: " (mod(A_Index,2)? 1 : -1) "`n"
MsgBox, 262144, , % result
return</
Outputs:<pre>1234 Sign: 1
1243 Sign: -1
Line 199 ⟶ 295:
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}}
<
PRINT
PROCperms(4)
Line 236 ⟶ 498:
ENDIF
UNTIL k% = 0
ENDPROC</
{{out}}
<pre>
Line 274 ⟶ 536:
=={{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">
#include<stdlib.h>
#include<string.h>
Line 342 ⟶ 604:
return 0;
}
</syntaxhighlight>
Output:
<pre>
Line 357 ⟶ 619:
=={{header|C++}}==
Direct implementation of Johnson-Trotter algorithm from the reference link.
<
#include <iostream>
#include <vector>
Line 420 ⟶ 682:
} while (!state.IsComplete());
}
</syntaxhighlight>
{{out}}
<pre>
Line 449 ⟶ 711:
=={{header|Clojure}}==
===Recursive version===
<
(defn permutation-swaps
"List of swap indexes to generate all permutations of n elements"
Line 487 ⟶ 749:
(doseq [n [2 3 4]]
(dorun (map println (permutations n))))
</syntaxhighlight>
{{out}}
Line 528 ⟶ 790:
===Modeled After Python version===
{{trans|Python}}
<
(ns test-p.core)
Line 591 ⟶ 853:
(println (format "Permutations and sign of %d items " n))
(doseq [q (spermutations n)] (println (format "Perm: %s Sign: %2d" (first q) (second q))))))
</syntaxhighlight>
{{out}}
Line 636 ⟶ 898:
=={{header|Common Lisp}}==
<
(number nil :type integer)
(direction nil :type (member :left :right)))
Line 694 ⟶ 956:
(permutations 3)
(permutations 4)</
{{out}}
<pre>#(<1 <2 <3) sign: +1
Line 731 ⟶ 993:
This isn't a Range yet.
{{trans|Python}}
<
struct Spermutations(bool doCopy=true) {
Line 814 ⟶ 1,076:
}
}
}</
Compile with version=permutations_by_swapping1 to see the demo output.
{{out}}
Line 854 ⟶ 1,116:
===Recursive Version===
{{trans|Python}}
<
auto sPermutations(in uint n) pure nothrow @safe {
Line 886 ⟶ 1,148:
writeln;
}
}</
{{out}}
<pre>Permutations and sign of 2 items:
Line 925 ⟶ 1,187:
[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 lang=text>
# 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.
<
(lib 'list)
Line 959 ⟶ 1,635:
perm: (1 0 3 2) count: 22 sign: 1
perm: (1 0 2 3) count: 23 sign: -1
</syntaxhighlight>
=={{header|Elixir}}==
{{trans|Ruby}}
<
def by_swap(n) do
p = Enum.to_list(0..-n) |> List.to_tuple
Line 1,002 ⟶ 1,678:
Permutation.by_swap(n)
IO.puts ""
end)</
{{out}}
Line 1,041 ⟶ 1,717:
=={{header|F_Sharp|F#}}==
See [http://www.rosettacode.org/wiki/Zebra_puzzle#F.23] for an example using this module
<
(*Implement Johnson-Trotter algorithm
Nigel Galloway January 24th 2017*)
Line 1,060 ⟶ 1,736:
yield! _Ni gel 0 1
}
</syntaxhighlight>
A little code for the purpose of this task demonstrating the algorithm
<
for n in Ring.PlainChanges [|1;2;3;4|] do printfn "%A" n
</syntaxhighlight>
{{out}}
<pre>
Line 1,097 ⟶ 1,773:
{{works with|gforth|0.7.9_20170308}}
{{trans|BBC BASIC}}
<
S" fsl/dynmem.seq" REQUIRED
Line 1,163 ⟶ 1,839:
3 ' .perm perms CR
4 ' .perm perms</
=={{header|FreeBASIC}}==
{{trans|BBC BASIC}}
<
' compile with: fbc -s console
Line 1,226 ⟶ 1,902:
Sleep
End
</syntaxhighlight>
{{out}}
<pre>output is edited to show results side by side
Line 1,261 ⟶ 1,937:
=={{header|Go}}==
<
// Iter takes a slice p and returns an iterator function. The iterator
Line 1,310 ⟶ 1,986:
}
}
}</
<
import (
Line 1,324 ⟶ 2,000:
fmt.Println(p, sign)
}
}</
{{out}}
<pre>
Line 1,336 ⟶ 2,012:
=={{header|Haskell}}==
<
sPermutations = flip zip (cycle [-1, 1]) . foldr aux [[]]
where
Line 1,350 ⟶ 2,026:
mapM_ print $ sPermutations [1 .. 3]
putStrLn "\n4 items:"
mapM_ print $ sPermutations [1 .. 4]</
{{Out}}
<pre>3 items:
Line 1,391 ⟶ 2,067:
{{trans|Python}}
<
every write("Permutations of length ",n := !A) do
every p := permute(n) do write("\t",showList(p[1])," -> ",right(p[2],2))
Line 1,420 ⟶ 2,096:
every (s := "[") ||:= image(!A)||", "
return s[1:-2]||"]"
end</
Sample run:
Line 1,465 ⟶ 2,141:
Meanwhile, here's an inductive approach, using negative integers to look left and positive integers to look right:
<
lookingat=: 0 >. <:@# <. i.@# + *
next=: | >./@:* | > | {~ lookingat
bfsjtn=: (((] <@, ] + *@{~) | i. next) C. ] * _1 ^ next < |)^:(*@next)</
Here, bfsjt0 N gives the initial permutation of order N, and bfsjtn^:M bfsjt0 N gives the Mth Steinhaus–Johnson–Trotter permutation of order N. (bf stands for "brute force".)
Line 1,476 ⟶ 2,152:
Example use:
<
_1 _2 _3
_1 _3 _2
Line 1,491 ⟶ 2,167:
1 0 2
A. <:@| bfsjtn^:(i.!3) bfjt0 3
0 1 4 5 3 2</
Here's an example of the Steinhaus–Johnson–Trotter representation of 3 element permutation, with sign (sign is the first column):
<
1 _1 _2 _3
_1 _1 _3 _2
Line 1,501 ⟶ 2,177:
_1 3 _2 _1
1 _2 3 _1
_1 _2 _1 3</
Alternatively, J defines [http://www.jsoftware.com/help/dictionary/dccapdot.htm C.!.2] as the parity of a permutation:
<
1 0 1 2
_1 0 2 1
Line 1,511 ⟶ 2,187:
_1 2 1 0
1 1 2 0
_1 1 0 2</
===Recursive Implementation===
Line 1,517 ⟶ 2,193:
This is based on the python recursive implementation:
<
if. 2>y do. i.2#y
else. ((!y)$(,~|.)-.=i.y)#inv!.(y-1)"1 y#rsjt y-1
end.
)</
Example use (here, prefixing each row with its parity):
<
1 0 1 2
_1 0 2 1
Line 1,531 ⟶ 2,207:
_1 2 1 0
1 1 2 0
_1 1 0 2</
=={{header|Java}}==
Line 1,537 ⟶ 2,213:
Heap's Algorithm, recursive and looping implementations
<
import java.util.Arrays;
Line 1,604 ⟶ 2,280:
}
}
}</
{{out}}
<pre>
Line 1,665 ⟶ 2,341:
input array. This array may contain any JSON entities, which are regarded as distinct.
<
# versions of jq with TCO (tail call optimization) there is no
# overhead associated with the recursion.
Line 1,709 ⟶ 2,385:
| .[1] = reduce range(0; $n) as $i ([]; . + [$in[$p[$i] - 1]]) ;
def count(stream): reduce stream as $x (0; .+1);</
'''Examples:'''
<
"There are \(count( [range(1;6)] | permutations )) permutations of 5 items."</
{{out}}
<
[1,["a","b","c"]]
[-1,["a","c","b"]]
Line 1,722 ⟶ 2,398:
[-1,["b","a","c"]]
"There are 32 permutations of 5 items."</
=={{header|Julia}}==
Nonrecursive (interative):
<
function johnsontrottermove!(ints, isleft)
len = length(ints)
Line 1,785 ⟶ 2,461:
end
johnsontrotter(1,4)
</syntaxhighlight>
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):
<
function johnsontrotter(low, high)
function permutelevel(vec)
Line 1,811 ⟶ 2,487:
println("""$sequence, $(i & 1 == 1 ? "+1" : "-1")""")
end
</syntaxhighlight>
=={{header|Kotlin}}==
This is based on the recursive Java code found at http://introcs.cs.princeton.edu/java/23recursion/JohnsonTrotter.java.html
<
fun johnsonTrotter(n: Int): Pair<List<IntArray>, List<Int>> {
Line 1,860 ⟶ 2,536:
val (perms2, signs2) = johnsonTrotter(4)
printPermsAndSigns(perms2, signs2)
}</
{{out}}
Line 1,899 ⟶ 2,575:
=={{header|Lua}}==
{{trans|C++}}
<
function JT(dim)
local n={ values={}, positions={}, directions={}, sign=1 }
Line 1,939 ⟶ 2,615:
repeat
print(unpack(perm.values))
until not perm:next()</
{{out}}
<pre>1 2 3 4
Line 1,967 ⟶ 2,643:
===Coroutine Implementation===
This is adapted from the [https://www.lua.org/pil/9.3.html Lua Book ].
<
local function perm(n)
local r = {}
Line 1,987 ⟶ 2,663:
end)
end
for sign,r in perm(3) do print(sign,table.unpack(r))end</
=={{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];</
Example:
<syntaxhighlight lang="text">Print["Perm: ", #[[1]], " Sign: ", #[[2]]] & /@ perms@4;</
{{out}}
<pre>Perm: {1,2,3,4} Sign: 1
Line 2,025 ⟶ 2,701:
=={{header|Nim}}==
<
iterator permutations*[T](ys: openarray[T]): tuple[perm: seq[T], sign: int] =
var
Line 2,058 ⟶ 2,734:
for i in permutations([0,1,2,3]):
echo i</
{{out}}
<pre>(perm: @[0, 1, 2], sign: 1)
Line 2,091 ⟶ 2,767:
(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;
use warnings;
Line 2,111 ⟶ 2,954:
# while demonstrating some common perl idioms.
sub perms :prototype(&@) {
my $callback = shift;
my @perm = map [$_, -1], @_;
Line 2,155 ⟶ 2,998:
print $sign < 0 ? " => -1\n" : " => +1\n";
} 1 .. $n;
</syntaxhighlight>
{{out}}<pre>
[1, 2, 3, 4] => +1
Line 2,186 ⟶ 3,029:
This is based on the Raku recursive version, but without recursion.
<
use strict;
use warnings;
Line 2,211 ⟶ 3,054:
print "[", join(", ", @$_), "] => $s\n";
}
</syntaxhighlight>
{{out}}
The output is the same as the first perl solution.
Line 2,219 ⟶ 3,062:
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).
<!--<
<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>
<span style="color: #000080;font-style:italic;">--
Line 2,245 ⟶ 3,088:
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<!--</
{{out}}
<pre>
Line 2,288 ⟶ 3,131:
=={{header|PicoLisp}}==
<syntaxhighlight lang="picolisp">(let
(N 4
L
Line 2,329 ⟶ 3,172:
(printsp (car I)) )
(prinl) ) )
(bye)</
=={{header|PowerShell}}==
<syntaxhighlight lang="powershell">
function output([Object[]]$A, [Int]$k, [ref]$sign)
{
"Perm: [$([String]::Join(', ', $A))] Sign: $($sign.Value)
}
Line 2,349 ⟶ 3,192:
else
{
for([Int]$i = 0; $i -lt $k; $i += 1)
{
if($i % 2 -eq 0)
{
$A[$i], $A[$k
}
else
{
$A[0], $A[$k
}
generate $A
}
}
Line 2,366 ⟶ 3,210:
generate $array $array.Count ([ref]1)
}
permutation @(0, 1, 2
""
permutation @(0, 1, 2, 3)
</syntaxhighlight>
<b>Output:</b>
<pre>Perm: [1, 0, 2] Sign: -1
Perm: [2, 0, 1
Perm: [0, 2, 1] Sign: -1
Perm: [1, 2, 0] Sign: 1
Perm: [2, 1, 0] Sign: -1
Perm: [
Perm: [1, 0, 2, 3] Sign: -1
Perm: [2, 0, 1, 3] Sign: 1
Perm: [0, 2, 1, 3] Sign: -1
Perm: [
Perm: [2, 1, 0, 3] Sign: -1
Perm: [
Perm: [1, 3, 0, 2] Sign: -1
Perm: [
Perm: [3, 0, 1, 2] Sign: -1
Perm: [
Perm: [0, 1, 3, 2] Sign: -1
Perm: [2, 1, 3, 0
Perm: [1, 2, 3, 0] Sign: -1
Perm: [
Perm: [2, 3, 1, 0] Sign: -1
Perm: [
Perm: [3, 1, 2, 0] Sign: -1
Perm: [3, 1, 0
Perm: [1, 3, 0, 2] Sign: -1
Perm: [0,
Perm: [3, 0, 1, 2] Sign: -1
Perm: [
Perm: [0, 1, 3, 2] Sign: -1</pre>
=={{header|Python}}==
Line 2,423 ⟶ 3,250:
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.
<
DEBUG = False # like the built-in __debug__
Line 2,482 ⟶ 3,309:
# Test
p = set(permutations(range(n)))
assert sp == p, 'Two methods of generating permutations do not agree'</
{{out}}
<pre>Permutations and sign of 3 items
Line 2,520 ⟶ 3,347:
===Python: recursive===
After spotting the pattern of highest number being inserted into each perm of lower numbers from right to left, then left to right, I developed this recursive function:
<
def s_perm(seq):
if not seq:
Line 2,538 ⟶ 3,365:
return [(tuple(item), -1 if i % 2 else 1)
for i, item in enumerate(s_perm(seq))]</
{{out|Sample output}}
Line 2,545 ⟶ 3,372:
===Python: Iterative version of the recursive===
Replacing the recursion in the example above produces this iterative version function:
<
items = [[]]
for j in seq:
Line 2,561 ⟶ 3,388:
return [(tuple(item), -1 if i % 2 else 1)
for i, item in enumerate(items)]</
{{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
Line 2,588 ⟶ 3,488:
(for ([n (in-range 3 5)]) (show-permutations (range n)))
</syntaxhighlight>
{{out}}
Line 2,631 ⟶ 3,531:
=== Recursive ===
{{works with|rakudo|2015-09-25}}
<syntaxhighlight lang="raku"
sub order($sg, @xs) { $sg > 0 ?? @xs !! @xs.reverse }
Line 2,642 ⟶ 3,542:
}
.say for perms([0..2]);</
{{out}}
Line 2,653 ⟶ 3,553:
=={{header|REXX}}==
===Version 1===
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,698 ⟶ 3,602:
end /*k*/
end /*$*/
return /*we're all finished with permutating. */</
{{out|output|text= when using the default input:}}
<pre>
Line 2,731 ⟶ 3,635:
</pre>
===Version 2===
See program shown for ooRexx
=={{header|Ruby}}==
{{trans|BBC BASIC}}
<
p = Array.new(n+1){|i| -i}
s = 1
Line 2,758 ⟶ 3,665:
perms(i){|perm, sign| puts "Perm: #{perm} Sign: #{sign}"}
puts
end</
{{out}}
<pre>
Line 2,795 ⟶ 3,702:
=={{header|Rust}}==
<
// See https://en.wikipedia.org/wiki/Heap%27s_algorithm#Details_of_the_algorithm
fn generate<T, F>(a: &mut [T], output: F)
Line 2,836 ⟶ 3,743:
let mut b = vec![0, 1, 2, 3];
generate(&mut b, print_permutation);
}</
{{out}}
Line 2,875 ⟶ 3,782:
=={{header|Scala}}==
<
private def perm(n: Int): Unit = {
Line 2,910 ⟶ 3,817:
perm(4)
}</
{{Out}}See it in running in your browser by [https://scastie.scala-lang.org/DdM4xnUnQ2aNGP481zwcrw Scastie (JVM)].
=={{header|Sidef}}==
{{trans|Perl}}
<
var perms = [[+1]]
for x in (1..n) {
Line 2,936 ⟶ 3,843:
s > 0 && (s = '+1')
say "#{p} => #{s}"
}</
{{out}}
Line 2,967 ⟶ 3,874:
=={{header|Swift}}==
<
// See https://en.wikipedia.org/wiki/Heap%27s_algorithm#Details_of_the_algorithm
func generate<T>(array: inout [T], output: (_: [T], _: Int) -> Void) {
Line 3,003 ⟶ 3,910:
print("\nPermutations and signs for four items:")
var b = [0, 1, 2, 3]
generate(array: &b, output: printPermutation)</
{{out}}
Line 3,043 ⟶ 3,950:
=={{header|Tcl}}==
<
proc swap {listvar i1 i2} {
upvar 1 $listvar l
Line 3,092 ⟶ 3,999:
}
}
}</
Demonstrating:
<
puts "$s\t$p"
}</
{{out}}
<pre>
Line 3,127 ⟶ 4,034:
=={{header|Wren}}==
{{trans|Kotlin}}
<
var p = List.filled(n, 0) // permutation
var q = List.filled(n, 0) // inverse permutation
Line 3,175 ⟶ 4,082:
perms = res[0]
signs = res[1]
printPermsAndSigns.call(perms, signs)</
{{out}}
Line 3,214 ⟶ 4,121:
=={{header|XPL0}}==
Translation of BBC BASIC example, which uses the Johnson-Trotter algorithm.
<
proc PERMS(N);
Line 3,249 ⟶ 4,156:
CrLf(0);
PERMS(4);
]</
{{out}}
Line 3,289 ⟶ 4,196:
{{trans|Python}}
{{trans|Haskell}}
<
{
insertEverywhere := fcn(x,list){ //(x,(a,b))-->((x,a,b),(a,x,b),(a,b,x))
Line 3,301 ⟶ 4,208:
T.fp(Void.Write,Void.Write));
},T(T));
}</
A cycle of two "build list" functions is used to insert x forward or reverse. reduce loops over the items and retains the enlarging list of permuations. pump loops over the existing set of permutations and inserts/builds the next set (into a list sink). (Void.Write,Void.Write,list) is a sentinel that says to write the contents of the list to the sink (ie sink.extend(list)). T.fp is a partial application of ROList.create (read only list) and the parameters VW,VW. It will be called (by pump) with a list of lists --> T.create(VM,VM,list) --> list
<
p.println();
p := permute([1..4]);
p.len().println();
p.toString(*).println()</
{{out}}
<pre>
Line 3,321 ⟶ 4,228:
</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:
<
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,341 ⟶ 4,248:
}
fcn permuteW(seq) { Utils.Generator(_permuteW,seq) }</
<
{{out}}
<pre>
|