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

#F   tSPL Twiddle factors
Class(TTwiddle, Tagged_tSPL_Container, rec(
    abbrevs :=  [
        (mn, n) -> [mn, n, 1],
        (mn, n, k) -> [mn, n, k]
     ],
    dims := self >> let(n:=self.params[1], [n,n]),
    terminate := self >> Diag(Tw1(self.params[1], self.params[2], self.params[3])),
    transpose := self >> Copy(self),
    isReal := False,
    doNotMeasure := true,
    noCodelet := true,
    normalizedArithCost := self >> 6*Rows(self)
));

Class(TTwiddle_Stockham, Tagged_tSPL_Container, rec(
    abbrevs :=  [
        (n, blocksize, rdx, j) -> [n, blocksize, rdx, j]
     ],
    dims := self >> let(n:=self.params[1], [n,n]),
    #params := self >> let(params := [self.params[1], self.params[2], self.params[3], self.params[4]]),
    terminate := self >> Tw1(self.params[1], self.params[1]/self.params[3], 1),
#F 	D tensor I has to be done in the TTwiddle_St rule, not here
#F    terminate := self >> diagTensor(Tw1(self.params[1], self.params[2], self.params[3]), fConst(TComplex, self.params[2], 1)),
#F    terminate := self >> fCompose(dOmega(self.params[1],1), fId(self.params[1]/self.params[2])),
    transpose := self >> Copy(self),
    isReal := False,
    doNotMeasure := true,
    noCodelet := true,
    domain := self >> TComplex,
    normalizedArithCost := self >> 6*Rows(self)
));

NewRulesFor(TTwiddle_Stockham, rec(
    TTwiddle_St := rec(
        minSize := false,
        maxSize := false,
        applicable := (self, nt) >> ((IsBool(self.minSize) and not self.minSize) or nt.params[1] >= self.minSize) and
            ((IsBool(self.maxSize) and not self.maxSize) or nt.params[1] <= self.maxSize),
        forTransposition := false,
        apply := function(t, C, Nonterms)
            local access, blocksize, i, i1, j, n, d, k, rdx, stride, t;

			n := t.params[1];
			blocksize := t.params[2];
			rdx := t.params[3];
			j := t.params[4];
			t := LogInt(n, rdx);
			i := Ind(n);
			i1 := Ind(n/(rdx^j));
			stride := rdx^j;
			access := Lambda(i1, i1 * stride);

#F	Older versions, not using an access function, but returning the full matrix
#F			TDiag(fPrecompute(diagTensor(fConst(TComplex, rdx^j, 1), Stockham_radix.gen(rdx, LogInt(N, rdx)-j-1))))
#F			omega := fCompose(FData(fCompose(dOmega(n,1),diagTensor(dLin(div(n,blocksize), 1, 0, TInt), dLin(blocksize, 1, 0, TInt))).tolist()), Lambda(i, i));
#F			omega := fCompose(fPrecompute(fCompose(dOmega(n,1),diagTensor(dLin(div(n,blocksize), 1, 0, TInt), dLin(blocksize, 1, 0, TInt))).tolist()), Lambda(i, i));

			omega := fCompose(fPrecompute(Tw1(n, n/rdx,1)), access);
			omega := diagTensor(omega, fConst(TComplex, rdx^j, 1));

        	return Diag(omega);

		end
    ),
));

NewRulesFor(TTwiddle, rec(
    TTwiddle_Tw1 := rec(
        minSize := false,
        maxSize := false,
        applicable := (self, nt) >> ((IsBool(self.minSize) and not self.minSize) or nt.params[1] >= self.minSize) and
            ((IsBool(self.maxSize) and not self.maxSize) or nt.params[1] <= self.maxSize),
        forTransposition := false,
        apply := (t, C, Nonterms) -> Diag(fPrecompute(Tw1(t.params[1], t.params[2], t.params[3])))
    ),

    TTwiddle_TwoTables := rec(
        minSize := false,
        maxSize := false,
        applicable := (self, nt) >> ((IsBool(self.minSize) and not self.minSize) or nt.params[1] >= self.minSize) and
            ((IsBool(self.maxSize) and not self.maxSize) or nt.params[1] <= self.maxSize),
        forTransposition := false,
        apply := function(t, C, Nonterms)
            local mn, n, _k, rdx, dp, i, i1, i2, j, k, f, omega_1, omega_2;

            #t in this case is the TTwiddle(mn,n,k) function, so the t.params[1]  = first parameter of TTwiddle() = mn
            mn := t.params[1];
            n := t.params[2];
            _k := t.params[3];
            dp := DivisorPairs(mn);
            rdx := Maximum(dp[Int(Length(dp)/2+1)]);

            i := Ind(mn);
            i1 := Ind(mn);
            i2 := Ind(mn);
            j := Ind(mn/rdx);
            k := Ind(rdx);

            f := Lambda(i, idiv(i, n) * imod(i, n));	# -> guarantees contiguous access

#   NOTE: fPrecompute does not work, so I have to force table generation through FData()
#            omega_1 := fCompose(fPrecompute(dOmega(mn/rdx, _k)), fComputeOnline(Lambda(i1, idiv(f.at(i1), rdx))));
#            omega_2 := fCompose(fPrecompute(dOmega(mn, _k)), fComputeOnline(Lambda(i2, imod(f.at(i2), rdx))));
#            omega_1 := fCompose(fPrecompute(fCompose(dOmega(mn/rdx, _k), fId(mn/rdx))), fComputeOnline(Lambda(i1, idiv(f.at(i1), rdx))));
#            omega_2 := fCompose(fPrecompute(fCompose(dOmega(mn, _k), fId(rdx))), fComputeOnline(Lambda(i2, imod(f.at(i2), rdx))));

#   NOTE: the domain of dOmega cannot be set to an integer, so I need to compose with fId()...
            omega_1 := fCompose(FData(fCompose(dOmega(mn/rdx, _k), fId(mn/rdx)).tolist()), Lambda(i1, idiv(f.at(i1), rdx)));
            omega_2 := fCompose(FData(fCompose(dOmega(mn, _k), fId(rdx)).tolist()), Lambda(i2, imod(f.at(i2), rdx)));

            return Diag(omega_1) * Diag(omega_2);

# old version with FData without fCompose
#            omega_1 := FData(Lambda(j, omega(mn/rdx, j*imod(_k, mn/rdx))).tolist());
#            omega_2 := FData(Lambda(k, omega(mn, k*_k)).tolist());
#            return Diag(Lambda(i1, omega_1.at(idiv(f.at(i1), rdx)))) * Diag(Lambda(i2, omega_2.at(imod(f.at(i2), rdx))));
        end
    ),
));


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

Declare(GathRecv);
Declare(ScatSend);
Declare(GathDist);
Declare(ScatDist);
Declare(Comm_Cell);
Declare(PTensor);

Declare(DistSum);
Declare(DistSumLoop);

#F GathRecv(func, pkSize, P, i).
#F Gather Receive, for parallel code.
Class(GathRecv, BaseMat, SumsBase, rec(
    sums := self >> self,
    isReal := self >> true,
    dims := self >> self.dimensions,
    needInterleavedLeft := self >> false,
    needInterleavedRight := self >> false,
    cannotChangeDataFormat := self >> true,
    totallyCannotChangeDataFormat := self >> true,
    #-----------------------------------------------------------------------
    # NOTE: we should have 2 children, not 1!
    rChildren := self >> [self.func, self.pkSize, self.P, self.i],
    rSetChild := rSetChildFields("func", "pkSize", "P", "i"),
    #-----------------------------------------------------------------------
    new := (self, func, pkSize, P, i) >> SPL(WithBases(self,
        rec(func       := FF(func),
            pkSize     := pkSize,
            i          := i,
            P          := P,
            dimensions := When(func.__name__ = "FData",
                  [pkSize*func.domain()/P, pkSize*func.domain()],
                  [pkSize*func.domain(), pkSize*func.range()] )
            ))),
    #-----------------------------------------------------------------------
    area := self >> When(func.__name__ = "FData",
                    self.pkSize * self.func.domain()/self.P,
                    self.pkSize * self.func.domain()),

    transpose := self >> ScatSend(self.func, self.pkSize, self.P, self.i),
    #-----------------------------------------------------------------------
    print := (self,i,is) >> Print(self.name, "(", self.func, ", ", self.pkSize, ", ", self.P, ", ", self.i,")"),
    #-----------------------------------------------------------------------
    toAMat := self >>
       Cond(self.func.__name__ = "FData",

          # NOTE Problem: The following considers self.i with FData, but not
          # otherwise! (So in the otherwise case, func contains this info).

          # This is if we've already converted to FData. Don't change the func below!
          let(pkSize   := self.pkSize,
              n        := pkSize*(self.func.domain()/self.P),
              N        := pkSize*self.func.domain(),
              func     := fTensor(
                            fCompose(self.func, fTensor( fBase(self.P, self.i), fId(self.func.domain()/self.P) )),
                            fId(pkSize)
                          ).lambda(),
              AMatMat(List([0..n-1], row -> BasisVec(N, func.at(row).ev())))
          ),
          # This is if we haven't converted to FData yet
          let(pkSize   := self.pkSize,
              n        := pkSize*self.func.domain(),
              N        := pkSize*self.func.range(),
              func     := fTensor(self.func, fId(pkSize)).lambda(),
              AMatMat(List([0..n-1], row -> BasisVec(N, func.at(row).ev())))
          )
       )
));

#F ScatSend(func, pkSize, P, i).
# For now, ScatSend will specify the target explicitly. GathRecv will just put
# things in place
Class(ScatSend, BaseMat, rec(
    sums := self >> self,
    dims := self >> self.dimensions,
    isReal := self >> true,
    needInterleavedLeft := self >> false,
    needInterleavedRight := self >> false,
    cannotChangeDataFormat := self >> true,
    totallyCannotChangeDataFormat := self >> true,
    area := self >> self.transpose().area(),
    toAMat := self >> TransposedAMat(self.transpose().toAMat()),
    #-----------------------------------------------------------------------
    rChildren := self >> [self.func, self.pkSize, self.P, self.i],
    rSetChild := rSetChildFields("func", "pkSize", "P", "i"),
    #-----------------------------------------------------------------------
    new := (self, func, pkSize, P, i) >> SPL(WithBases(self,
        rec(func       := FF(func),
            pkSize     := pkSize,
            P          := P,
            i          := i,
            dimensions := When(func.__name__ = "FData",
                  [pkSize*func.domain(), pkSize*func.domain()/P],
                  [pkSize*func.range(), pkSize*func.domain()] )
            ))),
    #-----------------------------------------------------------------------
    transpose := self >> GathRecv(self.func, self.pkSize, self.P, self.i),
    #-----------------------------------------------------------------------
    print := (self,i,is) >> Print(self.name, "(", self.func, ", ", self.pkSize, ", ", self.P, ", ", self.i,")"),
));

#F GathDist(N, pkSize, P, i)
#F Distributed Gather, for parallel code.
#F N=Vector length. pkSize = packetSize P=Number of processors i=processor#
#F Gathers (N/P)*pkSize elements corresponding to the ones to be processed by processor i.
Class(GathDist, BaseMat, SumsBase, rec(
    sums := self >> self,
    dims := self >> self.dimensions,
    isReal := self >> true,
    needInterleavedLeft := self >> false,
    needInterleavedRight := self >> false,
    cannotChangeDataFormat := self >> true,
    totallyCannotChangeDataFormat := self >> true,
    #-----------------------------------------------------------------------
    rChildren := self >> [self.N, self.pkSize, self.P, self.i],
    rSetChild := rSetChildFields("N", "pkSize", "P", "i"),
    #-----------------------------------------------------------------------
    new := (self, N, pkSize, P, i) >> SPL(WithBases(self,
        rec(N          := N,
            pkSize     := pkSize,
            P          := P,
            i          := i,
            func       := FF( fAdd(N, N/P, i*(N/P))  ),
            dimensions := [pkSize*(N/P), pkSize*N]))),
    #-----------------------------------------------------------------------
    area := self >> self.func.domain() * self.func.range(),
    transpose := self >> ScatDist(self.N, self.pkSize, self.P, self.i),
    #-----------------------------------------------------------------------
    print := (self,i,is) >> Print(self.name, "(", self.N, ", ", self.pkSize, ", ", self.P, ", ", self.i, ")"),
    #-----------------------------------------------------------------------
    toAMat := self >> let(
             pkSize:=self.pkSize,
             n:=pkSize*(self.N/self.P),
             N:=pkSize*self.N,
             i:=self.i,
             P:=self.P,
             func := FF( fAdd(N, N/P, i*(N/P))  ).lambda(),
             AMatMat(List([0..n-1], row -> BasisVec(N, func.at(row).ev())))
    ),
));

#F ScatDist(N, pkSize, P, i)
#F Distributed Scatter. See Doc(GathDist) for more info.
Class(ScatDist, BaseMat, rec(
    sums := self >> self,
    dims := self >> self.dimensions,
    isReal := self >> true,
    needInterleavedLeft := self >> false,
    needInterleavedRight := self >> false,
    cannotChangeDataFormat := self >> true,
    totallyCannotChangeDataFormat := self >> true,
    #-----------------------------------------------------------------------
    rChildren := self >> [self.N, self.pkSize, self.P, self.i],
    rSetChild := rSetChildFields("N", "pkSize", "P", "i"),
    #-----------------------------------------------------------------------
    new := (self, N, pkSize, P, i) >> SPL(WithBases(self,
        rec(N           := N,
            pkSize      := pkSize,
            P           := P,
            i           := i,
            func        := FF( fAdd(N, N/P, i*(N/P))  ),
            dimensions  := [pkSize*N, pkSize*(N/P)]))),
    #-----------------------------------------------------------------------
    area := self >> self.transpose().area(),
    transpose := self >> GathDist(self.N, self.pkSize, self.P, self.i),
    #-----------------------------------------------------------------------
    print := (self,i,is) >> Print(self.name, "(", self.N, ", ", self.pkSize, ", ", self.P, ", ", self.i, ")"),
    #-----------------------------------------------------------------------
    toAMat := self >> TransposedAMat(self.transpose().toAMat()),
));

#NOTE: P and domain are the same thing, and are redundant for DistSum. Remove
#one of them. Assign P to domain or something like that.

#F ==========================================================================
#F DistSum(<P>, <var>, <domain>, <spl>) - as ISum but makes parallel loop in the code
#F ==========================================================================

Class(DistSum, ISum, rec(

    doNotMarkBB := true,
    new := meth(self, P, var, domain, expr)
        local res;
        Constraint(IsSPL(expr));
        # if domain is an integer (not symbolic) it must be non-zero
        Constraint(not IsInt(domain) or domain > 0);
        var.isParallelLoopIndex := true;
        res := SPL(WithBases(self, rec(P:=P, _children := [expr], var := var, domain := domain)));
        res.dimensions := res.dims();
        return res;
    end,

    rChildren := self >> Concatenation([self.P], self._children),
    rSetChild := meth(self, n, newChild)
        if n=1 then self.P := newChild;
          else self._children[n-1] := newChild;
        fi;
    end,

    from_rChildren := (self, rch) >> ApplyFunc(ObjId(self), [rch[1], self.var, self.domain, rch[2]]),

    leftMostParScat  := self >> Collect(self._children[1], @(1,[ScatSend, ScatDist]))[1],
    rightMostParGath := self >> Collect(self._children[1], @(1,[GathRecv, GathDist]))[1],

    print := meth(self, indent, indentStep)
        Print(self.name, "(", self.P, ", ", self.var, ", ", self.domain, ",");
        self._newline(indent + indentStep);
        SPLOps.Print(self._children[1], indent+indentStep, indentStep); #, ", ", self.nt_maps);
        self._newline(indent);
        Print(")");
    end,

));

Class(DistSumLoop, DistSum, rec(

    dims := (self) >> self._children[1].dims()*self.domain

));

#F Comm_Cell(p, pkSize)
#F All-to-all communication, specifically implementing L(p^2, p), where p=# of procs

Class(Comm_Cell, BaseMat, rec(
    cannotChangeDataFormat :=  self >> true,
    totallyCannotChangeDataFormat := self >> true,
    sums := self >> self,
    dims := self >> self.dimensions,
    isReal := self >> true,
    #-----------------------------------------------------------------------
    rChildren := self >> [self.P, self.pkSize],
    rSetChild := rSetChildFields("P", "pkSize"),
    #-----------------------------------------------------------------------
    new := (self, P, pkSize) >> SPL(WithBases(self,
        rec(P           := P,
            pkSize      := pkSize,
            dimensions  := [P*P*pkSize, P*P*pkSize]))),
    #-----------------------------------------------------------------------
    area := self >> self.P*self.P*self.pkSize*self.P*self.P*self.pkSize,
    #NOTE: check.
    transpose := self >> self,
    #-----------------------------------------------------------------------
    print := (self,i,is) >> Print(self.name, "(", self.P, ", ", self.pkSize, ")"),
    #-----------------------------------------------------------------------
    toAMat := self >> let(
             pkSize := self.pkSize,
             P      := self.P,
             func   := FF( fTensor(L(P*P, P), fId(pkSize))  ).lambda(),
             AMatMat(List([0..(P*P*pkSize)-1], row -> BasisVec((P*P*pkSize), func.at(row).ev())))
          ),
));

Class(PTensor, BaseMat, SumsBase, rec(
    cannotChangeDataFormat :=  self >> true,
    totallyCannotChangeDataFormat := self >> true,
    sums := self >> PTensor(self.L.sums(), self.P),
    dims := self >> self.L.dims() * self.P,
    isReal := self >> true,
    #-----------------------------------------------------------------------
    rChildren := self >> [self.L, self.P],
    rSetChild := rSetChildFields("L", "P"),
    #-----------------------------------------------------------------------
    new := (self, L, P) >> SPL(WithBases(self,
        rec(L   := L,
            P   := P,
            dimensions := L.dims()*P)
    )),

    #-----------------------------------------------------------------------
    #area := self >> self.L.dimen
    transpose := self >> PTensor(self.L.transpose(), self.P),
    #-----------------------------------------------------------------------

    print := (self,i,is) >> Print(self.name, "(",
        self.L.print(i+is,is), ", ", self.P, ")"),
    #-----------------------------------------------------------------------
    toAMat := self >> Tensor(I(self.P), self.L).toAMat(),
    #-----------------------------------------------------------------------
    isPermutation := False,
    needInterleavedLeft := true,
    needInterleavedRight := true,
    #NOTE: We should be able to stuff data format change into the PTensor
));

#Class(DontTouchMe, Buf, rec(
#    totallyCannotChangeDataFormat := self >> true,
#    cannotChangeDataFormat := self >> true
#));


#############################################################################
##
#W    pcpgrp.gi                                                  Bettina Eick
##
##    This file contains the header functions to handle the 3- and
##    4-dimensional almost crystallographic pcp groups.
##

#############################################################################
##
#F IsAlmostCrystallographic( <G> )
##
InstallMethod( IsAlmostCrystallographic, "for pcp groups", true,
    [IsPcpGroup ], 0,
function( G )
    if HasAlmostCrystallographicInfo( G ) then return true; fi;
    return (IsInt(Index(G,FittingSubgroup(G))) and
            Size(NormalTorsionSubgroup(G)) = 1);
end );

#############################################################################
##
#F IsAlmostBieberbachGroup( <G> )
##
InstallMethod( IsAlmostBieberbachGroup, "for pcp groups", true,
    [IsPcpGroup ], 0,
function( G )
    return IsInt(Index(G,FittingSubgroup(G))) and IsTorsionFree(G);
end );

#############################################################################
##
#F IsolatorSubgroup( G, N )
##
InstallGlobalFunction( IsolatorSubgroup, function( G, N )
    local nat, F, T;
    if not IsNormal( G, N ) then return fail; fi;
    nat := NaturalHomomorphismByNormalSubgroup( G, N );
    F := Image( nat );
    T := TorsionSubgroup( F );
    if IsBool( T ) then return fail; fi;
    return PreImage( nat, T );
end);

#############################################################################
##
#F AlmostCrystallographicPcpDim3( type, param )
##
InstallGlobalFunction( AlmostCrystallographicPcpDim3,
function( type, param )
    local g, G, info;

    # type is integer or string
    if IsString( type ) then
        g := Int( type );
    elif IsInt( type ) then
        g := type;
    else
        g := false;
    fi;
    if not g in [1..17] then
        Error("type does not define a valid ac-group type");
    fi;

    # check parameters
    if IsBool( param ) then
        param := List( [1..ACDim3Param[g]], x -> Random(Integers) );
        if param[1] = 0 then param[1] := Random(Integers)^2+1; fi;
    elif IsInt( param ) then
        param := List( [1..ACDim3Param[g]], x -> param );
    elif Length( param ) <> ACDim3Param[g] then
        Error("parameter should be a list of length ", ACDim3Param[g] );
    fi;

    # get group
    if Length( param ) = 4 then
        G := ACPcpDim3Funcs[g](param[1], param[2], param[3], param[4]);
    elif Length(param) = 2 then
        G := ACPcpDim3Funcs[g](param[1], param[2] );
    elif Length(param) = 1 then
        G := ACPcpDim3Funcs[g](param[1]);
    fi;

    # set some information
    info := rec( dim := 3, type := g, param := param );
    SetAlmostCrystallographicInfo( G, info );
    SetIsAlmostCrystallographic( G, true );
    SetSize( G, infinity );
    return G;
end );

#############################################################################
##
#F AlmostCrystallographicPcpDim4( type, param )
##
InstallGlobalFunction( AlmostCrystallographicPcpDim4,
function( type, param )
    local g, G, info;

    # type is integer or string
    if IsString( type ) then
        g := Position( ACDim4Types, type );
    elif IsInt( type ) then
        g := type;
    else
        g := false;
    fi;
    if not g in [1..95] then
        Error("type does not define a valid ac-group type");
    fi;

    # check parameters
    if IsBool( param ) then
        param := List( [1..ACDim4Param[g]], x -> Random(Integers) );
        if param[1] = 0 then param[1] := Random(Integers)^2+1; fi;
    elif IsInt( param ) then
        param := List( [1..ACDim4Param[g]], x -> param );
    elif Length( param ) <> ACDim4Param[g] then
        Error("parameter should be a list of length ", ACDim4Param[g] );
    fi;

    # get group
    if Length(param) = 7 then
        G := ACPcpDim4Funcs[g]( param[1], param[2], param[3], param[4],
                                param[5], param[6], param[7]);
    elif Length(param) = 6 then
        G := ACPcpDim4Funcs[g]( param[1], param[2], param[3], param[4],
                                param[5], param[6]);
    elif Length(param) = 5 then
        G := ACPcpDim4Funcs[g]( param[1], param[2], param[3], param[4],
                                param[5]);
    elif Length(param) = 4 then
        G := ACPcpDim4Funcs[g]( param[1], param[2], param[3], param[4]);
    elif Length(param) = 3 then
        G := ACPcpDim4Funcs[g]( param[1], param[2], param[3]);
    fi;

    # set some information
    info := rec( dim := 4, type := g, param := param );
    SetAlmostCrystallographicInfo( G, info );
    SetIsAlmostCrystallographic( G, true );
    SetSize( G, infinity );
    return G;
end );

#############################################################################
##
#F AlmostCrystallographicPcpGroup( dim, type, param )
##
InstallGlobalFunction( AlmostCrystallographicPcpGroup,
function( dim, type, param )
    if dim = 3 then
        return AlmostCrystallographicPcpDim3( type, param );
    elif dim = 4 then
        return AlmostCrystallographicPcpDim4( type, param );
    else
        Error("dimension must be 3 or 4");
    fi;
end );

#############################################################################
##
#A  FittingSubgroup( < G > )
##
InstallMethod( FittingSubgroup, "for ac pcp groups", true,
      [IsPcpGroup and HasAlmostCrystallographicInfo], 0,
function( G )
    local pcp, rel, sub, F;
    pcp := Pcp( G );
    rel := RelativeOrdersOfPcp( pcp );
    sub := Filtered( [1..Length(pcp)], x -> rel[x] = 0 );
    F := Subgroup( G, pcp{sub} );
    SetIsNilpotentGroup( F, true );
    return F;
end );

#############################################################################
##
#F  NaturalHomomorphismOnHolonomyGroup( < G > )
#F  HolonomyGroup( < G > )
##
InstallMethod( NaturalHomomorphismOnHolonomyGroup, "for ac pcp groups", true,
    [IsPcpGroup and IsAlmostCrystallographic], 0,
function( G )
    return NaturalHomomorphismByNormalSubgroup(G,FittingSubgroup(G));
end );

InstallMethod( HolonomyGroup, "for ac pcp groups", true,
    [IsPcpGroup and IsAlmostCrystallographic], 0,
function( G )
    return Image( NaturalHomomorphismOnHolonomyGroup(G) );
end );

#############################################################################
##
#F IsomorphismPcpGroup( <G> )
##
InstallMethod( IsomorphismPcpGroup, "for ac groups", true,
    [IsMatrixGroup and HasAlmostCrystallographicInfo], 0,
function( G )
    local info, H, gensH, gensG, l, d, newsG, hom;

    # get the corresponding pcp group
    info := AlmostCrystallographicInfo( G );
    H := AlmostCrystallographicPcpGroup( info.dim, info.type, info.param );
    gensH := GeneratorsOfGroup(H);
    gensG := GeneratorsOfGroup(G);

    # sort the generators of G according to the generators of H
    l := Length( gensG );
    d := info.dim;
    newsG := Concatenation( Reversed( gensG{[d+1..l]} ), gensG{[1..d]} );
    hom := GroupHomomorphismByImagesNC( G, H, newsG, gensH );
    SetIsInjective( hom, true );
    SetIsSurjective( hom, true );
    return hom;
end );


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

;; This buffer is for notes you don't want to save, and for Lisp evaluation.
;; If you want to create a file, visit that file with C-x C-f,
;; then enter the text in that file's own buffer.

n := 20;

opts := CopyFields(PRDFTDefaults, rec(
    globalUnrolling := 1000,
    compileStrategy := NoCSE,
    compflags := "-O1"
));

r  := RandomRuleTree(BRDFT3(4,1/16), opts);
rr := RandomRuleTree(RC(SkewDFT(2,1/16)), opts);
s  := SumsSPL(Tensor(I(n), SumsRuleTree(r, opts)), opts);
ss := SumsSPL(Tensor(I(n), SumsRuleTree(rr, opts)), opts);
c  := CodeSums(1000, s, opts);;
cc := CodeSums(1000, ss, opts);;
CMeasure(c, opts);
CMeasure(cc, opts);

r  := RandomRuleTree(BRDFT1(4), opts);
rr := RandomRuleTree(SRDFT1(4), opts);
s  := SumsSPL(Tensor(I(n), SumsRuleTree(r, opts)), opts);
ss := SumsSPL(Tensor(I(n), SumsRuleTree(rr, opts)), opts);
c  := CodeSums(1000, s, opts);;
cc := CodeSums(1000, ss, opts);;
CMeasure(c, opts);
CMeasure(cc, opts);

copts := CopyFields(opts, rec(
   generateComplexCode := true,
   XType := TComplex,
   YType := TComplex,
   dataType := "complex",
   unparser := CMacroUnparser,
   includes := ["<include/complex_gcc_sse3.h>"]
));

opts := copts;

r  := RandomRuleTree(Tensor(I(n), BRDFT3(4,1/16)), opts);
rr := RandomRuleTree(Tensor(I(n), RC(SkewDFT(2,1/16))), opts);

c  := CodeRuleTree(r, opts);;
cc := CodeRuleTree(rr, opts);;


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

# -----------------------------
# Special extension definitions
# ------------------------------

# periodic
Class(per, rec(
    __call__ := (self, k) >> WithBases(self, rec(n:=k, operations:=PrintOps)),
    print := self >> Print(self.name, "(", self.n, ")"),
    left  := (self, N) >> fAdd(N, self.n, N - self.n),
    right := (self, N) >> fAdd(N, self.n, 0),
));

# half-point symmetric
Class(hs, rec(
    __call__ := (self, k) >> WithBases(self, rec(n:=k, operations:=PrintOps)),
    print := self >> Print(self.name, "(", self.n, ")"),

    left  := (self, N) >> fCompose(fAdd(N, self.n, 0), J(self.n)),
    right := (self, N) >> fCompose(fAdd(N, self.n, N-self.n),J(self.n))
));

# whole-point symmetric
Class(ws, rec(
    __call__ := (self, k) >> WithBases(self, rec(n:=k, operations:=PrintOps)),
    print := self >> Print(self.name, "(", self.n, ")"),

    left  := (self, N) >> fCompose(fAdd(N, self.n, 1), J(self.n)),
    right := (self, N) >> fCompose(fAdd(N, self.n, N-self.n-1),J(self.n))
));

# zero padding - doing nothing, just returning the extension length
Class(zer, rec(
    __call__ := (self, k) >> WithBases(self, rec(n:=k, operations:=PrintOps)),
    print := self >> Print(self.name, "(", self.n, ")"),
    left  := (self, N) >> self.n,
    right := (self, N) >> self.n,
));

# ******************************
#  Operations on polynomials
# ******************************

ListPoly := (p) -> [p.coefficients, p.valuation];

ListSum := function(l1,l2)
  local i, d1, d2, dm, l;

  l := [];
  d1 := Length(l1);
  d2 := Length(l2);
  dm := Minimum(d1,d2);
  for i in [1..dm] do
     l[i] := l1[i]+l2[i];od;
  if d2 > dm then Append(l,l2{[dm+1..d2]});
  else Append(l,l1{[dm+1..d1]});
  fi;
  return l;
end;

ListPolyMat := function(M)
   local S,L,V;
   S:=List(M, j-> ListPoly(j));
   L:=List(S, i->i[1]);
   V:=List(S, i->i[2]);

  return [L,V];
end;

Shift := function(h, sh)
local g;

if IsPolynomial(h) then
g := ShallowCopy(h);
g.valuation := h.valuation + sh;
return g;
else
return [h[1],h[2]+sh];
fi;
end;

Upsample := function(h)
local i, L, g;
L:=[];
 g:=ShallowCopy(h);
 if Length(h.coefficients)=1 then
  Add(L,h.coefficients[1]);
 elif Length(h.coefficients)>1 then
  for i in [1..Length(h.coefficients)-1] do
    Add(L, h.coefficients[i]);
    Add(L, h.baseRing.zero);
  od;
  Add(L, h.coefficients[i+1]);
 fi;
  g.coefficients := L;
  g.valuation := h.valuation * 2;
  return g;
end;

# Downsample creates apolynomial of even coefficients
# h_e(z^2) =1/2*( h(z)+h(-z) )

Downsample := function(h)
local i, L, g, even, odd, v, l, k, coef;

 if IsPolynomial(h) then L:= ListPoly(h); coef:=L[1]; l:=L[2];
 else coef:=h[1]; l:=h[2]; fi;
 L:=[];
 k := l mod 2;
    even := Filtered([1..Length(coef)], i-> i mod 2 = 0);
    odd := Filtered([1..Length(coef)], i-> i mod 2 = 1);

  if (k=0) then
    L:= Sublist(coef,odd);
    v := l/2;
  else
    L := Sublist(coef,even);
    v := Int((l+1)/2);
  fi;

  #g.coefficients := L;
  #g.valuation :=v;
  return [L,v];
end;

DownsampleTwo := function(h)
local he, ho;

if IsPolynomial(h) then h:=ListPoly(h); fi;
he:=Downsample(h);
ho:=Downsample(Shift(h,1));
if h[2] mod 2 = 0 then
ho:=Shift(ho,-1);
fi;

return[he,ho];
end;

DownsampleTwoNeg := function(h)
local he, ho;

he:=Downsample(h);
ho:=Downsample(Shift(h,-1));
if h[2] mod 2 = 0 then
ho:=Shift(ho,1);
fi;

return[he,ho];
end;

PosInt := (int) -> (int + AbsInt(int))/2;

#F Positive(n)
#F returns positive value of n thresholded at 0
#F
Positive := (n) -> When(n>0, n, 0);

#F Poly(L,v)
#F Creates a polynomial L[1]*z^(v+k-1) + ... + L[k]*z^v
#F

Poly := function(arg)
local z,L,v;
z:=Indeterminate(Cyclotomics);
z.name:="z";
L := When(IsList(arg[1]),arg[1],[arg[1]]);
v := When(Length(arg)<2,0,arg[2]);
return Polynomial(Cyclotomics, L, v);
end;

#F PolyMat(L,V)
#F Creates a polynomial matrix out of coefficient and valuation matrices
#F

PolyMat := function(L,V)
local M,dim;
dim:=Dimensions(V);
M := List([1..dim[1]],i->List([1..dim[2]],j->Poly(L[i][j],V[i][j])));
return M;
end;

#F PolyExtension(p(z))
#F Computes extension lengths for poynomial p(z)
#F
PolyExtension := p -> let(
    l := Positive(-p.valuation),
    r := Positive(LaurentDegree(p)+p.valuation),
    [l, r]
);

#F FillZeros := function(L,v)
#F fills zeros in the list of polynomial coefficients up to z^0
#F
FillZeros := function(p)
local w,Ls,L,v;
if IsList(p) then
L:=p[1];
v:=p[2];
else
L:= p.coefficients;
v:= p.valuation;
fi;

w:= v+Length(L)-1;
Ls:= L;
if w<=0 then
  Ls := Concat(L,List([1..-w], i->0));
  #k := -w;
elif v>=0 then
  Ls := Concat(List([1..v], i->0), L);
  #k := v;
fi;
return [Ls,-Positive(-v)];
end;

#F FillZerosMat := function(L,v)
#F fills zeros in the list of polynomial coefficients up to z^0
#F

FillZerosMat := function(p)
local S,L,V,dim;

dim := Dimensions(p);
L:=List(p, i->List(i, j->  j.coefficients));
V:=List(p, i->List(i, j->  j.valuation));

S:=List([1..dim[1]],i->List([1..dim[2]],j-> FillZeros([L[i][j],V[i][j]])));
L:=List(S, i->List(i, j-> j[1]));
V:=List(S, i->List(i, j-> j[2]));

return [L,V];
end;

TimeReverse := (L,v) -> let(
               deg := Length(L),
               [Reversed(L),-(v+deg)+1]);

TimeReverseMat := function(arg)
   local S,L,V,Ls,Vs,deg;

if Length(arg)=1 then L:=arg[1][1]; V:=arg[1][2];
else L:=arg[1]; V:=arg[2]; fi;

deg := Length(V);
S:=List([1..deg],i->TimeReverse(L[i],V[i]));
Ls:=List(S,i->i[1]);
Vs:=List(S,i->i[2]);
return [Ls,Vs];
end;

Alternate := (L) -> [List([1..Length(L[1])], i->(-1)^(L[2]+i-1)*L[1][i]),L[2]];

Synth2AnalFilts := function(L,V)

 local ht,gt,h,g;

 h:=TimeReverse(L[1],V[1]);
 g:=TimeReverse(L[2],V[2]);

 h:=Alternate(h);
 g:=Alternate(g);

 ht:=[];
 gt:=[];

 ht[1] := g[1];
 ht[2] := g[2]+1;
 gt[1] := -h[1];
 gt[2] := h[2]+1;

 return [[ht[1],gt[1]],[ht[2],gt[2]]];

end;

Anal2SynthFilts := function(L,V)

 local ht,gt,g,h;
 h:=TimeReverse(L[1],V[1]);
 g:=TimeReverse(L[2],V[2]);

 h:=Alternate(h);
 g:=Alternate(g);

 ht:=[];
 gt:=[];

 ht[1] := g[1];
 ht[2] := g[2]+1;
 gt[1] := -h[1];
 gt[2] := h[2]+1;

 return [[ht[1],gt[1]],[ht[2],gt[2]]];

end;

# wraps a polynomial given as Poly or as List+valuation periodically
# for circulants
CircularWrap := function(arg)
local L,v,l,r,n;
if (Length(arg) = 2) then
if IsPolynomial(arg[1]) then
l:=ListPoly(arg[1]);
else l:=arg[1];fi;
L:=l[1];
v:=l[2];
n:=arg[2];
else
L:=arg[1];
v:=arg[2];
n:=arg[3];
fi;

r:= Length(L)+v-1;
if v>0 then L:=Concat(Replicate(v,0),L);fi;

if r <n then
L:=Concat(L, Replicate(n-r-1,0));
L:=L*MatSPL(Ext(n,per(PosInt(-v)),per(0)));
else
L:=L*MatSPL(Ext(n,per(PosInt(-v)),per(r-n+1)));
fi;

# Circulant needs first column as param instead of first row (need to be changed)

l:= Reversed(L{[2..Length(L)]});
L:=Concat([L[1]],l);

return L;
end;

#
# Helper functions for non-terminal arguments
#
toSize := o -> Cond(
    IsPosInt(o), o,
    IsList(o), Length(o),
    IsPolynomial(o), Length(o.coefficients),
    IsFunction(o), o.domain(),
    Error("List, polynomial, or generating function expected"));

toFunc := o -> Cond(
    IsPosInt(o), FUnk(o),
    IsList(o), Checked(o<>[], FList(UnifyTypesV(o), o)),
    IsPolynomial(o), FList(UnifyTypesV(o.coefficients), o.coefficients),
    IsFunction(o),   o,
    Error("List, polynomial, or generating function expected"));

toValuation := o -> Cond(
    IsPosInt(o), 0,
    IsList(o), 0,
    IsPolynomial(o), o.valuation,
    IsFunction(o), 0,
    Error("List, polynomial, or generating function expected"));

QuantizeQuarters := rat -> Cond(0  <= rat and rat <= 3/8, 1/4,
                                3/8 < rat and rat <= 5/8, 1/2,
                                5/8 < rat and rat <= 7/8, 3/4,
				1);

toFiltFunc := o -> Cond(
    IsPosInt(o),
        [ fUnk(TReal, o), -o+1],
    IsList(o), Checked(o<>[],
	[ toFunc(o), -Length(o)+1 ]),
    IsPolynomial(o), let(zp := FillZeros(o),
        [ toFunc(zp[1]), zp[2] ]),
    IsFunction(o) or IsFuncExp(o),
        [ o, -o.domain()+1 ],
    Error("List, polynomial, or generating function expected"));

toFiltFuncV := (o,v) -> Cond(
    IsPosInt(o), let(w := v+o-1,
	When(w < 0 or v > 0,
	    Error("Valuation does not match domain of <o>, can't zero-pad a gener. function"),
        [ fUnk(TReal, o), v])),
    IsList(o), Checked(o<>[], let(zp := FillZeros([o,v]),
	[ toFunc(zp[1]), zp[2] ])),
    IsFunction(o) or IsFuncExp(o), let(dom := o.domain(), w := v+dom-1,
	When(w < 0 or v > 0,
	    Error("Valuation does not match domain of <o>, can't zero-pad a gener. function"),
	    [ o, -o.domain()+1 ])),
    Error("Only list or generating function can be specified with separate valuation"));


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

############################################################################
##
#I  TestFlag(<n>, <i>)
##
##  tests if the i-th bit is set in binary representation the nonnegative
##  integer n
##
InstallGlobalFunction(TestFlag,
    function(n, i)
        return QuoInt(n, 2^i) mod 2 = 1;
    end);

############################################################################
##
#F  CodeCharacteristicPolynomial(<mat>, <q>)
##
##  given a matrix mat over GF(q), this computes a number which uniquely
##  identifies the characteristic polynomial of mat.
##
InstallGlobalFunction(CodeCharacteristicPolynomial,
    function(mat, q)

        local cf, z, sum, c;

        z := Z(q);
        if Length(mat) = 2 then
            cf := [ mat[1][1]*mat[2][2] - mat[1][2]*mat[2][1],
                    - mat[1][1] - mat[2][2],
                    z^0];
        elif Length(mat) = 3 then
            cf := [ - mat[1][1]*mat[2][2]*mat[3][3] - mat[1][2]*mat[2][3]*mat[3][1] - mat[1][3]*mat[2][1]*mat[3][2]
                    + mat[1][1]*mat[2][3]*mat[3][2] + mat[2][2]*mat[1][3]*mat[3][1] + mat[3][3]*mat[2][1]*mat[1][2],
                    mat[1][1]*mat[2][2] + mat[2][2]*mat[3][3] + mat[1][1]*mat[3][3]
                        - mat[1][2]*mat[2][1] - mat[2][3]*mat[3][2] - mat[1][3]*mat[3][1],
                    - mat[1][1] - mat[2][2] - mat[3][3],
                    z^0];
        else
            cf := CoefficientsOfUnivariatePolynomial(CharacteristicPolynomial(mat, 1));
        fi;

        sum := 0;
        for c in cf do
            if c = 0*z then
                sum := sum * q;
            else
                sum := sum * q + LogFFE(c, z) + 1;
            fi;
        od;

        return sum;
    end);

############################################################################
##
#F  FFMatrixByNumber(n, d, q)
##
##  computes a d x d matrix over GF(q) represented by the integer n
##
InstallGlobalFunction(FFMatrixByNumber,
    function(n, d, q)

        local z, m, i, j, k;

        z := Z(q);
        m := NullMat(d,d, GF(q));

        for i in [d, d-1..1] do
            for j in [d, d-1..1] do
                k := RemInt(n, q);
                n := QuoInt(n, q);
                if k > 0 then
                    m[i][j] := z^(k-1);
                fi;
            od;
        od;
        ConvertToMatrixRep(m, q);
        return m;
    end);

############################################################################
##
#F  CanonicalPcgsByNumber(<pcgs>, <n>)
##
##  computes the canonical pcgs wrt. pcgs represented by the integer n
##
InstallGlobalFunction(CanonicalPcgsByNumber,
    function(pcgs, n)

        local gens, cpcgs;

        gens := List(ExponentsCanonicalPcgsByNumber(RelativeOrders(pcgs), n),
            exp -> PcElementByExponents(pcgs, exp));
        cpcgs := InducedPcgsByPcSequenceNC(pcgs, gens);
        SetIsCanonicalPcgs(cpcgs, true);
        return cpcgs;
    end);

############################################################################
##
#F  OrderGroupByCanonicalPcgsByNumber(<pcgs>, <n>)
##
##  computes Order(Group(CanonicalPcgsByNumber(<pcgs>, <n>))) without
##  actually constructing the canonical pcgs or the group
##
InstallGlobalFunction(OrderGroupByCanonicalPcgsByNumber,
    function(pcgs, n)

        local ros, order, j;

        order := 1;
        ros := RelativeOrders(pcgs);
        n := RemInt(n, 2^Length(ros));
        for j in [1..Length(ros)] do
            if RemInt(n, 2) > 0 then
                order := order * ros[j];
            fi;
            n := QuoInt(n, 2);
        od;
        return order;
    end);

############################################################################
##
#F  ExponentsCanonicalPcgsByNumber(<ros>, <n>)
##
##  computes the list of exponent vectors of the
##  elements of CanonicalPcgsByNumber(<pcgs>, <n>)) without actually
##  constructing the canonical pcgs itself - it is enough to know the
##  relative orders of the pc elements
##
InstallGlobalFunction(ExponentsCanonicalPcgsByNumber,
    function(ros, n)

        local depths, len, d, exps, exp, j, cpcgs;
        depths := [];
        len := Length(ros);
        for j in [1..len] do
            d := RemInt(n, 2);
            n := QuoInt(n, 2);
            if d > 0 then
                Add(depths, j);
            fi;
        od;

        exps := [];
        for d in depths do
            exp := ListWithIdenticalEntries(len, 0);
            exp[d] := 1;
            for j in [d+1..len] do
                if not j in depths then
                    exp[j] := RemInt(n, ros[j]);
                    n := QuoInt(n, ros[j]);
                fi;
            od;
            Add(exps, exp);
        od;

        return exps;
    end);

############################################################################
##
#F  IsMatGroupOverFieldFam(famG, famF)
##
##  tests whether famG is the collections family of matrices over the field
##  whose family is famF
##
InstallGlobalFunction(IsMatGroupOverFieldFam, function(famG, famF)
    return CollectionsFamily(CollectionsFamily(famF)) = famG;
end);

############################################################################
##
#V  IRREDSOL_DATA.PRIME_POWERS
##
##  cache of proper prime powers, preset to all prime powers <= 65535
##
IRREDSOL_DATA.PRIME_POWERS :=
[ 4, 8, 9, 16, 25, 27, 32, 49, 64, 81, 121, 125, 128, 169, 243, 256, 289,
  343, 361, 512, 529, 625, 729, 841, 961, 1024, 1331, 1369, 1681, 1849, 2048,
  2187, 2197, 2209, 2401, 2809, 3125, 3481, 3721, 4096, 4489, 4913, 5041,
  5329, 6241, 6561, 6859, 6889, 7921, 8192, 9409, 10201, 10609, 11449, 11881,
  12167, 12769, 14641, 15625, 16129, 16384, 16807, 17161, 18769, 19321,
  19683, 22201, 22801, 24389, 24649, 26569, 27889, 28561, 29791, 29929,
  32041, 32761, 32768, 36481, 37249, 38809, 39601, 44521, 49729, 50653,
  51529, 52441, 54289, 57121, 58081, 59049, 63001 ];

############################################################################
##
#F  IsPPowerInt(q)
##
##  tests whether q is a positive prime power, caching new prime powers
##
InstallGlobalFunction(IsPPowerInt,
    function(q)
        if not IsPosInt(q) then
            return false;
        elif IsPrimeInt(q) then
            return true;
        elif q in IRREDSOL_DATA.PRIME_POWERS then
            return true;
        elif IsPrimePowerInt(q) then
            AddSet(IRREDSOL_DATA.PRIME_POWERS, q);
            return true;
        else
            return false;
        fi;
    end);

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


#############################################################################
##
#W  smlinfo.gi               GAP group library             Hans Ulrich Besche
##                                               Bettina Eick, Eamonn O'Brien
##
##  This file contains the ...
##

#############################################################################
##
#F  SMALL_GROUPS_INFORMATION
##
##  ...
SMALL_GROUPS_INFORMATION := [ ];

#############################################################################
##
#F  SmallGroupsInformation( size )
##
##  ...
InstallGlobalFunction( SmallGroupsInformation, function( size )
    local smav, idav, num, lib, t;

    if not IsPosInt(size) then
      ErrorNoReturn("usage: SmallGroupsInformation( size )");
    fi;

    smav := SMALL_AVAILABLE( size );
    idav := ID_AVAILABLE( size );

    if size = 1024 then
        Print( "The groups of size 1024 are not available. \n");
        return;
    fi;

    if smav = fail then
        Print( "The groups of size ", size, " are not available. \n");
        return;
    fi;

    lib := 1;
    if IsBound( smav.lib ) then
        lib := smav.lib;
    fi;

    if IsBound( smav.number ) then
        num := smav.number;
    else
        num := NUMBER_SMALL_GROUPS_FUNCS[ smav.func ]( size, smav ).number;
    fi;
    if num = 1 then
        Print("\n  There is 1 group of order ",size,".\n");
    else
        Print("\n  There are ",num," groups of order ",size,".\n" );
    fi;

    SMALL_GROUPS_INFORMATION[ smav.func ]( size, smav, num );

    Print("\n  This size belongs to layer ",lib,
          " of the SmallGroups library. \n");

    if idav <> fail then
        Print("  IdSmallGroup is available for this size. \n \n");
    else
        Print("  IdSmallGroup is not available for this size. \n \n");
    fi;
end );

#############################################################################
##
#F SMALL_GROUPS_INFORMATION[ 1 ]( size, smav, num )
##
SMALL_GROUPS_INFORMATION[ 1 ] := function( size, smav, num )
    Print("\n");
    Print("  The groups whose order factorises in at most 3 primes \n");
    Print("  have been classified by O. Hoelder. This classification is \n");
    Print("  used in the SmallGroups library. \n");
end;

SMALL_GROUPS_INFORMATION[ 2 ] := SMALL_GROUPS_INFORMATION[ 1 ];
SMALL_GROUPS_INFORMATION[ 3 ] := SMALL_GROUPS_INFORMATION[ 1 ];
SMALL_GROUPS_INFORMATION[ 4 ] := SMALL_GROUPS_INFORMATION[ 1 ];
SMALL_GROUPS_INFORMATION[ 5 ] := SMALL_GROUPS_INFORMATION[ 1 ];
SMALL_GROUPS_INFORMATION[ 6 ] := SMALL_GROUPS_INFORMATION[ 1 ];
SMALL_GROUPS_INFORMATION[ 7 ] := SMALL_GROUPS_INFORMATION[ 1 ];

#############################################################################
##
#F SMALL_GROUPS_INFORMATION[ 8 .. 10 ]( size, smav, num )
##
SMALL_GROUPS_INFORMATION[ 8 ] := function( size, smav, num )
    local ffid, prop, i, l;

    ffid := IdGroup( OneSmallGroup( size, FrattinifactorSize, size ) );
    prop := PROPERTIES_SMALL_GROUPS[ size ].frattFacs;

    if not IsPrimePowerInt( size ) then
        Print("  They are sorted by their Frattini factors. \n");
        i := 1;
        if ffid[ 2 ] > 1 then
            repeat
                if prop.pos[ i ][ 1 ] = -prop.pos[ i ][ 2 ] then
                    Print( "     ", prop.pos[ i ][ 1 ],
                       " has Frattini factor ", prop.frattFacs[ i ], ".\n"  );
                else
                    Print( "     ", prop.pos[ i ][ 1 ], " - ",
                       -prop.pos[ i ][ 2 ], " have Frattini factor ",
                       prop.frattFacs[ i ], ".\n"  );
                fi;
                i := i + 1;
            until prop.frattFacs[ i ] = ffid;
        fi;
        Print("     ", ffid[2], " - ", num,
              " have trivial Frattini subgroup.\n");
    else
        Print("  They are sorted by their ranks. \n");
        Print("     ", 1, " is cyclic. \n");
        i := 2;
        repeat
            l := Length( Factors( prop.frattFacs[ i ][1] ) );
            if prop.pos[ i ][ 1 ] = -prop.pos[ i ][ 2 ] then
                Print( "     ", prop.pos[ i ][ 1 ], " has rank ", l, ".\n"  );
            else
                Print( "     ", prop.pos[ i ][ 1 ], " - ",
                       -prop.pos[ i ][ 2 ], " have rank ", l, ".\n"  );
            fi;
            i := i + 1;
        until prop.frattFacs[ i ] = ffid;
        Print("     ", ffid[2], " is elementary abelian. \n");
    fi;

    Print( "\n  For the selection functions the values of the ",
           "following attributes \n  are precomputed and stored:\n ");
    if IsPrimePowerInt( size ) then
        Print( "    IsAbelian, PClassPGroup, RankPGroup,",
               " FrattinifactorSize and \n     FrattinifactorId. \n");
    else
        Print( "    IsAbelian, IsNilpotentGroup,",
               " IsSupersolvableGroup, IsSolvableGroup, \n     LGLength,",
               " FrattinifactorSize and FrattinifactorId. \n");
    fi;
end;
SMALL_GROUPS_INFORMATION[ 9 ] := SMALL_GROUPS_INFORMATION[ 8 ];
SMALL_GROUPS_INFORMATION[ 10 ] := SMALL_GROUPS_INFORMATION[ 8 ];

#############################################################################
##
#F SMALL_GROUPS_INFORMATION[ 11, 17 ]( size, smav, num )
##
SMALL_GROUPS_INFORMATION[ 11 ] := function( size, smav, num )
    local i, q;

    q := 2;
    if IsBound( smav.q ) then q := smav.q; fi;

    Print("  They are sorted by normal Sylow subgroups. \n");
    Print( "     1 - ", smav.pos[ 2 ], " are the nilpotent groups.\n" );
    for i in [ 2 .. Length( smav.types ) ] do
        Print( "     ", smav.pos[i] + 1, " - ", smav.pos[i+1] );
        if smav.types[ i ] = "p-autos" then
            Print( " have a normal Sylow ", q,"-subgroup. \n");
        elif smav.types[ i ] = "none-p-nil" then
            Print( " have no normal Sylow subgroup. \n");
        elif IsInt( smav.types[ i ] ) then
            Print( " have a normal Sylow ", smav.p, "-subgroup \n");
            Print( "                     with centralizer of index ");
            Print( q^smav.types[i],".\n");
        fi;
    od;
end;
SMALL_GROUPS_INFORMATION[ 17 ] := SMALL_GROUPS_INFORMATION[ 11 ];

#############################################################################
##
#F SMALL_GROUPS_INFORMATION[ 12 ]( size, smav, num )
##
SMALL_GROUPS_INFORMATION[ 12 ] := function( size, smav, num )

    if size = 1152 then
        Print("  They are sorted using Sylow subgroups. \n");
        Print("     1 - 2328 are nilpotent with Sylow 3-subgroup c9.\n" );
        Print("     2329 - 4656 are nilpotent with Sylow 3-subgroup 3^2.\n");
        Print("     4657 - 153312 are non-nilpotent with normal ");
        Print("Sylow 3-subgroup.\n");
        Print("     153313 - 157877 have no normal Sylow 3-subgroup.\n");
        return;
    fi;

    Print("  They are sorted using Hall subgroups. \n");
    Print( "     1 - 2328 are the nilpotent groups.\n" );
    Print( "     2329 - 236344 have a normal Hall (3,5)-subgroup.\n");
    Print( "     236345 - 240416 are solvable without normal Hall",
           " (3,5)-subgroup.\n");
    Print( "     240417 - 241004 are not solvable.\n" );
end;

#############################################################################
##
#F SMALL_GROUPS_INFORMATION[ 14 ]( size, smav, num )
##
SMALL_GROUPS_INFORMATION[ 14 ] := function( size, smav, num )

    Print( "     1 - 10494213 are the nilpotent groups.\n" );
    Print( "     10494214 - 408526597 have a normal Sylow 3-subgroup.\n" );
    Print( "     408526598 - 408544625 have a normal Sylow 2-subgroup.\n" );
    Print( "     408544626 - 408641062 have no normal Sylow subgroup.\n" );
end;

#############################################################################
##
#F SMALL_GROUPS_INFORMATION[ 18 ]( size, smav, num )
##
SMALL_GROUPS_INFORMATION[ 18 ] := function( size, smav, num )

    Print( "     1 is cyclic. \n");
    Print( "     2 - 10 have rank 2 and p-class 3.\n" );
    Print( "     11 - 386 have rank 2 and p-class 4.\n" );
    Print( "     387 - 1698 have rank 2 and p-class 5.\n" );
    Print( "     1699 - 2008 have rank 2 and p-class 6.\n" );
    Print( "     2009 - 2039 have rank 2 and p-class 7.\n" );
    Print( "     2040 - 2044 have rank 2 and p-class 8.\n" );
    Print( "     2045 has rank 3 and p-class 2.\n" );
    Print( "     2046 - 29398 have rank 3 and p-class 3.\n" );
    Print( "     29399 - 30617 have rank 3 and p-class 4.\n" );
    Print( "     30618 - 31239 have rank 3 and p-class 3.\n" );
    Print( "     31240 - 56685 have rank 3 and p-class 4.\n" );
    Print( "     56686 - 60615 have rank 3 and p-class 5.\n" );
    Print( "     60616 - 60894 have rank 3 and p-class 6.\n" );
    Print( "     60895 - 60903 have rank 3 and p-class 7.\n" );
    Print( "     60904 - 67612 have rank 4 and ", "p-class 2.\n" );
    Print( "     67613 - 387088 have rank 4 and ", "p-class 3.\n" );
    Print( "     387089 - 419734 have rank 4 and ", "p-class 4.\n" );
    Print( "     419735 - 420500 have rank 4 and ", "p-class 5.\n" );
    Print( "     420501 - 420514 have rank 4 and ", "p-class 6.\n" );
    Print( "     420515 - 6249623 have rank 5 and ", "p-class 2.\n" );
    Print( "     6249624 - 7529606 have rank 5 and ", "p-class 3.\n" );
    Print( "     7529607 - 7532374 have rank 5 and ", "p-class 4.\n" );
    Print( "     7532375 - 7532392 have rank 5 and ", "p-class 5.\n" );
    Print( "     7532393 - 10481221 have rank 6 and ", "p-class 2.\n" );
    Print( "     10481222 - 10493038 have rank 6 and ", "p-class 3.\n" );
    Print( "     10493039 - 10493061 have rank 6 and ", "p-class 4.\n" );
    Print( "     10493062 - 10494173 have rank 7 ", "and p-class 2.\n" );
    Print( "     10494174 - 10494200 have rank 7 ", "and p-class 3.\n" );
    Print( "     10494201 - 10494212 have rank 8 ", "and p-class 2.\n" );
    Print( "     10494213 is elementary abelian.\n");
end;

#############################################################################
##
#F SMALL_GROUPS_INFORMATION[ 19 ]( size, smav, num )
##
SMALL_GROUPS_INFORMATION[ 19 ] := function( size, smav, num )

  Print("  They are sorted by their ranks. \n");
  Print( "     1 is cyclic. \n");
  Print( "     2 - 10 have rank 2. \n");
  Print( "     11 - 14 have rank 3. \n");
  Print( "     15 is elementary abelian. \n");
end;

#############################################################################
##
#F SMALL_GROUPS_INFORMATION[ 20 ]( size, smav, num )
##
SMALL_GROUPS_INFORMATION[ 20 ] := function( size, smav, num )
    local p, a, b, c;

    p := Factors(size)[1];
    a:=27 + p   + 2*GcdInt(p-1,3) + GcdInt(p-1,4);
    b:=54 + 2*p + 2*GcdInt(p-1,3) + GcdInt(p-1,4);
    c:=60 + 2*p + 2*GcdInt(p-1,3) + GcdInt(p-1,4);

    Print( "  They are sorted by their ranks.\n" );
    Print( "     1 is cyclic.\n");
    Print( "     2 - ",a," have rank 2. \n");
    Print( "     ",a+1," - ",b," have rank 3. \n");
    Print( "     ",b+1," - ",c," have rank 4. \n");
    Print( "     ",c+1," is elementary abelian. \n");
end;

#############################################################################
##
#F SMALL_GROUPS_INFORMATION[ 21 ]( size, smav, num )
##
SMALL_GROUPS_INFORMATION[ 21 ] := function( size, smav, num )

   Print( " \n");
   Print( "      Easterfield (1940) constructed a list of the groups of\n");
   Print( "      order p^6 for p >= 5.\n \n");

   Print( "      The database of parametrised presentations for the groups \n");
   Print( "      with order p^6 for p >= 5 is based on the Easterfield \n");
   Print( "      list, corrected by Newman, O'Brien and Vaughan-Lee (2004).\n");
   Print( "      It differs only in the addition of groups in isoclinism \n");
   Print( "      family $\\Phi_{13}$, in using the James (1980) presentations \n");
   Print( "      for the groups in $\\Phi_{19}$, and a small number of \n");
   Print( "      typographical amendments. The linear ordering employed is \n");
   Print( "      very close to that of Easterfield. \n \n");

   Print( "      Each group with order $p^6$ is described by a power- \n");
   Print( "      commutator presentation on 6 generators and 21 relations:\n");
   Print( "      15 are commutator relations and 6 are power relations. \n");
   Print( "      Each presentation has the prime $p$ as a parameter. \n");
   Print( "      The database contains about 500 parametrised \n");
   Print( "      presentations, most of these have $p$ as the only \n");
   Print( "      parameter. \n");

end;

#############################################################################
##
#F SMALL_GROUPS_INFORMATION[ 24 ]( size, smav, num )
##
SMALL_GROUPS_INFORMATION[ 24 ] := function( size, smav, num )
    local i, set, c;

    Print( "\n" );
    Print( "  The groups of squarefree order have a cylic socle and a " );
    Print( "cylic socle factor.\n" );

    Print( "\n" );
    i := 0;
    for set in smav.sets do
        c := Product( smav.primes{ set.kp } );
        if c = 1 then
            Print( "    1 is abelian\n" );
        elif set.number = 1 then
            Print( "    ", i + 1, " has socle C_" );
            Print( size / c, " and factor C_", c, "\n" );
        else
            Print( "    ", i + 1, " - ", i + set.number, " have socle C_" );
            Print( size / c, " and factor C_", c, "\n" );
        fi;
        i := i + set.number;
    od;
end;

#############################################################################
##
#F SMALL_GROUPS_INFORMATION[ 25 ]( size, smav, num )
##
SMALL_GROUPS_INFORMATION[ 25 ] := function( size, smav, num )
    local i, set, c;
    Print( "\n" );
    Print( "  The groups of cubefree order are either solvable or a direct ",
           "product of \n  the form PSL( 2, p ) x solvable group. ",
           "The cubefree solvable groups are \n  determined by their Frattini",
           " factor.\n\n" );

    i := 0;
    for set in smav.sets do
      if set.psl_p = 1 then
        if set.size_phi = 1 then
          if set.number = 1 then
            Print( "    ", i + 1, " is solvable and Frattini free\n" );
          else
            Print( "    ", i + 1, " - ", i + set.number, " are solvable ",
                   "and Frattini free\n" );
          fi;
        else
          if set.number = 1 then
            Print( "    ", i + 1, " is solvable with Frattini factor of ",
                   "size ", set.size_ff, "\n" );
          else
            Print( "    ", i + 1, " - ", i + set.number, " are solvable ",
                   "with Frattini factor of size ", set.size_ff, "\n" );
          fi;
        fi;
      elif
        set.size_ff = 1 then
          Print( "    ", i + 1, " is PSL( 2, ", set.psl_p, " )\n" );
      else
        if set.size_phi = 1 then
          if set.number = 1 then
            Print( "    ", i + 1, " is PSL( 2, ", set.psl_p, " ) x F, F ",
                   "solvable and Frattini free of order ", set.size_ff, "\n");
          else
            Print( "    ", i + 1, " - ", i + set.number, " are PSL( 2, ",
                   set.psl_p, " ) x F_i, F_i solvable ",
                   "Frattini free of order ", set.size_ff, "\n" );
          fi;
        else
          if set.number = 1 then
            Print( "    ", i + 1, " is PSL( 2, ", set.psl_p, " ) x G, G ",
                   "solvable of order ", set.size_ff * set.size_phi,
                   " with a Frattini factor\n      of order ", set.size_ff,
                   "\n");
          else
            Print( "    ", i + 1, " - ", i + set.number, " are PSL( 2, ",
                   set.psl_p, " ) x G_i, G_i ", "solvable of order ",
                   set.size_ff * set.size_phi, " with a",
                   "\n      Frattini factor of order ", set.size_ff, "\n");
          fi;
        fi;
      fi;
      i := i + set.number;
    od;
end;

#############################################################################
##
#F SMALL_GROUPS_INFORMATION[ 26 ]( size, smav, num )
##
SMALL_GROUPS_INFORMATION[ 26 ] := function( size, smav, num )

   Print( " \n");
   Print( "      E.A. O'Brien and M.R. Vaughan-Lee determined presentations\n");
   Print( "      of the groups with order p^7. A preprint of their paper is\n");
   Print( "      available at\n" );
   Print( "      http://www.math.auckland.ac.nz/%7Eobrien/research/p7/paper-p7.pdf\n\n" );
   Print( "      For p in { 3, 5, 7, 11 } explicit lists of groups of order\n");
   Print( "      p^7 have been produced and stored into the database.\n\n");
   Print( "      Giving the power commutator presentations of any of these\n");
   Print( "      groups using a standard notation they might be reduced to 35\n");
   Print( "      elements of the group or a 245 p-digit number.\n\n");
   Print( "      Only 56 of these digits may be unlike 0 for any group and\n");
   Print( "      even these 56 digits are mostly like 0. Further on these\n");
   Print( "      digits are often quite likely for sequences of subsequent\n");
   Print( "      groups. Thus storage of groups was done by finding a so\n");
   Print( "      called head group and a so called tail. Along the tail\n");
   Print( "      only the different digits compared to the head are relevant.\n");
   Print( "      Even the tails occur more or less often and this is used\n");
   Print( "      to improve storage too. Since p^7 is too big the data is\n");
   Print( "      stored into some remaing holes of SMALL_GROUP_LIB at\n");
   Print( "      Primes[ p + 10 ].\n");

end;


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

nz := x->When(x=0,0,1);
ps := x -> PrintMat(MapMat(x,nz));
crdiag := rr -> List([1..DimensionsMat(rr)[1]/2],
    i->rr[2*i-1][2*i-1] + E(4)*rr[2*i][2*i-1]);

submat := (m, rbegin, colbegin, size) -> List(m{[rbegin..rbegin+size-1]}, x->x{[colbegin..colbegin+size-1]});

N := 8;
m := 4;
n := N/m;

BIGNT := PRDFT4;
RIGHTNT := PRDFT4;
LEFTNT := BIGNT;

# DTT -> K^N_m (dirsum SkewDTT(m)) (DST3(n) tensor I(m)) B^N_m
ck := MatSPL(K(N,m));
cm := ck^-1;
rk := RCMatCyc(ck);
rm := RCMatCyc(cm);

big := MatSPL(BIGNT(2*N));
lhs := Tensor(I(n), LEFTNT(2*m));
rhs := Tensor(RIGHTNT(n), I(2*m));
quo := MatSPL(lhs)^-1 * rm * big;  #pquo := quo ^ MatSPL(L(2*N, n)); squo := MapMat(pquo, nz);
rb := quo * MatSPL(rhs)^-1;

# N=2, m=2, n=4
#prb := (MatSPL(L(16,2)*Tensor(M(8,4),I(2)))*rb*MatSPL(L(16,8)));

#TensorProductMat(IdentityMat(2*m), MatSPL(IPRDFT2(n,-1)*Diag(2,2,1,1)));
#PRDFT3(n))^-1);
#IPRDFT2(n,-1)*Diag(2,2,1,1)));

#pquo := quo ^ MatSPL(L(2*N, 2*n));
#blocks := List([1..m], x -> pquo{[1+2*n*(x-1) .. 2*n*x]}{[1+2*n*(x-1) .. 2*n*x]});

#brfinv := MatSPL(PRDFT3(2*n))^-1;
#rdiag := List(blocks, b -> b * brfinv);
#cdiag := List(rdiag, crdiag);
#diag := MatSPL(L(2*N, m)) * quo * MatSPL(L(2*N, 2*n)) * TensorProductMat(IdentityMat(m), brfinv);


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

# !!!! what's missing: CRT of 2 primes perm pullout

RewriteRules(RulesFuncSimp, rec(
 # ===================================================================
 # OddStride
 # ===================================================================
 OS_Id := Rule([OS, @N, 1], e->fId(@N.val)),

 OS_OS := ARule(fCompose, [[OS, @N, @r], [OS, @, @s]],
     e -> [ OS(@N.val, @r.val * @s.val mod @N.val) ]),

 OS_RR_PhaseShift := ARule( fCompose, [[OS, @N, @r], [RR, @, @phi, @g]],
     e -> [ RR(@N.val, @phi.val * @r.val, @g.val) ]),

 OS_RM_PhaseShift := ARule( fCompose, [[OS, @N, @r], [RM, @, @phi, @g]],
     e -> [ RM(@N.val, @phi.val * @r.val, @g.val) ]),

 # ===================================================================
 # Cyclic shift (Z) propagation
 # Z o (fBase X f)  ->  (Z o f) X (Z o fBase)
 Z_Propagate := ARule(fCompose, [[Z, @, @z], [fTensor, @F, [fBase, @m, @j]]],
     (e, cx) -> [ fTensor(
       fCompose(Z(range(@F.val), memo(cx, "g", idiv(@j.val+@z.val, @m.val))), @F.val),
       fCompose(Z(@m.val, @z.val), fBase(@m.val, @j.val))) ]),

 # ===================================================================
 # CRT / gammaTensor
 # ===================================================================
#   NOTE: This rule triggers problems when fired too early, as gammatensor cannot be transposed -- what to do??
# CRT_toGammaTensor := Rule(CRT, e->e.toGammaTensor()),

 GammaTensorAssoc := ARule(gammaTensor, [@(1,gammaTensor)], e->@(1).val.children()),

 # gammaTensor o fTensor -> gammaTensor( ... o ..., ... o ... , ...)
 GammaTensorMerge := ARule(fCompose,
      [ @(1,gammaTensor), @(2,fTensor,e->compat_tensor_chains(
                         @(1).val.children(), e.children(), domain, range)) ],
 e -> [ gammaTensor(merge_tensor_chains(
       @(1).val.children(), @(2).val.children(), fCompose, x->x, x->x, domain, range))]),

 ### fTensor(..., Y, ...) o X -> fTensor(..., Y o X, ...)
 GammaTensorComposeMergeRight := ARule(fCompose,
      [ @(1,gammaTensor), @(2).cond(e->compat_tensor_chains(
                         @(1).val.children(), [e], domain, range)) ],
 e -> [ gammaTensor(merge_tensor_chains(
       @(1).val.children(), [@(2).val], fCompose, x->x, x->x, domain, range)) ] ),

 ### X o fTensor(..., Y, ...) -> fTensor(..., X o Y, ...)
 GammaTensorComposeMergeLeft := ARule(fCompose,
      [ @(1), @(2,gammaTensor,e->compat_tensor_chains(
                         [@(1).val], e.children(), domain, range)) ],
 e -> [ gammaTensor(merge_tensor_chains(
       [@(1).val], @(2).val.children(), fCompose, x->x, x->x, domain, range)) ] ),

 # ===================================================================
 # Rader permutations
 # ===================================================================
 # NB: RR = fStack(1,RM), RR plugged into gammaTensor, eg. F_15 -> F_3, F_5

 # RR o fAdd(N,1,0) -> (0)_N
 RR_1stPoint_fAdd := ARule(fCompose, [[RR, @N, @phi, @g], [fAdd, @, 1, 0]],
     e -> [ H(@N.val, 1, 0, 1) ]),
 RR_1stPoint_H := ARule(fCompose, [[RR, @N, @phi, @g], [H, @, 1, 0, @]],
     e -> [ H(@N.val, 1, 0, 1) ]),

 # RR o fAdd(N,N-1,1) -> RM
 RR_toRM_fAdd := ARule(fCompose,  [[RR, @N, @phi, @g], [fAdd, @, @(1).cond(e->e=@N.val-1), 1]],
     e -> [ RM(@N.val, @N.val-1, @phi.val, @g.val) ]),
 RR_toRM_H := ARule(fCompose,  [[RR, @N, @phi, @g], [H, @, @(1).cond(e->e=@N.val-1), 1, 1]],
     e -> [ RM(@N.val, @N.val-1, @phi.val, @g.val) ])
));

Class(RulesRaderTensor, RuleSet);

RewriteRules(RulesRaderTensor, rec(
 # RM o fTensor -> RM
 RM_Tensor1 := ARule(fCompose, [ [RM,@N,@n,@phi,@g], [fTensor, @(1,fId), [fBase,@m,@j]] ],
     (e, cx) -> [ RM(@N.val, domain(@1.val),
           memo(cx, "g", powmod(@phi.val,@g.val,@j.val,@N.val)),
           powmod(1,@g.val,@m.val,@N.val).eval()) ] ),

 RM_Tensor2 := ARule(fCompose, [ [RM,@N,@n,@phi,@g], [fTensor, [fBase,@m,@j], @(1,fId)] ],
     (e, cx) -> [ RM(@N.val, domain(@1.val),
           memo(cx, "g", powmod(@phi.val, powmod(1,@g.val,@m.val,@N.val).eval(), @j.val, @N.val)),
           @g.val) ])
));


local reps,tori,labels,I,II,ords,blocks;

reps:=[[[1,1],[2,1],[3,1],[4,1],[5,1],[6,1]],        # E_6
       [[3,1],[5,1],[1,1],[6,1],[9,1],[10,1],[2,1]], # E_6(a_1)
       [[1,1],[3,1],[4,1],[2,1],[5,1]],              # D_5
       [[13,1],[1,1],[15,1],[6,1],[14,1],[4,1]],     # E_6(a_3)
       [[1,1],[3,1],[8,1],[10,1],[2,1],[5,1]],       # D_5(a_1)
       [[1,1],[3,1],[4,1],[5,1],[6,1]],              # A_5
       [[1,1],[3,1],[4,1],[2,1],[6,1]],              # A_4A_1
       [[3,1],[4,1],[2,1],[5,1]],                    # D_4
       [[1,1],[3,1],[4,1],[2,1]],                    # A_4
       [[3,1],[8,1],[10,1],[2,1],[5,1]],             # D_4(a_1)
       [[1,1],[3,1],[4,1],[6,1]],                    # A_3A_1
       [[1,1],[3,1],[5,1],[6,1],[2,1]],              # A_2^2A_1
       [[1,1],[3,1],[4,1]],                          # A_3
       [[2,1],[4,1],[1,1],[6,1]],                    # A_2A_1^2
       [[1,1],[3,1],[5,1],[6,1]],                    # A_2^2
       [[1,1],[3,1],[2,1]],                          # A_2A_1
       [[1,1],[3,1]],                                # A_2
       [[1,1],[4,1],[6,1]],                          # A_1^3
       [[1,1],[6,1]],                                # A_1^2
       [[1,1]]                                       # A_1
       ];

I:=[[],[4],[],[2,3,5],[4],[],[],[],[],[4],
    [],[],[],[],[],[],[],[],[],[]];

#
# The parabolic where the representative is distinguished
#
II:=[[1,2,3,4,5,6],
     [1,2,3,4,5,6],
     [1,2,3,4,5],
     [1,2,3,4,5,6],
     [1,2,3,4,5],
     [1,3,4,5,6],
     [1,2,3,4,6],
     [2,3,4,5],
     [1,2,3,4],
     [2,3,4,5],
     [1,3,4,6],
     [1,2,3,5,6],
     [1,3,4],
     [1,2,4,6],
     [1,3,5,6],
     [1,2,3],
     [1,3],
     [1,4,6],
     [1,6],
     [1]];

labels:=["E_6",
         "E_6(a_1)",
         "D_5",
         "E_6(a_3)",
         "D_5(a_1)",
         "A_5",
         "A_4A_1",
         "D_4",
         "A_4",
         "D_4(a_1)",
         "A_3A_1",
         "A_2^2A_1",
         "A_3",
         "A_2A_1^2",
         "A_2^2",
         "A_2A_1",
         "A_2",
         "A_1^3",
         "A_1^2",
         "A_1"];

tori:=[
    [2,2,2,2,2,2],
    [2,2,2,0,2,2],
    [2,2,2,2,2,-10],
    [2,0,0,2,0,2],
    [2,2,2,0,2,-7],
    [2,-9,2,2,2,2],
    [2,2,2,2,-7,2],
    [-6,2,2,2,2,-6],
    [2,2,2,2,-6,0],
    [-4,2,2,0,2,-4],
    [2,-3,2,2,-4,2],
    [2,2,2,-5,2,2],
    [2,-3,2,2,-3,0],
    [2,2,-3,2,-3,2],
    [2,0,2,-4,2,2],
    [2,2,2,-3,0,0],
    [2,0,2,-2,0,0],
    [2,-1,-2,2,-2,2],
    [2,0,-1,0,-1,2],
    [2,0,-1,0,0,0]
    ];

#blocks:=[];
blocks:=[[[19, 1], [15, 2], [9, 3], [2, 1]], [[9, 8], [6, 1]], [[9, 7], [7, 2], [1, 1]], [[9, 4], [7, 1], [6, 4], [3, 3], [2, 1]], [[9, 3], [8, 2], [6, 4], [3, 2], [2, 2], [1, 1]], [[9, 3], [8, 2], [6, 4], [3, 2], [2, 1], [1, 3]], [[9, 1], [8, 2], [7, 1], [6, 2], [5, 3], [3, 6], [1, 1]], [[9, 2], [7, 7], [3, 1], [1, 8]], [[9, 1], [7, 5], [5, 3], [3, 5], [1, 4]], [[7, 1], [6, 2], [5, 6], [3, 9], [1, 2]], [[7, 1], [6, 2], [5, 3], [4, 6], [3, 4], [2, 2], [1, 4]], [[3, 24], [2, 3]], [[7, 1], [5, 5], [4, 8], [3, 1], [1, 11]], [[3, 23], [2, 4], [1, 1]], [[3, 23], [2, 1], [1, 7]], [[3, 22], [2, 2], [1, 8]], [[3, 21], [1, 15]], [[3, 13], [2, 14], [1, 11]], [[3, 8], [2, 16], [1, 22]], [[3, 1], [2, 20], [1, 35]]];

#ords:=[];
ords:=[ 27, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 9, 3, 3, 3, 3, 3, 3, 3 ];

return [reps,tori,labels,I,II,ords,blocks];


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

_setN := function(o) o.params[2].nested := true; return o; end;

#F Filt(<n>, <taps>, <v>, <ds>) - FIR filter (linear convolution)
#F
#F Filt is a non-terminal for a linear convolution matrix optionallly
#F downsampled by a factor of <ds>.
#F
#F For ds=1, it is a (n x n+l-1) matrix,  where l is the number of filter
#F coefficients in <taps>.
#F
#F For ds<>1, it is a (n x ds*(n-1)+l) matrix.
#F
#F <n>    - number of outputs desired
#F <taps> -  list of filter taps or a polynomial transfer function
#F <v>    - valuation, optional, but used when <taps> is not a polynomial
#F <ds>   - downsampling factor
#F
#F Examples: Filt(5, [1, 2, 3, 4, 5]) corresponds to the matrix
#F             [ [1, 2, 3, 4, 5, 0, 0, 0, 0]
#F               [0, 1, 2, 3, 4, 5, 0, 0, 0]
#F               [0, 0, 1, 2, 3, 4, 5, 0, 0]
#F               [0, 0, 0, 1, 2, 3, 4, 5, 0]
#F               [0, 0, 0, 0, 1, 2, 3, 4, 5] ]
#F
#F           Filt(3, [1, 2, 3], -2, 2) corresponds to the matrix
#F             [ [1, 2, 3, 0, 0, 0, 0]
#F               [0, 0, 1, 2, 3, 0, 0]
#F               [0, 0, 0, 0, 1, 2, 3] ]
#F
#F  Alternatively for downsampled filters valuation can be omitted:
#F   Filt(n, taps, -Length(taps)+1, ds) is equivalent to
#F   DSFilt(n, taps, ds)
#F
Class(Filt, TaggedNonTerminal, DataNonTerminalMixin, rec(
    abbrevs := [
       (n,L)   -> Checked(IsPosIntSym(n), Concat([n], toFiltFunc(L), [1])),
       (n,L,v) -> Checked(IsPosIntSym(n), Concat([n], toFiltFuncV(L,v), [1])),
       (n,L,v,ds) -> Checked(IsPosIntSym(n), IsPosIntSym(ds), Concat([n], toFiltFuncV(L,v), [ds])),
    ],
    isReal := self >> true,

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

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

    dims := self >> let(n:=self.params[1], k:=self.params[2].domain(), ds:=self.params[4],
                        [n, ds*(n-1) + k]),

    terminate := self >> let(
	n    := self.params[1],
	coef := self.params[2].lambda().tolist(),
	ds   := self.params[4],
	k    := Length(coef),
	When(n=1, Mat([coef]),
	          RowTensor(n,k-ds,Mat([coef])))),

    HashId := self >> let(h := [ self.params[1], self.params[2].domain(), self.params[4] ],
    When(IsBound(self.tags), Concatenation(h, self.tags), h)),

    print := (self,i,is) >> Print(self.name, "(", PrintCS(self.params), ")",
    When(self.hasTags(), Print(".withTags(", self.getTags(), ")"), "")),
    hashAs := meth(self)
        local hfilt;
        hfilt := Copy(self);
        hfilt.params[2] := FUnk(self.params[2].domain());
        return hfilt;
    end,
    normalizedArithCost := self >> self.params[1] * (2*self.params[2].domain() - 1)
));

#F DSFilt(n, taps, ds) - creates a downsampled filter nonterminal
#F
#F This command is equivalent to Filt(n, taps, -Length(taps)+1, ds)
#F
DSFilt := (n, taps, ds) -> let(
    func := toFiltFunc(taps),
    Filt(n, func[1], func[2], ds)
);

Conv := function(arg)
    local filt, tr, v, deg;
    filt := ApplyFunc(Filt, arg).transpose();
    deg := filt.params[2].domain();
    v   := filt.params[3];
    filt.params[2] := fCompose(filt.params[2], J(deg));
    filt.params[3] := -(v+deg)+1;
    return filt;
end;

_vecList := (lst, t, vlen) -> let(l := Length(lst), Checked(l mod vlen = 0,
    List([0..l/vlen-1], i -> Value(TVect(t, vlen), lst{[1+vlen*i .. vlen*(i+1)]}))
));

_pruneVecZeros := lst -> List(lst, x->When(ForAll(x.v, v->v=0), 0, x));

#  a  b  c  d  0  0  0
#  0  a  b  c  d  0  0
#  0  0  a  b  c  d  0
#  0  0  0  a  b  c  d

#  a  b  c  d  0  0  0  0  0  0
#  0  0  a  b  c  d  0  0  0  0
#  0  0  0  0  a  b  c  d  0  0
#  0  0  0  0  0  0  a  b  c  d

_vecTapsHoriz := function(filt, vlen)
    local zeros, taps, k, vtaps, t, ds;
    t := filt.params[2].range(); # data type
    ds := filt.params[4];
# spiral> _roundup;
# (n, v) -> v * QuoInt((n + v - 1), v)
# _roundup(k + (v-1) ds,  v)
# k + v ds -ds + v - 1
# (k - ds - 1) + v (ds+1)
# (k - ds - 1) / v + v * (ds+1)
    k := filt.params[2].domain();
    zeros := Replicate(vlen*(ds + 1 + QuoInt(k-ds-1, vlen)) - k, 0);
    taps := Concatenation(List(filt.params[2].tolist(), EvalScalar), zeros);
    vtaps := List([0 .. vlen-1], blk ->
    List([0 .. k-1 + Length(zeros)], j -> taps[1 + ((j - blk*ds) mod (k + Length(zeros)))]));
    vtaps := List(vtaps, x->_vecList(x,t,vlen));
    return vtaps;
end;

_vecTaps := function(filt, vlen)
    local zeros, taps, k, vtaps, t, ds;
    t := filt.params[2].range(); # data type
    ds := filt.params[4];
    zeros := Replicate((vlen-1)*ds, 0);
    taps := Concatenation(zeros, List(filt.params[2].tolist(), EvalScalar), zeros);
    k := filt.params[2].domain();
    vtaps := List((vlen-1)*ds + [1..k+(vlen-1)*ds], i -> Value(TVect(t, vlen),
             List([0..vlen-1], j -> taps[i-ds*j])));
    return vtaps;
end;

##
## Rules
##
NewRulesFor(Filt, rec(
    #F Filt_Base: (base case)
    #F
    #F Computes convolution by definition
    #F
    Filt_Base := rec(
    requiredFirstTag := ANoTag,
    info             := "Filt -> Mat",
    forTransposition := true,
    limit            := -1, # means no limit
    applicable     := (self, t) >> When(self.limit < 0, true,
        t.params[1] <= self.limit or t.params[2].domain() <= self.limit),
    apply := (t, C, Nonterms) -> t.terminate()
    ),

    #F Filt_Nest: splits a wider filter into narrower filters, i.e. diagonal stripes
    #F
    Filt_Nest := rec(
	requiredFirstTag := ANoTag,
	forTransposition := false,

        minLength := 2,
        maxLength := 16,
        minTaps := 4,

        libApplicable := (self, t) >> let(n:=t.params[1], ntaps:=t.params[2].domain(),
            leq(self.minLength, n, self.maxLength) * leq(self.minTaps, ntaps)),

	applicable := (self, t) >> let(n:=t.params[1], ntaps:=t.params[2].domain(),
            (IsSymbolic(n) or (n >= self.minLength and n <= self.maxLength)) and
            (IsSymbolic(ntaps) or ntaps >= self.minTaps)),

        freedoms := (self, t) >> let(ntaps := t.params[2].domain(),
	    # we split into filters with 2^k taps, to constrain the search space
	    [ List( Filtered([1..20], i -> 2^(i+1) <= ntaps), i -> [2^i, ntaps mod 2^i] ) ]),

	child := (t, fr) -> let(
	    n  := t.params[1],
	    k  := t.params[2].domain(),
	    ds := t.params[4],
            d := fr[1],
	    Cond(d[2]=0, [ _setN(DSFilt(n, d[1],ds)) ],
                         [ _setN(DSFilt(n, d[1],ds)), _setN(DSFilt(n, d[2], ds)) ])),

	apply := function(t, C, Nonterms)
	    local n,k,kk,nfilts,j,core,tot_wid,bk_wid,rem_wid,taps,
	          bk_filtlen, rem_filtlen, ds;
	    taps := t.params[2];
	    n := t.params[1];
	    k := t.filtlen();
	    ds := t.params[4];
	    tot_wid := ds*(n-1)+k;
	    bk_wid  := Cols(C[1]);

	    bk_filtlen := Nonterms[1].filtlen();
	    nfilts := idiv(k, bk_filtlen);

      	    j := Ind(nfilts);
	    Nonterms[1].setData(fCompose(taps, fAdd(k, bk_filtlen, bk_filtlen * j)));

            core := ISumAcc(j, j.range, Scat(fId(n)) * C[1] *
                                Gath(fAdd(tot_wid, bk_wid, bk_filtlen * j)));

	    if Length(C) = 1 then return core;
	    else
		rem_wid     := Cols(Nonterms[2]);
		rem_filtlen := Nonterms[2].filtlen();
		Nonterms[2].setData(fCompose(taps, fAdd(k, rem_filtlen, bk_filtlen * nfilts)));
		return SUMAcc(core, Scat(fId(n)) * C[2] *
		                    Gath(fAdd(tot_wid, rem_wid, bk_filtlen * nfilts)));
	    fi;
	end
    ),

    #F Filt_OverlapSave: Block convolution using Overlap-Save method.
    #F
    #F Filter_n -> Filter_n/b
    #F
    Filt_OverlapSave := rec(
    info             := "Filt(n,h) -> Filt(b,h)",
    forTransposition := true,
    switch           := true,
    applicable       := t -> t.params[1] > 2 and t.params[2].domain() > 1,
    blockRatio       := 2,
    children      := (self,t) >> let(
        n  := t.params[1],
        k  := t.params[2].domain(),
        v  := t.params[3],
        ds := t.params[4],
        tags := t.getTags(),
        newTags := Cond(tags=[], [],
                    ObjId(tags[1])=AParSMP, Drop(tags, 1),
                tags),
        divs := List( Filtered([1..20], i -> 2^i <= self.blockRatio * k and 2^i < n),
                  i-> [i, n mod 2^i]),
        List(divs, d ->
        When( d[2] = 0,
            [Filt(2^d[1], k, v, ds).withTags(newTags)], # d|n
            [Filt(2^d[1], k, v, ds).withTags(newTags), Filt(d[2], k, v, ds).withTags(newTags)]))), # not(d|n)

    forceBB := 128, # set to 32 to force reasonable unrolling

    apply := meth(self, t, C, Nonterms)
        local n, k, s, ds, bb, tags, smp, dosmp;
        Nonterms[1].setData(t.params[2]);
        n := t.params[1];
        k := t.params[2].domain();
        s := Rows(C[1]);
        ds := t.params[4];
        tags := t.getTags();
        smp := When(tags<>[] and ObjId(tags[1])=AParSMP, s -> SMP(tags[1].p, s), s->s);
        dosmp := tags<>[] and ObjId(tags[1])=AParSMP;

        # NOTE, this allows us not to use .area() for unrolling, since BB
        # explicitly forces unrolling onto small guys
        bb := When(not dosmp and self.forceBB > 0 and k*n <= self.forceBB, BB, x->x);
        if Length(C)=1 then
        return smp(bb(RowTensor(n/s, k-ds, C[1]))); # d|n
        else
        Nonterms[2].setData(t.params[2]);
        return RowDirectSum(k-ds, smp(bb(RowTensor(QuoInt(n,s),k-ds,C[1]))), C[2]); # not(d|n)
        fi;
    end
    ),

  Filt_Vect := rec(
    forTransposition := true,
    switch           := true,
    requiredFirstTag := AVecReg,
    applicable       := t -> (t.params[1] mod t.getTags()[1].v)=0 and t.params[2].domain() >= 1,
    freedoms := t -> [],

    child := (t, freedoms) -> let(
        n  := t.params[1], k := t.params[2].domain(), v := t.params[3], ds := t.params[4],
        vlen := t.getTags()[1].v,
        [ Filt(n/vlen, k+(vlen-1)*ds, v-(vlen-1)*ds, ds*vlen)
         .withTags(Drop(t.getTags(), 1)) ]),

    apply := meth(self, t, C, Nonterms)
        local vlen;
        vlen := t.getTags()[1].v;
        Nonterms[1].setData(FData(_vecTaps(t, vlen)));
        return VTensor(C[1], vlen) * VGath_dup(fId(Cols(t)), vlen);
    end
    ),

  Filt_VectHoriz := rec(
    forTransposition := true,
    switch           := true,
    requiredFirstTag := AVecReg,
    applicable       := t -> let(vlen := t.getTags()[1].v,
        t.params[1] = vlen and
        t.params[2].domain() >= 1
    ),
    freedoms := t -> [],

    child := (t, freedoms) -> let(vlen := t.getTags()[1].v,
        vtaps := _vecTapsHoriz(t, vlen),
        [ TTag(TL(vlen^2, vlen, 1, 1), AVecReg(vlen)),
          Filt(1, vtaps[1]) ]),

    apply := meth(self, t, C, Nonterms)
        local vlen, vtaps, filts, vv;
        vlen := t.getTags()[1].v;
        vtaps := _vecTapsHoriz(t, vlen);
        filts := [];
        for vv in vtaps do
            Nonterms[1].setData(vv);
        Add(filts, Copy(C[1]));
        od;

        return VTensor(RowVec(fConst(vlen, 1)), vlen) *
               C[1] *
           VTensor(VStack(filts), vlen);
    end
    ),

    # Vectorization by converting a filter into a v-way filterbank
    #
    Filt_VectBank := rec(
 	forTransposition := true,
 	switch           := true,
 	requiredFirstTag := AVecReg,
        libApplicable    := t -> eq(imod(t.params[1], t.firstTag().v), 0),
 	applicable       := t -> let(n:=t.params[1], vlen:=t.firstTag().v,
            IsSymbolic(n) or (n mod vlen)=0),

 	freedoms := t -> [],

	child := (self,t,fr) >> let(
 	    n := t.params[1], taps := t.params[2], v := t.params[3], ds := t.params[4], vlen := t.firstTag().v,
 	    [ Filt(n/vlen, taps, v, ds*vlen).withTags(Drop(t.getTags(), 1)) ]),

 	apply := (self, t, C, Nonterms) >> let(
 	    n := t.params[1], taps := t.params[2], ds := t.params[4], vlen := t.firstTag().v,
            #GT(C[1], HH(Cols(t), Cols(C[1]), 0, [1, ds]),
            #         HH(Rows(t), Rows(C[1]), 0, [vlen, 1]), [vlen]).withTags(new_tags)
            VTensor(C[1], vlen) *
            VGath_u(H(Cols(t), Cols(C[1]), 0, 1), vlen)
                     ),
    ),

));

RulesFor(Filt, rec(
    #F Filter_OverlapSaveFreq: Block convolution using Overlap-Save method suited
    #F for Frequency-domain rules. It blocks so that we get powers of two for
    #F the columns -> leading to Circulant rule.
    #F
    #F Filter_n -> Filter_n/b
    #F
    Filt_OverlapSaveFreq := rec(
    info             := "Filt(n,h) -> Filt(b,h)",
    forTransposition := true,
    switch           := true,
    isApplicable     := P -> let(n:=P[1], k:= P[2].domain(), x := Log2Int(n+k-2), ds := P[4],
                                     (ds=1) and (n > 2) and (k > 1) and (k < 2^x)),
    allChildren      := P -> let(
        n  := P[1],
        k  := P[2].domain(),
         m := n + k - 1,
        divs := List( Filtered([1..20], i -> 2^(i-3) <= k and 2^i >= k and 2^i < n+k-1),
                  i-> [i, n mod (2^i-k+1)]),
        List(divs, d->
        When( d[2] = 0,
            [Filt(2^d[1]-k+1, P[2], P[3])], # d|n
            [Filt(2^d[1]-k+1, P[2], P[3]), Filt(d[2], P[2], P[3])]))), # not(d|n)

    rule := (P, C) -> let(
        n := P[1],
        k := Length(P[2]),
        s := C[1].dimensions[1],
        When(Length(C)=1,
        RowTensor(n/s, k-1, C[1]), # d|n
        RowDirectSum(k-1, RowTensor(QuoInt(n,s),k-1,C[1]), C[2]))# not(d|n)
    )
    ),

    #F Filt_OverlapAdd: block convolution using Overlap-Add method.
    #F
    #F Filt_n -> Conv_n/b, Toeplitz, Toeplitz
    #F
    Filt_OverlapAdd := rec(
    info              := "Filt(n,h) -> Conv(b,h)",
    forTransposition  := true,
    isApplicable      := P -> P[1] > 2 and P[2].domain() <= P[1]+1 and P[4]=1,
    switch := false,
    allChildren := function(P)
        local n,l,divs,d, coef,list1,list2;
        coef := P[2].tolist();
        l := Length(coef);
        n := P[1]-l+1;
        divs := List(Filtered([1..20], i-> 2^(i-1) < l and 2^i < P[1]),
                 i-> [i, n mod 2^i]);
        list1:= Reversed(Concat(Replicate(l-2,0),coef{[1..l-1]}));
        list2:= Reversed(Concat(coef{[2..l]},Replicate(l-2,0)));
        return List(divs, d->
        When(d[2] = 0,
             [ Conv(2^d[1], coef, P[3]), Toeplitz(list1), Toeplitz(list2) ], # d|n
             [ Conv(2^d[1], coef, P[3]), Conv(d[2],coef, P[3]),            # not(d|n)
                                     Toeplitz(list1), Toeplitz(list2) ]));
    end,

    rule := (P, C) -> let(
        k := P[2].domain(),
        n := P[1] - k + 1,
        s := Cols(C[1]),
        When(Length(C)=3,
        ColDirectSum(k-1, C[2], ColTensor(n/s, k-1, C[1]), C[3]), # d|n
        ColDirectSum(k-1, C[3], ColTensor(QuoInt(n,s), k-1, C[1]), C[2], C[4])) # not(d|n)
    )
    ),

    #F Filt_OverlapAdd: block convolution using Overlap-Add method.
    #F
    #F Filt_n -> Ext * Conv_n/b
    #F
    Filt_OverlapAdd2 := rec(
    info              := "Filt(n,h) -> Conv(b,h)",
    switch            := false,
    forTransposition  := true,
    isApplicable      := P -> P[1] > 2 and P[2].domain() > 1 and P[4]=1,
    allChildren := function(P)
        local n,k,divs,d, coef;
        k := P[2].domain();
        n := P[1]+k-1;
        coef := P[2];
        divs := List( Filtered([1..20], i -> 2^(i-1) < k and 2^i < P[1]),
                  i -> [i, n mod 2^i]);
        return List(divs, d->
        When( d[2] = 0,
            [Conv(2^d[1], coef, P[3])], # d|n
            [Conv(2^d[1], coef, P[3]), Conv(d[2], coef, P[3])])); # not(d|n)
    end,
    rule := (P, C) -> let(
        k := P[2].domain(),
        n := P[1] + k - 1,
        s := Cols(C[1]),
        ext := Ext(P[1],k-1,k-1).transpose(),
        When(Length(C)=1,
        ext * ColTensor(n/s, k-1, C[1]), # d|n
        ext * ColDirectSum(k-1, ColTensor(QuoInt(n,s), k-1, C[1]), C[2]))# not(d|n)
    )
    ),

    #F Filt_KaratsubaSimple:
    #F
    #F Filt_n(h) -> Filt_n(h0) dirsum Filt_n(h1) dirsum Filt_n(h0+h1)
    #F
    #F h0,h1 - even and odd downsampled h
    #F This is radix-2 Karatsuba - "transposed graph" version.
    #F Both the size and the length of the filter have to be divisible by 2
    #F
    Filt_KaratsubaSimple:= rec(
    info              := "Filt(n,h) -> Filt(b,h_e) dirsum Filt(b,h_o) dirsum Filt(b,h_e+h_o)",
    forTransposition  := false,
    switch := false,

    lowerLimit := 8,
    upperLimit := 128,

    isApplicable := (self, P) >> let(n := P[1], k := P[2].domain(), ds := P[4],
        (ds=1) and
        (n >= self.lowerLimit and n <= self.upperLimit) and (n mod 2 = 0) and
        (k >= self.lowerLimit and k <= self.upperLimit) and (k mod 2 = 0) and
        not IsBound(P[2].nested)),

    allChildren := P -> let(n := P[1], k := P[2].domain(), v := Int(P[3]/2),
        [[ Filt(n/2, k/2, v) ]]),

    rule := function( P, C, Nonterms )
        local n, m, l, m0, S, R, v0, v1, h0, h1, hsum, deg, coeffs, hds, f1,f2,f3;
        [n, l, deg] := [P[1], P[2].domain(), P[3]];
        coeffs := List(P[2].tolist(), x->x.ev());
        hds := DownsampleTwo([coeffs,deg]);
        [h0,v0] := hds[1];
        [h1,v1] := hds[2];

            if v0 <> v1 then Error("valuations of downsampled filters aren't the same"); fi;

        if (deg mod 2 = 1) then [h0,h1] := [h1,h0]; fi;
        hsum := ListSum(h0, h1);

        Nonterms[1].setData(FData(h0)); f1 := Copy(C[1]);
        Nonterms[1].setData(FData(h1)); f2 := Copy(C[1]);
        Nonterms[1].setData(FData(hsum)); f3 := Copy(C[1]);

        m0 := n + l - 1;
        m := (m0+1)/2 - 1;
        S := Tensor(Mat([[1,0,1],[0,1,1]]), I(n/2));
        # NOTE: use 3-band filter bank (instead of 3 separate filters) here to improve locality
        return L(n,n/2) * S *
               VStack(f1 * HStack(I(m), O(m,1), -I(m)),
                  f2 * HStack(O(m,1), I(m), -I(m)),
              f3 * Gath(fAdd(m0,m,m+1))) *
           BB(OS(m0,2));
        end
    ),

    #F Filt_Circulant
    #F
    #F Computes convolution by definition
    #F
    Filt_Circulant := rec(
    info             := "Filt -> Circulant",
    forTransposition := true,
    isApplicable     := P -> let(n:= P[1], k:= P[2].domain(), m:= n+k-1, ds:=P[4],
                               ds = 1 and m = 2^(Log2Int(m)) and n/k <= 8 and k/n <= 2),
    allChildren      := P -> let(
             n := P[1], l := P[3], coef := P[2], r := l+coef.domain()-1,
         [[ Circulant(n+PosInt(-l)+ PosInt(r), FUnk(coef.domain()), l) ]]),

    rule := (P,C,Nonterms) -> let(
        n := P[1], l := P[3], r := l + P[2].domain() - 1,
        nt := Nonterms[1].setData(P[2]),
        Ext(n, PosInt(-l), PosInt(r)).transpose() * C[1] )
    ),

    #F Filt_Blocking
    #F
    #F Linear Convolution (Filter) -> Blocks (Toeplitzes)
    #F
    #F Filter is partitioned into square blocks of sizes given by all
    #F proper divisors of the input size.
    #F
    Filt_Blocking := rec(
    info             := "Filt(n,h) -> Toeplitz(b,h')",
    forTransposition := false,
    switch           := true,
    isApplicable     := P -> let(n := P[1], k := P[2].domain(), ds := P[4],
        ds = 1 and n > 2 and n < k and ObjId(P[2]) in [FData, FUnk, FList]),

        # split into dense and half-sparse toeplitz, rest will be unrolled
    allChildren := P -> let(n := P[1], k := P[2].domain(), b := n,
        [[ Toeplitz(2*b-1),
           Toeplitz(2*b-1, 0, b-1),
           Toeplitz(2*b-1, b, 2*b-1) ]]),

    #When((k-1) mod b <>0, [ Toeplitz(2*((k-1) mod b) - 1) ], [ ]),

    rule := function(P, C, Nonterms)
        local n, k, b, Ls, Lsdata, S, j, rem, ofs, jj;
        n  := P[1];
        k  := P[2].domain();
        b := n;

            # first block major part
        Ls := List(P[2].tolist(), x->x.eval());
        Ls := Concat(Replicate(b-1,0), Ls, Replicate(2*b - k mod b,0));
        Lsdata := FData(Ls);

        j := Ind(Int((k-1)/b)-1); # we unroll first and last iteration
        jj := Ind(Int((k-1)/b)+1); # we unroll first and last iteration
        Nonterms[1].setData(fCompose(Lsdata, fAdd(Lsdata.domain(), 2*b-1, (j+1)*b), J(2*b-1)));
        Nonterms[2].setData(fCompose(Lsdata, fAdd(Lsdata.domain(), 2*b-1, jj*b), J(2*b-1)));
        Nonterms[3].setData(fCompose(Lsdata, fAdd(Lsdata.domain(), 2*b-1, jj*b), J(2*b-1)));
        Nonterms[3].setNonZero(b - (k mod b), 2*b - 1);

        S := SUMAcc(
        Data(jj, V(0),
            Scat(fId(b)) * C[2] * Gath(fTensor(fBase(j.range+2,jj), fId(b)))),
        ISumAcc(j, j.range,
            Scat(fId(b)) * C[1] * Gath(fTensor(fBase(j.range+2,j+1), fId(b)))),
        Data(jj, V(j.range+1),
            Scat(fId(b)) * C[3] * Gath(fTensor(fBase(j.range+2,jj), fId(b))))
        );

            # we have to add a small remaining triangle to the right
        if (k-1)mod b <> 0 then
        ofs := b * Int(((k-1)/b)+1) + 1;
        rem := Reversed( Concat( Ls{[ofs .. ofs + (k-1)mod b - 1]}, Replicate((k-1)mod b -1, 0)));
        S := ColDirectSum((b+k-1) mod b, S, toeplitz(rem));
        fi;

        return S;
    end
    ),

    Filt_KaratsubaFast := rec(
    info              := "Filt(n,h) -> Filt(b,h_e) dirsum Filt(b,h_o) dirsum Filt(b,h_e+h_o)",
    forTransposition  := false,
    switch := false,

    lowerLimit := 8,
    upperLimit := 128,

    isApplicable := (self, P) >> let(n := P[1], k := P[2].domain(), ds := P[4],
        (ds=1) and
        (n >= self.lowerLimit and n <= self.upperLimit) and (n mod 2 = 0) and
        (k >= self.lowerLimit and k <= self.upperLimit) and (k mod 2 = 0)),

    allChildren := P -> let(n := P[1], k := P[2].domain(), v := Int(P[3]/2),
        [[ Filt(n/2, k/2, v) ]]),

    rule := function( P, C, Nonterms )
        local m, m0, S, R, l, h0, h1, hsum, deg, n, t, v, coeffs, newcoeffs, hds, j, dirsum, gfunc, one, minone;
        n := P[1]; l := P[2].domain(); deg := P[3];
        coeffs := List(P[2].tolist(), x->x.ev());
        hds := DownsampleTwo([coeffs,deg]);
            if hds[1][2] <> hds[2][2] then Error("valuations of downsampled filters aren't the same"); fi;

        v := hds[1][2]; h0 := hds[1][1]; h1 := hds[2][1];
        if (deg mod 2 = 1) then t := h1; h1 := h0; h0 := t; fi;
        hsum := ListSum(h0, h1);

        newcoeffs := FData(Concat(h0, h1, hsum));
        j := Ind(3);
        gfunc := fCompose(newcoeffs, fTensor(fBase(j), fId(l/2)));
        Nonterms[1].setData(gfunc);
        dirsum := ISum(j, j.range,
            Scat(fTensor(fBase(j), fId(n/2))) * C[1] * Gath(fTensor(fBase(j), fId(Cols(C[1])))));
        m0 := n + l - 1;
        m := (m0+1)/2 - 1;
        S := Tensor(Mat([[1,0,1],[0,1,1]]), I(n/2));

        one := Diag(fConst(m,1));
        minone := Diag(fConst(m,-1));

        R := VStack(
            SUMAcc(one*Gath(fAdd(m0,m,0)), minone*Gath(fAdd(m0,m,m+1))),
            SUMAcc(one*Gath(fAdd(m0,m,1)), minone*Gath(fAdd(m0,m,m+1))),
        one*Gath(fAdd(m0,m,m+1))
        );

        return L(n,n/2) * S * dirsum * R * OS(m0,2);
        end
    )

));


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

# Radix N kernel for FFTE

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

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

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

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

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

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

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

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

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

    # print Radix N FFTE kernel as function

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

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


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

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

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

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

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

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

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

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

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

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

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

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