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

#D TL.withTags := (self, tags) >> CopyFields(self, rec(params := [self.params[1], self.params[2], self.params[3], self.params[4], tags]));
#D TL.getTags := self >> self.params[self.tagpos];

DoubleDivisorPairs:=function(n,m)
    local a,b,l;
    l:=[];
    for a in DivisorPairs(n) do
        Append(l,[Concatenation(a,[1,m]),Concatenation(a,[m,1])]);
        for b in DivisorPairs(m) do
            Append(l,[Concatenation(a,b)]);
        od;
    od;
    for b in DivisorPairs(m) do
        Append(l,[Concatenation([n,1],b),Concatenation([1,n],b)]);
    od;
    return l;
end;

VectorDivisible:=function(m,c,k,b,v)
#not yet taken into account : b or c =1
    local leftpart,rightpart;
    leftpart := v in DivisorsInt(c) or m=1 or (b=1 and k=1);
    rightpart:= v in DivisorsInt(b) or c=1 or k=1;
    return leftpart and rightpart;
end;

DoubleDivisorPairsVector:=function(n,m,v)
    return Filtered(DoubleDivisorPairs(n,m) , a -> VectorDivisible(a[1],a[2],a[3],a[4],v));
end;

Blocking:=function(m,c,k,b,v)
    local t, nv, PageSize, CacheLineSize;
    t:=128/v;
    PageSize:=4*1024*8*(2);
    nv:=m*c*k*b*t;
    if (nv>PageSize) then
        return When((PageSize/8<=b*c*t)and(b*c*t<=PageSize),true,false);

        #CacheLineSize:=64*8*(4);
    #else
        #if (nv>CacheLineSize) then
            #return When((CacheLineSize/8<=b*c*t)and(b*c*t<=CacheLineSize),true,false);
        #fi;
    fi;
    return true;
end;

DoubleDivisorPairsVectorBlocking:=function(n,m,v)
    return Filtered(DoubleDivisorPairsVector(n,m,v), a->Blocking(a[1],a[2],a[3],a[4],v));
end;

NewRulesFor(TL,rec(
    L_cx_real := rec(
        switch:=false,
        forTransposition := false,
        applicable := t ->  t.isTag(1, AVecRegCx) and let(P := t.params, P[1] = P[2]^2), #FF: NOTE!! can only terminate symmetrical ones...
        children := nt -> let(P:=nt.params, [[TL(P[1], P[2], P[3], P[4]*2).withTags([AVecReg(nt.getTags()[1].isa)])]]),
        apply := (t, C, Nonterms) -> CR(When(t.params[1]=t.params[2]^2, SymSPL(C[1]), C[1]))
    ),

    L_base_vec := rec(
        switch:=false,
        forTransposition := false,
        applicable := t -> t.isTag(1, AVecReg) or t.isTag(1, AVecRegCx),
        apply := (t, C, Nonterms) -> let(
            C1:=When(t.params[3]=1, [], [I(t.params[3])]),
            C2:=When(t.params[4]=1, [], [I(t.params[4])]),
            Tensor(Concat(C1, [L(t.params[1], t.params[2])], C2))
        )
#D        applicable := (self, t) >> FirstTagEq(t, AVecReg) or FirstTagEq(t, AVecRegCx),
#D        apply := (t, C, Nonterms) -> let(C1:=When(t.params[3]=1, [], [I(t.params[3])]),
#D            C2:=When(t.params[4]=1, [], [I(t.params[4])]), Tensor(Concat(C1, [L(t.params[1], t.params[2])], C2)))),
    ),

   #L^mn_m -> (L^mn/v_m x I_v)(I_mn/v2 x L^v2_v)(I_n/v x L^m_m/v x I_v)
    L_mn_m_vec := rec(
        forTransposition := false,
        freedoms := (self, t) >> [],
        applicable := t ->
            t.params[3] = 1
            and t.params[4] = 1
            and (t.isTag(1, AVecReg) or t.isTag(1, AVecRegCx))
            and let(
                v := t.firstTag().v,
                m := t.params[2],
                n := t.params[1] / m,
                IsInt(m/v)
                and IsInt(n/v)
                and not (
                    t.params[1] = v*v
                    and t.params[2] = v
                )
            ),
        child := (nt,freedoms) -> let (v := nt.firstTag().v, [ TL(v*v, v, 1, 1).withTags(nt.getTags()) ] ),

        apply := (nt, C, cnt) -> let(
            v := nt.firstTag().v,
            v2 := v*v,
            m := nt.params[2],
            n := nt.params[1]/m,
            VTensor(L(m*n/v, m), v)
            * SymSPL(BlockVPerm(m*n/v2, v, C[1], L(v^2,v)))
            * VTensor(Tensor(I(n/v), L(m,m/v)), v)
        )

#D        applicable := (self, t) >> t.params[3] = 1 and t.params[4] = 1 and FirstTagEq(t, AVecReg) and
#D                        let (v := GetFirstTag(t).v, m:=t.params[2], n:= t.params[1]/m,
#D                               IsInt(m/v) and IsInt(n/v) and not(t.params[1]=v*v and t.params[2]=v))  ,
#D
#D        child := (nt,freedoms) -> let (v := GetFirstTag(nt).v, [TL(v*v, v, 1, 1, GetTags(nt))]),
#D
#D        apply := (nt,C,cnt) -> let(v:=GetFirstTag(nt).v, v2:=v*v, m:=nt.params[2], n:= nt.params[1]/m,
#D                VTensor(L(m*n/v, m), v) *
#D                SymSPL(BlockVPerm(m*n/v2, v, C[1], L(v^2,v))) *
#D                VTensor(Tensor(I(n/v), L(m,m/v)), v))),
    ),

#SymSPL-BlockVPerm can be replaced by Tensor(I(m*n/v2), C[1])

#L^mn_m could probably also be splitted like that:

#   #L^mn_m -> (L^mn/v_m x I_v)(I_mn/v2 x L^v2_v)(I_n/v x L^m_m/v x I_v)
#   L_mn_m_vec := rec(
#       forTransposition := false,
#       applicable := (self, t) >> t.params[3] = 1 and t.params[4] = 1 and FirstTagEq(t, AVecReg) and
#                        let (v := GetFirstTag(t).v, m:=t.params[2], n:= t.params[1]/m,
#                                  IsInt(m/v) and IsInt(n/v)),

#       freedoms := (self, t) >> [],
#       child := (nt,freedoms) -> let (v := GetFirstTag(nt).v, m:=nt.params[2], n:= nt.params[1]/m,
#         [TL(m*n/v, m, 1, v, GetTags(nt)),
#                TL(v*v, v, m*n/(v*v), 1, GetTags(nt)),
#                   TL(m,m/v,n/v, v, GetTags(nt))]),
#       apply := (nt,C,cnt) -> let(v:=GetFirstTag(nt).v, v2:=v*v, m:=nt.params[2], n:= nt.params[1]/m, C[1] * C[2] * C[3])),

#   #I x L -> BlockVPerm
#   IxLxI_BlockVPerm := rec(
#       forTransposition := false,
#       applicable := (self, t) >> FirstTagEq(t, AVecReg) and (t.params[4]=1)
#                   and let (v := GetFirstTag(t).v, (t.params[1]=v*v) and (t.params[2]=v)),
#       freedoms := (self, t) >> [],
#       child := (nt,freedoms) -> let (v := GetFirstTag(nt).v,[TL(v*v, v, 1, 1, GetTags(nt))]),
#       apply := (t, C, cnt) -> let(v:=GetFirstTag(t).v,
#SymSPL(BlockVPerm(t.params[3], v, C[1], DropTag(cnt[1]))))),

   #A x I_v -> VTensor
   IxLxI_vtensor := rec(
       forTransposition := false,
       applicable := t ->
            (
                t.isTag(1, AVecReg)
                or t.isTag(1, AVecRegCx)
            )
            and IsPosInt(t.params[4] / t.firstTag().v),
       apply := (t, C, Nonterms) -> let(
            v:=t.firstTag().v,
            l1 := When(t.params[3] > 1, [I(t.params[3])], []),
            l2 := When(t.params[4]/v > 1, [I(t.params[4]/v)], []),
            VTensor(Tensor(Concat(l1, [L(t.params[1], t.params[2])], l2)), v)
        )
#D       applicable := (self, t) >> (FirstTagEq(t, AVecReg) or FirstTagEq(t, AVecRegCx)) and
#D                              let(v:=GetFirstTag(t).v, IsPosInt(t.params[4]/v)),
#D       apply := (t, C, Nonterms) -> let(v:=GetFirstTag(t).v, l1:= When(t.params[3] > 1, [I(t.params[3])], []), l2:=When(t.params[4]/v > 1, [I(t.params[4]/v)], []) , VTensor(Tensor(Concat(l1, [L(t.params[1], t.params[2])], l2)), v))),
    ),

#GV1 shouldn't be enabled for stuff that are not strides!
#It is highly disruptive because it doesn't respect the VTensor VPerm nomenclatura
#F L_GV1: TL(kmbc,kb,r,s) = I_r tensor ((L(kbm,bk) tensor I_c) * (I_m tensor TL(bc,b,k,1)) * (I_m tensor L(kc,k) tensor I_b)) tensor I_s
    L_GV1 := rec(
        switch:=false,
        forTransposition := false,
        freedoms := nt -> [
            MapN(
                DoubleDivisorPairsVector(nt.params[1] / nt.params[2], nt.params[2], nt.firstTag().v),
                (m,c,k,b) -> [b,c]
            )
        ],
        child := (nt,freedoms) -> let(b:=freedoms[1][1],c:=freedoms[1][2], [TL(b*c,b,1,1).withTags(nt.getTags())]),
        apply := (nt,C,cnt) -> let(
            n:=nt.params[1],
            b:=cnt[1].params[2],
            c:=cnt[1].params[1]/b,
            k:=nt.params[2]/b,
            m:=nt.params[1]/(k*b*c),
            r:=nt.params[3],
            s:=nt.params[4],
            Tensor(
                I(r),
                Tensor(
                    Tensor(L(k*b*m,b*k),I(c))
                    * Tensor(I(m),Tensor(I(k),C[1]))
                    * Tensor(Tensor(I(m),L(k*c,k)),I(b)),
                    I(s))
            )
        )
#D       freedoms := nt -> [MapN(DoubleDivisorPairsVector(nt.params[1]/nt.params[2],nt.params[2],GetFirstTag(nt).v),(m,c,k,b) -> [b,c])],
#D       child := (nt,freedoms) -> let(b:=freedoms[1][1],c:=freedoms[1][2], [TL(b*c,b,1,1,GetTags(nt))]),
#D       apply := (nt,C,cnt) -> let(
#D       n:=nt.params[1],b:=cnt[1].params[2],c:=cnt[1].params[1]/b,k:=nt.params[2]/b,m:=nt.params[1]/(k*b*c),r:=nt.params[3],s:=nt.params[4],
#D       Tensor(I(r),(Tensor(
#D               Tensor(L(k*b*m,b*k),I(c))*
#D               Tensor(I(m),Tensor(I(k),C[1]))*
#D               Tensor(Tensor(I(m),L(k*c,k)),I(b))
#D               , I(s)))))),
    ),

    L_GV1_vtensor := rec(
        switch:=false,
        forTransposition := false,
        applicable := nt -> let(p := nt.params,
            nt.isTag(1, AVecReg)
            and p[1] <> p[2]
            and p[2] <> 1
            and Length(
                DoubleDivisorPairsVectorBlocking(p[1] / p[2], p[2], nt.firstTag().v)
            ) > 0
        ),
        freedoms := nt -> let(p := nt.params, [
            MapN(
                DoubleDivisorPairsVectorBlocking(p[1] / p[2], p[2], nt.firstTag().v),
                (m,c,k,b) -> [b,c]
            )
        ]),
        child := (nt, freedoms) -> let(
            b:=freedoms[1][1],
            c:=freedoms[1][2],
            [ TL(b*c,b,1,1).withTags(nt.getTags()) ]
        ),
        apply := (nt,C,cnt) -> let(
            n := nt.params[1],
            b := cnt[1].params[2],
            c := cnt[1].params[1]/b,
            k := nt.params[2]/b,
            m := nt.params[1]/(k*b*c),
            r := nt.params[3],
            s := nt.params[4],
            v := nt.firstTag().v,
#            garbage:=fPrint(["n:",n," b:",b," c:",c," k:",k," m:",m," r:",r," s:",s, " v:",v,"\n"]),
            prefactor := When(r = 1, [], [I(r)]),
            firstfactor := When(m = 1 or (b = 1 and k = 1),
                [],
                [When(c=1,L(k*b*m,b*k), VTensor(Tensor(L(k*b*m,b*k),I(c/v)),v))]
            ),
            middlefactor := [ Tensor(I(m), Tensor(I(k), C[1])) ],
#            middlefactor:=When(k>1 and b*c<1024,[Tensor(I(m),I(k/2),BB(Tensor(I(2),C[1])))],[Tensor(I(m),Tensor(I(k),C[1]))]),
            thirdfactor := When(c=1 or k=1,
                [],
                [
                    When(b=1,
                        Tensor(I(m),L(k*c,k)),
                        VTensor(Tensor(I(m),L(k*c,k),I(b/v)),v)
                    )
                ]
            ),
            postfactor := When(r=s, [], [I(s)]),

            Tensor(Concat(
                prefactor,
                [Compose(Concat(
                    firstfactor,
                    middlefactor,
                    thirdfactor
                ))],
                postfactor
            ))
        )
#D       applicable := (self, nt)>> FirstTagEq(nt, AVecReg) and (nt.params[1]<>nt.params[2]) and (nt.params[2]<>1) and
#D           (Length(DoubleDivisorPairsVectorBlocking(nt.params[1]/nt.params[2],nt.params[2],GetFirstTag(nt).v))>0),
#D       freedoms := nt -> [MapN(DoubleDivisorPairsVectorBlocking(nt.params[1]/nt.params[2],nt.params[2],GetFirstTag(nt).v),(m,c,k,b) -> [b,c])],
#D       child := (nt,freedoms) -> let(b:=freedoms[1][1],c:=freedoms[1][2], [TL(b*c,b,1,1,GetTags(nt))]),
#D       apply := (nt,C,cnt) -> let(
#D       n:=nt.params[1],b:=cnt[1].params[2],c:=cnt[1].params[1]/b,k:=nt.params[2]/b,m:=nt.params[1]/(k*b*c),r:=nt.params[3],s:=nt.params[4],v:=GetFirstTag(nt).v,
#D#       garbage:=fPrint(["n:",n," b:",b," c:",c," k:",k," m:",m," r:",r," s:",s, " v:",v,"\n"]),
#D       prefactor  :=When(r=1, [], [I(r)]),
#D       firstfactor:=When(m=1 or (b=1 and k=1), [],[When(c=1,L(k*b*m,b*k), VTensor(Tensor(L(k*b*m,b*k),I(c/v)),v))]),
#D       middlefactor:=[Tensor(I(m),Tensor(I(k),C[1]))],
#D#      middlefactor:=When(k>1 and b*c<1024,[Tensor(I(m),I(k/2),BB(Tensor(I(2),C[1])))],[Tensor(I(m),Tensor(I(k),C[1]))]),
#D       thirdfactor:=When(c=1 or k=1, [], [When(b=1,Tensor(I(m),L(k*c,k)), VTensor(Tensor(I(m),L(k*c,k),I(b/v)),v))]),
#D       postfactor :=When(r=s, [], [I(s)]),
#D       Tensor(Concat(
#D           prefactor,
#D           [Compose(Concat(
#D               firstfactor,
#D               middlefactor,
#D               thirdfactor))
#D           ],
#D           postfactor))))
    )
));

######################################################################
#  OBSOLETE RULES
######################################################################

NewRulesFor(TL,rec(

    # L^nv_n -> (I_n/v x L^v2_v)(L^n_n/v x I_v)
    # superseeded by L_mn_m_vec with n=v
    L_nv_n_vec := rec(
        switch := false,
        forTransposition := false,
        applicable := t ->
            t.params[3] = 1
            and t.params[4] = 1
            and (t.isTag(1, AVecReg) or t.isTag(1, AVecRegCx))
            and let (v := t.firstTag().v,
                t.params[1] = t.params[2] * v
                and t.params[2] <> v
                and IsInt(t.params[2]/v)
            ),
        freedoms := (self, t) >> [],
        child := (nt,freedoms) -> let(
            v := nt.firstTag().v,
            [ TL(v*v, v, 1, 1).withTags(nt.getTags()) ]
        ),
        apply := (nt, C, cnt) -> let (
            v := nt.firstTag().v,
            n := nt.params[2],
            SymSPL(
                BlockVPerm(n/v, v, C[1], L(v^2,v))
            ) * VTensor(L(n, n/v), v)
        )
#D       applicable := (self, t) >> t.params[3] = 1 and t.params[4] = 1 and FirstTagEq(t, AVecReg) and
#D                         let (v := GetFirstTag(t).v, t.params[1] = t.params[2] * v and t.params[2] <> v and IsInt(t.params[2]/v)),
#D       freedoms := (self, t) >> [],
#D       child := (nt,freedoms) -> let (v := GetFirstTag(nt).v, [TL(v*v, v, 1, 1, GetTags(nt))]),
#D       apply := (nt,C,cnt) -> let (v := GetFirstTag(nt).v, n:= nt.params[2], SymSPL(BlockVPerm(n/v, v, C[1], L(v^2,v))) * VTensor(L(n, n/v), v))),
   #SymSPL-BlockVPerm can be replaced by Tensor(I(n/v), C[1])
    ),

   #L^nv_v -> (L^n_v x I_v)(I_n/v x L^v2_v)
   # superseeded by L_mn_m_vec with m=v
   L_nv_v_vec := rec(
       switch := false,
       forTransposition := false,
       applicable := t ->
            t.params[3] = 1
            and t.params[4] = 1
            and (t.isTag(1, AVecReg) or t.isTag(1, AVecRegCx))
            and let(v := t.firstTag().v,
                t.params[2] = v
                and t.params[1] <> v * v
                and IsInt(t.params[1]/(v*v))
            ),
       freedoms := (self, t) >> [],
       child := (nt, freedoms) -> let(v := nt.firstTag().v, [ TL(v*v, v, 1, 1).withTags(nt.getTags()) ]),
       apply := (nt, C, cnt) -> let(
            v := nt.firstTag().v,
            n:= nt.params[1]/v,
            VTensor(L(n, v), v)
            * SymSPL(BlockVPerm(n/v, v, C[1], L(v^2,v)))
        )
#D       applicable := (self, t) >> t.params[3] = 1 and t.params[4] = 1 and FirstTagEq(t, AVecReg) and
#D                        let (v := GetFirstTag(t).v, t.params[2] = v and t.params[1] <> v * v and IsInt(t.params[1]/(v*v))),
#D       freedoms := (self, t) >> [],
#D       child := (nt,freedoms) -> let (v := GetFirstTag(nt).v, [TL(v*v, v, 1, 1, GetTags(nt))]),
#D       apply := (nt,C,cnt) -> let (v := GetFirstTag(nt).v, n:= nt.params[1]/v, VTensor(L(n, v), v) * SymSPL(BlockVPerm(n/v, v, C[1], L(v^2,v))))),
   #SymSPL-BlockVPerm can be replaced by Tensor(I(n/v), C[1])))
    )

));


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

#F Perm_CCS(<n>) - SPL objects for CCS -> Perm IPP data format conversion
#F
#F Returns an SPL object that converts the result of an RDFT in CCS format into
#F Perm format. Both of these formats are defined in the IPP manual.
#F IPP manual does not define Perm format for odd RDFT size, so in this case
#F we defined it to coincide with CCS.
#F
#F The output of SPIRAL's PRDFT transform is equivalent to IPP CCS format.
#F Suggested uses are:
#F     Perm_CCS(n) * PRDFT(n)
#F     IPRDFT(n) * Perm_CCS(n).transpose()
#F
Perm_CCS := n -> When(IsEvenInt(n),
    Gath(H(n+2,n,0,1))*Perm((2,n+1),n+2),
    DirectSum(Mat([[1,0]]), I(n-1))
);

#F Pack_CCS(<n>) - SPL objects for CCS -> Pack IPP data format conversion of RDFT of type 1
#F
#F Returns an SPL object that converts the result of an RDFT in CCS format into
#F Pack format. Both of these formats are defined in the IPP manual.
#F
#F The output of SPIRAL's PRDFT transform is equivalent to IPP CCS format.
#F Suggested uses are:
#F     Pack_CCS(n) * PRDFT(n)
#F     IPRDFT(n) * Pack_CCS(n).transpose()
#F
Pack_CCS := n -> When(IsEvenInt(n),
    DirectSum(Mat([[1,0]]), When(n=2, [], I(n-2)), Mat([[1,0]])),
    DirectSum(Mat([[1,0]]), I(n-1))
);

#F Pack_CCS(<n>) - SPL objects for CCS -> Pack IPP data format conversion of RDFT of type 3
#F
#F [ note that IPP does not have RDFT of type 3, we just use their format terminology ]
#F Returns an SPL object that converts the result of an RDFT in CCS format into
#F Pack format. Both of these formats are defined in the IPP manual.
#F Perm format does not make sense for PRDFT3.
#F
#F The output of SPIRAL's PRDFT3 transform is equivalent to IPP CCS format.
#F Suggested uses are:
#F     Pack_CCS3(n) * PRDFT3(n)
#F     PRDFT3(n).inverse() * Pack_CCS3(n).transpose()
#F
Pack_CCS3 := n -> When(IsEvenInt(n),
    I(n),
    DirectSum(I(n-1), Mat([[1,0]]))
);


############################################################################
##
##  primitive.gi                   IRREDSOL                 Burkhard Höfling
##
##  Copyright © 2003–2016 Burkhard Höfling
##

############################################################################
##
#F  PcGroupExtensionByMatrixAction(<pcgs>, <hom>)
##
##  Let <G> be a finite soluble group with pcgs <pcgs>, and let <hom> be a
##  group hom. $<hom>\colon G \to GL(n, p)$, where $p$ is a prime. Let  $E$
##  denote the split
##  extension of $G$ by $V = \F_p$, where <G> acts on <V> via <hom>.
##  This function returns a record with the following components.
##     ext:   the group $E$ as a new pc group
##     V:     the subgroup $V$ of $E$ corresponding to the vector space
##     C:     a complement of $V$ in $E$ isomorphic with $G$
##     embed: a group homomorphism $G \to E$ with image $C$
##     proj:  a group homomorphism $E \to G$ with kernel $V$
##     pcgsV: an induced pcgs of V (wrt. FamilyPcgs(E)) whose elements
##               correspond to the natural basis elements
##               of the vector space V
##     pcgsC: an induced pcgs of C (wrt. FamilyPcgs(E)) whose elements
##               correspond to the images of pcgs under embed;
##               the elements of pcgsC act on pcgsV as the images of pcgs
##               under hom act on the natural basis of V
##
InstallGlobalFunction(PcGroupExtensionByMatrixAction,
    function(pcgs, hom)
        local p, d, ros, f, coll, exp, mat, i, j, r, E, pcgsC, pcgsV;

        p := Size(FieldOfMatrixGroup(Range(hom)));
        d := DegreeOfMatrixGroup(Range(hom));
        if not IsPrimeInt(p) then
            Error("Range(hom) must be over a prime field ");
        fi;

        ros := RelativeOrders(pcgs);

        f := FreeGroup(Length(pcgs) + d);
        coll := SingleCollector(f,
            Concatenation(ros,
                ListWithIdenticalEntries(d, p)));

        # relations for complement - same as for those for G
        exp := [];
        exp{[1,3..2*Length(pcgs)-1]} := [1..Length(pcgs)];
        for i in [1..Length(pcgs)] do
            exp{[2,4..2*Length(pcgs)]} := ExponentsOfPcElement(pcgs, pcgs[i]^ros[i]);
            # Print("power relation ", i,": ", exp, "\n");
            SetPower(coll, i, ObjByExtRep(FamilyObj(f.1), exp));
            for j in [i+1..Length(pcgs)] do
                exp{[2,4..2*Length(pcgs)]} := ExponentsOfPcElement(pcgs, pcgs[j]^pcgs[i]);
                # Print("conj. relation ", j, "^", i,": ", exp, "\n");
            SetConjugate(coll, j, i, ObjByExtRep(FamilyObj(f.1), exp));
            od;
        od;

        # relations for socle
        for j in [1..d] do
            SetPower(coll, j+Length(pcgs), One(f));
        od;

        exp := [];
        exp{[1,3..2*d-1]} :=
            [Length(pcgs) + 1..Length(pcgs) + d];

        for i in [1..Length(pcgs)] do
            mat := ImageElm(hom, pcgs[i]);
            for j in [1..d] do
                exp{[2,4..2*d]} := List(mat[j], IntFFE);
                # Print("conj. relation ", j+ Length(pcgs), "^", i,": ", exp, "\n");
                SetConjugate(coll, j + Length(pcgs), i, ObjByExtRep(FamilyObj(f.1), exp));
            od;
        od;

        E := GroupByRwsNC(coll);
        SetSize(E, Product(ros) * p^d);
        pcgsV := InducedPcgsByPcSequenceNC(FamilyPcgs(E),
            FamilyPcgs(E){[Length(pcgs) + 1..Length(FamilyPcgs(E))]});

        # the following sets attributes/properties which are defined
        # in the CRISP packages

        pcgsC := InducedPcgsByPcSequenceNC(FamilyPcgs(E),
                FamilyPcgs(E){[1..Length(pcgs)]});

        r := rec(
            E := E,
            V := GroupOfPcgs(pcgsV),
            C := GroupOfPcgs(pcgsC),
            pcgsV := pcgsV,
            pcgsC := pcgsC);
        r.embed := GroupHomomorphismByImagesNC(GroupOfPcgs(pcgs), E, pcgs, pcgsC);
        SetIsInjective(r.embed, true);
        SetImagesSource(r.embed, r.C);
        r.proj := GroupHomomorphismByImagesNC(E, GroupOfPcgs(pcgs),
            Concatenation(pcgsC, pcgsV),
            Concatenation(pcgs, ListWithIdenticalEntries(d, OneOfPcgs(pcgs))));
        SetIsSurjective(r.proj, true);
        SetKernelOfMultiplicativeGeneralMapping(r.proj, r.V);
        return r;
    end);

############################################################################
##
#F  PrimitivePcGroupIrreducibleMatrixGroup(<G>)
##
##  see IRREDSOL documentation
##
InstallGlobalFunction(PrimitivePcGroupIrreducibleMatrixGroup,
    function(G)

        if not IsMatrixGroup(G) or not IsFinite(FieldOfMatrixGroup(G))
                or not IsPrimeInt(Size(FieldOfMatrixGroup(G)))
                or not IsIrreducibleMatrixGroup(G) then
            Error("G must be an irreducible matrix group over a prime field");
        fi;

        return PrimitivePcGroupIrreducibleMatrixGroupNC(G);
    end);

############################################################################
##
#F  PrimitivePcGroupIrreducibleMatrixGroupNC(<G>)
##
##  see IRREDSOL documentation
##
##  it is important that the map from Pcgs(Source(RepresentationIsomorphism(G)))
##
InstallGlobalFunction(PrimitivePcGroupIrreducibleMatrixGroupNC,
    function(G)

        local rep, ext;

        rep := RepresentationIsomorphism(G);
        ext := PcGroupExtensionByMatrixAction(Pcgs(Source(rep)), rep);
        SetSocle(ext.E, ext.V);
        SetSocleComplement(ext.E, ext.C);
        SetFittingSubgroup(ext.E, ext.V);

        # the following sets attributes/properties which are defined
        # in the CRISP packages

        if IsBoundGlobal("SetIsPrimitiveSoluble") then
            ValueGlobal("SetIsPrimitiveSoluble")(ext.E, true);
        fi;
        return ext.E;

    end);

############################################################################
##
#F  PrimitivePcGroup(<n>,<p>,<d>,<k>)
##
##  see IRREDSOL documentation
##
InstallGlobalFunction(PrimitivePcGroup,
    function(n, p, d, k)

        local q, desc, G, mat, bas, hom, ext, o, pcgs, pcgsC, pcgsV, H;

        if not IsPosInt(n) or not IsPosInt(d) or not IsPosInt(p) or not IsPrimeInt(p) or n mod d <> 0 then
            Error("n, p, and d must be positive integers, ",
                "p must be a prime, and d must divide n");
        elif not k in IndicesIrreducibleSolubleMatrixGroups(n, p, d) then
            Error("k must be in IndicesIrreducibleSolubleMatrixGroups(n, p, d)");
        else
            n := n /d;
            q := p^d;
            LoadAbsolutelyIrreducibleSolubleGroupData(n, q);
            if n > 1 then
                desc := IRREDSOL_DATA.GROUPS[n][q][k];
            fi;
            if not IsBound(IRREDSOL_DATA.PRIM_GUARDIANS[n]) then
                IRREDSOL_DATA.PRIM_GUARDIANS[n] := [];
            fi;
            if not IsBound(IRREDSOL_DATA.PRIM_GUARDIANS[n][q]) then
                if n = 1 then
                    G := IRREDSOL_DATA.GUARDIANS[1][q][1];
                    mat := [[Z(q)]];
                    hom := GroupHomomorphismByImagesNC(G, Group(mat),
                        MinimalGeneratingSet(G), [mat]);
                    SetIsBijective(hom, true);
                else
                    hom := IRREDSOL_DATA.GUARDIANS[n][q][desc[1]][3];
                    G := Source(hom);
                fi;
                if d > 1 then
                    bas := CanonicalBasis(AsVectorSpace(GF(p), GF(q)));
                    mat := List(InducedPcgsWrtFamilyPcgs(G),
                        g -> BlownUpMat(bas, ImageElm(hom, g)));
                    hom := GroupHomomorphismByImagesNC(G, Group(mat),
                        InducedPcgsWrtFamilyPcgs(G), mat);
                fi;

                IRREDSOL_DATA.PRIM_GUARDIANS[n][q] :=
                    PcGroupExtensionByMatrixAction(InducedPcgsWrtFamilyPcgs(G), hom);

            fi;
            ext := IRREDSOL_DATA.PRIM_GUARDIANS[n][q];
            if n = 1 then
                Assert(1, Length(MinimalGeneratingSet(ext.C)) = 1);
                o := IRREDSOL_DATA.GROUPS_DIM1[q][k][1];
                pcgsC := InducedPcgsByGenerators(FamilyPcgs(ext.E),
                    [MinimalGeneratingSet(ext.C)[1]^((q-1)/o)]);
            else
                pcgsC := CanonicalPcgsByNumber(ext.pcgsC, desc[2]);
            fi;
            pcgs := InducedPcgsByPcSequenceNC(FamilyPcgs(ext.E), Concatenation(pcgsC, ext.pcgsV));
            H := GroupOfPcgs(pcgs);
            SetIdPrimitiveSolubleGroup(H, [n*d,p,d,k]);
            SetSocle(H, ext.V);
            SetFittingSubgroup(H, ext.V);
            SetSocleComplement(H, GroupOfPcgs(pcgsC));

            # the following sets attributes/properties which are defined
            # in the CRISP packages

            if IsBoundGlobal("SetIsPrimitiveSoluble") then
                ValueGlobal("SetIsPrimitiveSoluble")(H, true);
            fi;
            return H;
        fi;
    end);

############################################################################
##
#F  IrreducibleMatrixGroupPrimitiveSolubleGroup(<G>)
##
##  see IRREDSOL documentation
##
InstallGlobalFunction(IrreducibleMatrixGroupPrimitiveSolubleGroup,
    function(G)

        local F, p, matgrp, compl;

        if not IsFinite(G) or not IsSolvableGroup(G) then
            Error("G must be finite and soluble");

        # test if primitive - use the CRISP method if it is available
        elif IsBoundGlobal("IsPrimitiveSoluble")
                 and ValueGlobal("IsPrimitiveSoluble")(G) then
            return IrreducibleMatrixGroupPrimitiveSolubleGroupNC(G);

        else # test for primitivity
            F := FittingSubgroup(G);

            if not IsPGroup(F)  or not IsAbelian(F) then
                Error("G must be primitive");
            else
                p := PrimePGroup(F);

                if ForAny(GeneratorsOfGroup(F), x -> x^p <> One(G)) then
                    Error("G must be primitive");
                else
                    matgrp := IrreducibleMatrixGroupPrimitiveSolubleGroupNC(G);
                    if not IsIrreducibleMatrixGroup(matgrp, GF(p)) then
                        Error("G must be primitive");
                    else
                        compl := ComplementClassesRepresentatives(G, F);
                        if Length(compl) <> 1 then
                            Error("G must be primitive");
                        fi;
                        SetSocle(G, F);
                        return matgrp;
                    fi;
                fi;
            fi;
        fi;
    end);

############################################################################
##
#F  IrreducibleMatrixGroupPrimitiveSolubleGroupNC(<G>)
##
##  see IRREDSOL documentation
##
InstallGlobalFunction(IrreducibleMatrixGroupPrimitiveSolubleGroupNC,
    function(G)

        local N, p, F, pcgsN, pcgsGmodN, GmodN, one, mat, mats, g, h, i, H, hom;

        N := FittingSubgroup(G);

        pcgsN := Pcgs(N);
        p := RelativeOrders(pcgsN)[1];
        F := GF(p);
        one := One(F);

        mats := [];

        pcgsGmodN := ModuloPcgs(G, N);
        for g in pcgsGmodN do
            mat := [];
            for i in [1..Length(pcgsN)] do
                mat[i] := ExponentsOfPcElement(pcgsN, pcgsN[i]^g)*one;
            od;
            Add(mats, ImmutableMatrix(F, mat));
        od;
        H := Group(mats);
        SetSize(H, Size(G)/Size(N));
        GmodN := PcGroupWithPcgs(pcgsGmodN);
        hom := GroupGeneralMappingByImagesNC(GmodN, H, FamilyPcgs(GmodN), mats);
        SetIsGroupHomomorphism(hom, true);
        SetIsBijective(hom, true);
        SetRepresentationIsomorphism(H, hom);
        return H;
    end);

############################################################################
##
#F  DoIteratorPrimitiveSolubleGroups(<convert_func>, <arg_list>)
##
##  generic constructor function for an iterator of all primitive soluble groups
##  which can construct permutation groups or pc groups (or other types of groups),
##  depending on convert_func
##
InstallGlobalFunction(DoIteratorPrimitiveSolubleGroups,
    function(convert_func, arg_list)

        local r, iter;

        r := CheckAndExtractArguments([
            [[Degree, NrMovedPoints, LargestMovedPoint], IsPosInt],
            [[Order, Size], IsPosInt]],
            arg_list,
            "IteratorPrimitivePcGroups");
        if ForAny(r.specialvalues, v -> IsEmpty(v)) then
            return Iterator([]);
        fi;

        iter := rec(convert_func := convert_func);

        if not IsBound(r.specialvalues[1]) then
            Error("IteratorPrimitivePcGroupsIterator: You must specify the degree(s) of the desired primitive groups");
        else
            iter.degs := Filtered(r.specialvalues[1], IsPPowerInt);
        fi;

        iter.degind := 0;

        if IsBound(r.specialvalues[2]) then
            iter.orders := r.specialvalues[2];
        else
            iter.orders := fail;
        fi;

        iter.iteratormatgrp := Iterator([]);

        iter.IsDoneIterator := function(iterator)

            local d, p, n, orders, o;

            if iterator!.degind > Length(iterator!.degs) then
                Error("isDoneIterator called after it returned true");
            fi;

            while IsDoneIterator(iterator!.iteratormatgrp) do
                iterator!.degind := iterator!.degind + 1;
                if iterator!.degind > Length(iterator!.degs) then
                    return true;
                fi;
                d := iterator!.degs[iterator!.degind];
                p := SmallestRootInt(d);
                n := LogInt(d, p);
                if IsAvailableIrreducibleSolubleGroupData(n, p) then
                    if iterator!.orders <> fail then
                        orders := [];
                        for o in iterator!.orders do
                            if o mod d = 0 then
                                Add(orders, o/d);
                            fi;
                        od;
                        iterator!.iteratormatgrp := IteratorIrreducibleSolubleMatrixGroups(
                            Degree, n, Field, GF(p), Order, orders);
                    else
                        iterator!.iteratormatgrp := IteratorIrreducibleSolubleMatrixGroups(
                            Degree, n, Field, GF(p));

                    fi;
                else
                    Error("groups of degree ", d, " are beyond the scope of the IRREDSOL library");
                    iterator!.iteratormatgrp := Iterator([]);
                fi;
            od;
            return false;
        end;

        iter.NextIterator := function(iterator)

            local G;

            G := NextIterator(iterator!.iteratormatgrp);
            return iterator!.convert_func(G);
        end;

        iter.ShallowCopy := function(iterator)
            return rec(
                orders := iterator!.orders,
                degs := iterator!.degs,
                degind := iterator!.degind,
                convert_func := iterator!.convert_func,
                iteratormatgrp := ShallowCopy(iterator!.iteratormatgrp),
                IsDoneIterator := iterator!.IsDoneIterator,
                NextIterator := iterator!.NextIterator,
                ShallowCopy := iterator!.ShallowCopy);
        end;
        return IteratorByFunctions(iter);
    end);

############################################################################
##
#F  IteratorPrimitivePcGroups(<func_1>, <val_1>, ...)
##
##  see the IRREDSOL manual
##
InstallGlobalFunction(IteratorPrimitivePcGroups,
    function(arg)
        return DoIteratorPrimitiveSolubleGroups(
            PrimitivePcGroupIrreducibleMatrixGroupNC,
            arg);
    end);

###########################################################################
##
#F  AllPrimitivePcGroups(<arg>)
##
##  see IRREDSOL documentation
##
InstallGlobalFunction(AllPrimitivePcGroups,
    function(arg)

        local iter, l, G;

        iter := CallFuncList(IteratorPrimitivePcGroups, arg);

        l := [];
        for G in iter do
            Add(l, G);
        od;
        return l;
    end);

###########################################################################
##
#F  OnePrimitivePcGroup(<arg>)
##
##  see IRREDSOL documentation
##
InstallGlobalFunction(OnePrimitivePcGroup,
    function(arg)

        local iter;

        iter := CallFuncList(IteratorPrimitivePcGroups, arg);
        if IsDoneIterator(iter) then
            return fail;
        else
            return NextIterator(iter);
        fi;
    end);

############################################################################
##
#F  PrimitivePermGroupIrreducibleMatrixGroup(<G>)
##
##  see IRREDSOL documentation
##
InstallGlobalFunction(PrimitivePermGroupIrreducibleMatrixGroup,
    function(G)

        if not IsMatrixGroup(G) or not IsFinite(FieldOfMatrixGroup(G))
                or not IsPrimeInt(Size(FieldOfMatrixGroup(G)))
                or not IsIrreducibleMatrixGroup(G) then
            Error("G must be an irreducible matrix group over a prime field");
        fi;

        return PrimitivePermGroupIrreducibleMatrixGroupNC(G);
    end);

############################################################################
##
#F  PrimitivePermGroupIrreducibleMatrixGroupNC(<G>)
##
##  see IRREDSOL documentation
##
InstallGlobalFunction(PrimitivePermGroupIrreducibleMatrixGroupNC,
    function( M )
        local  gensc, genss, V, bas, enum, G;
        V := FieldOfMatrixGroup( M ) ^ DimensionOfMatrixGroup( M );
        bas := CanonicalBasis(V);
        enum := EnumeratorByBasis(bas);
        gensc := List(GeneratorsOfGroup(M), x -> Permutation(x, enum));
        genss := List( bas, x -> Permutation( x, enum, \+));
        G := GroupByGenerators(Concatenation(genss, gensc));
        SetSize( G, Size( M ) * Size( V ) );
        SetSocle(G, Subgroup(G, genss));
        SetSocleComplement(G, Subgroup(G, gensc));

        # the following sets attributes/properties which are defined
        # in the CRISP packages

        if IsBoundGlobal("SetIsPrimitiveSoluble") then
            ValueGlobal("SetIsPrimitiveSoluble")(G, true);
        fi;
         return G;
    end);

############################################################################
##
#F  PrimitiveSolublePermGroup(<n>,<p>,<d>,<k>)
##
##  see IRREDSOL documentation
##
InstallGlobalFunction(PrimitiveSolublePermGroup,
    function(n, p, d, k)

        local G;
        if not IsPosInt(n) or not IsPosInt(d) or not IsPosInt(p) or not IsPrimeInt(p) then
            Error("n, p, and d must be positive integers, ",
                "p must be a prime, and d must divide n");
        elif not k in IndicesIrreducibleSolubleMatrixGroups(n, p, d) then
            Error("k must be in IndicesIrreducibleSolubleMatrixGroups(n, p, d)");
        else
            G := PrimitivePermGroupIrreducibleMatrixGroupNC(
                    IrreducibleSolubleMatrixGroup(n, p, d, k));
            SetIdPrimitiveSolubleGroup(G, [n,p,d,k]);
        fi;
        return G;
     end);

############################################################################
##
#F  IteratorPrimitiveSolublePermGroups(<func_1>, <val_1>, ...)
##
##  see the IRREDSOL manual
##
InstallGlobalFunction(IteratorPrimitiveSolublePermGroups,
    function(arg)
        return DoIteratorPrimitiveSolubleGroups(
            PrimitivePermGroupIrreducibleMatrixGroupNC,
            arg);
    end);

###########################################################################
##
#F  AllPrimitiveSolublePermGroups(<arg>)
##
##  see IRREDSOL documentation
##
InstallGlobalFunction(AllPrimitiveSolublePermGroups,
    function(arg)

        local iter, l, G;

        iter := CallFuncList(IteratorPrimitiveSolublePermGroups, arg);

        l := [];
        for G in iter do
            Add(l, G);
        od;
        return l;
    end);

###########################################################################
##
#F  OnePrimitiveSolublePermGroup(<arg>)
##
##  see IRREDSOL documentation
##
InstallGlobalFunction(OnePrimitiveSolublePermGroup,
    function(arg)

        local iter;

        iter := CallFuncList(IteratorPrimitiveSolublePermGroups, arg);
        if IsDoneIterator(iter) then
            return fail;
        else
            return NextIterator(iter);
        fi;
    end);

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


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

#F Circulant(<n>, <filt-func>, <valuation>) -- n x n  circulant matrix non-terminal
#F
#F The circulant matrix with coefficients of the first row given by
#F the filter function <filt-func>.
#F
#F <valuation> is the offset, default = 0, meaning no offset.
#F
#F Examples:
#F
#F spiral> PrintMat(MatSPL( Circulant(5, FList(TInt, [1..3]), 0)));
#F [ [ 1, 2, 3,  ,   ],
#F   [  , 1, 2, 3,   ],
#F   [  ,  , 1, 2, 3 ],
#F   [ 3,  ,  , 1, 2 ],
#F   [ 2, 3,  ,  , 1 ] ]
#F spiral> PrintMat(MatSPL( Circulant(5, FList(TInt, [1..3]), -1)));
#F [ [ 2, 3,  ,  , 1 ],
#F   [ 1, 2, 3,  ,   ],
#F   [  , 1, 2, 3,   ],
#F   [  ,  , 1, 2, 3 ],
#F   [ 3,  ,  , 1, 2 ] ]

Class(Circulant, NonTerminal, rec(
    _short_print := true,

    abbrevs := [
     (L)     -> [ toSize(L), toFunc(L), toValuation(L) ],
     (n,L)   -> [ Checked(IsPosInt(n), n), toFunc(L), toValuation(L) ],
     (n,L,v) -> [ Checked(IsPosInt(n), n), toFunc(L), Checked(IsInt(v), v) ],
    ],

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

    setData := meth(self, newdata) self.params[2] := newdata; return self; end,

    column := self >> let(
	coeffs := List(self.params[2].tolist(), x->x.ev()),
	valuation := self.params[3],
	CircularWrap([coeffs, valuation], self.params[1])),

    terminate := meth(self)
      local i, j, n, L, Ls, mat;
      L := self.column();
      n := Length(L);
      mat := [ ];
      for i in [0..n-1] do
          Ls := Replicate(n, 0);
	  for j in [0..n-1] do Ls[(i-j) mod n + 1] := L[j+1]; od;
	  Add(mat,Ls);
      od;
      return Mat(mat);
    end,

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

    transpose := self >> Circulant(
	self.params[1],
	fCompose(self.params[2], J(self.filtlen())),
	-self.params[3]-self.filtlen()+1),

    isReal := self >> not IsComplexT(self.params[2].range()),

    hashAs := self >> let(
	t := ObjId(self)(
	    self.params[1], fUnk(self.params[2].range(), self.params[2].domain()), self.params[3]),
	When(self.transposed, t.transpose(), t)),

    SmallRandom := () -> let(n := Random([2..16]),
	List([1..n], i -> Float(Random([-2^10..2^10]), Random([-20..10])))),

    LargeRandom := () -> let(n := Random([16, 32, 64]),
	List([1..n], i -> Float(Random([-2^10..2^10]), Random([-20..10]))))
));

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

    #F Circulant_Base: (base case)
    #F
    Circulant_Base := rec (
	info             := "Circulant -> Mat",
	forTransposition := false,
	isApplicable     := P -> P[1] <= 32,
	allChildren      := P -> [[ ]],
	rule := (P, C) -> ApplyFunc(Circulant, P).terminate()
    ),

#     Circulant_toFilt := rec (
# 	info             := "Circulant -> VStack(.., Filt, ...)",
# 	forTransposition := false,
# 	isApplicable     := P -> P[1] > 2 and (P[1]-P[2].domain()) > 2 and P[2].domain() <= 32 and P[3] <= 0,
# 	allChildren      := P -> let(
# 	    n := P[1], l := -P[3], r := P[3] + P[2].domain() - 1,
# 	    [[ Filt(n-l-r, Poly(List(P[2].tolist(),EvalScalar), P[3])) ]]),

# 	rule := (P, C) -> let(
# 	    coeffs := P[2], nc := coeffs.domain(), n := P[1], l := -P[3],
# 	    r := -l + nc - 1,
# 	    j := Ind(l), k := Ind(r), v := Ind(nc),
# 	    VStack(
# 		BB(ISum(j, j.range,
# 		    Scat(fBase(j)) *
# 		    RowVec(fCompose(coeffs, Lambda(v, cond(leq(v,r+j), v-j+l, v-j+l-nc))))) *
# 		    Gath(n, nc,	Lambda(v, cond(leq(v,r+j), v, v+(n-l-r)-1 )))),
# 		C[1],
# 		BB(ISum(k, k.range,
# 		    Scat(fBase(k)) *
# 		    RowVec(fCompose(coeffs, Lambda(v, cond(leq(v,k), v-k+(nc-1), v-k-1)))) *
# 		    Gath(n, nc, Lambda(v, cond(leq(v,k), v, v+(n-l-r)-1 )))))))
#     ),

    #F Circulant_Blocking
    #F
    #F Circulant -> Blocks (Toeplitzes)
    #F
    #F Circulant is partitioned into square blocks of sizes
    #F given by all proper divisors of the input size.
    #F
    #F NOTE: this rule is invalid, Circulant_BlockingDense seems valid
    #F        whats the difference between the two ???
    Circulant_Blocking := rec(
	info             := "Circulant -> Toeplitz",
	forTransposition := false,
	isApplicable     := P -> let(n := P[1],
	    n > 2 and not IsPrime(n)), # and n <= 2*Length(P[2])),

	allChildren := P -> let(
	    divs := DivisorPairs(P[1]),
	    ratio := P[2].domain() / P[1],
	    List(divs, d -> [ Toeplitz(FUnk(2*d[1]-1), 0, CeilingRat(ratio * (2*d[1]-1))) ])
	),

        prepData := (self, L, b, nc) >> let(
	    n := Length(L),
	    Concatenation(
		List([1..nc], k ->
		    List([1..2*b-1], j -> L[((n-k*b+j) mod n) + 1])))),

	rule := (self,P,C,Nonterms) >> let(
	    n    := P[1],
	    b    := Rows(C[1]),
	    nc   := n/b,
	    new_data := FData(self.prepData(ApplyFunc(Circulant, P).column(), b, nc)),
	    i := Ind(nc),
	    k := Ind(nc),
	    ofs := DataInd(TInt, nc * (2*b-1)).setAttr("live_out"),
	    bnum := DataInd(TInt, nc).setAttr("live_out"),
	    gfunc := fCompose(new_data, fAdd(nc*(2*b-1), 2*b-1, ofs)),

	    len := P[2].domain(),
	    val := P[3] mod n,
	    btoep_len := 2*b-1,

	    left := val,
	    right := When(len+b >= n, val-1, (val + (len-1) + (b-1)) mod n),
	    exact_right := (val + (len-1)) mod n,

	    # we "quantize" the condition to tell us which block #s (ofs) are 0
	    lblock := btoep_len * Int(left/b),
	    rblock := btoep_len * Int(right/b),

	    rproj := b*bnum + (b - 1 - left),
	    lproj := b*bnum + (b - 1 - exact_right),
	    nt    := Nonterms[1].setData(gfunc)
	                        .setNonZero(lproj, rproj),

	    open   := leq(rblock+1, lblock),
	    A := leq(lblock, ofs),
	    B := leq(ofs, rblock),
	    isNonZero := logic_or(logic_and(A, B), logic_and(open, logic_or(A, B))),

	    ISum(i, i.range,
		Scat(fTensor(fBase(i), fId(b))) *
		ISumAcc(k, k.range,
		    Data(bnum, imod(nc+k-i, nc),
			Data(ofs, (2*b-1)*bnum,
			    COND(isNonZero, C[1], O(b)))) *
		    Gath(fTensor(fBase(k), fId(b)))))
        )
        # RowDirectSum( nc*b, List([1..nc], i->
        # ColDirectSum( b, List([1..nc], k-> C[((k-i) mod nc) + 1]))))
    ),

    #F Circulant_BlockingDense
    #F
    #F Circulant -> Blocks (Toeplitzes)
    #F
    #F Circulant is partitioned into square blocks of sizes
    #F given by all proper divisors of the input size.
    #F
    Circulant_BlockingDense := rec(
	info             := "Circulant -> Toeplitz",
	forTransposition := false,
	isApplicable     := P -> let(n := P[1],
	    n > 2 and not IsPrime(n) and n <= 2*P[2].domain()),

	allChildren := P -> let(
	    divs := DivisorPairs(P[1]),
	    ratio := P[2].domain() / P[1],
	    List(divs, d -> [ Toeplitz(FUnk(2*d[1]-1), 0, CeilingRat(ratio * (2*d[1]-1))) ])
	),

        prepData := (self, L, b, nc) >> let(
	    n := Length(L),
	    Concatenation(
		List([1..nc], k ->
		    List([1..2*b-1], j -> L[((n-k*b+j) mod n) + 1])))),

	rule := (self,P,C,Nonterms) >> let(
	    n    := P[1],
	    b    := Rows(C[1]),
	    nc   := n/b,
	    new_data := FData(self.prepData(ApplyFunc(Circulant, P).column(), b, nc)),
	    i := Ind(nc),
	    k := Ind(nc),
	    ofs := DataInd(TInt, nc * (2*b-1)).setAttr("live_out"),
	    bnum := DataInd(TInt, nc).setAttr("live_out"),

	    gfunc := fCompose(new_data, fAdd(nc*(2*b-1), 2*b-1, ofs)),

	    len := P[2].domain(),
	    val := P[3] mod n,
	    left := val,
	    exact_right := (val + (len-1)) mod n,

	    rproj := b*bnum + (b - 1 - left),
	    lproj := b*bnum + (b - 1 - exact_right),
	    nt    := Nonterms[1].setData(gfunc)
	                        .setNonZero(lproj, rproj),

	    ISum(i, i.range,
		Scat(fTensor(fBase(i), fId(b))) *
		ISumAcc(k, k.range,
		    Data(bnum, imod(nc+k-i, nc),
			Data(ofs, (2*b-1)*bnum,
			    C[1])) *
		    Gath(fTensor(fBase(k), fId(b)))))
        )
        # RowDirectSum( nc*b, List([1..nc], i->
        # ColDirectSum( b, List([1..nc], k-> C[((k-i) mod nc) + 1]))))
    ),

    #F Circulant_DiagonalizeStep
    #F
    #F Circulant_n -> (F2 tensor I2)
    #F                (Circulant_n/2 dirsum Toeplitz_n/2)
    #F                (F2 tensor I2)
    #F
    #F Computes circulant matrix through DFT.
    #F h is the first column of the circulant
    #F (params of Circulant nonterminal).
    #F
    Circulant_DiagonalizeStep := rec(
	info             := "Circulant_n -> Circulant_n/2 dirsum Toeplitz_n/2",
	forTransposition := false,
	isApplicable     := P -> let(n := P[1],
	    n > 2 and n mod 2 = 0 and n<=16),

	allChildren := P -> let(n := P[1],
	     [[ Circulant(FUnk(n/2)), Toeplitz(FUnk(n-1)) ]]),

	prepData := function(L)
	    local l, L1, L2, circ, toep;
	    l := Length(L);
	    L1 := L{[1     .. l/2]}; # first half
	    L2 := L{[l/2+1 ..  l ]}; # second half

	    circ := 1/2 * (L1 + L2);
	    toep := 1/2 * Concat(Drop(L2,1) - Drop(L1,1),
		                      L1    - L2);
	    return [circ, toep];
	end,

	rule := (self, P, C, Nonterms) >> let(
	    n := P[1],
	    data := self.prepData(ApplyFunc(Circulant,P).column()),
	    circ := Nonterms[1].setData(FData(data[1])),
	    toep := Nonterms[2].setData(FData(data[2])),

	    Tensor(F(2), I(n/2)) *
	    DirectSum(C[1], C[2]) *
	    Tensor(F(2), I(n/2))
	)
    ),

    ###################################################################
    ## Frequency domain methods
    ###################################################################

    #F Circulant_DFT
    #F
    #F Circulant -> invDFT * diag(DFT(h)) * DFT
    #F
    #F Computes circulant matrix through DFT.
    #F h is the first column of the circulant
    #F (params of Circulant nonterminal).
    #F
    Circulant_DFT := rec(
	info             := "Circulant -> invDFT * diag(DFT(h)) * DFT",
	forTransposition := false,
	switch           := false,
	isApplicable     := P -> P[1] > 1,
	allChildren      := P -> [[ transforms.DFT(P[1], -1), transforms.DFT(P[1], 1) ]],

	rule := function(P, C)
            local l, coef, L;
	    L := ApplyFunc(Circulant, P).column();
	    l := Length(L);
	    coef := List([1..l], i -> ComplexAny(L[i]));
	    coef := 1/l * ComplexFFT(coef);
	    return C[1] * Diag(FData(coef)) * C[2];
	end
    ),

    #F Circulant_RDFT
    #F
    #F Circulant -> invRDFT * block(RDFT(h)) * RDFT
    #F
    #F Computes circulant matrix through the Real DFT.
    #F h is the first column of the circulant
    #F (params of nonterminal Circulant).
    #F
    Circulant_RDFT := rec(
	info             := "Circulant -> invRDFT * block(RDFT(h)) * RDFT",
	forTransposition := false,
	switch           := false,

	isApplicable     := P -> let(n := P[1],
	    n > 2 and n <= 64 and (n mod 2 = 0) and
	    ForAll(Factors(n), f -> f in [2, 3])),

	allChildren      := P -> let(n := P[1],
	    [[ RDFT(n).transpose(), RDFT(n) ]]),

	rule := function( P, C )
 	    local i, L, M, X, l, coef, ccoef;

	    L := ApplyFunc(Circulant, P).column();
	    l := Length(L);
	    ccoef := List([1..l], i -> ComplexAny(L[i]));
	    ccoef := ComplexFFT(ccoef);
	    coef  := List([1..Int(l/2)+1], i -> 2/l * ReComplex(ccoef[i]));
	    Append(coef, List([Int(l/2)+2..l], i -> 2/l * (-ImComplex(ccoef[i])) ));

	    X := Diag([ 1/2 * coef[1]]);
	    for i in [2..Int(l/2)] do
	        M := Mat([[coef[i],      coef[l-i+2]],
			  [-coef[l-i+2], coef[i]]]);
		X := DirectSum(X, M);
	    od;
	    if (l mod 2 = 0) then
		X := DirectSum(X, Diag( [1/2 * coef[l/2+1]] ));
	    fi;
	    X := X^perm4(l);
	    return C[1] * X * C[2];
	end
    ),

    #F Circulant_PRDFT
    #F
    #F Circulant -> IPRDFT * diag(PRDFT(h)) * PRDFT
    #F
    #F Computes circulant matrix through the Packed Real DFT.
    #F h is the first column of the circulant
    #F (params of nonterminal Circulant).
    #F
    Circulant_PRDFT := rec(
	info             := " Circulant -> IPRDFT * diag(PRDFT(h)) * PRDFT",
	forTransposition := false,
	switch           := false,

	isApplicable     := P -> true,

	allChildren      := P -> let(n := P[1],
	    [[ IPRDFT(n), PRDFT(n) ]]),

	rule := function( P, C )
 	    local i, n, L, l, coef, D;
	    n := Cols(C[1]);
	    L := ApplyFunc(Circulant, P).column();
	    l := Length(L);
	    coef := List(L, EvalScalar);
	    coef := 1/l * ComplexFFT(coef);
	    D:=Diag(FData(coef{[1..n/2]}));
	    return C[1] * RC(D) * C[2];
	end
    ),

    #F Circulant_DHT
    #F
    #F Circulant -> DHT * block(DHT(h)) * DHT
    #F
    #F Computes circulant matrix through the Discrete Hartley transform.
    #F h is the first column of the circulant
    #F (params of nonterminal Circulant).
    #F
    Circulant_DHT := rec(
	info             := "Circulant -> DHT * block(DHT(h)) * DHT",
	forTransposition := false,
	switch           := false,
	isApplicable     := P -> let(n := P[1], n > 1 and Is2Power(n)),

	allChildren      := P -> let(n := P[1], [[ DHT(n) ]]),

	rule := function(P, C)
	    local i,M,X,l,L,coef,ccoef, rcoef, icoef;
	    L := ApplyFunc(Circulant, P).column();
	    l := Length(L);
	    ccoef := List([1..l], i -> ComplexAny(L[i]));
	    ccoef := ComplexFFT(ccoef);
	    rcoef := List([1..l/2+1], i -> 1/l * ReComplex(ccoef[i]));
	    icoef := List([2..l/2], i -> 1/l * ImComplex(ccoef[i]));
	    X := Diag([rcoef[1]]);
	    for i in [2..Int(l/2)] do
	        M := Mat([[rcoef[i],   -icoef[i-1]],
			  [icoef[i-1], rcoef[i]]]);
		X := DirectSum(X,M);
	    od;
	    X := DirectSum(X, Diag( [rcoef[l/2+1]] ));
	    X := X^perm4(l);
	    return C[1] * X * C[1];
	end
    )
));


n := 1024;
while n > 0 do
    Print(n, "\n");
    n := QuoInt(n, 2);
od;


# In reality we only need a list indexed by triples, so we
# will quite probably end up with a tree where the leaves have
# weights as labels.
InstallGlobalFunction(CyclicSubList,
function(l, pos, len)
    local r, i, j, llen;

    llen := Length(l);
    r := [];
    i := pos; j := 1;
    while j <= len do
        r[j] := l[i];
        i := i + 1; j := j + 1;
        if i > llen then
            i := 1;
        fi;
    od;

    return r;
end);

InstallGlobalFunction( EnterAllSubwords,
function(idx, word, value)
    local i, v, pos, ww;
    pos := [1..Length(word)];
    ww := List(word, x -> __ID(x));
    for i in pos do
        v := idx[ ww{ CyclicSubList(pos, i, 3) } ];
        if value < v then
            idx[ ww{ CyclicSubList(pos, i, 3) } ] := value;
        fi;
    od;
end);

#
InstallGlobalFunction( DigraphDijkstraST,
function(graph, s, t)
    local vertices, dist, prev, queue, u, v, alt;

    dist := [];
    prev := [];
    queue := BinaryHeap({x,y} -> x[1] < y[1]);

    for v in DigraphVertices(graph) do
        dist[v] := infinity;
        prev[v] := -1;
    od;

    dist[s] := 0;
    Push(queue, [0, s]);

    while not IsEmpty(queue) do
        u := Pop(queue);
        u := u[2];
        if u = t then
            return [ dist, prev ];
        fi;
        for v in OutNeighbours(graph)[u] do
            alt := dist[u] + DigraphEdgeLabel(graph, u, v);
            if alt < dist[v] then
                dist[v] := alt;
                prev[v] := u;
                Push(queue, [dist[v], v]);
            fi;
        od;
    od;
    return infinity;
end);

InstallGlobalFunction( DigraphDijkstraS,
function(graph, s)
    local vertices, dist, prev, queue, u, v, alt;

    dist := [];
    prev := [];
    queue := BinaryHeap({x,y} -> x[1] < y[1]);

    for v in DigraphVertices(graph) do
        dist[v] := infinity;
        prev[v] := -1;
    od;

    dist[s] := 0;
    Push(queue, [0, s]);

    while not IsEmpty(queue) do
        u := Pop(queue);
        u := u[2];
        for v in OutNeighbours(graph)[u] do
            alt := dist[u] + DigraphEdgeLabel(graph, u, v);
            if alt < dist[v] then
                dist[v] := alt;
                prev[v] := u;
                Push(queue, [dist[v], v]);
            fi;
        od;
    od;

    return [ dist, prev ];
end);


# SIMT-operators transfer their dim tag info to SIMT-SUM/ISum operators when SPL is lowered to SigmaSPL

Class(SIMTSumsGen, DefaultSumsGen, rec(

    _directSumSIMTSums := (self, obj, roverlap, coverlap, opts) >>
        let(cspans  :=  BaseOverlap.spans(roverlap, List(obj.children(), Cols)),
            rspans  :=  BaseOverlap.spans(coverlap, List(obj.children(), Rows)),
            nblocks  :=  obj.numChildren(),
            C  :=  Cols(obj),
            R  :=  Rows(obj),
            OP  :=  When(coverlap > 0, SUMAcc, SIMTSUM),
            OP( When(OP=SIMTSUM, [obj.simt_dim], []) :: Map([1..nblocks],
                 i -> Compose(
                      WID(R, 1 + rspans[i][2] - rspans[i][1], rspans[i][1]-1),
                      self(obj.child(i), opts),
                      RID(C, 1 + cspans[i][2] - cspans[i][1], cspans[i][1]-1) )))
            ),

    SIMTDirectSum := (self, o, opts) >> Cond(o.isPermutation(),
    Prm(ApplyFunc(fDirsum, List(o.children(), c->self(c, opts).func))),
        self._directSumSIMTSums(o, 0, 0, opts)
    ),

    IDirSum := (self, o, opts) >> let(
        bkcols := Cols(o.child(1)),
        bkrows := Rows(o.child(1)),
        nblocks := o.domain,
        cols := Cols(o),
        rows := Rows(o),

        SIMTISum(o.simt_dim, o.var, o.domain,
            Compose(Scat(fTensor(fBase(nblocks, o.var), fId(bkrows))),
                self(o.child(1), opts),
                Gath(fTensor(fBase(nblocks, o.var), fId(bkcols)))))
    ),

    SIMTTensor := meth(self, o, opts)
        local ch, col_prods, row_prods, col_prods_rev, row_prods_rev, i, j1, j2, j1b, j2b, bkcols, bkrows, prod, term;

        if o.isPermutation() then
            return Prm(ApplyFunc(o.fTensor, List(o.children(), c->self(c, opts).func)));
        elif ForAll(o.children(), x->ObjId(x)=Diag) then
            return Diag(ApplyFunc(diagTensor, List(o.children(), c->c.element)));
        fi;

        ch := o.children();
        col_prods := ScanL(ch, (x,y)->x*Cols(y), 1);
        col_prods_rev := Drop(ScanR(ch, (x,y)->x*Cols(y), 1), 1);

        row_prods := ScanL(ch, (x,y)->x*Rows(y), 1);
        row_prods_rev := Drop(ScanR(ch, (x,y)->x*Rows(y), 1), 1);

        prod := [];
        for i in [1..Length(ch)] do
            if not IsIdentitySPL(ch[i]) then
                bkcols := Cols(ch[i]);
                bkrows := Rows(ch[i]);
                j1 := Ind(col_prods[i]);
                j2 := Ind(row_prods_rev[i]);
                j1b := When(j1.range = 1, 0, fBase(j1));
                j2b := When(j2.range = 1, 0, fBase(j2));

                term := Scat(o.scatTensor(i)(Filtered([j1b, fId(bkrows), j2b], x->x<>0))) *
                        self(ch[i], opts) *
                    Gath(o.gathTensor(i)(Filtered([j1b, fId(bkcols), j2b], x->x<>0)));

#                if j2.range <> 1 then
                    term := SIMTISum(o.simt_dim, j2, j2.range, term);
#                fi;

#                if j1.range <> 1 then
                    term := SIMTISum(o.simt_dim, j1, j1.range, term);
#                fi;

                Add(prod, term);
            fi;
        od;
        return Compose(prod);
    end,

    SIMTISum := (self, o, opts) >> CopyFields(o, rec(_children := [self(o._children[1], opts)])),

    SIMTIDirSum := (self, o, opts) >> let(
        bkcols := Cols(o.child(1)),
        bkrows := Rows(o.child(1)),
        nblocks := o.domain,
        cols := Cols(o),
        rows := Rows(o),

        SIMTISum(o.simt_dim, o.var, o.domain,
            Compose(Scat(fTensor(fBase(nblocks, o.var), fId(bkrows))),
                self(o.child(1), opts),
                Gath(fTensor(fBase(nblocks, o.var), fId(bkcols)))))
    ),

    SIMTVStack := (self, o, opts) >> let(
        ch   := List(o.children(), e -> self(e, opts)),
        l    := Length(ch),
        ofs  := ScanL(ch, (p,x)->p+Rows(x), 0),
        SIMTSUM(o.simt_dim, List([1..l], i ->
            Scat(H(Rows(o), Rows(ch[i]), ofs[i], 1)) * ch[i] * Gath(fId(Cols(o)))))
    ),

    SIMTHStack1 := (self, o, opts) >> let(
        ch   := List(o.children(), e -> self(e, opts)),
        l    := Length(ch),
        it0  := Scat(fId(Rows(o))) * ch[1] * Gath(H(Cols(o), Cols(ch[1]), 0, 1)),
        ofs  := ScanL(ch, (p,x)->p+Cols(x), 0),
        its  := List([2..l], i ->
                   Scat(fId(Rows(o))) * ch[i] * Gath(H(Cols(o), Cols(ch[i]), ofs[i], 1))),
        SIMTSUM(o.simt_dim, [it0] :: its )
    ),

    SIMTIterVStack := (self, o, opts) >> let(
        bkcols := Cols(o.child(1)),
        bkrows := Rows(o.child(1)),
        nblocks := o.domain,
        cols := Cols(o), rows := Rows(o),
        SIMTISum(o.simt_dim, o.var, o.domain,
            Scat(fTensor(fBase(nblocks, o.var), fId(bkrows))) *
            self(o.child(1), opts) *
            Gath(fId(bkcols)))
    ),

    SIMTIterHStack1 := (self, o, opts) >> let(
        bkcols := Cols(o.child(1)),
        bkrows := Rows(o.child(1)),
        nblocks := o.domain,
        cols := Cols(o), rows := Rows(o),
        j := Ind(nblocks),
        ch := self(o.child(1), opts),

        SIMTISum(o.simt_dim, j, j.range,
        Scat(fId(bkrows)) *
        SubstVars(Copy(ch), rec((o.var.id) := j)) *
        Gath(fTensor(fBase(nblocks, j), fId(bkcols)))
        )
    ),

    ));


ITER_POLY_WARN:=false;
Read(Filename(home_dir,"lib/io.gi"));
Read(Filename(home_dir,"handle.gi"));

F:=GF(3^2);
F_gen:=GeneratorsOfField(F)[1];
aaa:=F_gen^2;

sys:=ChevalleyAdj("F",4,F);
alg:=AlgebraicU(sys);
orbs:=UnipotentClasses(alg,"");
infos:=List(AllClasses(orbs),o->handleClassShort(o));
labels:=List(AllClasses(orbs),x->Label(x));

APR:=ring(alg);
avars:=IndeterminatesOfPolynomialRing(APR);
vals:=ShallowCopy(avars);
pr:=positiveRoots(alg);
generic:=Unipotent(alg,List([1..Length(pr)],i->[i,avars[i]]));

Read(Filename(components_dir,"F4char3.gi"));


Read("SchreierSims.gi");
LoadPackage( "AtlasRep" );

MicroSeconds := function()
  local t;
  t := IO_gettimeofday();
  return t.tv_sec * 1000000 + t.tv_usec;
end;

n:=11;

Groups := ["M11", "M23", "M24", "J1", "J2", "J3", "Suz", "Co2", "Fi22"];
#Groups := [120];

for group in Groups do
    counter := 0;
    time := [[],[],[],[]];
    Print("Group: ");  Print(group);
    while counter < 5 do
        G := AtlasGroup(group);
        #G := SymmetricGroup(group);
        S := Set(GeneratorsOfGroup(G)); n := LargestMovedPoint(G); B := [];
        t1 := MicroSeconds();
        BSGS := RandomSchreierSims(B, S, 10, n);
        t2 := (MicroSeconds() - t1) * 1.0 / 1000000;
        RemoveRedundantGens(BSGS, S, n);
        upper_bound := Length(BSGS[1]);
        results := [1..Length(BSGS[1])];

        ## parallelization w.r.t. base
        t1 := MicroSeconds();
        tasks := [1..Length(BSGS[1])];
        for l in [1..upper_bound] do
            tasks[l] := RunTask(SimpleVerify, BSGS, l);
        od;
        for l in [1..upper_bound] do
            results[l] := TaskResult(tasks[l]);
        od;
        if false in results then
            continue;
        fi;
        Add(time[4], t2);
        counter := counter + 1;
        Add(time[1], (MicroSeconds() - t1) * 1.0 / 1000000);

        results := [1..Length(BSGS[1])];

        ## parallelization w.r.t. base
        t1 := MicroSeconds();
        for l in Reversed([1..upper_bound]) do
            results[l] := ParallelVerify(BSGS, l);
        od;
        Add(time[2], (MicroSeconds() - t1) * 1.0 / 1000000);

        results := [1..Length(BSGS[1])];

        ## no parallelization
        t1 := MicroSeconds();
        for l in Reversed([1..upper_bound]) do
            results[l] := SimpleVerify(BSGS, l);
        od;
        Add(time[3], (MicroSeconds() - t1) * 1.0 / 1000000);
    od;
    average := [0,0,0,0];
    for i in [1..5] do
        average[1] := average[1] + time[1][i]/5;
        average[2] := average[2] + time[2][i]/5;
        average[3] := average[3] + time[3][i]/5;
        average[4] := average[4] + time[4][i]/5;
    od;
    Print(", calculation time: "); Print(average[4]); Print(", times: "); Print(average{[1..3]}); Print("\n");
od;


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

Class(InterpolateSegmentDFT, TaggedNonTerminal, rec(
    abbrevs := [ (numseg, outsize, insize, overlap, dsfunc,usfunc) -> [numseg, outsize, insize, overlap, dsfunc, usfunc] ],

    dims := self >> [self.params[2], self.params[3]],

    terminate := self >> let(
        numseg  := self.params[1],
        rowlength := self.params[2],
        insize  := self.params[3],
        j       := Ind(numseg),
        overlap := self.params[4],
        downsample := self.params[5].at(j),
        upsample   := self.params[6],
        n       := upsample.domain(),
        N       := downsample.range(),
        substrec := i -> rec((j.id):=V(i)),

        kernel := Mat(MatAMat(RowDirectSum(
            overlap,
            List([1..numseg], i ->
                Downsample(SubstVars(Copy(downsample), substrec(i-1))).terminate() *
                DFT(N, 1).terminate() *
                Upsample(upsample).terminate() *
                Scale(1/n, DFT(n, -1).terminate())
            )).toAMat() *
            Scat(fAdd(n*numseg-(numseg-1)*overlap, insize, 0)).toAMat()
        )),
        When(Rows(kernel) = rowlength, kernel, VStack(kernel, O(rowlength-Rows(kernel), Cols(kernel))))
    ),
    isReal    := False,
    normalizedArithCost := self >> let(numseg := self.params[1], n:=self.params[6].domain(), N := self.params[6].range(),
        numseg * (n + IntDouble(5 * n * d_log(n) / d_log(2)) + IntDouble(5 * N * d_log(N) / d_log(2)))),
    TType := T_Complex(T_Real(64)),

    HashId := self >> let(h := [ self.params[1], self.params[2], self.params[3], self.params[4], self.params[5].domain(), self.params[5].range()],
        When(IsBound(self.tags), Concatenation(h, self.tags), h)),
    doNotMeasure := true
));

_sumSegDims := function(numsegs, seglen)
    local l, lfact, lsum, divsum, ssum;

    l := List([0..numsegs-1], i->seglen.at(i).domain());

    # check to pull out the mul
    if ForAll(l, i->ObjId(i) = mul and IsValue(i.args[1]) and i.args[1].v = l[1].args[1].v) then
        lfact := l[1].args[1];
        lsum := List(l, i -> i.args[2]);
        # we may need to create a table, but not sure yet...
        divsum := ApplyFunc(add, lsum);
        ssum := mul(lfact, divsum);
    else
        ssum := ApplyFunc(add, l);
    fi;

    return ssum;
end;

NewRulesFor(InterpolateSegmentDFT, rec(
    InterpolateSegmentDFT_base := rec(
        switch := false,
        applicable := (self, nt) >> not nt.hasTags() and ObjId(nt.params[6]) = fZeroPadMiddle,
        children := nt -> let(numseg := nt.params[1], j := Ind(numseg), downsample := nt.params[5].at(j), upsample := nt.params[6],
                              insize := nt.params[3], overlap := nt.params[4], n:=upsample.domain(), N := downsample.range(),
                              us := N/n, blk := n/2,
                              inp := n + (numseg-1)*(n-overlap), over := inp - insize, l := n - over,
            [[
                Downsample(downsample),
                DFT(N, 1),
                Upsample(upsample),
                DFT(n, -1),
                Upsample(fAdd(n, l, 0)),
                InfoNt(j)
            ]]),
        apply := (nt, C, cnt) -> let(numseg := nt.params[1], _j := cnt[6].params[1], j := Ind(_j.range-1), downsample := nt.params[5].at(j), upsample := nt.params[6],
                              outsize := nt.params[2], insize := nt.params[2], overlap := nt.params[4], n:=upsample.domain(), N := downsample.range(),
                              ids_rows := _sumSegDims(numseg-1, nt.params[5]),
                RowDirectSum(overlap,[
                    IRowDirSum(j, numseg-1, overlap,
                        SubstVars(Copy(C[1]), rec((_j.id) := j)) * C[2] * C[3] * Scale(1/n, C[4])).overrideDims([ids_rows, insize - C[4].dims()[2] + overlap]),
                    SubstVars(Copy(C[1]), rec((_j.id) := V(numseg-1))) * C[2] * C[3] * Scale(1/n, C[4] * C[5])
                ]).overrideDims([nt.params[2], nt.params[3]])
       )
    ),
    InterpolateSegmentDFT_PrunedDFT := rec(
        applicable := (self, nt) >> not nt.hasTags() and ObjId(nt.params[6]) = fZeroPadMiddle,
        children := nt -> let(numseg := nt.params[1], j := Ind(numseg), downsample := nt.params[5].at(j), upsample := nt.params[6],
                              insize := nt.params[3], overlap := nt.params[4], n:=upsample.domain(), N := downsample.range(),
                              us := N/n, blk := n/2,
                              inp := n + (numseg-1)*(n-overlap), over := inp - insize, l := n - over, g := Gcd(n, l),
            [[
                Downsample(downsample),
                PrunedDFT(N, 1, blk, [0, 2*us-1]),
                DFT(n, -1),
                PrunedDFT(n, -1, g, [0..l/g-1]),
                InfoNt(j)
            ]]),
        apply := (nt, C, cnt) -> let(numseg := nt.params[1], _j := cnt[5].params[1], j := Ind(_j.range-1), downsample := nt.params[5].at(j), upsample := nt.params[6],
                              outsize := nt.params[2], insize := nt.params[3], overlap := nt.params[4], n := upsample.domain(), N := downsample.range(),
                              ids_rows := _sumSegDims(numseg-1, nt.params[5]),
                RowDirectSum(overlap,[
                    IRowDirSum(j, numseg-1, overlap,
                        SubstVars(Copy(C[1]), rec((_j.id) := j)) * C[2] * Diag(fConst(n, 1/n)) * C[3]).overrideDims([ids_rows, insize - C[4].dims()[2] + overlap]),
                    SubstVars(Copy(C[1]), rec((_j.id) := V(numseg-1))) * C[2] * Diag(fConst(n, 1/n)) * C[4]
                ]).overrideDims([nt.params[2], nt.params[3]])
       )
    )
));


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

ImportAll(paradigms.scratchpad);

doNormalWHT := function(arg)
   local N, t, rt, srt, code, a;

   N := When(Length(arg) >=1, arg[1], 2);

   t := WHT(N);
   rt := RandomRuleTree(t, SpiralDefaults);
   srt := SumsRuleTree(rt, SpiralDefaults);
   code := CodeSums(srt, SpiralDefaults);
   a := CMatrix(code, SpiralDefaults);

   return a;
end;

doScratchWHT := function(arg)
   local N, ls, opts, t, rt, srt, code, b;
   N := When(Length(arg) >=1, arg[1], 2);
   ls := When(Length(arg) >=2, 2^arg[2],2);

   opts := ScratchX86CMContext.getOpts(ls,1,1,N);
   t := WHT(opts.size).withTags(opts.tags);
   rt := RandomRuleTree(t, opts);
   srt := SumsRuleTree(rt, opts);
   code := CodeSums(srt, opts);
   b := CMatrix(code, opts);

   return b;
end;

doWHT := function(arg)
    local N, N1, i, j, a, b;

    SpiralDefaults.includes := ["\"scratchc.h\""];
    SpiralDefaults.profile.makeopts.CFLAGS := "-O2 -Wall -fomit-frame-pointer -msse4.1 -std=gnu99 -static";

    N := When(Length(arg) >= 1, arg[1], 2);

    for i in [2..N] do
        a := doNormalWHT(i);
        N1 := i - 1;
        for j in [1..N1] do
            b := doScratchWHT(i,j);
            PrintLine("Size of WHT:", 2^i);
            PrintLine("Scratch buffer size:", 2^j);
            PrintLine(a=b);
            PrintLine("------------------------------------------");
        od;
    od;
end;


# The incidence graph of a Desarguesian projective plane.
BindGlobal("DesarguesianPlaneIncidenceGraph", function(q)
    local G, V, dp;
    V := GF(q)^3;
    dp := DirectProduct(GL(3, q), SymmetricGroup(2));
    G := Graph(dp, Union(List([1,2], d -> Subspaces(V, d))),
                OnProjectivePlane(V, dp), function(x, y)
                    return x <> y and Intersection(x, y) in [x, y];
                end, true);
    G.halfDuality := Sum;
    G.halfPrimality := Intersection;
    return G;
end);

# The incidence graph of a Hall plane.
BindGlobal("HallPlaneIncidenceGraph", function(q)
    local c, p, G, H, L, P, dp, mul;
    H := GF(q)^2;
    p := DefiningPolynomial(GF(GF(q), 2));
    c := CoefficientsOfUnivariatePolynomial(p);
    mul := HallMultiplication(p);
    P := Union([[]], List(H, x -> [x]), Cartesian(H, H));
    L := Union([Union([[]], List(H, z -> [z]))],
                List(H, x -> Union([[]], List(H, z -> [x, z]))),
                List(Cartesian(H, H), w -> Union([[w[1]]],
                    List(H, z -> [z, mul(z, w[1]) + w[2]]))));
    dp := DirectProduct(Concatenation(ListWithIdenticalEntries(5,
                                        FieldAdditionPermutationGroup(q)),
                        [FieldMultiplicationPermutationGroup(q),
                         Group([[c[2], Z(q)^0], [-c[1], 0*Z(q)]])]));
    G := Graph(dp, Union(P, L), OnHallPlane(q, dp),
                PointLineIncidence, true);
    G.halfDuality := DefaultDualityFunction;
    G.halfPrimality := DefaultPrimalityFunction;
    return G;
end);

# The incidence graph of a Hughes plane. If the second parameter n is zero or
# unspecified, a Dickson semifield of order q^2 is used and the first parameter
# q must be an odd prime power. Otherwise, an exceptional near-field of order
# q^2 is used, so q must be 5, 7, 11, 23, 29, or 59. As there are two
# exceptional near-fields of order 11^2, setting n to 1 or 2 chooses one of
# these semifields when q = 11.
BindGlobal("HughesPlaneIncidenceGraph", function(arg)
    local c, n, q, A, B, F, G, H, P, df, dp, th, mul, rdiv, gens, orth;
    if Length(arg) < 1 then
        Error("at least one argument expected");
        return fail;
    fi;
    q := arg[1];
    if Length(arg) > 1 then
        n := arg[2];
    else
        n := 0;
    fi;
    th := Z(q^2)^((q+1)/2);
    B := Basis(GF(q^2), [Z(q)^0, th]);
    if n = 0 then
        mul := DicksonMultiplication(q);
        rdiv := DicksonRightDivision(q);
    else
        gens := [[[0, -1], [1, 0]]];
        if q = 5 then
            gens[2] := [[1, -2], [-1, -2]];
        elif q = 7 then
            gens[2] := [[1, 3], [-1, -2]];
        elif q = 11 and n = 1 then
            gens[2] := [[1, 5], [-5, -2]];
            gens[3] := [[4, 0], [0, 4]];
        elif q = 11 and n = 2 then
            gens[2] := [[2, 4], [1, -3]];
        elif q = 23 then
            gens[2] := [[1, -6], [12, -2]];
            gens[3] := [[2, 0], [0, 2]];
        elif q = 29 then
            gens[2] := [[1, -7], [-12, -2]];
            gens[3] := [[16, 0], [0, 16]];
        elif q = 59 then
            gens[2] := [[9, 15], [-10, -10]];
            gens[3] := [[4, 0], [0, 4]];
        else
            Error("the specified exceptional near-field does not exist");
            return fail;
        fi;
        G := Group(gens * Z(q)^0);
        F := Union([NullMat(2, 2, GF(q))], Elements(G));
        SortBy(F, x -> IntVecFFE(x[1]));
        mul := ExceptionalMultiplication(q, F, B);
        rdiv := ExceptionalRightDivision(q, F, B);
    fi;
    c := CoefficientsOfUnivariatePolynomial(DefiningPolynomial(GF(GF(q), 3)));
    A := [[-c[3], Z(q)^0, 0*Z(q)],
          [-c[2], 0*Z(q), Z(q)^0],
          [-c[1], 0*Z(q), 0*Z(q)]];
    P := Filtered(GF(q^2)^3,
            x -> not IsZero(x) and IsOne(First(x, y -> not IsZero(y))));
    dp := DirectProduct(Group(A), SymmetricGroup(2));
    orth := function(x, y)
        local z;
        z := TransposedMat(List(y, w -> Coefficients(B, w)));
        return IsZero(x*z[1] + mul(th, x*z[2]));
    end;
    H := Graph(dp, Cartesian([1, 2], P), OnHughesPlane(q, rdiv, dp),
                function(x, y)
                    return x[1] <> y[1] and orth(x[2], y[2]);
                end, true);
    df := x -> [x[1][1]^(1, 2),
                Intersection(List(x,
                                    y -> Filtered(P, z -> orth(y[2], z))))[1]];
    H.halfDuality := df;
    H.halfPrimality := df;
    return H;
end);

# The collinearity graph of the generalized quadrangle Q(d, q)
# of order (q, q^{d-3}).
BindGlobal("GeneralizedQuadrangleQ", function(d, q)
    return PolarGraphO(4-d, d+1, q);
end);

# The collinearity graph of the generalized quadrangle H(d, r^2)
# of order (r^2, r^{d-5/2}).
BindGlobal("GeneralizedQuadrangleH", function(d, r)
    return PolarGraphU(d+1, r);
end);

# The collinearity graph of the generalized quadrangle W(q) of order (q, q).
BindGlobal("GeneralizedQuadrangleW", q -> PolarGraphSp(4, q));

# The collinearity graph of the generalized quadrangle T_d(O) of order
# (q, q^{d-1}) derived from the projective space PG(d+1, q) containing the
# oval or ovoid O in a hyperplane.
BindGlobal("GeneralizedQuadrangleT", function(arg)
    local d, o, q, G, H, O, V, gr;
    if Length(arg) < 1 then
        Error("at least one argument expected");
        return fail;
    elif Length(arg) < 3 then
        d := arg[1].d;
        q := arg[1].q;
        o := arg[1].points;
        G := arg[1].group;
    else
        d := arg[1];
        q := arg[2];
        o := arg[3];
        if Length(arg) > 3 then
            G := arg[4];
        else
            G := Group(IdentityMat(d+1, GF(q)));
        fi;
    fi;
    V := GF(q)^(d+2);
    H := Subspace(V, BasisVectors(CanonicalBasis(V)){[2..d+2]}, "basis");
    O := List(o, x -> Subspace(V,
            [Concatenation([0*Z(q)], BasisVectors(Basis(x))[1])], "basis"));
    gr := Graph(Group(List(GeneratorsOfGroup(G),
                            g -> Concatenation([Concatenation([Z(q)^0],
                                    ListWithIdenticalEntries(d+1, 0*Z(q)))],
                                List(g, l -> Concatenation([0*Z(q)], l))))),
        Union(Filtered(Subspaces(V, 1), x -> not IsSubset(H, x)),
                Filtered(Subspaces(V, d+1),
                    x -> Length(Filtered(O, y -> IsSubset(x, y))) = 1), [V]),
        OnSubspaces(V), function(x, y)
            local dx, dy, xy, yx;
            dx := Dimension(x);
            dy := Dimension(y);
            xy := x+y;
            yx := Intersection(x, y);
            return (dx = d+2 and dy = d+1) or (dx = d+1 and dy = d+2) or
                (dx = 1 and dy = 1 and ForAny(O, z -> IsSubset(xy, z))) or
                (dx = 1 and dy = d+1 and ForAny(O, z -> IsSubset(y, x+z))) or
                (dx = d+1 and dy = 1 and ForAny(O, z -> IsSubset(x, y+z))) or
                (dx = d+1 and dy = d+1 and x <> y and
                                            ForAny(O, z -> IsSubset(yx, z)));
        end, true);
    gr.duality := function(x)
        if V in x then
            return First(O, y -> IsSubset(Intersection(x), y));
        else
            return Sum(Filtered(x, y -> Dimension(y) = 1));
        fi;
    end;
    gr.primality := function(x)
        if ForAll(x, y -> Dimension(y) = 1) then
            return V;
        elif ForAll(x, y -> Dimension(y) = 2) then
            return Intersection(x);
        else
            return Sum(x);
        fi;
    end;
    return gr;
end);

# The collinearity graph of the generalized quadrangle T*(O) of order
# (2^h-1, 2^h+1) derived from the projective space PG(3, 2^h) containing the
# hyperoval O in a hyperplane.
BindGlobal("GeneralizedQuadrangleTstar", function(arg)
    local o, q, G, H, O, V, gr;
    if Length(arg) < 1 then
        Error("at least one argument expected");
        return fail;
    elif Length(arg) < 3 then
        q := arg[1].q;
        o := arg[1].points;
        G := arg[1].group;
    else
        q := 2^arg[1];
        o := arg[2];
        if Length(arg) > 2 then
            G := arg[3];
        else
            G := Group(IdentityMat(3, GF(q)));
        fi;
    fi;
    V := GF(q)^4;
    H := Subspace(V, BasisVectors(CanonicalBasis(V)){[2..4]}, "basis");
    O := List(o, x -> Subspace(V,
            [Concatenation([0*Z(q)], BasisVectors(Basis(x))[1])], "basis"));
    gr := Graph(Group(List(GeneratorsOfGroup(G),
                            g -> Concatenation([Concatenation([Z(q)^0],
                                    ListWithIdenticalEntries(3, 0*Z(q)))],
                                List(g, l -> Concatenation([0*Z(q)], l))))),
                Filtered(Subspaces(V, 1), x -> not IsSubset(H, x)),
                OnSubspaces(V), function(x, y)
                    local xy;
                    xy := x+y;
                    return not IsSubset(H, xy)
                        and ForAny(O, z -> IsSubset(xy, z));
                end, true);
    gr.duality := Sum;
    gr.primality := Intersection;
    return gr;
end);

# The collinearity graph of the generalized quadrangle P(G, z) of
# order (s-1, s+1) derived by removing the neighbourhood of a regular point z
# of a generalized quadrangle G of order (s, s).
BindGlobal("GeneralizedQuadrangleP", function(Q, z)
    local H, P;
    H := Graph(Stabilizer(Q.group, z), DistanceSet(Q, 2, z), OnPoints,
            function(x, y)
                local c;
                c := Intersection(Adjacency(Q, x), Adjacency(Q, y));
                return not z in c and (y in Adjacency(Q, x)
                                    or ForAll(c, w -> z in Adjacency(Q, w)));
            end, true);
    AssignVertexNames(H, Q.names{H.names});
    CheckDualityFunctions(Q);
    H.duality := function(x)
        local p;
        p := List(x, u -> Position(Q.names, u));
        if ForAny(Cartesian(p, p), w -> Distance(Q, w[1], w[2]) = 2) then
            return [2, Set(x)];
        else
            return [1, Q.duality(Union(x,
                    Q.names{Intersection(List(p, v -> Adjacency(Q, v)))}))];
        fi;
    end;
    H.primality := x -> Q.primality(List(Filtered(x, y -> y[1] = 1),
                                    w -> w[2]));
    return H;
end);

# The collinearity graph of the generalized quadrangle AS(q)
# of order (q-1, q+1).
BindGlobal("GeneralizedQuadrangleAS",
    q -> GeneralizedQuadrangleP(GeneralizedQuadrangleW(q), 1));

# The incidence graph of a projective plane read from a file as on
#   http://www.uwyo.edu/moorhouse/pub/planes/       or
#   http://www.uwyo.edu/moorhouse/pub/genpoly/
# The optional second parameter is a file containing generators of the
# automorphism group.
BindGlobal("IncidenceGraphFromFile", function(arg)
    local l, m, n, G, L, fst, lst, lns;
    if Length(arg) < 1 then
        Error("at least one argument expected");
        return fail;
    fi;
    lns := ReadLines(arg[1]);
    n := Length(lns);
    L := List(lns, l -> List(SplitString(l, " "), x -> Int(x)+n+1));
    if Length(arg) > 1 then
        lns := ReadLines(arg[2]);
        m := Length(lns);
        fst := Filtered([1..m], i -> IntChar(lns[i][1]) <> 32);
        l := Length(fst);
        lst := List(fst{[2..l]}, i -> i-1);
        Add(lst, m);
        G := Group(List([1..l], i -> PermList(List(SplitString(
                    JoinStringsWithSeparator(lns{[fst[i]..lst[i]]}, ""),
                    " "), x -> Int(x)+1))));
    else
        G := Group(());
    fi;
    return Graph(G, [1..2*n], OnPoints, function(x, y)
            return (x <= n and y in L[x]) or (y <= n and x in L[y]);
        end, true);
end);

# The collinearity graph of a projective plane read from a file as on
#   http://www.uwyo.edu/moorhouse/pub/genpoly/
# The optional second parameter is a file containing generators of the
# automorphism group.
BindGlobal("CollinearityGraphFromFile", function(arg)
    local l, m, n, G, L, fst, lst, lns;
    if Length(arg) < 1 then
        Error("at least one argument expected");
        return fail;
    fi;
    lns := ReadLines(arg[1]);
    n := Length(lns);
    L := List(lns, l -> List(SplitString(l, " "), x -> Int(x)));
    if Length(arg) > 1 then
        lns := ReadLines(arg[2]);
        m := Length(lns);
        fst := Filtered([1..m], i -> IntChar(lns[i][1]) <> 32);
        l := Length(fst);
        lst := List(fst{[2..l]}, i -> i-1);
        Add(lst, m);
        G := Group(List([1..l], i -> PermList(Filtered(List(SplitString(
                    JoinStringsWithSeparator(lns{[fst[i]..lst[i]]}, ""),
                    " "), x -> Int(x)+1), y -> y <= n))));
    else
        G := Group(());
    fi;
    return Graph(G, [1..n], OnPoints, function(x, y)
            return Length(Intersection(L[x], L[y])) = 1;
        end, true);
end);


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);
push := Rewrite(spmv2, RulesMatMul, opts);
fdos := FDataOfs(front, opts.symbol[1], i);
rv := RowVec(fdos);
pull := IterVStack(i, opts.symbol[1], rv);
f := var.fresh_t("nnz", TInt);
push_pull := COND(lt(div(f, opts.symbol[1]), V(0.01)), PushBFSKernel(push), PullBFSKernel(pull));
rt := RandomRuleTree(last, opts);
srt := SumsRuleTree(rt, opts);
srt2 := Rewrite(Copy(srt), RulesSigSPMV2, opts);
push_pullfinal := Rewrite(Copy(srt2), RulesScatRow, opts);
cs := CodeSums(BFSKernel(last), opts);
PrintCode("dobfs", cs, opts);