Permutations
You are encouraged to solve this task according to the task description, using any language you may know.
Write a program which generates the all permutations of n different objects. (Practically numerals!)
(c.f. Find the missing permutation )
Ada
<lang ada>-- perm.adb -- print all permutations of 1 .. n -- where n is given as a command line argument -- to compile with gnat : gnatmake perm.adb -- to call : perm n with ada.text_io, ada.command_line;
procedure perm is
use ada.text_io, ada.command_line; n : integer;
begin
if argument_count /= 1 then put_line (command_name & " n (with n >= 1)"); return; else n := integer'value (argument (1)); end if; declare subtype element is integer range 1 .. n; type permutation is array (element'range) of element; p : permutation; is_last : boolean := false; -- compute next permutation in lexicographic order -- iterative algorithm : -- find longest tail-decreasing sequence in p -- the elements from this tail cannot be permuted to get a new permutation, so -- reverse this tail, to start from an increaing sequence, and -- exchange the element x preceding the tail, with the minimum value in the tail, -- that is also greater than x procedure next is i, j, k, t : 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 t := p (j); p (j) := p (k); p (k) := t; 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 t := p (i); p (i) := p (j); p (j) := t; end next; procedure print is begin for i in element'range loop put (integer'image (p (i))); end loop; new_line; end print; -- initialize the permutation procedure init is begin for i in element'range loop p (i) := i; end loop; end init;
begin init; loop print; next; exit when is_last; end loop; end;
end perm;</lang>
C
Iterative method. Given a permutation, find the next in lexicographic order. Iterate until the last one. Here the main program shows letters and is thus limited to permutations of 26 objects. The function computing next permutation is not limited. <lang c>#include <stdio.h>
- include <stdlib.h>
/* Find next permutation in lexicographic order. Return -1 if already the last, otherwise 0. A permutation is an array[n] of value between 0 and n-1. */ int nextperm(int n, int *perm) { int i,j,k,t;
t = 0; for(i=n-2; i>=0; i--) { if(perm[i] < perm[i+1]) { t = 1; break; } }
/* last permutation if decreasing sequence */ if(!t) { return -1; }
/* swap tail decreasing to get a tail increasing */ for(j=i+1; j<n+i-j; j++) { t = perm[j]; perm[j] = perm[n+i-j]; perm[n+i-j] = t; }
/* find min acceptable value in tail */ k = n-1; for(j=n-2; j>i; j--) { if((perm[j] < perm[k]) && (perm[j] > perm[i])) { k = j; } }
/* swap with ith element (head) */ t = perm[i]; perm[i] = perm[k]; perm[k] = t;
return 0; }
int main(int argc, char **argv) { int i, n, *perm;
if(argc != 2) { printf("perm n (1 <= n <= 26\n"); return 1; } n = strtol(argv[1], NULL, 0);
perm = (int *)calloc(n, sizeof(int)); for(i=0; i<n; i++) { perm[i] = i; } do { for(i=0; i<n; i++) { printf("%c", perm[i] + 'A'); } printf("\n"); } while(!nextperm(n, perm)); free(perm); return 0; }</lang>
Sample result :
perm 3
ABC ACB BAC BCA CAB CBA
C++
The STL provides for this in the form of std::next_permutation and std::prev_permutation.
<lang cpp>#include <algorithm>
- include <string>
- include <vector>
- include <iostream>
template<class T> void print(const std::vector<T> &vec) {
for (typename std::vector<T>::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(int argc, char **argv) {
//Permutations for strings std::string example("Hello");
while (std::next_permutation(example.begin(), example.end())) std::cout << example << std::endl;
// And for vectors std::vector<int> another; another.push_back(1234); another.push_back(4321); another.push_back(1234); another.push_back(9999);
std::sort(another.begin(), another.end());
while (std::next_permutation(another.begin(), another.end())) print(another);
/* and so on...*/ return 0;
}</lang> Output:
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,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
D
<lang d>import std.stdio: writeln;
T[][] permutations(T)(T[] items) {
T[][] result;
void perms(T[] s, T[] prefix=[]) { if (s.length) foreach (i, c; s) perms(s[0 .. i] ~ s[i+1 .. $], prefix ~ c); else result ~= prefix; }
perms(items); return result;
}
void main() {
foreach (p; permutations([1, 2, 3])) writeln(p);
}</lang> Output:
[1, 2, 3] [1, 3, 2] [2, 1, 3] [2, 3, 1] [3, 1, 2] [3, 2, 1]
Fortran
<lang 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</lang> Output: <lang> 1 2 3
1 3 2 2 1 3 2 3 1 3 1 2 3 2 1</lang>
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. <lang gap>gap>perms := n -> List(SymmetricGroup(n), p -> List([1..n], x -> x^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 ] ]</lang>
GAP has also built-in functions to get permutations <lang gap># All arragements 4 elements in 1..4 Arrangements([1..4], 4);
- All permutations of 1..4
PermutationsList([1..4]);</lang>
Haskell
<lang haskell>import Data.List (permutations)
main = mapM_ print (permutations [1,2,3])</lang>
J
<lang j>perms=: A.&i.~ !</lang>
Example use:
<lang 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</lang>
Java
Using the code of Michael Gilleland. <lang 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</lang>
If I tested the program for n=3 with beginning 1, I got this output:
1 2 3 1 3 2 2 1 3 2 3 1 3 1 2 3 2 1
optimized
Following needs: Utils.java
<lang java> public class Permutations { public static void main(String[] args) { System.out.println(Utils.Permutations(Utils.mRange(1, 3))); } } </lang>
output:
[[1, 2, 3], [1, 3, 2], [2, 1, 3], [2, 3, 1], [3, 1, 2], [3, 2, 1]]
Logtalk
<lang logtalk>:- object(list).
:- public(permutation/2).
permutation(List, Permutation) :- same_length(List, Permutation), permutation2(List, Permutation).
permutation2([], []). permutation2(List, [Head| Tail]) :- select(Head, List, Remaining), permutation2(Remaining, Tail).
same_length([], []). same_length([_| Tail1], [_| Tail2]) :- same_length(Tail1, Tail2).
select(Head, [Head| Tail], Tail). select(Head, [Head2| Tail], [Head2| Tail2]) :- select(Head, Tail, Tail2).
- - end_object.</lang>
Usage example: <lang logtalk>| ?- forall(list::permutation([1, 2, 3], Permutation), (write(Permutation), nl)).
[1,2,3] [1,3,2] [2,1,3] [2,3,1] [3,1,2] [3,2,1] yes</lang>
PARI/GP
<lang>vector(n!,k,numtoperm(n,k))</lang>
Perl 6
<lang perl6># Lexicographic order sub next_perm ( @a ) {
# j is the largest index with a[j] < a[j+1]. my $j = @a.end - 1; $j-- while $j >= 1 and [gt] @a[ $j, $j+1 ];
# a[k] is the smallest integer greater than a[j] to the right of a[j]. my $aj = @a[$j]; my $k = @a.end; $k-- while [gt] $aj, @a[$k];
@a[ $j, $k ] .= reverse;
# This puts the tail end of permutation after jth position in # increasing order. my Int $r = @a.end; my Int $s = $j + 1; while $r > $s { @a[ $r, $s ] .= reverse; $r--; $s++; }
}
my @array = < a b c >.sort; my $perm_count = [*] 1 .. +@array; # Factorial for ^$perm_count {
@array.say; next_perm(@array);
} </lang>
Output:
abc acb bac bca cab cba
PicoLisp
<lang PicoLisp>(load "@lib/simul.l")
(permute (1 2 3))</lang> Output:
-> ((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1))
Prolog
Works with SWI-Prolog and library clpfd, <lang Prolog>:- use_module(library(clpfd)).
permut_clpfd(L, N) :-
length(L, N), L ins 1..N, all_different(L), label(L).</lang>
Example of output : <lang Prolog>?- permut_clpfd(L, 3), writeln(L), fail. [1,2,3] [1,3,2] [2,1,3] [2,3,1] [3,1,2] [3,2,1] false. </lang>A declarative way of fetching permutations : <lang Prolog>% permut_Prolog(P, L) % P is a permutation of L
permut_Prolog([], []). permut_Prolog([H | T], NL) :- select(H, NL, NL1), permut_Prolog(T, NL1).</lang> Example of output : <lang Prolog> ?- permut_Prolog(P, [ab, cd, ef]), writeln(P), fail. [ab,cd,ef] [ab,ef,cd] [cd,ab,ef] [cd,ef,ab] [ef,ab,cd] [ef,cd,ab] false. </lang>
PureBasic
The procedure nextPermutation() takes an array of integers as input and transforms its contents into the next lexicographic permutation of it's elements (i.e. integers). It returns #True if this is possible. It returns #False if there are no more lexicographic permutations left and arranges the elements into the lowest lexicographic permutation. It also returns #False if there is less than 2 elemetns to permute.
The integer elements could be the addresses of objects that are pointed at instead. In this case the addresses will be permuted without respect to what they are pointing to (i.e. strings, or structures) and the lexicographic order will be that of the addresses themselves. <lang PureBasic>Macro reverse(firstIndex, lastIndex)
first = firstIndex last = lastIndex While first < last Swap cur(first), cur(last) first + 1 last - 1 Wend
EndMacro
Procedure nextPermutation(Array cur(1))
Protected first, last, elementCount = ArraySize(cur()) If elementCount < 1 ProcedureReturn #False ;nothing to permute EndIf ;Find the lowest position pos such that [pos] < [pos+1] Protected pos = elementCount - 1 While cur(pos) >= cur(pos + 1) pos - 1 If pos < 0 reverse(0, elementCount) ProcedureReturn #False ;no higher lexicographic permutations left, return lowest one instead EndIf Wend
;Swap [pos] with the highest positional value that is larger than [pos] last = elementCount While cur(last) <= cur(pos) last - 1 Wend Swap cur(pos), cur(last)
;Reverse the order of the elements in the higher positions reverse(pos + 1, elementCount) ProcedureReturn #True ;next lexicographic permutation found
EndProcedure
Procedure display(Array a(1))
Protected i, fin = ArraySize(a()) For i = 0 To fin Print(Str(a(i))) If i = fin: Continue: EndIf Print(", ") Next PrintN("")
EndProcedure
If OpenConsole()
Dim a(2) a(0) = 1: a(1) = 2: a(2) = 3 display(a()) While nextPermutation(a()): display(a()): Wend Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input() CloseConsole()
EndIf</lang> Sample output:
1, 2, 3 1, 3, 2 2, 1, 3 2, 3, 1 3, 1, 2 3, 2, 1
Python
<lang python>import itertools for values in itertools.permutations([1,2,3]):
print values
</lang>
Output:
(1, 2, 3) (1, 3, 2) (2, 1, 3) (2, 3, 1) (3, 1, 2) (3, 2, 1)
REXX
<lang rexx> /*REXX program to show all Y permuations of X objects (names). */
@abc='abcdefghijklmnopqrstuvwxyz' @abcu=@abc; upper @abcu @abcs=@abcu||@abc @0abcs=123456789||@abcs
/*inbetweenChars & names are optional.*/
parse arg x y inbetweenChars names
/*inbetweenChars defaults to a [null]. */ /* names defaults to digits (and letters). */
call permsets x,y,inbetweenChars,names exit
/*──────────────────────────────────────────────────────────────────────*/
permsets: procedure expose @abc @abcu @0abcs
parse arg x,y,between,usyms /*take X things Y at a time.*/
sep=
syms.= /*placeholder for symbols. */
if between== then between=sep /*use appropriate seperator.*/
do k=1 for x /*build list of symbols. */ _=p(word(usyms,k) p(substr(@0abcs,k,1) k)) /*get or generate a symbol. */ if length(_)\==1 then sep='_' /*if not 1char, then use sep*/ syms.k=_ /*append to the sumbol list.*/ end
lim=1
do j=x-y+1 to x lim=lim*j end
!=0 /*count of PERM sets so far.*/
do j=$metadrome(y) until !>=lim n=j z.= /*placeholders for "digits".*/ zz.= /*placeholders for "digits".*/
do k=1 for y /*convert N to base X. */ _=n//x+1 /*add 1 to each "digit". */ n=n%x /*note: % is integer divide.*/ z.k=syms._ /*put "digit" into an array.*/ zz.k=_ /*put digit into an array.*/ end
_=z.y /*use first "digit". */
do k=y-1 to 1 by -1 /*build the permuation "num"*/ _=_||between||z.k /*build with separater chars*/ end
say _ /*show the PERM set. */ !=!+1 /*bump the perm set counter.*/ end
return
/*─────────────────────────────$METADOME subroutine─────────────────────*/
$metadrome:procedure;arg p;_=1;m=0;do k=p-1 to 1 by -1;m=m+k*_;_=_*p;end;return m
/*─────────────────────────────P subroutine─────────────────────────────*/
p:return word(arg(1),1)
</lang>
Output when the following is used for input:
3 3
123 131 132 133 211 212
Output when the following is used for input:
3 3 ---
1---2---3 1---3---1 1---3---2 1---3---3 2---1---1 2---1---2
Output when the following is used for input:
4 3 == aardvark stegosauris gnu rhinoceros
3 4 == aardvark
aardvark==stegosauris==stegosauris aardvark==stegosauris==gnu aardvark==stegosauris==rhinoceros aardvark==gnu==aardvark aardvark==gnu==stegosauris aardvark==gnu==gnu aardvark==gnu==rhinoceros aardvark==rhinoceros==aardvark aardvark==rhinoceros==stegosauris aardvark==rhinoceros==gnu aardvark==rhinoceros==rhinoceros stegosauris==aardvark==aardvark stegosauris==aardvark==stegosauris stegosauris==aardvark==gnu stegosauris==aardvark==rhinoceros stegosauris==stegosauris==aardvark stegosauris==stegosauris==stegosauris stegosauris==stegosauris==gnu stegosauris==stegosauris==rhinoceros stegosauris==gnu==aardvark stegosauris==gnu==stegosauris stegosauris==gnu==gnu stegosauris==gnu==rhinoceros stegosauris==rhinoceros==aardvark
Ruby
<lang ruby>p [1,2,3].permutation.to_a</lang> Output:
[[1, 2, 3], [1, 3, 2], [2, 1, 3], [2, 3, 1], [3, 1, 2], [3, 2, 1]]
Tcl
<lang tcl>package require struct::list
- Make the sequence of digits to be permuted
set n [lindex $argv 0] for {set i 1} {$i <= $n} {incr i} {lappend sequence $i}
- Iterate over the permutations, printing as we go
struct::list foreachperm p $sequence {
puts $p
}</lang>
Testing with tclsh listPerms.tcl 3
produces this output:
1 2 3 1 3 2 2 1 3 2 3 1 3 1 2 3 2 1