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

# Radix N kernel for FFTE

buildScalarKernel_c := function(n, kk, conf, opts)
    local name, suffix, filesuffix, j, k, l, l1, m, tmp1, tmp3, i1, i2, gf, sf, gath, scat, gc, sc,
        dft, rts, opcnts, rt, dfts, dftc, cl, cc, c, clp, lp, mp;

    name := DFTnameStr(n, kk);
    suffix := "c";
    filesuffix := "c_";
#    suffix := "_k";
    Print("\n\n// == Generating \"", name, "\" ==================================================\n\n");

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

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

    # gather and scatter
    i1 := var.fresh_t("i", n);
    i2 := var.fresh_t("i", n);
    gf := fTensor(Lambda(i1, k + j*m + i1*l1*m), fId(2));
    sf := fTensor(Lambda(i2, k+n*j*m + i2*m), fId(2));
    gath := Gath(gf);
    scat := Scat(sf);

    # generate gather and scatter code
    gc := BlockUnroll(unroll_cmd(opts.codegen(gath, tmp1, X, opts)), opts);
    sc := BlockUnroll(unroll_cmd(opts.codegen(scat, Y, tmp3, opts)), opts);

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

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

    # fixup to push decls inside (?)
    c := func(TVoid, "transform", [Y, X, j, k, l1, m],
            decl(cc.vars, cc.cmd.cmds[1].cmd));

    # print Radix N FFTE kernel as function

    # function with j and k loop in the function call
    clp := func(TVoid, "transform", [Y, X, lp, mp],
        decl(c.cmd.vars::c.free()::[l1,m],
            chain(
                assign(l1, deref(lp)),
                assign(m, deref(mp)),
                loopn(k, m, c.cmd.cmd)
            )
        )
    );

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


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

NewRulesFor(InterpolateDFT, rec(
    InterpolateDFT_tSPL_PrunedDFT := rec(
       applicable := (self, nt) >> nt.hasTags() and ObjId(nt.params[2]) = fZeroPadMiddle,
       children := nt -> let(n:=nt.params[2].domain(), N := nt.params[1].range(), us := N/n, blk := n/2,
            [[
                TCompose([
                    Downsample(nt.params[1]),
                    PrunedDFT(N, 1, blk, [0, 2*us-1]),
                    TDiag(fConst(n, 1/n)),
                    DFT(n, -1)
                ]).withTags(nt.getTags())
            ]]),
       apply := (nt, C, cnt) -> C[1]
    )
));

_maxBkSize := function(exp)
    local i, l, d;

    if IsExp(exp) and ObjId(exp)=mul and IsValue(exp.args[1]) then
        return exp.args[1];
    fi;

    if IsInt(exp.eval()) or IsValue(exp.eval()) then return EvalScalar(exp); fi;
    l := Lambda(Filtered(exp.free(), IsLoopIndex), exp);
    d := List(spiral.sigma.GenerateData(l).tolist(), EvalScalar);
    return Gcd(d);
end;

_divideFunc := function(exp, dval)
    local l, d, i;

    if IsValue(exp) or IsInt(exp) then return exp/dval; fi;

    if IsExp(exp) and ObjId(exp)=mul and IsValue(exp.args[1]) then
        return ApplyFunc(mul, Concat([idiv(exp.args[1], dval)], Drop(exp.args, 1)));
    fi;

    if IsInt(exp.eval()) or IsValue(exp.eval()) then return EvalScalar(exp/dval); fi;
    i := Filtered(exp.free(), IsLoopIndex)[1];
    l := Lambda(i, exp);
    d := List(spiral.sigma.GenerateData(l).tolist(), EvalScalar)/dval;
    return FData(List(d, j->i.t.value(j))).at(i);
end;

NewRulesFor(Downsample, rec(
    Downsample_tag := rec(
        applicable := (self, nt) >> nt.hasTags(),
        apply := (nt, C, cnt) -> let(gcd := _maxBkSize(nt.params[1].domain()),
            NeedInterleavedComplex(ScatGath(fTensor(fId(_divideFunc(nt.params[1].domain(), gcd)), fId(gcd)), nt.params[1])))
    )
));

NewRulesFor(InterpolateSegmentDFT, rec(
    InterpolateSegmentDFT_tSPL_PrunedDFT := rec(
        applicable := (self, nt) >> nt.hasTags() and ObjId(nt.params[6]) = fZeroPadMiddle,
        children := nt -> let(tags := nt.getTags(),
                              numseg := nt.params[1], j := Ind(numseg), downsample := nt.params[5].at(j), upsample := nt.params[6],
                              insize := nt.params[3], overlap := nt.params[4], n := upsample.domain(), N := downsample.range(),
                              us := N/n, blk := n/2,
                              inp := n + (numseg-1)*(n-overlap), over := inp - insize, l := n - over, g := Gcd(n, l),

            [[
                Downsample(downsample).withTags(tags),
                PrunedDFT(N, 1, blk, [0, 2*us-1]).withTags(tags),
                DFT(n, -1).withTags(tags),
                PrunedDFT(n, -1, g, [0..l/g-1]).withTags(tags),
                InfoNt(j)
            ]]),
        apply := (nt, C, cnt) -> let(numseg := nt.params[1], _j := cnt[5].params[1], j := Ind(_j.range-1), downsample := nt.params[5].at(j), upsample := nt.params[6],
                              outsize := nt.params[2], insize := nt.params[3], overlap := nt.params[4], n := upsample.domain(), N := downsample.range(),
                              ids_rows := _sumSegDims(numseg-1, nt.params[5]),
#                              ids_rows := RulesStrengthReduce(outsize - nt.params[5].at(numseg-1).domain()),
                RowDirectSum(overlap,[
                    IRowDirSum(j, numseg-1, overlap,
                       SubstVars(Copy(C[1]), rec((_j.id) := j)) * C[2] * Diag(fConst(n, 1/n)) * C[3]).overrideDims([ids_rows, insize - C[4].dims()[2] + overlap]),
                    SubstVars(Copy(C[1]), rec((_j.id) := V(numseg-1))) * C[2] * Diag(fConst(n, 1/n)) * C[4]
                 ]).overrideDims([nt.params[2], nt.params[3]])
       )
    )
));


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

Class(MultiPtrSumsgenMixin, rec(
    IterHStack :=
        (self, o, opts) >> let(
        	bkcols := Cols(o.child(1)),
        	bkrows := Rows(o.child(1)),
        	nblocks := o.domain,
        	cols := Cols(o), rows := Rows(o),
        	j := o.var,
        	ch := self(o.child(1), opts),

    	    ISum(j, j.range,
        		ch *
        		Gath(fTensor(fBase(nblocks, j), fId(bkcols)))
        	)
        )
));


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

benchNEON := function()
    return rec(
        2x32f := rec(
            wht := rec(
                small := _defaultSizes(s->doSimdWht(s, NEON_HALF, rec(
		            verify := true, oddSizes := true, svct := true, stdTTensor := true, tsplPFA := false)), [4]),
                medium := _defaultSizes(s->doSimdWht(s, NEON_HALF, rec(
			    oddSizes := false, svct := true, stdTTensor := true, tsplPFA := false)), List([2..10], i->2^i))
                ),
            1d := rec(
                dft_sc := rec(
                    small := _defaultSizes(s->doSimdDft(s, NEON_HALF, rec(
				verify:=true, tsplBluestein:=false, interleavedComplex := false, PRDFT:=true, URDFT:= true,
				cplxVect := true, stdTTensor := false, globalUnrolling:=10000)),
                        [ 2..32 ]),
                    medium := _defaultSizes(s->doSimdDft(s, NEON_HALF, rec(tsplRader:=false, tsplBluestein:=false,
				tsplPFA:=false, oddSizes:=false, interleavedComplex := false)),
                        _svctSizes(1024, 16, 2)),

                    ),
                dft_ic := rec(
                    small := _defaultSizes(s->doSimdDft(s, NEON_HALF, rec(
				verify:=true, tsplBluestein:=false, interleavedComplex := true, PRDFT:=true, URDFT:= true,
				cplxVect := true, stdTTensor := false, globalUnrolling:=10000)),
                        [2..32]),
                    medium := _defaultSizes(s->doSimdDft(s, NEON_HALF, rec(
				tsplRader:=false, tsplBluestein:=false, tsplPFA:=false, oddSizes:=false, interleavedComplex := true)),
                        _svctSizes(1024, 16, 2)),
                    medium_cx := _defaultSizes(s->doSimdDft(s, NEON_HALF, rec(
				tsplRader:=false, tsplBluestein:=false, tsplPFA:=false, oddSizes:=false, interleavedComplex := true,
				cplxVect := true, realVect := false)),
                        _svctSizes(1024, 16, 2)),
                    ),

                trdft := _defaultSizes(s->doSimdSymDFT(TRDFT, s, NEON_HALF, rec( verify:=true,
                            interleavedComplex := true, PRDFT:=true, URDFT:= true, tsplBluestein := false, cplxVect := true,
                            realVect := true, propagateNth := true, useDeref := true,
                            globalUnrolling:=10000)), 4*[1..32]),

                dht := _defaultSizes(s->doSimdSymDFT(TDHT, s, NEON_HALF, rec(verify :=true)), 8*[1..12]),
                dct2 := _defaultSizes(s->doSimdSymDFT(TDCT2, s, NEON_HALF, rec(verify :=true)), 8*[1..12]),
                dct3 := _defaultSizes(s->doSimdSymDFT(TDCT3, s, NEON_HALF, rec(verify :=true)), 8*[1..12]),
                dct4 := _defaultSizes(s->doSimdSymDFT(TDCT4, s, NEON_HALF, rec(verify :=true)), 8*[1..12]),
                dst2 := _defaultSizes(s->doSimdSymDFT(TDST2, s, NEON_HALF, rec(verify :=true)), 8*[1..12]),
                dst3 := _defaultSizes(s->doSimdSymDFT(TDST3, s, NEON_HALF, rec(verify :=true)), 8*[1..12]),
                dst4 := _defaultSizes(s->doSimdSymDFT(TDST4, s, NEON_HALF, rec(verify :=true)), 8*[1..12]),
                mdct := _defaultSizes(s->doSimdSymDFT(TMDCT, s, NEON_HALF, rec(verify :=true)), 8*[1..12]),
                imdct := _defaultSizes(s->doSimdSymDFT(TIMDCT, s, NEON_HALF, rec(verify :=true)), 8*[1..12])
                ),

            2d := rec(
                dft_ic := rec(
                    medium := _defaultSizes(s -> doSimdMddft(s, NEON_HALF, rec(
				interleavedComplex := true,
                                oddSizes := false, svct := true, splitL := false, pushTag := true,
				flipIxA := false, stdTTensor := true, tsplPFA := false)),
                        4 * List([1..16], i->[i,i])),

                    small := _defaultSizes(s->doSimdMddft(s, NEON_HALF, rec(
				verify:=true, interleavedComplex := true, globalUnrolling:=10000,
                                tsplPFA := false, pushTag:= false, oddSizes := true, svct := true, splitL := false)),
                        List([2..16], i->[i,i]))
                    ),
                dft_sc := rec(
                    medium := _defaultSizes(s -> doSimdMddft(s, NEON_HALF, rec(
				interleavedComplex := false,
                                oddSizes := false, svct := true, splitL := false, pushTag := true, flipIxA := false,
				stdTTensor := true, tsplPFA := false)),
                        4*List([1..16], i->[i,i])),
                    small := _defaultSizes(s->doSimdMddft(s, NEON_HALF, rec(verify:=true, interleavedComplex := false,
				globalUnrolling:=10000, tsplPFA := false, pushTag:= false, oddSizes := true,
				svct := true, splitL := false)),
                        List([2..16], i->[i,i]))
                    ),
                dct2 := _defaultSizes(s->doSimdSymMDDFT(DCT2, s, NEON_HALF, rec(verify := true)), [4, 8, 12, 16]),
                dct3 := _defaultSizes(s->doSimdSymMDDFT(DCT3, s, NEON_HALF, rec(verify := true)), [4, 8, 12, 16]),
                dct4 := _defaultSizes(s->doSimdSymMDDFT(DCT4, s, NEON_HALF, rec(verify := true)), [4, 8, 12, 16]),
                dst2 := _defaultSizes(s->doSimdSymMDDFT(DST2, s, NEON_HALF, rec(verify := true)), [4, 8, 12, 16]),
                dst3 := _defaultSizes(s->doSimdSymMDDFT(DST3, s, NEON_HALF, rec(verify := true)), [4, 8, 12, 16]),
                dst4 := _defaultSizes(s->doSimdSymMDDFT(DST4, s, NEON_HALF, rec(verify := true)), [4, 8, 12, 16])
            )
            ),

        4x32f := rec(
            wht := rec(
                small := _defaultSizes(s -> doSimdWht(s, NEON, rec(
			    verify := true, oddSizes := true, svct := true, stdTTensor := true, tsplPFA := false)),
		    List([1..3], i->2^i)),
                medium := _defaultSizes(s -> doSimdWht(s, NEON, rec(
			    oddSizes := false, svct := true, stdTTensor := true, tsplPFA := false
			    )), List([4..10], i->2^i))
                ),
            1d := rec(
                dft_sc := rec(
                    small := _defaultSizes(s->doSimdDft(s, NEON, rec(
				verify:=true, interleavedComplex := false, stdTTensor := false, globalUnrolling:=10000)),
                        [ 2..64 ]),
                    medium := _defaultSizes(s->doSimdDft(s, NEON, rec(
				tsplRader:=false, tsplBluestein:=false, tsplPFA:=false, oddSizes:=false, interleavedComplex := false)),
                        _svctSizes(1024, 16, 4)),

                    ),
                dft_ic := rec(
                    small := _defaultSizes(s->doSimdDft(s, NEON, rec(
				verify:=true, interleavedComplex := true, PRDFT:=true, URDFT:= true,
				cplxVect := true, stdTTensor := false, globalUnrolling:=10000)),
                        [ 2..64 ]),
                    medium := _defaultSizes(s->doSimdDft(s, NEON, rec(
				tsplRader:=false, tsplBluestein:=false, tsplPFA:=false,
				oddSizes:=false, interleavedComplex := true)),
                        _svctSizes(1024, 16, 4)),
                    medium_cx := _defaultSizes(s->doSimdDft(s, NEON, rec(
				tsplRader:=false, tsplBluestein:=false, tsplPFA:=false,
				oddSizes:=false, interleavedComplex := true,
                                cplxVect := true, realVect := false, PRDFT := false, URDFT := true)),
                        _svctSizes(1024, 16, 4))
                    ),

                rdft := _defaultSizes(s->doSimdSymDFT(TRDFT, s, NEON, rec(verify :=true)), 32*[1..12]),

                trdft := _defaultSizes(s->doSimdSymDFT(TRDFT, s, NEON, rec(
			    verify := true, interleavedComplex := true, PRDFT:=true, URDFT:= true,
			    tsplBluestein := false, cplxVect := true,   stdTTensor := false,
			    realVect := true, propagateNth := true, useDeref := true, globalUnrolling:=10000)),
		    8*[1..32]),

                dht := _defaultSizes(s->doSimdSymDFT(TDHT, s, NEON, rec(verify :=true)), 32*[1..12]),
                dct2 := _defaultSizes(s->doSimdSymDFT(TDCT2, s, NEON, rec(verify :=true)), 32*[1..12]),
                dct3 := _defaultSizes(s->doSimdSymDFT(TDCT3, s, NEON, rec(verify :=true)), 32*[1..12]),
                dct4 := _defaultSizes(s->doSimdSymDFT(TDCT4, s, NEON, rec(verify :=true)), 32*[1..12]),
                dst2 := _defaultSizes(s->doSimdSymDFT(TDST2, s, NEON, rec(verify :=true)), 32*[1..12]),
                dst3 := _defaultSizes(s->doSimdSymDFT(TDST3, s, NEON, rec(verify :=true)), 32*[1..12]),
                dst4 := _defaultSizes(s->doSimdSymDFT(TDST4, s, NEON, rec(verify :=true)), 32*[1..12]),
                mdct := _defaultSizes(s->doSimdSymDFT(TMDCT, s, NEON, rec(verify :=true)), 32*[1..12]),
                imdct := _defaultSizes(s->doSimdSymDFT(TIMDCT, s, NEON, rec(verify :=true)), 32*[1..12])
                ),
            2d := rec(
                dft_ic := rec(
                    medium := _defaultSizes(s -> doSimdMddft(s, NEON, rec(
				interleavedComplex := true,
                                oddSizes := false, svct := true, splitL := false, pushTag := true,
				flipIxA := false, stdTTensor := true, tsplPFA := false)),
                        16*List([1..8], i->[i,i])),
                    small := _defaultSizes(s->doSimdMddft(s, NEON, rec(
				verify:=true, interleavedComplex := true, globalUnrolling:=10000,
                                tsplPFA := false, pushTag:= false, oddSizes := true, svct := true, splitL := false)),
                        List([2..16], i->[i,i]))
                    ),
                dft_sc := rec(
                    medium := _defaultSizes(s -> doSimdMddft(s, NEON, rec(
				interleavedComplex := false,
                                oddSizes := false, svct := true, splitL := false, pushTag := true,
				flipIxA := false, stdTTensor := true, tsplPFA := false)),
                        16 * List([1..8], i->[i,i])),
                    small := _defaultSizes(s->doSimdMddft(s, NEON, rec(verify:=true, interleavedComplex := false,
				globalUnrolling:=10000, tsplPFA := false, pushTag:= false, oddSizes := true,
				svct := true, splitL := false)),
                        List([2..16], i->[i,i]))
                    ),
                dct2 := _defaultSizes(s -> doSimdSymMDDFT(DCT2, s, NEON, rec(verify := true)), [4, 8, 12, 16]),
                dct3 := _defaultSizes(s -> doSimdSymMDDFT(DCT3, s, NEON, rec(verify := true)), [4, 8, 12, 16]),
                dct4 := _defaultSizes(s -> doSimdSymMDDFT(DCT4, s, NEON, rec(verify := true)), [4, 8, 12, 16]),
                dst2 := _defaultSizes(s -> doSimdSymMDDFT(DST2, s, NEON, rec(verify := true)), [4, 8, 12, 16]),
                dst3 := _defaultSizes(s -> doSimdSymMDDFT(DST3, s, NEON, rec(verify := true)), [4, 8, 12, 16]),
                dst4 := _defaultSizes(s -> doSimdSymMDDFT(DST4, s, NEON, rec(verify := true)), [4, 8, 12, 16]),
                conv := _defaultSizes(s -> let(
                        opts := SIMDGlobals.getOpts(NEON, rec(svct := true, oddSizes := false,
				splitComplexTPrm := true, TRCDiag_VRCLR := true, globalUnrolling := 150,
				measureFinal := false)),
                        t := Flat(List(s, n -> let(
				    tt := TRConv2D(ImageVar([n, n])).withTags(opts.tags), [tt, tt.forwardTransform()]))),
                        spiral.libgen.DPBench.build(t, opts)), 16*[1..32])
            )
        )
    );
end;


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

# NOTE: Support odd sizes ie with (I_4 dirsum J_3)
condIJ := (N, m) -> let(k := N/m, Checked(IsSymbolic(k) or IsEvenInt(k),
    fCond(diagTensor(II(k/2), II(2,0,1), II(m)), fTensor(fId(k), fId(m)),
                                                 fTensor(fId(k), J(m)))
));

# NOTE: Support odd sizes ie with (I_4 dirsum OS_3)
condIOS := (N, m) -> let(k := N/m, Checked(IsSymbolic(k) or IsEvenInt(k),
    fCond(diagTensor(II(k/2), II(2,0,1), II(m)), fTensor(fId(k), fId(m)),
                                                 fTensor(fId(k), OS(m, -1)))
));

condM := (N, m) -> L(N, m) * Prm(condIJ(N, m));
condK := (N, m) -> Prm(condIJ(N, N/m)) * L(N, m);

condMp := (N, m) -> L(N, m) * Prm(condIOS(N, m));
condKp := (N, m) -> Prm(condIOS(N, N/m)) * L(N, m);

condB := (N, m) -> Checked(IsEvenInt(m), let(k := N/m,
    condK(N, m) * Tensor(I(N/m), condM(m,m/2))));

condBp := (N, m) -> Checked(IsEvenInt(m), let(k := N/m,
    condKp(N, m) * DirectSum(L(m,m/2), Tensor(I(k-1), condM(m,m/2)))));

condBpu := (N, m) -> Checked(IsEvenInt(m), let(k := N/m,
    condKp(N, m) * DirectSum(I(m), Tensor(I(k-1), condM(m,m/2)))));

# condBpu(k*m,m) == Scat(Refl0_u(k,m)) = Refl0_u(k,m).transpose()
# u = stands for URDFT. i.e. this is for URDFT based algorithms
# NOTE: not valid for odd <k> (but will need new ASPF rule anyway with an extra child)
# GOOD:  valid for odd <m>.
Class(Refl0_u, PermClass, rec(
    def := (k, m) -> rec(),
    domain := self >> self.params[1] * self.params[2],
    range := self >> self.params[1] * self.params[2],
    lambda := self >> let(k := self.params[1], m := self.params[2], i := Ind(k*m),
        Lambda(i, cond(leq(i, m-1), k*i,
                                    cond(leq(imod(i, m), idiv(m-1,2)), 2*k*imod(i,m) + idiv(i,m),
                                                                      2*k*m - 2*k*imod(i,m) - idiv(i,m)))))
));

# Valid for odd <k>, even <m>
# <omit> is how many initial points we want to omit from the permutation
# the only sensible values for it are 0 and 1
Class(Refl0_odd, PermClass, rec(
    def := (k, m, omit) -> rec(), #size := k*m+idiv(m+1,2)-omit),
    range := self >> self.domain(),
    domain := self >> let(k:=self.params[1], m:=self.params[2], omit:=self.params[3],
        k*m + idiv(m+1, 2) - omit),

    lambda := self >> let(
        k := self.params[1],   m := self.params[2], mc := idiv(m+1, 2),
        N := self.domain(), omit := self.params[3], mf := idiv(m, 2),
        N2:= 2*k*m+m,         ii := Ind(N-omit),    i  := ii+omit,

        Lambda(ii, cond(leq(i, mc-1), (2*k+1)*i,
                                     cond(leq(imod(i-mc, m), mc-1),       (2*k+1)*imod(i-mc,m) + idiv(i+mf,m),
                                                                    N2  - (2*k+1)*imod(i-mc,m) - idiv(i+mf,m)))
            -omit))
));

# condB(k*m,m) == Scat(Refl1(k,m)) = Refl1(k,m).transpose()
# NOTE: not valid for odd <k> (but will need new ASPF rule anyway with an extra child)
# GOOD:  valid for odd <m>.
Class(Refl1, PermClass, rec(
    def := (k, m) -> rec(), #size := k*m),
    domain := self >> self.params[1]*self.params[2],
    range := self >> self.params[1]*self.params[2],
    lambda := self >> let(k := self.params[1], m := self.params[2], i := Ind(k*m),
        Lambda(i, cond(leq(imod(i, m), idiv(m-1,2)), 2*k*imod(i,m) + idiv(i,m),
                                       2*k*m - 1 - 2*k*imod(i,m) - idiv(i,m))))
));

Declare(KK, MM, KKp, MMp);

Class(KK, PermClass, rec(
    def := (k, m) -> rec(), #size := k*m),
    domain := self >> self.params[1]*self.params[2],
    range := self >> self.params[1]*self.params[2],
    transpose := self >> MM(self.params[2], self.params[1]),
    lambda := self >> let(k := self.params[1], m := self.params[2],
        fCompose(Tr(k,m), condIJ(k*m, k)).lambda()),
));

Class(MM, PermClass, rec(
    def := (k, m) -> rec(), #size := k*m),
    domain := self >> self.params[1]*self.params[2],
    range := self >> self.params[1]*self.params[2],
    transpose := self >> KK(self.params[2], self.params[1]),
    lambda := self >> let(k := self.params[1], m := self.params[2],
        fCompose(condIJ(k*m, m), Tr(k, m)).lambda()),
));

Class(KKp, PermClass, rec(
    def := (k, m) -> rec(), #size := k*m),
    domain := self >> self.params[1]*self.params[2],
    range := self >> self.params[1]*self.params[2],
    transpose := self >> MMp(self.params[2], self.params[1]),
    lambda := self >> let(k := self.params[1], m := self.params[2],
        fCompose(Tr(k,m), condIOS(k*m, k)).lambda()),
));

Class(MMp, PermClass, rec(
    def := (k, m) -> rec(), #size := k*m),
    domain := self >> self.params[1]*self.params[2],
    range := self >> self.params[1]*self.params[2],
    transpose := self >> KKp(self.params[2], self.params[1]),
    lambda := self >> let(k := self.params[1], m := self.params[2],
        fCompose(condIOS(k*m, m), Tr(k, m)).lambda()),
));

Declare(IP);

libB := (k, m) -> Checked(IsSymbolic(m) or IsEvenInt(m),
    KK(k, m) * Tensor(I(k), MM(2,m/2)));

libBp := (k, m) -> Checked(IsSymbolic(m) or IsEvenInt(m),
    KKp(k, m) * DirectSum(Tr(2,m/2), Tensor(I(k-1), MM(2,m/2))));

libBpu := (k, m) -> Checked(IsSymbolic(m) or IsEvenInt(m),
    KKp(k, m) * DirectSum(I(m), Tensor(I(k-1), MM(2,m/2))));

#F IJ(<size>, <n>) - I_n dirsum J_n dirsum I_n dirsum ... (repeats N/n times, n|N)
#F
#
# Subst(i -> BinXor(i, BinAnd(i,$n) - BinShr(BinAnd(i,$n), $(LogInt(n,2))))),
# Class(IJ, PermClass, rec(
#   def := (N, n) -> Checked(IsInt(N), IsInt(n), N mod n = 0,
#       rec(
#       size := N,
#       direct  := Subst(x -> x + (QuoInt(x,$n) mod 2) * ($(n-1) - 2*(x mod $n))),
#       inverse := Subst(x -> x + (QuoInt(x,$n) mod 2) * ($(n-1) - 2*(x mod $n)))
#       )),
#   transpose := self >> self
#);
IJ := (N, n) -> IP(N, J(n));

#F IP(<N>, <splperm>) - I_n dirsum P_n dirsum I_n dirsum ... (repeats N/n times, n|N)
#F
#F    P_n given by <splperm>, which is a permutation function
#F
Class(IP, PermClass, rec(
    def := (N, splperm) -> Checked(IsInt(N), IsSPL(splperm), N mod Rows(splperm) = 0, rec()),
    range := self >> self.params[1],
    domain := self >> self.params[1],

    lambda := self >> let(
	N := self.params[1],
	P := self.params[2],
	Pl := P.lambda(),
	n := P.domain(),
	i := Ind(N),
	Lambda(i, n*idiv(i,n) + imod(1+idiv(i,n), 2)*imod(i, n) +
                                imod(  idiv(i,n), 2)*Pl.at(imod(i,n)))
    ),

    transpose := self >> IP(self.params[1], self.params[2].transpose())
));

# -----------------------------------------------------------------------------#
#F LIJ(<N>) - L(N, N/2) * (I(N/2) dirsum J(N/2))
##   works also for odd sizes
Class(LIJ, PermClass, rec(
    def := N -> Checked(IsInt(N), rec()),
    range := self >> self.params[1],
    domain := self >> self.params[1],
    lambda := self >> let(
	N := self.params[1],
	N1 := When(IsOddInt(N), N, N-1),
	i := Ind(N),
	When(not self.transposed,
            Lambda(i, QuoInt(N,2) + idiv(N-i, 2)*cond(neq(imod(N1-i,2),0), -1, 1)),
            Lambda(i, 2*i + idiv(i, QuoInt(N+1,2)) * (2*N - 1 - 4*i))
        ))
));

# -- Originals
# K ( <n>, <m> )
#   returns the equivalent of the stride permutation for Cooley-Tukey FFT
#   for the DCT3 and 4. <m> has to divide <n>
#     (I_n/m dirsum J_n/m dirsum I_n/m ....) * L^n_m  (direct sum alternately)
#   This permutation is to be used if it occurs on the left side in the rule.
#   It is K(n, m)^-1 =  M(n, n/m).
K := (mn, m) -> Checked(IsPosInt(mn), IsPosInt(m), mn mod m = 0,
    IJ(mn, mn/m) * L(mn, m));

M := (mn, m) -> Checked(IsPosInt(mn), IsPosInt(m), mn mod m = 0,
    L(mn, m) * IJ(mn, m));
# -------------

########################
# Generating functions
########################

L_or_OS := (n, str) -> When((n mod str) <> 0, OS(n, str), L(n, str));

Kp := (NN, m) -> let(n := NN / m,
    Prm(IP(NN, OS(n, -1)))* L(NN, m));

Mp := (NN, m) -> Kp(NN, NN/m).transpose();

# Type 0 symmetries  (ce0, co0) aka whole-point
# BH0(<Nreal>, <n>, <base>, <stride>), Nreal = number of output real pts = Rows(PRDFT(.))
# BH0 := (Nreal,n,base,stride) -> BH(Int(Nreal/2)+1, Nreal, n, base, stride);

# Type 1 symmetries  (ce1, co1) aka half-point
# BH1(<Nreal>, <n>, <base>, <stride>), Nreal = number of output real pts = Rows(PRDFT3(.))
# BH1 := (Nreal,n,base,stride) -> BH(Int((Nreal+1)/2), Nreal-1, n, base, stride);

# BH(<N>, <reflect>, <n>, <b>, <s>) - Reflective stride function
#   Defined as  i -> When(i < ceil(n/2)-1, si + b, reflect - si - b)
#
Class(BH, FuncClass, rec(
    def := (N,reflect,n,base,stride) -> rec(), #N := N, n := n),
    domain := self >> self.params[3],
    range  := self >> self.params[1],
    lambda := self >> let(
	N:=self.params[1], reflect:=self.params[2], n:=self.params[3], b:=self.params[4],
	s:=self.params[5], i:=Ind(n),
	Lambda(i, cond(leq(i, idiv(n-1, 2)), s*i + b, reflect - s*i - b)))
));

Declare(Refl);
# Refl(<N>, <reflect>, <n>, <func>) - Reflective arbitrary function
#   Defined as  i -> When(func(i) < N, func(i), reflect - func(i))
#   with domain of <n> points (usually smaller than domain(func))
#
Class(Refl, FuncClass, rec(
    def := (N,reflect,n,func) -> rec(), #N := N, n := n),
    domain := self >> self.params[3],
    range  := self >> self.params[1],
    transpose := self >> Refl(self.params[1], self.params[2], self.params[3], self.params[4].transpose()),
    lambda := self >> let(
	func:=self.params[4].lambda(), reflect:=self.params[2], N:=self.params[1],
	i := Ind(self.params[3]),
	Lambda(i, cond(leq(func.at(i), N-1), func.at(i), reflect-func.at(i))))
));


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

Class(InertTranspose, BaseContainer, SumsBase, rec(
    dims := self >> Reversed(self.child(1).dims()),
    toAMat := self >> AMatMat(TransposedMat(MatSPL(self.child(1))))
));

Class(InertConjTranspose, BaseContainer, SumsBase, rec(
    dims := self >> Reversed(self.child(1).dims()),
    toAMat := self >> AMatMat(Global.Conjugate(TransposedMat(MatSPL(self.child(1)))))
));

InertConjTranspose.conjTranspose := self >> self.child(1);


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

Declare(ScatH, VScat_L);

Class(GathH, SumsBase, BaseMat, rec(
    rChildren := self >> [self.N, self.n, self.base, self.stride],
    rSetChild := rSetChildFields("N", "n", "base", "stride"),
    new := (self, N, n, base, stride) >>
	SPL(WithBases(self, rec(
      	N:= N, n := n, base := base, stride := stride, dimensions := [n, N]))),
    dims := self >> self.dimensions,
    sums := self >> self,
    area := self >> self.n,
    isReal := self >> true,
    transpose := self >> ScatH(self.N, self.n, self.base, self.stride),
    conjTranspose := self >> self.transpose(),
    inverse := self >> self.transpose(),
    toAMat := self >> let(
	   n := self.n,
       N := self.N,
       base := self.base,
       stride := self.stride,
       AMatMat(List([0..n-1], row -> let(
         idx := base+row,
		 BasisVec(N, idx))))
    ),
    isIdentity := self >> (self.n=self.N) and self.base=0 and self.stride = 1,
));

Class(ScatH, SumsBase, BaseMat, rec(
    rChildren := self >> [self.N, self.n, self.base, self.stride],
    rSetChild := rSetChildFields("N", "n", "base", "stride"),
    new := (self, N, n, base, stride) >>
SPL(WithBases(self, rec(
      	N:= N, n := n, base := base, stride := stride, dimensions := [N, n]))),
    dims := self >> self.dimensions,
    sums := self >> self,
    area := self >> self.n,
    isReal := self >> true,
    transpose := self >> GathH(self.N, self.n, self.base, self.stride),
    conjTranspose := self >> self.transpose(),
    inverse := self >> self.transpose(),
    toAMat := self >> let(
	   n := self.n,
       N := self.N,
       base := self.base,
       stride := self.stride,
       TransposedAMat(AMatMat(List([0..n-1], row -> let(
         idx := base+row*stride,
		 BasisVec(N, idx))))
    )),
    isIdentity := self >> (self.n=self.N) and self.base=0 and self.stride = 1,
));

Class(VGath_L, SumsBase, BaseMat, rec(
    rChildren := self >> [self.N, self.n, self.base],
    rSetChild := rSetChildFields("N", "n", "base"),
    new := (self, N, n, base) >>
	SPL(WithBases(self, rec(
      	N:= N, n := n, base := base, dimensions := [2, N]))),
    dims := self >> self.dimensions,
    sums := self >> self,
    area := self >> self.n,
    isReal := self >> true,
    transpose := self >> VScat_L(self.N, self.n, self.base),
    conjTranspose := self >> self.transpose(),
    inverse := self >> self.transpose(),
    toAMat := self >> let(
	   n := self.n,
       N := self.N,
       base := self.base,
       AMatSPL(L(2*n, 2) * Tensor(SPLAMat(AMatMat(List([0..n-1], row -> let(
         idx := base+row,
		 BasisVec(N, idx))))), I(2)))
    ),
    isIdentity := False
));

Class(VScat_L, SumsBase, BaseMat, rec(
    rChildren := self >> [self.N, self.n, self.base],
    rSetChild := rSetChildFields("N", "n", "base"),
    new := (self, N, n, base) >>
SPL(WithBases(self, rec(
      	N:= N, n := n, base := base, dimensions := [N, 2]))),
    dims := self >> self.dimensions,
    sums := self >> self,
    area := self >> self.n,
    isReal := self >> true,
    transpose := self >> VGath_L(self.N, self.n, self.base),
    conjTranspose := self >> self.transpose(),
    inverse := self >> self.transpose(),
    toAMat := self >> TransposedAMat(self.transpose().toAMat()),
    isIdentity := False
));


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

# NOTE: The first section is Intel SSE/2/3 specific, and has to be ported
# over to SPU

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

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

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

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

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


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

# ==========================================================================
# RowDirectSum
# ==========================================================================
Class(RowDirectSum, BaseOverlap, rec(
    #-----------------------------------------------------------------------
    abbrevs := [
        function(arg)
          arg:=Flat(arg);
          return [arg[1], arg{[2..Length(arg)]}];
        end ],
    #-----------------------------------------------------------------------
    new := meth(self, overlap, spls)
       return self._new(0, overlap, spls);
    end,
    #-----------------------------------------------------------------------
    _dims := meth(self)
        local ovdim;
    ovdim := self.ovDim(self.overlap,
                        List(self._children, t -> t.dimensions[2]));
    return [ Sum(self._children, t -> t.dimensions[1]),
             ovdim[3] - ovdim[2] + 1 # max - min + 1
    ];
    end,
    dims := self >> When(IsBound(self._setDims), self._setDims, let(d := Try(self._dims()),
	    When(d[1], d[2], [errExp(TInt), errExp(TInt)]))),
    #-----------------------------------------------------------------------
    toAMat := meth(self)
        return
      DirectSumAMat(List(self._children, AMatSPL)) *
      AMatSPL(
          Sparse(
          self._rowoverlap(
              List(self._children, t -> t.dimensions[2]),
              self.overlap
          )
          )
      );
    end,
    #-----------------------------------------------------------------------
    arithmeticCost := meth(self, costMul, costAddMul)
        return Sum(List(self.children(), x -> x.arithmeticCost(costMul, costAddMul)));
    end
));


for i in [10, 9 .. 0] do
    Print(i, "\n");
od;


#############################################################################
##
#W  loewy.gi             GAP 4 package SingerAlg                Thomas Breuer
##
##  This file contains implementations of GAP functions for studying
##  the Loewy structure of Singer algebras A[q,z].
##

##  for those who worked with an earlier version of the package ...
LoewyLayersData:= function( arg )
    Print( "use LoewyStructureInfo not LoewyLayersData\n" );
    return CallFuncList( LoewyStructureInfoGAP, arg );
    end;

if IsPackageMarkedForLoading( "JuliaInterface", "" ) then

#############################################################################
##
#M  LoewyStructureInfoJulia( <A> )
##
##  Call a Julia function, convert its result to a record,
##  but keep the record components in Julia.
##
InstallMethod( LoewyStructureInfoJulia,
    [ "IsSingerAlgebra" ],
    A -> CallFuncList( LoewyStructureInfoJulia,
                       ParametersOfSingerAlgebra( A ) ) );

InstallMethod( LoewyStructureInfoJulia,
    [ "IsPosInt", "IsPosInt" ],
    { q, z } -> LoewyStructureInfoJulia( q, OrderMod( q, z ), z ) );

InstallMethod( LoewyStructureInfoJulia,
    [ "IsPosInt", "IsPosInt", "IsPosInt" ],
    { q, n, z } -> CallFuncList( Julia.SingerAlg.LoewyStructureInfo,
                       List( [ q, n, z ], GAPToJulia ) ) );

fi;

if IsPackageMarkedForLoading( "JuliaInterface", "" ) then

#############################################################################
##
#M  LoewyStructureInfo( <A> )
##
##  We prefer 'LoewyStructureInfoJulia' to 'LoewyStructureInfoGAP'.
##  For that, we convert the Julia dictionary into a GAP record.
##
InstallMethod( LoewyStructureInfo,
    [ "IsSingerAlgebra" ],
    A -> JuliaToGAP( IsRecord, LoewyStructureInfoJulia( A ), true ) );

InstallMethod( LoewyStructureInfo,
    [ "IsPosInt", "IsPosInt" ],
    { q, z } -> LoewyStructureInfo( q, OrderMod( q, z ), z ) );

InstallMethod( LoewyStructureInfo,
    [ "IsPosInt", "IsPosInt", "IsPosInt" ],
    { q, n, z } -> JuliaToGAP( IsRecord, LoewyStructureInfoJulia( q, n, z ),
                               true ) );

fi;

#############################################################################
##
#F  LoewyStructureInfoGAP( <A> )
#F  LoewyStructureInfoGAP( <q>[, <n>], <z> )
##
InstallMethod( LoewyStructureInfoGAP,
    [ "IsSingerAlgebra" ],
    A -> CallFuncList( LoewyStructureInfoGAP,
                       ParametersOfSingerAlgebra( A ) ) );

InstallMethod( LoewyStructureInfoGAP,
    [ "IsPosInt", "IsPosInt" ],
    { q, z } -> LoewyStructureInfoGAP( q, OrderMod( q, z ), z ) );

InstallMethod( LoewyStructureInfoGAP,
    [ "IsPosInt", "IsPosInt", "IsPosInt" ],
    function( q, n, z )
    local islessorequal, monomials, layers, degrees, predecessors, m, i,
          mon, lambda, pred, j, mm;

    if n mod OrderMod( q, z ) <> 0 then
      Error( "<z> must divide <q>^<n> - 1" );
    fi;

    islessorequal:= function( mon1, mon2 )
      local i;

      for i in [ 1 .. n ] do
        if mon2[i] < mon1[i] then
          return false;
        fi;
      od;
      return true;
    end;

    monomials:= [ 0 * [ 1 .. n ] ];
    layers:= [ 0 ];
    degrees:= [ 0 ];    # just for speedup: avoid comparisons

    predecessors:= [ 0 ];

    m:= n * (q-1);
    for i in [ 1 .. z ] do
      mon:= CoefficientsQadicReversed( i, z, q, n );
      lambda:= 0;
      pred:= 1;
      mm:= Sum( mon );
      for j in [ 2 .. i ] do
        if lambda < layers[j] and degrees[j] < mm
                              and islessorequal( monomials[j], mon ) then
          lambda:= layers[j];
          pred:= j;
        fi;
      od;
      monomials[i+1]:= mon;
      layers[i+1]:= lambda + 1;
      degrees[i+1]:= mm;
      predecessors[i+1]:= pred;

      if lambda = 0 then
        if mm < m then
          m:= mm;
        fi;
      fi;
    od;

    # Extract information about one longest chain.
    i:= Length( monomials );
    pred:= [];
    while i > 0 do
      Add( pred, i );
      i:= predecessors[i];
    od;

    return rec( monomials:= monomials,
                layers:= layers,
                chain:= pred,
                m:= m,
                LL:= lambda + 2,
                parameters:= [ q, n, z ] );
    end );

#############################################################################
##
#F  DimensionsLoewyFactorsGAP( <A> )
#F  DimensionsLoewyFactorsJulia( <A> )
##
##  Return the GAP object or the Julia object, respectively.
##
BindGlobal( "DimensionsLoewyFactorsGAP", function( A )
    local data, v, i;

    data:= LoewyStructureInfoGAP( A );
    v:= ListWithIdenticalEntries( data.LL, 0 );
    for i in data.layers do
      v[ i+1 ]:= v[ i+1 ] + 1;
    od;

    return v;
    end );

if IsPackageMarkedForLoading( "JuliaInterface", "" ) then

BindGlobal( "DimensionsLoewyFactorsJulia",
    A -> Julia.SingerAlg.LoewyVector( LoewyStructureInfoJulia( A ) ) );

fi;

#############################################################################
##
#M  DimensionsLoewyFactors( <A> )
##
##  If Julia is available then use the Julia functionality,
##  otherwise use the GAP code.
##
InstallMethod( DimensionsLoewyFactors,
    [ "IsSingerAlgebra" ],
    A -> DimensionsLoewyFactorsGAP( A ) );

if IsPackageMarkedForLoading( "JuliaInterface", "" ) then

InstallMethod( DimensionsLoewyFactors,
    [ "IsSingerAlgebra" ],
    A -> JuliaToGAP( IsList, DimensionsLoewyFactorsJulia( A ), true ) );

fi;

#############################################################################
##
#F  LoewyVectorAbbreviated( <v> )
#F  LoewyVectorExpanded( <v> )
##
InstallGlobalFunction( LoewyVectorAbbreviated, function( v )
    local result, x, m, i;

    if not IsDenseList( v ) then
      Error( "<v> must be a dense list" );
    elif Length( v ) = 0 then
      return [];
    fi;
    result:= [];
    x:= v[1];
    m:= 1;
    for i in [ 2 .. Length( v ) ] do
      if v[i] = x then
        m:= m + 1;
      elif m = 1 then
        Add( result, x );
        x:= v[i];
      else
        Add( result, [ x, m ] );
        x:= v[i];
        m:= 1;
      fi;
    od;

    if m = 1 then
      Add( result, x );
    else
      Add( result, [ x, m ] );
    fi;

    return result;
    end );

InstallGlobalFunction( LoewyVectorExpanded, function( v )
    local result, x, i;

    if not IsDenseList( v ) then
      Error( "<v> must be a dense list" );
    fi;
    result:= [];
    for x in v do
      if IsList( x ) then
        for i in [ 1 .. x[2] ] do
          Add( result, x[1] );
        od;
      else
        Add( result, x );
      fi;
    od;

    return result;
    end );

#############################################################################
##
#F  SingerAlgebra( <q>[, <n>], <z>[, <R>] )
#F  SingerAlgebra( <arec>[, <R>] )
##
##  The algebra returned by this function claims to be a structure constants
##  algebra (via the filter 'IsSCAlgebraObjCollection'),
##  but the structure constants table is not created until one asks for
##  something that needs it.
##  Currently a special method for 'CanonicalBasis' makes sure that the
##  relevant data get stored.
##
InstallGlobalFunction( SingerAlgebra, function( arg )
    local arec, paras, q, n, e, R, z, zero, filter, Fam, A;

    if Length( arg ) = 1 and IsRecord( arg[1] ) then
      # The record is assumed to belong to the database of Singer algebras.
      arec:= arg[1];
      q:= arec.q;
      n:= arec.n;
      if IsBound( arec.z ) then
        z:= arec.z;
      elif IsBound( arec.e ) then
        z:= ( q^n - 1 ) / arec.e;
      else
        Error( "<arec> must contain one of the components z or e" );
      fi;
      R:= Rationals;
    elif Length( arg ) = 2 and IsRecord( arg[1] ) and IsRing( arg[2] ) then
      # The record is assumed to belong to the database of Singer algebras.
      arec:= arg[1];
      q:= arec.q;
      n:= arec.n;
      if IsBound( arec.z ) then
        z:= arec.z;
      elif IsBound( arec.e ) then
        z:= ( q^n - 1 ) / arec.e;
      else
        Error( "<arec> must contain one of the components z or e" );
      fi;
      R:= arg[2];
    elif Length( arg ) = 1 and IsList( arg[1] ) then
      # The parameters must be q, n, e[, R].
      paras:= arg[1];
      if Length( paras ) = 3 then
        q:= paras[1];
        n:= paras[2];
        e:= paras[3];
        R:= Rationals;
      elif Length( paras ) = 4 then
        q:= paras[1];
        n:= paras[2];
        e:= paras[3];
        R:= paras[4];
      else
        Error( "usage: SingerAlgebra( <list> ) with list of length 3 or 4" );
      fi;
      z:= ( q^n - 1 ) / e;
    elif Length( arg ) = 2 then
      # The parameters must be q, z.
      q:= arg[1];
      z:= arg[2];
      n:= OrderMod( q, z );
      R:= Rationals;
    elif Length( arg ) = 3 and IsInt( arg[3] ) then
      # The parameters must be q, n, z.
      q:= arg[1];
      n:= arg[2];
      z:= arg[3];
      R:= Rationals;
    elif Length( arg ) = 3 and IsRing( arg[3] ) then
      # The parameters must be q, z, R.
      q:= arg[1];
      z:= arg[2];
      R:= arg[3];
      n:= OrderMod( q, z );
    elif Length( arg ) = 4 then
      # The parameters must be q, n, z, R.
      q:= arg[1];
      n:= arg[2];
      z:= arg[3];
      R:= arg[4];
    else
      Error( "usage: SingerAlgebra( <arec>[, <R>] ) or ",
             "SingerAlgebra( <q>[, <n>], <z>[, <R>] ) or ",
             "SingerAlgebra( <list> )" );
    fi;

    if not ( IsPosInt( q ) and IsPosInt( n ) and IsPosInt( z ) ) then
      Error( "<q>, <n>, <z> must be positive integers" );
    elif z <> 1 and PowerMod( q, n, z ) <> 1 then
      Error( "<z> must divide <q>^<n> - 1" );
    elif q = 1 then
      Error( "<q> must be an integer > 1" );
    fi;

    # Create the algebra as far as necessary.
    # (Do not set a 'Name' value, in order to use the different methods
    # installed for 'ViewObj' and 'PrintObj'.)
    zero := Zero( R );
    filter:= IsSCAlgebraObj;
    if IsAdditivelyCommutativeElementFamily( FamilyObj( zero ) ) then
      filter:= filter and IsAdditivelyCommutativeElement;
    fi;
    Fam:= NewFamily( "SCAlgebraObjFamily", filter );
    if Zero( ElementsFamily( FamilyObj( R ) ) ) <> fail then
      SetFilterObj( Fam, IsFamilyOverFullCoefficientsFamily );
    else
      Fam!.coefficientsDomain:= R;
    fi;
    Fam!.zerocoeff := zero;
    SetCharacteristic( Fam, Characteristic( R ) );
    SetCoefficientsFamily( Fam, ElementsFamily( FamilyObj( R ) ) );

    A:= Objectify( NewType( CollectionsFamily( Fam ),
                   IsSingerAlgebra and IsAttributeStoringRep ),
                   rec() );
    SetLeftActingDomain( A, R );
    SetParametersOfSingerAlgebra( A, [ q, n, z ] );
    SetGeneratingSubsetOfCanonicalBasisOfSingerAlgebra( A, [ 1 .. z+1 ] );
    SetDimension( A, z+1 );
    Fam!.fullSCAlgebra:= A;
    SetIsFullSCAlgebra( A, true );

    return A;
    end );

#############################################################################
##
#M  Display( <A> )
#M  ViewObj( <A> )
#M  PrintObj( <A> )
#M  DisplayString( <A> )
#M  ViewString( <A> )
#M  PrintString( <A> )
#M  String( <A> )
##
##  According to the Section "View and Print" in the GAP Reference Manual,
##  we need methods (only) for
##  'String' (which then covers 'PrintString' and 'PrintObj') and
##  'ViewString' (which then covers 'ViewObj').
##  (We do not need 'DisplayString', which would cover 'Display'.)
##
##  We want to *view* Singer algebras as 'A[q,n,z[,R]]',
##  and to *print* them as calls to 'SingerAlgebra'.
##
InstallMethod( ViewString,
    [ "IsSingerAlgebra" ],
    function( A )
    local paras;

    paras:= ParametersOfSingerAlgebra( A );
    if LeftActingDomain( A ) = Rationals then
      return Concatenation( "A[",
                 JoinStringsWithSeparator( List( paras, String ), "," ),
                 "]" );
    else
      return Concatenation( "A[",
                 JoinStringsWithSeparator( List( paras, String ), "," ),
                 ",", String( LeftActingDomain( A ) ), "]" );
    fi;
    end );

InstallMethod( String,
    [ "IsSingerAlgebra" ],
    function( A )
    local paras;

    paras:= ParametersOfSingerAlgebra( A );
    if LeftActingDomain( A ) = Rationals then
      return Concatenation( "SingerAlgebra( ",
                 JoinStringsWithSeparator( List( paras, String ), ", " ),
                 " )" );
    else
      return Concatenation( "SingerAlgebra( ",
                 JoinStringsWithSeparator( List( paras, String ), ", " ),
                 ", ", String( LeftActingDomain( A ) ), " )" );
    fi;
    end );

#T Currently the above installations are unfortunately *not* enough,
#T since some 'ViewObj' and 'PrintObj' methods for algebras interfere,
#T as well as a 'PrintString' method for magmas.

InstallMethod( ViewObj,
    [ "IsSingerAlgebra" ],
    function( A ) Print( ViewString( A ) ); end );

InstallMethod( PrintObj,
    [ "IsSingerAlgebra" ],
    function( A ) Print( PrintString( A ) ); end );

InstallMethod( PrintString,
    [ "IsSingerAlgebra" ],
    String );

#############################################################################
##
#M  CanonicalBasis( <A> )
##
##  This method provides the internal data for treating the Singer algebra
##  <A> as a structure constants algebra in GAP.
##
##  Formally, we require those filters that are required also by the
##  GAP library method for full s.c. algebras,
##  in order to guarantee a higher rank for our method;
##  these filters are set in algebras returned by 'SingerAlgebra'.
##
InstallMethod( CanonicalBasis,
    [ Concatenation( "IsSingerAlgebra and IsFreeLeftModule and ",
                     "IsSCAlgebraObjCollection and IsFullSCAlgebra" ) ],
    function( A )
    local paras, q, n, z, dim, coeffs, T, R, zero, one, empty, nonempty,
          i, j, Fam, gens;

    # Create the structure constants table.
    paras:= ParametersOfSingerAlgebra( A );
    q:= paras[1];
    n:= paras[2];
    z:= paras[3];
    dim:= Dimension( A );
    coeffs:= List( [ 0 .. z ],
                   k -> CoefficientsQadicReversed( k, z, q, n ) );
    T:= [];
    R:= LeftActingDomain( A );
    zero:= Zero( R );
    one:= One( R );
    empty:= MakeImmutable( [ [], [] ] );
    nonempty:= List( [ 1 .. dim ],
                     i -> MakeImmutable( [ [ i ], [ one ] ] ) );
    for i in [ 1 .. dim ] do
      T[i]:= [];
      for j in [ 1 .. i-1 ] do
        T[i][j]:= T[j][i];
      od;
      for j in [ i .. dim-i+1 ] do
        if q <= MaximumList( coeffs[i] + coeffs[j], 0 ) then
          T[i][j]:= empty;
        else
          T[i][j]:= nonempty[ i+j-1 ];
        fi;
      od;
      for j in [ dim-i+2 .. dim ] do
        T[i][j]:= empty;
      od;
    od;
    T[ dim+1 ]:= 1;  # commutativity flag
    T[ dim+2 ]:= zero;

    # Set the necessary entries in the family.
    Fam:= ElementsFamily( FamilyObj( A ) );
    Fam!.sctable:= T;
    Fam!.names:= MakeImmutable( List( [ 0 .. dim-1 ],
                     i -> Concatenation( "b", String( i ) ) ) );
    Fam!.zerocoeff:= zero;
    Fam!.defaultTypeDenseCoeffVectorRep :=
        NewType( Fam, IsSCAlgebraObj and IsDenseCoeffVectorRep );
    SetZero( Fam, ObjByExtRep( Fam, ListWithIdenticalEntries( dim, zero ) ) );

    # Set the algebra generators.
    gens:= MakeImmutable( List( IdentityMat( dim, R ),
               x -> ObjByExtRep( Fam, x ) ) );
    SetGeneratorsOfAlgebra( A, gens );
    SetGeneratorsOfAlgebraWithOne( A, gens );
    SetOne( A, gens[1] );
    Fam!.basisVectors:= gens;

    # Delegate to the library method for full s.c. algebras,
    # which has a lower rank.
    TryNextMethod();
    end );

#############################################################################
##
#M  Representative( <A> )
#M  GeneratorsOfAlgebra( <A> )
#M  GeneratorsOfAlgebraWithOne( <A> )
##
##  Note that we cannot use 'RedispatchOnCondition' here,
##  because we have only the attribute tester 'HasCanonicalBasis'
##  that may be missing,
##  whereas 'RedispatchOnCondition' checks for missing property values
##  plus their testers.
##
InstallMethod( Representative,
    [ "IsSingerAlgebra" ],
    function( A )
    if HasCanonicalBasis( A ) then
      TryNextMethod();
    fi;

    # Set the necessary data and redispatch.
    CanonicalBasis( A );
    return Representative( A );
    end );

InstallMethod( GeneratorsOfAlgebra,
    [ "IsSingerAlgebra" ],
    function( A )
    if HasCanonicalBasis( A ) then
      TryNextMethod();
    fi;

    # Set the necessary data and redispatch.
    CanonicalBasis( A );
    return GeneratorsOfAlgebra( A );
    end );

InstallMethod( GeneratorsOfAlgebraWithOne,
    [ "IsSingerAlgebra" ],
    function( A )
    if HasCanonicalBasis( A ) then
      TryNextMethod();
    fi;

    # Set the necessary data and redispatch.
    CanonicalBasis( A );
    return GeneratorsOfAlgebraWithOne( A );
    end );

#############################################################################
##
#M  GeneratingSubsetOfCanonicalBasisOfSingerAlgebra( <triv> )
##
##  Provide a method for the trivial subspace/subalgebra of a Singer algebra.
##  (We cannot be sure that this attribute gets set on creation.)
##
InstallMethod( GeneratingSubsetOfCanonicalBasisOfSingerAlgebra,
    [ "IsVectorSpace and HasParent" ],
    function( V )
    if IsSingerAlgebra( Parent( V ) ) and IsTrivial( V ) then
      return [];
    fi;
    TryNextMethod();
    end );

#############################################################################
##
#M  LoewyLengthGAP( <A> )
#M  LoewyLengthGAP( <q>, <z> )
#M  LoewyLengthGAP( <q>, <n>, <z>, <m> )
##
##  Use stored 'LoewyStructureInfoGAP' values,
##  use the cheap criteria when the upper bound is attained (using <m>),
##  compute 'LoewyStructureInfoGAP' only if necessary.
##
InstallMethod( LoewyLengthGAP,
    [ "IsSingerAlgebra and HasLoewyStructureInfoGAP" ],
    A -> LoewyStructureInfoGAP( A ).LL );

InstallMethod( LoewyLengthGAP,
    [ "IsSingerAlgebra" ],
    function( A )
    local m, paras;

    # We need m(q,e) anyhow in order to compute the upper bound
    # to which the cheap criteria refer.
    m:= MinimalDegreeOfSingerAlgebraGAP( A );
    if HasLoewyStructureInfoGAP( A ) then
      # Perhaps the computation of 'm' has triggered this.
      return LoewyStructureInfoGAP( A ).LL;
    else
      paras:= ParametersOfSingerAlgebra( A );
      return LoewyLengthGAP( paras[1], paras[2], paras[3], m );
    fi;
    end );

InstallMethod( LoewyLengthGAP,
    [ "IsPosInt", "IsPosInt" ],
    function( q, z )
    local n;

    n:= OrderMod( q, z );
    return LoewyLengthGAP( q, n, z,
               MinimalDegreeOfSingerAlgebraGAP( q, SingerAlgE( q, n, z ) ) );
    end );

InstallMethod( LoewyLengthGAP,
    [ "IsPosInt", "IsPosInt", "IsPosInt", "IsPosInt" ],
    function( q, n, z, m )
    local l;

    l:= LoewyLengthCheapGAP( q, n, z, m );
    if l = 0 then
      l:= LoewyLengthHardGAP( q, n, z, m );
    fi;
    return l;
    end );

#############################################################################
##
#F  OrderModExt( <n>, <m>[, <bound>] )
##
##  The optional argument <bound> is not yet supported for 'OrderMod'
##  in GAP 4.11.0, but it is useful in the context of this package.
##
InstallGlobalFunction( OrderModExt, function( n, m, bound... )
    local  x, o, d;

    # check the arguments and reduce $n$ into the range $0..m-1$
    if m <= 0  then Error("<m> must be positive");  fi;
    if n < 0   then n := n mod m + m;  fi;
    if m <= n  then n := n mod m;      fi;

    # return 0 if $m$ is not coprime to $n$
    if GcdInt(m,n) <> 1  then
        o := 0;

    # compute the order simply by iterated multiplying, $x= n^o$ mod $m$
    elif m < 100  then
        x := n;  o := 1;
        while x > 1  do
            x := x * n mod m;  o := o + 1;
        od;

    # otherwise try the divisors of $\lambda(m)$ and their divisors, etc.
    else
        if Length( bound ) = 1 then
            # We know a multiple of the desired order.
            o := bound[1];
        else
            # The default a priori known multiple is 'Lambda( m )'.
            o := Lambda( m );
        fi;
        for d in PrimeDivisors( o ) do
            while o mod d = 0  and PowerModInt(n,o/d,m) = 1  do
                o := o / d;
            od;
        od;

    fi;

    return o;
    end );

#############################################################################
##
#F  SufficientCriterionForLoewyBoundAttained( <q>, <n>, <z>, <m> )
##
InstallGlobalFunction( SufficientCriterionForLoewyBoundAttained,
    function( q, n, z, m )
    local qm, e, r, p, sum, d, phi6;

    if n <= 3 then
      return "Cor. I.7.1 (n <= 3)";
    elif z < 70 then
      # The bound is attained, by the classif. of small dim. Singer alg.
      return "z < 70";
    elif m = 2 then
      return "La. I.6.3";
    elif ( q - 1 ) mod m = 0 then
      return "Thm. I.7.1";
    elif n * (q-1) < 3 * m then
      return "La. I.7.1 (iii)";
    fi;

    qm:= q mod m;
    if 1 < qm and Int( n * ( qm-1 ) / m ) = 1 then
      return "Prop. II.3.15";
    fi;

    e:= ( q^n - 1 ) / z;

    if e <= 32 then
      return "Prop. II.6.1 (e <= 32)";
    elif e <= 3 * m then
      return "Prop. II.6.4";
    elif n <= 5 and ((q^n-1)/(q-1)) mod e = 0 then
      return "Prop. II.5.3, II.5.6 (e | (q^n-1)/(q-1), n <= 5)";
    elif n mod ( m / Gcd( m, q-1 ) * OrderModExt( q, e, n ) ) = 0 then
      return "La. II.5.2 (ii)";
    fi;

    if ( (q^n-1)/(q-1) ) mod e = 0 then
      # we know m <= n
      if m >= n-1 then
        return "Prop. II.5.1 (ii)";
      elif  m = n-2 and ( q mod m ) in [ 1 .. Int( (m+1)/2 ) ] then
        return "Prop. II.5.1 (iii)";
      elif Int( (n-m) * (q-1) / m ) mod ( n-m ) = 0 then
        return "Prop. II.5.1 (i)";
      fi;
    fi;

    if ( n mod m = 0 ) then
      if Sum( List( [ 0 .. m-1 ], i -> q^(i*n/m) ) ) mod e = 0 then
        return "La. II.4.1 for r = 1";
      fi;
      for r in DivisorsInt( n ) do
        if (n/r) mod m = 0 and
           Sum( [ 0 .. m-1 ], i -> q^(n*i/(m*r)) ) mod e = 0 then
          return "La. II.4.1";
        fi;
      od;
    fi;

    p:= SmallestRootInt( e );

    if p = 2 then
      return "Thm. II.4.3 (iii)";
    elif IsPrimeInt( p ) then
      # (Here we know that 'q mod p <> 1' holds.)
      # Check whether 'p' is a Pierpont prime.
      p:= p - 1;
      while p mod 2 = 0 do
        p:= p/2;
      od;
      while p mod 3 = 0 do
        p:= p/3;
      od;
      if p = 1 then
        return "Thm. II.4.3 (ii)";
      fi;
    fi;

    # Concerning Remark II.5.4,
    # we need not check \Phi_2 (since m = e if e divides q-1,
    # and we have checked whether m divides q-1),
    # \Phi_4, \Phi_8 (because then m = 2).
    phi6:= q^2 - q + 1;    # this is \Phi_6(q)
    if phi6 mod e = 0 or
       ( q^3*(q^3+1) + 1 ) mod e = 0 or     # this is \Phi_9(q)
       ( q^3*(q-1) + phi6 ) mod e = 0 then  # this is \Phi_{10}(q)
      return "Rem. II.5.4";
    fi;

    # We give up.
    return "";
    end );

InstallGlobalFunction( LoewyLengthCheapGAP, function( q, n, z, m )
    if SufficientCriterionForLoewyBoundAttained( q, n, z, m ) <> "" then
      return Int( n * ( q - 1 ) / m ) + 1;
    else
      return 0;
    fi;
    end );

InstallGlobalFunction( LoewyLengthHardGAP,
    { q, n, z, m } -> LoewyStructureInfoGAP( q, n, z ).LL );

#############################################################################
##
#M  LoewyLengthJulia( <A> )
#M  LoewyLengthJulia( <q>, <z> )
#M  LoewyLengthJulia( <q>, <n>, <z>, <m> )
##
##  Use the same criteria as for the &GAP; variant.
##  These methods are available only if &Julia; is available.
##
if IsPackageMarkedForLoading( "JuliaInterface", "" ) then

InstallMethod( LoewyLengthJulia,
    [ "IsSingerAlgebra and HasLoewyStructureInfoJulia" ],
    A -> JuliaToGAP( IsInt,
             Julia.Base.get( LoewyStructureInfoJulia( A ),
                             JuliaSymbol( "LL" ), 0 )  ));

InstallMethod( LoewyLengthJulia,
    [ "IsSingerAlgebra" ],
    function( A )
    local paras;

    paras:= ParametersOfSingerAlgebra( A );

    # Leave the computation of m(q,e) and of the Loewy length to Julia,
    # let Julia set also the 'MinimalDegreeOfSingerAlgebraJulia' value in A.
    return JuliaToGAP( IsInt,
               Julia.SingerAlg.LoewyLength( paras[1], paras[2], paras[3],
                   A ) );
    end );

InstallMethod( LoewyLengthJulia,
    [ "IsPosInt", "IsPosInt" ],
    function( q, z )
    return JuliaToGAP( IsInt, Julia.SingerAlg.LoewyLength( q, z ) );
    end );

InstallMethod( LoewyLengthJulia,
    [ "IsPosInt", "IsPosInt", "IsPosInt", "IsPosInt" ],
    function( q, n, z, m )
    return JuliaToGAP( IsInt,
               Julia.SingerAlg.LoewyLength( q, n, z, m ) );
    end );

fi;

#############################################################################
##
#M  RadicalOfAlgebra( <A> )
##
##  The Jacobson radical of a Singer algebra of dimension <M>z+1</M>
##  has the basis <M>[ b_1, b_2, \ldots, b_z ]</M>.
##
InstallMethod( RadicalOfAlgebra,
    [ "IsSingerAlgebra" ],
    function( A )
    local B, range, S;

    B:= BasisVectors( CanonicalBasis( A ) );
    range:= [ 2 .. Length( B ) ];
    S:= SubalgebraNC( A, B{ range }, "basis" );
    SetGeneratingSubsetOfCanonicalBasisOfSingerAlgebra( S, range );

    return S;
    end );

#############################################################################
##
#M  RadicalSeriesOfAlgebra( <A> )
##
InstallMethod( RadicalSeriesOfAlgebra,
    [ "IsSingerAlgebra" ],
    function( A )
    local result, data, B, i, S;

    result:= [ A, RadicalOfAlgebra( A ) ];
    data:= LoewyStructureInfoGAP( A );
    data:= SingerAlg.BasesOfRadicalSeries( data );
    B:= BasisVectors( CanonicalBasis( A ) );
    for i in [ 2 .. Length( data ) ] do
      S:= SubalgebraNC( A, B{ data[i] }, "basis" );
      SetGeneratingSubsetOfCanonicalBasisOfSingerAlgebra( S, data[i] );
      result[i+1]:= S;
    od;
    Add( result, TrivialSubalgebra( A ) );

    return result;
    end );

#############################################################################
##
#M  SocleSeriesOfAlgebra( <A> )
##
InstallMethod( SocleSeriesOfAlgebra,
    [ "IsSingerAlgebra" ],
    function( A )
    local result, data, B, i, S;

    result:= [ TrivialSubalgebra( A ) ];
    data:= LoewyStructureInfoGAP( A );
    data:= SingerAlg.BasesOfSocleSeries( data );
    B:= BasisVectors( CanonicalBasis( A ) );
    for i in [ 1 .. Length( data ) ] do
      S:= SubalgebraNC( A, B{ data[i] }, "basis" );
      SetGeneratingSubsetOfCanonicalBasisOfSingerAlgebra( S, data[i] );
      result[i+1]:= S;
    od;
    Add( result, A );

    return result;
    end );

#############################################################################
##
#M  Intersection2( <A>, <B> )
##
InstallMethod( Intersection2,
    IsIdenticalObj,
    [ "IsVectorSpace and HasGeneratingSubsetOfCanonicalBasisOfSingerAlgebra",
      "IsVectorSpace and HasGeneratingSubsetOfCanonicalBasisOfSingerAlgebra" ],
    100,  # beat generic methods for two 'IsFLMLORWithOne'
    function( A, B )
    local P, basis, data, S;

    P:= Parent( A );
    if not IsIdenticalObj( P, Parent( B ) ) then
      TryNextMethod();
    fi;
    basis:= BasisVectors( CanonicalBasis( P ) );
    data:= Intersection2(
               GeneratingSubsetOfCanonicalBasisOfSingerAlgebra( A ),
               GeneratingSubsetOfCanonicalBasisOfSingerAlgebra( B ) );
    S:= SubspaceNC( P, basis{ data }, "basis" );
    SetGeneratingSubsetOfCanonicalBasisOfSingerAlgebra( S, data );

    return S;
    end );

#############################################################################
##
#M  \+( <A>, <B> )
##
InstallOtherMethod( \+,
    IsIdenticalObj,
    [ "IsVectorSpace and HasGeneratingSubsetOfCanonicalBasisOfSingerAlgebra",
      "IsVectorSpace and HasGeneratingSubsetOfCanonicalBasisOfSingerAlgebra" ],
    100,  # beat generic methods for two rings, two left modules
    function( A, B )
    local P, basis, data, S;

    P:= Parent( A );
    if not IsIdenticalObj( P, Parent( B ) ) then
      TryNextMethod();
    fi;
    basis:= BasisVectors( CanonicalBasis( P ) );
    data:= Union(
               GeneratingSubsetOfCanonicalBasisOfSingerAlgebra( A ),
               GeneratingSubsetOfCanonicalBasisOfSingerAlgebra( B ) );
    S:= SubspaceNC( P, basis{ data }, "basis" );
    SetGeneratingSubsetOfCanonicalBasisOfSingerAlgebra( S, data );

    return S;
    end );

#############################################################################
##
#M  ProductSpace( <A>, <B> )
##
InstallMethod( ProductSpace,
    IsIdenticalObj,
    [ "IsVectorSpace and HasGeneratingSubsetOfCanonicalBasisOfSingerAlgebra",
      "IsVectorSpace and HasGeneratingSubsetOfCanonicalBasisOfSingerAlgebra" ],
    100,  # beat generic methods for two algebras, two left modules
    function( A, B )
    local P, basis, data, S;

    P:= Parent( A );
    if not IsIdenticalObj( P, Parent( B ) ) then
      TryNextMethod();
    fi;
    basis:= BasisVectors( CanonicalBasis( P ) );
    data:= LoewyStructureInfoGAP( P );
    data:= SingerAlg.BasisOfProductSpace( data,
               GeneratingSubsetOfCanonicalBasisOfSingerAlgebra( A ),
               GeneratingSubsetOfCanonicalBasisOfSingerAlgebra( B ) );
    S:= SubspaceNC( P, basis{ data }, "basis" );
    SetGeneratingSubsetOfCanonicalBasisOfSingerAlgebra( S, data );

    return S;
    end );

#############################################################################
##
#F  CoefficientsQadicReversed( <k>, <z>, <q>, <n> )
##
InstallGlobalFunction( CoefficientsQadicReversed, function( k, z, q, n )
    local v, i, r, rq, d;

    v:= [];

    if k = z then
      for i in [ 1 .. n ] do
        v[i]:= q-1;
      od;
    else
      r:= k;
      for i in [ 1 .. n ] do
        rq:= r * q;
        d:= QuoInt( rq, z );
        r:= rq - d * z;
        v[i]:= d;
      od;
    fi;

    return v;
    end );

#############################################################################
##
#F  SingerAlg.MultTable( <data> )
##
##  <#GAPDoc Label="SingerAlg.MultTable">
##  <ManSection>
##  <Func Name="SingerAlg.MultTable" Arg='data'/>
##
##  <Description>
##  Let <A>data</A> be the record returned by
##  <Ref Oper="LoewyStructureInfoGAP" Label="for parameters"/>
##  that describes a Singer algebra <M>A[q,z]</M>,
##  and let <M>B = B(A)</M>.
##  <Ref Func="SingerAlg.MultTable"/> returns the
##  <M>(z+1) \times (z+1)</M> matrix that contains at the position
##  <M>(i,j)</M> the value <M>i+j-1</M> if the product
##  <M>B_i \cdot B_j</M> is nonzero
##  (hence equal to <M>B_{{i+j-1}}</M>, the <M>i+j-1</M>-th basis vector),
##  and <M>0</M> otherwise.
##  <P/>
##  <Example><![CDATA[
##  gap> data:= LoewyStructureInfoGAP( 2, 3, 7 );;
##  gap> Display( SingerAlg.MultTable( data ) );
##  [ [  1,  2,  3,  4,  5,  6,  7,  8 ],
##    [  2,  0,  4,  0,  6,  0,  8,  0 ],
##    [  3,  4,  0,  0,  7,  8,  0,  0 ],
##    [  4,  0,  0,  0,  8,  0,  0,  0 ],
##    [  5,  6,  7,  8,  0,  0,  0,  0 ],
##    [  6,  0,  8,  0,  0,  0,  0,  0 ],
##    [  7,  8,  0,  0,  0,  0,  0,  0 ],
##    [  8,  0,  0,  0,  0,  0,  0,  0 ] ]
##  ]]></Example>
##  <P/>
##  The multiplication table of a Singer algebra of dimension <M>N</M>
##  has the value <M>N</M> on the antidiagonal (<M>i+j = N+1</M>),
##  is zero below the antidiagonal,
##  and contains only <M>N-i</M> and zero on the <M>i</M> parallel above the
##  antidiagonal.
##  </Description>
##  </ManSection>
##  <#/GAPDoc>
##
SingerAlg.MultTable:= function( data )
    local monoms, n, nn, mat, q, qhalf, i, j;

    if not IsBound( data.multtable ) then
      monoms:= data.monomials;
      n:= Length( monoms ); # z+1
      nn:= QuoInt( n+1, 2 );
      mat:= NullMat( n, n );
      q:= data.parameters[1];
      if q mod 2 = 1 then
        qhalf:= QuoInt( q, 2 ) + 1;
      else
        qhalf:= QuoInt( q, 2 );
      fi;
      for i in [ 1 .. nn ] do
        for j in [ 1 .. i-1 ] do
          if ForAll( monoms[i] + monoms[j], x -> x < q ) then
            mat[i,j]:= i+j-1;
            mat[j,i]:= i+j-1;
          fi;
        od;
        if ForAll( monoms[i], x -> x < qhalf ) then
          mat[i,i]:= i+i-1;
        fi;
      od;
      for i in [ nn+1 .. n ] do
        # The [i,j] entry can be nonzero only if i+j <= z+2 holds.
        for j in [ 1 .. n+1-i ] do
          if ForAll( monoms[i] + monoms[j], x -> x < q ) then
            mat[i,j]:= i+j-1;
            mat[j,i]:= i+j-1;
          fi;
        od;
      od;
      data.multtable:= mat;
    fi;

    return data.multtable;
    end;

#############################################################################
##
#F  SingerAlg.BasisOfSum( <data>, <I>, <J> )
#F  SingerAlg.BasisOfIntersection( <data>, <I>, <J> )
##
##  <#GAPDoc Label="SingerAlg.BasisOfSum">
##  <ManSection>
##  <Heading>SingerAlg.BasisOfSum and SingerAlg.BasisOfIntersection</Heading>
##  <Func Name="SingerAlg.BasisOfSum" Arg='data, I, J'/>
##  <Func Name="SingerAlg.BasisOfIntersection" Arg='data, I, J'/>
##
##  <Description>
##  For two subsets <A>I</A>, <A>J</A> of <M>\{ 1, 2, \ldots, z+1 \}</M>,
##  these functions just return the union and the intersection,
##  respectively, of <A>I</A> and <A>J</A>.
##  <P/>
##  <A>I</A> and <A>J</A> describe subsets of a basis, which generate the
##  spaces <M>U</M> and <M>V</M>, say, then the result describes the subset
##  of this basis that generates the sum and the intersection, respectively,
##  of <M>U</M> and <M>V</M>.
##  <P/>
##  <Example><![CDATA[
##  gap> SingerAlg.BasisOfSum( data, [ 1, 2, 3 ], [ 2, 4, 6 ] );
##  [ 1, 2, 3, 4, 6 ]
##  gap> SingerAlg.BasisOfIntersection( data, [ 1, 2, 3 ], [ 2, 4, 6 ] );
##  [ 2 ]
##  ]]></Example>
##  </Description>
##  </ManSection>
##  <#/GAPDoc>
##
SingerAlg.BasisOfSum:= { data, I, J } -> Union( I, J );

SingerAlg.BasisOfIntersection:= { data, I, J } -> Intersection( I, J );

#############################################################################
##
#F  SingerAlg.BasisOfProductSpace( <data>, <I>, <J> )
##
##  <#GAPDoc Label="SingerAlg.BasisOfProductSpace">
##  <ManSection>
##  <Func Name="SingerAlg.BasisOfProductSpace" Arg='data, I, J'/>
##
##  <Description>
##  Let <A>data</A> be the record returned by
##  <Ref Oper="LoewyStructureInfoGAP" Label="for parameters"/>
##  that describes a Singer algebra <M>A = A[q,z]</M>,
##  let <M>B = B(A)</M>,
##  and let <A>I</A>, <A>J</A> be subsets of
##  <M>\{ 1, 2, \ldots, z+1 \}</M>,
##  describing subspaces <M>U</M>, <M>V</M> of <M>A</M> with bases
##  <M>( B_i; i \in I )</M> and <M>( B_i; i \in J )</M>, respectively.
##  <Ref Func="SingerAlg.BasisOfProductSpace"/> returns the subset <M>K</M>
##  of <M>\{ 1, 2, \ldots, z+1 \}</M> such that
##  <M>( B_i; i \in K )</M> is a basis of the product space <M>U \cdot V</M>.
##  <P/>
##  <Example><![CDATA[
##  gap> data:= LoewyStructureInfoGAP( 2, 7 );;
##  gap> radser:= SingerAlg.BasesOfRadicalSeries( data );
##  [ [ 2 .. 8 ], [ 4, 6, 7, 8 ], [ 8 ] ]
##  gap> SingerAlg.BasisOfProductSpace( data, radser[1], radser[1] );
##  [ 4, 6, 7, 8 ]
##  gap> SingerAlg.BasisOfProductSpace( data, radser[1], radser[2] );
##  [ 8 ]
##  gap> SingerAlg.BasisOfProductSpace( data, radser[2], radser[2] );
##  [  ]
##  ]]></Example>
##  </Description>
##  </ManSection>
##  <#/GAPDoc>
##
SingerAlg.BasisOfProductSpace:= function( data, I, J )
    local mat, basis, i, j;

    mat:= SingerAlg.MultTable( data );
    basis:= [];

    for i in I do
      for j in J do
        if mat[i,j] <> 0 then
          AddSet( basis, i+j-1 );
        fi;
      od;
    od;

    return basis;
    end;

#############################################################################
##
#F  SingerAlg.BasisOfIdeal( <data>, <I> )
##
##  <#GAPDoc Label="SingerAlg.BasisOfIdeal">
##  <ManSection>
##  <Func Name="SingerAlg.BasisOfIdeal" Arg='data, I'/>
##
##  <Description>
##  Let <A>data</A> be the record returned by
##  <Ref Oper="LoewyStructureInfoGAP" Label="for parameters"/>
##  that describes a Singer algebra <M>A = A[q,z]</M>,
##  let <M>B = B(A)</M>,
##  and let <A>I</A> be a subset of <M>\{ 1, 2, \ldots, z+1 \}</M>,
##  describing a subspace <M>U</M> of <M>A</M> with basis
##  <M>( B_i; i \in I )</M>.
##  <Ref Func="SingerAlg.BasisOfIdeal"/> returns the subset <M>J</M>
##  of <M>\{ 1, 2, \ldots, z+1 \}</M> such that
##  <M>( B_i; i \in J )</M> is a basis of the ideal <M>U \cdot A</M>.
##  <P/>
##  <Example><![CDATA[
##  gap> data:= LoewyStructureInfoGAP( 2, 7 );;
##  gap> SingerAlg.BasisOfIdeal( data, [ 4 ] );
##  [ 4, 8 ]
##  ]]></Example>
##  </Description>
##  </ManSection>
##  <#/GAPDoc>
##
SingerAlg.BasisOfIdeal:= { data, I } -> SingerAlg.BasisOfProductSpace( data,
              I, [ 1 .. Length( data.monomials ) ] );

#############################################################################
##
#F  SingerAlg.BasisOfAnnihilator( <data>, <I> )
##
##  <#GAPDoc Label="SingerAlg.BasisOfAnnihilator">
##  <ManSection>
##  <Func Name="SingerAlg.BasisOfAnnihilator" Arg='data, I'/>
##
##  <Description>
##  Let <A>data</A> be the record returned by
##  <Ref Oper="LoewyStructureInfoGAP" Label="for parameters"/>
##  that describes a Singer algebra <M>A = A[q,z]</M>,
##  let <M>B = B(A)</M>,
##  and let <A>I</A> be a subset of <M>\{ 1, 2, \ldots, z+1 \}</M>,
##  describing a subspace <M>U</M> of <M>A</M> with basis
##  <M>( B_i; i \in I )</M>.
##  <Ref Func="SingerAlg.BasisOfAnnihilator"/> returns the subset <M>J</M>
##  of <M>\{ 1, 2, \ldots, z+1 \}</M> such that
##  <M>( B_i; i \in J )</M> is a basis of the annihilator
##  <M>\{ x \in A; x \cdot U = 0 \}</M> of <M>U</M> in <M>A</M>.
##  <P/>
##  <Example><![CDATA[
##  gap> data:= LoewyStructureInfoGAP( 2, 7 );;
##  gap> radser:= SingerAlg.BasesOfRadicalSeries( data );
##  [ [ 2 .. 8 ], [ 4, 6, 7, 8 ], [ 8 ] ]
##  gap> List( radser, I -> SingerAlg.BasisOfAnnihilator( data, I ) );
##  [ [ 8 ], [ 4, 6, 7, 8 ], [ 2, 3, 4, 5, 6, 7, 8 ] ]
##  ]]></Example>
##  </Description>
##  </ManSection>
##  <#/GAPDoc>
##
SingerAlg.BasisOfAnnihilator:= function( data, list )
    local mat;

    mat:= SingerAlg.MultTable( data );
    return Filtered( [ 1 .. Length( mat ) ],
                     i -> ForAll( list, j -> mat[i,j] = 0 ) );
    end;

#############################################################################
##
#F  SingerAlg.BasesOfRadicalSeries( <data> )
##
##  <#GAPDoc Label="SingerAlg.BasesOfRadicalSeries">
##  <ManSection>
##  <Func Name="SingerAlg.BasesOfRadicalSeries" Arg='data'/>
##
##  <Description>
##  Let <A>data</A> be the record returned by
##  <Ref Oper="LoewyStructureInfoGAP" Label="for parameters"/>
##  that describes a Singer algebra <M>A = A[q,z]</M>,
##  and let <M>B = B(A)</M>.
##  <Ref Func="SingerAlg.BasesOfRadicalSeries"/> returns the list
##  <M>[ I_1, I_2, \ldots, I_l ]</M> of subsets of
##  <M>\{ 1, 2, \ldots, z+1 \}</M> such that
##  <M>( B_i; i \in I_j )</M> is a basis of the <M>j</M>-th power of the
##  Jacobson radical <M>J</M> of <M>A</M>,
##  and such that <M>J^l</M> is nonzero and <M>J^{{l+1}}</M> is zero.
##  <P/>
##  <Example><![CDATA[
##  gap> data:= LoewyStructureInfoGAP( 2, 7 );;
##  gap> radser:= SingerAlg.BasesOfRadicalSeries( data );
##  [ [ 2 .. 8 ], [ 4, 6, 7, 8 ], [ 8 ] ]
##  ]]></Example>
##  </Description>
##  </ManSection>
##  <#/GAPDoc>
##
SingerAlg.BasesOfRadicalSeries:= function( data )
    local lay, ll, jbylayer, J, i;

    lay:= data.layers;
    ll:= data.LL;
    jbylayer:= List( [ 1 .. ll-1 ], i -> Positions( lay, i ) );
    J:= [ jbylayer[ ll-1 ] ];
    for i in [ 2 .. ll-1 ] do
      J[i]:= Union( J[ i-1 ], jbylayer[ ll - i ] );
    od;

    return Reversed( J );
    end;

#############################################################################
##
#F  SingerAlg.BasesOfSocleSeries( <data> )
##
##  <#GAPDoc Label="SingerAlg.BasesOfSocleSeries">
##  <ManSection>
##  <Func Name="SingerAlg.BasesOfSocleSeries" Arg='data'/>
##
##  <Description>
##  Let <A>data</A> be the record returned by
##  <Ref Oper="LoewyStructureInfoGAP" Label="for parameters"/>
##  that describes a Singer algebra <M>A = A[q,z]</M>,
##  and let <M>B = B(A)</M>.
##  <Ref Func="SingerAlg.BasesOfSocleSeries"/> returns the list
##  <M>[ I_1, I_2, \ldots, I_l ]</M> of subsets of
##  <M>\{ 1, 2, \ldots, z+1 \}</M> such that
##  <M>( B_i; i \in I_j )</M> is a basis of <M>S_j</M>,
##  where <M>S_1</M> is the socle of <M>A</M>,
##  <M>S_{{j+1}}/S_j</M> is the socle of <A>A</A><M>/S_j</M>,
##  and <A>A</A><M>/S_l</M> is nonzero and its own socle.
##  <P/>
##  <Example><![CDATA[
##  gap> socser:= SingerAlg.BasesOfSocleSeries( data );
##  [ [ 8 ], [ 4, 6, 7, 8 ], [ 2 .. 8 ] ]
##  ]]></Example>
##  </Description>
##  </ManSection>
##  <#/GAPDoc>
##
SingerAlg.BasesOfSocleSeries:= function( data )
    local lay, ll, sbylayer, S, i;

    lay:= Reversed( data.layers );
    ll:= data.LL;
    sbylayer:= List( [ 0 .. ll-2 ], i -> Positions( lay, i ) );
    S:= [ sbylayer[ 1 ] ];
    for i in [ 2 .. ll-1 ] do
      S[i]:= Union( S[ i-1 ], sbylayer[i] );
    od;

    return S;
    end;

#############################################################################
##
#F  SingerAlg.BasisOfPowers( <data>, <I>, <p>, <m> )
##
##  <#GAPDoc Label="SingerAlg.BasisOfPowers">
##  <ManSection>
##  <Func Name="SingerAlg.BasisOfPowers" Arg='data, I, p, m'/>
##
##  <Description>
##  Let <A>p</A> be a prime integer,
##  let <A>data</A> be the record returned by
##  <Ref Oper="LoewyStructureInfoGAP" Label="for parameters"/>
##  that describes a Singer algebra <M>A = A[q,z]</M>,
##  let <M>B = B(A_p)</M>,
##  let <A>I</A> be a subset of <M>\{ 1, 2, \ldots, z+1 \}</M>,
##  describing a subspace <M>U</M> of <M>A_p</M> with basis
##  <M>( B_i; i \in I )</M>,
##  and let <A>m</A> be a positive integer.
##  <Ref Func="SingerAlg.BasisOfPowers"/> returns the subset <M>J</M>
##  of <M>\{ 1, 2, \ldots, z+1 \}</M> such that
##  <M>( B_i; i \in J )</M> is a basis of the subspace
##  <M>\{ x^{{p^m}}; x \in U \}</M> of <M>A_p</M>.
##  <P/>
##  <Example><![CDATA[
##  gap> data:= LoewyStructureInfoGAP( 3, 8 );;
##  gap> SingerAlg.BasisOfPowers( data, [ 1 .. 9 ], 2, 1 );
##  [ 1, 3, 7, 9 ]
##  gap> SingerAlg.BasisOfPowers( data, [ 1 .. 9 ], 2, 2 );
##  [ 1 ]
##  gap> SingerAlg.BasisOfPowers( data, [ 1 .. 9 ], 3, 1 );
##  [ 1 ]
##  ]]></Example>
##  </Description>
##  </ManSection>
##  <#/GAPDoc>
##
SingerAlg.BasisOfPowers:= function( data, I, p, m )
    local result, q, pm, quo, k;

    result:= [];
    q:= data.parameters[1];
    pm:= p^m;
    quo:= QuoInt( q-1, pm );
    for k in I do
      if Maximum( data.monomials[k] ) <= quo then
        Add( result, pm * ( k-1 ) + 1 );
      fi;
    od;

    return result;
    end;

#############################################################################
##
#F  SingerAlg.BasisOfPMRoots( <data>, <I>, <p>, <m> )
##
##  <#GAPDoc Label="SingerAlg.BasisOfPMRoots">
##  <ManSection>
##  <Func Name="SingerAlg.BasisOfPMRoots" Arg='data, I, p, m'/>
##
##  <Description>
##  Let <A>p</A> be a prime integer,
##  let <A>data</A> be the record returned by
##  <Ref Oper="LoewyStructureInfoGAP" Label="for parameters"/>
##  that describes a Singer algebra <M>A = A[q,z]</M>,
##  let <M>B = B(A_p)</M>,
##  let <A>I</A> be a subset of <M>\{ 1, 2, \ldots, z+1 \}</M>,
##  describing a subspace <M>U</M> of <M>A_p</M> with basis
##  <M>( B_i; i \in I )</M>,
##  and let <A>m</A> be a positive integer.
##  (See Section <Ref Sect="sect:Singer algebras"/> for the definition of
##  <M>A_p</M>.)
##  <P/>
##  <Ref Func="SingerAlg.BasisOfPMRoots"/> returns the subset <M>J</M>
##  of <M>\{ 1, 2, \ldots, z+1 \}</M> such that
##  <M>( B_i; i \in J )</M> is a basis of the subspace
##  <M>\{ x \in A_p; x^{{p^m}} \in U \}</M> of <M>A_p</M>.
##  <P/>
##  <Example><![CDATA[
##  gap> data:= LoewyStructureInfoGAP( 3, 8 );;
##  gap> SingerAlg.BasisOfPMRoots( data, [], 2, 1 );
##  [ 3, 6, 7, 8, 9 ]
##  gap> SingerAlg.BasisOfPMRoots( data, [], 2, 2 );
##  [ 2, 3, 4, 5, 6, 7, 8, 9 ]
##  gap> SingerAlg.BasisOfPMRoots( data, [ 3 ], 2, 1 );
##  [ 2, 3, 6, 7, 8, 9 ]
##  ]]></Example>
##  </Description>
##  </ManSection>
##  <#/GAPDoc>
##
SingerAlg.BasisOfPMRoots:= function( data, I, p, m )
    local q, pm, quo;

    q:= data.parameters[1];
    pm:= p^m;
    quo:= QuoInt( q-1, pm );

    # The first condition means that B_k^{p^m} is zero
    # and hence inside the given subspace.
    # For the second condition, we may assume that B_k^{p^m}
    # is nonzero and hence equal to B_{p^m (k-1)+1}.
    return Filtered( [ 1 .. Length( data.monomials ) ],
                     k ->    Maximum( data.monomials[k] ) > quo
                          or pm * (k-1) + 1 in I );
    end;

#############################################################################
##
#F  SingerAlg.BasisOfPC( <data>, <I>, <J> )
##
##  <#GAPDoc Label="SingerAlg.BasisOfPC">
##  <ManSection>
##  <Func Name="SingerAlg.BasisOfPC" Arg='data, I, J'/>
##
##  <Description>
##  Let <A>data</A> be the record returned by
##  <Ref Oper="LoewyStructureInfoGAP" Label="for parameters"/>
##  that describes a Singer algebra <M>A = A[q,z]</M>,
##  let <M>B = B(A)</M>,
##  let <A>I</A> and <M>J</M> be subsets of <M>\{ 1, 2, \ldots, z+1 \}</M>,
##  describing subspaces <M>U</M> and <M>V</M> of <M>A</M> with bases
##  <M>( B_i; i \in I )</M> and <M>( B_i; i \in J )</M>,
##  respectively.
##  <Ref Func="SingerAlg.BasisOfPC"/> returns the subset <M>K</M>
##  of <M>\{ 2, 3, \ldots, z+1 \}</M> such that
##  <M>( B_i; i \in K )</M> is a basis of the subspace
##  <M>\{ x \in J(A); x \cdot U \subseteq V \}</M> of <M>J(A)</M>.
##  <P/>
##  (The perhaps strange name <Q>BasisOfPC</Q> was chosen because the
##  result contains the indices of those basis vectors such that the
##  <E>P</E>roduct with the space <M>U</M> is <E>C</E>ontained in the
##  space <M>V</M>.)
##  <P/>
##  <Example><![CDATA[
##  gap> data:= LoewyStructureInfoGAP( 23, 585 );;
##  gap> soc:= SingerAlg.BasesOfSocleSeries( data );;
##  gap> rad:= SingerAlg.BasesOfRadicalSeries( data );;
##  gap> I1:= SingerAlg.BasisOfPC( data, soc[3], rad[3] );;
##  gap> Length( I1 );
##  581
##  gap> data:= LoewyStructureInfoGAP( 212, 585 );;
##  gap> soc:= SingerAlg.BasesOfSocleSeries( data );;
##  gap> rad:= SingerAlg.BasesOfRadicalSeries( data );;
##  gap> I2:= SingerAlg.BasisOfPC( data, soc[3], rad[3] );;
##  gap> Length( I2 );
##  545
##  ]]></Example>
##  </Description>
##  </ManSection>
##  <#/GAPDoc>
##
SingerAlg.BasisOfPC:= { data, I, J } -> Filtered(
    # Note that we are interested in subspaces of the radical.
    [ 2 .. Length( data.monomials ) ],
    k -> IsSubset( J, SingerAlg.BasisOfProductSpace( data, [ k ], I ) ) );

#############################################################################
##
#E


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

NewRulesFor(TConjEven, rec(
    TConjEven_vec := rec(
        switch := true,
        applicable := (self, t) >> IsEvenInt(t.params[1]) and t.isTag(1, AVecReg) and
	    t.params[1] mod (2*t.getTag(1).v) = 0,

        apply := (self, t, C, Nonterms) >> let(N := t.params[1], v := t.getTag(1).v, rot := t.params[2],
            m := Mat([[1,0],[0,-1]]),
#            d1 := Diag(diagDirsum(fConst(TReal, 2, 1.0), fConst(TReal, N-2, 1/2))),
            d1 := VDiag(diagDirsum(fConst(TReal, 1, 1.0), fConst(TReal, v-1, 0.5), fConst(TReal, 1, 1.0), fConst(TReal, N-v-1, 0.5)), v),
            #m1 := DirectSum(m, SUM(I(N-2), Tensor(J((N-2)/2), m))),
            #dv1 := Diag(diagDirsum(fConst(TReal, v, 1.0), fConst(TReal, 1,-1.0), fConst(TReal, N-v-1, 1.0))),
            dv1 := DirectSum(VTensor(I(1), v),
		             VBlk([[ [-1.0] :: Replicate(v-1, 1.0) ]], v),
			     VTensor(I(N/v-2), v)),
            P1 := VPrm_x_I(L(N/v, N/(2*v)), v),
            Q1 := VPrm_x_I(L(N/v, 2), v),
            jv1 := P1*DirectSum(VO1dsJ(N/2, v), VScale(VO1dsJ(N/2, v), -1, v))*Q1,
            mv1 := _VSUM([dv1,jv1], v),
            #m2 := DirectSum(J(2), SUM(I(N-2), Tensor(J((N-2)/2), -m))),
            e0 := [0.0] :: Replicate(v-1, 1.0),
            e1 := [1.0] :: Replicate(v-1, 0.0),
            blk := VBlk([[e0,e1],[e1,e0]], v).setSymmetric(),
            dv2 := DirectSum(blk, VTensor(I(N/v-2), v)),
            jv2 := P1 * DirectSum(VScale(VO1dsJ(N/2, v), -1, v), VO1dsJ(N/2, v))*Q1,
            mv2 := _VSUM([dv2,jv2], v),
            #
            i := VTensor(I(N/v), v),
            d2 := VRCLR(Diag(fPrecompute(diagDirsum(fConst(TReal, 1, 1.0), diagMul(fConst(TComplex, N/2-1, omegapi(-1/2)), fCompose(dOmega(N, rot), fAdd(N/2, N/2-1, 1)))))), v),
            #
            #d1 *
	    VBlkInt(d1 * _VHStack([mv1, mv2], v) * VStack(i, d2), v))
    ),

    TConjEven_vec_tr := rec(
        switch := true,
        applicable := (self, t) >> IsEvenInt(t.params[1]) and t.isTag(1, AVecReg) and t.params[1] mod (2*t.getTag(AVecReg).v)=0,
	transposed := true,

        apply := (self, t, C, Nonterms) >> let(N := t.params[1], v := t.getTag(1).v, rot := t.params[2],
            m := Mat([[1,0],[0,-1]]),
#            d1 := Diag(diagDirsum(fConst(TReal, 2, 1.0), fConst(TReal, N-2, 1/2))),
            d1 := VDiag(diagDirsum(fConst(TReal, 1, 1.0), fConst(TReal, v-1, 0.5), fConst(TReal, 1, 1.0), fConst(TReal, N-v-1, 0.5)), v),
            #m1 := DirectSum(m, SUM(I(N-2), Tensor(J((N-2)/2), m))),
            #dv1 := Diag(diagDirsum(fConst(TReal, v, 1.0), fConst(TReal, 1,-1.0), fConst(TReal, N-v-1, 1.0))),
            dv1 := DirectSum(VTensor(I(1), v),
		             VBlk([[ [-1.0] :: Replicate(v-1, 1.0) ]], v),
			     VTensor(I(N/v-2), v)),
            P1 := VPrm_x_I(L(N/v, N/(2*v)), v),
            Q1 := VPrm_x_I(L(N/v, 2), v),
            jv1 := P1*DirectSum(VO1dsJ(N/2, v), VScale(VO1dsJ(N/2, v), -1, v))*Q1,
            mv1 := _VSUM([dv1,jv1], v),
            #m2 := DirectSum(J(2), SUM(I(N-2), Tensor(J((N-2)/2), -m))),
            e0 := [0.0] :: Replicate(v-1, 1.0),
            e1 := [1.0] :: Replicate(v-1, 0.0),
            blk := VBlk([[e0,e1],[e1,e0]], v).setSymmetric(),
            dv2 := DirectSum(blk, VTensor(I(N/v-2), v)),
            jv2 := P1 * DirectSum(VScale(VO1dsJ(N/2, v), -1, v), VO1dsJ(N/2, v))*Q1,
            mv2 := _VSUM([dv2,jv2], v),
            #
            i := VTensor(I(N/v), v),
            d2 := VRCLR(Diag(fPrecompute(diagDirsum(fConst(TReal, 1, 1.0), diagMul(fConst(TComplex, N/2-1, omegapi(-1/2)), fCompose(dOmega(N, rot), fAdd(N/2, N/2-1, 1)))))), v),
            #
            #d1 *
	    VBlkInt(_VHStack([i, d2.transpose()], v) * VStack(mv1, mv2) * d1, v))
    )
));

NewRulesFor(TXMatDHT, rec(
    TXMatDHT_vec := rec(
        switch := true,
        applicable := (self, t) >> IsEvenInt(t.params[1]) and t.isTag(1, AVecReg),
        apply := (self, t, C, Nonterms) >> let(N := t.params[1], v := t.getTag(1).v,

            f0 := Replicate(v, 1.0),
            f1 := [0.0] :: Replicate(v-1, 1.0),
            f2 := [1.0] :: Replicate(v-1, -1.0),
            fblk := VBlk([[f0,f1],[f1,f2]], v).setSymmetric(),
            fdiag := VTensor(Tensor(I(N/(2*v)-1), F(2)), v),
            ff := DirectSum(fblk, fdiag),

            ###
            m := Mat([[1,0],[0,-1]]),
            d1 := Diag(diagDirsum(fConst(TReal, 2, 1.0), fConst(TReal, N-2, 1/2))),
            #m1 := DirectSum(m, SUM(I(N-2), Tensor(J((N-2)/2), m))),
            #dv1 := Diag(diagDirsum(fConst(TReal, v,1), fConst(TReal, 1,-1), fConst(TReal, N-v-1, 1))),
            dv1 := DirectSum(VTensor(I(1), v),
		             VBlk([[ [-1.0] :: Replicate(v-1, 1.0) ]], v),
			     VTensor(I(N/v-2), v)),
            P1 := VPrm_x_I(L(N/v, N/(2*v)), v),
            Q1 := VPrm_x_I(L(N/v, 2), v),
            jv1 := P1*DirectSum(VO1dsJ(N/2, v), VScale(VO1dsJ(N/2, v), -1, v))*Q1,
            mv1 := _VSUM([dv1,jv1], v),
            #m2 := DirectSum(J(2), SUM(I(N-2), Tensor(J((N-2)/2), -m))),
            e0 := [0.0] :: Replicate(v-1, 1.0),
            e1 := [1.0] :: Replicate(v-1, 0.0),
            blk := VBlk([[e0,e1],[e1,e0]], v).setSymmetric(),
            dv2 := DirectSum(blk, VTensor(I(N/v-2), v)),
            jv2 := P1*DirectSum(VScale(VO1dsJ(N/2, v), -1, v), VO1dsJ(N/2, v))*Q1,
            mv2 := _VSUM([dv2,jv2], v),
            #
            i := VTensor(I(N/v), v),
            d2 := VRCLR(Diag(fPrecompute(diagDirsum(fConst(TReal, 1, 1.0), diagMul(fConst(TComplex, N/2-1, Complex(0,-1)), fCompose(dOmega(N, 1), fAdd(N/2, N/2-1, 1)))))), v),
            #
            d1 * VBlkInt(ff * _VHStack([mv1, mv2], v) * VStack(i, d2), v)
    ))
));