a := [85, 88, 75, 66, 25, 29, 83, 39, 97];
b := [68, 41, 10, 49, 16, 65, 32, 92, 28, 98];

# Compute a decimal approximation of a rational
Approx := function(x, d)
	local neg, a, b, n, m, s;
	if x < 0 then
		x := -x;
		neg := true;
	else
		neg := false;
	fi;
	a := NumeratorRat(x);
	b := DenominatorRat(x);
	n := QuoInt(a, b);
	a := RemInt(a, b);
	m := 10^d;
	s := "";
	if neg then
		Append(s, "-");
	fi;
	Append(s, String(n));
	n := Size(s) + 1;
	Append(s, String(m + QuoInt(a*m, b)));
	s[n] := '.';
	return s;
end;

PermTest := function(a, b)
	local c, d, p, q, u, v, m, n, k, diff, all;
	p := Size(a);
	q := Size(b);
	v := Concatenation(a, b);
	n := p + q;
	m := Binomial(n, p);
	diff := Sum(a)/p - Sum(b)/q;
	all := [1 .. n];
	k := 0;
	for u in Combinations(all, p) do
		c := List(u, i -> v[i]);
		d := List(Difference(all, u), i -> v[i]);
		if Sum(c)/p - Sum(d)/q > diff then
			k := k + 1;
		fi;
	od;
	return [Approx((1 - k/m)*100, 3), Approx(k/m*100, 3)];
end;

# in order, % less or greater than original diff
PermTest(a, b);
[ "87.197", "12.802" ]


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

Class(MD_PRDFT, TaggedNonTerminal, rec(
    abbrevs := [ (dims)     -> Checked(IsList(dims), ForAll(dims, IsPosIntSym), [dims, 1]),
                 (dims,rot) -> Checked(IsList(dims), ForAll(dims, IsPosIntSym), IsIntSym(rot), [dims, rot])
    ],

    terminate := self >> let(
        n := self.params[1], rot := self.params[2],
        n0 := DropLast(n, 1),
        lst := Last(n),
        res := RC(Tensor(MDDFT(n0), I(Rows(PRDFT(lst))/2))) * Tensor(I(Product(n0)), PRDFT(lst, rot)),
        When(self.transposed, res.transpose(), res)),

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

    isReal := True,

    normalizedArithCost := self >> let(n := Product(self.params[1]),
       IntDouble(2.5 * n * d_log(n) / d_log(2))),

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

    dims := self >> let(
        n := self.params[1],
        n0 := DropLast(n, 1),
        lst := Last(n),
        d := [ Product(n0) * 2*(idiv(lst,2)+1), Product(n)],
        When(self.transposed, Reversed(d), d)),

    omega := (N,k,r,c) -> E(N)^(k*r*c),
));

NewRulesFor(MD_PRDFT, rec(
    MD_PRDFT_Base := rec(
        applicable := t -> true,
        freedoms := t -> [],
        child := (t, fr) -> let(
            n := t.params[1], rot := t.params[2],
            n0 := DropLast(n, 1),
            lst := Last(n),
            RC(
                GT(MDDFT(n0), GTVec, GTVec, [Rows(PRDFT(lst))/2]).withTags(t.getTags())
            ) *
            GT(PRDFT(lst, rot), GTPar, GTPar, [Product(n0)]).withTags(t.getTags())
        ),
        apply := (self, t, C, Nonterms) >> C[1]
    )
));

# tst := vec -> let(n := Length(vec), dim := Sqrt(n), cols := 2*(Int(dim/2)+1),
#     out := TransposedMat(MatSPL(MD_PRDFT([dim,dim], 1)) * TransposedMat([vec]))[1],
#     outmat := List([0..dim-1], x->out{[1 + x*cols .. cols + x * cols]}),
#     PrintMat(outmat),
#     outmat);

# ctst := vec -> let(n := Length(vec), dim := Sqrt(n),
#     out := TransposedMat(MatSPL(MDDFT([dim,dim], 1)) * TransposedMat([vec]))[1],
#     outmat := List([0..dim-1], x->out{[1 + x*dim .. dim + x * dim]}),
#     PrintMat((outmat)),
#     outmat);

# CX = X * RE
# X^-1 = RE * CX^-1


# Matrix exponentiation is built-in
A := [[0 , 1], [1, 1]];
PrintArray(A);
#   [ [  0,  1 ],
#     [  1,  1 ] ]
PrintArray(A^10);
#   [ [  34,  55 ],
#     [  55,  89 ] ]


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

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

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

#
# change basis order of first exteriror power to match chevalley basis order
#
b:=extA_basis[1];
#SetBasis(extA[1],bbb);
#extA_basis[1]:=Basis(extA[1]);
#extA_basis[1]:=
#b:=[
#    b[7],
#    b[6],
#    b[8],   # alpha + beta
#    b[3],
#    b[2],
#    b[1],
#    b[5],
#    b[4],
#    ];

#plist:=[7,6,8,3,2,1,5,4];
plist:=[3,2,1,6,7,8,4,5];
bbb:=b{plist};
apply_plist:=function(mat)
    local result;
    result:=List(mat,i->i{plist});
    result:=TransposedMat(result);
    result:=List(result,i->i{plist});
    result:=TransposedMat(result);
    return result;
end;

semne:=DiagonalMat([1,-1,1,-1, 1,1,-1,1]);
apply_signs:=function(mat)
    local result;
    result := semne*mat*semne;
    return result;
end;

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;

ade:=function(e)
	local result,v;
	result:=[];
	for v in cb0 do
		Append(result,[Coefficients(cb0,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;

ad_root_group:=function(index,t)
	local ee,tmp,result,i;
	ee:=ade(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;

#
# Test:
#

# ade1
yyy:=ext1e(cb0[1]);
yyy:=apply_plist(yyy);
yyy:=apply_signs(yyy);
xxx:=ade0(cb0[1]);
Display(yyy);
Display(xxx);
Display(xxx=yyy);

# root group 1
yyy:=ext1_root_group(1,1);
yyy:=apply_plist(yyy);
yyy:=apply_signs(yyy);
xxx:=ad_root_group(1,1);
Display(yyy);
Display(xxx);
Display(xxx=yyy);

# ade2 --------------------> Distinct
yyy:=ext1e(cb0[2]);
yyy:=apply_plist(yyy);
yyy:=apply_signs(yyy);
xxx:=ade0(cb0[2]);
Display(yyy);
Display(xxx);
Display(xxx=yyy);

# root group 2 --------------------> Distinct
yyy:=ext1_root_group(2,1);
yyy:=apply_plist(yyy);
yyy:=apply_signs(yyy);
xxx:=ad_root_group(2,1);
Display(yyy);
Display(xxx);
Display(xxx=yyy);


doors := function(n)
  local a,j,s;
  a := [ ];
  for j in [1 .. n] do
    a[j] := 0;
  od;
  for s in [1 .. n] do
    j := s;
    while j <= n do
      a[j] := 1 - a[j];
      j := j + s;
    od;
  od;
  return Filtered([1 .. n], j -> a[j] = 1);
end;

doors(100);
# [ 1, 4, 9, 16, 25, 36, 49, 64, 81, 100 ]


# our deficient list
L :=
[ "ABCD", "CABD", "ACDB", "DACB", "BCDA",
  "ACBD", "ADCB", "CDAB", "DABC", "BCAD",
  "CADB", "CDBA", "CBAD", "ABDC", "ADBC",
  "BDCA", "DCBA", "BACD", "BADC", "BDAC",
  "CBDA", "DBCA", "DCAB" ];

# convert L to permutations on 1..4
u := List(L, s -> List([1..4], i -> Position("ABCD", s[i])));

# set difference (with all permutations)
v := Difference(PermutationsList([1..4]), u);

# convert back to letters
s := "ABCD";
List(v, p -> List(p, i -> s[i]));


# We keep only primitive pythagorean triples
pyth := n ->
  Filtered(Cartesian([1 .. n], [1 .. n], [1 .. n]),
  u -> u[3]^2 = u[1]^2 + u[2]^2 and u[1] < u[2]
  and GcdInt(u[1], u[2]) = 1);

pyth(100);
# [ [ 3, 4, 5 ], [ 5, 12, 13 ], [ 7, 24, 25 ], [ 8, 15, 17 ], [ 9, 40, 41 ], [ 11, 60, 61 ], [ 12, 35, 37 ],
#   [ 13, 84, 85 ], [ 16, 63, 65 ], [ 20, 21, 29 ], [ 28, 45, 53 ], [ 33, 56, 65 ], [ 36, 77, 85 ], [ 39, 80, 89 ],
#   [ 48, 55, 73 ], [ 65, 72, 97 ] ]


v := [1 .. 8];

Sum(v);
# 36

Product(v);
# 40320

# You can sum or multiply the result of a function

Sum(v, n -> n^2);
# 204

Product(v, n -> 1/n);
# 1/40320


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

# We are interested to see if
# IMDPRDFT(l)*MDPRDFT(l) = Product(l)*MatSPL(Product(l));
# because we want to see if we can recover the original REAL data.

Declare(MDPRDFT);
Declare(IMDPRDFT);

# Same as (floor(n_t/2)+1)*2.
# RClength := (n) -> (n + 1) mod 2 + n + 1;
RClength := (n) -> PRDFT1(n).dims()[1];

IJmatrix := (n) -> DirectSum(I(1), J(n-1));

tensorIJmatrix := (l) -> When(Length(l) > 0,
                         Tensor(IJmatrix(l[1]), tensorIJmatrix(Drop(l, 1))),
                         Diag([1, -1]));

#F MDPRDFT(<dims>, [<exp>]) - multi-dimensional PRDFT non-terminal
#F   dims = [ <n_1>,.., <n_t> ] list of (positive) dimensions
#F   exp = root of unity exponent scaling (see DFT for exact definition)
#F
#F Definition : multidimensional matrix of size M x N, where
#F M = n_1*...*n_{t-1}*(floor(n_t/2)+1)*2
#F N = n_1*..*n_t
#F This matrix has real components, for an operator with
#F N real inputs,
#F M real outputs for interleaved real and imaginary components.
#F
#F Example (direct)  : MDPRDFT([2,4,4])
#F Example (inverse) : MDPRDFT([2,4,4], -1)
#F
#F In last dimension, t: real-to-complex DFT;
#F then dimensions t-1, ..., 1: complex-to-complex DFT.
#F

# To verify that components of m are real:
# Im(MatSPL(m)) = MatSPL(ApplyFunc(O, m.dims()));

Class(MDPRDFT, TaggedNonTerminal, rec(
    a_lengths := self >> self.params[1],
    a_exp := self >> self.params[2],

    # Components of self.a_lengths() that are equal to 1 are removed.
    abbrevs := [
        P     -> Checked(IsList(P),
                         ForAll(P, IsPosInt),
                         Product(P) > 1,
                         [ RemoveOnes(P), 1 ]),
        (P,k) -> Checked(IsList(P),
                         ForAll(P, IsPosInt),
                         IsInt(k),
                         Product(P) > 1,
                         Gcd(Product(P), k) = 1,
                         [ RemoveOnes(P), k mod Product(P) ])
        ],

    # dims() has 2 components, counting outputs and inputs:
    # dims()[1] is product of all but last dimension, and RClength on last.
    # dims()[2] is product of all dimensions given.
    dims := self >> let(a_lengths := self.a_lengths(),
                        [Product(DropLast(a_lengths, 1)) *
                         RClength(Last(a_lengths)),
                         Product(a_lengths)
                        ]),

terminate := self >>  let(
        a_lengths := self.a_lengths(),
        Ninputs := self.dims()[2],              # number of scalar inputs
        Nlast := Last(a_lengths),        # length of last dimension
        Nrest := DropLast(a_lengths, 1), # all dimension lengths but last
        rcNlast := RClength(Nlast),
        # interleave has a 2x1 matrix [1; 0] along diagonal for each input;
        # it is a block-diagonal matrix of size (2*Ninputs) x Ninputs
        # that takes real inputs and puts a 0 between each.
        interleave := Scat(fTensor(fId(Ninputs), fBase(2,0))),
        # Here we are defining mddft as multi-dimensional DFT that takes
        # input as interleaved real and imaginary data,
        # output as interleaved real and imaginary data.
        mddft := RC(ApplyFunc(MDDFT, self.params)),
        # gath is block-diagonal matrix consisting of Product(Nrest) blocks
        # of size rcNlast x (2*Nlast), so it has
        # input as Product(Nrest) blocks of length 2*Nlast,
        # output as Product(Nrest) blocks of length rcNlast.
        f := fAdd(2*Nlast, rcNlast, 0), # pad length rcNlast to 2*Nlast
        # could also set f := HStack(I(rcNlast), O(rcNlast, 2*Nlast-rcNlast))
        ff := fTensor(List(Nrest, N -> fId(N)), f),
        # could also set ff := Tensor(List(Nrest, N->I(N)), f), no Gath needed.
        gath := Gath(ff),
        # 1. interleave: take real input, put a 0 after each element.
        # 2. mddft: multi-dimensional DFT, interleaved complex input & output.
        # 3. gath: in last dimension, keep only rcNlast of the 2*Nlast components.
        mdprdft := gath * mddft * interleave,
        mdprdft),

    transpose := self >> IMDPRDFT(self.a_lengths(), -self.a_exp()),

    isReal := True,

    normalizedArithCost :=  (self) >> let(n := Product(self.a_lengths()),
                                        IntDouble(2 * n * d_log(n) / d_log(2)) )
));

# Conjugate in interleaved form:  (a, b) maps to (a, -b).
# That's multiplication by matrix [ [1, 0], [0, -1] ].
# That's fBase(2, 0) above -fBase(2, 1).
# Try adapting fId, replacing let(i := Ind(self.params[1]), Lambda(i,i)).
# Or dLin or dOmega.

#F IMDPRDFT(<dims>, [<exp>]) - multi-dimensional inverse PRDFT non-terminal
#F   dims = [ <n_1>,.., <n_t> ] list of (positive) dimensions
#F   exp = root of unity exponent scaling (see DFT for exact definition)
#F
#F Definition : multidimensional matrix of size N x M, where
#F N = n_1*..*n_t
#F M = n_1*...*n_{t-1}*(floor(n_t/2)+1)*2
#F This matrix has real components, for an operator with
#F M real inputs for interleaved real and imaginary components,
#F N real outputs.
#F
#F Example (direct)  : IMDPRDFT([2,4,4])
#F Example (inverse) : IMDPRDFT([2,4,4], -1)
#F
#F In dimensions 1, .., t-1: complex-to-complex DFT;
#F then in last dimension, t: complex-to-real DFT.
#F
Class(IMDPRDFT, TaggedNonTerminal, rec(
    a_lengths := self >> self.params[1],
    a_exp := self >> self.params[2],

    # Components of self.a_lengths() that are equal to 1 are removed.
    abbrevs := [
        P     -> Checked(IsList(P),
                         ForAll(P, IsPosInt),
                         Product(P) > 1,
                         [ RemoveOnes(P), 1 ]),
        (P,k) -> Checked(IsList(P),
                         ForAll(P, IsPosInt),
                         IsInt(k),
                         Product(P) > 1,
                         Gcd(Product(P), k) = 1,
                         [ RemoveOnes(P), k mod Product(P) ])
        ],

    # dims() has 2 components, counting outputs and inputs:
    # dims()[1] is product of all dimensions given.
    # dims()[2] is product of all but last dimension, and RClength on last.
    dims := self >> let(a_lengths := self.a_lengths(),
                        [Product(a_lengths),
                         Product(DropLast(a_lengths, 1)) *
                         RClength(Last(a_lengths))
                        ]),

    terminate := self >>  let(
        a_lengths := self.a_lengths(),
        Nlast := Last(a_lengths),        # length of last dimension
        Nrest := DropLast(a_lengths, 1), # all dimension lengths but last
        rcNlast := RClength(Nlast),
        newcomplex := Nlast - rcNlast/2,
        Nallbutlast := Product(Nrest),
        shuffle := Tensor( L(Nallbutlast*rcNlast/2, rcNlast/2), I(2)),
        unshuffle := Tensor( L(Nallbutlast*Nlast, Nallbutlast), I(2)),
        # This is the basic conjugation matrix.
        flipper := tensorIJmatrix(Nrest),
        newrows := 2*newcomplex*Nallbutlast,
        nzeroleft := When(Nlast mod 2 = 0,
                          Nallbutlast*(rcNlast - 2*newcomplex - 2),
                          Nallbutlast*(rcNlast - 2*newcomplex)),
        hpart := When(newrows > 0,
           HStack(
                  O(newrows, nzeroleft),
                  Tensor(J(newcomplex), flipper),
                  When(Nlast mod 2 = 0, O(newrows, 2*Nallbutlast), [ ])
                 ),
            [ ]),
        stacker := VStack(I(rcNlast*Nallbutlast), hpart),
        # Here we are defining mddft as multi-dimensional DFT that takes
        # input as interleaved real and imaginary data,
        # output as interleaved real and imaginary data.
        imddft := RC(ApplyFunc(MDDFT, self.params)),
        # extract real has 1x2 matrix [1, 0] along diagonal for each input;
        # it is a block-diagonal matrix of size (2*Noutputs) x Noutputs
        # that extracts every other component of the input.
        extractreal := Gath(fTensor(List(a_lengths, N->fId(N)), fBase(2, 0))),
        extend := unshuffle * stacker * shuffle,
        # 1. extend: in last dimension, extend the rcNlast interleaved complex input to 2*Nlast.
        # 2. imddft: inverse multi-dimensional DFT, interleaved complex input & output.
        # 3. extractreal: return the real parts of interleaved complex data.
        imdprdft := extractreal * imddft * extend,
        imdprdft),

    transpose := self >> MDPRDFT(self.a_lengths(), -self.a_exp()),

    isReal := True,

    normalizedArithCost :=  (self) >> let(n := Product(self.a_lengths()),
                                        IntDouble(2 * n * d_log(n) / d_log(2)) )
));


Y := function(f)
    local u;
    u := x -> x(x);
    return u(y -> f(a -> y(y)(a)));
end;

fib := function(f)
    local u;
    u := function(n)
        if n < 2 then
            return n;
        else
            return f(n-1) + f(n-2);
        fi;
    end;
    return u;
end;

Y(fib)(10);
# 55

fac := function(f)
    local u;
    u := function(n)
        if n < 2 then
            return 1;
        else
            return n*f(n-1);
        fi;
    end;
    return u;
end;

Y(fac)(8);
# 40320


# Function composition
Composition := function(f, g)
  local h;
  h := function(x)
    return f(g(x));
  end;
  return h;
end;

# Apply each function in list u, to argument x
ApplyList := function(u, x)
  local i, n, v;
  n := Size(u);
  v := [ ];
  for i in [1 .. n] do
    v[i] := u[i](x);
  od;
  return v;
end;

# Inverse and Sqrt are in the built-in library. Note that GAP doesn't have real numbers nor floating point numbers. Therefore, Sqrt yields values in cyclotomic fields.
# For example,
#    gap> Sqrt(7);
#    E(28)^3-E(28)^11-E(28)^15+E(28)^19-E(28)^23+E(28)^27
# where E(n) is a primitive n-th root of unity
a := [ i -> i + 1, Inverse, Sqrt ];
# [ function( i ) ... end, <Operation "InverseImmutable">, <Operation "Sqrt"> ]
b := [ i -> i - 1, Inverse, x -> x*x ];
# [ function( i ) ... end, <Operation "InverseImmutable">, function( x ) ... end ]

# Compose each couple
z := ListN(a, b, Composition);

# Now a test
ApplyList(z, 3);
[ 3, 3, 3 ]


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

type:="A";
rank:=2;
nr_pos_roots:=3;
L:= SimpleLieAlgebra(type,rank,Rationals);
cb0:=CanonicalBasis(L);

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

ade:=function(e)
	local mb,result,v;

    mb:=Basis(M);

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

root_group:=function(index,t)
	local e,tmp,result,i;

    e:=ade(cb0[index]);
    tmp:=ShallowCopy(e);
	result:=tmp^0;

	i:=1;
	while Length(Set(Concatenation(tmp)))<>1 do
		result:=result+t^i*tmp/Factorial(i);
		i:=i+1;
		tmp:=tmp*e;
	od;
	return result;
end;

ad_nil_deg:=function(e)
    local ee,tmp;
    ee:=ade(e);
    tmp:=ShallowCopy(ee);
    i:=1;
    while Length(Set(Concatenation(tmp)))<>1 do;
        tmp:=tmp*ee;
        i:=i+1;
    od;
    return i;
end;

ad_exp:=function(e,t,v)
    local result,ord_e,i,j,tmp;

    ord_e:=ad_nil_deg(e);

    result:=v;
    for i in [1..ord_e-1] do
        tmp:=ShallowCopy(v);
        for j in [1..i] do
            tmp:=e^tmp;
        od;
        result:=result+t^i*tmp/Factorial(i);
    od;
    return result;
end;

diag_g:=function(e,wedge_sum)
    local fam_algmod,fam_wedge,o,result,new_wedge,i,bv,exp_term;
    fam_algmod:=FamilyObj(wedge_sum);
    o:=ExtRepOfObj(wedge_sum);
    fam_wedge:=FamilyObj(o);
    o:=ExtRepOfObj(o);

    result:=[];
    for i in [1,3..Length(o)-1] do
        new_wedge:=[];
        for bv in o[i] do
            exp_term:=ad_exp(e,1,bv);
            Add(new_wedge,exp_term);
        od;
        Add(result,new_wedge);
        Add(result,o[i+1]);
    od;

    result:=ObjByExtRep(fam_wedge,result);
    result:=ConvertToNormalFormMonomialElement(result);
    result:=ObjByExtRep(fam_algmod,result);

    return result;
end;

exp_action_mat_g:=function(e,M)
    local mb,v,result;
    mb:=Basis(M);

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

u1:=root_group(1,1);

f:=LeftModuleHomomorphismByMatrix(Basis(M),u1,Basis(M));
test:=Image(f,Basis(M)[1]);

bbb:=Basis(extM2);
tmp:=ExtRepOfObj(ExtRepOfObj(bbb[1]));
tmp:=ShallowCopy(tmp);
tmp:=[[Image(f,tmp[1][1]),Image(f,tmp[1][2])],1];

fam:=FamilyObj(ExtRepOfObj(bbb[1]));
tmp:=ObjByExtRep(fam,tmp);
tmp:=ConvertToNormalFormMonomialElement(tmp);

fam2:=FamilyObj(bbb[1]);
tmp:=ObjByExtRep(fam2,tmp);


Filtered([2008 .. 2121], y -> WeekDay([25, 12, y]) = "Sun");
# [ 2011, 2016, 2022, 2033, 2039, 2044, 2050, 2061, 2067, 2072, 2078, 2089, 2095, 2101, 2107, 2112, 2118 ]

# A possible implementation of WeekDayAlt

days := ["Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun"];;

WeekDayAlt := function(args)
   local d, m, y, k;
   d := args[1];
   m := args[2];
   y := args[3];
   if m < 3 then
      m := m + 12;
      y := y - 1;
   fi;
   k := 1 + RemInt(d + QuoInt((m + 1)*26, 10) + y + QuoInt(y, 4)
          + 6*QuoInt(y, 100) + QuoInt(y, 400) + 5, 7);
   return days[k];
end;

Filtered([2008 .. 2121], y -> WeekDayAlt([25, 12, y]) = "Sun");
# [ 2011, 2016, 2022, 2033, 2039, 2044, 2050, 2061, 2067, 2072, 2078, 2089, 2095, 2101, 2107, 2112, 2118 ]


# Solution in '''RPN'''
check := function(x, y, z)
	local r, c, s, i, j, k, a, b, p;
	i := 0;
	j := 0;
	k := 0;
	s := [ ];
	r := "";
	for c in z do
		if c = 'x' then
			i := i + 1;
			k := k + 1;
			s[k] := x[i];
			Append(r, String(x[i]));
		else
			j := j + 1;
			b := s[k];
			k := k - 1;
			a := s[k];
			p := y[j];
			r[Size(r) + 1] := p;
			if p = '+' then
				a := a + b;
			elif p = '-' then
				a := a - b;
			elif p = '*' then
				a := a * b;
			elif p = '/' then
				if b = 0 then
					continue;
				else
					a := a / b;
				fi;
			else
				return fail;
			fi;
			s[k] := a;
		fi;
	od;
	if s[1] = 24 then
		return r;
	else
		return fail;
	fi;
end;

Player24 := function(digits)
	local u, v, w, x, y, z, r;
	u := PermutationsList(digits);
	v := Tuples("+-*/", 3);
	w := ["xx*x*x*", "xx*xx**", "xxx**x*", "xxx*x**", "xxxx***"];
	for x in u do
		for y in v do
			for z in w do
				r := check(x, y, z);
				if r <> fail then
					return r;
				fi;
			od;
		od;
	od;
	return fail;
end;

Player24([1,2,7,7]);
# "77*1-2/"
Player24([9,8,7,6]);
# "68*97-/"
Player24([1,1,7,7]);
# fail

# Solutions with only one distinct digit are found only for 3, 4, 5, 6:
Player24([3,3,3,3]);
# "33*3*3-"
Player24([4,4,4,4]);
# "44*4+4+"
Player24([5,5,5,5]);
# "55*55/-"
Player24([6,6,6,6]);
# "66*66+-"

# A tricky one:
Player24([3,3,8,8]);
"8383/-/"


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

#F DFT(<size>, [<exp>]) - Discrete Fourier Transform non-terminal
#F                         gcd(size, exp) = 1
#F Definition: (n x n)-matrix [ e^((2*pi*exp*i)*k*l/n) | k,l = 0...n-1 ],
#F             observe that canonical root e^(2*pi*i/n) is exponentiated to <exp>
#F             default exp=1,
#              i = sqrt(-1)
#F Example, direct  : DFT(8) ,
#F          inverse : DFT(8, -1)
#F          rotated : DFT(8, 3)
#F
Class(DFT_NonTerm, TaggedNonTerminal, rec(
    abbrevs := [
    (n)       -> Checked(IsPosIntSym(n),
        [_unwrap(n), 1]),
    (n,k)     -> Checked(IsPosIntSym(n), IsIntSym(k), AnySyms(n,k) or Gcd(_unwrap(n),_unwrap(k))=1,
        [_unwrap(n), When(AnySyms(n,k), k, k mod _unwrap(n))])
    ],

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

    dims := self >> When(self.isReal(), 2* [ self.params[1], self.params[1] ], [ self.params[1], self.params[1] ]),

    terminate := self >> let(N := self.params[1], K := self.params[2],
        t := List([0..N-1], r -> List([0..N-1], c -> E(4*N)^(K*self.omega4pow(r,c)))),
            When(self.isReal(), MatAMat(RC(Mat(t)).toAMat()), Mat(t))),

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

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

    TType := T_Complex(TUnknown)
));

Declare(DFT, DFT2, DFT3, DFT4);

Class(DFT, DFT_NonTerm, rec(
    transpose     := self >> DFT(self.params[1], self.params[2]).withTags(self.getTags()),
    conjTranspose := self >> DFT(self.params[1], -self.params[2]).withTags(self.getTags()),
    inverse := self >> self.conjTranspose(),
    omega4pow := (r,c) -> 4*r*c,
    printlatex := (self) >> Print(" \\DFT_{", self.params[1], "} ")
));

DFT1 := DFT;
IDFT := n -> DFT(n,-1);

Class(DFT2, DFT_NonTerm, rec(
    abbrevs := [
    (n)       -> Checked(IsPosIntSym(n),
        [_unwrap(n), 1]),
    (n,k)     -> Checked(IsPosIntSym(n), IsIntSym(k), AnySyms(n,k) or Gcd(_unwrap(n),_unwrap(k))=1,
        [_unwrap(n), When(AnySyms(n,k), k, k mod (2*_unwrap(n)))]),
    ],

    transpose     := self >> DFT3(self.params[1], self.params[2]).withTags(self.getTags()),
    conjTranspose := self >> DFT3(self.params[1], -self.params[2]).withTags(self.getTags()),
    inverse := self >> self.conjTranspose(),
    omega4pow := (r,c) -> 2*r*(2*c+1),
));

Class(DFT3, DFT_NonTerm, rec(
    abbrevs := [
    (n)       -> Checked(IsPosIntSym(n),
        [_unwrap(n), 1]),
    (n,k)     -> Checked(IsPosIntSym(n), IsIntSym(k), AnySyms(n,k) or Gcd(_unwrap(n),_unwrap(k))=1,
        [_unwrap(n), When(AnySyms(n,k), k, k mod (2*_unwrap(n)))]),
    ],

    transpose     := self >> DFT2(self.params[1], self.params[2]).withTags(self.getTags()),
    conjTranspose := self >> DFT2(self.params[1], -self.params[2]).withTags(self.getTags()),
    inverse := self >> self.conjTranspose(),
    omega4pow := (r,c) -> (2*r+1)*2*c,
));

Class(DFT4, DFT_NonTerm, rec(
    abbrevs := [
    (n)       -> Checked(IsPosIntSym(n),
        [_unwrap(n), 1]),
    (n,k)     -> Checked(IsPosIntSym(n), IsIntSym(k), AnySyms(n,k) or Gcd(_unwrap(n),_unwrap(k))=1,
        [_unwrap(n), When(AnySyms(n,k), k, k mod (4*_unwrap(n)))]),
    ],

    transpose     := self >> DFT4(self.params[1], self.params[2]).withTags(self.getTags()),
    conjTranspose := self >> DFT4(self.params[1], -self.params[2]).withTags(self.getTags()),
    inverse := self >> self.conjTranspose(),
    omega4pow := (r,c) -> (2*r+1)*(2*c+1),
));

paramFunc := function(i, m, f, n)
    local res;

#    res := List([0..m-1], e -> SubstBottomUp(Copy(f), i, g -> e));
    res := List([0..m-1], e -> f(e,m));
    res := diagDirsum(res);
    res := fCompose(res, fTensor(fBase(m, i), fId(n)));

    return res;
end;

#F -----------------------------------------------------------------------------
#F Tw1(n, d)
#F Tw1(n, d, k) : diagonal function for Cooley-Tukey FFT, namely
#F   <d> | <n> and
#F   Tw1(n, d, k) = direct_sum_(i = 1)^n/d diag(w_n^0, ..., w_n^(d-1)^i
#F   If the second version is used, w_n is replaced by w_n^k, gcd(<n>, <k>) = 1.
#F
#F -----------------------------------------------------------------------------
Tw1 := (n,d,k) -> Checked(
    IsPosIntSym(n), IsPosIntSym(d), IsIntSym(k),
    fCompose(dOmega(n,k),diagTensor(dLin(div(n,d), 1, 0, TInt), dLin(d, 1, 0, TInt))));

Tw2 := (n,d,k) -> Checked(
    IsPosIntSym(n), IsPosIntSym(d), IsIntSym(k),
    fCompose(dOmega(2*n,k),
         diagTensor(dLin(div(n,d), 2, 1, TInt), dLin(d, 1, 0, TInt))));

Tw3 := (n,d,k) -> Checked(
    IsPosIntSym(n), IsPosIntSym(d), IsIntSym(k),
    fCompose(dOmega(2*n,k),
         diagTensor(dLin(div(n,d), 1, 0, TInt), dLin(d, 2, 1, TInt))));

Tw4 := (n,d,k) -> Checked(
    IsPosIntSym(n), IsPosIntSym(d), IsIntSym(k),
    fCompose(dOmega(4*n,k),
         diagTensor(dLin(div(n,d), 2, 1, TInt), dLin(d, 2, 1, TInt))));

# j-row, i-col
Class(Twid, DiagFunc, rec(
    def := (N, n, rot, a, b, i) -> rec(size:=n),
    lambda := self >> let(
        N := self.params[1], n := self.size, rot := self.params[3],
        a := self.params[4], b := self.params[5], i := self.params[6],
        na := Numerator(a),   nb := Numerator(b),
        da := Denominator(a), db := Denominator(b),
        j := Ind(n),
        Lambda(j, omega(N*da*db, rot*(i*da+na)*(j*db+nb)))),

    range := self >> TComplex,
    domain := self >> self.params[2]
));

Class(ScaledTwid, DiagFunc, rec(
    def := (N, n, k, a, b, i, scaling) -> rec(size:=n),
    lambda := self >> let(N:=self.params[1], n:=self.size, k:=self.params[3],
        a := self.params[4], b := self.params[5], i := self.params[6], scaling := self.params[7],
        na := Numerator(a),   nb := Numerator(b),
        da := Denominator(a), db := Denominator(b),
        j := Ind(n),
        Lambda(j, scaling * omega(N*da*db, k*(i*da+na)*(j*db+nb)))),
    range := self >> TComplex
));

#F TC6(radix, iteration, exp) - diagonal generating function for Stockham algorithm
#F					generates the omega-matrix as described in Van Loin - radix 4 Stockham framework
#F					first parameter of dLin stands for the total dimension of returned function
TC6 := (r, iter, exp) -> Checked(
    IsPosIntSym(r), IsInt(exp),
	fCompose(dOmegaPow(r^(iter+1), 1, exp), dLin(r^iter, 1, 0, TInt)));

#F TC5(radix, iteration) - diagonal generating function for Stockham algorithm - generates a diagonal function
#DP: IsInt(iter) can't be checked, because iter is calculated based on a free variable and not yet evaluated here
TC5 := (r, iter) -> Checked(
    IsPosIntSym(r),
    diagDirsum(fConst(r^iter,1), fCompose(dOmega(r^(iter+1), 1), dLin(r^iter, 1, 0, TInt))));

#F TC4(radix, iteration) - diagonal generating function for Stockham algorithm
#F					generates the omega-matrix as described in Van Loin - Stockham Autosort Network
Class(TC4, DiagFunc, rec(
    abbrevs := [ (rdx, iter, exp) -> [rdx, iter, exp],
	         (rdx, iter, exp) -> [rdx, iter, exp]],
    def := (rdx, iter, exp) -> rec(size := rdx^iter),

    lambda := self >> let(rdx:=self.params[1],
	iter:=self.params[2], n:=rdx^(iter+1), i:=Ind(rdx^iter), exp:=self.params[3],	#n = L (van Loin), i = L/rdx (van Loin)
	Lambda(i, omega(n,i)^exp)),

    range := self >> TInt,
));

Class(Stockham_radix, DiagFunc, rec(
    gen := meth(self, rdx, j)
		local diag;

        if IsInt(rdx) and rdx=2 then
			diag := diagDirsum(TC6(rdx, j, 0), TC6(rdx, j, 1));
		elif rdx = 4 then
			diag := diagDirsum(TC6(rdx, j, 0), TC6(rdx, j, 1), TC6(rdx, j, 2), TC6(rdx, j, 3));
		elif rdx = 8 then
			diag := diagDirsum(TC6(rdx, j, 0), TC6(rdx, j, 1), TC6(rdx, j, 2), TC6(rdx, j, 3), TC6(rdx, j, 4), TC6(rdx, j, 5), TC6(rdx, j, 6), TC6(rdx, j, 7));
		elif rdx = 16 then
			diag := diagDirsum(TC6(rdx, j, 0), TC6(rdx, j, 1), TC6(rdx, j, 2), TC6(rdx, j, 3), TC6(rdx, j, 4), TC6(rdx, j, 5), TC6(rdx, j, 6), TC6(rdx, j, 7),
								TC6(rdx, j, 8), TC6(rdx, j, 9), TC6(rdx, j, 10), TC6(rdx, j, 11), TC6(rdx, j, 12), TC6(rdx, j, 13), TC6(rdx, j, 14), TC6(rdx, j, 15));
		elif rdx > 16 then
            Error("Radix > 16 not supported");
        fi;

        return diag;
    end,

    extract := meth(self, list, elems)
		local i, lc, stride;

		lc := [];
		stride := Length(list)/elems;

		for i in [0..elems-1] do
			lc[i+1] := list[1 + i*stride];
		od;

		return lc;
    end,
));

#F TC2(size, radix, c, k) - diagonal generating function for Pease algorithm
#F
#F TC2 is (5) in Jeremy's Pease paper.
#F
#
# Note: due to current limitations, Spiral is unable to evaluate the
# dimensions of this function properly.
#
# example: TDiag(fPrecompute(TC(N, rdx, j, m)))
#
TC2 := (n, r, c, k) -> Checked(
    IsPosIntSym(n), IsPosIntSym(r), IsPosIntSym(k),
    fCompose(dOmega(n / r^c, k),
	diagTensor(diagTensor(dLin(n/(r^(c+1)), 1, 0, TInt), fConst(r^c, 1)),
		dLin(r, 1, 0, TInt))));

#F TC(size, radix, c, k) - diagonal generating function for Pease algorithm
#F
#F TC is (5) in Jeremy's Pease paper.
#F
Class(TC, DiagFunc, rec(
    abbrevs := [ (n, r, c) -> [n, r, c, 1],
	         (n, r, c, k) -> [n, r, c, k]],
    def := (n, r, c, k) -> rec(size := n),
    lambda := self >> let(n:=self.params[1], r:=self.params[2],
	c:=self.params[3], k:=self.params[4], i:=Ind(n),
	Lambda(i, omega(n/(r^c), k*idiv(i, r^(c+1)) * imod(i, r)))),

    domain := (self) >> self.params[1],
    range := self >> TComplex,
));

#F TCBase(size, radix, k) - diagonal base function for Pease algorithm.
#F This is equivalent to:
#F      L(size,radix) * TC(size, radix, 0, k) * L(size, size/radix).
#F
#F TC is (5) in Jeremy's Pease paper.
#F
Class(TCBase, DiagFunc, rec(
    abbrevs := [ (n, r) -> [n, r, 0, 1],
	         (n, r, k) -> [n, r, 0, k]],
    def := (n, r, c, k) -> rec(size := n-(n/r)),
    lambda := self >> let(n:=self.params[1], r:=self.params[2],
	c:=self.params[3], k:=self.params[4], i:=Ind(n - n/r),
	Lambda(i, omega(n/(r^c), k*idiv(
	    idiv((i+n/r), (r^c)), (n/r^(c+1))) *
		imod(idiv((i+n/r), (r^c)), n/(r^(c+1)))))
		),

    range := self >> TComplex,

));

# TI(n, r, c) - Diagonal generating function for Iterative FFT algorithm
#    where r is the radix, n = size, and c is the iteration
Class(TI, DiagFunc, rec(

    abbrevs := [ (n, r, c) -> [n, r, c, 1],
                 (n, r, c, k) -> [n, r, c, k] ],

    def := (n, r, c, k) -> rec(size := n/(r^c)),
    lambda := self >> let(n:=self.params[1], r:=self.params[2],
	c := self.params[3], k:=self.params[4],
	TC(n/(r^c), r, 0, k).lambda()),

    range := self >> TComplex,
    domain := self >> self.params[1]/(self.params[2]^self.params[3]),
));

# TIFold(n, r, c) - Diagonal generating function for Iterative FFT algorithm
#    where r is the radix, n = size, and c is the iteration.  This is
#    the same as TI, except we will implement it differently because the
#    surrounding structure is not wide enough to perform all the optimizations.
Class(TIFold, DiagFunc, rec(

    abbrevs := [ (n,r,c) -> [n,r, c, 1],
           [ (n, r, c, k) -> [n, r, c, k]]],

    def := (n, r, c, k) -> rec(size := n/(r^c)),
    lambda := self >> let(n:=self.params[1], r:=self.params[2],
	c := self.params[3], k:=self.params[4],
	TC(n/(r^c), r, 0).lambda()),

    range := self >> TComplex,

));

#F ZDFT( <size>, <rshift>, <lshift> )
#F    Discrete Fourier Transform with a cyclic shift on
#F    one or both sides
Class(ZDFT, NonTerminal, rec(
    abbrevs := [ (n,r,l) -> Checked(IsInt(n), n > 0, [n, r, l]) ],
    dims := self >> [ self.params[1], self.params[1] ],

    terminate := self >> let(N:=self.params[1], K:=self.params[2],
    Mat(List([0..N-1],
         r -> List([0..N-1], c -> E(N)^(K*r*c))))),

    transpose := self >> self.__bases__[1](self.params[1], self.params[3], self.params[2]),
    isReal := False,
    SmallRandom := () -> Random([2..16]),
    LargeRandom := () -> 2 ^ Random([6..15])
));

#
# BRDFT(k) = BR(k)*DFT(k)
# This is the same as DRDFT(k,2) = DR(k,2)*DRDFT(k,2)
Class(BRDFT, NonTerminal, rec
(
  abbrevs   := [ (n) -> Checked(IsPosInt(n), [n, []]) ],
#D                 (n, pv) -> Checked(IsPosInt(n), IsList(pv), [n, pv]) ],
  dims      := self >> let(size := self.params[1], [size, size]),
  terminate := self >> Compose(DR(self.params[1], 2), DFT(self.params[1])),
  transpose := self >> Copy(self),
  isReal    := self >> true,
  SmallRandom := () -> Random([2..5]),
  LargeRandom := () -> Random([6..15]),
#D  setpv := meth(self, pv)
#D    local s;
#D    s:= Copy(self);
#D    s.params[2] := pv;
#D    return s;
#D  end,
#D  tagpos := 2

));

#
# DFTBR(k, r) = DFT(k)*BR(k, r)
# This is the same as DFTDR(k,2) = DRDFT(k,2)*BR(k,2)
Class(DFTBR, NonTerminal, rec(
  abbrevs   := [ (n) -> Checked(IsPosInt(n), [n, []]) ],
#D                 (n, pv) -> Checked(IsPosInt(n), IsList(pv), [n, pv]) ],
  dims      := self >> let(size := self.params[1], [size, size]),
  terminate := self >> Compose(DFT(self.params[1]), DR(self.params[1], 2)),
  transpose := self >> Copy(self),
  isReal    := self >> false,
  SmallRandom := () -> Random([2..5]),
  LargeRandom := () -> Random([6..15]),
#D  setpv := meth(self, pv)
#D    local s;
#D    s:= Copy(self);
#D    s.params[2] := pv;
#D    return s;
#D  end,
#D  tagpos := 2

));

Class(DRDFT_Base, TaggedNonTerminal, rec(
  abbrevs   := [ (n,k, r)      -> Checked(IsPosIntSym(n), IsPosIntSym(r), IsInt(k), [n, k, r]) ],
#D                 (n, r, pv) -> Checked(IsPosIntSym(n), IsPosIntSym(r), IsList(pv), [n, r, pv]) ],
  dims      := self >> let(size := self.params[1], [size, size]),
  isReal    := self >> false,
  SmallRandom := () -> Random([2..5]),
  LargeRandom := () -> Random([6..15]),
#D  setpv := meth(self, pv)
#D    local s;
#D    s:= Copy(self);
#D    s.params[3] := pv;
#D    return s;
#D  end,
#D  tagpos := 3
));

Declare(DFTDR);

# DRDFT(n, k, r) = DR(n, r)*DFT(n, k)
#
Class(DRDFT, DRDFT_Base, rec(
  terminate := self >> Compose(DR(self.params[1], self.params[3]), DFT(self.params[1], self.params[2])),
  transpose := self >> ApplyFunc(DFTDR, self.params).withTags(self.getTags()),
));

#
# DFTDR(n, k, r) = DFT(n,k)*DR(n, r)
Class(DFTDR, DRDFT_Base, rec(
  terminate := self >> Compose(DFT(self.params[1], self.params[2]), DR(self.params[1], self.params[3])),
  transpose := self >> ApplyFunc(DRDFT, self.params).withTags(self.getTags()),
));


for p in AlternatingGroup(4) do
    Print(p, "\n");
od;

()
(1,3,2)
(1,2,3)
(1,4,3)
(2,4,3)
(1,3)(2,4)
(1,2,4)
(1,4)(2,3)
(2,3,4)
(1,3,4)
(1,2)(3,4)
(1,4,2)


#######################################################################
# Description: A function to calculate orbits, described in           #
#              section 3.1.                                           #
# Input: - integer 0 < a <= n + 1                                     #
#        - list of generators S                                       #
# Output: - list of integers 'orbit'                                  #
#######################################################################

OrbitSimple := function(a, S)
    local orbit, b, x;
    orbit := [a];
    for b in orbit do
        for x in S do
            if not b^x in orbit then
                Add(orbit, b^x);
            fi;
        od;
    od;
    return orbit;
end;

#######################################################################
#######################################################################

#######################################################################
# Description: A function to calculate orbits and belonging Schreier- #
#              vectors, described in section 3.1.                     #
# Input: - integer 0 < a <= n                                         #
#        - list of generators S                                       #
# Output: - list of integers 'orbit'                                  #
#         - belonging Schreier-vector 'sv' as list of integers        #
#######################################################################

OrbitSV := function(a, S, n)
    local orbit, b, x, i, sv;
    orbit := [a];  sv := [1..n]*0;  sv[a] := -1;
    for b in orbit do
        for i in [1..Length(S)] do
            if not b^S[i] in orbit then
                Add(orbit, b^S[i]);  sv[b^S[i]] := i;
            fi;
        od;
    od;
    return [orbit, sv];
end;

#######################################################################
#######################################################################

#######################################################################
# Description: A function to calculate transversal elements, described#
#              in section 3.1.                                        #
# Input: - orbit element b of type integer 0 < b <= n                 #
#        - Schreier-vector 'sv' as list of integers in range [1..n]   #
#        - list of generators S                                       #
# Output: - transversal element of b w.r.t. a and <S>                 #
#######################################################################

Transversal := function(b, sv, S)
    local u, k;
    if sv[b] = 0 then
        return false;
    fi;
    u := ();  k := sv[b];
    while not k = -1 do
        u := S[k]*u;  b := b^(S[k]^-1);  k := sv[b];
    od;
    return u;
end;


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

# Auxiliary Matrices
# ==================
#
# This file contains useful matrices to be used in rules
#

IsRealMat := mat -> ForAll(mat, r -> ForAll(r, IsRealNumber));

ReMat := mat -> MapMat(mat, e -> re(e));

# Permutations
# ------------

#F
#F GenPerm0(generator_func, size)
#F   returns a permutation generated by applying generator_func to
#F   list [0..size-1]
#F
GenPerm0 := function(size, generator_func)
     Constraint(IsInt(size) and size > 0);
     return PermList(List([0..size-1], generator_func) + 1);
end;

#F
#F GenPerm1(generator_func, size)
#F   returns a permutation generated by applying generator_func to
#F   list [1..size]
#F
GenPerm1 := function(size, generator_func)
     Constraint(IsInt(size) and size > 0);
     return PermList(List([1..size], generator_func));
end;

#F
#F LexMap(r,s)
#F   returns list of lexicographical ordering pairs
#F
LexMap := function(r,s)
   local i,j, result;
   result:=[];
   for i in [0..r-1] do
      for j in [0..s-1] do
         Append(result, [[i,j]]);
      od;
   od;
   return result;
end;

#F
#F ToeplitzMat([..elements..])
#F    Returns a Toeplitz matrix given by element list
#F
ToeplitzMat := function(elements)
    local i, j, n, Ls, mat;
    Constraint(IsList(elements));
    Constraint(Length(elements) > 0);
    Constraint(IsOddInt(Length(elements)));
    n := (Length(elements)+1)/2;
    mat := [ ];
    for i in [1..n] do
        Ls := List([1..n], k->0);
	for j in [1..n] do
	    Ls[j] := elements[n+i-j];
	od;
	Add(mat,Ls);
    od;
    return mat;
end;

# -----------------------------------------------------------------------------
# Matrices used in some breakdown rules
# NOTE: these should be moved to transforms/*
# -----------------------------------------------------------------------------

# perm2( <n> )
#   (x_0, .., x_n-1) --> (x_0, x_n-1, x_1, x_n-2, ..)
# For even <n> it is L(n,n/2) * IJ(n,n/2);
# for odd <n>    OddStride(n,(n+1)/2) * DirectSum(I((n+1)/2), J((n-1)/2))
#
perm2 := n -> When(IsEvenInt(n), M(n,n/2), LIJ(n));

# perm3( <n> )
#   (x_0, .., x_n-1) --> (x_0, x_n/2, x_1, x_n/2+1, ..),
# can be expressed by the previous two:
#   perm3(n) = perm2(n) * (I_n/2 dirsum J(n/2))
# for 2|n it is the stride permutation L^n_n/2
perm3 := n -> When(IsEvenInt(n), L(n, n/2), OS(n, (n+1)/2));

# perm4( <n> )
#   permutes a direct sum of 2x2 blocks
#   into star form, first block outermost etc.
#   for n even it is equal to perm2
perm4 := n -> When(IsEvenInt(n), LIJ(n), Z(n).transpose()*LIJ(n));

# perm5( <n> )
#   reverse the odd indices:
#   (x_0, x_1, .., x_2k) --> (x_0, x_2k-1, x_2, x_2k-3, .., x_1, x_2k)
perm5 := n -> LIJ(n) * L(n,2);

# perm6( <n> )
#   a permutation for rule DCT4_Iterative.
perm6 := SymFunc("perm6", function ( n )
  local k, p, i;

  k := LogInt(n, 2);
  p := PermSPL(perm4(n));
  for i in [1..k - 2] do
    p :=
      p *
      TensorProductPerm(
        [ 2^(i - 1), n/2^(i - 1) ],
        [ (),
          DirectSumPerm(
            [ n/2^i, n/2^i ],
            [ PermSPL(perm4(n/2^i)),
              PermSPL(perm4(n/2^i)) ^ PermSPL(J(n/2^i)) ]
          ) ]
      );
  od;

  return Perm(p, n);
end);

# perm7( <n> )
#   a permutation for converting an RDFT into a DCT2.
perm7 := SymFunc("perm7", function ( n )
  local k, L, i;

  k := (n-1)/2;
  L := [ ];
  for i in [0..k] do
    Add(L, (-1)^(i + k + 1)*i + k);
  od;
  for i in [k + 1..n - 1] do
    Add(L, (-1)^(i + k + 1)*(n - i) + k);
  od;

  return Perm(PermListList(L, [0..n-1]), n);
end);

# Block Matrices
# --------------

# blocks1( <n> )
#   returns an spl that represents a direct sum of
#   DFT_2's in star form. If n is odd then it contains
#   a 1x1 block in the middle.
blocks1 := n -> When(IsEvenInt(n),
    Tensor(I(Int(n/2)), F(2)) ^ perm4(n),
    DirectSum(I(1), Tensor(I(Int(n/2)), F(2))) ^ perm4(n));

blocks4 := (n, k) ->
    DirectSum(I(1), Tensor(I(Int(n/2)), F(2) * Diag([1, k*E(4)]))) ^ perm4(n);

# Sum Matrices
# ------------

# n x n matrix
# diagonal and upper diagonal 1's
sums1 := SymFunc("sums1", function ( n )
  local M, i;

  M := [ ];
  for i in [1..n] do
    Add(M, [i, i, 1]);
  od;
  for i in [1..n-1] do
    Add(M, [i, i+1, 1]);
  od;
  return Sparse(M);
end);

# n x 2n matrix
# [ identity, opposite identity ]
sums2 := SymFunc("sums2", n -> HStack(I(n), J(n)));

# n+1 x 3*n/2 matrix, e.g.,
#[ [   1,   0,   0,   0,   0,   0,   0,   0,   1,   0,   0,   0 ],
#  [   0,   1,   0,   0,   0,   0,   0,   0,   0,   1,   0,   0 ],
#  [   0,   0,   1,   0,   0,   0,   0,   0,   0,   0,   1,   0 ],
#  [   0,   0,   0,   1,   0,   0,   0,   0,   0,   0,   0,   1 ],
#  [   0,   0,   0,   0,   1,   0,   0,   0,   0,   0,   0,   0 ],
#  [   0,   0,   0,   0,   0,   1,   0,   0,   0,   0,   0,  -1 ],
#  [   0,   0,   0,   0,   0,   0,   1,   0,   0,   0,  -1,   0 ],
#  [   0,   0,   0,   0,   0,   0,   0,   1,   0,  -1,   0,   0 ],
#  [   1,   0,   0,   0,   0,   0,   0,   0,  -1,   0,   0,   0 ] ]
sums3 := SymFunc("sums3", function ( n )
  local M, i;

  M := [ ];
  for i in [1..n] do
    Add(M, [i, i, 1]);
  od;
  for i in [1..n/2] do
    Add(M, [i, n + i, 1]);
    Add(M, [n/2 + 1 + i, 3*n/2 - i + 1, -1]);
  od;
  Add(M, [n+1, 1, 1]);

  return Sparse(M);
end);

# n x 2n matrix
# [ identity, -opposite identity ]
sums4 := n -> HStack(I(n), -J(n));

# 2n x n matrix
# [ opposite lower diagonal 1;
#   identity
# ]

# n x 3n/2 matrix, e.g.,
#[ [  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0 ],
#  [  0,  1,  0,  0,  0,  0,  0,  0,  0,  0,  0,  1 ],
#  [  0,  0,  1,  0,  0,  0,  0,  0,  0,  0,  1,  0 ],
#  [  0,  0,  0,  1,  0,  0,  0,  0,  0,  1,  0,  0 ],
#  [  0,  0,  0,  0,  0,  0,  0,  0,  1,  0,  0,  0 ],
#  [  0,  0,  0,  0,  0,  1,  0,  0,  0,  1,  0,  0 ],
#  [  0,  0,  0,  0,  0,  0,  1,  0,  0,  0,  1,  0 ],
#  [  0,  0,  0,  0,  0,  0,  0,  1,  0,  0,  0,  1 ] ]
sums5 := SymFunc("sums5", function ( n )
  local M, i;

  M := [ ];
  for i in [2..n/2] do
    Add(M, [i, i, 1]);
    Add(M, [i, 3*n/2 - i + 2, 1]);
  od;
  Add(M, [n/2 + 1, n + 1, 1]);
  for i in [1..n/2 - 1] do
    Add(M, [n/2 + 1 + i, n/2 + 1 + i, 1]);
    Add(M, [n/2 + 1 + i, n + i + 1, 1]);
  od;

  return Sparse(M);
end);

# a factorization of a matrix like
#   [ [   1/2,     0,     0,     0,     0,     0,     0,     0 ],
#     [  -1/2,     1,     0,     0,     0,     0,     0,     0 ],
#     [   1/2,    -1,     1,     0,     0,     0,     0,     0 ],
#     [  -1/2,     1,    -1,     1,     0,     0,     0,     0 ],
#     [   1/2,    -1,     1,    -1,     1,     0,     0,     0 ],
#     [  -1/2,     1,    -1,     1,    -1,     1,     0,     0 ],
#     [   1/2,    -1,     1,    -1,     1,    -1,     1,     0 ],
#     [  -1/2,     1,    -1,     1,    -1,     1,    -1,     1 ] ]
# into 1 mult and n - 1 subs. If the first column is divided by 1/2,
# then we obtain the transpose - inverse of sums1.
sums6 := SymFunc("sums6", function ( n )
  local T, M, M1, i;

  # small cases
  if n = 1 then
    return Diag([1/2]);
  fi;
  if n = 2 then
    return Mat([[1, 0], [-1, 1]]) * Diag([1/2, 1]);
  fi;

  T    := List([1..n], i -> 1);
  T[1] := 1/2;
  T    := Diag(T);
  M1   := Mat([[1, 0], [-1, 1]]);
  T    := DirectSum(M1, I(n - 2)) * T;
  for i in [3..n - 1] do
    T := DirectSum(I(i - 2), M1, I(n - i)) * T;
  od;
  return DirectSum(I(n - 2), M1) * T;
end);

# sparse1( <n>, <r> )
#   returns an spl for the matrix
#     I_m  -Z_m
#           D_m
#   where m = n/2, Z_m has ones on the lower opposite diagonal,
#   and D_m = cos(r*pi) * diag(1, 2, ..., 2)
#   This matrix occurs in Steidl's rule for DCT2/3.
sparse1 := (n,r) -> CheckedD(IsInt(n), CanBeScalar(r) or IsScalar(r), n mod 2 = 0,
    let(m := n/2,
	d := DirectSum(Diag(cospi(r)), Scale(2*cospi(r), I(n/2-1))),

	BlockMat(
	    [ [I(m), DirectSum(O(1), -J(m-1))],
	      [O(m),          d            ] ])));

# Copy Matrices
# -------------

# 2n x n+1 matrix, e.g.,
#[ [  1,  0,  0,  0,  0 ],
#  [  0,  1,  0,  0,  0 ],
#  [  0,  0,  1,  0,  0 ],
#  [  0,  0,  0,  1,  0 ],
#  [  0,  0,  0,  0,  1 ],
#  [  0,  0,  0,  1,  0 ],
#  [  0,  0,  1,  0,  0 ],
#  [  0,  1,  0,  0,  0 ] ]

copy1 := SymFunc("copy1", function ( n )
  local M, i;

  M := [ ];
  for i in [1..n + 1] do
    Add(M, [i, i, 1]);
  od;
  for i in [1..n - 1] do
    Add(M, [n + 1 + i, n - i + 1, 1]);
  od;

  return Sparse(M);
end);

# 2n x n matrix, e.g.,
#[ [   1,   0,   0,   0 ],
#  [   0,   1,   0,   0 ],
#  [   0,   0,   1,   0 ],
#  [   0,   0,   0,   1 ],
#  [   0,   0,   0,   0 ],
#  [   0,   0,   0,  -1 ],
#  [   0,   0,  -1,   0 ],
#  [   0,  -1,   0,   0 ] ]

copy2 := SymFunc("copy2", function ( n )
  local M, i;

  M := [ ];
  for i in [1..n] do
    Add(M, [i, i, 1]);
  od;
  for i in [1..n - 1] do
    Add(M, [n + 1 + i, n - i + 1, -1]);
  od;

  return Sparse(M);
end);

# Monomial Matrices
# -----------------

# monomial1 ( <n> )
#   Let m = n/4. Then monomial1(<n>) returns an spl of type "sparse"
#   that represents
#   I_m+1  0   0    0
#    0     0   J_m  0
#    0     0   0   -J'_m
#    0   I_m-1 0    0
# where the prime indicates that the entry in the last row
# has opposite sign

monomial1 := SymFunc("monomial1", function ( n )
  local m, L, i;

  m := n/4;
  L := [ ];
  for i in [1..m+1] do
    Add(L, [i, i, 1]);
  od;
  for i in [1..m] do
    Add(L, [m+1+i, 3*m+1-i, 1]);
  od;
  for i in [1..m-1] do
    Add(L, [2*m+1+i, 4*m+1-i, -1]);
  od;

  # the exception
  Add(L, [3*m+1, 3*m+1, 1]);
  for i in [1..m-1] do
    Add(L, [3*m+1+i, m+1+i, 1]);
  od;

  return Sparse(L);
end);


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

#F Random SPLs
#F -----------
#F

#F RandomPermSPL ( <n> )
#F   returns a random spl of type "perm" or "symbol" representing
#F   a <n> x <n> permutation matrix.
#F

RandomPermSPL := function ( n )
  local type;

  type := Random(["perm", "J", "L"]);
  if type = "perm" then
    return Perm(Random(SymmetricGroup(n)), n);
  elif type = "J" then
    return SPLSymbol("J", n);
  elif type = "L" then
    return SPLSymbol("L", [n, Random(DivisorsInt(n))]);
  else
    Error("should not happen");
  fi;
end;

#F RandomSymbolSPL ( <n> )
#F   returns a random spl of type "symbol" representing
#F   a <n> x <n> matrix.
#F

RandomSymbolSPL := function ( n )
  local type, d;

  if n = 1 then
    type := Random(["I", "J"]);
  elif n = 2 then
    type := Random(["I", "J", "F", "Rot"]);
  elif IsPrime(n) then
    type := Random(["I", "J"]);
  else
    type := Random(["I", "J", "L", "T"]);
  fi;
  if type in ["I", "J", "F"] then
    return SPLSymbol(type, n);
  elif type = "Rot" then
    return SPLSymbol("Rot", Random(Rationals));
  elif type in ["L", "T"] then
    d := Random([2..Tau(n)-1]);
    return SPLSymbol(type, [n, DivisorsInt(n)[d]]);
  else
    Error("should not happen");
  fi;
end;

#F RandomTerminalSPL ( <n> )
#F   returns a random terminal spl representing a <n> x <n> matrix.
#F

RandomTerminalSPL := function ( n )
  local type, randscalar, L, i, P, p;

  # function to return a somewhat random scalar <> 0
  randscalar := function ( )
    local L, den;

    L :=
      Concatenation(
        [-5..-1], [1..5], List([1/3,2/5,3/7], CosPi), List([2..5], E)
      );
    return Random(L)/Random([1..5]);
  end;

  # choose type, mats only for n <= 3, give better odds to
  # composed types
  if n <= 3 then
    type :=
      Random( [
	"mat", "sparse", "diag", "perm", "symbol",
        "compose", "directSum", "tensor",
        "compose", "directSum", "tensor",
        "scalarMultiple", "conjugate"
      ] );
  else
    type :=
      Random( [
	"sparse", "diag", "perm", "symbol",
        "compose", "directSum", "tensor",
        "scalarMultiple", "conjugate"
      ] );
  fi;

  # dispatch on types
  if type = "mat" then

    return Mat(List([1..n], i -> List([1..n], j -> randscalar())));

  elif type = "sparse" then

    # choose n entries
    # make sure there are no doubles
    L := [ ];
    P := [ ];
    for i in [1..n] do
      repeat
        p := [Random([1..n]), Random([1..n])];
      until not p in P;
      AddSet(P, p);
      Add(L, [p[1], p[2], randscalar()]);
    od;
    if ForAll(L, t -> t[1] <> n or t[2] <> n) then

      # add entry in lower right corner
      Add(L, [n, n, randscalar()]);
    fi;
    return Sparse(L);

  elif type = "diag" then

    return Diag(List([1..n], i -> randscalar()));

  elif type = "perm" then

    return RandomPermSPL(n);

  elif type = "symbol" then

    return RandomSymbolSPL(n);

  elif type = "compose" then

    # choose 2 factors
    i := Random([2]);
    return Compose(List([1..i], i -> RandomTerminalSPL(n)));

  elif type = "directSum" then

    if n <= 3 then
      return RandomTerminalSPL(n);
    fi;

    # choose partition into 2 summands
    i := Random([2]);
    return
      DirectSum(List(Random(OrderedPartitions(n, i)), RandomTerminalSPL));

  elif type = "tensor" then

    if IsPrime(n) or n = 1 then
      return RandomTerminalSPL(n);
    else
      i := Random(DivisorsInt(n));
      return Tensor(RandomTerminalSPL(i), RandomTerminalSPL(n/i));
    fi;

  elif type = "scalarMultiple" then

    return Scale(randscalar(), RandomTerminalSPL(n));

  elif type = "conjugate" then

    return Conjugate(RandomTerminalSPL(n), RandomPermSPL(n));

  else
    Error("should not happen");
  fi;
end;


# Using functions from 'RandomPerm.gi' and 'Orbit.gi'
Read("RandomPerm.gi"); Read("Orbit.gi");

#######################################################################
# Description: A function to calculate the pointwise image of a list. #
# Input: - list of integers B = [b_1,...,b_k]                         #
#        - permutation x as cycle                                     #
# Output: - list of integers [b_1^x,...,b_k^x]                        #
#######################################################################

BaseImage := function(B, x)
    local i, image;
    image := [];
    for i in [1..Length(B)] do
        Add(image, B[i]^x);
    od;
    return image;
end;

#######################################################################
#######################################################################

#######################################################################
# Description: A function to setup partial generating sets of         #
#              stabilizeres.                                          #
# Input: - list of integers B = [b_1,...,b_k]                         #
#        - generating system S as list of permutations                #
# Output: - list of generating system (lists of permutations),        #
#           one generating system for each stabilizer in chain        #
#######################################################################

GeneratingSets := function(B, S)
    local s, x, i, partialBase, sets;
    sets := [S];
    for i in [1..Length(B)-1] do
        Add(sets, []);
    od;
    for x in S do
        for i in [1..Length(B)-1] do
            partialBase := B{[1..i]};
            if BaseImage(partialBase, x) = partialBase then
                Add(sets[i+1], x);
            else
                break;
            fi;
        od;
    od;
    return sets;
end;

#######################################################################
#######################################################################

#######################################################################
# Description: A function to strip a permutation w.r.t. a base,       #
#              described in section 3.2.                              #
# Input: - permutation g as cycle                                     #
#        - list of integers B = [b_1,...,b_k]                         #
#        - generating system S as list of permutations                #
#        - data structure returned by 'GeneratingSets' function       #
# Output: - residue and dropout level of g                            #
#######################################################################

Strip := function(g, B, orbits, sgs)
    local m, i, u, b;
    m := g;
    for i in [1..Length(B)] do
        b := B[i]^m;
        if orbits[i][2][b] = 0 then
            return [m, i];
        fi;
        u := Transversal(b, orbits[i][2], sgs[i]);  m := m*(u^(-1));
    od;
    return [m, Length(B)+1];
end;

#######################################################################
#######################################################################

#######################################################################
# Description: The standard deterministic Schreier-Sims-Algorithm     #
#              described in section 3.3.                              #
# Input: - list B of base points (might be empty list [] first)       #
#        - list S of given generators of group G                      #
#        - integer n specifying the degree of symmetric group the     #
#          generated group G is embedded in                           #
# Output: - list 'BSGS' with three entries including                  #
#           -- the calculated base B as list in BSGS[1]               #
#           -- a strong generating set S as list of partial           #
#              generating sets for each stabilizer in BSGS[2]         #
#           -- a list of the sizes of the orbits belonging to B       #
#              and S in BSGS[3]                                       #
#######################################################################

SchreierSims := function(B, S, n)
    local x, u, y, h, b, i, j, k, t, orbits, sgs, sizes, stripped;

    # extending partial base so that no point of S
    # fixes all points
    for x in S do
        if BaseImage(B, x) = B then
            Add(B, MovedPoints(x)[1]);
        fi;
    od;
    # calculating generating sets for each stabilizer
    sgs := GeneratingSets(B, S);

    # calculate orbits and schreier vectors of base
    # points under action of generated stabilizers
    orbits := [];
    for i in [1..Length(B)] do
        Add(orbits, OrbitSV(B[i], sgs[i], n));
    od;
    i := Length(B);
    while i >= 1 do
        for b in orbits[i][1] do
            t := Transversal(b, orbits[i][2], sgs[i]);
            for x in sgs[i] do
                u := Transversal(b^x, orbits[i][2], sgs[i]);  y := true;
                if not t*x = u then
                    # check whether Schreier generator
                    # belongs to H^(i+1)
                    stripped := Strip(t*x*(u^(-1)), B, orbits, sgs);
                    j := stripped[2];  h := stripped[1];

                    # in case the Schreier generator does
                    # not belong to H^(i+1) do ...
                    if j <= Length(B) then
                        y := false;
                    elif not h = () then
                        Add(B, MovedPoints(h)[1]);
                        Add(sgs, []);  y := false;
                    fi;
                    if y = false then
                        # update generating sets, orbits
                        # and Schreier vectors
                        for k in [i+1..j] do
                            Add(sgs[k], h);
                            orbits[k] := OrbitSV(B[k], sgs[k], n);
                        od;
                        i := j;  break;
                    fi;
                fi;
            od;
            if y = false then
                break;
            fi;
        od;
        if y = false then
            continue;
        fi;
        i := i - 1;
    od;
    sizes := [];
    for i in [1..Length(B)] do
       Add(sizes, Length(orbits[i][1]));
    od;
    return [B, sgs, sizes];
end;

#######################################################################
#######################################################################

#######################################################################
# Description: The randomized Schreier-Sims-Algorithm,                #
#              described in section 4.2.                              #
# Input: - list B of base points (might be empty list [] first)       #
#        - list S of given generators of group G                      #
#        - an integer 'bound' capping the number of elements          #
#          getting stripped                                           #
#          with trivial residue in a row                              #
#        - integer n specifying the degree of symmetric group the     #
#          generated group G is embedded in                           #
# Output: - list 'BSGS' with three entries including                  #
#           -- the calculated base B as list in BSGS[1]               #
#           -- a strong generating set S as list of partial           #
#              generating sets for each stabilizer in BSGS[2]         #
#           -- a list of the sizes of the orbits belonging to B       #
#              and S in BSGS[3]                                       #
#######################################################################

RandomSchreierSims := function(B, S, bound, n)
    local x, g, i, h, X, c, j, k, y, sgs, orbits, sizes, SGS, stripped;

    for x in S do
        if BaseImage(B, x) = B then
            Add(B, MovedPoints(x)[1]);
        fi;
    od;

    sgs := GeneratingSets(B, S);  orbits := [];  SGS := ShallowCopy(S);

    for i in [1..Length(B)] do
        Add(orbits, OrbitSV(B[i], sgs[i], n));
    od;

   X := InitGenerator(S);  c := 0;
   while c < bound do
       g := RandomPerm(S, X);
       stripped := Strip(g, B, orbits, sgs);
       j := stripped[2];  h := stripped[1];  y := true;
       if j <= Length(B) then
           y := false;
       elif not h = () then
           y := false;  Add(B, MovedPoints(h)[1]);  Add(sgs, []);
       fi;
       if y = false then
           Add(SGS, h);
           for k in [2..j] do
               Add(sgs[k], h);
               orbits[k] := OrbitSV(B[k], sgs[k], n);
           od;
           c := 0;
       fi;
       c := c + 1;
   od;

   sizes := [];  sgs[1] := SGS;
   for i in [1..Length(B)] do
       Add(sizes, Length(orbits[i][1]));
   od;
   Add(sgs, [()]);
   return [B, sgs, sizes];
end;

#######################################################################
#######################################################################

#######################################################################
# Description: A function to remove redundant generators from         #
#              a strong generating set, described in section 4.2.     #
# Input: - BSGS data structure returned by RandomSchreierSims         #
#        - Generating set which defined the group. NOT the strong     #
#          generating set returned by RandomSchreierSims!             #
#        - integer n specifying the size of the set the group         #
#          operates on
#######################################################################

RemoveRedundantGens := function(BSGS, initialGenSet, n)
    local orbits, i, g, newGenSys, removeGen;
    orbits := [];

    removeGen := function(SGS, gen, level)
        local j;
        for j in [1..level] do
            RemoveSet(SGS[j], gen);
        od;
    end;
    for i in [1..Length(BSGS[1])] do
        BSGS[2][i] := Set(BSGS[2][i]);
        Add(orbits, Set(OrbitSimple(BSGS[1][i], BSGS[2][i])));
    od;
    for i in Reversed([1..Length(BSGS[1])-1]) do
        for g in BSGS[2][i] do
            if not g in BSGS[2][i+1]
               and not g in initialGenSet then
                newGenSys := Set(BSGS[2][i]);
                RemoveSet(newGenSys, g);
                if Set(OrbitSimple(BSGS[1][i], newGenSys)) = orbits[i]
                	then removeGen(BSGS[2], g, i);
                fi;
            fi;
        od;
    od;
    orbits := [];
    for i in [1..Length(BSGS[1])] do
        Add(orbits, OrbitSV(BSGS[1][i], BSGS[2][i], n));
    od;
    Add(BSGS, orbits);  MakeImmutable(BSGS);
end;

#######################################################################
#######################################################################

#######################################################################
# Description: The sequential deterministic verification,             #
#              described in section 4.3                               #
# Input: - BSGS data structure returned by RandomSchreierSims         #
#        - integer m specifying which layer H^{(m)}_{b_m} = H^{(m+1)} #
#          has to be verified                                         #
# Output: - boolean, true if H^{(m)}_{b_m} = H^{(m+1)} holds,         #
#           else false                                                #
#######################################################################

SimpleVerify := function(BSGS, m)
    local x, u, b, t, orbits, gen, stripped, sgs, B;

    B := BSGS[1]; sgs := BSGS[2]; orbits := BSGS[4];

    for b in orbits[m][1] do
         t := Transversal(b, orbits[m][2], sgs[m]);
         for x in sgs[m] do
            if not x in sgs[m+1] or orbits[m+1][2][b] = 0 then
                 u := Transversal(b^x, orbits[m][2], sgs[m]);
                 if not t*x = u then
                    gen := t*x*(u^(-1));
                    # check whether Schreier generator 'gen'
                    # belongs to H^(i+1)
                    stripped := Strip(gen, B, orbits, sgs);
                    # if not, return
                    if stripped[2] <= Length(B) then
                        return false;
                    elif not stripped[1] = () then
                        return false;
                    fi;
                 fi;
              fi;
         od;
    od;
    return true;
end;

#######################################################################
#######################################################################

#######################################################################
# Description: The deterministic verification, parallelized w.r.t.    #
#              the length of the basic orbits, described as method 2  #
#              in section 5.1.                                        #
# Input: - BSGS data structure returned by RandomSchreierSims         #
#        - integer m specifying which layer H^{(m)}_{b_m} = H^{(m+1)} #
#          has to be verified                                         #
# Output: - boolean, true if H^{(m)}_{b_m} = H^{(m+1)} holds,         #
#           else false                                                #
#######################################################################

ParallelVerify := function(BSGS, m)
    local b, i, orbits, sgs, B, Verify, tasks, results, numOfTasks,
          remaining, partition, pointsPerTask;

    # the well-known deterministic verify routine
    Verify := function(B, sgs, orbits, m, partition)
        local x, u, i, stripped, gen, t;
        for b in partition do
            t := Transversal(b, orbits[m][2], sgs[m]);
                 for x in sgs[m] do
                    if not x in sgs[m+1] or orbits[m+1][2][b] = 0 then
                         u := Transversal(b^x, orbits[m][2], sgs[m]);
                         if not t*x = u then
                            gen := t*x*(u^(-1));
                            stripped := Strip(gen, B, orbits, sgs);

                            if stripped[2] <= Length(B) then
                                return false;
                            elif not stripped[1] = () then
                                return false;
                            fi;
                         fi;
                      fi;
                 od;
        od;
        return true;
    end;

    B := BSGS[1]; sgs := BSGS[2];
    orbits := BSGS[4]; partition := [];

    pointsPerTask := Int(Length(orbits[m][1])*0.05) + 1;
    numOfTasks := Int(Length(orbits[m][1])/pointsPerTask) + 1;
    remaining := Length(orbits[m][1]) mod pointsPerTask;

    tasks := [1..numOfTasks]; results := [1..numOfTasks];

    # slice orbit into 'numOfTask' many nearly equally sized subsets
    for i in [1..numOfTasks-1] do
        Add(partition, orbits[m][1]{[(i-1)*pointsPerTask+1..
                                         i*pointsPerTask]});
    od;

    Add(partition, orbits[m][1]{[(numOfTasks-1)*pointsPerTask+1..
                    ((numOfTasks-1)*pointsPerTask+remaining)]});

    # start several verifications ...
    for i in [1..numOfTasks] do
        tasks[i] := RunTask(Verify, B, sgs, orbits, m, partition[i]);
    od;

    # ... and evaluate their results afterwards
    for i in [1..numOfTasks] do
        results[i] := TaskResult(tasks[i]);
    od;
    if false in results then
        return false;

    else
        return true;
    fi;
end;


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

ImportAll(spiral);

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

#alphai := (n,i,alpha) -> fr(n,i,2*alpha).ev()/2;
cat := Concatenation;
cos := x->CosPi(2*x);
sin := x->SinPi(2*x);

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

MatRDFT1 := n -> cat(
     [ List([0..n-1], x->1), List([0..n-1], x->(-1)^x) ],
     cat(List([1..n/2-1], i->
                    [ ls(n, j -> cos(j*i/n)),
                      ls(n, j -> sin(j*i/n)) ])));

MatRDFT3 := n ->
     cat(List([0..n/2-1], i->
                    [ ls(n, j -> cos(j*(i+1/2)/n)),
                      ls(n, j -> sin(j*(i+1/2)/n)) ]));

MatRDFT := (N,a) -> let(n:=N/2,
     cat(ls(n, i-> let(aa := alphai(n,i,a), # 2 since we use 2pi*a
                    [ ls(2*n, j -> cos(j*aa)),
                      ls(2*n, j -> sin(j*aa)) ]))));

MatrDFT := (N,a) -> let(n:=N/2,
     cat(ls(n, i-> let(aa := alphai(n,i,a),
                    [ cat(ls(n, j->cos(j*aa)), (-1)^i*ls(n, j -> -sin(j*aa))),
                      cat(ls(n, j->sin(j*aa)), (-1)^i*ls(n, j ->  cos(j*aa))) ]))));

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


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

#F DHT <size>)
#F Definition: (n x n)-matrix [ cas(2*pi*i*k*l/n) | k,l = 0...n-1 ] or
#F                            [ cos(2*pi*i*k*l/n) + sin(2*pi*i*k*l/n) | k,l = 0...n-1 ]
#F Note:     DHT_n = Re(DFT_n) + Im(DFT_n)
#F Example:  DHT(8)
#F
Class(DHT, NonTerminal, rec(
    abbrevs := [ n -> Checked(IsPosInt(n), [n]) ],
    dims := self >> [self.params[1], self.params[1]],
    terminate := self >> Mat(Sqrt(self.params[1]) * Global.DHT(self.params[1])),
    transpose := self >> Copy(self),
    isReal := self >> true,
    SmallRandom := ( ) -> Random([2, 4, 6, 8, 12, 16, 24, 32]),
    normalizedArithCost := self >> let(n := self.params[1], IntDouble(2.5 * n * d_log(n) / d_log(2)))
));

#F -----------------------------------------------------------------------------
#F XH(size) : represents a matrix used in DHT radix-2 rule (temporary solution)
#F -----------------------------------------------------------------------------
Class(XH, Sym, rec(
    notSupported := true,
    abbrevs := [ n -> Checked(IsInt(n), n >= 4, n mod 4 = 0, n) ],

    def := N -> When(N = 4, I(4),
	DirectSum(
	    I(N/2 + 1),
	    DirectSum(
		I(1),
		List([1..N/4-1], i -> Rot(1/2-2*i/N) * J(2))) ^
	              perm4(N/2-1))),

    transpose := self >> self,

    isReal := True
));

RulesFor(DHT, rec(
    #F DHT_Base: DHT_2 = F_2
    #F
    DHT_Base := rec (
	info             := "DHT_2 -> F_2",
	forTransposition := false,
	isApplicable     := P -> P[1] = 2,
	allChildren := P -> [[ ]],
	rule := (P, C) -> F(2)
    ),

    DHT_toPRDFT := rec(
        isApplicable := P -> P[1] > 2,
        allChildren := P -> [[ PRDFT(P[1]) ]],
        rule := (P, C) -> let(n := P[1], cut := Mat([[1,0]]),
            OS(n,-1) * # or set the rotation to -1
            LIJ(n).transpose() *
            Cond(IsEvenInt(n), DirectSum(cut, Tensor(I(n/2-1), F(2)), cut) * C[1],
                 IsOddInt(n),  DirectSum(cut, Tensor(I((n-1)/2), F(2)))    * C[1]))
    ),

    #F DHT_DCT1andDST1:
    #F
    #F   DHT_n = blocks * (DCT1_(n/2+1) dirsum DST1_(n/2-1)) * blocks
    #F
    #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
    DHT_DCT1andDST1 := rec (
	info             := "DHT_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],
	    DirectSum(I(1), blocks1(n - 1)) *
	    DirectSum(C[1], C[2] ^ J(n/2 - 1)) *
	    DirectSum(I(1), blocks1(n - 1)))
    ),

    #F DHT_2:
    #F Radix-2 Cooley-Tukey
    #F
    DHT_Radix2 := rec (
	info             := "DHT_n -> DHT_n/2",
	forTransposition := false,
	isApplicable     := P -> P[1] mod 2 = 0 and IsPrimePowerInt(P[1]) and P[1] > 2,
	allChildren := P -> [[ DHT(P[1]/2) ]],
	rule := (P, C) -> let(n:=P[1],
	    Tensor(F(2), I(n/2)) *
	    XH(n) *
	    Tensor(I(2), C[1]) *
	    L(n, 2))
    )
));


# The first two work with rationals or with floats
# (but bear in mind that support of floating point is very poor in GAP)
mean := v -> Sum(v) / Length(v);
harmean := v -> Length(v) / Sum(v, Inverse);
geomean := v -> EXP_FLOAT(Sum(v, LOG_FLOAT) / Length(v));

mean([1 .. 10]);
# 11/2
harmean([1 .. 10]);
# 25200/7381

v := List([1..10], FLOAT_INT);;
mean(v);
# 5.5
harmean(v);
# 3.41417
geomean(v);
# 4.52873


# Complete multipartite graphs.
BindGlobal("CompleteMultipartiteGraph", function(arg)
    local sizes, dp, F, G, m, n;
    F := function(x, y) return x[1] <> y[1]; end;
    if Length(arg) = 0 then
        Error("at least one argument expected");
        return fail;
    elif Length(arg) = 1 then
        sizes := arg[1];
        dp := DirectProduct(List(sizes, i -> SymmetricGroup(i)));
        return Graph(dp, Union(List([1..Length(sizes)],
            i -> List([1..sizes[i]], j -> [i, j]))),
            OnSum(dp), F, true);
    else
        m := arg[1];
        n := arg[2];
        return Graph(WreathProductSymmetricGroups(n, m),
                     Cartesian([1..m], [1..n]),
                     function(x, g)
                        local y;
                        y := (n*(x[1]-1)+x[2])^g - 1;
                        return [Int(y/n)+1, y mod n + 1];
                     end, F, true);
    fi;
end);

# Cycle graphs.
BindGlobal("CycleGraph", n -> Graph(DihedralGroup(IsPermGroup, 2*n), [1..n],
    OnPoints, function(x, y)
        return (x-y) mod n in [1,n-1];
    end, true));

# Cocktail party graphs.
BindGlobal("CocktailPartyGraph",
    n -> CompleteMultipartiteGraph(n, 2)
);

# Paley graphs.
# For q = 1 (mod 4) a prime power, the graph is strongly regular.
# For q = 3 (mod 4) a prime power, the graph is directed.
BindGlobal("PaleyGraph", function(q)
    local dp;
    dp := DirectProduct(FieldAdditionPermutationGroup(q),
        Group(GeneratorsOfGroup(FieldMultiplicationPermutationGroup(q))[1]^2));
    return Graph(dp, Elements(GF(q)), OnPaley(q, dp),
        function(x, y)
            return IsOne((x-y)^((q-1)/2));
        end, true);
end);

# Latin square graphs.
BindGlobal("LatinSquareGraph", function(arg)
    local dim, dp, G, invt, vcs;
    if Length(arg) = 0 then
        Error("at least one argument expected");
        return fail;
    fi;
    G := arg[1];
    if Length(arg) > 1 then
        invt := arg[2];
    else
        invt := true;
    fi;
    if IsGroup(G) then
        dp := DirectProduct(G, G);
        if invt then
            vcs := Cartesian(G, G);
        else
            vcs := [[One(G), One(G)]];
        fi;
        return Graph(dp, vcs, OnLatinSquare(dp),
            function(x, y)
                return x <> y and (x[1] = y[1] or x[2] = y[2]
                                or x[1]*x[2] = y[1]*y[2]);
            end, invt);
    else
        dim := DimensionsMat(G);
        return AdjFunGraph(Cartesian([1..dim[1]], [1..dim[2]]),
            function(x, y)
                return x <> y and (x[1] = y[1] or x[2] = y[2]
                                or G[x[1]][x[2]] = G[y[1]][y[2]]);
            end);
    fi;
end);

# Complete Taylor graphs, i.e. complete bipartite graphs minus a matching.
BindGlobal("CompleteTaylorGraph", function(n)
    local G;
    G := EdgeOrbitsGraph(Group([(1,2)(n+1,n+2),
                    PermList(Concatenation([2..n], [1], [n+2..2*n], [n+1])),
                    PermList(Concatenation([n+1..2*n], [1..n]))]), [1, n+2]);
    AssignVertexNames(G, Cartesian([1, 2], [1..n]));
    return G;
end);


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

#F --------------------------------------------------------------------------------
RulesFor(DST1, rec(
  #F DST1_Base1: DST1_1 = I_1
  #F
  DST1_Base1 := rec (
      info             := "DST_1 -> I_1",
      forTransposition := false,
      isApplicable     := P -> P[1] = 1,
      rule := (P, C) -> I(1)
  ),

  #F DST1_Base2: DST1_2 = cos(pi/6) * F_2
  #F
  DST1_Base2 := rec (
      info             := "DST_2 -> c * F_2",
      forTransposition := false,
      isApplicable     := P -> P[1] = 2,
      rule := (P, C) -> CosPi(1/6) * F(2)
  ),

  #F DST1_DST3and1: 1984
  #F
  #F   DST1_(n-1) = perm * (DST3_n/2 dirsum DST1_(n/2-1) ^ perm) * (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
  DST1_DST3and1 := rec (
      info          := "DST1_(n-1) --> DST3_n/2, DST1_(n/2-1)",
      isApplicable  := P -> (P[1] + 1) mod 2 = 0 and P[1] >= 2,
      allChildren   := P -> [[ DST3((P[1] + 1)/2), DST1((P[1] - 1)/2) ]],
      rule := (P, C) -> # P is odd
	 DirectSum(C[1], C[2]) ^ OS(P[1], 2) *
	 DirectSum(I(1), Tensor(I((P[1] - 1)/2), F(2))) ^ Z(P[1],P[1]-1) *
	 LIJ(P[1])
         #LIJ(P) *
	 #DirectSum(C[1], C[2] ^ J((P - 1)/2)) *
	 #DirectSum(I(1), Tensor(I((P - 1)/2), F(2))) ^ (Z(P,P-1) * LIJ(P))
  ),

  DST1_toDCT3 := rec( # this rule is probably numerically unstable
      isApplicable  := P -> P[1] >= 3,
      allChildren   := P -> [[ DCT3(P[1]+1) ]],
      rule := (P, C) -> let(n:=P[1], N := n+1,
          RowTensor(n, 1, Mat([[1,-1]])) * C[1] *
          VStack(RowVec(fConst(TReal, n, 0)),
                 Diag(FList(TReal, List([1..n], i -> CosPi(i/(2*N)) / SinPi(i/N))))))
  )
));

#F --------------------------------------------------------------------------------
RulesFor(DST2, rec(
    #F DST2_Base2: DST2_2 = diag(1/Sqrt(2), 1) * F_2
    #F
    DST2_Base2 := rec(
	info := "DST_2 -> F_2",
	isApplicable := P -> P[1] = 2,
	rule := (P, C) -> Diag([Sqrt(1/2), 1]) * F(2)
    ),

    #F DST2_toDCT2: DST2_n =  perm * DCT2_n * diag
    #F
    #F   Wang:
    #F     A Fast Algorithm for the Discrete Sine Transform by the
    #F     Fast Cosine Transform, IEEE Trans. on ASSP, 1982, pp. 814--815
    #F
    DST2_toDCT2 := rec (
	info             := "DST2_n -> DCT2_n",
	isApplicable     := P -> P[1] > 2,
	allChildren := P -> [[ DCT2(P[1]) ]],
	rule := (P, C) ->
	    J(P[1]) * C[1] * Diag(List([0..P[1] - 1], i -> (-1)^i))
    ),

    #F DST2_DST2and4: 1982
    #F
    #F   DST2'_n = perm * (DST4_n/2 dirsum DST2'_n/2^perm) * (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
    DST2_DST2and4 := rec(
	info             := "DST2_n --> DST4_n/2, DST2_n/2",
	isApplicable     := P -> P[1] > 2 and P[1] mod 2 = 0,
	allChildren      := P -> [[ DST4(P[1]/2), DST2(P[1]/2) ]],
	rule := (P, C) ->
	    DirectSum(C[1], C[2]) ^ L(P[1],2) *
	    Tensor(I(Int((P[1] / 2))), F(2)) *
 	    LIJ(P[1])
    )
));

#F --------------------------------------------------------------------------------
RulesFor(DST4, rec(
    #F DST4_Base2: DST4_2 = (1,2) * R_15/8
    #F
    DST4_Base := rec (
	info             := "DST_4 -> R_15/8",
	forTransposition := false,
	isApplicable     := P -> P[1] = 2,
	rule := (P, C) -> J(2) * Rot(15/8)
    ),

    #F DST4_1: 1984
    #F
    #F   DST4_n = perm * DCT4_n * diag
    #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   Chan:
    #F     Direct Methods for computing discrete sinusoidal transforms
    #F     IEE Proceedings, Vol. 137, 1990, pp. 433--442
    #F
    DST4_toDCT4 := rec (
	info             := "DST4_n --> DCT4_n",
	isApplicable     := P -> P[1] > 2,
	allChildren := P -> [[ DCT4(P[1]) ]],
	rule := (P, C) ->
  	    J(P[1]) * C[1] * Diag(List([0..P[1]-1], i -> (-1)^i))
    )
));


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

# Auxiliary Functions for Symbols and Non-Terminals
# =================================================
# MP, from 08/17/00

#F Stride Permutations
#F -------------------
#F

# Let K a field and d | n. Then the stride permutation L_d^n is a
# permutation of degree n defined by
#   L_d^n (e_i tensor e_j) = (e_j tensor e_i)
#   for all i, j
# where e_i is the ith canonical base vector in K^d
# and e_j the jth in K^(n/d).
# Hence L_d^n exchanges the tensor components of dimension
# d and n/d resp.
# L_d^n can also be viewed the following way. Let x be
# a (d x n/d)-matrix stored in row major order. L_d^n permutes
# x such that it is stored in column major order
# (i.e. transposes x).

# Lemma: L_d^n is given as a permutation of 0..n-1 by
#   i -> i * d mod (n - 1), 0 <= i < n-1.
#
# Lemma: The following computation rules hold:
#   a) L_r^rst * L_s^rst = L_rs^rst.
#   b) L_t^rst = (L_t^rt tensor 1_s)(1_r tensor L_t^st).
#
# Lemma: L_2^(2i) has exactly 2 fixpoints.
#
# Lemma: (has to be proven)
#   p prime: ord(L_(p^i)^(p^n)) = n/gcd(n, i).

#F StridePerm( <n>, <d> )
#F   returns the stride permutation L_d^n (see above)
#F

StridePerm := function ( n, d )
  local M;

  # check arguments
  if not ( IsInt(n) and IsInt(d) and n > 0 and d > 0 ) then
    Error("<n> and <d> must be positive integers");
  fi;
  if not n mod d = 0 then
    Error("<d> must divide <n>");
  fi;

  # create matrix and transpose
  M := List([1..d], i -> [(i-1)*n/d+1..i*n/d]);

  return
    MappingPermListList(
      Concatenation(TransposedMat(M)),
      [1..n]
    );
end;

# Computes the same thing, but slightly slower.

StridePerm1 := function ( n, d )
  local L;

  # check arguments
  if not ( IsInt(n) and IsInt(d) and n > 0 and d > 0 ) then
    Error("<n> and <d> must be positive integers");
  fi;
  if not n mod d = 0 then
    Error("<d> must divide <n>");
  fi;

  # compute images according to lemma above
  L    := List([1..n], i -> (i - 1) * d mod (n - 1) + 1);
  L[n] := n;

  # return permutation
  return MappingPermListList([1..n], L);
end;

# CycleTypeStridePerm( <n>, <d> )
#   computes the cycle type of L_d^n. The cycle type is a
#   list of pairs [ .., [c_i, n_i], .. ], which denotes
#   that the permutation contains exactly n_i cycles of
#   length c_i.
#   If c_i = 1, then n_i is the number of fixpoints.
#

CycleTypeStridePerm := function ( n, d )
  return Collected(CycleLengths(StridePerm(n, d), [1..n]));
end;

#F Twiddle Matrices
#F ----------------
#F

# The twiddle factors appear in the Cooley-Tukey FFT, namely,
# for d|n we have:
#   F_n = (F_n/d tensor I_d) * T(n, d) * (I_n/d tensor F_d) * L(n, n/d)
# where F_n is a DFT of size n, and L denotes a stride permutation
# defined as above

#F TwiddleDiag( <n>, <d> [, <k> ] )
#F TwiddleDiag( <list-of-n-d[-k]> )
#F   returns the twiddle factors for <d>|<n> as a list:
#F     T(n, d) = direct_sum_(i = 1)^n/d diag(w_n^0, ..., w_n^(d-1)^i
#F   If the optional parameter <k> is given then w_n is replaced by
#F   w_n^k, gcd(<n>, <k>) = 1.
#F

TwiddleDiag := function ( arg )
  local n, d, k;

  if Length(arg) = 1 and IsList(arg[1]) then
    arg := arg[1];
  fi;

  if Length(arg) = 2 then
    n := arg[1];
    d := arg[2];
    k := 1;
  elif Length(arg) = 3 then
    n := arg[1];
    d := arg[2];
    k := arg[3];
  else
    Error(
      "usage:\n",
      "  TwiddleDiag( <n>, <d> [, <k> ] )\n",
      "  TwiddleDiag( <list-of-n-d[-k]> )"
    );
  fi;

  # check arguments
  if not ( IsInt(n) and IsInt(d) and n > 0 and d > 0 ) then
    Error("<n> and <d> must be positive integers");
  fi;
  if not n mod d = 0 then
    Error("<d> must divide <n>");
  fi;
  if not Gcd(n, k) = 1 then
    Error("gcd(<n>, <k>) must be 1");
  fi;

  return
    Concatenation(
      List([1..n/d], i -> List([1..d], j -> E(n)^(k*(j-1)*(i-1))))
    );
end;


# Copyright 2018-2019, Carnegie Mellon University
# See LICENSE for details
#F
#F SPL Objects for directly-implementable gates
#F

#F -----------------------------------------------------------------------------
#F H - 2x2 Hadamard SPL object
#F -----------------------------------------------------------------------------
Class(qH, Sym, rec(
    def := () ->  Sqrt(1/2) * Mat([[1,1], [1,-1]]),
    isReal := False,
    isPermutation := False,
    transpose := self >> self,
    conjTranspose := self >> self,
    inverse := self >> self,
    toAMat := self >> self.def(),
));

#F -----------------------------------------------------------------------------
#F X - 2x2 180 degree rotation along the X axis of the bloch sphere
#F Specific case of Rotx with theta = pi
#F -----------------------------------------------------------------------------
Class(qX, Sym, rec(
    def := () -> Mat( [[0, 1], [1, 0]] ),
    isReal := False,
    isPermutation := False,
    transpose := self >> self,
    conjTranspose := self >> self,
    inverse := self >> self,
    toAMat := self >> self.def(),
));

#F -----------------------------------------------------------------------------
#F Y - 2x2 180 degree rotation along the Y axis of the bloch sphere
#F Specific case of Roty with theta = pi
#F -----------------------------------------------------------------------------
Class(qY, Sym, rec(
    def := () -> Mat( [[0, E(2)], [-E(2), 0]] ), #Mat( [[0, Cplx(0, -1)], [Cplx(0, 1), 0]] ),
    isReal := False,
    isPermutation := False,
    transpose := self >> Mat( [[0, -E(2)], [E(2), 0]] ), #Mat( [[0, Cplx(0, 1)], [Cplx(0, -1), 0]] ),
    conjTranspose := self >> Mat( [[0, -E(2)], [E(2), 0]] ), #Mat( [[0, Cplx(0, 1)], [Cplx(0, -1), 0]] ),
    inverse := self >> self,
    toAMat := self >> self.def(),
));

#F -----------------------------------------------------------------------------
#F Z - 2x2 180 degree rotation along the Z axis of the bloch sphere
#F Specific case of Rotz with theta = pi
#F -----------------------------------------------------------------------------
Class(qZ, Sym, rec(
    def := () -> Mat( [[1, 0], [0, -1]] ),
    isReal := False,
    isPermutation := False,
    transpose := self >> self,
    conjTranspose := self >> self,
    inverse := self >> self,
    toAMat := self >> self.def(),
));

#F -----------------------------------------------------------------------------
#F S - 2x2 90 degree rotation along the Z axis of the bloch sphere
#F Specific case of Rotz with theta = pi/2, or commonly notated as sqrt(Z)
#F -----------------------------------------------------------------------------
Class(qS, Sym, rec(
    def := () -> Mat( [[1, 0], [0, -E(2)]] ), #Mat( [[1, 0], [0, Cplx(0, 1)]] ),
    isReal := False,
    isPermutation := False,
    transpose := self >> self,
    conjTranspose := self >> Mat( [[1, 0], [0, E(2)]] ),
    inverse := self >> Mat( [[1, 0], [0, E(2)]] ),
    toAMat := self >> self.def(),
));

#F -----------------------------------------------------------------------------
#F Sdag - 2x2 -90 degree rotation along the Z axis of the bloch sphere
#F Specific case of Rotz with theta = -pi/2, or commonly notated as -sqrt(Z)
#F -----------------------------------------------------------------------------
Class(qSdag, Sym, rec(
    def := () -> Mat( [[1, 0], [0, E(2)]] ), #Mat( [[1, 0], [0, Cplx(0, -1)]] ),
    isReal := False,
    isPermutation := False,
    transpose := self >> self,
    conjTranspose := self >> qS(),
    inverse := self >> qS(),
    toAMat := self >> self.def(),
));

#F -----------------------------------------------------------------------------
#F T - 2x2 45 degree rotation along the Z axis of the bloch sphere
#F Specific case of Rotz with theta = pi/4, or commonly notated as sqrt(S)
#F -----------------------------------------------------------------------------
Class(qT, Sym, rec(
    def := () -> Mat( [[1, 0], [0, E(8)]] ),
    isReal := False,
    isPermutation := False,
    transpose := self >> self,
    conjTranspose := self >> Mat( [[1, 0], [0, E(8)^3]] ),
    inverse := self >> Mat( [[1, 0], [0, E(8)^3]] ),
    toAMat := self >> self.def(),
));

#F -----------------------------------------------------------------------------
#F Tdag - 2x2 -90 degree rotation along the Z axis of the bloch sphere
#F Specific case of Rotz with theta = -pi/4, or commonly notated as sqrt(S)
#F -----------------------------------------------------------------------------
Class(qTdag, Sym, rec(
    def := () -> Mat( [[1, 0], [0, E(8)^3]] ),
    isReal := False,
    isPermutation := False,
    transpose := self >> self,
    conjTranspose := self >> qT(),
    inverse := self >> qT(),
    toAMat := self >> self.def(),
));

##
#F GenSwapMat( <i>, <j>, <n> )
##
## Helper functioj to create a matrix swapping qubits i and j
GenSwapMat := function (i, j, n)
    local mi, mj, swap, pre;
    mi := Minimum([i, j]);
    mj := Maximum([i, j]);
    if (i = j) then
        return I(2^(n));
    fi;
    pre := Tensor(   Tensor(I(2^(mj-1)), L(4,2)),    I(2^(n-mj-1)) );
    swap := pre * GenSwapMat(mi, mj-1, n) * pre;
    return swap;
end;

##
#F PerfSwap( <target>, <l>, <n> )
##
## generates a 2^n by 2^n matrix that swaps the qubits in target with those in l
## *Not* conscious of the architecture, just generates the equivalent matrix for terminate()
PerfSwap := function (target, l, n)
    local swap, qub, e, a, ls, tmp_l, r, idx;
    swap := I(2^n);
    qub := 1;
    tmp_l := l;
    # Generate the forward swap matrix,
    for e in tmp_l do
        swap := swap * GenSwapMat(target[qub], e, n);
        ls := SplitAt(tmp_l, 1)[2];
        idx := 1;
        for r in ls do
            # if we affected another qubit in our list
            if r = qub then
                tmp_l[idx] := e;
            fi;
            idx := idx + 1;
        od;
        qub := qub + 1;
    od;
    return swap;
end;

##
#F JuncTerm( <l>, <n>, <dir> )
##
## Terminate a Junction object into a permutation matrix
JuncTerm := function (l, n, dir)
    local  size, swap1, swap2, trans, tmp_l;
    size := Length(l);
    tmp_l := [1..Length(l)];
    tmp_l := Map(tmp_l, i -> l[i]);
    # Generate swap matrix
    swap1 := PerfSwap([0..size-1], tmp_l, n);
    # Generate the reverse swap matrix
    swap2 := PerfSwap(Reversed([0..size-1]), Reversed(tmp_l), n);
    if (dir >= 0) then
        return swap1;
    fi;
    return swap2;
end;

#F -----------------------------------------------------------------------------
#F Junc - reordering of the logical qubit vector (l is the ordering, d is the direction)
#F -----------------------------------------------------------------------------
Class(Junc, Sym, rec(
    def := (l, d) -> JuncTerm(l, Length(l), d),
    isReal := False,
    isPermutation := False,
    inverse := self >> self.def(self.params[1], -self.params[2]),
    toAMat := self >> self.def(self.params[1], self.params[2]),
));

#F -----------------------------------------------------------------------------
#F Reord - reordering of the physical qubit positions (l = ordering, arch = architecture, d = direction)
#F -----------------------------------------------------------------------------
Class(Reord, Sym, rec(
    def := (l, arch, d) -> JuncTerm(l, Length(l), d),
    isReal := False,
    isPermutation := False,
    inverse := self >> self.def(self.params[1], -self.params[2]),
    toAMat := self >> self.def(self.params[1], self.params[2]),
));


# GAP has an improved floating-point support since version 4.5

Pi := Acos(-1.0);

r := Pi / 5.0;
d := 36;

Deg := x -> x * Pi / 180;

Sin(r);         Asin(last);
Sin(Deg(d));    Asin(last);
Cos(r);         Acos(last);
Cos(Deg(d));    Acos(last);
Tan(r);         Atan(last);
Tan(Deg(d));    Atan(last);


# The Hamming graph H(d, e) of vectors with d elements
# over an alphabet with e elements.
BindGlobal("HammingGraph", function(d, e)
    return Graph(WreathProductSymmetricGroups(e, d),
        Elements(ZmodnZ(e)^d), OnZmodnZVectors(d, e),
        function(x, y) return WeightVecFFE(x-y) = 1; end, true);
end);

# The d-dimensional hypercube
BindGlobal("HypercubeGraph", d -> HammingGraph(d, 2));

# The Shrikhande graph with parameters v = 16, k = 6, lm = 2, mu = 2,
# i.e., the same as H(2, 4), but not isomorphic to it.
BindGlobal("ShrikhandeGraph",
    ComplementGraph(LatinSquareGraph(CyclicGroup(4))));

# The Doob graph Doob(n, d) of diameter 2*n+d
# as a box product of n copies of the Shrikhande graph and H(d, 4).
BindGlobal("DoobGraph", function(n, d)
    local l;
    l := ListWithIdenticalEntries(n, ShrikhandeGraph);
    if d > 0 then
        Add(l, HammingGraph(d, 4));
    fi;
    return BoxProductGraph(l);
end);

# The halved d-cube.
BindGlobal("HalvedCubeGraph",
    d -> HalvedGraph(HammingGraph(d, 2))
);

# The folded d-cube.
BindGlobal("FoldedCubeGraph",
    d -> AntipodalQuotientGraph(HammingGraph(d, 2))
);

# The folded halved 2d-cube.
BindGlobal("FoldedHalvedCubeGraph",
    d -> AntipodalQuotientGraph(HalvedGraph(HammingGraph(2*d, 2)))
);

# The Brouwer graph Br(q) of pairs of 3-dimensional vectors over F_q,
# with two pairs being adjacent whenever the difference of the first vectors
# equals the cross product of the second vectors.
BindGlobal("BrouwerGraph", function(q)
    return Graph(WreathProduct(FieldAdditionPermutationGroup(q),
            MatrixColumnEvenPermutationGroup(2, 3)), Elements(GF(q)^[2,3]),
        OnVectorPairs(q), function(x, y)
            return x <> y and x[1] - y[1] = VectorProduct(x[2], y[2]);
        end, true);
end);

# The Pasechnik graph Pa(q) as the extended bipartite double
# of the Brouwer graph Br(q).
BindGlobal("PasechnikGraph",
    q -> ExtendedBipartiteDoubleGraph(BrouwerGraph(q))
);

# The additive symplectic cover of the complete graph on q^{2n} vertices.
BindGlobal("AdditiveSymplecticCoverGraph", function(arg)
    local B, F, G, K, V, h, m, q, dp;
    if Length(arg) < 2 then
        Error("at least two arguments expected");
        return fail;
    fi;
    if Length(arg) > 2 then
        h := arg[3];
    else
        h := 0;
    fi;
    q := arg[1];
    F := GF(q);
    m := 2*arg[2];
    G := Sp(m, q);
    V := F^m;
    B := InvariantBilinearForm(G).matrix;
    dp := DirectProduct(Concatenation([G],
        ListWithIdenticalEntries(m+1, FieldAdditionPermutationGroup(q))));
    if h = 0 then
        K := AdditiveGroup(0*Z(q));
    else
        K := AdditiveGroup(BasisVectors(Basis(F)){[1..h]});
    fi;
    return Graph(dp, Cartesian(Unique(List(F, x -> x+K)), V),
        OnAdditiveSymplecticCover(q, m, B, dp),
        function(x, y)
            return x <> y and x[2]*B*y[2]+y[1]-Elements(x[1])[1] = K;
        end, true);
end);

# The multiplicative symplectic cover of the complete graph on q+1 vertices.
# It is distance-regular when m divides q-1 and either q or m is even.
BindGlobal("MultiplicativeSymplecticCoverGraph", function(q, m)
    local B, F, G, K, dp;
    F := GF(q);
    K := Group(Z(q)^((q-1)/m));
    G := Sp(2, q);
    B := InvariantBilinearForm(G).matrix;
    dp := DirectProduct(G, Group((1,2)),
                        FieldExponentiationPermutationGroup(q));
    return Graph(dp, Unique(List(Filtered(F^2, x -> x <> Zero(F^2)),
                                 v -> Set(List(K, g -> List(v, x -> g*x))))),
                 OnMultiplicativeSymplecticCover(q, dp), function(x, y)
                    return x <> y and x[1]*B*y[1] in K;
                 end, true);
end);

# The affine polar graph VO^{(+/-)}(d, q)
# with respect to a nondegenerate quadratic form.
BindGlobal("AffinePolarGraphVO", function(arg)
    local d, e, q, B, G, Q, V, dp;
    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);
    dp := DirectProduct(Concatenation([G],
            ListWithIdenticalEntries(d, FieldAdditionPermutationGroup(q))));
    Q := InvariantQuadraticForm(G).matrix;
    return Graph(dp, Elements(GF(q)^d), OnAffine(q, d, dp), function(x, y)
                    return x <> y and IsZero((x-y)*Q*(x-y));
                end, true);
end);

# The affine polar graph VNO^{(+/-)}(d, q)
# with respect to a nondegenerate quadratic form.
BindGlobal("AffinePolarGraphVNO", function(arg)
    local d, e, q, B, G, H, Q, V, dp;
    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);
    dp := DirectProduct(Concatenation([G],
            ListWithIdenticalEntries(d, FieldAdditionPermutationGroup(q))));
    Q := InvariantQuadraticForm(G).matrix;
    return Graph(dp, Elements(GF(q)^d), OnAffine(q, d, dp),
                function(x, y)
                    return x <> y and IsOne(((x-y)*Q*(x-y))^((q-1)/2));
                end, true);
end);


gap>List(SymmetricGroup(4), p -> Permuted([1 .. 4], p));
perms(4);
[ [ 1, 2, 3, 4 ], [ 4, 2, 3, 1 ], [ 2, 4, 3, 1 ], [ 3, 2, 4, 1 ], [ 1, 4, 3, 2 ], [ 4, 1, 3, 2 ], [ 2, 1, 3, 4 ],
  [ 3, 1, 4, 2 ], [ 1, 3, 4, 2 ], [ 4, 3, 1, 2 ], [ 2, 3, 1, 4 ], [ 3, 4, 1, 2 ], [ 1, 2, 4, 3 ], [ 4, 2, 1, 3 ],
  [ 2, 4, 1, 3 ], [ 3, 2, 1, 4 ], [ 1, 4, 2, 3 ], [ 4, 1, 2, 3 ], [ 2, 1, 4, 3 ], [ 3, 1, 2, 4 ], [ 1, 3, 2, 4 ],
  [ 4, 3, 2, 1 ], [ 2, 3, 4, 1 ], [ 3, 4, 2, 1 ] ]