Data commit

Task/Permutations-by-swapping/00-META.yaml

@@ -0,0 +1,2 @@
+---
+from: http://rosettacode.org/wiki/Permutations_by_swapping

Task/Permutations-by-swapping/00-TASK.txt

@@ -0,0 +1,24 @@
+;Task:
+Generate permutations of n items in which successive permutations differ from each other by the swapping of any two items. 
+
+Also generate the sign of the permutation which is +1 when the permutation is generated from an even number of swaps from the initial state, and -1 for odd. 
+
+Show the permutations and signs of three items, in order of generation ''here''.
+
+Such data are of use in generating the [[Matrix arithmetic|determinant]] of a square matrix and any functions created should bear this in mind.
+
+Note: The Steinhaus–Johnson–Trotter algorithm generates successive permutations where ''adjacent'' items are swapped, but from [[wp:Parity_of_a_permutation#Example|this]] discussion adjacency is not a requirement.
+
+
+;References:
+* [[wp:Steinhaus–Johnson–Trotter algorithm|Steinhaus–Johnson–Trotter algorithm]]
+* [http://www.cut-the-knot.org/Curriculum/Combinatorics/JohnsonTrotter.shtml Johnson-Trotter Algorithm Listing All Permutations]
+* [[wp:Heap's algorithm|Heap's algorithm]]
+* [http://www.gutenberg.org/files/18567/18567-h/18567-h.htm#ch7] Tintinnalogia
+
+
+;Related tasks:
+*   [[Matrix arithmetic]]
+*   [[Gray code]]
+<br><br>
+

Task/Permutations-by-swapping/11l/permutations-by-swapping.11l

@@ -0,0 +1,18 @@
+F s_permutations(seq)
+   V items = [[Int]()]
+   L(j) seq
+      [[Int]] new_items
+      L(item) items
+         I L.index % 2
+            new_items [+]= (0..item.len).map(i -> @item[0 .< i] [+] [@j] [+] @item[i..])
+         E
+            new_items [+]= (item.len..0).step(-1).map(i -> @item[0 .< i] [+] [@j] [+] @item[i..])
+      items = new_items
+
+   R enumerate(items).map((i, item) -> (item, I i % 2 {-1} E 1))
+
+L(n) (3, 4)
+   print(‘Permutations and sign of #. items’.format(n))
+   L(perm, sgn) s_permutations(Array(0 .< n))
+      print(‘Perm: #. Sign: #2’.format(perm, sgn))
+   print()

Task/Permutations-by-swapping/ALGOL-68/permutations-by-swapping.alg

@@ -0,0 +1,42 @@
+BEGIN # Heap's algorithm for generating permutations - from the pseudo-code on the Wikipedia page #
+    # generate permutations of a #
+    PROC generate = ( INT k, REF[]INT a, REF INT swap count )VOID:
+         IF k = 1 THEN
+            output permutation( a, swap count )
+         ELSE
+            # Generate permutations with kth unaltered #
+            # Initially k = length a #
+            generate( k - 1, a, swap count );
+            # Generate permutations for kth swapped with each k-1 initial #
+            FOR i FROM 0 TO k - 2 DO
+                # Swap choice dependent on parity of k (even or odd) #
+                swap count +:= 1;
+                INT swap item = IF ODD k THEN 0 ELSE i FI;
+                INT t           = a[ swap item ];
+                a[ swap item ] := a[ k - 1 ];
+                a[ k - 1     ] := t;
+                generate( k - 1, a, swap count )
+            OD
+         FI # generate # ;
+    # generate permutations of a #
+    PROC permute = ( REF[]INT a )VOID:
+         BEGIN
+            INT swap count := 0;
+            generate( ( UPB a + 1 ) - LWB a, a[ AT 0 ], swap count )
+         END # permute # ;
+
+    # handle a permutation #
+    PROC output permutation = ( REF[]INT a, INT swap count )VOID:
+         BEGIN
+            print( ( "[" ) );
+            FOR i FROM LWB a TO UPB a DO
+               print( ( whole( a[ i ], 0 ) ) );
+               IF i = UPB a THEN print( ( "]" ) ) ELSE print( ( ", " ) ) FI
+            OD;
+            print( ( " sign: ", IF ODD swap count THEN "-1" ELSE " 1" FI, newline ) )
+         END # output permutation # ;
+
+    [ 1 : 3 ]INT a := ( 1, 2, 3 );
+    permute( a )
+
+END

Task/Permutations-by-swapping/Arturo/permutations-by-swapping.arturo

@@ -0,0 +1,39 @@
+permutations: function [arr][
+    d: 1
+    c: array.of: size arr 0
+    xs: new arr
+    sign: 1
+
+    ret: new @[@[xs, sign]]
+
+    while [true][
+        while [d > 1][
+            d: d-1
+            c\[d]: 0
+        ]
+
+        while [c\[d] >= d][
+            d: d+1
+            if d >= size arr -> return ret
+        ]
+
+        i: (1 = and d 1)? -> c\[d] -> 0
+        tmp: xs\[i]
+        xs\[i]: xs\[d]
+        xs\[d]: tmp
+
+        sign: neg sign
+        'ret ++ @[new @[xs, sign]]
+        c\[d]: c\[d] + 1
+    ]
+
+    return ret
+]
+
+loop permutations 0..2 'row ->
+    print [row\0 "-> sign:" row\1]
+
+print ""
+
+loop permutations 0..3 'row ->
+    print [row\0 "-> sign:" row\1]

Task/Permutations-by-swapping/AutoHotkey/permutations-by-swapping-1.ahk

@@ -0,0 +1,10 @@
+Permutations_By_Swapping(str, list:=""){
+	ch := SubStr(str, 1, 1)								; get left-most charachter of str
+	for i, line in StrSplit(list, "`n")					; for each line in list
+		loop % StrLen(line) + 1							; loop each possible position
+			Newlist .= RegExReplace(line, mod(i,2) ? "(?=.{" A_Index-1 "}$)" : "^.{" A_Index-1 "}\K", ch) "`n"
+	list := Newlist ? Trim(Newlist, "`n") : ch			; recreate list
+	if !str := SubStr(str, 2)							; remove charachter from left hand side
+		return list										; done if str is empty
+	return Permutations_By_Swapping(str, list)			; else recurse
+}

Task/Permutations-by-swapping/AutoHotkey/permutations-by-swapping-2.ahk

@@ -0,0 +1,4 @@
+for each, line in StrSplit(Permutations_By_Swapping(1234), "`n")
+	result .= line "`tSign: " (mod(A_Index,2)? 1 : -1) "`n"
+MsgBox, 262144, , % result
+return

Task/Permutations-by-swapping/BASIC256/permutations-by-swapping.basic

@@ -0,0 +1,38 @@
+call perms(3)
+print
+call perms(4)
+end
+
+subroutine perms(n)
+    dim p((n+1)*4)
+    for i = 1 to n
+        p[i] = -i
+    next i
+    s = 1
+
+    do
+        print "Perm: [ ";
+        for i = 1 to n
+            print abs(p[i]); " ";
+        next i
+        print "] Sign: "; s
+
+        k = 0
+        for i = 2 to n
+            if p[i] < 0 and (abs(p[i]) > abs(p[i-1])) and (abs(p[i]) > abs(p[k])) then k = i
+        next i
+        for i = 1 to n-1
+            if p[i] > 0 and (abs(p[i]) > abs(p[i+1])) and (abs(p[i]) > abs(p[k])) then k = i
+        next i
+        if k then
+            for i = 1 to n    #reverse elements > k
+                if abs(p[i]) > abs(p[k]) then p[i] = -p[i]
+            next i
+            if p[k] < 0 then i = k-1 else i = k+1
+            temp = p[k]
+            p[k] = p[i]
+            p[i] = temp
+            s = -s
+        end if
+    until k = 0
+end subroutine

Task/Permutations-by-swapping/BBC-BASIC/permutations-by-swapping.basic

@@ -0,0 +1,35 @@
+      PROCperms(3)
+      PRINT
+      PROCperms(4)
+      END
+
+      DEF PROCperms(n%)
+      LOCAL p%(), i%, k%, s%
+      DIM p%(n%)
+      FOR i% = 1 TO n%
+        p%(i%) = -i%
+      NEXT
+      s% = 1
+      REPEAT
+        PRINT "Perm: [ ";
+        FOR i% = 1 TO n%
+          PRINT ;ABSp%(i%) " ";
+        NEXT
+        PRINT "] Sign: ";s%
+        k% = 0
+        FOR i% = 2 TO n%
+          IF p%(i%)<0 IF ABSp%(i%)>ABSp%(i%-1) IF ABSp%(i%)>ABSp%(k%) k% = i%
+        NEXT
+        FOR i% = 1 TO n%-1
+          IF p%(i%)>0 IF ABSp%(i%)>ABSp%(i%+1) IF ABSp%(i%)>ABSp%(k%) k% = i%
+        NEXT
+        IF k% THEN
+          FOR i% = 1 TO n%
+            IF ABSp%(i%)>ABSp%(k%) p%(i%) *= -1
+          NEXT
+          i% = k%+SGNp%(k%)
+          SWAP p%(k%),p%(i%)
+          s% = -s%
+        ENDIF
+      UNTIL k% = 0
+      ENDPROC

Task/Permutations-by-swapping/C++/permutations-by-swapping.cpp

@@ -0,0 +1,62 @@
+#include <iostream>
+#include <vector>
+
+using namespace std;
+
+vector<int> UpTo(int n, int offset = 0)
+{
+	vector<int> retval(n);
+	for (int ii = 0; ii < n; ++ii)
+		retval[ii] = ii + offset;
+	return retval;
+}
+
+struct JohnsonTrotterState_
+{
+	vector<int> values_;
+	vector<int> positions_;	// size is n+1, first element is not used
+	vector<bool> directions_;
+	int sign_;
+
+	JohnsonTrotterState_(int n) : values_(UpTo(n, 1)), positions_(UpTo(n + 1, -1)), directions_(n + 1, false), sign_(1) {}
+
+	int LargestMobile() const	// returns 0 if no mobile integer exists
+	{
+		for (int r = values_.size(); r > 0; --r)
+		{
+			const int loc = positions_[r] + (directions_[r] ? 1 : -1);
+			if (loc >= 0 && loc < values_.size() && values_[loc] < r)
+				return r;
+		}
+		return 0;
+	}
+
+	bool IsComplete() const { return LargestMobile() == 0; }
+
+	void operator++()	// implement Johnson-Trotter algorithm
+	{
+		const int r = LargestMobile();
+		const int rLoc = positions_[r];
+		const int lLoc = rLoc + (directions_[r] ? 1 : -1);
+		const int l = values_[lLoc];
+		// do the swap
+		swap(values_[lLoc], values_[rLoc]);
+		swap(positions_[l], positions_[r]);
+		sign_ = -sign_;
+		// change directions
+		for (auto pd = directions_.begin() + r + 1; pd != directions_.end(); ++pd)
+			*pd = !*pd;
+	}
+};
+
+int main(void)
+{
+	JohnsonTrotterState_ state(4);
+	do
+	{
+		for (auto v : state.values_)
+			cout << v << " ";
+		cout << "\n";
+		++state;
+	} while (!state.IsComplete());
+}

Task/Permutations-by-swapping/C/permutations-by-swapping.c

@@ -0,0 +1,67 @@
+#include<stdlib.h>
+#include<string.h>
+#include<stdio.h>
+
+int flag = 1;
+
+void heapPermute(int n, int arr[],int arrLen){
+	int temp;
+	int i;
+	
+	if(n==1){
+		printf("\n[");
+		
+		for(i=0;i<arrLen;i++)
+			printf("%d,",arr[i]);
+		printf("\b] Sign : %d",flag);
+		
+		flag*=-1;
+	}
+	else{
+		for(i=0;i<n-1;i++){
+			heapPermute(n-1,arr,arrLen);
+			
+			if(n%2==0){
+				temp = arr[i];
+				arr[i] = arr[n-1];
+				arr[n-1] = temp;
+			}
+			else{
+				temp = arr[0];
+				arr[0] = arr[n-1];
+				arr[n-1] = temp;
+			}
+		}
+		heapPermute(n-1,arr,arrLen);
+	}
+}
+
+int main(int argC,char* argV[0])
+{
+	int *arr, i=0, count = 1;
+	char* token;
+	
+	if(argC==1)
+		printf("Usage : %s <comma separated list of integers>",argV[0]);
+	else{
+		while(argV[1][i]!=00){
+			if(argV[1][i++]==',')
+				count++;
+		}
+		
+		arr = (int*)malloc(count*sizeof(int));
+		
+		i = 0;
+		
+		token = strtok(argV[1],",");
+		
+		while(token!=NULL){
+			arr[i++] = atoi(token);
+			token = strtok(NULL,",");
+		}
+		
+		heapPermute(i,arr,count);
+	}
+		
+	return 0;
+}

Task/Permutations-by-swapping/Clojure/permutations-by-swapping-1.clj

@@ -0,0 +1,37 @@
+(defn permutation-swaps
+  "List of swap indexes to generate all permutations of n elements"
+  [n]
+  (if (= n 2) `((0 1))
+    (let [old-swaps (permutation-swaps (dec n))
+          swaps-> (partition 2 1 (range n))
+          swaps<- (reverse swaps->)]
+      (mapcat (fn [old-swap side]
+                (case side
+                  :first swaps<-
+                  :right (conj swaps<- old-swap)
+                  :left (conj swaps-> (map inc old-swap))))
+              (conj old-swaps nil)
+              (cons :first (cycle '(:left :right)))))))
+
+
+(defn swap [v [i j]]
+  (-> v
+      (assoc i (nth v j))
+      (assoc j (nth v i))))
+
+
+(defn permutations [n]
+  (let [permutations (reduce
+                       (fn [all-perms new-swap]
+                         (conj all-perms (swap (last all-perms)
+                                               new-swap)))
+                       (vector (vec (range n)))
+                       (permutation-swaps n))
+        output (map vector
+                    permutations
+                    (cycle '(1 -1)))]
+    output))
+
+
+(doseq [n [2 3 4]]
+  (dorun (map println (permutations n))))

Task/Permutations-by-swapping/Clojure/permutations-by-swapping-2.clj

@@ -0,0 +1,62 @@
+(ns test-p.core)
+
+(defn numbers-only [x]
+  " Just shows the numbers only for the pairs (i.e. drops the direction --used for display purposes when printing the result"
+  (mapv first x))
+
+(defn next-permutation
+  " Generates next permutation from the current (p) using the Johnson-Trotter technique
+    The code below translates the Python version which has the following steps:
+     p of form [...[n dir]...] such as [[0 1] [1 1] [2 -1]], where n is a number and dir = direction (=1=right, -1=left, 0=don't move)
+     Step: 1 finds the pair [n dir] with the largest value of n (where dir is not equal to 0 (done if none)
+     Step: 2: swap the max pair found with its neighbor in the direction of the pair (i.e. +1 means swap to right, -1 means swap left
+     Step 3: if swapping places the pair a the beginning or end of the list, set the direction = 0 (i.e. becomes non-mobile)
+     Step 4: Set the directions of all pairs whose numbers are greater to the right of where the pair was moved to -1 and to the left to +1 "
+  [p]
+  (if (every? zero? (map second p))
+    nil                                                                 ; no mobile elements (all directions are zero)
+    (let [n (count p)
+          ; Step 1
+          fn-find-max (fn [m]
+                        (first (apply max-key                           ; find the max mobile elment
+                                   (fn [[i x]]
+                                     (if (zero? (second x))
+                                       -1
+                                       (first x)))
+                                              (map-indexed vector p))))
+          i1 (fn-find-max p)                                            ; index of max
+          [n1 d1] (p i1)                                                ; value and direction of max
+          i2 (+ d1 i1)
+          fn-swap (fn [m] (assoc m i2 (m i1) i1 (m i2)))                ; function to swap with neighbor in our step direction
+          fn-update-max (fn [m] (if (or (contains? #{0 (dec n)} i2)     ; update direction of max (where max went)
+                                        (> ((m (+ i2 d1)) 0) n1))
+                                  (assoc-in m [i2 1] 0)
+                                  m))
+          fn-update-others (fn [[i3 [n3 d3]]]                            ; Updates directions of pairs to the left and right of max
+                             (cond                                       ; direction reset to -1 if to right, +1 if to left
+                               (<= n3 n1) [n3 d3]
+                               (< i3 i2) [n3 1]
+                               :else      [n3 -1]))]
+      ; apply steps 2, 3, 4(using functions that where created for these steps)
+      (mapv fn-update-others (map-indexed vector (fn-update-max (fn-swap p)))))))
+
+(defn spermutations
+  " Lazy sequence of permutations of n digits"
+  ; Each element is two element vector (number direction)
+  ; Startup case - generates sequence 0...(n-1) with move direction (1 = move right, -1 = move left, 0 = don't move)
+  ([n] (spermutations 1
+                      (into [] (for [i (range n)] (if (zero? i)
+                                                    [i 0]               ; 0th element is not mobile yet
+                                                    [i -1])))))         ; all others move left
+  ([sign p]
+   (when-let [s (seq p)]
+             (cons [(numbers-only p) sign]
+                   (spermutations (- sign) (next-permutation p))))))   ; recursively tag onto sequence
+
+
+;; Print results for 2, 3, and 4 items
+(doseq [n (range 2 5)]
+  (do
+    (println)
+    (println (format "Permutations and sign of %d items " n))
+  (doseq [q (spermutations n)] (println (format "Perm: %s Sign: %2d" (first q) (second q))))))

Task/Permutations-by-swapping/Common-Lisp/permutations-by-swapping.lisp

@@ -0,0 +1,59 @@
+(defstruct (directed-number (:conc-name dn-))
+  (number nil :type integer)
+  (direction nil :type (member :left :right)))
+
+(defmethod print-object ((dn directed-number) stream)
+  (ecase (dn-direction dn)
+    (:left  (format stream "<~D" (dn-number dn)))
+    (:right (format stream "~D>" (dn-number dn)))))
+
+(defun dn> (dn1 dn2)
+  (declare (directed-number dn1 dn2))
+  (> (dn-number dn1) (dn-number dn2)))
+
+(defun dn-reverse-direction (dn)
+  (declare (directed-number dn))
+  (setf (dn-direction dn) (ecase (dn-direction dn)
+                            (:left  :right)
+                            (:right :left))))
+
+(defun make-directed-numbers-upto (upto)
+  (let ((numbers (make-array upto :element-type 'integer)))
+    (dotimes (n upto numbers)
+      (setf (aref numbers n) (make-directed-number :number (1+ n) :direction :left)))))
+
+(defun max-mobile-pos (numbers)
+  (declare ((vector directed-number) numbers))
+  (loop with pos-limit = (1- (length numbers))
+        with max-value and max-pos
+        for num across numbers
+        for pos from 0
+        do (ecase (dn-direction num)
+             (:left  (when (and (plusp pos) (dn> num (aref numbers (1- pos)))
+                                (or (null max-value) (dn> num max-value)))
+                       (setf max-value num
+                             max-pos   pos)))
+             (:right (when (and (< pos pos-limit) (dn> num (aref numbers (1+ pos)))
+                                (or (null max-value) (dn> num max-value)))
+                       (setf max-value num
+                             max-pos   pos))))
+        finally (return max-pos)))
+
+(defun permutations (upto)
+  (loop with numbers = (make-directed-numbers-upto upto)
+        for max-mobile-pos = (max-mobile-pos numbers)
+        for sign = 1 then (- sign)
+        do (format t "~A sign: ~:[~;+~]~D~%" numbers (plusp sign) sign)
+        while max-mobile-pos
+        do (let ((max-mobile-number (aref numbers max-mobile-pos)))
+             (ecase (dn-direction max-mobile-number)
+               (:left  (rotatef (aref numbers (1- max-mobile-pos))
+                                (aref numbers max-mobile-pos)))
+               (:right (rotatef (aref numbers max-mobile-pos)
+                                (aref numbers (1+ max-mobile-pos)))))
+             (loop for n across numbers
+                   when (dn> n max-mobile-number)
+                     do (dn-reverse-direction n)))))
+
+(permutations 3)
+(permutations 4)

Task/Permutations-by-swapping/D/permutations-by-swapping-1.d

@@ -0,0 +1,84 @@
+import std.algorithm, std.array, std.typecons, std.range;
+
+struct Spermutations(bool doCopy=true) {
+    private immutable uint n;
+    alias TResult = Tuple!(int[], int);
+
+    int opApply(in int delegate(in ref TResult) nothrow dg) nothrow {
+        int result;
+
+        int sign = 1;
+        alias Int2 = Tuple!(int, int);
+        auto p = n.iota.map!(i => Int2(i, i ? -1 : 0)).array;
+        TResult aux;
+
+        aux[0] = p.map!(pi => pi[0]).array;
+        aux[1] = sign;
+        result = dg(aux);
+        if (result)
+            goto END;
+
+        while (p.any!q{ a[1] }) {
+            // Failed to use std.algorithm here, too much complex.
+            auto largest = Int2(-100, -100);
+            int i1 = -1;
+            foreach (immutable i, immutable pi; p)
+                if (pi[1])
+                    if (pi[0] > largest[0]) {
+                        i1 = i;
+                        largest = pi;
+                    }
+            immutable n1 = largest[0],
+                      d1 = largest[1];
+
+            sign *= -1;
+            int i2;
+            if (d1 == -1) {
+                i2 = i1 - 1;
+                p[i1].swap(p[i2]);
+                if (i2 == 0 || p[i2 - 1][0] > n1)
+                    p[i2][1] = 0;
+            } else if (d1 == 1) {
+                i2 = i1 + 1;
+                p[i1].swap(p[i2]);
+                if (i2 == n - 1 || p[i2 + 1][0] > n1)
+                    p[i2][1] = 0;
+            }
+
+            if (doCopy) {
+                aux[0] = p.map!(pi => pi[0]).array;
+            } else {
+                foreach (immutable i, immutable pi; p)
+                    aux[0][i] = pi[0];
+            }
+            aux[1] = sign;
+            result = dg(aux);
+            if (result)
+                goto END;
+
+            foreach (immutable i3, ref pi; p) {
+                immutable n3 = pi[0],
+                          d3 = pi[1];
+                if (n3 > n1)
+                    pi[1] = (i3 < i2) ? 1 : -1;
+            }
+        }
+
+        END: return result;
+    }
+}
+
+Spermutations!doCopy spermutations(bool doCopy=true)(in uint n) {
+    return typeof(return)(n);
+}
+
+version (permutations_by_swapping1) {
+    void main() {
+        import std.stdio;
+        foreach (immutable n; [3, 4]) {
+            writefln("\nPermutations and sign of %d items", n);
+            foreach (const tp; n.spermutations)
+                writefln("Perm: %s  Sign: %2d", tp[]);
+        }
+    }
+}

Task/Permutations-by-swapping/D/permutations-by-swapping-2.d

@@ -0,0 +1,33 @@
+import std.algorithm, std.array, std.typecons, std.range;
+
+auto sPermutations(in uint n) pure nothrow @safe {
+    static immutable(int[])[] inner(in int items) pure nothrow @safe {
+        if (items <= 0)
+            return [[]];
+        typeof(return) r;
+        foreach (immutable i, immutable item; inner(items - 1)) {
+            //r.put((i % 2 ? iota(item.length.signed, -1, -1) :
+            //               iota(item.length + 1))
+            //      .map!(i => item[0 .. i] ~ (items - 1) ~ item[i .. $]));
+            immutable f = (in size_t i) pure nothrow @safe =>
+                item[0 .. i] ~ (items - 1) ~ item[i .. $];
+            r ~= (i % 2) ?
+                 //iota(item.length.signed, -1, -1).map!f.array :
+                 iota(item.length + 1).retro.map!f.array :
+                 iota(item.length + 1).map!f.array;
+        }
+        return r;
+    }
+
+    return inner(n).zip([1, -1].cycle);
+}
+
+void main() {
+    import std.stdio;
+    foreach (immutable n; [2, 3, 4]) {
+        writefln("Permutations and sign of %d items:", n);
+        foreach (immutable tp; n.sPermutations)
+            writefln("  %s Sign: %2d", tp[]);
+        writeln;
+    }
+}

Task/Permutations-by-swapping/Delphi/permutations-by-swapping.delphi

@@ -0,0 +1,211 @@
+{These routines would normally be in a separate library; they are presented here for clarity}
+
+
+{Permutator based on the Johnson and Trotter algorithm.}
+{Which only permutates by swapping a pair of elements at a time}
+{object steps through all permutation of array items}
+{Zero-Based = True = 0..Permutions-1 False = 1..Permutaions}
+{Permutation set on "Create(Size)" or by "Permutations" property}
+{Permutation are contained in the array "Indices"}
+
+type TDirection = (drLeftToRight,drRightToLeft);
+type TDirArray = array of TDirection;
+
+
+type TJTPermutator = class(TObject)
+ private
+  Dir: TDirArray;
+  FZeroBased: boolean;
+  FBase: integer;
+  FPermutations: integer;
+  procedure SetZeroBased(const Value: boolean);
+  procedure SetPermutations(const Value: integer);
+ protected
+   FMax: integer;
+ public
+  NextCount: Integer;
+  Indices: TIntegerDynArray;
+  constructor Create(Size: integer);
+  procedure Reset;
+  function Next: boolean;
+  property ZeroBased: boolean read FZeroBased write SetZeroBased;
+  property Permutations: integer read FPermutations write SetPermutations;
+ end;
+
+
+{==============================================================================}
+
+function Fact(N: integer): integer;
+{Get factorial of N}
+var I: integer;
+begin
+Result:=1;
+for I:=1 to N do Result:=Result * I;
+end;
+
+
+procedure SwapIntegers(var A1,A2: integer);
+{Swap integer arguments}
+var T: integer;
+begin
+T:=A1; A1:=A2; A2:=T;
+end;
+
+
+procedure TJTPermutator.Reset;
+var I: integer;
+begin
+{ Preset items 0..n-1 or 1..n depending on base}
+for I:=0 to High(Indices) do Indices[I]:=I + FBase;
+{ initially all directions are set to RIGHT TO LEFT }
+for I:=0 to High(Indices) do Dir[I]:=drRightToLeft;
+NextCount:=0;
+end;
+
+
+procedure TJTPermutator.SetPermutations(const Value: integer);
+begin
+if FPermutations<>Value then
+	begin
+	FPermutations := Value;
+	SetLength(Indices,Value);
+	SetLength(Dir,Value);
+	Reset;
+	end;
+end;
+
+
+
+constructor TJTPermutator.Create(Size: integer);
+begin
+ZeroBased:=True;
+Permutations:=Size;
+Reset;
+end;
+
+
+
+procedure TJTPermutator.SetZeroBased(const Value: boolean);
+begin
+if FZeroBased<>Value then
+	begin
+	FZeroBased := Value;
+	if Value then FBase:=0
+	else FBase:=1;
+	Reset;
+	end;
+end;
+
+
+function TJTPermutator.Next: boolean;
+{Step to next permutation}
+{Returns true when sequence completed}
+var Mobile,Pos,I: integer;
+var S: string;
+
+	function FindLargestMoble(Mobile: integer): integer;
+	{Find position of largest mobile integer in A}
+	var I: integer;
+	begin
+	for I:=0 to  High(Indices) do
+	 if Indices[I] = Mobile then
+		begin
+		Result:=I + 1;
+		exit;
+		end;
+	Result:=-1;
+	end;
+
+
+	function GetMobile: integer;
+	{ find the largest mobile integer.}
+	var LastMobile, Mobile: integer;
+	var I: integer;
+	begin
+	LastMobile:= 0; Mobile:= 0;
+	for I:=0 to High(Indices) do
+		begin
+		{ direction 0 represents RIGHT TO LEFT.}
+		if (Dir[Indices[I] - 1] = drRightToLeft) and (I<>0) then
+			begin
+			if (Indices[I] > Indices[I - 1]) and (Indices[I] > LastMobile) then
+				begin
+				Mobile:=Indices[I];
+				LastMobile:=Mobile;
+				end;
+			end;
+
+	        { direction 1 represents LEFT TO RIGHT.}
+	        if (dir[Indices[I] - 1] = drLeftToRight) and (i<>(Length(Indices) - 1)) then
+			begin
+			if (Indices[I] > Indices[I + 1]) and (Indices[I] > LastMobile) then
+				begin
+				Mobile:=Indices[I];
+				LastMobile:=Mobile;
+				end;
+			end;
+		end;
+
+	if (Mobile = 0) and (LastMobile = 0) then Result:=0
+	else Result:=Mobile;
+	end;
+
+
+
+begin
+Inc(NextCount);
+Result:=NextCount>=Fact(Length(Indices));
+if Result then
+	begin
+	Reset;
+	exit;
+	end;
+Mobile:=GetMobile;
+Pos:=FindLargestMoble(Mobile);
+
+{ Swap elements according to the direction in Dir}
+if (Dir[Indices[pos - 1] - 1] = drRightToLeft) then SwapIntegers(Indices[Pos - 1], Indices[Pos - 2])
+else if (dir[Indices[pos - 1] - 1] = drLeftToRight) then SwapIntegers(Indices[Pos], Indices[Pos - 1]);
+
+{ changing the directions for elements}
+{ greater than largest Mobile integer.}
+for I:=0 to High(Indices) do
+ if Indices[I] > Mobile then
+	begin
+	if Dir[Indices[I] - 1] = drLeftToRight then Dir[Indices[I] - 1]:=drRightToLeft
+	else if (Dir[Indices[i] - 1] = drRightToLeft) then Dir[Indices[I] - 1]:=drLeftToRight;
+        end;
+end;
+
+
+{==============================================================================}
+
+
+
+
+function GetPermutationStr(PM: TJTPermutator): string;
+var I: integer;
+begin
+Result:=Format('%2d - [',[PM.NextCount+1]);
+for I:=0 to High(PM.Indices) do Result:=Result+IntToStr(PM.Indices[I]);
+Result:=Result+'] Sign: ';
+if (PM.NextCount and 1)=0 then Result:=Result+'+1'
+else Result:=Result+'-1';
+end;
+
+
+
+procedure SwapPermutations(Memo: TMemo);
+var PM: TJTPermutator;
+begin
+PM:=TJTPermutator.Create(3);
+try
+repeat Memo.Lines.Add(GetPermutationStr(PM))
+until PM.Next;
+Memo.Lines.Add('');
+
+PM.Permutations:=4;
+repeat Memo.Lines.Add(GetPermutationStr(PM))
+until PM.Next;
+finally PM.Free; end;
+end;

Task/Permutations-by-swapping/EchoLisp/permutations-by-swapping.l

@@ -0,0 +1,29 @@
+(lib 'list)
+
+(for/fold (sign 1) ((σ (in-permutations 4)) (count 100))
+    (printf "perm: %a count:%4d sign:%4d" σ count sign) (* sign -1))
+
+perm: (0 1 2 3) count:   0 sign:   1
+perm: (0 1 3 2) count:   1 sign:  -1
+perm: (0 3 1 2) count:   2 sign:   1
+perm: (3 0 1 2) count:   3 sign:  -1
+perm: (3 0 2 1) count:   4 sign:   1
+perm: (0 3 2 1) count:   5 sign:  -1
+perm: (0 2 3 1) count:   6 sign:   1
+perm: (0 2 1 3) count:   7 sign:  -1
+perm: (2 0 1 3) count:   8 sign:   1
+perm: (2 0 3 1) count:   9 sign:  -1
+perm: (2 3 0 1) count:  10 sign:   1
+perm: (3 2 0 1) count:  11 sign:  -1
+perm: (3 2 1 0) count:  12 sign:   1
+perm: (2 3 1 0) count:  13 sign:  -1
+perm: (2 1 3 0) count:  14 sign:   1
+perm: (2 1 0 3) count:  15 sign:  -1
+perm: (1 2 0 3) count:  16 sign:   1
+perm: (1 2 3 0) count:  17 sign:  -1
+perm: (1 3 2 0) count:  18 sign:   1
+perm: (3 1 2 0) count:  19 sign:  -1
+perm: (3 1 0 2) count:  20 sign:   1
+perm: (1 3 0 2) count:  21 sign:  -1
+perm: (1 0 3 2) count:  22 sign:   1
+perm: (1 0 2 3) count:  23 sign:  -1

Task/Permutations-by-swapping/Elixir/permutations-by-swapping.elixir

@@ -0,0 +1,40 @@
+defmodule Permutation do
+  def by_swap(n) do
+    p = Enum.to_list(0..-n) |> List.to_tuple
+    by_swap(n, p, 1)
+  end
+
+  defp by_swap(n, p, s) do
+    IO.puts "Perm: #{inspect for i <- 1..n, do: abs(elem(p,i))}  Sign: #{s}"
+    k = 0 |> step_up(n, p) |> step_down(n, p)
+    if k > 0 do
+      pk = elem(p,k)
+      i = if pk>0, do: k+1, else: k-1
+      p = Enum.reduce(1..n, p, fn i,acc ->
+        if abs(elem(p,i)) > abs(pk), do: put_elem(acc, i, -elem(acc,i)), else: acc
+      end)
+      pi = elem(p,i)
+      p = put_elem(p,i,pk) |> put_elem(k,pi)            # swap
+      by_swap(n, p, -s)
+    end
+  end
+
+  defp step_up(k, n, p) do
+    Enum.reduce(2..n, k, fn i,acc ->
+      if elem(p,i)<0 and abs(elem(p,i))>abs(elem(p,i-1)) and abs(elem(p,i))>abs(elem(p,acc)),
+        do: i, else: acc
+    end)
+  end
+
+  defp step_down(k, n, p) do
+    Enum.reduce(1..n-1, k, fn i,acc ->
+      if elem(p,i)>0 and abs(elem(p,i))>abs(elem(p,i+1)) and abs(elem(p,i))>abs(elem(p,acc)),
+        do: i, else: acc
+    end)
+  end
+end
+
+Enum.each(3..4, fn n ->
+  Permutation.by_swap(n)
+  IO.puts ""
+end)

Task/Permutations-by-swapping/F-Sharp/permutations-by-swapping-1.fs

@@ -0,0 +1,18 @@
+(*Implement Johnson-Trotter algorithm
+  Nigel Galloway January 24th 2017*)
+module Ring
+let PlainChanges (N:'n[]) = seq{
+  let gn  = [|for n in N -> 1|]
+  let ni  = [|for n in N -> 0|]
+  let gel = Array.length(N)-1
+  yield N
+  let rec _Ni g e l = seq{
+    match (l,g) with
+    |_ when l<0   -> gn.[g] <- -gn.[g]; yield! _Ni (g-1) e (ni.[g-1] + gn.[g-1])
+    |(1,0)        -> ()
+    |_ when l=g+1 -> gn.[g] <- -gn.[g]; yield! _Ni (g-1) (e+1) (ni.[g-1] + gn.[g-1])
+    |_ -> let n = N.[g-ni.[g]+e];
+          N.[g-ni.[g]+e] <- N.[g-l+e]; N.[g-l+e] <- n; yield N
+          ni.[g] <- l; yield! _Ni gel 0 (ni.[gel] + gn.[gel])}
+  yield! _Ni gel 0 1
+}

Task/Permutations-by-swapping/F-Sharp/permutations-by-swapping-2.fs

@@ -0,0 +1 @@
+for n in Ring.PlainChanges [|1;2;3;4|] do printfn "%A" n

Task/Permutations-by-swapping/Forth/permutations-by-swapping.fth

@@ -0,0 +1,67 @@
+S" fsl-util.fs" REQUIRED
+S" fsl/dynmem.seq" REQUIRED
+
+cell darray p{
+
+: sgn
+  DUP 0 > IF
+    DROP 1
+  ELSE 0 < IF
+    -1
+  ELSE
+    0
+  THEN THEN ;
+: arr-swap {: addr1 addr2 | tmp -- :}
+  addr1 @ TO tmp
+  addr2 @ addr1 !
+  tmp addr2 ! ;
+: perms {: n xt | my-i k s -- :}
+  & p{ n 1+ }malloc malloc-fail? ABORT" perms :: out of memory"
+  0 p{ 0 } !
+  n 1+ 1 DO
+    I NEGATE p{ I } !
+  LOOP
+  1 TO s
+  BEGIN
+    1 n 1+ DO
+      p{ I } @ ABS
+    -1 +LOOP
+    n 1+ s xt EXECUTE
+    0 TO k
+    n 1+ 2 DO
+      p{ I } @ 0 < ( flag )
+      p{ I } @ ABS  p{ I 1- } @ ABS  > ( flag flag )
+      p{ I } @ ABS p{ k } @ ABS > ( flag flag flag )
+      AND AND IF
+        I TO k
+      THEN
+    LOOP
+    n 1 DO
+      p{ I } @ 0 > ( flag )
+      p{ I } @ ABS  p{ I 1+ } @ ABS  > ( flag flag )
+      p{ I } @ ABS  p{ k } @ ABS  > ( flag flag flag )
+      AND AND IF
+        I TO k
+      THEN
+    LOOP
+    k IF
+      n 1+ 1 DO
+        p{ I } @ ABS  p{ k } @ ABS  > IF
+          p{ I } @ NEGATE p{ I } !
+        THEN
+      LOOP
+      p{ k } @ sgn k + TO my-i
+      p{ k } p{ my-i } arr-swap
+      s NEGATE TO s
+    THEN
+  k 0 = UNTIL ;
+: .perm ( p0 p1 p2 ... pn n s )
+  >R
+  ." Perm: [ "
+  1 DO
+    . SPACE
+  LOOP
+  R> ." ] Sign: " . CR ;
+
+3 ' .perm perms CR
+4 ' .perm perms

Task/Permutations-by-swapping/FreeBASIC/permutations-by-swapping.basic

@@ -0,0 +1,59 @@
+' version 31-03-2017
+' compile with: fbc -s console
+
+Sub perms(n As ULong)
+
+    Dim As Long p(n), i, k, s = 1
+
+    For i = 1 To n
+        p(i) = -i
+    Next
+
+    Do
+        Print "Perm: [ ";
+        For i = 1 To n
+            Print Abs(p(i)); " ";
+        Next
+        Print "] Sign: "; s
+
+        k = 0
+        For i = 2 To n
+            If p(i) < 0 Then
+                If Abs(p(i)) > Abs(p(i -1)) Then
+                    If Abs(p(i)) > Abs(p(k)) Then k = i
+                End If
+            End If
+        Next
+
+        For i = 1 To n -1
+            If p(i) > 0 Then
+                If Abs(p(i)) > Abs(p(i +1)) Then
+                    If Abs(p(i)) > Abs(p(k)) Then k = i
+                End If
+            End If
+        Next
+
+        If k Then
+            For  i = 1 To n
+                If Abs(p(i)) > Abs(p(k)) Then p(i) = -p(i)
+            Next
+            i = k + Sgn(p(k))
+            Swap p(k), p(i)
+            s = -s
+        End If
+
+    Loop Until k = 0
+
+End Sub
+
+' ------=< MAIN >=------
+
+perms(3)
+print
+perms(4)
+
+' empty keyboard buffer
+While Inkey <> "" : Wend
+Print : Print "hit any key to end program"
+Sleep
+End

Task/Permutations-by-swapping/Go/permutations-by-swapping-1.go

@@ -0,0 +1,50 @@
+package permute
+
+// Iter takes a slice p and returns an iterator function.  The iterator
+// permutes p in place and returns the sign.  After all permutations have
+// been generated, the iterator returns 0 and p is left in its initial order.
+func Iter(p []int) func() int {
+    f := pf(len(p))
+    return func() int {
+        return f(p)
+    }
+}
+
+// Recursive function used by perm, returns a chain of closures that
+// implement a loopless recursive SJT.
+func pf(n int) func([]int) int {
+    sign := 1
+    switch n {
+    case 0, 1:
+        return func([]int) (s int) {
+            s = sign
+            sign = 0
+            return
+        }
+    default:
+        p0 := pf(n - 1)
+        i := n
+        var d int
+        return func(p []int) int {
+            switch {
+            case sign == 0:
+            case i == n:
+                i--
+                sign = p0(p[:i])
+                d = -1
+            case i == 0:
+                i++
+                sign *= p0(p[1:])
+                d = 1
+                if sign == 0 {
+                    p[0], p[1] = p[1], p[0]
+                }
+            default:
+                p[i], p[i-1] = p[i-1], p[i]
+                sign = -sign
+                i += d
+            }
+            return sign
+        }
+    }
+}

Task/Permutations-by-swapping/Go/permutations-by-swapping-2.go

@@ -0,0 +1,14 @@
+package main
+
+import (
+    "fmt"
+    "permute"
+)
+
+func main() {
+    p := []int{11, 22, 33}
+    i := permute.Iter(p)
+    for sign := i(); sign != 0; sign = i() {
+        fmt.Println(p, sign)
+    }
+}

Task/Permutations-by-swapping/Haskell/permutations-by-swapping.hs

@@ -0,0 +1,15 @@
+sPermutations :: [a] -> [([a], Int)]
+sPermutations = flip zip (cycle [-1, 1]) . foldr aux [[]]
+  where
+    aux x items = do
+      (f, item) <- zip (repeat id) items
+      f (insertEv x item)
+    insertEv x [] = [[x]]
+    insertEv x l@(y:ys) = (x : l) : ((y :) <$> insertEv x ys)
+
+main :: IO ()
+main = do
+  putStrLn "3 items:"
+  mapM_ print $ sPermutations [1 .. 3]
+  putStrLn "\n4 items:"
+  mapM_ print $ sPermutations [1 .. 4]

Task/Permutations-by-swapping/Icon/permutations-by-swapping.icon

@@ -0,0 +1,30 @@
+procedure main(A)
+    every write("Permutations of length ",n := !A) do
+       every p := permute(n) do write("\t",showList(p[1])," -> ",right(p[2],2))
+end
+
+procedure permute(n)
+    items := [[]]
+    every (j := 1 to n, new_items := []) do {
+        every item := items[i := 1 to *items] do {
+            if *item = 0 then put(new_items, [j])
+            else if i%2 = 0 then
+                every k := 1 to *item+1 do {
+                    new_item := item[1:k] ||| [j] ||| item[k:0]
+                    put(new_items, new_item)
+                    }
+            else
+                every k := *item+1 to 1 by -1 do {
+                    new_item := item[1:k] ||| [j] ||| item[k:0]
+                    put(new_items, new_item)
+                    }
+            }
+       items := new_items
+       }
+    suspend (i := 0, [!items, if (i+:=1)%2 = 0 then 1 else -1])
+end
+
+procedure showList(A)
+    every (s := "[") ||:= image(!A)||", "
+    return s[1:-2]||"]"
+end

Task/Permutations-by-swapping/J/permutations-by-swapping-1.j

@@ -0,0 +1,4 @@
+bfsjt0=: _1 - i.
+lookingat=: 0 >. <:@# <. i.@# + *
+next=: | >./@:* | > | {~ lookingat
+bfsjtn=: (((] <@, ] + *@{~) | i. next) C. ] * _1 ^ next < |)^:(*@next)

Task/Permutations-by-swapping/J/permutations-by-swapping-2.j

@@ -0,0 +1,16 @@
+   bfsjtn^:(i.!3) bfjt0 3
+_1 _2 _3
+_1 _3 _2
+_3 _1 _2
+ 3 _2 _1
+_2  3 _1
+_2 _1  3
+   <:@| bfsjtn^:(i.!3) bfjt0 3
+0 1 2
+0 2 1
+2 0 1
+2 1 0
+1 2 0
+1 0 2
+   A. <:@| bfsjtn^:(i.!3) bfjt0 3
+0 1 4 5 3 2

Task/Permutations-by-swapping/J/permutations-by-swapping-3.j

@@ -0,0 +1,7 @@
+   (_1^2|i.!3),. bfsjtn^:(i.!3) bfjt0 3
+ 1 _1 _2 _3
+_1 _1 _3 _2
+ 1 _3 _1 _2
+_1  3 _2 _1
+ 1 _2  3 _1
+_1 _2 _1  3

Task/Permutations-by-swapping/J/permutations-by-swapping-4.j

@@ -0,0 +1,7 @@
+   (,.~C.!.2)<:| bfsjtn^:(i.!3) bfjt0 3
+ 1 0 1 2
+_1 0 2 1
+ 1 2 0 1
+_1 2 1 0
+ 1 1 2 0
+_1 1 0 2

Task/Permutations-by-swapping/J/permutations-by-swapping-5.j

@@ -0,0 +1,5 @@
+rsjt=: 3 :0
+  if. 2>y do. i.2#y
+  else.  ((!y)$(,~|.)-.=i.y)#inv!.(y-1)"1 y#rsjt y-1
+  end.
+)

Task/Permutations-by-swapping/J/permutations-by-swapping-6.j

@@ -0,0 +1,7 @@
+   (,.~ C.!.2) rsjt 3
+ 1 0 1 2
+_1 0 2 1
+ 1 2 0 1
+_1 2 1 0
+ 1 1 2 0
+_1 1 0 2

Task/Permutations-by-swapping/Java/permutations-by-swapping.java

@@ -0,0 +1,68 @@
+package org.rosettacode.java;
+
+import java.util.Arrays;
+import java.util.stream.IntStream;
+
+public class HeapsAlgorithm {
+
+	public static void main(String[] args) {
+		Object[] array = IntStream.range(0, 4)
+				.boxed()
+				.toArray();
+		HeapsAlgorithm algorithm = new HeapsAlgorithm();
+		algorithm.recursive(array);
+		System.out.println();
+		algorithm.loop(array);
+	}
+
+	void recursive(Object[] array) {
+		recursive(array, array.length, true);
+	}
+
+	void recursive(Object[] array, int n, boolean plus) {
+		if (n == 1) {
+			output(array, plus);
+		} else {
+			for (int i = 0; i < n; i++) {
+				recursive(array, n - 1, i == 0);
+				swap(array, n % 2 == 0 ? i : 0, n - 1);
+			}
+		}
+	}
+
+	void output(Object[] array, boolean plus) {
+		System.out.println(Arrays.toString(array) + (plus ? " +1" : " -1"));
+	}
+
+	void swap(Object[] array, int a, int b) {
+		Object o = array[a];
+		array[a] = array[b];
+		array[b] = o;
+	}
+
+	void loop(Object[] array) {
+		loop(array, array.length);
+	}
+
+	void loop(Object[] array, int n) {
+		int[] c = new int[n];
+		output(array, true);
+		boolean plus = false;
+		for (int i = 0; i < n; ) {
+			if (c[i] < i) {
+				if (i % 2 == 0) {
+					swap(array, 0, i);
+				} else {
+					swap(array, c[i], i);
+				}
+				output(array, plus);
+				plus = !plus;
+				c[i]++;
+				i = 0;
+			} else {
+				c[i] = 0;
+				i++;
+			}
+		}
+	}
+}

Task/Permutations-by-swapping/Jq/permutations-by-swapping-1.jq

@@ -0,0 +1,45 @@
+# The helper function, _recurse, is tail-recursive and therefore in
+# versions of jq with TCO (tail call optimization) there is no
+# overhead associated with the recursion.
+
+def permutations:
+  def abs: if . < 0 then -. else . end;
+  def sign: if . < 0 then -1 elif . == 0 then 0 else 1 end;
+  def swap(i;j): .[i] as $i | .[i] = .[j] | .[j] = $i;
+
+  # input: [ parity, extendedPermutation]
+  def _recurse:
+    .[0] as $s | .[1] as $p | (($p | length) -1) as $n
+    | [ $s, ($p[1:] | map(abs)) ],
+      (reduce range(2; $n+1) as $i
+         (0;
+          if $p[$i] < 0 and -($p[$i]) > ($p[$i-1]|abs) and -($p[$i]) > ($p[.]|abs)
+          then $i
+          else .
+          end)) as $k
+      | (reduce range(1; $n) as $i
+           ($k;
+            if $p[$i] > 0 and $p[$i] > ($p[$i+1]|abs) and $p[$i] > ($p[.]|abs)
+            then $i
+            else .
+            end)) as $k
+      | if $k == 0 then empty
+        else (reduce range(1; $n) as $i
+	       ($p;
+                if (.[$i]|abs) > (.[$k]|abs) then .[$i] *= -1
+                else .
+                end )) as $p
+        | ($k + ($p[$k]|sign)) as $i
+        | ($p | swap($i; $k)) as $p
+        | [ -($s), $p ] | _recurse
+        end ;
+
+  . as $in
+  | length as $n
+  | (reduce range(0; $n+1) as $i ([]; . + [ -$i ])) as $p
+  # recurse state: [$s, $p]
+  | [ 1, $p] | _recurse
+  | .[1] as $p
+  | .[1] = reduce range(0; $n) as $i ([]; . + [$in[$p[$i]  - 1]]) ;
+
+def count(stream): reduce stream as $x (0; .+1);

Task/Permutations-by-swapping/Jq/permutations-by-swapping-2.jq

@@ -0,0 +1,2 @@
+(["a", "b", "c"] | permutations),
+"There are \(count( [range(1;6)] | permutations )) permutations of 5 items."

Task/Permutations-by-swapping/Jq/permutations-by-swapping-3.jq

@@ -0,0 +1,9 @@
+$ jq -c -n -f Permutations_by_swapping.jq
+[1,["a","b","c"]]
+[-1,["a","c","b"]]
+[1,["c","a","b"]]
+[-1,["c","b","a"]]
+[1,["b","c","a"]]
+[-1,["b","a","c"]]
+
+"There are 32 permutations of 5 items."

Task/Permutations-by-swapping/Julia/permutations-by-swapping-1.julia

@@ -0,0 +1,58 @@
+function johnsontrottermove!(ints, isleft)
+    len = length(ints)
+    function ismobile(pos)
+        if isleft[pos] && (pos > 1) && (ints[pos-1] < ints[pos])
+            return true
+        elseif !isleft[pos] && (pos < len) && (ints[pos+1] < ints[pos])
+            return true
+        end
+        false
+    end
+    function maxmobile()
+        arr = [ints[pos] for pos in 1:len if ismobile(pos)]
+        if isempty(arr)
+            0, 0
+        else
+            maxmob = maximum(arr)
+            maxmob, findfirst(x -> x == maxmob, ints)
+        end
+    end
+    function directedswap(pos)
+        tmp = ints[pos]
+        tmpisleft = isleft[pos]
+        if isleft[pos]
+            ints[pos] = ints[pos-1]; ints[pos-1] = tmp
+            isleft[pos] = isleft[pos-1]; isleft[pos-1] = tmpisleft
+        else
+            ints[pos] = ints[pos+1]; ints[pos+1] = tmp
+            isleft[pos] = isleft[pos+1]; isleft[pos+1] = tmpisleft
+        end
+    end
+    (moveint, movepos) = maxmobile()
+    if movepos > 0
+        directedswap(movepos)
+        for (i, val) in enumerate(ints)
+            if val > moveint
+                isleft[i] = !isleft[i]
+            end
+        end
+        ints, isleft, true
+    else
+        ints, isleft, false
+    end
+end
+function johnsontrotter(low, high)
+    ints = collect(low:high)
+    isleft = [true for i in ints]
+    firstconfig = copy(ints)
+    iters = 0
+    while true
+        iters += 1
+        println("$ints $(iters & 1 == 1 ? "+1" : "-1")")
+        if johnsontrottermove!(ints, isleft)[3] == false
+            break
+        end
+    end
+    println("There were $iters iterations.")
+end
+johnsontrotter(1,4)

Task/Permutations-by-swapping/Julia/permutations-by-swapping-2.julia

@@ -0,0 +1,23 @@
+function johnsontrotter(low, high)
+    function permutelevel(vec)
+        if length(vec) < 2
+            return [vec]
+        end
+        sequences = []
+        endint = vec[end]
+        smallersequences = permutelevel(vec[1:end-1])
+        leftward = true
+        for seq in smallersequences
+            for pos in (leftward ? (length(seq)+1:-1:1): (1:length(seq)+1))
+                push!(sequences, insert!(copy(seq), pos, endint))
+            end
+            leftward = !leftward
+        end
+        sequences
+    end
+    permutelevel(collect(low:high))
+end
+
+for (i, sequence) in enumerate(johnsontrotter(1,4))
+    println("""$sequence, $(i & 1 == 1 ? "+1" : "-1")""")
+end

Task/Permutations-by-swapping/Kotlin/permutations-by-swapping.kotlin

@@ -0,0 +1,46 @@
+// version 1.1.2
+
+fun johnsonTrotter(n: Int): Pair<List<IntArray>, List<Int>> {
+    val p = IntArray(n) { it }  // permutation
+    val q = IntArray(n) { it }  // inverse permutation
+    val d = IntArray(n) { -1 }  // direction = 1 or -1
+    var sign = 1
+    val perms = mutableListOf<IntArray>()
+    val signs = mutableListOf<Int>()
+
+    fun permute(k: Int) {
+        if (k >= n) {
+            perms.add(p.copyOf())
+            signs.add(sign)
+            sign *= -1
+            return
+        }
+        permute(k + 1)
+        for (i in 0 until k) {
+            val z = p[q[k] + d[k]]
+            p[q[k]] = z
+            p[q[k] + d[k]] = k
+            q[z] = q[k]
+            q[k] += d[k]
+            permute(k + 1)
+        }
+        d[k] *= -1
+    }
+
+    permute(0)
+    return perms to signs
+}
+
+fun printPermsAndSigns(perms: List<IntArray>, signs: List<Int>) {
+    for ((i, perm) in perms.withIndex()) {
+        println("${perm.contentToString()} -> sign = ${signs[i]}")
+    }
+}
+
+fun main(args: Array<String>) {
+    val (perms, signs) = johnsonTrotter(3)
+    printPermsAndSigns(perms, signs)
+    println()
+    val (perms2, signs2) = johnsonTrotter(4)
+    printPermsAndSigns(perms2, signs2)
+}

Task/Permutations-by-swapping/Lua/permutations-by-swapping-1.lua

@@ -0,0 +1,41 @@
+_JT={}
+function JT(dim)
+  local n={ values={}, positions={}, directions={}, sign=1 }
+  setmetatable(n,{__index=_JT})
+  for i=1,dim do
+    n.values[i]=i
+    n.positions[i]=i
+    n.directions[i]=-1
+  end
+  return n
+end
+
+function _JT:largestMobile()
+  for i=#self.values,1,-1 do
+    local loc=self.positions[i]+self.directions[i]
+    if loc >= 1 and loc <= #self.values and self.values[loc] < i then
+      return i
+    end
+  end
+  return 0
+end
+
+function _JT:next()
+  local r=self:largestMobile()
+  if r==0 then return false end
+  local rloc=self.positions[r]
+  local lloc=rloc+self.directions[r]
+  local l=self.values[lloc]
+  self.values[lloc],self.values[rloc] = self.values[rloc],self.values[lloc]
+  self.positions[l],self.positions[r] = self.positions[r],self.positions[l]
+  self.sign=-self.sign
+  for i=r+1,#self.directions do self.directions[i]=-self.directions[i] end
+  return true
+end
+
+-- test
+
+perm=JT(4)
+repeat
+  print(unpack(perm.values))
+until not perm:next()

Task/Permutations-by-swapping/Lua/permutations-by-swapping-2.lua

@@ -0,0 +1,21 @@
+local wrap, yield = coroutine.wrap, coroutine.yield
+local function perm(n)
+    local r = {}
+    for i=1,n do r[i]=i end
+    local sign = 1
+  return wrap(function()
+    local function swap(m)
+      if m==0 then
+        sign = -sign, yield(sign,r)
+      else
+        for i=m,1,-1 do
+          r[i],r[m]=r[m],r[i]
+          swap(m-1)
+          r[i],r[m]=r[m],r[i]
+        end
+      end
+    end
+    swap(n)
+  end)
+end
+for sign,r in perm(3) do print(sign,table.unpack(r))end

Task/Permutations-by-swapping/Mathematica/permutations-by-swapping-1.math

@@ -0,0 +1,5 @@
+perms[0] = {{{}, 1}};
+perms[n_] :=
+ Flatten[If[#2 == 1, Reverse, # &]@
+     Table[{Insert[#1, n, i], (-1)^(n + i) #2}, {i, n}] & @@@
+   perms[n - 1], 1];

Task/Permutations-by-swapping/Mathematica/permutations-by-swapping-2.math

@@ -0,0 +1 @@
+Print["Perm: ", #[[1]], " Sign: ", #[[2]]] & /@ perms@4;

Task/Permutations-by-swapping/Nim/permutations-by-swapping.nim

@@ -0,0 +1,34 @@
+# iterative Boothroyd method
+iterator permutations*[T](ys: openarray[T]): tuple[perm: seq[T], sign: int] =
+  var
+    d = 1
+    c = newSeq[int](ys.len)
+    xs = newSeq[T](ys.len)
+    sign = 1
+
+  for i, y in ys: xs[i] = y
+  yield (xs, sign)
+
+  block outter:
+    while true:
+      while d > 1:
+        dec d
+        c[d] = 0
+      while c[d] >= d:
+        inc d
+        if d >= ys.len: break outter
+
+      let i = if (d and 1) == 1: c[d] else: 0
+      swap xs[i], xs[d]
+      sign *= -1
+      yield (xs, sign)
+      inc c[d]
+
+when isMainModule:
+  for i in permutations([0,1,2]):
+    echo i
+
+  echo ""
+
+  for i in permutations([0,1,2,3]):
+    echo i

Task/Permutations-by-swapping/OoRexx/permutations-by-swapping-1.rexx

@@ -0,0 +1,70 @@
+/* REXX Compute permutations of things elements       */
+/* implementing Heap's algorithm nicely shown in      */
+/*   https://en.wikipedia.org/wiki/Heap%27s_algorithm */
+/* Recursive Algorithm                                */
+Parse Arg things
+e.=''
+Select
+  When things='?' Then
+    Call help
+  When things='' Then
+    things=4
+  When words(things)>1 Then Do
+    elements=things
+    things=words(things)
+    Do i=0 By 1 While elements<>''
+      Parse Var elements e.i elements
+      End
+    End
+  Otherwise
+    If datatype(things)<>'NUM' Then Call help 'bunch ('bunch') must be numeric'
+  End
+n=0
+Do i=0 To things-1
+  a.i=i
+  End
+Call generate things
+Say time('R') 'seconds'
+Exit
+
+generate: Procedure Expose a. n e. things
+  Parse Arg k
+  If k=1 Then
+    Call show
+  Else Do
+    Call generate k-1
+    Do i=0 To k-2
+      ka=k-1
+      If k//2=0 Then
+        Parse Value a.i a.ka With a.ka a.i
+      Else
+        Parse Value a.0 a.ka With a.ka a.0
+      Call generate k-1
+      End
+    End
+  Return
+
+show: Procedure Expose a. n e. things
+  n=n+1
+  ol=''
+  Do i=0 To things-1
+    z=a.i
+    If e.0<>'' Then
+      ol=ol e.z
+    Else
+      ol=ol z
+    End
+  Say strip(ol)
+  Return
+Exit
+
+help:
+  Parse Arg msg
+  If msg<>'' Then Do
+    Say 'ERROR:' msg
+    Say ''
+    End
+  Say 'rexx permx            -> Permutations of 1 2 3 4               '
+  Say 'rexx permx 2          -> Permutations of 1 2                   '
+  Say 'rexx permx a b c d    -> Permutations of a b c d in 2 positions'
+  Exit

Task/Permutations-by-swapping/OoRexx/permutations-by-swapping-2.rexx

@@ -0,0 +1,76 @@
+/* REXX Compute permutations of things elements       */
+/* implementing Heap's algorithm nicely shown in      */
+/*   https://en.wikipedia.org/wiki/Heap%27s_algorithm */
+/* Iterative Algorithm                                */
+Parse Arg things
+e.=''
+Select
+  When things='?' Then
+    Call help
+  When things='' Then
+    things=4
+  When words(things)>1 Then Do
+    elements=things
+    things=words(things)
+    Do i=0 By 1 While elements<>''
+      Parse Var elements e.i elements
+      End
+    End
+  Otherwise
+    If datatype(things)<>'NUM' Then Call help 'bunch ('bunch') must be numeric'
+  End
+Do i=0 To things-1
+  a.i=i
+  End
+Call time 'R'
+Call generate things
+Say time('E') 'seconds'
+Exit
+
+generate:
+  Parse Arg n
+  Call show
+  c.=0
+  i=0
+  Do While i<n
+    If c.i<i Then Do
+      if i//2=0 Then
+        Parse Value a.0 a.i With a.i a.0
+      Else Do
+        z=c.i
+        Parse Value a.z a.i With a.i a.z
+        End
+      Call show
+      c.i=c.i+1
+      i=0
+      End
+    Else Do
+      c.i=0
+      i=i+1
+      End
+    End
+  Return
+
+show:
+  ol=''
+  Do j=0 To n-1
+    z=a.j
+    If e.0<>'' Then
+      ol=ol e.z
+    Else
+      ol=ol z
+    End
+  Say strip(ol)
+  Return
+Exit
+
+help:
+  Parse Arg msg
+  If msg<>'' Then Do
+    Say 'ERROR:' msg
+    Say ''
+    End
+  Say 'rexx permxi            -> Permutations of 1 2 3 4               '
+  Say 'rexx permxi 2          -> Permutations of 1 2                   '
+  Say 'rexx permxi a b c d    -> Permutations of a b c d in 2 positions'
+  Exit

Task/Permutations-by-swapping/Perl/permutations-by-swapping-1.pl

@@ -0,0 +1,58 @@
+use strict;
+use warnings;
+
+# This code uses "Even's Speedup," as described on
+# the Wikipedia page about the Steinhaus–Johnson–
+# Trotter algorithm.
+
+# Any resemblance between this code and the Python
+# code elsewhere on the page is purely a coincidence,
+# caused by them both implementing the same algorithm.
+
+# The code was written to be read relatively easily
+# while demonstrating some common perl idioms.
+
+sub perms :prototype(&@) {
+   my $callback = shift;
+   my @perm = map [$_, -1], @_;
+   $perm[0][1] = 0;
+
+   my $sign = 1;
+   while( ) {
+      $callback->($sign, map $_->[0], @perm);
+      $sign *= -1;
+
+      my ($chosen, $index) = (-1, -1);
+      for my $i ( 0 .. $#perm ) {
+         ($chosen, $index) = ($perm[$i][0], $i)
+           if $perm[$i][1] and $perm[$i][0] > $chosen;
+      }
+      return if $index == -1;
+
+      my $direction = $perm[$index][1];
+      my $next = $index + $direction;
+
+      @perm[ $index, $next ] = @perm[ $next, $index ];
+
+      if( $next <= 0 or $next >= $#perm ) {
+         $perm[$next][1] = 0;
+      } elsif( $perm[$next + $direction][0] > $chosen ) {
+         $perm[$next][1] = 0;
+      }
+
+      for my $i ( 0 .. $next - 1 ) {
+         $perm[$i][1] = +1 if $perm[$i][0] > $chosen;
+      }
+      for my $i ( $next + 1 .. $#perm ) {
+         $perm[$i][1] = -1 if $perm[$i][0] > $chosen;
+      }
+   }
+}
+
+my $n = shift(@ARGV) || 4;
+
+perms {
+   my ($sign, @perm) = @_;
+   print "[", join(", ", @perm), "]";
+   print $sign < 0 ? " => -1\n" : " => +1\n";
+} 1 .. $n;

Task/Permutations-by-swapping/Perl/permutations-by-swapping-2.pl

@@ -0,0 +1,25 @@
+#!perl
+use strict;
+use warnings;
+
+sub perms {
+   my ($xx) = (shift);
+   my @perms = ([+1]);
+   for my $x ( 1 .. $xx ) {
+      my $sign = -1;
+      @perms = map {
+         my ($s, @p) = @$_;
+         map [$sign *= -1, @p[0..$_-1], $x, @p[$_..$#p]],
+            $s < 0 ? 0 .. @p : reverse 0 .. @p;
+      } @perms;
+   }
+   @perms;
+}
+
+my $n = shift() || 4;
+
+for( perms($n) ) {
+   my $s = shift @$_;
+   $s = '+1' if $s > 0;
+   print "[", join(", ", @$_), "] => $s\n";
+}

Task/Permutations-by-swapping/Phix/permutations-by-swapping.phix

@@ -0,0 +1,27 @@
+(phixonline)-->
+ <span style="color: #008080;">function</span> <span style="color: #000000;">spermutations</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">p</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">)</span>
+ <span style="color: #000080;font-style:italic;">--
+ -- generate the i'th permutation of [1..p]:
+ -- first obtain the appropriate permutation of [1..p-1],
+ -- then insert p/move it down k(=0..p-1) places from the end.
+ --  </span>
+     <span style="color: #004080;">sequence</span> <span style="color: #000000;">res</span>
+     <span style="color: #004080;">integer</span> <span style="color: #000000;">k</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">mod</span><span style="color: #0000FF;">(</span><span style="color: #000000;">i</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">2</span><span style="color: #0000FF;">*</span><span style="color: #000000;">p</span><span style="color: #0000FF;">)</span>
+     <span style="color: #008080;">if</span> <span style="color: #000000;">k</span><span style="color: #0000FF;">>=</span><span style="color: #000000;">p</span> <span style="color: #008080;">then</span> <span style="color: #000000;">k</span><span style="color: #0000FF;">=</span><span style="color: #000000;">2</span><span style="color: #0000FF;">*</span><span style="color: #000000;">p</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">-</span><span style="color: #000000;">k</span>  <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
+     <span style="color: #008080;">if</span> <span style="color: #000000;">p</span><span style="color: #0000FF;">></span><span style="color: #000000;">1</span> <span style="color: #008080;">then</span>
+         <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">spermutations</span><span style="color: #0000FF;">(</span><span style="color: #000000;">p</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">floor</span><span style="color: #0000FF;">((</span><span style="color: #000000;">i</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)/</span><span style="color: #000000;">p</span><span style="color: #0000FF;">)+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)</span>
+         <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">res</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">..</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">res</span><span style="color: #0000FF;">)-</span><span style="color: #000000;">k</span><span style="color: #0000FF;">]&</span><span style="color: #000000;">p</span><span style="color: #0000FF;">&</span><span style="color: #000000;">res</span><span style="color: #0000FF;">[</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">res</span><span style="color: #0000FF;">)-</span><span style="color: #000000;">k</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">..$]</span>
+     <span style="color: #008080;">else</span>
+         <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">1</span><span style="color: #0000FF;">}</span>
+     <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
+     <span style="color: #008080;">return</span> <span style="color: #000000;">res</span>
+ <span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
+
+ <span style="color: #008080;">for</span> <span style="color: #000000;">p</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">4</span> <span style="color: #008080;">do</span>
+     <span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"==%d==\n"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">p</span><span style="color: #0000FF;">)</span>
+     <span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">factorial</span><span style="color: #0000FF;">(</span><span style="color: #000000;">p</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
+         <span style="color: #004080;">integer</span> <span style="color: #000000;">parity</span> <span style="color: #0000FF;">=</span> <span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">and_bits</span><span style="color: #0000FF;">(</span><span style="color: #000000;">i</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)?</span><span style="color: #000000;">1</span><span style="color: #0000FF;">:-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)</span>
+         <span style="color: #0000FF;">?{</span><span style="color: #000000;">i</span><span style="color: #0000FF;">,</span><span style="color: #000000;">spermutations</span><span style="color: #0000FF;">(</span><span style="color: #000000;">p</span><span style="color: #0000FF;">,</span><span style="color: #000000;">i</span><span style="color: #0000FF;">),</span><span style="color: #000000;">parity</span><span style="color: #0000FF;">}</span>
+     <span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
+ <span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
+<!--

Task/Permutations-by-swapping/PicoLisp/permutations-by-swapping.l

@@ -0,0 +1,42 @@
+(let
+   (N 4
+      L
+      (mapcar
+         '((I) (list I 0))
+         (range 1 N) ) )
+   (for I L
+      (printsp (car I)) )
+   (prinl)
+   (while
+      # find the lagest mobile integer
+      (setq
+         X
+         (maxi
+            '((I) (car (get L (car I))))
+            (extract
+               '((I J)
+                  (let? Y
+                     (get
+                        L
+                        ((if (=0 (cadr I)) dec inc) J) )
+                     (when (> (car I) (car Y))
+                        (list J (cadr I)) ) ) )
+               L
+               (range 1 N) ) )
+         Y (get L (car X)) )
+      # swap integer and adjacent int it is looking at
+      (xchg
+         (nth L (car X))
+         (nth
+            L
+            ((if (=0 (cadr X)) dec inc) (car X)) ) )
+      # reverse direction of all ints large than our
+      (for I L
+         (when (< (car Y) (car I))
+            (set (cdr I)
+               (if (=0 (cadr I)) 1 0) ) ) )
+      # print current positions
+      (for I L
+         (printsp (car I)) )
+      (prinl) ) )
+(bye)

Task/Permutations-by-swapping/PowerShell/permutations-by-swapping.psh

@@ -0,0 +1,37 @@
+function output([Object[]]$A, [Int]$k, [ref]$sign)
+{
+    "Perm: [$([String]::Join(', ', $A))] Sign: $($sign.Value)"
+}
+
+function permutation([Object[]]$array)
+{
+    function generate([Object[]]$A, [Int]$k, [ref]$sign)
+    {
+        if($k -eq 1)
+        {
+            output $A $k $sign
+            $sign.Value = -$sign.Value
+        }
+        else
+        {
+            $k -= 1
+            generate $A  $k $sign
+            for([Int]$i = 0; $i -lt $k; $i += 1)
+             {
+                if($i % 2 -eq 0)
+                {
+                    $A[$i], $A[$k] = $A[$k], $A[$i]
+                }
+                else
+                {
+                    $A[0], $A[$k] = $A[$k], $A[0]
+                }
+                generate $A $k $sign
+            }
+        }
+    }
+    generate $array $array.Count ([ref]1)
+}
+permutation @(0, 1, 2)
+""
+permutation @(0, 1, 2, 3)

Task/Permutations-by-swapping/Python/permutations-by-swapping-1.py

@@ -0,0 +1,60 @@
+from operator import itemgetter
+
+DEBUG = False # like the built-in __debug__
+
+def spermutations(n):
+    """permutations by swapping. Yields: perm, sign"""
+    sign = 1
+    p = [[i, 0 if i == 0 else -1] # [num, direction]
+         for i in range(n)]
+
+    if DEBUG: print ' #', p
+    yield tuple(pp[0] for pp in p), sign
+
+    while any(pp[1] for pp in p): # moving
+        i1, (n1, d1) = max(((i, pp) for i, pp in enumerate(p) if pp[1]),
+                           key=itemgetter(1))
+        sign *= -1
+        if d1 == -1:
+            # Swap down
+            i2 = i1 - 1
+            p[i1], p[i2] = p[i2], p[i1]
+            # If this causes the chosen element to reach the First or last
+            # position within the permutation, or if the next element in the
+            # same direction is larger than the chosen element:
+            if i2 == 0 or p[i2 - 1][0] > n1:
+                # The direction of the chosen element is set to zero
+                p[i2][1] = 0
+        elif d1 == 1:
+            # Swap up
+            i2 = i1 + 1
+            p[i1], p[i2] = p[i2], p[i1]
+            # If this causes the chosen element to reach the first or Last
+            # position within the permutation, or if the next element in the
+            # same direction is larger than the chosen element:
+            if i2 == n - 1 or p[i2 + 1][0] > n1:
+                # The direction of the chosen element is set to zero
+                p[i2][1] = 0
+        if DEBUG: print ' #', p
+        yield tuple(pp[0] for pp in p), sign
+
+        for i3, pp in enumerate(p):
+            n3, d3 = pp
+            if n3 > n1:
+                pp[1] = 1 if i3 < i2 else -1
+                if DEBUG: print ' # Set Moving'
+
+
+if __name__ == '__main__':
+    from itertools import permutations
+
+    for n in (3, 4):
+        print '\nPermutations and sign of %i items' % n
+        sp = set()
+        for i in spermutations(n):
+            sp.add(i[0])
+            print('Perm: %r Sign: %2i' % i)
+            #if DEBUG: raw_input('?')
+        # Test
+        p = set(permutations(range(n)))
+        assert sp == p, 'Two methods of generating permutations do not agree'

Task/Permutations-by-swapping/Python/permutations-by-swapping-2.py

@@ -0,0 +1,19 @@
+def s_permutations(seq):
+    def s_perm(seq):
+        if not seq:
+            return [[]]
+        else:
+            new_items = []
+            for i, item in enumerate(s_perm(seq[:-1])):
+                if i % 2:
+                    # step up
+                    new_items += [item[:i] + seq[-1:] + item[i:]
+                                  for i in range(len(item) + 1)]
+                else:
+                    # step down
+                    new_items += [item[:i] + seq[-1:] + item[i:]
+                                  for i in range(len(item), -1, -1)]
+            return new_items
+
+    return [(tuple(item), -1 if i % 2 else 1)
+            for i, item in enumerate(s_perm(seq))]

Task/Permutations-by-swapping/Python/permutations-by-swapping-3.py

@@ -0,0 +1,17 @@
+def s_permutations(seq):
+    items = [[]]
+    for j in seq:
+        new_items = []
+        for i, item in enumerate(items):
+            if i % 2:
+                # step up
+                new_items += [item[:i] + [j] + item[i:]
+                              for i in range(len(item) + 1)]
+            else:
+                # step down
+                new_items += [item[:i] + [j] + item[i:]
+                              for i in range(len(item), -1, -1)]
+        items = new_items
+
+    return [(tuple(item), -1 if i % 2 else 1)
+            for i, item in enumerate(items)]

Task/Permutations-by-swapping/QBasic/permutations-by-swapping.basic

@@ -0,0 +1,39 @@
+SUB perms (n)
+    DIM p((n + 1) * 4)
+    FOR i = 1 TO n
+    p(i) = -i
+    NEXT i
+    s = 1
+
+    DO
+    PRINT "Perm: (";
+    FOR i = 1 TO n
+        PRINT ABS(p(i)); "";
+    NEXT i
+    PRINT ") Sign: "; s
+
+    k = 0
+    FOR i = 2 TO n
+        IF p(i) < 0 AND (ABS(p(i)) > ABS(p(i - 1))) AND (ABS(p(i)) > ABS(p(k))) THEN k = i
+    NEXT i
+    FOR i = 1 TO n - 1
+        IF p(i) > 0 AND (ABS(p(i)) > ABS(p(i + 1))) AND (ABS(p(i)) > ABS(p(k))) THEN k = i
+    NEXT i
+    IF k THEN
+        FOR i = 1 TO n    'reverse elements > k
+        IF ABS(p(i)) > ABS(p(k)) THEN p(i) = -p(i)
+        NEXT i
+        'if p(k) < 0 then i = k-1 else i = k+1
+        i = k + SGN(p(k))
+        SWAP p(k), p(i)
+        'temp = p(k)
+        'p(k) = p(i)
+        'p(i) = temp
+        s = -s
+    END IF
+    LOOP UNTIL k = 0
+END SUB
+
+perms (3)
+PRINT
+perms (4)

Task/Permutations-by-swapping/Quackery/permutations-by-swapping.quackery

@@ -0,0 +1,35 @@
+  [ stack ]                   is parity (   --> s )
+
+  [ 1 & ]                     is odd    ( n --> b )
+
+  [ [] swap witheach
+    [ nested
+      i odd 2 * 1 -
+      join nested join ] ]    is +signs ( [ --> [ )
+
+  [ dup
+    [ dup 0 = iff
+        [ drop ' [ [ ] ] ]
+        done
+      dup temp put
+      1 - recurse
+      [] swap
+      witheach
+        [ i odd parity put
+          temp share times
+            [ temp share 1 -
+              over
+              parity share
+              iff i else i^
+              stuff
+              nested rot join
+              swap ]
+          drop
+          parity release ]
+      temp release ]
+    swap odd if reverse
+    +signs ]                  is perms  ( n --> [ )
+
+  3 perms witheach [ echo cr ]
+  cr
+  4 perms witheach [ echo cr ]

Task/Permutations-by-swapping/REXX/permutations-by-swapping.rexx

@@ -0,0 +1,46 @@
+/*REXX program  generates all  permutations  of   N   different objects by  swapping.   */
+parse arg things bunch .                         /*obtain optional arguments from the CL*/
+if things=='' | things==","  then things=4       /*Not specified?  Then use the default.*/
+if bunch =='' | bunch ==","  then bunch =things  /* "      "         "   "   "     "    */
+call permSets things, bunch                      /*invoke permutations by swapping sub. */
+exit                                             /*stick a fork in it,  we're all done. */
+/*──────────────────────────────────────────────────────────────────────────────────────*/
+!:        procedure;  !=1;        do j=2  to arg(1);    !=!*j;     end;           return !
+/*──────────────────────────────────────────────────────────────────────────────────────*/
+permSets: procedure; parse arg x,y               /*take   X  things   Y   at a time.    */
+          !.=0;      pad=left('', x*y)           /*X can't be > length of below str (62)*/
+          z=left('123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ', x);  q=z
+          #=1                                    /*the number of permutations  (so far).*/
+          !.z=1;    s=1;   times=!(x) % !(x-y)   /*calculate (#) TIMES  using factorial.*/
+          w=max(length(z), length('permute') )   /*maximum width of  Z and also PERMUTE.*/
+          say center('permutations for '   x   ' things taken '   y   " at a time",60,'═')
+          say
+          say   pad    'permutation'       center("permute", w, '─')         "sign"
+          say   pad    '───────────'       center("───────", w, '─')         "────"
+          say   pad    center(#, 11)       center(z        , w)              right(s, 4-1)
+
+             do $=1   until  #==times            /*perform permutation until # of times.*/
+               do   k=1    for x-1               /*step thru things for  things-1 times.*/
+                 do m=k+1  to  x;      ?=        /*this method doesn't use  adjacency.  */
+                     do n=1  for x               /*build the new permutation by swapping*/
+                     if n\==k & n\==m  then               ? =  ?  ||  substr(z, n, 1)
+                                       else if n==k  then ? =  ?  ||  substr(z, m, 1)
+                                                     else ? =  ?  ||  substr(z, k, 1)
+                     end   /*n*/
+                 z=?                             /*save this permutation for next swap. */
+                 if !.?  then iterate m          /*if defined before, then try next one.*/
+                 _=0                             /* [↓]  count number of swapped symbols*/
+                    do d=1  for x  while $\==1;  _= _ + (substr(?,d,1)\==substr(prev,d,1))
+                    end   /*d*/
+                 if _>2  then do;        _=z
+                              a=$//x+1;  q=q + _ /* [← ↓]  this swapping tries adjacency*/
+                              b=q//x+1;  if b==a  then b=a + 1;       if b>x  then b=a - 1
+                              z=overlay( substr(z,b,1), overlay( substr(z,a,1), _, b),  a)
+                              iterate $          /*now, try this particular permutation.*/
+                              end
+                 #=#+1;  s= -s;   say pad   center(#, 11)    center(?, w)    right(s, 4-1)
+                 !.?=1;  prev=?;      iterate $  /*now, try another swapped permutation.*/
+                 end   /*m*/
+               end     /*k*/
+             end       /*$*/
+          return                                 /*we're all finished with permutating. */

Task/Permutations-by-swapping/Racket/permutations-by-swapping.rkt

@@ -0,0 +1,20 @@
+#lang racket
+
+(define (add-at l i x)
+  (if (zero? i) (cons x l) (cons (car l) (add-at (cdr l) (sub1 i) x))))
+
+(define (permutations l)
+  (define (loop l)
+    (cond [(null? l) '(())]
+          [else (for*/list ([(p i) (in-indexed (loop (cdr l)))]
+                            [i ((if (odd? i) identity reverse)
+                                (range (add1 (length p))))])
+                  (add-at p i (car l)))]))
+  (for/list ([p (loop (reverse l))] [i (in-cycle '(1 -1))]) (cons i p)))
+
+(define (show-permutations l)
+  (printf "Permutations of ~s:\n" l)
+  (for ([p (permutations l)])
+    (printf "  ~a (~a)\n" (apply ~a (add-between (cdr p) ", ")) (car p))))
+
+(for ([n (in-range 3 5)]) (show-permutations (range n)))

Task/Permutations-by-swapping/Raku/permutations-by-swapping.raku

@@ -0,0 +1,12 @@
+sub insert($x, @xs) { ([flat @xs[0 ..^ $_], $x, @xs[$_ .. *]] for 0 .. +@xs) }
+sub order($sg, @xs) { $sg > 0 ?? @xs !! @xs.reverse }
+
+multi perms([]) {
+    [] => +1
+}
+
+multi perms([$x, *@xs]) {
+    perms(@xs).map({ |order($_.value, insert($x, $_.key)) }) Z=> |(+1,-1) xx *
+}
+
+.say for perms([0..2]);

Task/Permutations-by-swapping/Ruby/permutations-by-swapping.rb

@@ -0,0 +1,26 @@
+def perms(n)
+  p = Array.new(n+1){|i| -i}
+  s = 1
+  loop do
+    yield p[1..-1].map(&:abs), s
+    k = 0
+    for i in 2..n
+      k = i if p[i] < 0 and p[i].abs > p[i-1].abs and p[i].abs > p[k].abs
+    end
+    for i in 1...n
+      k = i if p[i] > 0 and p[i].abs > p[i+1].abs and  p[i].abs > p[k].abs
+    end
+    break if k.zero?
+    for i in 1..n
+      p[i] *= -1 if p[i].abs > p[k].abs
+    end
+    i = k + (p[k] <=> 0)
+    p[k], p[i] = p[i], p[k]
+    s = -s
+  end
+end
+
+for i in 3..4
+  perms(i){|perm, sign| puts "Perm: #{perm}  Sign: #{sign}"}
+  puts
+end

Task/Permutations-by-swapping/Run-BASIC/permutations-by-swapping.basic

@@ -0,0 +1,36 @@
+sub perms n
+    dim p((n+1)*4)
+    for i = 1 to n : p(i) = i*-1 : next i
+    s = 1
+
+    while 1
+        print "Perm: [ ";
+        for i = 1 to n
+            print abs(p(i)); " ";
+        next i
+        print "] Sign: "; s
+
+        k = 0
+        for i = 2 to n
+            if p(i) < 0 and (abs(p(i)) > abs(p(i-1))) and (abs(p(i)) > abs(p(k))) then k = i
+        next i
+        for i = 1 to n-1
+            if p(i) > 0 and (abs(p(i)) > abs(p(i+1))) and (abs(p(i)) > abs(p(k))) then k = i
+        next i
+        if k then
+            for i = 1 to n   'reverse elements > k
+                if abs(p(i)) > abs(p(k)) then p(i) = p(i)*-1
+            next i
+            if p(k) < 0 then i = k-1 else i = k+1   'swap K with element looked at
+            temp = p(k)
+            p(k) = p(i)
+            p(i) = temp
+            s = s*-1         'alternate signs
+        end if
+    if k = 0 then exit while
+    wend
+end sub
+
+call perms 3
+print
+call perms 4

Task/Permutations-by-swapping/Rust/permutations-by-swapping.rust

@@ -0,0 +1,42 @@
+// Implementation of Heap's algorithm.
+// See https://en.wikipedia.org/wiki/Heap%27s_algorithm#Details_of_the_algorithm
+fn generate<T, F>(a: &mut [T], output: F)
+where
+    F: Fn(&[T], isize),
+{
+    let n = a.len();
+    let mut c = vec![0; n];
+    let mut i = 1;
+    let mut sign = 1;
+    output(a, sign);
+    while i < n {
+        if c[i] < i {
+            if (i & 1) == 0 {
+                a.swap(0, i);
+            } else {
+                a.swap(c[i], i);
+            }
+            sign = -sign;
+            output(a, sign);
+            c[i] += 1;
+            i = 1;
+        } else {
+            c[i] = 0;
+            i += 1;
+        }
+    }
+}
+
+fn print_permutation<T: std::fmt::Debug>(a: &[T], sign: isize) {
+    println!("{:?} {}", a, sign);
+}
+
+fn main() {
+    println!("Permutations and signs for three items:");
+    let mut a = vec![0, 1, 2];
+    generate(&mut a, print_permutation);
+
+    println!("\nPermutations and signs for four items:");
+    let mut b = vec![0, 1, 2, 3];
+    generate(&mut b, print_permutation);
+}

Task/Permutations-by-swapping/Scala/permutations-by-swapping.scala

@@ -0,0 +1,36 @@
+object JohnsonTrotter extends App {
+
+  private def perm(n: Int): Unit = {
+    val p = new Array[Int](n) // permutation
+    val pi = new Array[Int](n) // inverse permutation
+    val dir = new Array[Int](n) // direction = +1 or -1
+
+    def perm(n: Int, p: Array[Int], pi: Array[Int], dir: Array[Int]): Unit = {
+      if (n >= p.length) for (aP <- p) print(aP)
+      else {
+        perm(n + 1, p, pi, dir)
+        for (i <- 0 until n) { // swap
+          printf("   (%d %d)\n", pi(n), pi(n) + dir(n))
+          val z = p(pi(n) + dir(n))
+          p(pi(n)) = z
+          p(pi(n) + dir(n)) = n
+          pi(z) = pi(n)
+          pi(n) = pi(n) + dir(n)
+          perm(n + 1, p, pi, dir)
+        }
+        dir(n) = -dir(n)
+      }
+    }
+
+    for (i <- 0 until n) {
+      dir(i) = -1
+      p(i) = i
+      pi(i) = i
+    }
+    perm(0, p, pi, dir)
+    print("   (0 1)\n")
+  }
+
+  perm(4)
+
+}

Task/Permutations-by-swapping/Sidef/permutations-by-swapping.sidef

@@ -0,0 +1,22 @@
+func perms(n) {
+   var perms = [[+1]]
+   for x in (1..n) {
+      var sign = -1
+      perms = gather {
+        for s,*p in perms {
+          var r = (0 .. p.len)
+          take((s < 0 ? r : r.flip).map {|i|
+            [sign *= -1, p[^i], x, p[i..p.end]]
+          }...)
+        }
+      }
+   }
+   perms
+}
+
+var n = 4
+for p in perms(n) {
+    var s = p.shift
+    s > 0 && (s = '+1')
+    say "#{p} => #{s}"
+}

Task/Permutations-by-swapping/Swift/permutations-by-swapping.swift

@@ -0,0 +1,37 @@
+// Implementation of Heap's algorithm.
+// See https://en.wikipedia.org/wiki/Heap%27s_algorithm#Details_of_the_algorithm
+func generate<T>(array: inout [T], output: (_: [T], _: Int) -> Void) {
+    let n = array.count
+    var c = Array(repeating: 0, count: n)
+    var i = 1
+    var sign = 1
+    output(array, sign)
+    while i < n {
+        if c[i] < i {
+            if (i & 1) == 0 {
+                array.swapAt(0, i)
+            } else {
+                array.swapAt(c[i], i)
+            }
+            sign = -sign
+            output(array, sign)
+            c[i] += 1
+            i = 1
+        } else {
+            c[i] = 0
+            i += 1
+        }
+    }
+}
+
+func printPermutation<T>(array: [T], sign: Int) {
+    print("\(array) \(sign)")
+}
+
+print("Permutations and signs for three items:")
+var a = [0, 1, 2]
+generate(array: &a, output: printPermutation)
+
+print("\nPermutations and signs for four items:")
+var b = [0, 1, 2, 3]
+generate(array: &b, output: printPermutation)

Task/Permutations-by-swapping/Tcl/permutations-by-swapping-1.tcl

@@ -0,0 +1,50 @@
+# A simple swap operation
+proc swap {listvar i1 i2} {
+    upvar 1 $listvar l
+    set tmp [lindex $l $i1]
+    lset l $i1 [lindex $l $i2]
+    lset l $i2 $tmp
+}
+
+proc permswap {n v1 v2 body} {
+    upvar 1 $v1 perm $v2 sign
+
+    # Initialize
+    set sign -1
+    for {set i 0} {$i < $n} {incr i} {
+	lappend items $i
+	lappend dirs -1
+    }
+
+    while 1 {
+	# Report via callback
+	set perm $items
+	set sign [expr {-$sign}]
+	uplevel 1 $body
+
+	# Find the largest mobile integer (lmi) and its index (idx)
+	set i [set idx -1]
+	foreach item $items dir $dirs {
+	    set j [expr {[incr i] + $dir}]
+	    if {$j < 0 || $j >= [llength $items]} continue
+	    if {$item > [lindex $items $j] && ($idx == -1 || $item > $lmi)} {
+		set lmi $item
+		set idx $i
+	    }
+	}
+
+	# If none, we're done
+	if {$idx == -1} break
+
+	# Swap the largest mobile integer with "what it is looking at"
+	set nextIdx [expr {$idx + [lindex $dirs $idx]}]
+	swap items $idx $nextIdx
+	swap dirs $idx $nextIdx
+
+	# Reverse directions on larger integers
+	set i -1
+	foreach item $items dir $dirs {
+	    lset dirs [incr i] [expr {$item > $lmi ? -$dir : $dir}]
+	}
+    }
+}

Task/Permutations-by-swapping/Tcl/permutations-by-swapping-2.tcl

@@ -0,0 +1,3 @@
+permswap 4 p s {
+    puts "$s\t$p"
+}

Task/Permutations-by-swapping/Wren/permutations-by-swapping.wren

@@ -0,0 +1,49 @@
+var johnsonTrotter = Fn.new { |n|
+    var p = List.filled(n, 0)  // permutation
+    var q = List.filled(n, 0)  // inverse permutation
+    for (i in 0...n) p[i] = q[i] = i
+    var d = List.filled(n, -1) // direction = 1 or -1
+    var sign = 1
+    var perms = []
+    var signs = []
+
+    var permute // recursive closure
+    permute = Fn.new { |k|
+        if (k >= n) {
+            perms.add(p.toList)
+            signs.add(sign)
+            sign = sign * -1
+            return
+        }
+        permute.call(k + 1)
+        for (i in 0...k) {
+            var z = p[q[k] + d[k]]
+            p[q[k]] = z
+            p[q[k] + d[k]] = k
+            q[z] = q[k]
+            q[k] = q[k] + d[k]
+            permute.call(k + 1)
+        }
+        d[k] = d[k] * -1
+    }
+    permute.call(0)
+    return [perms, signs]
+}
+
+var printPermsAndSigns = Fn.new { |perms, signs|
+    var i = 0
+    for (perm in perms) {
+        System.print("%(perm) -> sign = %(signs[i])")
+        i = i + 1
+    }
+}
+
+var res = johnsonTrotter.call(3)
+var perms = res[0]
+var signs = res[1]
+printPermsAndSigns.call(perms, signs)
+System.print()
+res = johnsonTrotter.call(4)
+perms = res[0]
+signs = res[1]
+printPermsAndSigns.call(perms, signs)

Task/Permutations-by-swapping/XPL0/permutations-by-swapping.xpl0

@@ -0,0 +1,36 @@
+include c:\cxpl\codes;
+
+proc PERMS(N);
+int  N;                         \number of elements
+int  I, K, S, T, P;
+[P:= Reserve((N+1)*4);
+for I:= 0 to N do P(I):= -I;    \initialize facing left (also set P(0)=0)
+S:= 1;
+repeat  Text(0, "Perm: [ ");
+        for I:= 1 to N do
+                [IntOut(0, abs(P(I)));  ChOut(0, ^ )];
+        Text(0, "] Sign: ");  IntOut(0, S);  CrLf(0);
+
+        K:= 0;                  \find largest mobile element
+        for I:= 2 to N do                         \for left-facing elements
+            if P(I) < 0 and
+                abs(P(I)) > abs(P(I-1)) and       \ greater than neighbor
+                abs(P(I)) > abs(P(K)) then K:= I; \ get largest element
+        for I:= 1 to N-1 do                       \for right-facing elements
+            if P(I) > 0 and
+                abs(P(I)) > abs(P(I+1)) and       \ greater than neighbor
+                abs(P(I)) > abs(P(K)) then K:= I; \ get largest element
+        if K # 0 then           \mobile element found
+           [for I:= 1 to N do   \reverse elements > K
+                if abs(P(I)) > abs(P(K)) then P(I):= P(I)*-1;
+            I:= K + (if P(K)<0 then -1 else 1);
+            T:= P(K);  P(K):= P(I);  P(I):= T;    \swap K with element looked at
+            S:= -S;             \alternate signs
+            ];
+until   K = 0;                  \no mobile element remains
+];
+
+[PERMS(3);
+CrLf(0);
+PERMS(4);
+]

Task/Permutations-by-swapping/Yabasic/permutations-by-swapping.basic

@@ -0,0 +1,38 @@
+perms(3)
+print
+perms(4)
+end
+
+sub perms(n)
+    dim p((n+1)*4)
+    for i = 1 to n
+        p(i) = -i
+    next i
+    s = 1
+
+    repeat
+        print "Perm: [ ";
+        for i = 1 to n
+            print abs(p(i)), " ";
+        next i
+        print "] Sign: ", s
+
+        k = 0
+        for i = 2 to n
+            if p(i) < 0 and (abs(p(i)) > abs(p(i-1))) and (abs(p(i)) > abs(p(k)))  k = i
+        next i
+        for i = 1 to n-1
+            if p(i) > 0 and (abs(p(i)) > abs(p(i+1))) and (abs(p(i)) > abs(p(k)))  k = i
+        next i
+        if k then
+            for i = 1 to n    //reverse elements > k
+                if abs(p(i)) > abs(p(k))  p(i) = -p(i)
+            next i
+            i = k + sig(p(k))
+            temp = p(k)
+            p(k) = p(i)
+            p(i) = temp
+            s = -s
+        endif
+    until k = 0
+end sub

Task/Permutations-by-swapping/Zkl/permutations-by-swapping-1.zkl

@@ -0,0 +1,13 @@
+fcn permute(seq)
+{
+   insertEverywhere := fcn(x,list){ //(x,(a,b))-->((x,a,b),(a,x,b),(a,b,x))
+      (0).pump(list.len()+1,List,'wrap(n){list[0,n].extend(x,list[n,*]) })};
+   insertEverywhereB := fcn(x,t){ //--> insertEverywhere().reverse()
+      [t.len()..-1,-1].pump(t.len()+1,List,'wrap(n){t[0,n].extend(x,t[n,*])})};
+
+   seq.reduce('wrap(items,x){
+      f := Utils.Helpers.cycle(insertEverywhereB,insertEverywhere);
+      items.pump(List,'wrap(item){f.next()(x,item)},
+	      T.fp(Void.Write,Void.Write));
+   },T(T));
+}

Task/Permutations-by-swapping/Zkl/permutations-by-swapping-2.zkl

@@ -0,0 +1,6 @@
+p := permute(T(1,2,3));
+p.println();
+
+p := permute([1..4]);
+p.len().println();
+p.toString(*).println()

Task/Permutations-by-swapping/Zkl/permutations-by-swapping-3.zkl

@@ -0,0 +1,21 @@
+ fcn [private] _permuteW(seq){	// lazy version
+   N:=seq.len(); NM1:=N-1;
+   ds:=(0).pump(N,List,T(Void,-1)).copy(); ds[0]=0; // direction to move e: -1,0,1
+   es:=(0).pump(N,List).copy();  // enumerate seq
+
+   while(1) {
+      vm.yield(es.pump(List,seq.__sGet));
+
+      // find biggest e with d!=0
+      reg i=Void, c=-1;
+      foreach n in (N){ if(ds[n] and es[n]>c) { c=es[n]; i=n; } }
+      if(Void==i) return();
+
+      d:=ds[i]; j:=i+d;
+      es.swap(i,j); ds.swap(i,j);	// d tracks e
+      if(j==NM1 or j==0 or es[j+d]>c) ds[j]=0;
+      foreach e in (N){ if(es[e]>c) ds[e]=(i-e).sign }
+   }
+}
+
+fcn permuteW(seq) { Utils.Generator(_permuteW,seq) }

Task/Permutations-by-swapping/Zkl/permutations-by-swapping-4.zkl

@@ -0,0 +1 @@
+foreach p in (permuteW(T("a","b","c"))){ println(p) }