Quelle  cp.gi   Sprache: unbekannt

#############################################################################
##
#W cp.gi                                                       Thorsten Groth
##
#Y Copyright (C) 2014, Thorsten Groth
##
#############################################################################
##
##  This file implements the conjugacy problem for branch groups
##
#############################################################################

#---------------------------------------------------------------
#------              Dep-Cartesian          --------------------
#--  Calculates a cartesian product of ordered lists with    ---
#-- respect to dependencies which entries belong together    ---
#-- Example: L=[[A,B,X],[C,D],[c,d]], dep=[[1],[2,3]] results --
#--   in [[A,C,c],[A,D,d],[B,C,c],[B,D,d],[X,C,c],[X,D,d]    ---
#--     The Lists, which are joined by the dependencies      ---
#--            have to be of the same length                --- 
#---------------------------------------------------------------
BindGlobal("DEP_CARTESIAN@", function(L,dep)
 local res_list, temp_cart, container, al, d, i ,j,a;
 res_list := [];
 temp_cart := [];
 for d in dep do
  container := [];
  for j in [1..Size(L[d[1]])] do
   al := [];
   for i in [1..Size(d)] do
    if IsBound(L[d[i]][j]) then
     al[i]:=L[d[i]][j];
    fi;
   od;
   if al <> [] then container[j]:=al; fi;
  od; 
  Add(temp_cart,container);
 od; 
 temp_cart := Cartesian(temp_cart);
 for i in temp_cart do
  container := [];
  for d in i do
   Append(container,d);
  od;
  Add(res_list,container);
 od;
 return res_list;
end);

#--------------------------------------------------------------
#------             LEVEL_PERM_CONJ                     -------
#------  Takes two FRElements and computes a list of    -------
#------  conjugators of the action on the first level.  -------
#--------------------------------------------------------------
BindGlobal("LEVEL_PERM_CONJ@", function(arg)
 local G, pi_x, pi_y, c;
 if Length(arg) < 3 then
  G:=SymmetricGroup(AlphabetOfFRObject(arg[1]));
 else 
  if not IsFRObject(arg[1]) or not IsFRObject(arg[2]) or not IsPermGroup(arg[3]) then
   Error("Usage: FRelm, FRelm, [PermGroup]");
  fi;
  G:=arg[3];
 fi;
 pi_x := PermList(DecompositionOfFRElement(arg[1])[2]);
  pi_y := PermList(DecompositionOfFRElement(arg[2])[2]);
  c := RepresentativeAction(G,pi_x,pi_y);
  if c= fail then
   return [];
  fi;
  return c*List(Centralizer(G,pi_y));
end);
##################################################################
#````````````````````````````````````````````````````````````````#
#```````````````````    OrbitSignalizer   ```````````````````````#
#````````````````                            ````````````````````#
#````````````````    Guaranteed to stop on    ```````````````````#
#```````````````` BoundedFRElements as input ````````````````````#
#``````  Computes {a^m@v|v∊X*} with m = |Orb_a(v)|   ````````````#
#````````````````````````````````````````````````````````````````#
##################################################################
InstallMethod(OrbitSignalizer,
 "Returns the finite Orbit Signalizer",
 [IsFRElement],
function(a)
 local OS_list,i,OS_unvisited,OS_new,elm,x,new,suc;
 suc := function(state,x)
  return  State(state^Size(ForwardOrbit(state,[x])),[x]);
 end;
 OS_list := [];
 OS_unvisited := [a];
 while Length(OS_unvisited) > 0 do
  OS_new := [];
  for elm in OS_unvisited do
   for x in AlphabetOfFRObject(a) do
    new := suc(elm,x);
    if (not new in OS_list) and (not new in OS_unvisited) and (not new in OS_new) then
     Add(OS_new,new);
    fi;
   od;
   
  od; 
  Append(OS_list,OS_unvisited);
  OS_unvisited := OS_new;
 od;
 return OS_list;
end
);
##################################################################
#````````````````````````````````````````````````````````````````#
#`````````````````````                  `````````````````````````#
#`````````````````````  ConjugatorGraph `````````````````````````#
#`````````````````````     DrawGraph    `````````````````````````#
#`````````````````````                  `````````````````````````#
#````````````````````````````````````````````````````````````````#
##################################################################
BindGlobal("CONJUGATOR_GRAPH@", function(a,b)
 local Alph, Vertices, Edges, c, d, p, v_id, e_id, v, orbits, orb_repr, i, new_con_pair, new_v, w, change, found, e, all_found;
 
 Alph := AlphabetOfFRObject(a);
 Vertices := [];
 Edges := [];
 #--------------------- Save some work, in easy cases--------
 if Size(LEVEL_PERM_CONJ@(a,b))=0 then
  return [[],[]];
 fi;
 #--------------------- Generate the Vertex list ------------
 v_id := 1;
 for c in OrbitSignalizer(a) do
  for d in OrbitSignalizer(b) do
   for p in LEVEL_PERM_CONJ@(c,d) do
    Add(Vertices,rec( id:= v_id,
             conj_pair := [c,d],
             action := p));
    v_id := v_id+1;
   od;
  od;
 od;
 #Print("Vertexlist generated\n");
 
 #--------------------- Find the Edges  -------------------
 e_id := 1;
 for v in Vertices do
  c := v.conj_pair[1];
  d := v.conj_pair[2];
  orbits := Orbits(Group(c),Alph);
  orb_repr := List(orbits,Minimum);
  for i in [1..Length(orbits)] do
   new_con_pair := [State(c^Length(orbits[i]),orb_repr[i]),State(d^Length(orbits[i]),orb_repr[i]^v.action)];
   for p in LEVEL_PERM_CONJ@(new_con_pair[1],new_con_pair[2]) do
    new_v := 0;
    for w in Vertices do
     if w.conj_pair = new_con_pair and w.action = p then;
      new_v := w;
      break;
     fi;
    od;
    if new_v <> 0 then
     #Print("Add Edge from ",v.id," to ",new_v.id," along ",orb_repr[i],"\n");
     Add(Edges,rec( from:=v.id,
             to := new_v.id,
             read := orb_repr[i],
             write := orb_repr[i]^v.action,
             id := e_id));
     e_id := e_id +1; 
    else #This case should never happen...
     Error("Error the element is not in the vertex set!\n");
    fi;
   od;
  od;
 od;
 #Print(Size(Edges)," Edges generated\n");
 
 #--------------------- Delete dead Vertices  -------------------
 change:=true;
 while change do
  change := false;
  for v in Vertices do
   orbits := Orbits(Group(v.conj_pair[1]),Alph);
   orb_repr := List(orbits,Minimum);
   found := [];
   for e in Edges do
    if e.from = v.id then
     Add(found,e.read);
    fi;
   od;
   #Are all outgoing edges there?
   all_found := true;
   for i in orb_repr do
    if not i in found then
     all_found := false;
     #Print("At Vertex ",v.id," no Edge ",i," was found. So remove it.\n");
     break;
    fi;
   od;
   if not all_found then
    Unbind(Vertices[v.id]);
    #Delete all Edges from or to the removed vertex
    for e in Edges do
     if e.from = v.id or e.to = v.id then
      Unbind(Edges[e.id]);
     fi;
    od;
    change:=true;
   fi;
  od;
 od;
 #Print("Dead Vertices removed\n");
 return [Vertices,Edges];
end);

BindGlobal("DRAW_GRAPH@",function(Vertices,Edges)
 local v,S,e;
 for v in Vertices do
  Print("ID: ",v.id," Name: (",v.conj_pair[1]![2],",",v.conj_pair[2]![2],")\n");
 od;
 #Draw Conjugacy Graph
 S := "digraph finite_state_machine {\n";
 for e in Edges do
  #Print(Vertices[e.from].conj_pair[1]![2]);
  Append(S,"\"");
  Append(S,String(Vertices[e.from].id));
  Append(S,": (");
  Append(S,String(Vertices[e.from].conj_pair[1]![2]));
  Append(S,",");
  Append(S,String(Vertices[e.from].conj_pair[2]![2]));
  Append(S,")");
  Append(S,String(Vertices[e.from].action));
  Append(S,"\"");
  Append(S," -> ");
  Append(S,"\"");
  Append(S,String(Vertices[e.to].id));
  Append(S,": (");
  Append(S,String(Vertices[e.to].conj_pair[1]![2]));
  Append(S,",");
  Append(S,String(Vertices[e.to].conj_pair[2]![2]));
  Append(S,")");
  Append(S,String(Vertices[e.to].action));
  Append(S,"\"");
  Append(S," [label=\"");
  Append(S,String(e.read));
  Append(S,"|");
  Append(S,String(e.write));
  Append(S,"\"];\n");
 od;
 Append(S,"}");
 Print(S);
 DOT2DISPLAY@(S,"dot");
end);
##################################################################
#````````````````````````````````````````````````````````````````#
#```````````````````  MEALY_FROM_STATES@  ```````````````````````#
#````````````````                            ````````````````````#
#`````````````````  Computes a mealy machine ````````````````````#
#````````````````     with Statesset L and   ````````````````````#
#````````````````        activity act        ````````````````````#
#````````````````````````````````````````````````````````````````#
##################################################################
#Computes a mealy machine with stateset L and given activity act.
BindGlobal("MEALY_FROM_STATES@", function(L,act)
  local m,tran,out,i,j;
  #Force L to contain elements and not lists of elements.
  for i in [1..Size(L)] do
   if IsList(L[i]) then
    L[i] := Product(L[i]);
   fi;
  od;
  #Force act to be a list of output symbols.
  if IsPerm(act) then
   act := List(AlphabetOfFRObject(L[1]),x->x^act);
  fi;
  
  tran := [[]];
  out := [act];
  i := 1;
  j := 2;
  for m in L do
    Add(tran[1],i+1);
    Append(tran,List(m!.transitions,x->List(x,y->y+i)));
    Append(out,m!.output);
    i := i + Length(m!.transitions);
    j := j+1;
  od;
  return MealyElement(tran,out,1);
 end);
##################################################################
#````````````````````````````````````````````````````````````````#
#`````````````````````                  `````````````````````````#
#`````````````````````    F.S. Worker   `````````````````````````#
#`````````````````````                  `````````````````````````#
#````````````````````````````````````````````````````````````````#
##################################################################
BindGlobal("CONJUGATORS_FINITE_STATE_WRAPPER@",function(start,CG)
 local v,AS,to_visit, Alph, new_v, i, found, e, Tran, Act, c,d, orbit;
   #--------- Choose one subgraph, as automaton  ---------
   AS := [start.id]; #Contains IDs of vertices, which build the subgraph
   to_visit := [start.id]; 
   Alph := AlphabetOfFRObject(start.conj_pair[1]);
   while Length(to_visit) > 0 do 
    new_v := [];
    for i in to_visit do
     v := CG[1][i];
     found := [];
     for e in CG[2] do
      if e.from = v.id then
       if e.read in found then
        Unbind(CG[2][e.id]);
       else 
        Add(found,e.read);
        if not e.to in AS then
         Add(new_v,CG[1][e.to].id);
         Add(AS,e.to);
        fi;
       fi;
      fi;
     od;
    od;
    to_visit := new_v;
   od;
   #Form an automaton out of the subgraph
   Tran := [];
   Act := [];
   for i in AS do
    Add(Tran,[]);
    Add(Act,CG[1][i].action);
   od;
   for e in CG[2] do
    if e.from in AS and e.to in AS then
     Tran[Position(AS,e.from)][Position(Alph,e.read)] := [Position(AS,e.to)];
     c := CG[1][e.from].conj_pair[1];
     d := CG[1][e.from].conj_pair[2];
     orbit := ForwardOrbit(c,e.read);
     for i in [2..Length(orbit)] do
     #The missing edges...
      Tran[Position(AS,e.from)][Position(Alph,orbit[i])] := [State(c^(i-1),e.read)^(-1),Position(AS,e.to),State(d^(i-1),e.read^(CG[1][e.from].action))];
     od;
    fi;
   od;
   return FRElement(Tran,Act,[1]);
end);
##################################################################
#````````````````````````````````````````````````````````````````#
#`````````````````````                  `````````````````````````#
#`````````````````````  Finitary Worker `````````````````````````#
#`````````````````````                  `````````````````````````#
#````````````````````````````````````````````````````````````````#
##################################################################
BindGlobal("CONJUGATORS_FINITARY_WRAPPER@",function(v,Graph,Seen,Known_vertex_conjugator)
 local CONJUGATORS_FINITARY_REK;
 CONJUGATORS_FINITARY_REK := function(v,Graph,Seen,Known_vertex_conjugator)
  local Vertices,Edges,sons,starts,conj_cand,conjugators_found,son,x,NewSeen,a,b,e,son_conj,son_conjs,tempo_conj, htemp,tempoconj,err,Indices,diction,pos,real_conj,real_conjugators,i,j,ip,son_orbit_size,Alph,action,
  w,Circle,Conjs,con;
 
  #Print("@Vertex ",v,"\n");
  if IsBound(Known_vertex_conjugator[v]) then #Don't do the same work twice.
   return Known_vertex_conjugator[v];
  fi;
  Vertices := Graph[1];
  Edges := Graph[2];
  a := Vertices[v].conj_pair[1];
  b := Vertices[v].conj_pair[2];
  Alph := AlphabetOfFRObject(a);
  action := Vertices[v].action;
 
  if v in Seen then
   Circle:=Seen{[Position(Seen,v)..Size(Seen)]}; #are all one then.
   for w in Circle do
    if not Vertices[w].action = () then
     return [];
    fi;
    if not Vertices[w].conj_pair[1] = Vertices[w].conj_pair[2] then
     return [];
    fi;
   od;
   return [One(a)];
  fi;
 
  sons := [];
  for e in Edges do
   if e.from = v then
    Add(sons,[e.to,e.read]);
   fi;
  od;
  real_conjugators := [];
  conj_cand := EmptyPlist(Size(Alph));
  for x in Alph do
   conj_cand[x] := [];
  od;
  conjugators_found := [];
 
  for son in sons do
   NewSeen := ShallowCopy(Seen);
   Add(NewSeen,v);
   son_conjs := CONJUGATORS_FINITARY_REK(son[1],Graph,NewSeen,Known_vertex_conjugator);
   son_orbit_size := Size(Orbit(Group(a),son[2]));
   for son_conj in son_conjs do
    tempo_conj := [];
    err:=0;
    for j in [1..son_orbit_size-1] do
     htemp := (State(a^j,son[2]))^(-1) * son_conj * State(b^j,son[2]^action);
     if IsFinitaryFRElement(htemp) then
      tempo_conj[son[2]^(a^j)] := htemp;
     else
      err := 1;
      break;
     fi;
    od;
    tempo_conj[son[2]] := son_conj;
    if err = 0 then #tempo_conj is indeed a valid partial_conjugator for (a,b)
     for i in Alph do
      if IsBound(tempo_conj[i]) then
       Add(conj_cand[i],[tempo_conj[i]]);
       conjugators_found[i] := 1;
      fi;
     od;
    fi;
   od;
  od;
  #Test if we have enough partial conjugators
  if IsDenseList(conjugators_found) and Size(conjugators_found) = Size(Alph) then
   #puzzle them together! 
   Conjs := DEP_CARTESIAN@(conj_cand,Orbits(Group(a),Alph));
   for con in Conjs do
    Add(real_conjugators,FRElement([con],[action],[1]));
   od;
  fi;
  Known_vertex_conjugator[v] := real_conjugators;
  return real_conjugators;
 end;
 return CONJUGATORS_FINITARY_REK(v,Graph,Seen,Known_vertex_conjugator);
end);
##################################################################
#````````````````````````````````````````````````````````````````#
#`````````````````````                  `````````````````````````#
#`````````````````````  BoundedWorker   `````````````````````````#
#`````````````````````                  `````````````````````````#
#````````````````````````````````````````````````````````````````#
##################################################################
BindGlobal("CONJUGATORS_BOUNDED_WRAPPER@",function(v,Graph,Seen,readwrite_path,Known_vertex_conjugator)
 local CONJUGATORS_BOUNDED_REK;
 CONJUGATORS_BOUNDED_REK := function(v,Graph,Seen,readwrite_path,Known_vertex_conjugator)
  local Vertices,Edges,sons,starts,conj_cand,conjugators_found,son,x,NewSeen,a,b,e,son_conj,son_conjs,tempo_conj, htemp,tempoconj,err,Indices,diction,pos,real_conj,real_conjugators,conj_cand_aux,i,j,ip,son_orbit_size,Alph,Alph_num,action, alph,beta,Conj_elm,read,write,orb_size,Conj_Tran,Conj_act,m,read_path,write_path,action_path,New_read_path, New_write_path,New_action_path,Conj_Tran_el,Conjs,circle_length,New_Seen,X,con, check_need ;
 
  #Print("@Vertex ",v,"\n");
  if IsBound(Known_vertex_conjugator[v]) then #Don't do the same work twice.
   return Known_vertex_conjugator[v];
  fi;
  #TODO REKURSIONSABBRUCH, wenn start schon gefunden wurde!!!!
  #if IsBound(Known_vertex_conjugator[start]) then
  # if Size(Known_vertex_conjugator[start]>0) then
  #  Print("Warum denn noch weitermachen... ist doch schon alles klar...\n\n");
  # fi;
  #fi;
  Vertices := Graph[1];
  Edges := Graph[2];
  a := Vertices[v].conj_pair[1];
  b := Vertices[v].conj_pair[2];
  Alph := AlphabetOfFRObject(a);
  Alph_num := [1..Size(Alph)];
  action := Vertices[v].action;
  read_path := readwrite_path[1];
  write_path := readwrite_path[2];
  action_path := readwrite_path[3];
  if v in Seen then
   m := Size(Orbit(Group(a),read_path));

   Conj_Tran:= [];
   Conj_act := [];
   circle_length:=Size(Seen)-Position(Seen,v)+1;
   check_need := false;
   for i in [Position(Seen,v)..Size(Seen)] do
    alph := Vertices[Seen[i]].conj_pair[1];
    beta := Vertices[Seen[i]].conj_pair[2];
    read:=read_path[i];
    write:=write_path[i];
    orb_size:= Size(Orbit(Group(alph),read));
    Conj_elm :=[];
    for x in Alph_num do
     Conj_elm[x]:=[];
    od;
    if not orb_size = Size(Alph) then  #Here some extra work, search for a conjugator for the non determined states, there may be more than one.
     x:= read;
     #Get a representative for the orbits
     X:=Difference(Alph,Orbit(Group(alph),x));
     while Size(X)>0 do 
      x := Minimum(X);    
      sons := [];
      for e in Edges do
       if e.from = v and e.read = x then
        Add(sons,e.to);
       fi;
      od;
      New_Seen := Seen{[1..i]};
      son_conjs:= [];
      #Here there is already one circle, so the other states have to be finitary
      for son in sons do
        Conjs :=CONJUGATORS_FINITARY_WRAPPER@(son,Graph,New_Seen,Known_vertex_conjugator);
        Append(son_conjs,Conjs);
      od;  
      for son_conj in son_conjs do
       for j in [0..Size(Orbit(Group(alph),x))-1] do 
        Add(Conj_elm[Position(Alph,x^(alph^j))],[(State(alph^j,x))^-1*son_conj*State(beta^j,x^action_path[i])]); 
       od;
      od;
      X:=Difference(X,Orbit(Group(alph),x)); #next orbit
     od;
    fi;
    Conj_elm[Position(Alph,read)]:= [[(i mod circle_length) +1]];
    for j in [1..orb_size-1] do
     Conj_elm[Position(Alph,read^(alph^j))] := [[(State(alph^j,read))^-1,Conj_elm[Position(Alph,read)][1][1],State(beta^j,write)]];
     #This may be not bounded, so check it later.
     check_need := true;
    od;
    #Remove duplicates in
    for x in Alph_num do
     Conj_elm[x] := Set(Conj_elm[x]);
    od;
    Conj_elm := DEP_CARTESIAN@(Conj_elm,Orbits(Group(alph),Alph)); #puzzle the conjugators together
    Add(Conj_act,action_path[i]);
    Add(Conj_Tran,Conj_elm);
   od;
   Conjs := [];
   for Conj_Tran_el in Cartesian(Conj_Tran) do
    conj_cand := FRElement(Conj_Tran_el,Conj_act,[1]);
    if check_need then
     if IsBoundedFRElement(conj_cand) then
      check_need := false;
     fi;
    fi;
    if not check_need then
     if IsBound(Known_vertex_conjugator[v]) then
      Add(Known_vertex_conjugator[v],conj_cand);
     else
      Known_vertex_conjugator[v] := [conj_cand];
     fi;
     Add(Conjs,conj_cand);
    fi;
   od;
   return Conjs;

  fi;
  sons := [];
  for e in Edges do
   if e.from = v then
    Add(sons,[e.to,e.read]);
   fi;
  od;
  real_conjugators := [];
  conj_cand := EmptyPlist(Size(Alph));
  for x in Alph do
   conj_cand[x] := [];
  od;
  conjugators_found := [];
 
  for son in sons do
   NewSeen := ShallowCopy(Seen);
   Add(NewSeen,v);
   New_read_path := ShallowCopy(read_path);
   Add(New_read_path,son[2]);
   New_write_path := ShallowCopy(write_path);
   Add(New_write_path,son[2]^action);
   New_action_path := ShallowCopy(action_path);
   Add(New_action_path,action);
    
   son_conjs := CONJUGATORS_BOUNDED_REK(son[1],Graph,NewSeen,[New_read_path,New_write_path,New_action_path],Known_vertex_conjugator);
   for son_conj in son_conjs do
   son_orbit_size := Size(Orbit(Group(a),son[2]));
    for j in [0..son_orbit_size-1] do
     Add(conj_cand[son[2]^(a^j)],[(State(a^j,son[2]))^(-1) * son_conj * State(b^j,son[2]^action)]);
     conjugators_found[son[2]^(a^j)] := 1;
    od;
   od;
  od;
  #Test if we have enough partial conjugators
  if IsDenseList(conjugators_found) and Size(conjugators_found) = Size(Alph) then
   #puzzle them together! 
   Conjs := DEP_CARTESIAN@(conj_cand,Orbits(Group(a),Alph));
   for con in Conjs do
    Add(real_conjugators,FRElement([con],[action],[1]));
   od;
  fi;
  Known_vertex_conjugator[v] := real_conjugators;
  return real_conjugators;
 end;
 return CONJUGATORS_BOUNDED_REK(v,Graph,Seen,readwrite_path,Known_vertex_conjugator);
end);
##################################################################
# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%#
# %%%%%%%%%%%%%%%%%%%%      IsConjugate        %%%%%%%%%%%%%%%%%%%#
# %%%%%%%%%%%%%%%%%%%%  RepresentativeActionOp %%%%%%%%%%%%%%%%%%%#
# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%#
##################################################################
InstallMethod(IsConjugate,
 "For Aut, RAut, FAut, Poly-1, Poly0",
 #The attribute FullSCVertex charakterizes all FullSCGroups
 [ IsFRGroup and HasFullSCVertex,IsFRElement,IsFRElement], 
  function(G,a,b)
   local v, Graph, sons, starts;
   if AlphabetOfFRSemigroup(G) <> AlphabetOfFRObject(a) or AlphabetOfFRSemigroup(G) <> AlphabetOfFRObject(b) then
    return false;
   fi;
   if a = b then #Spare Computing Time in trivial case.
    return true; 
   fi; 
   Graph := CONJUGATOR_GRAPH@(a,b);
   if FullSCFilter(G) = IsFRElement or FullSCFilter(G) = IsFiniteStateFRElement then
  #In this cases the conjugacy problems are equivalent,
  #----------------------FiniteState-----------------;
  #------------------FunctionalRecursive-------------;
   for v in Graph[1] do
    if v.conj_pair = [a,b] then;
     return true;
    fi;
   od;
   return false;
  elif FullSCFilter(G) = IsFinitaryFRElement then
  #----------------------Finitary--------------------;
   starts := [];
   for v in Graph[1] do
    if v.conj_pair = [a,b] then
     Add(starts,v.id);
    fi;
   od;
   for v in starts do;
    if Size(CONJUGATORS_FINITARY_WRAPPER@(v,Graph,[],[]))>0 then
     return true;
    fi;
   od;
   return false; 
  elif FullSCFilter(G) = IsBoundedFRElement then
  #----------------------Bounded---------------------;  
   starts := [];
   for v in Graph[1] do
    if v.conj_pair = [a,b] then
     Add(starts,v.id);
    fi;
   od;
   for v in starts do
    if Size(CONJUGATORS_BOUNDED_WRAPPER@(v,Graph,[],[[],[],[]],[]))>0 then
     return true;
    fi;
   od;
   return false;
  else
  #----------------------Else------------------------; 
   TryNextMethod();
  fi;
  end
);

InstallOtherMethod(RepresentativeActionOp,
 "Computes a conjugator in the given FullSCGroup ",
 #The attribute FullSCVertex charakterizes all FullSCGroups
 [ IsFRGroup and HasFullSCVertex,IsFRElement,IsFRElement], 
 function(G,a,b)
   local CG, v, start, Conjugators;
   if AlphabetOfFRSemigroup(G) <> AlphabetOfFRObject(a) or AlphabetOfFRSemigroup(G) <> AlphabetOfFRObject(b) then
    return fail;
   fi;
   if a=b then
    return One(G); 
   fi;
   CG := CONJUGATOR_GRAPH@(a,b);
   if FullSCFilter(G) = IsFRElement or FullSCFilter(G) = IsFiniteStateFRElement then
  #In this cases the conjugacy problems are equivalent,
  #----------------------FiniteState-----------------;
  #------------------FunctionalRecursive-------------;
   for v in CG[1] do
    if v.conj_pair = [a,b] then;
     start := v;
     break;
    fi;
   od;
   if not IsBound(start) then
    return fail;
   fi;
   return CONJUGATORS_FINITE_STATE_WRAPPER@(start,CG);
  elif FullSCFilter(G) = IsFinitaryFRElement then
  #----------------------Finitary--------------------;
   start := [];
   for v in CG[1] do
    if v.conj_pair = [a,b] then
     Add(start,v.id);
    fi;
   od;
   for v in start do
    Conjugators :=CONJUGATORS_FINITARY_WRAPPER@(v,CG,[],[]);
    if Size(Conjugators)>0 then
     return Conjugators[1];
    fi;
   od;
   return fail;  
  elif FullSCFilter(G) = IsBoundedFRElement then
  #----------------------Bounded---------------------;  
   start := [];
   for v in CG[1] do
    if v.conj_pair = [a,b] then
     Add(start,v.id);
    fi;
   od;
   for v in start do
    Conjugators :=CONJUGATORS_BOUNDED_WRAPPER@(v,CG,[],[[],[],[]],[]);
    if Size(Conjugators)>0 then
     return Conjugators[1];
    fi;
   od;
   return fail;
  else
  #----------------------Else------------------------; 
   TryNextMethod();
  fi;
  end);
#****************************************************************
################################################################*
################################################################*
###############                               ##################*
###############  Algorithm for branch groups  ##################*
###############                               ##################*
################################################################*
################################################################* 
#****************************************************************


#---------------------------------------------------------------
#------      InitConjugateForBranchGroups      -----------------
#--   Sets the Precomputed initial data for the branch    ---
#--  Algorithm. Stores this data for later computations.     ---   
#---------------------------------------------------------------

InstallMethod(FRBranchGroupConjugacyData,
 [ IsFRGroup ], 
  function(G)
   local init, N, g, h, b, CT, c, i;
   Info(InfoFR, 1, "Init FRBranchGroupConjugacyData");
  init := rec(initial_conj_dic:=NewDictionary([One(G),One(G)],true),
        Branchstructure:=BranchStructure(G),
        RepSystem:=List(~.Branchstructure.group,x->PreImagesRepresentativeNC(~.Branchstructure.quo,x)));
  N := TORSIONNUCLEUS@(G);
  if N = fail then return fail;fi;
  SEARCH@.INIT(G);
  for g in N do
   for h in N do
    #Find one conjugator b
    repeat 
      b := SEARCH@.CONJUGATE(G,g,h);
      while b=fail and SEARCH@.EXTEND(G)=fail do
            SEARCH@.ERROR(G,"RepresentativeAction");
         od;
         Info(InfoFR, 3, "RepresentativeAction: searching at level ",G!.FRData.level," and in sphere of radius ",G!.FRData.radius);
        until b<>fail;
      CT := []; #The Conjugator tuple
      if b <> false then
       i := 1;
       for c in init.Branchstructure.group do
        repeat
           b := SEARCH@.CONJUGATE_COSET(G,c,g,h);
         while b=fail and SEARCH@.EXTEND(G)=fail do
            SEARCH@.ERROR(G,"RepresentativeAction");
         od;
        until b<>fail;
        if b <> false then
       CT[i] := b;
      fi;
      i := i+1;
     od;
      fi;
    AddDictionary(init.initial_conj_dic,[g,h],CT);
   od;
  od;
  Info(InfoFR, 1, "Finished Init FRBranchGroupConjugacyData");
  return init;
  end);
##################################################################
#````````````````````````````````````````````````````````````````#
#`````````````````````                  `````````````````````````#
#`````````````````````   Branch Worker  `````````````````````````#
#`````````````````````                  `````````````````````````#
#````````````````````````````````````````````````````````````````#
################################################################## 
BindGlobal("CONJUGATORS_BRANCH@",function(G,g,h)
 local CP_init, Start, B, BS, Con_dic, saved_quo, quo, Alph, Conjugators_branch_rek,l,k,rek_count;
 CP_init := FRBranchGroupConjugacyData(G);
 if CP_init = fail then
  return fail;
 fi;
 BS := CP_init.Branchstructure;
 B := List(BS.group);
 Con_dic := CP_init.initial_conj_dic;
 saved_quo := NewDictionary(One(G),true);
 quo := function(elm) #Calculate only if asked for.
  local q;
  if not KnowsDictionary(saved_quo,elm) then
   Info(InfoFR,4,"Computing elm^BS.quo. May take some time...");
   q := elm^BS.quo;
   Info(InfoFR,4,"Finished");
   AddDictionary(saved_quo,elm,q);
   return q;
  fi;
  return LookupDictionary(saved_quo,elm);
 end;
 if g = h then
  return [One(g)];
 fi;
 Alph := AlphabetOfFRSemigroup(G);
 rek_count := 1;
 Conjugators_branch_rek := function(g,h)
  local L,LC,C,orbits,orb_repr,p,L_Pos,dep,L_PosC,Pos_Con,c,CT,Con,i,j;
  if not HasName(g) then
   SetName(g,Concatenation("g_",String(rek_count)));
  fi;
  if not HasName(h) then
   SetName(h,Concatenation("h_",String(rek_count)));
  fi; 
  rek_count := rek_count +1;
  Info(InfoFR,3,"Computing g,h=",Name(g),",",Name(h),"");
  if IsOne(g) or IsOne(h) then
   if g = h then
    Info(InfoFR,3,"Computing g,h=",Name(g),",",Name(h),"     g=h=1 So return B");
    return CP_init.RepSystem;
   else
    Info(InfoFR,3,"Computing g,h=",Name(g),",",Name(h),"     g,h is One but the other not. So return []");
    return [];
   fi;
  fi;
  if KnowsDictionary(Con_dic,[g,h]) then
   Info(InfoFR,3,"Computing g,h=",Name(g),",",Name(h),"     g,h are already known. So return them]");
   return LookupDictionary(Con_dic,[g,h]);
  fi;
  orbits := List(Orbits(Group(g),Alph),SortedList);
  orb_repr := List(orbits,Minimum);
  CT := []; # Resulting Conjugator Tuple
  Info(InfoFR,3,"Computing g,h=",Name(g),",",Name(h),"     Orbit: ",orbits);
  for p in LEVEL_PERM_CONJ@(g,h,BS.top) do
   Info(InfoFR,3,"Computing g,h=",Name(g),",",Name(h),"     Try a conjugator with activity ",p);
   L := [];
   L_Pos := []; #Stores the position at which the conjugator tuples are defined.
   dep := []; #Stores the dependencies
   for i in [1..Length(orb_repr)] do
    C := Conjugators_branch_rek(State(g^Length(orbits[i]),orb_repr[i]),State(h^Length(orbits[i]),orb_repr[i]^p));
    if Length(C)=0 then #not a valid conjugator
     L:=[];
     break;
    fi;
    for j in [0..Length(orbits[i])-1] do
     LC := [];
     L_PosC := [];
     for k in [1..Length(C)] do
      if IsBound(C[k]) then
       LC[k] := [State(g^j,orb_repr[i])^-1,C[k],State(h^j,orb_repr[i]^p)];
       L_PosC[k] := k;
      fi;
     od;
     L[orb_repr[i]^(g^j)]:=LC ; 
     L_Pos[orb_repr[i]^(g^j)]:=L_PosC; 
    od;
    Add(dep,orbits[i]);
   od; 
   if Size(L)>0 then
    Con := DEP_CARTESIAN@(L,dep);
    Pos_Con := DEP_CARTESIAN@(L_Pos,dep);
    for i in [1..Size(Con)] do #Now possable Conjugators.
     c:= Product([1..Size(Pos_Con[i])],x->(quo(Con[i][x][1])*B[Pos_Con[i][x]]*quo(Con[i][x][3]))^Embedding(BS.wreath,x));
     c:= (c*p^Embedding(BS.wreath,Size(Alph)+1))^BS.epi;; 
     if c <> fail then #Con is a valid element with representative c;
      Info(InfoFR,3,"Computing g,h=",Name(g),",",Name(h),"     Conjugator found. Add to conjugator tuple ");
      CT[Position(B,c)] := MEALY_FROM_STATES@(Con[i],p);
      #CT[Position(B,c)] := FRElement([Con[i]],[p],[1]);
     fi;
    od; 
   fi;
  od;
  AddDictionary(Con_dic,[g,h],CT); #Save work in case is it again asked for a CT for (g,h).
  return CT;    
 end;
 return Conjugators_branch_rek(g,h);
end);

##################################################################
# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%#
# %%%%%%%%%%%%%%%%%%%      IsConjugate         %%%%%%%%%%%%%%%%%%%#
# %%%%%%%%%%%%%%%%%%% RepresentativeActionOp  %%%%%%%%%%%%%%%%%%%#
# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%#
##################################################################
InstallOtherMethod(RepresentativeActionOp,
 "Computes a conjugator in the given Branch group ",
 [ IsBranched and IsFinitelyGeneratedGroup,IsFRElement,IsFRElement,IsFunction], 
 function(G,g,h,f)
  local con;
  if f <> OnPoints then TryNextMethod(); fi;
  Info(InfoFR,2,"Try method for branch groups.");
  con := CONJUGATORS_BRANCH@(G,g,h);
  if con <> fail then
   if Size(con)>0 then
    return Representative(con);
   fi;
   return fail;
  fi;
  Info(InfoFR,2,"Doesn't work. Try next...");
  TryNextMethod();
  end);
InstallMethod(IsConjugate,
 "For Branch Groups",
 [ IsBranched and IsFinitelyGeneratedGroup,IsFRElement,IsFRElement], 
  function(G,g,h)
   local con;
  Info(InfoFR,2,"Try method for branch groups.");
   con := CONJUGATORS_BRANCH@(G,g,h);
  if con <> fail then
   if Size(con)>0 then
    return true;
   fi;
   return false;
  fi;
  Info(InfoFR,2,"Doesn't work. Try next...");
  TryNextMethod();
  end); 


#############################Example##############################
####        Setting the Branch Data           ###
####   for GrigorchukGroup and GuptaSidkiGroup        ###
#SetFRBranchGroupConjugacyData(GrigorchukGroup,
#  rec( initial_conj_dic:=NewDictionary([One(GrigorchukGroup),One(GrigorchukGroup)],true),
#    Branchstructure:=BranchStructure(GrigorchukGroup),
#    RepSystem:=List(~.Branchstructure.group,x->PreImagesRepresentativeNC(~.Branchstructure.quo,x)))
#  );
#CallFuncList(function(a,b,c,d) 
#       local G,D,g,h;
#       G:= GrigorchukGroup;
#       D:= FRBranchGroupConjugacyData(G).initial_conj_dic;
#       for g in [a,b,c,d] do
#        for h in [a,b,c,d] do
#         if g<>h then
#          AddDictionary(D,[g,h],[]);
#         fi;
#        od;
#       od;
#       AddDictionary(D,[a,a],[One(G),a,d*a*d,a*d*a*d]);
#       AddDictionary(D,[b,b],[One(G),,,, b,,,,c,,,,d]);
#       AddDictionary(D,[c,c],[One(G),,,, b,,,,c,,,,d]);
#       AddDictionary(D,[d,d],[One(G),,,a*d*a*d,b,,,b*a*d*a*d,c,,,b*a*d*a,d,,,a*d*a]);
#      end,GeneratorsOfGroup(GrigorchukGroup)
#  );
  
#SetFRBranchGroupConjugacyData(GuptaSidkiGroup,
#  rec( initial_conj_dic:=NewDictionary([One(GuptaSidkiGroup),One(GuptaSidkiGroup)],true),
#    Branchstructure:=BranchStructure(GuptaSidkiGroup),
#    RepSystem:=List(~.Branchstructure.group,x->PreImagesRepresentativeNC(~.Branchstructure.quo,x)))
#  );
#CallFuncList(function(a,t) 
#       local G,D,g,h;
#       G:= GuptaSidkiGroup;
#       D:= FRBranchGroupConjugacyData(G).initial_conj_dic;
#       for g in [a,a^2,t,t^2] do
#        for h in [a,a^2,t,t^2] do
#         if g<>h then
#          AddDictionary(D,[g,h],[]);
#         fi;
#        od;
#       od;
#       AddDictionary(D,[a,a],[One(G),a,a^2]);
#       AddDictionary(D,[a^2,a^2],[One(G),a,a^2]);
#       AddDictionary(D,[t,t],[One(G),,,t,,,t^2]);
#       AddDictionary(D,[t^2,t^2],[One(G),,,t,,,t^2]);
#      end,GeneratorsOfGroup(GuptaSidkiGroup)
#  );
#****************************************************************
################################################################*
################################################################*
###############                               ##################*
###############     Algorithm for the         ##################*
###############       GrigorchukGroup         ##################*
################################################################*
################################################################* 
#****************************************************************
BindGlobal("GRIG_CON@",function(G,g,h)
local f,gw,hw,Gen,a, b, c, d, Fam, aw, dw, ae, be, ce, de, Alph, x_1, x_2, K_repr, K_repr_words, D, ConTup_a, Check, alternating_a_form, shorten_word, compute_conjugates, compute_conjugates_of_word, L_Decomp, Compute_K_rep, L_word_to_Grig, Merge_Ls, conjugators_grig_rek, Res, r, Join_to_first;

############   Spare Computing Time in trivial case.     #########
  if AlphabetOfFRSemigroup(G) <> AlphabetOfFRObject(g) or AlphabetOfFRSemigroup(G) <> AlphabetOfFRObject(h) then
  return fail;
 fi;
 if g = h then 
  return One(G); 
 fi; 
############       (Local) GLOBALS           #####################
 f := EpimorphismFromFreeGroup(G);
 gw:=PreImagesRepresentativeNC(f,g);
 hw:=PreImagesRepresentativeNC(f,h);
 
 Gen := GeneratorsOfGroup(G);
 a:= Position(Gen,MealyElement([[4,2],[4,3],[5,1],[5,5],[5,5]],[(),(),(),(1,2),()],4)); 
 b:= Position(Gen,MealyElement([[4,2],[4,3],[5,1],[5,5],[5,5]],[(),(),(),(1,2),()],1)); 
 c:= Position(Gen,MealyElement([[4,2],[4,3],[5,1],[5,5],[5,5]],[(),(),(),(1,2),()],2)); 
 d:= Position(Gen,MealyElement([[4,2],[4,3],[5,1],[5,5],[5,5]],[(),(),(),(1,2),()],3)); 
 Fam := FamilyObj(gw);  
##################################################################
 aw :=AssocWordByLetterRep(Fam,[a]);  
 dw :=AssocWordByLetterRep(Fam,[d]);
 ae := ImageElm(f,AssocWordByLetterRep(Fam,[a]));
 be := ImageElm(f,AssocWordByLetterRep(Fam,[b]));
 ce := ImageElm(f,AssocWordByLetterRep(Fam,[c]));
 de := ImageElm(f,AssocWordByLetterRep(Fam,[d]));
 Alph:=AlphabetOfFRObject(g);
 x_1 := Alph[1];
 x_2 := Alph[2];

#Precomputed K-representatives:
#[[],a,ad,ada,adad,adada,adadada,adadada,b,ba,bad,bada,badad,badada,badadad,badadada]
 K_repr := [[],[a],[a,d],[a,d,a],[a,d,a,d],[a,d,a,d,a],[a,d,a,d,a,d],[a,d,a,d,a,d,a],[b],[b,a],[b,a,d],[b,a,d,a],[b,a,d,a,d],[b,a,d,a,d,a],[b,a,d,a,d,a,d],[b,a,d,a,d,a,d,a]];
 K_repr_words := List(K_repr,x->AssocWordByLetterRep(Fam,x));
 
 #Precomputed words, which decompose to the K_repr.: <K_repr[i]·l,f(K_repr[i])·l'> = D[i]·<l,l'>
 D:= List([[],[c],[c,a,c,a],[c,a,c,a,c],[c,a,c,a,c,a,c,a],[c,a,c,a,c,a,c,a,c],[c,a,c,a,c,a,c,a,c,a,c,a],[c,a,c,a,c,a,c,a,c,a,c,a,c],[a,d,a],[a,d,a,c],[a,d,a,c,a,c,a],[a,d,a,c,a,c,a,c],[a,d,a,c,a,c,a,c,a,c,a],[a,d,a,c,a,c,a,c,a,c,a,c],[a,d,a,c,a,c,a,c,a,c,a,c,a,c,a],[a,d,a,c,a,c,a,c,a,c,a,c,a,c,a,c]],x->AssocWordByLetterRep(Fam,x));
# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# %%%%%%%%%%%%%%%%%%        Functions       %%%%%%%%%%%%%%%%%%%%%%%
# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
 
 #TeporaryDebug function to locate possable errors.
 Check := function(s,g,h,C)
  local c;
  if InfoLevel(InfoFR)>2 then
   for c in C do
    if g^c <> h then
     Info(InfoFR,2,"Error at ",s);
     Info(InfoFR,3,"Error happened here: g=",g,", and h=",h,", and Conjugator c=",c," number: ",Position(C,c),"in ",C);
     return fail;
    fi;
   od;
  fi;
  return true;
 end;
 
# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# %%%%%%%%%%%%%%%%%%%%     Magic on words     %%%%%%%%%%%%%%%%%%%%%
# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 

 #Given a word w in Generators of Grig, computes the form w= (a) x1 a x2 a x3… where xi in b,c,d
 alternating_a_form := function(w)
  local i,L,red_L,change,last,last_ind;
  red_L:=List(LetterRepAssocWord(w),AbsInt);
  change := true;
  while (change) do
   change := false;
   last := 5; #not a possable generator
   last_ind := -1;
   for i in [1..Size(red_L)] do
    if IsBound(red_L[i]) then
     if red_L[i]=last then #all generators are of order two
      Unbind(red_L[i]);
      Unbind(red_L[last_ind]);
      last:=5;
      last_ind:=-1;
      change:= true;
     else 
      L := [b,c,d];
      if (not last in [a,5]) and red_L[i] in L then
       Remove(L,Position(L,last));
       Remove(L,Position(L,red_L[i]));
       red_L[last_ind] := L[1]; #bc=cb=d, bd=db=c, cd=dc=b
       last := L[1];
       Unbind(red_L[i]);
       change := true;
      else
       last:=red_L[i];
       last_ind:=i;
      fi;
     fi;
    fi; 
   od;
  od;
  #Fill the gaps
  L:= [];
  for i in red_L do
   Add(L,i);
  od;
  return AssocWordByLetterRep(FamilyObj(w),L);
 end;
#-----------------------------------------------------------------

 #Shortens a given Letter-word over Generators of L by killing all instances of x,-x and 1,1 and 2,2, -1,-1,-2,-2
 shorten_word := function(w) 
  local change, last_pos, l, new_w;
  change := true;
  last_pos := Size(w)+1;
  w[last_pos] := 0;
  while change do
   last_pos := Size(w);
   change := false;
   for l in [1..Size(w)-1] do 
    if IsBound(w[l]) then
     if w[l] = -1*(w[last_pos]) or (w[l]= w[last_pos] and w[l] in [-2,-1,1,2]) then
      change := true;
      Unbind(w[l]);
      Unbind(w[last_pos]);
      last_pos := Size(w);
     else
      last_pos := l;
     fi;
    fi;
   od;
  od;
  new_w:=[];
  for l in w do  
   Add(new_w,l);
  od;
  return new_w{[1..Size(new_w)-1]};
 end;
#-----------------------------------------------------------------
 #Given a generator gen of L and a Letter-word w in Grig, computes the gen^w in generators of L
 compute_conjugates := function(gen,w) 
  local gen_conjugates, Gen, x, g, L;
  #Precomputed list gen_conjugates[x][y] is x^y as word in L_gen
  #where L_gen = [[b],[a,b,a],[b,a,d,a,b,a,d,a],[a,b,a,d,a,b,a,d]];
  #and y in [b,c,d,a]
  gen_conjugates := [];
  gen_conjugates[1]  := [];
  gen_conjugates[1][a] := [2];
  gen_conjugates[1][b] := [1];
  gen_conjugates[1][c] := [1];
  gen_conjugates[1][d] := [1];
  
  gen_conjugates[2]  := [];
  gen_conjugates[2][a] := [1];
  gen_conjugates[2][b] := [1,2,1];
  gen_conjugates[2][c] := [1,-4,2,1];
  gen_conjugates[2][d] := [-4,2];
  
  gen_conjugates[3]  := [];
  gen_conjugates[3][a] := [4];
  gen_conjugates[3][b] := [1,3,1];
  gen_conjugates[3][c] := [-3];
  gen_conjugates[3][d] := [1,-3,1];
  
  gen_conjugates[4]  := [];
  gen_conjugates[4][a] := [3];
  gen_conjugates[4][b] := [1,4,1];
  gen_conjugates[4][c] := [1,-4,1];
  gen_conjugates[4][d] := [-4];
  
  #gen_conjugates := [[[1],[1],[1],[2]],
  #          [[1,2,1],[1,-4,2,1],[-4,2],[1]],
  #          [[1,3,1],[-3],[1,-3,1],[4]],
  #          [[1,4,1],[1,-4,1],[-4],[3]]];
  Gen := [gen];
  for x in w do
   L:= [];
   for g in Gen do
    if g<0 then
     Append(L,List(Reversed(gen_conjugates[-1*g][x]),y->-1*y));
    else 
     Append(L,gen_conjugates[g][x]);
    fi;
   od;
   Gen := shorten_word(L);
  od;
  return Gen;
 end;
#-----------------------------------------------------------------
 #Given a Letter-word w over G and a Letter-word v over L_Gen returns v^w as word over L_Gen.
 compute_conjugates_of_word := function(v,w)
  local con, x;
  con := [];
  for x in v do
   Append(con,compute_conjugates(x,w));
  od;
  return con;
 end;
#-----------------------------------------------------------------
 #Given a word w in Generators of Grig computes a unique representative of w·L and the corresponding word in Letters
 #of generators of L. 
 #The resulting representative is an element of K_repr_words{[1..8]}
 L_Decomp := function(w)
  local l_elm,l_elm_compl,k,l,i,L,red_L,new_L,change,gen_conjugates;
  w:=alternating_a_form(w);
  l_elm := []; #Will contain tuples [v,w,...] meaning l = ...b^w·b^v
  #L_gen := [[b],[a,b,a],[b,a,d,a,b,a,d,a],[a,b,a,d,a,b,a,d]];
  change := true;
  while change do
   change := false;
   new_L := [];
   red_L:=List(LetterRepAssocWord(w),AbsInt);
   for i in Reversed([1..Size(red_L)]) do
    if red_L[i] = b then
     change := true;
     Add(l_elm,Reversed(new_L));
    elif red_L[i] = c then
     change := true;
     Add(l_elm,Reversed(new_L));
     Add(new_L,d);
    else 
     Add(new_L,red_L[i]);
    fi;
   od;
   new_L := Reversed(new_L);
   w := alternating_a_form(AssocWordByLetterRep(Fam,new_L));
  od;
  l_elm_compl := [];
  for l in Reversed(l_elm) do
   Append(l_elm_compl,compute_conjugates(1,l));
  od;
  #Force the form unique beginning with a.
  if Length(w)>7 then 
   w:=Subword(w,1,Length(w) mod 8);
  fi;
  if Length(w)>0 and Subword(w,1,1) = AssocWordByLetterRep(Fam,[d]) then
   w := Subword(AssocWordByLetterRep(Fam,[a,d,a,d,a,d,a,d]),1,8-Length(w));
  fi;
  return [w,shorten_word(l_elm_compl)];
 end;
#-----------------------------------------------------------------
 #Given a word w in Generators of Grig computes a unique represantative of w·K.
 #The result is an element of K_repr_words
 Compute_K_rep := function(w)
  local l,L,red_L,new_L,change,nb,b_exist;
  w:=alternating_a_form(w);
  change := true;
  while change do
   change := false;
   new_L := [];
   #In Grig all generators are selfinverse.
   red_L:=List(LetterRepAssocWord(w),AbsInt);
   nb := 0; #Stores the number of b's occuring
   for l in red_L do
    if l = b then
     nb := nb +1;
    elif l = c then
     nb := nb +1;
     Add(new_L,d);
    else 
     Add(new_L,l);
    fi;
   od;
   w := alternating_a_form(AssocWordByLetterRep(Fam,new_L));
   if IsOddInt(nb) then
    w := AssocWordByLetterRep(Fam,[b])*w;
    b_exist := true;
   else 
    b_exist := false;
   fi;
  od;
  #Force the word to begin with a (after the possable b) to gain a unique form. 
  if b_exist then
   w := Subword(w,2,Length(w));
  fi;
  if Length(w)>7 then 
   w:=Subword(w,1,Length(w) mod 8);
  fi;
  if Length(w)>0 and Subword(w,1,1) = AssocWordByLetterRep(Fam,[d]) then
   w := Subword(AssocWordByLetterRep(Fam,[a,d,a,d,a,d,a,d]),1,8-Length(w));
  fi;
  if b_exist then
   w := AssocWordByLetterRep(Fam,[b])*w;
  fi;
  return w;
 end;
#-----------------------------------------------------------------
 #Given a Letter-word w in L_gen computes a Letter-word res in [a,b,c,d] such that <w,1>=res in Grig.
 L_word_to_Grig := function(w)
  local Pre,Res,x;
  #Precomputed set:
  Pre := [[a,d,a],[b,a,d,a,b],[c,b,a,d,a,b,a,c,a,b,a,d,a,b,a,c,a,c],[b,a,d,a,b,a,c,a,b,a,d,a,b,a,c,a]];
  Res := [];
  for x in w do
   if x<0 then
    Append(Res,Reversed(Pre[-1*x]));
   else
    Append(Res,Pre[x]);
   fi;
  od;
  return Res;
 end;

# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# %%%%%%%%%%%%%%%%%   Helping Functions    %%%%%%%%%%%%%%%%%%%%%%%%
# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
 #Computes the conjugator tuple for the pair (g,a): 
 ConTup_a := function (g)
  local g1_modL,l,Allowed_reps,Connected_conjs,con_at_1,con_word,con,Centr_a,Con_tuple;
  if IsOne(Activity(g)) then
   return [];
  fi;
  if not IsOne(State(g,1)*State(g,2)) then
   return [];
  fi;
  #L_gen := [[b],[a,b,a],[b,a,d,a,b,a,d,a],[a,b,a,d,a,b,a,d]];
  g1_modL:=L_Decomp(PreImagesRepresentativeNC(f,State(g,1))); 
  l:=g1_modL[2];
  g1_modL:=LetterRepAssocWord(g1_modL[1]);
  #See Lemma lem:conjugators_of_a for Details
  Allowed_reps:= [[],[a,d],[a,d,a,d,a,d],[a,d,a,d]];
  if not g1_modL in Allowed_reps then
   return [];
  fi;
  #See Lemma lem:conjugators_of_a for the appix conjugator
  Connected_conjs := [[],[c],[a,c],[c,a,c]];
  con := Connected_conjs[Position(Allowed_reps,g1_modL)];
  #resulting conjugator is of the form <l^((g_1modL^-1)),1>·con
  con_at_1 := compute_conjugates_of_word(l,Reversed(g1_modL));
  con_word := L_word_to_Grig(con_at_1);
  Append(con_word,con);
  Info(InfoFR,4,"Conjugator in gen_L: <",con_at_1,",1>",con,"\nConjugator in gen_Grig: ",con_word,"\n");
  #Determine Cosets of K in which the conjugator lies.
  #See Roskov CP Lemma3 for centralizer of a
  Centr_a := List([[],[a],[a,d,a,d],[a,d,a,d,a]],x -> AssocWordByLetterRep(Fam,Concatenation(con_word,x)));
  Con_tuple:= [];
  for con in Centr_a do
   Con_tuple[Position(K_repr,LetterRepAssocWord(Compute_K_rep(con)))] := ImageElm(f,con);
  od; 
  Check("ConTup_a",g,ae,Con_tuple);
  return Con_tuple;
 end; 
 #Finds all Elements <l1,l2> with <l1,l2> in Grig, for l1 in L1, l2 in L2 and return result as Conjugator tuple.
 Merge_Ls := function(L1,L2,with_action)
  local aw_w,aw_t,dw_w,res_Con,i,x; 
  aw_w := One(aw);
  aw_t := ();
  dw_w := One(dw);
  if with_action then
   aw_w := aw;
   aw_t := (x_1,x_2);
  fi;
  Info(InfoFR,4,"Computing ",g,",",h,"  Sub Conjugators: ",L1,"\n");
  Info(InfoFR,4,"Computing ",g,",",h,"  Sub Conjugators: ",L2,"\n");
  #See Lemma 6.16 for <g1,g2<in Grig,  <=> g1=v(a,d)l g2=v(d,a)l
  #So <K_repr[i],K_repr[j]> in Grig  <=> j in [17-x mod 16 +1, 25-x mod 16 +1]
  res_Con := [];
  for i in [1..16] do
   if IsBound(L1[i]) then
    #Find second entry:
    for x in [((17-i) mod 16) +1,((25-i) mod 16) +1] do
     if IsBound(L2[x]) then
      if x>8 then
       dw_w := dw;
      else
       dw_w := One(dw);
      fi;
      Info(InfoFR,4,"Computing ",g,",",h,"  Conjugator found:",i,",",x,"\n");
      if L1[i]=ImageElm(f,K_repr_words[i]) and L2[x]=ImageElm(f,K_repr_words[x]) then
       res_Con[Position(K_repr_words,Compute_K_rep(dw_w*D[i]*aw_w))] := ImageElm(f,dw_w*D[i]*aw_w);
      else #Could always compute the words as generators, but seems uneccassary
       res_Con[Position(K_repr_words,Compute_K_rep(dw_w*D[i]*aw_w))] := MEALY_FROM_STATES@([L1[i],L2[x]],aw_t);
      fi;
     fi;
    od;
   fi;
  od;
  return res_Con;
 end;
 #Joins two Lists in the first with overwriting eventually existing values.
 Join_to_first := function(L,K)
  local i;
  for i in [1..Length(K)] do
   if IsBound(K[i]) then
    L[i] := K[i];
   fi;
  od;
 end;  
# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# %%%%%%%%%%%%%%%%%%     Main Computor      %%%%%%%%%%%%%%%%%%%%%%%
# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 conjugators_grig_rek := function(g,h)
  local Centr_bc, Centr_d, L1, L1_temp, L2, res_Con, g1, h1, x ,y;
  Info(InfoFR,3,"Compute Conjugator for pair: ",g,",",h,".\n");
  if Activity(g) <> Activity(h) then
   return [];
  fi;
  #-#-#-#-#-#-#-#-#-#-#-#-   g = identity   -#-#-#-#-#-#-#-#-#-#
  if IsOne(g) then
   if IsOne(h) then
    return List(K_repr,x -> ImageElm(f,AssocWordByLetterRep(Fam,x)));
   fi;
    return [];
  fi;
  #-#-#-#-#-#-#-#-#-#-#-   g in a,b,c,d    -#-#-#-#-#-#-#-#-#-#
  if g in [be,ce] then
   if h=g then
    Centr_bc := [[],,,,,,,[a,d,a,d,a,d,a],[b],,,,,,,[b,a,d,a,d,a,d,a]];
    return List(Centr_bc,x -> ImageElm(f,AssocWordByLetterRep(Fam,x)));
   fi;
  fi;
  if g = de then
   if h=g then
    Centr_d := [[],,,[a,d,a],[a,d,a,d],,,[a,d,a,d,a,d,a],[b],,,[b,a,d,a],[b,a,d,a,d],,,[b,a,d,a,d,a,d,a]];
    return List(Centr_d,x -> ImageElm(f,AssocWordByLetterRep(Fam,x)));
   fi;
  fi;
  if g=ae then
   return List(ConTup_a(h),x->x^-1);
  fi;
  if g in [be,ce,de] then
   if h in [be,ce,de,One(h),ae] then
    return []; #As g=h already considered in an earlier case
   fi;
   #---------------------    |h|>1     -----------------------
   #Test for Conjugator with trivial Activity
   res_Con := [];
   L1 := conjugators_grig_rek(State(g,x_1),State(h,x_1));
   if Size(L1) > 0 then
    L2 := conjugators_grig_rek(State(g,x_2),State(h,x_2));
    res_Con := Merge_Ls(L1,L2,false);
   fi;  

   #Test for Conjugator with non-trivial Activity
   L1 := conjugators_grig_rek(State(g,x_1),State(h,x_2));
   if Size(L1) = 0 then
    return res_Con;
   fi;
   L2 := conjugators_grig_rek(State(g,x_2),State(h,x_1));
   Join_to_first(res_Con,Merge_Ls(L1,L2,true));
   Check("h>1 nontrivial",g,h,res_Con);
   return res_Con;
  fi;

  #-#-#-#-#-#-#-#-#-   |g| > 1, act(g) = 1    -#-#-#-#-#-#-#
  res_Con := [];
  if IsOne(Activity(g)) then
  #Test for Conjugator with trivial Activity
   L1 := conjugators_grig_rek(State(g,x_1),State(h,x_1));
   if Size(L1) > 0 then
    L2 := conjugators_grig_rek(State(g,x_2),State(h,x_2));
    res_Con := Merge_Ls(L1,L2,false);
   fi; 
   #Test for Conjugator with non-trivial Activity
   L1 := conjugators_grig_rek(State(g,x_1),State(h,x_2));
   L2 := conjugators_grig_rek(State(g,x_2),State(h,x_1));
   Join_to_first(res_Con,Merge_Ls(L1,L2,true));
   Check("g>1, act = 1, non-trivial",g,h,res_Con);
   return res_Con;
  else
  #-#-#-#-#-#-#-#-#-   |g| > 1, act(g) = (1,2)    -#-#-#-#-#
   #Test for Conjugator with trivial Activity
   g1 := Compute_K_rep(PreImagesRepresentativeNC(f,State(g,x_1)^-1));
   h1 := Compute_K_rep(PreImagesRepresentativeNC(f,State(h,x_1)));
   L1 := conjugators_grig_rek(State(g,x_1)*State(g,x_2),State(h,x_1)*State(h,x_2));
   res_Con := [];
   if Size(L1) > 0 then
    for x in L1 do
     #Force that only <x,g1xh1> is checked. #Seems to be a bit too complicated, may be simplified.
     L1_temp := [];
     L1_temp[Position(L1,x)]:=x;
     L2 := [];
     L2[Position(K_repr_words,Compute_K_rep(Compute_K_rep(g1)*K_repr_words[Position(L1,x)]*Compute_K_rep(h1)))] := State(g,x_1)^-1*x*State(h,x_1);
     L2 :=Merge_Ls(L1_temp,L2,false);
     for y in L2 do
      res_Con[Position(L2,y)] := y;
     od;
    od;
   fi;
   #Test for Conjugator with non-trivial Activity
   h1 := Compute_K_rep(PreImagesRepresentativeNC(f,State(h,x_2)));
   L1 := conjugators_grig_rek(State(g,x_1)*State(g,x_2),State(h,x_2)*State(h,x_1));
   if Size(L1) = 0 then
    return res_Con;
   fi;
   for x in L1 do
    #Force that only <x,g1xh1> is checked.
    L1_temp := [];
    L1_temp[Position(L1,x)]:=x;
    L2 := [];
    L2[Position(K_repr_words,Compute_K_rep(Compute_K_rep(g1)*K_repr_words[Position(L1,x)]*Compute_K_rep(h1)))] := State(g,x_1)^-1*x*State(h,x_2);
    L2 :=Merge_Ls(L1_temp,L2,true);
    for y in L2 do
     res_Con[Position(L2,y)] := y;
    od;
   od;
   Check("g>1, act = (1,2), non-trivial",g,h,res_Con);
   return res_Con;
  fi;
 end;
 
 Res:= conjugators_grig_rek(g,h);
 Info(InfoFR,3,"Result of recursive computation: ",Res,"\n");
 if Size(Res) = 0 then
  return fail;
 fi;
 return Representative(Res);
end);
SetFRConjugacyAlgorithm(GrigorchukGroup,GRIG_CON@);
#################################################################
# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%#
# %%%%%%%%%%%%%%%%%%%%      IsConjugate        %%%%%%%%%%%%%%%%%%#
# %%%%%%%%%%%%%%%%%%%%  RepresentativeActionOp %%%%%%%%%%%%%%%%%%#
# %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%#
################################################################# 
InstallMethod(IsConjugate,
 " For FR groups with optimized conjugacy algorithm ",
 [ IsFRGroup and HasFRConjugacyAlgorithm,IsFRElement,IsFRElement], 
  function(G,a,b)
   return FRConjugacyAlgorithm(G)(G,a,b) <> fail;
  end);
InstallOtherMethod(RepresentativeActionOp,
 " For FR groups with optimized conjugacy algorithm ",
 [ IsFRGroup and HasFRConjugacyAlgorithm,IsFRElement,IsFRElement,IsFunction], 
  function(G,a,b,f)
   if f <> OnPoints then TryNextMethod(); fi;
   return FRConjugacyAlgorithm(G)(G,a,b);
  end);
  
  















 
 
 
 
 

[ Dauer der Verarbeitung: 0.59 Sekunden  (vorverarbeitet)  ]