## Tuesday, May 3, 2016

### Fast generation of the symmetric and alternating groups

From Wikipedia I got this algorithm, how to generate all permutation in alphabetical order:

1. Find the largest index k such that a[k]<a[k+1]. If no such index
exists, the permutation is the last.
2. Find the largest index l greater than k such that a[k]<a[l].
3. Swap the value of a[k] with that of a[l].
4. Reverse the sequence from a[k+1] up to and including the final
element a[n].

First a word that reverse the order of all n characters starting at address ad.

: reverse-string \ ad n --
loop ;

Then the 1'st part of the algorithm, returning the address corresponding to the index k if it exists or else return 0.

: lex-perm1 \ ad n -- a1
0 loc{ a1 } 2 - over +
do i c@ i 1+ c@ <
if i to a1 leave then -1
+loop a1 ;

Find the largest address a2 greater than a1 such that [a1]<[a2].

: lex-perm2 \ ad n a1 -- a2
0 loc{ a1 a2 } 1- over +
do a1 c@ i c@ <
if i to a2 leave then -1
+loop a2 ;

Swap the values at addresses a1 and a2.

: lex-perm3 \ a1 a2 --
over c@ over c@
swap rot c!
swap c! ;

Reverse the order of the last characters, from address a1 to the end.

: lex-perm4 \ ad n a1 --
1+ -rot            \ a1+1 ad n
+ over -           \ a1+1 ad+n-(a1+1)
reverse-string ;

Calculate the next permutation:

: nextp \ ad n --
lex-perm1 dup 0=
if 2drop 2drop drop exit
lex-perm2 r>       \ ad n a2 a1
tuck swap          \ ad n a1 a1 a2
lex-perm4 ;

Create the string 123...n:

: n>str \ n -- ad n
dup 0 do i 49 + pad i + c! loop pad swap ;

Create a vector on the z-stack from the string.

: str>vect \ ad n -- | -- s
loc{ ad n } n dup 0
do ad i + c@ 15 and >zst loop 2* 1+ negate >zst ;

Fast calculation of the symmetry group of n! permutations.

: sym \ n -- | -- s
n dup ufaculty dup 0
loop swap 1+ * 2* negate >zst ;

utime 7 sym cardinality . utime d- d. 5040 -3931  ok

What would take hours with straight forward generation is now done in 4 milliseconds.

Next word calculates how many components in the vector s that is greater than the number m:

: perm> \ m -- n | s --
loc{ m } 0
foreach do zst> m > + loop negate ;

This is used to calculate the number of pairs of components in the vector s that is unsorted:

: #perm \ -- n | s --
0
begin zst@ -3 <
while zsplit zst> zdup perm> +
repeat zdrop ;

Which determine if the vector correspond to an odd permutation:

: oddperm \ -- flag | s --
#perm 1 and ;

: alt \ n -- | -- s
n dup ufaculty dup 0
do ad n str>vect zdup oddperm
if zdrop then ad n nextp
loop swap 1+ * negate >zst ;

utime 7 alt cardinality . utime d- d. 2520 -35424  ok

To filter out the odd permutations takes some time, so the alternating group of n!/2 even permutations runs in 35 ms.

What is left is to figure out how to generate general groups fast. And to write a manual!