InstallGlobalFunction(ReduceWord, function(v)
local i, b;
b := []; for i in [1..Length(v)] do if v[i] <> 1then
Add(b, v[i]); fi;
od;
return b; end);
InstallGlobalFunction(ProjectWord, function(w, s, G)
local i, perm, d, proj;
d := Length(G[1])-1; if s > d or s < 1then
Error("Incorrect index of a subtree"); fi;
proj := [];
perm := (); for i in [1..Length(w)] do
Add(proj, G[w[i]][s^perm]);
perm := perm*G[w[i]][d+1];
od;
return proj; end);
InstallGlobalFunction(WordActionOnFirstLevel, function(w, G)
local i, perm, d;
d := Length(G[1])-1;
perm := (); for i in [1..Length(w)] do perm := perm*G[w[i]][d+1]; od;
return perm; end);
InstallGlobalFunction(WordActionOnVertex, function(w, ver, G)
local i, cur_w, new_ver, perm;
new_ver := [];
cur_w := ShallowCopy(w); for i in [1..Length(ver)] do
perm := WordActionOnFirstLevel(cur_w, G);
new_ver[i] := ver[i]^perm;
cur_w := ProjectWord(cur_w, ver[i], G);
od;
return new_ver; end);
InstallMethod(OrbitOfVertex, "for [IsList, IsTreeHomomorphism, IsCyclotomic]", true, [IsList, IsTreeHomomorphism, IsCyclotomic], function(ver, g, n)
local i, ver_tmp, orb;
i := 0; orb := [];
ver_tmp := ver; while i < n and (ver <> ver_tmp or i = 0) do
Add(orb, ver_tmp);
ver_tmp := ver_tmp^g;
i := i+1;
od;
return orb; end);
InstallMethod(OrbitOfVertex, "for [IsString, IsTreeHomomorphism, IsCyclotomic]", true, [IsString, IsTreeHomomorphism, IsCyclotomic], function(ver, g, n)
local i, ver_tmp, orb, ch;
ver_tmp := []; for i in [1..Length(ver)] do
ch := Int(String([ver[i]])); if ch < 1 or ch > g!.deg then
Error("received string ", ver, " does not represent a valid vertex"); fi;
Add(ver_tmp, ch);
od;
ver := ver_tmp;
i := 0; orb := [];
ver_tmp := ver; while i < n and (ver <> ver_tmp or i = 0) do
Add(orb, ver_tmp);
ver_tmp := ver_tmp^g;
i := i+1;
od;
return orb; end);
InstallMethod(PrintOrbitOfVertex, "for [IsList, IsTreeHomomorphism, IsCyclotomic]",
[IsList, IsTreeHomomorphism, IsCyclotomic], function(ver, w, n)
local orb, i, j;
orb := OrbitOfVertex(ver, w, n); if w!.deg = 2then for i in [1..Length(orb)] do for j in [1..Length(orb[1])] do # Print(orb[i][j]); if orb[i][j] = 1then Print(" "); else Print("x"); fi;
od;
Print("\n");
od; else for i in [1..Length(orb)] do for j in [1..Length(orb[1])] do
Print(orb[i][j]);
od;
Print("\n");
od; fi; end);
InstallGlobalFunction(IsOneWordSelfSim, function(w, G)
local i, IsOneWordIter, ReachedWords, d;
IsOneWordIter := function(v)
local i, j, perm; if v in ReachedWords then return true; else
perm := (); for i in [1..Length(v)] do perm := perm*G[v[i]][d+1]; od; if perm <> () then return false; fi;
Add(ReachedWords, v); for j in [1..d] do if not IsOneWordIter(ProjectWord(v, j, G)) then return false; fi;
od;
return true; fi; end;
d := Length(G[1])-1; if Length(w) = 0then return true; fi;
ReachedWords := [];
return IsOneWordIter(w); end);
InstallGlobalFunction(IsOneWordContr, function(word, G)
local IsOneWordContrLocal;
IsOneWordContrLocal:=function(word)
local i, b, l, v, c, k, res, t, w;
w := ShallowCopy(word); # Print("w=",w,"\n"); if Length(w) = 0then return true; fi; if Length(w) = 1then if w = [1] then return true; else return false; fi; fi; if Length(w) mod 2 = 1then Add(w, 1); fi;
l := []; for i in [1..Length(w)/2] do
Add(l, StructuralCopy(G[w[2*i-1]][w[2*i]]));
od; # Print("l = ", l); # list c contains permutations c[i+1] = pi[1]*pi[2]*...*pi[i]
c := [(), l[1][Length(l[1])]];
t := Length(l); for i in [2..t] do # Print("c[", i, "] = ", c[i], ", l[", i, "] = ", l[i][Length(l[i])], ";");
Add(c, c[i]*l[i][Length(l[i])]);
l[i][Length(l[i])] := c[i];
od; if c[Length(c)] <> () then
return false; fi;
l[1][Length(l[1])] := ();
b := []; for i in [1..Length(l)] do
b[i] := Permuted(l[i],(l[i][Length(l[i])])^(-1));
od;
i := 1;
res := true; while res and (i <= Length(b[1])-1) do
v := []; for k in [1..Length(b)] do
Add(v, b[k][i]);
od;
v := ReduceWord(v);
res := IsOneWordContrLocal(v);
i := i+1;
od;
return res; end;
return IsOneWordContrLocal(word); end);
InstallGlobalFunction(AG_IsOneList, function(w, G) if IsList(G[1][1]) then return IsOneWordContr(w, G); else return IsOneWordSelfSim(w, G); fi; end);
InstallGlobalFunction(CONVERT_ASSOCW_TO_LIST, function(w)
local w_list, w_ext, i, j, numstates, cur_gen;
numstates := FamilyObj(w)!.numstates;
w_list := [];
w_ext := ExtRepOfObj(w!.word); for i in [1..Length(w_ext)/2] do if w_ext[2*i] > 0then
cur_gen := w_ext[2*i-1]; else
cur_gen := w_ext[2*i-1]+numstates; fi; for j in [1..AbsInt(w_ext[2*i])] do Add(w_list, cur_gen); od;
od;
return w_list; end);
InstallGlobalFunction(IsOneContr, function(a)
local a_list, a_list_orig, track_l, Gi, i;
a_list_orig := CONVERT_ASSOCW_TO_LIST(a);
Gi := AG_MinimizedAutomatonList(GroupOfAutomFamily(FamilyObj(a)));
track_l := Gi[3];
#a_list := []; #for i in [1..Length(a_list_orig)] do Add(a_list, track_l[a_list_orig[i]]); od;
############################################################################### ## #M AG_IsOneList(w, G) (IsList, IsAutomGroup) ## #InstallGlobalFunction(AG_IsOneList, #function(w, G) # if HasIsContracting(G) and IsContracting(G) and UseContraction(G) then # return IsOneWordContr(w, AG_ContractingTable(G)); # else # return IsOneWordSelfSim(w, AG_MinimizedAutomatonList(G)[1]); # fi; #end);
InstallGlobalFunction(AG_ChooseAutomatonList, function(G) if HasIsContracting(G) and IsContracting(G) and UnderlyingAutomFamily(G)!.use_contraction then
return AG_ContractingTable(G); else
return AG_MinimizedAutomatonList(G)[1]; fi; end);
InstallMethod(AG_OrderOfElement, "for [IsList, IsList, IsCyclotomic]", true,
[IsList, IsList, IsCyclotomic], function(v, G, size)
local w, k;
v := ReduceWord(v);
w := StructuralCopy(v); k := 1; if Length(G[1]) = 3then while (not AG_IsOneList(w, G)) and k < size do
Append(w, w); # Print(w, ";");
k := 2*k;
od; else while (not AG_IsOneList(w, G)) and k < size do
Append(w, v); # Print(w, ";");
k := k+1;
od; fi; if AG_IsOneList(w, G) then return k; else return fail; fi; end);
InstallGlobalFunction(GeneratorActionOnVertex, function(G, g, w)
local i, v, gen, d;
d := Length(G[1])-1;
gen := g; v := []; for i in [1..Length(w)] do
Add(v, (w[i]+1)^G[gen][d+1]-1);
gen := G[gen][w[i]+1];
od;
return v; end);
InstallGlobalFunction(AG_NumberOfVertex, function(w, d)
local i, s;
s := 0; for i in [1..Length(w)] do
s := s+w[i]*d^(Length(w)-i);
od;
return s; end);
InstallGlobalFunction(NumberOfVertex, function(w, d)
local i, s, w_loc;
s := 0; if IsString(w) then
w_loc := List(w, x -> Int(String([x]))-1); else
w_loc := List(w, x -> x-1); fi; for i in w_loc do if i < 0 or i >= d then
Error("received string ", w, " does not represent a valid vertex"); fi;
od; for i in [1..Length(w)] do
s := s+w_loc[i]*d^(Length(w)-i);
od;
return s+1; end);
InstallGlobalFunction(AG_VertexNumber, function(k, n, d)
local i, l, l1, t;
t := k; l := []; while t > 0do
Add(l, t mod d);
t := (t-(t mod d))/d;
od; for i in [Length(l)+1..n] do Add(l, 0); od;
l1 := []; for i in [1..n] do l1[i] := l[n-i+1]; od;
return l1; end);
InstallGlobalFunction(VertexNumber, function(k, n, d)
local i, l, l1, t;
t := k-1; l := []; while t > 0do
Add(l, t mod d);
t := (t-(t mod d))/d;
od; for i in [Length(l)+1..n] do Add(l, 0); od;
l1 := []; for i in [1..n] do l1[i] := l[n-i+1]; od;
return List(l1, x -> x+1); end);
InstallGlobalFunction(GeneratorActionOnLevel, function(G, g, n)
local l, d, i, s, v, w, k;
s := (); d := Length(G[1])-1;
l := []; for i in [1..d^n] do Add(l, 0); od;
i := 0; while i < d^n do
k := 0; while l[k+1] > 0do
k := k+1;
od;
w := AG_VertexNumber(k, n, d);
v := StructuralCopy(w);
i := i+1;
repeat
l[AG_NumberOfVertex(v, d)+1] := 1;
v := GeneratorActionOnVertex(G, g, v); if v <> w then
s := s*(k+1, AG_NumberOfVertex(v, d)+1);
i := i+1; fi;
until v = w;
od;
return s; end);
InstallGlobalFunction(PermActionOnLevel, function(perm, big_lev, sm_lev, deg)
local l, i;
l := []; for i in [0..deg^sm_lev-1] do
Add(l, Int(((1+i*deg^(big_lev-sm_lev))^perm-1)/(deg^(big_lev-sm_lev)))+1);
od;
return PermList(l); end);
InstallGlobalFunction(WordActionOnLevel, function(G, w, n)
local gen, perm;
perm := (); for gen in w do
perm := perm*GeneratorActionOnLevel(G, gen, n);
od;
return perm; end);
InstallGlobalFunction(AG_GeneratorActionOnLevelAsMatrix, function(G, g, n)
local perm, i, j, m, d;
perm := GeneratorActionOnLevel(G, g, n);
d := Length(G[1])-1;
m := List([1..d^n], x -> List([1..d^n], x -> 0)); for i in [1..d^n] do
m[i][i^perm] := 1;
od;
return m; end);
InstallGlobalFunction(PermOnLevelAsMatrix, function(g, lev)
local perm, i, j, m, d;
perm := PermOnLevel(g, lev);
d := g!.deg;
m := List([1..d^lev], x -> List([1..d^lev], x -> 0)); for i in [1..d^lev] do
m[i][i^perm] := 1;
od;
return m; end);
InstallGlobalFunction(TransformationOnLevelAsMatrix, function(g, lev)
local trans, i, j, m, d;
trans := TransformationOnLevel(g, lev);
d := DegreeOfTransformation(trans);
m := List([1..d], x -> List([1..d], x -> 0)); for i in [1..d] do
m[i][i^trans] := 1;
od;
return m; end);
InstallGlobalFunction(InvestigatePairs, function(G)
local i, j, k, i1, j1, k1, Pairs, Trip, n, IsPairEq, d, res, tmp;
IsPairEq := function(i, j, k) # ij = k?
local t, res; if (not IsList(Pairs[i][j])) or (IsList(Pairs[i][j])
and (Pairs[i][j][1] <> k)) then if (not IsList(Pairs[i][j])) and (Pairs[i][j] <> -1) then if Pairs[i][j] = k then return true; else return false; fi; fi; if IsList(Pairs[i][j]) then if Length(Pairs[i][j]) = 1then
Trip[i][j][Pairs[i][j][1]] := 0; else
Trip[i1][j1][k1] := 0;
return true; fi; fi; if Trip[i][j][k] = 0then return false; else if G[i][d+1]*G[j][d+1] <> G[k][d+1] then
Trip[i][j][k] := 0;
return false; fi;
Pairs[i][j] := [k];
t := 1; res := true; while res and (t <= d) do # Print("i = ", i, ", j = ", j, ", k = ", k, ", t = ", t, "; ");
res := IsPairEq(G[i][t], G[j][t^G[i][d+1]], G[k][t]);
t := t+1;
od; if res then if Trip[i][j][k] <> 0then
Pairs[i][j] := [k, 1];
return true; else
Pairs[i][j] := -1;
return false; fi; else
Trip[i][j][k] := 0;
Pairs[i][j] := -1;
return false; fi; fi; else
return true; fi; end;
Pairs := [[]]; Trip := [];
n := Length(G);
d := Length(G[1])-1; for j in [1..n] do Add(Pairs[1], j); od; for i in [2..n] do
Add(Pairs, [i]);
Trip[i] := []; for j in [2..n] do
Pairs[i][j] := -1;
Trip[i][j] := []; for k in [1..n] do Trip[i][j][k] := -1; od;
od;
od; # Print(Pairs); # Print(Trip); for i1 in [2..n] dofor j1 in [2..n] do if Pairs[i1][j1] = -1then
k1 := 1; res := false; while (not res) and (k1 <= n) do
res := IsPairEq(i1, j1, k1); # Print(Pairs, "\n"); for i in [2..n] dofor j in [2..n] do if IsList(Pairs[i][j]) then if res then Pairs[i][j] := Pairs[i][j][1]; else Pairs[i][j] := -1; fi; fi;
od; od;
k1 := k1+1;
od; if Pairs[i1][j1] = -1then Pairs[i1][j1] := 0; fi; fi;
od; od;
return Pairs; end);
InstallMethod(ContractingLevel, "for [IsAutomGroup]", [IsAutomGroup], function(H) if not HasIsContracting(H) then
Info(InfoAutomGrp, 1, "If < H > is not contracting, the algorithm will never stop"); fi;
FindNucleus(H,false);
return ContractingLevel(H); end);
InstallMethod(AG_ContractingTable, "for [IsAutomGroup]", [IsAutomGroup], function(H)
local AG_ContractingTableLocal;
AG_ContractingTableLocal := function(G)
local lev, n, d, i, j, ContractingPair, Pairs, ContTable;
ContractingPair := function(i, j)
local l, k, t, PairAct, TmpList, g1, g2; if Pairs[i][j] <> 0then PairAct := [Pairs[i][j]]; else PairAct := [[i, j]]; fi; for l in [1..lev] do
TmpList := []; for t in [1..Length(PairAct)] do if not IsList(PairAct[t]) then for k in [1..d] do Add(TmpList, G[PairAct[t]][k]); od; else for k in [1..d] do
g1 := G[PairAct[t][1]][k];
g2 := G[PairAct[t][2]][k^G[PairAct[t][1]][d+1]]; if Pairs[g1][g2] <> 0then Add(TmpList, Pairs[g1][g2]); else Add(TmpList, [g1, g2]); fi;
od; fi;
od;
PairAct := StructuralCopy(TmpList);
od;
Add(PairAct, GeneratorActionOnLevel(G, i, lev)*GeneratorActionOnLevel(G, j, lev));
return PairAct; end;
lev := ContractingLevel(H);
Pairs := InvestigatePairs(G);
n := Length(G);
d := Length(G[1])-1;
ContTable := []; for i in [1..n] do
Add(ContTable, []); for j in [1..n] do Add(ContTable[i], ContractingPair(i, j)); od;
od;
return ContTable; end; ################ AG_ContractingTable itself #################################
if not HasIsContracting(H) then
Info(InfoAutomGrp, 1, "If < H > is not contracting, the algorithm will never stop"); fi;
return AG_ContractingTableLocal(AG_GeneratingSetWithNucleusAutom(H)); end);
InstallMethod(ContractingTable, "for [IsAutomGroup]", [IsAutomGroup], function(H)
local T, i, j, k, deg, numstates;
T := StructuralCopy(AG_ContractingTable(H));
deg := Length(T[1][1])-1;
numstates := Length(T); for i in [1..numstates] do for j in [1..numstates] do for k in [1..deg] do
T[i][j][k] := GeneratingSetWithNucleus(H)[T[i][j][k]];
od;
T[i][j] := TreeAutomorphism(T[i][j]{[1..deg]} , T[i][j][deg+1]);
od;
od;
return T; end);
# The base of the code of the function below below was written by Andriy Russev
InstallGlobalFunction(AG_MinimizationOfAutomatonListTrack, function(A)
local n, perms, m, classes, states, list, i, j, ids, temp, s, d, new_as_old, old_as_new, aut_list, perm, state;
n := Length(A);
d:=Length(A[1])-1;
perms := SSortedList(List(A,x->x[d+1])); # In the minimization process the set of states is partitioned into classes
m := Length(perms); # number of states of automaton A
# "classes" contains classes of states. To each state of automaton A we assign an number from 1 to m # (the first element in the list; if the class is not "finished", we add n)
classes := List([1..n], x -> [Position(perms, A[x][d+1])]); # Canonical representatives of classes of states
states := [];
# The list of states of A that have not been classified yet
list := [1..n];
# At this moment all the states that belong to the same class act identically # on words of length 1. During each iteration, classes consist of states that # act identically on the words of length k will be partitioned into smalled # subclasses of states that act identically on words of length k+1. # If no class was partitioned during an iteration, then all the states in # each class are equivalent and act identically on words of arbitrary length. # This is the end of minimization procedure while true do # states from each class act identically on all words of length k. for i in list do # Define classes for the states of the first level
classes[i][2] := List(A[i]{[1..d]}, x -> classes[x][1]);
od;
# the extended identifier of a class contains information about the action # of this state, and of its first level states on words of length k. # I.e., it describes the action of the state on words of the length k+1. # If extended identifiers of states coincide, then these states act # identically on words of length k+1. # Update the identifiers of classes; save to "temp" the list of classes # that contain one state
ids := [];
temp := [];
s := Length(states); for i in list do
j := Position(ids, classes[i]); if j = fail then
Add(ids, ShallowCopy(classes[i]));
j := Length(ids);
temp[j] := i; else
Unbind(temp[j]); fi;
classes[i][1] := s + j + n;
od; # Check if new classes created during the iteration if s + Length(ids) = m then break; fi;
m := s + Length(ids); # Find canonical representatives of classes that contain only a single state of A
temp := Compacted(temp); for i in temp do
s := s + 1;
classes[i][1] := s;
states[s] := i;
od; # remove all classes with one state from future iterations.
SubtractSet(list, temp);
od; # Find canonical representatives of the remaining classes
ids := []; for i in list do
classes[i][1] := classes[i][1] - n;
j := Position(ids, classes[i]); if j = fail then
Add(ids, classes[i]);
states[classes[i][1]] := i; fi;
od;
aut_list:=List(states,
x -> Flat([List(A[x]{[1..d]}, y -> classes[y][1]),
A[x][d+1]]));
old_as_new:=List(classes,c->c[1]);
new_as_old:=List([1..Length(states)],x->Position(old_as_new,x));
#Now sort the new list in the same order as the old states
perm:=Sortex(new_as_old);
aut_list:=Permuted(aut_list,perm); for state in aut_list do for i in [1..d] do
state[i]:=state[i]^perm;
od;
od;
InstallGlobalFunction(AG_AddInversesListTrack, function(H)
local d, n, G, idEl, st, i, perm, inv, minimized_autlist;
## track_s - new generators in terms of old ones ## track_l - old generators in terms of new ones
d := Length(H[1])-1;
n := Length(H); if n < 1 or d < 1then return fail; fi;
idEl := Flat([List([1..d],x->1),()]);
G := [idEl]; for i in [1..n] do Add(G, StructuralCopy(H[i])); od;
for st in [2..n+1] do for i in [1..d] do G[st][i] := G[st][i]+1; od;
od;
for st in [2..n+1] do
inv := [];
perm := G[st][d+1]^(-1); for i in [1..d] do Add(inv, G[st][i^perm]+n); od;
Add(inv, perm);
Add(G, inv);
od; # return AG_MinimizationOfAutomatonListTrack(G, [0..Length(G)-1], [2..Length(G)]);
minimized_autlist := AG_MinimizationOfAutomatonListTrack(G);
return [minimized_autlist[1], List(minimized_autlist[2],x->x-1), minimized_autlist[3]{[2..Length(minimized_autlist[3])]}]; end);
InstallMethod(UseContraction, "for [IsAutomGroup]", true,
[IsAutomGroup], function(G)
local H;
H := GroupOfAutomFamily(UnderlyingAutomFamily(G));
if not HasIsContracting(H) then
Print("Error in UseContraction(<G>): It is not known whether the group of family is contracting\n");
return fail; elif not IsContracting(H) then
Print("Error in UseContraction(<G>): The group of family is not contracting");
return fail; fi;
# IsContracting returns either true or false or an error (it can not return fail)
UnderlyingAutomFamily(G)!.use_contraction := true;
return true; end);
# DoesPairContract := function(i, j, lev) # local t, res; # if lev > maxlev then maxlev := lev; fi; # # # ContPairs[i][j] may take the following values: # # -1 - [i, j] was not met before # # 1 - [i, j] contracts # # 2 - [i, j] was met above in the tree # # if (ContPairs[i][j] = 1) then return true; fi; # if Pairs[i][j] <> 0 then # ContPairs[i][j] := 1; # return true; # fi; # # if we've seen this pair before it needs to be in the nucleus # if ContPairs[i][j] = 2 then return [i, j]; fi; # t := 1; res := true; # ContPairs[i][j] := 2; # while res = true and (t <= d) do # res := DoesPairContract(G[i][t], G[j][t^G[i][d+1]], lev+1); # t := t+1; # od; # if res = true then # ContPairs[i][j] := 1; # return true; # else return res; # fi; # end;
DoesPairContract := function(i, j, lev)
local t, res, localmaxlev; if lev > maxlev then maxlev := lev; fi;
# ContPairs[i][j] may take the following values: # -1 - [i, j] was not met before # [k] - [i, j] contracts on level k # 2 - [i, j] was met above in the tree
if IsList(ContPairs[i][j]) then if lev+ContPairs[i][j][1] > maxlev then maxlev := lev+ContPairs[i][j][1]; fi;
return true; fi; if Pairs[i][j] <> 0then
ContPairs[i][j] := [0];
return true; fi; if ContPairs[i][j] = 2then return [i,j]; fi;
t := 1; res := true;
ContPairs[i][j] := 2;
localmaxlev := 0; while res = true and (t <= d) do
res := DoesPairContract(G[i][t], G[j][t^G[i][d+1]], lev+1); if res = true then if ContPairs[G[i][t]][G[j][t^G[i][d+1]]][1]+1 > localmaxlev then
localmaxlev := ContPairs[G[i][t]][G[j][t^G[i][d+1]]][1]+1; fi; fi;
t := t+1;
od; if res = true then
ContPairs[i][j] := [localmaxlev];
return true; else return res; fi; end;
AddPairs := function(i, j)
local tmp, l, CurNum; if Pairs[i][j] > 0then return Pairs[i][j]; fi;
Pairs[i][j] := num;
CurNum := num;
Add(PairsToAdd, []);
num := num+1;
tmp := []; for l in [1..d] do
Add(tmp, AddPairs(G[i][l], G[j][l^G[i][d+1]]));
od;
Add(tmp, G[i][d+1]*G[j][d+1]);
Append(PairsToAdd[CurNum-n], tmp);
AssocWPairsToAdd[CurNum-n] := cur_nucl[i]*cur_nucl[j];
return CurNum; end;
IsElemInNucleus := function(g)
local i, res; if g in tmp then for i in [Position(tmp, g)..Length(tmp)] do if not (tmp[i] in Nucl) then Add(Nucl, tmp[i]); fi;
od;
return g = tmp[1]; fi;
Add(tmp, g);
res := false; i := 1; while (not res) and i <= d do
res := IsElemInNucleus(G[g][i]);
i := i+1;
od;
Remove(tmp);
return res; end;
if HasIsContracting(H) and not IsContracting(H) then
return fail; fi;
automgens := UnderlyingAutomFamily(H)!.automgens;
d := UnderlyingAutomFamily(H)!.deg;
cur_nucl := [One(UnderlyingAutomFamily(H))];
Hi := StructuralCopy(AG_MinimizedAutomatonList(H)); # Print("Gi = ", Gi, "\n");
G := Hi[1];
track_s := Hi[2];
track_l := Hi[3];
for i in [2..Length(track_s)] do Add(cur_nucl, automgens[track_s[i]]); od;
found := false;
while (not found) and Length(G) < max_nucl do
res := true; maxlev := 0; ContPairs := [];
Pairs := InvestigatePairs(G);
n := Length(G); # Print("n = ", n, "\n"); if print_info = true then
Print("Trying generating set with ", n, " elements\n"); else
Info(InfoAutomGrp, 3, "Trying generating set with ", n, " elements"); fi; # for i in [1..n] do # Add(ContPairs, [1]); # for j in [1..n-1] do # if i = 1 then Add(ContPairs[i], 1); # else Add(ContPairs[i], -1); # fi; # od; # od;
for i in [1..n] do
Add(ContPairs, [[0]]); for j in [1..n-1] do if i = 1then Add(ContPairs[i], [0]); else Add(ContPairs[i], -1); fi;
od;
od;
i := 1;
while res = true and (i <= n) do
j := 1; while res = true and (j <= n) do #Print("i = ", i, ", j = ", j, "\n"); if ContPairs[i][j] = -1then res := DoesPairContract(i, j, 0); fi; if res <> true then
PairsToAdd := [];
AssocWPairsToAdd := []; # num represents current number of generators
num := n+1;
AssocWPairsToAdd := [];
AddPairs(res[1], res[2]); if print_info = true then
Print("Elements added:", List(AssocWPairsToAdd, x -> x!.word), "\n"); else
Info(InfoAutomGrp, 3, "Elements added:", List(AssocWPairsToAdd, x -> x!.word)); fi;
Append(G, PairsToAdd); # Print("G = ", G, "\n");
Append(cur_nucl, AssocWPairsToAdd);
G_track := AG_AddInversesListTrack(G); # Print("G_track = ", G_track, "\n");
G := G_track[1];
cur_nucl_tmp := [];
cur_nucl_tmp := [One(UnderlyingAutomFamily(H))];
cur_nucl_length := Length(cur_nucl); for i in [2..Length(G_track[2])] do if G_track[2][i] <= cur_nucl_length then
Add(cur_nucl_tmp, cur_nucl[G_track[2][i]]); else
Add(cur_nucl_tmp, cur_nucl[G_track[2][i]-cur_nucl_length]^-1); fi;
od;
cur_nucl := StructuralCopy(cur_nucl_tmp); fi;
j := j+1;
od;
i := i+1;
od; if res = true then
found := true; fi;
od;
if not found then return fail; fi;
Nucl := []; # first add elements of cycles for i in [1..Length(G)] do
tmp := []; if not (i in Nucl) then IsElemInNucleus(i); fi;
od;
# now add sections of elements for g in Nucl do for i in [1..d] do if not (G[g][i] in Nucl) then
Add(Nucl, G[g][i]); fi;
od;
od; # Print("Nucleus:", Nucl, "\n");
nucl_final := []; for i in Nucl do Add(nucl_final, cur_nucl[i]); od;
InstallMethod(IsContracting, "for [IsAutomGroup]", true,
[IsAutomGroup], function(G)
local res; if IsSelfSimilar(G) = false then
Info(InfoAutomGrp, 3, "The group <G> is not self-similar, so it is not contracting");
return false; elif not IsAutomatonGroup(G) then
Print("Represent <G> as a group generated by finite automaton\n");
return fail; fi; if FindNucleus(G, 50, false) <> fail then return true; fi; if IsNoncontracting(G, 10, 10) = true then return false; fi;
Info(InfoAutomGrp, 3, "You can try FindNucleus( <G>, <max_nucl> ) or");
Info(InfoAutomGrp, 3, " IsNoncontracting( <G>, <lengh>, <depth> ) with bigger bounds");
TryNextMethod(); end);
InstallGlobalFunction(InversePerm, function(G)
local i, j, viewed, inv, found;
viewed := []; inv := (); for i in [1..Length(G)] do if not (i in viewed) then
j := 1; found := false; while j <= Length(G) and not found do #Print("[", i, ", ", j, "]\n"); if AG_IsOneList([i, j], G) then
found := true; if i <> j then
inv := inv*(i, j);
Append(viewed, [i, j]); else
Add(viewed, i); fi; fi;
j := j+1;
od; fi;
od;
return inv; end);
PortraitIter := function(v, lev, plist)
local i, j, tmpv, sigma; for i in [1..Length(G)] do
tmpv := StructuralCopy(v);
Add(tmpv, i); if AG_IsOneList(tmpv, G) then
Add(bndry, [lev, nucl[i^inv]]);
Add(plist, nucl[i^inv]);
return; fi;
od;
for i in [1..d] do
tmpv := []; sigma := (); for j in v do
Add(tmpv, G[j][i^sigma]);
sigma := sigma*G[j][d+1];
od; if i = 1then Add(plist, sigma);fi;
Add(plist, []);
PortraitIter(tmpv, lev+1, plist[i+1]);
od; end;
d := w!.deg;
G := AG_GeneratingSetWithNucleusAutom(GroupOfAutomFamily(FamilyObj(w)));
nucl := GeneratingSetWithNucleus(GroupOfAutomFamily(FamilyObj(w)));
Gi := AG_MinimizedAutomatonList(GroupOfAutomFamily(FamilyObj(w)));
track_l := Gi[3];
w_list_orig := CONVERT_ASSOCW_TO_LIST(w);
w_list := List(w_list_orig, i -> track_l[i]);
InstallGlobalFunction(AutomPortraitDepth, function(w)
local bndry;
return Maximum(List(AG_AutomPortraitMain(w)[2], x -> x[1])); end);
################################################################################ ## #F WritePortraitToFile. . . . . . . . . . .Writes portrait in a file in the form ## understandable by Maple
# InstallGlobalFunction(WritePortraitToFile, function(p, file, add) # local WritePerm, l; # # WritePerm := function(perm) # local j; # AppendTo(file, "[ "); # if Length(perm) > 0 then # AppendTo(file, "`", perm[1], "`"); # for j in [2..Length(perm)] do # AppendTo(file, ", "); # WritePerm(perm[j]); # od; # fi; # AppendTo(file, " ]"); # end; # # # l := [p[1], List(p[2], x -> [x[1], x[2]!.word])]; # if add then AppendTo(file, "[ ", l[1], ", "); # else PrintTo(file, "[ ", l[2], ", "); # fi; # WritePerm(p[3]); # AppendTo(file, " ]"); # end);
################################################################################ ## #F WritePortraitsToFile. . . . . . . . . . . . .Writes portraitso of elements of ## a list in a file in the form understandable by Maple
# InstallGlobalFunction(WritePortraitsToFile, function(lst, G, file, add) # local WritePerm, i, p; # # if add then AppendTo(file, "[ "); # else PrintTo(file, "[ "); # fi; # # for i in [1..Length(lst)] do # if i = 1 then # AppendTo(file, "[ ", lst[i], ", "); # else # AppendTo(file, ", [ ", lst[i], ", "); # fi; # p := AutomPortrait(lst[i], G); # WritePortraitToFile(p, file, true); # AppendTo(file, "]"); # # od; # end);
# produce a symmetric generating set
orig_gens := ShallowCopy(GeneratorsOfGroup(G));
Append(orig_gens, List(orig_gens, x -> x^-1));
gens := [];
# select pairwise different generators for i in [1..Length(orig_gens)] do if not IsOne(orig_gens[i]) then
new_gen := true; for j in [1..i-1] doif orig_gens[i] = orig_gens[j] then new_gen := false; fi; od; if new_gen then Add(gens, orig_gens[i]); fi; fi;
od;
while len < max_len and GrList[len] <> GrList[len+1] do for i in [GrList[len]+1..GrList[len+1]] do
oldgr := Length(ElList); for gen in gens do
g := ElList[i]*gen;
New := true; if len = 1then k := 1; else k := GrList[len-1]; fi; while New and k <= oldgr do if g = ElList[k] then New := false; fi;
k := k+1;
od; if New then Add(ElList, g); fi;
od;
od;
Add(GrList, Length(ElList));
Print("There are ", Length(ElList), " elements of length up to ", len+1, "\n");
len := len+1;
od; if GrList[len] = GrList[len+1] then
SetSize(G, GrList[len]); fi;
return GrList; end);
InstallMethod(Growth, "for [IsTreeHomomorphismSemigroup, IsCyclotomic]", true,
[IsTreeHomomorphismSemigroup, IsCyclotomic], function(G, max_len)
local iter, g, i;
iter := Iterator(G, max_len); for g in iter do od;
return List(iter!.levels, x -> x[Length(x)]); end);
inverse := function(w)
local i, iw;
iw := []; for i in [1..Length(w)] do
iw[i] := w[Length(w)-i+1]^inv;
od;
return iw; end;
ProductEls := function(i, j)
local t, v, tmpv;
v := StructuralCopy(ElList[i]);
Append(v, ElList[j]); for t in [1..Length(ElList)] do
tmpv := StructuralCopy(v);
Append(tmpv, inverse(ElList[t])); if AG_IsOneList(tmpv, G) then return t; fi;
od; end;
LongCycle := function(n)
local l, i;
l := []; for i in [2..n] do Add(l, i); od;
Add(l, 1);
return PermList(l); end;
IsNewRel := function(v)
local tmp, i, j, cyc, cycr, v_cyc, r_cyc, r, r_cyc_inv;
cyc := LongCycle(Length(v)); for i in [0..Length(v)-1] do
v_cyc := Permuted(v, cyc^i); if v_cyc[1] = v_cyc[Length(v)]^inv then return false; fi; for r in rels do
cycr := LongCycle(Length(r)); for j in [0..Length(r)-1] do
r_cyc := Permuted(r, cycr^j);
r_cyc_inv := inverse(Permuted(r, cycr^j)); if PositionSublist(v_cyc, r_cyc) <> fail or PositionSublist(v_cyc, r_cyc_inv) <> fail then
return false; fi;
od;
od;
od;
return true; end;
####################### _FiniteGroupId itself #########################################
gr := 1; len := 1;
G := AG_ChooseAutomatonList(H);
inv := InversePerm(G); if not HasIsFinite(H) then
Info(InfoAutomGrp, 2, "warning, if < H > is infinite the algorithm will never stop"); fi;
GrList := [1, Length(G)];
ElList := []; rels := []; for i in [1..Length(G)] do
Add(ElList, [i]);
od; while GrList[len+1] > GrList[len] and GrList[len+1] < size do for i in [GrList[len]+1..GrList[len+1]] do
oldgr := Length(ElList); for j in [2..Length(G)] do
v := StructuralCopy(ElList[i]); if j <> v[Length(v)]^inv then
Add(v, j);
New := true; if len = 1then k := 1; else k := GrList[len-1]+1; fi; while New and k <= oldgr do
tmpv := StructuralCopy(v);
Append(tmpv, inverse(ElList[k])); if AG_IsOneList(tmpv, G) then
New := false; ## show relations if IsNewRel(tmpv) then
Add(rels, tmpv); # Info(InfoAutomGrp, 3, v, "*", ElList[k], "^(-1) = 1"); # Print(tmpv, "\n"); fi; fi;
k := k+1;
od; if New then Add(ElList, v); fi; fi;
od;
od;
Add(GrList, Length(ElList));
Info(InfoAutomGrp, 3, "There are ", Length(ElList), " elements of length up to ", len+1);
len := len+1;
od;
if GrList[len+1] > GrList[len] then return fail; fi;
SetSize(H, GrList[len]);
# in case of finite group construct Cayley table
FinG := []; for i in [2..UnderlyingAutomFamily(H)!.numstates+1] do
act := ();
tmpl := []; while Length(tmpl) < Length(ElList) do
j := 1; while j in tmpl do j := j+1; od;
Add(tmpl, j);
push := ProductEls(j, i); while push <> j do
Add(tmpl, push);
act := act*(j, push);
push := ProductEls(push, i);
od;
od;
Add(FinG, act);
od;
ProductEls := function(i, j)
local t; for t in [1..Length(ElList)] do if IsOne(ElList[i]*ElList[j]*ElList[t]^-1) then return t; fi;
od;
return fail; end;
while len < n and GrList[len] <> GrList[len+1] do for i in [GrList[len]+1..GrList[len+1]] do
oldgr := Length(ElList); for gen in gens do
g := ElList[i]*gen; # Print("g = ", g, "\n\n");
New := true; if len = 1then k := 1; else k := GrList[len-1]; fi; while New and k <= oldgr do # Print(g*ElList[k]^-1, "\n"); if IsOne(g*ElList[k]^-1) then New := false; fi;
k := k+1;
od; if New then Add(ElList, g); fi;
od;
od;
Add(GrList, Length(ElList));
Info(InfoAutomGrp, 3, "There are ", Length(ElList), " elements of length up to ", len+1);
len := len+1;
od;
if GrList[len] <> GrList[len+1] then return fail; fi;
SetSize(G, GrList[len]);
# in case of finite group construct Cayley table
FinG := []; for i in [2..num_diff_gens+1] do
act := ();
tmpl := []; while Length(tmpl) < Length(ElList) do
j := 1; while j in tmpl do j := j+1; od;
Add(tmpl, j);
push := ProductEls(j, i); while push <> j do
Add(tmpl, push);
act := act*(j, push);
push := ProductEls(push, i);
od;
od;
Add(FinG, act);
od;
# switch to the original generating set
old_gens := []; for i in [1..num_orig_gens] do if track_l[i] = 0then
old_gens[i] := (); else
old_gens[i] := FinG[track_l[i]]; fi;
od;
return GroupWithGenerators(old_gens); end);
InstallGlobalFunction(AG_IsOneWordSubs, function(w, subs, G)
local i, v;
v := []; for i in w do Append(v, subs[i]); od;
return AG_IsOneList(v, G); end);
inverse := function(w)
local i, iw;
iw := []; for i in [1..Length(w)] do
iw[i] := w[Length(w)-i+1]^inv;
od;
return iw; end;
inverseS := function(w)
local i, iw;
iw := []; for i in [1..Length(w)] do
iw[i] := w[Length(w)-i+1]^invs;
od;
return iw; end;
ProductEls := function(i, j)
local t, v, tmpv;
v := StructuralCopy(ElList[i]);
Append(v, ElList[j]); for t in [1..Length(ElList)] do
tmpv := StructuralCopy(v);
Append(tmpv, inverse(ElList[t])); if AG_IsOneList(tmpv, G) then return t; fi;
od; end;
LongCycle := function(n)
local l, i;
l := []; for i in [2..n] do Add(l, i); od;
Add(l, 1);
return PermList(l); end;
IsNewRelS := function(v)
local tmp, i, j, cyc, cycr, v_cyc, r_cyc, r, r_cyc_inv;
cyc := LongCycle(Length(v)); for i in [0..Length(v)-1] do
v_cyc := Permuted(v, cyc^i); if v_cyc[1] = v_cyc[Length(v)]^invs then return false; fi; for r in rels do
cycr := LongCycle(Length(r)); for j in [0..Length(r)-1] do
r_cyc := Permuted(r, cycr^j){[1..Int(Length(r)/2)+1]};
r_cyc_inv := inverseS(Permuted(r, cycr^j)){[1..Int(Length(r)/2)+1]}; if PositionSublist(v_cyc, r_cyc) <> fail or PositionSublist(v_cyc, r_cyc_inv) <> fail then
return false; fi;
od;
od;
od;
return true; end; #************************ FindGroupRelationsSubsLocal itself ****************************************************
rels := []; # G := GroupOfAutomFamily(FamilyObj(subs_words[1]));
inv := InversePerm(G); #check if there are any identity elements in subs list for i in [1..Length(subs)] do if AG_IsOneList(subs[i], G) then
Error(AssocW([i]), " = id, remove this element from a list and try again"); fi;
od;
AssocWrels := [];
#check if there are any equal elements in subs list
invslist := []; for i in [1..Length(subs)] do for j in [i..Length(subs)] do if i <> j and AG_IsOneList(Concatenation(subs[i], inverse(subs[j])), G) then
Error(AssocW([i]), " = ", AssocW([j]), ", remove one of these elements from a list and try again"); fi;
# add inverses to subs list
origlength := Length(subs);
invadded := false; for i in [1..origlength] do if not IsBound(invslist[i]) then
invadded := true;
Add(subs, inverse(subs[i]));
Add(gens, gens[i]^-1);
invslist[i] := Length(subs);
invslist[Length(subs)] := i; fi;
od;
invs := PermList(invslist);
GrList := [1, Length(subs)+1];
ElList := [];
gr := 1; len := 1;
for i in [1..Length(subs)] do
Add(ElList, [i]);
od; while GrList[len+1] > GrList[len] and len < max_len and Length(rels) < num_of_rels do for i in [GrList[len]..GrList[len+1]-1] do
oldgr := Length(ElList); for j in [1..Length(subs)] do
v := StructuralCopy(ElList[i]); if j <> v[Length(v)]^invs then
Add(v, j);
New := true; # k := 1; if len = 1then k := 1; else k := GrList[len-1]; fi; while New and k <= oldgr do
tmpv := StructuralCopy(v);
Append(tmpv, inverseS(ElList[k])); if AG_IsOneWordSubs(tmpv, subs, G) then
New := false; ## show relations if IsNewRelS(tmpv) then
Add(rels, tmpv); if Length(AssocW(tmpv)) > 0then
Add(AssocWrels, AssocW(tmpv));
Print(AssocW(tmpv), "\n"); fi; fi; fi;
k := k+1;
od; if New then Add(ElList, v); fi; fi;
od;
od;
Add(GrList, Length(ElList)+1); # Print("ElList[", len, "] = ", ElList, "\n");
Info(InfoAutomGrp,3,"There are ", Length(ElList) + 1, " elements of length up to ", len+1);
len := len+1;
od;
return AssocWrels; end;
if Length(subs_words) <> Length(names) then
Error("The number of names must coincide with the number of generators"); fi;
F := FreeGroup(names);
G := GroupOfAutomFamily(FamilyObj(subs_words[1]));
# gens is a mutable list of generators
gens := ShallowCopy(GeneratorsOfGroup(F));
#convert associative words into lists
subs1 := List(subs_words, CONVERT_ASSOCW_TO_LIST);
Gi := StructuralCopy(AG_MinimizedAutomatonList(G)); # Print("Gi = ", Gi, "\n");
H := Gi[1];
track_s := Gi[2];
track_l := Gi[3];
subs := [];
for w in subs1 do
w_list := []; for i in [1..Length(w)] do Add(w_list, track_l[w[i]]); od;
Add(subs, ShallowCopy(w_list));
od;
rels0 := [];
# for k in [1..Length(AutomatonList(G))] do # Print("Beam\n"); # if track_l[k] = 1 then Add(rels0, AssocW([k])); # elif track_s[track_l[k]] <> k then Add(rels0, AssocW([k, track_s[track_l[k]]+Length(AutomatonList(G))])); # fi; # od;
rels := FindGroupRelationsSubsLocal(subs, AG_ChooseAutomatonList(G)); if rels = fail then return fail; fi;
Append(rels0, rels); # Print(rels0);
return rels0; end);
inverse := function(w)
local i, iw;
iw := []; for i in [1..Length(w)] do
iw[i] := w[Length(w)-i+1]^inv;
od;
return iw; end;
inverseS := function(w)
local i, iw;
iw := []; for i in [1..Length(w)] do
iw[i] := w[Length(w)-i+1]^invs;
od;
return iw; end;
ProductEls := function(i, j)
local t, v, tmpv;
v := StructuralCopy(ElList[i]);
Append(v, ElList[j]); for t in [1..Length(ElList)] do
tmpv := StructuralCopy(v);
Append(tmpv, inverse(ElList[t])); if AG_IsOneList(tmpv, G) then return t; fi;
od; end;
LongCycle := function(n)
local l, i;
l := [2..n];
Add(l, 1);
return PermList(l); end;
IsNewRelS := function(v)
local tmp, i, j, cyc, cycr, v_cyc, r_cyc, r, r_cyc_inv;
cyc := LongCycle(Length(v)); for i in [0..Length(v)-1] do
v_cyc := Permuted(v, cyc^i); if v_cyc[1] = v_cyc[Length(v)]^invs then return false; fi; for r in rels do
cycr := LongCycle(Length(r)); for j in [0..Length(r)-1] do
r_cyc := Permuted(r, cycr^j){[1..Int(Length(r)/2)+1]};;
r_cyc_inv := inverseS(Permuted(r, cycr^j)){[1..Int(Length(r)/2)+1]};; if PositionSublist(v_cyc, r_cyc) <> fail or PositionSublist(v_cyc, r_cyc_inv) <> fail then
return false; fi;
od;
od;
od;
return true; end; #************************ FindGroupRelationsLocal itself ****************************************************
invslist := []; for i in [1..Length(subs)] do for j in [i..Length(subs)] do # Print(AssocW([Gi[2][i+1], Gi[2][j+1]])!.word, "\n"); if AG_IsOneList(Concatenation(subs[i], subs[j]), G) then
invslist[i] := j; invslist[j] := i; if Length(AssocW([Gi[2][i+1], Gi[2][j+1]])!.word) > 0then
Add(rels, [i, j]);
Add(AssocWrels, AssocW([Gi[2][i+1], Gi[2][j+1]]));
Print( AssocW([Gi[2][i+1], Gi[2][j+1]])!.word, "\n"); fi; fi;
od;
od;
invs := PermList(invslist);
GrList := [1, Length(subs)+1];
ElList := [];
gr := 1; len := 1;
for i in [1..Length(subs)] do
Add(ElList, [i]);
od; while GrList[len+1] > GrList[len] and len < max_len and Length(rels) < num_of_rels do for i in [GrList[len]..GrList[len+1]-1] do
oldgr := Length(ElList); for j in [1..Length(subs)] do
v := StructuralCopy(ElList[i]); if j <> v[Length(v)]^invs then
Add(v, j);
New := true; # k := 1; if len = 1then k := 1; else k := GrList[len-1]; fi; while New and k <= oldgr do
tmpv := StructuralCopy(v);
Append(tmpv, inverseS(ElList[k])); if AG_IsOneWordSubs(tmpv, subs, G) then
New := false; ## show relations if IsNewRelS(tmpv) then # tmpv in the original generators
tmpv_orig := []; for k in [1..Length(tmpv)] do
tmpv_orig[k] := Gi[2][tmpv[k]+1];
od;
Add(rels, tmpv); if Length(AssocW(tmpv_orig)!.word) > 0then
Add(AssocWrels, AssocW(tmpv_orig));
Print( AssocW(tmpv_orig)!.word, "\n"); fi; # Print(tmpv, "\n"); fi; fi;
k := k+1;
od; if New then Add(ElList, v); fi; fi;
od;
od;
Add(GrList, Length(ElList)+1); # Print("ElList[", len, "] = ", ElList, "\n");
Info(InfoAutomGrp, 3, "There are ", Length(ElList) + 1, " elements of length up to ", len + 1);
len := len+1;
od;
return AssocWrels; end;
Gi := StructuralCopy(AG_MinimizedAutomatonList(G)); # Print("Gi = ", Gi, "\n");
H := Gi[1];
track_s := Gi[2];
track_l := Gi[3];
rels0 := [];
# for k in [1..Length(AutomatonList(G))] do # Print("Beam\n"); # if track_l[k] = 1 then Add(rels0, AssocW([k])); # elif track_s[track_l[k]] <> k then Add(rels0, AssocW([k, track_s[track_l[k]]+Length(AutomatonList(G))])); # fi; # od;
IsNewRel := function(rel)
local rel1, r;
rel1 := rel;
repeat for r in all_relsF do if PositionWord(rel1, Subword(r,1,Int(Length(r)/2)+1), 1) <> fail then return false; fi;
od;
rel1 := rel1^Subword(rel1, 1, 1);
until rel1 = rel;
return true; end;
# select pairwise different generators for i in [1..Length(orig_gens)] do if not IsOne(orig_gens[i]) then
new_gen := true; for j in [1..i-1] do if orig_gens[i] = orig_gens[j] then
new_gen := false; if IsNewRel(orig_fgens[i]^-1*orig_fgens[j]) then if not IsIdenticalObj(orig_gens[i], orig_gens[j]) then
Add(rels, orig_gens[i]^-1*orig_gens[j]);
Print( orig_gens[i]^-1*orig_gens[j], "\n"); fi;
Add(relsF, orig_fgens[i]^-1*orig_fgens[j]);
Append(all_relsF, CyclicConjugates(orig_fgens[i]^-1*orig_fgens[j])); if i > ngens and j <= ngens then # hom_images[i-ngens] := orig_gens[j+ngens]; # hom_images[j] := orig_gens[i];
FFhom_images[i-ngens] := orig_fgens[j+ngens];
FFhom_images[j] := orig_fgens[i]; fi; fi;
break; fi;
od; if new_gen then
Add(gens, orig_gens[i]);
Add(fgens, orig_fgens[i]); if i <= ngens then
FGhom_images[i] := orig_gens[i]; fi; fi; else if not IsIdenticalObj(orig_gens[i], One(orig_gens[i])) then
Add(rels, orig_gens[i]);
Print( orig_gens[i], "\n"); fi; # # Add(relsF, orig_fgens[i]); fi;
od;
# inv_gens := []; # for i in [1..Length(gens)] do # for j in [1..i] do # if IsOne(gens[i]*gens[j]) then # inv_gens[i] := gens[j]; inv_gens[j] := gens[i]; # fi; # od; # od;
while GrList[len] <> GrList[len+1] and len < max_len and Length(rels) < num_of_rels do for i in [GrList[len]+1..GrList[len+1]] do
oldgr := Length(ElList); for j in [1..Length(gens)] do
f := ElListF[i]*fgens[j]; if Length(f) > Length(ElListF[i]) then
g := ElList[i]*gens[j];
New := true; if len = 1then k := 1; else k := GrList[len-1]; fi; while New and k <= oldgr do if g = ElList[k] then
New := false; fi;
k := k+1;
od; if New then
Add(ElList, g); # Add(ElList_inv, inv_gens[j]*ElList_inv[i]);
Add(ElListF, f); else
new_rel := true;
rel := CyclicallyReducedWord(Image(FFhom, f^-1)*ElListF[k-1]); if Length(rel) < Length(f)+Length(ElListF[k-1]) then new_rel := false; fi;
if new_rel and IsNewRel(rel) and IsNewRel(Image(FFhom, rel^-1)) then # Add(rels, inv_gens[j]*ElList_inv[i]*ElList[k-1]);
cur_rel := Image(FGhom, rel);
Add(rels, cur_rel);
Add(relsF, rel);
Print( cur_rel, "\n");
Append(all_relsF, CyclicConjugates(rel)); fi;
fi; fi;
od;
od;
Add(GrList, Length(ElList));
Info(InfoAutomGrp, 3, "There are ", Length(ElList), " elements of length up to ", len+1);
len := len+1;
od; if GrList[len] = GrList[len+1] then
SetSize(G, GrList[len]); fi;
return rels; end);
IsNewRel := function(rel)
local rel1, r;
rel1 := rel;
repeat for r in all_relsF do if PositionWord(rel1, Subword(r,1,Int(Length(r)/2)+1), 1) <> fail then return false; fi;
od;
rel1 := rel1^Subword(rel1, 1, 1);
until rel1 = rel;
return true; end;
# select pairwise different generators for i in [1..Length(orig_gens)] do if not IsOne(orig_gens[i]) then
new_gen := true; for j in [1..i-1] do if orig_gens[i] = orig_gens[j] then
new_gen := false; if IsNewRel(orig_fgens[i]^-1*orig_fgens[j]) then
Add(relsF, orig_fgens[i]^-1*orig_fgens[j]);
Print(orig_fgens[i]^-1*orig_fgens[j], "\n");
Append(all_relsF, CyclicConjugates(orig_fgens[i]^-1*orig_fgens[j])); if i > ngens and j <= ngens then
FFhom_images[i-ngens] := orig_fgens[j+ngens];
FFhom_images[j] := orig_fgens[i]; fi; fi;
break; fi;
od; if new_gen then
Add(gens, orig_gens[i]);
Add(fgens, orig_fgens[i]); fi; else
Add(relsF, orig_fgens[i]);
Print(orig_fgens[i], "\n"); fi;
od;
while GrList[len] <> GrList[len+1] and len < max_len and Length(relsF) < num_of_rels do for i in [GrList[len]+1..GrList[len+1]] do
oldgr := Length(ElList); for j in [1..Length(gens)] do
f := ElListF[i]*fgens[j]; if Length(f) > Length(ElListF[i]) then
g := ElList[i]*gens[j];
New := true; if len = 1then k := 1; else k := GrList[len-1]; fi; while New and k <= oldgr do if g = ElList[k] then
New := false; fi;
k := k+1;
od; if New then
Add(ElList, g);
Add(ElListF, f); else
new_rel := true;
rel := CyclicallyReducedWord(Image(FFhom, f^-1)*ElListF[k-1]); if Length(rel) < Length(f)+Length(ElListF[k-1]) then new_rel := false; fi;
if new_rel and IsNewRel(rel) and IsNewRel(Image(FFhom, rel^-1)) then
Add(relsF, rel);
Print( rel, "\n");
Append(all_relsF, CyclicConjugates(rel)); fi;
fi; fi;
od;
od;
Add(GrList, Length(ElList));
Info(InfoAutomGrp, 3, "There are ", Length(ElList), " elements of length up to ", len+1);
len := len+1;
od;
return relsF; end);
# InstallMethod(FindSemigroupRelations, "for [IsAutomSemigroup, IsCyclotomic, IsCyclotomic]", true, # [IsAutomSemigroup, IsCyclotomic, IsCyclotomic], # function(G, max_len, num_of_rels) # local ElList, GrList, i, j, orig_gens, gen, gens, new_gen, g, len, oldgr, New, k, has_one, rels, rel; # # orig_gens := ShallowCopy(GeneratorsOfSemigroup(G)); # # gens := []; # rels := []; # has_one := false; # # # select pairwise different generators # for i in [1..Length(orig_gens)] do # if not IsOne(orig_gens[i]) then # new_gen := true; # for j in [1..i-1] do # if orig_gens[i] = orig_gens[j] then # new_gen := false; # if not Word(orig_gens[i]) = Word(orig_gens[j]) then # Add(rels, [orig_gens[i], orig_gens[j]]); # fi; # break; # fi; # od; # if new_gen then Add(gens, orig_gens[i]); fi; # else # if not Word(orig_gens[i]) = Word(One(orig_gens[i])) then # Add(rels, [orig_gens[i], One(orig_gens[i])]); # fi; # has_one := true; # fi; # od; # # if has_one then # ElList := [One(G)]; # GrList := [1]; # else # ElList := []; # GrList := [0]; # fi; # # Append(ElList, ShallowCopy(gens)); # Add(GrList, Length(gens)+GrList[1]); # len := 1; # # while GrList[len] <> GrList[len+1] and len < max_len and Length(rels) < num_of_rels do # for i in [GrList[len]+1..GrList[len+1]] do # oldgr := Length(ElList); # for gen in gens do # g := ElList[i]*gen; # New := true; # # # Print("g = ", g, "\n"); # # Print("rels = ", rels, "\n"); # # # If g includes a longer part of some relation it can not represent # # neither a new element, nor be involved in a new relation # # for rel in rels do # if PositionWord(Word(g), Word(rel[1]), 1) <> fail then New := false; fi; # od; # # # Print("New el/rel:", New, "\n"); # if New then # # k := 0; # while New and k < Length(ElList) do # k := k+1; # if g = ElList[k] then # New := false; # fi; # od; # # Print("New el:", New, "\n"); # if New then # Add(ElList, g); # else # if not Word(g) = Word(ElList[k]) then # Add(rels, [g, ElList[k]]); # Print( g, " = ", ElList[k], "\n"); # fi; # fi; # fi; # # Print("\n\n\n"); # od; # od; # Add(GrList, Length(ElList)); # Info(InfoAutomGrp, 3, "There are ", Length(ElList), " elements of length up to ", len+1); # len := len+1; # od; # if GrList[len] = GrList[len+1] then # SetSize(G, GrList[len]); # fi; # return rels; # end); # # # # InstallMethod(FindSemigroupRelations, "for [IsAutomSemigroup, IsCyclotomic]", true, # [IsAutomSemigroup, IsCyclotomic], # function(G, max_len) # return FindSemigroupRelations(G, max_len, infinity); # end); # # # InstallMethod(FindSemigroupRelations, "for [IsAutomSemigroup]", # [IsAutomSemigroup], # function(G) # return FindSemigroupRelations(G, infinity, infinity); # end);
# select pairwise different generators for i in [1..Length(orig_gens)] do if not IsOne(orig_gens[i]) then
new_gen := true; for j in [1..i-1] do if orig_gens[i] = orig_gens[j] then
new_gen := false; if not IsIdenticalObj(orig_gens[i], orig_gens[j]) then
Add(rels, [orig_gens[i], orig_gens[j]]); fi;
break; fi;
od; if new_gen then Add(gens, orig_gens[i]); fi; else if not IsIdenticalObj(orig_gens[i], One(orig_gens[i])) then
Add(rels, [orig_gens[i], One(orig_gens[i])]); fi;
has_one := true; fi;
od;
Append(ElList, ShallowCopy(gens));
Append(ElListF, GeneratorsOfGroup(F));
Add(GrList, Length(gens)+GrList[1]);
len := 1;
while GrList[len] <> GrList[len+1] and len < max_len and Length(rels) < num_of_rels do for i in [GrList[len]+1..GrList[len+1]] do
oldgr := Length(ElList); for j in [1..Length(gens)] do
gen := gens[j];
genf := GeneratorsOfGroup(F)[j];
g := ElList[i]*gen;
f := ElListF[i]*genf;
New := true;
# If g includes a longer part of some relation it can not represent # neither a new element, nor be involved in a new relation for rel in relsF do if PositionSublist(LetterRepAssocWord(f), LetterRepAssocWord(rel[1]) ) <> fail then New := false; fi;
od;
# Print("New = ", New, "\n\n"); if New then
k := 0; while New and k < Length(ElList) do
k := k+1; if g = ElList[k] then
New := false; fi;
od; if New then
Add(ElList, g);
Add(ElListF, f); else
Add(rels, [g, ElList[k]]);
Add(relsF, [f, ElListF[k]]); # if Length(AssocW(v)) > 0 then
Print(g, " = ", ElList[k], "\n"); # fi; fi; fi;
od;
od;
Add(GrList, Length(ElList));
Info(InfoAutomGrp, 3, "There are ", Length(ElList), " elements of length up to ", len+1);
len := len+1;
od; if GrList[len] = GrList[len+1] then
SetSize(G, GrList[len]); fi;
return rels; end);
if Length(subs_words) <> Length(names) then
Error("The number of names must coincide with the number of generators"); fi;
F := FreeGroup(names);
orig_fgens := GeneratorsOfGroup(F);
# select pairwise different generators for i in [1..Length(orig_gens)] do if not IsOne(orig_gens[i]) then
new_gen := true; for j in [1..i-1] do if orig_gens[i] = orig_gens[j] then
new_gen := false;
Add(relsF, [orig_fgens[i], orig_fgens[j]]);
Print( orig_fgens[i], " = ", orig_fgens[j], "\n");
break; fi;
od; if new_gen then
Add(gens, orig_gens[i]);
Add(fgens, orig_fgens[i]); fi; else
Add(relsF, [orig_fgens[i], One(orig_fgens[i])]);
Print( orig_fgens[i], " = ", One(F), "\n");
has_one := true; fi;
od;
Append(ElList, ShallowCopy(gens));
Append(ElListF, fgens);
Add(GrList, Length(gens)+GrList[1]);
len := 1;
while GrList[len] <> GrList[len+1] and len < max_len and Length(relsF) < num_of_rels do for i in [GrList[len]+1..GrList[len+1]] do
oldgr := Length(ElList); for j in [1..Length(gens)] do
gen := gens[j];
genf := fgens[j];
g := ElList[i]*gen;
f := ElListF[i]*genf;
New := true;
# If g includes a longer part of some relation it can not represent # neither a new element, nor be involved in a new relation for rel in relsF do if PositionSublist(LetterRepAssocWord(f), LetterRepAssocWord(rel[1]) ) <> fail then New := false; fi;
od;
if New then
k := 0; while New and k < Length(ElList) do
k := k+1; if g = ElList[k] then
New := false; fi;
od; if New then
Add(ElList, g);
Add(ElListF, f); else
Add(relsF, [f, ElListF[k]]);
Print( f, " = ", ElListF[k], "\n"); fi; fi;
od;
od;
Add(GrList, Length(ElList));
Info(InfoAutomGrp, 3, "There are ", Length(ElList), " elements of length up to ", len+1);
len := len+1;
od;
return relsF; end);
CyclicallyReduce := function(w)
local i, j, wtmp, reduced;
for i in [1..Length(w)] do if -w[i] in gens_ord2 then w[i] := -w[i]; fi;
od;
repeat
reduced := true;
j := 1; while reduced and j < Length(w) do if w[j] = -w[j+1] or (w[j] = w[j+1] and w[j] in gens_ord2) then
reduced := false;
wtmp := ShallowCopy(w{[1..j-1]});
Append(wtmp, w{[j+2..Length(w)]});
w := wtmp; fi;
j := j+1;
od;
until reduced;
repeat if Length(w) < 2then return w; fi;
reduced := true; if w[1] = -w[Length(w)] or (w[1] = w[Length(w)] and w[1] in gens_ord2) then
w := w{[2..Length(w)-1]};
reduced := false; fi;
until reduced;
return w; end;
AreConjugateUsingSmallRels := function(g, h)
local i, g_list, h_list, long_cycle, l;
g_list := CyclicallyReduce(LetterRepAssocWord(g));
h_list := CyclicallyReduce(LetterRepAssocWord(h)); if Length(g_list) <> Length(h_list) then return false; fi;
l := [2..Length(g_list)];
Add(l, 1);
long_cycle := PermList(l); for i in [0..Length(g_list)-1] do if h_list = Permuted(g_list, long_cycle^i) then return true; fi;
od;
return false; end;
OrderUsingSections_LOCAL := function(g)
local i, el, orb, Orbs, res, st, reduced_word, loc_order; # Print("vertex=",vertex,"\n"); # Print("g=",g,"\n"); if IsOne(g) then return 1; fi;
if IsActingOnBinaryTree(g) and
not HasContainsSphericallyTransitiveElement(GroupOfAutomFamily(FamilyObj(g))) or
(HasContainsSphericallyTransitiveElement(GroupOfAutomFamily(FamilyObj(g))) and
ContainsSphericallyTransitiveElement(GroupOfAutomFamily(FamilyObj(g)))) then if IsSphericallyTransitive(g) then
Info(InfoAutomGrp, 3, g!.word, " acts transitively on levels and is obtained from (", a!.word, ")^", Product(degs{[1..Length(degs)]}), "\n by taking sections and cyclic reductions at vertex ", vertex);
return infinity; fi; fi; for i in [1..Length(cur_list)] do
el := cur_list[i]; if (AreConjugateUsingSmallRels(g!.word, el!.word) or AreConjugateUsingSmallRels((g!.word)^(-1), el!.word)) then if Product(degs{[i..Length(degs)]}) > 1then if i > 1then Info(InfoAutomGrp, 3, el!.word, " is obtained from (", a!.word, ")^", Product(degs{[1..i-1]}), "\n by taking sections and cyclic reductions at vertex ", vertex{[1..i-1]}); fi;
Info(InfoAutomGrp, 3, g!.word, " is obtained from (", el!.word, ")^", Product(degs{[i..Length(degs)]}), "\n by taking sections and cyclic reductions at vertex ", vertex{[i..Length(degs)]});
SetIsFinite(GroupOfAutomFamily(FamilyObj(a)), false);
return infinity; else # Info(InfoAutomGrp, 3, "The group <G> might not be contracting, ", g, " has itself as a section.");
return 1; fi; fi;
od; if Length(cur_list) >= max_depth then return fail; fi;
Add(cur_list, g);
Orbs := OrbitsPerms([g!.perm], [1..g!.deg]);
loc_order := 1;
for orb in Orbs do
Add(degs, Length(orb));
Add(vertex, orb[1]); # res := OrderUsingSections_LOCAL(Autom(CyclicallyReducedWord(Section(g^Length(orb), orb[1])!.word), FamilyObj(g))); # Print(g^Length(orb), "\n");
st := Section(g^Length(orb), orb[1]);
reduced_word := AssocWordByLetterRep(FamilyObj(st!.word), CyclicallyReduce(LetterRepAssocWord(st!.word))); # Print(st!.word, " at ", vertex, "\n");
res := OrderUsingSections_LOCAL(Autom(reduced_word, FamilyObj(g))); if res = infinity then return res; elif res=fail then
loc_order:=fail; fi; if loc_order<>fail then
loc_order := Lcm(loc_order, res*Length(orb)); fi;
Remove(degs);
Remove(vertex);
od;
Remove(cur_list);
return loc_order; end;
F := FamilyObj(a)!.freegroup;
gens_ord2 := GeneratorsOfOrderTwo(FamilyObj(a));
cur_list := []; # degs traces at what positions we raise to what power
degs := []; vertex := [];
res := OrderUsingSections_LOCAL(a); if res = infinity then
SetIsFinite(GroupOfAutomFamily(FamilyObj(a)), false);
SetOrder(a, infinity); fi;
return res; end);
InstallGlobalFunction(AG_SuspiciousForNoncontraction, function(arg)
local AG_SuspiciousForNoncontraction_LOCAL, cur_list, F, vertex, print_info, a;
AG_SuspiciousForNoncontraction_LOCAL := function(g)
local i, res; if IsOne(g) or g!.perm <> () then return false; fi;
if (g!.word in cur_list) or (g!.word^(-1) in cur_list) then if g = a or g = a^-1then if print_info then
Info(InfoAutomGrp, 3, a!.word, " has ", g!.word, " as a section at vertex ", vertex); else
Info(InfoAutomGrp, 5, a!.word, " has ", g!.word, " as a section at vertex ", vertex); fi;
return true; else return false; fi; fi;
Add(cur_list, g!.word);
for i in [1..FamilyObj(a)!.deg] do
Add(vertex, i);
res := AG_SuspiciousForNoncontraction_LOCAL(Section(g, i)); if res then return true; fi;
Unbind(vertex[Length(vertex)]);
od;
return false; end;
a := arg[1];
print_info := false;
if Length(arg) > 1then print_info := arg[2]; fi; if Length(arg) > 2then Error("invalid arguments for IsNoncontracting"); fi;
F := FamilyObj(a)!.freegroup;
cur_list := []; # degs traces at what positions we raise to what power
vertex := [];
return AG_SuspiciousForNoncontraction_LOCAL(a); end);
# produce a symmetric generating set
orig_gens := ShallowCopy(GeneratorsOfGroup(G));
Append(orig_gens, List(orig_gens, x -> x^-1));
gens := [];
# select pairwise different generators for i in [1..Length(orig_gens)] do if not IsOne(orig_gens[i]) then
new_gen := true; for j in [1..i-1] doif orig_gens[i] = orig_gens[j] then new_gen := false; fi; od; if new_gen then Add(gens, orig_gens[i]); fi; fi;
od;
for g in gens do if func(g) = val then return g; fi;
od;
while len < n and GrList[len] <> GrList[len+1] do for i in [GrList[len]+1..GrList[len+1]] do
oldgr := Length(ElList); for gen in gens do
g := ElList[i]*gen;
New := true; if len = 1then k := 1; else k := GrList[len-1]; fi; while New and k <= oldgr do if g = ElList[k] then New := false; fi;
k := k+1;
od; if New then if func(g) = val then return g; fi;
Add(ElList, g); fi;
od;
od;
Add(GrList, Length(ElList));
Info(InfoAutomGrp, 3, "There are ", Length(ElList), " elements of length up to ", len+1);
len := len+1;
od; if GrList[len] = GrList[len+1] then
SetSize(G, GrList[len]); fi;
return fail; end);
# produce a symmetric generating set
orig_gens := ShallowCopy(GeneratorsOfGroup(G));
Append(orig_gens, List(orig_gens, x -> x^-1));
gens := [];
cur_els := [];
# select pairwise different generators for i in [1..Length(orig_gens)] do if not IsOne(orig_gens[i]) then
new_gen := true; for j in [1..i-1] doif orig_gens[i] = orig_gens[j] then new_gen := false; fi; od; if new_gen then Add(gens, orig_gens[i]); fi; fi;
od;
if func(One(G)) = val then Add(cur_els, One(G)); fi; for g in gens do if func(g) = val then Add(cur_els, g); fi;
od;
while len < n and GrList[len] <> GrList[len+1] do for i in [GrList[len]+1..GrList[len+1]] do
oldgr := Length(ElList); for gen in gens do
g := ElList[i]*gen;
New := true; if len = 1then k := 1; else k := GrList[len-1]; fi; while New and k <= oldgr do if g = ElList[k] then New := false; fi;
k := k+1;
od; if New then if func(g) = val then
Add(cur_els, g);
Info(InfoAutomGrp, 3, g); fi;
Add(ElList, g); fi;
od;
od;
Add(GrList, Length(ElList));
Info(InfoAutomGrp, 3, "There are ", Length(ElList), " elements of length up to ", len+1);
len := len+1;
od; if GrList[len] = GrList[len+1] then
SetSize(G, GrList[len]); fi;
return cur_els; end);
InstallMethod(FindElement, "for [IsTreeHomomorphismSemigroup, IsFunction, IsObject, IsCyclotomic]", true,
[IsTreeHomomorphismSemigroup, IsFunction, IsObject, IsCyclotomic], function(G, func, val, max_len)
local iter, g;
iter := Iterator(G, max_len); while not IsDoneIterator(iter) do
g := NextIterator(iter); if func(g) = val then return g; fi;
od;
return fail; end);
InstallMethod(FindElements, "for [IsTreeHomomorphismSemigroup, IsFunction, IsObject, IsCyclotomic]", true,
[IsTreeHomomorphismSemigroup, IsFunction, IsObject, IsCyclotomic], function(G, func, val, max_len)
local iter, g, l;
iter := Iterator(G, max_len);
l := []; while not IsDoneIterator(iter) do
g := NextIterator(iter); if func(g) = val then Add(l, g); fi;
od;
return l; end);
InstallMethod(FindElementOfInfiniteOrder, "for [IsTreeAutomorphismGroup, IsCyclotomic, IsCyclotomic]", true,
[IsTreeHomomorphismSemigroup, IsCyclotomic, IsCyclotomic], function(G, n, depth)
local CheckOrder, res;
if HasIsFinite(G) and IsFinite(G) then return fail; fi;
CheckOrder := function(g) return OrderUsingSections(g, depth); end;
res := FindElement(G, CheckOrder, infinity, n); if res <> fail then SetIsFinite(G, false); fi;
return res; end);
InstallMethod(FindElementsOfInfiniteOrder, "for [IsAutomGroup, IsCyclotomic, IsCyclotomic]", true,
[IsAutomGroup, IsCyclotomic, IsCyclotomic], function(G, n, depth)
local CheckOrder, res; if HasIsFinite(G) and IsFinite(G) then return []; fi;
CheckOrder := function(g) return OrderUsingSections(g, depth); end;
res := FindElements(G, CheckOrder, infinity, n); if res <> [] then SetIsFinite(G, false); fi;
return res; end);
InstallGlobalFunction(IsNoncontracting, function(arg)
local IsNoncontrElement, res,
G, n, depth;
IsNoncontrElement := function(g) if AG_SuspiciousForNoncontraction(g) and OrderUsingSections( g, depth ) = infinity then if InfoLevel(InfoAutomGrp) > 2then
AG_SuspiciousForNoncontraction(g, true); fi;
return true; fi;
return false; end;
G := arg[1];
n := infinity;
depth := 10; if Length(arg) > 1then n := arg[2]; fi; if Length(arg) > 2then depth := arg[3]; fi; if Length(arg) > 3then Error("invalid arguments for IsNoncontracting"); fi;
if HasIsContracting(G) then return not IsContracting(G); fi;
res := FindElement(G, IsNoncontrElement, true, n); if res <> fail then
SetIsFinite(G, false);
SetIsContracting(G, false);
return true; fi;
return fail; end);
IsNewCycle := function(C)
local i, l, cur_cycle, long_cycle;
l := [2..Length(C)];
Add(l, 1);
long_cycle := PermList(l);
for cur_cycle in cycles do if Intersection(cur_cycle, C) <> [] then # if Length(C) <> Length(cur_cycle) then return fail; fi; # for i in [0..Length(C)-1] do # if cur_cycle = Permuted(C, long_cycle^i) then return false; fi; # od;
Info(InfoAutomGrp, 5, "cycle1 = ", cur_cycle, "cycle2 = ", C);
return fail; fi;
od;
return true; end;
# Example: # cycles = [[1, 2, 4], [3, 5, 6], [7]] # cur_cycles = [1, 3] (the first and the third cycles) # cycle_order = [[2, 3], [3], []] (means 1 -> 2 -> 3, 1 -> 3)
HasPolyGrowth := function(v)
local i, v_next, is_new, C, ver; # Print("v = ", v, "\n");
Add(cur_path, v); for i in [1..d] do
v_next := aut_list[v][i]; if not (v_next in known_vertices or v_next = 2*nstates+1) then if v_next in cur_path then
C := cur_path{[Position(cur_path, v_next)..Length(cur_path)]};
is_new := IsNewCycle(C); if is_new = fail then
return false; else
Add(cycles, C);
Add(cycle_order, []); for ver in C do # Print("next_cycles = ", next_cycles);
UniteSet(cycle_order[Length(cycles)], next_cycles[ver]);
cycle_of_vertex[ver] := Length(cycles);
next_cycles[ver] := [Length(cycles)];
od; fi; else if not HasPolyGrowth(v_next) then
return false; fi; if cycle_of_vertex[v] = 0then
UniteSet(next_cycles[v], next_cycles[v_next]); elif cycle_of_vertex[v] <> cycle_of_vertex[v_next] then
UniteSet(cycle_order[cycle_of_vertex[v]], next_cycles[v_next]);
Info(InfoAutomGrp, 5, "v = ", v, "; v_next = ", v_next);
Info(InfoAutomGrp, 5, "cycle_order (local) = ", cycle_order); fi; fi; elif v_next in known_vertices then if cycle_of_vertex[v] = 0then
UniteSet(next_cycles[v], next_cycles[v_next]); elif cycle_of_vertex[v] = cycle_of_vertex[v_next] then
return false; else
UniteSet(cycle_order[cycle_of_vertex[v]], next_cycles[v_next]); fi;
nstates := UnderlyingAutomFamily(G)!.numstates;
aut_list := AutomatonList(G);
d := UnderlyingAutomFamily(G)!.deg;
cycles := [];
cycle_of_vertex := List([1..nstates], x -> 0); #if vertex i is in cycle j, then cycle_of_vertex[i] = j
next_cycles := List([1..nstates], x -> []); #if vertex i is not in a cycle, next_cycles[i] stores the list of cycles, that can be reached immediately (with no cycles in between) from this vertex
known_vertices := [];
cur_path := [];
cycle_order := [];
while Length(known_vertices) < nstates do
ver := Difference([1..nstates], known_vertices)[1]; if not HasPolyGrowth(ver) then
SetIsGeneratedByBoundedAutomaton(G, false);
return false; fi;
od;
# Now we find the longest chain in the poset of cycles
cycles_of_level := [[]]; for i in [1..Length(cycles)] do if cycle_order[i] = [] then Add(cycles_of_level[1], i); fi;
od;
lev := 1;
while cycles_of_level[Length(cycles_of_level)] <> [] do
Add(cycles_of_level, []); for i in [1..Length(cycles)] do if Intersection(cycles_of_level[lev], cycle_order[i]) <> [] then
Add(cycles_of_level[lev+1], i); fi;
od;
lev := lev+1;
od;
InstallMethod(IsGeneratedByBoundedAutomaton, "for [IsAutomatonGroup]", true,
[IsAutomatonGroup], function(G)
local res;
res := IsGeneratedByAutomatonOfPolynomialGrowth(G);
return IsGeneratedByBoundedAutomaton(G); end);
InstallMethod(PolynomialDegreeOfGrowthOfUnderlyingAutomaton, "for [IsAutomatonGroup]", true,
[IsAutomatonGroup], function(G)
local res;
res := IsGeneratedByAutomatonOfPolynomialGrowth(G); if not res then
Print("Error: the automaton generating <G> has exponenetial growth\n");
return fail; fi;
return PolynomialDegreeOfGrowthOfUnderlyingAutomaton(G); end);
InstallMethod(IsAmenable, "for [IsAutomGroup]", true,
[IsAutomGroup], function(G) if HasIsFinite(G) and IsFinite(G) then return true; fi; if IsGeneratedByBoundedAutomaton(GroupOfAutomFamily(G)) then return true; fi; if IsAutomatonGroup(G) and IsAbelian(StabilizerOfLevel(G, 2)) then return true; fi; if IsAutomatonGroup(G) and IsOfSubexponentialGrowth(G)=true then return true; fi;
TryNextMethod(); end);
if (HasIsFinite(G) and IsFinite(G)) or IsAbelian(G) then return true; fi;
iter := Iterator(G, len);
cur_length := 1;
res := false;
while not IsDoneIterator(iter) do
g := NextIterator(iter);
if Length(Word(g)) > cur_length then if res then
return true;
SetIsAmenable(G, true); fi;
res := true;
cur_length := cur_length + 1; fi;
if res and cur_length <= Sum( List(Sections(g, depth), x -> Length(Word(x))) ) then
Info(InfoAutomGrp, 3, g, " has sections ", Sections(g, depth));
res := false; fi;
od;
if res then return true; fi;
# if iterator has enumerated all (finitely many) elements of <G> if HasIsFinite(G) and IsFinite(G) then return true; fi; if IsAbelian(StabilizerOfLevel(G, 2)) then return true; fi;
return fail; end);
if (HasIsFinite(G) and IsFinite(G)) or IsAbelian(G) then return true; fi;
F := UnderlyingFreeGroup(G);
iter := Iterator(F);
cur_length := 1;
res := false;
repeat
g := NextIterator(iter);
if Length(g) > cur_length then if res then
return true;
SetIsAmenable(G, true); fi;
res := true;
cur_length := cur_length + 1; fi;
if res and cur_length <= Sum( List(Sections(SelfSim(g,One(G)), depth), x -> Length(Word(x))) ) then
Info(InfoAutomGrp, 3, g, " has sections ", Sections( SelfSim(g,One(G)), depth));
res := false; fi;
until Length(g)>len;
# if iterator has enumerated all (finitely many) elements of <G> if HasIsFinite(G) and IsFinite(G) then return true; fi; if IsAbelian(StabilizerOfLevel(G, 2)) then return true; fi;
return fail; end);
InstallMethod(IsOfSubexponentialGrowth, "for [IsTreeAutomorphismGroup and IsSelfSimilar]", true,
[IsTreeAutomorphismGroup and IsSelfSimilar], function(G)
return IsOfSubexponentialGrowth(G, 10, 6); end);
¤ Diese beiden folgenden Angebotsgruppen bietet das Unternehmen0.123Angebot
(Wie Sie bei der Firma Beratungs- und Dienstleistungen beauftragen können 2026-10-12)
¤
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:
Die farbliche Syntaxdarstellung und die Messung sind noch experimentell.