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

 Steinhaus–Johnson–Trotter algorithm
 Johnson-Trotter Algorithm Listing All Permutations
 Heap's algorithm
 [1] Tintinnalogia


Related tasks

   Matrix arithmetic
   Gray code


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