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

# alpha is a function of P (divisor of N)
# m = N/P

# Frequency domain, u in [0, N)
# Per processor, total pts=2*m, total useful pts=m
# We start to see aliasing at 3*m/2, m=N/P.
W := (alpha, u) -> exp(-alpha * u^2);

# Time domain, t in [0, 1]
w := (alpha, t) -> sqrt(d_PI / alpha) * exp(-d_PI^2 * t^2 / alpha);

# digits - eg. 17, number of exact (unaffected by aliasing) decimal digits
gauss_alpha := (N, p, digits) -> let(m := N/p, 4/9 * digits * d_log(10) / m^2);

# how many samples of the filter to keep in the time domain, assuming gauss_alpha(N, p, digits)
# was used.
edge := digits -> IntDouble(d_ceil(2/(3*d_PI) * d_log(10) * digits));

Class(fPerExt, FuncClass, rec(
    def := (N, l, r) -> rec(N:=N, n:=N+l+r),
    lambda := self >> let(N := self.params[1], l:=self.params[2], r:=self.params[3],
 	j := Ind(self.n),
	Lambda(j, imod(j-l, N)))
));

# below we should not use HZ, since HZ assumes that n * stride = N, and if used as below
# assumption will be violated
#RewriteRules(RulesFuncSimp, rec(
#    fPerExt_H := ARule(fCompose, [@(1,fPerExt), @(2,H)], e ->
#	let(base := @(2).val.params[3], stride := @(2).val.params[4],
#	[ HZ(@(1).val.N, @(2).val.n, base - @(1).val.params[2], stride) ]))
#));

NewRulesFor(DFT, rec(

   DFT_Gauss := rec(
	forTransposition := true,
	minSize     := 4,
	maxSize     := false,
	p      := 4,
	digits := 15,

	applicable  := (self, t) >> (self.minSize<>false and Rows(t) > self.minSize) and
	                            not IsPrime(Rows(t)) and t.params[2] in [1,-1 mod Rows(t)],

        libApplicable := (self, t) >> eq(imod(t.params[1], self.p), 0),
	freedoms := (self, t) >> [],

	child := (self, t, freedoms) >> let(N := Rows(t), p := self.p,
	    [ DFT(2*N/p, t.params[2]), DFT(p, t.params[2]) ]),

	apply := meth(self, t,C,Nonterms)
	    local N, m, n, rot, k, p, alpha, time_filter, freq_filter, j;
	    N := Rows(t);
	    n := Rows(C[2]);
	    k := edge(self.digits);
	    p := self.p;
	    m := N/p;
	    alpha := gauss_alpha(N, p, self.digits);

	    time_filter := let(i:=Ind(2*k*p), Lambda(i, w(alpha, (i-k*p)/N)).setRange(TDouble));
	    freq_filter := let(i:=Ind(m),     Lambda(i, p/(2*N*W(alpha, i-m/2))).setRange(TDouble));

	    j := Ind(p);
	    return
	    Grp(
		IterDirectSum(j, j.range,
		    Diag(freq_filter) *
		    Gath(H(2*m, m, m*imod(j,2), 1)).toloop(4) * C[1]
		) *
		(Tr(2*N/p, p))
	    ) *
	    RowTensor(2*N/p, 2*k*p-p/2,
		C[2] *
		let(i:=Ind(p), Diag(Lambda(i, omega(2*p, i)).setRange(TComplex))) *
		Tensor(RowVec(List([0..2*k-1], x->(-1)^x)), I(p)) *
		Diag(time_filter)
	    ) *
	    Gath(fPerExt(N, k*p, k*p-p/2));
	end

   )
));

# scaling by p/(2*N) belongs to the time_filter, but freq_filter is shorter
#	    time_filter := List([-k*p .. k*p-1], i-> w(alpha, i/N));
#	    freq_filter := List([-m/2..m/2-1], i-> p/(2*N*W(alpha, i)));

#	    return
#	    Z(N, m/2) *
#	    Tensor(I(p/2),
#		   DirectSum(
#		       Diag(freq_filter) * Gath(fStack(H(2*m, m/2, 3*m/2, 1), H(2*m, m/2, 0, 1))) * C[1],
#		       Diag(freq_filter) * Gath(H(2*m, m, m/2, 1)) * C[1])
#	    ) *

testGauss := function(N, p, k)
    local s, me, them;
    DFT_Gauss.p := p;
    SwitchRulesByNameQuiet(DFT, [DFT_Gauss]);
    s := SPLRuleTree(ExpandSPL(DFT(N,k))[1]);
    me := MatSPL(s);
    them := MatSPL(DFT(N,k));
    VisualizeMat(me-them, " ");
    return [s, me, them];
end;

splGauss := function(N, p, k)
    local s, me, them;
    DFT_Gauss.p := p;
    SwitchRulesByNameQuiet(DFT, [DFT_Gauss]);
    s := SPLRuleTree(ExpandSPL(DFT(N,k))[1]);
    return s;
end;

sums := function(s, opts)
    local real;
    real := s.isReal();
    s := SumsSPL(s);
    s := SubstBottomUp(s, @.cond(IsNonTerminal), x->RecursStep(0,0,x));
    s := ApplyStrategy(s, opts.formulaStrategies.sigmaSpl, UntilDone);
    if not opts.generateComplexCode and not real then
        s := ApplyStrategy(RC(s), opts.formulaStrategies.rc, UntilDone); fi;
    return ApplyStrategy(s, opts.formulaStrategies.postProcess, UntilDone);
end;

# opts := CopyFields(SpiralDefaults, rec(generateComplexCode := true));
# opts := CopyFields(opts, rec(unparser := CMacroUnparser));

# N := 128;
# k := edge(17);
# p := 4;
# alpha := alpha(N, p, 17);

NewRulesFor(DFT, rec(

   DFT_PrunedGauss := rec(
	forTransposition := true,
	minSize     := 4,
	maxSize     := false,
	p := 2,
	digits := 15,

	applicable  := (self, t) >> (self.minSize<>false and Rows(t) > self.minSize) and
	                            not IsPrime(Rows(t)) and t.params[2] in [1,-1 mod Rows(t)],

	children := (self, t) >> let(N := Rows(t), p := self.p,
	    [[ DFT(2*N/p, t.params[2]), DFT3(p, t.params[2]) ]]), #DFT3

	apply := meth(self, t,C,Nonterms)
	    local N, m, n, mat, rot, k, p, alpha, time_filter, freq_filter, freq_filter2;
	    N := Rows(t);
	    n := Rows(C[2]);
            mat := MatSPL(C[2]);
	    k := edge(self.digits);
	    p := self.p;
	    m := N/p;
	    alpha := gauss_alpha(N, p, self.digits);
	    time_filter := List([-k*p .. k*p-1], i-> w(alpha, i/N).eval());
	    freq_filter := List([-m/2..m/2-1], i-> p/(2*N*W(alpha, i).eval()));

	    return
	    Diag(freq_filter) * Gath(H(2*m, m, 0, 1)) * C[1] *
	    RowTensor(2*N/p, 2*k*p-p/2,
		RowVec(mat[1]) *
		Tensor(RowVec(List([0..2*k-1], x->(-1)^x)), I(p)) *
		Diag(time_filter)) *
	    transforms.filtering.Ext(N, transforms.filtering.per(k * p),
		                        transforms.filtering.per(k * p - p/2));
	end
   )
));

#2N/p  * 2kp
#4Nk complex fmas overhead for filter (one stripe out), k=edge(digits)


# return a list of two lists :
# first is the list of months with five weekends between years y1 and y2 (included)
# second is the list of years without such months, in the same interval
FiveWeekends := function(y1, y2)
  local L, yL, badL, d, m, y;
  L := [ ];
  badL := [ ];
  for y in [y1 .. y2] do
    yL := [ ];
    for m in [1, 3, 5, 7, 8, 10, 12] do
      if WeekDay([1, m, y]) = "Fri" then
        d := StringDate([1, m, y]);
        Add(yL, d{[4 .. 11]});
      fi;
    od;
    if Length(yL) = 0 then
      Add(badL, y);
    else
      Append(L, yL);
    fi;
  od;
  return [ L, badL ];
end;

r := FiveWeekends(1900, 2100);;
n := Length(r[1]);
# 201
Length(r[2]);
# 29
r[1]{[1 .. 5]};
# [ "Mar-1901", "Aug-1902", "May-1903", "Jan-1904", "Jul-1904" ]
r[1]{[n-4 .. n]};
# [ "Mar-2097", "Aug-2098", "May-2099", "Jan-2100", "Oct-2100" ]


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

Declare(DWTper);

#F DWTper(<n>, <j>, [<h(z)>,<g(z)>])
#F DWTper(<n>, <j>, <L>, <V>)
#F   returns a 2-channel <j>-stage discrete wavelet transform with periodic extensions
#F   (circulant transforms) where the
#F   low pass and the high pass analysis filters given by polynomials
#F   [<h(z)>,<g(z)>]
#F
#F   <L> = [<Lh>,<Lg>] - coefficient lists for h and g
#F   <V> = [<vh>,<vg>] - valuation for h and g
#F
#F  <n> - size of the output of the reconstructed sequence
#F  <j> - number of filter bank stages
Class(DWTper, NonTerminal, rec(

  abbrevs := [
    function(n,j,M)
    local S,L,V, j;
    if IsList(M[1]) then
     S:=List([1,2], j->FillZeros([M[1][j],M[2][j]]));
     V:=List(S, j->j[2]);
     L:=List(S, j->j[1]);
     return [n,j,L,V];
    else
    Checked(IsPosInt(n), Checked(ForAll(M,i->IsPolynomial(i)),true));
      S:=List(M, i-> FillZeros(i));
      V:=List(S, i->i[2]);
      L:=List(S, i->i[1]);
    return [n,j,L,V];
    fi;
    end,
    function(n,j,L,V)
    local S,V,L,i,j;
     S:=List([1,2], j->FillZeros([L[j],V[j]]));
     V:=List(S, j->j[2]);
     L:=List(S, j->j[1]);
     return [n,j,L,V];
    end
  ],

  dims := self >> [self.params[1], self.params[1]],

  half1 := self >> let(
      n  := self.params[1],
      l1 := self.params[3][1],
      v1 := self.params[4][1],
      DownSample(n,2,0) * Circulant(n,l1,v1).terminate() ),

  half2 := self >> let(
      n  := self.params[1],
      l2 := self.params[3][2],
      v2 := self.params[4][2],
      DownSample(n,2,0) * Circulant(n,l2,v2).terminate() ),

  terminate := self >> let(
      n := self.params[1],
      j := self.params[2],
      L := self.params[3],
      V := self.params[4],
      # DWT as filter bank stage + downsampling
      res := Cond(j = 1, I(n),
	          DirectSum(DWTper(n/2,j-1,L,V).terminate(), I(n/2))) *
             VStack(self.half1(), self.half2()),
      When(self.transposed, res.transpose(), res)
  ),

  LiftingScheme := self >> self.lifting(),

  lifting := meth(self)
               local n,j,LS,h,g,he,ho,ge,go;
               n := self.params[1];
               j := self.params[2];
               h := DownsampleTwo([self.params[3][1],self.params[4][1]]);
               g := DownsampleTwo([self.params[3][2],self.params[4][2]]);
               # Lifting scheme does not converge for wavelets longer than 9
               # (need to be fixed)
               if (Maximum(List(h, i-> Length(i[1])))>9 or
                   Maximum(List(g, i-> Length(i[1])))>9) then return [[]];fi;
               he := Poly(h[1][1],h[1][2]);
               ho := Poly(h[2][1],h[2][2]);
               ge := Poly(g[1][1],g[1][2]);
               go := Poly(g[2][1],g[2][2]);
               LS := LiftingScheme([[he,ho],[ge,go]]);
               return LS;
             end,

  isReal := True,
));

#F RuleFilter_DWT: (base case) DWT -> Mat,
#F   Computes filter by definition
#F
RulesFor(DWTper, rec(
    #F RuleFilt_Mallat_2:
    #F
    #F DWTper(n,j,[h,g])->DWTper(n/2,j-1,[h,g]),DWTper(n,1,[h,g])
    #F
    #F Mallat rule recursive (single stage DWT)
    #F The I(n/2) is inefficient because it copies the output
    #F However, this rule allows application of Lifting, POlyphase, etc.
    #F on DWTper(n,1,[h,g])
    #F
    DWTper_Mallat_2 := rec(
	info             := "DWTper(n,j,[h,g])->DWTper(n,j-1,[h,g])",
	forTransposition := false,
	isApplicable     := P -> P[1] > 2 and P[1] mod 2 =0 and P[2] > 1,

	allChildren := P -> [[ DWTper(P[1]/2,P[2]-1,P[3],P[4]), DWTper(P[1],1,P[3],P[4]) ]],

	rule := (P, C) -> DirectSum(C[1],I(P[1]/2))*C[2]
    ),

    #F DWTper_Mallat:
    #F
    #F DWTper(n,j,[h,g])->DWTper(n/2,j-1,[h,g]), DSCirculant
    #F
    DWTper_Mallat := rec(
        info             := "DWTper(n,j,[h,g])->DWTper(n/2,j-1,[h,g])",
        forTransposition := false,
        isApplicable     := P -> P[1]>2 and P[1] mod 2 = 0,

        allChildren := P -> let(
	    n        := P[1],
	    dcirc1 := DSCirculant(n, P[3][1], P[4][1], 2, 0),
	    dcirc2 := DSCirculant(n, P[3][2], P[4][2], 2, 0),
	    When(P[2]=1, [[ dcirc1, dcirc2 ]],
		         [[ dcirc1, dcirc2, DWTper(P[1]/2, P[2]-1, P[3], P[4]) ]])),

         rule := (P, C) -> When(P[2]=1, VStack(C[1], C[2]),
                                        VStack(C[3]*C[1], C[2]))
    ),

    #F DWTper_Polyphase:
    #F
    #F DWTper(n,1,[h,g])->[ [Circulant(he), Circulant(ho)],
    #F                      [Circulant(ge), Circulant(go)] ]
    #F
    #F Single-stage periodic DWT into a matrix of circulants of downsampled filters
    #F
    DWTper_Polyphase := rec(
	info             := "DWTper(n,1,[h,g]) -> [[Circ(he), Circ(ho)], [Circ(ge), Circ(go)]]",
	forTransposition := false,
	isApplicable     := P -> P[1]>2 and P[1] mod 2 =0 and P[2]=1,
	allChildren := function(P)
	    local n,h,g,he,ho,ge,go;
	    n := P[1];
	    h := DownsampleTwo([P[3][1], P[4][1]]);
	    g := DownsampleTwo([P[3][2], P[4][2]]);
	    he := Circulant(n/2, h[1][1], h[1][2]);
	    ho := Circulant(n/2, h[2][1], h[2][2]);
	    ge := Circulant(n/2, g[1][1], g[1][2]);
	    go := Circulant(n/2, g[2][1], g[2][2]);
	    return [[ he, ho, ge, go ]];
	end,
	rule := (P, C) -> BlockMat( [[ C[1], C[2] ],
		                     [ C[3], C[4] ]] ) * L(P[1],2)
    ),

    #F RuleDWTper_Lifting:
    #F
    DWTper_Lifting := rec(
        info             := "DWTper(n,1,[h,g]) -> Lifting steps",
        forTransposition := false,
        isApplicable     := ( L ) -> L[1]>2 and L[1] mod 2 =0 and L[2]=1,

        allChildren := function ( P )
            local n,j,LS,Lc,scheme,step,pol;
            n := P[1];
            LS := Copy(HashLookupWav(HashTableWavelets, [P[3],P[4]]));
            Lc := List(LS, scheme->
                     List(scheme{[2..Length(scheme)]}, step->
                        let(pol := FillZeros(ListPoly(step)),
                            Circulant(n/2,pol[1],pol[2]))));

            for i in [1..Length(LS)] do
             # attach the indicator of the type of the first liftings step
              Lc[i][1].lift :=LS[i][1];

             # fuse in the constants/shifts in the last lifting step
             #if (LS[i][1]=0 or LS[i][1]=-2) then LS[i][4]:=LS[i][4]*LS[i][3];
             #else  LS[i][4]:=LS[i][4]*LS[i][2];
             #fi;

             pol := FillZeros(ListPoly(LS[i][4]));
             Lc[i][3] := Circulant(n/2,pol[1],pol[2]);
            od;
            return Lc;
        end,

        rule := function ( P, C, Nonterms )
            local n, i, ind, b, l, M, first, last, ind0, ind1, lstep, last_ls;
            n := P[1];
            b := Nonterms[1].lift;
            l:=Length(C);

	    ind0 := fTensor(fBase(2,0), fId(Rows(C[3])));
	    ind1 := fTensor(fBase(2,1), fId(Rows(C[3])));
	    lstep := (f,b) -> When(b=0,
		LStep(Scat(ind0) * f * Gath(ind1)),
		LStep(Scat(ind1) * f * Gath(ind0)));

            M := When(b < 0,
		SUM(Scat(ind0)*C[2]*Gath(ind1), Scat(ind1)*C[1]*Gath(ind0)),
		SUM(Scat(ind0)*C[2]*Gath(ind0), Scat(ind1)*C[1]*Gath(ind1)));

	    b := (b+2) mod 2; # make b positive
	    for i in [1 .. l-2] do
	        M := M * lstep(C[i+2], b);
		b := (b+1) mod 2;
            od;

	    first := M.child(1);
	    M := Inplace(Compose(Drop(M.children(),1)));
	    return first * M * L(n,2);
       end
    )
));


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

Class(PrunedMDDFT, TaggedNonTerminal, rec(
    abbrevs := [
        (n,k,blk,pat) -> Checked(ForAll(n, IsPosIntSym), IsIntSym(k), IsPosIntSym(blk), ForAll(pat, IsList),
            [_unwrap(n), _unwrap(k), _unwrap(blk), pat, ]),
        ],
    dims      := self >> [Product(self.params[1]), self.params[3]*Product(self.params[4], i->Length(i))],
    isReal    := self >> false,
    normalizedArithCost := self >> let(n := self.params[1], IntDouble(5 * n * d_log(n) / d_log(2))),
    TType := TComplex,
    terminate := self >> let(nlist := self.params[1],
                                blk := self.params[3], pat_md := self.params[4],
                                scat3d := Tensor(List(Zip2(pat_md, nlist), j->let(pat := j[1], size := j[2],
                                    Tensor(Mat(List(pat, i->BasisVec(size/blk, i))).transpose(), I(blk)).terminate()))),
                                dft3d := MDDFT(nlist, self.params[2]),
                                t := dft3d * scat3d,
                                t.terminate()
                            )

));

Class(PrunedIMDDFT, TaggedNonTerminal, rec(
    abbrevs := [
        (n,k,blk,pat) -> Checked(ForAll(n, IsPosIntSym), IsIntSym(k), IsPosIntSym(blk), ForAll(pat, IsList),
            [_unwrap(n), _unwrap(k), _unwrap(blk), pat, ]),
        ],
    dims      := self >> [ self.params[3]*Product(self.params[4], i->Length(i)), Product(self.params[1]) ],
    isReal    := self >> false,
    normalizedArithCost := self >> let(n := self.params[1], IntDouble(5 * n * d_log(n) / d_log(2))),
    TType := TComplex,
    terminate := self >> let(nlist := self.params[1],
                                blk := self.params[3], pat_md := self.params[4],
                                gath3d := Tensor(List(Zip2(pat_md, nlist), j->let(pat := j[1], size := j[2],
                                    Tensor(Mat(List(pat, i->BasisVec(size/blk, i))), I(blk)).terminate()))),
                                dft3d := MDDFT(nlist, self.params[2]),
                                t := gath3d * dft3d,
                                t.terminate()
                            )

));

NewRulesFor(PrunedMDDFT, rec(
    PrunedMDDFT_Base := rec(
        info := "PrunedMDDFT -> PrunedDFT",
        applicable     := nt -> Length(nt.params[1])=1,
        children       := nt -> let(P := nt.params, tags := nt.getTags(), [[ PrunedDFT(P[1][1], P[2], P[3], P[4][1]).withTags(tags) ]]),
        apply          := (nt, C, Nonterms) -> C[1]
    ),
    PrunedMDDFT_RowCol := rec (
        info := "PrunedMDDFT_n -> PrunedMDDFT_n/d, PrunedMDDFT_d",
        applicable := nt -> Length(nt.params[1]) > 1 and not nt.hasTags(),

        children := nt -> let(
            dims := nt.params[1],
            len := Length(dims),
            pats := nt.params[4],
            List([1..len-1],
            i -> [ PrunedMDDFT(dims{[1..i]}, nt.params[2], nt.params[3], pats{[1..i]}),
                   PrunedMDDFT(dims{[i+1..len]}, nt.params[2], nt.params[3], pats{[i+1..len]}) ])),

        apply := (nt, C, Nonterms) -> let(
            n1 := Cols(Nonterms[1]),
            n2 := Rows(Nonterms[2]),
            Tensor(C[1], I(n2)) *
            Tensor(I(n1), C[2])
        )
    )
));

NewRulesFor(PrunedIMDDFT, rec(
    PrunedIMDDFT_Base := rec(
        info := "PrunedIMDDFT -> PrunedIDFT",
        applicable     := nt -> Length(nt.params[1])=1,
        children       := nt -> let(P := nt.params, tags := nt.getTags(), [[ PrunedIDFT(P[1][1], P[2], P[3], P[4][1]).withTags(tags) ]]),
        apply          := (nt, C, Nonterms) -> C[1]
    ),
    PrunedIMDDFT_RowCol := rec (
        info := "PrunedIMDDFT_n -> PrunedIMDDFT_n/d, PrunedIMDDFT_d",
        applicable := nt -> Length(nt.params[1]) > 1 and not nt.hasTags(),

        children := nt -> let(
            dims := nt.params[1],
            len := Length(dims),
            pats := nt.params[4],
            List([1..len-1],
            i -> [ PrunedIMDDFT(dims{[1..i]}, nt.params[2], nt.params[3], pats{[1..i]}),
                   PrunedIMDDFT(dims{[i+1..len]}, nt.params[2], nt.params[3], pats{[i+1..len]}) ])),

        apply := (nt, C, Nonterms) -> let(
            n1 := Cols(Nonterms[1]),
            n2 := Rows(Nonterms[2]),
            Tensor(C[1], I(n2)) *
            Tensor(I(n1), C[2])
        )
    )
));


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

# Radix N kernel for FFTE

buildScalarKernel_a := function(n, kk, conf, opts)
    local name, suffix, filesuffix, j, k, l, m, tmp1, tmp2, tmp3, i1, i2, gf, sf, gath, scat,
        gc, sc, dft, rts, rt, opcnts, dfts, dftc, i3, twt, twf, twl, tws, twc,
        cl, cc, c, cx, lp, mp;

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

    # variables
    #t := var.fresh_t("t", TInt);
    j := var.fresh_t("j", TInt);
#    k := var.fresh_t("k", TInt);
    k := V(0);
    l := var.fresh_t("l", TInt);
 #   m := var.fresh_t("m", TInt);
   m := V(1);
    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));
    tmp2 := var.fresh_t("S", 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*l*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, tmp2, tmp1, opts), opts);

    # twiddles as lookup table
    i3 := var.fresh_t("i", 2*n);
    twt := var.fresh_t("TW", TPtr(TReal));
    twf := Lambda(i3, cond(eq(i3, 0), 1, eq(i3, 1), 0, nth(twt, 2*((n-1)*j) + 2 * idiv(i3, 2) + (imod(i3, 2) - 2))));

    # debug twiddles
    twl := Map(twf.tolist(), RulesStrengthReduce);
    DoForAll([0..Length(twl)-1], _i->Unparse(assign(nth(Y, _i), twl[_i+1]), CUnparser, 0, 1));

    tws := RCDiag(twf);
    twc :=BlockUnroll(unroll_cmd(opts.codegen(tws, tmp3, tmp2, opts)), opts);

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

    # fixup to push decls inside (?)
    c := func(TVoid, "transform", [Y, X, twt, j, k, lp],
            decl(cc.vars::[l],
                chain(
                    assign(l, deref(lp)),
                    cc.cmd.cmds[1].cmd
                )
            )
         );

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

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

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


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

Class(PkRDFT12_Base, PRDFT_Base, rec(
    dims := self >> [self.params[1], self.params[1]],
    terminate := self >> let(N := self.params[1], k := self.params[2],
	rr := When(self.transposed, Cols(self), Rows(self)),
	mat := Cond(IsEvenInt(N),
            Mat(Concatenation(
                    [List([0..N-1], c-> When(IsEvenInt(c), 1,1))],
                    [List([0..N-1], c-> When(IsEvenInt(c), 1,-1))],
                    List([2..rr-1], r -> When(r mod 2 = 0,
                        List([0..N-1], c -> self.projRe(self.omega(N,k,Int(r/2),c))),
                        List([0..N-1], c -> self.projIm(self.omega(N,k,Int(r/2),c))))))),
            Mat(Concatenation(
                    [List([0..N-1], c -> 1)],
                    List([2..rr], r -> When(r mod 2 = 0,
                        List([0..N-1], c -> self.projRe(self.omega(N,k,Int(r/2),c))),
                        List([0..N-1], c -> self.projIm(self.omega(N,k,Int(r/2),c)))))))),
        When(self.transposed, mat.transpose(), mat)),
));

Class(PkRDFT1, PkRDFT12_Base, rec(
    abbrevs := [ (n) -> Checked(IsPosInt(n),  [n, 1]),
                 (n,k) -> Checked(IsPosIntSym(n), IsIntSym(k),
                                  IsSymbolic(n) or IsSymbolic(k) or Gcd(n,k)=1, [n, k mod n]) ],
    omega := (N,k,r,c) -> E(N)^(k*r*c)
));
Class(PkRDFT2, PkRDFT12_Base, rec(
    abbrevs := [ (n) -> Checked(IsPosIntSym(n),  [n, 1]),
                 (n,k) -> Checked(IsPosIntSym(n), IsIntSym(k),
                                  IsSymbolic(n) or IsSymbolic(k) or Gcd(n,k)=1, [n, k mod (2*n)]) ],
    omega := (N,k,r,c) -> E(2*N)^(k*r*(2*c+1))
));

Class(PkDHT1, PkRDFT1, rec(
    terminate := self >> let(n := self.params[1], k := self.params[2], i := When(IsEvenInt(n), 2, 1),
        DirectSum(I(i), Tensor(I(Int((n-1)/2)), F(2))) *
        PkRDFT1(n, k).terminate()
    )
));

Class(PkDHT2, PkRDFT2, rec(
    terminate := self >> let(n := self.params[1], k := self.params[2], i := When(IsEvenInt(n), 2, 1),
        DirectSum(I(i), Tensor(I(Int((n-1)/2)), Diag(1,-1)*F(2))) *
        PkRDFT2(n, k).terminate()
    )
));

Class(URealDFT_Base, NonTerminal, rec(
    abbrevs := [ (n) -> Checked(IsPosInt(n),  [n, 1]),
                 (n,k) -> Checked(IsPosInt(n), IsInt(k), Gcd(n,k)=1, [n, k mod n]) ],
    terminate := self >> let(N := self.params[1], k := self.params[2],
	rr := When(self.transposed, Cols(self), Rows(self)),
	Mat(Concatenation(
	    [List([0..N-1], c-> When(IsEvenInt(c), 1,0))],
	    [List([0..N-1], c-> When(IsOddInt(c), 1,0))],
	    List([2..rr-1], r -> When(r mod 2 = 0,
		 List([0..N-1], c -> self.projRe(self.omega(N,k,Int(r/2),c))),
		 List([0..N-1], c -> self.projIm(self.omega(N,k,Int(r/2),c)))))))),
    isReal := True,
    SmallRandom := () -> Random([2..16]),
    LargeRandom := () -> 2 ^ Random([6..15])
));

Class(URDFT_Base, URealDFT_Base, rec(
    projRe := Re,
    projIm := Im,
    hashAs := self >> self
));

Class(URDFT, URDFT_Base, rec(
    dims := self >> let(n:=self.params[1], [ 2*(Int((n+1)/2)), n ]),
    omega := (N,k,r,c) -> E(N)^(k*r*c),
));

URDFT1:=URDFT;

# Regularized Rules
# R1 -> (R1, C1) (R1')
# R2 -> (R2, C2) (R1')
PRF12_CTReg_Children := (N,k,PRFt,DFTt,PRF1prime, maxRadix) -> Map2(
    Filtered(DivisorPairs(N),d->d[1] <= maxRadix/2 and d[2]<>2),
    (m,n) -> When(IsEvenInt(n),
	[ PRFt(2*m,k), DFTt(m,k), PRF1prime(n,k) ],
	[ PRFt(m,k),   DFTt(m,k), PRF1prime(n,k) ] )
);

PRF12_CTReg_Rule := (N,k,C,Conj,Tw) -> let(mm:=Cols(C[1]), m:=When(IsEvenInt(N), mm/2, mm),
    n:=Cols(C[3]), Nf:=Int(N/2), Nc:=Int((N+1)/2),
    nf:=Int(n/2), nc:=Int((n+1)/2), mf:=Int(m/2), mc:=Int((m+1)/2), j:=Ind(nc-1),

    SUM(
	BB(RC(Scat(H(Nc,m,0,n/2))) * C[1] * L(mm,2) * RC(Gath(H(nc*m, m, 0, nc)))),

	When(nc=1, [],
	ISum(j, BB(
	     RC(Scat(BH(Nc,N,m,j+1,n))) *
	     Conj * RC(C[2]) * Tw(j) *
	     RC(Gath(H(nc*m, m, j+1, nc))))))
    ) *
    Tensor(I(m), C[3]) * L(N,m)
);

PRF12_CTReg2_Rule := (N,k,C,Conj,Tw) -> let(mm:=Cols(C[1]), m:=When(IsEvenInt(N), mm/2, mm),
    n:=Cols(C[3]), Nf:=Int(N/2), Nc:=Int((N+1)/2),
    nf:=Int(n/2), nc:=Int((n+1)/2), mf:=Int(m/2), mc:=Int((m+1)/2), j:=Ind(nc-1),

    SUM(
	RC(Scat(H(Nc,m,0,n/2))) * C[1] * RC(Gath(H(nc*m, m, 0, 1))),

	When(nc=1, [],
	ISum(j,
	     RC(Scat(BH(Nc,N,m,j+1,n))) *
	     Conj * RC(C[2]) * Tw(j) * L(2*m, m) *
	     RC(Gath(H(nc*m, m, m*(j+1), 1)))))
    ) *
    Tensor(C[3], I(m))
);

PRF12_CTReg3_Rule := (N,k,C,Conj,Tw) -> let(mm:=Cols(C[1]), m:=When(IsEvenInt(N), mm/2, mm),
    n:=Cols(C[3]), Nf:=Int(N/2), Nc:=Int((N+1)/2),
    nf:=Int(n/2), nc:=Int((n+1)/2), mf:=Int(m/2), mc:=Int((m+1)/2), j:=Ind(nc-1),

    SUM(
	RC(Scat(H(Nc,m,0,n/2))) * C[1] * L(2*m, 2) * Gath(H(N, 2*m, 0, nc)),

	When(nc=1, [],
	ISum(j,
	     RC(Scat(BH(Nc,N,m,j+1,n))) *
	     Conj * RC(C[2]) * Tw(j) *
	     Gath(H(N, 2*m, j+1, nc))))
    ) *
    Tensor(I(m), L(n,2)*C[3]) * L(N,m)
);

PRF12_CTReg4_Rule := (N,k,C,Conj,Tw) -> let(mm:=Cols(C[1]), m:=When(IsEvenInt(N), mm/2, mm),
    n:=Cols(C[3]), Nf:=Int(N/2), Nc:=Int((N+1)/2),
    nf:=Int(n/2), nc:=Int((n+1)/2), mf:=Int(m/2), mc:=Int((m+1)/2), j:=Ind(nc-1),

    RC(Tensor(I(m/2), DirectSum(I(n/2+1), J(n/2-1)))) *
    RC(L(N/2, m)) *
    DirectSum(
        C[1] * L(2*m, 2),
	IterDirectSum(j, RC(M(m,m/2)) * Conj * RC(C[2]) * Tw(j))
    ) *
    L(N, nc) *
    Tensor(I(m), L(n,2)*C[3]) * L(N,m)
);

PRF12_CTReg5_Rule := (N,k,C,Conj,Tw) -> let(mm:=Cols(C[1]), m:=When(IsEvenInt(N), mm/2, mm),
    n:=Cols(C[3]), Nf:=Int(N/2), Nc:=Int((N+1)/2),
    nf:=Int(n/2), nc:=Int((n+1)/2), mf:=Int(m/2), mc:=Int((m+1)/2), j:=Ind(nc-1),

    RC(Tensor(I(m/2), DirectSum(I(n/2+1), J(n/2-1)))) *
    RC(L(N/2, m)) *
    DirectSum(
        C[1],
	IterDirectSum(j, RC(M(m,m/2)) * Conj * RC(C[2]) * Tw(j) * L(2*m, m))
    ) *
    Tensor(C[3], I(m))
);

unrc := m -> let(r := Dimensions(m)[1], c := Dimensions(m)[2],
    MatSPL(Gath(H(r,r/2,0,2))) * m * MatSPL(Scat(H(c,c/2,0,2))));

RulesFor(URDFT1, rec(
    URDFT1_Base1 := BaseRule(URDFT1, [1, @]),
    URDFT1_Base2 := BaseRule(URDFT1, [2, @]),
    URDFT1_Base4 := BaseRule(URDFT1, [4, @]),

    URDFT1_CT := rec(
        maxRadix := 32,
	isApplicable := P -> not IsPrime(P[1]) and not (IsEvenInt(P[1]) and IsPrime(P[1]/2)),
	allChildren  := (self, P) >> PRF12_CTReg_Children(P[1], P[2], URDFT1, DFT1, URDFT1, self.maxRadix),
	rule := (P,C) -> let(N:=P[1], k:=P[2], m:=When(IsEvenInt(N), Cols(C[1])/2, Cols(C[1])),
	    PRF12_CTReg_Rule(N, k, C, Diag(BHD(m,1,-1)),
                j -> RC(DirectSum(I(1), Diag(fPrecompute(fCompose(Twid(N,m,k,0,0,j+1), fAdd(m, m-1, 1))))))))),

    # slightly different variant of same rule,
    URDFT1_CT2 := rec(
	isApplicable := P -> not IsPrime(P[1]) and not (IsEvenInt(P[1]) and IsPrime(P[1]/2)),
	allChildren  := P -> PRF12_CTReg_Children(P[1], P[2], URDFT1, DFT1, URDFT1),
	rule := (P,C) -> let(N:=P[1], k:=P[2], m:=When(IsEvenInt(N), Cols(C[1])/2, Cols(C[1])),
	    PRF12_CTReg2_Rule(N, k, C, Diag(BHD(m,1,-1)), j->RC(Diag(fPrecompute(Twid(N,m,k,0,0,j+1))))))),

    URDFT1_CT3 := rec(
	isApplicable := P -> not IsPrime(P[1]) and not (IsEvenInt(P[1]) and IsPrime(P[1]/2)),
	allChildren  := P -> PRF12_CTReg_Children(P[1], P[2], URDFT1, DFT1, URDFT1),
	rule := (P,C) -> let(N:=P[1], k:=P[2], m:=When(IsEvenInt(N), Cols(C[1])/2, Cols(C[1])),
	    PRF12_CTReg3_Rule(N, k, C, Diag(BHD(m,1,-1)), j->RC(Diag(fPrecompute(Twid(N,m,k,0,0,j+1))))))),

    URDFT1_CT4 := rec(
	isApplicable := P -> not IsPrime(P[1]) and not (IsEvenInt(P[1]) and IsPrime(P[1]/2)),
	allChildren  := P -> PRF12_CTReg_Children(P[1], P[2], URDFT1, DFT1, URDFT1),
	rule := (P,C) -> let(N:=P[1], k:=P[2], m:=When(IsEvenInt(N), Cols(C[1])/2, Cols(C[1])),
	    PRF12_CTReg4_Rule(N, k, C, Diag(BHD(m,1,-1)), j->RC(Diag(fPrecompute(Twid(N,m,k,0,0,j+1))))))),

    URDFT1_CT5 := rec(
	isApplicable := P -> not IsPrime(P[1]) and not (IsEvenInt(P[1]) and IsPrime(P[1]/2)),
	allChildren  := P -> PRF12_CTReg_Children(P[1], P[2], URDFT1, DFT1, URDFT1),
	rule := (P,C) -> let(N:=P[1], k:=P[2], m:=When(IsEvenInt(N), Cols(C[1])/2, Cols(C[1])),
	    PRF12_CTReg5_Rule(N, k, C, Diag(BHD(m,1,-1)), j->RC(Diag(fPrecompute(Twid(N,m,k,0,0,j+1))))))),

));


# Copyright (c) 2018-2020, Carnegie Mellon University
# See LICENSE for details
#
# Contains the CNOT and SWAP non-terminals and rewrite rules
#

##
#F qSWAPT( <qi>, <qj>, <n>,, <arch> ) Object
##
#F Awaps qi and qj in a system of n qubits, with architecture arch
#F Definition: (2^n x 2^n)-matrix
#F that swaps qubit qi and qubit qj, with the identity operation applied to all others
Class(qSWAPT, TaggedNonTerminal, rec(
  abbrevs   := [ (qi, qj, n, arch) -> Checked(IsPosInt(n), [qi, qj, n, arch]) ],
  dims      := self >> let(size := 2^self.params[3], [size, size]),
  terminate := self >> GenSwapMat(self.params[1], self.params[2], self.params[3]),
  isReal    := self >> true,
  rChildren := self >> self.params,
  from_rChildren := (self, rch) >> self.__bases__[1](rch[1], rch[2], rch[3], rch[4]),
  SmallRandom := () -> Random([2..5]),
  LargeRandom := () -> Random([6..15]),
  normalizedArithCost := self >> Error("ArithCost not implemented"),
  TType := T_Real(64)
));

##
#F CnotTerm( <i>, <j>, <n> )
##
## .terminate() function for the qCNOT Non-terminal. Expands qCNOT non-terminal into a 2^n by 2^n matrix
CnotTerm := function (i, j, n)
    return When(i < j, Tensor(Tensor(I(2^(i)), GenCnotMat(j, 0)), I(2^(n-j))), Tensor(Tensor(I(2^(j)), GenCnotMat(i, 1)), I(2^(n-i)))); # create the intended cnot matrix
end;

##
#F CnotSPL( <i>, <j>, <n> )
##
## Used for the qCNOT_Base breakdown rule. Represents a qCNOT Non-terminal as a tensor of CNOT and I SPL objects
CnotSPL := function (i, j, n)
    return When(i < j, Tensor(Tensor(I(2^(i)), CNOT(j-i, 0)), I(2^(n-1-j))), Tensor(Tensor(I(2^(j)), CNOT(i-j, 1)), I(2^(n-1-i)))); # create the intended cnot matrix
end;

##
#F qCNOT( <qj>, <dir>, <arch> ) Object
##
#F CNOT Non-terminal
#F Definition: (2^n x 2^n)-matrix  that applies a CNOT from qubit 0 to j
Class(qCNOT, TaggedNonTerminal, rec(
  abbrevs   := [ (qj, dir, arch) -> Checked([qj, dir, arch]) ],
  dims      := self >> let(size := 2^(self.params[1]+1), [size, size]),
  terminate := self >> GenCnotMat(self.params[1], self.params[2]),
  isReal    := self >> true,
  groups    := self >> [[2]],
  recursive_def := (self, arch) >> self.__bases__[1](self.params[1], self.params[2], arch),
  rChildren := self >> self.params,
  from_rChildren := (self, rch) >> self.__bases__[1](rch[1], rch[2], rch[3]),
  connected := self >> true,
  SmallRandom := () -> Random([2..5]),
  LargeRandom := () -> Random([6..15]),
  normalizedArithCost := self >> Error("ArithCost not implemented"),
  TType := T_Real(64)
));

##
#F qCNOT Breakdown Rules
##
NewRulesFor(qCNOT, rec(

    #F qCNOT_Base: qCNOT(_) =  CNOT() SPL object
    #F Directly represent as an implementable gate, if a proper edge exists
    qCNOT_Base := rec(
        info             := "qCNOT_(_) -> CNOT(_)",
        forTransposition := false,
        applicable       := (self, nt) >> (HasEdge(0, nt.params[1], nt.params[3]) = 1),
        apply            := (nt, c, cnt) -> CNOT(nt.params[1], nt.params[2]),
    )

));

##
#F CnotSPL( <i>, <j>, <n> )
##
## Used for the qSWAP_Base breakdown rule. Represents a qCNOT Non-terminal as a tensor of CNOT and I SPL objects
CnotSPL := function (i, j, n)
    return When(i < j, Tensor(Tensor(I(2^(i)), CNOT(j-i, 0)), I(2^(n-1-j))), Tensor(Tensor(I(2^(j)), CNOT(i-j, 1)), I(2^(n-1-i)))); # create the intended cnot matrix
end;

##
#F SwapGenChildren( <start>, <ending>, <n>, <arch> )
##
## decompose a qSWAPT transform into smaller qSWAPT transforms
SwapGenChildren := function (start, ending, n, arch)
    local move, children;
    move := Best_Move(start, ending, arch);
    children := [];
    Add(children, [qSWAPT(start, move, n, arch) * qSWAPT(move, ending, n, arch) * qSWAPT(start, move, n, arch)]);
    return children;
end;

##
#F qSWAPT Breakdown Rules
##
NewRulesFor(qSWAPT, rec(

    #F qSWAPT_Base: qSWAPT(_) =  qCNOT() SPL objects
    #F SWAP to CNOT conversion, only if an edge exists
    #F represent a swap as a series of 3 CNOTs with the middle being an alternate direction
    qSWAPT_Base := rec(
        info             := "qSWAPT() -> CNOT * CNOT * CNOT ",
        forTransposition := false,
        applicable       := (self, nt) >> ( (HasEdge(nt.params[1], nt.params[2], nt.params[4]) = 1) and (nt.params[1] <> nt.params[2])),
        children         := nt -> List( [ [ (CnotSPL(nt.params[1], nt.params[2], nt.params[3]))*(CnotSPL(nt.params[2], nt.params[1], nt.params[3]))*(CnotSPL(nt.params[1], nt.params[2], nt.params[3])) ] , [ (CnotSPL(nt.params[2], nt.params[1], nt.params[3]))*(CnotSPL(nt.params[1], nt.params[2], nt.params[3]))*(CnotSPL(nt.params[2], nt.params[1], nt.params[3])) ]  ] ),
        apply            := (nt, c, cnt) -> c[1],
    ),

    #F qSWAPT_ID: qSWAPT(_) =  I() SPL object
    #F SWAP to Identity conversion if the swap is trivial
    qSWAPT_Id := rec(
        info             := "qSWAPT() -> Identity ",
        forTransposition := false,
        applicable       := (self, nt) >> (nt.params[1] = nt.params[2]),
        apply            := (nt, c, cnt) -> I(2^(nt.params[3])),
    ),

    #F qSWAPT_Rec: qSWAPT(_) =   qSWAPT(_) *  qSWAPT(_)
    #F Break down an unimplementable qSWAP into an implementable swap and a swap that is 1 step closer to being implementable
    #F TODO, make this a bit more intelligent, right now SwapGenChildren just does a random walk
    qSWAPT_Rec := rec(
        info             := "qSWAPT() -> qSWAPT() * qSWAPT()",
        forTransposition := false,
        applicable       := (self, nt) >> ((nt.params[1] <> nt.params[2]) and (HasEdge(nt.params[1], nt.params[2], nt.params[4]) = 0)),
        children         := nt -> SwapGenChildren(nt.params[1], nt.params[2], nt.params[3], nt.params[4]),
        apply            := (nt, c, cnt) -> c[1],
    )

));

##
#F ShiftMat( <swap1>, <swap2>, <arch>, <n> )
##
## generates a martix of SWAP operations that swap the qubit groups swap1 and swap2 in parallel
## swap1 is the target position, and swap2 are original positions
ShiftMat := function (swap1, swap2, arch, n)
    local idx, format, backmat, targets, t, positions, e, sw1, sw2, s, i, test, already_swapped;
    idx := 1;
    format := I(2^(n));
    backmat := I(2^(n));
    positions := [];
    targets := [];
    for s in swap1 do
        Add(positions, s);
    od;
    for t in swap2 do
        Add(targets, t);
    od;
    for s in swap1 do
        if ((targets[idx] <> positions[idx])) then # just save the extra trouble, if the swap is trivial
            format := format * qSWAPT(positions[idx], targets[idx], n ,arch);
            backmat := qSWAPT(positions[idx], targets[idx], n , arch) * backmat;
            sw1 := targets[idx];
            sw2 := positions[idx];
            i := 1;
            for e in positions do
                if e = sw1 then
                    positions[i] := sw2;
                fi;
                if e = sw2 then
                    positions[i] := sw1;
                fi;
                i := i + 1;
            od;
        fi;
        idx := idx + 1;
    od;
    return [format, backmat];
end;


#
# cls 17: A_2
#
handle17char3:=function()
    local tmp1,tmp2,o,info,rep,cent,uu;
    o:=AllClasses(orbs)[17];
    info:=infos[17];

    rep:=Representative(o);
    #pr[15]=[0,0,1,1,1,0]
    #pr[13]=[0,1,1,1,0,0]
    #pr[26]=[1,1,1,2,1,0]
    tmp1:=ApplyRootsReflections(rep,[15,13,26]);
    uu:=Unipotent(chevalleyAdj(rep),[[3,1]]);
    tmp1:=Conj(tmp1,uu);
    tmp1:=ConjugateByTori(tmp1,[3],[-1]);

    cent:=FromPositiveBorel(o,info[2]);
    tmp2:=ApplyRootsReflections(cent,[15,13,26]);
    uu:=Unipotent(chevalleyAdj(cent),[[3,1]]);
    tmp2:=Conj(tmp2,uu);
    tmp2:=ConjugateByTori(tmp2,[3],[-1]);

    return [tmp1,tmp2];
end;

#
# cls 10: D_4(a_1)
#
handle10char3:=function()
    local tmp1,tmp2,tmp3,tmp4,o,info,rep,cent,uu;
    o:=AllClasses(orbs)[10];
    info:=infos[10];

    rep:=Representative(o);
    #pr[4] =[0,0,0,1,0,0]
    #pr[32]=[1,1,2,2,1,1]
    #pr[33]=[1,1,1,2,2,1]
    tmp1:=ApplyRootsReflections(rep,[4,32,33]);
    uu:=Unipotent(chevalleyAdj(rep),[[3,-1],[5,1]]);
    tmp1:=Conj(tmp1,uu);
    tmp1:=ConjugateByTori(tmp1,[4,1,2,6],[-1,-1,-1,-1]);

    #pr[20]=[0,1,0,1,1,1]
    #pr[21]=[0,0,1,1,1,1]
    tmp3:=ApplyRootsReflections(rep,[20,21]);
    uu:=Unipotent(chevalleyAdj(rep),[[3,1],[4,1],[5,-1],[9,1],[10,-1]]);
    tmp3:=Conj(tmp3,uu);
    tmp3:=ConjugateByTori(tmp3,[2,4],[-1,-1,-1,-1]);

    cent:=FromPositiveBorel(o,info[2]);
    tmp2:=ApplyRootsReflections(cent,[4,32,33]);
    uu:=Unipotent(chevalleyAdj(cent),[[3,-1],[5,1]]);
    tmp2:=Conj(tmp2,uu);
    tmp2:=ConjugateByTori(tmp2,[4,1,2,6],[-1,-1,-1,-1]);

    tmp4:=ApplyRootsReflections(cent,[20,21]);
    uu:=Unipotent(chevalleyAdj(cent),[[3,1],[4,1],[5,-1],[9,1],[10,-1]]);
    tmp4:=Conj(tmp4,uu);
    tmp4:=ConjugateByTori(tmp4,[2,4],[-1,-1,-1,-1]);

    return [tmp1,tmp3,tmp2,tmp4];
end;

#
# cls 4: E_6(a_3) [13,1,15,6,14,4]
#
handle4char3:=function()
    local tmp1,tmp2,o,info,rep,cent;
    o:=AllClasses(orbs)[4];
    info:=infos[4];

    rep:=Representative(o);
    tmp1:=ConjugateByTorus(rep,4,-1);# h_1 --> h_4

    cent:=FromPositiveBorel(o,info[2]);
    tmp2:=ConjugateByTorus(cent,4,-1);# h_1 --> h_4

    return [tmp1,tmp2];
end;


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

# equality of scalars
scalareq := (a,b) -> AbsFloat(a-b) < 1e-10;
# equality of lists
lseq := (a,b) -> Length(a)=Length(b) and ForAll([1..Length(a)], scalareq(a[i], b[i]));

lequiv := (a,b) -> Cond(
    lseq(a,b),   "eq",
    lseq(a, -b), "eqneg",
    lseq(a, Reversed(b)), "rev",
    lseq(a, -Reversed(b)), "revneg",
    "none");

tovec := lst -> TransposedMat([lst]);
tolst := vec -> TransposedMat(vec)[1];
rpart := vec -> List(vec, x->ReComplex(Complex(x)));
ipart := vec -> List(vec, x->ImComplex(Complex(x)));

rand := arg -> RandomList([-100..100]);
#rand := x->x;

##
## Constructors for symmetric sequences
##
real := n -> List([1..n], rand);
cplx := (rsym, isym) -> (n -> rsym(n) + E(4)*isym(n));

even0 := n -> let(len := Int((n-1)/2), lst := List([2..len+1], rand),
    Flat([rand(1), lst, When(IsEvenInt(n),rand(len+2),[]), Reversed(lst)]));

even00 := n -> let(len := Int((n-1)/2), lst := List([1..len], rand),
    Flat([0, lst, When(IsEvenInt(n),rand(len+1),[]), Reversed(lst)]));
odd0 := n -> let(len := Int((n-1)/2), lst := List([2..len+1], rand),
    Flat([rand(1), lst, When(IsEvenInt(n),0,[]), -Reversed(lst)]));
odd00 := n -> let(len := Int((n-1)/2), lst := List([1..len], rand),
    Flat([0, lst, When(IsEvenInt(n),0,[]), -Reversed(lst)]));

even1 := n -> let(len := Int(n/2), lst := List([1..len], rand),
    Flat([lst, When(IsOddInt(n),rand(len+1),[]), Reversed(lst)]));
odd1 := n -> let(len := Int(n/2), lst := List([1..len], rand),
    Flat([lst, When(IsOddInt(n),0,[]), -Reversed(lst)]));

jeven1 := n -> Checked(IsEvenInt(n), let(lst:=List([1..n/2], rand), Flat([lst,lst])));
jodd1  := n -> Checked(IsEvenInt(n), let(lst:=List([1..n/2], rand), Flat([lst,-lst])));
jeven0 := n -> Checked(IsOddInt(n), Concatenation([rand(0)], jeven1(n-1)));
jeven00 := n -> Checked(IsOddInt(n), Concatenation([0], jeven1(n-1)));
jodd0  := n -> Checked(IsOddInt(n), Concatenation([rand(0)], jodd1(n-1)));
jodd00 := n -> Checked(IsOddInt(n), Concatenation([0], jodd1(n-1)));

ce0 := cplx(even0, odd00);
co0 := cplx(odd0, even00);
ce1 := cplx(even1, odd1);
co1 := cplx(odd1, even1);

jce0 := cplx(jeven0, jodd00);
jco0 := cplx(jodd0, jeven00);
jce1 := cplx(jeven1, jodd1);
jco1 := cplx(jodd1, jeven1);

raderce0 := n -> Checked(IsPrime(n+1), Drop(
    tolst(MatSPL(DFT_Rader.raderMid(n+1,1,PrimitiveRootMod(n+1))) *
	  tovec(Concat([rand(0)], ce0(n)))), 1));

upsample0 := n -> Checked(IsEvenInt(n),  List([1..n], i -> When(IsEvenInt(i),0,rand())));

upsample1 := n -> Checked(IsEvenInt(n),  List([1..n], i -> When(IsOddInt(i),0,rand())));

_even := n -> ((n+1) mod 2);
_odd := n -> (n mod 2);

_minsetPoints := function(points, n)
    local uniq, cur, p;
    cur := []; uniq := Set([]);
    for p in points do
        if not (p in uniq) and p < n then
	    Add(cur, p);
	    AddSet(uniq, p);
	fi;
    od;
    return cur;
end;

_CommuteExt := function(perm, sym, refl_diff, n, drop0)
    local mat, N, ext, points, minset, pmat;
    mat:=MatSPL(Prm(perm));
    N := perm.domain();
    ext := sym.ext(N,false);
    points := List(Refl(n, N-refl_diff, N, perm).tolist(), x->x.ev());
    minset := When(not drop0, _minsetPoints(points, n), Drop(_minsetPoints(points,n), 1)-1);
    pmat := MatSPL(Scat(FList(minset).setRange(Cols(ext))));
    return
       mat * MatSPL(ext) * pmat;
end;

# CommuteExt(spl, sym, scaled) - find X, such that spl * sym.ext(n, scaled) = X * pspl
#  X = spl * sym.ext(n, scaled) * pspl^-1
#

CommuteExt1 := (perm, sym) -> _CommuteExt(perm, sym, -1, Cols(sym.ext(perm.domain(),false)), false);
CommuteExt0 := (perm, sym) -> _CommuteExt(perm, sym, 0,  Cols(sym.ext(perm.domain(),false)), false);
CommuteExt00 := (perm, sym) -> _CommuteExt(perm, sym, 0, 1+Cols(sym.ext(perm.domain(),false)), true);

##
## Constructors for symmetric sequences
##
Class(Symmetry, rec(
    isSymmetry := true,
    __call__ := (self, n) >> self.seq(n),
    red := (self, n, scaled) >> self.ext(n, scaled).transpose(),
    verify := (self, n) >> MatSPL(self.red(n,false)*self.ext(n, true))
));

IsSymmetry := x -> IsRec(x) and IsBound(x.isSymmetry) and x.isSymmetry;

_gathI := (nn, top_hole, bot_hole) -> let(n:=Int(nn), Gath(fAdd(n, n-top_hole-bot_hole, top_hole)));
_gathI2 := (nn, top_hole, bot_hole) -> let(n:=Int(nn), Gath(H(n, Int((n-top_hole-bot_hole+1)/2), top_hole, 2)));
_gathJ := (nn, top_hole, bot_hole) -> let(n:=Int(nn), Gath(fCompose(fAdd(n, n-top_hole-bot_hole, top_hole), J(n-top_hole-bot_hole))));

Class(GathExtend, Sym, rec(def := (n, symmetry) -> symmetry.ext(n, true)));
Class(GathExtendU, Sym, rec(def := (n, symmetry) -> symmetry.ext(n, false)));
Class(GathExtendZ, Sym, rec(def := (n, symmetry) -> DirectSum(I(1),-J(n-1))*symmetry.ext(n, true)));
Class(GathExtendZU, Sym, rec(def := (n, symmetry) -> DirectSum(I(1),-J(n-1))*symmetry.ext(n, false)));
Class(ScatReduce, Sym, rec(def := (n, symmetry) -> symmetry.red(n, true)));
Class(ScatReduceU, Sym, rec(def := (n, symmetry) -> symmetry.red(n, false)));

Class(EOSymmetry, Symmetry, rec(tsize := "cols"));

Class(Upsample0, EOSymmetry, rec(
    seq:=  n -> Checked(IsEvenInt(n),  List([1..n], i -> When(IsEvenInt(i),0,rand()))),
    ext := (n, scaled) -> Checked(IsEvenInt(n), Tensor(I(n/2),Mat([[1],[0]]))),
    red := (n, scaled) -> Checked(IsEvenInt(n), Tensor(I(n/2),Mat([[1,0]]))),
));

Class(Upsample1, EOSymmetry, rec(
    seq:=  n -> Checked(IsEvenInt(n),  List([1..n], i -> When(IsEvenInt(i),0,rand()))),
    ext := (n, scaled) -> Checked(IsEvenInt(n), Tensor(I(n/2),Mat([[0],[1]]))),
    red := (n, scaled) -> Checked(IsEvenInt(n), Tensor(I(n/2),Mat([[0,1]]))),
));

Class(Even0, EOSymmetry, rec(
    seq := n -> let(len := Int((n-1)/2), lst := List([2..len+1], rand),
	Flat([rand(1), lst, When(IsEvenInt(n),rand(len+2),[]), Reversed(lst)])),
    ext := (n, scaled) -> let(hf := When(scaled, 1/2, 1),
	DirectSum(I(1),
	            VStack(
			DirectSum(hf*I(Int((n-1)/2)), I(_even(n))),
			hf*_gathJ(n/2, 0, _even(n))))),
#    red := n -> Gath(fAdd(n, Int((n+2)/2), 0))
));

Class(Even0star, EOSymmetry, rec(
    seq := n -> let(len := Int((n-1)/2), lst := List([2..len+1], rand),
	Flat([rand(1), lst, When(IsEvenInt(n),0,[]), Reversed(lst)])),
    ext := (n, scaled) -> let(hf := When(scaled, 1/2, 1),
	DirectSum(I(1),
	            VStack(
			hf*I(Int((n-1)/2)),
                        When(IsEvenInt(n), O(1, Int((n-1)/2)), []),
			hf*J(Int((n-1)/2))))),
#    red := n -> Gath(fAdd(n, Int((n+2)/2), 0))
));

Class(Even00, EOSymmetry, rec(
    seq := n -> let(len := Int((n-1)/2), lst := List([2..len+1], rand),
	Flat([0, lst, When(IsEvenInt(n),rand(len+2),[]), Reversed(lst)])),
    ext := (n, scaled) -> let(hf := When(scaled, 1/2, 1),
	VStack(O(1,Int(n/2)),
	       DirectSum(hf*I(Int((n-1)/2)), I(_even(n))),
	       hf*_gathJ(n/2, 0, _even(n)))),
#    red := n -> Gath(fAdd(n, Int(n/2), 1))
));

Class(Even00star, EOSymmetry, rec(
    seq := n -> let(len := Int((n-1)/2), lst := List([2..len+1], rand),
	Flat([0, lst, When(IsEvenInt(n),0,[]), Reversed(lst)])),
    ext := (n, scaled) -> let(hf := When(scaled, 1/2, 1),
	VStack(O(1,Int(n/2)),
	       DirectSum(hf*I(Int((n-1)/2)), O(_even(n))),
	       hf*_gathJ(n/2, 0, _even(n)))),
#    red := n -> Gath(fAdd(n, Int(n/2), 1))
));

Class(Even1, EOSymmetry, rec(
    seq := n -> let(len := Int(n/2), lst := List([1..len], rand),
	Flat([lst, When(IsOddInt(n),rand(len+1),[]), Reversed(lst)])),
    ext := (n, scaled) -> let(hf := When(scaled, 1/2, 1),
	When(IsEvenInt(n),
	    hf * VStack(I(n/2), J(n/2)),
	    VStack(DirectSum(hf*I((n-1)/2), I(1)), hf*_gathJ((n+1)/2, 0, 1))))
#    red := n -> Gath(fAdd(n, Int((n+1)/2), 0))
));

Class(Odd0, EOSymmetry, rec(
    seq := n -> let(len := Int((n-1)/2), lst := List([2..len+1], rand),
	Flat([rand(1), lst, When(IsEvenInt(n),0,[]), -Reversed(lst)])),
    ext := (n, scaled) -> let(hf := When(scaled, 1/2, 1),
	DirectSum(I(1),
	         hf*VStack(I(Int((n-1)/2)),
		            When(IsEvenInt(n), O(1, Int((n-1)/2)), []),
			    -J(Int((n-1)/2)))))
#    red := n -> Gath(fAdd(n, Int((n+2)/2), 0))
));

Class(Odd00, EOSymmetry, rec(
    seq := n -> let(len := Int((n-1)/2), lst := List([2..len+1], rand),
	Flat([0, lst, When(IsEvenInt(n),0,[]), -Reversed(lst)])),
    ext := (n, scaled) -> let(hf := When(scaled, 1/2, 1),
	        hf * VStack(O(1,Int((n-1)/2)),
	                     I(Int((n-1)/2)),
			     When(IsEvenInt(n), O(1,Int((n-1)/2)), []),
	                     -J(Int((n-1)/2)))),
#    red := n -> Gath(fAdd(n, Int((n-1)/2), 1))
));

Class(Odd00star, EOSymmetry, rec(
    seq := n -> let(len := Int((n-1)/2), lst := List([2..len+1], rand),
	Flat([0, lst, When(IsEvenInt(n),rand(len+2),[]), -Reversed(lst)])),
    ext := (n, scaled) -> let(hf := When(scaled, 1/2, 1),
	        hf * VStack(O(1,Int((n-1)/2)),
	                    I(Int((n-1)/2)),
                            When(IsEvenInt(n), RowVec( Replicate(Int((n-3)/2),0)::[1]  ), []),
                            -J(Int((n-1)/2)))),
#    red := n -> Gath(fAdd(n, Int((n-1)/2), 1))
));

Class(Odd1, EOSymmetry, rec(
    seq := n -> let(len := Int(n/2), lst := List([1..len], rand),
	Flat([lst, When(IsOddInt(n),0,[]), -Reversed(lst)])),
    ext := (n, scaled) -> let(hf := When(scaled, 1/2, 1),
	     hf * VStack(I(Int(n/2)),
		         When(IsOddInt(n), O(1, Int(n/2)),[]),
			 -J(Int(n/2)))),
#    red := n -> Gath(fAdd(n, Int(n/2), 0))
));

Class(Real, EOSymmetry, rec(
    seq := n -> List([1..n], rand),
    ext := (n, scaled) -> I(n),
    tsize := "rows", # does not matter, since ext is square
));

# NOTE: red != ext^T, how to handle?
# - silently drop scaling?

# DirectSum((I tensor W), j * I(1))
#
Class(Conj_Base, Symmetry, rec(
    __call__ := (self, w, j) >> Checked(IsMat(w), DimensionsMat(w)=[2,2],
	WithBases(self, rec(
		w := w,
		j := j,
		operations := PrintOps
    ))),
    tsize := "rows",
    print := self >> Print(self.name, "(", self.w, ", ", self.j, ")"),
    W := self >> When(IsBound(self.isOdd) and self.isOdd, self.w * DiagonalMat([1, -1]), self.w),
    invertW := self >> let(base := self.__bases__[1], base(TransposedMat(self.w^-1), 1/self.j)),
    seq := (self, n) >> self.re.seq(n) + E(4) * self.im.seq(n),
    verify := (self, n) >> MatSPL(self.red(n,false)*self.ext(n, false))
));

Class(Conj0_Base, Conj_Base, rec(
    P := n -> DirectSum(I(1), L_or_OS(n-1, Int(n/2)) * DirectSum(I(Int(n/2)), J(Int((n-1)/2)))),
    ext := (self, n, scaled) >> self.invertW().red(n, scaled).transpose(),
    red := (self, n, scaled) >> let(
	W := Mat(When(scaled, self.W(), self.W())),
        self.PP(n) * DirectSum(I(1), Tensor(I(Int((n-1)/2)), W), self.j * I(_even(n))) * self.P(n)
    )
));

Class(Conj1_Base, Conj_Base, rec(
    P := n -> L_or_OS(n, Int((n+1)/2)) * DirectSum(I(Int((n+1)/2)), J(Int(n/2))),
    seq := (self, n) >> self.re.seq(n) + E(4) * self.im.seq(n),
    ext := (self, n, scaled) >> self.invertW().red(n, scaled).transpose(),
    red := (self, n, scaled) >> let(
	W := Mat(When(scaled, self.W(), self.W())),
        self.PP(n) * DirectSum(Tensor(I(Int(n/2)), W), self.j * I(_odd(n))) * self.P(n)
    )
));

Class(Conj0_R2R, Conj0_Base, rec(PP := (self, n) >> self.P(n).transpose()));
Class(Conj1_R2R, Conj1_Base, rec(PP := (self, n) >> self.P(n).transpose()));

Class(CE0_R2R, Conj0_R2R, rec(re := Even0, im := Odd00,  isOdd := false));
Class(CO0_R2R, Conj0_R2R, rec(re := Odd0,  im := Even00, isOdd := true, j := -E(4)));
Class(CE1_R2R, Conj1_R2R, rec(re := Even1, im := Odd1,   isOdd := false));
Class(CO1_R2R, Conj1_R2R, rec(re := Odd1,  im := Even1,  isOdd := true, j := -E(4)));

_m := n -> When(n=1, Mat([[1], [0]]), I(0));
_mj := n -> When(n=1, Mat([[0], [1]]), I(0));

Class(Conj0_R2Cpx, Conj0_Base, rec(PP := (self, n) >>
	DirectSum(_m(1), I(n-1-_even(n)), _m(_even(n)))));

Class(Conj1_R2Cpx, Conj1_Base, rec(PP := (self, n) >>
	DirectSum(I(n-_odd(n)), When(self.isOdd, _mj(_odd(n)), _m(_odd(n))))));

Class(CE0_R2Cpx, Conj0_R2Cpx, rec(re := Even0, im := Odd00,  isOdd := false));
Class(CO0_R2Cpx, Conj0_R2Cpx, rec(re := Odd0,  im := Even00, isOdd := true, j := -E(4)));
Class(CE1_R2Cpx, Conj1_R2Cpx, rec(re := Even1, im := Odd1,   isOdd := false));
Class(CO1_R2Cpx, Conj1_R2Cpx, rec(re := Odd1,  im := Even1,  isOdd := true, j := -E(4)));

W_RFT := 1/2*[[1, 1], [-E(4), E(4)]];
W_RFTT := 1/2*[[1, 1], [E(4), -E(4)]];
W_URFT := [[1, 1], [-E(4), E(4)]];
W_URFTT := [[1, 1], [E(4), -E(4)]];
W_DHT := 1/2*[[1-E(4), 1+E(4)], [1+E(4), 1-E(4)]];

rsym := function(x)
    local n, nc, nf, mid, uniq, zeros, fst_0, mid_0, fstmid;
    n := Length(x); nc := Int((n+1)/2); nf := Int(n/2); mid := nf;
    if n=0 then return "empty"; fi;

    fst_0 := scalareq(x[1], 0);
    mid_0 := scalareq(x[nf+1], 0);
    fstmid := [Cond(fst_0,0, 1), Cond(mid_0, 0, 1)];

    if ForAll(x, e->scalareq(e,0)) then return "zero";

    # normal symmetries
    elif ForAll([1..nc-1], i->scalareq(x[1+ i],  x[1+ (n-i) mod n])) then
        fstmid[2] := Cond(IsOddInt(n), 1, fstmid[2]);
        if   fstmid=[0,0] then return "even00*";
	elif fstmid=[0,1] then return "even00";
        elif fstmid=[1,0] then return "even0*";
        elif fstmid=[1,1] then return "even0";
        fi;
    elif ForAll([1..nc-1], i->scalareq(x[1+ i], -x[1+ (n-i) mod n])) then
        fstmid[2] := Cond(IsOddInt(n), 0, fstmid[2]);
        if   fstmid=[0,0] then return "odd00";
	elif fstmid=[0,1] then return "odd00*";
        elif fstmid=[1,0] then return "odd0";
        elif fstmid=[1,1] then return "odd0*";
        fi;
    elif ForAll([0..mid-1], i->scalareq(x[1+ i],  x[1+ (n-1-i)])) then
        if IsOddInt(n) and mid_0 then return "even1*";
        else return "even1";
        fi;
    elif ForAll([0..mid-1], i->scalareq(x[1+ i], -x[1+ (n-1-i)])) then
        if IsOddInt(n) and not mid_0 then return "odd1*";
        else return "odd1";
        fi;

    # symmetries with flipped bottom, i.e. abcabc
    elif n>2 and IsOddInt(n) and ForAll([1..nc-1], i->scalareq(x[1+ i],  x[1+ mid+i])) then
	if fst_0 then return "jeven00"; else return "jeven0"; fi;
    elif n>2 and IsOddInt(n) and ForAll([1..nc-1], i->scalareq(x[1+ i], -x[1+ mid+i])) then
	if fst_0 then return "jodd00"; else return "jodd0"; fi;
    elif n>2 and ForAll([0..mid-1], i->scalareq(x[1+ i],  x[1+ mid+i])) then return "jeven1";
    elif n>2 and ForAll([0..mid-1], i->scalareq(x[1+ i], -x[1+ mid+i])) then return "jodd1";

    # rader symmetries, similar to normal but every other sample in bottom half is negated
    elif  ForAll([1..nc-1], i->scalareq(x[1+i], (-1)^i * x[1+(n-i) mod n])) then
	if fst_0 then return "rader_even00"; else return "rader_even0"; fi;
    elif  ForAll([1..nc-1], i->scalareq(x[1+i], - (-1)^i * x[1+(n-i) mod n])) then
	if fst_0 then return "rader_odd00"; else return "rader_odd0"; fi;

    # symmetries with normal shape, but elements negated in some non-recognized way
    elif  ForAll([1..nc-1], i->scalareq(x[1+i], x[1+(n-i) mod n]) or scalareq(x[1+i], -x[1+(n-i) mod n])) then
	if fst_0 then return "eo00"; else return "eo0"; fi;
    elif  ForAll([0..mid-1], i->scalareq(x[1+i], x[1+(n-1-i)]) or scalareq(x[1+i], -x[1+(n-1-i)])) then
	return "eo1";
    else
	uniq := Length(Set(List(x, e->V(AbsFloat(e)))));
	zeros := Length(Filtered(x, e->scalareq(e,0)));
	if uniq <= Int((n+2)/2) then
            # no obvious symmetry, but only approx half unique elements
	    # so sequence is still redundant
	    return Concat("red_", String(uniq-zeros), "/", String(zeros), "/",String(Length(x)));
	else return "none";
	fi;
    fi;
end;

risym := function(x)
    local rs, is, re, im;
    re := List(x, e->ReComplex(Complex(e)));
    im := List(x, e->ImComplex(Complex(e)));
    rs := rsym(re);
    is := rsym(im);
    return [rs,is];
end;

csym := function(x)
   local s;
   s := sym(x);
   if s = ["even0", "odd00"] then return "ce0";
   elif s = ["odd0", "even00"] then return "co0";
   elif s = ["even1", "odd1"] then return "ce1";
   elif s = ["odd1", "even1"] then return "co1";
   elif s = ["jeven1", "jodd1"] then return "jce1";
   elif s = ["jodd1", "jeven1"] then return "jco1";
   elif s = ["rader_even0", "rader_odd00"] then return "rader_ce0";
   elif s = ["rader_odd0", "rader_even00"] then return "rader_co0";
   elif s = ["none", "zero"] then return "real";
   elif s = ["zero", "none"] then return "imag";
   elif s = ["zero", "zero"] then return "zero";
   elif s = ["none", "none"] then return "cplx";
   else return s;
   fi;
end;

part := (v, str, n) -> v{1 + [ 0 .. (Length(v) / str - 1) ] * str + n};

fxi_inputs := (inp, fsize) -> let(
    m := Length(inp)/fsize,
    List([0..m-1], x->part(inp,m,x)));

fxi_rsyms := (inp, fsize) -> List(fxi_inputs(inp, fsize), rsym);
fxi_syms := (inp, fsize) -> List(fxi_inputs(inp, fsize), risym);

transf_syms := (n, transforms, syms) ->
   List(syms, s ->
       List(transforms, transform ->
	   let(inpvec := TransposedMat([s(n)]),
	       outvec := TransposedMat(MatSPL(transform(n))*inpvec)[1],
	       outsym := sym(outvec),
	       Cond(outsym[2]="zero", outsym[1],
		    outsym[1]="zero", Concat("j*", outsym[2]),
		    "none"))));

ctransf_syms := (n, transforms, syms) ->
   List(syms, s ->
       List(transforms, transform ->
	   let(inpvec := TransposedMat([s(n)]),
	       outvec := TransposedMat(MatSPL(transform(n))*inpvec)[1],
	       risym(outvec))));

# transf_syms(18, [ DFT1, DFT2, DFT3, DFT4 ], [even00, even1, odd00, odd1]);

# fxi_syms(even0(36),6);
# fxi_syms(even00(36),6);
# fxi_syms(even1(36),6);
# fxi_syms(odd0(36),6);
# fxi_syms(odd00(36),6);
# fxi_syms(odd1(36),6);

#    if rs="none" and is="none" then return "none";
#    elif rs="none" and is="zero" then return "real";
#    elif rs="even" and is="odd" then return "ce";
#    elif rs="even" and is="odd" then return "ce";
#end;
twpow :=  (N,n) -> List([0..N-1], j -> (j mod n) * Int(j / n));

tw1 :=  (N,n) -> List([0..N-1], j -> E(4*N)^((2*(j mod n))   * (2*Int(j / n))));
tw2 :=  (N,n) -> List([0..N-1], j -> E(4*N)^((2*(j mod n))   * (2*Int(j / n)+1)));
tw3 :=  (N,n) -> List([0..N-1], j -> E(4*N)^((2*(j mod n)+1) * (2*Int(j / n))));
tw4 :=  (N,n) -> List([0..N-1], j -> E(4*N)^((2*(j mod n)+1) * (2*Int(j / n)+1)));
dct2diag := N -> List([0..N-1], i->E(2*N)^i);
dct4diag := N -> List([0..N-1], i->E(4*N)^(2*i+1));
idct2diag := N -> List([0..N-1], i->E(2*N)^-i);
listmul := (l1,l2) -> List([1..Length(l1)], i->l1[i]*l2[i]);

ComplexFFT2 := input -> TransposedMat(MatSPL(DFT2(Length(input))) * TransposedMat([input]))[1];
ComplexFFT3 := input -> TransposedMat(MatSPL(DFT3(Length(input))) * TransposedMat([input]))[1];
ComplexFFT4 := input -> TransposedMat(MatSPL(DFT4(Length(input))) * TransposedMat([input]))[1];

# Macro Extensions
#
MacroExt0 := (k,a,b,c,d) -> Checked(IsSymmetry(a), IsSPL(b), IsSPL(d), b.dims()=d.dims(),
    IsOddInt(k) or IsSymmetry(c),
    Cond(IsOddInt(k),
         let(kk := (k-1)/2, n := Cols(b),
             top := DirectSum(GathExtendU(n, a), Tensor(I(kk), b)),
             VStack(top,
                    Tensor(J(kk), d) * Gath(fAdd(Cols(top), kk*Cols(d), Cols(a.ext(n,true)))))),
         let(kk := (k-2)/2, n := Cols(b),
             top := DirectSum(GathExtendU(n, a), Tensor(I(kk), b), GathExtendU(n, c)),
             VStack(top,
                    Tensor(J(kk), d) * Gath(fAdd(Cols(top), kk*Cols(d), Cols(a.ext(n,true))))))
         ));

MacroExt1 := (k,b,c,d) -> Checked(IsSPL(b), IsSPL(d), b.dims()=d.dims(),
    IsEvenInt(k) or IsSymmetry(c),
    Cond(IsOddInt(k),
         let(kk := (k-1)/2, n := Cols(b),
             top := DirectSum(Tensor(I(kk), b), GathExtendU(n, c)),
             VStack(top,
                    Tensor(J(kk), d) * Gath(fAdd(Cols(top), kk*Cols(d), 0)))),
         let(kk := k/2,
             VStack(Tensor(I(kk), b),
                    Tensor(J(kk), d)))
         ));

Jp := x -> OS(x, -1);

listExtMat := mat -> List(mat, row -> let(n:=PositionProperty(row, x->x<>0),
    Cond(n=false, 0,
         row[n]<0, -n,
         +n)));

analyze := (stride, extmat) -> let(
    lst := listExtMat(MatSPL(extmat)),
    fsize := Length(lst)/stride,
    rec(inp := fxi_inputs(lst, fsize),
        sym := fxi_rsyms(lst, fsize)));

analyzeT := (stride, extmat, partsizes) -> let(
    fsize := Rows(extmat)/stride,
    lst := listExtMat(TransposedMat(MatSPL(L(fsize*stride, stride)*extmat))),
    part := Drop(ScanL(partsizes, (p, x) -> [Last(p)+1..Last(p)+x], [0]), 1),
    rec(out := List(part, p->lst{p})));

panalyze := function(stride, extmat)
    local r, zip, i, e, sym, n, mid, j, cur, absprev, prev, sign;
    r := analyze(stride, extmat);
    zip := Zip2(r.sym, r.inp);
    n := Length(zip);
    mid := Int((n+1)/2);
    for i in [1..Length(zip)] do
        e := zip[i];
        if e[1] = "none" then
            sym := "I";
            if i > mid then
                cur := List(e[2], AbsInt);
                for j in [1..mid] do
                   prev := r.inp[j];
                   absprev := List(r.inp[j], AbsInt);
                   if cur=Reversed(absprev) then
                       prev := Reversed(prev);
                       sign := Cond(e[2]=prev, "", e[2]=-prev, "-", "#");
                       sym := sign :: "J/" :: StringInt(j);
                   elif cur=[absprev[1]]::Reversed(Drop(absprev, 1)) then
                       prev := [prev[1]]::Reversed(Drop(prev, 1));
                       sign := Cond(e[2]=prev, "", e[2]=-prev, "-", "#");
                       sym := sign :: "J'/"::StringInt(j);
                   fi;
                od;
            fi;
        else
            sym := YellowStr(e[1]);
        fi;
        Print(sym, ": ", e[2], "\n");
    od;
end;


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

Class(RealDFT_Base, TaggedNonTerminal, rec(
    abbrevs := [ (n) -> Checked(IsPosInt(n),  [n, 1]),
                 (n,k) -> Checked(IsPosInt(n), IsInt(k), Gcd(n,k)=1, [n, k]) ],

    terminate := self >> let(N := self.params[1], k := self.params[2],
	rr := When(self.transposed, Cols(self), Rows(self)),
	mat := Mat(List([0..rr-1], r -> When(r mod 2 = 0,
                    List([0..N-1], c -> self.projRe(self.omega(N,k,Int(r/2),c))),
                    List([0..N-1], c -> self.projIm(self.omega(N,k,Int(r/2),c)))))),
        When(self.transposed, mat.transpose(), mat)),

    toAMat := self >> self.terminate().toAMat(),

    isReal := True,
    SmallRandom := () -> Random([2..16]),
    LargeRandom := () -> 2 ^ Random([6..15]),

    normalizedArithCost := self >> let(n := self.params[1],
       floor(2.5 * n * log(n) / log(2.0))),

    hashAs := self >> let(t:=ObjId(self)(self.params[1], 1).withTags(self.getTags()),
        When(self.transposed, t.transpose(), t))

));

Class(PDHT13_Base, RealDFT_Base, rec(
    projRe := w -> Re(w)+Im(w),
    projIm := w -> Re(w)-Im(w)
));

Class(PDHT24_Base, RealDFT_Base, rec(
    projRe := w -> Re(w)+Im(w),
    projIm := w -> -Re(w)+Im(w)
));

Class(PRDFT_Base, RealDFT_Base, rec(
    projRe := Re,
    projIm := Im
));

Class(IPRDFT_Base, TaggedNonTerminal, rec(
    abbrevs := [ (n) -> Checked(IsPosInt(n),  [n, 1]),
	         (n,k) -> Checked(IsPosInt(n), IsInt(k), Gcd(n,k)=1, [n, k]) ],
    terminate := self >> let(n:=self.params[1], k:=self.params[2],
	self.rdft(n, -k).terminate().transpose() * self.diag(n)),
    isReal := True,
    SmallRandom := () -> Random([2..16]),
    LargeRandom := () -> 2 ^ Random([6..15]),

    diag0 := n -> When(n=2, I(4),
        Diag(diagDirsum(fConst(TReal, 2, 1), fConst(TReal, 2*Int((n-1)/2), 2),
                When(IsEvenInt(n), fConst(TReal, 2, 1), [])))),

    diag1 := n -> Diag(diagDirsum(fConst(TReal, 2*Int(n/2), 2),
                          When(IsOddInt(n), fConst(TReal, 2, 1), []))),

    normalizedArithCost := self >> let(n := self.params[1],
       floor(2.5 * n * log(n) / log(2.0))),

    hashAs := self >> let(t:=ObjId(self)(self.params[1], 1).withTags(self.getTags()),
        When(self.transposed, t.transpose(), t))
));

Declare(IPRDFT, IPRDFT1, IPRDFT2, IPRDFT3, IPRDFT4);

# PRDFT(<N>, <k>) - Packed Real DFT Nonterminal
#   Is a N+2 x N real matrix. N+2 outputs correspond
#   to Floor(N/2)+1 complex outputs of complex DFT
#   the other half of complex DFT outputs are complex
#
Class(PRDFT, PRDFT_Base, rec(
    abbrevs := [ (n) -> Checked(IsPosInt(n),  [n, 1]),
                 (n,k) -> Checked(IsPosInt(n), IsInt(k), Gcd(n,k)=1, [n, k mod n]) ],
    dims := self >> let(n:=self.params[1], d := [2*(Int(n/2)+1), n], When(self.transposed, Reversed(d), d)),
    omega := (N,k,r,c) -> E(N)^(k*r*c),
    inverse := self >> IPRDFT1(self.params[1], -self.params[2]),
    inverseViaDiag := self >> self.transpose() * IPRDFT.diag(self.params[1])
));
PRDFT1 := PRDFT;

Class(PRDFT2, PRDFT_Base, rec(
    abbrevs := [ (n) -> Checked(IsPosInt(n),  [n, 1]),
                 (n,k) -> Checked(IsPosInt(n), IsInt(k), Gcd(n,k)=1, [n, k mod (2*n)]) ],
    dims := self >> let(n:=self.params[1], d := [2*(Int(n/2)+1), n], When(self.transposed, Reversed(d), d)),
    omega := (N,k,r,c) -> E(2*N)^(k*r*(2*c+1)),
    inverse := self >> IPRDFT3(self.params[1], -self.params[2])
));

Class(PRDFT3, PRDFT_Base, rec(
    abbrevs := [ (n) -> Checked(IsPosInt(n),  [n, 1]),
                 (n,k) -> Checked(IsPosInt(n), IsInt(k), Gcd(n,k)=1, [n, k mod (2*n)]) ],
    dims := self >> let(n:=self.params[1], d := [2*(Int((n+1)/2)), n], When(self.transposed, Reversed(d), d)),
    omega := (N,k,r,c) -> E(2*N)^(k*(2*r+1)*c),
    inverse := self >> IPRDFT2(self.params[1], -self.params[2])
));

Class(PRDFT4, PRDFT_Base, rec(
    abbrevs := [ (n) -> Checked(IsPosInt(n),  [n, 1]),
                 (n,k) -> Checked(IsPosInt(n), IsInt(k), Gcd(n,k)=1, [n, k mod (4*n)]) ],
    dims := self >> let(n:=self.params[1], d := [2*(Int((n+1)/2)), n], When(self.transposed, Reversed(d), d)),
    omega := (N,k,r,c) -> E(4*N)^(k*(2*r+1)*(2*c+1)),
    inverse := self >> IPRDFT4(self.params[1], -self.params[2])
));

# Class(SkewRDFT3, PRDFT_Base, rec(
#     abbrevs := [ (n) -> Checked(IsPosInt(n),  [n, 1, 0, 0]),
#       (n,k) -> Checked(IsPosInt(n), IsInt(k), Gcd(n,k)=1, [n, k, 0, 0]),
#       (n,k,lr,rr) -> Checked(IsPosInt(n), IsInt(k), IsRat(lr), IsRat(rr),
# 	  Gcd(n,k)=1, [n, k, lr, rr])
#     ],
#     dims := self >> let(n:=self.params[1], [ 2*Int((n+1)/2), n ]),
#     omega := (self,N,k,r,c) >> let(
# 	lnum:=Numerator(self.params[3]), lden:=Denominator(self.params[3]),
# 	rnum:=Numerator(self.params[4]), rden:=Denominator(self.params[4]),
# 	E(2*N*lden*rden) ^ (k*(lden*(2*r+1)+lnum)*(rden*c+rnum)))
# ));
# Class(SkewRDFT4, SkewRDFT3, rec(
#     dims := self >> let(n:=self.params[1], [ 2*Int((n+1)/2), n ]),
#     omega := (self,N,k,r,c) >> let(
# 	lnum:=Numerator(self.params[3]), lden:=Denominator(self.params[3]),
# 	rnum:=Numerator(self.params[4]), rden:=Denominator(self.params[4]),
# 	E(4*N*lden*rden) ^ (k*(lden*(2*r+1)+lnum)*(rden*(2*c+1)+rnum)))
# ));

#
# Hartley
#
Class(PDHT, PDHT13_Base, rec(
    abbrevs := [ (n) -> Checked(IsPosInt(n),  [n, 1]),
                 (n,k) -> Checked(IsPosInt(n), IsInt(k), Gcd(n,k)=1, [n, k mod (n)]) ],
    dims := self >> let(n:=self.params[1], d := [2*(Int(n/2)+1), n], When(self.transposed, Reversed(d), d)),
    omega := PRDFT.omega
));
PDHT1 := PDHT;

Class(PDHT2, PDHT24_Base, rec(
    abbrevs := [ (n) -> Checked(IsPosInt(n),  [n, 1]),
                 (n,k) -> Checked(IsPosInt(n), IsInt(k), Gcd(n,k)=1, [n, k mod (2*n)]) ],
    dims := self >> let(n:=self.params[1], d := [2*(Int(n/2)+1), n], When(self.transposed, Reversed(d), d)),
    omega := PRDFT2.omega
));

Class(PDHT3, PDHT13_Base, rec(
    abbrevs := [ (n) -> Checked(IsPosInt(n),  [n, 1]),
                 (n,k) -> Checked(IsPosInt(n), IsInt(k), Gcd(n,k)=1, [n, k mod (2*n)]) ],
    dims := self >> let(n:=self.params[1], d := [2*(Int((n+1)/2)), n], When(self.transposed, Reversed(d), d)),
    omega := PRDFT3.omega
));

Class(PDHT4, PDHT24_Base, rec(
    abbrevs := [ (n) -> Checked(IsPosInt(n),  [n, 1]),
                 (n,k) -> Checked(IsPosInt(n), IsInt(k), Gcd(n,k)=1, [n, k mod (4*n)]) ],
    dims := self >> let(n:=self.params[1], d := [2*(Int((n+1)/2)), n], When(self.transposed, Reversed(d), d)),
    omega := PRDFT4.omega
));

# IPRDFT(<N>, <k>) - Inverse Packed Real DFT Nonterminal
#   Is a N x N+2 real matrix. When applied to N+2 outputs
#   of PRDFT yields the original real input.
Class(IPRDFT, IPRDFT_Base, rec(
    abbrevs := [ (n) -> Checked(IsPosInt(n),  [n, 1]),
                 (n,k) -> Checked(IsPosInt(n), IsInt(k), Gcd(n,k)=1, [n, k mod (n)]) ],
    dims := self >> let(n:=self.params[1], d := [n, 2*(Int(n/2)+1)], When(self.transposed, Reversed(d), d)),
    rdft := PRDFT,
    diag := IPRDFT_Base.diag0
));
IPRDFT1 := IPRDFT;

# IPRDFT2 is inverse if PRDFT3
Class(IPRDFT2, IPRDFT_Base, rec(
    abbrevs := [ (n) -> Checked(IsPosInt(n),  [n, 1]),
                 (n,k) -> Checked(IsPosInt(n), IsInt(k), Gcd(n,k)=1, [n, k mod (2*n)]) ],
    dims := self >> let(n:=self.params[1], d := [n, 2*(Int((n+1)/2))], When(self.transposed, Reversed(d), d)),
    rdft := PRDFT3,
    diag := IPRDFT_Base.diag1
));

# IPRDFT3 is inverse if PRDFT2
Class(IPRDFT3, IPRDFT_Base, rec(
    abbrevs := [ (n) -> Checked(IsPosInt(n),  [n, 1]),
                 (n,k) -> Checked(IsPosInt(n), IsInt(k), Gcd(n,k)=1, [n, k mod (2*n)]) ],
    dims := self >> let(n:=self.params[1], d := [n, 2*(Int(n/2)+1)], When(self.transposed, Reversed(d), d)),
    rdft := PRDFT2,
    diag := IPRDFT_Base.diag0
));

Class(IPRDFT4, IPRDFT_Base, rec(
    abbrevs := [ (n) -> Checked(IsPosInt(n),  [n, 1]),
                 (n,k) -> Checked(IsPosInt(n), IsInt(k), Gcd(n,k)=1, [n, k mod (4*n)]) ],
    dims := self >> let(n:=self.params[1], d := [n, 2*(Int((n+1)/2))], When(self.transposed, Reversed(d), d)),
    rdft := PRDFT4,
    diag := IPRDFT_Base.diag1
));


# The tetrahedron with v=4, k=3, lm=2.
BindGlobal("TetrahedronGraph", CompleteGraph(SymmetricGroup(4)));

# The octahedron with v=6, k=4, lm=2, mu=4.
BindGlobal("OctahedronGraph", CocktailPartyGraph(3));

# The Petersen graph with v=10, k=3, lm=0, mu=1.
BindGlobal("PetersenGraph", OddGraph(2));

# The Clebsch graph with v=16, k=10, lm=6, mu=6.
BindGlobal("ClebschGraph", HalvedCubeGraph(5));

# The Schlaefli graph with v=27, k=16, lm=10, mu=8.
BindGlobal("SchlaefliGraph",
    Graph(DirectProduct(SymmetricGroup(6), SymmetricGroup(2)),
        [[-3,-3,1,1,1,1,1,1], [3,-1,-1,-1,-1,-1,-1,3]],
        OnRoots, RootAdjacency));

# The Hoffman-Singleton graph with v=50, k=7, lm=0, mu=1.
BindGlobal("HoffmanSingletonGraph", List([function()
        local G, dp, p1, p2, p3, p4;
        G := Group((1, 2, 3, 4, 5));
        dp := DirectProduct(G, G, G, Group((1, 2)));
        p1 := Projection(dp, 1);
        p2 := Projection(dp, 2);
        p3 := Projection(dp, 3);
        p4 := Projection(dp, 4);
        return Graph(dp, Cartesian(GF(5), GF(5), [1, 2]),
            function(x, g)
                local g4, j, s, u, v;
                u := 5^Image(p2, g) * Z(5)^0;
                v := 5^Image(p3, g) * Z(5)^0;
                g4 := Image(p4, g);
                s := x[3]^2;
                j := [1, 2*x[3]];
                return [1^g4*(x[1]+x[2]*(u-s*v)+s*(u^2-v^2)/2)+5^Image(p1, g),
                    j[1^g4]*(x[2]+s*u+v), x[3]^g4];
            end, function(x, y)
                return (x{[2,3]} = y{[2,3]} and y[1] in [x[1]-x[3], x[1]+x[3]])
                    or x[3] <> y[3] and y[1] = x[1] + x[2]*y[2]*x[3]^2;
            end, true);
    end])[1]());

# The Gewirtz graph with v=56, k=10, lm=0, mu=2.
BindGlobal("GewirtzGraph", Graph(MathieuGroup(21), [[1,2,3,7,10,20]],
                                    OnSets, DisjointSets));

# The strongly regular Witt graph with v=77, k=16, lm=0, mu=4.
BindGlobal("WittStronglyRegularGraph", Graph(MathieuGroup(22),
                                    [[1,2,3,7,10,20]], OnSets, DisjointSets));

# The graph with v=210, k=99, lm=48, mu=45 constructed by M. Klin
BindGlobal("KlinGraph", List([function()
        local G, H, N, V;
        H := Group([(1,2,3,4,5,6), (1,4)]);
        V := Set(List(SymmetricGroup(7), g -> H*g));
        N := Position(V, H*());
        G := EdgeOrbitsGraph(Action(SymmetricGroup(7), V, OnRight),
            List([(3,4,5,6,7), (2,4,6,3,5,7), (3,5,6,7), (2,4,5,6,7,3),
                        (2,3,5,6,7), (2,4,5,6), (2,3,5,6)],
                    g -> [N, Position(V, H*g)]));
        AssignVertexNames(G, V);
        return G;
    end])[1]());

# The cube with intersection array {3, 2, 1; 1, 2, 3}
BindGlobal("CubeGraph", HammingGraph(3, 2));

# The Heawood graph with intersection array {3, 2, 2; 1, 1, 3}.
BindGlobal("HeawoodGraph", DesarguesianPlaneIncidenceGraph(2));

# The icosahedron with intersection array {5, 2, 1; 1, 2, 5}.
BindGlobal("IcosahedronGraph", Graph(DirectProduct(AlternatingGroup(5),
                                                   Group((1, 2))),
                                     [(1,3,5,2,4)], function(p, g)
                                        return (p^g)^((-1)^(6^g));
                                     end, function(x, y)
                                        return Order(x*y) = 3;
                                     end));

# The Sylvester graph with intersection array {5, 4, 2; 1, 1, 4}
BindGlobal("SylvesterGraph", Graph(SymmetricGroup(6),
                    [[1, [[[1,2], [3,4], [5,6]],
                          [[1,3], [2,5], [4,6]],
                          [[1,4], [2,6], [3,5]],
                          [[1,5], [2,4], [3,6]],
                          [[1,6], [2,3], [4,5]]]]],
                    function(x, g)
                        return [x[1]^g,
                            Set(List(x[2], l -> OnSetsSets(l, g)))];
                    end, function(x, y)
                        return x[1] <> y[1] and x[2] <> y[2] and
                            Set([x[1], y[1]]) in Intersection(x[2], y[2])[1];
                    end));

# The Perkel graph with intersection array {6, 5, 2; 1, 1, 3}.
BindGlobal("PerkelGraph", Graph(PSL(2, 19),
                    Elements(Filtered(ConjugacyClassesSubgroups(PSL(2, 19)),
                        x -> Size(x) = 57 and Order(x[1]) = 60)[1]),
                    ConjugateGroup, function(x, y)
                        return Order(Intersection(x, y)) = 10;
                    end, true));

# The Gosset graph with intersection array {27, 10, 1; 1, 10, 27}.
BindGlobal("GossetGraph",
    Graph(DirectProduct(SymmetricGroup(8), SymmetricGroup(2)),
        [[-3,-3,1,1,1,1,1,1]], OnRoots, RootAdjacency));

# The truncated Witt graph with intersection array {15, 14, 12; 1, 1, 9}.
BindGlobal("Witt23Graph", Graph(MathieuGroup(23), [[1,4,8,12,13,19,21,23]],
                                OnSets, DisjointSets));

# The large Witt graph with intersection array {30, 28, 24; 1, 3, 15}.
BindGlobal("Witt24Graph", Graph(MathieuGroup(24), [[1,4,8,12,13,19,21,23]],
                                OnSets, DisjointSets));

# The bipartite graph associated to Higman's design
# with intersection array {50, 49, 36; 1, 14, 50}.
BindGlobal("HigmanGraph", Graph(Stabilizer(MathieuGroup(24), [23, 24], OnSets),
                            [[1,4,8,12,13,19,21,23]], OnSets,
                            function (x, y)
                                return Length(Difference(Intersection(x, y),
                                                         [23, 24])) in [0, 4];
                            end));

# The Coxeter graph with intersection array {3,2,2,1; 1,1,1,2}.
BindGlobal("CoxeterGraph", PolarGraphNOorth(1, 3, 7));

# The doubly truncated Witt graph with intersection array {7,6,4,4; 1,1,1,6}.
BindGlobal("Witt22Graph", Graph(MathieuGroup(22), [[1,2,3,4,5,10,18,21]],
                                OnSets, DisjointSets));

# The dodecahedron with intersection array {3,2,1,1,1; 1,1,1,2,3}.
BindGlobal("DodecahedronGraph", List([function()
        local G, O, act, dp, p1, p2, u, v;
        dp := DirectProduct(AlternatingGroup(5), Group((1, 2)));
        p1 := Projection(dp, 1);
        p2 := Projection(dp, 2);
        act := function(t, g)
            return OnTuples(t{Permuted([1,2], Image(p2, g))}, Image(p1, g));
        end;
        u := [1, 2];
        v := [3, 4];
        O := Arrangements([1..5], 2);
        G := EdgeOrbitsGraph(Action(dp, O, act),
                             [Position(O, u), Position(O, v)]);
        AssignVertexNames(G, O);
        return G;
    end])[1]());

# The Desargues graph with intersection array {3,2,2,1,1; 1,1,2,2,3}.
BindGlobal("DesarguesGraph", DoubledOddGraph(2));

# The Biggs-Smith graph with intersection array {3,2,2,2,1,1,1; 1,1,1,1,1,1,3}.
BindGlobal("BiggsSmithGraph", Graph(PSL(2, 17),
                    Elements(Filtered(ConjugacyClassesSubgroups(PSL(2, 17)),
                        x -> Size(x) = 102 and Order(x[1]) = 24)[1]),
                    ConjugateGroup, function(x, y)
                        return Order(Intersection(x, y)) = 8;
                    end, true));


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

Declare(ImageData, ImageVar, ImageUnk);

Class(ImageUnk, SumsBase, BaseContainer, rec(
    new := (self, dims) >> Checked(IsList(dims) and Length(dims) = 2 and ForAll(dims, IsPosInt),
        SPL(WithBases(self, rec(dimensions := dims, _children := [], dims := self >> self.dimensions)))),
    print := (self, i, is) >> Print("ImageUnk(", self.dims(), ")"),
    codeletShape := self >> let(d := self.dims(), Concat("ImageUnk_", StringInt(d[1]),"x",StringInt(d[2]))),
    fftImage := self >> ApplyFunc(O, TRDFT2D(self.dims()).dims()/self.dims()[2]),
    freqImage := self >> let(lindims := Product(TRDFT2D(self.dims()).dims())/(2*Product(self.dims())),
        fPrecompute(fConst(TComplex, lindims, 1+E(4)))),
    timeImage := self >> O(self.dims()[1], self.dims()[2]),
    randomImage := (self, m, n) >> ImageUnk(m, n),
    toAMat := self >> NullAMat(self.dimensions),
    unknownImage := self >> self
));

Class(ImageData, Mat, rec(
    print := (self, i, is) >> Print("ImageData(", Mat(self.element).dims(), ")"),
    codeletShape := self >> let(d := self.dims(), Concat("ImageData_", StringInt(d[1]),"x",StringInt(d[2]))),
    fftImage := self >> TRDFT2D(self.dims()).compute(self.element),
    freqImage := self >> let(fftRData := 1/Product(self.dims()) * Flat(self.fftImage()),
        fftCxData := List([1..Length(fftRData)/2], i->Complex(fftRData[2*i-1], fftRData[2*i])),
        FData(List(fftCxData, i->TComplex.value(i)))),
    timeImage := self >> self.element,
    randomImage := (self, m, n) >> let(data := List([1..m], i->List([1..n], j->FloatRat(Random([1..1000]/1000)))),
        ImageData(data)),
    unknownImage := self >> ImageUnk(self.dims())
));

Class(ImageVar, SumsBase, BaseContainer, rec(
    new := (self, dims) >> Checked(IsList(dims) and Length(dims) = 2 and ForAll(dims, IsPosInt),
        SPL(WithBases(self, rec(dimensions := dims, _children := [], dims := self >> self.dimensions)))),
    print := (self, i, is) >> Print("ImageVar(", self.dims(), ")"),
    codeletShape := self >> let(d := self.dims(), Concat("ImageVar_", StringInt(d[1]),"x",StringInt(d[2]))),
    fftImage := self >> ApplyFunc(O, TRDFT2D(self.dims()).dims()/self.dims()[2]),
    freqImage := self >> let(lindims := Product(TRDFT2D(self.dims()).dims())/(2*Product(self.dims())),
        type := TArray(TComplex, lindims), d := param(type, "freqImage"), FDataOfs(d, lindims, 0)),
    timeImage := self >> O(self.dims()[1], self.dims()[2]),
    randomImage := (self, m, n) >> ImageVar(m, n),
    toAMat := self >> NullAMat(self.dimensions),
    unknownImage := self >> ImageUnk(self.dims())
));

#F TRConv2D(img)
# For an image
# img := [ [ 1, 2, 3, 4 ],
#          [ 5, 6, 7, 8 ],
#          [ 9, 10, 11, 12 ],
#          [ 13, 14, 15, 16 ] ];
#
# MatSPL(TRConv2D(RealImage(img))) =
#
#[ [ 1, 4, 3, 2, 13, 16, 15, 14, 9, 12, 11, 10, 5, 8, 7, 6 ],
#  [ 2, 1, 4, 3, 14, 13, 16, 15, 10, 9, 12, 11, 6, 5, 8, 7 ],
#  [ 3, 2, 1, 4, 15, 14, 13, 16, 11, 10, 9, 12, 7, 6, 5, 8 ],
#  [ 4, 3, 2, 1, 16, 15, 14, 13, 12, 11, 10, 9, 8, 7, 6, 5 ],
#  [ 5, 8, 7, 6, 1, 4, 3, 2, 13, 16, 15, 14, 9, 12, 11, 10 ],
#  [ 6, 5, 8, 7, 2, 1, 4, 3, 14, 13, 16, 15, 10, 9, 12, 11 ],
#  [ 7, 6, 5, 8, 3, 2, 1, 4, 15, 14, 13, 16, 11, 10, 9, 12 ],
#  [ 8, 7, 6, 5, 4, 3, 2, 1, 16, 15, 14, 13, 12, 11, 10, 9 ],
#  [ 9, 12, 11, 10, 5, 8, 7, 6, 1, 4, 3, 2, 13, 16, 15, 14 ],
#  [ 10, 9, 12, 11, 6, 5, 8, 7, 2, 1, 4, 3, 14, 13, 16, 15 ],
#  [ 11, 10, 9, 12, 7, 6, 5, 8, 3, 2, 1, 4, 15, 14, 13, 16 ],
#  [ 12, 11, 10, 9, 8, 7, 6, 5, 4, 3, 2, 1, 16, 15, 14, 13 ],
#  [ 13, 16, 15, 14, 9, 12, 11, 10, 5, 8, 7, 6, 1, 4, 3, 2 ],
#  [ 14, 13, 16, 15, 10, 9, 12, 11, 6, 5, 8, 7, 2, 1, 4, 3 ],
#  [ 15, 14, 13, 16, 11, 10, 9, 12, 7, 6, 5, 8, 3, 2, 1, 4 ],
#  [ 16, 15, 14, 13, 12, 11, 10, 9, 8, 7, 6, 5, 4, 3, 2, 1 ] ]
#
Class(TRConv2D, TaggedNonTerminal, rec(
    abbrevs := [ img -> [img]],
    dims := self >> self.params[1].dims(),
    isReal := True,
    terminate := self >>
        TIRDFT2D(self.params[1].dims()).terminate() *
        RCDiag(FList(TReal, 1/Product(self.params[1].dims())*Flat(self.params[1].fftImage()))) *
        TRDFT2D(self.params[1].dims()).terminate(),
    normalizedArithCost := (self) >>
        TRDFT2D(self.params[1].dims()).normalizedArithCost() +
        TIRDFT2D(self.params[1].dims()).normalizedArithCost() +
        3 * Rows(TRDFT2D(self.params[1].dims())),
    symTerminate := self >> let(N := self.params[1].dims(),
        imgv := Flat(self.params[1].timeImage()),
        tf := MDDFT(N),
        ti := MDDFT(N, -1),
        d := MatSPL(tf) * imgv,
        t := ti * (1/Product(N))*Diag(d) * tf,
        MatSPL(t)),
    forwardTransform := self >> let(t := TRDFT2D(self.params[1].dims()), tags := self.getTags(),
        When(
            Length(tags) >= 1 and ObjId(tags[1]) = paradigms.vector.AVecReg, let(n := t.dims()[1], v := tags[1].v,
                TCompose([TPrm(fTensor(fId(n/(2*v)), L(2*v, 2))), t]).withTags(tags)),
            t.withTags(tags))),

    HashId := self >> let(conv := self.params[1].dims(), When(IsBound(self.tags), Concatenation(conv, self.tags), conv)),

    hashAs := meth(self)
        local conv;
        conv := Copy(self);
        conv.params[1] := self.params[1].unknownImage();
        return conv;
    end
));

#F 2D RConv Rule
NewRulesFor(TRConv2D, rec(
    TRConv2D_TRDFT2D_tSPL := rec(
        switch := true,
        applicable := (self, t) >> true,
        children := (self, t) >>
            [[
                TCompose([
                    TIRDFT2D(t.params[1].dims()),
                    TRCDiag(fPrecompute(t.params[1].freqImage())),
                    TRDFT2D(t.params[1].dims())
                ]).withTags(t.getTags())
            ]],
        apply := (self, t, C, Nonterms) >> C[1]
    )
));

#Class(TRCorr2D, TaggedNonTerminal, rec(
#    abbrevs := [ img -> [img]],
#    dims := self >> self.params[1].dims(),
#    isReal := True,
#    terminate := self >> let(tf := TRDFT2D(self.params[1].dims()), d := 1/Product(self.params[1].dims()) * Flat(tf.compute(self.params[1].element)),
#        TIRDFT2D(self.params[1].dims()).terminate() *
#        RCDiag(FList(TReal, List([1..Length(d)], j->When(IsOddInt(j), d[j], -d[j])))) *
#        tf.terminate(),
#    normalizedArithCost := (self) >>
#        TRDFT2D(self.params[1].dims()).normalizedArithCost() +
#        TIRDFT2D(self.params[1].dims()).normalizedArithCost() +
#        3 * Rows(TRDFT2D(self.params[1].dims()))),
#    symTerminate := self >> let(N := self.params[1].dims(),
#        img := self.params[1].element,
#        rimg := Reversed(List(img, Reversed)),
#        imgv := Flat(rimg),
#        tf := MDDFT(N),
#        ti := MDDFT(N, -1),
#        d := MatSPL(tf) * imgv,
#        t := ti * (1/Product(N))*Diag(d) * tf,
#        MatSPL(t))
#));


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

################################################################################
##
#F pseudounitary_sort(<list>,<list>,<list>) . . . . sorts S and T to give pseudo
##. . . . . . . . . . . . . . .  . . . . . . .unitary data. FPdims are computed.
##
InstallGlobalFunction(pseudounitary_sort, function(S,T,Simples)
  local FPdim,FPdimC,x,r,i,FPRow,FPRow_idx,j,is_real,is_pos;
  #
  # look along the diagonal for 1's and check that the corresponding row is real
  # and positive
  FPRow:=[];
  r := Size(Simples);
  for i in [1..r] do
    if S[i][i] = 1 then
      is_real := true;
      is_pos := true;
      for j in [1..r] do
        if ImaginaryPart(S[i][j]) <> 0 then
          is_real := false;
          break;
        fi;
        if S[i][j] <= 0 then
          is_pos := false;
          break;
        fi;
      od;
      if is_real and is_pos then
        Add(FPRow,ShallowCopy(S[i]));
      fi;;
    fi;
  od;

  # find out which row is largest
  Sort(FPRow);
  FPRow:=Reversed(FPRow);
  FPRow_idx:=Position(S,FPRow[1]);

  # switch 1 with FPRow_idx
  if FPRow_idx <> 1 then
    S{[1,FPRow_idx]}:=S{[FPRow_idx,1]};
    S:=TransposedMatMutable(S);
    S{[1,FPRow_idx]}:=S{[FPRow_idx,1]};
    S:=TransposedMatMutable(S);
    Simples{[1,FPRow_idx]}:=Simples{[FPRow_idx,1]};
    T{[1,FPRow_idx]}:=T{[FPRow_idx,1]};
  fi;

  # get the FPdimension
  FPdim:=ShallowCopy(S[1]);
  FPdimC:=Sum(List(FPdim,x->x^2));

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

################################################################################
##
#F dimension_sort(<list>,<list>,<list>,<list>) . . . . sorts data by increasing
#                                               dimension.
##
InstallGlobalFunction(dimension_sort, function(S,T,Simples,FPdim)
  local made_switch, x, r;
  made_switch := true;
  r:=Size(FPdim);
  while made_switch do
    made_switch := false;
    for x in [3..r] do
      if FPdim[x] < FPdim[x-1] then
        S{[x,x-1]} := S{[x-1,x]};
        S:=TransposedMatMutable(S);
        S{[x,x-1]} := S{[x-1,x]};
        S:=TransposedMatMutable(S);
        T{[x,x-1]} := T{[x-1,x]};
        FPdim{[x,x-1]} := FPdim{[x-1,x]};
        Simples{[x,x-1]} := Simples{[x-1,x]};
        made_switch := true;
      fi;
    od;
  od;
  return [Simples,S,T,FPdim];
end);
#E pseudounitary_sort.gi . . . . . . . . . . . . . . . . . . . . . . . ends here