Permutations: Difference between revisions
Line 1,486: | Line 1,486: | ||
=={{header|Python}}== |
=={{header|Python}}== |
||
{{works with|Python|2.6+}} |
|||
<lang python>import itertools |
<lang python>import itertools |
||
for values in itertools.permutations([1,2,3]): |
for values in itertools.permutations([1,2,3]): |
Revision as of 05:59, 5 September 2011
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.
ABAP
<lang 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.</lang>
Output:
1, 3, 2 2, 1, 3 2, 3, 1 3, 1, 2 3, 2, 1
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>
ALGOL 68
File: Template_Permutations.a68 <lang algol68># Document prelude template usage: TEMPLATE(
INT upb values := 4; MODE VALUE = INT; FORMAT value fmt := $g(0)$
); #
MODE
VALVALUES = [upb values]VALUE, VALUES = REF VALVALUES, YIELDVALUES = PROC(VALUES)VOID;
FORMAT
values fmt := $"("n(upb values-1)(f(value fmt)", ")f(value fmt)")"$;
- Generate permutations of the input values of valueues #
PROC gen values permutations = (VALUES values, YIELDVALUES yield)VOID: (
- Warning: this routine does not correctly handle duplicate elements #
IF LWB values = UPB values THEN yield(values) ELSE FOR elem FROM LWB values TO UPB values DO VALUE first = values[elem]; values[LWB values+1:elem] := values[:elem-1]; values[LWB values] := first; # FOR VALUES next values IN # gen values permutations(values[LWB values+1:] # ) DO #, ## (VALUES next)VOID:( yield(values) # OD #)); values[:elem-1] := values[LWB values+1:elem]; values[elem] := first OD FI
);
- Define some additional utility OPerators #
PRIO P = 7; # OP to calculate number of permutations # OP P = (INT n, k)INT: ( # n! OVER (n-k)! #
# ( n>k | n * ((n-1) P k) | n ); # INT out := k; FOR i FROM k+1 TO n DO out *:= i OD; out
);
- Define an operator for doing iterations over permutations #
PRIO DOPERM = 1; OP (VALUES, YIELDVALUES)VOID DOPERM = gen values permutations;
- Return an a matrix of permutations #
OP PERM = (VALUES in values)[, ]VALUE: (
[(UPB in values-LWB in values+1) P 1, LWB in values:UPB in values]VALUE out; INT elem := LWB out;
- FOR VALUES values IN # in values DOPERM (
- (VALUES values)VOID:(
out[elem, ] := values; elem +:= 1
- OD #));
out
);</lang>File: test_Permutations.a68 <lang algol68>#!/usr/local/bin/a68g --script #
PR READ "Template_Permutations.a68" PR # n.b. READ is nonstandard #
- USING( #
INT upb values := 4; MODE VALUE = INT; # user defined # FORMAT value fmt := $g(0)$
- ) #;
main:(
VALVALUES test case := (1, 22, 333, 44444); print(("Number of permutations: ", UPB test case P 1, new line));
COMMENT # Use the generator: #
# FOR ARRAY values IN # test case DOPERM ( ## (ARRAY values)VOID:( printf((values fmt, values, $l$)) # OD #));
END COMMENT
- or simply the operator: #
printf(($f(values fmt)l$, PERM test case))
)</lang> Output:
Number of permutations: +24 (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)
BBC BASIC
The procedure PROC_NextPermutation() will give the next lexicographic permutation of an integer array. <lang BBC BASIC>
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
</lang>
C
See lexicographic generation of permutations. <lang c>#include <stdio.h>
- include <stdlib.h>
int next_perm(int n, char *a) {
- 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; }
int main(int argc, char **argv) { char a[] = "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
if (argc < 2) { printf("usage: %s n (1 <= n <= 26)\n", argv[0]); return 0; }
int n = atoi(argv[1]); if (n <= 0) n = 4; if (n > 26) n = 26;
do { printf("%.*s\n", n, a); } while(next_perm(n, a));
return 0; }</lang>output<lang>% ./a.out 3 ABC ACB BAC BCA CAB CBA</lang>
C++
The C++ standard library 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() {
//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<int> 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()));
}</lang> Output:
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
Clojure
In an REPL:
<lang 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))</lang>
CoffeeScript
<lang 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...</lang>
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.
Usage: <lang 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</lang>
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]
Delphi
<lang 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.</lang> Output:
4123 4213 4312 4321 4132 4231 3421 3412 2413 1423 2431 1432 3142 3241 2341 1342 2143 1243 3124 3214 2314 1324 2134 1234
Erlang
<lang Erlang>-module(permute). -export([permute/1]). -import(lists, [append/1, map/2, seq/2, split/2]).
%% insert element E into list L immediately after the item at position N %% (N=0 prepends E to the list) insert( L, N, E ) ->
{H, T} = split( N, L ), append( [H, [E], T] ).
% Return a list of all the permutations of the given list permute( [] ) -> [[]]; permute( [H|T] ) ->
append( map( fun(P) -> map( fun(N) -> insert(P, N, H) end, seq( 0, length(P) )) end, permute( T ))).
</lang>
Demonstration (escript):
<lang Erlang>main(_) -> io:fwrite("~p~n", [permute:permute([1,2,3])]).</lang>
Output:
[[1,2,3],[1,3,2],[2,1,3],[2,3,1],[3,1,2],[3,2,1]]
Euphoria
<lang 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</lang>
Output:
abcd abdc acbd acdb adbc adcb bacd badc bcad bcda bdac bdca cabd cadb cbad cbda cdab cdba dabc dacb dbac dbca dcab dcba
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
<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>
Here is an alternate, iterative version in Fortran 77. Based on Ada version. <lang 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</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 arrangements of 4 elements in 1..4 Arrangements([1..4], 4);
- All permutations of 1..4
PermutationsList([1..4]);</lang>
Go
<lang 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))
}</lang> Output:
[1 2 3] [1 3 2] [3 1 2] [2 1 3] [2 3 1] [3 2 1]
Haskell
<lang haskell>import Data.List (permutations)
main = mapM_ print (permutations [1,2,3])</lang>
Icon and Unicon
<lang 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</lang> A sample run:
->permute Aardvarks eat ants Aardvarks eat ants Aardvarks ants eat eat Aardvarks ants eat ants Aardvarks ants eat Aardvarks ants Aardvarks eat ->
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]]
JavaScript
Copy the following as an HTML file and load in a browser. <lang javascript><html><head><title>Permutations</title></head>
<body>
<script type="text/javascript"> var d = document.getElementById('result');
function perm(list, ret) { if (list.length == 0) { var row = document.createTextNode(ret.join(' ') + '\n'); d.appendChild(row); return; } for (var i = 0; i < list.length; i++) { var x = list.splice(i, 1); ret.push(x); perm(list, ret); ret.pop(); list.splice(i, 0, x); } }
perm([1, 2, 'A', 4], []); </script></body></html></lang>
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>
OCaml
<lang ocaml>(* Iterative, though loops are implemented as auxiliary recursive functions.
Translation of Ada version. *)
let next_perm p = let n = Array.length p in let i = let rec aux i = if (i < 0) || (p.(i) < p.(i+1)) then i else aux (i - 1) in aux (n - 2) in let rec aux j k = if j < k then let t = p.(j) in p.(j) <- p.(k); p.(k) <- t; aux (j + 1) (k - 1) else () in aux (i + 1) (n - 1); if i < 0 then false else let j = let rec aux j = if p.(j) > p.(i) then j else aux (j + 1) in aux (i + 1) in let t = p.(i) in p.(i) <- p.(j); p.(j) <- t; true;;
let print_perm p = let n = Array.length p in for i = 0 to n - 2 do print_int p.(i); print_string " " done; print_int p.(n - 1); print_newline ();;
let print_all_perm n = let p = Array.init n (function i -> i + 1) in print_perm p; while next_perm p do print_perm p done;;
print_all_perm 3;; (* 1 2 3
1 3 2 2 1 3 2 3 1 3 1 2 3 2 1 *)</lang>
Permutations can also be defined on lists recursively: <lang OCaml>let rec permutations l =
let n = List.length l in if n = 1 then [l] else let rec sub e = function | [] -> failwith "sub" | h :: t -> if h = e then t else h :: sub e t in let rec aux k = let e = List.nth l k in let subperms = permutations (sub e l) in let t = List.map (fun a -> e::a) subperms in if k < n-1 then List.rev_append t (aux (k+1)) else t in aux 0;;
let print l = List.iter (Printf.printf " %d") l; print_newline() in List.iter print (permutations [1;2;3;4])</lang> or permutations indexed independently: <lang OCaml>let rec pr_perm k n l =
let a, b = let c = k/n in c, k-(n*c) in let e = List.nth l b in let rec sub e = function | [] -> failwith "sub" | h :: t -> if h = e then t else h :: sub e t in (Printf.printf " %d" e; if n > 1 then pr_perm a (n-1) (sub e l))
let show_perms l =
let n = List.length l in let rec fact n = if n < 3 then n else n * fact (n-1) in for i = 0 to (fact n)-1 do pr_perm i n l; print_newline() done
let () = show_perms [1;2;3;4]</lang>
PARI/GP
<lang>vector(n!,k,numtoperm(n,k))</lang>
Pascal
<lang pascal>program perm;
var p: array[1 .. 12] of integer; is_last: boolean; n: integer;
procedure next; var i, j, k, t: integer; begin is_last := true; i := n - 1; while i > 0 do begin if p[i] < p[i + 1] then begin is_last := false; break; end; i := i - 1; end;
if not is_last then begin j := i + 1; k := n; while j < k do begin t := p[j]; p[j] := p[k]; p[k] := t; j := j + 1; k := k - 1; end;
j := n; while p[j] > p[i] do j := j - 1; j := j + 1;
t := p[i]; p[i] := p[j]; p[j] := t; end; end;
procedure print; var i: integer; begin for i := 1 to n do write(p[i], ' '); writeln; end;
procedure init; var i: integer; begin n := 0; while (n < 1) or (n > 10) do begin write('Enter n (1 <= n <= 10): '); readln(n); end; for i := 1 to n do p[i] := i; end;
begin init; repeat print; next; until is_last; end.</lang>
Perl
<lang perl6># quick and dirty recursion sub permutation(){ my ($perm,@set) = @_; print "$perm\n" || return unless (@set); &permutation($perm.$set[$_],@set[0..$_-1],@set[$_+1..$#set]) foreach (0..$#set); } @input = (a,2,c,4); &permutation(,@input); </lang>
Output:
a2c4 a24c ac24 ac42 a42c a4c2 2ac4 2a4c 2ca4 2c4a 24ac 24ca ca24 ca42 c2a4 c24a c4a2 c42a 4a2c 4ac2 42ac 42ca 4ca2 4c2a
Perl 6
This is generic code that works with any ordered type. To force lexicographic ordering, change after to gt. To force numeric order, replace it with >. <lang perl6>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 ...^ !*;</lang>
Output:
a b c a c b b a c b c a c a b c b a
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)
R
<lang r>next.perm <- function(p) { n <- length(p) i <- n - 1 r = TRUE for(i in (n-1):1) { if(p[i] < p[i+1]) { r = FALSE break } }
j <- i + 1 k <- n while(j < k) { x <- p[j] p[j] <- p[k] p[k] <- x j <- j + 1 k <- k - 1 }
if(r) return(NULL)
j <- n while(p[j] > p[i]) j <- j - 1 j <- j + 1
x <- p[i] p[i] <- p[j] p[j] <- x return(p) }
print.perms <- function(n) { p <- 1:n while(!is.null(p)) { cat(p,"\n") p <- next.perm(p) } }
print.perms(3)
- 1 2 3
- 1 3 2
- 2 1 3
- 2 3 1
- 3 1 2
- 3 2 1</lang>
REXX
<lang rexx> /*REXX program to find the missing permutation. */
/*inbetweenChars & names are optional.*/
parse arg things bunch inbetweenChars names
/*inbetweenChars defaults to a [null]. */ /* names defaults to digits (and letters). */
call permSets things,bunch,inbetweenChars,names exit
/*──────────────────────────────────────────────────────────────────────*/
permSets: procedure; parse arg x,y,between,usyms /*X things Y at a time.*/
/*X can't be > length(@0abcs). */
@abc='abcdefghijklmnopqrstuvwxyz' @abcu=@abc; upper @abcu @abcs=@abcu||@abc @0abcs=123456789||@abcs @.= sep=
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*/ $.k=_ /*append to the sumbol list.*/ end
if between== then between=sep /*use appropriate seperator.*/
list='$. @. between x y' call permset(1) exit
/*────────────────────────────────PERMSET subroutine────────────────────*/ permset: procedure expose (list); parse arg ?
if ?>y then do
_=@.1 do j=2 to y _=_||between||@.j end say _ end else do q=1 for x /*construction permutation recursively*/ do k=1 for ?-1 if @.k==$.q then iterate q end @.?=$.q call permset(?+1) end
return
/*────────────────────────────────P subroutine (Pick one)───────────────*/
p: return word(arg(1),1)
</lang>
Output when the following was used for input:
3 3
123 132 213 231 312 321
Output when the following was used for input:
4 4 --- A B C D
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
Output when the following was used for input:
4 3 - aardvark gnu stegosaurus platypus
aardvark-gnu-stegosaurus aardvark-gnu-platypus aardvark-stegosaurus-gnu aardvark-stegosaurus-platypus aardvark-platypus-gnu aardvark-platypus-stegosaurus gnu-aardvark-stegosaurus gnu-aardvark-platypus gnu-stegosaurus-aardvark gnu-stegosaurus-platypus gnu-platypus-aardvark gnu-platypus-stegosaurus stegosaurus-aardvark-gnu stegosaurus-aardvark-platypus stegosaurus-gnu-aardvark stegosaurus-gnu-platypus stegosaurus-platypus-aardvark stegosaurus-platypus-gnu platypus-aardvark-gnu platypus-aardvark-stegosaurus platypus-gnu-aardvark platypus-gnu-stegosaurus platypus-stegosaurus-aardvark platypus-stegosaurus-gnu
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]]
However, this method will produce indistinct permutations if the array has indictinct elements. If you need to find all the permutations of an array of which many elements are the same, the method below will be more efficient.
<lang ruby> class Array
def distinct_permutation @copy = self.dup sort! yield self while true # from: "The Art of Computer Programming" by Donald Knuth j = size - 2; j -= 1 while j > 0 && self[j] >= self[j+1] if self[j] < self[j+1] l = size - 1 l -= 1 while self[j] >= self[l] self[j] , self[l] = self[l] , self[j] self[j+1..-1] = self[j+1..-1].reverse yield self else break end end self[0..-1] = @copy end
end
permutations = [] [1,1,2].distinct_permutation do |p| permutations << p.dup end p permutations </lang>
will produce:
[[1, 1, 2], [1, 2, 1], [2, 1, 1]]
Scala
There is a built-in function that works on any sequential collection. It could be used as follows given a List of symbols: <lang>List('a, 'b, 'c).permutations foreach println</lang> Output:
List('a, 'b, 'c) List('a, 'c, 'b) List('b, 'a, 'c) List('b, 'c, 'a) List('c, 'a, 'b) List('c, 'b, 'a)
Scheme
<lang scheme>; translation of ocaml : mostly iterative, with auxiliary recursive functions for some loops (define (vector-swap! v i j) (let ((tmp (vector-ref v i))) (vector-set! v i (vector-ref v j)) (vector-set! v j tmp)))
(define (next-perm p) (let* ((n (vector-length p)) (i (let aux ((i (- n 2))) (if (or (< i 0) (< (vector-ref p i) (vector-ref p (+ i 1)))) i (aux (- i 1)))))) (let aux ((j (+ i 1)) (k (- n 1))) (if (< j k) (begin (vector-swap! p j k) (aux (+ j 1) (- k 1))))) (if (< i 0) #f (begin (vector-swap! p i (let aux ((j (+ i 1))) (if (> (vector-ref p j) (vector-ref p i)) j (aux (+ j 1))))) #t))))
(define (print-perm p) (let ((n (vector-length p))) (do ((i 0 (+ i 1))) ((= i n)) (display (vector-ref p i)) (display " ")) (newline)))
(define (print-all-perm n) (let ((p (make-vector n))) (do ((i 0 (+ i 1))) ((= i n)) (vector-set! p i i)) (print-perm p) (do ( ) ((not (next-perm p))) (print-perm p))))
(print-all-perm 3)
- 0 1 2
- 0 2 1
- 1 0 2
- 1 2 0
- 2 0 1
- 2 1 0
- a more recursive implementation
(define (permute p i) (let ((n (vector-length p))) (if (= i (- n 1)) (print-perm p) (begin (do ((j i (+ j 1))) ((= j n)) (vector-swap! p i j) (permute p (+ i 1))) (do ((j (- n 1) (- j 1))) ((< j i)) (vector-swap! p i j))))))
(define (print-all-perm-rec n)
(let ((p (make-vector n)))
(do ((i 0 (+ i 1))) ((= i n)) (vector-set! p i i))
(permute p 0)))
(print-all-perm-rec 3)
- 0 1 2
- 0 2 1
- 1 0 2
- 1 2 0
- 2 0 1
- 2 1 0</lang>
Smalltalk
<lang smalltalk>(1 to: 4) permutationsDo: [ :x | Transcript show: x printString; cr ].</lang>
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
Ursala
In practice there's no need to write this because it's in the standard library.
<lang Ursala>#import std
permutations =
~&itB^?a( # are both the input argument list and its tail non-empty?
@ahPfatPRD *= refer ^C( # yes, recursively generate all permutations of the tail, and for each one ~&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</lang>
test program: <lang Ursala>#cast %nLL
test = permutations <1,2,3></lang> output:
< <1,2,3>, <2,1,3>, <2,3,1>, <1,3,2>, <3,1,2>, <3,2,1>>