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

Declare(VTensor, RCVTensor, VTensorInd);

#   A x I_v
Class(VTensor, Tensor, rec(
    new := (self, L) >> SPL(WithBases(self, rec(
        _children := [L[1]],
        dimensions := When(IsBound(L[1].dims), L[1].dims(), L[1].dimensions) * L[2],
        vlen := L[2]))),
    # NOTE: vlen not exposed to rChildren
    from_rChildren := (self, rch) >> ObjId(self)(rch[1], self.vlen),

    normalizedArithCost := (self) >> self.vlen * self.child(1).normalizedArithCost(),
    print := (self,i,is) >> Print(self.name, "(",
    self.child(1).print(i+is,is), ", ", self.vlen, ")"),
    toAMat := self >> Tensor(self.child(1), I(self.vlen)).toAMat(),
    sums := self >> Inherit(self, rec(_children := [self.child(1).sums()])),
    isPermutation := False,
    dims := self >> self.child(1).dims() * self.vlen,
    needInterleavedLeft := False,
    needInterleavedRight := False,
    transpose := self >> VTensor(self.child(1).transpose(), self.vlen),
    # for BlockSums
    isBlockTransitive := true,
    area := self >> self.child(1).area() * self.vlen,
    #NOTE: check if these two should be set to true or false
    cannotChangeDataFormat := False,
    totallyCannotChangeDataFormat := False
));

#   RC(A x I_v)
Class(RCVTensor, Tensor, rec(
    new := (self, L) >> SPL(WithBases(self, rec(
        _children := [L[1]],
        dimensions := 2 * L[1].dimensions * L[2],
        vlen := L[2]))),
    # NOTE: vlen not exposed to rChildren
    from_rChildren := (self, rch) >> ObjId(self)(rch[1], self.vlen),
    print := (self,i,is) >> Print(self.name, "(",
    self.child(1).print(i+is,is), ", ", self.vlen, ")"),
    toAMat := self >> RC(Tensor(self.child(1), I(self.vlen)).toAMat()),
    sums := self >> Inherit(self, rec(_children := [self.child(1).sums()])),
    isPermutation := False,
    dims := self >> self.child(1).dims() * self.vlen * 2,
    needInterleavedLeft := True,
    needInterleavedRight := True,
    transpose := self >> RCVTensor(self.child(1).transpose(), self.vlen),
    # for BlockSums
    isBlockTransitive := true
));

Class(VTensorInd, Tensor, rec(
    new := (self, L) >> SPL(WithBases(self, rec(
        _children := [L[1]],
        dimensions := When(IsBound(L[1].dims), L[1].dims(), L[1].dimensions) * L[2].range,
        vlen := L[2]))),
    from_rChildren := (self, rch) >> ObjId(self)(rch[1], self.vlen),

    rChildren := self >> [self._children[1], self.vlen],

    rSetChild := meth ( self, n, what )
            if n=1 then
                self._children[1] := what;
            elif n=2 then
                self.vlen := what;
            else
                Error("VTensorInd only has 2 rChildren");
            fi;
        end,
#    from_rChildren := (self, rch) >> ObjId(self)(rch[1], rch[2]),

    print := (self,i,is) >> Print(self.name, "(",
    self.child(1).print(i+is,is), ", ", self.vlen, ")"),
    toAMat := self >> let(d := self.child(1).dims(), v := self.vlen.range, L(d[1]*v, d[1]).toAMat() * IDirSum(self.vlen, self.child(1)).toAMat() * L(d[2]*v, v).toAMat()),
    sums := self >> Inherit(self, rec(_children := [self.child(1).sums()])),
    isPermutation := False,
    dims := self >> self.child(1).dims() * self.vlen.range,
    needInterleavedLeft := False,
    needInterleavedRight := False,
    transpose := self >> VTensorInd(self.child(1).transpose(), self.vlen),
    # for BlockSums
    isBlockTransitive := true,
    area := self >> self.child(1).area() * self.vlen.range,
    free := meth(self)
        local fvar;
        fvar := self.child(1).free();
        SubtractSet(fvar, Set([self.vlen]));
        return fvar;
    end
));


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

sys:=AlgebraicU(ChevalleyAdj("F",4,GF(2)));
w:=Witt(1,sys);
Print("Created Witt ",w,"\n");
Print("\t[",IsWitt(w)=true,"] IsWitt(w)=true\n");


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

Declare(DFT_Rader, DFT_GoodThomas);

_accurate_dft := vec -> List(TransposedMat(MatSPL(transforms.DFT(Length(vec)))*TransposedMat([vec]))[1], ComplexCyc);

Class(fdft, FuncExp, rec(
    computeType := self >> self.args[1].t
));

Class(fDFT, DiagFunc, rec(
    abbrevs := [ func -> Checked(IsFunction(func), [func]) ],
    range  := self >> TComplex,
    domain := self >> self.params[1].domain(),

    lambda := self >> fdft(self.params[1].lambda()),

    tolist := self >> let(
	elts := List(self.params[1].tolist(), x->Complex(EvalScalar(x))),
	ComplexFFT(elts))
));

NewRulesFor(DFT, rec(
    #F DFT_Base: DFT_2 = F_2
    #F
    DFT_Base := rec(
        info             := "DFT_2 -> F_2",
        forTransposition := false,
        applicable       := nt -> nt.params[1] = 2 and not nt.hasTags(),
        apply            := (nt, C, cnt) -> F(2)
    ),

    DFT_Base1 := rec(
        info             := "DFT_1 -> I(1)",
        forTransposition := false,
        applicable       := nt -> nt.params[1] = 1 and not nt.hasTags(),
        apply            := (nt, C, cnt) -> I(1)
    ),

    #F DFT_Canonize: DFT_n_k = perm * DFT_n
    #F
    DFT_Canonize := rec(
       switch           := false,
       info             := "DFT_n_k -> perm * DFT_n",
       forTransposition := false,
       applicable       := nt -> nt.params[1] > 2 and nt.params[2] <> 1 and not nt.hasTags(),
       children         := nt -> [[ DFT(nt.params[1], 1) ]],
       apply            := (nt, C, cnt) -> OddStride(nt.params[1], nt.params[2]) * C[1]
    ),

    #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_CT := rec(
        info          := "DFT(mn,k) -> DFT(m, k%m), DFT(n, k%n)",

        maxSize       := false,
        forcePrimeFactor := false,

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

        children  := nt -> Map2(DivisorPairs(nt.params[1]),
            (m,n) -> [ DFT(m, nt.params[2] mod m), DFT(n, nt.params[2] mod n) ]
        ),

        apply := (nt, C, cnt) -> let(mn := nt.params[1], m := Rows(C[1]), n := Rows(C[2]),
            Tensor(C[1], I(n)) *
            Diag(fPrecompute(Tw1(mn, n, nt.params[2]))) *
            Tensor(I(m), C[2]) *
            L(mn, m)
        )
    ),

    DFT_CT_Mincost := rec(
        maxSize := false,
        applicable := (self, nt) >> let(N := nt.params[1],
	    N > 2 and not nt.hasTags() and IsEvenInt(N) and
            (self.maxSize = false or nt.params[1] <= self.maxSize)),

        children  := nt -> let(N := nt.params[1], k := nt.params[2], Map2(
	    Filtered(DivisorPairs(N), divpair -> IsEvenInt(divpair[2])),
            (m,n) -> [ DFT(m, k mod m), DFT3(m, k mod (2*m)), DFT(n, k mod n) ])),

        apply := (nt, C, cnt) -> let(
	    N := nt.params[1], m := Rows(C[1]), n := Rows(C[3]), k := nt.params[2],
            hf := (n-2)/2,     i := Ind(hf),    j := Ind(hf),

            SUM(        _hhi(N,  m, 0,      n,  C[1]), # first iteration has no twiddles
              When(hf=0, [],
		ISum(i, _hhi(N,  m, i+1,    n,  C[1] * Diag(fPrecompute(Twid(N,m,k,0,0,i+1)))))),
                        _hhi(N,  m, hf+1,   n,  C[2]), # middle is a DFT3
	      When(hf=0, [],
		ISum(j, _hhi(N,  m, j+hf+2, n,  C[1] * Diag(fPrecompute(Twid(N,m,k,0,0,j+2+hf))))))
            ) *
            Tensor(I(m), C[3]) *
            Tr(n, m)
        )
    ),

    #F DFT_CosSinSplit:
    #F
    #F   DFT_n = CosDFT_n + i * SinDFT_n
    #F
    #F This rule has been restricted in applicability to small size
    #F (see config.g), Connects to Vetterli rules for CosDFT/SinDFT.
    #F
    DFT_CosSinSplit := rec(
        info             := "DFT_n -> CosDFT_n, SinDFT_n",
        forTransposition := false,
        maxSize := 64,

        applicable := (self, nt) >> let(N:=nt.params[1], rot:=nt.params[2],
            N > 2 and N <= self.maxSize and Is2Power(N) and AbsInt(rot)=1
	    and not nt.hasTags()),

        children := nt -> [[ CosDFT(nt.params[1]), SinDFT(nt.params[1]) ]],

        apply := (nt, C, cnt) -> let(N := nt.params[1], rot := nt.params[2],
	    Tensor(Mat([[1,1]]), I(N)) *
            VStack(C[1], (E(4)^rot) * 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_Rader := rec(
        info             := "DFT(p) -> P(g)' * DFT(p-1) * Tp ",
        forTransposition := false,
        minSize          := 3,
        maxSize          := 64,
        accurate         := true,

        raderDiag := (self, N, k, root) >> let(
	    dft := When(self.accurate, _accurate_dft, vec->ComplexFFT(List(vec,ComplexCyc))),
            SubList(dft(List([0..N-2], x -> E(N)^(k*root^x mod N))), 2) / (N-1)),

        raderMid := (self, N, k, root) >>
                     DirectSum(Mat([[1, 1], [1, -1/(N-1)]]),
                       Diag(FData(self.raderDiag(N, k, root)))),

        applicable := (self, nt) >> let(n:=nt.params[1],
            n >= self.minSize and n <= self.maxSize and IsPrime(EvalScalar(n))
	    and not nt.hasTags()),

        children      := nt -> [[ DFT(nt.params[1]-1, -1), DFT(nt.params[1]-1, -1) ]],

        apply := (self, nt, C, cnt) >> let(
	    N := EvalScalar(nt.params[1]), k := EvalScalar(nt.params[2]), root := PrimitiveRootMod(N),
            RR(N, 1, root).transpose() *
            DirectSum(I(1), C[1]) *
            self.raderMid(N,k,root) *
            DirectSum(I(1), C[2]) *
            RR(N, 1, root)
        )
    ),

    DFT_RealRader := CopyFields(~.DFT_Rader, rec(
        children      := nt -> [[ PRDFT1(nt.params[1]-1).transpose(), PRDFT1(nt.params[1]-1) ]],

        realRaderDiag := (self, N, k, root) >> let(cdiag := self.raderDiag(N, k, root),
            # cdiag is of length N-2.
            # cdiag = sublist( DFT_{N-1} * omega_vector, [2..N-1])
            # now we want to obtain
            #   rdiag = sublist( RDFT_N * omega_vector, [2..N-1]), we can do this using
            #   the property RDFT = (1 dirsum (I tensor [[1, 1], [-j, j]]) dirsum 1) * LIJ * DFT
            #   which means that rdiag = (1 dirsum (I tensor [[1, 1], [-j, j]]) dirsum 1) * LIJ * cdiag
            #   the code below does this ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ plus pads a zero (for PRDFT)
            #   and also the following trick.

            #  The expected rdiag steady state is [[a, b], [b, -a]], we convert this to rotations (=RCDiag)
            #  by applying J(2), ie we get [[b, -a], [a, b]], which would be a rotation by b + E(4)*a,
            #  but in this case both a and b are complex, so its not. We still use RCDiag though.
            #
            Concatenation(
                ConcatList([1..(N-3)/2], i -> Reversed([cdiag[i]+cdiag[N-1-i], -E(4)*(cdiag[i]-cdiag[N-1-i])])), # DFT->RDFT
                [0, cdiag[(N-3)/2+1]])),

        raderMid := (self, N, k, root) >>
            DirectSum(Mat([[1, 1, 0], [1, -1/(N-1), 0], [0, 0, 0]]), # zero padding for PRDFT
                Tensor(I((N-1)/2), J(2))*
                RCDiag(FData(self.realRaderDiag(N, k, root))).toloop()),
                # RCDiag with complex entries, max weird :) !
                # .toloop() is used because in vector code RCDiag is
                # converted to VRCDiag which is confused by complex entries AFAIK
        apply := (self,nt,C,cnt) >> let(
        N := EvalScalar(nt.params[1]), k := EvalScalar(nt.params[2]), root := PrimitiveRootMod(N),
            RR(N, 1, root).transpose() *
            DirectSum(I(1), C[1]) *
            self.raderMid(N,k,root) *
            DirectSum(I(1), C[2]) *
            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_Bluestein := rec(
        info             := "DFT_n -> diag * Toeplitz * diag",
        forTransposition := false,
        minSize := 3,
        maxSize := false,
        switch := false,

        # Applicable only for non-powers of 2 to prevent cycles
        applicable := (self, nt) >> let(N := nt.params[1],
            IsSymbolic(N) or
	    (N >= self.minSize and When(IsInt(self.maxSize), N <= self.maxSize, true) and not Is2Power(N)
		and not nt.hasTags())),

	# NOTE: extend this to be a true degree of freedom
	freedoms := t -> let(min := 2*t.params[1]+1,
	    [ integersBetween(min, 4 * pow(2, floor(log(t.params[1])/log(2)))) ]),

        child := (t, fr) -> let(
	    N := t.params[1], Ncirc := fr[1],
            [ DFT(Ncirc, -1).withTags(t.getTags()), DFT(Ncirc, 1).withTags(t.getTags()) ]),

        diag := (N, k) -> let(i:=Ind(N), Lambda(i, omegapi(fdiv(i^2 * k, N)))),

	circ := (N, k, circsize) -> let(
	    j1 := Ind(N),
	    j2 := Ind(N-1),
	    diagDirsum(
		Lambda(j1, fdiv(omegapi(fdiv(-j1^2*k, N)), circsize)),
		fConst(TReal, circsize-2*N+1, 0),
		Lambda(j2, fdiv(omegapi(fdiv(-(N-j2-1)^2*k, N)), circsize)))),

        apply := (self, nt, C, cnt) >> let(
            N := nt.params[1],
            k := nt.params[2],
            Ncirc := Rows(C[1]),
            diag := fPrecompute(self.diag(N,k)),
	    pad  := spiral.paradigms.common.TRDiag(Ncirc, N, diag).withTags(nt.getTags()),

	    #Diag(diag) * Gath(fCompose(fAdd(Ncirc, N, 0))).toloop(1) *
	    pad.transpose() *
	    Inplace(Grp(C[1] * Diag(fPrecompute(fDFT(self.circ(N, k, Ncirc)))))) *
	    Inplace(C[2]) *
	    pad
	    #Scat(fAdd(Ncirc, N, 0)).toloop(1) * Diag(diag) ##, O(Ncirc-N, N))
	)
    ),

    #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_GoodThomas := rec(
        info             := "DFT_n*k -> perm * (DFT_n_a tensor DFT_k_b) * perm",
        forTransposition := false,
        applicable     := (self, nt) >> let(N := nt.params[1],
	    N > 2 and DivisorPairsRP(N) <> [] and N <= self.maxSize and
	    not nt.hasTags()),

        maxSize := 64,

        children := nt -> let(mn := nt.params[1], k:= nt.params[2], Map2(DivisorPairsRP(mn),
            (m,n) -> [ DFT(m, k*n mod m), DFT(n, k*m mod n) ])),

        apply := (nt, C, cnt) -> let(
            r  := Rows(C[1]),
            s  := Rows(C[2]),
            alpha := 1 / s mod r,
            beta  := 1 / r mod s,
            CRT(r,s,1,1).transpose() * Tensor(C[1], C[2]) * CRT(r,s,1,1)
        )
    ),

    #F DFT_PFA_SUMS : Prime Factor FFT using Sigma-SPL and cyclic shifts
    #F
    #F     DFT_n*k -> perm * (DFT_n_a tensor DFT_k_b) * perm
    #F     when gcd(n,k) = 1
    #F
    DFT_PFA_SUMS := CopyFields(~.DFT_GoodThomas, rec(
        apply := (nt, C, cnt) -> let(
	    r := Rows(C[1]), s := Rows(C[2]),
	    j := Ind(s), k := Ind(r),
	    alpha := (1/s) mod r, beta := (1/r) mod s,
	    ISum(j,
                Scat(fTensor(fId(r), fBase(j))) *
                (C[1] ^ Z(r, -alpha*j)) *
                Gath(fTensor(fId(r), fBase(j)))) *
	    ISum(k,
                Scat(fTensor(fId(s), fBase(k))) *
                (C[2] ^ Z(s, -beta*k)) *
                Gath(fTensor(fId(s), fBase(k))))
	)
    )),

    DFT_PFA_RaderComb := rec(
        forTransposition := false,
        applicable := nt -> let(N := nt.params[1], divs := DivisorPairsRP(N),
            N > 2 and Length(divs)=2 and N mod 2 = 1 and
            IsPrime(divs[1][1]) and IsPrime(divs[1][2])
	    and not nt.hasTags()),

        children := nt -> let(
	    N:=nt.params[1], k:=nt.params[2], divs := DivisorPairsRP(nt.params[1]),
             r := divs[1][1], s := divs[1][2],
                 [ [DFT(r-1,-1), DFT(r-1,-1), DFT(s-1,-1), DFT(s-1,-1)],
		   [DFT(s-1,-1), DFT(s-1,-1), DFT(r-1,-1), DFT(r-1,-1)] ]),

        apply := (nt, C, cnt) -> let(
            r := Rows(C[1])+1,
            s := Rows(C[3])+1,
            er := ChineseRem([r,s], [1,0]),
            es := ChineseRem([r,s], [0,1]),
            dr := DFT_Rader.raderMid(r, nt.params[2]*s), # * er/s mod r),
            ds := DFT_Rader.raderMid(s, nt.params[2]*r), # * es/r mod s),

            CRT(r,s,1,1).transpose() *
            Tensor(RR(r).transpose(), RR(s).transpose()) *
            Tensor(
                DirectSum(I(1), C[1]) * dr * DirectSum(I(1), C[2]),
                DirectSum(I(1), C[3]) * ds * DirectSum(I(1), C[4])
            ) *
            Tensor(RR(r), RR(s)) *
            CRT(r,s,1,1)
        )
    ),

    #F DFT_SplitRadix: 1984
    #F
    #F DFT_n = B * (DFT_n/2 dirsum DFT_n/4 dirsum DFT_n/4) * perm
    #F
    #F B = (DFT_2 tensor I_n/2) * S * diag
    #F S = (I_n/2 dirsum (diag([1,E(4)] tensor I_n/4))
    #F
    #F Duhamel, Pierre:
    #F   Split Radix FFT Algorithm, Electronics Letters, Vol. 20, No. 1,
    #F   pp. 14--16, 1984
    #F
    DFT_SplitRadix := rec(
        info             := "DFT_n -> DFT_n/2, DFT_n/4, DFT_n/4",
        forTransposition := true,
        maxSize := 64,

        applicable := (self, nt) >> let(N := nt.params[1],
            N >= 8 and N mod 4 = 0 and N <= self.maxSize and not nt.hasTags()
        ),

        children := nt -> let(N := nt.params[1], w := nt.params[2],
            [[ DFT(N/2, w), DFT(N/4, w) ]]
        ),

        apply := (nt, C, cnt) -> let(N := nt.params[1], w := nt.params[2],
            Tensor(F(2), I(N/2)) *
            DirectSum(
                C[1],
                Tensor(Diag([1, E(4)^w]) * F(2), I(N/4)) *
                Diag(fPrecompute(fCompose(Tw3(N/2, 2, w), L(N/2, 2)))) *
                Tensor(I(2), C[2])*L(N/2,2)
            ) *
            L(N, 2)
        )
    ),

    #F DFT_DCT1andDST1: 1984
    #F
    #F   DFT_n = blocks * (DCT1_(n/2+1) dirsum DST1_(n/2-1)) * blocks
    #F
    #F   Wang:
    #F     Fast Algorithms for the Discrete W Transform and the
    #F     Discrete Fourier Transform.
    #F     IEEE Trans. on ASSP, 1984, pp. 803--814
    #F   Britanak/Rao:
    #F     The fast generalized discrete Fourier transforms: A unified
    #F     approach to the discrete sinusoidal transforms computation.
    #F     Signal Processing 79, 1999, pp. 135--150
    #F
    DFT_DCT1andDST1 := rec(
        info    := "DFT_n -> DCT1_(n/2+1), DST1_(n/2-1)",
        maxSize := 64,

        applicable := (self, nt) >> let(N:=nt.params[1], k:=nt.params[2],
            N > 2 and N <= self.maxSize and Is2Power(N) and AbsInt(k)=1) and not nt.hasTags(),

        children := nt ->
	    [[ DCT1( nt.params[1]/2 + 1 ), DST1( nt.params[1]/2 - 1 ) ]],

        apply := (nt, C, cnt) -> let(N:=nt.params[1], w:=nt.params[2],
            DirectSum(I(1), blocks4(N - 1, w)) *
            DirectSum(C[1], C[2] ^ J(N/2 - 1)) *
            DirectSum(I(1), blocks1(N - 1))
        )
    )
));


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

#F ==========================================================================
#F VBlk(<M>, <v>)
#F
#F Matrix of <v> element diagonals -- each matrix entry is represented as a
#F list vector elements, or as vector values, e.g., TVect(t, v).value(..)
#F
Class(VBlk, SumsBase, Mat, rec(
    #-----------------------------------------------------------------------
    new := (self, M, v) >> SPL(WithBases(self, rec(
        element := M,
	v       := v,
        TType   := Cond( # NOTE: add checks to M
	    IsList(M),     TVect(UnifyTypes(List(Concatenation(M), InferType)).t, v),
	    IsSymbolic(M), M.t.t.t),
    ))).setDims(),
    #-----------------------------------------------------------------------
    dims := self >> Dimensions(self.element) * self.v,
    #-----------------------------------------------------------------------
    rChildren := self >> [self.element, self.v],
    rSetChild := rSetChildFields("element", "v"),
    #-----------------------------------------------------------------------
    toAMat   := self >> BlockMat(MapMat(self.element,
        x -> Diag(FList(self.TType.t, _unwrap(When(IsList(x), x, x.ev())))))).toAMat(),
    #-----------------------------------------------------------------------
    velement := self >> Cond(
	IsList(self.element), let(
	    d := Dimensions(self.element),
	    t := self.TType,
	    TArray(TArray(t, d[2]), d[1]).value(
		MapMat(self.element, x -> self.TType.value(x)))),
	IsSymbolic(self.element), self.element),
    #-----------------------------------------------------------------------
    transpose := self >> Cond(self.isSymmetric(), self,
        CopyFields(self, rec(element := TransposedMat(self.element),
                             dimensions := Reversed(self.dimensions)))),
    conjTranspose := self >> self.transpose(), # NOTE: implement this properly
    #-----------------------------------------------------------------------
    isSymmetric := False,
    setSymmetric := self >> Inherit(self, rec(isSymmetric := True)),
    #-----------------------------------------------------------------------
    isReal := self >> Cond(
	IsList(self.element),  ForAll(self.element, r -> ForAll(r, IsRealNumber)),
	not IsComplexT(self.element.t.t.t)),
));

#F ==========================================================================
#F RCVBlk(<M>, <v>)
#F
#F Matrix of complex diagonals --
#F     each matrix entry is represented as a list of v/2 complex numbers
#F
#F <v> here represents the *real* vector length
#F (YSV: it used to be complex vector length in older versions)
#F
Class(RCVBlk, VBlk, rec(
    #-----------------------------------------------------------------------
    toAMat := self >> BlockMat(MapMat(self.element,
        x -> RCDiag(RCData(FList(TComplex, x))))).toAMat(),
    #-----------------------------------------------------------------------
    velement := self >> Cond(
        IsList(self.element),
            apack.fromMat(self.element, cel -> ApplyFunc(vpack,
                ConcatList( Flat([cel]), e -> [re(e), im(e)] ))),
        IsSymbolic(self.element),
            self.element),
    #-----------------------------------------------------------------------
    isReal := self >> true,
    #-----------------------------------------------------------------------
    # transposition will conjugate complex numbers, similarly to RCDiag
    transpose := self >> ObjId(self)(
	MapMat(TransposedMat(self.element), x -> List(x, conj)), self.v),
    #-----------------------------------------------------------------------
    conjTranspose := self >> ObjId(self)(TransposedMat(self.element), self.v)
));

#F ==========================================================================
#F VReplicate(<v>) - 1 -> v vector,  each component is splatted.
#F
#F Takes 1 vector and produces <v> vectors, by vdup'ping (splatting) each component
#F
Class(VReplicate, BaseContainer, rec(
    #-----------------------------------------------------------------------
    new := (self, v) >> SPL(WithBases(self, rec(_children := [], v := v))).setDims(),
    #-----------------------------------------------------------------------
    dims := self >> [self.v^2, self.v],
    #-----------------------------------------------------------------------
    toAMat := self >> Tensor(
        I(self.v),
        Mat(TransposedMat([Replicate(self.v, 1)]))).toAMat(),
    #-----------------------------------------------------------------------
    print := (self,i,is) >> Print(self.name, "(", self.v, ")"),
    #-----------------------------------------------------------------------
    sums  := self >> self,
    #-----------------------------------------------------------------------
    isPermutation := False,
    #-----------------------------------------------------------------------
    rChildren := self >> [],
    rSetChild := (self, n, what) >> Error("no children"),
    #-----------------------------------------------------------------------
    transpose     := self >> InertTranspose(self),
    conjTranspose := self >> InertConjTranspose(self)
));

#F ==========================================================================
#F VHAdd(<v>) - takes a <v> vectors and produces 1 vector
#F                         - each vector is added horizontally
#F
Class(VHAdd, BaseContainer, rec(
    #-----------------------------------------------------------------------
    new := (self, v) >> SPL(WithBases(self, rec(v := v))).setDims(),
    #-----------------------------------------------------------------------
    dims := self >> [self.v, self.v^2],
    #-----------------------------------------------------------------------
    toAMat := self >> Tensor(
        I(self.v),
        Mat([Replicate(self.v,1)])).toAMat(),
    #-----------------------------------------------------------------------
    print := (self,i,is) >> Print(self.name, "(", self.v, ")"),
    #-----------------------------------------------------------------------
    sums := self >> self,
    #-----------------------------------------------------------------------
    isPermutation := False,
    #-----------------------------------------------------------------------
    rChildren := self >> [],
    _children := self >> [],
    #-----------------------------------------------------------------------
    transpose     := self >> Error("Not implemented"),
    conjTranspose := self >> Error("Not implemented"),
));


Logical := function(a, b)
    return [ a or b, a and b, not a ];
end;

Logical(true, true);
# [ true, true, false ]

Logical(true, false);
# [ true, false, false ]

Logical(false, true);
# [ true, false, true ]

Logical(false, false);
# [ false, false, true ]


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

#P SPL Parametrized Symbols
#P ========================
#P
#P This package contains parametrized symbols - shortcut notation for common
#P idiomatic constructs.
#P

#F -----------------------------------------------------------------------------
#F I(N) : NxN identity matrix
#F -----------------------------------------------------------------------------
Class(I, Sym, rec(
    abbrevs := [ (x,y) -> Checked(x=y, IsPosInt0Sym(x), x),
                 (n)   -> Checked(IsPosInt0Sym(n), n) ],
    def := n -> Perm((), n),
    transpose := self >> self,
    conjTranspose := self >> self,
    inverse := self >> self,
    isIdentity := True,
    isSymmetric := True,
    doNotMeasure := true,
    printlatex := self >> Print(" \\one_{",self.params[1],"} "),
    area := self >> self.params[1],
    normalizedArithCost := self >> 0,
));

#F -----------------------------------------------------------------------------
#F O(M,N) : MxN matrix of zeros
#F -----------------------------------------------------------------------------
Class(O, BaseMat, rec(
    abbrevs := [ n -> Checked(IsPosInt(n), [n,n]) ],

    new := (self, r, c) >> SPL(WithBases(self, rec(
        params := [r, c], dimensions := [r, c]))),

    isReal := True,
    isPermutation := False,
    arithmeticCost := (self, costMul, costAddMul) >> costMul(0) - costMul(0),

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

    area := self >> Maximum(self.dimensions),

    toAMat := self >> AMatMat(NullMat(
	EvalScalar(self.params[1]), EvalScalar(self.params[2]))),

    print := Sym.print,
    dims  := self >> [ self.params[1], self.params[2] ],
    rChildren := Sym.rChildren,
    rSetChild := Sym.rSetChild
));

#F -----------------------------------------------------------------------------
#F RI(M,N) : MxN rectangular identity
#F           MIN(M,N) x MIN(M,N) identity padded with 0s
#F -----------------------------------------------------------------------------
Class(RI, Sym, rec(
    def := (r, c) -> Checked(IsPosInt(r), IsPosInt(c),
    Cond(r = c, I(r),
         r < c, Gath(fAdd(c,r,0)),
                Scat(fAdd(r,c,0)))),

    transpose := self >> ApplyFunc(self.__bases__[1], Reversed(self.params)),
    conjTranspose := self >> ApplyFunc(self.__bases__[1], Reversed(self.params)),
));

#F -----------------------------------------------------------------------------
#F F(N) - NxN Discrete Fourier Transform matrix
#F -----------------------------------------------------------------------------
Class(F, Sym, rec(
    def := size -> Checked(IsPosInt(size),
    Cond(size = 1, Mat([[1]]),
         size = 2, Mat([[1,1], [1,-1]]),
         Mat(Global.DFT(size)))),

    isReal    := self >> self.params[1] <= 2,
    isPermutation := False,
    transpose := self >> self,
    conjTranspose := self >> self,
    inverse := self >> let(n:=self.params[1], Cond(n=1, self, n=2, 1/2*F(2), Error("Inverse not supported"))),
    toAMat    := self >> DFTAMat(self.params[1]),
    printlatex := (self) >> Print(" F_{", self.params[1], "} ")
));

#F -----------------------------------------------------------------------------
#F R(a)     : 2x2 rotation matrix with angle a*pi, namely
#F
#F    cos(a) sin(a)
#F   -sin(a) cos(a)
#F
#F alternatively:
#F
#F R(c,s)   : specified by a pair such as c^2 + s^2 = 1
#F     <c>  <s>
#F    -<s>  <c>
#F
#F -----------------------------------------------------------------------------
Class(Rot, Sym, rec(
    abbrevs := [ (a) -> [cospi(a), sinpi(a)] ],

    def := (a,b) ->
    Mat( [[a, b], [-b, a]] ),

    transpose := self >>
        self.__bases__[1](self.params[1], -self.params[2]),

    conjTranspose := self >> self.transpose(),
    inverse := self >> self.transpose(),

    toAMat := self >> let(a := self.params[1], b := self.params[2],
        When(IsScalar(a) and IsScalar(b) and ScalarIsCos(a) and ScalarIsSin(b),
         RotationAMat(EvalScalar(ScalarCosArg(a))),
         AMatMat([[EvalScalar(a),  EvalScalar(b)],
              [EvalScalar(-b), EvalScalar(a)]]))),

    #-----------------------------------------------------------------------
    # Expansions
    expandLifting := self >>
        let(c := self.params[1],
            s := self.params[2],
            ev := (not IsScalar(c) or CanBeFullyEvaluated(c.val)) and
                  (not IsScalar(s) or CanBeFullyEvaluated(s.val)),
            Cond(ev and c = s,  c * F(2) * Perm((1,2), 2),
                 ev and c = -s, c * Perm((1,2), 2) * F(2),
                 Mat([[1,1,0], [0,-1,1]]) *
                 Diag([c-s, s, c+s]) *
                 Mat([[1,0], [1,1], [0,1]]))),

    expandWinograd:= self >>
        let(c := self.params[1],
            s := self.params[2],
            ev := (not IsScalar(c) or CanBeFullyEvaluated(c.val)) and
                  (not IsScalar(s) or CanBeFullyEvaluated(s.val)),
            Cond(ev and c = s,  c * F(2) * Perm((1,2), 2),
                 ev and c = -s, c * Perm((1,2), 2) * F(2),
                 Mat([[1, (1-c)/s], [0, 1]]) *
                 Mat([[1, 0], [-s, 1]]) *
                 Mat([[1, (1-c)/s], [0, 1]]))),

    expandDef := self >> self.obj,
));

Declare(toeplitz);

#F -----------------------------------------------------------------------------
#F toeplitz(elements) : toeplitz matrix given by elements of the first row and
#F                      column, starting from the upper right corner
#F -----------------------------------------------------------------------------
#F NOTE: use generating function not list (see 'Toeplitz')
Class(toeplitz, Sym, rec(
    abbrevs := [ arg -> When(Length(arg) > 1 or not IsList(arg[1]), [arg], arg) ],

    def := function(elements)
        local n;
        Constraint(IsList(elements) and Length(elements) > 0);
        Constraint(IsOddInt(Length(elements)));
        DoForAll(elements, x->Constraint(IsScalarOrNum(x)));
        n := (Length(elements) + 1) / 2;
        return Mat(ToeplitzMat(elements));
    end,

    transpose := self >> toeplitz(Reversed(self.params[1])),
    conjTranspose := self >> toeplitz(List(Reversed(self.params[1]), x->Global.Conjugate(x))),
    isReal := True,
    isPermutation := False,
    area := self >> Product(self.dimensions)
));


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

#F qZT( n ) - Z Gate non-terminal
#F Definition: (2^n x 2^n)-matrix  that applies an n-point Z Transform to the target qubits
#F Note:       qZT(1) denotes the matrix[[1, 0], [0, -1]],
#F             qZT(_) is symmetric.
#F
#F qZT( n ) -> an n-qubit Z transform
Class(qZT, TaggedNonTerminal, rec(
  abbrevs   := [ n -> Checked(IsPosInt(n), [n]) ],
  dims      := self >> let(size := 2^self.params[1], [size, size]),
  terminate := self >> Tensor(Replicate(self.params[1], qZ())),
  isReal    := self >> true,
  groups    := self >> [Replicate(self.params[1], 1)],
  rChildren := self >> self.params,
  from_rChildren := (self, rch) >> self.__bases__[1](rch[1]),
  recursive_def := (self, arch) >> self.__bases__[1](self.params[1]),
  SmallRandom := () -> Random([2..5]),
  LargeRandom := () -> Random([6..15]),
  normalizedArithCost := self >> Error("ArithCost not implemented"),
  TType := T_Complex(64)
));

NewRulesFor(qZT, rec(

    # qZT_BinSplit rule
    # qzT_BinSplit qZT_(k) -> (qZT_(k1) tensor I) (I tensor qZT_(k2))
    # k1 + k2 = k
    qZT_BinSplit := rec (
        forTransposition := false,
        minSize          := 2,
        applicable       := (self, nt) >> nt.params[1] > 1,
        children         := nt -> List( [1..nt.params[1] - 1],  i -> [ Tensor(qZT(i), qZT(nt.params[1]-i)).withTags(nt.getTags()) ]  ),
        apply            := (nt, c, cnt) -> c[1],
        switch := true,
    ),

    #F qZT_Base: qZT(1) = qZ() SPL object
    #F Directly represent as an implementable gate
    qZT_Base := rec(
        info             := "qZT_(1) -> qZ()",
        forTransposition := false,
        applicable       := (self, nt) >> nt.params[1]=1,
        apply            := (nt, c, cnt) -> qZ(),
    )

));


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

# ==========================================================================
# RowTensor
# ==========================================================================
Class(RowTensor, BaseOverlap, rec(
    #-----------------------------------------------------------------------
    dims := self >> let(D := self._children[1].dimensions,
        [ self.isize * D[1],
	  D[2] + AbsInt((D[2] - self.overlap) * (self.isize - 1)) ]),
    #-----------------------------------------------------------------------
    toAMat := self >> let(n := EvalScalar(self.isize),
        TensorProductAMat(AMatSPL(I(n)), AMatSPL(self._children[1])) *
	AMatSPL(Sparse(
		self._rowoverlap(
		    List([1..n], i-> EvalScalar(Cols(self._children[1]))),
		    EvalScalar(self.overlap)
		)))
    ),
    #-----------------------------------------------------------------------
    arithmeticCost := (self, costMul, costAddMul) >>
        self.isize * self._children[1].arithmeticCost(costMul, costAddMul)
));

# ==========================================================================
# ColTensor
# ==========================================================================
Class(ColTensor, BaseOverlap, rec(
    #-----------------------------------------------------------------------
    dims := self >> let(D := self._children[1].dimensions,
        [ D[1] + AbsInt((D[1] - self.overlap) * (self.isize - 1)),
	  self.isize * D[2] ]),
    #-----------------------------------------------------------------------
    toAMat := self >> let(n := _unwrap(self.isize),
        AMatSPL(Sparse(
		self._coloverlap(
		    List([1..n], i->self._children[1].dimensions[1]),
		    self.overlap
		))) *
	TensorProductAMat(AMatSPL(I(n)), AMatSPL(self._children[1]))
    )
));

ColTensor._transpose_class := RowTensor;
RowTensor._transpose_class := ColTensor;


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

RulesFor(DFT, rec(
    #F DFT_DFT1and3 : DFT1_2n -> L (DFT1_n dirsum DFT3_n) L (I2 tensor F2) L
    #F Derived using polynomial factorization:
    #F    x^2n -> (x^n-1) (x^n+1)
    #F
    DFT_DFT1and3 := rec(
        isApplicable := P -> P[1] > 2 and P[1] mod 2 = 0,
        allChildren := P -> [[ DFT1(P[1]/2, P[2]), DFT3(P[1]/2, P[2]) ]],
        rule := (P,C) -> let(n := P[1]/2,
            L(2*n, n) * DirectSum(C[1], C[2]) * L(2*n, 2) *
            Tensor(I(n), F(2)) *
            L(2*n, n))
    )
));

lperm := p -> Z(p, (p-1)/2);
rperm := p -> Z(p, (p+1)/2);
pdiag := (p,k) -> When(IsEvenInt(k),
    I(p),
    Diag(List([0..p-1], i -> (-1)^i)));

RulesFor(DFT2, rec(
    DFT2_CT := Inherit(DFT_CT, rec(
	switch := false,
	allChildren  := P -> Map2(DivisorPairs(P[1]),
	    (m,n) -> [ DFT2(m, P[2]), DFT(n, P[2]) ]),

	rule := (P,C) -> let(mn := P[1], m := Rows(C[1]), n := Rows(C[2]),
	    Tensor(C[1], I(n)) * Diag(fPrecompute(Tw2(mn, n, P[2]))) *
	    Tensor(I(m), C[2]) * L(mn, m))
    )),
));

NewRulesFor(DFT2, rec(
    DFT2_PF := rec(
    	info         := "DFT2_n*k -> diag * perm * (DFT2_n_a tensor DFT2_k_b) * perm",
    	forTransposition := true,
    	applicable     := nt -> nt.params[1] > 2 and DivisorPairsRP(nt.params[1]) <> [] and not nt.hasTags(),
    	allChildren := nt -> let(N := nt.params[1], k:= nt.params[2], Map2(DivisorPairsRP(N),
    		(r,s) -> [ DFT2(r, 1/s mod r), DFT2(s, 1/r mod s) ])),

        apply := (nt, C, cnt) -> let(
    	    N := nt.params[1],
    	    r := Rows(C[1]),
    	    s := Rows(C[2]),
    	    alpha := 1 / s mod r,
    	    beta  := 1 / r mod s,
    	    i := Ind(r*s),

    	    CRT(r,s).transpose() *
    	    Diag(Lambda(i, -sign(imod(s*alpha*idiv(i,s) + r*beta*imod(i,s), 2*N) - N))) *
    	    Tensor(C[1], C[2]) * CRT(r,s)
    	)
#D    	isApplicable     := P -> P[1] > 2 and DivisorPairsRP(P[1]) <> [] and Length(P[3]) = 0,
#D    	allChildren := P -> let(N := P[1], k:= P[2], Map2(DivisorPairsRP(N),
#D    		(r,s) -> [ DFT2(r, 1/s mod r), DFT2(s, 1/r mod s) ])),
#D
#D    	rule := (P,C) -> let(
#D    	    N := P[1],
#D    	    r := Rows(C[1]),
#D    	    s := Rows(C[2]),
#D    	    alpha := 1 / s mod r,
#D    	    beta  := 1 / r mod s,
#D    	    i := Ind(r*s),
#D
#D    	    CRT(r,s).transpose() *
#D    	    Diag(Lambda(i, -sign(imod(s*alpha*idiv(i,s) + r*beta*imod(i,s), 2*N) - N))) *
#D    	    Tensor(C[1], C[2]) * CRT(r,s)
#D    	)
    )
));

RulesFor(DFT3, rec(
    DFT3_Base := BaseRule(DFT3, [2, ...]),

    DFT3_CT := Inherit(DFT_CT, rec(
	switch := false,
	allChildren  := P -> Map2(DivisorPairs(P[1]),
	    (m,n) -> [ DFT(m, P[2]), DFT3(n, P[2]) ]),

	rule := (P,C) -> let(mn := P[1], m := Rows(C[1]), n := Rows(C[2]),
	    Tensor(C[1], I(n)) * Diag(fPrecompute(Tw3(mn, n, P[2]))) *
	    Tensor(I(m), C[2]) * L(mn, m))
    )),

    DFT3_CT_Radix2 := rec(
	isApplicable := P -> P[1] > 2 and (P[1] mod 2) = 0,
	allChildren  := P -> [[ DFT(P[1]/2, P[2]) ]],
	rule := (P,C) -> let(n := P[1]/2,
	    Tensor(C[1], I(2)) * Diag(fPrecompute(Tw3(2*n, 2, P[2]))) *
	    Tensor(I(n), F(2)*Diag(1,E(4)^P[2])) * L(2*n, n))
    ),

    DFT3_OddToDFT1 := rec(
	isApplicable := P -> IsOddInt(P[1]),
	allChildren := P -> [[ DFT(P[1], P[2]) ]],
	rule := (P, C) -> rperm(P[1]) * C[1] * pdiag(P[1], P[2])
    ),

    DFT3_2xOddToDFT1 := rec(
	isApplicable := P -> P[1] mod 4 = 2 and P[1] > 2,
	allChildren := P -> [[ DFT(P[1], P[2]) ]],
	rule := (P, C) -> let(n:=P[1], k:=P[2],
	    Z(n,-(n-2)/4) * C[1] * Diag(List([0..n-1], x->E(4)^(k*x))))
    )

));

RulesFor(DFT4, rec(
    DFT4_Base := rec(
	isApplicable := P -> P[1]=2,
	forTransposition := false,
	rule := (P,C) -> E(8)*Mat((1/E(8))*MatSPL(ApplyFunc(DFT4, P)))
    ),

    DFT4_CT := Inherit(DFT_CT, rec(
	allChildren  := P -> Map2(DivisorPairs(P[1]),
	    (m,n) -> [ DFT2(m, P[2]), DFT3(n, P[2]) ]),

	rule := (P,C) -> let(mn := P[1], m := Rows(C[1]), n := Rows(C[2]),
	    Tensor(C[1], I(n)) * Diag(fPrecompute(Tw4(mn, n, P[2]))) *
	    Tensor(I(m), C[2]) * L(mn, m))
    )),
));

NewRulesFor(DFT4, rec(
    DFT4_PF := rec(
    	info         := "DFT4_n*k -> diag * perm * (DFT4_n_a tensor DFT4_k_b) * perm",
    	forTransposition := true,
    	applicable     := nt -> nt.params[1] > 2 and DivisorPairsRP(nt.params[1]) <> [] and not nt.hasTags(),
        children := nt -> let(N := nt.params[1], k:= nt.params[2], Map2(DivisorPairsRP(N),
    		(r,s) -> [ DFT4(r, 1/s mod r), DFT4(s, 1/r mod s) ])),

        apply := (nt, C, cnt) -> let(
    	    N := nt.params[1],
    	    r := Rows(C[1]),
    	    s := Rows(C[2]),
    	    alpha := 1 / s mod r,
    	    beta  := 1 / r mod s,
    	    i := Ind(r*s),
    	    d := Diag(Lambda(i, -sign(imod(s*alpha*idiv(i,s) + r*beta*imod(i,s), 2*N) - N))),
    	    CRT(r,s).transpose() *
    	    d * (-E(4))*
    	    Tensor(C[1], C[2]) *
    	    d *
    	    CRT(r,s)
    	)
#D    	isApplicable     := P -> P[1] > 2 and DivisorPairsRP(P[1]) <> [] and Length(P[3]) = 0,
#D    	allChildren := P -> let(N := P[1], k:= P[2], Map2(DivisorPairsRP(N),
#D    		(r,s) -> [ DFT4(r, 1/s mod r), DFT4(s, 1/r mod s) ])),
#D
#D    	rule := (P,C) -> let(
#D    	    N := P[1],
#D    	    r := Rows(C[1]),
#D    	    s := Rows(C[2]),
#D    	    alpha := 1 / s mod r,
#D    	    beta  := 1 / r mod s,
#D    	    i := Ind(r*s),
#D    	    d := Diag(Lambda(i, -sign(imod(s*alpha*idiv(i,s) + r*beta*imod(i,s), 2*N) - N))),
#D    	    CRT(r,s).transpose() *
#D    	    d * (-E(4))*
#D    	    Tensor(C[1], C[2]) *
#D    	    d *
#D    	    CRT(r,s)
#D    	)
    )
));


bogosort := function( list )

  while not IsSortedList( list ) do

    Shuffle( list );

  od;

  return list;

end;


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

# Here I define the new layer of "index-free" Sigma-SPL.  I will use
# this for library generation. The goal of index-free formulas is to
# eliminate loop indices completely. In such formulas objects may
# still depend on the loop indices, because gather/scatter/diagonal
# functions become multivariate (vs. univariate) functions, taking
# loop indices + point index as arguments.
#
# See "Generalized Problem Spec" write-up.
#

Class(GTIndexFunction, FuncClass, rec(
    isGTIndexFunction := true,

    # .upRank (=lift in spl.maude) is is the inverse of reduction .downRank,
    # it adds implicit dependency on the (new) inner loop, this happens when, eg.
    # gather is pulled into a loop:  Gath(f) ISum(s) => ISum(Gath(f.upRank()) * s)
    upRank := self >> Error("Not implemented"),

    upRankBy := (self, n) >> Checked(IsPosInt0(n),
        FoldL([1..n], (f, i) -> f.upRank(), self)),

    # .downRank (=red in spl.maude) is the "reduction" operator for
    # index mapping functions it eliminates implicit deendencies on loops
    # by introducing explicit references to loop variables ind(..)
    #
    # Eliminates dependency on loop <loopid>, 1 denotes innermost loop
    # <ind> is a loop index
    downRank := (self, loopid, ind) >> Error("Not implemented"),

    # returns the rank, i.e., the number of implicit nested loops
    rank := self >> Error("Not implemented"),

    # eliminated all loop dependencies
    downRankFull := (self, inds) >>
        FoldL(Reversed([1..Length(inds)]), (f, i) -> f.downRank(i, inds[i]), self),

    # split a loop, increase rank by 1,
    # if a loop had n iterations, the new outer loop will have <outer_its> iterations,
    # and next inner <inner_its> iterations
    split := (self, loopid, inner_its, outer_its) >> Error("not implemented"),

    # rotate the ranks (see Doc(frotate) for explanation)
    rotate := (self, n) >> Error("not implemented"),

    isUnitStride := self >> false,
    vecStride := (self, rank) >> self.params[4][rank+1],

));

Class(GTOps, rec(
    Print := PrintOps.Print,
    \= := (a,b) -> When(IsBound(a.equals), a.equals(b), b=a)
));

IsGTIndexFunction := o -> IsRec(o) and IsBound(o.isGTIndexFunction) and o.isGTIndexFunction;

# slow implementation, Haskell would love this
_dropTail := (lst, arg) -> Cond(Length(lst)=0,lst,Cond(Last(lst)=arg, _dropTail(DropLast(lst, 1),arg), lst));

Class(HHBase, GTIndexFunction, rec(
    abbrevs := [ (N,n,b,strides) -> [toExpArg(N), toExpArg(n), toExpArg(b),
                                     List(_dropTail(strides, 0), toExpArg)] ],
    def := (N, n, b, strides) -> Checked(IsList(strides), ForAll(strides, IsPosInt0Sym),
	rec(N := N, n := n)),

    nloops := self >> Length(self.params[4]),
    free := self >> FreeVars(self.params),

    toSpl := (self, inds, kernel_size) >> self.downRankFull(inds),
    rank := self >> Maximum(0, Length(self.params[4])-1),  # rank = number of implicit loop dependencies

    domain := self >> When(IsValue(self.params[2]), self.params[2].v, self.params[2]),
    range := self >> When(IsValue(self.params[1]), self.params[1].v, self.params[1]),

    base := self >> self.params[3],
    strides := self >> Cond(self.params[4] = [], [0], self.params[4]),

    # rotate(<n>)
    #   switch the order of loops (represented by ranks), by making <n>-th loop innermost
    rotate := meth(self, n)
       local params, strides, rank;
       rank := self.rank();
       if rank<=1 and n<=1 then return self;
       elif n > rank then return self.upRank();
       fi;

       params := ShallowCopy(self.params);
       strides := ShallowCopy(params[4]);
       strides := [strides[1], strides[n+1]] :: strides{[2..n]} :: strides{[n+2 .. rank+1]};
       params[4] := strides;
       return self.from_rChildren(params);
    end,

    isUnitStride := self >> false, # redefine if unit stride is possible
));

Declare(KH, BHH, HH, HHZ);

#F HH(<N>, <n>, <b>, <strides>) - generalized stride index mapping function
#F   N - range
#F   n - domain
#F
#F   HH represents a multivariate function (j1 .. jn are indices of enclosing loops)
#F       (i, j1, ..., jn) -> b + strides[1]*i + strides[2]*j1 + ... + strides[n+1]*jn
#F
#F   Observe that dependence on the loop indices exists, even though no explicit
#F   loop index is present. This is how index free representation works.
#F
Class(HH, HHBase, rec(
    upRank := self >> let(s:=self.strides(),
	HH(self.params[1], self.params[2], self.params[3], Concatenation([s[1], 0], Drop(s, 1)))),

    downRank := (self, loopid, ind) >> Cond(loopid > self.rank(), self, let(s:=self.strides(),
	HH(self.params[1], self.params[2], s[loopid+1] * ind + self.params[3], ListWithout(s, loopid+1)))),

    split := (self, loopid, inner_its, outer_its) >> Cond(loopid > self.rank(), self, let(
        strides := self.params[4],
        vs := self.params[4][1+loopid],
	HH(self.params[1],
           self.params[2],
           self.params[3],
           Concatenation(strides{[1..loopid+1]}, [inner_its * vs], strides{[loopid+2..Length(strides)]})))),

    lambda := self >> let(
        n := self.params[2],
        b := self.params[3],
        s := self.strides(),
        ind := List([1..Length(s)], i -> When(i=1, Ind(n), var.fresh_t("q", TInt))),
        Lambda(Reversed(ind), b + Sum([1..Length(s)], i -> s[i] * ind[i]))),

    isUnitStride := self >> self.strides()[1] = 1
));

Class(BHH, HHBase, rec(
    abbrevs := [ (N,n,b,strides,refl) -> [toExpArg(N), toExpArg(n), toExpArg(b), List(_dropTail(strides,0), toExpArg), toExpArg(refl)] ],
    def := (N, n, b, strides, refl) -> Checked(
        IsList(strides), ForAll(strides, IsPosInt0Sym), IsPosIntSym(refl),
	rec(N := N, n := n)),

    upRank := self >> let(s:=self.strides(),
	BHH(self.params[1], self.params[2], self.params[3], Concatenation([s[1], 0], Drop(s, 1)), self.params[5])),

    downRank := (self, loopid, ind) >> Cond(loopid > self.rank(), self, let(s:=self.strides(),
	BHH(self.params[1], self.params[2], self.params[3] + s[loopid+1] * ind,
           ListWithout(s, loopid+1), self.params[5]))),

    split := (self, loopid, inner_its, outer_its) >> Cond(loopid > self.rank(), self, let(
        strides := self.strides(),
        vs := self.params[4][1+loopid],
	BHH(self.params[1],
           self.params[2],
           self.params[3],
           Concatenation(strides{[1..loopid+1]}, [inner_its * vs], strides{[loopid+2..Length(strides)]}),
           self.params[5]))),

    lambda := self >> let(
        n := self.params[2],
        b := self.params[3],
        s := self.strides(),
        refl := self.params[5],
        inds := List([1..Length(s)], i -> When(i=1, Ind(n), var.fresh_t("q", TInt))),
        res := b + Sum([1..Length(s)], i -> s[i] * inds[i]),
        Lambda(Reversed(inds), cond(leq(inds[1], idiv(n-1,2)), res, refl-res))
    ),
));

#F KH(<N>, <n>, <b>, <strides>, <corr>) - generalized (I_m dirsum J_m dirsum I_m ...) L^mn_n thingy
#F   N - range
#F   n - domain
#F
#F   KH represents a multivariate function (j1 .. jn are indices of enclosing loops)
#F       (i, j1, ..., jn) -> b + strides[1]*i + strides[2]*j1 + ... + strides[n+1]*jn
#F
#F   Observe that dependence on the loop indices exists, even though no explicit
#F   loop index is present. This is how index free representation works.
#F
Class(KH, HHBase, rec(
    abbrevs := [ (N,n,b,strides,corr) -> [toExpArg(N), toExpArg(n), toExpArg(b), List(_dropTail(strides,0), toExpArg), List(corr, toExpArg)] ],
    def := (N, n, b, strides, corr) -> Checked(
        IsList(strides), ForAll(strides, IsPosInt0Sym),
        IsList(corr),    ForAll(corr, IsIntSym), Length(corr) = 2,
	rec(N := N, n := n)),

    upRank := self >> let(s:=self.strides(),
	KH(self.params[1], self.params[2], self.params[3],
           Concatenation([s[1], 0], Drop(s, 1)),
           self.params[5])),

    downRank := (self, loopid, ind) >> Checked(loopid=1, self.rank()=1, let(
        s:=self.strides(), corr:=self.params[5], b:=self.params[3],
	KH(self.params[1],
           self.params[2],
           b,
           [s[1]],
           [ s[2]*ind      + cond(neq(imod(ind,2),0), corr[2], corr[1]),
             s[1]-s[2]-ind + cond(neq(imod(ind,2),0), corr[1], corr[2]) ]))),

    lambda := self >> Checked(Length(self.strides())=1, let(
        n := self.params[2],
        b := self.params[3],
        s := self.strides()[1],
        i := Ind(n),
        corr_even := self.params[5][1], corr_odd := self.params[5][2],
        Lambda(i, b + s*i + imod(i+1, 2)*corr_even + imod(i, 2)*corr_odd)))
));

#F HHZ(<N>, <n>, <b>, <strides>) - generalized stride mod N index mapping (prime-factor FFT)
#F   N - range
#F   n - domain
#F
#F   HHZ represents a multivariate function (j1 .. jn are indices of enclosing loops)
#F       (i, j1, ..., jn) -> (b + strides[1]*i + strides[2]*j1 + ... + strides[n+1]*jn) mod N
#F
#F   Observe that dependence on the loop indices exists, even though no explicit
#F   loop index is present. This is same as in HH.
#F
Class(HHZ, HHBase, rec(
    split := (self, loopid, inner_its, outer_its) >> Cond(loopid > self.rank(), self, let(
        strides := self.params[4],
        vs := self.params[4][1+loopid],
	HHZ(self.params[1],
           self.params[2],
           self.params[3],
           Concatenation(strides{[1..loopid+1]}, [inner_its * vs], strides{[loopid+2..Length(strides)]})))),

    upRank := self >> let(s:=self.strides(),
	HHZ(self.params[1], self.params[2], self.params[3], Concatenation([s[1], 0], Drop(s, 1)))),

    downRank := (self, loopid, ind) >> Cond(loopid > self.rank(), self, let(s:=self.strides(),
	HHZ(self.params[1], self.params[2], self.params[3] + s[loopid+1]*ind, ListWithout(s, loopid+1)))),

    lambda := self >> let(hlambda := ApplyFunc(HH, self.params).lambda(),
        CopyFields(hlambda, rec(expr := imod(hlambda.expr, self.params[1]))))
));

Declare(UU);

##    UU(<N>,<n>,<base>,<stride>,<columns>,<leading_dim>,
##                                 < <vstride_cols, vstride_rows>, ... > )
##
##    index mapping:
##       (i, j1, ..., jn) ->
##          base + stride * (i / columns) + leading_dim * (i mod columns)
##               + vstride_cols[1]*j1 + ... + vstride_cols[n]*jn
##               + (vstride_rows[1]*j1 + ... + vstride_rows[n]*jn)* leading_dim
##
##    This is roughly the equivalent of an HH function for 2D inputs.

Class(UU, GTIndexFunction, rec(
    abbrevs := [ (N, n, bX, bY, s, c, ld, strides) -> [toExpArg(N), toExpArg(n), toExpArg(bX), toExpArg(bY),
                                            toExpArg(s), toExpArg(c), toExpArg(ld),
                                     List(_dropTail(strides,[0,0]), x->List(x,toExpArg))] ],
    def := (N, n, bX, bY, s, c, ld, strides) -> Checked(IsList(strides), ForAll(strides, x->
                                              IsList(x) and Length(x)=2 and ForAll(x,IsPosInt0Sym)),
                                                rec(N := N, n := n)),

    nloops := self >> Length(self.params[8]),
    free := self >> FreeVars(self.params),

    toSpl := (self, inds, kernel_size) >> self.downRankFull(inds),
    rank := self >> Length(self.params[8]),   # rank = number of implicit loop dependencies

    domain := self >> When(IsValue(self.params[2]), self.params[2].v, self.params[2]),
    range := self >> When(IsValue(self.params[1]), self.params[1].v, self.params[1]),

    upRank := self >> let(ss:=self.params[8],
	UU(self.params[1], self.params[2], self.params[3], self.params[4], self.params[5], self.params[6], self.params[7],
            Concatenation([[0,0]], ss))),

    downRank := (self, loopid, ind) >> Cond(loopid > self.rank(), self, let(ss:=self.params[8],
	UU(self.params[1], self.params[2], self.params[3] + ss[loopid][1] * ind, self.params[4] + ss[loopid][2] * ind * self.params[7],
            self.params[5], self.params[6], self.params[7], ListWithout(ss, loopid)))),

    split := (self, loopid, inner_its, outer_its) >> Cond(loopid > self.rank(), self, let(
        strides := self.params[8],
        vs := self.params[8][loopid],
        UU(self.params[1],
           self.params[2],
           self.params[3],
           self.params[4],
           self.params[5],
           self.params[6],
           self.params[7],
           Concatenation(strides{[1..loopid]}, [inner_its * vs], strides{[loopid+1..Length(strides)]})))),

    lambda := self >> let(
        n := self.params[2],
        bX := self.params[3],
        bY := self.params[4],
        s := self.params[5],
        c := self.params[6],
        ld := self.params[7],
        ss := self.params[8],
        ind := List([1..Length(ss)], i -> var.fresh_t("q", TInt)),
        index := Ind(n),
        Lambda(Concatenation(Reversed(ind),[index]), (bX  + imod(index,c) * s) + (bY+idiv(index,c) * ld) + Sum([1..Length(ss)], i -> ss[i][1] * ind[i]) + Sum([1..Length(ss)], i -> ss[i][2] * ind[i] * ld))),

    isUnitStride := self >> Error("isUnitStride is not supported for now with UU"),
));

Declare(XChain);

#F XChain( <permuted [1..n]> ) - fTensor chain of fBase's and single fId.
#F
#F   This represents a subset of functions captured by HH. Namely those
#F   functions that described tightly packed index space, i.e.,
#F   if f is an XChain in k-nested loop with dimensions in loop_dims, then
#F
#F   domain(f) * Product(loop_dims) = range(f)
#F
Class(XChain, GTIndexFunction, rec(
    def := perm -> Checked(IsList(perm), ForAll(perm, IsPosInt0),
	Set(Copy(perm))=[0..Length(perm)-1],
        rec()),

    range := self >> 0,
    domain := self >> 0,

    equals := (self, o) >> ObjId(self)=ObjId(o) and self.params[1]=o.params[1],

    printFull := self >> Print(self.name, "(", self.params[1], ")"),
    printShort := self >> Print("x(", PrintCS(self.params[1]), ")"),

    toSpl := (self, inds, kernel_size) >> let(fbases := List(inds, fBase),
	ApplyFunc(fTensor, List(self.params[1], i -> When(i=0, fId(kernel_size), fbases[i])))),

    toDiag := (self, loop_dims, kernel) >> let(fconst := List(loop_dims, d->fConst(d,1)),
	ApplyFunc(diagTensor, List(self.params[1], i -> When(i=0, kernel, fconst[i])))),

    without := (self, loopid) >> Checked(loopid >= 1, loopid <= Length(self.params[1])-1, let(
	lst := ListWithout(self.params[1], Position(self.params[1], loopid)),
	XChain(List(lst, x -> When(x < loopid, x, x-1))))),

    part := (self, loopid, ind, kernel_size, loop_dims) >>
        ApplyFunc(fTensor, List(self.params[1], i ->
	    Cond(i=0,      fId(kernel_size),
		 i=loopid, fBase(ind),
		 fId(loop_dims[i])))),

    composeWith := (self, f) >> When(ObjId(f)<>XChain, Error("Can only compose with another XChain"),
	let(fperm := f.params[1],
	    myperm := self.params[1],
	    pos := Position(myperm, 0),
	    XChain(Concatenation(1+myperm{[1..pos-1]}, fperm, 1+myperm{[pos+1..Length(myperm)]})))),
));

# NOTE: toSpl -> SubstTopDown( ind -> inds[i] )
# Normal functions retrofitted for GT
fId.toSpl  := (self, inds, ksize) >> self;
fId.without:= (self, loopid) >> self;
fId.part   := (self, loopid, loopvar, kernel_size, loop_dims) >> self;
#fId.toDiag := (self, loop_dims) >> fConst(TReal, self.params[1], 1);

fBase.toSpl  := (self, inds, ksize) >> Cond(
    ObjId(self.params[2])=ind, fBase(inds[self.params[2].n]),
    self);

fBase.without := (self, loopid) >> Cond(
    self.params[2]=ind(self.params[1], loopid), fBase(self.params[1], 0),
    self);

fBase.part := (self, loopid, loopvar, ksize, loop_dims) >> Cond(
    self.params[2]=ind(self.params[1], loopid), fAdd(self.params[1], self.params[1], loopvar),
    fId(self.params[1]));

fTensor.part := (self, loopid, loopvar, ksize, loop_dims) >>
     ApplyFunc(fTensor, List(self.children(), c -> c.part(loopid, loopvar, ksize, loop_dims)));

fTensor.without := (self, loopid) >>
     ApplyFunc(fTensor, List(self.children(), c -> c.without(loopid)));

fTensor.toSpl := (self, inds, ksize) >>
     ApplyFunc(ObjId(self), List(self.children(), c -> c.toSpl(inds, ksize)));

fCompose.toSpl := (self, inds, ksize) >>
     ApplyFunc(fCompose, List(self.children(), c -> c.toSpl(inds, ksize)));

FuncClass.toSpl := (self, inds, ksize) >> self;

#FuncClassOper.rank := self >> Maximum(List(self.children(), x->x.rank()));
#FuncClass.rank := self >> 0;
#DiagFunc.rank := self >> 0;

FuncClassOper.isUnitStride := self >> false;
FuncClass.isUnitStride     := self >> false;
fId.isUnitStride := self >> true;
fTensor.isUnitStride := self >> ForAll(self._children, x->x.isUnitStride());
#fBase.toDiag := (self, loop_dims) >> fConst(TReal, self.params[1], 1);
#fId.part   := (self, loopid, ind, kernel_size, loop_dims) >> self;

ListAddP := function(l1, l2, c)
    local i, lenl1, lenl2, res, maxlen, minlen;
    lenl1 := Length(l1);
    lenl2 := Length(l2);
    minlen := Minimum(lenl1, lenl2);
    maxlen := Maximum(lenl1, lenl2);
    res := Concatenation(l1, Replicate(maxlen-lenl1, c));
    for i in [1..lenl2] do
        res[i] := res[i] + l2[i];
    od;
    return res;
end;

ListAddZP := (l1, l2) -> ListAddP(l1,l2,0);
ListAddLP := (l1, l2) -> ListAddP(l1,l2,[0,0]);


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

ImportAll(spiral.formgen);
ImportAll(spiral.transforms);
ImportAll(spiral.compiler);

doScalarDft := function(arg)
	local szs, userOpts, isSingle, opts, direction, func, file, t, rt, ir, N, cycles, flops;

	if not (Length(arg) in [1..2]) then
		Error("usage: doScalarDft(sizes, [userOptions])");
	fi;

	szs      := When(IsList(arg[1]), arg[1], [ arg[1] ]);
	userOpts := When(IsBound(arg[2]), arg[2], rec());

	isSingle := IsBound(userOpts.precision) and userOpts.precision = "single";

	opts := CopyFields(SpiralDefaults, rec(
				precision  := When(isSingle, "single", "double"),
				TRealCtype := When(isSingle, "float", "double"),
			));

	opts.globalUnrolling := 512;

	direction := When(IsBound(userOpts.transInverse) and userOpts.transInverse, 1, -1);

	for N in szs do
		if IsBound(userOpts.functionNameRoot) then
			func := ReplaceAll(userOpts.functionNameRoot, "%sz1", StringInt(N));
		else
			func := When(direction=1,"i","")::"DFT"::When(isSingle, "_SC", "_DC")::StringInt(N);
		fi;

		file := func::".c";

		t    := DFT(N, direction);
		rt   := RandomRuleTree(t, opts);
		ir   := CodeRuleTree(rt, opts);

		PrintTo(file, PrintCode(func, ir, opts));

		cycles := CMeasure(ir, opts);
		flops:= t.normalizedArithCost();
		PrintLine(t, "  ", cycles, " [cyc]  ", _compute_gflops(flops, cycles), " [Gf/s]");
	od;

	return true;
end;

doScalar2DDft := function(arg)
	local szs, userOpts, isSingle, opts, direction, func, file, t, rt, ir, dims, cycles, flops;

	if not ((Length(arg) in [1..2]) and IsList(arg[1]) and Length(arg[1]) > 0) then
		Error("usage: doScalar2DDft(sizes, [userOptions])");
	fi;

	szs      := arg[1];
	if Length(szs) = 2 and IsInt(szs[1]) and IsInt(szs[2]) then
		szs := [ szs ];
	elif not ForAll(szs, dims -> Length(dims) = 2 and IsInt(dims[1]) and IsInt(dims[2])) then
		Error("sizes must be one or more pairs of integers");
	fi;

	userOpts := When(IsBound(arg[2]), arg[2], rec());

	isSingle := IsBound(userOpts.precision) and userOpts.precision = "single";

	opts := CopyFields(SpiralDefaults, rec(
				precision  := When(isSingle, "single", "double"),
				TRealCtype := When(isSingle, "float", "double"),
			));

	opts.globalUnrolling := 128;

	direction := When(IsBound(userOpts.transInverse) and userOpts.transInverse, 1, -1);

	for dims in szs do
		if IsBound(userOpts.functionNameRoot) then
			func := ReplaceAll(userOpts.functionNameRoot, "%sz1", StringInt(dims[1]));
			func := ReplaceAll(func, "%sz2", StringInt(dims[2]));
		else
			func := When(direction=1,"i","")::"DFT"::When(isSingle, "_SC", "_DC")::StringInt(dims[1])::"x"::StringInt(dims[2]);
		fi;

		file := func::".c";

		t    := MDDFT(dims, direction);
		rt   := RandomRuleTree(t, opts);
		ir   := CodeRuleTree(rt, opts);

		PrintTo(file, PrintCode(func, ir, opts));

		cycles := CMeasure(ir, opts);
		flops:= t.normalizedArithCost();
		PrintLine(t, "  ", cycles, " [cyc]  ", _compute_gflops(flops, cycles), " [Gf/s]");
	od;

	return true;
end;

Class(ScriptGenScalar, ScriptGenBase, rec(

	_arch := () -> "Scalar",

	_init := meth(self)
		self._setTransform(SGKEY_FFT);
		self._setType(SGKEY_SPCX);
		self._setSize(16);
		self._setFilename("");
	end,

	_validTransforms := meth(arg)
		return [SGKEY_FFT, SGKEY_IFFT, SGKEY_FFT_2D, SGKEY_IFFT_2D];
	end,

	_validSizes := meth(arg)
		local self, szs, xform, type;
		self  := arg[1];
		szs   := [];
		xform := self.getSettingsValue(SGKEY_TRANSFORM);
		type  := self.getSettingsValue(SGKEY_DATATYPE);

		if xform in [SGKEY_FFT, SGKEY_IFFT] then
			szs := Filtered([2..512], i->ForAll(Factors(i), j->j<=19));
			Append(szs, Filtered([513..1024], i->ForAll(Factors(i), j->j<=19) and IsInt(i/16)));
			Append(szs, List([11..16], i->2^i));
		elif xform in [SGKEY_FFT_2D, SGKEY_IFFT_2D] then
			szs := List(Filtered([2..360], i->ForAll(Factors(i), j->j<=19)), n -> [n, n]);
		elif xform = SGKEY_WHT then
			if type = SGKEY_DPCX then
				szs := List([2..10], i->2^i);
			else
				szs := List([4..10], i->2^i);
			fi;
		fi;

		return szs;
	end,

	_validTypes := meth(arg)
		return [SGKEY_SPCX, SGKEY_DPCX];
	end,

	getScriptChoices := (self) >> [SGSTR_RUNRANDOMALL],

	_genScript := meth(self, runType)
		local scrstr, xform, type, szs, tempopts, optrec, optstr, funcstr;

		xform	 := self.getSettingsValue(SGKEY_TRANSFORM);
		type	 := self.getSettingsValue(SGKEY_DATATYPE);
		szs      := self.getSettingsValue(SGKEY_SIZE);

		tempopts := "scriptOpts";

		optrec	 := rec(
						precision  := When(type=SGKEY_SPCX, "single", "double"),
						searchType := runType,
					);
		if IsBound(self._settings.(SGKEY_FUNCNAME)) then
			optrec.functionNameRoot := self._settings.(SGKEY_FUNCNAME);
		fi;
		if xform in [SGKEY_IFFT, SGKEY_IFFT_2D] then
			optrec.transInverse := true;
		fi;

		if xform in [SGKEY_FFT, SGKEY_IFFT] then
			funcstr := "doScalarDft("::String(szs)::", "::tempopts::")";
		elif xform in [SGKEY_FFT_2D, SGKEY_IFFT_2D] then
			funcstr := "doScalar2DDft("::String(szs)::", "::tempopts::")";
		else
			return "";
		fi;

		optstr := StringPrint(optrec);

		scrstr := "Import(scriptgen);;\n";
		Append(scrstr, tempopts::" := "::optstr::";;\n");
		Append(scrstr, funcstr::";;\n");

		return scrstr;
	end,
)); # Class ScriptGenScalar

SetScriptGenConstructor(ScriptGenScalar);


#############################################################################
##
##  This file is part of GAP, a system for computational discrete algebra.
##  This file's authors include Alexander Hulpke.
##
##  Copyright of GAP belongs to its developers, whose names are too numerous
##  to list here. Please refer to the COPYRIGHT file for details.
##
##  SPDX-License-Identifier: GPL-2.0-or-later
##
##  This file contains the methods for the construction of the basic fp group
##  types.
##

#############################################################################
##
#M  TrivialGroupCons( <IsPcGroup> )
##
InstallMethod( TrivialGroupCons,  "fp group",
    [ IsFpGroup and IsTrivial ],
    filter -> FreeGroup(0));

#############################################################################
##
#M  AbelianGroupCons( <IsFpGroup and IsFinite>, <ints> )
##
InstallMethod( AbelianGroupCons, "fp group", true,
    [ IsFpGroup and IsAbelian, IsList ], 0,
function( filter, ints )
local   f,g,i,j,rels,gfam,fam;

  if Length(ints)=0 or not ForAll( ints, x -> IsInfinity(x) or (IsInt(x) and x >= 0) )  then
      Error( "<ints> must be a list of integers" );
  fi;

  f   := FreeGroup(IsSyllableWordsFamily, Length(ints));
  g   := GeneratorsOfGroup(f);
  rels:=[];
  for i in [1..Length(ints)] do
    for j in [1..i-1] do
      Add(rels,Comm(g[i],g[j]));
    od;
    if IsPosInt(ints[i]) then
      Add(rels,g[i]^ints[i]);
    fi;
  od;

  g:=f/rels;

  if ForAll(ints,IsPosInt) then
    SetSize( g, Product(ints) );
  else
    SetSize( g, infinity );
  fi;

  fam:=FamilyObj(One(f));
  gfam:=FamilyObj(One(g));
  gfam!.redorders:=ints;
  SetFpElementNFFunction(gfam,function(x)
    local u,e,i,j,n;
    u:=UnderlyingElement(x);
    e:=ExtRepOfObj(u); # syllable form

    # bring in correct order and reduction
    n:=ListWithIdenticalEntries(Length(gfam!.redorders),0);
    for i in [1,3..Length(e)-1] do
      j:=e[i];
      if IsPosInt(gfam!.redorders[j]) then
	n[j]:=n[j]+e[i+1] mod gfam!.redorders[j];
      else
	n[j]:=n[j]+e[i+1];
      fi;
    od;

    e:=[];
    for i in [1..Length(gfam!.redorders)] do
      if n[i]<>0 then
	Add(e,i);
	Add(e,n[i]);
      fi;
    od;

    return ObjByExtRep(fam,e);
  end);

  SetReducedMultiplication(g);
  SetIsAbelian( g, true );

  return g;
end );

#############################################################################
##
#M  CyclicGroupCons( <IsFpGroup>, <n> )
##
InstallOtherMethod( CyclicGroupCons, "fp group", true,
    [ IsFpGroup and IsCyclic, IsObject ], 0,
function( filter, n )
local f,g,fam,gfam;
  if n=infinity then
    return FreeGroup("a");
  elif not IsPosInt(n) then
    TryNextMethod();
  fi;
  f:=FreeGroup( IsSyllableWordsFamily, "a" );
  g:=f/[f.1^n];
  SetSize(g,n);
  fam:=FamilyObj(One(f));
  gfam:=FamilyObj(One(g));
  SetFpElementNFFunction(gfam,function(x)
    local u,e;
    u:=UnderlyingElement(x);
    e:=ExtRepOfObj(u); # syllable form
    if Length(e)=0 or (e[2]>=0 and e[2]<n) then
      return u;
    elif e[2] mod n=0 then
      return One(f);
    else
      e:=[e[1],e[2] mod n];
      return ObjByExtRep(fam,e);
    fi;
  end);

  SetReducedMultiplication(g);
  return g;
end );

#############################################################################
##
#M  DihedralGroupCons( <IsFpGroup and IsFinite>, <n> )
##
InstallMethod( DihedralGroupCons,
    "fp group",
    true,
    [ IsFpGroup and IsFinite,
      IsInt and IsPosRat ],
    0,

function( filter, n )
local f,rels,g;

  if n mod 2 = 1  then
      TryNextMethod();
  elif n = 2 then return
      CyclicGroup( IsFpGroup, 2 );
  fi;
  f   := FreeGroup( IsSyllableWordsFamily, "r", "s" );
  rels:= [f.1^(n/2),f.2^2,f.1^f.2*f.1];
  g   := f/rels;
  SetSize(g,n);
  SetReducedMultiplication(g);
  return g;

end );

InstallOtherMethod( DihedralGroupCons,
    "fp group",
    true,
    [ IsFpGroup and IsFinite,
      IsInfinity ],
    0,

function( filter, inf )
local f,rels,g;

  f   := FreeGroup( IsSyllableWordsFamily, "r", "s" );
  rels:= [f.2^2,f.1^f.2*f.1];
  g   := f/rels;
  SetSize(g,infinity);
  SetReducedMultiplication(g);
  return g;

end );

#############################################################################
##
#M  DicyclicGroupCons( <IsFpGroup and IsFinite>, <n> )
##
InstallMethod( DicyclicGroupCons,
    "fp group",
    true,
    [ IsFpGroup and IsFinite,
      IsInt and IsPosRat ],
    0,
function( filter, n )
local f,rels,g;
  if 0 <> n mod 4  then
      TryNextMethod();
  elif n = 4 then return
      CyclicGroup( IsFpGroup, 4 );
  fi;
  f   := FreeGroup( IsSyllableWordsFamily, "r", "s" );
  rels:= [ f.1^2/f.2^(n/4), f.2^(n/2), f.2^f.1*f.2 ];
  g   := f/rels;
  SetSize(g,n);
  if n <= 10^4 then SetReducedMultiplication(g); fi;
  return g;
end );

#############################################################################
##
#M  ElementaryAbelianGroupCons( <IsFpGroup and IsFinite>, <n> )
##
InstallMethod( ElementaryAbelianGroupCons,
    "fp group",
    true,
    [ IsFpGroup and IsFinite and IsElementaryAbelian,
      IsInt and IsPosRat ],
    0,

function( filter, n )
    if n = 1  then
        return CyclicGroupCons( IsFpGroup, 1 );
    elif not IsPrimePowerInt(n)  then
        Error( "<n> must be a prime power" );
    fi;
    n:= AbelianGroupCons( IsFpGroup, Factors(n) );
    SetIsElementaryAbelian( n, true );
    return n;
end );

#############################################################################
##
#M  FreeAbelianGroupCons( <IsFpGroup>, <rank> )
##
InstallMethod( FreeAbelianGroupCons,
    "fp group",
    true,
    [ IsFpGroup and IsAbelian,
      IsInt and IsPosRat ],
    0,

function( filter, rank )
    return AbelianGroupCons( filter, ListWithIdenticalEntries(rank, 0) );
    # TODO: Add the following if it ever moves from Polycyclic to the GAP core:
    #SetIsFreeAbelian( G, true );
end );


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

Class(LoopGath, Gath);
Class(LoopScat, Scat);
Class(LoopPrm, Prm);

FuncClass.gath := self >> Gath(self);
FuncClass.scat := self >> Scat(self);

fId.gath := self >> I(self.params[1]);
fId.scat := self >> I(self.params[1]);

L.scat := self >> let(m:=self.params[2], n:=self.params[1]/self.params[2], j:=Ind(m), fid := fId(n), fbase := fBase(m,j),
                      gath := Gath(fTensor(fid, fbase)), scat := Scat(fTensor(fbase, fid)),
                      ISum(j, m, scat*gath));

L.gath := self >> let(m:=self.params[2], n:=self.params[1]/self.params[2], j:=Ind(n), fid := fId(m), fbase := fBase(n,j),
                      gath := Gath(fTensor(fbase, fid)), scat := Scat(fTensor(fid, fbase)),
                      ISum(j, n, scat*gath));

fCompose.gath := self >> Compose(Reversed(List(self.children(), i->i.gath())));
fCompose.scat := self >> Compose(List(self.children(), i->i.scat()));

fTensorBuf := function(func, combine)
    local ch, n, loopvars, i, lv, newch1, newch2, res;
    ch := func.children();
    n := Length(ch);
    loopvars := List(Filtered(ch, c -> ObjId(c)=fId), c -> Ind(c.size));

    lv := 1; newch1 := []; newch2 := [];
    for i in [1..n] do
        if ObjId(ch[i]) <> fId then
	    Add(newch1, ch[i]);
	else
	    Add(newch1, fBase(loopvars[lv]));
	    Add(newch2, fBase(loopvars[lv]));
	    lv := lv+1;
	fi;
    od;

    res := combine(fTensor(newch1), fTensor(newch2));

    # lv here is number of loopvars + 1
    for i in Reversed([1..lv-1]) do
        res := ISum(loopvars[i], res);
	# unroll inner loop
	#if i=lv-1 then res:=BB(res); fi;
    od;
    return res;
end;

#fTensor.gath := self >> Tensor(List(self.children(), i->i.gath()));

fTensor.scat := self >> fTensorBuf(self, (f1, f2) -> BB(Scat(f1) * Gath(f2)));
fTensor.gath := self >> fTensorBuf(self, (f1, f2) -> BB(Scat(f2) * Gath(f1)));


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

#   Debug functions -- where to put?
Import(spl, formgen, code, sigma);
VerifyRuleTreeSPL := rt -> let(t := rt.node, mt := MatSPL(t), mspl := MatSPL(SPLRuleTree(rt)), InfinityNormMat(mt-mspl));
VerifyRuleTreeSigmaSPL := (rt, opts) -> let(t := rt.node, mt := MatSPL(t), ms := MatSPL(SumsRuleTree(rt, opts)), InfinityNormMat(mt-ms));

_THRESHOLD := 1E-5;
_abs := i -> When(IsComplex(i), AbsComplex(i), AbsFloat(i));
ThresholdMat := arg -> MapMat(arg[1], i-> When(_abs(i) > When(Length(arg)=2, arg[2], _THRESHOLD),i , 0));

vm := x -> VisualizeMat(When(IsSPL(x), MatSPL(x), x), "");
vmt := x -> VisualizeMat(ThresholdMat(When(IsSPL(x), MatSPL(x), x)), "");


# Built-in
A := [[1, 2], [3, 4], [5, 6], [7, 8]];
B := [[1, 2, 3], [4, 5, 6]];

PrintArray(A);
#  [ [  1,  2 ],
#    [  3,  4 ],
#    [  5,  6 ],
#    [  7,  8 ] ]

PrintArray(B);
#  [ [  1,  2,  3 ],
#    [  4,  5,  6 ] ]

PrintArray(A * B);
#  [ [   9,  12,  15 ],
#    [  19,  26,  33 ],
#    [  29,  40,  51 ],
#    [  39,  54,  69 ] ]


a := [2, 9, 4, 7, 5, 3];
Random(a);


Load(graph);
Import(graph);
conf := SparseDefaultConf;
opts := conf.getOpts(V(1));
opts.vec := true;
i := Ind(opts.symbol[1]);
front := var.fresh_t("frontier",TArray(TSemiring_Boolean(TInt), opts.symbol[1]));
fdataofs := FDataOfs(front, opts.symbol[1], 0);
md := MakeDiag(fdataofs);
eye := I(i);
sid := SUM(eye, md);
matmul := MatMul(opts.symbol[1],opts.symbol[1]);
spmv := matmul * sid;
spmv2 := Rewrite(spmv, RulesIDiag, opts);
spmv3 := Rewrite(spmv2, RulesMatMul, opts);
rt := RandomRuleTree(last, opts);
srt := SumsRuleTree(rt, opts);
push := Rewrite(Copy(srt), RulesSigSPMV2, opts);
cs := CodeSums(BFSKernel(PushBFSKernel(push)), opts);
PrintCode("spmv", cs, opts);


# Solving equations over Free Groups

InstallGlobalFunction(FreeGroupEquationSolve,
function(w,u)
    local vars, consts;

    vars := GeneratorsOfGroup(FreeGroupOfWord(w));
    consts := GeneratorsOfGroup(FreeGroupOfWord(u));

end);

#	ex and ey are the x- and y-exponent sums of the word w respectively.
#	q is the quotient of the exponent sums, e.g. if exponent sums are 3 and 7 then q=2, as 2x3+1=7
#	aut:=[x', y'] is a list consisting of the Neilsen generating pair corresponding to the Moldovanskii rewriting.
#	That is, if w' is the rewritten form of w then there exists an automorphism
#	\phi of F(x, y) such that \phi(w)=w'. In aut, x' and y' are such that
#	\phi(x)=x', \phi(y)=y'. For example, for mold:=Moldovanskii(u); where u is
#	some word over x and y, then mold[1]; and MappedWord(u, [x, y], mold[2]); are
#	the same word.
# NOTE: It may be that MappedWord is better than Eliminated word
#	for our purposes? As might not use syllable notation! (Section 36.3-1 of GAP
#	documentation.)

# TODO: Tests: Some words to rewrite + test that applying the auotmorphism
#              stabilises them.
#       Check whether w is a commutator, and error if it is
#       Error("w is a commutator");
#       Error("");

InstallGlobalFunction(MoldovanskiiRewritingByGenerators,
function(w,x,y)
	  local ex, ey, q, aut;

	  ex := ExponentSumWord(w, x);
	  ey := ExponentSumWord(w, y);
	  aut := [x, y];

	  while ex<>0 and ey<>0 do
		    if AbsInt(ey)>=AbsInt(ex) then
			      q := -QuoInt(ey, ex); # QuoInt is quotient of integers
			      w := MappedWord(w, [x], [x*y^q] );
			      aut[1] := MappedWord(aut[1], [x], [x*y^q] );
			      aut[2] := MappedWord(aut[2], [x], [x*y^q] );
			      ey := ExponentSumWord(w, y);
		    elif AbsInt(ex)>AbsInt(ey) then
			      q := -QuoInt(ex, ey);
			      w := MappedWord(w, [y], [y*x^q] );
			      aut[1] := MappedWord(aut[1], [y], [y*x^q] );
			      aut[2] := MappedWord(aut[2], [y], [y*x^q] );
			      ex := ExponentSumWord(w, x);
		    fi;
	  od;
	  return [w, aut];
end);

# We're looking for solutions to w(x,y) = u(a,b)
# 1. Rewrite w(x,y) as w_0(xy^-1x, y)
#    If expoent sum of x <> 0 or y <> 0 then do
#    Moldovanski rewriting to get one of htem to 0.
#    Also remember the rewriting step
# 2. If  w_0 is in <x^eps y x, y> or <y^eps x y, x >
#    (If w_0 in <y^-1xy, x> then reinterpret x->x_0, y->x_0y_0

# Solves the equation w(x,y) = u(a,b) where w in F(x,y) :wq
# There is no real reason to not use
# list and not just 2 variables
InstallGlobalFunction(IsSolution,
function(w, u, xs, ixs)
    return MappedWord(w, xs, ixs) = u;
end);

InstallGlobalFunction(SubwordLength,
function(word_string, i)
	local subword, exp, next_exp, subcount, letter, j;
	subcount := 0;
	while i <= Length(word_string) do
		next_exp := 0;
		letter := word_string[i];
		if IsAlphaChar(letter) then
			if word_string[i+1] = '^' then
				next_exp := Int([word_string[i+2]]);
				i := i + 3;
				while IsDigitChar(word_string[i]) do
					next_exp := 10*next_exp;
					next_exp := next_exp + Int([word_string[i]]);
					i := i + 1;
				od;
				subcount := subcount + next_exp;
			else
				subcount := subcount + 1;
				i := i + 1;
			fi;
		elif letter = ')' then
			return subcount;
		elif letter = '(' then
			subword := SubwordLength(word_string, i + 1);
			j := 0;
			while word_string[i + j] <> ')' do
				j := j + 1;
			od;
			i := i + j + 1;
			exp := 1;
			if i >= Length(word_string) then
				return -1;
			fi;
			if word_string[i] = '^' then
				exp := Int([word_string[i + 1]]);
				i := i + 2;
				while IsDigitChar(word_string[i]) do
					exp := 10*exp;
					exp := exp + Int([word_string[i]]);
					i := i + 1;
				od;
			fi;
			subcount := subcount + (exp * subword);
			if i >= Length(word_string) then
				return -1;
			fi;
		else
			i := i + 1;
		fi;
	od;
end);

# Find solutions to an equation w(x,y) = u(a,b)
# up to length n by brute force
# w(x, y) is a function of variables
# u(a, b) is a function of constants
# Trying to solve for x and y

InstallGlobalFunction(ShortSolutions,
function(w, u, n)
    local variables, constants, f, gens, const, consts, vars, copy, solutions, tree, c1, c2, c3, c4, nodes, word_string, letter, subcount, i, next_exp, start_consts, exps;
	solutions := [];
	tree := rec();
	nodes := [1];

    variables := FreeGroupOfWord(w);
	constants := FreeGroupOfWord(u);

	f := FreeGroup(Concatenation(List(GeneratorsOfGroup(constants), String),
								 List(GeneratorsOfGroup(variables), String)));
	gens := GeneratorsOfGroup(f){[1 .. Length(GeneratorsOfGroup(variables))]};
	vars := GeneratorsOfGroup(f){[Length(GeneratorsOfGroup(variables)) + 1 ..
								  Length(GeneratorsOfGroup(f))]};
	consts := Concatenation(gens, List(gens, Inverse));
	start_consts := Concatenation(consts, [f.1*f.1^-1]);
	tree.children := List(start_consts, x -> rec(value := x, parent := tree));
	tree.value := f.1 * f.1^-1;
	w := MappedWord(w, GeneratorsOfGroup(variables), vars);
	u := MappedWord(u, GeneratorsOfGroup(constants), consts);

	if u = f.1 * f.1^-1 then
		word_string := String(w);
		if IsDigitChar(word_string[Length(word_string)]) then
			if word_string[1] = '(' then
				subcount := SubwordLength(word_string, 2);
				if subcount > 0 then
					w := Subword(w, 1, subcount);
				fi;
			fi;
		fi;
		exps := ExponentSums(w);
		if RemInt(exps[3], exps[4]) <> 0 and RemInt(exps[4], exps[3]) <> 0 then
			return [[f.1 * f.1^-1, f.1 * f.1^-1]];
		fi;
	fi;

	for const in start_consts do
		copy := MappedWord(w, [vars[1]], [const]);
		if copy = u then
			Add(solutions, [const, 0]);
		fi;
		solutions := BuildTree(const, consts, tree, copy, u, f, solutions, 0, n, nodes);
	od;
	# Print(nodes[1]);
	# Print("\n");
	return solutions;
end);

InstallGlobalFunction(BuildTree,
function(x, consts, node, copy, u, f, solutions, n, limit, nodes)
	local child, const, word, grandchild, c, child_rec;
	nodes[1] := nodes[1] + 1;
	if n > limit then
		return solutions;
	fi;
	for child in node.children do
		child.children := [];
		c := MappedWord(copy, [f.4], [child.value]);
		if c = u then
			Add(solutions, [x, child.value]);
		fi;
		if child.value <> (f.1*f.1^-1) then
			for const in consts do
				word := child.value * const;
				if word = child.parent.value then
					continue;
				fi;
				child_rec := rec();
				child_rec.value := word;
				child_rec.parent := child;
				Add(child.children, child_rec);
			od;
		fi;
	od;
	for child in node.children do
		BuildTree(x, consts, child, copy, u, f, solutions, n + 1, limit, nodes);
	od;
	return solutions;
end);

InstallMethod(FreeGroupOfWord, "for a word over the free group",
              [IsWord], w -> FamilyObj(w)!.freeGroup);

GreenTest := function(n)
    local w, u, F, U, x, y, a, b;

    F := FreeGroup("x", "y");
    x := F.1; y := F.2;

    w := x * y * x;
    u := a^2 * b^2 * a^2;

    return ShortSolutions(w, u, n);
end;


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

type:="G";
rank:=2;
nr_pos_roots:=6;

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

#
# c_2=0 c_3=0
#
#
#
handle23:=function()
	local ua,ub,uab,uabb,u,e,nn,vals,rels,i,v;
	ua:=root_group(1,1);
	uabb:=root_group(4,1);
	u:=ua*uabb;
	id_mat:=u^0;
	e:=u-id_mat;

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

	vals:=[];
	Append(vals,[[[xvars[7]],[Zero(APR)]]]);
	Append(vals,[[[xvars[8]],[Zero(APR)]]]);
	Append(vals,[[[xvars[5]],[Zero(APR)]]]);
	Append(vals,[[[xvars[10]],[Zero(APR)]]]); # for p>2
	Append(vals,[[[xvars[9]],[Zero(APR)]]]); # for p>2
	Append(vals,[[[xvars[2]],[-xvars[6]]]]);
	# ###
	# Append(vals,[[[xvars[1]],[Zero(APR)]]]);
	# Append(vals,[[[xvars[3]],[Zero(APR)]]]);
	# Append(vals,[[[xvars[4]],[Zero(APR)]]]);
	# Append(vals,[[[xvars[8]],[Zero(APR)]]]);
	# Append(vals,[[[xvars[9]],[Zero(APR)]]]);

	#
	# atentie la ordinea transpunerilor
	#
	rels:=nn*TransposedMat(u)-nn;
	rels:=evaluate_rels(rels,vals);
	nn:=evaluate_rels(nn,vals);

	return [u,nn,rels,vals];
end;


# De Caen, Mathon and Moorhouse's Preparata graph Pr(t, e)
BindGlobal("PreparataGraph", function(arg)
    local t, e, q, s, F, K, dp;
    if Length(arg) < 1 then
        Error("at least one argument expected");
        return fail;
    fi;
    t := arg[1];
    if Length(arg) > 1 then
        e := arg[2];
    else
        e := 1;
    fi;
    q := 2^(2*t-1);
    s := 2^e;
    F := GF(q);
    dp := DirectProduct(FieldMultiplicationPermutationGroup(q),
                        FieldAdditionPermutationGroup(2),
                        FieldAdditionPermutationGroup(q),
                        FieldExponentiationPermutationGroup(q));
    return Graph(dp, Cartesian(F, GF(2), F), OnPreparata(q, s, dp),
        function(x,y)
            return x <> y
                and x[3]+y[3] = x[1]^s * y[1] + x[1] * y[1]^s + (x[2]+y[2])*(x[1]^(s+1) + y[1]^(s+1));
        end, true);
end);

# Quotient graph of the Preparata graph
BindGlobal("PreparataQuotientGraph", function(arg)
    local h, s, t, e, B, G, H, K, T, V;
    if Length(arg) < 2 then
        Error("at least two arguments expected");
        return fail;
    fi;
    h := arg[1];
    if IsGraph(arg[2]) then
        G := arg[2];
        if IsFFE(G.names[1][3]) then
            s := 1;
        else
            s := Size(G.names[1][3]);
        fi;
        t := Log2Int(2*s*G.order)/4;
    else
        t := arg[2];
        if Length(arg) > 2 then
            e := arg[3];
        else
            e := 1;
        fi;
        G := PreparataGraph(t, e);
    fi;
    B := BasisVectors(Basis(GF(2^(2*t-1))));
    if IsFFE(G.names[1][3]) then
        K := AdditiveGroup(B{[1..h]});
        V := List(G.names, x -> [x[1], x[2], x[3]+K]);
    else
        K := AdditiveGroup(B{[1..h+Log2Int(s)]});
        V := List(G.names, x -> [x[1], x[2], Elements(x[3])[1]+K]);
    fi;
    T := Set(List(V, x -> Positions(V, x)));
    H := Graph(Stabilizer(G.group, T, OnSetsSets), T, OnSets, function(x,y)
        return IsSubset(DistanceSet(G, 1, x), y);
    end, true);
    AssignVertexNames(H, List(T, x -> V[x[1]]));
    return H;
end);

# The coset graph of a Kasami code over an odd power extension
# of a binary field.
BindGlobal("KasamiGraph", function(i, j, m)
    local q, s, t, dp, G;
    q := 2^i;
    s := q^(2*j+1);
    t := q^m + 1;
    G := FieldAdditionPermutationGroup(s);
    dp := DirectProduct(G, G, FieldExponentiationPermutationGroup(s));
    return Graph(dp, Elements(GF(s)^2), OnKasami(s, s, dp),
        function(x, y)
            return x <> y and x[1]+y[1] = (x[2]+y[2])^t;
        end, true);
end);

# The coset graph of an extended Kasami code over an odd power extension
# of a binary field.
BindGlobal("ExtendedKasamiGraph", function(i, j, m)
    return ExtendedBipartiteDoubleGraph(KasamiGraph(i, j, m));
end);

# The coset graph of a Kasami code over a quadratic extension
# of a binary field.
BindGlobal("QuadraticKasamiGraph", function(i)
    local q, s, t, dp;
    q := 2^i;
    s := q^2;
    t := q + 1;
    dp := DirectProduct(FieldAdditionPermutationGroup(q),
            FieldAdditionPermutationGroup(s),
            FieldExponentiationPermutationGroup(s));
    return Graph(dp, Cartesian(GF(q), GF(s)), OnKasami(q, s, dp),
        function(x, y)
            return x <> y and x[1]+y[1] = (x[2]+y[2])^t;
        end, true);
end);

# The coset graph of an extended Kasami code over a quadratic extension
# of a binary field.
BindGlobal("ExtendedQuadraticKasamiGraph", function(i)
    return ExtendedBipartiteDoubleGraph(QuadraticKasamiGraph(i));
end);


Load(graph);
Import(graph);
conf := SparseDefaultConf;
opts := conf.getOpts(V(1));
opts.vec := true;
i := Ind(3);
ts := TSparse(TArray(TInt, 3), TSemiring_Boolean(TInt));
fdataofs := FDataOfs(ts, 3, 0);
md := MakeDiag(fdataofs);
eye := I(i);
sid := SUM(eye, md);
matmul := MatMul(3,3);
spmv := matmul * sid;
spmv2 := Rewrite(spmv, RulesIDiag, opts);
spmv3 := Rewrite(spmv2, RulesMatMul, opts);
rt := RandomRuleTree(last, opts);
srt := SumsRuleTree(rt, opts);
srt2 := Rewrite(Copy(srt), RulesSigSPMV2, opts);
cs := CodeSums(PushBFSKernel(last), opts);
PrintCode("spmv", cs, opts);


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

#P Parametrized permutation classes
#P --------------------------------
#P

## -----------------------------------------------------------------------------
#F L(<n>, <str>) - stride permutation
##
Class(L, PermClass, rec(
    def := (n,str) -> Checked(IsPosIntSym(n), IsPosIntSym(str),
        (not (IsInt(n) and IsInt(str)) or n mod str = 0), rec()),

    domain := self >> self.params[1],
    range  := self >> self.params[1],

    lambda := self >> let(
        n := self.params[1], str := self.params[2], i := Ind(n),
        Lambda(i, idiv(i, n/str) + str * imod(i, n/str))),

    transpose := self >> self.__bases__[1](self.params[1], self.params[1] / self.params[2]),
    isSymmetric := self >> (self.params[1] = self.params[2]^2) or (self.params[2] = 1) or (self.params[2] = self.params[1]),
    printlatex := self >> Print(" \\stride^{", self.params[1], "}_{",self.params[2],"} ")

));

## -----------------------------------------------------------------------------
#F Tr(<k>, <str>) - stride permutation L(k*str, str),
##
## This L equivalent is used to simplify rewriting, since k is not explicit in L,
## and if symbolics are used, to extract it we have to do simplification tricks,
## eg.  n/f1(n) = f2(n).
##
## Tr stands for Transpose.
##
Class(Tr, PermClass, rec(
    def := (k,str) -> Checked(IsPosIntSym(k), IsPosIntSym(str), rec()),

    lambda := self >> let(
        k := self.params[1], str := self.params[2], i := Ind(k*str),
        Lambda(i, idiv(i, k) + str * imod(i, k))),

    domain := self >> self.params[1] * self.params[2],
    range := self >> self.params[1] * self.params[2],

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

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

## -----------------------------------------------------------------------------
#F Z(N,k) : Cyclic shift by <k>, permutation {0, ..., n-1} -> {k,...,n-1, 0,...,k-1}
##
# if one redefines .lambda, then .transposed should be also handled in custom .lambda
Class(Z, PermClass, rec(
    abbrevs := [ n -> [n,1] ],
    def := (n,k) -> rec(),
    domain := self >> self.params[1],
    range  := self >> self.params[1],
    lambda := self >> let(n:=self.params[1], k:=self.params[2], i := Ind(n),
        Lambda(i, imod(i + k, n))),
    transpose := self >> self.__bases__[1](self.params[1], self.params[1] - self.params[2])
));

## -----------------------------------------------------------------------------
#F J(N) : NxN reverse identity, also known as reversal permutation (1,n)(2,n-1)...
##
Class(J, PermClass, rec(
    def := n -> rec(),
    lambda := self >> let(i := Ind(self.params[1]), Lambda(i,self.params[1]-i-1)),
    domain := self >> self.params[1],
    range  := self >> self.params[1],
    transpose := self >> self,
    isSymmetric := True
));

## -----------------------------------------------------------------------------
#F OddStride(<n>, <str>)
#F OS(<n>, <str>)        - odd stride permutation (i -> i * str mod n)
##
Class(OS, PermClass, rec(
    isCyclic := true,
    def := (n,str) -> Checked(IsPosIntSym(n), IsIntSym(str), n > 0,
        AnySyms(n,str) or (Gcd(EvalScalar(n),EvalScalar(str))=1), rec()),
    domain := self >> self.params[1],
    range  := self >> self.params[1],
    lambda := self >> let(i := Ind(self.params[1]),
        Lambda(i, imod(self.params[2] * i, self.params[1]))),
    transpose := self >> self.__bases__[1](self.params[1], self.params[2]^-1 mod self.params[1])
));
OddStride := OS;

Declare(gammaTensor);
## -----------------------------------------------------------------------------
#F CRT(<r>, <s>) - Chinese remainder theorem permutation function of size r*s
##
Class(CRT, PermClass, rec(
    isCyclic := true,

    abbrevs := [ (r, s) -> Checked(IsPosIntSym(r), IsPosIntSym(s), AnySyms(r,s) or Gcd(r,s)=1,
        let(alpha := 1/s mod r,
        beta  := 1/r mod s,
        [r, s, alpha, beta])) ],

    toGammaTensor := self >> gammaTensor(
        OddStride(self.params[1], self.params[3]),
        OddStride(self.params[2], self.params[4])),

    def := (r, s, alpha, beta) -> Checked(
        IsPosIntSym(r), IsPosIntSym(s), AnySyms(r, s) or Gcd(r,s)=1,
        rec()),

    domain := self >> self.params[1] * self.params[2],
    range  := self >> self.params[1] * self.params[2],

    lambda := self >> let(
        r := self.params[1], s := self.params[2], N := r*s,
        alpha := self.params[3], beta := self.params[4],
        aa := (1/s/alpha) mod r, bb := (1/r/beta) mod s,
        i := Ind(N),
        When(not self.transposed,
            Lambda(i, ((s*alpha*idiv(i, s)) + (r*beta*imod(i, s))) mod N),
            Lambda(i,   s*(imod(i*aa, r))   + (imod(i*bb, s))))),
));

Class(fCond, FuncClass, rec(
    def := (cond, f1, f2) -> Checked(
        f1.range() = f2.range(),
        f1.domain() = f2.domain(),
	rec()),

    domain := self >> self.params[1].domain(),
    range := self >> self.params[2].range(),

    lambda := self >> let(f1 := self.params[2], f2:= self.params[3], mycond := self.params[1],
        i := Ind(f1.domain()),
        Lambda(i, cond(mycond.lambda().at(i), f1.lambda().at(i), f2.lambda().at(i)))),

    transpose := self >> let(base := self.__bases__[1],
        base(self.params[1], self.params[2].transpose(), self.params[3].transpose()))
));

# ----------------------------------------------------------
# Bit and Digit reversals
# ----------------------------------------------------------

# Return x as a b-bit value, formed as a vector
_numToBits := (k, b) >> Reversed(List([1..b], i-> imod(idiv(k, 2^(i-1)), 2)));

# Return number corresponding to bit vector b
_bitsToNum := b -> let(
   l := Reversed(b),
   Sum([1..Length(l)], i -> 2^(i-1) * l[i]));

# Calculate base-r digit reversed value of k, where k is between 0 and n-1
_digitRev := function(k, n, r)
   local bitval, numbits, bitsperchunk, numchunks, res_bits, i, s;

   numbits      := Log2Int(n);
   bitsperchunk := Log2Int(r);
   numchunks    := numbits / bitsperchunk;

   bitval := _numToBits(k, numbits);

   res_bits := [];
   for i in Reversed([1..numchunks]) do
       s := bitval{([bitsperchunk*i-(bitsperchunk-1) .. bitsperchunk * i])};
       Append(res_bits, s);
   od;

   return _bitsToNum(res_bits);
end;

#F DR(<k, r>) - digit reversal permutation R^k_r
##
Class(DR, PermClass, rec(
    def := (k, r) -> Checked(IsInt(k), Is2Power(k), (r^(LogInt(k,r)) = k), rec()),

    domain := self >> self.params[1],
    range  := self >> self.params[1],
 # This is very slow because of how Gap evaluates functions
 #    lambda := self >> let(
 #         n := self.params[1],  base := self.params[2],  t := LogInt(n, base),
 #         rev := List([1..t], i-> fTensor(fId(base^(t-i)), L(base^i, base))),
 #         fCompose(Reversed(rev)).lambda()),

# This is faster but a little bit uglier.
    lambda := self >> let(
        i := Ind(self.params[1]),
        Lambda(i, _digitRev(i, self.params[1], self.params[2]))),

    transpose := self >> self
));

#F BR(<k>) - bit reversal permutation
##
Class(BR, PermClass, rec(
    def := k -> Checked(IsInt(k), Is2Power(k),  rec()),
    domain := self >> self.params[1],
    range  := self >> self.params[1],
    lambda := self >> DR(self.params[1], 2).lambda(),
    transpose := self >> self
));


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

avarnames:=List([1..7],i->Concatenation("a_{",String(i),"}"));
PR:=PolynomialRing(GF(5),avarnames);

Print("Created PolynomialRing ",PR,"\n");
Print("\t[",IsPolynomialRing(PR)=true,"] IsPolynomialRing(PR)=true\n");


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

################################################################################
##
#F DG_S_and_T(<group>,<bool>) Computes Simples, S, T, FPdim(Xi), FPdimC for D(G)
##
InstallGlobalFunction(DG_S_and_T, function(G,display)
  local g, elmsG, R, r, tbl, chi, Simples, x, y, S, s, T, rank, x_idx, y_idx, FPdim, FPdimC,l,pseudounitary_data,sorted_data;
  elmsG := Elements(G);
  if display then
    Print("\nG = ", StructureDescription(G), "              ", IdGroup(G), "\n");
  fi;

  # compute the simples
  R := List(ConjugacyClasses(G), Representative);
  Simples := [];
  for r in R do
    tbl := CharacterTable(Centralizer(G, r));
    for chi in Irr(tbl) do
      Add(Simples, [r, chi, ConjugacyClasses(tbl)]);
    od;
  od;
  rank:=Size(Simples);

  if display then
    Print("Rank is\n\n");
    Display(rank);
    Print("Computing S matrix\n");
  fi;

  # compute the S-matrix
  # since s is symmetric we can half the size of the inner loop
  #S := NullMat(rank,rank);
  S:=[];
#  for x_idx in [1..rank] do
#    x:=Simples[x_idx];
  for x in Simples do
    l:=[];
    #for y_idx in [x_idx..rank] do
#    for y_idx in [1..rank] do
#      y:=Simples[y_idx];
    for y in Simples do
      s := 0;
      for g in elmsG do
        if x[1]*g*y[1]*Inverse(g) = g*y[1]*Inverse(g)*x[1] then
         s := s + ComplexConjugate(x[2][Position(x[3],
                  ConjugacyClass(Centralizer(G, x[1]), g*y[1]*Inverse(g)))])
                * ComplexConjugate(y[2][Position(y[3],
                  ConjugacyClass(Centralizer(G, y[1]), Inverse(g)*x[1]*g))]);
        fi;
      od;
      s := s * (1/(Size(Centralizer(G, x[1])) * Size(Centralizer(G, y[1])))) * Size(G);
      #S[x_idx][y_idx] := s;
      #S[y_idx][x_idx] := s;
      Add(l,s);
     od;
     Add(S,l);
  od;

  # compute the T-matrix
  T := [];
  for x in Simples do
    Add(T, x[2][Position(x[3], ConjugacyClass(Centralizer(G, x[1]), x[1]))]/x[2][1]);
  od;

  if display then
    Print("\n The S-matrix is: \n\n");
    Print(S);
    Print("\n\n The T-matrix is: \n\n");
    Print(T);
    Print("\n\n");
  fi;

  pseudounitary_data := pseudounitary_sort(S,T,Simples);
  Simples := pseudounitary_data[1];
  S := pseudounitary_data[2];
  T := pseudounitary_data[3];
  FPdim := pseudounitary_data[4];
  FPdimC := pseudounitary_data[5];

  # sort by dimensions (if two objects have the same dimension, their
  # relative order is unchanged).
  sorted_data := dimension_sort(S,T,Simples,FPdim);
  Simples:=sorted_data[1];
  S:=sorted_data[2];
  T:=sorted_data[3];
  FPdim:=sorted_data[4];

  return [Simples, S, T, FPdim, FPdimC];
end);

################################################################################
##
#F DG_data(<group>) . . . . . . . . . . . . . . .Computes modular data for D(G).
InstallGlobalFunction(DG_data, function(G)
  local Simples, S, T, FPdim, FPdimC, N, data;
  data:=DG_S_and_T(G,false);
  Simples:=data[1];
  S:=data[2];
  T:=data[3];
  FPdim:=data[4];
  FPdimC:=data[5];
  N:=compute_fusion_rules(S,FPdimC);
  return [Simples,S,T,N,FPdim,FPdimC];
end);

#E DG_data.gi . . . . . . . . . . . . . . . . . . . . . . . . . . . . .ends here


Fibonacci(n);


# Using SageMath interface for GAP
# To start GAP inside of SageMath:
# gap.console()
#
# Defining groups in GAP:
# PSL := FreeProduct(CyclicGroup(2),CyclicGroup(3))
#
# Using SageMath to access GAP's
# finitely presented groups functionality
# https://doc.sagemath.org/html/en/reference/groups/sage/groups/finitely_presented.html

# from sage.interfaces.gap import get_gap_memory_pool_size, set_gap_memory_pool_size
# set_gap_memory_pool_size(20000000000)

k := 4;

F := FreeGroup("t_k", "c", "d");

G := F / [F.3^(-1)*F.1*(F.3*F.2^(-1))^(-k+1)*F.1*(F.3*F.2^(-1))^(k-1)*(F.1^(-1)),
          F.2^(-1)*F.1*F.2*F.3^(-1)*(F.1)^(-1)*F.3*F.1*F.3*F.2^(-1)*(F.1)^(-1)];

RelatorsOfFpGroup(G);

AllHomomorphismClasses(G, SymmetricGroup(3));
# AllHomomorphisms(G, SymmetricGroup(3));