Permutations: Difference between revisions

16,487 bytes added ,  14 days ago
(Permutations in BASIC256)
 
(36 intermediate revisions by 20 users not shown)
Line 14:
 
=={{header|11l}}==
<langsyntaxhighlight lang="11l">V a = [1, 2, 3]
L
print(a)
I !a.next_permutation()
L.break</langsyntaxhighlight>
 
{{out}}
Line 32:
=={{header|360 Assembly}}==
{{trans|Liberty BASIC}}
<langsyntaxhighlight lang="360asm">* Permutations 26/10/2015
PERMUTE CSECT
USING PERMUTE,R15 set base register
Line 92:
PG DC CL80' ' buffer
YREGS
END PERMUTE</langsyntaxhighlight>
{{out}}
<pre style="height:40ex;overflow:scroll">
Line 123:
=={{header|AArch64 Assembly}}==
{{works with|as|Raspberry Pi 3B version Buster 64 bits}}
<syntaxhighlight lang="aarch64 assembly">
<lang AArch64 Assembly>
/* ARM assembly AARCH64 Raspberry PI 3B */
/* program permutation64.s */
Line 275:
.include "../includeARM64.inc"
 
</syntaxhighlight>
</lang>
<pre>
Value : +1
Line 304:
</pre>
=={{header|ABAP}}==
<langsyntaxhighlight ABAPlang="abap">data: lv_flag type c,
lv_number type i,
lt_numbers type table of i.
Line 403:
modify iv_set index lv_perm from lv_temp_2.
modify iv_set index lv_len from lv_temp.
endform.</langsyntaxhighlight>
{{out}}
<pre>
Line 418:
 
=={{header|Action!}}==
<langsyntaxhighlight Actionlang="action!">PROC PrintArray(BYTE ARRAY a BYTE len)
BYTE i
 
Line 477:
 
RMARGIN=oldRMARGIN ;restore right margin on the screen
RETURN</langsyntaxhighlight>
{{out}}
[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/Permutations.png Screenshot from Atari 8-bit computer]
Line 509:
===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:
<langsyntaxhighlight lang="ada">generic
N: positive;
package Generic_Perm is
Line 517:
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;</langsyntaxhighlight>
 
Here is the implementation of the package:
<langsyntaxhighlight lang="ada">package body Generic_Perm is
 
Line 590:
end Go_To_Next;
end Generic_Perm;</langsyntaxhighlight>
 
===The procedure Print_Perms===
<langsyntaxhighlight lang="ada">with Ada.Text_IO, Ada.Command_Line, Generic_Perm;
procedure Print_Perms is
Line 622:
when Constraint_Error
=> TIO.Put_Line ("*** Error: enter one numerical argument n with n >= 1");
end Print_Perms;</langsyntaxhighlight>
 
{{out}}
Line 635:
 
=={{header|Aime}}==
<langsyntaxhighlight lang="aime">void
f1(record r, ...)
{
Line 658:
 
0;
}</langsyntaxhighlight>
{{Out}}
<pre>aime permutations -a Aaa Bb C
Line 672:
{{works with|ALGOL 68G|Any - tested with release [http://sourceforge.net/projects/algol68/files/algol68g/algol68g-2.6 algol68g-2.6].}}
{{wont work with|ELLA ALGOL 68|Any (with appropriate job cards) - tested with release [http://sourceforge.net/projects/algol68/files/algol68toc/algol68toc-1.8.8d/algol68toc-1.8-8d.fc9.i386.rpm/download 1.8-8d] - due to extensive use of '''format'''[ted] ''transput''.}}
'''File: prelude_permutations.a68'''<langsyntaxhighlight lang="algol68"># -*- coding: utf-8 -*- #
 
COMMENT REQUIRED BY "prelude_permutations.a68"
Line 704:
);
SKIP</langsyntaxhighlight>'''File: test_permutations.a68'''<langsyntaxhighlight lang="algol68">#!/usr/bin/a68g --script #
# -*- coding: utf-8 -*- #
 
Line 727:
# OD #))
)</langsyntaxhighlight>'''Output:'''
<pre>
(1, 22, 333, 44444)
Line 757:
=={{header|Amazing Hopper}}==
{{trans|AWK}}
<syntaxhighlight lang="amazing hopper">
<lang Amazing Hopper>
/* hopper-JAMBO - a flavour of Amazing Hopper! */
 
Line 793:
Set(c), [ leng ] Cput(lista)
Return
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 806:
=={{header|APL}}==
For Dyalog APL(assumes index origin ⎕IO←1):
<syntaxhighlight lang="apl">
<lang APL>
⍝ Builtin version, takes a vector:
⎕CY'dfns'
Line 814:
dpmat←{1=⍵:,⊂,0 ⋄ (⊃,/)¨(⍳⍵)⌽¨⊂(⊂(!⍵-1)⍴⍵-1),⍨∇⍵-1}
perms2←{↓⍵[1+⍉↑dpmat ≢⍵]}
</syntaxhighlight>
</lang>
 
<pre>
Line 833:
 
Recursively, in terms of concatMap and delete:
<langsyntaxhighlight AppleScriptlang="applescript">----------------------- PERMUTATIONS -----------------------
 
-- permutations :: [a] -> [[a]]
Line 919:
missing value
end if
end uncons</langsyntaxhighlight>
{{Out}}
<pre>{{"aardvarks", "eat", "ants"}, {"aardvarks", "ants", "eat"},
Line 927:
{{trans|Pseudocode}}
(Fast recursive Heap's algorithm)
<langsyntaxhighlight AppleScriptlang="applescript">to DoPermutations(aList, n)
--> Heaps's algorithm (Permutation by interchanging pairs)
if n = 1 then
Line 968:
DoPermutations(SourceList, SourceList's length)
--> result (value of Permlist)
{"123", "213", "312", "132", "231", "321"}</langsyntaxhighlight>
 
===Non-recursive===
As a right fold (which turns out to be significantly faster than recurse + delete):
<langsyntaxhighlight lang="applescript">----------------------- PERMUTATIONS -----------------------
 
-- permutations :: [a] -> [[a]]
Line 1,104:
{}
end if
end take</langsyntaxhighlight>
{{Out}}
<pre>{{1, 2, 3}, {2, 1, 3}, {2, 3, 1}, {1, 3, 2}, {3, 1, 2}, {3, 2, 1}}</pre>
Line 1,110:
 
===Recursive again===
This is marginally faster even than the Pseudocode translation above and doesn't demarcate lists with square brackets, which don't officially exist in AppleScript. It returns the 362,880 permutations of a 9-item list in about a second and a half and the 3,628,800 permutations of a 10-item list in about 16 seconds. Don't let Script Editor attempt to display such large results or you'll have to force-quit it!
 
<syntaxhighlight lang="applescript">-- Translation of "Improved version of Heap's method (recursive)" found in
This is marginally faster even than the Pseudocode translation above and doesn't demarcate lists with square brackets, which don't officially exist in AppleScript. It now features tail call elimination and a rethink of way the results list is built which, on my machine, reduces the time taken to return the 362,880 permutations of a 9-item list from a minute to a second and a half. It'll even return the 3,628,800 permutations of a 10-item list without seizing up, in about 17 seconds. But make sure Script Editor doesn't attempt to display such large results or you'll need to force-quit it!
-- Robert Sedgewick's PDF document "Permutation Generation Methods"
 
<lang applescript>-- AppleScript interpretation of "Improved version of Heap's method (recursive)"
-- found in Robert Sedgewick's PDF document "Permutation Generation Methods"
-- <https://www.cs.princeton.edu/~rs/talks/perms.pdf>
-- Adapted to permute from right to left instead of vice versa and to eliminate tail calls.
 
on allPermutations(theList)
script o
-- Work list and precalculated indices for its last four items (assuming that many).
property workList : missing value
property permutationsworkList : {}missing value --(Set to a copy of theList below.)
property r : (count theList) -- The work list's rightmost …
property |r-1|rMinus1 : r - 1 -- … penultimate …
property |r-2|rMinus2 : r - 2 -- … and penpenultimate indices.
property prMinus3 : 1r -- Index for the permutations list.3
-- Output list and traversal index.
property output : {}
property p : 1
-- Recursive handler. Stores copies of workList after permuting items l thru r.
on prmt(l)
set-- evenCountIs tothe ((rrange -length l)covered modby 2this =recursion 1) -- Permuting anlevel even number of the work list's items?
set rangeLenEven to ((r - l) mod 2 = 1)
-- Tail call elimination repeat. Stops with the three rightmost items still to be permuted.
-- Tail call elimination repeat. untilGives (lway =to |rhard-2|)coding for the lowest three levels.
repeat with l from -- Recursively permute items (l + 1) thruto r.rMinus3
set-- |l+1|Recursively topermute items (l + 1) thru r of the work list.
prmt(|set lPlus1 to l + 1|)
prmt(lPlus1)
-- And again after successive swaps of item l with others to its right.
-- And again after swaps of item l with each of the items to its right
if (evenCount) then
-- Permuting(if anthe evenrange numberl ofto items.r Swapis itemeven) lor with itemsthe fromrightmost slotsitem r to- l + 1 in turn.times
-- (if the range repeatlength withis swapIndexodd). fromThe r"recursion" toafter |l+1|the +last 1swap by -1will
-- instead be the next iteration of this telltail item l ofcall myelimination workListrepeat.
if (rangeLenEven) then
set item l of my workList to item swapIndex of my workList
repeat with swapIdx from r to (lPlus1 + set1) item swapIndex of my workList toby it-1
tell my workList's item l
set my workList's item l to my workList's item swapIdx
set my workList's item swapIdx to it
end tell
prmt(|l+1|lPlus1)
end repeat
set swapIndexswapIdx to |l+1|lPlus1
else
--repeat Permuting(r an- oddlPlus1) number of items. Always swap item l with item r.times
repeat (r - |l+1|) timestell my workList's item l
tell set my workList's item l ofto my workList's item r
set item l of my workList to's item r ofto my workListit
set item r of my workList to it
end tell
prmt(|l+1|lPlus1)
end repeat
set swapIndexswapIdx to r
end if
tell my workList's item l
-- Do the last swap with the current l, then reset to repeat in lieu of a tail recursion.
tell set my workList's item l ofto my workList's item swapIdx
set item l of my workList to's item swapIndexswapIdx ofto my workListit
set item swapIndex of my workList to it
end tell
set lrangeLenEven to |l+1|(not rangeLenEven)
set evenCount to (not evenCount)
end repeat
-- Store thea current statecopy of the work list's current state.
copyset workListmy tooutput's item p ofto my permutationsworkList's items
-- AndThen five more times with permutationsthe of thethree rightmost threeitems itemspermuted.
--set (Written out herev1 to save doing fivemy moreworkList's recursionitem branches.)rMinus2
set {v1, v2, v3} to itemsmy |r-2|workList's thruitem r of my workListrMinus1
set itemv3 |r-1| ofto my workList's to v3end
set itemmy rworkList's ofitem my workListrMinus1 to v2v3
copyset my workList to's item (pr + 1) of myto permutationsv2
set my output's item |r-2|(p of+ 1) to my workList's to v2items
set itemmy rworkList's ofitem my workListrMinus2 to v1v2
copyset my workList to's item (pr + 2) of myto permutationsv1
set my output's item |r-1|(p of+ 2) to my workList's to v1items
set itemmy rworkList's ofitem my workListrMinus1 to v3v1
copyset my workList to's item (pr + 3) of myto permutationsv3
set my output's item |r-2|(p of+ 3) to my workList's to v3items
set itemmy rworkList's ofitem my workListrMinus2 to v2v3
copyset my workList to's item (pr + 4) of myto permutationsv2
set my output's item |r-1|(p of+ 4) to my workList's to v2items
set itemmy rworkList's ofitem my workListrMinus1 to v1v2
copyset my workList to's item (pr + 5) of myto permutationsv1
set my output's item (p + 5) to my workList's items
set p to p + 6
end prmt
Line 1,190 ⟶ 1,192:
if (o's r < 3) then
-- Special-case fewerFewer than three items in the input list.
copy theList to the beginning of o's permutationsoutput's beginning
if (o's r is 2) then set the end of o's permutationsoutput's end to theList's reverse
else
-- Otherwise setprepare upa list to usehold (factorial of input list thelength) recursivepermutations handler.
copy theList to o's workList
set factorial to 2
-- "Growing" a long results list by appending each permutation to it
repeat with i from 3 to o's r
-- takes a disproportionately long time. Instead, build a list of the
-- appropriate set factorial lengthto beforehand,factorial using* concatenation.i
set o's permutations to {missing value, missing value}
repeat with i from 3 to (count theList)
set temp to o's permutations
repeat (i - 1) times
set o's permutations to o's permutations & temp
end repeat
end repeat
set o's output to makeList(factorial, missing value)
-- … and call o's recursive handler.
o's prmt(1)
end if
return o's permutationsoutput
end allPermutations
 
on makeList(limit, filler)
return allPermutations({1, 2, "cat", "dog"})</lang>
if (limit < 1) then return {}
script o
property lst : {filler}
end script
set counter to 1
repeat until (counter + counter > limit)
set o's lst to o's lst & o's lst
set counter to counter + counter
end repeat
if (counter < limit) then set o's lst to o's lst & o's lst's items 1 thru (limit - counter)
return o's lst
end makeList
 
return allPermutations({1, 2, 3, 4})</syntaxhighlight>
 
{{output}}
<langsyntaxhighlight lang="applescript">{{1, 2, "cat"3, "dog"4}, {1, 2, "dog"4, "cat"3}, {1, "cat"3, "dog"4, 2}, {1, "cat"3, 2, "dog"4}, {1, "dog"4, 2, "cat"3}, {1, "dog"4, "cat"3, 2}, {2, "dog"4, "cat"3, 1}, {2, "dog"4, 1, "cat"3}, {2, "cat"3, 1, "dog"4}, {2, "cat"3, "dog"4, 1}, {2, 1, "dog"4, "cat"3}, {2, 1, "cat"3, "dog"4}, {"cat"3, 1, 2, "dog"4}, {"cat"3, 1, "dog"4, 2}, {"cat"3, 2, "dog"4, 1}, {"cat"3, 2, 1, "dog"4}, {"cat"3, "dog"4, 1, 2}, {"cat"3, "dog"4, 2, 1}, {"dog"4, "cat"3, 2, 1}, {"dog"4, "cat"3, 1, 2}, {"dog"4, 2, 1, "cat"3}, {"dog"4, 2, "cat"3, 1}, {"dog"4, 1, "cat"3, 2}, {"dog"4, 1, 2, "cat"3}}</langsyntaxhighlight>
 
=={{header|ARM Assembly}}==
{{works with|as|Raspberry Pi}}
<syntaxhighlight lang="arm assembly">
<lang ARM Assembly>
/* ARM assembly Raspberry PI */
/* program permutation.s */
Line 1,363 ⟶ 1,376:
/***************************************************/
.include "../affichage.inc"
</syntaxhighlight>
</lang>
<pre>
Value : +1
Line 1,392 ⟶ 1,405:
</pre>
=={{header|Arturo}}==
<langsyntaxhighlight lang="rebol">print permutate [1 2 3]</langsyntaxhighlight>
{{out}}
<pre>[1 2 3] [1 3 2] [32 1 23] [2 1 3 1] [2 3 1 2] [3 2 1]</pre>
 
=={{header|AutoHotkey}}==
from the forum topic http://www.autohotkey.com/forum/viewtopic.php?t=77959
<langsyntaxhighlight AutoHotkeylang="autohotkey">#NoEnv
StringCaseSense On
 
Line 1,446 ⟶ 1,459:
o := A_LoopField o
return o
}</langsyntaxhighlight>
{{out}}
<pre style="height:40ex;overflow:scroll">Hello
Line 1,511 ⟶ 1,524:
===Alternate Version===
Alternate version to produce numerical permutations of combinations.
<langsyntaxhighlight lang="ahk">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"
Line 1,543 ⟶ 1,556:
. P(n,k-1,opt,delim,str . A_LoopField . delim)
Return s
}</langsyntaxhighlight>
{{out}}
<syntaxhighlight lang ="ahk">MsgBox % P(3)</langsyntaxhighlight>
<pre style="height:40ex;overflow:scroll">---------------------------
permute.ahk
Line 1,558 ⟶ 1,571:
OK
---------------------------</pre>
<langsyntaxhighlight lang="ahk">MsgBox % P("Hello",3)</langsyntaxhighlight>
<pre style="height:40ex;overflow:scroll">---------------------------
permute.ahk
Line 1,607 ⟶ 1,620:
OK
---------------------------</pre>
<langsyntaxhighlight lang="ahk">MsgBox % P("2`n3`n4`n5",2,3)</langsyntaxhighlight>
<pre style="height:40ex;overflow:scroll">---------------------------
permute.ahk
Line 1,635 ⟶ 1,648:
OK
---------------------------</pre>
<langsyntaxhighlight lang="ahk">MsgBox % P("11 a text ] u+z",3,0," ")</langsyntaxhighlight>
<pre style="height:40ex;overflow:scroll">---------------------------
permute.ahk
Line 1,704 ⟶ 1,717:
 
=={{header|AWK}}==
<syntaxhighlight lang="awk">
<lang AWK>
# syntax: GAWK -f PERMUTATIONS.AWK [-v sep=x] [word]
#
Line 1,751 ⟶ 1,764:
arr[leng-1] = c
}
</syntaxhighlight>
</lang>
<p>sample command:</p>
GAWK -f PERMUTATIONS.AWK Gwen
Line 1,759 ⟶ 1,772:
</pre>
 
=={{header|BASIC256BASIC}}==
==={{header|Applesoft BASIC}}===
{{trans|Commodore BASIC}} Shortened from Commodore BASIC to seven lines. Integer arrays are used instead of floating point. GOTO is used instead of GOSUB to avoid OUT OF MEMORY ERROR due to the call stack being full for values greater than 100.
<syntaxhighlight lang="BASIC"> 10 INPUT "HOW MANY? ";N:J = N - 1
20 S$ = " ":M$ = S$ + CHR$ (13):T = 0: DIM A%(J),K%(J),I%(J),R%(J): FOR I = 0 TO J:A%(I) = I + 1: NEXT :K%(S) = N:R = S:R%(R) = 0:S = S + 1
30 IF K%(R) < = 1 THEN FOR I = 0 TO N - 1: PRINT MID$ (S$,(I = 0) + 1,1)A%(I);: NEXT I:S$ = M$: GOTO 70
40 K%(S) = K%(R) - 1:R%(S) = 0:R = S:S = S + 1: GOTO 30
50 J = I%(R) * (1 - (K%(R) - INT (K%(R) / 2) * 2)):T = A%(J):A%(J) = A%(K%(R) - 1):A%(K%(R) - 1) = T:K%(S) = K%(R) - 1:R%(S) = 1:R = S:S = S + 1: GOTO 30
60 I%(R) = (I%(R) + 1) * R%(S): IF I%(R) < K%(R) - 1 GOTO 50
70 S = S - 1:R = S - 1: IF R > = 0 GOTO 60</syntaxhighlight>
{{Out}}
<pre>HOW MANY? 3
1 2 3
2 1 3
3 1 2
1 3 2
2 3 1
3 2 1
</pre>
<pre>HOW MANY? 4483
 
?OUT OF MEMORY ERROR IN 20
</pre>
<pre>HOW MANY? 4482
BREAK IN 30
]?FRE(0)
1
</pre>
 
==={{header|BASIC256}}===
{{trans|Liberty BASIC}}
<langsyntaxhighlight BASIC256lang="basic256">arraybase 1
n = 4 : cont = 0
dim a(n)
Line 1,803 ⟶ 1,845:
end if
until i = 0
end</langsyntaxhighlight>
 
==={{header|BatchBBC FileBASIC}}===
Recursive permutation generator.
<lang Batch File>
@echo off
setlocal enabledelayedexpansion
set arr=ABCD
set /a n=4
:: echo !arr!
call :permu %n% arr
goto:eof
 
:permu num &arr
setlocal
if %1 equ 1 call echo(!%2! & exit /b
set /a "num=%1-1,n2=num-1"
set arr=!%2!
for /L %%c in (0,1,!n2!) do (
call:permu !num! arr
set /a n1="num&1"
if !n1! equ 0 (call:swapit !num! 0 arr) else (call:swapit !num! %%c arr)
)
call:permu !num! arr
endlocal & set %2=%arr%
exit /b
 
:swapit from to &arr
setlocal
set arr=!%3!
set temp1=!arr:~%~1,1!
set temp2=!arr:~%~2,1!
set arr=!arr:%temp1%=@!
set arr=!arr:%temp2%=%temp1%!
set arr=!arr:@=%temp2%!
:: echo %1 %2 !%~3! !arr!
endlocal & set %3=%arr%
exit /b
</lang>
{{out}}
<pre>
ABCD
BACD
CABD
ACBD
BCAD
CBAD
DBAC
BDAC
ADBC
DABC
BADC
ABDC
ACDB
CADB
DACB
ADCB
CDAB
DCAB
DCBA
CDBA
BDCA
DBCA
CBDA
BCDA
</pre>
 
=={{header|BBC BASIC}}==
The procedure PROC_NextPermutation() will give the next lexicographic permutation of an integer array.
<langsyntaxhighlight lang="bbcbasic"> DIM List%(3)
List%() = 1, 2, 3, 4
FOR perm% = 1 TO 24
Line 1,909 ⟶ 1,886:
last -= 1
ENDWHILE
ENDPROC</langsyntaxhighlight>
'''Output:'''
<pre>
Line 1,936 ⟶ 1,913:
4 3 1 2
4 3 2 1
</pre>
 
==={{header|Commodore BASIC}}===
Heap's algorithm, using a couple extra arrays as stacks to permit recursive calls.
 
<syntaxhighlight lang="Commodore BASIC">100 INPUT "HOW MANY";N
110 DIM A(N-1):REM ARRAY TO PERMUTE
120 DIM K(N-1):REM HOW MANY ITEMS TO PERMUTE (ARRAY AS STACK)
130 DIM I(N-1):REM CURRENT POSITION IN LOOP (ARRAY AS STACK)
140 S=0:REM STACK POINTER
150 FOR I=0 TO N-1
160 : A(I)=I+1: REM INITIALIZE ARRAY TO 1..N
170 NEXT I
180 K(S)=N:S=S+1:GOSUB 200:REM PERMUTE(N)
190 END
200 IF K(S-1)>1 THEN 270
210 REM PRINT OUT THIS PERMUTATION
220 FOR I=0 TO N-1
230 : PRINT A(I);
240 NEXT I
250 PRINT
260 RETURN
270 K(S)=K(S-1)-1:S=S+1:GOSUB 200:S=S-1:REM PERMUTE(K-1)
280 I(S-1)=0:REM FOR I=0 TO K-2
290 IF I(S-1)>=K(S-1)-1 THEN 340
300 J=I(S-1):IF K(S-1) AND 1 THEN J=0:REM ELEMENT TO SWAP BASED ON PARITY OF K
310 T=A(J):A(J)=A(K(S-1)-1):A(K(S-1)-1)=T:REM SWAP
320 K(S)=K(S-1)-1:S=S+1:GOSUB 200:S=S-1:REM PERMUTE(K-1)
330 I(S-1)=I(S-1)+1:GOTO 290:REM NEXT I
340 RETURN</syntaxhighlight>
 
{{Out}}
<pre>READY.
RUN
HOW MANY? 3
1 2 3
2 1 3
3 1 2
1 3 2
2 3 1
3 2 1
 
READY.</pre>
 
==={{header|Craft Basic}}===
<syntaxhighlight lang="basic">let n = 3
let i = n + 1
 
dim a[i]
 
for i = 1 to n
 
let a[i] = i
 
next i
 
do
 
for i = 1 to n
 
print a[i]
 
next i
 
print
 
let i = n
 
do
 
let i = i - 1
let b = i + 1
 
loopuntil (i = 0) or (a[i] < a[b])
 
let j = i + 1
let k = n
 
do
 
if j < k then
 
let t = a[j]
let a[j] = a[k]
let a[k] = t
let j = j + 1
let k = k - 1
 
endif
 
loop j < k
 
if i > 0 then
 
let j = i + 1
 
do
 
if a[j] < a[i] then
 
let j = j + 1
 
endif
 
loop a[j] < a[i]
 
let t = a[j]
let a[j] = a[i]
let a[i] = t
 
endif
 
loopuntil i = 0</syntaxhighlight>
{{out| Output}}<pre>
1 2 3
1 3 2
2 1 3
2 3 1
3 1 2
3 2 1
</pre>
 
==={{header|FreeBASIC}}===
<syntaxhighlight lang="freebasic">' version 07-04-2017
' compile with: fbc -s console
 
' Heap's algorithm non-recursive
Sub perms(n As Long)
 
Dim As ULong i, j, count = 1
Dim As ULong a(0 To n -1), c(0 To n -1)
 
For j = 0 To n -1
a(j) = j +1
Print a(j);
Next
Print " ";
 
i = 0
While i < n
If c(i) < i Then
If (i And 1) = 0 Then
Swap a(0), a(i)
Else
Swap a(c(i)), a(i)
End If
For j = 0 To n -1
Print a(j);
Next
count += 1
If count = 12 Then
Print
count = 0
Else
Print " ";
End If
c(i) += 1
i = 0
Else
c(i) = 0
i += 1
End If
Wend
 
End Sub
 
' ------=< MAIN >=------
 
perms(4)
 
' empty keyboard buffer
While Inkey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End</syntaxhighlight>
{{out}}
<pre>1234 2134 3124 1324 2314 3214 4213 2413 1423 4123 2143 1243
1342 3142 4132 1432 3412 4312 4321 3421 2431 4231 3241 2341</pre>
 
 
 
==={{header|IS-BASIC}}===
<syntaxhighlight lang="is-basic">100 PROGRAM "Permutat.bas"
110 LET N=4 ! Number of elements
120 NUMERIC T(1 TO N)
130 FOR I=1 TO N
140 LET T(I)=I
150 NEXT
160 LET S=0
170 CALL PERM(N)
180 PRINT "Number of permutations:";S
190 END
200 DEF PERM(I)
210 NUMERIC J,X
220 IF I=1 THEN
230 FOR X=1 TO N
240 PRINT T(X);
250 NEXT
260 PRINT :LET S=S+1
270 ELSE
280 CALL PERM(I-1)
290 FOR J=1 TO I-1
300 LET C=T(J):LET T(J)=T(I):LET T(I)=C
310 CALL PERM(I-1)
320 LET C=T(J):LET T(J)=T(I):LET T(I)=C
330 NEXT
340 END IF
350 END DEF</syntaxhighlight>
 
==={{header|Liberty BASIC}}===
Permuting numerical array (non-recursive):
{{trans|PowerBASIC}}
<syntaxhighlight lang="lb">
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
</syntaxhighlight>
 
{{out}}
<pre>
123
132
213
231
312
321
</pre>
Permuting string (recursive):
<syntaxhighlight lang="lb">
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
 
</syntaxhighlight>
 
{{out}}
<pre>
123
132
213
231
312
321
</pre>
 
==={{header|Microsoft Small Basic}}===
{{trans|vba}}
<syntaxhighlight lang="smallbasic">'Permutations - sb
n=4
printem = "True"
For i = 1 To n
p[i] = i
EndFor
count = 0
Last = "False"
While Last = "False"
If printem Then
For t = 1 To n
TextWindow.Write(p[t])
EndFor
TextWindow.WriteLine("")
EndIf
count = count + 1
Last = "True"
i = n - 1
While i > 0
If p[i] < p[i + 1] Then
Last = "False"
Goto exitwhile
EndIf
i = i - 1
EndWhile
exitwhile:
j = i + 1
k = n
While j < k
t = p[j]
p[j] = p[k]
p[k] = t
j = j + 1
k = k - 1
EndWhile
j = n
While p[j] > p[i]
j = j - 1
EndWhile
j = j + 1
t = p[i]
p[i] = p[j]
p[j] = t
EndWhile
TextWindow.WriteLine("Number of permutations: "+count) </syntaxhighlight>
{{out}}
<pre>
1234
1243
1324
1342
1423
1432
2134
2143
2314
2341
2413
2431
3124
3142
3214
3241
3412
3421
4123
4132
4213
4231
4312
4321
Number of permutations: 24
</pre>
 
==={{header|PowerBASIC}}===
{{works with|PowerBASIC|10.00+}}
<syntaxhighlight lang="ada"> #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</syntaxhighlight>
{{out}}
<pre>
1 2 3
1 3 2
2 1 3
2 3 1
3 1 2
3 2 1
</pre>
 
==={{header|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.
<syntaxhighlight lang="purebasic">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</syntaxhighlight>
{{out}}
<pre>1, 2, 3
1, 3, 2
2, 1, 3
2, 3, 1
3, 1, 2
3, 2, 1</pre>
 
==={{header|QBasic}}===
{{works with|QBasic|1.1}}
{{works with|QuickBasic|4.5}}
{{trans|FreeBASIC}}
<syntaxhighlight lang="qbasic">SUB perms (n)
DIM a(0 TO n - 1), c(0 TO n - 1)
FOR j = 0 TO n - 1
a(j) = j + 1
PRINT a(j);
NEXT j
PRINT
i = 0
WHILE i < n
IF c(i) < i THEN
IF (i AND 1) = 0 THEN
SWAP a(0), a(i)
ELSE
SWAP a(c(i)), a(i)
END IF
FOR j = 0 TO n - 1
PRINT a(j);
NEXT j
PRINT
c(i) = c(i) + 1
i = 0
ELSE
c(i) = 0
i = i + 1
END IF
WEND
END SUB
 
perms(4)</syntaxhighlight>
 
==={{header|Run BASIC}}===
Works with Run BASIC, Liberty BASIC and Just BASIC
<syntaxhighlight lang="runbasic">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</syntaxhighlight>Output:
<pre>hello
ehllo
elhlo
ellho
elloh
leloh
lleoh
lloeh
llohe
lolhe
lohle
lohel
olhel
ohlel
ohell
hoell
heoll
helol</pre>
 
==={{header|True BASIC}}===
{{trans|Liberty BASIC}}
<syntaxhighlight lang="qbasic">SUB SWAP(vb1, vb2)
LET temp = vb1
LET vb1 = vb2
LET vb2 = temp
END SUB
 
LET n = 4
DIM a(4)
DIM c(4)
 
FOR i = 1 TO n
LET a(i) = i
NEXT i
PRINT
 
DO
FOR i = 1 TO n
PRINT a(i);
NEXT i
PRINT
LET i = n
DO
LET i = i - 1
LOOP UNTIL (i = 0) OR (a(i) < a(i + 1))
LET j = i + 1
LET k = n
DO WHILE j < k
CALL SWAP (a(j), a(k))
LET j = j + 1
LET k = k - 1
LOOP
IF i > 0 THEN
LET j = i + 1
DO WHILE a(j) < a(i)
LET j = j + 1
LOOP
CALL SWAP (a(i), a(j))
END IF
LOOP UNTIL i = 0
END</syntaxhighlight>
 
==={{header|Yabasic}}===
{{trans|Liberty BASIC}}
<syntaxhighlight lang="yabasic">n = 4
dim a(n), c(n)
 
for j = 1 to n : a(j) = j : next j
repeat
for i = 1 to n: print a(i);: next: print
i = n
repeat
i = i - 1
until (i = 0) or (a(i) < a(i+1))
j = i + 1
k = n
while j < 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
tmp = a(j) : a(j) = a(i) : a(i) = tmp
endif
until i = 0
end</syntaxhighlight>
 
=={{header|Batch File}}==
Recursive permutation generator.
<syntaxhighlight lang="batch file">
@echo off
setlocal enabledelayedexpansion
set arr=ABCD
set /a n=4
:: echo !arr!
call :permu %n% arr
goto:eof
 
:permu num &arr
setlocal
if %1 equ 1 call echo(!%2! & exit /b
set /a "num=%1-1,n2=num-1"
set arr=!%2!
for /L %%c in (0,1,!n2!) do (
call:permu !num! arr
set /a n1="num&1"
if !n1! equ 0 (call:swapit !num! 0 arr) else (call:swapit !num! %%c arr)
)
call:permu !num! arr
endlocal & set %2=%arr%
exit /b
 
:swapit from to &arr
setlocal
set arr=!%3!
set temp1=!arr:~%~1,1!
set temp2=!arr:~%~2,1!
set arr=!arr:%temp1%=@!
set arr=!arr:%temp2%=%temp1%!
set arr=!arr:@=%temp2%!
:: echo %1 %2 !%~3! !arr!
endlocal & set %3=%arr%
exit /b
</syntaxhighlight>
{{out}}
<pre>
ABCD
BACD
CABD
ACBD
BCAD
CBAD
DBAC
BDAC
ADBC
DABC
BADC
ABDC
ACDB
CADB
DACB
ADCB
CDAB
DCAB
DCBA
CDBA
BDCA
DBCA
CBDA
BCDA
</pre>
 
=={{header|Bracmat}}==
<langsyntaxhighlight lang="bracmat"> ( perm
= prefix List result original A Z
. !arg:(?.)
Line 1,951 ⟶ 2,625:
& !result
)
& out$(perm$(.a 2 "]" u+z);</langsyntaxhighlight>
Output:
<pre> (a 2 ] u+z.)
Line 1,981 ⟶ 2,655:
===version 1===
Non-recursive algorithm to generate all permutations. It prints objects in lexicographical order.
<syntaxhighlight lang="c">
<lang c>
#include <stdio.h>
int main (int argc, char *argv[]) {
Line 2,036 ⟶ 2,710:
}
}
</syntaxhighlight>
</lang>
 
===version 2===
Non-recursive algorithm to generate all permutations. It prints them from right to left.
<syntaxhighlight lang="c">
<lang c>
 
#include <stdio.h>
Line 2,066 ⟶ 2,740:
}
 
</syntaxhighlight>
</lang>
 
===version 3===
See [[wp:Permutation#Systematic_generation_of_all_permutations|lexicographic generation]] of permutations.
<langsyntaxhighlight lang="c">#include <stdio.h>
#include <stdlib.h>
 
Line 2,170 ⟶ 2,844:
return 0;
}
</syntaxhighlight>
</lang>
 
===version 4===
See [[wp:Permutation#Systematic_generation_of_all_permutations|lexicographic generation]] of permutations.
<langsyntaxhighlight lang="c">#include <stdio.h>
#include <stdlib.h>
 
Line 2,274 ⟶ 2,948:
return 0;
}
</syntaxhighlight>
</lang>
 
=={{header|C sharp|C#}}==
Recursive Linq
{{works with|C sharp|C#|7}}
<langsyntaxhighlight lang="csharp">public static class Extension
{
public static IEnumerable<IEnumerable<T>> Permutations<T>(this IEnumerable<T> values) where T : IComparable<T>
Line 2,287 ⟶ 2,961:
return values.SelectMany(v => Permutations(values.Where(x => x.CompareTo(v) != 0)), (v, p) => p.Prepend(v));
}
}</langsyntaxhighlight>
Usage
<langsyntaxhighlight lang="sharp">Enumerable.Range(0,5).Permutations()</langsyntaxhighlight>
A recursive Iterator. Runs under C#2 (VS2005), i.e. no `var`, no lambdas,...
<langsyntaxhighlight lang="csharp">public class Permutations<T>
{
public static System.Collections.Generic.IEnumerable<T[]> AllFor(T[] array)
Line 2,321 ⟶ 2,995:
}
}
}</langsyntaxhighlight>
Usage:
<langsyntaxhighlight lang="csharp">namespace Permutations_On_RosettaCode
{
class Program
Line 2,336 ⟶ 3,010:
}
}
}</langsyntaxhighlight>
 
 
Line 2,342 ⟶ 3,016:
 
Recursive version
<langsyntaxhighlight lang="csharp">using System;
class Permutations
{
Line 2,369 ⟶ 3,043:
}
}
}</langsyntaxhighlight>
 
Alternate recursive version
 
<langsyntaxhighlight lang="csharp">
using System;
class Permutations
Line 2,400 ⟶ 3,074:
}
}
</syntaxhighlight>
</lang>
 
[https://en.wikipedia.org/wiki/Heap%27s_algorithm Heap's Algorithm]
<syntaxhighlight lang="csharp">
// Always returns the same array which is the one passed to the function
public static IEnumerable<T[]> HeapsPermutations<T>(T[] array)
{
var state = new int[array.Length];
 
yield return array;
 
for (var i = 0; i < array.Length;)
{
if (state[i] < i)
{
var left = i % 2 == 0 ? 0 : state[i];
var temp = array[left];
array[left] = array[i];
array[i] = temp;
yield return array;
state[i]++;
i = 1;
}
else
{
state[i] = 0;
i++;
}
}
}
 
// Returns a different array for each permutation
public static IEnumerable<T[]> HeapsPermutationsWrapped<T>(IEnumerable<T> items)
{
var array = items.ToArray();
return HeapsPermutations(array).Select(mutating =>
{
var arr = new T[array.Length];
Array.Copy(mutating, arr, array.Length);
return arr;
});
}
</syntaxhighlight>
 
=={{header|C++}}==
The C++ standard library provides for this in the form of <code>std::next_permutation</code> and <code>std::prev_permutation</code>.
<langsyntaxhighlight lang="cpp">#include <algorithm>
#include <string>
#include <vector>
Line 2,443 ⟶ 3,159:
 
return 0;
}</langsyntaxhighlight>
{{out}}
<pre>
Line 2,523 ⟶ 3,239:
In an REPL:
 
<langsyntaxhighlight lang="clojure">
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))</langsyntaxhighlight>
 
===Explicit===
Replacing the call to the combinatorics library function by its real implementation.
<langsyntaxhighlight lang="clojure">
(defn- iter-perm [v]
(let [len (count v),
Line 2,568 ⟶ 3,284:
(println (permutations [1 2 3]))
 
</syntaxhighlight>
</lang>
 
=={{header|CoffeeScript}}==
<langsyntaxhighlight lang="coffeescript"># Returns a copy of an array with the element at a specific position
# removed from it.
arrayExcept = (arr, idx) ->
Line 2,588 ⟶ 3,304:
# Flatten the array before returning it.
[].concat permutations...</langsyntaxhighlight>
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.
{{out|Usage}}
<langsyntaxhighlight lang="coffeescript">coffee> console.log (permute "123").join "\n"
1,2,3
1,3,2
Line 2,597 ⟶ 3,313:
2,3,1
3,1,2
3,2,1</langsyntaxhighlight>
 
=={{header|Common Lisp}}==
<langsyntaxhighlight lang="lisp">(defun permute (list)
(if list
(mapcan #'(lambda (x)
Line 2,608 ⟶ 3,324:
'(()))) ; else
 
(print (permute '(A B Z)))</langsyntaxhighlight>
{{out}}
<pre>((A B Z) (A Z B) (B A Z) (B Z A) (Z A B) (Z B A))</pre>
Lexicographic next permutation:
<langsyntaxhighlight lang="lisp">(defun next-perm (vec cmp) ; modify vector
(declare (type (simple-array * (*)) vec))
(macrolet ((el (i) `(aref vec ,i))
Line 2,629 ⟶ 3,345:
;;; test code
(loop for a = "1234" then (next-perm a #'char<) while a do
(write-line a))</langsyntaxhighlight>
Recursive implementation of Heap's algorithm:
<langsyntaxhighlight lang="lisp">(defun heap-permutations (seq)
(let ((permutations nil))
(labels ((permute (seq k)
Line 2,644 ⟶ 3,360:
(permute seq (1- k)))))))
(permute seq (length seq))
permutations)))</langsyntaxhighlight>
 
=={{header|Crystal}}==
<langsyntaxhighlight Rubylang="ruby">puts [1, 2, 3].permutations</langsyntaxhighlight>
{{out}}
<pre>[[1, 2, 3], [1, 3, 2], [2, 1, 3], [2, 3, 1], [3, 1, 2], [3, 2, 1]]</pre>
Line 2,653 ⟶ 3,369:
=={{header|Curry}}==
 
<langsyntaxhighlight lang="curry">
insert :: a -> [a] -> [a]
insert x xs = x : xs
Line 2,661 ⟶ 3,377:
permutation [] = []
permutation (x:xs) = insert x $ permutation xs
</syntaxhighlight>
</lang>
 
=={{header|D}}==
===Simple Eager version===
Compile with -version=permutations1_main to see the output.
<langsyntaxhighlight lang="d">T[][] permutations(T)(T[] items) pure nothrow {
T[][] result;
 
Line 2,686 ⟶ 3,402:
writefln("%(%s\n%)", [1, 2, 3].permutations);
}
}</langsyntaxhighlight>
{{out}}
<pre>[1, 2, 3]
Line 2,697 ⟶ 3,413:
===Fast Lazy Version===
Compiled with <code>-version=permutations2_main</code> produces its output.
<langsyntaxhighlight lang="d">import std.algorithm, std.conv, std.traits;
 
struct Permutations(bool doCopy=true, T) if (isMutable!T) {
Line 2,784 ⟶ 3,500:
[B(1), B(2), B(3)].permutations!false.writeln;
}
}</langsyntaxhighlight>
 
===Standard Version===
<langsyntaxhighlight lang="d">void main() {
import std.stdio, std.algorithm;
 
Line 2,794 ⟶ 3,510:
items.writeln;
while (items.nextPermutation);
}</langsyntaxhighlight>
 
=={{header|Delphi}}==
<langsyntaxhighlight Delphilang="delphi">program TestPermutations;
 
{$APPTYPE CONSOLE}
Line 2,854 ⟶ 3,570:
if Length(S) > 0 then Writeln(S);
Readln;
end.</langsyntaxhighlight>
{{out}}
<pre>
Line 2,861 ⟶ 3,577:
2341 1342 2143 1243 3124 3214 2314
1324 2134 1234
</pre>
 
=={{header|EasyLang}}==
 
<syntaxhighlight lang="easylang">
proc permlist k . list[] .
if k = len list[]
print list[]
return
.
for i = k to len list[]
swap list[i] list[k]
permlist k + 1 list[]
swap list[k] list[i]
.
.
l[] = [ 1 2 3 ]
permlist 1 l[]
</syntaxhighlight>
 
=={{header|Ecstasy}}==
<syntaxhighlight lang="java">
/**
* Implements permutations without repetition.
*/
module Permutations {
static Int[][] permut(Int items) {
if (items <= 1) {
// with one item, there is a single permutation; otherwise there are no permutations
return items == 1 ? [[0]] : [];
}
 
// the "pattern" for all values but the first value in each permutation is
// derived from the permutations of the next smaller number of items
Int[][] pattern = permut(items - 1);
 
// build the list of all permutations for the specified number of items by iterating only
// the first digit
Int[][] result = new Int[][];
for (Int prefix : 0 ..< items) {
for (Int[] suffix : pattern) {
result.add(new Int[items](i -> i == 0 ? prefix : (prefix + suffix[i-1] + 1) % items));
}
}
return result;
}
 
void run() {
@Inject Console console;
console.print($"permut(3) = {permut(3)}");
}
}
</syntaxhighlight>
 
{{out}}
<pre>
permut(3) = [[0, 1, 2], [0, 2, 1], [1, 2, 0], [1, 0, 2], [2, 0, 1], [2, 1, 0]]
</pre>
 
Line 2,868 ⟶ 3,641:
(2) Return the next permutation in lexicographic order, or set a flag to indicate there are no more permutations.
The algorithm for (2) is the same as in the Wikipedia article "Permutation".
<langsyntaxhighlight lang="edsac">
[Permutations task for Rosetta Code.]
[EDSAC program, Initial Orders 2.]
Line 3,076 ⟶ 3,849:
PF [enter with acc = 0]
[end]
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 3,092 ⟶ 3,865:
 
=={{header|Eiffel}}==
<syntaxhighlight lang="eiffel">
<lang Eiffel>
class
APPLICATION
Line 3,141 ⟶ 3,914:
end
 
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 3,154 ⟶ 3,927:
=={{header|Elixir}}==
{{trans|Erlang}}
<langsyntaxhighlight lang="elixir">defmodule RC do
def permute([]), do: [[]]
def permute(list) do
Line 3,161 ⟶ 3,934:
end
 
IO.inspect RC.permute([1, 2, 3])</langsyntaxhighlight>
 
{{out}}
Line 3,170 ⟶ 3,943:
=={{header|Erlang}}==
Shortest form:
<langsyntaxhighlight Erlanglang="erlang">-module(permute).
-export([permute/1]).
 
permute([]) -> [[]];
permute(L) -> [[X|Y] || X<-L, Y<-permute(L--[X])].</langsyntaxhighlight>
Y-combinator (for shell):
<langsyntaxhighlight Erlanglang="erlang">F = fun(L) -> G = fun(_, []) -> [[]]; (F, L) -> [[X|Y] || X<-L, Y<-F(F, L--[X])] end, G(G, L) end.</langsyntaxhighlight>
More efficient zipper implementation:
<langsyntaxhighlight Erlanglang="erlang">-module(permute).
 
-export([permute/1]).
Line 3,195 ⟶ 3,968:
 
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]).</langsyntaxhighlight>
Demonstration (escript):
<langsyntaxhighlight Erlanglang="erlang">main(_) -> io:fwrite("~p~n", [permute:permute([1,2,3])]).</langsyntaxhighlight>
{{out}}
<pre>[[1,2,3],[1,3,2],[2,1,3],[2,3,1],[3,1,2],[3,2,1]]</pre>
Line 3,203 ⟶ 3,976:
=={{header|Euphoria}}==
{{trans|PureBasic}}
<langsyntaxhighlight lang="euphoria">function reverse(sequence s, integer first, integer last)
object x
while first < last do
Line 3,250 ⟶ 4,023:
end if
puts(1, s & '\t')
end while</langsyntaxhighlight>
{{out}}
<pre>abcd abdc acbd acdb adbc adcb bacd badc bcad bcda
Line 3,257 ⟶ 4,030:
 
=={{header|F Sharp|F#}}==
<langsyntaxhighlight lang="fsharp">
let rec insert left x right = seq {
match right with
Line 3,278 ⟶ 4,051:
|> Seq.iter (fun x -> printf "%A\n" x)
0
</syntaxhighlight>
</lang>
 
<pre>
Line 3,291 ⟶ 4,064:
 
Translation of Haskell "insertion-based approach" (last version)
<langsyntaxhighlight lang="fsharp">
let permutations xs =
let rec insert x = function
Line 3,297 ⟶ 4,070:
| head :: tail -> (x :: (head :: tail)) :: (List.map (fun l -> head :: l) (insert x tail))
List.fold (fun s e -> List.collect (insert e) s) [[]] xs
</syntaxhighlight>
</lang>
 
=={{header|Factor}}==
Line 3,303 ⟶ 4,076:
 
=={{header|Fortran}}==
<langsyntaxhighlight lang="fortran">program permutations
 
implicit none
Line 3,335 ⟶ 4,108:
end subroutine generate
 
end program permutations</langsyntaxhighlight>
{{out}}
<pre> 1 2 3
Line 3,349 ⟶ 4,122:
The values need to be "swapped back" after the recursive call.
 
<langsyntaxhighlight lang="fortran">program allperm
implicit none
integer :: n, i
Line 3,375 ⟶ 4,148:
end if
end subroutine
end program</langsyntaxhighlight>
 
 
Line 3,383 ⟶ 4,156:
Here below is the speed test for a couple of algorithms of permutation. We can add more algorithms into this frame-work. When they work in the same circumstance, we can see which is the fastest one.
 
<langsyntaxhighlight lang="fortran"> program testing_permutation_algorithms
 
implicit none
Line 3,743 ⟶ 4,516:
 
!=====
end program</langsyntaxhighlight>
 
An example of performance:
Line 3,798 ⟶ 4,571:
Here is an alternate, iterative version in Fortran 77.
{{trans|Ada}}
<langsyntaxhighlight lang="fortran"> program nptest
integer n,i,a
logical nextp
Line 3,838 ⟶ 4,611:
a(j)=t
nextp=.true.
end</langsyntaxhighlight>
 
=== Ratfor 77 ===
See [[#RATFOR|RATFOR]].
 
=={{header|FreeBASIC}}==
<lang freebasic>' version 07-04-2017
' compile with: fbc -s console
 
' Heap's algorithm non-recursive
Sub perms(n As Long)
 
Dim As ULong i, j, count = 1
Dim As ULong a(0 To n -1), c(0 To n -1)
 
For j = 0 To n -1
a(j) = j +1
Print a(j);
Next
Print " ";
 
i = 0
While i < n
If c(i) < i Then
If (i And 1) = 0 Then
Swap a(0), a(i)
Else
Swap a(c(i)), a(i)
End If
For j = 0 To n -1
Print a(j);
Next
count += 1
If count = 12 Then
Print
count = 0
Else
Print " ";
End If
c(i) += 1
i = 0
Else
c(i) = 0
i += 1
End If
Wend
 
End Sub
 
' ------=< MAIN >=------
 
perms(4)
 
' empty keyboard buffer
While Inkey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End</lang>
{{out}}
<pre>1234 2134 3124 1324 2314 3214 4213 2413 1423 4123 2143 1243
1342 3142 4132 1432 3412 4312 4321 3421 2431 4231 3241 2341</pre>
 
=={{header|Frink}}==
Frink's array class has built-in methods <CODE>permute[]</CODE> and <CODE>lexicographicPermute[]</CODE> which permute the elements of an array in reflected Gray code order and lexicographic order respectively.
<langsyntaxhighlight lang="frink">a = [1,2,3,4]
println[formatTable[a.lexicographicPermute[]]]</langsyntaxhighlight>
 
{{out}}
Line 3,931 ⟶ 4,647:
4 3 2 1
</pre>
 
=={{header|FutureBasic}}==
 
=== With recursion ===
Here's a sweet and short solution adapted from Robert Sedgewick's 'Algorithms' (1989, p. 628). It generates its own array of integers.
 
<syntaxhighlight lang="futurebasic">
void local fn perm( k as Short)
static Short w( 4 ), i = -1
Short j
i ++ : w( k ) = i
if i = 4
for j = 1 to 4 : print w( j ),
next : print
else
for j = 1 to 4 : if w( j ) = 0 then fn perm( j )
next
end if
i -- : w( k ) = 0
end fn
 
fn perm(0)
 
handleevents
 
</syntaxhighlight>
 
=== With iteration ===
We can also do it by brute force:
<syntaxhighlight lang="futurebasic">
void local fn perm( w as CFStringRef )
Short a, b, c, d
for a = 0 to 3 : for b = 0 to 3 : for c = 0 to 3 : for d = 0 to 3
if a != b and a != c and a != d and b != c and b != d and c != d
print mid(w,a,1); mid(w,b,1); mid(w,c,1); mid(w,d,1)
end if
next : next : next : next
end fn
 
fn perm (@"abel")
 
handleevents
</syntaxhighlight>
 
=={{header|GAP}}==
Line 3,936 ⟶ 4,695:
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.
<langsyntaxhighlight lang="gap">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 ] ]</langsyntaxhighlight>
GAP has also built-in functions to get permutations
<langsyntaxhighlight lang="gap"># All arrangements of 4 elements in 1 .. 4
Arrangements([1 .. 4], 4);
# All permutations of 1 .. 4
PermutationsList([1 .. 4]);</langsyntaxhighlight>
Here is an implementation using a function to compute next permutation in lexicographic order:
<langsyntaxhighlight lang="gap">NextPermutation := function(a)
local i, j, k, n, t;
n := Length(a);
Line 3,991 ⟶ 4,750:
[ [ 1, 2, 3 ], [ 1, 3, 2 ],
[ 2, 1, 3 ], [ 2, 3, 1 ],
[ 3, 1, 2 ], [ 3, 2, 1 ] ]</langsyntaxhighlight>
 
=={{header|Glee}}==
<langsyntaxhighlight lang="glee">$$ n !! k dyadic: Permutations for k out of n elements (in this case k = n)
$$ #s monadic: number of elements in s
$$ ,, monadic: expose with space-lf separators
Line 4,000 ⟶ 4,759:
 
'Hello' 123 7.9 '•'=>s;
s[s# !! (s#)],,</langsyntaxhighlight>
 
Result:
<langsyntaxhighlight lang="glee">Hello 123 7.9 •
Hello 123 • 7.9
Hello 7.9 123 •
Line 4,026 ⟶ 4,785:
• 123 7.9 Hello
• 7.9 Hello 123
• 7.9 123 Hello</langsyntaxhighlight>
 
=={{header|GNU make}}==
Line 4,032 ⟶ 4,791:
Recursive on unique elements
 
<langsyntaxhighlight lang="make">
#delimiter should not occur inside elements
delimiter=;
Line 4,046 ⟶ 4,805:
delimiter_separated_output=$(call permutations,a b c d)
$(info $(delimiter_separated_output))
</syntaxhighlight>
</lang>
 
{{out}}
Line 4,055 ⟶ 4,814:
=== recursive ===
 
<langsyntaxhighlight lang="go">package main
 
import "fmt"
Line 4,106 ⟶ 4,865:
}
rc(len(s))
}</langsyntaxhighlight>
{{out}}
<pre>[1 2 3]
Line 4,117 ⟶ 4,876:
=== non-recursive, lexicographical order ===
 
<langsyntaxhighlight lang="go">package main
 
import "fmt"
Line 4,145 ⟶ 4,904:
fmt.Println(a)
}
}</langsyntaxhighlight>
 
{{out}}
Line 4,158 ⟶ 4,917:
=={{header|Groovy}}==
Solution:
<langsyntaxhighlight lang="groovy">def makePermutations = { l -> l.permutations() }</langsyntaxhighlight>
Test:
<langsyntaxhighlight lang="groovy">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 }</langsyntaxhighlight>
{{out}}
<pre style="height:30ex;overflow:scroll;">[Young, Crosby, Stills, Nash]
Line 4,192 ⟶ 4,951:
 
=={{header|Haskell}}==
<langsyntaxhighlight lang="haskell">import Data.List (permutations)
 
main = mapM_ print (permutations [1,2,3])</langsyntaxhighlight>
 
A simple implementation, that assumes elements are unique and support equality:
<langsyntaxhighlight lang="haskell">import Data.List (delete)
 
permutations :: Eq a => [a] -> [[a]]
permutations [] = [[]]
permutations xs = [ x:ys | x <- xs, ys <- permutations (delete x xs)]</langsyntaxhighlight>
 
A slightly more efficient implementation that doesn't have the above restrictions:
<langsyntaxhighlight lang="haskell">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 ]</langsyntaxhighlight>
 
The above are all selection-based approaches. The following is an insertion-based approach:
<langsyntaxhighlight lang="haskell">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)</langsyntaxhighlight>
 
A serialized version:
{{Trans|Mathematica}}
<langsyntaxhighlight lang="haskell">import Data.Bifunctor (second)
 
permutations :: [a] -> [[a]]
Line 4,232 ⟶ 4,991:
 
main :: IO ()
main = print $ permutations [1, 2, 3]</langsyntaxhighlight>
{{Out}}
<pre>[[1,2,3],[2,3,1],[3,1,2],[2,1,3],[1,3,2],[3,2,1]]</pre>
 
=={{header|Icon}} and {{header|Unicon}}==
<langsyntaxhighlight lang="unicon">procedure main(A)
every p := permute(A) do every writes((!p||" ")|"\n")
end
Line 4,244 ⟶ 5,003:
if *A <= 1 then return A
suspend [(A[1]<->A[i := 1 to *A])] ||| permute(A[2:0])
end</langsyntaxhighlight>
{{out}}
<pre>->permute Aardvarks eat ants
Line 4,254 ⟶ 5,013:
ants Aardvarks eat
-></pre>
 
=={{header|IS-BASIC}}==
<lang IS-BASIC>100 PROGRAM "Permutat.bas"
110 LET N=4 ! Number of elements
120 NUMERIC T(1 TO N)
130 FOR I=1 TO N
140 LET T(I)=I
150 NEXT
160 LET S=0
170 CALL PERM(N)
180 PRINT "Number of permutations:";S
190 END
200 DEF PERM(I)
210 NUMERIC J,X
220 IF I=1 THEN
230 FOR X=1 TO N
240 PRINT T(X);
250 NEXT
260 PRINT :LET S=S+1
270 ELSE
280 CALL PERM(I-1)
290 FOR J=1 TO I-1
300 LET C=T(J):LET T(J)=T(I):LET T(I)=C
310 CALL PERM(I-1)
320 LET C=T(J):LET T(J)=T(I):LET T(I)=C
330 NEXT
340 END IF
350 END DEF</lang>
 
=={{header|J}}==
<langsyntaxhighlight lang="j">perms=: A.&i.~ !</langsyntaxhighlight>
{{out|Example use}}
<langsyntaxhighlight lang="j"> perms 2
0 1
1 0
Line 4,295 ⟶ 5,026:
random text some
text some random
text random some</langsyntaxhighlight>
 
=={{header|Java}}==
Using the code of Michael Gilleland.
<langsyntaxhighlight lang="java">public class PermutationGenerator {
private int[] array;
private int firstNum;
Line 4,381 ⟶ 5,112:
}
 
} // class</langsyntaxhighlight>
{{out}}
<pre>
Line 4,394 ⟶ 5,125:
 
Following needs: [[User:Margusmartsepp/Contributions/Java/Utils.java|Utils.java]]
<langsyntaxhighlight lang="java">public class Permutations {
public static void main(String[] args) {
System.out.println(Utils.Permutations(Utils.mRange(1, 3)));
}
}</langsyntaxhighlight>
{{out}}
<pre>[[1, 2, 3], [1, 3, 2], [2, 1, 3], [2, 3, 1], [3, 1, 2], [3, 2, 1]]</pre>
Line 4,407 ⟶ 5,138:
 
Copy the following as an HTML file and load in a browser.
<langsyntaxhighlight lang="javascript"><html><head><title>Permutations</title></head>
<body><pre id="result"></pre>
<script type="text/javascript">
Line 4,429 ⟶ 5,160:
 
perm([1, 2, 'A', 4], []);
</script></body></html></langsyntaxhighlight>
 
Alternatively: 'Genuine' js code, assuming no duplicate.
 
<syntaxhighlight lang="javascript">
<lang JavaScript>
function perm(a) {
if (a.length < 2) return [a];
Line 4,446 ⟶ 5,177:
 
console.log(perm(['Aardvarks', 'eat', 'ants']).join("\n"));
</syntaxhighlight>
</lang>
 
{{Out}}
<langsyntaxhighlight JavaScriptlang="javascript">Aardvarks,eat,ants
Aardvarks,ants,eat
eat,Aardvarks,ants
eat,ants,Aardvarks
ants,Aardvarks,eat
ants,eat,Aardvarks</langsyntaxhighlight>
 
====Functional composition====
Line 4,462 ⟶ 5,193:
(Simple version – assuming a unique list of objects comparable by the JS === operator)
 
<langsyntaxhighlight JavaScriptlang="javascript">(function () {
'use strict';
 
Line 4,496 ⟶ 5,227:
// TEST
return permutations(['Aardvarks', 'eat', 'ants']);
})();</langsyntaxhighlight>
 
{{Out}}
<langsyntaxhighlight JavaScriptlang="javascript">[["Aardvarks", "eat", "ants"], ["Aardvarks", "ants", "eat"],
["eat", "Aardvarks", "ants"], ["eat", "ants", "Aardvarks"],
["ants", "Aardvarks", "eat"], ["ants", "eat", "Aardvarks"]]</langsyntaxhighlight>
 
===ES6===
Recursively, in terms of concatMap and delete:
<langsyntaxhighlight JavaScriptlang="javascript">(() => {
'use strict';
 
Line 4,543 ⟶ 5,274:
permutations(['Aardvarks', 'eat', 'ants'])
);
})();</langsyntaxhighlight>
{{Out}}
<langsyntaxhighlight JavaScriptlang="javascript">[["Aardvarks", "eat", "ants"], ["Aardvarks", "ants", "eat"],
["eat", "Aardvarks", "ants"], ["eat", "ants", "Aardvarks"],
["ants", "Aardvarks", "eat"], ["ants", "eat", "Aardvarks"]]</langsyntaxhighlight>
 
 
Or, without recursion, in terms of concatMap and reduce:
<langsyntaxhighlight lang="javascript">(() => {
'use strict';
 
Line 4,592 ⟶ 5,323:
permutations([1, 2, 3])
);
})();</langsyntaxhighlight>
{{Out}}
<pre>[[1,2,3],[2,1,3],[2,3,1],[1,3,2],[3,1,2],[3,2,1]]</pre>
Line 4,598 ⟶ 5,329:
=={{header|jq}}==
"permutations" generates a stream of the permutations of the input array.
<langsyntaxhighlight lang="jq">def permutations:
if length == 0 then []
else
Line 4,604 ⟶ 5,335:
| [.[$i]] + (del(.[$i])|permutations)
end ;
</syntaxhighlight>
</lang>
'''Example 1''': list them
[range(0;3)] | permutations
Line 4,631 ⟶ 5,362:
=={{header|Julia}}==
 
<syntaxhighlight lang="julia">
<lang Julia>
julia> perms(l) = isempty(l) ? [l] : [[x; y] for x in l for y in perms(setdiff(l, x))]
</syntaxhighlight>
</lang>
 
{{out}}
<syntaxhighlight lang="julia">
<lang Julia>
julia> perms([1,2,3])
6-element Vector{Vector{Int64}}:
Line 4,644 ⟶ 5,375:
[3, 1, 2]
[3, 2, 1]
</syntaxhighlight>
</lang>
 
Further support for permutation creation and processing is available in the <tt>Combinatorics.jl</tt> package.
<tt>permutations(v)</tt> creates an iterator over all permutations of <tt>v</tt>. Julia 0.7 and 1.0+ require the line global i inside the for to update the i variable.
<syntaxhighlight lang="julia">
<lang Julia>
using Combinatorics
 
Line 4,663 ⟶ 5,394:
end
println()
</syntaxhighlight>
</lang>
 
{{out}}
Line 4,680 ⟶ 5,411:
</pre>
 
<syntaxhighlight lang="text">
# Generate all permutations of size t from an array a with possibly duplicated elements.
collect(Combinatorics.multiset_permutations([1,1,0,0,0],3))
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 4,698 ⟶ 5,429:
=={{header|K}}==
{{trans|J}}
<langsyntaxhighlight Klang="k"> perm:{:[1<x;,/(>:'(x,x)#1,x#0)[;0,'1+_f x-1];,!x]}
perm 2
(0 1
Line 4,709 ⟶ 5,440:
random text some
text some random
text random some</langsyntaxhighlight>
 
Alternative:
<syntaxhighlight lang="k">
<lang K>
perm:{x@m@&n=(#?:)'m:!n#n:#x}
Line 4,738 ⟶ 5,469:
text some random
text random some
</syntaxhighlight>
</lang>
 
{{works with|ngn/k}}
<syntaxhighlight lang=K> prm:{$[0=x;,!0;,/(prm x-1){?[1+x;y;0]}/:\:!x]}
perm:{x[prm[#x]]}
 
(("some";"random";"text")
("random";"some";"text")
("random";"text";"some")
("some";"text";"random")
("text";"some";"random")
("text";"random";"some"))</syntaxhighlight>
 
Note, however that K is heavily optimized for "long horizontal columns and short vertical rows". Thus, a different approach drastically improves performance:
 
<syntaxhighlight lang=K>prm:{$[x~*x;;:x@o@#x];(x-1){,/'((,(#*x)##x),x)m*(!l)+&\m:~=l:1+#x}/0}
perm:{x[prm[#x]]
 
perm[" "\"some random text"]
(("text";"text";"random";"some";"random";"some")
("random";"some";"text";"text";"some";"random")
("some";"random";"some";"random";"text";"text"))</syntaxhighlight>
 
=={{header|Kotlin}}==
Translation of C# recursive 'insert' solution in Wikipedia article on Permutations:
<langsyntaxhighlight lang="scala">// version 1.1.2
 
fun <T> permute(input: List<T>): List<List<T>> {
Line 4,763 ⟶ 5,515:
println("There are ${perms.size} permutations of $input, namely:\n")
for (perm in perms) println(perm)
}</langsyntaxhighlight>
 
{{out}}
Line 4,793 ⟶ 5,545:
[d, c, a, b]
[d, c, b, a]
</pre>
 
=== Using rotate ===
 
<syntaxhighlight lang="kotlin">
 
fun <T> List<T>.rotateLeft(n: Int) = drop(n) + take(n)
 
fun <T> permute(input: List<T>): List<List<T>> =
when (input.isEmpty()) {
true -> listOf(input)
else -> {
permute(input.drop(1))
.map { it + input.first() }
.flatMap { subPerm -> List(subPerm.size) { i -> subPerm.rotateLeft(i) } }
}
}
 
fun main(args: Array<String>) {
permute(listOf(1, 2, 3)).also {
println("""There are ${it.size} permutations:
|${it.joinToString(separator = "\n")}""".trimMargin())
}
}
 
</syntaxhighlight>
{{out}}
<pre>
There are 6 permutations:
[3, 2, 1]
[2, 1, 3]
[1, 3, 2]
[2, 3, 1]
[3, 1, 2]
[1, 2, 3]
</pre>
 
=={{header|Lambdatalk}}==
 
<langsyntaxhighlight lang="scheme">
{def inject
{lambda {:x :a}
Line 4,823 ⟶ 5,610:
->
[[1,2,3,4],[2,1,3,4],[2,3,1,4],[2,3,4,1],[1,3,2,4],[3,1,2,4],[3,2,1,4],[3,2,4,1],[1,3,4,2],[3,1,4,2],[3,4,1,2],[3,4,2,1],[1,2,4,3],[2,1,4,3],[2,4,1,3],[2,4,3,1],[1,4,2,3],[4,1,2,3],[4,2,1,3],[4,2,3,1],[1,4,3,2],[4,1,3,2],[4,3,1,2],[4,3,2,1]]
</syntaxhighlight>
</lang>
 
And this is an illustration of the way lambdatalk builds an interface for javascript functions (the first one is given in this page):
 
<langsyntaxhighlight lang="javascript">
1) permutations on sentences
 
Line 4,898 ⟶ 5,685:
321
 
</syntaxhighlight>
</lang>
 
=={{header|langur}}==
Line 4,904 ⟶ 5,691:
This follows the Go language non-recursive example, but is not limited to integers, or even to numbers.
 
<syntaxhighlight lang="langur">val .factorial = fn .x: if(.x < 2: 1; .x * self(.x - 1))
{{works with|langur|0.10}}
Prior to 0.10, multi-variable declaration/assignment would use parentheses around variable names and values. 0.10 also parses the increment section of a for loop as a multi-variable assignment, not as a list of assignments.
 
val .permute = fn(.list) {
<lang langur>val .factorial = f if(.x < 2: 1; .x x self(.x - 1))
if .list is not list: throw "expected list"
 
val .permute = f(.arr) {
if not isArray(.arr): throw "expected array"
 
val .limit = 10
if len(.arrlist) > .limit: throw $"permutation limit exceeded (currently \{{.limit;}})"
 
var .elements = .arrlist
var .ordinals = pseries len .elements
 
Line 4,921 ⟶ 5,705:
var .i, .j
 
for[.p=[.arrlist]] of .factorial(len .arrlist)-1 {
.i = .n - 1
.j = .n
Line 4,945 ⟶ 5,729:
for .e in .permute([1, 3.14, 7]) {
writeln .e
}
}</lang>
</syntaxhighlight>
 
{{out}}
Line 4,957 ⟶ 5,742:
=={{header|LFE}}==
 
<langsyntaxhighlight lang="lisp">
(defun permute
(('())
Line 4,965 ⟶ 5,750:
(<- y (permute (-- l `(,x)))))
(cons x y))))
</syntaxhighlight>
</lang>
REPL usage:
<langsyntaxhighlight lang="lisp">
> (permute '(1 2 3))
((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1))
</syntaxhighlight>
</lang>
 
=={{header|Liberty BASIC}}==
Permuting numerical array (non-recursive):
{{trans|PowerBASIC}}
<lang lb>
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
</lang>
 
{{out}}
<pre>
123
132
213
231
312
321
</pre>
Permuting string (recursive):
<lang lb>
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
 
</lang>
 
{{out}}
<pre>
123
132
213
231
312
321
</pre>
 
=={{header|Lobster}}==
<syntaxhighlight lang="lobster">
<lang Lobster>
// Lobster implementation of the (very fast) Go example
// http://rosettacode.org/wiki/Permutations#Go
Line 5,183 ⟶ 5,891:
 
permi(se): print(_)
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 5,289 ⟶ 5,997:
 
=={{header|Logtalk}}==
<langsyntaxhighlight lang="logtalk">:- object(list).
 
:- public(permutation/2).
Line 5,310 ⟶ 6,018:
select(Head, Tail, Tail2).
 
:- end_object.</langsyntaxhighlight>
{{out|Usage example}}
<langsyntaxhighlight lang="logtalk">| ?- forall(list::permutation([1, 2, 3], Permutation), (write(Permutation), nl)).
 
[1,2,3]
Line 5,320 ⟶ 6,028:
[3,1,2]
[3,2,1]
yes</langsyntaxhighlight>
 
=={{header|Lua}}==
 
<langsyntaxhighlight lang="lua">
local function permutation(a, n, cb)
if n == 0 then
Line 5,342 ⟶ 6,050:
end
permutation({1,2,3}, 3, callback)
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 5,353 ⟶ 6,061:
</pre>
 
<langsyntaxhighlight lang="lua">
 
-- Iterative version
Line 5,386 ⟶ 6,094:
 
ipermutations(3, 3)
</syntaxhighlight>
</lang>
 
<pre>
Line 5,398 ⟶ 6,106:
 
=== fast, iterative with coroutine to use as a generator ===
<langsyntaxhighlight lang="lua">
#!/usr/bin/env luajit
-- Iterative version
Line 5,440 ⟶ 6,148:
print(table.concat(p, " "))
end
</syntaxhighlight>
</lang>
 
{{out}}
Line 5,455 ⟶ 6,163:
=={{header|M2000 Interpreter}}==
===All permutations in one module===
<syntaxhighlight lang="m2000 interpreter">
<lang M2000 Interpreter>
Module Checkit {
Global a$
Line 5,500 ⟶ 6,208:
}
Checkit
</syntaxhighlight>
</lang>
===Step by step Generator===
<syntaxhighlight lang="m2000 interpreter">
<lang M2000 Interpreter>
Module StepByStep {
Function PermutationStep (a) {
Line 5,547 ⟶ 6,255:
StepByStep
 
</syntaxhighlight>
</lang>
{{out}}
<pre style="height:30ex;overflow:scroll">
Line 5,617 ⟶ 6,325:
A peculiarity of this implementation is my use of arithmetic rather than branching to compute Sedgewick’s ‘k’. (I use arithmetic similarly in my Ratfor 77 implementation.)
 
<langsyntaxhighlight lang="m4">divert(-1)
 
# 1-based indexing of a string's characters.
Line 5,651 ⟶ 6,359:
divert`'dnl
permutations(`123')
permutations(`abcd')</langsyntaxhighlight>
 
{{out}}
Line 5,689 ⟶ 6,397:
 
=={{header|Maple}}==
<langsyntaxhighlight Maplelang="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]]</langsyntaxhighlight>
 
An implementation based on Mathematica solution:
 
<langsyntaxhighlight lang="maple">fold:=(f,a,v)->`if`(nops(v)=0,a,fold(f,f(a,op(1,v)),[op(2...,v)])):
insert:=(v,a,n)->`if`(n>nops(v),[op(v),a],subsop(n=(a,v[n]),v)):
perm:=s->fold((a,b)->map(u->seq(insert(u,b,k+1),k=0..nops(u)),a),[[]],s):
perm([$1..3]);
[[3, 2, 1], [2, 3, 1], [2, 1, 3], [3, 1, 2], [1, 3, 2], [1, 2, 3]]</langsyntaxhighlight>
 
=={{header|Mathematica}}/{{header|Wolfram Language}}==
Line 5,708 ⟶ 6,416:
===Version from scratch===
 
<syntaxhighlight lang="mathematica">
<lang Mathematica>
(***Standard list functions:*)
fold[f_, x_, {}] := x
Line 5,720 ⟶ 6,428:
Table[insert[L, #2, k + 1], {k, 0, Length[L]}]] /@ #1) &, {{}},
S]
</syntaxhighlight>
</lang>
 
{{out}}
Line 5,731 ⟶ 6,439:
 
===Built-in version===
<langsyntaxhighlight Mathematicalang="mathematica">Permutations[{1,2,3,4}]</langsyntaxhighlight>
{{out}}
<pre>{{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,
Line 5,738 ⟶ 6,446:
 
=={{header|MATLAB}} / {{header|Octave}}==
<langsyntaxhighlight MATLABlang="matlab">perms([1,2,3,4])</langsyntaxhighlight>
{{out}}
<pre>4321
Line 5,766 ⟶ 6,474:
 
=={{header|Maxima}}==
<langsyntaxhighlight lang="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())),
Line 5,789 ⟶ 6,497:
[2, 3, 1]
[3, 1, 2]
[3, 2, 1] */</langsyntaxhighlight>
 
===Builtin version===
<langsyntaxhighlight lang="maxima">
(%i1) permutations([1, 2, 3]);
(%o1) {[1, 2, 3], [1, 3, 2], [2, 1, 3], [2, 3, 1], [3, 1, 2], [3, 2, 1]}
</syntaxhighlight>
</lang>
 
=={{header|Mercury}}==
<langsyntaxhighlight lang="mercury">
:- module permutations2.
:- interface.
Line 5,836 ⟶ 6,544:
nl(!IO),
print(all_permutations2([1,2,3,4]),!IO).
</syntaxhighlight>
</lang>
 
{{out}}
Line 5,843 ⟶ 6,551:
sol([[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]])
sol([[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]]) 
</pre>
 
=={{header|Microsoft Small Basic}}==
{{trans|vba}}
<lang smallbasic>'Permutations - sb
n=4
printem = "True"
For i = 1 To n
p[i] = i
EndFor
count = 0
Last = "False"
While Last = "False"
If printem Then
For t = 1 To n
TextWindow.Write(p[t])
EndFor
TextWindow.WriteLine("")
EndIf
count = count + 1
Last = "True"
i = n - 1
While i > 0
If p[i] < p[i + 1] Then
Last = "False"
Goto exitwhile
EndIf
i = i - 1
EndWhile
exitwhile:
j = i + 1
k = n
While j < k
t = p[j]
p[j] = p[k]
p[k] = t
j = j + 1
k = k - 1
EndWhile
j = n
While p[j] > p[i]
j = j - 1
EndWhile
j = j + 1
t = p[i]
p[i] = p[j]
p[j] = t
EndWhile
TextWindow.WriteLine("Number of permutations: "+count) </lang>
{{out}}
<pre>
1234
1243
1324
1342
1423
1432
2134
2143
2314
2341
2413
2431
3124
3142
3214
3241
3412
3421
4123
4132
4213
4231
4312
4321
Number of permutations: 24
</pre>
 
=={{header|Modula-2}}==
{{works with|ADW Modula-2 (1.6.291)}}
<langsyntaxhighlight Modulalang="modula-2">MODULE Permute;
 
FROM Terminal
Line 5,982 ⟶ 6,614:
IF n > 0 THEN permute(n) END;
(*Wait*)
END Permute.</langsyntaxhighlight>
 
=={{header|Modula-3}}==
Line 5,989 ⟶ 6,621:
This implementation merely prints out the orbit of the list (1, 2, ..., n) under the action of <i>S<sub>n</sub></i>. It shows off Modula-3's built-in <code>Set</code> type and uses the standard <code>IntSeq</code> library module.
 
<langsyntaxhighlight lang="modula2">MODULE Permutations EXPORTS Main;
 
IMPORT IO, IntSeq;
Line 6,046 ⟶ 6,678:
GeneratePermutations(chosen, values);
 
END Permutations.</langsyntaxhighlight>
 
{{out}}
Line 6,067 ⟶ 6,699:
Suppose that <code>D</code> is the domain of elements to be permuted. This module requires a <code>DomainSeq</code> (<code>Sequence</code> of <code>D</code>), a <code>DomainSet</code> (<code>Set</code> of <code>D</code>), and a <code>DomainSeqSeq</code> (<code>Sequence</code> of <code>Sequence</code>s of <code>Domain</code>).
 
<langsyntaxhighlight lang="modula3">GENERIC INTERFACE GenericPermutations(DomainSeq, DomainSet, DomainSeqSeq);
 
(*
Line 6,094 ⟶ 6,726:
*)
 
END GenericPermutations.</langsyntaxhighlight>
 
;implementation
Line 6,100 ⟶ 6,732:
In addition to the interface's specifications, this requires a generic <code>Domain</code>. Some implementations of a set are not safe to iterate over while modifying (e.g., a tree), so this copies the values and iterates over them.
 
<langsyntaxhighlight lang="modula3">GENERIC MODULE GenericPermutations(Domain, DomainSeq, DomainSet, DomainSeqSeq);
 
(*
Line 6,170 ⟶ 6,802:
 
BEGIN
END GenericPermutations.</langsyntaxhighlight>
 
;Sample Usage
Line 6,176 ⟶ 6,808:
Here the domain is <code>Integer</code>, but the interface doesn't require that, so we "merely" need <code>IntSeq</code> (a <code>Sequence</code> of <code>Integer</code>), <code>IntSetTree</code> (a set type I use, but you could use <code>SetDef</code> or <code>SetList</code> if you prefer; I've tested it and it works), <code>IntSeqSeq</code> (a <code>Sequence</code> of <code>Sequence</code>s of <code>Integer</code>), and <code>IntPermutations</code>, which is <code>GenericPermutations</code> instantiated for <code>Integer</code>.
 
<langsyntaxhighlight lang="modula3">MODULE GPermutations EXPORTS Main;
 
IMPORT IO, IntSeq, IntSetTree, IntSeqSeq, IntPermutations;
Line 6,218 ⟶ 6,850:
END;
 
END GPermutations.</langsyntaxhighlight>
 
{{out}} (somewhat edited!)
Line 6,232 ⟶ 6,864:
 
=={{header|NetRexx}}==
<langsyntaxhighlight NetRexxlang="netrexx">/* NetRexx */
options replace format comments java crossref symbols nobinary
 
Line 6,380 ⟶ 7,012:
end thing
return
</syntaxhighlight>
</lang>
{{out}}
<pre style="height:55ex;overflow:scroll">
Line 6,428 ⟶ 7,060:
 
===Using the standard library===
<langsyntaxhighlight lang="nim">import algorithm
var v = [1, 2, 3] # List has to start sorted
echo v
while v.nextPermutation():
echo v</langsyntaxhighlight>
 
{{out}}
Line 6,445 ⟶ 7,077:
 
===Single yield iterator===
<langsyntaxhighlight lang="nim">
iterator inplacePermutations[T](xs: var seq[T]): var seq[T] =
assert xs.len <= 24, "permutation of array longer than 24 is not supported"
Line 6,469 ⟶ 7,101:
c[i] = int8(t)
i = t
</syntaxhighlight>
</lang>
verification
<langsyntaxhighlight lang="nim">
import intsets
from math import fac
Line 6,503 ⟶ 7,135:
# check exactly l! unique number of permutations
assert len(s) == fac(l)
</syntaxhighlight>
</lang>
 
===Translation of C===
{{trans|C}}
<langsyntaxhighlight lang="nim"># iterative Boothroyd method
iterator permutations[T](ys: openarray[T]): seq[T] =
var
Line 6,533 ⟶ 7,165:
 
for i in permutations(x):
echo i</langsyntaxhighlight>
Output:
<pre>@[1, 2, 3]
Line 6,544 ⟶ 7,176:
===Translation of Go===
{{trans|Go}}
<langsyntaxhighlight lang="nim"># Nim implementation of the (very fast) Go example.
# http://rosettacode.org/wiki/Permutations#Go
# implementing a recursive https://en.wikipedia.org/wiki/Steinhaus–Johnson–Trotter_algorithm
Line 6,576 ⟶ 7,208:
var se = @[0, 1, 2, 3] #, 4, 5, 6, 7, 8, 9, 10]
 
perm(se, proc(s: openArray[int])= echo s)</langsyntaxhighlight>
 
=={{header|OCaml}}==
<langsyntaxhighlight lang="ocaml">(* Iterative, though loops are implemented as auxiliary recursive functions.
Translation of Ada version. *)
let next_perm p =
Line 6,623 ⟶ 7,255:
2 3 1
3 1 2
3 2 1 *)</langsyntaxhighlight>
Permutations can also be defined on lists recursively:
<langsyntaxhighlight OCamllang="ocaml">let rec permutations l =
let n = List.length l in
if n = 1 then [l] else
Line 6,639 ⟶ 7,271:
let print l = List.iter (Printf.printf " %d") l; print_newline() in
List.iter print (permutations [1;2;3;4])</langsyntaxhighlight>
or permutations indexed independently:
<langsyntaxhighlight OCamllang="ocaml">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
Line 6,657 ⟶ 7,289:
done
 
let () = show_perms [1;2;3;4]</langsyntaxhighlight>
 
=={{header|ooRexx}}==
Essentially derived fom the program shown under rexx.
This program works also with Regina (and other REXX implementations?)
<langsyntaxhighlight lang="oorexx">
/* REXX Compute bunch permutations of things elements */
Parse Arg bunch things
Line 6,748 ⟶ 7,380:
Say 'rexx perm 2 4 -> Permutations of 1 2 3 4 in 2 positions'
Say 'rexx perm 2 a b c d -> Permutations of a b c d in 2 positions'
Exit</langsyntaxhighlight>
{{out}}
<pre>H:\>rexx perm 2 U V W X
Line 6,773 ⟶ 7,405:
 
=={{header|OpenEdge/Progress}}==
<syntaxhighlight lang="openedge/progress">
<lang OpenEdge/Progress>
DEFINE VARIABLE charArray AS CHARACTER EXTENT 3 INITIAL ["A","B","C"].
DEFINE VARIABLE sizeofArray AS INTEGER.
Line 6,808 ⟶ 7,440:
charArray[a] = charArray[b].
charArray[b] = temp.
END PROCEDURE. </langsyntaxhighlight>
{{out}}
<pre>ABC
Line 6,818 ⟶ 7,450:
 
=={{header|PARI/GP}}==
<langsyntaxhighlight lang="parigp">vector(n!,k,numtoperm(n,k))</langsyntaxhighlight>
 
=={{header|Pascal}}==
<langsyntaxhighlight lang="pascal">program perm;
 
var
Line 6,891 ⟶ 7,523:
next;
until is_last;
end.</langsyntaxhighlight>
===alternative===
a little bit more speed.I take n = 12.
Line 6,897 ⟶ 7,529:
But you have to use the integers [1..n] directly or as Index to your data.
1 to n are in lexicographic order.
<langsyntaxhighlight lang="pascal">{$IFDEF FPC}
{$MODE DELPHI}
{$ELSE}
Line 6,967 ⟶ 7,599:
writeln(permcnt);
writeln(FormatDateTime('HH:NN:SS.zzz',T1-T0));
end.</langsyntaxhighlight>
{{Out}}
{fpc 2.64/3.0 32Bit or 3.1 64 Bit i4330 3.5 Ghz same timings.
Line 6,976 ⟶ 7,608:
===Permutations from integers===
A console application in Free Pascal, created with the Lazarus IDE.
<langsyntaxhighlight lang="pascal">
program Permutations;
(*
Line 7,096 ⟶ 7,728:
end;
end.
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 7,128 ⟶ 7,760:
=={{header|Perl}}==
A simple recursive implementation.
<langsyntaxhighlight lang="perl">sub permutation {
my ($perm,@set) = @_;
print "$perm\n" || return unless (@set);
Line 7,134 ⟶ 7,766:
}
my @input = (qw/a b c d/);
permutation('',@input);</langsyntaxhighlight>
{{out}}
<pre>abcd
Line 7,163 ⟶ 7,795:
For better performance, use a module like <code>ntheory</code> or <code>Algorithm::Permute</code>.
{{libheader|ntheory}}
<langsyntaxhighlight lang="perl">use ntheory qw/forperm/;
my @tasks = (qw/party sleep study/);
forperm {
print "@tasks[@_]\n";
} @tasks;</langsyntaxhighlight>
{{out}}
<pre>
Line 7,179 ⟶ 7,811:
 
=={{header|Phix}}==
<!--<langsyntaxhighlight Phixlang="phix">(phixonline)-->
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
<span style="color: #7060A8;">requires</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"1.0.2"</span><span style="color: #0000FF;">)</span>
<span style="color: #0000FF;">?</span><span style="color: #7060A8;">shorten</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">permutes</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"abcd"</span><span style="color: #0000FF;">),</span><span style="color: #008000;">"elements"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">5</span><span style="color: #0000FF;">)</span>
<!--</langsyntaxhighlight>-->
{{out}}
<pre>
Line 7,191 ⟶ 7,823:
 
=={{header|Phixmonti}}==
<langsyntaxhighlight Phixmontilang="phixmonti">include ..\Utilitys.pmt
 
def save
Line 7,214 ⟶ 7,846:
( ) >ps
( ) ( 1 2 3 4 ) permute
ps> sort print</langsyntaxhighlight>
 
=={{header|Picat}}==
Line 7,223 ⟶ 7,855:
===Recursion===
Use <code>findall/2</code> to find all permutations. See example below.
<langsyntaxhighlight Picatlang="picat">permutation_rec1([X|Y],Z) :-
permutation_rec1(Y,W),
select(X,Z,W).
Line 7,234 ⟶ 7,866:
append(L1, L2, H1),
append(L1, [T], X1),
append(X1, L2, X).</langsyntaxhighlight>
 
===Constraint modelling===
Line 7,240 ⟶ 7,872:
 
<code>permutation_cp_list(L)</code> permutes a list via <code>permutation_cp2/1</code>.
<langsyntaxhighlight Picatlang="picat">import cp.
 
% Returns all permutations
Line 7,257 ⟶ 7,889:
% Use the cp approach on a list L.
permutation_cp_list(L) = Perms =>
Perms = [ [L[I] : I in P] : P in permutation_cp1(L.len)].</langsyntaxhighlight>
 
===Tests===
Here is a test of the different approaches, including the two built-ins.
<langsyntaxhighlight Picatlang="picat">import util, cp.
main =>
N = 3,
Line 7,270 ⟶ 7,902:
println(permutation_cp1=permutation_cp1(N)),
println(permutation_cp2=findall(P,permutation_cp2(N,P))),
println(permutation_cp_list=permutation_cp_list("abc")).</langsyntaxhighlight>
 
{{out}}
Line 7,283 ⟶ 7,915:
 
=={{header|PicoLisp}}==
<langsyntaxhighlight PicoLisplang="picolisp">(load "@lib/simul.l")
 
(permute (1 2 3))</langsyntaxhighlight>
{{out}}
<pre>-> ((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1))</pre>
 
=={{header|PowerBASIC}}==
{{works with|PowerBASIC|10.00+}}
<lang ada> #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</lang>
{{out}}
<pre>
1 2 3
1 3 2
2 1 3
2 3 1
3 1 2
3 2 1
</pre>
 
=={{header|PowerShell}}==
<syntaxhighlight lang="powershell">
<lang PowerShell>
function permutation ($array) {
function generate($n, $array, $A) {
Line 7,365 ⟶ 7,949:
}
permutation @('A','B','C')
</syntaxhighlight>
</lang>
<b>Output:</b>
<pre>
Line 7,378 ⟶ 7,962:
=={{header|Prolog}}==
Works with SWI-Prolog and library clpfd,
<langsyntaxhighlight Prologlang="prolog">:- use_module(library(clpfd)).
 
permut_clpfd(L, N) :-
Line 7,384 ⟶ 7,968:
L ins 1..N,
all_different(L),
label(L).</langsyntaxhighlight>
{{out}}
<langsyntaxhighlight Prologlang="prolog">?- permut_clpfd(L, 3), writeln(L), fail.
[1,2,3]
[1,3,2]
Line 7,394 ⟶ 7,978:
[3,2,1]
false.
</syntaxhighlight>
</lang>
A declarative way of fetching permutations:
<langsyntaxhighlight Prologlang="prolog">% permut_Prolog(P, L)
% P is a permutation of L
 
Line 7,402 ⟶ 7,986:
permut_Prolog([H | T], NL) :-
select(H, NL, NL1),
permut_Prolog(T, NL1).</langsyntaxhighlight>
{{out}}
<langsyntaxhighlight Prologlang="prolog"> ?- permut_Prolog(P, [ab, cd, ef]), writeln(P), fail.
[ab,cd,ef]
[ab,ef,cd]
Line 7,411 ⟶ 7,995:
[ef,ab,cd]
[ef,cd,ab]
false.</langsyntaxhighlight>
{{Trans|Curry}}
<syntaxhighlight lang="prolog">
<lang Prolog>
insert(X, L, [X|L]).
insert(X, [Y|Ys], [Y|L2]) :- insert(X, Ys, L2).
Line 7,419 ⟶ 8,003:
permutation([], []).
permutation([X|Xs], P) :- permutation(Xs, L), insert(X, L, P).
</syntaxhighlight>
</lang>
{{Out}}
<pre>
Line 7,431 ⟶ 8,015:
false.
</pre>
 
=={{header|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.
<lang PureBasic>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</lang>
{{out}}
<pre>1, 2, 3
1, 3, 2
2, 1, 3
2, 3, 1
3, 1, 2
3, 2, 1</pre>
 
=={{header|Python}}==
Line 7,505 ⟶ 8,020:
===Standard library function===
{{works with|Python|2.6+}}
<langsyntaxhighlight lang="python">import itertools
for values in itertools.permutations([1,2,3]):
print (values)</langsyntaxhighlight>
{{out}}
<pre>
Line 7,522 ⟶ 8,037:
The follwing functions start from a list [0 ... n-1] and exchange elements to always have a valid permutation. This is done recursively: first exchange a[0] with all the other elements, then a[1] with a[2] ... a[n-1], etc. thus yielding all permutations.
 
<langsyntaxhighlight lang="python">def perm1(n):
a = list(range(n))
def sub(i):
Line 7,547 ⟶ 8,062:
a[k - 1] = a[k]
a[n - 1] = x
yield from sub(0)</langsyntaxhighlight>
 
These two solutions make use of a generator, and "yield from" introduced in [https://www.python.org/dev/peps/pep-0380/ PEP-380]. They are slightly different: the latter produces permutations in lexicographic order, because the "remaining" part of a (that is, a[i+1:]) is always sorted, whereas the former always reverses the exchange just after the recursive call.
Line 7,553 ⟶ 8,068:
On three elements, the difference can be seen on the last two permutations:
 
<langsyntaxhighlight lang="python">for u in perm1(3): print(u)
(0, 1, 2)
(0, 2, 1)
Line 7,567 ⟶ 8,082:
(1, 2, 0)
(2, 0, 1)
(2, 1, 0)</langsyntaxhighlight>
 
=== Iterative implementation ===
Line 7,573 ⟶ 8,088:
Given a permutation, one can easily compute the ''next'' permutation in some order, for example lexicographic order, here. Then to get all permutations, it's enough to start from [0, 1, ... n-1], and store the next permutation until [n-1, n-2, ... 0], which is the last in lexicographic order.
 
<langsyntaxhighlight lang="python">def nextperm(a):
n = len(a)
i = n - 1
Line 7,611 ⟶ 8,126:
(1, 2, 0)
(2, 0, 1)
(2, 1, 0)</langsyntaxhighlight>
 
=== Implementation using destructive list updates ===
<langsyntaxhighlight lang="python">
def permutations(xs):
ac = [[]]
Line 7,628 ⟶ 8,143:
 
print(permutations([1,2,3,4]))
</syntaxhighlight>
</lang>
 
===Functional :: type-preserving===
Line 7,636 ⟶ 8,151:
 
{{Works with|Python|3.7}}
<langsyntaxhighlight lang="python">'''Permutations of a list, string or tuple'''
 
from functools import (reduce)
Line 7,721 ⟶ 8,236:
# MAIN ---
if __name__ == '__main__':
main()</langsyntaxhighlight>
{{Out}}
<pre>[1, 2, 3] -> [[1,2,3],[2,3,1],[3,1,2],[2,1,3],[1,3,2],[3,2,1]]
'abc' -> ['abc','bca','cab','bac','acb','cba']
(1, 2, 3) -> [(1, 2, 3),(2, 3, 1),(3, 1, 2),(2, 1, 3),(1, 3, 2),(3, 2, 1)]</pre>
 
=={{header|QBasic}}==
{{works with|QBasic|1.1}}
{{works with|QuickBasic|4.5}}
{{trans|FreeBASIC}}
<lang qbasic>SUB perms (n)
DIM a(0 TO n - 1), c(0 TO n - 1)
FOR j = 0 TO n - 1
a(j) = j + 1
PRINT a(j);
NEXT j
PRINT
i = 0
WHILE i < n
IF c(i) < i THEN
IF (i AND 1) = 0 THEN
SWAP a(0), a(i)
ELSE
SWAP a(c(i)), a(i)
END IF
FOR j = 0 TO n - 1
PRINT a(j);
NEXT j
PRINT
c(i) = c(i) + 1
i = 0
ELSE
c(i) = 0
i = i + 1
END IF
WEND
END SUB
 
perms(4)</lang>
 
=={{header|Qi}}==
{{trans|Erlang}}
<syntaxhighlight lang="qi">
<lang qi>
(define insert
L 0 E -> [E|L]
Line 7,784 ⟶ 8,263:
(insert P N H))
(seq 0 (length P))))
(permute T))))</langsyntaxhighlight>
 
 
Line 7,792 ⟶ 8,271:
The word ''perms'' solves a more general task; generate permutations of between ''a'' and ''b'' items (inclusive) from the specified nest.
 
<langsyntaxhighlight Quackerylang="quackery"> [ stack ] is perms.min ( --> [ )
 
[ stack ] is perms.max ( --> [ )
Line 7,823 ⟶ 8,302:
' [ 1 2 3 ] permutations echo cr
$ "quack" permutations 60 wrap$
$ "quack" 3 4 perms 46 wrap$</langsyntaxhighlight>
 
'''Output:'''
Line 7,872 ⟶ 8,351:
by stuffing the 0 into each of the 4 possible positions that it could go.
 
The code start with a nest of all the permutations of 0 items <code>[ [ ] ]</code>, and each time though the outer <code>times</code> loop (i.e. 4 times in the example) it takes each of the permutations generated so far (this is the <code>witheach</code> loop) and applies the central idea descrieddescribed above (that is the inner <code>times</code> loop.)
 
'''Some aids to reading the code.'''
Line 7,894 ⟶ 8,373:
<code>nested join</code> adds a nest to the end of a nest as its last item.
 
<langsyntaxhighlight Quackerylang="quackery"> [ ' [ [ ] ] swap times
[ [] i rot witheach
[ dup size 1+ times
Line 7,901 ⟶ 8,380:
unrot ] drop ] drop ] ] is perms ( n --> [ )
 
4 perms witheach [ echo cr ]</langsyntaxhighlight>
 
{{out}}
Line 7,933 ⟶ 8,412:
=={{header|R}}==
===Iterative version===
<langsyntaxhighlight lang="r">next.perm <- function(a) {
n <- length(a)
i <- n
Line 7,967 ⟶ 8,446:
}
unname(e)
}</langsyntaxhighlight>
 
'''Example'''
 
<syntaxhighlight lang="text">> perm(3)
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 1 1 2 2 3 3
[2,] 2 3 1 3 1 2
[3,] 3 2 3 1 2 1</langsyntaxhighlight>
 
===Recursive version===
<langsyntaxhighlight lang="r"># list of the vectors by inserting x in s at position 0...end.
linsert <- function(x,s) lapply(0:length(s), function(k) append(s,x,k))
 
Line 7,989 ⟶ 8,468:
# permutations of a vector s
permutation <- function(s) lapply(perm(length(s)), function(i) s[i])
</syntaxhighlight>
</lang>
 
Output:
<langsyntaxhighlight lang="r">> permutation(letters[1:3])
[[1]]
[1] "c" "b" "a"
Line 8,009 ⟶ 8,488:
 
[[6]]
[1] "a" "b" "c"</langsyntaxhighlight>
 
=={{header|Racket}}==
<langsyntaxhighlight lang="racket">
#lang racket
 
Line 8,073 ⟶ 8,552:
(next-perm (permuter))))))
;; -> (A B C)(A C B)(B A C)(B C A)(C A B)(C B A)
</syntaxhighlight>
</lang>
 
=={{header|Raku}}==
Line 8,079 ⟶ 8,558:
{{works with|rakudo|2018.10}}
First, you can just use the built-in method on any list type.
<syntaxhighlight lang="raku" perl6line>.say for <a b c>.permutations</langsyntaxhighlight>
{{out}}
<pre>a b c
Line 8,089 ⟶ 8,568:
 
Here is some generic code that works with any ordered type. To force lexicographic ordering, change <tt>after</tt> to <tt>gt</tt>. To force numeric order, replace it with <tt>&gt;</tt>.
<syntaxhighlight lang="raku" perl6line>sub next_perm ( @a is copy ) {
my $j = @a.end - 1;
return Nil if --$j < 0 while @a[$j] after @a[$j+1];
Line 8,104 ⟶ 8,583:
}
 
.say for [<a b c>], &next_perm ...^ !*;</langsyntaxhighlight>
{{out}}
<pre>a b c
Line 8,114 ⟶ 8,593:
</pre>
Here is another non-recursive implementation, which returns a lazy list. It also works with any type.
<syntaxhighlight lang="raku" perl6line>sub permute(+@items) {
my @seq := 1..+@items;
gather for (^[*] @seq) -> $n is copy {
Line 8,126 ⟶ 8,605:
}
}
.say for permute( 'a'..'c' )</langsyntaxhighlight>
{{out}}
<pre>(a b c)
Line 8,135 ⟶ 8,614:
(c b a)</pre>
Finally, if you just want zero-based numbers, you can call the built-in function:
<syntaxhighlight lang="raku" perl6line>.say for permutations(3);</langsyntaxhighlight>
{{out}}
<pre>0 1 2
Line 8,147 ⟶ 8,626:
For translation to FORTRAN 77 with the public domain ratfor77 preprocessor.
 
<langsyntaxhighlight lang="ratfor"># Heap’s algorithm for generating permutations. Algorithm 2 in
# Robert Sedgewick, 1977. Permutation generation methods. ACM
# Comput. Surv. 9, 2 (June 1977), 137-164.
Line 8,193 ⟶ 8,672:
}
 
end</langsyntaxhighlight>
 
Here is what the generated FORTRAN 77 code looks like:
<langsyntaxhighlight lang="fortran">C Output from Public domain Ratfor, version 1.0
implicit none
integer a(1: 3)
Line 8,229 ⟶ 8,708:
endif
23005 continue
end</langsyntaxhighlight>
 
{{out}}
Line 8,243 ⟶ 8,722:
This program could be simplified quite a bit if the "things" were just restricted to numbers (numerals),
<br>but that would make it specific to numbers and not "things" or objects.
<langsyntaxhighlight lang="rexx">/*REXX pgm generates/displays all permutations of N different objects taken M at a time.*/
parse arg things bunch inbetweenChars names /*obtain optional arguments from the CL*/
if things=='' | things=="," then things= 3 /*Not specified? Then use the default.*/
Line 8,281 ⟶ 8,760:
@.?= $.q; call .permSet ?+1
end /*q*/
return</langsyntaxhighlight>
{{out|output|text=&nbsp; when the following was used for input: &nbsp; &nbsp; <tt> 3 &nbsp; 3 </tt>}}
<pre>
Line 8,347 ⟶ 8,826:
 
=={{header|Ring}}==
<langsyntaxhighlight lang="ring">
load "stdlib.ring"
 
Line 8,395 ⟶ 8,874:
last -= 1
end
</syntaxhighlight>
</lang>
Output:
<pre>
Line 8,426 ⟶ 8,905:
 
=={{header|Ring}}==
<langsyntaxhighlight lang="ring">
 
Another Solution
Line 8,479 ⟶ 8,958:
 
 
</syntaxhighlight>
</lang>
Output:
<pre>
Line 8,517 ⟶ 8,996:
 
=={{header|Ruby}}==
<langsyntaxhighlight lang="ruby">p [1,2,3].permutation.to_a</langsyntaxhighlight>
{{out}}
<pre>
[[1, 2, 3], [1, 3, 2], [2, 1, 3], [2, 3, 1], [3, 1, 2], [3, 2, 1]]
</pre>
 
=={{header|Run BASIC}}==
Works with Run BASIC, Liberty BASIC and Just BASIC
<lang Runbasic>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</lang>Output:
<pre>hello
ehllo
elhlo
ellho
elloh
leloh
lleoh
lloeh
llohe
lolhe
lohle
lohel
olhel
ohlel
ohell
hoell
heoll
helol</pre>
 
=={{header|Rust}}==
===Iterative===
Uses Heap's algorithm. An in-place version is possible but is incompatible with <code>Iterator</code>.
<langsyntaxhighlight lang="rust">pub fn permutations(size: usize) -> Permutations {
Permutations { idxs: (0..size).collect(), swaps: vec![0; size], i: 0 }
}
Line 8,611 ⟶ 9,044:
vec![2, 1, 0],
]);
}</langsyntaxhighlight>
 
===Recursive===
<langsyntaxhighlight lang="rust">use std::collections::VecDeque;
 
fn permute<T, F: Fn(&[T])>(used: &mut Vec<T>, unused: &mut VecDeque<T>, action: &F) {
Line 8,631 ⟶ 9,064:
let mut queue = (1..4).collect::<VecDeque<_>>();
permute(&mut Vec::new(), &mut queue, &|perm| println!("{:?}", perm));
}</langsyntaxhighlight>
 
=={{header|SAS}}==
<!-- oh god this code -->
<langsyntaxhighlight lang="sas">/* Store permutations in a SAS dataset. Translation of Fortran 77 */
data perm;
n=6;
Line 8,676 ⟶ 9,109:
return;
keep p1-p6;
run;</langsyntaxhighlight>
 
=={{header|Scala}}==
There is a built-in function in the Scala collections library, that is part of the language's standard library. The permutation function is available on any sequential collection. It could be used as follows given a list of numbers:
 
<langsyntaxhighlight lang="scala">List(1, 2, 3).permutations.foreach(println)</langsyntaxhighlight>
 
{{out}}
Line 8,694 ⟶ 9,127:
The following function returns all the permutations of a list:
 
<langsyntaxhighlight lang="scala"> def permutations[T]: List[T] => Traversable[List[T]] = {
case Nil => List(Nil)
case xs => {
Line 8,704 ⟶ 9,137:
}
}
}</langsyntaxhighlight>
 
If you need the unique permutations, use <code>distinct</code> or <code>toSet</code> on either the result or on the input.
Line 8,710 ⟶ 9,143:
=={{header|Scheme}}==
{{trans|Erlang}}
<langsyntaxhighlight lang="scheme">(define (insert l n e)
(if (= 0 n)
(cons e l)
Line 8,728 ⟶ 9,161:
(insert p n (car l)))
(seq 0 (length p))))
(permute (cdr l))))))</langsyntaxhighlight>
{{trans|OCaml}}
<langsyntaxhighlight lang="scheme">; translation of ocaml : mostly iterative, with auxiliary recursive functions for some loops
(define (vector-swap! v i j)
(let ((tmp (vector-ref v i)))
Line 8,790 ⟶ 9,223:
; 1 2 0
; 2 0 1
; 2 1 0</langsyntaxhighlight>
Completely recursive on lists:
<langsyntaxhighlight lang="lisp">(define (perm s)
(cond ((null? s) '())
((null? (cdr s)) (list s))
Line 8,802 ⟶ 9,235:
(splice (cons m l) (car r) (cdr r))))))))
 
(display (perm '(1 2 3)))</langsyntaxhighlight>
 
=={{header|Seed7}}==
<langsyntaxhighlight lang="seed7">$ include "seed7_05.s7i";
 
const type: permutations is array array integer;
Line 8,841 ⟶ 9,274:
writeln;
end for;
end func;</langsyntaxhighlight>
{{out}}
<pre>
Line 8,853 ⟶ 9,286:
 
=={{header|Shen}}==
<syntaxhighlight lang="shen">
<lang Shen>
(define permute
[] -> []
Line 8,872 ⟶ 9,305:
 
(permute [a b c d])
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 8,878 ⟶ 9,311:
</pre>
For lexical order, make a small change:
<syntaxhighlight lang="shen">
<lang Shen>
(define permute-helper
_ [] -> []
Done [X|Rest] -> (append (prepend-all X (permute (append Done Rest))) (permute-helper (append Done [X]) Rest))
)
</syntaxhighlight>
</lang>
 
=={{header|Sidef}}==
===Built-in===
<langsyntaxhighlight lang="ruby">[0,1,2].permutations { |p*a|
say pa
}</langsyntaxhighlight>
 
===Iterative===
<langsyntaxhighlight lang="ruby">func forperm(callback, n) {
var idx = @^n
 
loop {
callback([idx...])
 
var p = n-1
Line 8,912 ⟶ 9,345:
}
 
forperm({|*p| say p }, 3)</langsyntaxhighlight>
 
===Recursive===
<langsyntaxhighlight lang="ruby">func permutations(callback, set, perm=[]) {
set.is_empty &&|| callback(perm)
for i in ^set {
__FUNC__(callback, [
set[(0 ..^ i)..., (i+1 ..^ set.len)...]
], [perm..., set[i]])
}
Line 8,925 ⟶ 9,358:
}
 
permutations({|p| say p }, [0,1,2])</langsyntaxhighlight>
{{out}}
<pre>
Line 8,939 ⟶ 9,372:
{{works with|Squeak}}
{{works with|Pharo}}
<langsyntaxhighlight lang="smalltalk">(1 to: 4) permutationsDo: [ :x |
Transcript show: x printString; cr ].</langsyntaxhighlight>
{{works with|GNU Smalltalk}}
<langsyntaxhighlight lang="smalltalk">
ArrayedCollection extend [
 
Line 8,970 ⟶ 9,403:
[:g |
c map permuteAndDo: [g yield: (c copyFrom: 1 to: c size)]]]
</syntaxhighlight>
</lang>
 
Use example:
<syntaxhighlight lang="smalltalk">
<lang Smalltalk>
st> 'Abc' permutations contents
('bcA' 'cbA' 'cAb' 'Acb' 'bAc' 'Abc' )
</syntaxhighlight>
</lang>
 
=={{header|Standard ML}}==
<syntaxhighlight lang="sml">
fun interleave x [] = [[x]]
| interleave x (y::ys) = (x::y::ys) :: (List.map (fn a => y::a) (interleave x ys))
 
fun perms [] = [[]]
| perms (x::xs) = List.concat (List.map (interleave x) (perms xs))
</syntaxhighlight>
 
=={{header|Stata}}==
Line 8,983 ⟶ 9,425:
For instance:
 
<syntaxhighlight lang ="stata">perm 4</langsyntaxhighlight>
 
'''Program'''
 
<langsyntaxhighlight lang="stata">program perm
local n=`1'
local r=1
Line 9,027 ⟶ 9,469:
} while (i > 1)
}
end</langsyntaxhighlight>
 
=={{header|Swift}}==
<langsyntaxhighlight lang="swift">func perms<T>(var ar: [T]) -> [[T]] {
return heaps(&ar, ar.count)
}
Line 9,044 ⟶ 9,486:
}
 
perms([1, 2, 3]) // [[1, 2, 3], [2, 1, 3], [3, 1, 2], [1, 3, 2], [2, 3, 1], [3, 2, 1]]</langsyntaxhighlight>
 
=={{header|Tailspin}}==
This solution seems to be the same as the Kotlin solution. Permutations flow independently without being collected until the end.
<langsyntaxhighlight lang="tailspin">
templates permutations
when <=1> do [1] !
Line 9,063 ⟶ 9,505:
def alpha: ['ABCD'...];
[ $alpha::length -> permutations -> '$alpha($)...;' ] -> !OUT::write
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 9,070 ⟶ 9,512:
 
If we collect all the permutations of the next size down, we can output permutations in lexical order
<langsyntaxhighlight lang="tailspin">
templates lexicalPermutations
when <=1> do [1] !
Line 9,082 ⟶ 9,524:
def alpha: ['ABCD'...];
[ $alpha::length -> lexicalPermutations -> '$alpha($)...;' ] -> !OUT::write
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 9,089 ⟶ 9,531:
 
That algorithm can also be written from the bottom up to produce an infinite stream of sets of larger and larger permutations, until we stop
<langsyntaxhighlight lang="tailspin">
templates lexicalPermutations2
def N: $;
Line 9,102 ⟶ 9,544:
end lexicalPermutations2
 
def alpha: ['ABCD'...];
[ $alpha::length -> lexicalPermutations2 -> '$alpha($)...;' ] -> !OUT::write
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 9,110 ⟶ 9,553:
 
The solutions above create a lot of new arrays at various stages. We can also use mutable state and just emit a copy for each generated solution.
<langsyntaxhighlight lang="tailspin">
templates perms
templates findPerms
Line 9,129 ⟶ 9,572:
def alpha: ['ABCD'...];
[4 -> perms -> '$alpha($)...;' ] -> !OUT::write
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 9,137 ⟶ 9,580:
=={{header|Tcl}}==
{{tcllib|struct::list}}
<langsyntaxhighlight lang="tcl">package require struct::list
 
# Make the sequence of digits to be permuted
Line 9,146 ⟶ 9,589:
struct::list foreachperm p $sequence {
puts $p
}</langsyntaxhighlight>
Testing with <code>tclsh listPerms.tcl 3</code> produces this output:
<pre>
Line 9,157 ⟶ 9,600:
</pre>
 
=={{header|TrueUNIX BASICShell}}==
{{works with|Bourne Again SHell}}
{{trans|Liberty BASIC}}
{{works with|Korn Shell}}
<lang qbasic>SUB SWAP(vb1, vb2)
LET temp = vb1
LET vb1 = vb2
LET vb2 = temp
END SUB
 
Straightforward implementation of Heap's algorithm operating in-place on an array local to the <tt>permute</tt> function.
LET n = 4
DIM a(4)
DIM c(4)
 
<syntaxhighlight lang="bash">function permute {
FOR i = 1 TO n
if LET a(i)( $# == 1 )); ithen
set -- $(seq $1)
NEXT i
fi
PRINT
local A=("$@")
permuteAn "$#"
}
 
function permuteAn {
DO
# print all permutations of first n elements of the array A, with remaining
FOR i = 1 TO n
# elements unchanged.
PRINT a(i);
local NEXT-i n=$1 i
PRINTshift
if LET(( in == n1 )); then
printf '%s\n' "${A[*]}"
DO
else
LET i = i - 1
LOOP UNTILpermuteAn $(i = 0) OR (a(i) <n-1 a(i + 1))
LET jfor (( i=0; i<n-1; ++i 1)); do
LET k = nlocal -i k
DO WHILE j <(( k=n%2 ? 0: i ))
CALLlocal SWAP (a(j), a(t=${A[k))]}
LET j A[k]= j + ${A[n-1]}
LET k = k A[n- 1]=$t
permuteAn $(( n-1 ))
LOOP
IF i > 0 THENdone
fi
LET j = i + 1
}</syntaxhighlight>
DO WHILE a(j) < a(i)
 
LET j = j + 1
For Zsh the array indices need to be bumped by 1 inside the <tt>permuteAn</tt> function:
LOOP
 
CALL SWAP (a(i), a(j))
{{works with|Z Shell}}
END IF
<syntaxhighlight lang="zsh">function permuteAn {
LOOP UNTIL i = 0
# print all permutations of first n elements of the array A, with remaining
END</lang>
# elements unchanged.
local -i n=$1 i
shift
if (( n == 1 )); then
printf '%s\n' "${A[*]}"
else
permuteAn $(( n-1 ))
for (( i=1; i<n; ++i )); do
local -i k
(( k=n%2 ? 1 : i ))
local t=$A[k]
A[k]=$A[n]
A[n]=$t
permuteAn $(( n-1 ))
done
fi
}</syntaxhighlight>
 
{{Out}}
Sample run:
<pre>$ permute 4
permute 4
1 2 3 4
2 1 3 4
3 1 2 4
1 3 2 4
2 3 1 4
3 2 1 4
4 2 1 3
2 4 1 3
1 4 2 3
4 1 2 3
2 1 4 3
1 2 4 3
1 3 4 2
3 1 4 2
4 1 3 2
1 4 3 2
3 4 1 2
4 3 1 2
4 3 2 1
3 4 2 1
2 4 3 1
4 2 3 1
3 2 4 1
2 3 4 1</pre>
 
=={{header|Ursala}}==
In practice there's no need to write this because it's in the standard library.
<langsyntaxhighlight Ursalalang="ursala">#import std
 
permutations =
Line 9,210 ⟶ 9,696:
~&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</langsyntaxhighlight>
test program:
<langsyntaxhighlight Ursalalang="ursala">#cast %nLL
 
test = permutations <1,2,3></langsyntaxhighlight>
{{out}}
<pre><
Line 9,226 ⟶ 9,712:
=={{header|VBA}}==
{{trans|Pascal}}
<langsyntaxhighlight VBlang="vb">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
Line 9,307 ⟶ 9,793:
Debug.Print "Number of permutations: "; count
End Sub</langsyntaxhighlight>
{{out|Sample dialogue}}
<pre>
Line 9,348 ⟶ 9,834:
=={{header|VBScript}}==
A recursive implementation. Arrays can contain anything, I stayed with with simple variables. (Elements could be arrays but then the printing routine should be recursive...)
<syntaxhighlight lang="vb">
<lang vb>
'permutation ,recursive
a=array("Hello",1,True,3.141592)
Line 9,373 ⟶ 9,859:
next
end sub
</syntaxhighlight>
</lang>
Output
<pre>
Line 9,407 ⟶ 9,893:
===Recursive===
{{trans|Kotlin}}
<langsyntaxhighlight ecmascriptlang="wren">var permute // recursive
permute = Fn.new { |input|
if (input.count == 1) return [input]
Line 9,425 ⟶ 9,911:
var perms = permute.call(input)
System.print("There are %(perms.count) permutations of %(input), namely:\n")
perms.each { |perm| System.print(perm) }</langsyntaxhighlight>
 
{{out}}
Line 9,443 ⟶ 9,929:
{{libheader|Wren-math}}
Output modified to follow the pattern of the recursive version.
<langsyntaxhighlight ecmascriptlang="wren">import "./math" for Int
 
var input = [1, 2, 3]
Line 9,469 ⟶ 9,955:
}
System.print("There are %(perms.count) permutations of %(input), namely:\n")
perms.each { |perm| System.print(perm) }</langsyntaxhighlight>
 
{{out}}
Line 9,485 ⟶ 9,971:
===Library based===
{{libheader|Wren-perm}}
<langsyntaxhighlight ecmascriptlang="wren">import "./perm" for Perm
 
var a = [1, 2, 3]
System.print(Perm.list(a)) // not lexicographic
System.print()
System.print(Perm.listLex(a)) // lexicographic</langsyntaxhighlight>
 
{{out}}
Line 9,500 ⟶ 9,986:
 
=={{header|XPL0}}==
<langsyntaxhighlight XPL0lang="xpl0">code ChOut=8, CrLf=9;
def N=4; \number of objects (letters)
char S0, S1(N);
Line 9,524 ⟶ 10,010:
[S0:= "rose "; \N different objects (letters)
Permute(0); \(space char avoids MSb termination)
]</langsyntaxhighlight>
 
Output:
Line 9,556 ⟶ 10,042:
=={{header|zkl}}==
Using the solution from task [[Permutations by swapping#zkl]]:
<langsyntaxhighlight lang="zkl">zkl: Utils.Helpers.permute("rose").apply("concat")
L("rose","roes","reos","eros","erso","reso","rseo","rsoe","sroe","sreo",...)
 
Line 9,563 ⟶ 10,049:
 
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),...)</langsyntaxhighlight>
885

edits