#
# Read("~/Workspace/groupsSB/epi/A2/testLieAlgebraModuleBasis.gi");
#

type:="A";
rank:=2;
nr_pos_roots:=3;

Read("~/Workspace/groupsSB/epi/group.gi");

highest_weight:=[1,1];# corresponding highest weight module is the Lie algebra

Read("~/Workspace/groupsSB/epi/ext.gi");

Vb:=Basis(V);

#
# action of elements in the chevalley basis cb0 on module
#
on_module:=List(cb0,b->List(Vb,v->Coefficients(Vb,b^v)));

#
# action of elements in the chevalley basis cb0 on module
#
on_algebra:=List(cb0,b->List(cb0,v->Coefficients(cb0,v*b)));

#
# Wights of torus cb0[7],cb0[8] on module
#
weights_module:=[];
Add(weights_module,[on_module[7][1][1],on_module[8][1][1]]);
Add(weights_module,[on_module[7][2][2],on_module[8][2][2]]);
Add(weights_module,[on_module[7][3][3],on_module[8][3][3]]);

Add(weights_module,[on_module[7][4][4],on_module[8][4][4]]);
Add(weights_module,[on_module[7][5][5],on_module[8][5][5]]);

Add(weights_module,[on_module[7][6][6],on_module[8][6][6]]);
Add(weights_module,[on_module[7][7][7],on_module[8][7][7]]);
Add(weights_module,[on_module[7][8][8],on_module[8][8][8]]);

#
# Let a=cb0[1] and b=cb0[2]
#

#
# Vb[1] corrsponds to a+b (heighest root) ---> cb0[3]
#

#
# Vb[2] and Vb[3] corrspond to a and b
#

#
# In the internal notation
#   y1 = cb0[4] corrseponding to -a corresponding to cb0[7]
#   y2 = cb0[5] corresponding to -b corresponding to cb0[8]
#   y3 = cb0[6] corresponding to -a-b


cube := Group([(1, 2, 3, 4)(5, 6, 7, 8), (1, 4, 8, 5)(2, 3, 7, 6)]);

Order(cube);

degree := 8;
colorings := Filtered(
  Combinations(Cartesian([1..degree], ["b","w"]), degree)
, \c -> Size(Set(List(c, \a -> a[1]))) = degree
);

Size(colorings);

OnFunctions := function(omega, g)
  local result;
  result := List(omega, t -> [t[1]^g, t[2]]);
  SortBy(result, t -> t[1]);
  return result;
end;

orbits := Orbits(cube, colorings, OnFunctions);
Size(orbits);

image := OnFunctions([
    [1, "w"],
    [2, "w"],
    [3, "w"],
    [4, "b"],
    [5, "b"],
    [6, "b"],
    [7, "b"],
    [8, "b"],
], cube.1);

IsFixed := function(omega, g)
    return OnFunctions(omega, g) = omega;
end;

fixed := Filtered(colorings, \c -> IsFixed(c, cube.1));

orbitCount := 1/Order(cube) * Sum(
  List(Elements(cube), \g -> Size(Filtered(colorings, \c -> IsFixed(c, g))))
);


#
# Read("~/Workspace/groupsSB/epi/A2/actionFromExt1.gi");
#

type:="A";
rank:=2;
nr_pos_roots:=3;
highest_weight:=[1,1];# corresponding highest weight module is the Lie algebra

L:= SimpleLieAlgebra(type,rank,Rationals);
cb0:=CanonicalBasis(L);
V:= HighestWeightModule( L, highest_weight );
extA:=List([1..Dimension(V)],i->ExteriorPowerOfAlgebraModule( V, i ));
extA_basis:=List(extA,i->Basis(i));

extA1:=extA[1];
extA1b:=extA_basis[1];

#extA:=List([1..Dimension(V)],i->ExteriorPower( i ,V ));

ext1e:=function(e)
	local extb,result,v;
    extb:=extA_basis[1];

	result:=[];
	for v in extb do
		Append(result,[Coefficients(extb,e^v)]);
	od;
	result:=TransposedMat(result);
	return result;
end;

ext1_root_group:=function(index,t)
	local ee,tmp,result,i;
	ee:=ext1e(cb0[index]);
	tmp:=ee;
	result:=tmp^0;
	i:=1;
	while Length(Set(Concatenation(tmp)))<>1 do
		result:=result+t^i*tmp/Factorial(i);
		i:=i+1;
		tmp:=tmp*ee;
	od;
	return result;
end;

ext1_coeff_comb:=function(coeffs)
    local result,extb;
    extb:=extA_basis[1];
    result:=List([1..Length(extb)],i->coeffs[i]*extb[i]);
    return Sum(result);
end;

ext1_root_group_basis_img:=function(index,t)
    local rg,result;
    rg:=ext1_root_group(index,t);
    rg:=TransposedMat(rg);
    result:=List(rg,l->ext1_coeff_comb(l));
    return result;
end;

# ObjByExtRep(FamilyObj(bbb[1]),ExtRepOfObj(bbb[1]));

u1Bimg:=ext1_root_group_basis_img(1,1);

qqq:=ExtRepOfObj(extA_basis[2][1]);
IsWedgeElement(qqq);
ConvertToNormalFormMonomialElement(qqq);

n:=2;
fam:=FamilyObj(qqq);
combs:= Combinations( [1..Dimension(L)], n );
gens:= List( combs, x -> Basis(L){x} );
F:=LeftActingDomain(L);
gens2:= List( gens, x -> ObjByExtRep( fam, [ x , One(F) ] ) );

for i in [1..Length(gens)] do
    gens2[i]![2]:= true;
od;

test:=[2,2];
test:=Basis(L){test};
test:=ObjByExtRep( fam, [ test , One(F) ] );
test![2]:=true;
test:=ConvertToNormalFormMonomialElement(test);

M:=AdjointModule(L);
extA2:=ExteriorPowerOfAlgebraModule(M,2);

#
#
#
extA1:=extA[1];
bv:=BasisVectors(Basis(extA1));
bb:=ext1_root_group_basis_img(1,1);
B:= Algebra( Rationals, bb, "basis" );
#AlgebraHomomorphismByImages( extA1, extA1, bv, bb )

LeftModuleGeneralMappingByImages( extA1, extA1, bv, bb );
LeftModuleHomomorphismByImages( extA1, extA1, bv, bb );


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

NewRulesFor(MDPRDFT, rec(
    #F Rule MDPRDFT_Base:  MDPRDFT -> PRDFT1
    #F
    #F Apply this rule when Length(a_lengths()) = 1.
    #F QUESTION: What do the tags mean?
    #F Note MDPRDFT.hasTags() = false = IMDPRDFT.hasTags().
    #F
    MDPRDFT_Base := rec(
        info := "MDPRDFT -> PRDFT1",
        applicable     := nt -> Length(nt.a_lengths())=1,

        # Generally, children is list of ordered lists of all possible children.
        children       := nt -> let(tags := nt.getTags(),
                                    a_lengths := nt.a_lengths(),
                                    a_exp := nt.a_exp(),
                                    [[ PRDFT1(a_lengths[1], a_exp).withTags(tags) ]]),

        # nonterminal, children, children non-terminals
        apply          := (nt, C, Nonterms) -> C[1]
    ),

    #F  MDPRDFT_RowCol1: MDPRDFT(n_1,n_2,...,n_t) = (RC(MDDFT(n_1,n_2,...,n_{t-1}) x I(.))) (I(n_1*n_2*...*n_{t-1}) x PRDFT1(n_t))
    #F
    #F Apply this rule when Length(a_lengths()) > 1 and no tags.
    #F QUESTION: What do the tags mean?
    #F I find MDPRDFT.hasTags() = IMDPRDFT.hasTags() = false.
    #F
    MDPRDFT_RowCol1 := rec(
        info :="MDDFT(n_1,n_2,...,n_t) = (RC(MDDFT(n_1,n_2,...,n_{t-1}) x I(.))) (I(n_1*n_2*...*n_{t-1}) x PRDFT1(n_t))",
        applicable := nt -> Length(nt.a_lengths())>1 and not nt.hasTags(),
        # Generally, children is list of ordered lists of all possible children.
        # 2 children, both with same parameter a_exp():
        # [1] MDDFT on all but last dimension;
        # [2] PRDFT1 on last dimension, the fastest varying dimension.
        children  := nt -> let(a_lengths := nt.a_lengths(),
                               a_exp := nt.a_exp(),
                               [[ MDDFT(DropLast(a_lengths, 1), a_exp),
                                  PRDFT1(Last(a_lengths), a_exp) ]]),

        # nonterminal, children, children non-terminals
        apply := (nt, C, cnt) -> let(a_lengths := nt.a_lengths(),
                                     Clast := C[2],
                                     Crest := C[1],
                                     Nlastcomplex := Clast.dims()[1]/2,
                                     Nrest := DropLast(a_lengths, 1),
                                     Nallbutlast := Product(Nrest),
                                     # Apply Clast on last dimension,
                                     # then Crest on all dimensions but last.
                                     RC(Tensor(Crest, I(Nlastcomplex))) *
                                     Tensor(I(Nallbutlast), Clast)
                                    )
    )
));

NewRulesFor(IMDPRDFT, rec(
    #F Rule IMDPRDFT_Base:  IMDPRDFT -> IPRDFT1
    #F
    #F Apply this rule when Length(a_lengths()) = 1.
    #F QUESTION: What do the tags mean?
    #F Note MDPRDFT.hasTags() = false = IMDPRDFT.hasTags().
    #F
    IMDPRDFT_Base := rec(
        info := "IMDPRDFT -> IPRDFT1",
        applicable     := nt -> Length(nt.a_lengths())=1,
        # Generally, children is list of ordered lists of all possible children.
        children       := nt -> let(tags := nt.getTags(),
                                    a_lengths := nt.a_lengths(),
                                    a_exp := nt.a_exp(),
                                    [[ IPRDFT1(a_lengths[1], a_exp).withTags(tags) ]]),
        # nonterminal, children, children non-terminals
        apply          := (nt, C, Nonterms) -> C[1]
    ),

    #F  IMDPRDFT_RowCol1: IMDPRDFT(n_1,n_2,...,n_t) = (RC(IMDDFT(n_1,n_2,...,n_{t-1}) x I(.))) (I(n_1*n_2*...*n_{t-1}) x IPRDFT1(-n_t))
    #F
    #F Apply this rule when Length(a_lengths()) > 1 and no tags.
    #F QUESTION: What do the tags mean?
    #F I find MDPRDFT.hasTags() = IMDPRDFT.hasTags() = false.
    #F
    #F FIXME: This is not done yet.
    #F
    IMDPRDFT_RowCol1 := rec(
        info :="IMDDFT(n_1,n_2,...,n_t) = (RC(IMDDFT(n_1,n_2,...,n_{t-1}) x I(.))) (I(n_1*n_2*...*n_{t-1}) x PRDFT1(-n_t))",
        applicable := nt -> Length(nt.a_lengths())>1 and not nt.hasTags(),
        # Generally, children is list of ordered lists of all possible children.
        # 2 children, both with same parameter a_exp():
        # [1] IMDDFT on all but last dimension;
        # [2] IPRDFT1 on last dimension, the fastest varying dimension.
        children  := nt -> let(a_lengths := nt.a_lengths(),
                               a_exp := nt.a_exp(),
                               [[ MDDFT(DropLast(a_lengths, 1), a_exp),
                                  IPRDFT1(Last(a_lengths), a_exp) ]]),

        # nonterminal, children, children non-terminals
        apply := (nt, C, cnt) -> let(a_lengths := nt.a_lengths(),
                                     Clast := C[2],
                                     Crest := C[1],
                                     Nlastcomplex := Clast.dims()[2]/2,
                                     Nrest := DropLast(a_lengths, 1),
                                     Nallbutlast := Product(Nrest),
                                     # Apply Crest on all dimensions but last,
                                     # then Clast on last dimension.
                                     Tensor(I(Nallbutlast), Clast) *
                                     RC(Tensor(Crest, I(Nlastcomplex)))
                                    )
    )
));


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

# This file contains code relevant to arbitrary bit matrices.
# At some point, Marek and I should make one file of this sort that we can both use. (PM)

##    BitMatrixToInts(P) returns bit matrix converted into integers (0, 1).
##
BitMatrixToInts := meth(x)
   return List([1 .. Length(x)], i-> IntVecFFE(x[i]));
end;

##   PrintBitMatrix(P) prints bit matrix P in a readable form.
##
PrintBitMatrix := meth(x)
   PrintMat(BitMatrixToInts(x));
end;

##   NumberBitRep(x, b) returns a b-bit number, formed as a vector over GF(2),
##       corresponding to decimal number x.
##
NumberBitRep := meth(x, bits)
   return Reversed(List([1..bits], i -> [ Mod(QuoInt(x, 2^(i-1)), 2) * GF(2).one ] ));
end;

##   BitsToNumber(x) returns the decimal number associated with bit vector x.
##
BitsToNumber := meth(x)
   return Sum(List([1..Length(x)], i -> 2^(i-1) * IntVecFFE(Reversed(x)[i])[1]));
end;

##    BasisVecToNum(b) returns a number corresponding to given basis
##       vector b.
##
BasisVecToNum := meth(b)
   return Sum(List([1..Length(b)], i -> Cond(IsList(b[i]), b[i][1], b[i]) * (i-1)));
end;

##   BitsToPermMatrix(P) returns the SPL permutation matrix corresponding
##      to bit matrix P.
##
BitsToPermMatrix := meth(P)
   local x, l;
   x := [];
   l := Dimensions(P)[1];

   x := List([1..2^l], i -> BasisVec(2^l, BitsToNumber(P * NumberBitRep(i-1, l))));

   return Transposed(x);
end;

Declare(TransposeVector);

##   PermMatrixToBits(P) returns the bit matrix associated with
##      permutation matrix P.
##
PermMatrixToBits := function(perm)
   local length, res, i, logLength, pm;

   length := Length(perm);
   logLength := Log2Int(length);

   res := [];
   for i in [0..logLength-1] do
      res[logLength-i] :=
         TransposeVector(
	    NumberBitRep(
	       BasisVecToNum(
	          perm * TransposeVector(BasisVec(length, 2^i))
	       ), logLength
	    )
	 );
   od;

   res := TransposedMat(res);

   pm := BitsToPermMatrix(res);

   if (Length(pm) <> Length(perm) or Maximum(Maximum(pm - perm)) <> 0) then
#       Print("ERROR: Given matrix is not a permutation or is not linear on the bits.\n");
       return -1;
   fi;

   return res;
 end;

# ===============================================
# A permutation represented as a linear mapping on the bits
# LinearBits(matrix over GF(2), <SPL Permutation object>)
# ===============================================
Class(LinearBits, BaseMat, SumsBase, rec(
	new := (self, m, p) >>
	   SPL(WithBases(self,
		   rec(
		       dimensions := [2^Length(m), 2^Length(m)],
		       _children  := [m, p]
		   )
	)),

	rSetChild := meth(self, n, what)
	   self._children[n] := what;
	end,

	rChildren  := self >> self._children,
	child      := (self, n) >> self._children[n],
	children   := self >> self._children,

	createCode := self >> self,
        print      := (self,i,is) >> Print(self.name, "(", self._children[1], ")"),

	toAMat     := self >> AMatMat(BitsToPermMatrix(self.child(1))),
	dims       := self >> [2^(Length(self._children[1])), 2^(Length(self._children[1]))],

	sums       := self >> self
));

TL.permBits :=
    meth(self)
        local stride, logStride, size, logSize, res, row, i, j, a, b;
	stride    := self.params[2];
	logStride := Log2Int(stride);
	size      := self.params[1];
	logSize   := Log2Int(size);
	a         := Log2Int(self.params[3]);
	b         := Log2Int(self.params[4]);
	res       := [];

	for i in [1 .. a] do
	   row := Concatenation([ List([1 .. i-1],     i -> 0*GF(2).one),
		                  [ GF(2).one ],
				  List([i+1 .. a],     i -> 0*GF(2).one),
				  List([1 .. logSize], i -> 0*GF(2).one),
				  List([1 .. b],       i -> 0*GF(2).one) ]);

	   Append(res, [row]);
	od;

	for i in [logSize-logStride+1 .. logSize] do
	   row := Concatenation([ List([1 .. a],         i -> 0*GF(2).one),
		                  List([1 .. i-1],       i -> 0*GF(2).one),
				  [ GF(2).one ],
				  List([i+1 .. logSize], i -> 0*GF(2).one),
				  List([1 .. b],         i -> 0*GF(2).one)]);

	   Append(res, [row]);
	od;

	for i in [1 .. logSize-logStride] do
	   row := Concatenation([ List([1 .. a],   i -> 0*GF(2).one),
		                  List([1 .. i-1], i -> 0*GF(2).one),
				  [ GF(2).one ],
				  List([i+1 .. logSize], i -> 0*GF(2).one),
				  List([1 .. b],         i -> 0*GF(2).one)]);

	   Append(res, [row]);
	od;

	for i in [1 .. b] do
	   row := Concatenation([ List([1 .. a],       i -> 0*GF(2).one),
		                  List([1 .. logSize], i -> 0*GF(2).one),
				  List([1 .. i-1],     i -> 0*GF(2).one),
				  [ GF(2).one ],
				  List([i+1 .. b],     i -> 0*GF(2).one)]);

	   Append(res, [row]);
	od;

	return res;
end;

DR.permBits := meth(self)
       local k,  n, res;
       k := LogInt(self.params[2], 2);
       n := LogInt(self.domain(), 2);
       return MatSPL(Tensor(J(n/k), I(k))) * GF(2).one;
end;


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

#s:=SPLRuleTree(ExpandSPL(PolyBDFT3(16))[1]);

#s:=SPLRuleTree(ExpandSPL(BSkewDFT3(16))[1]);
# Even1 -- Odd0
s := K(16,4) *
     DirectSum(
	 BSkewDFT3(4, 1/16),
	 BSkewDFT3(4, 3/16),
	 BSkewDFT3(4, 5/16),
	 BSkewDFT3(4, 7/16)
     ) *
     L(16,8) *
     Tensor(I(2), PolyBDFT3(8, 1/4));
     L(16,2);

left := K(8,2) *
        DirectSum(
	  SkewDTT(DCT3(2), 1/8),
	  SkewDTT(DCT3(2), 3/8),
	  SkewDTT(DCT3(2), 5/8),
	  SkewDTT(DCT3(2), 7/8)
        );

 right:=MatSPL(left)^-1 * MatSPL(DCT3(8));

spiral> ps(MatSPL(L(8,2))*right*MatSPL(L(8,4)));

left := K(8,4) *
        DirectSum(
	  SkewDTT(DCT3(4), 1/4),
	  SkewDTT(DCT3(4), 3/4)
        );

 right:=MatSPL(left)^-1 * MatSPL(DCT3(8));

spiral> ps(MatSPL(L(8,4))*right*MatSPL(L(8,2)));

# X * BRDFT * IJ = BRDFT,      X = BRDFT * IJ * BRDFT^-1
# Y * BRDFT * IJ = BRDFT * J,  Y = BRDFT*J*IJ*BRDFT^-1
#
c3polyalgo := function(N,m,a)
    local k, left, right, zz, mid;
    k := N/2/m;
    zz := RulesDFTSymmetry(L(N, m) * GathExtend(N,Odd0));
    left := K(N/2,m) * DirectSum(List([0..k-1], i -> SkewDTT(DCT3(m), fr(k,i,a).ev())));
    right := DirectSum(
	SkewDTT(DCT3(k), a),
	List([1..(m-2)/2], i -> BRDFT3(2*k,a/2)*DirectSum(I(1), -J(2*k-1))),
	PolyDTT(SkewDTT(DCT4(k),a))
    ) *
    Compose(Drop(zz.children(), 1));

    mid := MatSPL(left)^-1 * MatSPL(SkewDTT(DCT3(N/2),a)) * MatSPL(right)^-1;
    #PrintMat(mid);
    VisualizeMat(mid, ", ");
    return mid;
end;

#N := 32; m := 4; k := N/2/m;

#[0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]
mid := c3polyalgo(32,8);
p:=Prm(FList([0,2,3,6,7,10,11,14, 1,4,5,8,9,12,13, 15]).setRange(15));

ps(mid * MatSPL(p)^-1);


#
# Read("~/Workspace/groupsSB/epi/B2/case.6.gi");
#

type:="B";
rank:=2;
nr_pos_roots:=4;

Read("~/Workspace/groupsSB/epi/group.gi");

highest_weight:=[0,2];# corresponding highest weight module is the Lie algebra

Read("~/Workspace/groupsSB/epi/ext.gi");

#
# p>2
#

getRep:=function(k,t)
    local u,ua,ub,uab,uabb;
    #ua:=ext_root_group(k,1,t);
    ub:=ext_root_group(k,2,t);
    uab:=ext_root_group(k,3,t);
    uabb:=ext_root_group(k,4,t^2);
    u:=ub*uab*uabb;

    return u;
end;

handle:=function(k)
    local id_mat,u,e,h,h1,h2,ese,evh,esh,esh0,index_ev0,si,inter;
    u:=getRep(k,1);
    id_mat:=u^0;
    e:=u-id_mat;
    ese:=Eigenspaces(Rationals,e)[1]; #eigenvalues 0, centralizer

    # torus
    h1:=ext_e(k,cb0[7]);
    h2:=ext_e(k,cb0[8]);;
    h:=h1+h2;
    esh:=Eigenspaces(Rationals,h);
    evh:=Eigenvalues(Rationals,h);

    # centralizer of torus
    esh0:=[];
    index_ev0:=Position(evh,0);
    esh0:=esh[index_ev0];

    #
    # sum and intersection
    #
    si:=SumIntersectionMat(Basis(ese),Basis(esh0));
    inter:=si[2];
    return inter;
end;


# The Loop function will apply some function to every tuple built by taking
# the i-th element of each list. If one of them is exhausted before the others,
# the loop continues at its begining. Only the longests lists will be precessed only once.
Loop := function(a, f)
    local i, j, m, n, v;
    n := Length(a);
    v := List(a, Length);
    m := Maximum(v);
    for j in [1 .. m] do
        f(List([1 .. n], i -> a[i][1 + RemInt(j - 1, v[i])]));
    od;
end;

# Here we simply print each "row"
f := function(u)
    Perform(u, Print);
    Print("\n");
end;

Loop([["a", "b", "c"], ["A", "B", "C"], [1, 2, 3]], f);

aA1
bB2
cC3

Loop([["a", "b"], ["A", "B", "C", "D", "E"], [1, 2, 3]], f);

aA1
bB2
aC3
bD1
aE2


Anagrams := function(name)
  local f, p, L, line, word, words, swords, res, cur, r;
  words := [ ];
  swords := [ ];
  f := InputTextFile(name);
  while true do
    line := ReadLine(f);
    if line = fail then
      break;
    else
      word := Chomp(line);
      Add(words, word);
      Add(swords, SortedList(word));
    fi;
  od;
  CloseStream(f);
  p := SortingPerm(swords);
  L := Permuted(words, p);
  r := "";
  cur := [ ];
  res := [ ];
  for word in L do
    if SortedList(word) = r then
      Add(cur, word);
    else
      if Length(cur) > 0 then
        Add(res, cur);
      fi;
      r := SortedList(word);
      cur := [ word ];
    fi;
  od;
  if Length(cur) > 0 then
    Add(res, cur);
  fi;
  return Filtered(res, v -> Length(v) > 1);
end;

ana := Anagrams("my/gap/unixdict.txt");;

# What is the longest anagram sequence ?
Maximum(List(ana, Length));
# 5

# Which are they ?
Filtered(ana, v -> Length(v) = 5);
# [ [ "abel", "able", "bale", "bela", "elba" ],
#   [ "caret", "carte", "cater", "crate", "trace" ],
#   [ "angel", "angle", "galen", "glean", "lange" ],
#   [ "alger", "glare", "lager", "large", "regal" ],
#   [ "elan", "lane", "lean", "lena", "neal" ],
#   [ "evil", "levi", "live", "veil", "vile" ] ]


#############################################################################
##
#W  ncgraphs.gi                NCGraph Package                    John Gouwar
##
##  Installation file for functions of the NCGraph package.
##
##

#############################################################################
##
#F  RemoveCenter( <G> ) . . . . . . . .  removes the center of a group
##
InstallGlobalFunction( RemoveCenter, function( G )
  local center, removed_center, g;
  center := Centre(G);
  removed_center := [];
  for g in G do
    if g in center then
      continue;
    else
      Add(removed_center, g);
    fi;
  od;
  return removed_center;
end );

#############################################################################
##
#F  NonCommutingGraph(<G>) . . . . . . .  generate non-commuting graph of <G>
##
InstallGlobalFunction( NonCommutingGraph, function( G )
  local non_com_relation, id;
    id := One(G);
  non_com_relation := function(x, y) return Comm(x, y) <> id; end;
  if IsAbelian(G) then
    return Graph(Group(id), [], OnPoints, non_com_relation);
  fi;
  return Graph(Group(id), RemoveCenter(G), OnPoints, non_com_relation);
end );

#############################################################################
##
#F  AdjacencyMatrix(<G>) . . . . . . .  generate an adjaceny matrix of <G>
##
InstallGlobalFunction( AdjacencyMatrix, function( G )
  local adj_mat, order, adjacencies, i, j;
  order := G.order;
  if order = 0 then
    return [];
  fi;
  adjacencies := G.adjacencies;
  adj_mat := NullMat(order, order);
  for i in [1..order] do
    for j in adjacencies[i] do
      adj_mat[i][j] := 1;
    od;
  od;
  return adj_mat;
end );

#E  ncgraphs.gi  . . . . . . . . . . . . . . . . . . . . . . ends here


# Codes related to Rationality of Algebraic Tori.
# This file contains all codes written by myself.

Sub_Matrix:= function(G,L,M)
#Inputs: G as a finite group, L list with 2 entries showing the interval of desired rows, M list with 2
# entries showing the interval of desired columns. The output is a list containing extracted submatrices
# from generators of group G.
local g,H;
H:= [];
	for g in GeneratorsOfGroup(G) do
		Append(H,[g{[L[1]..L[2]]}{[M[1]..M[2]]}]);
	od;
return(H);
end;

GDual:= function(G)
# this function returns the dual G-lattice, by transposing the generators of G.

	local i,L,n,T,Gp;

	T:= GeneratorsOfGroup(G);

	n:= Size(T);

	L:=[];
	for i in [1..n] do
		L[i]:= TransposedMat(T[i]);
	od;

	Gp:= GroupByGenerators(L);
	return(Gp);
end;

Rank1PermQuot:= function(G)

local   Denom,		# List of all denominators of entries of a vector.
	SDenom,		# Size of Denom.
	gens,		# A generating list for the rank m-1 subgroup (sublattice
			# of the dual lattice).
	H,		# The Corresponding group of the dual lattice.
	HH,		# A list of Generators of H.
	I,		# Identity matrix of size equal to rank of G
	K,		# An appropriate conjugate of the dual group in which,
			# the invariant sublattice of rank m-1 is readable.
	L,		# The record containing the vectors which extend
			# the sign vector to a basis fo lattice.
	LCM,		# The least common multiple of Denom.
	m,		# The rank of group
	W,		# A list of vectors which is formed by bases of eigenspaces.
	R,		# A mutable copy of extended basis.
	r,		# A mutable copy of the basis for the invariant space.
	S,		# GAP ID of the rank n-1 invariant for the original lattice.
	G1,		# The group asocciated to an invariant subspace of rank m-1 in the original lattice.
	Res;		# Record containing all the information of the reduction process.
	H:= GDual(G);
	HH:= GeneratorsOfGroup(H);
	m:= Size(HH[1]);
	I:= HH[1]^0;
	W:= BaseFixedSpace(HH);

	if Size(W)<>0 then
		if ForAll(W[1], IsInt) = false then
			Denom := List(W[1], w-> DenominatorRat(w));
			LCM:= Denom[1];
			SDenom:= Size(Denom);
			for i in [2..SDenom] do
				LCM:= LcmInt(LCM,Denom[i]);
			od;
			W[1]:= LCM*W[1];
		else
			W[1]:= W[1];
		fi;
		L:= ComplementIntMat(I,[W[1]]);
		R:= ShallowCopy(L.complement);
		r:= ShallowCopy(L.sub);
		Append(R,r);
		if IsInt(Determinant(R)) = true and AbsInt(Determinant(R))=1 then
			K:= ConjugateGroup(H,R^(-1));
			gens:= Sub_Matrix(K,[1,m-1],[1,m-1]);
			G1:= GDual(GroupByGenerators(gens));
			S:= CrystCatZClass(G1);
			Res:= rec(Structure:= StructureDescription(G), DualGens:= HH, Trans:= R^(-1), 		 				NewG:=GeneratorsOfGroup(GDual(K)),SubLatGens:= GeneratorsOfGroup(G1), ZClassSubLat:= S);
			return(S);
		else
			return(fail);
		fi;
	else
		#Print("No Permutation lattice of Rank 1\n");
		return(fail);

	fi;
end;

###### For a given lattice (represented by finite number of unimodular matrices)
# The function calculates intersections of Eigenspaces for eigenvalues one and
# negative one. In Case that there is a nonzero intersection, it returns the basis.
# Input:  a finite subgroup of GL(n,Z).
# Output: The conjugation element for the dual lattice which is a matrix in GL(n,Z).
#	  An invariant sublattice of the corresponding lattice to G, of rank 4 where
#	  the quotient of the original lattice and the output is a sign permutation.

Rank1SgnPermQuot:= function(G)

local
	BEigSP,		# Duplicate free list of bases of intersection of eigenspaces.
	EigSp,		# List of all eigenspaces of all generators of G.
	EigSP,		# List of Cartesian product of EigSp.
	Denom,		# List of all denominators of entries of a vector.
	gens,		# A generating list for the rank 4 subgroup (invariant sublattice
			# of the dual lattice).
	H,		# The Corresponding group of the dual lattice.
	HH,		# A list of Generators of H.
	I,		# Identity Matrix of rank 5.
	InterEigSP,	# A list of Intersections of eigenspaces.
	K,		# An appropriate conjugate of the dual group in which,
			# the invariant sublattice of rank 4 is easily readable.
	l,		# rank of lattice
	L,		# The record containing the vectors which extend
			# the sign vector to a basis fo lattice.
	LCM,		# The least common multiple of Denom.
	W,		# A list of vectors which is formed by bases of eigenspaces.
	R,		# A mutable copy of extended basis.
	Rec,
	r,		# A mutable copy of the basis for the sign invariant space.
	S,		# GAP ID of the rank n-1 invariant for the original lattice.
	Sgen,		# The size of a generating set of H.
	G1;		# An invariant subspace of rank 4 in the original lattice.

	H:= GDual(G);
	HH:= GeneratorsOfGroup(H);
	I:= HH[1]^0;
	l:= Size(I);
	Sgen:= Size(HH);
	EigSp:= List([1..Sgen],x->[]);
	for i in [1..Sgen] do
		Append(EigSp[i],Eigenspaces(Rationals,HH[i]));
	od;
	EigSP:= Cartesian(EigSp);
	InterEigSP:= [];
	for a in EigSP do
		n:= Size(a);
		S:= a[1];
		for i in [2..n] do
			S:= Intersection(S,a[i]);
		od;
		Append(InterEigSP,[S]);
	od;
	BEigSP:= Set(List(InterEigSP,t->GeneratorsOfVectorSpace(t)));
	Remove(BEigSP,Position(BEigSP,[]));
	if BEigSP <> [] then
		W:= ShallowCopy(BEigSP[1]);

		if Size(W)<>[] then
			if ForAll(W[1], IsInt) = false then
				Denom := List(W[1], w-> DenominatorRat(w));
				LCM:= Denom[1];
				for i in [2..Size(Denom)] do
					LCM:= LcmInt(LCM,Denom[i]);
				od;
				W[1]:= LCM*W[1];
			else
				W[1]:= W[1];
			fi;
			L:= ComplementIntMat(I,W);
			R:= ShallowCopy(L.complement);
			r:= ShallowCopy(L.sub);
			Append(R,r);

				K:= ConjugateGroup(H,R^(-1));
				gens:= Sub_Matrix(K,[1,l-1],[1,l-1]);
				G1:= GDual(GroupByGenerators(gens));
				S:= CrystCatZClass(G1);
				Print(R^(-1),"\n");
				Rec:= rec(DualGens:= HH, Trans:= R^(-1), NewG:= GeneratorsOfGroup(GDual(K)),
                                         SubLatGens:= GeneratorsOfGroup(G1), ZClassSubLat:= S);
					return(S);
		else
			Print("No sign permutation lattice of rank 1\n");

		fi;
	else
		Print("No sign permutation lattice of rank 1\n");
	fi;
end;


# Copyright 2018-2019, Carnegie Mellon University
# See LICENSE for details
#
# CNOT Base object
#

##
#F GenCnotMat( <j>, <dir> )
##
## Expands into a 2^i by 2^i CNOT matrix. CNOT-ing between i and 0 depending on dir
## if dir = 1 then i -> 0, if dir = 0 then 0 -> i
GenCnotMat:= function (j, dir)
    local m1, m2;
    # if 0 controlling j
    if j = 0 then
        return I(1);
    fi;
    m1 := VStack( HStack(I(2^(j)), O(2^(j))), HStack(O(2^(j)), Tensor(I(2^(j-1)), qX())) );
    # if j controlling 0
    m2 := qHT(j+1) * m1 * qHT(j+1);
    return When(dir = 0, m1, m2);
end;

#F -----------------------------------------------------------------------------
#F CNOT(j, a) - CNOT gate size j, swapping qubit index 0 and index j
#F a takes on {0, 1} indicating which is the controlling qubit
#F affected qubit is implicitly the other qubit. acts on a 2-qubit state vector
#F -----------------------------------------------------------------------------
Class(CNOT, Sym, rec(
     def := (j, a) -> GenCnotMat(j, a),
     isReal := False,
     isPermutation := False,
     transpose := self >> self,
     conjTranspose := self >> self,
     inverse := self >> self,
     toAMat := self >> self.def(self.params[1], self.params[2]),
 ));


# A hyperconic in a Desarguesian projective plane of order 2^s.
BindGlobal("HyperconicProjectivePlane",
    s -> rec(points := Set(List(Union([[0,1,0], [1,0,0]]*Z(2^s)^0,
                                    List(GF(2^s), t -> [t, t^2, 1]*Z(2^s)^0)),
                                x -> Subspace(GF(2^s)^3, [x], "basis"))),
            group := HyperconicAutomorphismGroup(2^s), d := 2, q := 2^s)
);

# A classical conic in a Desarguesian projective plane of order q.
BindGlobal("ClassicalConicProjectivePlane",
    q -> rec(points := Set(List(Union([[0,1,0]]*Z(q)^0, List(GF(q),
            t -> [t, t^2, 1]*Z(q)^0)), x -> Subspace(GF(q)^3, [x], "basis"))),
            group := HyperconicAutomorphismGroup(q), d := 2, q := q)
);

# A nonclassical conic in a Desarguesian projective plane of order q.
BindGlobal("NonclassicalConicProjectivePlane",
    q -> rec(points := Set(List(Union([[1,0,0]]*Z(q)^0, List(GF(q),
            t -> [t, t^2, 1]*Z(q)^0)), x -> Subspace(GF(q)^3, [x], "basis"))),
            group := Group([DiagonalMat([Z(q), Z(q)^2, Z(q)^0]),
                            Z(q)*IdentityMat(3, GF(q))]),
            d := 2, q := q)
);

# An elliptic quadric in a d-dimensional projective space of order q.
BindGlobal("EllipticQuadricProjectiveSpace", function(q)
    local G, V;
    G := GO(-1, 4, q);
    V := GF(q)^4;
    return rec(points := IsotropicSpacesQuadraticForm(
                    InvariantQuadraticForm(G).matrix)(Subspaces(V, 1)),
                group := G, d := 3, q := q);
end);


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

#F SinDFT( <size> )
#F
Class(SinDFT, NonTerminal, rec(
    abbrevs   := [ n -> Checked(IsInt(n), n > 0, n) ],
    dims      := self >> [ self.params, self.params ],
    terminate := self >> Mat(Global.SinDFT(self.params)),
    transpose := self >> self,
    isReal    := True
));

#F CosDFT( <size> )
#F
Class(CosDFT, NonTerminal, rec(
    abbrevs   := [ n -> Checked(IsInt(n), n > 0, n) ],
    dims      := self >> [ self.params, self.params ],
    terminate := self >> Mat(Global.CosDFT(self.params)),
    transpose := self >> self,
    isReal    := True
));

RulesFor(CosDFT, rec(
    #F CosDFT_Base: (base case)
    #F
    #F   CosDFT_2 = F_2
    #F   CosDFT_4 = ... can be done in 5 instad of 7 adds
    #F
    CosDFT_Base := rec (
	info             := "CosDFT_2 -> F_2",
	forTransposition := false,
	isApplicable     := P -> P in [2,4],
	rule := (P, C) -> When(P=2, F(2),
	    Mat(MatSPL(copy1(2) * sums3(2))) *
	    DirectSum(F(2), Mat([[1, 1]])) *
	    Perm((2,3), 4))
    ),

    #F CosDFT_Trigonometric: 1984
    #F
    #F   CosDFT_n = copy * sums * (CosDFT_n/2 dirsum DCT2_n/4) * sums * perm
    #F
    #F   Vetterli/Nussbaumer:
    #F     Simple FFT and DCT Algorithms with Reduced Number
    #F     of Operations, Signal Processing, 1984, pp. 267--278
    #F
    CosDFT_Trigonometric := rec (
	info             := "CosDFT_n --> CosDFT_n/2, DCT2_n/4",
	isApplicable     := P -> P mod 4 = 0 and P > 4,

	allChildren := P -> [[ CosDFT(P/2), DCT2(P/4) ]],

	rule := (P, C) ->
	    copy1(P/2) * sums3(P/2) *
	    DirectSum(C) *
	    DirectSum(I(P/2), sums2(P/4)) *
	    L(P, 2)
    )
));

RulesFor(SinDFT, rec(
    #F SinDFT_Base: (base case)
    #F
    #F   SinDFT_2 = NullMat_2
    #F   SinDFT_4 = (NullMat_2 dirsum block) ^ perm
    #F
    SinDFT_Base := rec (
	info             := "SinDFT_2 -> 0_2",
	forTransposition := false,
	isApplicable := P -> P in [2,4],
	rule := (self, P, C) >> When(P = 2,
		Mat([[0,0],[0,0]]),
		DirectSum(Mat([[0, 0], [0, 0]]),
		          Mat([[1], [-1]]) * Mat([[1, -1]])) ^ Perm((2,3), 4))
    ),

    #F SinDFT_Trigonometric: 1984
    #F
    #F   SinDFT_n = copy * sums * (SinDFT_n/2 dirsum DCT2_n/4) * sums * perm
    #F
    #F   Vetterli/Nussbaumer:
    #F     Simple FFT and DCT Algorithms with Reduced Number
    #F     of Operations, Signal Processing, 1984, pp. 267--278
    #F
    SinDFT_Trigonometric := rec(
	info         := "SinDFT_n --> SinDFT_n/2, DCT2_n/4",
	isApplicable := P -> P mod 4 = 0 and P > 4,

	allChildren := P -> [[ SinDFT(P/2), DCT2(P/4) ]],

	rule := (P, C) ->
	    copy2(P/2) * sums5(P/2) *
	    DirectSum(C) *
	    DirectSum(I(P/2), sums4(P/4)) *
	    L(P, 2)
    )
));


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

sys:=RootSystem("F",4);
Print("Created RootSystem ",sys,"\n");
Print("\t[",IsRootSystem(sys)=true,"] IsRootSystem(sys)=true\n");

positiveRootTest:=[ [ 1, 0, 0, 0 ], [ 0, 1, 0, 0 ], [ 0, 0, 1, 0 ], [ 0, 0, 0, 1 ], [ 1, 0, 1, 0 ], [ 0, 1, 0, 1 ],
  [ 0, 0, 1, 1 ], [ 1, 0, 1, 1 ], [ 0, 1, 1, 1 ], [ 0, 0, 2, 1 ], [ 1, 1, 1, 1 ], [ 1, 0, 2, 1 ],
  [ 0, 1, 2, 1 ], [ 1, 1, 2, 1 ], [ 2, 0, 2, 1 ], [ 0, 1, 2, 2 ], [ 1, 1, 2, 2 ], [ 2, 1, 2, 1 ],
  [ 1, 1, 3, 2 ], [ 2, 1, 2, 2 ], [ 2, 1, 3, 2 ], [ 2, 1, 4, 2 ], [ 2, 1, 4, 3 ], [ 2, 2, 4, 3 ] ]=positiveRoots(sys);
Print("\t[",positiveRootTest,"] testing positiveRoots(sys)\n");

tmp:=StringPrint(Cocharacters(UnderlyingLieAlgebra(sys)));
tmp:=SubstitutionSublist(tmp,"\n  ","");
cocharacterTest:="[ v.49, v.50, v.51, v.52, v.49+v.51, v.50+v.52, v.51+(2)*v.52, v.49+v.51+(2)*v.52, (2)*v.50+v.51+\
(2)*v.52, v.51+v.52, v.49+(2)*v.50+v.51+(2)*v.52, v.49+(2)*v.51+(2)*v.52, v.50+v.51+v.52, v.49+(2)\
*v.50+(2)*v.51+(2)*v.52, v.49+v.51+v.52, v.50+v.51+(2)*v.52, v.49+(2)*v.50+(2)*v.51+(4)*v.52, v.49\
+v.50+v.51+v.52, v.49+(2)*v.50+(3)*v.51+(4)*v.52, v.49+v.50+v.51+(2)*v.52, (2)*v.49+(2)*v.50+(3)*v\
.51+(4)*v.52, v.49+v.50+(2)*v.51+(2)*v.52, v.49+v.50+(2)*v.51+(3)*v.52, v.49+(2)*v.50+(2)*v.51+(3)\
*v.52 ]"=tmp;
Print("\t[",positiveRootTest,"] testing Cocharacters(UnderlyingLieAlgebra(sys))\n");

Print("\t[TODO] testing TorusWeightOnRoot\n");
Print("\t[TODO] testing RootReflections\n");
Print("\t[TODO] testing PositiveTorusPermutation\n");
Print("\t[TODO] testing PermutationMatrix\n");
Print("\t[TODO] testing RootGraph\n");
Print("\t[TODO] testing LatexRootGraph\n");


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

_B_dct1 := n -> let(j:=Ind(n), VStack(
    RowVec(diagDirsum(FList(TReal, [2,1]), fConst(TReal, n-2, 0.0))),
    HStack(ColVec(fConst(TReal, n-3, 0.0)),
           RowTensor(n-3, 1, Mat([[1,1]])),
           ColVec(fConst(TReal, n-3, 0.0))),
    RowVec(diagDirsum(fConst(TReal, n-2, 0.0), FList(TReal, [1, 2]))),
    RowVec(Lambda(j, cond(neq(imod(j, 2),0), -1, 1)))
));

RulesFor(DCT1, rec(
    #F DCT1_Base2: (base case for size 2)
    #F
    #F   DCT1_2 = F_2        (scaled)
    #F
    DCT1_Base2 := rec(
	info             := "DCT_1 -> F_2",
	forTransposition := false,
	isApplicable     := P -> P[1]=2,
	allChildren      := P -> [[]],
	rule             := (P, C) -> F(2)
    ),

    #F DCT1_Base4: DCT1_4 = (M tensor F_2) ^ P
    #F
    DCT1_Base4 := rec(
	info             := "DCT_1 -> (M tensor F_2)^P",
	forTransposition := false,
	isApplicable     := P -> P[1]=4,
	allChildren      := P -> [[]],
	rule := (P, C) ->
	    Tensor(Mat([[1, 1], [1, -1/2]]), F(2)) ^ Perm((2,4), 4)
    ),

    #F DCT1_DCT1and3: 1984
    #F
    #F   DCT1_(n+1) = perm * (DCT1_(n/2+1) dirsum DCT3_n/2 ^ perm) *
    #F             (1 tensor DFT_2)^perm
    #F
    #F   Wang:
    #F     Fast Algorithms for the Discrete W Transform and the
    #F     Discrete Fourier Transform.
    #F     IEEE Trans. on ASSP, 1984, pp. 803--814
    #F
    DCT1_DCT1and3 := rec (
	info             := "DCT1_n --> DCT1_n/2, DCT3_n/2",
	isApplicable     := P -> (P[1] - 1) mod 2 = 0,
	allChildren := P ->
	    When(P[1]=3, [[ DCT1(2) ]],
		      [[ DCT1((P[1]+1)/2), DCT3((P[1]-1)/2) ]]),

	rule := (P, C) ->
	    When(P[1]=3,
		perm2(3) *
		DirectSum(C[1], I(1)) *
		DirectSum(I(1), F(2)) ^ perm4(3),

		perm2(P[1]) *
		DirectSum(C[1], C[2] ^ J((P[1]-1)/2)) *
		DirectSum(I(1), Tensor(I((P[1]-1)/2), F(2))) ^ perm4(P[1]))
    ),

    DCT1_toDCT2 := rec(
        isApplicable := P -> P[1] > 5,
        allChildren := P -> [[DCT2(P[1]-1)]],
        rule := (P, C) ->  let(
            n := P[1], j := Ind(n-1), nn := n-1,
            DirectSum(Diag(Lambda(j, 1/(2*cospi(fdiv(j, 2*nn))))) *
                      C[1], I(1)) *
            _B_dct1(n)
        )
    )
));


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

################################################################################
##
#F compute_fusion_rules(<list>,<number>). . . . . . . .use verlinde to compute N
##
InstallGlobalFunction(compute_fusion_rules, function(S,FPdimC)
  local N,r,i,j,k,m;
  r:=Length(S[1]);
  N:=List([1..r],i->NullMat(r,r));
  for i in [1..r] do
    for j in [1..r] do
      for k in [1..r] do
        for m in [1..r] do
          N[i][j][k]:=N[i][j][k]+S[i][m]*S[j][m]*ComplexConjugate(S[k][m])/S[1][m];
        od;
        N[i][j][k]:=N[i][j][k]/FPdimC;
      od;
    od;
  od;
  return N;
end);

################################################################################
##
#F display_fusion_rules(<list>). . . . . . . . . display the fusion rules
##
InstallGlobalFunction(display_fusion_rules, function(N)
  local x;
  for x in [1..Size(N)] do
    Print("\nN_",x,"\n");
    Display(N[x]);
  od;
  Print("\n");
end);

#E verlinde.gi . . . . . . . . . . . . . . . . . . . . . . . . . . . . ends here


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

#F IRDFT(<size>, [<normalized?>]) - Inverse RDFT, non-terminal
#F This is an obsolete inverse real DFT, plese use IPRDFT
#F
Class(IRDFT, NonTerminal, rec(
    abbrevs := [
	N -> Checked(IsInt(N), N > 1, [N, false]),
	(N, norm) -> Checked(IsInt(N), N > 1, IsBool(norm), [N, norm])
    ],
    ndiag := meth(self)
        local Ls, n;
	n := self.params[1];
	if self.params[2] then
	    Ls:=List([1..n], i->2/n);
	    Ls[1]:=1/n;
	    if (n mod 2 = 0) then Ls[n/2+1]:=1/n; fi;
	    return Diag(Ls);
	else return I(self.params[1]);
	fi;
    end,
    transpose := self >> let(exp := 1, Compose(self.ndiag(), RDFT(self.params[1]))),
    terminate := self >> TransposedSPL(TerminateSPL(self.transpose())),
    isReal := True,
    dims := self >> [self.params[1], self.params[1]],
    SmallRandom := () -> Random([2, 3, 4, 6, 8, 12, 16, 24, 32])
));

RulesFor(IRDFT, rec(
    #F IRDFT_Trigonometric: 1984
    #F
    #F   invRDFT_n = blocks * (DCT1_(n/2+1) dirsum DST1_(n/2-1))
    #F
    #F   Wang:
    #F     Fast Algorithms for the Discrete W Transform and the
    #F     Discrete Fourier Transform.
    #F     IEEE Trans. on ASSP, 1984, pp. 803--814
    #F   Britanak/Rao:
    #F     The fast generalized discrete Fourier transforms: A unified
    #F     approach to the discrete sinusoidal transforms computation.
    #F     Signal Processing 79, 1999, pp. 135--150
    #F
    IRDFT_Trigonometric := rec(
	info             := "IRDFT_n -> DCT1_(n/2+1), DST1_(n/2-1)",
	forTransposition := false,
	isApplicable     := P -> P[1] mod 2 = 0 and P[1] > 2,
	allChildren      := P -> [[ DCT1(P[1]/2 + 1), DST1(P[1]/2 - 1) ]],
	rule := (P, C) -> let(
	    n := P[1],
	    exp := 1, # should be an extra IRDFT parameter
	    normalized := P[2],

	    DirectSum(I(1), blocks1(n - 1)) *
	    DirectSum(C[1], exp * C[2] ^ J(n/2 - 1)) *
	    When(normalized,
		Diag(List([0..n-1], c -> When(c mod (n/2) = 0, 1/n, 2/n))),
		I(n)))
    )
));


mode := function(v)
  local c, m;
  c := Collected(SortedList(v));
  m := Maximum(List(c, x -> x[2]));
  return List(Filtered(c, x -> x[2] = m), y -> y[1]);
end;

mode([ 7, 5, 6, 1, 5, 5, 7, 12, 17, 6, 6, 5, 12, 3, 6 ]);
# [ 5, 6 ]


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

RulesFor(DCT3, rec(
    #F DCT3_Base2: DCT2_2 = F_2 * diag(1, 1/sqrt(2))
    #F
    DCT3_Base2 := rec (
	info             := "DCT3_2 -> F_2",
	isApplicable     := P -> P[1] = 2,
	rule := (P, C) -> F(2) * Diag(1, Sqrt(1/2))
    ),

    #F DCT3_Base3: DCT3_3 = (I_1 dirsum F_2)^P * (M dirsum c) * Q
    #F well-known, e.g.,
    #F   Pueschel/Moura: Discrete Cosine and Sine Transforms (in preparation)
    DCT3_Base3 := rec (
	info             := "DCT3_3 = (I_1 dirsum F_2)^P * (M dirsum c) * Q",
	isApplicable     := P -> P[1]=3,
	rule := (P, C) ->
            (DirectSum(I(1), F(2)) ^ Perm((1,2), 3)) *
	    DirectSum(Mat([[1, 1/2], [1, -1]]),
		      Diag(CosPi(1/6))) *
	    Perm((2,3), 3)
    ),

    #F DCT3_Base5: (possible base case for size 3)
    #F
    #F   DCT3_5 = P * (I_1 dirsum (SkewDCT3_2's * (pDCT8_2 tensor I_2) * B
    #F
    #F   Pueschel/Moura: Discrete Cosine and Sine Transforms, in preparation
    #F
    DCT3_Base5 := rec (
	info             := "DCT3_5 -> SkewDCT3_2's, pDCT8_2",
	isApplicable     := P -> P[1]=5,
	allChildren := P -> [[ SkewDTT(DCT3(2), 1/5),
		               SkewDTT(DCT3(2), 3/5),
			       PolyDTT(DCT8(2)) ]],
	rule := (P, C) ->
	    Perm((1,2,4,5,3), 5) *
	    DirectSum(I(1),
		      DirectSum(C[1], C[2]) * Tensor(C[3], I(2))) *
	    Mat([ [  1,   0,   -1,   0,    1 ],
		  [  1,   0,  1/2,   0,    0 ],
		  [  0,   1,    0,   0,    0 ],
		  [  0,   0,  1/2,   0,  1/2 ],
		  [  0,   0,    0,   1,    0 ] ])
    ),

    #F DCT3_Orth9: DCT3_9 = hand-derived radix-3 Cooley-Tukey for RDFT
    #F
    DCT3_Orth9 := rec (
	info             := "DCT3_9 -> TRDFT_3's",
	isApplicable     := P -> P[1] = 9,
	allChildren := P -> [ [ RDFT(3).transpose() ] ],
	rule := (P, C) ->
	   Perm( (1,5)(2,7,8,4,9,6), 9 ) *
	   Tensor(C[1],	I(3)) *
	   DirectSum(
	       I(3),
	       (DirectSum(I(2), Rot(2/9), Rot(4/9))) ^ Perm((2,4,5,3), 6)) *
	   Tensor(I(3), C[1]) *
	   DirectSum(
	       I(3),
	       Mat([ [ 1,  0,  0, 0, 0, 0 ],
		     [ 0,  1,  0, 0, 0, 1 ],
		     [ 0,  0,  1, 0, 1, 0 ],
		     [ 0,  0,  0, 1, 0, 0 ],
		     [ 0,  0, -1, 0, 1, 0 ],
		     [ 0, -1,  0, 0, 0, 1 ] ])) *
	   Diag(1, -1, 1, -1, 1, -1, 1, -1, 1) *
	   Perm( (2,7,8)(3,4)(5,9), 9 )
    ),

    #F DCT3_toSkewDCT3:  DCT3_n = DCT3_n(1/2)
    #F
    DCT3_toSkewDCT3 := rec (
	info             := "DCT3_n -> SkewDCT3_n(1/2)",
	forTransposition := false,
	isApplicable     := P -> IsPrimePowerInt(P[1]) and P[1] mod 2 = 0 and P[1] > 2,
	allChildren := P -> [ [ SkewDTT(DCT3(P[1]), 1/2) ] ],
	rule := (P, C) -> C[1]
    )
));


# The Grassmann graph J_q(n, d) of d-dimensional subspaces of F_q^n.
BindGlobal("GrassmannGraph", function(q, n, d)
    local G;
    G := SubspaceGraph(GL(n, q), Elements, GF(q)^n, d, true);
    G.duality := GrassmannDualityFunction;
    G.primality := GrassmannDualityFunction;
    return G;
end);

# The doubled Grassmann graph 2J_q(2d+1, d) of d- and (d+1)-dimensional
# subspaces of F_q^{2d+1}.
BindGlobal("DoubledGrassmannGraph", function(q, d)
    local n, G, V, dp;
    n := 2*d+1;
    V := GF(q)^n;
    dp := DirectProduct(GL(n, q), Group((1, 2)));
    G := Graph(dp, Union(Subspaces(V, d), Subspaces(V, d+1)),
                OnDoubledGrassmann(V, dp), SymmetrizedInclusion, true);
    G.halfDuality := GrassmannDualityFunction;
    G.halfPrimality := GrassmannDualityFunction;
    return G;
end);

# The twisted Grassmann graph TG_d(q) of (d+1)-dimensional subspaces of
# F_q^{2d+1} which are not subspaces of a hyperplane H, and (d-1)-dimensional
# subspaces of H.
BindGlobal("TwistedGrassmannGraph", function(d, q)
    local F, H, S, V, n;
    n := 2*d+1;
    F := GF(q)^n;
    H := Subspace(F, CanonicalBasis(F){[1..n-1]}, "basis");
    V := Union(Filtered(Subspaces(F, d+1), x -> not IsSubset(H, x)),
            Subspaces(H, d-1));
    S := OnSubspaces(F);
    return Graph(Stabilizer(GL(n, q), H, S), V, S, function(x, y)
        local dx;
        dx := Dimension(x);
        if dx = Dimension(y) then
            return Dimension(Intersection(x, y)) = dx-1;
        else
            return IsSubset(x, y) or IsSubset(y, x);
        fi;
    end, true);
end);

# The polar graph O^{(+/-)}(d, q) of isotropic lines of F_q^d
# with respect to a nondegenerate quadratic form.
BindGlobal("PolarGraphO", function(arg)
    local d, e, q, B, G, H, Q, V;
    if Length(arg) < 2 then
        Error("at least two arguments expected");
        return fail;
    elif Length(arg) = 2 then
        e := 0;
        d := arg[1];
        q := arg[2];
    else
        e := arg[1];
        d := arg[2];
        q := arg[3];
    fi;
    G := GO(e, d, q);
    Q := InvariantQuadraticForm(G).matrix;
    B := Q + TransposedMat(Q);
    V := GF(q)^d;
    H := Graph(G, IsotropicSpacesQuadraticForm(Q)(Subspaces(V, 1)),
                OnSubspaces(V), function(x, y)
                    return x <> y and IsZero(Elements(x)[2]*B*Elements(y)[2]);
                end, true);
    H.duality := Sum;
    H.primality := Intersection;
    return H;
end);

# The polar graph NO^{+/-}orth(d, q) of nonisotropic lines of F_q^d
# with respect to a nondegenerate quadratic form.
BindGlobal("PolarGraphNOorth", function(e, d, q)
    local f, z, B, G, H, Q, V;
    if d mod 2 = 1 then
        f := 0;
        if q mod 4 = 3 and d mod 4 = 1 then
            e := -e;
        fi;
    else
        f := e;
    fi;
    G := GO(f, d, q);
    Q := InvariantQuadraticForm(G).matrix;
    B := Q + TransposedMat(Q);
    V := GF(q)^d;
    z := Z(q)^((1-e)/2);
    H := Graph(G, NonisotropicSpacesQuadraticForm(Q, z)(Subspaces(V, 1)),
                OnSubspaces(V), function(x, y)
                    return x <> y and IsZero(Elements(x)[2]*B*Elements(y)[2]);
                end, true);
    return H;
end);

# The polar graph Sp(d, q) of isotropic lines of F_q^d
# with respect to a nondegenerate symplectic form.
BindGlobal("PolarGraphSp", function(d, q)
    local G, H, Q, V;
    G := Sp(d, q);
    Q := InvariantBilinearForm(G).matrix;
    V := GF(q)^d;
    H := Graph(G, IsotropicSpacesQuadraticForm(Q)(Subspaces(V, 1)),
                OnSubspaces(V), function(x, y)
                    return x <> y and IsZero(Elements(x)[2]*Q*Elements(y)[2]);
                end, true);
    H.duality := Sum;
    H.primality := Intersection;
    return H;
end);

# The polar graph U(d, r) of isotropic lines of F_{r^2}^d
# with respect to a nondegenerate Hermitean form.
BindGlobal("PolarGraphU", function(d, r)
    local c, B, F, G, H, Q, V;
    G := GU(d, r);
    Q := InvariantSesquilinearForm(G).matrix;
    V := GF(r^2)^d;
    B := Elements(CanonicalBasis(V));
    c := Conjugates(GF(r^2), GF(r), Z(r^2));
    F := x -> List(x, y -> y^r);
    H := Graph(G, IsotropicSpacesSesquilinearForm(Q, r)(Subspaces(V, 1)),
            OnSubspaces(V), function(x, y)
                return x <> y and IsZero(Elements(x)[2]*Q*F(Elements(y)[2]));
            end, true);
    H.duality := Sum;
    H.primality := Intersection;
    return H;
end);

# The dual polar graph B_d(q) of isotropic d-dimensional subspaces of
# F_q^{2d+1} with respect to a nondegenerate quadratic form.
BindGlobal("DualPolarGraphB", function(d, q)
    local F, G, S, e, z, invt;
    e := 2*d+1;
    F := GF(q)^e;
    G := GO(e, q);
    if q mod 2 = 1 then
        invt := true;
        S := IsotropicSpacesQuadraticForm(InvariantQuadraticForm(G).matrix);
    else
        invt := false;
        S := [Subspace(F, Elements(CanonicalBasis(F)){[2..d+1]}, "basis")];
    fi;
    return SubspaceGraph(G, S, F, d, invt);
end);

# The dual polar graph C_d(q) of isotropic d-dimensional subspaces of
# F_q^{2d} with respect to a nondegenerate symplectic form.
BindGlobal("DualPolarGraphC", function(d, q)
    local F, e;
    e := 2*d;
    F := GF(q)^e;
    return SubspaceGraph(Sp(e, q),
        [Subspace(F, Elements(CanonicalBasis(F)){[1..d]}, "basis")],
        F, d, false);
end);

# The dual polar graph D_d(q) of isotropic d-dimensional subspaces of
# F_q^{2d} with respect to a nondegenerate quadratic form of Witt index d.
BindGlobal("DualPolarGraphD", function(d, q)
    local F, G, S, e, invt;
    e := 2*d;
    F := GF(q)^e;
    G := GO(1, e, q);
    if q mod 2 = 1 then
        invt := true;
        S := IsotropicSpacesQuadraticForm(InvariantQuadraticForm(G).matrix);
    else
        invt := false;
        S := [Subspace(F, Elements(CanonicalBasis(F)){[1,3..e-1]}, "basis")];
    fi;
    return SubspaceGraph(G, S, F, d, invt);
end);

# The dual polar graph ^2D_{d+1}(q) of isotropic d-dimensional subspaces of
# F_q^{2d+2} with respect to a nondegenerate quadratic form of Witt index d.
BindGlobal("DualPolarGraph2D", function(d, q)
    local G, e;
    e := 2*d+2;
    G := GO(-1, e, q);
    return SubspaceGraph(G,
        IsotropicSpacesQuadraticForm(InvariantQuadraticForm(G).matrix),
        GF(q)^e, d);
end);

# The dual polar graph ^2A_{e-1}(r) of isotropic [e/2]-dimensional
# subspaces of F_{r^2}^e with respect to a nondegenerate Hermitean form.
BindGlobal("DualPolarGraph2A", function(e, r)
    local B, F, c, d;
    F := GF(r^2)^e;
    B := Elements(CanonicalBasis(F));
    c := Conjugates(GF(r^2), GF(r), Z(r^2));
    d := Int(e/2);
    return SubspaceGraph(GU(e, r),
        [Subspace(F, B{[1..d]} + (c[1]-c[2])*B{e+1-[1..d]}, "basis")],
        F, d, false);
end);

# The Doro graph of nonisotropic 1-dimensional subspaces of F_q^4 with respect
# to a nondegenerate quadratic form. It is distance-regular for q = 4, 5.
BindGlobal("DoroGraph", function(q)
    local G, V;
    V := GF(q)^4;
    G := GO(-1, 4, q);
    return Graph(G, [Subspace(V, BasisVectors(Basis(V)){[4]}, "basis")],
        OnSubspaces(V), IsHyperbolic(InvariantQuadraticForm(G).matrix));
end);

# The unitary nonisotropics graph of 1-dimensional subspaces of F_(r^2)^3 with
# respect to a nondegenerate sesquilinear form.
BindGlobal("UnitaryNonisotropicsGraph", function(r)
    local G, V;
    V := GF(r^2)^3;
    G := GU(3, r);
    return Graph(G, [Subspace(V, BasisVectors(Basis(V)){[2]}, "basis")],
        OnSubspaces(V), IsOrthogonal(InvariantSesquilinearForm(G).matrix, r));
end);


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

DCTDiag  := n -> Diag(diagDirsum(fConst(1,1/Sqrt(n)), fConst(n-1, Sqrt(2/n))));
DCTDiag2 := n -> Diag(diagDirsum(fConst(1,1/n), fConst(n-1, 2/n)));

#ForwardDCT := DCT2;

Class(InverseDCT, DTTBase, rec(
    terminate := self >> DCT3(self.params[1]).terminate() * DCTDiag2(self.params[1]),
#    transpose := self >> DCTDiag2(self.params[1]) * DCT2(self.params[1]),
));

RulesFor(InverseDCT, rec(
     InverseDCT_toDCT3 := rec(
	 isApplicable     := P -> true,
	 allChildren      := P -> [[ DCT3(P[1]) ]],
	 rule := (P, C) -> C[1] * DCTDiag2(P[1])
     )
));


# The field addition group as a permutation group.
BindGlobal("FieldAdditionPermutationGroup",
    q -> Group(List(Elements(Basis(GF(q))),
        g -> Permutation(g, GF(q), function(x, y) return x+y; end)))
);

# The field multiplication group as a permutation group.
BindGlobal("FieldMultiplicationPermutationGroup",
    q -> CyclicGroup(IsPermGroup, q-1)
);

# The field exponentiation group as a permutation group.
BindGlobal("FieldExponentiationPermutationGroup",
    q -> Action(Group(FrobeniusAutomorphism(GF(q))), GF(q))
);

# The group of even permutations of columns of a matrix
# as a permutation group over matrix elements.
BindGlobal("MatrixColumnEvenPermutationGroup", function(d, e)
    return Action(AlternatingGroup(e), Cartesian([1..d], [1..e]),
        function(x, g)
            return [x[1], OnPoints(x[2], g)];
        end);
end);

# The group of permutations of columns of a matrix
# as a permutation group over matrix elements.
BindGlobal("MatrixColumnPermutationGroup", function(d, e)
    return Action(SymmetricGroup(e), Cartesian([1..d], [1..e]),
        function(x, g)
            return [x[1], OnPoints(x[2], g)];
        end);
end);

# The group of simultaneous permutations of rows and columns
# of a square matrix as a permutation group over matrix elements.
BindGlobal("MatrixRowColumnPermutationGroup", function(d)
    return Action(SymmetricGroup(d), Cartesian([1..d], [1..d]), OnTuples);
end);

# The wreath product of two symmetric groups.
BindGlobal("WreathProductSymmetricGroups", function(m, n)
    local g;
    if not (IsInt(m) and IsInt(n) and m >= 0 and n >= 0) then
        Error("m or n not a nonnegative integer");
        return fail;
    fi;
    if m <= 1 then
        return SymmetricGroup(n);
    elif n <= 1 then
        return SymmetricGroup(m);
    fi;
    g := Concatenation(GeneratorsOfGroup(SymmetricGroup(m)),
                        [PermList(Concatenation([m+1..2*m], [1..m]))]);
    if n > 2 then
        Add(g, PermList(Concatenation([m+1..n*m], [1..m])));
    fi;
    return Group(g);
end);

# The automorphism group of a (hyper)conic
# in a Desarguesian projective plane of order q.
BindGlobal("HyperconicAutomorphismGroup", q -> Group([
    [[-Z(q)^0, 0*Z(q), 0*Z(q)],
     [ 0*Z(q), 0*Z(q), Z(q)^0],
     [ 0*Z(q), Z(q)^0, 0*Z(q)]],
    [[-Z(q)^0, 0*Z(q), -2*Z(q)^0],
     [ Z(q)^0, Z(q)^0,   Z(q)^0],
     [ 0*Z(q), 0*Z(q),   Z(q)^0]],
    [[-Z(q),   0*Z(q), -2*Z(q)^0],
     [ Z(q),   Z(q)^2,   Z(q)^0],
     [ 0*Z(q), 0*Z(q),   Z(q)^0]],
    Z(q)*IdentityMat(3, GF(q))
]));


# The Kneser graph on k-subsets of a set with n elements.
BindGlobal("KneserGraph", function(arg)
    local n, k, invt, vcs;
    if Length(arg) < 2 then
        Error("at least two arguments expected");
        return fail;
    else
        n := arg[1];
        k := arg[2];
        if Length(arg) > 2 then
            invt := arg[3];
        else
            invt := true;
        fi;
    fi;
    if invt then
        vcs := Combinations([1..n], k);
    else
        vcs := [[1..k]];
    fi;
    return Graph(SymmetricGroup(n), vcs, OnSets, DisjointSets);
end);

# The Odd graph of diameter d on 2*d+1 points.
BindGlobal("OddGraph", d -> KneserGraph(2*d+1, d, false));

# The doubled Odd graph on 2*d+1 points.
BindGlobal("DoubledOddGraph", function(d)
    local n, dp;
    n := 2*d+1;
    dp := DirectProduct(SymmetricGroup(n), SymmetricGroup(2));
    return Graph(dp, Union(Combinations([1..n], d), Combinations([1..n], d+1)),
                    OnDoubledOdd(n, dp), SymmetrizedInclusion, true);
end);

# The folded Johnson graph.
BindGlobal("FoldedJohnsonGraph",
    d -> AntipodalQuotientGraph(JohnsonGraph(2*d, d))
);

# The three Chang graphs with v=28, k=12, lm=6, mu=4
BindGlobal("ChangGraph", function(j)
    local J, S, Ss;
    Ss := [List([1..4], i -> [i, i+4]),
           Set(List([1..8], i -> Set([i, (i mod 8)+1]))),
           Union(List([1..3], i -> Set([i, (i mod 3)+1])),
                 List([1..5], i -> Set([i+3, (i mod 5)+4])))];
    J := JohnsonGraph(8, 2);
    S := List(Ss[j], x -> Position(J.names, x));
    return SwitchedGraph(J, S, Stabilizer(J.group, S, OnSets));
end);


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

NewRulesFor(DFT, rec(

    DFT_PD := rec(
        forTransposition := false,
        maxSize          := 13,

        core := meth(self, N, k, root, is_real)
            local coeffs, l1, l2, n, circ, toep;
            coeffs := List([0..N-2], x->E(N)^(k*root^(-x) mod N));
            n := N-1;
            l1 := coeffs{[1..n/2]};
            l2 := coeffs{[n/2+1..n]};
            circ := 1/2 * (l1 + l2);
            toep := Reversed(1/2 * Concat(Drop(l2 - l1, 1), l1 - l2));
            if is_real then toep := toep / E(4); fi;
            return
            DirectSum(I(1),
                  transforms.filtering.Circulant(circ).terminate(),
                  transforms.filtering.Toeplitz(toep).terminate());
        end,

        A := N -> let(nn := (N-1)/2, ones := m -> fConst(m, 1),
             VStack(HStack(RowVec(ones(nn+1)), O(1, nn)),
               HStack(VStack(-2*ColVec(ones(nn)), O(nn, 1)), I(2*nn)))),

        applicable     := (self, nt) >> nt.params[1] > 2 and nt.params[1] <= self.maxSize and IsPrime(nt.params[1]) and not nt.hasTags(),

        apply := (self,nt,C,cnt) >> let(N := nt.params[1], k := nt.params[2], root := PrimitiveRootMod(N),
            Scat(RR(N, 1, root)) *
            DirectSum(I(1), Tensor(F(2), I((N-1)/2))) *
            Mat(MatSPL(
                self.core(N, k, root, false) *
                self.A(N))) *
            DirectSum(I(1), Tensor(F(2), I((N-1)/2))) *
    #        DirectSum(I(1), OS(N-1, -1)) *
            Gath(RR(N, 1, 1/root mod N))
        )
#D    isApplicable     := (self, P) >> P[1] > 2 and P[1] <= self.maxSize and IsPrime(P[1]) and P[3] = [],
#D
#D    rule := (self,P,C) >> let(N := P[1], k := P[2], root := PrimitiveRootMod(N),
#D        Scat(RR(N, 1, root)) *
#D        DirectSum(I(1), Tensor(F(2), I((N-1)/2))) *
#D        Mat(MatSPL(
#D            self.core(N, k, root, false) *
#D            self.A(N))) *
#D        DirectSum(I(1), Tensor(F(2), I((N-1)/2))) *
#D#        DirectSum(I(1), OS(N-1, -1)) *
#D        Gath(RR(N, 1, 1/root mod N))
#D    )
    )
));


Filtered([1 .. 10000], n -> Sum(DivisorsInt(n)) = 2*n);
# [ 6, 28, 496, 8128 ]


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

# Convention: N - range
#             n - domain

## H(<N>,<n>,<base>,<stride>)
##    Stride index mapping: i -> base + stride * i
#
Class(H, FuncClass, rec(
    def := (N,n,base,stride) -> rec(),
    domain := self >> self.params[2],
    range := self >> self.params[1],
    lambda := self >> let(
	base := self.params[3], str := self.params[4], i := Ind(self.params[2]),
	Lambda(i, base + str * i))
));

# HZ(<N>,<n>,<base>,<stride>)
##    Mod-stride index mapping: i -> (base + stride * i) mod N
##
Class(HZ, FuncClass, rec(
    isCyclic := true,

    def := (N,n,base,str) -> rec(),
    domain := self >> self.params[2],
    range := self >> self.params[1],

    lambda := self >> let(
	n := self.params[2], N := self.params[1], base := self.params[3], str := self.params[4],
	i := Ind(n),
	ii := When(str * n = N, no_mod(i), i), # condition to omit the mod is str*n = N
	Lambda(i, imod(base + str * ii, N)))
));

#F RM(<N>,<n>,<phi>,<g>)
##    Exponential index mapping: i -> (phi * g^i) mod N
##    <g> - generating element for integers mod <N>.
##    <phi> - "phase"
##
Class(RM, FuncClass, rec(
    isCyclic := true,
    abbrevs := [ N    -> [N, N-1, 1, PrimitiveRootMod(N)],
	        (N,n) -> [N, n,   1, PrimitiveRootMod(N)] ],

    domain := self >> self.params[2],
    range := self >> self.params[1],
    def := (N,n,phi,g) -> Checked(IsPosIntSym(N), IsPosIntSym(n), n <= N, rec()),

    lambda := self >> let(
	phi := self.params[3], g := self.params[4], i := Ind(self.params[2]),
	Lambda(i, powmod(phi, g, i, self.params[1]))),
));

#F RR(<N>,<phi>,<g>)
##    Rader permutation: i -> {    0,     if i = 0 }
##                            { RM(i-1),  if i > 0 }
##    <phi> and <g> are parameters to RM
##
Class(RR, PermClass, rec(
    isCyclic := true,

    abbrevs := [ N -> [N,1,PrimitiveRootMod(N)] ],

    def := (N,phi,g) -> Checked(IsPosInt(N), IsPrime(N), rec()),

    domain := self >> self.params[1],
    range := self >> self.params[1],

    # alternatively cond(i, imod(phi * pow(g, i-1), N), 0) we do g^-1 for easier poweropt
    lambda  := self >> let(
	N := self.params[1], phi := self.params[2], g := self.params[3], i:= Ind(N),
	When(not self.transposed,
	    Lambda(i, cond(i, powmod(phi*(g^-1 mod N) mod N, g, i, N), 0)),
	    Lambda(i, cond(i, 1+ilogmod(cond(i,i,1)/phi mod N, g, N), 0)))
    )
));


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

Local.qmat := Mat(
    [[1,1,1],
     [1,-1,0],
     [1,0,-1]]
);
Local.wmat := Mat(
    [[1,0,1],
     [0,1,0],
     [0,0,1]]);

## C3 = DCT-3
## C4 = DCT-4
## S3 = DST-3
## S4 = DST-4

RulesFor(DTT, rec(
    #
    # DCT-3
    #
    DTT_C3_Base2 := SimpleRule(
	[ DTT_C3, 2, @, @ ],
	(P, C) -> F(2) * Diag(1, cospi(P[3]))
    ),
    DTT_IC3_Base2 := SimpleRule(
	[ DTT_IC3, 2, @, @ ],
	(P, C) -> Diag(1, 1/(2*cospi(P[3]))) * F(2)
    ),
    DTT_C3_Base3 := SimpleRule(
	[ DTT_C3, 3, @, @ ],
	(P, C) -> let(r:=P[3],
	    qmat * DirectSum(I(1), Mat([[ cospi((1+r)/3),  cospi((1-2*r)/3) ],
			             [ cospi((1-r)/3),  cospi((1+2*r)/3) ]])))
    ),
    DTT_C3_Base3 := SimpleRule(
	[ DTT_C3, 3, @, @ ],
	(P, C) -> let(r:=P[3],
	    DirectSum(I(1),
		      1/sinpi(r) *
		      Mat([[ cospi(( 1-2*r)/6),  sinpi((-1+2*r)/3) ],
			   [ cospi((-1+2*r)/6),  cospi(( 1-2*r)/3) ]]) *
		      Mat([[0, sqrt(3)/2],
			   [1, -1/2]]))
	    * qmat)
    ),

    #
    # DST-3
    #
    DTT_S3_Base2 := SimpleRule(
	[ DTT_S3, 2, @, false ],
	(P, C) -> let(r:=P[3],  F(2) * Diag(sinpi(r/2), sinpi(r)))
    ),
    DTT_S3Poly_Base2 := SimpleRule(
	[ DTT_S3, 2, @, true ],
	(P, C) -> let(r:=P[3],  F(2) * Diag(1, 2*cospi(r/2)))
    ),
    DTT_S3Poly_Base3 := SimpleRule(
	[ DTT_S3, 3, @, true ],
	(P, C) -> let(r:=P[3],
	    qmat * DirectSum(I(1), 2* Mat([[ cospi((1+r)/3),  cospi((1-2*r)/3) ],
	       	                           [ cospi((1-r)/3),  cospi((1+2*r)/3) ]]) * wmat))
    ),
    DTT_S3_Base2 := SimpleRule(
	[ DTT_S3, 2, @, false ],
	(P, C) -> let(r:=P[3],  F(2) * Diag(sinpi(r/2), sinpi(r)))
    ),

    #
    # DCT-4
    #
    DTT_C4_Base2 := SimpleRule(
	[ DTT_C4, 2, @, false ],
	(P, C) -> let(r:=P[3],  Mat([[cospi(r/4), cospi(3*r/4)],
		                     [sinpi(r/4), -sinpi(3*r/4)]]))
    ),
    DTT_C4_Base2_LS := SimpleRule(
	[ DTT_C4, 2, @, false ],
	(P, C) -> let(r:=P[3],  Diag(cospi(r/4), sinpi(r/4)) * F(2) * Mat([[1,-1],[0,2*cospi(r/2)]]))
    ),
    DTT_C4Poly_Base2 := SimpleRule(
	[ DTT_C4, 2, @, true ],
	(P, C) -> let(r:=P[3],  F(2) * Mat([[1,-1],[0,2*cospi(r/2)]]))
    ),

    #
    # DST-4
    #
    DTT_S4_Base2 := SimpleRule(
	[ DTT_S4, 2, @, false ],
	(P, C) -> let(r:=P[3],  Mat([[sinpi(r/4), sinpi(3*r/4)],
		                     [cospi(r/4), -cospi(3*r/4)]]))
    ),
    DTT_S4_Base2_LS := SimpleRule(
	[ DTT_S4, 2, @, false ],
	(P, C) -> let(r:=P[3],  Diag(sinpi(r/4), cospi(r/4)) * F(2) * Mat([[1,1],[0,2*cospi(r/2)]]))
    ),
    DTT_S4Poly_Base2 := SimpleRule(
	[ DTT_S4, 2, @, true ],
	(P, C) -> let(r:=P[3],  F(2) * Mat([[1,1],[0,2*cospi(r/2)]]))
    ),

    #
    # Recursive rules
    #
    DTT_DIF_T := rec(
	isApplicable     := P -> not IsPrime(P[2]) and P[2] > 2,
	forTransposition := false,

	baseChange := (self, P, m) >> let(t := P[1], mn := P[2],
	    Cond(Same(t, DTT_C3), B_DCT3_U(mn, m),
		 Same(t, DTT_C4), B_DCT4_U(mn, m),
		 Same(t, DTT_S3), B_DST3_U(mn, m),
		 Same(t, DTT_S4), B_DST4_U(mn, m))),

	recursType := (self, t) >>
	    Cond(Same(t, DTT_C3), DTT_S3,
		 Same(t, DTT_C4), DTT_S3,
		 Same(t, DTT_S3), DTT_S3,
		 Same(t, DTT_S4), DTT_S3),

	allChildren      := (self,P) >> let(
	    type := P[1], MN := P[2], r := P[3],  poly := P[4],
	    divs := DivisorPairs(MN),
	    List(divs, d -> let(j := Ind(d[2]),
		[ DTT(type,                     d[1], fr(d[2], j, r), poly),
		  DTT(self.recursType(type),    d[2], r,              true) ]))),

	rule := (self, P, C, Nonterms) >> let(MN := P[2], N := Rows(C[1]), M := Rows(C[2]),
	                 j := Nonterms[1].params[3].args[2],
	    K(MN, N) *
	    IterDirectSum(j, j.range, C[1]) *
	    Tensor(C[2], I(N)) *
	    self.baseChange(P, M)
	)
    )
));


# Built-in
Combinations([1 .. n], m);

Combinations([1 .. 5], 3);
# [ [ 1, 2, 3 ], [ 1, 2, 4 ], [ 1, 2, 5 ], [ 1, 3, 4 ], [ 1, 3, 5 ],
#   [ 1, 4, 5 ], [ 2, 3, 4 ], [ 2, 3, 5 ], [ 2, 4, 5 ], [ 3, 4, 5 ] ]


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

# assuming the angles 2pi*a
alpha2pi := (n,i,a) -> Cond(i mod 2 = 0, (a + Int(i/2))/n, (1-a + Int(i/2))/n);

Mat_rDFT := (N,a,k) -> let(n:=N/2,
     ConcatList([0..n-1], i -> let(aa := alpha2pi(n,i,a), [
        Concatenation(     List([0..n-1], j -> cospi(k*2*j*aa)),
                    (-1)^i*List([0..n-1], j -> -sinpi(k*2*j*aa))),
        Concatenation(     List([0..n-1], j -> sinpi(k*2*j*aa)),
                    (-1)^i*List([0..n-1], j -> cospi(k*2*j*aa))) ])));

Mat_nrDFT := (N,a,k) -> let(n:=N/2,
     ConcatList([0..n-1], i -> let(
        raw := (i+a)/n,
        sign := When(raw > 1/2, -1, 1) * When(a > 1/2, -1, 1),
        aa := When(raw > 1/2, 1-raw, raw), [
        Concatenation(     List([0..n-1], j -> cospi(k*2*j*aa)),
                      sign*List([0..n-1], j -> -sinpi(k*2*j*aa))),
        Concatenation(     List([0..n-1], j -> sinpi(k*2*j*aa)),
                      sign*List([0..n-1], j -> cospi(k*2*j*aa))) ])));

_row_BRDFT_13 := (n,u,k) -> let(s := 1/sinpi(k*2*u),
   [ List([0..n-1], j -> -s*sinpi(k*2*u*(j-1))),
     List([0..n-1], j ->  s*sinpi(k*2*u*j)) ]);

# scaled = 2*cospi(u) * unscaled
# since 2*cospi(u) / sinpi(2*u) = 1/sinpi(u)
#
_row_BRDFT_24 := (n,u, k,scaled) -> let(s := When(scaled, 1/sinpi(k*u), 1/sinpi(k*2*u)),
   [ List([0..n-1], j -> -s*sinpi(k*2*u*(j-1/2))),
     List([0..n-1], j ->  s*sinpi(k*2*u*(j+1/2))) ]);

# F.T. for the polynomial algebra below, basis in time = (1, x, ..., x^(n-1))
#   R[x] / x^n - 1
#
Mat_BRDFT1 := (n,k) -> When(IsEvenInt(n),
   Concatenation(
       [List([0..n-1], i-> 1)],
       [List([0..n-1], i-> (-1)^i)],
       ConcatList([1..n/2-1], i -> _row_BRDFT_13(n, i/n, k))),
   Concatenation(
       [List([0..n-1], i-> 1)],
       ConcatList([1..(n-1)/2], i -> _row_BRDFT_13(n, i/n, k)))
);

Mat_BRDFT1U := (n,k) -> When(IsOddInt(n), Mat_BRDFT1(n),
   Concatenation(
       [List([0..n-1], i-> When(IsEvenInt(i), 1, 0))],
       [List([0..n-1], i-> When(IsEvenInt(i), 0, 1))],
       ConcatList([1..n/2-1], i -> _row_BRDFT_13(n, i/n, k))));

# -- i1 dst1 / dst1 i1
# -- i1 dst5 / dst5

# F.T. for the polynomial algebra below, basis in time = (x^(1/2),x^(3/2),..., x^(n-1/2))
#   R[x] / x^n - 1
#
Mat_BRDFT2 := (n,k,scaled) -> When(IsEvenInt(n),
   Concatenation(
       [List([0..n-1], i-> 1)],
       [List([0..n-1], i-> (-1)^i)],
       ConcatList([1..n/2-1], i -> _row_BRDFT_24(n, i/n, k, scaled))),
   Concatenation(
       [List([0..n-1], i-> 1)],
       ConcatList([1..(n-1)/2], i -> _row_BRDFT_24(n, i/n, k, scaled))));
# - dct2/dst2 dst2/dst2 - breaks?
# - i1 dst6 dst6 -- ok
# - i1 dst5 dst5 -- ok

# F.T. for the polynomial algebras below, basis in time = (1,x,..., x^(n-1))
# u = 1/4, n - even or odd
#   R[x] / x^n + 1
#
# u <> 1/4, n - even ("skew" BRDFT3)
#   R[x] / x^n - 2cos(2*pi*u) x^(n/2) + 1
#
Mat_BRDFT3 := (n, u, k) -> When(IsEvenInt(n),
   ConcatList([0..n/2-1], i -> _row_BRDFT_13(n, 2*alpha2pi(n, i, u), k)),
   Concatenation(
       ConcatList([0..(n-3)/2], i -> _row_BRDFT_13(n, 2*alpha2pi(n, i, u), k)),
       [List([0..n-1], i-> (-1)^i)])
);
# dst3/dst3

# F.T. for the polynomial algebras below, basis in time = (x^(1/2),x^(3/2),..., x^(n-1/2))
# u = 1/4, n - even or odd
#   R[x] / x^n + 1
#
# u <> 1/4, n - even ("skew" BRDFT4)
#   R[x] / x^n - 2cos(2*pi*u) x^(n/2) + 1
#
Mat_BRDFT4 := (n, u, k, scaled) -> When(IsEvenInt(n),
   ConcatList([0..n/2-1], i -> _row_BRDFT_24(n, 2*alpha2pi(n, i, u), k, scaled)),
   Concatenation(
       ConcatList([0..(n-3)/2], i -> _row_BRDFT_24(n, 2*alpha2pi(n, i, u), k, scaled)),
       [List([0..n-1], i-> (-1)^i)])
);
# dst4/dst4 -- scale(brdft4)

# spiral> $ * scale(Mat_BRDFT4(16,1/4));
# [ [ 1, -1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ],
#   [ 0, 0, -1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, -1 ],
#   [ 0, 0, 0, -1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, -1, 0 ],
#   [ 0, 0, 0, 0, -1, 0, 0, 0, 0, 0, 0, 0, 0, -1, 0, 0 ],
#   [ 0, 0, 0, 0, 0, -1, 0, 0, 0, 0, 0, 0, -1, 0, 0, 0 ],
#   [ 0, 0, 0, 0, 0, 0, -1, 0, 0, 0, 0, -1, 0, 0, 0, 0 ],
#   [ 0, 0, 0, 0, 0, 0, 0, -1, 0, 0, -1, 0, 0, 0, 0, 0 ],
#   [ 0, 0, 0, 0, 0, 0, 0, 0, -1, -1, 0, 0, 0, 0, 0, 0 ],
#   [ 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1 ],
#   [ 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0 ],
#   [ 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0 ],
#   [ 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0 ],
#   [ 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0 ],
#   [ 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0 ],
#   [ 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0 ],
#   [ 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0 ] ]

Class(Base_BRDFT, NonTerminal, TaggedObjectMixin, rec(
   isReal := True,
   dims := self >> let(n:=self.params[1], [n, n]),
   print := (self, i, is) >> let(base_print := NonTerminal.print,
       Print(base_print(self, i, is),
           When(IsBound(self.tags), Print(".withTags(", self.tags, ")"))))
));

Class(rDFT, Base_BRDFT, rec(
   abbrevs := [ (n)       -> Checked(IsPosIntSym(n), [n, 1/4, 1]),
                (n,a,rot) -> Checked(IsPosIntSym(n), IsRatSym(a), IsIntSym(rot),
                                     IsSymbolic(rot) or Gcd(n,rot)=1,
                    let(aa := When(IsRat(a) and a>1/2, 1-a,a), [n, aa, rot])) ],

   terminate := self >> Mat(Mat_rDFT(self.params[1], EvalScalar(self.params[2]), self.params[3])),
   hashAs := self >> ObjId(self)(self.params[1]).withTags(self.getTags()),
   HashId := self >> Concatenation([self.params[1]], self.getTags())
));

# BRDFT1(<n>) - real DFT of type 1 non-terminal
#  Freq. basis :
#      (1), (1,x)*, (1)
#  Time basis :
#      (1, x, ..., x^(n-1))
#  Polynomial algebra :
#      R[x] / x^n - 1
#
Class(BRDFT1, Base_BRDFT, rec(
   abbrevs := [ (n)   -> Checked(IsPosIntSym(n), [n, 1]),
                (n,rot) -> Checked(IsPosIntSym(n), IsIntSym(rot), [n, rot]) ],
   terminate := self >> let(mat := Mat(Mat_BRDFT1(self.params[1], EvalScalar(self.params[2]))),
       When(self.transposed, mat.transpose(), mat))
));

# Same as BRDFT1 but does not decompose polynomial algebra completely,
# keeping 1D spectral components fused (ie first spectral component is
# R[x]/x^2-1), with basis (1,x) as in all other components.
#
Class(UBRDFT1, Base_BRDFT, rec(
   abbrevs := [ (n)   -> Checked(IsPosIntSym(n), [n, 1]),
                (n,rot) -> Checked(IsPosIntSym(n), IsIntSym(rot), [n, rot]) ],
   terminate := self >> Mat(Mat_BRDFT1U(self.params[1], EvalScalar(self.params[2])))
));

# BRDFT3(<n>) - real DFT of type 3 non-terminal
#  Freq. basis :
#      (1), (1,x)*, (1)
#  Time basis :
#      (1, x, ..., x^(n-1))
#  Polynomial algebra :
#      R[x] / x^n + 1
#
Class(BRDFT3, Base_BRDFT, rec(
   abbrevs := [ (n)   -> Checked(IsPosIntSym(n),           [n, 1/4, 1]),
                (n,a) -> Checked(IsPosIntSym(n), IsRatSym(a),
                    let(aa := When(IsRat(a) and a>1/2, 1-a,a), [n, aa, 1])),
                (n,a, rot) -> Checked(IsPosIntSym(n), IsRatSym(a), IsIntSym(rot),
                    let(aa := When(IsRat(a) and a>1/2, 1-a,a), [n, aa, rot])) ],

   terminate := self >> Mat(Mat_BRDFT3(self.params[1], EvalScalar(self.params[2]), EvalScalar(self.params[3]))),
   hashAs := self >> ObjId(self)(self.params[1]),
));

# -----------------------------------
# Base changes and older misc stuff
# -----------------------------------

bblock := a -> let(aa := -2*cospi(2*a), [[-1,  aa], [-aa, aa^2-1]]);

bruun2 := (m,a) -> Checked((m mod 4)=0, let(
     a12 := When(a <= 1/2,
              [a/2, (a+1)/2],
              [(1-a)/2, (1-a+1)/2]),
         BlockMat([[I(m/2), Tensor(Mat(bblock(a12[1])), I(m/4))],
                   [I(m/2), Tensor(Mat(bblock(a12[2])), I(m/4))]])));

_omega := a -> E(Denominator(a))^Numerator(a);
_shift := lst -> Concatenation(lst{[2..Length(lst)]}, [lst[1]]);
_shift2 := lst -> Concatenation(lst{[2..Length(lst)]}, [-lst[1]]);

# Polynomial transform for p(x)
# P_{b,a} = [p_l(a_k)]_{k,l}
# where b = {p_0, ...} is basis, typically {1,x,x^2,...}
# and a = {a_0, ...} are roots of p(x)
#
# 2nd col is column of roots
#
# roots of x^n - omega{2pi*a}  (==omega( (a+i)/n ))
CycRoots := (n, a) -> List([0..n-1], i -> _omega((a+i)/n));

# roots of x^2n - 2 x^n cos(2*pi*f) + 1
# roots are ordered CCW on the unit circle
PhiRoots := (N, f) -> let(n:=Numerator(f), d:=Denominator(f),
    ConcatList([0..N-1], i -> [E(N*d)^(n+d*i), E(N*d)^(-n-d*(N-1-i))]));

PhiRoots2 := (N, f) -> let(n:=Numerator(f), d:=Denominator(f),
    Concatenation(
    List([0..N-1], i -> [E(2*N*d)^(n+d*i), E(2*N*d)^(-n-d*(2*N-1-i))])));

phiRootsNewOrder := (n, a) -> # first omega will have negative angle, we have to make it last => _shift
    _shift(ConcatList([0..n-1], i -> [_omega((-a+i)/n), _omega((a+i)/n)]));

phiRoots2NewOrder := (n, a) -> # first omega will have negative angle, we have to make it last and negate => _shift2
    _shift2(ConcatList([0..n-1], i -> [_omega((-a+i)/(2*n)), _omega((a+i)/(2*n))]));

Mat_BDFT := (n, a, rot) -> let(
    roots := phiRootsNewOrder(n/2, a),
    List([1..n], r -> List([0..n-1], c -> roots[r]^(rot*c))));

Mat_BDFT2 := (n, a, rot) -> let(
    roots := phiRoots2NewOrder(n/2, a),
    List([1..n], r -> List([0..n-1], c -> roots[r]^(rot*c))));

alphai := (n,i,a)  -> Cond(i mod 2 = 0, (a + Int(i/2))/n, (1-a + Int(i/2))/n);

time_r := a -> [[1, -cospi(2*a)/sinpi(2*a)],
                [0, 1/sinpi(2*a)]];

r_time := a -> [[1, cospi(2*a)],
                [0, sinpi(2*a)]];

B1_time_r := n -> DirectSum(I(1), List([1..Int((n-1)/2)], i-> Mat(time_r(i/n))), I(_even(n)));
B3_time_r := n -> DirectSum(List([0..Int(n/2)-1], i -> Mat(time_r((i+1/2)/n))), I(_odd(n)));

B3_r_time := (n,a) -> DirectSum(List([0..Int(n/2)-1], i -> Mat(r_time(alphai(n,i,a)))), I(_odd(n)));

#ls := (n,func) -> List([0..n-1], func);

#MatBRDFT3 := (N,a) -> MatSPL(BlockMat(let(n:=N/2,
#     ls(n, i->let(phi := [[0,-1],[1,2*cospi(2*alphai(n,i,a))]],
#    ls(n, j->Mat(phi^(2*j))))))));

#MatBRDFT33 := (N,a) -> MatSPL(BlockMat(let(n:=N/2,
#     ls(n, i->let(phi := [[0,1],[1,-2*E(4)*sinpi(2*alphai(n,i,a))]],
#    ls(n, j->Mat(phi^(2*j))))))));

#r:=MatSPL(B3_time_r(7)*SRDFT3(7));

#MatBRDFT4 := (N,a) -> MatSPL(BlockMat(let(n:=N/2,
#     ls(n, i->let(start:=MatSPL(BRDFT4(2,alphai(n,i,a))), phi := [[0,-1],[1,2*cospi(2*alphai(n,i,a))]],
#    ls(n, j->Mat(start*phi^(2*j))))))));

# roots := List(PhiRoots(100, 1/(4*23)), ComplexCyc);
# DoForAll(last, x->AppendTo("roots", ReComplex(x), " ", ImComplex(x), "\n"));
# PrintTo("tmp.gnuplot", "plot 'roots' with lp");
# SYS_EXEC("gnuplot tmp.gnuplot -");

# m88:=MatSPL(M(16,2))*MatSPL(DFT3(16))*MatSPL(bruun2(16,1/4))^-1;
scale := mat -> List(mat, x->x/x[1]);
# Note:
#   GathExtend(n, Even1).transpose() * BSkewDFT3(n, a) * VStack(I(n/2), O(n/2)) == SkewDTT(DCT3(n/2), 2*a)
#   GathExtend(n, Odd1).transpose()  * BSkewDFT4(n, a) * VStack(I(n/2), O(n/2)) == SkewDTT(DCT4(n/2), 2*a)
#
# BRDFT3 supports Odd0 input symmetry
# BRDFT4 supports Odd1 input symmetry (incorrectly defined in Spiral)
#
#   x3  := n ->       MatSPL(Gath(H(n, n/2, 0, 2)) * BRDFT3(n) * GathExtend(n, Odd0));   == PolyDTT(DCT3(n/2)) == DCT3(n/2), other half=zero
#   x33 := n ->       MatSPL(Gath(H(n, n/2, 1, 2)) * BRDFT3(n) * GathExtend(n, Even00)); == PolyDTT(DST3(n/2)), other half=first half * cospi( (2*i+1) / m), eg 1/8, 3/8, 5/8, 7/8 for n=8
#   y3  := n ->     2*MatSPL(Gath(H(n, n/2, 0, 2)) * BRDFT3(n) * DirectSum(I(1), -J(n-1))
#                  1/2*                                               * GathExtend(n, Odd1)));  == PolyDTT(DCT4(n/2)), other half=same
#   y33 := n ->     2*MatSPL(Gath(H(n, n/2, 0, 2)) * BRDFT3(n) * DirectSum(I(1), -J(n-1)) *
#                                                                   GathExtend(n, Even1));  == PolyDTT(DST4(n/2)), other half=neg
#
#   z3  := n ->       MatSPL(Gath(H(n, n/2, 1, 2)) * BRDFT4(n) * GathExtend(n, Odd1));  == PolyDTT(DCT4(n/2)), !new def
#   z33 := n -> scale(MatSPL(Gath(H(n, n/2, 0, 2)) * BRDFT4(n) * GathExtend(n, Even1)));  == PolyDTT(DST4(n/2)), !new def
#
#   x44 := n -> scale((-E(4)) * MatSPL(Gath(H(n, n/2, 1, 2)) * BRDFT4(n) * GathExtend(n, Odd1)));  == PolyDTT(DCT4(n/2))
#   x4 :=  n ->       (-E(4)) * MatSPL(Gath(H(n, n/2, 0, 2)) * BRDFT4(n) * GathExtend(n, Even1));  == DST4(n/2)
#   x4 :=  n ->  scale(-E(4)) * MatSPL(Gath(H(n, n/2, 0, 2)) * BRDFT4(n) * GathExtend(n, Even1));  == PolyDTT(DST4(n/2))

#   spiral> pm(Gath(H(16,8,0,2))*BRDFT3(16)*GathExtend(16, Odd0));
#
#   y := (n,a) -> MatSPL(Gath(H(n, n/2, 0, 2)) * BRDFT3(n,a) * DirectSum(I(1), -VStack(O(2,n/2-1), RI(n/2,n/2-1), O(n/2-3, n/2-1))));
#  == PolyDTT(SkewDTT(DST3(n/2), 2*a))
#

# # Decomposes C[x]/phi(.) or R[x]/phi(.) into 2-dim spectral
# # components with basis 1,x
# #
# Class(BRDFT3, NonTerminal, rec(
#     abbrevs := [ (n)   -> Checked(IsPosInt(n),           [n, 1/4]),
#                  (n,a) -> Checked(IsPosInt(n), IsRatSym(a),
#            let(aa := When(IsRat(a) and a>1/2, 1-a,a), [n, aa])) ],

#     terminate := self >> let(n:=self.params[1], a:=self.params[2],
#   M(n,n/2) * self.xmat() * BSkewDFT3(n, a).terminate()),

#     xmat := self >> let(n:=self.params[1], a:=self.params[2],
#   roots := Take(PhiRoots(n/2,a),n/2), cc := Global.Conjugate,
#   DirectSum(List(roots, r->Mat([[1,r],[1,cc(r)]]^-1)))^LIJ(n)),

#     isReal := True,
#     dims := self >> let(n:=self.params[1], [n, n]),
#     HashId := self >> self.params[1]
# ));

# Class(BRDFT4, BRDFT3, rec(
#     terminate := self >> let(n:=self.params[1], a:=self.params[2],
#   M(n,n/2) * self.xmat() * BSkewDFT4(n, a).terminate()),
# #    xmat := self >> let(n:=self.params[1], a:=self.params[2],
# # roots := Take(PhiRoots2(n/2,a),n/2), cc := Global.Conjugate,
# # DirectSum(List(roots, r->Mat([[r,r^3],[-cc(r),-cc(r)^3]]^-1)))^LIJ(n)),
# ));

#Class(BRDFT4, BRDFT3, rec(
#    terminate := self >> let(n:=self.params[1], a:=self.params[2],
#   Mat(scale(MatSPL(M(n,n/2) * self.xmat() * BSkewDFT4(n, a))))),
##    xmat := self >> let(n:=self.params[1], a:=self.params[2],
##  roots := Take(PhiRoots2(n/2,a),n/2), cc := Global.Conjugate,
##  DirectSum(List(roots, r->Mat([[r,r^3],[-cc(r),-cc(r)^3]]^-1)))^LIJ(n)),
#));

# -------------------------------------------------------------
# Other transforms
# -------------------------------------------------------------

# roots of BSkewDFT3(2*n, u)
#   { E(n)^(2u+i) } union { E(n)^(-2u-i) }
#
Class(BSkewDFT3, NonTerminal, TaggedObjectMixin, rec(
    abbrevs := [ (n)   -> Checked(IsPosIntSym(n),           [n, 1/4, 1]),
                 (n,a) -> Checked(IsPosIntSym(n), IsRatSym(a),
                    let(aa := When(IsRat(a) and a>1/2, 1-a,a), [n, aa, 1])),
                 (n,a,rot) -> Checked(IsPosIntSym(n), IsRatSym(a), IsIntSym(rot),
                    let(aa := When(IsRat(a) and a>1/2, 1-a,a), [n, aa, rot])) ],

    terminate := self >> let(N := self.params[1], a := self.params[2], rot := self.params[3],
        roots := PhiRoots(N/2, EvalScalar(a)),
        Mat(List([1..N], r ->
                List([0..N-1], c -> roots[r]^(rot*c))))),

    isReal := False,
    dims := self >> let(n:=self.params[1], [n, n]),
    hashAs := self >> ObjId(self)(self.params[1]),
));

Class(PSkewDFT3, NonTerminal, TaggedObjectMixin, rec(
    abbrevs := [ (n)   -> Checked(IsPosInt(n),                  [n, 1/4, 1]),
                 (n,a) -> Checked(IsPosInt(n), IsRatSym(a),
                     let(aa := When(IsRat(a) and a>1/2, 1-a,a), [n, aa, 1])),
                 (n,a,rot) -> Checked(IsPosInt(n), IsRatSym(a), IsIntSym(rot),
                     let(aa := When(IsRat(a) and a>1/2, 1-a,a), [n, aa, rot])) ],

    terminate := self >> let(N := self.params[1], a := EvalScalar(self.params[2]),
        rot := EvalScalar(self.params[3]),
        roots := PhiRoots(N/2, a),
        Mat(List([1..N], r ->
            Concatenation(
                List([0..N/2-1], c -> roots[r]^(rot*c)),
                List([N/2..N-1], c -> (roots[r]^(rot*c) - roots[r]^(rot*(c-N/2))*cospi(2*a*rot))/sinpi(2*a*rot)))))),

    isReal := False,
    dims := self >> let(n:=self.params[1], [n, n]),
    hashAs := self >> ObjId(self)(self.params[1]),
));

Class(BSkewDFT4, BSkewDFT3, rec(
    terminate := self >> let(N := self.params[1], a := EvalScalar(self.params[2]), rot := EvalScalar(self.params[3]),
	roots := PhiRoots2(N/2, a),
        Mat(List([1..N], r ->
	     List([0..N-1], c -> roots[r]^(rot*(2*c+1)))))),
    hashAs := self >> ObjId(self)(self.params[1]),
));

# NOTE: rot is missing
Class(BSkewPRDFT, PRDFT3, TaggedObjectMixin, rec(
    abbrevs := [ (n)   -> Checked(IsPosInt(n),           [n, 1/4]),
                 (n,a) -> Checked(IsPosInt(n), IsRatSym(a),
             let(aa := When(IsRat(a) and a>1/2, 1-a,a), [n, aa])) ],

    terminate := self >> let(N := self.params[1], a := EvalScalar(self.params[2]),
	roots := PhiRoots(N/2, a),
        Mat(List([0..N-1], r ->
	     When(r mod 2 = 0,
		 List([0..N-1], c -> self.projRe(roots[1+r/2]^c)),
		 List([0..N-1], c -> self.projIm(roots[1+(r-1)/2]^c)))))),
    hashAs := self >> ObjId(self)(self.params[1]),
));
# NOTE: rot is missing
Class(BSkewRDFT, PRDFT3, TaggedObjectMixin, rec(
    abbrevs := [ (n)   -> Checked(IsPosInt(n),           [n, 1/4]),
                 (n,a) -> Checked(IsPosInt(n), IsRatSym(a),
             let(aa := When(IsRat(a) and a>1/2, 1-a,a), [n, aa])) ],

    terminate := self >> let(N := self.params[1], a := EvalScalar(self.params[2]),
	K(N,2) * BSkewPRDFT(N,a).terminate()),

    hashAs := self >> ObjId(self)(self.params[1]),
));


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

normCos := normalizeCosine;
dnormCos := x -> When(IsDelay(x) and Type(x)=T_FUNCCALL and x[1] = D(normCos),
	              x, PEV(normCos(x)));

dnormCos := x -> When(IsRat(x), normCos(x), x);

#F SkewDTT(<non-terminal for DCT/DST type 3/4>, <rat>)
#F Parameters:       [ <transform for DCT or dst type 3 or 4>, <rat> ]
#F Definition:       Let t be dct or dst type 3 or 4 as non-terminal spl.
#F                   Transform( "SkewDTT", [t, r] ) represents the (n x n)-matrix
#F                     [ cos(r_k*l*pi/n) | k,l = 0...n-1 ]
#F                     [ sin(r_k*(l+1)*pi/n) | k,l = 0...n-1 ]
#F                     [ cos(r_k*(l+1/2)*pi/n) | k,l = 0...n-1 ]
#F                     [ sin(r_k*(l+1/2)*pi/n) | k,l = 0...n-1 ]
#F                   for dct3, dst3, dct4, dst4, respectively
#F                   where the list L of the r_k arises from the list
#F                     [ (r + 2k)/n | 0 <= k < n ]
#F                   by
#F                     1. normalizing the entries to lie in [0, 1] such
#F 		       that their cosine does not change
#F                     2. ordering the values increasing by size
#F Note:             for r = 1/2, the skew DCT3 reduces to the ordinary DCT3.
#F                   The transpose is provided by the transform TSkewDTT
#F Example:          SkewDTT( DCT3(8), 1/3 )
#F
Class(SkewDTT, NonTerminal, rec(
    _short_print := true,
    abbrevs := [ (nt, r) -> Checked(IsNonTerminal(nt), IsRatSym(r),
	                            ObjId(nt) in [DCT3, DST3, DCT4, DST4],
				    [Copy(nt), dnormCos(r)]) ],

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

    terminate := self >> let(
	S := ObjId(self.params[1]),
	N := self.params[1].dimensions[1],
	r := EvalScalar(self.params[2]),
	Cond(S = DCT3, Mat(SkewDCT_IIIunscaled(N, r)),
	     S = DST3, Mat(SkewDST_IIIunscaled(N, r)),
	     S = DCT4, Mat(SkewDCT_IVunscaled(N, r)),
	     S = DST4, Mat(SkewDST_IVunscaled(N, r)),
	     Error("Unrecognized <self.params[1].symbol>"))),

    isReal := True

#    HashId := self >> self.params[1]
));

RulesFor(SkewDTT, rec(
    SkewDTT_Base2 := rec(
        info             := "DTT_2(r) -> F_2",
        isApplicable     := P -> P[1].dimensions[1] = 2,
        allChildren      := P -> [ [ ] ],
        rule := (P,C) ->
	    let(S := ObjId(P[1]),
		r := P[2],
		Cond(
		    S = DCT3,  F(2) * Diag([1, CosPi(r/2)]),

		    S = DST3,  F(2) * Diag([SinPi(r/2), SinPi(r)]),

		    S = DCT4,  Diag([CosPi(r/4), SinPi(r/4)]) * F(2) *
				 Mat([[1, -1], [0, 2*CosPi(r/2)]]),

		    S = DST4,  Diag([SinPi(r/4), CosPi(r/4)]) * F(2) *
				 Mat([[1, 1], [0, 2*CosPi(r/2)]])))
    ),

    SkewDCT3_VarSteidl := rec(
        info             := "SkewDCT3_n -> IterDirectSum(SkewDCT3_n/2)",
	switch           := true,
	forTransposition := false,
        isApplicable     := P -> let(S := ObjId(P[1]), n := Rows(P[1]),
	    S = DCT3 and IsPrimePowerInt(n) and n mod 2 = 0 and n > 2),

	# create one parametrized SkewDTT, use SampledVar() to make timing possible
        allChildren := P -> let(n := Rows(P[1]), r := P[2],
	    [[ SkewDTT(DCT3(n/2), r/2),
	       SkewDTT(DCT3(n/2), 1 - r/2) ]]),

        rule := (P,C) -> let(n := Rows(P[1]), r := P[2],
	    K(n, n/2) *
	    DirectSum(C[1], C[2]) *
	    Tensor(F(2), I(n/2)) *
	    sparse1(n, r/2))
    ),

    # NOTE: We need to be able to time SkewDTT(n, r) where r is free variable
    #        otherwise DP does not work
    SkewDCT3_VarSteidlIterative := rec(
        info             := "SkewDCT3_n -> IterDirectSum(SkewDCT3_n/2)",
	switch           := false,
	forTransposition := false,
        isApplicable     := P -> let(S := ObjId(P[1]), n := Rows(P[1]),
	    S = DCT3 and IsPrimePowerInt(n) and n mod 2 = 0 and n > 2),

	# create one parametrized SkewDTT, use SampledVar() to make timing possible
        allChildren := P -> let(n := Rows(P[1]), r := P[2], i:=Ind(2),
	    [[ SkewDTT(DCT3(n/2), cond(i,1,0) + cond(i,-1,1)*r/2) ]]),

        rule := (P,C, Nonterms) -> let(
	    n := Rows(P[1]),
	    r := P[2],
	    ivar := Nonterms[1].params[2].args[1].args[1],

	    K(n, n/2) *
	    IterDirectSum(ivar, 2, C[1]) *
	    Tensor(F(2), I(n/2)) *
	    sparse1(n, r/2))
    )
));


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

##    extractP3(P, k) takes a bit matrix P and a boundary k, and returns
##    submatrix P3 where P is partitioned as
##
##    P4 | P3
##    -------
##    P2 | P1
##
##    If P is of size N by N, P3 is size N-k by k.
##
extractP3 := meth(P, k)
   local dim, row, i, j, res;
   dim := Length(P);
   res := [];
   for i in [1..dim-k] do
      row := [];
      for j in [dim-k+1..dim] do
         Append(row, [P[i][j]]);
      od;
      Append(res, [row]);
   od;
   return res;
end;

##    extractP1(P, k) takes a bit matrix P and a boundary k, and returns
##    submatrix P1 where P is partitioned as
##
##    P4 | P3
##    -------
##    P2 | P1
##
##    P1 is size k by k.
##
extractP1 := meth(P, k)
   local dim, row, i, j, res;
   dim := Length(P);
   res := [];
   for i in [dim-k+1..dim] do
      row := [];
      for j in [dim-k+1..dim] do
         Append(row, [P[i][j]]);
      od;
      Append(res, [row]);
   od;
   return res;
end;

##    NonZeroRows(P) determines which rows of P are not all-zero.  It returns a
##       vector (indexed starting from 1) that indicates these rows.
##
NonZeroRows := meth(P2)
   local i, l, t, res;
   res := [];

   for i in [1..Length(P2)] do
      t := 0;

      for l in [1..Length(P2[i])] do
         if (P2[i][l] <> 0 * GF(2).one) then t := t + 1; fi;
      od;

      if (t <> 0) then Append(res, [i]); fi;

   od;
   return res;
end;

##    ZeroRows(P) determines which rows of P are all zero.  It returns a
##       vector (indexed starting from 1) that indicates these rows.
##
ZeroRows := meth(P1)
   local i, l, t, res;
   res := [];

   for i in [1..Length(P1)] do
      t := 0;

      for l in [1..Length(P1[i])] do
         if (P1[i][l] <> 0 * GF(2).one) then t := t + 1; fi;
      od;

      if (t = 0) then Append(res, [i]); fi;

   od;
   return res;
end;

##   buildH2(i, j, n, k) builds matrix H2 given i, j, n, and k as in
##      Algorithm 5.2, Case 1, Line 3, in the Streaming Permutation
##      paper.
##
buildH2 := meth(i, j, n, k)
   local res, l, c;
   res := [];
   c := 1;
   for l in [1..n-k] do
      if l in j then
         Append(res, [BasisVec(k, i[c]-1) * GF(2).one]);
	 c := c+1;
      else
	 Append(res, [ List([1..k], x -> 0 * GF(2).one) ]);
      fi;
   od;

   return TransposedMat(res);
end;

##   buildH(n, k, H2) constructs matrix H given size n, partition
##      location k, and submatrix H2.
##
##      I(n-k) |  0
##      -------|-----
##        H2   | I(k)
##
buildH := meth(n, k, H2)
   local res, i;
   res := [];
   for i in [1..n-k] do
      Append(res, [BasisVec(n, i-1) * GF(2).one]);
   od;
   for i in [n-k+1..n] do
      Append(res, [Concatenation(H2[i-(n-k)], BasisVec(k, i-(n-k)-1) * GF(2).one )]);
   od;

   return res;
end;

##   GetTopLeftOnes(P, k) counts the number of ones in the top
##      left corner.
##
GetTopLeftOnes := meth(P, k)

#    local count, x, size;

#    size := Length(P);
#    count := 1;

#    repeat x := P[count][count]; count := count+1; until x <> GF(2).one;

#    return Min2(count-2, size-k);

    local size, count, x, y, Pt;

    Pt := TransposedMat(P);
    size := Length(P);
    count := 0;

    repeat
	count := count+1;
        x := P[count];
	y := Pt[count];
    until ((x <> BasisVec(size, count-1) * GF(2).one) or (y <> BasisVec(size, count-1) * GF(2).one) or (count = size));

    return Min2(count-1, size-k);

end;

##   AddTopLeftOnes(P, l) adds l ones to the top left corner.
##
AddTopLeftOnes := meth(P, l)
   local size, res, i, t;
   size := Length(P);
   res := [];

   for i in [1..l] do
      Append(res, [BasisVec(size+l, i-1)]*GF(2).one);
   od;

   t := List([1..l], e->0*GF(2).one);

   for i in [1..size] do
      Append(res, [Concatenation(t, P[i])]);
   od;

   return res;

end;

##   TransposeVector(x) transposes 1d 'horizontal' vector x into
##      a 2d 'vertical' vector.
##
TransposeVector := meth(x)
   local i, res;
   res := [];
   if IsList(x[1]) then
       for i in [1 .. Length(x)] do res[i] := x[i][1]; od;
   else
      for i in [1 .. Length(x)] do res[i] := [x[i]]; od;
   fi;
   return res;
end;

##   CheckPerm(P) returns 1 if P is a permutation matrix,
##      and 0 otherwise.
##
CheckPerm := meth(P)
    local i, j, t, row;
    P := BitMatrixToInts(P);

    for i in [1 .. Length(P)] do
       if ( Sum( P[i]{ [ 1..Length(P[i]) ] } ) <> 1) then
	   return 0;
       fi;
    od;

    return 1;
end;

switchCols := meth(P, a, b)
   local ptrans, row;
   ptrans := TransposedMat(P);
   row := ptrans[a];
   ptrans[a] := ptrans[b];
   ptrans[b] := row;

   return TransposedMat(ptrans);
end;

Declare(BRAMPerm);
Declare(STensor);
Declare(MyTriangulizeMat);
#Declare(BRAMPermStreamOne);
Declare(PermMatrixRowVals);

# ===============================================
# A container for a streaming permutation
# StreamPermBit(<SPL>, <q>)
#   where <SPL> is the permutation as an SPL object, and <q>
#   is the streaming width.
# ===============================================
Class(StreamPermBit, BaseMat, SumsBase, rec(
	abbrevs := [(s, q) -> [s, q]],

	new := (self, prm, ss) >> SPL(WithBases(self, rec(
	     _children := [prm],
	     streamSize := ss,

	     dimensions := prm.dims(),
	     ))),

	rChildren := self >> self._children,
	rSetChild := meth(self, n, what) self._children[n] := what; end,
	child := (self, n) >> self._children[1],
	children := self >> self._children,

	createCode := meth(self)
	   local res, p3, p1, r, k, M, N, P, x, i, j, l, K, size, count, ptrans, z, G, q1, q3, q3b, p1b, G;

       # if (self.streamSize = 1) then
#           return BRAMPermStreamOne(PermMatrixRowVals(MatSPL(self.child(1))),
#                       self.child(1));
#       fi;

	   k := Log2Int(self.streamSize);
	   P := self._children[1]._children[1];
	   size := Log2Int(self.dimensions[1]);

       # If our streaming width is 1, then we are done.  P = I*P.
       #    We no longer do this, because we use the general version above.
	   if (self.streamSize = 1) then
	      #return BRAMPerm(P, MatSPL(I(size))*GF(2).one, 1);
           return BRAMPerm(MatSPL(I(size))*GF(2).one, P, 1);
	   fi;

	   # if P is the bit form of I tensor P',
	   # we can remove the top-left corner bits
	   # (up to (size-k) bits, and replace them
	   # with a streaming tensor product of a
	   # smaller permutation
	   count := GetTopLeftOnes(P,k);
	   P := P{[count+1..Length(P)]}{[count+1..Length(P)]};

	   size := size-count;

	   p3 := extractP3(P, k);
	   p1 := extractP1(P, k);

	   r := Rank(p1);

	   if (r = k) then
	       M := P;
	       N := MatSPL(I(Length(M))) * GF(2).one;
	   else
           if (CheckPerm(P) = 1) then
	           j := NonZeroRows(p3);
	           i := ZeroRows(p1);
	       else
		       p1b := TransposedMat(Copy(p1));
		       G := MyTriangulizeMat(p1b);
		       G := TransposedMat(G);
		       q1 := p1 * G;
		       q3 := p3 * G;

 		       z := LinearIndependentColumns(TransposedMat(q1));
 		       i := [];

 		       for l in [1 .. k] do
   		       if (l in z) then
 		               ;
               else
 		           Add(i, l);
 		       fi;
 		       od;

 		       q3b := [];

 		       for l in [1 .. k] do
 		       Append(q3b, q3{[r+1..k]});
 		       od;

 		       j := LinearIndependentColumns(TransposedMat(q3b));
           fi;

	       K := buildH2(i, j, size, k);

	       N := buildH(size, k, K) * GF(2).one;
	       M := N*P;
	   fi;

	   if (Maximum(Maximum(N * M - P)) <> 0 * GF(2).one) then
	       Print("ERROR: Could not factor permutation matrix.\n");
	   fi;

	   if (count = 0) then
	       return BRAMPerm(N, M, self.streamSize);
	   else
	       return STensor(BRAMPerm(N,M,self.streamSize), 2^count, self.streamSize);
	   fi;
        end,

	print := (self,i,is) >> Print(self.name, "(", self._children[1], ", ", self.streamSize, ")"),

	toAMat := self >> AMatMat(BitsToPermMatrix(self._children[1]._children[1])),
	dims := self >> self._children[1].dims(),

	sums := self >> self,

));

# ===============================================
# A streaming permutation that has been factored into reading and writing
# into a dual-ported RAM
# BRAMPerm(M, N)
#   where M and N are bit representations of the factorized perm
#
# (see Pueschel, Milder, and Hoe.  "Permuting Streaming Data Using RAMs.")
# ===============================================
Class(BRAMPerm, BaseMat, SumsBase, rec(
	abbrevs := [(m,n,q)-> [m,n,q]],

	new := (self, m, n,q) >> SPL(WithBases(self, rec(
		    _children  := [m,n],
		    dimensions := [2^Length(m), 2^Length(m)],
		    streamSize := q
	     ))),

	rChildren := self >> self._children,
	rSetChild := meth(self, n, what) self._children[n] := what; end,
	child     := (self, n) >> self._children[n],
	children  := self >> self._children,

	createCode := self >> self,
        print      := (self,i,is) >> Print(self.name, "(", BitMatrixToInts(self._children[1]), ", ", BitMatrixToInts(self._children[2]), ", ", self.streamSize, ")"),

	toAMat := self >> AMatMat(BitsToPermMatrix(self.child(1)) * BitsToPermMatrix(self.child(2))),
	dims   := self >> [2^(Length(self._children[1])), 2^(Length(self._children[1]))],

	sums   := self >> self
));

## PermMatrixRowVals(p) takes permutation matrix p and returns a list
##   of the '1' location in each row of the matrix.
PermMatrixRowVals := meth(x)
   local length, i, res;

   res := [];
   length := Length(x);
   for i in [1 .. length] do
      res[i] := BasisVecToNum(x[i]);
   od;
   return res;
end;

#############################################################################
##
#F  MyTriangulizeMat( <mat> ) . . . . . bring a matrix in upper triangular form
##
##    This is a modified version of TriangulizeMat included with Gap.
##       I have modified it to keep track of the elementary row
##       operations performed, and return their product.
MyTriangulizeMat := function ( mat )
    local   m, n, i, j, k, row, row2, zero, G;

    if mat <> [] then

       # get the size of the matrix
       m := Length(mat);
       n := Length(mat[1]);
       zero := 0*mat[1][1];
       G := MatSPL(I(Length(mat)));

       # run through all columns of the matrix
       i := 0;
       for k  in [1..n]  do

           # find a nonzero entry in this column
           j := i + 1;
           while j <= m and mat[j][k] = zero  do j := j + 1;  od;

           # if there is a nonzero entry
           if j <= m  then

               # increment the rank
               InfoMatrix2(k," \c");
               i := i + 1;

               # make its row the current row and normalize it
               row := mat[j];  mat[j] := mat[i];  mat[i] := row[k]^-1 * row;
	       row2 := G[j]; G[j] := G[i]; G[i] := row[k]^-1 * row2;
	       # Print("aG = ", G, "\n");
	       # Print("amat = ", mat, "\n");

               # clear all entries in this column
               for j  in [1..m] do
                   if  i <> j  and mat[j][k] <> zero  then
		       G[j] := G[j] - mat[j][k] * G[i];
                       mat[j] := mat[j] - mat[j][k] * mat[i];
		       # Print("bG = ", G, "\n");
		       # Print("G[i] = ", G[i], "\n");
		       # Print("mat[j][k] = ", mat[j][k], "\n");
		       # Print("bmat = ", mat, "\n");
                   fi;
               od;

           fi;

       od;

    fi;

    return G;

end;