Permutations: Difference between revisions

From Rosetta Code
Content added Content deleted
(+ second D entry (lazy))
Line 792: Line 792:


=={{header|D}}==
=={{header|D}}==
===Eager version===
<lang d>import std.stdio: writeln;
<lang d>import std.stdio: writeln;


Line 820: Line 821:
[3, 1, 2]
[3, 1, 2]
[3, 2, 1]</pre>
[3, 2, 1]</pre>
===Lazy version===
With same main function produces the same output.
<lang d>import std.range, std.algorithm, std.math, std.exception;
struct Permutations(T) {
private immutable size_t num;
private T[] items;
private ulong tot;
this (in T[] items) pure nothrow
in {
enforce(items.length > 0,
"Permutations: items.length must be > 0");
} body {
static ulong factorial(in uint n) pure nothrow {
ulong result = 1;
foreach (i; 2 .. n + 1)
result *= i;
return result;
}
this.num = items.length;
this.items = items.dup;
this.tot = factorial(this.num);
}
@property const(T[]) front() const pure nothrow {
return items;
}
@property bool empty() const pure nothrow {
return tot == 0;
}
void popFront() pure nothrow {
tot--;
if (tot > 0) {
size_t j = num - 2;
while (items[j] > items[j + 1])
j--;
size_t k = num - 1;
while (items[j] > items[k])
k--;
swap(items[k], items[j]);
size_t r = num - 1;
size_t s = j + 1;
while (r > s) {
swap(items[s], items[r]);
r--;
s++;
}
}
}
}
Permutations!T permutations(T)(in T[] items) pure nothrow {
return Permutations!T(items);
}</lang>


=={{header|Delphi}}==
=={{header|Delphi}}==

Revision as of 03:33, 14 February 2012

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.

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

Works with: ALGOL 68 version Revision 1 - one minor extension to language used - PRAGMA READ, like C's #include directive.
Works with: ALGOL 68G version Any - tested with release 1.18.0-9h.tiny.

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)")"$;
  1. Generate permutations of the input values of valueues #

PROC gen values permutations = (VALUES values, YIELDVALUES yield)VOID: (

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

);

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

);

  1. Define an operator for doing iterations over permutations #

PRIO DOPERM = 1; OP (VALUES, YIELDVALUES)VOID DOPERM = gen values permutations;

  1. 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;
  1. FOR VALUES values IN # in values DOPERM (
    1. (VALUES values)VOID:(
   out[elem, ] := values;
   elem +:= 1
  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 #

  1. USING( #
 INT upb values := 4;
 MODE VALUE = INT; # user defined #
 FORMAT value fmt := $g(0)$
  1. ) #;

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

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

AutoHotkey

from the forum topic http://www.autohotkey.com/forum/viewtopic.php?t=77959 <lang 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

} </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

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>

  1. include <stdlib.h>

/* 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) {

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

  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); }

  1. 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; }</lang>

C++

The C++ standard library 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() { 

   //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()));

   return 0;

}</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

  1. removed from it.

arrayExcept = (arr, idx) -> res = arr[0..] res.splice idx, 1 res

  1. The actual function which returns the permutations of an array-like
  2. 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>

Common Lisp

<lang 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)))</lang>output<lang>((A B Z) (A Z B) (B A Z) (B Z A) (Z A B) (Z B A))</lang>

Lexicographic next permutation: <lang 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))

</lang>

D

Eager version

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

Lazy version

With same main function produces the same output. <lang d>import std.range, std.algorithm, std.math, std.exception;

struct Permutations(T) { 

   private immutable size_t num;
   private T[] items;
   private ulong tot;

   this (in T[] items) pure nothrow
   in {
       enforce(items.length > 0,
               "Permutations: items.length must be > 0");
   } body {
       static ulong factorial(in uint n) pure nothrow {
           ulong result = 1;
           foreach (i; 2 .. n + 1)
               result *= i;
           return result;
       }


       this.num = items.length;
       this.items = items.dup;
       this.tot = factorial(this.num);
   }

   @property const(T[]) front() const pure nothrow {
       return items;
   }

   @property bool empty() const pure nothrow {
       return tot == 0;
   }

   void popFront() pure nothrow {
       tot--;
       if (tot > 0) {
           size_t j = num - 2;
           while (items[j] > items[j + 1])
               j--;
           size_t k = num - 1;
           while (items[j] > items[k])
               k--;
           swap(items[k], items[j]);

           size_t r = num - 1;
           size_t s = j + 1;
           while (r > s) {
               swap(items[s], items[r]);
               r--;
               s++;
           }
       }
   }

}

Permutations!T permutations(T)(in T[] items) pure nothrow { 

   return Permutations!T(items);

}</lang>

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

Shortest form: <lang Erlang>-module(permute). -export([permute/1]).

permute([]) -> [[]]; permute(L) -> [[X|Y] || X<-L, Y<-permute(L--[X])]. </lang> Y-combinator (for shell): <lang Erlang> F = fun(L) -> G = fun(_, []) -> [[]]; (F, L) -> [[X|Y] || X<-L, Y<-F(F, L--[X])] end, G(G, L) end. </lang> More efficient zipper implementation: <lang Erlang>-module(permute).

-export([permute/1]).

permute([]) -> [[]]; permute(L) -> zipper(L, []).

% Use zipper to pick up first element of permutation zipper([], _) -> []; zipper([H|T], R) -> 

 % 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]).

prepend(_, [], T, R) -> zipper(T, R); % continue in zipper prepend(X, [H|T], ZT, ZR) -> [[X|H] | prepend(X, T, ZT, ZR)]. </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

Translation of: PureBasic

<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);

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

Groovy

Solution: <lang groovy>def makePermutations = { l -> l.permutations() }</lang>

Test: <lang 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 }</lang>

Output: 

[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

<lang haskell>import Data.List (permutations)

main = mapM_ print (permutations [1,2,3])</lang>

<lang haskell>import Data.List (delete)

permutations [] = [[]] permutations xs = [ x:ys | x <- xs, ys <- permutations (delete x xs)] </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>



K


Translation of: J


<lang K>   perm:{:[1<x;,/(>:'(x,x)#1,x#0)[;0,'1+_f x-1];,!x]}



  perm 2



(0 1



1 0)



  `0:{1_,/" ",/:x}'r@perm@#r:("some";"random";"text")



some random text
some text random
random some text
random text some
text some random
text random some</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>






Mathematica


<lang Mathematica>Permutations[{1,2,3,4}]</lang>

Output:



{{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}}


Maxima


<lang maxima>next_permutation(v) := block([n, i, j, k, t],



  n: length(v), i: 0,
  for k: n - 1 thru 1 step -1 do (if v[k] < v[k + 1] then (i: k, return())),
  j: i + 1, k: n,
  while j < k do (t: v[j], v[j]: v[k], v[k]: t, j: j + 1, k: k - 1),
  if i = 0 then return(false),
  j: i + 1,
  while v[j] < v[i] do j: j + 1,
  t: v[j], v[j]: v[i], v[i]: t,
  true



)$

print_perm(n) := block(



  v: makelist(i, i, 1, n),
  disp(v),
  while next_permutation(v) do disp(v)



)$

print_perm(3);
/* [1, 2, 3]



  [1, 3, 2]
  [2, 1, 3]
  [2, 3, 1]
  [3, 1, 2]
  [3, 2, 1] */</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 parigp>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))


PowerBASIC


<lang powerbasic>defint a-z
option base 1
input "n=",n
dim a(n)
for i=1 to n: a(i)=i: next
do



 for i=1 to n: print a(i);: next: print
 i=n
 do
   decr i
 loop until i=0 or a(i)<a(i+1)
 j=i+1
 k=n
 while j<k
   swap a(j),a(k)
   incr j
   decr k
 wend
 if i>0 then
   j=i+1
   while a(j)<a(i)
     incr j
   wend
   swap a(i),a(j)
 end if



loop until i=0</lang>



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)



Qi


Translation of: Erlang


<lang qi>
(define insert



 L      0 E -> [E|L]
 [L|Ls] N E -> [L|(insert Ls (- N 1) E)])



(define seq



 Start Start -> [Start]
 Start End   -> [Start|(seq (+ Start 1) End)])



(define append-lists



 []    -> []
 [A|B] -> (append A (append-lists B)))



(define permutate



 []    -> [[]]
 [H|T] -> (append-lists (map (/. P
                                 (map (/. N
                                          (insert P N H))
                                      (seq 0 (length P))))
                             (permute T))))



</lang>



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

  2. 1 3 2
    3. 

  3. 2 1 3
    4. 

  4. 2 3 1
    5. 

  5. 3 1 2
    6. 

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


Works with: Ruby version 1.8.7+


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



 # Yields distinct permutations of _self_ to the block.
 # This method requires that all array elements be Comparable.
 def distinct_permutation  # :yields: _ary_
   # If no block, return an enumerator. Works with Ruby 1.8.7.
   block_given? or return enum_for(:distinct_permutation)



   copy = self.sort
   yield copy.dup
   return if size < 2



   while true
     # from: "The Art of Computer Programming" by Donald Knuth
     j = size - 2;
     j -= 1 while j > 0 && copy[j] >= copy[j+1]
     if copy[j] < copy[j+1]
       l = size - 1
       l -= 1 while copy[j] >= copy[l] 
       copy[j] , copy[l] = copy[l] , copy[j]
       copy[j+1..-1] = copy[j+1..-1].reverse
       yield copy.dup
     else
       break
     end
   end
 end



end

permutations = []
[1,1,2].distinct_permutation do |p| permutations << p end
p permutations



  1. => [[1, 1, 2], [1, 2, 1], [2, 1, 1]]


if RUBY_VERSION >= "1.8.7"



 p [1,1,2].distinct_permutation.to_a
 # => [[1, 1, 2], [1, 2, 1], [2, 1, 1]]



end</lang>



SAS


<lang sas>/* Store permutations in a SAS dataset. Translation of Fortran 77 */
data perm;
n=6;
array a{6} p1-p6;
do i=1 to n;
a(i)=i;
end;
L1:
output;
link L2;
if next then goto L1;
stop;
L2:
next=0;
i=n-1;
L10:
if a(i)<a(i+1) then goto L20;
i=i-1;
if i=0 then goto L20;
goto L10;
L20:
j=i+1;
k=n;
L30:
t=a(j);
a(j)=a(k);
a(k)=t;
j=j+1;
k=k-1;
if j<k then goto L30;
j=i;
if j=0 then return;
L40:
j=j+1;
if a(j)<a(i) then goto L40;
t=a(i);
a(i)=a(j);
a(j)=t;
next=1;
return;
keep p1-p6;
run;</lang>



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


Translation of: Erlang


<lang scheme>
(define (insert l n e)



 (if (= 0 n)
     (cons e l)
     (cons (car l) 
           (insert (cdr l) (- n 1) e))))



(define (seq start end)



 (if (= start end)
     (list end)
     (cons start (seq (+ start 1) end))))



(define (permute l)



 (if (null? l)
     '(())
     (apply append (map (lambda (p)
                          (map (lambda (n)
                                 (insert p n (car l)))
                               (seq 0 (length p))))
                        (permute (cdr l))))))



</lang>



Translation of: OCaml


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


Completely recursive on lists:
<lang lisp>(define (perm s)



 (cond ((null? s) '())



	((null? (cdr s)) (list s))
	(else ;; extract each item in list in turn and perm the rest
	  (let splice ((l '()) (m (car s)) (r (cdr s)))
	    (append
	      (map (lambda (x) (cons m x)) (perm (append l r)))
	      (if (null? r) '()
		(splice (cons m l) (car r) (cdr r))))))))

(display (perm '(1 2 3)))</lang>



Seed7


<lang seed7>$ include "seed7_05.s7i";

const type: permutations is array array integer;

const func permutations: permutations (in array integer: items) is func



 result
   var permutations: permsList is 0 times 0 times 0;
 local
   const proc: perms (in array integer: sequence, in array integer: prefix) is func
     local
       var integer: element is 0;
       var integer: index is 0;
     begin
       if length(sequence) <> 0 then
         for element key index range sequence do
           perms(sequence[.. pred(index)] & sequence[succ(index) ..], prefix & [] (element));
         end for;
       else
         permsList &:= prefix;
       end if;
     end func;
 begin
   perms(items, 0 times 0);
 end func;




const proc: main is func



 local
   var array integer: perm is 0 times 0;
   var integer: element is 0;
 begin
   for perm range permutations([] (1, 2, 3)) do
     for element range perm do
       write(element <& " ");
     end for;
     writeln;
   end for;
 end func;</lang>



Output:



1 2 3 
1 3 2 
2 1 3 
2 3 1 
3 1 2 
3 2 1 



Smalltalk


Works with: Squeak


Works with: Pharo


<lang smalltalk>(1 to: 4) permutationsDo: [ :x | 
	Transcript show: x printString; cr ].</lang>



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



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


VBA


Based on the Pascal version above.

<lang VBA>
Public Sub Permute(n As Integer, Optional printem As Boolean = True)
'generate, count and print (if printem is not false) all permutations of first n integers

Dim P() As Integer
Dim count As Long
dim Last as boolean
Dim t, i, j, k As Integer

If n <= 1 Then



 Debug.Print "give a number greater than 1!"
 Exit Sub



End If

'initialize
ReDim P(n)
For i = 1 To n: P(i) = i: Next
count = 0
Last = False

Do While Not Last



'print?
If printem Then
  For t = 1 To n: Debug.Print P(t);: Next
  Debug.Print
End If
count = count + 1

Last = True
i = n - 1
Do While i > 0
  If P(i) < P(i + 1) Then
    Last = False
     Exit Do
  End If
  i = i - 1
Loop



If Not Last Then
  j = i + 1
  k = n
  While j < k
    ' swap p(j) and p(k)
    t = P(j)
    P(j) = P(k)
    P(k) = t
    j = j + 1
    k = k - 1
  Wend
  j = n
  While P(j) > P(i)
    j = j - 1
  Wend
  j = j + 1
  'swap p(i) and p(j)
  t = P(i)
  P(i) = P(j)
  P(j) = t
End If 'not last



Loop 'while not last

Debug.Print "Number of permutations: "; count

End Sub
</lang>

Sample dialogue:



permute 1
give a number greater than 1!
permute 2
 1  2 
 2  1 
Number of permutations:  2 
permute 4
 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 
Number of permutations:  24 
permute 10,False
Number of permutations:  3628800 



Retrieved from "https://rosettacode.org/wiki/Permutations?oldid=158419"