Permutations

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>

1. 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>

1. include <string>
2. include <vector>
3. 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 arrangements of 4 elements in 1..4 Arrangements([1..4], 4);

1. 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

Works with: Python version 2.6

<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 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 permuation 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

Works with: Ruby version 1.9

<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

Library: Tcllib (Package: struct::list)

<lang tcl>package require struct::list

1. Make the sequence of digits to be permuted

set n [lindex $argv 0] for {set i 1} {$i <= $n} {incr i} {lappend sequence $i}

1. 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