tasks a-s

Task/Permutations/0DESCRIPTION

@@ -0,0 +1,4 @@
+Write a program that generates all [[wp:Permutation|permutations]] of '''n''' different objects. (Practically numerals!)
+;Cf.
+* [[Find the missing permutation]]
+* [[Permutations/Derangements]]

Task/Permutations/1META.yaml

@@ -0,0 +1,2 @@
+---
+note: Discrete math

Task/Permutations/ABAP/permutations.abap

@@ -0,0 +1,100 @@
+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.

Task/Permutations/ALGOL-68/permutations-1.alg

@@ -0,0 +1,61 @@
+# 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
+);

Task/Permutations/ALGOL-68/permutations-2.alg

@@ -0,0 +1,23 @@
+#!/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))
+)

Task/Permutations/Ada/permutations.ada

@@ -0,0 +1,113 @@
+-- perm.adb
+-- print all permutations of 1 .. n
+-- where n is given as a command line argument
+-- to compile with GNAT : gnat make perm.adb
+-- to call on command line : 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;
+
+      procedure Swap (A, B : in out Integer) is
+         C : Integer := A;
+      begin
+         A := B;
+         B := C;
+      end;
+
+      -- 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 : 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
+            Swap (P (J), P (K));
+            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
+         Swap (P (I), P (J));
+      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;
+      while not Is_Last loop
+         Print;
+         Next;
+      end loop;
+   end;
+
+end Perm;

Task/Permutations/AutoHotkey/permutations.ahk

@@ -0,0 +1,49 @@
+#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
+}

Task/Permutations/BBC-BASIC/permutations.bbc

@@ -0,0 +1,38 @@
+      DIM List%(3)
+      List%() = 1, 2, 3, 4
+      FOR perm% = 1 TO 24
+        FOR i% = 0 TO DIM(List%(),1)
+          PRINT List%(i%);
+        NEXT
+        PRINT
+        PROC_NextPermutation(List%())
+      NEXT
+      END
+
+      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

Task/Permutations/Bracmat/permutations.bracmat

@@ -0,0 +1,13 @@
+  ( perm
+  =   prefix List result original A Z
+    .   !arg:(?.)
+      |   !arg:(?prefix.?List:?original)
+        & :?result
+        &   whl
+          ' ( !List:%?A ?Z
+            & !result perm$(!prefix !A.!Z):?result
+            & !Z !A:~!original:?List
+            )
+        & !result
+  )
+& out$(perm$(.a 2 "]" u+z);

Task/Permutations/C++/permutations.cpp

@@ -0,0 +1,40 @@
+#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()));
+
+    return 0;
+}

Task/Permutations/C/permutations.c

@@ -0,0 +1,100 @@
+#include <stdio.h>
+#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) {
+#	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;
+#	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);
+}
+
+#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;
+}

Task/Permutations/Clojure/permutations.clj

@@ -0,0 +1,4 @@
+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))

Task/Permutations/CoffeeScript/permutations-1.coffeescript

@@ -0,0 +1,18 @@
+# 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...

Task/Permutations/CoffeeScript/permutations-2.coffeescript

@@ -0,0 +1,7 @@
+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

Task/Permutations/Common-Lisp/permutations-1.lisp

@@ -0,0 +1,9 @@
+(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)))

Task/Permutations/Common-Lisp/permutations-2.lisp

@@ -0,0 +1,18 @@
+(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))

Task/Permutations/D/permutations-1.d

@@ -0,0 +1,21 @@
+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);
+}

Task/Permutations/D/permutations-2.d

@@ -0,0 +1,86 @@
+import std.algorithm, std.conv, std.traits;
+
+struct Permutations(bool doCopy=true, T) if (isMutable!T) {
+    private immutable size_t num;
+    private T[] items;
+    private uint[31] indexes;
+    private ulong tot;
+
+    this (/*in*/ T[] items) /*pure nothrow*/
+    in {
+        static enum string L = text(indexes.length); // impure
+        assert(items.length >= 0 && items.length <= indexes.length,
+               "Permutations: items.length must be >= 0 && < " ~ L);
+    } 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;
+        foreach (i; 0 .. cast(typeof(indexes[0]))this.num)
+            this.indexes[i] = i;
+        this.tot = factorial(this.num);
+    }
+
+    @property T[] front() pure nothrow {
+        static if (doCopy) {
+            //return items.dup; // Not nothrow.
+            auto items2 = new T[items.length];
+            items2[] = items[];
+            return items2;
+        } else
+            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 (indexes[j] > indexes[j + 1])
+                j--;
+            size_t k = num - 1;
+            while (indexes[j] > indexes[k])
+                k--;
+            swap(indexes[k], indexes[j]);
+            swap(items[k], items[j]);
+
+            size_t r = num - 1;
+            size_t s = j + 1;
+            while (r > s) {
+                swap(indexes[s], indexes[r]);
+                swap(items[s], items[r]);
+                r--;
+                s++;
+            }
+        }
+    }
+}
+
+Permutations!(doCopy,T) permutations(bool doCopy=true, T)
+                                    (/*in*/ T[] items)
+/*pure nothrow*/ if (isMutable!T) {
+    return Permutations!(doCopy, T)(items);
+} unittest {
+    import std.bigint;
+    foreach (p; permutations([BigInt(1), BigInt(2), BigInt(3)]))
+        assert((p[0] + 1) > 0);
+}
+
+version (permutations2_main) {
+    void main() {
+        import std.stdio, std.bigint;
+        foreach (p; permutations!false([1, 2, 3]))
+            writeln(p);
+        alias BigInt B;
+        foreach (p; permutations!false([B(1), B(2), B(3)])) {}
+    }
+}

Task/Permutations/D/permutations-3.d

@@ -0,0 +1,8 @@
+import std.stdio, std.algorithm;
+
+void main() {
+    auto items = [1, 2, 3];
+    do
+        writeln(items);
+    while (items.nextPermutation());
+}

Task/Permutations/Delphi/permutations.delphi

@@ -0,0 +1,58 @@
+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.

Task/Permutations/Erlang/permutations-1.erl

@@ -0,0 +1,5 @@
+-module(permute).
+-export([permute/1]).
+
+permute([]) -> [[]];
+permute(L) -> [[X|Y] || X<-L, Y<-permute(L--[X])].

Task/Permutations/Erlang/permutations-2.erl

@@ -0,0 +1 @@
+F = fun(L) -> G = fun(_, []) -> [[]]; (F, L) -> [[X|Y] || X<-L, Y<-F(F, L--[X])] end, G(G, L) end.

Task/Permutations/Erlang/permutations-3.erl

@@ -0,0 +1,18 @@
+-module(permute).
+
+-export([permute/1]).
+
+permute([]) -> [[]];
+permute(L) -> zipper(L, [], []).
+
+% Use zipper to pick up first element of permutation
+zipper([], _, Acc) -> lists:reverse(Acc);
+zipper([H|T], R, Acc) ->
+  % 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], Acc).
+
+prepend(_, [], T, R, Acc) -> zipper(T, R, Acc); % continue in zipper
+prepend(X, [H|T], ZT, ZR, Acc) -> prepend(X, T, ZT, ZR, [[X|H]|Acc]).

Task/Permutations/Erlang/permutations-4.erl

@@ -0,0 +1 @@
+main(_) -> io:fwrite("~p~n", [permute:permute([1,2,3])]).

Task/Permutations/Euphoria/permutations.euphoria

@@ -0,0 +1,48 @@
+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

Task/Permutations/Fortran/permutations-1.f

@@ -0,0 +1,33 @@
+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

Task/Permutations/Fortran/permutations-2.f

@@ -0,0 +1,41 @@
+      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

Task/Permutations/GAP/permutations-1.gap

@@ -0,0 +1,6 @@
+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 ] ]

Task/Permutations/GAP/permutations-2.gap

@@ -0,0 +1,4 @@
+# All arrangements of 4 elements in 1..4
+Arrangements([1..4], 4);
+# All permutations of 1..4
+PermutationsList([1..4]);

Task/Permutations/GAP/permutations-3.gap

@@ -0,0 +1,44 @@
+NextPermutation := function(a)
+   local i, j, k, n, t;
+   n := Length(a);
+   i := n - 1;
+   while i > 0 and a[i] > a[i + 1] do
+      i := i - 1;
+   od;
+   j := i + 1;
+   k := n;
+   while j < k do
+      t := a[j];
+      a[j] := a[k];
+      a[k] := t;
+      j := j + 1;
+      k := k - 1;
+   od;
+   if i = 0 then
+      return false;
+   else
+      j := i + 1;
+      while a[j] < a[i] do
+         j := j + 1;
+      od;
+      t := a[i];
+      a[i] := a[j];
+      a[j] := t;
+      return true;
+   fi;
+end;
+
+Permutations := function(n)
+   local a, L;
+   a := List([1 .. n], x -> x);
+   L := [ ];
+   repeat
+      Add(L, ShallowCopy(a));
+   until not NextPermutation(a);
+   return L;
+end;
+
+Permutations(3);
+[ [ 1, 2, 3 ], [ 1, 3, 2 ],
+  [ 2, 1, 3 ], [ 2, 3, 1 ],
+  [ 3, 1, 2 ], [ 3, 2, 1 ] ]

Task/Permutations/Go/permutations.go

@@ -0,0 +1,52 @@
+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))
+}

Task/Permutations/Groovy/permutations-1.groovy

@@ -0,0 +1 @@
+def makePermutations = { l -> l.permutations() }

Task/Permutations/Groovy/permutations-2.groovy

@@ -0,0 +1,4 @@
+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 }

Task/Permutations/Haskell/permutations-1.hs

@@ -0,0 +1,3 @@
+import Data.List (permutations)
+
+main = mapM_ print (permutations [1,2,3])

Task/Permutations/Haskell/permutations-2.hs

@@ -0,0 +1,5 @@
+import Data.List (delete)
+
+permutations :: Eq a -> [a] -> [[a]]
+permutations [] = [[]]
+permutations xs = [ x:ys | x <- xs, ys <- permutations (delete x xs)]

Task/Permutations/Haskell/permutations-3.hs

@@ -0,0 +1,5 @@
+permutations :: [a] -> [[a]]
+permutations [] = [[]]
+permutations xs = [ y:zs | (y,ys) <- select xs, zs <- permutations ys]
+  where select []     = []
+        select (x:xs) = (x,xs) : [ (y,x:ys) | (y,ys) <- select xs ]

Task/Permutations/Haskell/permutations-4.hs

@@ -0,0 +1,5 @@
+permutations :: [a] -> [[a]]
+permutations = foldr (concatMap . insertEverywhere) [[]]
+  where insertEverywhere :: a -> [a] -> [[a]]
+        insertEverywhere x [] = [[x]]
+        insertEverywhere x l@(y:ys) = (x:l) : map (y:) (insertEverywhere x ys)

Task/Permutations/Icon/permutations.icon

@@ -0,0 +1,8 @@
+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

Task/Permutations/J/permutations-1.j

@@ -0,0 +1 @@
+perms=: A.&i.~ !

Task/Permutations/J/permutations-2.j

@@ -0,0 +1,10 @@
+   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

Task/Permutations/Java/permutations-1.java

@@ -0,0 +1,83 @@
+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

Task/Permutations/Java/permutations-2.java

@@ -0,0 +1,5 @@
+public class Permutations {
+	public static void main(String[] args) {
+		System.out.println(Utils.Permutations(Utils.mRange(1, 3)));
+	}
+}

Task/Permutations/JavaScript/permutations.js

@@ -0,0 +1,23 @@
+<html><head><title>Permutations</title></head>
+<body><pre id="result"></pre>
+<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>

Task/Permutations/K/permutations.k

@@ -0,0 +1,12 @@
+   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

Task/Permutations/Logtalk/permutations-1.logtalk

@@ -0,0 +1,22 @@
+:- 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.

Task/Permutations/Logtalk/permutations-2.logtalk

@@ -0,0 +1,9 @@
+| ?- 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

Task/Permutations/Lua/permutations.lua

@@ -0,0 +1,17 @@
+local function permutation(a, n, cb)
+	if n == 0 then
+		cb(a)
+	else
+		for i = 1, n do
+			a[i], a[n] = a[n], a[i]
+			permutation(a, n - 1, cb)
+			a[i], a[n] = a[n], a[i]
+		end
+	end
+end
+
+--Usage
+local function callback(a)
+	print('{'..table.concat(a, ', ')..'}')
+end
+permutation({1,2,3}, 3, callback)

Task/Permutations/Maple/permutations.maple

@@ -0,0 +1,5 @@
+> combinat:-permute( 3 );
+   [[1, 2, 3], [1, 3, 2], [2, 1, 3], [2, 3, 1], [3, 1, 2], [3, 2, 1]]
+
+> combinat:-permute( [a,b,c] );
+   [[a, b, c], [a, c, b], [b, a, c], [b, c, a], [c, a, b], [c, b, a]]

Task/Permutations/Mathematica/permutations.math

@@ -0,0 +1 @@
+Permutations[{1,2,3,4}]

Task/Permutations/Maxima/permutations-1.maxima

@@ -0,0 +1,24 @@
+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] */

Task/Permutations/Maxima/permutations-2.maxima

@@ -0,0 +1,2 @@
+(%i1) permutations([1, 2, 3]);
+(%o1) {[1, 2, 3], [1, 3, 2], [2, 1, 3], [2, 3, 1], [3, 1, 2], [3, 2, 1]}

Task/Permutations/OCaml/permutations-1.ocaml

@@ -0,0 +1,45 @@
+(* 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 *)

Task/Permutations/OCaml/permutations-2.ocaml

@@ -0,0 +1,15 @@
+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])

Task/Permutations/OCaml/permutations-3.ocaml

@@ -0,0 +1,17 @@
+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]

Task/Permutations/PARI-GP/permutations.pari

@@ -0,0 +1 @@
+vector(n!,k,numtoperm(n,k))

Task/Permutations/Pascal/permutations.pascal

@@ -0,0 +1,71 @@
+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.

Task/Permutations/Perl-6/permutations-1.pl6

@@ -0,0 +1,8 @@
+sub postfix:<!>(@a) {
+    @a == 1 ?? [@a] !!
+    gather for @a -> $a {
+        take [ $a, @$_ ] for @a.grep(none $a)!
+    }
+}
+
+.say for <a b c>!

Task/Permutations/Perl-6/permutations-2.pl6

@@ -0,0 +1,16 @@
+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 ...^ !*;

Task/Permutations/Perl/permutations.pl

@@ -0,0 +1,8 @@
+# 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);

Task/Permutations/PicoLisp/permutations.l

@@ -0,0 +1,3 @@
+(load "@lib/simul.l")
+
+(permute (1 2 3))

Task/Permutations/PowerBASIC/permutations.powerbasic

@@ -0,0 +1,26 @@
+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

Task/Permutations/Prolog/permutations-1.pro

@@ -0,0 +1,7 @@
+:- use_module(library(clpfd)).
+
+permut_clpfd(L, N) :-
+    length(L, N),
+    L ins 1..N,
+    all_different(L),
+    label(L).

Task/Permutations/Prolog/permutations-2.pro

@@ -0,0 +1,8 @@
+?- 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.

Task/Permutations/Prolog/permutations-3.pro

@@ -0,0 +1,7 @@
+% 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).

Task/Permutations/Prolog/permutations-4.pro

@@ -0,0 +1,8 @@
+ ?- 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.

Task/Permutations/PureBasic/permutations.purebasic

@@ -0,0 +1,57 @@
+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

Task/Permutations/Python/permutations.py

@@ -0,0 +1,3 @@
+import itertools
+for values in itertools.permutations([1,2,3]):
+    print (values)

Task/Permutations/Qi/permutations.qi

@@ -0,0 +1,19 @@
+(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))))

Task/Permutations/R/permutations.r

@@ -0,0 +1,48 @@
+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

Task/Permutations/REXX/permutations-1.rexx

@@ -0,0 +1,34 @@
+/*REXX program generates all permutations of  N  different objects.     */
+parse arg things bunch inbetweenChars names
+
+      /* inbetweenChars  (optional)   defaults to a  [null].            */
+      /*          names  (optional)   defaults to digits (and letters). */
+
+call permSets things,bunch,inbetweenChars,names
+exit                                   /*stick a fork in it, we're done.*/
+/*──────────────────────────────────.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               /*build permutation recursively. */
+                do k=1 for ?-1;  if @.k==$.q then iterate q;  end    /*k*/
+            @.?=$.q;      call .permset ?+1
+            end    /*q*/
+return
+/*──────────────────────────────────PERMSETS subroutine─────────────────*/
+permSets: procedure; parse arg x,y,between,uSyms /*X things Y at a time.*/
+@.=;   sep=                            /*X  can't be > length(@0abcs).  */
+@abc  = 'abcdefghijklmnopqrstuvwxyz';     @abcU=@abc;         upper @abcU
+@abcS = @abcU || @abc;                    @0abcS=123456789 || @abcS
+
+  do k=1 for x                         /*build a list of (perm) symbols.*/
+  _=p(word(uSyms,k)  p(substr(@0abcS,k,1) k))   /*get|generate a symbol.*/
+  if length(_)\==1  then sep='_'       /*if not 1st char, then use sep. */
+  $.k=_                                /*append it to the symbol list.  */
+  end
+
+if between==''  then between=sep       /*use the appropriate separator. */
+list='$. @. between x y'
+call .permset 1
+return
+/*──────────────────────────────────P subroutine (Pick one)─────────────*/
+p:  return word(arg(1),1)

Task/Permutations/REXX/permutations-2.rexx

@@ -0,0 +1,22 @@
+/*REXX program shows permutations of '''N''' number of objects (1,2,3, ...).*/
+parse arg n .;   if n=='' then n=3     /*Not specified?   Assume default*/
+                                       /*populate the first permutation.*/
+        do pop=1 for n;           @.pop=pop  ;   end;          call tell n
+
+        do while nextperm(n,0);   call tell n;   end
+exit                                   /*stick a fork in it, we're done.*/
+/*──────────────────────────────────NEXTPERM subroutine─────────────────*/
+nextperm:  procedure expose @.;    parse arg n,i;    nm=n-1
+
+  do k=nm by -1 for nm;   kp=k+1
+  if @.k<@.kp then  do;   i=k;   leave;   end
+  end   /*k*/
+
+      do j=i+1  while j<n;  parse value @.j @.n with @.n @.j;  n=n-1;  end
+
+if i==0 then return 0
+                                         do j=i+1  while @.j<@.i;   end
+parse  value   @.j @.i  with   @.i @.j
+return 1
+/*──────────────────────────────────TELL subroutine─────────────────────*/
+tell: procedure expose @.; _=; do j=1 for arg(1);_=_ @.j;end; say _;return

Task/Permutations/Ruby/permutations-1.rb

@@ -0,0 +1 @@
+p [1,2,3].permutation.to_a

Task/Permutations/Ruby/permutations-2.rb

@@ -0,0 +1,37 @@
+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, 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

Task/Permutations/Run-BASIC/permutations.run

@@ -0,0 +1,25 @@
+list$ = "h,e,l,l,o"		' supply list seperated with comma's
+
+while word$(list$,d+1,",") <> ""  'Count how many in the list
+d = d + 1
+wend
+
+dim theList$(d)			' place list in array
+for i = 1 to d
+  theList$(i) = word$(list$,i,",")
+next i
+
+for i = 1 to d			' print the Permutations
+ for j = 2 to d
+   perm$ = ""
+   for k = 1 to d
+    perm$ = perm$ + theList$(k)
+   next k
+   if instr(perms$,perm$+",") = 0 then print perm$ ' only list 1 time
+   perms$ 	 = perms$ + perm$ + ","
+   h$		 = theList$(j)
+   theList$(j)	 = theList$(j - 1)
+   theList$(j-1) = h$
+  next j
+next i
+end

Task/Permutations/SAS/permutations.sas

@@ -0,0 +1,42 @@
+/* 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;

Task/Permutations/Scala/permutations.scala

@@ -0,0 +1 @@
+List('a, 'b, 'c).permutations foreach println

Task/Permutations/Scheme/permutations-1.ss

@@ -0,0 +1,19 @@
+(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))))))

Task/Permutations/Scheme/permutations-2.ss

@@ -0,0 +1,61 @@
+; 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

Task/Permutations/Scheme/permutations-3.ss

@@ -0,0 +1,11 @@
+(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)))

Task/Permutations/Seed7/permutations.seed7

@@ -0,0 +1,37 @@
+$ 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;

Task/Permutations/Smalltalk/permutations.st

@@ -0,0 +1,2 @@
+(1 to: 4) permutationsDo: [ :x |
+	Transcript show: x printString; cr ].

Task/Permutations/Tcl/permutations.tcl

@@ -0,0 +1,10 @@
+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
+}

Task/Permutations/Ursala/permutations-1.ursala

@@ -0,0 +1,9 @@
+#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

Task/Permutations/Ursala/permutations-2.ursala

@@ -0,0 +1,3 @@
+#cast %nLL
+
+test = permutations <1,2,3>

Task/Permutations/VBA/permutations.vba

@@ -0,0 +1,64 @@
+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

Task/Permutations/XPL0/permutations.xpl0

@@ -0,0 +1,25 @@
+code ChOut=8, CrLf=9;
+def  N=4;                       \number of objects (letters)
+char S0, S1(N);
+
+proc Permute(D);                \Display all permutations of letters in S0
+int D;                          \depth of recursion
+int I, J;
+[if D=N then
+        [for I:= 0 to N-1 do ChOut(0, S1(I));
+        CrLf(0);
+        return;
+        ];
+for I:= 0 to N-1 do
+        [for J:= 0 to D-1 do    \check if object (letter) already used
+                if S1(J) = S0(I) then J:=100;
+        if J<100 then
+                [S1(D):= S0(I); \object (letter) not used so append it
+                Permute(D+1);   \recurse next level deeper
+                ];
+        ];
+];
+
+[S0:= "rose ";                  \N different objects (letters)
+Permute(0);                     \(space char avoids MSb termination)
+]