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

apply_nt := (NT, input) ->
    List(TransposedMat(MatSPL(NT) * TransposedMat([input]))[1], EvalScalar);

dft_a := [0, 0, 1/2, 1/2];
dft_b := [0, 1/2, 0, 1/2];

dft_algo := [ [DFT1, DFT1], # f1 -> f1, f1
              [DFT2, DFT1], # f2 -> f2, f1
	      [DFT1, DFT3], # f3 -> f1, f3
	      [DFT2, DFT3]  # f4 -> f2, f3
	    ];
twid := (type,N,m,i) -> List(
    Twid(N,m,1,dft_a[type], dft_b[type],i).lambda().tolist(), EvalScalar);

# F_N -> Tensor(F_m, I_n) * T(mn, n) * Tensor(I_m, F_n) * L(mn, m)
#
[n, inputs, dfts, inputs2, twids, tinputs2, outputs, out, tdfts] := [0,0,0,0,0,0,0,0,0];

dft_projection := function(type, N, m, input)
    n := N/m;
    inputs := List([0..m-1], x->part(input,m,x));
    dfts    := List(inputs, x->apply_nt(dft_algo[type][2](Length(x)), x));
    inputs2 := TransposedMat(dfts);
    twids := List([0..n-1], i -> twid(type,N,m,i));
    tinputs2 := List([1..n], i -> listmul(inputs2[i], twids[i]));
    outputs := List(tinputs2, x->apply_nt(dft_algo[type][1](Length(x)), x));
    return List([inputs, dfts, inputs2, tinputs2, outputs], x->List(x,csym));
end;

tdft_projection := function(type, N, m, input)
    n := N/m;
    inputs := List([0..n-1], x->part(input,n,x));
    dfts    := List(inputs, x->apply_nt(dft_algo[type][2](Length(x)), x));
    twids := List([0..n-1], i->twid(Cond(type=2,3,type=3,2,type),N,m,i));
    tdfts := List([1..n], i -> listmul(dfts[i], twids[i]));
    tinputs2 := TransposedMat(tdfts);
    outputs := List(tinputs2, x->apply_nt(dft_algo[type][1](Length(x)), x));
    return List([inputs, dfts, tdfts, tinputs2, outputs], x->List(x,csym));
end;

Declare(inp, p1, p2, imid, dft1, dft2);
dft1_radproj := function(N, input)
    local mid; #,imid, p1, p2, inp, out;
    mid := DFT_Rader.raderMid(N,1,PrimitiveRootMod(N));
    input := apply_nt(RR(N), input);
    p1 := [input[1]]; inp := Drop(input,1);
    dft1 := apply_nt(DFT(N-1,-1), inp);
    imid := apply_nt(mid, Concat(p1, dft1));
    p2 := [imid[1]]; imid := Drop(imid, 1);
    dft2 := apply_nt(DFT(N-1,-1), imid);
    out := apply_nt(RR(N).transpose(), Concat(p2, dft2));
    return List([inp, dft1, imid, dft2, out], csym);
end;
# left transform in Rader rule:
# jDFT1 -> IRDFT1 dirsum jIRDFT2
# jDFT1 -> (jDFT1   dirsum jDFT3  )^L (R^2 dirsum C^2 ... I^2)
# jDFT3 -> (jDFT1 D dirsum jDFT1 D)^L (R^2 dirsum C^2 ... R^2)
#
#
rcexp := l -> ConcatList(l,
    e -> let(ee := Complex(e), [ReComplex(ee), ImComplex(ee)]));

# DFT_mn = CRT(m,n,1,1)^T (OS(m,n) F_m x I_n) (I_m x OS(n,m) F_n) CRT(m,n,1,1)
pf_projection := function(N, m, input)
    local i, j;
    n := N/m;
    inputs := List([0..m-1], j -> List([0..n-1], i->input[1+ (j*n + i*m) mod N]));
    dfts    := List(inputs, x->apply_nt(OS(n,m)*DFT(n), x));
    inputs2 := TransposedMat(dfts);
    outputs := List(inputs2, x->apply_nt(OS(m,n)*DFT(m), x));
    out := [1..N];
    for j in [0..n-1] do
       for i in [0..m-1] do
           out[1+ (j*m + i*n) mod N] := outputs[1+j][1+i];
       od;
    od;
    return List([inputs, dfts, inputs2, outputs], x->List(x,csym));
end;


# Built-in

Filtered([1 .. 100], IsPrime);
# [ 2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59, 61, 67, 71, 73, 79, 83, 89, 97 ]

Filtered([1 .. 10], IsEvenInt);
# [ 2, 4, 6, 8, 10 ]

Filtered([1 .. 10], IsOddInt);
# [ 1, 3, 5, 7, 9 ]


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

# Transform symbol: Toeplitz
#
# Parameters:       <list>
#
# Definition:       Toeplitz(L) represents the (n X n) toeplitz matrix.
#                   L must contain the coefficients of the first row (from
#                   right to left) followed by all but first coefficents
# 		    on the first column specified. Toeplitz matrices have
#                   constant elements along all diagonals.
#
# 		    n = (len(L)+1) / 2.
#
# Example:          Transform( "Toeplitz", [1, 2, 3, 4, 5, 6, 7]) is the matrix
#                     [ [4, 3, 2, 1],
#                       [5, 4, 3, 2],
#                       [6, 5, 4, 3],
#                       [7, 6, 5, 4] ]
Class(Toeplitz, NonTerminal, DataNonTerminalMixin, rec(
    # above DataNonTerminalMixin must come after NonTerminal to pickup
    # NonTerminal.operations instead of DataNonTerminalMixin.operations
    # which is actually ClassBase.operations
    abbrevs := [
	L -> let(f:=toFunc(L),
	         [ Checked(IsOddInt(f.domain()), f), 0, f.domain()-1 ]),
	(L, l, r) -> let(f:=toFunc(L),
	         [ Checked(IsOddInt(f.domain()), f), l, r ] )
    ],

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

    terminate := self >> let(
	coeffs := self.params[1],
	#lcoeffs := coeffs.lambda(),
	coeffs_ev := coeffs.lambda().tolist(),
	len := coeffs.domain(),
	l := self.params[2],
	r := self.params[3],
	#v := Ind(len),
        #toeplitz( Lambda(v, cond(leq(l,v,r), lcoeffs.at(v), 0)).tolist() )),
        toeplitz(coeffs_ev)),

    transpose := self >> let(nums := self.params[1],
        Toeplitz(fCompose(nums, J(nums.domain())))),

    isReal := self >> true,

    HashId := self >> let(n := self.params[1].domain(), l := self.params[2], r := self.params[3],
#	[n, When(IsInt(l) and IsInt(r), QuantizeQuarters(((r-l) mod n)/(n-1)), 1)]),
	n),

    hprint := self >> let(n := self.params[1].domain(), h := self.HashId,
	Print(self.name, "(", n, ")")), #, ", 0, ", ", Int((n-1)*h[2]), ")")),

    SmallRandom  := () -> [1 .. 1+2*Random([1..8])],

    setNonZero := meth(self, l, r)
        self.params[2] := l;
	self.params[3] := r;
    end
));

##
## Rules
##
RulesFor(Toeplitz, rec(
    ###################################################################
    ## Time domain methods
    ###################################################################

    #F Toeplitz_Base: (base case)
    #F
    #F NonTerm_Filter -> SPLMat
    #F Computes convolution by definition
    #F
    Toeplitz_Base := rec(
	info             := "Toeplitz -> Mat",
	forTransposition := false,
	limit            := 8,
	isApplicable     := (self, P) >> let(n := (P[1].domain()+1)/2, n <= self.limit),
	allChildren      := P -> [[ ]],
	rule := (P, C) -> ApplyFunc(Toeplitz, P).terminate()
    ),

    Toeplitz_SmartBase := rec(
	info             := "Toeplitz -> Lower-Triangular | Upper-Triangular | Full matrix",
	forTransposition := false,
	limit            := 5,
	isApplicable     := (self, P) >> let(n := (P[1].domain()+1)/2, n <= self.limit),
	allChildren      := P -> [[ ]],

	rule := (P, C) -> let(
	    coeffs := P[1],
	    coeffs_ev := coeffs.lambda().tolist(),
	    len := coeffs.domain(), # 7 (r 6,5,4,<3>,2,1,0 l)
	    halflen := (len-1) / 2, # 3
	    l := P[2],
	    r := P[3],
	    closed := leq(l, r),

	    A := leq(halflen, l),
	    B := leq(r, halflen),

	    lout := leq(len, l),
	    rout := leq(r, -1),

	    COND(logic_and(A, logic_or(closed, rout)), # lower triangular
		 toeplitz(Concat(Replicate(halflen,0), Drop(coeffs_ev, halflen))),
		 COND(logic_and(B, logic_or(closed, lout)), # upper triangular
		      toeplitz(Concat(Take(coeffs_ev, halflen+1), Replicate(halflen,0))),
		      toeplitz(coeffs_ev)))) # full
    ),

    Toeplitz_PreciseBase := rec(
	info             := "Toeplitz -> toeplitz of non-zero elements only",
	forTransposition := false,
	switch := false,
	isApplicable     := P -> let(len := P[1].domain(), len = 3),
	allChildren      := P -> [[ ]],
	rule := (P, C) -> let(
	    lcoeffs := P[1].lambda(),
	    len := P[1].domain(),
	    l := P[2],
	    r := P[3],
	    v := Ind(len),
	    toeplitz( Lambda(v, cond(leq(l,v,r), lcoeffs.at(v), 0)).tolist() ))
    ),

    #F Toeplitz_Blocking
    #F
    #F Toeplitz -> Blocks (Toeplitzes)
    #F
    #F Toeplitz is divided into square blocks of sizes given by all
    #F proper divisors of the input size.
    #F
    Toeplitz_Blocking := rec(
	info             := "Toeplitz_nk -> Toeplitz_k",
	forTransposition := false,

	isApplicable     := P -> let(N := (P[1].domain() + 1) / 2,
	    N > 2 and not IsPrime(N)),

	allChildren := P -> let(
	    len := P[1].domain(), N := (len+1)/2,
	    l := P[2], r:= P[3], nzlen := r-l+1, ratio := When(IsInt(nzlen), nzlen/len, 1),
	    List(DivisorPairs(N), d -> let(newlen := 2*d[1]-1,
		[ Toeplitz(FUnk(newlen), newlen - CeilingRat(newlen*ratio), newlen-1) ]))),

	rule := (P, C, Nonterms) -> let(
	    len := P[1].domain(),
	    N := (len + 1) / 2,
	    bksize := Rows(C[1]),
	    bklen  := 2*bksize - 1,
	    bkdim := N / bksize,
	    numblocks := 2 * bkdim - 1,
	    i := Ind(bkdim),
	    k := Ind(bkdim),
	    ofs := DataInd(TInt, N*2-bklen).setAttr("live_out"),
	    gfunc := fAdd(len, bklen, ofs),

	    l := P[2],
	    r := P[3],
	    open   := leq(r+1, l),
	    A := leq(l-bklen+1, ofs),
	    B := leq(ofs, r),
	    isNonZero := logic_or(logic_and(A, B), logic_and(open, logic_or(A, B))),

            nt := Nonterms[1].setData(fCompose(P[1], gfunc))
	                     .setNonZero(l-ofs, r-ofs),

	    ISum(i, i.range,
		Scat(fTensor(fBase(i), fId(bksize))) *
		ISumAcc(k, k.range,
		    Data(ofs, bksize*((bkdim-1)+i-k),
		       COND(isNonZero, C[1],
			    O(bksize))) *
		    Gath(fTensor(fBase(k), fId(bksize)))))
	)
    ),

    Toeplitz_BlockingDense := rec(
	info             := "Toeplitz_nk -> Toeplitz_k",
	forTransposition := false,

	isApplicable     := P -> let(N := (P[1].domain() + 1) / 2,
	    N > 2 and not IsPrime(N)),

	allChildren := P -> let(
	    len := P[1].domain(), N := (len+1)/2,
	    l := P[2], r:= P[3], nzlen := r-l+1, ratio := When(IsInt(nzlen), nzlen/len, 1),
	    List(DivisorPairs(N), d -> let(newlen := 2*d[1]-1,
		[ Toeplitz(FUnk(newlen), newlen - CeilingRat(newlen*ratio), newlen-1) ]))),

	rule := (P, C, Nonterms) -> let(
	    len := P[1].domain(),
	    N := (len + 1) / 2,
	    bksize := Rows(C[1]),
	    bklen  := 2*bksize - 1,
	    bkdim := N / bksize,
	    numblocks := 2 * bkdim - 1,
	    i := Ind(bkdim),
	    k := Ind(bkdim),
	    ofs := DataInd(TInt, N*2-bklen).setAttr("live_out"),
	    gfunc := fAdd(len, bklen, ofs),
	    isNonZero := When(P[3]-P[2]+1=len, V(1), leq(P[2]-bklen+1, ofs, P[3])),
            nt := Nonterms[1].setData(fCompose(P[1], gfunc))
	                     .setNonZero(P[2]-ofs, P[3]-ofs),

	    ISum(i, i.range,
		Scat(fTensor(fBase(i), fId(bksize))) *
		ISumAcc(k, k.range,
		    Data(ofs, bksize*((bkdim-1)+i-k),
		       C[1]) *
		    Gath(fTensor(fBase(k), fId(bksize)))))
	)
    ),
    ###################################################################
    ## Frequency domain methods
    ###################################################################

    #F Toeplitz_ExpandedConvolution
    #F
    #F Toeplitz -> Toeplitz_n -> submatrix Circulant(k)  where k>=2*n-1
    #F
    #F Computes Toeplitz matrix through convolution of expanded size.
    #F
    #F Van Loan, C. "Computational Frameworks for the Fast Fourier Transform",
    #F SIAM Philadelphia 1992, p208.
    #F
    Toeplitz_ExpandedConvolution := rec(
	info             := "Toeplitz_n -> submatrix Circulant(k), k>=2*n-1 ",
	forTransposition := false,
	switch           := false,
	isApplicable     := P -> P[1].domain() >= 5,
	allChildren      := function( P )
	    local conv_size,l,L,toep_size;
	    l := P[1].domain();
	    L := P[1].lambda().tolist();
	    conv_size := 2^LogInt(l, 2);
	    while conv_size < l do conv_size := conv_size*2; od;
	    return [[ Circulant(
		Concatenation(
		    List([1..(l+1)/2], x->L[(l+1)/2+x-1]),
		    List([1..conv_size-l], x->0),
		    List([1..(l-1)/2], x->L[x]))) ]];
	end,

	rule := (P, C) -> let(n := (P[1].domain() + 1)/2,
	    RI(n, Rows(C[1])) *
	    C[1] *
	    RI(Rows(C[1]), n)
	)
    )
));


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

Class(VecRaderMid, BaseMat, SumsBase, rec(
    sums := self >> self,
    isReal := False,
    dims := self >> self.dimensions,
    #-----------------------------------------------------------------------
    new := (self, p, k, r, v) >> SPL(WithBases(self,
        rec(p := p, k := k, r := r, v := v, dimensions := [v+_roundup(p-1,v), v+_roundup(p-1,v)]))),
    #-----------------------------------------------------------------------
    area := self >> self.dimensions[1] + 2,
    transpose := self >> self,
    #-----------------------------------------------------------------------
    print := (self,i,is) >> Print(self.name, "(", self.p, ", ", self.k, ", ", self.r, ", ", self.v, ")"),
    #-----------------------------------------------------------------------
    toAMat := self >> self.term().toAMat(),
    rChildren := self >> [],
    from_rChildren := (self, rch) >> self,
    #-----------------------------------------------------------------------
    term := meth(self)
        local dl, d, e0, ep, blk, p, k, root, v;
        p := self.p; k:=self.k; root :=self.r; v:= self.v;
        dl := Concat(TRaderMid.raderDiag(p, k, root), List([p-1..v], i->V(0.0)));
        e0 := Concat([V(1.0)], List([2..v], i->V(0.0)));
        ep := Concat([V(-1/(p-1))], dl{[1..v-1]});
        blk := VBlk([[V(e0),V(e0)],[V(e0),V(ep)]], v).setSymmetric();

        if p > 2*v then
            d := VDiag(fStretch(FList(TComplex, dl{[v..p-2]}), _roundup(p-1-v, v), p-1-v), v);
            return DelayedDirectSum(blk, d);
        else
            return blk;
        fi;
    end,
    #-----------------------------------------------------------------------
    stretchCT := meth(self, N)
        local dl, d, e0, ep, blk, p, k, root, v;
        p := self.p;
        k:=self.k;
        root:=self.r;
        v:= self.v;
        dl := fStretch(FList(TComplex, Concat([-1/(p-1)], TRaderMid.raderDiag(p, k, root))), _roundup(N, v), N).tolist();
        d := VDiag(FList(TComplex, Drop(dl, v)), v);
        e0 := Concat([V(1.0)], List([2..v], i->V(0.0)));
        ep := dl{[1..v]};
        blk := VBlk([[e0,e0],[e0,ep]], v).setSymmetric();
        return DelayedDirectSum(blk, d);
    end,
    #-----------------------------------------------------------------------
    stretchPFA := meth(self, part, N, func)
        local dl, d, e0, ep, blk, p, k, root, v;
        p := self.p;
        k:=self.k;
        root:=self.r;
        v:= self.v;
#        Error();
        dl := fStretch(fCompose(FList(TComplex, Concat([-1/(p-1)], TRaderMid.raderDiag(p, k, root))), func), _roundup(N/part, v), N/part).tolist();
        d := VDiag(FList(TComplex, Drop(dl, v)), v);
        e0 := Concat([V(1.0)], List([2..v], i->V(0.0)));
        ep := dl{[1..v]};
        blk := VBlk([[e0,e0],[e0,ep]], v).setSymmetric();
        return DelayedDirectSum(blk, d);
    end,
));


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

Declare(MDRConv);
# From IOPrunedMDRConv, signature (n,h,oblk,opat,iblk,ipat,isFreqData)
# but this one has oblk=1, iblk=1, opat=ipat=[[0..n(1)-1], ...]
# Left with n (was [1]), h, (was [2]), isFreqData (was [7]).
Class(MDRConv, TaggedNonTerminal, rec(
    a_n := self >> self.params[1],
    a_h := self >> self.params[2],
    a_isFreqData := self >> self.params[3],

    abbrevs := [
                (n, h) -> Checked(ForAll(n, IsPosIntSym),
                                  [_unwrap(n), h, false]),
                (n, h, isFreqData) -> Checked(ForAll(n, IsPosIntSym),
                                              [_unwrap(n), h, isFreqData])
               ],
    dims   := self >> let(nprod := Product(self.a_n()),
                          [nprod, nprod]),
    isReal := self >> true,
    normalizedArithCost := self >> let(n := self.a_n(),
                                       IntDouble(5 * n * d_log(n) / d_log(2))),
    TType := TReal,
    terminate := self >> When(self.a_isFreqData(),
               # case of isFreqData = true
               let(nlist := self.a_n(),
                   n1 := nlist[1],
                   nfreq := RClength(n1)/2, # WAS n1/2 + 1
                   nrest := Drop(nlist, 1),
                   idft := Tensor(IPRDFT(n1, -1), I(Product(nrest))) *
                                  Tensor(I(nfreq), L(2*Product(nrest), 2)) *
                                  Tensor(I(nfreq), RC(MDDFT(nrest, -1))),
                   tlist := MatSPL(idft) * self.a_h().list,
                   MDRConv(nlist,
                           FList(TReal, tlist),
                           false).terminate()
                   ),
               # case of isFreqData = false
               let(nlist := self.a_n(),
                   scat3d := Tensor(List(nlist, n->I(n))::[Mat([[1], [0]])]),
                   gath3d := Tensor(List(nlist, n->I(n))::[Mat([[1, 0]])]),
                   dft3dr := RC(MDDFT(nlist, -1)),
                   idft3dr := RC(MDDFT(nlist, 1)),
                   gfd := List((1/Product(nlist)) *
                               MatSPL(MDDFT(nlist, 1)) *
                               self.a_h().list,
                               ComplexAny),
                   gdiagr := RC(Diag(gfd)),
                   t := gath3d * idft3dr * gdiagr * dft3dr * scat3d,
                   t.terminate()
                  )
        ), # end of When

    hashAs := self >> ApplyFunc(ObjId(self),
                                [self.a_n(),
                                 fUnk(self.a_h().range(),
                                 self.a_h().domain())]::Drop(self.params, 2))
));

# used to represent convolution with real valued conjugate even symbol
Class(MDRConvR, MDRConv);


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

#
# Using these "radix-2" rules will yield optimal 2nlog(n)-4n+6
# arithmetic cost for PRDFT1 (Split-Radix), and an almost equivalent
# cost of 2nlog(n)-4n+8 for PDHT1 (better than the literature).
#

# Each entry is J(2) times conjugated twiddle w* times PDHT3(2)=F(2),
# twiddles are accessed at stride 2.
# (w^*) * F_2 = [[r,i],[-i,r]] * F_2 = [[r+i, r-i], [r-i], [-i-r]]
Class(H3_CasTwid, Sym, rec(
    def := (n, k) ->
	DirectSum(List([0..n/2-1], j -> let(w := E(2*n)^(k*j),
		    J(2) * Mat([[Re(w)+Im(w),  Re(w)-Im(w)],
			        [Re(w)-Im(w), -Re(w)-Im(w)]]))))
));

# These twiddles are combined with PRDFT3(2) (just as for PDHT3 above)
# since PRDFT3(2,1)=I(2), and PRDFT3(2,-1)=Diag(1,-1) we have the
# variable 'm' scaling the second column of rotations.
Class(R3_Twid, Sym, rec(
    def := (n, k) -> let(m := When(k mod 4 = 1, 1, -1),
	DirectSum(List([0..n/2-1], j -> let(w := E(2*n)^(k*j),
		           Mat([[Re(w), -Im(w)*m],
				[Im(w),  Re(w)*m]])))))
));
# since IPRDFT2(2,1)=Diag(1,-1), and IPRDFT2(2,-1)=I(2) we have 'm' again,
# it scales second row
Class(IR3_Twid, Sym, rec(
    def := (n, k) -> let(m := When(k mod 4 = 1, -1, 1),
	DirectSum(List([0..n/2-1], j -> let(w := E(2*n)^(k*j),
		           Mat(2*  [  [Re(w), -Im(w)],
				    m*[Im(w),  Re(w)]])))))
));

RulesFor(PDHT3, rec(
    PDHT3_CT_Radix2 := rec(
	isApplicable := P -> P[1] > 2 and IsEvenInt(P[1]),
	allChildren  := P -> [[ DFT1(P[1]/2, P[2]) ]],
	rule := (P,C) -> let(N := P[1], k := P[2],
	        RC(LIJ(N/2)) *
		DirectSum(Tensor(I(N/4), J(2)), I(N/2)) *
		RC(C[1]) *
		H3_CasTwid(N,k) *
		L(N,N/2)
	))
));
RulesFor(PRDFT3, rec(
    PRDFT3_CT_Radix2 := rec(
	isApplicable := P -> P[1] > 2 and IsEvenInt(P[1]),
	allChildren  := P -> [[ DFT1(P[1]/2, P[2]) ]], # SkewDFT(n, E(4)), and then no twids are necessary
	rule := (P,C) -> let(N := P[1], k := P[2],
	        RC(LIJ(N/2)) *
		Diag(BHD(N/2, 1, -1)) *
		RC(C[1]) *
		R3_Twid(N,k) *
		L(N,N/2)
	))
));
RulesFor(IPRDFT2, rec(
    IPRDFT2_CT_Radix2 := rec(
	isApplicable := P -> P[1] > 2 and IsEvenInt(P[1]),
	allChildren  := P -> [[ DFT1(P[1]/2, P[2]) ]], # SkewDFT(n, E(4)), and then no twids are necessary
	rule := (P,C) -> let(N := P[1], k := P[2],
		L(N,2) *
		IR3_Twid(N,k) *
		RC(C[1]) *
		Diag(BHD(N/2, 1, -1)) *
	        RC(LIJ(N/2).transpose())
	))
));

RulesFor(PDHT1, rec(
    PDHT1_CT_Radix2 := rec(
	isApplicable := P -> P[1] > 2 and IsEvenInt(P[1]),
	allChildren  := P -> [[ PDHT1(P[1]/2, P[2]), PDHT3(P[1]/2, P[2]) ]],
	rule := (P,C) -> let(N := P[1], k := P[2],
	        RC(OddStride(N/2+1, N/4+1)) *
		DirectSum(C[1], C[2]) *
		Tensor(F(2), I(N/2))
	))
));

RulesFor(PRDFT1, rec(
    PRDFT1_CT_Radix2 := rec(
	isApplicable := P -> P[1] > 2 and IsEvenInt(P[1]),
	allChildren  := P -> [[ PRDFT1(P[1]/2, P[2]), PRDFT3(P[1]/2, P[2]) ]],
	rule := (P,C) -> let(N := P[1], k := P[2],
	        RC(L_or_OS(N/2+1, Int(N/4)+1)) *
		DirectSum(C[1], C[2]) *
		Tensor(F(2), I(N/2))
	))
));
RulesFor(IPRDFT1, rec(
    IPRDFT1_CT_Radix2 := rec(
	isApplicable := P -> P[1] > 2 and IsEvenInt(P[1]),
	allChildren  := P -> [[ IPRDFT1(P[1]/2, P[2]), IPRDFT2(P[1]/2, P[2]) ]],
	rule := (P,C) -> let(N := P[1], k := P[2],
		Tensor(F(2), I(N/2)) *
		DirectSum(C[1], C[2]) *
	        RC(OddStride(N/2+1, 2))
	))
));

RulesFor(PRDFT2, rec(
    PRDFT2_CT_Radix2 := rec(
	isApplicable := P -> P[1] > 2 and IsEvenInt(P[1]),
	allChildren  := P -> [[ PRDFT2(P[1]/2, P[2]), PRDFT4(P[1]/2, P[2]) ]],
	rule := (P,C) -> let(N := P[1], k := P[2],
	        RC(OddStride(N/2+1, N/4+1)) *
		DirectSum(C[1], C[2]) *
		Tensor(I(N/2), F(2)) ^ L(N, N/2)
	))
));

# SwitchRules(PRDFT3, [1,3]);
# SwitchRules(PRDFT1, [1,7]);#H3_CasTwid.cost := n -> 4 + (n/2-1)*6;

#DHT1.cost := n -> n + DHT1.cost(n/2) + DHT3.cost(n/2);
#DHT3.cost := n -> H3_CasTwid.cost(n) + DFT.cost(n/2);

#DHT1.cost := n -> n + DHT1.cost(n/2) + H3_CasTwid.cost(n/2) + DFT.cost(n/4);
# DHT1(32) cost = 16*2 (F2) + size 64

# DFT_8 = 56
# DFT_16 = 168
# DFT_32 = 456
# DFT_64 = 1160


# Takes two groups, and builds the pregroup underlying the free product of
# these two groups
#
# don't try using this on large groups.
#
InstallMethod(PregroupOfFreeProduct, "for two finite groups",
              [IsGroup and IsFinite, IsGroup and IsFinite],
function(G, H)
    local i, j, size, table, eltn;

    size := Size(G) + Size(H) - 1;
    table := NullMat(size,size);

    table{[2..Size(G)]}{[2..Size(G)]} := MultiplicationTable(G){[2..Size(G)]}{[2..Size(G)]};
    table{[Size(G)+1..size]}{[Size(G)+1..size]} := Size(G) - 1 + MultiplicationTable(H){[2..Size(H)]}{[2..Size(H)]};

    for i in [Size(G) + 1 .. size ] do
        for j in [Size(G) + 1 .. size ] do
            if table[i][j] = Size(G) then
                table[i][j] := 1;
            fi;
        od;
    od;

    for i in [1..size] do
        table[1][i] := i;
        table[i][1] := i;
    od;

    eltn := List([1..size], String);
    return PregroupByTable(eltn, table);
end);

# Pregroup of free product of entered groups
InstallGlobalFunction(PregroupOfFreeProductList,
function(l)
    local r;

    r.groups := l;

    return Objectify(PregroupOfFreeProductType, r);
end);

InstallMethod(PregroupByRedRelators,
              "for a free group, and a list of words of length 3",
              [ IsFreeGroup, IsList, IsList ],
function(F, rred, inv)
    local rkF, n, enams, table, i, j, r, pg, convert, ic;

    rkF := Length(GeneratorsOfGroup(F));

    if ForAny(rred, x -> not ( (x in F) and ( Length(x) = 3 ) ) ) then
        Error("rred has to be a list of words of length 3 over F");
    fi;

    ic := Length(inv);
    n := 1 + 2 * rkF;
    enams := Concatenation(["1"]
                          , Concatenation( List([1..rkF],
                                 x -> [ Concatenation("x", String(x))
                                      , Concatenation("X", String(x)) ] )));
    table := NullMat(n, n);

    # Multiplication by 1
    for i in [1..n] do
        table[1,i] := i;
        table[i,1] := i;
    od;

    # Multiplication of mutual inverse generators in
    # Free group
    for i in [2, 4..2 * rkF] do
        table[i, i+1] := 1;
        table[i+1, i] := 1;
    od;

    for i in inv do
        table[ 2*i, 2*i] := 1;
        table[ 2*i, 2*i + 1] := 0;
        table[ 2*i + 1, 2*i] := 0;
        table[ 2*i+1 , 2*i+1] := 1;

    od;

    convert := function(x)
        if x > 0 then
            return 2 * x;
        else
            # involution
            if -x in inv then
                return 2 * (-x);
            else
                return 2 * (-x) + 1;
            fi;
        fi;
    end;

    # Enter red relators
    # for r = x * y * z we get
    # - x * y = z^-1
    # - x = z^-1 * y^-1
    # - y * z = x ^ -1
    # - z = y^-1 * x^-1
    # - y = x^-1 * z^-1
    # - y^-1 = z * x
    for r in List(rred, LetterRepAssocWord) do
        table[ convert(r[1]), convert(r[2]) ] := convert(-r[3]);
        table[ convert(-r[3]), convert(-r[2]) ] := convert(r[1]);
        table[ convert(r[2]), convert(r[3]) ] := convert(-r[1]);
        table[ convert(-r[2]), convert(-r[1]) ] := convert(r[3]);
        table[ convert(-r[1]), convert(-r[3]) ] := convert(r[2]);
        table[ convert(r[3]), convert(r[1]) ] := convert(-r[2]);
    od;
    pg := PregroupByTable(enams, table);
    pg!.freegroup := F;
    pg!.convert_word := w -> List(LetterRepAssocWord(w), l -> pg[convert(l)]);
    return pg;
end);


# Calculate over the field Q(a) where a is a solution to x^2-3 = 0
x := Indeterminate(Rationals, "x");
p := x^2-3;
e := AlgebraicExtension(Rationals, p);
a := RootOfDefiningPolynomial(e);

b1 := [1, 0] * One(e);
b2 := [1/2, 1/2*a] * One(e);

s := [-1/2, 1/2*a] * One(e);
t := [-1/2, -1/2*a] * One(e);

u := s - b1;
v := t - b1;

ToFloat := function(element)
  local coefficients;
  coefficients := ExtRepOfObj(element);
  return Float(coefficients[1]) + Sqrt(3.0)*Float(coefficients[2]);
end;

scale := 4;
n := 3;
radius := 2*Ceil(n/2.0);

points := [];
for a in [-n..n] do
  for b in [-n..n] do
    for c in [b1, b2] do
      w := (a*u + b*v) + c;
      norm := ToFloat(w * w);
      if norm <= radius^2 then
        w := scale * w;
        Add(points, w);
      fi;
    od;
  od;
od;

PrintToConsole := function(index, element)
  Print(element, "\n");
end;

psFile := "data.ps";
PrintToPS := function(index, element)
  AppendTo(psFile, "\t[", ToFloat(element[1]), " ", ToFloat(element[2]), "]\n");
end;

tspFile := "data.tsp";
PrintToTSP := function(index, element)
  AppendTo(tspFile, index, " ", ToFloat(element[1]), " ", ToFloat(element[2]), "\n");
end;

header := Concatenation("NAME: hex-paper\n\
TYPE: TSP\n\
COMMENT: Taking concorde for a run on a small problem\n\
DIMENSION: ", String(Length(points)), "\n\
EDGE_WEIGHT_TYPE: EUC_2D\n\
NODE_COORD_TYPE: TWOD_COORDS\n\
NODE_COORD_SECTION:\n");

PrintTo(psFile);
PrintTo(tspFile, header);

index := 0;
for w in points do
  PrintToConsole(index, w);
  PrintToPS(index, w);
  PrintToTSP(index, w);
  index := index + 1;
od;


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

###############################################################################
##
#F DwG_rank(<group>,<bool>). . . . . . . .compute rank of D^w(G)
##
InstallGlobalFunction(DwG_rank, function(G,display)
  local A,R,C,CH,H,classes,cs,fs,CC,Counter,f,DwG_rank,x,Zx,ZxReps,alpha_regular,g,is_alpha_regular,Zg_in_Zx,h,alpha_g_h,alpha_h_g,DwG_ranks,last_rank,H3G;

  # compute H_3(G,Z)
  H3G:=GroupHomology(G,3);;
  A:=CyclicGroup(Lcm(H3G));;
  #A:=CyclicGroup(Order(G));
  A:=TrivialGModuleAsGOuterGroup(G,A);;
  R:=ResolutionFiniteGroup(G,4);;
  C:=HomToGModule(R,A);;
  CH:=CohomologyModule(C,3);;
  H:=ActedGroup(CH);
  classes:=Elements(ActedGroup(CH));;
  Print(Length(classes));;
  Print("\n Cohomology group:");;
  Print(StructureDescription(H));;
  Print("\n");

  # get the 3-cocycle rerpresenting the second cohomology classes
  cs:=List(classes,x->CH!.representativeCocycle(x));

  # get a cocycle f:GxGxG->A corresponding to this cohomology class
  fs:=List(cs,x->Mapping(x));

  # get group conjugacy class represenatives
  CC:=List(ConjugacyClasses(G),Representative);;

  # for each cocycle f and each conjugacy class x compute alpha the 2-cocycle on
  # the centralizer
  Counter:=0;
  DwG_ranks:=[];
  for f in fs
  do
    Counter:=Counter+1;
    DwG_rank:=0;
    for x in CC
    do
      # compute the centralizer of X
      Zx:=Centralizer(G,x);;
      ZxReps:=List(ConjugacyClasses(Zx),Representative); # compute the alpha-regular elements of Zx
      alpha_regular:=[];;
      for g in ZxReps
      do
        is_alpha_regular:=true;;
        Zg_in_Zx:=Centralizer(Zx,g);
        for h in Zg_in_Zx
        do
          alpha_g_h:=f(g,h,x)*f(x,g,h)*(f(g,x,h)^-1);;
          alpha_h_g:=f(h,g,x)*f(x,h,g)*(f(h,x,g)^-1);;
          if not(alpha_g_h=alpha_h_g) then
            is_alpha_regular:=false;;
            break;;
          fi;
        od;
        if is_alpha_regular=true then
          Append(alpha_regular,[g]);
          DwG_rank:=DwG_rank+1;
        fi;
      od;
    od;
    if display then
      Print("\nThe cohomology class is: ");
      Print(classes[Counter]);
      Print("\nRank is: ");
      Print(DwG_rank);
    else
      Print(".");
    fi;
    Append(DwG_ranks,[[classes[Counter],DwG_rank]]);
    if Counter=1 then
      last_rank:=DwG_rank;
    fi;
  od;
  Print("\n");

  return DwG_ranks;;
end);

#E DwG_rank.gi . . . . . . . . . . . . . . . . . . . . . . . . . . . . ends here


##############################################################
##
##           Helps compute the decomposition of
##           the ramification module and the equivariant
##           degree of a multiple of a simple orbit for
##           the modular curves X(p) with automorphism group
##           G = PSL(2,p), p a prime.
##
##           Using these computations and Borne's formula, the
##           G-module structure of the RR spaces of equivariant
##           divisors can be determined explicitly.
##
## Reference: D. Joyner and A. Ksir, "Modular representations
##            on some Riemann-Roch spaces of modular curves
##            $X(N)$, Computational Aspects of Algebraic Curves,
##            (Editor: T. Shaska) Lecture Notes in Computing,
##            WorldScientific, 2005.)
##
##
## 12-30-2004, wdj
###########################################################

## To read this in, use for example:
### Read("/home/wdj/gapfiles/curves/mod_crv_aut_gp3.gap");
## To log your results, use for example:
### LogTo("/home/wdj/gapfiles/mod_crv_aut_gp1.log");

ram_module_X:=function(p)
## p is a prime
## output is [m1,...,mn]
## where n = # conj classes of G=PSL(2,p)
## and mi = mult of pi_i in ram mod of modular curve
## X with AutGp(X) = G.
## Here Irr(G) = [pi_1,...,pi_n] (in that order).
##
local G,i,j,n,n0,H,G1,H_chars,CG,G_chars,w,m,theta,pi_theta_to_the;
  G:=PSL(2,p);
  H:=[];
  H_chars:=[];
  n0:=[ [ Z(p)^0, Z(p) ], [ Z(p)*0, Z(p)^0 ] ];
  CG:=ConjugacyClassesSubgroups(G);
  H[1]:=Representative(CG[2]); # size 2
  H[2]:=Representative(CG[3]); # size 3
  n :=Size(CG);
  for i in [1..n] do
    if Size(Representative(CG[i]))=p then
      H[3]:=Representative(CG[i]);
    fi;
  od;
## H[3]:=Group(n0);       # size p
  for i in [1..Size(H)] do
   H_chars[i]:=Irr(H[i]);
  od;
  G_chars:=Irr(G);
  m:=[];
  m[1]:=[];m[2]:=[];m[3]:=[];
  theta:=List([1..3],i->H_chars[i][2]);
  pi_theta_to_the:=List([1..3],i->Sum([1..(Size(H[i])-1)],
      j->j*InducedClassFunction(theta[i]^(j),G)));
#Print("\n\n pi_theta_to_the = ",Sum(pi_theta_to_the),"\n\n");
  for i in [1..3] do
    m[i]:=List(G_chars, pi->ScalarProduct(pi_theta_to_the[i],pi))/Size(H[i]);
  od;
#Print("\n\n m = ",m,"\n\n");
return Sum(m);
end;

#ram_module_X(5);
#[ 0, 3, 3, 4, 5 ]
#ram_module_X(7);
#[ 0, 4, 3, 6, 7, 8 ]
#ram_module_X(11);
#[ 0, 5, 6, 11, 10, 12, 12, 12 ]
#ram_module_X(13);
#[ 0, 7, 7, 13, 13, 13, 13, 14, 15 ]
#ram_module_X(17);
#[ 0, 9, 9, 18, 17, 17, 17, 18, 18, 19, 19 ]
#ram_module_X(19);
#[ 0, 9, 10, 20, 20, 19, 19, 20, 20, 21, 21, 21 ]
#ram_module_X(23);
#[ 0, 14, 11, 24, 24, 24, 23, 23, 25, 25, 25, 25, 25, 25 ]
#ram_module_X(29);
#[ 0, 16, 16, 30, 31, 31, 30, 30, 30, 30, 31, 32, 32, 32, 31, 31, 31 ]
#ram_module_X(31);
#[ 0, 18, 15, 33, 33, 33, 32, 32, 32, 32, 33, 34, 33, 33, 34, 34, 34, 34 ]
#ram_module_X(37);
#[ 0, 20, 20, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 40, 39, 41, 41, 41, 40, 40, 40 ]

ram_module_X_JK:=function(p)
## p is a prime
## output is (m1,...,mn)
## where n = # conj classes of G=PSL(2,p)
## and mi = "mult of pi_i in ram mod of G" using JK formula
##
local G,i,j,n,n0,H,G1,H_chars,CG,G_chars,A,B,C,D,pi;
  G:=PSL(2,p);
  H:=[];
  H_chars:=[];
  n0:=[ [ Z(p)^0, Z(p) ], [ Z(p)*0, Z(p)^0 ] ];
  CG:=ConjugacyClassesSubgroups(G);
  H[1]:=Representative(CG[2]); # size 2
  H[2]:=Representative(CG[3]); # size 3
  n:=Size(CG);
  for i in [1..n] do
    if Size(Representative(CG[i]))=p then
      H[3]:=Representative(CG[i]);
    fi;
  od;
## H[3]:=Group(n0);       # size p
  for i in [1..Size(H)] do
   H_chars[i]:=Irr(H[i]);
  od;
  G_chars:=Irr(G);
  n:=Length(G_chars);
  A:=[];
  for i in [1..n] do
    pi:=G_chars[i];
    A[i]:=ScalarProduct(H_chars[1][1],RestrictedClassFunction(pi,H[1]));
  od;
  B:=[];
  for i in [1..n] do
    pi:=G_chars[i];
    B[i]:=ScalarProduct(H_chars[2][1],RestrictedClassFunction(pi,H[2]));
  od;
  C:=[];
  for i in [1..n] do
    pi:=G_chars[i];
    C[i]:=ScalarProduct(H_chars[3][1],RestrictedClassFunction(pi,H[3]));
  od;
  D:=[];
  for i in [1..n] do
    pi:=G_chars[i];
    D[i]:=DegreeOfCharacter(pi);
  od;
 return (1/2)*(3*D-A-B-C);
end;

#ram_module_X_JK(5);
#[ 0, 3, 3, 4, 5 ]
#ram_module_X_JK(7);
#[ 0, 7/2, 7/2, 6, 7, 8 ]
#ram_module_X_JK(11);
#[ 0, 11/2, 11/2, 11, 10, 12, 12, 12 ]
#ram_module_X_JK(13);
#[ 0, 7, 7, 13, 13, 13, 13, 15, 14 ]
#ram_module_X_JK(17);
#[ 0, 9, 9, 18, 17, 17, 17, 18, 18, 19, 19 ]
#ram_module_X_JK(19);
#[ 0, 19/2, 19/2, 20, 20, 19, 19, 20, 20, 21, 21, 21 ]
#ram_module_X_JK(23);
#[ 0, 25/2, 25/2, 24, 24, 24, 23, 23, 25, 25, 25, 25, 25, 25 ]
#ram_module_X_JK(29);
#[ 0, 16, 16, 30, 31, 31, 30, 30, 30, 30, 31, 32, 32, 32, 31, 31, 31 ]

pieces_ram_module_X:=function(p)
## p is a prime
## output is (m1,...,mn)
## where n = # conj classes of G=PSL(2,p)
## and mi = mult of pi_i in ram mod of G
##
local G,i,j,n,n0,H,G1,H_chars,CG,G_chars,w,m,theta,pi_theta_to_the;
  G:=PSL(2,p);
  H:=[];
  H_chars:=[];
  n0:=[ [ Z(p)^0, Z(p) ], [ Z(p)*0, Z(p)^0 ] ];
  CG:=ConjugacyClassesSubgroups(G);
  H[1]:=Representative(CG[2]); # size 2
  H[2]:=Representative(CG[3]); # size 3
  n :=Size(CG);
  for i in [1..n] do
    if Size(Representative(CG[i]))=p then
      H[3]:=Representative(CG[i]);
    fi;
  od;
## H[3]:=Group(n0);       # size p
  for i in [1..Size(H)] do
   H_chars[i]:=Irr(H[i]);
  od;
  G_chars:=Irr(G);
  m:=[];
  m[1]:=[];m[2]:=[];m[3]:=[];
  theta:=List([1..3],i->H_chars[i][2]);
  pi_theta_to_the:=List([1..3],i->Sum([1..(Size(H[i])-1)],
      j->j*InducedClassFunction(theta[i]^(j),G)));
#Print("\n\n pi_theta_to_the = ",Sum(pi_theta_to_the),"\n\n");
  for i in [1..3] do
    m[i]:=List(G_chars, pi->ScalarProduct(pi_theta_to_the[i],pi));
  od;
#Print("\n\n m = ",m,"\n\n");
return m;
end;

equiv_deg_module_X:=function(p,ii,r)
## p is a prime
## ii  = 1 for H[1], size 2
## ii  = 2 for H[2], size 3
## ii  = 3 for H[3], size p
## output is (m1,...,mn)
## where n = # conj classes of G=PSL(2,p)
## and mi = mult of pi_i in deg_equiv module of G
##
local G,i,j,n,n0,H,G1,H_chars,CG,G_chars,w,m,theta,pi_theta,pi_theta_to_the;
G:=PSL(2,p);
H:=[]; # 3 decomp gps
H_chars:=[];
n0:=[ [ Z(p)^0, Z(p) ], [ Z(p)*0, Z(p)^0 ] ];
CG:=ConjugacyClassesSubgroups(G);
H[1]:=Representative(CG[2]); # size 2
H[2]:=Representative(CG[3]); # size 3
n:=Size(CG);
for i in [1..n] do
  if Size(Representative(CG[i]))=p then
    H[3]:=Representative(CG[i]);
  fi;
od;
## H[3]:=Group(n0);       # size p
for i in [1..3] do
 H_chars[i]:=Irr(H[i]);
od;
G_chars:=Irr(G);
m:=[];
m[1]:=[];m[2]:=[];m[3]:=[];
theta:=List([1..3],i->H_chars[i][2]);
pi_theta_to_the:=List([1..3],i->List([1..r],j->InducedClassFunction(theta[i]^(-j),G)));
for i in [1..3] do
 for j in [1..r] do
  m[i][j]:=List(G_chars, pi->ScalarProduct(pi_theta_to_the[i][j],pi));
 od;
od;
return Sum(m[ii]);
end;

# equiv_deg_module_X(7,2,1);
#[ 0, 1, 1, 2, 2, 3 ]
# equiv_deg_module_X(7,1,1);
#[ 0, 2, 2, 2, 4, 4 ]
# equiv_deg_module_X(7,3,1);
#[ 0, 1, 0, 1, 1, 1 ]
# equiv_deg_module_X(7,3,7);
#[ 1, 3, 3, 6, 7, 8 ]
# equiv_deg_module_X(7,1,2);
#[ 1, 3, 3, 6, 7, 8 ]


InstallMethod(AlgebraicU,
              "Simple algebraic of adjoint type",
              [IsString,IsPosInt,IsRing],
              function(Type,Rank,Ring)
              local object,
              avarnames;
              object:=Objectify(NewType(NewFamily("AlgebraicUFamily"),
                                        IsAttributeStoringRep and
                                        IsChevalleyAdj and
                                        IsAlgebraicU),
                                rec());

              Settype(object,Type);
              Setrank(object,Rank);

              SetchevalleyAdj(object,ChevalleyAdj(Type,Rank,Ring));

              SetBaseRing(object,Ring);
              avarnames:=List([1..2*Length(positiveRoots(chevalleyAdj(object)))],i->Concatenation("a_{",String(i),"}"));
              Setring(object,PolynomialRing(Ring,avarnames));

              SetCharacteristic(object,Characteristic(Ring));

              SetlieAlgebra(object,SimpleLieAlgebraTypeA_G(Type,Rank,ring(object)));
              SetrootSystem(object,RootSystem(SimpleLieAlgebra(Type,Rank,Integers)));
              SetpositiveRoots(object,positiveRoots(rootSystem(object)));
              SetallRoots(object,Concatenation(
                  positiveRoots(rootSystem(object)),
                  -positiveRoots(rootSystem(object))));
              SetweylGroup(object,WeylGroup(rootSystem(object)));

              SetA(object,A_rs(object));
              SetH(object,Eta(object));
              SetN(object,N_rs(object));
              SetM(object,M_rsi(object));
              SetC(object,C_ijrs(object));

              SetName(object,Concatenation("<simple adjoint ",Type,String(Rank),
                                           " in characteristic ",String(Characteristic(Ring)),">"));

              return object;
end);

InstallMethod(AlgebraicU,
              "Simple algebraic of adjoint type",
              [IsChevalleyAdj],
              function(sys)
              local object,
              avarnames;
              object:=Objectify(NewType(NewFamily("AlgebraicUFamily"),
                                        IsAttributeStoringRep and
                                        IsChevalleyAdj and
                                        IsAlgebraicU),
                                rec());

              Settype(object,type(sys));
              Setrank(object,rank(sys));

              avarnames:=List([1..2*Length(positiveRoots(sys))],i->Concatenation("a_{",String(i),"}"));
              Setring(object,PolynomialRing(ring(sys),avarnames));

              SetCharacteristic(object,Characteristic(sys));

              SetlieAlgebra(object,SimpleLieAlgebraTypeA_G(type(object),rank(object),ring(object)));
              SetrootSystem(object,rootSystem(sys));
              SetpositiveRoots(object,positiveRoots(sys));
              SetallRoots(object,allRoots(sys));
              SetweylGroup(object,weylGroup(sys));

              SetA(object,A(sys));
              SetH(object,H(sys));
              SetN(object,N(sys));
              SetM(object,M(sys));
              SetC(object,C(sys));

              SetBaseRing(object,ring(sys));
              SetchevalleyAdj(object,sys);

              SetName(object,Concatenation("<simple adjoint ",type(object),String(rank(object)),
                                           " in characteristic ",String(Characteristic(object)),">"));

              return object;
end);


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

RulesFor(DCT2, rec(
    #F DCT2_DCT2and4: 1977
    #F
    #F   DCT2_n = perm * (DCT2_n/2 dirsum DCT4_n/2^perm) * (1 tensor DFT_2)^perm
    #F
    #F   Chen/Fralick/Smith:
    #F     A Fast Computational Algorithm for the
    #F     Discrete Cosine Transform, IEEE Trans. on Comm., 1977, pp. 1004--1009.
    #F   Wang:
    #F     Reconsideration of --above--
    #F     Circ., Systems, and Signal Proc., 1983, 121--123.
    #F   Rao/Yip:
    #F     Discrete Cosine Transform, Academic Press, 1990, pp. 53
    #F
    DCT2_DCT2and4 := rec(
	info         := "DCT2'_n --> DCT2'_n/2, DCT4_n/2",
	isApplicable := P -> P[1] > 2 and P[1] mod 2 = 0,
	allChildren  := P -> [[ DCT2(P[1]/2), DCT4(P[1]/2) ]],
	rule         := (P, C) ->
	    LIJ(P[1]) *
	    DirectSum(C[1], C[2] ^ J(P[1]/2)) *
	    Tensor(I(Int((P[1] / 2))), F(2)) ^ LIJ(P[1]) # this line was blocks1(P[1])
    ),

    #F DCT2_toRDFT:
    #F
    #F   DCT2_n = blocks * RDFT_n * perm
    #F
    #F for n even
    #F
    DCT2_toRDFT := rec (
	info         := "DCT2_n -> RDFT_n",
	isApplicable := P -> IsEvenInt(P[1]),
	allChildren  := P -> [[ SRDFT(P[1]) ]],

	rule := (P, C) -> let(i := Ind(P[1]/2-1),
            # first an X shaped matrix where opposite diagonal is lowered by 1
            LIJ(P[1]).transpose() *
	    DirectSum(I(1),
		      When(i.range > 0, IterDirectSum(i, i.range, Rot(fdiv(1+i, 2*P[1]))*J(2)), []),
		      Diag(Sqrt(1/2))) *
	    C[1] * K(P[1], 2)
	)
    ),
#rdft = d os dct p7
#dct = os^-1 d^-1 rdft * p7^-1
    DCT2_toRDFT_odd := rec(
	info             := "DCT2_n -> RDFT_n",
	isApplicable     := P -> IsOddInt(P[1]),
        allChildren      := P -> [[ PRDFT1(P[1]) ]],
	forTransposition := true,
	rule := (P, C) -> let(N := P[1],
	    OS(N, 2).transpose() *
	    Diag(List([0..N-1], i -> (-1)^i)) *
	    DirectSum(Mat([[1,0]]), LIJ(N-1).transpose()) *
	    C[1] *
	    perm7(N).transpose()
	)
    ),

    #F DCT2_PrimePowerInduction:
    #F
    #F   DCT2'_n = perm * sparse * (1 tensor DCT2'_n/3) *
    #F             ( dirsum of 3x3 blocks ) ^ perm * perm
    #F
    #F   Pueschel/Moura: Discrete Cosine and Sine Transforms
    #F
    DCT2_PrimePowerInduction := rec (
	info             := "DCT2_3n -> DCT2_n",
	isApplicable := P -> P[1] mod 3 = 0 and P[1] <> 3,
	allChildren  := P -> [[ DCT2(P[1]/3) ]],

        # the sparse matrix occuring in the rule; it has the form
        # [ [ I_n, Z_n ], [ Z_n, I_n ] ], Z_n has only 1's on the upper
        # diagonal; n = L/3
	sparsemat := function ( n )
	    local L, i;
            # diagonal 1's
	    L := List([1..2*n], i -> [i, i, 1]);
            # the other 1's
	    for i in [1..n-1] do  Add(L, [i, n+1+i, 1]);   od;
	    for i in [1..n-1] do  Add(L, [n+i, i+1, 1]);   od;
	    return Sparse(L);
	end,

        # the 3x3 blocks occuring; so to say the twiddle factors
        # note: the block for i = (n-1)/2 is a DCT of size 3 and can be done
        # in 4 adds, 2 mults; but here only in 5 adds and 2 mults
	block3 := function ( i, n )
	    local M, H, M1, ii;
	    ii := i + 1/2;
	    M := TransposedMat(
		[ [ 1,                1,                       1                      ],
		  [CosPi(  ii/(3*n)), CosPi(  (2*n-ii)/(3*n)), CosPi(  (2*n+ii)/(3*n))],
		  [CosPi(2*ii/(3*n)), CosPi(2*(2*n-ii)/(3*n)), CosPi(2*(2*n+ii)/(3*n))] ]
	    );
	    M := 3 * DiagonalMat([1, 1/2, 1/2]) * M^-1;
            # now M has 1's in the first row
	    H := [[1, 1, 1], [1, -1, 0], [1, 0, -1]];
	    M1 := M*H^-1;
            # M*H has the structure 1 dirsum 2x2 block
            # get the 2x2 block
	    M1 := Sublist(List(M1, r -> Sublist(r, [2,3])), [2,3]);
	    return DirectSum(I(1), Mat(M1)) * Mat(H);
	end,

	rule := (self, P, C) >> let(n := P[1]/3,
	    L(3*n, n) *
	    DirectSum(I(n), self.sparsemat(n)) *
	    Tensor(I(3), C[1]) *
	    (DirectSum(List([1..n], i -> self.block3(i, n))) ^ L(3*n, n)) *
	    IJ(3*n, n))
    ),

#F DCT2_PrimeFactor: 1985
#F
#F   DCT2_nm = P1 * (1_(n+m-1) dirsum (1_(nm-n-m+1) tensor F_2)) *
#F             P2 * (DCT2_n tensor DCT2_m) * P3,    gcd(n, m) = 1
#F
#F Yang/Narasimha: Prime Factor Decomposition of the Discrete Cosine Transform,
#F   Proc. ICASSP, pp. 772--775, 1985
#F
#F see also:
#F Feig/Linzer: Scaled DCT's on Input Sizes that Are Composite, IEEE Transactions on
#F   Signal Processing 43(1), pp. 43--50, 1995
#F
DCT2_PrimeFactor := rec (
  info             := "DCT2_nm -> DCT2_n tensor DCT2_m",
  isApplicable     := P -> not IsPrimePowerInt(P[1]),
  allChildren      := P -> List(DivisorPairsRP(P[1]), p -> [ DCT2(p[1]), DCT2(p[2]) ]),

  rule := function ( P, C )
    local n, n1, n2, dctperm1, dctperm2;

    n1 := C[1].dimensions[1];
    n2 := C[2].dimensions[1];
    n  := P[1];

    # first permutation
    dctperm1 := function ( n1, n2 )
      local n, g1, g2, L, i, j;

      n  := n1*n2;
      g1 := QuotientMod(1, n2, n1);
      g2 := n2 - QuotientMod(1, n1, n2);

      # indices
      L := [ ];
      for i in [0..n1 - 1] do
	for j in [0..n2 - 1] do
	  if (i + j) mod 2 = 0 then
	    Add(L, ((2*i + 1)*g1*n2 - (2*j + 1)*g2*n1) mod (4*n));
	  else
	    Add(L, ((2*i + 1)*g1*n2 + (2*j + 1)*g2*n1) mod (4*n));
	  fi;
	od;
      od;

      for i in [1..Length(L)] do
	if L[i] < 2*n then
	  L[i] := (L[i] - 1)/2;
	else
	  L[i] := (4*n - L[i] - 1)/2;
	fi;
      od;

      return PermList(L + 1);
    end;

    # second and third permutation
    dctperm2 := function ( n1, n2 )
      local n, K, L, i, j, q2;

      n  := n1*n2;

      L := [ ];
      K := [ ];

      # start with the border
      # i = 0
      for j in [0..n2 - 1] do
	Add(L, j);
	Add(K, j*n1);
      od;

      # j = 0
      for i in [1..n1 - 1] do
	Add(L, i*n2);
	Add(K, i*n2);
      od;

      # now the interior; two cases
      if n1 mod 2 = 0 then
	for i in [1..n1/2 - 1] do
	  for j in [1..n2 - 1] do
	    q2 := i*n2 + j*n1;
	    if q2 > n then
	      q2 := q2 - 2*n;
	      Add(L, (n1 - i)*n2 + (n2 - j));
	      Add(L, i*n2 + j);
	    else
	      Add(L, i*n2 + j);
	      Add(L, (n1 - i)*n2 + (n2 - j));
	    fi;
	    Add(K, AbsInt(i*n2 - j*n1));
	    Add(K, AbsInt(q2));
	  od;
	od;
	i := n1/2;
	for j in [1..(n2 - 1)/2] do
	  q2 := i*n2 + j*n1;
	  if q2 > n then
	    q2 := q2 - 2*n;
	    Add(L, (n1 - i)*n2 + (n2 - j));
	    Add(L, i*n2 + j);
	  else
	    Add(L, i*n2 + j);
	    Add(L, (n1 - i)*n2 + (n2 - j));
	  fi;
	  Add(K, AbsInt(i*n2 - j*n1));
	  Add(K, AbsInt(q2));
	od;
      else # n1 mod 2 <> 0
	for i in [1..(n1 - 1)/2] do
	  for j in [1..n2 - 1] do
	    q2 := i*n2 + j*n1;
	    if q2 > n then
	      q2 := q2 - 2*n;
	      Add(L, (n1 - i)*n2 + (n2 - j));
	      Add(L, i*n2 + j);
	    else
	      Add(L, i*n2 + j);
	      Add(L, (n1 - i)*n2 + (n2 - j));
	    fi;
	    Add(K, AbsInt(i*n2 - j*n1));
	    Add(K, AbsInt(q2));
	  od;
	od;
      fi;

      return [PermList(L + 1), PermList(K + 1)];
    end;

    # actual rule
    return
      Perm(dctperm2(n1, n2)[2]^-1, n) *
      DirectSum(
	I(n1 + n2 - 1),
	Tensor(I((n - n1 - n2 + 1)/2), F(2))
      ) *
      Perm(dctperm2(n1, n2)[1], n) *
      Tensor(C) *
      Perm(dctperm1(n1, n2), n);
  end
)
));


InstallMethod(ChevalleyAdj,
              "Simple algebraic of adjoint type",
              [IsString,IsPosInt,IsRing],
              function(Type,Rank,Ring)
              local object,test;
              object:=Objectify(NewType(NewFamily("ChevalleyAdjFamily"),
                                        IsAttributeStoringRep and
                                        IsChevalleyAdj),
                                rec());

              Settype(object,Type);
              Setrank(object,Rank);

              SetlieAlgebra(object,SimpleLieAlgebraTypeA_G(Type,Rank,Ring));
              SetrootSystem(object,RootSystem(SimpleLieAlgebraTypeA_G(Type,Rank,Integers)));
              SetpositiveRoots(object,positiveRoots(rootSystem(object)));
              SetallRoots(object,Concatenation(
                  positiveRoots(rootSystem(object)),
                  -positiveRoots(rootSystem(object))));
              SetweylGroup(object,WeylGroup(rootSystem(object)));

              Setring(object,Ring);

              SetCharacteristic(object,Characteristic(Ring));

              SetA(object,A_rs(object));
              SetN(object,N_rs(object));
              SetH(object,Eta(object));
              SetM(object,M_rsi(object));
              SetC(object,C_ijrs(object));

              SetName(object,Concatenation("<simple adjoint ",Type,String(Rank),
                                           " in characteristic ",String(Characteristic(Ring)),">"));

              return object;
end);

InstallMethod(ChevalleyAdj,
              "Simple algebraic of adjoint type",
              [IsChevalleyAdj,IsRing],
              function(sys,Ring)
              local object;
              object:=Objectify(NewType(NewFamily("ChevalleyAdjFamily"),
                                        IsAttributeStoringRep and
                                        IsChevalleyAdj),
                                rec());

              Settype(object,type(sys));
              Setrank(object,rank(sys));

              SetlieAlgebra(object,SimpleLieAlgebraTypeA_G(type(object),rank(object),Ring));
              SetrootSystem(object,rootSystem(sys));
              SetpositiveRoots(object,positiveRoots(sys));
              SetallRoots(object,allRoots(sys));
              SetweylGroup(object,weylGroup(sys));

              Setring(object,Ring);

              SetCharacteristic(object,Characteristic(Ring));

              SetA(object,A(sys));
              SetH(object,H(sys));
              SetN(object,N(sys));
              SetM(object,M(sys));
              SetC(object,C(sys));

              SetName(object,Concatenation("<simple adjoint ",type(object),String(rank(object)),
                                           " in characteristic ",String(Characteristic(object)),">"));

              return object;
end);

InstallMethod(A_rs,
              "Extended Cartan Matrix",
              [IsChevalleyAdj],
              function(sys)
              local A,
              root_len,L,B,cochars,
              r,s;

              root_len:=2*Length(positiveRoots(sys));
              L:=UnderlyingLieAlgebra(rootSystem(sys));
              cochars:=Cocharacters(L);
              cochars:=Concatenation(cochars,-cochars);
              B:=Basis(L);

              A:=NullMat(root_len,root_len,Integers);
              for r in [1..root_len] do
                  for s in [1..root_len] do
                      A[r][s]:=Sum(Coefficients(Basis(L),cochars[r]*B[s]));
                  od;
              od;

              return A;
end);

eta:=function(r,s,roots,NN)
    local p,q,sus,jos;

    p:=0;
    while Position(roots,-(p+1)*roots[r]+roots[s])<>fail do p:=p+1; od;
    q:=0;
    while Position(roots,(q+1)*roots[r]+roots[s])<>fail do q:=q+1; od;

    sus:=List([1..p],i->SignInt(NN[r][Position(roots,(i-1-p)*roots[r]+roots[s])]));
    if sus=[] then sus:=1; else sus:=Product(sus); fi;
    if sus=0 then sus:=1; fi;

    jos:=List([1..q],i->SignInt(NN[r][Position(roots,(i-1-p)*roots[r]+roots[s])]));
    if jos=[] then jos:=1; else jos:=Product(jos); fi;
    if jos=0 then jos:=1; fi;

    return (-1)^p*sus/jos;
end;

InstallMethod(Eta,
              "The matrix \eta with the signs (see Carter page 95)",
              [IsChevalleyAdj],
              function(sys)
              local H,
              NN,roots,roots_len,r,s;

              roots:=allRoots(sys);
              roots_len:=Length(roots);

              NN:=N_rs(sys);

              H:=NullMat(roots_len,roots_len,Integers);
#              for r in [1..roots_len/2] do
#                  H[r][r]:=-1;
#                  H[r][Position(roots,-roots[r])]:=-1;
#                  H[Position(roots,-roots[r])][r]:=-1;
#                  H[Position(roots,-roots[r])][Position(roots,-roots[r])]:=-1;
#              od;

              for r in [1..roots_len] do
                  for s in [1..roots_len] do
                      if r<>s and r<>Position(roots,-roots[s]) then H[r][s]:=eta(r,s,roots,NN);
                      else H[r][s]:=-1; fi;
                  od;
              od;

              return H;
end);

#InstallMethod(Eta,
#              "The matrix \eta with the signs (see Carter page 95)",
#              [IsChevalleyAdj],
#              function(sys)
#              local H,
#              A_rs,pr,roots,pr_len,root_refs,
#              r,s,
#              wr_on_s,flag;
#
#              A_rs:=A(sys);
#              pr:=positiveRoots(sys);
#              roots:=allRoots(sys);
#              pr_len:=Length(pr);
#              root_refs:=RootReflections(weylGroup(sys));
#
#              H:=NullMat(2*pr_len,2*pr_len,Integers);
#              for r in [1..pr_len] do
#                  H[r][r]:=-1;
#                  H[r][Position(roots,-roots[r])]:=-1;
#                  H[Position(roots,-roots[r])][r]:=-1;
#                  H[Position(roots,-roots[r])][Position(roots,-roots[r])]:=-1;
#              od;
#
#              for s in [1..2*pr_len] do
#                  flag:=false;
#                  for r in [1..2*pr_len] do
#                      wr_on_s:=Position(roots,roots[s]*root_refs[((r-1) mod pr_len) +1]);
#                      if H[r][s]<>0 and H[r][wr_on_s]=0 then
#                          H[r][wr_on_s]:=H[r][s]*(-1)^A_rs[r][s];
#                          H[r][Position(roots,-roots[wr_on_s])]:=H[r][wr_on_s];
#                          flag:=true;
#                      elif H[r][s]=0 and H[r][wr_on_s]<>0 then
#                          H[r][s]:=H[r][wr_on_s]*(-1)^A_rs[r][s];
#                          H[r][Position(roots,-roots[s])]:=H[r][s];
#                          flag:=true;
#                      fi;
#                  od;
#                  if not flag then
#                      for r in [1..2*pr_len] do
#                          wr_on_s:=Position(roots,roots[s]*root_refs[((r-1) mod pr_len)+1]);
#                          if H[r][s]=0 then
#                              H[r][s]:=1;
#                              H[r][Position(roots,-roots[s])]:=1;
#                              H[r][wr_on_s]:=(-1)^A_rs[r][s];
#                              H[r][Position(roots,-roots[wr_on_s])]:=H[r][wr_on_s];
#                          fi;
#                      od;
#                  fi;
#              od;
#
#              return H;
#end);

InstallMethod(N_rs,
              "Lie Algebra structure constants (see Carter page 52)",
              [IsChevalleyAdj],
              function(sys)
              local N,
              L,B,pr_len,
              r,s;

              L:=UnderlyingLieAlgebra(rootSystem(sys));
              B:=Basis(L);
              pr_len:=Length(positiveRoots(sys));

              N:=NullMat(2*pr_len,2*pr_len,Integers);
              for r in [1..pr_len*2] do
                  for s in [1..pr_len*2] do
                      if r=s+pr_len or s=r+pr_len then N[r][s]:=fail;
                      else N[r][s]:=Sum(Coefficients(B,B[r]*B[s])); fi;
                  od;
              od;

              return N;
end);

InstallMethod(M_rsi,
              "The M_rsi (see Certer page 61)",
              [IsChevalleyAdj],
              function(sys)
              local M,
              pr,pr_len,roots,n,
              i,j,k,tmp,poz;

              pr:=positiveRoots(sys);
              roots:=allRoots(sys);
              pr_len:=Length(pr);
              n:=N(sys);

              M:=List([1..pr_len*2],i->List([1..pr_len*2],j->[]));
              for i in [1..pr_len*2] do
                  for j in [1..pr_len*2] do
                      if i=j+pr_len or j=i+pr_len then M[i][j]:=fail;
                      else
                          tmp:=[n[i][j]];
                          for k in [2..4] do
                              poz:=Position(roots,(k-1)*roots[i]+roots[j]);
                              if poz<>fail then Add(tmp,n[i][poz]); fi;
                          od;
                          M[i][j]:=List([1..Length(tmp)],i->1/Factorial(i)*Product(tmp{[1..i]}));
                          M[i][j]:=Filtered(M[i][j],k->k<>0);
                      fi;
                  od;
              od;

              return M;
end);

InstallMethod(C_ijrs,
              "Algebraic group structure constants (see Carter page 76)",
              [IsChevalleyAdj],
              function(sys)
              local C,
              pr,pr_len,roots,m,
              r,s,poz;

              pr:=positiveRoots(sys);
              roots:=allRoots(sys);
              pr_len:=Length(pr);
              m:=M(sys);

              C:=List([1..pr_len*2],i->List([1..pr_len*2],j->[]));
              for r in [1..pr_len*2] do
                  for s in [1..pr_len*2] do
                    if r=s+pr_len or s=r+pr_len then C[r][s]:=fail;
                    else
                      #C_i1rs=M_rsi
                      Add(C[r][s],List([1..Length(m[r][s])],i->[i,1,m[r][s][i]]));
                      #C_1jrs=(-1)^j*M_srj
                      Add(C[r][s],List([2..Length(m[s][r])],j->[1,j,m[s][r][j]*(-1)^j]));#(1,1) apare mai sus
                      #C_32rs=1/3*M_(r+s)r2
                      poz:=Position(roots,3*roots[r]+2*roots[s]);
                      if poz <> fail then
                          poz:=Position(roots,roots[r]+roots[s]);
                          Add(C[r][s],[[3,2,(1/3)*m[poz][r][2]]]);
                      fi;
                      #C_23rs=1/3*M_(r+s)r2
                      poz:=Position(roots,2*roots[r]+3*roots[s]);
                      if poz <> fail then
                          poz:=Position(roots,roots[r]+roots[s]);
                          Add(C[r][s],[[2,3,-(2/3)*m[poz][s][2]]]);
                      fi;
                      C[r][s]:=Concatenation(C[r][s]);
                      Sort(C[r][s],function(a,b) return a[1]+a[2]<b[1]+b[2]; end);
                    fi;
                  od;
              od;

              return C;
end);

InstallMethod(PermutationSign,
              "Uses the \eta's to give the sign of the permutation on an e_alpha",
              [IsChevalleyAdj,IsList,IsPosInt],
              function(sys,perm,root_index)
              local result,
              eta,ref_mats,roots,
              i;

              eta:=H(sys);
              ref_mats:=RootReflections(weylGroup(sys));
              roots:=allRoots(sys);

              result:=1;
              for i in Reversed(perm) do  # !!! ATENTIE AICI .. conteaza daca e actiune stanga sau dreapta
              #for i in perm do
                  result:=result*eta[i][root_index];
                  root_index:=Position(roots,roots[root_index]*ref_mats[i]);
#                  root_index:=Position(roots,ref_mats[i]*roots[root_index]);
              od;

              return result;
end);

InstallMethod(PermutationSign,
              "Uses the \eta's to give the sign of the permutation on an e_alpha",
              [IsChevalleyAdj,IsList,IsList],
              function(sys,perm,root)
              return PermutationSign(sys,perm,Position(positiveRoots(sys),root));
end);

InstallMethod(InversePermutationSign,
              "Uses the \eta's to give the sign of the permutation on an e_alpha",
              [IsChevalleyAdj,IsList,IsPosInt],
              function(sys,perm,root_index)
              local result,
              eta,ref_mats,roots,
              i;

              eta:=H(sys);
              ref_mats:=RootReflections(weylGroup(sys));
              roots:=allRoots(sys);

              result:=1;
              #for i in Reversed(perm) do  # !!! ATENTIE AICI .. conteaza daca e actiune stanga sau dreapta
              for i in perm do
                  #result:=result*eta[i][root_index];
                  root_index:=Position(roots,roots[root_index]*ref_mats[i]);
                  result:=result*eta[i][root_index];
#                  root_index:=Position(roots,ref_mats[i]*roots[root_index]);
              od;

              return result;
end);

InstallMethod(InversePermutationSign,
              "Uses the \eta's to give the sign of the permutation on an e_alpha",
              [IsChevalleyAdj,IsList,IsList],
              function(sys,perm,root)
              return InversePermutationSign(sys,perm,Position(positiveRoots(sys),root));
end);


##############################################################
##
##           Helps compute the decomposition of
##           the ramification module and the equivariant
##           degree of a multiple of a simple orbit for
##           the Hurwitz curves X with automorphism group
##           G = PSL(2,q), q a prime.
##
##           Using these computations and Borne's formula, the
##           G-module structure of the RR spaces of equivariant
##           divisors can be determined explicitly.
##
## Reference: David Joyner, Amy Ksir, Roger Vogeler,
##            "Group representations on Riemann-Roch spaces
##            of some Hurwitz curves," preprint, 2006.
##
## 6-9-2006, wdj
##############################################################

## To read this in, use for example:
## Read("/home/wdj/gapfiles/curves/hurwitz_crv_rr_sp.gap");
## To log your results, use for example:
## LogTo("/home/wdj/gapfiles/curves/hurwitz_crv_rr_sp1.log");

hurwitz_primes:=function(n)
# Returns the primes < n s.t. PSL(2,p) is a Hurwitz gp
# Assumes n<1000.
local p,L;
L:=[];
for p in Primes do
 if Int((p+1)/7)=((p+1)/7) and p<n then
   L:=Concatenation(L,[p]);
 fi;
 if Int((p-1)/7)=((p-1)/7) and p<n then
   L:=Concatenation(L,[p]);
 fi;
od;
return L;
end;

hurwitz_prime_powers:=function(n)
## Returns the prime powers q=p^3 < n s.t. PSL(2,q)
## is a Hurwitz gp
## Assumes n<1000.
local p,L;
L:=[];
for p in Primes do
 if Int((p+2)/7)=((p+2)/7) and p^3<n then
   L:=Concatenation(L,[p^3]);
 fi;
 if Int((p-2)/7)=((p-2)/7) and p^3<n then
   L:=Concatenation(L,[p^3]);
 fi;
 if Int((p+3)/7)=((p+3)/7) and p^3<n then
   L:=Concatenation(L,[p^3]);
 fi;
 if Int((p-3)/7)=((p-3)/7) and p^3<n then
   L:=Concatenation(L,[p^3]);
 fi;
od;
return L;
end;

ram_module_hurwitz:=function(p)
##
## input: p is a Hurwitz prime; output: [m1,...,mn],
## where n = # conj classes of G=PSL(2,p)
## and mi = mult of pi_i in ram mod of Hurwitz crv with
## aut gp G.
## Here Irr(G) = [pi_1,...,pi_n] (in that order).
##
local A,B,C,D,pi,G,i,j,n,n0,H,G1,H_chars,CG,G_chars,w,m,theta,pi_theta_to_the;
  if not(p in hurwitz_primes(500)) then
      Print("Input is not a (small) Hurwitz prime.\n");
      return [];
  fi;
  G:=PSL(2,p);
  H:=[];
  H_chars:=[];
  n0:=[ [ Z(p)^0, Z(p) ], [ Z(p)*0, Z(p)^0 ] ];
  CG:=ConjugacyClassesSubgroups(G);
  H[1]:=Representative(CG[2]); # size 2
  H[2]:=Representative(CG[3]); # size 3
  n :=Size(CG);
  for i in [1..n] do
    if Size(Representative(CG[i]))=7 then
      H[3]:=Representative(CG[i]);
    fi;
  od;
## H[3]:=Group(n0);       # size 7
  for i in [1..Size(H)] do
   H_chars[i]:=Irr(H[i]);
  od;
  G_chars:=Irr(G);
  m:=[];
  m[1]:=[];m[2]:=[];m[3]:=[];
  theta:=List([1..3],i->H_chars[i][2]);
  pi_theta_to_the:=List([1..3],i->Sum([1..(Size(H[i])-1)],
      j->j*InducedClassFunction(theta[i]^(j),G)));
#Print("\n\n pi_theta_to_the = ",Sum(pi_theta_to_the),"\n\n");
  for i in [1..3] do
    m[i]:=List(G_chars, pi->ScalarProduct(pi_theta_to_the[i],pi))/Size(H[i]);
  od;
#Print("\n\n m = ",m,"\n\n");
#Print("Multiplicities (by definition):\n ",Sum(m),"\n");
return Sum(m);
####
n:=Length(G_chars);
A:=[];
B:=[];
C:=[];
D:=[];
for i in [1..n] do
  pi:=G_chars[i];
  A[i]:=ScalarProduct(H_chars[1][1],RestrictedClassFunction(pi,H[1]));
  B[i]:=ScalarProduct(H_chars[2][1],RestrictedClassFunction(pi,H[2]));
  C[i]:=ScalarProduct(H_chars[3][1],RestrictedClassFunction(pi,H[3]));
  D[i]:=DegreeOfCharacter(pi);
od;
#Print("Multiplicities (predicted by JK - assumes all R_\ell=1):\n ",(1/2)*(3*D-A-B-C),"\n");
end;

#########example
#gap> ram_module_hurwitz(13); time;
#
#m = [ [0,2,2,3,3,3,3,4,3],[0,2,2,4,4,4,4,5,5],[0,3,3,5,5,5,6,6,6] ]
#
#Multiplicities (by definition):
# [ 0, 7, 7, 12, 12, 12, 13, 15, 14 ]
#Multiplicities (predicted by JK - assumes all R_ell=1):
# [ 0, 7, 7, 12, 12, 12, 13, 15, 14 ]
#1640
#

ram_module_X:=function(p)
## p is a Hurwitz prime
## output is (m1,...,mn)
## where n = # conj classes of G=PSL(2,p)
## and mi = mult of pi_i in ram mod of G
##
local G,i,j,n,n0,H,G1,H_chars,CG,G_chars,w,m,theta,pi_theta_to_the;
  if not(p in hurwitz_primes(500)) then
      Print("Input is not a (small) Hurwitz prime.\n");
      return [];
  fi;
  G:=PSL(2,p);
  H:=[];
  H_chars:=[];
  n0:=[ [ Z(p)^0, Z(p) ], [ Z(p)*0, Z(p)^0 ] ];
  CG:=ConjugacyClassesSubgroups(G);
  H[1]:=Representative(CG[2]); # size 2
  H[2]:=Representative(CG[3]); # size 3
  n :=Size(CG);
  for i in [1..n] do
    if Size(Representative(CG[i]))=7 then
      H[3]:=Representative(CG[i]);
    fi;
  od;
## H[3]:=Group(n0);       # size 7
  for i in [1..Size(H)] do
   H_chars[i]:=Irr(H[i]);
  od;
  G_chars:=Irr(G);
  m:=[];
  m[1]:=[];m[2]:=[];m[3]:=[];
  theta:=List([1..3],i->H_chars[i][2]);
  pi_theta_to_the:=List([1..3],i->Sum([1..(Size(H[i])-1)],
      j->j*InducedClassFunction(theta[i]^(j),G)));
#Print("\n\n pi_theta_to_the = ",Sum(pi_theta_to_the),"\n\n");
  for i in [1..3] do
    m[i]:=List(G_chars, pi->ScalarProduct(pi_theta_to_the[i],pi))/Size(H[i]);
  od;
#Print("\n\n m = ",m,"\n\n");
return Sum(m);
end;

ram_module_X_JK:=function(p)
## p is a Hurwitz prime
## output is (m1,...,mn)
## where n = # conj classes of G=PSL(2,p)
## and mi = "mult of pi_i in ram mod of G" using JK formula
##
local G,i,j,n,n0,H,G1,H_chars,CG,G_chars,A,B,C,D,pi;
G:=PSL(2,p);
H:=[];
H_chars:=[];
n0:=[ [ Z(p)^0, Z(p) ], [ Z(p)*0, Z(p)^0 ] ];
CG:=ConjugacyClassesSubgroups(G);
H[1]:=Representative(CG[2]); # size 2
H[2]:=Representative(CG[3]); # size 3
n:=Size(CG);
for i in [1..n] do
  if Size(Representative(CG[i]))=7 then
    H[3]:=Representative(CG[i]);
  fi;
od;
## H[3]:=Group(n0);       # size 7
for i in [1..Size(H)] do
 H_chars[i]:=Irr(H[i]);
od;
G_chars:=Irr(G);
n:=Length(G_chars);
A:=[];
B:=[];
C:=[];
D:=[];
for i in [1..n] do
  pi:=G_chars[i];
  A[i]:=ScalarProduct(H_chars[1][1],RestrictedClassFunction(pi,H[1]));
  B[i]:=ScalarProduct(H_chars[2][1],RestrictedClassFunction(pi,H[2]));
  C[i]:=ScalarProduct(H_chars[3][1],RestrictedClassFunction(pi,H[3]));
  D[i]:=DegreeOfCharacter(pi);
od;
return (1/2)*(3*D-A-B-C); #assumes all R_\ell=1
end;

equiv_deg_module_hurwitz:=function(p,ii,r)
## p is a Hurwitz prime
## ii  = 1 for H[1], size 2
## ii  = 2 for H[2], size 3
## ii  = 3 for H[3], size p
## output is (m1,...,mn)
## where n = # conj classes of G=PSL(2,p)
## and mi = mult of pi_i in deg_equiv module of G
##
local G,i,j,n,n0,H,G1,H_chars,CG,G_chars,w,m,theta,pi_theta,pi_theta_to_the;
G:=PSL(2,p);
H:=[]; # 3 decomp gps
H_chars:=[];
n0:=[ [ Z(p)^0, Z(p) ], [ Z(p)*0, Z(p)^0 ] ];
CG:=ConjugacyClassesSubgroups(G);
H[1]:=Representative(CG[2]); # size 2
H[2]:=Representative(CG[3]); # size 3
n:=Size(CG);
for i in [1..n] do
  if Size(Representative(CG[i]))=7 then
    H[3]:=Representative(CG[i]);
  fi;
od;
## H[3]:=Group(n0);       # size 7
for i in [1..3] do
 H_chars[i]:=Irr(H[i]);
od;
G_chars:=Irr(G);
m:=[];
m[1]:=[];m[2]:=[];m[3]:=[];
theta:=List([1..3],i->H_chars[i][2]);
pi_theta_to_the:=List([1..3],i->List([1..r],j->InducedClassFunction(theta[i]^(-j),G)));
for i in [1..3] do
 for j in [1..r] do
  m[i][j]:=List(G_chars, pi->ScalarProduct(pi_theta_to_the[i][j],pi));
 od;
od;
return Sum(m[ii]);
end;

# equiv_deg_module_X(7,2,1);
#[ 0, 1, 1, 2, 2, 3 ]
# equiv_deg_module_X(7,1,1);
#[ 0, 2, 2, 2, 4, 4 ]
# equiv_deg_module_X(7,3,1);
#[ 0, 1, 0, 1, 1, 1 ]
# equiv_deg_module_X(7,3,7);
#[ 1, 3, 3, 6, 7, 8 ]
# equiv_deg_module_X(7,1,2);
#[ 1, 3, 3, 6, 7, 8 ]

cuberoots:=function(q)
local x,L;
 L:=[];
 for x in GF(q^2) do
   if x<>Zero(GF(q^2)) and x<>One(GF(q^2)) and x^3=One(GF(q^2)) then
     L:=Concatenation(L,[x]);
   fi;
 od;
 return L;
end;

#gap> cuberoots(41);
#[ Z(41^2)^560, Z(41^2)^1120 ]
#gap> cuberoots(43);
#[ Z(43)^14, Z(43)^28 ]
#gap> fourthroots(43);
#[ Z(43^2)^462, Z(43^2)^1386 ]
#gap> fourthroots(41);
#[ Z(41)^10, Z(41)^30 ]
#gap> fourteenthroots(41);
#[ Z(41^2)^120, Z(41^2)^600, Z(41^2)^1560, Z(41^2)^1320, Z(41^2)^1080, Z(41^2)^360 ]
#gap> fourteenthroots(43);
#[ Z(43)^3, Z(43)^9, Z(43)^15, Z(43)^27, Z(43)^33, Z(43)^39 ]

fourteenthroots:=function(q)
local x,L;
 L:=[];
 for x in GF(q^2) do
   if x<>Zero(GF(q^2)) and x<>One(GF(q^2)) and x^2<>One(GF(q^2))
                     and x^7<>One(GF(q^2)) and x^(14)=One(GF(q^2)) then
     L:=Concatenation(L,[x]);
   fi;
 od;
 return L;
end;

fourthroots:=function(q)
local x,L;
 L:=[];
 for x in GF(q^2) do
   if x<>Zero(GF(q^2)) and x<>One(GF(q^2)) and
      x^2<>One(GF(q^2)) and x^(4)=One(GF(q^2)) then
     L:=Concatenation(L,[x]);
   fi;
 od;
 return L;
end;

Nalpha:=function(alpha,q)
 # alpha a character of GF(q)^x
 local root3,root4,root14,count;
 count := 0;
 root3:=cuberoots(q)[1];
 root4:=fourthroots(q)[1];
 root14:=fourteenthroots(q)[1];
 if root3 in GF(q) and root3^alpha<>1 then count:=count+1; fi;
 if root4 in GF(q) and root4^alpha<>1 then count:=count+1; fi;
 if root14 in GF(q) and root14^alpha<>1 then count:=count+1; fi;
 return count;
end;

Nbeta:=function(beta,q)
 # beta a character of GF(q^2)^x
 local root3,root4,root14,count;
 count := 0;
 root3:=cuberoots(q)[1];
 root4:=fourthroots(q)[1];
 root14:=fourteenthroots(q)[1];
 if root3 in GF(q) and root3^beta<>1 then count:=count+1; fi;
 if root4 in GF(q) and root4^beta<>1 then count:=count+1; fi;
 if root14 in GF(q) and root14^beta<>1 then count:=count+1; fi;
 return count;
end;


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

# Base change for DST-3
#    def := (mn, n) -> Let(m=>mn/n,
#                  Conjugate(DirectSum(Tensor(I(n-1), S(m)), I(m)),
#	                        L(mn, n) * IP(mn, DirectSum(J(n-1), I(1))))),
Class(B_DST3_U, Sym, rec(
    def := (mn, m) -> let(n := mn/m,
	DoNotReorder(SUMAcc(
		Mon(fId(mn),
		    II(mn),
		    II(mn)),
		Mon(fTensor(Z(m,1), fDirsum(J(n-1), fId(1))),
		    II(mn),
		    diagTensor(II(m, 1, m), II(n,n-1))))))));
#B_DST3_U := (mn,m) -> I(mn);

Class(B_DST4_U, Sym, rec(
    def := (mn, m) -> let(n := mn/m,
	DoNotReorder(SUMAcc(
		Mon(fId(mn),
		    II(mn),
		    II(mn)),
		Mon(fTensor(Z(m,1), J(n)),
		    II(mn),
		    diagTensor(II(m, 1, m), II(n))))))));

Class(B_DCT4_U, Sym, rec(
    def := (mn, m) -> let(n := mn/m,
	DoNotReorder(SUMAcc(
		Mon(fId(mn),
		    II(mn),
		    II(mn)),
		Mon(fTensor(Z(m,1), J(n)),
		    fConst(mn, -1),
		    diagTensor(II(m, 1, m), II(n))))))));

Class(B_DCT3_U, Sym, rec(
    def := (mn, m) -> let(n := mn/m,
	DoNotReorder(SUMAcc(
		Mon(fId(mn), II(mn),          diagTensor(II(m,0,1), II(n,0,1))),
		Mon(fId(mn), fConst(mn, 1/2), diagTensor(II(m,1,m), II(n,0,1))),
		Mon(fId(mn), II(mn),          diagTensor(II(m,0,m), II(n,1,n))),

		Mon(fTensor(Z(m,1), fDirsum(fId(1), J(n-1))),
		    II(mn),
		    diagTensor(II(m, 1, m), II(n,1,n))),

		Mon(fTensor(Z(m,2), fId(n)),
		    fConst(mn, -1/2),
		    diagTensor(II(m, 2, m), II(n,0,1))))))));

# inverse-transpose T-basis for DCT3
Class(B_DCT3_T_IT, Sym, rec(
    def := (mn, m) -> let(n := mn/m,
	DoNotReorder(SUMAcc(
		Mon(fId(mn),
		    II(mn),
		    II(mn)),
		Mon(fTensor(Z(m,m-1), fDirsum(fId(1), J(n-1))),
		    II(mn),
		    diagTensor(II(m, 0, m-1), II(n,1,n))))))));

Class(B_DCT3_T_Radix2, Sym, rec(
    def := (mn, r) -> let(n := mn/2,
	DoNotReorder(SUMAcc(
		Mon(fId(mn), II(mn),               diagTensor(II(2,0,1), II(n,0,n))),
		Mon(fId(mn), fConst(mn, cos(r)),   diagTensor(II(2,1,2), II(n,0,1))),
		Mon(fId(mn), fConst(mn, 2*cos(r)), diagTensor(II(2,1,2), II(n,1,n))),

		Mon(fTensor(Z(2,1), fDirsum(fId(1), J(n-1))),
		    fConst(mn, -1),
		    diagTensor(II(2, 1, 2), II(n,1,n))))))));


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

Declare(IMDCT_Odd, IMDST_Odd);

Class(MDCTBase, DTTBase, rec(
    dims := self >> [ self.params, 2*self.params ],
    SmallRandom := () -> Random([2,4,6,8,12,16,18,24])
));

Class(IMDCTBase, DTTBase, rec(
    dims := self >> [ 2*self.params, self.params ],
    SmallRandom := () -> Random([2,4,6,8,12,16,18,24])
));

#F MDCT_Odd(<n>) - Modified Discrete Cosine Transform non-terminal, (oddly-stacked system)
#F Definition: (n x 2n)-matrix [ cos((2i+1)(2j+1+n)/(4n)) | i = 0..n-1, j = 0..2n-1 ]
#F Note:       MDCT_Odd is the transpose of IMDCT_Odd
#F Example:    MDCT_Odd(8)
#F
Class(MDCT_Odd, MDCTBase, rec(
    terminate := self >> let(n := self.params, Mat(
	List([0 .. n-1], i ->
	    List([0 .. 2*n - 1], j ->
		CosPi((2*j + 1 + n)*(2*i + 1)/(4*n)))))),

    transpose := self >> IMDCT_Odd(self.params),
));

MDCT := MDCT_Odd;

#F MDST_Odd(<n>) - Modified Discrete Sine Transform non-terminal, (oddly-stacked system)
#F Definition: (n x 2n)-matrix [ sin((2i+1)(2j+1+n)/(4n)) | i = 0..n-1, j = 0..2n-1 ]
#F Note:       MDST_Odd is the transpose of IMDST_Odd
#F Example:    MDST_Odd(8)
#F
Class(MDST_Odd, MDCTBase, rec(
    terminate := self >> let(n := self.params, Mat(
	List([0 .. n-1], i ->
	    List([0 .. 2*n - 1], j ->
		SinPi((2*j + 1 + n)*(2*i + 1)/(4*n)))))),

    transpose := self >> IMDST_Odd(self.params),
));

#F MDCT_Even(<n>) - Modified Discrete Cosine Transform non-terminal, (evenly-stacked system)
#F Definition: (n   x 2n)-matrix [ cos((2i)(2j+1+n)/(4n)) | i = 0..n-1, j = 0..2n-1 ], n even
#F             (n+1 x 2n)-matrix [ cos((2i)(2j+1+n)/(4n)) | i = 0..n,   j = 0..2n-1 ], n odd
#F
#F Example:    MDCT_Even(8)
#F
Class(MDCT_Even, MDCTBase, rec(
    dims := self >> [ self.params + When(IsOddInt(self.params), 1, 0), 2*self.params ],

    terminate := self >> let(n := self.params, isodd := When(IsOddInt(n), 1, 0), Mat(
	List([0 .. n-1 + isodd], i ->
	    List([0 .. 2*n - 1], j ->
		CosPi((2*j + 1 + n)*(2*i)/(4*n)))))),

#    transpose := self >> IMDCT_Even(self.params),
));

#F MDST_Even(<n>) - Modified Discrete Sine Transform non-terminal, (evenly-stacked system)
#F Definition: (n   x 2n)-matrix [ sin((2i)(2j+1+n)/(4n)) | i = 1..n,   j = 0..2n-1 ], n even
#F             (n-1 x 2n)-matrix [ sin((2i)(2j+1+n)/(4n)) | i = 1..n-1, j = 0..2n-1 ], n odd
#F
#F Example:    MDST_Even(8)
#F
Class(MDST_Even, MDCTBase, rec(
    dims := self >> [ self.params - When(IsOddInt(self.params), 1, 0), 2*self.params ],

    terminate := self >> let(n := self.params, isodd := When(IsOddInt(n), 1, 0), Mat(
	List([1 .. n-isodd], i ->
	    List([0 .. 2*n - 1], j ->
		SinPi((2*j + 1 + n)*(2*i)/(4*n)))))),

#    transpose := self >> IMDST_Even(self.params),
));

#F IMDCT_Odd(<n>) - Inverse Modified Discrete Cosine Transform non-terminal (oddly-stacked system)
#F Definition: (2n x n)-matrix [ cos((2j+1)(2i+1+n)/(4n)) | i=0..2n-1, j=0..n-1 ]
#F Note:       IMDCT_Odd is the transpose of MDCT_Odd
#F Example:    IMDCT_Odd(8)
#F
Class(IMDCT_Odd, IMDCTBase, rec(
    terminate := self >> let(n:=self.params, Mat(
	List([0 .. 2*n-1], i ->
	    List([0 .. n-1], j ->
		CosPi((2*i + 1 + n)*(2*j + 1)/(4*n)))))),

    transpose := self >> MDCT_Odd(self.params),
));

IMDCT := IMDCT_Odd;

#F IMDST_Odd(<n>) - Inverse Modified Discrete Sine Transform non-terminal (oddly-stacked system)
#F Definition: (2n x n)-matrix [ cos((2j+1)(2i+1+n)/(4n)) | i=0..2n-1, j=0..n-1 ]
#F Note:       IMDST_Odd is the transpose of MDST_Odd
#F Example:    IMDST_Odd(8)
#F
Class(IMDST_Odd, IMDCTBase, rec(
    terminate := self >> let(n:=self.params, Mat(
	List([0 .. 2*n-1], i ->
	    List([0 .. n-1], j ->
		SinPi((2*i + 1 + n)*(2*j + 1)/(4*n)))))),

    transpose := self >> MDST_Odd(self.params),
));

_shiftcut := (transform, n, start, cut, shift, boundary) -> Checked(cut in ["re", "im"],
    let(ofs := When(cut="re", 0, 1),
	N   := Cols(transform),
	i   := Ind(N),

	Gath(H(Rows(transform), n, ofs+start, 2)) *
	transform *
	When(boundary=1, I(N), Diag(Lambda(i, cond(leq(i,shift-1), boundary, 1)))) *
	Z(N, -shift))
);

RulesFor(MDCT_Odd, rec(
    #F MDCT_toDCT4:  MDCT_n = DCT4_n * sums
    #F
    MDCT_Odd_toDCT4 := rec (
	info         := "MDCT_n -> DCT4_n",
	isApplicable := P -> P mod 2 = 0,
	allChildren  := P -> [[ DCT4(P) ]],
	rule := (P, C) ->
	    C[1] *
	    J(P) *
	    DirectSum(Tensor(Mat([[1, -1]]), I(P/2)),
		      Tensor(Mat([[-1, -1]]), I(P/2))) *
	    DirectSum(J(P/2), I(P/2), I(P/2), J(P/2))
    ),

    MDCT_Odd_toPRDFT34 := rec(
	info         := "MDCT_n -> PRDFT4_2n or PRDFT3_2n",
	isApplicable := P -> true,
	allChildren  := P -> When(IsEvenInt(P), [[ PRDFT4(2*P) ]], [[ PRDFT3(2*P) ]]),
	rule := (P, C) -> let(n:=P,
	    _shiftcut(C[1], n, 0, "re", Int((n+1)/2), -1))
    )

));

RulesFor(MDST_Odd, rec(
    #F MDST_toDST4:  MDST_n = DST4_n * sums
    #F
    MDST_Odd_toDST4 := rec (
	info         := "MDST_n -> DST4_n",
	isApplicable := P -> P mod 2 = 0,
        # NOTE: implement rule for n odd, converts to DST3
	allChildren  := P -> [[ DST4(P) ]],
	rule := (P, C) -> let(n:=P,
	    C[1] *
	    J(n) *
	    DirectSum(Tensor(Mat([[1, 1]]), I(n/2)),
		      Tensor(Mat([[1, -1]]), I(n/2))) *
	    DirectSum(J(n/2), I(n/2), I(n/2), J(n/2)))
    ),

    MDST_Odd_toPRDFT34 := rec(
	info         := "MDST_n -> PRDFT4_2n or PRDFT3_2n",
	isApplicable := P -> true,
	allChildren  := P -> When(IsEvenInt(P), [[ PRDFT4(2*P) ]], [[ PRDFT3(2*P) ]]),
	rule := (P, C) -> let(n:=P,
	    _shiftcut(C[1], n, 0, "im", Int((n+1)/2), -1))
    )

));

RulesFor(MDCT_Even, rec(
    MDCT_Even_toPRDFT12 := rec(
	info         := "MDCT_n -> PRDFT1_2n or PRDFT2_2n",
	isApplicable := P -> true,
	allChildren  := P -> When(IsEvenInt(P), [[ PRDFT2(2*P) ]], [[ PRDFT1(2*P) ]]),
	rule := (P, C) -> let(n:=P,
	    _shiftcut(C[1], n+(n mod 2), 0, "re", Int((n+1)/2), 1))
    )
));

RulesFor(MDST_Even, rec(
    MDST_Even_toPRDFT12 := rec(
	info         := "MDST_n -> PRDFT1_2n or PRDFT2_2n",
	isApplicable := P -> true,
	allChildren  := P -> When(IsEvenInt(P), [[ PRDFT2(2*P) ]], [[ PRDFT1(2*P) ]]),
	rule := (P, C) -> let(n:=P,
	    _shiftcut(C[1], n-(n mod 2), 2, "im", Int((n+1)/2), 1))
    )
));


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

# Cross-compatibility
#

#######################################################################################
#   tSPL DFT rules
NewRulesFor(DFT, rec(
    #F DFT_CT: 1965
    #F   General Cooley-Tukey Rule
    #F   DFT_n = (DFT_n/d tensor I_d) * diag * (I_n/d tensor F_d) * perm
    #F
    #F Cooley/Tukey:
    #F   An Algorithm for the Machine Calculation of Complex Fourier Series.
    #F   Mathematics of Computation, Vol. 19, 1965, pp. 297--301.
    #F
    DFT_tSPL_CT := rec(
    info          := "tSPL DFT(mn,k) -> DFT(m, k%m), DFT(n, k%n)",

    maxSize       := false,
    filter := e->true,

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

    children      := (self, nt) >> Map2(Filtered(DivisorPairs(nt.params[1]), self.filter), (m,n) -> [
        TCompose([
            TGrp(TCompose([
                TTensorI(DFT(m, nt.params[2] mod m), n, AVec, AVec),
                TTwiddle(m*n, n, nt.params[2])
            ])),
            TGrp(TTensorI(DFT(n, nt.params[2] mod n), m, APar, AVec))
        ]).withTags(nt.getTags())
    ]),

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

#D    isApplicable := (self,P) >> P[1] > 2 and
#D        (self.maxSize=false or P[1] <= self.maxSize) and not IsPrime(P[1]) and PHasTags(self.nonTerminal, P),
#D    allChildren  := P -> Map2(DivisorPairs(P[1]),
#D        (m,n) -> [ TCompose([TGrp(TCompose([TTensorI(DFT(m, P[2] mod m), n, AVec, AVec), TDiag(fPrecompute(Tw1(m*n, n, P[2])))])),
#D                   TGrp(TTensorI(DFT(n, P[2] mod n), m, APar, AVec))], P[3]) ]),
#D    rule := (P,C,nt) -> C[1],
    switch := false
    )
));

NewRulesFor(DFT, rec(
    DFT_TTensorI_CT := rec(
        switch := false,
        maxSize := false,
        minSize := false,

        applicable := (self, t) >> let(
            n := Rows(t),
            n > 2
            #and nt.hasTags() --> fixed: dpickem 08/03/09
            and t.hasTags()
            and (self.maxSize=false or n <= self.maxSize)
            and (self.minSize=false or n >= self.minSize)
            and not IsPrime(n)
        ),

        children := t -> let(
            tags := t.params[3],
            Map2(DivisorPairs(Rows(t)), (m,n) -> [
                TTensorI_GT(GT(DFT(m, t.params[2] mod m), XChain([0, 1]), XChain([0, 1]), [n]).withTags(tags)),
                TTensorI_GT(GT(DFT(n, t.params[2] mod n), XChain([0, 1]), XChain([1, 0]), [m]).withTags(tags))
            ])
        ),

        apply := (t, C, Nonterms) ->
            Grp(C[1] * Diag(fPrecompute(Tw1(Rows(t), Rows(Nonterms[2].params[1]), t.params[2])))) * C[2]
    ),

    #F DFT_Rader: Rader's Algorithm for Prime size DFT
    #F
    #F   DFT(p) -> P(g)' * (1 dirsum DFT(p-1)) * Tp * (1 dirsum DFT(p-1)) * P(g)",
    #F   P(g) = perm
    #F   Tp   = [[1,1],[1,-1/(p-1)]] dirsum diag
    #F
    DFT_tSPL_Rader := rec(
        minSize := 3,
        useSymmetricAlgorithm := true,
        avoidSizes := [],
        switch := false,

        applicable := (self, t) >> let(
            n := Rows(t),
            n >= self.minSize
            and IsPrime(n)
            and (not n in self.avoidSizes)
            and t.hasTags()
        ),

        children := (self, t) >> let(
            N := Rows(t),
            tags := t.getTags(),
            When(self.useSymmetricAlgorithm,
                [[
                    TDirectSum(I(1), DFT(N-1, -1)).withTags(tags),
                    TRaderMid(N, t.params[2], PrimitiveRootMod(N)).withTags(tags)
                ]],
                [[
                    TCompose([
                        TDirectSum(I(1), DFT(N-1, -1)),
                        TRaderMid(N, t.params[2], PrimitiveRootMod(N)),
                        TDirectSum(I(1), DFT(N-1, -1))
                    ]).withTags(tags)
                ]]
            )
        ),

    apply := (self, t, C, Nonterms) >> let(
        N := Rows(t), k := t.params[2], root := PrimitiveRootMod(N),
        When(self.useSymmetricAlgorithm,
            RR(N, 1, root).transpose()
            * C[1].transpose() * C[2] * C[1]
            * RR(N, 1, root),
            RR(N, 1, root).transpose()
            * C[1]
            * RR(N, 1, root)
        ))
    ),

    #F DFT_Bluestein : Convert FFT to Toeplitz matrix, then embed in a larger Circulant
    #F
    #F    DFT_n -> diag * Toeplitz * diag
    #F
    # DFT on inputs, some of which are 0:
    #
    DFT_tSPL_Bluestein := rec(
        minRoundup := 8,
        customFilter := True,
        goodFactors := [2,3,5],
        applicableSizes := IsPrime,
        circSizes := meth(self,N)
            local low, high, cands;
            low := 2 * N + 1;
            high := 4 * 2^Log2Int(N);
            cands := When(high < self.minRoundup, [self.minRoundup], [low..high]);
            cands := Filtered(cands, self.customFilter);
            cands := Filtered(cands, i->IsEvenInt(i) and IsSubset(Set(self.goodFactors), Set(Factors(i))));
            return cands;
        end,

        toeplitz := (N, k) ->
            List([1..2*N-1], x -> ComplexW(2*N, -(N-x)^2 * k)),

        diag := (N, k) ->
            List([0..N-1], x -> ComplexW(2*N, x^2 * k)),

        circulantToep := (toep,size) -> let(l:=Length(toep),
            Concatenation(
                List([1..(l+1)/2],   x->toep[(l+1)/2+x-1]),
                List([1..size-l],    x->0),
                List([1..(l-1)/2],   x->toep[x]))),

        switch := false,
        applicable := (self, t) >> self.applicableSizes(Rows(t)) and t.hasTags(),

        children := meth(self, t)
            local P, N, k, circsize, dvar, diag, toep, circ, diagonalized_circ, tags, kids;

            tags := t.getTags();
            P := t.params;
            N := P[1];
            k := P[2];
            diag := FData(self.diag(N,k));
            toep := self.toeplitz(N,k);
            kids := [];
            for circsize in self.circSizes(N) do
                dvar := Dat(TArray(TComplex, circsize));
                circ := self.circulantToep(toep, circsize);
                diagonalized_circ := FData(1/circsize * ComplexFFT(circ));
                Add(kids, [
                    TCompose([
                        TRDiag(circsize/2, N, diag).transpose(),
                        PrunedDFT(circsize, -1, circsize/2, [0]).transpose(),
                        TDiag(diagonalized_circ),
                        PrunedDFT(circsize, 1, circsize/2, [0]),
                        TRDiag(circsize/2, N, diag)
                    ]).withTags(tags)
                ]);
            od;

            return kids;
        end,

        apply := (t, C, Nonterms) -> C[1]
    ),

    #F DFT_GoodThomas : Prime Factor FFT
    #F
    #F     DFT_n*k -> perm * (DFT_n_a tensor DFT_k_b) * perm
    #F     when gcd(n,k) = 1
    #F
    DFT_tSPL_GoodThomas := rec(
        applicable     := (t) ->
            t.params[1] > 2
            and DivisorPairsRP(t.params[1]) <> []
            and t.hasTags(),

        children := (self, t) >> let(
            tags := t.getTags(),
            mn := t.params[1],
            k := t.params[2],
            Map2(DivisorPairsRP(mn), (m,n) -> [
                TTensor(DFT(m, k*n mod m), DFT(n, k*m mod n)).withTags(tags)
            ])
        ),

        apply := (t, C, Nonterms) -> let(
            P := t.params,
            r := Rows(Nonterms[1].params[1]),
            s := Rows(Nonterms[1].params[2]),
            alpha := 1 / s mod r,
            beta  := 1 / r mod s,
            # CRT should not be pulled into sums before DelayedDirectSums are terminated,
            # otherwise PFA inside Rader for n =vq breaks as VectRaderDiag rules can't match
            DelayedPrm(CRT(r,s,1,1)).transpose() * C[1] * DelayedPrm(CRT(r,s,1,1))
        )
    )
));

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

NewRulesFor(TTensorI, rec(

    # Vector recursion for the DFT
    DFT_vecrec := rec(
        forTransposition := false,
        applicable := nt ->
            ObjId(nt.params[1]) = DFT
            and IsParVec(nt.params)
            and let(p1 := nt.params[1].params[1],
                p1 > 2 and not IsPrime(p1)
            )
            and nt.hasTags(),

        children := nt -> let(
            f := nt.params[1],
            k := nt.params[2],
            Map2(DivisorPairs(f.params[1]), (m,n) -> let(
                r := When(
                    nt.hasTags() and nt.firstTagIs(spiral.paradigms.vector.AVecReg),
                    VWrapTRC(nt.firstTag().v),
                    VWrapId
                ),
                [
                    TGrp(TCompose([
                        TTensorI(DFT(m, f.params[2] mod m), n, AVec, AVec),
                        TDiag(fPrecompute(Tw1(m*n, n, f.params[2])))
                    ])).withTags(nt.getTags()), <# strange #>
                    TTensorI(
                        TTensorI(DFT(n, f.params[2] mod n), m, APar, AVec),
                        k, APar, AVec
                    ).withTags(nt.getTags()) <# strange #>
                ]
            ))
        ),

        apply := (nt, c, cnt) -> Tensor(I(nt.params[2]), c[1]) * c[2],

        switch := false

#D    isApplicable := (self,P) >> ObjId(P[1])=DFT and P[3].isPar and P[4].isVec and
#D                                    let(P1:=P[1].params[1], P1 > 2 and not IsPrime(P1)) and PHasTags(self.nonTerminal, P),

#D        allChildren  := P -> let(k:=P[2],
#D        Map2(DivisorPairs(P[1].params[1]),
#D        (m,n) -> let( r:=When(Length(P[5])>0 and P[5][1].isReg, VWrapTRC(P[5][1].v), VWrapId),
#D            [ TGrp(TCompose([TTensorI(DFT(m, P[1].params[2] mod m), n, AVec, AVec),
#D                     TDiag(fPrecompute(Tw1(m*n, n, P[1].params[2])))]), P[5]).setWrap(r),

#D              TTensorI(TTensorI(DFT(n, P[1].params[2] mod n), m, APar, AVec),
#D                  k, APar, AVec, P[5]).setWrap(r) ]))),

#D    rule := (P,C,nt) -> Tensor(I(P[2]), C[1]) * C[2],
    ),

    # Transposed vector recursion for the DFT
    DFT_vecrec_T := rec(
        forTransposition := false,

        applicable := nt ->
            ObjId(nt.params[1]) = DFT
            and IsVecPar(nt.params)
            and let(
                p1 := nt.params[1].params[1],
                p1 > 2
                and IsPrime(p1)
            )
            and nt.hasTags(),

        children := nt -> let(
            k := nt.params[2],
            Map2(DivisorPairs(nt.params[1].params[1], (m,n) -> let(
                r := When(nt.hasTags() and nt.isTag(1, spiral.paradigms.vector.AVecReg),
                    VWrapTRC(nt.firstTag().v),
                    VWrapId
                ),
                [
                    TTensorI(
                        TTensorI(DFT(n, P[1].params[2] mod n), m, AVec, APar),
                        k, AVec, APar
                    ).withTags(nt.getTags()).setWrap(r), <# strange #>
                    TGrp(TCompose([
                        TDiag(fPrecompute(Tw1(m*n, n, P[1].params[2]))),
                        TTensorI(DFT(m, P[1].params[2] mod m), n, AVec, AVec)
                    ])).withTags(nt.getTags()).setWrap(r) <# strange #>
                ]
            )))
        ),

        apply := (nt, c, cnt) -> c[1] * Tensor(I(nt.params[2]), c[2]),

        switch := false

#D        isApplicable := (self,P) >> ObjId(P[1])=DFT and P[3].isVec and P[4].isPar and
#D                                    let(P1:=P[1].params[1], P1 > 2 and not IsPrime(P1)) and PHasTags(self.nonTerminal, P),
#D        allChildren  := P -> let(k:=P[2],
#D            Map2(DivisorPairs(P[1].params[1]),
#D        (m,n) -> let(r:=When(Length(P[5])>0 and P[5][1].isReg, VWrapTRC(P[5][1].v), VWrapId), [
#D            TTensorI(TTensorI(DFT(n, P[1].params[2] mod n), m, AVec, APar),
#D                                        k, AVec, APar, P[5]).setWrap(r),
#D
#D                    TGrp(TCompose([TDiag(fPrecompute(Tw1(m*n, n, P[1].params[2]))),
#D                                   TTensorI(DFT(m, P[1].params[2] mod m), n, AVec, AVec)
#D                  ]), P[5]).setWrap(r)
#D                            ]))),
#D
#D    rule := (P,C) -> C[1] * Tensor(I(P[2]), C[2]),

    )
));

#######################################################################################################
#   tSPL rule
NewRulesFor(MDDFT, rec(
    MDDFT_tSPL_RowCol := rec(
        info := "tSPL MDDFT_n -> MDDFT_n/d, MDDFT_d",

        applicable := (self, t) >> Length(t.params[1]) > 1,
        freedoms := t -> [ [1..Length(t.params[1])-1] ],

        child := (t, fr) -> let(
            newdims := SplitAt(t.params[1], fr[1]),
            rot := t.params[2],
            [ TTensor(
                MDDFT(newdims[1], rot),
                MDDFT(newdims[2], rot)
            ).withTags(t.getTags())]
        ),

        apply := (t, C, Nonterms) -> C[1],
        switch := false
    ),
));

AllRadices := function(n)
    local divisors, radices;
    divisors := DropLast(Drop(DivisorsInt(n), 1), 1);
    radices := Filtered(divisors, i -> n=(i^LogInt(n, i)));
    return radices;
end;

##########################################################################################
#   tSPL Pease DFT rule
NewRulesFor(DFT, rec(
    DFT_tSPL_Pease   := rec (
        info             := "Pease tSPL DFT_(k) -> (\Prod(L(I tensor F)Tc))*DR(k,r)",
#        forTransposition := false,
        forTransposition := true,
        maxRadix         := 32,
        minRadix         := 4,

        applicable := (self, nt) >>
            nt.hasTags()
            and nt.params[2] = 1
            and let(
                r := AllRadices(nt.params[1]),
                Length(r) > 0
                and ForAny(r, i ->
                    i >= self.minRadix
                    and i <= self.maxRadix
                    #and nt.firstTag().legal_kernel(i)
                )
            ),

        children := (self, nt) >> let(
            N := nt.params[1],
            m := nt.params[2],
            radices := Filtered(AllRadices(N), i ->
                i >= self.minRadix and i <= self.maxRadix
                #and nt.firstTag().legal_kernel(i)
            ),
            j := var("j"),

            List(radices, rdx -> [
                TCompose([
                    TICompose(j, LogInt(N, rdx),
                        TCompose([
                            TTensorI(DFT(rdx, m), N/rdx, AVec, APar),
                            TDiag(fPrecompute(TC(N, rdx, j, m)))
                        ])
                    ),
                    TDR(N, rdx)
                ]).withTags(nt.getTags()),
            ])
        ),

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

        switch := false

#D    isApplicable     := (self, P) >> PHasTags(self.nonTerminal, P) and P[2] = 1 and
#D                                     let(r := AllRadices(P[1]),
#D                                        Length(r) > 0 and
#D                                        ForAny(r, i-> i >= self.minRadix and i <= self.maxRadix and PGetFirstTag(self.nonTerminal, P).legal_kernel(i))
#D                                     ),
#D
#D    allChildren      := (self, P) >> let(
#D                            N := P[1],
#D                            m := P[2],
#D                            radices := Filtered(AllRadices(N), i-> i >= self.minRadix and i <= self.maxRadix and PGetFirstTag(self.nonTerminal, P).legal_kernel(i)),
#D                            j := var("j"),
#D
#D                            List(radices, rdx ->
#D                                [
#D                                    AddTag(
#D                                        TCompose([
#D                                            TICompose(j, LogInt(N, rdx),
#D                                                TCompose([
#D                                                    TTensorI(DFT(rdx, m), N/rdx, AVec, APar),
#D                                                    TDiag(fPrecompute(TC(N, rdx, j, m)))
#D                                                ])),
#D                                            TDR(N, rdx)
#D                                        ]),
#D                                    PGetTags(self.nonTerminal, P))
#D                                ]
#D                            )),
#D
#D    rule := (P, C) -> C[1],
    )
));

##########################################################################################
#   tSPL Stockham DFT rule
NewRulesFor(DFT, rec(
    DFT_tSPL_Stockham   := rec (
        info             := "Stockham tSPL DFT_(k) -> (\Prod(DFT tensor I)*Diag*(L tensor I))",
        forTransposition := false,
        maxRadix         := 2,
        minRadix         := 2,

        #one dimensional transform --> nt.params[2] = 1
        applicable := (self, nt) >>
            nt.hasTags()
            and nt.params[2] = 1
            and let(
                r := AllRadices(nt.params[1]),
                Length(r) > 0
                and ForAny(r, i ->
                    i >= self.minRadix
                    and i <= self.maxRadix
                    #and nt.firstTag().legal_kernel(i)
                )
            ),

        children := (self, nt) >> let(
            N := nt.params[1],
            m := nt.params[2],
            radices := Filtered(AllRadices(N), i ->
                i >= self.minRadix and i <= self.maxRadix and (When(IsBound(nt.firstTag().legal_kernel), nt.firstTag().legal_kernel(i), true))
            ),
#need the tag for TICompose to be parallelized, but then the DFT(r) in TTensorI will not be broken down
#if i use no tag for TICompose, no parallelization will take place ...
#solution: drop tags in GT_Par's children function --> rule GT_Par_drop implemented in paradigms/gpu/breakdown.gi
            List(radices, rdx -> let(j := var.fresh("j", TInt, LogInt(N, rdx)), tags := Drop(t.getTags(), 1),
                [TICompose(j, LogInt(N, rdx),
                        TCompose([
                            TTensorI(DFT(rdx, m), N/rdx, AVec, AVec),
                            #Diag(fPrecompute(diagTensor(Stockham_radix.gen(rdx, LogInt(N, rdx)-j-1), fConst(TComplex, rdx^j, 1)))),
                            #Tensor(Diag(fPrecompute(Stockham_radix.gen(rdx, LogInt(N, rdx)-j-1))), I(rdx^j)),
                            #TDiag(fPrecompute(diagTensor(TC5(rdx, LogInt(N, rdx)-j-1), fConst(TComplex, rdx^j, 1)))),
                            TTwiddle_Stockham(N, N/rdx, rdx, j),
                            Tensor(L(N/rdx^j, rdx), I( rdx^j))
                        ])
                    ).withTags(nt.getTags()),
                ])
            )
        ),

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

        switch := false
    )
));

NewRulesFor(DFT, rec(
    DFT_tSPL_Stockham_split   := rec (
        info             	:= "Stockham tSPL DFT_(k) -> (\Prod(DFT tensor I)*Diag*(L tensor I)), first n iterations split off",
        forTransposition 	:= false,
        minRadix         	:= 4,
        maxRadix         	:= 4,

        # one dimensional transform --> nt.params[2] = 1
        # first parameter of AGenericTag indicates how many iterations to split off
        applicable := (self, nt) >>
            nt.hasTags()
#            and nt.firstTag().kind() = AGenericTag
#            and IsPosInt(nt.firstTag().params[1])
            and nt.params[2] = 1
            and let(
                r := AllRadices(nt.params[1]),
                Length(r) > 0
                and ForAny(r, i ->
                    i >= self.minRadix
                    and i <= self.maxRadix
                    #and nt.firstTag() is GPU tag
                    #and nt.firstTag().legal_kernel(i)
                )
            ),

        children := (self, nt) >> let(
            N := nt.params[1],
            m := nt.params[2],
# number of iterations to peel off is n
#            n := nt.firstTag().params[1],
            n := 1,
            radices := Filtered(AllRadices(N), i ->
                i >= self.minRadix and i <= self.maxRadix and (When(IsBound(nt.firstTag().legal_kernel), nt.firstTag().legal_kernel(i), true))
            ),
            List(radices, rdx -> let(j := var.fresh("j", TInt, LogInt(N, rdx)-n), i := var.fresh("i", TInt, n),
            	# first TICompose deals with the iterations [n..LogInt(N,rdx)-1], these are the critical write-out stages

            	[TCompose([
                	TICompose(j, LogInt(N, rdx)-n,
                    	    TCompose([
                        	    TTensorI(DFT(rdx, m), N/rdx, AVec, AVec),
                            	#TDiag(fPrecompute(diagTensor(Stockham_radix.gen(rdx, LogInt(N, rdx)-j-1), fConst(TComplex, rdx^j, 1)))),
                            	#Diag(fPrecompute(diagTensor(TTwiddle_Stockham(rdx^(LogInt(N, rdx)-j), rdx^(LogInt(N, rdx)-j-1), 1).terminate(), fConst(TComplex, rdx^j, 1)))),
	                            TTwiddle_Stockham(N, N/rdx, rdx, j),
	                            TL(N/rdx^j, rdx, 1, rdx^j)
    	                    ])
        	            ).withTags(nt.getTags()),
            	     # second TICompose has to range from [0..n-1]
                	 TICompose(i, n,
	                        TCompose([
    	                        TTensorI(DFT(rdx, m), N/rdx, AVec, AVec),
        	                    #TDiag(fPrecompute(diagTensor(Stockham_radix.gen(rdx, n-i-1), fConst(TComplex, N/rdx^(n-i), 1)))),
                            	#Tensor(TTwiddle(rdx^(n-j), rdx^(n-j-1)), I(rdx^j)),
	                            #Diag(fPrecompute(diagTensor(TTwiddle_Stockham(rdx^(LogInt(N, rdx)-j), rdx^(LogInt(N, rdx)-j-1), 1).terminate(), fConst(TComplex, rdx^j, 1)))),
								TTwiddle_Stockham(N, N/rdx, rdx, j),
            	                TL(rdx^(n-i), rdx, 1, N/rdx^(n-i))
                	        ])
	                    ).withTags(nt.getTags()),
					])
                ])
            )
        ),

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

        switch := false
    )
));