Quelle  selfs.gi   Sprache: unbekannt

#############################################################################
##
#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]);
--> --------------------

--> maximum size reached

--> --------------------

[ zur Elbe Produktseite wechseln0.70Quellennavigators  Analyse erneut starten  ]