|
#############################################################################
##
#A orbstab.gi Cryst library Bettina Eick
#A Franz G"ahler
#A Werner Nickel
##
#Y Copyright 1997-1999 by Bettina Eick, Franz G"ahler and Werner Nickel
##
#############################################################################
##
#M Orbit( G, H, gens, oprs, opr ) . . . . . . . . . .for an AffineCrystGroup
##
InstallOtherMethod( OrbitOp,
"G, H, gens, oprs, opr for AffineCrystGroups", true,
[ IsAffineCrystGroupOnRight, IsAffineCrystGroupOnRight,
IsList, IsList, IsFunction ], 10,
function( G, H, gens, oprs, opr )
local orb, grp, gen, img;
if opr = OnPoints then
orb := [ H ];
for grp in orb do
for gen in oprs do
img := List( GeneratorsOfGroup( grp ), x -> x^gen );
if not ForAny( orb, g -> ForAll( img, x -> x in g ) ) then
Add( orb, ConjugateGroup( grp, gen ) );
fi;
od;
od;
return orb;
else
TryNextMethod();
fi;
end );
InstallOtherMethod( OrbitOp,
"G, H, gens, oprs, opr for AffineCrystGroups", true,
[ IsAffineCrystGroupOnLeft, IsAffineCrystGroupOnLeft,
IsList, IsList, IsFunction ], 10,
function( G, H, gens, oprs, opr )
local orb, grp, gen, img;
if opr = OnPoints then
orb := [ H ];
for grp in orb do
for gen in oprs do
img := List( GeneratorsOfGroup( grp ), x -> x^gen );
if not ForAny( orb, g -> ForAll( img, x -> x in g ) ) then
Add( orb, ConjugateGroup( grp, gen ) );
fi;
od;
od;
return orb;
else
TryNextMethod();
fi;
end );
#############################################################################
##
#M OrbitStabilizer( G, H, gens, oprs, opr ) . . . . .for an AffineCrystGroup
##
InstallOtherMethod( OrbitStabilizerOp,
"G, H, gens, oprs, opr for AffineCrystGroups", true,
[ IsAffineCrystGroupOnRight, IsAffineCrystGroupOnRight,
IsList, IsList, IsFunction ], 0,
function( G, H, gens, oprs, opr )
local orb, rep, stb, grp, k, img, i, sch;
if opr = OnPoints then
orb := [ H ];
rep := [ One( G ) ];
if IsSubgroup( G, H ) then
stb := H;
else
stb := Intersection2( G, H );
fi;
for grp in orb do
for k in [1..Length(gens)] do
img := List( GeneratorsOfGroup( grp ), x -> x^oprs[k] );
i := PositionProperty( orb,
g -> ForAll( img, x -> x in g ) );
if i = fail then
Add( orb, ConjugateGroup( grp, oprs[k] ) );
Add( rep, rep[Position(orb,grp)] * oprs[k] );
else
sch := rep[Position(orb,grp)] * gens[k] / rep[i];
if not sch in stb then
stb := ClosureGroup( stb, sch );
fi;
fi;
od;
od;
return Immutable( rec( orbit := orb, stabilizer := stb ) );
else
TryNextMethod();
fi;
end );
InstallOtherMethod( OrbitStabilizerOp,
"G, H, gens, oprs, opr for AffineCrystGroups", true,
[ IsAffineCrystGroupOnLeft, IsAffineCrystGroupOnLeft,
IsList, IsList, IsFunction ], 0,
function( G, H, gens, oprs, opr )
local orb, rep, stb, grp, k, img, i, sch;
if opr = OnPoints then
orb := [ H ];
rep := [ One( G ) ];
if IsSubgroup( G, H ) then
stb := H;
else
stb := Intersection2( G, H );
fi;
for grp in orb do
for k in [1..Length(gens)] do
img := List( GeneratorsOfGroup( grp ), x -> x^oprs[k] );
i := PositionProperty( orb,
g -> ForAll( img, x -> x in g ) );
if i = fail then
Add( orb, ConjugateGroup( grp, oprs[k] ) );
Add( rep, rep[Position(orb,grp)] * oprs[k] );
else
sch := rep[Position(orb,grp)] * gens[k] / rep[i];
if not sch in stb then
stb := ClosureGroup( stb, sch );
fi;
fi;
od;
od;
return Immutable( rec( orbit := orb, stabilizer := stb ) );
else
TryNextMethod();
fi;
end );
#############################################################################
##
#M RepresentativeAction( G, d, e, opr ) . . . . . . for an AffineCrystGroup
##
InstallOtherMethod( RepresentativeActionOp,
"G, d, e, opr for AffineCrystGroups", true,
[ IsAffineCrystGroupOnRight, IsAffineCrystGroupOnRight,
IsAffineCrystGroupOnRight, IsFunction ], 0,
function( G, d, e, opr )
local Td, Te, PG, f, r, n, Pd, Pe, r2, R, dim, gP, M, i, TG, tr1, tr2,
tt, res, gN, orb, rep, x, g, dd, redtrans;
if opr <> OnPoints then
TryNextMethod();
fi;
redtrans := function( TG, tr1, tr2, t2, P, U )
local dim, gen, t1, sol;
dim := DimensionOfMatrixGroup( P );
gen := List( GeneratorsOfGroup( P ),
x -> PreImagesRepresentativeNC( PointHomomorphism( U ), x ) );
t1 := Concatenation( List( gen, x -> x[dim+1]{[1..dim]} ) ) - t2;
sol := IntSolutionMat( tr1, -t1 );
if sol = fail then
return VectorModL( t2, tr2 );
else
return AugmentedMatrix( One( P ), sol{[1..Length(TG)]} * TG );
fi;
end;
# have the translation basis the same length?
Td := TranslationBasis( d );
Te := TranslationBasis( e );
if Length( Td ) <> Length( Te ) then
return fail;
fi;
# map translation basis onto each other
PG := PointGroup( G );
if Length( Td ) > 0 then
f := function(x,g) return ReducedLatticeBasis( x*g ); end;
r := RepresentativeAction( PG, Td, Te, f );
if r = fail then
return fail;
fi;
n := Stabilizer( PG, Te, f );
else
n := PG;
r := One( PG );
fi;
# map point groups onto each other
Pd := PointGroup( d );
Pe := PointGroup( e );
r2 := RepresentativeAction( n, Pd^r, Pe );
if r2 = fail then
return fail;
fi;
r := r*r2;
R := PreImagesRepresentativeNC( PointHomomorphism( G ), r );
dim := DimensionOfMatrixGroup( PG );
gP := GeneratorsOfGroup( Pe );
M := NullMat( Length(gP) * Length(Te), dim * Length(gP) );
if not IsEmpty( Te ) then
for i in [1..Length(gP)] do
M{[1..Length(Te)]+(i-1)*Length(Te)}{[1..dim]+(i-1)*dim} := Te;
od;
fi;
TG := TranslationBasis( G );
tr1 := List( TG, t -> Concatenation( List( gP, x -> t * ( One(Pe)-x ) ) ) );
tr1 := Concatenation( tr1, M );
tr2 := ReducedLatticeBasis( tr1 );
tt := List( gP, x -> PreImagesRepresentativeNC( PointHomomorphism(e), x ));
tt := Concatenation( List( tt, x -> x[dim+1]{[1..dim]} ) );
# is there a conjugating translation?
res := redtrans( TG, tr1, tr2, tt, Pe, d^R );
if IsMatrix( res ) then
return R * res;
fi;
# now we have to try the normalizer
gN := Filtered( GeneratorsOfGroup( Normalizer(n, Pe) ), x -> not x in Pe );
gN := List( gN, x -> PreImagesRepresentativeNC( PointHomomorphism(G), x ) );
orb := [ res ];
rep := [ R ];
for x in rep do
for g in gN do
dd := d ^ (x * g);
res := redtrans( TG, tr1, tr2, tt, Pe, dd );
if IsMatrix( res ) then
return x * g * res;
fi;
if not res in orb then
Add( orb, res );
Add( rep, x * g );
fi;
od;
od;
return fail;
end );
InstallOtherMethod( RepresentativeActionOp,
"G, d, e, opr for AffineCrystGroups", true,
[ IsAffineCrystGroupOnLeft, IsAffineCrystGroupOnLeft,
IsAffineCrystGroupOnLeft, IsFunction ], 0,
function( G, d, e, opr )
local C;
C := RepresentativeAction( TransposedMatrixGroup( G ),
TransposedMatrixGroup( d ), TransposedMatrixGroup( e ), opr );
if C = fail then
return fail;
else
return TransposedMat( C );
fi;
end );
#############################################################################
##
#F ConjugatingTranslation( G, gen, T)
##
## returns a translation t from the Z-span of T such that the elements
## of gen conjugated with t are in G (or fail if no such t exists)
##
ConjugatingTranslation := function( G, gen, T )
local d, b, TG, lt, lg, M, I, i, g, m, sol, t;
d := DimensionOfMatrixGroup( G ) - 1;
TG := TranslationBasis( G );
lt := Length( T );
lg := Length( TG );
b := [];
M := NullMat( lt + lg * Length(gen), d * Length(gen) );
I := IdentityMat( d );
for i in [1..Length(gen)] do
g := gen[i]{[1..d]}{[1..d]};
if not g in PointGroup( G ) then
return fail;
fi;
m := PreImagesRepresentativeNC( PointHomomorphism( G ), g );
Append( b, -gen[i][d+1]{[1..d]} + m[d+1]{[1..d]} );
M{[1..lt]}{[1..d]+(i-1)*d} := T * (I - g);
if lg > 0 then
M{[1..lg]+lt+(i-1)*lg}{[1..d]+(i-1)*d} := TG;
fi;
od;
sol := IntSolutionMat( M, b );
if IsList( sol ) then
sol := sol{[1..lt]} * T;
# t := AugmentedMatrix( I, sol );
# for g in gen do
# Assert( 0, g^t in G );
# od;
return sol;
else
return fail;
fi;
end;
#############################################################################
##
#M Normalizer( G, H ) . . . . . . . . . . . . . . . . . . . . . . normalizer
##
InstallMethod( NormalizerOp, "two AffineCrystGroupsOnRight", IsIdenticalObj,
[ IsAffineCrystGroupOnRight, IsAffineCrystGroupOnRight ], 0,
function( G, H )
local P, TH, TG, d, I, gens, T, t, trn, orb, rep, stb,
grp, gen, img, i, sch, g, b, M, m, sol, Q, N;
# we must normalize the point group and the translation subgroup
P := Normalizer( PointGroup( G ), PointGroup( H ) );
TH := TranslationBasis( H );
if TH <> [] then
P := Stabilizer( P, TH, function( x, g )
return ReducedLatticeBasis( x * g );
end );
fi;
# lift P to G
d := DimensionOfMatrixGroup( P );
I := IdentityMat( d );
gens := List( GeneratorsOfGroup( P ),
x -> PreImagesRepresentativeNC( PointHomomorphism( G ), x ) );
# stabilizer of translation conjugacy class of H
TG := TranslationBasis( G );
orb := [ H ];
rep := [ One( G ) ];
stb := TrivialSubgroup( G );
for grp in orb do
for gen in gens do
img := List( GeneratorsOfGroup( grp ), x -> x^gen );
i := PositionProperty( orb,
g -> ConjugatingTranslation( g, img, TG ) <> fail );
if i = fail then
Add( orb, ConjugateGroup( grp, gen ) );
Add( rep, rep[Position(orb,grp)] * gen );
else
sch := rep[Position(orb,grp)] * gen / rep[i];
stb := ClosureGroup( stb, sch );
fi;
od;
od;
gens := List( GeneratorsOfGroup( stb ), MutableMatrix );
# fix the translations
for gen in gens do
img := List( GeneratorsOfGroup( H ), x -> x^gen );
trn := ConjugatingTranslation( H, img, TG );
gen[d+1]{[1..d]} := gen[d+1]{[1..d]} + trn;
od;
gens := Set( gens );
# construct the pure translations
T := TG;
for g in GeneratorsOfGroup( PointGroup( H ) ) do
if T <> [] then
M := Concatenation( T * (g-I), TH );
M := M * Lcm( List( Flat( M ), DenominatorRat ) );
Q := IdentityMat( Length( M ) );
M := RowEchelonFormT( M, Q );
T := Q{[Length(M)+1..Length(Q)]}{[1..Length(T)]} * T;
T := ReducedLatticeBasis( T );
fi;
od;
for t in T do
Add( gens, AugmentedMatrix( I, t ) );
od;
# for g in gens do
# Assert( 0, H^g = H );
# od;
# construct the normalizer
N := AffineCrystGroupOnRight( gens, One( G ) );
AddTranslationBasis( N, T );
return N;
end );
InstallMethod( NormalizerOp, "two AffineCrystGroupsOnLeft", IsIdenticalObj,
[ IsAffineCrystGroupOnLeft, IsAffineCrystGroupOnLeft ], 0,
function( G, H )
return TransposedMatrixGroup(
Normalizer( TransposedMatrixGroup(G), TransposedMatrixGroup(H) ) );
end );
[ Dauer der Verarbeitung: 0.6 Sekunden
(vorverarbeitet)
]
|
