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

Class(PrunedDFT, TaggedNonTerminal, rec(
    abbrevs := [
        (n,blk,pat) -> Checked(IsPosIntSym(n), IsPosIntSym(blk), IsList(pat),
            AnySyms(n,blk) or (IsInt(_unwrap(n)/_unwrap(blk)) and ForAll(pat, i->IsInt(i) and i < n/blk)),
            [_unwrap(n), 1, _unwrap(blk), pat]),
        (n,k,blk,pat) -> Checked(IsPosIntSym(n), IsIntSym(k), IsPosIntSym(blk), IsList(pat),
            AnySyms(n,k) or Gcd(_unwrap(n),_unwrap(k))=1,
            AnySyms(n,blk) or (IsInt(_unwrap(n)/_unwrap(blk)) and ForAll(pat, i->IsInt(i) and i < n/blk)),
            [_unwrap(n), When(AnySyms(n,k), k, k mod _unwrap(n)), _unwrap(blk), pat])
        ],

    dims := self >> let(
        size := self.params[1],
        d := [size, self.params[3]*Length(self.params[4])],
        When(self.transposed, [d[2], d[1]], d)
    ),

    terminate := self >> let(
        size := self.params[1], blk := self.params[3], pat := self.params[4],
        res := DFT(size, self.params[2]).terminate() *
               Tensor(Mat(List(pat, i->BasisVec(size/blk, i))).transpose(), I(blk)).terminate(),
        When(self.transposed, res.transpose(), res)
    ),

    isReal    := self >> false,
    normalizedArithCost := self >> let(n := self.params[1], IntDouble(5 * n * d_log(n) / d_log(2))),
    TType := T_Complex(T_Real(64))
));

Class(PrunedIDFT, TaggedNonTerminal, rec(
    abbrevs := [
        (n,blk,pat) -> Checked(IsPosIntSym(n), IsPosIntSym(blk), IsList(pat),
            AnySyms(n,blk) or (IsInt(_unwrap(n)/_unwrap(blk)) and ForAll(pat, i->IsInt(i) and i < n/blk)),
            [_unwrap(n), 1, _unwrap(blk), pat]),
        (n,k,blk,pat) -> Checked(IsPosIntSym(n), IsIntSym(k), IsPosIntSym(blk), IsList(pat),
            AnySyms(n,k) or Gcd(_unwrap(n),_unwrap(k))=1,
            AnySyms(n,blk) or (IsInt(_unwrap(n)/_unwrap(blk)) and ForAll(pat, i->IsInt(i) and i < n/blk)),
            [_unwrap(n), When(AnySyms(n,k), k, k mod _unwrap(n)), _unwrap(blk), pat])
        ],

    dims := self >> let(
        size := self.params[1],
        d := [size, self.params[3]*Length(self.params[4])],
        When(not self.transposed, [d[2], d[1]], d)
    ),

    terminate := self >> let(
        size := self.params[1], blk := self.params[3], pat := self.params[4],
        res := DFT(size, self.params[2]).terminate() *
               Tensor(Mat(List(pat, i->BasisVec(size/blk, i))).transpose(), I(blk)).terminate(),
        When(not self.transposed, res.transpose(), res)
    ),

    isReal    := self >> false,
    normalizedArithCost := self >> let(n := self.params[1], IntDouble(5 * n * d_log(n) / d_log(2))),
    TType := T_Complex(T_Real(64))
));

_pruned_children := function(m, n, scatpat, pdft)
    local pdfts, scatpats, iterparts, uspats, uuspats, uspats, spats;
    spats := Map([0..m-1], i->List(Intersection(scatpat, i+m*[0..n-1]), j->j));
    uspats := Map([0..Length(spats)-1], i->(spats[i+1]-i)/m);
    uuspats := Set(uspats);

    # partition iterations into unique patterns
    iterparts := List([1..Length(uuspats)], j->Filtered([1..m], i->uspats[i] = uuspats[j])-1);
    Sort(iterparts);

    scatpats := List(iterparts, lst->uspats[lst[1]+1]);
    pdfts := Map(scatpats, sp->pdft(n, sp));
    return pdfts;
end;

_ctpr_applicable := function(m, n, scatpat)
    local spats, gpats, strides;
    spats := Map([0..m-1], i->List(Intersection(scatpat, i+m*[0..n-1]), j->j));
    gpats := Map(spats, lst->Map(lst, i->Position(scatpat, i)-1));
    strides := Set(Flat(Map(gpats, lst->Map([1..Length(lst)-1], j->lst[j+1]-lst[j]))));
    return ForAll(spats, i->i<>[]) and  (Length(strides) in [0, 1]);
end;

_build_basef := lst -> When(lst = lst[1] + [0..Length(lst)-1], let(i := Ind(Length(lst)), Lambda(i, lst[1] + i)), FData(Map(lst, V)));

_build_stack := function(m, n, scatpat, pdfts, NI, gsop, istck, stck, cmpse)
    local stack, isu, is, itervars, gatscats, lbds, lbdvars, itercounts, iterbasesf, iterbases, iterparts, uuspats, uspats, bases, strides, stride, spats, gpats;
    spats := Map([0..m-1], i->List(Intersection(scatpat, i+m*[0..n-1]), j->j));
    gpats := Map(spats, lst->Map(lst, i->Position(scatpat, i)-1));
    #When(ForAny(spats, i->i=[]), Error("need at least one element per child DFT"));
    strides := Set(Flat(Map(gpats, lst->Map([1..Length(lst)-1], j->lst[j+1]-lst[j]))));
    stride := When(Length(strides) = 1, strides[1], 1);
    bases := Map(gpats, i->i[1]);

    uspats := Map([0..Length(spats)-1], i->(spats[i+1]-i)/m);
    uuspats := Set(uspats);

    iterparts := List([1..Length(uuspats)], j->Filtered([1..m], i->uspats[i] = uuspats[j])-1);
    Sort(iterparts);
    iterbases := Map(iterparts, lst->Map(lst, i->bases[i+1]));
    iterbasesf := List(iterbases, _build_basef);
    itercounts := List(iterparts, Length);
    itervars := List(iterparts, lst->Ind(Length(lst)));
    lbdvars := List(iterparts, lst->Ind(Length(gpats[lst[1]+1])));
    lbds := List([1..Length(itervars)], i->Lambda(lbdvars[i], stride*lbdvars[i]+iterbasesf[i].at(itervars[i])).setRange(NI));
    gatscats := List(lbds, i->ApplyFunc(gsop, [i]));

    is := List([1..Length(itervars)], i->ApplyFunc(istck, [itervars[i], cmpse(pdfts[i], gatscats[i])]));
    isu := Map([1..Length(is)], i->When(itervars[i].range=1, is[i].unroll().child(1), is[i]));
    stack := When(Length(isu) = 1, isu[1], ApplyFunc(stck, isu));
    return stack;
end;

NewRulesFor(PrunedDFT, rec(
    PrunedDFT_base := rec(
       forTransposition := false,
       maxSize := 256,
       applicable := (self, nt) >> not nt.hasTags() and nt.params[1] <= self.maxSize and nt.params[3] = 1,
       children := nt -> [[DFT(nt.params[1], nt.params[2])]],
       apply := (nt, C, cnt) -> let(size := nt.params[1], blk := nt.params[3], pat := nt.params[4],
            C[1] * Tensor(Mat(List(pat, i->BasisVec(size/blk, i))).transpose(), I(blk)).terminate())
    ),
    PrunedDFT_DFT := rec(
       forTransposition := true,
       applicable := (self, nt) >> nt.params[1] = nt.params[3] and nt.params[4] = [0],
       children := nt -> [[ DFT(nt.params[1], nt.params[2]).withTags(nt.getTags()) ]],
       apply := (nt, C, cnt) -> C[1]
    ),
    PrunedDFT_CT := rec(
       forTransposition := true,
       applicable := (self, nt) >> nt.params[1] > 2
            and not nt.hasTags()
            and not IsPrime(nt.params[1])
            and nt.params[3] > 1,
        children  := nt -> Map2(Filtered(DivisorPairs(nt.params[1]), (l) -> IsInt(nt.params[3]/l[1])),
            (m,n) -> [ DFT(m, nt.params[2] mod m), PrunedDFT(n, nt.params[2] mod n, nt.params[3]/m, nt.params[4]) ]
        ),
        apply := (nt, C, cnt) -> let(mn := nt.params[1], m := Rows(C[1]), n := Rows(C[2]),
            Tensor(C[1], I(n)) *
            Diag(fPrecompute(Tw1(mn, n, nt.params[2]))) *
            L(mn, m) * Tensor(C[2], I(m))
        )),
    PrunedDFT_CT_rec_block := rec(
       forTransposition := true,
       applicable := (self, nt) >> nt.params[1] > 2
            and not nt.hasTags()
            and not IsPrime(nt.params[1])
            and nt.params[3] = 1
            and Last(nt.params[4])+1-nt.params[4][1] = Length(Set(nt.params[4]))
            and ForAny(Map2(DivisorPairs(nt.params[1]), (m,n)->_ctpr_applicable(m, n, nt.params[4])), i->i),
       children := (nt) -> Filtered(Map2(DivisorPairs(nt.params[1]), (m, n) -> [ DFT(m, nt.params[2] mod m) ]::
                              _pruned_children(m, n, nt.params[4], (r, sp) -> PrunedDFT(r, nt.params[2] mod n, nt.params[3], sp))),
                              lst -> ForAll(Filtered(lst, i->ObjId(i) = PrunedDFT), j->j.params[4] <> [])),
        apply := (nt, C, cnt) -> let(mn := nt.params[1], m := Rows(C[1]), n := Rows(C[2]),
            Tensor(C[1], I(n)) *
            Diag(fPrecompute(Tw1(mn, n, nt.params[2]))) *
            _build_stack(m, n, nt.params[4], Drop(C, 1), nt.dims()[2], Gath, IterVStack, VStack, (a,b)->a*b)
        )
    )
));

NewRulesFor(PrunedIDFT, rec(
    PrunedIDFT_base := rec(
       forTransposition := false,
       maxSize :=256,
       applicable := (self, nt) >> not nt.hasTags() and nt.params[1] <= self.maxSize and nt.params[3] = 1,
       children := nt -> [[DFT(nt.params[1], nt.params[2])]],
       apply := (nt, C, cnt) -> let(size := nt.params[1], blk := nt.params[3], pat := nt.params[4],
            Tensor(Mat(List(pat, i->BasisVec(size/blk, i))) * C[1], I(blk)).terminate())
    ),
    PrunedIDFT_CT_rec_block := rec(
       forTransposition := true,
       applicable := (self, nt) >> nt.params[1] > 2
            and not nt.hasTags()
            and not IsPrime(nt.params[1])
            and nt.params[3] = 1
            and Last(nt.params[4])+1-nt.params[4][1] = Length(Set(nt.params[4]))
            and ForAny(Map2(DivisorPairs(nt.params[1]), (m,n)->_ctpr_applicable(m, n, nt.params[4])), i->i),
       children := (nt) -> Filtered(Map2(DivisorPairs(nt.params[1]), (n, m) ->
                              _pruned_children(m, n, nt.params[4], (r, sp) -> PrunedIDFT(r, nt.params[2] mod n, nt.params[3], sp)) ::
                              [ DFT(m, nt.params[2] mod m) ]),
                              lst -> ForAll(Filtered(lst, i->ObjId(i) = PrunedIDFT), j->j.params[4] <> [])),
        apply := (nt, C, cnt) -> let(mn := nt.params[1], m := Rows(Last(C)), n := Cols(C[1]),
            _build_stack(m, n, nt.params[4], DropLast(C, 1), nt.dims()[1], Scat, IterHStack1, HStack1, (a,b)->b*a) *
            Diag(fPrecompute(Tw1(mn, n, nt.params[2]))) *
            Tensor(Last(C), I(n))
        )
    )
));

Class(IOPrunedDFT, TaggedNonTerminal, rec(
    abbrevs := [
        (n,oblk,opat,iblk,ipat) -> Checked(IsPosIntSym(n), IsPosIntSym(oblk), IsList(opat), IsPosIntSym(iblk), IsList(ipat),
            AnySyms(n,iblk,oblk) or (IsInt(_unwrap(n)/_unwrap(iblk)) and IsInt(_unwrap(n)/_unwrap(oblk)) and
                ForAll(ipat, i->IsInt(i) and i < n/iblk) and ForAll(opat, i->IsInt(i) and i < n/oblk)),
            [_unwrap(n), 1, _unwrap(oblk), opat, _unwrap(iblk), ipat]),

        (n,k,oblk,opat,iblk,ipat) -> Checked(IsPosIntSym(n), IsIntSym(k), IsPosIntSym(oblk), IsList(opat), IsPosIntSym(iblk), IsList(ipat),
            AnySyms(n,k) or Gcd(_unwrap(n),_unwrap(k))=1,
            AnySyms(n,iblk,oblk) or (IsInt(_unwrap(n)/_unwrap(iblk)) and IsInt(_unwrap(n)/_unwrap(oblk)) and
                ForAll(ipat, i->IsInt(i) and i < n/iblk) and ForAll(opat, i->IsInt(i) and i < n/oblk)),
            [_unwrap(n), When(AnySyms(n,k), k, k mod _unwrap(n)), _unwrap(oblk), opat, _unwrap(iblk), ipat])
        ],
    dims      := self >> [self.params[3]*Length(self.params[4]), self.params[5]*Length(self.params[6])],
    terminate := self >> let(size := self.params[1],
        oblk := self.params[3], opat := self.params[4], iblk := self.params[5], ipat := self.params[6],
        Tensor(Mat(List(opat, i->BasisVec(size/oblk, i))), I(oblk)).terminate() *
        DFT(size, self.params[2]).terminate() *
        Tensor(Mat(List(ipat, i->BasisVec(size/iblk, i))).transpose(), I(iblk)).terminate()),
    isReal    := self >> false,
    normalizedArithCost := self >> let(n := self.params[1], IntDouble(5 * n * d_log(n) / d_log(2))),
    TType := T_Complex(T_Real(64))
));

NewRulesFor(IOPrunedDFT, rec(
    IOPrunedDFT_base := rec(
       forTransposition := true,
       maxSize := 16,
       applicable := (self, nt) >> not nt.hasTags() and nt.params[1] <= self.maxSize and nt.params[3] = 1 and nt.params[5] = 1,
       children := nt -> [[DFT(nt.params[1], nt.params[2])]],
       apply := (nt, C, cnt) -> let(size := nt.params[1], oblk := nt.params[3], opat := nt.params[4], iblk := nt.params[5], ipat := nt.params[6],
            Tensor(Mat(List(opat, i->BasisVec(size/oblk, i))), I(oblk)).terminate() *
            C[1] *
            Tensor(Mat(List(ipat, i->BasisVec(size/iblk, i))).transpose(), I(iblk)).terminate())
    ),

    IOPrunedDFT__PrunedDFT := rec(
       forTransposition := true,
       applicable := (self, nt) >> nt.params[1] = nt.params[3] and nt.params[4] = [0],
       children := nt -> [[ PrunedDFT(nt.params[1], nt.params[2], nt.params[5], nt.params[6]).withTags(nt.getTags()) ]],
       apply := (nt, C, cnt) -> C[1]
    ),

    IOPrunedDFT__PrunedDFT_T := rec(
       forTransposition := true,
       applicable := (self, nt) >> nt.params[1] = nt.params[5] and nt.params[6] = [0],
       children := nt -> [[ PrunedDFT(nt.params[1], nt.params[2], nt.params[3], nt.params[4]).transpose().withTags(nt.getTags()) ]],
       apply := (nt, C, cnt) -> C[1]
    ),

    IOPrunedDFT__Gath_PrunedDFT := rec(
       forTransposition := true,
       maxSize := 16,
       applicable := (self, nt) >> not nt.hasTags() and nt.params[1] <= self.maxSize and
           ((nt.params[3] = 1 and not (nt.params[5] = 1)) or (nt.params[3] * nt.params[5] < nt.params[1])),
       children := nt -> [[ PrunedDFT(nt.params[1], nt.params[2], nt.params[5], nt.params[6]) ]],
       apply := (nt, C, cnt) -> let(size := nt.params[1], oblk := nt.params[3], opat := nt.params[4], iblk := nt.params[5], ipat := nt.params[6],
            Tensor(Mat(List(opat, i->BasisVec(size/oblk, i))), I(oblk)).terminate() * C[1])
    ),

    IOPrunedDFT__PrunedDFT_T_Scat := rec(
       forTransposition := true,
       maxSize := 16,
       applicable := (self, nt) >> not nt.hasTags() and nt.params[1] <= self.maxSize and
           (((not nt.params[3] = 1) and nt.params[5] = 1) or(nt.params[3] * nt.params[5] < nt.params[1])),
       children := nt -> [[ PrunedDFT(nt.params[1], nt.params[2], nt.params[3], nt.params[4]).transpose() ]],
       apply := (nt, C, cnt) -> let(size := nt.params[1], oblk := nt.params[3], opat := nt.params[4], iblk := nt.params[5], ipat := nt.params[6],
            C[1] * Tensor(Mat(List(ipat, i->BasisVec(size/iblk, i))).transpose(), I(iblk)).terminate())
    ),

    IOPrunedDFT_CT := rec(
       forTransposition := true,
       applicable := (self, nt) >> nt.params[1] > 2 and nt.params[3] * nt.params[5] >= nt.params[1]
            and not nt.hasTags()
            and not IsPrime(nt.params[1])
            and nt.params[3] > 1,
        children  := nt -> Map2(Filtered(DivisorPairs(nt.params[1]), (mn) -> IsInt(nt.params[3]/mn[2]) and IsInt(nt.params[5]/mn[1])),
            (m,n) -> [
                PrunedDFT(m, nt.params[2] mod m, nt.params[3]/n, nt.params[4]).transpose(),
                PrunedDFT(n, nt.params[2] mod n, nt.params[5]/m, nt.params[6]) ]
        ),
        apply := (nt, C, cnt) -> let(mn := nt.params[1], m := Cols(C[1]), n := Rows(C[2]),
            Tensor(C[1], I(n)) *
            Diag(fPrecompute(Tw1(mn, n, nt.params[2]))) *
            L(mn, m) * Tensor(C[2], I(m))
        ))
));


InstallMethod(TotalDegree,
              "TotalDegree of multivariable polynomial",
              [IsPolynomial],
              function(poly)
              local result;

              result:=ExtRepPolynomialRatFun(poly);
              result:=result{2*[1..Length(result)/2]-1};
              result:=Maximum(List(result,j->Sum(j{2*[1..Length(j)/2]})));
              return result;
end);

InstallMethod(ValuePoly,
              "Value of multivariable polynomial",
              [IsPolynomial,IsList,IsList],
              function(poly,vars,vals)
    local result,ext_rep,ext_vars,
    monom,pos,i,j;

    ext_rep:=ExtRepPolynomialRatFun(poly);
    ext_vars:=List(vars,i->ExtRepPolynomialRatFun(i));
    ext_vars:=List(ext_vars,i->i[1][1]);

    result:=Zero(poly);
    for i in 2*[1..Length(ext_rep)/2]-1 do
        monom:=One(poly);
        for j in 2*[1..Length(ext_rep[i])/2]-1 do
            pos:=Position(ext_vars,ext_rep[i][j]);
            monom:=monom*vals[pos]^ext_rep[i][j+1];
        od;
        monom:=monom*((ext_rep[i+1]*One(poly)));
        result:=result+monom;
    od;

    return result;
end);

pRadical:=function(poly,avars)
    local result,
    ext_rep,ext_avars,
    p,deg,deg_max,p_div,monom,i,j;

    #exterior reprezentation of polynomial and variables
    ext_rep:=ExtRepPolynomialRatFun(poly);
    ext_avars:=List(avars,i->ExtRepPolynomialRatFun(i));
    ext_avars:=List(ext_avars,i->i[1][1]);

    # degree of variables in monomials of poly
    deg:=List(ext_rep{2*[1..Length(ext_rep)/2]-1},i->i{2*[1..Length(i)/2]});

    # Adjustment: (poly)^p ---> poly
    p:=Characteristic(poly);
    if Concatenation(deg)=[] then return poly; fi;
    deg_max:=LogInt(Maximum(Concatenation(deg)),p);
    p_div:=Gcd(p^deg_max,Gcd(Concatenation(deg)));
    if p_div>1 then
        result:=Zero(poly);
        for i in 2*[1..Length(ext_rep)/2]-1 do
            monom:=One(poly);
            for j in 2*[1..Length(ext_rep[i])/2]-1 do
                monom:=monom*avars[Position(ext_avars,ext_rep[i][j])]^(ext_rep[i][j+1]/p_div);
            od;
            result:=result+ext_rep[i+1]*monom;
        od;
        return result;
    fi;
    return poly;
end;

Solve:=function(poly,avars)
    local ext_rep,vars,ext_avars,p,
    deg,tot_deg,poz1,pozm,xpoly,xall,x,
    taboo;

    # Adjustment: (poly)^p ---> poly
    poly:=pRadical(poly,avars);

    #exterior reprezentation of polynomial and variables
    ext_rep:=ExtRepPolynomialRatFun(poly);
    ext_avars:=List(avars,i->ExtRepPolynomialRatFun(i));
    ext_avars:=List(ext_avars,i->i[1][1]);

    # variables of poly
    vars:=Concatenation(ext_rep{2*[1..Length(ext_rep)/2]-1});
    vars:=vars{2*[1..Length(vars)/2]-1};
    # degree of variables in monomials of poly
    deg:=List(ext_rep{2*[1..Length(ext_rep)/2]-1},i->i{2*[1..Length(i)/2]});
    tot_deg:=List(deg,i->Sum(i));
    #ignor constants
    tot_deg:=Filtered(tot_deg,i->i<>0);

    # Restrict: x should not be deduced from x+x^p+y
    taboo:=[];
    if Length(Set(vars))>1 then
    for x in Set(vars) do
        xall:=ext_rep{2*[1..Length(ext_rep)/2]-1};
        xall:=Filtered(xall,i->x in i);
        xpoly:=Filtered(xall,i->Length(i)=2);
        if Length(xpoly)>=2 then
        #    if xall=xpoly then
        #        return [Position(ext_avars,x),Zero(poly),avars[Position(ext_avars,x)]];
        #    fi;
            Add(taboo,Positions(vars,x));
        fi;
    od;
    taboo:=Concatenation(taboo);
    fi;

    p:=Characteristic(poly);
#    if Length(vars)=1 then
#        return [Position(ext_avars,vars[1]),RootsOfUPol(poly)[1],true];
#    fi;
#Error("!");
    if 1 in tot_deg then
        # x^p+P(x)^p
        if Length(Set(vars)) = 1 and Length(Set(tot_deg))>=2 then
#        Print(poly,"\n");
            return [Position(ext_avars,vars[1]),Zero(poly),avars[Position(ext_avars,vars[1])]];
#            return fail;
        fi;

##        if Length(Set(vars)) = 1 and not Difference(tot_deg,[1])[1] mod p =0 then
#        if Length(Set(vars)) = 1 and not Set(tot_deg)=[1,p] then
#            Print(poly,"\n");
#            return [Position(ext_avars,vars[1]),Zero(poly),avars[Position(ext_avars,vars[1])]];
##            return fail;
#        fi;

        if Length(Set(vars)) = 1 and Maximum(tot_deg)>1 then return fail; fi; # such relations produce infinite loops

        # position of variables among monomials of poly
        poz1:=Positions(tot_deg,1);
        poz1:=Difference(poz1,taboo);
        # if all variables are taboo return fail
        if Length(poz1)=0 then return fail; fi;
        # else choose one which is not taboo
        poz1:=poz1[1];
        # position of monomial in ext_rep
        pozm:=Position(ext_rep,[vars[poz1],1]);
        return [Position(ext_avars,vars[poz1]),avars[Position(ext_avars,vars[poz1])]-(ext_rep[pozm+1]^(-1))*poly,true];
    fi;
    return fail;
end;

SolveWithTorsion:=function(poly,avars)
    local ext_rep,vars,ext_avars,
    deg,tot_deg,poz1,pozm,xpoly,x,
    taboo;

    # Adjustment: (poly)^p ---> poly
    poly:=pRadical(poly,avars);

    #exterior reprezentation of polynomial and variables
    ext_rep:=ExtRepPolynomialRatFun(poly);
    ext_avars:=List(avars,i->ExtRepPolynomialRatFun(i));
    ext_avars:=List(ext_avars,i->i[1][1]);

    # variables of poly
    vars:=Concatenation(ext_rep{2*[1..Length(ext_rep)/2]-1});
    vars:=vars{2*[1..Length(vars)/2]-1};
    # degree of variables in monomials of poly
    deg:=List(ext_rep{2*[1..Length(ext_rep)/2]-1},i->i{2*[1..Length(i)/2]});
    tot_deg:=List(deg,i->Sum(i));
    #ignor constants
    tot_deg:=Filtered(tot_deg,i->i<>0);

    # Restrict: x should not be deduced from x+x^p+y
    taboo:=[];
    if Length(Set(vars))>1 then
    for x in Set(vars) do
        xpoly:=ext_rep{2*[1..Length(ext_rep)/2]-1};
        xpoly:=Filtered(xpoly,i->x in i);
        xpoly:=Filtered(xpoly,i->Length(i)=2);
        if Length(xpoly)>=2 then
            Add(taboo,Positions(vars,x));
        fi;
    od;
    taboo:=Concatenation(taboo);
    fi;

#    if Length(vars)=1 then
#        return [Position(ext_avars,vars[1]),RootsOfUPol(poly)[1],true];
#    fi;
#Error("!");
    if 1 in tot_deg then
        # x^p+P(x)^p
        if Length(Set(vars)) = 1 and Length(Set(tot_deg))>=2 then
            return [Position(ext_avars,vars[1]),Zero(poly),avars[Position(ext_avars,vars[1])]];
        fi;

        if Length(Set(vars)) = 1 and Maximum(tot_deg)>1 then return fail; fi; # such relations produce infinite loops

        # position of variables among monomials of poly
        poz1:=Positions(tot_deg,1);
        poz1:=Difference(poz1,taboo);
        # if all variables are taboo return fail
        if Length(poz1)=0 then return fail; fi;
        # else choose one which is not taboo
        poz1:=poz1[1];
        # position of monomial in ext_rep
        pozm:=Position(ext_rep,[vars[poz1],1]);
        return [Position(ext_avars,vars[poz1]),avars[Position(ext_avars,vars[poz1])]-(ext_rep[pozm+1]^(-1))*poly,true];
    fi;
    return fail;
end;

ReduceRelations:=function(relations,avars,values,APR)
    local result,#relations,
    relations_len,schimbare,Ring,torsion,GB,
    index,sol,i,modulo;

    result:=ShallowCopy(values);
    relations:=List(relations,i->Value(i,avars,result)*One(APR));
    relations:=Filtered(relations,i->i <> Zero(APR));
    relations:=Set(relations);
#    relations:=List(coefficients(u),i->i[2]);
    relations_len:=Length(relations);

#    i:=1;
#    while i<relations_len do
#        modulo:=Concatenation([1..i-1],[i+1..relations_len]);
#        modulo:=relations{modulo};
#        relations:=List(relations,i->PolynomialReducedRemainder(i,relations,MonomialLexOrdering()));
#        relations:=Set(Filtered(relations,i->i <> Zero(APR)));
#        if Length(relations)<relations_len then i:=1; fi;
#        relations_len:=Length(relations);
#    od;
#    Error("!");
#Print("...relations: ",relations,"\n");
    schimbare:=true;
    while relations<>[] and schimbare do
        #Print("@@@",relations_len," ");
#        Print("..relations: ",relations,"\n");
#        Print("--->result: ",result,"\n");
        #GB:=GroebnerBasis(relations,MonomialLexOrdering()); ## ATENTIE AICI
        result:=List(result,i->PolynomialReducedRemainder(i,relations,MonomialLexOrdering()));
        #result:=List(result,i->PolynomialReducedRemainder(i,GB,MonomialLexOrdering()));
#        Print("fresh result:",result,"\n");
        schimbare:=false;
        #Error("!!");
        #refresh relations
        #relations:=List(relations,i->Value(i,avars,result)*One(APR));
        relations:=List(relations,i->ValuePoly(i,avars,result)*One(APR));
#        Print("fresh rels:",relations,"\n");
        relations:=Filtered(relations,i->i <> Zero(APR));
        schimbare:=Length(relations)<relations_len;
        relations_len:=Length(relations);
    od;
#Error("!");
#Print(".relations: ",relations,"\n");
    relations:=Filtered(relations,i->i <> Zero(APR));

    return [result,relations];
end;

SolveRelations:=function(relations,avars,values,APR)
    local result,#relations,
    relations_len,schimbare,Ring,torsion,
    index,sol,i;

    result:=ShallowCopy(values);
    relations:=List(relations,i->Value(i,avars,result)*One(APR));
    relations:=Filtered(relations,i->i <> Zero(APR));

    relations:=ReduceRelations(relations,avars,result,APR);
#    #Error("!");
    result:=relations[1];
    relations:=relations[2];
#    #relations:=List(coefficients(u),i->i[2]);
    relations_len:=Length(relations);
#        Print("...relations: ",relations,"\n");

    Ring:=CoefficientsRing(APR);
    schimbare:=true;
    torsion:=[];

    #Error("!");
    while relations<>[] and schimbare do
    ##Print("len:=",Length(relations),"\n");
        schimbare:=false;
        index:=1;
        while index<=relations_len do
        #Print("len===",Length(relations),"\n","index===",index,"\n");
            sol:=Solve(relations[index],avars);
            #Print("solved ",relations[index],"\n");
            #Error("!");
            #sol:=fail;
            if sol<>fail then
                #change result
                result[sol[1]]:=sol[2];
                for i in [1..Length(result)] do
                    if not result[i] in Ring and result[i]<>avars[i] then
                       result[i]:=Value(result[i],avars,result)*One(APR);
                    fi;
                od;
                #refresh relations
                relations:=List(relations,i->Value(i,avars,result)*One(APR));
                relations:=Filtered(relations,i->i <> Zero(APR));
                #relations:=ReduceRelations(relations,avars,result,APR);
                #result:=relations[1];
                #relations:=relations[2];
                schimbare:=Length(relations)<relations_len or sol[2]=Zero(APR);
                relations_len:=Length(relations);

                if Length(sol)=3 and sol[3] in avars then Add(torsion,sol[3]); fi;
            fi;
            index:=index+1;
        od;
    od;

    return [result,relations,torsion];
end;


RequirePackage("grape");

GC := function(x,y,i,j) return x[i]*y[j] - x[j]*y[i]; end;

G2 := function(q)
    local P, Q;
    if q mod 2 = 0 then
        Q := [[0,0,0,0,1,0,0],[0,0,0,0,0,1,0],[0,0,0,0,0,0,1],[0,0,0,1,0,0,0],[0,0,0,0,0,0,0],[0,0,0,0,0,0,0],[0,0,0,0,0,0,0]]*Z(q)^0;;
    else
        Q := [[0,0,0,0,1,0,0],[0,0,0,0,0,1,0],[0,0,0,0,0,0,1],[0,0,0,1,0,0,0],[1,0,0,0,0,0,0],[0,1,0,0,0,0,0],[0,0,1,0,0,0,0]]*Z(q)^0;;
    fi;
    P := Filtered(List(Subspaces(GF(q)^7, 1), y -> Elements(y)[2]), x -> x*Q*x = 0*Z(q));;

    return Graph(Group(()), P, function(x,y) return x; end,
        function(x,y)
            return x <> y and x*Q*y = 0*Z(q) and y*Q*x = 0*Z(q) and
            [ GC(x,y,2,3), GC(x,y,6,5), GC(x,y,3,1), GC(x,y,7,6), GC(x,y,1,2), GC(x,y,5,7) ] =
            [ GC(x,y,4,5), GC(x,y,4,3), GC(x,y,4,6), GC(x,y,4,1), GC(x,y,4,7), GC(x,y,4,2) ];
        end, true);;
end;


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

ZeroCoef := function(p)
local i, L;
L:=p.coefficients;
for i in [1..Length(p.coefficients)] do
  if AbsFloat(ReComplex(ComplexAny(p.coefficients[i]))) < FloatString("1e-4") then
    L[i] := p.baseRing.zero;
  fi;
od;
return Polynomial(p.baseRing, L, p.valuation);
end;

# Recursive implementation of the long division for Laurent polynomials h(z) and g(z)
# There are deg(h)-deg(g)+2 different schemes for division
LaurentRemainder := function ( arg )

local a, b, q, q1, r1, q2, r2, Ls, Lt, z,
      deghigha, deglowa, deghighb, deglowb, dega, degb, coefa, coefb,  divs;

if IsList(arg[1]) then arg:=arg[1];fi;
a:=arg[1];
b:=arg[2];

#Print("check");
if not (IsPolynomial(a) and IsPolynomial(a)) then
  Error("<a> and <b> must be polynomials");
elif not a.baseRing.name = b.baseRing.name then
  Error("Both polynomials have to be over the same field");
elif not IsBound(PolynomialRing(a.baseRing).isEuclideanRing) then
  Error("Polymonials must be constructed over a field, not over a ring");
fi;

z:=Indeterminate(a.baseRing);
z.name:="z";
if Length(arg)=3 then q:=arg[3]; else q:=0*z^0; fi;

deglowa := a.valuation;
deglowb := b.valuation;
dega := Length(a.coefficients)-1;
degb := Length(b.coefficients)-1;
deghigha := deglowa + dega;
deghighb := deglowb + degb;

coefa := a.coefficients;
coefb := b.coefficients;

if dega<degb then return [[q,a]];fi;

  q1 := Polynomial(a.baseRing,[coefa[dega+1]/coefb[degb+1]],deghigha-deghighb);
  r1 := a - q1 * b;
  q1 := q1 + q;
#  Print(q1);
#  Print("\n");
#  Print(r1);
#Print("\n");

#  q2 := coefa[1]/coefb[1] * z^(deglowa-deglowb);
  q2 := Polynomial(a.baseRing,[coefa[1]/coefb[1]],deglowa-deglowb);
  r2 := a - q2 * b;
  q2 := q2 + q;
  Ls := [];
  for divs in [[r1,b,q1],[r2,b,q2]] do
     Lt := LaurentRemainder(divs);
     Add(Ls,Lt);
  od;
  Ls := Flat(Ls);
  Ls := List([1..Length(Ls)/2], i->[Ls[2*i-1],Ls[2*i]]);
  Ls := List(Collected(Ls), col->col[1]);
  if not IsList(Ls[1]) then return [Ls];
  else return Ls;
  fi;

end;

#
# Note:
# ! Because we now use double floats, the LiftingScheme generates more LS than
# possible because of finite precision. There will be a bunch of the same lifting
# schemes generated multiple times with coefficients different after 10th
# decimal or so. This requies fixing !
#

#F LiftingScheme( <poly1>, <poly2> )
#F   returns a list of Laurent polynomials that represent
#F   primal and dual lifting steps factorization of the polyphase
#F   matrix of polynomials <poly1> and <poly2>:
#F            P(z)= [[ <poly1_even>, <poly1_odd>],
#F                   [ <poly2_even>, <poly2_odd>]]
#F   In Discrete Wavelet Transform notation, <poly1> represents
#F   a low-pass filter impulse response, whereas <poly2> represents
#F   a high-pass one.
#F
#F   The output is in the following format:
#F   [ b, l1(z), l2(z), .... , ln(z), c1, c2]
#F
#F   b - a binary symbol that determines the type of the
#F       initial lifting step (0 - primal, 1 - dual)
#F   li(z) - polynomial representing i-th lifting step
#F   c1, c2 - scaling constants
#F
#F   Example:
#F
#F   P(z)=  [ c1, 0  ] * [ 1, l2(z)] * [ 1    , 0 ]
#F          [  0, c2 ]   [ 0, 1    ]   [ l1(z), 1 ]
#F          ----------   -----------   ------------
#F           scaling      primal l.s.   dual l.s. (b=1)
#F
#F   Note: Factorization is implemented in Laurent Polynomial
#F   ring over the base field inherited from <poly1>, <poly2>.
#F

LiftingScheme := function ( M )

local he, ho, ge, go, hen, hon, gen, gon, b, QR, z, Le, Lo, L, Lc, Ls, ve, vo, P, factor, scheme;

#Print("Recursion \n");
# Check if h(z) and g(z) in fact represent a perfect reconstruction
# filter bank -> determinant of the polyphase matrix should be
# a monomial
he := M[1][1];ho := M[1][2]; ge := M[2][1]; go := M[2][2];
  if not Length(ZeroCoef(Determinant([[he, ho],[ge, go]])).coefficients) = 1 then
     Error("h(z) and g(z) must satisfy the perfect reconstruction condition P(z)*P'(z)^(-1) = I where P and P' are analysis and synthesis polyphase matrices");
  fi;

  z:=Indeterminate(he.baseRing);
  z.name:="z";
# Factoring Algorithm
  b:=0;

  if LaurentDegree(he) >= LaurentDegree(ho) then b:=1; fi;

  if (ho=0*z^0 or ge=0*z^0) then
    L:=[];
    if ho=0*z^0 then Add(L,ZeroCoef(ge)*
         Polynomial(he.baseRing,[1/ ZeroCoef(go).coefficients[1]], -go.valuation));
    else Add(L,ho/he); fi;
    Add(L, he);
    Add(L, go);
    Add(L, b);
    return [Reversed(L)];
  fi;
  if (he=0*z^0 or go=0*z^0) then
    L:=[];
    if he=0*z^0 then Add(L,ZeroCoef(go)*
         Polynomial(he.baseRing,[1/ ZeroCoef(ge).coefficients[1]], -ge.valuation));
    else Add(L,he/ho); fi;
    Add(L, ho);
    Add(L, ge);
    Add(L, b-2);
    return [Reversed(L)];
  fi;
  L:=[];
    if b=0 then
      QR:=LaurentRemainder(ho,he);
      for factor in QR do
        hon := factor[2];
        hon := ZeroCoef(hon);
        gon := go - ge * factor[1];
        gon := ZeroCoef(gon);

        Lc:=LiftingScheme([[he,hon],[ge,gon]]);
        for scheme in Lc do Add(scheme,factor[1]); od;
        Append(L,Lc);
      od;

    else
      QR:=LaurentRemainder(he,ho);
      for factor in QR do
        hen := factor[2];
        hen := ZeroCoef(hen);
        gen := ge - go * factor[1];
        gen := ZeroCoef(gen);
        Lc:=LiftingScheme([[hen,ho],[gen,go]]);
        for scheme in Lc do Add(scheme,factor[1]); od;
        Append(L,Lc);
      od;

    fi;

return(L);

end;

Lifting := function(M)
local Lt, Ls, L, factor, p, normM, normDiff;

L:=LiftingScheme(M,[]);
Lt:=[];
Ls:=[];

for factor in L do
  Add(Ls, factor);
 if IsInt(factor) then  Add(Lt, Ls); Ls:=[];fi;
od;
return Lt;
end;

VerifyLiftingScheme:=function(P,L2)

local P, M, b, i, l,z,p, normM, normDiff;

  z:=Indeterminate(P[1].baseRing);
  z.name:="z";

#P:=[[P[1],P[2]],[P[3],P[4]]];
M:= [[1, 0],[0,1]];

L2:=Reversed(L2);
l:=Length(L2);
b:=L2[l];
for i in [1 .. l-3] do
 if b=-2 then
   M:= M * [[0*z^0,1*z^0 ], [1*z^0, L2[l-i-2]]]; b:=1;
 elif b=-1 then
   M:= M * [[L2[l-i-2],1*z^0 ], [1*z^0, 0*z^0]]; b:=0;
 elif b=0 then
   M:= M * [[1*z^0, L2[l-i-2]], [0*z^0, 1*z^0]]; b:=1;
 else
   M:= M * [[1*z^0, 0*z^0], [L2[l-i-2], 1*z^0]]; b:=0;
 fi;
od;
M:=[[L2[l-2], 0*z^0],[0*z^0, L2[l-1]]]*M;
#Print([[P[1],P[2]],[P[3],P[4]]]);
if Same(P[1][1].baseRing, Doubles) then
  normM:=Sum(M, l->Sum(l, p->(Sum(p.coefficients,i->i^2))^1/2))^1/2;
  normDiff:=Sum(M-P, l->Sum(l, p->(Sum(p.coefficients,i->i^2))^1/2))^1/2;
  Print("error: ",normDiff/normM,"\n");
  if (normDiff/normM > FloatString("1e-4")) then return false;
  else return true;
  fi;
else return[M,P,M=P];
fi;
end;

ArithmeticCostLS := function(L)
local step, mult, add, i;

mult:=0;
add:=0;
L:=Reversed(L);
for step in [1..Length(L)-3] do
  for i in L[step].coefficients do
     if not i = 0 then mult:=mult+1; add:=add+1;fi;
  od;
od;
mult:=mult+2;
return [add,mult,Length(L)-3];
end;

#F MatPoly := function(h,g)
#F   returns a matrix formed of two filters h(z) and g(z)
#F   also returns largest and the smallest degree of the
#F   coefficients in the matrix.
#F   Format: [<mat>, q, p]

MatPoly := function(h,g)

local hc, gc, hsmall, hlarge,
      gsmall, glarge, q, p, M;

    # Check the degrees of the filters
    hc := h.coefficients;
    gc := g.coefficients;
    hsmall := h.valuation;
    hlarge := Length(hc) + hsmall - 1;
    gsmall := g.valuation;
    glarge := Length(gc) + gsmall - 1;
    q := Minimum([hsmall,gsmall]);
    p := Maximum([hlarge,glarge]);

# Construct the 2 x l matrix of filter coefficients

    M :=
      [
       Concat(List([1..AbsInt(q-hsmall)],i->h.baseRing.zero),
               hc, List([1..p-hlarge],i->h.baseRing.zero)
             ),
       Concat(List([1..AbsInt(q-gsmall)],i->h.baseRing.zero),
               gc, List([1..p-glarge],i->h.baseRing.zero)
             )
      ];

    return ([M, hsmall, hlarge, gsmall, glarge]);
end;

Polyphase := function(p1,p2)

local  he, ho, ge, go, z, h, g;

if not (IsPolynomial(p1) and IsPolynomial(p1)) then
  Error("<p1> and <p2> must be polynomials");
elif not p1.baseRing.name = p2.baseRing.name then
  Error("Both polynomials have to be over the same field");
elif not IsBound(PolynomialRing(p1.baseRing).isEuclideanRing) then
  Error("Polymonials must be constructed over a field, not over a ring");
fi;

  z:=Indeterminate(p1.baseRing);
  z.name:="z";

        h := DownsampleTwo(ListPoly(p1));
        g := DownsampleTwo(ListPoly(p2));
        he := Polynomial(p1.baseRing, h[1][1], h[1][2]);
        ho := Polynomial(p1.baseRing, h[2][1], h[2][2]);
        ge := Polynomial(p1.baseRing, g[1][1], g[1][2]);
        go := Polynomial(p1.baseRing, g[2][1], g[2][2]);

# Find he(z) and ho(z)
#  Lo:=Sublist(p1.coefficients, Filtered([1..Length(p1.coefficients)],IsEvenInt));
#  Le:=Sublist(p1.coefficients, Filtered([1..Length(p1.coefficients)],IsOddInt));
#  if (p1.valuation mod 2 = 1) then L:=Le; Le:=Lo; Lo:=L;
#    ve := Int((p1.valuation + 1)/2); vo := ve;
#  else ve := Int(p1.valuation/2); vo := ve + 1;
#  fi;
#  he:=Polynomial(p1.baseRing, Le, ve);
#  ho:=Polynomial(p1.baseRing, Lo, vo);
#
# Find ge(z) and go(z)

#  Lo:=Sublist(p2.coefficients, Filtered([1..Length(p2.coefficients)],IsEvenInt));
#  Le:=Sublist(p2.coefficients, Filtered([1..Length(p2.coefficients)],IsOddInt));
#  if (p2.valuation mod 2 = 1) then L:=Le; Le:=Lo; Lo:=L;
#    ve := Int((p2.valuation + 1)/2); vo := ve;
#  else ve := Int(p2.valuation/2); vo := ve+1;
#  fi;
#  ge:=Polynomial(p2.baseRing, Le, ve);
#  go:=Polynomial(p2.baseRing, Lo, vo);

return [[he,ho],[ge,go]];
end;

# PolyPolyphaseMat:=function(M)
# Returns a list of 2 polynomials from a polyphase matrix

PolyPolyphaseMat:=function(M)

local he,ho,ge,go,h,g,z;

he:=M[1][1];
ho:=M[1][2];
ge:=M[2][1];
go:=M[2][2];
z:=Indeterminate(he.baseRing);
z.name:="z";

h:=Upsample(he)+z^(1)*Upsample(ho);
g:=Upsample(ge)+z^(1)*Upsample(go);

return([h,g]);
end;


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

#####################
# General Rule
#####################

PRF34_CT_Children := (N,k,DFTp,PRF3,PRFt) -> Map2(DivisorPairs(N),
    (m,n) -> When(IsEvenInt(n),
	[ DFTp(m, k), PRF3(n, k) ],
	[ DFTp(m, k), PRF3(n, k), PRFt(m, k) ])
);

PRF34_CT_Rule := (N,k,C,Conj,Tw) -> let(
    m:=Rows(C[1]), n:=Cols(C[2]), Nc:=Int((N+1)/2),
    nf:=Int(n/2), nc:=Int((n+1)/2), mf:=Int(m/2), mc:=Int((m+1)/2), j:=Ind(nf),

    SUM(
	ISum(j, RC(Scat(BH(Nc, N-1, m, j, n))) *
	        Conj * RC(C[1]) * Tw(j) *
		RC(Gath(H(nc*m, m, j, nc)))
	),
	When(IsEvenInt(n), [],
	     RC(Scat(H(Nc, mc, nf, n))) * C[3] * Gath(H(2*nc*m, m, 2*nf, 2*nc)))
    ) *
    Tensor(I(m), C[2]) *
    L(N,m)
);

IPRF34_CT_Rule := (N,k,C,Conj,Tw) -> let(
    m:=Rows(C[1]), n:=Rows(C[2]), Nc:=Int((N+1)/2),
    nf:=Int(n/2), nc:=Int((n+1)/2), mf:=Int(m/2), mc:=Int((m+1)/2), j:=Ind(nf),

    L(N,n) *
    Tensor(I(m), C[2]) *
    SUM(
	ISum(j,
	    RC(Scat(H(nc*m, m, j, nc))) *
	    Tw(j) *
	    RC(C[1]) *
	    Conj *
	    RC(Gath(BH(Nc, N-1, m, j, n)))
	),
	When(IsEvenInt(n), [],
	     Scat(H(2*nc*m, m, 2*nf, 2*nc)) * C[3] * RC(Gath(H(Nc, mc, nf, n))))
    )
);

#####################
# Special Cases
#####################

RulesFor(PRDFT4, rec(
    PRDFT4_Base1 := BaseRule(PRDFT4, [1, @]),
    PRDFT4_Base2 := rec(
	isApplicable := P -> P[1]=2,
	rule := (P, C) -> F(2) * Mat(1/2*MatSPL(PDHT4(2,P[2])))  # DHT4(2) is a diagonal
    ),
    PRDFT4_CT := rec(
	isApplicable := P -> not IsPrime(P[1]),
	allChildren  := P -> PRF34_CT_Children(P[1], P[2], DFT2, PRDFT3, PRDFT4),
	rule := (P,C) -> let(N:=P[1], k:=P[2], m:=Rows(C[1]),
	    PRF34_CT_Rule(N, k, C, Diag(BHD(m,-1,1)), j->RC(Diag(fPrecompute(Twid(N,m,k,1/2,1/2,j))))))),
    PRDFT4_Trig := rec(
	isApplicable := P -> P[1] > 2 and IsEvenInt(P[1]) and P[2]=1,
	allChildren := P -> [[ DCT4(P[1]/2), DST4(P[1]/2) ]],
	rule := (P, C) -> let(n:=P[1]/2,
	    L(2*n, n) * DirectSum(C[1], C[2]) * SymSplit4(n)))
));

RulesFor(IPRDFT4, rec(
    IPRDFT4_Base1 := BaseRule(IPRDFT4, [1, @]),
    IPRDFT4_Base2 := rec(
	isApplicable := P -> P[1]=2,
	rule := (P, C) -> Mat(1/2*MatSPL(PDHT4(2,P[2]))) * F(2)  # DHT4(2) is a diagonal
    ),
    IPRDFT4_CT := rec(
	isApplicable := P -> not IsPrime(P[1]),
	allChildren  := P -> PRF34_CT_Children(P[1], P[2], DFT3, IPRDFT2, IPRDFT4),
	rule := (P,C) -> let(N:=P[1], k:=P[2], m:=Rows(C[1]),
	    IPRF34_CT_Rule(N, k, C, Diag(BHD(m,-1,1)), j->RC(Diag(fPrecompute(Twid(N,m,k,1/2,1/2,j)))))))
));

RulesFor(PRDFT3, rec(
    PRDFT3_Base1 := BaseRule(PRDFT3, [1, @]),
    PRDFT3_Base2 := rec(
	isApplicable := P -> P[1]=2,
	rule := (P, C) -> Cond(
	    P[2] mod 4 = 1, I(2),
	    P[2] mod 4 = 3, Diag(1,-1),
	    Error("Bad second parameter for PRDFT3(n,k), gcd(n,k)=1 does not hold"))
    ),
    PRDFT3_CT := rec(
	isApplicable := P -> not IsPrime(P[1]),
	allChildren  := P -> PRF34_CT_Children(P[1], P[2], DFT1, PRDFT3, PRDFT3),
	rule := (P,C) -> let(N:=P[1], k:=P[2], m:=Rows(C[1]),
	    PRF34_CT_Rule(N, k, C, Diag(BHD(m,1,-1)), j->RC(Diag(fPrecompute(Twid(N,m,k,1/2,0,j))))))),
    PRDFT3_Trig := rec(
	isApplicable := P -> P[1] > 2 and IsEvenInt(P[1]) and P[2]=1,
	allChildren := P -> [[ DCT3(P[1]/2), DST3(P[1]/2) ]],
	rule := (P, C) -> let(n:=P[1]/2,
	    L(2*n, n) * DirectSum(C[1], C[2]) * SymSplit3(n))),

    PRDFT3_OddToPRDFT1 := rec(
	isApplicable := P -> IsOddInt(P[1]),
	allChildren := P -> [[ PRDFT(P[1], P[2]) ]],
	rule := (P, C) -> rperm_ev(P[1]) * C[1] * pdiag(P[1], P[2])
    )
));

RulesFor(IPRDFT2, rec(
    IPRDFT2_Base1 := BaseRule(IPRDFT2, [1, @]),
    IPRDFT2_Base2 := rec(
	isApplicable := P -> P[1]=2,
	rule := (P, C) -> Cond(
	    P[2] mod 4 = 1, Diag(2,-2),
	    P[2] mod 4 = 3, Diag(2,2),
	    Error("Bad second parameter for IPRDFT2(n,k), gcd(n,k)=1 does not hold"))
    ),
    IPRDFT2_CT := rec(
	isApplicable := P -> not IsPrime(P[1]),
	allChildren  := P -> PRF34_CT_Children(P[1], P[2], DFT1, IPRDFT2, IPRDFT2),
	rule := (P,C) -> let(N:=P[1], k:=P[2], m:=Rows(C[1]),
	    IPRF34_CT_Rule(N, k, C, Diag(BHD(m,1,-1)), j->RC(Diag(fPrecompute(Twid(N,m,k,1/2,0,j)))))))
));

RulesFor(PDHT4, rec(
    PDHT4_Base2 := BaseRule(PDHT4, [2, @]),
    PDHT4_CT := rec(
	isApplicable := P -> not IsPrime(P[1]),
	allChildren  := P -> PRF34_CT_Children(P[1], P[2], DFT2, PDHT3, PDHT4),
	rule := (P,C) -> let(N:=P[1], k:=P[2], m:=Rows(C[1]),
	    PRF34_CT_Rule(N, k, C, TopHalf(m, -J(2)),
		          j -> RCDiag(RCData(fPrecompute(Twid(N,m,-k,1/2,1/2,j))), -J(2))))),
    PDHT4_Trig := rec(
	isApplicable := P -> P[1] > 2 and IsEvenInt(P[1]) and P[2]=1,
	allChildren := P -> [[ DCT4(P[1]/2), DST4(P[1]/2) ]],
	rule := (P, C) -> let(n:=P[1]/2,
	    Tensor(I(n), F(2)) * L(2*n,n) * DirectSum(C[1], C[2]) * SymSplit4(n)))
));

RulesFor(PDHT3, rec(
    PDHT3_Base2 := rec(
	isApplicable := P -> P[1]=2,
	rule := (P, C) -> Cond(
	    P[2] mod 4 = 1, F(2),
	    P[2] mod 4 = 3, J(2)*F(2),
	    Error("Bad second parameter for PRDFT3(n,k), gcd(n,k)=1 does not hold"))
    ),

    PDHT3_CT := rec(
	isApplicable := P -> not IsPrime(P[1]),
	allChildren  := P -> PRF34_CT_Children(P[1], P[2], DFT1, PDHT3, PDHT3),
	rule := (P,C) -> let(N:=P[1], k:=P[2], m:=Rows(C[1]),
	    PRF34_CT_Rule(N, k, C, TopHalf(m, J(2)),
		          j -> RCDiag(RCData(fPrecompute(Twid(N,m,-k,1/2,0,j))), J(2))))),
    PDHT3_Trig := rec(
	isApplicable := P -> P[1] > 2 and IsEvenInt(P[1]) and P[2]=1,
	allChildren := P -> [[ DCT3(P[1]/2), DST3(P[1]/2) ]],
	rule := (P, C) -> let(n:=P[1]/2,
	    Tensor(I(n), F(2)) * L(2*n,n) * DirectSum(C[1], C[2]) * SymSplit3(n)))

));


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

RulesFor(DCT4, rec(

    #F DCT4_Base2: DCT4_2 = (1,2) * R_13/8
    #F
    DCT4_Base2 := rec(
	info             := "DCT4_2 -> R_13/8",
	forTransposition := false,
	isApplicable     := P -> P[1] = 2,
	rule := (P, C) -> J(2) * Rot(13/8)
    ),

    #F DCT4_Base3: (base case for size 3)
    #F
    #F   DCT4_2 = (2,3) * (F_2 dirsum 1) * (a dirsum M) * (F_2 dirsum 1) * (2,3)
    #F
    #F derived by hand starting with AREP's decomposition by mon-mon symmetry.
    #F
    DCT4_Base3 := rec (
	info             := "DCT4_3 -> F_2, M, F_2",
	forTransposition := false,
	isApplicable     := P -> P[1] = 3,
	rule := (P, C) ->
	    Perm((2,3), 3) *
	    DirectSum(F(2), I(1)) *
	    DirectSum(Diag(Sqrt(3/8)), Sqrt(1/2)*Mat([[1/2, 1], [1, -1]])) *
	    DirectSum(F(2), I(1)) *
	    Perm((2,3), 3)
    ),

    #F DCT4_DCT2: DCT4_n = sums * DCT2_n * diag
    #F
    #F   inverse - transpose of RuleDCT4_2
    #F
    DCT4_DCT2 := rec (
	info             := "DCT4_n --> DCT2'_n",
	isApplicable     := P -> P[1] > 2,
	allChildren := P -> [[ DCT2(P[1]) ]],
	rule := (P, C) ->
	    sums1(P[1]) *
	    C[1] *
	    Diag(List([0..P[1]-1], i -> 1/(2*CosPi((2*i+1)/(4*P[1])))))
    ),

    #F DCT4_DCT2t: 1985, DCT4_n = sums * DCT2_n * diag
    #F
    #F   Chan:
    #F     Direct Methods for computing discrete sinusoidal transforms
    #F     IEE Proceedings, Vol. 137, 1990, pp. 433--442
    #F
    # switched off since critical path too long (sums6)
    # also there seems to be one mult too much
    DCT4_DCT2t := rec (
	info             := "DCT4_n --> DCT2'_n",
	switch           := false,
	isApplicable     := P -> P[1] > 2,
	allChildren      := P -> [[ DCT2(P[1]) ]],
	rule := ( P, C ) ->
	    sums6(P[1]) *
	    C[1] *
	    Diag(List([0..P[1] - 1], i -> 2 * CosPi((2*i + 1)/(4*P[1]))))
    ),

    #F DCT4_DCT2andDST2: 1985
    #F
    #F   DCT4_n = blocks * perm * (DCT2_n/2 dirsum DST2_n/2) * rotations
    #F
    #F   Wang: (transposed)
    #F     On Computing the Discrete Fourier ans Cosine Transforms,
    #F     IEEE Trans. on Signal Proc., 1985, pp. 1341--1344
    #F
    DCT4_DCT2andDST2 := rec (
	info             := "DCT4_n --> DCT2'_n/2, DST2'_n/2",
	isApplicable     := P -> IsInt(P[1]) and P[1] > 2 and P[1] mod 2 = 0,
	allChildren := P -> [[ DCT2(P[1]/2), DST2(P[1]/2) ]],
	rule := (P, C) ->
	    DirectSum(I(1),
		      Tensor(I(P[1]/2-1), F(2)*J(2)),
		      I(1)) *
	    DirectSum(C[1], C[2]) ^ L(P[1], 2) *
	    DirectSum(List([0..P[1]/2-1], i -> J(2)*Rot(2-(2*P[1]-2*i-1)/(4*P[1])))) *
	    LIJ(P[1])

	  # LIJ(P[1]) *
	  # DirectSum(C[1], C[2] ^ J(P[1]/2)) *
	  # DirectSum(List([0..P[1]/2-1], i -> J(2)*Rot(2-(2*P[1]-2*i-1)/(4*P[1]))))
	  #    ^ LIJ(P[1])
    ),

    #F DCT4_DST4andDST2: 1988
    #F
    #F   DCT4_n = diag * sums * perm * (DST4_n/2 dirsum DST2_n/2) * sign *
    #F            (DFT_2 tensor I_n/2) * diag * perm
    #F
    #F   Rao/Yip:
    #F     The Decimation-in-Frequency Algorithms for a family of
    #F     Discrete Sine and Cosine Algorithms.
    #F     Circuits, Systems, and Signal Processing, 1988, pp. 3--19
    #F
    DCT4_DST4andDST2 := rec (
	info             := "DCT4_n --> DST4_n/2, DST2_n/2",
	switch           := false,
	isApplicable     := P -> IsInt(P[1]) and P[1] > 2 and P[1] mod 2 = 0,

	allChildren := P -> [[ DST4(P[1]/2), DST2(P[1]/2) ]],

	rule := (P, C) ->
	    Diag(List([0..P[1] - 1], i -> (-1)^i)) *
	    sums1(P[1]).transpose() *
	    L(P[1], P[1]/2) *
	    DirectSum(C[1], C[2] * (-1)) *
	    Tensor(F(2), I(P[1]/2)) *
	    Diag(Concat(List([1..P[1]/2], i -> 1/(2*SinPi((2*i - 1)/(4*P[1])))),
		        List([1..P[1]/2], i -> 1/(2*CosPi((2*i - 1)/(4*P[1])))))) *
	    IJ(P[1], P[1]/2)
    ),

    #F DCT4_Iterative: 1985, DCT4_n = iterative
    #F
    #F   Chen/Smith/Fralick:
    #F     A Fast Computational Algorithm for the Discrete Cosine Transform,
    #F     IEEE Trans. on Comm., 1977, pp. 1004--1009
    #F   corrected in:
    #F   Wang:
    #F     Reconsideration of --above--, IEEE Trans. on Comm., 1983, pp. 121--123
    #F   Wang:
    #F      Fast Algorithms for the Discrete W Transform and the
    #F      Discrete Fourier Transform.
    #F      IEEE Trans. on ASSP, 1984, pp. 803--814
    #F
    DCT4_Iterative := rec (
	info             := "DCT4_n iterative",
	isApplicable     := P -> P[1] > 2 and Is2Power(P[1]),
	rule := (P, C) ->
	    LIJ(P[1]) * L(P[1], 2) *
	    DirectSum(List([1..P[1]/2], i -> Rot(1/2-(4*i-3)/(4*P[1])) * J(2))) *

	    Compose(List([1..Log2Int(P[1])-1], j -> let(jj := 2^j,
		    Tensor(I(jj/2), F(2), I(P[1]/jj)) *
		    Tensor(I(jj/2),
			DirectSum(I(P[1]/jj), List([1..P[1]/jj/2],
			     i -> Rot(1/2-(4*i-3)/(2*P[1]/jj)) * J(2))))))) *
	    perm6(P[1])
    )
));


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

RulesFor(DFT, rec(
    DFT_CT_Inplace := rec(
	info          := "DFT(mn,k) -> DFT(m, k%m), DFT(n, k%n)",
	maxCodeletSize := 16,

	isApplicable := (self, P) >> P[1] > 2 and not IsPrime(P[1]),

	allChildren  := (self, P) >> Map2(
	    Filtered(DivisorPairs(P[1]), d -> d[1] <= self.maxCodeletSize),
	    (m,n) -> [
		DFT(m, P[2] mod m),
		DFT(n, P[2] mod n) ]),

	rule := (self,P,C) >> let(mn := P[1], m := Rows(C[1]), n := Rows(C[2]),
            di := fPrecompute(Tw1(mn, n, P[2])),

	    When(mn > self.maxCodeletSize, # why BB?
		Inplace(Tensor(C[1], I(n)) * Diag(di)),
		        Tensor(C[1], I(n)) * Diag(di)) *
	    Tensor(I(m), C[2]) *
	    L(mn, m))
    ),

    DFT_SplitRadix_Inplace := rec(
	info             := "DFT_n -> DFT_n/2, DFT_n/4, DFT_n/4",
	forTransposition := true,
	maxSize := 64,

	isApplicable := (self, P) >> let(N := P[1],
	    N >= 8 and N mod 4 = 0 and N <= self.maxSize),

	allChildren := P -> let(N := P[1], w := P[2],
	    [[ DFT(N/2, w), DFT(N/4, w) ]]),

	rule := (P, C) -> let(N := P[1], w := P[2],
	    Inplace(Tensor(F(2), I(N/2))) *
	    DirectSum(
		C[1],
		Inplace(BB(
			Tensor(Diag(1, E(4)^w) * F(2), I(N/4)) *
			Diag(Concat(List([0..N/4-1], i->E(N)^(w*i))),
			            List([0..N/4-1], i->E(N)^(3*w*i))))) *
	        Tensor(I(2), C[2])*L(N/2,2)
	    ) *
	    L(N, 2))
    ),

));


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

TrPRDFT1 := arg -> let(x:=ApplyFunc(PRDFT1, arg).transpose(), Chain(PrintLine(x, " ", x.dimensions), x));
TrPRDFT2 := arg -> ApplyFunc(PRDFT2, arg).transpose();
TrPRDFT3 := arg -> ApplyFunc(PRDFT3, arg).transpose();
TrPRDFT4 := arg -> ApplyFunc(PRDFT4, arg).transpose();

DFTSymmetries := rec(    #n-even, #n-odd
    DFT  := [
	[Real ,                 [CE0_R2Cpx(W_RFT, 1), [PRDFT1,   PRDFT1], 1]],
	[CE0_R2Cpx(W_URFTT, 1), [Real,                [TrPRDFT1, TrPRDFT1], 1]],
	[Even0, [Even0, [DCT1, DCT5], 1]],
	[Odd00, [Odd00, [DST1, DST5], E(4)]]  # *j
    ],

    DFT2 := [
	[Real ,                 [CO0_R2Cpx(W_RFT, -E(4)), [PRDFT2,   PRDFT2], 1]],
	[CE1_R2Cpx(W_URFTT, 1), [Real,                    [TrPRDFT3, TrPRDFT3], 1]],
	[Even1, [Odd0,   [DCT2, DCT6], 1]],
	[Odd1 , [Even00, [DST2, DST6], E(4)]]
    ],

    DFT3 := [
	[Real ,                    [CE1_R2Cpx(W_RFT, 1), [PRDFT3,   PRDFT3], 1]],
	[CO1_R2Cpx(W_URFTT, E(4)), [Real,                [TrPRDFT2, TrPRDFT2], 1]],
	[Real , [CE1_R2Cpx(W_RFT, 1), [PRDFT3, PRDFT3], 1]],
	[Odd0 , [Even1, [DCT3, DCT7], 1]],
	[Even00,[Odd1,  [DST3, DST7], E(4)]]
    ],

    DFT4 := [
	[Real ,                    [CO1_R2Cpx(W_RFT, -E(4)), [PRDFT4,   PRDFT4], 1]],
	[CO1_R2Cpx(W_URFTT, E(4)), [Real,                    [TrPRDFT4, TrPRDFT4], 1]],
	[Odd1 , [Odd1,  [DCT4, DCT8], 1]],
	[Even1, [Even1, [DST4, DST8], E(4)]]
    ]
);

_dftSym := function(nt, sym)
    local pos, entry, dftsym;
    if not IsBound(DFTSymmetries.(nt.name))
	then return false; fi;

    dftsym := DFTSymmetries.(nt.name);
    pos := PositionProperty(dftsym, x->x[1]=sym);
    if pos = false then
	return false; fi;

    entry := dftsym[pos][2];
    if IsEvenInt(Rows(nt)) then return [entry[1], entry[2][1], entry[3]];
    else                        return [entry[1], entry[2][2], entry[3]];
    fi;
end;

# let Q := JDFTp_Reconstruct(n), p = 1..4 (DFT type)
# Q is defined to be the matrix that satisfies
#    Q * DFTp(n) = DFTp(n) * J(n)
#    Q = J(n) ^ (DFTp(n)^-1)
#
#spiral> PrintMat( MatSPL(J(8))^(MatSPL(DFT(8))^-1) );

Class(JRecTwid1, DiagFunc, rec(
    def := n -> rec(size:=n),
    range := self >> TComplex,
    lambda := self >> let(n:=self.params[1], i:=Ind(n),
	Lambda(i, omega(n, -i)))
));

Class(JRecTwid3, DiagFunc, rec(
    def := n -> rec(size:=n),
    range := self >> TComplex,
    lambda := self >> let(n:=self.params[1], i:=Ind(n),
	Lambda(i, omega(2*n, (-2*i + n - 1))))
));

mk_InvDFT_Reconstruct := dft -> (let(n:=dft.params[1], Cond(
    ObjId(dft) = DFT1, DirectSum(I(1), J(n-1)),
    ObjId(dft) = DFT2, DirectSum(I(1), -J(n-1)),
    ObjId(dft) = DFT3, J(n),
    ObjId(dft) = DFT4, -J(n),
    Error("<dft> must be a non-terminal DFT1, DFT2, DFT3, or DFT4"))));

mk_JInvDFT_Reconstruct := dft -> (let(n:=dft.params[1], Cond(
    ObjId(dft) = DFT1, Diag(JRecTwid1(n)),
    ObjId(dft) = DFT2, I(n),
    ObjId(dft) = DFT3, Diag(JRecTwid3(n)),
    ObjId(dft) = DFT4, -I(n),
    Error("<dft> must be a non-terminal DFT1, DFT2, DFT3, or DFT4"))));

mk_JDFT_Reconstruct := dft -> (let(n:=dft.params[1], Cond(
    ObjId(dft) = DFT1, Diag(JRecTwid1(n)) * mk_InvDFT_Reconstruct(dft),
    ObjId(dft) = DFT2, mk_InvDFT_Reconstruct(dft),
    ObjId(dft) = DFT3, Diag(JRecTwid3(n)) * mk_InvDFT_Reconstruct(dft),
    ObjId(dft) = DFT4, -mk_InvDFT_Reconstruct(dft),
    Error("<dft> must be a non-terminal DFT1, DFT2, DFT3, or DFT4"))));

verify_JInvDFT_Reconstruct := dft -> let(T:=ObjId(dft), n:=dft.params[1], k:=dft.params[2],
    MatSPL(dft * J(n)) - MatSPL(mk_JInvDFT_Reconstruct(dft) * T(n, -k))
);
verify_JDFT_Reconstruct := dft -> let(T:=ObjId(dft), n:=dft.params[1], k:=dft.params[2],
    MatSPL(dft * J(n)) - MatSPL(mk_JDFT_Reconstruct(dft) * dft)
);

Class(RulesDFTSymmetry, RuleSet);
RewriteRules(RulesDFTSymmetry, rec(

     DFT1_upgrade := ARule(Compose, [@(1,DFT), [@(2,GathExtend), @, @(3).cond(e->e in [Even1, Odd1])]],
	 e -> let(n := Cols(@(1).val), [ Diag(Twid(n,n,-1,1/2,0,0)), DFT2(n), @(2).val])),

     DFT3_upgrade := ARule(Compose, [@(1,DFT3), [@(2,GathExtend), @, @(3).cond(e->e in [Even1, Odd1])]],
	 e -> let(n := Cols(@(1).val), [ Diag(Twid(n,n,-1,1/2,1/2,0)), DFT4(n), @(2).val])),

     DFT1_upgradeCE := ARule(Compose, [@(1,DFT), [@(2,GathExtend), @, @(3, [CE1_R2Cpx, CO1_R2Cpx])]],
	 e -> let(n := Cols(@(1).val), [ Diag(Twid(n,n,-1,1/2,0,0)), DFT2(n), @(2).val])),

     DFT3_upgradeCE := ARule(Compose, [@(1,DFT3), [@(2,GathExtend), @, @(3, [CE1_R2Cpx, CO1_R2Cpx])]],
	 e -> let(n := Cols(@(1).val), [ Diag(Twid(n,n,-1,1/2,1/2,0)), DFT4(n), @(2).val])),

     DFT_EO_Symmetry := ARule(Compose,
	 [ @(1,[DFT,DFT2,DFT3,DFT4]),
	   [ @(2, GathExtend), @, @(3).cond(e->_dftSym(@(1).val, e)<>false)] ],
	 e ->
	     let(sym := _dftSym(@(1).val, @(3).val),
		 out := sym[1],
		 transf := sym[2],
		 n := When(@(3).val.tsize = "cols", Cols(@(2).val), Rows(@(2).val)),
		 scale := sym[3],
		 [PushL(GathExtendU(Rows(@(1).val), out)), scale*transf(n)])),

     L_Real := ARule(Compose, [[L, @(1), @(2)], [@(3,GathExtend), @, Real]],
	 e -> let(N:=@(1).val, k:=@(2).val,
	     [ GathExtend(N, Real), L(N, k) ])),

     L_Conj0_R2Cpx := ARule(Compose, [[L, @(1), @(2)], [@(3,GathExtend), @, @(4, [CE0_R2Cpx, CO0_R2Cpx])]],
	 e -> let(N:=@(1).val, k:=@(2).val, m:=N/k, nn:=Cols(@(3).val)/2,
	          sym  := @(4).val,
	          sym1 := When(ObjId(sym)=CE0_R2Cpx, CE1_R2Cpx(sym.w, sym.j), CO1_R2Cpx(sym.w, sym.j)),
		  diag := When(ObjId(sym)=CE0_R2Cpx, Diag(BHD(m, 1, -1)), Diag(BHD(m, -1, 1))),
	     [ DirectSum(GathExtend(m, sym), GathExtend(N-m, sym1)),
	       DirectSum(I(Int(m+1+_even(m))), Tensor(I(Int((k-1)/2)), diag), I(_even(k)*(m+_odd(m)))),
	       RC(VStack(Gath(Refl(nn, N, Int((m+2)/2), L(N,k))),
		         Gath(Refl(nn, N, nn-Int((m+2)/2), fCompose(L(N,k), fAdd(N, N-m, m)))))) ])),

     L_Conj1_R2Cpx := ARule(Compose, [[L, @(1), @(2)], [@(3,GathExtend), @, @(4, [CE1_R2Cpx, CO1_R2Cpx])]],
	 e -> let(N:=@(1).val, k:=@(2).val, m:=N/k, nn:=Cols(@(3).val)/2,
	          sym  := @(4).val,
		  diag := When(sym=CE1_R2Cpx, Diag(BHD(m, 1, -1)), Diag(BHD(m, -1, 1))),
	     [ GathExtend(N, sym),
	       DirectSum(Tensor(I(Int(k/2)), diag), When(IsOddInt(k), I(m+_odd(m)), [])),
	       RC(Gath(Refl(nn, N-1, nn, L(N,k)))) ])),

     L_Even0 := ARule(Compose, [[L, @(1), @(2)], [@(3,GathExtend), @, Even0]],
	 e -> let(N:=@(1).val, k:=@(2).val, m:=N/k, nn:=Cols(@(3).val),
	     [ DirectSum(GathExtend(m, Even0), GathExtend(N-m, Even1)),
	       VStack(Gath(Refl(nn, N, Int((m+2)/2), L(N,k))),
		      Gath(Refl(nn, N, nn-Int((m+2)/2), fCompose(L(N,k), fAdd(N, N-m, m))))) ])),

     L_Even00 := ARule(Compose, [[L, @(1), @(2)], [@(3,GathExtend), @, Even00]],
	 e -> let(N:=@(1).val, k:=@(2).val, m:=N/k, nn:=Cols(@(3).val),
	     [ DirectSum(GathExtend(m, Even00), GathExtend(N-m, Even1)),
	       VStack(Gath(Refl(nn, N-2, Int(m/2), fCompose(fAdd(N,N,-1), L(N,k), fAdd(N, N-1, 1)))),
		      Gath(Refl(nn, N-2, nn-Int(m/2), fCompose(fAdd(N,N,-1), L(N,k), fAdd(N, N-m, m))))) ])),

     L_Odd0 := ARule(Compose, [[L, @(1), @(2)], [@(3,GathExtend), @, Odd0]],
	 e -> let(N:=@(1).val, k:=@(2).val, m:=N/k, nn:=Cols(@(3).val),
	     [ DirectSum(GathExtend(m, Odd0),  GathExtend(m*(k-1), Odd1)),
	       DirectSum(I(Int((m+1)/2)), Tensor(I(Int((k-1)/2)), Diag(BHN(m))), When(IsEvenInt(k), I(Int(m/2)), [])),
	       VStack(Gath(Refl(nn, N, Int((m+1)/2), L(N,k))),
		      Gath(Refl(nn, N, nn-Int((m+1)/2), fCompose(L(N,k), fAdd(N, N-m, m))))) ])),

     L_Odd00 := ARule(Compose, [[L, @(1), @(2)], [@(3,GathExtend), @, Odd00]],
	 e -> let(N:=@(1).val, k:=@(2).val, m:=N/k, nn:=Cols(@(3).val),
	     [ DirectSum(GathExtend(m, Odd00), GathExtend(m*(k-1), Odd1)),
	       DirectSum(I(Int((m-1)/2)), Tensor(I(Int((k-1)/2)), Diag(BHN(m))), When(IsEvenInt(k), I(Int(m/2)), [])),
	       VStack(Gath(Refl(nn, N-2, Int((m-1)/2), fCompose(fAdd(N,N,-1), L(N,k), fAdd(N, N-1, 1)))),
		      Gath(Refl(nn, N-2, nn-Int((m-1)/2), fCompose(fAdd(N,N,-1), L(N,k), fAdd(N, N-m, m))))) ])),

     L_Even1 := ARule(Compose, [[L, @(1), @(2)], [@(3,GathExtend), @, Even1]],
	 e -> let(N:=@(1).val, k:=@(2).val, m:=N/k, nn:=Cols(@(3).val),
	     [ GathExtend(N, Even1),
	       Gath(Refl(nn, N-1, nn, L(N,k))) ])),

     L_Odd1 := ARule(Compose, [[L, @(1), @(2)], [@(3,GathExtend), @, Odd1]],
	 e -> let(N:=@(1).val, k:=@(2).val, m:=N/k, nn:=Cols(@(3).val),
	     [ GathExtend(N, Odd1),
	       DirectSum(Tensor(I(Int(k/2)), Diag(BHN(m))), When(IsOddInt(k), I(Int(m/2)), [])),
	       Gath(Refl(nn, N-1, nn, L(N,k))) ])),

     CRT_Even1 := ARule(Compose, [@(1, CRT), [@(2,GathExtend), @, Even1]],
	 e -> let(N:=Rows(@(2).val),  nn:=Cols(@(2).val),
	     [ GathExtend(N, Even1),
	       Gath(Refl(nn, N-1, nn, @(1).val)) ])),

     Tensor_Dirsum_split := ARule(Compose,
	 [[Tensor, [I, @(1)], @(2)], [DirectSum, @(3).cond(e->Rows(e)=Cols(@(2).val)), @(4)]],
	 e -> [ DirectSum(@(2).val * @(3).val, Tensor(I(@(1).val-1), @(2).val) * @(4).val) ]),

     IxDFT_EO1 := ARule(Compose,
	 [[Tensor, [I, @(1)], [@(2,[DFT,DFT2,DFT3,DFT4]), @, 1, ...]], [@(3,GathExtend), @, @(4).cond(e->e in [Even1, Odd1])]],
	 e -> let(k:=@(1).val, n:=Cols(@(2).val), transf:=@(2).val, sign := When(@(4).val=Odd1, -1, 1),
	        When(k mod 2 = 0,
	         [ # Below is actually a scaled type 1 extension! exploit this for final rewriting phase
                   PushL(DirectSum(I(n*k/2), Tensor(I(k/2), mk_JDFT_Reconstruct(transf)*J(n))) *
                         @(3).val) *
		   Tensor(I(k/2), transf) ],

                   # again, a scaled type 1 extension!
		 [ PushL(VStack(I(n*(k+1)/2),
			        Tensor(J((k-1)/2), sign * mk_JDFT_Reconstruct(transf))
				   * Gath(fAdd(n*(k+1)/2, n*(k-1)/2, 0)))),
		   DirectSum(Tensor(I((k-1)/2), 1/2*transf),
			     transf * GathExtend(n, @(4).val))]))),

 #     IxDFT_EO1 := ARule(Compose,
# 	 [[Tensor, [I, @(1)], [@(2,[DFT,DFT2,DFT3,DFT4]), @, 1, ...]], [GathExtend, @(3), @(4).cond(e->e in [Even1, Odd1])]],
# 	 e -> let(k:=@(1).val, n:=Cols(@(2).val), transf:=@(2).val, sign := When(@(4).val=Odd1, -1, 1),
# 	        When(k mod 2 = 0,
# 	         [ # Below is actually a scaled type 1 extension! exploit this for final rewriting phase
#                    PushL(VStack(I(n*k/2), Tensor(J(k/2), sign * mk_JDFT_Reconstruct(transf)))),
# 		   Tensor(I(k/2), 1/2*transf) ],

#                    # again, a scaled type 1 extension!
# 		 [ PushL(VStack(I(n*(k+1)/2),
# 			        Tensor(J((k-1)/2), sign * mk_JDFT_Reconstruct(transf))
# 				   * Gath(fAdd(n*(k+1)/2, n*(k-1)/2, 0)))),
# 		   DirectSum(Tensor(I((k-1)/2), 1/2*transf),
# 			     transf * GathExtend(n, @(4).val))]))),

     IxDFT_CEO1_RFTT_DHT := ARule(Compose,
	 [[Tensor, [I, @(1)], @(2,[DFT,DFT2,DFT3,DFT4])],
	  [GathExtend, @(3), @(4,[CE1_R2Cpx, CO1_R2Cpx],e->e.w in [W_RFTT, W_URFTT, W_DHT, W_DHT])]],

	 e -> let(k:=@(1).val, n:=Cols(@(2).val),
	          transf := @(2).val, sign := When(ObjId(@(4).val)=CO1_R2Cpx, -1, 1),
	          newtransf := RC(ObjId(transf)(transf.params[1], -transf.params[2])),
		  winv := @(4).val.w^-1,
		  pack1 := Mat([winv[1]]),
		  pack2 := Mat([winv[2]]),

	        When(k mod 2 = 0,
	         [ PushL(VStack(Tensor(I(n*k/2), pack1),
			        Tensor(J(k/2), sign * Tensor(I(n), pack2)*
				               RC(mk_JInvDFT_Reconstruct(transf))))),
		   Tensor(I(k/2), newtransf) ],

		 [ PushL(VStack(DirectSum(Tensor(I(n*(k-1)/2), pack1), I(n)),
			        Tensor(J((k-1)/2), sign * Tensor(I(n), pack2) *
				                   RC(mk_JInvDFT_Reconstruct(transf))) * Gath(fAdd(n*k, n*(k-1), 0)))),
		   DirectSum(Tensor(I((k-1)/2), newtransf),
			     transf * GathExtend(n, @(4).val))]))),

     IxDFT_Real := ARule(Compose,
	 [[Tensor, [I, @(1)], [@(2,[DFT,DFT2,DFT3,DFT4]), @, 1, ...]], [GathExtend, @(3), Real]],
	 e -> [ Tensor(I(@(1).val), @(2).val * GathExtend(Cols(@(2).val), Real)) ]),

     DFTxI_Ext := ARule(Compose,
	 [[@(1,Tensor), [@(2,[DFT,DFT2,DFT3,DFT4]), @, 1, ...], I], @(4, GathExtend)],
	 e -> [ @(1).val.parallelForm() * @(4).val]),

     Tensor_J1 := Rule([Tensor, [J, 1], @(1)], e -> @(1).val),
     Tensor_I1 := Rule([Tensor, [I, 1], @(1)], e -> @(1).val),
     Tensor_I0 := Rule([Tensor, ..., [I, 0], ...], e -> I(0)),
     Compose_I := ARule(Compose, [I], e -> []),
     DirectSum_I0 := ARule(DirectSum, [[I, 0]], e -> []),
     DirectSum_Assoc := ARule(DirectSum, [@(1,DirectSum)], e -> [@(1).val.children()]),
     DirectSum_Single := Rule([DirectSum, @(1)], e -> @(1).val),
     Compose_Assoc := ARule(Compose, [@(1,Compose)], e -> [@(1).val.children()]),
     Compose_Single := Rule([Compose, @(1)], e -> @(1).val),
     J_J := ARule(Compose, [@(1,J), @(2,J)], e -> [ I(@(1).val.params[1]) ]),

     # ===============
     # Diags
     # ================
     Diag_Diag := ARule(Compose, [[Diag, @(1)], [Diag, @(2)]], e ->
         [ Diag(diagMul(@(1).val, @(2).val)) ]),

     Diag_L_Diag := ARule(Compose, [[Diag, @(1)], @(2, L), [Diag, @(3)]], e ->
         [ Diag(diagMul(@(1).val, fCompose(@(3).val, @(2).val))) * @(2).val ]),

     Tensor_Diag := Rule([Tensor, [I, @(1)], [Diag, @(2)]],
         e -> Diag(diagTensor(fConst(@(1).val, 1), @(2).val))),
     DirectSum_Diag := Rule([DirectSum, [I, @(1)], [Diag, @(2)]],
         e -> Diag(diagDirsum(fConst(@(1).val, 1), @(2).val))),

     E1_Diag_E1 := ARule(Compose, [[@(1,GathExtend,e->e.transposed), @, Odd1],
                                   [Diag, @(2)],
                                   [@(1,GathExtend,e->not e.transposed), @, Odd1]],
      e -> let(n:=@(2).val.domain(), f := @(2).val,
           [Diag(diagMul(fConst(n/2, 1/4),
                       diagAdd(fCompose(f, fTensor(fBase(2, 0), fId(n/2))),
                               fCompose(f, fTensor(fBase(2, 1), J(n/2))))))])),

     Scale_Scale := Rule([Scale, @(1), [Scale, @(2), @(3)]], e->Scale(@(1).val * @(2).val, @(3))),
     Scale_1 := Rule([Scale, @(1).cond(e->e=1), @(2)], e->@(2).val),

     # =============
     # PushL/PushR
     # =============
     PushL_within_PushL := Rule(@@(1,PushL, (e,cx)->IsBound(cx.PushL) and cx.PushL<>[]), e -> e.child(1)),

     Compose_PushL_PushL := ARule(Compose, [[PushL, @(1)], [PushL, @(2)]], e -> [ PushL(@(1).val * @(2).val) ]),
     Compose_PushR_PushL := ARule(Compose, [[PushR, @(1)], [PushL, @(2)]], e -> [ PushR(@(1).val * @(2).val) ]),
     XXX_PushL := ARule(Compose, [@(1, [Diag, L]), [PushL, @(2)]], e -> [PushL(@(1).val * @(2).val)]),

     Tensor_PushL := Rule([Tensor, @(1, I), [Compose, @(2, PushL), @(3)]],
	 e -> PushL(Tensor(@(1).val, @(2).val.child(1))) * Tensor(@(1).val, @(3).val)),

     DirectSum_PushL := Rule(@(1, DirectSum,
	     e -> ForAny(e.children(),
		 c -> ObjId(c)=PushL or (ObjId(c)=Compose and ObjId(c.child(1)) = PushL))),

	 e -> let(ch := @(1).val.children(),
	          split := List(ch, e -> Cond(ObjId(e) = PushL,
			                          [e, I(Cols(e))],
			                      ObjId(e) = Compose and ObjId(e.child(1))=PushL,
					          [e.child(1).child(1), Drop(e.children(), 1)],
					      [I(Rows(e)), e])),
		  PushL(DirectSum(List(split, x->x[1]))) * DirectSum(List(split, x->x[2]))))
));

RewriteRules(RulesDFTSymmetry, rec(
     BRDFT3_ExtendOdd0 := ARule(Compose, [[BRDFT3, @(1).cond(e->IsEvenInt(e)), 1/4], [GathExtend, @, Odd0]],
	 e -> let(k:=@(1).val,
	     [ GathExtend(k,Upsample0),SkewDTT(DCT3(k/2),1/2)])),

     Odd1_split := ARule(Compose, [[Tensor, [I,@(1)],@(2)],[GathExtend, @, Odd1]],
	 e -> let(n:=@(1).val,A:=@(2).val,k:=When(IsEvenInt(n),n/2, (n-1)/2),When(IsEvenInt(n),
	     [VStack(Tensor(I(k),A)*(1/2),Tensor(J(k),A*J(Cols(A))*(-1/2)))],
	     [VStack(DirectSum(Tensor(I(k),A)*(1/2),A*GathExtend(Cols(A),Odd1)),Tensor(J(k),A*J(Cols(A))*(-1/2)))]))),

     ReduceUpsample0_RC := ARule(Compose, [[ScatReduce, @(1), Upsample0],[RC, @(2)]],
	 e -> [@(2).val*ScatReduce(@(1).val,Upsample0)]),

     Push_ScatReduceWithinSum :=  ARule(Compose, [[ScatReduce, @, Upsample0],[@(1,IterDirectSum).cond(e->IsEvenInt(e.domain)),@(2)]],
	 e -> [IterDirectSum(@(1).val.var,@(1).val.domain,ScatReduce(Rows(@(2).val),Upsample0)*@(2).val)]
),

     Cut_SkewPRDFT := ARule(Compose, [[ScatReduce, @, Upsample0],[BSkewPRDFT,@(1),@(2)]],
	 e ->  let(n:=@(1).val,a:=@(2).val,f:=2*cospi(2*a),
	        [SkewDTT(DCT3(n/2),2*a)*When(IsEvenInt(n/2),
		     HStack(I(n/2),DirectSum(Mat([[f/2]]),Tensor(I(((n/2)-2)/2),Mat([[f,-1],[-1,f]])),Mat([[f-1]]))^M((n)/2,n/4)),
		     HStack(I(n/2),DirectSum(Mat([[f/2]]),Conjugate(Tensor(I((n/2-1)/2),Mat([[f,-1],[-1,f]])),M(n/2-1,(n/2-1)/2)))))])),

     SplitIterDirectSum := Rule([@(1,IterDirectSum), [Compose,@(2,SkewDTT),@(3,HStack)]],
	 e->let(i:=@(1).val.var,IterDirectSum(@(1).val.var,@(1).val.domain,@(2).val)*IterDirectSum(@(1).val.var,@(1).val.domain,@(3).val))),

     BRDFT3_ExtendOdd1 := ARule(Compose, [[BRDFT3, @(1).cond(e->IsEvenInt(e)), 1/4], [GathExtend, @, Odd1]],
         e -> let(k:=@(1).val,i:=Ind(),
	        [IterDirectSum(i,k/2,Mat([[1/2+cospi((2*i+1)/k)],[-1/2]]))*PolyDTT(DCT4(k/2))])),

     BRDFT3_J := ARule(Compose, [[BRDFT3, @(1).cond(e->IsEvenInt(e)), 1/4], [J, @]],
         e -> let(k:=@(1).val,i:=Ind(),
                [IterDirectSum(i,k/2,Mat([[-2*cospi((2*i+1)/k),-1-2*cospi((2*i+1)/(k/2))],[1,-2*cospi((2*((k/2)-i)-1)/k)]]))*BRDFT3(k)]))
));

#z := L(15,3) * GathExtend(15, Odd0);; zz := RulesDFTSymmetry(z);; PrintMat(MatSPL(z)-MatSPL(zz));
#z := L(16,4) * GathExtend(16, Odd0);; zz := RulesDFTSymmetry(z);; PrintMat(MatSPL(z)-MatSPL(zz));

#z := L(15,3) * GathExtend(15, Even00);; zz := RulesDFTSymmetry(z);; PrintMat(MatSPL(z)-MatSPL(zz));
#z := L(16,4) * GathExtend(16, Odd1);; zz := RulesDFTSymmetry(z);; PrintMat(MatSPL(z)-MatSPL(zz));

#RulesDFTSymmetry(Tensor(I(3), DFT(5))*L(15,3)*GathExtend(15, Even0));
#RulesDFTSymmetry(Tensor(I(2), DFT3(8))*L(16,2)*GathExtend(16, Even0));

dft1 := (N, k) -> Tensor(DFT1(k), I(N/k)) * Diag(Tw1(N, N/k, 1)) * Tensor(I(k), DFT1(N/k)) * L(N, k);
dft2 := (N, k) -> Tensor(DFT2(k), I(N/k)) * Diag(Tw2(N, N/k, 1)) * Tensor(I(k), DFT1(N/k)) * L(N, k);
dft3 := (N, k) -> Tensor(DFT1(k), I(N/k)) * Diag(Tw3(N, N/k, 1)) * Tensor(I(k), DFT3(N/k)) * L(N, k);
dft4 := (N, k) -> Tensor(DFT2(k), I(N/k)) * Diag(Tw4(N, N/k, 1)) * Tensor(I(k), DFT3(N/k)) * L(N, k);

pdft1 := (N, k, lsym, rsym) -> GathExtend(N, lsym).transpose() * dft1(N, k) * GathExtend(N, rsym);
pdft2 := (N, k, lsym, rsym) -> GathExtend(N, lsym).transpose() * dft2(N, k) * GathExtend(N, rsym);
pdft3 := (N, k, lsym, rsym) -> GathExtend(N, lsym).transpose() * dft3(N, k) * GathExtend(N, rsym);
pdft4 := (N, k, lsym, rsym) -> GathExtend(N, lsym).transpose() * dft4(N, k) * GathExtend(N, rsym);

# DCT6(8)
f := L(15, 3) * Tensor(I(5), DFT2(3, 1)) * L(15, 5) *
     Diag(Tw2(15, 5, 1)) *
     Tensor(I(3), DFT(5, 1)) * L(15, 3);
ff := GathExtend(Rows(f), Odd0).transpose() * f * GathExtend(Cols(f), Even1);

# f := L(16,4) * Tensor(I(4), DFT(4)) * L(16,4) * Diag(Tw1(16,4,1)) * Tensor(I(4), DFT(4)) * L(16,4);
# ff := GathExtend(Rows(f), Odd00).transpose() * f * GathExtend(Cols(f), Odd00);

# DCT2/DCT6
# f := L(16,4) * Tensor(I(4), DFT2(4)) * L(16,4) * Diag(Tw2(16,4)) * Tensor(I(4), DFT(4)) * L(16,4);
#ff := GathExtend(Rows(f), Odd0).transpose() * f * GathExtend(Cols(f), Even1);

# f4 := L(16,4) * Tensor(I(4), DFT2(4)) * L(16,4) * Diag(Tw4(16,4)) * Tensor(I(4), DFT3(4)) * L(16,4);
# ff := GathExtend(Rows(f), Odd1).transpose() * f4 * GathExtend(Cols(f), Odd1);

#  fo := L(21,3) * Tensor(I(7), DFT2(3)) * L(21,7) * Diag(Tw4(21,7)) * Tensor(I(3), DFT3(7)) * L(21,3);
# ffo := GathExtend(Rows(fo), Odd1).transpose() * fo * GathExtend(Cols(fo), Odd1);

# fr1 := GathExtend(16, CE0_R2Cpx(W_RFT, 1).invertW()).transpose() * f * GathExtend(16, Real);

 fr2 := GathExtend(21, CE0_R2Cpx(W_RFT, 1).invertW()).transpose() *
        L(21,3) * Tensor(I(7), DFT(3)) * L(21,7) * Diag(Tw1(21,7,1)) * Tensor(I(3), DFT(7)) * L(21,3) *
	GathExtend(21, Real);

 fr4 := GathExtend(21, CO1_R2Cpx(W_RFT, -E(4)).invertW()).transpose() *
        L(21,3) * Tensor(I(7), DFT2(3)) * L(21,7) * Diag(Tw4(21,7,1)) * Tensor(I(3), DFT3(7)) * L(21,3) *
	GathExtend(21, Real);

# fr4 := GathExtend(16, CO1_R2Cpx).transpose() * L(16,4) * Tensor(I(4), DFT2(4)) * L(16,4) * Diag(Tw4(16,4)) * Tensor(I(4), DFT3(4)) * L(16,4) * GathExtend(16, Real);

#p  := Mat(1/2*[[1,  E(4)]]);
#pp := Mat(1/2*[[1, -E(4)]]);

#them := MatSPL(DFT(4) * Tensor(I(4), 2*pp));;
#me   := MatSPL(Tensor(I(4), 2*pp) * RC(DFT(4,1)));;

# y = DFT x* = (DFT* x)* ?
#
# C IxP = IxP' RC(C)
# IxP' = C IxP RC(C)^-1

# C IxP =IxP' C Ix(1,j)

dftproj := function(f)
    f := RulesDFTSymmetry(f);
    f := f.transpose();
    f := RulesDFTSymmetry(f);
    f := f.transpose();
    return f;
end;


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

#############################
# General Case Cooley-Tukey
#############################

# R1 -> (R1, C1, R3) (R1)
# R2 -> (R2, C2, R4) (R1)
PRF12_CT_Children := (N,k,PRFt,DFTt,PRFtp,PRF1) -> Map2(DivisorPairs(N),
    (m,n) -> When(IsEvenInt(n),
	[ PRFt(m,k), DFTt(m,k), PRF1(n,k), PRFtp(m,k) ],
	[ PRFt(m,k), DFTt(m,k), PRF1(n,k) ] )
);

PRF12_CT_Rule := (N,k,C,Conj,Tw) -> let(m:=Cols(C[1]), n:=Cols(C[3]), Nf:=Int(N/2),
    nf:=Int(n/2), nc:=Int((n+1)/2), mf:=Int(m/2), mc:=Int((m+1)/2), j:=Ind(nc-1),

    SUM(
	RC(Scat(H(Nf+1,mf+1,0,n))) * C[1] * Gath(H(2*(nf+1)*m, m, 0, 2*(nf+1))),

	When(nc=1, [],
	ISum(j,
	     RC(Scat(BH(Nf+1,N,m,j+1,n))) *
	     Conj * RC(C[2]) * Tw(j) *
	     RC(Gath(H((nf+1)*m, m, j+1, nf+1))))),

	When(IsOddInt(n), [],
	RC(Scat(H(Nf+1,mc,nf,n))) * C[4] * Gath(H(2*(nf+1)*m, m, 2*nf, 2*(nf+1))))
    ) *
    Tensor(I(m), C[3]) * L(N,m)
);

IPRF12_CT_Rule := (N,k,C,Conj,Tw) -> let(m:=Rows(C[1]), n:=Rows(C[3]), Nf:=Int(N/2),
    nf:=Int(n/2), nc:=Int((n+1)/2), mf:=Int(m/2), mc:=Int((m+1)/2), j:=Ind(nc-1),

    L(N,n) * Tensor(I(m), C[3]) *
    SUM(
	Scat(H(2*(nf+1)*m, m, 0, 2*(nf+1))) * C[1] * RC(Gath(H(Nf+1,mf+1,0,n))),

	When(nc=1, [],
	ISum(j,
	     RC(Scat(H((nf+1)*m, m, j+1, nf+1))) *
	     Tw(j) *
	     RC(C[2]) *
	     Conj *
	     RC(Gath(BH(Nf+1,N,m,j+1,n))))),

	When(IsOddInt(n), [],
	Scat(H(2*(nf+1)*m, m, 2*nf, 2*(nf+1))) * C[4] * RC(Gath(H(Nf+1,mc,nf,n))))
    )
  );

####################
# Prime Factor
####################

PRF12_PF_Children := (N,k,PRFt,DFTt,PRF1) -> Map2(DivisorPairsRP(N),
    (m,n) -> When(IsEvenInt(n),
	[ PRFt(m,k*n), DFTt(m,k*n), PRF1(n,k*m), PRF1(m,k*n) ],
	[ PRFt(m,k*n), DFTt(m,k*n), PRF1(n,k*m) ] )
);

 RC.toAMat := self >> AMatMat(RCMatCyc( MatSPL(self.child(1)) ));

PRF12_PF_Rule := (N,k,C) -> let(m:=Cols(C[1]), n:=Cols(C[3]), Nf:=Int(N/2), Nc:=Int((N+1)/2),
    nf:=Int(n/2), nc:=Int((n+1)/2), mf:=Int(m/2), mc:=Int((m+1)/2), j:=Ind(nc-1),
    alpha := (1/n) mod m,
    beta := (1/m) mod n,
    jj:=Ind(m), q := Ind(2*m),

    SUM(
	RC(Scat(H(Nf+1,mf+1,0,n))) * C[1] * Gath(H(2*(nf+1)*m, m, 0, 2*(nf+1))),

	When(nc=1, [],
	ISum(j,
	     RC(Scat(Refl(Nf+1, N, m, HZ(N, m, (j+1)*m, n)))) *
	     # conjugate those values which indices will be reflected by the scatter Refl
	     # NOTE: Unless 1.0 is used below, vector code will break due to TVect(TInt, ...)
	     Diag(Lambda(q, cond(neq(imod(q, 2),0), cond(leq(imod(n*idiv(q, 2) + (j+1)*m, N), Nc-1), 1.0, -1.0), 1.0))) *
	     RC(C[2]) *
	     RC(Gath(H((nf+1)*m, m, j+1, nf+1))))),

	When(IsOddInt(n), [],
	     let(inds := HZ(N, mc, nc*m, n).tolist(),
		 conj := ConcatList(inds{[1..mc]}, i -> When(i.v > Nf, [1.0,-1.0], [1.0,1.0])),

		 RC(Scat(Refl(Nf+1, N, mc, HZ(N, mc, nc*m, n)))) *
		 #RC(Scat(H(Nf+1, mc, nf, n))) *
		 Diag(conj) * C[4] *
		 Gath(H(2*(nf+1)*m, m, 2*nf, 2*(nf+1)))
	     ))
    ) *
    Tensor(I(m), C[3]) * CRT(m,n,1,1)
);

# s := PRF12_PF_Rule(6,1,PRF12_PF_Children(6,1,PRDFT1, DFT1, PRDFT1)[1]);
# Print(s);
# me := MatSPL(s);
# them := MatSPL(PRDFT(6));

###########
# RDFT    #
###########

Declare(PRDFT1_PF);

RulesFor(PRDFT1, rec(
    PRDFT1_Base1 := BaseRule(PRDFT1, [1, @]),
    PRDFT1_Base2 := BaseRule(PRDFT1, [2, @]),

    #F PRDFT1_CT: projection of DFT_CT
    PRDFT1_CT := rec(
	forcePrimeFactor := false,
	isApplicable := (self, P) >> not IsPrime(P[1]) and
	    When(self.forcePrimeFactor, not PRDFT1_PF.isApplicable(P), true),

	allChildren  := P -> PRF12_CT_Children(P[1], P[2], PRDFT1, DFT1, PRDFT3, PRDFT1),
	rule := (P,C) -> let(N:=P[1], k:=P[2], m:=Cols(C[1]),
	    PRF12_CT_Rule(N, k, C, Diag(BHD(m,1,-1)), j->RC(Diag(fPrecompute(Twid(N,m,k,0,0,j+1))))))),

    #F PRDFT1_Complex: computes PRDFT using half of the outputs of complex DFT
    #F                this rule can be successfully pruned by the compiler, and thus
    #F                works for all sizes, including primes
    PRDFT1_Complex := rec(
	switch           := false,
	isApplicable     := P -> not Is2Power(P[1]),
	allChildren      := P -> [[ DFT(P[1], P[2]) ]],
	forTransposition := false,
	rule             := (P,C) -> let(n := P[1], nn:=Int(n/2)+1,
	    Buf(Gath(H(2*n,2*nn, 0, 1))) *
	    Diag(diagDirsum(fConst(2*nn,1), fConst(2*n-2*nn,0))) *
	    RC(C[1]) *
	    Tensor(I(n), Diag(1,0)) *
	    Buf(Scat(H(2*n,n,0,2)))
	)
    ),

    # transpose of RC(DFT(n)) is RC(DFT(n,-1)), since correct transposition is not implemented,
    # we need a separate rule
    PRDFT1_Complex_T := rec(
	switch           := false,
	isApplicable     := P -> not Is2Power(P[1]),
	allChildren      := P -> [[ DFT(P[1], -P[2]) ]],
	forTransposition := false,
	transposed := true,
	rule             := (P,C) -> let(n := P[1], nn:=Int(n/2)+1,
	    Buf(Gath(H(2*n,n,0,2))) *
	    Tensor(I(n), Diag(1,0)) *
	    RC(C[1]) *
	    Diag(diagDirsum(fConst(2*nn,1), fConst(2*n-2*nn,0))) *
	    Buf(Scat(H(2*n,2*nn, 0, 1)))
	)
    ),

    #F PRDFT1_Trig: PRDFT1_n -> P (DCT1_(n/2+1) dirsum DST1_(n/2-1)) A
    #F
    PRDFT1_Trig := rec(
	isApplicable := P -> P[1] > 2 and IsEvenInt(P[1]) and (P[2] mod P[1]) in [1,-1 mod P[1]],
	allChildren := P -> [[ DCT1(P[1]/2+1), DST1(P[1]/2-1) ]],
	rule := (P, C) -> let(n:=P[1]/2,
	    Z(2*n+2,2) *
	    DirectSum(Mat([[1,0],[0,0],[0,1],[0,0]]), L(2*n-2,n-1)) *
	    DirectSum(Z(n+1,-1)*C[1], Scale(P[2],C[2])) * SymSplit1(n))),

    PRDFT1_PF := rec(
	maxSize := false,
    	isApplicable := (self, P) >> (self.maxSize=false or P[1]<=self.maxSize) and not IsPrime(P[1]) and DivisorPairsRP(P[1])<>[],
    	allChildren  := P -> PRF12_PF_Children(P[1], P[2], PRDFT1, DFT1, PRDFT1),
    	rule := (P,C) -> let(N:=P[1], k:=P[2], m:=Cols(C[1]),
    	    PRF12_PF_Rule(N, k, C)))
));

RulesFor(IPRDFT1, rec(
    IPRDFT1_Base1 := BaseRule(IPRDFT1, [1, @]),
    IPRDFT1_Base2 := BaseRule(IPRDFT1, [2, @]),

    IPRDFT1_CT := rec(
	isApplicable := P -> not IsPrime(P[1]),
	allChildren  := P -> PRF12_CT_Children(P[1], P[2], IPRDFT1, DFT1, IPRDFT2, IPRDFT1),
	rule := (P,C) -> let(N:=P[1], k:=P[2], m:=Rows(C[1]),
	    IPRF12_CT_Rule(N, k, C, Diag(BHD(m,1,-1)), j->RC(Diag(fPrecompute(Twid(N,m,k,0,0,j+1))))))),

    IPRDFT1_Complex := rec(
 	switch           := false,
 	isApplicable     := P -> IsPrime(P[1]),
 	allChildren      := P -> [[ DFT(P[1], P[2]) ]],
	forTransposition := false,
	rule             := (P,C) -> let(n := P[1], nn:=Int(n/2)+1,
	    Mat(MatSPL(Gath(H(2*n,n,0,2)))) *
	    #Tensor(I(n), Diag(1,0)) *
	    RC(C[1]) *
	    Mat(MatSPL(Scat(H(2*n,2*nn, 0, 1))))
	)
    )
));

RulesFor(PRDFT2, rec(
    PRDFT2_Base1 := BaseRule(PRDFT2, [1, @]),
    PRDFT2_Base2 := BaseRule(PRDFT2, [2, @]),

    #F PRDFT2_CT: projection of DFT2_CT
    PRDFT2_CT := rec(
	isApplicable := P -> not IsPrime(P[1]),
	allChildren  := P -> PRF12_CT_Children(P[1], P[2], PRDFT2, DFT2, PRDFT4, PRDFT1),
	rule := (P,C) -> let(N:=P[1], k:=P[2], m:=Cols(C[1]),
	    PRF12_CT_Rule(N, k, C, Diag(BHD(m,-1,1)), j->RC(Diag(fPrecompute(Twid(N,m,k,0,1/2,j+1)))))))
));

RulesFor(IPRDFT3, rec(
    IPRDFT3_Base1 := BaseRule(IPRDFT3, [1, @]),
    IPRDFT3_Base2 := BaseRule(IPRDFT3, [2, @]),

    IPRDFT3_CT := rec(
	isApplicable := P -> not IsPrime(P[1]),
	allChildren  := P -> PRF12_CT_Children(P[1], P[2], IPRDFT3, DFT3, IPRDFT4, IPRDFT1),
	rule := (P,C) -> let(N:=P[1], k:=P[2], m:=Rows(C[1]),
	    IPRF12_CT_Rule(N, k, C, Diag(BHD(m,-1,1)), j->RC(Diag(fPrecompute(Twid(N,m,k,0,1/2,j+1)))))))
));

###########
# Hartley #
###########

RulesFor(PDHT1, rec(
    PDHT1_Base2 := rec(
	isApplicable := P -> P[1]=2,
	rule := (P, C) -> Tensor(I(2), Mat([[1],[1]])) * F(2)
    ),

    PDHT1_CT := rec(
	isApplicable := P -> not IsPrime(P[1]),
	allChildren  := P -> PRF12_CT_Children(P[1], P[2], PDHT1, DFT1, PDHT3, PDHT1),
	rule := (P,C) -> let(N:=P[1], k:=P[2], m:=Cols(C[1]),
	    PRF12_CT_Rule(N, k, C, TopHalf(m, J(2)), j->HTwid(N,m,k,0,0,j+1,J(2)).obj)))
));

RulesFor(PDHT2, rec(
   PDHT2_Base2 := rec(
	isApplicable := P -> P[1]=2,
	rule := (P, C) -> DirectSum(Mat([[1],[1]]), Mat([[1],[-1]])) * Mat(MatSPL(PRDFT2(P[1], P[2])){[1,4]})
    ),
    PDHT2_CT := rec(
	isApplicable := P -> not IsPrime(P[1]),
	allChildren  := P -> PRF12_CT_Children(P[1], P[2], PDHT2, DFT2, PDHT4, PDHT1),
	rule := (P,C) -> let(N:=P[1], k:=P[2], m:=Cols(C[1]),
	    PRF12_CT_Rule(N, k, C, TopHalf(m, -J(2)), j->HTwid(N,m,k,0,1/2,j+1,-J(2)).obj)))
));


# Examples/Tests for ANATPH

# Jack Button's Group
# -------------------
#
# With presentation
#
# Alan Logan says this is hyperbolic, but noone wants to publish
# this result alone.
#
# Tester now proves this to be hyperbolic, after corrected
# relation. Bug reported by email by Chris Chalk <chalk235@gmail.com>
#
InstallGlobalFunction("JackButtonGroup",
function()
    local pg;

    pg := PregroupOfFreeGroup(3);
    SetPregroupElementNames(pg, "1aAbBtT");
    return NewPregroupPresentation(pg, [ pg_word( pg, [7,2,6,5,3])
                                       , pg_word( pg, [7,4,6,3,5]) ]);
end);

# Triangle Groups
# ---------------
# As demonstrated in Proposition 9.4 of anatph, for l > 2 (and hence n > 3 if the
# group is supposed to be hyperbolic) there are no instantiable green places, and if
# l = 2 then there are exactly two instantiable green places.
InstallGlobalFunction("TriangleGroup",
function(l,m,n)
    local pg;
    pg := PregroupOfFreeProduct( CyclicGroup( IsPermGroup, l)
                               , CyclicGroup( IsPermGroup, m) );

    # This is a bit icky, we can't tell which element of pg is the one of the
    # second cyclic group
    return NewPregroupPresentation(pg, [ pg_word( pg, Repeat(n, [2, l + 1]))]);
end);

# Example from Theorem 9.5, triangle-like: quotient of 2-3-m triangle group
# our choice of pregroup is the free product of cyclic groups of order 2 and 3
#T see what happens if we present this group as
#T <x,y,z | x^2, y^3, z^m, (zxY)^n > ?
#T we push a parameter into the pregroup
InstallGlobalFunction(TriangleCommutatorQuotient,
function(m,n)
    local pg;
    pg := PregroupOfFreeProduct( CyclicGroup(IsPermGroup, 2)
                               , CyclicGroup(IsPermGroup, 3) );
    # Do this to have slightly nicer display. Maybe we need to give the user
    # a way to label generators
    pg!.enams := "1xyY";
    return NewPregroupPresentation(pg,
                                   [ pg_word(pg, Repeat(m, [2,3])),
                                     pg_word(pg, Repeat(n, [2,3,2,4]))
                                   ]);
end);

InstallGlobalFunction(RandomTriangleQuotient,
function(p,q,r,len)
    local pg;
    pg := PregroupOfFreeProduct( CyclicGroup(IsPermGroup, p)
                               , CyclicGroup(IsPermGroup, q) );
    # Do this to have slightly nicer display. Maybe we need to give the user
    # a way to label generators
    pg!.enams := "1xyY";
    return NewPregroupPresentation(pg,
                                   [ pg_word(pg, Repeat(r, [2,3])),
                                     RandomPregroupWord(pg, len)
                                   ]);
end);

InstallGlobalFunction(RandomPregroupWord,
function(pg, len)
    local i, lett, rel;

    rel := [];

    rel[1] := Random([2..Size(pg)]);
    for i in [2..len-1] do
        rel[i] := Random(Difference( [2..Size(pg)]
                                   , [__ID(PregroupInverse(pg[rel[i-1]]))]));
    od;
    rel[len] := Random(Difference([2..Size(pg)]
                                 , [ __ID(PregroupInverse(pg[rel[len - 1]]))
                                   , __ID(PregroupInverse(pg[rel[1]]))
                                   ] ));
    return pg_word(pg, rel);
end);

# Given a pregroup make a random presentation with nrel relators
# of length lrel
InstallGlobalFunction(RandomPregroupPresentation,
function(pg, nrel, lrel)
    local rels;

    rels := List([1..nrel], i -> RandomPregroupWord(pg, lrel));
    return NewPregroupPresentation(pg, rels);
end);

BindGlobal("CreateRandomExample",
function(path, pg, nrel, lrel)
    local pgp;

    if not IsDirectoryPath(path) then
        Error("path does not exist or is not a directory");
        return;
    fi;
    pgp := RandomPregroupPresentation(pg, nrel, lrel);

    # Write the pregroup presentation to file
    PregroupPresentationToFile(Concatenation(path, "/presentation-gap"), pgp);
    PregroupPresentationToSimpleFile(Concatenation(path, "/presentation-simple"), pgp);

    if WALRUS_kbmag_available then
    # Also create a KBMAG input file, if RSymTest succeeds on this presentation,
    # we can try computing an automatic structure and run gpgeowa on the result
    # to check whether the group is hyperbolic.
    WriteRWS(KBMAGRewritingSystem(PregroupPresentationToFpGroup(pgp)),
             Concatenation(path, "/presentation-kbmag"));
    fi;
end);

# Create a series of examples
BindGlobal("CreateRandomSeries",
function(pg, nrels, lrels, nexs, prf, basepath)
    local path, path2, i, pgp, lrel, nrel;

    if not IsDirectoryPath(basepath) then
        Error("path does not exist or is not a directory");
        return;
    fi;
    path := basepath;

    for lrel in lrels do
        CreateDir(Concatenation(path, "/", String(lrel)));
        for nrel in nrels do
            CreateDir(Concatenation(path, "/", String(lrel), "/", String(nrel)));
            for i in [1..nexs] do
                path2 := Concatenation(path, "/", String(lrel), "/", String(nrel), "/", String(i));
                prf("creating example nr ", i, " in ", path2, " \c");

                CreateDir(path2);
                CreateRandomExample(path2, pg, nrel, lrel);
                prf("\n");
            od;
        od;
    od;
end);

BindGlobal("CreateRandomSeriesOverSmallPregroups",
function(basepath)
    local i, n, sizes, path;

    if not IsDirectoryPath(basepath) then
        Error("path does not exist or is not a directory");
        return;
    fi;

    # at the moment we only have pregroups
    # of size 6
    sizes := [6];
    for n in sizes do
        CreateDir(Concatenation(basepath, "/", String(n)));
        for i in [1..NrSmallPregroups(n)] do
            path := Concatenation(basepath, "/", String(n), "/", String(i));
            CreateDir(path);
            CreateRandomSeries( SmallPregroup(n, i)
                              , [1,2,4,8,10]
                              , [5,10,15,20,25,30,35,40,45,50]
                              , 20
                              , Print
                              , path);
        od;
    od;
end);

BindGlobal("CreateRandomSeriesOverFreeGroup",
function(basepath)
    local i, n, sizes, path;

    if not IsDirectoryPath(basepath) then
        Error("path does not exist or is not a directory");
        return;
    fi;

    # ranks of free group
    sizes := [2,4,8,16,32,64];
    for n in sizes do
        path := Concatenation(basepath, "/", String(n));
        CreateDir(path);
        CreateRandomSeries( PregroupOfFreeGroup(n)
                          , [1,2,4,8,10]
                          , [5,10,15,20,25,30,35,40,45,50]
                          , 20
                          , Print
                          , path);
    od;
end);

BindGlobal("CreateRandomSeriesOverTrianglePregroup",
function(eps, p, q, nrel, lrel, nexs, prf, path)
    local pg;
    pg := PregroupOfFreeProduct( CyclicGroup( IsPermGroup, p)
                                , CyclicGroup( IsPermGroup, q) );
    pg!.enams := "1xyY";
    CreateRandomSeries( pg
                      , [1]
                      , [5,10,15,20,25,30,35,40,45,50]
                      , 20
                      , Print
                      , path );
end);

BindGlobal("CreateRandomSeriesOverTriangleGroup",
          function(eps, p, q, nrel, lrel, nexs, prf, path)
              local pg;
              pg := PregroupOfFreeProduct( CyclicGroup( IsPermGroup, p)
                                         , CyclicGroup( IsPermGroup, q) );
              pg!.enams := "1xyY";
              CreateRandomSeries( pg
                                , [1]
                                , [5,10,15,20,25,30,35,40,45,50]
                                , 20
                                , Print
                                , path );
          end);

BindGlobal("BenchmarkRandomPresentation",
function(pg, eps, nrel, lrel, nexs, prf, path)
    local i, pgp, start, stop, estart, estop, n, nfail, res, runt, fid, stream;

    n := 0;
    runt := [];

    start := NanosecondsSinceEpoch();
    for i in [1..nexs] do
        prf("creating example nr ", i, ", \c");
        pgp := RandomPregroupPresentation(pg, nrel, lrel);
        prf("starting RSymTest, \c");
        estart := NanosecondsSinceEpoch();
        res := RSymTest(pgp, eps);
        estop := NanosecondsSinceEpoch();
        if res = true then
            prf("succeeded after \c");
        else
            prf("failed \c");
        fi;
#        LogPregroupPresentation(path, pgp, res);
        prf(Float((estop - estart) / 1000000000), " seconds\n");
        Add(runt, [pgp, res, estop - estart]);
    od;
    stop := NanosecondsSinceEpoch();
    return rec( runtime := (stop - start) / 1000000000,
                samples := runt );
end);

BindGlobal("RandomPregroupFromSmallGroups",
function()
    local n, i, g1, g2;

    n := Random([1..64]);
    i := Random([1..NrSmallGroups(n)]);
    g1 := SmallGroup(n,i);

    n := Random([1..64]);
    i := Random([1..NrSmallGroups(n)]);
    g2 := SmallGroup(n,i);

    return PregroupOfFreeProduct(g1, g2);
end);

BindGlobal("BenchmarkRandom_TriPregroup",
function(eps, nrel, lrel, nexs, prf, path)
    local pg;
    pg := PregroupOfFreeProduct( CyclicGroup( IsPermGroup, 2)
                               , CyclicGroup( IsPermGroup, 3) );
    pg!.enams := "1xyY";
    return BenchmarkRandomPresentation(pg, eps, nrel, lrel, nexs, prf, path);
end);

BindGlobal("BenchmarkRandom_FreeGroupPregroup",
function(eps, ngen, nrel, lrel, nexs, prf, path)
    local pg;
    pg := PregroupOfFreeGroup(ngen);
    return BenchmarkRandomPresentation(pg, eps, nrel, lrel, nexs, prf, path);
end);

BindGlobal("BenchmarkRandom_OverSmallPregroup",
function(eps, nrel, lrel, nexs, prf, path)
    local pg, res;

    res := [];
    # FIXME: We only have pregroups of size 6 at the moment
    for pg in ANATPH_small_pregroups[6] do
        pg := PregroupByTable([1,'a','b','c','d', 'e'], pg);
        Add(res, BenchmarkRandomPresentation(pg, eps, nrel, lrel, nexs, prf, path));
    od;
    return res;
end);

BindGlobal("_VARIANCE",
function(v)
    local q, avg;
    if Length(v) = 1 then
        q := 1;
    else
        q := Length(v) - 1;
    fi;
    avg := Average(v);
    return Sum(List(v, x -> (x - avg)^2)) / (q);
end);

BindGlobal("AnalyseBenchmarkResult",
function(res)
    local r, succed, failed;

    r := rec();

    r.n := Length(res.samples);
    r.rt_avg := Average(List(res.samples, x->x[3]));
    r.rt_std := Sqrt(Float(_VARIANCE(List(res.samples, x->x[3]))));

    succed := Filtered(res.samples, x -> not IsList(x[2]));
    r.succed_n := Length(succed);
    if r.succed_n > 0 then
        r.succed_rt_avg := Average(List(succed, x->x[3]));
        r.succed_rt_std := Sqrt(Float(_VARIANCE(List(succed, x->x[3]))));
    fi;

    failed := Filtered(res.samples, x -> IsList(x[2]));
    r.failed_n := Length(failed);
    if r.failed_n > 0 then
        r.failed_rt_avg := Average(List(failed, x->x[3]));
        r.failed_rt_std := Sqrt(Float(_VARIANCE(List(failed, x->x[3]))));
    fi;

    return r;
end);

BindGlobal("StringBenchResult",
function(r)
    local res;

    res := STRINGIFY("n: ", r.n, ", s: ", r.succed_n, " f: ", r.failed_n, " (", Float(r.succed_n) / r.n, ")\n",
                     " (", Float(r.rt_avg), ",", r.rt_std, ")\n");
    Append(res, STRINGIFY(" success: ", r.succed_n));
    if r.succed_n > 0 then
        Append(res, STRINGIFY(" ", Float(r.succed_rt_avg), ",", r.succed_rt_std, "\n"));
    fi;
    Append(res, STRINGIFY(" failure: ", r.failed_n));
    if r.failed_n > 0 then
        Append(res, STRINGIFY(" ", Float(r.failed_rt_avg), ",", r.failed_rt_std, "\n"));
    fi;
    if res[Length(res)] <> '\n' then
        Add(res, '\n');
    fi;
    return res;
end);

BindGlobal("StandardBenchmarks",
function(nsamples, prn)
    local d, ngens, rlen, nrels, r, path;

    path := DirectoryTemporary();
    prn("running standard benchmarks for anatph, ", nsamples, " each\n");

    prn("= = = = = = =\n");
    prn(" Quotients of free group pregroup\n");
    prn("= = = = = = =\n");
    for ngens in [2,4,8,16] do
        for nrels in [1,2,3,4] do
            for rlen in [10,20,30,40,50] do
                prn("running "
                   , ngens, " generators, "
                   , nrels, " relators "
                   , "of length ", rlen, "\n");
                r := BenchmarkRandom_FreeGroupPregroup(
                                                    1/12
                                                  , ngens
                                                  , nrels
                                                  , rlen
                                                  , nsamples
                                                  , prn
                                                  , path
                     );
                prn(StringBenchResult(AnalyseBenchmarkResult(r)));
            od;
        od;
    od;

    prn("= = = = = = =\n");
    prn(" Quotients of 2-3-triangle group pregroup\n");
    prn("= = = = = = =\n");
    for nrels in [1,2,3,4] do
        for rlen in [10,20,30,40,50] do
            prn("running ", nrels, "relators of length ", rlen, "\n");
            r := BenchmarkRandom_TriPregroup(
                                              1/12
                                            , nrels
                                            , rlen
                                            , nsamples
                                            , prn
                                            , path
                     );
            prn(StringBenchResult(AnalyseBenchmarkResult(r)));
        od;
    od;

end);

BenchmarkSinglePres := function(eps, pg, nrel, len)
    local r,t,res;
    r := RandomPregroupPresentation(pg, nrel, len);
    t := NanosecondsSinceEpoch();
    res := RSymTest(r, eps);
    t := NanosecondsSinceEpoch() - t;
    return [r, res, t / 1000000000.];
end;

if IsBound(OutputAnnotatedCodeCoverageFiles) then
    ProfileSinglePresentation := function(eps, pg, nrel, len)
    local t, dir, fn;

    dir := DirectoryTemporary();
    fn := Filename(dir, "anatph.gz");

    Print("Profiling presentation to ", fn, "\n");
    ProfileLineByLine(fn);
    t := BenchmarkSinglePres(eps, pg, nrel, len);
    UnprofileLineByLine();

    Print("Writing annotated code coverage to ", Filename(dir, ""), "\n");
    OutputAnnotatedCodeCoverageFiles(fn, Filename(dir, ""));

    return t;
end;

else
    Print("profiling package is not available, disabling ProfileSinglePresentation\n");
fi;

# Benchmark the RSym tester with a presentation given density
# and length
BenchmarkGromovDensity := function(eps, ngens, length, density)
    local pg, nrels;

    pg := PregroupOfFreeGroup(ngens);
    nrels := Int( (2 * ngens - 1)^Float(density * length ) );
    Print("number of relators: ", nrels, "\n");
    return BenchmarkSinglePres(eps
                              , pg
                              , nrels
                              , length );
end;


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

unpacklo := (l1,l2,n,k) -> Flat(List([1..n/(2*k)], i-> [
        List([1..k], j->l1[(i-1)*k+j]),
        List([1..k], j->l2[(i-1)*k+j])
]));

unpackhi := (l1,l2,n,k) -> Flat(List([1..n/(2*k)], i -> [
        List([1..k], j->l1[n/2+(i-1)*k+j]),
        List([1..k], j->l2[n/2+(i-1)*k+j])
]));

# saturation in pack_semantic is not taken into account
pack_semantic := (l1, l2, n) -> Flat(List( [1..n], i -> [l1[i], l2[i]]));

sparams := (l,n) -> List([1..l], i->[1..n]);

shuffle := (in1, in2, p, n, k) -> Flat([
    List([1..n/(2*k)],     i->List([1..k], j->in1[(p[i]-1)*k+j])),
    List([n/(2*k)+1..n/k], i->List([1..k], j->in2[(p[i]-1)*k+j]))
]);

inverse_ushuffle := (inp, p, n) -> List([1..n], i->inp[p[i]]);

shufflehi := (in1, p, n, k) -> Concat(
    Sublist(in1, [1..n/2]),
    let(l := Sublist(in1, [n/2+1..n]), shuffle(l, l, p, n/2, k)));

shufflelo := (in1, p, n, k) -> Concat(
    let(l := Sublist(in1, [1..n/2]), shuffle(l, l, p, n/2, k)),
    Sublist(in1, [n/2+1..n]));

iclshuffle := p -> Print("_MM_SHUFFLE", When(Length(p)=2, "2", ""), "(", PrintCS(Reversed(p-1)), ")");

iclprintop := self >> Print(self.icl, "(", _vcprintcs(self.args), ")");

iperm4 := self >> Filtered(Cartesian(self.params()), i->i[1]<>i[2] and i[3] <> i[4]);

vtakehi := (v) -> Checked(IsValue(v) and IsVecT(v.t) and v.t.size>1,  TakeLast(v.v, Length(v.v)/2));
vtakelo := (v) -> Checked(IsValue(v) and IsVecT(v.t) and v.t.size>1,  Take(v.v, Length(v.v)/2));


################################################################################
##
#W DwG_data.gi              GroupTheoretical Package
##
#W Paul Bruillard, Cesar Galindo, Siu-Hung Ng, Julia Plavnik, Eric Rowell,
#W Zhenghan Wang
##
## Installation file for DwG_data functions of the GroupTheoretical Package
##
#Y Copyright (C) 2016, Battelle Memorial Institute
##
################################################################################

################################################################################
##
#F DwG_simples(<group>,<int>,<function>) . . . . . compute simples in D^w(G)
##
InstallGlobalFunction( DwG_simples, function(G,n,w)
  local x,Zx,wx,CC,SimpleObjects,projective_characters,chi;
  CC:=List(ConjugacyClasses(G),Representative);;
  SimpleObjects:=[];
  for x in CC do
    Zx:=Centralizer(G,x);
    wx:=function(g,h) return w(g,h,x)*w(x,g,h)*(w(g,x,h)^-1); end;;
    projective_characters:=projective_reps(Zx,wx,n);
    if not(Sum(List(projective_characters,chi->chi[1]^2))=Order(Zx)) then
      Display("ERROR");
    fi;
    for chi in projective_characters do
      Append(SimpleObjects,[[x,chi,ConjugacyClass(G,x),wx,Zx]]);
    od;
  od;
  return SimpleObjects;
end );

################################################################################
##
#F DwG_S_and_T(<list>,<group>) . . . . . . . . . .compute S and T for D^w(G)
##
InstallGlobalFunction(DwG_S_and_T, function(Simples,G)
  local r,S,T,i,simple1,x,chi,Kx,betax,Zx,x_idx,Zx_Transversal,j,simple2,y,chi_prime,Ky,betay,Zy,Zy_Transversal,a,g,Zg,b,g_prime,h_prime,h,h_idx,h_prime_idx;

  r:=Length(Simples);
  S:=NullMat(r,r);;
  T:=List([1..r],i->0);
  for i in [1..r] do
    simple1:=Simples[i];
    x:=simple1[1];
    chi:=simple1[2];
    Kx:=simple1[3];
    betax:=simple1[4];
    Zx:=simple1[5];
    #x_idx:=Position(GSet,x);
    x_idx:=Position(AsSet(Zx),x);
    T[i]:=chi[x_idx]/chi[Position(AsSet(Zx),Identity(Zx))];
    Zx_Transversal:=RightTransversal(G,Zx);
    for j in [i..r] do
      simple2:=Simples[j];
      y:=simple2[1];
      chi_prime:=simple2[2];
      Ky:=simple2[3];
      betay:=simple2[4];
      Zy:=simple2[5];
      #y_idx:=Position(GSet,y);
      Zy_Transversal:=RightTransversal(G,Zy);
      for a in Zx_Transversal do
        g:=(a^-1)*x*a;
        if not(g in Kx) then
          continue;
        fi;
        Zg:=Centralizer(G,g);
        for b in Zy_Transversal do
          g_prime:=(b^-1)*y*b;
          if not((g_prime in Ky) and (g_prime in Zg)) then
            continue;
          fi;
          h_prime:=b*g*(b^-1);
          h:=a*g_prime*(a^-1);
          h_idx:=Position(AsSet(Zx),h);
          h_prime_idx:=Position(AsSet(Zy),h_prime);
          S[i][j]:=S[i][j]+betax(a,g_prime)*betax(a*g_prime,a^-1)*betay(b,g)*betay(b*g,b^-1)*(betax(a,a^-1)^-1)*(betay(b,b^-1)^-1)*chi[h_idx]*chi_prime[h_prime_idx];
        od;
      od;
      S[j][i]:=S[i][j];
    od;
  od;

  return [S,T];
end);

################################################################################
##
#F DwG_data(<group>,<function>,<int>) . . . . . compute data of D^w(G)
InstallGlobalFunction(DwG_data,function(G,w,n)
  local Simples, S_and_T, pseudounitary_data, S, T, N, FPdimC, FPdim,sorted_data;
  Simples := DwG_simples(G,n,w);;
  S_and_T := DwG_S_and_T(Simples,G);;
  S := S_and_T[1];
  T := S_and_T[2];
  pseudounitary_data := pseudounitary_sort(S,T,Simples);
  Simples := pseudounitary_data[1];
  S := pseudounitary_data[2];
  T := pseudounitary_data[3];
  FPdim := pseudounitary_data[4];
  FPdimC := pseudounitary_data[5];
  sorted_data := dimension_sort(S,T,Simples,FPdim);
  Simples := sorted_data[1];
  S := sorted_data[2];
  T := sorted_data[3];
  FPdim := sorted_data[4];
  N:=compute_fusion_rules(S,FPdimC);;
  return [Simples, S, T, N, FPdim, FPdimC];;
end);

#E DwG_data.gi . . . . . . . . . . . . . . . . . . . . . . . . . . . . ends here