Permutations: Difference between revisions
→{{header|langur}}
Langurmonkey (talk | contribs) |
Langurmonkey (talk | contribs) |
||
| (141 intermediate revisions by 52 users not shown) | |||
Line 12:
{{Template:Combinations and permutations}}
<br><br>
=={{header|11l}}==
<syntaxhighlight lang="11l">V a = [1, 2, 3]
L
print(a)
I !a.next_permutation()
L.break</syntaxhighlight>
{{out}}
<pre>
[1, 2, 3]
[1, 3, 2]
[2, 1, 3]
[2, 3, 1]
[3, 1, 2]
[3, 2, 1]
</pre>
=={{header|360 Assembly}}==
{{trans|Liberty BASIC}}
<
PERMUTE CSECT
USING PERMUTE,R15 set base register
Line 75 ⟶ 92:
PG DC CL80' ' buffer
YREGS
END PERMUTE</
{{out}}
<pre style="height:40ex;overflow:scroll">
Line 104 ⟶ 121:
</pre>
=={{header|AArch64 Assembly}}==
{{works with|as|Raspberry Pi 3B version Buster 64 bits}}
<syntaxhighlight lang="aarch64 assembly">
/* ARM assembly AARCH64 Raspberry PI 3B */
/* program permutation64.s */
/*******************************************/
/* Constantes file */
/*******************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeConstantesARM64.inc"
/*********************************/
/* Initialized data */
/*********************************/
.data
sMessResult: .asciz "Value : @\n"
sMessCounter: .asciz "Permutations = @ \n"
szCarriageReturn: .asciz "\n"
.align 4
TableNumber: .quad 1,2,3
.equ NBELEMENTS, (. - TableNumber) / 8
/*********************************/
/* UnInitialized data */
/*********************************/
.bss
sZoneConv: .skip 24
/*********************************/
/* code section */
/*********************************/
.text
.global main
main: //entry of program
ldr x0,qAdrTableNumber //address number table
mov x1,NBELEMENTS //number of élements
mov x10,0 //counter
bl heapIteratif
mov x0,x10 //display counter
ldr x1,qAdrsZoneConv //
bl conversion10S //décimal conversion
ldr x0,qAdrsMessCounter
ldr x1,qAdrsZoneConv //insert conversion
bl strInsertAtCharInc
bl affichageMess //display message
100: //standard end of the program
mov x0,0 //return code
mov x8,EXIT //request to exit program
svc 0 //perform the system call
qAdrszCarriageReturn: .quad szCarriageReturn
qAdrsMessResult: .quad sMessResult
qAdrTableNumber: .quad TableNumber
qAdrsMessCounter: .quad sMessCounter
/******************************************************************/
/* permutation by heap iteratif (wikipedia) */
/******************************************************************/
/* x0 contains the address of table */
/* x1 contains the eléments number */
heapIteratif:
stp x2,lr,[sp,-16]! // save registers
stp x3,x4,[sp,-16]! // save registers
stp x5,x6,[sp,-16]! // save registers
stp x7,fp,[sp,-16]! // save registers
tst x1,1 // odd ?
add x2,x1,1
csel x2,x2,x1,ne // the stack must be a multiple of 16
lsl x7,x2,3 // 8 bytes by count
sub sp,sp,x7
mov fp,sp
mov x3,#0
mov x4,#0 // index
1: // init area counter
str x4,[fp,x3,lsl 3]
add x3,x3,#1
cmp x3,x1
blt 1b
bl displayTable
add x10,x10,#1
mov x3,#0 // index
2:
ldr x4,[fp,x3,lsl 3] // load count [i]
cmp x4,x3 // compare with i
bge 5f
tst x3,#1 // even ?
bne 3f
ldr x5,[x0] // yes load value A[0]
ldr x6,[x0,x3,lsl 3] // and swap with value A[i]
str x6,[x0]
str x5,[x0,x3,lsl 3]
b 4f
3:
ldr x5,[x0,x4,lsl 3] // load value A[count[i]]
ldr x6,[x0,x3,lsl 3] // and swap with value A[i]
str x6,[x0,x4,lsl 3]
str x5,[x0,x3,lsl 3]
4:
bl displayTable
add x10,x10,1
add x4,x4,1 // increment count i
str x4,[fp,x3,lsl 3] // and store on stack
mov x3,0 // raz index
b 2b // and loop
5:
mov x4,0 // raz count [i]
str x4,[fp,x3,lsl 3]
add x3,x3,1 // increment index
cmp x3,x1 // end ?
blt 2b // no -> loop
add sp,sp,x7 // stack alignement
100:
ldp x7,fp,[sp],16 // restaur 2 registers
ldp x5,x6,[sp],16 // restaur 2 registers
ldp x3,x4,[sp],16 // restaur 2 registers
ldp x2,lr,[sp],16 // restaur 2 registers
ret // return to address lr x30
/******************************************************************/
/* Display table elements */
/******************************************************************/
/* x0 contains the address of table */
displayTable:
stp x1,lr,[sp,-16]! // save registers
stp x2,x3,[sp,-16]! // save registers
mov x2,x0 // table address
mov x3,#0
1: // loop display table
ldr x0,[x2,x3,lsl 3]
ldr x1,qAdrsZoneConv
bl conversion10S // décimal conversion
ldr x0,qAdrsMessResult
ldr x1,qAdrsZoneConv // insert conversion
bl strInsertAtCharInc
bl affichageMess // display message
add x3,x3,1
cmp x3,NBELEMENTS - 1
ble 1b
ldr x0,qAdrszCarriageReturn
bl affichageMess
mov x0,x2
100:
ldp x2,x3,[sp],16 // restaur 2 registers
ldp x1,lr,[sp],16 // restaur 2 registers
ret // return to address lr x30
qAdrsZoneConv: .quad sZoneConv
/********************************************************/
/* File Include fonctions */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"
</syntaxhighlight>
<pre>
Value : +1
Value : +2
Value : +3
Value : +2
Value : +1
Value : +3
Value : +3
Value : +1
Value : +2
Value : +1
Value : +3
Value : +2
Value : +2
Value : +3
Value : +1
Value : +3
Value : +2
Value : +1
Permutations = +6
</pre>
=={{header|ABAP}}==
<
lv_number type i,
lt_numbers type table of i.
Line 204 ⟶ 403:
modify iv_set index lv_perm from lv_temp_2.
modify iv_set index lv_len from lv_temp.
endform.</
{{out}}
<pre>
Line 216 ⟶ 415:
3, 2, 1
</pre>
=={{header|Action!}}==
<syntaxhighlight lang="action!">PROC PrintArray(BYTE ARRAY a BYTE len)
BYTE i
FOR i=0 TO len-1
DO
PrintB(a(i))
OD
Print(" ")
RETURN
BYTE FUNC NextPermutation(BYTE ARRAY a BYTE len)
BYTE i,j,k,tmp
i=len-1
WHILE i>0 AND a(i-1)>a(i)
DO
i==-1
OD
j=i
k=len-1
WHILE j<k
DO
tmp=a(j) a(j)=a(k) a(k)=tmp
j==+1 k==-1
OD
IF i=0 THEN
RETURN (0)
FI
j=i
WHILE a(j)<a(i-1)
DO
j==+1
OD
tmp=a(i-1) a(i-1)=a(j) a(j)=tmp
RETURN (1)
PROC Main()
DEFINE len="5"
BYTE ARRAY a(len)
BYTE RMARGIN=$53,oldRMARGIN
BYTE i
oldRMARGIN=RMARGIN
RMARGIN=37 ;change right margin on the screen
FOR i=0 TO len-1
DO
a(i)=i
OD
DO
PrintArray(a,len)
UNTIL NextPermutation(a,len)=0
OD
RMARGIN=oldRMARGIN ;restore right margin on the screen
RETURN</syntaxhighlight>
{{out}}
[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/Permutations.png Screenshot from Atari 8-bit computer]
<pre>
01234 01243 01324 01342 01423 01432
02134 02143 02314 02341 02413 02431
03124 03142 03214 03241 03412 03421
04123 04132 04213 04231 04312 04321
10234 10243 10324 10342 10423 10432
12034 12043 12304 12340 12403 12430
13024 13042 13204 13240 13402 13420
14023 14032 14203 14230 14302 14320
20134 20143 20314 20341 20413 20431
21034 21043 21304 21340 21403 21430
23014 23041 23104 23140 23401 23410
24013 24031 24103 24130 24301 24310
30124 30142 30214 30241 30412 30421
31024 31042 31204 31240 31402 31420
32014 32041 32104 32140 32401 32410
34012 34021 34102 34120 34201 34210
40123 40132 40213 40231 40312 40321
41023 41032 41203 41230 41302 41320
42013 42031 42103 42130 42301 42310
43012 43021 43102 43120 43201 43210
</pre>
Line 224 ⟶ 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:
<
N: positive;
package Generic_Perm is
Line 232 ⟶ 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;</
Here is the implementation of the package:
<
Line 305 ⟶ 590:
end Go_To_Next;
end Generic_Perm;</
===The procedure Print_Perms===
<
procedure Print_Perms is
Line 337 ⟶ 622:
when Constraint_Error
=> TIO.Put_Line ("*** Error: enter one numerical argument n with n >= 1");
end Print_Perms;</
{{out}}
Line 350 ⟶ 635:
=={{header|Aime}}==
<
f1(record r, ...)
{
Line 373 ⟶ 658:
0;
}</
{{Out}}
<pre>aime permutations -a Aaa Bb C
Line 387 ⟶ 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'''<
COMMENT REQUIRED BY "prelude_permutations.a68"
Line 419 ⟶ 704:
);
SKIP</
# -*- coding: utf-8 -*- #
Line 442 ⟶ 727:
# OD #))
)</
<pre>
(1, 22, 333, 44444)
Line 470 ⟶ 755:
</pre>
=={{header|Amazing Hopper}}==
{{trans|AWK}}
<syntaxhighlight lang="amazing hopper">
/* hopper-JAMBO - a flavour of Amazing Hopper! */
#include <jambo.h>
Main
leng=0
Void(lista)
Set("la realidad","escapa","a los sentidos"), Apnd list(lista)
Length(lista), Move to(leng)
Toksep(" ")
Printnl( lista )
Set(1) Gosub(Permutar)
End-Return
Subrutines
Define( Permutar, pos )
If ( Sub(leng, pos) Isgeq(1) )
i=pos
Loop if( Less( i, leng ) )
Plusone(pos), Gosub(Permutar)
Set( pos ), Gosub(Rotate)
Printnl( lista )
++i
Back
Plusone(pos), Gosub(Permutar)
Set( pos ), Gosub(Rotate)
End If
Return
Define ( Rotate, pos )
c=0, [pos] Get(lista), Move to(c)
[ Plusone(pos): leng ] Cget(lista)
[ pos: Minusone(leng) ] Cput(lista)
Set(c), [ leng ] Cput(lista)
Return
</syntaxhighlight>
{{out}}
<pre>
la realidad escapa a los sentidos
la realidad a los sentidos escapa
escapa a los sentidos la realidad
escapa la realidad a los sentidos
a los sentidos la realidad escapa
a los sentidos escapa la realidad
</pre>
=={{header|APL}}==
For Dyalog APL(assumes index origin ⎕IO←1):
<syntaxhighlight lang="apl">
⍝ Builtin version, takes a vector:
⎕CY'dfns'
perms←{↓⍵[pmat ≢⍵]} ⍝ pmat always gives lexicographically ordered permutations.
⍝ Recursive fast implementation, courtesy of dzaima from The APL Orchard:
dpmat←{1=⍵:,⊂,0 ⋄ (⊃,/)¨(⍳⍵)⌽¨⊂(⊂(!⍵-1)⍴⍵-1),⍨∇⍵-1}
perms2←{↓⍵[1+⍉↑dpmat ≢⍵]}
</syntaxhighlight>
<pre>
perms 'cat'
┌───┬───┬───┬───┬───┬───┐
│cat│cta│act│atc│tca│tac│
└───┴───┴───┴───┴───┴───┘
perms2 'cat'
┌───┬───┬───┬───┬───┬───┐
│cta│atc│tac│tca│act│cat│
└───┴───┴───┴───┴───┴───┘
</pre>
=={{header|AppleScript}}==
Line 477 ⟶ 833:
Recursively, in terms of concatMap and delete:
<
-- permutations :: [a] -> [[a]]
Line 505 ⟶ 861:
on run
Line 513 ⟶ 869:
-- concatMap :: (a -> [b]) -> [a] -> [b]
Line 526 ⟶ 882:
return lst
end concatMap
-- delete :: a -> [a] -> [a]
Line 553 ⟶ 910:
end if
end mReturn
-- uncons :: [a] -> Maybe (a, [a])
Line 561 ⟶ 919:
missing value
end if
end uncons</
{{Out}}
<pre>{{"aardvarks", "eat", "ants"}, {"aardvarks", "ants", "eat"},
Line 569 ⟶ 927:
{{trans|Pseudocode}}
(Fast recursive Heap's algorithm)
<
--> Heaps's algorithm (Permutation by interchanging pairs)
if n = 1 then
tell (a reference to
-- or: copy aList as text (for concatenated results)
else
Line 582 ⟶ 940:
tell aList to set [item 1, item n] to [item n, item 1] -- swaps items 1 and n of aList
end if
end repeat
end if
return (a reference to
end DoPermutations
--> Example 1 (list of words)
set [SourceList,
DoPermutations(SourceList, SourceList's length)
--> result (value of
{{"Good", "Johnny", "Be"}, {"Johnny", "Good", "Be"}, {"Be", "Good", "Johnny"}, ¬
{"Good", "Be", "Johnny"}, {"Johnny", "Be", "Good"}, {"Be", "Johnny", "Good"}}
--> Example 2 (characters with concatenated results)
set [SourceList,
DoPermutations(SourceList, SourceList's length)
--> result (value of
{"XYZ", "YXZ", "ZXY", "XZY", "YZX", "ZYX"}
Line 611 ⟶ 968:
DoPermutations(SourceList, SourceList's length)
--> result (value of Permlist)
{"123", "213", "312", "132", "231", "321"}</
===Non-recursive===
As a right fold (which turns out to be significantly faster than recurse + delete):
<syntaxhighlight lang="applescript">----------------------- PERMUTATIONS -----------------------
-- permutations :: [a] -> [[a]]
on permutations(xs)
script go
Line 640 ⟶ 999:
--
on run
Line 649 ⟶ 1,008:
--
-- concatMap :: (a -> [b]) -> [a] -> [b]
Line 662 ⟶ 1,021:
return acc
end concatMap
-- drop :: Int -> [a] -> [a]
Line 671 ⟶ 1,031:
end if
end drop
-- enumFromTo :: Int -> Int -> [Int]
Line 684 ⟶ 1,045:
end if
end enumFromTo
-- foldr :: (a -> b -> b) -> b -> [a] -> b
Line 696 ⟶ 1,058:
end tell
end foldr
-- Lift 2nd class handler function into 1st class script wrapper
Line 708 ⟶ 1,071:
end if
end mReturn
-- map :: (a -> b) -> [a] -> [b]
Line 720 ⟶ 1,084:
end tell
end map
-- min :: Ord a => a -> a -> a
Line 729 ⟶ 1,094:
end if
end min
-- take :: Int -> [a] -> [a]
Line 738 ⟶ 1,104:
{}
end if
end take</
{{Out}}
<pre>{{1, 2, 3}, {2, 1, 3}, {2, 3, 1}, {1, 3, 2}, {3, 1, 2}, {3, 2, 1}}</pre>
----
===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 workList : missing value --(Set to a copy of theList below.)
property r : (count theList)
property rMinus1 : r - 1
property rMinus2 : r - 2
property rMinus3 : r - 3
-- Output list and traversal index.
property output : {}
property p : 1
-- Recursive handler.
on prmt(l)
-- Is the range length covered by this recursion level even?
set rangeLenEven to ((r - l) mod 2 = 1)
-- Tail call elimination repeat. Gives way to hard-coding for the lowest three levels.
repeat with l from l to rMinus3
-- Recursively permute items (l + 1) thru r of the work list.
set lPlus1 to l + 1
prmt(lPlus1)
-- And again after swaps of item l with each of the items to its right
-- (if the range l to r is even) or with the rightmost item r - l times
-- (if the range length is odd). The "recursion" after the last swap will
-- instead be the next iteration of this tail call elimination repeat.
if (rangeLenEven) then
repeat with swapIdx from r to (lPlus1 + 1) by -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(lPlus1)
end repeat
set swapIdx to lPlus1
else
repeat (r - lPlus1) times
tell my workList's item l
set my workList's item l to my workList's item r
set my workList's item r to it
end tell
prmt(lPlus1)
end repeat
set swapIdx to r
end if
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
set rangeLenEven to (not rangeLenEven)
end repeat
-- Store a copy of the work list's current state.
set my output's item p to my workList's items
-- Then five more with the three rightmost items permuted.
set v1 to my workList's item rMinus2
set v2 to my workList's item rMinus1
set v3 to my workList's end
set my workList's item rMinus1 to v3
set my workList's item r to v2
set my output's item (p + 1) to my workList's items
set my workList's item rMinus2 to v2
set my workList's item r to v1
set my output's item (p + 2) to my workList's items
set my workList's item rMinus1 to v1
set my workList's item r to v3
set my output's item (p + 3) to my workList's items
set my workList's item rMinus2 to v3
set my workList's item r to v2
set my output's item (p + 4) to my workList's items
set my workList's item rMinus1 to v2
set my workList's item r to v1
set my output's item (p + 5) to my workList's items
set p to p + 6
end prmt
end script
if (o's r < 3) then
-- Fewer than three items in the input list.
copy theList to o's output's beginning
if (o's r is 2) then set o's output's end to theList's reverse
else
-- Otherwise prepare a list to hold (factorial of input list length) permutations …
copy theList to o's workList
set factorial to 2
repeat with i from 3 to o's r
set factorial to factorial * i
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 output
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, 3, 4}, {1, 2, 4, 3}, {1, 3, 4, 2}, {1, 3, 2, 4}, {1, 4, 2, 3}, {1, 4, 3, 2}, {2, 4, 3, 1}, {2, 4, 1, 3}, {2, 3, 1, 4}, {2, 3, 4, 1}, {2, 1, 4, 3}, {2, 1, 3, 4}, {3, 1, 2, 4}, {3, 1, 4, 2}, {3, 2, 4, 1}, {3, 2, 1, 4}, {3, 4, 1, 2}, {3, 4, 2, 1}, {4, 3, 2, 1}, {4, 3, 1, 2}, {4, 2, 1, 3}, {4, 2, 3, 1}, {4, 1, 3, 2}, {4, 1, 2, 3}}</syntaxhighlight>
=={{header|ARM Assembly}}==
{{works with|as|Raspberry Pi}}
<syntaxhighlight lang="arm assembly">
/* ARM assembly Raspberry PI */
/* program permutation.s */
/* REMARK 1 : this program use routines in a include file
see task Include a file language arm assembly
for the routine affichageMess conversion10
see at end of this program the instruction include */
/* for constantes see task include a file in arm assembly */
/************************************/
/* Constantes */
/************************************/
.include "../constantes.inc"
/*********************************/
/* Initialized data */
/*********************************/
.data
sMessResult: .asciz "Value : @ \n"
sMessCounter: .asciz "Permutations = @ \n"
szCarriageReturn: .asciz "\n"
.align 4
TableNumber: .int 1,2,3
.equ NBELEMENTS, (. - TableNumber) / 4
/*********************************/
/* UnInitialized data */
/*********************************/
.bss
sZoneConv: .skip 24
/*********************************/
/* code section */
/*********************************/
.text
.global main
main: @ entry of program
ldr r0,iAdrTableNumber @ address number table
mov r1,#NBELEMENTS @ number of élements
mov r10,#0 @ counter
bl heapIteratif
mov r0,r10 @ display counter
ldr r1,iAdrsZoneConv @
bl conversion10S @ décimal conversion
ldr r0,iAdrsMessCounter
ldr r1,iAdrsZoneConv @ insert conversion
bl strInsertAtCharInc
bl affichageMess @ display message
100: @ standard end of the program
mov r0, #0 @ return code
mov r7, #EXIT @ request to exit program
svc #0 @ perform the system call
iAdrszCarriageReturn: .int szCarriageReturn
iAdrsMessResult: .int sMessResult
iAdrTableNumber: .int TableNumber
iAdrsMessCounter: .int sMessCounter
/******************************************************************/
/* permutation by heap iteratif (wikipedia) */
/******************************************************************/
/* r0 contains the address of table */
/* r1 contains the eléments number */
heapIteratif:
push {r3-r9,lr} @ save registers
lsl r9,r1,#2 @ four bytes by count
sub sp,sp,r9
mov fp,sp
mov r3,#0
mov r4,#0 @ index
1: @ init area counter
str r4,[fp,r3,lsl #2]
add r3,r3,#1
cmp r3,r1
blt 1b
bl displayTable
add r10,r10,#1
mov r3,#0 @ index
2:
ldr r4,[fp,r3,lsl #2] @ load count [i]
cmp r4,r3 @ compare with i
bge 5f
tst r3,#1 @ even ?
bne 3f
ldr r5,[r0] @ yes load value A[0]
ldr r6,[r0,r3,lsl #2] @ and swap with value A[i]
str r6,[r0]
str r5,[r0,r3,lsl #2]
b 4f
3:
ldr r5,[r0,r4,lsl #2] @ load value A[count[i]]
ldr r6,[r0,r3,lsl #2] @ and swap with value A[i]
str r6,[r0,r4,lsl #2]
str r5,[r0,r3,lsl #2]
4:
bl displayTable
add r10,r10,#1
add r4,r4,#1 @ increment count i
str r4,[fp,r3,lsl #2] @ and store on stack
mov r3,#0 @ raz index
b 2b @ and loop
5:
mov r4,#0 @ raz count [i]
str r4,[fp,r3,lsl #2]
add r3,r3,#1 @ increment index
cmp r3,r1 @ end ?
blt 2b @ no -> loop
add sp,sp,r9 @ stack alignement
100:
pop {r3-r9,lr}
bx lr @ return
/******************************************************************/
/* Display table elements */
/******************************************************************/
/* r0 contains the address of table */
displayTable:
push {r0-r3,lr} @ save registers
mov r2,r0 @ table address
mov r3,#0
1: @ loop display table
ldr r0,[r2,r3,lsl #2]
ldr r1,iAdrsZoneConv @
bl conversion10S @ décimal conversion
ldr r0,iAdrsMessResult
ldr r1,iAdrsZoneConv @ insert conversion
bl strInsertAtCharInc
bl affichageMess @ display message
add r3,#1
cmp r3,#NBELEMENTS - 1
ble 1b
ldr r0,iAdrszCarriageReturn
bl affichageMess
mov r0,r2
100:
pop {r0-r3,lr}
bx lr
iAdrsZoneConv: .int sZoneConv
/***************************************************/
/* ROUTINES INCLUDE */
/***************************************************/
.include "../affichage.inc"
</syntaxhighlight>
<pre>
Value : +1
Value : +2
Value : +3
Value : +2
Value : +1
Value : +3
Value : +3
Value : +1
Value : +2
Value : +1
Value : +3
Value : +2
Value : +2
Value : +3
Value : +1
Value : +3
Value : +2
Value : +1
Permutations = +6
</pre>
=={{header|Arturo}}==
<syntaxhighlight lang="rebol">print permutate [1 2 3]</syntaxhighlight>
{{out}}
<pre>[1 2 3] [1 3 2] [2 1 3] [2 3 1] [3 1 2] [3 2 1]</pre>
=={{header|AutoHotkey}}==
from the forum topic http://www.autohotkey.com/forum/viewtopic.php?t=77959
<
StringCaseSense On
Line 793 ⟶ 1,459:
o := A_LoopField o
return o
}</
{{out}}
<pre style="height:40ex;overflow:scroll">Hello
Line 858 ⟶ 1,524:
===Alternate Version===
Alternate version to produce numerical permutations of combinations.
<
;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 890 ⟶ 1,556:
. P(n,k-1,opt,delim,str . A_LoopField . delim)
Return s
}</
{{out}}
<syntaxhighlight lang
<pre style="height:40ex;overflow:scroll">---------------------------
permute.ahk
Line 905 ⟶ 1,571:
OK
---------------------------</pre>
<
<pre style="height:40ex;overflow:scroll">---------------------------
permute.ahk
Line 954 ⟶ 1,620:
OK
---------------------------</pre>
<
<pre style="height:40ex;overflow:scroll">---------------------------
permute.ahk
Line 982 ⟶ 1,648:
OK
---------------------------</pre>
<
<pre style="height:40ex;overflow:scroll">---------------------------
permute.ahk
Line 1,049 ⟶ 1,715:
OK
---------------------------</pre>
=={{header|AWK}}==
<syntaxhighlight lang="awk">
# syntax: GAWK -f PERMUTATIONS.AWK [-v sep=x] [word]
#
# examples:
# REM all permutations on one line
# GAWK -f PERMUTATIONS.AWK
#
# REM all permutations on a separate line
# GAWK -f PERMUTATIONS.AWK -v sep="\n"
#
# REM use a different word
# GAWK -f PERMUTATIONS.AWK Gwen
#
# REM command used for RosettaCode output
# GAWK -f PERMUTATIONS.AWK -v sep="\n" Gwen
#
BEGIN {
sep = (sep == "") ? " " : substr(sep,1,1)
str = (ARGC == 1) ? "abc" : ARGV[1]
printf("%s%s",str,sep)
leng = length(str)
for (i=1; i<=leng; i++) {
arr[i-1] = substr(str,i,1)
}
ana_permute(0)
exit(0)
}
function ana_permute(pos, i,j,str) {
if (leng - pos < 2) { return }
for (i=pos; i<leng-1; i++) {
ana_permute(pos+1)
ana_rotate(pos)
for (j=0; j<=leng-1; j++) {
printf("%s",arr[j])
}
printf(sep)
}
ana_permute(pos+1)
ana_rotate(pos)
}
function ana_rotate(pos, c,i) {
c = arr[pos]
for (i=pos; i<leng-1; i++) {
arr[i] = arr[i+1]
}
arr[leng-1] = c
}
</syntaxhighlight>
<p>sample command:</p>
GAWK -f PERMUTATIONS.AWK Gwen
{{out}}
<pre>
Gwen Gwne Genw Gewn Gnwe Gnew wenG weGn wnGe wneG wGen wGne enGw enwG eGwn eGnw ewnG ewGn nGwe nGew nweG nwGe neGw newG
</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
n = 4 : cont = 0
dim a(n)
dim c(n)
for j = 1 to n
a[j] = j
next j
do
for i = 1 to n
print a[i];
next
print " ";
i = n
cont += 1
if cont = 12 then
print
cont = 0
else
print " ";
end if
do
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 += 1
k -= 1
end while
if i > 0 then
j = i + 1
while a[j] < a[i]
j += 1
end while
tmp = a[j] : a[j] = a[i] : a[i] = tmp
end if
until i = 0
end</syntaxhighlight>
==={{header|BBC BASIC}}===
The procedure PROC_NextPermutation() will give the next lexicographic permutation of an integer array.
<
List%() = 1, 2, 3, 4
FOR perm% = 1 TO 24
Line 1,153 ⟶ 1,886:
last -= 1
ENDWHILE
ENDPROC</
'''Output:'''
<pre>
Line 1,180 ⟶ 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}}==
<
= prefix List result original A Z
. !arg:(?.)
Line 1,195 ⟶ 2,625:
& !result
)
& out$(perm$(.a 2 "]" u+z);</
Output:
<pre> (a 2 ] u+z.)
Line 1,225 ⟶ 2,655:
===version 1===
Non-recursive algorithm to generate all permutations. It prints objects in lexicographical order.
<syntaxhighlight lang="c">
#include <stdio.h>
int main (int argc, char *argv[]) {
Line 1,280 ⟶ 2,710:
}
}
</syntaxhighlight>
===version 2===
Non-recursive algorithm to generate all permutations. It prints them from right to left.
<syntaxhighlight lang="c">
#include <stdio.h>
Line 1,310 ⟶ 2,740:
}
</syntaxhighlight>
===version 3===
See [[wp:Permutation#Systematic_generation_of_all_permutations|lexicographic generation]] of permutations.
<
#include <stdlib.h>
Line 1,414 ⟶ 2,844:
return 0;
}
</syntaxhighlight>
===version 4===
See [[wp:Permutation#Systematic_generation_of_all_permutations|lexicographic generation]] of permutations.
<
#include <stdlib.h>
Line 1,518 ⟶ 2,948:
return 0;
}
</syntaxhighlight>
=={{header|C sharp|C#}}==
Recursive Linq
{{works with|C sharp|C#|7}}
<syntaxhighlight lang="csharp">public static class Extension
{
public static IEnumerable<IEnumerable<T>> Permutations<T>(this IEnumerable<T> values) where T : IComparable<T>
{
if (values.Count() == 1)
return new[] { values };
return values.SelectMany(v => Permutations(values.Where(x => x.CompareTo(v) != 0)), (v, p) => p.Prepend(v));
}
}</syntaxhighlight>
Usage
<syntaxhighlight lang="sharp">Enumerable.Range(0,5).Permutations()</syntaxhighlight>
A recursive Iterator. Runs under C#2 (VS2005), i.e. no `var`, no lambdas,...
<syntaxhighlight lang="csharp">public class Permutations<T>
{
public static System.Collections.Generic.IEnumerable<T[]> AllFor(T[] array)
{
if (array == null || array.Length == 0)
{
yield return new T[0];
}
else
{
for (int pick = 0; pick < array.Length; ++pick)
{
T item = array[pick];
int i = -1;
T[] rest = System.Array.FindAll<T>(
array, delegate(T p) { return ++i != pick; }
);
foreach (T[] restPermuted in AllFor(rest))
{
i = -1;
yield return System.Array.ConvertAll<T, T>(
array,
delegate(T p) {
return ++i == 0 ? item : restPermuted[i - 1];
}
);
}
}
}
}
}</syntaxhighlight>
Usage:
<syntaxhighlight lang="csharp">namespace Permutations_On_RosettaCode
{
class Program
{
static void Main(string[] args)
{
string[] list = "a b c d".Split();
foreach (string[] permutation in Permutations<string>.AllFor(list))
{
System.Console.WriteLine(string.Join(" ", permutation));
}
}
}
}</syntaxhighlight>
Recursive version
<syntaxhighlight lang="csharp">using System;
class Permutations
{
static int n = 4;
static int [] buf = new int [n];
static bool [] used = new bool [n];
static void Main()
{
for (int i = 0; i < n; i++) used [i] = false;
rec(0);
}
static void rec(int ind)
{
for (int i = 0; i < n; i++)
{
if (!used [i])
{
used [i] = true;
buf [ind] = i;
if (ind + 1 < n) rec(ind + 1);
else Console.WriteLine(string.Join(",", buf));
used [i] = false;
}
}
}
}</syntaxhighlight>
Alternate recursive version
<syntaxhighlight lang="csharp">
using System;
class Permutations
{
static int n = 4;
static int [] buf = new int [n];
static int [] next = new int [n+1];
static void Main()
{
for (int i = 0; i < n; i++) next [i] = i + 1;
next[n] = 0;
rec(0);
}
static void rec(int ind)
{
for (int i = n; next[i] != n; i = next[i])
{
buf [ind] = next[i];
next[i]=next[next[i]];
if (ind < n - 1) rec(ind + 1);
else Console.WriteLine(string.Join(",", buf));
next[i] = buf [ind];
}
}
}
</syntaxhighlight>
[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>.
<
#include <string>
#include <vector>
Line 1,561 ⟶ 3,159:
return 0;
}</
{{out}}
<pre>
Line 1,636 ⟶ 3,234:
9999,1234,4321,1234
9999,4321,1234,1234</pre>
=={{header|Clojure}}==
Line 1,764 ⟶ 3,239:
In an REPL:
<
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))</
===Explicit===
Replacing the call to the combinatorics library function by its real implementation.
<
(defn- iter-perm [v]
(let [len (count v),
Line 1,809 ⟶ 3,284:
(println (permutations [1 2 3]))
</syntaxhighlight>
=={{header|CoffeeScript}}==
<
# removed from it.
arrayExcept = (arr, idx) ->
Line 1,829 ⟶ 3,304:
# Flatten the array before returning it.
[].concat permutations...</
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}}
<
1,2,3
1,3,2
Line 1,838 ⟶ 3,313:
2,3,1
3,1,2
3,2,1</
=={{header|Common Lisp}}==
<
(if list
(mapcan #'(lambda (x)
Line 1,849 ⟶ 3,324:
'(()))) ; else
(print (permute '(A B Z)))</
{{out}}
<pre>((A B Z) (A Z B) (B A Z) (B Z A) (Z A B) (Z B A))</pre>
Lexicographic next permutation:
<
(declare (type (simple-array * (*)) vec))
(macrolet ((el (i) `(aref vec ,i))
Line 1,870 ⟶ 3,345:
;;; test code
(loop for a = "1234" then (next-perm a #'char<) while a do
(write-line a))</
Recursive implementation of Heap's algorithm:
<syntaxhighlight lang="lisp">(defun heap-permutations (seq)
(let ((permutations nil))
(labels ((permute (seq k)
(if (= k 1)
(push seq permutations)
(progn
(permute seq (1- k))
(loop for i from 0 below (1- k) do
(if (evenp k)
(rotatef (elt seq i) (elt seq (1- k)))
(rotatef (elt seq 0) (elt seq (1- k))))
(permute seq (1- k)))))))
(permute seq (length seq))
permutations)))</syntaxhighlight>
=={{header|Crystal}}==
<
{{out}}
<pre>[[1, 2, 3], [1, 3, 2], [2, 1, 3], [2, 3, 1], [3, 1, 2], [3, 2, 1]]</pre>
Line 1,879 ⟶ 3,369:
=={{header|Curry}}==
<
insert :: a -> [a] -> [a]
insert x xs = x : xs
Line 1,887 ⟶ 3,377:
permutation [] = []
permutation (x:xs) = insert x $ permutation xs
</syntaxhighlight>
=={{header|D}}==
===Simple Eager version===
Compile with -version=permutations1_main to see the output.
<
T[][] result;
Line 1,912 ⟶ 3,402:
writefln("%(%s\n%)", [1, 2, 3].permutations);
}
}</
{{out}}
<pre>[1, 2, 3]
Line 1,923 ⟶ 3,413:
===Fast Lazy Version===
Compiled with <code>-version=permutations2_main</code> produces its output.
<
struct Permutations(bool doCopy=true, T) if (isMutable!T) {
Line 2,010 ⟶ 3,500:
[B(1), B(2), B(3)].permutations!false.writeln;
}
}</
===Standard Version===
<
import std.stdio, std.algorithm;
Line 2,020 ⟶ 3,510:
items.writeln;
while (items.nextPermutation);
}</
=={{header|Delphi}}==
<
{$APPTYPE CONSOLE}
Line 2,080 ⟶ 3,570:
if Length(S) > 0 then Writeln(S);
Readln;
end.</
{{out}}
<pre>
Line 2,087 ⟶ 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>
=={{header|EDSAC order code}}==
Uses two subroutines which respectively
(1) Generate the first permutation in lexicographic order;
(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".
<syntaxhighlight lang="edsac">
[Permutations task for Rosetta Code.]
[EDSAC program, Initial Orders 2.]
T51K P200F [G parameter: start address of subroutines]
T47K P100F [M parameter: start address of main routine]
[====================== G parameter: Subroutines =====================]
E25K TG GK
[Constants used in the subroutines]
[0] AF [add to address to make A order for that address]
[1] SF [add to address to make S order for that address]
[2] UF [(1) add to address to make U order for that address]
[(2) subtract from S order to make T order, same address]
[3] OF [add to A order to make T order, same address]
[-----------------------------------------------------------
Subroutine to initialize an array of n short (17-bit) words
to 0, 1, 2, ..., n-1 (in the address field).
Parameters: 4F = address of array; 5F = n = length of array.
Workspace: 0F, 1F.]
[4] A3F [plant return link as usual]
T19@
A4F [address of array]
A2@ [make U order for that address]
T1F [store U order in 1F]
A5F [load n = number of elements (in address field)]
S2F [make n-1]
[Start of loop; works backwards, n-1 to 0]
[11] UF [store array element in 0F]
A1F [make order to store element in array]
T15@ [plant that order in code]
AF [pick up element fron 0F]
[15] UF [(planted) store element in array]
S2F [dec to next element]
E11@ [loop if still >= 0]
TF [clear acc. before return]
[19] ZF [overwritten by jump back to caller]
[-------------------------------------------------------------------
Subroutine to get next permutation in lexicographic order.
Uses same 4-step algorithm as Wikipedia article "Permutations",
but notation in comments differs from that in Wikipedia.
Parameters: 4F = address of array; 5F = n = length of array.
0F is returned as 0 for success, < 0 if passed-in
permutation is the last.
Workspace: 0F, 1F.]
[20] A3F [plant return link as usual]
T103@
[Step 1: Find the largest index k such that a{k} > a{k-1}.
If no such index exists, the passed-in permutation is the last.]
A4F [load address of a{0}]
A@ [make A order for a{0}]
U1F [store as test for end of loop]
A5F [make A order for a{n}]
U96@ [plant in code below]
S2F [make A order for a{n-1}]
T43@ [plant in code below]
A4F [load address of a{0}]
A5F [make address of a{n}]
A1@ [make S order for a{n}]
T44@ [plant in code below]
[Start of loop for comparing a{k} with a{k-1}]
[33] TF [clear acc]
A43@ [load A order for a{k}]
S2F [make A order for a{k-1}]
S1F [tested all yet?]
G102@ [if yes, jump to failed (no more permutations)]
A1F [restore accumulator after test]
T43@ [plant updated A order]
A44@ [dec address in S order]
S2F
T44@
[43] SF [(planted) load a{k-1}]
[44] AF [(planted) subtract a{k}]
E33@ [loop back if a{k-1} > a{k}]
[Step 2: Find the largest index j >= k such that a{j} > a{k-1}.
Such an index j exists, because j = k is an instance.]
TF [clear acc]
A4F [load address of a{0}]
A5F [make address of a{n}]
A1@ [make S order for a{n}]
T1F [save as test for end of loop]
A44@ [load S order for a{k}]
T64@ [plant in code below]
A43@ [load A order for a{k-1}]
T63@ [plant in code below]
[Start of loop]
[55] TF [clear acc]
A64@ [load S order for a{j} (initially j = k)]
U75@ [plant in code below]
A2F [inc address (in effect inc j)]
S1F [test for end of array]
E66@ [jump out if so]
A1F [restore acc after test]
T64@ [update S order]
[63] AF [(planted) load a{k-1}]
[64] SF [(planted) subtract a{j}]
G55@ [loop back if a{j} still > a{k-1}]
[66]
[Step 3: Swap a{k-1} and a{j}]
TF [clear acc]
A63@ [load A order for a{k-1}]
U77@ [plant in code below, 2 places]
U94@
A3@ [make T order for a{k-1}]
T80@ [plant in code below]
A75@ [load S order for a{j}]
S2@ [make T order for a{j}]
T78@ [plant in code below]
[75] SF [(planted) load -a{j}]
TF [park -a{j} in 0F]
[77] AF [(planted) load a{k-1}]
[78] TF [(planted) store a{j}]
SF [load a{j} by subtracting -a{j}]
[80] TF [(planted) store in a{k-1}]
[Step 4: Now a{k}, ..., a{n-1} are in decreasing order.
Change to increasing order by repeated swapping.]
[81] A96@ [counting down from a{n} (exclusive end of array)]
S2F [make A order for a{n-1}]
U96@ [plant in code]
A3@ [make T order for a{n-1}]
T99@ [plant]
A94@ [counting up from a{k-1} (exclusive)]
A2F [make A order for a{k}]
U94@ [plant]
A3@ [make T order for a{k}]
U97@ [plant]
S99@ [swapped all yet?]
E101@ [if yes, jump to exit from subroutine]
[Swapping two array elements, initially a{k} and a{n-1}]
TF [clear acc]
[94] AF [(planted) load 1st element]
TF [park in 0F]
[96] AF [(planted) load 2nd element]
[97] TF [(planted) copy to 1st element]
AF [load old 1st element]
[99] TF [(planted) copy to 2nd element]
E81@ [always loop back]
[101] TF [done, return 0 in location 0F]
[102] TF [return status to caller in 0F; also clears acc]
[103] ZF [(planted) jump back to caller]
[==================== M parameter: Main routine ==================]
[Prints all 120 permutations of the letters in 'EDSAC'.]
E25K TM GK
[Constants used in the main routine]
[0] P900F [address of permutation array]
[1] P5F [number of elements in permutation (in address field)]
[Array of letters in 'EDSAC', in alphabetical order]
[2] AF CF DF EF SF
[7] O2@ [add to index to make O order for letter in array]
[8] P12F [permutations per printed line (in address field)]
[9] AF [add to address to make A order for that address]
[Teleprinter characters]
[10] K2048F [set letters mode]
[11] !F [space]
[12] @F [carriage return]
[13] &F [line feed]
[14] K4096F [null]
[Entry point, with acc = 0.]
[15] O10@ [set teleprinter to letters]
S8@ [intialize -ve count of permutations per line]
T7F [keep count in 7F]
A@ [pass address of permutation array in 4F]
T4F
A1@ [pass number of elements in 5F]
T5F
[22] A22@ [call subroutine to initialize permutation array]
G4G
[Loop: print current permutation, then get next (if any)]
[24] A4F [address]
A9@ [make A order]
T29@ [plant in code]
S5F [initialize -ve count of array elements]
[28] T6F [keep count in 6F]
[29] AF [(planted) load permutation element]
A7@ [make order to print letter from table]
T32@ [plant in code]
[32] OF [(planted) print letter from table]
A29@ [inc address in permutation array]
A2F
T29@
A6F [inc -ve count of array elements]
A2F
G28@ [loop till count becomes 0]
A7F [inc -ve count of perms per line]
A2F
E44@ [jump if end of line]
O11@ [else print a space]
G47@ [join common code]
[44] O12@ [print CR]
O13@ [print LF]
S8@
[47] T7F [update -ve count of permutations in line]
[48] A48@ [call subroutine for next permutation (if any)]
G20G
AF [test 0F: got a new permutation?]
E24@ [if so, loop to print it]
O14@ [no more, output null to flush teleprinter buffer]
ZF [halt program]
E15Z [define entry point]
PF [enter with acc = 0]
[end]
</syntaxhighlight>
{{out}}
<pre>
ACDES ACDSE ACEDS ACESD ACSDE ACSED ADCES ADCSE ADECS ADESC ADSCE ADSEC
AECDS AECSD AEDCS AEDSC AESCD AESDC ASCDE ASCED ASDCE ASDEC ASECD ASEDC
CADES CADSE CAEDS CAESD CASDE CASED CDAES CDASE CDEAS CDESA CDSAE CDSEA
CEADS CEASD CEDAS CEDSA CESAD CESDA CSADE CSAED CSDAE CSDEA CSEAD CSEDA
DACES DACSE DAECS DAESC DASCE DASEC DCAES DCASE DCEAS DCESA DCSAE DCSEA
DEACS DEASC DECAS DECSA DESAC DESCA DSACE DSAEC DSCAE DSCEA DSEAC DSECA
EACDS EACSD EADCS EADSC EASCD EASDC ECADS ECASD ECDAS ECDSA ECSAD ECSDA
EDACS EDASC EDCAS EDCSA EDSAC EDSCA ESACD ESADC ESCAD ESCDA ESDAC ESDCA
SACDE SACED SADCE SADEC SAECD SAEDC SCADE SCAED SCDAE SCDEA SCEAD SCEDA
SDACE SDAEC SDCAE SDCEA SDEAC SDECA SEACD SEADC SECAD SECDA SEDAC SEDCA
</pre>
=={{header|Eiffel}}==
<syntaxhighlight lang="eiffel">
class
APPLICATION
Line 2,139 ⟶ 3,914:
end
</syntaxhighlight>
{{out}}
<pre>
Line 2,152 ⟶ 3,927:
=={{header|Elixir}}==
{{trans|Erlang}}
<
def permute([]), do: [[]]
def permute(list) do
Line 2,159 ⟶ 3,934:
end
IO.inspect RC.permute([1, 2, 3])</
{{out}}
Line 2,168 ⟶ 3,943:
=={{header|Erlang}}==
Shortest form:
<
-export([permute/1]).
permute([]) -> [[]];
permute(L) -> [[X|Y] || X<-L, Y<-permute(L--[X])].</
Y-combinator (for shell):
<
More efficient zipper implementation:
<
-export([permute/1]).
Line 2,193 ⟶ 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]).</
Demonstration (escript):
<
{{out}}
<pre>[[1,2,3],[1,3,2],[2,1,3],[2,3,1],[3,1,2],[3,2,1]]</pre>
Line 2,201 ⟶ 3,976:
=={{header|Euphoria}}==
{{trans|PureBasic}}
<
object x
while first < last do
Line 2,248 ⟶ 4,023:
end if
puts(1, s & '\t')
end while</
{{out}}
<pre>abcd abdc acbd acdb adbc adcb bacd badc bcad bcda
Line 2,255 ⟶ 4,030:
=={{header|F Sharp|F#}}==
<
let rec insert left x right = seq {
match right with
Line 2,276 ⟶ 4,051:
|> Seq.iter (fun x -> printf "%A\n" x)
0
</syntaxhighlight>
<pre>
Line 2,289 ⟶ 4,064:
Translation of Haskell "insertion-based approach" (last version)
<
let permutations xs =
let rec insert x = function
Line 2,295 ⟶ 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>
=={{header|Factor}}==
Line 2,301 ⟶ 4,076:
=={{header|Fortran}}==
<
implicit none
Line 2,333 ⟶ 4,108:
end subroutine generate
end program permutations</
{{out}}
<pre> 1 2 3
Line 2,347 ⟶ 4,122:
The values need to be "swapped back" after the recursive call.
<
implicit none
integer :: n, i
Line 2,373 ⟶ 4,148:
end if
end subroutine
end program</
Line 2,381 ⟶ 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.
<
implicit none
Line 2,741 ⟶ 4,516:
!=====
end program</
An example of performance:
Line 2,796 ⟶ 4,571:
Here is an alternate, iterative version in Fortran 77.
{{trans|Ada}}
<
integer n,i,a
logical nextp
Line 2,836 ⟶ 4,611:
a(j)=t
nextp=.true.
end</
=== Ratfor 77 ===
See [[#RATFOR|RATFOR]].
=={{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.
<syntaxhighlight lang="frink">a = [1,2,3,4]
println[formatTable[a.lexicographicPermute[]]]</syntaxhighlight>
{{out}}
<pre>1 2 3 4
1 2 4 3
1 3 2
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|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 2,898 ⟶ 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.
<
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 ] ]</
GAP has also built-in functions to get permutations
<
Arrangements([1 .. 4], 4);
# All permutations of 1 .. 4
PermutationsList([1 .. 4]);</
Here is an implementation using a function to compute next permutation in lexicographic order:
<
local i, j, k, n, t;
n := Length(a);
Line 2,953 ⟶ 4,750:
[ [ 1, 2, 3 ], [ 1, 3, 2 ],
[ 2, 1, 3 ], [ 2, 3, 1 ],
[ 3, 1, 2 ], [ 3, 2, 1 ] ]</
=={{header|Glee}}==
<
$$ #s monadic: number of elements in s
$$ ,, monadic: expose with space-lf separators
Line 2,963 ⟶ 4,759:
'Hello' 123 7.9 '•'=>s;
s[s# !! (s#)],,</
Result:
<
Hello 123 • 7.9
Hello 7.9 123 •
Line 2,989 ⟶ 4,785:
• 123 7.9 Hello
• 7.9 Hello 123
• 7.9 123 Hello</
=={{header|GNU make}}==
Recursive on unique elements
<syntaxhighlight lang="make">
#delimiter should not occur inside elements
delimiter=;
#convert list to delimiter separated string
implode=$(subst $() $(),$(delimiter),$(strip $1))
#convert delimiter separated string to list
explode=$(strip $(subst $(delimiter), ,$1))
#enumerate all permutations and subpermutations
permutations0=$(if $1,$(foreach x,$1,$x $(addprefix $x$(delimiter),$(call permutations0,$(filter-out $x,$1)))),)
#remove subpermutations from permutations0 output
permutations=$(strip $(foreach x,$(call permutations0,$1),$(if $(filter $(words $1),$(words $(call explode,$x))),$(call implode,$(call explode,$x)),)))
delimiter_separated_output=$(call permutations,a b c d)
$(info $(delimiter_separated_output))
</syntaxhighlight>
{{out}}
<pre>a;b;c;d a;b;d;c a;c;b;d a;c;d;b a;d;b;c a;d;c;b b;a;c;d b;a;d;c b;c;a;d b;c;d;a b;d;a;c b;d;c;a c;a;b;d c;a;d;b c;b;a;d c;b;d;a c;d;a;b c;d;b;a d;a;b;c d;a;c;b d;b;a;c d;b;c;a d;c;a;b d;c;b;a</pre>
=={{header|Go}}==
Line 2,995 ⟶ 4,814:
=== recursive ===
<
import "fmt"
Line 3,046 ⟶ 4,865:
}
rc(len(s))
}</
{{out}}
<pre>[1 2 3]
Line 3,057 ⟶ 4,876:
=== non-recursive, lexicographical order ===
<
import "fmt"
Line 3,085 ⟶ 4,904:
fmt.Println(a)
}
}</
{{out}}
Line 3,098 ⟶ 4,917:
=={{header|Groovy}}==
Solution:
<
Test:
<
def permutations = makePermutations(list)
assert permutations.size() == (1..<(list.size()+1)).inject(1) { prod, i -> prod*i }
permutations.each { println it }</
{{out}}
<pre style="height:30ex;overflow:scroll;">[Young, Crosby, Stills, Nash]
Line 3,132 ⟶ 4,951:
=={{header|Haskell}}==
<
main = mapM_ print (permutations [1,2,3])</
A simple implementation, that assumes elements are unique and support equality:
<
permutations :: Eq a => [a] -> [[a]]
permutations [] = [[]]
permutations xs = [ x:ys | x <- xs, ys <- permutations (delete x xs)]</
A slightly more efficient implementation that doesn't have the above restrictions:
<
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 ]</
The above are all selection-based approaches. The following is an insertion-based approach:
<
permutations = foldr (concatMap . insertEverywhere) [[]]
where insertEverywhere :: a -> [a] -> [[a]]
insertEverywhere x [] = [[x]]
insertEverywhere x l@(y:ys) = (x:l) : map (y:) (insertEverywhere x ys)</
A serialized version:
{{Trans|Mathematica}}
<syntaxhighlight lang
permutations :: [a] -> [[a]]
permutations =
in foldr
)
[[]]
main :: IO ()
main = print $ permutations [1, 2, 3]</
{{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}}==
<
every p := permute(A) do every writes((!p||" ")|"\n")
end
Line 3,180 ⟶ 5,003:
if *A <= 1 then return A
suspend [(A[1]<->A[i := 1 to *A])] ||| permute(A[2:0])
end</
{{out}}
<pre>->permute Aardvarks eat ants
Line 3,190 ⟶ 5,013:
ants Aardvarks eat
-></pre>
=={{header|J}}==
<
{{out|Example use}}
<
0 1
1 0
Line 3,231 ⟶ 5,026:
random text some
text some random
text random some</
=={{header|Java}}==
Using the code of Michael Gilleland.
<
private int[] array;
private int firstNum;
Line 3,317 ⟶ 5,112:
}
} // class</
{{out}}
<pre>
Line 3,330 ⟶ 5,125:
Following needs: [[User:Margusmartsepp/Contributions/Java/Utils.java|Utils.java]]
<
public static void main(String[] args) {
System.out.println(Utils.Permutations(Utils.mRange(1, 3)));
}
}</
{{out}}
<pre>[[1, 2, 3], [1, 3, 2], [2, 1, 3], [2, 3, 1], [3, 1, 2], [3, 2, 1]]</pre>
Line 3,343 ⟶ 5,138:
Copy the following as an HTML file and load in a browser.
<
<body><pre id="result"></pre>
<script type="text/javascript">
Line 3,365 ⟶ 5,160:
perm([1, 2, 'A', 4], []);
</script></body></html></
Alternatively: 'Genuine' js code, assuming no duplicate.
<syntaxhighlight lang="javascript">
function perm(a) {
if (a.length < 2) return [a];
Line 3,382 ⟶ 5,177:
console.log(perm(['Aardvarks', 'eat', 'ants']).join("\n"));
</syntaxhighlight>
{{Out}}
<
Aardvarks,ants,eat
eat,Aardvarks,ants
eat,ants,Aardvarks
ants,Aardvarks,eat
ants,eat,Aardvarks</
====Functional composition====
Line 3,398 ⟶ 5,193:
(Simple version – assuming a unique list of objects comparable by the JS === operator)
<
'use strict';
Line 3,432 ⟶ 5,227:
// TEST
return permutations(['Aardvarks', 'eat', 'ants']);
})();</
{{Out}}
<
["eat", "Aardvarks", "ants"], ["eat", "ants", "Aardvarks"],
["ants", "Aardvarks", "eat"], ["ants", "eat", "Aardvarks"]]</
===ES6===
Recursively, in terms of concatMap and delete:
<
'use strict';
Line 3,479 ⟶ 5,274:
permutations(['Aardvarks', 'eat', 'ants'])
);
})();</
{{Out}}
<
["eat", "Aardvarks", "ants"], ["eat", "ants", "Aardvarks"],
["ants", "Aardvarks", "eat"], ["ants", "eat", "Aardvarks"]]</
Or, without recursion, in terms of concatMap and reduce:
<
'use strict';
Line 3,528 ⟶ 5,323:
permutations([1, 2, 3])
);
})();</
{{Out}}
<pre>[[1,2,3],[2,1,3],[2,3,1],[1,3,2],[3,1,2],[3,2,1]]</pre>
Line 3,534 ⟶ 5,329:
=={{header|jq}}==
"permutations" generates a stream of the permutations of the input array.
<
if length == 0 then []
else
Line 3,540 ⟶ 5,335:
| [.[$i]] + (del(.[$i])|permutations)
end ;
</syntaxhighlight>
'''Example 1''': list them
[range(0;3)] | permutations
Line 3,566 ⟶ 5,361:
=={{header|Julia}}==
<syntaxhighlight lang="julia">
julia> perms(l) = isempty(l) ? [l] : [[x; y] for x in l for y in perms(setdiff(l, x))]
</syntaxhighlight>
{{out}}
<syntaxhighlight lang="julia">
julia> perms([1,2,3])
6-element Vector{Vector{Int64}}:
[1, 2, 3]
[1, 3, 2]
⋮
[3, 1, 2]
[3, 2, 1]
</syntaxhighlight>
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">
using Combinatorics
Line 3,582 ⟶ 5,394:
end
println()
</syntaxhighlight>
{{out}}
Line 3,599 ⟶ 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>
{{out}}
<pre>
Line 3,617 ⟶ 5,429:
=={{header|K}}==
{{trans|J}}
<
perm 2
(0 1
Line 3,628 ⟶ 5,440:
random text some
text some random
text random some</
Alternative:
<syntaxhighlight lang="k">
perm:{x@m@&n=(#?:)'m:!n#n:#x}
Line 3,657 ⟶ 5,469:
text some random
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}}==
Translation of C# recursive 'insert' solution in Wikipedia article on Permutations:
<
fun <T> permute(input: List<T>): List<List<T>> {
Line 3,682 ⟶ 5,515:
println("There are ${perms.size} permutations of $input, namely:\n")
for (perm in perms) println(perm)
}</
{{out}}
Line 3,714 ⟶ 5,547:
</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>) {
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}}==
<syntaxhighlight lang="scheme">
{def inject
{lambda {:x :a}
{if {A.empty? :a}
then {A.new {A.new :x}}
else {let { {:c {{lambda {:a :b} {A.cons {A.first :a} :b}} :a}}
{:d {inject :x {A.rest :a}}}
{:e {A.cons :x :a}}
} {A.cons :e {A.map :c :d}}}}}}
-> inject
{def permut
{lambda {:a}
{if {A.empty? :a}
then {A.new :a}
else {let { {:c {{lambda {:a :b} {inject {A.first :a} :b}} :a}}
{:d {permut {A.rest :a}}}
} {A.reduce A.concat {A.map :c :d}}}}}}
-> permut
{permut {A.new 1 2 3}}
-> [[1,2,3],[2,1,3],[2,3,1],[1,3,2],[3,1,2],[3,2,1]]
{permut {A.new 1 2 3 4}}
->
[[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>
And this is an illustration of the way lambdatalk builds an interface for javascript functions (the first one is given in this page):
<syntaxhighlight lang="javascript">
1) permutations on sentences
{script
var S_perm = function(a) {
if (a.length < 2) return [a];
var b = [];
for (var c = 0; c < a.length; c++) {
var e = a.splice(c, 1), f = S_perm(a);
for (var d = 0; d < f.length; d++)
b.push( e.concat( f[d]) );
a.splice(c, 0, e[0])
}
return b
}
LAMBDATALK.DICT['S.perm'] = function() { // {S.perm 1 2 3}
return S_perm( arguments[0].trim()
.split(" ") )
.join(" ")
.replace(/\s/g,"{br}")
};
}
{S.perm 1 2 3}
->
1,2,3
1,3,2
2,1,3
2,3,1
3,1,2
3,2,1
{S.perm hello brave world}
->
hello,brave,world
hello,world,brave
brave,hello,world
brave,world,hello
world,hello,brave
world,brave,hello
2) permutations on words
{script
var W_perm = function(word) {
if (word.length === 1) return [word]
var results = [];
for (var i = 0; i < word.length; i++) {
var buti = W_perm( word.substring(0, i) + word.substring(i + 1) );
for (var j = 0; j < buti.length; j++)
results.push(word[i] + buti[j]);
}
return results;
};
LAMBDATALK.DICT['W.perm'] = function() { // {W.perm 123}
return W_perm( arguments[0].trim() ).join("{br}")
};
}
{W.perm 123}
->
123
132
213
231
312
321
</syntaxhighlight>
=={{header|langur}}==
{{trans|Go}}
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(.list) > .limit: throw "permutation limit exceeded (currently {{.limit}})"
var .elements = .list
var .ordinals = pseries len .elements
val .n = len(.ordinals)
var
for[.p=[.list]] of .factorial(len .
.i = .n - 1
.j = .n
.i -= 1
}
.j -= 1
}
.i += 1
for .j = .n; .i < .j ; .i
}
.
}
}
for .e in .permute([1, 3.14, 7]) {
writeln .e
}
</syntaxhighlight>
{{out}}
Line 3,774 ⟶ 5,742:
=={{header|LFE}}==
<
(defun permute
(('())
Line 3,782 ⟶ 5,750:
(<- y (permute (-- l `(,x)))))
(cons x y))))
</syntaxhighlight>
REPL usage:
<
> (permute '(1 2 3))
((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1))
</syntaxhighlight>
=={{header|
<syntaxhighlight lang="lobster">
// Lobster implementation of the (very fast) Go example
// http://rosettacode.org/wiki/Permutations#Go
// implementing the plain changes (bell ringers) algorithm, using a recursive function
// https://en.wikipedia.org/wiki/Steinhaus–Johnson–Trotter_algorithm
def permr(s, f):
if s.length == 0:
f(s)
return
def rc(np: int):
if np == 1:
f(s)
return
let np1 = np - 1
let pp = s.length - np1
rc(np1) // recurs prior swaps
var i = pp
while i > 0:
// swap s[i], s[i-1]
let t = s[i]
s[i] = s[i-1]
s[i-1] = t
rc(np1) // recurs swap
i -= 1
let w = s[0]
for(pp): s[_] = s[_+1]
s[pp] = w
rc(s.length)
// Heap's recursive method https://en.wikipedia.org/wiki/Heap%27s_algorithm
def permh(s, f):
def rc(k: int):
if k <= 1:
f(s)
else:
// Generate permutations with kth unaltered
// Initially k == length(s)
rc(k-1)
// Generate permutations for kth swapped with each k-1 initial
for(k-1) i:
// Swap choice dependent on parity of k (even or odd)
// zero-indexed, the kth is at k-1
if (k & 1) == 0:
let t = s[i]
s[i] = s[k-1]
s[k-1] = t
else:
let t = s[0]
s[0] = s[k-1]
s[k-1] = t
rc(k-1)
rc(s.length)
// iterative Boothroyd method
import std
def permi(xs, f):
var d = 1
let c = map(xs.length): 0
f(xs)
while true:
while d > 1:
d -= 1
c[d] = 0
while c[d] >= d:
d += 1
if d >= xs.length:
return
let i = if (d & 1) == 1: c[d] else: 0
let t = xs[i]
xs[i] = xs[d]
xs[d] = t
f(xs)
c[d] = c[d] + 1
// next lexicographical permutation
// to get all permutations the initial input `a` must be in sorted order
// returns false when input `a` is in reverse sorted order
def next_lex_perm(a):
def swap(i, j):
let t = a[i]
a[i] = a[j]
a[j] = t
let n = a.length
/* 1. Find the largest index k such that a[k] < a[k + 1]. If no such
index exists, the permutation is the last permutation. */
var k = n - 1
while k > 0 and a[k-1] >= a[k]: k--
if k == 0: return false
k -= 1
/* 2. Find the largest index l such that a[k] < a[l]. Since k + 1 is
such an index, l is well defined */
var l = n - 1
while a[l] <= a[k]: l--
/* 3. Swap a[k] with a[l] */
swap(k, l)
/* 4. Reverse the sequence from a[k + 1] to the end */
k += 1
l = n - 1
while l > k:
swap(k, l)
l -= 1
k += 1
return true
var se = [0, 1, 2, 3] //, 4, 5, 6, 7, 8, 9, 10]
print "Iterative lexicographical permuter"
print se
while next_lex_perm(se): print se
print "Recursive plain changes iterator"
se = [0, 1, 2, 3]
permr(se): print(_)
print "Recursive Heap\'s iterator"
se = [0, 1, 2, 3]
permh(se): print(_)
print "Iterative Boothroyd iterator"
se = [0, 1, 2, 3]
permi(se): print(_)
</syntaxhighlight>
{{out}}
<pre>
Iterative lexicographical permuter
[0, 1, 2, 3]
[0, 1, 3, 2]
[0, 2, 1, 3]
[0, 2, 3, 1]
[0, 3, 1, 2]
[0, 3, 2, 1]
[1, 0, 2, 3]
[1, 0, 3, 2]
[1, 2, 0, 3]
[1, 2, 3, 0]
[1, 3, 0, 2]
[1, 3, 2, 0]
[2, 0, 1, 3]
[2, 0, 3, 1]
[2, 1, 0, 3]
[2, 1, 3, 0]
[2, 3, 0, 1]
[2, 3, 1, 0]
[3, 0, 1, 2]
[3, 0, 2, 1]
[3, 1, 0, 2]
[3, 1, 2, 0]
[3, 2, 0, 1]
[3, 2, 1, 0]
Recursive plain changes iterator
[0, 1, 2, 3]
[0, 1, 3, 2]
[0, 3, 1, 2]
[3, 0, 1, 2]
[0, 2, 1, 3]
[0, 2, 3, 1]
[0, 3, 2, 1]
[3, 0, 2, 1]
[2, 0, 1, 3]
[2, 0, 3, 1]
[2, 3, 0, 1]
[3, 2, 0, 1]
[1, 0, 2, 3]
[1, 0, 3, 2]
[1, 3, 0, 2]
[3, 1, 0, 2]
[1, 2, 0, 3]
[1, 2, 3, 0]
[1, 3, 2, 0]
[3, 1, 2, 0]
[2, 1, 0, 3]
[2, 1, 3, 0]
[2, 3, 1, 0]
[3, 2, 1, 0]
Recursive Heap's iterator
[0, 1, 2, 3]
[1, 0, 2, 3]
[2, 0, 1, 3]
[0, 2, 1, 3]
[1, 2, 0, 3]
[2, 1, 0, 3]
[3, 1, 0, 2]
[1, 3, 0, 2]
[0, 3, 1, 2]
[3, 0, 1, 2]
[1, 0, 3, 2]
[0, 1, 3, 2]
[0, 2, 3, 1]
[2, 0, 3, 1]
[3, 0, 2, 1]
[0, 3, 2, 1]
[2, 3, 0, 1]
[3, 2, 0, 1]
[3, 2, 1, 0]
[2, 3, 1, 0]
[1, 3, 2, 0]
[3, 1, 2, 0]
[2, 1, 3, 0]
[1, 2, 3, 0]
Iterative Boothroyd iterator
[0, 1, 2, 3]
[1, 0, 2, 3]
[2, 0, 1, 3]
[0, 2, 1, 3]
[1, 2, 0, 3]
[2, 1, 0, 3]
[3, 1, 0, 2]
[1, 3, 0, 2]
[0, 3, 1, 2]
[3, 0, 1, 2]
[1, 0, 3, 2]
[0, 1, 3, 2]
[0, 2, 3, 1]
[2, 0, 3, 1]
[3, 0, 2, 1]
[0, 3, 2, 1]
[2, 3, 0, 1]
[3, 2, 0, 1]
[3, 2, 1, 0]
[2, 3, 1, 0]
[1, 3, 2, 0]
[3, 1, 2, 0]
[2, 1, 3, 0]
[1, 2, 3, 0]
</pre>
=={{header|Logtalk}}==
<
:- public(permutation/2).
Line 3,887 ⟶ 6,018:
select(Head, Tail, Tail2).
:- end_object.</
{{out|Usage example}}
<
[1,2,3]
Line 3,897 ⟶ 6,028:
[3,1,2]
[3,2,1]
yes</
=={{header|Lua}}==
<
local function permutation(a, n, cb)
if n == 0 then
Line 3,919 ⟶ 6,050:
end
permutation({1,2,3}, 3, callback)
</syntaxhighlight>
{{out}}
<pre>
Line 3,930 ⟶ 6,061:
</pre>
<
-- Iterative version
Line 3,963 ⟶ 6,094:
ipermutations(3, 3)
</syntaxhighlight>
<pre>
Line 3,971 ⟶ 6,102:
2 3 1
3 1 2
3 2 1
</pre>
=== fast, iterative with coroutine to use as a generator ===
<syntaxhighlight lang="lua">
#!/usr/bin/env luajit
-- Iterative version
local function ipermgen(a,b)
if a==0 then return end
local taken = {} local slots = {}
for i=1,a do slots[i]=0 end
for i=1,b do taken[i]=false end
local index = 1
while index > 0 do repeat
repeat slots[index] = slots[index] + 1
until slots[index] > b or not taken[slots[index]]
if slots[index] > b then
slots[index] = 0
index = index - 1
if index > 0 then
taken[slots[index]] = false
end
break
else
taken[slots[index]] = true
end
if index == a then
coroutine.yield(slots)
taken[slots[index]] = false
break
end
index = index + 1
until true end
end
local function iperm(a)
local co=coroutine.create(function() ipermgen(a,a) end)
return function()
local code,res=coroutine.resume(co)
return res
end
end
local a=arg[1] and tonumber(arg[1]) or 3
for p in iperm(a) do
print(table.concat(p, " "))
end
</syntaxhighlight>
{{out}}
<pre>
> ./perm_iter_coroutine.lua 3
1 2 3
1 3 2
2 1 3
2 3 1
3 1 2
3 2 1
</pre>
Line 3,976 ⟶ 6,163:
=={{header|M2000 Interpreter}}==
===All permutations in one module===
<syntaxhighlight lang="m2000 interpreter">
Module Checkit {
Global a$
Line 4,021 ⟶ 6,208:
}
Checkit
</syntaxhighlight>
===Step by step Generator===
<syntaxhighlight lang="m2000 interpreter">
Module StepByStep {
Function PermutationStep (a) {
Line 4,068 ⟶ 6,255:
StepByStep
</syntaxhighlight>
{{out}}
<pre style="height:30ex;overflow:scroll">
Line 4,133 ⟶ 6,320:
</pre >
=={{header|m4}}==
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.)
<syntaxhighlight lang="m4">divert(-1)
# 1-based indexing of a string's characters.
define(`get',`substr(`$1',decr(`$2'),1)')
define(`set',`substr(`$1',0,decr(`$2'))`'$3`'substr(`$1',`$2')')
define(`swap',
`pushdef(`_u',`get(`$1',`$2')')`'dnl
pushdef(`_v',`get(`$1',`$3')')`'dnl
set(set(`$1',`$2',_v),`$3',_u)`'dnl
popdef(`_u',`_v')')
# $1-fold repetition of $2.
define(`repeat',`ifelse($1,0,`',`$2`'$0(decr($1),`$2')')')
#
# Heap's algorithm. Algorithm 2 in Robert Sedgewick, 1977. Permutation
# generation methods. ACM Comput. Surv. 9, 2 (June 1977), 137-164.
#
# This implementation permutes the characters in a string of length no
# more than 9. On longer strings, it may strain the resources of a
# very old implementation of m4.
#
define(`permutations',
`ifelse($2,`',`$1
$0(`$1',repeat(len(`$1'),1),2)',
`ifelse(eval(($3) <= len(`$1')),1,
`ifelse(eval(get($2,$3) < $3),1,
`swap(`$1',_$0($2,$3),$3)
$0(swap(`$1',_$0($2,$3),$3),set($2,$3,incr(get($2,$3))),2)',
`$0(`$1',set($2,$3,1),incr($3))')')')')
define(`_permutations',`eval((($2) % 2) + ((1 - (($2) % 2)) * get($1,$2)))')
divert`'dnl
permutations(`123')
permutations(`abcd')</syntaxhighlight>
{{out}}
$ m4 permutations.m4
<pre>123
213
312
132
231
321
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|Maple}}==
<syntaxhighlight lang="maple">combinat:-permute(3);
[[1, 2, 3], [1, 3, 2], [2, 1, 3], [2, 3, 1], [3, 1, 2], [3, 2, 1]]
[[a, b, c], [a, c, b], [b, a, c], [b, c, a], [c, a, b], [c, b, a]]</syntaxhighlight>
An implementation based on Mathematica solution:
<syntaxhighlight 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]]</syntaxhighlight>
=={{header|Mathematica}}/{{header|Wolfram Language}}==
Note: The built-in version will have better performance.
===Version from scratch===
<syntaxhighlight lang="mathematica">
(***Standard list functions:*)
fold[f_, x_, {}] := x
Line 4,160 ⟶ 6,428:
Table[insert[L, #2, k + 1], {k, 0, Length[L]}]] /@ #1) &, {{}},
S]
</syntaxhighlight>
{{out}}
Line 4,171 ⟶ 6,439:
===Built-in version===
<
{{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 4,178 ⟶ 6,446:
=={{header|MATLAB}} / {{header|Octave}}==
<
{{out}}
<pre>4321
Line 4,206 ⟶ 6,474:
=={{header|Maxima}}==
<
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 4,229 ⟶ 6,497:
[2, 3, 1]
[3, 1, 2]
[3, 2, 1] */</
===Builtin version===
<
(%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>
=={{header|Mercury}}==
<
:- module permutations2.
:- interface.
Line 4,276 ⟶ 6,544:
nl(!IO),
print(all_permutations2([1,2,3,4]),!IO).
</syntaxhighlight>
{{out}}
Line 4,283 ⟶ 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|Modula-2}}==
{{works with|ADW Modula-2 (1.6.291)}}
<
FROM Terminal
Line 4,422 ⟶ 6,614:
IF n > 0 THEN permute(n) END;
(*Wait*)
END Permute.</
=={{header|Modula-3}}==
Line 4,429 ⟶ 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.
<
IMPORT IO, IntSeq;
Line 4,486 ⟶ 6,678:
GeneratePermutations(chosen, values);
END Permutations.</
{{out}}
Line 4,507 ⟶ 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>).
<
(*
Line 4,534 ⟶ 6,726:
*)
END GenericPermutations.</
;implementation
Line 4,540 ⟶ 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.
<
(*
Line 4,610 ⟶ 6,802:
BEGIN
END GenericPermutations.</
;Sample Usage
Line 4,616 ⟶ 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>.
<
IMPORT IO, IntSeq, IntSetTree, IntSeqSeq, IntPermutations;
Line 4,658 ⟶ 6,850:
END;
END GPermutations.</
{{out}} (somewhat edited!)
Line 4,672 ⟶ 6,864:
=={{header|NetRexx}}==
<
options replace format comments java crossref symbols nobinary
Line 4,820 ⟶ 7,012:
end thing
return
</syntaxhighlight>
{{out}}
<pre style="height:55ex;overflow:scroll">
Line 4,866 ⟶ 7,058:
=={{header|Nim}}==
===Using the standard library===
<syntaxhighlight lang="nim">import algorithm
var v = [1, 2, 3] # List has to start sorted
echo v
while v.nextPermutation():
echo v</syntaxhighlight>
{{out}}
<pre>
[1, 2, 3]
[1, 3, 2]
[2, 1, 3]
[2, 3, 1]
[3, 1, 2]
[3, 2, 1]
</pre>
===Single yield iterator===
<syntaxhighlight 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"
let n = xs.len - 1
var
c: array[24, int8]
i: int = 0
for i in 0 .. n: c[i] = int8(i+1)
while true:
yield xs
if i >= n: break
c[i] -= 1
let j = if (i and 1) == 1: 0 else: int(c[i])
swap(xs[i+1], xs[j])
i = 0
while c[i] == 0:
let t = i+1
c[i] = int8(t)
i = t
</syntaxhighlight>
verification
<syntaxhighlight lang="nim">
import intsets
from math import fac
block:
# test all permutations of length from 0 to 9
for l in 0..9:
# prepare data
var xs = newSeq[int](l)
for i in 0..<l: xs[i] = i
var s = initIntSet()
for cs in inplacePermutations(xs):
# each permutation must be of length l
assert len(cs) == l
# each permutation must contain digits from 0 to l-1 exactly once
var ds = newSeq[bool](l)
for c in cs:
assert not ds[c]
ds[c] = true
# generate a unique number for each permutation
var h = 0
for e in cs:
h = l * h + e
assert not s.contains(h)
s.incl(h)
# check exactly l! unique number of permutations
assert len(s) == fac(l)
</syntaxhighlight>
===Translation of C===
{{trans|C}}
<
iterator permutations[T](ys: openarray[T]): seq[T] =
var
Line 4,885 ⟶ 7,157:
inc d
if d >= ys.len: break outer
let i = if (d and 1) == 1: c[d] else: 0
swap xs[i], xs[d]
Line 4,894 ⟶ 7,165:
for i in permutations(x):
echo i</
Output:
<pre>@[1, 2, 3]
Line 4,903 ⟶ 7,174:
@[3, 2, 1]</pre>
===Translation of Go===
{{trans|Go}}
<
# http://rosettacode.org/wiki/Permutations#Go
# implementing a recursive https://en.wikipedia.org/wiki/Steinhaus–Johnson–Trotter_algorithm
import algorithm
proc perm(s: openArray[int];
var s = @s
if s.len == 0:
emit(s)
return
proc rc(np: int) =
if np ==
rc(np1) # Recurse prior swaps.
for i in countDown(pp, 1):
swap s[i], s[i-1]
rc(np1) #
var se = @[0, 1, 2, 3] #, 4, 5, 6, 7, 8, 9, 10]
perm(se, proc(
=={{header|OCaml}}==
<
Translation of Ada version. *)
let next_perm p =
Line 4,988 ⟶ 7,255:
2 3 1
3 1 2
3 2 1 *)</
Permutations can also be defined on lists recursively:
<
let n = List.length l in
if n = 1 then [l] else
Line 5,004 ⟶ 7,271:
let print l = List.iter (Printf.printf " %d") l; print_newline() in
List.iter print (permutations [1;2;3;4])</
or permutations indexed independently:
<
let a, b = let c = k/n in c, k-(n*c) in
let e = List.nth l b in
Line 5,022 ⟶ 7,289:
done
let () = show_perms [1;2;3;4]</
=={{header|ooRexx}}==
Essentially derived fom the program shown under rexx.
This program works also with Regina (and other REXX implementations?)
<syntaxhighlight lang="oorexx">
/* REXX Compute bunch permutations of things elements */
Parse Arg bunch things
If bunch='?' Then
Call help
If bunch=='' Then bunch=3
If datatype(bunch)<>'NUM' Then Call help 'bunch ('bunch') must be numeric'
thing.=''
Select
When things='' Then things=bunch
When datatype(things)='NUM' Then Nop
Otherwise Do
data=things
things=words(things)
Do i=1 To things
Parse Var data thing.i data
End
End
End
If things<bunch Then Call help 'things ('things') must be >= bunch ('bunch')'
perms =0
Call time 'R'
Call permSets things, bunch
Say perms 'Permutations'
Say time('E') 'seconds'
Exit
/*--------------------------------------------------------------------------------------*/
first_word: return word(Arg(1),1)
/*--------------------------------------------------------------------------------------*/
permSets: Procedure Expose perms thing.
Parse Arg things,bunch
aa.=''
sep=''
perm_elements='123456789ABCDEF'
Do k=1 To things
perm=first_word(first_word(substr(perm_elements,k,1) k))
dd.k=perm
End
Call .permSet 1
Return
.permSet: Procedure Expose dd. aa. things bunch perms thing.
Parse Arg iteration
If iteration>bunch Then do
perm= aa.1
Do j=2 For bunch-1
perm= perm aa.j
End
perms+=1
If thing.1<>'' Then Do
ol=''
Do pi=1 To words(perm)
z=word(perm,pi)
If datatype(z)<>'NUM' Then
z=9+pos(z,'ABCDEF')
ol=ol thing.z
End
Say strip(ol)
End
Else
Say perm
End
Else Do
Do q=1 for things
Do k=1 for iteration-1
If aa.k==dd.q Then
iterate q
End
aa.iteration= dd.q
Call .permSet iteration+1
End
End
Return
help:
Parse Arg msg
If msg<>'' Then Do
Say 'ERROR:' msg
Say ''
End
Say 'rexx perm -> Permutations of 1 2 3 '
Say 'rexx perm 2 -> Permutations of 1 2 '
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</syntaxhighlight>
{{out}}
<pre>H:\>rexx perm 2 U V W X
U V
U W
U X
V U
V W
V X
W U
W V
W X
X U
X V
X W
12 Permutations
0.006000 seconds
H:\>rexx perm ?
rexx perm -> Permutations of 1 2 3
rexx perm 2 -> Permutations of 1 2
rexx perm 2 4 -> Permutations of 1 2 3 4 in 2 positions
rexx perm 2 a b c d -> Permutations of a b c d in 2 positions</pre>
=={{header|OpenEdge/Progress}}==
<syntaxhighlight lang="openedge/progress">
DEFINE VARIABLE charArray AS CHARACTER EXTENT 3 INITIAL ["A","B","C"].
DEFINE VARIABLE sizeofArray AS INTEGER.
Line 5,060 ⟶ 7,440:
charArray[a] = charArray[b].
charArray[b] = temp.
END PROCEDURE. </
{{out}}
<pre>ABC
Line 5,070 ⟶ 7,450:
=={{header|PARI/GP}}==
<
=={{header|Pascal}}==
<
var
Line 5,143 ⟶ 7,523:
next;
until is_last;
end.</
===alternative===
a little bit more speed.I take n = 12.
Line 5,149 ⟶ 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.
<
{$MODE DELPHI}
{$ELSE}
Line 5,219 ⟶ 7,599:
writeln(permcnt);
writeln(FormatDateTime('HH:NN:SS.zzz',T1-T0));
end.</
{{Out}}
{fpc 2.64/3.0 32Bit or 3.1 64 Bit i4330 3.5 Ghz same timings.
Line 5,226 ⟶ 7,606:
479001600 //= 12!
00:00:01.328</pre>
===Permutations from integers===
A console application in Free Pascal, created with the Lazarus IDE.
<syntaxhighlight lang="pascal">
program Permutations;
(*
Demonstrates four closely related ways of establishing a bijection between
permutations of 0..(n-1) and integers 0..(n! - 1).
Each integer in that range is represented by mixed-base digits d[0..n-1],
where each d[j] satisfies 0 <= d[j] <=j.
The integer represented by d[0..n-1] is
d[n-1]*(n-1)! + d[n-2]*(n-2)! + ... + d[1]*1! + d[0]*0!
where the last term can be omitted in practice because d[0] is always 0.
See the section "Numbering permutations" in the Wikipedia article
"Permutation" (NB their digit array d is 1-based).
*)
uses SysUtils, TypInfo;
type TPermIntMapping = (map_I, map_J, map_K, map_L);
type TPermutation = array of integer;
// Function to map an integer to a permutation.
function IntToPerm( map : TPermIntMapping;
nrItems, z : integer) : TPermutation;
var
d, lookup : array of integer;
x, y : integer;
h, j, k, m : integer;
begin
SetLength( result, nrItems);
SetLength( lookup, nrItems);
SetLength( d, nrItems);
m := nrItems - 1;
// Convert z to digits d[0..m] (see comment at head of program).
d[0] := 0;
y := z;
for j := 1 to m - 1 do begin
x := y div (j + 1);
d[j] := y - x*(j + 1);
y := x;
end;
d[m] := y;
// Set up the permutation elements
case map of
map_I, map_L: for j := 0 to m do lookup[j] := j;
map_J, map_K: for j := 0 to m do lookup[j] := m - j;
end;
for j := m downto 0 do begin
k := d[j];
case map of
map_I: result[lookup[k]] := m - j;
map_J: result[j] := lookup[k];
map_K: result[lookup[k]] := j;
map_L: result[m - j] := lookup[k];
end;
// When lookup[k] has been used, it's removed from the lookup table
// and the elements above it are moved down one place.
for h := k to j - 1 do lookup[h] := lookup[h + 1];
end;
end;
// Function to map a permutation to an integer; inverse of the above.
// Put in for completeness, not required for Rosetta Code task.
function PermToInt( map : TPermIntMapping;
p : TPermutation) : integer;
var
m, i, j, k : integer;
d : array of integer;
begin
m := High(p); // number of items in permutation is m + 1
SetLength( d, m + 1);
for k := 0 to m do d[k] := 0; // initialize all digits to 0
// Looking for inversions
for i := 0 to m - 1 do begin
for j := i + 1 to m do begin
if p[j] < p[i] then begin
case map of
map_I : inc( d[m - p[j]]);
map_J : inc( d[j]);
map_K : inc( d[p[i]]);
map_L : inc( d[m - i]);
end;
end;
end;
end;
// Get result from its digits (see comment at head of program).
result := d[m];
for j := m downto 2 do result := result*j + d[j - 1];
end;
// Main routine to generate permutations of the integers 0..(n-1),
// where n is passed as a command-line parameter, e.g. Permutations 4
var
n, n_fac, z, j : integer;
nrErrors : integer;
perm : TPermutation;
map : TPermIntMapping;
lineOut : string;
pinfo : TypInfo.PTypeInfo;
begin
n := SysUtils.StrToInt( ParamStr(1));
n_fac := 1;
for j := 2 to n do n_fac := n_fac*j;
pinfo := System.TypeInfo( TPermIntMapping);
lineOut := 'integer';
for map := Low( TPermIntMapping) to High( TPermIntMapping) do begin
lineOut := lineOut + ' ' + TypInfo.GetEnumName( pinfo, ord(map));
end;
WriteLn( lineOut);
for z := 0 to n_fac - 1 do begin
lineOut := SysUtils.Format( '%7d', [z]);
for map := Low( TPermIntMapping) to High( TPermIntMapping) do begin
perm := IntToPerm( map, n, z);
// Check the inverse mapping (not required for Rosetta Code task)
Assert( z = PermToInt( map, perm));
lineOut := lineOut + ' ';
for j := 0 to n - 1 do
lineOut := lineOut + SysUtils.Format( '%d', [perm[j]]);
end;
WriteLn( lineOut);
end;
end.
</syntaxhighlight>
{{out}}
<pre>
integer map_I map_J map_K map_L
0 0123 0123 0123 0123
1 0132 1023 1023 0132
2 0213 0213 0213 0213
3 0312 2013 1203 0231
4 0231 1203 2013 0312
5 0321 2103 2103 0321
6 1023 0132 0132 1023
7 1032 1032 1032 1032
8 2013 0312 0231 1203
9 3012 3012 1230 1230
10 2031 1302 2031 1302
11 3021 3102 2130 1320
12 1203 0231 0312 2013
13 1302 2031 1302 2031
14 2103 0321 0321 2103
15 3102 3021 1320 2130
16 2301 2301 2301 2301
17 3201 3201 2310 2310
18 1230 1230 3012 3012
19 1320 2130 3102 3021
20 2130 1320 3021 3102
21 3120 3120 3120 3120
22 2310 2310 3201 3201
23 3210 3210 3210 3210
</pre>
=={{header|Perl}}==
A simple recursive implementation.
<
my ($perm,@set) = @_;
print "$perm\n" || return unless (@set);
Line 5,235 ⟶ 7,766:
}
my @input = (qw/a b c d/);
permutation('',@input);</
{{out}}
<pre>abcd
Line 5,264 ⟶ 7,795:
For better performance, use a module like <code>ntheory</code> or <code>Algorithm::Permute</code>.
{{libheader|ntheory}}
<
my @tasks = (qw/party sleep study/);
forperm {
print "@tasks[@_]\n";
} @tasks;</
{{out}}
<pre>
Line 5,279 ⟶ 7,810:
</pre>
=={{header|
<!--<syntaxhighlight lang="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>
<!--</syntaxhighlight>-->
{{out}}
<pre>
{"abcd","abdc","acbd","acdb","adbc","...","dacb","dbac","dbca","dcab","dcba"," (24 elements)"}
</pre>
The elements can be any type. There is also a permute() function which accepts an integer between 1 and factorial(length(s)) and returns the permutations in lexicographical position order. It is just as fast to generate the (n!)th permutation as the first, so some applications may benefit by storing an integer key rather than duplicating all the elements of the given set.
=={{header|Phixmonti}}==
<syntaxhighlight lang="phixmonti">include ..\Utilitys.pmt
def save
over over chain ps> swap 0 put >ps
enddef
def permute /# l l -- #/
pop swap rot swap 1 put swap permute
endfor
else
save rotate save rotate
endif
swap len if
pop rot rot 0 put
else
drop drop
endif
enddef
( ) >ps
( ) ( 1 2 3 4 ) permute
ps> sort print</syntaxhighlight>
=={{header|Picat}}==
Picat has built-in support for permutations:
* <code>permutation(L)</code>: Generates all permutations for a list L.
* <code>permutation(L,P)</code>: Generates (via backtracking) all permutations for a list L.
===Recursion===
Use <code>findall/2</code> to find all permutations. See example below.
<syntaxhighlight lang="picat">permutation_rec1([X|Y],Z) :-
permutation_rec1(Y,W),
select(X,Z,W).
permutation_rec1([],[]).
permutation_rec2([], []).
permutation_rec2([X], [X]) :-!.
permutation_rec2([T|H], X) :-
permutation_rec2(H, H1),
append(L1, L2, H1),
append(L1, [T], X1),
append(X1, L2, X).</syntaxhighlight>
===Constraint modelling===
Constraint modelling only handles integers, and here generates all permutations of a list 1..N for a given N.
<code>permutation_cp_list(L)</code> permutes a list via <code>permutation_cp2/1</code>.
<syntaxhighlight lang="picat">import cp.
% Returns all permutations
permutation_cp1(N) = solve_all(X) =>
X = new_list(N),
X :: 1..N,
all_different(X).
% Find next permutation on backtracking
permutation_cp2(N,X) =>
X = new_list(N),
X :: 1..N,
all_different(X),
solve(X).
% 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)].</syntaxhighlight>
===Tests===
Here is a test of the different approaches, including the two built-ins.
<syntaxhighlight lang="picat">import util, cp.
main =>
N = 3,
println(permutations=permutations(1..N)), % built in
println(permutation=findall(P,permutation([a,b,c],P))), % built-in
println(permutation_rec1=findall(P,permutation_rec1(1..N,P))),
println(permutation_rec2=findall(P,permutation_rec2(1..N,P))),
println(permutation_cp1=permutation_cp1(N)),
println(permutation_cp2=findall(P,permutation_cp2(N,P))),
println(permutation_cp_list=permutation_cp_list("abc")).</syntaxhighlight>
{{out}}
<pre>permutations = [[1,2,3],[2,1,3],[2,3,1],[1,3,2],[3,1,2],[3,2,1]]
permutation = [abc,acb,bac,bca,cab,cba]
permutation_rec1 = [[1,2,3],[2,1,3],[2,3,1],[1,3,2],[3,1,2],[3,2,1]]
permutation_rec2 = [[1,2,3],[2,1,3],[2,3,1],[1,3,2],[3,1,2],[3,2,1]]
permutation_cp1 = [[1,2,3],[1,3,2],[2,1,3],[2,3,1],[3,1,2],[3,2,1]]
permutation_cp2 = [[1,2,3],[1,3,2],[2,1,3],[2,3,1],[3,1,2],[3,2,1]]
permutation_cp_list = [abc,acb,bac,bca,cab,cba]</pre>
=={{header|PicoLisp}}==
<
(permute (1 2 3))</
{{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">
function permutation ($array) {
function generate($n, $array, $A) {
Line 5,464 ⟶ 7,949:
}
permutation @('A','B','C')
</syntaxhighlight>
<b>Output:</b>
<pre>
Line 5,477 ⟶ 7,962:
=={{header|Prolog}}==
Works with SWI-Prolog and library clpfd,
<
permut_clpfd(L, N) :-
Line 5,483 ⟶ 7,968:
L ins 1..N,
all_different(L),
label(L).</
{{out}}
<
[1,2,3]
[1,3,2]
Line 5,493 ⟶ 7,978:
[3,2,1]
false.
</syntaxhighlight>
A declarative way of fetching permutations:
<
% P is a permutation of L
Line 5,501 ⟶ 7,986:
permut_Prolog([H | T], NL) :-
select(H, NL, NL1),
permut_Prolog(T, NL1).</
{{out}}
<
[ab,cd,ef]
[ab,ef,cd]
Line 5,510 ⟶ 7,995:
[ef,ab,cd]
[ef,cd,ab]
false.</
{{Trans|Curry}}
<syntaxhighlight lang="prolog">
insert(X, L, [X|L]).
insert(X, [Y|Ys], [Y|L2]) :- insert(X, Ys, L2).
permutation([], []).
permutation([X|Xs], P) :- permutation(Xs, L), insert(X, L, P).
</syntaxhighlight>
{{Out}}
<pre>
?- permutation([a,b,c],X).
X = [a, b, c] ;
X =
X = [b, c, a] ;
X = [a, c,
X = [c, a,
X = [c, b, a] ;
false.
</pre>
=={{header|Python}}==
Line 5,585 ⟶ 8,020:
===Standard library function===
{{works with|Python|2.6+}}
<
for values in itertools.permutations([1,2,3]):
print (values)</
{{out}}
<pre>
Line 5,602 ⟶ 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.
<
a = list(range(n))
def sub(i):
Line 5,627 ⟶ 8,062:
a[k - 1] = a[k]
a[n - 1] = x
yield from sub(0)</
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 5,633 ⟶ 8,068:
On three elements, the difference can be seen on the last two permutations:
<
(0, 1, 2)
(0, 2, 1)
Line 5,647 ⟶ 8,082:
(1, 2, 0)
(2, 0, 1)
(2, 1, 0)</
=== Iterative implementation ===
Line 5,653 ⟶ 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.
<
n = len(a)
i = n - 1
Line 5,691 ⟶ 8,126:
(1, 2, 0)
(2, 0, 1)
(2, 1, 0)</
=== Implementation using destructive list updates ===
<
def permutations(xs):
ac = [[]]
Line 5,708 ⟶ 8,143:
print(permutations([1,2,3,4]))
</syntaxhighlight>
===Functional :: type-preserving===
The '''itertools.permutations''' function is polymorphic in its inputs but not in its outputs – it discards the type of input lists and strings, coercing all inputs to tuples.
Line 5,716 ⟶ 8,151:
{{Works with|Python|3.7}}
<
from functools import (reduce)
Line 5,801 ⟶ 8,236:
# MAIN ---
if __name__ == '__main__':
main()</
{{Out}}
<pre>[1, 2, 3] -> [[1,2,3],[2,3,1],[3,1,2],[2,1,3],[1,3,2],[3,2,1]]
Line 5,809 ⟶ 8,244:
=={{header|Qi}}==
{{trans|Erlang}}
<syntaxhighlight lang="qi">
(define insert
L 0 E -> [E|L]
Line 5,828 ⟶ 8,263:
(insert P N H))
(seq 0 (length P))))
(permute T))))</
=={{header|Quackery}}==
===General Solution===
The word ''perms'' solves a more general task; generate permutations of between ''a'' and ''b'' items (inclusive) from the specified nest.
<syntaxhighlight lang="quackery"> [ stack ] is perms.min ( --> [ )
[ stack ] is perms.max ( --> [ )
forward is (perms)
[ over size
perms.min share > if
[ over temp take
swap nested join
temp put ]
over size
perms.max share < if
[ dup size times
[ 2dup i^ pluck
rot swap nested join
swap (perms) ] ]
2drop ] resolves (perms) ( [ [ --> )
[ perms.max put
1 - perms.min put
[] temp put
[] swap (perms)
temp take
perms.min release
perms.max release ] is perms ( [ a b --> [ )
[ dup size dup perms ] is permutations ( [ --> [ )
' [ 1 2 3 ] permutations echo cr
$ "quack" permutations 60 wrap$
$ "quack" 3 4 perms 46 wrap$</syntaxhighlight>
'''Output:'''
<pre>[ [ 1 2 3 ] [ 1 3 2 ] [ 2 1 3 ] [ 2 3 1 ] [ 3 1 2 ] [ 3 2 1 ] ]
quack quakc qucak qucka qukac qukca qauck qaukc qacuk qacku
qakuc qakcu qcuak qcuka qcauk qcaku qckua qckau qkuac qkuca
qkauc qkacu qkcua qkcau uqack uqakc uqcak uqcka uqkac uqkca
uaqck uaqkc uacqk uackq uakqc uakcq ucqak ucqka ucaqk ucakq
uckqa uckaq ukqac ukqca ukaqc ukacq ukcqa ukcaq aquck aqukc
aqcuk aqcku aqkuc aqkcu auqck auqkc aucqk auckq aukqc aukcq
acquk acqku acuqk acukq ackqu ackuq akquc akqcu akuqc akucq
akcqu akcuq cquak cquka cqauk cqaku cqkua cqkau cuqak cuqka
cuaqk cuakq cukqa cukaq caquk caqku cauqk caukq cakqu cakuq
ckqua ckqau ckuqa ckuaq ckaqu ckauq kquac kquca kqauc kqacu
kqcua kqcau kuqac kuqca kuaqc kuacq kucqa kucaq kaquc kaqcu
kauqc kaucq kacqu kacuq kcqua kcqau kcuqa kcuaq kcaqu kcauq
qua quac quak quc quca quck quk quka qukc qau
qauc qauk qac qacu qack qak qaku qakc qcu qcua
qcuk qca qcau qcak qck qcku qcka qku qkua qkuc
qka qkau qkac qkc qkcu qkca uqa uqac uqak uqc
uqca uqck uqk uqka uqkc uaq uaqc uaqk uac uacq
uack uak uakq uakc ucq ucqa ucqk uca ucaq ucak
uck uckq ucka ukq ukqa ukqc uka ukaq ukac ukc
ukcq ukca aqu aquc aquk aqc aqcu aqck aqk aqku
aqkc auq auqc auqk auc aucq auck auk aukq aukc
acq acqu acqk acu acuq acuk ack ackq acku akq
akqu akqc aku akuq akuc akc akcq akcu cqu cqua
cquk cqa cqau cqak cqk cqku cqka cuq cuqa cuqk
cua cuaq cuak cuk cukq cuka caq caqu caqk cau
cauq cauk cak cakq caku ckq ckqu ckqa cku ckuq
ckua cka ckaq ckau kqu kqua kquc kqa kqau kqac
kqc kqcu kqca kuq kuqa kuqc kua kuaq kuac kuc
kucq kuca kaq kaqu kaqc kau kauq kauc kac kacq
kacu kcq kcqu kcqa kcu kcuq kcua kca kcaq kcau</pre>
===An Uncommon Ordering===
Edit: I ''think'' this process is called "iterative deepening". Would love to have this confirmed or corrected.
The central idea is that given a list of the permutations of say 3 items, each permutation can be used to generate 4 of the permutations of 4 items, so for example, from <code>[ 3 1 2 ]</code> we can generate
::<code>[ 0 3 1 2 ]</code>
::<code>[ 3 0 1 2 ]</code>
::<code>[ 3 1 0 2 ]</code>
::<code>[ 3 1 2 0 ]</code>
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 described above (that is the inner <code>times</code> loop.)
'''Some aids to reading the code.'''
Quackery is a stack based language. If you are unfamiliar the with words <code>swap</code>, <code>rot</code>, <code>dup</code>, <code>2dup</code>, <code>dip</code>, <code>unrot</code> or <code>drop</code> they can be skimmed over as "noise" to get a gist of the process.
<code>[]</code> creates an empty nest <code>[ ]</code>.
<code>times</code> indicates that the word or nest following it is to be repeated a specified number of times. (The specified number is on the top of the stack, so <code>4 times [ ... ]</code>repeats some arbitrary code 4 times.)
<code>i</code> returns the number of times a <code>times</code> loop has left to repeat. It counts down to zero.
<code>i^</code> returns the number of times a <code>times</code> loop has been repeated. It counts up from zero.
<code>size</code> returns the number of items (words, numbers, nests) in a nest.
<code>witheach</code> indicates that the word or nest following it is to be repeated once for each item in a specified nest, with successive items from the nest available on the top of stack on each repetition.
<code>999 ' [ 10 11 12 13 ] 3 stuff</code> will return <code>[ 10 11 12 999 13 ]</code>by stuffing the number 999 into the 3rd position in the nest. (The start of a nest is the zeroth position, the end of this nest is the 5th position.)
<code>nested join</code> adds a nest to the end of a nest as its last item.
<syntaxhighlight lang="quackery"> [ ' [ [ ] ] swap times
[ [] i rot witheach
[ dup size 1+ times
[ 2dup i^ stuff
dip rot nested join
unrot ] drop ] drop ] ] is perms ( n --> [ )
4 perms witheach [ echo cr ]</syntaxhighlight>
{{out}}
<pre>[ 0 1 2 3 ]
[ 1 0 2 3 ]
[ 1 2 0 3 ]
[ 1 2 3 0 ]
[ 0 2 1 3 ]
[ 2 0 1 3 ]
[ 2 1 0 3 ]
[ 2 1 3 0 ]
[ 0 2 3 1 ]
[ 2 0 3 1 ]
[ 2 3 0 1 ]
[ 2 3 1 0 ]
[ 0 1 3 2 ]
[ 1 0 3 2 ]
[ 1 3 0 2 ]
[ 1 3 2 0 ]
[ 0 3 1 2 ]
[ 3 0 1 2 ]
[ 3 1 0 2 ]
[ 3 1 2 0 ]
[ 0 3 2 1 ]
[ 3 0 2 1 ]
[ 3 2 0 1 ]
[ 3 2 1 0 ]
</pre>
=={{header|R}}==
===Iterative version===
<
n <- length(a)
i <- n
Line 5,866 ⟶ 8,446:
}
unname(e)
}</
'''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</
===Recursive version===
<
linsert <- function(x,s) lapply(0:length(s), function(k) append(s,x,k))
Line 5,888 ⟶ 8,468:
# permutations of a vector s
permutation <- function(s) lapply(perm(length(s)), function(i) s[i])
</syntaxhighlight>
Output:
<
[[1]]
[1] "c" "b" "a"
Line 5,908 ⟶ 8,488:
[[6]]
[1] "a" "b" "c"</
=={{header|Racket}}==
<
#lang racket
Line 5,972 ⟶ 8,552:
(next-perm (permuter))))))
;; -> (A B C)(A C B)(B A C)(B C A)(C A B)(C B A)
</syntaxhighlight>
=={{header|Raku}}==
(formerly Perl 6)
{{works with|rakudo|2018.10}}
First, you can just use the built-in method on any list type.
<syntaxhighlight lang="raku" line>.say for <a b c>.permutations</syntaxhighlight>
{{out}}
<pre>a b c
a c b
b a c
b c a
c a b
c b a</pre>
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>></tt>.
<syntaxhighlight lang="raku" line>sub next_perm ( @a is copy ) {
my $j = @a.end - 1;
return Nil if --$j < 0 while @a[$j] after @a[$j+1];
my $aj = @a[$j];
my $k = @a.end;
$k-- while $aj after @a[$k];
@a[ $j, $k ] .= reverse;
my $r = @a.end;
my $s = $j + 1;
@a[ $r--, $s++ ] .= reverse while $r > $s;
return @a;
}
.say for [<a b c>], &next_perm ...^ !*;</syntaxhighlight>
{{out}}
<pre>a b c
a c b
b a c
b c a
c a b
c b a
</pre>
Here is another non-recursive implementation, which returns a lazy list. It also works with any type.
<syntaxhighlight lang="raku" line>sub permute(+@items) {
my @seq := 1..+@items;
gather for (^[*] @seq) -> $n is copy {
my @order;
for @seq {
unshift @order, $n mod $_;
$n div= $_;
}
my @i-copy = @items;
take map { |@i-copy.splice($_, 1) }, @order;
}
}
.say for permute( 'a'..'c' )</syntaxhighlight>
{{out}}
<pre>(a b c)
(a c b)
(b a c)
(b c a)
(c a b)
(c b a)</pre>
Finally, if you just want zero-based numbers, you can call the built-in function:
<syntaxhighlight lang="raku" line>.say for permutations(3);</syntaxhighlight>
{{out}}
<pre>0 1 2
0 2 1
1 0 2
1 2 0
2 0 1
2 1 0</pre>
=={{Header|RATFOR}}==
For translation to FORTRAN 77 with the public domain ratfor77 preprocessor.
<syntaxhighlight 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.
define(n, 3)
define(n_minus_1, 2)
implicit none
integer a(1:n)
integer c(1:n)
integer i, k
integer tmp
10000 format ('(', I1, n_minus_1(' ', I1), ')')
# Initialize the data to be permuted.
do i = 1, n {
a(i) = i
}
# What follows is a non-recursive Heap’s algorithm as presented by
# Sedgewick. Sedgewick neglects to fully initialize c, so I have
# corrected for that. Also I compute k without branching, by instead
# doing a little arithmetic.
do i = 1, n {
c(i) = 1
}
i = 2
write (*, 10000) a
while (i <= n) {
if (c(i) < i) {
k = mod (i, 2) + ((1 - mod (i, 2)) * c(i))
tmp = a(i)
a(i) = a(k)
a(k) = tmp
c(i) = c(i) + 1
i = 2
write (*, 10000) a
} else {
c(i) = 1
i = i + 1
}
}
end</syntaxhighlight>
Here is what the generated FORTRAN 77 code looks like:
<syntaxhighlight lang="fortran">C Output from Public domain Ratfor, version 1.0
implicit none
integer a(1: 3)
integer c(1: 3)
integer i, k
integer tmp
10000 format ('(', i1, 2(' ', i1), ')')
do23000 i = 1, 3
a(i) = i
23000 continue
23001 continue
do23002 i = 1, 3
c(i) = 1
23002 continue
23003 continue
i = 2
write (*, 10000) a
23004 if(i .le. 3)then
if(c(i) .lt. i)then
k = mod (i, 2) + ((1 - mod (i, 2)) * c(i))
tmp = a(i)
a(i) = a(k)
a(k) = tmp
c(i) = c(i) + 1
i = 2
write (*, 10000) a
else
c(i) = 1
i = i + 1
endif
goto 23004
endif
23005 continue
end</syntaxhighlight>
{{out}}
$ ratfor77 permutations.r > permutations.f && f2c permutations.f && cc -o permutations permutations.c -lf2c && ./permutations
<pre>(1 2 3)
(2 1 3)
(3 1 2)
(1 3 2)
(2 3 1)
(3 2 1)</pre>
=={{header|REXX}}==
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.
<
parse arg things bunch inbetweenChars names /*obtain optional arguments from the CL*/
if things=='' | things=="," then things= 3 /*Not specified? Then use the default.*/
if bunch=='' | bunch=="," then bunch= things /* " "
/* ╔════════════════════════════════════════════════════════════════╗ */
/* ║ inBetweenChars (optional) defaults to a [null]. ║ */
/* ║ names (optional) defaults to digits (and letters).║ */
/* ╚════════════════════════════════════════════════════════════════╝ */
call permSets things, bunch, inBetweenChars, names
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
p: return word( arg(1), 1)
/*──────────────────────────────────────────────────────────────────────────────────────*/
permSets: procedure; parse arg x,y,between,uSyms /*X things taken Y at a time. */
@.=;
@abc = 'abcdefghijklmnopqrstuvwxyz'; @abcU= @abc; upper @abcU
@abcS = @abcU || @abc; @0abcS= 123456789 || @abcS
do k=1 for x /*build a list of permutation symbols. */
_= p(word(uSyms, k) p(substr(@0abcS, k, 1) k) )
if length(_)\==1 then sep= '_'
$.k=
end /*k*/
if between=='' then between=
call .
return /* [↓] this is a recursive subroutine.*/
.
if ?>y then do; _= @.1; do j=2
end
else do q=1 for x /*build the permutation recursively. */
do k=1 for ?-1; if @.k==$.q then iterate q
end /*k*/
@.?= $.q; call .permSet ?+1
end /*q*/
return</syntaxhighlight>
{{out|output|text= when the following was used for input: <tt> 3 3 </tt>}}
<pre>
123
Line 6,019 ⟶ 8,770:
321
</pre>
<pre>
A---B---C---D
Line 6,046 ⟶ 8,797:
D---C---B---A
</pre>
<pre>
aardvark~gnu~stegosaurus
Line 6,074 ⟶ 8,825:
</pre>
==
<syntaxhighlight lang="ring">
load "stdlib.ring"
list = 1:4
lenList = len(list)
permut = []
for perm = 1 to factorial(len(list))
for i = 1 to len(list)
next
perm(list)
next
for n = 1 to len(permut)/lenList
for m = (n-1)*lenList+1 to n*lenList
see "" + permut[m]
if m < n*lenList
see ","
ok
next
see nl
next
func
elementcount = len(a)
if elementcount < 1 then return ok
Line 6,131 ⟶ 8,864:
a[pos] = a[last]
a[last] = temp
func
while first < last
temp = a[first]
Line 6,141 ⟶ 8,874:
last -= 1
end
</syntaxhighlight>
Output:
<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,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|Ring}}==
<syntaxhighlight lang="ring">
Another Solution
// Permutations -- Bert Mariani 2020-07-12
// Ask User for number of digits to permutate
? "Enter permutations number : " Give n
n = number(n)
x = 1:n // array
? "Permutations are : "
count = 0
nPermutation(1,n) //===>>> START
? " " // ? = print
? "Exiting of the program... "
? "Enter to Exit : " Give m // To Exit CMD window
//======================
// Returns true only if uniq number on row
Func Place(k,i)
for j=1 to k-1
if x[j] = i // Two numbers in same row
return 0
ok
next
return 1
//======================
Func nPermutation(k, n)
for i = 1 to n
if( Place(k,i)) //===>>> Call
x[k] = i
if(k=n)
See nl
for i= 1 to n
See " "+ x[i]
next
See " "+ (count++)
else
nPermutation(k+1,n) //===>>> Call RECURSION
ok
ok
next
return
</syntaxhighlight>
Output:
<pre>
Enter permutations number :
4
Permutations are :
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
Exiting of the program...
Enter to Exit :
</pre>
=={{header|Ruby}}==
<
{{out}}
<pre>
[[1, 2, 3], [1, 3, 2], [2, 1, 3], [2, 3, 1], [3, 1, 2], [3, 2, 1]]
</pre>
=={{header|Rust}}==
===Iterative===
Uses Heap's algorithm. An in-place version is possible but is incompatible with <code>Iterator</code>.
<
Permutations { idxs: (0..size).collect(), swaps: vec![0; size], i: 0 }
}
Line 6,265 ⟶ 9,044:
vec![2, 1, 0],
]);
}</
===Recursive===
<
fn permute<T, F: Fn(&[T])>(used: &mut Vec<T>, unused: &mut VecDeque<T>, action: &F) {
Line 6,285 ⟶ 9,064:
let mut queue = (1..4).collect::<VecDeque<_>>();
permute(&mut Vec::new(), &mut queue, &|perm| println!("{:?}", perm));
}</
=={{header|SAS}}==
<!-- oh god this code -->
<
data perm;
n=6;
Line 6,330 ⟶ 9,109:
return;
keep p1-p6;
run;</
=={{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:
<
{{out}}
Line 6,348 ⟶ 9,127:
The following function returns all the permutations of a list:
<
case Nil => List(Nil)
case xs => {
Line 6,358 ⟶ 9,137:
}
}
}</
If you need the unique permutations, use <code>distinct</code> or <code>toSet</code> on either the result or on the input.
Line 6,364 ⟶ 9,143:
=={{header|Scheme}}==
{{trans|Erlang}}
<
(if (= 0 n)
(cons e l)
Line 6,382 ⟶ 9,161:
(insert p n (car l)))
(seq 0 (length p))))
(permute (cdr l))))))</
{{trans|OCaml}}
<
(define (vector-swap! v i j)
(let ((tmp (vector-ref v i)))
Line 6,444 ⟶ 9,223:
; 1 2 0
; 2 0 1
; 2 1 0</
Completely recursive on lists:
<
(cond ((null? s) '())
((null? (cdr s)) (list s))
Line 6,456 ⟶ 9,235:
(splice (cons m l) (car r) (cdr r))))))))
(display (perm '(1 2 3)))</
=={{header|Seed7}}==
<
const type: permutations is array array integer;
Line 6,495 ⟶ 9,274:
writeln;
end for;
end func;</
{{out}}
<pre>
Line 6,505 ⟶ 9,284:
3 2 1
</pre>
=={{header|Shen}}==
<syntaxhighlight lang="shen">
(define permute
[] -> []
[X] -> [[X]]
X -> (permute-helper [] X))
(define permute-helper
_ [] -> []
Done [X|Rest] -> (append (prepend-all X (permute (append Done Rest))) (permute-helper [X|Done] Rest))
)
(define prepend-all
_ [] -> []
X [Next|Rest] -> [[X|Next]|(prepend-all X Rest)]
)
(set *maximum-print-sequence-size* 50)
(permute [a b c d])
</syntaxhighlight>
{{out}}
<pre>
[[a b c d] [a b d c] [a c b d] [a c d b] [a d c b] [a d b c] [b a c d] [b a d c] [b c a d] [b c d a] [b d c a] [b d a c] [c b a d] [c b d a] [c a b d] [c a d b] [c d a b] [c d b a] [d c b a] [d c a b] [d b c a] [d b a c] [d a b c] [d a c b]]
</pre>
For lexical order, make a small change:
<syntaxhighlight lang="shen">
(define permute-helper
_ [] -> []
Done [X|Rest] -> (append (prepend-all X (permute (append Done Rest))) (permute-helper (append Done [X]) Rest))
)
</syntaxhighlight>
=={{header|Sidef}}==
===Built-in===
<
say
}</
===Iterative===
<
var idx = @^n
loop {
callback(
var p = n-1
Line 6,533 ⟶ 9,345:
}
forperm({|*p| say p }, 3)</
===Recursive===
<
set
for i in ^set {
__FUNC__(callback, [
set[
], [perm..., set[i]])
}
Line 6,546 ⟶ 9,358:
}
permutations({|p| say p }, [0,1,2])</
{{out}}
<pre>
Line 6,560 ⟶ 9,372:
{{works with|Squeak}}
{{works with|Pharo}}
<
Transcript show: x printString; cr ].</
{{works with|GNU Smalltalk}}
<
ArrayedCollection extend [
Line 6,591 ⟶ 9,403:
[:g |
c map permuteAndDo: [g yield: (c copyFrom: 1 to: c size)]]]
</syntaxhighlight>
Use example:
<syntaxhighlight lang="smalltalk">
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>
=={{header|Stata}}==
Line 6,604 ⟶ 9,425:
For instance:
<syntaxhighlight lang
'''Program'''
<
local n=`1'
local r=1
Line 6,648 ⟶ 9,469:
} while (i > 1)
}
end</
=={{header|Swift}}==
<
return heaps(&ar, ar.count)
}
Line 6,665 ⟶ 9,486:
}
perms([1, 2, 3]) // [[1, 2, 3], [2, 1, 3], [3, 1, 2], [1, 3, 2], [2, 3, 1], [3, 2, 1]]</
=={{header|Tailspin}}==
This solution seems to be the same as the Kotlin solution. Permutations flow independently without being collected until the end.
<
templates permutations
when <=1> do [1] !
otherwise
def n: $;
templates expand
def p: $;
1..$n -> \(def k: $;
[$p(1..$k-1)..., $n, $p($k..
end expand
$n - 1 -> permutations -> expand !
end permutations
def alpha: ['ABCD'...];
[ $alpha::length -> permutations -> '$alpha($)...;' ] -> !OUT::write
</syntaxhighlight>
{{out}}
<pre>
Line 6,690 ⟶ 9,511:
</pre>
<
templates lexicalPermutations
when <=1> do [1] !
otherwise
def n: $;
def p: [ $n - 1 -> lexicalPermutations ];
1..$n -> \(def k: $;
end lexicalPermutations
def alpha: ['ABCD'...];
[ $alpha::length -> lexicalPermutations -> '$alpha($)...;' ] -> !OUT::write
</syntaxhighlight>
{{out}}
<pre>
[ABCD, ABDC, ACBD, ACDB, ADBC, ADCB, BACD, BADC, BCAD, BCDA, BDAC, BDCA, CABD, CADB, CBAD, CBDA, CDAB, CDBA, DABC, DACB, DBAC, DBCA, DCAB, DCBA]
</pre>
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
<syntaxhighlight lang="tailspin">
templates lexicalPermutations2
def N: $;
[[1]] -> #
when <[<[]($N)>]> do $... !
otherwise
def tails: $;
[1..$tails(1)::length+1 -> \(
def first: $;
$tails... -> [$first, $... -> \(when <$first..> do $+1! otherwise $!\)] !
\)] -> #
end lexicalPermutations2
def alpha: ['ABCD'...];
[ $alpha::length -> lexicalPermutations2 -> '$alpha($)...;' ] -> !OUT::write
</syntaxhighlight>
{{out}}
<pre>
Line 6,711 ⟶ 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.
<
templates perms
templates findPerms
when <$@perms::length..> do $@perms !
def index: $;
$index..$@perms::length
-> \(
@perms([$, $index]): $@perms([$index, $])...;
$index + 1 -> findPerms !
\) !
@perms([
end findPerms
@: [1..$];
1 -> findPerms !
end perms
def alpha: ['ABCD'...];
[4 -> perms -> '$alpha($)...;' ] -> !OUT::write
</syntaxhighlight>
{{out}}
<pre>
Line 6,738 ⟶ 9,580:
=={{header|Tcl}}==
{{tcllib|struct::list}}
<
# Make the sequence of digits to be permuted
Line 6,747 ⟶ 9,589:
struct::list foreachperm p $sequence {
puts $p
}</
Testing with <code>tclsh listPerms.tcl 3</code> produces this output:
<pre>
Line 6,757 ⟶ 9,599:
3 2 1
</pre>
=={{header|UNIX Shell}}==
{{works with|Bourne Again SHell}}
{{works with|Korn Shell}}
Straightforward implementation of Heap's algorithm operating in-place on an array local to the <tt>permute</tt> function.
<syntaxhighlight lang="bash">function permute {
if (( $# == 1 )); then
set -- $(seq $1)
fi
local A=("$@")
permuteAn "$#"
}
function permuteAn {
# print all permutations of first n elements of the array A, with remaining
# elements unchanged.
local -i n=$1 i
shift
if (( n == 1 )); then
printf '%s\n' "${A[*]}"
else
permuteAn $(( n-1 ))
for (( i=0; i<n-1; ++i )); do
local -i k
(( k=n%2 ? 0: i ))
local t=${A[k]}
A[k]=${A[n-1]}
A[n-1]=$t
permuteAn $(( n-1 ))
done
fi
}</syntaxhighlight>
For Zsh the array indices need to be bumped by 1 inside the <tt>permuteAn</tt> function:
{{works with|Z Shell}}
<syntaxhighlight lang="zsh">function permuteAn {
# print all permutations of first n elements of the array A, with remaining
# 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.
<
permutations =
Line 6,768 ⟶ 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</
test program:
<
test = permutations <1,2,3></
{{out}}
<pre><
Line 6,784 ⟶ 9,712:
=={{header|VBA}}==
{{trans|Pascal}}
<
'Generate, count and print (if printem is not false) all permutations of first n integers
Line 6,865 ⟶ 9,793:
Debug.Print "Number of permutations: "; count
End Sub</
{{out|Sample dialogue}}
<pre>
Line 6,902 ⟶ 9,830:
permute 10,False
Number of permutations: 3628800
</pre>
=={{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">
'permutation ,recursive
a=array("Hello",1,True,3.141592)
cnt=0
perm a,0
wscript.echo vbcrlf &"Count " & cnt
sub print(a)
s=""
for i=0 to ubound(a):
s=s &" " & a(i):
next:
wscript.echo s :
cnt=cnt+1 :
end sub
sub swap(a,b) t=a: a=b :b=t: end sub
sub perm(byval a,i)
if i=ubound(a) then print a: exit sub
for j= i to ubound(a)
swap a(i),a(j)
perm a,i+1
swap a(i),a(j)
next
end sub
</syntaxhighlight>
Output
<pre>
Hello 1 Verdadero 3.141592
Hello 1 3.141592 Verdadero
Hello Verdadero 1 3.141592
Hello Verdadero 3.141592 1
Hello 3.141592 Verdadero 1
Hello 3.141592 1 Verdadero
1 Hello Verdadero 3.141592
1 Hello 3.141592 Verdadero
1 Verdadero Hello 3.141592
1 Verdadero 3.141592 Hello
1 3.141592 Verdadero Hello
1 3.141592 Hello Verdadero
Verdadero 1 Hello 3.141592
Verdadero 1 3.141592 Hello
Verdadero Hello 1 3.141592
Verdadero Hello 3.141592 1
Verdadero 3.141592 Hello 1
Verdadero 3.141592 1 Hello
3.141592 1 Verdadero Hello
3.141592 1 Hello Verdadero
3.141592 Verdadero 1 Hello
3.141592 Verdadero Hello 1
3.141592 Hello Verdadero 1
3.141592 Hello 1 Verdadero
Count 24
</pre>
=={{header|Wren}}==
===Recursive===
{{trans|Kotlin}}
<syntaxhighlight lang="wren">var permute // recursive
permute = Fn.new { |input|
if (input.count == 1) return [input]
var perms = []
var toInsert = input[0]
for (perm in permute.call(input[1..-1])) {
for (i in 0..perm.count) {
var newPerm = perm.toList
newPerm.insert(i, toInsert)
perms.add(newPerm)
}
}
return perms
}
var input = [1, 2, 3]
var perms = permute.call(input)
System.print("There are %(perms.count) permutations of %(input), namely:\n")
perms.each { |perm| System.print(perm) }</syntaxhighlight>
{{out}}
<pre>
There are 6 permutations of [1, 2, 3], namely:
[1, 2, 3]
[2, 1, 3]
[2, 3, 1]
[1, 3, 2]
[3, 1, 2]
[3, 2, 1]
</pre>
===Iterative, lexicographical order===
{{trans|Go}}
{{libheader|Wren-math}}
Output modified to follow the pattern of the recursive version.
<syntaxhighlight lang="wren">import "./math" for Int
var input = [1, 2, 3]
var perms = [input]
var a = input.toList
var n = a.count - 1
for (c in 1...Int.factorial(n+1)) {
var i = n - 1
var j = n
while (a[i] > a[i+1]) i = i - 1
while (a[j] < a[i]) j = j - 1
var t = a[i]
a[i] = a[j]
a[j] = t
j = n
i = i + 1
while (i < j) {
t = a[i]
a[i] = a[j]
a[j] = t
i = i + 1
j = j - 1
}
perms.add(a.toList)
}
System.print("There are %(perms.count) permutations of %(input), namely:\n")
perms.each { |perm| System.print(perm) }</syntaxhighlight>
{{out}}
<pre>
There are 6 permutations of [1, 2, 3], namely:
[1, 2, 3]
[1, 3, 2]
[2, 1, 3]
[2, 3, 1]
[3, 1, 2]
[3, 2, 1]
</pre>
===Library based===
{{libheader|Wren-perm}}
<syntaxhighlight lang="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</syntaxhighlight>
{{out}}
<pre>
[[1, 2, 3], [1, 3, 2], [2, 1, 3], [2, 3, 1], [3, 2, 1], [3, 1, 2]]
[[1, 2, 3], [1, 3, 2], [2, 1, 3], [2, 3, 1], [3, 1, 2], [3, 2, 1]]
</pre>
=={{header|XPL0}}==
<
def N=4; \number of objects (letters)
char S0, S1(N);
Line 6,929 ⟶ 10,010:
[S0:= "rose "; \N different objects (letters)
Permute(0); \(space char avoids MSb termination)
]</
Output:
Line 6,961 ⟶ 10,042:
=={{header|zkl}}==
Using the solution from task [[Permutations by swapping#zkl]]:
<
L("rose","roes","reos","eros","erso","reso","rseo","rsoe","sroe","sreo",...)
Line 6,968 ⟶ 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),...)</
| |||