# 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))
#));


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

Class(IdFunc, DiagFunc, rec(
    range := self >> TInt
));

#F fConst(<N>, <c>) - constant diagonal function, <N> values of <c>
#F
Class(idConst, IdFunc, rec(
#    def := (N, c) -> Checked(IsPosInt0(N), rec(size:=N)),
    def := (N, c) -> rec(size:=N),
    inline := true,
    lambda := self >> let(i:=Ind(self.size), Lambda(i, self.params[2])),
    isReal := self >> IsRealNumber(self.params[2]),
    domain := self >> self.params[1],
));

Class(idId, IdFunc, rec(
    def := size -> rec(size := size),
    lambda := self >> let(i := Ind(self.size), Lambda(i,i)),
    #inverse := i->i,
    transpose := self >> self,
    domain := self >> self.params[1],
));

#NOTE Derive the idTensor from diagTensor
Class(idTensor, fTensorBase, rec(
    print := FuncClassOper.print,
#    range := self >> UnifyTypes(List(self.children(), x->x.range())),
    combine_op := (self, jv, split, f, g) >> f.relaxed_at(jv, split[1]) * g.relaxed_at(jv, split[2]),

    updateRange := self >> UnifyTypes(List(self.children(), x->x.range())),
    range       := self >> self.updateRange(),
#    combine_op := (self, split, F, G) >> F.at(split[1]) * G.at(split[2])
    # idTensor is something else again ???
#    combine_op := (self, split, F, G) >> self.child(2).domain() * F.at(split[1]) + G.at(split[2])
));

#Class(idfTensor, fTensorBase, rec(
#    print := FuncClassOper.print,
#    updateRange := self >> UnifyTypes(List(self.children(), x->x.range())),
#    combine_op := (self, split, F, G) >> self.child(2).domain() * F.at(split[1]) + G.at(split[2])
#));
#

Class(idCompose, fCompose);

Class(Id, Diag, rec(
  toAMat := self >> IdentityMatAMat(self.element.domain()),
  domain := self >> self.element.domain()
));


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

Declare(BaseOverlap);

# BaseOverlap
# subclasses should define these fields:
#    _transpose_class
#
Class(BaseOverlap, BaseOperation, rec(

    new := (self, isize, overlap, spls) >>
       self._new(isize,overlap,spls),

    _new := meth(self, isize, overlap, spls)
        local result;
    if not IsList(spls) then spls := [spls]; fi;
    #Constraint(IsInt(overlap));
    #Constraint(IsInt(isize));
        DoForAll(spls, s -> Constraint(IsSPL(s)));
    result := WithBases(self, rec(isize := isize,
                            overlap := overlap,
                    _children := spls));
    result.dimensions := result.dims();
    return SPL(result);
    end,
    #-----------------------------------------------------------------------
    rChildren := self >> Concat([self.isize, self.overlap, self._children], When(IsBound(self._setDims), [self._setDims],[])),
    rSetChild := rSetChildFields("isize", "overlap", "_children", "_setDims"),

    #-----------------------------------------------------------------------
    isPermutation := self >> false,
    #-----------------------------------------------------------------------
    transpose := self >> CopyFields(self,
	self._transpose_class._new(
            self.isize,
            self.overlap,
            List(self._children, c -> c.transpose())
	)
    ),
    conjTranspose := self >> CopyFields(self,
	self._transpose_class._new(
            self.isize,
            self.overlap,
            List(self._children, c -> c.conjTranspose())
	)
    ),
    #----------------------------- Helpers ----------------------------------

    # Create SparseSPL list for AMatSPL conversion of type "rowDirectSum" and
    # "rowtensor" that represent a row overlapped direct sum of identity
    # matrices of sizes given in list N with overlap v.
    _rowoverlap := function(N, v)
        local i,j,k,l,min,L;
	L:=[];
	i:=1;
	j:=1;
	for k in [1..Length(N)] do
            for l in [1..N[k]] do
                Add(L, [i, j, 1]);
		i := i+1;
		j := j+1;
	    od;
            j := j-v;
        od;
        # Make sure there are no negative indices
	min := Minimum(List([1..Length(L)],i->L[i][2]));
	if min < 1 then
            for k in [1..Length(L)] do
                L[k][2] := L[k][2] + 1 - min;
            od;
	fi;
	return L;
   end,

   # Create SparseSPL list for AMatSPL conversion of type "colDirectSum" and
   # "coltensor" that represent a column overlapped direct sum of identity
   # matrices of sizes given in list N with overlap v.
   _coloverlap := function(N, v)
       local i,j,k,L;
       L := BaseOverlap._rowoverlap(N, v);
       for k in [1..Length(L)] do
           L[k]{[1..2]}:=Reversed(L[k]{[1..2]});
       od;
       return L;
   end,

   ovDim := (ov, dims) ->
       FoldL(dims,
         (p, dim) -> let(dd := p[1] + dim - ov,
                   [ dd, Min2(p[2], dd-dim+1), Max2(p[3], dd) ]),
         [ov, 1, 1]),

   ovDimList := (ov, dims) -> Drop(
       ScanL(dims,
         (p, dim) -> let(dd := p[1] + dim - ov,
                   [ dd, Min2(p[2], dd-dim+1), Max2(p[3], dd) ]),
         [ov, 1, 1]),
       1),

   spans := (ov, dims) -> let(
       dl := BaseOverlap.ovDimList(ov,dims),
       ofs := 1 - dl[1][2],
       List([1..Length(dims)], i -> [ofs+dl[i][1]-dims[i]+1, ofs+dl[i][1]]))
));


################################################################################
##
#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


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

############################################################################
##
#F  IndicesIrreducibleSolubleMatrixGroups(<n>, <q>, <d>)
##
##  see the IRREDSOL manual
##
InstallGlobalFunction(IndicesIrreducibleSolubleMatrixGroups,
    function( n, q, d )

        local data, inds, perm, i, k, l, max;

        if not IsPosInt(n) or not IsPosInt(d) or not IsPosInt(q)
                or not IsPPowerInt(q) then
            Error("n, q, and d must be positive integers, ",
                "q must be a prime power");
        fi;
        if n mod d <> 0 then
            return [];
        fi;

        LoadAbsolutelyIrreducibleSolubleGroupData(n/d, q^d);

        if d < n then
            data := IRREDSOL_DATA.GROUPS[n/d][q^d];
            inds := Filtered([1..Length(data)], i -> IsBound(data[i]));
                # as a last resort, redundant groups can be removed
        else
            inds := [1..Length(IRREDSOL_DATA.GROUPS_DIM1 [q^d])];
            if d > 1 then
                if IRREDSOL_DATA.GROUPS_DIM1 [q^d][1] = 1 then
                    RemoveSet(inds, 1); # rewriting the trivial group over a smaller field yields a reducible group
                fi;
            fi;
        fi;
        perm := IRREDSOL_DATA.GAL_PERM[n/d][q^d]^LogInt(q, SmallestRootInt(q));
        # permutation of a generator of Gal(GF(q^d)/GF(q)) on inds

        if perm <> () then
            i := PositionSorted(inds, SmallestMovedPoint(perm));
            max := LargestMovedPoint(perm);
            while i <= Length(inds) do
                k := inds[i];
                if k > max then
                    break;
                fi;
                l := k^perm;
                while l <> k do
                    RemoveSet(inds, l);
                    l := l^perm;
                od;
                i := i + 1;
            od;
        fi;
        MakeImmutable(inds);
        return inds;
    end);

############################################################################
##
#F  PermCanonicalIndexIrreducibleSolubleMatrixGroup(<n>, <q>, <d>, <k>
##
InstallGlobalFunction(PermCanonicalIndexIrreducibleSolubleMatrixGroup,
    function( n, q, d, k )

        local perm, pow, l, orb, min, powmin;

        LoadAbsolutelyIrreducibleSolubleGroupData(n/d, q^d);

        perm := IRREDSOL_DATA.GAL_PERM[n/d][q^d]^LogInt(q, SmallestRootInt(q));

        # permutation of a generator of Gal(GF(q^d)/GF(q)) on parameters

        powmin := 0;
        l := k^perm; # check whether k is least in orbit
        pow := 1;
        min := k;
        orb := [k];
        while l <> k do
            Add(orb, l);
            # we have l = k^(perm^pow)
            if l < k then
                powmin := pow;
                min := l;
            fi;
            l := l^perm;
            pow := pow + 1;
        od;
        return rec(perm := perm, pow := powmin, orb := orb, min := min);
    end);

############################################################################
##
#F  IrreducibleSolubleMatrixGroup(<n>, <q>, <d>, <k>)
##
##  see the IRREDSOL manual
##
InstallGlobalFunction(IrreducibleSolubleMatrixGroup,
    function( n, q, d, k )

        local perm, l, n0, q0, p, o, i, bas, mat, C, c, gddesc, desc, pres, gens, pcgs, grp, hom;

        if not IsPosInt(n) or not IsPosInt(d) or not IsPosInt(q)
                or not IsPPowerInt(q)  or not IsPosInt(k) or not n mod d = 0 then
            Error("n, q, d, and k must be positive integers, q must be a prime power ",
                "and d must divide n");
        fi;

        n0 := n;
        q0 := q;
        n := n0/d;
        q := q0^d;
        p := SmallestRootInt(q0);

        LoadAbsolutelyIrreducibleSolubleGroupData(n, q);

        if d > 1 then # rewrite as matrix group over subfield

            # switch to larger field

            # compute the permutation of a generator of Gal(GF(q)/GF(q0))
            # on the ccls of absolutely irreducible subgroups of GL(n,q)

            perm := IRREDSOL_DATA.GAL_PERM[n][q]^LogInt(q0, p);

            # check if k is a valid paramter, i. e., least in orbit

            l := k^perm;
            while l <> k do
                if l < k then
                    Error("inadmissible value for k");
                fi;
                l := l^perm;
            od;

            Info(InfoIrredsol, 3, "Constructing irreducible group with id ",
                [n0, q0, d, k]);

            bas := CanonicalBasis(AsVectorSpace(GF(q0), GF(q)));
                      # it is important to use CanonicalBasis here, in order to be sure
                      # that the result is the same when called multiple times
        fi;
        if n = 1 then
            if not IsBound(IRREDSOL_DATA.GROUPS_DIM1[q][k]) then
                Error("inadmissible value for k");
            fi;
            o := IRREDSOL_DATA.GROUPS_DIM1[q][k][1];

            mat := [[Z(q)^((q-1)/o)]];
            if d > 1 then
                mat := BlownUpMat(bas, mat);
            fi;
            grp := GroupWithGenerators([mat], IdentityMat(n0, GF(q0)));
            SetSize(grp, o);
            SetIsCyclic(grp, true);
            i := PositionSet(DivisorsInt(LogInt(q, p)), LogInt(q0, p));
            if d = 1 then
                SetMinimalBlockDimensionOfMatrixGroup(grp,  1);
            else
                SetMinimalBlockDimensionOfMatrixGroup(grp, IRREDSOL_DATA.GROUPS_DIM1[q][k][2][i]);
            fi;

            if o = 1 then
                hom := IdentityMapping(grp);
            else
                Assert(1, Length(IRREDSOL_DATA.GUARDIANS[1][q]) = 1);
                C := IRREDSOL_DATA.GUARDIANS[1][q][1];
                Assert(1, Length(MinimalGeneratingSet(C)) = 1);
                c := MinimalGeneratingSet(C)[1]^((q-1)/o);
                Assert(1, Order(c) = o);
                hom := GroupHomomorphismByImagesNC(SubgroupNC(C, [c]), grp, [c], [mat]);
                SetIsBijective(hom, true);
            fi;
        else
            if not IsBound(IRREDSOL_DATA.GROUPS[n][q][k]) then
                Error("inadmissible value for k");
            fi;

            # construct group and isomorphic pc group

            desc  := IRREDSOL_DATA.GROUPS[n][q][k];
            gddesc := IRREDSOL_DATA.GUARDIANS[n][q][desc[1]];
            pres := gddesc[3];

            pcgs := CanonicalPcgsByNumber(FamilyPcgs(Source(pres)), desc[2]);
            gens := List(pcgs, x -> ImageElm(pres, x));
            if d > 1 then
                gens := List(gens, x -> BlownUpMat(bas, x));
            fi;

            grp := GroupWithGenerators(gens, IdentityMat(n0, GF(q0)));
            SetSize( grp, Product(RelativeOrders(pcgs)) );

            hom := GroupGeneralMappingByImagesNC(GroupOfPcgs(pcgs), grp,
                pcgs, gens);
            SetIsGroupHomomorphism(hom, true);
            SetIsBijective(hom, true);

            # look up minimal block dimension
            if d = 1 then
                SetMinimalBlockDimensionOfMatrixGroup(grp, gddesc[4]);
            else
                i := PositionSet(DivisorsInt(LogInt(q, p)), LogInt(q0, p));
                SetMinimalBlockDimensionOfMatrixGroup(grp, IRREDSOL_DATA.GROUPS[n][q][k][3][i]);
            fi;
        fi;

        SetIdIrreducibleSolubleMatrixGroup(grp, [n0, q0, d, k]);
        SetFieldOfMatrixGroup(grp, GF(q0));
        SetDefaultFieldOfMatrixGroup(grp, GF(q0));
        SetTraceField(grp, GF(q0));
        SetConjugatingMatTraceField(grp, One(grp));
        SetRepresentationIsomorphism(grp, hom);
        SetIsPrimitiveMatrixGroup(grp, MinimalBlockDimensionOfMatrixGroup(grp) = n);
        SetIsIrreducibleMatrixGroup(grp, true);
        SetIsAbsolutelyIrreducibleMatrixGroup(grp, d = 1);
        SetIsSolvableGroup(grp, true);
        return grp;
    end);

############################################################################
##
#F  IndicesMaximalAbsolutelyIrreducibleSolubleMatrixGroups(<n>, <q>)
##
##  see the IRREDSOL manual
##
InstallGlobalFunction(IndicesMaximalAbsolutelyIrreducibleSolubleMatrixGroups,
    function( n, q )

        if not IsPosInt(n) or not IsPPowerInt(q)  then
            Error("n and q must be positive integers and q must be a prime power");
        fi;
        LoadAbsolutelyIrreducibleSolubleGroupData(n, q);
        if n = 1 then
            return Immutable([Length(IRREDSOL_DATA.GROUPS_DIM1 [q])]);
        else
            return IRREDSOL_DATA.MAX[n][q];
        fi;
    end);

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


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

sys:=NilpotentChv(ChevalleyAdj("F",4,GF(2)),[[1,1],[2,1]]);
Print("Created NilpotentChv ",sys,"\n");
Print("\t[",IsNilpotentChv(sys)=true,"] IsNilpotentChv(sys)=true\n");


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

Class(PrunedDFT, TaggedNonTerminal, rec(
    abbrevs := [
        (n,blk,pat) -> Checked(IsPosIntSym(n), IsPosIntSym(blk), IsList(pat),
            AnySyms(n,blk) or (IsInt(_unwrap(n)/_unwrap(blk)) and ForAll(pat, i->IsInt(i) and i < n/blk)),
            [_unwrap(n), 1, _unwrap(blk), pat]),
        (n,k,blk,pat) -> Checked(IsPosIntSym(n), IsIntSym(k), IsPosIntSym(blk), IsList(pat),
            AnySyms(n,k) or Gcd(_unwrap(n),_unwrap(k))=1,
            AnySyms(n,blk) or (IsInt(_unwrap(n)/_unwrap(blk)) and ForAll(pat, i->IsInt(i) and i < n/blk)),
            [_unwrap(n), When(AnySyms(n,k), k, k mod _unwrap(n)), _unwrap(blk), pat])
        ],

    dims := self >> let(
        size := self.params[1],
        d := [size, self.params[3]*Length(self.params[4])],
        When(self.transposed, [d[2], d[1]], d)
    ),

    terminate := self >> let(
        size := self.params[1], blk := self.params[3], pat := self.params[4],
        res := DFT(size, self.params[2]).terminate() *
               Tensor(Mat(List(pat, i->BasisVec(size/blk, i))).transpose(), I(blk)).terminate(),
        When(self.transposed, res.transpose(), res)
    ),

    isReal    := self >> false,
    normalizedArithCost := self >> let(n := self.params[1], IntDouble(5 * n * d_log(n) / d_log(2))),
    TType := T_Complex(T_Real(64))
));

Class(PrunedIDFT, TaggedNonTerminal, rec(
    abbrevs := [
        (n,blk,pat) -> Checked(IsPosIntSym(n), IsPosIntSym(blk), IsList(pat),
            AnySyms(n,blk) or (IsInt(_unwrap(n)/_unwrap(blk)) and ForAll(pat, i->IsInt(i) and i < n/blk)),
            [_unwrap(n), 1, _unwrap(blk), pat]),
        (n,k,blk,pat) -> Checked(IsPosIntSym(n), IsIntSym(k), IsPosIntSym(blk), IsList(pat),
            AnySyms(n,k) or Gcd(_unwrap(n),_unwrap(k))=1,
            AnySyms(n,blk) or (IsInt(_unwrap(n)/_unwrap(blk)) and ForAll(pat, i->IsInt(i) and i < n/blk)),
            [_unwrap(n), When(AnySyms(n,k), k, k mod _unwrap(n)), _unwrap(blk), pat])
        ],

    dims := self >> let(
        size := self.params[1],
        d := [size, self.params[3]*Length(self.params[4])],
        When(not self.transposed, [d[2], d[1]], d)
    ),

    terminate := self >> let(
        size := self.params[1], blk := self.params[3], pat := self.params[4],
        res := DFT(size, self.params[2]).terminate() *
               Tensor(Mat(List(pat, i->BasisVec(size/blk, i))).transpose(), I(blk)).terminate(),
        When(not self.transposed, res.transpose(), res)
    ),

    isReal    := self >> false,
    normalizedArithCost := self >> let(n := self.params[1], IntDouble(5 * n * d_log(n) / d_log(2))),
    TType := T_Complex(T_Real(64))
));

_pruned_children := function(m, n, scatpat, pdft)
    local pdfts, scatpats, iterparts, uspats, uuspats, uspats, spats;
    spats := Map([0..m-1], i->List(Intersection(scatpat, i+m*[0..n-1]), j->j));
    uspats := Map([0..Length(spats)-1], i->(spats[i+1]-i)/m);
    uuspats := Set(uspats);

    # partition iterations into unique patterns
    iterparts := List([1..Length(uuspats)], j->Filtered([1..m], i->uspats[i] = uuspats[j])-1);
    Sort(iterparts);

    scatpats := List(iterparts, lst->uspats[lst[1]+1]);
    pdfts := Map(scatpats, sp->pdft(n, sp));
    return pdfts;
end;

_ctpr_applicable := function(m, n, scatpat)
    local spats, gpats, strides;
    spats := Map([0..m-1], i->List(Intersection(scatpat, i+m*[0..n-1]), j->j));
    gpats := Map(spats, lst->Map(lst, i->Position(scatpat, i)-1));
    strides := Set(Flat(Map(gpats, lst->Map([1..Length(lst)-1], j->lst[j+1]-lst[j]))));
    return ForAll(spats, i->i<>[]) and  (Length(strides) in [0, 1]);
end;

_build_basef := lst -> When(lst = lst[1] + [0..Length(lst)-1], let(i := Ind(Length(lst)), Lambda(i, lst[1] + i)), FData(Map(lst, V)));

_build_stack := function(m, n, scatpat, pdfts, NI, gsop, istck, stck, cmpse)
    local stack, isu, is, itervars, gatscats, lbds, lbdvars, itercounts, iterbasesf, iterbases, iterparts, uuspats, uspats, bases, strides, stride, spats, gpats;
    spats := Map([0..m-1], i->List(Intersection(scatpat, i+m*[0..n-1]), j->j));
    gpats := Map(spats, lst->Map(lst, i->Position(scatpat, i)-1));
    #When(ForAny(spats, i->i=[]), Error("need at least one element per child DFT"));
    strides := Set(Flat(Map(gpats, lst->Map([1..Length(lst)-1], j->lst[j+1]-lst[j]))));
    stride := When(Length(strides) = 1, strides[1], 1);
    bases := Map(gpats, i->i[1]);

    uspats := Map([0..Length(spats)-1], i->(spats[i+1]-i)/m);
    uuspats := Set(uspats);

    iterparts := List([1..Length(uuspats)], j->Filtered([1..m], i->uspats[i] = uuspats[j])-1);
    Sort(iterparts);
    iterbases := Map(iterparts, lst->Map(lst, i->bases[i+1]));
    iterbasesf := List(iterbases, _build_basef);
    itercounts := List(iterparts, Length);
    itervars := List(iterparts, lst->Ind(Length(lst)));
    lbdvars := List(iterparts, lst->Ind(Length(gpats[lst[1]+1])));
    lbds := List([1..Length(itervars)], i->Lambda(lbdvars[i], stride*lbdvars[i]+iterbasesf[i].at(itervars[i])).setRange(NI));
    gatscats := List(lbds, i->ApplyFunc(gsop, [i]));

    is := List([1..Length(itervars)], i->ApplyFunc(istck, [itervars[i], cmpse(pdfts[i], gatscats[i])]));
    isu := Map([1..Length(is)], i->When(itervars[i].range=1, is[i].unroll().child(1), is[i]));
    stack := When(Length(isu) = 1, isu[1], ApplyFunc(stck, isu));
    return stack;
end;

NewRulesFor(PrunedDFT, rec(
    PrunedDFT_base := rec(
       forTransposition := false,
       maxSize := 256,
       applicable := (self, nt) >> not nt.hasTags() and nt.params[1] <= self.maxSize and nt.params[3] = 1,
       children := nt -> [[DFT(nt.params[1], nt.params[2])]],
       apply := (nt, C, cnt) -> let(size := nt.params[1], blk := nt.params[3], pat := nt.params[4],
            C[1] * Tensor(Mat(List(pat, i->BasisVec(size/blk, i))).transpose(), I(blk)).terminate())
    ),
    PrunedDFT_DFT := rec(
       forTransposition := true,
       applicable := (self, nt) >> nt.params[1] = nt.params[3] and nt.params[4] = [0],
       children := nt -> [[ DFT(nt.params[1], nt.params[2]).withTags(nt.getTags()) ]],
       apply := (nt, C, cnt) -> C[1]
    ),
    PrunedDFT_CT := rec(
       forTransposition := true,
       applicable := (self, nt) >> nt.params[1] > 2
            and not nt.hasTags()
            and not IsPrime(nt.params[1])
            and nt.params[3] > 1,
        children  := nt -> Map2(Filtered(DivisorPairs(nt.params[1]), (l) -> IsInt(nt.params[3]/l[1])),
            (m,n) -> [ DFT(m, nt.params[2] mod m), PrunedDFT(n, nt.params[2] mod n, nt.params[3]/m, nt.params[4]) ]
        ),
        apply := (nt, C, cnt) -> let(mn := nt.params[1], m := Rows(C[1]), n := Rows(C[2]),
            Tensor(C[1], I(n)) *
            Diag(fPrecompute(Tw1(mn, n, nt.params[2]))) *
            L(mn, m) * Tensor(C[2], I(m))
        )),
    PrunedDFT_CT_rec_block := rec(
       forTransposition := true,
       applicable := (self, nt) >> nt.params[1] > 2
            and not nt.hasTags()
            and not IsPrime(nt.params[1])
            and nt.params[3] = 1
            and Last(nt.params[4])+1-nt.params[4][1] = Length(Set(nt.params[4]))
            and ForAny(Map2(DivisorPairs(nt.params[1]), (m,n)->_ctpr_applicable(m, n, nt.params[4])), i->i),
       children := (nt) -> Filtered(Map2(DivisorPairs(nt.params[1]), (m, n) -> [ DFT(m, nt.params[2] mod m) ]::
                              _pruned_children(m, n, nt.params[4], (r, sp) -> PrunedDFT(r, nt.params[2] mod n, nt.params[3], sp))),
                              lst -> ForAll(Filtered(lst, i->ObjId(i) = PrunedDFT), j->j.params[4] <> [])),
        apply := (nt, C, cnt) -> let(mn := nt.params[1], m := Rows(C[1]), n := Rows(C[2]),
            Tensor(C[1], I(n)) *
            Diag(fPrecompute(Tw1(mn, n, nt.params[2]))) *
            _build_stack(m, n, nt.params[4], Drop(C, 1), nt.dims()[2], Gath, IterVStack, VStack, (a,b)->a*b)
        )
    )
));

NewRulesFor(PrunedIDFT, rec(
    PrunedIDFT_base := rec(
       forTransposition := false,
       maxSize :=256,
       applicable := (self, nt) >> not nt.hasTags() and nt.params[1] <= self.maxSize and nt.params[3] = 1,
       children := nt -> [[DFT(nt.params[1], nt.params[2])]],
       apply := (nt, C, cnt) -> let(size := nt.params[1], blk := nt.params[3], pat := nt.params[4],
            Tensor(Mat(List(pat, i->BasisVec(size/blk, i))) * C[1], I(blk)).terminate())
    ),
    PrunedIDFT_CT_rec_block := rec(
       forTransposition := true,
       applicable := (self, nt) >> nt.params[1] > 2
            and not nt.hasTags()
            and not IsPrime(nt.params[1])
            and nt.params[3] = 1
            and Last(nt.params[4])+1-nt.params[4][1] = Length(Set(nt.params[4]))
            and ForAny(Map2(DivisorPairs(nt.params[1]), (m,n)->_ctpr_applicable(m, n, nt.params[4])), i->i),
       children := (nt) -> Filtered(Map2(DivisorPairs(nt.params[1]), (n, m) ->
                              _pruned_children(m, n, nt.params[4], (r, sp) -> PrunedIDFT(r, nt.params[2] mod n, nt.params[3], sp)) ::
                              [ DFT(m, nt.params[2] mod m) ]),
                              lst -> ForAll(Filtered(lst, i->ObjId(i) = PrunedIDFT), j->j.params[4] <> [])),
        apply := (nt, C, cnt) -> let(mn := nt.params[1], m := Rows(Last(C)), n := Cols(C[1]),
            _build_stack(m, n, nt.params[4], DropLast(C, 1), nt.dims()[1], Scat, IterHStack1, HStack1, (a,b)->b*a) *
            Diag(fPrecompute(Tw1(mn, n, nt.params[2]))) *
            Tensor(Last(C), I(n))
        )
    )
));

Class(IOPrunedDFT, TaggedNonTerminal, rec(
    abbrevs := [
        (n,oblk,opat,iblk,ipat) -> Checked(IsPosIntSym(n), IsPosIntSym(oblk), IsList(opat), IsPosIntSym(iblk), IsList(ipat),
            AnySyms(n,iblk,oblk) or (IsInt(_unwrap(n)/_unwrap(iblk)) and IsInt(_unwrap(n)/_unwrap(oblk)) and
                ForAll(ipat, i->IsInt(i) and i < n/iblk) and ForAll(opat, i->IsInt(i) and i < n/oblk)),
            [_unwrap(n), 1, _unwrap(oblk), opat, _unwrap(iblk), ipat]),

        (n,k,oblk,opat,iblk,ipat) -> Checked(IsPosIntSym(n), IsIntSym(k), IsPosIntSym(oblk), IsList(opat), IsPosIntSym(iblk), IsList(ipat),
            AnySyms(n,k) or Gcd(_unwrap(n),_unwrap(k))=1,
            AnySyms(n,iblk,oblk) or (IsInt(_unwrap(n)/_unwrap(iblk)) and IsInt(_unwrap(n)/_unwrap(oblk)) and
                ForAll(ipat, i->IsInt(i) and i < n/iblk) and ForAll(opat, i->IsInt(i) and i < n/oblk)),
            [_unwrap(n), When(AnySyms(n,k), k, k mod _unwrap(n)), _unwrap(oblk), opat, _unwrap(iblk), ipat])
        ],
    dims      := self >> [self.params[3]*Length(self.params[4]), self.params[5]*Length(self.params[6])],
    terminate := self >> let(size := self.params[1],
        oblk := self.params[3], opat := self.params[4], iblk := self.params[5], ipat := self.params[6],
        Tensor(Mat(List(opat, i->BasisVec(size/oblk, i))), I(oblk)).terminate() *
        DFT(size, self.params[2]).terminate() *
        Tensor(Mat(List(ipat, i->BasisVec(size/iblk, i))).transpose(), I(iblk)).terminate()),
    isReal    := self >> false,
    normalizedArithCost := self >> let(n := self.params[1], IntDouble(5 * n * d_log(n) / d_log(2))),
    TType := T_Complex(T_Real(64))
));

NewRulesFor(IOPrunedDFT, rec(
    IOPrunedDFT_base := rec(
       forTransposition := true,
       maxSize := 16,
       applicable := (self, nt) >> not nt.hasTags() and nt.params[1] <= self.maxSize and nt.params[3] = 1 and nt.params[5] = 1,
       children := nt -> [[DFT(nt.params[1], nt.params[2])]],
       apply := (nt, C, cnt) -> let(size := nt.params[1], oblk := nt.params[3], opat := nt.params[4], iblk := nt.params[5], ipat := nt.params[6],
            Tensor(Mat(List(opat, i->BasisVec(size/oblk, i))), I(oblk)).terminate() *
            C[1] *
            Tensor(Mat(List(ipat, i->BasisVec(size/iblk, i))).transpose(), I(iblk)).terminate())
    ),

    IOPrunedDFT__PrunedDFT := rec(
       forTransposition := true,
       applicable := (self, nt) >> nt.params[1] = nt.params[3] and nt.params[4] = [0],
       children := nt -> [[ PrunedDFT(nt.params[1], nt.params[2], nt.params[5], nt.params[6]).withTags(nt.getTags()) ]],
       apply := (nt, C, cnt) -> C[1]
    ),

    IOPrunedDFT__PrunedDFT_T := rec(
       forTransposition := true,
       applicable := (self, nt) >> nt.params[1] = nt.params[5] and nt.params[6] = [0],
       children := nt -> [[ PrunedDFT(nt.params[1], nt.params[2], nt.params[3], nt.params[4]).transpose().withTags(nt.getTags()) ]],
       apply := (nt, C, cnt) -> C[1]
    ),

    IOPrunedDFT__Gath_PrunedDFT := rec(
       forTransposition := true,
       maxSize := 16,
       applicable := (self, nt) >> not nt.hasTags() and nt.params[1] <= self.maxSize and
           ((nt.params[3] = 1 and not (nt.params[5] = 1)) or (nt.params[3] * nt.params[5] < nt.params[1])),
       children := nt -> [[ PrunedDFT(nt.params[1], nt.params[2], nt.params[5], nt.params[6]) ]],
       apply := (nt, C, cnt) -> let(size := nt.params[1], oblk := nt.params[3], opat := nt.params[4], iblk := nt.params[5], ipat := nt.params[6],
            Tensor(Mat(List(opat, i->BasisVec(size/oblk, i))), I(oblk)).terminate() * C[1])
    ),

    IOPrunedDFT__PrunedDFT_T_Scat := rec(
       forTransposition := true,
       maxSize := 16,
       applicable := (self, nt) >> not nt.hasTags() and nt.params[1] <= self.maxSize and
           (((not nt.params[3] = 1) and nt.params[5] = 1) or(nt.params[3] * nt.params[5] < nt.params[1])),
       children := nt -> [[ PrunedDFT(nt.params[1], nt.params[2], nt.params[3], nt.params[4]).transpose() ]],
       apply := (nt, C, cnt) -> let(size := nt.params[1], oblk := nt.params[3], opat := nt.params[4], iblk := nt.params[5], ipat := nt.params[6],
            C[1] * Tensor(Mat(List(ipat, i->BasisVec(size/iblk, i))).transpose(), I(iblk)).terminate())
    ),

    IOPrunedDFT_CT := rec(
       forTransposition := true,
       applicable := (self, nt) >> nt.params[1] > 2 and nt.params[3] * nt.params[5] >= nt.params[1]
            and not nt.hasTags()
            and not IsPrime(nt.params[1])
            and nt.params[3] > 1,
        children  := nt -> Map2(Filtered(DivisorPairs(nt.params[1]), (mn) -> IsInt(nt.params[3]/mn[2]) and IsInt(nt.params[5]/mn[1])),
            (m,n) -> [
                PrunedDFT(m, nt.params[2] mod m, nt.params[3]/n, nt.params[4]).transpose(),
                PrunedDFT(n, nt.params[2] mod n, nt.params[5]/m, nt.params[6]) ]
        ),
        apply := (nt, C, cnt) -> let(mn := nt.params[1], m := Cols(C[1]), n := Rows(C[2]),
            Tensor(C[1], I(n)) *
            Diag(fPrecompute(Tw1(mn, n, nt.params[2]))) *
            L(mn, m) * Tensor(C[2], I(m))
        ))
));


# Floating point infinity
inf := FLOAT_INT(1) / FLOAT_INT(0);

IS_FLOAT(inf);
#true;

# GAP has also a formal ''infinity'' value
infinity in Cyclotomics;
# true


InstallMethod(TotalDegree,
              "TotalDegree of multivariable polynomial",
              [IsPolynomial],
              function(poly)
              local result;

              result:=ExtRepPolynomialRatFun(poly);
              result:=result{2*[1..Length(result)/2]-1};
              result:=Maximum(List(result,j->Sum(j{2*[1..Length(j)/2]})));
              return result;
end);

InstallMethod(ValuePoly,
              "Value of multivariable polynomial",
              [IsPolynomial,IsList,IsList],
              function(poly,vars,vals)
    local result,ext_rep,ext_vars,
    monom,pos,i,j;

    ext_rep:=ExtRepPolynomialRatFun(poly);
    ext_vars:=List(vars,i->ExtRepPolynomialRatFun(i));
    ext_vars:=List(ext_vars,i->i[1][1]);

    result:=Zero(poly);
    for i in 2*[1..Length(ext_rep)/2]-1 do
        monom:=One(poly);
        for j in 2*[1..Length(ext_rep[i])/2]-1 do
            pos:=Position(ext_vars,ext_rep[i][j]);
            monom:=monom*vals[pos]^ext_rep[i][j+1];
        od;
        monom:=monom*((ext_rep[i+1]*One(poly)));
        result:=result+monom;
    od;

    return result;
end);

pRadical:=function(poly,avars)
    local result,
    ext_rep,ext_avars,
    p,deg,deg_max,p_div,monom,i,j;

    #exterior reprezentation of polynomial and variables
    ext_rep:=ExtRepPolynomialRatFun(poly);
    ext_avars:=List(avars,i->ExtRepPolynomialRatFun(i));
    ext_avars:=List(ext_avars,i->i[1][1]);

    # degree of variables in monomials of poly
    deg:=List(ext_rep{2*[1..Length(ext_rep)/2]-1},i->i{2*[1..Length(i)/2]});

    # Adjustment: (poly)^p ---> poly
    p:=Characteristic(poly);
    if Concatenation(deg)=[] then return poly; fi;
    deg_max:=LogInt(Maximum(Concatenation(deg)),p);
    p_div:=Gcd(p^deg_max,Gcd(Concatenation(deg)));
    if p_div>1 then
        result:=Zero(poly);
        for i in 2*[1..Length(ext_rep)/2]-1 do
            monom:=One(poly);
            for j in 2*[1..Length(ext_rep[i])/2]-1 do
                monom:=monom*avars[Position(ext_avars,ext_rep[i][j])]^(ext_rep[i][j+1]/p_div);
            od;
            result:=result+ext_rep[i+1]*monom;
        od;
        return result;
    fi;
    return poly;
end;

Solve:=function(poly,avars)
    local ext_rep,vars,ext_avars,p,
    deg,tot_deg,poz1,pozm,xpoly,xall,x,
    taboo;

    # Adjustment: (poly)^p ---> poly
    poly:=pRadical(poly,avars);

    #exterior reprezentation of polynomial and variables
    ext_rep:=ExtRepPolynomialRatFun(poly);
    ext_avars:=List(avars,i->ExtRepPolynomialRatFun(i));
    ext_avars:=List(ext_avars,i->i[1][1]);

    # variables of poly
    vars:=Concatenation(ext_rep{2*[1..Length(ext_rep)/2]-1});
    vars:=vars{2*[1..Length(vars)/2]-1};
    # degree of variables in monomials of poly
    deg:=List(ext_rep{2*[1..Length(ext_rep)/2]-1},i->i{2*[1..Length(i)/2]});
    tot_deg:=List(deg,i->Sum(i));
    #ignor constants
    tot_deg:=Filtered(tot_deg,i->i<>0);

    # Restrict: x should not be deduced from x+x^p+y
    taboo:=[];
    if Length(Set(vars))>1 then
    for x in Set(vars) do
        xall:=ext_rep{2*[1..Length(ext_rep)/2]-1};
        xall:=Filtered(xall,i->x in i);
        xpoly:=Filtered(xall,i->Length(i)=2);
        if Length(xpoly)>=2 then
        #    if xall=xpoly then
        #        return [Position(ext_avars,x),Zero(poly),avars[Position(ext_avars,x)]];
        #    fi;
            Add(taboo,Positions(vars,x));
        fi;
    od;
    taboo:=Concatenation(taboo);
    fi;

    p:=Characteristic(poly);
#    if Length(vars)=1 then
#        return [Position(ext_avars,vars[1]),RootsOfUPol(poly)[1],true];
#    fi;
#Error("!");
    if 1 in tot_deg then
        # x^p+P(x)^p
        if Length(Set(vars)) = 1 and Length(Set(tot_deg))>=2 then
#        Print(poly,"\n");
            return [Position(ext_avars,vars[1]),Zero(poly),avars[Position(ext_avars,vars[1])]];
#            return fail;
        fi;

##        if Length(Set(vars)) = 1 and not Difference(tot_deg,[1])[1] mod p =0 then
#        if Length(Set(vars)) = 1 and not Set(tot_deg)=[1,p] then
#            Print(poly,"\n");
#            return [Position(ext_avars,vars[1]),Zero(poly),avars[Position(ext_avars,vars[1])]];
##            return fail;
#        fi;

        if Length(Set(vars)) = 1 and Maximum(tot_deg)>1 then return fail; fi; # such relations produce infinite loops

        # position of variables among monomials of poly
        poz1:=Positions(tot_deg,1);
        poz1:=Difference(poz1,taboo);
        # if all variables are taboo return fail
        if Length(poz1)=0 then return fail; fi;
        # else choose one which is not taboo
        poz1:=poz1[1];
        # position of monomial in ext_rep
        pozm:=Position(ext_rep,[vars[poz1],1]);
        return [Position(ext_avars,vars[poz1]),avars[Position(ext_avars,vars[poz1])]-(ext_rep[pozm+1]^(-1))*poly,true];
    fi;
    return fail;
end;

SolveWithTorsion:=function(poly,avars)
    local ext_rep,vars,ext_avars,
    deg,tot_deg,poz1,pozm,xpoly,x,
    taboo;

    # Adjustment: (poly)^p ---> poly
    poly:=pRadical(poly,avars);

    #exterior reprezentation of polynomial and variables
    ext_rep:=ExtRepPolynomialRatFun(poly);
    ext_avars:=List(avars,i->ExtRepPolynomialRatFun(i));
    ext_avars:=List(ext_avars,i->i[1][1]);

    # variables of poly
    vars:=Concatenation(ext_rep{2*[1..Length(ext_rep)/2]-1});
    vars:=vars{2*[1..Length(vars)/2]-1};
    # degree of variables in monomials of poly
    deg:=List(ext_rep{2*[1..Length(ext_rep)/2]-1},i->i{2*[1..Length(i)/2]});
    tot_deg:=List(deg,i->Sum(i));
    #ignor constants
    tot_deg:=Filtered(tot_deg,i->i<>0);

    # Restrict: x should not be deduced from x+x^p+y
    taboo:=[];
    if Length(Set(vars))>1 then
    for x in Set(vars) do
        xpoly:=ext_rep{2*[1..Length(ext_rep)/2]-1};
        xpoly:=Filtered(xpoly,i->x in i);
        xpoly:=Filtered(xpoly,i->Length(i)=2);
        if Length(xpoly)>=2 then
            Add(taboo,Positions(vars,x));
        fi;
    od;
    taboo:=Concatenation(taboo);
    fi;

#    if Length(vars)=1 then
#        return [Position(ext_avars,vars[1]),RootsOfUPol(poly)[1],true];
#    fi;
#Error("!");
    if 1 in tot_deg then
        # x^p+P(x)^p
        if Length(Set(vars)) = 1 and Length(Set(tot_deg))>=2 then
            return [Position(ext_avars,vars[1]),Zero(poly),avars[Position(ext_avars,vars[1])]];
        fi;

        if Length(Set(vars)) = 1 and Maximum(tot_deg)>1 then return fail; fi; # such relations produce infinite loops

        # position of variables among monomials of poly
        poz1:=Positions(tot_deg,1);
        poz1:=Difference(poz1,taboo);
        # if all variables are taboo return fail
        if Length(poz1)=0 then return fail; fi;
        # else choose one which is not taboo
        poz1:=poz1[1];
        # position of monomial in ext_rep
        pozm:=Position(ext_rep,[vars[poz1],1]);
        return [Position(ext_avars,vars[poz1]),avars[Position(ext_avars,vars[poz1])]-(ext_rep[pozm+1]^(-1))*poly,true];
    fi;
    return fail;
end;

ReduceRelations:=function(relations,avars,values,APR)
    local result,#relations,
    relations_len,schimbare,Ring,torsion,GB,
    index,sol,i,modulo;

    result:=ShallowCopy(values);
    relations:=List(relations,i->Value(i,avars,result)*One(APR));
    relations:=Filtered(relations,i->i <> Zero(APR));
    relations:=Set(relations);
#    relations:=List(coefficients(u),i->i[2]);
    relations_len:=Length(relations);

#    i:=1;
#    while i<relations_len do
#        modulo:=Concatenation([1..i-1],[i+1..relations_len]);
#        modulo:=relations{modulo};
#        relations:=List(relations,i->PolynomialReducedRemainder(i,relations,MonomialLexOrdering()));
#        relations:=Set(Filtered(relations,i->i <> Zero(APR)));
#        if Length(relations)<relations_len then i:=1; fi;
#        relations_len:=Length(relations);
#    od;
#    Error("!");
#Print("...relations: ",relations,"\n");
    schimbare:=true;
    while relations<>[] and schimbare do
        #Print("@@@",relations_len," ");
#        Print("..relations: ",relations,"\n");
#        Print("--->result: ",result,"\n");
        #GB:=GroebnerBasis(relations,MonomialLexOrdering()); ## ATENTIE AICI
        result:=List(result,i->PolynomialReducedRemainder(i,relations,MonomialLexOrdering()));
        #result:=List(result,i->PolynomialReducedRemainder(i,GB,MonomialLexOrdering()));
#        Print("fresh result:",result,"\n");
        schimbare:=false;
        #Error("!!");
        #refresh relations
        #relations:=List(relations,i->Value(i,avars,result)*One(APR));
        relations:=List(relations,i->ValuePoly(i,avars,result)*One(APR));
#        Print("fresh rels:",relations,"\n");
        relations:=Filtered(relations,i->i <> Zero(APR));
        schimbare:=Length(relations)<relations_len;
        relations_len:=Length(relations);
    od;
#Error("!");
#Print(".relations: ",relations,"\n");
    relations:=Filtered(relations,i->i <> Zero(APR));

    return [result,relations];
end;

SolveRelations:=function(relations,avars,values,APR)
    local result,#relations,
    relations_len,schimbare,Ring,torsion,
    index,sol,i;

    result:=ShallowCopy(values);
    relations:=List(relations,i->Value(i,avars,result)*One(APR));
    relations:=Filtered(relations,i->i <> Zero(APR));

    relations:=ReduceRelations(relations,avars,result,APR);
#    #Error("!");
    result:=relations[1];
    relations:=relations[2];
#    #relations:=List(coefficients(u),i->i[2]);
    relations_len:=Length(relations);
#        Print("...relations: ",relations,"\n");

    Ring:=CoefficientsRing(APR);
    schimbare:=true;
    torsion:=[];

    #Error("!");
    while relations<>[] and schimbare do
    ##Print("len:=",Length(relations),"\n");
        schimbare:=false;
        index:=1;
        while index<=relations_len do
        #Print("len===",Length(relations),"\n","index===",index,"\n");
            sol:=Solve(relations[index],avars);
            #Print("solved ",relations[index],"\n");
            #Error("!");
            #sol:=fail;
            if sol<>fail then
                #change result
                result[sol[1]]:=sol[2];
                for i in [1..Length(result)] do
                    if not result[i] in Ring and result[i]<>avars[i] then
                       result[i]:=Value(result[i],avars,result)*One(APR);
                    fi;
                od;
                #refresh relations
                relations:=List(relations,i->Value(i,avars,result)*One(APR));
                relations:=Filtered(relations,i->i <> Zero(APR));
                #relations:=ReduceRelations(relations,avars,result,APR);
                #result:=relations[1];
                #relations:=relations[2];
                schimbare:=Length(relations)<relations_len or sol[2]=Zero(APR);
                relations_len:=Length(relations);

                if Length(sol)=3 and sol[3] in avars then Add(torsion,sol[3]); fi;
            fi;
            index:=index+1;
        od;
    od;

    return [result,relations,torsion];
end;


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

RewriteRules(RulesStrengthReduce, rec(
    mul_rv_cxpack:= Rule([@(2, mul), @(1, Value, e->(e.t = TComplex and let(vv:= im(e.v).eval(), IsValue(vv) and vv.v = 0.0)) or e.t in [TReal, TInt] ), @(3, cxpack)],
        e->let(vv := Value(TReal, re(@(1).val).eval()), cxpack(vv * @(3).val.args[1], vv * @(3).val.args[2]))),
));

RewriteRules(RulesFuncSimp, rec(
    distribure_diagDirsum_fTensor_fId := Rule([@(1, fCompose), @(2, diagDirsum, e->ForAll(e.children(), c->c.domain() = e.children()[1].domain())), [@(3, fTensor), @(4, fId, e->e.range() = Length(@(2).val.children())),...]],
        e->diagDirsum(List([0..@(4).val.range()-1], j->fCompose(@(2).val.children()[j+1], fTensor(Drop(@(3).val.children(), 1)))))),

    distribure_diagDirsum_fTensor_fBase := Rule([@(1, fCompose), @(2, diagDirsum, e->ForAll(e.children(), c->c.domain() = e.children()[1].domain())), [@(3, fTensor), @(4, fBase, e->e.range() = Length(@(2).val.children())),...]],
        e->fCompose(@(2).val.child(@(4).val.params[2]+1), fTensor(Drop(@(3).val.children(), 1)))),

    flip_L_fbase_fId := ARule(fCompose, [ @(1,L), @(3, fTensor, e->let(ch := e.children(), ObjId(Last(ch)) = fId
            and ForAll(DropLast(ch, 1), j->ObjId(j) = fBase) and @(1).val.params[1] / @(1).val.params[2] = Last(ch).size))],
        e-> [ fTensor([Last(@(3).val.children())]::DropLast(@(3).val.children(), 1))]),

    push_RCData :=ARule(fCompose, [@(1,RCData), @(3, fTensor, e->ObjId(Last(e.children())) = fId and Last(e.children()).size = 2)],
        e->[RCData(fCompose(@(1).val.func, fTensor(DropLast(@(3).val.children(), 1))))]),

    diagMul_fConst_RCData := Rule([@(1, diagMul), @(2, fConst), @(3, RCData)],
        e->RCData(diagMul(fConst(@(2).val.params[1], @(2).val.params[2]/2, @(2).val.params[3]), @(3).val.func))),

    diagMul_diagTensor := Rule([@(1, diagMul), @(2, fConst), @(3, diagTensor)],
        e->let(ch := @(3).val.children(),
               loc := PositionProperty(ch, c->ObjId(c) = Lambda and ObjId(c.expr) = cxpack),
               chn := ch[loc],
               pre := [1..loc-1],
               post := [loc+1..Length(ch)],
               ldc := Filtered(ch, c->ObjId(c) = Lambda and IsValue(c.expr)),
               fct := Product(List(ldc), c->_unwrap(c.expr)),
               chl := List(ch{pre}, c->When(IsValue(c.expr), Lambda(c.vars, V(1)), c)),
               chr := List(ch{post}, c->When(IsValue(c.expr), Lambda(c.vars, V(1)), c)),
               diagTensor(chl::[Lambda(chn.vars, mul(V(fct * @(2).val.params[3]), chn.expr))]::chr))),

    fCompose_Lambda_fBase := Rule([@(1,fCompose), @(3,Lambda), @(2, fBase)], e->let(ii := Ind(1), Lambda(ii, @(3).val.at(@(2).val.params[2]))))

));


# Built-in
Combinations([1, 2, 3]);
# [ [  ], [ 1 ], [ 1, 2 ], [ 1, 2, 3 ], [ 1, 3 ], [ 2 ], [ 2, 3 ], [ 3 ] ]

# Note that it handles duplicates
Combinations([1, 2, 3, 1]);
# [ [  ], [ 1 ], [ 1, 1 ], [ 1, 1, 2 ], [ 1, 1, 2, 3 ], [ 1, 1, 3 ], [ 1, 2 ], [ 1, 2, 3 ], [ 1, 3 ],
#   [ 2 ], [ 2, 3 ], [ 3 ] ]