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

_DHT_CONST := 2.5;

#F TDHT(<n>, <k>) - RDFT Nonterminal
Class(TDHT, TaggedNonTerminal, rec(
    abbrevs := [ (n) -> Checked(IsPosInt(n),  [n]) ],
    dims := self >> [self.params[1], self.params[1]],
    isReal := True,
    terminate := self >> PkDHT1(self.params[1]).terminate(),
    SmallRandom := () -> Random([2,4,6,8,10,12,16,18,24,30,32]),
    normalizedArithCost := (self) >> let(n := self.params[1], IntDouble(_DHT_CONST * n * d_log(n) / d_log(2)))
));

_DHTtoRDFT := N -> DirectSum(I(2), Tensor(I(N/2-1), F(2)));

#F TXMatDHT(<n>) - X-matrix to translate a RC(DFT(N)) -> DHT(2*N)
Class(TXMatDHT, TaggedNonTerminal, rec(
    abbrevs := [ (n) -> Checked(IsPosIntSym(n), [n]) ],
    dims := self >> [self.params[1], self.params[1]],
    isReal := True,
    terminate := self >>  _DHTtoRDFT(self.params[1]) * TConjEven(self.params[1]).terminate(),
    SmallRandom := () -> Random([2,4,6,8,10,12,16,18,24,30,32]),
    doNotMeasure := true
));

#F  Translate DHT into RDFT
NewRulesFor(TDHT, rec(
    DHT_DFT_tSPL := rec(
        switch := true,
        applicable := (self, t) >> IsEvenInt(t.params[1]), # and t.hasTags(),
        children := (self, t) >> let(N := t.params[1], tags := t.getTags(),
            [[
                TXMatDHT(N).withTags(tags),
                TRC(DFT(N/2)).withTags(tags)
            ]]),
        apply := (self, t, C, Nonterms) >> C[1] * C[2]
    )
));

NewRulesFor(TXMatDHT, rec(
    TXMatDHT_TConjEven := rec(
        switch := true,
        applicable := (self, t) >> IsEvenInt(t.params[1]),
        children := (self, t) >> let(N := t.params[1], tags := t.getTags(),
            [[
                 TConjEven(N).withTags(tags),
           ]]),
        apply := (self, t, C, Nonterms) >> _DHTtoRDFT(t.params[1]) * C[1]
    )
));


InstallMethod(NilpotentChv,
              "NilpotentChv element in simple Lie type",
              [IsChevalleyAdj,IsList],
              function(sys,coeffs)
              local object,
              B,admat,l;

              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("NilpotentChv: The coefficients ar not in indicated ring.");
              fi;

              object:=Objectify(NewType(NewFamily("NilpotentChvFamily"),
                                        IsAttributeStoringRep and
                                        IsNilpotentChv and
                                        IsAdditiveElementWithInverse and
                                        IsAdditiveElementWithZero),
                                rec());

              SetchevalleyAdj(object,sys);

              # Simplified form of the element (negative root vectors are also allowd "2*Len..")
              coeffs:=Filtered(List([1..2*Length(positiveRoots(sys))],
                                    i->[i,One(ring(sys))*Sum(List(Filtered(coeffs,
                                                                           j->j[1]=i),
                                                                  k->k[2]))]),
                               l->l[2]<>Zero(ring(sys)));

              Setcoefficients(object,coeffs);

              B:=Basis(lieAlgebra(sys));
              if coeffs<>[] then SetLieAlgebraElement(object,Sum(coeffs,i->i[2]*B[i[1]]));
              else SetLieAlgebraElement(object,Zero(lieAlgebra(sys))); fi;
              SetLieAlgebraCoeffs(object,Coefficients(B,LieAlgebraElement(object)));

#              l:=Length(PRoots(R));
#              admat:=AdjointMatrix(B,LieAlgebraElement(e));
#              SetPositiveAde(object,List([1..l],i->admat[i]{[1..l]}));

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

InstallMethod(Ascend,
              "If possible embed the parameters in a polynomial ring with coefficients ring the base ring",
              [IsNilpotentChv,IsPolynomialRing],
              function(e,inel)
              local sys,
              check;

              sys:=chevalleyAdj(e);

              if not IsPolynomialRing(inel) then
                  Error("Ascend NilpotentChv: The new ring is not a polynomial ring to embed in!\n");
              elif CoefficientsRing(inel)<>ring(sys) then
                  Error("Ascend NilpotentChv: CoefficientsRing and ring(sys) do not coincide!\n");
              fi;

              return NilpotentChv(ChevalleyAdj(sys,inel),List(coefficients(e),i->[i[1],One(inel)*i[2]]));
end);

InstallMethod(Ascend,
              "If possible embed the parameters in a polynomial ring with coefficients ring the base ring",
              [IsNilpotentChv,IsChevalleyAdj],
              function(e,sys)
              local syse,
              check;

              syse:=chevalleyAdj(e);

              if not IsPolynomialRing(ring(sys)) then
                  Error("The new ring is not a polynomial ring to embed in.");
              elif CoefficientsRing(ring(sys))<>ring(syse) then
                  Error("CoefficientsRing and ring(syse) do not coincide.");
              fi;

              return NilpotentChv(sys,List(coefficients(e),i->[i[1],One(ring(sys))*i[2]]));
end);

InstallMethod(\*,
              "multiplication by scalar for nilpotent elements s*e",
              [IsRingElement,IsNilpotentChv],
              function(s,e)
              local sys;

              sys:=chevalleyAdj(e);
              if not s in ring(sys) then
                  Error("Scalar*NilpotentChv: Scalar not in ring of nilpotent!\n");
              fi;

              return NilpotentChv(sys,List(coefficients(e),i->[i[1],s*i[2]]));
end);

InstallMethod(\+,
              "addition for nilpotent elements e1+e2",
              [IsNilpotentChv,IsNilpotentChv],
              function(e1,e2)
              local sys1,sys2;

              sys1:=chevalleyAdj(e1);
              sys2:=chevalleyAdj(e2);
              if type(sys1)<>type(sys2) or
                 rank(sys1)<>rank(sys2) or
                 ring(sys1)<>ring(sys2) then
                  Error("NilpotentChv+NilpotentChv: Not in the same family!\n");
              fi;

              return NilpotentChv(sys1,Concatenation(coefficients(e1),coefficients(e2)));
end);

InstallMethod(AdditiveInverseMutable,
              "additive inverse for nilpotent elements -e1",
              [IsNilpotentChv],
              function(e)
              local sys;

              sys:=chevalleyAdj(e);

              return NilpotentChv(sys,List(coefficients(e),i->[i[1],-i[2]]));
end);

InstallMethod(ZeroMutable,
              "Zero vector of the Lie algebra",
              [IsNilpotentChv],
              function(e)
              local sys;

              return NilpotentChv(chevalleyAdj(e),[]);
end);


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

# ==========================================================================
# ColDirectSum
# ==========================================================================
Class(ColDirectSum, BaseOverlap, rec(
    #-----------------------------------------------------------------------
    abbrevs := [
        function(arg)
          arg:=Flat(arg);
          return [arg[1], arg{[2..Length(arg)]}];
        end ],
    #-----------------------------------------------------------------------
    new := meth(self, overlap, spls)
       return self._new(0, overlap, spls);
    end,
    #-----------------------------------------------------------------------
    dims := meth(self)
        local ovdim;
	ovdim := self.ovDim(self.overlap,
	                    List(self._children, t -> t.dimensions[1]));
	return [ ovdim[3] - ovdim[2] + 1, # max - min + 1
	         Sum(self._children, t -> t.dimensions[2]) ];
    end,
    #-----------------------------------------------------------------------
    toAMat := meth(self)
        return
	   AMatSPL(
	       Sparse(
		   self._coloverlap(
		       List(self._children, t -> t.dimensions[1]),
		       self.overlap
		   )
	       )
	   ) *
	   DirectSumAMat(List(self._children, AMatSPL));
    end,
));

ColDirectSum._transpose_class := RowDirectSum;
RowDirectSum._transpose_class := ColDirectSum;


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

#P Permutations
#P ------------
#P
#P Under different circumstances different objects are called permutations,
#P even in the context of linear algrebra.
#P
#P Following list describes these objects and their representation in SPIRAL:
#P
#P  1. Regular permutations
#P     (a) in cycle notation : (1,2)(3,4)
#P     (b) as lists          : [2,1,4,3]
#P     (c) as index space mapping function:  i -> i+1 mod N
#P
#P  2. Parametrized permutation classes
#P     [For example stride permutations L(size,str) | size mod str = 0]
#P     Represented as a construction function, which returns an index mapping
#P     function - (c) above.
#P
#P  Conversions: ListPerm     (b) <- (a)   [gap.perm]
#P               PermList     (a) <- (b)   [gap.perm]
#P               PermFunc     (a) <- (c)   [spiral.spl.perm]
#P               ListPermFunc (b) <- (c)   [spiral.spl.perm]
#P
#P -------------------

#F PermFunc(<func>, <size>) . . . . . convert perm. function into explicit GAP perm.
#F
#F  PermFunc converts a 0-based permutation function used in SPLs, into an explicit
#F  GAP permutation. Recall that GAP permutations are 1-based, and are in cycle
#F  representation.
#F
PermFunc := (func, size) ->
    PermList( List([0..size-1], func) + 1 );

#F PermFunc(<func>, <size>) . . . . . convert perm. function into explicit list perm.
#F
#F  PermFunc converts a 0-based permutation function used in SPLs, into an explicit
#F  1-based list permutation. List permutations can be converted to GAP permutations
#F  using PermList. Alternatively PermFunc can be used, wihch returns GAP permutation.
#F
ListPermFunc := (func, size) ->
    List([0..size-1], func) + 1;

# ==========================================================================
# FuncClass
#
# Base class for symbolic functions
# ==========================================================================
Class(FuncClass, BaseMat, Function, rec(
    #-----------------------------------------------------------------------
    # Must be implemented in subclasses
    #-----------------------------------------------------------------------
    lambda := self >> Error("not implemented"),
    domain := self >> Error("not implemented"),
    range := self >> Error("not implemented"),

    #-----------------------------------------------------------------------
    _perm := true,
    isReal := True,
    isPermutation := self >> false,
    perm := self >> Checked(self.isPermutation(), PermFunc(x->self.lambda().at(x), self.range())),

    #-----------------------------------------------------------------------
    print   := (self,i,is) >> Print(
	self.name, "(", PrintCS(self.params), ")", When(self.transposed, ".transpose()")),
    #-----------------------------------------------------------------------
    equals := (self, other) >> ObjId(other) = ObjId(self) and self.params=other.params,
    dims := self >> [self.range(), self.domain()],

    advdims   := self >> [ [[ self.range() ]], [[ self.domain() ]] ],

    # size along each dimension, for a multidimensional range
    # for compatibility with ClassSPL, we wrap this into another list
    # (list of outputs, since ClassSPL can have >1 output)
    advrange  := self >> [[ self.range() ]],

    # size along each dimension, for a multidimensional domain
    # for compatibility with ClassSPL, we wrap this into another list
    # (list of outputs, since ClassSPL can have >1 output)
    advdomain := self >> [[ self.domain() ]],

    # dimensionality of range (1-d, 2-d, etc)
    advrangeDim := self >> Length(self.advrange()[1]),
    # dimensionality of domain (1-d, 2-d, etc)
    advdomainDim := self >> Length(self.advdomain()[1]),
    #-----------------------------------------------------------------------
    toAMat := self >> Gath(self).toAMat(),
    #-----------------------------------------------------------------------
    arithmeticCost := (self, costMul, costAddMul) >> costMul(0) - costMul(0),
    #-----------------------------------------------------------------------
    transpose := self >> CopyFields(self, rec(transposed := not self.transposed )),
    #-----------------------------------------------------------------------
    conjTranspose := self >> self.transpose(),
    #-----------------------------------------------------------------------
    normalizedArithCost := self >> 0,
    #-----------------------------------------------------------------------
    free := self >> Union(List(self.params, FreeVars)),
    #-----------------------------------------------------------------------
    # Rewrite rules support
    #
    from_rChildren := (self, rch) >> CopyFields(ApplyFunc(ObjId(self), rch),
	rec(transposed:=self.transposed)),

    # NOTE: self.transposed not exposed
    rChildren := self >> self.params,

    rSetChild := meth(self, n, newChild)
        self.params[n] := newChild;
        # self.canonizeParams(); ??
	self.dimensions := self.dims();
    end,
    # ----------------------------------------------------------------------
    checkParams := meth(self, params)
        local nargs, nump;
	nargs := NumArgs(self.def);
	nump := Length(params);
	if nargs <> -1 and nargs <> nump then
            Error(self.name, " needs ", NumArgs(self.def), " parameters: ",
		ParamsFunc(self.def), "\n");
	fi;
    end,
    #-----------------------------------------------------------------------
    canonizeParams := meth(self, params)
        local A, nump;
	nump := Length(params);
	if IsBound(self.abbrevs) then
            for A in self.abbrevs do
                if NumArgs(A) = -1 or NumArgs(A) = nump then
		    return ApplyFunc(A, params);
		fi;
	    od;
            return params;
	else
            return params;
	fi;
    end,
    #-----------------------------------------------------------------------
    __call__ := meth(arg)
        local result, self, params, lkup, h;
        self := arg[1];
        params := arg{[2..Length(arg)]};
        params := self.canonizeParams(params);
        self.checkParams(params);

        h := self.hash;
        if h<>false then
            lkup := h.objLookup(self, params);
            if lkup[1] <> false then return lkup[1]; fi;
        fi;

        result := SPL(WithBases(self, rec(params := params, transposed := false)));
        result := Inherit(result, ApplyFunc(result.def, params));
	result.dimensions := result.dims();

        if h<>false then return h.objAdd(result, lkup[2]);
        else return result;
        fi;
    end,

# obsolete
#    checkInverse := self >> Checked(self.isPermutation(),
#        PermFunc(self.direct, self.range()) * PermFunc(self.inverse, self.domain())),
));

Class(PermClass, FuncClass, rec(
    isPermutation := self >> true,
    toAMat := self >> Gath(self).toAMat(),
    equals := (self, other) >> ObjId(other) = ObjId(self) and self.params=other.params
));


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

# Radix n kernel for FFTE, targeting ARM SVE

buildSVEKernel_a := function(n, kk, conf, opts)
    local vlen, name, suffix, filesuffix, t, j, k, l, m, tmp1, tmp2, tmp3,
        gi, g, gc, si, ss, s, sc, dft, rts, rt, opcnts, dfts, dftc, i, twt, twf, twl, tws, twc,
        cl, cc, c, clp, useFMA, _FMA, lp;

    name := DFTnameStr(n, kk);
    suffix := "a";
    filesuffix := "sve_";
#    suffix := "_j";
    Print("\n\n// == Generating \"", name, "\" ==================================================\n\n");

    vlen := TInt;
    useFMA := When(IsBound(conf.useFMA), conf.useFMA, true);
    _FMA := When(useFMA, FMA, p -> p);

    # variables
    t := var.fresh_t("t", TInt);
    j := var.fresh_t("j", TInt);
    k := V(0);
    l := var.fresh_t("l", TInt);
    m := V(1);
    lp := var.fresh_t("lp", TPtr(TInt));
#    mp := var.fresh_t("mp", TPtr(TInt));

    # temp arrays
    tmp1 := var.fresh_t("R", TArray(TVectSVE, 2*n));
    tmp2 := var.fresh_t("S", TArray(TVectSVE, 2*n));
    tmp3 := var.fresh_t("T", TArray(TVectSVE, 2*n));

    # gather
    gi := _i -> VGath_L(1, vlen, 2*(k + j*m + _i*l*m));
    g := RulesSums(SumsSPL(VStack(List([0..n-1], gi)), opts));
    gc := Compile(opts.codegen(g, tmp1, X, opts), opts);

    # scatter
    si := _i -> ScatH(1, 1, 2*n*j+_i, 2*n);
    ss := SumsSPL(HStack(List([0..2*n-1], si)), opts);
    s := RulesSums(SubstTopDown(ss, @(1, ScatAcc), e->Scat(@(1).val.func)));
    sc := Compile(opts.codegen(s, Y, tmp3, opts), opts);

    # generate DFT kernel
    dft := RC(DFT(n, kk));
    rts := AllRuleTrees(dft, opts);
    opcnts := List(rts, r -> [ Length(Collect(CodeRuleTree(r, opts), @(1, [add, sub, mul], e->e.t=TReal))), r]);
    rt := Minimum(opcnts)[2];
    dfts := SumsRuleTree(rt, opts);
    dftc := BlockUnroll(opts.codegen(dfts, tmp2, tmp1, opts), opts);

    # twiddles as lookup table
    i := var.fresh_t("i", 2*n);
    twt := var.fresh_t("TW", TPtr(TReal));
    twf := Lambda(i, cond(
        eq(i, 0), 1,
        eq(i, 1), 0,
        sve_gath(nth(twt, 2*((n-1)*j) + 2 * idiv(i, 2) + (imod(i, 2) - 2)).toPtr(TReal), TInt, opts.pg, 2*(n-1))
    ));

    # debug twiddles
    twl := Map(twf.tolist(), RulesStrengthReduce);
    DoForAll([0..Length(twl)-1], _i->Unparse(assign(nth(Y, _i), twl[_i+1]), CUnparser, 0, 1));
    tws := RCDiag(twf);
    twc :=BlockUnroll(unroll_cmd(opts.codegen(tws, tmp3, tmp2, opts)), opts);

    # stitch code fragments together
    cl := func(TVoid, "transform", [Y, X, twt, j, k, l, m, opts.pg],
            decl([tmp1, tmp2, tmp3], chain(gc, dftc, twc, sc)));
    cc := Compile(cl, opts);

    # fixup to push decls inside (?)
    c := func(TVoid, "transform", [Y, X, twt, j, l, opts.pg],
            decl(cc.vars, _FMA(cc.cmd.cmds[1].cmd)));

    # print Radix N FFTE kernel as function
    #PrintCode(name, c, opts);
    #PrintTo(name::".c", PrintCode(name, c, opts));

    ########################################################
    # version with j loop vectorized as m == 1, k == 0
    clp := func(TVoid, "transform", [Y, X, twt, lp],
        decl(c.cmd.vars::c.free()::[opts.pg, l],
            chain(
                assign(l, deref(lp)),
                sve_loopn(j, l,
                    c.cmd.cmd
                )
            )
        )
    );

    # print Radix N FFTE kernel as function
    PrintCode(opts.FortranIze(name::suffix), clp, opts);
    PrintTo(name::filesuffix::suffix::".c", PrintCode(opts.FortranIze(name::suffix), clp, opts));
end;


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

###############################################################################
##
##  AG_IsCorrectAutomatonList( <list>, <invertible> )
##
InstallGlobalFunction(AG_IsCorrectAutomatonList,
function(list, invertible)
  local len, deg, i, j, sym, semi;

  if not IsDenseList(list) then
    return false;
  fi;

  len := Length(list);
  if len = 0 then
    return false;
  fi;

  for i in [1..len] do
    if not IsDenseList(list[i]) then
      return false;
    fi;
    if Length(list[i]) <> Length(list[1]) then
      return false;
    fi;
  od;

  deg := Length(list[1]) - 1;
  if deg < 1 then
    return false;
  fi;

  sym := SymmetricGroup(deg);
  semi := FullTransformationSemigroup(deg);

  for i in [1..len] do
    for j in [1..deg] do
      if not IsInt(list[i][j]) then
        return false;
      fi;
      if list[i][j] > len or list[i][j] < 1 then
        return false;
      fi;
    od;

    if not list[i][deg + 1] in sym then
      if not list[i][deg + 1] in semi then
        return false;
      fi;
      if invertible and list[i][deg + 1]^-1=fail then
        return false;
      fi;
    fi;
  od;

  return true;
end);

###############################################################################
##
##  AG_IsCorrectRecurList( <list>, <invertible> )
##
InstallGlobalFunction(AG_IsCorrectRecurList,
function(list, invertible)
  local len, deg, i, j, k, sym, semi, inv_states;

  if not IsDenseList(list) then
    return false;
  fi;

  len := Length(list);
  if len = 0 then
    return false;
  fi;

  for i in [1..len] do
    if not IsDenseList(list[i]) then
      return false;
    fi;
    if Length(list[i]) <> Length(list[1]) then
      return false;
    fi;
  od;

  deg := Length(list[1]) - 1;
  if deg < 2 then
    return false;
  fi;

  sym := SymmetricGroup(deg);
  semi := FullTransformationSemigroup(deg);

  for i in [1..len] do
    for j in [1..deg] do
      if IsInt(list[i][j]) then
        if list[i][j] > len or list[i][j] < -len or list[i][j] = 0 then
          return false;
        fi;
      elif IsList(list[i][j]) then
        if not IsDenseList(list[i][j]) then
          return false;
        fi;
        for k in list[i][j] do
          if (not IsInt(k)) or k > len or k < -len or k = 0 then
            return false;
          fi;
        od;
      else
        return false;
      fi;
    od;

    # Check that everything is correct here
    if (not IsPerm(list[i][deg + 1])) and (not IsTransformation(list[i][deg + 1])) then
      return false;
    elif LargestMovedPoint(list[i][deg + 1]) > deg then
      return false;
    elif IsTransformation(list[i][deg + 1]) and invertible and list[i][deg + 1]^-1=fail then
      return false;
    fi;
  od;

#  check if there is x^-1 in the list, while x is not invertible
  inv_states:=[];
  for i in [1..len] do
    if AG_IsInvertibleStateInList(i,list) then Add(inv_states,i); fi;
  od;

  for i in [1..len] do
    for j in [1..deg] do
      if IsInt(list[i][j]) then
        if list[i][j]<0 and not -list[i][j] in inv_states then
          return false;
        fi;
      else
        for k in list[i][j] do
          if k<0 and not -k in inv_states then
            return false;
          fi;
        od;
      fi;
    od;
  od;

  return true;
end);

###############################################################################
##
##  AG_ConnectedStatesInList(state, list)
##
##  Returns list of states which are reachable from given state,
##  it does not check correctness of arguments
##
InstallGlobalFunction(AG_ConnectedStatesInList,
function(state, list)
  local i, j, s, d, to_check, checked;

  d := Length(list[1]) - 1;

  to_check := [state];
  checked := [];

  while Length(to_check) <> 0 do
    for s in to_check do
      for i in [1..d] do
        if IsList(list[s][i]) then
          for j in AsSet(List(list[s][i],AbsInt)) do
            if (not j in checked) and (not j in to_check) then
              to_check := Union(to_check, [j]);
            fi;
          od;
        else
          if (not AbsInt(list[s][i]) in checked) and (not AbsInt(list[s][i]) in to_check) then
            to_check := Union(to_check, [AbsInt(list[s][i])]);
          fi;
        fi;
      od;
      checked := Union(checked, [s]);
      to_check := Difference(to_check, [s]);
    od;
  od;

  return checked;
end);

###############################################################################
##
##  AG_IsTrivialStateInList( <state>, <list>)
##
##  Checks whether given state is trivial.
##  Does not check correctness of arguments.
##
InstallGlobalFunction(AG_IsTrivialStateInList,
function(state, list)
  local deg;
  deg := Length(list[1]) - 1;
  # IsOne works for Transformation's
  return ForAll(AG_ConnectedStatesInList(state, list),
                s -> IsOne(list[s][deg+1]));
end);

###############################################################################
##
##  AG_IsObviouslyTrivialStateInList( <state>, <list>)
##
##  Checks whether given state is obviously trivial.
##  Works for lists generating self-similar groups.
##  Returns `true' if <state>=(*,...,*)(), where
##  * could be either +-<state> or [+-<state>], or [].
##
InstallGlobalFunction(AG_IsObviouslyTrivialStateInList,
function(state, list)
  local deg, check;

  check := function(s)
    if IsInt(s) then return state=AbsInt(s);
                else return s=[] or (Length(s)=1 and state=AbsInt(s[1]));
    fi;
  end;

  deg := Length(list[1]) - 1;
  if not IsOne(list[state][deg+1]) then return false; fi;
  # IsOne works for Transformation's
  return ForAll(list[state]{[1..deg]}, check);
end);

###############################################################################
##
##  AG_IsInvertibleStateInList( <state>, <list> )
##
##  Checks whether given state is invertible.
##  Does not check correctness of arguments.
##
InstallGlobalFunction(AG_IsInvertibleStateInList,
function(state, list)
  local deg;
  deg := Length(list[1]) - 1;
  return ForAll(AG_ConnectedStatesInList(state, list),
                s -> (list[s][deg+1]^-1<>fail));
end);

###############################################################################
##
##  AG_AreEquivalentStatesInList( <state1>, <state2>, <list> )
##
##  Checks whether two given states are equivalent.
##  Does not check correctness of arguments.
##
InstallGlobalFunction(AG_AreEquivalentStatesInList,
function(state1, state2, list)
  local d, checked_pairs, pos, s1, s2, np, i;

  d := Length(list[1]) - 1;
  checked_pairs := [[state1, state2]];
  pos := 0;

  while Length(checked_pairs) <> pos do
    pos := pos + 1;
    s1 := checked_pairs[pos][1];
    s2 := checked_pairs[pos][2];

    if list[s1][d+1] <> list[s2][d+1] then
      return false;
    fi;

    for i in [1..d] do
      np := [list[s1][i], list[s2][i]];
      if not np in checked_pairs then
        checked_pairs := Concatenation(checked_pairs, [np]);
      fi;
    od;
  od;

  return true;
end);

###############################################################################
##
##  AG_AreEquivalentStatesInLists( <state1>, <state2>, <list1>, <list2>)
##
##  Checks whether two given states in different lists are equivalent.
##  Does not check correctness of arguments.
##
InstallGlobalFunction(AG_AreEquivalentStatesInLists,
function(state1, state2, list1, list2)
  local d, checked_pairs, pos, s1, s2, np, i;

  d := Length(list1[1]) - 1;
  checked_pairs := [[state1, state2]];
  pos := 0;

  while Length(checked_pairs) <> pos do
    pos := pos + 1;
    s1 := checked_pairs[pos][1];
    s2 := checked_pairs[pos][2];

    if list1[s1][d+1] <> list2[s2][d+1] then
      return false;
    fi;

    for i in [1..d] do
      np := [list1[s1][i], list2[s2][i]];
      if not np in checked_pairs then
        checked_pairs := Concatenation(checked_pairs, [np]);
      fi;
    od;
  od;

  return true;
end);

###############################################################################
##
##  AG_ReducedAutomatonInList( <list> )
##
##  Returns [new_list, list_of_states, old_states] where new_list is a new list
##  which represents reduced form of given automaton, i-th elmt of list_of_states
##  is the number of i-th state of new automaton in the old one.
##  old_states[i] is the number of state which corresponds to the i-th state
##  of the original automaton.
##
##  First state of returned list is always first state of given one.
##  It does not remove trivial state, so it's not really "reduced automaton",
##  it just removes equivalent states.
##  TODO: write such function which removes trivial state
##
##  Does not check correctness of list.
##
##  WARNING: do *NOT* change it.
##
InstallGlobalFunction(AG_ReducedAutomatonInList,
function(list)
  local   i, n, triv_states, equiv_classes, checked_states, s, s1, s2,
          eq_cl, eq_cl_1, eq_cl_2, are_equiv, eq_cl_reprs,
          new_states, new_list, deg,
          reduced_automaton, state, states_reprs;

  n := Length(list);
  triv_states := [];
  equiv_classes := [];
  checked_states := [];
  deg := Length(list[1]) - 1;

  for s in [1..n] do
      if AG_IsTrivialStateInList(s, list) then
          triv_states := Union(triv_states, [s]);
      fi;
  od;

  equiv_classes:=[triv_states];
  for s1 in Difference([1..n], triv_states) do
  for s2 in Difference([s1+1..n], triv_states) do
    are_equiv := AG_AreEquivalentStatesInList(s1, s2, list);

    if s1 in checked_states then
      for eq_cl in equiv_classes do
        if s1 in eq_cl then
          eq_cl_1 := StructuralCopy(eq_cl);
          break; fi; od;
    else
      equiv_classes := Union(equiv_classes, [[s1]]);
      eq_cl_1 := [s1];
      checked_states := Union(checked_states, [s1]);
    fi;
    if s2 in checked_states then
      for eq_cl in equiv_classes do
        if s2 in eq_cl then
          eq_cl_2 := StructuralCopy(eq_cl);
          break; fi; od;
    else
      equiv_classes := Union(equiv_classes, [[s2]]);
      eq_cl_2 := [s2];
      checked_states := Union(checked_states, [s2]);
    fi;

    if are_equiv then
      equiv_classes := Difference(equiv_classes, [eq_cl_1, eq_cl_2]);
      equiv_classes := Union(equiv_classes, [Union(eq_cl_1, eq_cl_2)]);
    fi;
  od;
  od;
  states_reprs := [1..n];
  for eq_cl in equiv_classes do
    for s in eq_cl do
      states_reprs[s] := Minimum(eq_cl);
    od;
  od;

  new_states := Set(states_reprs);
  new_list := [];

  for s in new_states do
    state := [];
    state[deg+1] := list[s][deg+1];
    for i in [1..deg] do
      state[i] := Position(new_states, states_reprs[list[s][i]]);
    od;
    new_list := Concatenation(new_list, [state]);
  od;

  return [new_list, new_states, List([1..n], i -> Position(new_states, states_reprs[i]))];
end);

###############################################################################
##
##  AG_MinimalSubAutomatonInlist(<states>, <list>)
##
##  Returns list representation of automaton given by <list> which is minimal
##  subatomaton of automaton containing states <states>.
##
##  Does not check correctness of list.
##
InstallGlobalFunction(AG_MinimalSubAutomatonInlist,
function(states, list)
  local s, new_states, state, new_list, i, deg;

  new_states := [];
  for s in states do
    new_states := Union(new_states, AG_ConnectedStatesInList(s, list));
  od;

  new_list := [];
  deg := Length(list[1]) - 1;

  for s in new_states do
    state := [];
    for i in [1..deg] do
      state[i] := Position(new_states, list[s][i]);
    od;
    state[deg+1] := list[s][deg+1];
    new_list := Concatenation(new_list, [state]);
  od;

  return [new_list, new_states];
end);

###############################################################################
##
##  AG_PermuteStatesInList(<list>, <perm>)
##
##  Does not check correctness of arguments.
##
InstallGlobalFunction(AG_PermuteStatesInList,
function(list, perm)
  local new_list, i, j, deg;

  deg := Length(list[1]) - 1;
  new_list := [];
  for i in [1..Length(list)] do
    new_list[i^perm] := [];
    for j in [1..deg] do
      new_list[i^perm][j] := list[i][j]^perm;
    od;
    new_list[i^perm][deg+1] := list[i][deg+1];
  od;

  return new_list;
end);

###############################################################################
##
##  AG_WordStateInList(<w>, <s>, <list>, <reduce>, <trivstate>)
##
##  It's ProjectWord from selfs.g
##  Does not check correctness of arguments.
##
InstallGlobalFunction(AG_WordStateInList,
function(w, s, list, reduce, trivstate)
  local i, perm, d, proj, red, reduce_word;

  reduce_word := function(v)
    local len, red, x;
    len := 0;
    red := [];
    for x in v do
      if x <> trivstate then
        if len <> 0 and x = -red[len] then
          Remove(red, len);
          len := len - 1;
        else
          Add(red, x);
          len := len + 1;
        fi;
      fi;
    od;
    return red;
  end;

  d := Length(list[1])-1;
  proj := [];
  perm := ();
  for i in [1..Length(w)] do
    Add(proj, list[w[i]][s^perm]);
    perm := perm * list[w[i]][d+1];
  od;
  if reduce then
    return reduce_word(proj);
  else
    return proj;
  fi;
end);

###############################################################################
##
##  AG_WordStateAndPermInList(<w>, <s>, <list>)
##
##  Does not check correctness of arguments.
##
InstallGlobalFunction(AG_WordStateAndPermInList,
function(w, s, list)
  local i, perm, perm_res, new_state, d, proj;
  d := Length(list[1])-1;
  proj := [];
  perm := ();
  perm_res := ();
  for i in [1..Length(w)] do
    new_state := list[w[i]][s^perm];
    Add(proj, new_state);
    perm := perm * list[w[i]][d+1];
    perm_res := perm_res * list[new_state][d+1];
  od;
  return [proj, perm_res];
end);

###############################################################################
##
##  AG_ImageOfVertexInList(<list>, <init>, <vertex>)
##
##  Does not check correctness of arguments.
##
InstallGlobalFunction(AG_ImageOfVertexInList,
function(list, s, seq)
  local deg, img, x;

  deg := Length(list[1]) - 1;
  img := [];
  for x in seq do
      Add(img, x^list[s][deg+1]);
      s := list[s][x];
  od;

  return img;
end);

###############################################################################
##
##  AG_DiagonalPowerInList(<list>, <n>)
##
InstallGlobalFunction(AG_DiagonalPowerInList,
function(list, n, names)
  local d, nlist, nd, nalph, nstates, nperm,
        i, j, k, letter, n_letter, n_state, state,
        nnames;

  d := Length(list[1]) - 1;
  nd := d ^ n;
  nalph := Tuples([1..d], n);
  nstates := Tuples([1..Length(list)], n);
  nlist := List([1..Length(nstates)], i -> []);
  nnames := List(nstates, s->List(s, i->names[i]));

  for i in [1..Length(nlist)] do
    nperm := [];
    state := nstates[i];
    for j in [1..nd] do
      letter := nalph[j];
      n_letter := [];
      n_state := [];
      for k in [1..n] do
        n_letter[k] := letter[k]^list[state[k]][d+1];
        n_state[k] := list[state[k]][letter[k]];
      od;
      nperm[j] := n_letter;
      nlist[i][j] := Position(nstates, n_state);
    od;
    nlist[i][nd+1] := PermListList(nalph, nperm);
  od;

  nnames := List(nnames, l->Concatenation(l));
  return [nlist, nnames];
end);

###############################################################################
##
##  AG_MultAlphabetInList(<list>, <n>)
##
InstallGlobalFunction(AG_MultAlphabetInList,
function(list, n)
  local d, nlist, nd, nalph, nperm,
        i, j, k, letter, n_letter, st;

  d := Length(list[1]) - 1;
  nd := d ^ n;
  nalph := Tuples([1..d], n);
  nlist := List(list, i -> []);

  for i in [1..Length(nlist)] do
    nperm := [];
    for j in [1..Length(nalph)] do
      letter := nalph[j];
      n_letter := [];
      st := i;
      for k in [1..n] do
        Add(n_letter, letter[k]^list[st][d+1]);
        st := list[st][letter[k]];
      od;
      nlist[i][j] := st;
      nperm[j] := n_letter;
    od;
    nlist[i][nd+1] := PermListList(nalph, nperm);
  od;

  return nlist;
end);

###############################################################################
##
##  AG_HasDualInList(<list>)
##
InstallGlobalFunction(AG_HasDualInList,
function(list)
  local i, j, p, d, n;
  d := Length(list[1]) - 1;
  n := Length(list);
  for i in [1..d] do
    p := [];
    for j in [1..n] do
      p[j] := list[j][i];
    od;
    if PermListList([1..n], p) = fail then
      return false;
    fi;
  od;
  return true;
end);

###############################################################################
##
##  AG_DualAutomatonList(<list>)
##
InstallGlobalFunction(AG_DualAutomatonList,
function(list)
  local dual, d, n;
  d := Length(list[1]) - 1;
  n := Length(list);
  return List([1..d], i -> Concatenation(List([1..n], j -> i^list[j][d+1]),
    [PermList(List([1..n], j -> list[j][i]))]));
end);

###############################################################################
##
##  AG_HasDualOfInverseInList(<list>)
##
InstallGlobalFunction(AG_HasDualOfInverseInList,
function(list)
  return AG_HasDualInList(AG_InverseAutomatonList(list));
end);

###############################################################################
##
##  AG_InverseAutomatonList(<list>)
##
InstallGlobalFunction(AG_InverseAutomatonList,
function(list)
  local inv, d, i;
  d := Length(list[1]) - 1;
  inv := List(list, l -> Permuted(l, l[d+1]));
  for i in [1..Length(list)] do inv[i][d+1] := inv[i][d+1]^-1; od;
  return inv;
end);

#E


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

Declare(TDCT2, TDCT3, TDCT4);

_DCT_CONST := 2.5;

#######################################################################################
#   tSPL DCT rules

#    PDCT4_CT_SPL := rec(
#    isApplicable     := P -> P > 2 and ForAny(DivisorPairs(2*P), d->IsEvenInt(d[1]) and IsEvenInt(d[2])),
#    forTransposition := false,
#
#    allChildren  := P -> let(N := P,
#        Map2(Filtered(DivisorPairs(2*N), d -> IsEvenInt(d[1]) and IsEvenInt(d[2])),
#        (m,n) -> [ PRDFT3(m,-1).transpose(), PRDFT3(n) ])),
#
#    rule := (P,C) -> let(N := P, m := Rows(C[1]), n := Cols(C[2]),
#        j := Ind(n/2),
#        T := Diag(Twid(2*N, m/2, 1, 1/2, 1/2, j)),
#
#        Prm(Refl(N, 2*N-1, N, L(m*n, m))) *
#        IterDirectSum(j, j.range, Diag(BHN(m)) * C[1] * RC(T)) *
#        RC(L(m*n/4, n/2)) *
#        Tensor(I(m/2), C[2] * Diag(BHN(n))) *
#        Prm(Refl(N, 2*N-1, N, L(m*n, m)))
#        )
#    )
#

#F TDCT4(<size>, tags) - Discrete Cosine Transform, Type IV, non-terminal
#F Definition: (n x n)-matrix  [ cos((k+1/2)*(l+1/2)*pi/n) | k,l = 0...n-1 ]
#F Note:       DCT4 is symmetric
#F Example:    DCT4(8)
Class(TDCT4, TaggedNonTerminal, rec(
    abbrevs := [ N -> Checked(IsInt(N), N >= 1, [N]) ] ,
    dims := self >> [self.params[1], self.params[1]],
    isReal := True,
    terminate := self >> Mat(DCT_IVunscaled(self.params[1])),
    transpose := self >> Copy(self),
    SmallRandom := () -> Random([2, 3, 4, 6, 8, 9, 12, 16, 18, 24, 27, 32]),
    normalizedArithCost := (self) >> let(n := self.params[1], IntDouble(_DCT_CONST * n * d_log(n) / d_log(2)))
));

NewRulesFor(TDCT4, rec(
#    DCT4_CT_tSPL := rec(
#        switch := false,
#
#        applicable := (self, t) >> let(P:=t.params, P[1] > 2 and ForAny(DivisorPairs(2*P[1]), d->IsEvenInt(d[1]) and IsEvenInt(d[2])) and HasTags(t)),
#
#        children := (self, t) >> let(tags := GetTags(t), N := t.params[1],
#                                    Map2(Filtered(DivisorPairs(2*N), d -> IsEvenInt(d[1]) and IsEvenInt(d[2])),
#                                        (m,n) -> [
#                                            SetTag(TCompose([
#                                                TScat(Refl(N, 2*N-1, N, L(m*n, m))),
#                                                TTensorI(Diag(BHN(m)) * PRDFT3(m,-1).transpose(), n/2, APar, APar),
#                                                TRC(TDiag(fPrecompute(
#                                                    fCompose(dOmega(8 * N, 1), diagTensor(dLin(N/m, 2, 1, TInt), dLin(m/2, 2, 1, TInt)))
#                                                ))),
#                                                TRC(TL(m*n/4, n/2, 1, 1)),
#                                                TTensorI(PRDFT3(n) * Diag(BHN(n)), m/2, APar, APar),
#                                                TGath(Refl(N, 2*N-1, N, L(m*n, m))) ]),
#                                                tags)
#                                        ])),
#
#        apply := (self, t, C, Nonterms) >> C[1]
#    ),
#
#    # Variant better suited for vectorization
#    PDCT4_CT_SPL_Vec := rec(
#    isApplicable     := P -> P > 2 and (P mod 2) = 0,
#    forTransposition := false,
#
#    allChildren  := P -> let(N := P,
#        Map2(Filtered(DivisorPairs(2*N), d -> IsEvenInt(d[1]) and IsEvenInt(d[2])),
#        (m,n) -> [ PRDFT3(m,-1).transpose(), PRDFT3(n) ])),
#
#    rule := (P,C) -> let(N := P, m := Rows(C[1]), n := Cols(C[2]),
#            TT := Diag(fPrecompute(fCompose(dOmega(8 * N, 1),
#                        diagTensor(dLin(N/m, 2, 1, TInt), dLin(m/2, 2, 1, TInt))))),
#
#            IJ(N, n/2) *
#            L(N, m) *
#        Tensor(I(n/2),
#                   M(m,m/2) * Diag(BHN(m)) * C[1]) *
#            RC(TT) *
#            L(N, n/2) *
#        Tensor(I(m/2),
#                   L(n, 2) * C[2] * Diag(BHN(n)) * K(n, 2)) *
#            L(N, m/2) *
#            IJ(N, m/2)
#    )
#    )

    DCT4_CT_tSPL := rec(
        switch := false,

        applicable := (self, t) >> let(
            P:=t.params,
            P[1] > 2
            and ForAny(DivisorPairs(2*P[1]), d ->
                IsEvenInt(d[1]) and IsEvenInt(d[2])
            )
            and t.hasTags()
        ),

        children := (self, t) >> let(
            tags := t.getTags(),
            N := t.params[1],
            Map2(
                Filtered(DivisorPairs(2*N), d -> IsEvenInt(d[1]) and IsEvenInt(d[2])),
                (m,n) -> List([
                    TPrm(IJ(N, n/2)),
                    TTensorI(condM(m,m/2) * Diag(BHN(m)) * PRDFT3(m,-1).transpose(), n/2, AVec, AVec),
                    TTensorI(L(n, 2) * PRDFT3(n) * Diag(BHN(n)) * condK(n, 2), m/2, APar, AVec),
                    TPrm(IJ(N, m/2))
                ], i -> i.setTags(tags))
            )
        ),

        apply := (self, t, C, Nonterms) >> let(
            N:=t.params[1],
            n:=2*Rows(Nonterms[1].params[1].params[2]),
            m:=2*Rows(Nonterms[4].params[1].params[2]),
            Grp(
                C[1] * C[2]
                * ConjDiag(RC(Diag(fPrecompute(
                    fCompose(dOmega(8 * N, 1), diagTensor(dLin(N/m, 2, 1, TInt), dLin(m/2, 2, 1, TInt)))
                ))), L(N, m), L(N, n/2))
            )
            * C[3] * C[4]
        )
    )
));

#F TDCT2(<n>) - Discrete Cosine Transform, Type II, non-terminal
#F Definition: (n x n)-matrix [ cos(k*(l+1/2)*pi/n) | k,l = 0...n-1 ]
#F Note:       DCT2 is the transpose of DCT3
#F Example:    DCT2(8)
Class(TDCT2, TaggedNonTerminal, rec(
    abbrevs := [ N -> Checked(IsInt(N), N >= 1, [N]) ] ,
    dims := self >> [self.params[1], self.params[1]],
    isReal := True,
    terminate := self >> Mat(DCT_IIunscaled(self.params[1])),
    transpose := self >> TDCT3(self.params[1]),
    SmallRandom := () -> Random([2,3,4,5,6,8,9,10,12,15,16,18,24,27,30,32]),
    normalizedArithCost := (self) >> let(n := self.params[1], IntDouble(_DCT_CONST * n * d_log(n) / d_log(2)))
));

NewRulesFor(TDCT2, rec(
    DCT2_DCT4_tSPL := rec(
        switch := false,
        applicable := (self, t) >> true,
        children := (self, t) >> [[ TS(t.params[1]).withTags(t.getTags()), TDCT4(t.params[1]).withTags(t.getTags()) ]],
        apply := (self, t, C, Nonterms) >> let(P := t.params[1],
            Diag(Concat([V(2.0)], List([1..P-1], i->V(1.0)))) *
            C[1].transpose() * C[2] *
            Diag(List([0..P - 1], i -> 1/(2 * CosPi((2*i + 1)/(4*P))))))
    ))
);

#F TDCT3(<n>) - Discrete Cosine Transform, Type III, non-terminal (unscaled)
#F Definition: (n x n)-matrix [ cos((k+1/2)*l*pi/n) | k,l = 0...n-1 ]
#F  [scaled]   (n x n)-matrix [ a_l*cos((k+1/2)*l*pi/n) | k,l = 0...n-1 ]
#F                              a_j = 1/sqrt(2) for j = 0 and = 1 else
#F Note:       DCT3 is the transpose of DCT2, scaled NOT supported yet
#F Example:    DCT3(8)
Class(TDCT3, TaggedNonTerminal, rec(
    abbrevs := [ N -> Checked(IsInt(N), N >= 1, [N]) ] ,
    dims := self >> [self.params[1], self.params[1]],
    isReal := True,
    terminate := self >> Mat(DCT_IIIunscaled(self.params[1])),
    transpose := self >> TDCT2(self.params[1]),
    SmallRandom := () -> Random([2,3,4,5,6,8,9,10,12,15,16,18,24,27,30,32]),
    normalizedArithCost := (self) >> let(n := self.params[1], IntDouble(_DCT_CONST * n * d_log(n) / d_log(2)))
));

NewRulesFor(TDCT3, rec(
    DCT3_DCT2_tSPL := rec(
        switch := false,
        applicable := (self, t) >> true,
        children := (self, t) >> [[ TDCT2(t.params[1]).withTags(t.getTags()) ]],
        apply := (self, t, C, Nonterms) >> C[1].transpose()
    ),
    DCT3_DCT4_tSPL := rec(
        switch := false,
        applicable := (self, t) >> true,
        children := (self, t) >> [[ TDCT4(t.params[1]).withTags(t.getTags()), TS(t.params[1]).withTags(t.getTags()) ]],
        apply := (self, t, C, Nonterms) >> let(P := t.params[1],
            Diag(List([0..P - 1], i -> 1/(2 * CosPi((2*i + 1)/(4*P))))) *
            C[1] * C[2] *
            Diag(Concat([V(2.0)], List([1..P-1], i->V(1.0)))))
    )
));


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

InstallMethod(UnipotentMod,
              "Unipotent element in simple adjoint type",
              [IsChevalleyAdj,IsList,IsList,IsInt,IsPosInt],
              function(sys,coeffs,ordering,order,root)
              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),
                           rec());

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

              Setcoefficients(object,CanonicMod(sys,coeffs,ordering,root));
#             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(UnipotentMod,
              "Unipotent element in simple adjoint type",
              [IsChevalleyAdj,IsList,IsList,IsPosInt],
              function(sys,coeffs,ordering,root)

              return UnipotentMod(sys,coeffs,ordering,-2,root);
end);

#
# ---------- Canonic form of element modulo some roots ----------
#

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

              lista:=[];
              for i in coeffs do
                  if Ordering[i[1]]<=Ordering[root] then
                      Add(lista,ShallowCopy(i));
                  fi;
              od;

              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]];
                                    pos:=Position(pr,suma);
                                    if Ordering[pos]<=Ordering[root] then
                                        param:=cc[3]*((-1)^cc[1])*(lista[i-1][2]^cc[1])*(lista[i][2]^cc[2]);
                                        Add(lista,[pos,param],i+k);
                                        k:=k+1;
                                    fi;
                                od;
                                flag:=true;
                            fi;
                            i:=i-1;
                  od;
              od;

              return Immutable(lista);
end);

#
# ---------- Arithmetic Operations modulo some roots ----------
#

InstallMethod(MMod,
              "Multiplication for unipotent elements a*b modulo some roots and with the ordering of b",
              [IsUnipotent,IsUnipotent,IsPosInt],
              function(u1,u2,root)
              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 UnipotentMod(sys2,Concatenation(coefficients(u1),coefficients(u2)),Ordering(u2));
end);

InstallMethod(CommMod,
              "Commutator for unipotent elements a^-1b^-1ab with the ordering of b",
              [IsUnipotent,IsUnipotent,IsPosInt],
              function(u1,u2,root)
              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 UnipotentMod(sys2,
                                  Concatenation(coefficients(u1^-1),coefficients(u2^-1),
                                                   coefficients(u1),coefficients(u2)),
                                  Ordering(u2),
                                  root);
end);

InstallMethod(ConjMod,
              "Conjugation for unipotent elements b^-1ab with the ordering of b",
              [IsUnipotent,IsUnipotent,IsPosInt],
              function(u1,u2,root)
              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),
                               root);
end);


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

setLeft := function(tags)
   local i, retval;
   retval := Copy(tags);
   for i in retval do
      i.isLeftChild := true;
      i.isRightChild := false;
 od;
 return(retval);
end;

setRight := function(tags)
   local i, retval;
   retval := Copy(tags);
   for i in retval do
      i.isLeftChild := false;
      i.isRightChild := true;
 od;
 return(retval);
end;

NewRulesFor(WHT, rec(
    WHT_GT := rec(
    switch := false,
    maxSize := false,
    minSize := false,
    codeletSize := false,
    inplace := false,

    applicable := (self, t) >> let(n := Rows(t),
        n > 2 and
        (self.maxSize=false or n <= self.maxSize) and
        (self.minSize=false or n >= self.minSize) and
        not IsPrime(n)),

        children := (self, t) >> Map2(Filtered(DivisorPairs(Rows(t)), d->When(IsInt(self.codeletSize), d[1]<=self.codeletSize, true)),
        (m,n) -> [
        GT(WHT(LogInt(m, 2)), XChain([0, 1]), XChain([0, 1]), [n]).withTags(t.getTags()),
        GT(WHT(LogInt(n, 2)), XChain([1, 0]), XChain([1, 0]), [m]).withTags(t.getTags()),
        #GT(WHT(LogInt(m, 2)), XChain([0, 1]), XChain([0, 1]), [n]).withTags( let(ts := t.getTags(),  setLeft(ts)) ),
        #GT(WHT(LogInt(n, 2)), XChain([1, 0]), XChain([1, 0]), [m]).withTags( let(ts := t.getTags(), setRight(ts)) ),
        ]),

    apply := (self, t, C, Nonterms) >>  C[1] * C[2]
    )
));

NewRulesFor(DFT, rec(
    DFT_GT_CT := rec(
    switch := false,
    maxSize := false,
    minSize := 2,
    codeletSize := false,
    inplace := false,

    a := rec(
        precompute := true
    ),

    applicable := (self, t) >> let(n := Rows(t),
        n > 2 and
        (self.maxSize=false or n <= self.maxSize) and
        (self.minSize=false or n >= self.minSize) and
        not IsPrime(n)),

        #GT(DFT(m, t.params[2] mod m), XChain([0, 1]), XChain([0, 1]), [n]).withTags(  let(a := t.getTags(),  ),
        #GT(DFT(n, t.params[2] mod n), XChain([0, 1]), XChain([1, 0]), [m]).withTags(  t.getTags())

        #GT(DFT(m, t.params[2] mod m), XChain([0, 1]), XChain([0, 1]), [n]).withTags(t.getTags()),
        #GT(DFT(n, t.params[2] mod n), XChain([0, 1]), XChain([1, 0]), [m]).withTags(t.getTags())

    children := (self, t) >> Map2(Filtered(DivisorPairs(Rows(t)), d->When(IsInt(self.codeletSize), d[1]<=self.codeletSize, true)),
        (m,n) -> [
        GT(DFT(m, t.params[2] mod m), XChain([0, 1]), XChain([0, 1]), [n]).withTags(t.getTags()),
        GT(DFT(n, t.params[2] mod n), XChain([0, 1]), XChain([1, 0]), [m]).withTags(t.getTags()),
        #GT(DFT(m, t.params[2] mod m), XChain([0, 1]), XChain([0, 1]), [n]).withTags( let(ts := t.getTags(),  setLeft(ts)) ),
        #GT(DFT(n, t.params[2] mod n), XChain([0, 1]), XChain([1, 0]), [m]).withTags( let(ts := t.getTags(), setRight(ts)) ),
         ]),

    apply := (self, t, C, Nonterms) >>  let(
            inplace := When(self.inplace, Inplace, Grp),
            n := Rows(Nonterms[2].params[1]),
            rot := t.params[2],
            compute := When(self.a.precompute, fPrecompute, fComputeOnline),

            inplace(Buf(C[1] * Diag(compute(Tw1(Rows(t), n, rot))))) * C[2])
    )
));

# GT(DFT(), ...) rules
#
NewRulesFor(GT, rec(
    GT_DFT_Base2 := rec(
    applicable := (self, t) >> let(rank := Length(t.params[4]),
        rank = 0 and PatternMatch(t, [GT, DFT, @, @, @, @, @], empty_cx()) and Rows(t.params[1])=2),
    apply := (t, C, Nonterms) -> F(2)
    ),

    GT_DFT_CT := rec(
        maxSize       := false,
        minSize       := false,
        minRank       := 0,
        maxRank       := 1,
        codeletSize := 32,
        inplace := true,

        a := rec(
            precompute := true
        ),

        applicable := (self, t) >> let(
            rank := Length(t.params[4]),
            dft := t.params[1],

            rank >= self.minRank
            and rank <= self.maxRank
            and When(rank>0, t.getTags()=[], true)
            and (self.maxSize=false or Rows(dft) <= self.maxSize)
            and (self.minSize=false or Rows(dft) >= self.minSize)
            and PatternMatch(t, [GT, DFT, XChain, XChain, @, @, @], empty_cx())
            and DFT_GT_CT.applicable(dft)
        ),

        children := (self, t) >> let(
            dft := t.params[1],
            g := t.params[2], s := t.params[3],
            rot := dft.params[2],
            loop_dims := t.params[4],
            nloops := Length(loop_dims),
            tags := t.getTags(),

            Map2( Filtered(DivisorPairs(Rows(dft)), d->d[1]<=self.codeletSize),
                (m,n) -> [
                    GT(DFT(m, rot mod m),
                        s.composeWith(XChain([0, 1])), s.composeWith(XChain([0, 1])),
                        Concatenation([n], loop_dims)
                    ).withTags(tags),

                    GT(DFT(n, rot mod n),
                        g.composeWith(XChain([0, 1])), s.composeWith(XChain([1, 0])),
                        Concatenation([m], loop_dims)
                    ).withTags(tags)
                ]
            )
        ),

        apply := (self, t, C, Nonterms) >> let(
            loop_dims := t.params[4],
            s := t.params[3],
            N := Rows(t.params[1]),
            k := t.params[1].params[2],
            n := Rows(Nonterms[2].params[1]),

            inplace := When(self.inplace, Inplace, Grp),
            compute := When(self.a.precompute, fPrecompute, fComputeOnline),

            inplace(Buf(C[1] * Diag(compute(s.toDiag(loop_dims, Tw1(N,n,k)))))) * C[2]
        )
    )
));


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

IsIntSym     := x -> (IsSymbolic(x) and IsOrdT(x.t)) or (IsValue(x) and IsOrdT(x.t)) or IsInt(x);
IsPosIntSym  := x -> (IsSymbolic(x) and IsOrdT(x.t)) or (IsValue(x) and IsOrdT(x.t) and x.v > 0)  or (IsInt(x) and x > 0);
IsPosInt0Sym := x -> (IsSymbolic(x) and IsOrdT(x.t)) or (IsValue(x) and IsOrdT(x.t) and x.v >= 0) or (IsInt(x) and x >= 0);
IsRatSym     := x -> (IsSymbolic(x) and (IsOrdT(x.t) or IsRealT(x.t) or x.t=TUnknown)) or IsRat(x) or (IsValue(x) and (IsOrdT(x.t) or IsRealT(x.t)));
IsBoolSym    := x -> x.t=TBool and (IsSymbolic(x) or IsValue(x));

AnySyms := arg -> ForAny(arg, IsSymbolic);

_ev := x->When(IsRec(x) and IsBound(x.ev), x.ev(), x);

# in functions below
# vec elements could be non-values (i.e. symbolic == expressions)

isValueZero := e ->
    (e.v=0 or IsDouble(e.v) and AbsFloat(e.v)<TReal.cutoff) or
    (IsVecT(e.t) and ForAll(e.v, x->not IsSymbolic(x) and AbsFloat(_ev(x)) < TDouble.cutoff));

isValueOne := e ->
    (e.v=1 or IsDouble(e.v) and AbsFloat(e.v-1)<TReal.cutoff) or
    (IsVecT(e.t) and ForAll(e.v, x->not IsSymbolic(x) and AbsFloat(_ev(x)-1) < TDouble.cutoff));

isValueNegOne := e ->
    (e.v=-1 or IsDouble(e.v) and AbsFloat(e.v+1)<TReal.cutoff) or
    (IsVecT(e.t) and ForAll(e.v, x->not IsSymbolic(x) and AbsFloat(_ev(x)+1) < TReal.cutoff));

_is0none := e -> Cond(IsValue(e), isValueZero(e), ObjId(e)=noneExp or e=0);
_is1 := e -> Cond(IsValue(e), isValueOne(e),  e=1);

# in the patterns below 'e' could be a plan GAP integer or other non-class GAP object
_0    := @(0).cond(e -> Cond(IsValue(e), isValueZero(e), e=0));
_0none:= @(0).cond(_is0none);
_1    := @(0).cond(_is1);
_2    := @(0).cond(x -> x=2);
_neg1 := @(0).cond(e -> Cond(IsValue(e), isValueNegOne(e), e=-1));

_v0    := @(0, Value, isValueZero);
_v0none:= @(0, [Value, noneExp], e -> Cond(ObjId(e)=noneExp, true, isValueZero(e)));
_v1    := @(0, Value, isValueOne);
_vneg1 := @(0, Value, isValueNegOne);

_vtrivial := @(0, Value, e->isValueZero(e) or isValueOne(e) or isValueNegOne(e));

_vtrue    := @(0, Value, e -> e.v=true);
_vfalse    := @(0, Value, e -> e.v=false);

Declare(_divides_rec);

_divides_rec := (d,n) -> Cond(
    ObjId(n) = add and ForAll( n.args, e -> _divides_rec(d, e) ), true,
    ObjId(n) = mul and ForAny( n.args, e -> _divides_rec(d, e) ), true,
    IsSymbolic(d) or IsSymbolic(n), d=n or n=0,
    (EvalScalar(n) mod EvalScalar(d)) = 0);

_divides := (d,n) -> CondPat( d,
    [mul, param, param, ...], # product of distinct params
        ForAll( d.args, p -> IsParam(p) and _divides_rec(p,n) ) and Length(Set(d.args))=Length(d.args),
    [mul, Value, param],
        _divides_rec(d.args[1], n) and _divides_rec(d.args[2], n),
    # else
    _divides_rec(d,n));

_isEven := x -> _divides(2, x);

# We can't know for sure that d|n, because _dividesUnsafe returns true if either d or n is a variable
_dividesUnsafe := (d,n) -> Cond(IsSymbolic(d) or IsSymbolic(n), true,
    (EvalScalar(n) mod EvalScalar(d)) = 0);

_unwrap := n -> Cond(IsValue(n), n.v, n);
Declare(_stripval);
_stripval := n -> Cond( IsValue(n), _stripval(n.v),
                        IsList(n),  List(n, _stripval),
                        n );

_unwrapV := (n) -> let(_n := EvalScalar(n), Cond(IsValue(_n), n.v, _n));


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

Class(PDTT_Base, TaggedNonTerminal, rec(
    abbrevs := [ n -> Checked(IsPosIntSym(n), [n]) ],
    dims := self >> [self.params[1], self.params[1]],
    isReal := True,
    print := (self,i,is) >> Print(self.__name__, "(", PrintCS(self.params), ")",
	When(self.transposed, Print(".transpose()")),
        When(self.tags<>[], Print(".withTags(", self.tags, ")"))),

    normalizedArithCost := self >> let(n := self.params[1],
	floor(2.5 * n * log(n) / log(2.0)) )
));

#
# Discrete Trigonometric Transforms (DTTs) via PRF
#
Declare(PDST3, PDCT3);

Class(PDST4, PDTT_Base, rec(
    transpose := self >> Copy(self),
    terminate := self >> Mat(DST_IVunscaled(EvalScalar(self.params[1]))),
));

Class(PDCT4, PDTT_Base, rec(
    transpose := self >> Copy(self),
    terminate := self >> Mat(DCT_IVunscaled(EvalScalar(self.params[1]))),
));

Class(PDCT2, PDTT_Base, rec(
    terminate := self >> Mat(DCT_IIunscaled(EvalScalar(self.params[1]))),
    transpose := self >> PDCT3(self.params[1])
));

Class(PDST2, PDTT_Base, rec(
    terminate := self >> Mat(DST_IIunscaled(EvalScalar(self.params[1]))),
    transpose := self >> PDST3(self.params[1])
));

Class(PDCT3, PDTT_Base, rec(
    terminate := self >> Mat(DCT_IIIunscaled(EvalScalar(self.params[1]))),
    transpose := self >> PDCT2(self.params[1])
));

Class(PDST3, PDTT_Base, rec(
    terminate := self >> Mat(DST_IIIunscaled(EvalScalar(self.params[1]))),
    transpose := self >> PDST2(self.params[1])
));

RulesFor(PDST4, rec(
    PDST4_Base2 := DST4_Base, #BaseRule(PDST4, 2),
    PDST4_CT := rec(
	isApplicable     := P -> P[1] > 2, #not IsPrime(P),
	forTransposition := false,
	allChildren  := P -> let(N := P[1], Map2(DivisorPairs(2*N), (m,n) -> Cond(
		IsEvenInt(m) and IsEvenInt(n), [ PRDFT3(m,-1).transpose(), PRDFT3(n) ],
		#IsEvenInt(m) and IsEvenInt(n), [ PDHT3(m).transpose(), PDHT3(n) ],
		IsEvenInt(m) and IsOddInt(n),  [ PRDFT3(m,-1).transpose(), PRDFT3(n), PDST4(m/2) ],
		IsOddInt(m)  and IsEvenInt(n), [ PRDFT3(m,-1).transpose(), PRDFT3(n), PDST4(n/2) ],
		IsOddInt(m)  and IsOddInt(n),  Error("This can't happen")))),

	rule := (P,C) -> let(N := P[1], m := Rows(C[1]), n := Cols(C[2]),
	    nf:=Int(n/2), nc:=Int((n+1)/2), mf:=Int(m/2), mc:=Int((m+1)/2), j:=Ind(nf), i:=Ind(mf),
	    # mult twid by -E(4) for RDFT, by 1/2 for DHT
	    t := ScaledTwid(2*N, mf, 1, 1/2, 1/2, j, -E(4)),
	    T := When(IsOddInt(m), Diag(diagDirsum(t,fConst(1,1))), Diag(t)),
	    Et := Tensor(I(mf),Mat([[0,-1],[-1,0]])),
	    Ett := Tensor(I(mf),Mat([[0,-1],[1,0]])),
	    SUM(
		ISum(j,
		    Scat(BH(N, 2*N-1, m, j, n)) * C[1] * #Ett *
		    RC(T) *
		    #Et * # DHT only
		    RC(Gath(H(mc*nc, mc, j, nc)))
		),
		When(IsEvenInt(n), [], Scat(H(N,m/2,nf,n))*C[3]*Gath(H(2*mc*nc, m/2, 2*nf, 2*nc)))
	    ) *
	    SUM(
		ISum(i, RC(Scat(H(mc*nc, nc, i*nc, 1))) * C[2] * Gath(BH(N, 2*N-1, n, i, m))),
                # output is imaginary, but we output into real slot, because subseq transform
		# is jIR2, which we implement as IR2 * (-j)
		When(IsEvenInt(m), [], Scat(H(2*mc*nc, nc, 2*mf*nc, 2))*C[3]*Gath(H(N,n/2,mf,m)))
	    ))),

    PDST4_CT_SPL := rec(
	isApplicable     := P -> P[1] > 2 and ForAny(DivisorPairs(2*P[1]), d->IsEvenInt(d[1]) and IsEvenInt(d[2])),
	forTransposition := false,

	allChildren  := P -> let(N := P[1],
	    Map2(Filtered(DivisorPairs(2*N), d -> IsEvenInt(d[1]) and IsEvenInt(d[2])),
		(m,n) -> [ PRDFT3(m,-1).transpose(), PRDFT3(n) ])),

	rule := (P,C) -> let(N := P[1], m := Rows(C[1]), n := Cols(C[2]),
            TT := Diag(fPrecompute(diagMul(fConst(N/2, -E(4)),
                        fCompose(dOmega(8 * N, 1),
                            diagTensor(dLin(N/m, 2, 1, TInt), dLin(m/2, 2, 1, TInt)))))),

	    Prm(Refl(N, 2*N-1, N, L(m*n, m))) *
	    Tensor(I(n/2), C[1]) *
            RC(TT) *
            RC(L(m*n/4, n/2)) *
	    Tensor(I(m/2), C[2]) *
	    Prm(Refl(N, 2*N-1, N, L(m*n, m)))
	)
    )
));

RulesFor(PDCT4, rec(
    PDCT4_Base2 := rec(isApplicable:=P->P[1]=2, rule:=(P,C)->DCT4(2).terminate()),
    PDCT4_Base4 := rec(isApplicable:=P->P[1]=4,
	               allChildren := P -> [[ DCT4(4) ]],
		       rule:=(P,C)->C[1]),

    PDCT4_CT := rec(
	isApplicable     := P -> P[1] > 2, #not IsPrime(P),
	forTransposition := false,
	allChildren  := P -> let(N := P[1], Map2(DivisorPairs(2*N), (m,n) -> Cond(
		IsEvenInt(m) and IsEvenInt(n), [ PRDFT3(m,-1).transpose(), PRDFT3(n) ],
		#IsEvenInt(m) and IsEvenInt(n), [ PDHT3(m).transpose(), PDHT3(n) ],
		IsEvenInt(m) and IsOddInt(n),  [ PRDFT3(m,-1).transpose(), PRDFT3(n), PDCT4(m/2) ],
		IsOddInt(m)  and IsEvenInt(n), [ PRDFT3(m,-1).transpose(), PRDFT3(n), PDCT4(n/2) ],
		IsOddInt(m)  and IsOddInt(n),  Error("This can't happen")))),

	rule := (P,C) -> let(N := P[1], m := Rows(C[1]), n := Cols(C[2]),
	    nf:=Int(n/2), nc:=Int((n+1)/2), mf:=Int(m/2), mc:=Int((m+1)/2), j:=Ind(nf), i:=Ind(mf),
	    t := fPrecompute(Twid(2*N, mf, 1, 1/2, 1/2, j)),
	    T := When(IsOddInt(m), Diag(diagDirsum(t,fConst(1,1))), Diag(t)),
	    Et := Tensor(I(mf),Mat([[0,1],[1,0]])),
	    SUM(
		ISum(j,
		    Scat(BH(N, 2*N-1, m, j, n)) * Diag(BHN(m)) * C[1] *
		    # mult twid by 1/2 for DHT
		    RC(T) *
		    #Et * # DHT only
		    RC(Gath(H(mc*nc, mc, j, nc)))
		),
		When(IsEvenInt(n), [], Scat(H(N,m/2,nf,n))*C[3]*Gath(H(2*mc*nc, m/2, 2*nf, 2*nc)))
	    ) *
	    SUM(
		ISum(i, RC(Scat(H(mc*nc, nc, i*nc, 1))) * C[2] * Diag(BHN(n)) * Gath(BH(N, 2*N-1, n, i, m))),
		When(IsEvenInt(m), [], Scat(H(2*mc*nc, nc, 2*mf*nc, 2))*C[3]*Gath(H(N,n/2,mf,m)))
	    ))),
));

NewRulesFor(PDCT4, rec(
    PDCT4_CT_SPL := rec(
        libApplicable := t -> eq(imod(t.params[1], 2), 0),
	applicable := t -> IsSymbolic(t.params[1]) or (t.params[1] > 2 and (t.params[1] mod 4) = 0),
        extraLeftTags := [],
	forTransposition := false,

        freedoms := t -> [ divisorsIntNonTriv(t.params[1]/2) ],

	child  := (self, t, fr) >> let(N := t.params[1], f := fr[1],
	    [ spiral.sym.ASP(-1).RDFT3(2*f).withTags(self.extraLeftTags).transpose(),
	      spiral.sym.ASP.RDFT3(div(N,f)) ]),

	apply := (t,C,Nonterms) -> let(N := t.params[1], m := Rows(C[1]), n := Cols(C[2]),
            mh := Rows(C[1])/2, nh := Cols(C[2])/2,
            D := RC(Diag(fPrecompute(fCompose(dOmega(8 * N, 1),
                            diagTensor(dLin(N/m, 2, 1, TInt), dLin(m/2, 2, 1, TInt)))))),

            Grp(Scat(Refl1(nh, m)) *
                Tensor(I(nh), Diag(BHN(m)) * C[1]) *
                D *
                Tensor(I(nh), Tr(2, mh))) *
            #RC(Tr(mh, nh)) *
            Grp(Tr(mh, n) *
                Tensor(I(mh), C[2] * Diag(BHN(n))) *
                Gath(Refl1(mh, n)))
	)
    )
));

RulesFor(PDCT4, rec(
    # Variant better suited for vectorization
    PDCT4_CT_SPL_Vec := rec(
	isApplicable     := P -> P[1] > 2 and (P[1] mod 2) = 0,
	forTransposition := false,

	allChildren  := P -> let(N := P[1],
	    Map2(Filtered(DivisorPairs(2*N), d -> IsEvenInt(d[1]) and IsEvenInt(d[2])),
		(m,n) -> [ PRDFT3(m,-1).transpose(), PRDFT3(n) ])),

	rule := (P,C) -> let(N := P[1], m := Rows(C[1]), n := Cols(C[2]),
            TT := Diag(fPrecompute(fCompose(dOmega(8 * N, 1),
                        diagTensor(dLin(N/m, 2, 1, TInt), dLin(m/2, 2, 1, TInt))))),

            Prm(condIJ(N, n/2)) *
            Prm(L(N, m)) *
	    Tensor(I(n/2),
                   condM(m,m/2) * Diag(BHN(m)) * C[1]) *
            RC(TT) *
            Prm(L(N, n/2)) *
	    Tensor(I(m/2),
                   L(n, 2) * C[2] * Diag(BHN(n)) * condK(n, 2)) *
            Prm(L(N, m/2)) *
            Prm(condIJ(N, m/2))
	)
    )

));

testPDCT4 := function(n)
    local opts, r, s;
    opts := CopyFields(SpiralDefaults, rec(
            breakdownRules := rec(
                PDCT4 := [PDCT4_Base2, PDCT4_CT_SPL_Vec],
                PRDFT1 := [PRDFT1_Base1, PRDFT1_Base2, PRDFT1_CT],
                PRDFT3 := [PRDFT3_Base1, PRDFT3_Base2, PRDFT3_CT],
                DFT := [DFT_Base, DFT_CT]
            )));
    r := RandomRuleTree(PDCT4(n), opts);
    s := SumsRuleTree(r, opts);
    return [opts,r,s];
end;

NewRulesFor(PDCT2, rec(
    PDCT2_Base2 := rec(
	forTransposition := true,
        applicable := t -> t.params[1] = 2,
        apply := (t, C, Nonterms) -> DCT2(2).terminate()
    ),

    PDCT2_Base4 := rec(
	forTransposition := true,
        applicable := t -> t.params[1] = 4,
        apply := (t, C, Nonterms) ->
            LIJ(4) *
            DirectSum(
                Diag(FList(TReal, [ 1, 0.70710678118654757 ])) * F(2),
                Rot(cospi(13/8), sinpi(13/8)) * J(2)) *
            (Tensor(I(2), F(2))) ^ LIJ(4)
    ),

    PDCT2_CT_SPL := rec(
	forTransposition := true,
        libApplicable := t -> eq(imod(t.params[1], 2), 0),
        extraLeftTags := [],

	applicable := t -> let(N:=t.params[1],
            IsSymbolic(N) or
            (N > 2 and IsEvenInt(N) and (N mod 4) = 0)),

	freedoms := t -> [ divisorsIntNonTriv(t.params[1]/2) ],

        # N/2 = k*m
        child := (self, t, fr) >> let(N:=t.params[1], k:=fr[1], m:=N/2/k,
            [ PDCT2(2*k).withTags(self.extraLeftTags),
              spiral.sym.ASP(-1).RDFT3(2*k).transpose().withTags(self.extraLeftTags),
              spiral.sym.ASP(+1).URDFT(2*m) ]),

	apply := (t,C,Nonterms) -> let(N:=t.params[1], k:=Rows(C[1])/2, m:=Cols(C[3])/2,
            D := RC(Diag(fPrecompute(fCompose(dOmega(4 * N, 1),
                        diagTensor(dLin(m-1, 1, 1, TInt), dLin(k, 2, 1, TInt)))))),
            Grp(
                Scat(Refl0_u(m, 2*k)) *
                DirectSum(
                    C[1] * KK(k, 2),
                    Tensor(I(m-1), Diag(BHN(2*k)) * C[2]) * D
                )) *
            Grp(
                RC(Tr(k, m)) *
                Tensor(I(k), C[3]) *
                Gath(Refl1(k, 2*m))
            )
	)
    )
));

NewRulesFor(PDST2, rec(
    PDST2_Base2 := rec(
        applicable := t -> t.params[1] = 2,
        apply := (t, C, Nonterms) -> DST2(2).terminate()
    ),

    PDST2_CT_SPL := rec(
	forTransposition := true,
	applicable := t -> let(N:=t.params[1], N > 2 and IsEvenInt(N) and (N mod 4) = 0),
	freedoms := t -> [ DivisorsIntNonTriv(t.params[1]/2) ],

        # N/2 = k*m
        child := (t, fr) -> let(N:=t.params, k:=fr[1], m:=N/2/k,
                [ DST2(2*k), PRDFT3(2*k,-1).transpose(), URDFT(2*m)  ]),

	apply := (t,C,Nonterms) -> let(N:=t.params[1], k:=Rows(C[1])/2, m:=Cols(C[3])/2,
            TT := Diag(fPrecompute(fCompose(dOmega(4 * N, 1),
                        # ie multiply all twiddles by -E(4)
                        diagAdd(diagDirsum(fConst(k, 0), fConst(k*(m-1), 3*N)),
                                diagTensor(dLin(m, 1, 0, TInt), dLin(k, 2, 1, TInt)))))),

            J(N) *
            Kp(N, 2*k) *
	    DirectSum(
                J(2*k) * C[1] * Diag(BHN(2*k)) * K(2*k, 2),
                Tensor(I(m-1), J(2*k) * M(2*k, k) * C[2])
            ) *
            RC(TT) *
            RC(L(N/2, m)) *
	    Tensor(I(k), C[3] * Diag(BHN(2*m))) *
	    Prm(Refl(N, 2*N-1, N, L(2*N, 2*k)))
	)
    )

));

RulesFor(DCT5, rec(
  DCT5_Rader := rec(
	forTransposition := false,
	isApplicable     := P -> P > 2 and IsPrime(2*P-1),
	allChildren      := P -> [[ IPRDFT(P-1,-1), PRDFT(P-1,-1) ]],

	diag := N -> Sublist(
	    DFT_Rader.raderDiag(2*N-1,1,PrimitiveRootMod(2*N-1)),
	    [1..Int((N-1)/2)]*2),

	# 3rd col with 0's is for PRDFT, not necessary for (non-packed) RDFT
	raderMid := (self, N) >> let(Fsize := 2*N-1,
	             DirectSum(Mat([[1, 1, 0], [1, -1/(Fsize-1), 0], [0,0,0]]),
			       RC(Diag(FData(self.diag(N)))))),

	# NOTE, special case for even P-1
	rule := (self,P,C) >> let(N := P,
	    #RealRR(N).transpose() *

	    Gath(H(2*P-1, P, 0, 1)) *
	    RR(2*P-1).transpose() *
	    DirectSum(I(1), VStack(I(P-1), I(P-1))) *

	    DirectSum(I(1), C[1]) *
#		C[1]*Diag(1,1, Replicate(2*Int((P-2)/2), 2),
#		               When(IsEvenInt(P-1), [1,1],[]))) *
	    self.raderMid(N) *
	    DirectSum(I(1), C[2]) *

            # replace by RealRR
	    Gath(H(2*P-1, P, 0, 1)) *
	    RR(2*P-1) * DirectSum(I(1), VStack(I(P-1), J(P-1)))
    ))
));

#q:=ExpandSPL(DCT5(6))[1];
#s:=SPLRuleTree(q);
#me := MatSPL(s);
#them := remat(MatSPL(q.node));

#RDFT-11,  DCT5(6) 15(6/9 rots) + 19(12/7 irdft) + 17(12/5 rdft) = 30/21 = 51
#           DST5(5)
#           10(blk)
# fftw 60/50

# RDFT-13
#  DCT5(7)  18(8/10=4/8+0/1+2/1 rots) + 18(14/4 irdft) + 18(14/4 rdft) = 36/18=54
#  DST5(6)
#  12(blk)
#  fftw 76/34=110

# DFT-13
# fftw 176+68=244
# us = 54*2 (dct5) + 24(blk)*2 + dst5


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

# input: imaginary, output: co1 (?)
_j := N -> Tensor(I(approx.CeilingRat(N/2)),J(2)*Diag(-1,1));

RealRR_Out := (N, root) -> let(
    rrind := RR(N, 1, root).tolist(),
    outind := List(rrind{[1..(N+1)/2]}, x->When(x.v >= (N+1)/2, N-x.v, x.v)),
    #same as Refl((N+1)/2, N, (N+1)/2, RR(N,1,root)).tolist(),

    # Reflective RR
    Scat(fTensor(FList((N+1)/2, outind), fId(2))) *
    # Conjugate complex elements that will be reflected
    Diag(ConcatList([0..(N-1)/2], x->When(rrind[x+1].v >= (N+1)/2, [1,-1], [1,1])))
);

RulesFor(PRDFT, rec(

   # PRDFT_PD : Projection of complex DFT partial diagonalization rule to real DFT
   # See also : PRDFT_Rader
   #
   PRDFT_PD := rec(
	forTransposition := true,
	maxSize          := 13,
	isApplicable     := (self, P) >> P[1] > 2 and P[1] <= self.maxSize and IsPrime(P[1]),

	rule := (self,P,C) >> let(N:=P[1], n:=N-1, k:=P[2], root:=PrimitiveRootMod(N),
	    BB(RealRR_Out(N, root) *
	    DirectSum(Mat([[1],[0]]), L(n, n/2)) *
	    Mat(MatSPL(DFT_PD.core(N, k, root, true) * DFT_PD.A(N))) *
	    DirectSum(I(1), Tensor(F(2), I(n/2))) *
	    DirectSum(I(1), OS(n, -1)) *
	    Gath(RR(N, 1, root)))
	)
   ),

   # PRDFT_Rader : Projection of complex DFT Rader rule to real DFT
   #
   #   Note: PRDFT of types 2--4 of odd size (which includes all primes > 2)
   #         can be converted without arithmetic cost to PRDFT1,
   #         which means that this rule enables implementation of a prime
   #         size PRDFT of any type.
   PRDFT_Rader := rec(
	isApplicable := (self, P) >> P[1] > 3 and IsPrime(P[1]),

	diag := (N, k, root) -> let(fulldiag := DFT_Rader.raderDiag(N,k,root),
	    last := Int((N-1)/2),
	    Concatenation(2*fulldiag{[1..last-1]}, [fulldiag[last]])),

	# 3rd col with 0's is for padding used by PRDFT
	raderMid := (self, N, k, root) >> let(n:=N-1,
	    DirectSum(Mat([[1, 1, 0], [1, -1/n, 0], [0,0,0]]),
		      RCDiag(RCData(FData(self.diag(N, k, root)))))),

	allChildren := P -> let(n:=P[1]-1,
	    [[ PRDFT(n/2).transpose(), PRDFT3(n/2).transpose(), PRDFT(n, -1) ]]),

	rule := (self,P,C) >> let(N:=P[1], n:=N-1, k:=P[2], root:=PrimitiveRootMod(N),
	    RealRR_Out(N, root) *
	    DirectSum(Mat([[1],[0]]), ##
		      L(n, n/2) *
		      DirectSum(C[1], C[2] * _j(n/2)) *
		      RC(L_or_OS(n/2+1, 2))) *
	    self.raderMid(N, k, root) *
	    DirectSum(I(1), C[3]) *
	    Gath(RR(N, 1, root))
	)
   )
));

RulesFor(IPRDFT, rec(

   # IPRDFT_PD : Projection of complex DFT partial diagonalization rule to inverse real DFT
   # See also : IPRDFT_Rader
   #
   IPRDFT_PD := rec(
	forTransposition := true,
	maxSize          := 13,
	isApplicable     := (self, P) >> P[1] > 2 and P[1] <= self.maxSize and IsPrime(P[1]),
	rule := (self,P,C) >> let(N:=P[1], n:=N-1, k:=P[2], root:=PrimitiveRootMod(N),
	    BB(Scat(RR(N, 1, root)) *
	    DirectSum(I(1), OS(n, -1)) *
	    DirectSum(I(1), Tensor(F(2), I(n/2))) *
	    Mat(MatSPL(TransposedSPL(DFT_PD.core(N, -k, root, true) * DFT_PD.A(N)) * DirectSum(I(1), 2*I(n)))) *
	    DirectSum(Mat([[1,0]]), L(n, 2)) *
	    RealRR_Out(N, root).transpose())
	)
   ),

   # IPRDFT_Rader : Projection of complex DFT Rader rule to inverse real DFT
   #
   #   Note: IPRDFT of types 2--4 of odd size (which includes all primes > 2)
   #         can be converted without arithmetic cost to IPRDFT1,
   #         which means that this rule enables implementation of a prime
   #         size IPRDFT of any type.
   IPRDFT_Rader := CopyFields(PRDFT_Rader, rec(
	# 3rd col with 0's is for padding, we also scale everything but 1st elt by 2,
	# as IPRDFT requires.
	raderMid := (self, N, k, root) >> let(n:=N-1,
	    DirectSum(Mat([[1, 2, 0], [1, -2/n, 0], [0,0,0]]),
		      RCDiag(RCData(FConj(FData(2*self.diag(N, -k, root))))))),

	allChildren := P -> let(n:=P[1]-1,
	    [[ PRDFT(n/2), PRDFT3(n/2), PRDFT(n,-1).transpose() ]]),

	rule := (self,P,C) >> let(N:=P[1], n:=N-1, k:=P[2], root:=PrimitiveRootMod(N),
	    Scat(RR(N, 1, root)) *
	    DirectSum(I(1), C[3]) *
	    self.raderMid(N, k, root) *
	    DirectSum(Mat([[1,0]]), ##
		      RC(L_or_OS(n/2+1, 2).transpose()) *
		      DirectSum(C[1], _j(n/2).transpose() * C[2]) *
		      L(n, 2)) *
	    RealRR_Out(N, root).transpose()
	)
   ))
));


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

# NOTE: MISSING (YV)
Class(VScat_red);

Class(BaseVScat, BaseMat, SumsBase, rec(
    isVScat := true,
    sums := self >> self,
    dims := self >> self.dimensions,
    isReal := self >> true,
    needInterleavedLeft := False,
    needInterleavedRight := False,
    area := self >> self.transpose().area(),
    toAMat := self >> TransposedAMat(self.transpose().toAMat()),
    conjTranspose := self >> self.transpose(),
));

Class(BaseSVScat, BaseMat, SumsBase, rec(
    isVScat := true,
    isSVScat := true,
    #-----------------------------------------------------------------------
    abbrevs        := BaseSVGath.abbrevs,
    new            := BaseSVGath.new,
    print          := BaseSVGath.print,
    getConstantRem := BaseSVGath.getConstantRem,
    #-----------------------------------------------------------------------
    dims := self >> Error(ObjId(self), ".dims() is undefined"),
    #-----------------------------------------------------------------------
    sums := self >> self,
    isReal := self >> true,
    needInterleavedLeft := True,
    needInterleavedRight := False,
    #-----------------------------------------------------------------------
    conjTranspose := self >> self.transpose(),
    area := self >> self.transpose().area(),
    toAMat := self >> TransposedAMat(self.transpose().toAMat())
));

IsVScat := x -> IsRec(x) and IsBound(x.isVScat) and x.isVScat;
IsSVScat := x -> IsRec(x) and IsBound(x.isSVScat) and x.isSVScat;

# ==========================================================================
# VScat(<func>, <v>) - vector scatter (write) matrix, assumes aligned output
# ==========================================================================
Class(VScat, BaseVScat, rec(
    #-----------------------------------------------------------------------
    rChildren := self >> [self.func],
    rSetChild := rSetChildFields("func"),
    from_rChildren := (self, rch) >> ObjId(self)(rch[1], self.v),
    #-----------------------------------------------------------------------
    new := (self, func, v) >> SPL(WithBases(self,
        rec(func := func, v := v))).setDims(),
    #-----------------------------------------------------------------------
    dims := self >> [self.v * self.func.range(), self.v * self.func.domain()],
    #-----------------------------------------------------------------------
    transpose := self >> VGath(self.func, self.v),
    #-----------------------------------------------------------------------
    print := (self,i,is) >> Print(self.__name__, "(", self.func, ", ", self.v, ")", self.printA()),
 ));

# ==========================================================================
# VScat_u(<func>, <v>) -- same as VScat but assumes that output is unaligned
# ==========================================================================
Class(VScat_u, VScat, rec(
    dims := self >> [ self.func.range(), self.v * self.func.domain()],
    transpose := self >> VGath_u(self.func, self.v)
));

# ==========================================================================
# VScat_zero(N, n, <v>) - vector scatter (write) matrix
# ==========================================================================
Class(VScat_zero, BaseVScat, rec(
    #-----------------------------------------------------------------------
    rChildren := self >> [],
    rSetChild := rSetChildFields(),
    from_rChildren := (self, rch) >> ObjId(self)(self.N, self.n, self.v),
    #-----------------------------------------------------------------------
    new := (self, N, n, v) >> SPL(WithBases(self,
        rec(n := n, N := N, v := v))).setDims(),
    #-----------------------------------------------------------------------
    dims := self >> [self.v * self.N, self.v * self.n],
    #-----------------------------------------------------------------------
    transpose := self >> VGath_zero(self.N, self.n, self.v),
    #-----------------------------------------------------------------------
    print := (self,i,is) >> Print(self.__name__, "(", self.N, ", ",
        self.n, ", ", self.v,")", self.printA()),
 ));

# ==========================================================================
# VScat_sv(<func>, <v>, <sv>) - vector scatter (write) matrix on subvectors
# ==========================================================================
Class(VScat_sv, BaseSVScat, rec(
    #-----------------------------------------------------------------------
    rChildren := self >> [self.func],     # self >> [self.func, self.v, self.sv],
    rSetChild := rSetChildFields("func"), # rSetChildFields("func", "v", "sv"),
    from_rChildren := (self, rch) >> ObjId(self)(rch[1], self.v, self.sv, self.rem),
    #-----------------------------------------------------------------------
    dims := self >> [self.sv * self.func.range(),
                     _roundup(self.sv * self.func.domain(), self.v)],
    #-----------------------------------------------------------------------
    transpose := self >> VGath_sv(self.func, self.v, self.sv, self.rem),
));

# ==========================================================================
# RCVScat_sv(<func>, <v>, <sv>) - vector scatter (write) matrix on subvectors
# ==========================================================================
Class(RCVScat_sv, BaseSVScat, rec(
    #-----------------------------------------------------------------------
    rChildren := self >> [self.func],     # self >> [self.func, self.v, self.sv],
    rSetChild := rSetChildFields("func"), # rSetChildFields("func", "v", "sv"),
    from_rChildren := (self, rch) >> ObjId(self)(rch[1], self.v, self.sv, self.rem),
    #-----------------------------------------------------------------------
    dims := self >> let(
	n := self.func.domain() * self.sv,  nv := _roundup(n, self.v),
	N := self.func.range() * self.sv,
	[2*N, 2*nv]),
    #-----------------------------------------------------------------------
    transpose := self >> RCVGath_sv(self.func, self.v, self.sv, self.rem),
));

# ==========================================================================
# VStretchScat(<func>, part, <v>) - vector scatter (write) matrix on subvectors
# ==========================================================================
Class(VStretchScat, BaseSVScat, rec(
    #-----------------------------------------------------------------------
    rChildren := self >> [self.func],
    rSetChild := rSetChildFields("func"),
    from_rChildren := (self, rch) >> ObjId(self)(rch[1], self.part, self.v),
    #-----------------------------------------------------------------------
    dims := self >> let(
	n  := self.func.domain(), N := self.func.range(),
	nv := self.part * _roundup(n / self.part, self.v),
        [N, nv]),
    #-----------------------------------------------------------------------
    abbrevs := [],
    new := (self, func, part, v) >> SPL(WithBases(self,
	rec(func := func, part := part, v := v))).setDims(),
    #-----------------------------------------------------------------------
    transpose := self >> VStretchGath(self.func, self.part, self.v),
    #-----------------------------------------------------------------------
    print := (self,i,is) >> Print(self.__name__, "(", self.func, ", ",
        self.part, ", ", self.v, ")", self.printA()),
));

# ==========================================================================
# vRCStretchScat(<func>, part, <v>) - vector scatter (write) matrix on subvectors
# ==========================================================================
Class(vRCStretchScat, BaseSVScat, rec(
    #-----------------------------------------------------------------------
    rChildren := self >> [self.func],
    rSetChild := rSetChildFields("func"),
    from_rChildren := (self, rch) >> ObjId(self)(rch[1], self.part, self.v),
    #-----------------------------------------------------------------------
    dims := self >> let(
	n  := self.func.domain(), N := self.func.range(),
	nv := self.part * _roundup(n / self.part, self.v/2),
        2*[N, nv]),
    #-----------------------------------------------------------------------
    abbrevs := [],
    new := (self, func, part, v) >> SPL(WithBases(self,
        rec(func := func, part := part, v := v))).setDims(),
    #-----------------------------------------------------------------------
    transpose := self >> vRCStretchGath(self.func, self.part, self.v),
    #-----------------------------------------------------------------------
    print := (self,i,is) >> Print(self.__name__, "(", self.func, ", ",
        self.part, ", ", self.v, ")", self.printA()),
));

# ==========================================================================
# RCVStretchScat(<func>, part, <v>) - vector scatter (write) matrix on subvectors
# ==========================================================================
Class(RCVStretchScat, BaseSVScat, rec(
    #-----------------------------------------------------------------------
    rChildren := self >> [self.func],
    rSetChild := rSetChildFields("func"),
    from_rChildren := (self, rch) >> ObjId(self)(rch[1], self.part, self.v),
    #-----------------------------------------------------------------------
    dims := self >> let(
	n  := self.func.domain(), N := self.func.range(),
	nv := self.part * _roundup(n / self.part, self.v),
        2*[N, nv]),
    #-----------------------------------------------------------------------
    abbrevs := [],
    new := (self, func, part, v) >> SPL(WithBases(self, rec(
        func := func, part := part, v := v))).setDims(),
    #-----------------------------------------------------------------------
    transpose := self >> RCVStretchGath(self.func, self.part, self.v),
    #-----------------------------------------------------------------------
    print := (self,i,is) >> Print(self.__name__, "(", self.func, ", ",
        self.part, ", ", self.v, ")", self.printA()),
 ));

# ==========================================================================
# VScat_pc(N, n, ofs, v) - vector scatter (write) matrix writing unaligned
#                         partial contiguous vectors
# ==========================================================================
Class(VScat_pc, BaseSVScat, rec(
    #-----------------------------------------------------------------------
    rChildren := self >> [self.N, self.n, self.ofs, self.v],
    rSetChild := rSetChildFields("N", "n", "ofs", "v"),
    #-----------------------------------------------------------------------
    dims := self >> let(nv := _roundup(self.n, self.v), [self.N, nv]),
    #-----------------------------------------------------------------------
    abbrevs := [],
    new := (self, N, n, ofs, v) >> SPL(WithBases(self, rec(
        N := N, n:= n, ofs := ofs, v := v))).setDims(),
    #-----------------------------------------------------------------------
    transpose := self >> VGath_pc(self.N, self.n, self.ofs, self.v),
    #-----------------------------------------------------------------------
    print := (self,i,is) >> Print(self.__name__, "(", self.N, ", ", self.n, ", ",
        self.ofs, ", ", self.v,")", self.printA()),
));

# ==========================================================================
# IxVScat_pc(k, N, n, ofs, v) - vector gather (read)
#   matrix reading unaligned
#   partial REAL contiguous vectors
# ==========================================================================
Class(IxVScat_pc, BaseSVScat, rec(
    #-----------------------------------------------------------------------
    rChildren := self >> [self.k, self.N, self.n, self.ofs, self.v],
    rSetChild := rSetChildFields("k", "N", "n", "ofs", "v"),

    from_rChildren := (self, rch) >> ObjId(self)(self.k, self.N, self.n, self.ofs, self.v),
    #-----------------------------------------------------------------------
    dims := self >> let(nv := _roundup(self.n, self.v), [self.k*self.N, self.k*nv]),
    #-----------------------------------------------------------------------
    abbrevs := [],
    new := (self, k, N, n, ofs, v) >> SPL(WithBases(self, rec(
        k := k, N := N, n:= n, ofs := ofs, v := v))).setDims(),
    #-----------------------------------------------------------------------
    transpose := self >> IxVGath_pc(self.k, self.N, self.n, self.ofs, self.v),
    #-----------------------------------------------------------------------
    toloop := (self, bksize) >> self.transpose().toloop(bksize).transpose(),
    #-----------------------------------------------------------------------
    print := (self,i,is) >> Print(self.__name__, "(", self.k, ", ", self.N, ", ",
        self.n, ", ", self.ofs, ", ", self.v,")", self.printA()),
));

# ==========================================================================
# IxRCVScat_pc(k, N, n, ofs, v) - vector gather (read)
#   matrix reading unaligned
#   partial REAL contiguous vectors
# ==========================================================================
Class(IxRCVScat_pc, BaseSVScat, rec(
    #-----------------------------------------------------------------------
    rChildren := self >> [],         # self >> [self.ofs],  # SEEMS NOT TO WORK?!
    rSetChild := rSetChildFields(),  #  rSetChildFields("ofs"),
    from_rChildren := (self, rch) >> ObjId(self)(self.k, self.N, self.n, self.ofs, self.v),
    #-----------------------------------------------------------------------
    dims := self >> let(nv := _roundup(self.n, self.v), 2 * [self.k*self.N, self.k*nv]),
    #-----------------------------------------------------------------------
    abbrevs := [],
    new := (self, k, N, n, ofs, v) >> SPL(WithBases(self, rec(
        k := k, N := N, n := n, ofs := ofs, v := v))).setDims(),
    #-----------------------------------------------------------------------
    transpose := self >> IxRCVGath_pc(self.k, self.N, self.n, self.ofs, self.v),
    #-----------------------------------------------------------------------
    print := (self,i,is) >> Print(self.__name__, "(", self.k, ", ", self.N, ", ",
        self.n, ", ", self.ofs, ", ", self.v,")", self.printA()),
));

# ==========================================================================
# Accumulative scatter versions
# NOTE: to be replaced by a Sigma-SPL lowering step, CodeSumsAcc, and
#        a specialized CodegenAcc
#
# NOTE(!!!): .transpose().transpose() on below classes will lead to non-accumulative
#             versions, and thus invalid code!
Class(VScatAcc,    VScat,    rec());
Class(VScatAcc_u,  VScat_u,  rec());
Class(VScat_svAcc, VScat_sv, rec());
Class(VScat_pcAcc, VScat_pc, rec());

# ==========================================================================
# Methods for vectorization  of ScatGath constructs
# NOTE: This is a hack

# BB needed, as basic block size is not known due to varying function domain
ScatGath.toloopRCVec := (self, _bksize, v) >> let(
    bksize := When(_bksize = 1, v, _bksize),
    dom    := RulesMergedStrengthReduce(_divideFunc(self.gfunc.domain(), bksize)),
    i      := Ind(dom), #ok := Error("caught"),
    sfunc  := RulesFuncSimp(self.sfunc),
    ISum(i, dom,
        BB(
            Compose(When(ObjId(sfunc)=fId, [], [RCVScat_sv(sfunc, v, 1)]) ::
		    [VScat(fTensor(fBase(i), fId(2*bksize/v)), v)]) *
            RCVGath_sv(fCompose(self.gfunc, fTensor(fBase(i), fId(bksize))).setDomain(bksize), v, 1)
        )
    )
);

ScatGath.toloopVec := (self, _bksize, v) >> let(
    bksize := When(_bksize = 1, v, _bksize),
    dom    := RulesMergedStrengthReduce(_divideFunc(self.gfunc.domain(), bksize)),
    i      := Ind(dom),
    sfunc  := RulesFuncSimp(self.sfunc),
    ISum(i, dom,
        BB(
            Compose(When(ObjId(sfunc)=fId, [], [VScat_sv(sfunc, v, 1)]) ::
		    [ VScat(fTensor(fBase(i), fId(bksize/v)), v)]) *
            VGath_sv(fCompose(self.gfunc, fTensor(fBase(i), fId(bksize))).setDomain(bksize), v, 1)
        )
    )
);


local reps,tori,labels,I,II,ords,mizuno,blocks;

mizuno:=[[ 1, 2, 3, 4, 5, 6, fail,
           7, 8, 9, 10,
           11, 6, 12, 13,
           15, 14, 16, 11,
           17, 18, 19, 21,
           20, 16, 22, 23,
           24, 25, 21, 20,
           26, 27, 23, 28,
           25, 29, 30, 27,
           31, 28, 32, 33,
           30, 31, 34, 32,
           33, fail, 35, 34,
           fail, 36, 35, fail,
           36, fail, fail, fail,
           fail, fail, fail, fail ],
          []];

reps:=[[[1,1],[2,1],[3,1],[4,1],[5,1],[6,1]],          # E_6
       [[2,1],[4,1],[5,1],[6,1],[8,1],[16,1]],         # E_6(a_1)
       [[1,1],[2,1],[10,1],[11,1],[12,1]],             # D_5
       [[8,1],[9,1],[12,1],[10,1],[11,1],[16,1]],      # A_5+A_1
       [[8,1],[9,1],[16,1],[12,1],[18,1]],             # D_5(a_1)
       [[1,1],[15,1],[16,1],[17,1],[6,1]],             # A_5
       [[14,1],[15,1],[16,1],[17,1],[12,1]],           # A_4+A_1
       [[2,1],[14,1],[16,1],[18,1]],                   # D_4
       [[14,1],[15,1],[17,1],[12,1]],                  # A_4
       [[14,1],[16,1],[22,1],[24,1]],                  # D_4(a_1)
       [[14,1],[22,1],[23,1],[24,1]],                  # A_3+A_1
       [[20,1],[21,1],[28,1],[23,1],[24,1]],           # 2A_2+A_1
       [[14,1],[22,1],[24,1]],                         # A_3
       [[26,1],[27,1],[28,1],[29,1]],                  # A_2+2A_1
       [[20,1],[21,1],[23,1],[24,1]],                  # 2A_2
       [[26,1],[27,1],[35,1]],                         # A_2+A_1
       [[26,1],[35,1]],                                # A_2
       [[37,1],[38,1],[40,1]],                         # 3A_1
       [[42,1],[43,1]],                                # 2A_1
       [[53,1]]                                        # A_1
       ];

labels:=["E_6",
         "E_6(a_1)",
         "D_5",
         "A_5+A_1",
         "D_5(a_1)",
         "A_5",
         "A_4+A_1",
         "D_4",
         "A_4",
         "D_4(a_1)",
         "A_3+A_1",
         "2A_2+A_1",
         "A_3",
         "A_2+2A_1",
         "2A_2",
         "A_2+A_1",
         "A_2",
         "3A_1",
         "2A_1",
         "A_1",
         ];

I:=[ [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ] ];

II:=[ [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ] ];

tori:=[ [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ] ];

#blocks:=[];
blocks:=[[[16, 4], [8, 1], [6, 1]], [[16, 2], [11, 2], [8, 2], [4, 2]], [[8, 9], [6, 1]], [[8, 8], [4, 2], [3, 2]], [[8, 5], [6, 1], [4, 8]], [[8, 8], [2, 6], [1, 2]], [[8, 4], [6, 2], [5, 2], [4, 4], [2, 4]], [[8, 1], [6, 9], [2, 8]], [[8, 2], [7, 4], [5, 2], [4, 2], [3, 4], [1, 4]], [[4, 18], [3, 2]], [[4, 16], [2, 6], [1, 2]], [[4, 16], [2, 6], [1, 2]], [[4, 16], [2, 4], [1, 6]], [[4, 10], [3, 2], [2, 16]], [[4, 16], [1, 14]], [[4, 8], [3, 6], [2, 10], [1, 8]], [[4, 2], [3, 18], [1, 16]], [[2, 38], [1, 2]], [[2, 32], [1, 14]], [[2, 22], [1, 34]]];

#ords:=[];
ords:=[ 16, 16, 8, 8, 8, 8, 8, 8, 8, 4, 4, 4, 4, 4, 4, 4, 4, 2, 2, 2 ];

return [reps,tori,labels,I,II,ords,blocks,mizuno];


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

#F PolyDTT( <dtt-nonterminal> )
#F Parameters:       <nonterminal for a (optionally skew) DCT or DST of type 1--8>
#F Definition:       Let <t> be an (otionally skew) DCT or DST of type 1--8. Then
#F                   Transform( "PolyDTT", <t> ) represents the (n x n)-matrix
#F                   obtained from dividing every row in <t> by its first
#F                   entry.
#F                   This transform is called the polynomial version of
#F                   the DCT or DST.
#F Note:             The transpose of PolyDTT(<t>) is
#F                   TPolyDTT(<t>^T).
#F Example:          PolyDTT(DCT2(8)).
#F
Class(PolyDTT, NonTerminal, rec(
    _short_print := true,
    abbrevs := [ nt -> Checked(IsNonTerminal(nt),
	    ObjId(nt) in
	    [ DCT1, DCT3, DCT5, DCT7, # PolyDTT(T)=T for these
	      DCT2, DCT4, DCT6, DCT8,
	      DST1, DST2, DST3, DST4,
	      DST5, DST6, DST7, DST8,
	      SkewDTT],
	    [ Copy(nt) ]
	)],
    dims := self >> self.params[1].dimensions,
    terminate := self >> Mat(PolynomialDTT(MatSPL(TerminateSPL(self.params[1])))),
    isReal := True
));

Class(fr, Exp, rec(
    ev := self >> let(
	m := self.args[1].ev(),
	i := self.args[2].ev(),
	r := self.args[3].ev(),
	Cond(i mod 2 = 0, (r + 2 * Int(i/2)) / m,
	     i mod 2 = 1, (2 - r + 2 * Int(i/2)) / m))));

#F Rules
#F -----
RulesFor(PolyDTT, rec(
    PolyDTT_ToNormal := rec(
	isApplicable := P -> ObjId(P[1]) in [DCT1, DCT3, DCT5, DCT7],
	allChildren := P -> [P[1]],
	rule := P -> P[1]
    ),

    #F PolyDTT_Base2: (base case for non-skew DTTs of size 2)
    #F
    #F   pDCT2_2 = F_2
    #F   pDCT4_2 = F_2 * [[1, -1], [0, sqrt(2)]]
    #F   pDCT6_2 = [ [ 1, 1 ], [ 1, -2 ] ]
    #F   pDCT8_2 = [ [ 1, cos(2*pi/5) ], [ 1, cos(4*pi/5) ] ]
    #F   pDST4_2 = F_2 * [[1, 1], [0, sqrt(2)]]
    #F
    #F   Pueschel/Moura: Discrete Cosine and Sine Transforms, in preparation
    #F
    PolyDTT_Base2 := rec (
	info           := "pDTT_2 -> F_2",
	isApplicable   := P -> Rows(P[1]) = 2 and ObjId(P[1]) <> SkewDTT,
	allChildren    := P -> [[ ]],
	rule := (P, C) -> let(nt := ObjId(P[1]), Cond(
		nt = DCT2, F(2),
		nt = DCT4, F(2) * Mat([[1, -1], [0,sqrt(2)]]),
		nt = DCT6, Mat([[1,1], [1,-2]]),
		nt = DCT8, Mat([[1,2*CosPi(2/5)], [1,2*CosPi(4/5)]]),
		nt = DST2, F(2),
		nt = DST3, F(2) * Diag([1, sqrt(2)]),
		nt = DST4, F(2) * Mat([[1, 1], [0, sqrt(2)]]),
		nt = DST5, Mat([[1,2*CosPi(2/5)], [1,2*CosPi(4/5)]]),
		nt = DST6, Mat([[1,2*CosPi(1/5)], [1,2*CosPi(3/5)]]),
		nt = DST7, Mat([[1,2*CosPi(1/5)], [1,2*CosPi(3/5)]]),
		nt = DST8, Mat([[1,2], [1,-1]]),
		Error("unrecognized <L.symbol>"))
	)
    ),

   PolyDTT_SkewBase2 := rec (
	info           := "pDTT_2 -> F_2",
	isApplicable   := P -> Rows(P[1]) = 2 and ObjId(P[1]) = SkewDTT and
	                       ObjId(P[1].params[1]) = DST3,
	allChildren    := P -> [[ ]],
	rule := (P, C) -> let(skewnt := ObjId(P[1].params[1]), r := P[1].params[2],
	    Cond(
		skewnt = DST3, F(2) * Diag(1, 2*CosPi(r/2)),
		Error("unrecognized <L.symbol>"))
	)
   ),

   PolyDTT_SkewDST3_CT := rec(
       isApplicable := P -> ObjId(P[1]) = SkewDTT and
                            ObjId(P[1].params[1]) = DST3 and
                            Rows(P[1]) > 2 and not IsPrime(Rows(P[1])),

       allChildren := P -> let(
	   N := Rows(P[1].params[1]), r := P[1].params[2],
	   List(DivisorPairs(N), d->
	       let(i := Ind(d[2]),
		   ri := fr(d[2], i, r),
		   [ PolyDTT(SkewDTT(DST3(d[1]), ri)),
		     PolyDTT(SkewDTT(DST3(d[2]), r)) ]))),

       rule := (P,C) -> let(
	   MN := Rows(P[1]),  N := Rows(C[1]),  M := Rows(C[2]),
	   r := P[1].params[2],
	   i := C[1].root.params.params[2].args[2],

	    K(MN, N) *
	    IterDirectSum(i, i.range, C[1]) *
	    Tensor(C[2], I(N)) *
	    B_DST3_U(MN, M)
       )
   )
));