#############################################################################
##
##  ExternalPolymakeCone.gi      JConvex package
##                               Martin Bies
##
##  Copyright 2021               University of Pennsylvania
##
##  A Gap package to do convex geometry by Polymake
##
##  Chapter Cones in Polymake
##
#############################################################################

##############################################################################################
##
##  Section GAP category of PolymakeCones
##
##############################################################################################

DeclareRepresentation( "IsPolymakeConeRep", IsPolymakeCone and IsAttributeStoringRep, [ ] );

BindGlobal( "TheFamilyOfPolymakeCones", NewFamily( "TheFamilyOfPolymakeCones" ) );

BindGlobal( "TheTypeOfPolymakeCone", NewType( TheFamilyOfPolymakeCones, IsPolymakeConeRep ) );

BindGlobal( "JuliaMatrixInt", JuliaEvalString("Matrix{BigInt}") );

BindGlobal( "PolymakeMatrixToGAP", function( mat )
    mat := _Polymake_jl.common.primitive( mat ); # ensure integer coeffs
    return JuliaToGAP( IsList, JuliaMatrixInt( mat ), true );
end );

BindGlobal( "MakePolymakeConeVRep", function( rays, lineality )
    local cone, kwargs;
    cone := Objectify( TheTypeOfPolymakeCone,
            rec( rays := Immutable( rays ),
                 lineality := Immutable( lineality ),
                 number_type := "rational",
                 rep_type := "V-rep" ) );

    kwargs := rec();

    # TODO: verify that kwargs is set correctly, also if one or both lists are empty

    # check for degenerate case
    if Length( rays ) > 0 then
        kwargs.INPUT_RAYS := JuliaMatrixInt( rays );

        # if we also have lineality, add them
        if Length( lineality ) > 0 then
            kwargs.INPUT_LINEALITY := JuliaMatrixInt( lineality );
        fi;
    elif Length( lineality ) > 0 then
        kwargs.INPUT_RAYS := JuliaMatrixInt( lineality );
        kwargs.INPUT_LINEALITY := kwargs.INPUT_RAYS;
    fi;

    cone!.pmobj := CallJuliaFunctionWithKeywordArguments( _Polymake_jl.polytope.Cone, [], kwargs );
    return cone;
end);

BindGlobal( "MakePolymakeConeHRep", function( inequalities, equalities )
    local cone, kwargs;
    cone := Objectify( TheTypeOfPolymakeCone,
            rec( inequalities := Immutable( inequalities ),
                 equalities := Immutable( equalities ),
                 number_type := "rational",
                 rep_type := "H-rep" ) );

    kwargs := rec();

    # TODO: verify that kwargs is set correctly, also if one or both lists are empty

    # check for degenerate case
    if Length( inequalities ) > 0 then
        kwargs.INEQUALITIES := JuliaMatrixInt( inequalities );

        # if we have non-zero equalities, add them
        if Length( equalities ) > 0 then
            kwargs.EQUATIONS := JuliaMatrixInt( equalities );
        fi;
    elif Length( equalities ) > 0 then
        kwargs.INEQUALITIES := JuliaMatrixInt( equalities );
        kwargs.EQUATIONS := kwargs.INEQUALITIES;
    fi;

    cone!.pmobj := CallJuliaFunctionWithKeywordArguments( _Polymake_jl.polytope.Cone, [], kwargs );
    return cone;
end);

##############################################################################################
##
##  Constructors for PolymakeCones
##
##############################################################################################

InstallGlobalFunction( Polymake_ConeByGenerators,
  function( arg )
    local given_rays, i, given_lineality, cone;

    if Length( arg ) = 0 then

        Error( "Wrong input: Please provide some input!" );

    elif Length( arg ) = 1 and IsList( arg[1] ) then

        given_rays := Filtered( arg[ 1 ], row -> not IsZero( row ) );
        if Length( given_rays ) > 0 then

            # non-trivial cone
            return Polymake_ConeByGenerators( arg[ 1 ], [ ] );

        else

            # received the trivial cone
            cone := MakePolymakeConeVRep( [ ], [ ] );
            return cone;

        fi;

    elif Length( arg ) = 2 and IsList( arg[ 1 ] ) and IsList( arg[ 2 ] ) then

        if ( not IsEmpty( arg[ 1 ] ) ) and not ( IsMatrix( arg[ 1 ] ) ) then
            Error( "Wrong input: The first argument should be a Gap matrix!" );
        fi;

        if ( not IsEmpty( arg[ 2 ] ) ) and not ( IsMatrix( arg[ 2 ] ) ) then
            Error( "Wrong input: The second argument should be a Gap matrix!" );
        fi;

        given_rays := Filtered( arg[ 1 ], row -> not IsZero( row ) );
        given_lineality := Filtered( arg[ 2 ], row -> not IsZero( row ) );
        cone := MakePolymakeConeVRep( given_rays, given_lineality );
        return Polymake_CanonicalConeByGenerators( cone );

    fi;

end );

InstallGlobalFunction( Polymake_ConeFromInequalities,
  function( arg )
    local given_ineqs, given_eqs, cone;

    if Length( arg ) = 0 or ForAll( arg, IsEmpty ) then

        Error( "Wrong input: Please provide some input!" );

    elif Length( arg ) = 1 and IsList( arg[ 1 ] ) then

        return Polymake_ConeFromInequalities( arg[ 1 ], [ ] );

    elif Length( arg ) = 2 and IsList( arg[ 1 ] ) and IsList( arg[ 2 ] ) then

        if ( not IsEmpty( arg[ 1 ] ) ) and not ( IsMatrix( arg[ 1 ] ) ) then
            Error( "Wrong input: The first argument should be a Gap matrix!" );
        fi;

        if ( not IsEmpty( arg[ 2 ] ) ) and not ( IsMatrix( arg[ 2 ] ) ) then
            Error( "Wrong input: The second argument should be a Gap matrix!" );
        fi;

        given_ineqs := Filtered( arg[ 1 ], row -> not IsZero( row ) );
        given_eqs := Filtered( arg[ 2 ], row -> not IsZero( row ) );
        cone := MakePolymakeConeHRep( given_ineqs, given_eqs );
        return Polymake_CanonicalConeFromInequalities( cone );

    fi;

end );

##############################################################################################
##
##  Canonicalize cones
##
##############################################################################################

InstallMethod( Polymake_CanonicalConeByGenerators,
               [ IsPolymakeCone ],
  function( cone )
    local rays, lineality;

    if cone!.rep_type = "H-rep" then

        return fail;

    else

        # compute rays
        rays := PolymakeMatrixToGAP( cone!.pmobj.RAYS );

        # extract lineality
        lineality := PolymakeMatrixToGAP( cone!.pmobj.LINEALITY_SPACE );

        # construct the new cone
        return MakePolymakeConeVRep( rays, lineality );

    fi;

end );

InstallMethod( Polymake_CanonicalConeFromInequalities,
               [ IsPolymakeCone ],
  function( cone )
    local ineqs, eqs;

    if cone!.rep_type = "V-rep" then

        return fail;

    else

        # compute facets
        ineqs := PolymakeMatrixToGAP( cone!.pmobj.FACETS );

        # compute linear span
        eqs := PolymakeMatrixToGAP( cone!.pmobj.LINEAR_SPAN );

        # construct the new cone
        return MakePolymakeConeHRep( ineqs, eqs );

    fi;

end );

##############################################################################################
##
##  Conversion of cones
##
##############################################################################################

InstallMethod( Polymake_V_Rep,
               [ IsPolymakeCone ],
  function( cone )
    local rays, lineality;

    if cone!.rep_type = "V-rep" then
        return cone;
    else

        # compute rays
        rays := PolymakeMatrixToGAP( cone!.pmobj.RAYS );

        # extract lineality
        lineality := PolymakeMatrixToGAP( cone!.pmobj.LINEALITY_SPACE );

        # construct the new cone
        return MakePolymakeConeVRep( rays, lineality );

    fi;

end );

InstallMethod( Polymake_H_Rep,
               [ IsPolymakeCone ],
  function( cone )
    local ineqs, eqs;

    if cone!.rep_type = "H-rep" then

        return cone;

    else

        if cone!.rep_type = "V-rep" and cone!.rays = [] then
            return Polymake_ConeFromInequalities( [ [ 0, 1 ], [ -1, -1 ] ] );
        fi;

        # compute facets
        ineqs := PolymakeMatrixToGAP( cone!.pmobj.FACETS );

        # compute linear span
        eqs := PolymakeMatrixToGAP( cone!.pmobj.LINEAR_SPAN );

        # construct the new cone
        return MakePolymakeConeHRep( ineqs, eqs );

    fi;

end );

##############################################################################################
##
##  Attributes of cones
##
##############################################################################################

InstallMethod( Polymake_AmbientSpaceDimension,
              "finding the dimension of the ambient space of the cone",
              [ IsPolymakeCone ],
  function( cone )

    return Length( Polymake_V_Rep( cone )!.rays[1] );

end );

InstallMethod( Polymake_Dimension,
              " returns the dimension of the cone",
            [ IsPolymakeCone ],
  function( cone )

    if Polymake_IsEmpty( cone ) then
        return -1;
    fi;

    return cone!.pmobj.CONE_DIM;

end );

InstallMethod( Polymake_Rays,
              " return the list of generating vertices",
              [ IsPolymakeCone ],
  function( cone )

    return Set( Polymake_V_Rep( cone )!.rays );

end );

InstallMethod( Polymake_Lineality,
              " return the list of generating vertices",
              [ IsPolymakeCone ],
  function( cone )

    return Set( Polymake_V_Rep( cone )!.lineality );

end );

InstallMethod( Polymake_Equalities,
              " return the list of equalities of a cone",
              [ IsPolymakeCone ],
  function( cone )

    return Set( ( Polymake_H_Rep( cone ) )!.equalities );

end );

InstallMethod( Polymake_Inequalities,
              " return the list of inequalities of a cone",
              [ IsPolymakeCone ],
  function( cone )

    return Set( ( Polymake_H_Rep( cone ) )!.inequalities );

end );

InstallMethod( Polymake_RaysInFacets,
              " returns the incident matrix of the rays in the facets",
            [ IsPolymakeCone ],
  function( cone )
    local help_cone, s, res_string, number_rays, ray_list, i, dummy, j, helper;

    help_cone := Polymake_V_Rep( cone );
    number_rays := Length( help_cone!.rays );
    s := JuliaToGAP( IsString, Julia.string( help_cone!.pmobj.RAYS_IN_FACETS ) );

    # process the string
    res_string := SplitString( s, '\n' );
    res_string := List( [ 2 .. Length( res_string ) ], i -> EvalString( res_string[ i ] ) );

    # now construct list of rays -- each facets is a list number_rays entries: 0 indicates that the ray generator is not in the facet and a 1 that it is part of the facet
    ray_list := [];
    for i in [ 1 .. Length( res_string ) ] do
        dummy := List( [ 1 .. number_rays ], i -> 0 );
        for j in [ 1 .. Length( res_string[ i ] ) ] do
            dummy[ res_string[ i ][ j ] ] := 1;
        od;
        Append( ray_list, [ dummy ] );
    od;

    # return the result
    return ray_list;

end );

InstallMethod( Polymake_RaysInFaces,
              " returns the incident matrix of the rays in the faces",
            [ IsPolymakeCone ],
  function( cone )
    local dim, help_cone, rays, rays_in_faces, i, generators, additional_rays, j, converted_additional_rays, pos, pos2, k, help_list;

    # check degenerate case
    dim := Polymake_Dimension( cone );
    if ( dim = 2 ) then

        rays_in_faces := Polymake_RaysInFacets( cone );

    else

        # compute a V-representation of the cone
        help_cone := Polymake_V_Rep( cone );

        # read-off the rays and the list of rays in the facets
        rays := help_cone!.rays;
        rays_in_faces := Polymake_RaysInFacets( help_cone );

        # construct the facets as cones, compute their facets and add them
        # this is thus a recursive function, with (presumably) low performance
        for i in [ 1 .. Length( rays_in_faces ) ] do

            # construct the i-th facet and compute the rays in its facets
            generators := List( Filtered( [ 1 .. Length( rays ) ], j -> not IsZero( rays_in_faces[ i ][ j ] ) ), k -> rays[ k ] );
            additional_rays := RaysInFaces( Cone( generators ) );

            # convert these lists into a list with the rays above
            converted_additional_rays := [];
            for j in [ 1 .. Length( additional_rays ) ] do
                pos := Positions( additional_rays[ j ], 1 );
                pos2 := List( [ 1 .. Length( pos ) ], k -> Position( rays, generators[ pos[ k ] ] ) );
                help_list := List( [ 1 .. Length( rays ) ], k -> 0 );
                for k in pos2 do
                    help_list[ k ] := 1;
                od;
                converted_additional_rays := Concatenation( converted_additional_rays, [ help_list ] );
            od;

            # add this list of rays in the faces of the i-th facet to the above-computed list of rays_in_facets
            rays_in_faces := Concatenation( rays_in_faces, converted_additional_rays  );

        od;

    fi;

    # all all rays, since the overall cone is also a face
    rays_in_faces := Concatenation( rays_in_faces, [ ListWithIdenticalEntries( Length( Polymake_Rays( cone ) ), 1 ) ] );

    # return the result
    return DuplicateFreeList( rays_in_faces );

end );

##############################################################################################
##
##  Properties of PolymakeCones
##
##############################################################################################

InstallMethod( Polymake_IsEmpty,
               "finding if the cone empty is or not",
               [ IsPolymakeCone ],
  function( cone )

    return Length( Polymake_V_Rep( cone )!.rays ) = 0;

end );

InstallMethod( Polymake_IsPointed,
               "finding if the cone is pointed or not",
               [ IsPolymakeCone ],
  function( cone )
    local help_cone;

    help_cone := Polymake_V_Rep( cone );

    return help_cone!.pmobj.POINTED;

end );

##############################################################################################
##
##  Operations with cones
##
##############################################################################################

InstallMethod( Polymake_Intersection,
               "construct intersection of two cones",
               [ IsPolymakeCone, IsPolymakeCone ],
  function( cone1, cone2 )
    local cone1_h, cone2_h, new_ineqs, new_equ;

    cone1_h := Polymake_H_Rep( cone1 );
    cone2_h := Polymake_H_Rep( cone2 );

    new_ineqs := Concatenation( cone1_h!.inequalities, cone2_h!.inequalities );
    new_equ := Concatenation( cone1_h!.equalities, cone2_h!.equalities );

    return Polymake_ConeFromInequalities( new_ineqs, new_equ );

end );


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

# First, for Pease, need parameters:
# 1. n
# 2. direction (forward or inverse)
# 3. data width
# 4. twiddle width
# 5. bit reverse in/out
# 6. scaling?
# 7. parallelism (streaming width)
# 8. BRAM budget

# bitrev = 0 --> n/n
# bitrev = 1 --> n/r
# bitrev = 2 --> r/n

# direction = 0 --> DFT(n, -1) (forward)
# direction = 1 --> DFT(n, 1) (inverse)

# test:
# webGen(0, 16, 2, 0, 0, 16, 16, 0, 0, 4, -1, 0, "test");
# output in /tmp/spiral/[PID]/test.v

_splhdl_path := "";  #set in .gaprc

webGen := function(arch, size, radix, direction, d_type, d_width, t_width, bitrev, scaling, width, brams, ip, name)
   local opts, t, fwd, scale_str, bram_str;

   # With radix limited to 16, this will avoid more expensive 2/8 and 8/2 CT splits.
#   DFT_CT.children := (nt) -> Map2(Filtered(DivisorPairs(nt.params[1]), divpair -> (divpair[1] <= 4 and divpair[2] <= 4)), (m,n) -> [ DFT(m, nt.params[2] mod m), DFT(n, nt.params[2] mod n) ]);

 if (ip = 0) then
       paradigms.stream.avoidPermPatent := 1;
   fi;

   if (arch = 0) then
       opts := InitStreamHw();
   else
       opts := InitStreamUnrollHw();
   fi;

   fwd := Cond(direction = 0, -1, 1);
   scale_str := Cond(scaling = 0, " ", " -s ");
   bram_str := Cond(brams = -1, " ", ConcatenationString(" -br ", String(brams)));

    if (_splhdl_path = "") then
	Error("Error: path to SPLHDL compiler not set: paradigms.stream._splhdl_path is not bound.");
    fi;

   opts.profile.makeopts.SPLHDL := _splhdl_path; #"/home/pam/web_backends/splhdl/src/splhdl";
   opts.profile.makeopts.OUTNAME := ConcatenationString(String(name), ".v");
   opts.profile.makeopts.GAP := "gap.spl";
   opts.profile.makeopts.WRAP := ConcatenationString(scale_str, bram_str, " -lic -web");

   if (d_type = 0) then
       opts.profile.makeopts.DATATYPE := ConcatenationString("fix ", StringInt(d_width));
   else
       opts.profile.makeopts.DATATYPE := ConcatenationString("flt ", StringInt(d_width));
   fi;

#       opts.profile.makeopts.TWIDTYPE := ConcatenationString("-fixtw", " ", StringInt(t_width));
#   Print("name: ", name, "\n");

   DFTDR_tSPL_Pease.unroll_its := 1;
   DRDFT_tSPL_Pease.unroll_its := 1;

   if ((size = 4) and (width=4) and (radix=2)) then
       radix := 4;
   fi;

  if (bitrev = 0) then
       t := streamDFT(TRC(DFT(size, fwd)).withTags([AStream(2*width)]), radix, opts);
   else
       if (bitrev = 1) then
           t := streamDFT(TRC(DRDFT(size, fwd, radix)).withTags([AStream(2*width)]), radix, opts);
       else
           t := streamDFT(TRC(DFTDR(size, fwd, radix)).withTags([AStream(2*width)]), radix, opts);
       fi;
   fi;

#   Print("t = ", t, "\n\n\n");

   return CMeasure(t, opts);

end;

webGenDCT := function(size, d_type, d_width, brams, width, ip, name)
   local opts, bram_str, t, width;

   if (ip = 0) then
       paradigms.stream.avoidPermPatent := 1;
   fi;

   opts := InitStreamUnrollHw();
   bram_str := Cond(brams = -1, " ", ConcatenationString(" -br ", String(brams)));

    if (_splhdl_path = "") then
	Error("Error: path to SPLHDL compiler not set: paradigms.stream._splhdl_path is not bound.");
    fi;

   opts.profile.makeopts.SPLHDL := _splhdl_path;
   opts.profile.makeopts.OUTNAME := ConcatenationString(String(name), ".v");
   opts.profile.makeopts.GAP := "gap.spl";
   opts.profile.makeopts.WRAP := ConcatenationString(bram_str, " -lic -webdct");

   if (d_type = 0) then
       opts.profile.makeopts.DATATYPE := ConcatenationString("fix ", StringInt(d_width));
   else
       opts.profile.makeopts.DATATYPE := ConcatenationString("flt ", StringInt(d_width));
   fi;

   t := streamDCTUnroll(size, width);
   return CMeasure(t, opts);
end;


Class(SP, SumsBase, BaseMat, rec(
    _short_print := true,
	rChildren := self >> [self.sr, self.list1, self.list2],
	rSetChild := rSetChildFields("sr","list1", "list2"),
	dims := self >> [self.list1.dimensions[2], self.list2.dimensions[2]],

	new := (self, sr, list1, list2) >> SPL(WithBases(self,
		rec(dimensions := [list1.dimensions[2], list2.dimensions[2]],
		sr := Checked(IsSemiring(sr), sr),
		list1 := list1,
		list2 := list2))),

));

Class(SP2, SumsBase, BaseMat, rec(
    _short_print := true,
	rChildren := self >> [self.list1, self.list2],
	rSetChild := rSetChildFields("list1", "list2"),

	new := (self, list1, list2) >> SPL(WithBases(self,
		rec(
		list1 := list1,
		list2 := list2))),

	intersect := meth(list1, list2)
		local i, x, result;
		x := 1;
		i := 1;
		result := 0;
		while i < Length(list1) and x < Length(list2) do
			if list1[i] < list2[x] then
				i := i + 1;
			elif list2[x] < list1[i] then
				x := x + 1;
			else
				result := result + 1;
				i := i +1;
				x := x +1;
			fi;
		od;
		return result;
	end,
));

Class(Intersect, BaseOperation, rec(
  __call__ := (self, sr, x_n, s1, s2, range) >> SPL(WithBases(self, rec(
    sr := Checked(IsSemiring(sr), sr),
    start1 := s1,
    start2 := s2,
    range := range,
    x_n := x_n,
    _children := [range]
  ))),
  dims := self >> [self.x_n, V(1)],
  from_rChildren := (self, rch) >> CopyFields(self, rec(_children := rch)),
  doNotMarkBB := true,
  print := (self, i, is) >> Print(
        self.name, "(", self.sr, ", ", self.start1, ", ", self.start2, ", ", self.range, ")"
  )
));

Class(ScalarProd, TaggedNonTerminal, rec(
  abbrevs := [ (n) -> [n] ],
  isReal := self >> true,
  dims := self >> [self.params[1], self.params[1]]
));

NewRulesFor(ScalarProd, rec(
  Intersect := rec(
    info := "set intersection across two vectors",
    maxSize := false,
    applicable := nt -> not nt.hasTags(),
    children := (self, nt) >> let(i := Ind(), n := nt.params[1], sr := TSemiring_Arithmetic(n.t),
              [[ Intersect(sr, [i, V(0)], [V(0), V(0)], [i, V(0)], i, i, n)]]),
    apply := (nt, C, ct) -> let(i := C[1]._children[1].rt.node.d1, n := nt.params[1], sr := TSemiring_Arithmetic(n.t),C[1])
  ),
));

DefaultSumsGen.Intersect := (self, o, opts) >> o;

DefaultSumsGen.SP := (self, o, opts) >> o;

DefaultCodegen.SP := meth(self, o, y, x, opts)
	local start, iA, jA, e1, istart, jstart, kstart, kend;
	iA := var.fresh_t("iA", TPtr(x.t));
	jA := var.fresh_t("jA", TPtr(x.t));
	start := var.fresh_t("start", TPtr(x.t));
	e1 := var.fresh_t("e1", TPtr(x.t));
	istart := var.fresh_t("istart", TPtr(x.t));
	jstart := var.fresh_t("jstart", TPtr(x.t));
	kstart := var.fresh_t("kstart", TPtr(x.t));
	kend := var.fresh_t("kend", TPtr(x.t));
	return decl([jstart,start, kstart,kend],chain(
	assign(y, o.sr.zero()),
	assign(jstart, start),
	assign(kstart, add(jA, deref(add(iA, deref(istart)))),
	assign(kend, add(jA, deref(add(iA, add(deref(istart),V(1)))))),
	loopw(logic_and(lt(jstart, e1), lt(kstart,kend)),
	chain(
		if3(lt(deref(jstart), deref(kstart)),
			assign(jstart, add(jstart,V(1))),
			lt(deref(kstart), deref(jstart)),
			assign(kstart, add(kstart, V(1))),
			chain(
				assign(y, o.srt.sum(y, V(1))),
				assign(jstart, add(jstart, V(1))),
				assign(kstart, add(kstart, V(1))))))))));
end;

TCDefaults := CopyFields(SpiralDefaults, rec(
  compileStrategy := GraphIndicesCS,
  X := var("IJ", TPtr(TInt)),
  XType := TPtr(TInt),
  arrayDataModifier := "",
  arrayBufModifier := "",
  Y := var("res", TPtr(TInt)),
  YType := TPtr(TInt),
  isCSR := true,
  includes := ["<include/sparse.h>"],
));


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

_orderedUniquify := l-> Flat([l[1]]::List([2..Length(l)], i->When(l[i] in l{[1..i-1]}, [], [l[i]])));

Class(FFTXGenMixin, rec(
    search := (self, t) >> When(IsBound(self.useDP) and self.useDP, DP(t, When(IsBound(self.dpopts), self.dpopts, rec()), self)[1].ruletree, RuleTreeMid(t, self)),
    preProcess := (self, t) >> let(t1 := RulesFFTXPromoteNT(Copy(t)), RulesFFTXPromoteNT_Cleanup(t1)),

    codeSumsCPU := meth(self, ss)
                        local opts2, ss2, c;

                        opts2 := Copy(SpiralDefaults);
                        opts2.useDeref := false;
#                        opts2.codegen := VecRecCodegen;
#                        opts2.unparser := SSEUnparser;

                        ss2 := Copy(ss);

                        ss2 := SubstBottomUp(ss2, @(1, SIMTISum),
                            e -> ISum(@(1).val.var, @(1).val.domain, @(1).val.child(1)));

                        self.debug.ss_cpu := ss2;

                        c := CodeSums(ss2, opts2);
                        c := fixReplicatedData(c, opts2);

                        self.cpu_opts := opts2;
                        c.dimensions := ss.dims();

                        return c;
                    end,

    prettyPrintCPU := meth(self, c)
                       local name;
                       name := "fftx_generated";
                       if (IsBound(c.ruletree) and IsBound(c.ruletree.node.params[2].fname)) then
                           name := c.ruletree.node.params[2].fname;
                       fi;
                       PrintCode(name, c, self.cpu_opts);
                   end,

    fftxGenCPU := meth(self, t)
                   local tt, rt, c, s, r;
				   if Length(t.params) > 1 then
				       r := t.params[2];
					   if IsRec(r) and IsBound(r.fname) then
					      self.cudasubName := r.fname;
					   fi;
				   fi;

                   self.debug := rec();
                   tt := self.preProcess(t);
                   self.debug.tt := tt;
                   rt := self.search(tt);
                   self.debug.rt := rt;
                   s := self.sumsRuleTree(rt);
                   self.debug.ss := s;

                   c := self.codeSumsCPU(s);
                   c := SubstBottomUp(c, @(1,decl), e->let(fr := @(1).val.cmd.free(), decl(Filtered(e.vars, v->v in fr), @(1).val.cmd)));

                   self.debug.c := c;
                   c.ruletree := rt;
                   c.dimensions := s.dims();

                   return c;
               end,

    cmeasureCPU := (self, c) >> CMeasure(c, self.cpu_opts),

    codeSums := meth(self, ss)
                        local c, cc, Xptr, Yptr, plist, plist1, tags;

                        if IsBound(self.Xptr) then
                            Xptr := self.Xptr;
                        else
                            Xptr := X;
                        fi;
                        if IsBound(self.Yptr) then
                            Yptr := self.Yptr;
                        else
                            Yptr := Y;
                        fi;

                        c := CodeSums(ss, self);
                        tags := rec();
                        if IsBound(c.dimensions) then tags.dimensions  := c.dimensions; fi;
                        if IsBound(c.ruletree) then tags.ruletree  := c.ruletree; fi;

                        c := SubstVars(c, rec(X := Xptr, Y := Yptr));
                        cc := fixReplicatedData(c, self);
                        cc := Rewrite(cc, RulesDropSymDecl, self);

                        plist := Collect(cc, @(1,func, e->e.id="transform"))[1].params;
                        plist1 := _orderedUniquify(plist);
                        if Length(plist1) = 2 then
                            plist1 := plist1 :: self.symbol;
                        fi;
                        cc := SubstTopDown(cc, @(1).cond(e->IsList(e) and e = plist), e->plist1);

                        cc := fixReplicatedData(cc, self);
                        cc := SubstTopDown(cc, @(1, Value, e->e.t = TReal and IsDouble(e.v) and let(delta := AbsFloat(e.v - IntDouble(e.v)), delta >0 and delta  < 0.00000000001 )),
                            e->Value(TReal, IntDouble(@(1).val.v))
                        );

                        if IsBound(self.postProcessCode) then
                            cc := self.postProcessCode(cc, self);
                        fi;

                        cc := CopyFields(tags, cc);
                        return cc;
                    end,

    sumsRuleTree := meth(self, rt)
                        local  s, s2, ss, Xptr, Yptr, tags;

                        self.symbol := When(IsBound(rt.node.params[2].params), rt.node.params[2].params, []);

                        if IsBound(rt.node.params[2].XType) then
                            Xptr := var("Xptr", rt.node.params[2].XType);
                        else
                            Xptr := X;
                        fi;
                        if IsBound(rt.node.params[2].YType) then
                            Yptr := var("Yptr", rt.node.params[2].YType);
                        else
                            Yptr := Y;
                        fi;

                        self.Xptr := Xptr;
                        self.Yptr := Yptr;

                        s := SumsRuleTree(rt, self);
                        tags := rec(ruletree := rec());
                        if IsBound(s.ruletree) then tags.ruletree  := s.ruletree; fi;

                        s2 := fixUpSigmaSPL(s, self);

                        ss := SubstVars(s2, rec(X := Xptr, Y := Yptr));
                        ss := SubstTopDown(ss, @(1, [NoDiagPullinLeft, NoDiagPullinRight, Grp]), e->e.child(1));
                        if IsBound(self.postProcessSums) then ss := self.postProcessSums(ss, self); fi;
                        ss.ruletree := tags.ruletree;

                        return ss;
                    end,

    prettyPrint := meth(self, c)
                       local name;
                       name := "fftx_generated";
                       if (IsBound(c.ruletree) and IsBound(c.ruletree.node.params[2].fname)) then
                           name := c.ruletree.node.params[2].fname;
                       fi;
                       PrintCode(name, c, self);
                   end,

    fftxGen := meth(self, t)
                   local tt, rt, c, s, r;
				   if Length(t.params) > 1 then
				       r := t.params[2];
					   if IsRec(r) and IsBound(r.fname) then
					      self.cudasubName := r.fname;
					   fi;
				   fi;
                   tt := self.preProcess(t);
                   rt := self.search(tt);
                   s := self.sumsRuleTree(rt);
                   c := self.codeSums(s);
                   return c;
               end
));

_tofAdd := (n, l) -> When(IsList(l), let(mn := Minimum(l), mx := Maximum(l), Checked(ForAll([mn..mx], i->i in l), fAdd(n, mx-mn+1, mn))),
                          When(n <> l, fAdd(n, l, 0), fId(n)));
_toBox := (ns, nps)-> When(IsList(ns), fTensor(List(Zip2(ns, nps), i->ApplyFunc(_tofAdd, i))), _tofAdd(ns, nps));

ZeroEmbedBox := (ns, nps) -> Scat(_toBox(ns, nps));
ExtractBox := (ns, nps) -> Gath(_toBox(ns, nps));
BoxND := (l, stype) -> Cond(IsInt(l), TArray(stype, l),
                             IsList(l) and Length(l) = 1, TArray(stype, l[1]),
                             TArray(BoxND(Drop(l, 1), stype), l[1]));

BoxNDcmaj := (l, stype) -> TColMaj(BoxND(l, stype));

fBox := l -> fTensor(List(l, fId));
fBoxInBox := (l2, l1, l3) ->fTensor(List([1..Length(l1)], _l -> fAdd(l1[_l], l2[_l], let(shft := l3[_l], When(IsInt(shft), shft, IntDouble(shft))))));

#_cplx := (r,i) -> r + E(4)*i;
#_imag := i -> E(4) * i;
_real := r -> r;
M_PI := d_acos(-1);

_cplx := (r,i) -> cxpack(r,i);
_imag := i -> cxpack(0, i);

TMapPar := (krn, dims) -> When(Length(dims) = 0, krn, let(tti := When(IsVar(dims[1]), TTensorInd, TTensorI), ApplyFunc(tti, [TMapPar(krn, Drop(dims, 1)), dims[1], APar, APar])));
TMap := (krn, dims, al, ar) -> TCompose(
    When(al = AVec, [TL(Product(List(dims, i->i.range)) * Rows(krn), Rows(krn), 1, 1)], []) ::
    [ TMapPar(krn, dims)] ::
    When(ar = AVec, [TL(Product(List(dims, i->i.range)) * Cols(krn), Product(List(dims, i->i.range)), 1, 1)], []));

lin_idx := arg -> fTensor(List(arg, fBase)).at(0);

TIterator1D := (A, n, l,  r) -> When(n = 1, A, TTensorI(A, n, l, r));

_gflops := (n, b, t) -> (b*5*n*LogInt(n, 2))/(t*1000000);


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

mizuno:=[[ 1, 2, 3, 4, 5, 6, 7,
           8, 9, 10, 11,
           12, 13, 14, 15,
           17, 16, 18, 19,
           20, 21, 22, 24,
           23, 25, 26, 27,
           28, 29, 31, 30,
           32, 33, 34, 35,
           36, 37, 38, 39,
           40, 41, 42, 43,
           44, 45, 46, 47,
           48, 49, 50, 51,
           52, 53, 54, 55,
           56, 57, 58, 59,
           60, 61, 62, 63 ],
          []];

reps:=[[[1,1],[2,1],[3,1],[4,1],[5,1],[6,1],[7,1]],            # E_7
       [[1,1],[3,1],[10,1],[9,1],[5,1],[6,1],[7,1]],           # E_7(a_1)
       [[1,1],[2,1],[3,1],[9,1],[11,1],[12,1],[13,1]],         # E_7(a_2)      ? 3/8
       [[1,1],[9,1],[10,1],[17,1],[22,1],[12,1],[7,1]],        # D_6+A_1
       [[1,1],[3,1],[9,1],[11,1],[12,1],[13,1]],               # E_6           ? 3/8
       [[8,1],[9,1],[11,1],[16,1],[12,1],[13,1]],              # E_6(a_1)
       [[1,1],[15,1],[16,1],[17,1],[6,1],[7,1]],               # D_6
       [[1,1],[15,1],[16,1],[17,1],[18,1],[23,1],[13,1]],      # D_6(a_1)+A_1
       [[14,1],[15,1],[16,1],[17,1],[12,1],[13,1]],            # A_6
       [[1,1],[15,1],[17,1],[23,1],[24,1],[7,1]],              # D_6(a_1)
       [[1,1],[15,1],[16,1],[17,1],[18,1],[19,1]],             # D_5+A_1
       [[14,1],[15,1],[27,1],[17,1],[18,1],[19,1],[23,1]],     # D_6(a_2)+A_1
       [[1,1],[15,1],[16,1],[18,1],[19,1]],                    # D_5
       [[8,1],[15,1],[16,1],[20,1],[24,1],[25,1]],             # (A_5+A_1)'
       [[15,1],[20,1],[21,1],[23,1],[13,1],[17,1]],            # D_6(a_2)
       [[20,1],[21,1],[23,1],[24,1],[28,1],[7,1]],             # (A_5+A_1)''
       [[28,1],[12,1],[13,1],[20,1],[21,1]],                   # A_5'
       [[14,1],[22,1],[23,1],[24,1],[25,1],[19,1]],            # D_5(a_1)+A_1
       [[20,1],[21,1],[23,1],[24,1],[7,1]],                    # A_5''
       [[20,1],[21,1],[22,1],[23,1],[24,1],[25,1]],            # A_4+A_2
       [[8,1],[28,1],[24,1],[25,1],[30,1]],                    # D_5(a_1)
       [[20,1],[21,1],[24,1],[30,1]],                          # A_4
       [[20,1],[21,1],[24,1],[28,1],[30,1]],                   # A_4+A_1
       [[1,1],[28,1],[29,1],[30,1],[31,1]],                    # D_4+A_1
       [[26,1],[27,1],[28,1],[29,1],[30,1],[31,1]],            # A_3+A_2+A_1
       [[1,1],[28,1],[29,1],[30,1]],                           # D_4
       [[27,1],[29,1],[30,1],[31,1],[32,1],[37,1]],            # A_3+A_2
#       [[27,1],[29,1],[30,1],[31,1],[32,1]],                   # (A_3+A_2)_2
       [[28,1],[30,1],[31,1],[33,1],[34,1]],                   # D_4(a_1)+A_1
       [[28,1],[30,1],[33,1],[34,1]],                          # D_4(a_1)
       [[30,1],[31,1],[32,1],[33,1],[40,1]],                   # A_3+2A_1
       [[26,1],[27,1],[40,1],[41,1]],                          # (A_3+A_1)'
       [[30,1],[31,1],[32,1],[33,1]],                          # (A_3+A_1)''
       [[20,1],[21,1],[49,1]],                                 # A_3
       [[34,1],[36,1],[37,1],[38,1],[40,1]],                   # 2A_2+A_1
       [[34,1],[36,1],[38,1],[40,1]],                          # 2A_2
       [[37,1],[38,1],[39,1],[40,1],[41,1]],                   # A_2+3A_1
       [[42,1],[43,1],[44,1],[45,1]],                          # A_2+2A_1
       [[44,1],[46,1],[49,1]],                                 # A_2+A_1
       [[44,1],[46,1]],                                        # A_2
       [[47,1],[48,1],[49,1],[53,1]],                          # 4A_1
       [[53,1],[54,1],[55,1]],                                 # (3A_1)'
       [[47,1],[48,1],[49,1]],                                 # (3A_1)''
       [[58,1],[59,1]],                                        # 2A_1
       [[63,1]]                                                # A_1
       ];

labels:=["E_7",
         "E_7(a_1)",
         "E_7(a_2)",
         "D_6+A_1",
         "E_6",
         "E_6(a_1)",
         "D_6",
         "D_6(a_1)+A_1",
         "A_6",
         "D_6(a_1)",
         "D_5+A_1",
         "D_6(a_2)+A_1",
         "D_5",
         "(A_5+A_1)'",
         "D_6(a_2)",
         "(A_5+A_1)''",
         "A_5'",
         "D_5(a_1)+A_1",
         "A_5''",
         "A_4+A_2",
         "D_5(a_1)",
         "A_4",
         "A_4+A_1",
         "D_4+A_1",
         "A_3+A_2+A_1",
         "D_4",
         "A_3+A_2",
#         "(A_3+A_2)_2"
         "D_4(a_1)+A_1",
         "D_4(a_1)",
         "A_3+2A_1",
         "(A_3+A_1)'",
         "(A_3+A_1)''",
         "A_3",
         "2A_2+A_1",
         "2A_2",
         "A_2+3A_1",
         "A_2+2A_1",
         "A_2+A_1",
         "A_2",
         "4A_1",
         "(3A_1)'",
         "(3A_1)''",
         "2A_1",
         "A_1",
         ];

I:=[ [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ] ];#, [  ] ];

II:=[ [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ] ];#, [  ] ];

tori:=[ [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ] ];#, [  ] ];

#blocks:=[];
blocks:=[[[27, 3], [19, 1], [15, 1], [9, 2]], [[27, 1], [19, 1], [18, 2], [15, 1], [9, 4]], [[19, 1], [18, 2], [15, 1], [9, 7]], [[19, 1], [17, 1], [15, 2], [11, 2], [9, 3], [6, 2], [3, 2]], [[19, 1], [15, 4], [9, 5], [3, 3]], [[9, 14], [7, 1]], [[19, 1], [16, 2], [15, 1], [11, 1], [10, 2], [9, 2], [6, 2], [3, 1], [1, 3]], [[9, 12], [7, 1], [6, 2], [3, 2]], [[9, 11], [7, 4], [3, 1], [1, 3]], [[9, 11], [8, 2], [6, 2], [3, 1], [1, 3]], [[9, 11], [8, 2], [6, 2], [3, 1], [1, 3]], [[9, 9], [7, 1], [6, 2], [5, 3], [3, 6]], [[9, 11], [7, 4], [1, 6]], [[9, 6], [7, 1], [6, 8], [3, 8]], [[9, 9], [7, 1], [6, 2], [5, 1], [4, 4], [3, 3], [1, 3]], [[9, 9], [3, 16], [2, 2]], [[9, 5], [8, 2], [6, 8], [3, 7], [1, 3]], [[9, 5], [7, 4], [6, 6], [3, 7], [1, 3]], [[9, 9], [3, 15], [1, 7]], [[9, 3], [7, 1], [6, 8], [5, 3], [3, 12]], [[9, 3], [8, 4], [7, 2], [6, 6], [3, 4], [2, 4], [1, 4]], [[9, 1], [7, 7], [5, 9], [3, 7], [1, 9]], [[9, 1], [8, 2], [7, 3], [6, 4], [5, 5], [4, 2], [3, 8], [2, 2], [1, 2]], [[9, 2], [8, 4], [7, 5], [6, 4], [3, 2], [2, 4], [1, 10]], [[7, 1], [6, 8], [5, 3], [3, 21]], [[9, 2], [7, 13], [3, 1], [1, 21]], [[7, 1], [6, 8], [5, 1], [4, 4], [3, 18], [1, 3]], [[7, 1], [6, 6], [5, 4], [4, 4], [3, 16], [1, 6]], [[7, 1], [6, 2], [5, 12], [3, 15], [1, 9]], [[7, 1], [6, 4], [5, 7], [4, 4], [3, 11], [2, 6], [1, 6]], [[7, 1], [6, 2], [5, 7], [4, 10], [3, 6], [2, 6], [1, 9]], [[7, 1], [5, 15], [3, 10], [1, 21]], [[7, 1], [5, 7], [4, 16], [3, 1], [1, 24]], [[3, 43], [2, 2]], [[3, 42], [1, 7]], [[3, 42], [1, 7]], [[3, 37], [2, 8], [1, 6]], [[3, 34], [2, 8], [1, 15]], [[3, 33], [1, 34]], [[3, 28], [2, 14], [1, 21]], [[3, 19], [2, 26], [1, 24]], [[3, 27], [1, 52]], [[3, 10], [2, 32], [1, 39]], [[3, 1], [2, 32], [1, 66]]];

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

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


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

########################################################################
#   TRC rules

_VBlkMatSPL := function(mat, vtype)
   local i, n, m, nv, a, v, start, final, diff, m_zeros;
   [n, m] := DimensionsMat(mat);
   start := 1;
   a := [];
   v := vtype.size;
   nv := approx.CeilingRat(n/v);
   m_zeros := Replicate(m, vtype.t.zero().v);
   for i in [1 .. nv] do
       final := start + v - 1;
       if (final > n)  then
           diff := final - n;
           Add(a, List(TransposedMat(mat{[start .. n]} :: Replicate(diff, m_zeros)),
		       vec -> vtype.value(vec)));
       else
           Add(a, List(TransposedMat(mat{[start .. final]}),
		       vec -> vtype.value(vec)));
       fi;
       start := final + 1;
   od;
   return a;
end;

VectorizedMatSPL := (isa, spl) -> let(
    r   := Rows(spl),
    c   := Cols(spl),
    v   := isa.v,
    mat := Cond(IsMat(spl), spl, MatSPL(spl)),
    tt  := VBlk(_VBlkMatSPL(mat, isa.t), v) * VGath_dup(fId(c), v),
    When(Mod(r,v)=0, tt, VScat_pc(r,r,0,v)*tt)
);

NewRulesFor(TRC, rec(
#   base cases
    TRC_vect := rec(
        info := "TRC vect",
        forTransposition := false,
        applicable := t -> t.hasTag(AVecReg),
        children := t -> let(
            tags := t.getTags(),
            vecTag := t.getTag(AVecReg, 1),
            [[ t.params[1].withTags(tags).setWrap(VWrapTRC(vecTag.isa)) ]]
        ),
        apply := (t, c, nt) -> VRC(c[1], t.getTag(AVecReg, 1).v)
    ),

    TRC_VRCLR := rec(
        info := "TRC vect",
        forTransposition := false,
        applicable := t -> t.hasTags() and t.isTag(1, AVecReg),
        children := t -> [[ t.params[1].withTags(t.getTags()) ]],
        apply := (self, t, C, Nonterms) >> RC(C[1]),
        switch := false
    ),

    TRC_cplx := rec(
        forTransposition := false,
        applicable := t -> t.hasTag(AVecRegCx),
        children := t -> let(
            tags := t.getTags(),
            tag  := t.getTag(AVecRegCx, 1),
            nt   := t.params[1],
            [[ nt.withTags(tags).setWrap(VWrapTRCcplx(tag.isa)) ]]
        ),
        apply := (self, t, C, Nonterms) >> vRC(C[1]),
        switch := false
    ),

    # TRC_cplxvect will fire even when asked for real vectorization
    TRC_cplxvect := rec(
        forTransposition := false,
        applicable := t -> t.hasTag(AVecRegCx) or t.hasTag(AVecReg),
        children := t -> let(
            tags := t.getTags(),
            tag := Filtered([t.getTag(AVecReg, 1), t.getTag(AVecRegCx, 1)], i->not IsBool(i))[1],
            nt := t.params[1],
            ctag := When(ObjId(tag)=AVecRegCx, tag, AVecRegCx(tag.isa)),
            newTags := List(tags, i->When(i=tag, ctag, i)),
            [[ nt.withTags(newTags).setWrap(VWrapTRCcplx(tag.isa)) ]]
        ),
        apply := (self, t, C, Nonterms) >> vRC(C[1]),
        switch := false
    ),

    TRC_cplx_v2 := rec(
        forTransposition := false,
        applicable := t -> t.hasTag(AVecRegCx) and t.getTag(AVecRegCx, 1).isa.v = 2,
        children := t -> let(
            tags := t.getTags(),
            tag := t.getTag(AVecRegCx, 1),
            nt := t.params[1],
            newTags := Filtered(tags, i -> i<>tag),
            [[ nt.withTags(newTags).setWrap(VWrapTRCcplx(tag.isa)) ]]
        ),
        apply := (self, t, C, Nonterms) >> vRC(VTensor(C[1], 1)),
        switch := false
    ),

    TRC_By_Def := rec(
         forTransposition := false,
	 maxSize := 128,
         applicable := (self, t) >> Rows(t) <= self.maxSize and Cols(t)<=self.maxSize and
       	                            t.hasTags() and t.isTag(1, AVecReg) and t.free()=[],
         apply := (self, t, C, Nonterms) >> let(
	     isa := t.getTag(AVecReg, 1).isa,
	     VectorizedMatSPL(isa, RC(t.params[1]))
	 )
    )
));


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

h := HashTableDP();
opts := CopyFields(PRDFTDefaults, rec(
	globalUnrolling := 64,
	compileStrategy := SimpleCS,
	compflags := "-O3 -fomit-frame-pointer"
));

opts.breakdownRules := rec(
    PRDFT := [PRDFT1_Base1, PRDFT1_Base2, PRDFT1_CT],
    PRDFT3 := [PRDFT3_Base1, PRDFT3_Base2, PRDFT3_CT],
    DFT := [DFT_Base, DFT_CT_Mincost],
    DFT3 := [DFT3_Base, DFT3_CT],

    BRDFT1 := [ BRDFT1_Base2, BRDFT1_Decomp ],
    BRDFT3 := [ BRDFT3_Base2, BRDFT3_Base4, BRDFT3_Decomp ],
    BSkewPRDFT := [ BSkewPRDFT_Base2, BSkewPRDFT_Base4, BSkewPRDFT_Decomp ],

    InfoNt := [Info_Base]
);

bopts := CopyFields(opts, rec(breakdownRules := CopyFields(opts.breakdownRules, rec(
    DFT := [DFT_Base, DFT_Bruun_Decomp],
    BSkewDFT3 := [BSkewDFT3_Base2, BSkewDFT3_Base4, BSkewDFT3_Decomp],
    PkRDFT1 := [PkRDFT1_Base2, PkRDFT1_Bruun_Decomp],
    PRDFT3 := [PRDFT3_Base1, PRDFT3_Base2, PRDFT3_CT]
))));

DP(BRDFT1(64), rec(hashTable:=h), opts);
DP(PRDFT1(64), rec(hashTable:=h), opts);

brdft := List([2..6], i->HashLookup(h, BRDFT1(2^i))[1].ruletree);
prdft := List([2..6], i->HashLookup(h, PRDFT1(2^i))[1].ruletree);

codes_brdft := List(brdft, r -> CodeRuleTree(r, opts));
codes_prdft := List(prdft, r -> CodeRuleTree(r, opts));

acost_brdft := List(codes_brdft, ArithCostCode);
acost_prdft := List(codes_prdft, ArithCostCode);

# ---------------------
a := AllRuleTrees(BRDFT1(32), opts);;
p := x -> Chain(PrintLine(x), x);

codes := [];
DoForAll([1..Length(a)], i -> Add(codes, CodeRuleTree(a[p(i)], opts)));
times := List(codes, x->CMeasure(x, opts));
best := Minimum(times);
besti := Position(times, best);
bestcode := codes[besti];

a := AllRuleTrees(BRDFT1(64), opts);;


n := 0;
repeat
    n := n + 1;
    Print(n, "\n");
until RemInt(n, 6) = 0;


Import(paradigms.smp);

Class(fCubeTranspose, PermClass, rec(
    domain := self >> self.params[1],
    range  := self >> self.params[1],
    def    := (N, stage, cube) -> rec(),
    lambda := self >> let(i := Ind(self.params[1]), errExp(TInt)),
    transpose := self >> self,
    isIdentity := True
));

Class(MPIPrm, Prm);

Class(MPIRCPrm, Prm,
    rec(
        dims := self >> 2*Replicate(2, self.func.params[1])
));

Declare(MPITensor);

Class(MPISum, SMPSum);

Class(MPIGath, Gath);

Class(MPIScat, Scat);

Class(MPITensor, BaseMat, SumsBase, rec(
    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)
    )),

    #-----------------------------------------------------------------------
    transpose := self >> MPITensor(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
));

Class(MPISumsgenMixin, rec(
    MPITensor := (self, o, opts) >> let(p:= o.P, i:= Ind(p),
        MPISum(p, i, p,
        MPIScat(fTensor(fBase(i), fId(Rows(o.L)))) * o.L * MPIGath(fTensor(fBase(i), fId(Cols(o.L))))
    ))
));


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

# Recursive data structure for SPL programs
# =========================================
# needs AREP, approx.g, aux.g, scalar.g, optrec.g

#F SPLs
#F ====
#F
#F *** WARNING ***
#F *** INFORMATION BELOW IS OBSOLETE ***
#F
#F This file contains a recursive data structure to
#F represent SPL programs in GAP. The data structure is
#F also named SPL. An spl is a GAP record with certain
#F fields as explained below.
#F There are two main applications of spl:
#F 1. They are used by the rule-based formula generator to
#F    generate SPL programs within GAP.
#F 2. As an interface between amats (cf. amat.g in AREP) and
#F    SPL programs.
#F
#F We define a SPL object (SPL) recursively in BNF as
#F the disjoint union of the following cases
#F
#F <SPL> ::=
#F ; atomic cases
#F   | <mat>                                 ; "mat"
#F   | <sparse>                              ; "sparse"
#F   | <mon>                                 ; "mon"  (invertible)
#F   | <diag>                                ; "diag"
#F   | <perm>                                ; "perm" (invertible)
#F
#F ; parametrized symbols
#F   | Symbol(<name>, <params>)              ; "symbol"
#F
#F ; non-terminal symbols
#F   | NonTerminal(<name>, <params>)         ; "nonTerminal"
#F
#F ; composed cases
#F   | <SPL> * .. * <SPL>                    ; "compose"
#F   | DirectSum(<SPL>, .., <SPL>)           ; "directSum"
#F   | TensorProduct(<SPL>, .., <SPL>)       ; "tensor"
#F   | <scalar> * <SPL>                      ; "scalarMultiple"
#F   | <SPL> ^ <permSPL>                     ; "conjugate"
#F   | <SPL> ^ <positive-int>                ; "power"
#F
#F The design of SPL is similar to that of AMat with the
#F exception of the types "symbol" and "nonTerminal".
#F The type "symbol" has been introduced to represent parametrized
#F matrices in an efficient way. E.g., the Fourier transform F_n of
#F size n is presented as
#F   SPLSymbol( "F", [ 3 ] )  and in SPL as  (F 3)
#F without any matrix being stored. The symbol should also be part of SPL
#F (the language). The symbols are contained in the Symboltable (below)
#F together with symbol-specific functions. The symboltable is meant to be
#F extended.
#F
#F Note: you can use scalars to build spls (see scalar.g) but currently
#F only for "scalarMultiple" and "diag".
#F
#F An SPL is a GAP-Rec T with the following mandatory
#F fields common to all types of SPL
#F
#F   isSPL        := true, identifies spls
#F   operations   := SPLOps, GAP operations record for T
#F   type         : a string identifying the type of T
#F   dimensions   : size of the matrix represented (= [rows, columns])
#F
#F The characteristic of the base field is always = 0.
#F
#F The following fields are optional for any type of spl S:
#F
#F   splOptions: a list of strings supplying options for the spl compiler
#F     "unrolled": specifies that S is to be unrolled
#F     when exported to spl. In this case this option is disregarded for
#F     all subtrees (if an spl is to be unrolled, then all its subtrees have
#F     to be unrolled).
#F     "pcl": a pcl label should be set in the spl program
#F   pclLabel: a label for pcl profiling
#F   root: contains the spl that has been expanded to obtain S.
#F
#F The following fields are mandatory to the type of T (T.type):
#F
#F type = "mat"
#F   T.element: matrix represented
#F type = "sparse"
#F   T.element: list of triples [i, j, a_(i,j)]
#F type = "mon"
#F   T.element: mon represented
#F type = "diag"
#F   T.element: list containing the diagonal
#F type = "perm"
#F   T.element: perm represented
#F type = "symbol"
#F   T.symbol: string representing the symbol
#F   T.params: list of parameters for the symbol
#F type = "nonTerminal"
#F   T.symbol: string representing the symbol
#F   T.isRealTransform: true if the transform is real, false else;
#F     a transform is real iff the matrix is real for all choices of parameters
#F   T.params: list of parameters for the symbol
#F   T.index: the index of the non-terminal in NonTerminalTableSPL
#F   T.ruleinds: the indices of applicable rules from RuleTable
#F type = "compose"
#F   T.children(): list of spls, the factors
#F type = "directSum"
#F   T.children(): list of spls, the summands
#F type = "tensor"
#F   T.children(): list of spls, the tensor factors
#F type = "scalarMultiple"
#F   T.scalar: the scalar
#F   T.element: the SPL multiplied
#F type = "conjugate"
#F   T.element: the SPL to be conjugated
#F   T.conjugation: the conjugating SPL
#F type = "power"
#F   T.element: the SPL raised to the exponent
#F   T.exponent: the exponent, an integer > 0
#F
#F *** WARNING ***
#F *** INFORMATION ABOVE IS OBSOLETE ***

# Internal Functions for SPLs
# ----------------------------
#

# the operations record
SPLOps := CantCopy(OperationsRecord("SPLOps"));

# SPLOps.IsDegree( <perm>, <degree> )
#   tests whether <degree> is a degree consistent with <perm>

SPLOps.IsDegree := function ( p, n )
  if not IsPerm(p) then
    Error("usage: SPLOps.IsDegree( <perm>, <degree> )");
  fi;
  return
    IsInt(n) and
    n >= 0 and
    ( p = ( ) or n >= LargestMovedPointPerm(p) );
end;

# SPLOps.IsDimension( <dims/deg> )
#   tests whether <dims/deg> is a valid dimension for a
#   matrix, i.e. a positive integer or a pair of them and
#   returns a pair representing the dimension.

SPLOps.IsDimension := function ( D )
  if IsList(D) then
    if not (
      Length(D) = 2 and
      ForAll(D, n -> IsInt(n) and n > 0)
    ) then
      Error("<D> must be a list of two positive ints");
    fi;
    return D;
  else
    if not ( IsInt(D) and D > 0 ) then
      Error("<D> must be a positive int");
    fi;
    return [D, D];
  fi;
end;

#F Fundamental Constructors and Tests for SPLs
#F --------------------------------------------
#F

#F IsSPL( <obj> )
#F   tests whether <obj> is an SPL. The particular case of SPL
#F   is provided by SPL.type and the additional fields are available
#F   directly from the record.
#F
IsSPL := S -> IsRec(S) and IsBound(S.isSPL) and S.isSPL;

#F IsPermutationSPL( <spl> )
#F   returns true, if <spl> is of type "perm" or a symbol that
#F   represents a permutation.
#F
IsPermutationSPL := function ( S )
  if not IsSPL(S) then
      Error("<S> must be an spl");
  elif IsBound(S.isPermutation) then
      return S.isPermutation();
  else
      return false;
  fi;
end;

#F Comparison of SPLs
#F ------------------
#F

#F SPLOps.\=( <spl1>, <spl2> )
#F   returns true if <spl1> and <spl2> are structurally equal.
#F
SPLOps.\= := (S1, S2) -> Cond(IsRec(S1) and IsBound(S1.equals), S1.equals(S2), false);
# NOTE: this function will not yield a good order is Set(..) is used
SPLOps.\< := (S1, S2) -> Cond(IsRec(S1) and IsBound(S1.lessThan), S1.lessThan(S2), BagAddr(S1) < BagAddr(S2));

#F IsIdenticalSPL ( <spl1>, <spl2> )
#F    returns true if <spl1> and <spl2> are spls with identical
#F    syntax trees.
#F
IsIdenticalSPL := (S1, S2) ->
   Checked(IsSPL(S1), IsSPL(S2),
       Cond(S1.dimensions <> S2.dimensions, false,
	    ObjId(S1) <> ObjId(S2), false,
	    S1.equals(S2)));

IsEqualObj := (o1,o2) -> Cond(
    Same(o1,o2), true,
    not IsRec(o1) or not IsBound(o1.equals), o1=o2,
    o1.equals(o2)
);

#F IsHashIdenticalSPL ( <spl1>, <spl2> )
#F    returns true if <spl1> and <spl2> are identical for the
#F    hashing purposes (see spiral/search).
#F

IsHashIdenticalSPL := function( S1, S2 )
    if not ( IsSPL(S1) and IsSPL(S2) ) then
	Error("usage: IsHashIdenticalSPL ( <spl1>, <spl2> )");
    fi;

    if IsBound(S1.hashId) and IsBound(S2.hashId) then
       return Same(ObjId(S1), ObjId(S2)) and
              S1.dimensions = S2.dimensions and
              S1.transposed = S2.transposed and
              S1.hashId = S2.hashId;
    elif IsBound(S1.HashId) and IsBound(S2.HashId) then #NOTE: IS THAT RIGHT???
       return Same(ObjId(S1), ObjId(S2)) and
              When(ForAll(Concat(S1.dimensions, S2.dimensions), IsInt), S1.dimensions = S2.dimensions, true) and
              S1.transposed = S2.transposed and
              S1.HashId() = S2.HashId();
    else
       return IsIdenticalSPL( S1, S2 );
    fi;
end;

#F Converting SPLs
#F ---------------

#F MatSparseSPL ( <"sparse"-spl> )
#F   returns the matrix represented by the spl of type "sparse".
#F
MatSparseSPL := function ( S )
  local M, t;
  #Constraint(ObjId(S) = Sparse);
  M := NullMat(S.dimensions[1], S.dimensions[2]);
  for t in S.element do
    M[t[1]][t[2]] := t[3];
  od;

  return M;
end;

#F AMatSPL( <SPL> )
#F   converts <SPL> into an amat.
#F
AMatSPL := S -> S.toAMat();

#F MatSPL( <spl> )
#F   returns the matrix represented by <spl>.
#F
MatSPL := S -> MatAMat(AMatSPL(S));

#F PermSPL( <spl> )
#F   returns the permutation represented by <spl>,
#F   or false if <spl> is no permutation.
#F
PermSPL := S -> PermAMat(AMatSPL(S));

#F Other Functions
#F ---------------
#F

#F TerminateSPL( <spl> )
#F   returns an spl equivalent to <spl> by replacing
#F   all non-terminals with terminal spls.
#F
TerminateSPL := S -> S.terminate();

#F TransposedSPL ( <SPL> )
#F   returns an spl representing the transpose of <SPL>.
#F
TransposedSPL := S -> S.transpose();

# ArithmeticCostScalarComplex ( <scalar> )
#   returns the arithmetic cost of multiplying <scalar>
#   to a complex number in the form
#     [adds, mults, sign-changes]
#   <scalar> can be a scalar (see scalar.g) or a number.
#
ArithmeticCostScalarComplex := function ( s )
  local n;
  # convert scalar into number (scalar.g)
  s := EvalScalar(s);

  if s = 1 then     return [0, 0, 0];
  elif s = -1 then  return [0, 0, 2];
  # s is real
  elif GaloisCyc(s, -1) = s then return [0, 2, 0];
  else
    n := NofCyc(s);

    # determine exponent of s as root of unity
    if n mod 2 = 1 and s ^ n = -1 then
      n := 2 * n;
    fi;

    # s is no root of unity
    if s^n <> 1 then
      return [2, 4, 0];
    fi;

    # special roots of unity
    if n = 4 then  return [0, 0, 1];
    elif n = 8 then return [2, 2, 0];
    else return [2, 4, 0];
    fi;
  fi;
end;

IsRealNumber := function (num)
   if IsValue(num) then num := num.v; fi;

   if IsSymbolic(num) then
       return When(IsVecT(num.t) or IsArrayT(num.t), not IsComplexT(num.t.t), not IsComplexT(num.t));
   elif IsComplex(num) then return ImComplex(num)=0;
   elif IsDouble(num) then return true;
   elif IsCyc(num) then return GaloisCyc(num, -1) = num;
   elif IsList(num) then return ForAll(num, IsRealNumber);
   else return true;
   fi;
end;

#F IsRealSPL( <spl> )
#F   returns true if <spl> contains no complex subexpressions
#F   and false else. Note that this function does not determine whether
#F   <terminal spl> represents a real matrix! E.g.,
#F     E(4) * Mat([[-E(4)]])
#F   is a real matrix, but contains complex expressions. The result is
#F   stored in .isReal
#F   If the field nonTerminal is set in <spl> then true is returned iff
#F   the nonTerminal is a real transform. This assumes that a real transform
#F   is never expanded using complex expressions!
#F   The function is used to determine whether the compiler option -R
#F   should be used on exporting to spl.
#F
IsRealSPL     := S -> S.isReal();

IsIdentity    := S -> IsBound(S.isIdentity) and S.isIdentity();
IsIdentitySPL := S -> IsSPL(S) and IsIdentity(S);
IsIdentityObj := S -> IsBound(S.isIdentity) and S.isIdentity = True;


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

NewRulesFor(TRCDiag, rec(
    TRCDiag_VRCLR := rec(
        applicable := (self, t) >> t.hasTags() and ObjId(t.firstTag()) = AVecReg,
        apply := (self, t, C, Nonterms) >> let(isa := t.firstTag().isa, v := isa.v, n := Rows(t),
            FormatPrm(fTensor(fId(n/v), L(2*v, v))) *
            VRCLR(Diag(t.params[1]), v) *
            FormatPrm(fTensor(fId(n/v), L(2*v, 2)))
        )
    )
));


# Action of a group on a signed point.
BindGlobal("OnSignedPoints", function(dp, signs)
    local p1, p2;
    p1 := Projection(dp, 1);
    p2 := Projection(dp, 2);
    return function(e, g)
        return [OnPoints(e[1], Image(p1, g)),
                Permuted(signs, Image(p2, g))[Position(signs, e[2])]];
    end;
end);

# Action of a product group on vertices of a product graph.
BindGlobal("OnProduct", function(n, dp)
    local pr;
    pr := List([1..n], i -> Projection(dp, i));
    return function(e, g)
        return List([1..n],
            i -> OnPoints(e[i], Image(pr[i], g)));
    end;
end);

# Action of a product group on vertices of a sum graph.
BindGlobal("OnSum", dp -> function(e, g)
        return [e[1], OnPoints(e[2], Image(Projection(dp, e[1]), g))];
    end
);

# Action of a product group on the multiplication table of its factors.
BindGlobal("OnLatinSquare", function(dp)
    local p1, p2;
    p1 := Projection(dp, 1);
    p2 := Projection(dp, 2);
    return function(e, g)
        return [Image(p1, g) * e[1], e[2] * Image(p2, g)];
    end;
end);

# Action of a wreath product on vectors over a ring.
BindGlobal("OnZmodnZVectors", function(d, e)
    local ij;
    ij := Cartesian([1..d], [0..e-1]);
    return function(vec, g)
        local ji, v, w, vw;
        ji := ij{OnTuples([1..d*e], g)};
        vw := List([1..d], i -> ji[Int(vec[i])+(i-1)*e+1]);
        v := List(vw, x -> ZmodnZObj(x[2], e));
        w := List(vw, x -> x[1]);
        return v{List([1..d], i -> Position(w, i))};
    end;
end);

# Action of a wreath product on pairs of vectors with 3 elements.
BindGlobal("OnVectorPairs", function(q)
    local ij;
    ij := Cartesian([1..2], [1..3], [0..q-1]);
    return function(M, g)
        local ji, v, w, vw;
        ji := ij{OnTuples([1..6*q], g)};
        vw := List([1..2],
            i -> List([1..3],
                j -> ji[FFEToInt(M[i][j], q)+(j-1)*q+(i-1)*q*3+1]));
        v := List(vw, r -> List(r, x -> IntToFFE(x[3], q)));
        w := List(vw, r -> List(r, x -> x[2]));
        v := List([1..2], i -> v[i]{List([1..3], j -> Position(w[i], j))});
        w := List([1..2], i -> M[i]{List([1..3], j -> Position(w[i], j))});
        return [v[1] + VectorProduct(w[2], v[2]), v[2]];
    end;
end);

# Action of a wreath product on matrices over a field.
BindGlobal("OnMatrices", function(q, d, e, dp)
    local F, N, p1, p2, pm;
    F := Elements(GF(q));
    N := Position(F, 0*Z(q));
    p1 := Projection(dp, 1);
    p2 := Projection(dp, 2);
    pm := List([0..d-1], i -> List([1..e], j -> Projection(dp, e*i+j+2)));
    return function(M, g)
        return Image(p1, g)*M*Image(p2, g) +
            List(pm, r -> List(r, p -> F[N^Image(p, g)]));
    end;
end);

# Action of a wreath product on Hermitean matrices over a field.
BindGlobal("OnHermiteanMatrices", function(r, d, dp)
    local C, F, K, N, p1, pm;
    F := Elements(GF(r));
    N := Position(F, 0*Z(r));
    K := Elements(GF(r^2));
    C := List(K, x -> Conjugates(GF(r^2), GF(r), x)[2]);
    p1 := Projection(dp, 1);
    pm := List([0..d-1], i -> List([1..d], j -> Projection(dp, d*i+j+1)));
    return function(M, g)
        local H;
        H := Image(p1, g);
        return List(H, r -> List(r, x -> C[Position(K, x)]))*M*TransposedMat(H)
            + ToHermitean(List(pm, r -> List(r, p -> F[N^Image(p, g)])), r);
    end;
end);

# Action of a matrix group on subspaces of a vector space over a finite field.
BindGlobal("OnSubspaces",
    V -> function(S, g)
        return Subspace(V, OnSubspacesByCanonicalBasis(Basis(S), g));
    end);

# Action of a matrix group on a set of subspaces of a vector space over a
# finite field.
BindGlobal("OnSetsSubspaces", function(V)
    local A;
    A := OnSubspaces(V);
    return function(L, g)
        return Set(List(L, S -> A(S, g)));
    end;
end);

# Action on the vertices of doubled Odd graphs.
BindGlobal("OnDoubledOdd", function(n, dp)
    local F, p1, p2;
    F := [x -> x, x -> Difference([1..n], x)];
    p1 := Projection(dp, 1);
    p2 := Projection(dp, 2);
    return function(s, g)
        return F[1^Image(p2, g)](OnSets(s, Image(p1, g)));
    end;
end);

# Action on the vertices of doubled Grassmann graphs.
BindGlobal("OnDoubledGrassmann", function(V, dp)
    local A, F, p1, p2;
    F := [x -> x, OrthogonalSpaceInFullRowSpace];
    p1 := Projection(dp, 1);
    p2 := Projection(dp, 2);
    A := OnSubspaces(V);
    return function(S, g)
        return F[1^Image(p2, g)](A(S, Image(p1, g)));
    end;
end);

# Action on the vertices of Paley graphs.
BindGlobal("OnPaley", function(q, dp)
    local F, N, p1, p2;
    F := Elements(GF(q));
    N := Position(F, 0*Z(q));
    p1 := Projection(dp, 1);
    p2 := Projection(dp, 2);
    return function(x, g)
        return (x + F[N^Image(p1, g)]) * Z(q)^((q-1)^Image(p2, g));
    end;
end);

# Action on the vertices of Preparata graphs.
BindGlobal("OnPreparata", function(q, s, dp)
    local F, N, p1, p2, p3, p4;
    F := Elements(GF(q));
    N := Position(F, 0*Z(q));
    p1 := Projection(dp, 1);
    p2 := Projection(dp, 2);
    p3 := Projection(dp, 3);
    p4 := Projection(dp, 4);
    return function(t, g)
        local w, z;
        z := Z(q)^((q-1)^Image(p1, g));
        w := [z*t[1], t[2] + 2^Image(p2, g),
              t[3]*z^(s+1) + F[N^Image(p3, g)]];
        return List(w, x -> F[Position(F, x)^Image(p4, g)]);
    end;
end);

# Action on the vertices of Kasami graphs.
BindGlobal("OnKasami", function(q, s, dp)
    local Fq, Fs, Nq, Ns, p1, p2, p3;
    Fq := Elements(GF(q));
    Nq := Position(Fq, 0*Z(q));
    Fs := Elements(GF(s));
    Ns := Position(Fs, 0*Z(s));
    p1 := Projection(dp, 1);
    p2 := Projection(dp, 2);
    p3 := Projection(dp, 3);
    return function(v, g)
        local w;
        w := [v[1] + Fq[Nq^Image(p1, g)],
              v[2] + Fs[Ns^Image(p2, g)]];
        return List(w, x -> Fs[Position(Fs, x)^Image(p3, g)]);
    end;
end);

# Action on vertices of additive symplectic covers of complete graphs.
BindGlobal("OnAdditiveSymplecticCover", function(q, m, B, dp)
    local F, N, p1, p2, pr;
    F := Elements(GF(q));
    N := Position(F, 0*Z(q));
    p1 := Projection(dp, 1);
    p2 := Projection(dp, 2);
    pr := List([1..m], i -> Projection(dp, i+2));
    return function(p, g)
        local z;
        z := List([1..m], i -> F[N^Image(pr[i], g)]);
        return [p[1] + F[N^Image(p2, g)] + p[2]*B*z,
                p[2]*Image(p1, g) + z];
    end;
end);

# Action on vertices of multiplicative symplectic covers of complete graphs.
BindGlobal("OnMultiplicativeSymplecticCover", function(q, dp)
    local F, p1, p2, p3;
    F := Elements(GF(q));
    p1 := Projection(dp, 1);
    p2 := Projection(dp, 2);
    p3 := Projection(dp, 3);
    return function(s, g)
        local g2, g3;
        g2 := Image(p2, g);
        g3 := Image(p3, g);
        return OnSets(Set(List(s, p -> List(Permuted([1,2], g2),
                                            i -> F[Position(F, p[i])^g3]))),
                      Image(p1, g));
    end;
end);

# Action on the vertices of affine polar graphs.
BindGlobal("OnAffine", function(q, d, dp)
    local F, N, p1, pr;
    F := Elements(GF(q));
    N := Position(F, 0*Z(q));
    p1 := Projection(dp, 1);
    pr := List([1..d], i -> Projection(dp, i+1));
    return function(v, g)
        return v^Image(p1, g) + List([1..d], i -> F[N^Image(pr[i], g)]);;
    end;
end);

# Action on the roots of E_8
BindGlobal("OnRoots", function(v, g)
    return (-1)^(10^g) * v{OnTuples([1..Length(v)], g)};
end);

# Action of a matrix group on normalized vectors over a semifield.
BindGlobal("OnSemifieldVectors", function(div)
    local norm;
    norm := NormalizeSemifieldVector(div);
    return function(s, g)
        return norm(s*g);
    end;
end);

# Action of a matrix group on sets of normalized vectors over a semifield.
BindGlobal("OnSetsSemifieldVectors", function(div)
    local norm;
    norm := NormalizeSemifieldVector(div);
    return function(S, g)
        return Set(List(S*g, norm));
    end;
end);

# Action on points and lines of Desarguesian projective planes.
BindGlobal("OnProjectivePlane", function(V, dp)
    local F, P, p1, p2;
    F := OnSubspaces(V);
    P := [x -> x, OrthogonalSpaceInFullRowSpace];
    p1 := Projection(dp, 1);
    p2 := Projection(dp, 2);
    return function(S, g)
        return P[2^Image(p2, g)](F(S, Image(p1, g)));
    end;
end);

# Action on points or lines of a point-line geometry.
BindGlobal("OnPointsOrLines", function(act, line)
    return function(x, g)
        if line(x) then
            return Set(List(x, p -> act(p, g)));
        else
            return act(x, g);
        fi;
    end;
end);

# Action on points and lines of Hall planes.
BindGlobal("OnHallPlane", function(q, dp)
    local p5, p6, p7, p8, pr, A, F, N;
    pr := List([0,1], i -> List([1,2], j -> Projection(dp, 2*i+j)));
    p5 := Projection(dp, 5);
    p6 := Projection(dp, 6);
    p7 := Projection(dp, 7);
    F := Elements(GF(q));
    N := Position(F, 0*Z(q));
    A := function(p, g)
        local s, M;
        M := Image(p7, g);
        p := List(p, z -> [z[1] + F[N^Image(p5, g)]*z[2],
                            z[2]*(Z(q)^((q-1)^Image(p6, g)))]);
        if p = [] then
            if IsZero(M[2][1]) then
                return [];
            else
                return [[M[2][2]/M[1][2], 0*Z(q)]];
            fi;
        elif Length(p) = 1 then
            if not IsZero(p[1][2]) then
                return p;
            fi;
            s := M[1][1] + p[1][1]*M[1][2];
            if IsZero(s) then
                return [];
            else
                return [[(M[2][1] + p[1][1]*M[2][2])/s, 0*Z(q)]];
            fi;
        else
            return M*p + List(pr, r -> List(r, e -> F[N^Image(e, g)]));
        fi;
    end;
    return OnPointsOrLines(A, x -> Length(x) > 2);
end);

# Action on points and lines of Hughes planes.
BindGlobal("OnHughesPlane", function(q, div, dp)
    local p1, p2, act, F;
    p1 := Projection(dp, 1);
    p2 := Projection(dp, 2);
    act := OnSemifieldVectors(div);
    F := [Inverse, TransposedMat];
    return function(p, g)
        return [p[1]^Image(p2, g), act(p[2], F[p[1]](Image(p1, g)))];
    end;
end);


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

NewRulesFor(DFT, rec(
    #F DFT_Base: DFT_2 = F_2
    #F
    DFT_tSPL_VBase := rec(
        switch := false,
        applicable := (t) -> Rows(t) = 2 and t.isTag(1,AVecReg),
        children := t -> [[ TTensorI(DFT(2), 1, AVec, AVec).withTags(t.getTags()) ]],
        apply := (t, C, Nonterms) -> C[1]
    ),
    #F DFT_Base: DFT_2 = F_2 for complex v/2-way vectorization
    #F
    DFT_tSPL_CxVBase := rec(
        switch := false,
        applicable := (t) -> Rows(t) = 2 and t.isTag(1,AVecRegCx),
        apply := (t, C, Nonterms) -> let(
	    v := t.getTags()[1].v,
	    Cond(v = 1, VTensor(F(2), 1),
		 # else
		 let(zeros    := Replicate(v-2, 0.0),
		     one_one  := TVect(TReal, v).value( [1.0,  1.0] :: zeros ),
		     one_mone := TVect(TReal, v).value( [1.0, -1.0] :: zeros ),
		     blk      := VBlk([[ one_mone, one_one ]], v),
		     scat     := _VVStack([VTensor(I(1), v), VIxJ2(v)], v),
		     IxVScat_pc(1,2,2,0,v) * blk * scat * IxVGath_pc(1,2,2,0,v)))
        )
    ),

    #F DFT_Base: DFT_4 for complex v/2-way vectorization
    #F Tensor(F(2),I(4)) * RC(Diag(Tw1(4,2,-1))) * Tensor(I(2), F(2), I(2)) * Tensor(L(4,2),I(2))
    DFT_tSPL_CxVBase2 := rec(
        switch := false,
        applicable := (t) -> t.params[1] = 4 and t.firstTagIs(AVecRegCx) and t.firstTag().v>=4,
        children := nt -> [[TL(4, 2, 1, 1).withTags(nt.getTags()).setWrap(VWrapId)]],

        apply := (t, C, Nonterms) -> let(
	    v  := t.firstTag().v,
            vt := TVect(TReal, v),

            IxVScat_pc(1,4,4,0,v) *
            VBlk( [[ vt.value([1, 1, -1,-1]), vt.one() ]], v) *
            _VVStack([VTensor(I(1), v), VJxI(2, v)], v) *
            VDiag(Tw1(4,2,t.params[2]), v) *
            VBlk( [[ vt.value([1, -1, 1,-1]), vt.one() ]], v) *
            _VVStack([VTensor(I(1), v), VIxJ2(v)], v) *
            C[1] *
            IxVGath_pc(1,4,4,0,v)
        )
    ),
    #F DFT_tSPL_CT_oddvloop
    #F DFT(mn, k)->Tensor(t2 * RI(m, mu), RI(n,nu)) * (Tensor(RI(mu,m), RI(nu,n)) * Diag(twf) * Tensor(RI(m,mu), RI(n,nu))) * L(mu*nu, mu) * Tensor(RI(nu,n) * t1, RI(mu, m))
    DFT_tSPL_CT_oddvloop := rec(
        switch  := false,
        maxSize := false,
        filter  := e->true,
        applicable := (self, nt) >> nt.params[1] > 2
            and (self.maxSize = false or nt.params[1] <= self.maxSize)
            and not IsPrime(nt.params[1])
            and (nt.firstTagIs(AVecReg) or nt.firstTagIs(AVecRegCx)),

        children := (self, nt) >> let(
            pv := nt.getTags(),
            v := pv[1].v,
            isa := pv[1].isa,
            _wrp := _nt -> When(Length(pv)=1, _nt.setWrap(VWrap(isa)), _nt.withTags(Drop(pv, 1)).setWrap(VWrap(isa))),
            Map2(Filtered(Filtered(DivisorPairs(nt.params[1]), a->IsOddInt(a[1])), self.filter),
                (m,n) -> [ _wrp(DFT(m, nt.params[2] mod m)),
                            _wrp(DFT(n, nt.params[2] mod n)),
                            TL(_roundup(n,v).v*v,v).withTags(pv).setWrap(VWrapId)
                         ])),

        apply := (t, C, Nonterms) -> let(
  	        v := t.firstTag().v,
            lprm := C[3],
            m := Rows(C[1]),
            n := Rows(C[2]),
            N := m * n,
            k := t.params[2],
            dftm := C[1],
            dftn := C[2],
            mu := _roundup(m,v).v,
            md := _rounddown(m,v).v,
            nu := _roundup(n,v).v,
            nd := _rounddown(n,v).v,
            f1 := fCompose(Tw1(N, n, k), fTensor(fId(m), fAdd(n,nd,0))),
            f2 := When(mu = m,
                fCompose(Tw1(N, n, k), fTensor(fId(m), fAdd(n,n-nd,nd))),
                fStretch(fCompose(Tw1(N, n, k), fTensor(fId(m), fAdd(n,n-nd,nd))), v, mu-m)),
            i1 := Ind(md/v),
            i2 := Ind(nd/v),
            #---------------------
            stage1 := ApplyFunc(SUM, Concat([
                ISum(i1,
                    VScat(fTensor(fAdd(mu/v,1,i1), fId(nu)),v) *
                    lprm * VScat_zero(nu, n, v) * VTensor(dftn,v) *
                    IxVGath_pc(n, m, v, v*i1, v)
                )],
                Cond(IsOddInt(m),
                    [VScat(fTensor(fAdd(mu/v,1,md/v), fId(nu)),v) *
                    lprm * VScat_zero(nu, n, v) * VTensor(dftn,v) *
                    IxVGath_pc(n, m, m-md, md, v)],
                    [])
                )
            ),
            #---------------------
            stage2 := ApplyFunc(SUM, Concat([
                ISum(i2,
                    IxVScat_pc(m, n, v, v*i2, v) *
                    VTensor(dftm, v) * VDiag(fPrecompute(fCompose(f1, fTensor(fId(m), fBase(i2), fId(v)))), v) * VGath(fAdd(mu, m, 0), v) *
                    VGath(fTensor(fId(mu), fAdd(nu/v, 1,i2)),v)
                )],
                Cond(IsOddInt(n),
                    [IxVScat_pc(m, n, n-nd, nd, v) *
                    VTensor(dftm, v) * VDiag(f2, v) * VGath(fAdd(mu, m, 0), v) *
                    VGath(fTensor(fId(mu), fAdd(nu/v, 1,nd/v)),v)],
                    [])
                )
            ),
#            #---------------------
#            stage1 := SUM(
#                ISum(i1,
#                    VScat(fTensor(fAdd(mu/v,1,i1), fId(nu)),v) *
#                    lprm * VScat_zero(nu, n, v) * VTensor(dftn,v) *
#                    IxVGath_pc(n, m, v, v*i1, v)
#                ),
#                VScat(fTensor(fAdd(mu/v,1,md/v), fId(nu)),v) *
#                lprm * VScat_zero(nu, n, v) * VTensor(dftn,v) *
#                IxVGath_pc(n, m, m-md, md, v)
#            ),
#            #---------------------
#            stage2 := SUM(
#                ISum(i2,
#                    IxVScat_pc(m, n, v, v*i2, v) *
#                    VTensor(dftm, v) * VDiag(fPrecompute(fCompose(f1, fTensor(fId(m), fBase(i2), fId(v)))), v) * VGath(fAdd(mu, m, 0), v) *
#                    VGath(fTensor(fId(mu), fAdd(nu/v, 1,i2)),v)
#                ),
#                IxVScat_pc(m, n, n-nd, nd, v) *
#                VTensor(dftm, v) * VDiag(f2, v) * VGath(fAdd(mu, m, 0), v) *
#                VGath(fTensor(fId(mu), fAdd(nu/v, 1,nd/v)),v)
#            ),
            #---------------------
            stage2 * stage1
        )
    ),

#    #F DFT_tSPL_CT_evenoddvloop
#    #F DFT(mn, k)->Tensor(t2 * RI(m, mu), RI(n,nu)) * (Tensor(RI(mu,m), RI(nu,n)) * Diag(twf) * Tensor(RI(m,mu), RI(n,nu))) * L(mu*nu, mu) * Tensor(RI(nu,n) * t1, RI(mu, m))
#    DFT_tSPL_CT_evenoddvloop := rec(
#        switch  := false,
#        maxSize := false,
#        filter  := e->true,
#        applicable := (self, nt) >> nt.params[1] > 2
#            and (self.maxSize = false or nt.params[1] <= self.maxSize)
#            and not IsPrime(nt.params[1])
#            and IsOddInt(nt.params[1]/2)
#            and IsEvenInt(nt.params[1])
#            and (nt.firstTagIs(AVecReg) or nt.firstTagIs(AVecRegCx)),
#
#        children := (self, nt) >> let(
#            pv := nt.getTags(),
#            v := pv[1].v,
#            isa := pv[1].isa,
#            _wrp := _nt -> When(Length(pv)=1, _nt.setWrap(VWrap(isa)), _nt.withTags(Drop(pv, 1)).setWrap(VWrap(isa))),
#            Map2(Filtered(DivisorPairs(nt.params[1]), self.filter),
#                (m,n) -> [ _wrp(DFT(m, nt.params[2] mod m)),
#                            _wrp(DFT(n, nt.params[2] mod n)),
#                            TL(_roundup(n,v).v*v,v).withTags(pv).setWrap(VWrapId)
#                         ])),
#
#        apply := (t, C, Nonterms) -> let(
#  	        v := t.firstTag().v,
#            lprm := C[3],
#            m := Rows(C[1]),
#            n := Rows(C[2]),
#            N := m * n,
#            k := t.params[2],
#            dftm := C[1],
#            dftn := C[2],
#            mu := _roundup(m,2).v,
#            md := _rounddown(m,2).v,
#            nu := _roundup(n,2).v,
#            nd := _rounddown(n,2).v,
#            f1 := fCompose(Tw1(N, n, k), fTensor(fId(m), fAdd(n,nd,0))),
#            f2 := fStretch(fCompose(Tw1(N, n, k), fTensor(fId(m), fAdd(n,n-nd,nd))), v, mu-m),
#            i1 := Ind(md/v),
#            i2 := Ind(nd/v),
#            #---------------------
#            stage1 := ApplyFunc(SUM, Concat([
#                ISum(i1,
#                    VScat(fTensor(fAdd(mu/v,1,i1), fId(nu)),v) *
#                    lprm * VScat_zero(nu, n, v) * VTensor(dftn,v) *
#                    IxVGath_pc(n, m, v, v*i1, v)
#                )],
#                Cond(IsOddInt(m),
#                    [VScat(fTensor(fAdd(mu/v,1,md/v), fId(nu)),v) *
#                    lprm * VScat_zero(nu, n, v) * VTensor(dftn,v) *
#                    IxVGath_pc(n, m, m-md, md, v)],
#                    [])
#                )
#            ),
#            #---------------------
#            stage2 := ApplyFunc(SUM, Concat([
#                ISum(i2,
#                    IxVScat_pc(m, n, v, v*i2, v) *
#                    VTensor(dftm, v) * VDiag(fPrecompute(fCompose(f1, fTensor(fId(m), fBase(i2), fId(v)))), v) * VGath(fAdd(mu, m, 0), v) *
#                    VGath(fTensor(fId(mu), fAdd(nu/v, 1,i2)),v)
#                )],
#                Cond(IsOddInt(n),
#                    [IxVScat_pc(m, n, n-nd, nd, v) *
#                    VTensor(dftm, v) * VDiag(f2, v) * VGath(fAdd(mu, m, 0), v) *
#                    VGath(fTensor(fId(mu), fAdd(nu/v, 1,nd/v)),v)],
#                    [])
#                )
#            ),
#            #---------------------
#            stage2 * stage1
#        )
#    )
));


Length("abc");
# or same result with
Size("abc");


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

RulesFor(DFT, rec(
    DFT_SR_Reg := rec(
	isApplicable := P -> P[1] mod 2 = 0 and P[1] > 4,

	allChildren := P -> let(k:=P[2],
	    Map2(Filtered(DivisorPairs(P[1]), dd->dd[2]>2 and (dd[2] mod 2 = 0)),
	    (m,n) -> [DFT(m,k), DFT(2*m,k), UDFT(n,k)])),

	rule := (P,C) -> let( # we know that n >= 4
	    N := P[1], m:=Cols(C[1]), n:=Cols(C[3]), k:=P[2], hf:=(n-2)/2,
	    i := Ind(hf), j := Ind(hf),

	    SUM(        _hhi(N, 2*m, 0,      n/2, C[2] * L(2*m,2)),
		ISum(i, _hhi(N,   m, i+1,    n,   C[1] * Diag(Twid(N,m,k,0,0,i+1)))),
		ISum(j, _hhi(N,   m, j+2+hf, n,   C[1] * Diag(Twid(N,m,k,0,0,j+2+hf))))
	    ),
	    Tensor(I(m), C[3]) *
	    L(N,m)
	)
    ),

    DFT_SR_Reg2 := rec(
	isApplicable := P -> P[1] mod 4 = 0 and P[1] > 4,

	allChildren := P -> let(k:=P[2],
	    Map2(Filtered(DivisorPairs(P[1]), dd->dd[1]>2 and dd[2]>2 and (dd[1] mod 2 = 0) and (dd[2] mod 2 = 0)),
	    (m,n) -> [UDFT(m,k).transpose(), UUDFT(2*m,k).transpose(),
		      UDFT(n,k),             UUDFT(2*n, k)])),

	rule := (P,C) -> let( # we know that n >= 4
	    N := P[1], m:=Cols(C[1]), n:=Cols(C[3]), k:=P[2], nhf:=(n-2)/2, mhf:=(m-2)/2,
	    i := Ind(nhf), j := Ind(nhf), ii := Ind(mhf), jj := Ind(mhf),
	    q := Ind(2*n),
	    dd := Diag(Lambda(q, cond(eq(q,3*n/2), (-E(4))^k, 1))),

	    SUM(        _hhi(N, 2*m, 0,       n/2, C[2] * L(2*m,2)),
		ISum(i, _hhi(N,   m, i+1,     n,   C[1] * Diag(UTwid(N,m,k,0,0,i+1)))),
		ISum(j, _hhi(N,   m, j+2+nhf, n,   C[1] * Diag(UTwid(N,m,k,0,0,j+2+nhf))))
	    ) *
	    SUM(Scat(fStack(H(N,n,0,1), H(N,n,N/2,1))) * dd * C[4] * Gath(H(N, 2*n, 0, m/2)),
		ISum(ii, _hho(N,   n, n+ii*n,         1,  ii+1,     m,   C[3])),
		ISum(jj, _hho(N,   n, 2*n+mhf*n+jj*n, 1,  jj+mhf+2, m,   C[3]))
	    )
	)
    ),

    DFT_SR123_Corr := rec(
	isApplicable := P -> P[1] mod 4 = 0,
	allChildren := P -> let(k:=P[2],
	    Map2(Filtered(DivisorPairs(P[1]), dd -> (dd[1] mod 2=0) and (dd[2] mod 2 = 0)),
	    (m,n) -> [DFT(m,k), DFT3(m,k), DFT(n,k), DFT2(n, k)])),

	rule := function(P,C)
	    local N,m,n,k,nhf,mhf, i,j,ii,jj,q,dd,isum, tw1a, tw1b, tw2a, tw2b;

	    N := P[1]; m:=Cols(C[1]); n:=Cols(C[3]); k:=P[2]; nhf:=(n-2)/2; mhf:=(m-2)/2;
	    i := Ind(nhf); j := Ind(nhf); ii := Ind(mhf); jj := Ind(mhf);
	    q := Ind(n);
	    dd := Diag(Lambda(q, cond(eq(q,n/2), (-E(4))^k, 1)));
	    isum := (var, expr) -> When(var.range=0, [], ISum(var, expr));

	    return
	    SUM(         _hhi(N,   m, 0,       n,   C[1]),
		isum(i,  _hhi(N,   m, i+1,     n,   C[1] * Diag(fPrecompute(UTwid(N,m,k,0,0,i+1))))),
		         _hhi(N,   m, nhf+1,   n,   C[2]),
		isum(j,  _hhi(N,   m, j+nhf+2, n,   C[1] * Diag(fPrecompute(UTwid(N,m,k,0,0,j+2+nhf)))))
	    ) *
	    SUM(         _hho(N,   n, 0,              1,  0,        m,    C[3]),
		isum(ii, _hho(N,   n, n+ii*n,         1,  ii+1,     m,    C[3])),
		         _hho(N,   n, n+mhf*n,        1,  mhf+1,    m, dd*C[4]),
		isum(jj, _hho(N,   n, 2*n+mhf*n+jj*n, 1,  jj+mhf+2, m,    C[3]))
	    );
	end
    ),

    DFT_SR123 := rec(
	isApplicable := P -> P[1] mod 4 = 0,
	maxRadix := 4,
	allChildren := (self, P) >> let(k:=P[2],
	    Map2(Filtered(DivisorPairs(P[1]), dd -> (dd[1] mod 2=0 and dd[1]<=self.maxRadix) and (dd[2] mod 2 = 0)),
	    (m,n) -> [DFT(m,k), DFT3(m,k), DFT(n,k), DFT2(n, k)])),

	inplace := Inplace,
	rule := meth(self,P,C)
	    local N,m,n,k,nhf,mhf, i,j,ii,jj,q,dd,isum, tw1a, tw1b, tw2a, tw2b, d1;

	    N := P[1]; m:=Cols(C[1]); n:=Cols(C[3]); k:=P[2]; nhf:=(n-2)/2; mhf:=(m-2)/2;
	    i := Ind(nhf); j := Ind(nhf); ii := Ind(mhf); jj := Ind(mhf);
	    q := Ind(n);
	    dd := Diag(Lambda(q, cond(eq(q,n/2), (-E(4))^k, 1)));
	    isum := (var, expr) -> When(var.range=0, [], ISum(var, expr));

	    tw1a := fPrecompute(fCompose(dOmega(N,k), dLin(mhf, i+1, i+1,     TInt)));
	    tw1b := fPrecompute(fCompose(dOmega(N,k), dLin(mhf, i+1, (i+1)*(mhf+2), TInt)));

	    tw2a := fPrecompute(fCompose(dOmega(N,k), dLin(mhf, j+2+nhf, j+2+nhf,     TInt)));
	    tw2b := fPrecompute(fCompose(dOmega(N,k), dLin(mhf, j+2+nhf, (j+2+nhf)*(mhf+2), TInt)));

	    d1 := fConst(1, 1.0);

	    return
	    self.inplace(
	    SUM(         _hhi(N,   m, 0,       n,   C[1]),
		isum(i,  _hhi(N,   m, i+1,     n,   C[1] * When(tw1a.domain()=0, I(2), Diag(diagDirsum(d1, tw1a, d1, tw1b))))),
		         _hhi(N,   m, nhf+1,   n,   C[2]),
		isum(j,  _hhi(N,   m, j+nhf+2, n,   C[1] * When(tw2a.domain()=0, I(2), Diag(diagDirsum(d1, tw2a, d1, tw2b)))))
	    )) *
	    SUM(         _hho(N,   n, 0,              1,  0,        m,    C[3]),
		isum(ii, _hho(N,   n, n+ii*n,         1,  ii+1,     m,    C[3])),
		         _hho(N,   n, n+mhf*n,        1,  mhf+1,    m,    C[4]), #dd * C[4]),
		isum(jj, _hho(N,   n, 2*n+mhf*n+jj*n, 1,  jj+mhf+2, m,    C[3]))
	    );
	end
    )
));

 RulesFor(DFT3, rec(
    DFT3_CT_Twids := Inherit(DFT_CT, rec(
 	switch := false,
	maxRadix := 4,
 	allChildren  := (self, P) >> Map2(Filtered(DivisorPairs(P[1]), dd->dd[1] <= self.maxRadix),
 	    (m,n) -> [ DFT(m, P[2]), DFT3(n, P[2]) ]),

	inplace := Inplace,
 	rule := meth(self, P,C)
	    local N, m, n, k, i, tw;
	    N := P[1];
	    m := Cols(C[1]); n := Cols(C[2]); k := P[2];
	    i := Ind(n);
	    tw := fPrecompute(fCompose(dOmega(2*N,k), dLin(m-1, 2*i+1, 2*i+1,  TInt)));

	    return self.inplace(ISum(i, _hhi(N,  m,  i,  n,  C[1] * Diag(diagDirsum(fConst(1,1.0), tw))))) *
 	           Tensor(I(m), C[2]) *
		   L(N, m);
 	end
     )),

    DFT3_SR34_Corr := rec(
	isApplicable := P -> P[1] mod 4 = 0,
	allChildren := P -> let(k:=P[2],
	    Map2(Filtered(DivisorPairs(P[1]), dd -> (dd[1] mod 2=0) and (dd[2] mod 2 = 0)),
	    (m,n) -> [DFT(m,k), DFT3(n,k), DFT4(n, k)])),

	rule := function(P,C)
	    local N,m,n,k,nhf,mhf, i,j,ii,jj,q,dd,isum, tw1a, tw1b, tw2a, tw2b;

	    N := P[1]; m:=Cols(C[1]); n:=Cols(C[3]); k:=P[2]; nhf:=(n-2)/2; mhf:=(m-2)/2;
	    i := Ind(n); ii := Ind(mhf); jj := Ind(mhf);
	    isum := (var, expr) -> When(var.range=0, [], ISum(var, expr));

	    return
            isum(i,  _hhi(N,   m, i,     n,   C[1] * Diag(fPrecompute(UTwid1(N,m,k,1/2,0,i))))) *
	    SUM(         _hho(N,   n, 0,              1,  0,        m,    C[2]),
		isum(ii, _hho(N,   n, n+ii*n,         1,  ii+1,     m,    C[2])),
		         _hho(N,   n, n+mhf*n,        1,  mhf+1,    m,    C[3]),
		isum(jj, _hho(N,   n, 2*n+mhf*n+jj*n, 1,  jj+mhf+2, m,    C[2]))
	    );
	end
    ),

 ));

RulesFor(UUDFT, rec(
   UUDFT1_Base4 := BaseRule(UUDFT1, [4, @])
));

RulesFor(UDFT1, rec(
   UDFT1_Base2 := rec(
       isApplicable := P -> P[1] = 2,
       rule := (P, C) -> I(2)
   ),

   UDFT1_Base4 := rec(
       isApplicable := P -> P[1] = 4,
       rule := (P, C) ->
           DirectSum(I(2), F(2))^L(4,2) *
	   Diag(Tw1(4, 2, 1)) *
	   Tensor(I(2), F(2)) *
	   L(4, 2)
   ),

   UDFT1_toDFT := rec(
       isApplicable := P -> P[1] > 4,
       allChildren := P -> [[ DFT(P[1], P[2]) ]],
       rule := (P, C) ->
           DirectSum((1/2)*F(2), I(P[1]-2))^L(P[1],P[1]/2) * C[1]
   ),

   UDFT1_SR_Reg := rec(
	isApplicable := P -> Is2Power(P[1]) and P[1] > 4,

	allChildren := P -> let(k:=P[2], Map2(Filtered(DivisorPairs(P[1]), dd->dd[2]>2),
	    (m,n) -> [DFT(m,k), UDFT(2*m,k), UDFT(n,k)])),

	forTransposition := false,

	rule := (P,C) -> let( # we know that n >= 4
	    N := P[1], m:=Cols(C[1]), n:=Cols(C[3]), k:=P[2], j := Ind((n-2)/2), jj := Ind((n-2)/2),
	    SUM(
		Scat(H(N,2*m,0,n/2)) * C[2] * L(2*m,2) * Gath(H(N,2*m,0,n/2)),
		ISum(j,
		     Scat(H(N,m,j+1,n)) *
		     C[1] * Diag(Twid(N,m,k,0,0,j+1)) *
		     Gath(H(N, m,j+1,n))),
		ISum(jj,
		     Scat(H(N,m,jj+2+(n-2)/2,n)) *
		     C[1] * Diag(Twid(N,m,k,0,0,jj+2+(n-2)/2)) *
		     Gath(H(N, m,jj+2+(n-2)/2,n)))

	    ) *
	    Tensor(I(m), C[3]) * L(N,m))
    )
));

#Unbind(UDFT.transpose);
#SwitchRules(DFT, [1,3,18]);
#DFT_CT.isApplicable := P -> P[1]=4;