by Michael Hutton May 2011

You may want to find all the possible permutations of a set. The following procedure(s) will take an integer array of values (they could be numbers or pointers to strings for example) and calculate the next lexicographical permutation of the array.

      DEF PROC_NextPermutation(A%())
      LOCAL first, last, elementcount, pos
      elementcount = DIM(A%(),1)
      IF elementcount < 1 THEN ENDPROC
      pos = elementcount-1
      WHILE A%(pos) >= A%(pos+1)
        pos -= 1
        IF pos < 0 THEN
          PROC_Permutation_Reverse(A%(), 0, elementcount)
          ENDPROC
        ENDIF
      ENDWHILE
      last = elementcount
      WHILE A%(last) <= A%(pos)
        last -= 1
      ENDWHILE
      SWAP A%(pos), A%(last)
      PROC_Permutation_Reverse(A%(), pos+1, elementcount)
      ENDPROC

      DEF PROC_Permutation_Reverse(A%(), first, last)
      WHILE first < last
        SWAP A%(first), A%(last)
        first += 1
        last -= 1
      ENDWHILE
      ENDPROC

So, for example to find all the permutations of a 5 element array:

      S% = 4
      DIM A%(S%), O%(S%)

      REM Fill the array
      FOR I% = 0 TO S% : A%(I%) = I% : NEXT

      REM Set O%() to hold the original array
      O%() = A%()

      REM A one line factorial function
      DEF FN_Factorial(N) : IF (N = 1) OR (N = 0) THEN = 1 ELSE = N * FN_Factorial(N-1)

      REM Calculate the permutations
      N% = FN_Factorial(DIM(A%(),1)+1)
      C% = 0
      REPEAT
        FOR I%= 0 TO S%
          PRINT ;A%(I%);" ";
        NEXT
        PROC_NextPermutation(A%())
        C% += 1
        PRINT
      UNTIL C% = N%
      PRINT "Number of Permutations = ";C%

or alternatively, to find all the permutations of a string use this code:

      A$ = "BB4W"
      N% = FN_Factorial(LEN(A$))
      PRINT" There are ";N%;" permutations of ";A$
      FOR I% = 1 TO N%
        A$ = FN_NextPermutation$(A$)
        PRINT I%," "A$
      NEXT

      END

      DEF FN_NextPermutation$(A$)
      LOCAL A%(),I%
      DIM A%(LENA$-1)
      FOR I%=0 TO (LENA$-1)
        A%(I%) = ASCMID$(A$,I%+1)
      NEXT
      PROC_NextPermutation(A%())
      FOR I%=0 TO (LENA$-1)
        MID$(A$,I%+1,1) = CHR$A%(I%)
      NEXT
      =A$

To calculate the number of Derangements ie. the number of permutations in which no item appears in its original place you can calculate the SubFactorial of the number of items.

There are two ways of doing this, either:

DEF FN_SubFactorial(N) : IF N<1 THEN =1 ELSE =(N-1)*(FN_SubFactorial(N-1)+FN_SubFactorial(N-2))

or

DEF FN_SubFactorial(N) : IF N=0 THEN =1 ELSE = N*FN_SubFactorial(N-1)+-1^N