Spracherkennung für: .gi vermutete Sprache: Unknown {[0] [0] [0]} [Methode: Schwerpunktbildung, einfache Gewichte, sechs Dimensionen]
#############################################################################
##
#W selfs.gi automgrp package Yevgen Muntyan
#W Dmytro Savchuk
##
#Y Copyright (C) 2003 - 2018 Yevgen Muntyan, Dmytro Savchuk
##
InstallGlobalFunction(ReduceWord,
function(v)
local i, b;
b := [];
for i in [1..Length(v)] do
if v[i] <> 1 then
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 < 1 then
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 [IsList, IsTreeHomomorphism]", [IsList, IsTreeHomomorphism],
function(ver, g)
return OrbitOfVertex(ver, g, infinity);
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(OrbitOfVertex, "for [IsString, IsTreeHomomorphism]",
[IsString, IsTreeHomomorphism],
function(ver, g)
return OrbitOfVertex(ver, g, infinity);
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 = 2 then
for i in [1..Length(orb)] do
for j in [1..Length(orb[1])] do
# Print(orb[i][j]);
if orb[i][j] = 1 then 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);
InstallMethod(PrintOrbitOfVertex, "for [IsString, IsTreeHomomorphism]", [IsList, IsTreeHomomorphism],
function(ver, g)
PrintOrbitOfVertex(ver, g, infinity);
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) = 0 then 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) = 0 then return true; fi;
if Length(w) = 1 then
if w = [1] then return true;
else return false;
fi;
fi;
if Length(w) mod 2 = 1 then 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);
InstallMethod(AG_MinimizedAutomatonList, "for [IsAutomGroup]", [IsAutomGroup],
function(H)
return AG_AddInversesListTrack(List(AutomatonList(H), x -> List(x)));
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] > 0 then
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;
a_list := List(a_list_orig, i -> track_l[i]);
return IsOneWordContr(a_list, AG_ContractingTable(GroupOfAutomFamily(FamilyObj(a))));
end);
###############################################################################
##
#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]) = 3 then
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);
InstallMethod(AG_OrderOfElement, "for [IsList, IsList, IsPosInt]",
[IsList, IsList],
function(v, G)
return AG_OrderOfElement(v, G, infinity);
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 > 0 do
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 > 0 do
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] > 0 do
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_IsWordTransitiveOnLevel, function(G, w, lev)
return Length(OrbitPerms([WordActionOnLevel(G, w, lev)], 1)) = (Length(G[1])-1)^lev;
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]) = 1 then
Trip[i][j][Pairs[i][j][1]] := 0;
else
Trip[i1][j1][k1] := 0;
return true;
fi;
fi;
if Trip[i][j][k] = 0 then 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] <> 0 then
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] do for j1 in [2..n] do
if Pairs[i1][j1] = -1 then
k1 := 1; res := false;
while (not res) and (k1 <= n) do
res := IsPairEq(i1, j1, k1);
# Print(Pairs, "\n");
for i in [2..n] do for 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] = -1 then 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] <> 0 then 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] <> 0 then 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;
Apply(old_as_new, x->x^perm);
return [aut_list,
new_as_old,
old_as_new];
end);
InstallGlobalFunction(AG_MinimizationOfAutomatonList, function(G)
return AG_MinimizationOfAutomatonListTrack(G)[1];
end);
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 < 1 then 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);
InstallGlobalFunction(AG_AddInversesList, function(H)
return AG_AddInversesListTrack(H)[1];
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);
InstallMethod(DoNotUseContraction, "for [IsAutomGroup]", true,
[IsAutomGroup],
function(G)
UnderlyingAutomFamily(G)!.use_contraction := false;
return true;
end);
InstallMethod(FindNucleus, "for [IsAutomatonGroup, IsCyclotomic, IsBool]", true,
[IsAutomatonGroup, IsCyclotomic, IsBool],
function(H, max_nucl, print_info)
local G, g, Pairs, i, j, PairsToAdd, AssocWPairsToAdd, res, ContPairs, n, d, found, num, DoesPairContract, AddPairs, lev, maxlev, tmp, Nucl, IsElemInNucleus,
nucl_final, cur_nucl, cur_nucl_tmp, Hi, track_s, track_l, G_track, automgens, cur_nucl_length, info;
# 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] <> 0 then
ContPairs[i][j] := [0];
return true;
fi;
if ContPairs[i][j] = 2 then 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] > 0 then 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;
# ****************** FindNucleus itself *******************************
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 = 1 then 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] = -1 then 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;
SetIsContracting(H, true);
SetGroupNucleus(H, nucl_final);
SetGeneratingSetWithNucleus(H, cur_nucl);
SetAG_GeneratingSetWithNucleusAutom(H, G);
SetGeneratingSetWithNucleusAutom(H, MealyAutomaton(G));
SetContractingLevel(H, maxlev);
UseContraction(H);
return [nucl_final, cur_nucl, GeneratingSetWithNucleusAutom(H)];
end);
InstallMethod(FindNucleus, "for [IsAutomatonGroup, IsBool]", true,
[IsAutomatonGroup, IsBool],
function(H, print_info)
return FindNucleus(H, infinity, print_info);
end);
InstallMethod(FindNucleus, "for [IsAutomatonGroup, IsCyclotomic]", true,
[IsAutomatonGroup, IsCyclotomic],
function(H, max_nucl)
return FindNucleus(H, max_nucl, true);
end);
InstallMethod(FindNucleus, "for [IsAutomatonGroup]", true,
[IsAutomatonGroup],
function(H)
return FindNucleus(H, infinity, true);
end);
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);
InstallMethod(GroupNucleus, "for [IsAutomGroup]", true,
[IsAutomGroup],
function(G)
FindNucleus(G, false);
return GroupNucleus(G);
end);
InstallMethod(GeneratingSetWithNucleus, "for [IsAutomGroup]", true,
[IsAutomGroup],
function(G)
FindNucleus(G, false);
return GeneratingSetWithNucleus(G);
end);
InstallMethod(GeneratingSetWithNucleusAutom, "for [IsAutomGroup]", true,
[IsAutomGroup],
function(G)
FindNucleus(G, false);
return GeneratingSetWithNucleusAutom(G);
end);
InstallMethod(AG_GeneratingSetWithNucleusAutom, "for [IsAutomGroup]", true,
[IsAutomGroup],
function(G)
FindNucleus(G, false);
return AG_GeneratingSetWithNucleusAutom(G);
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);
InstallGlobalFunction(AG_AutomPortraitMain, function(w)
local PortraitIter, bndry, inv, d, Perm_List, max_lev, G, w_list, w_list_orig, Gi, track_l, nucl;
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 = 1 then 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]);
bndry := [];
Perm_List := [];
inv := InversePerm(G);
max_lev := 0;
PortraitIter(w_list, 0, Perm_List);
return [d, bndry, Perm_List];
end);
InstallGlobalFunction(AutomPortrait, function(w)
return AG_AutomPortraitMain(w)[3];
end);
InstallGlobalFunction(AutomPortraitBoundary, function(w)
return AG_AutomPortraitMain(w)[2];
end);
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);
InstallMethod(Growth, "for [IsAutomGroup, IsCyclotomic]", true,
[IsGroup, IsCyclotomic],
function(G, max_len)
local ElList, GrList, i, j, orig_gens, gen, gens, new_gen, g, len, viewed, oldgr, New, k, cur_els;
# 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] do if orig_gens[i] = orig_gens[j] then new_gen := false; fi; od;
if new_gen then Add(gens, orig_gens[i]); fi;
fi;
od;
ElList := [One(G)]; Append(ElList, ShallowCopy(gens));
GrList := [1, Length(gens)+1];
len := 1;
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 = 1 then 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);
InstallMethod(ListOfElements, "for [IsTreeHomomorphismSemigroup, IsCyclotomic]", true,
[IsGroup, IsCyclotomic],
function(G, max_len)
return FindElements(G, ReturnTrue, true, max_len);
end);
InstallMethod(AG_FiniteGroupId, "for [IsAutomatonGroup, IsPosInt]", true,
[IsAutomatonGroup, IsCyclotomic],
function(H, size)
local gr, len, ElList, GrList, inv, i, j, k, oldgr, v, tmpv, New, IsNewRel, inverse, G, FinG, tmpl, push, ProductEls, act, rels, LongCycle;
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 = 1 then 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;
return GroupWithGenerators(FinG);
end);
InstallMethod(AG_FiniteGroupId, "for [IsAutomGroup]",
[IsAutomGroup],
function(G)
return AG_FiniteGroupId(G, infinity);
end);
InstallMethod(AG_FiniteGroupId, "for [IsAutomGroup, IsCyclotomic]",
[IsAutomGroup, IsCyclotomic],
function(G, n)
local ElList, GrList, i, j, orig_gens, gen, gens, new_gen, g, len, viewed, oldgr, New, k, ProductEls, FinG, tmpl, push, act, track_l,
num_diff_gens, num_orig_gens, old_gens;
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;
orig_gens := ShallowCopy(GeneratorsOfGroup(G));
num_orig_gens := Length(orig_gens);
Append(orig_gens, List(orig_gens, x -> x^-1));
gens := [];
# select pairwise different generators and track the original ones.
# examlpe: assume b^2 = 1
# orig_gens = [a, e, a, b, b, c, a^-1, e^-1, a^-1, b^-1, b^-1, c^-1]
# track_l = [1, 0, 1, 2, 2, 3, 4, 0, 4, 2, 2, 5 ]
# gens = [a, b, c, a^-1, c^-1]
# num_orig_gens = 6
# num_diff_gens = 3
track_l := [];
for i in [1..Length(orig_gens)] do
if IsOne(orig_gens[i]) then
track_l[i] := 0;
else
new_gen := true;
j := 1;
while j < i and new_gen do
if orig_gens[i] = orig_gens[j] then
new_gen := false;
track_l[i] := track_l[j];
fi;
j := j+1;
od;
if new_gen then
Add(gens, orig_gens[i]);
track_l[i] := Length(gens);
fi;
if i = num_orig_gens then num_diff_gens := Length(gens); fi;
fi;
od;
ElList := [One(G)]; Append(ElList, ShallowCopy(gens));
GrList := [1, Length(gens)+1];
len := 1;
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 = 1 then 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] = 0 then
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);
InstallMethod(FindGroupRelations, "for [IsList and IsAutomCollection, IsList, IsCyclotomic, IsCyclotomic]", true,
[IsList and IsAutomCollection, IsList, IsCyclotomic, IsCyclotomic],
function(subs_words, names, max_len, num_of_rels)
local G, gens, Gi, H, rel, rels, rels0, k, track_s, track_l, AssocW, FindGroupRelationsLocal, gens_autom, i, j, subs, subs1, w_list, FindGroupRelationsSubsLocal, w_ext, w, automgens, numstates, F, cur_gen;
AssocW := function(w)
return Product(List(w, i -> gens[i]));
end;
FindGroupRelationsSubsLocal := function(subs, G)
local gr, len, ElList, GrList, inv, i, j, k, oldgr, v, tmpv, New, IsNewRelS, inverse, inverseS, H, FinG, tmpl, push, ProductEls, act, rels, LongCycle, invslist, invs, origlength, w, invadded, AssocWrels;
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;
# Print(AG_IsOneList(Append(StructuralCopy(subs[i]), subs[j]), G), "\n");
# Print(Concatenation(subs[i], subs[j]), "\n");
if AG_IsOneList(Concatenation(subs[i], subs[j]), G) then
invslist[i] := j; invslist[j] := i;
Add(rels, [i, j]);
Add(AssocWrels, AssocW([i, j]));
Print(AssocW([i, j]), "\n");
fi;
od;
od;
# 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 = 1 then 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)) > 0 then
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;
#************************ FindGroupRelationsSubs itself ****************************************************
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));
automgens := UnderlyingAutomFamily(G)!.automgens;
numstates := UnderlyingAutomFamily(G)!.numstates;
#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);
InstallMethod(FindGroupRelations, "for [IsList and IsAutomCollection, IsList, IsCyclotomic]", true,
[IsList and IsAutomCollection, IsList, IsCyclotomic],
function(subs_words, names, max_len)
return FindGroupRelations(subs_words, names, max_len, infinity);
end);
InstallMethod(FindGroupRelations, "for [IsList and IsAutomCollection, IsList]",
[IsList and IsAutomCollection, IsList],
function(subs_words, names)
return FindGroupRelations(subs_words, names, infinity, infinity);
end);
InstallMethod(FindGroupRelations, "for [IsAutomGroup, IsCyclotomic, IsCyclotomic]", true,
[IsAutomatonGroup, IsCyclotomic, IsCyclotomic],
function(G, max_len, num_of_rels)
local gens, Gi, H, rel, rels, rels0, k, track_s, track_l, AssocW, FindGroupRelationsLocal;
AssocW := function(w)
#Print(w);
return Product(List(w, i -> gens[i]));
end;
FindGroupRelationsLocal := function(subs, G)
local gr, len, ElList, GrList, inv, i, j, k, oldgr, v, tmpv, New, IsNewRelS, inverse, inverseS, H, FinG, tmpl, push, ProductEls, act, rels, LongCycle, invslist, invs, origlength, w, invadded, tmpv_orig, AssocWrels;
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 ****************************************************
rels := [];
AssocWrels := [];
inv := InversePerm(G);
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) > 0 then
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 = 1 then 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) > 0 then
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;
#************************ FindGroupRelations itself ****************************************************
gens := ShallowCopy(UnderlyingAutomFamily(G)!.automgens);
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;
rels := FindGroupRelationsLocal(List([2..Length(H)], i -> [i]), AG_ChooseAutomatonList(G));
Append(rels0, rels);
# Print(rels0);
return rels0;
end);
InstallMethod(FindGroupRelations, "for [IsAutomGroup, IsCyclotomic]", true,
[IsAutomatonGroup, IsCyclotomic],
function(G, max_len)
return FindGroupRelations(G, max_len, infinity);
end);
InstallMethod(FindGroupRelations, "for [IsAutomGroup]",
[IsAutomatonGroup],
function(G)
return FindGroupRelations(G, infinity, infinity);
end);
InstallMethod(FindGroupRelations, "for [IsList and IsAutomCollection, IsCyclotomic, IsCyclotomic]", true,
[IsList and IsAutomCollection, IsCyclotomic, IsCyclotomic],
function(subs_words, max_len, num_of_rels)
return FindGroupRelations(GroupWithGenerators(subs_words), max_len, infinity);
end);
InstallMethod(FindGroupRelations, "for [IsList and IsAutomCollection, IsCyclotomic]", true,
[IsList and IsAutomCollection, IsCyclotomic],
function(subs_words, max_len)
return FindGroupRelations(subs_words, max_len, infinity);
end);
InstallMethod(FindGroupRelations, "for [IsList and IsAutomCollection]",
[IsList and IsAutomCollection],
function(subs_words)
return FindGroupRelations(subs_words, infinity, infinity);
end);
InstallMethod(FindGroupRelations, "for [IsGroup, IsCyclotomic, IsCyclotomic]", true,
[IsGroup, 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, rels, rel, F, relsF, ElListF, genf, f, fgens, all_relsF, rel1, new_rel, r, orig_fgens, \
IsNewRel, CyclicConjugates, ngens, FFhom_images, FFhom, FGhom_images, FGhom, ElList_inv, inv_gens, cur_rel;
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;
CyclicConjugates := function(rel)
local rel1, conjs;
rel1 := rel; conjs := [];
repeat
rel1 := rel1^Subword(rel1, 1, 1);
Add(conjs, rel1);
until rel1 = rel;
return conjs;
end;
orig_gens := ShallowCopy(GeneratorsOfGroup(G));
ngens := Length(orig_gens);
F := FreeGroup(ngens);
orig_fgens := ShallowCopy(GeneratorsOfGroup(F));
FFhom_images := ShallowCopy(GeneratorsOfGroup(F));
FGhom_images := ShallowCopy(GeneratorsOfGroup(G));
Append(orig_gens, List(orig_gens, x -> x^-1));
Append(orig_fgens, List(orig_fgens, x -> x^-1));
gens := [];
fgens := [];
rels := [];
relsF := [];
all_relsF := [];
# 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;
# Print("gens = ", gens, "\n");
# Print("inv_gens = ", inv_gens, "\n");
FFhom := GroupHomomorphismByImagesNC(F, F, GeneratorsOfGroup(F), FFhom_images);
FGhom := GroupHomomorphismByImagesNC(F, G, GeneratorsOfGroup(F), FGhom_images);
# Print("hom = ", hom, "\n");
ElList := [One(G)];
# ElList_inv := [One(G)];
ElListF := [One(F)];
Append(ElList, ShallowCopy(gens));
# Append(ElList_inv, ShallowCopy(inv_gens));
Append(ElListF, ShallowCopy(fgens));
GrList := [1, Length(gens)+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
f := ElListF[i]*fgens[j];
if Length(f) > Length(ElListF[i]) then
g := ElList[i]*gens[j];
New := true;
if len = 1 then 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);
InstallMethod(FindGroupRelations, "for [IsGroup, IsCyclotomic]", true,
[IsGroup, IsCyclotomic],
function(G, max_len)
return FindGroupRelations(G, max_len, infinity);
end);
InstallMethod(FindGroupRelations, "for [IsGroup]",
[IsGroup],
function(G)
return FindGroupRelations(G, infinity, infinity);
end);
InstallMethod(FindGroupRelations, "for [IsList, IsCyclotomic, IsCyclotomic]", true,
[IsList, IsCyclotomic, IsCyclotomic],
function(subs_words, max_len, num_of_rels)
return FindGroupRelations(GroupWithGenerators(subs_words), max_len, infinity);
end);
InstallMethod(FindGroupRelations, "for [IsList, IsCyclotomic]", true,
[IsList, IsCyclotomic],
function(subs_words, max_len)
return FindGroupRelations(subs_words, max_len, infinity);
end);
InstallMethod(FindGroupRelations, "for [IsList]",
[IsList],
function(subs_words)
return FindGroupRelations(subs_words, infinity, infinity);
end);
InstallMethod(FindGroupRelations, "for [IsList, IsList, IsCyclotomic, IsCyclotomic]", true,
[IsList, IsList, IsCyclotomic, IsCyclotomic],
function(subs_words, names, max_len, num_of_rels)
local ElList, GrList, i, j, orig_gens, gen, gens, new_gen, g, len, oldgr, New, k, rel, F, relsF, ElListF, genf, f, fgens, all_relsF, rel1, new_rel, r, orig_fgens, \
IsNewRel, CyclicConjugates, ngens, FFhom_images, FFhom;
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;
CyclicConjugates := function(rel)
local rel1, conjs;
rel1 := rel; conjs := [];
repeat
rel1 := rel1^Subword(rel1, 1, 1);
Add(conjs, rel1);
until rel1 = rel;
return conjs;
end;
if Length(subs_words) <> Length(names) then
Error("The number of names must coincide with the number of generators");
fi;
orig_gens := ShallowCopy(subs_words);
F := FreeGroup(names);
orig_fgens := ShallowCopy(GeneratorsOfGroup(F));
ngens := Length(orig_gens);
FFhom_images := ShallowCopy(GeneratorsOfGroup(F));
Append(orig_gens, List(orig_gens, x -> x^-1));
Append(orig_fgens, List(orig_fgens, x -> x^-1));
gens := [];
fgens := [];
relsF := [];
all_relsF := [];
# 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;
FFhom := GroupHomomorphismByImagesNC(F, F, GeneratorsOfGroup(F), FFhom_images);
ElList := [One(subs_words[1])];
ElListF := [One(F)];
Append(ElList, ShallowCopy(gens));
Append(ElListF, ShallowCopy(fgens));
GrList := [1, Length(gens)+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
f := ElListF[i]*fgens[j];
if Length(f) > Length(ElListF[i]) then
g := ElList[i]*gens[j];
New := true;
if len = 1 then 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(FindGroupRelations, "for [IsList, IsList, IsCyclotomic]", true,
[IsList, IsList, IsCyclotomic],
function(subs_words, names, max_len)
return FindGroupRelations(subs_words, names, max_len, infinity);
end);
InstallMethod(FindGroupRelations, "for [IsList, IsList]", true,
[IsList, IsList],
function(subs_words, names)
return FindGroupRelations(subs_words, names, infinity, infinity);
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);
InstallMethod(FindSemigroupRelations, "for [IsSemigroup, IsCyclotomic, IsCyclotomic]", true,
[IsSemigroup, 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, F, relsF, ElListF, genf, f;
orig_gens := ShallowCopy(GeneratorsOfSemigroup(G));
gens := [];
rels := [];
relsF := [];
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 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;
F := FreeGroup(Length(gens));
if has_one then
ElList := [One(G)];
ElListF := [One(F)];
GrList := [1];
else
ElList := [];
ElListF := [];
GrList := [0];
fi;
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);
InstallMethod(FindSemigroupRelations, "for [IsSemigroup, IsCyclotomic]", true,
[IsSemigroup, IsCyclotomic],
function(G, max_len)
return FindSemigroupRelations(G, max_len, infinity);
end);
InstallMethod(FindSemigroupRelations, "for [IsSemigroup]",
[IsSemigroup],
function(G)
return FindSemigroupRelations(G, infinity, infinity);
end);
InstallMethod(FindSemigroupRelations, "for [IsList, IsCyclotomic, IsCyclotomic]", true,
[IsList, IsCyclotomic, IsCyclotomic],
function(subs_words, max_len, num_of_rels)
return FindSemigroupRelations(SemigroupByGenerators(subs_words), max_len, num_of_rels);
end);
InstallMethod(FindSemigroupRelations, "for [IsList, IsCyclotomic]", true,
[IsList, IsCyclotomic],
function(subs_words, max_len)
return FindSemigroupRelations(subs_words, max_len, infinity);
end);
InstallMethod(FindSemigroupRelations, "for [IsList]",
[IsList],
function(subs_words)
return FindSemigroupRelations(subs_words, infinity, infinity);
end);
InstallMethod(FindSemigroupRelations, "for [IsList, IsList, IsCyclotomic, IsCyclotomic]", true,
[IsList, IsList, IsCyclotomic, IsCyclotomic],
function(subs_words, names, max_len, num_of_rels)
local ElList, GrList, i, j, orig_gens, orig_fgens, gen, gens, fgens, new_gen, g, len, oldgr, New, k, has_one, rel, F, relsF, ElListF, genf, f;
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);
orig_gens := ShallowCopy(subs_words);
gens := [];
fgens := [];
relsF := [];
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;
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;
if has_one then
ElList := [One(gens[1])];
ElListF := [One(F)];
GrList := [1];
else
ElList := [];
ElListF := [];
GrList := [0];
fi;
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);
InstallMethod(FindSemigroupRelations, "for [IsList, IsList, IsCyclotomic]", true,
[IsList, IsList, IsCyclotomic],
function(subs_words, names, max_len)
return FindSemigroupRelations(subs_words, names, max_len, infinity);
end);
InstallMethod(FindSemigroupRelations, "for [IsList, IsList]", true,
[IsList, IsList],
function(subs_words, names)
return FindSemigroupRelations(subs_words, names, infinity, infinity);
end);
InstallMethod(OrderUsingSections, "for [IsAutom, IsCyclotomic]", true,
[IsAutom, IsCyclotomic],
function(a, max_depth)
local OrderUsingSections_LOCAL, cur_list, F, degs, vertex, AreConjugateUsingSmallRels, gens_ord2, CyclicallyReduce, res;
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) < 2 then 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)]}) > 1 then
if i > 1 then 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);
InstallMethod(OrderUsingSections, "for [IsAutom]", true,
[IsAutom],
function(a)
return OrderUsingSections(a, infinity);
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^-1 then
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) > 1 then print_info := arg[2]; fi;
if Length(arg) > 2 then 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);
InstallMethod(FindElement, "for [IsAutomGroup, IsFunction, IsObject, IsCyclotomic]", true,
[IsAutomGroup, IsFunction, IsObject, IsCyclotomic],
function(G, func, val, n)
local ElList, GrList, i, j, orig_gens, gen, gens, new_gen, g, len, viewed, oldgr, New, k;
if func(One(G)) = val then return One(G); fi;
# 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] do if 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;
ElList := [One(G)]; Append(ElList, ShallowCopy(gens));
GrList := [1, Length(gens)+1];
len := 1;
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 = 1 then 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);
InstallMethod(FindElements, "for [IsAutomGroup, IsFunction, IsObject, IsCyclotomic]", true,
[IsGroup, IsFunction, IsObject, IsCyclotomic],
function(G, func, val, n)
local ElList, GrList, i, j, orig_gens, gen, gens, new_gen, g, len, viewed, oldgr, New, k, cur_els;
# 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] do if 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;
ElList := [One(G)]; Append(ElList, ShallowCopy(gens));
GrList := [1, Length(gens)+1];
len := 1;
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 = 1 then 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) > 2 then
AG_SuspiciousForNoncontraction(g, true);
fi;
return true;
fi;
return false;
end;
G := arg[1];
n := infinity;
depth := 10;
if Length(arg) > 1 then n := arg[2]; fi;
if Length(arg) > 2 then depth := arg[3]; fi;
if Length(arg) > 3 then 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);
InstallMethod(IsGeneratedByAutomatonOfPolynomialGrowth, "for [IsAutomatonGroup]", true,
[IsAutomatonGroup],
function(G)
local i, d, ver, nstates, cycles, cycle_of_vertex, IsNewCycle, known_vertices, aut_list, HasPolyGrowth, cycle_order, next_cycles, cur_cycles, cur_path, cycles_of_level, lev;
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] = 0 then
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] = 0 then
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;
fi;
od;
Remove(cur_path);
Add(known_vertices, v);
return true;
end;
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;
if lev = 2 then
SetIsGeneratedByBoundedAutomaton(G, true);
SetIsAmenable(G, true);
elif lev = 1 then
SetIsGeneratedByBoundedAutomaton(G, true);
SetIsFinite(G, true);
else
SetIsGeneratedByBoundedAutomaton(G, false);
fi;
SetPolynomialDegreeOfGrowthOfUnderlyingAutomaton(G, lev-2);
Info(InfoAutomGrp, 5, "Cycles = ", cycles);
Info(InfoAutomGrp, 5, "cycle_order = ", cycle_order);
Info(InfoAutomGrp, 5, "next_cycles = ", next_cycles);
return true;
end);
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);
InstallMethod(IsOfSubexponentialGrowth, "for [IsAutomatonGroup, IsCyclotomic, IsCyclotomic]", true,
[IsAutomatonGroup, IsCyclotomic, IsCyclotomic],
function(G, len, depth)
local iter, res, g, cur_length;
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);
InstallMethod(IsOfSubexponentialGrowth, "for [IsSelfSimilarGroup, IsCyclotomic, IsCyclotomic]", true,
[IsSelfSimilarGroup, IsCyclotomic, IsCyclotomic],
function(G, len, depth)
local iter, res, g, cur_length, F;
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);
InstallGlobalFunction(AG_GroupHomomorphismByImagesNC,
function(G, H, gens_G, gens_H)
local F, gens_in_freegrp, pi, pi_bar, hom_function, inv_hom_function;
if Length(gens_G)<>Length(gens_H) then
Error("Lengths of generating sets must coincide");
fi;
F := FreeGroup(Length(gens_G));
gens_in_freegrp := List(gens_G, Word);
# pi
# F ------> G ----> H
# -------------->
# pi_bar
pi := GroupHomomorphismByImages(F, Group(gens_in_freegrp),
GeneratorsOfGroup(F), gens_in_freegrp);
pi_bar := GroupHomomorphismByImages(F, H,
GeneratorsOfGroup(F), gens_H);
hom_function := function(g)
return Image(pi_bar, PreImagesRepresentative(pi, g!.word));
end;
if IsAutomGroup(G) then
inv_hom_function := function(b)
return Autom(Image(pi, PreImagesRepresentative(pi_bar, b)), UnderlyingAutomFamily(G));
end;
elif IsSelfSimGroup(G) then
inv_hom_function := function(b)
return SelfSim(Image(pi, PreImagesRepresentative(pi_bar, b)), UnderlyingSelfSimFamily(G));
end;
fi;
return GroupHomomorphismByFunction(G, H, hom_function, inv_hom_function);
end);
#E
