Permutations by swapping: Difference between revisions

Content added Content deleted

Inline

Revision as of 01:23, 29 April 2013

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 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 this discussion adjacency is not a requirement.

References

Cf.

Matrix arithmetic

BBC BASIC

Works with: BBC BASIC for Windows

<lang bbcbasic> 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</lang>

Output:

Perm: [ 1 2 3 ] Sign: 1
Perm: [ 1 3 2 ] Sign: -1
Perm: [ 3 1 2 ] Sign: 1
Perm: [ 3 2 1 ] Sign: -1
Perm: [ 2 3 1 ] Sign: 1
Perm: [ 2 1 3 ] Sign: -1

Perm: [ 1 2 3 4 ] Sign: 1
Perm: [ 1 2 4 3 ] Sign: -1
Perm: [ 1 4 2 3 ] Sign: 1
Perm: [ 4 1 2 3 ] Sign: -1
Perm: [ 4 1 3 2 ] Sign: 1
Perm: [ 1 4 3 2 ] Sign: -1
Perm: [ 1 3 4 2 ] Sign: 1
Perm: [ 1 3 2 4 ] Sign: -1
Perm: [ 3 1 2 4 ] Sign: 1
Perm: [ 3 1 4 2 ] Sign: -1
Perm: [ 3 4 1 2 ] Sign: 1
Perm: [ 4 3 1 2 ] Sign: -1
Perm: [ 4 3 2 1 ] Sign: 1
Perm: [ 3 4 2 1 ] Sign: -1
Perm: [ 3 2 4 1 ] Sign: 1
Perm: [ 3 2 1 4 ] Sign: -1
Perm: [ 2 3 1 4 ] Sign: 1
Perm: [ 2 3 4 1 ] Sign: -1
Perm: [ 2 4 3 1 ] Sign: 1
Perm: [ 4 2 3 1 ] Sign: -1
Perm: [ 4 2 1 3 ] Sign: 1
Perm: [ 2 4 1 3 ] Sign: -1
Perm: [ 2 1 4 3 ] Sign: 1
Perm: [ 2 1 3 4 ] Sign: -1

D

Iterative Version

This isn't a Range.

Translation of: Python

<lang d>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) dg) {
       int result;

       int sign = 1;
       alias Int2 = Tuple!(int, int);
       auto p = iota(n).map!(i => Int2(i, i ? -1 : 0))().array();
       TResult aux;

       if (doCopy) {
           aux[0] = p.map!(pp => pp[0])().array();
       } else {
           aux[0] = new int[n];
           foreach (immutable i, immutable pp; p)
               aux[0][i] = pp[0];
       }
       aux[1] = sign;
       result = dg(aux);
       if (result)
           goto END;

       while (p.canFind!(pp => pp[1])()) {
           // Failed to use std.algorithm here, too much complex.
           auto largest = Int2(-100, -100);
           int i1 = -1;
           foreach (immutable i, immutable pp; p) {
               if (pp[1]) {
                   if (pp[0] > largest[0]) {
                       i1 = i;
                       largest = pp;
                   }
               }
           }
           immutable n1 = largest[0], d1 = largest[1];

           sign *= -1;
           int i2;
           if (d1 == -1) {
               i2 = i1 - 1;
               swap(p[i1], p[i2]);
               if (i2 == 0 || p[i2 - 1][0] > n1)
                   p[i2][1] = 0;
           } else if (d1 == 1) {
               i2 = i1 + 1;
               swap(p[i1], p[i2]);
               if (i2 == n - 1 || p[i2 + 1][0] > n1)
                   p[i2][1] = 0;
           }

           if (doCopy) {
               aux[0] = p.map!(pp => pp[0])().array();
           } else {
               foreach (immutable i, immutable pp; p)
                   aux[0][i] = pp[0];
           }
           aux[1] = sign;
           result = dg(aux);
           if (result)
               goto END;

           foreach (immutable i3, ref pp; p) {
               immutable n3 = pp[0], d3 = pp[1];
               if (n3 > n1)
                   pp[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 (n; [3, 4]) {
           writefln("\nPermutations and sign of %d items", n);
           foreach (tp; spermutations(n))
               writefln("Perm: %s  Sign: %2d", tp.tupleof);
       }
   }

}</lang> Compile with version=permutations_by_swapping1 to see the demo output.

Output:

Permutations and sign of 3 items
Perm: [0, 1, 2]  Sign:  1
Perm: [0, 2, 1]  Sign: -1
Perm: [2, 0, 1]  Sign:  1
Perm: [2, 1, 0]  Sign: -1
Perm: [1, 2, 0]  Sign:  1
Perm: [1, 0, 2]  Sign: -1

Permutations and sign of 4 items
Perm: [0, 1, 2, 3]  Sign:  1
Perm: [0, 1, 3, 2]  Sign: -1
Perm: [0, 3, 1, 2]  Sign:  1
Perm: [3, 0, 1, 2]  Sign: -1
Perm: [3, 0, 2, 1]  Sign:  1
Perm: [0, 3, 2, 1]  Sign: -1
Perm: [0, 2, 3, 1]  Sign:  1
Perm: [0, 2, 1, 3]  Sign: -1
Perm: [2, 0, 1, 3]  Sign:  1
Perm: [2, 0, 3, 1]  Sign: -1
Perm: [2, 3, 0, 1]  Sign:  1
Perm: [3, 2, 0, 1]  Sign: -1
Perm: [3, 2, 1, 0]  Sign:  1
Perm: [2, 3, 1, 0]  Sign: -1
Perm: [2, 1, 3, 0]  Sign:  1
Perm: [2, 1, 0, 3]  Sign: -1
Perm: [1, 2, 0, 3]  Sign:  1
Perm: [1, 2, 3, 0]  Sign: -1
Perm: [1, 3, 2, 0]  Sign:  1
Perm: [3, 1, 2, 0]  Sign: -1
Perm: [3, 1, 0, 2]  Sign:  1
Perm: [1, 3, 0, 2]  Sign: -1
Perm: [1, 0, 3, 2]  Sign:  1
Perm: [1, 0, 2, 3]  Sign: -1

Recursive Version

Same output.

Translation of: Python

<lang d>import std.algorithm, std.array, std.typecons, std.range;

Tuple!(int[], int)[] sPermutations(in int n) /*pure nothrow*/ {

   static int[][] sPermu(in int items) /*pure nothrow*/ {
       if (items <= 0)
           return [[]];
       typeof(return) r;
       foreach (i, item; sPermu(items - 1)) {
           if (i % 2)
               r ~= iota(cast(int)item.length, -1, -1)
                    .map!(i => item[0..i] ~ (items-1) ~ item[i..$])()
                    .array();
           else
               r ~= iota(item.length + 1)
                    .map!(i => item[0..i] ~ (items-1) ~ item[i..$])()
                    .array();
       }
       return r;
   }

   auto r = sPermu(n);
   return iota(r.length)
          .map!(i => tuple(r[i], i % 2 ? -1 : 1))()
          .array();

}

void main() {

   import std.stdio;
   foreach (n; [3, 4]) {
       writefln("\nPermutations and sign of %d items", n);
       foreach (tp; sPermutations(n))
           writefln("Perm: %s Sign: %2d", tp.tupleof);
   }

}</lang>

Haskell

<lang haskell>insertEverywhere :: a -> [a] -> a insertEverywhere x [] = x insertEverywhere x l@(y:ys) = (x:l) : map (y:) (insertEverywhere x ys)

s_perm :: [a] -> a s_perm = foldl aux [[]]

 where aux items x = do (f, item) <- zip (cycle [reverse, id]) items
                        f (insertEverywhere x item)

s_permutations :: [a] -> [([a], Int)] s_permutations = flip zip (cycle [1, -1]) . s_perm

main :: IO () main = do

 putStrLn "3 items:"
 mapM_ print $ s_permutations [0..2]
 putStrLn "4 items:"
 mapM_ print $ s_permutations [0..3]</lang>

Output:

3 items:
([0,1,2],1)
([0,2,1],-1)
([2,0,1],1)
([2,1,0],-1)
([1,2,0],1)
([1,0,2],-1)
4 items:
([0,1,2,3],1)
([0,1,3,2],-1)
([0,3,1,2],1)
([3,0,1,2],-1)
([3,0,2,1],1)
([0,3,2,1],-1)
([0,2,3,1],1)
([0,2,1,3],-1)
([2,0,1,3],1)
([2,0,3,1],-1)
([2,3,0,1],1)
([3,2,0,1],-1)
([3,2,1,0],1)
([2,3,1,0],-1)
([2,1,3,0],1)
([2,1,0,3],-1)
([1,2,0,3],1)
([1,2,3,0],-1)
([1,3,2,0],1)
([3,1,2,0],-1)
([3,1,0,2],1)
([1,3,0,2],-1)
([1,0,3,2],1)
([1,0,2,3],-1)

J

J has a built in mechanism for representing permutations (which is designed around the idea of selecting a permutation uniquely by an integer) but it does not seem seem to have an obvious mapping to Steinhaus–Johnson–Trotter. Perhaps someone with a sufficiently deep view of the subject of permutations can find a direct mapping?

Meanwhile, here's an inductive approach, using negative integers to look left and positive integers to look right:

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

Here, bfsjt0 N gives the initial permutation of order N, and bfsjtn^:M bfsjt0 N gives the Mth Steinhaus–Johnson–Trotter permutation of order N. (bf stands for "brute force".)

To convert from the Steinhaus–Johnson–Trotter representation of a permutation to J's representation, use <:@|, or to find J's anagram index of a Steinhaus–Johnson–Trotter representation of a permutation, use A.@:<:@:|

Example use:

<lang J> 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</lang>

Here's an example of the Steinhaus–Johnson–Trotter representation of 3 element permutation, with sign (sign is the first column):

<lang J> (_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</lang>

Alternatively, J defines C.!.2 as the parity of a permutation:

<lang J> (,.~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</lang>

Recursive Implementation

This is based on the python recursive implementation:

<lang J>rsjt=: 3 :0

 if. 2>y do. i.2#y
 else.  ((!y)$(,~|.)-.=i.y)#inv!.(y-1)"1 y#rsjt y-1
 end.

)</lang>

Example use (here, prefixing each row with its parity):

<lang J> (,.~ 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</lang>

Mathematica

Recursive

<lang>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];</lang>

Example: <lang>Print["Perm: ", #1, " Sign: ", #2] & /@ perms@4;</lang> Output:

Perm: {1,2,3,4} Sign: 1
Perm: {1,2,4,3} Sign: -1
Perm: {1,4,2,3} Sign: 1
Perm: {4,1,2,3} Sign: -1
Perm: {4,1,3,2} Sign: 1
Perm: {1,4,3,2} Sign: -1
Perm: {1,3,4,2} Sign: 1
Perm: {1,3,2,4} Sign: -1
Perm: {3,1,2,4} Sign: 1
Perm: {3,1,4,2} Sign: -1
Perm: {3,4,1,2} Sign: 1
Perm: {4,3,1,2} Sign: -1
Perm: {4,3,2,1} Sign: 1
Perm: {3,4,2,1} Sign: -1
Perm: {3,2,4,1} Sign: 1
Perm: {3,2,1,4} Sign: -1
Perm: {2,3,1,4} Sign: 1
Perm: {2,3,4,1} Sign: -1
Perm: {2,4,3,1} Sign: 1
Perm: {4,2,3,1} Sign: -1
Perm: {4,2,1,3} Sign: 1
Perm: {2,4,1,3} Sign: -1
Perm: {2,1,4,3} Sign: 1
Perm: {2,1,3,4} Sign: -1

Perl 6

Recursive

<lang perl6>sub insert($x, @xs) { [@xs[0..$_-1], $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]);</lang>

Output:

[0, 1, 2] => 1
[1, 0, 2] => -1
[1, 2, 0] => 1
[2, 1, 0] => -1
[2, 0, 1] => 1
[0, 2, 1] => -1

Python

Python: iterative

When saved in a file called spermutations.py it is used in the Python example to the Matrix arithmetic task and so any changes here should also be reflected and checked in that task example too.

<lang python>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'</lang>

Output:

Permutations and sign of 3 items
Perm: (0, 1, 2) Sign:  1
Perm: (0, 2, 1) Sign: -1
Perm: (2, 0, 1) Sign:  1
Perm: (2, 1, 0) Sign: -1
Perm: (1, 2, 0) Sign:  1
Perm: (1, 0, 2) Sign: -1

Permutations and sign of 4 items
Perm: (0, 1, 2, 3) Sign:  1
Perm: (0, 1, 3, 2) Sign: -1
Perm: (0, 3, 1, 2) Sign:  1
Perm: (3, 0, 1, 2) Sign: -1
Perm: (3, 0, 2, 1) Sign:  1
Perm: (0, 3, 2, 1) Sign: -1
Perm: (0, 2, 3, 1) Sign:  1
Perm: (0, 2, 1, 3) Sign: -1
Perm: (2, 0, 1, 3) Sign:  1
Perm: (2, 0, 3, 1) Sign: -1
Perm: (2, 3, 0, 1) Sign:  1
Perm: (3, 2, 0, 1) Sign: -1
Perm: (3, 2, 1, 0) Sign:  1
Perm: (2, 3, 1, 0) Sign: -1
Perm: (2, 1, 3, 0) Sign:  1
Perm: (2, 1, 0, 3) Sign: -1
Perm: (1, 2, 0, 3) Sign:  1
Perm: (1, 2, 3, 0) Sign: -1
Perm: (1, 3, 2, 0) Sign:  1
Perm: (3, 1, 2, 0) Sign: -1
Perm: (3, 1, 0, 2) Sign:  1
Perm: (1, 3, 0, 2) Sign: -1
Perm: (1, 0, 3, 2) Sign:  1
Perm: (1, 0, 2, 3) Sign: -1

Python: recursive

After spotting the pattern of highest number being inserted into each perm of lower numbers from right to left, then left to right, I developed this recursive function: <lang python>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))]</lang>

Sample output

The output is the same as before except it is a list of all results rather than yielding each result from a generator function.

Python: Iterative version of the recursive

Replacing the recursion in the example above produces this iterative version function: <lang python>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)]</lang>

Sample output

The output is the same as before and is a list of all results rather than yielding each result from a generator function.

Racket

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))) </lang>

Output:

Permutations of (0 1 2):
  0, 1, 2 (1)
  0, 2, 1 (-1)
  2, 0, 1 (1)
  2, 1, 0 (-1)
  1, 2, 0 (1)
  1, 0, 2 (-1)
Permutations of (0 1 2 3):
  0, 1, 2, 3 (1)
  0, 1, 3, 2 (-1)
  0, 3, 1, 2 (1)
  3, 0, 1, 2 (-1)
  3, 0, 2, 1 (1)
  0, 3, 2, 1 (-1)
  0, 2, 3, 1 (1)
  0, 2, 1, 3 (-1)
  2, 0, 1, 3 (1)
  2, 0, 3, 1 (-1)
  2, 3, 0, 1 (1)
  3, 2, 0, 1 (-1)
  3, 2, 1, 0 (1)
  2, 3, 1, 0 (-1)
  2, 1, 3, 0 (1)
  2, 1, 0, 3 (-1)
  1, 2, 0, 3 (1)
  1, 2, 3, 0 (-1)
  1, 3, 2, 0 (1)
  3, 1, 2, 0 (-1)
  3, 1, 0, 2 (1)
  1, 3, 0, 2 (-1)
  1, 0, 3, 2 (1)
  1, 0, 2, 3 (-1)

Tcl

<lang tcl># 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}] }

}</lang> Demonstrating: <lang tcl>permswap 4 p s {

   puts "$s\t$p"

}</lang>

Output:

XPL0

Translation of BBC BASIC example, which uses the Johnson-Trotter algorithm. <lang XPL0>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); ]</lang>

Output:

Perm: [ 1 2 3 ] Sign: 1
Perm: [ 1 3 2 ] Sign: -1
Perm: [ 3 1 2 ] Sign: 1
Perm: [ 3 2 1 ] Sign: -1
Perm: [ 2 3 1 ] Sign: 1
Perm: [ 2 1 3 ] Sign: -1

Perm: [ 1 2 3 4 ] Sign: 1
Perm: [ 1 2 4 3 ] Sign: -1
Perm: [ 1 4 2 3 ] Sign: 1
Perm: [ 4 1 2 3 ] Sign: -1
Perm: [ 4 1 3 2 ] Sign: 1
Perm: [ 1 4 3 2 ] Sign: -1
Perm: [ 1 3 4 2 ] Sign: 1
Perm: [ 1 3 2 4 ] Sign: -1
Perm: [ 3 1 2 4 ] Sign: 1
Perm: [ 3 1 4 2 ] Sign: -1
Perm: [ 3 4 1 2 ] Sign: 1
Perm: [ 4 3 1 2 ] Sign: -1
Perm: [ 4 3 2 1 ] Sign: 1
Perm: [ 3 4 2 1 ] Sign: -1
Perm: [ 3 2 4 1 ] Sign: 1
Perm: [ 3 2 1 4 ] Sign: -1
Perm: [ 2 3 1 4 ] Sign: 1
Perm: [ 2 3 4 1 ] Sign: -1
Perm: [ 2 4 3 1 ] Sign: 1
Perm: [ 4 2 3 1 ] Sign: -1
Perm: [ 4 2 1 3 ] Sign: 1
Perm: [ 2 4 1 3 ] Sign: -1
Perm: [ 2 1 4 3 ] Sign: 1
Perm: [ 2 1 3 4 ] Sign: -1