Permutations: Difference between revisions

3,817 bytes added ,  14 days ago
 
(22 intermediate revisions by 11 users not shown)
Line 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}}
<syntaxhighlight lang="basic256">arraybase 1
Line 1,818 ⟶ 1,847:
end</syntaxhighlight>
 
==={{header|BatchBBC FileBASIC}}===
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|BBC BASIC}}==
The procedure PROC_NextPermutation() will give the next lexicographic permutation of an integer array.
<syntaxhighlight lang="bbcbasic"> DIM List%(3)
Line 1,949 ⟶ 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,653 ⟶ 3,314:
3,1,2
3,2,1</syntaxhighlight>
 
=={{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|Common Lisp}}==
Line 2,959 ⟶ 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,965 ⟶ 3,602:
* Implements permutations without repetition.
*/
module Permutations {
static Int[][] permut(Int items) {
{
static Int[][] permut(Int if (items <= 1) {
{
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
Line 2,982 ⟶ 3,616:
// the first digit
Int[][] result = new Int[][];
for (Int prefix : 0 ..< items) {
for (Int[] suffix : pattern) {
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,984 ⟶ 4,615:
=== Ratfor 77 ===
See [[#RATFOR|RATFOR]].
 
=={{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|Frink}}==
Line 4,073 ⟶ 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,396 ⟶ 5,013:
ants Aardvarks eat
-></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|J}}==
Line 4,881 ⟶ 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 5,081 ⟶ 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) {
<syntaxhighlight 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 5,098 ⟶ 5,705:
var .i, .j
 
for[.p=[.arrlist]] of .factorial(len .arrlist)-1 {
.i = .n - 1
.j = .n
Line 5,122 ⟶ 5,729:
for .e in .permute([1, 3.14, 7]) {
writeln .e
}
}</syntaxhighlight>
</syntaxhighlight>
 
{{out}}
Line 5,148 ⟶ 5,756:
((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1))
</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|Lobster}}==
Line 6,020 ⟶ 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}}
<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>
 
Line 7,465 ⟶ 7,920:
{{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+}}
<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|PowerShell}}==
Line 7,608 ⟶ 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.
<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|Python}}==
Line 7,903 ⟶ 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|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|Qi}}==
Line 8,699 ⟶ 9,001:
[[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
<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|Rust}}==
Line 9,064 ⟶ 9,320:
=={{header|Sidef}}==
===Built-in===
<syntaxhighlight lang="ruby">[0,1,2].permutations { |p*a|
say pa
}</syntaxhighlight>
 
Line 9,073 ⟶ 9,329:
 
loop {
callback([idx...])
 
var p = n-1
Line 9,089 ⟶ 9,345:
}
 
forperm({|*p| say p }, 3)</syntaxhighlight>
 
===Recursive===
<syntaxhighlight 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 9,153 ⟶ 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,334 ⟶ 9,599:
3 2 1
</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|UNIX Shell}}==
Line 9,671 ⟶ 9,893:
===Recursive===
{{trans|Kotlin}}
<syntaxhighlight lang="ecmascriptwren">var permute // recursive
permute = Fn.new { |input|
if (input.count == 1) return [input]
Line 9,707 ⟶ 9,929:
{{libheader|Wren-math}}
Output modified to follow the pattern of the recursive version.
<syntaxhighlight lang="ecmascriptwren">import "./math" for Int
 
var input = [1, 2, 3]
Line 9,749 ⟶ 9,971:
===Library based===
{{libheader|Wren-perm}}
<syntaxhighlight lang="ecmascriptwren">import "./perm" for Perm
 
var a = [1, 2, 3]
Line 9,817 ⟶ 10,039:
esor
</pre>
 
=={{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|zkl}}==
885

edits