, )
##
InstallGlobalFunction( IgsParallel, function( gens, pre )
return AddToIgsParallel( [], gens, [], pre );
end );
#############################################################################
##
## CgsParallel( , )
##
## parallel version of Cgs. Note: this function performes an
## induced pcs computation as well.
##
InstallGlobalFunction( CgsParallel, function( gens, pre )
local can, cann, i, f, e, j, l, d, r, s;
if Length( gens ) = 0 then return []; fi;
can := IgsParallel( gens, pre );
cann := can[2];
can := can[1];
# first norm leading coefficients
for i in [1..Length(can)] do
f := NormingExponent( can[i] );
can[i] := can[i]^f;
cann[i] := cann[i]^f;
od;
# reduce entries in matrix
for i in [1..Length(can)] do
e := LeadingExponent( can[i] );
r := Depth( can[i] );
for j in [1..i-1] do
l := Exponents( can[j] )[r];
if l > 0 then
d := QuoInt( l, e );
can[j] := can[j] * can[i]^-d;
cann[j] := cann[j] * cann[i]^-d;
elif l < 0 then
d := QuoInt( -l, e );
s := RemInt( -l, e );
if s = 0 then
can[j] := can[j] * can[i]^d;
cann[j] := cann[j] * cann[i]^d;
else
can[j] := can[j] * can[i]^(d+1);
cann[j] := cann[j] * cann[i]^(d+1);
fi;
fi;
od;
od;
return[ can, cann ];
end );
polycyclic-2.16/gap/basic/construct.gi 0000644 0000766 0000024 00000015121 13706672341 017031 0 ustar mhorn staff #############################################################################
##
#W construct.gi Polycyclic Max Horn
##
#############################################################################
##
#M TrivialGroupCons( )
##
InstallMethod( TrivialGroupCons,
"pcp group",
[ IsPcpGroup and IsFinite ],
function( filter )
return PcpGroupByCollectorNC( FromTheLeftCollector( 0 ) );
end );
#############################################################################
##
#M AbelianGroupCons( , )
##
InstallMethod( AbelianGroupCons,
"pcp group",
[ IsPcpGroup, IsList ],
function( filter, ints )
local coll, i, n, r, grp;
if not ForAll( ints, IsInt ) then
Error( " must be a list of integers" );
fi;
# We allow 0, and interpret it as indicating an infinite factor.
if not ForAll( ints, x -> 0 <= x ) then
TryNextMethod();
fi;
n := Length(ints);
r := ints;
# construct group
coll := FromTheLeftCollector( n );
for i in [1..n] do
if IsBound( r[i] ) and r[i] > 0 then
SetRelativeOrder( coll, i, r[i] );
fi;
od;
UpdatePolycyclicCollector(coll);
grp := PcpGroupByCollectorNC( coll );
SetIsAbelian( grp, true );
return grp;
end );
#############################################################################
##
#M ElementaryAbelianGroupCons( , )
##
InstallMethod( ElementaryAbelianGroupCons,
"pcp group",
[ IsPcpGroup and IsFinite, IsPosInt ],
function(filter,size)
local grp;
if size = 1 or IsPrimePowerInt( size ) then
grp := AbelianGroup( filter, Factors(size) );
else
Error( " must be a prime power" );
fi;
SetIsElementaryAbelian( grp, true );
return grp;
end);
#############################################################################
##
#M FreeAbelianGroupCons( , )
##
if IsBound(FreeAbelianGroupCons) then
InstallMethod( FreeAbelianGroupCons,
"pcp group",
[ IsPcpGroup, IsInt and IsPosRat ],
function( filter, rank )
local coll, grp;
# construct group
coll := FromTheLeftCollector( rank );
UpdatePolycyclicCollector( coll );
grp := PcpGroupByCollectorNC( coll );
SetIsFreeAbelian( grp, true );
return grp;
end );
fi;
#############################################################################
##
#M CyclicGroupCons( , )
##
InstallMethod( CyclicGroupCons,
"pcp group",
[ IsPcpGroup and IsFinite, IsPosInt ],
function( filter, n )
local coll, grp;
# construct group
coll := FromTheLeftCollector( 1 );
SetRelativeOrder( coll, 1, n );
UpdatePolycyclicCollector(coll);
grp := PcpGroupByCollectorNC( coll );
if n > 1 then
SetMinimalGeneratingSet(grp, [grp.1]);
else
SetMinimalGeneratingSet(grp, []);
fi;
return grp;
end );
#############################################################################
##
#M CyclicGroupCons( , infinity )
##
InstallOtherMethod( CyclicGroupCons,
"pcp group",
[ IsPcpGroup, IsInfinity ],
function( filter, n )
local coll, grp;
# construct group
coll := FromTheLeftCollector( 1 );
UpdatePolycyclicCollector(coll);
grp := PcpGroupByCollectorNC( coll );
SetMinimalGeneratingSet(grp, [grp.1]);
return grp;
end );
#############################################################################
##
#M DihedralGroupCons( , )
##
InstallMethod( DihedralGroupCons,
"pcp group",
[ IsPcpGroup and IsFinite, IsPosInt ],
function( filter, n )
local coll, grp;
if n mod 2 = 1 then
TryNextMethod();
elif n = 2 then
return CyclicGroup( filter, 2 );
fi;
coll := FromTheLeftCollector( 2 );
SetRelativeOrder( coll, 1, 2 );
SetRelativeOrder( coll, 2, n/2 );
SetConjugate( coll, 2, 1, [2,n/2-1] );
UpdatePolycyclicCollector(coll);
grp := PcpGroupByCollectorNC( coll );
return grp;
end );
#############################################################################
##
#M DihedralGroupCons( , infinity )
##
InstallOtherMethod( DihedralGroupCons,
"pcp group",
[ IsPcpGroup, IsInfinity ],
function( filter, n )
local coll, grp;
coll := FromTheLeftCollector( 2 );
SetRelativeOrder( coll, 1, 2 );
SetConjugate( coll, 2, 1, [2,-1] );
SetConjugate( coll, 2, -1, [2,-1] );
UpdatePolycyclicCollector(coll);
grp := PcpGroupByCollectorNC( coll );
return grp;
end );
#############################################################################
##
#M QuaternionGroupCons( , )
##
InstallMethod( QuaternionGroupCons,
"pcp group",
[ IsPcpGroup and IsFinite, IsPosInt ],
function( filter, n )
local coll, grp;
if 0 <> n mod 4 then
TryNextMethod();
elif n = 4 then return
CyclicGroup( filter, 4 );
fi;
coll := FromTheLeftCollector( 2 );
SetRelativeOrder( coll, 1, 2 );
SetRelativeOrder( coll, 2, n/2 );
SetPower( coll, 1, [2, n/4] );
SetConjugate( coll, 2, 1, [2,n/2-1] );
UpdatePolycyclicCollector(coll);
grp := PcpGroupByCollectorNC( coll );
return grp;
end );
#############################################################################
##
#M ExtraspecialGroupCons( , , )
##
InstallMethod( ExtraspecialGroupCons,
"pcp group",
[ IsPcpGroup and IsFinite,
IsInt,
IsObject ],
function( filters, order, exp )
local G;
G := ExtraspecialGroupCons( IsPcGroup and IsFinite, order, exp );
return PcGroupToPcpGroup( G );
end );
#############################################################################
##
#M AlternatingGroupCons( , )
##
InstallMethod( AlternatingGroupCons,
"pcp group with degree",
[ IsPcpGroup and IsFinite,
IsPosInt ],
function( filter, deg )
local alt;
if 4 < deg then
Error( " must be at most 4" );
fi;
alt := AlternatingGroupCons(IsPcGroup and IsFinite,deg);
alt := PcGroupToPcpGroup(alt);
SetIsAlternatingGroup( alt, true );
return alt;
end );
#############################################################################
##
#M SymmetricGroupCons( , )
##
InstallMethod( SymmetricGroupCons,
"pcp group with degree",
[ IsPcpGroup and IsFinite,
IsPosInt ],
function( filter, deg )
local sym;
if 4 < deg then
Error( " must be at most 4" );
fi;
sym := SymmetricGroupCons(IsPcGroup and IsFinite,deg);
sym := PcGroupToPcpGroup(sym);
SetIsSymmetricGroup( sym, true );
return sym;
end );
polycyclic-2.16/gap/basic/pcppcps.gd 0000644 0000766 0000024 00000003176 13706672341 016457 0 ustar mhorn staff #############################################################################
##
#W pcppcgs.gd Polycyc Bettina Eick
##
#############################################################################
##
## induced and canonical generating sets + parallel versions
##
DeclareGlobalFunction( "AddToIgs" );
DeclareGlobalFunction( "AddToIgsParallel" );
DeclareGlobalFunction( "IgsParallel" );
DeclareGlobalFunction( "CgsParallel" );
#############################################################################
##
## Introduce the category and representation of Pcp's
##
DeclareCategory( "IsPcp", IsObject );
DeclareRepresentation( "IsPcpRep",
IsComponentObjectRep,
["gens", "rels", "denom", "numer", "one", "group" ] );
#############################################################################
##
## Create their family and their type
##
BindGlobal( "PcpFamily", NewFamily( "PcpFamily", IsPcp, IsPcp ) );
BindGlobal( "PcpType", NewType( PcpFamily, IsPcpRep ) );
#############################################################################
##
## Basic attributes and properties
##
DeclareGlobalFunction( "GeneratorsOfPcp" );
DeclareGlobalFunction( "RelativeOrdersOfPcp" );
DeclareGlobalFunction( "DenominatorOfPcp" );
DeclareGlobalFunction( "NumeratorOfPcp" );
DeclareGlobalFunction( "GroupOfPcp" );
DeclareGlobalFunction( "OneOfPcp" );
DeclareGlobalFunction( "IsSNFPcp" );
DeclareGlobalFunction( "IsTailPcp" );
#############################################################################
##
## The main function to create an pcp
##
DeclareGlobalFunction( "Pcp" );
polycyclic-2.16/gap/basic/orbstab.gi 0000644 0000766 0000024 00000017420 13706672341 016445 0 ustar mhorn staff #############################################################################
##
#W orbstab.gi Polycyc Bettina Eick
#W Werner Nickel
##
#############################################################################
##
#F TransversalInverse( j, trels )
##
TransversalInverse := function( j, trels )
local l, w, s, p, t;
l := Product( trels );
j := j - 1;
w := [];
for s in Reversed( [1..Length( trels )] ) do
p := trels[s];
l := l/p;
t := QuoInt( j, l );
j := RemInt( j, l );
if t > 0 then Add( w, [s,t] ); fi;
od;
return w;
end;
#############################################################################
##
#F SubsWord( word, list )
##
SubsWord := function( word, list )
local g, w;
g := list[1]^0;
for w in word do
g := g * list[w[1]]^w[2];
od;
return g;
end;
#############################################################################
##
#F TransversalElement( j, stab, id )
##
TransversalElement := function( j, stab, id )
local t;
if Length( stab.trels ) = 0 then return id; fi;
t := TransversalInverse(j, stab.trels);
return SubsWord( t, stab.trans )^-1;
end;
#############################################################################
##
#F Translate( word, t )
##
Translate := function( word, t )
return List( word, x -> [t[x[1]], -x[2]] );
end;
#############################################################################
##
#F PcpOrbitStabilizer( e, pcp, act, op )
##
## Warning: this function runs forever, if the orbit is infinite!
##
# FIXME: This function is documented and should be turned into a GlobalFunction
PcpOrbitStabilizer := function( e, pcp, act, op )
local rels, orbit, dict, trans, trels, tword, stab, word, w, i, f, j, n, t, s, k;
# check relative orders
if IsList( pcp ) then
rels := List( pcp, x -> 0 );
else
rels := RelativeOrdersOfPcp( pcp );
fi;
# set up
orbit := [e];
dict := NewDictionary(e, true);
AddDictionary(dict, e, 1);
trans := [];
trels := [];
tword := [];
stab := [];
word := [];
# construct orbit and stabilizer
for i in Reversed( [1..Length(pcp)] ) do
# get new point
f := op( e, act[i] );
j := LookupDictionary( dict, f );
# if it is new, add all blocks
n := orbit;
t := [];
s := 1;
while IsBool( j ) do
n := List( n, x -> op( x, act[i] ) );
Append( t, n );
j := LookupDictionary( dict, op( n[1], act[i] ) );
s := s + 1;
od;
# add to orbit
for k in [1..Length(t)] do
AddDictionary( dict, t[k], Length(orbit) + k );
od;
Append( orbit, t );
# add to transversal
if s > 1 then
Add( trans, pcp[i]^-1 );
Add( trels, s );
Add( tword, i );
fi;
# compute stabiliser element
if rels[i] = 0 or s < rels[i] then
if j = 1 then
Add( stab, pcp[i]^s );
Add( word, [[i,s]] );
else
t := TransversalInverse(j, trels);
Add( stab, pcp[i]^s * SubsWord( t, trans ) );
Add( word, Concatenation( [[i,s]], Translate( t, tword )));
fi;
fi;
od;
# return orbit and stabilizer
return rec( orbit := orbit,
trels := trels,
trans := trans,
stab := Reversed(stab),
word := Reversed(word) );
end;
#############################################################################
##
#F PcpOrbitsStabilizers( dom, pcp, act, op )
##
## dom is the operation domain
## pcp is a igs or pcp of a group
## act is the action corresponding to pcp
## op is the operation of act on dom
##
## The function returns a list of records - one for each orbit. Each record
## contains a representative and an igs of the stabilizer.
##
## Warning: this function runs forever, if one of the orbits is infinite!
##
# FIXME: This function is documented and should be turned into a GlobalFunction
PcpOrbitsStabilizers := function( dom, pcp, act, op )
local todo, orbs, e, o;
todo := [1..Length(dom)];
orbs := [];
while Length( todo ) > 0 do
e := dom[todo[1]];
o := PcpOrbitStabilizer( e, pcp, act, op );
Add( orbs, rec( repr := o.orbit[1],
leng := Length(o.orbit),
stab := o.stab,
word := o.word ) );
todo := Difference( todo, List( o.orbit, x -> Position(dom,x)));
od;
return orbs;
end;
#############################################################################
##
#F RandomPcpOrbitStabilizer( e, pcp, act, op )
##
RandomPcpOrbitStabilizer := function( e, pcp, act, op )
local one, acts, gens, O, dict, T, S, count, i, j, t, g, im, index, l, s;
# a trivial check
if Length( pcp ) = 0 then return rec( orbit := [e], stab := pcp ); fi;
# generators and inverses
acts := Concatenation( AsList( act ), List( act, g -> g^-1 ) );
gens := Concatenation( AsList( pcp ), List( pcp, g -> g^-1 ) );
one := gens[1]^0;
# set up
O := [ e ]; # orbit
dict := NewDictionary(e, true);
AddDictionary(dict, e, 1);
T := [ one ]; # transversal
S := []; # stabilizer
# set counter
count := 0;
i := 1;
while i <= Length(O) do
e := O[ i ];
t := T[ i ];
for j in [1..Length(gens)] do
im := op( e, acts[j] );
index := LookupDictionary( dict, im );
if index = fail then
Add( O, im );
AddDictionary( dict, im, Length(O) );
Add( T, t * gens[j] );
if Length(O) > 500 then
Print( "#I Orbit longer than limit: exiting.\n" );
return rec( orbit := O, stab := S );
fi;
else
l := Length( S );
s := t * gens[j] * T[ index ]^-1;
if s <> one then
S := AddToIgs( S, [s] );
if l = Length(S) then
count := count + 1;
else
count := 0;
fi;
if count > 100 then
Print( "#I Stabilizer not increasing: exiting.\n" );
return rec( orbit := O, stab := S );
fi;
fi;
fi;
od;
i := i+1;
od;
Print( "#I Orbit calculation complete.\n" );
return rec( orbit := O, stab := S );
end;
#############################################################################
##
#F RandomCentralizerPcpGroup( G, g )
##
# FIXME: This function is documented and should be turned into a GlobalFunction
RandomCentralizerPcpGroup := function( G, g )
local gens, stab, h;
gens := Igs( G );
if IsPcpElement( g ) then
stab := RandomPcpOrbitStabilizer( g, gens, gens, OnPoints ).stab;
elif IsSubgroup( G, g ) then
stab := ShallowCopy( gens );
for h in GeneratorsOfGroup( g ) do
stab := RandomPcpOrbitStabilizer( h, stab, stab, OnPoints ).stab;
od;
else
Print("g must be a subgroup or an element of G \n");
fi;
return Subgroup( G, stab );
end;
#############################################################################
##
#F RandomNormalizerPcpGroup( G, N )
##
# FIXME: This function is documented and should be turned into a GlobalFunction
RandomNormalizerPcpGroup := function( G, N )
local gens, stab;
gens := Igs(G);
stab := RandomPcpOrbitStabilizer( N, gens, gens, OnPoints);
return Subgroup( G, stab.stab );
end;
polycyclic-2.16/gap/basic/collect.gd 0000644 0000766 0000024 00000011274 13706672341 016432 0 ustar mhorn staff #############################################################################
##
#W collect.gd Polycyclic Werner Nickel
##
#############################################################################
##
## First we need a new representation for a power-conjugate collector, which
## will implement the generic collector for groups given by a polycyclic
## presentation.
##
#R IsFromTheLeftCollectorRep( )
##
DeclareRepresentation( "IsFromTheLeftCollectorRep",
IsPowerConjugateCollector, [] );
BindGlobal( "FromTheLeftCollectorFamily",
NewFamily( "FromTheLeftCollector", IsFromTheLeftCollectorRep ) );
#############################################################################
##
#P The following property is set if a collector presents a nilpotent group
## and has a weight array and a second commute array. . . . . . . . . . . .
##
DeclareProperty( "IsWeightedCollector", IsPolycyclicCollector );
#############################################################################
##
#P The following property is set if a collector presents a nilpotent group
## and has Hall polynomials (computed by Deep Thought)
##
DeclareProperty( "IsPolynomialCollector", IsFromTheLeftCollectorRep );
#############################################################################
##
#P The following property is used to dispatch between a GAP level collector
## and the kernel collector. By default the property is false. Its main
## use is for debugging purposes.
##
DeclareProperty( "UseLibraryCollector", IsFromTheLeftCollectorRep );
#############################################################################
##
#V The following variables are global flags mainly intended for debugging
## purposes.
##
BindGlobal( "USE_LIBRARY_COLLECTOR", false );
BindGlobal( "DEBUG_COMBINATORIAL_COLLECTOR", false );
BindGlobal( "USE_COMBINATORIAL_COLLECTOR", false );
#############################################################################
##
## Next the operation for creating a from-the-left collector is defined.
##
#O FromTheLeftCollector. . . . . . . . . . . . . . . . . . . . . . . . . . .
##
DeclareOperation( "FromTheLeftCollector", [IsObject] );
#############################################################################
##
## This is the inverse operation for ObjByExponents.
##
#O ExponentsByObj
##
DeclareOperation( "ExponentsByObj", [IsPolycyclicCollector, IsObject] );
#############################################################################
##
## These operations should be defined in the GAP library.
##
#O GetPower
#O GetConjugate
##
DeclareOperation( "GetPower", [IsPolycyclicCollector, IsObject] );
DeclareOperation( "GetConjugate",
[IsPolycyclicCollector, IsObject, IsObject] );
#############################################################################
##
#I InfoFromTheLeftCollector
#I InfoCombinatorialFromTheLeftCollector
##
DeclareInfoClass( "InfoFromTheLeftCollector" );
DeclareInfoClass( "InfoCombinatorialFromTheLeftCollector" );
############################################################################
##
#F NumberOfGenerators
#F FromTheLeftCollector_SetCommute
#F FromTheLeftCollector_CompletePowers
#F FromTheLeftCollector_CompleteConjugate
##
DeclareGlobalFunction( "NumberOfGenerators" );
DeclareGlobalFunction( "FromTheLeftCollector_SetCommute" );
DeclareGlobalFunction( "FromTheLeftCollector_CompletePowers" );
DeclareGlobalFunction( "FromTheLeftCollector_CompleteConjugate" );
############################################################################
##
#F IsPcpNormalFormObj( , )
##
DeclareGlobalFunction( "IsPcpNormalFormObj" );
############################################################################
##
#P IsPolycyclicPresentation
##
## checks whether the input-presentation is a polycyclic presentation, i.e.
## whether the right-hand-sides of the relations are normal.
##
DeclareProperty( "IsPolycyclicPresentation", IsFromTheLeftCollectorRep );
#############################################################################
##
#H The following indices point into a from the left collector. They are used
## in addition to the ones defined in the GAP source file src/objcftl.h/.c.
## Eventually, there will be one place for defining the indices of a
## from-the-left collector.
##
BindGlobal( "PC_PCP_ELEMENTS_FAMILY", 22 );
BindGlobal( "PC_PCP_ELEMENTS_TYPE", 23 );
BindGlobal( "PC_COMMUTATORS", 24 );
BindGlobal( "PC_INVERSECOMMUTATORS", 25 );
BindGlobal( "PC_COMMUTATORSINVERSE", 26 );
BindGlobal( "PC_INVERSECOMMUTATORSINVERSE", 27 );
BindGlobal( "PC_NILPOTENT_COMMUTE", 28 );
BindGlobal( "PC_WEIGHTS", 29 );
BindGlobal( "PC_ABELIAN_START", 30 );
polycyclic-2.16/gap/basic/pcpfact.gi 0000644 0000766 0000024 00000004650 13706672341 016432 0 ustar mhorn staff #############################################################################
##
#W pcpfact.gi Polycyc Bettina Eick
##
#############################################################################
##
#M FactorGroupNC( H, N )
##
InstallMethod( FactorGroupNC, IsIdenticalObj, [IsPcpGroup, IsPcpGroup],
function( H, N )
local F;
if not IsNormal( H, N ) then return fail; fi;
if not IsSubgroup( H, N ) then H := ClosureGroup( H, N ); fi;
F := PcpGroupByPcp( Pcp( H, N ) );
UseFactorRelation( H, N, F );
return F;
end );
#############################################################################
##
#F NaturalHomomorphismByPcp( pcp )
##
## compute factor and natural homomorphism.
## Setting up F and setting up the homomorphism are time-consuming.
## Speed up homomorphisms by `AddToIgsParallel'
##
InstallGlobalFunction( NaturalHomomorphismByPcp, function( pcp )
local G, F, N, gens, imgs, hom;
# G/N = F
G := GroupOfPcp( pcp );
N := SubgroupByIgs( G, DenominatorOfPcp( pcp ) );
F := PcpGroupByPcp( pcp );
UseFactorRelation( G, N, F );
# get generators in G and images in F
gens := ShallowCopy( GeneratorsOfPcp( pcp ) );
imgs := ShallowCopy( Igs( F ) );
Append( gens, DenominatorOfPcp( pcp ) );
Append( imgs, List( DenominatorOfPcp( pcp ), x -> One(F) ) );
# set up homomorphism
hom := GroupHomomorphismByImagesNC( G, F, gens, imgs );
SetKernelOfMultiplicativeGeneralMapping( hom, N );
return hom;
end );
#############################################################################
##
#F NaturalHomomorphism( G, N )
##
# This exists only for backwards compatibility; we may remove it once all
# packages have switched to using NaturalHomomorphismByNormalSubgroup. Or at
# least change it to print a warning...
InstallMethod( NaturalHomomorphism,
"for pcp groups", IsIdenticalObj, [IsPcpGroup, IsPcpGroup],
function( G, N )
if Size(N) = 1 then return IdentityMapping( G ); fi;
return NaturalHomomorphismByPcp( Pcp( G, N ) );
end );
#############################################################################
##
#F NaturalHomomorphismByNormalSubgroupOp( G, N )
##
InstallMethod( NaturalHomomorphismByNormalSubgroupOp,
"for pcp groups", IsIdenticalObj, [IsPcpGroup, IsPcpGroup],
function( G, N )
if Size(N) = 1 then return IdentityMapping( G ); fi;
return NaturalHomomorphismByPcp( Pcp( G, N ) );
end );
polycyclic-2.16/gap/basic/colftl.gi 0000644 0000766 0000024 00000016562 13706672341 016302 0 ustar mhorn staff CollectPolycyclicGap := function( pcp, ev, w )
local ngens, pow, exp, com, wst, west, sst, est, bottom,
stp, g, word, exponent, i, h, m, u, j, cnj,
icnj, hh;
if Length( w ) = 0 then return true; fi;
ngens := pcp![PC_NUMBER_OF_GENERATORS];
pow := pcp![ PC_POWERS ];
exp := pcp![ PC_EXPONENTS ];
com := pcp![ PC_COMMUTE ];
wst := [ ];
west := [ ];
sst := [ ];
est := [ ];
bottom := 0;
stp := bottom + 1;
wst[stp] := w;
west[stp] := 1;
sst[stp] := 1;
est[stp] := w[ 2 ];
# collect
while stp > bottom do
if est[stp] = 0 then
# initialise est
sst[stp] := sst[stp] + 1;
if sst[stp] > Length(wst[stp])/2 then
west[stp] := west[stp] - 1;
if west[stp] <= 0 then
## clear stacks before going down
wst[ stp ] := 0;
west[ stp ] := 0;
sst[ stp ] := 0;
est[ stp ] := 0;
stp := stp - 1;
else
sst[stp] := 1;
est[stp] := wst[stp][2];
fi;
else
est[stp] := wst[stp][ 2*sst[stp] ];
fi;
else
# get next generator
g := wst[stp][ 2*sst[stp]-1 ];
if stp > 1 and sst[stp] = 1 and g = com[g] then
## collect word ^ exponent in one go
word := wst[stp];
exponent := west[stp];
## Add the word into ev
for i in [1,3..Length(word)-1] do
h := word[ i ];
ev[h] := ev[h] + word[ i+1 ] * exponent;
od;
## Now reduce.
for h in [word[1]..ngens] do
if IsBound( exp[h] ) and ev[h] >= exp[h] then
m := QuoInt( ev[h], exp[h] );
ev[h] := ev[h] mod exp[h];
if IsBound( pow[h] ) then
u := pow[h];
for j in [1,3..Length(u)-1] do
ev[ u[j] ] := ev[ u[j] ] + u[j+1] * m;
od;
fi;
fi;
od;
west[ stp ] := 0;
est[ stp ] := 0;
sst[ stp ] := Length( word );
elif g = com[g] then
# move generator directly to its correct position
ev[g] := ev[g] + est[stp];
est[stp] := 0;
else
if est[stp] > 0 then
est[stp] := est[stp] - 1;
ev[g] := ev[g] + 1;
cnj := pcp![ PC_CONJUGATES ];
icnj := pcp![ PC_INVERSECONJUGATES ];
else
est[stp] := est[stp] + 1;
ev[g] := ev[g] - 1;
cnj := pcp![ PC_CONJUGATESINVERSE ];
icnj := pcp![ PC_INVERSECONJUGATESINVERSE ];
fi;
h := com[g];
# Find first position where we need to collect
while h > g do
if ev[h] <> 0 then
if ev[h] > 0 then
if IsBound( cnj[h][g] ) then break; fi;
else
if IsBound( icnj[h][g] ) then break; fi;
fi;
fi;
h := h-1;
od;
# Put that part on the stack, if necessary
if h > g or
( IsBound(exp[g])
and (ev[g] < 0 or ev[g] >= exp[g])
and IsBound(pow[g]) ) then
for hh in [com[g],com[g]-1..h+1] do
if ev[hh] <> 0 then
stp := stp+1;
if ev[hh] > 0 then
wst[stp] := pcp![ PC_GENERATORS ][hh];
west[stp] := ev[hh];
else
wst[stp] := pcp![ PC_INVERSES ][hh];
west[stp] := -ev[hh];
fi;
sst[stp] := 1;
est[stp] := wst[stp][ 2 ];
ev[hh] := 0;
fi;
od;
fi;
# move generator across the exponent vector
while h > g do
if ev[h] <> 0 then
stp := stp+1;
if ev[h] > 0 then
if IsBound( cnj[h][g] ) then
wst[stp] := cnj[h][g];
west[stp] := ev[h];
else
wst[stp] := pcp![ PC_GENERATORS ][h];
west[stp] := ev[h];
fi;
else
if IsBound( icnj[h][g] ) then
wst[stp] := icnj[h][g];
west[stp] := -ev[h];
else
wst[stp] := pcp![ PC_INVERSES ][h];
west[stp] := -ev[h];
fi;
fi;
sst[stp] := 1;
est[stp] := wst[stp][ 2 ];
ev[h] := 0;
fi;
h := h-1;
od;
fi;
# reduce exponent if necessary
if IsBound( exp[g] ) and ev[g] >= exp[g] then
ev[g] := ev[g] - exp[g];
if IsBound( pow[g] ) then
stp := stp+1;
wst[stp] := pow[g];
west[stp] := 1;
sst[stp] := 1;
est[stp] := wst[stp][ 2 ];
fi;
fi;
fi;
od;
return true;
end;
PrintCollectionStack := function( stp, wst, west, sst, est )
while stp > 0 do
Print( wst[stp], "^", west[stp],
" at ", sst[stp], " with exponent ", est[stp], "\n" );
stp := stp - 1;
od;
end;
#############################################################################
##
#M CollectWordOrFail . . . . . . . . . . . . . . . . . . . . . . . . . . . .
##
InstallMethod( CollectWordOrFail,
"FromTheLeftCollector (outdated)",
[ IsFromTheLeftCollectorRep,
IsList, IsList ],
function( pcp, ev, w )
Error( "Collector is out of date" );
end );
InstallMethod( CollectWordOrFail,
"FromTheLeftCollector",
[ IsFromTheLeftCollectorRep and IsUpToDatePolycyclicCollector,
IsList, IsList ],
function( pcp, a, b )
if USE_LIBRARY_COLLECTOR then
return CollectPolycyclicGap( pcp, a, b );
else
# CollectPolycyclic is implemented by the GAP C kernel, in file src/objcftl.c
CollectPolycyclic( pcp, a, b );
return true;
fi;
end );
InstallMethod( CollectWordOrFail,
"FromTheLeftCollector",
[ IsFromTheLeftCollectorRep and IsUpToDatePolycyclicCollector and
UseLibraryCollector,
IsList, IsList ],
CollectPolycyclicGap );
polycyclic-2.16/gap/basic/pcpelms.gi 0000644 0000766 0000024 00000040150 13706672341 016450 0 ustar mhorn staff #############################################################################
##
#W pcpelms.gi Polycyc Bettina Eick
##
InstallGlobalFunction( PcpElementConstruction,
function( coll, list, word )
local elm;
elm := rec( collector := coll,
exponents := Immutable(list),
word := Immutable(word),
name := "g" );
# objectify and return
return Objectify( coll![PC_PCP_ELEMENTS_TYPE], elm );
end );
#############################################################################
##
## Functions to create pcp elements by exponent vectors or words.
## In the NC versions we assume that elements are in normal form.
## In the other versions we collect before we return an element.
##
InstallGlobalFunction( PcpElementByExponentsNC,
function( coll, list )
local i, word;
word := ObjByExponents( coll, list );
return PcpElementConstruction( coll, list, word );
end );
InstallGlobalFunction( PcpElementByExponents, function( coll, list )
local h, k;
if Length(list) > NumberOfGenerators(coll) then
Error( "more exponents than generators" );
fi;
h := ObjByExponents( coll, list );
k := list * 0;
while CollectWordOrFail( coll, k, h ) = fail do od;
return PcpElementByExponentsNC( coll, k );
end );
InstallGlobalFunction( PcpElementByGenExpListNC,
function( coll, word )
local list, i;
list := ExponentsByObj( coll, word );
word := ObjByExponents( coll, list );
return PcpElementConstruction( coll, list, word );
end );
InstallGlobalFunction( PcpElementByGenExpList, function( coll, word )
local k;
k := [1..coll![PC_NUMBER_OF_GENERATORS]] * 0;
while CollectWordOrFail( coll, k, word ) = fail do od;
return PcpElementByExponentsNC( coll, k );
end );
#############################################################################
##
#A Basic attributes of pcp elements - for IsPcpElementRep
##
InstallMethod( Collector,
"for pcp groups",
[ IsPcpGroup ],
G -> Collector( One(G) ) );
InstallMethod( Collector,
"for pcp elements",
[ IsPcpElementRep ],
g -> g!.collector );
InstallMethod( Exponents,
"for pcp elements",
[ IsPcpElementRep ],
g -> g!.exponents );
InstallMethod( NameTag,
"for pcp elements",
[ IsPcpElementRep ],
g -> g!.name );
InstallMethod( GenExpList,
"for pcp elements",
[ IsPcpElementRep ],
g -> g!.word );
InstallMethod( Depth,
"for pcp elements",
[ IsPcpElementRep ],
function( elm )
if Length(elm!.word) = 0 then
return elm!.collector![PC_NUMBER_OF_GENERATORS] + 1;
else
return elm!.word[1];
fi;
end );
InstallMethod( TailOfElm,
"for pcp elements",
[ IsPcpElement and IsPcpElementRep ],
function( elm )
if Length( elm!.word ) = 0 then
return 0;
else
return elm!.word[ Length(elm!.word) - 1 ];
fi;
end );
InstallMethod( LeadingExponent,
"for pcp elements",
[ IsPcpElementRep ],
function( elm )
if Length(elm!.word) = 0 then
return fail;
else
return elm!.word[2];
fi;
end );
## Note, that inverses of generators with relative order > 0 are not treated
## as inverses as they should never appear here with a negative exponent.
IsGeneratorOrInverse := function( elm )
return Length(elm!.word) = 2 and
(elm!.word[2] = 1 or elm!.word[2] = -1);
end;
##
## Is elm the power of a generator modulo depth d?
## If so, then return the power, otherwise return fail;
##
IsPowerOfGenerator := function( elm, d )
if Length( elm!.word ) = 0 or
(Length( elm!.word ) > 2 and elm!.word[3] <= d) then
return fail;
fi;
return elm!.word[2];
end;
#############################################################################
##
#F FactorOrder( g )
##
InstallMethod( FactorOrder, [IsPcpElement],
function( g )
if Length( g!.word ) = 0 then return fail; fi;
return RelativeOrders( Collector(g) )[Depth(g)];
end );
#############################################################################
##
#F RelativeOrderPcp( g )
##
InstallMethod( RelativeOrderPcp, [IsPcpElement],
function( g )
local r, l;
if Length( g!.word ) = 0 then return fail; fi;
r := FactorOrder( g );
# the infinite case
if r = 0 then return 0; fi;
# the finite case
l := LeadingExponent( g );
if l = 1 then
return r;
elif IsBound( g!.normed ) and g!.normed then
return r / LeadingExponent(g);
elif IsPrime( r ) then
return r;
else
return r / Gcd( r, l );
fi;
end );
# TODO: Replace this by something like DeclareSynonymAttr.
# However, we cannot use DeclareSynonymAttr directly, because for
# collectors there is already an operation SetRelativeOrder.
RelativeOrder := function( g ) return RelativeOrderPcp(g); end;
#############################################################################
##
#F RelativeIndex( g )
##
InstallMethod( RelativeIndex, [IsPcpElement],
function( g )
local r, l;
if Length( g!.word ) = 0 then return fail; fi;
r := FactorOrder( g );
l := LeadingExponent( g );
if IsBound( g!.normed ) and g!.normed then
return l;
elif r > 0 then
return Gcd( r, l );
else
return AbsInt( l );
fi;
end );
#############################################################################
##
#F Order( g )
##
InstallMethod( Order, [IsPcpElement],
function( g )
local o, r;
o := 1;
while g <> g^0 do
r := RelativeOrderPcp( g );
if r = 0 then return infinity; fi;
o := o*r;
g := g^r;
od;
return o;
end );
#############################################################################
##
#F NormingExponent( g ) . . . . . . . . .returns f such that g^f is normed
##
## Note that g is normed, if the LeadingExponent of g is its RelativeIndex.
##
# FIXME: This function is documented and should be turned into a GlobalFunction
NormingExponent := function( g )
local r, l, e;
r := FactorOrder( g );
l := LeadingExponent( g );
if IsBool( l ) then
return 1;
elif r = 0 and l < 0 then
return -1;
elif r = 0 then
return 1;
elif IsPrime( r ) then
return l^-1 mod r;
else
e := Gcdex( r, l ); # = RelativeIndex
return e.coeff2 mod r; # l * c2 = e mod r
fi;
end;
#############################################################################
##
#F NormedPcpElement( g )
##
# FIXME: This function is documented and should be turned into a GlobalFunction
NormedPcpElement := function( g )
local h;
h := g^NormingExponent( g );
h!.normed := true;
return h;
end;
#############################################################################
##
#M Print pcp elements
##
InstallMethod( PrintObj,
"for pcp elements",
[IsPcpElement],
function( elm )
local g, l, e, d;
g := NameTag( elm );
e := Exponents( elm );
d := Depth( elm );
if d > Length( e ) then
Print("id");
elif e[d] = 1 then
Print(Concatenation(g,String(d)));
else
Print(Concatenation(g,String(d)),"^",e[d]);
fi;
for l in [d+1..Length(e)] do
if e[l] = 1 then
Print("*",Concatenation(g,String(l)));
elif e[l] <> 0 then
Print("*",Concatenation(g,String(l)),"^",e[l]);
fi;
od;
end );
InstallMethod( String,
"for pcp elements",
[IsPcpElement],
function( elm )
local g, l, e, d, str;
g := NameTag( elm );
e := Exponents( elm );
d := Depth( elm );
if d > Length( e ) then
return "id";
fi;
str := Concatenation(g,String(d));
if e[d] <> 1 then
Append(str, Concatenation("^",String(e[d])));
fi;
for l in [d+1..Length(e)] do
if e[l] = 0 then continue; fi;
Append(str, Concatenation("*",g,String(l)));
if e[l] <> 1 then
Append(str, Concatenation("^",String(e[l])));
fi;
od;
return str;
end );
#############################################################################
##
#M g * h
##
InstallMethod( \*,
"for pcp elements",
IsIdenticalObj,
[IsPcpElement, IsPcpElement],
20,
function( g1, g2 )
local clt, e, f;
clt := Collector( g1 );
if TailOfElm( g1 ) < Depth( g2 ) then
e := Exponents( g1 ) + Exponents( g2 );
else
e := ShallowCopy( Exponents( g1 ) );
f := GenExpList( g2 );
while CollectWordOrFail( clt, e, f ) = fail do
e := ShallowCopy( Exponents( g1 ) );
od;
fi;
return PcpElementByExponentsNC( clt, e );
end );
#############################################################################
##
#M Inverse
##
InstallMethod( Inverse,
"for pcp elements",
[IsPcpElement],
function( g )
local clt, k;
clt := Collector( g );
if IsGeneratorOrInverse( g ) and RelativeOrderPcp(g) = 0 then
if LeadingExponent( g ) = 1 then
k := clt![PC_INVERSES][ Depth(g) ];
else
k := clt![PC_GENERATORS][ Depth(g) ];
fi;
else
k := FromTheLeftCollector_Inverse( clt, GenExpList(g) );
fi;
return PcpElementByGenExpListNC( clt, k );
end );
InstallMethod( INV,
"for pcp elements",
[IsPcpElement],
function( g )
local clt, k;
clt := Collector( g );
if IsGeneratorOrInverse( g ) and RelativeOrderPcp(g) = 0 then
if LeadingExponent( g ) = 1 then
k := clt![PC_INVERSES][ Depth(g) ];
else
k := clt![PC_GENERATORS][ Depth(g) ];
fi;
else
k := FromTheLeftCollector_Inverse( clt, GenExpList(g) );
fi;
return PcpElementByGenExpListNC( clt, k );
end );
#############################################################################
##
#M \^
##
InstallMethod( \^,
"for a pcp element and an integer",
[IsPcpElement, IsInt],
SUM_FLAGS + 10,
function( g, d )
local res;
# first catch the trivial cases
if d = 0 then
return PcpElementByExponentsNC( Collector(g), 0*Exponents(g) );
elif d = 1 then
return g;
elif d = -1 then
return Inverse(g);
fi;
# # use collector function
# c := Collector(g);
# k := FromTheLeftCollector_Power(c, ObjByExponents(c, Exponents(g)), d);
# return PcpElementByGenExpListNC( c, k );
# set up for computation
if d < 0 then
g := Inverse(g);
d := -d;
fi;
# compute power
res := g^0;
while d > 0 do
if d mod 2 = 1 then res := res * g; fi;
d := QuoInt( d, 2 );
if d <> 0 then g := g * g; fi;
od;
return res;
end );
InstallMethod( \^,
"for two pcp elements",
IsIdenticalObj,
[IsPcpElement, IsPcpElement],
function( h, g )
local clt, conj;
clt := Collector( g );
if IsGeneratorOrInverse( h ) and IsGeneratorOrInverse( g ) then
if Depth( g ) = Depth( h ) then
conj := h;
elif Depth( g ) < Depth( h ) then
conj := GetConjugateNC( clt,
Depth( h ) * LeadingExponent( h ),
Depth( g ) * LeadingExponent( g ) );
conj := PcpElementByGenExpListNC( clt, conj );
elif Depth( g ) > Depth( h ) then
# h^g = g^-1 * h * g
conj := ShallowCopy( Exponents( g^-1 ) );
while CollectWordOrFail( clt, conj,
[ Depth(h), LeadingExponent( h ),
Depth(g), LeadingExponent( g ) ] ) = fail do
conj := ShallowCopy( Exponents( g^-1 ) );
od;
conj := PcpElementByExponentsNC( clt, conj );
fi;
elif Depth(g) = TailOfElm(g) and Depth( g ) < Depth( h ) then
##
## nicht klar ob dies etwas bringt
##
g := [ Depth(g), LeadingExponent(g) ];
conj := ShallowCopy( Exponents( h ) );
while CollectWordOrFail( clt, conj, g ) = fail do
conj := ShallowCopy( Exponents( h ) );
od;
conj[ g[1] ] := 0;
conj := PcpElementByExponentsNC( clt, conj );
else
conj := g^-1 * h * g;
fi;
return conj;
end );
InstallMethod( GetCommutatorNC,
"for from the left collector",
[ IsFromTheLeftCollectorRep, IsInt, IsInt ],
function( coll, h, g )
if g > 0 then
if h > 0 then
if IsBound( coll![PC_COMMUTATORS][h] ) and
IsBound( coll![PC_COMMUTATORS][h][g] ) then
return coll![PC_COMMUTATORS][h][g];
else
return fail;
fi;
else
h := -h;
if IsBound( coll![PC_INVERSECOMMUTATORS][h] ) and
IsBound( coll![PC_INVERSECOMMUTATORS][h][g] ) then
return coll![PC_INVERSECOMMUTATORS][h][g];
else
return fail;
fi;
fi;
else
g := -g;
if h > 0 then
if IsBound( coll![PC_COMMUTATORSINVERSE][h] ) and
IsBound( coll![PC_COMMUTATORSINVERSE][h][g] ) then
return coll![PC_COMMUTATORSINVERSE][h][g];
else
return fail;
fi;
else
h := -h;
if IsBound( coll![PC_INVERSECOMMUTATORSINVERSE][h] ) and
IsBound( coll![PC_INVERSECOMMUTATORSINVERSE][h][g] ) then
return coll![PC_INVERSECOMMUTATORSINVERSE][h][g];
else
return fail;
fi;
fi;
fi;
end );
#############################################################################
##
#M Comm
##
InstallMethod( Comm,
"for two pcp elements",
[ IsPcpElement, IsPcpElement ],
function( h, g )
local clt, conj, ev;
clt := Collector( g );
if IsGeneratorOrInverse( h ) and IsGeneratorOrInverse( g ) then
if Depth( g ) = Depth( h ) then return g^0; fi;
if Depth( g ) < Depth( h ) then
## Do we know the commutator?
conj := GetCommutatorNC( clt, Depth( h ) * LeadingExponent( h ),
Depth( g ) * LeadingExponent( g ) );
if conj <> fail then
return conj;
fi;
## [h,g] = h^-1 h^g
conj := GetConjugateNC( clt, Depth( h ) * LeadingExponent( h ),
Depth( g ) * LeadingExponent( g ) );
ev := ShallowCopy( Exponents( h^-1 ) );
while CollectWordOrFail( clt, ev, conj ) = fail do
ev := ShallowCopy( Exponents( h^-1 ) );
od;
return PcpElementByExponentsNC( clt, ev );
fi;
if Depth( g ) > Depth( h ) and RelativeOrderPcp( g ) = 0 then
## [h,g] = (g^-1)^h * g
conj := GetConjugateNC( clt, Depth( g ) * -LeadingExponent( g ),
Depth( h ) * LeadingExponent( h ) );
ev := ExponentsByObj( clt, conj );
while CollectWordOrFail( clt, ev, GenExpList(g) ) = fail do
ev := ExponentsByObj( clt, conj );
od;
return PcpElementByExponentsNC( clt, ev );
fi;
fi;
return PcpElementByGenExpListNC( clt,
FromTheLeftCollector_Solution( clt,
GenExpList(g*h),GenExpList(h*g) ) );
end );
#############################################################################
##
#M One
##
InstallMethod( One, "for pcp elements", [IsPcpElement],
g -> PcpElementByExponentsNC( Collector(g), 0*Exponents(g) ) );
#############################################################################
##
#M \=
##
InstallMethod( \=,
"for pcp elements",
IsIdenticalObj,
[IsPcpElement, IsPcpElement],
function( g, h )
return Exponents( g ) = Exponents( h );
end );
#############################################################################
##
#M \<
##
InstallMethod( \<,
"for pcp elements",
IsIdenticalObj,
[IsPcpElement, IsPcpElement],
function( g, h )
return Exponents( g ) > Exponents( h );
end );
polycyclic-2.16/gap/basic/colrec.gi 0000644 0000766 0000024 00000005244 13706672341 016261 0 ustar mhorn staff #############################################################################
##
#F FromTheLeftCollector_Power . . . . . . . . . . . . . . . . . . . . . .
##
#BindGlobal( "FromTheLeftCollector_Power", function( coll, w, e )
#
# if e < 0 then
# w := FromTheLeftCollector_Inverse( coll, w );
# e := -e;
# fi;
#
# return BinaryPower( coll, w, e );
#end );
#
#############################################################################
##
#F ProductAutomorphisms . . . . . . . . . . . . . . . . . . . . . . . . .
##
#BindGlobal( "ProductAutomorphisms", function( coll, alpha, beta )
# local ngens, gamma, i, w, ev, g;
# ngens := NumberGeneratorsOfRws( coll );
# gamma := [];
# for i in [1..ngens] do
# if IsBound( alpha[i] ) then
# w := alpha[i];
# ev := ListWithIdenticalEntries( ngens, 0 );
# for g in [1,3..Length(w)-1] do
# if w[g+1] <> 0 then
# CollectWordOrFail( coll, ev,
# FromTheLeftCollector_Power(
# coll, beta[ w[g] ], w[g+1] ) );
# fi;
# od;
# gamma[i] := ObjByExponents( coll, ev );
# fi;
# od;
# return gamma;
#end );
#############################################################################
##
#F PowerAutomorphism . . . . . . . . . . . . . . . . . . . . . . . . . . .
##
#BindGlobal( "PowerAutomorphism", function( coll, g, e )
# local n, a, power, h, ipower;
#
# n := NumberGeneratorsOfRws( coll );
#
# # initialise automorphism
# a := [];
# power := [];
# for h in [g+1..n] do
# if e > 0 then
# if IsBound( coll![ PC_CONJUGATES][h] ) and
# IsBound( coll![ PC_CONJUGATES ][h][g] ) then
# a[h] := coll![ PC_CONJUGATES ][h][g];
# else
# a[h] := [h,1];
# fi;
# else
# if IsBound( coll![ PC_CONJUGATESINVERSE ][h] ) and
# IsBound( coll![ PC_CONJUGATESINVERSE ][h][g] ) then
# a[h] := coll![ PC_CONJUGATESINVERSE ][h][g];
# else
# a[h] := [h,1];
# fi;
# fi;
# power[h] := [h,1];
# od;
# if e < 0 then
# e := -e;
# fi;
#
# while e > 0 do
# if e mod 2 = 1 then
# power := ProductAutomorphisms( coll, power, a );
# fi;
# e := Int( e / 2 );
# if e > 0 then
# a := ProductAutomorphisms( coll, a, a );
# fi;
# od;
# ipower := [];
# for h in [g+1..n] do
# ipower[h] := FromTheLeftCollector_Inverse( coll, power[h] );
# od;
#
# return [ power, ipower ];
#end );
#
polycyclic-2.16/gap/basic/grphoms.gi 0000644 0000766 0000024 00000027613 13706672341 016475 0 ustar mhorn staff #############################################################################
##
#W grphoms.gi Polycyc Bettina Eick
##
#############################################################################
##
## Functions to deal with homomorphisms to and from pcp groups.
##
## This function is modified version of GAP's DoGGMBINC
BindGlobal( "GroupGeneralMappingByImages_for_pcp", function( G, H, gens, imgs )
local mapi, filter, type, hom, pcgs, p, l, obj_args;
hom := rec( );
if Length(gens)<>Length(imgs) then
Error(" and must be lists of same length");
fi;
# if not HasIsHandledByNiceMonomorphism(G) and ValueOption("noassert")<>true then
# Assert( 2, ForAll( gens, x -> x in G ) );
# fi;
# if not HasIsHandledByNiceMonomorphism(H) and ValueOption("noassert")<>true then
# Assert( 2, ForAll( imgs, x -> x in H ) );
# fi;
mapi := [Immutable(gens), Immutable(imgs)];
filter := IsGroupGeneralMappingByImages and HasSource and HasRange
and HasMappingGeneratorsImages;
if IsPcpGroup(G) then
hom!.igs_gens_to_imgs := IgsParallel( gens, imgs );
filter := filter and IsFromPcpGHBI;
elif IsPcGroup( G ) and IsPrimeOrdersPcgs(Pcgs(G)) then
filter := filter and IsPcGroupGeneralMappingByImages;
pcgs := CanonicalPcgsByGeneratorsWithImages( Pcgs(G), mapi[1], mapi[2] );
hom.sourcePcgs := pcgs[1];
hom.sourcePcgsImages := pcgs[2];
if pcgs[1]=Pcgs(G) then
filter := filter and IsTotal;
fi;
elif IsPcgs( gens ) then
filter := filter and IsGroupGeneralMappingByPcgs;
hom.sourcePcgs := mapi[1];
hom.sourcePcgsImages := mapi[2];
# Do we map a subgroup of a free group or an fp group by a subset of its
# standard generators?
# (So we can used MappedWord for mapping)?
elif IsSubgroupFpGroup(G) then
if HasIsWholeFamily(G) and IsWholeFamily(G)
# total on free generators
and Set(FreeGeneratorsOfFpGroup(G))=Set(List(gens,UnderlyingElement))
then
l:=List(gens,UnderlyingElement);
p:=List(l,i->Position(FreeGeneratorsOfFpGroup(G),i));
# test for duplicate generators, same images
if Length(gens)=Length(FreeGeneratorsOfFpGroup(G)) or
ForAll([1..Length(gens)],x->imgs[x]=imgs[Position(l,l[x])]) then
filter := filter and IsFromFpGroupStdGensGeneralMappingByImages;
hom.genpositions:=p;
else
filter := filter and IsFromFpGroupGeneralMappingByImages;
fi;
else
filter := filter and IsFromFpGroupGeneralMappingByImages;
fi;
elif IsPermGroup(G) then
filter := filter and IsPermGroupGeneralMappingByImages;
fi;
if IsPermGroup(H) then
filter := filter and IsToPermGroupGeneralMappingByImages;
elif IsPcGroup(H) then
filter := filter and IsToPcGroupGeneralMappingByImages;
elif IsSubgroupFpGroup(H) then
filter := filter and IsToFpGroupGeneralMappingByImages;
elif IsPcpGroup(H) then
hom!.igs_imgs_to_gens := IgsParallel( imgs, gens );
filter := filter and IsToPcpGHBI;
fi;
obj_args := [
hom,
, # Here the type will be inserted
Source, G,
Range, H,
MappingGeneratorsImages, mapi ];
if HasGeneratorsOfGroup(G)
and IsIdenticalObj(GeneratorsOfGroup(G),mapi[1]) then
Append(obj_args, [PreImagesRange, G]);
filter := filter and IsTotal and HasPreImagesRange;
fi;
if HasGeneratorsOfGroup(H)
and IsIdenticalObj(GeneratorsOfGroup(H),mapi[2]) then
Append(obj_args, [ImagesSource, H]);
filter := filter and IsSurjective and HasImagesSource;
fi;
obj_args[2] :=
NewType( GeneralMappingsFamily( ElementsFamily( FamilyObj( G ) ),
ElementsFamily( FamilyObj( H ) ) ),
filter );
CallFuncList(ObjectifyWithAttributes, obj_args);
return hom;
end );
#############################################################################
##
#M GGMBI( G, H ) . . . . . . . . . . . . . . . . . . . for G and H pcp groups
##
InstallMethod( GroupGeneralMappingByImagesNC,
"for pcp group, pcp group, list, list",
[IsPcpGroup, IsPcpGroup, IsList, IsList],
GroupGeneralMappingByImages_for_pcp );
#############################################################################
##
#M GGMBI( G, H ) . . . . . . . . . . . . . . . . . . . . . . for G pcp group
##
InstallMethod( GroupGeneralMappingByImagesNC,
"for pcp group, group, list, list",
[IsPcpGroup, IsGroup, IsList, IsList],
GroupGeneralMappingByImages_for_pcp );
#############################################################################
##
#M GGMBI( G, H ) . . . . . . . . . . . . . . . . . . . . . . for H pcp group
##
InstallMethod( GroupGeneralMappingByImagesNC,
"for group, pcp group, list, list",
[IsGroup, IsPcpGroup, IsList, IsList],
GroupGeneralMappingByImages_for_pcp );
#############################################################################
##
#M IsSingleValued( )
##
## This method is very similar to our CoKernelOfMultiplicativeGeneralMapping
## method. However, a crucial difference is the call to 'NormalClosure'
## at the end of CoKernelOfMultiplicativeGeneralMapping, which won't
## terminate if the range is e.g. an infinite matrix group.
InstallMethod( IsSingleValued,
"for IsFromPcpGHBI",
[ IsFromPcpGHBI ],
function( hom )
local gens, imgs, i, j, a, b, mapi;
if IsTrivial(Range(hom)) then
return true;
fi;
gens := hom!.igs_gens_to_imgs[1];
imgs := hom!.igs_gens_to_imgs[2];
# check relators
for i in [1..Length( gens )] do
if RelativeOrderPcp( gens[i] ) > 0 then
a := gens[i]^RelativeOrderPcp( gens[i] );
a := MappedVector(ExponentsByIgs(gens, a), imgs);
b := imgs[i]^RelativeOrderPcp( gens[i] );
if a <> b then return false; fi;
fi;
for j in [1..i-1] do
a := gens[i] ^ gens[j];
a := MappedVector(ExponentsByIgs(gens, a), imgs);
b := imgs[i] ^ imgs[j];
if a <> b then return false; fi;
if RelativeOrderPcp( gens[i] ) = 0 then
a := gens[i] ^ (gens[j]^-1);
a := MappedVector(ExponentsByIgs(gens, a), imgs);
b := imgs[i] ^ (imgs[j]^-1);
if a <> b then return false; fi;
fi;
od;
od;
# we still need to test any additional generators. This matters
# for generalized mappings which are not total or not single valued,
# such as the "inverse" of a non-surjective / non-injective group
# homomorphism.
mapi := MappingGeneratorsImages( hom );
for i in [1..Length(mapi[1])] do
a := mapi[1][i];
a := MappedVector(ExponentsByIgs(gens, a), imgs);
b := mapi[2][i];
if a <> b then return false; fi;
od;
return true;
end );
#############################################################################
##
#M CoKernelOfMultiplicativeGeneralMapping
##
InstallMethod( CoKernelOfMultiplicativeGeneralMapping,
"for IsFromPcpGHBI",
[ IsFromPcpGHBI ],
function( hom )
local C, gens, imgs, i, j, a, b, mapi;
if IsTrivial(Range(hom)) then
return Range(hom);
fi;
gens := hom!.igs_gens_to_imgs[1];
imgs := hom!.igs_gens_to_imgs[2];
C := TrivialSubgroup(Range(hom)); # the cokernel
# check relators
for i in [1..Length( gens )] do
if RelativeOrderPcp( gens[i] ) > 0 then
a := gens[i]^RelativeOrderPcp( gens[i] );
a := MappedVector(ExponentsByIgs(gens, a), imgs);
b := imgs[i]^RelativeOrderPcp( gens[i] );
C := ClosureSubgroupNC(C, a/b);
fi;
for j in [1..i-1] do
a := gens[i] ^ gens[j];
a := MappedVector(ExponentsByIgs(gens, a), imgs);
b := imgs[i] ^ imgs[j];
C := ClosureSubgroupNC(C, a/b);
if RelativeOrderPcp( gens[i] ) = 0 then
a := gens[i] ^ (gens[j]^-1);
a := MappedVector(ExponentsByIgs(gens, a), imgs);
b := imgs[i] ^ (imgs[j]^-1);
C := ClosureSubgroupNC(C, a/b);
fi;
od;
od;
# we still need to test any additional generators. This matters
# for generalized mappings which are not total or not single valued,
# such as the "inverse" of a non-surjective / non-injective group
# homomorphism.
mapi := MappingGeneratorsImages( hom );
for i in [1..Length(mapi[1])] do
a := mapi[1][i];
a := MappedVector(ExponentsByIgs(gens, a), imgs);
b := mapi[2][i];
C := ClosureSubgroupNC(C, a/b);
od;
C := NormalClosure(ImagesSource(hom),C);
return C;
end );
#############################################################################
##
#M Images
##
InstallMethod( ImagesRepresentative,
"for FromPcpGHBI",
FamSourceEqFamElm,
[ IsFromPcpGHBI, IsPcpElement ],
function( hom, elm )
local e;
if Length(hom!.igs_gens_to_imgs[1]) = 0 then return One(Range(hom)); fi;
e := ExponentsByIgs( hom!.igs_gens_to_imgs[1], elm );
if e = fail then return fail; fi;
return MappedVector( e, hom!.igs_gens_to_imgs[2] );
end );
# TODO: Also implement ImagesSet methods, like we have PreImagesSet methods ?
# Any particular reason for / against each?
#############################################################################
##
#M PreImages
##
InstallMethod( PreImagesRepresentative,
"for ToPcpGHBI",
FamRangeEqFamElm,
[ IsToPcpGHBI, IsPcpElement ],
function( hom, elm )
local e;
e := ExponentsByIgs(hom!.igs_imgs_to_gens[1], elm);
if e = fail then return fail; fi;
if Length(e) = 0 then return One(hom!.Source); fi;
return MappedVector(e, hom!.igs_imgs_to_gens[2]);
end );
InstallMethod( PreImagesSet,
"for PcpGHBI",
CollFamRangeEqFamElms,
[ IsFromPcpGHBI and IsToPcpGHBI, IsPcpGroup ],
function( hom, U )
local prei, kern;
prei := List( Igs(U), x -> PreImagesRepresentative(hom,x) );
if fail in prei then
TryNextMethod();
# Potential solution: Intersect U with ImagesSource(hom)
# and then compute the preimage of that.
#gens := GeneratorsOfGroup( Intersection( ImagesSource(hom), U ) );
#prei := List( gens, x -> PreImagesRepresentative(hom,x) );
fi;
kern := Igs( KernelOfMultiplicativeGeneralMapping( hom ) );
return SubgroupByIgs( Source(hom), kern, prei );
end );
#############################################################################
##
#M KernelOfMultiplicativeGeneralMapping
##
InstallMethod( KernelOfMultiplicativeGeneralMapping,
"for PcpGHBI",
[ IsFromPcpGHBI and IsToPcpGHBI],
function( hom )
local A, a, B, b, D, u, kern, i, g;
# set up
A := Source(hom);
a := MappingGeneratorsImages(hom)[1];
B := Range(hom);
b := MappingGeneratorsImages(hom)[2];
D := DirectProduct(B,A);
u := Cgs(Subgroup(D, List([1..Length(a)], x ->
Image(Embedding(D,1),b[x])*Image(Embedding(D,2),a[x]))));
# filter kernel gens
kern := [];
for i in [1..Length(u)] do
g := Image(Projection(D,1),u[i]);
if g = One(B) then
Add(kern, Image(Projection(D,2),u[i]));
fi;
od;
# create group
return Subgroup( Source(hom), kern);
end );
# TODO: Add KernelOfMultiplicativeGeneralMapping method for IsToPcpGHBI
# Slower than the one above but more general.
#############################################################################
##
#M IsInjective( )
##
InstallMethod( IsInjective,
"for PcpGHBI",
[ IsFromPcpGHBI and IsToPcpGHBI],
function( hom )
return Size( KernelOfMultiplicativeGeneralMapping(hom) ) = 1;
end );
#############################################################################
##
#M KnowsHowToDecompose( , )
##
InstallMethod( KnowsHowToDecompose,
"pcp group and generators: always true",
IsIdenticalObj,
[ IsPcpGroup, IsList ], 0,
ReturnTrue);
polycyclic-2.16/gap/basic/colcom.gi 0000644 0000766 0000024 00000047301 13706672341 016266 0 ustar mhorn staff
## The elements of combinatorial collection from the left are:
##
## the exponent vector: contains the result of the collection process
##
## the word stack: stacks words which need to be collected into
## the exponent vector
## the word exponent stack: stacks the exponents corresponding to each
## word on the word stack
## the syllable stack: stacks indices into the words on the word
## stack. This is necessary because words may
## have to be collected only partially before
## other words are put onto the word stack.
## the exponent stack: stacks exponents of the generator to which
## the corresponding entry on the syllable
## stack points. This is needed because a
## power of generator in a word may have to be
## collected partially before new words are put
## on the stack.
##
## the two commute arrays:
##
## the 4 conjugation arrays:
## the exponent array:
## the power array:
##
## For this collector we need normed right hand sides in the presentation.
# Collect various statistics about the combinatorial collection process
# for debugging purposes.
CombCollStats := rec(
Counter := 0,
CompleteCommGen := 0,
WholeCommWord := 0,
CommRestWord := 0,
CommGen := 0,
CombColl := 0,
CombCollStack := 0,
OrdColl := 0,
StepByStep := 0,
ThreeWtGen := 0,
ThreeWtGenStack := 0,
Count_Length := 0,
Count_Weight := 0,
);
DisplayCombCollStats := function()
Print( "Calls to combinatorial collector: ", CombCollStats.Counter, "\n" );
Print( "Completely collected generators: ", CombCollStats.CompleteCommGen, "\n" );
Print( "Whole words collected: ", CombCollStats.WholeCommWord, "\n" );
Print( "Rest of word collected: ", CombCollStats.CommRestWord, "\n" );
Print( "Commuting generator collected: ", CombCollStats.CommGen, "\n" );
Print( "Triple weight generators: ", CombCollStats.ThreeWtGen, "\n" );
Print( " of those had to be stacked: ", CombCollStats.ThreeWtGenStack, "\n" );
Print( "Step by step collection: ", CombCollStats.StepByStep, "\n" );
Print( "Combinatorial collection: ", CombCollStats.CombColl, "\n" );
Print( " of those had to be stacked: ", CombCollStats.CombCollStack, "\n" );
Print( "Ordinary collection: ", CombCollStats.OrdColl, "\n" );
end;
ClearCombCollStats := function()
CombCollStats.Counter := 0;
CombCollStats.CompleteCommGen := 0;
CombCollStats.WholeCommWord := 0;
CombCollStats.CommRestWord := 0;
CombCollStats.CommGen := 0;
CombCollStats.CombColl := 0;
CombCollStats.CombCollStack := 0;
CombCollStats.OrdColl := 0;
CombCollStats.StepByStep := 0;
CombCollStats.ThreeWtGen := 0;
CombCollStats.ThreeWtGenStack := 0;
end;
CombinatorialCollectPolycyclicGap := function( coc, ev, w )
local com, com2, wt, class, wst, west,
sst, est, bottom, stp, g, cnj, icnj, h, m, i, j,
astart, IsNormed, InfoCombi,
ngens, pow, exp,
ReduceExponentVector,
AddIntoExponentVector;
## The following is more elegant since it avoids the if-statment but it
## uses two divisions.
# m := ev[h];
# ev[h] := ev[h] mod exp[h];
# m := (m - ev[h]) / exp[h];
ReduceExponentVector := function( ev, g )
## We assume that all generators after g commute with g.
local h, m, u, j;
Info( InfoCombinatorialFromTheLeftCollector, 5,
" Reducing ", ev, " from ", g );
for h in [g..ngens] do
if IsBound( exp[h] ) and (ev[h] < 0 or ev[h] >= exp[h]) then
m := QuoInt( ev[h], exp[h] );
ev[h] := ev[h] - m * exp[h];
if ev[h] < 0 then
m := m - 1;
ev[h] := ev[h] + exp[h];
fi;
if ev[h] < 0 or ev[h] >= exp[h] then
Error( "incorrect reduction of exponent vector" );
fi;
if IsBound( pow[h] ) then
u := pow[h];
for j in [1,3..Length(u)-1] do
ev[ u[j] ] := ev[ u[j] ] + u[j+1] * m;
od;
fi;
fi;
od;
end;
## ev := ev * word^exp
## We assume that all generators after g commute with g.
AddIntoExponentVector := function( ev, word, start, e )
local i, h;
Info( InfoCombinatorialFromTheLeftCollector, 5,
" Adding ", word, "^", e, " from ", start );
CombCollStats.Count_Length := CombCollStats.Count_Length + Length(word);
if start <= Length(word) then
CombCollStats.Count_Weight := CombCollStats.Count_Weight + word[start];
fi;
for i in [start,start+2..Length(word)-1] do
h := word[ i ];
ev[h] := ev[h] + word[ i+1 ] * e;
if IsBound( exp[h] ) and (ev[h] < 0 or ev[h] >= exp[h]) then
ReduceExponentVector( ev, h );
fi;
od;
end;
if Length(w) = 0 then return true; fi;
InfoCombi := InfoCombinatorialFromTheLeftCollector;
CombCollStats.Counter := CombCollStats.Counter + 1;
Info( InfoCombi, 4,
"Entering combinatorial collector (", CombCollStats.Counter, ") ",
ev, " * ", w );
## Check if the word is normed
IsNormed := true;
for i in [3,5..Length(w)-1] do
if not w[i-2] < w[i] then IsNormed := false; break; fi;
od;
## The following variables are global because they are needed by the
## two routines above.
ngens := coc![PC_NUMBER_OF_GENERATORS];
pow := coc![ PC_POWERS ];
exp := coc![ PC_EXPONENTS ];
## weight and commutator information
wt := coc![ PC_WEIGHTS ];
class := wt[ Length(wt) ];
com := coc![ PC_COMMUTE ];
com2 := coc![ PC_NILPOTENT_COMMUTE ];
astart := coc![ PC_ABELIAN_START ];
## the four stacks
wst := [ ];
west := [ ];
sst := [ ];
est := [ ];
## initialise
bottom := 0;
stp := bottom + 1;
wst[stp] := w;
west[stp] := 1;
sst[stp] := 1;
est[stp] := w[ 2 ];
# collect
while stp > bottom do
Info( InfoCombi, 5,
" Next iteration: exponent vector ", ev );
## Stack Management
if est[stp] = 0 then
## The current generator has been collected completely,
## advance syllable pointer.
sst[stp] := sst[stp] + 2;
if sst[stp] <= Length(wst[stp]) then
## Get the corresponding exponent.
est[stp] := wst[stp][ sst[stp]+1 ];
else
## The current word has been collected completely,
## reduce the wrd exponent.
west[stp] := west[stp] - 1;
if west[stp] > 0 then
## Initialise the syllable pointer and exponent
## counter.
sst[stp] := 1;
est[stp] := wst[stp][2];
else
## The current word/exponent pair has been collected
## completely, move down the stacks and clear stacks
## before going down.
wst[ stp ] := 0; west[ stp ] := 0;
sst[ stp ] := 0; est[ stp ] := 0;
stp := stp - 1;
fi;
fi;
## Collection
else ## now move the next generator/word to the correct position
g := wst[stp][ sst[stp] ]; ## get generator number
if est[stp] > 0 then
cnj := coc![PC_CONJUGATES];
icnj := coc![PC_INVERSECONJUGATES];
elif est[stp] < 0 then
cnj := coc![PC_CONJUGATESINVERSE];
icnj := coc![PC_INVERSECONJUGATESINVERSE];
else
Error( "exponent stack has zero entry" );
fi;
## Check if there is a single commuting generator on the stack
## and collect.
if Length( wst[stp] ) = 1 and com[g] = g then
CombCollStats.CompleteCommGen := CombCollStats.CompleteCommGen + 1;
Info( InfoCombi, 5,
" collecting single generator ", g );
ev[ g ] := ev[ g ] + west[stp] * wst[stp][ sst[stp]+1 ];
west[ stp ] := 0; est[ stp ] := 0; sst[ stp ] := 1;
## Do we need to reduce ev[ g ] ?
if IsBound( exp[g] ) and
( ev[g] < 0 or ev[ g ] >= exp[ g ]) then
ReduceExponentVector( ev, g );
fi;
## Check if we can collect a whole commuting word into ev[]. We
## can only do this if the word on the stack is normed.
## Therefore, we cannot do this for the first word on the stack.
elif (IsNormed or stp > 1) and sst[stp] = 1 and g = com[g] then
CombCollStats.WholeCommWord := CombCollStats.WholeCommWord + 1;
Info( InfoCombi, 5,
" collecting a whole word ",
wst[stp], "^", west[stp] );
## Collect word ^ exponent in one go.
AddIntoExponentVector( ev, wst[stp], sst[stp], west[stp] );
# ReduceExponentVector( ev, g );
## Adjust the stack.
west[ stp ] := 0;
est[ stp ] := 0;
sst[ stp ] := Length( wst[stp] ) - 1;
elif (IsNormed or stp > 1) and g = com[g] then
CombCollStats.CommRestWord := CombCollStats.CommRestWord + 1;
Info( InfoCombi, 5,
" collecting the rest of a word ",
wst[stp], "[", sst[stp], "]" );
## Here we must only add the word from g onwards.
AddIntoExponentVector( ev, wst[stp], sst[stp], 1 );
# ReduceExponentVector( ev, g );
# Adjust the stack.
est[ stp ] := 0;
sst[ stp ] := Length( wst[ stp ] ) - 1;
elif g = com[g] then
CombCollStats.CommGen := CombCollStats.CommGen + 1;
Info( InfoCombi, 5,
" collecting a commuting generators ",
g, "^", est[stp] );
## move generator directly to its correct position ...
ev[g] := ev[g] + est[stp];
## ... and reduce if necessary.
if IsBound( exp[g] ) and (ev[g] < 0 or ev[g] >= exp[g]) then
ReduceExponentVector( ev, g );
fi;
est[stp] := 0;
elif (IsNormed or stp > 1) and 3*wt[g] > class then
CombCollStats.ThreeWtGen := CombCollStats.ThreeWtGen + 1;
Info( InfoCombi, 5,
" collecting generator ", g, " with w(g)=", wt[g],
" and exponent ", est[stp] );
## Collect ^ without stacking commutators.
## This is step 6 in (Vaughan-Lee 1990).
for h in Reversed( [ g+1 .. com[g] ] ) do
if ev[h] > 0 and IsBound( cnj[h][g] ) then
AddIntoExponentVector( ev, cnj[h][g],
3, ev[h] * AbsInt(est[ stp ]) );
elif ev[h] < 0 and IsBound( icnj[h][g] ) then
AddIntoExponentVector( ev, icnj[h][g],
3, -ev[h] * AbsInt(est[ stp ]) );
fi;
od;
ReduceExponentVector( ev, astart );
ev[g] := ev[g] + est[ stp ];
est[ stp ] := 0;
## If the exponent is out of range, we have to stack up the
## entries of the exponent vector because the rhs of the
## power relation need not satisfy the weight condition.
if IsBound( exp[g] ) and (ev[g] < 0 or ev[g] >= exp[g] ) then
m := QuoInt( ev[g], exp[g] );
ev[g] := ev[g] - m * exp[g];
if ev[g] < 0 then
m := m - 1;
ev[g] := ev[g] + exp[g];
fi;
if IsBound(pow[g]) then
## Put entries of the exponent vector onto the stack
CombCollStats.ThreeWtGenStack := CombCollStats.ThreeWtGenStack + 1;
for i in Reversed( [g+1 .. com[g]] ) do
if ev[i] <> 0 then
stp := stp + 1;
## Can we use gen[i] here and put ev[i] onto
## est[]?
wst[stp] := [ i, ev[i] ];
west[stp] := 1;
sst[stp] := 1;
est[stp] := wst[stp][ sst[stp] + 1 ];
ev[i] := 0;
fi;
od;
## m must be 1, otherwise we cannot add the power
## relation into the exponent vector. Lets check.
if m <> 1 then
Error( "illegal add operation in collection" );
fi;
AddIntoExponentVector( ev, pow[g], 1, m );
## Start reducing from com[g] on because the entries
## before that have been put onto the stack and are
## now zero.
# ReduceExponentVector( ev, astart );
fi;
fi;
else ## we have to move step by step
CombCollStats.StepByStep := CombCollStats.StepByStep + 1;
Info( InfoCombi, 5, " else-case, generator ", g );
if est[ stp ] > 0 then
est[ stp ] := est[ stp ] - 1;
ev[ g ] := ev[ g ] + 1;
else
est[ stp ] := est[ stp ] + 1;
ev[ g ] := ev[ g ] - 1;
fi;
if IsNormed or stp > 1 then
## Do combinatorial collection as far as possible.
CombCollStats.CombColl := CombCollStats.CombColl + 1;
for h in Reversed( [com2[g]+1..com[g]] ) do
if ev[h] > 0 and IsBound( cnj[h][g] ) then
AddIntoExponentVector( ev, cnj[h][g], 3, ev[h] );
elif ev[h] < 0 and IsBound( icnj[h][g] ) then
AddIntoExponentVector( ev, icnj[h][g], 3, -ev[h] );
fi;
od;
# ReduceExponentVector( ev, astart );
h := com2[g];
else
h := com[g];
fi;
## Find the first position in v from where on ordinary
## collection has to be applied.
while h > g do
if ev[h] <> 0 and IsBound( cnj[h][g] ) then
break;
fi;
h := h - 1;
od;
## Stack up this part of v if we run through the next
## for-loop or if a power relation will be applied
if g < h or
IsBound( exp[g] ) and
(ev[g] < 0 or ev[g] >= exp[g]) and IsBound(pow[g]) then
if h+1 <= com[g] then
CombCollStats.CombCollStack := CombCollStats.CombCollStack + 1;
fi;
for j in Reversed( [h+1..com[g]] ) do
if ev[j] <> 0 then
stp := stp + 1;
## Can we use gen[h] here and put ev[h] onto
## est[]?
wst[stp] := [ j, ev[j] ];
west[stp] := 1;
sst[stp] := 1;
est[stp] := wst[stp][ sst[stp] + 1 ];
ev[j] := 0;
Info( InfoCombi, 5,
" Putting ", wst[ stp ], "^", west[stp],
" onto the stack" );
fi;
od;
fi;
## We finish with ordinary collection from the left.
if g <> h then
CombCollStats.OrdColl := CombCollStats.OrdColl + 1;
fi;
Info( InfoCombi, 5,
" Ordinary collection: g = ", g, ", h = ", h );
while g < h do
Info( InfoCombi, 5,
"Executing while loop with h = ", h );
if ev[h] <> 0 then
stp := stp + 1;
if ev[h] > 0 and IsBound( cnj[h][g] ) then
wst[stp] := cnj[h][g];
west[stp] := ev[h];
elif ev[h] < 0 and IsBound( icnj[h][g] ) then
wst[stp] := icnj[h][g];
west[stp] := -ev[h];
else ## Can we use gen[h] here and put ev[h]
## onto est[]?
wst[stp] := [ h, ev[h] ];
west[stp] := 1;
fi;
sst[stp] := 1;
est[stp] := wst[stp][ sst[stp]+1 ];
ev[h] := 0;
Info( InfoCombi, 5,
" Putting ", wst[ stp ], "^", west[stp],
" onto the stack" );
fi;
h := h - 1;
od;
## check that the exponent is not too big
if IsBound( exp[g] ) and (ev[g] < 0 or ev[g] >= exp[g]) then
m := ev[g] / exp[g];
ev[g] := ev[g] - m * exp[g];
if ev[g] < 0 then
m := m - 1;
ev[g] := ev[g] + exp[g];
fi;
if IsBound( pow[g] ) then
stp := stp + 1;
wst[stp] := pow[g];
west[stp] := m;
sst[stp] := 1;
est[stp] := wst[stp][ sst[stp]+1 ];
Info( InfoCombi, 5,
" Putting ", wst[ stp ], "^", west[stp],
" onto the stack" );
fi;
fi;
fi;
fi;
od;
return true;
end;
#############################################################################
##
## Methods for CollectWordOrFail.
##
InstallMethod( CollectWordOrFail,
"CombinatorialFromTheLeftCollector",
[ IsFromTheLeftCollectorRep and IsUpToDatePolycyclicCollector
and IsWeightedCollector,
IsList, IsList ],
function( pcp, a, b )
local aa, aaa;
if DEBUG_COMBINATORIAL_COLLECTOR then
aa := ShallowCopy(a);
aaa := ShallowCopy(a);
CombinatorialCollectPolycyclicGap( pcp, a, b );
CollectPolycyclicGap( pcp, aa, b );
if aa <> a then
Error( "combinatorial collection failed" );
fi;
else
CombinatorialCollectPolycyclicGap( pcp, a, b );
fi;
return true;
end );
polycyclic-2.16/gap/basic/pcpgrps.gd 0000644 0000766 0000024 00000002065 13706672341 016461 0 ustar mhorn staff #############################################################################
##
#W pcpgrps.gd Polycyc Bettina Eick
##
#############################################################################
##
## Declare pcp groups as groups of pcp elements.
##
DeclareSynonym( "IsPcpGroup", IsGroup and IsPcpElementCollection );
InstallTrueMethod( IsPolycyclicGroup, IsPcpGroup );
InstallTrueMethod( CanEasilySortElements, IsPcpGroup );
InstallTrueMethod( KnowsHowToDecompose, IsPcpGroup );
#############################################################################
##
## An igs/ngs/cgs is an attribute of a pcp group.
##
DeclareAttribute( "Igs", IsPcpGroup );
DeclareAttribute( "Ngs", IsPcpGroup );
DeclareAttribute( "Cgs", IsPcpGroup );
#############################################################################
##
## Some global functions
##
DeclareGlobalFunction( "PcpGroupByCollectorNC" );
DeclareGlobalFunction( "PcpGroupByCollector" );
DeclareGlobalFunction( "LinearActionOnPcp" );
DeclareGlobalFunction( "SubgroupByIgs" );
polycyclic-2.16/gap/basic/infos.gd 0000644 0000766 0000024 00000000750 13706672341 016120 0 ustar mhorn staff #############################################################################
##
#W infos.gd Polycyc Bettina Eick
##
#############################################################################
##
#I InfoClass
##
DeclareInfoClass( "InfoIntStab" ); # for the element orbit-stabilizer
DeclareInfoClass( "InfoIntNorm" ); # for the subgroup orbit-stabilizer
DeclareInfoClass( "InfoPcpGrp" ); # for all higher level functions
polycyclic-2.16/gap/README 0000644 0000766 0000024 00000001224 13706672341 014262 0 ustar mhorn staff
gap:
This directory contains the gap code to compute with infinite
polycyclic groups. It is splitted in various subdirectories:
matrix -- basic stuff for rational modules and related
basic -- basic stuff for pcp groups, collector etc.
cohom -- cohomology for pcp groups, complements and extensions
action -- actions of polycyclic groups and orbit-stabilizer methods
pcpgrp -- higher level functions for pcp groups
matrep -- computing a matrix representation for a pcp group
exam -- examples of pcp groups
Each directory has its own README file containing more information
about the various files containing the code.
polycyclic-2.16/gap/obsolete.gd 0000644 0000766 0000024 00000005372 13706672341 015542 0 ustar mhorn staff ############################################################################
##
## Polycyclic: Computation with polycyclic groups
## Copyright (C) 1999-2012 Bettina Eick
## Copyright (C) 1999-2007 Werner Nickel
## Copyright (C) 2010-2012 Max Horn
##
## This program is free software; you can redistribute it and/or
## modify it under the terms of the GNU General Public License
## as published by the Free Software Foundation; either version 2
## of the License, or (at your option) any later version.
##
## This program is distributed in the hope that it will be useful,
## but WITHOUT ANY WARRANTY; without even the implied warranty of
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
## GNU General Public License for more details.
##
## You should have received a copy of the GNU General Public License
## along with this program; if not, write to the Free Software
## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
##
#############################################################################
##
## <#GAPDoc Label="Obsolete">
## Over time, the interface of &Polycyclic; has changed. This
## was done to get the names of &Polycyclic; functions to agree with the
## general naming conventions used throughout GAP. Also, some &Polycyclic;
## operations duplicated functionality that was already available in
## the core of GAP under a different name. In these cases, whenever possible
## we now install the &Polycyclic; code as methods for the existing GAP
## operations instead of introducing new operations.
##
## For backward compatibility, we still provide the old, obsolete
## names as aliases. However, please consider switching to the new names
## as soon as possible. The old names may be completely removed at some
## point in the future.
##
## The following function names were changed.
##
## SchurCovering
## SchurMultPcpGroup
##
##
## - OLD
## - NOW USE
##
##
##
## - SchurCovering
##
##
##
## - SchurMultPcpGroup
##
##
##
## <#/GAPDoc>
DeclareSynonymAttr("SchurCovering", SchurCover);
#DeclareSynonymAttr("SchurExtensionEpimorphism", EpimorphismSchurExtension);
#DeclareSynonymAttr("NonAbelianExteriorSquareEpimorphism", EpimorphismNonabelianExteriorSquare);
#DeclareSynonymAttr("NonAbelianExteriorSquare", NonabelianExteriorSquare);
# The following does not use DeclareSynonymAttr on purpose
SchurMultPcpGroup := AbelianInvariantsMultiplier;
polycyclic-2.16/gap/action/ 0000755 0000766 0000024 00000000000 13706672341 014660 5 ustar mhorn staff polycyclic-2.16/gap/action/orbnorm.gi 0000644 0000766 0000024 00000053715 13706672341 016672 0 ustar mhorn staff #############################################################################
##
#W orbnorm.gi Polycyc Bettina Eick
##
## The orbit-stabilizer algorithm for subgroups of Z^d.
##
#############################################################################
##
#F Action function LatticeBases( base, mat )
##
OnLatticeBases := function( base, mat )
local imgs;
imgs := base * mat;
return NormalFormIntMat( imgs, 2 ).normal;
end;
#############################################################################
##
#F CheckNormalizer( G, S, linG, U )
##
CheckNormalizer := function( G, S, linG, U )
local linS, m, u, R;
# the trivial case
if Length( Pcp(G) ) = 0 then return true; fi;
# first check that S is stabilizing
linS := InducedByPcp( Pcp(G), Pcp(S), linG );
for m in linS do
for u in U do
if IsBool( PcpSolutionIntMat( U, u*m ) ) then return false; fi;
od;
od;
# now consider the random stabilizer
R := RandomPcpOrbitStabilizer( U, Pcp(G), linG, OnLatticeBases );
if ForAny( R.stab, x -> not x in S ) then return false; fi;
return true;
end;
#############################################################################
##
#F CheckConjugacy( G, g, linG, U, W )
##
CheckConjugacy := function( G, g, linG, U, W )
local m, u;
if Length( U ) <> Length( W ) then return IsBool( g ); fi;
if Length(Pcp(G)) = 0 then return U = W; fi;
m := InducedByPcp( Pcp(G), g, linG );
for u in U do
if IsBool( PcpSolutionIntMat( W, u*m ) ) then return false; fi;
od;
return true;
end;
#############################################################################
##
#F BasisOfNormalizingSubfield( baseK, baseU )
##
BasisOfNormalizingSubfield := function( baseK, baseU )
local d, e, baseL, i, syst, subs;
d := Length(baseK);
e := Length(baseU );
baseL := IdentityMat( d );
for i in [1..e] do
syst := List( baseK, x -> baseU[i] * x );
Append( syst, baseU );
subs := TriangulizedNullspaceMat( syst );
subs := subs{[1..Length(subs)]}{[1..d]};
baseL := SumIntersectionMat( baseL, subs )[2];
od;
return List( baseL, x -> LinearCombination( baseK, x ) );
end;
#############################################################################
##
#F NormalizerHomogeneousAction( G, linG, baseU ) . . . . . . . . . . . N_G(U)
##
## V is a homogenous G-module via linG (and thus linG spans a field).
## U is a subspace of V and baseU is an echelonised basis for U.
##
NormalizerHomogeneousAction := function( G, linG, baseU )
local K, baseK, baseL, L, exp, U, linU;
# check for trivial cases
if ForAll(linG, x -> x = x^0) or Length(baseU) = 0 or
Length(baseU) = Length(baseU[1]) then return G;
fi;
# get field
K := FieldByMatricesNC( linG );
baseK := BasisVectors( Basis( K ) );
# determine normalizing subfield and its units
baseL := BasisOfNormalizingSubfield( baseK, baseU );
L := FieldByMatrixBasisNC( baseL );
U := UnitGroup( L );
linU := GeneratorsOfGroup(U);
# find G cap L = G cap U as subgroup of G
exp := IntersectionOfUnitSubgroups( K, linG, linU );
return Subgroup( G, List( exp, x -> MappedVector( x, Pcp(G) ) ) );
end;
#############################################################################
##
#F ConjugatingFieldElement( baseK, baseU, baseW ) . . . . . . . . . U^k = W
##
ConjugatingFieldElement := function( baseK, baseU, baseW )
local d, e, baseL, i, syst, subs, k;
# compute the full space of conjugating elements
d := Length(baseK);
e := Length(baseW );
baseL := IdentityMat( d );
for i in [1..e] do
syst := List( baseK, x -> baseU[i] * x );
Append( syst, baseW );
subs := TriangulizedNullspaceMat( syst );
subs := subs{[1..Length(subs)]}{[1..d]};
baseL := SumIntersectionMat( baseL, subs )[2];
od;
# if baseL is empty, then there is no solution
if Length(baseL) = 0 then return false; fi;
# get one (integral) solution
k := baseL[Length(baseL)];
k := k * Lcm( List( k, DenominatorRat ) );
return LinearCombination( baseK, k );
end;
#############################################################################
##
#F ConjugacyHomogeneousAction( G, linG, baseU, baseW ) . . . . . . . U^g = W?
##
## V is a homogenous G-module via linG. U and W are subspaces of V with bases
## baseU and baseW, respectively. The function computes N_G(U) and U^g = W if
## g exists. If no g exists, then false is returned.
##
ConjugacyHomogeneousAction := function( G, linG, baseU, baseW )
local K, baseK, baseL, L, U, a, f, b, C, g, N, k, h;
# check for trivial cases
if Length(baseU) <> Length(baseW) then return false; fi;
if baseU = baseW then
return rec( norm := NormalizerHomogeneousAction( G, linG, baseU ),
conj := One(G) );
fi;
# get field - we need the maximal order in this case!
K := FieldByMatricesNC( linG );
baseK := BasisVectors( MaximalOrderBasis( K ) );
# determine conjugating field element
k := ConjugatingFieldElement( baseK, baseW, baseU );
if IsBool(k) then return false; fi;
h := k^-1;
# determine normalizing subfield
baseL := BasisOfNormalizingSubfield( baseK, baseU );
L := FieldByMatrixBasisNC( baseL );
# get norm and root
a := Determinant( k );
f := Length(baseK) / Length(baseL);
b := RootInt( a, f );
if b^f <> a then return false; fi;
# solve norm equation in L and sift
C := NormCosetsOfNumberField( L, b );
C := List( C, x -> x * h );
C := Filtered( C, x -> IsUnitOfNumberField( K, x ) );
if Length(C) = 0 then return false; fi;
# add unit group of L
U := GeneratorsOfGroup(UnitGroup(L));
C := rec( reprs := C, units := U{[2..Length(U)]} );
# find an element of G cap Lh in G
h := IntersectionOfTFUnitsByCosets( K, linG, C );
if IsBool( h ) then return false; fi;
g := MappedVector( h.repr, Pcp(G) );
N := Subgroup( G, List( h.ints, x -> MappedVector( x, Pcp(G) ) ) );
# that's it
return rec( norm := N, conj := g );
end;
#############################################################################
##
#F AffineActionAsTensor( linG, nath )
##
AffineActionAsTensor := function( linG, nath )
local actsF, actsS, affG, i, t, j, d, b;
# action on T / S for T = U + S and action on S
actsF := List(linG, x -> InducedActionFactorByNHLB(x, nath ));
actsS := List(linG, x -> InducedActionSubspaceByNHLB(x, nath ));
# determine affine action on H^1 wrt U
affG := [];
for i in [1..Length(linG)] do
# the linear part is the diagonal action on the tensor
t := KroneckerProduct( actsF[i], actsS[i] );
for j in [1..Length(t)] do Add( t[j], 0 ); od;
# the affine part is determined by the derivation wrt nath.factor
b := PreimagesBasisOfNHLB( nath );
d := (actsF[i]^-1 * b) * linG[i] - b;
d := Flat( List( d, x -> ProjectionByNHLB( x, nath ) ) );
Add( d, 1 );
Add( t, d );
# t is the affine action - store it
Add( affG, t );
od;
return affG;
end;
#############################################################################
##
#F DifferenceVector( base, nath )
##
## Determines the vector (s1, ..., se) with nath.factor[i]+si in base.
##
DifferenceVector := function( base, nath )
local b, k, f, v;
b := PreimagesBasisOfNHLB( nath );
k := KernelOfNHLB( nath );
f := Concatenation( k, base );
v := List(b, x -> PcpSolutionIntMat(f, x){[1..Length(k)]});
v := - Flat(v);
Add( v, 1 );
return v;
end;
#############################################################################
##
#F NormalizerComplement( G, linG, baseU, baseS ) . . . . . . . . . . . N_G(U)
##
## U and S are free abelian subgroups of V such that U cap S = 0. The group
## acts via linG on the full space V.
##
NormalizerComplement := function( G, linG, baseU, baseS )
local baseT, nathT, affG, e;
# catch the trivial cases
if Length(baseS)=0 or Length(baseU)=0 then return G; fi;
if ForAll( linG, x -> x = x^0 ) then return G; fi;
baseT := LatticeBasis( Concatenation( baseU, baseS ) );
nathT := NaturalHomomorphismByLattices( baseT, baseS );
# compute a stabilizer under the affine action
affG := AffineActionAsTensor( linG, nathT );
e := DifferenceVector( baseU, nathT );
return StabilizerIntegralAction( G, affG, e );
end;
#############################################################################
##
#F ConjugacyComplements( G, linG, baseU, baseW, baseS ) . . . . . . .U^g = W?
##
ConjugacyComplements := function( G, linG, baseU, baseW, baseS )
local baseT, nathT, affG, e, f, os;
# catch the trivial cases
if Length(baseU)<>Length(baseW) then return false; fi;
if baseU = baseW then return
rec( norm := NormalizerComplement( G, linG, baseU, baseS ),
conj := One(G) );
fi;
baseT := LatticeBasis( Concatenation( baseU, baseS ) );
nathT := NaturalHomomorphismByLattices( baseT, baseS );
# compute the stabilizer of (0,..,0,1) under an affine action
affG := AffineActionAsTensor( linG, nathT );
e := DifferenceVector( baseU, nathT );
f := DifferenceVector( baseW, nathT );
os := OrbitIntegralAction( G, affG, e, f );
if IsBool(os) then return os; fi;
return rec( norm := os.stab, conj := os.prei );
end;
#############################################################################
##
#F NormalizerCongruenceAction( G, linG, baseU, ser ) . . . . . . . . . N_G(U)
##
NormalizerCongruenceAction := function( G, linG, baseU, ser )
local V, S, i, d, linS, nath, indG, indS, U, M, I, H, subh, actS, T, F,
fach, UH, MH, s;
# catch a trivial case
if ForAll( linG, x -> x = x^0 ) then return G; fi;
if Length(baseU) = 0 then return G; fi;
# set up for induction over the module series
V := IdentityMat( Length(baseU[1]) );
S := G;
# use induction over the module series
for i in [1..Length(ser)-1] do
d := Length( ser[i] ) - Length( ser[i+1] );
Info( InfoIntNorm, 2, " ");
Info( InfoIntNorm, 2, " consider layer ", i, " of dim ",d);
# do a check
if Length(Pcp(S)) = 0 then return S; fi;
# induce to the current layer V/ser[i+1];
Info( InfoIntNorm, 2, " induce to current layer");
nath := NaturalHomomorphismByLattices( V, ser[i+1] );
indG := List( linG, x -> InducedActionFactorByNHLB( x, nath ) );
indS := InducedByPcp( Pcp(G), Pcp(S), indG );
U := LatticeBasis( List( baseU, x -> ImageByNHLB( x, nath ) ) );
M := LatticeBasis( List( ser[i], x -> ImageByNHLB( x, nath ) ) );
F := IdentityMat(Length(indG[1]));
# compute intersection
I := StructuralCopy( LatticeIntersection( U, M ) );
H := PurifyRationalBase( I );
# first, use the action on the module M
subh := NaturalHomomorphismByLattices( M, [] );
actS := List( indS, x -> InducedActionFactorByNHLB( x, subh ) );
I := LatticeBasis( List( I, x -> ImageByNHLB( x, subh ) ) );
Info( InfoIntNorm, 2, " normalize intersection ");
T := NormalizerHomogeneousAction( S, actS, I );
if Length(Pcp(T)) = 0 then return T; fi;
# reset action for the next step
if Index(S,T) <> 1 then
indS := InducedByPcp( Pcp(G), Pcp(T), indG );
fi;
S := T;
# next, consider the factor modulo the intersection hull H
if Length(F) > Length(H) then
fach := NaturalHomomorphismByLattices( F, H );
UH := LatticeBasis( List( U, x -> ImageByNHLB( x, fach ) ) );
MH := LatticeBasis( List( M, x -> ImageByNHLB( x, fach ) ) );
actS := List( indS, x -> InducedActionFactorByNHLB( x, fach ) );
Info( InfoIntNorm, 2, " normalize complement ");
T := NormalizerComplement( S, actS, UH, MH );
if Length(Pcp(T)) = 0 then return T; fi;
# again, reset action for the next step
if Index(S,T) <> 1 then
indS := InducedByPcp( Pcp(G), Pcp(T), indG );
fi;
S := T;
fi;
# finally, add a finite orbit-stabilizer computation
if H <> I then
Info( InfoIntNorm, 2, " add finite stabilizer computation");
s := PcpOrbitStabilizer( U, Pcp(S), indS, OnLatticeBases );
S := SubgroupByIgs( S, s.stab );
fi;
od;
Info( InfoIntNorm, 2, " ");
return S;
end;
#############################################################################
##
#F ConjugacyCongruenceAction( G, linG, baseU, baseW, ser ) . . . . . U^g = W?
##
ConjugacyCongruenceAction := function( G, linG, baseU, baseW, ser )
local V, S, g, i, d, linS, moveW, nath, indS, U, W, M, IU, IW, H, F,
subh, actS, s, UH, WH, MH, j, fach, indG;
# catch some trivial cases
if baseU = baseW then
return rec( norm := NormalizerCongruenceAction(G, linG, baseU, ser),
conj := One(G) );
fi;
if Length(baseU)<>Length(baseW) or ForAll( linG, x -> x = x^0 ) then
return false;
fi;
# set up
V := IdentityMat( Length(baseU[1]) );
S := G;
g := One( G );
# use induction over the module series
for i in [1..Length(ser)-1] do
d := Length( ser[i] ) - Length( ser[i+1] );
Info( InfoIntNorm, 2, " ");
Info( InfoIntNorm, 2, " consider layer ", i, " of dim ",d);
# get action of S on the full space
moveW := LatticeBasis( baseW * InducedByPcp( Pcp(G), g, linG )^-1 );
# do a check
if Length(Pcp(S))=0 and baseU<>moveW then return false; fi;
if Length(Pcp(S))=0 and baseU=moveW then
return rec( norm := S, conj := g );
fi;
# induce to the current layer V/ser[i+1];
Info( InfoIntNorm, 2, " induce to layer ");
nath := NaturalHomomorphismByLattices( V, ser[i+1] );
indG := List( linG, x -> InducedActionFactorByNHLB( x, nath ) );
indS := InducedByPcp( Pcp(G), Pcp(S), indG );
U := LatticeBasis( List( baseU, x -> ImageByNHLB( x, nath ) ) );
W := LatticeBasis( List( moveW, x -> ImageByNHLB( x, nath ) ) );
M := LatticeBasis( List( ser[i], x -> ImageByNHLB( x, nath ) ) );
F := IdentityMat(Length(indG[1]));
# get intersections
IU := LatticeIntersection( U, M );
IW := LatticeIntersection( W, M );
H := PurifyRationalBase( IU );
# first, use action on the module M
subh := NaturalHomomorphismByLattices( M, [] );
actS := List( indS, x -> InducedActionFactorByNHLB( x, subh ) );
IU := LatticeBasis( List( IU, x -> ImageByNHLB( x, subh ) ) );
IW := LatticeBasis( List( IW, x -> ImageByNHLB( x, subh ) ) );
Info( InfoIntNorm, 2, " conjugate intersections ");
s := ConjugacyHomogeneousAction( S, actS, IU, IW );
if IsBool(s) then return false; fi;
# reset action for next step
g := g * s.conj;
W := LatticeBasis( W * InducedByPcp( Pcp(G), s.conj, indG )^-1 );
if Index(S,s.norm)<>1 then
indS := InducedByPcp(Pcp(G),Pcp(s.norm),indG);
fi;
S := s.norm;
# next, consider factor modulo the intersection hull H
if Length(F) > Length(H) then
fach := NaturalHomomorphismByLattices( F, H );
UH := LatticeBasis( List( U, x -> ImageByNHLB( x, fach ) ) );
WH := LatticeBasis( List( W, x -> ImageByNHLB( x, fach ) ) );
MH := LatticeBasis( List( M, x -> ImageByNHLB( x, fach ) ) );
actS := List( indS, x -> InducedActionFactorByNHLB( x, fach ) );
Info( InfoIntNorm, 2, " conjugate complements ");
s := ConjugacyComplements( S, actS, UH, WH, MH );
if IsBool(s) then return false; fi;
# again, reset action
g := g * s.conj;
W := LatticeBasis( W * InducedByPcp( Pcp(G), s.conj, indG )^-1 );
if Index(S,s.norm)<>1 then
indS := InducedByPcp(Pcp(G),Pcp(s.norm),indG);
fi;
S := s.norm;
fi;
# finally, add a finite orbit-stabilizer computation
if H <> IU then
Info( InfoIntNorm, 2, " add finite stabilizer computation");
s := PcpOrbitStabilizer( U, Pcp(S), indS, OnLatticeBases );
j := Position( s.orbit, W );
if IsBool(j) then return false; fi;
g := g * TransversalElement( j, s, One(G) );
S := SubgroupByIgs( S, s.stab );
fi;
od;
Info( InfoIntNorm, 2, " ");
return rec( norm := S, conj := g );
end;
#############################################################################
##
#F NormalizerIntegralAction( G, linG, U ) . . . . . . . . . . . . . . .N_G(U)
##
# FIXME: This function is documented and should be turned into a GlobalFunction
NormalizerIntegralAction := function( G, linG, U )
local gensU, d, e, F, t, I, S, linS, K, linK, ser, T, orbf, N;
# catch a trivial case
if ForAll( linG, x -> x = x^0 ) then return G; fi;
# do a check
gensU := LatticeBasis( U );
if gensU <> U then Error("function needs lattice basis as input"); fi;
# get generators and check for trivial case
if Length( U ) = 0 then return G; fi;
d := Length( U[1] );
e := Length( U );
# compute modulo 3 first
Info( InfoIntNorm, 1, "reducing by orbit-stabilizer mod 3");
F := GF(3);
t := InducedByField( linG, F );
I := VectorspaceBasis( U * One(F) );
S := PcpOrbitStabilizer( I, Pcp(G), t, OnSubspacesByCanonicalBasis );
S := SubgroupByIgs( G, S.stab );
linS := InducedByPcp( Pcp(G), Pcp(S), linG );
# use congruence kernel
Info( InfoIntNorm, 1, "determining 3-congruence subgroup");
K := KernelOfFiniteMatrixAction( S, linS, F );
linK := InducedByPcp( Pcp(G), Pcp(K), linG );
# compute homogeneous series
Info( InfoIntNorm, 1, "computing module series");
ser := HomogeneousSeriesOfRationalModule( linG, linK, d );
ser := List( ser, x -> PurifyRationalBase(x) );
# get N_K(U)
Info( InfoIntNorm, 1, "adding stabilizer for congruence subgroup");
T := NormalizerCongruenceAction( K, linK, U, ser );
# set up orbit stabilizer function for K
orbf := function( K, actK, a, b )
local o;
o := ConjugacyCongruenceAction( K, actK, a, b, ser );
if IsBool(o) then return o; fi;
return o.conj;
end;
# add remaining stabilizer
Info( InfoIntNorm, 1, "constructing block orbit-stabilizer");
N := ExtendOrbitStabilizer( U, K, linK, S, linS, orbf, OnLatticeBases );
N := AddIgsToIgs( N.stab, Igs(T) );
N := SubgroupByIgs( G, N );
# do a temporary check
if CHECK_INTNORM@ then
Info( InfoIntNorm, 1, "checking results");
if not CheckNormalizer(G, N, linG, U) then
Error("wrong norm in integral action");
fi;
fi;
# now return
return N;
end;
#############################################################################
##
#F ConjugacyIntegralAction( G, linG, U, W ) . . . . . . . . . . . . .U^g = W?
##
## returns N_G(U) and g in G with U^g = W if g exists.
## returns false otherwise.
##
# FIXME: This function is documented and should be turned into a GlobalFunction
ConjugacyIntegralAction := function( G, linG, U, W )
local F, t, I, J, os, j, g, L, S, linS, K, linK, ser, orbf, h, T;
# do a check
if U <> LatticeBasis(U) or W <> LatticeBasis(W) then
Error("function needs lattice bases as input");
fi;
# catch some trivial cases
if U = W then
return rec( norm := NormalizerIntegralAction(G, linG, U),
prei := One( G ) );
fi;
if Length(U)<>Length(W) or ForAll( linG, x -> x = x^0 ) then
return false;
fi;
# compute modulo 3 first
Info( InfoIntNorm, 1, "reducing by orbit-stabilizer mod 3");
F := GF(3);
t := InducedByField( linG, F );
I := VectorspaceBasis( U * One(F) );
J := VectorspaceBasis( W * One(F) );
os := PcpOrbitStabilizer( I, Pcp(G), t, OnSubspacesByCanonicalBasis );
j := Position( os.orbit, J );
if IsBool(j) then return false; fi;
g := TransversalElement( j, os, One(G) );
L := LatticeBasis( W * InducedByPcp( Pcp(G), g, linG )^-1 );
S := SubgroupByIgs( G, os.stab );
linS := InducedByPcp( Pcp(G), Pcp(S), linG );
# use congruence kernel
Info( InfoIntNorm, 1, "determining 3-congruence subgroup");
K := KernelOfFiniteMatrixAction( S, linS, F );
linK := InducedByPcp( Pcp(G), Pcp(K), linG );
# compute homogeneous series
Info( InfoIntNorm, 1, "computing module series");
ser := HomogeneousSeriesOfRationalModule( linG, linK, Length(U[1]) );
ser := List( ser, x -> PurifyRationalBase(x) );
# set up orbit stabilizer function for K
orbf := function( K, linK, a, b )
local o;
o := ConjugacyCongruenceAction( K, linK, a, b, ser );
if IsBool(o) then return o; fi;
return o.conj;
end;
# determine block orbit and stabilizer
Info( InfoIntNorm, 1, "constructing block orbit-stabilizer");
os := ExtendOrbitStabilizer( U, K, linK, S, linS, orbf, OnRight );
# get orbit element and preimage
j := FindPosition( os.orbit, L, K, linK, orbf );
if IsBool(j) then return false; fi;
h := TransversalElement( j, os, One(G) );
L := LatticeBasis( L * InducedByPcp( Pcp(G), h, linG )^-1 );
g := orbf( K, linK, U, L ) * h * g;
# get Stab_K(e) and thus Stab_G(e)
Info( InfoIntNorm, 1, "adding stabilizer for congruence subgroup");
T := NormalizerCongruenceAction( K, linK, U, ser );
t := AddIgsToIgs( os.stab, Igs(T) );
T := SubgroupByIgs( T, t );
# do a temporary check
if CHECK_INTNORM@ then
Info( InfoIntNorm, 1, "checking results");
if not CheckNormalizer( G, T, linG, U) then
Error("wrong norm in integral action");
elif not CheckConjugacy(G, g, linG, U, W) then
Error("wrong conjugate in integral action");
fi;
fi;
# now return
return rec( stab := T, prei := g );
end;
polycyclic-2.16/gap/action/freegens.gi 0000644 0000766 0000024 00000004453 13706672341 017005 0 ustar mhorn staff #############################################################################
##
#W freegens.gi Polycyclic Pakage Bettina Eick
##
## Compute minimal generating sets for abelian mat groups in various
## situations.
##
#############################################################################
##
#F FreeGensByRelationMat( gens, mat ) . . . . . . . . . use smith normal form
##
FreeGensByRelationMat := function( gens, mat )
local S, H, Q, I, pos, i;
# first try to simplify mat
mat := ShallowCopy( mat );
Sort( mat, function( a, b ) return PositionNonZero(a) H[x][x] <> 1 );
return rec( gens := List( pos, x -> MappedVector( I[x], gens ) ),
rels := List( pos, x -> H[x][x] ),
imgs := I{pos},
prei := Q{[1..Length(gens)]}{pos} );
end;
#############################################################################
##
#F FreeGensByRelsAndOrders( gens, mat, ords ) . . . . . additional rel orders
##
FreeGensByRelsAndOrders := function( gens, mat, ords )
local idm, i;
# append orders to relation mat
mat := ShallowCopy( mat );
idm := IdentityMat( Length(gens) );
for i in [1..Length(ords)] do
Add( mat, ords[i] * idm[i] );
od;
# return
return FreeGensByRelationMat( gens, mat );
end;
#############################################################################
##
#F FreeGensByBasePcgs( pcgs )
##
FreeGensByBasePcgs := function( pcgs )
local pcss, rels, n, mat, i, e;
# set up
pcgs.revs := Reversed( pcgs.pcref );
pcss := PcSequenceBasePcgs( pcgs );
rels := RelativeOrdersBasePcgs( pcgs );
n := Length( pcss );
if n = 0 then return rec( gens := [], rels := [] ); fi;
# get relation matrix
mat := [];
for i in [1..n] do
e := ExponentsByBasePcgs( pcgs, pcss[i]^rels[i] );
e[i] := e[i] - rels[i];
Add( mat, e );
od;
# return
return FreeGensByRelationMat( pcss, mat );
end;
polycyclic-2.16/gap/action/extend.gi 0000644 0000766 0000024 00000012006 13706672341 016467 0 ustar mhorn staff #############################################################################
##
#W extend.gi Bettina Eick
##
#W Enlarge a base pcgs by normalizing elements.
##
#############################################################################
##
#F SubsWord( w, list ) . . . . . . . . . . . . . . . . . . .substitute a word
##
SubsWord := function( w, list )
local g, i;
g := list[1]^0;
for i in [1..Length(w)] do
g := g * list[w[i][1]]^w[i][2];
od;
return g;
end;
#############################################################################
##
#F SubsWordPlus( w, gens, invs, id ) . . . . . . . .use inverses and identity
##
SubsWordPlus := function( w, gens, invs, id )
local g, v;
g := id;
for v in w do
if v[2] = 1 then
g := g * gens[v[1]];
elif v[2] = -1 then
g := g * invs[v[1]];
elif v[2] > 1 then
g := g * gens[v[1]] ^ v[2];
elif v[2] < -1 then
g := g * invs[v[1]] ^ -v[2];
fi;
od;
return g;
end;
#############################################################################
##
#F SubsRecWord( w, list ) . . . . . . . . . . . . substitute a recursive word
##
SubsRecWord := function( w, list )
local g, v;
# catch the case of a single exponent
if Length(w) = 2 and IsInt( w[1] ) and IsInt( w[2] ) then
return list[w[1]]^w[2];
elif Length(w) = 2 and IsInt( w[2] ) and IsList( w[1] ) then
return SubsRecWord( w[1], list )^w[2];
fi;
# now deal with products
g := list[1]^0;
for v in w do
g := g * SubsRecWord( v, list );
od;
return g;
end;
#############################################################################
##
#F SubsAndInvertDefn( w, defns ) . . . . . . . . . . . .substitute and invert
##
SubsAndInvertDefn := function( w, defns )
local v, l;
v := [];
for l in w do
Add( v, [defns[l[1]], -l[2]] );
od;
return Reversed( v );
end;
#############################################################################
##
#F TransWord( j, trels ) . . . . . . . . . . . . . determine transversal word
##
TransWord := function( j, trels )
local l, g, s, p, t, w;
l := Product( trels );
j := j - 1;
w := [];
for s in Reversed( [1..Length( trels )] ) do
p := trels[s];
l := l/p;
t := QuoInt( j, l );
j := RemInt( j, l );
if t > 0 then Add( w, [s, t] ); fi;
od;
return Reversed( w );
end;
#############################################################################
##
#F EnlargeOrbit( orbit, g, p, op ) . . . . enlarge orbit by p images under g
##
EnlargeOrbit := function( orbit, g, p, op )
local l, s, k, t, h;
l := Length( orbit );
orbit[p*l] := true;
s := 0;
for k in [ 1 .. p - 1 ] do
t := s + l;
for h in [ 1 .. l ] do
orbit[h+t] := op( orbit[h+s], g );
od;
s := t;
od;
end;
#############################################################################
##
#F SmallOrbitPoint( pcgs, g )
##
SmallOrbitPoint := function( pcgs, g )
local b;
repeat
b := Random(pcgs.acton);
until pcgs.oper( b, g ) <> b;
return b;
end;
#############################################################################
##
#F ExtendedBasePcgs( pcgs, g, d ) . . . . . . . . . . . . extend a base pcgs
##
## g normalizes and we compute a new pcgs for .
##
ExtendedBasePcgs := function( pcgs, g, d )
local h, e, i, o, b, m, c, l, w, j, k;
# change in place - but unbind not updated information
Unbind(pcgs.pcgs);
Unbind(pcgs.rels);
# set up
h := g;
e := ShallowCopy( d );
i := 0;
# loop over base and divide off
while not pcgs.trivl( h ) do
i := i + 1;
# take base point (if necessary, add new base point)
if i > Length( pcgs.orbit ) then
b := SmallOrbitPoint( pcgs, g );
Add( pcgs.orbit, [b] );
Add( pcgs.trans, [] );
Add( pcgs.defns, [] );
Add( pcgs.trels, [] );
else
b := pcgs.orbit[i][1];
fi;
# compute the relative orbit length of h
m := 1;
c := pcgs.oper( b, h );
while not c in pcgs.orbit[i] do
m := m + 1;
c := pcgs.oper( c, h );
od;
# enlarge pcgs, if necessary
if m > 1 then
#Print(" enlarge basic orbit ",i," by ",m," copies \n");
Add( pcgs.trans[i], h );
Add( pcgs.defns[i], e );
Add( pcgs.trels[i], m );
EnlargeOrbit( pcgs.orbit[i], h, m, pcgs.oper );
Add( pcgs.pcref, [i, Length(pcgs.trans[i])] );
fi;
# divide off
j := Position( pcgs.orbit[i], c );
if j > 1 then
w := TransWord( j, pcgs.trels[i] );
h := h^m * SubsWord( w, pcgs.trans[i] )^-1;
e := [[e,m], SubsAndInvertDefn( w, pcgs.defns[i] ) ];
else
h := h^m;
e := [e,m];
fi;
od;
end;
polycyclic-2.16/gap/action/README 0000644 0000766 0000024 00000000743 13706672341 015544 0 ustar mhorn staff
gap/action:
Functions to compute with polycyclic groups acting on a set.
extend.gi -- extending a base pcgs for finite actions
basepcgs.gi -- computing a base pcgs for finite actions
freegens.gi -- multiplicatively independent generating sets
dixon.gi -- verify linear independence of abelian matrix gens
kernels.gi -- kernel of finite/congruence actions
orbstab.gi -- orbit stabilizer method for polycyclic groups
acting on elements of Z^d
polycyclic-2.16/gap/action/kernels.gi 0000644 0000766 0000024 00000024051 13706672341 016646 0 ustar mhorn staff #############################################################################
##
#W kernels.gi Polycyc Bettina Eick
##
#############################################################################
##
#F InducedByPcp( pcpG, pcpU, actG )
##
InducedByPcp := function( pcpG, pcpU, actG )
if IsMultiplicativeElement( pcpU ) then
return MappedVector( ExponentsByPcp( pcpG, pcpU ), actG );
fi;
if AsList(pcpU) = AsList(pcpG) then
return actG;
else
return List(pcpU, x-> MappedVector(ExponentsByPcp(pcpG,x),actG));
fi;
end;
#############################################################################
##
#W KernelOfFiniteMatrixAction( G, mats, f )
##
KernelOfFiniteMatrixAction := function( G, mats, f )
local d, I, U, i, actU, stab;
if Length( mats ) = 0 then return G; fi;
d := Length( mats[1] );
I := IdentityMat( d, f );
# loop over basis and stabilize each point
U := G;
for i in [1..d] do
actU := InducedByPcp( Pcp(G), Pcp(U), mats );
stab := PcpOrbitStabilizer( I[i], Pcp(U), actU, OnRight );
U := SubgroupByIgs( G, stab.stab );
od;
# that's it
return U;
end;
#############################################################################
##
#W KernelOfFiniteAction( G, pcp )
##
## If pcp defines an elementary abelian layer, then we compute the kernel
## of the action of G. If pcp is free abelian, then we compute the kernel
## of the action mod 3.
##
KernelOfFiniteAction := function( G, pcp )
local rels, p, f, pcpG, actG;
# get the char and the field
rels := RelativeOrdersOfPcp( pcp );
p := rels[1];
if p = 0 then p := 3; fi;
f := GF(p);
# get the action of G on pcp
pcpG := Pcp(G);
actG := LinearActionOnPcp( pcpG, pcp );
actG := InducedByField( actG, f );
# centralize
return KernelOfFiniteMatrixAction( G, actG, f );
end;
#############################################################################
##
#F RelationLatticeMod( gens, f )
##
RelationLatticeMod := function( gens, f )
local mats, l, pcgs, free, r, defn, g, e, null, base, i;
# induce to f
mats := InducedByField( gens, f );
l := Length( mats );
# compute independent gens
pcgs := BasePcgsByPcFFEMatrices( mats );
free := FreeGensByBasePcgs( pcgs );
r := Length( free.gens );
if r = 0 then return IdentityMat(l); fi;
# set up relation system
defn := [];
for g in mats do
e := ExponentsByBasePcgs( pcgs, g );
Add( defn, e * free.prei );
od;
# solve it mod relative orders
null := NullspaceMatMod( defn, free.rels );
# determine lattice basis
base := NormalFormIntMat( null, 2 ).normal;
base := Filtered( base, x -> PositionNonZero(x) <= l );
## do a temporary check
#for i in [1..Length(base)] do
# if not MappedVector( base[i], mats ) = mats[1]^0 then
# Error("found non-relation");
# fi;
#od;
return base;
end;
#############################################################################
##
#F IsRelation( mats, rel ) . . . . . . . .check if rel is a relation for mats
##
IsRelation := function( mats, rel )
local M1, M2, i;
M1 := mats[1]^0;
M2 := mats[1]^0;
for i in [1..Length(mats)] do
if rel[i] > 0 then
M1 := M1*mats[i]^rel[i];
elif rel[i] < 0 then
M2 := M2*mats[i]^-rel[i];
fi;
od;
return M1 = M2;
end;
#############################################################################
##
#F ApproxRelationLattice( mats, k, p ). . . . . . . . . k step approximation
##
ApproxRelationLattice := function( mats, k, p )
local lat, i, new, ind, len;
# set up
lat := IdentityMat( Length(mats) );
# compute new lattices and intersect
for i in [1..k] do
p := NextPrimeInt(p);
new := RelationLatticeMod( mats, GF(p) );
lat := LatticeIntersection( lat, new );
od;
# find short vectors
lat := LLLReducedBasis( lat ).basis;
# did we find any relations?
for i in [1..Length(lat)] do
if not IsRelation( mats, lat[i] ) then lat[i] := false; fi;
od;
return rec( rels := Filtered( lat, x -> not IsBool(x) ), prime := p );
end;
#############################################################################
##
#F VerifyIndependence( mats )
##
VerifyIndependence := function( mats )
local base, prim, dixn, done, L, p, i, N, w, d;
if Length( mats ) = 1 and mats[1] <> mats[1]^0 then return true; fi;
Print(" verifying linear independence \n");
base := AlgebraBase( mats );
d := Length( base );
Print(" got ", Length( mats ), " generators and dimension ", d,"\n");
if Length( mats ) >= d then return false; fi;
prim := PrimitiveAlgebraElement( mats, base );
Print(" computing dixon bound \n");
dixn := Length(mats[1]) * LogDixonBound( mats, prim )^2;
Print(" found ", dixn, "\n");
done := false;
# set up
L := IdentityMat( Length(mats) );
p := 1;
while not done do
Print(" next step verification \n");
# compute new lattices and intersect
for i in [1..d] do
p := NextPrimeInt(p);
N := RelationLatticeMod( mats, GF(p) );
L := LatticeIntersection( L, N );
od;
# find short vectors
L := LLLReducedBasis( L ).basis;
w := Minimum( List( L, x -> x * x ) );
Print(" got shortest vector ", w, "\n");
# check dixon bound
if w > dixn then return true; fi;
# check rels
for i in [1..Length(L)] do
if IsRelation( mats, L[i] ) then return false; fi;
od;
od;
end;
#############################################################################
##
#W KernelOfCongruenceMatrixActionGAP( G, mats ) . . G acts as ss cong subgrp
##
## Warning: G must be integral!
##
KernelOfCongruenceMatrixActionGAP := function( G, mats )
local p, U, pcp, K, gens, acts, rell, tmps;
# set up
p := 1;
U := DerivedSubgroup(G);
pcp := Pcp( G );
# now loop
repeat
K := U;
gens := Pcp( G, K );
acts := InducedByPcp( pcp, gens, mats );
rell := ApproxRelationLattice( acts, Length(acts[1]), p );
tmps := List( rell.rels, x -> MappedVector( x, gens ) );
tmps := AddToIgs( DenominatorOfPcp( gens ), tmps );
U := SubgroupByIgs( G, tmps );
p := rell.prime;
until Index( G, U ) = 1 or Index( U, K ) = 1;
# verify if desired
if Index( G, U ) > 1 and VERIFY@ then
gens := Pcp( G, U );
acts := InducedByPcp( pcp, gens, mats );
if not VerifyIndependence( acts ) then
Error(" generators are not linearly independent");
fi;
fi;
# that's it
return U;
end;
#############################################################################
##
#F KernelOfCongruenceMatrixActionALNUTH( G, mats ) . G acts as ss cong subgrp
##
KernelOfCongruenceMatrixActionALNUTH := function( G, mats )
local H, base, prim, fact, full, f, s, h, imats, F, rels, gens;
# the trivial case
if ForAll( mats, x -> x^0 = x ) then return G; fi;
# split into irreducibles
base := AlgebraBase( mats );
prim := PrimitiveAlgebraElement( base, List( base, Flat ) );
fact := Factors( prim.poly );
# catch the trivial case first - for increased efficiency
if Length(fact) = 1 then
F := FieldByMatricesNC( mats );
SetPrimitiveElement( F, prim.elem );
SetDefiningPolynomial( F, prim.poly );
rels := RelationLatticeOfTFUnits( F, mats );
return Subgroup( G, List( rels, x -> MappedVector( x, Pcp(G) ) ) );
fi;
# loop over subspaces
full := mats[1]^0;
gens := AsList( Pcp(G) );
H := G;
for f in fact do
# induce matrices if necessary
if Index( G, H ) > 1 then
mats := List( rels, x -> MappedVector( x, mats ) );
G := H;
fi;
# get subspace
s := NullspaceRatMat( Value( f, prim.elem ) );
h := NaturalHomomorphismBySemiEchelonBases( full, s );
# induce to factor
imats := List( mats, x -> InducedActionSubspaceByNHSEB( x, h ) );
if ForAny( imats, x -> x <> x^0 ) then
F := FieldByMatricesNC( mats );
SetPrimitiveElement( F, prim.elem );
SetDefiningPolynomial( F, prim.poly );
# compute kernel
rels := RelationLatticeOfTFUnits( F, imats );
# set up for iteration
gens := List( rels, x -> MappedVector( x, gens ) );
H := Subgroup( G, gens );
fi;
od;
# that's it
return H;
end;
#############################################################################
##
#F KernelOfCongruenceMatrixAction( G, mats ) . . . . . . . . header function
##
KernelOfCongruenceMatrixAction := function( G, mats )
if ForAll( mats, x -> x = x^0 ) then return G; fi;
if USE_ALNUTH@ then
return KernelOfCongruenceMatrixActionALNUTH( G, mats );
else
return KernelOfCongruenceMatrixActionGAP( G, mats );
fi;
end;
#############################################################################
##
#F KernelOfCongruenceAction( G, pcp ) . . . . . . . .G acts as ss cong subgrp
##
KernelOfCongruenceAction := function( G, pcp )
local mats;
mats := LinearActionOnPcp( Pcp(G), pcp );
return KernelOfCongruenceMatrixAction( G, mats );
end;
#############################################################################
##
#F MemberByCongruenceMatrixAction( G, mats, m ) . . G acts as irr cong subgrp
##
## So far, this works only if G is an integral group.
##
MemberByCongruenceMatrixAction := function( G, mats, m )
local F, r, e;
# get field
F := FieldByMatricesNC( mats );
# check whether m is a unit in F
if not IsUnitOfNumberField( F, m ) then return false; fi;
# check if m is in G
r := RelationLatticeOfTFUnits( F, Concatenation( [m], mats ) )[1];
if PositionNonZero( r ) > 1 or AbsInt( r[1] ) <> 1 then return false; fi;
# now translate to G
e := -r{[2..Length(r)]} * r[1];
return MappedVector( e, Pcp(G) );
end;
polycyclic-2.16/gap/action/basepcgs.gi 0000644 0000766 0000024 00000014606 13706672341 016777 0 ustar mhorn staff #############################################################################
##
#W basepcgs.gi Bettina Eick
##
#W A base pcgs is a pcgs with attached base and strong generating set.
#W It is a record consisting of:
#W .orbit and .trans and .trels - the base and strong gen set
#W .acton and .oper and .trivl - the domain to act on and the action
#W .pcref - the reference to a pcgs
##
#############################################################################
##
#F BasePcgsByPcSequence( pcs, dom, trv, oper )
##
## pcs is a sequence of normalizing elements, dom is the domain they act
## on, trv is a function to decide when an element is trivial, oper is the
## operation of pcs on dom. (If trv is boolean, then a standard trv function
## is used.)
##
BasePcgsByPcSequence := function( pcs, dom, trv, oper )
local pcgs, i;
if IsBool( trv ) then trv := function( x ) return x = x^0; end; fi;
pcgs := rec( orbit := [], trans := [], trels := [], defns := [],
pcref := [],
acton := dom, oper := oper, trivl := trv );
for i in Reversed( [1..Length(pcs)] ) do
ExtendedBasePcgs( pcgs, pcs[i], [i,1] );
od;
return pcgs;
end;
#############################################################################
##
#F BasePcgsByPcFFEMatrices( gens )
##
BasePcgsByPcFFEMatrices := function( gens )
local f, d, pcgs;
# triviality check
if Length(gens) = 0 then
return BasePcgsByPcSequence( gens, false, false, OnRight );
fi;
# set up
f := Field( gens[1][1][1] );
d := Length( gens[1] );
# compute pcgs, add preimages and return
pcgs := BasePcgsByPcSequence( gens, f^d, false, OnRight );
pcgs.gens := gens;
return pcgs;
end;
#############################################################################
##
#F BasePcgsByPcIntMatrices( gens, f )
##
BasePcgsByPcIntMatrices := function( gens, f )
local d, news, pcgs;
# triviality check
if Length(gens) = 0 then
return BasePcgsByPcSequence( gens, false, false, OnRight );
fi;
# change field and compute
d := Length( gens[1] );
news := InducedByField( gens, f );
pcgs := BasePcgsByPcSequence( news, f^d, false, OnRight );
pcgs.gens := gens;
pcgs.field := f;
return pcgs;
end;
#############################################################################
##
#F RelativeOrdersBasePcgs( pcgs )
##
RelativeOrdersBasePcgs := function( pcgs )
local t;
if IsBound( pcgs.rels ) then return pcgs.rels; fi;
pcgs.rels := [];
for t in Reversed( pcgs.pcref ) do
Add( pcgs.rels, pcgs.trels[t[1]][t[2]] );
od;
return pcgs.rels;
end;
#############################################################################
##
#F PcSequenceBasePcgs( pcgs )
##
PcSequenceBasePcgs := function( pcgs )
local t;
if IsBound( pcgs.pcgs ) then return pcgs.pcgs; fi;
pcgs.pcgs := [];
for t in Reversed( pcgs.pcref ) do
Add( pcgs.pcgs, pcgs.trans[t[1]][t[2]] );
od;
return pcgs.pcgs;
end;
#############################################################################
##
#F DefinitionsBasePcgs( pcgs )
##
DefinitionsBasePcgs := function( pcgs )
local defn, t;
defn := [];
for t in Reversed( pcgs.pcref ) do
Add( defn, pcgs.defns[t[1]][t[2]] );
od;
return defn;
end;
#############################################################################
##
#F GeneratorsBasePcgs( pcgs )
##
GeneratorsBasePcgs := function( pcgs )
return pcgs.gens;
end;
#############################################################################
##
#F SiftByBasePcgs( pcgs, g )
##
SiftByBasePcgs := function( pcgs, g )
local h, w, i, j;
h := g;
for i in [1..Length(pcgs.orbit)] do
j := Position( pcgs.orbit[i], pcgs.oper( pcgs.orbit[i][1], h ) );
if IsBool( j ) then return h; fi;
if j > 1 then
w := TransWord( j, pcgs.trels[i] );
h := h * SubsWord( w, pcgs.trans[i] )^-1;
fi;
od;
return h;
end;
#############################################################################
##
#F SiftExponentsByBasePcgs( pcgs, g )
##
SiftExponentsByBasePcgs := function( pcgs, g )
local h, w, e, i, j;
h := g;
e := List( pcgs.orbit, x -> 0 );
for i in [1..Length(pcgs.orbit)] do
if pcgs.trivl( h ) then return e; fi;
j := Position( pcgs.orbit[i], pcgs.oper( pcgs.orbit[i][1], h ) );
if IsBool( j ) then return false; fi;
if j > 1 then
w := TransWord( j, pcgs.trels[i] );
h := h * SubsWord( w, pcgs.trans[i] )^-1;
fi;
e[i] := j-1;
od;
if pcgs.trivl( h ) then return e; fi;
return false;
end;
#############################################################################
##
#F BasePcgsElementBySiftExponents( pcgs, exp )
##
BasePcgsElementBySiftExponents := function( pcgs, exp )
local g, w, i;
g := pcgs.trans[1][1]^0;
for i in Reversed( [1..Length(exp)] ) do
if exp[i] > 0 then
w := TransWord( exp[i]+1, pcgs.trels[i] );
g := SubsWord( w, pcgs.trans[i] ) * g;
fi;
od;
return g;
end;
#############################################################################
##
#F MemberTestByBasePcgs( pcgs, g )
##
MemberTestByBasePcgs := function( pcgs, g )
return pcgs.trivl( SiftByBasePcgs( pcgs,g ) );
end;
#############################################################################
##
#F WordByBasePcgs( pcgs, g )
##
WordByBasePcgs := function( pcgs, g )
local w, h, i, j, t;
w := List( pcgs.orbit, x -> [] );
h := g;
for i in [1..Length(pcgs.orbit)] do
j := Position( pcgs.orbit[i], pcgs.orbit[i][1] * h );
if j > 1 then
t := TransWord( j, pcgs.trels[i] );
t := List( t, x -> [Position( pcgs.revs, [i,x[1]] ), x[2]] );
h := h * SubsWord( t, pcgs.pcgs )^-1;
w[i] := t;
fi;
od;
return Concatenation( Reversed( w ) );
end;
#############################################################################
##
#F ExponentsByBasePcgs( pcgs, g )
##
## This function gives useful results for abelian groups only.
##
ExponentsByBasePcgs := function( pcgs, g )
local n, w, e, s;
n := Length( PcSequenceBasePcgs( pcgs ) );
w := WordByBasePcgs( pcgs, g );
e := List( [1..n], x -> 0 );
for s in w do
e[s[1]] := e[s[1]] + s[2];
od;
return e;
end;
polycyclic-2.16/gap/action/orbstab.gi 0000644 0000766 0000024 00000053053 13706672341 016643 0 ustar mhorn staff #############################################################################
##
#W orbstab.gi Polycyc Bettina Eick
##
## The orbit-stabilizer algorithm for elements of Z^d.
##
#############################################################################
##
#F CheckStabilizer( G, S, mats, v )
##
CheckStabilizer := function( G, S, mats, v )
local actS, m, R;
# first check that S is stabilizing
actS := InducedByPcp( Pcp(G), Pcp(S), mats );
for m in actS do if v*m <> v then return false; fi; od;
# now consider the random stabilizer
R := RandomPcpOrbitStabilizer( v, Pcp(G), mats, OnRight );
if ForAny( R.stab, x -> not x in S ) then return false; fi;
return true;
end;
#############################################################################
##
#F CheckOrbit( G, g, mats, e, f )
##
CheckOrbit := function( G, g, mats, e, f )
return e * InducedByPcp( Pcp(G), g, mats ) = f;
end;
#############################################################################
##
#F OrbitStabilizerTranslationAction( K, derK ) . . . . . for transl. subgroup
##
OrbitStabilizerTranslationAction := function( K, derK )
local base, gens, orbit, trans, stabl;
# the first case is that image is trivial
if ForAll( derK, x -> x = 0*x ) then
return rec( stabl := K, trans := [], orbit := [] );
fi;
# now compute orbit in standart form
gens := AsList( Pcp(K) );
base := FreeGensAndKernel( derK );
if Length( base.kern ) > 0 then
base.kern := NormalFormIntMat( base.kern, 2 ).normal;
fi;
# set up result
orbit := base.free;
trans := List( base.trsf, x -> MappedVector( x, gens ) );
stabl := List( base.kern, x -> MappedVector( x, gens ) );
return rec( stabl := stabl, trans := trans, orbit := orbit );
end;
#############################################################################
##
#F InducedDerivation( g, G, linG, derG ) . . . . . . . . . value of derG on g
##
InducedDerivation := function( g, G, linG, derG )
local pcp, exp, der, i, e, j, inv;
pcp := Pcp( G );
exp := ExponentsByPcp( pcp, g );
der := 0 * derG[1];
for i in [1..Length(exp)] do
e := exp[i];
if linG[i] = linG[i]^0 then
der := der + e*derG[i];
elif e > 0 then
for j in [1..e] do
der := der * linG[i] + derG[i];
od;
elif e < 0 then
inv := linG[i]^-1;
for j in [1..-e] do
der := (der - derG[i]) * inv;
od;
fi;
od;
return der;
end;
#############################################################################
##
#F StabilizerIrreducibleAction( G, K, linG, derG ) . . . . . . kernel of derG
##
StabilizerIrreducibleAction := function( G, K, linG, derG )
local derK, stabK, OnAffMod, affG, e, h, H, gens, i, f, k;
# catch the trivial case first
if ForAll( derG, x -> x = 0 * x ) then return G; fi;
# now we are in a non-trivial case - compute derivations of K
derK := List( Pcp(K), x -> InducedDerivation( x, G, linG, derG ) );
# compute orbit and stabilizer under K
stabK := OrbitStabilizerTranslationAction( K, derK );
Info( InfoIntStab, 3, " translation orbit: ", stabK.orbit);
# if derK = 0, then K is the kernel
if Length( stabK.orbit ) = 0 then return K; fi;
# define affine action
OnAffMod := function( pt, aff )
local im;
im := pt * aff[1] + aff[2];
return VectorModLattice( im, stabK.orbit );
end;
# use finite orbit stabilizer to determine block-stab
affG := List( [1..Length(linG)], x -> [linG[x], derG[x]] );
e := derG[1] * 0;
h := PcpOrbitStabilizer( e, Pcp(G), affG, OnAffMod ).stab;
H := SubgroupByIgs( G, h );
Info( InfoIntStab, 3, " finite orbit has length ", Index(G,H));
# now we have to compute the complement
gens := ShallowCopy( AsList( Pcp( H, K ) ) );
for i in [1..Length( gens )] do
f := InducedDerivation( gens[i], G, linG, derG );
e := MemberBySemiEchelonBase( f, stabK.orbit );
k := MappedVector( e, stabK.trans );
gens[i] := gens[i] * k^-1;
od;
Info( InfoIntStab, 3, " determined complement ");
gens := AddIgsToIgs( gens, stabK.stabl );
return SubgroupByIgs( G, gens );
end;
#############################################################################
##
#F OrbitIrreducibleActionTrivialKernel( G, K, linG, derG, v ) . v^g in derG?
##
## returns an element g in G with v^g in derG and ker(derG) if g exists.
## returns false otherwise.
##
OrbitIrreducibleActionTrivialKernel := function( G, K, linG, derG, v )
local I, d, lin, der, g, t, a, m;
# set up
I := linG[1]^0;
d := Length(I);
# compute basis of Q[G] and corresponding derivations
lin := StructuralCopy(linG);
der := StructuralCopy(derG);
while RankMat(der) < d do
g := Random(G);
t := InducedDerivation( g, G, linG, derG );
if t <> 0 * t and IsBool( SolutionMat( der, t ) ) then
Add( der, t );
Add( lin, InducedByPcp( Pcp(G), g, linG ) );
fi;
od;
# find linear combination
a := SolutionMat( der, v );
if IsBool( a ) then Error("derivations do not span"); fi;
# translate combination
m := Sum(List( [1..Length(a)], x -> a[x] * (lin[x] - I))) + I;
# check if a preimage of m is in g
g := MemberByCongruenceMatrixAction( G, linG, m );
# now return
if IsBool( g ) then return false; fi;
return rec( stab := K, prei := g );
end;
#############################################################################
##
#F OrbitIrreducibleAction( G, K, linG, derG, v ) . . . . . . . . v^g in derG?
##
## returns an element g in G with v^g in derG and ker(derG) if g exists.
## returns false otherwise.
##
OrbitIrreducibleAction := function( G, K, linG, derG, v )
local derK, stabK, I, a, m, g, OnAffMod, affG, e, h, i, c, k, H, f, gens,
found, w;
# catch some trivial cases first
if v = 0 * v then
return rec( stab := StabilizerIrreducibleAction( G, K, linG, derG ),
prei := One(G) );
fi;
if ForAll( derG, x -> x = 0 * x ) then return false; fi;
# now we are in a non-trivial case - compute derivations of K
derK := List( Pcp(K), x -> InducedDerivation( x, G, linG, derG ) );
# compute orbit and stabilizer under K
stabK := OrbitStabilizerTranslationAction( K, derK );
Info( InfoIntStab, 3, " translation orbit: ", stabK.orbit);
# if derK = 0, then K is the kernel and g is a linear combination
if Length( stabK.orbit ) = 0 then
return OrbitIrreducibleActionTrivialKernel( G, K, linG, derG, v );
fi;
# define affine action
OnAffMod := function( pt, aff )
local im;
im := pt * aff[1] + aff[2];
return VectorModLattice( im, stabK.orbit );
end;
# use finite orbit stabilizer to determine block-stab
affG := List( [1..Length(linG)], x -> [linG[x], derG[x]] );
e := derG[1] * 0;
h := PcpOrbitStabilizer( e, Pcp(G), affG, OnAffMod );
H := SubgroupByIgs( G, h.stab );
# get preimage
found := false; i := 0;
while not found and i < Length( h.orbit ) do
i := i + 1;
c := PcpSolutionIntMat( stabK.orbit, v-h.orbit[i] );
if not IsBool( c ) then
g := TransversalElement( i, h, One(G) );
w := InducedDerivation( g, G, linG, derG );
c := PcpSolutionIntMat( stabK.orbit, v-w);
k := MappedVector( c, stabK.trans );
g := g * k;
found := true;
fi;
od;
if not found then return false; fi;
# get stabilizer as complement
gens := ShallowCopy( AsList( Pcp( H, K ) ) );
for i in [1..Length( gens )] do
f := InducedDerivation( gens[i], G, linG, derG );
e := MemberBySemiEchelonBase( f, stabK.orbit );
k := MappedVector( e, stabK.trans );
gens[i] := gens[i] * k^-1;
od;
gens := AddToIgs( stabK.stabl, gens );
return rec( stab := SubgroupByIgs( G, gens ), prei := g);
end;
#############################################################################
##
#F StabilizerCongruenceAction( G, mats, e, ser )
##
StabilizerCongruenceAction := function( G, mats, e, ser )
local S, d, actS, derS, nath, K, T, actT, derT, full, subs, bas, tak,
act, der, U, f, comp, i, inv;
# catch the trivial case
if ForAll( mats, x -> e * x = e ) then return G; fi;
# set up
S := G;
# now use induction on this series
for i in [1..Length(ser)-1] do
d := Length( ser[i] ) - Length( ser[i+1] );
Info( InfoIntStab, 2, " consider layer ", i, " of dim ",d);
# reset
actS := InducedByPcp( Pcp(G), Pcp(S), mats );
derS := List( actS, x -> e*x - e );
# get layer
nath := NaturalHomomorphismByLattices( ser[i], ser[i+1] );
actS := List( actS, x -> InducedActionFactorByNHLB( x, nath ) );
derS := List( derS, x -> ImageByNHLB( x, nath ) );
# the current layer is a semisimple S-module -- get kernel
Info( InfoIntStab, 2, " computing kernel of linear action");
K := KernelOfCongruenceMatrixAction( S, actS );
# set up for iteration
T := S; actT := actS; derT := derS;
full := IdentityMat(d);
subs := RefineSplitting( actT, [full] );
subs := List( subs, PurifyRationalBase );
comp := [];
# now loop over irreducible submodules and compute stab T
while Length(subs)>0 do
Info( InfoIntStab, 2, " layer: ", List(subs,Length));
bas := Concatenation(subs); Append(bas, comp); inv := bas^-1;
tak := Remove(subs, 1); f := Length(tak); Append(comp, tak);
act := List(actT, x -> bas*x*inv);
act := List(act, x -> x{[1..f]}{[1..f]});
der := List(derT, x -> x*inv);
der := List(der, x -> x{[1..f]});
# stabilize
U := StabilizerIrreducibleAction( T, K, act, der );
# reset
if Index(T,U) > 1 then
T := SubgroupByIgs( G, Cgs(U) );
K := NormalIntersection( K, T );
actT := InducedByPcp( Pcp(S), Pcp(T), actS );
derT := List(Pcp(T),x->InducedDerivation(x, S, actS, derS));
if Length(subs) > 0 then
subs := RefineSplitting( actT, subs );
subs := List( subs, PurifyRationalBase );
fi;
fi;
# do a check
if Length( Pcp( T ) ) = 0 then return T; fi;
od;
S := T;
od;
return S;
end;
#############################################################################
##
#F OrbitCongruenceAction := function( G, mats, e, f, ser )
##
## returns Stab_G(e) and g in G with e^g = f if g exists.
## returns false otherwise.
##
OrbitCongruenceAction := function( G, mats, e, f, ser )
local S, d, actS, derS, nath, K, T, actT, derT, full, subs, bas, tak,
act, der, U, j, comp, g, t, o, u, inv, i;
# catch some trivial cases
if e = f then
return rec( stab := StabilizerCongruenceAction(G, mats, e, ser),
prei := One( G ) );
fi;
if RankMat( [e,f] ) = 1 or ForAll( mats, x -> e*x = e) then
return false;
fi;
# set up
S := G;
g := One( G );
# now use induction on this series
for i in [1..Length(ser)-1] do
d := Length( ser[i] ) - Length( ser[i+1] );
Info( InfoIntStab, 2, " consider layer ", i, " with dim ",d);
# reset
actS := InducedByPcp( Pcp(G), Pcp(S), mats );
derS := List( actS, x -> e*x - e );
# get layer
nath := NaturalHomomorphismBySemiEchelonBases( ser[i], ser[i+1] );
actS := List( actS, x -> InducedActionFactorByNHSEB( x, nath ) );
derS := List( derS, x -> ImageByNHSEB( x, nath ) );
# the current layer is a semisimple S-module -- get kernel
Info( InfoIntStab, 2, " computing kernel of linear action");
K := KernelOfCongruenceMatrixAction( S, actS );
# set up for iteration
T := S; actT := actS; derT := derS;
full := IdentityMat( Length(actS[1]) );
subs := RefineSplitting( actT, [full] );
subs := List(subs, PurifyRationalBase );
comp := [];
# now loop over irreducible submodules and compute stab T
while Length( subs ) > 0 do
Info( InfoIntStab, 2, " layer: ", List(subs,Length));
bas := Concatenation(subs); Append(bas, comp); inv := bas^-1;
tak := Remove(subs, 1); j := Length(tak); Append(comp, tak);
act := List(actT, x -> bas*x*inv);
act := List(act, x -> x{[1..j]}{[1..j]});
der := List(derT, x -> x*inv);
der := List(der, x -> x{[1..j]});
# set up element and do a check
t := InducedByPcp(Pcp(G), g, mats)^-1;
u := f*t-e;
if Length(Pcp(T)) = 0 and u = 0*u then
return rec( stab := T, prei := g );
elif Length(Pcp(T)) = 0 then
return false;
fi;
# induce to layer
u := ImageByNHSEB( u, nath ) * inv;
u := u{[1..j]};
# find preimage h with u = h^der if it exists
o := OrbitIrreducibleAction( T, K, act, der, u );
if IsBool(o) then return false; fi;
g := o.prei * g;
U := o.stab;
# reset
if Index(T, U) > 1 then
T := SubgroupByIgs(G, Cgs(U));
K := NormalIntersection( K, T );
actT := InducedByPcp( Pcp(S), Pcp(T), actS );
derT := List(Pcp(T), x->InducedDerivation(x, S, actS, derS));
if Length(subs) > 0 then
subs := RefineSplitting( actT, subs );
subs := List( subs, PurifyRationalBase );
fi;
fi;;
od;
S := T;
od;
return rec( stab := S, prei := g );
end;
#############################################################################
##
#F FindPosition( orbit, pt, K, actK, orbfun )
##
FindPosition := function( orbit, pt, K, actK, orbfun )
local j, k;
for j in [1..Length(orbit)] do
k := orbfun( K, actK, pt, orbit[j] );
if not IsBool( k ) then return j; fi;
od;
return false;
end;
#############################################################################
##
#F ExtendOrbitStabilizer( e, K, actK, S, actS, orbfun, op )
##
## K has finite index in S and and orbfun solves the orbit problem for K.
##
ExtendOrbitStabilizer := function( e, K, actK, S, actS, orbfun, op )
local gens, rels, mats, orbit, trans, trels, stab, i, f, j, n, t, s, g;
# get action
gens := Pcp(S,K);
rels := RelativeOrdersOfPcp( gens );
mats := InducedByPcp( Pcp(S), gens, actS );
# set up
orbit := [e];
trans := [];
trels := [];
stab := [];
# construct orbit and stabilizer
for i in Reversed( [1..Length(gens)] ) do
# get new point
f := op( e, mats[i] );
j := FindPosition( orbit, f, K, actK, orbfun );
# if it is new, add all blocks
n := orbit;
t := [];
s := 1;
while IsBool( j ) do
n := List( n, x -> op( x, mats[i] ) );
Append( t, n );
j := FindPosition( orbit, op( n[1], mats[i]), K, actK, orbfun );
s := s + 1;
od;
# add to orbit
Append( orbit, t );
# add to transversal
if s > 1 then
Add( trans, gens[i]^-1 );
Add( trels, s );
fi;
# compute stabiliser element
if rels[i] = 0 or s < rels[i] then
g := gens[i]^s;
if j > 1 then
t := TransversalInverse(j, trels);
g := g * SubsWord( t, trans );
fi;
f := op( e, InducedByPcp( Pcp(S), g, actS ) );
g := g * orbfun( K, actK, f, e );
Add( stab, g );
fi;
od;
return rec( stab := Reversed( stab ), orbit := orbit,
trels := trels, trans := trans );
end;
#############################################################################
##
#F StabilizerModPrime( G, mats, e, p )
##
StabilizerModPrime := function( G, mats, e, p )
local F, t, S;
F := GF(p);
t := InducedByField( mats, F );
S := PcpOrbitStabilizer( e*One(F), Pcp(G), t, OnRight );
return SubgroupByIgs( G, S.stab );
end;
#############################################################################
##
#F StabilizerIntegralAction( G, mats, e ) . . . . . . . . . . . . . Stab_G(e)
##
# FIXME: This function is documented and should be turned into a GlobalFunction
StabilizerIntegralAction := function( G, mats, e )
local p, S, actS, K, actK, T, stab, ser, orbf;
# reduce e
e := e / Gcd( e );
# catch the trivial case
if ForAll( mats, x -> e*x = e ) then return G; fi;
# compute modulo 3 first
S := G;
actS := mats;
for p in USED_PRIMES@ do
Info( InfoIntStab, 1, "reducing by stabilizer mod ",p);
T := StabilizerModPrime( S, actS, e, p );
Info( InfoIntStab, 1, " obtained reduction by ",Index(S,T));
S := T;
actS := InducedByPcp( Pcp(G), Pcp(S), mats );
od;
# use congruence kernel
Info( InfoIntStab, 1, "determining 3-congruence subgroup");
K := KernelOfFiniteMatrixAction( S, actS, GF(3) );
actK := InducedByPcp( Pcp(G), Pcp(K), mats );
Info( InfoIntStab, 1, " obtained subgroup of index ",Index(S,K));
# compute homogeneous series
Info( InfoIntStab, 1, "computing module series");
ser := HomogeneousSeriesOfRationalModule( mats, actK, Length(e) );
ser := List( ser, x -> PurifyRationalBase(x) );
# get Stab_K(e)
Info( InfoIntStab, 1, "adding stabilizer for congruence subgroup");
T := StabilizerCongruenceAction( K, actK, e, ser );
# set up orbit stabilizer function for K
orbf := function( K, actK, a, b )
local o;
o := OrbitCongruenceAction( K, actK, a, b, ser );
if IsBool(o) then return o; fi;
return o.prei;
end;
# compute block stabilizer
Info( InfoIntStab, 1, "constructing block orbit-stabilizer");
stab := ExtendOrbitStabilizer( e, K, actK, S, actS, orbf, OnRight );
Info( InfoIntStab, 1, " obtained ",Length(stab.orbit)," blocks");
stab := AddIgsToIgs( stab.stab, Igs(T) );
stab := SubgroupByIgs( G, stab );
# do a temporary check
if CHECK_INTSTAB@ then
Info( InfoIntStab, 1, "checking results");
if not CheckStabilizer(G, stab, mats, e) then
Error("wrong stab in integral action");
fi;
fi;
# now return
return stab;
end;
#############################################################################
##
#F OrbitIntegralAction( G, mats, e, f ) . . . . . . . . . . . . . . .e^g = f?
##
## returns Stab_G(e) and g in G with e^g = f if g exists.
## returns false otherwise.
##
# FIXME: This function is documented and should be turned into a GlobalFunction
OrbitIntegralAction := function( G, mats, e, f )
local c, F, t, os, j, g, S, actS, K, actK, ser, orbf, h, T, l;
# reduce e and f
c := Gcd(e); e := e/c; f := f/c;
if not ForAll( f, IsInt ) or AbsInt(Gcd(f)) <> 1 then return false; fi;
# catch some trivial cases
if e = f then
return rec( stab := StabilizerIntegralAction(G, mats, e),
prei := One( G ) );
fi;
if RankMat( [e,f] ) = 1 or ForAll( mats, x -> e*x = e) then
return false;
fi;
# compute modulo 3 first
Info( InfoIntStab, 1, "reducing by orbit-stabilizer mod 3");
F := GF(3);
t := InducedByField( mats, F );
os := PcpOrbitStabilizer( e*One(F), Pcp(G), t, OnRight );
j := Position( os.orbit, f*One(F) );
if IsBool(j) then return false; fi;
# extract infos
g := TransversalElement( j, os, One(G) );
l := f * InducedByPcp( Pcp(G), g, mats )^-1;
S := SubgroupByIgs( G, os.stab );
actS := InducedByPcp( Pcp(G), Pcp(S), mats );
# use congruence kernel
Info( InfoIntStab, 1, "determining 3-congruence subgroup");
K := KernelOfFiniteMatrixAction( S, actS, F );
actK := InducedByPcp( Pcp(G), Pcp(K), mats );
# compute homogeneous series
Info( InfoIntStab, 1, "computing module series");
ser := HomogeneousSeriesOfRationalModule( mats, actK, Length(e) );
ser := List( ser, x -> PurifyRationalBase(x) );
# set up orbit stabilizer function for K
orbf := function( K, actK, a, b )
local o;
o := OrbitCongruenceAction( K, actK, a, b, ser );
if IsBool(o) then return o; fi;
return o.prei;
end;
# determine block orbit and stabilizer
Info( InfoIntStab, 1, "constructing block orbit-stabilizer");
os := ExtendOrbitStabilizer( e, K, actK, S, actS, orbf, OnRight );
# get orbit element and preimage
j := FindPosition( os.orbit, l, K, actK, orbf );
if IsBool(j) then return false; fi;
h := TransversalElement( j, os, One(G) );
l := l * InducedByPcp( Pcp(S), h, actS )^-1;
g := orbf( K, actK, e, l ) * h * g;
# get Stab_K(e) and thus Stab_G(e)
Info( InfoIntStab, 1, "adding stabilizer for congruence subgroup");
T := StabilizerCongruenceAction( K, actK, e, ser );
t := AddIgsToIgs( os.stab, Igs(T) );
T := SubgroupByIgs( T, t );
# do a temporary check
if CHECK_INTSTAB@ then
Info( InfoIntStab, 1, "checking results");
if not CheckStabilizer(G, T, mats, e) then
Error("wrong stab in integral action");
elif not CheckOrbit(G, g, mats, e, f) then
Error("wrong orbit in integral action");
fi;
fi;
# now return
return rec( stab := T, prei := g );
end;
polycyclic-2.16/gap/action/dixon.gi 0000644 0000766 0000024 00000012252 13706672341 016324 0 ustar mhorn staff #############################################################################
##
#W dixon.gi Bettina Eick
##
## Determine Dixon's Bound for torsion free semisimple matrix groups.
##
#############################################################################
##
#F PadicValue( rat, p )
##
PadicValue := function( rat, p )
local a1, a2;
a1 := AbsInt( NumeratorRat(rat) );
a2 := DenominatorRat(rat);
a1 := Length( Filtered( FactorsInt(a1), x -> x = p ) );
a2 := Length( Filtered( FactorsInt(a2), x -> x = p ) );
return a1 - a2;
end;
#############################################################################
##
#F LogAbsValueBound( rat )
##
LogAbsValueBound := function( rat )
local a1, a2, a;
a1 := LogInt( AbsInt( NumeratorRat(rat) ), 2 );
a2 := LogInt( DenominatorRat(rat), 2 );
a := Maximum( AbsInt( a1 - a2 + 1 ), AbsInt( a1 - a2 - 1) );
return QuoInt( a * 3, 4 );
end;
#############################################################################
##
#F ConsideredPrimes( rats )
##
ConsideredPrimes := function( rats )
local pr, r, a1, a2, tmp;
pr := [];
for r in rats do
a1 := AbsInt( NumeratorRat(r) );
a2 := DenominatorRat(r);
if a1 <> 1 then
tmp := FactorsInt( a1: RhoTrials := 1000000 );
pr := Union( pr, tmp );
fi;
if a2 <> 1 then
tmp := FactorsInt( a2: RhoTrials := 1000000 );
pr := Union( pr, tmp );
fi;
od;
return pr;
end;
#############################################################################
##
#F CoefficientsByBase( base, vec )
##
CoefficientsByBase := function( base, vec )
local sol;
sol := MemberBySemiEchelonBase( vec, base.vectors );
if IsBool( sol ) then return fail; fi;
return sol * base.coeffs;
end;
#############################################################################
##
#F FullDixonBound( gens, prim )
##
FullDixonBound := function( gens, prim )
local c, f, j, n, d, minp, sub, max, cof, deg, base, cofs, dofs,
g, pr, t1, p, s, i, a, b, t2, t;
# set up
c := prim.elem;
f := prim.poly;
n := Length( gens );
d := Degree(f);
cof := CoefficientsOfUnivariatePolynomial( f );
if cof[1] <> 1 or cof[d+1] <> 1 then return fail; fi;
# get prim-basis
# Print("compute prim-base \n");
base := List([0..d-1], x -> Flat(c^x));
base := SemiEchelonMatTransformation( base );
# get coeffs of gens in prim-base
Print("compute coefficients \n");
cofs := [];
dofs := [];
for g in gens do
Add( cofs, CoefficientsByBase( base, Flat( g ) ) );
Add( dofs, CoefficientsByBase( base, Flat( g^-1 ) ) );
od;
Print("compute relevant primes \n");
pr := ConsideredPrimes( Flat( Concatenation( cofs, dofs ) ) );
# first consider p-adic case
Print("p-adic valuations \n");
t1 := 0;
for p in pr do
s := 0;
for i in [1..n] do
a := AbsInt( Minimum( List( cofs[i], x -> PadicValue(x,p) ) ) );
b := AbsInt( Minimum( List( dofs[i], x -> PadicValue(x,p) ) ) );
s := s + Maximum( a, b );
od;
t1 := Maximum( t1, s );
od;
t1 := d * t1;
Print("non-archimedian: ", t1,"\n");
# then the log-value
Print("logarithmic valuations \n");
t := Maximum( List( cof, x -> LogAbsValueBound( 1+AbsInt(x) ) ) );
t2 := 0;
for i in [1..n] do
if gens[i] = c then
t2 := t2 + t;
else
a := LogAbsValueBound( Sum( AbsInt( cofs[i] ) ) );
b := LogAbsValueBound( Sum( AbsInt( dofs[i] ) ) );
t2 := t2 + (d-1) * t + Maximum( a, b );
fi;
od;
t2 := QuoInt( 3 * 7 * d^2 * t2, 2 * LogInt(d,2) );
Print("archimedian: ", t2,"\n");
t := Maximum( t1, t2 );
return QuoInt( t^n + 1, t );
end;
#############################################################################
##
#F LogDixonBound( gens, prim )
##
LogDixonBound := function( gens, prim )
local c, f, d, base, cofs, dofs, g, t, s, i, a, b;
# set up
c := prim.elem;
f := CoefficientsOfUnivariatePolynomial( prim.poly );
d := Length( f ) - 1;
if f[1] <> 1 or f[d+1] <> 1 then return fail; fi;
# get prim-basis
# Print("compute prim-base \n");
base := List([0..d-1], x -> Flat(c^x));
base := SemiEchelonMatTransformation( base );
# get coeffs of gens in prim-base
# Print("compute coefficients \n");
cofs := [];
dofs := [];
for g in gens do
Add( cofs, CoefficientsByBase( base, Flat( g ) ) );
Add( dofs, CoefficientsByBase( base, Flat( g^-1 ) ) );
od;
# get log-value
# Print("logarithmic valuation \n");
t := Maximum( List( f, x -> LogAbsValueBound( 1+AbsInt(x) ) ) );
s := 0;
for i in [1..Length(gens)] do
if gens[i] = c then
s := s + t;
else
a := LogAbsValueBound( Sum( AbsInt( cofs[i] ) ) );
b := LogAbsValueBound( Sum( AbsInt( dofs[i] ) ) );
s := s + (d-1) * t + Maximum( a, b );
fi;
od;
# now determine final value
t := 7 * d^2 * s / QuoInt( 2 * LogInt(d,2), 3 );
return QuoInt( t^Length(gens) + 1, t );
end;
polycyclic-2.16/gap/exam/ 0000755 0000766 0000024 00000000000 13706672341 014335 5 ustar mhorn staff polycyclic-2.16/gap/exam/nqlib.gi 0000644 0000766 0000024 00000076307 13706672341 016000 0 ustar mhorn staff #############################################################################
##
#W nqlib.gi Polycyc Werner Nickel
##
#############################################################################
##
#W NqExamples( n )
##
InstallGlobalFunction( NqExamples, function( n )
local NqF, NqColl;
if n = 1 then
NqF := FreeGroup( 24 );
NqColl := FromTheLeftCollector( NqF );
SetRelativeOrder( NqColl, 11, 5 );
SetRelativeOrder( NqColl, 12, 4 );
SetRelativeOrder( NqColl, 14, 5 );
SetRelativeOrder( NqColl, 15, 5 );
SetRelativeOrder( NqColl, 16, 4 );
SetRelativeOrder( NqColl, 18, 6 );
SetRelativeOrder( NqColl, 19, 5 );
SetRelativeOrder( NqColl, 20, 5 );
SetRelativeOrder( NqColl, 21, 4 );
SetRelativeOrder( NqColl, 23, 10 );
SetRelativeOrder( NqColl, 24, 6 );
SetPower( NqColl, 11, NqF.19^2*NqF.20^4*NqF.21^2*NqF.22^4*NqF.24^4 );
SetPower( NqColl, 12, NqF.13^2*NqF.15*NqF.16^3*NqF.17^-6*NqF.18^4*\
NqF.19^3*NqF.21^3*NqF.22^12*NqF.23^8*NqF.24^4 );
SetPower( NqColl, 16, NqF.17^2*NqF.20*NqF.21^3*NqF.22^-6*NqF.24^4 );
SetPower( NqColl, 18, NqF.23*NqF.24^4 );
SetPower( NqColl, 21, NqF.22^2 );
SetPower( NqColl, 23, NqF.24^2 );
SetConjugate( NqColl, 2, 1, NqF.2*NqF.3 );
SetConjugate( NqColl, 2, -1, NqF.2*NqF.3^-1*NqF.4*NqF.5^-1*NqF.6*NqF.7*\
NqF.8^-3*NqF.9^10*NqF.10^-1*NqF.11*NqF.13^5*NqF.14^4*NqF.15*NqF.16^2*NqF.17^-23*\
NqF.18^5*NqF.19^2*NqF.20^2*NqF.21*NqF.22^54*NqF.23^5*NqF.24 );
SetConjugate( NqColl, -2, 1, NqF.2^-1*NqF.3^-1 );
SetConjugate( NqColl, -2, -1, NqF.2^-1*NqF.3*NqF.4^-1*NqF.5*NqF.6^-1*NqF.9^3*\
NqF.11^2*NqF.12^2*NqF.13^-1*NqF.14^2*NqF.18^5*NqF.19*NqF.20^3*NqF.21^3*\
NqF.22^-2 );
SetConjugate( NqColl, 3, 1, NqF.3*NqF.4 );
SetConjugate( NqColl, 3, -1, NqF.3*NqF.4^-1*NqF.5*NqF.6^-1*NqF.9^3*NqF.11^2*\
NqF.12^2*NqF.13^-1*NqF.14^2*NqF.18^5*NqF.19*NqF.20^3*NqF.21^3*NqF.22^-2 );
SetConjugate( NqColl, -3, 1, NqF.3^-1*NqF.4^-1*NqF.7^-1*NqF.8^2*NqF.9^-7*\
NqF.10*NqF.11^4*NqF.12*NqF.13^-6*NqF.14^3*NqF.16^2*NqF.17^19*NqF.19*NqF.20^3*\
NqF.22^-50*NqF.23^4 );
SetConjugate( NqColl, -3, -1, NqF.3^-1*NqF.4*NqF.5^-1*NqF.6*NqF.7*NqF.8^-3*\
NqF.9^10*NqF.10^-1*NqF.11*NqF.13^5*NqF.14^4*NqF.15*NqF.16^2*NqF.17^-23*\
NqF.18^5*NqF.19^2*NqF.20^2*NqF.21*NqF.22^54*NqF.23^5*NqF.24 );
SetConjugate( NqColl, 3, 2, NqF.3 );
SetConjugate( NqColl, 3, -2, NqF.3 );
SetConjugate( NqColl, -3, 2, NqF.3^-1 );
SetConjugate( NqColl, -3, -2, NqF.3^-1 );
SetConjugate( NqColl, 4, 1, NqF.4*NqF.5 );
SetConjugate( NqColl, 4, -1, NqF.4*NqF.5^-1*NqF.6*NqF.14^3*NqF.21^2*NqF.22^-1 );
SetConjugate( NqColl, -4, 1, NqF.4^-1*NqF.5^-1*NqF.9^-3*NqF.12^2*NqF.13^-1*\
NqF.14*NqF.15^4*NqF.16^3*NqF.17^3*NqF.18^3*NqF.19^4*NqF.20*NqF.21^2*NqF.22^-10*\
NqF.24^5 );
SetConjugate( NqColl, -4, -1, NqF.4^-1*NqF.5*NqF.6^-1*NqF.9^3*NqF.11^2*\
NqF.12^2*NqF.13^-1*NqF.14^2*NqF.18^5*NqF.19*NqF.20^3*NqF.21^3*NqF.22^-2 );
SetConjugate( NqColl, 4, 2, NqF.4*NqF.7*NqF.8^-2*NqF.9^7*NqF.10^-1*NqF.11*\
NqF.13^4*NqF.14^2*NqF.15*NqF.16^2*NqF.17^-18*NqF.18^5*NqF.19*NqF.20*NqF.21*\
NqF.22^42*NqF.23^5*NqF.24^2 );
SetConjugate( NqColl, 4, -2, NqF.4*NqF.7^-1*NqF.8^2*NqF.9^-7*NqF.10^2*\
NqF.11^4*NqF.12*NqF.13^-6*NqF.14^3*NqF.15^3*NqF.16^3*NqF.17^20*NqF.18*NqF.20^3*\
NqF.22^-52*NqF.24^4 );
SetConjugate( NqColl, -4, 2, NqF.4^-1*NqF.7^-1*NqF.8^2*NqF.9^-7*NqF.10*\
NqF.11^4*NqF.12*NqF.13^-6*NqF.14^3*NqF.16^2*NqF.17^19*NqF.19*NqF.20^3*NqF.22^-50*\
NqF.23^4 );
SetConjugate( NqColl, -4, -2, NqF.4^-1*NqF.7*NqF.8^-2*NqF.9^7*NqF.10^-2*\
NqF.11*NqF.12^2*NqF.13^6*NqF.14^2*NqF.16^2*NqF.17^-21*NqF.18^2*NqF.19*NqF.20^2*\
NqF.21^3*NqF.22^48*NqF.23^2*NqF.24^4 );
SetConjugate( NqColl, 4, 3, NqF.4*NqF.7^-1*NqF.8^2*NqF.9^-7*NqF.10^2*\
NqF.11^4*NqF.12*NqF.13^-6*NqF.14^3*NqF.15^3*NqF.16^3*NqF.17^20*NqF.18*NqF.20^3*\
NqF.22^-52*NqF.24^4 );
SetConjugate( NqColl, 4, -3, NqF.4*NqF.7*NqF.8^-2*NqF.9^7*NqF.10^-1*NqF.11*\
NqF.13^4*NqF.14^2*NqF.15*NqF.16^2*NqF.17^-18*NqF.18^5*NqF.19*NqF.20*NqF.21*\
NqF.22^42*NqF.23^5*NqF.24^2 );
SetConjugate( NqColl, -4, 3, NqF.4^-1*NqF.7*NqF.8^-2*NqF.9^7*NqF.10^-2*\
NqF.11*NqF.12^2*NqF.13^6*NqF.14^2*NqF.16^2*NqF.17^-21*NqF.18^2*NqF.19*NqF.20^2*\
NqF.21^3*NqF.22^48*NqF.23^2*NqF.24^4 );
SetConjugate( NqColl, -4, -3, NqF.4^-1*NqF.7^-1*NqF.8^2*NqF.9^-7*NqF.10*\
NqF.11^4*NqF.12*NqF.13^-6*NqF.14^3*NqF.16^2*NqF.17^19*NqF.19*NqF.20^3*NqF.22^-50*\
NqF.23^4 );
SetConjugate( NqColl, 5, 1, NqF.5*NqF.6 );
SetConjugate( NqColl, 5, -1, NqF.5*NqF.6^-1 );
SetConjugate( NqColl, -5, 1, NqF.5^-1*NqF.6^-1*NqF.14^2*NqF.21^2*NqF.22^-1 );
SetConjugate( NqColl, -5, -1, NqF.5^-1*NqF.6*NqF.14^3*NqF.21^2*NqF.22^-1 );
SetConjugate( NqColl, 5, 2, NqF.5*NqF.7 );
SetConjugate( NqColl, 5, -2, NqF.5*NqF.7^-1*NqF.10^3*NqF.12^2*NqF.13^-6*\
NqF.15*NqF.16^3*NqF.17^12*NqF.18*NqF.20^2*NqF.21^2*NqF.22^-28*NqF.23^9 );
SetConjugate( NqColl, -5, 2, NqF.5^-1*NqF.7^-1*NqF.15^4*NqF.16^3*NqF.17^-3*\
NqF.19^3*NqF.20*NqF.21*NqF.22^4*NqF.23^3 );
SetConjugate( NqColl, -5, -2, NqF.5^-1*NqF.7*NqF.10^-3*NqF.12^2*NqF.13^4*\
NqF.15^4*NqF.16^3*NqF.17^-9*NqF.18*NqF.19^4*NqF.20^4*NqF.21*NqF.22^22*NqF.23^9*\
NqF.24^4 );
SetConjugate( NqColl, 5, 3, NqF.5*NqF.8^-1*NqF.9^5*NqF.11^3*NqF.12^3*\
NqF.13^-1*NqF.14^3*NqF.15*NqF.17^-4*NqF.18^4*NqF.19^4*NqF.22^8*NqF.23^9*\
NqF.24^3 );
SetConjugate( NqColl, 5, -3, NqF.5*NqF.8*NqF.9^-5*NqF.11^2*NqF.12^2*NqF.13^-2*\
NqF.14^2*NqF.15^2*NqF.16^3*NqF.17^10*NqF.18^3*NqF.19^4*NqF.20^3*NqF.21^3*\
NqF.22^-28*NqF.23*NqF.24^3 );
SetConjugate( NqColl, -5, 3, NqF.5^-1*NqF.8*NqF.9^-5*NqF.11^2*NqF.12*NqF.13^-1*\
NqF.14^2*NqF.15^3*NqF.16*NqF.17^8*NqF.18^4*NqF.19^2*NqF.20^2*NqF.21^3*NqF.22^-23*\
NqF.23*NqF.24^3 );
SetConjugate( NqColl, -5, -3, NqF.5^-1*NqF.8^-1*NqF.9^5*NqF.11^3*NqF.12^2*\
NqF.14^3*NqF.15^2*NqF.16^2*NqF.17^-8*NqF.18^5*NqF.20^4*NqF.21^3*NqF.22^15*\
NqF.23^9*NqF.24^5 );
SetConjugate( NqColl, 5, 4, NqF.5*NqF.9^-3*NqF.12^2*NqF.13^-1*NqF.14*\
NqF.15^4*NqF.16^3*NqF.17^3*NqF.18^3*NqF.19*NqF.20^2*NqF.21^3*NqF.22^-12*\
NqF.24^5 );
SetConjugate( NqColl, 5, -4, NqF.5*NqF.9^3*NqF.12^2*NqF.13^-1*NqF.14^4*\
NqF.16^2*NqF.17^-1*NqF.18^5*NqF.19^3*NqF.20^2*NqF.21*NqF.22^4*NqF.24^3 );
SetConjugate( NqColl, -5, 4, NqF.5^-1*NqF.9^3*NqF.12^2*NqF.13^-1*NqF.14^4*\
NqF.16^2*NqF.17^-1*NqF.18^5*NqF.19*NqF.20*NqF.22^6*NqF.24^3 );
SetConjugate( NqColl, -5, -4, NqF.5^-1*NqF.9^-3*NqF.12^2*NqF.13^-1*NqF.14*\
NqF.15^4*NqF.16^3*NqF.17^3*NqF.18^3*NqF.19^4*NqF.20*NqF.21^2*NqF.22^-10*\
NqF.24^5 );
SetConjugate( NqColl, 6, 1, NqF.6 );
SetConjugate( NqColl, 6, -1, NqF.6 );
SetConjugate( NqColl, -6, 1, NqF.6^-1 );
SetConjugate( NqColl, -6, -1, NqF.6^-1 );
SetConjugate( NqColl, 6, 2, NqF.6*NqF.8^2*NqF.9^-7*NqF.10*NqF.11^4*NqF.13^-4*\
NqF.14^3*NqF.15^4*NqF.16^2*NqF.17^16*NqF.18*NqF.19*NqF.20^3*NqF.22^-42*\
NqF.23^4*NqF.24^2 );
SetConjugate( NqColl, 6, -2, NqF.6*NqF.8^-2*NqF.9^7*NqF.10*NqF.11*NqF.12*\
NqF.14^2*NqF.15^3*NqF.17^-8*NqF.19^4*NqF.20*NqF.21^2*NqF.22^18*NqF.23^9*\
NqF.24^4 );
SetConjugate( NqColl, -6, 2, NqF.6^-1*NqF.8^-2*NqF.9^7*NqF.10^-1*NqF.11*\
NqF.13^4*NqF.14^2*NqF.15*NqF.16^2*NqF.17^-18*NqF.18^5*NqF.19^2*NqF.20^2*\
NqF.21^3*NqF.22^40*NqF.23^5*NqF.24^2 );
SetConjugate( NqColl, -6, -2, NqF.6^-1*NqF.8^2*NqF.9^-7*NqF.10^-1*NqF.11^4*\
NqF.12^3*NqF.13^-2*NqF.14^3*NqF.15*NqF.16*NqF.17^12*NqF.18^2*NqF.19*NqF.20^4*\
NqF.21^2*NqF.22^-34*NqF.23^2 );
SetConjugate( NqColl, 6, 3, NqF.6*NqF.9^2*NqF.11^3*NqF.12^2*NqF.13^-1*\
NqF.14^4*NqF.15*NqF.16*NqF.18^5*NqF.19^4*NqF.22^-2*NqF.23^7*NqF.24^5 );
SetConjugate( NqColl, 6, -3, NqF.6*NqF.9^-2*NqF.11^2*NqF.12^2*NqF.13^-1*\
NqF.14*NqF.15*NqF.16^2*NqF.17^4*NqF.18^3*NqF.20*NqF.22^-12*NqF.23^4 );
SetConjugate( NqColl, -6, 3, NqF.6^-1*NqF.9^-2*NqF.11^2*NqF.12^2*NqF.13^-1*\
NqF.14*NqF.15^3*NqF.17^4*NqF.18^3*NqF.19*NqF.22^-12*NqF.23^3*NqF.24 );
SetConjugate( NqColl, -6, -3, NqF.6^-1*NqF.9^2*NqF.11^3*NqF.12^2*NqF.13^-1*\
NqF.14^4*NqF.15^3*NqF.16^3*NqF.17^-2*NqF.18^5*NqF.20^3*NqF.21*NqF.22^2*\
NqF.23^6*NqF.24^2 );
SetConjugate( NqColl, 6, 4, NqF.6*NqF.11^2*NqF.14^3*NqF.16^2*NqF.17^-1*\
NqF.19^3*NqF.21^3*NqF.22^-2*NqF.24^5 );
SetConjugate( NqColl, 6, -4, NqF.6*NqF.11^3*NqF.14^2*NqF.16^2*NqF.17^-1*\
NqF.24^5 );
SetConjugate( NqColl, -6, 4, NqF.6^-1*NqF.11^3*NqF.14^2*NqF.16^2*NqF.17^-1*\
NqF.24^5 );
SetConjugate( NqColl, -6, -4, NqF.6^-1*NqF.11^2*NqF.14^3*NqF.16^2*NqF.17^-1*\
NqF.19^3*NqF.21^3*NqF.22^-2*NqF.24^5 );
SetConjugate( NqColl, 6, 5, NqF.6*NqF.14^2*NqF.21^2*NqF.22^-1 );
SetConjugate( NqColl, 6, -5, NqF.6*NqF.14^3*NqF.21^2*NqF.22^-1 );
SetConjugate( NqColl, -6, 5, NqF.6^-1*NqF.14^3*NqF.21^2*NqF.22^-1 );
SetConjugate( NqColl, -6, -5, NqF.6^-1*NqF.14^2*NqF.21^2*NqF.22^-1 );
SetConjugate( NqColl, 7, 1, NqF.7*NqF.8 );
SetConjugate( NqColl, 7, -1, NqF.7*NqF.8^-1*NqF.9*NqF.11^4*NqF.14*NqF.19^3*\
NqF.20*NqF.21^2*NqF.22^-6*NqF.24^2 );
SetConjugate( NqColl, -7, 1, NqF.7^-1*NqF.8^-1 );
SetConjugate( NqColl, -7, -1, NqF.7^-1*NqF.8*NqF.9^-1*NqF.11*NqF.14^4 );
SetConjugate( NqColl, 7, 2, NqF.7*NqF.10^3*NqF.12^2*NqF.13^-6*NqF.15*\
NqF.16^3*NqF.17^12*NqF.18^2*NqF.20^2*NqF.21^2*NqF.22^-28*NqF.23*NqF.24^4 );
SetConjugate( NqColl, 7, -2, NqF.7*NqF.10^-3*NqF.12^2*NqF.13^4*NqF.15^3*\
NqF.16^2*NqF.17^-10*NqF.18*NqF.19^2*NqF.20*NqF.21*NqF.22^22*NqF.23^2*NqF.24^4 );
SetConjugate( NqColl, -7, 2, NqF.7^-1*NqF.10^-3*NqF.12^2*NqF.13^4*NqF.15^3*\
NqF.16^2*NqF.17^-10*NqF.19^2*NqF.20*NqF.21*NqF.22^22*NqF.24^2 );
SetConjugate( NqColl, -7, -2, NqF.7^-1*NqF.10^3*NqF.12^2*NqF.13^-6*NqF.15*\
NqF.16^3*NqF.17^12*NqF.18*NqF.20^2*NqF.21^2*NqF.22^-28*NqF.23^9 );
SetConjugate( NqColl, 7, 3, NqF.7*NqF.10^-1*NqF.12*NqF.13^2*NqF.15^4*\
NqF.16^3*NqF.17^-6*NqF.18^3*NqF.19*NqF.21^3*NqF.22^12*NqF.23^7*NqF.24^4 );
SetConjugate( NqColl, 7, -3, NqF.7*NqF.10*NqF.12^3*NqF.13^-4*NqF.16^2*\
NqF.17^8*NqF.19*NqF.20^3*NqF.22^-18*NqF.23^8*NqF.24^4 );
SetConjugate( NqColl, -7, 3, NqF.7^-1*NqF.10*NqF.12^3*NqF.13^-4*NqF.16^2*\
NqF.17^8*NqF.18^5*NqF.19*NqF.20^3*NqF.22^-18*NqF.23^3*NqF.24^2 );
SetConjugate( NqColl, -7, -3, NqF.7^-1*NqF.10^-1*NqF.12*NqF.13^2*NqF.15^4*\
NqF.16^3*NqF.17^-6*NqF.18^2*NqF.19*NqF.21^3*NqF.22^12*NqF.23^3 );
SetConjugate( NqColl, 7, 4, NqF.7*NqF.12*NqF.13^-2*NqF.15^3*NqF.17^3*\
NqF.18^5*NqF.19^3*NqF.22^-8*NqF.23^4*NqF.24^2 );
SetConjugate( NqColl, 7, -4, NqF.7*NqF.12^3*NqF.15*NqF.16*NqF.17*NqF.18^3*\
NqF.19^4*NqF.20^4*NqF.21^2*NqF.22^-2*NqF.23^6*NqF.24^2 );
SetConjugate( NqColl, -7, 4, NqF.7^-1*NqF.12^3*NqF.15*NqF.16*NqF.17*NqF.18^3*\
NqF.19^4*NqF.20^4*NqF.21^2*NqF.22^-2*NqF.23^6*NqF.24^2 );
SetConjugate( NqColl, -7, -4, NqF.7^-1*NqF.12*NqF.13^-2*NqF.15^3*NqF.17^3*\
NqF.18^5*NqF.19^3*NqF.22^-8*NqF.23^4*NqF.24^2 );
SetConjugate( NqColl, 7, 5, NqF.7*NqF.15^4*NqF.16^3*NqF.17^-3*NqF.19^3*\
NqF.20*NqF.21*NqF.22^4*NqF.23^3 );
SetConjugate( NqColl, 7, -5, NqF.7*NqF.15*NqF.16*NqF.17*NqF.19^2*NqF.20^3*\
NqF.23^7 );
SetConjugate( NqColl, -7, 5, NqF.7^-1*NqF.15*NqF.16*NqF.17*NqF.19^2*NqF.20^3*\
NqF.23^7 );
SetConjugate( NqColl, -7, -5, NqF.7^-1*NqF.15^4*NqF.16^3*NqF.17^-3*NqF.19^3*\
NqF.20*NqF.21*NqF.22^4*NqF.23^3 );
SetConjugate( NqColl, 7, 6, NqF.7*NqF.19*NqF.20*NqF.21^2*NqF.22^-2 );
SetConjugate( NqColl, 7, -6, NqF.7*NqF.19^4*NqF.20^4*NqF.21^2 );
SetConjugate( NqColl, -7, 6, NqF.7^-1*NqF.19^4*NqF.20^4*NqF.21^2 );
SetConjugate( NqColl, -7, -6, NqF.7^-1*NqF.19*NqF.20*NqF.21^2*NqF.22^-2 );
SetConjugate( NqColl, 8, 1, NqF.8*NqF.9 );
SetConjugate( NqColl, 8, -1, NqF.8*NqF.9^-1*NqF.11*NqF.14^4 );
SetConjugate( NqColl, -8, 1, NqF.8^-1*NqF.9^-1 );
SetConjugate( NqColl, -8, -1, NqF.8^-1*NqF.9*NqF.11^4*NqF.14*NqF.19^3*NqF.20*\
NqF.21^2*NqF.22^-6*NqF.24^2 );
SetConjugate( NqColl, 8, 2, NqF.8*NqF.10 );
SetConjugate( NqColl, 8, -2, NqF.8*NqF.10^-1*NqF.18*NqF.23^7*NqF.24^2 );
SetConjugate( NqColl, -8, 2, NqF.8^-1*NqF.10^-1 );
SetConjugate( NqColl, -8, -2, NqF.8^-1*NqF.10*NqF.18^5*NqF.23^2*NqF.24^4 );
SetConjugate( NqColl, 8, 3, NqF.8*NqF.12^3*NqF.13^-1*NqF.17^4*NqF.18^3*\
NqF.19*NqF.21^2*NqF.22^-10*NqF.24^4 );
SetConjugate( NqColl, 8, -3, NqF.8*NqF.12*NqF.13^-1*NqF.15^4*NqF.16*NqF.18^5*\
NqF.19*NqF.20^4*NqF.23^2*NqF.24^5 );
SetConjugate( NqColl, -8, 3, NqF.8^-1*NqF.12*NqF.13^-1*NqF.15^4*NqF.16*\
NqF.18^5*NqF.19*NqF.20^4*NqF.24^2 );
SetConjugate( NqColl, -8, -3, NqF.8^-1*NqF.12^3*NqF.13^-1*NqF.17^4*NqF.18^3*\
NqF.19*NqF.21^2*NqF.22^-10*NqF.23^8*NqF.24^5 );
SetConjugate( NqColl, 8, 4, NqF.8*NqF.15*NqF.16^2*NqF.17^-1*NqF.19^3*\
NqF.20^3*NqF.21^3*NqF.22^2*NqF.23^7*NqF.24^5 );
SetConjugate( NqColl, 8, -4, NqF.8*NqF.15^4*NqF.16^2*NqF.17^-1*NqF.19^2*\
NqF.20*NqF.21^2*NqF.23^3*NqF.24 );
SetConjugate( NqColl, -8, 4, NqF.8^-1*NqF.15^4*NqF.16^2*NqF.17^-1*NqF.19^2*\
NqF.20*NqF.21^2*NqF.23^3*NqF.24 );
SetConjugate( NqColl, -8, -4, NqF.8^-1*NqF.15*NqF.16^2*NqF.17^-1*NqF.19^3*\
NqF.20^3*NqF.21^3*NqF.22^2*NqF.23^7*NqF.24^5 );
SetConjugate( NqColl, 8, 5, NqF.8*NqF.19^4*NqF.20^3*NqF.21*NqF.22^-1 );
SetConjugate( NqColl, 8, -5, NqF.8*NqF.19*NqF.20^2*NqF.21^3*NqF.22^-1 );
SetConjugate( NqColl, -8, 5, NqF.8^-1*NqF.19*NqF.20^2*NqF.21^3*NqF.22^-1 );
SetConjugate( NqColl, -8, -5, NqF.8^-1*NqF.19^4*NqF.20^3*NqF.21*NqF.22^-1 );
SetConjugate( NqColl, 9, 1, NqF.9*NqF.11 );
SetConjugate( NqColl, 9, -1, NqF.9*NqF.11^4*NqF.14*NqF.19^3*NqF.20*NqF.21^2*\
NqF.22^-6*NqF.24^2 );
SetConjugate( NqColl, -9, 1, NqF.9^-1*NqF.11^4*NqF.19^3*NqF.20*NqF.21^2*\
NqF.22^-6*NqF.24^2 );
SetConjugate( NqColl, -9, -1, NqF.9^-1*NqF.11*NqF.14^4 );
SetConjugate( NqColl, 9, 2, NqF.9*NqF.12 );
SetConjugate( NqColl, 9, -2, NqF.9*NqF.12^3*NqF.13^-2*NqF.15^4*NqF.16*\
NqF.17^4*NqF.18^4*NqF.19^2*NqF.20^4*NqF.21^2*NqF.22^-10*NqF.23^3 );
SetConjugate( NqColl, -9, 2, NqF.9^-1*NqF.12^3*NqF.13^-2*NqF.15^4*NqF.16*\
NqF.17^4*NqF.18^2*NqF.19^2*NqF.20^4*NqF.21^2*NqF.22^-10*NqF.23*NqF.24^4 );
SetConjugate( NqColl, -9, -2, NqF.9^-1*NqF.12*NqF.18^4*NqF.23^7*NqF.24^4 );
SetConjugate( NqColl, 9, 3, NqF.9*NqF.15^4*NqF.16*NqF.19*NqF.20^4*NqF.23^3*\
NqF.24^2 );
SetConjugate( NqColl, 9, -3, NqF.9*NqF.15*NqF.16^3*NqF.17^-2*NqF.19^4*\
NqF.21*NqF.22^4*NqF.23^7*NqF.24^4 );
SetConjugate( NqColl, -9, 3, NqF.9^-1*NqF.15*NqF.16^3*NqF.17^-2*NqF.19^4*\
NqF.21*NqF.22^4*NqF.23^7*NqF.24^4 );
SetConjugate( NqColl, -9, -3, NqF.9^-1*NqF.15^4*NqF.16*NqF.19*NqF.20^4*\
NqF.23^3*NqF.24^2 );
SetConjugate( NqColl, 9, 4, NqF.9*NqF.19*NqF.20^3*NqF.21 );
SetConjugate( NqColl, 9, -4, NqF.9*NqF.19^4*NqF.20^2*NqF.21^3*NqF.22^-2 );
SetConjugate( NqColl, -9, 4, NqF.9^-1*NqF.19^4*NqF.20^2*NqF.21^3*NqF.22^-2 );
SetConjugate( NqColl, -9, -4, NqF.9^-1*NqF.19*NqF.20^3*NqF.21 );
SetConjugate( NqColl, 10, 1, NqF.10*NqF.13 );
SetConjugate( NqColl, 10, -1, NqF.10*NqF.13^-1*NqF.17*NqF.22^-1 );
SetConjugate( NqColl, -10, 1, NqF.10^-1*NqF.13^-1 );
SetConjugate( NqColl, -10, -1, NqF.10^-1*NqF.13*NqF.17^-1*NqF.22 );
SetConjugate( NqColl, 10, 2, NqF.10*NqF.18*NqF.23^7*NqF.24^2 );
SetConjugate( NqColl, 10, -2, NqF.10*NqF.18^5*NqF.23^2*NqF.24^4 );
SetConjugate( NqColl, -10, 2, NqF.10^-1*NqF.18^5*NqF.23^2*NqF.24^4 );
SetConjugate( NqColl, -10, -2, NqF.10^-1*NqF.18*NqF.23^7*NqF.24^2 );
SetConjugate( NqColl, 10, 3, NqF.10*NqF.18^5*NqF.24^2 );
SetConjugate( NqColl, 10, -3, NqF.10*NqF.18*NqF.23^9*NqF.24^4 );
SetConjugate( NqColl, -10, 3, NqF.10^-1*NqF.18*NqF.23^9*NqF.24^4 );
SetConjugate( NqColl, -10, -3, NqF.10^-1*NqF.18^5*NqF.24^2 );
SetConjugate( NqColl, 10, 4, NqF.10*NqF.23*NqF.24^4 );
SetConjugate( NqColl, 10, -4, NqF.10*NqF.23^9 );
SetConjugate( NqColl, -10, 4, NqF.10^-1*NqF.23^9 );
SetConjugate( NqColl, -10, -4, NqF.10^-1*NqF.23*NqF.24^4 );
SetConjugate( NqColl, 11, 1, NqF.11*NqF.14 );
SetConjugate( NqColl, 11, -1, NqF.11*NqF.14^4 );
SetConjugate( NqColl, 11, 2, NqF.11*NqF.15 );
SetConjugate( NqColl, 11, -2, NqF.11*NqF.15^4*NqF.23^6 );
SetConjugate( NqColl, 11, 3, NqF.11*NqF.19^4*NqF.20 );
SetConjugate( NqColl, 11, -3, NqF.11*NqF.19*NqF.20^4 );
SetConjugate( NqColl, 12, 1, NqF.12*NqF.16 );
SetConjugate( NqColl, 12, -1, NqF.12*NqF.16^3*NqF.17^-2*NqF.20^4*NqF.21^2*\
NqF.22^4*NqF.24^2 );
SetConjugate( NqColl, 12, 2, NqF.12*NqF.18^2*NqF.23^2*NqF.24^2 );
SetConjugate( NqColl, 12, -2, NqF.12*NqF.18^4*NqF.23^7*NqF.24^4 );
SetConjugate( NqColl, 12, 3, NqF.12*NqF.23^7*NqF.24^2 );
SetConjugate( NqColl, 12, -3, NqF.12*NqF.23^3*NqF.24^2 );
SetConjugate( NqColl, 13, 1, NqF.13*NqF.17 );
SetConjugate( NqColl, 13, -1, NqF.13*NqF.17^-1*NqF.22 );
SetConjugate( NqColl, -13, 1, NqF.13^-1*NqF.17^-1 );
SetConjugate( NqColl, -13, -1, NqF.13^-1*NqF.17*NqF.22^-1 );
SetConjugate( NqColl, 13, 2, NqF.13*NqF.18 );
SetConjugate( NqColl, 13, -2, NqF.13*NqF.18^5*NqF.23^9 );
SetConjugate( NqColl, -13, 2, NqF.13^-1*NqF.18^5*NqF.23^9 );
SetConjugate( NqColl, -13, -2, NqF.13^-1*NqF.18 );
SetConjugate( NqColl, 13, 3, NqF.13*NqF.23^9*NqF.24^5 );
SetConjugate( NqColl, 13, -3, NqF.13*NqF.23*NqF.24^5 );
SetConjugate( NqColl, -13, 3, NqF.13^-1*NqF.23*NqF.24^5 );
SetConjugate( NqColl, -13, -3, NqF.13^-1*NqF.23^9*NqF.24^5 );
SetConjugate( NqColl, 14, 1, NqF.14 );
SetConjugate( NqColl, 14, -1, NqF.14 );
SetConjugate( NqColl, 14, 2, NqF.14*NqF.19 );
SetConjugate( NqColl, 14, -2, NqF.14*NqF.19^4 );
SetConjugate( NqColl, 15, 1, NqF.15*NqF.20 );
SetConjugate( NqColl, 15, -1, NqF.15*NqF.20^4 );
SetConjugate( NqColl, 15, 2, NqF.15*NqF.23^6 );
SetConjugate( NqColl, 15, -2, NqF.15*NqF.23^4*NqF.24^4 );
SetConjugate( NqColl, 16, 1, NqF.16*NqF.21 );
SetConjugate( NqColl, 16, -1, NqF.16*NqF.21^3*NqF.22^-2 );
SetConjugate( NqColl, 16, 2, NqF.16*NqF.23^3*NqF.24^4 );
SetConjugate( NqColl, 16, -2, NqF.16*NqF.23^7 );
SetConjugate( NqColl, 17, 1, NqF.17*NqF.22 );
SetConjugate( NqColl, 17, -1, NqF.17*NqF.22^-1 );
SetConjugate( NqColl, -17, 1, NqF.17^-1*NqF.22^-1 );
SetConjugate( NqColl, -17, -1, NqF.17^-1*NqF.22 );
SetConjugate( NqColl, 17, 2, NqF.17*NqF.23 );
SetConjugate( NqColl, 17, -2, NqF.17*NqF.23^9*NqF.24^4 );
SetConjugate( NqColl, -17, 2, NqF.17^-1*NqF.23^9*NqF.24^4 );
SetConjugate( NqColl, -17, -2, NqF.17^-1*NqF.23 );
SetConjugate( NqColl, 18, 1, NqF.18*NqF.24 );
SetConjugate( NqColl, 18, -1, NqF.18*NqF.24^5 );
SetConjugate( NqColl, 18, 2, NqF.18 );
SetConjugate( NqColl, 18, -2, NqF.18 );
return PcpGroupByCollector( NqColl );
elif n = 2 then
NqF := FreeGroup( 13 );
NqColl := FromTheLeftCollector( NqF );
SetRelativeOrder( NqColl, 11, 5 );
SetRelativeOrder( NqColl, 12, 4 );
SetPower( NqColl, 12, NqF.13^2 );
SetConjugate( NqColl, 2, 1, NqF.2*NqF.3 );
SetConjugate( NqColl, 2, -1, NqF.2*NqF.3^-1*NqF.4*NqF.5^-1*NqF.6*NqF.7*\
NqF.8^-3*NqF.9^10*NqF.10^-1*NqF.11*NqF.13^5 );
SetConjugate( NqColl, -2, 1, NqF.2^-1*NqF.3^-1 );
SetConjugate( NqColl, -2, -1, NqF.2^-1*NqF.3*NqF.4^-1*NqF.5*NqF.6^-1*NqF.9^3*\
NqF.11^2*NqF.12^2*NqF.13^-1 );
SetConjugate( NqColl, 3, 1, NqF.3*NqF.4 );
SetConjugate( NqColl, 3, -1, NqF.3*NqF.4^-1*NqF.5*NqF.6^-1*NqF.9^3*NqF.11^2*\
NqF.12^2*NqF.13^-1 );
SetConjugate( NqColl, -3, 1, NqF.3^-1*NqF.4^-1*NqF.7^-1*NqF.8^2*NqF.9^-7*\
NqF.10*NqF.11^4*NqF.12*NqF.13^-6 );
SetConjugate( NqColl, -3, -1, NqF.3^-1*NqF.4*NqF.5^-1*NqF.6*NqF.7*NqF.8^-3*\
NqF.9^10*NqF.10^-1*NqF.11*NqF.13^5 );
SetConjugate( NqColl, 3, 2, NqF.3 );
SetConjugate( NqColl, 3, -2, NqF.3 );
SetConjugate( NqColl, -3, 2, NqF.3^-1 );
SetConjugate( NqColl, -3, -2, NqF.3^-1 );
SetConjugate( NqColl, 4, 1, NqF.4*NqF.5 );
SetConjugate( NqColl, 4, -1, NqF.4*NqF.5^-1*NqF.6 );
SetConjugate( NqColl, -4, 1, NqF.4^-1*NqF.5^-1*NqF.9^-3*NqF.12^2*NqF.13^-1 );
SetConjugate( NqColl, -4, -1, NqF.4^-1*NqF.5*NqF.6^-1*NqF.9^3*NqF.11^2*\
NqF.12^2*NqF.13^-1 );
SetConjugate( NqColl, 4, 2, NqF.4*NqF.7*NqF.8^-2*NqF.9^7*NqF.10^-1*NqF.11*\
NqF.13^4 );
SetConjugate( NqColl, 4, -2, NqF.4*NqF.7^-1*NqF.8^2*NqF.9^-7*NqF.10^2*\
NqF.11^4*NqF.12*NqF.13^-6 );
SetConjugate( NqColl, -4, 2, NqF.4^-1*NqF.7^-1*NqF.8^2*NqF.9^-7*NqF.10*\
NqF.11^4*NqF.12*NqF.13^-6 );
SetConjugate( NqColl, -4, -2, NqF.4^-1*NqF.7*NqF.8^-2*NqF.9^7*NqF.10^-2*\
NqF.11*NqF.12^2*NqF.13^6 );
SetConjugate( NqColl, 4, 3, NqF.4*NqF.7^-1*NqF.8^2*NqF.9^-7*NqF.10^2*\
NqF.11^4*NqF.12*NqF.13^-6 );
SetConjugate( NqColl, 4, -3, NqF.4*NqF.7*NqF.8^-2*NqF.9^7*NqF.10^-1*NqF.11*\
NqF.13^4 );
SetConjugate( NqColl, -4, 3, NqF.4^-1*NqF.7*NqF.8^-2*NqF.9^7*NqF.10^-2*\
NqF.11*NqF.12^2*NqF.13^6 );
SetConjugate( NqColl, -4, -3, NqF.4^-1*NqF.7^-1*NqF.8^2*NqF.9^-7*NqF.10*\
NqF.11^4*NqF.12*NqF.13^-6 );
SetConjugate( NqColl, 5, 1, NqF.5*NqF.6 );
SetConjugate( NqColl, 5, -1, NqF.5*NqF.6^-1 );
SetConjugate( NqColl, -5, 1, NqF.5^-1*NqF.6^-1 );
SetConjugate( NqColl, -5, -1, NqF.5^-1*NqF.6 );
SetConjugate( NqColl, 5, 2, NqF.5*NqF.7 );
SetConjugate( NqColl, 5, -2, NqF.5*NqF.7^-1*NqF.10^3*NqF.12^2*NqF.13^-6 );
SetConjugate( NqColl, -5, 2, NqF.5^-1*NqF.7^-1 );
SetConjugate( NqColl, -5, -2, NqF.5^-1*NqF.7*NqF.10^-3*NqF.12^2*NqF.13^4 );
SetConjugate( NqColl, 5, 3, NqF.5*NqF.8^-1*NqF.9^5*NqF.11^3*NqF.12^3*\
NqF.13^-1 );
SetConjugate( NqColl, 5, -3, NqF.5*NqF.8*NqF.9^-5*NqF.11^2*NqF.12^2*NqF.13^-2 );
SetConjugate( NqColl, -5, 3, NqF.5^-1*NqF.8*NqF.9^-5*NqF.11^2*NqF.12*NqF.13^-1 );
SetConjugate( NqColl, -5, -3, NqF.5^-1*NqF.8^-1*NqF.9^5*NqF.11^3*NqF.12^2 );
SetConjugate( NqColl, 5, 4, NqF.5*NqF.9^-3*NqF.12^2*NqF.13^-1 );
SetConjugate( NqColl, 5, -4, NqF.5*NqF.9^3*NqF.12^2*NqF.13^-1 );
SetConjugate( NqColl, -5, 4, NqF.5^-1*NqF.9^3*NqF.12^2*NqF.13^-1 );
SetConjugate( NqColl, -5, -4, NqF.5^-1*NqF.9^-3*NqF.12^2*NqF.13^-1 );
SetConjugate( NqColl, 6, 1, NqF.6 );
SetConjugate( NqColl, 6, -1, NqF.6 );
SetConjugate( NqColl, -6, 1, NqF.6^-1 );
SetConjugate( NqColl, -6, -1, NqF.6^-1 );
SetConjugate( NqColl, 6, 2, NqF.6*NqF.8^2*NqF.9^-7*NqF.10*NqF.11^4*NqF.13^-4 );
SetConjugate( NqColl, 6, -2, NqF.6*NqF.8^-2*NqF.9^7*NqF.10*NqF.11*NqF.12 );
SetConjugate( NqColl, -6, 2, NqF.6^-1*NqF.8^-2*NqF.9^7*NqF.10^-1*NqF.11*\
NqF.13^4 );
SetConjugate( NqColl, -6, -2, NqF.6^-1*NqF.8^2*NqF.9^-7*NqF.10^-1*NqF.11^4*\
NqF.12^3*NqF.13^-2 );
SetConjugate( NqColl, 6, 3, NqF.6*NqF.9^2*NqF.11^3*NqF.12^2*NqF.13^-1 );
SetConjugate( NqColl, 6, -3, NqF.6*NqF.9^-2*NqF.11^2*NqF.12^2*NqF.13^-1 );
SetConjugate( NqColl, -6, 3, NqF.6^-1*NqF.9^-2*NqF.11^2*NqF.12^2*NqF.13^-1 );
SetConjugate( NqColl, -6, -3, NqF.6^-1*NqF.9^2*NqF.11^3*NqF.12^2*NqF.13^-1 );
SetConjugate( NqColl, 6, 4, NqF.6*NqF.11^2 );
SetConjugate( NqColl, 6, -4, NqF.6*NqF.11^3 );
SetConjugate( NqColl, -6, 4, NqF.6^-1*NqF.11^3 );
SetConjugate( NqColl, -6, -4, NqF.6^-1*NqF.11^2 );
SetConjugate( NqColl, 7, 1, NqF.7*NqF.8 );
SetConjugate( NqColl, 7, -1, NqF.7*NqF.8^-1*NqF.9*NqF.11^4 );
SetConjugate( NqColl, -7, 1, NqF.7^-1*NqF.8^-1 );
SetConjugate( NqColl, -7, -1, NqF.7^-1*NqF.8*NqF.9^-1*NqF.11 );
SetConjugate( NqColl, 7, 2, NqF.7*NqF.10^3*NqF.12^2*NqF.13^-6 );
SetConjugate( NqColl, 7, -2, NqF.7*NqF.10^-3*NqF.12^2*NqF.13^4 );
SetConjugate( NqColl, -7, 2, NqF.7^-1*NqF.10^-3*NqF.12^2*NqF.13^4 );
SetConjugate( NqColl, -7, -2, NqF.7^-1*NqF.10^3*NqF.12^2*NqF.13^-6 );
SetConjugate( NqColl, 7, 3, NqF.7*NqF.10^-1*NqF.12*NqF.13^2 );
SetConjugate( NqColl, 7, -3, NqF.7*NqF.10*NqF.12^3*NqF.13^-4 );
SetConjugate( NqColl, -7, 3, NqF.7^-1*NqF.10*NqF.12^3*NqF.13^-4 );
SetConjugate( NqColl, -7, -3, NqF.7^-1*NqF.10^-1*NqF.12*NqF.13^2 );
SetConjugate( NqColl, 7, 4, NqF.7*NqF.12*NqF.13^-2 );
SetConjugate( NqColl, 7, -4, NqF.7*NqF.12^3 );
SetConjugate( NqColl, -7, 4, NqF.7^-1*NqF.12^3 );
SetConjugate( NqColl, -7, -4, NqF.7^-1*NqF.12*NqF.13^-2 );
SetConjugate( NqColl, 8, 1, NqF.8*NqF.9 );
SetConjugate( NqColl, 8, -1, NqF.8*NqF.9^-1*NqF.11 );
SetConjugate( NqColl, -8, 1, NqF.8^-1*NqF.9^-1 );
SetConjugate( NqColl, -8, -1, NqF.8^-1*NqF.9*NqF.11^4 );
SetConjugate( NqColl, 8, 2, NqF.8*NqF.10 );
SetConjugate( NqColl, 8, -2, NqF.8*NqF.10^-1 );
SetConjugate( NqColl, -8, 2, NqF.8^-1*NqF.10^-1 );
SetConjugate( NqColl, -8, -2, NqF.8^-1*NqF.10 );
SetConjugate( NqColl, 8, 3, NqF.8*NqF.12^3*NqF.13^-1 );
SetConjugate( NqColl, 8, -3, NqF.8*NqF.12*NqF.13^-1 );
SetConjugate( NqColl, -8, 3, NqF.8^-1*NqF.12*NqF.13^-1 );
SetConjugate( NqColl, -8, -3, NqF.8^-1*NqF.12^3*NqF.13^-1 );
SetConjugate( NqColl, 9, 1, NqF.9*NqF.11 );
SetConjugate( NqColl, 9, -1, NqF.9*NqF.11^4 );
SetConjugate( NqColl, -9, 1, NqF.9^-1*NqF.11^4 );
SetConjugate( NqColl, -9, -1, NqF.9^-1*NqF.11 );
SetConjugate( NqColl, 9, 2, NqF.9*NqF.12 );
SetConjugate( NqColl, 9, -2, NqF.9*NqF.12^3*NqF.13^-2 );
SetConjugate( NqColl, -9, 2, NqF.9^-1*NqF.12^3*NqF.13^-2 );
SetConjugate( NqColl, -9, -2, NqF.9^-1*NqF.12 );
SetConjugate( NqColl, 10, 1, NqF.10*NqF.13 );
SetConjugate( NqColl, 10, -1, NqF.10*NqF.13^-1 );
SetConjugate( NqColl, -10, 1, NqF.10^-1*NqF.13^-1 );
SetConjugate( NqColl, -10, -1, NqF.10^-1*NqF.13 );
SetConjugate( NqColl, 10, 2, NqF.10 );
SetConjugate( NqColl, 10, -2, NqF.10 );
SetConjugate( NqColl, -10, 2, NqF.10^-1 );
SetConjugate( NqColl, -10, -2, NqF.10^-1 );
return PcpGroupByCollector( NqColl );
elif n = 3 then
NqF := FreeGroup( 17 );
NqColl := FromTheLeftCollector( NqF );
SetRelativeOrder( NqColl, 8, 2 );
SetRelativeOrder( NqColl, 10, 2 );
SetRelativeOrder( NqColl, 11, 2 );
SetRelativeOrder( NqColl, 14, 2 );
SetRelativeOrder( NqColl, 15, 2 );
SetRelativeOrder( NqColl, 17, 5 );
SetPower( NqColl, 8, NqF.9*NqF.10*NqF.11*NqF.12^-1*NqF.13^3*NqF.14*\
NqF.16^-2*NqF.17 );
SetPower( NqColl, 10, NqF.12*NqF.15*NqF.16^3 );
SetPower( NqColl, 11, NqF.13*NqF.14*NqF.16^-2*NqF.17 );
SetPower( NqColl, 14, NqF.16^2 );
SetPower( NqColl, 15, NqF.16 );
SetConjugate( NqColl, 2, 1, NqF.2*NqF.3 );
SetConjugate( NqColl, 2, -1, NqF.2*NqF.3^-1 );
SetConjugate( NqColl, -2, 1, NqF.2^-1*NqF.3^-1*NqF.4*NqF.5^-1*NqF.6^-1*\
NqF.7*NqF.8*NqF.9*NqF.10*NqF.11*NqF.13^-2*NqF.15*NqF.16^-2*NqF.17^3 );
SetConjugate( NqColl, -2, -1, NqF.2^-1*NqF.3*NqF.4^-1*NqF.5*NqF.7^-1*NqF.11*\
NqF.13^-2*NqF.14*NqF.16*NqF.17^2 );
SetConjugate( NqColl, 3, 1, NqF.3 );
SetConjugate( NqColl, 3, -1, NqF.3 );
SetConjugate( NqColl, -3, 1, NqF.3^-1 );
SetConjugate( NqColl, -3, -1, NqF.3^-1 );
SetConjugate( NqColl, 3, 2, NqF.3*NqF.4 );
SetConjugate( NqColl, 3, -2, NqF.3*NqF.4^-1*NqF.5*NqF.7^-1*NqF.11*NqF.13^-2*\
NqF.14*NqF.16*NqF.17^2 );
SetConjugate( NqColl, -3, 2, NqF.3^-1*NqF.4^-1*NqF.6*NqF.9^-1*NqF.10*NqF.12^-1*\
NqF.15*NqF.16^-4 );
SetConjugate( NqColl, -3, -2, NqF.3^-1*NqF.4*NqF.5^-1*NqF.6^-1*NqF.7*NqF.8*\
NqF.9*NqF.10*NqF.11*NqF.13^-2*NqF.15*NqF.16^-2*NqF.17^3 );
SetConjugate( NqColl, 4, 1, NqF.4*NqF.6*NqF.9^-1 );
SetConjugate( NqColl, 4, -1, NqF.4*NqF.6^-1*NqF.9*NqF.10*NqF.15*NqF.16^-2 );
SetConjugate( NqColl, -4, 1, NqF.4^-1*NqF.6^-1*NqF.9*NqF.15*NqF.16 );
SetConjugate( NqColl, -4, -1, NqF.4^-1*NqF.6*NqF.9^-1*NqF.10*NqF.12^-1*\
NqF.15*NqF.16^-4 );
SetConjugate( NqColl, 4, 2, NqF.4*NqF.5 );
SetConjugate( NqColl, 4, -2, NqF.4*NqF.5^-1*NqF.7 );
SetConjugate( NqColl, -4, 2, NqF.4^-1*NqF.5^-1*NqF.11*NqF.13*NqF.16^-1*\
NqF.17 );
SetConjugate( NqColl, -4, -2, NqF.4^-1*NqF.5*NqF.7^-1*NqF.11*NqF.13^-2*\
NqF.14*NqF.16*NqF.17^2 );
SetConjugate( NqColl, 4, 3, NqF.4*NqF.6*NqF.9^-1 );
SetConjugate( NqColl, 4, -3, NqF.4*NqF.6^-1*NqF.9*NqF.10*NqF.15*NqF.16^-2 );
SetConjugate( NqColl, -4, 3, NqF.4^-1*NqF.6^-1*NqF.9*NqF.15*NqF.16 );
SetConjugate( NqColl, -4, -3, NqF.4^-1*NqF.6*NqF.9^-1*NqF.10*NqF.12^-1*\
NqF.15*NqF.16^-4 );
SetConjugate( NqColl, 5, 1, NqF.5*NqF.6 );
SetConjugate( NqColl, 5, -1, NqF.5*NqF.6^-1*NqF.10*NqF.12*NqF.15*NqF.16^-2 );
SetConjugate( NqColl, -5, 1, NqF.5^-1*NqF.6^-1 );
SetConjugate( NqColl, -5, -1, NqF.5^-1*NqF.6*NqF.10*NqF.12^-2*NqF.16^-2 );
SetConjugate( NqColl, 5, 2, NqF.5*NqF.7 );
SetConjugate( NqColl, 5, -2, NqF.5*NqF.7^-1 );
SetConjugate( NqColl, -5, 2, NqF.5^-1*NqF.7^-1 );
SetConjugate( NqColl, -5, -2, NqF.5^-1*NqF.7 );
SetConjugate( NqColl, 5, 3, NqF.5*NqF.8*NqF.11*NqF.13^-3*NqF.14*NqF.15*\
NqF.16^-1*NqF.17^3 );
SetConjugate( NqColl, 5, -3, NqF.5*NqF.8*NqF.9^-1*NqF.10*NqF.13^-1*NqF.15*\
NqF.16^-3 );
SetConjugate( NqColl, -5, 3, NqF.5^-1*NqF.8*NqF.9^-1*NqF.10*NqF.13^-1*\
NqF.14*NqF.16^-3 );
SetConjugate( NqColl, -5, -3, NqF.5^-1*NqF.8*NqF.11*NqF.13^-3*NqF.16*NqF.17^3 );
SetConjugate( NqColl, 5, 4, NqF.5*NqF.11*NqF.13*NqF.16^-1*NqF.17 );
SetConjugate( NqColl, 5, -4, NqF.5*NqF.11*NqF.13^-2*NqF.14*NqF.16*NqF.17^3 );
SetConjugate( NqColl, -5, 4, NqF.5^-1*NqF.11*NqF.13^-2*NqF.14*NqF.16*NqF.17^3 );
SetConjugate( NqColl, -5, -4, NqF.5^-1*NqF.11*NqF.13*NqF.16^-1*NqF.17 );
SetConjugate( NqColl, 6, 1, NqF.6*NqF.10*NqF.12*NqF.15*NqF.16^-2 );
SetConjugate( NqColl, 6, -1, NqF.6*NqF.10*NqF.12^-2*NqF.16^-2 );
SetConjugate( NqColl, -6, 1, NqF.6^-1*NqF.10*NqF.12^-2*NqF.16^-2 );
SetConjugate( NqColl, -6, -1, NqF.6^-1*NqF.10*NqF.12*NqF.15*NqF.16^-2 );
SetConjugate( NqColl, 6, 2, NqF.6*NqF.8 );
SetConjugate( NqColl, 6, -2, NqF.6*NqF.8*NqF.9^-1*NqF.10*NqF.13^-3*NqF.14*\
NqF.15*NqF.16^-4*NqF.17 );
SetConjugate( NqColl, -6, 2, NqF.6^-1*NqF.8*NqF.9^-1*NqF.10*NqF.11*NqF.13^-4*\
NqF.15*NqF.16^-2*NqF.17^3 );
SetConjugate( NqColl, -6, -2, NqF.6^-1*NqF.8*NqF.11*NqF.13^-1*NqF.14*NqF.17^2 );
SetConjugate( NqColl, 6, 3, NqF.6*NqF.10*NqF.15*NqF.16^-3 );
SetConjugate( NqColl, 6, -3, NqF.6*NqF.10*NqF.12^-1*NqF.16^-1 );
SetConjugate( NqColl, -6, 3, NqF.6^-1*NqF.10*NqF.12^-1*NqF.16^-1 );
SetConjugate( NqColl, -6, -3, NqF.6^-1*NqF.10*NqF.15*NqF.16^-3 );
SetConjugate( NqColl, 6, 4, NqF.6*NqF.15*NqF.16 );
SetConjugate( NqColl, 6, -4, NqF.6*NqF.15*NqF.16^-2 );
SetConjugate( NqColl, -6, 4, NqF.6^-1*NqF.15*NqF.16^-2 );
SetConjugate( NqColl, -6, -4, NqF.6^-1*NqF.15*NqF.16 );
SetConjugate( NqColl, 7, 1, NqF.7*NqF.9 );
SetConjugate( NqColl, 7, -1, NqF.7*NqF.9^-1*NqF.12 );
SetConjugate( NqColl, -7, 1, NqF.7^-1*NqF.9^-1 );
SetConjugate( NqColl, -7, -1, NqF.7^-1*NqF.9*NqF.12^-1 );
SetConjugate( NqColl, 7, 2, NqF.7 );
SetConjugate( NqColl, 7, -2, NqF.7 );
SetConjugate( NqColl, -7, 2, NqF.7^-1 );
SetConjugate( NqColl, -7, -2, NqF.7^-1 );
SetConjugate( NqColl, 7, 3, NqF.7*NqF.13^-1*NqF.16 );
SetConjugate( NqColl, 7, -3, NqF.7*NqF.13*NqF.16^-1 );
SetConjugate( NqColl, -7, 3, NqF.7^-1*NqF.13*NqF.16^-1 );
SetConjugate( NqColl, -7, -3, NqF.7^-1*NqF.13^-1*NqF.16 );
SetConjugate( NqColl, 7, 4, NqF.7*NqF.17^4 );
SetConjugate( NqColl, 7, -4, NqF.7*NqF.17 );
SetConjugate( NqColl, -7, 4, NqF.7^-1*NqF.17 );
SetConjugate( NqColl, -7, -4, NqF.7^-1*NqF.17^4 );
SetConjugate( NqColl, 8, 1, NqF.8*NqF.10 );
SetConjugate( NqColl, 8, -1, NqF.8*NqF.10*NqF.12^-1*NqF.15*NqF.16^-4 );
SetConjugate( NqColl, 8, 2, NqF.8*NqF.11 );
SetConjugate( NqColl, 8, -2, NqF.8*NqF.11*NqF.13^-1*NqF.14*NqF.17^2 );
SetConjugate( NqColl, 8, 3, NqF.8*NqF.14*NqF.15*NqF.16^-2 );
SetConjugate( NqColl, 8, -3, NqF.8*NqF.14*NqF.15*NqF.16^-1 );
SetConjugate( NqColl, 9, 1, NqF.9*NqF.12 );
SetConjugate( NqColl, 9, -1, NqF.9*NqF.12^-1 );
SetConjugate( NqColl, -9, 1, NqF.9^-1*NqF.12^-1 );
SetConjugate( NqColl, -9, -1, NqF.9^-1*NqF.12 );
SetConjugate( NqColl, 9, 2, NqF.9*NqF.13 );
SetConjugate( NqColl, 9, -2, NqF.9*NqF.13^-1*NqF.17 );
SetConjugate( NqColl, -9, 2, NqF.9^-1*NqF.13^-1 );
SetConjugate( NqColl, -9, -2, NqF.9^-1*NqF.13*NqF.17^4 );
SetConjugate( NqColl, 9, 3, NqF.9*NqF.16^-1 );
SetConjugate( NqColl, 9, -3, NqF.9*NqF.16 );
SetConjugate( NqColl, -9, 3, NqF.9^-1*NqF.16 );
SetConjugate( NqColl, -9, -3, NqF.9^-1*NqF.16^-1 );
SetConjugate( NqColl, 10, 1, NqF.10 );
SetConjugate( NqColl, 10, -1, NqF.10 );
SetConjugate( NqColl, 10, 2, NqF.10*NqF.14 );
SetConjugate( NqColl, 10, -2, NqF.10*NqF.14*NqF.16^-2 );
SetConjugate( NqColl, 11, 1, NqF.11*NqF.15 );
SetConjugate( NqColl, 11, -1, NqF.11*NqF.15*NqF.16^-1 );
SetConjugate( NqColl, 11, 2, NqF.11*NqF.17^3 );
SetConjugate( NqColl, 11, -2, NqF.11*NqF.17^2 );
SetConjugate( NqColl, 12, 1, NqF.12 );
SetConjugate( NqColl, 12, -1, NqF.12 );
SetConjugate( NqColl, -12, 1, NqF.12^-1 );
SetConjugate( NqColl, -12, -1, NqF.12^-1 );
SetConjugate( NqColl, 12, 2, NqF.12*NqF.16^2 );
SetConjugate( NqColl, 12, -2, NqF.12*NqF.16^-2 );
SetConjugate( NqColl, -12, 2, NqF.12^-1*NqF.16^-2 );
SetConjugate( NqColl, -12, -2, NqF.12^-1*NqF.16^2 );
SetConjugate( NqColl, 13, 1, NqF.13*NqF.16 );
SetConjugate( NqColl, 13, -1, NqF.13*NqF.16^-1 );
SetConjugate( NqColl, -13, 1, NqF.13^-1*NqF.16^-1 );
SetConjugate( NqColl, -13, -1, NqF.13^-1*NqF.16 );
SetConjugate( NqColl, 13, 2, NqF.13*NqF.17 );
SetConjugate( NqColl, 13, -2, NqF.13*NqF.17^4 );
SetConjugate( NqColl, -13, 2, NqF.13^-1*NqF.17^4 );
SetConjugate( NqColl, -13, -2, NqF.13^-1*NqF.17 );
return PcpGroupByCollector( NqColl );
fi;
return fail;
end);
polycyclic-2.16/gap/exam/generic.gi 0000644 0000766 0000024 00000015001 13706672341 016267 0 ustar mhorn staff #############################################################################
##
#W generic.gi Polycyc Bettina Eick
##
#############################################################################
##
#M AbelianPcpGroup
##
InstallGlobalFunction( AbelianPcpGroup, function( arg )
local coll, i, n, r, grp;
# catch arguments
if Length(arg) = 1 and IsInt(arg[1]) then
n := arg[1];
r := List([1..n], x -> 0);
elif Length(arg) = 1 and IsList(arg[1]) then
n := Length(arg[1]);
r := arg[1];
elif Length(arg) = 2 then
n := arg[1];
r := arg[2];
fi;
# construct group
coll := FromTheLeftCollector( n );
for i in [1..n] do
if IsBound( r[i] ) and r[i] > 0 then
SetRelativeOrder( coll, i, r[i] );
fi;
od;
UpdatePolycyclicCollector(coll);
grp := PcpGroupByCollectorNC( coll );
SetIsAbelian( grp, true );
return grp;
end );
#############################################################################
##
#M DihedralPcpGroup
##
InstallGlobalFunction( DihedralPcpGroup, function( n )
local coll, m;
coll := FromTheLeftCollector( 2 );
SetRelativeOrder( coll, 1, 2 );
if IsInt( n ) then
m := n/2;
if not IsInt( m ) then return fail; fi;
SetRelativeOrder( coll, 2, m );
SetConjugate( coll, 2, 1, [2,m-1] );
else
SetConjugate( coll, 2, 1, [2,-1] );
SetConjugate( coll, 2, -1, [2,-1] );
fi;
UpdatePolycyclicCollector(coll);
return PcpGroupByCollectorNC( coll );
end );
#############################################################################
##
#M UnitriangularPcpGroup( n, p ) . . . . . . . . for p = 0 we take UT( n, Z )
##
InstallGlobalFunction( UnitriangularPcpGroup, function( n, p )
local F, l, c, e, g, r, pairs, i, j, k, o, G;
if not IsPosInt(n) then return fail; fi;
if p = 0 then
F := Rationals;
elif IsPrimeInt(p) then
F := GF(p);
else
return fail;
fi;
l := n*(n-1)/2;
c := FromTheLeftCollector( l );
# compute matrix generators
g := [];
e := One(F);
for i in [1..n-1] do
for j in [1..n-i] do
r := IdentityMat( n, F );
r[j][i+j] := e;
Add( g, r );
od;
od;
# read of pc presentation
pairs := ListX([1..n-1], i -> [1..n-i], function(i,j) return [j, i+j]; end);
for i in [1..l] do
# commutators
for j in [i+1..l] do
if pairs[i][1] = pairs[j][2] then
k := Position(pairs, [pairs[j][1], pairs[i][2]]);
o := [j,1,k,1];
SetConjugate( c, j, i, o );
elif pairs[i][2] = pairs[j][1] then
k := Position(pairs, [pairs[i][1], pairs[j][2]]);
o := [j,1,k,-1];
if p > 0 then o[4] := o[4] mod p; fi;
SetConjugate( c, j, i, o );
else
# commutator is trivial
fi;
od;
# powers
if p > 0 then
SetRelativeOrder( c, i, p );
fi;
od;
# translate from collector to group
UpdatePolycyclicCollector( c );
G := PcpGroupByCollectorNC( c );
G!.mats := g;
# check
# IsConfluent(c);
return G;
end );
#############################################################################
##
#M SubgroupUnitriangularPcpGroup( mats )
##
InstallGlobalFunction( SubgroupUnitriangularPcpGroup, function( mats )
local n, p, G, g, i, j, r, h, m, e, v, c;
# get the dimension, the char and the full unitriangluar group
n := Length( mats[1] );
p := Characteristic( mats[1][1][1] );
G := UnitriangularPcpGroup( n, p );
# compute corresponding generators
g := [];
for i in [1..n-1] do
for j in [1..n-i] do
r := IdentityMat( n );
r[j][i+j] := 1;
Add( g, r );
od;
od;
# get exponents for each matrix
h := [];
for m in mats do
e := [];
c := 0;
for i in [1..n-1] do
v := List( [1..n-i], x -> m[x][x+i] );
r := MappedVector( v, g{[c+1..c+n-i]} );
m := r^-1 * m;
c := c + n-i;
Append( e, v );
od;
Add( h, MappedVector( e, Pcp(G) ) );
od;
return Subgroup( G, h );
end );
#############################################################################
##
#M HeisenbergPcpGroup( m )
##
InstallGlobalFunction( HeisenbergPcpGroup, function( m )
local FLT, i;
FLT := FromTheLeftCollector( 2*m+1 );
for i in [1..m] do
SetConjugate( FLT, m+i, i, [m+i, 1, 2*m+1, 1] );
od;
UpdatePolycyclicCollector( FLT );
return PcpGroupByCollectorNC( FLT );
end );
#############################################################################
##
#M MaximalOrderByUnitsPcpGroup(f)
##
InstallGlobalFunction( MaximalOrderByUnitsPcpGroup, function(f)
local m, F, O, U, i, G, u, a;
# check
if Length(Factors(f)) > 1 then return fail; fi;
# create field
m := CompanionMat(f);
F := FieldByMatricesNC([m]);
# get order and units
O := MaximalOrderBasis(F);
U := UnitGroup(F);
# get pcp groups
i := IsomorphismPcpGroup(U);
G := Image(i);
# get action of U on O
u := List( Pcp(G), x -> PreImagesRepresentative(i,x) );
a := List( u, x -> List( O, y -> Coefficients(O, y*x)));
# return split extension
return SplitExtensionPcpGroup( G, a );
end);
#############################################################################
##
#F PDepth(G, e)
##
PDepth := function(G, e)
local l, i;
l := PCentralSeries(G);
for i in Reversed([1..Length(l)]) do
if e in l[i] then
return i;
fi;
od;
end;
#############################################################################
##
#F BlowUpPcpPGroup(G)
##
BlowUpPcpPGroup := function(G)
local p, e, f, c, i, j, k;
# set up
p := PrimePGroup(G);
e := ShallowCopy(AsList(G));
f := function(a,b) return PDepth(G,a)