Permutations: Difference between revisions

From Rosetta Code
Content added Content deleted
(→‎{{header|Ada}}: slightly simpler)
Line 109: Line 109:
begin
begin
init;
init;
print;
loop
loop
print;
next;
next;
exit when is_last;
exit when is_last;
print;
end loop;
end loop;
end;
end;

Revision as of 14:14, 10 November 2010

Task
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

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>

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)

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