#############################################################################
##
##  ExternalPolymakePolytope.gi  JConvex package
##                               Martin Bies
##
##  Copyright 2021               University of Pennsylvania
##
##  A Gap package to do convex geometry by Polymake, Cdd and Normaliz
##
##  Chapter Polytopes in Polymake
##
#############################################################################

##############################################################################################
##
##  Section GAP category of PolymakePolytopes
##
##############################################################################################

DeclareRepresentation( "IsPolymakePolytopeRep", IsPolymakePolytope and IsAttributeStoringRep, [ ] );

BindGlobal( "TheFamilyOfPolymakePolytopes", NewFamily( "TheFamilyOfPolymakePolytopes" ) );

BindGlobal( "TheTypeOfPolymakePolytope", NewType( TheFamilyOfPolymakePolytopes, IsPolymakePolytopeRep ) );

BindGlobal( "MakePolymakePolytopeVRep", function( vertices, lineality )
    local poly, kwargs, new_vertices, new_lin, v;
    poly := Objectify( TheTypeOfPolymakePolytope,
            rec( vertices := Immutable( vertices ),
                 lineality := Immutable( lineality ),
                 number_type := "rational",
                 rep_type := "V-rep" ) );

    # add 1s at the beginning, since Polymake always considers polytopes as intersections with the hyperplane x0 = 1
    new_vertices := [];
    for v in vertices do
        v := ShallowCopy( v );
        Add( v, 1, 1 );
        Add( new_vertices, v );
    od;
    new_lin := [];
    for v in lineality do
        v := ShallowCopy( v );
        Add( v, 1, 1 );
        Add( new_lin, v );
    od;

    kwargs := rec();

    # TODO: verify that kwargs is set correctly, also if one or both lists are empty

    # check for degenerate case
    if Length( new_vertices ) > 0 then
        kwargs.POINTS := JuliaMatrixInt( new_vertices );

        # if we also have lineality, add them
        if Length( new_lin ) > 0 then
            kwargs.INPUT_LINEALITY := JuliaMatrixInt( new_lin );
        fi;
    elif Length( new_lin ) > 0 then
        kwargs.POINTS := JuliaMatrixInt( new_lin );
        kwargs.INPUT_LINEALITY := kwargs.POINTS;
    fi;

    poly!.pmobj := CallJuliaFunctionWithKeywordArguments( _Polymake_jl.polytope.Polytope, [], kwargs );
    return poly;
end);

BindGlobal( "MakePolymakePolytopeHRep", function( inequalities, equalities )
    local poly, kwargs;
    poly := Objectify( TheTypeOfPolymakePolytope,
            rec( inequalities := Immutable( inequalities ),
                 equalities := Immutable( equalities ),
                 number_type := "rational",
                 rep_type := "H-rep" ) );

    kwargs := rec();

    # TODO: verify that kwargs is set correctly, also if one or both lists are empty

    # check for degenerate case
    if Length( inequalities ) > 0 then
        kwargs.INEQUALITIES := JuliaMatrixInt( inequalities );

        # check if we also need equalities
        if Length( equalities ) > 0 then
            kwargs.EQUATIONS := JuliaMatrixInt( equalities );
        fi;
    elif Length( equalities ) > 0 then
        kwargs.INEQUALITIES := JuliaMatrixInt( equalities );
        kwargs.EQUATIONS := kwargs.INEQUALITIES;
    fi;

    poly!.pmobj := CallJuliaFunctionWithKeywordArguments( _Polymake_jl.polytope.Polytope, [], kwargs );
    return poly;
end);

##############################################################################################
##
##  Constructors for PolymakePolytopes
##
##############################################################################################

InstallGlobalFunction( Polymake_PolytopeByGenerators,
  function( arg )
    local poly, i, matrix, temp, dim;

    if Length( arg )= 0 or ForAll( arg, IsEmpty ) then

        Error( "Wrong input: Please provide some input!" );

    elif Length( arg ) = 1 and IsList( arg[1] ) then

        return Polymake_PolytopeByGenerators( arg[ 1 ], [ ] );

    elif Length( arg ) = 2 and IsList( arg[ 1 ] ) and IsList( arg[ 2 ] ) then

        if ( not IsEmpty( arg[ 1 ] ) ) and not ( IsMatrix( arg[ 1 ] ) ) then
            Error( "Wrong input: The first argument should be a Gap matrix!" );
        fi;

        if ( not IsEmpty( arg[ 2 ] ) ) and not ( IsMatrix( arg[ 2 ] ) ) then
            Error( "Wrong input: The second argument should be a Gap matrix!" );
        fi;

        poly := MakePolymakePolytopeVRep( arg[ 1 ], arg[ 2 ] );
        return Polymake_CanonicalPolytopeByGenerators( poly );

    fi;

end );

InstallGlobalFunction( Polymake_PolytopeFromInequalities,
  function( arg )
    local poly, i, temp, matrix, dim;

    if Length( arg ) = 0 or ForAll( arg, IsEmpty ) then

        Error( "Wrong input: Please provide some input!" );

    elif Length( arg ) = 1 and IsList( arg[ 1 ] ) then

        return Polymake_PolytopeFromInequalities( arg[ 1 ], [ ] );

    elif Length( arg ) = 2 and IsList( arg[ 1 ] ) and IsList( arg[ 2 ] ) then

        if ( not IsEmpty( arg[ 1 ] ) ) and not ( IsMatrix( arg[ 1 ] ) ) then
            Error( "Wrong input: The first argument should be a Gap matrix!" );
        fi;

        if ( not IsEmpty( arg[ 2 ] ) ) and not ( IsMatrix( arg[ 2 ] ) ) then
            Error( "Wrong input: The second argument should be a Gap matrix!" );
        fi;

        poly := MakePolymakePolytopeHRep( arg[ 1 ], arg[ 2 ] );
        return Polymake_CanonicalPolytopeFromInequalities( poly );

    fi;

end );

##############################################################################################
##
##  Canonicalize polytopes
##
##############################################################################################

InstallMethod( Polymake_CanonicalPolytopeByGenerators,
               [ IsPolymakePolytope ],
  function( poly )
    local vertices, v_copy, scaled_vertices, i, scale, lineality, scaled_lineality;

    if poly!.rep_type = "H-rep" then

        return fail;

    else

        # compute vertices
        vertices := PolymakeMatrixToGAP( poly!.pmobj.VERTICES );

        # sometimes, Polymake returns rational vertices - we turn them into integral vectors
        # also, Polymake requires x0 = 1 in affine coordinates - we remove this 1
        scaled_vertices := [];
        for i in [ 1 .. Length( vertices ) ] do
            v_copy := ShallowCopy( vertices[ i ] );
            Remove( v_copy, 1 );
            Add( scaled_vertices, v_copy );
        od;

        # extract lineality
        lineality := PolymakeMatrixToGAP( poly!.pmobj.LINEALITY_SPACE );

        # sometimes, Polymake returns rational lineality - we turn them into integral vectors
        scaled_lineality := [];
        for i in [ 1 .. Length( lineality ) ] do
            v_copy := ShallowCopy( lineality[ i ] );
            Remove( v_copy, 1 );
            Add( scaled_lineality, v_copy );
        od;

        # construct the new poly
        return MakePolymakePolytopeVRep( scaled_vertices, scaled_lineality );

    fi;

end );

InstallMethod( Polymake_CanonicalPolytopeFromInequalities,
               [ IsPolymakePolytope ],
  function( poly )
    local ineqs, eqs;

    if poly!.rep_type = "V-rep" then

        return fail;

    else

        # compute facets
        ineqs := PolymakeMatrixToGAP( poly!.pmobj.FACETS );

        # compute affine hull
        eqs := PolymakeMatrixToGAP( poly!.pmobj.AFFINE_HULL );

        # construct the new poly
        return MakePolymakePolytopeHRep( ineqs, eqs );

    fi;

end );

##############################################################################################
##
##  Conversion of polytopes
##
##############################################################################################

InstallMethod( Polymake_V_Rep,
               [ IsPolymakePolytope ],
  function( poly )
    local vertices, v_copy, scaled_vertices, i, lineality, scaled_lineality;

    if poly!.rep_type = "V-rep" then

        return poly;

    else

        # compute vertices
        vertices := PolymakeMatrixToGAP( poly!.pmobj.VERTICES );

        # sometimes, Polymake returns rational vertices - we turn them into integral vectors
        scaled_vertices := [];
        for i in [ 1 .. Length( vertices ) ] do
            v_copy := ShallowCopy( vertices[ i ] );
            Remove( v_copy, 1 );
            Add( scaled_vertices, v_copy );
        od;

        # compute lineality
        lineality := PolymakeMatrixToGAP( poly!.pmobj.LINEALITY_SPACE );

        # sometimes, Polymake returns rational lineality - we turn them into integral vectors
        scaled_lineality := [];
        for i in [ 1 .. Length( lineality ) ] do
            v_copy := ShallowCopy( lineality[ i ] );
            Remove( v_copy, 1 );
            Add( scaled_lineality, v_copy );
        od;

        # construct the new poly
        return MakePolymakePolytopeVRep( scaled_vertices, scaled_lineality );

    fi;

end );

InstallMethod( Polymake_H_Rep,
               [ IsPolymakePolytope ],
  function( poly )
    local ineqs, eqs;

    if poly!.rep_type = "H-rep" then

        return poly;

    else

        if poly!.rep_type = "V-rep" and poly!.vertices = [] then
            return Polymake_PolytopeFromInequalities( [ [ 0, 1 ], [ -1, -1 ] ] );
        fi;

        # compute inequalities
        ineqs := PolymakeMatrixToGAP( poly!.pmobj.FACETS );

        # compute equalities
        eqs := PolymakeMatrixToGAP( poly!.pmobj.AFFINE_HULL );

        # construct the new poly
        return MakePolymakePolytopeHRep( ineqs, eqs );

    fi;

end );

##############################################################################################
##
##  Attributes of PolymakeCones
##
##############################################################################################

InstallMethod( Polymake_AmbientSpaceDimension,
              "finding the dimension of the ambient space of the poly",
              [ IsPolymakePolytope ],
  function( poly )

    return Length( Polymake_V_Rep( poly )!.vertices[0] );

end );

InstallMethod( Polymake_Dimension,
              " returns the dimension of the poly",
            [ IsPolymakePolytope ],
  function( poly )

    if Polymake_IsEmpty( poly ) then
        return -1;
    fi;

    return poly!.pmobj.CONE_DIM - 1;

end );

InstallMethod( Polymake_Vertices,
              " return the list of generating vertices",
              [ IsPolymakePolytope ],
  function( poly )

    return Set( Polymake_V_Rep( poly )!.vertices );

end );

InstallMethod( Polymake_Linealities,
              " return the list of linealities",
              [ IsPolymakePolytope ],
  function( poly )

    return Set( Polymake_V_Rep( poly )!.linealities );

end );

InstallMethod( Polymake_Equalities,
              " return the list of equalities of a poly",
              [ IsPolymakePolytope ],
  function( poly )

    return Set( ( Polymake_H_Rep( poly ) )!.equalities );

end );

InstallMethod( Polymake_Inequalities,
              " return the list of inequalities of a poly",
              [ IsPolymakePolytope ],
  function( poly )

    return Set( ( Polymake_H_Rep( poly ) )!.inequalities );

end );

InstallMethod( Polymake_LatticePoints,
              " return the list of the lattice points of poly",
              [ IsPolymakePolytope ],
  function( poly )
    local point_list, lattice_points, i, copy;

    point_list := JuliaToGAP( IsList, JuliaMatrixInt( poly!.pmobj.LATTICE_POINTS_GENERATORS[1] ), true );

    # the point list is in affine coordinate, that is we have a 1 at position one, which should be removed
    lattice_points := [];
    for i in [ 1 .. Length( point_list ) ] do
        copy := ShallowCopy( point_list[ i ] );
        Remove( copy, 1 );
        Add( lattice_points, copy );
    od;

    # return result
    return lattice_points;

end );

InstallMethod( Polymake_Intersection,
               [ IsPolymakePolytope, IsPolymakePolytope ],
  function( poly1, poly2 )
    local poly1_h, poly2_h, new_ineqs, new_equ;

    # compute H-reps
    poly1_h := Polymake_H_Rep( poly1 );
    poly2_h := Polymake_H_Rep( poly2 );

    # add the inequalities and equalities
    new_ineqs := Concatenation( poly1_h!.inequalities, poly2_h!.inequalities );
    new_equ := Concatenation( poly1_h!.equalities, poly2_h!.equalities );

    # return result
    return Polymake_PolytopeFromInequalities( new_ineqs, new_equ );

end );

##############################################################################################
##
##  Properties of PolymakeCones
##
##############################################################################################

InstallMethod( Polymake_IsEmpty,
               "finding if the poly empty is or not",
               [ IsPolymakePolytope ],
  function( poly )

    return Length( Polymake_V_Rep( poly )!.vertices ) = 0;

end );

InstallMethod( Polymake_IsPointed,
               "finding if the poly is pointed or not",
               [ IsPolymakePolytope ],
  function( poly )
    return poly!.pmobj.POINTED;

end );

InstallMethod( Polymake_IsBounded,
              " returns if the polytope is bounded or not",
              [ IsPolymakePolytope ],
  function( poly )
    return poly!.pmobj.BOUNDED;

end );


##  Copyright (c) 2018-2021, Carnegie Mellon University
##  See LICENSE for details

Class(WarpXOpts, FFTXConvOpts, rec(
    tags := [],
    operations := rec(Print := s -> Print("<FFTX WarpX options record>"))
));

warpxOpts := function(arg) # specific to WarpX size 100...
    local opts, rfs;

    rfs := Copy(RulesFuncSimp);
    Unbind(rfs.rules.TensorIdId);

    opts := Copy(WarpXOpts);
    opts.breakdownRules.Circulant := [Circulant_PRDFT_FDataNT];
    opts.breakdownRules.PRDFT := List([PRDFT1_Base1, PRDFT1_Base2, CopyFields(PRDFT1_CT,
            rec(allChildren := P ->Filtered(PRDFT1_CT.allChildren(P), i->When(P[1] = 100, Cols(i[1]) = 4, true)))),
        PRDFT_PD], _noT);
    opts.breakdownRules.IPRDFT := List([ IPRDFT1_Base1, IPRDFT1_Base2, IPRDFT1_CT, IPRDFT_PD ], _noT);
    opts.breakdownRules.PRDFT3 := List([ PRDFT3_Base1, PRDFT3_Base2, PRDFT3_CT ], _noT);
    opts.breakdownRules.IPRDFT2 := List([ IPRDFT2_Base1, IPRDFT2_Base2, IPRDFT2_CT ], _noT);
    opts.breakdownRules.DFT := [ DFT_Base,
        CopyFields(DFT_CT, rec(children := nt ->Filtered(DFT_CT.children(nt), i->When(nt.params[1] = 100, Cols(i[1]) = 4, true)))),
        DFT_PD ];
    opts.breakdownRules.TTensorInd := [dsA_base, L_dsA_L_base, dsA_L_base, L_dsA_base];
    opts.breakdownRules.MDDFT := [ MDDFT_Base, MDDFT_RowCol ];
    opts.breakdownRules.TL := [L_base];
    opts.breakdownRules.TSparseMat := [ TSparseMat_base ];

    opts.globalUnrolling := 23;
    opts.codegen := CopyFields( MultiPtrCodegenMixin, spiral.libgen.VecRecCodegen);
    opts.sumsgen.IterHStack := MultiPtrSumsgenMixin.IterHStack;
    opts.preProcess := t -> ApplyStrategy(t,
                    [ RulesFFTXPromoteWarpX1,
                      MergedRuleSet(rfs, RulesSums, RulesFFTXPromoteWarpX2),
                      RulesFFTXPromoteNT,
                      MergedRuleSet(rfs, RulesSums, RulesFFTXPromoteWarpX3) ],
        BUA, opts);
    opts.useDeref := false;
    # for debugging...
    opts.generateInitFunc := false;
#    opts.codegen := DefaultCodegen;
    opts.arrayBufModifier := "";
    opts.arrayDataModifier := "static";

    return opts;
end;

warpxConf := rec(
    defaultName := "defaultWarpXConf",
    defaultOpts := (arg) >> rec(useWarpX := true),
    confHandler := warpxOpts
);

fftx.FFTXGlobals.registerConf(warpxConf);


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

###############################################################################
##
#R  IsAutomRep
##
##  This is how IsAutom object is stored in GAP:
##  IsAutom object is a thing of kind "w = (w_1, w_2, ..., w_d)\pi", where
##    deg = d - arity of tree;
##    perm = \pi - permutation on first level;
##    w, w_1, ..., w_d - elements of free group representing elements of
##      automata group;
##    word = w;
##    states = [w_1, ..., w_d].
##
DeclareRepresentation("IsAutomRep",
                      IsComponentObjectRep and IsAttributeStoringRep,
                      ["word", "states", "perm", "deg"]);

InstallGlobalFunction(__AG_CreateAutom,
function(family, word, states, perm, invertible)
  local a, cat;

  if invertible then
    cat := IsInvertibleAutom and IsAutomRep;

    if perm^-1=fail then
      Error(perm, " is not invertible");
    else
      perm := AG_PermFromTransformation(perm);
    fi;
  else
    cat := IsAutom and IsAutomRep;
  fi;

  a := Objectify(NewType(family, cat),
                 rec(word := word,
                     states := states,
                     perm := perm,
                     deg := family!.deg));

  SetIsActingOnBinaryTree(a, a!.deg = 2);

  return a;
end);

###############################################################################
##
#M  Autom(<word>, <fam>)
##
InstallMethod(Autom, "for [IsAssocWord, IsAutomFamily]",
              [IsAssocWord, IsAutomFamily],
function(w, fam)
  local exp, wstates, curstate, newstate, curletter, newletter,
        nperm, i, j, perm, a, wtmp, reduced, invertible;

  if fam!.use_rws then
    w := AG_ReducedForm(fam!.rws, w);
  fi;

  if Length(w) = 0 then
    return One(fam);
  elif Length(w) = 1 then
    if ExponentSyllable(w, 1) = 1 then
      return fam!.automgens[GeneratorSyllable(w, 1)];
    else
      return fam!.automgens[GeneratorSyllable(w, 1) + fam!.numstates];
    fi;
  fi;

  # TODO
  exp := LetterRepAssocWord(w);
  for i in [1..Length(exp)] do
    if exp[i] < 0 then exp[i] := -exp[i] + fam!.numstates; fi;
  od;
  wstates := [];
  nperm := ();
  for i in [1..Length(exp)] do
    nperm := nperm * fam!.automatonlist[exp[i]][fam!.deg+1];
  od;

  for i in [1..fam!.deg] do
    wstates[i] := [];
    perm := ();

    for j in [1..Length(exp)] do
      newstate := fam!.automatonlist[exp[j]][i^perm];
      if newstate <> fam!.trivstate then
        if newstate > fam!.numstates then
          newstate := -(newstate - fam!.numstates);
        fi;
        if Length(wstates[i]) > 0 and wstates[i][Length(wstates[i])] = -newstate then
          Remove(wstates[i], Length(wstates[i]));
        else
          Add(wstates[i], newstate);
        fi;
      fi;
      perm := perm * fam!.automatonlist[exp[j]][fam!.deg+1];
    od;
    if Length(wstates[i]) > 0 then
      wstates[i] := AssocWordByLetterRep(FamilyObj(w), wstates[i]);
    else
      wstates[i] := One(fam!.freegroup);
    fi;
    if fam!.use_rws and not IsOne(wstates[i]) then
      wstates[i] := AG_ReducedForm(fam!.rws, wstates[i]);
    fi;
  od;

  invertible := true;
  if not fam!.isgroup then
    for i in exp do
      if i <= fam!.numstates and not IsInvertibleAutom(fam!.automgens[i]) then
        invertible := false;
        break;
      fi;
    od;
  fi;

  return __AG_CreateAutom(fam, w, wstates, nperm, invertible);
end);

###############################################################################
##
#M  Autom(<word>, <a>)
##
InstallMethod(Autom, "for [IsAssocWord, IsAutom]", [IsAssocWord, IsAutom],
function(w, a)
  return Autom(w, FamilyObj(a));
end);

InstallMethod(MappedWord, [IsAssocWord,
                           IsList and IsAssocWordCollection,
                           IsList and IsAutomCollection],
function(w, fgens, agens)
  local img;
  img := MappedWord(w, fgens, List(agens, a -> a!.word));
  return Autom(img, FamilyObj(agens[1]));
end);

###############################################################################
##
#M  Autom(<word>, <list>)
##
InstallMethod(Autom, "for [IsAssocWord, IsList]",
                   [IsAssocWord, IsList],
function(w, list)
  local fam;
  fam := AutomFamily(list);
  if fam = fail then
    return fail;
  fi;
  return Autom(w, fam);
end);

###############################################################################
##
#M  PrintObj(<a>)
##
InstallMethod(PrintObj, "for [IsAutom]",
              [IsAutom],
function (a)
  local deg, printword, i;

  printword := function(w)
    if IsOne(w) then Print(AG_Globals.identity_symbol);
    else Print(w); fi;
  end;

  if true then
    View(a);
    return;
  fi;

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

###############################################################################
##
#M  ViewObj(<a>)
##
InstallMethod(ViewObj, "for [IsAutom]",
              [IsAutom],
function (a)
  if IsOne(a!.word) then Print(AG_Globals.identity_symbol);
  else Print(a!.word); fi;
end);

###############################################################################
##
#M  String(<a>)
##
InstallMethod(String, "for [IsAutom]",
              [IsAutom],
function (a)
  if IsOne(a!.word) then return AG_Globals.identity_symbol;
  else return String(a!.word); fi;
end);

###############################################################################
##
#M  Perm(<a>)
##
InstallMethod(Perm, "for [IsAutom]", [IsAutom],
function(a)
    return a!.perm;
end);

###############################################################################
##
#M  Word(<a>)
##
InstallMethod(Word, "for [IsAutom]", [IsAutom],
function(a)
    return a!.word;
end);

###############################################################################
##
#M  <a1> * <a2>
##
InstallMethod(\*, "for [IsAutom, IsAutom]", [IsAutom, IsAutom],
function(a1, a2)
    local a, i, fam, word, states;

    fam := FamilyObj(a1);
    word := a1!.word * a2!.word;

    if fam!.use_rws then
      word := AG_ReducedForm(fam!.rws, word);
    fi;

    if IsOne(word) then
      return One(a1);
    fi;

    states := List([1..a1!.deg], i -> a1!.states[i] * a2!.states[i^(a1!.perm)]);

    if fam!.use_rws then
      for i in [1..a1!.deg] do
        states[i] := AG_ReducedForm(fam!.rws, states[i]);
      od;
    fi;

    return __AG_CreateAutom(FamilyObj(a1), word, states, a1!.perm * a2!.perm,
                           IsInvertibleAutom(a1) and IsInvertibleAutom(a2));
end);

AG_IsOne_Autom := function(a)
  local deg, w, aw, checked, to_check;

  if IsOne(a!.word) then
    return true;
  fi;

  if not IsOne(a!.perm) then
    return false;
  fi;

  deg := a!.deg;
  checked := [];
  to_check := Filtered(a!.states, w -> not IsOne(w) and w <> a!.word);

  while not IsEmpty(to_check) do
    w := Remove(to_check, Length(to_check));
    # TODO Use AddSet() here?
    Add(checked, w);
    aw := Autom(w, a);
    if not IsOne(aw!.perm) then
      return false;
    fi;
    for w in aw!.states do
      if not IsOne(w) and not w in checked and not w in to_check then
        # TODO Use AddSet() here?
        Add(to_check, w);
      fi;
    od;
  od;

  return true;
end;

###############################################################################
##
#M  IsOne(a)
##
InstallMethod(IsOne, "for [IsAutom]", [IsAutom],
function(a)
  local i, w, nw, d, to_check, checked, deb_i, perm, autlist, pos, istrivstate, exp, G, trivstate;

  if IsOne(a!.word) then return true; fi;

  G := GroupOfAutomFamily(FamilyObj(a));
  if G <>fail and HasIsContracting(G) and IsContracting(G) and FamilyObj(a)!.use_contraction = true  then
    return IsOneContr(a);
  fi;

  # this seems working well enough
  return AG_IsOne_Autom(a);

  d := a!.deg;
  autlist := FamilyObj(a)!.automatonlist;
  trivstate := FamilyObj(a)!.trivstate;
  checked := [];

  istrivstate := function(v)
    local i, j, perm;

    if IsEmpty(v) then
      return true;
    fi;

    if v in checked then
      return true;
    else
      perm := ();
      for i in [1..Length(v)] do perm := perm * autlist[v[i]][d+1]; od;
      if perm <> () then return false; fi;
      Add(checked, v);
      for j in [1..d] do
        if not istrivstate(AG_WordStateInList(v, j, autlist, true, trivstate)) then
          return false;
        fi;
      od;
      return true;
    fi;
  end;

  exp := LetterRepAssocWord(a!.word);
  for i in [1..Length(exp)] do
    if exp[i] < 0 then
      exp[i] := -exp[i] + FamilyObj(a)!.numstates;
    fi;
  od;

  return istrivstate(exp);
end);

###############################################################################
##
#M  a1 = a2
##
InstallMethod(\=, "for [IsAutom, IsAutom]", IsIdenticalObj, [IsAutom, IsAutom],
function(a1, a2)
  local areequalstates, exp, i, d, checked, autlist, G, trivstate;

  G := GroupOfAutomFamily(FamilyObj(a1));
  if G <> fail and HasIsContracting(G) and IsContracting(G) and UseContraction(G) then
    return IsOneContr(a1*a2^-1);
  fi;

  # TODO can there be a problem if we do this?
  if G <> fail then
    return AG_IsOne_Autom(a1*a2^-1);
  fi;

  d := a1!.deg;
  checked := [];
  autlist := FamilyObj(a1)!.automatonlist;
  trivstate := FamilyObj(a1)!.trivstate;

  areequalstates := function(p)
    local i, j, perm1, perm2;

    if p[1] = p[2] then
      return true;
    fi;

    if p in checked then
      return true;
    else
      perm1 := ();
      perm2 := ();

      for i in [1..Length(p[1])] do
        perm1 := perm1 * autlist[p[1][i]][d+1];
      od;
      for i in [1..Length(p[2])] do
        perm2 := perm2 * autlist[p[2][i]][d+1];
      od;

      if perm1 <> perm2 then
        return false;
      fi;

      AddSet(checked, p);
      for j in [1..d] do
        if not areequalstates([AG_WordStateInList(p[1], j, autlist, true, trivstate),
                               AG_WordStateInList(p[2], j, autlist, true, trivstate)])
        then
          return false;
        fi;
      od;
      return true;
    fi;
  end;

  exp := [LetterRepAssocWord(a1!.word), LetterRepAssocWord(a2!.word)];
  for i in [1..Length(exp[1])] do
    if exp[1][i] < 0 then exp[1][i] := -exp[1][i] + FamilyObj(a1)!.numstates; fi;
  od;
  for i in [1..Length(exp[2])] do
    if exp[2][i] < 0 then exp[2][i] := -exp[2][i] + FamilyObj(a2)!.numstates; fi;
  od;
  return areequalstates(exp);
end);

###############################################################################
##
#M  a1 < a2
##
InstallMethod(\<, "for [IsAutom, IsAutom]", IsIdenticalObj, [IsAutom, IsAutom],
function(a1, a2)
  local d, checked, pos, aw1, aw2, p, np, i, exp, perm1, perm2, autlist, cmp;

  d := a1!.deg;
  autlist := FamilyObj(a1)!.automatonlist;
  exp := [LetterRepAssocWord(a1!.word), LetterRepAssocWord(a2!.word)];
  for i in [1..Length(exp[1])] do
    if exp[1][i] < 0 then exp[1][i] := -exp[1][i] + FamilyObj(a1)!.numstates; fi;
  od;
  for i in [1..Length(exp[2])] do
    if exp[2][i] < 0 then exp[2][i] := -exp[2][i] + FamilyObj(a2)!.numstates; fi;
  od;
  checked := [exp];
  pos := 0;

  while Length(checked) <> pos do
    pos := pos + 1;
    p := checked[pos];
    perm1 := ();
    perm2 := ();
    for i in [1..Length(p[1])] do perm1 := perm1 * autlist[p[1][i]][d+1]; od;
    for i in [1..Length(p[2])] do perm2 := perm2 * autlist[p[2][i]][d+1]; od;
    cmp := AG_TrCmp(perm1, perm2, d);
    if cmp < 0 then
      return true;
    elif cmp > 0 then
      return false;
    fi;
    for i in [1..d] do
      np := [AG_WordStateInList(p[1], i, autlist, false, 0),
             AG_WordStateInList(p[2], i, autlist, false, 0)];
      if not np in checked then
        Add(checked, np);
      fi;
    od;
  od;

  return false;
end);

###############################################################################
##
#M  InverseOp(<a>)
##
InstallMethod(InverseOp, "for [IsInvertibleAutom]", [IsInvertibleAutom],
function(a)
  local i, inv, fam, word, states;

  fam := FamilyObj(a);
  word := a!.word ^ -1;
  if fam!.use_rws then
    word := AG_ReducedForm(fam!.rws, word);
    if IsOne(word) then
      return One(a);
    fi;
  fi;

  states := List([1..a!.deg], i -> a!.states[i^(a!.perm^-1)]^-1);

  if fam!.use_rws then
    for i in [1..a!.deg] do
      states[i] := AG_ReducedForm(fam!.rws, states[i]);
    od;
  fi;

  return __AG_CreateAutom(FamilyObj(a), word, states, a!.perm^-1, true);
end);

###############################################################################
##
#M  OneOp(<a>)
##
InstallMethod(OneOp, "for [IsAutom]", [IsAutom],
function(a)
    return One(FamilyObj(a));
end);

###############################################################################
##
#M  StatesWords(<a>)
##
InstallMethod(StatesWords, "for [IsAutom]", [IsAutom],
function(a)
  return a!.states;
end);

###############################################################################
##
#M  Sections(a)
##
InstallMethod(Sections, "for [IsAutom]", [IsAutom],
function(a)
  return List(a!.states, s -> Autom(s, a));
end);

###############################################################################
##
#M  Section(a, k)
##
InstallMethod(Section, "for [IsAutom, IsPosInt]", [IsAutom, IsPosInt],
function(a, k)
  if k > a!.deg then
    Error("in Section(IsAutom, IsPosInt): invalid vertex ", k);
  fi;
  return Autom(a!.states[k], a);
end);

###############################################################################
##
#M  Section(a, seq)
##
## TODO
InstallMethod(Section, "for [IsAutom, IsList]", [IsAutom, IsList],
function(a, v)
  if Length(v) = 0 then
    return a;
  fi;

  if Length(v) = 1 then
    return Section(a, v[1]);
  fi;

  return Section(Section(a, v[1]), v{[2..Length(v)]});
end);

###############################################################################
##
#M  k ^ a
##
InstallMethod(\^, "for [IsPosInt, IsAutom]", [IsPosInt, IsAutom],
function(k, a)
    return k ^ Perm(a);
end);

###############################################################################
##
#M  seq ^ a
##
InstallMethod(\^, "for [IsList, IsAutom]", [IsList, IsAutom],
function(seq, a)
    local i, deg, img, cur;

    deg := DegreeOfTree(a);
    for i in seq do
      if not IsInt(i) or i < 1 or i > deg then
         Error("\^(IsList, IsAutom): ",
              i, " is out of range 1..", deg, " and is not a letter of the alphabet\n");
#        Print("\^(IsList, IsAutom): ",
#             i, " is out of range 1..", deg, " and is not a letter of the alphabet\n");
#        return seq;
      fi;
    od;

    if Length(seq) = 0 then return []; fi;
    if Length(seq) = 1 then return [seq[1]^Perm(a)]; fi;

    cur := LetterRepAssocWord(Word(a));
    for i in [1..Length(cur)] do
      if cur[i] < 0 then cur[i] := -cur[i]+FamilyObj(a)!.numstates; fi;
    od;
    cur := [cur, Perm(a)];

    img := [];
    for i in [1..Length(seq)] do
        img[i] := seq[i]^cur[2];
        cur := AG_WordStateAndPermInList(cur[1], seq[i],
                                         FamilyObj(a)!.automatonlist);
    od;

    return img;
end);

###############################################################################
##
#M  PermOnLevelOp(a, k)
##
## TODO
InstallMethod(PermOnLevelOp, "for [IsIsInvertibleAutom, IsPosInt]",
              [IsInvertibleAutom, IsPosInt],
function(a, k)
  local dom, perm;

  if k = 1 then
    return a!.perm;
  fi;

  dom := AsList(Tuples([1.. a!.deg], k));
  perm := List(dom, s -> s ^ a);
  perm := PermListList(dom, perm);

  return perm;
end);

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

###############################################################################
##
#M  IsActingOnBinaryTree(<a>)
##
InstallMethod(IsActingOnBinaryTree, "for [IsAutom]",
              [IsAutom],
function(a)
    return a!.deg = 2;
end);

InstallMethod(SphericalIndex, "for [IsAutom]", [IsAutom],
function(a)
  # XXX check uses of SphericalIndex everywhere
  return rec(start := [], period := [a!.deg]);
end);

# XXX check uses of this everywhere
InstallMethod(DegreeOfTree, "for [IsAutom]", [IsAutom],
function(a)
  return a!.deg;
end);

# XXX check uses of this everywhere
InstallMethod(TopDegreeOfTree, "for [IsAutom]", [IsAutom],
function(a)
  return a!.deg;
end);

###############################################################################
##
#M  CanEasilyTestSphericalTransitivity(<a>)
##
InstallTrueMethod(CanEasilyTestSphericalTransitivity,
                  IsActingOnBinaryTree and IsAutom);

###############################################################################
##
#M  IsSphericallyTransitive(<a>)
##
InstallMethod(IsSphericallyTransitive, "for [IsAutom]",
              [IsInvertibleAutom],
function(a)
  local w, i, ab, abs;

  if IsOne(Word(a)) then
    Info(InfoAutomGrp, 3, "IsSphericallyTransitive(a): false");
    Info(InfoAutomGrp, 3, "  IsOne(Word(a)): a = ", a);
    return false;
  fi;

  TryNextMethod();
end);

#########################################################################
##
#M  Order(<a>)
##
InstallMethod(Order, "for [IsInvertibleAutom]", true,
                   [IsInvertibleAutom],
function(a)
  local ord_loc;
  if IsGeneratedByBoundedAutomaton(GroupOfAutomFamily(FamilyObj(a))) then
    return OrderUsingSections(a, infinity);
  fi;
  if IsActingOnBinaryTree(a) and IsSphericallyTransitive(a) then
    return infinity;
  fi;
  ord_loc := OrderUsingSections(a, 10);
  if ord_loc <> fail then
    return ord_loc;
  fi;
  return OrderUsingSections(a, infinity);
end);

#########################################################################
##
#M  IsTransitiveOnLevel( <a>, <lev> )
##
InstallMethod(IsTransitiveOnLevel, "for [IsInvertibleAutom, IsPosInt]",
              [IsInvertibleAutom, IsPosInt],
function(a, lev)
  return Length(OrbitPerms([PermOnLevel(a, lev)], 1)) = a!.deg^lev;
end);

#########################################################################
##
#M  AllSections( <a> )
##
InstallMethod(AllSections, "for [IsAutom]",
              [IsAutom],
function(a)
  local states, find_all_sections;

  find_all_sections := function(s)
    local i;
    if not s in states then
      Add(states, s);
      for i in [1..s!.deg] do find_all_sections(Section(s, i)); od;
    fi;
  end;

  states := [];
  find_all_sections(a);
  return states;
end);

#E


# Copyright (c) 2018-2021, Carnegie Mellon University
# See LICENSE for details

#F ==========================================================================
#F AParSMP(<num_threads>, <tid>) - SMP parallelization tag
#F    .params[1] becomes num_threads
#F    .params[2] becomes tid
#F
Class(AParSMP, AGenericTag, rec(
    isSMP := true,
    updateParams := meth(self)
        if Length(self.params)=1 then self.params := [self.params[1], threadId()];
        elif Length(self.params)=2 then ;
        else Error("Usage: AParSMP(<num_threads>, [<tid>])");
        fi;
    end
));

#F ==========================================================================
#F SMPBarrier(<nthreads>, <tid>, <spl>)
#F
#F ==========================================================================
Class(SMPBarrier, Buf, BaseContainer, rec(
    # inheriting from Buf helps to get extra methods from Buf, for example
    # .cannotChangeDataFormat (from paradigms/vector). Buf is considered a general wrapper.
    doNotMarkBB := true,
    new := (self, nthreads, tid, spl) >> Checked(IsPosInt0Sym(tid), IsPosIntSym(nthreads), IsSPL(spl),
        SPL(WithBases(self, rec(_children:=[spl], tid := tid, nthreads := nthreads, dimensions := spl.dims())))),

    dims := self >> self._children[1].dims(),

    rChildren := self >> [self.nthreads, self.tid, self._children[1]],
    rSetChild := meth(self, n, newC)
        if n=1 then self.nthreads := newC;
        elif n=2 then self.tid := newC;
        elif n=3 then self._children[1] := newC;
        else Error("<n> must be in [1..3]");
        fi;
    end
));

#F ==========================================================================
#F SMPSum(<nthreads>, <tid>, <var>, <domain>, <spl>) - parallel loop with <nthreads> threads
#F
#F As a matrix SMPSum(p, var, domain, spl) == ISum(var, domain, spl)
#F ==========================================================================
Class(SMPSum, ISum, rec(
    doNotMarkBB := true,
    abbrevs := [ (p, var, domain, spl) -> Checked(
                    IsInt(p) or IsScalar(p), IsVar(var), IsInt(p) or IsScalar(domain), IsSPL(spl),
                    [p, threadId(), var, domain, spl]) ],

    new := meth(self, nthreads, tid, var, domain, spl)
        local res;
        Constraint(IsSPL(spl));
	# if domain is an integer (not symbolic) it must be non-zero
	Constraint(IsPosIntSym(domain));
        var.isLoopIndex := true;
        var.range := domain;
	res := SPL(WithBases(self, rec(nthreads:=nthreads, tid:=tid, _children := [spl], var := var, domain := domain)));
	res.dimensions := res.dims();
	return res;
    end,

    rChildren := self >> [self.nthreads, self.tid, self.var, self.domain, self._children[1]],

    from_rChildren := (self, rch) >> ApplyFunc(ObjId(self), rch),

    rSetChild := meth(self, n, newChild)
	if n=1 then self.nthreads := newChild;
	elif n=2 then self.tid := newChild;
	elif n=3 then self.var := newChild;
	elif n=4 then self.var.range := newChild; self.var.isLoopIndex := true;
	elif n=5 then self._children[1] := newChild;
        else Error("<n> must be in [1..5]");
	fi;
    end,

    print := (self, i, is) >> Print(self.__name__, "(", self.nthreads, ", ", self.tid, ", ",
        self.var, ", ", self.domain, ",\n", Blanks(i+is), self.child(1).print(i+is, is), "\n",
	Blanks(i), ")", self.printA())
));

#F ==========================================================================
#F SMP(<num_threads>, <tid>, <spl>) - parallel container for rewriting
#F
#F SMP(ISum(...)) -- becomes --> SMPSum(...)
#F ==========================================================================
Class(SMP, BaseContainer, rec(
    doNotMarkBB := true,

    abbrevs := [ (nthreads, spl) -> Checked(IsInt(nthreads) or IsScalar(nthreads), IsSPL(spl),
                                            [nthreads, threadId(), spl]) ],

    new := (self, nthreads, tid, spl) >>
	SPL(WithBases(self, rec(nthreads:=nthreads, tid:=tid, dimensions := spl.dimensions, _children := [spl]))),

    rChildren := self >> [self.nthreads, self.tid, self._children[1]],

    rSetChild := meth(self, n, newChild)
        if   n = 1 then self.nthreads := newChild;
        elif n = 2 then self.tid := newChild;
	elif n = 3 then self._children[1] := newChild;
	else Error("<n> must be in [1..3]"); fi;
	return self;
    end,

    sums := self >> ObjId(self)(self.nthreads, self.tid, self.child(1).sums()),

    normalizedArithCost := self >> self.child(1).normalizedArithCost()
));