#############################################################################
##
#W  treehom.gi                 automgrp package                Yevgen Muntyan
#W                                                             Dmytro Savchuk
##
#Y  Copyright (C) 2003 - 2018 Yevgen Muntyan, Dmytro Savchuk
##


###############################################################################
##
#R  IsTreeHomomorphismRep
##
DeclareRepresentation("IsTreeHomomorphismRep",
                      IsComponentObjectRep and IsAttributeStoringRep,
                      ["states", "perm", "deg"]);

###############################################################################
##
#R  IsTreeHomomorphismFamilyRep
##
DeclareRepresentation("IsTreeHomomorphismFamilyRep",
                      IsComponentObjectRep and IsAttributeStoringRep,
                      ["spher_index", "top_deg"]);

###############################################################################
##
##  AG_CreatedTreeHomomorphismFamilies
##
##  Contains all created TreeHomomorphismFamily objects; for each spherical
##  index there exists one family, to which all objects created with TreeHomomorphism
##  belong.
##
BindGlobal("AG_CreatedTreeHomomorphismFamilies", rec(ind := [], fam := []));

###############################################################################
##
#M  TreeHomomorphismFamily(<sph_ind>)
##
InstallMethod(TreeHomomorphismFamily, [IsRecord],
function(sph_ind)
  local fam, pos;

  sph_ind := AG_ReducedSphericalIndex(sph_ind);
  if sph_ind in AG_CreatedTreeHomomorphismFamilies.ind then
    for fam in AG_CreatedTreeHomomorphismFamilies.fam do
      if fam!.spher_index = sph_ind then
        return fam;
      fi;
    od;
  fi;

  fam := NewFamily(Concatenation("Automorphisms of ", sph_ind.start, ", (", sph_ind.period, ")-tree"),
                   IsTreeHomomorphism, IsTreeHomomorphism,
                   IsTreeHomomorphismFamily and IsTreeHomomorphismFamilyRep);
  fam!.spher_index := sph_ind;
  fam!.top_deg := AG_TopDegreeInSphericalIndex(sph_ind);

  AddSet(AG_CreatedTreeHomomorphismFamilies.ind, sph_ind);
  Add(AG_CreatedTreeHomomorphismFamilies.fam, fam);

  return fam;
end);

###############################################################################
##
#M  TreeHomomorphism (<states>, <tr>)
##
InstallMethod(TreeHomomorphism,
              [IsList and IsTreeHomomorphismCollection, IsObject],
function(states, perm)
  local top_deg, bot_deg, ind, fam, a;

  if not IsPerm(perm) and not IsTransformation(perm) then
    Error("The second argument ",perm, "must be a permutation or transformation");
  fi;

  if perm^-1<>fail and
     ForAll(states, IsTreeAutomorphism)
  then
    return TreeAutomorphism(states, AG_PermFromTransformation(perm));
  fi;

  top_deg := Length(states);

  if IsPerm(perm) then
    if not IsOne(perm) and top_deg < Maximum(MovedPoints(perm)) then
      Error("The root permutation ", perm, " must move only points from 1 to the degree ", top_deg, " of the tree");
    fi;
  else
    if not IsOne(perm) and top_deg < DegreeOfTransformation(perm) then
      Error("The root transformation ", perm, " must move only points from 1 to the degree ", top_deg, " of the tree");
    fi;
  fi;

  bot_deg := DegreeOfTree(states[1]);
  ind := rec(start := [top_deg], period := [bot_deg]);
  fam := TreeHomomorphismFamily(ind);

  return Objectify(NewType(fam, IsTreeHomomorphism and IsTreeHomomorphismRep),
                   rec(states := ShallowCopy(states),
                       perm := perm,
                       deg := top_deg));
end);

###############################################################################
##
#M  TreeHomomorphism (<states_list>, <perm>)
##
InstallMethod(TreeHomomorphism, [IsList, IsTransformation],
function(states, perm)
  local autom, nstates, s;

  autom := fail;

  for s in states do
    if IsTreeHomomorphism(s) then
      autom := s;
      break;
    elif not IsOne(s) then
      Error("Invalid state `", s, "'");
    fi;
  od;

  if autom = fail then
    Error("Can't create an automaton with all trivial states ",
          "without information about the tree");
  fi;

  nstates := List(states, function(s)
                            if IsOne(s) then
                              return One(autom);
                            else
                              return s;
                            fi;
                          end);

  return TreeHomomorphism(nstates, perm);
end);

###############################################################################
##
#M  TreeHomomorphism(<state_1>, <state_2>, ..., <state_n>, <perm>)
##
InstallMethod(TreeHomomorphism, [IsObject, IsObject, IsTransformation],
  function(a1, a2, perm) return TreeHomomorphism([a1, a2], perm); end);
InstallMethod(TreeHomomorphism, [IsObject, IsObject, IsObject, IsTransformation],
  function(a1, a2, a3, perm) return TreeHomomorphism([a1, a2, a3], perm); end);
InstallMethod(TreeHomomorphism, [IsObject, IsObject, IsObject, IsObject, IsTransformation],
  function(a1, a2, a3, a4, perm) return TreeHomomorphism([a1, a2, a3, a4], perm); end);
InstallMethod(TreeHomomorphism, [IsObject, IsObject, IsPerm],
  function(a1, a2, perm) return TreeHomomorphism([a1, a2], perm); end);
InstallMethod(TreeHomomorphism, [IsObject, IsObject, IsObject, IsPerm],
  function(a1, a2, a3, perm) return TreeHomomorphism([a1, a2, a3], perm); end);
InstallMethod(TreeHomomorphism, [IsObject, IsObject, IsObject, IsObject, IsPerm],
  function(a1, a2, a3, a4, perm) return TreeHomomorphism([a1, a2, a3, a4], perm); end);

###############################################################################
##
#M  ViewObj(<a>)
##
InstallMethod(ViewObj, [IsTreeHomomorphism],
function (a)
    local deg, printword, i, perm, states;

    states := Sections(a);
    deg := Length(states);
    perm := TransformationOnLevel(a, 1);

    Print("(");
    for i in [1..deg] do
        View(states[i]);
        if i <> deg then Print(", "); fi;
    od;
    Print(")");
    if not IsOne(perm) then
      AG_PrintTransformation(perm);
    fi;
end);

###############################################################################
##
#M  PrintObj(<a>)
##
InstallMethod(PrintObj, "for [IsTreeHomomorphism and IsTreeHomomorphismRep]",
                             [IsTreeHomomorphism and IsTreeHomomorphismRep],
function (a)
    local deg, i, states, perm;

    states := Sections(a);
    deg := Length(states);
    perm := TransformationOnLevel(a, 1);

    Print("(");
    for i in [1..deg] do
      if IsAutom(a!.states[i]) then
        View(a!.states[i]);
      else
        Print(a!.states[i]);
      fi;
      if i <> deg then Print(", "); fi;
    od;
    Print(")");
    if not IsOne(perm) then
      AG_PrintTransformation(perm);
    fi;
end);


###############################################################################
##
#M  String(<a>)
##
InstallMethod(String, "for [IsTreeHomomorphism]", [IsTreeHomomorphism],
function (a)
    local deg, printword, i, perm, states, str;

    states := Sections(a);
    deg := Length(states);
    perm := TransformationOnLevel(a, 1);
    str:= "(";

    for i in [1..deg] do
        Append(str, String(states[i]));
        if i <> deg then Append(str, ", "); fi;
    od;
    Append(str, ")");
    if not IsOne(perm) then
      Append(str, AG_TransformationString(perm));
    fi;
    return str;
end);


###############################################################################
##
#M  SphericalIndex (<a>)
##
InstallMethod(SphericalIndex, [IsTreeHomomorphism and IsTreeHomomorphismRep],
function(a)
  return FamilyObj(a)!.spher_index;
end);
InstallMethod(TopDegreeOfTree, [IsTreeHomomorphism and IsTreeHomomorphismRep],
function(a)
  return FamilyObj(a)!.top_deg;
end);


###############################################################################
##
#M  TransformationOnLevel (<a>, <k>)
##
InstallMethod(TransformationOnLevelOp, "for [IsTreeHomomorphism, IsPosInt]",
              [IsTreeHomomorphism, IsPosInt],
function(a, k)
  local states, top, first_level, i, j, d1, d2, permuted, p;

  if k = 1 then
    return TransformationOnFirstLevel(a);
  fi;

  # TODO: it is unnesessarily greedy, it could check whether there
  # are trivial permutations below
  d1 := DegreeOfTree(a);
  d2 := 1;
  for i in [2 .. k] do
    d2 := d2 * DegreeOfLevel(a, i);
  od;
  states := Sections(a);
  top := TransformationOnFirstLevel(a);
  first_level := List(states, s -> TransformationOnLevel(s, k-1));
  permuted := [];
  for i in [1..d1] do
    for j in [1..d2] do
      permuted[d2*(i-1) + j] := d2*(i^top - 1) + j^first_level[i];
    od;
  od;

#  p := PermList(permuted);
#  if p = fail then
#    p := Transformation(permuted);
#  fi;
#  return p;

  return Transformation(permuted);
end);

InstallMethod(TransformationOnFirstLevel, [IsTreeHomomorphism and IsTreeHomomorphismRep],
function(a)
  return AsTransformation(a!.perm);
end);


###############################################################################
##
#M  k ^ a
##
InstallMethod(\^, "for [IsPosInt, IsTreeHomomorphism]", [IsPosInt, IsTreeHomomorphism],
function(k, a)
    return k ^ TransformationOnLevel(a, 1);
end);

###############################################################################
##
#M  seq ^ a
##
InstallMethod(\^, "for [IsList, IsTreeHomomorphism]", [IsList, IsTreeHomomorphism],
function(seq, a)
  if Length(seq) = 0 then
    return [];
  elif Length(seq) = 1 then
    return [seq[1]^TransformationOnLevel(a, 1)];
  else
    return Concatenation([seq[1]^TransformationOnLevel(a, 1)],
                         seq{[2..Length(seq)]}^Section(a, seq[1]));
  fi;
end);


# ###############################################################################
# ##
# #M  FixesLevel(<a>, <k>)
# ##
# InstallMethod(FixesLevel, "for [IsTreeHomomorphism, IsPosInt]",
#               [IsTreeHomomorphism, IsPosInt],
# function(a, k)
#   if HasIsSphericallyTransitive(a) then
#     if IsSphericallyTransitive(a) then
#       return false; fi; fi;
#
#   if IsOne(PermOnLevel(a, k)) then
#     Info(InfoAutomGrp, 3, "IsSphericallyTransitive(a): false");
#     Info(InfoAutomGrp, 3, "  a is not transitive on level", k);
#     Info(InfoAutomGrp, 3, "  a = ", a);
#     SetIsSphericallyTransitive(a, false);
#     return true;
#   else
#     return false;
#   fi;
# end);
#
#
# ###############################################################################
# ##
# #M  FixesVertex(<a>, <v>)
# ##
# InstallOtherMethod(FixesVertex,  "for [IsTreeHomomorphism, IsObject]",
#                    [IsTreeHomomorphism, IsObject],
# function(a, v)
#   if HasIsSphericallyTransitive(a) then
#     if IsSphericallyTransitive(a) then
#       Info(InfoAutomGrp, 3, "FixesVertex(a, v): false");
#       Info(InfoAutomGrp, 3, "  IsSphericallyTransitive(a)");
#       Info(InfoAutomGrp, 3, "  a = ", a);
#       return false;
#     fi;
#   fi;
#
#   if v^a = v then
#     Info(InfoAutomGrp, 3, "IsSphericallyTransitive(a): false");
#     Info(InfoAutomGrp, 3, "  a fixes vertex ", v);
#     Info(InfoAutomGrp, 3, "  a = ", a);
#     SetIsSphericallyTransitive(a, false);
#     return true;
#   else
#     return false;
#   fi;
# end);


###############################################################################
##
#M  Section(<a>, <k>)
##
InstallMethod(Section, [IsTreeHomomorphism, IsPosInt],
function(a, k)
  return Sections(a)[k];
end);

InstallMethod(Section, [IsTreeHomomorphism and IsTreeHomomorphismRep, IsPosInt],
function(a, k)
  return a!.states[k];
end);


###############################################################################
##
#M  Section(<a>, <v>)
##
InstallMethod(Section, [IsTreeHomomorphism, IsList],
function(a, v)
  if Length(v) = 1 then
    return Section(a, v[1]);
  else
    return Section(Section(a, v[1]), v{[2..Length(v)]});
  fi;
end);


###############################################################################
##
#M  Sections(<a>)
##
InstallMethod(Sections, [IsTreeHomomorphism and IsTreeHomomorphismRep],
function(a)
  return a!.states;
end);


###############################################################################
##
#M  Sections(a, k)
##
InstallMethod(Sections, "for [IsTreeHomomorphism, IsPosInt]",
                   [IsTreeHomomorphism, IsPosInt],
function(a, level)
  if level = 1 then
    return Sections(a);
  else
    return Concatenation(List(Sections(a), s -> Sections(s, level-1)));
  fi;
end);

InstallMethod(Sections, "for [IsTreeHomomorphism, IsInt and IsZero]", [IsTreeHomomorphism, IsInt and IsZero],
function(a, level)
  return [a];
end);


###############################################################################
##
#M  Decompose(<a>, <k>)
##
InstallMethod(Decompose, "for [IsTreeHomomorphism, IsPosInt]",
              [IsTreeHomomorphism, IsPosInt],
function(a, level)
  return TreeHomomorphism(Sections(a, level), TransformationOnLevel(a, level));
end);

InstallMethod(Decompose, [IsTreeHomomorphism, IsInt and IsZero],
function(a, level)
  return a;
end);


###############################################################################
##
#M  Decompose(<a>)
##
InstallMethod(Decompose, "for [IsTreeHomomorphism]",
              [IsTreeHomomorphism],
function(a)
  return Decompose(a, 1);
end);


###############################################################################
##
#M  IsOne(<a>)
##
InstallMethod(IsOne, "for [IsTreeHomomorphism]",
              [IsTreeHomomorphism],
function(a)
  local s;

  if not IsOne(TransformationOnLevel(a, 1)) then
    return false;
  fi;

  for s in Sections(a) do
    if not IsOne(s) then
      return false;
    fi;
  od;

  return true;
end);


###############################################################################
##
#M  \=(<a1>, <a2>)
##
# TODO: can lead to infinite recursion
InstallMethod(\=, "for [IsTreeHomomorphism, IsTreeHomomorphism]", ReturnTrue,
              [IsTreeHomomorphism, IsTreeHomomorphism],
function(a1, a2)
  return TransformationOnLevel(a1, 1) = TransformationOnLevel(a2, 1) and
          Sections(a1) = Sections(a2);
end);


###############################################################################
##
#M  \<(<a1>, <a2>)
##
InstallMethod(\<, [IsTreeHomomorphism and IsTreeHomomorphismRep,
                   IsTreeHomomorphism and IsTreeHomomorphismRep],
function(a1, a2)
  return AG_TreeHomomorphismCmp(a1, a2) < 0;
end);


###############################################################################
##
##  AG_TreeHomomorphismCmp(a1, a2)
##
##  Global function to be used from IsTreeAutomomorphism too
##
InstallGlobalFunction(AG_TreeHomomorphismCmp,
function(a1, a2)
  local i, cmp;

  cmp := AG_TrCmp(a1!.perm, a2!.perm, a1!.deg);

  if cmp < 0 then
    return -1;
  elif cmp > 0 then
    return 1;
  fi;

  for i in [1..a1!.deg] do
    if a1!.states[i] < a2!.states[i] then
      return -1;
    elif a1!.states[i] > a2!.states[i] then
      return 1;
    fi;
  od;

  return 0;
end);


###############################################################################
##
#M  OneOp(<a>)
##
InstallMethod(OneOp, [IsTreeHomomorphism and IsTreeHomomorphismRep],
function(a)
  return Objectify(NewType(FamilyObj(a), IsTreeHomomorphism and IsTreeHomomorphismRep),
                   rec(states := List([1..a!.deg], i -> One(a!.states[1])),
                       perm := Transformation([1..a!.deg]),
                       deg := a!.deg));
end);


###############################################################################
##
#M  \*(<a1>, <a2>)
##
InstallMethod(\*, [IsTreeHomomorphism and IsTreeHomomorphismRep,
                   IsTreeHomomorphism and IsTreeHomomorphismRep],
function(a1, a2)
  local a;
  a := Objectify(NewType(FamilyObj(a1), IsTreeHomomorphism and IsTreeHomomorphismRep),
        rec(states := List([1..a1!.deg], i -> a1!.states[i] * a2!.states[i^(a1!.perm)]),
            perm := a1!.perm * a2!.perm,
            deg := a1!.deg));
  SetIsActingOnBinaryTree(a, IsActingOnBinaryTree(a1));
  SetIsActingOnRegularTree(a, IsActingOnRegularTree(a1));
  return a;
end);


###############################################################################
##
#M  \[\](<a1>, <a2>)
##
InstallOtherMethod(\[\], [IsTreeHomomorphism, IsPosInt],
function(a, k)
  return Section(a, k);
end);


###############################################################################
##
#M  Representative( <word>, <fam> )
##
InstallMethod(Representative, "for [IsAssocWord, IsTreeHomomorphismFamily]",
              [IsAssocWord, IsTreeHomomorphismFamily],
function( word, fam )
  if IsAutomFamily( fam ) then return Autom( word, fam );
  elif IsSelfSimFamily( fam ) then return SelfSim( word, fam );
  else Error("the family <fam> must be either IsAutomFamily or IsSelfSimFamily");
  fi;
end);


###############################################################################
##
#M  Representative( <word>, <a> )
##
InstallMethod(Representative, "for [IsAssocWord, IsTreeHomomorphism]",
              [IsAssocWord, IsTreeHomomorphism],
function( word, a )
  local fam;
  fam := FamilyObj(a);
  if IsAutomFamily( fam ) then return Autom( word, fam );
  elif IsSelfSimFamily( fam ) then return SelfSim( word, fam );
  else Error("the homomorphism <a> must be either from IsAutomFamily or from IsSelfSimFamily");
  fi;
end);


# ###############################################################################
# ##
# #M  InverseOp(<a>)
# ##
# InstallMethod(InverseOp, "for [IsTreeHomomorphism and IsTreeHomomorphismRep]",
#               [IsTreeHomomorphism and IsTreeHomomorphismRep],
# function(a)
#   local inv;
#   inv := Objectify(NewType(FamilyObj(a), IsTreeHomomorphism and IsTreeHomomorphismRep),
#             rec(states := List([1..a!.deg], i -> a!.states[i^(a!.perm^-1)]^-1),
#                 perm := a!.perm ^ -1,
#                 deg := a!.deg) );
#   SetIsActingOnBinaryTree(inv, IsActingOnBinaryTree(a));
#   SetIsActingOnRegularTree(inv, IsActingOnRegularTree(a));
#   return inv;
# end);
#
# InstallMethod(InverseOp, "for [IsTreeHomomorphism]", [IsTreeHomomorphism],
# function(a)
#   local states, inv_states, perm;
#   states := Sections(a);
#   perm := Inverse(Perm(a));
#   inv_states := List([1..Length(states)], i -> Inverse(states[i^perm]));
#   return TreeHomomorphism(inv_states, perm);
# end);





#E