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

RemoveOnes := x -> Filtered(x, i->i<>1);

#F MDDFT(<dims>, [<exp>]) - multi-dimensional DFT non-terminal
#F   dims = [ <n_1>,.., <n_t> ] list of (positive) dimensions
#F   exp = root of unity exponent scaling (see DFT for exact definition)
#F
#F Definition : multidimensional matrix of size NxN, where N=n_1*..*n_t
#F      can also be represented as Tensor(DFT(n_1), ..., DFT(n_t))
#F
#F Example (direct)  : MDDFT([2,4,4])
#F Example (inverse) : MDDFT([2,4,4], -1)
#F
Class(MDDFT, TaggedNonTerminal, rec(
    abbrevs := [
    P     -> Checked(IsList(P), ForAll(P,IsPosInt), Product(P) > 1,
             [ RemoveOnes(P), 1, false ]),
    (P,k) -> Checked(IsList(P), ForAll(P,IsPosInt), IsInt(k), Product(P) > 1,
                     Gcd(Product(P), k)=1,
             [ RemoveOnes(P), k mod Product(P), false ]),
    (P,k,rc) -> Checked(IsList(P), ForAll(P,IsPosInt), IsInt(k), Product(P) > 1,
                     Gcd(Product(P), k)=1,
             [ RemoveOnes(P), k mod Product(P), rc ])
    ],
    dims := self >> let(n := Product(self.params[1]), When(self.isReal(), 2*[n,n], [n, n])),

    terminate := self >> let(t:=Tensor(List(self.params[1],
                                i -> DFT(i, self.params[2]).terminate())),
                            When(self.isReal(), MatAMat(RC(t).toAMat()), t)
                         ),

    transpose := self >> Copy(self),

    isReal := self >> self.params[3],

    setAB := meth(self, ab)
       self.a := ab[1];
       self.b := ab[2];
       return self;
    end,

    normalizedArithCost :=  (self) >> let(n := Product(self.params[1]),
                                        IntDouble(5 * n * d_log(n) / d_log(2)) )

#D    setpv := meth(self, pv)
#D        local s;
#D        s:= Copy(self);
#D        s.params[3] := pv;
#D        return s;
#D    end,

#D    tagpos := 3

));

# check for 1 dimensional MDDFTs and convert them to DFTs
catch1d_mddft := ch ->
    List(ch, x -> List(x, t -> When(Length(t.params[1]) > 1, t,
        DFT(Rows(t), t.params[2], t.params[3], t.params[4]))));

NewRulesFor(MDDFT, rec(
    #F RuleMDDFT_Base:  MDDFT -> DFT
    #F
    MDDFT_Base := rec(
        info := "MDDFT -> DFT",
        applicable     := nt -> Length(nt.params[1])=1,
        children       := nt -> let(P := nt.params, tags := nt.getTags(), [[ DFT(P[1][1], P[2]).withTags(tags) ]]),
        apply          := (nt, C, Nonterms) -> C[1]
    )
));

NewRulesFor(MDDFT, rec(

    #F RuleMDDFT_Tensor: MDDFT(n_1,n_2,...,n_t) = Tensor(DFT_n1, DFT_n2, ..., DFT_nt)
    #F
    MDDFT_Tensor := rec(
        switch := false,
        info :="MDDFT_n -> Tensor(DFT_n1,DFT_n2,...DFT_nt)",
        applicable := nt -> Length(nt.params[1])>1 and not nt.hasTags(),
        children  := nt -> [ List(nt.params[1],i->DFT(i, nt.params[2])) ],
        rule := (nt, C, cnt) -> Tensor(C)
#D        isApplicable := P -> Length(P[1])>1 and Length(P[3]) = 0,
#D        allChildren  := P -> [ List(P[1],i->DFT(i, P[2])) ],
#D        rule := (P,C) -> Tensor(C)
    ),

    #F RuleMDDFT_Dimless
    #F
    #F If N = RxS = n_1xn_2x...n_t and
    #F d1 = n_1* ..*n_(l-1), d2 = n_(l+1)*..*n_t, n_(l) = a*b then,
    #F MDDFT([n_1,..,n_t]) = Tensor(MDDFT([n_1,..,n_(l-1),a]), I(b), I(d2))*
    #F                       Tensor(I(d1), T(n_(l),b), I(d2))*
    #F                       Tensor(I(d1), I(a), MDDFT([b,n_(l+1),..,n_t])) *
    #F                       Tensor(I(d1), L(n_(l),a), I(d2))
    #F
    MDDFT_RowCol := rec (
        info := "MDDFT_n -> MDDFT_n/d, MDDFT_d",
        applicable := nt -> Length(nt.params[1]) > 1 and not nt.hasTags(),

        children := nt -> let(
            dims := nt.params[1],
            len := Length(dims),
            List([1..len-1],
            i -> [ MDDFT(dims{[1..i]}, nt.params[2]), MDDFT(dims{[i+1..len]}, nt.params[2]) ])),

        apply := (nt, C, Nonterms) -> let(
            a := Last(Nonterms[1].params[1]),
            n1 := Rows(Nonterms[1])/a,
            n2 := Rows(Nonterms[2]),
            Tensor(C[1], I(n2)) *
            Tensor(I(n1), Tensor(I(a), C[2]))
        )
#D    isApplicable := P -> Length(P[1]) > 1 and Length(P[3]) = 0,
#D
#D    allChildren := P -> let(
#D        dims := P[1],
#D        len := Length(dims),
#D        List([1..len-1],
#D        i -> [ MDDFT(dims{[1..i]}, P[2]), MDDFT(dims{[i+1..len]}, P[2]) ])),
#D
#D    rule := (P,C,Nonterms) -> let(
#D        a := Last(Nonterms[1].params[1]),
#D        n1 := Rows(Nonterms[1])/a,
#D        n2 := Rows(Nonterms[2]),
#D        Tensor(C[1], I(n2)) *
#D        Tensor(I(n1), Tensor(I(a), C[2])))
    ),

    MDDFT_Dimless := rec (
        info := "MDDFT_n -> MDDFT_n/d, MDDFT_d",
        applicable := nt -> Length(nt.params[1]) > 1 and ForAny(nt.params[1], x->not IsPrime(x)) and not nt.hasTags(),

        children := function(nt)
            local ch, dims, len, simple_splits, div_splits;
            dims := nt.params[1];
            len := Length(dims);
            return Concatenation(List([1..len], i -> let(
               left := dims{[1..i-1]},
               right := dims{[i+1..len]},
               List(DivisorPairs(dims[i]), split ->
                   [ MDDFT(Concatenation(left, [split[1]]), nt.params[2]),
             MDDFT(Concatenation([split[2]], right), nt.params[2]) ]))));
        end,

        apply := (nt, C, Nonterms) -> let(
            a := Last(Nonterms[1].params[1]),
            b := Nonterms[2].params[1][1],
            n1 := Rows(Nonterms[1])/a,
            n2 := Rows(Nonterms[2])/b,

            Tensor(Tensor(C[1], I(b)), I(n2)) *
            Diag(diagTensor(fConst(n1,1), Tw1(a*b,b,nt.params[2]), fConst(n2,1))) *
            Tensor(I(n1), Tensor(I(a), C[2])) *
            Tensor(I(n1), L(a*b,a), I(n2))
        )
#D    isApplicable := P -> Length(P[1]) > 1 and ForAny(P[1], x->not IsPrime(x)) and Length(P[3]) = 0,
#D
#D    allChildren := meth(self,P)
#D        local ch, dims, len, simple_splits, div_splits;
#D        dims := P[1];
#D        len := Length(dims);
#D        return Concatenation(List([1..len], i -> let(
#D           left := dims{[1..i-1]},
#D           right := dims{[i+1..len]},
#D           List(DivisorPairs(dims[i]), split ->
#D               [ MDDFT(Concatenation(left, [split[1]]), P[2]),
#D         MDDFT(Concatenation([split[2]], right), P[2]) ]))));
#D
#D    end,
#D
#D    rule := (P,C,Nonterms) -> let(
#D        a := Last(Nonterms[1].params[1]),
#D        b := Nonterms[2].params[1][1],
#D        n1 := Rows(Nonterms[1])/a,
#D        n2 := Rows(Nonterms[2])/b,
#D
#D        Tensor(Tensor(C[1], I(b)), I(n2)) *
#D        Diag(diagTensor(fConst(n1,1), T(a*b,b), fConst(n2,1))) *
#D        Tensor(I(n1), Tensor(I(a), C[2])) *
#D        Tensor(I(n1), L(a*b,a), I(n2)))
    ),

    #   2D Vector Radix
    #   NOTE: Put citation
    MDDFT_vrdx2D := rec(
        info          := "MDDFT([mn, rs],k) -> MDDFT([m, r], k%mr), MDDFT([n, s], k%ns)",

	switch        := false,
        maxSize       := false,

        applicable := nt -> Length(nt.params[1]) = 2 and ForAll(nt.params[1], x->not IsPrime(x))
                                    and not nt.hasTags(),

        children  := nt -> let(l:=List(nt.params[1], i->DivisorPairs(i)),
            idx:=Cartesian(List([1..Length(l)], i->[1..Length(l[i])])),
            rdx := List(idx, i->List([1..2], j->List([1..2], k->l[k][i[1]][j]))),
            Map2(rdx, (m,n) -> [ MDDFT(m, nt.params[2] mod Product(m)), MDDFT(n, nt.params[2] mod Product(n)) ])
        ),

        apply := (nt, C, cnt) -> let(mn := Product(nt.params[1]), m := Rows(C[1]), n := Rows(C[2]),
            Tensor(C[1], I(n)) *
            Diag(Tw1(mn, n, nt.params[2])) *
            Tensor(I(m), C[2]) *
            L(mn, m)
        )
    )
#D    isApplicable := (self,P) >> Length(P[1]) = 2 and ForAll(P[1], x->not IsPrime(x))
#D                                and Length(P[3]) = 0,
#D
#D    allChildren  := P -> let(l:=List(P[1], i->DivisorPairs(i)),
#D            idx:=Cartesian(List([1..Length(l)], i->[1..Length(l[i])])),
#D            rdx := List(idx, i->List([1..2], j->List([1..2], k->l[k][i[1]][j]))),
#D            Map2(rdx, (m,n) -> [ MDDFT(m, P[2] mod Product(m)), MDDFT(n, P[2] mod Product(n)) ])
#D        ),
#D
#D    rule := (P,C) -> let(mn := P[1], m := Rows(C[1]), n := Rows(C[2]),
#D        Tensor(C[1], I(n)) *
#D        T(mn, n, P[2]) *
#D        Tensor(I(m), C[2]) *
#D        L(mn, m))
#D    )

));


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

IsCyclicPerm := x -> IsSPL(x) and IsBound(x.isCyclic) and x.isCyclic;

CyclicPerms := function(e)
    local beg, mid, endd, len, list, i;
    beg := I(Rows(e)); mid := I(Rows(e)); endd := I(Cols(e));
    list := e.children();
    len := Length(list);
    i := 1;
    while i <= Length(list) and IsCyclicPerm(list[i])     do
        beg:=beg*list[i]; i:=i+1;
    od;
    while i <= Length(list) and not IsCyclicPerm(list[i]) do mid:=mid*list[i]; i:=i+1; od;
    while i <= Length(list) and IsCyclicPerm(list[i])     do endd:=endd*list[i]; i:=i+1; od;
    return [beg, mid, endd];
end;

PullOutCyclicPerms := tensor ->
    SubstTopDownNR(tensor, [Tensor, @(1,Compose), @(2,Compose)],
	e -> let(p1 := CyclicPerms(@(1).val),
	         p2 := CyclicPerms(@(2).val),
		 Tensor(p1[1], p2[1]) * Tensor(p1[2], p2[2]) * Tensor(p1[3], p2[3])));


# The graph obtained from an adjacency function on the vertex set.
BindGlobal("AdjFunGraph", function(E, F)
    return Graph(Group(()), E, function(x, y) return x; end, F, true);
end);

# A generic product graph.
BindGlobal("ProductGraph", function(Gs, F)
    local G, GG, dp;
    dp := DirectProduct(List(Gs, H -> H.group));
    G := Graph(dp, Cartesian(List(Gs, H -> [1..H.order])),
        OnProduct(Length(Gs), dp), F, true);
    for GG in Gs do
        if not "names" in RecNames(GG) then
            GG.names := [1..GG.order];
        fi;
    od;
    AssignVertexNames(G, List(G.names,
        f -> List([1..Length(f)], i -> Gs[i].names[f[i]])));
    return G;
end);

# The box product of two or more graphs.
BindGlobal("BoxProductGraph", function(arg)
    local Gs;
    if Length(arg) = 1 then
        Gs := arg[1];
    else
        Gs := arg;
    fi;
    return ProductGraph(Gs, function(x, y)
        local l;
        l := List([1..Length(Gs)], i -> Distance(Gs[i], x[i], y[i]));
        return WeightVecFFE(l) = 1 and Sum(l) = 1;
    end);
end);

# The cross product of two or more graphs.
BindGlobal("CrossProductGraph", function(arg)
    local Gs;
    if Length(arg) = 1 then
        Gs := arg[1];
    else
        Gs := arg;
    fi;
    return ProductGraph(Gs, function(x, y)
        local l;
        l := List([1..Length(Gs)], i -> Distance(Gs[i], x[i], y[i]));
        return Minimum(l) = 1 and Maximum(l) = 1;
    end);
end);

# The strong product of two or more graphs.
BindGlobal("StrongProductGraph", function(arg)
    local Gs;
    if Length(arg) = 1 then
        Gs := arg[1];
    else
        Gs := arg;
    fi;
    return ProductGraph(Gs, function(x, y)
        return Maximum(List([1..Length(Gs)],
            i -> Distance(Gs[i], x[i], y[i]))) = 1;
    end);
end);

# The bipartite double of a graph.
BindGlobal("BipartiteDoubleGraph", function(G)
    local H;
    H := BipartiteDouble(G);
    CheckDualityFunctions(G);
    H.halfDuality := BipartiteDoubleDualityFunction(G.duality);
    H.halfPrimality := BipartiteDoubleDualityFunction(G.primality);
    return H;
end);

# The extended bipartite double of a graph.
BindGlobal("ExtendedBipartiteDoubleGraph", function(G)
    local dp, signs, H;
    signs := ["+", "-"];
    dp := DirectProduct(G.group, SymmetricGroup(2));
    H := Graph(dp, Cartesian(G.representatives, signs),
        OnSignedPoints(dp, signs), function(x, y)
            return x[2] <> y[2] and Distance(G, x[1], y[1]) <= 1;
        end);
    if "names" in RecNames(G) then
        AssignVertexNames(H, List(H.names, x -> [G.names[x[1]], x[2]]));
    fi;
    CheckDualityFunctions(G);
    H.halfDuality := BipartiteDoubleDualityFunction(G.duality);
    H.halfPrimality := BipartiteDoubleDualityFunction(G.primality);
    return H;
end);

# The halved graph of a bipartite graph. The optional second argument
# allows choosing between the first and second halves.
BindGlobal("HalvedGraph", function(arg)
    local n, G, G2, H, vs;
    if Length(arg) < 1 then
        Error("at least one argument expected");
        return fail;
    fi;
    G := arg[1];
    if Length(arg) > 1 then
        n := arg[2];
    else
        n := 1;
    fi;
    if not IsConnectedGraph(G) then
        Error("not a connected graph");
        return fail;
    fi;
    if not IsBipartite(G) then
        Error("not a bipartite graph");
        return fail;
    fi;
    G2 := DistanceGraph(G, 2);
    vs := ConnectedComponent(G2, 1);
    if n = 2 then
        vs := Difference([1..G.order], vs);
    fi;
    H := Graph(Stabilizer(G.group, vs, OnSets), vs, OnPoints,
        function(x, y) return Distance(G2, x, y) = 1; end, true);
    if "names" in RecNames(G) then
        AssignVertexNames(H, G.names{vs});
    fi;
    if "halfDuality" in RecNames(G) then
        if n = 2 then
            H.primality := G.halfDuality;
        else
            H.duality := G.halfDuality;
        fi;
    fi;
    if "halfPrimality" in RecNames(G) then
        if n = 2 then
            H.duality := G.halfPrimality;
        else
            H.primality := G.halfPrimality;
        fi;
    fi;
    return H;
end);

# The antipodal quotient of an antipodal cover.
BindGlobal("AntipodalQuotientGraph", function(G)
    local d, H;
    if not IsAntipodalCover(G) then
        Error("not an antipodal cover");
        return fail;
    fi;
    d := Diameter(G);
    H := Graph(G.group,
        Set(List(G.representatives, x -> DistanceSet(G, [0, d], x))),
        OnSets, function(x, y)
            return IsSubset(DistanceSet(G, 1, x), y);
        end);
    if "names" in RecNames(G) then
        AssignVertexNames(H, List(H.names, f -> G.names{f}));
    fi;
    return H;
end);

# A graph with the set of d-dimensional subspaces of V filtered by S
# as the vertex set, acted upon by the matrix group G,
# with two subspaces being adjacent iff their intersection has dimension d-1.
BindGlobal("SubspaceGraph", function(arg)
    local G, H, S, V, d, invt, vcs;
    if Length(arg) < 4 then
        Error("at least four arguments expected");
        return fail;
    fi;
    G := arg[1];
    S := arg[2];
    V := arg[3];
    d := arg[4];
    if Length(arg) > 4 then
        invt := arg[5];
    else
        invt := true;
    fi;
    if IsList(S) then
        vcs := S;
    else
        vcs := S(Subspaces(V, d));
    fi;
    H := Graph(G, vcs, OnSubspaces(V), function(x,y)
                    return Dimension(Intersection(x,y)) = d-1;
                end, invt);
    H.duality := Intersection;
    H.primality := Sum;
    return H;
end);

# The clique (dual geometry) graph of a collinearity graph. The optional second
# argument allows choosing a connected component of the resulting graph.
BindGlobal("CliqueGraph", function(arg)
    local C, G, H, n;
    if Length(arg) < 1 then
        Error("at least one argument expected");
        return fail;
    fi;
    G := arg[1];
    C := Cliques(G);
    if Length(arg) > 1 then
        n := arg[2];
        if not IsList(n) then
            n := [n];
        fi;
    else
        n := [1..Length(C)];
    fi;
    H := Graph(G.group, C{n}, OnSets,
                function(x, y)
                    return Size(Intersection(x,y)) = 1;
                end);
    if "names" in RecNames(G) then
        CheckDualityFunctions(G);
        H.duality := G.primality;
        H.primality := G.duality;
        AssignVertexNames(H, List(H.names, f -> G.duality(G.names{f})));
        if "halfDuality" in RecNames(G) then
            H.halfDuality := G.halfDuality;
        fi;
        if "halfPrimality" in RecNames(G) then
            H.halfPrimality := G.halfPrimality;
        fi;
    fi;
    return H;
end);

# The incidence graph of a collinearity graph.
BindGlobal("IncidenceGraph", function(arg)
    local C, G, H, n;
    if Length(arg) < 1 then
        Error("at least one argument expected");
        return fail;
    fi;
    G := arg[1];
    C := Cliques(G);
    if Length(arg) > 1 then
        n := arg[2];
        if not IsList(n) then
            n := [n];
        fi;
    else
        n := [1..Length(C)];
    fi;
    H := Graph(G.group, Union(G.representatives, C{n}),
                OnPointsOrLines(OnPoints, IsList),
                function(x, y)
                    return (IsList(y) and x in y) or (IsList(x) and y in x);
                end);
    if "names" in RecNames(G) and G.order > 0 then
        CheckDualityFunctions(G);
        if IsList(H.names[1]) then
            H.halfDuality := G.primality;
            H.halfPrimality := G.duality;
        else
            H.halfDuality := G.duality;
            H.halfPrimality := G.primality;
        fi;
        AssignVertexNames(H, List(H.names, function(f)
                                            if IsList(f) then
                                                return G.duality(G.names{f});
                                            else
                                                return G.names[f];
                                            fi;
        end));
    fi;
    return H;
end);


signature Nuss(alphabet, answer) {

  answer nil(void);
  answer right(answer, alphabet);
  answer pair(alphabet, answer, alphabet);
  answer split(answer, answer);
  choice [answer] h([answer]);

}

algebra bpmax implements Nuss(alphabet = char, answer = int)
{
  int nil(void)
  {
    return 0;
  }

  int left(char c, int a)
  {
    return a;
  }

  int pair(char c, int m, char d)
  {
    return m + 1;
  }

  int split(int l, int r)
  {
    return l + r;
  }

  choice [int] h([int] l)
  {
    return list(maximum(l));
  }

}

grammar nussinov uses Nuss (axiom=start) {

  tabulated { start, bp }

  start = nil(EMPTY) |
          left(CHAR, start) |
          split(bp, start) # h ;

  bp = pair(CHAR, start, CHAR) with char_basepairing ;

}

instance bpmax = nussinov ( bpmax ) ;


#############################################################################
##
#W  betti.gi                                                    Karel Dekimpe
#W                                                               Bettina Eick
##

#############################################################################
##
## The following functions can be used to determine Betti-numbers of a
## torsion-free polycyclic group given by a pcp presentation. All
## Betti-numbers can be obtained if G has Hirsch length at most 5.
##
## The Betti-numbers B(G,m) are defined as the ranks of H_m(G,Z) for the
## trivial G-module Z. If M is the orientation G-module, then we can also
## characterise B(G,m) for n >= m >= n-2 as the ranks of H^n-m(G,M).
## Further, the alternating sum of all Betti-numbers is 0 using the
## Euler characteristic.
##

#############################################################################
##
#F OrientationModule( G )
##
InstallMethod( OrientationModule, "for pcp groups", true, [IsPcpGroup], 0,
function( G )
    local pcps, gens, mats, acts, dets, i, pcp;
    pcps := PcpsOfEfaSeries( G );
    pcps := Filtered( pcps, x -> RelativeOrdersOfPcp(x)[1] = 0 );
    gens := Igs(G);
    mats := List( gens, x -> IdentityMat( 1 ) );
    for pcp in pcps do
        acts := LinearActionOnPcp( gens, pcp );
        dets := List( acts, x -> Determinant( x ) );
        for i in [1..Length(mats)] do
            mats[i] := dets[i] * mats[i];
        od;
    od;
    return mats;
end );

#############################################################################
##
#F IsOrientedMatGroup( G )
##
IsOrientedMatGroup := function( G )
    return ForAll( GeneratorsOfGroup(G), x -> Determinant(x) = 1 );
end;

#############################################################################
##
#F BettiNumber( G, m )
##
BettiNumberPcpGroup := function(G,m)
    local n, pcp, mats, CR, one, two;

    if not IsTorsionFree( G ) then
        Print("the input group must be torsion-free \n");
        return fail;
    fi;

    # catch the trivial case
    if IsFinite(G) then
        if m = 0 then
            return 1;
        else
            return 0;
        fi;
    fi;

    # the hirsch length
    n := HirschLength( G );

    if m < 0 or m > n then return 0; fi;

    if m = 0 then return 1; fi;

    if m = 1 then
        pcp := Pcp( G, DerivedSubgroup(G) );
        return Length( Filtered( RelativeOrdersOfPcp( pcp ),x -> x=0 ));
    fi;

    if m = n then
        mats := OrientationModule( G );
        if ForAny( mats, x -> x[1][1] = -1 ) then
            return 0;
        else
            return 1;
        fi;
    fi;

    if m = 2 then
        mats := List( Pcp(G), x -> IdentityMat(1) );
        CR := CRRecordByMats( G, mats );
        two := TwoCohomologyCR( CR ).factor.rels;
        return Length( Filtered( two, x -> x = 0 ) );
    fi;

    if m = n-1 then
        mats := OrientationModule( G );
        CR := CRRecordByMats( G, mats );
        one := OneCohomologyCR( CR ).factor.rels;
        return Length( Filtered( one, x -> x = 0 ) );
    fi;

    if m = n-2 then
        mats := OrientationModule( G );
        CR := CRRecordByMats( G, mats );
        two := TwoCohomologyCR( CR ).factor.rels;
        return Length( Filtered( two, x -> x = 0 ) );
    fi;

    Print("Betti-number is out of range for our methods \n");
    return fail;
end;

InstallMethod( BettiNumber, "for torsion-free pcp groups", true,
   [IsPcpGroup, IsInt], 0,
function(G, m)
    if not IsTorsionFree(G) then TryNextMethod(); fi;
    if m in [3..HirschLength(G)-3] then TryNextMethod(); fi;
    return BettiNumberPcpGroup(G,m);
end);

#############################################################################
##
#F BettiNumbers( G )
##
InstallMethod( BettiNumbers, "for torsion-free pcp groups", true,
    [IsPcpGroup], 0,
function( G )
    local n, betti;

    n := HirschLength( G );
    if not IsTorsionFree( G ) or n > 6 then TryNextMethod(); fi;

    # set up the Betti-numbers
    betti := [1];
    if n = 0 then return betti; fi;
    betti[2] := BettiNumber( G, 1 );
    if n = 1 then return betti; fi;
    betti[3] := BettiNumber( G, 2 );
    if n = 2 then return betti; fi;
    betti[4] := betti[1] - betti[2] + betti[3];
    if n = 3 then return betti; fi;
    if n > 3 then
        betti[5] := BettiNumber( G, 4 );
        betti[4] := betti[4] + betti[5];
    fi;
    if n > 4 then
        betti[6] := BettiNumber( G, 5 );
        betti[4] := betti[4] - betti[6];
    fi;
    if n > 5 then
        betti[7] := BettiNumber( G, 6 );
        betti[4] := betti[4] + betti[7];
    fi;
    return betti;
end );


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

#F VO1dsJ(<n>, <v>) -- vector construct for I(1) \dirsum J(n-1)
#F
Class(VO1dsJ, BaseMat, SumsBase, rec(
    new := (self, n, v) >> SPL(WithBases(self, rec(n := n, v := v))).setDims(),
    dims := self >> [self.n, self.n],
    #-----------------------------------------------------------------------
    rChildren := self >> [self.n, self.v],
    rSetChild := rSetChildFields("n", "v"),
    #-----------------------------------------------------------------------
    transpose := self >> self,
    conjTranspose := self >> self,
    area := self >> self.n * self.n,
    #-----------------------------------------------------------------------
    toAMat := self >> AMatMat(MatSPL(DirectSum(O(1), J(self.n-1))))
));

#F VIxJ2(<v>) -- vector construct for I(v/2) \tensor J(2)
#F
Class(VIxJ2, BaseMat, SumsBase, rec(
    new := (self, v) >> SPL(WithBases(self, rec(v := v))).setDims(),
    dims := self >> [self.v, self.v],
    #-----------------------------------------------------------------------
    isReal := True,
    rChildren := self >> [self.v],
    rSetChild := rSetChildFields("v"),
    #-----------------------------------------------------------------------
    transpose := self >> self,
    conjTranspose := self >> self,
    area := self >> self.v * self.v,
    #-----------------------------------------------------------------------
    toAMat := self >> AMatMat(MatSPL(Tensor(I(self.v/2), J(2))))
));

#F For v > 2
#F    RCVIxJ2(v) == RC(VIxJ2(v/2))
#F               == I(v/4) \tensor J(2) \tensor I(2)
#F For v=2
#F    RCVIxJ2(2) == J(2)
#F
Class(RCVIxJ2, BaseMat, SumsBase, rec(
    new := (self, v) >> SPL(WithBases(self, rec(v := v))).setDims(),
    dims := self >> [self.v, self.v],
    #-----------------------------------------------------------------------
    isReal := True,
    rChildren := self >> [self.v],
    rSetChild := rSetChildFields("v"),
    #-----------------------------------------------------------------------
    transpose := self >> self,
    conjTranspose := self >> self,
    area := self >> self.v * self.v,
    #-----------------------------------------------------------------------
    toAMat := self >> Cond(self.v=2, J(2).toAMat(), # YSV: NOTE: check if this is correct
	                             Tensor(I(self.v/4), J(2), I(2)).toAMat())
));

#F VJxI(<m>, <v>) -- vector construct for J(m) \tensor I(v/m)
#F
Class(VJxI, BaseMat, SumsBase, rec(
    new := (self, m, v) >> SPL(WithBases(self, rec(m := m, v := v))).setDims(),
    dims := self >> [self.v, self.v],
    #-----------------------------------------------------------------------
    isReal := True,
    rChildren := self >> [self.m, self.v],
    rSetChild := rSetChildFields("m", "v"),
    #-----------------------------------------------------------------------
    transpose := self >> self,
    conjTranspose := self >> self,
    area := self >> self.v * self.v,
    #-----------------------------------------------------------------------
    toAMat := self >> AMatMat(MatSPL(Tensor(J(self.m), I(self.v/self.m))))
));


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

NewRulesFor(DFT, rec(

    DFT_PD_loop := rec(
        forTransposition := false,
        minSize := 7,
        maxSize := 13,

        TabPerm := r -> let(i:=Ind(r.domain()), f := FData(r.tolist()).at(i), Lambda(i, f).setRange(r.range())),

        applicable     := (self, nt) >> nt.params[1] > 2 and nt.params[1] in [self.minSize..self.maxSize] and IsPrime(nt.params[1]) and not nt.hasTags(),

        apply := (self, nt, C, cnt) >> let(
            N := nt.params[1],
            k := nt.params[2],
            root := PrimitiveRootMod(N),
            M:=(N-1)/2,
            i := Ind(M),
            j := Ind(M),
            k1 := Ind(M+1),
            m := MatSPL(DFT_PD.core(N, k, root, false) * DFT_PD.A(N)),
            m1 := Map(m{[2..(N+1)/2]}, r -> r{[2..(N+1)/2]}),
            m2 := Map(m{[(N+3)/2..N]}, r -> r{[(N+3)/2..N]}),
            d := Flat(m1)::Map(Flat(m2), c->im(ComplexAny(c)).v),
            fd := FData(d),

            s := Scat(self.TabPerm(RR(N, 1, root))),
            g := Gath(self.TabPerm(RR(N, 1, 1/root mod N))),

            gg := Gath(fCompose(fAdd(N, N-1, 1), fTensor(fId(2), fBase(M, k1-1)))),
            f2 := F(2),
            u := Ind(2),
            uf := Lambda(u, fd.at(u*M*M + M*i+(k1-1))),
            bb := DirectSum(Blk1(uf.at(0)), Scale(ImaginaryUnit(), Blk1(uf.at(1)))),

            krn0 := Mat([[1],[0]]) * Gath(fAdd(N, 1, 0)),
            krnn := bb * f2 * gg,
            krn := ScatAcc(fId(2)) * f2 * COND(eq(k1,0), krn0, krnn),

            q1 := L(2*M, 2) * IterVStack(i, ISumAcc(k1, krn)),
            #q2 := RowVec(fConst(13,V(1.0))),
            _i := Ind(N),
            q2 := ISumAcc(_i, ScatAcc(fAdd(1,1,0)) * Blk([[1]]) * COND(eq(_i, 0), Gath(fAdd(13,1,0)), Gath(fAdd(13,1,_i)))),
            q3 := VStack(q2, q1 * g),
            qq := s * q3,
            qq
        )
    )
));

RulesFor(PRDFT, rec(
   PRDFT_PD_loop := rec(
	forTransposition := false,
    minSize := 7,
	maxSize          := 13,
	isApplicable     := (self, P) >> P[1] > 2 and P[1] in [self.minSize..self.maxSize] and IsPrime(P[1]),

	rule := (self,P,C) >> let(N:=P[1], n:=N-1, k:=P[2], root:=PrimitiveRootMod(N),
        M:=n/2,
        i := Ind(M),
        j := Ind(M),
        k1 := Ind(M+1),
        m := MatSPL(DFT_PD.core(N, k, root, false) * DFT_PD.A(N)),
        m1 := Map(m{[2..(N+1)/2]}, r -> r{[2..(N+1)/2]}),
        m2 := Map(m{[(N+3)/2..N]}, r -> r{[(N+3)/2..N]}),
        d := Flat(m1)::Map(Flat(m2), c->im(ComplexAny(c)).v),
        fd := FData(d),
        #lfd1 := Lambda(j, fd.at(M*i+j)),
        #lfd1 := Lambda(k1, cond(eq(k1, V(0)), V(1.0), fd.at(M*i+(k1-V(1))))),
        #lfd2 := Lambda(j, fd.at(M*M+M*i+j)),

        gf := DFT_PD_loop.TabPerm(RR(N, 1, root)),
        g := Gath(gf),

        #kk1 := DirectSum(RowVec(lfd1), RowVec(lfd2)) * DirectSum(I(1), Tensor(F(2), I(M)) * OS(n, -1)),
        #q1 :=  IterVStack(i, BB(kk1)),

        #lbd := OS(12, -1).lambda(),
        _j := Ind(n),
        lbd := Lambda(_j, imod(V(n)-_j, V(n))),
        gg := Gath(fCompose(fAdd(N, N-1, 1), fCompose(lbd, fTensor(fId(2), fBase(M, k1-1))))),

        f2 := F(2),
        u := Ind(2),
        uf := Lambda(u, fd.at(u*M*M + M*i+(k1-1))),
        bb := DirectSum(Blk1(uf.at(0)), Blk1(uf.at(1))),

        krn0 := Mat([[1],[0]]) * Gath(fAdd(N, 1, 0)),
        krnn := bb * f2 * gg,
        krn := Grp(ScatAcc(fId(2))) * COND(eq(k1,0), krn0, krnn),

        q1 := IterVStack(i, ISumAcc(k1, krn)),
        q2a := RowVec(fConst(13,V(1.0))),
#        _i := Ind(N),
#        q2a := ISumAcc(_i, ScatAcc(fAdd(1,1,0)) * Blk([[1]]) * COND(eq(_i, 0), Gath(fAdd(13,1,0)), Gath(fAdd(13,1,_i)))),
        q2b := RowVec(fConst(13,V(0.0))),
        q3 := VStack(BB(VStack(q2a, q2b)), q1),
        sf := DFT_PD_loop.TabPerm(Refl((N+1)/2, N, (N+1)/2, RR(N,1,root))),
        s := Scat(fTensor(sf, fId(2))),

        u1 := Ind(N+1),
        df := Lambda(u1, cond(logic_and(eq(V(1), bin_and(u1, 1)), geq(gf.at(idiv(u1, 2)), (N+1)/2)), V(-1), V(1))),
        dfl := df.tolist(),
        m1s := Filtered([0..N], _i->dfl[_i+1] = V(-1)),
        m1eq := List(m1s, _i->eq(u1, V(_i))),
        cnd := ApplyFunc(logic_or, m1eq),
        lbdcnd := Lambda(u1, cond(cnd, V(-1), V(1))),
        diag := Diag(lbdcnd),
        sct := s * diag,
        qq := sct * q3 * g,
        qq
    )
)));

RulesFor(IPRDFT, rec(
   IPRDFT_PD_loop := rec(
	forTransposition := false,
    minSize := 7,
	maxSize          := 13,
	isApplicable     := (self, P) >> P[1] > 2 and P[1] in [self.minSize..self.maxSize] and IsPrime(P[1]),

	rule := (self,P,C) >> let(N:=P[1], n:=N-1, k:=P[2], root:=PrimitiveRootMod(N), M:=n/2,
        # loop variables
        ii := Ind(M),
        k1 := Ind(M+1),
        u := Ind(2),
        # scatter
        fstr := fDirsum(fId(1), L(n, n/2)),
        fos := fDirsum(fId(2), J(N-2)),
        frr := RR(N, 1, root),
        fsct := fCompose(frr, fos, fstr),
        fl := fsct.tolist(){[2..N]},
        flst := FList(N-1, fl),
        fst :=  DFT_PD_loop.TabPerm(flst),
        i := Ind(N),
        flbd := Lambda(i, cond(eq(i, V(0)), V(0), fst.at(i-V(1)))).setRange(N),
        sct := Scat(flbd),
        # diagonal sign flip and block matrix
        rr := RealRR_Out(N, root).transpose(),
        dd := rr.child(1),
        mc := TransposedSPL(DFT_PD.core(N, k, root, false) * DFT_PD.A(N)) * DirectSum(Mat([[1,0]]), 2*I(n)),
        dd2 := DirectSum(I(2), L(n, 2)) * dd * DirectSum(I(2), L(n, n/2)),
        m := MatSPL(mc * dd2),
        m1 := Map(m{[2..(N+1)/2]}, r -> r{[3..(N+1)/2+1]}),
        m2 := Map(m{[(N+3)/2..N]}, r -> Map(r{[(N+3)/2+1..N+1]}, c->-im(ComplexAny(c)).v)),
        d := Flat(m1)::Flat(m2),
        fd := FData(d),
        # gather
        gth := rr.child(2),
        gf := gth.func,
        gfl := gf.tolist(){2*[1..(N-1)/2]+1},
        gst := FList((N-1)/2, gfl),
        gftb := DFT_PD_loop.TabPerm(gst).setRange(N+1),
        glbd := Lambda(u, gftb.at(k1-1) + u).setRange(N+1),
        gath := Gath(glbd),
        # kernel
        uf := Lambda(u, fd.at(u*M*M + M*ii+(k1-1))),
        bb := DirectSum(Blk1(uf.at(0)), Blk1(uf.at(1))),
        f2 := F(2),
        krn0 := f2 * Mat([[1],[0]]) * Gath(fAdd(N+1, 1, 0)),
        krnn := f2 * bb * gath,
        krn := Grp(ScatAcc(fId(2))) * COND(eq(k1,0), krn0, krnn),
        # stack
        q1 := IterVStack(ii, ISumAcc(k1, krn)),
        r1 := RowVec(diagDirsum(fConst(1,V(1.0)), fConst(n/2,V(2.0)))) * Gath(fTensor(fId((N+1)/2), fBase(2, 0))),
        qq := VStack(r1, q1),
        qq1 := sct * qq,
        qq1
    ))
));


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

##################################
# I currently have a streaming algorithm (from Nikara et al.) for two variations of DCT-2.
#
# First, we have Spiral's standard DCT-2.  This is called TDCT2, defined:
#    [ cos(k*(l+1/2)*pi/n) | k,l = 0...n-1 ]
#
# Then, I have added a scaled version, defined:
#    [ Diag(1/sqrt(2), 1, 1, ...  ] * [ cos(k*(l+1/2)*pi/n) | k,l = 0...n-1 ]
# which matches the definition in the Nikara paper.

# We use essentially the same algorithm for both; the only change is in one diagonal.

# Using opts := InitStreamUnrollHw(); will enable these rules.

# Other DCT-2 definitions also have a sqrt(2/n) scaling factor in front of the whole matrix.

###########################

Declare(Sc_DCT2_func);

#F Sc_DCT2(<n>) - Scaled Discrete Cosine Transform, Type II, non-terminal
#F Definition: (n x n)-matrix [ Diag(1/sqrt(2), 1, 1, ...  ] * [ cos(k*(l+1/2)*pi/n) | k,l = 0...n-1 ]
#F Example:    DCT2(8)
Class(Sc_DCT2, TaggedNonTerminal, rec(

    abbrevs := [
    (n)       -> Checked(IsPosIntSym(n),
        [_unwrap(n)]),
    ],

    hashAs := self >> ObjId(self)(self.params[1], 1).withTags(self.getTags()),

    dims := self >> [ self.params[1], self.params[1] ],

    isReal := self >> true,

    terminate := self >> Mat(Sc_DCT2_func(self.params[1])),
    transpose := self >> Mat(TransposedMat(Sc_DCT2_func(self.params[1]))),
));

# hadamard_func(n,i): n-point Hadamard permutation, position i.
# Defined as in:
#    Z. Wang, Pruning the fast discrete Cosine transform, IEEE
#    Tr. Communications 39(5), May 1991, 640-643.
hadamard_func := function(n,i)
   if ((n=1) and (i=0)) then return 0; fi;
   if (imod(n,2) <> 0) then return -1;  fi; # ERROR
   if (imod(i,2) = 0) then return hadamard_func(n/2, i/2); fi;

   return n-1-hadamard_func(n/2, (i-1)/2);

end;

# An Exp wrapper for hadamard_func.  Used so Spiral does not try to evaluate the expression
# until Process_fPrecompute is called.

Class(hadamard_func_exp, Exp, rec(
    ev := self >> hadamard_func(self.args[1].ev(), self.args[2].ev())
));

# Had(n): Hadamard permutation on n points.
# See:
#    Z. Wang, Pruning the fast discrete Cosine transform, IEEE
#    Tr. Communications 39(5), May 1991, 640-643.
Class(Had, PermClass, rec(
#    exportSymbol := self>>self.name,
#    exportParams := self>>self.params,
#    export := Sym.export,

    def := (n) -> Checked(
        IsPosIntSym(n),
        rec(size := n)),

    lambda := self >> let(
        n := self.params[1], i := Ind(n),
        lt := List([0..n-1], it->hadamard_func(n,it)),
        FList(TInt, lt).lambda()
    ),

    transpose := self >> Error("Transpoed Hadamard permutation not currently supported."),

    # Only symmetric for size 2.
    isSymmetric := self >> (self.params[1] = 2)
));

# Don't think I need this anymore.
# tSPL Hadamard permutation on n points
# See:
#    Z. Wang, Pruning the fast discrete Cosine transform, IEEE
#    Tr. Communications 39(5), May 1991, 640-643.
Class(THad, Tagged_tSPL_Container, rec(
    abbrevs :=  [ size -> [size] ],

    dims := self >> Replicate(2, self.params[1]),

    terminate := self >> Had(self.params[1]),
    transpose := self >> Error("Transposed Hadamard permutation not currently supported."),
    isReal := self >> true,
    isSymmetric := self >> self.params[1] = 2,

    # We can verify this with:
    # PermMatrixToBits(MatSPL(Had(n)))
    permBits := self >> let(n:=self.params[1], logn:=Log2Int(n),
        (MatSPL(DirectSum(J(logn-1), O(1,1))) + MatSPL(J(logn))) *
        GF(2).one
    )

));

########################################
## The following are helper functions used in the streaming DCT2
## diagonal given in
##    Nikara et al., Discrete cosine and sine transforms--regular
##    algorithms and pipeline architectures, Signal Processing 86,
##    2006.

mu := (s,i) -> Cond(imod(i,2^s)=0, 0, 1);
tau := (i,s) -> Cond(s=i, 0, 1);

Class(mu_exp, Exp, rec(
   ev := self >> mu(self.args[1].ev(), self.args[2].ev())
));

Class(tau_exp, Exp, rec(
   ev := self >> tau(self.args[1].ev(), self.args[2].ev())
));

dct_diag_f := (k,i,s) -> (imod(i,2) + (1-tau_exp(0,i)) * (1-tau_exp(k-1,s)));

#dct_diag_d := i -> let(K := 2^(Log2Int(i)), t := i-K,
#    h := hadamard_func(K, t),
#    cospi((h+1/2)/(2*K)));

dct_diag_d := i -> let(K := 2^(floor(fdiv(log(i), log(2)))), t := i-K,
    h := hadamard_func_exp(K, t),
    cospi(fdiv((h+1/2), (2*K))));

dct_sc_diag_g := (k,i,s) -> ((2^(mu_exp(s, floor(fdiv(i,2))))) *
    (dct_diag_d(2^(k-s-1) + floor(fdiv(i, (2^(s+1)))))))^dct_diag_f(k,i,s);

dct_unsc_diag_g := (k,i,s) -> ((2^(mu_exp(s, floor(fdiv(i,2))))) *
    (dct_diag_d(2^(k-s-1) + floor(fdiv(i, (2^(s+1)))))))^imod(i,2);

## This represents the diagonal matrix used in the streaming
## DCT2 algorithm. The problem is of size 2^k, and s represents
## the iteration
#Str_DCT2_Diag := (k, s) -> Diag(List([0..((2^k)-1)],
#    i-> dct_diag_g(k, i, s)));

Class(Str_Sc_DCT2_Diag, DiagFunc, rec(
    abbrevs := [(k, s) -> [k, s]],
    def := (k, s) -> rec(size := 2^k),
    lambda := self >> let(k := self.params[1], s := self.params[2], i := Ind(2^k), Lambda(i, dct_sc_diag_g(k, i, s))),
    range := self >> TReal,
));

Class(Str_DCT2_Diag, DiagFunc, rec(
    abbrevs := [(k, s) -> [k, s]],
    def := (k, s) -> rec(size := 2^k),
    lambda := self >> let(k := self.params[1], s := self.params[2], i := Ind(2^k), Lambda(i, dct_unsc_diag_g(k, i, s))),
    range := self >> TReal,
));

Class(Str_DCT2_Perm, PermClass, rec(
    def := (k) -> Checked(
        IsPosIntSym(k),
        rec(size := 2^k)),

    # Sigh, this is broken it seems.
    lambda := self >> let(
        k := self.params[1],
	fCompose(Reversed(List([0..(k-2)], i-> let(rsize := 2^k - 2^(k-i),

            fCompose(
		fTensor(fId(2^i), L(2^(k-i), 2^(k-i-1))),
		fDirsum(fId(2^(k-i)), fTensor(fId(rsize/4), fDirsum(fId(2), J(2))))
	    )

	)))).lambda()),

    transpose := self >> self,
    isSymmetric := self >> true,

));

Class(Str_DCT2_Perm_tspl, TaggedNonTerminal, rec(

    abbrevs := [(k)      -> [k]],

    dims := self >> [ 2^self.params[1], 2^self.params[1] ],

    terminate := self >> let(k := self.params[1],
	    Compose(List([0..(k-2)], i-> let(rsize := 2^k - 2^(k-i),
            DirectSum(I(2^(k-i)),
                Tensor(I(rsize/4), DirectSum(I(2), J(2)))
            ) *
            Tensor(I(2^i), L(2^(k-i), 2^(k-i-1)))
	    )
        ))
    ),

    isReal := self >> true,

    print := meth(self, indent, indentStep)
        local lparams, mparams;
        if not IsBound(self.params) then Print(self.name); return; fi;
        Print(self.name, "(");
        if IsList(self.params) then
            lparams := Filtered(self.params, i->not (IsList(i) and i=[]));
            mparams := Filtered(lparams, i->not (IsBool(i) and not i));
            DoForAllButLast(mparams, x -> Print(x, ", "));
            Print(Last(mparams));
        else
            Print(self.params);
        fi;
    Print(")", When(self.transposed, ".transpose()", ""));
    end,

));

Str_DCT2_M := (n,s) -> let(l := Ind(n/2), TTensorInd(COND(eq(imod(l, 2^s), 0), I(2), Mat([[1,0],[-1,1]])), l, APar, APar));

Str_DCT2_H := (n,s) -> let(k := Log2Int(n), l := Ind(n/4), Cond(s=0, I(n), TTensorInd(COND(eq(imod(l, 2^(s-1)),0), I(4), Mat([[1,0,0,0],[0,0,0,1],[0,0,1,0],[0,1,0,0]])), l, APar, APar)));

#Sc_DCT2_func := (N) -> List([0..N-1], m-> List([0..N-1], n-> ((Sqrt(2/N) * Cond(m=0, 1/Sqrt(2), 1) * CosPi(m*(n+1/2)/N)))));
Sc_DCT2_func := (N) -> List([0..N-1], m-> List([0..N-1], n-> (Cond(m=0, 1/Sqrt(2), 1) * CosPi(m*(n+1/2)/N))));

NewRulesFor(Sc_DCT2, rec(
    Sc_DCT2_Stream := rec(
        forTransposition := false,
        applicable := (self, nt) >> nt.params[1] > 4 and nt.isTag(1, AStream) and nt.firstTag().bs >= 4,
        children := (self, t) >> let(
            n := t.params[1],
            k := Log2Int(n),
            [[ TCompose(Concatenation(
                  [TPrm(Str_DCT2_Perm(k))],
                  Reversed(List([1..k-1], s-> TCompose([Str_DCT2_M(n, s), TDiag(fPrecompute(Str_Sc_DCT2_Diag(k, s))), Str_DCT2_H(n, s), TTensorI(F(2), n/2, APar, APar), TTensorI(TPrm(L(2^(s+1), 2^s)), 2^(k-s-1), APar, APar),
#TL(2^(s+1), 2^s, 2^(k-s-1), 1)
]))),
                  [TDiag(fPrecompute(Str_Sc_DCT2_Diag(k, 0))), TTensorI(F(2), n/2, APar, APar), TPrm(Had(n))])).withTags(t.getTags())
            ]]
         ),

        apply := (t,c,nt) -> c[1],
    )
));

NewRulesFor(TDCT2, rec(
    DCT2_Stream := rec(
        forTransposition := false,
        applicable := (self, nt) >> nt.params[1] > 4 and nt.isTag(1, AStream) and nt.firstTag().bs >= 4,
        children := (self, t) >> let(
            n := t.params[1],
            k := Log2Int(n),
            [[ TCompose(Concatenation(
                  [Cond(t.firstTag().bs = t.params[1],
			  TPrm(Str_DCT2_Perm(k)),
			  TPrm(Str_DCT2_Perm_tspl(k))
		      )
		      ],
                  Reversed(List([1..k-1], s-> TCompose([Str_DCT2_M(n, s), TDiag(fPrecompute(Str_DCT2_Diag(k, s))), Str_DCT2_H(n, s), TTensorI(F(2), n/2, APar, APar), TTensorI(TPrm(L(2^(s+1), 2^s)), 2^(k-s-1), APar, APar),
]))),
                  [TDiag(fPrecompute(Str_DCT2_Diag(k, 0))), TTensorI(F(2), n/2, APar, APar), TPrm(Had(n))])).withTags(t.getTags())
            ]]
         ),

        apply := (t,c,nt) -> c[1],
    )
));


InstallMethod(ParabolicSystem,
              "Roots of standard parabolic",
              [IsRootSystem,IsList],
              function(R,I)
              local P,graph,order,i_levels;
              P:=Objectify(NewType(NewFamily("ParabolicSystemFamily"),
                                   IsAttributeStoringRep and
                                   IsParabolicSystem),
                           rec());
              SetUnderlyingRootSystem(P,R);
              SetSupportRoots(P,I);
              SetRadicalRoots(P,Filtered(positiveRoots(R),i->InRadical(P,i)));
              SetiRadicalRoots(P,List(RadicalRoots(P),i->Position(positiveRoots(R),i)));
              SetHeight(P,Maximum(List([1..Length(positiveRoots(R))],i->RootHeight(P,i))));
              SetLevels(P,List([1..Height(P)],i->Filtered(positiveRoots(R),j->RootHeight(P,j)=i)));
              i_levels:=List([1..Height(P)],i->Filtered([1..Length(positiveRoots(R))],j->RootHeight(P,positiveRoots(R)[j])=i));
              SetiLevels(P,i_levels);
              i_levels:=Concatenation(i_levels);
              Set0Level(P,Filtered([1..Length(positiveRoots(R))],i->not i in i_levels));
              SetShapes(P,Set(List(positiveRoots(R),i->Shape(P,i))));
              SetLeviModules(P,List(Levels(P),i->Set(List(i,j->LeviModule(P,j)))));
              SetiLeviModules(P,List(iLevels(P),i->Set(List(i,j->iLeviModule(P,j)))));
              SetName(P,Concatenation("<parabolic of ",
                                      SemiSimpleType(UnderlyingLieAlgebra(R)),
                                      " root system with support in ",
                                      String(I),">"));

              order:=function(P)
                  local levels,result,lung,i;
                  levels:=Concatenation(iLevels(P));
                  lung:=Length(levels);
                  result:=List([1..lung],i->0);
                  for i in [1..lung] do
                      result[levels[i]]:=i;
                  od;
                  return result;
              end;

              SetOrdering(P,order(P));

#              SetRootGraph(P,graph(P));

              return P;
end);

InstallMethod(Shape,
              "Shape of root",
              [IsParabolicSystem,IsList],
              function(P,root_coeffs)
              local I;
              if not root_coeffs in positiveRoots(UnderlyingRootSystem(P)) then Error("Vector not in root system. "); fi;
              I:=SupportRoots(P);
              return root_coeffs{Filtered([1..Length(root_coeffs)],i->not i in I)};
end);

InstallMethod(Shape,
              "Shape of root",
              [IsParabolicSystem,IsPosInt],
              function(P,root_index)
              if not root_index in [1..Length(positiveRoots(UnderlyingRootSystem(P)))] then Error("Not a root index. "); fi;
              return Shape(P,positiveRoots(UnderlyingRootSystem(P))[root_index]);
end);

InstallMethod(LeviModule,
              "Levi module (vectors) for root vector",
              [IsParabolicSystem,IsList],
              function(P,root_coeffs)
              local I,s;
              if not root_coeffs in positiveRoots(UnderlyingRootSystem(P)) then Error("Vector not in root system. "); fi;
              I:=SupportRoots(P);
              s:=Shape(P,root_coeffs);
              return Filtered(positiveRoots(UnderlyingRootSystem(P)),i->Shape(P,i)=s);
end);

InstallMethod(LeviModule,
              "Levi module (vectors) for root index",
              [IsParabolicSystem,IsPosInt],
              function(P,root_index)
              if not root_index in [1..Length(positiveRoots(UnderlyingRootSystem(P)))] then Error("Not a root index. "); fi;
              return LeviModule(P,positiveRoots(UnderlyingRootSystem(P)[root_index]));
end);

InstallMethod(iLeviModule,
              "Levi module (vectors) for root vector",
              [IsParabolicSystem,IsList],
              function(P,root_coeffs)
              local I,s;
              if not root_coeffs in positiveRoots(UnderlyingRootSystem(P)) then Error("Vector not in root system. "); fi;
              I:=SupportRoots(P);
              s:=Shape(P,root_coeffs);
              return Filtered([1..Length(positiveRoots(UnderlyingRootSystem(P)))],i->Shape(P,i)=s);
end);

InstallMethod(iLeviModule,
              "Levi module (indices) for root vector",
              [IsParabolicSystem,IsPosInt],
              function(P,root_index)
              if not root_index in [1..Length(positiveRoots(UnderlyingRootSystem(P)))] then Error("Not a root index. "); fi;
              return iLeviModule(P,positiveRoots(UnderlyingRootSystem(P))[root_index]);
end);

InstallMethod(LeviModules,
              "Levi modules at a given height",
              [IsParabolicSystem,IsPosInt],
              function(P,i)
              if i > Height(P) then return []; fi;
              return Filtered(LeviModules(P),j->RootHeight(P,j[1])=i);
end);

InstallMethod(iLeviModules,
              "Levi modules at a given height",
              [IsParabolicSystem,IsPosInt],
              function(P,i)
              if i > Height(P) then return []; fi;
              return Filtered(iLeviModules(P),j->RootHeight(P,j[1])=i);
end);

InstallMethod(RootHeight,
              "the level of a root",
              [IsParabolicSystem,IsList],
              function(P,root_coeffs)
              return Sum(Shape(P,root_coeffs));
end);

InstallMethod(RootHeight,
              "the level of a root",
              [IsParabolicSystem,IsPosInt],
              function(P,root_index)
              return Sum(Shape(P,root_index));
end);

InstallMethod(Level,
              "roots at level",
              [IsParabolicSystem,IsPosInt],
              function(P,i)
              if i > Height(P) then return []; fi;
              return Levels(P)[i];
end);

InstallMethod(InRadical,
              "Check for root in radical",
              [IsParabolicSystem,IsList],
              function(P,root_coeffs)
              if not root_coeffs in positiveRoots(UnderlyingRootSystem(P)) then Error("Vector not in root system. "); fi;
              return Length(Filtered([1..Length(root_coeffs)],i->not i in SupportRoots(P) and root_coeffs[i]<>0))>0;
end);


#
# usage:
# Read("~/Workspace/Chevalley.gap/init.gi"); Read(Filename(home_dir,"load.gi")); Read(Filename(f4_dir_char3,"_init_char3.gi")); Read(Filename(f4_dir_char3,"B2.gi"));
#
# Read(Filename(f4_dir_char3,"B2.gi"));
#

label:="B_2";
orb_nr:=Position(labels,label);
#orb:=AllClasses(orbs)[9];
orb:=AllClasses(orbs)[orb_nr];
info:=infos[orb_nr];

#
# ------------------------------------------------------------------------
#

Print("Consider the class ",Label(orb)," in characteristic ",Characteristic(ring(sys)),":\n");
Print("\tBorel representative \n\t",coefficients(BorelRep(orb)),"\n");
Print("\tconnected C_U(u) \n\t",coefficients(info[1]),"\n");
Print("\tconnected double C_U(u) in Levi \n\t",coefficients(info[2]),"\n");
Print("\tconnected double C_U(u) \n\t",coefficients(info[3]),"\n");

Z0:=info[2];
# move Z0 to match the representative
Z0:=FromPositiveBorel(orb,Z0);
# adjust ordering of roots
Z0:=Unipotent(chevalleyAdj(Z0),coefficients(Z0),[1..Length(positiveRoots(sys))]);
Print("Z0 in position of Representative:\n\tZ0=",coefficients(Z0),"\n");

Print("Component group is C2.\n");
Print("On Z0:\n");
n:=[9];
aZ0:=ApplyRootsReflections(Z0,n);
aZ0:=ConjugateByTorus(aZ0,4,-1);

Print("\ta^Z0=",coefficients(aZ0),"\n");

#
# ------------------------------------------------------------------------
#

tmp:=handle9char3();
Print("\nComponent group is check:\n");
Print("\ta^u= \n",coefficients(tmp[1]),"\n");
Print("\tconnected center= \n",coefficients(tmp[2]),"\n");


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

Declare(PrunedMDPRDFT);
Declare(PrunedIMDPRDFT);

# Same as (floor(n_t/2)+1)*2.
# RClength := (n) -> (n + 1) mod 2 + n + 1;
RClength := (n) -> PRDFT1(n).dims()[1];

IJmatrix := (n) -> DirectSum(I(1), J(n-1));

tensorIJmatrix := (l) -> When(Length(l) > 0,
                         Tensor(IJmatrix(l[1]), tensorIJmatrix(Drop(l, 1))),
                         Diag([1, -1]));

# Distinct(list) means the elements of list are distinct.
Distinct := (l) -> (Length(l) = Length(Set(l)));

# pairup takes two lists of the same length,
# returns list of ordered pairs with elements of first and second.
pairup := (l1, l2) -> When(Length(l1)=0,
                           [],
                           Concat([ [l1[1], l2[1]] ],
                                  pairup(Drop(l1, 1),
                                         Drop(l2, 1))));

#F PrunedMDPRDFT(<dims>, <pat>, [<exp>=1])
#F Pruned multi-dimensional PRDFT (packed real DFT) non-terminal
#F   dims = [ <n_1>, ..., <n_t> ] list of (positive) dimensions
#F   pat = [ <l_1>, ..., <l_t> ] lists l_i having distinct elements in 0..n_i
#F   exp = root of unity exponent scaling (see DFT for exact definition)
#F
#F Definition : multidimensional matrix of size M x N, where
#F M = n_1*...*n_{t-1}*(floor(n_t/2)+1)*2
#F N = Length(l_1)*..*Length(l_t)
#F This matrix has real components, for an operator with
#F N real inputs,
#F M real outputs for interleaved real and imaginary components.
#F
#F Example (direct)  : MDPRDFT([4,5,6], [[0..3], [2..4], [5, 3, 1]])
#F Example (inverse) : MDPRDFT([4,5,6], [[0..3], [2..4], [5, 3, 1]], -1)
#F
#F In last dimension, t: real-to-complex DFT;
#F then dimensions t-1, ..., 1: complex-to-complex DFT.
#F

# To verify that components of m are real:
# Im(MatSPL(m)) = MatSPL(ApplyFunc(O, m.dims()));

Class(PrunedMDPRDFT, TaggedNonTerminal, rec(
    a_lengths := self >> self.params[1],
    a_pat := self >> self.params[2],
    a_exp := self >> self.params[3],

    abbrevs := [
        (L, pat)    -> Checked(IsList(L),
                               ForAll(L, IsPosInt),
                               ForAll(L, e->e > 1),
                               IsList(pat),
                               Length(pat) = Length(L),
                               ForAll(pat, IsList),
                               # Elements of pat[d] are distinct and in 0..L[d]-1.
                               ForAll(pat, Distinct),
                               Minimum(List(pat, Minimum)) >= 0,
                               ForAll(L - List(pat, Maximum), IsPosInt),
                               [ L, pat, 1 ]),
        (L, pat, k) -> Checked(IsList(L),
                               ForAll(L, IsPosInt),
                               ForAll(L, e->e > 1),
                               IsList(pat),
                               Length(pat) = Length(L),
                               ForAll(pat, IsList),
                               ForAll(pat, Distinct),
                               # Elements of pat[d] are distinct and in 0..L[d]-1.
                               Minimum(List(pat, Minimum)) >= 0,
                               ForAll(L - List(pat, Maximum), IsPosInt),
                               IsInt(k),
                               Gcd(Product(L), k) = 1,
                               [ L, pat, k mod Product(L) ])
        ],

    # dims() has 2 components, counting outputs and inputs:
    # dims()[1] is product of all but last dimension, and RClength on last.
    # dims()[2] is product of all lengths of pattern components.
    dims := self >> let(a_lengths := self.a_lengths(),
                        a_pat := self.a_pat(),
                        [Product(DropLast(a_lengths, 1)) *
                         RClength(Last(a_lengths)),
                         Product(List(a_pat, Length))
                        ]),

     # Just pad pat[d] with zeroes to fill 0..lengths[d]-1,
     # and then call MDPRDFT.  But would that be too simple?
     # It's the terminate function, not a Rule, so maybe OK?
terminate := self >>  let(
        a_lengths := self.a_lengths(),
        a_pats := self.a_pat(),
        a_exp := self.a_exp(),
        mdprdft := MDPRDFT(a_lengths, a_exp),
        lenpatpairs := pairup(a_lengths, a_pats),
        lv := List(lenpatpairs, lp->HStack(List(lp[2], e->Scat(fBase(lp[1], e))))),
        tlv := mdprdft * Tensor(lv),
        tlv),

    transpose := self >> PrunedIMDPRDFT(self.a_lengths(), self.a_pat(), -self.a_exp()),

    isReal := True,

    normalizedArithCost :=  (self) >> let(n := Product(self.a_lengths()),
                                        IntDouble(2 * n * d_log(n) / d_log(2)) )
));

#F PrunedIMDPRDFT(<dims>, <pat>, [<exp>=1])
#F Pruned multi-dimensional inverse PRDFT (packed real DFT) non-terminal
#F   dims = [ <n_1>, ..., <n_t> ] list of (positive) dimensions
#F   pat = [ <l_1>, ..., <l_t> ] lists l_i having distinct elements in 0..n_i
#F   exp = root of unity exponent scaling (see DFT for exact definition)
#F
#F Definition : multidimensional matrix of size N x M, where
#F N = Length(l_1)*..*Length(l_t)
#F M = n_1*...*n_{t-1}*(floor(n_t/2)+1)*2
#F This matrix has real components, for an operator with
#F M real inputs for interleaved real and imaginary components,
#F N real outputs.
#F
#F Example (direct)  : IMDPRDFT([4,5,6], [[0..3], [2..4], [5, 3, 1]])
#F Example (inverse) : IMDPRDFT([4,5,6], [[0..3], [2..4], [5, 3, 1]], -1)
#F
#F In dimensions 1, ..., t-1: complex-to-complex DFT;
#F then in last dimension, t: complex-to-real DFT.
#F

Class(PrunedIMDPRDFT, TaggedNonTerminal, rec(
    a_lengths := self >> self.params[1],
    a_pat := self >> self.params[2],
    a_exp := self >> self.params[3],

    abbrevs := [
        (L, pat)    -> Checked(IsList(L),
                               ForAll(L, IsPosInt),
                               ForAll(L, e->e > 1),
                               IsList(pat),
                               Length(pat) = Length(L),
                               ForAll(pat, IsList),
                               # Elements of pat[d] are distinct and in 0..L[d]-1.
                               ForAll(pat, Distinct),
                               Minimum(List(pat, Minimum)) >= 0,
                               ForAll(L - List(pat, Maximum), IsPosInt),
                               [ L, pat, 1 ]),
        (L, pat, k) -> Checked(IsList(L),
                               ForAll(L, IsPosInt),
                               ForAll(L, e->e > 1),
                               IsList(pat),
                               Length(pat) = Length(L),
                               ForAll(pat, IsList),
                               ForAll(pat, Distinct),
                               # Elements of pat[d] are distinct and in 0..L[d]-1.
                               Minimum(List(pat, Minimum)) >= 0,
                               ForAll(L - List(pat, Maximum), IsPosInt),
                               IsInt(k),
                               Gcd(Product(L), k) = 1,
                               [ L, pat, k mod Product(L) ])
        ],

    # dims() has 2 components, counting outputs and inputs:
    # dims()[1] is product of all lengths of pattern components.
    # dims()[2] is product of all but last dimension, and RClength on last.
    dims := self >> let(a_lengths := self.a_lengths(),
                        a_pat := self.a_pat(),
                        [Product(List(a_pat, Length)),
                         Product(DropLast(a_lengths, 1)) *
                         RClength(Last(a_lengths))
                        ]),

     # Just call IMDPRDFT and then prune in each dimension according to pat.
     # It's the terminate function, not a Rule, so maybe OK?
terminate := self >>  let(
        a_lengths := self.a_lengths(),
        a_pats := self.a_pat(),
        a_exp := self.a_exp(),
        imdprdft := IMDPRDFT(a_lengths, a_exp),
        lenpatpairs := pairup(a_lengths, a_pats),
        lv := List(lenpatpairs, lp->VStack(List(lp[2], e->Gath(fBase(lp[1], e))))),
        tlv := Tensor(lv) * imdprdft,
        tlv),

    transpose := self >> PrunedMDPRDFT(self.a_lengths(), self.a_pat(), -self.a_exp()),

    isReal := True,

    normalizedArithCost :=  (self) >> let(n := Product(self.a_lengths()),
                                        IntDouble(2 * n * d_log(n) / d_log(2)) )
));


Hanoi := function(n)
	local move;
	move := function(n, a, b, c) # from, through, to
		if n = 1 then
			Print(a, " -> ", c, "\n");
		else
			move(n - 1, a, c, b);
			move(1, a, b, c);
			move(n - 1, b, a, c);
		fi;
	end;
	move(n, "A", "B", "C");
end;

Hanoi(1);
# A -> C

Hanoi(2);
# A -> B
# A -> C
# B -> C

Hanoi(3);
# A -> C
# A -> B
# C -> B
# A -> C
# B -> A
# B -> C
# A -> C


InstallMethod(Witt,
              "Constructor for Witt Structure",
              [IsPosInt,IsAlgebraicU],
              function(dim,sys)
              local object,
              BPR,xvarnames,yvarnames,xvars,
              p,max_level,generic_poly;

              object:=Objectify(NewType(NewFamily("WittFamily"),
                                        IsAttributeStoringRep and
                                        IsWitt),
                                rec());

              SetDimension(object,dim);
              SetCharacteristic(object,Characteristic(sys));

              SetalgebraicU(object,sys);

              xvarnames:=List([1..dim],i->Concatenation("x_",String(i)));
              yvarnames:=List([1..dim],i->Concatenation("y_",String(i)));
              BPR:=PolynomialRing(ring(sys),Concatenation(xvarnames,yvarnames));
              xvars:=IndeterminatesOfPolynomialRing(BPR){[1..dim]};

              SetchevalleyAdjBPR(object,ChevalleyAdj(sys,BPR));

              SetGenericSum(object,GenericSumOp(object));# this needs to be set after Characteristic

              p:=Characteristic(sys);

              #max_level:=Maximum(List(positiveRoots(simpleAdj(sys)),i->Sum(i)));
              max_level:=20;
              generic_poly:=function(degree)
                  local result,
                  tuples,tuple_degreeP;

                  tuple_degreeP:=function(t)
                      return Sum(List([1..Length(t)],i->t[i]*p^(i-1)));
                  end;

                  #tuples:=Tuples([1..dim+1]-1,dim);
                  tuples:=Tuples([1..max_level]-1,dim);
                  tuples:=Filtered(tuples,i->tuple_degreeP(i)=degree);
                  tuples:=List(tuples,t->List([1..dim],i->xvars[i]^t[i]));
                  tuples:=List(tuples,t->Product(t));

                  return tuples;
              end;
              #SetGenericLevelPolynomials(object,List([1..max_level],i->generic_poly(i)));

              generic_poly:=function(level)
                  local result,
                  i,Unu,tmp;

                  if level=0 then return [List([1..dim],i->0)]; fi;
                  if level<0 then return []; fi;

                  Unu:=DiagonalMat(List([1..dim],i->1));

                  result:=[];
                  for i in [1..dim] do
                      tmp:=generic_poly(level-p^(i-1));
                      if tmp<>[] then
                          result:=Concatenation(result,List(tmp,j->j+Unu[i]));
                      fi;
                  od;

                  tmp:=[];
                  for i in result do
                      if not i in tmp then
                          tmp:=Concatenation(tmp,[i]);
                      fi;
                  od;

                  return tmp;#result;
              end;
              SetGenericLevelPolynomials(object,List([1..max_level],
                                                     i->List(generic_poly(i),
                                                             j->Product([1..dim],
                                                                        k->xvars[k]^j[k]))));

              SetName(object,Concatenation("<witt structure of dimension ",String(dim),
                                           " over ring of characteristic ",String(p),">"));
              return object;
end);

InstallMethod(GenericSumOp,
              "Polynomials for generic sum in the Witt structure",
              [IsWitt],
              function(w)
              local result,
              p,dim,phiX,phiY,psiXY,phiXY,
              localIPR,Xvarnames,Yvarnames,X,Y,ext_reps,
              BPR,xyvars,i,j,k,poly,monom,pos;

              dim:=Dimension(w);
              p:=Characteristic(w);
              BPR:=ring(chevalleyAdjBPR(w));

              Xvarnames:=List([1..dim],i->Concatenation("X",String(i)));
              Yvarnames:=List([1..dim],i->Concatenation("Y",String(i)));
              localIPR:=PolynomialRing(Integers,Concatenation(Xvarnames,Yvarnames));
              X:=IndeterminatesOfPolynomialRing(localIPR){[1..dim]};
              Y:=IndeterminatesOfPolynomialRing(localIPR){dim+[1..dim]};

              phiX:=List([1..Length(X)],i->Sum(List([1..i],j->p^(j-1)*X[j]^(p^(i-j)))) );
              phiY:=List([1..Length(Y)],i->Sum(List([1..i],j->p^(j-1)*Y[j]^(p^(i-j)))) );

              psiXY:=[];
              phiXY:=phiX+phiY;

              for i in [1..Length(phiXY)] do
                  psiXY:=Concatenation(psiXY,[(1/p^(i-1))*(phiXY[i]-Sum(List([1..i-1],j->p^(j-1)*psiXY[j]^(p^(i-j)))))]);
              od;

              ext_reps:=List(Concatenation(X,Y),i->ExtRepPolynomialRatFun(i));
              ext_reps:=List(ext_reps,i->i[1][1]);

              xyvars:=IndeterminatesOfPolynomialRing(BPR);
              psiXY:=List(psiXY,i->List(ExtRepPolynomialRatFun(i)));
              result:=[];
              for i in [1..Length(psiXY)] do
                  poly:=Zero(BPR);
                  for j in [1..Length(psiXY[i])/2] do
                      monom:=One(BPR);
                      for k in [1..Length(psiXY[i][2*j-1])/2] do
                          pos:=Position(ext_reps,psiXY[i][2*j-1][2*k-1]);
                          monom:=monom*xyvars[pos]^psiXY[i][2*j-1][2*k];
                      od;
                      monom:=monom*psiXY[i][2*j];
                      poly:=poly+monom;
                  od;
                  Add(result,poly);
              od;

              return result;

    # adjust the form to the one I need
#    psiXY_:=List([1..dim],i->psiXY[i]-X[i]-Y[i]);
end);


InstallMethod(UnipotentClass,
              "Unipotent conjugacy class in algebraic group",
              [IsString,IsUnipotent,IsList,IsList],
              function(label,u,torus,parabolics)
              local object,
              sys,permute_rep,exp;

              Print(label,"\n");

              object:=Objectify(NewType(NewFamily("UnipotentClassFamily"),
                                        IsAttributeStoringRep and
                                        IsUnipotentClass),
                                rec());

              sys:=chevalleyAdj(u);
              SetalgebraicU(object,sys);
              SetLabel(object,label);
              SetRepresentative(object,u);

#              permute_rep:=function(rep,torus)
#                  local result,signs,pr,perm,perm_matrix;
#
#                  perm:=PositiveTorusPermutation(rootSystem(sys),torus);
#                  perm_matrix:=Inverse(PermutationMatrix(weylGroup(sys),perm));
#                  pr:=positiveRoots(sys);
#
#                  #result:=List(rep,j->perm_matrix*pr[j[1]]);
#                  result:=List(rep,j->pr[j[1]]*perm_matrix);
#                  signs:=List(rep,j->PermutationSign(sys,perm,pr[j[1]]));
#                  #Print(List([1..Length(result)],j->[Position(pr,result[j]),signs[j]*rep[j][2]]));
#                  return List([1..Length(result)],j->[Position(pr,result[j]),signs[j]*rep[j][2]]);
#              end;

              if torus <> [] then
                  SetCocharacter(object,torus);
                  SetBorelPerm(object,PositiveTorusPermutation(rootSystem(sys),torus));
                  #SetBorelRep(object,Unipotent(sys,permute_rep(coefficients(u),torus)));# !!! Verifica asta
                  #SetBorelRep(object,Unipotent(sys,permute_rep(coefficients(u),torus),
                  #                             [1..Length(positiveRoots(sys))]));# !!! Verifica asta
                  SetBorelRep(object,Unipotent(sys,coefficients(ToPositiveBorel(object,u)),
                                               [1..Length(positiveRoots(sys))]));# !!! Verifica asta
                  SetOrder(BorelRep(object),Order(u));
              fi;

              if parabolics <> [[],[]] then
                  SetSupportParabolic(object,ParabolicSystem(rootSystem(sys),parabolics[1]));
                  SetDistinguishedParabolic(object,ParabolicSystem(rootSystem(sys),parabolics[2]));
              fi;

              if HasOrder(u) then SetOrder(object,Order(u)); fi;
#              elif Characteristic(sys)>0 then SetOrder(object,OrderOp(u)); fi; This can take to much time

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

InstallMethod(ToPositiveBorel,
              "Permutes root to positive Borel subgroup with the cocharacter",
              [IsUnipotentClass,IsPosInt],
              function(orb,root_index)
              local sys,perm,perm_mat,pr,roots;

              sys:=algebraicU(orb);
              perm:=PositiveTorusPermutation(rootSystem(sys),Cocharacter(orb));
              perm_mat:=Inverse(PermutationMatrix(weylGroup(sys),perm));
              pr:=positiveRoots(sys);
              roots:=allRoots(sys);

              #return Position(pr,perm_mat*roots[root_index]);
              return Position(pr,roots[root_index]*perm_mat);
end);

InstallMethod(ToPositiveBorel,
              "Permutes roots (in roots_index) to positive Borel subgroup with the cocharacter",
              [IsUnipotentClass,IsList],
              function(orb,roots_index)
              return List(roots_index,i->ToPositiveBorel(orb,i));
end);

InstallMethod(FromPositiveBorel,
              "Permutes root from positive Borel subgroup with the cocharacter",
              [IsUnipotentClass,IsPosInt],
              function(orb,root_index)
              local sys,perm,perm_mat,pr,roots;

              sys:=algebraicU(orb);
              perm:=PositiveTorusPermutation(rootSystem(sys),Cocharacter(orb));
              perm_mat:=Inverse(PermutationMatrix(weylGroup(sys),Reversed(perm)));
              #perm_mat:=PermutationMatrix(weylGroup(sys),perm);
              pr:=positiveRoots(sys);
              roots:=allRoots(sys);

              #return Position(pr,perm_mat*roots[root_index]);
              return Position(pr,roots[root_index]*perm_mat);
end);

InstallMethod(FromPositiveBorel,
              "Permutes roots (in roots_index) from positive Borel subgroup with the cocharacter",
              [IsUnipotentClass,IsList],
              function(orb,roots_index)
              return List(roots_index,i->FromPositiveBorel(orb,i));
end);

InstallMethod(ToPositiveBorel,
              "Permutes roots (in roots_index) from positive Borel subgroup with the cocharacter",
              [IsUnipotentClass,IsUnipotent],
              function(orb,u)
              local result,coeffs,sys,signs,pr,perm,perm_matrix;

              sys:=chevalleyAdj(u);

              perm:=BorelPerm(orb);
              #perm_matrix:=Inverse(PermutationMatrix(weylGroup(sys),perm));
              perm_matrix:=PermutationMatrix(weylGroup(sys),Reversed(perm));
              pr:=positiveRoots(sys);

              coeffs:=coefficients(u);
              result:=List(coeffs,j->pr[j[1]]*perm_matrix);
              signs:=List(coeffs,j->InversePermutationSign(sys,perm,pr[j[1]]));
              result:=List([1..Length(result)],j->[Position(pr,result[j]),signs[j]*coeffs[j][2]]);
####              result:=List([1..Length(result)],j->[Position(pr,result[j]),coeffs[j][2]]);
#Print(result,"\n");
              if Filtered(result,i->i[1]=fail)<>[] then return fail; fi;

              result:=Unipotent(sys,result);#,Ordering(u));
              if HasOrder(u) then SetOrder(result,Order(u)); fi;

              return result;
end);

InstallMethod(FromPositiveBorel,
              "Permutes roots (in roots_index) from positive Borel subgroup with the cocharacter",
              [IsUnipotentClass,IsUnipotent],
              function(orb,u)
              local result,coeffs,sys,signs,pr,perm,perm_matrix;

              sys:=chevalleyAdj(u);

              perm:=BorelPerm(orb);
              #perm_matrix:=Inverse(PermutationMatrix(weylGroup(sys),perm));
              #perm_matrix:=Inverse(PermutationMatrix(weylGroup(sys),Reversed(perm)));
              perm_matrix:=PermutationMatrix(weylGroup(sys),perm);
              pr:=positiveRoots(sys);

              coeffs:=coefficients(u);
              result:=List(coeffs,j->pr[j[1]]*perm_matrix);
              signs:=List(coeffs,j->PermutationSign(sys,perm,pr[j[1]]));
              result:=List([1..Length(result)],j->[Position(pr,result[j]),signs[j]*coeffs[j][2]]);
####              result:=List([1..Length(result)],j->[Position(pr,result[j]),coeffs[j][2]]);

              if Filtered(result,i->i[1]=fail)<>[] then return fail; fi;

              result:=Unipotent(sys,result);#,Ordering(u));
              if HasOrder(u) then SetOrder(result,Order(u)); fi;

              return result;
end);

#
# ---------- Overclass for classes --------
#

InstallMethod(UnipotentClasses,
              "Over class for unipotent orbits of a simple algebraic group",
              [IsAlgebraicU,IsString],
              function(sys,source)
              local object,
              pr_len,p,
              APR,avarnames,
              file,dir,reps,exps,
              rep,root;

              object:=Objectify(NewType(NewFamily("UnipotentClassesFamily"),
                                        IsAttributeStoringRep and
                                        IsUnipotentClasses),
                                rec());

              SetalgebraicU(object,sys);
              p:=Characteristic(sys);

              dir:=data_dir;
              if type(sys) in ["B","C","D","E","F","G"] and p = 2 or
                 type(sys) in ["E","F","G"] and p = 3 or
                 type(sys) = "E" and rank(sys) = 8 and p = 5 then
#              if type(sys) in ["B","C","D","F"] and p = 2 or
#                 type(sys) = "E" and rank(sys) in [7,8] and p = 2 or
#                 type(sys) in ["E","G"] and rank(sys) in [2,8] p = 3 or
                   file:=Concatenation("data",type(sys),String(rank(sys)),"char",String(p),source,".gi");
              Print(file,"\n");
#                   if source then file:=Concatenation("data",type(sys),String(rank(sys)),"char",String(p),"Mizuno.gi");
#                   else file:=Concatenation("data",type(sys),String(rank(sys)),"char",String(p),".gi"); fi;
              else file:=Concatenation("data",type(sys),String(rank(sys)),".gi"); fi;
              file:=Filename(dir,file);
              file:=ReadAsFunction(file);
              file:=file();

              if file[6]=[] then file[6]:=List([1..Length(file[1])],i->-1); fi;# if Orders not given then compute them
              reps:=List([1..Length(file[1])],i->Unipotent(sys,file[1][i],file[6][i]));
              if file[7]<>[] then
                  for rep in [1..Length(reps)] do
                      SetAduJordanBlocks(reps[rep],file[7][rep]);
                  od;
              fi;

              if p<>0 then
                  exps:=List(reps,i->LogInt(Order(i),p));
                  SetWittStructure(object,Witt(Maximum(exps),sys));
              fi;

              SetAllClasses(object,List([1..Length(file[1])],i->UnipotentClass(#witt_structures[exp[i]],
                  file[3][i],
                  reps[i],
                  file[2][i],
                  [file[4][i],file[5][i]])));

              SetName(object,Concatenation("<unipotent conjugacy classes ",type(sys),String(rank(sys)),
                                           " in characteristic ",String(Characteristic(sys)),">"));

              return object;
end);


#############################################################################
##
##  Functions.gi        JConvex package
##                      Martin Bies
##
##  Copyright 2021      University of Pennsylvania
##
##  A Gap package to do convex geometry by Polymake
##
##  Chapter: Polytopes
##
#############################################################################

####################################
##
##  Attributes of polyopes
##
####################################

InstallMethod( ExternalPolymakePolytope,
               "for polyopes",
               [ IsPolytope ],
    function( poly )

    if IsBound( poly!.input_points ) then
        return Polymake_PolytopeByGenerators( poly!.input_points );
    fi;

    # otherwise our fallback is poly from inequalities
    return Polymake_PolytopeFromInequalities( poly!.input_ineqs );

end );

InstallMethod( VerticesOfPolytope,
               "for polyopes",
               [ IsPolytope ],
  function( poly )

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

end );

InstallMethod( DefiningInequalities,
               "for polyopes",
               [ IsPolytope ],
  function( poly )
    local ineqs, eqs;

    ineqs := Polymake_Inequalities( ExternalPolymakePolytope( poly ) );
    eqs := Polymake_Equalities( ExternalPolymakePolytope( poly ) );
    return Set( Concatenation( eqs, (-1) * eqs, ineqs ) );

end );

InstallMethod( FacetInequalities,
               " for external polyopes",
               [ IsExternalPolytopeRep ],
  function( poly )

    return Polymake_Inequalities( ExternalPolymakePolytope( poly ) );

end );

InstallMethod( IsBounded,
               " for external polyopes.",
               [ IsPolytope ],
    function( poly )

    return Polymake_IsBounded( ExternalPolymakePolytope( poly ) );

end );

InstallMethod( LatticePoints,
               [ IsPolytope ],
    function( poly )

    return Polymake_LatticePoints( ExternalPolymakePolytope( poly ) );

end );

InstallMethod( Dimension,
               [ IsPolytope ],
    function( poly )

    return Polymake_Dimension( ExternalPolymakePolytope( poly ) );

end );

InstallMethod( IntersectionOfPolytopes,
               [ IsPolytope, IsPolytope ],
  function( poly1, poly2 )
    local poly, ext_polytope;

    if not Rank( ContainingGrid( poly1 ) ) = Rank( ContainingGrid( poly2 ) ) then
        Error( "polytopes are not of the same dimension" );
    fi;

    # compute the intersection
    ext_polytope:= Polymake_Intersection( ExternalPolymakePolytope( poly1 ), ExternalPolymakePolytope( poly2 ) );

    # find the generating vertices of this new polytope and construct the polytope
    # currently, this ignores the lineality space Polymake_Linealities( ext_polytope ) completely!
    poly := Polytope( Polymake_Vertices( ext_polytope ) );

    # set properties
    SetExternalPolymakePolytope( poly, ext_polytope );
    SetContainingGrid( poly, ContainingGrid( poly1 ) );
    SetAmbientSpaceDimension( poly, AmbientSpaceDimension( poly1 ) );

    # return the result
    return poly;

end );


# Determine images of the homomorphism between to a permutation group
# and a matrix groups both isomorphic to S_4.
G := Group((1, 2, 3, 4), (2, 3, 4));
H := Group([[0, -1, 0], [1, 0, 0], [0, 0, 1]], [[0, 1, 0], [0, 0, 1], [1, 0, 0]]);

hom := GroupHomomorphismByImages(G, H);

for g in G do
    l := [1..4];
    Apply(l, i -> String((i^g) - 1));
    w := Concatenation(l);
    image := Image(hom, g);
    Print(w, " ", image, "\n");
od;


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

Declare(TDST2, TDST3, TDST4);

_DST_CONST := 2.5;

#######################################################################################
#   tSPL DST rules

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

NewRulesFor(TDST4, rec(
    DST4_CT_tSPL := rec(
        switch := false,

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

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

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

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

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

#F TDST3(<n>) - Discrete Sine Transform, Type III, non-terminal
#F Definition: (n x n)-matrix [ sin((k-1/2)*l*pi/n) | k,l = 1...n ]
#F Note:       DST3 is the transpose of DST2
#F Example:    DST3(8)
#F Scaled variant (not supported) is:
#F                [ a_l*sin(k*(l-1/2)*pi/n) | k,l = 1...n ]
#F            with  a_j = 1/sqrt(2) for j = n and = 1 else.
Class(TDST3, TaggedNonTerminal, rec(
    abbrevs := [ N -> Checked(IsInt(N), N >= 1, [N]) ] ,
    dims := self >> [self.params[1], self.params[1]],
    isReal := True,
    terminate := self >> Mat(DST_IIIunscaled(self.params[1])),
    transpose := self >> TDST2(self.params[1]),
    SmallRandom := () -> Random([2,3,4,5,6,8,9,10,12,15,16,18,24,27,30,32]),
    normalizedArithCost := (self) >> let(n := self.params[1], IntDouble(_DST_CONST * n * d_log(n) / d_log(2)))
));

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


#
# Read("~/Workspace/groupsSB/epi/A2/handle.ext.gi");
#

type:="A";
rank:=2;
nr_pos_roots:=3;

Read("~/Workspace/groupsSB/epi/group.gi");

highest_weight:=[1,1];# corresponding highest weight module is the Lie algebra

Read("~/Workspace/groupsSB/epi/ext.gi");

handleReg:=function()
    local k,ua,ub,uab,u,e,h,h1,h2;
    k:=3; # power of exterior algebra
    ua:=ext_root_group(k,1,1);
    ub:=ext_root_group(k,2,1);
    uab:=ext_root_group(k,3,1/2); #p\neq 2
    u:=ua*ub*uab;
    #
    #uua:=ext_root_group(1,2);
    #uub:=ext_root_group(2,2);
    #uuab:=ext_root_group(3,2);
    #uu:=uua*uub*uuab;
    #
    id_mat:=u^0;
    e:=u-id_mat;

    ese:=Eigenspaces(Rationals,e)[1]; #eigenvalues 0, centralizer
    h1:=ext_e(k,cb0[7]);
    h2:=ext_e(k,cb0[8]);;
    h:=h1*h2;
    esh1:=Eigenspaces(Rationals,h);
    evh1:=Eigenvalues(Rationals,h);

    esh10:=[];
    index_ev0:=Position(evh1,0);
    esh10:=esh1[index_ev0];

    #
    # sum and intersection
    #
    si:=SumIntersectionMat(Basis(ese),Basis(esh10));
    inter:=si[2];
    return inter;
end;

#
# c_2=0
#
#handle2:=function()
#   local k,ua,ub,uab,u,e;
k:=3;
ua:=ext_root_group(k,1,1);
uab:=ext_root_group(k,3,1);
u:=ua*uab;
e:=u-id_mat;

ese:=Eigenspaces(Rationals,e)[1]; #eigenvalues 0, centralizer
h1:=ext_e(k,cb0[7]);;
esh1:=Eigenspaces(Rationals,h1);
evh1:=Eigenvalues(Rationals,h1);

esh10:=[];
index_ev0:=Position(evh1,0);
esh10:=esh1[index_ev0];

#
# sum and intersection
#
si:=SumIntersectionMat(Basis(ese),Basis(esh10));
inter:=si[2];
#    return inter;
#end;


#
# Read("~/Workspace/Chevalley.gap/init.gi"); Read(Filename(home_dir,"load.gi")); Read(Filename(test_dir,"psys.test.gi"));
#
# Read("~/Workspace/Chevalley.gap/init.gi"); Read(Filename(test_dir,"psys.test.init.gi")); Read(Filename(test_dir,"psys.test.gi"));
#
# Read(Filename(test_dir,"psys.test.gi"));
#

rsys:=RootSystem("F",4);
psys:=ParabolicSystem(rsys,[1,3]);

Print("Created ParabolicSystem ",psys,"\n");
Print("\t[",IsParabolicSystem(psys)=true,"] IsParabolicSystem(sys,[1,3])=true\n");

Print("\t[TODO] SupportRoots\n");
Print("\t[TODO] UnderlyingRootSystem\n");

radicalRootTest:=[ [ 0, 1, 0, 0 ], [ 0, 0, 0, 1 ], [ 0, 1, 0, 1 ], [ 0, 0, 1, 1 ], [ 1, 0, 1, 1 ], [ 0, 1, 1, 1 ],
  [ 0, 0, 2, 1 ], [ 1, 1, 1, 1 ], [ 1, 0, 2, 1 ], [ 0, 1, 2, 1 ], [ 1, 1, 2, 1 ], [ 2, 0, 2, 1 ],
  [ 0, 1, 2, 2 ], [ 1, 1, 2, 2 ], [ 2, 1, 2, 1 ], [ 1, 1, 3, 2 ], [ 2, 1, 2, 2 ], [ 2, 1, 3, 2 ],
  [ 2, 1, 4, 2 ], [ 2, 1, 4, 3 ], [ 2, 2, 4, 3 ] ]=RadicalRoots(psys);
Print("\t[",radicalRootTest,"] testing RadicalRoots(sys)\n");

Print("\t[TODO] iRadicalRoots\n");
Print("\t[TODO] Height\n");
Print("\t[TODO] Levels\n");
Print("\t[TODO] iLevels\n");
Print("\t[TODO] 0Level\n");
Print("\t[TODO] Shapes\n");
Print("\t[TODO] LeviModules\n");
Print("\t[TODO] iLeviModules\n");
Print("\t[TODO] Ordering\n");

Print("\t[TODO] Shape\n");
Print("\t[TODO] Shape\n");
Print("\t[TODO] LeviModule\n");
Print("\t[TODO] LeviModule\n");
Print("\t[TODO] iLeviModule\n");
Print("\t[TODO] iLeviModule\n");

Print("\t[TODO] LeviModules\n");
Print("\t[TODO] iLeviModules\n");
Print("\t[TODO] RootHeight\n");
Print("\t[TODO] RootHeight\n");
Print("\t[TODO] Level\n");
Print("\t[TODO] InRadical\n");


#
# Read("~/Workspace/groupsSB/epi/group.gi");
#
#
# needs:
# type:="A";
# rank:=2;
# nr_pos_roots:=3;
#

ZZ:=Integers;
avarnames:=List([1..100],i->Concatenation("a_{",String(i),"}"));
bvarnames:=List([1..100],i->Concatenation("b_{",String(i),"}"));
cvarnames:=List([1..100],i->Concatenation("c_{",String(i),"}"));
xvarnames:=List([1..100],i->Concatenation("x_{",String(i),"}"));
varnames:=Concatenation(avarnames,bvarnames,cvarnames,xvarnames);
APR:=PolynomialRing(ZZ,varnames);
vars:=IndeterminatesOfPolynomialRing(APR);
xvars:=vars{[301..400]};

sla:=SimpleLieAlgebraTypeA_G(type,rank,APR);

cb:=CanonicalBasis(sla);

e:=cb[1];

id_mat:=DiagonalMat(List([1..2*nr_pos_roots+rank],i->1));

ade:=function(e)
	local result,v;
	result:=[];
	for v in cb do
		Append(result,[Coefficients(cb,e*v)]);
	od;
	result:=TransposedMat(result);
	return result;
end;

root_group:=function(index,t)
	local ee,tmp,result,i;
	ee:=ade(cb[index]);
	tmp:=ee;
	result:=One(APR)*tmp^0;
	i:=1;
	while Length(Set(Concatenation(tmp)))<>1 do
		result:=result+t^i*tmp/Factorial(i);
		i:=i+1;
		tmp:=tmp*ee;
	od;
	return result;
end;
#u1a1:=root_group(1,vars[1]);

pos_root_groups:=function(start_a_index)
	return List([1..nr_pos_roots],i->root_group(i,vars[start_a_index+i]));
end;

generic_U:=function(start_a_index)
	local Uas;
	Uas:=pos_root_groups(start_a_index);
	return Product(Uas);
end;

Ua:=generic_U(0);
Ub:=generic_U(10);
Uc:=generic_U(20);

#
#
#

evaluate_U:=function(u,vals)
	local i,j,result,v;
	result := [];
	for i in [1..Length(u)] do
		Append(result,[[1..Length(u)]]);
		for j in [1..Length(u)] do
			result[i][j]:=u[i][j];
		od;
	od;
	Print(result);
	for i in [1..Length(u)] do
		for j in [1..Length(u)] do
			for v in vals do
				result[i][j]:=One(APR)*Value(One(APR)*result[i][j],v[1],v[2]);
			od;
		od;
	od;
	return result;
end;

evaluate_U:=function(u,vals)
	local i,j,result,v;
	result := [];
	for i in [1..Length(u)] do
		Append(result,[[1..Length(u)]]);
		for j in [1..Length(u)] do
			result[i][j]:=u[i][j];
		od;
	od;
	Print(result);
	for i in [1..Length(u)] do
		for j in [1..Length(u)] do
			for v in vals do
				result[i][j]:=One(APR)*Value(One(APR)*result[i][j],v[1],v[2]);
			od;
		od;
	od;
	return result;
end;

evaluate_rels:=function(rels,vals)
	local i,result,v;
	result :=List([1..Length(rels)],i->rels[i]);
	for i in [1..Length(rels)] do
		for v in vals do
			#Print(Length(rels),": ",rels[i],"\n");
			result[i]:=One(APR)*Value(result[i],v[1],v[2]);
			#nn[i]:=One(APR)*Value(nn[i],v[1],v[2]);
		od;
	od;
	return result;
end;


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

#F NthRootCyc(<cyc>, <nroot>) - <nroot>-th root of <cyc>
#F   to get a root we take all powers of cyc of order n,
#F   and make them powers of cyc of order nroot*n (effectively dividing these
#F   powers by nroot). This is done by appending n*(nroot-1) zeros to list of
#F   coeffs and using CoeefsCyc.
NthRootCyc := (cyc, nroot) -> let(n := OrderCyc(cyc),
    coeffs := CoeffsCyc(cyc,n), # -1 must be E(2), not -E(1)
    sum := Sum(coeffs),
    Cond( # GAP normalization of cyc's (to [-j,j], and not [1,-1]) give headache here
	sum =  1, CycList(Concatenation(coeffs, Replicate(n*(nroot-1), 0))),
	sum = -1, CycList(Concatenation(Replicate(n/2, 0), -coeffs{[1..n/2]}, Replicate(n*(nroot-1), 0))),
	Error("E(N) or E(-N) where N is positive integer is expected")));

#F SkewDFT(n, alpha, k) - Fourier transform for algebra C[x]/x^n - omega_1^alpha
#F   k - rotation
#F   matrix [ w_n ^ (r+alpha)c ]_{r,c}
#F
Class(SkewDFT, TaggedNonTerminal, rec(
    abbrevs := [ (n)       -> Checked(IsPosIntSym(n), [n, 1, 1]),
	         (n,alpha) -> Checked(IsPosIntSym(n), IsRatSym(alpha), [n, alpha, 1]),
	         (n,alpha,k) -> Checked(IsPosIntSym(n), IsIntSym(k), AnySyms(n,k) or Gcd(_unwrap(n),_unwrap(k))=1, IsRatSym(alpha), [n, alpha, k]) ],

    dims := self >> [ self.params[1], self.params[1] ],
    terminate := self >> let(
	N := self.params[1], rot := self.params[3], a := self.params[2], j := Ind(N-1),
        mat := DFT(N).terminate() *
               Diag(diagDirsum(fConst(TReal, 1, 1.0), fPrecompute(
                      Lambda(j, cospi(fdiv(2*a*rot*(j+1), N)) + E(4)*sinpi(fdiv(2*a*rot*(j+1), N)))))),
        Cond(self.transposed, mat.transpose(), mat)),

    conjTranspose := self >> ObjId(self)(self.params[1], self.params[2], -self.params[3]).transpose(),

    isReal := False,

    hashAs := self >> let(t:=ObjId(self)(self.params[1], 1/16, 1).withTags(self.getTags()),
        When(self.transposed, t.transpose(), t)),

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

Class(OnlineDiag, Diag, rec(
    isReal := self >> let(t := self.element.range(),
	Cond(IsVecT(t), t.t <> TComplex and ObjId(t.t) <> T_Complex,
	     t <> TComplex and ObjId(t)<>T_Complex)),
));

Global.compiler.DefaultCodegen.OnlineDiag := (self, o, y, x, opts) >> let(
    cc := o.element.compute(),
    decl(cc.values,
        chain(
            cc.code,
            List([1..Length(cc.values)], i -> assign(nth(y, i-1), cc.values[i] * nth(x, i-1)))
        )
    ));

Class(RCOnlineDiag, Diag, rec(
    dims := self >> Replicate(2, 2*self.element.domain())
));

Global.compiler.DefaultCodegen.RCOnlineDiag := (self, o, y, x, opts) >> let(
    cxmul      := (y, x, c) -> assign(y, c*x),
    cxmul_conj := (y, x, c) -> assign(y, conj(c)*x),
    cc         := o.element.computeWithOps(cxmul, cxmul_conj),

    decl(cc.values, chain(
	cc.code,
	List([0..Length(cc.values)-1], i -> chain(
		assign(nth(y, 2*i),   nth(x, 2*i) * re(cc.values[i+1]) - nth(x, 2*i+1) * im(cc.values[i+1])),
		assign(nth(y, 2*i+1), nth(x, 2*i) * im(cc.values[i+1]) + nth(x, 2*i+1) * re(cc.values[i+1]))))
    ))
);

RewriteRules(RulesDiag, rec(
   RC_OnlineDiag := Rule([RC, [OnlineDiag, @(1)]], e-> RCOnlineDiag(@(1).val))
));

#F SkewTwid(<n>, <a>)  -- twiddle factor function II(n-1) -> TComplex
#F   j -> omegapi(2*a*(j+1) / n)
#F
Class(SkewTwid, RewritableObject, Function, rec(
    updateParams := self >> Checked(IsPosIntSym(self.params[1]), IsRatSym(self.params[2]), 0),

    lambda := self >> let(
        n := self.params[1], a := self.params[2], j := Ind(n-1),
        Lambda(j, omegapi(fdiv(2*a*(j+1), n)))),

    range := self >> TComplex,

    domain := self >> self.params[1]-1,
));

#F OnlineSkewTwid(<n>, <a>, <seed_exps>, <seed_twiddle_func>)  -- same as SkewTwid but twiddles are computed
#F   online from seed values given by <seed_twiddle_func>.tolist()
#F
#F Example:
#F   OnlineSkewTwid(13,1/7,[1], fCompose(SkewTwid(13,1/7), FList(TInt, [0]))).compute();
Class(OnlineSkewTwid, SkewTwid, rec(
    # params[2] is only used by super-class's .lambda(), but not here, not in compute()
    updateParams := self >> Checked(IsPosIntSym(self.params[1]), IsRatSym(self.params[2]),
                                    IsList(self.params[3]), ForAll(self.params[3], IsIntSym),
                                    IsFunction(self.params[4])),

    range := self >> self.params[4].range(),

    # compute() returns [ code := ..., values := ... ],
    compute := self >> self.computeWithOps((res,a,b) -> assign(res, a*b),
	                                   (res,a,b) -> assign(res, a*conj(b))),

    computeWithOps := meth(self, cxmul, cxmul_conj)
        local exp, W, n, c, new_exp, new_W, i, a, b, v, val, num, perm;
        n := EvalScalar(self.params[1]);

        exp := List(self.params[3], EvalScalar);
        W := List([1..Length(exp)], i -> var.fresh_t(Concat("W",StringInt(exp[i]), "_"), self.range()));
        c := List([1..Length(exp)], i -> assign(W[i], self.params[4].at(i-1)));

        # NOTE: check if stuck
        while Length(exp) <> (n-1) do
            new_exp := Cartesian(exp, exp);
            new_W := Cartesian(W, W);
            num := Length(exp);
            for i in [1..Length(new_exp)] do
                [a, b] := new_exp[i];
                if (a+b) > 0 and (a+b) < n and not ((a+b) in exp) then
                    v := var.fresh_t(Concat("W",StringInt(a+b), "_"), self.range());
                    Add(exp, a+b);
                    Add(W, v);
                    Add(c, cxmul(v, new_W[i][1], new_W[i][2]));
                fi;
                if (a-b) > 0 and (a-b) < n and not ((a-b) in exp) then
                    v := var.fresh_t(Concat("W",StringInt(a-b), "_"), self.range());
                    Add(exp, a-b);
                    Add(W, v);
                    Add(c, cxmul_conj(v, new_W[i][1], new_W[i][2]));
                fi;
            od;
            if Length(exp) = num then Error("OnlineSkewTwid.compute is stuck, not enough twiddle seed values given"); fi;
        od;
        perm := SortingPerm(exp);
        return rec(values := Permuted(W,perm), exp := Permuted(exp,perm), code := chain(c));
    end
));

Class(ATwidOnline, AGenericTag, rec(isPushTag := true));
Class(ATwidSplit, AGenericTag, rec(isPushTag := true));

NewRulesFor(SkewDFT, rec(
    SkewDFT_Base2 := rec(
	applicable := t -> t.params[1] = 2,
	apply := (t, C, Nonterms) -> let(
            den:=Denominator(t.params[2]), num:=Numerator(t.params[2]), k:=t.params[3],
	    F(2) * Diag(1,E(2*den)^(k*num)))),

    SkewDFT_toDFT := rec(
	applicable := (self, t) >> logic_or(eq(self.a.maxSize, -1), leq(t.params[1], self.a.maxSize)),
        children := t -> [[ DFT(_unwrap(t.params[1]), _unwrap(t.params[3])).withTags(
		    Filtered(t.getTags(), t -> not ObjId(t) in [ATwidOnline, ATwidSplit])) ]],

        a := rec(
            diagMode := "normal", # "normal" | "split" | "online"
            maxSize := -1
        ),

        forTransposition := true,

        onlineSeeds := n -> Cond(n<=4, [1],
                                 n<=8, [1, 3],
                                       [1, 3, n-1]),

	apply := (self, t, C, Nonterms) >> let(
            N := t.params[1], rot := t.params[3], a := t.params[2], j := Ind(N-1),
            tw := SkewTwid(N, a*rot),
            mode := Cond(t.firstTag()=ATwidOnline(),
		         # if other tags are present, do not use "online" mode
		         # this is necessary because we can't vectorize a standalone SkewDFT in this mode
		              Cond(Length(t.getTags())>1, self.a.diagMode, "online"),
                         t.firstTag()=ATwidSplit(), "split",
                         self.a.diagMode),

	    C[1] *
            Cond(mode = "split",
                    DiagCpxSplit(diagDirsum(FList(TReal, [1.0, 0.0]), fPrecompute(RCData(tw)))),
                 mode = "normal" or N=2,
                    Diag(        diagDirsum(fConst(TReal, 1, 1.0),    fPrecompute(tw))), # XXX

                 mode = "online", let(seeds := self.onlineSeeds(N),
                     DirectSum(I(1), OnlineDiag(OnlineSkewTwid(N, a*rot, seeds, fPrecompute(fCompose(tw, FList(TInt, seeds-1))))))),
                 Error("<self>.diagMode must be \"split\" | \"normal\" | \"online\""))
        )
    ),

    #F SkewDFT_Fact : PDFT_2n_a -> L (PDFT_n_r0 dirsum PDFT_n_r1) L
    #F                               (I2 tensor [[1,r0],[1,r1]]) L
    #F Derived using polynomial factorization:
    #F    (x^2n - a) == (x^n - r0) * (x^n - r1)
    #F where r0 and r1 are two different quadratic roots of a
    #F
    SkewDFT_Fact := rec(
	applicable := t -> t.params[1] > 2 and t.params[1] mod 2 = 0,

	children := t -> let(
	    n:=t.params[1]/2, r0:=t.params[2]/2, r1:=r0+1/2, k:=t.params[3],
	    [[ SkewDFT(n, r0, k), SkewDFT(n, r1, k) ]]),

	apply := (t, C, Nonterms) -> let(
	    n:=t.params[1]/2, den:=Denominator(t.params[2]), num:=Numerator(t.params[2]), k:=t.params[3],
	    DirectSum(C[1], C[2]) ^ L(2*n, 2) *
	    Tensor(I(n), F(2)*Diag(1,E(2*den)^(k*num))) *
	    L(2*n, n))
    ),

    #F SkewDFT_CT : SkewDFT_mn(r) -> (SkewDFT_m(.) tensor I_n) (I_m tensor SkewDFT_n(r)) L
    #F
    #F Derived using polynomial decomposition
    #F    x^mn - a == (x^m)^n - a
    #F
    SkewDFT_CT := rec(
        applicable := (self, t) >> logic_and(gt(t.params[1], 2), logic_neg(t.hasTags()), logic_neg(isPrime(t.params[1]))),
        freedoms := t -> [ divisorsIntNonTriv(t.params[1]) ],
        child := (t, fr) -> let(
            N := t.params[1],  m := fr[1],          n := div(N, m),
            a := t.params[2],  rot := t.params[3],  j := Ind(n),

            [ IDirSum(j, SkewDFT(m, fdiv(a+j, n), rot)),
              SkewDFT(n, a, rot) ]),

        apply := (nt, C, Nonterms) -> let(m := Rows(Nonterms[1].child(1)), n := Rows(Nonterms[2]),
            Tr(n, m) * C[1] * Tr(m, n) * Tensor(I(m), C[2]) * Tr(n, m)
        )
    )
));