## Monday, March 14, 2016

### Some groups

First, I have improved the word psubgroups. Stupidly enough it calculated the whole (known) group. Now it works 5-10 times faster and calculate the set of subgroups of Sym(4) in a second. To calculate the set of subgroups to Sym(5) takes about 30 minutes, though, so enhancements must still be made.

Now handling groups with order around 100 and subgroups of groups with order around 30 is okay. A little more with a fast system...

Some finite groups

\ cyclic group of permutations of 1...n
: cyc \ n -- | -- s
pcirc pgen ;

6 cyc zet. {(6,1,2,3,4,5),(5,6,1,2,3,4),(4,5,6,1,2,3),(3,4,5,6,1,2),(2,3,4,5,6,1),(1,2,3,4,5,6)} ok

\ symetric group of permutations of 1...n, n<6
: sym \ n -- | -- s
dup 2 >
if dup pcirc zfence proll zfence zmerge generate
else 2 = if ( 2 1 ) pgen else ( 1 ) pgen then
then ;

The n-th symmetry group is the set of all bijections of {1,...,n}.

4 sym cr zet.
{(4,2,3,1),(1,2,3,4),(1,3,4,2),(2,3,4,1),(2,4,3,1),(1,4,3,2),(2,1,3,4),(4,1,3,2),(3,4,1,2),(2,4,1,3),(3,4,2,1),(1,4,2,3),(3,1,4,2),(2,1,4,3),(3,2,4,1),(1,2,4,3),(4,3,1,2),(2,3,1,4),(4,2,1,3),(3,2,1,4),(4,3,2,1),(1,3,2,4),(4,1,2,3),(3,1,2,4)} ok

\ dihedral group of permutations of 1...n
: dih \ n -- | -- s
dup >r pcirc zfence
( 1 r> ?do i -1 +loop ) zfence
zetmerge generate ;

6 dih cr zet.
{(6,5,4,3,2,1),(6,1,2,3,4,5),(2,1,6,5,4,3),(2,3,4,5,6,1),(4,5,6,1,2,3),(4,3,2,1,6,5),(3,2,1,6,5,4),(3,4,5,6,1,2),(5,4,3,2,1,6),(5,6,1,2,3,4),(1,2,3,4,5,6),(1,6,5,4,3,2)} ok

There is also an other tradition where the dihedral group is denoted after the order of the group, but I think it's more consequent to denote it after the number of permutation elements.

Any permutation can be factorized in simple so called 2-cycles: (n m) where n maps to m and m maps to n. Example: (2,3,1)=(1 2)(1 3). Certain permutations can be factorized in an even number of 2-cycles and some can not. The product of even permutations is of course an even permutation and those permutation forms a subgroup Alt(S) of Sym(S). Both Sym(S) and Alt(S) can be generated by two elements, while their subgroups might not.

\ alternating group of permutations of 1...n, n<6
: alt \ n -- | -- s   n>2
dup 3 = if drop ( 2 3 1 ) pgen exit then
dup 1 and
if >r
{ r@ pcirc
( r@ 2 - 1 do i loop r@ 1- r@ r> 2 - )
} generate
else >r
{ ( r@ 2 do i loop 1 r@ )
( r@ 2 - 1 do i loop r@ 1- r@ r> 2 - )
} generate
then ;

4 alt cr zet.
{(3,4,1,2),(3,1,2,4),(3,2,4,1),(4,1,3,2),(2,1,4,3),(1,3,4,2),(2,4,3,1),(1,4,2,3),(2,3,1,4),(4,3,2,1),(1,2,3,4),(4,2,1,3)} ok

\ quaternion group Q8={±1,±i,±j,±k} as group of permutations of 1..8
\ q8 \ -- s
: { ( 2 4 6 7 3 8 1 5 ) ( 3 5 4 8 7 2 6 1 ) } generate ;

### The product of two permutation groups given as a permutation group

\ extend, to the right, bijection v to permute n elements
: rext \ n -- | v -- v'
>r ( r> zst@ cs do i 1+ loop )
1 zst+! zswap 1 zst+! zswap zmerge -1 zst+! ;

\ extend to the left
: lext \ n -- | v -- v'
dup >r ( r> zst@ cs - 1+ 1 do i loop ) 1 zst+!
zswap zst@ tuck cs - loc{ x y }
1 zst+! foreach
do zst> y + loop x 1+ >>zst
zmerge -1 zst+! ;

\ extend all functions in a set to the right
: multirext \ n -- | s -- s'
0 >xst foreach
do dup rext zfence xzmerge
loop drop xst zst setmove ;

3 sym 4 multirext cr zet.
{(3,2,1,4),(1,2,3,4),(2,3,1,4),(1,3,2,4),(3,1,2,4),(2,1,3,4)} ok

\ extend all to the left
: multilext \ n -- | s -- s'
0 >xst foreach
do dup lext zfence xzmerge
loop drop xst zst setmove ;

5 cyc 6 multilext cr zet.
{(1,2,3,4,5,6),(1,3,4,5,6,2),(1,4,5,6,2,3),(1,5,6,2,3,4),(1,6,2,3,4,5)} ok

\ the product of two groups s and s'
: gprod \ s s' -- sxs'
ord zswap ord +
dup multirext zswap
multilext union generate ;

2 cyc zdup gprod zet. {(2,1,3,4),(1,2,3,4),(1,2,4,3),(2,1,4,3)} ok

3 cyc 4 alt gprod cr zet.
{(2,3,1,4,5,6,7,8,9,10,11,15,12,14,13),(2,3,1,4,5,6,7,8,9,10,11,15,14,13,12),(2,3,1,4,5,6,7,8,9,10,11,12,14,15,13),(2,3,1,4,5,6,7,8,9,10,11,13,14,12,15),(2,3,1,4,5,6,7,8,9,10,11,14,15,12,13),(2,3,1,4,5,6,7,8,9,10,11,13,12,15,14),(2,3,1,4,5,6,7,8,9,10,11,14,12,13,15),(2,3,1,4,5,6,7,8,9,10,11,13,15,14,12),(2,3,1,4,5,6,7,8,9,10,11,12,15,13,14),(2,3,1,4,5,6,7,8,9,10,11,14,13,15,12),(2,3,1,4,5,6,7,8,9,10,11,12,13,14,15),(1,2,3,4,5,6,7,8,9,10,11,12,14,15,13),(1,2,3,4,5,6,7,8,9,10,11,12,15,13,14),(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15),(1,2,3,4,5,6,7,8,9,10,11,14,15,12,13),(1,2,3,4,5,6,7,8,9,10,11,13,15,14,12),(1,2,3,4,5,6,7,8,9,10,11,15,12,14,13),(1,2,3,4,5,6,7,8,9,10,11,13,14,12,15),(1,2,3,4,5,6,7,8,9,10,11,15,14,13,12),(1,2,3,4,5,6,7,8,9,10,11,13,12,15,14),(1,2,3,4,5,6,7,8,9,10,11,14,12,13,15),(1,2,3,4,5,6,7,8,9,10,11,14,13,15,12),(3,1,2,4,5,6,7,8,9,10,11,12,14,15,13),(3,1,2,4,5,6,7,8,9,10,11,12,15,13,14),(3,1,2,4,5,6,7,8,9,10,11,12,13,14,15),(3,1,2,4,5,6,7,8,9,10,11,14,15,12,13),(3,1,2,4,5,6,7,8,9,10,11,13,15,14,12),(3,1,2,4,5,6,7,8,9,10,11,15,12,14,13),(3,1,2,4,5,6,7,8,9,10,11,13,14,12,15),(3,1,2,4,5,6,7,8,9,10,11,15,14,13,12),(3,1,2,4,5,6,7,8,9,10,11,13,12,15,14),(3,1,2,4,5,6,7,8,9,10,11,14,12,13,15),(3,1,2,4,5,6,7,8,9,10,11,15,13,12,14),(3,1,2,4,5,6,7,8,9,10,11,14,13,15,12),(2,3,1,4,5,6,7,8,9,10,11,15,13,12,14),(1,2,3,4,5,6,7,8,9,10,11,15,13,12,14)} ok

### Pseudo isomorphism test

\ the set of cyclic subgroups of the group s
: pcsubs \ s -- s'
0 >xst
foreach
do pgen zfence xzmerge
loop xst zst setmove reduce ;

\ flag true if not equal cardinality
: card<> \ -- flag | s s' -- s s'

zover cardinality zdup cardinality = 0= ;

\ sort a list of non-negative integers
: vect-sort \ v -- v'
set-sort zst> 1- > zst ;

\ compute vector of orders of all cyclic subgroups in s
: pscan \ s -- v
0 foreach do cardinality swap 1+ loop
sort 2* 1+ negate >zet ;

: pseudoiso \ -- flag | s s' --
card<>
if zdrop zdrop false exit then
pcsubs zswap pcsubs card<>
if zdrop zdrop false exit then
pscan zswap pscan vector= ;

4 dih pcsubs pscan zet. (1,2,2,2,2,2,4) ok
4 dih 8 cyc pseudoiso . 0  ok
3 sym 3 dih pseudoiso . -1  ok

Due to Mathematics Stack Exchange the psudoiso test holds for all subgroups of Sym(7) but already in Sym(8) there are counterexamples. A counterexample in Sym(16) is also:

4 cyc zdup gprod 2 cyc q8 gprod pseudoiso . -1  ok

## Friday, March 4, 2016

### Tutorial: play around 1

In addition to the two Forth stacks s and r, there are three stacks x, y and z in Zet. The main stack (set parameter stack) for bundles is z. Most of the algebraic is done in z, for example:

reduce ( -- ) that eliminates copies of members in sorted sets in z;

zdup zdrop zover zswap znip ztuck and zrot manipulates bundles in z;
cardinality ( -- n | s -- ) that counts the number of elements in sets or components vectors;
foreach ( -- n 0 | s -- z1...zn ) that "appends" a set and prepare for a do loop for each element;
zet. ( s -- ) that prints the set/vector on z;
subset zet= member that examines sets and vectors on z;
union intersection diff powerset cartprod etc that works on z;
set-sort ( -- | m1...mk -- n1---nk )
zmerge ( s s' -- s" )

The other two stacks, x and y, are help stacks that compensate the lack of variables. Some operations working on x and y are:

setdup ( ad -- | obj -- obj obj )

setdrop ( ad -- | obj -- )
setover ( ad -- | obj1 obj2 -- obj1 obj2 obj1
_fence ( ad -- | obj -- {obj} )

And there are also some special words for stack interaction:

xzmerge ( s -- ) takes set from z and merge so set in x

yzcopy1 ( -- s ) copy set from top y to z
yzcopy2 ( -- s ) copy set from next after top y to z

There are two main methods to penetrate a set, to use foreach or to use zsplit (or ysplit). When all elements are to be penetrated foreach is handy, but no objects under the top set on z can be reached under the penetration. When using zsplit, that splits a set in the top element and the rest of the set, the sets under can be reached, and the penetration can be abrupt without stack problems.

The facility with | in

{ 1 100 | prime } cr zet.{2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97} ok

does only work in interpretation mode and can't be compiled.

1 value num
: coprime \ n -- flag
num ugcd 1 = ;

{ 1 30 dup to num | coprime } zet. {1,7,11,13,17,19,23,29} ok
17 num invmod . 23  ok
17 23 num u*mod . 1  ok

: setint+ \ n -- | s -- s'
0 >xst                       \ empty set on x
foreach                      \ for each number in s
?do zst> over + >zst         \ element to datastack and back
zfence xzmerge            \ merge {x+y} to the set on x
loop drop xst zst setmove ;  \ drop n and move the set to z

: set+ \ s s' -- s"
0 >xst
zst yst setmove
foreach
?do zst>                     \ element to data stack
yzcopy1 setint+           \ add element to all elements in s'
xzmergered                \ merge this set to the set on x
loop yst setdrop
xst zst setmove ;

{ 3 100 | prime } zdup set+ cr zet.
{6,8,10,12,14,16,18,20,22,24,26,28,30,32,34,36,38,40,42,44,46,48,50,52,54,56,58,60,62,64,66,68,70,72,74,76,78,80,82,84,86,88,90,92,94,96,98,100,102,104,106,108,110,112,114,116,118,120,122,124,126,128,130,132,134,136,138,140,142,144,146,148,150,152,154,156,158,160,162,164,166,168,170,172,176,178,180,186,194} ok

Hmm..! Goldbach seems to be right...

The first failure is 174.

{ 3 200 | prime } zdup set+ cr zet.
{6,8,10,12,14,16,18,20,22,24,26,28,30,32,34,36,38,40,42,44,46,48,50,52,54,56,58,60,62,64,66,68,70,72,74,76,78,80,82,84,86,88,90,92,94,96,98,100,102,104,106,108,110,112,114,116,118,120,122,124,126,128,130,132,134,136,138,140,142,144,146,148,150,152,154,156,158,160,162,164,166,168,170,172,174,176,178,180,182,184,186,188,190,192,194,196,198,200,202,204,206,208,210,212,214,216,218,220,222,224,226,228,230,232,234,236,238,240,242,244,246,248,250,252,254,256,258,260,262,264,266,268,270,272,274,276,278,280,282,284,286,288,290,292,294,296,298,300,302,304,306,308,310,312,314,316,318,320,322,324,326,328,330,332,334,336,338,340,342,344,346,348,350,352,354,356,358,360,362,364,366,370,372,374,376,378,380,382,384,386,388,390,392,394,396,398} ok

First failure at 368.

{ 3 300 | prime } zdup set+ cr zet.
{6,8,10,12,14,16,18,20,22,24,26,28,30,32,34,36,38,40,42,44,46,48,50,52,54,56,58,60,62,64,66,68,70,72,74,76,78,80,82,84,86,88,90,92,94,96,98,100,102,104,106,108,110,112,114,116,118,120,122,124,126,128,130,132,134,136,138,140,142,144,146,148,150,152,154,156,158,160,162,164,166,168,170,172,174,176,178,180,182,184,186,188,190,192,194,196,198,200,202,204,206,208,210,212,214,216,218,220,222,224,226,228,230,232,234,236,238,240,242,244,246,248,250,252,254,256,258,260,262,264,266,268,270,272,274,276,278,280,282,284,286,288,290,292,294,296,298,300,302,304,306,308,310,312,314,316,318,320,322,324,326,328,330,332,334,336,338,340,342,344,346,348,350,352,354,356,358,360,362,364,366,368,370,372,374,376,378,380,382,384,386,388,390,392,394,396,398,400,402,404,406,408,410,412,414,416,418,420,422,424,426,428,430,432,434,436,438,440,442,444,446,448,450,452,454,456,458,460,462,464,466,468,470,472,474,476,478,480,482,484,486,488,490,492,494,496,498,500,502,504,506,508,510,512,514,516,518,520,522,524,526,528,532,534,538,540,542,544,546,548,550,552,554,556,558,560,562,564,566,570,574,576,586} ok

Fail(300)=530. The first failure is a kind of measure of the probability of Goldbachs conjecture to be true.

\ Is s a permutation subgroup of s'?
: psub? \ -- flag | s s' --
zover zswap subset 0=
if zdrop false exit
then permgroup? ;

\ Is s a normal permutation subgroup of s'?
: pnsub? \ -- flag | s s' --
zover zover psub? 0=
if zdrop zdrop false exit then
zswap zst yst setmove
begin zst@
while zsplit yzcopy1 zover prcoset
zswap yzcopy1 plcoset zet= 0=    \ false
if zdrop yst setdrop false exit then
repeat zdrop          \ dropping the empty set left in z
yst setdrop true ;

\ s' is the set of normal subgroups of s
: pnsubgroups \ s -- s'
zst yst setcopy
psubgroups
0 >xst
begin zst@
while zsplit zdup yzcopy1 pnsub?
if zfence xzmerge else zdrop then
repeat zdrop yst setdrop xst zst setmove ;

{ ( 4 1 2 3 ) ( 2 1 3 4 ) } generate zdup cardinality . 24  ok
pnsubgroups cr zet.
{{(2,1,3,4),(3,4,2,1),(3,1,4,2),(2,3,4,1),(1,4,2,3),(1,3,4,2),(1,2,3,4),(4,2,3,1),(4,1,2,3),(3,2,1,4),(4,1,3,2),(4,2,1,3),(4,3,1,2),(2,1,4,3),(2,3,1,4),(2,4,1,3),(3,1,2,4),(3,4,1,2),(3,2,4,1),(4,3,2,1),(2,4,3,1),(1,2,4,3),(1,3,2,4),(1,4,3,2)},{(4,3,2,1),(1,3,4,2),(1,2,3,4),(4,2,1,3),(3,1,2,4),(2,3,1,4),(2,4,3,1),(3,2,4,1),(1,4,2,3),(4,1,3,2),(2,1,4,3),(3,4,1,2)},{(4,3,2,1),(1,2,3,4),(3,4,1,2),(2,1,4,3)},{(1,2,3,4)}} ok

## Wednesday, March 2, 2016

### A simple implementation of permutation groups

I have big problems with groups. If you in GAP write

gap> s7 := Group ( (1, 2, 3, 4, 5, 6, 7), (1, 2) );

GAP immediately respond

Group([ (1,2,3,4,5,6,7), (1,2) ])

And if you then write

gap> Elements ( s7 );

GAP prints the list of all 7! elements of Sym(7) in a second or so.

In my simple implementation of permutation groups it takes about two seconds to generate Sym(5), and Sym(6) seems to be out of reach. The big discrepancy comes from that GAP has been developed at the universities for twenty years or so and that I so far has almost no knowledge of computational algebra.

In GAP a group is determined by its generators while in ZET it's determined by the set of permutations. To me it's interesting to examine subgroups of Sym(5) in this form, but it would also be interesting to try to make a more general and perhaps more efficient implementation later on.

In GAP i.e. (1,2,3,4) denotes a cycle but here the same vector will denote the identity permutation and the cycle in GAP would correspond to (2,3,4,1) here.

\ The number of permutations in a set of permutations
: ord \ -- n | s -- s
zst> zst> 2dup >zst >zst
cs 1+ swap cs swap / ;

\ The number of elements to be permuted in v
: numb \ -- n | v --
zst@ cs zdrop ;

\ j=v(i)
: pmaps \ i -- j | v --
zdrop cells zst @ + @ ;

\ composition of permutations as functions
: permcomp \ v1 v2 -- v1v2
( zst@ cs 1+ 1
do zover zover i pmaps pmaps
loop ) znip znip ;

\ generation of cyclic permutation group
: pgen \ v -- s
zst yst setcopy -1 1
do zdup yzcopy1 permcomp zdup yzcopy1 vector=
if numb 1+ i * 2* negate >zst leave then
loop yst setdrop ;

\ right coset
: prcoset \ s v -- s'
0 >xst
zst yst setmove
foreach
?do yzcopy1 permcomp zfence xzmerge
loop yst setdrop xst zst setmove ;

\ left coset
: plcoset \ v s -- s'
0 >xst
zswap zst yst setmove
foreach
?do yzcopy1 zswap permcomp zfence xzmerge
loop yst setdrop xst zst setmove ;

\ componentwise composition of permutation sets
: permset* \ -- | s1 s2 -- s3
0 >xst
zst yst setmove
foreach
?do yzcopy1 plcoset
xzmergered
loop yst setdrop
xst zst setmove ;

: permgroup? \ -- flag | s --
zdup zdup permset* zet= ;

\ Generation of standard permutations
: pidentity \ n -- | -- v
>r ( r> 1+ 1 ?do i loop ) ;

: pcirc \ n -- | -- v
>r ( r> dup 1 ?do i loop )  ;

: proll \ n -- | -- v
>r ( r@ 1- dup 1 do i loop r> ) ;

\ The number of element to be permuted in permutations in s
: perm# \ -- n | s -- s
zst> zst> tuck >zst >zst cs ;

\ Calculate the inverse permutation
: pinv \ v -- v'
do i dup 1- cells a2 + @ 1- cells a1 + ! loop znip ;

\ add the inverses to all permutations in s
: adinv \ s -- s'
0 >xst zdup xzmerge foreach
do pinv zfence xzmerge
loop xst zst setmove reduce ;

\ generates the group s' from the generators in s
: generate \ s -- s'
zst yst setcopy 0 >xst foreach
?do pgen xzmerge
loop xst zst setmove reduce 1
begin yzcopy1 zswap permset*
yzcopy1 permset* ord tuck =
until yst setdrop drop ;

\ generate set of groups s' from set of generators s
: multigen \ s -- s'
0 >xst foreach
?do generate zfence xzmerge
loop xst zst setmove reduce ;

\ Set of all subgroups to s
: psubgroups \ s -- s'
perm# pidentity zfence zfence
zst yst setmove foreach
do yst zst setmove zdup zrot multincl
multigen union zst yst setmove
loop yst zst setmove ;

{ ( 4 1 2 3 ) ( 2 1 3 4 ) } generate  ok
ord . 24  ok
psubgroups  ok
zdup  ok
cardinality . 30  ok
zet. {{(4,3,2,1),(1,2,3,4)},{(1,2,3,4)},{(1,3,4,2),(1,4,2,3),(1,2,3,4)},{(2,1,4,3),(1,2,3,4)},{(4,1,3,2),(2,4,3,1),(1,2,3,4)},{(3,4,1,2),(1,2,3,4)},{(4,3,2,1),(1,2,3,4),(3,4,1,2),(2,1,4,3)},{(3,1,2,4),(2,3,1,4),(1,2,3,4)},{(1,3,2,4),(1,2,3,4)},{(3,2,1,4),(1,2,3,4)},{(1,2,4,3),(1,2,3,4)},{(4,2,3,1),(1,2,3,4)},{(4,3,2,1),(1,2,3,4),(4,2,3,1),(1,3,2,4)},{(3,4,1,2),(1,2,3,4),(1,4,3,2),(3,2,1,4)},{(1,3,4,2),(1,4,2,3),(1,2,3,4),(1,4,3,2),(1,2,4,3),(1,3,2,4)},{(1,4,3,2),(1,2,3,4)},{(4,3,1,2),(2,1,4,3),(3,4,2,1),(1,2,3,4)},{(1,2,4,3),(1,2,3,4),(3,2,1,4),(4,2,1,3),(3,2,4,1),(4,2,3,1)},{(4,3,2,1),(1,3,4,2),(1,2,3,4),(4,2,1,3),(3,1,2,4),(2,3,1,4),(2,4,3,1),(3,2,4,1),(1,4,2,3),(4,1,3,2),(2,1,4,3),(3,4,1,2)},{(3,2,4,1),(4,2,1,3),(1,2,3,4)},{(3,1,4,2),(3,4,1,2),(1,3,2,4),(1,2,3,4),(2,1,4,3),(4,3,2,1),(2,4,1,3),(4,2,3,1)},{(2,4,1,3),(3,1,4,2),(4,3,2,1),(1,2,3,4)},{(3,1,2,4),(2,3,1,4),(1,2,3,4),(2,1,3,4),(1,3,2,4),(3,2,1,4)},{(4,1,3,2),(2,4,3,1),(1,2,3,4),(2,1,3,4),(1,4,3,2),(4,2,3,1)},{(2,1,4,3),(1,2,3,4),(2,1,3,4),(1,2,4,3)},{(2,1,3,4),(1,2,3,4)},{(4,3,2,1),(1,2,3,4),(2,1,3,4),(3,4,2,1),(1,2,4,3),(4,3,1,2),(3,4,1,2),(2,1,4,3)},{(2,1,3,4),(3,4,2,1),(3,1,4,2),(2,3,4,1),(1,4,2,3),(1,3,4,2),(1,2,3,4),(4,2,3,1),(4,1,2,3),(3,2,1,4),(4,1,3,2),(4,2,1,3),(4,3,1,2),(2,1,4,3),(2,3,1,4),(2,4,1,3),(3,1,2,4),(3,4,1,2),(3,2,4,1),(4,3,2,1),(2,4,3,1),(1,2,4,3),(1,3,2,4),(1,4,3,2)},{(4,1,2,3),(3,4,1,2),(2,3,4,1),(1,2,3,4)},{(4,1,2,3),(2,1,4,3),(3,2,1,4),(1,2,3,4),(4,3,2,1),(3,4,1,2),(2,3,4,1),(1,4,3,2)}} ok

My purpose with the nested sets was to investigate the possibility of simple dynamic data structures without the need of garbage collection. The stacks are administrated as usual and rest data on the stacks comes from faulty programming. So in a way the word q, that resets the stacks in case of error (manually now, but should be automatic), and the word drop, replace the garbage collection systems used in traditional programming with dynamic data. Except from with the present primitive implementation of groups it turned out to be surprisingly efficient.