|
#############################################################################
##
#W algebra.gi Laurent Bartholdi
##
##
#Y Copyright (C) 2007, Laurent Bartholdi
##
#############################################################################
##
## This file implements self-similar associative algebras.
##
#############################################################################
InstallAccessToGenerators(IsFRAlgebra,
"(FR) for a FR algebra",GeneratorsOfAlgebra);
InstallAccessToGenerators(IsFRAlgebraWithOne,
"(FR) for a FR algebra-with-one",GeneratorsOfAlgebraWithOne);
#############################################################################
##
#M AlphabetOfFRAlgebra
##
InstallMethod(AlphabetOfFRAlgebra, "(FR) for an FR algebra",
[IsFRAlgebra],
G->AlphabetOfFRObject(Representative(G)));
#############################################################################
#############################################################################
##
#O AlgebraHomomorphismByFunction
#O AlgebraWithOneHomomorphismByFunction
##
InstallMethod(AlgebraHomomorphismByFunction, "(FR) for two algebras and a function",
[IsAlgebra,IsAlgebra,IsFunction],
function(S,R,f)
return Objectify(TypeOfDefaultGeneralMapping(S,R,
IsSPMappingByFunctionRep and IsAlgebraHomomorphism), rec(fun:=f));
end);
InstallMethod(AlgebraWithOneHomomorphismByFunction, "(FR) for two algebras and a function",
[IsAlgebraWithOne,IsAlgebraWithOne,IsFunction],
function(S,R,f)
return Objectify(TypeOfDefaultGeneralMapping(S,R,
IsSPMappingByFunctionRep and IsAlgebraWithOneHomomorphism), rec(fun:=f));
end);
#############################################################################
#############################################################################
##
#O SCAlgebra
#O SCAlgebraWithOne
##
InstallMethod(SCAlgebraNC, "(FR) for a linear machine",
[IsLinearFRMachine],
function(M)
local a, g;
a := Objectify(NewType(CollectionsFamily(FREFamily(M)),
IsFRAlgebra and IsAttributeStoringRep),
rec());
SetLeftActingDomain(a,LeftActingDomain(M));
g := List(GeneratorsOfFRMachine(M),x->FRElement(M,x));
SetGeneratorsOfLeftOperatorRing(a,g);
SetCorrespondence(a,g);
SetUnderlyingFRMachine(a,M);
if IsVectorFRMachineRep(M) then
SetFilterObj(a,IsVectorFRElementSpace);
fi;
SetFilterObj(a,IsLinearFRElementSpace);
return a;
end);
InstallMethod(SCAlgebra, "(FR) for a linear machine",
[IsLinearFRMachine], SCAlgebraNC);
BindGlobal("SCALGEBRAWITHONE@", function(M)
local a;
a := Objectify(NewType(CollectionsFamily(FREFamily(M)),
IsFRAlgebraWithOne and IsAttributeStoringRep),
rec());
SetLeftActingDomain(a,LeftActingDomain(M));
SetCorrespondence(a,List(GeneratorsOfFRMachine(M),x->FRElement(M,x)));
SetUnderlyingFRMachine(a,M);
if IsVectorFRMachineRep(M) then
SetFilterObj(a,IsVectorFRElementSpace);
fi;
SetFilterObj(a,IsLinearFRElementSpace);
return a;
end);
InstallMethod(SCAlgebraWithOneNC, "(FR) for a linear machine",
[IsLinearFRMachine],
function(M)
local a;
a := SCALGEBRAWITHONE@(M);
SetGeneratorsOfLeftOperatorRingWithOne(a,Correspondence(a));
return a;
end);
InstallMethod(SCAlgebraWithOne, "(FR) for a linear machine",
[IsLinearFRMachine],
function(M)
local a, g, p;
a := SCALGEBRAWITHONE@(M);
g := DuplicateFreeList(Correspondence(a));
if Length(g)>=1 then
p := Position(g,One(g[1]));
if p<>fail then Remove(g,p); fi;
fi;
SetGeneratorsOfLeftOperatorRingWithOne(a,g);
return a;
end);
InstallMethod(SCLieAlgebra, "(FR) for a linear machine",
[IsLinearFRMachine],
function(M)
local a;
a := Objectify(NewType(CollectionsFamily(FRJFAMILY@(M)),
IsFRAlgebra and IsAttributeStoringRep),
rec());
SetLeftActingDomain(a,LeftActingDomain(M));
SetGeneratorsOfLeftOperatorRing(a,List(GeneratorsOfFRMachine(M),x->FRElement(M,x,IsJacobianElement)));
SetUnderlyingFRMachine(a,M);
if IsVectorFRMachineRep(M) then
SetFilterObj(a,IsVectorFRElementSpace);
fi;
SetFilterObj(a,IsLinearFRElementSpace);
return a;
end);
############################################################################
#############################################################################
##
#F FRAlgebra
#F FRAlgebraWithOne
##
BindGlobal("TOTALDEGREE@", function(x)
local d, i;
d := -1;
x := ExtRepOfObj(x)[2];
for i in x{[1,3..Length(x)-1]} do
d := Maximum(d,Sum(i{[2,4..Length(i)]}));
od;
return d;
end);
BindGlobal("STRINGSTOLMACHINE@", function(r,args,creator)
local temp, i, j, gens, transitions, output, data;
if not IsRing(r) or not ForAll(args,IsString) then
Error("<arg> should contain a ring and strings\n");
fi;
temp := List(args, x->SplitString(x,"="));
if ForAny(temp,x->Size(x)<>2) then
Error("<arg> should have the form a=[[...]...]\n");
fi;
gens := List(temp, x->x[1]);
if Size(Set(gens)) <> Size(gens) then
Error("all generators should have a distinct name\n");
fi;
data := rec(holder := FreeAssociativeAlgebraWithOne(r,gens));
transitions := [];
output := [];
for temp in List(temp,x->x[2]) do
temp := SplitString(temp,":");
if Length(temp)=2 then
Add(output,STRING_ATOM2GAP@(temp[2])*One(r));
else
Add(output,One(r));
fi;
temp := STRING_WORD2GAP@(gens,GeneratorsOfAlgebraWithOne(data.holder),temp[1])*One(data.holder);
if not IsMatrix(temp) then
Error("<arg> should have the form a=[[...]...]\n");
fi;
Add(transitions,temp);
od;
i := AlgebraMachine(r,data.holder,transitions,output);
if ValueOption("IsVectorElement")=true or
(ForAll(Flat(transitions),x->TOTALDEGREE@(x)<=1) and ValueOption("IsAlgebraElement")<>true) then
i := AsVectorMachine(i);
i := List(Correspondence(i),x->FRElement(i,x));
for temp in [1..Length(gens)] do
SetName(i[temp],gens[temp]);
od;
i := creator(r,i);
else
i := creator(r,List(GeneratorsOfFRMachine(i),x->FRElement(i,x)));
fi;
SetIsStateClosed(i,true);
return i;
end);
InstallGlobalFunction(FRAlgebra,
function(arg)
return STRINGSTOLMACHINE@(arg[1],arg{[2..Length(arg)]},Algebra);
end);
InstallGlobalFunction(FRAlgebraWithOne,
function(arg)
return STRINGSTOLMACHINE@(arg[1],arg{[2..Length(arg)]},AlgebraWithOne);
end);
InstallMethod(AssignGeneratorVariables, "(FR) for an FR algebra",
[IsFRAlgebra],
function(G)
ASSIGNGENERATORVARIABLES@(GeneratorsOfAlgebra(G));
end);
InstallMethod(AssignGeneratorVariables, "(FR) for an FR algebra with one",
[IsFRAlgebraWithOne],
function(G)
ASSIGNGENERATORVARIABLES@(GeneratorsOfAlgebraWithOne(G));
end);
############################################################################
#############################################################################
##
#O ThinnedAlgebra
#O ThinnedAlgebraWithOne
##
InstallMethod(ThinnedAlgebra, "(FR) for a ring and a FR semigroup",
[IsRing, IsFRSemigroup],
function(r,G)
local a, g, s;
s := GeneratorsOfSemigroup(G);
g := List(s,x->AsLinearElement(r,x));
for a in [1..Length(s)] do
if HasName(s[a]) then SetName(g[a],Name(s[a])); fi;
od;
a := Objectify(NewType(CollectionsFamily(FamilyObj(g[1])),
IsFRAlgebra and IsAttributeStoringRep),
rec());
SetLeftActingDomain(a,LeftActingDomain(g[1]));
SetGeneratorsOfLeftOperatorRing(a,g);
if HasSize(G) and Size(G)=infinity then
SetDimension(G,infinity);
fi;
return a;
end);
BindGlobal("THINNEDALGEBRAWITHONE@",
function(r,G,s)
local a, g;
g := List(s,x->AsLinearElement(r,x));
for a in [1..Length(s)] do
if HasName(s[a]) then SetName(g[a],Name(s[a])); fi;
od;
a := Objectify(NewType(CollectionsFamily(FamilyObj(g[1])),
IsFRAlgebraWithOne and IsAttributeStoringRep),
rec());
SetLeftActingDomain(a,LeftActingDomain(g[1]));
SetGeneratorsOfLeftOperatorRingWithOne(a,g);
SetAugmentationIdeal(a,TwoSidedIdealByGenerators(a,List(g,x->x-One(a))));
return a;
end);
InstallMethod(ThinnedAlgebraWithOne, "(FR) for a ring and a FR monoid",
[IsRing, IsFRMonoid],
function(r,G)
return THINNEDALGEBRAWITHONE@(r,G,GeneratorsOfMonoid(G));
end);
InstallMethod(Embedding, "(FR) for a semigroup and a FR algebra",
[IsFRSemigroup, IsFRAlgebra],
function(G,A)
if IsGroup(G) then
return GroupHomomorphismByFunction(G,A,x->AsLinearElement(LeftActingDomain(A),x));
else
return MagmaHomomorphismByFunctionNC(G,A,x->AsLinearElement(LeftActingDomain(A),x));
fi;
end);
############################################################################
#############################################################################
##
#O Nillity
##
BindGlobal("ISNIL_GENERIC@", function(x) # returns false or 2-powers of x till 0
local powx, rank, oldrank, ring;
powx := [x];
if IsMatrix(x) then
ring := DefaultRing(x[1][1]);
else
ring := DefaultRing(x);
fi;
if IsMatrix(x) and (HasIsIntegralRing(x) and IsIntegralRing(x)) then
rank := RankMat(x);
while not IsZero(x) do
x := x*x;
Add(powx,x);
oldrank := rank;
rank := RankMat(x);
if rank=oldrank then return false; fi;
od;
# certainly not a nil element if has non-zero generalized eigenspace
else
if HasIsIntegralRing(x) and IsIntegralRing(x) then
if IsZero(x) then return [x]; else return false; fi;
fi;
while not IsZero(x) do
if IsOne(x) then return false; fi;
x := x*x;
Add(powx,x);
od;
fi;
return powx;
end);
BindGlobal("ISNIL_FR@", function(x)
# return either a list of non-trivial 2-powers of x, or false
local powx, deg, testing, found, recur;
deg := Dimension(AlphabetOfFRObject(x));
powx := [x];
testing := NewDictionary(x,true); # current order during recursion
found := NewDictionary(x,true); # elements for which we found the nillity
AddDictionary(testing,Zero(x),infinity);
AddDictionary(found,Zero(x),1);
recur := function(x,mult,level,depth)
local i, c, d, order;
if KnowsDictionary(testing,x) then
if KnowsDictionary(found,x) then
return LookupDictionary(found,x);
elif mult>LookupDictionary(testing,x) then
return infinity;
else
return 1;
fi;
fi;
AddDictionary(testing,x,mult);
# first see if element is triangular
d := DecompositionOfFRElement(x);
# c are indices of diagonal blocks of size 1
c := List(Filtered(List(EquivalenceClasses(StronglyConnectedComponents(TransitiveClosureBinaryRelation(BinaryRelationOnPoints(List([1..deg],i->Filtered([1..deg],j->not IsZero(d[i][j]))))))),AsList),x->Length(x)=1),c->c[1]);
order := 1;
for i in c do
i := recur(d[i][i],mult,level+1,1);
if i=infinity then return infinity; fi;
order := Maximum(order,i);
od;
if IsDiagonalMat(d) then
return order;
fi;
# now see if a projection is non-nil
if IsVectorFRMachineRep(x) then
d := LogInt(Dimension(StateSet(x))+1,deg)+1;
else
d := LogInt(Length(Flat(ExtRepOfObj(InitialState(x)))),deg)+2;
fi;
if d > depth then # work at new depth
if ISNIL_GENERIC@(Activity(x,depth))=false then
return infinity;
fi;
fi;
i := recur(x*x,mult+1,level,d);
AddDictionary(found,x,i);
return i;
end;
if recur(x,0,0,0)=infinity then
return false;
fi;
return powx;
end);
BindGlobal("NILLITY@", function(x,isnil)
local powx, pown, n, y;
powx := isnil(x);
if powx=false then return infinity; fi;
Append(powx,ISNIL_GENERIC@(Remove(powx))); # get all 2-powers of x
Remove(powx);
pown := List([0..Length(powx)-1],i->2^i);
if powx=[] then return 1; fi;
x := Remove(powx);
n := Remove(pown)+1;
while powx<>[] do
y := x*Remove(powx);
if IsZero(y) then
Remove(pown);
else
x := y;
n := n+Remove(pown);
fi;
od;
return n;
end);
InstallOtherMethod(Nillity, "(FR) for an associative element",
# [IsAssociativeElement and IsMultiplicativeElementWithZero],
[IsAssociativeElement and IsMultiplicativeElement],
x->NILLITY@(x,ISNIL_GENERIC@));
InstallMethod(Nillity, "(FR) for an FR element",
[IsLinearFRElement],
x->NILLITY@(x,ISNIL_FR@));
InstallOtherMethod(IsNilElement, "(FR) for an associative element",
# [IsAssociativeElement and IsMultiplicativeElementWithZero], ## removed "WithZero" filter, because GAP doesn't set it for linear elements
[IsAssociativeElement and IsMultiplicativeElement],
x->ISNIL_GENERIC@(x)<>false);
InstallMethod(IsNilElement, "(FR) for an FR element",
[IsLinearFRElement],
x->ISNIL_FR@(x)<>false);
InstallTrueMethod(IsHomogeneousElement,# "(FR) for a vector with degree",
IsLinearFRElement and HasDegreeOfHomogeneousElement);
InstallMethod(NucleusOfFRAlgebra, "(FR) for a ss algebra",
[IsFRAlgebra],
A->LINEARNUCLEUS@(VectorSpace(LeftActingDomain(A),GeneratorsOfAlgebra(A))));
InstallMethod(NucleusOfFRAlgebra, "(FR) for a ss algebra with one",
[IsFRAlgebraWithOne],
A->LINEARNUCLEUS@(VectorSpace(LeftActingDomain(A),GeneratorsOfAlgebraWithOne(A))));
InstallMethod(NucleusMachine, "(FR) for a ss algebra",
[IsFRAlgebra],
A->AsVectorMachine(NucleusOfFRAlgebra(A)));
InstallMethod(IsContracting, "(FR) for a ss algebra",
[IsFRAlgebra],
function(A)
local N;
N := NucleusOfFRAlgebra(A);
return IsVectorSpace(N) and IsFiniteDimensional(N);
end);
#############################################################################
#############################################################################
##
#O MatrixQuotient
##
InstallMethod(MatrixQuotient, "(FR) for a FR algebra and a level",
[IsFRAlgebra,IsInt],
function(A,n)
return Algebra(LeftActingDomain(A),List(GeneratorsOfAlgebra(A),x->Activity(x,n)));
end);
InstallMethod(EpimorphismMatrixQuotient, "(FR) for a FR algebra and a level",
[IsFRAlgebra,IsInt],
function(A,n)
local Q;
Q := MatrixQuotient(A,n);
return AlgebraHomomorphismByFunction(A,Q,x->Activity(x,n));
end);
InstallMethod(MatrixQuotient, "(FR) for a FR algebra-with-one and a level",
[IsFRAlgebraWithOne,IsInt],
function(A,n)
local Q;
Q := AlgebraWithOne(LeftActingDomain(A),List(GeneratorsOfAlgebraWithOne(A),x->Activity(x,n)));
if HasAugmentationIdeal(A) then
SetAugmentationIdeal(Q,IdealNC(Q,List(GeneratorsOfIdeal(AugmentationIdeal(A)),x->Activity(x,n))));
fi;
return Q;
end);
InstallMethod(EpimorphismMatrixQuotient, "(FR) for a FR algebra-with-one and a level",
[IsFRAlgebraWithOne,IsInt],
function(A,n)
local Q;
Q := MatrixQuotient(A,n);
return AlgebraWithOneHomomorphismByFunction(A,Q,x->Activity(x,n));
end);
############################################################################
#############################################################################
##
#M View
##
BindGlobal("VIEWALGEBRA@", function(A)
local n, x, y, s;
if HasIsJacobianRing(A) and IsJacobianRing(A) then
x := "Lie ";
else
x := "";
fi;
if IsAlgebraWithOne(A) then
n := Length(GeneratorsOfAlgebraWithOne(A));
y := "-with-one";
else
n := Length(GeneratorsOfAlgebra(A));
y := "";
fi;
s := Concatenation("<self-similar ",x,"algebra",y," on alphabet ",
String(LeftActingDomain(A)), "^", String(Dimension(AlphabetOfFRAlgebra(A))),
" with ",String(n)," generator");
if n<>1 then Append(s,"s"); fi;
if HasDimension(A) then Append(s,", of dimension "); Append(s,String(Dimension(A))); fi;
Append(s,">");
return s;
end);
InstallMethod(ViewString, "(FR) for an FR algebra",
[IsFRAlgebra],
VIEWALGEBRA@);
InstallMethod(ViewString, "(FR) for an FR algebra-with-one",
[IsFRAlgebraWithOne],
VIEWALGEBRA@);
INSTALLPRINTERS@(IsFRAlgebra);
INSTALLPRINTERS@(IsFRAlgebraWithOne);
############################################################################
[ Dauer der Verarbeitung: 0.7 Sekunden
(vorverarbeitet)
]
|
