Permutations: Difference between revisions
→{{header|langur}}
(→{{header|UNIX Shell}}: Add implementation) |
Langurmonkey (talk | contribs) |
||
| (27 intermediate revisions by 14 users not shown) | |||
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
-- Robert Sedgewick's PDF document "Permutation Generation Methods"
-- <https://www.cs.princeton.edu/~rs/talks/perms.pdf>
on allPermutations(theList)
script o
-- Work list and precalculated indices for its last four items (assuming that many).
property
property r : (count theList)
property
property
property
-- Output list and traversal index.
property output : {}
property p : 1
-- Recursive handler
on prmt(l)
set rangeLenEven to ((r - l) mod 2 = 1)
-- Tail call elimination repeat.
repeat with l from
prmt(lPlus1)
-- And again after swaps of item l with each of the items to its right
-- (if the range
-- instead be the next iteration of this
if (rangeLenEven) then
repeat with swapIdx from r to (lPlus1 +
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(
end repeat
set
else
set
end tell
prmt(
end repeat
set
end if
tell my workList's item l
set
end tell
set
end repeat
-- Store
--
set
set
set
set my output's item
set
set my output's item
set
set my output's item
set
set my output's item
set
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
--
copy theList to
if (o's r is 2) then set
else
-- Otherwise
copy theList to o's workList
set factorial to 2
repeat with i from 3 to o's r
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
end allPermutations
on makeList(limit, filler)
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}}
<syntaxhighlight lang="applescript">{{1, 2,
=={{header|ARM Assembly}}==
Line 1,759 ⟶ 1,772:
</pre>
=={{header|
==={{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}}
<syntaxhighlight lang="basic256">arraybase 1
Line 1,805 ⟶ 1,847:
end</syntaxhighlight>
==={{header|
The procedure PROC_NextPermutation() will give the next lexicographic permutation of an integer array.
<syntaxhighlight lang="bbcbasic"> DIM List%(3)
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>
Line 2,904 ⟶ 3,578:
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}}==
Line 2,910 ⟶ 3,602:
* Implements permutations without repetition.
*/
module Permutations {
static Int[][] permut(Int items) {
// 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
Line 2,927 ⟶ 3,616:
// 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>
Line 3,929 ⟶ 4,615:
=== Ratfor 77 ===
See [[#RATFOR|RATFOR]].
=={{header|Frink}}==
Line 4,018 ⟶ 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 4,341 ⟶ 5,013:
ants Aardvarks eat
-></pre>
=={{header|J}}==
Line 4,826 ⟶ 5,470:
text random some
</syntaxhighlight>
{{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}}==
Line 4,880 ⟶ 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>
Line 4,991 ⟶ 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))
val .permute = fn(.list) {
if .list is not list: throw "expected list"
val .limit = 10
if len(.
var .elements = .
var .ordinals = pseries len .elements
Line 5,008 ⟶ 5,705:
var .i, .j
for[.p=[.
.i = .n - 1
.j = .n
Line 5,032 ⟶ 5,729:
for .e in .permute([1, 3.14, 7]) {
writeln .e
}
</syntaxhighlight>
{{out}}
Line 5,058 ⟶ 5,756:
((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1))
</syntaxhighlight>
=={{header|Lobster}}==
Line 5,930 ⟶ 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>
Line 7,375 ⟶ 7,920:
{{out}}
<pre>-> ((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1))</pre>
=={{header|PowerShell}}==
Line 7,518 ⟶ 8,015:
false.
</pre>
=={{header|Python}}==
Line 7,813 ⟶ 8,241:
'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|Qi}}==
Line 8,609 ⟶ 9,001:
[[1, 2, 3], [1, 3, 2], [2, 1, 3], [2, 3, 1], [3, 1, 2], [3, 2, 1]]
</pre>
=={{header|Rust}}==
Line 8,974 ⟶ 9,320:
=={{header|Sidef}}==
===Built-in===
<syntaxhighlight lang="ruby">[0,1,2].permutations { |
say
}</syntaxhighlight>
Line 8,983 ⟶ 9,329:
loop {
callback(
var p = n-1
Line 8,999 ⟶ 9,345:
}
forperm({|*p| say p }, 3)</syntaxhighlight>
===Recursive===
<syntaxhighlight lang="ruby">func permutations(callback, set, perm=[]) {
set
for i in ^set {
__FUNC__(callback, [
set[
], [perm..., set[i]])
}
Line 9,063 ⟶ 9,409:
st> 'Abc' permutations contents
('bcA' 'cbA' 'cAb' 'Acb' 'bAc' 'Abc' )
</syntaxhighlight>
=={{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>
Line 9,244 ⟶ 9,599:
3 2 1
</pre>
=={{header|UNIX Shell}}==
Line 9,303 ⟶ 9,615:
function permuteAn {
#
# elements unchanged.
local -i n=$1 i
Line 9,326 ⟶ 9,638:
{{works with|Z Shell}}
<syntaxhighlight lang="zsh">function permuteAn {
#
# elements unchanged.
local -i n=$1 i
Line 9,373 ⟶ 9,685:
3 2 4 1
2 3 4 1</pre>
=={{header|Ursala}}==
Line 9,582 ⟶ 9,893:
===Recursive===
{{trans|Kotlin}}
<syntaxhighlight lang="
permute = Fn.new { |input|
if (input.count == 1) return [input]
Line 9,618 ⟶ 9,929:
{{libheader|Wren-math}}
Output modified to follow the pattern of the recursive version.
<syntaxhighlight lang="
var input = [1, 2, 3]
Line 9,660 ⟶ 9,971:
===Library based===
{{libheader|Wren-perm}}
<syntaxhighlight lang="
var a = [1, 2, 3]
Line 9,728 ⟶ 10,039:
esor
</pre>
=={{header|zkl}}==
| |||