Quelle isom.gi
Sprache: unbekannt
|
|
#############################################################################
##
#W isom.gi QuaGroup Willem de Graaf
##
##
## Isomorphisms of quantized enveloping algebras.
##
#############################################################################
##
## Functions for creating and working with automorphisms of quea:
##
QGPrivateFunctions.invertq:= function( qelt )
local num, den, en, ed, i;
if not qelt in QuantumField then
Error("<qelt> does not lie in QuantumField");
fi;
num:= 0*_q; den:= 0*_q;
en:= ExtRepNumeratorRatFun( qelt );
ed:= ExtRepDenominatorRatFun( qelt );
for i in [1,3..Length(en)-1] do
if en[i] = [ ] then
num:= num+en[i+1];
else
num:= num + en[i+1]*_q^( -en[i][2] );
fi;
od;
for i in [1,3..Length(ed)-1] do
if ed[i] = [ ] then
den:= den+ed[i+1];
else
den:= den + ed[i+1]*_q^( -ed[i][2] );
fi;
od;
return num/den;
end;
QGPrivateFunctions.makeImageList:= function( U, imgs, isrev )
# imgs is a list of length 4*l; first the images of the F-gens,
# then the images of the K-gens, then K^-1-gens, finally the E-gens.
local g, fam, imlist, R, B, posR, convR, rank, s, sim,
i, x, pos, k, k1, k2, pair, rel, cf, qa, im, u,
r, qp, one, zero;
g:= GeneratorsOfAlgebra( U );
fam:= ElementsFamily( FamilyObj( U ) );
# we compute an image for each PBW-generator.
imlist:= [ ];
one:= imgs[1]^0;
zero:= imgs[1]*0;
R:= RootSystem( U );
B:= BilinearFormMatNF( R );
posR:= PositiveRootsNF( R );
convR:= PositiveRootsInConvexOrder( R );
rank:= Length( CartanMatrix(R) );
s:= Length( posR );
sim:= SimpleSystemNF( R );
# first we do the F elements
for i in [1..s] do
x:= Position( sim, posR[i] );
if x <> fail then
# simple root; get image from the input...
pos:= Position( convR, posR[i] );
imlist[pos]:= imgs[x];
else
# find a `definition' for F_{\alpha}
# find a simple root r such that posR[i]-r is also a root
for k in [1..rank ] do
k1:= Position( convR, posR[i] - sim[k] );
if k1 <> fail then
k2:= Position( convR, sim[k] );
if k1 > k2 then
pair:= [ k1, k2 ];
else
pair:= [ k2, k1 ];
fi;
rel:= List( fam!.multTab[pair[1]][pair[2]], ShallowCopy );
# see whether F_i is in there...
pos:= Position( rel, [ Position( convR, posR[i] ), 1 ] );
if pos <> fail then
break;
fi;
fi;
od;
# F_i is in `rel'; we get it out
cf:= rel[ pos+1];
Unbind( rel[pos] ); Unbind( rel[pos+1] );
rel:= Filtered( rel, x -> IsBound(x) );
for k in [2,4..Length(rel)] do
rel[k]:= -(1/cf)*rel[k];
od;
Add( rel, [ pair[1], 1, pair[2], 1 ] );
Add( rel, 1/cf );
qa:= _q^( -convR[k1]*( B*convR[k2] ) );
Add( rel, [ pair[2], 1, pair[1], 1 ] );
Add( rel, -qa/cf );
# Now compute the image of `rel' (which is the same as
# the image of F_i).
if isrev then
for k in [2,4..Length(rel)] do
rel[k]:= QGPrivateFunctions.invertq( rel[k] );
od;
fi;
im:= zero;
for k in [1,3..Length(rel)-1] do
u:= rel[k+1]*one;
for r in [1,3..Length(rel[k])-1] do
qp:= _q^( posR[i]*( B*posR[i] ) );
u:= u*( imlist[rel[k][r]]^rel[k][r+1] )/GaussianFactorial(
rel[k][r+1], qp );
od;
im:= im+u;
od;
pos:= Position( convR, posR[i] );
imlist[pos]:= im;
fi;
od;
# K-elements, just copy from the input....
for i in [s+1..s+2*rank] do
imlist[i]:= imgs[ rank+i-s ];
od;
# then we do the E elements
for i in [1..s] do
x:= Position( sim, posR[i] );
if x <> fail then
# simple root
pos:= Position( convR, posR[i] );
imlist[s+2*rank+pos]:= imgs[ 3*rank+x ];
else
# find a `definition' for E_{\alpha}
# find a simple root r such that posR[i]-r is also a root
for k in [1..rank ] do
k1:= Position( convR, posR[i] - sim[k] );
if k1 <> fail then
k2:= Position( convR, sim[k] );
if k1 > k2 then
pair:= [ s+rank+k1, s+rank+k2 ];
else
pair:= [ s+rank+k2, s+rank+k1 ];
fi;
rel:= List( fam!.multTab[pair[1]][pair[2]], ShallowCopy );
# See whether E_i is in rel:
pos:= Position( rel, [ Position( convR, posR[i] )+s+rank,
1 ] );
if pos <> fail then
break;
fi;
fi;
od;
# E_i is in `rel'; we get it out
cf:= rel[ pos+1];
Unbind( rel[pos] ); Unbind( rel[pos+1] );
rel:= Filtered( rel, x -> IsBound(x) );
for k in [2,4..Length(rel)] do
rel[k]:= -(1/cf)*rel[k];
od;
Add( rel, [ pair[1], 1, pair[2], 1 ] );
Add( rel, 1/cf );
qa:= _q^( -convR[k1]*( B*convR[k2] ) );
Add( rel, [ pair[2], 1, pair[1], 1 ] );
Add( rel, -qa/cf );
# Compute the image of rel...
if isrev then
for k in [2,4..Length(rel)] do
rel[k]:= QGPrivateFunctions.invertq( rel[k] );
od;
fi;
im:= zero;
for k in [1,3..Length(rel)-1] do
u:= rel[k+1]*one;
for r in [1,3..Length(rel[k])-1] do
qp:= _q^( posR[i]*( B*posR[i] ) );
u:= u*( imlist[rel[k][r]+rank]^rel[k][r+1] )/
GaussianFactorial( rel[k][r+1], qp );
od;
im:= im+u;
od;
pos:= Position( convR, posR[i] );
imlist[s+2*rank+pos]:= im;
fi;
od;
return imlist;
end;
InstallMethod( QEAAutomorphism,
"for a generic quea and a list", true,
[ IsGenericQUEA, IsList ], 0,
function( U, imgs )
local imlist, map;
imlist:= QGPrivateFunctions.makeImageList( U, imgs, false );
map:= Objectify( TypeOfDefaultGeneralMapping( U, U,
IsSPGeneralMapping
and IsAlgebraGeneralMapping
and IsGenericQUEAAutomorphism
and IsBijective
and IsAlgebraHomomorphism),
rec(
images := imlist,
rank:= Length( SimpleSystem( RootSystem(U) ) ),
noPosR:= Length( PositiveRoots( RootSystem(U) ) )
) );
SetIsqReversing( map, false );
return map;
end );
InstallMethod( QEAAutomorphism,
"for a quea and an autom. of the corr. generic quea",
true, [ IsQuantumUEA, IsGenericQUEAAutomorphism ], 0,
function( U, f )
if IsqReversing(f) then
Error("<f> must not map q to q^-1");
fi;
return Objectify( TypeOfDefaultGeneralMapping( U, U,
IsSPGeneralMapping
and IsAlgebraGeneralMapping
and IsInducedQUEAAutomorphism
and IsBijective
and IsAlgebraHomomorphism),
rec( origMap:= f ) );
end );
InstallMethod( PrintObj,
"for quea automorphism", true, [ IsQUEAAutomorphism ], 0,
function( map )
Print("<automorphism of ",Source( map ),">");
end );
InstallMethod( ImageElm,
"for quea aut, and elm",
true, [ IsGenericQUEAHomomorphism, IsQEAElement ], 0,
function( map, x )
local rew_K_noninv, rew_K_inv, ex, U, R, B, posR, sim,
noposR, rank, im, i, u, j, qp, zero, one;
rew_K_noninv:= function( a, b, delta, s, qpar )
local res, i;
res:= a^delta;
for i in [1..s] do
res:= res*( qpar^(-i+1)*a-qpar^(i-1)*b )/( qpar^i-qpar^-i );
od;
return res;
end;
rew_K_inv:= function( a, b, delta, s, qpar )
local res, i;
res:= a^delta;
for i in [1..s] do
res:= res*( qpar^(i-1)*a-qpar^(-i+1)*b )/( qpar^-i-qpar^i );
od;
return res;
end;
ex:= ExtRepOfObj( x );
U:= Source( map );
R:= RootSystem( U );
B:= BilinearFormMatNF( R );
posR:= PositiveRootsInConvexOrder( R );
sim:= SimpleSystemNF( R );
noposR:= map!.noPosR;
rank:= map!.rank;
zero:= Zero( Range( map ) );
one:= One( Range( map ) );
im:= zero;
for i in [1,3..Length(ex)-1] do
if IsqReversing( map ) then
u:= QGPrivateFunctions.invertq( ex[i+1] )*one;
else
u:= ex[i+1]*one;
fi;
for j in [1,3..Length(ex[i])-1] do
if IsList( ex[i][j] ) then
#it is a K...; more difficult.
qp:= _q^( sim[ ex[i][j][1]-noposR ]*
( B*sim[ ex[i][j][1]-noposR ] )/2);
if IsqReversing( map ) then
u:= u*rew_K_inv( map!.images[ ex[i][j][1] ],
map!.images[ ex[i][j][1]+map!.rank ],
ex[i][j][2],
ex[i][j+1], qp );
else
u:= u*rew_K_noninv( map!.images[ ex[i][j][1] ],
map!.images[ ex[i][j][1]+map!.rank ],
ex[i][j][2],
ex[i][j+1], qp );
fi;
elif ex[i][j] <= map!.noPosR then
#it is an F...
qp:= _q^( posR[ ex[i][j] ]*( B*posR[ ex[i][j] ] )/2 );
u:= u*( map!.images[ ex[i][j] ]^ex[i][j+1] )/
GaussianFactorial( ex[i][j+1], qp );
else
#it is an E...
qp:= _q^( posR[ ex[i][j]-noposR-rank ]*(
B*posR[ ex[i][j]-noposR-rank ] )/2 );
u:= u*( map!.images[ ex[i][j]+rank ]^ex[i][j+1] )/
GaussianFactorial( ex[i][j+1], qp );
fi;
od;
im:= im+u;
od;
return im;
end );
InstallMethod( ImageElm,
"for induced quea aut, and elm",
true, [ IsInducedQUEAAutomorphism, IsQEAElement ], 0,
function( map, x )
local U, qp, U0, f0, im, ex, i, y, ey, j;
U:= Source( map );
qp:= QuantumParameter( U );
U0:= QuantizedUEA( RootSystem( U ) );
f0:= map!.origMap;
im:= Zero( U );
ex:= ExtRepOfObj( x );
for i in [1,3..Length(ex)-1] do
y:= ObjByExtRep( ElementsFamily(FamilyObj(U0)), [ ShallowCopy(ex[i]),
QuantumParameter(U0)^0 ] );
y:= Image( f0, y );
ey:= ShallowCopy( ExtRepOfObj(y) );
for j in [2,4..Length(ey)] do
ey[j]:= Value( ey[j], qp )*ex[i+1];
if IsZero( ey[j] ) then
Unbind( ey[j] ); Unbind(ey[j-1]);
fi;
od;
ey:= Filtered( ey, x -> IsBound(x) );
im:= im + ObjByExtRep( ElementsFamily(FamilyObj(U)), ey );
od;
return im;
end );
InstallMethod( \*,
"for two qea automorphisms", true,
[ IsGenericQUEAAutomorphism, IsGenericQUEAAutomorphism ], 0,
function( f, g )
local U, ims, map;
if not IsIdenticalObj( Range(f), Source(g) ) then
Error( "Range( <f> ) and Source( <g> ) do not match");
fi;
U:= Source( f );
ims:= List( g!.images, x -> Image( f, x ) );
map:= Objectify( TypeOfDefaultGeneralMapping( U, U,
IsSPGeneralMapping
and IsAlgebraGeneralMapping
and IsGenericQUEAAutomorphism
and IsBijective
and IsAlgebraHomomorphism),
rec(
images := ims,
rank:= f!.rank,
noPosR:= f!.noPosR
) );
# map is q-reversing iff exactly one of f, g is q-reversing.
SetIsqReversing( map, ( IsqReversing(f) or IsqReversing(g) ) and
not ( IsqReversing(f) and IsqReversing(g) ) );
return map;
end );
InstallMethod( \*,
"for two induced qea automorphisms", true,
[ IsInducedQUEAAutomorphism, IsInducedQUEAAutomorphism ], 0,
function( f, g )
if not IsIdenticalObj( Range(f), Source(g) ) then
Error( "Range( <f> ) and Source( <g> ) do not match");
fi;
return QEAAutomorphism( Source(f), f!.origMap*g!.origMap );
end );
##################################################################################
##
## Same as above, but now for aniautomorphisms:
##
InstallMethod( QEAAntiAutomorphism,
"for a generic quea and an algebra, and a list", true,
[ IsGenericQUEA, IsList ], 0,
function( U, imgs )
# imgs is a list of length 4*l; first the images of the F-gens,
# then the images of the K-gens, then K^-1-gens, finally the E-gens.
local g, fam, imlist, R, B, posR, convR, rank, s, sim,
i, x, pos, k, k1, k2, pair, rel, cf, qa, im, u,
r, qp, map, images;
g:= GeneratorsOfAlgebra( U );
fam:= ElementsFamily( FamilyObj( U ) );
# we compute an image for each PBW-generator.
imlist:= [ ];
R:= RootSystem( U );
B:= BilinearFormMatNF( R );
posR:= PositiveRootsNF( R );
convR:= PositiveRootsInConvexOrder( R );
rank:= Length( CartanMatrix(R) );
s:= Length( posR );
sim:= SimpleSystemNF( R );
# first we do the F elements
for i in [1..s] do
x:= Position( sim, posR[i] );
if x <> fail then
# simple root; get image from the input...
pos:= Position( convR, posR[i] );
imlist[pos]:= imgs[x];
else
# find a `definition' for F_{\alpha}
# find a simple root r such that posR[i]-r is also a root
for k in [1..rank ] do
k1:= Position( convR, posR[i] - sim[k] );
if k1 <> fail then
k2:= Position( convR, sim[k] );
if k1 > k2 then
pair:= [ k1, k2 ];
else
pair:= [ k2, k1 ];
fi;
rel:= List( fam!.multTab[pair[1]][pair[2]], ShallowCopy );
# see whether F_i is in there...
pos:= Position( rel, [ Position( convR, posR[i] ), 1 ] );
if pos <> fail then
break;
fi;
fi;
od;
# F_i is in `rel'; we get it out
cf:= rel[ pos+1];
Unbind( rel[pos] ); Unbind( rel[pos+1] );
rel:= Filtered( rel, x -> IsBound(x) );
for k in [2,4..Length(rel)] do
rel[k]:= -(1/cf)*rel[k];
od;
Add( rel, [ pair[1], 1, pair[2], 1 ] );
Add( rel, 1/cf );
qa:= _q^( -convR[k1]*( B*convR[k2] ) );
Add( rel, [ pair[2], 1, pair[1], 1 ] );
Add( rel, -qa/cf );
# Now compute the image of `rel' (which is the same as
# the image of F_i).
im:= Zero( U );
for k in [1,3..Length(rel)-1] do
u:= rel[k+1]*One( U );
for r in [1,3..Length(rel[k])-1] do
qp:= _q^( posR[i]*( B*posR[i] ) );
u:= (( imlist[rel[k][r]]^rel[k][r+1] )/GaussianFactorial(
rel[k][r+1], qp ))*u;
od;
im:= im+u;
od;
pos:= Position( convR, posR[i] );
imlist[pos]:= im;
fi;
od;
# K-elements, just copy from the input....
for i in [s+1..s+2*rank] do
imlist[i]:= imgs[ rank+i-s ];
od;
# then we do the E elements
for i in [1..s] do
x:= Position( sim, posR[i] );
if x <> fail then
# simple root
pos:= Position( convR, posR[i] );
imlist[s+2*rank+pos]:= imgs[ 3*rank+x ];
else
# find a `definition' for E_{\alpha}
# find a simple root r such that posR[i]-r is also a root
for k in [1..rank ] do
k1:= Position( convR, posR[i] - sim[k] );
if k1 <> fail then
k2:= Position( convR, sim[k] );
if k1 > k2 then
pair:= [ s+rank+k1, s+rank+k2 ];
else
pair:= [ s+rank+k2, s+rank+k1 ];
fi;
rel:= List( fam!.multTab[pair[1]][pair[2]], ShallowCopy );
# See whether E_i is in rel:
pos:= Position( rel, [ Position( convR, posR[i] )+s+rank,
1 ] );
if pos <> fail then
break;
fi;
fi;
od;
# E_i is in `rel'; we get it out
cf:= rel[ pos+1];
Unbind( rel[pos] ); Unbind( rel[pos+1] );
rel:= Filtered( rel, x -> IsBound(x) );
for k in [2,4..Length(rel)] do
rel[k]:= -(1/cf)*rel[k];
od;
Add( rel, [ pair[1], 1, pair[2], 1 ] );
Add( rel, 1/cf );
qa:= _q^( -convR[k1]*( B*convR[k2] ) );
Add( rel, [ pair[2], 1, pair[1], 1 ] );
Add( rel, -qa/cf );
# Compute the image of rel...
im:= Zero( U );
for k in [1,3..Length(rel)-1] do
u:= rel[k+1]*One( U );
for r in [1,3..Length(rel[k])-1] do
qp:= _q^( posR[i]*( B*posR[i] ) );
u:= ( ( imlist[rel[k][r]+rank]^rel[k][r+1] )/
GaussianFactorial( rel[k][r+1], qp ) )*u;
od;
im:= im+u;
od;
pos:= Position( convR, posR[i] );
imlist[s+2*rank+pos]:= im;
fi;
od;
map:= Objectify( TypeOfDefaultGeneralMapping( U, U,
IsSPGeneralMapping
and IsAlgebraGeneralMapping
and IsGenericQUEAAntiAutomorphism
and IsBijective
and IsAlgebraHomomorphism),
rec(
images := imlist,
rank:= rank,
noPosR:= s
) );
SetIsqReversing( map, false );
return map;
end );
InstallMethod( QEAAntiAutomorphism,
"for a quea and an anti atom. of the corr. generic quea",
true, [ IsQuantumUEA, IsGenericQUEAAntiAutomorphism ], 0,
function( U, f )
return Objectify( TypeOfDefaultGeneralMapping( U, U,
IsSPGeneralMapping
and IsAlgebraGeneralMapping
and IsInducedQUEAAntiAutomorphism
and IsBijective
and IsAlgebraHomomorphism),
rec( origMap:= f ) );
end );
InstallMethod( PrintObj,
"for quea anti automorphism", true, [ IsQUEAAntiAutomorphism ], 0,
function( map )
Print("<anti-automorphism of ",Source( map ),">");
end );
InstallMethod( ImageElm,
"for quea aut, and elm",
true, [ IsGenericQUEAAntiAutomorphism, IsQEAElement ], 0,
function( map, x )
local rew_K_noninv, rew_K_inv, ex, U, R, B, posR, sim,
noposR, rank, im, i, u, j, qp;
rew_K_noninv:= function( a, b, delta, s, qpar )
local res, i;
res:= a^delta;
for i in [1..s] do
res:= res*( qpar^(-i+1)*a-qpar^(i-1)*b )/( qpar^i-qpar^-i );
od;
return res;
end;
rew_K_inv:= function( a, b, delta, s, qpar )
local res, i;
res:= a^delta;
for i in [1..s] do
res:= res*( qpar^(i-1)*a-qpar^(-i+1)*b )/( qpar^-i-qpar^i );
od;
return res;
end;
ex:= ExtRepOfObj( x );
U:= Source( map );
R:= RootSystem( U );
B:= BilinearFormMatNF( R );
posR:= PositiveRootsInConvexOrder( R );
sim:= SimpleSystemNF( R );
noposR:= map!.noPosR;
rank:= map!.rank;
im:= Zero( U );
for i in [1,3..Length(ex)-1] do
if IsqReversing( map ) then
u:= QGPrivateFunctions.invertq( ex[i+1] )*One( U );
else
u:= ex[i+1]*One( U );
fi;
for j in [1,3..Length(ex[i])-1] do
if IsList( ex[i][j] ) then
#it is a K...; more difficult.
qp:= _q^( sim[ ex[i][j][1]-noposR ]*
( B*sim[ ex[i][j][1]-noposR ] )/2 );
if IsqReversing( map ) then
u:= rew_K_inv( map!.images[ ex[i][j][1] ],
map!.images[ ex[i][j][1]+map!.rank ],
ex[i][j][2],
ex[i][j+1], qp )*u;
else
u:= rew_K_noninv( map!.images[ ex[i][j][1] ],
map!.images[ ex[i][j][1]+map!.rank ],
ex[i][j][2],
ex[i][j+1], qp )*u;
fi;
elif ex[i][j] <= map!.noPosR then
#it is an F...
qp:= _q^( posR[ ex[i][j] ]*( B*posR[ ex[i][j] ] )/2 );
u:= (( map!.images[ ex[i][j] ]^ex[i][j+1] )/
GaussianFactorial( ex[i][j+1], qp ))*u;
else
#it is an E...
qp:= _q^( posR[ ex[i][j]-noposR-rank ]*(
B*posR[ ex[i][j]-noposR-rank ] )/2 );
u:= (( map!.images[ ex[i][j]+rank ]^ex[i][j+1] )/
GaussianFactorial( ex[i][j+1], qp ))*u;
fi;
od;
im:= im+u;
od;
return im;
end );
InstallMethod( ImageElm,
"for induced quea anti aut, and elm",
true, [ IsInducedQUEAAntiAutomorphism, IsQEAElement ], 0,
function( map, x )
local U, qp, U0, f0, im, ex, i, y, ey, j;
U:= Source( map );
qp:= QuantumParameter( U );
U0:= QuantizedUEA( RootSystem( U ) );
f0:= map!.origMap;
im:= Zero( U );
ex:= ExtRepOfObj( x );
for i in [1,3..Length(ex)-1] do
y:= ObjByExtRep( ElementsFamily(FamilyObj(U0)), [ ShallowCopy(ex[i]),
QuantumParameter(U0)^0 ] );
y:= Image( f0, y );
ey:= ShallowCopy( ExtRepOfObj(y) );
for j in [2,4..Length(ey)] do
ey[j]:= Value( ey[j], qp )*ex[i+1];
if IsZero( ey[j] ) then
Unbind( ey[j] ); Unbind(ey[j-1]);
fi;
od;
ey:= Filtered( ey, x -> IsBound(x) );
im:= im + ObjByExtRep( ElementsFamily(FamilyObj(U)), ey );
od;
return im;
end );
InstallMethod( \*,
"for two qea anti automorphisms", true,
[ IsGenericQUEAAntiAutomorphism, IsGenericQUEAAntiAutomorphism ], 0,
function( f, g )
local U, ims, map;
if not IsIdenticalObj( Range(f), Source(g) ) then
Error( "Range( <f> ) and Source( <g> ) do not match");
fi;
U:= Source( f );
ims:= List( g!.images, x -> Image( f, x ) );
map:= Objectify( TypeOfDefaultGeneralMapping( U, U,
IsSPGeneralMapping
and IsAlgebraGeneralMapping
and IsGenericQUEAAutomorphism
and IsBijective
and IsAlgebraHomomorphism),
rec(
images := ims,
rank:= f!.rank,
noPosR:= f!.noPosR
) );
# map is q-reversing iff exactly one of f, g is q-reversing.
SetIsqReversing( map, ( IsqReversing(f) or IsqReversing(g) ) and
not ( IsqReversing(f) and IsqReversing(g) ) );
return map;
end );
InstallMethod( \*,
"for two induced qea automorphisms", true,
[ IsInducedQUEAAntiAutomorphism, IsInducedQUEAAntiAutomorphism ], 0,
function( f, g )
if not IsIdenticalObj( Range(f), Source(g) ) then
Error( "Range( <f> ) and Source( <g> ) do not match");
fi;
return QEAAutomorphism( Source(f), f!.origMap*g!.origMap );
end );
InstallMethod( \*,
"for an automorphism and an antiautomorphism", true,
[ IsGenericQUEAAutomorphism, IsGenericQUEAAntiAutomorphism ], 0,
function( f, g )
local U, ims, map;
if not IsIdenticalObj( Range(f), Source(g) ) then
Error( "Range( <f> ) and Source( <g> ) do not match");
fi;
U:= Source( f );
ims:= List( g!.images, x -> Image( f, x ) );
map:= Objectify( TypeOfDefaultGeneralMapping( U, U,
IsSPGeneralMapping
and IsAlgebraGeneralMapping
and IsGenericQUEAAntiAutomorphism
and IsBijective
and IsAlgebraHomomorphism),
rec(
images := ims,
rank:= f!.rank,
noPosR:= f!.noPosR
) );
# map is q-reversing iff exactly one of f, g is q-reversing.
SetIsqReversing( map, ( IsqReversing(f) or IsqReversing(g) ) and
not ( IsqReversing(f) and IsqReversing(g) ) );
return map;
end );
InstallMethod( \*,
"for an automorphism and an antiautomorphism", true,
[ IsInducedQUEAAutomorphism, IsInducedQUEAAntiAutomorphism ], 0,
function( f, g )
if not IsIdenticalObj( Range(f), Source(g) ) then
Error( "Range( <f> ) and Source( <g> ) do not match");
fi;
return QEAAntiAutomorphism( Source(f),
f!.origMap*g!.origMap );
end );
InstallMethod( \*,
"for an automorphism and an antiautomorphism", true,
[ IsGenericQUEAAntiAutomorphism, IsGenericQUEAAutomorphism ], 0,
function( f, g )
local U, ims, map;
if not IsIdenticalObj( Range(f), Source(g) ) then
Error( "Range( <f> ) and Source( <g> ) do not match");
fi;
U:= Source( f );
ims:= List( g!.images, x -> Image( f, x ) );
map:= Objectify( TypeOfDefaultGeneralMapping( U, U,
IsSPGeneralMapping
and IsAlgebraGeneralMapping
and IsGenericQUEAAntiAutomorphism
and IsBijective
and IsAlgebraHomomorphism),
rec(
images := ims,
rank:= f!.rank,
noPosR:= f!.noPosR
) );
# map is q-reversing iff exactly one of f, g is q-reversing.
SetIsqReversing( map, ( IsqReversing(f) or IsqReversing(g) ) and
not ( IsqReversing(f) and IsqReversing(g) ) );
return map;
end );
InstallMethod( \*,
"for an automorphism and an antiautomorphism", true,
[ IsInducedQUEAAntiAutomorphism, IsInducedQUEAAutomorphism ], 0,
function( f, g )
if not IsIdenticalObj( Range(f), Source(g) ) then
Error( "Range( <f> ) and Source( <g> ) do not match");
fi;
return QEAAntiAutomorphism( Source(f),
f!.origMap*g!.origMap );
end );
#################################################################################
##
## Functions for creating some particular automorphisms:
##
InstallMethod( AutomorphismOmega,
"for a quea", true, [IsQuantumUEA], 0,
function( U )
local U0, R, posR, sim, rank, noR, g, ims, i, f;
if IsGenericQUEA( U ) then
U0:= U;
else
U0:= QuantizedUEA( RootSystem( U ) );
fi;
R:= RootSystem( U0 );
posR:= PositiveRootsInConvexOrder( R );
sim:= SimpleSystemNF( R );
rank:= Length( sim );
noR:= Length( posR );
g:= GeneratorsOfAlgebra( U0 );
ims:= [ ];
# F_alpha is mapped to E_alpha:
for i in [1..rank] do
Add( ims, g[ Position( posR, sim[i] )+2*rank+noR ] );
od;
# K_alpha --> K_alpha^-1
for i in [1..rank] do
Add( ims, g[ noR+2*i ] );
od;
# K_alpha^-1 --> K_alpha
for i in [1..rank] do
Add( ims, g[noR+2*i-1] );
od;
# E_alpha --> F_alpha
for i in [1..rank] do
Add( ims, g[ Position( posR, sim[i] ) ] );
od;
f:= QEAAutomorphism( U0, ims );
if IsGenericQUEA( U ) then
SetIsqReversing( f, false );
return f;
else
return QEAAutomorphism( U, f );
fi;
end );
InstallMethod( AntiAutomorphismTau,
"for a quea", true, [IsQuantumUEA], 0,
function( U )
local U0, R, posR, sim, rank, noR, g, ims, i, f;
if IsGenericQUEA( U ) then
U0:= U;
else
U0:= QuantizedUEA( RootSystem( U ) );
fi;
R:= RootSystem( U0 );
posR:= PositiveRootsInConvexOrder( R );
sim:= SimpleSystemNF( R );
rank:= Length( sim );
noR:= Length( posR );
g:= GeneratorsOfAlgebra( U0 );
ims:= [ ];
# F_alpha is mapped to F_alpha:
for i in [1..rank] do
Add( ims, g[ Position( posR, sim[i] ) ] );
od;
# K_alpha --> K_alpha^-1
for i in [1..rank] do
Add( ims, g[ noR+2*i ] );
od;
# K_alpha^-1 --> K_alpha
for i in [1..rank] do
Add( ims, g[noR+2*i-1] );
od;
# E_alpha --> E_alpha
for i in [1..rank] do
Add( ims, g[ Position( posR, sim[i] ) +2*rank+noR] );
od;
f:= QEAAntiAutomorphism( U0, ims );
if IsGenericQUEA( U ) then
SetIsqReversing( f, false );
return f;
else
return QEAAntiAutomorphism( U, f );
fi;
end );
InstallMethod( AutomorphismTalpha,
"for a quea", true, [IsQuantumUEA,IsInt], 0,
function( U, ind )
local U0, R, posR, sim, rank, noR, g, ims, i, f, qp, a, u, r, b, j;
if IsGenericQUEA( U ) then
U0:= U;
else
U0:= QuantizedUEA( RootSystem( U ) );
fi;
R:= RootSystem( U0 );
posR:= PositiveRootsInConvexOrder( R );
sim:= SimpleSystemNF( R );
rank:= Length( sim );
noR:= Length( posR );
qp:= QuantumParameter(U0)^( BilinearFormMatNF(R)[ind][ind]/2 );
g:= GeneratorsOfAlgebra( U0 );
ims:= [ ];
# F_beta...
a:= g[ Position( posR, sim[ind] ) ];
for i in [1..rank] do
if i = ind then
# F_alpha is mapped to -K_alpha^-1 E_alpha:
Add( ims, -g[ noR+2*i ]*g[ Position( posR, sim[i] )+2*rank+noR ] );
else
# F_alpha is mapped to a sum..
u:= Zero( U0 );
r:= -CartanMatrix(R)[i][ind];
b:= g[ Position( posR, sim[i] ) ];
for j in [0..r] do
u:= u + (-qp)^j*( a^j/GaussianFactorial(j,qp) )*b*
a^(r-j)/GaussianFactorial(r-j,qp);
od;
Add( ims, u );
fi;
od;
# K_alpha...
for i in [1..rank] do
if i = ind then
Add( ims, g[ noR+2*i ] );
else
Add( ims, g[noR+2*i-1]*g[noR+2*ind-1]^-CartanMatrix(R)[i][ind] );
fi;
od;
# K_alpha^-1:
for i in [1..rank] do
if i = ind then
Add( ims, g[noR+2*i-1] );
else
Add( ims, g[noR+2*i]*g[noR+2*ind]^-CartanMatrix(R)[i][ind] );
fi;
od;
# E_beta
a:= g[ Position( posR, sim[ind] ) +2*rank+noR ];
for i in [1..rank] do
if i = ind then
# E_alpha is mapped to -F_alpha K_alpha
Add( ims, -g[ Position( posR, sim[i] ) ]*g[ noR+2*i-1 ] );
else
# E_alpha is mapped to a sum..
u:= Zero( U0 );
r:= -CartanMatrix(R)[i][ind];
b:= g[ Position( posR, sim[i] )+noR+2*rank ];
for j in [0..r] do
u:= u + (-qp^-1)^j*( a^(r-j)/GaussianFactorial(r-j,qp) )*b*
a^(j)/GaussianFactorial(j,qp);
od;
Add( ims, u );
fi;
od;
f:= QEAAutomorphism( U0, ims );
if IsGenericQUEA( U ) then
SetIsqReversing( f, false );
return f;
else
return QEAAutomorphism( U, f );
fi;
end );
InstallMethod( DiagramAutomorphism,
"for a quea and a permutation", true, [IsQuantumUEA, IsPerm], 0,
function( U, p )
local U0, R, posR, sim, rank, noR, g, ims, i, f;
if IsGenericQUEA( U ) then
U0:= U;
else
U0:= QuantizedUEA( RootSystem( U ) );
fi;
R:= RootSystem( U0 );
posR:= PositiveRootsInConvexOrder( R );
sim:= SimpleSystemNF( R );
rank:= Length( sim );
noR:= Length( posR );
g:= GeneratorsOfAlgebra( U0 );
ims:= [ ];
# F_alpha is mapped to F_p(\alpha):
for i in [1..rank] do
Add( ims, g[ Position( posR, sim[i^p] ) ] );
od;
# K_alpha --> K_p(alpha)
for i in [1..rank] do
Add( ims, g[ noR+2*(i^p)-1 ] );
od;
# K_alpha^-1 --> K_p(alpha)^-1
for i in [1..rank] do
Add( ims, g[noR+2*(i^p)] );
od;
# E_alpha --> E_p(alpha)
for i in [1..rank] do
Add( ims, g[ Position( posR, sim[i^p] ) +2*rank+noR ] );
od;
f:= QEAAutomorphism( U0, ims );
if IsGenericQUEA( U ) then
SetIsqReversing( f, false );
return f;
else
return QEAAutomorphism( U, f );
fi;
end );
InstallMethod( BarAutomorphism,
"for a quea", true, [IsGenericQUEA], 0,
function( U )
local imgs, g, R, sim, posR, s, rank, i, pos, imlist,
map, images, noPosR;
imgs:= [ ];
g:= GeneratorsOfAlgebra( U );
R:= RootSystem( U );
sim:= SimpleSystemNF( R );
posR:= PositiveRootsInConvexOrder( R );
s:= Length( posR );
rank:= Length(sim);
for i in [1..rank] do
pos:= Position( posR, sim[i] );
imgs[i]:= g[ pos ];
imgs[rank+i]:= g[ s+2*i ];
imgs[ 2*rank+i ]:= g[ s+2*i-1 ];
imgs[ 3*rank+i ]:= g[ s+2*rank+pos ];
od;
imlist:= QGPrivateFunctions.makeImageList( U, imgs, true );
map:= Objectify( TypeOfDefaultGeneralMapping( U, U,
IsSPGeneralMapping
and IsAlgebraGeneralMapping
and IsGenericQUEAAutomorphism
and IsBijective
and IsAlgebraHomomorphism),
rec(
images := imlist,
rank:= rank,
noPosR:= s
) );
SetIsqReversing( map, true );
return map;
end );
#############################################################################
##
## Functions for creating homomorphisms:
##
## We note that this only works "generically", in order to create
## non-generic homomorphisms U' --> A', we would need a generic map
## U --> A, along with a map A --> A', somehow substituting the
## quantum parameter. This seems rather cumbersome to do in general.
## (Also it is not clear what A must be in general).
##
InstallMethod( QEAHomomorphism,
"for a generic quea, an algebra and a list", true,
[ IsGenericQUEA, IsObject, IsList ], 0,
function( U, A, imgs )
local imlist, map;
imlist:= QGPrivateFunctions.makeImageList( U, imgs, false );
map:= Objectify( TypeOfDefaultGeneralMapping( U, A,
IsSPGeneralMapping
and IsAlgebraGeneralMapping
and IsGenericQUEAHomomorphism
and IsAlgebraHomomorphism),
rec(
images := imlist,
rank:= Length( SimpleSystem( RootSystem(U) ) ),
noPosR:= Length( PositiveRoots( RootSystem(U) ) )
) );
SetIsqReversing( map, false );
return map;
end );
InstallMethod( PrintObj,
"for quea homomorphism", true, [ IsQUEAHomomorphism ], 0,
function( map )
Print("<homomorphism: ",Source( map )," -> ",Range(map),">");
end );
[ Dauer der Verarbeitung: 0.43 Sekunden
(vorverarbeitet)
]
|
2026-04-02
|