Spracherkennung für: .gi vermutete Sprache: Unknown {[0] [0] [0]} [Methode: Schwerpunktbildung, einfache Gewichte, sechs Dimensionen]
#############################################################################
##
#W group.gi Laurent Bartholdi
##
##
#Y Copyright (C) 2006, Laurent Bartholdi
##
#############################################################################
##
## This file implements the category of functionally recursive groups.
##
#############################################################################
#############################################################################
##
#O SEARCH@
##
SEARCH@.DEPTH := function()
local v;
v := ValueOption("FRdepth");
if v=fail then return SEARCH@.depth; else return v; fi;
end;
SEARCH@.VOLUME := function()
local v;
v := ValueOption("FRvolume");
if v=fail then return SEARCH@.volume; else return v; fi;
end;
SEARCH@.BALL := 1;
SEARCH@.QUOTIENT := 2;
SEARCH@.INIT := function(G)
# initializes search structure, stored in semigroup G
if IsBound(G!.FRData) then return; fi;
if IsFRGroup(G) then
G!.FRData := rec(pifunc := EpimorphismPermGroup,
sphere := [[One(G)],Difference(Set(Union(GeneratorsOfGroup(G),List(GeneratorsOfGroup(G),Inverse))),[One(G)])]);
elif IsFRMonoid(G) then
G!.FRData := rec(pifunc := EpimorphismTransformationMonoid,
sphere := [[One(G)],Difference(Set(GeneratorsOfSemigroup(G)),[One(G)])]);
elif IsFRSemigroup(G) then
G!.FRData := rec(pifunc := EpimorphismTransformationSemigroup,
sphere := [[],Set(GeneratorsOfSemigroup(G))]);
fi;
G!.FRData.radius := 1;
G!.FRData.runtimes := [0,0];
G!.FRData.level := 0;
G!.FRData.pi := G!.FRData.pifunc(G,0);
G!.FRData.volume := Sum(List(G!.FRData.sphere,Length));
G!.FRData.index := Size(Image(G!.FRData.pi));
if IsFRGroup(G) and (HasIsBoundedFRSemigroup(G) or ForAll(GeneratorsOfGroup(G),IsMealyElement)) and IsBoundedFRSemigroup(G) and not IsFinitaryFRSemigroup(G) then
G!.FRData.pifunc := EpimorphismGermGroup;
fi;
end;
SEARCH@.RESET := function(G)
Unbind(G!.FRData);
end;
SEARCH@.ERROR := function(G,str)
# allow user to increase the search limits
local obm, volume, depth;
obm := OnBreakMessage;
volume := fail; depth := fail;
OnBreakMessage := function()
Print("current limits are (volume = ",SEARCH@.VOLUME(),
", depth = ",SEARCH@.DEPTH(),")\n",
"to increase search volume, type 'volume := <value>; return;'\n",
"to increase search depth, type 'depth := <value>; return;'\n",
"type 'quit;' if you want to abort the computation.\n");
OnBreakMessage := obm;
end;
Error("Search for ",G," reached its limits in function ",str,"\n");
if volume <> fail then PushOptions(rec(FRvolume := volume)); fi;
if depth <> fail then PushOptions(rec(FRdepth := depth)); fi;
end;
SEARCH@.EXTEND := function(arg)
# extend the search structure. argument1 is a group; argument2 is optional,
# and is SEARCH@.BALL to extend search ball radius,
# and is SEARCH@.QUOTIENT to extend search depth.
# returns fail if the search limits do not allow extension.
local i, j, k, l, d, r, strategy;
d := arg[1]!.FRData;
if Length(arg)=2 then
strategy := [arg[2]];
else
strategy := [SEARCH@.BALL,SEARCH@.QUOTIENT]; fi;
if d.volume>=SEARCH@.VOLUME() then
strategy := Difference(strategy,[SEARCH@.BALL]);
fi;
if d.level>=SEARCH@.DEPTH() then
strategy := Difference(strategy,[SEARCH@.QUOTIENT]);
fi;
if Length(strategy)=0 then
return fail;
elif Length(strategy)=1 then
strategy := strategy[1];
else
if Maximum(d.runtimes)>5*Minimum(d.runtimes) then
# at least 20% on each strategy
strategy := Position(d.runtimes,Minimum(d.runtimes));
elif d.index > d.volume^2 then
strategy := SEARCH@.BALL;
else
strategy := SEARCH@.QUOTIENT;
fi;
fi;
r := Runtime();
if strategy=SEARCH@.BALL then
d.radius := d.radius+1;
d.sphere[d.radius+1] := [];
if IsFRGroup(arg[1]) then
for i in d.sphere[2] do
for j in d.sphere[d.radius] do
k := i*j;
if not (k in d.sphere[d.radius-1] or k in d.sphere[d.radius]) then
AddSet(d.sphere[d.radius+1],k);
fi;
od;
od;
else
for i in d.sphere[2] do
for j in d.sphere[d.radius] do
k := i*j;
for l in [1..d.radius] do
if k in d.sphere[l] then k := fail; break; fi;
od;
if k<>fail then
AddSet(d.sphere[d.radius+1],k);
fi;
od;
od;
fi;
MakeImmutable(d.sphere[d.radius+1]);
d.volume := d.volume + Length(d.sphere[d.radius+1]);
if d.sphere[d.radius+1]=[] then
d.volume := d.volume+10^9; # force quotient searches
# d.runtimes[strategy] := d.runtimes[strategy]+10^9; # infinity messes up arithmetic later
fi;
elif strategy=SEARCH@.QUOTIENT then
d.level := d.level+1;
d.pi := d.pifunc(arg[1],d.level);
if IsPcpGroup(Range(d.pi)) then
d.index := 2^Length(Pcp(Range(d.pi))); # exponential complexity
elif IsPcGroup(Range(d.pi)) then # in length of pcgs
d.index := 2^Length(Pcgs(Range(d.pi)));
else
d.index := Size(Image(d.pi));
fi;
fi;
d.runtimes[strategy] := d.runtimes[strategy]+Runtime()-r;
return true;
end;
SEARCH@.IN := function(x,G)
# check in x is in G. can return true, false or fail
if not x^G!.FRData.pi in Image(G!.FRData.pi) then
return false;
elif ForAny(G!.FRData.sphere,s->x in s) then
return true;
fi;
return fail;
end;
SEARCH@.CONJUGATE := function(G,x,y)
# check if x,y is conjugate in G. can return true, false or fail
if not IsConjugate(Range(G!.FRData.pi),x^G!.FRData.pi,y^G!.FRData.pi) then
return false;
elif ForAny(G!.FRData.sphere,s->ForAny(s,t->x^t=y)) then
return true;
fi;
return fail;
end;
SEARCH@.CONJUGATE_WITNESS := function(G,x,y)
# check if x,y is conjugate in G. can return a conjugator, false or fail
local s,t;
if not IsConjugate(Range(G!.FRData.pi),x^G!.FRData.pi,y^G!.FRData.pi) then
return false;
else
for s in G!.FRData.sphere do
for t in s do
if x^t=y then
return t;
fi;
od;
od;
fi;
return fail;
end;
SEARCH@.CONJUGATE_COSET := function(G,c,x,y)
# check if x,y is conjugate in c can return a conjugator, false or fail
local s,t,r,B,K,K_pi;
B := BranchStructure(G);
K := BranchingSubgroup(G);
K_pi := Image(G!.FRData.pi,K);
if IsOne(x) and IsOne(y) then
return PreImagesRepresentativeNC(B.quo,c);
fi;
r := RepresentativeAction(Range(G!.FRData.pi),x^G!.FRData.pi,y^G!.FRData.pi);
if r = fail then
return false;
fi;
if not PreImagesRepresentativeNC(B.quo,c)^G!.FRData.pi in Union(List(K_pi,z->RightCoset(Centralizer(Range(G!.FRData.pi),x^G!.FRData.pi),r*z))) then
return false;
else
for s in G!.FRData.sphere do
for t in s do
if x^t=y and t^B.quo = c then
return t;
fi;
od;
od;
fi;
return fail;
end;
SEARCH@.EXTENDTRANSVERSAL := function(G,H,trans)
# completes the tranversal trans of H^pi in G^pi, and returns it,
# or "fail" if the search volume limit of G is too small.
# trans is a partial transversal.
local pitrans, got, todo, i, j, k;
pitrans := RightTransversal(Image(G!.FRData.pi),Image(G!.FRData.pi,H));
got := []; todo := Length(pitrans);
for i in trans do
got[PositionCanonical(pitrans,i^G!.FRData.pi)] := i;
todo := todo-1;
od;
if todo=0 then return got; fi;
i := 1;
while true do
if not IsBound(G!.FRData.sphere[i]) and SEARCH@.EXTEND(G,SEARCH@.BALL)=fail then
return fail;
fi;
for j in G!.FRData.sphere[i] do
k := PositionCanonical(pitrans,j^G!.FRData.pi);
if not IsBound(got[k]) then
got[k] := j;
Add(trans,j);
todo := todo-1;
if todo=0 then return got; fi;
fi;
od;
i := i+1;
od;
return fail;
end;
SEARCH@.CHECKTRANSVERSAL := function(G,H,trans)
# check that trans is a transversal of H in G.
# returns true on success, false on failure, and fail if the search
# volume of H is too limited.
local g, t, u, b, transinv, found;
transinv := List(trans,Inverse);
for g in G!.FRData.sphere[2] do for t in trans do
repeat
found := false;
for u in transinv do
b := SEARCH@.IN(t*g*u,H);
if b=true then
found := true;
break;
elif b=fail then
found := fail;
fi;
od;
if found=false then
return false;
elif found=fail and SEARCH@.EXTEND(H)=fail then
return fail;
fi;
until found=true;
od; od;
return true;
end;
#############################################################################
#############################################################################
##
#O SCGroup( <M> )
#O SCSemigroup( <M> )
#O SCMonoid( <M> )
##
# we'd prefer the method that uses an finitely L-presented group isomorphic to G;
# but maybe NQL is not loaded. If so, we'll content ourselves with a
# finitely presented group that maps onto G. In all cases, we expect the
# PreImageData structure to return such a group with the correct abelianization.
# the next method is also there to cache an attribute giving the data required
# to express group elements as words.
if @.nql then
InstallMethod(FRGroupImageData, "(FR) for a FR group with preimage data",
[IsFRGroup and HasFRGroupPreImageData],
G->FRGroupPreImageData(G)(-1));
else
InstallMethod(FRGroupImageData, "(FR) for a FR group with preimage data",
[IsFRGroup and HasFRGroupPreImageData],
G->FRGroupPreImageData(G)(0));
fi;
InstallAccessToGenerators(IsFRGroup,
"(FR) for a FR group",GeneratorsOfGroup);
InstallAccessToGenerators(IsFRMonoid,
"(FR) for a FR monoid",GeneratorsOfMonoid);
InstallAccessToGenerators(IsFRSemigroup,
"(FR) for a FR semigroup",GeneratorsOfSemigroup);
InstallMethod(SCGroupNC, "(FR) for a Mealy machine",
[IsMealyMachine],
function(M)
local G;
G := Group(List(GeneratorsOfFRMachine(M),s->FRElement(M,s)));
SetAlphabetOfFRSemigroup(G,AlphabetOfFRObject(M));
SetIsStateClosed(G,true);
SetCorrespondence(G,StateSet(M));
SetUnderlyingFRMachine(G,M);
return G;
end);
InstallMethod(SCGroupNC, "(FR) for a FR machine",
[IsFRMachine and IsFRMachineStdRep],
function(M)
local G;
G := Group(List(GeneratorsOfFRMachine(M),s->FRElement(M,s)));
SetAlphabetOfFRSemigroup(G,AlphabetOfFRObject(M));
SetIsStateClosed(G,true);
SetCorrespondence(G,GroupHomomorphismByFunction(M!.free,G,w->FRElement(M,w)));
SetUnderlyingFRMachine(G,M);
return G;
end);
InstallMethod(SCMonoidNC, "(FR) for a Mealy machine",
[IsMealyMachine],
function(M)
local G;
G := Monoid(List(GeneratorsOfFRMachine(M),s->FRElement(M,s)));
SetAlphabetOfFRSemigroup(G,AlphabetOfFRObject(M));
SetIsStateClosed(G,true);
SetCorrespondence(G,StateSet(M));
SetUnderlyingFRMachine(G,M);
return G;
end);
InstallMethod(SCMonoidNC, "(FR) for a FR machine",
[IsFRMachine and IsFRMachineStdRep],
function(M)
local G;
G := Monoid(List(GeneratorsOfFRMachine(M),s->FRElement(M,s)));
SetAlphabetOfFRSemigroup(G,AlphabetOfFRObject(M));
SetIsStateClosed(G,true);
SetCorrespondence(G,MagmaHomomorphismByFunctionNC(M!.free,G,w->FRElement(M,w)));
SetUnderlyingFRMachine(G,M);
return G;
end);
InstallMethod(SCSemigroupNC, "(FR) for a Mealy machine",
[IsMealyMachine],
function(M)
local G;
G := Semigroup(List(GeneratorsOfFRMachine(M),s->FRElement(M,s)));
SetAlphabetOfFRSemigroup(G,AlphabetOfFRObject(M));
SetIsStateClosed(G,true);
SetCorrespondence(G,StateSet(M));
SetUnderlyingFRMachine(G,M);
return G;
end);
InstallMethod(SCSemigroupNC, "(FR) for a FR machine",
[IsFRMachine],
function(M)
local G;
G := Semigroup(List(GeneratorsOfFRMachine(M),s->FRElement(M,s)));
SetAlphabetOfFRSemigroup(G,AlphabetOfFRObject(M));
SetIsStateClosed(G,true);
SetCorrespondence(G,MagmaHomomorphismByFunctionNC(M!.free,G,w->FRElement(M,w)));
SetUnderlyingFRMachine(G,M);
return G;
end);
InstallMethod(SCGroup, "(FR) for a FR machine",
[IsFRMachine],
function(M)
local gens, corr, i, x, G;
gens := []; corr := [];
for i in GeneratorsOfFRMachine(M) do
x := FRElement(M,i);
if IsOne(x) then
Add(corr,0);
elif x in gens then
Add(corr,Position(gens,x));
elif x^-1 in gens then
Add(corr,-Position(gens,x^-1));
else
Add(gens,x);
Add(corr,Size(gens));
fi;
od;
if gens=[] then
G := TrivialSubgroup(Group(FRElement(M,GeneratorsOfFRMachine(M)[1])));
else
G := Group(gens);
fi;
SetAlphabetOfFRSemigroup(G,AlphabetOfFRObject(M));
SetIsStateClosed(G,true);
if IsMealyMachine(M) then
SetCorrespondence(G,corr);
elif IsFRMachineStdRep(M) then
SetCorrespondence(G,GroupHomomorphismByFunction(M!.free,G,w->FRElement(M,w)));
fi;
SetUnderlyingFRMachine(G,M);
return G;
end);
InstallMethod(SCMonoid, "(FR) for a FR machine",
[IsFRMachine],
function(M)
local gens, corr, i, x, G;
gens := []; corr := [];
for i in GeneratorsOfFRMachine(M) do
x := FRElement(M,i);
if IsOne(x) then
Add(corr,0);
elif x in gens then
Add(corr,Position(gens,x));
else
Add(gens,x);
Add(corr,Size(gens));
fi;
od;
if gens=[] then
G := TrivialSubmonoid(Monoid(FRElement(M,GeneratorsOfFRMachine(M)[1])));
else
G := Monoid(gens);
fi;
SetAlphabetOfFRSemigroup(G,AlphabetOfFRObject(M));
SetIsStateClosed(G,true);
if IsMealyMachine(M) then
SetCorrespondence(G,corr);
elif IsFRMachineStdRep(M) then
SetCorrespondence(G,MagmaHomomorphismByFunctionNC(M!.free,G,w->FRElement(M,w)));
fi;
SetUnderlyingFRMachine(G,M);
return G;
end);
InstallMethod(SCSemigroup, "(FR) for a FR machine",
[IsFRMachine],
function(M)
local gens, corr, i, x, G;
gens := []; corr := [];
for i in GeneratorsOfFRMachine(M) do
x := FRElement(M,i);
if x in gens then
Add(corr,Position(gens,x));
else
Add(gens,x);
Add(corr,Size(gens));
fi;
od;
G := Semigroup(gens);
SetAlphabetOfFRSemigroup(G,AlphabetOfFRObject(M));
SetIsStateClosed(G,true);
if IsMealyMachine(M) then
SetCorrespondence(G,corr);
elif IsFRMachineStdRep(M) then
SetCorrespondence(G,MagmaHomomorphismByFunctionNC(M!.free,G,w->FRElement(M,w)));
fi;
SetUnderlyingFRMachine(G,M);
return G;
end);
#############################################################################
#############################################################################
##
#O FullSCGroup
#O FullSCSemigroup
#O FullSCMonoid
##
FILTERORDER@ := [IsFRObject, IsFinitaryFRElement, IsBoundedFRElement, IsPolynomialGrowthFRElement, IsFiniteStateFRElement, IsFRElement];
# value IsFRObject means a group for which the exact category of elements is
# not known; it really stand for "unspecified subgroup of FullSCGroup"
BindGlobal("FULLGETDATA@", function(arglist,
cat, Iscat, IsFRcat, GeneratorsOfcat, AscatFRElement,
makevertex, stype)
local a, G, rep, alphabet, i, x, name, filter, depth, vertex, o, onerep;
filter := IsFRElement;
depth := infinity;
for a in arglist do
if Iscat(a) then
vertex := a;
elif IsList(a) or IsDomain(a) then
alphabet := a;
elif IsFilter(a) then
if Position(FILTERORDER@,a)<Position(FILTERORDER@,filter) then filter := a; fi;
elif IsInt(a) then
depth := a;
else
Error("Unknown argument ",a,"\n");
fi;
od;
if not IsBound(alphabet) then
if IsBound(vertex) and IsSemigroup(vertex) then
alphabet := [1..LargestMovedPoint(vertex)];
else
Error("Please specify at least a vertex group or an alphabet\n");
fi;
elif not IsBound(vertex) then
vertex := makevertex(alphabet);
fi;
rep := First(GeneratorsOfSemigroup(vertex),x->not IsOne(x));
if rep=fail then rep := Representative(vertex); fi;
onerep := One(vertex);
if onerep=fail then
onerep := rep;
fi; # maybe this does not define an element of the semigroup :(
if IsList(alphabet) then
rep := MealyElement([List(alphabet,a->2),List(alphabet,a->2)],[rep,onerep],1);
else
rep := MealyElement(Domain([1,2]),alphabet,function(s,a) return 1; end, function(s,a) if s=1 then return a; else return a^Representative(vertex); fi; end);
fi;
if depth < infinity then filter := IsFinitaryFRElement; fi;
if filter=IsFRElement then rep := AscatFRElement(rep); fi;
G := Objectify(NewType(FamilyObj(cat(rep)),
IsFRcat and IsAttributeStoringRep),
rec());
SetAlphabetOfFRSemigroup(G,alphabet);
SetDepthOfFRSemigroup(G,depth);
if IsOne(onerep) then
SetOne(G,One(rep));
else
SetOne(G,fail);
fi;
if ((IsList(alphabet) or HasSize(alphabet)) and Size(alphabet)=1) or not IsBound(Enumerator(vertex)[2]) or depth=0 then
SetIsTrivial(G, true);
SetIsFinite(G, true);
Setter(GeneratorsOfcat)(G,[]);
if Size(vertex)=0 or (One(G)=fail and depth<>infinity) then
SetSize(G,0);
else
SetSize(G,1);
SetRepresentative(G,rep);
fi;
else
if filter<>IsFRObject and (onerep<>rep or depth=infinity) then
SetRepresentative(G,rep); # if finite depth and semigroup,
# maybe there are no representative
fi;
SetIsTrivial(G, false);
if depth=infinity then
SetIsFinite(G, false);
SetSize(G, infinity);
elif IsList(alphabet) or HasSize(alphabet) then
SetIsFinite(G, true);
SetSize(G, Size(vertex)^((Size(alphabet)^depth-1)/(Size(alphabet)-1)));
x := GeneratorsOfcat(vertex);
x := List(x,g->MealyElement([List(alphabet,a->2),List(alphabet,a->2)],[g,One(vertex)],1));
if cat=Group then
o := List(Orbits(vertex,alphabet),Representative);
else
o := alphabet;
fi;
a := x;
for i in [1..depth-1] do
x := Concatenation(List(x,g->List(o,a->VertexElement(a,g))));
Append(a,x);
od;
Setter(GeneratorsOfcat)(G,a);
if cat=Group then
Append(a,List(a,Inverse));
Setter(GeneratorsOfSemigroup)(G,a);
fi;
fi;
fi;
if filter=IsFRObject then
name := "<recursive ";
Append(name,LowercaseString(stype));
Append(name," over ");
Append(name,String(alphabet));
Append(name,">");
else
name := "FullSC";
Append(name,stype);
Append(name,"(");
Append(name,String(alphabet));
if vertex<>makevertex(alphabet) then
Append(name,", "); PrintTo(OutputTextString(name,true),vertex);
fi;
if depth < infinity then
Append(name,", "); Append(name,String(depth));
elif filter <> IsFRElement then
Setter(filter)(G,true);
x := ""; PrintTo(OutputTextString(x,false),filter);
if x{[1..10]}="<Operation" then x := x{[13..Length(x)-2]}; fi;
Append(name,", "); Append(name,x);
fi;
Append(name,")");
for x in [2..Position(FILTERORDER@,filter)-1] do
Setter(FILTERORDER@[x])(G,false);
od;
SetIsStateClosed(G, true);
SetIsRecurrentFRSemigroup(G, depth=infinity);
SetIsBranched(G, depth=infinity);
if depth<infinity and cat=Group then
SetBranchingSubgroup(G,TrivialSubgroup(G));
x := EpimorphismPermGroup(G,depth);
SetIsInjective( x, true );
SetIsHandledByNiceMonomorphism(G,true);
SetNiceMonomorphism(G,x);
else
SetBranchingSubgroup(G,G);
fi;
if filter=IsFinitaryFRElement then
if One(G)=fail then
SetNucleusOfFRSemigroup(G,[]);
else
SetNucleusOfFRSemigroup(G,[One(G)]);
fi;
else
SetNucleusOfFRSemigroup(G,G);
fi;
SetIsContracting(G,filter=IsFinitaryFRElement or filter=IsBoundedFRElement);
SetHasOpenSetConditionFRSemigroup(G,filter=IsFinitaryFRElement);
fi;
SetFullSCVertex(G,vertex);
SetFullSCFilter(G,filter);
SetName(G,name);
return G;
end);
InstallGlobalFunction(FullSCGroup, # "(FR) full tree automorphism group",
function(arg)
local G;
G := FULLGETDATA@(arg,Group,IsGroup,IsFRGroup,GeneratorsOfGroup,AsGroupFRElement,
SymmetricGroup,"Group");
if IsTrivial(G) or FullSCFilter(G)=IsFRObject then
return G;
elif DepthOfFRSemigroup(G)=infinity then
SetIsLevelTransitiveFRGroup(G,IsTransitive(FullSCVertex(G),AlphabetOfFRSemigroup(G)));
SetIsFinitelyGeneratedGroup(G, false);
SetCentre(G, TrivialSubgroup(G));
SetIsSolvableGroup(G, false);
SetIsAbelian(G, false);
fi;
SetIsPerfectGroup(G, IsPerfectGroup(FullSCVertex(G)));
return G;
end);
InstallGlobalFunction(FullSCMonoid,
function(arg)
local M;
M := FULLGETDATA@(arg,Monoid,IsMonoid,IsFRMonoid,GeneratorsOfMonoid,AsMonoidFRElement,
FullTransformationMonoid,
"Monoid");
return M;
end);
InstallGlobalFunction(FullSCSemigroup,
function(arg)
local S;
S := FULLGETDATA@(arg,Semigroup,IsSemigroup,IsFRSemigroup,GeneratorsOfSemigroup,AsSemigroupFRElement,
FullTransformationSemigroup,"Semigroup");
return S;
end);
InstallTrueMethod(HasFullSCData, HasFullSCVertex and HasFullSCFilter);
#############################################################################
#############################################################################
##
#M AlphabetOfFRSemigroup
##
InstallMethod(AlphabetOfFRSemigroup, "(FR) for an FR semigroup",
[IsFRSemigroup],
function(G)
local p;
while not HasRepresentative(G) and HasParent(G) and not IsIdenticalObj(Parent(G),G) do
G := Parent(G);
od;
return AlphabetOfFRObject(Representative(G));
end);
#############################################################################
#############################################################################
##
#M IsGeneratorsOfMagmaWithInverses
##
InstallMethod(IsGeneratorsOfMagmaWithInverses, "(FR) for a list of FR elements",
[IsListOrCollection],
function(L)
if ForAll(L,IsFRElement) and ForAll(L,IsInvertible) then return true;
else TryNextMethod(); fi;
end);
#############################################################################
#############################################################################
##
#M Random
#M Pseudorandom
##
BindGlobal("RANDOMFINITARY@", function(G,d)
local i, a, t, transitions, output;
if d=0 then return One(G); fi;
transitions := [];
output := [Random(FullSCVertex(G))];
for i in [0..d-2] do for i in [1..Size(AlphabetOfFRSemigroup(G))^i] do
t := [];
for a in AlphabetOfFRSemigroup(G) do
Add(output,Random(FullSCVertex(G)));
Add(t,Length(output));
od;
Add(transitions,t);
od; od;
Add(output,One(FullSCVertex(G)));
for i in [0..Size(AlphabetOfFRSemigroup(G))^(d-1)] do
Add(transitions,List(AlphabetOfFRSemigroup(G),a->Length(output)));
od;
return MealyElement(transitions,output,1);
end);
BindGlobal("RANDOMBOUNDED@", function(G)
local E, F, M, s, n, i, j;
if IsTrivial(G) then
return One(G);
fi;
s := Size(AlphabetOfFRSemigroup(G));
F := RANDOMFINITARY@(G,Random([2..4]));
M := UnderlyingFRMachine(F);
for i in [0..5] do
n := Random([1..4]);
E := MealyMachineNC(FRMFamily(AlphabetOfFRSemigroup(G)),List([1..n],i->List([1..s],i->Random(n+[1..M!.nrstates]))),List([1..n],i->ListTransformation(Random(FullSCVertex(G)),s)))+M;
for j in [1..n] do
E!.transitions[j][Random([1..s])] := 1+RemInt(j,n);
od;
F := F*FRElement(E,1);
od;
return F;
end);
BindGlobal("RANDOMPOLYNOMIALGROWTH@", function(G)
local E, F, i, j, one, n, p;
# F := RANDOMBOUNDED@(G);
for i in [0..5] do
E := UnderlyingFRMachine(RANDOMBOUNDED@(G));
for j in [1..Random([0..4])] do
one := First([1..E!.nrstates],i->IsOne(FRElement(E,i)));
repeat
n := Random([1..E!.nrstates]);
p := Random([1..Size(AlphabetOfFRSemigroup(G))]);
until E!.transitions[n][p]=one;
E := E+UnderlyingFRMachine(RANDOMBOUNDED@(G));
E!.transitions[n^Correspondence(E)[1]][p] := 1^Correspondence(E)[2];
od;
return FRElement(E,1);
F := F*E;
od;
return F;
end);
InstallMethodWithRandomSource(Random, "for a random source and a full SC Group",
[IsRandomSource, IsFRSemigroup and HasFullSCData],
function (rs, G)
local n, f;
if DepthOfFRSemigroup(G)<infinity then
return Minimized(RANDOMFINITARY@(G,DepthOfFRSemigroup(G)));
elif IsFinitaryFRSemigroup(G) then
return Minimized(RANDOMFINITARY@(G,Random(rs, 0, 5)));
elif IsBoundedFRSemigroup(G) then
return RANDOMBOUNDED@(G);
elif IsPolynomialGrowthFRSemigroup(G) then
return RANDOMPOLYNOMIALGROWTH@(G);
elif IsFiniteStateFRSemigroup(G) then
n := Random(rs, 1, 20);
return MealyElement(List([1..n],s->List(AlphabetOfFRSemigroup(G),a->Random(rs, 1, n))),List([1..n],s->Random(rs, FullSCVertex(G))),1);
else
n := Random(rs, 1, 5);
if IsGroup(StateSet(Representative(G))) then
f := FreeGroup(n);
else
f := FreeMonoid(n);
fi;
return FRElement(f,List([1..n],s->List(AlphabetOfFRSemigroup(G),a->Random(rs, f))),List([1..n],s->Random(rs, FullSCVertex(G))),Random(rs, f));
fi;
end);
BindGlobal("INITPSEUDORANDOM@", function(g, len, scramble)
local gens, seed, i;
gens := GeneratorsOfSemigroup(g);
if 0 = Length(gens) then
SetPseudoRandomSeed(g,[[]]);
return;
fi;
len := Maximum(len,Length(gens),2);
seed := ShallowCopy(gens);
for i in [Length(gens)+1..len] do
seed[i] := Random(gens);
od;
SetPseudoRandomSeed(g,[seed]);
for i in [1..scramble] do
PseudoRandom(g);
od;
end);
BindGlobal("PSEUDORANDOM@", function (g)
local seed, i, j;
if not HasPseudoRandomSeed(g) then
i := Length( GeneratorsOfSemigroup(g) );
INITPSEUDORANDOM@(g, i+10, Maximum(i*10,100));
fi;
seed := PseudoRandomSeed(g);
if 0 = Length(seed[1]) then
return One(g);
fi;
i := Random([1..Length(seed[1])]);
repeat
j := Random([1..Length(seed[1])]);
until i <> j;
if Random([true, false]) then
seed[1][j] := seed[1][i] * seed[1][j];
else
seed[1][j] := seed[1][j] * seed[1][i];
fi;
return seed[1][j];
end);
InstallMethod(PseudoRandom, "(FR) for an FR group",
[IsFRSemigroup],
function(g)
local lim, gens, i, x;
lim := ValueOption("radius");
if lim=fail then return PSEUDORANDOM@(g); fi;
gens := GeneratorsOfSemigroup(g);
x := Random(gens);
for i in [1..lim] do x := x*Random(gens); od;
return x;
end);
#############################################################################
#############################################################################
##
#M IsSubgroup
#M \in
#M =
#M IsSubset
#M Size
#M IsFinite
#M Iterator
#M Enumerator
##
InstallMethod(IsSubset, "(FR) for two full FR semigroups",
IsIdenticalObj,
[IsFRSemigroup and HasFullSCData, IsFRSemigroup and HasFullSCData],
100, # make sure groups with full SC data come first
function (G, H)
if FullSCFilter(G)=IsFRObject then
return fail;
elif not IsSubset(FullSCVertex(G), FullSCVertex(H)) then
return false;
elif DepthOfFRSemigroup(G)<DepthOfFRSemigroup(H) then
return false;
elif DepthOfFRSemigroup(H)<infinity then
return true;
elif Position(FILTERORDER@,FullSCFilter(G))<Position(FILTERORDER@,FullSCFilter(H)) then
return false;
else
return true;
fi;
end);
InstallMethod(IsSubset, "(FR) for an FR semigroup and a full SC semigroup",
IsIdenticalObj,
[IsFRSemigroup, IsFRSemigroup and HasFullSCData],
function (G, H)
if FullSCFilter(H)=IsFRObject then
return fail;
elif DepthOfFRSemigroup(H)<>infinity and
ForAll(GeneratorsOfSemigroup(H),x->x in G) then
return true;
else
return false;
fi;
end);
InstallMethod(IsSubset, "(FR) for an FR semigroup and a f.g. FR group",
IsIdenticalObj,
[IsFRSemigroup, IsFRGroup and IsFinitelyGeneratedGroup],
5, # little boost: avoid GAP methods that involve finiteness tests
function (G, H)
return IsSubset(G, GeneratorsOfGroup(H));
end);
InstallMethod(IsSubset, "(FR) for an FR semigroup and an FR monoid",
IsIdenticalObj,
[IsFRSemigroup, IsFRMonoid and IsFinitelyGeneratedMonoid],
5, # little boost: avoid GAP methods that involve finiteness tests
function (G, H)
return IsSubset(G, GeneratorsOfMonoid(H));
end);
InstallMethod(IsSubset, "(FR) for two FR semigroups",
IsIdenticalObj,
[IsFRSemigroup, IsFRSemigroup], # missing IsFinitelyGeneratedSemigroup!
5, # little boost: avoid GAP methods that involve finiteness tests
function (G, H)
return IsSubset(G, GeneratorsOfSemigroup(H));
end);
InstallMethod(\=, "(FR) for two FR semigroups",
IsIdenticalObj,
[IsFRSemigroup, IsFRSemigroup],
5, # little boost: avoid GAP methods that involve finiteness tests
function (G, H)
return IsSubset(G, H) and IsSubset(H, G);
end);
# we duplicate the method above for groups, otherwise the generic method
# for groups gets higher priority -- and triggers "IsFinite".
InstallMethod(\=, "(FR) for two FR semigroups",
IsIdenticalObj,
[IsFRGroup, IsFRGroup],
5, # little boost: avoid GAP methods that involve finiteness tests
function (G, H)
return IsSubset(G, H) and IsSubset(H, G);
end);
InstallMethod(\in, "(FR) for an FR element and a full SC semigroup",
IsElmsColls,
[IsFRElement, IsFRSemigroup and HasFullSCData],
function ( g, G )
if FullSCFilter(G)=IsFRObject then
return fail;
elif not ForAll(States(g), s->TransformationList(Output(s)) in FullSCVertex(G)) then
return false;
elif not FullSCFilter(G)(g) then
return false;
elif DepthOfFRSemigroup(G)<>infinity and DepthOfFRElement(g)>DepthOfFRSemigroup(G) then
return false;
else
return true;
fi;
end);
InstallMethod(\in, "(FR) for an FR element and an FR semigroup",
IsElmsColls,
[IsFRElement, IsFRSemigroup],
function ( g, G )
local b;
if HasNucleusOfFRSemigroup(G) then
if not IsFiniteStateFRElement(g) or not
IsSubset(NucleusOfFRSemigroup(G),LimitStates(g)) then
return false;
fi;
fi;
SEARCH@.INIT(G);
while true do
b := SEARCH@.IN(g,G);
if b<>fail then return b; fi;
while SEARCH@.EXTEND(G)=fail do
SEARCH@.ERROR(G,"\\in");
od;
Info(InfoFR, 3, "\\in: searching at level ",G!.FRData.level," and in sphere of radius ",G!.FRData.radius);
od;
end);
InstallMethod(IsConjugate, "(FR) for an FR element and an FR group",
[IsFRGroup,IsFRElement, IsFRElement],
function ( G, g, h )
local b;
SEARCH@.INIT(G);
while true do
b := SEARCH@.CONJUGATE(G,g,h);
if b<>fail then return b; fi;
while SEARCH@.EXTEND(G)=fail do
SEARCH@.ERROR(G,"IsConjugate");
od;
Info(InfoFR, 3, "IsConjugate: searching at level ",G!.FRData.level," and in sphere of radius ",G!.FRData.radius);
od;
end);
InstallOtherMethod(RepresentativeActionOp, "(FR) for an FR element and an FR group",
[IsFRGroup,IsFRElement, IsFRElement, IsFunction],
function ( G, g, h, f )
local b;
if f <> OnPoints then TryNextMethod(); fi;
SEARCH@.INIT(G);
while true do
b := SEARCH@.CONJUGATE_WITNESS(G,g,h);
if b<>fail then
if b=false
then return fail;
else
return b;
fi;
fi;
while SEARCH@.EXTEND(G)=fail do
SEARCH@.ERROR(G,"RepresentativeActionOp");
od;
Info(InfoFR, 3, "RepresentativeActionOp: searching at level ",G!.FRData.level," and in sphere of radius ",G!.FRData.radius);
od;
end);
BindGlobal("EDGESTABILIZER@", function(G)
# returns the stabilizer of an edge in the tree; i.e.
# computes the action on the second level, and takes the stabilizer of a subtree and at the root.
local i, a, s;
a := AlphabetOfFRSemigroup(G);
s := Stabilizer(PermGroup(G,2),a,OnTuples); # fix [1,1],...,[1,d]
for i in a do
s := Stabilizer(s,a+(i-1)*Size(a),OnSets); # preserve {[i,1],...,[i,d]}
od;
# the following method is too slow
#s := Stabilizer(s,List(AlphabetOfFRSemigroup(G),i->(i-1)*Size(AlphabetOfFRSemigroup(G))+AlphabetOfFRSemigroup(G)),OnTuplesSets);
return s;
end);
BindGlobal("ISFINITE_THOMPSONWIELANDT@", function(G)
# returns 'true' if G is finite, 'false' if not, 'fail' otherwise
#
# Thompson-Wielandt's theorem says that G is infinite if the stabilizer of a vertex is primitive
# and the stabilizer of the star of an edge is not a p-group; see
# Burger-Mozes, Lattices..., prop 1.3
local q, s;
if HasUnderlyingFRMachine(G) and IsBireversible(UnderlyingFRMachine(G))
and IsPrimitive(VertexTransformations(G),AlphabetOfFRSemigroup(G)) then
s := EDGESTABILIZER@(G);
if not IsPGroup(s) then
return false;
fi;
fi;
return fail;
end);
BindGlobal("ISFINITE_MINIMIZEDUAL@", function(G)
# keep taking dual and minimizing, ask whether we get the trivial machine
local gens, m, oldm;
if not HasGeneratorsOfGroup(G) then
return fail;
fi;
gens := GeneratorsOfGroup(G);
if ForAll(gens,HasIsFiniteStateFRElement) and ForAll(gens,IsFiniteStateFRElement) then
m := Sum(List(gens,UnderlyingFRMachine));
repeat
oldm := m;
m := Minimized(DualMachine(m));
m := Minimized(DualMachine(m));
until m=oldm;
if Size(StateSet(m))=1 then
return true;
fi;
fi;
return fail;
end);
InstallMethod(IsFinite, "(FR) for an FR group",
[IsFRGroup],
function(G)
local b;
if IsFinitaryFRSemigroup(G) then
return true;
fi;
b := ISFINITE_MINIMIZEDUAL@(G);
if b<>fail then
return b;
fi;
b := ISFINITE_THOMPSONWIELANDT@(G);
if b<>fail then
return b;
fi;
if IsLevelTransitiveFRGroup(G) then
return false;
fi;
TryNextMethod();
end);
BindGlobal("SIZE@", function(G,testorder)
local n, g, iter;
iter := Iterator(G);
n := 0;
while not IsDoneIterator(iter) do
g := NextIterator(iter);
if testorder and Order(g)=infinity then return infinity; fi;
n := n+1;
if RemInt(n,100)=0 then
Info(InfoFR,2,"Size: is at least ",n);
fi;
od;
return n;
end);
InstallMethod(IsTrivial, "(FR) for an FR semigroup",
[IsFRSemigroup],
function(G)
return ForAll(GeneratorsOfSemigroup(G),IsOne);
end);
InstallMethod(IsTrivial, "(FR) for an FR monoid",
[IsFRMonoid],
function(G)
return ForAll(GeneratorsOfMonoid(G),IsOne);
end);
InstallMethod(IsTrivial, "(FR) for an FR group",
[IsFRGroup],
function(G)
return ForAll(GeneratorsOfGroup(G),IsOne);
end);
InstallMethod(Size, "(FR) for an FR semigroup",
[IsFRSemigroup],
function(G)
return SIZE@(G,false);
end);
InstallMethod(Size, "(FR) for an FR group",
[IsFRGroup],
function(G)
local b, gens, rays;
b := ISFINITE_THOMPSONWIELANDT@(G);
if b=true then
return SIZE@(G,false);
elif b=false then
return infinity;
elif IsBoundedFRSemigroup(G) then
gens := GeneratorsOfGroup(G);
rays := Union(List(gens,g->List(Germs(g),p->p[1])));
if ForAll(rays,x->ForAll(gens,s->x^s=x)) then
return SIZE@(G,false);
fi;
fi;
if IsLevelTransitiveFRGroup(G) then return infinity; fi;
#!!! try to find a subgroup that acts transitively on a subtree
return SIZE@(G,true);
end);
SEARCH@.NEXTITERATOR := function(iter)
if iter!.pos < Length(iter!.G!.FRData.sphere[iter!.radius+1]) then
iter!.pos := iter!.pos+1;
else
iter!.pos := 1;
while iter!.radius=iter!.G!.FRData.radius and
SEARCH@.EXTEND(iter!.G,SEARCH@.BALL)=fail do
SEARCH@.ERROR(iter!.G,"NextIterator");
od;
iter!.radius := iter!.radius+1;
if iter!.G!.FRData.sphere[iter!.radius+1]=[] then return fail; fi;
fi;
return iter!.G!.FRData.sphere[iter!.radius+1][iter!.pos];
end;
SEARCH@.ISDONEITERATOR := function(iter)
if iter!.pos < Length(iter!.G!.FRData.sphere[iter!.radius+1]) then
return false;
else
iter!.pos := 0;
while iter!.radius=iter!.G!.FRData.radius and
SEARCH@.EXTEND(iter!.G,SEARCH@.BALL)=fail do
SEARCH@.ERROR(iter!.G,"IsDoneIterator");
od;
iter!.radius := iter!.radius+1;
return iter!.G!.FRData.sphere[iter!.radius+1]=[];
fi;
end;
SEARCH@.SHALLOWCOPY := function(iter)
return rec(
NextIterator := SEARCH@.NEXTITERATOR,
IsDoneIterator := SEARCH@.ISDONEITERATOR,
ShallowCopy := SEARCH@.SHALLOWCOPY,
G := iter!.G,
pos := iter!.pos,
radius := iter!.radius);
end;
SEARCH@.ELEMENTNUMBER := function(iter,n)
local i;
i := 1;
while n > Length(iter!.G!.FRData.sphere[i]) do
n := n-Length(iter!.G!.FRData.sphere[i]);
i := i+1;
while not IsBound(iter!.G!.FRData.sphere[i]) and
SEARCH@.EXTEND(iter!.G,SEARCH@.BALL)=fail do
SEARCH@.ERROR(iter!.G,"ElementNumber");
od;
if iter!.G!.FRData.sphere[i]=[] then return fail; fi;
od;
return iter!.G!.FRData.sphere[i][n];
end;
SEARCH@.NUMBERELEMENT := function(iter,x)
local i, n, p;
i := 1; n := 0;
repeat
while not IsBound(iter!.G!.FRData.sphere[i]) and
SEARCH@.EXTEND(iter!.G,SEARCH@.BALL)=fail do
SEARCH@.ERROR(iter!.G,"NumberElement");
od;
p := Position(iter!.G!.FRData.sphere[i],x);
if p<>fail then return n+p; fi;
n := n+Length(iter!.G!.FRData.sphere[i]);
i := i+1;
until false;
end;
InstallMethod(Iterator, "(FR) for an FR semigroup",
[IsFRSemigroup],
function(G)
SEARCH@.INIT(G);
return IteratorByFunctions(rec(
NextIterator := SEARCH@.NEXTITERATOR,
IsDoneIterator := SEARCH@.ISDONEITERATOR,
ShallowCopy := SEARCH@.SHALLOWCOPY,
G := G,
pos := 0,
radius := 0));
end);
InstallMethod(Iterator, "(FR) for an FR semigroup with SC data",
[IsFRSemigroup and HasFullSCData],
function(G)
local maker;
if DepthOfFRSemigroup(G)<infinity then
TryNextMethod(); # GAP does a fine job here
elif IsFinitaryFRSemigroup(G) then
if IsGroup(G) then
maker := n->FullSCGroup(AlphabetOfFRSemigroup(G),VertexTransformations(G),n);
elif IsMonoid(G) then
maker := n->FullSCMonoid(AlphabetOfFRSemigroup(G),VertexTransformations(G),n);
else
maker := n->FullSCSemigroup(AlphabetOfFRSemigroup(G),VertexTransformations(G),n);
fi;
return IteratorByFunctions(rec(
NextIterator := function(iter)
local n;
repeat
if IsDoneIterator(iter!.iter) then
iter!.level := iter!.level+1;
iter!.iter := Iterator(maker(iter!.level));
fi;
n := NextIterator(iter!.iter);
until DepthOfFRSemigroup(n)>=iter!.level;
return n;
end,
IsDoneIterator := ReturnFalse,
ShallowCopy := function(iter)
return rec(NextIterator := iter!.NextIterator,
IsDoneIterator := iter!.IsDoneIterator,
ShallowCopy := iter!.ShallowCopy,
level := iter!.level,
iter := ShallowCopy(iter!.iter));
end,
level := 0,
iter := Iterator(maker(0))));
else
return fail; # probably not worth coding
fi;
end);
InstallMethod(Enumerator, "(FR) for an FR semigroup",
[IsFRSemigroup],
function(G)
SEARCH@.INIT(G);
return EnumeratorByFunctions(G,rec(
ElementNumber := SEARCH@.ELEMENTNUMBER,
NumberElement := SEARCH@.NUMBERELEMENT,
G := G));
end);
InstallMethod(PreImagesRepresentativeNC, "(FR) for a map to an FR group",
[IsGroupGeneralMappingByImages, IsMultiplicativeElementWithInverse],
function(f,y)
local iter, x;
if not IsFRGroup(Range(f)) then TryNextMethod(); fi;
iter := Iterator(Source(f));
while not IsDoneIterator(iter) do
x := NextIterator(iter);
if x^f=y then return x; fi;
od;
return fail;
end);
#############################################################################
#############################################################################
##
#M View
##
BindGlobal("VIEWFRGROUP@", function(G,gens,name)
local n, s;
s := "<";
if HasIsStateClosed(G) then
if not IsStateClosed(G) then Append(s,"non-"); fi;
Append(s,"state-closed");
else
Append(s,"recursive");
fi;
if HasIsRecurrentFRSemigroup(G) and IsRecurrentFRSemigroup(G) then
Append(s,", recurrent");
fi;
if HasIsLevelTransitiveFRGroup(G) and IsLevelTransitiveFRGroup(G) then
Append(s,", level-transitive");
fi;
if HasIsContracting(G) and IsContracting(G) then
Append(s,", contracting");
fi;
if HasIsFinitaryFRSemigroup(G) and IsFinitaryFRSemigroup(G) then
Append(s,", finitary");
elif HasIsBoundedFRSemigroup(G) and IsBoundedFRSemigroup(G) then
Append(s,", bounded");
elif HasIsPolynomialGrowthFRSemigroup(G) and IsPolynomialGrowthFRSemigroup(G) then
Append(s,", polynomial-growth");
elif HasIsFiniteStateFRSemigroup(G) and IsFiniteStateFRSemigroup(G) then
Append(s,", finite-state");
fi;
if HasIsBranched(G) and IsBranched(G) then
Append(s,", branched");
fi;
n := Length(gens(G));
APPEND@(s," ",name," over ",AlphabetOfFRSemigroup(G)," with ",n," generator");
if n<>1 then Append(s,"s"); fi;
if HasSize(G) then APPEND@(s,", of size ",Size(G)); fi;
Append(s,">");
return s;
end);
InstallMethod(ViewString, "(FR) for an FR group",
[IsFRGroup and IsFinitelyGeneratedGroup],
G->VIEWFRGROUP@(G,GeneratorsOfGroup,"group"));
InstallMethod(ViewString, "(FR) for an FR monoid",
[IsFRMonoid],
G->VIEWFRGROUP@(G,GeneratorsOfMonoid,"monoid"));
InstallMethod(ViewString, "(FR) for an FR semigroup",
[IsFRSemigroup],
G->VIEWFRGROUP@(G,GeneratorsOfSemigroup,"semigroup"));
INSTALLPRINTERS@(IsFRGroup);
INSTALLPRINTERS@(IsFRMonoid);
INSTALLPRINTERS@(IsFRSemigroup);
#############################################################################
#############################################################################
##
#M ExternalSet
##
InstallOtherMethod(ExternalSet, "(FR) for an FR semigroup and a depth",
[IsFRSemigroup, IsPosInt],
function( g, n )
return ExternalSet(g,Cartesian(List([1..n],i->AlphabetOfFRSemigroup(g))),\^);
end);
#############################################################################
#############################################################################
##
#M VertexTransformations
##
InstallMethod(TopVertexTransformations, "(FR) for a f.g. FR group",
[IsFRGroup and IsFinitelyGeneratedGroup],
function(g)
if GeneratorsOfGroup(g)=[] then return Group(()); fi;
return Group(List(GeneratorsOfGroup(g),ActivityPerm));
end);
InstallMethod(TopVertexTransformations, "(FR) for a FR monoid",
[IsFRMonoid],
function(g)
if GeneratorsOfMonoid(g)=[] then return Monoid(IdentityTransformation); fi;
return Monoid(List(GeneratorsOfMonoid(g),ActivityTransformation));
end);
InstallMethod(TopVertexTransformations, "(FR) for a FR semigroup",
[IsFRSemigroup],
function(g)
return Semigroup(List(GeneratorsOfSemigroup(g),ActivityTransformation));
end);
InstallMethod(VertexTransformations, "(FR) for a f.g. FR group",
[IsFRGroup and IsFinitelyGeneratedGroup],
function(g)
if GeneratorsOfGroup(g)=[] then return Group(()); fi;
return Group(Concatenation(List(GeneratorsOfGroup(g),g->List(States(g),ActivityPerm))));
end);
InstallMethod(VertexTransformations, "(FR) for a FR monoid",
[IsFRMonoid],
function(g)
if GeneratorsOfMonoid(g)=[] then return Monoid(IdentityTransformation); fi;
return Monoid(Concatenation(List(GeneratorsOfMonoid(g),g->List(States(g),ActivityTransformation))));
end);
InstallMethod(VertexTransformations, "(FR) for a FR semigroup",
[IsFRSemigroup],
function(g)
return Semigroup(Concatenation(List(GeneratorsOfSemigroup(g),g->List(States(g),ActivityTransformation))));
end);
InstallMethod(TopVertexTransformations, "(FR) for a full SC semigroup",
[IsFRSemigroup and HasFullSCData],
FullSCVertex);
InstallMethod(VertexTransformations, "(FR) for a full SC semigroup",
[IsFRSemigroup and HasFullSCData],
FullSCVertex);
#############################################################################
#############################################################################
##
#M PermGroup
#M EpimorphismPermGroup
##
InstallMethod(PermGroup, "(FR) for a f.g. FR group and a level",
[IsFRGroup and IsFinitelyGeneratedGroup, IsInt], 1,
function( g, n )
if IsTrivial(g) then return Group(()); fi;
return Group(List(GeneratorsOfGroup(g),x->ActivityPerm(x,n)));
end);
InstallMethod(PermGroup, "(FR) for a full FR group and a level",
[IsFRGroup and HasFullSCData, IsInt],
function( g, n )
return PermGroup(FullSCGroup(FullSCVertex(g),FullSCFilter(g),n),n);
end);
InstallMethod(EpimorphismPermGroup, "(FR) for a f.g. FR group and a level",
[IsFRGroup, IsInt], 1,
function( g, n )
local q, h;
q := PermGroup(g,n);
if HasGeneratorsOfGroup(g) then
h := GroupGeneralMappingByImagesNC(q,g,List(GeneratorsOfGroup(g),w->ActivityPerm(w,n)),GeneratorsOfGroup(g));
q := GroupHomomorphismByFunction(g,q,w->ActivityPerm(w,n),false,x->ImagesRepresentative(h,x));
else
q := GroupHomomorphismByFunction(g,q,w->ActivityPerm(w,n));
fi;
SetLevelOfEpimorphismFromFRGroup(q,n);
return q;
end);
InstallMethod(EpimorphismPermGroup, "(FR) for a full FR group and a level",
[IsFRGroup and HasFullSCData, IsInt],
function( g, n )
local gn, q, h;
if DepthOfFRSemigroup(g)>n then
gn := FullSCGroup(FullSCVertex(g),FullSCFilter(g),n);
else
gn := g;
fi;
q := PermGroup(gn,n);
h := GroupGeneralMappingByImagesNC(q,g,List(GeneratorsOfGroup(gn),w->ActivityPerm(w,n)),GeneratorsOfGroup(gn));
q := GroupHomomorphismByFunction(g,q,w->ActivityPerm(w,n),false,x->ImagesRepresentative(h,x));
SetLevelOfEpimorphismFromFRGroup(q,n);
return q;
end);
BindGlobal("PERMTRANS2COLL@", function(l)
local i;
if IsCollection(l) then
return l;
else # is a combination of permutations and transformations
for i in [1..Length(l)] do
if IsPerm(l[i]) then l[i] := AsTransformation(l[i]); fi;
od;
return l;
fi;
end);
BindGlobal("TRANSMONOID@", function(g,n,gens,filt,fullconstr,mconstr,constr,subconstr,activity)
local s;
if ForAny(filt,x->x(g)) then
s := gens(g);
elif HasFullSCData(g) then
s := gens(fullconstr(FullSCVertex(g),FullSCFilter(g),n));
else
TryNextMethod();
fi;
if s=[] then # GAP hates monoids and semigroups with 0 generators
return subconstr(mconstr(constr([1..Size(AlphabetOfFRSemigroup(g))^n])),[]);
fi;
return mconstr(PERMTRANS2COLL@(List(s,x->activity(x,n))));
end);
InstallMethod(TransformationMonoid, "(FR) for a f.g. FR monoid and a level",
[IsFRMonoid, IsInt],
function(g, n)
return TRANSMONOID@(g,n,GeneratorsOfMonoid,[HasGeneratorsOfMonoid,HasGeneratorsOfGroup],FullSCMonoid,Monoid,Transformation,Submonoid,ActivityTransformation);
end);
InstallMethod(EpimorphismTransformationMonoid, "(FR) for a f.g. FR monoid and a level",
[IsFRMonoid, IsInt],
function(g, n)
local q, f;
q := TransformationMonoid(g,n);
f := MagmaHomomorphismByFunctionNC(g,q,w->ActivityTransformation(w,n));
f!.prefun := x->Error("Factorization not implemented in monoids");
return f;
end);
InstallMethod(TransformationSemigroup, "(FR) for a f.g. FR semigroup and a level",
[IsFRSemigroup, IsInt],
function(g, n)
return TRANSMONOID@(g,n,GeneratorsOfSemigroup,[HasGeneratorsOfSemigroup,HasGeneratorsOfMonoid,HasGeneratorsOfGroup],FullSCSemigroup,Semigroup,Transformation,Subsemigroup,ActivityTransformation);
end);
InstallMethod(EpimorphismTransformationSemigroup, "(FR) for a f.g. FR semigroup and a level",
[IsFRSemigroup, IsInt],
function( g, n )
local q ,f;
q := TransformationSemigroup(g,n);
f := MagmaHomomorphismByFunctionNC(g,q,w->ActivityTransformation(w,n));
f!.prefun := x->Error("Factorization not implemented in semigroups");
return f;
end);
InstallMethod(PcGroup, "(FR) for an FR group and a level",
[IsFRGroup, IsInt],
function(g,n)
local q;
q := Image(IsomorphismPcGroup(PermGroup(g,n)));
if IsPGroup(VertexTransformations(g)) then
SetPrimePGroup(q,PrimePGroup(VertexTransformations(g)));
fi;
return q;
end);
InstallMethod(EpimorphismPcGroup, "(FR) for an FR group and a level",
[IsFRGroup, IsInt],
function(g,n)
local q;
q := EpimorphismPermGroup(g,n);
q := q*IsomorphismPcGroup(Image(q));
if IsPGroup(VertexTransformations(g)) then
SetPrimePGroup(Range(q),PrimePGroup(VertexTransformations(g)));
fi;
return q;
end);
InstallMethod(KernelOfMultiplicativeGeneralMapping, "(FR) for an epimorphism to perm or pc group",
[IsGroupHomomorphism and HasLevelOfEpimorphismFromFRGroup],
f->LevelStabilizer(Source(f),LevelOfEpimorphismFromFRGroup(f)));
#############################################################################
#############################################################################
##
#P IsContracting
#A NucleusOfFRSemigroup
#A NucleusMachine
##
InstallMethod(IsContracting, "(FR) for an FR semigroup",
[IsFRSemigroup],
function(G)
local N;
N := NucleusOfFRSemigroup(G);
return IsCollection(N) and IsFinite(N);
end);
InstallMethod(NucleusOfFRSemigroup, "(FR) for an FR semigroup",
[IsFRSemigroup],
G->NUCLEUS@(GeneratorsOfSemigroup(G)));
InstallMethod(NucleusMachine, "(FR) for an FR semigroup",
[IsFRSemigroup],
G->AsMealyMachine(NucleusOfFRSemigroup(G)));
BindGlobal("ADJACENCYBASESWITHONE@",
function(nuke)
local seen, i, j, a, len, u, bases, basepos, machine, skip, addelt;
addelt := function(new)
local i;
i := 1;
while i <= Length(bases) do
if IsSubset(bases[i],new) then
return false;
elif IsSubset(new,bases[i]) then
Remove(bases,i);
if basepos >= i then basepos := basepos-1; fi;
else
i := i+1;
fi;
od;
Add(bases,new);
return true;
end;
nuke := Set(nuke);
machine := AsMealyMachine(nuke);
seen := [[[1..Length(nuke)],[],false]];
bases := [];
len := 1;
basepos := 1;
while len <= Length(seen) do
if seen[len][3] then len := len+1; continue; fi;
for i in AlphabetOfFRObject(machine) do
u := Set(seen[len][1],x->Transition(machine,x,i));
a := Concatenation(seen[len][2],[i]);
skip := false;
for j in [1..Length(seen)] do
if a{[1..Length(seen[j][2])]}=seen[j][2] then # parent
if seen[j][1]=u then
addelt(u);
skip := true;
break;
fi;
elif j > len then
if IsSubset(seen[j][1],u) then skip := true; break; fi;
fi;
od;
Add(seen,[u,a,skip]);
od;
len := len+1;
od;
basepos := 1;
while basepos <= Length(bases) do
for i in AlphabetOfFRObject(machine) do
addelt(Set(bases[basepos],x->Transition(machine,x,i)));
od;
basepos := basepos+1;
od;
return [bases,nuke,List(bases,x->nuke{x})];
end);
InstallMethod(AdjacencyBasesWithOne, "(FR) for a nucleus",
[IsFRElementCollection],
L->ADJACENCYBASESWITHONE@(L)[3]);
InstallMethod(AdjacencyBasesWithOne, "(FR) for an FR semigroup",
[IsFRSemigroup],
G->ADJACENCYBASESWITHONE@(NucleusOfFRSemigroup(G))[3]);
BindGlobal("ADJACENCYPOSET@",
function(nuke)
local b, c, x, y, elements, oldelements, rel, bases, dom;
bases := ADJACENCYBASESWITHONE@(nuke);
nuke := bases[2];
bases := bases[1];
elements := [];
for b in bases do
# for x in b do # that would be to include adjacent tiles in the relation
# c := b "/" nuke[x];
c := b;
if not c in elements then
oldelements := ShallowCopy(elements);
AddSet(elements,c);
for y in oldelements do
AddSet(elements,Intersection(y,c));
od;
fi;
# od;
od;
dom := Domain(List(elements,x->nuke{x}));
rel := [];
for b in elements do for c in elements do
if IsSubset(b,c) then Add(rel,DirectProductElement([nuke{b},nuke{c}])); fi;
od; od;
return BinaryRelationByElements(dom,rel);
end);
InstallMethod(AdjacencyPoset, "(FR) for a nucleus",
[IsFRElementCollection],
ADJACENCYPOSET@);
InstallMethod(AdjacencyPoset, "(FR) for an FR semigroup",
[IsFRSemigroup],
G->ADJACENCYPOSET@(NucleusOfFRSemigroup(G)));
#############################################################################
#############################################################################
##
#M Degree
##
BindGlobal("FILTERCOMPARE@", function(G,filter)
if FullSCFilter(G)=IsFRObject then
TryNextMethod();
fi;
return Position(FILTERORDER@,FullSCFilter(G))<=Position(FILTERORDER@,filter);
end);
InstallMethod(DegreeOfFRSemigroup, "(FR) for a self-similar semigroup",
[IsFRSemigroup],
G->Maximum(List(GeneratorsOfSemigroup(G),DegreeOfFRElement)));
InstallMethod(Degree, [IsFRSemigroup], DegreeOfFRSemigroup);
InstallMethod(DegreeOfFRSemigroup, "(FR) for a full SC semigroup",
[IsFRSemigroup and HasFullSCData],
function(G)
if IsTrivial(G) then
return -1;
elif IsFinitaryFRSemigroup(G) then
return 0;
elif IsBoundedFRSemigroup(G) then
return 1;
else
return infinity;
fi;
end);
InstallMethod(IsFinitaryFRSemigroup, "(FR) for a self-similar semigroup",
[IsFRSemigroup],
G->ForAll(GeneratorsOfSemigroup(G),IsFinitaryFRElement));
InstallMethod(IsFinitaryFRSemigroup, "(FR) for a full SC semigroup",
[IsFRSemigroup and HasFullSCData],
G->FILTERCOMPARE@(G,IsFinitaryFRElement));
InstallMethod(IsWeaklyFinitaryFRSemigroup, "(FR) for a self-similar semigroup",
[IsFRSemigroup],
G->ForAll(GeneratorsOfSemigroup(G),IsWeaklyFinitaryFRElement));
InstallTrueMethod(IsFinitaryFRSemigroup, IsWeaklyFinitaryFRSemigroup);
InstallMethod(DepthOfFRSemigroup, "(FR) for a self-similar semigroup",
[IsFRSemigroup],
G->Maximum(List(GeneratorsOfSemigroup(G),DepthOfFRElement)));
InstallMethod(Depth, [IsFRSemigroup], DepthOfFRSemigroup);
InstallMethod(IsBoundedFRSemigroup, "(FR) for a self-similar semigroup",
[IsFRSemigroup],
G->ForAll(GeneratorsOfSemigroup(G),IsBoundedFRElement));
InstallMethod(IsBoundedFRSemigroup, "(FR) for a full SC semigroup",
[IsFRSemigroup and HasFullSCData],
G->FILTERCOMPARE@(G,IsBoundedFRElement));
InstallMethod(IsPolynomialGrowthFRSemigroup, "(FR) for a self-similar semigroup",
[IsFRSemigroup],
G->ForAll(GeneratorsOfSemigroup(G),IsPolynomialGrowthFRElement));
InstallMethod(IsPolynomialGrowthFRSemigroup, "(FR) for a full SC semigroup",
[IsFRSemigroup and HasFullSCData],
G->FILTERCOMPARE@(G,IsPolynomialGrowthFRElement));
InstallMethod(IsFiniteStateFRSemigroup, "(FR) for a self-similar semigroup",
[IsFRSemigroup],
G->ForAll(GeneratorsOfSemigroup(G),IsFiniteStateFRElement));
InstallMethod(IsFiniteStateFRSemigroup, "(FR) for a full SC semigroup",
[IsFRSemigroup and HasFullSCData],
G->FILTERCOMPARE@(G,IsFiniteStateFRElement));
#############################################################################
#############################################################################
##
#M IsTorsionGroup
#M IsTorsionFreeGroup
#M IsAmenableGroup
#M IsVirtuallySimpleGroup
#M IsSQUniversal
#M IsResiduallyFinite
#M IsJustInfinite
##
InstallTrueMethod(IsResiduallyFinite, IsFinite);
InstallTrueMethod(IsResiduallyFinite, IsFreeGroup);
InstallMethod(IsResiduallyFinite, "(FR) for an FR group",
[IsFRGroup],
function(G)
return IsFinite(AlphabetOfFRSemigroup(G)) or IsResiduallyFinite(VertexTransformations(G));
end);
InstallMethod(IsJustInfinite, "(FR) for a free group",
[IsFreeGroup],
G->RankOfFreeGroup(G)=1);
InstallMethod(IsJustInfinite, "(FR) for a finite group",
[IsGroup and IsFinite],
ReturnFalse);
InstallMethod(IsJustInfinite, "(FR) for a f.p. group",
[IsFpGroup],
function(G)
if 0 in AbelianInvariants(G) and not IsCyclic(G) then
return false;
fi;
if IsFinite(G) then
return false;
fi;
TryNextMethod();
end);
InstallMethod(IsJustInfinite, "(FR) for a FR group",
[IsFRGroup],
function(G)
local K;
K := BranchingSubgroup(G);
if K=fail then
TryNextMethod();
fi;
return Index(G,K)<infinity and not 0 in AbelianInvariants(K);
end);
InstallMethod(IsSQUniversal, "(FR) for a free group",
[IsFreeGroup],
G->RankOfFreeGroup(G)>=2);
InstallMethod(IsSQUniversal, "(FR) for a finite object",
[IsFinite],
ReturnFalse);
InstallMethod(IsSQUniversal, "(FR) for an amenable group",
[IsGroup],
function(G)
if HasIsAmenableGroup(G) and IsAmenableGroup(G) then
return false;
fi;
TryNextMethod();
end);
BindGlobal("TORSIONSTATES@", function(g)
local s, todo, i, j, x, y;
todo := [g];
i := 1;
while i <= Length(todo) do
if Order(todo[i])=infinity then
return fail;
fi;
x := DecompositionOfFRElement(todo[i]);
for j in Cycles(PermList(x[2]),AlphabetOfFRObject(g)) do
y := Product(x[1]{j});
if not y in todo then
Add(todo,y);
fi;
od;
i := i+1;
od;
return todo;
end);
BindGlobal("TORSIONLIMITSTATES@", function(L)
local s, d, dd, S, oldS, i, x;
s := [];
for i in L do
x := TORSIONSTATES@(i);
if x=fail then return fail; fi;
UniteSet(s,x);
od;
d := [];
for i in s do
x := DecompositionOfFRElement(i);
dd := [];
for i in Cycles(PermList(x[2]),AlphabetOfFRObject(L[1])) do
Add(dd,Position(s,Product(x[1]{i})));
od;
Add(d,dd);
od;
S := [1..Length(s)];
repeat
oldS := S;
S := Union(d{S});
until oldS=S;
return Set(s{S});
end);
BindGlobal("TORSIONNUCLEUS@", function(G)
local s, olds, news, gens, i, j;
gens := Set(GeneratorsOfSemigroup(G));
s := TORSIONLIMITSTATES@(gens);
if s=fail then return fail; fi;
olds := [];
repeat
news := Difference(s,olds);
olds := ShallowCopy(s);
for i in news do
for j in gens do AddSet(s,i*j); od;
od;
s := TORSIONLIMITSTATES@(s);
if s=fail then return fail; fi;
Info(InfoFR, 2, "TorsionNucleus: The nucleus contains at least ",s);
until olds=s;
return s;
end);
InstallTrueMethod(IsTorsionGroup, IsGroup and IsFinite);
InstallMethod(IsTorsionGroup, "(FR) for a self-similar group",
[IsFRGroup],
function(G)
Info(InfoFR,1,"Beware! This code has not been tested nor proven valid!");
return TORSIONNUCLEUS@(G)<>fail;
end);
InstallMethod(IsTorsionFreeGroup, "(FR) for a self-similar group",
[IsFRGroup],
function(G)
local iter, n, g;
if IsBoundedFRSemigroup(G) and ForAll(AbelianInvariants(G),IsZero)
and IsAbelian(VertexTransformations(G)) then
return true;
fi;
iter := Iterator(G);
n := 0;
# !!! have to be much more subtle!!! is there a finite set of
# infinite-order elements such that for all elements x in G,
# a stable state of some x^n belongs to the set?
while true do
g := NextIterator(iter);
if IsOne(g) then continue; fi;
if Order(g)<infinity then return false; fi;
n := n+1;
if RemInt(n,100)=0 then
Info(InfoFR,2,"IsTorsionFreeGroup: size is at least ",n);
fi;
od;
end);
InstallTrueMethod(IsTorsionFreeGroup, IsFreeGroup);
InstallMethod(IsSolvableGroup, [IsFreeGroup and IsFinitelyGeneratedGroup],
function(G)
return RankOfFreeGroup(G)<=1;
end);
InstallTrueMethod(IsAmenableGroup, IsGroup and IsBoundedFRSemigroup);
InstallTrueMethod(IsAmenableGroup, IsGroup and IsFinite);
InstallTrueMethod(IsAmenableGroup, IsSolvableGroup);
InstallMethod(IsAmenableGroup, [IsFreeGroup],
G->RankOfFreeGroup(G)<=1);
#!!! could be much more subtle, e.g. handling small cancellation groups
#############################################################################
#############################################################################
##
#F FRGroup
#F FRSemigroup
#F FRMonoid
##
BindGlobal("STRING_ATOM2GAP@", function(s)
local stream, result;
stream := "return ";
Append(stream,s);
Append(stream,";");
stream := InputTextString(stream);
result := ReadAsFunction(stream)();
CloseStream(stream);
return result;
end);
# gens: list of strings corresponding to generator names
# imgs: a list of the same length as imgs
# w: a string containing an expression in terms of the generators names in `gens`
BindGlobal("STRING_WORD2GAP@", function(gens,imgs,w)
local s, f, i, argname;
# generate an identifier that is definitely not in gens by making it
# longer than any element of gens
argname := ListWithIdenticalEntries(Maximum(List(gens, Length))+1, '_');
--> --------------------
--> maximum size reached
--> --------------------
