⚠️ Warning: This is a draft ⚠️
This means it might contain formatting issues, incorrect code, conceptual problems, or other severe issues.
If you want to help to improve and eventually enable this page, please fork RosettaGit's repository and open a merge request on GitHub.
{{task|Discrete math}}
;Task: Write a program that generates all [[wp:Permutation|permutations]] of '''n''' different objects. (Practically numerals!)
;Related tasks:
- [[Find the missing permutation]]
- [[Permutations/Derangements]]
{{Template:Combinations and permutations}}
360 Assembly
{{trans|Liberty BASIC}}
* Permutations 26/10/2015
PERMUTE CSECT
USING PERMUTE,R15 set base register
LA R9,TMP-A n=hbound(a)
SR R10,R10 nn=0
LOOP LA R10,1(R10) nn=nn+1
LA R11,PG pgi=@pg
LA R6,1 i=1
LOOPI1 CR R6,R9 do i=1 to n
BH ELOOPI1
LA R2,A-1(R6) @a(i)
MVC 0(1,R11),0(R2) output a(i)
LA R11,1(R11) pgi=pgi+1
LA R6,1(R6) i=i+1
B LOOPI1
ELOOPI1 XPRNT PG,80
LR R6,R9 i=n
LOOPUIM BCTR R6,0 i=i-1
LTR R6,R6 until i=0
BE ELOOPUIM
LA R2,A-1(R6) @a(i)
LA R3,A(R6) @a(i+1)
CLC 0(1,R2),0(R3) or until a(i)<a(i+1)
BNL LOOPUIM
ELOOPUIM LR R7,R6 j=i
LA R7,1(R7) j=i+1
LR R8,R9 k=n
LOOPWJ CR R7,R8 do while j<k
BNL ELOOPWJ
LA R2,A-1(R7) r2=@a(j)
LA R3,A-1(R8) r3=@a(k)
MVC TMP,0(R2) tmp=a(j)
MVC 0(1,R2),0(R3) a(j)=a(k)
MVC 0(1,R3),TMP a(k)=tmp
LA R7,1(R7) j=j+1
BCTR R8,0 k=k-1
B LOOPWJ
ELOOPWJ LTR R6,R6 if i>0
BNP ILE0
LR R7,R6 j=i
LA R7,1(R7) j=i+1
LOOPWA LA R2,A-1(R7) @a(j)
LA R3,A-1(R6) @a(i)
CLC 0(1,R2),0(R3) do while a(j)<a(i)
BNL AJGEAI
LA R7,1(R7) j=j+1
B LOOPWA
AJGEAI LA R2,A-1(R7) r2=@a(j)
LA R3,A-1(R6) r3=@a(i)
MVC TMP,0(R2) tmp=a(j)
MVC 0(1,R2),0(R3) a(j)=a(i)
MVC 0(1,R3),TMP a(i)=tmp
ILE0 LTR R6,R6 until i<>0
BNE LOOP
XR R15,R15 set return code
BR R14 return to caller
A DC C'ABCD' <== input
TMP DS C temp for swap
PG DC CL80' ' buffer
YREGS
END PERMUTE
{{out}}
ABCD ABDC ACBD ACDB ADBC ADCB BACD BADC BCAD BCDA BDAC BDCA CABD CADB CBAD CBDA CDAB CDBA DABC DACB DBAC DBCA DCAB DCBA ``` ## ABAP ```ABAP data: lv_flag type c, lv_number type i, lt_numbers type table of i. append 1 to lt_numbers. append 2 to lt_numbers. append 3 to lt_numbers. do. perform permute using lt_numbers changing lv_flag. if lv_flag = 'X'. exit. endif. loop at lt_numbers into lv_number. write (1) lv_number no-gap left-justified. if sy-tabix <> '3'. write ', '. endif. endloop. skip. enddo. " Permutation function - this is used to permute: " Can be used for an unbounded size set. form permute using iv_set like lt_numbers changing ev_last type c. data: lv_len type i, lv_first type i, lv_third type i, lv_count type i, lv_temp type i, lv_temp_2 type i, lv_second type i, lv_changed type c, lv_perm type i. describe table iv_set lines lv_len. lv_perm = lv_len - 1. lv_changed = ' '. " Loop backwards through the table, attempting to find elements which " can be permuted. If we find one, break out of the table and set the " flag indicating a switch. do. if lv_perm <= 0. exit. endif. " Read the elements. read table iv_set index lv_perm into lv_first. add 1 to lv_perm. read table iv_set index lv_perm into lv_second. subtract 1 from lv_perm. if lv_first < lv_second. lv_changed = 'X'. exit. endif. subtract 1 from lv_perm. enddo. " Last permutation. if lv_changed <> 'X'. ev_last = 'X'. exit. endif. " Swap tail decresing to get a tail increasing. lv_count = lv_perm + 1. do. lv_first = lv_len + lv_perm - lv_count + 1. if lv_count >= lv_first. exit. endif. read table iv_set index lv_count into lv_temp. read table iv_set index lv_first into lv_temp_2. modify iv_set index lv_count from lv_temp_2. modify iv_set index lv_first from lv_temp. add 1 to lv_count. enddo. lv_count = lv_len - 1. do. if lv_count <= lv_perm. exit. endif. read table iv_set index lv_count into lv_first. read table iv_set index lv_perm into lv_second. read table iv_set index lv_len into lv_third. if ( lv_first < lv_third ) and ( lv_first > lv_second ). lv_len = lv_count. endif. subtract 1 from lv_count. enddo. read table iv_set index lv_perm into lv_temp. read table iv_set index lv_len into lv_temp_2. modify iv_set index lv_perm from lv_temp_2. modify iv_set index lv_len from lv_temp. endform. ``` {{out}} ```txt 1, 3, 2 2, 1, 3 2, 3, 1 3, 1, 2 3, 2, 1 ``` ## Ada We split the task into two parts: The first part is to represent permutations, to initialize them and to go from one permutation to another one, until the last one has been reached. This can be used elsewhere, e.g., for the Topswaps [[http://rosettacode.org/wiki/Topswops]] task. The second part is to read the N from the command line, and to actually print all permutations over 1 .. N. ===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: ```ada generic N: positive; package Generic_Perm is subtype Element is Positive range 1 .. N; type Permutation is array(Element) of Element; 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: ```ada package body Generic_Perm is procedure Set_To_First(P: out Permutation; Is_Last: out Boolean) is begin for I in P'Range loop P (I) := I; end loop; Is_Last := P'Length = 1; -- if P has a single element, the fist permutation is the last one end Set_To_First; procedure Go_To_Next(P: in out Permutation; Is_Last: out Boolean) is procedure Swap (A, B : in out Integer) is C : Integer := A; begin A := B; B := C; end Swap; I, J, K : Element; begin -- find longest tail decreasing sequence -- after the loop, this sequence is I+1 .. n, -- and the ith element will be exchanged later -- with some element of the tail Is_Last := True; I := N - 1; loop if P (I) < P (I+1) then Is_Last := False; exit; end if; -- next instruction will raise an exception if I = 1, so -- exit now (this is the last permutation) exit when I = 1; I := I - 1; end loop; -- if all the elements of the permutation are in -- decreasing order, this is the last one if Is_Last then return; end if; -- sort the tail, i.e. reverse it, since it is in decreasing order J := I + 1; K := N; while J < K loop Swap (P (J), P (K)); J := J + 1; K := K - 1; end loop; -- find lowest element in the tail greater than the ith element J := N; while P (J) > P (I) loop J := J - 1; end loop; J := J + 1; -- exchange them -- this will give the next permutation in lexicographic order, -- since every element from ith to the last is minimum Swap (P (I), P (J)); end Go_To_Next; end Generic_Perm; ``` ===The procedure Print_Perms=== ```ada with Ada.Text_IO, Ada.Command_Line, Generic_Perm; procedure Print_Perms is package CML renames Ada.Command_Line; package TIO renames Ada.Text_IO; begin declare package Perms is new Generic_Perm(Positive'Value(CML.Argument(1))); P : Perms.Permutation; Done : Boolean := False; procedure Print(P: Perms.Permutation) is begin for I in P'Range loop TIO.Put (Perms.Element'Image (P (I))); end loop; TIO.New_Line; end Print; begin Perms.Set_To_First(P, Done); loop Print(P); exit when Done; Perms.Go_To_Next(P, Done); end loop; end; exception when Constraint_Error => TIO.Put_Line ("*** Error: enter one numerical argument n with n >= 1"); end Print_Perms; ``` {{out}} ```txt >./print_perms 3 1 2 3 1 3 2 2 1 3 2 3 1 3 1 2 3 2 1 3 2 1 ``` ## Aime ```aime void f1(record r, ...) { if (~r) { for (text s in r) { r.delete(s); rcall(f1, -2, 0, -1, s); r[s] = 0; } } else { ocall(o_, -2, 1, -1, " ", ","); o_newline(); } } main(...) { record r; ocall(r_put, -2, 1, -1, r, 0); f1(r); 0; } ``` {{Out}} ```txt aime permutations -a Aaa Bb C Aaa, Bb, C, Aaa, C, Bb, Bb, Aaa, C, Bb, C, Aaa, C, Aaa, Bb, C, Bb, Aaa, ``` ## ALGOL 68 {{works with|ALGOL 68|Revision 1 - one minor extension to language used - PRAGMA READ, similar to C's #include directive.}} {{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''' ```algol68 # -*- coding: utf-8 -*- # COMMENT REQUIRED BY "prelude_permutations.a68" MODE PERMDATA = ~; PROVIDES: # PERMDATA*=~* # # perm*=~ list* # END COMMENT MODE PERMDATALIST = REF[]PERMDATA; MODE PERMDATALISTYIELD = PROC(PERMDATALIST)VOID; # Generate permutations of the input data list of data list # PROC perm gen permutations = (PERMDATALIST data list, PERMDATALISTYIELD yield)VOID: ( # Warning: this routine does not correctly handle duplicate elements # IF LWB data list = UPB data list THEN yield(data list) ELSE FOR elem FROM LWB data list TO UPB data list DO PERMDATA first = data list[elem]; data list[LWB data list+1:elem] := data list[:elem-1]; data list[LWB data list] := first; # FOR PERMDATALIST next data list IN # perm gen permutations(data list[LWB data list+1:] # ) DO #, ## (PERMDATALIST next)VOID:( yield(data list) # OD #)); data list[:elem-1] := data list[LWB data list+1:elem]; data list[elem] := first OD FI ); SKIP ``` '''File: test_permutations.a68''' ```algol68 #!/usr/bin/a68g --script # # -*- coding: utf-8 -*- # CO REQUIRED BY "prelude_permutations.a68" CO MODE PERMDATA = INT; #PROVIDES:# # PERM*=INT* # # perm *=int list *# PR READ "prelude_permutations.a68" PR; main:( FLEX[0]PERMDATA test case := (1, 22, 333, 44444); INT upb data list = UPB test case; FORMAT data fmt := $g(0)$, data list fmt := $"("n(upb data list-1)(f(data fmt)", ")f(data fmt)")"$; # FOR DATALIST permutation IN # perm gen permutations(test case#) DO (#, ## (PERMDATALIST permutation)VOID:( printf((data list fmt, permutation, $l$)) # OD #)) ) ``` '''Output:''' ```txt (1, 22, 333, 44444) (1, 22, 44444, 333) (1, 333, 22, 44444) (1, 333, 44444, 22) (1, 44444, 22, 333) (1, 44444, 333, 22) (22, 1, 333, 44444) (22, 1, 44444, 333) (22, 333, 1, 44444) (22, 333, 44444, 1) (22, 44444, 1, 333) (22, 44444, 333, 1) (333, 1, 22, 44444) (333, 1, 44444, 22) (333, 22, 1, 44444) (333, 22, 44444, 1) (333, 44444, 1, 22) (333, 44444, 22, 1) (44444, 1, 22, 333) (44444, 1, 333, 22) (44444, 22, 1, 333) (44444, 22, 333, 1) (44444, 333, 1, 22) (44444, 333, 22, 1) ``` ## AppleScript ### Recursive {{trans|JavaScript}} (Functional ES6 version) Recursively, in terms of concatMap and delete: ```AppleScript -- PERMUTATIONS -------------------------------------------------------------- -- permutations :: [a] -> [[a]] on permutations(xs) script go on |λ|(xs) script h on |λ|(x) script ts on |λ|(ys) {{x} & ys} end |λ| end script concatMap(ts, go's |λ|(|delete|(x, xs))) end |λ| end script if {} ≠ xs then concatMap(h, xs) else {{}} end if end |λ| end script go's |λ|(xs) end permutations -- TEST ---------------------------------------------------------------------- on run permutations({"aardvarks", "eat", "ants"}) end run -- GENERIC FUNCTIONS --------------------------------------------------------- -- concatMap :: (a -> [b]) -> [a] -> [b] on concatMap(f, xs) set lst to {} set lng to length of xs tell mReturn(f) repeat with i from 1 to lng set lst to (lst & |λ|(contents of item i of xs, i, xs)) end repeat end tell return lst end concatMap -- delete :: a -> [a] -> [a] on |delete|(x, xs) if length of xs > 0 then set {h, t} to uncons(xs) if x = h then t else {h} & |delete|(x, t) end if else {} end if end |delete| -- Lift 2nd class handler function into 1st class script wrapper -- mReturn :: Handler -> Script on mReturn(f) if class of f is script then f else script property |λ| : f end script end if end mReturn -- uncons :: [a] -> Maybe (a, [a]) on uncons(xs) if length of xs > 0 then {item 1 of xs, rest of xs} else missing value end if end uncons ``` {{Out}} ```txt {{"aardvarks", "eat", "ants"}, {"aardvarks", "ants", "eat"}, {"eat", "aardvarks", "ants"}, {"eat", "ants", "aardvarks"}, {"ants", "aardvarks", "eat"}, {"ants", "eat", "aardvarks"}} ``` {{trans|Pseudocode}} (Fast recursive Heap's algorithm) ```AppleScript to DoPermutations(aList, n) --> Heaps's algorithm (Permutation by interchanging pairs) AppleScript by Jean.O.matiC if n = 1 then tell (a reference to Permlist) to copy aList to its end -- or: copy aList as text (for concatenated results) else repeat with i from 1 to n DoPermutations(aList, n - 1) if n mod 2 = 0 then -- n is even tell aList to set [item i, item n] to [item n, item i] -- swaps items i and n of aList else tell aList to set [item 1, item n] to [item n, item 1] -- swaps items 1 and n of aList end if set i to i + 1 end repeat end if return (a reference to Permlist) as list end DoPermutations --> Example 1 (list of words) set [SourceList, Permlist] to [{"Good", "Johnny", "Be"}, {}] DoPermutations(SourceList, SourceList's length) --> result (value of Permlist) {{"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, Permlist] to [{"X", "Y", "Z"}, {}] DoPermutations(SourceList, SourceList's length) --> result (value of Permlist) {"XYZ", "YXZ", "ZXY", "XZY", "YZX", "ZYX"} --> Example 3 (Integers) set [SourceList, Permlist] to [{1, 2, 3}, {}] DoPermutations(SourceList, SourceList's length) --> result (value of Permlist) {{1, 2, 3}, {2, 1, 3}, {3, 1, 2}, {1, 3, 2}, {2, 3, 1}, {3, 2, 1}} --> Example 4 (Integers with concatenated results) set [SourceList, Permlist] to [{1, 2, 3}, {}] 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): ```applescript -- permutations :: [a] -> [[a]] on permutations(xs) script go on |λ|(x, a) script on |λ|(ys) script infix on |λ|(n) if ys ≠ {} then take(n, ys) & {x} & drop(n, ys) else {x} end if end |λ| end script map(infix, enumFromTo(0, (length of ys))) end |λ| end script concatMap(result, a) end |λ| end script foldr(go, {{}}, xs) end permutations -- TEST --------------------------------------------------- on run permutations({1, 2, 3}) --> {{1, 2, 3}, {2, 1, 3}, {2, 3, 1}, {1, 3, 2}, {3, 1, 2}, {3, 2, 1}} end run -- GENERIC ------------------------------------------------ -- concatMap :: (a -> [b]) -> [a] -> [b] on concatMap(f, xs) set lng to length of xs set acc to {} tell mReturn(f) repeat with i from 1 to lng set acc to acc & |λ|(item i of xs, i, xs) end repeat end tell return acc end concatMap -- drop :: Int -> [a] -> [a] on drop(n, xs) if n < length of xs then items (1 + n) thru -1 of xs else {} end if end drop -- enumFromTo :: Int -> Int -> [Int] on enumFromTo(m, n) if m ≤ n then set lst to {} repeat with i from m to n set end of lst to i end repeat return lst else return {} end if end enumFromTo -- foldr :: (a -> b -> b) -> b -> [a] -> b on foldr(f, startValue, xs) tell mReturn(f) set v to startValue set lng to length of xs repeat with i from lng to 1 by -1 set v to |λ|(item i of xs, v, i, xs) end repeat return v end tell end foldr -- Lift 2nd class handler function into 1st class script wrapper -- mReturn :: First-class m => (a -> b) -> m (a -> b) on mReturn(f) if class of f is script then f else script property |λ| : f end script end if end mReturn -- map :: (a -> b) -> [a] -> [b] on map(f, xs) tell mReturn(f) set lng to length of xs set lst to {} repeat with i from 1 to lng set end of lst to |λ|(item i of xs, i, xs) end repeat return lst end tell end map -- min :: Ord a => a -> a -> a on min(x, y) if y < x then y else x end if end min -- take :: Int -> [a] -> [a] -- take :: Int -> String -> String on take(n, xs) if 0 < n then items 1 thru min(n, length of xs) of xs else {} end if end take ``` {{Out}} ```txt {{1, 2, 3}, {2, 1, 3}, {2, 3, 1}, {1, 3, 2}, {3, 1, 2}, {3, 2, 1}} ``` ## AutoHotkey from the forum topic http://www.autohotkey.com/forum/viewtopic.php?t=77959 ```AutoHotkey #NoEnv StringCaseSense On o := str := "Hello" Loop { str := perm_next(str) If !str { MsgBox % clipboard := o break } o.= "`n" . str } perm_Next(str){ p := 0, sLen := StrLen(str) Loop % sLen { If A_Index=1 continue t := SubStr(str, sLen+1-A_Index, 1) n := SubStr(str, sLen+2-A_Index, 1) If ( t < n ) { p := sLen+1-A_Index, pC := SubStr(str, p, 1) break } } If !p return false Loop { t := SubStr(str, sLen+1-A_Index, 1) If ( t > pC ) { n := sLen+1-A_Index, nC := SubStr(str, n, 1) break } } return SubStr(str, 1, p-1) . nC . Reverse(SubStr(str, p+1, n-p-1) . pC . SubStr(str, n+1)) } Reverse(s){ Loop Parse, s o := A_LoopField o return o } ``` {{out}}Hello Helol Heoll Hlelo Hleol Hlleo Hlloe Hloel Hlole Hoell Holel Holle eHllo eHlol eHoll elHlo elHol ellHo elloH eloHl elolH eoHll eolHl eollH lHelo lHeol lHleo lHloe lHoel lHole leHlo leHol lelHo leloH leoHl leolH llHeo llHoe lleHo lleoH lloHe lloeH loHel loHle loeHl loelH lolHe loleH oHell oHlel oHlle oeHll oelHl oellH olHel olHle oleHl olelH ollHe olleH ``` ### Alternate Version Alternate version to produce numerical permutations of combinations. ```ahk P(n,k="",opt=0,delim="",str="") { ; generate all n choose k permutations lexicographically ;1..n = range, or delimited list, or string to parse ; to process with a different min index, pass a delimited list, e.g. "0`n1`n2" ;k = length of result ;opt 0 = no repetitions ;opt 1 = with repetitions ;opt 2 = run for 1..k ;opt 3 = run for 1..k with repetitions ;str = string to prepend (used internally) ;returns delimited string, error message, or (if k > n) a blank string i:=0 If !InStr(n,"`n") If n in 2,3,4,5,6,7,8,9 Loop, %n% n := A_Index = 1 ? A_Index : n "`n" A_Index Else Loop, Parse, n, %delim% n := A_Index = 1 ? A_LoopField : n "`n" A_LoopField If (k = "") RegExReplace(n,"`n","",k), k++ If k is not Digit Return "k must be a digit." If opt not in 0,1,2,3 Return "opt invalid." If k = 0 Return str Else Loop, Parse, n, `n If (!InStr(str,A_LoopField) || opt & 1) s .= (!i++ ? (opt & 2 ? str "`n" : "") : "`n" ) . P(n,k-1,opt,delim,str . A_LoopField . delim) Return s } ``` {{out}} ```ahk MsgBox % P(3) ```--------------------------- permute.ahk --------------------------- 123 132 213 231 312 321 --------------------------- OK --------------------------- ``` ```ahk MsgBox % P("Hello",3) ```--------------------------- permute.ahk --------------------------- Hel Hel Heo Hle Hlo Hle Hlo Hoe Hol Hol eHl eHl eHo elH elo elH elo eoH eol eol lHe lHo leH leo loH loe lHe lHo leH leo loH loe oHe oHl oHl oeH oel oel olH ole olH ole --------------------------- OK --------------------------- ``` ```ahk MsgBox % P("2`n3`n4`n5",2,3) ```--------------------------- permute.ahk --------------------------- 2 22 23 24 25 3 32 33 34 35 4 42 43 44 45 5 52 53 54 55 --------------------------- OK --------------------------- ``` ```ahk MsgBox % P("11 a text ] u+z",3,0," ") ```--------------------------- permute.ahk --------------------------- 11 a text 11 a ] 11 a u+z 11 text a 11 text ] 11 text u+z 11 ] a 11 ] text 11 ] u+z 11 u+z a 11 u+z text 11 u+z ] a 11 text a 11 ] a 11 u+z a text 11 a text ] a text u+z a ] 11 a ] text a ] u+z a u+z 11 a u+z text a u+z ] text 11 a text 11 ] text 11 u+z text a 11 text a ] text a u+z text ] 11 text ] a text ] u+z text u+z 11 text u+z a text u+z ] ] 11 a ] 11 text ] 11 u+z ] a 11 ] a text ] a u+z ] text 11 ] text a ] text u+z ] u+z 11 ] u+z a ] u+z text u+z 11 a u+z 11 text u+z 11 ] u+z a 11 u+z a text u+z a ] u+z text 11 u+z text a u+z text ] u+z ] 11 u+z ] a u+z ] text --------------------------- OK --------------------------- ``` ## Arturo ```arturo print $(permutations #(1 2 3)) ``` {{out}} ```txt #(#(1 2 3) #(1 3 2) #(2 1 3) #(2 3 1) #(3 1 2) #(3 2 1)) ``` ## Batch File Recursive permutation generator. ```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 ``` {{out}} ```txt ABCD BACD CABD ACBD BCAD CBAD DBAC BDAC ADBC DABC BADC ABDC ACDB CADB DACB ADCB CDAB DCAB DCBA CDBA BDCA DBCA CBDA BCDA ``` ## BBC BASIC The procedure PROC_NextPermutation() will give the next lexicographic permutation of an integer array. ```bbcbasic DIM List%(3) List%() = 1, 2, 3, 4 FOR perm% = 1 TO 24 FOR i% = 0 TO DIM(List%(),1) PRINT List%(i%); NEXT PRINT PROC_NextPermutation(List%()) NEXT END DEF PROC_NextPermutation(A%()) LOCAL first, last, elementcount, pos elementcount = DIM(A%(),1) IF elementcount < 1 THEN ENDPROC pos = elementcount-1 WHILE A%(pos) >= A%(pos+1) pos -= 1 IF pos < 0 THEN PROC_Permutation_Reverse(A%(), 0, elementcount) ENDPROC ENDIF ENDWHILE last = elementcount WHILE A%(last) <= A%(pos) last -= 1 ENDWHILE SWAP A%(pos), A%(last) PROC_Permutation_Reverse(A%(), pos+1, elementcount) ENDPROC DEF PROC_Permutation_Reverse(A%(), first, last) WHILE first < last SWAP A%(first), A%(last) first += 1 last -= 1 ENDWHILE ENDPROC ``` '''Output:''' ```txt 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 ``` ## Bracmat ```bracmat ( perm = prefix List result original A Z . !arg:(?.) | !arg:(?prefix.?List:?original) & :?result & whl ' ( !List:%?A ?Z & !result perm$(!prefix !A.!Z):?result & !Z !A:~!original:?List ) & !result ) & out$(perm$(.a 2 "]" u+z); ``` Output: ```txt (a 2 ] u+z.) (a 2 u+z ].) (a ] u+z 2.) (a ] 2 u+z.) (a u+z 2 ].) (a u+z ] 2.) (2 ] u+z a.) (2 ] a u+z.) (2 u+z a ].) (2 u+z ] a.) (2 a ] u+z.) (2 a u+z ].) (] u+z a 2.) (] u+z 2 a.) (] a 2 u+z.) (] a u+z 2.) (] 2 u+z a.) (] 2 a u+z.) (u+z a 2 ].) (u+z a ] 2.) (u+z 2 ] a.) (u+z 2 a ].) (u+z ] a 2.) (u+z ] 2 a.) ``` ## C ### version 1 Non-recursive algorithm to generate all permutations. It prints objects in lexicographical order. ```c #includeint main (int argc, char *argv[]) { //here we check arguments if (argc < 2) { printf("Enter an argument. Example 1234 or dcba:\n"); return 0; } //it calculates an array's length int x; for (x = 0; argv[1][x] != '\0'; x++); //buble sort the array int f, v, m; for(f=0; f < x; f++) { for(v = x-1; v > f; v-- ) { if (argv[1][v-1] > argv[1][v]) { m=argv[1][v-1]; argv[1][v-1]=argv[1][v]; argv[1][v]=m; } } } //it calculates a factorial to stop the algorithm char a[x]; int k=0; int fact=k+1; while (k!=x) { a[k]=argv[1][k]; k++; fact = k*fact; } a[k]='\0'; //Main part: here we permutate int i, j; int y=0; char c; while (y != fact) { printf("%s\n", a); i=x-2; while(a[i] > a[i+1] ) i--; j=x-1; while(a[j] < a[i] ) j--; c=a[j]; a[j]=a[i]; a[i]=c; i++; for (j = x-1; j > i; i++, j--) { c = a[i]; a[i] = a[j]; a[j] = c; } y++; } } ``` ### version 2 Non-recursive algorithm to generate all permutations. It prints them from right to left. ```c #include int main() { char a[] = "4321"; //array int i, j; int f=24; //factorial char c; //buffer while (f--) { printf("%s\n", a); i=1; while(a[i] > a[i-1]) i++; j=0; while(a[j] < a[i])j++; c=a[j]; a[j]=a[i]; a[i]=c; i--; for (j = 0; j < i; i--, j++) { c = a[i]; a[i] = a[j]; a[j] = c; } } } ``` ### version 3 See [[wp:Permutation#Systematic_generation_of_all_permutations|lexicographic generation]] of permutations. ```c #include #include /* print a list of ints */ int show(int *x, int len) { int i; for (i = 0; i < len; i++) printf("%d%c", x[i], i == len - 1 ? '\n' : ' '); return 1; } /* next lexicographical permutation */ int next_lex_perm(int *a, int n) { # define swap(i, j) {t = a[i]; a[i] = a[j]; a[j] = t;} int k, l, t; /* 1. Find the largest index k such that a[k] < a[k + 1]. If no such index exists, the permutation is the last permutation. */ for (k = n - 1; k && a[k - 1] >= a[k]; k--); if (!k--) return 0; /* 2. Find the largest index l such that a[k] < a[l]. Since k + 1 is such an index, l is well defined */ for (l = n - 1; 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 */ for (k++, l = n - 1; l > k; l--, k++) swap(k, l); return 1; # undef swap } void perm1(int *x, int n, int callback(int *, int)) { do { if (callback) callback(x, n); } while (next_lex_perm(x, n)); } /* Boothroyd method; exactly N! swaps, about as fast as it gets */ void boothroyd(int *x, int n, int nn, int callback(int *, int)) { int c = 0, i, t; while (1) { if (n > 2) boothroyd(x, n - 1, nn, callback); if (c >= n - 1) return; i = (n & 1) ? 0 : c; c++; t = x[n - 1], x[n - 1] = x[i], x[i] = t; if (callback) callback(x, nn); } } /* entry for Boothroyd method */ void perm2(int *x, int n, int callback(int*, int)) { if (callback) callback(x, n); boothroyd(x, n, n, callback); } /* same as perm2, but flattened recursions into iterations */ void perm3(int *x, int n, int callback(int*, int)) { /* calloc isn't strictly necessary, int c[32] would suffice for most practical purposes */ int d, i, t, *c = calloc(n, sizeof(int)); /* curiously, with GCC 4.6.1 -O3, removing next line makes it ~25% slower */ if (callback) callback(x, n); for (d = 1; ; c[d]++) { while (d > 1) c[--d] = 0; while (c[d] >= d) if (++d >= n) goto done; t = x[ i = (d & 1) ? c[d] : 0 ], x[i] = x[d], x[d] = t; if (callback) callback(x, n); } done: free(c); } #define N 4 int main() { int i, x[N]; for (i = 0; i < N; i++) x[i] = i + 1; /* three different methods */ perm1(x, N, show); perm2(x, N, show); perm3(x, N, show); return 0; } ``` ### version 4 See [[wp:Permutation#Systematic_generation_of_all_permutations|lexicographic generation]] of permutations. ```c #include #include /* print a list of ints */ int show(int *x, int len) { int i; for (i = 0; i < len; i++) printf("%d%c", x[i], i == len - 1 ? '\n' : ' '); return 1; } /* next lexicographical permutation */ int next_lex_perm(int *a, int n) { # define swap(i, j) {t = a[i]; a[i] = a[j]; a[j] = t;} int k, l, t; /* 1. Find the largest index k such that a[k] < a[k + 1]. If no such index exists, the permutation is the last permutation. */ for (k = n - 1; k && a[k - 1] >= a[k]; k--); if (!k--) return 0; /* 2. Find the largest index l such that a[k] < a[l]. Since k + 1 is such an index, l is well defined */ for (l = n - 1; 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 */ for (k++, l = n - 1; l > k; l--, k++) swap(k, l); return 1; # undef swap } void perm1(int *x, int n, int callback(int *, int)) { do { if (callback) callback(x, n); } while (next_lex_perm(x, n)); } /* Boothroyd method; exactly N! swaps, about as fast as it gets */ void boothroyd(int *x, int n, int nn, int callback(int *, int)) { int c = 0, i, t; while (1) { if (n > 2) boothroyd(x, n - 1, nn, callback); if (c >= n - 1) return; i = (n & 1) ? 0 : c; c++; t = x[n - 1], x[n - 1] = x[i], x[i] = t; if (callback) callback(x, nn); } } /* entry for Boothroyd method */ void perm2(int *x, int n, int callback(int*, int)) { if (callback) callback(x, n); boothroyd(x, n, n, callback); } /* same as perm2, but flattened recursions into iterations */ void perm3(int *x, int n, int callback(int*, int)) { /* calloc isn't strictly necessary, int c[32] would suffice for most practical purposes */ int d, i, t, *c = calloc(n, sizeof(int)); /* curiously, with GCC 4.6.1 -O3, removing next line makes it ~25% slower */ if (callback) callback(x, n); for (d = 1; ; c[d]++) { while (d > 1) c[--d] = 0; while (c[d] >= d) if (++d >= n) goto done; t = x[ i = (d & 1) ? c[d] : 0 ], x[i] = x[d], x[d] = t; if (callback) callback(x, n); } done: free(c); } #define N 4 int main() { int i, x[N]; for (i = 0; i < N; i++) x[i] = i + 1; /* three different methods */ perm1(x, N, show); perm2(x, N, show); perm3(x, N, show); return 0; } ``` ## C++ The C++ standard library provides for this in the form of std::next_permutation
andstd::prev_permutation
. ```cpp #include#include #include #include template void print(const std::vector &vec) { for (typename std::vector ::const_iterator i = vec.begin(); i != vec.end(); ++i) { std::cout << *i; if ((i + 1) != vec.end()) std::cout << ","; } std::cout << std::endl; } int main() { //Permutations for strings std::string example("Hello"); std::sort(example.begin(), example.end()); do { std::cout << example << '\n'; } while (std::next_permutation(example.begin(), example.end())); // And for vectors std::vector another; another.push_back(1234); another.push_back(4321); another.push_back(1234); another.push_back(9999); std::sort(another.begin(), another.end()); do { print(another); } while (std::next_permutation(another.begin(), another.end())); return 0; } ``` {{out}} ```txt Hello Helol Heoll Hlelo Hleol Hlleo Hlloe Hloel Hlole Hoell Holel Holle eHllo eHlol eHoll elHlo elHol ellHo elloH eloHl elolH eoHll eolHl eollH lHelo lHeol lHleo lHloe lHoel lHole leHlo leHol lelHo leloH leoHl leolH llHeo llHoe lleHo lleoH lloHe lloeH loHel loHle loeHl loelH lolHe loleH oHell oHlel oHlle oeHll oelHl oellH olHel olHle oleHl olelH ollHe olleH 1234,1234,4321,9999 1234,1234,9999,4321 1234,4321,1234,9999 1234,4321,9999,1234 1234,9999,1234,4321 1234,9999,4321,1234 4321,1234,1234,9999 4321,1234,9999,1234 4321,9999,1234,1234 9999,1234,1234,4321 9999,1234,4321,1234 9999,4321,1234,1234 ``` ## C# Recursive Linq {{works with|C sharp|C#|7}} ```csharp>public static IEnumerable > Permutations values) { if (values.Count() == 1) return new [] {values}; return values.SelectMany(v => Permutations(values.Where(x=> x != v)),(v, p) => p.Prepend(v)); } ``` Usage ```sharp Enumerable.Range(0,5).Permutations() ``` A recursive Iterator. Runs under C#2 (VS2005), i.e. no `var`, no lambdas,... ```csharp>public class Permutations 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 ( array, delegate(T p) { return ++i != pick; } ); foreach (T[] restPermuted in AllFor(rest)) { i = -1; yield return System.Array.ConvertAll ( array, delegate(T p) { return ++i == 0 ? item : restPermuted[i - 1]; } ); } } } } } ``` Usage: ```c# namespace Permutations_On_RosettaCode { class Program { static void Main(string[] args) { string[] list = "a b c d".Split(); foreach (string[] permutation in Permutations .AllFor(list)) { System.Console.WriteLine(string.Join(" ", permutation)); } } } } ``` Recursive version ```c# 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; } } } } ``` Alternate recursive version ```c# 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]; } } } ``` ## Clojure ### Library function In an REPL: ```clojure user=> (require 'clojure.contrib.combinatorics) nil user=> (clojure.contrib.combinatorics/permutations [1 2 3]) ((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1)) ``` ### Explicit Replacing the call to the combinatorics library function by its real implementation. ```clojure (defn- iter-perm [v] (let [len (count v), j (loop [i (- len 2)] (cond (= i -1) nil (< (v i) (v (inc i))) i :else (recur (dec i))))] (when j (let [vj (v j), l (loop [i (dec len)] (if (< vj (v i)) i (recur (dec i))))] (loop [v (assoc v j (v l) l vj), k (inc j), l (dec len)] (if (< k l) (recur (assoc v k (v l) l (v k)) (inc k) (dec l)) v)))))) (defn- vec-lex-permutations [v] (when v (cons v (lazy-seq (vec-lex-permutations (iter-perm v)))))) (defn lex-permutations "Fast lexicographic permutation generator for a sequence of numbers" [c] (lazy-seq (let [vec-sorted (vec (sort c))] (if (zero? (count vec-sorted)) (list []) (vec-lex-permutations vec-sorted))))) (defn permutations "All the permutations of items, lexicographic by index" [items] (let [v (vec items)] (map #(map v %) (lex-permutations (range (count v)))))) (println (permutations [1 2 3])) ``` ## CoffeeScript ```coffeescript # Returns a copy of an array with the element at a specific position # removed from it. arrayExcept = (arr, idx) -> res = arr[0..] res.splice idx, 1 res # The actual function which returns the permutations of an array-like # object (or a proper array). permute = (arr) -> arr = Array::slice.call arr, 0 return [[]] if arr.length == 0 permutations = (for value,idx in arr [value].concat perm for perm in permute arrayExcept arr, idx) # 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}} ```coffeescript>coffee console.log (permute "123").join "\n" 1,2,3 1,3,2 2,1,3 2,3,1 3,1,2 3,2,1 ``` ## Common Lisp ```lisp (defun permute (list) (if list (mapcan #'(lambda (x) (mapcar #'(lambda (y) (cons x y)) (permute (remove x list)))) list) '(()))) ; else (print (permute '(A B Z))) ``` {{out}} ```txt ((A B Z) (A Z B) (B A Z) (B Z A) (Z A B) (Z B A)) ``` Lexicographic next permutation: ```lisp (defun next-perm (vec cmp) ; modify vector (declare (type (simple-array * (*)) vec)) (macrolet ((el (i) `(aref vec ,i)) (cmp (i j) `(funcall cmp (el ,i) (el ,j)))) (loop with len = (1- (length vec)) for i from (1- len) downto 0 when (cmp i (1+ i)) do (loop for k from len downto i when (cmp i k) do (rotatef (el i) (el k)) (setf k (1+ len)) (loop while (< (incf i) (decf k)) do (rotatef (el i) (el k))) (return-from next-perm vec))))) ;;; test code (loop for a = "1234" then (next-perm a #'char<) while a do (write-line a)) ``` ## Crystal ```Ruby puts [1, 2, 3].permutations ``` {{out}} ```txt [[1, 2, 3], [1, 3, 2], [2, 1, 3], [2, 3, 1], [3, 1, 2], [3, 2, 1]] ``` ## Curry ```curry insert :: a -> [a] -> [a] insert x xs = x : xs insert x (y:ys) = y : insert x ys permutation :: [a] -> [a] permutation [] = [] permutation (x:xs) = insert x $ permutation xs ``` ## D ### Simple Eager version Compile with -version=permutations1_main to see the output. ```d T[][] permutations(T)(T[] items) pure nothrow { T[][] result; void perms(T[] s, T[] prefix=[]) nothrow { if (s.length) foreach (immutable i, immutable c; s) perms(s[0 .. i] ~ s[i+1 .. $], prefix ~ c); else result ~= prefix; } perms(items); return result; } version (permutations1_main) { void main() { import std.stdio; writefln("%(%s\n%)", [1, 2, 3].permutations); } } ``` {{out}} ```txt [1, 2, 3] [1, 3, 2] [2, 1, 3] [2, 3, 1] [3, 1, 2] [3, 2, 1] ``` ### Fast Lazy Version Compiled with -version=permutations2_main
produces its output. ```d import std.algorithm, std.conv, std.traits; struct Permutations(bool doCopy=true, T) if (isMutable!T) { private immutable size_t num; private T[] items; private uint[31] indexes; private ulong tot; this (T[] items) pure nothrow @safe @nogc in { static enum string L = indexes.length.text; assert(items.length >= 0 && items.length <= indexes.length, "Permutations: items.length must be >= 0 && < " ~ L); } body { static ulong factorial(in size_t n) pure nothrow @safe @nogc { ulong result = 1; foreach (immutable i; 2 .. n + 1) result *= i; return result; } this.num = items.length; this.items = items; foreach (immutable i; 0 .. cast(typeof(indexes[0]))this.num) this.indexes[i] = i; this.tot = factorial(this.num); } @property T[] front() pure nothrow @safe { static if (doCopy) { return items.dup; } else return items; } @property bool empty() const pure nothrow @safe @nogc { return tot == 0; } @property size_t length() const pure nothrow @safe @nogc { // Not cached to keep the function pure. typeof(return) result = 1; foreach (immutable x; 1 .. items.length + 1) result *= x; return result; } void popFront() pure nothrow @safe @nogc { tot--; if (tot > 0) { size_t j = num - 2; while (indexes[j] > indexes[j + 1]) j--; size_t k = num - 1; while (indexes[j] > indexes[k]) k--; swap(indexes[k], indexes[j]); swap(items[k], items[j]); size_t r = num - 1; size_t s = j + 1; while (r > s) { swap(indexes[s], indexes[r]); swap(items[s], items[r]); r--; s++; } } } } Permutations!(doCopy,T) permutations(bool doCopy=true, T) (T[] items) pure nothrow if (isMutable!T) { return Permutations!(doCopy, T)(items); } version (permutations2_main) { void main() { import std.stdio, std.bigint; alias B = BigInt; foreach (p; [B(1), B(2), B(3)].permutations) assert((p[0] + 1) > 0); [1, 2, 3].permutations!false.writeln; [B(1), B(2), B(3)].permutations!false.writeln; } } ``` ### Standard Version ```d void main() { import std.stdio, std.algorithm; auto items = [1, 2, 3]; do items.writeln; while (items.nextPermutation); } ``` ## Delphi ```Delphi program TestPermutations; {$APPTYPE CONSOLE} type TItem = Integer; // declare ordinal type for array item TArray = array[0..3] of TItem; const Source: TArray = (1, 2, 3, 4); procedure Permutation(K: Integer; var A: TArray); var I, J: Integer; Tmp: TItem; begin for I:= Low(A) + 1 to High(A) + 1 do begin J:= K mod I; Tmp:= A[J]; A[J]:= A[I - 1]; A[I - 1]:= Tmp; K:= K div I; end; end; var A: TArray; I, K, Count: Integer; S, S1, S2: ShortString; begin Count:= 1; I:= Length(A); while I > 1 do begin Count:= Count * I; Dec(I); end; S:= ''; for K:= 0 to Count - 1 do begin A:= Source; Permutation(K, A); S1:= ''; for I:= Low(A) to High(A) do begin Str(A[I]:1, S2); S1:= S1 + S2; end; S:= S + ' ' + S1; if Length(S) > 40 then begin Writeln(S); S:= ''; end; end; if Length(S) > 0 then Writeln(S); Readln; end. ``` {{out}} ```txt 4123 4213 4312 4321 4132 4231 3421 3412 2413 1423 2431 1432 3142 3241 2341 1342 2143 1243 3124 3214 2314 1324 2134 1234 ``` ## Eiffel ```Eiffel class APPLICATION create make feature {NONE} make do test := <<2, 5, 1>> permute (test, 1) end test: ARRAY [INTEGER] permute (a: ARRAY [INTEGER]; k: INTEGER) -- All permutations of 'a'. require count_positive: a.count > 0 k_valid_index: k > 0 local t: INTEGER do if k = a.count then across a as ar loop io.put_integer (ar.item) end io.new_line else across k |..| a.count as c loop t := a [k] a [k] := a [c.item] a [c.item] := t permute (a, k + 1) t := a [k] a [k] := a [c.item] a [c.item] := t end end end end ``` {{out}} ```txt 251 215 521 512 152 125 ``` ## Elixir {{trans|Erlang}} ```elixir defmodule RC do def permute([]), do: [[]] def permute(list) do for x <- list, y <- permute(list -- [x]), do: [x|y] end end IO.inspect RC.permute([1, 2, 3]) ``` {{out}} ```txt [[1, 2, 3], [1, 3, 2], [2, 1, 3], [2, 3, 1], [3, 1, 2], [3, 2, 1]] ``` ## Erlang Shortest form: ```Erlang -module(permute). -export([permute/1]). permute([]) -> [[]]; permute(L) -> [[X|Y] || X<-L, Y<-permute(L--[X])]. ``` Y-combinator (for shell): ```Erlang F = fun(L) -> G = fun(_, []) -> [[]]; (F, L) -> [[X|Y] || X<-L, Y<-F(F, L--[X])] end, G(G, L) end. ``` More efficient zipper implementation: ```Erlang -module(permute). -export([permute/1]). permute([]) -> [[]]; permute(L) -> zipper(L, [], []). % Use zipper to pick up first element of permutation zipper([], _, Acc) -> lists:reverse(Acc); zipper([H|T], R, Acc) -> % place current member in front of all permutations % of rest of set - both sides of zipper prepend(H, permute(lists:reverse(R, T)), % pass zipper state for continuation T, [H|R], Acc). 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): ```Erlang main(_) -> io:fwrite("~p~n", [permute:permute([1,2,3])]). ``` {{out}} ```txt [[1,2,3],[1,3,2],[2,1,3],[2,3,1],[3,1,2],[3,2,1]] ``` ## Euphoria {{trans|PureBasic}} ```euphoria function reverse(sequence s, integer first, integer last) object x while first < last do x = s[first] s[first] = s[last] s[last] = x first += 1 last -= 1 end while return s end function function nextPermutation(sequence s) integer pos, last object x if length(s) < 1 then return 0 end if pos = length(s)-1 while compare(s[pos], s[pos+1]) >= 0 do pos -= 1 if pos < 1 then return -1 end if end while last = length(s) while compare(s[last], s[pos]) <= 0 do last -= 1 end while x = s[pos] s[pos] = s[last] s[last] = x return reverse(s, pos+1, length(s)) end function object s s = "abcd" puts(1, s & '\t') while 1 do s = nextPermutation(s) if atom(s) then exit end if puts(1, s & '\t') end while ``` {{out}} ```txt abcd abdc acbd acdb adbc adcb bacd badc bcad bcda bdac bdca cabd cadb cbad cbda cdab cdba dabc dacb dbac dbca dcab dcba ``` =={{header|F Sharp|F#}}== ```fsharp let rec insert left x right = seq { match right with | [] -> yield left @ [x] | head :: tail -> yield left @ [x] @ right yield! insert (left @ [head]) x tail } let rec perms permute = seq { match permute with | [] -> yield [] | head :: tail -> yield! Seq.collect (insert [] head) (perms tail) } [] let main argv = perms (Seq.toList argv) |> Seq.iter (fun x -> printf "%A\n" x) 0 ``` ```txt >RosettaPermutations 1 2 3 ["1"; "2"; "3"] ["2"; "1"; "3"] ["2"; "3"; "1"] ["1"; "3"; "2"] ["3"; "1"; "2"] ["3"; "2"; "1"] ``` Translation of Haskell "insertion-based approach" (last version) ```fsharp let permutations xs = let rec insert x = function | [] -> [[x]] | 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 ``` ## Factor The all-permutations word is part of factor's standard library. See http://docs.factorcode.org/content/word-all-permutations,math.combinatorics.html ## Fortran ```fortran program permutations implicit none integer, parameter :: value_min = 1 integer, parameter :: value_max = 3 integer, parameter :: position_min = value_min integer, parameter :: position_max = value_max integer, dimension (position_min : position_max) :: permutation call generate (position_min) contains recursive subroutine generate (position) implicit none integer, intent (in) :: position integer :: value if (position > position_max) then write (*, *) permutation else do value = value_min, value_max if (.not. any (permutation (: position - 1) == value)) then permutation (position) = value call generate (position + 1) end if end do end if end subroutine generate end program permutations ``` {{out}} ```txt 1 2 3 1 3 2 2 1 3 2 3 1 3 1 2 3 2 1 ``` ### Alternate solution Instead of looking up unused values, this program starts from [1, ..., n] and does only swaps, hence the array always represents a valid permutation. The values need to be "swapped back" after the recursive call. ```fortran program allperm implicit none integer :: n, i integer, allocatable :: a(:) read *, n allocate(a(n)) a = [ (i, i = 1, n) ] call perm(1) deallocate(a) contains recursive subroutine perm(i) integer :: i, j, t if (i == n) then print *, a else do j = i, n t = a(i) a(i) = a(j) a(j) = t call perm(i + 1) t = a(i) a(i) = a(j) a(j) = t end do end if end subroutine end program ``` ### Fortran Speed Test So ... what is the fastest algorithm? 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. ```fortran program testing_permutation_algorithms implicit none integer :: nmax integer, dimension(:),allocatable :: ida logical :: mtc logical :: even integer :: i integer(8) :: ic integer :: clock_rate, clock_max, t1, t2 real(8) :: dt integer :: pos_min, pos_max ! ! ! Beginning: ! write(*,*) 'INPUT N:' read *, nmax write(*,*) 'N =', nmax allocate ( ida(1:nmax) ) ! ! ! (1) Starting: ! do i = 1, nmax ida(i) = i enddo ! ic = 0 call system_clock ( t1, clock_rate, clock_max ) ! mtc = .false. ! do call subnexper ( nmax, ida, mtc, even ) ! ! 1) counting the number of permutatations ! ic = ic + 1 ! ! 2) writing out the result: ! ! do i = 1, nmax ! write (100,"(i3,',')",advance = "no") ida(i) ! enddo ! write(100,*) ! ! repeat if not being finished yet, otherwise exit. ! if (mtc) then cycle else exit endif ! enddo ! call system_clock ( t2, clock_rate, clock_max ) dt = ( dble(t2) - dble(t1) )/ dble(clock_rate) ! ! Finishing (1) ! write(*,*) "1) subnexper:" write(*,*) 'Total permutations :', ic write(*,*) 'Total time elapsed :', dt ! ! ! (2) Starting: ! do i = 1, nmax ida(i) = i enddo ! pos_min = 1 pos_max = nmax ! ic = 0 call system_clock ( t1, clock_rate, clock_max ) ! call generate ( pos_min ) ! call system_clock ( t2, clock_rate, clock_max ) dt = ( dble(t2) - dble(t1) )/ dble(clock_rate) ! ! Finishing (2) ! write(*,*) "2) generate:" write(*,*) 'Total permutations :', ic write(*,*) 'Total time elapsed :', dt ! ! ! (3) Starting: ! do i = 1, nmax ida(i) = i enddo ! ic = 0 call system_clock ( t1, clock_rate, clock_max ) ! i = 1 call perm ( i ) ! call system_clock ( t2, clock_rate, clock_max ) dt = ( dble(t2) - dble(t1) )/ dble(clock_rate) ! ! Finishing (3) ! write(*,*) "3) perm:" write(*,*) 'Total permutations :', ic write(*,*) 'Total time elapsed :', dt ! ! ! (4) Starting: ! do i = 1, nmax ida(i) = i enddo ! ic = 0 call system_clock ( t1, clock_rate, clock_max ) ! do ! ! 1) counting the number of permutatations ! ic = ic + 1 ! ! 2) writing out the result: ! ! do i = 1, nmax ! write (100,"(i3,',')",advance = "no") ida(i) ! enddo ! write(100,*) ! ! repeat if not being finished yet, otherwise exit. ! if ( nextp(nmax,ida) ) then cycle else exit endif ! enddo ! call system_clock ( t2, clock_rate, clock_max ) dt = ( dble(t2) - dble(t1) )/ dble(clock_rate) ! ! Finishing (4) ! write(*,*) "4) nextp:" write(*,*) 'Total permutations :', ic write(*,*) 'Total time elapsed :', dt ! ! ! What's else? ! ... ! !== deallocate(ida) ! stop !== contains !== ! Modified version of SUBROUTINE NEXPER from the book of ! Albert Nijenhuis and Herbert S. Wilf, "Combinatorial ! Algorithms For Computers and Calculators", 2nd Ed, p.59. ! subroutine subnexper ( n, a, mtc, even ) implicit none integer,intent(in) :: n integer,dimension(n),intent(inout) :: a logical,intent(inout) :: mtc, even ! ! local varialbes: ! integer,save :: nm3 integer :: ia, i, s, d, i1, l, j, m ! if (mtc) goto 10 nm3 = n-3 do i = 1,n a(i) = i enddo mtc = .true. 5 even = .true. if ( n .eq. 1 ) goto 8 6 if ( a(n) .ne. 1 .or. a(1) .ne. 2+mod(n,2) ) return if ( n .le. 3 ) goto 8 do i = 1,nm3 if( a(i+1) .ne. a(i)+1 ) return enddo 8 mtc = .false. return 10 if ( n .eq. 1 ) goto 27 if( .not. even ) goto 20 ia = a(1) a(1) = a(2) a(2) = ia even = .false. goto 6 20 s = 0 do i1 = 2,n ia = a(i1) i = i1-1 d = 0 do j = 1,i if ( a(j) .gt. ia ) d = d+1 enddo s = d+s if ( d .ne. i*mod(s,2) ) goto 35 enddo 27 a(1) = 0 goto 8 35 m = mod(s+1,2)*(n+1) do j = 1,i if(isign(1,a(j)-ia) .eq. isign(1,a(j)-m)) cycle m = a(j) l = j enddo a(l) = ia a(i1) = m even = .true. return end subroutine !===== ! ! http://rosettacode.org/wiki/Permutations#Fortran ! recursive subroutine generate (pos) implicit none integer,intent(in) :: pos integer :: val if (pos > pos_max) then ! ! 1) counting the number of permutatations ! ic = ic + 1 ! ! 2) writing out the result: ! ! write (*,*) permutation ! else do val = 1, nmax if (.not. any (ida( : pos-1) == val)) then ida(pos) = val call generate (pos + 1) endif enddo endif end subroutine !===== ! ! http://rosettacode.org/wiki/Permutations#Fortran ! recursive subroutine perm (i) implicit none integer,intent(inout) :: i ! integer :: j, t, ip1 ! if (i == nmax) then ! ! 1) couting the number of permutatations ! ic = ic + 1 ! ! 2) writing out the result: ! ! write (*,*) a ! else ip1 = i+1 do j = i, nmax t = ida(i) ida(i) = ida(j) ida(j) = t call perm ( ip1 ) t = ida(i) ida(i) = ida(j) ida(j) = t enddo endif return end subroutine !===== ! ! http://rosettacode.org/wiki/Permutations#Fortran ! function nextp ( n, a ) logical :: nextp integer,intent(in) :: n integer,dimension(n),intent(inout) :: a ! ! local variables: ! integer i,j,k,t ! i = n-1 10 if ( a(i) .lt. a(i+1) ) goto 20 i = i-1 if ( i .eq. 0 ) goto 20 goto 10 20 j = i+1 k = n 30 t = a(j) a(j) = a(k) a(k) = t j = j+1 k = k-1 if ( j .lt. k ) goto 30 j = i if (j .ne. 0 ) goto 40 ! nextp = .false. ! return ! 40 j = j+1 if ( a(j) .lt. a(i) ) goto 40 t = a(i) a(i) = a(j) a(j) = t ! nextp = .true. ! return end function !===== ! ! What's else ? ! ... !===== end program ``` An example of performance: 1) Compiled with GNU fortran compiler: gfortran -O3 testing_permutation_algorithms.f90 ; ./a.out INPUT N: 10 N = 10 1) subnexper: Total permutations : 3628800 Total time elapsed : 4.9000000000000002E-002 2) generate: Total permutations : 3628800 Total time elapsed : 0.84299999999999997 3) perm: Total permutations : 3628800 Total time elapsed : 5.6000000000000001E-002 4) nextp: Total permutations : 3628800 Total time elapsed : 2.9999999999999999E-002 b) Compiled with Intel compiler: ifort -O3 testing_permutation_algorithms.f90 ; ./a.out INPUT N: 10 N = 10 1) subnexper: Total permutations : 3628800 Total time elapsed : 8.240000000000000E-002 2) generate: Total permutations : 3628800 Total time elapsed : 0.616200000000000 3) perm: Total permutations : 3628800 Total time elapsed : 5.760000000000000E-002 4) nextp: Total permutations : 3628800 Total time elapsed : 3.600000000000000E-002 So far, we have conclusion from the above performance: 1) subnexper is the 3rd fast with ifort and the 2nd with gfortran. 2) generate is the slowest one with not only ifort but gfortran. 3) perm is the 2nd fast one with ifort and the 3rd one with gfortran. 4) nextp is the fastest one with both ifort and gfortran (the winner in this test). Note: It is worth mentioning that the performance of this test is dependent not only on algorithm, but also on computer where the test runs. Therefore we should run the test on our own computer and make conclusion by ourselves. ### Fortran 77 Here is an alternate, iterative version in Fortran 77. {{trans|Ada}} ```fortran program nptest integer n,i,a logical nextp external nextp parameter(n=4) dimension a(n) do i=1,n a(i)=i enddo 10 print *,(a(i),i=1,n) if(nextp(n,a)) go to 10 end function nextp(n,a) integer n,a,i,j,k,t logical nextp dimension a(n) i=n-1 10 if(a(i).lt.a(i+1)) go to 20 i=i-1 if(i.eq.0) go to 20 go to 10 20 j=i+1 k=n 30 t=a(j) a(j)=a(k) a(k)=t j=j+1 k=k-1 if(j.lt.k) go to 30 j=i if(j.ne.0) go to 40 nextp=.false. return 40 j=j+1 if(a(j).lt.a(i)) go to 40 t=a(i) a(i)=a(j) a(j)=t nextp=.true. end ``` ## FreeBASIC ```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 ``` {{out}} ```txt 1234 2134 3124 1324 2314 3214 4213 2413 1423 4123 2143 1243 1342 3142 4132 1432 3412 4312 4321 3421 2431 4231 3241 2341 ``` ## GAP GAP can handle permutations and groups. Here is a straightforward implementation : for each permutation p in S(n) (symmetric group), 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. ```gap>gap List(SymmetricGroup(4), p -> Permuted([1 .. 4], p)); perms(4); [ [ 1, 2, 3, 4 ], [ 4, 2, 3, 1 ], [ 2, 4, 3, 1 ], [ 3, 2, 4, 1 ], [ 1, 4, 3, 2 ], [ 4, 1, 3, 2 ], [ 2, 1, 3, 4 ], [ 3, 1, 4, 2 ], [ 1, 3, 4, 2 ], [ 4, 3, 1, 2 ], [ 2, 3, 1, 4 ], [ 3, 4, 1, 2 ], [ 1, 2, 4, 3 ], [ 4, 2, 1, 3 ], [ 2, 4, 1, 3 ], [ 3, 2, 1, 4 ], [ 1, 4, 2, 3 ], [ 4, 1, 2, 3 ], [ 2, 1, 4, 3 ], [ 3, 1, 2, 4 ], [ 1, 3, 2, 4 ], [ 4, 3, 2, 1 ], [ 2, 3, 4, 1 ], [ 3, 4, 2, 1 ] ] ``` GAP has also built-in functions to get permutations ```gap # All arrangements of 4 elements in 1 .. 4 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: ```gap NextPermutation := function(a) local i, j, k, n, t; n := Length(a); i := n - 1; while i > 0 and a[i] > a[i + 1] do i := i - 1; od; j := i + 1; k := n; while j < k do t := a[j]; a[j] := a[k]; a[k] := t; j := j + 1; k := k - 1; od; if i = 0 then return false; else j := i + 1; while a[j] < a[i] do j := j + 1; od; t := a[i]; a[i] := a[j]; a[j] := t; return true; fi; end; Permutations := function(n) local a, L; a := List([1 .. n], x -> x); L := [ ]; repeat Add(L, ShallowCopy(a)); until not NextPermutation(a); return L; end; Permutations(3); [ [ 1, 2, 3 ], [ 1, 3, 2 ], [ 2, 1, 3 ], [ 2, 3, 1 ], [ 3, 1, 2 ], [ 3, 2, 1 ] ] ``` ## Glee ```glee $$ n !! k dyadic: Permutations for k out of n elements (in this case k = n) $$ #s monadic: number of elements in s $$ ,, monadic: expose with space-lf separators $$ s[n] index n of s 'Hello' 123 7.9 '•'=>s; s[s# !! (s#)],, ``` Result: ```glee Hello 123 7.9 • Hello 123 • 7.9 Hello 7.9 123 • Hello 7.9 • 123 Hello • 123 7.9 Hello • 7.9 123 123 Hello 7.9 • 123 Hello • 7.9 123 7.9 Hello • 123 7.9 • Hello 123 • Hello 7.9 123 • 7.9 Hello 7.9 Hello 123 • 7.9 Hello • 123 7.9 123 Hello • 7.9 123 • Hello 7.9 • Hello 123 7.9 • 123 Hello • Hello 123 7.9 • Hello 7.9 123 • 123 Hello 7.9 • 123 7.9 Hello • 7.9 Hello 123 • 7.9 123 Hello ``` ## Go ### recursive ```go package main import "fmt" func main() { demoPerm(3) } func demoPerm(n int) { // create a set to permute. for demo, use the integers 1..n. s := make([]int, n) for i := range s { s[i] = i + 1 } // permute them, calling a function for each permutation. // for demo, function just prints the permutation. permute(s, func(p []int) { fmt.Println(p) }) } // permute function. takes a set to permute and a function // to call for each generated permutation. func permute(s []int, emit func([]int)) { if len(s) == 0 { emit(s) return } // Steinhaus, implemented with a recursive closure. // arg is number of positions left to permute. // pass in len(s) to start generation. // on each call, weave element at pp through the elements 0..np-2, // then restore array to the way it was. var rc func(int) rc = func(np int) { if np == 1 { emit(s) return } np1 := np - 1 pp := len(s) - np1 // weave rc(np1) for i := pp; i > 0; i-- { s[i], s[i-1] = s[i-1], s[i] rc(np1) } // restore w := s[0] copy(s, s[1:pp+1]) s[pp] = w } rc(len(s)) } ``` {{out}} ```txt [1 2 3] [1 3 2] [3 1 2] [2 1 3] [2 3 1] [3 2 1] ``` === non-recursive, lexicographical order === ```go package main import "fmt" func main() { var a = []int{1, 2, 3} fmt.Println(a) var n = len(a) - 1 var i, j int for c := 1; c < 6; c++ { // 3! = 6: i = n - 1 j = n for a[i] > a[i+1] { i-- } for a[j] < a[i] { j-- } a[i], a[j] = a[j], a[i] j = n i += 1 for i < j { a[i], a[j] = a[j], a[i] i++ j-- } fmt.Println(a) } } ``` {{out}} ```txt [1 2 3] [1 3 2] [2 1 3] [2 3 1] [3 1 2] [3 2 1] ``` ## Groovy Solution: ```groovy def makePermutations = { l -> l.permutations() } ``` Test: ```groovy def list = ['Crosby', 'Stills', 'Nash', 'Young'] def permutations = makePermutations(list) assert permutations.size() == (1..<(list.size()+1)).inject(1) { prod, i -> prod*i } permutations.each { println it } ``` {{out}} [Young, Crosby, Stills, Nash] [Crosby, Stills, Young, Nash] [Nash, Crosby, Young, Stills] [Stills, Nash, Crosby, Young] [Young, Stills, Crosby, Nash] [Stills, Crosby, Nash, Young] [Stills, Crosby, Young, Nash] [Stills, Young, Nash, Crosby] [Nash, Stills, Young, Crosby] [Crosby, Young, Nash, Stills] [Crosby, Nash, Young, Stills] [Crosby, Nash, Stills, Young] [Nash, Young, Stills, Crosby] [Young, Nash, Stills, Crosby] [Nash, Young, Crosby, Stills] [Young, Stills, Nash, Crosby] [Crosby, Stills, Nash, Young] [Stills, Young, Crosby, Nash] [Young, Nash, Crosby, Stills] [Nash, Stills, Crosby, Young] [Young, Crosby, Nash, Stills] [Nash, Crosby, Stills, Young] [Crosby, Young, Stills, Nash] [Stills, Nash, Young, Crosby] ``` ## Haskell ```haskell import Data.List (permutations) main = mapM_ print (permutations [1,2,3]) ``` A simple implementation, that assumes elements are unique and support equality: ```haskell import Data.List (delete) 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: ```haskell permutations :: [a] -> [[a]] permutations [] = [[]] permutations xs = [ y:zs | (y,ys) <- select xs, zs <- permutations ys] where select [] = [] select (x:xs) = (x,xs) : [ (y,x:ys) | (y,ys) <- select xs ] ``` The above are all selection-based approaches. The following is an insertion-based approach: ```haskell permutations :: [a] -> [[a]] permutations = foldr (concatMap . insertEverywhere) [[]] where insertEverywhere :: a -> [a] -> [[a]] insertEverywhere x [] = [[x]] insertEverywhere x l@(y:ys) = (x:l) : map (y:) (insertEverywhere x ys) ``` A serialized version: {{Trans|Mathematica}} ```haskell permutations :: [a] -> [[a]] permutations = foldr (\x ac -> ac >>= (fmap . ins x) <*> (enumFromTo 0 . length)) [[]] where ins x xs n = let (a, b) = splitAt n xs in a ++ x : b main :: IO () main = print $ permutations [1, 2, 3] ``` {{Out}} ```txt [[1,2,3],[2,3,1],[3,1,2],[2,1,3],[1,3,2],[3,2,1]] ``` =={{header|Icon}} and {{header|Unicon}}== ```unicon procedure main(A) every p := permute(A) do every writes((!p||" ")|"\n") end procedure permute(A) if *A <= 1 then return A suspend [(A[1]<->A[i := 1 to *A])] ||| permute(A[2:0]) end ``` {{out}} ```txt ->permute Aardvarks eat ants Aardvarks eat ants Aardvarks ants eat eat Aardvarks ants eat ants Aardvarks ants eat Aardvarks ants Aardvarks eat -> ``` =={{header|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 ``` ## J ```j perms=: A.&i.~ ! ``` {{out|Example use}} ```j perms 2 0 1 1 0 ({~ perms@#)&.;: 'some random text' some random text some text random random some text random text some text some random text random some ``` ## Java Using the code of Michael Gilleland. ```java public class PermutationGenerator { private int[] array; private int firstNum; private boolean firstReady = false; public PermutationGenerator(int n, int firstNum_) { if (n < 1) { throw new IllegalArgumentException("The n must be min. 1"); } firstNum = firstNum_; array = new int[n]; reset(); } public void reset() { for (int i = 0; i < array.length; i++) { array[i] = i + firstNum; } firstReady = false; } public boolean hasMore() { boolean end = firstReady; for (int i = 1; i < array.length; i++) { end = end && array[i] < array[i-1]; } return !end; } public int[] getNext() { if (!firstReady) { firstReady = true; return array; } int temp; int j = array.length - 2; int k = array.length - 1; // Find largest index j with a[j] < a[j+1] for (;array[j] > array[j+1]; j--); // Find index k such that a[k] is smallest integer // greater than a[j] to the right of a[j] for (;array[j] > array[k]; k--); // Interchange a[j] and a[k] temp = array[k]; array[k] = array[j]; array[j] = temp; // Put tail end of permutation after jth position in increasing order int r = array.length - 1; int s = j + 1; while (r > s) { temp = array[s]; array[s++] = array[r]; array[r--] = temp; } return array; } // getNext() // For testing of the PermutationGenerator class public static void main(String[] args) { PermutationGenerator pg = new PermutationGenerator(3, 1); while (pg.hasMore()) { int[] temp = pg.getNext(); for (int i = 0; i < temp.length; i++) { System.out.print(temp[i] + " "); } System.out.println(); } } } // class ``` {{out}} ```txt 1 2 3 1 3 2 2 1 3 2 3 1 3 1 2 3 2 1 ``` '''optimized''' Following needs: [[User:Margusmartsepp/Contributions/Java/Utils.java|Utils.java]] ```java public class Permutations { public static void main(String[] args) { System.out.println(Utils.Permutations(Utils.mRange(1, 3))); } } ``` {{out}} ```txt [[1, 2, 3], [1, 3, 2], [2, 1, 3], [2, 3, 1], [3, 1, 2], [3, 2, 1]] ``` ## JavaScript ### ES5 ### =Iteration= Copy the following as an HTML file and load in a browser. ```javascript> Permutations ```