Quelle fplie.gi
Sprache: unbekannt
|
|
#####################################################################################
#
# fplie.gi Serena Cicalo' and Willem de Graaf
#
#
# The package LieRing 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.
# Functions for working with free algebras.
# first we install the record containing all
# sorts of functions we want to write protect
InstallValue( LRPrivateFunctions, rec() );
############################################################################
##
#M ObjByExtRep( <fam>, <list> )
#M ExtRepOfObj( <obj> )
#
InstallMethod( ObjByExtRep,
"for family of FAlg elements, and list",
true, [ IsFAlgElementFamily, IsList ], 0,
function( fam, list )
return Objectify( fam!.defaultType,
[ Immutable(list) ] );
end );
InstallMethod( ExtRepOfObj,
"for an FAlg element",
true, [ IsFAlgElement ], 0,
function( obj )
return obj![1];
end );
InstallMethod( PrintObj,
"for FAlg element",
[ IsFAlgElement ],
function( elm )
local names, print, e, i, len;
names:= FamilyObj( elm )!.names;
print:= function( expr )
if IsBound(expr.var) then
Print( names[ expr.var ] );
else
Print( "(" );
print( expr.left );
Print( "," );
print( expr.right );
Print( ")" );
fi;
end;
e:= elm![1];
len:= Length( e );
for i in [ 1, 3 .. len - 1 ] do
if not IsOne( e[i+1] ) then
Print( "(",e[i+1],")*");
fi;
if i < len-1 then
print( e[i] ); Print("+");
else
print( e[i] );
fi;
od;
if len = 0 then
Print( "0" );
fi;
end );
#############################################################################
##
#M ZeroOp( <m> ) . . . . . . . . . . . . . . . for a Falg element
#M \<( <m1>, <m2> ) . . . . . . . . . . . . . . for two Falg elements
#M \=( <m1>, <m2> ) . . . . . . . . . . . . . . for two Falg elements
#M \+( <m1>, <m2> ) . . . . . . . . . . . . . . for two Falg elements
#M \-( <m> ) . . . . . . . . . . . . . . for a Falg element
#M \in( <U>, <u> ) . . . . . . . . . . . . . . for Free algebra, and element
##
InstallMethod( ZeroOp,
"for FAlg element",
true, [ IsFAlgElement ], 0,
function( x )
return ObjByExtRep( FamilyObj( x ), [ ] );
end );
InstallMethod( \<,
"for two FAlg elements",
IsIdenticalObj, [ IsFAlgElement, IsFAlgElement ], 0,
function( x, y )
return x![1]< y![1];
end );
InstallMethod( \=,
"for two FAlg elements",
IsIdenticalObj, [ IsFAlgElement, IsFAlgElement], 0,
function( x, y )
local len, i;
return x![1] = y![1];
end );
LRPrivateFunctions.direct_sum:= function( F, x, y )
local sum,z,mons,o,ord;
o:= F!.ordering;
ord:= function( a, b )
return o[a.no] < o[b.no];
end;
sum:= ZIPPED_SUM_LISTS( x, y, F!.zeroCoefficient, [ ord, \+ ] );
return sum;
end;
InstallMethod( \+,
"for two FAlg elements",
true, [ IsFAlgElement, IsFAlgElement ], 0,
function( x, y )
local F;
F:= FamilyObj(x);
return ObjByExtRep( F, LRPrivateFunctions.direct_sum( F, x![1], y![1] ) );
end );
LRPrivateFunctions.dir_monmult:= function( F, x, y )
local T, mons, o, ord_1, a, b, c, i, j, t1, t2, s1, r, pos, num, p, s;
T:= F!.multTable;
mons:= F!.monomials;
o:= F!.ordering;
ord_1:= function( mon1, mon2 )
if mon1.no = mon2.no then return false; fi;
if mon1.deg <> mon2.deg then return mon1.deg < mon2.deg; fi;
if mon1.left.no <> mon2.left.no then return o[mon1.left.no] < o[mon2.left.no]; fi;
return o[mon1.right.no] < o[mon2.right.no];
end;
a:= x[1]; b:= y[1];
c:= x[2]*y[2];
i:= a.no; j:= b.no;
if F!.sign = -1 then
if i = j then return [ a, 0*c ]; fi;
if i > j then
t1:= j; t2:= i;
s1:= -1;
else
t1:= i; t2:= j;
s1:= 1;
fi;
if IsBound( T[t1] ) and IsBound( T[t1][t2] ) then
r:= T[t1][t2];
pos:= o[ r[1] ];
return [ mons[pos], s1*r[2]*c ];
fi;
# If we arrive here then the product is not known yet.
num:= Length( mons ) + 1; # number of new monomial...
if o[i] < o[j] then
# i.e., a < b
p:= rec( no:= num, deg:= a.deg+b.deg, left:= a, right:= b );
s:= 1;
else
p:= rec( no:= num, deg:= a.deg+b.deg, left:= b, right:= a );
c:= -c;
s:= -1;
fi;
if not IsBound( T[t1] ) then T[t1]:= [ ]; fi;
T[t1][t2]:= [ num, s*s1 ];
F!.multTable:= T;
# now we have to insert p in the sorted list of monomials...
pos:= POSITION_SORTED_LIST_COMP( mons, p, ord_1 );
for i in [pos..Length(o)] do o[ mons[i].no ]:= o[ mons[i].no ]+1; od;
Add( o, pos );
CopyListEntries(mons,pos,1,mons,pos+1,1,Length(mons)-pos+1);
mons[pos]:= p;
F!.monomials:= mons;
F!.ordering:= o;
return [ p, c ];
else
# The extremely free multiplication...
if IsBound( T[i] ) and IsBound( T[i][j] ) then
r:= T[i][j];
pos:= o[ r ];
return [ mons[pos], c ];
fi;
# If we arrive here then the product is not known yet.
num:= Length( mons ) + 1; # number of new monomial...
p:= rec( no:= num, deg:= a.deg+b.deg, left:= a, right:= b );
if not IsBound( T[i] ) then T[i]:= [ ]; fi;
T[i][j]:= num;
F!.multTable:= T;
# now we have to insert p in the sorted list of monomials...
pos:= POSITION_SORTED_LIST_COMP( mons, p, ord_1 );
for i in [pos..Length(o)] do o[ mons[i].no ]:= o[ mons[i].no ]+1; od;
Add( o, pos );
CopyListEntries(mons,pos,1,mons,pos+1,1,Length(mons)-pos+1);
mons[pos]:= p;
F!.monomials:= mons;
F!.ordering:= o;
return [ p, c ];
fi;
end;
LRPrivateFunctions.monmult:= function( x, y )
local F;
F:= FamilyObj(x);
return ObjByExtRep( F, LRPrivateFunctions.dir_monmult( F, x![1], y![1] ) );
end;
LRPrivateFunctions.dir_mult:= function( F, x, y )
local o, ord, mns, cfs, i, j, l, res, len;
o:= F!.ordering;
ord:= function( a, b )
return o[a.no] < o[b.no];
end;
# Keeping it sorted might make it faster!!
mns:= []; cfs:= [];
for i in [1,3..Length(x)-1] do
for j in [1,3..Length(y)-1] do
l:= LRPrivateFunctions.dir_monmult( F, [x[i],x[i+1]], [y[j],y[j+1]] );
if not IsZero( l[2] ) then
Add( mns, l[1] ); Add(cfs, l[2] );
fi;
od;
od;
SortParallel( mns, cfs, ord );
res:= [];
len:= -1;
for i in [1..Length(mns)] do
if len > 0 and mns[i].no = res[len].no then
res[len+1]:= res[len+1]+cfs[i];
else
Add( res, mns[i] ); Add( res, cfs[i] );
len:= len+2;
fi;
od;
for i in [2,4..Length(res)] do
if IsZero(res[i]) then
Unbind( res[i-1] ); Unbind( res[i] );
fi;
od;
res:= Filtered( res, x -> IsBound(x) );
return res;
end;
InstallMethod( \*,
"for two FAlg elements",
true, [ IsFAlgElement, IsFAlgElement ], 0,
function( x, y )
local F;
F:= FamilyObj(x);
return ObjByExtRep( F, LRPrivateFunctions.dir_mult( F, x![1], y![1] ) );
end);
LRPrivateFunctions.special_mult:= function( F, x1, f1, x2, f2, x3, f3 )
# compute x1f1 + x2f2 + x3f3, where the xi are monomials
local T, mons, o, ord_1, mon_prod, ord, mns, cfs, i, j, l, res, len,t, e1, e2;
T:= F!.multTable;
mons:= F!.monomials;
o:= F!.ordering;
ord_1:= function( mon1, mon2 )
if mon1.no = mon2.no then return false; fi;
if mon1.deg <> mon2.deg then return mon1.deg < mon2.deg; fi;
if mon1.left.no <> mon2.left.no then return o[mon1.left.no] < o[mon2.left.no]; fi;
return o[mon1.right.no] < o[mon2.right.no];
end;
if F!.sign = -1 then
mon_prod:= function( a, b, ca, cb )
local c, p, i, j, r, pos, num, pi, pj, s, mmm, t1, t2, s1;
c:= ca*cb;
i:= a.no; j:= b.no;
if i = j then return [ a, 0*c ]; fi;
if i > j then
t1:= j; t2:= i;
s1:= -1;
else
t1:= i; t2:= j;
s1:= 1;
fi;
if IsBound( T[t1] ) and IsBound( T[t1][t2] ) then
r:= T[t1][t2];
pos:= o[ r[1] ];
return [ mons[pos], s1*r[2]*c ];
fi;
# If we arrive here then the product is not known yet.
num:= Length( mons ) + 1; # number of new monomial...
if o[i] < o[j] then
# i.e., a < b
p:= rec( no:= num, deg:= a.deg+b.deg, left:= a, right:= b );
s:= 1;
else
p:= rec( no:= num, deg:= a.deg+b.deg, left:= b, right:= a );
c:= -c;
s:= -1;
fi;
if not IsBound( T[t1] ) then T[t1]:= [ ]; fi;
T[t1][t2]:= [ num, s*s1 ];
F!.multTable:= T;
# now we have to insert p in the sorted list of monomials...
pos:= POSITION_SORTED_LIST_COMP( mons, p, ord_1 );
for i in [pos..Length(o)] do o[ mons[i].no ]:= o[ mons[i].no ]+1; od;
Add( o, pos );
CopyListEntries(mons,pos,1,mons,pos+1,1,Length(mons)-pos+1);
mons[pos]:= p;
F!.monomials:= mons;
F!.ordering:= o;
return [ p, c ];
end;
fi;
ord:= function( a, b )
return o[a.no] < o[b.no];
end;
e1:= [ ];
for i in [1,3..Length(f1)-1] do
l:= mon_prod( x1[1], f1[i], x1[2], f1[i+1] );
if not IsZero( l[2] ) then
Append( e1, l );
fi;
od;
e2:= [ ];
for i in [1,3..Length(f2)-1] do
l:= mon_prod( x2[1], f2[i], x2[2], f2[i+1] );
if not IsZero( l[2] ) then
Append( e2, l );
fi;
od;
res:= ZIPPED_SUM_LISTS( e1, e2, F!.zeroCoefficient, [ ord, \+ ] );
e2:= [ ];
for i in [1,3..Length(f3)-1] do
l:= mon_prod( x3[1], f3[i], x3[2], f3[i+1] );
if not IsZero( l[2] ) then
Append( e2, l );
fi;
od;
return ZIPPED_SUM_LISTS( res, e2, F!.zeroCoefficient, [ ord, \+ ] );
end;
InstallMethod( AdditiveInverseSameMutability,
"for FAlg element",
true, [ IsFAlgElement ], 0,
function( x )
local ex, i;
ex:= ShallowCopy(x![1]);
for i in [2,4..Length(ex)] do
ex[i]:= -ex[i];
od;
return ObjByExtRep( FamilyObj(x), ex );
end );
InstallMethod( AdditiveInverseMutable,
"for FAlg element",
true, [ IsFAlgElement ], 0,
function( x )
local ex, i;
ex:= ShallowCopy(x![1]);
for i in [2,4..Length(ex)] do
ex[i]:= -ex[i];
od;
return ObjByExtRep( FamilyObj(x), ex );
end );
#############################################################################
##
#M \*( <scal>, <m> ) . . . . . . . . .for a scalar and a FAlg element
#M \*( <m>, <scal> ) . . . . . . . . .for a scalar and a FAlg element
##
InstallMethod( \*,
"for scalar and FAlg element",
true, [ IsScalar, IsFAlgElement ], 0,
function( scal, x )
local ex, i;
if IsZero( scal ) then return Zero(x); fi;
ex:= ShallowCopy( x![1] );
for i in [2,4..Length(ex)] do
ex[i]:= scal*ex[i];
od;
return ObjByExtRep( FamilyObj(x), ex );
end);
InstallMethod( \*,
"for FAlg element and scalar",
true, [ IsFAlgElement, IsScalar ], 0,
function( x, scal )
local ex, i;
if IsZero( scal ) then return Zero(x); fi;
ex:= ShallowCopy( x![1] );
for i in [2,4..Length(ex)] do
ex[i]:= scal*ex[i];
od;
return ObjByExtRep( FamilyObj(x), ex );
end);
InstallMethod( \in,
"for FAlg element and free algebra",
true, [ IsFAlgElement, IsFreeNAAlgebra ], 0,
function( u, U )
return IsIdenticalObj( ElementsFamily( FamilyObj(U) ), FamilyObj(u) );
end );
InstallMethod( Degree, "FAlg elements", true, [ IsFAlgElement ], 0,
function(x)
x:= x![1];
return x[ Length(x)-1 ].deg ;
end );
LRPrivateFunctions.FreeNonassociativeAlgebra:= function( arg )
local R, # coefficients ring
names, # names of the algebra generators
F, # family of elements
one, # identity of `R'
zero, # zero of `R'
A, sign, g, gr, ord;
R:= arg[1];
# Construct names of generators.
if IsInt( arg[2] ) then
names:= List( [ 1 .. arg[2] ],
i -> Concatenation( "x", String(i) ) );
elif IsList( arg[2] ) then
names:= arg[2];
else
Error( "The second argument to FreeNonassociativeAlgebra has to be an integer, or a list" );
fi;
if Length(arg) >= 3 then
if arg[3] in [1,-1] then
sign:= arg[3];
else
Error("The third argument to FreeNonassociativeAlgebra must be 1, or -1 ");
fi;
else
sign:= 1;
fi;
if Length( arg ) = 4 then
gr:= arg[4];
else
gr:= List( names, x -> 1 );
fi;
F:= NewFamily( "FreeAlgebraEltFamily", IsFAlgElement );
if IsField(R) then
F!.isfield_basering:= true;
elif R=Integers then
F!.isfield_basering:= false;
else
Error("The only allowed base rings are fields and the Integers");
fi;
one:= One( R );
zero:= Zero( R );
F!.defaultType := NewType( F, IsFAlgElement );
F!.zeroCoefficient := zero;
F!.names := names;
F!.sign:= sign;
A:= Objectify( NewType( CollectionsFamily( F ),
IsFreeNAAlgebra
and IsAttributeStoringRep ),
rec() );
SetLeftActingDomain( A, R );
g:= List( [1..Length(names)],
x -> ObjByExtRep( F, [ rec( no:= x, deg:=gr[x], var:= x ), one ] ) );
F!.monomials:= List( g, u -> ExtRepOfObj( u )[1] );
F!.multTable:= [];
ord:= List( [1..Length(names)], x -> x );
SortParallel( gr, ord );
F!.ordering:= ord;
SetGeneratorsOfLeftOperatorRing( A, g );
return A;
end;
InstallAccessToGenerators( IsFreeNAAlgebra,
"free algebra",
GeneratorsOfLeftOperatorRing );
InstallMethod( FreeLieRing,
"for a ring and list",
true,
[ IsRing, IsList ], 0,
function( R, names )
# Check the argument list.
if not IsRing( R ) then
Error( "first argument must be a ring" );
fi;
if not ForAll( names, IsString ) then
Error("second argument must be a list of strings");
fi;
return LRPrivateFunctions.FreeNonassociativeAlgebra( R, names, -1 );
end );
InstallOtherMethod( FreeLieRing,
"for a ring and list and list",
true,
[ IsRing, IsList, IsList ], 0,
function( R, names, grad )
# Check the argument list.
if not IsRing( R ) then
Error( "first argument must be a ring" );
fi;
if not ForAll( names, IsString ) then
Error("second argument must be a list of strings");
fi;
return LRPrivateFunctions.FreeNonassociativeAlgebra( R, names, -1, grad );
end );
InstallOtherMethod( FreeLieRing,
"for a ring and an integer",
true,
[ IsRing, IsInt ], 0,
function( R, k )
# Check the argument list.
if not IsRing( R ) then
Error( "first argument must be a ring" );
fi;
return LRPrivateFunctions.FreeNonassociativeAlgebra( R, k, -1 );
end );
InstallOtherMethod( FreeLieRing,
"for a ring and an integer",
true,
[ IsRing, IsInt, IsList ], 0,
function( R, k, grad )
# Check the argument list.
if not IsRing( R ) then
Error( "first argument must be a ring" );
fi;
return LRPrivateFunctions.FreeNonassociativeAlgebra( R, k, -1, grad );
end );
InstallMethod( PrintObj,
"for a nonassociative algebra",
true,
[ IsFreeNAAlgebra ], 0,
function( A )
local g, i;
Print("<Free algebra over ",LeftActingDomain(A)," generators: " );
g:= GeneratorsOfAlgebra(A);
for i in [1..Length(g)-1] do
Print( g[i], ", " );
od;
Print( g[ Length(g) ], " >" );
end );
InstallMethod( ViewObj,
"for a nonassociative algebra",
true,
[ IsFreeNAAlgebra ], 0,
function( A )
local g, i;
Print("<Free algebra over ",LeftActingDomain(A)," generators: " );
g:= GeneratorsOfAlgebra(A);
for i in [1..Length(g)-1] do
Print( g[i], ", " );
od;
Print( g[ Length(g) ], " >" );
end );
InstallMethod( PrintObj,
"for a reduced set",
true,
[ IsReducedSetOfFAE ], 0,
function( G )
Print("<Reduced set of free algebra elements>" );
end );
InstallMethod( ViewObj,
"for a reduced set",
true,
[ IsReducedSetOfFAE ], 0,
function( G )
Print("<Reduced set of free algebra elements>" );
end );
InstallMethod( AsSSortedList,
"for a reduced set",
true,
[ IsReducedSetOfFAE ], 0,
function( G )
return G!.elements;
end );
LRPrivateFunctions.search_factor:= function( m, lms )
# here m is a monomial in ext rep; lms is a sorted list of monomial
# numbers of leading monomials. We search a leading monomial that is
# a factor in m; if found then a list is returned with in the first
# position the value true, in the second position, the position of the
# factor in lms, and the third and fourth positions contain lists that
# describe the correponding appliance (first the list of monomials, than
# a list of 0,1; 0 means: mult on the left, 1 means mult on the right).
# if no factor is found the list [false] is returned.
local b, choices, points, pos, mns, lr, c, k;
b:= m;
choices:= [ ];
points:= [ b ];
while true do
pos:= PositionSorted( lms, b.no );
if pos <= Length(lms) and lms[pos] = b.no then
mns:= [ ];
lr:= [ ];
c:= m;
for k in choices do
if k = 0 then
Add( lr, 1 ); Add( mns, c.right ); c:= c.left;
else
Add( lr, 0 ); Add( mns, c.left ); c:= c.right;
fi;
od;
return [ true, pos, Reversed(mns), Reversed(lr) ];
fi;
if IsBound(b.var) then
# backtrack...
k:= Length( choices );
while k>=1 and choices[k] = 1 do k:= k-1; od;
if k = 0 then return [ false ]; fi;
choices:= choices{[1..k-1]}; points:= points{[1..k]};
b:= points[k].right;
Add( choices, 1 ); Add( points, b );
else
b:= b.left;
Add( choices, 0 ); Add( points, b );
fi;
od;
end;
LRPrivateFunctions.ReduceElmFreeAlg:= function( fam, f, G, lms, minus )
local ef, len, r, a, g, lg, mns, side, i, m, cf, cg, rem, q;
# Here f is an elem of a free algeb in ext rep,
# fam is its family, G is a list of elements of
# the same free alg, but in wrapped rep, lms is a list
# of the numbers of the leading monomials of G,
# minus is a boolean, if true then the result is normalised
# i.e., multiplied by an appropriate unit.
if f=[] then return f; fi;
if G = [ ] then
if minus then
f:= ShallowCopy(f);
cf:= f[Length(f)];
if fam!.isfield_basering then
if not IsOne(cf) then
for i in [2,4..Length(f)] do
f[i]:= f[i]/cf;
od;
fi;
else
if cf < 0 then
for i in [2,4..Length(f)] do
f[i]:= -f[i];
od;
fi;
fi;
fi;
return f;
fi;
ef:= ShallowCopy( f );
len:= Length(ef);
r:= [ ];
if fam!.isfield_basering then
while len >0 do
m:= ef[ len-1 ]; cf:= ef[len];
ef:= ef{[1..len-2]};
len:= len-2;
# look for a factor...
a:= LRPrivateFunctions.search_factor( m, lms );
if a[1] then
g:= ShallowCopy(G[a[2]]![1]);
mns:= a[3];
side:= a[4];
lg:= Length(g);
g:= g{[1..lg-2]};
for i in [1..Length(mns)] do
if side[i] = 0 then
g:= LRPrivateFunctions.dir_mult( fam, [mns[i],1], g );
else
g:= LRPrivateFunctions.dir_mult( fam, g, [mns[i],1] );
fi;
od;
# compute -cf*g:
for i in [2,4..Length(g)] do
g[i]:= -cf*g[i];
od;
ef:= LRPrivateFunctions.direct_sum( fam, ef, g );
len:= Length( ef );
else
r:= LRPrivateFunctions.direct_sum( fam, r, [m,cf] );
# Better: add everything, then sort!
fi;
od;
if r <> [ ] and minus then
cf:= r[Length(r)];
if not IsOne(cf) then
for i in [2,4..Length(r)] do r[i]:= r[i]/cf; od;
fi;
fi;
else
# so the base ring is the integers...
while len >0 do
m:= ef[ len-1 ]; cf:= ef[len];
ef:= ef{[1..len-2]};
len:= len-2;
# look for a factor...
a:= LRPrivateFunctions.search_factor( m, lms );
if a[1] then
g:= ShallowCopy(G[a[2]]![1]);
lg:= Length(g);
cg:= g[lg];
rem:= cf mod cg;
q:= (cf-rem)/cg;
if q <> 0 then
mns:= a[3];
side:= a[4];
g:= g{[1..lg-2]};
for i in [1..Length(mns)] do
if side[i] = 0 then
g:= LRPrivateFunctions.dir_mult( fam, [mns[i],1], g );
else
g:= LRPrivateFunctions.dir_mult( fam, g, [mns[i],1] );
fi;
od;
# compute -q*g:
for i in [2,4..Length(g)] do
g[i]:= -q*g[i];
od;
ef:= LRPrivateFunctions.direct_sum( fam, ef, g );
len:= Length( ef );
fi;
if rem <> 0 then
r:= LRPrivateFunctions.direct_sum( fam, r, [m,rem] );
fi;
else
r:= LRPrivateFunctions.direct_sum( fam, r, [m,cf] );
# Better: add everything, then sort!
fi;
od;
if r <> [ ] and minus then
cf:= r[Length(r)];
if cf < 0 then
for i in [2,4..Length(r)] do r[i]:= -r[i]; od;
fi;
fi;
fi;
return r;
end;
LRPrivateFunctions.AddElmRedSet:= function( fam, f, G, lms )
local newelms, len, h, n, Gh, i, g, pos;
newelms:= [ f ];
len:= 1;
while len>0 do
h:= newelms[len];
newelms:= newelms{[1..len-1]};
len:= len-1;
h:= LRPrivateFunctions.ReduceElmFreeAlg( fam, h, G, lms, true );
if h <> [] then
# we add it, but first we remove all elements of which the
# leading monomial reduces mod h from G:
n:= [ h[ Length(h)-1 ].no ];
h:= ObjByExtRep( fam, h );
Gh:= [ h ];
for i in [1..Length(G)] do
g:= LRPrivateFunctions.ReduceElmFreeAlg( fam, G[i]![1], Gh, n, true );
if g <> [] and g[Length(g)-1].no <> lms[i] then
Add( newelms, g ); len:= len+1;
Unbind( G[i] ); Unbind( lms[i] );
elif g=[ ] then
Unbind( G[i] ); Unbind( lms[i] );
else
G[i]:= ObjByExtRep( fam, g );
fi;
od;
G:= Filtered( G, x -> IsBound(x) );
lms:= Filtered( lms, x -> IsBound(x) );
pos:= PositionSorted( lms, n[1] );
CopyListEntries(G,pos,1,G,pos+1,1,Length(G)-pos+1);
G[pos]:= h;
CopyListEntries(lms,pos,1,lms,pos+1,1,Length(lms)-pos+1);
lms[pos]:= n[1];
fi;
od;
return [ G, lms ];
end;
InstallMethod( ReducedSet,
"for a set of free alg elms",
true,
[ IsList ], 0,
function( elms )
local RS, G, lms, fam, g, a;
RS:= Objectify( NewType( NewFamily( "ReducedSetFam", IsReducedSetOfFAE ), IsReducedSetOfFAE ),
rec() );
if elms = [ ] then
RS!.elements:= [ ];
RS!.leading_mns:= [ ];
return RS;
fi;
G:= [ ]; lms:= [ ];
fam:= FamilyObj( elms[1] );
for g in elms do
a:= LRPrivateFunctions.AddElmRedSet( fam, g![1], G, lms );
G:= a[1]; lms:= a[2];
od;
RS!.elements:= G;
RS!.leading_mns:= lms;
return RS;
end );
InstallMethod( AddToReducedSet,
"for a reduced set of free alg elms, and a free alg elm",
true,
[ IsReducedSetOfFAE, IsFAlgElement ], 0,
function( G, f )
local elms, lms, ef, a;
elms:= G!.elements;
lms:= G!.leading_mns;
ef:= f![1];
if elms = [ ] and ef <> [ ] then
G!.elements:= [ f ];
G!.leading_mns:= [ ef[ Length(ef)-1 ].no ];
elif elms <> [ ] then
a:= LRPrivateFunctions.AddElmRedSet( FamilyObj( f ), ef, elms, lms );
G!.elements:= a[1];
G!.leading_mns:= a[2];
fi;
end );
InstallMethod( NormalForm,
"for a reduced set of free alg elms, and a free alg elm",
true,
[ IsReducedSetOfFAE, IsFAlgElement ], 0,
function( G, f )
local h;
h:= LRPrivateFunctions.ReduceElmFreeAlg(
FamilyObj(f), f![1], G!.elements, G!.leading_mns, false );
return ObjByExtRep( FamilyObj(f), h );
end );
[ Dauer der Verarbeitung: 0.26 Sekunden
(vorverarbeitet)
]
|
2026-04-02
|
