# The code in this file was used to construct the examples used
# in the conference paper "Algorithmic use of the Mal'cev correspondence"
#
#
#
LoadPackage( "nq" );
#############################################################################
#
# Code for the computation of polycyclic presentations of triangular
# matrix groups over a maximal order of a number field
#
#############################################################################
FindNonZeroEntry := function ( mat )
# only for unipotent matrices with one non-zero entry
local n,i,j;
n := Length( mat );
for i in [1..n-1] do
for j in [i+1..n] do
if mat[i][j] <> 0 then
return [[i,j],mat[i][j]];
fi;
od;
od;
return fail;
end;
DetermineRelationsD := function( col, U_O, dim )
local o,r,i,gens;
gens := GeneratorsOfGroup( U_O );
# order of fundamental unit
o := Order( gens[1] );
r := Length( gens );
# set power relation of torsion unit
for i in [0..dim-1] do
SetRelativeOrder( col, 1+i*r, o );
od;
return;
end;
PositionsUnipotentGens := function( pos, n, dim, noD )
# pos = [i,j] specify a matrix entry
# n is the dimension of the maximal order
# dim is the dimension of the matrices
local i,j,weight,sum,ll,k;
i := pos[1];
j := pos[2];
# number of subdiagonal
weight := j-i;
# number of "n-boxes" before the wanted subdiagonal
sum := Sum( [(dim-1 -weight +2) ..(dim-1)] );
ll := [];
for k in [1..n] do
Add( ll, sum*n + (i-1)*n + k );
od;
return ll + noD;
end;
UnipoMat2Word := function( mat, O, noD, noU )
# only for unipotent matrices with one non-zero entry
local n,dim, ent, coeff,pos,ll,word,i;
dim := Length( mat );
# dimension of maximal order
n := Length( O );
ent := FindNonZeroEntry( mat );
if ent = fail then return fail; fi;
coeff := Coefficients( O, ent[2] );
pos := ent[1];
# get the positions of the corresponding generators in the U(n,O)
ll := PositionsUnipotentGens( pos, n, dim, noD );
# construct the word
word := [];
for i in [1..n] do
if coeff[i] <> 0 then
Add( word, ll[i] );
Add( word, coeff[i] );
fi;
od;
return word;
end;
ConstructD := function( dim, U_O , F)
local ll, gens, r, i,j, mat;
ll := [];
gens := GeneratorsOfGroup( U_O );
r := Length( gens );
for i in [1..dim] do
for j in [1..r] do
mat := IdentityMat( dim, F );
mat[i][i] := gens[j];
Add( ll, mat );
od;
od;
return ll;
end;
ConstructU := function( dim, O, F )
local ll,w,i,mat,o;
ll := [];
for w in [1..(dim-1)] do
for i in [1..(dim-w)] do
for o in O do
mat := IdentityMat( dim, F );
mat[i][i+w] := o;
Add( ll, mat );
od;
od;
od;
return ll;
end;
DetermineRelationsDonU := function( gensTr, noD,noU,col,O )
local i,d,j,u,mat,word;
for i in [1..noD] do
d := gensTr[i];
for j in [noD+1..noD+noU] do
u := gensTr[j];
mat := u^d;
word := UnipoMat2Word( mat, O, noD, noU );
#Print( "i ", i, " j ", j , " word ", word, "\n");
SetConjugate( col, j, i, word );
# also inverse
mat := u^(d^-1);
word := UnipoMat2Word( mat, O, noD, noU );
#Print( "i ", i, " j ", j , " word ", word, "\n");
SetConjugate( col, j, i, word );
od;
od;
end;
DetermineRelationsU := function( gensTr, noD,noU,col,O )
local i,u1,j,u2,mat,word, word2;
for i in [noD+1..(noD+noU)] do
u1 := gensTr[i];
for j in [i+1..noD+noU] do
u2 := gensTr[j];
mat := Comm( u2, u1 );
#Display( mat );
word := UnipoMat2Word( mat, O, noD, noU );
#Print( "i ", i, " j ", j , " word ", word, "\n");
if not word = fail then
word2 := [j,1];
Append( word2, word );
SetConjugate( col, j, i, word2 );
fi;
# also inverse
mat := Comm( u2,(u1^-1));
#Display( mat );
word := UnipoMat2Word( mat, O, noD, noU );
#Print( "i ", i, " j ", j , " word ", word, "\n");
if not word = fail then
word2 := [j,1];
Append( word2, word );
SetConjugate( col, j, i, word2 );
fi;
od;
od;
end;
PresentTriang := function( dim, pol )
local F,O,U_O,isoU_O,n,r,noD,noU,col,D,U,gensTr;
# setup
F := FieldByPolynomial( pol );
O := MaximalOrderBasis( F );
U_O := UnitGroup( F );
#isoU_O := IsomorphismPcpGroup( U_O );
# dimension of maximal order
n := Length( O );
# number fundamental units plus 1 (torsion unit)
r := Length( GeneratorsOfGroup( U_O ) );
# number of gens of D and U
noD := r*dim;
noU := n*((dim-1)*dim)/2;
# get collector
col := FromTheLeftCollector( noD + noU );
# determine relations wihtin the elements of D
DetermineRelationsD( col, U_O, dim );
D := ConstructD( dim, U_O , F);
U := ConstructU( dim, O, F );
gensTr := [];
Append( gensTr, D );
Append( gensTr, U );
# determine the relations of D action on U
DetermineRelationsDonU( gensTr, noD,noU,col,O );
# determine conjugation relations in U
DetermineRelationsU( gensTr, noD,noU,col,O );
UpdatePolycyclicCollector( col );
return rec( Tr := PcpGroupByCollector( col ), noD := noD );
end;
#############################################################################
#
ExamplesOfSomeTGroups := function()
local G, FF, F,n;
n := 10;
G := List( [1..n], x-> ExamplesOfSomePcpGroups(x) );
FF := List( G, FittingSubgroup );
F := List( [1..n], x-> PcpGroupByPcp( Pcp( FF[x] ) ) );
List( F, IsNilpotent );
return rec( G := G, FF := FF, F := F );
end;
#############################################################################
#
# IN F_nc ..... free nilpotent group on n gens and class c
#
SC_GetSomeAutomorphsimOfF_nc := function( F_nc, n )
local F,A,gensA,gensN,k,auts,ll,gensF,imgs,g,beta,i,aut;
# get automorphsim induced from free group
F := FreeGroup( n );
gensF := GeneratorsOfGroup( F );
A := AutomorphismGroup( F );
gensA := GeneratorsOfGroup( A );
gensN := Pcp( F_nc );
k := Length( gensA );
auts := [];
for i in [1..k] do
aut := gensA[i];
ll := List( gensF, x->x^aut );
imgs := List( ll, x -> MappedWord( x, gensF, gensN{[1..n]} ) );
Add( auts, GroupHomomorphismByImagesNC(F_nc,F_nc,gensN{[1..n]},imgs ));
od;
# get automorphism of Bryant
g := gensN[1]*Comm( Comm( gensN[1], gensN[2] ), gensN[1] );
beta := GroupHomomorphismByImagesNC( F_nc,F_nc,gensN{[1,2]}, [g,gensN[2]]);
Add( auts, beta );
return auts;
end;
#############################################################################
# IN: N ..... T-group given by a finite presentation
# auts... List Automorphisms of N, where <auts> is abelian
#
# OUT: polycyclic presentation of the semidirect product H \rhd N
# where H is a free abelian group with Length(auts) generators, which
# acts like auts on N
#
SC_TGroupByAbelianGroup := function( N, auts )
local n,m,l,coll,pcpN,exp1,i,j,con,exp,exp2,genList,g;
#get collector
n := HirschLength( N );
m := Length( auts );
l := m+n;
coll := FromTheLeftCollector( l );
# define conjugation relations within N, g_i^g_j
pcpN := Pcp( N );
exp1 := List( [1..m], x-> 0 );
for i in [2..n] do
for j in [1..(i-1)] do
# compute g_i^g_j
con := pcpN[i]^pcpN[j];
exp2 := Exponents( con );
exp := Concatenation( exp1, exp2 );
genList:=POL_Exp2GenList(exp);
SetConjugate( coll, i+m, j+m, genList);
# compute g_i^(g_j^-1)
con := pcpN[i]^(pcpN[j]^-1);
exp2 := Exponents( con );
exp := Concatenation( exp1, exp2 );
genList:=POL_Exp2GenList(exp);
SetConjugate( coll, i+m, -(j+m), genList);
od;
od;
#define relations coming from the action of H on N
for j in [1..m] do
for i in [1..n] do
#action of g_j on g_{i+m}
g := pcpN[i]^(auts[j]);
exp2 := Exponents( g );
exp := Concatenation( exp1, exp2 );
genList:=POL_Exp2GenList(exp);
SetConjugate( coll, i+m, j, genList);
#action of g_j^-1 onf g_{i+m}
g := pcpN[i]^(auts[j]^-1);
exp2 := Exponents( g );
exp := Concatenation( exp1, exp2 );
genList:=POL_Exp2GenList(exp);
SetConjugate( coll, i+m, -j, genList);
od;
od;
UpdatePolycyclicCollector( coll);
return PcpGroupByCollector( coll );
end;
SC_Exams_Help1 := function( R )
local G,m,ll,N;
G := R.Tr;
m := Length( Pcp(G) );
ll := [R.noD+1..m];
N := Subgroup( G, Pcp(G){ll} );
return rec( G := G, N := N );
end;
#TODO: look at examples coming from Polenta.
#############################################################################
#
# Examples of some nilpotent-by-abelian groups
#
#
SC_Exams := function( n )
local x,pol,R,G,m,ll,N,n1,n2,N2,F,F_nc,hl,auts,T,a;
x := Indeterminate( Rationals );
# first 8 groups as in paper
if n=1 then
pol := x^2-3;
R := PresentTriang( 3, pol );
return SC_Exams_Help1( R );
fi;
if n=2 then
pol := x^2-3;
R := PresentTriang( 4, pol );
return SC_Exams_Help1( R );
fi;
if n=3 then
pol := x^2-3;
R := PresentTriang( 5, pol );
return SC_Exams_Help1( R );
fi;
if n=4 then
pol := x^3 - x^2 + 4;
R := PresentTriang( 3, pol );
return SC_Exams_Help1( R );
fi;
if n=5 then
pol := x^3 - x^2 + 4;
R := PresentTriang( 4, pol );
return SC_Exams_Help1( R );
fi;
#if n=6 then
# pol := x^3 - x^2 + 4;
# R := PresentTriang( 5, pol );
# return SC_Exams_Help1( R );
#fi;
if n=6 then
m := 2;
F := FreeGroup( m );
F_nc := NilpotentQuotient( F, 4 );
hl := HirschLength( F_nc );
auts := SC_GetSomeAutomorphsimOfF_nc( F_nc, m );
a := auts[1]*auts[2]*auts[3]^3;
G := SC_TGroupByAbelianGroup( F_nc, [a] );
N := Subgroup( G, Pcp(G){[2..hl+1]} );
T := rec( G := G, N := N );
return T;
fi;
if n=7 then
m := 2;
F := FreeGroup( m );
F_nc := NilpotentQuotient( F, 5 );
hl := HirschLength( F_nc );
auts := SC_GetSomeAutomorphsimOfF_nc( F_nc, m );
a := auts[1]*auts[2]*auts[3]^3;
G := SC_TGroupByAbelianGroup( F_nc, [a] );
N := Subgroup( G, Pcp(G){[2..hl+1]} );
T := rec( G := G, N := N );
return T;
fi;
if n=8 then
m := 3;
F := FreeGroup( m );
F_nc := NilpotentQuotient( F, 4 );
hl := HirschLength( F_nc );
auts := SC_GetSomeAutomorphsimOfF_nc( F_nc, m );
a := auts[1]*auts[3]^3;
G := SC_TGroupByAbelianGroup( F_nc, [a] );
N := Subgroup( G, Pcp(G){[2..hl+1]} );
T := rec( G := G, N := N );
return T;
fi;
############################################################33
if n=11 then
pol := x^3 - x^2 + 4;
R := PresentTriang( 4, pol );
return SC_Exams_Help1( R );
fi;
if n=12 then
pol := x^3 - x^2 + 4;
R := PresentTriang( 3, pol );
G := R.Tr;
m := Length( Pcp(G) );
ll := [R.noD+1..m];
N := Subgroup( G, Pcp(G){ll} );
n1 := Pcp(N)[2]*Pcp(N)[4];
n2 := Pcp(N)[5]*Pcp(N)[1]^-1;
N2 := NormalClosure( G, Subgroup( G, [n1,n2]) );
return rec( G := G, N := N2 );
fi;
if n=13 then
pol := x^7-x^6+x^5-x^4-3*x^3+3*x^2-2*x+1;
R := PresentTriang( 3, pol );
return SC_Exams_Help1( R );
fi;
if n=14 then
pol := x^3 - x^2 + 4;
R := PresentTriang( 4, pol );
return SC_Exams_Help1( R );
fi;
if n=15 then
pol := x^3 - x^2 + 4;
R := PresentTriang( 4, pol );
G := R.Tr;
m := Length( Pcp(G) );
ll := [R.noD+1..m];
N := Subgroup( G, Pcp(G){ll} );
n1 := Pcp(N)[2]*Pcp(N)[5]*Pcp(N)[13]^-1;
n2 := Pcp(N)[3]*Pcp(N)[7]*Pcp(N)[11]^-1;
N2 := NormalClosure( G, Subgroup( G, [n1,n2]) );
return rec( G := G, N := N2 );
fi;
if n = 11 then
pol := x^2 -3;
R := PresentTriang( 5, pol );
return SC_Exams_Help1( R );
fi;
if n = 21 then
m := 2;
F := FreeGroup( m );
F_nc := NilpotentQuotient( F, 5 );
hl := HirschLength( F_nc );
auts := SC_GetSomeAutomorphsimOfF_nc( F_nc, 2 );
a := auts[1]*auts[2]*auts[3]^3;
G := SC_TGroupByAbelianGroup( F_nc, [a] );
N := Subgroup( G, Pcp(G){[2..hl+1]} );
T := rec( G := G, N := N );
return T;
fi;
if n = 29 then
# the calculation of the presentation needs 3000 sec.
# Dimension = 34
F := FreeGroup( 2 );
return NilpotentQuotient( F, 6 );
fi;
if n in [-10..-1] then
G := ExamplesOfSomePcpGroups(-n);
N := FittingSubgroup( G );
return rec( G := G, N := N );
fi;
if n = -11 then
G := ExamplesOfSomePcpGroups(13);
N := FittingSubgroup( G );
return rec( G := G, N := N );
fi;
end;
#g1 := SC_RandomPcpElement( T.G, 10 );
#g2 := SC_RandomPcpElement( T.G, 10 );
#g1 := SC_RandomPcpElement( FCR.GG, 10 );
#g2 := SC_RandomPcpElement( FCR.GG, 10 );
# T := SC_Exams( 2 );
#FCR := MAT_FastConjugationRec( T.G, T.N );
#n := Random( FCR.NN );
#n := SC_RandomPcpElement( FCR.NN, 10 );
#g := FCR.factorGens[1];
#c := g^100;
#n^c;
#MAT_FastConjugation( FCR, n, c );
#ExponentsByPcp( FCR.pcpNN, n^c );
SC_Exams_Help2 := function( dim, pol )
local R,G,N,pcp,N2,phi,m,ll;
R := PresentTriang( dim, pol );
G := R.Tr;
m := Length( Pcp(G) );
ll := [R.noD+1..m];
N := Subgroup( G, Pcp(G){ll} );
pcp := Pcp( N );
N2 := PcpGroupByPcp( pcp );
IsNilpotent( N2 );
return N2;
end;
#############################################################################
#
# IN: n_fac ..... no. of gens of G/N
# n_N ..... no. of gens of N
# aver ...... bound on absolut value of exponents
# (measure how hard the group is )
#
# OUT: Produces a random pc presentation of a group where the
# tail of the generators generates a normal T-group
# G > N > 1
SC_ProduceRandomPcGroup := function( n_fac, n_N, aver1, aver2 )
local n,coll,l1,l2,i,j,exp1,exp2,exp3,exp4,exp,genList;
# get collector
n := n_fac + n_N;
coll := FromTheLeftCollector( n );
# produce list which is the domain of random exponents
l1 := [-aver1..aver1];
l2 := [-aver2..aver2];
# define relations within nilpotent N g_i^g_j
exp1 := List( [1..n_fac], x-> 0 );
for i in [2..n_N] do
for j in [1..(i-1)] do
exp2 := List( [1..(i-1)], x->0 );
exp3 := [1];
exp4 := List( [i+1..n_N], x->RandomList( l1 ) );
exp := Concatenation( exp1, exp2, exp3, exp4 );
genList:=POL_Exp2GenList(exp);
SetConjugate( coll, i+n_fac, j+n_fac, genList);
od;
od;
# define relations coming from the action of G/N on N
#for j in [1..n_fac] do
# for i in [1..n_N] do
# #action of g_j on g_{i+n_fac}\
# exp2 := List( [1..n_N], x-> RandomList( l2 ) );
# exp := Concatenation( exp1, exp2 );
# genList:=POL_Exp2GenList(exp);
# SetConjugate( coll, i+n_fac, j, genList);
# od;
#od;
# define relations coming from the gens within G/N
UpdatePolycyclicCollector( coll);
return PcpGroupByCollector( coll );
end;
#############################################################################
# Code for the computation of automorphism of the free nilpotent group
DrumHerum := function()
local n,F,gensF,A,gensA,N,NN,gensNN,aut,ll,imgs,psi,gensN,psi2,g,beta;
n := 2;
F := FreeGroup( n );
gensF := GeneratorsOfGroup( F );
A := AutomorphismGroup( F );
gensA := GeneratorsOfGroup( A );
N := NilpotentQuotient( F, 4 );
gensN := GeneratorsOfGroup( N );
#NN := Subgroup( N, gensN{[1..n]} );
#gensNN := GeneratorsOfGroup( NN );
#choose automorphism of F
aut := gensA[2];
ll := List( gensF, x->x^aut );
imgs := List( ll, x -> MappedWord( x, gensF, gensN{[1,2]} ) );
#psi := GroupHomomorphismByImagesNC( NN, NN, gensNN, imgs );
# geht noch einfacher !
#GroupHomomorphismByImagesNC( N, N, gensNN, imgs );
#GroupHomomorphismByImagesNC( N, N, gensN{[1,2]}, imgs );
psi2 := GroupHomomorphismByImagesNC( N, N, gensN{[1,2]}, imgs );
g := gensN[1]*Comm( Comm( gensN[1], gensN[2] ), gensN[1] );
beta := GroupHomomorphismByImagesNC( N, N, gensN{[1,2]}, [g, gensN[2]] );
end;
SC_OrbitStabilizerOnRightMod := function (G,erzs, x, length)
local erzsF,n,k, bahn, stab, tran,tranF, g,gF,F,i, y, w, j;
#erzs := ShallowCopy (GeneratorsOfGroup (G));
n := Length( erzs );
F := FreeGroup( n );
erzsF := ShallowCopy (GeneratorsOfGroup( F ));
Append (erzs, List (erzs, x -> x^-1));
Append (erzsF, List (erzsF, x -> x^-1));
bahn := [x];
stab := [];
tran := [One (G)];
tranF := [One(F)];
i := 1;
while i <= Length (bahn) and Length(bahn) <= length do
y := bahn[i];
#for g in erzs do
for k in [1..Length(erzs)] do
g := erzs[k];
gF := erzsF[k];
w := y*g;
j := Position (bahn, w);
if j = fail then
Add (bahn, w);
Add (tran, tran[i]*g);
Add (tranF, tranF[i]*gF);
else
AddSet (stab, tran[i]*g/tran[j]);
fi;
od;
i := i + 1;
od;
return rec (bahn := bahn, stab := Subgroup (G, stab),
tran := tran, tranF := tranF);
end;
# F is a free group of rank k
# G is a free nilpotent group of rank
# x is an element of G which I want to express a word in the original
# generators
SC_ExpressAsWord := function( F, G, x, length )
local b,i,k,gens;
k := Rank( F );
gens := GeneratorsOfGroup( G ){[1..k]};
b := SC_OrbitStabilizerOnRightMod(G, gens, One(G), length);
i := Position( b.bahn, x );
if i = fail then
return fail;
else
return b.tranF[i];
fi;
end;
SC_GetOrbitInfo := function( F, G, length )
local b,i,k,gens;
k := Rank( F );
gens := GeneratorsOfGroup( G ){[1..k]};
b := SC_OrbitStabilizerOnRightMod(G, gens, One(G), length);
return b;
end;
SC_ExpressAsWord2 := function( F, G, x, orbit )
local b,i,k,gens;
b := orbit;
i := Position( b.bahn, x );
if i = fail then
return fail;
else
return b.tranF[i];
fi;
end;
