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