#
# ---------- Constructors ----------
#

InstallMethod(Unipotent,
              "Unipotent element in simple adjoint type",
              [IsChevalleyAdj,IsList,IsList,IsInt],
              function(sys,coeffs,ordering,order)
              local object;

              if Filtered(coeffs,i->not i[2] in Integers)=[] then coeffs:=List(coeffs,i->[i[1],One(ring(sys))*i[2]]);
              elif Filtered(coeffs,i->not i[2] in ring(sys))<>[] then Error("The coefficients ar not in indicated ring."); fi;

              object:=Objectify(NewType(NewFamily("UnipotentFamily"),
                                        IsAttributeStoringRep and
                                        IsUnipotent and
                                        IsMultiplicativeElementWithInverse and
                                        IsMultiplicativeElementWithOne),
                           rec());

              SetchevalleyAdj(object,sys);
              SetOrdering(object,ordering);

              Setcoefficients(object,Canonic(sys,coeffs,ordering));
#             SetInverse(object,InverseOp(object)); This is set at the first call Inverse(obj);

              if order = -1 and Characteristic(sys)>0 then
                  SetOrder(object,OrderOp(object));
              elif order > -1 then
                  SetOrder(object,order);
              fi;

              SetName(object,Concatenation("<unipotent element for ",type(sys),String(rank(sys)),
                                      " in characteristic ",String(Characteristic(sys)),">"));
              return object;
end);

InstallMethod(Unipotent,
              "Unipotent element in simple adjoint type",
              [IsChevalleyAdj,IsList,IsList],
              function(sys,coeffs,ordering)

              return Unipotent(sys,coeffs,ordering,-2);
end);

InstallMethod(Unipotent,
              "Unipotent element in simple adjoint type",
              [IsChevalleyAdj,IsList,IsInt],
              function(sys,coeffs,order)
              local ordering,tmp,i,slot;

              tmp:=ShallowCopy(coeffs);
              Sort(tmp,function(a,b) return a[1]<b[1]; end);

              ordering:=[1..Length(positiveRoots(sys))];
              tmp:=List(tmp,i->ordering[i[1]]);

              for i in [1..Length(coeffs)] do
                  ordering[coeffs[i][1]]:=tmp[i];
              od;

              return Unipotent(sys,Filtered(coeffs,i->i[2]<>Zero(ring(sys))),ordering,order);
end);

InstallMethod(Unipotent,
              "Unipotent element in simple adjoint type",
              [IsChevalleyAdj,IsList],
              function(sys,coeffs)

              return Unipotent(sys,coeffs,-2);#-1);
end);

InstallMethod(Unipotent,
              "Unipotent element in simple adjoint type",
              [IsNilpotentChv],
              function(e)

              return Unipotent(chevalleyAdj(e),coefficients(e));
end);

#
# ---------- Canonic form of element ----------
#

InstallMethod(Canonic,
              "Canonic form of coefficients of unipotent element in given ordering",
              [IsChevalleyAdj,IsList,IsList],
              function(sys,coeffs,ordering)
              local lista,
              pr,Cijrs,
              flag,i,temp,suma,param,cc,k;

              lista:=List(coeffs,i->ShallowCopy(i));
              pr:=positiveRoots(sys);

              Cijrs:=C(sys);
              flag:=true;
              while flag do
                  flag:=false;
                  i:=Length(lista);
                  while 0 < i do
                            if lista[i][2] = Zero(ring(sys)) then
                                Remove(lista,i);
                                flag:=true;
                            elif 1 < i and lista[i][1] = lista[i-1][1] then
                                lista[i-1][2]:=lista[i-1][2]+lista[i][2];
                                Remove(lista,i);
                                flag:=true;
                            elif 1 < i and ordering[lista[i][1]] < ordering[lista[i-1][1]] then
                                temp:=lista[i]; lista[i]:=lista[i-1]; lista[i-1]:=temp;

                                #aici r si s sunt pe pozitia i-1 si repsectiv i
                                k:=1;
                                for cc in Cijrs[lista[i-1][1]][lista[i][1]] do
                                    suma:=cc[1]*pr[lista[i-1][1]]+cc[2]*pr[lista[i][1]];
                                    param:=cc[3]*((-1)^cc[1])*(lista[i-1][2]^cc[1])*(lista[i][2]^cc[2]);
                                    Add(lista,[Position(pr,suma),param],i+k);
                                    k:=k+1;
                                od;
                                flag:=true;
                            fi;
                            i:=i-1;
                  od;
              od;

              return Immutable(lista);
end);

#
# ---------- Arithmetic Operations ----------
#

InstallMethod(InverseMutable,
              "Inverse of unipotent element",
              [IsUnipotent],
              function(u)
              local i,lista,len,reverse_order;

              lista:=List(coefficients(u),i->StructuralCopy(i));
              len:=Length(lista);
              for i in [1..len] do
                  Add(lista,[lista[len-i+1][1],-lista[len-i+1][2]]);
                  Remove(lista,len-i+1);
              od;

              reverse_order:=function(o)
                  local maxim;
                  maxim:=Maximum(o);
                  return List(o,i->maxim-i+1);
              end;

              return Unipotent(chevalleyAdj(u),lista,reverse_order(Ordering(u)),-2);#0);
end);

InstallMethod(OneMutable,
              "Inverse of unipotent element",
              [IsUnipotent],
              function(u)

              return One(chevalleyAdj(u),[],0);
end);

InstallMethod(\*,
              "Multiplication for unipotent elements a*b with the ordering of b",
              [IsUnipotent,IsUnipotent],
              function(u1,u2)
              local sys1,sys2,
              generic,result,coeffs1,coeffs2,
              APR,avars,pr_len,
              i;

              sys1:=chevalleyAdj(u1);
              sys2:=chevalleyAdj(u2);
              if type(sys1)<>type(sys2) or
                 rank(sys1)<>rank(sys2) or
                 ring(sys1)<>ring(sys2) then Error("Not in the same family."); fi;

              return Unipotent(sys2,Concatenation(coefficients(u1),coefficients(u2)),Ordering(u2));
end);

InstallMethod(\*,
              "Action of unipotent element u on nilpotent e: u*e",
              [IsUnipotent,IsNilpotentChv],
              function(u,e)
              local result,
              sys1,sys2,Mrsi,pr,
              uas,r,s,i,pos;

              sys1:=chevalleyAdj(u);
              sys2:=chevalleyAdj(e);
              if type(sys1)<>type(sys2) or
                 rank(sys1)<>rank(sys2) or
                 ring(sys1)<>ring(sys2) then Error("Not in the same family.");
              fi;

              pr:=positiveRoots(sys1);
              Mrsi:=M(sys1);

              uas:=Reversed(coefficients(u));
              result:=List(coefficients(e),i->ShallowCopy(i));

              # for this see Carter pg.64
              for r in uas do
                  for s in result do
                      for i in [1..Length(Mrsi[r[1]][s[1]])] do
                          pos:=Position(pr,i*pr[r[1]]+pr[s[1]]);
                          result:=Concatenation(result,[[pos,Mrsi[r[1]][s[1]][i]*r[2]^i*s[2]]]);
                      od;
                  od;
              od;

              return NilpotentChv(sys2,result);
end);

InstallMethod(OrderOp,
              "Order of unipotent element",
              [IsUnipotent],
              function(u)
              local result,
              p,u_to_p,putere,i;

              if coefficients(u)=[] then return 1; fi;

              p:=Characteristic(chevalleyAdj(u));

              u_to_p:=u;
              for i in [1..p-1] do u_to_p:=u_to_p*u; od;

              result:=1;
              putere:=u_to_p;
              while coefficients(putere)<>[] do
                  putere:=putere*u_to_p;
                  result:=result+1;
              od;

              return p*result;
end);

InstallMethod(Comm,
              "Commutator for unipotent elements a^-1b^-1ab with the ordering of b",
              [IsUnipotent,IsUnipotent],
              function(u1,u2)
              local sys1,sys2;

              sys1:=chevalleyAdj(u1);
              sys2:=chevalleyAdj(u2);
              if type(sys1)<>type(sys2) or
                 rank(sys1)<>rank(sys2) or
                 ring(sys1)<>ring(sys2) then Error("Not in the same family."); fi;
              return Unipotent(sys2,
                                  Concatenation(coefficients(u1^-1),coefficients(u2^-1),
                                                     coefficients(u1),coefficients(u2)),
                                  Ordering(u2));
end);

InstallMethod(Conj,
              "Conjugation for unipotent elements b^-1ab with the ordering of b",
              [IsUnipotent,IsUnipotent],
              function(u1,u2)
              local sys1,sys2;

              sys1:=chevalleyAdj(u1);
              sys2:=chevalleyAdj(u2);
              if type(sys1)<>type(sys2) or
                 rank(sys1)<>rank(sys2) or
                 ring(sys1)<>ring(sys2) then Error("Not in the same family."); fi;
              return Unipotent(sys2,
                                  Concatenation(coefficients(u2^-1),coefficients(u1),coefficients(u2)),
                                  Ordering(u2));
end);

InstallMethod(Subword,
              "Subword of a unipotent element by list of roots",
              [IsUnipotent,IsList],
              function(u,l)
              local coeffs;
              coeffs:=Filtered(coefficients(u),i->i[1] in l);

              return Unipotent(chevalleyAdj(u),coeffs,Ordering(u));
end);

InstallMethod(InsertWord,
              "Shuffles a word into a unipotent element u according to the ordering of u",
              [IsUnipotent,IsList],
              function(u,word)
              local coeffs,
              sys,check,ord;

              sys:=chevalleyAdj(u);
              check:=ForAll(word,i-> i[2] in ring(sys));
              if not check then
                  Error("The word cannot be shuffled into u: not over the same ring!\n");
              fi;

              coeffs:=coefficients(u);
              coeffs:=Concatenation(coeffs,word);
              ord:=Ordering(u);
              Sort(coeffs,function(a,b) return ord[a[1]]<ord[b[1]]; end);
              coeffs:=Canonic(sys,coeffs,ord);

#              Setcoefficients(u,coeffs); Doesn't work this way

              return Unipotent(sys,coeffs,Ordering(u));
end);

#
# ---------- Lie Algebra Action ----------
#

InstallMethod(AduAlphat,
              "Adu_{alpha}(t) on the whole Lie algebra",
              [IsChevalleyAdj,IsPosInt,IsRingElement],
              function(sys,root,param)
              local result,
              pr,pr_len,roots,
              A_rs,M_rsi,
              L,CB,Rank,B,cochars,h,
              tmp,zero,unu,s,i,poz;

              pr:=positiveRoots(sys);
              pr_len:=Length(pr);
              roots:=Concatenation(pr,-pr);

              L:=lieAlgebra(sys);
              CB:=ChevalleyBasis(L);
              Rank:=rank(sys);
              B:=Basis(L);
              cochars:=Cocharacters(L);
              cochars:=List(cochars,i->Coefficients(B,i));

              zero:=Zero(ring(sys));
              unu:=One(ring(sys));

              A_rs:=A(sys);
              M_rsi:=M(sys);

              result:=[];
              # s in positive roots
              for s in [1..pr_len] do
                  tmp:=List([1..Dimension(L)],i->zero);

                  if s = root then
                      tmp[s]:=unu;
                  else
                      tmp[s]:=unu;
                      for i in [1..Length(M_rsi[root][s])] do
                          poz:=Position(roots,i*roots[root]+roots[s]);
                          tmp[poz]:=M_rsi[root][s][i]*param^i;
                      od;
                  fi;
                  Add(result,tmp);
              od;

              # s in negative roots
              for s in [1..pr_len]+pr_len do
                  tmp:=List([1..Dimension(L)],i->zero);

                  if s = root+pr_len then
                      # e_{-r}
                      tmp[s]:=unu;
                      # -t^2*e_{r}
                      tmp[root]:=-param^2;
                      # t*h_{r}
                      tmp:=tmp+param*cochars[root];
                  else
                      tmp[s]:=unu;
                      for i in [1..Length(M_rsi[root][s])] do
                          poz:=Position(roots,i*roots[root]+roots[s]);
                          tmp[poz]:=M_rsi[root][s][i]*param^i;
                      od;
                  fi;
                  Add(result,tmp);
              od;

              # h_s
              for s in [1..Rank] do
                  tmp:=List([1..Dimension(L)],i->zero);
                  # h_s
                  tmp:=tmp+cochars[s];
                  # -A_{sr}*t*e_r
                  tmp[root]:=-A_rs[s][root]*param;
                  Add(result,tmp);
              od;

              return result;#TransposedMat(result);
end);

InstallMethod(Adu,
              "Adu on the whole Lie algebra",
              [IsUnipotent],
              function(u)
              return Product(coefficients(u),i->AduAlphat(chevalleyAdj(u),i[1],i[2]));
end);

InstallMethod(AduJordanBlocksOp,
              "Computes Jordan Blocks of Adu using SageMath",
              [IsUnipotent],
              function(u)
              local sage_script,current_dir,tmp_file,result,
              ad,dim,i,j;

              sage_script:=Concatenation("~/sage/sage-4.7.2-linux-32bit-ubuntu_10.04_lts-i686-Linux/sage ",
                                      "~/workspace/ChevalleyAdj/sage/tmp/jordan.sage");
              current_dir:=Directory("~/workspace/ChevalleyAdj/sage/tmp/");
              tmp_file:=Filename(current_dir,"matrix.sage");
              result:=Filename(current_dir,"blocks.gap");

              #while IsPolynomialRing(ring(chevalleyAdj(u))) do u:=Descend(u,CoefficientsRing(ring(chevalleyAdj(u)))); od;
              if IsAlgebraicU(chevalleyAdj(u)) then u:=Descend(u,chevalleyAdj(chevalleyAdj(u))); fi;
              ad:=Adu(u);
              ad:=List(ad,i->List(i,j->Int(j)));
              PrintTo(tmp_file,"p=",String(Characteristic(chevalleyAdj(u))),"\nmat=");
              AppendTo(tmp_file,"[");
              dim:=Length(ad);
              for i in [1..dim] do
                  AppendTo(tmp_file,"[");
                  for j in [1..dim] do
                      AppendTo(tmp_file,String(ad[i][j]));
                          if j<>dim then AppendTo(tmp_file,","); fi;
                  od;
                  AppendTo(tmp_file,"]");
                  if i<>dim then AppendTo(tmp_file,",\n"); fi;
              od;
              AppendTo(tmp_file,"]");

              Exec(sage_script);

              result:=ReadAsFunction(result);
              result:=result();

              return result;
end);

InstallMethod(PositiveAdu,
              "Ad(u) restricted to Lie(U) where U is spanned by positive root groups",
              [IsUnipotent],
              function(u)
              local result,
              sys,
              baza,b,pr,pr_len;

              sys:=chevalleyAdj(u);
              pr:=positiveRoots(sys);
              pr_len:=Length(pr);
              baza:=List([1..pr_len],i->NilpotentChv(sys,[[i,1]]));

              result:=[];
              for b in baza do
                  result:=Concatenation(result,[u*b]);
              od;

              return List(result,i->LieAlgebraCoeffs(i){[1..pr_len]});
end);

InstallMethod(RestrictedAdu,
              "Ad(u) restricted to a subspace of Lie(U) spanned given (positive) roots",
              [IsUnipotent,IsList],
              function(u,roots)
              local sys,adu,pr,
              croots,check;

              if not IsInt(roots[1]) then TryNextMethod(); fi;

              sys:=chevalleyAdj(u);
              adu:=PositiveAdu(u);
              pr:=positiveRoots(sys);
              croots:=Filtered([1..Length(pr)],i->not i in roots);

              check:=Filtered(Concatenation(List(croots,i->adu[i]{roots})),j->j<>Zero(ring(sys)));
              if check<>[] then Error("Ade cannot be restricted like this."); fi;
              check:=Filtered(Concatenation(List(roots,i->adu[i]{croots})),j->j<>Zero(ring(sys)));
              if check<>[] then Error("Ade cannot be restricted like this."); fi;

              return List(roots,i->adu[i]{roots});
end);

InstallMethod(RestrictedAdu,
              "Ad(u) restricted to a subspace of Lie(U) spanned given (positive) roots",
              [IsUnipotent,IsList],
              1,
              function(u,vectors)
              local result,vectors_len,
              adu,img,
              CPR,cvar_names,cvars,cvectors,sysCPR,uu,
              tmp,generic,relations,relations_len,sol,i;

              vectors_len:=Length(vectors);

              cvar_names:=List([1..vectors_len],i->Concatenation("c_",String(i)));
              CPR:=PolynomialRing(ring(chevalleyAdj(u)),cvar_names);
              cvars:=IndeterminatesOfPolynomialRing(CPR);
              sysCPR:=ChevalleyAdj(chevalleyAdj(u),CPR);

              cvectors:=List(vectors,i->Ascend(i,sysCPR));
              uu:=Ascend(u,sysCPR);
              img:=List(cvectors,i->uu*i);

              result:=[];
              for i in [1..vectors_len] do
                  tmp:=ShallowCopy(cvars);
                  generic:=Sum(List([1..vectors_len],i->tmp[i]*cvectors[i]));
                  relations:=List(coefficients(img[i]-generic),i->i[2]);
                  relations:=Filtered(relations,i->i<>Zero(CPR));
              #Error("!");
                  tmp:=SolveRelations(relations,cvars,tmp,CPR);
                  if tmp[2]<>[] then
                      #Error("!");
                      Print("RestrictedAdu: did not solve all relations! ",relations,"\n");
                  fi;
                  tmp:=List(tmp[1],i->Value(i,cvars,cvars));
                  #tmp:=Sum(List([1..vectors_len],i->tmp[i]*vectors[i])); # I want the matrix
                  Add(result,tmp);
              od;

              return result;
end);

InstallMethod(PositiveFixedspace,
              "Ker of PositiveAdu",
              [IsUnipotent],
              function(u)
              local result,
              adu,sys,unu,pr,pr_len,ns;

              sys:=chevalleyAdj(u);
              pr:=positiveRoots(sys);
              pr_len:=Length(pr);

              adu:=PositiveAdu(u);
              unu:=DiagonalMat(List([1..pr_len],i->One(ring(sys))));
              ns:=NullspaceMat(adu-unu);

              result:=List(ns,v->List([1..pr_len],j->[j,v[j]]));
              result:=List(result,i->NilpotentChv(sys,i));

              return result;
end);

InstallMethod(RestrictedFixedspace,
              "Ker of RestrictedAdu",
              [IsUnipotent,IsList],
              function(u,roots)
              local result,
              radu,sys,unu,roots_len,ns;

              sys:=chevalleyAdj(u);
              roots_len:=Length(roots);

              radu:=RestrictedAdu(u,roots);
              unu:=DiagonalMat(List([1..roots_len],i->One(ring(sys))));
              ns:=NullspaceMat(radu-unu);

              result:=List(ns,v->List([1..roots_len],j->[roots[j],v[j]]));
              result:=List(result,i->NilpotentChv(sys,i));

              return result;
end);


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

Class(JoinDirectSums, RuleSet);
RewriteRules(JoinDirectSums, rec(
    combine := ARule(Compose, [@(1, DelayedDirectSum), @(2, DelayedDirectSum,
        e -> let(c1:=@(1).val.children(), c2:=e.children(), Length(c1) = Length(c2) and ForAll([1..Length(c1)], i->c1[i].dims()[2] = c2[i].dims()[1]))) ],
        e -> let(c1:=@(1).val.children(), c2:=@(2).val.children(), [ DelayedDirectSum(List([1..Length(c1)], i -> c1[i] * c2[i])) ])
    )
));

Class(TerminateDirectSums, RuleSet);
RewriteRules(TerminateDirectSums, rec(
    terminate := Rule(@(1, DelayedDirectSum), e-> DirectSum(@(1).val.children()).sums())
));


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

# ==========================================================================
# Sparse
# ==========================================================================
Class(Sparse, BaseMat, rec(
    new := meth(self, L)
        Constraint(IsList(L));
	if not ForAll(L, t -> IsList(t) and Length(t)=3 and
		              IsInt(t[1]) and IsInt(t[2])) then
	    Error("<L> must be a list of triples [i, j, a_(i,j)]");
	fi;
        return SPL(WithBases( self, rec( element := L,
				       dimensions := [ Maximum(List(L, t->t[1])),
				                       Maximum(List(L, t->t[2])) ]
                       )));
    end,
    #-----------------------------------------------------------------------
    dims := self >> [ Maximum(List(self.element, t->t[1])),
	              Maximum(List(self.element, t->t[2])) ],
    #-----------------------------------------------------------------------
    isPermutation := False,
    #-----------------------------------------------------------------------
    isReal := self >> ForAll(self.element, t -> IsRealNumber(t[3])),
    #-----------------------------------------------------------------------
    toAMat := self >> AMatMat(List(MatSparseSPL(self), r -> List(r, EvalScalar))),
    #-----------------------------------------------------------------------
    transpose := meth(self)  # we use CopyFields to copy all fields of self
        local L, t;
	L := [ ];
	for t in self.element do
	    Add(L, [t[2], t[1], t[3]]);
	od;
	return CopyFields(self, rec(element := L,
		                 dimensions := Reversed(self.dims())));
    end,
    conjTranspose := meth(self)  # we use CopyFields to copy all fields of self
        local L, t;
	L := [ ];
	for t in self.element do
	    Add(L, [t[2], t[1], Global.Conjugate(t[3])]);
	od;
	return CopyFields(self, rec(element := L,
		                 dimensions := Reversed(self.dims())));
    end,
    #-----------------------------------------------------------------------
    arithmeticCost := meth(self, costMul, costAddMul)
        local cost, row, elms;
	cost := costMul(0) - costMul(0); # will work even when costMul(0) <> 0
	for row in [1..self.dimensions[1]] do
	    elms := Filtered(self.element, e -> e[1]=row);
	    if Length(elms) > 0 then
		cost := cost + costMul(elms[1][3])
		             + Sum(elms{[2..Length(elms)]}, e -> costAddMul(e[3]));
	    fi;
	od;
	return cost;
    end
));


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

#F RuleTreeOps.\=( <ruletree1>, <ruletree2> )
#F    returns true if <ruletree1> and <ruletree2> are equal, i.e., they
#F    represent the same breakdown strategy.  Otherwise, false is returned.
#F

RuleTreeOps := CantCopy(OperationsRecord("RuleTreeOps"));

IsRuleTree := T -> IsRec(T) and IsBound(T.isRuleTree) and T.isRuleTree;

#F Ruletrees
#F =========
#F
#F A ruletree is a record with the following mandatory fields:
#F
#F   isRuleTree  = "true"              # identifies ruletrees
#F   operations  = RuleTreeOps         # operations record
#F   node        = <spl>               # the spl expanded
#F   transposed  = false/true          # indicates whether <rule> or
#F                                       transpose - <rule> - transpose
#F   rule        = <rule>              # the rule chosen
#F   children    = <list>              # the children, a list of
#F                                       ruletrees/non-terminal spls
#F
#F Note that children can be a list of ruletrees as well as non-terminal spls.
#F The field children is empty iff the ruletree is a leaf.
#F In general, the .node is a non-terminal spl that is expanded by .rule.
#F
#F The following fields are optional:
#F   splOptions = [ <option1>, <option2>, .. ]
#F     valid <options> : "unrolled", "pcl"
#F

Class(RuleTreeClass, rec(
    spl  := self >> SPLRuleTree(self),
    measure := self >> SPLRuleTree(self).measure(),
    shortPrint := false,
    dims := self >> self.node.dims(),
    dmn  := self >> self.node.dmn(),
    rng  := self >> self.node.rng(),

    print := meth(self, i, is)
        local ch;

        if Length(self.children) = 0 then
           # print leaves in one line
            Print(self.rule, "( ");
            When (self.transposed, Print("\"T\","));
            self.node.print(i+is, is);
            When (IsBound(self.splOptions),
                Print(", ", self.splOptions, " )"),
                Print(" )"));
        else
            # print children on separate lines
            Print(self.rule, "( ",
                When(self.transposed, "\"T\", ", ""),
                When(not self.shortPrint, self.node.print(i+is, is), ""), ",\n", Blanks(i+is)
            );
            self.children[1].print(i+is, is);
            for ch in Drop(self.children, 1) do
                Print(",\n", Blanks(i+is));
                ch.print(i+is, is);
            od;

            When (IsBound(self.splOptions),
                Print("\n", Blanks(i), ", ", self.splOptions, " )"),
                Print(" )"));
        fi;
    end,

    # new with tSPL and opts.baseHash:
    # we cannot blindly transpose everything, as vector
    # permutations that are automatically generated
    # may not support transposition
    transpose := self >>
        When((not self.node.transposeSymmetric()) and self.node.isSymmetric(),
            self,
            RuleTree(
                self.rule,
                When(self.transposed, "", "T"),
                self.node.transpose(),
                List(self.children, x->x.transpose())
        )
    ),
    # RuleTreeRewriting enabled by default
    # one can disable it with "EnableRuleTreeRewriting(false)"
    rChildren := (self) >> [ self.node, self.children ],
    rSetChild := rSetChildFields("node", "children"),
    from_rChildren := (self, rch) >>
        RuleTree(self.rule, When(self.transposed, "T", ""), rch[1], rch[2])
));

RuleTreeOps.\= := function( T1, T2 )
    return
        IsRuleTree(T1) and IsRuleTree(T2) and
        T1.rule = T2.rule and
        T1.transposed = T2.transposed and
        IsIdenticalSPL(T1.node, T2.node) and
        T1.children = T2.children and
        (   (   IsBound(T1.splOptions) and
		        IsBound(T2.splOptions) and
                T1.splOptions = T2.splOptions
			) or
            (   not IsBound(T1.splOptions) and
			    not IsBound(T2.splOptions)
			)
        );
end;

#F RuleTreeNC( <rule>, <non-terminal spl>, <children> )
#F   returns the corresponding ruletree without any checking.

RuleTreeNC := function ( R, S, C )
    return WithBases(RuleTreeClass,
        rec(
            isRuleTree := true,
            operations := RuleTreeOps,
            node       := S,
            transposed := false,
            rule       := R,
            children   := C
		)
    );
end;

#F RuleTree(
#F   <rule>,
#F   [ "T" ,]
#F   <non-terminal spl>
#F   [, <children> ]
#F   [, <list-of-sploptions> ]
#F )
#F
#F   Creates a ruletree for <non-terminal spl>
#F   using <rule> with <children>. The <children> can be non-terminal spls
#F   or ruletrees. It is checked whether <children> can be derived
#F   from <non-terminal spl> using <rule>.
#F   If the string "T" is supplied, then instead of <rule>, the
#F   sequence transpose - <rule> - transpose is denoted. In this case
#F   <non-terminal spl> and <children> are also transposed. This construction
#F   avoids unnecessary recoding of rules that are just transposes of
#F   other rules. In this case, <rule> must have the field
#F   .forTransposition set to true.
#F
#F   The argument <list-of-sploptions> provides options used for spl compilation.
#F   See top of this file for valid options; examples are "unrolled" and "pcl".
#F   <children> might be empty (default) in which case the ruletree
#F   returned is a leaf.
#F
RuleTree := function ( arg )
    local a, R, t, S, C, u, S1, C1, RT;
    S := false;
    t := false;
    u := [ ];
    C := [ ];
    R := false;

    for a in arg do
        if IsString(a) and a = "T" then
	        t := true;
        elif IsList(a) and ForAll(a, IsString) then
	        u := a;
        elif IsSPL(a) then
			if S=false then
				S := a;
			else
				Add(C, a);
			fi;
		elif IsRuleTree(a) then
			Add(C, a);
		elif IsList(a) then
			Append(C, a);
		elif IsRule(a) and R=false then
			R := a;
		else Error(
			"usage: \n",
			"  RuleTree( \n",
			"    <rule>, [ \"T\" ,] <non-terminal spl> \n",
			"    [, <children> ] [, <list-of-sploptions> ] )");

		fi;
    od;

    Constraint(IsRule(R));
    Constraint(IsSPL(S));

    if not IsList(u) and ForAll(u, IsString) then
        Error("<u> must be a list of spl options");
    elif not (IsList(C) and ForAll(C, c -> IsSPL(c) or IsRuleTree(c))) then
        Error("<C> must be a list of ruletrees or non-terminal spls");
    fi;

    RT := RuleTreeNC(R, S, C);
    if u <> [ ]
	    then RT.splOptions := u;
	fi;
    return RT;
end;

#F ExtractChildrenSPL ( <spl> )
#F   returns the list of non-terminal spls contained in <spl>.
#F   The order is left first - depth first (non-terminals are
#F   always leaves.
#F
ExtractChildrenSPL := S -> Collect(S, @.cond(IsNonTerminal));

#F CopyRuleTree( <ruletree> )
#F   returns a copy of <ruletree>. All fields apart from .children
#F   are copied by reference.
#F
CopyRuleTree := function( orig )
    local new;
    new := ShallowCopy(orig);
    if IsRuleTree(new) then
	    new.children := List(orig.children, CopyRuleTree);
	fi;
    return new;
end;

_matchChildren := (C1, C2) ->
    Length(C1)=Length(C2) and
    ForAll([1..Length(C1)],
       j -> IsHashIdenticalSPL(HashAsSPL(C1[j]), HashAsSPL(C2[j])) or
            (ObjId(C1[j])=InfoNt and ObjId(C2[j])=InfoNt));

#F ApplyRuleTreeSPL( <ruletree>, <spl>, <opts> )
#F   creates a ruletree for <spl> using rules from the <ruletree>
#F   (if possible)
#F   Uses: opts.breakdownRules (for backwards compatibility of R.switch only)
ApplyRuleTreeSPL := function ( rtree, spl, opts )
    local i, R, C, C1, CC, children, L;
    Constraint(IsRuleTree(rtree));
    Constraint(IsSPL(spl));

    if rtree.transposed then
        return ApplyRuleTreeSPL(rtree.transpose(), spl.transpose(), opts).transpose();
    fi;

    R := rtree.rule;
    children:=[];

    # if <spl> was not compatible with <ruletree>.node to start with
    # then at some point there will be a split in <ruletree> that is not
    # applicable to the generated ruletree.
    if not IsApplicableRule( R, spl, opts.breakdownRules ) then
        Error("<rtree> can not be expanded from <spl>");
    fi;

    # determine the right set of children from allChildren to be used
    # in expansion
    C1 := _allChildren(R, rtree.node, opts);
    C := List([1..Length(rtree.children)], c -> rtree.children[c].node);
    i := PositionProperty([1..Length(C1)], j -> _matchChildren(C1[j], C));

    # DEBUG HACK: AppendTo("applytree", R, "\n", C, "\n", C1, "\n---------\n");
    if i = false then
        Error("<ruletree> can not be expanded from <spl>, could not find matching children");
	fi;

    # determine all children for <spl> and pick the right set
    L :=  _allChildren(R, spl, opts);
    if i > Length(L) then
        Error("<ruletree> can not be expanded from <spl>");
    else
        C1 := L[i];
    fi;

    # recurse and return
    children := List([1..Length(rtree.children)], i -> ApplyRuleTreeSPL(rtree.children[i], C1[i], opts));

    return RuleTreeNC(R, spl, children);
end;

#F Printing RuleTrees
#F ------------------
#F

#F RuleTreeOps.Print( <ruletree> [, <indent> , <indentStep> ] )
#F   prints <ruletree> with <indent>. Further indenting is done
#F   in steps of size <indentStep>. The default is
#F   indent = 0, indentStep = 2.
#F
RuleTreeOps.Print := function ( arg )
    local T, indent, indentStep;
	if Length(arg) = 1 then
        T          := arg[1];
        indent     := 0;
        indentStep := 2;
    elif Length(arg) = 3 then
        T          := arg[1];
        indent     := arg[2];
        indentStep := arg[3];
    else
        Error("usage: RuleTreeOps.Print( <ruletree> [, <indent> , <indentStep> ] )");
    fi;
    Constraint(IsRuleTree(T));
    Constraint(IsPosInt0(indent));
    Constraint(IsPosInt0(indentStep));
    T.print(indent, indentStep);
end;

PrintRuleTreeCustom := function (T, i, is, spl_print, ruletree_print)
    local ch;
    Constraint(IsRuleTree(T) or IsSPL(T));
    Constraint(IsPosInt0(i));
    Constraint(IsPosInt0(is));

    if IsSPL(T) then
        spl_print(T);
    else # T is a ruletree
        Print(Blanks(i), ruletree_print(T), "\n");
        for ch in T.children do
            PrintRuleTreeCustom(ch, i+is, is, spl_print, ruletree_print);
        od;
    fi;
end;

#F PrintNodesRuleTree(
#F   <ruletree/non-terminal spl> [, <indent> , <indentStep> ]
#F )
#F   pretty prints <ruletree> by displaying only the nodes (non-terminals)
#F   and its parameters. The tree structure is expressed by indentation.
#F   Non-terminals are being marked by (nt).
#F

PrintNodesRuleTree := function ( arg )
    local T, i, is;
    if Length(arg) = 1 then
        T := arg[1];
		i := 0;
		is := 2;
    elif Length(arg) = 3 then
        T := arg[1];
		i := arg[2];
		is := arg[3];
    else
        Error("usage: PrintNodesRuleTree( <ruletree> [, <indent> , <indentStep> ] )");
    fi;
    PrintRuleTreeCustom(T, i, is,
        T -> Print(T, " (nt)"),
        T -> Print(T.node));
end;

#F PrintRulesRuleTree(
#F   <ruletree/non-terminal spl> [, <indent> , <indentStep> ]
#F )
#F   pretty prints <ruletree> by displaying only the rules and
#F   the node sizes in parentheses. Transposed rules are marked
#F   by ^T. The tree structure is expressed by indentation.
#F   Non-terminals are denoted by nt.
#F
PrintRulesRuleTree := function(arg)
    local T, i, is;
    if Length(arg) = 1 then
        T := arg[1]; i := 0; is := 2;
    elif Length(arg) = 3 then
        T := arg[1]; i := arg[2]; is := arg[3];
    else
        Error("usage: PrintRulesRuleTree( <ruletree> [, <indent> , <indentStep> ] )");
    fi;
    PrintRuleTreeCustom(T, i, is,
    T -> Print("nt (", T.dimensions[1], ")"),
    T -> Print(T.rule, When(T.transposed," ^ T",""), "(", T.node.dimensions[1], ")"));
end;

#F PrettyPrintRuleTree(
#F   <ruletree/non-terminal spl> [, <whiteIndent> [, <linedIndent> ] ]
#F )
#F   pretty prints <ruletree> by displaying only the nodes (non-terminals),
#F   their parameters, and the rules. The tree structure is expressed by
#F   indentation.  Non-terminals are being marked by (nt).
#F

PrettyPrintRuleTree := function ( arg )
    local T, chIndent, whiteIndent, linedIndent, oldLinedIndent, newline, params, i;

    # new line plus indents
    newline := function ( )
    local i;

    Print("\n");
    for i in [1..whiteIndent] do
        Print(" ");
    od;
    if not linedIndent = "" then
        Print( linedIndent, "--" );
    fi;
    end;

    # decode arg
    if Length(arg) = 1 then
        T           := arg[1];
        whiteIndent := 0;
        linedIndent := "";
    elif Length(arg) = 2 then
        T           := arg[1];
        whiteIndent := arg[2];
        linedIndent := "";
    elif Length(arg) = 3 then
        T           := arg[1];
        whiteIndent := arg[2];
        linedIndent := arg[3];
    else
        Error("usage: PrintNodesRuleTree( <ruletree> [, <indent> , <indentStep> ] )");
    fi;

    # check arguments
    if not ( IsRuleTree(T) or IsSPL(T) and T.type = "nonTerminal" ) then
        Error("<T> must be a ruletree or a non-terminal spl");
    fi;
    if not IsInt(whiteIndent) and whiteIndent >= 0 then
        Error("<whiteIndent> must be pos-int");
    fi;
    if not IsString(linedIndent) then
        Error("<linedIndent> must be a string");
    fi;

    chIndent := whiteIndent+Length(linedIndent)+4;
    # spl case
    if IsSPL(T) then
        T.print(chIndent, 2); Print(" (nt)");
        return;
    fi;

    T.node.print(chIndent, 2);
    Print("     {" );
    Print(T.rule);
    if T.transposed then
        Print(" ^ T");
    fi;
    if IsBound(T.splOptions) then
        Print(", ", T.splOptions);
    fi;
    Print( "}" );

    if Length(T.children) > 0 then
        if linedIndent = "" then
            oldLinedIndent := linedIndent;
        else
            oldLinedIndent := Concatenation( linedIndent, "  " );
        fi;
        linedIndent := Concatenation( oldLinedIndent, " |" );
        for i in [1..Length(T.children)-1] do
            newline();
            PrettyPrintRuleTree(T.children[i], whiteIndent, linedIndent);
        od;
        linedIndent := Concatenation( oldLinedIndent, " \`" );
        newline();
        linedIndent := Concatenation( oldLinedIndent, "  " );
        PrettyPrintRuleTree(T.children[Length(T.children)],
                            whiteIndent, linedIndent);
        linedIndent := oldLinedIndent;
    fi;
    if whiteIndent = 0 and linedIndent = "" then
        newline();
    fi;
end;

#F Converting RuleTrees
#F --------------------
#F

#F AMatRuleTree( <ruletree> ) - returns an amat corresponding to ruletree.
#F
AMatRuleTree := T -> AMatSPL(SPLRuleTree(T));

#F MatRuleTree( <ruletree> ) -  returns the matrix corresponding to ruletree.
#F
MatRuleTree := T -> MatSPL(SPLRuleTree(T));

#F Creating Random RuleTrees
#F -------------------------
#F

Declare(SemiRandomRuleTree, _SemiRandomRuleTree);

#F RandomRuleTree( <spl> , <opts>)
#F    returns a random rule tree for <spl>
#F    or 'false' if no breakdown rule combination leads to a
#F    fully expanded ruletree.
#F
#F   Uses: opts.baseHashes
#F         opts.breakdownRules
#F   Optional:  (see Doc(_allChildren) ) for usage
#F         opts.restrictSplit
#F         opts.restrictSplitSize
#F
RandomRuleTree := (spl, opts) -> _SemiRandomRuleTree(spl, false, s->false, opts);

RandomRuleTreeCutoff := (spl, cutoff_func, opts) -> _SemiRandomRuleTree(spl, false, cutoff_func, opts);

RandomRuleTreeDP := (t, opts) -> let(res := spiral.search.DP(t, rec(measureFunction := (R,O)->Random([1..10000]), verbosity := 0), opts), When(res = [], false, res[1].ruletree));

#F SemiRandomRuleTree( <spl>, <top_rule>, opts )
#F    returns a random rule tree for <spl> with fixed top-level rule
#F    or 'false' if no breakdown rule combination leads to a
#F    fully expanded ruletree.
#F
#F   Uses: opts.baseHashes
#F         opts.breakdownRules
#F   Optional:  (see Doc(_allChildren) ) for usage
#F         opts.restrictSplit
#F         opts.restrictSplitSize
#F
SemiRandomRuleTree := (spl, top_rule, opts) -> _SemiRandomRuleTree(spl, top_rule, s->false, opts);

_SemiRandomRuleTree := function(spl, top_rule, cutoff_func, opts)
    local ch, i, R, rules, rule, rand, candidates, ch, children, ch_candidates;

    if not (IsSPL(spl)) then
        Error("usage: SemiRandomRuleTree( <spl>, <top_rule>, <cutoff>, <opts> )");
    elif cutoff_func(spl) then
	    return spl;
    elif MultiHashLookup(opts.baseHashes, spl) <> false then
        return MultiHashLookup(opts.baseHashes, spl)[1].ruletree;
    else
        if top_rule <> false then
            rules := [top_rule];
        else
            rules  := AllApplicableRulesDirect(spl, opts.breakdownRules);
            if rules = [ ] then
                return false;
            fi;
        fi;

        candidates := Set([1..(Length(rules))]);
        while candidates <> [] do
            rand := RandomList(candidates);
            RemoveSet(candidates, rand);

            if rand <= Length(rules) then
                rule := rules[rand];
                ch_candidates := _allChildren(rule, spl,opts);
                ch_candidates := Permuted(ch_candidates, Random(SymmetricGroup(Length(ch_candidates))));
                for children in ch_candidates do
                    children := List( children, s -> _SemiRandomRuleTree(s, false, cutoff_func, opts) );
                    if not ForAny(children, c -> IsBool(c) and c=false) then
                        return RuleTreeNC( rule, spl, children );
                    fi;
                od;
            fi;
        od;
        return false;
   fi;
end;

#F Creating all RuleTrees
#F ----------------------
#F
#ExpandSPLRules := function( S, ruleset )
ExpandSPLRules := function( arg )
    local i, L, R, S, ruleset, opts;
    S := arg[1];
    ruleset := arg[2];
    Constraint(IsSPL(S));

    if IsBound(arg[3]) then
	    opts := arg[3];
    else
	    opts := rec();
	fi;

    L  := [ ];
    for R in AllApplicableRulesDirect(S, ruleset) do
        Append(L, List(_allChildren(R,S,opts), c -> RuleTreeNC(R, S, c)));
    od;

    return L;
end;

#F ExpandSPL( <spl>, <opts> )
#F   performs one expansion of <spl> in all possible ways,
#F   and returns the list of the derived ruletrees.
#F   If there are no breakdown rules for <spl> (i.e., not a non-terminal)
#F   then the default base cases rule @_Base is used, which means that
#F   the recursion will continue on its children
#F
#F   Uses: opts.baseHashes
#F         opts.breakdownRules
#F
ExpandSPL := (S, opts) -> ExpandSPLRules(S, opts.breakdownRules, opts);

_AllRuleTrees := function ( S, cutoff, memohash, opts )
    local L, L1, T, Lc, i, cs, T1, lkup;

    # check cutoff, baseHashes, and our memoization hash
    if cutoff(S) then
		return [S];
	fi;
    lkup := MultiHashLookup(opts.baseHashes, S);
    if lkup <> false then
		return [lkup[1].ruletree];
	fi;

    lkup := HashLookup(memohash, S);
    if lkup <> false
		then return lkup;
	fi;

    L := ExpandSPL(S, opts);
    if ForAll(L, r -> r.children = [ ]) then
		HashAdd(memohash, S, L);
		return L;
    fi;

    L1 := [ ];
    for T in L do
        Lc := [ ];
		for i in [1..Length(T.children)] do
            Lc[i] := _AllRuleTrees(T.children[i], cutoff, memohash, opts);
		od;
		for cs in Cartesian(Lc) do
            T1 := ShallowCopy(T);
			T1.children := cs;
			Add(L1, T1);
		od;
    od;

    HashAdd(memohash, S, L1);
    return L1;
end;

#F AllRuleTrees( <spl>, <opts> )
#F   expands <spl> in all possible ways and returns the obtained list
#F   of fully expanded ruletrees (ruletrees containing no non-terminals).
#F   Note that subtrees are "by reference", i.e., modifying one subtree
#F   alters the same subtree in some other expansions.
#F
#F   Uses: opts.baseHashes
#F         opts.breakdownRules
#F   Optional:  (see Doc(_allChildren) ) for usage
#F         opts.restrictSplit
#F         opts.restrictSplitSize
#F
AllRuleTrees := (S, opts) -> _AllRuleTrees(S, x->false, HashTableSPL(), opts);

#F AllRuleTreesCutoff( <spl>, <cutoff_func>, <opts> )
#F   expands <spl> in all possible ways and returns the obtained list
#F   of fully expanded ruletrees (ruletrees containing no non-terminals).
#F   Note that subtrees are "by reference", i.e., modifying one subtree
#F   alters the same subtree in some other expansions.
#F   <cutoff_func> is of the form e -> e = <cutoff>
#F
#F   Uses: opts.baseHashes
#F         opts.breakdownRules
#F
AllRuleTreesCutoff := (S, cutoff_func, opts) -> _AllRuleTrees(S, cutoff_func, HashTableSPL(), opts);

_NofRuleTrees := function ( S, cutoff, memohash, opts, level, trace )
    local p, Cs, n, lkup, indentstr, i;
    Constraint(IsSPL(S));
    Constraint(IsRec(opts));

    if trace then
        indentstr := "";
        for i in [2..level] do
            indentstr := Concat(indentstr, ".  ");
        od;
        indentstr := Concat(indentstr, String(level), " ");
        Print(indentstr, ">> _NofRuleTrees(", S, ")\n");
    fi;

    # check cutoff, baseHashes, and our memoization hash
    if cutoff(S) then
        if trace then
            Print(indentstr, "<< (cutoff) 1\n");
        fi;
        return 1;
    fi;
    if MultiHashLookup(opts.baseHashes, S) <> false then
        if trace then
            Print(indentstr, "<< (MultiHashLookup) 1\n");
        fi;
        return 1;
    fi;
    lkup := HashLookup(memohash, S);
    if lkup <> false then
        if trace then
            Print(indentstr, "<< hashed: ", lkup, "\n");
        fi;
        return lkup;
    fi;

    # first apply rules as they are
    Cs := List(AllApplicableRulesDirect(S, opts.breakdownRules), r -> _allChildren(r,S, opts));
	if trace then
        Print(indentstr, "   Cs: ", Cs, "\n");
    fi;

    if Cs = [ [ ] ] then
        n := 1;
    else
        n := Sum(Cs, c -> Sum(c, l -> Product(l, x -> _NofRuleTrees(x, cutoff, memohash, opts, level+1, trace))));
    fi;

    HashAdd(memohash, S, n);

    if trace then
        Print(indentstr, "<< (", S, ") ", n, "\n");
    fi;

    return n;
end;

#F NofRuleTrees ( <spl>, <opts> )
#F   returns the number of ruletrees for <spl>.
#F
#F   Uses: opts.baseHashes
#F         opts.breakdownRules
#F   Optional:  (see Doc(_allChildren) ) for usage
#F         opts.restrictSplit
#F         opts.restrictSplitSize
#F
#F   if opts.verbosity > 3 prints trace info

NofRuleTrees := (spl, opts) -> _NofRuleTrees(spl, x->false, HashTableSPL(), opts, 1, IsBound(opts.verbosity) and (opts.verbosity > 3));

NofRuleTreesCutoff := (spl, cutoff_func, opts) -> _NofRuleTrees(spl, cutoff_func, HashTableSPL(), opts, 1, IsBound(opts.verbosity) and (opts.verbosity > 3));

#F RulesInRuleTree( <ruletree> )
#F   return the set of rules contained in <ruletree>.
#F
RulesInRuleTree := function ( T )
    local C;
    Constraint(IsRuleTree(T));

    # base case
    if T.children = [ ] then
	    return Set([T.rule]);
	fi;

    # recurse with ruletree children
    C := Filtered(T.children, IsRuleTree);
    C := Set(Concatenation(List(C, RulesInRuleTree)));
    AddSet(C, T.rule);
    return C;
end;

#F RulesInRuleTreeAll( <ruletree> )
#F   return the histogram of all rules contained in <ruletree> as set
#F   of pairs [rule, number].
#F
RulesInRuleTreeAll := function ( T )
    local C, C1, c, i;
    Constraint(IsRuleTree(T));

    # base case
    if T.children = [ ] then
	    return Set([ [T.rule, 1] ]);
	fi;

    # recurse with ruletree children
    C := Filtered(T.children, IsRuleTree);
    C := Concatenation(List(C, RulesInRuleTreeAll));

    # merge
    C1 := [ ];
    for c in C do
        i := PositionProperty(C1, p -> c[1] = p[1]);
        if i = false then
            AddSet(C1, c);
        else
            C1[i][2] := C1[i][2] + c[2];
        fi;
    od;

    i := PositionProperty(C1, p -> p[1] = T.rule);
    if i = false then
        AddSet(C1, [T.rule, 1]);
    else
        C1[i][2] := C1[i][2] + 1;
    fi;
        return C1;
end;

ApplyRuleTreeStep := function ( rt, recurse )
    local nt, C, Nonterms, S, c;
    if IsNonTerminal(rt) or IsSPL(rt) then
	    return rt;
	fi;

    Constraint(IsRuleTree(rt));

    C := List(rt.children, recurse);
    nt := rt.node;
    Nonterms := List(rt.children, c -> When(IsRuleTree(c), c.node, c));

    if rt.transposed then
        nt := TransposedSPL(nt);
        C := List(C, TransposedSPL);
        Nonterms := List(Nonterms, TransposedSPL);
    fi;

    S := _apply(rt.rule, nt, C, Nonterms);
    if rt.transposed then
	    S := TransposedSPL(S);
	fi;

    trace_log.addTreeExpansion(rt.rule,nt,S,rt.children,CopyFields(rt.node, rec(params := C)), var);

    S.root := rt.node;
    return S;
end;

SPLRuleTreeStep := rt -> ApplyRuleTreeStep(rt, c -> RecursStep(
    When(IsRuleTree(c), RTWrap(c), c)));

_SPLRuleTree := rt -> ApplyRuleTreeStep(rt, _SPLRuleTree);

SPLRuleTree := function(rt)
    local spl, t, tag;
    trace_log.beginStage("tSPL","SPL", rt.node);
    spl := ApplyRuleTreeStep(rt, _SPLRuleTree);

    # tags may inject container objects
    t := rt.node;
    if IsBound(t.getTags) then
        for tag in Reversed(t.getTags()) do
            if IsBound(tag.container)
			    then spl := tag.container(spl);
			fi;
        od;
    fi;
    trace_log.endStage("tSPL","SPL", spl);
    return spl;
end;

# forward declaration for function that does all the work.
Declare(_ruleTreeN);

#F RandomRuleTrees( <spl>, <num>, <opts>)
#F    returns <num> random rule trees for <spl>
#F    uniformly distributed amongst the potential trees
#F    or 'false' if no breakdown rule combination leads to a
#F    fully expanded ruletree.
#F
#F   Uses: opts.baseHashes
#F         opts.breakdownRules
#F   Optional:  (see Doc(_allChildren) ) for usage
#F
RandomRuleTrees := function(spl, num, opts)
    local n, rand, memohash;

    memohash := HashTableSPL();

    n := _NofRuleTrees(spl, s -> false, memohash, opts, 1, false);

    if num >= n then
        rand := [1..n];
    else
        rand := [];
        while Length(rand) <> num do
            rand := Set(Concat(rand, [RandomList([1..n])]));
        od;
    fi;

    return List(rand, e -> _ruleTreeN(spl, e-1, memohash, opts));
end;

# helper functions/arrays for _ruleTreeN and _ruleTree1

_getNumTrees := (s, memohash, opts) -> let(
    n := HashLookup(memohash, s),
    When(n = false,
        _NofRuleTrees(s, e -> false, memohash, opts, 1, false),
        n
    )
);
#F RuleTreeN(<spl>, <num>, <opts>)
#F   returns ruletree of index <num>
#F
#F   Uses: opts.basHashes, opts.breakdownRules.
#F
RuleTreeN := function(spl, num, opts)
    local memohash, n, r;

    memohash := HashTableSPL();
    n := _NofRuleTrees(spl, s -> false, memohash, opts, 1, false);

    if num in [1..n] then
        r := _ruleTreeN(spl, num-1, memohash, opts);

    else
        r := false;
    fi;

    return r;
end;

# fold list inside out, favoring the right hand side

_foldedMidFirst := function(origlist)
	local len, midpt, front, back, newlist;

	len := Length(origlist);
	if len < 2 then
		return origlist;
	fi;
	midpt := Int(len/2);
	front := Reversed(Sublist(origlist, [1..midpt]));
	back  := Sublist(origlist, [midpt+1..len]);

	newlist := [];

	if IsOddInt(len) then
		Append(newlist, [back[1]]);
		back := Drop(back,1);
	fi;

	while (front <> []) or (back <> []) do
		if back <> [] then
			Append(newlist, [back[1]]);
			back := Drop(back,1);
		fi;
		if front <> [] then
			Append(newlist, [front[1]]);
			front := Drop(front, 1);
		fi;
	od;

	return newlist;
end;

Declare(_ruleTreeMid);

#F RuleTreeMid(spl, opts)
#F
#F   Similar to RuleTree1, but tries to grab the middle of each range of choices
#F

RuleTreeMid := (spl, opts) -> _ruleTreeMid(spl, HashTableSPL(), opts);

_ruleTreeMid := function(spl, memohash, opts)
    local h, R, r, C, c, ch, npc, idx, idxlist, ridx, ridxlist;

    h := MultiHashLookup(opts.baseHashes, spl);

    if h <> false then
        return h[1].ruletree;
    fi;

    R := AllApplicableRulesDirect(spl, opts.breakdownRules);
	ridxlist := [1..Length(R)];
	if Length(ridxlist) > 1 then
		if Length(_allChildren(R[1], spl, opts)) < 2 then
			ridxlist := _foldedMidFirst(ridxlist);
		fi;
	fi;
    for ridx in ridxlist do
		r := R[ridx];
		C := _allChildren(r, spl, opts);
		idxlist := _foldedMidFirst([1..Length(C)]);
		for idx in idxlist do
			c := C[idx];
			npc := Product(c, e -> _getNumTrees(e, memohash, opts));
			if npc > 0 then
				ch := List(c, e -> _ruleTreeMid(e, memohash, opts));
				if not ForAny(ch, e -> IsBool(e) and e=false) then
					return RuleTreeNC(r, spl, ch);
				fi;
			fi;

        od;
    od;
	# no tree, return original spl
    return spl;
end;

Declare(_ruleTree1);

#F RuleTree1(spl, opts)
#F
#F   returns the first ruletree. this is often useful for
#F   testing whether a particular rule is firing, and you
#F   want to avoid the randomness of RandomRuleTree
#F
#F   NOTE: this function does not check if a tree can
#F   actually just be created, it just tries to return
#F   the first one. RuleTreeN(spl, 1, opts) does the
#F   same thing but first checks.
#F

RuleTree1 := (spl, opts) -> _ruleTree1(spl, HashTableSPL(), opts);

_ruleTree1 := function(spl, memohash, opts)
    local h, R, r, i, c, ch, npc;

    h := MultiHashLookup(opts.baseHashes, spl);

    if h <> false then
        return h[1].ruletree;
    fi;

    R := AllApplicableRulesDirect(spl, opts.breakdownRules);
    for r in R do
		for c in _allChildren(r, spl, opts) do
			npc := Product(c, e -> _getNumTrees(e, memohash, opts));
			if npc > 0 then
				ch := List(c, e -> _ruleTree1(e, memohash, opts));
				if not ForAny(ch, e -> IsBool(e) and e=false) then
					return RuleTreeNC(r, spl, ch);
				fi;
			fi;
        od;
    od;
	# no tree, return original spl
    return spl;
end;

#F _ruleTreeN(<spl>, <num>, <memohash>, <opts>)
#F   internal function which returns a ruletree for
#F   <spl> with index given by <num>. This is a recursive
#F   routine. Note that <num> is 0-based, unlike everything
#F   else in SPIRAL, which is 1-based.
#F
_ruleTreeN := function(spl, num, memohash, opts)
    local R, rtNC, h, r, c, npc, off, ch, i, n, p, offset;

    # lookup stuff like SSE base cases.
    h := MultiHashLookup(opts.baseHashes, spl);

    if h <> false then
       return h[1].ruletree;
    fi;

    # get list of normal rules
    R := AllApplicableRulesDirect(spl, opts.breakdownRules);
    offset := 0;

    for r in R do
        for c in _allChildren(r, spl, opts) do
            # figure out which group of children we should be looking at.
            npc := Product(c, e -> _getNumTrees(e, memohash, opts));

            # is this the correct group?
            if num < offset + npc then
                off := npc;
                ch := [];

                # step through the kids, and push down the ruletree number
                for i in [1..Length(c)] do
                    n := _getNumTrees(c[i], memohash, opts);

                    off := When(n > 0, off / n, off);

                    p := When(n <= 0 or num <= offset,
                        0,
                        RemInt(QuoInt(num - offset, off), n)
                    );

                    # all the kids get evaluated
                    Add(ch, _ruleTreeN(c[i], p, memohash, opts));
                od;

                # no kids should be false, but just in case.
                if not ForAny(ch, e -> IsBool(e) and e=false) then
                    return RuleTreeNC(r, spl, ch);
                fi;
            fi;

            # fixup offset
            offset := offset + npc;
        od;
    od;

	# no tree, return original spl
    return spl;
end;

Declare(_ruleTreeGetN);

#F RuleTreeGetN(<ruletree>, <opts>)
#F given a ruletree, determine the index
#F
#F uses:
#F      opts.breakdownRules
#F      opts.baseHashes
#F

RuleTreeGetN := function(ruletree, opts)
    local memohash, r;

    memohash := HashTableSPL();

    # prime the memohash.
    _NofRuleTrees(ruletree.node, s -> false, memohash, opts, 1, false);

    r := _ruleTreeGetN(ruletree, memohash, opts, 0);

    # ruleTreeGetN may return false if we couldn't match the tree in the passed
    # in breakdownRules/baseHashes.
    return When(IsInt(r), r + 1, false);
end;

_ruleTreeGetN := function(rt, memohash, opts, offset)
    local h, R, r, c, ch, off, n;

    # is the ruletree something from the baseHashes?
    h := MultiHashLookup(opts.baseHashes, rt.node);
    if IsList(h) and rt = h[1].ruletree then
        return offset;
    fi;

    R := AllApplicableRulesDirect(rt.node, opts.breakdownRules);

    for r in R do
        # does rule match?
        if r = rt.rule then
            for c in _allChildren(r, rt.node, opts) do
                # does child match?
                if c = List(rt.children, e -> e.node) then
                    off := Product(rt.children, e -> _getNumTrees(e.node, memohash, opts));
                    for ch in rt.children do
                        n := _getNumTrees(ch.node, memohash, opts);
                        off := When(n > 0, off / n, off);
                        offset := offset + (off * _ruleTreeGetN(ch, memohash, opts, 0));
                    od;
                    return offset;
                # child doesn't match, increase offset
                else
                    offset := offset + Product(c, e -> _getNumTrees(e, memohash, opts));
                fi;
            od;
        # rule doesn't match, so increase offset by all possible expansions we didn't use
        else
            offset := offset
                + Sum(_allChildren(r, rt.node, opts), C ->
                    Product(C, c -> _getNumTrees(c, memohash, opts))
                );
        fi;
    od;

    return offset;
end;


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

# ================================================================
# Simplification of Intervals
# ================================================================

full_II := (int, size) ->
    [int.target(II), size, 0, @.cond(e->e=size.val)];

empty_II := (int, size) ->
    [int.target(II).cond(e->e.params[2]=e.params[3]), size, @, @];

left_II := (int, size, endd) ->
    [int.target(II), size, 0, endd];

right_II := (int, size,start) ->
    [int.target(II), size, start, @.cond(e->e=size.val)];

Class(RulesII, RuleSet);

RewriteRules(RulesII, rec(
    # full II o index mapping func @(3) = II with domain of @(3)
    # II(n, 0, n) o f = II(domain(f), 0, domain(f))
    FullII_f := ARule(fCompose, [ full_II(@, @(1)), @(2) ],  e -> [ II(@(2).val.domain()) ]),
    EmptyII_f := ARule(fCompose, [ empty_II(@, @(1)), @(2) ],  e -> [ II(@(2).val.domain(),0,0) ]),

    # partial II o dirsum of perms
    # II(n, 0, k) o fDirsum(perm_k, perm_?) -> II(n,0,k)
    LeftII_fDirsum := ARule(fCompose,
        [ left_II(@(0), @(1), @(2)), [fDirsum, @(3).cond(e -> is_perm(e) and e.range()=@(2).val), ...]],
        e -> [ @(0).val ]),

    # partial II o dirsum of perms
    # II(n, n-k, n) o fDirsum(perm_?, perm_k) -> II(n,n-k,n)
    RightII_fDirsum := ARule( fCompose,
        [ right_II(@(0), @(1), @(2)), [fDirsum, ..., @(4).cond(e -> is_perm(e) and e.range() = @(1).val-@(2).val)]],
        e -> [ @(0).val ]),

    # fTensor(IIn, IIk) -> II(n*k)
    fullII_tensor_fullII := ARule(diagTensor, [full_II(@(0), @(1)), full_II(@(0), @(2))],
        e -> [ II(@(1).val * @(2).val) ]),

    # fDirsum(IIn, IIk) -> II(n+k)
    fullII_dirsum_fullII := ARule(diagDirsum, [full_II(@(0), @(1)), full_II(@(0), @(2))],
        e -> [ II(@(1).val + @(2).val) ]),

    diagTensor_emptyII := Rule([diagTensor, ..., empty_II(@(1), @(2)), ...], e -> II(e.domain(),0,0)),
    diagTensor_fullII_Id1 := ARule(diagTensor, [@(0), full_II(@(1), @(2).cond(e->e=1))], e -> [ @(0).val ]),
    diagTensor_fullII_Id2 := ARule(diagTensor, [full_II(@(1), @(2).cond(e->e=1)), @(0)], e -> [ @(0).val ]),

    II_dirsum_emptyII := ARule(diagDirsum, [[II, @(1), @(2), @(3)], empty_II(@(4), @(5))],
        e -> [ II(@(1).val + @(5).val), @(2).val, @(3).val ]),

    emptyII_dirsum_II := ARule(diagDirsum, [empty_II(@(4), @(5)), [II, @(1), @(2), @(3)]],
        e -> [ II(@(1).val + @(5).val), @(5).val + @(2).val, @(5).val + @(3).val ]),

    # II Shifting, we support shift left (shift <= start), and right (shift >= end)
    # II o Z = shifted II#
    II_Z := ARule(fCompose, [[II, @(1), @(2), @(3)], [Z, @(4), @(5).cond(e -> (e<=@(2).val) or (e >= @(3).val))]],
        e -> [II(@(1).val, (@(2).val-@(5).val) mod @(1).val,
               # this makes 0->size, because size mod size = 0
                let(last:=(@(3).val-@(5).val) mod @(1).val,
                    When(last=0, @(1).val, last))) ]),

    DiagFullII_toId := Rule([Diag, full_II(@(1), @(2))], e -> I(@(2).val)),
    Diag_fConst_toId := Rule([Diag, [fConst, @(2), @(1), 1]], e -> I(@(1).val)),
    Diag_fConstV_toId := Rule([Diag, [fConst, @(2), @(1), _1]], e -> I(@(1).val)),

    COND_fullII := Rule([COND, full_II(@(1), @(2)), @(3), @(4)], e -> @(3).val),
    COND_emptyII := Rule([COND, full_II(@(1), @(2)), @(3), @(4)], e -> @(4).val)
));


#############################################################################
##
##  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