ANEW --PERM--                                 \  Wil Baden  2003-01-01

\  *******************************************************************
\  *                                                                 *
\  *  Wil Baden 2000-09-01                                           * 
\  *                                                                 *
\  *     Permutation by Adjacent Exchange                            *
\  *                                                                 *
\  *******************************************************************

\  Here is the permutation method that I prefer. It was "originated" 
\  by me, but I don't think I'm the original person to do it. 

\  Its virtue is that successive permutations are obtained by 
\  exchanging a pair of adjacent bytes. (SPELL-DISTANCE is 1.) This 
\  makes it the most practical when stepping through permutations, 
\  especially when physical or mechanical effort must be used. 

\  The output here shows the index of the adjacent bytes to exchange 
\  for the next permutation. 

\  You can modify the output routine `PERMUTE` to accommodate your 
\  requirements. 

\  You can do your own initialization of `Perm-Buffer`. 

\  ******************************  How  ******************************

\  To go from sequence number to permutation, take the remainders after
\  dividing by N, N-1, N-2, etc., stopping when you get a non-zero
\  remainder.

\  With a non-zero remainder when the quotient is odd, subtract the
\  remainder from the divisor.

\  With a zero remainder when the quotient is even, increment _addr_.

\  When all remainders are 0, all permutations have been made.

\         int permlength;

\         char permbuf[12];

\         void initperm (void) {
\             int i;
\             for (i = 0; i < 12; i++)
\                 permbuf[i] = 'A' + i;
\         }

\         int nextperm (int n) {
\         int addr = 0;
\         int rem, temp;
\         for (int i = permlength; i > 1; i--)
\             rem = n % i; n = n / i;
\             if (rem != 0) {
\                 if (n & 1) rem = i - rem;
\                 addr += rem;
\                 temp            = permbuf[addr];
\                 permbuf[addr]   = permbuf[addr-1];
\                 permbuf[addr-1] = temp;
\                 return (addr);
\             }
\             if ((n & 1) == 0) addr++;
\         }
\         return (0);
\         }

\         void permute (void) {
\             int i, j, n;
\             for (j = 0; j < permlength; j++)
\                 permbuf[j] = 'A' + j;
\             n = 0;
\             do {
\                 for (j = 0, j < permlength; j++)
\                     putchar (permbuf[j]);
\                 ++n;
\                 i = nextperm (n);
\                 printf (" %d ", i);
\                 if (n % permlength == 0) putchar ('\n');
\             } while (i != 0);
\             printf ("%d\n", n);
\         }


\  *******************************************************************
\  *     Perm-Length  Perm-Buffer  Init-Perm-Buffer                  *
\  *******************************************************************

\  Perm-Length        ( -- n )
\     Number of bytes to be permuted.

\  Perm-Buffer        ( -- addr )
\     Buffer to hold current permutation

\  Init-Perm-Buffer   ( -- )
\     Initialize `Perm-Buffer` with default string.

4 VALUE Perm-Length  \  12 at the most for 32-bit arithmetic.

CREATE Perm-Buffer  12 CHARS ALLOT

: Init-Perm-Buffer  ( -- )
    S" ABCDEFGHIJKL" Perm-Buffer SWAP MOVE ;

\  *******************************************************************
\  *     Exchange-Char  Next-Perm                                    *
\  *******************************************************************

\  Exchange-Char       ( addr addr -- ) 
\     Exchange the characters at two addresses. 

\  Next-Perm           ( n -- i ) 
\     Given _n_, the current permutation sequence number, generate 
\     next permutation in `Perm-Buffer` and return index of the 
\     adjacent pair. If permutations are complete, return 0. 

    : Exchange-Char    ( addr addr -- )
        DUP C@ >R  OVER C@ SWAP C!  R> SWAP C! ;

: Next-Perm            ( n -- i )
    0 SWAP                      ( addr n)
    2 Perm-Length DO
        I /MOD                  ( addr rem n)
        OVER IF
            1 AND IF  I SWAP -  THEN  ( addr rem)
            +                   ( addr)
            Perm-buffer over +  DUP 1-  Exchange-Char
            UNLOOP EXIT
        THEN                    ( addr rem n)
        >R  DROP  R@ 1 AND 0= IF  1+  THEN  R>
    -1 +LOOP
    2DROP 0 ;

\  *******************************************************************
\  *     PERMUTE  PERMUTATIONS                                       *
\  *******************************************************************

\  PERMUTE             ( -- ) 
\     Do all permutations on `Perm-Buffer`, displaying the index of 
\     the next adjacent pair to exchange. 

\  PERMUTATIONS        ( -- ) 
\     Initialize `Perm-Buffer` with default string using 
\     `Init-Perm-Buffer`, and do all permutations on Perm-Buffer` 
\     using `PERMUTE`. 

: PERMUTE              ( -- )
    Perm-Length 2 13 WITHIN NOT IF  EXIT  THEN
    0 BEGIN                    ( n)
        DUP Perm-Length MOD 0= IF  CR  THEN
        Perm-Buffer Perm-Length TYPE SPACE
        1+                     ( n)
        DUP Next-Perm          ( n i)
        DUP .
    0= UNTIL
    CR . ;

: PERMUTATIONS         ( -- )
    Init-Perm-Buffer          ( addr)
    PERMUTE ; 

\  *******************************************************************
\  *      Sample                                                     *
\  *******************************************************************

    3 to Perm-Length PERMUTATIONS

    4 to Perm-Length PERMUTATIONS

    5 to Perm-Length PERMUTATIONS

\\   //   \\   //   \\   //   \\   //   \\   //   \\   //   \\   //   \\