update

Task/Permutations/00DESCRIPTION

@@ -2,3 +2,6 @@ Write a program that generates all [[wp:Permutation|permutations]] of '''n''' di
 ;Cf.
 * [[Find the missing permutation]]
 * [[Permutations/Derangements]]
+
+'''See Also:'''
+{{Template:Combinations and permutations}}

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

@@ -1,61 +1,33 @@
-# Document prelude template usage:
-TEMPLATE(
-  INT upb values := 4;
-  MODE VALUE = INT;
-  FORMAT value fmt := $g(0)$
-); #
+# -*- coding: utf-8 -*- #
 
-MODE
-  VALVALUES = [upb values]VALUE, VALUES = REF VALVALUES,
-  YIELDVALUES = PROC(VALUES)VOID;
+COMMENT REQUIRED BY "prelude_permutations.a68"
+  MODE PERMDATA = ~;
+PROVIDES:
+# PERMDATA*=~* #
+# perm*=~ list* #
+END COMMENT
 
-FORMAT
-  values fmt := $"("n(upb values-1)(f(value fmt)", ")f(value fmt)")"$;
+MODE PERMDATALIST = REF[]PERMDATA;
+MODE PERMDATALISTYIELD = PROC(PERMDATALIST)VOID;
 
-# Generate permutations of the input values of valueues #
-PROC gen values permutations = (VALUES values, YIELDVALUES yield)VOID: (
+# Generate permutations of the input data list of data list #
+PROC perm gen permutations = (PERMDATALIST data list, PERMDATALISTYIELD yield)VOID: (
 # Warning: this routine does not correctly handle duplicate elements #
-  IF LWB values = UPB values THEN
-    yield(values)
+  IF LWB data list = UPB data list THEN
+    yield(data list)
   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)
+    FOR elem FROM LWB data list TO UPB data list DO
+      PERMDATA first = data list[elem];
+      data list[LWB data list+1:elem] := data list[:elem-1];
+      data list[LWB data list] := first;
+    # FOR PERMDATALIST next data list IN # perm gen permutations(data list[LWB data list+1:] # ) DO #,
+    ##   (PERMDATALIST next)VOID:(
+        yield(data list)
     # OD #));
-      values[:elem-1] := values[LWB values+1:elem];
-      values[elem] := first
+      data list[:elem-1] := data list[LWB data list+1:elem];
+      data list[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
-);
+SKIP

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

@@ -1,23 +1,24 @@
-#!/usr/local/bin/a68g --script #
+#!/usr/bin/a68g --script #
+# -*- coding: utf-8 -*- #
 
-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)$
-# ) #;
+CO REQUIRED BY "prelude_permutations.a68" CO
+  MODE PERMDATA = INT;
+#PROVIDES:#
+# PERM*=INT* #
+# perm *=int list *#
+PR READ "prelude_permutations.a68" PR;
 
 main:(
-  VALVALUES test case := (1, 22, 333, 44444);
-  print(("Number of permutations: ", UPB test case P 1, new line));
+  FLEX[0]PERMDATA test case := (1, 22, 333, 44444);
 
-COMMENT # Use the generator: #
-  # FOR ARRAY values IN # test case DOPERM (
-  ##   (ARRAY values)VOID:(
-      printf((values fmt, values, $l$))
-  # OD #));
-END COMMENT
+  INT upb data list = UPB test case;
+  FORMAT
+    data fmt := $g(0)$,
+    data list fmt := $"("n(upb data list-1)(f(data fmt)", ")f(data fmt)")"$;
+
+# FOR DATALIST permutation IN # perm gen permutations(test case#) DO (#,
+##   (PERMDATALIST permutation)VOID:(
+    printf((data list fmt, permutation, $l$))
+# OD #))
 
-# or simply the operator: #
-  printf(($f(values fmt)l$, PERM test case))
 )

Task/Permutations/Ada/permutations-1.ada

@@ -0,0 +1,9 @@
+generic
+   N: positive;
+package Generic_Perm is
+   subtype Element is Positive range 1 .. N;
+   type Permutation is array(Element) of Element;
+
+   procedure Set_To_First(P: out Permutation; Is_Last: out Boolean);
+   procedure Go_To_Next(P: in out Permutation; Is_Last: out Boolean);
+end Generic_Perm;

Task/Permutations/Ada/permutations-2.ada

@@ -0,0 +1,71 @@
+package body Generic_Perm is
+
+
+   procedure Set_To_First(P: out Permutation; Is_Last: out Boolean) is
+   begin
+      for I in P'Range loop
+	 P (I) := I;
+      end loop;
+      Is_Last := P'Length = 1;
+      -- if P has a single element, the fist permutation is the last one
+   end Set_To_First;
+
+   procedure Go_To_Next(P: in out Permutation; Is_Last: out Boolean) is
+
+      procedure Swap (A, B : in out Integer) is
+         C : Integer := A;
+      begin
+         A := B;
+         B := C;
+      end Swap;
+
+      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 Go_To_Next;
+
+end Generic_Perm;

Task/Permutations/Ada/permutations-3.ada

@@ -0,0 +1,30 @@
+with Ada.Text_IO, Ada.Command_Line, Generic_Perm;
+
+procedure Print_Perms is
+   package CML renames Ada.Command_Line;
+   package TIO renames Ada.Text_IO;
+begin
+   declare
+      package Perms is new Generic_Perm(Positive'Value(CML.Argument(1)));
+      P : Perms.Permutation;
+      Done : Boolean := False;
+
+      procedure Print(P: Perms.Permutation) is
+      begin
+         for I in P'Range loop
+            TIO.Put (Perms.Element'Image (P (I)));
+         end loop;
+         TIO.New_Line;
+      end Print;
+   begin
+      Perms.Set_To_First(P, Done);
+      loop
+         Print(P);
+         exit when Done;
+         Perms.Go_To_Next(P, Done);
+      end loop;
+   end;
+exception
+   when Constraint_Error
+     => TIO.Put_Line ("*** Error: enter one numerical argument n with n >= 1");
+end Print_Perms;

Task/Permutations/NetRexx/permutations.netrexx

@@ -0,0 +1,148 @@
+/* NetRexx */
+options replace format comments java crossref symbols nobinary
+
+import java.util.List
+import java.util.ArrayList
+
+-- =============================================================================
+/**
+ * Permutation Iterator
+ * <br />
+ * <br />
+ * Algorithm by E. W. Dijkstra, "A Discipline of Programming", Prentice-Hall, 1976, p.71
+ */
+class RPermutationIterator implements Iterator
+
+  -- ---------------------------------------------------------------------------
+  properties indirect
+    perms = List
+    permOrders = int[]
+    maxN
+    currentN
+    first = boolean
+
+  -- ---------------------------------------------------------------------------
+  properties constant
+    isTrue  = boolean (1 == 1)
+    isFalse = boolean (1 \= 1)
+
+  -- ---------------------------------------------------------------------------
+  method RPermutationIterator(initial = List) public
+    setUp(initial)
+    return
+
+  -- ---------------------------------------------------------------------------
+  method RPermutationIterator(initial = Object[]) public
+    init = ArrayList(initial.length)
+    loop elmt over initial
+      init.add(elmt)
+      end elmt
+    setUp(init)
+    return
+
+  -- ---------------------------------------------------------------------------
+  method RPermutationIterator(initial = Rexx[]) public
+    init = ArrayList(initial.length)
+    loop elmt over initial
+      init.add(elmt)
+      end elmt
+    setUp(init)
+    return
+
+  -- ---------------------------------------------------------------------------
+  method setUp(initial = List) private
+    setFirst(isTrue)
+    setPerms(initial)
+    setPermOrders(int[getPerms().size()])
+    setMaxN(getPermOrders().length)
+    setCurrentN(0)
+    po = getPermOrders()
+    loop i_ = 0 while i_ < po.length
+      po[i_] = i_
+      end i_
+    return
+
+  -- ---------------------------------------------------------------------------
+  method hasNext() public returns boolean
+    status = isTrue
+    if getCurrentN() == factorial(getMaxN()) then status = isFalse
+    setCurrentN(getCurrentN() + 1)
+    return status
+
+  -- ---------------------------------------------------------------------------
+  method next() public returns Object
+    if isFirst() then setFirst(isFalse)
+    else do
+      po = getPermOrders()
+      i_ = getMaxN() - 1
+      loop while po[i_ - 1] >= po[i_]
+        i_ = i_ - 1
+        end
+
+      j_ = getMaxN()
+      loop while po[j_ - 1] <= po[i_ - 1]
+        j_ = j_ - 1
+        end
+
+      swap(i_ - 1, j_ - 1)
+
+      i_ = i_ + 1
+      j_ = getMaxN()
+      loop while i_ < j_
+        swap(i_ - 1, j_ - 1)
+        i_ = i_ + 1
+        j_ = j_ - 1
+        end
+      end
+    return reorder()
+
+  -- ---------------------------------------------------------------------------
+  method remove() public signals UnsupportedOperationException
+    signal UnsupportedOperationException()
+
+  -- ---------------------------------------------------------------------------
+  method swap(i_, j_) private
+    po = getPermOrders()
+    save   = po[i_]
+    po[i_] = po[j_]
+    po[j_] = save
+    return
+
+  -- ---------------------------------------------------------------------------
+  method reorder() private returns List
+    result = ArrayList(getPerms().size())
+    loop ix over getPermOrders()
+      result.add(getPerms().get(ix))
+      end ix
+    return result
+
+  -- ---------------------------------------------------------------------------
+  /**
+   * Calculate n factorial: {@code n! = 1 * 2 * 3 .. * n}
+   * @param n
+   * @return n!
+   */
+  method factorial(n) public static
+    fact = 1
+    if n > 1 then loop i = 1 while i <= n
+      fact = fact * i
+      end i
+    return fact
+
+  -- ---------------------------------------------------------------------------
+  method main(args = String[]) public static
+    thing02 = RPermutationIterator(['alpha', 'omega'])
+    thing03 = RPermutationIterator([String 'one', 'two', 'three'])
+    thing04 = RPermutationIterator(Arrays.asList([Integer(1), Integer(2), Integer(3), Integer(4)]))
+    things = [thing02, thing03, thing04]
+    loop thing over things
+      N = thing.getMaxN()
+      say 'Permutations:' N'! =' factorial(N)
+      loop lineCount = 1 while thing.hasNext()
+        prm = thing.next()
+        say lineCount.right(8)':' prm.toString()
+        end lineCount
+      say 'Permutations:' N'! =' factorial(N)
+      say
+      end thing
+    return

Task/Permutations/Racket/permutations.rkt

@@ -0,0 +1,13 @@
+#lang racket
+
+;; using a builtin
+(permutations '(A B C))
+;; -> '((A B C) (B A C) (A C B) (C A B) (B C A) (C B A))
+
+;; a random simple version (which is actually pretty good for a simple version)
+(define (perms l)
+  (let loop ([l l] [tail '()])
+    (if (null? l) (list tail)
+        (append-map (λ(x) (loop (remq x l) (cons x tail))) l))))
+(perms '(A B C))
+;; -> '((C B A) (B C A) (C A B) (A C B) (B A C) (A B C))