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

################################################################################
##
#F compute_simples(<group>,<int>,<function>) . . . . . compute simples in D^w(G)
##
InstallGlobalFunction( projective_reps, function(G,alpha,n)
  local chi, chi_i, rho_i, Mi, g, x, rho, component_bases, Degrees, algebra_basis_vectors, algebra_basis, twisted_group_alg, dd, lst, i, j, k, h, GSet, T, F;

  F:=CF(n);;

  # cosntruct the twisted group algebra according to the multiplication rule:
  #  g*h=alpha(g,h)gh
  T:=EmptySCTable(Order(G),0);;
  GSet:=AsSet(G);;
  for i in [1..Order(G)] do
    g:=GSet[i];;
    for j in [1..Order(G)] do
      h:=GSet[j];;
      k:=Position(GSet,g*h);;
      # we need to convert alpha(g,h) from an abstract cyclic group element to a
      # complex, so we assign the generator of the cyclic group Z_s to E(s), a
      # primitive s-th root of unity
      #lst:=[E(s)^Position(OrderedA,alpha(g,h)),k];;
      lst:=[alpha(g,h),k];;
      SetEntrySCTable(T,i,j,lst);;
    od;;
  od;;
  twisted_group_alg:=AlgebraByStructureConstants(F,T);;

  # verify that the algebra is associative and then compute its decomposition
  if not(IsAssociative(twisted_group_alg)) then
    Error("algebra is not associative. There is likely an error or your 3-cocycle\n");
  fi;
  dd:=DirectSumDecomposition(twisted_group_alg);

  # compute a basis for the algebra and a basis for each of the decomposition
  # components
  algebra_basis:=Basis(twisted_group_alg);
  algebra_basis_vectors:=BasisVectors(algebra_basis);
  component_bases:=List(dd,Basis);
  Degrees:=List(List(component_bases, Size), Sqrt);# check whether the degrees are squares otherwise extends the field.

  # compute the represenations and characters
  rho:=[];
  chi:=[];
  for Mi in component_bases do
    # compute the representation corresponding to component Mi
    #
    # for each g (basis vector for the twisted group algebra) compute the matrix
    # rho_i(g)_{a,b} according to rho_i(g)(v_a) = Sum_{b}rho_i(g)_{a,b}v_b where
    # {v_{a}} is the basis Mi for the ith component.
    rho_i:=List(algebra_basis_vectors,g->List(Mi,x->Coefficients(Mi,g*x)));
    Append(rho,[rho_i]);
    # for each g, compute chi_i(g)=Tr(rho_i(g))/sqrt(dim of the ideal)
    chi_i:=List(rho_i,x->Trace(x))/Sqrt(Size(Mi));
    Append(chi,[chi_i]);
  od;
  return chi;
end);

#E Projective_Representations.gi . . . . . . . . . . . . . . . . . . . ends here


#######################################################################
# Description: A function to initialize a generator for random        #
#              permutations, described in section 4.1.                #
# Input: - list of generators S                                       #
# Output: - list of permutations X including repetitions of generators#
#           from S                                                    #
#######################################################################

InitGenerator := function(S)
    local i, X, k;
    X := List(S); k := Length(X);
    for i in [k+1..Maximum(11, Length(S))] do
        Add(X, X[i-k]);
    od;
    if IsReadOnlyGlobal("X") = true then
        MakeReadWriteGlobal("X");
    fi;
    return X;
end;

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

#######################################################################
# Description: A function to calculate a random permutation,          #
#              described in section 4.1.                              #
# Input: - list of generators S, generator X returned by InitGenerator#
# Output: - random permutation a as cycle                             #
#######################################################################

RandomPerm := function(S, X)
    local Randomize, a, r, i;

    r := Maximum(11, Length(S));
    Randomize := function()
        local s, t, e, range;

        # indices s and t specify which permutations X[s], X[t]
        # will be multiplied with each other
        # e specifies whether X[t] or its inverse will be used
        range := [1..r];  s := Random(range);  e := Random([-1,1]);
        t := Random(range);  Remove(range, s);

        # alternate the order of multiplication
        # of X[t] and X[s] randomly
        # update generator X

        if Random([1,2]) = 1 then
           X[s] := X[s]*X[t]^e;
           a := a*X[s];
        else
           X[s] := X[t]^e*X[s];
           a := X[s]*a;
        fi;
        return a;
    end;

    # calculate random permutation a as
    # product of random permutations from X
    a := ();
    for i in [1..50] do
        Randomize();
    od;
    return a;
end;


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

_RDFT_CONST := 2.5;

#F TRDFT2D([<m>, <n>], <k>)
Class(TRDFT2D, TaggedNonTerminal, rec(
    abbrevs := [
        P     -> Checked(IsList(P), Length(P) = 2, ForAll(P,i->IsPosInt(i) and IsEvenInt(i)), Product(P) > 1,
                [ RemoveOnes(P), 1]),
        (P,k) -> Checked(IsList(P), Length(P) = 2, ForAll(P,IsPosInt), IsInt(k), Product(P) > 1,
                        Gcd(Product(P), k)=1,
                [ RemoveOnes(P), k mod Product(P)])
    ],
    dims := self >> let(m := self.params[1][1], n := self.params[1][2], d := [n*(m+2), m*n], When(self.transposed, Reversed(d), d)),
    isReal := True,
    terminate := self >>
            Gath(fTensor(fAdd(self.params[1][1], (self.params[1][1]+2)/2, 0), fId(2*self.params[1][2]))) *
            RC(MDDFT(self.params[1], self.params[2]).terminate()) *
            Scat(fTensor(fId(Product(self.params[1])), fBase(2, 0))),
    normalizedArithCost := (self) >> let(n := Product(self.params[1]), IntDouble(_RDFT_CONST * n * d_log(n) / d_log(2))),
    compute := meth(self, data)
        local rows, cols, cxrows, m1, m2;

        rows := self.params[1][1];
        cols := self.params[1][2];
        cxrows := Rows(self)/cols;

        m1 := List(TransposedMat(List(TransposedMat(data), i->ComplexFFT(i){[1..cxrows/2]})), ComplexFFT);
        m2 := Flat(List(Flat(m1), i->[ReComplex(i), ImComplex(i)]));

        return List([0..cxrows-1], i->m2{[cols*i+1..cols*(i+1)]});
    end
));

#F TIRDFT2D([<m>, <n>], <k>)
Class(TIRDFT2D, TaggedNonTerminal, rec(
    abbrevs := [
        P     -> Checked(IsList(P), Length(P) = 2, ForAll(P,i->IsPosInt(i) and IsEvenInt(i)), Product(P) > 1,
                [ RemoveOnes(P), 1]),
        (P,k) -> Checked(IsList(P), Length(P) = 2, ForAll(P,IsPosInt), IsInt(k), Product(P) > 1,
                        Gcd(Product(P), k)=1,
                [ RemoveOnes(P), k mod Product(P)])
    ],
    dims := self >> let(m := self.params[1][1], n := self.params[1][2], d := [m*n, n*(m+2)], When(self.transposed, Reversed(d), d)),
    isReal := True,
    terminate := self >> let(cxrows := (self.params[1][1]+2)/2, rows := self.params[1][1], cols := self.params[1][2], k := self.params[2],
        Tensor(PRDFT(rows,k).inverse().terminate(), I(cols)) * Tensor(I(cxrows), L(2*cols, 2)*RC(DFT(cols, -k)))),
    normalizedArithCost := (self) >> let(n := Product(self.params[1]), IntDouble(_RDFT_CONST * n * d_log(n) / d_log(2)))
));

#F 2D RDFT Rule
NewRulesFor(TRDFT2D, rec(
    TRDFT2D_ColRow_tSPL := rec(
        switch := true,
        applicable := (self, t) >> true,
        children := (self, t) >> let(m := t.params[1][1], n:=t.params[1][2], k:= t.params[2], tags := t.getTags(),
            [[
                TCompose([
                    TTensorI(TCompose([TRC(DFT(n, k)), TPrm(L(2*n, n))]), (m+2)/2, APar, APar),
                    TTensorI(PRDFT1(m, k), n, AVec, AVec)
                ]).withTags(t.getTags())
            ]]),
        apply := (self, t, C, Nonterms) >> C[1]
    )
));

#F 2D IRDFT Rule
NewRulesFor(TIRDFT2D, rec(
    TIRDFT2D_RowCol_tSPL := rec(
        switch := true,
        applicable := (self, t) >> true,
        children := (self, t) >> let(m := t.params[1][1], n:=t.params[1][2], k:= t.params[2], tags := t.getTags(),
            [[
                TCompose([
                    TTensorI(PRDFT1(m, k).inverse(), n, AVec, AVec),
                    TTensorI(TCompose([TPrm(L(2*n, 2)), TRC(DFT(n, -k))]), (m+2)/2, APar, APar)
                ]).withTags(t.getTags())
            ]]),
        apply := (self, t, C, Nonterms) >> C[1]
    )
));


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

Class(VectorizedBaseMat, BaseMat, SumsBase, rec(
    transpose := self >> Inherit(self, rec(transposed := not self.transposed)),
    #-----------------------------------------------------------------------
    print := (self,i,is) >> Print(self.name, "(", self.n, ", ", self.v,")",
	self.printA(), When(self.transposed, ".transpose()", "")),
));

#F VS(<n>, <v>)  --  vectorized version of doubly-diagonal matrix
#F
#F Represents the matrix that has 1s on the main diagonal and upper shifted by 1 diagonal
#F
#F   <n> - matrix size
#F   <v> - vector length, does not affect matrix shape, only needed for Codegen
#F
#F Example:
#F
#F spiral> PrintMat(MatSPL(VS(8,4)));
#F [ [ 1, 1,  ,  ,  ,  ,  ,   ],
#F   [  , 1, 1,  ,  ,  ,  ,   ],
#F   [  ,  , 1, 1,  ,  ,  ,   ],
#F   [  ,  ,  , 1, 1,  ,  ,   ],
#F   [  ,  ,  ,  , 1, 1,  ,   ],
#F   [  ,  ,  ,  ,  , 1, 1,   ],
#F   [  ,  ,  ,  ,  ,  , 1, 1 ],
#F   [  ,  ,  ,  ,  ,  ,  , 1 ] ]
#F
Class(VS, VectorizedBaseMat, rec(
    new := (self, n, v) >> SPL(WithBases(self,
        rec(n := n, v := v, transposed := false))).setDims(),
    #-----------------------------------------------------------------------
    dims := self >> [self.n, self.n],
    #-----------------------------------------------------------------------
    rChildren := self >> [self.n, self.v],
    rSetChild := rSetChildFields("n", "v"),
    #-----------------------------------------------------------------------
    area := self >> self.n * self.n,
    #-----------------------------------------------------------------------
    toAMat := self >> let(s:=S(self.n), AMatMat(MatSPL(When(self.transposed, s.transpose(), s))))
));

Declare(VLD);

#F VUD(<n>, <v>)  --  vectorized upper diagonal matrix
#F
#F VUD(n,v) is equivalent to UD(n,1)
#F
#F   <n> -- matrix size
#F   <v> -- vector length, does not affect matrix shape, only needed for Codegen
#F
#F spiral> PrintMat(MatSPL(VUD(8,4)));
#F [ [  , 1,  ,  ,  ,  ,  ,   ],
#F   [  ,  , 1,  ,  ,  ,  ,   ],
#F   [  ,  ,  , 1,  ,  ,  ,   ],
#F   [  ,  ,  ,  , 1,  ,  ,   ],
#F   [  ,  ,  ,  ,  , 1,  ,   ],
#F   [  ,  ,  ,  ,  ,  , 1,   ],
#F   [  ,  ,  ,  ,  ,  ,  , 1 ],
#F   [  ,  ,  ,  ,  ,  ,  ,   ] ]
#F
Class(VUD, VectorizedBaseMat, rec(
    new := (self, n, v) >> SPL(WithBases(self, rec(n := n, v := v))).setDims(),
    #-----------------------------------------------------------------------
    transpose := (self) >> VLD(self.n, self.v),
    #-----------------------------------------------------------------------
    dims := self >> [self.n, self.n],
    #-----------------------------------------------------------------------
    rChildren := self >> [self.n, self.v],
    rSetChild := rSetChildFields("n", "v"),
    #-----------------------------------------------------------------------
    area := self >> self.n,
    #-----------------------------------------------------------------------
    toAMat := self >> UD(self.n).toAMat()
));

#F VLD(<n>, <v>)  --  vectorized lower diagonal matrix
#F
#F VLD(n,v) is equivalent to LD(n,1)
#F
#F   <n> -- matrix size
#F   <v> -- vector length, does not affect matrix shape, only needed for Codegen
#F
#F spiral> PrintMat(MatSPL(VLD(8,4)));
#F [ [  ,  ,  ,  ,  ,  ,  ,   ],
#F   [ 1,  ,  ,  ,  ,  ,  ,   ],
#F   [  , 1,  ,  ,  ,  ,  ,   ],
#F   [  ,  , 1,  ,  ,  ,  ,   ],
#F   [  ,  ,  , 1,  ,  ,  ,   ],
#F   [  ,  ,  ,  , 1,  ,  ,   ],
#F   [  ,  ,  ,  ,  , 1,  ,   ],
#F   [  ,  ,  ,  ,  ,  , 1,   ] ]
#F
Class(VLD, VectorizedBaseMat, rec(
    new := (self, n, v) >> SPL(WithBases(self, rec(n := n, v := v))).setDims(),
    #-----------------------------------------------------------------------
    transpose := (self) >> VUD(self.n, self.v),
    #-----------------------------------------------------------------------
    dims := self >> [self.n, self.n],
    #-----------------------------------------------------------------------
    rChildren := self >> [self.n, self.v],
    rSetChild := rSetChildFields("n", "v"),
    #-----------------------------------------------------------------------
    area := self >> self.n,
    #-----------------------------------------------------------------------
    toAMat := self >> LD(self.n, 1).toAMat()
));


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

#
# Frontier
#

#F _DFUnion(<list_frontiers>) merges frontiers.
#F     Multiple frontiers result from multiple outgoing paths.
#F
#F     For example t3 = add(t1,t2) will have the frontier
#F       [ [t3], _DFUnion([DefFrontier(t1), DefFrontier(t2)]) ]
#F
#F     The parameter is a list of frontiers, where each frontier
#F     is a list of sets of variables.
#F
_DFUnion := function(list_frontiers)
    local depths, maxdepth, curset, res, numfrontiers, d, j;
    numfrontiers := Length(list_frontiers);
    depths := List(list_frontiers, Length);
    maxdepth := Maximum0(depths);
    res := [];
    for d in [1..maxdepth] do
        curset := Set([]);
	for j in [1..numfrontiers] do
	    if d <= depths[j] then
		curset := UnionSet(curset, list_frontiers[j][d]);
	    else
		# if frontier is shorter than the longest, we carry over its last terms.
		# For instance, the frontier of t5 in { t3=add(t1,t2); t5=add(t3, t4) }
		# is [[t5], [t3, t4], [t1, t2, t3]].
		curset := UnionSet(curset, list_frontiers[j][depths[j]]);
	    fi;
	od;
	Add(res, curset);
    od;
    return res;
end;

#F DefFrontier(<cmd>, <depth>) - computes the so-called def-frontier for a command.
#F    The function can be defined inductively as:
#F       DF(t, d) == DF(t.def, d), where t.def is the 'assign' defining t
#F       DF(assign(t,      ...    ), 0)  == [ [t] ]
#F       DF(assign(t, f(a1,a2,...)), 1)  == [ [t], [a1,a2,...] ]
#F       DF(assign(t, f(a1,a2,...)), n)  == [ [t], [a1,a2,...] ] concat
#F                                                 _DFUnion(DF(a1,n-1), DF(a2,n-1), ...)
#F
#F    In plain words it returns the minimal set of variables that fully define a given
#F    location (or cmd.loc).
#F
#F    For instance, the frontier of t5 in { t3=add(t1,t2); t5=add(t3, t4) }
#F    is [[t5], [t3, t4], [t1, t2, t4]].
#F
#F    Note (!!!): MarkDefUse(code) must be called on the corresponding code object,
#F                so that locations can be connected with their definitions
#F
#F    If <depth> is negative, then the maximally deep frontier is computed.
#F
DefFrontier := (cmd, depth) -> Cond(
    IsLoc(cmd), let(def := DefLoc(cmd), When(def=false, [[cmd]], DefFrontier(def, depth))),
    depth = 0,      [Set([cmd.loc])],
#    IsLoc(cmd.exp), [Set([cmd.loc])],
    let(args := ArgsExp(cmd.exp),
	Concatenation([Set([cmd.loc])],
	               _DFUnion(
			   List(args, a -> DefFrontier(a, depth-1))))));

DefCollect := (cmd, depth) -> Cond(
    depth = 0,      cmd.loc,
    IsLoc(cmd.exp), cmd.loc,
    depth = 1,      cmd.exp,
    SubstLeaves(Copy(cmd.exp), var,
	v -> let(def := DefLoc(v), When(def=false, v, DefCollect(def, depth-1)))));

AddFrontier := x -> Cond(
    IsLoc(x), let(def := DefLoc(x),
	Cond(def = false, x, AddFrontier(def.exp))),
    ObjId(x) in [add,sub],
        ApplyFunc(ObjId(x), List(x.args, AddFrontier)),
    x);

AddFrontierD := (x,d) -> Cond(
    d = 0,    x,
    IsLoc(x), let(def := DefLoc(x),
	Cond(def = false, x, AddFrontierD(def.exp, d))),
    ObjId(x) in [add,sub],
        ApplyFunc(ObjId(x), List(x.args, a -> AddFrontierD(a, d-1))),
    x);

AddFrontierDM := (x,d) -> Cond(
    d = 0,
        [x,false],
    IsLoc(x), let(def := DefLoc(x),
	Cond(def = false, [x,false], AddFrontierDM(def.exp, d))),
    d = 1,
        [x,ObjId(x)=mul],
    ObjId(x) in [add,sub],
        let(args := List(x.args, a -> AddFrontierDM(a, d-1)),
	    Cond(ForAll(args, a->a[2]=false), [x,false],
		 [ApplyFunc(ObjId(x), List([1..Length(args)], i->Cond(args[i][2], args[i][1], x.args[i]))), true])),
    [x,ObjId(x)=mul]);

# NOTE: memoization
#
Class(madd, add, rec(
    redundancy := self >> self.constantRedundancy(), # or self.termRedundancy(),

    terms               := self >> Map(self.args, a->a.args[2]),
    constants           := self >> Map(self.args, a->a.args[1].v),
    nonTrivialConstants := self >> Filtered(Map(self.args, a->AbsFloat(a.args[1].v)), c->c<>1),

    constantRedundancy := self >> let(
	constants := self.nonTrivialConstants(),
	constants <> [] and Length(constants)<>Length(Set(constants))),

    termRedundancy := self >> let(
	locs := Filtered(self.terms(), IsLoc),
	locs <> [] and Length(locs) <> Length(Set(locs))),

    factorConstants := meth(self)
        local constants, res, t, c, a, i, fac_indices, l1, l2;
	res := []; constants := []; l1:=[]; fac_indices := Set([]);
	for a in self.args do
	    a := Copy(a);
	    c := a.args[1].v; t := a.args[2];

	    if c in [1,-1] then
		Add(constants, c); Add(res, a);
	    elif c in constants then
		i := Position(constants, c);
		res[i].args[2] := add(res[i].args[2], t); AddSet(fac_indices,i);
	    elif -c in constants then
		i := Position(constants, -c);
		res[i].args[2] := sub(res[i].args[2], t); AddSet(fac_indices,i);
	    else
		Add(constants, c); Add(res, a);
	    fi;
	od;

	l1 := res{fac_indices};
	l2 := res{Difference([1..Length(res)], fac_indices)};

	if l1=[] then return FoldL1(l2,add); fi;
	l1 := FoldL1(l1,add);

	if l2=[] then return l1; fi;
	l2 := FoldL1(l2,add);
	return add(l1, l2);
    end,

    factorTerms := meth(self)
        local terms, res, t, c, a, i, fac_indices, l1, l2;
	res := []; terms := []; fac_indices := Set([]);
	for a in self.args do
	    a := Copy(a);
	    c := a.args[1].v; t := a.args[2];

	    if IsLoc(t) and t in terms then
		i := Position(terms, t);
		res[i].args[1].v := res[i].args[1].v + c; AddSet(fac_indices,i);
	    else
		Add(terms, t); Add(res, a);
	    fi;
	od;

	l1 := res{fac_indices};
	l2 := res{Difference([1..Length(res)], fac_indices)};
	l1 := Filtered(l1, a->a.args[1].v <> 0);
	l2 := Filtered(l2, a->a.args[1].v <> 0);

	if l1=[] and l2=[] then return V(0); fi;

	if l1=[] then return FoldL1(l2,add); fi;
	l1 := FoldL1(l1,add);

	if l2=[] then return l1; fi;
	l2 := FoldL1(l2,add);
	return add(l1, l2);
    end
));

# "MultiAdd" is a normal form for linear expressions
#  MultiAdd = madd(mul(c1,e1), mul(c2,e2), ...)
#
Class(ToMultiAdd, RuleSet, rec(
    __call__ := (self, e) >> TDA(madd(mul(1,e)), self, SpiralDefaults)));

RewriteRules(ToMultiAdd, rec(
    EliminateAdd := Rule(add, e->ApplyFunc(madd, List(e.args, a->mul(1,a)))),

    EliminateSub := Rule(sub, e->madd(mul(1,e.args[1]), mul(-1, e.args[2]))),

    MulMul := Rule([mul, @(1,Value), [mul, @(2,Value), @(3)]],
	e -> mul(@(1).val.v * @(2).val.v, @(3).val)),

    MaddSinkMul := ARule(madd, [[mul, @(1,Value), @(2,madd)]],
	e -> List(@(2).val.args, a->mul(@(1).val*a.args[1], a.args[2]))),

    FlattenMaddMadd := ARule(madd, [@(1,madd)], e->@(1).val.args)
));

NODE := x -> RCSE.node(TDouble, x);
REMOVE_NODE := x -> RCSE.remove_node(x);

deepCheck := function(c, d)
    local frontier, linexp;
    frontier := AddFrontierD(c.exp, d);
    linexp := ToMultiAdd(frontier);
    if not ObjId(linexp)=madd then return [c.loc,c.loc,"none"]; fi;
    if linexp.constantRedundancy() then	return [c.loc, linexp, "constant"];
    elif linexp.termRedundancy()   then	return [c.loc, linexp, "term"];
    else	                        return [c.loc, c.loc, "none"];
    fi;
end;

deepCheckM := function(c, d)
    local frontier, linexp;
    frontier := AddFrontierDM(c.exp, d)[1];
    linexp := ToMultiAdd(frontier);
    if not ObjId(linexp)=madd then return [c.loc,c.loc,"none"]; fi;
    if linexp.constantRedundancy() then	return [c.loc, linexp, "constant"];
    elif linexp.termRedundancy()   then	return [c.loc, linexp, "term"];
    else	                        return [c.loc, c.loc, "none"];
    fi;
end;

_DeepSimplifyCmd := function(c, d, frontier_func)
    local node, frontier, linexp;

    frontier := frontier_func(c.exp, d);
    linexp := ToMultiAdd(frontier);

    if not ObjId(linexp)=madd then return c; fi;

    if linexp.constantRedundancy() then
	linexp := linexp.factorConstants();
	if IsValue(linexp) then node := linexp;
	else node := ApplyFunc(ObjId(linexp), List(linexp.args, NODE));
	fi;
	c.exp := node;
    elif linexp.termRedundancy() then
	linexp := linexp.factorTerms();
	if IsValue(linexp) then node := linexp;
	else node := ApplyFunc(ObjId(linexp), List(linexp.args, NODE));
	fi;
	c.exp := node;
    fi;
    return c;
end;

DeepSimplifyCmd := function(c, d1, d2)
    if PatternMatch(c.exp, [mul, @(1,Value), @(2,var,v->DefLoc(v)<>false)], empty_cx()) and
	PatternMatch(DefLoc(@(2).val).exp, [mul, @(3,Value), @(4)], empty_cx()) then
	c.exp := mul(@(1).val.v * @(3).val.v, @(4).val);
    fi;
    c := _DeepSimplifyCmd(c, d1, AddFrontierD);
    c := _DeepSimplifyCmd(c, d2, (x,d)->AddFrontierDM(x,d)[1]);
    return c;
end;

Declare(DeepSimplifyChain);

DEPTH1 := 2; # AddFrontierD
DEPTH2 := 3; # AddFrontierDM

DefUnbound := function(e, bound)
    local unbound, defs;
    unbound := Difference(e.free(), bound);
    defs := Filtered(List(unbound, DefLoc), d->d<>false and not Same(d,e));
    return Concatenation(Concatenation(List(defs, d -> DefUnbound(d, bound))), defs);
end;

_DeepSimplifyChain := function(code, bound)
   local orig, c, res, cmds, args, supp, supplocs;
   res := chain();

   for c in code.cmds do
       if ObjId(c) <> assign then Error("Can't handle 'c' of type '", ObjId(c), "'"); fi;
       orig := c.exp;

       DeepSimplifyCmd(c,DEPTH1,DEPTH2);
       if IsVar(c.loc) then AddSet(bound, c.loc); fi;

       supp := chain(DefUnbound(c.exp, bound));
       supplocs := List(supp.cmds, cmd->cmd.loc);
       DoForAll(supplocs, REMOVE_NODE);
       UniteSet(bound, supplocs);

       supp := FlattenCode(_DeepSimplifyChain(supp, bound));
       Add(supp.cmds, c);
       supp := RCSE(supp);

       Append(res.cmds, supp.cmds);
   od;

   return res;
end;

DeepSimplifyChain := code -> _DeepSimplifyChain(code, code.free());

DeepSimplify := function(code)
   local c, frontier, linexp, free, undefined;
   code := BinSplit(code);
   RCSE.flush();
   MarkDefUse(code);
   return SubstBottomUp(code, chain, DeepSimplifyChain);
end;

_CheckUninitializedChain := function(code, def, uninit)
    local def1, def2, c, use;
    for c in code.cmds do
        if ObjId(c)=assign then
	    use := VarArgsExp(c.exp);
	    UniteSet(uninit, Filtered(use, x->not x in def));
	    AddSet(def, c.loc);

        elif ObjId(c)=chain then
            [def, uninit] := _CheckUninitializedChain(c, def, uninit);

        elif ObjId(c)=IF then
            [def1, uninit] := _CheckUninitializedChain(c.then_cmd, ShallowCopy(def), uninit);
            [def2, uninit] := _CheckUninitializedChain(c.else_cmd, ShallowCopy(def), uninit);
            def := Union(def1, def2);
	fi;
    od;
    return [def, uninit];
end;

CheckUninitializedChain := function(code)
    local def, uninit;
    Constraint(ObjId(code)=chain);
    def := Set([]);
    uninit := Set([]);
    [def, uninit] := _CheckUninitializedChain(code, def, uninit);
    return uninit;
end;

reds := chain -> Filtered(chain.cmds, c -> deepCheck(c,DEPTH1)[3] <>"none" or
    deepCheckM(c, DEPTH2)[3] <>"none");

DoDeepSimplify := function(code, num_iterations)
   local c, frontier, linexp, free, undefined, i;
   Print("Orig cost : ", ArithCostCode(code), "\n");
   for i in [1..num_iterations] do
       code := DeepSimplify(code);  Print("DS : ", ArithCostCode(code), "\n");
       code := CopyPropagate(code); Print("CP : ", ArithCostCode(code), "\n");
       code := CopyPropagate(code); Print("CP : ", ArithCostCode(code), "\n");
       code := CopyPropagate(code); Print("CP : ", ArithCostCode(code), "\n");
       code := BinSplit(code);
       code := RCSE(code); Print("RCSE : ", ArithCostCode(code), "\n");
   od;
   return code;
end;

# err := [];

# LIMIT := 1; ww:=DeepSimplify(Copy(w));; cm := CMatrix(pp(ww));
# if inf_norm(cm-dm) > 1e-10 then Print("ERROR\n"); Add(err, [Copy(ww), Copy(w), inf_norm(cm-dm)]); else Print("OK\n"); fi;

# LIMIT := 1; w:=DeepSimplify(Copy(ww));; cm := CMatrix(pp(w));
# if inf_norm(cm-dm) > 1e-10 then Print("ERROR\n"); err := Add(err, [Copy(w), Copy(ww), inf_norm(cm-dm)]); else Print("OK\n"); fi;


RequirePackage("grape");

V := GF(3)^7;
P := Filtered(List(Elements(Subspaces(V, 1)), v -> Elements(v)[2]), u -> u*u = Z(3));;

G := Graph(Group(()), P, function(x,y) return x; end, function(x,y) return x*y = 0*Z(3); end, true);;
GlobalParameters(G);


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

Declare(Tensor, I, L);

# ==========================================================================
# Tensor(<spl1>, <spl2>, ...) . . . . . . . . . .  Kronecker product of SPLs
#    Arguments can be lists of spls of any depth. So that the following is
#    legal:
#       Tensor(I(2), [[F(2), [I(2)]]])
#    and is equivalent to
#       Tensor(I(2), F(2), I(2))
# ==========================================================================
Class(Tensor, BaseOperation, rec(
    abbrevs := [ arg -> [Flat(arg)] ],

    new := meth(self, L)
        local scl,mat;
        Constraint(IsList(L) and Length(L) >= 1);
        L:=Filtered(L,x->x<>I(1));
        if (Length(L)=0) then return I(1); fi;
        #DoForAll(L, x -> Constraint(IsSPL(x)));
	if Length(L)=1 then return L[1]; fi;

	#if Length(L)=2 then
	#    scl := Cond(Dimensions(L[1])=[1,1], 1,
	#	        Dimensions(L[2])=[1,1], 2,
	#		false);
	#    if scl <> false then
	#	mat := L [ When(scl=1, 2, 1) ];
	#	scl := MatSPL(L[scl])[1][1];
	#
	#	return When(scl=1, mat, spiral.spl.operators.Scale(scl, mat));
	#    fi;
	#fi;

        return SPL(WithBases( self,
	    rec( _children := L,
		dimensions := [ Product(L, t -> t.dims()[1]),
		                Product(L, t -> t.dims()[2]) ] )));
    end,
    #-----------------------------------------------------------------------
    dims := self >> [ Product(self._children, t -> t.dims()[1]),
	              Product(self._children, t -> t.dims()[2]) ],
    #-----------------------------------------------------------------------
    isPermutation := self >> ForAll(self._children, IsPermutationSPL),
    #-----------------------------------------------------------------------
    isSymmetric := self >> ForAll(self._children, c -> c.isSymmetric()),
    #-----------------------------------------------------------------------
    toAMat := self >> TensorProductAMat(List(self._children, AMatSPL)),
    #-----------------------------------------------------------------------
    transpose := self >>
        CopyFields(self, rec(_children := List(self._children, x->x.transpose()),
		          dimensions := Reversed(self.dimensions))),
    conjTranspose := self >>
        CopyFields(self, rec(_children := List(self._children, x->x.conjTranspose()),
		          dimensions := Reversed(self.dimensions))),
    inverse := self >>
        CopyFields(self, rec(_children := List(self._children, x->x.inverse()),
		          dimensions := Reversed(self.dimensions))),
    #-----------------------------------------------------------------------
    rightBinary  := self >> FoldR1(self._children, (p,x) -> let(base:=self.__bases__[1], base(x, p))),

    leftBinary := self >> FoldL1(self._children, (p,x) -> let(base:=self.__bases__[1], base(p, x))),

    split := meth(self)
        local i, lft, rt, ch, res;
        ch := self.children();
        rt := Product(Drop(ch, 1), Rows);
        lft := 1;
        res := Tensor(ch[1], I(rt));
        for i in [2..self.numChildren()] do
            lft := lft * Cols(ch[i-1]);
            rt := rt / Rows(ch[i]);
            res := res * Tensor(I(lft), ch[i], I(rt));
        od;
        return res;
    end,

    vectorForm := self >> Checked(self.numChildren() = 2,
	let(c1 := self.child(1), c2 := self.child(2),

	    Cond(IsIdentitySPL(c1) and IsIdentitySPL(c2), self,
		 IsIdentitySPL(c1), L(Rows(c2)*Rows(c1), Rows(c1)) *
		                    Tensor(c2, I(Rows(c1))) *
				    L(Cols(c2)*Cols(c1), Cols(c2)),
		 IsIdentitySPL(c2), self,
	         # else
		 Tensor(c1, I(Rows(c2)) * Tensor(I(Cols(c1)), c2).vectorForm()
	    )))),

    parallelForm := self >> Checked(self.numChildren() = 2,
	let(c1 := self.child(1), c2 := self.child(2),

	    Cond(IsIdentitySPL(c1) and IsIdentitySPL(c2), self,
		 IsIdentitySPL(c2), L(Rows(c2)*Rows(c1), Rows(c1)) *
		                    Tensor(I(Rows(c2)), c1) *
				    L(Cols(c2)*Cols(c1), Cols(c2)),
		 IsIdentitySPL(c1), self,
	         # else rc1*rc2 X cc1*cc2
		 Tensor(c1, I(Rows(c2))).parallelForm() * Tensor(I(Cols(c1)), c2)
	    ))),

    #-----------------------------------------------------------------------
    arithmeticCost := meth(self, costMul, costAddMul)
        local t, left, right, cost;
        left  := 1;
	right := self.dimensions[1];
	cost  := costMul(0) - costMul(0); # will work even when costMul(0) <> 0
	for t in self.children() do
	    right := right / t.dimensions[1];
	    cost  := cost + left * right * t.arithmeticCost(costMul, costAddMul);
	    left  := left * t.dimensions[2];
	od;
	return cost;
    end,
    #-----------------------------------------------------------------------
    latexSymbol := "\\tensor"
));


Balanced := function(L)
    local c, r;
    r := 0;
    for c in L do
        if c = ']' then
            r := r - 1;
            if r < 0 then
                return false;
            fi;
        elif c = '[' then
            r := r + 1;
        fi;
    od;
    return r = 0;
end;

Balanced("");
# true

Balanced("[");
# false

Balanced("]");
# false

Balanced("[]");
# true

Balanced("][");
# false

Balanced("[[][]]");
# true

Balanced("[[[]][]]]");
# false


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

_computeNumDen := (value) -> let(
    list := Filtered([1..10000], e -> IntDouble(value * e) = value * e),

    When(value = 0.0, [0, 1],
	 When(Length(list) = 0, [0, 1],
	      [IntDouble(list[1] * value), list[1]]))
);

_shiftElements := (sizeIdx, size, shft) -> let(
    numDen := _computeNumDen(shft), # numDen[1]/numDen[2] = shft
    i := Ind([0..sizeIdx - 1]),
    onlyPositive := (sizeIdx < size),
    # Lambda(i, cond(lt(i, size / 2), E(numDen[2] * size) ^ (sign(2 * i) * numDen[1] * i), E(numDen[2] * size) ^ (sign(2 * i - size) * numDen[1] * (i - size))))
    # Lambda(i, cond(lt(i, size / 2), E(numDen[2] * size) ^ (numDen[1] * i), E(numDen[2] * size) ^ (numDen[1] * (i - size))))
    Lambda(i, cond(onlyPositive,
                   E(numDen[2] * size) ^ (numDen[1] * i),
                   cond(lt(i, size / 2),
                        E(numDen[2] * size) ^ (numDen[1] * i),
                        E(numDen[2] * size) ^ (numDen[1] * (i - size)))))
);

#_tabelize := f->let(vals := f.tolist(), i := Ind(f.domain()), When(
#    ForAll(vals, v->v=vals[1]), Lambda(i, vals[1]),
#    Lambda(i, FData(List(vals, j->Value(TComplex, _unwrap(j)))).at(i))
#));

_tabelize := f->let(vals := f.tolist(), i := Ind(f.domain()), When(
    ForAll(vals, v->v=vals[1]), Lambda(i, vals[1]),
    let(    rtab := FData(Flat(List(vals, e->[re(e), im(e)]))),
        Lambda(i, cxpack(rtab.at(2*i), rtab.at(2*i+1))))
));

NewRulesFor(TResample, rec(
		   TResample_TGath := rec(
		       forTransposition := false,
		       switch           := true,
		       applicable       := nt -> ForAny(Zip2(nt.params[1], nt.params[2]), l-> l[1]<l[2]),
		       children      := nt -> [[TResample(nt.params[1], nt.params[1], nt.params[3]), TGath(_toBox(nt.params[2], nt.params[1]))]],
		       apply := (nt, C, cnt) -> C[1] * C[2]
		   ),

		   TResample_TScat := rec(
		       forTransposition := false,
		       switch           := true,
		       applicable       := nt -> ForAny(Zip2(nt.params[1], nt.params[2]), l-> l[1]>l[2]),
		       children      := nt -> [[TScat(_toBox(nt.params[1], nt.params[2])), TResample(nt.params[2], nt.params[2], nt.params[3])]],
		       apply := (nt, C, cnt) -> C[1] * C[2]

		   ),

		   TResample_MD_nofrac := rec(
		       forTransposition := false,
		       switch           := true,
		       applicable       := nt -> (nt.params[1] = nt.params[2]) and (Length(nt.params[1]) > 1) and ForAll(nt.params[3], e -> e = 0.0),
		       children := nt -> [[I(Product(nt.params[1]))]],
		       apply := (nt, C, cnt) -> C[1]
		   ),

		   # ASSUMPTION IS THAT FASTEST DIMENSION IS REAL DFT-ED
		   TResample_MD_frac := rec(
		       forTransposition := false,
		       switch           := true,
		       applicable       := nt -> (nt.params[1] = nt.params[2]) and (Length(nt.params[1]) > 1) and ForAny(nt.params[3], e -> (abs(e) > 0.0) and (abs(e) < 1.0)),
		       children      := nt -> [[IMDPRDFT(nt.params[1], 1), MDPRDFT(nt.params[2], -1)]],

		       apply := (nt, C, cnt) -> let(
    			   sizeX := Last(nt.params[2]),
    			   sizeXf := sizeX / 2 + 1,
    			   shftX := Last(nt.params[3]),

    			   dXf := diagMul(fConst(sizeXf, 1/sizeX), _shiftElements(sizeXf, sizeX, shftX)),

    			   sizes := DropLast(nt.params[2], 1),
    			   shfts := DropLast(nt.params[3], 1),

    			   df := List([1..Length(sizes)], e -> diagMul(fConst(sizes[e], 1/sizes[e]), _shiftElements(sizes[e], sizes[e], shfts[e]))),
                   dd := List(df::[dXf], _tabelize),

    			   C[1] *
    			   RCDiag(RCData(diagTensor(dd))) *
    			   C[2]
		       )
		   )
	       )
	   );


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

Class(Ext, Sym, rec(
    abbrevs := [
	(n, ext) -> [n, ext, ext, 1, 1],
	(n, l, r) -> [n, l, r, 1, 1] ],

    def := function(n, l, r, lscale, rscale)
         local stack;
         Checked(IsPosInt(n), true);
         stack := [];

         if (IsInt(l) and l>0) then
           Add(stack,O(l,n));
         elif (IsRec(l) and not l.n=0 ) then
           l := When(IsSPL(l), l, l.left(n));
           Add(stack, When(lscale<>1, lscale*Gath(l), Gath(l)));
         fi;

         Add(stack, I(n));

         if (IsInt(r) and r>0) then
           Add(stack,O(r,n));
         elif (IsRec(r) and not r.n=0 ) then
           r := When(IsSPL(r), r, r.right(n));
           Add(stack, When(rscale<>1, rscale*Gath(r), Gath(r)));
         fi;

	    return VStack(stack);
    end
));

Class(DownSample, Sym, rec(
    abbrevs := [ (n, fact, offset) ->
        Checked(IsPosInt(n), IsPosInt(fact), IsPosInt0(offset), [n, fact, offset]) ],

    def := (n, fact, offset) -> let(m := Int((n-offset-1) / fact + 1),
         Gath(H(n, m, offset, fact)))
));

Class(UpSample, Sym, rec(
    abbrevs := [ (n, fact, offset) ->
        Checked(IsPosInt(n), IsPosInt(fact), IsPosInt0(offset), [n, fact, offset]) ],

    def := (n, fact, offset) -> let(m := Int((n-offset-1) / fact + 1),
         Scat(H(n, m, offset, fact)))
));


latexPoly:=function(poly,APR,var_name)
    local result,ext_rep,i,j,monom,coeff,
    avars,ext_avars,pos;

    if not IsPolynomialRing(APR) then return String(Int(poly)); fi;

    ext_rep:=ExtRepPolynomialRatFun(poly);
    avars:=IndeterminatesOfPolynomialRing(APR);
    ext_avars:=List(avars,i->ExtRepPolynomialRatFun(i));
    ext_avars:=List(ext_avars,i->i[1][1]);
    result:="";
    for i in 2*[1..Length(ext_rep)/2]-1 do
        monom:="";
        for j in 2*[1..Length(ext_rep[i])/2]-1 do
            pos:=Position(ext_avars,ext_rep[i][j]);
            monom:=Concatenation(monom,String(avars[pos]));
            if ext_rep[i][j+1]<>1 then
                monom:=Concatenation(monom,"^{",String(ext_rep[i][j+1]),"}");
            fi;
        od;
        coeff:=latexPoly(ext_rep[i+1],CoefficientsRing(APR),"a");#String(Int(ext_rep[i+1]));
        if i > 1 then result:=Concatenation(result,"+"); fi;
        if coeff="1" and monom<>"" then
            result:=Concatenation(result,monom);
        else
            result:=Concatenation(result,coeff,monom);
        fi;
    od;
    result:=ReplacedString(result,String(avars[1]){[1]},var_name);
    return result;
end;

latexUnipotent:=function(u)
    local result,
    coeffs,i,pr,root,poly,APR;

    coeffs:=coefficients(u);
    APR:=ring(chevalleyAdj(u));
    pr:=positiveRoots(chevalleyAdj(u));
    result:="";
    for i in [1..Length(coeffs)] do
        #root:=Concatenation(List(pr[coeffs[i][1]],j->String(j)));
        #poly:=ReplacedString(String(coeffs[i][2]),"*","");
        result:=Concatenation(result,"u_{",String(coeffs[i][1]),"}(",latexPoly(coeffs[i][2],APR,"t"),")");
    od;

    #result:=ReplacedString(result,"a","t");
    return result;
end;

latexUnipotentNice:=function(u)
    local result,
    coeffs,i,pr,root,poly,APR;

    coeffs:=coefficients(u);
    APR:=ring(chevalleyAdj(u));
    pr:=positiveRoots(chevalleyAdj(u));
    result:="";
    for i in [1..Length(coeffs)] do
        if type(chevalleyAdj(u))="F" then root:=Concatenation(List(pr[coeffs[i][1]],j->String(j))){[2,4,3,1]};
        else root:=Concatenation(List(pr[coeffs[i][1]],j->String(j))); fi;
        #poly:=ReplacedString(String(coeffs[i][2]),"*","");
        result:=Concatenation(result,"u_{",root,"}(",latexPoly(coeffs[i][2],APR,"t"),")");
    od;

    #result:=ReplacedString(result,"a","t");
    return result;
end;

latexUnipotentTrimmed:=function(u,step)
    local result,
    coeffs,i,pr,root,poly,APR,index;

    coeffs:=coefficients(u);
    APR:=ring(chevalleyAdj(u));
    pr:=positiveRoots(chevalleyAdj(u));
    result:="";
    index:=1;
    for i in [1..Length(coeffs)] do
        if index > step then
            index:=0;
            result:=Concatenation(result," \\\\ && ");
        fi;
        result:=Concatenation(result,"u_{",String(coeffs[i][1]),"}(",latexPoly(coeffs[i][2],APR,"t"),")\n");
        index:=index+Length(ExtRepPolynomialRatFun(coeffs[i][2]))/2;
    od;

    #result:=ReplacedString(result,"a","t");
    return result;
end;

trimmedString:=function(str,chars,step)
    local result,i;
    result:=[""];
    while Length(str)>0 do
        i:=step;
        while i<Length(str) and not str[i] in chars do
            i:=i+1;
        od;
        if i<Length(str) then
            Add(result,Concatenation(str{[1..i-1]},"\\\\ \n & & "));
            str:=str{[i..Length(str)]};
        else
            Add(result,str);
            str:="";
        fi;
    od;
    return Concatenation(result);
end;

trimmedStringNice:=function(str,chars,step)
    local result,i;
    result:=[""];
    while Length(str)>0 do
        i:=step;
        while i<Length(str) and not str[i] in chars do
            i:=i+1;
        od;
        if i<Length(str) then
            Add(result,Concatenation(str{[1..i-1]},"$\\\\\n&\n$"));
            str:=str{[i..Length(str)]};
        else
            Add(result,str);
            str:="";
        fi;
    od;
    return Concatenation(result);
end;

trimmedString2:=function(str,chars,start,step)
    local result,i,flag,nr_plusuri;
    result:=[""];
    flag:=true;
    nr_plusuri:=0;
    while Length(str)>0 do
        if flag = true then
            i:=step-start;
            flag:=false;
        else i:=step; fi;

        #i:=i+2*Length(Positions(str{[1..Minimum(i,Length(str))]},'+'));

        while i<Length(str) and not str[i] in chars do
            i:=i+1;
            #Print(str[i]);
            #if str[i] in ['+'] then nr_plusuri:=nr_plusuri+1; fi;
        od;
        if i<Length(str) then
            Add(result,Concatenation(str{[1..i-1]},"\\\\ \n & & "));
            str:=str{[i..Length(str)]};
        else
            Add(result,str);
            #Print("\n",nr_plusuri,"\n");
            str:="";
            nr_plusuri:=0;
        fi;
    od;
    return Concatenation(result);
end;

trimmedString2Nice:=function(str,chars,start,step)
    local result,i,flag,nr_plusuri;
    result:=[""];
    flag:=true;
    nr_plusuri:=0;
    while Length(str)>0 do
        if flag = true then
            i:=step-start;
            flag:=false;
        else i:=step; fi;

        #i:=i+2*Length(Positions(str{[1..Minimum(i,Length(str))]},'+'));

        while i<Length(str) and not str[i] in chars do
            i:=i+1;
            #Print(str[i]);
            #if str[i] in ['+'] then nr_plusuri:=nr_plusuri+1; fi;
        od;
        if i<Length(str) then
            Add(result,Concatenation(str{[1..i-1]},"$\\\\\n&\n$"));
            str:=str{[i..Length(str)]};
        else
            Add(result,str);
            #Print("\n",nr_plusuri,"\n");
            str:="";
            nr_plusuri:=0;
        fi;
    od;
    return Concatenation(result);
end;

latexClass:=function(orb,info)
    local fisier,
    u,sys,str,#info,
    step,i;

    #u:=Representative(orb);
    u:=BorelRep(orb);
    sys:=chevalleyAdj(u);
    #info:=handleClass(orb);

    fisier:=Concatenation("tex/data/",type(sys),String(rank(sys)),
                          "/char",String(Characteristic(sys)),
                          "/",Label(orb),".tex");
    fisier:=ReplacedString(fisier,"\\tilde ","s");
    fisier:=Filename(home_dir,fisier);

    step:=150;

    SizeScreen([2000,2000]);
    PrintTo(fisier,"\\textbf{Class $",Label(orb),"$:}");
    AppendTo(fisier,"\\begin{eqnarray*}\n");
    AppendTo(fisier,"&&\\mathbf{u}=");
    AppendTo(fisier,trimmedString(latexUnipotent(u),"u+",step));
#    AppendTo(fisier,"\\end{eqnarray*}\n");
#    AppendTo(fisier,"\\begin{eqnarray*}\n");
    AppendTo(fisier,"\\\\ && \\mathbf{C_U(u)^{\\circ}} =");
    AppendTo(fisier,trimmedString2(latexUnipotent(info[1][1]),"u+",30,step));
#    AppendTo(fisier,"\\end{eqnarray*}\n");
#    AppendTo(fisier,"\\begin{eqnarray*}\n");
    AppendTo(fisier,"\\\\ && \\mathbf{Z(C_U(u)^{\\circ})^{\\circ}} =");
    AppendTo(fisier,trimmedString2(latexUnipotent(info[2]),"u+",40,step));
    AppendTo(fisier,"\\\\ &&=");

    #
    #  short form of decomposition
    #
    str:="";
    for i in info[4][1] do
        if i <> info[4][1][1] then  str:=Concatenation(str," \\mid "); fi;
        str:=Concatenation(str,"W_{",String(Dimension(info[3][i])),"}");
    od;
    AppendTo(fisier,trimmedString(str,"u+",step));
    AppendTo(fisier," \\\|");
    str:="";
    for i in info[4][2] do
        if i <> info[4][2][1] then str:=Concatenation(str," \\mid "); fi;
        str:=Concatenation(str,"W_{",String(Dimension(info[3][i])),"}");
    od;
    AppendTo(fisier,trimmedString(str,"u+",step));
    #
    #  explicite form of decomposition
    #
    AppendTo(fisier,"\\\\ && =");
    str:="";
    for i in info[4][1] do
        if i <> info[4][1][1] then str:=Concatenation(str," \\mid "); fi;
        str:=Concatenation(str,latexUnipotent(info[3][i]));
    od;
    AppendTo(fisier,trimmedString(str,"u+",step));
    AppendTo(fisier," \\\|");
    str:="";
    for i in info[4][2] do
        if i <> info[4][2][1] then str:=Concatenation(str," \\mid "); fi;
        str:=Concatenation(str,latexUnipotent(info[3][i]));
    od;
    AppendTo(fisier,trimmedString(str,"u+",step));

    AppendTo(fisier,"\\end{eqnarray*}\n");
    SizeScreen([156,39]);
end;

latexClasses:=function(orbs,infos)
    local i;
    for i in [1..Length(Classes(orbs))] do
        latexClass(Classes(orbs)[i],infos[i]);
    od;
end;

latexClassShort:=function(orb,info)
    local fisier,
    uu,u,sys,str,#info,
    step,i;

    uu:=Representative(orb);
    u:=BorelRep(orb);
    sys:=chevalleyAdj(u);
    #info:=handleClass(orb);

    fisier:=Concatenation("tex/data/",type(sys),String(rank(sys)),
                          "/char",String(Characteristic(sys)),
                          "/",Label(orb),".tex");
    fisier:=ReplacedString(fisier,"\\tilde ","s");
    fisier:=Filename(home_dir,fisier);

    step:=150;

    SizeScreen([2000,2000]);
    PrintTo(fisier,"\\textbf{Class $",Label(orb),"$:}");
    AppendTo(fisier,"\\begin{eqnarray*}\n");
    AppendTo(fisier,"&&\\mathbf{\\tilde u}=");
    AppendTo(fisier,trimmedString(latexUnipotent(uu),"u+",step));
    AppendTo(fisier,"\\\\ &&\\mathbf{u}=");
    AppendTo(fisier,trimmedString(latexUnipotent(u),"u+",step));
#    AppendTo(fisier,"\\end{eqnarray*}\n");
#    AppendTo(fisier,"\\begin{eqnarray*}\n");
    AppendTo(fisier,"\\\\ && \\mathbf{C_U(u)^{\\circ}} =");
    AppendTo(fisier,trimmedString2(latexUnipotent(info[1]),"u+",30,step));
#    AppendTo(fisier,"\\end{eqnarray*}\n");
#    AppendTo(fisier,"\\begin{eqnarray*}\n");
    AppendTo(fisier,"\\\\ && \\mathbf{Z(C_U(u)^{\\circ})^{\\circ}} =");
    AppendTo(fisier,trimmedString2(latexUnipotent(info[2]),"u+",40,step));
    AppendTo(fisier,"\\end{eqnarray*}\n");
    SizeScreen([156,39]);
end;

latexClassShortNice:=function(orb,info)
    local fisier,
    uu,u,sys,str,#info,
    step,i;

    uu:=Representative(orb);
    u:=BorelRep(orb);
    sys:=chevalleyAdj(u);
    #info:=handleClass(orb);

    fisier:=Concatenation("tex/data/",type(sys),String(rank(sys)),
                          "/char",String(Characteristic(sys)),
                          "/",Label(orb),".tex");
    fisier:=ReplacedString(fisier,"\\tilde ","s");
    fisier:=Filename(home_dir,fisier);

    step:=150;

    SizeScreen([2000,2000]);
#    PrintTo(fisier,"$$\n\\begin{array}{p{3cm} p{20cm}}\n");
#    AppendTo(fisier,"\\textbf{Class $",Label(orb),"$:} &\\\\\n ");
    PrintTo(fisier,"\\textbf{p=",Characteristic(sys),":}");
    AppendTo(fisier,"&$\\mathbf{u}=");
    AppendTo(fisier,trimmedStringNice(latexUnipotentNice(uu),"u+",step));
    AppendTo(fisier,"$\\\\\n&\n$\\mathbf{\\tilde u}=");
    AppendTo(fisier,trimmedStringNice(latexUnipotentNice(u),"u+",step));
    AppendTo(fisier,"$\\\\\n&\n$\\mathbf{C_U(\\tilde u)^{\\circ}} =");
    AppendTo(fisier,trimmedString2Nice(latexUnipotentNice(Unipotent(chevalleyAdj(u),coefficients(info[1]),Ordering(u))),"u+",30,step));
    AppendTo(fisier,"$\\\\\n&\n$\\mathbf{Z(C_G(u))^{\\circ}} =");
    AppendTo(fisier,trimmedString2Nice(latexUnipotentNice(Unipotent(chevalleyAdj(uu),coefficients(FromPositiveBorel(orb,info[2])),Ordering(uu))),"u+",40,step));
    AppendTo(fisier,"$\\\\\n");
#    AppendTo(fisier,"$\n\\end{array}\n$$");
    SizeScreen([156,39]);
end;

latexClassVeryShortNice:=function(orb,info)
    local fisier,
    uu,u,sys,str,#info,
    step,i;

    uu:=Representative(orb);
    u:=BorelRep(orb);
    sys:=chevalleyAdj(u);
    #info:=handleClass(orb);

    fisier:=Concatenation("tex/data/",type(sys),String(rank(sys)),
                          "/char",String(Characteristic(sys)),
                          "/",Label(orb),".tex");
    fisier:=ReplacedString(fisier,"\\tilde ","s");
    fisier:=Filename(home_dir,fisier);

    step:=150;

    SizeScreen([2000,2000]);
#    PrintTo(fisier,"$$\n\\begin{array}{p{3cm} p{20cm}}\n");
#    AppendTo(fisier,"\\textbf{Class $",Label(orb),"$:} &\\\\\n ");
    PrintTo(fisier,"\\textbf{p=",Characteristic(sys),":}");
    AppendTo(fisier,"&$\\mathbf{u}=");
    AppendTo(fisier,trimmedStringNice(latexUnipotentNice(uu),"u+",step));
    AppendTo(fisier,"$\\\\\n&\n$\\mathbf{\\tilde u}=");
    AppendTo(fisier,trimmedStringNice(latexUnipotentNice(u),"u+",step));
#    AppendTo(fisier,"$\\\\\n&\n$\\mathbf{C_U(\\tilde u)^{\\circ}} =");
#    AppendTo(fisier,trimmedString2Nice(latexUnipotentNice(Unipotent(chevalleyAdj(u),coefficients(info[1]),Ordering(u))),"u+",30,step));
    AppendTo(fisier,"$\\\\\n&\n$\\mathbf{Z(C_G(u))^{\\circ}} =");
    AppendTo(fisier,trimmedString2Nice(latexUnipotentNice(Unipotent(chevalleyAdj(uu),coefficients(FromPositiveBorel(orb,info[2])),Ordering(uu))),"u+",40,step));
    AppendTo(fisier,"$\\\\\n");
#    AppendTo(fisier,"$\n\\end{array}\n$$");
    SizeScreen([156,39]);
end;

latexClassesShort:=function(orbs,infos)
    local i;
    for i in [1..Length(Classes(orbs))] do
        latexClassShort(Classes(orbs)[i],infos[i]);
    od;
end;

latexClassesShortNice:=function(orbs,infos)
    local i;
    for i in [1..Length(Classes(orbs))] do
        latexClassShortNice(Classes(orbs)[i],infos[i]);
    od;
end;

latexClassesVeryShortNice:=function(orbs,infos)
    local i;
    for i in [1..Length(Classes(orbs))] do
        latexClassVeryShortNice(Classes(orbs)[i],infos[i]);
    od;
end;

latexFisiere:=function(orbs)
    local result,
    sys,tip,rang,p,
    fisier,fisi,orb;

    sys:=algebraicU(orbs);
    tip:=type(sys);
    rang:=rank(sys);
    p:=Characteristic(sys);
    fisier:=Concatenation("tex/data/all",tip,String(rang),"char",String(p),".tex");
    fisier:=Filename(home_dir,fisier);

    result:="";
    for orb in Classes(orbs) do
        result:=Concatenation(result,"\\input{data/",tip,String(rang),"/char",String(p),"/",Label(orb),".tex}\n");
        fisi:=Concatenation("tex/data/",tip,String(rang),"/char",String(p),"/",Label(orb),".tex");
        fisi:=ReplacedString(fisi,"\\tilde ","s");
        fisi:=Filename(home_dir,fisi);
        PrintTo(fisi," ");
    od;

    result:=ReplacedString(result,"\\tilde ","s");
    PrintTo(fisier,result);
end;

latexFisiereNice:=function(orbs)
    local result,inainte,dupa,
    sys,tip,rang,p,
    fisier,fisi,orb;

    sys:=algebraicU(orbs);
    tip:=type(sys);
    rang:=rank(sys);
    p:=Characteristic(sys);
    fisier:=Concatenation("tex/data/all",tip,String(rang),"char",String(p),".tex");
    fisier:=Filename(home_dir,fisier);

    dupa:="\\end{array}$";

    result:="";
    for orb in Classes(orbs) do
        inainte:=Concatenation("\\\\\n\\par\\noindent\n$\\begin{array}{p{0.7cm} p{15cm}}\n$\\mathbf{",Label(orb),"}$ &\\\\");
        result:=Concatenation(result,inainte,"\n\\input{data/",tip,String(rang),"/char",String(p),"/",Label(orb),".tex}\n",dupa,"\n");
        fisi:=Concatenation("tex/data/",tip,String(rang),"/char",String(p),"/",Label(orb),".tex");
        fisi:=ReplacedString(fisi,"\\tilde ","s");
        fisi:=Filename(home_dir,fisi);
#        PrintTo(fisi," ");
    od;

    result:=ReplacedString(result,"\\tilde ","s");
    PrintTo(fisier,result);
end;

#
#   SAGE
#

sageAdu:=function(classes)
    local sys,orbs,orbs_len,o,fisier_out,dir,dir_labels,ad,result,i,j,dim;
    sys:=algebraicU(classes);
    orbs:=Classes(classes);
    dir_labels:=Directory(Concatenation("~/workspace/ChevalleyAdj/sage/data/",type(sys),String(rank(sys))));
    dir:=Directory(Concatenation("~/workspace/ChevalleyAdj/sage/data/",
                                 type(sys),String(rank(sys)),"/char",String(Characteristic(sys))));

    SizeScreen([2000,2000]);
    for o in orbs do
        fisier_out:=Concatenation(Label(o),".sage");
        fisier_out:=ReplacedString(fisier_out,"\\tilde ","s");
        fisier_out:=Filename(dir,fisier_out);
        ad:=Descend(Representative(o),chevalleyAdj(chevalleyAdj(Representative(o))));
        ad:=Adu(ad);
        ad:=List(ad,i->List(i,j->Int(j)));
#        result:=List(ad,i->ReplacedString(String(i),", ",","));
#        result:=ReplacedString(result,", ",",");
#        result:=ReplacedString(result,"],","],\n");
#        PrintTo(fisier_out,Concatenation("rep=",result));
        PrintTo(fisier_out,"rep=");
        AppendTo(fisier_out,"[");
        dim:=Length(ad);
        for i in [1..dim] do
            AppendTo(fisier_out,"[");
            for j in [1..dim] do
                AppendTo(fisier_out,String(ad[i][j]));
                if j<>dim then AppendTo(fisier_out,","); fi;
            od;
            AppendTo(fisier_out,"]");
            if i<>dim then AppendTo(fisier_out,",\n"); fi;
        od;
        AppendTo(fisier_out,"]");
    od;

    fisier_out:=Filename(dir_labels,Concatenation("char",String(Characteristic(sys)),"Labels.sage"));
    PrintTo(fisier_out,"labels=[");
    orbs_len:=Length(orbs);
    for i in [1..orbs_len] do
         AppendTo(fisier_out,"\"",ReplacedString(Label(orbs[i]),"\\tilde ","s"),"\"");
         if i<>orbs_len then AppendTo(fisier_out,","); fi;
    od;
    AppendTo(fisier_out,"]");

    SizeScreen([156,39]);
end;

latexJordanBlocks:=function(classes)
    local sys,result,fisier_out,tex_blocks,o;
    sys:=algebraicU(classes);
    fisier_out:=Concatenation("~/workspace/ChevalleyAdj/tex/data/",
                              type(sys),String(rank(sys)),"/char",String(Characteristic(sys)),"blocks.tex");

    tex_blocks:=function(blocks)
        local result;
        result:=Concatenation(List(blocks,b->Concatenation(",",String(b[1]),"^{",String(b[2]),"}")));
        result:=result{[2..Length(result)]};
        return ReplacedString(result,"^{1}","");
    end;

    result:="";
    for o in Classes(classes) do
        result:=Concatenation(result,"$",Label(o),"$ & $",tex_blocks(AduJordanBlocks(Representative(o))),"$\\\\ \n");
    od;

    PrintTo(fisier_out,"\\begin{tabular}{|c|c|}\n \\hline \n");
    AppendTo(fisier_out,"Class & Blocks\\\\ \\hline\n");
    AppendTo(fisier_out,result,"\\hline\n");
    AppendTo(fisier_out,"\\end{tabular}\n");
end;


# Copyright (c) 2018-2020, Carnegie Mellon University
# See LICENSE for details
#
# Top-level qCirc object and associated helpers
#

##
#F CircTerm( <ops>, <n>, <arch> )
##
#F given a list of operations to perform on  target qubits, the number of qubits, and the hardware architecture,
#F expand out the qCircuit object as a matrix product of qEmbed objects
##
CircTerm := function(ops, n, arch)
    local mat, h, oper;
    mat := I(2^(n));
    for oper in ops do
        # oper is [[1,2,3], qHT], for example
        h := qEmbed(oper[1], n, arch, oper[2]).terminate();
        mat := mat * h;
    od;
    return mat;
end;

##
#F ArchUpdate( <oplist>, <arch> )
##
#F updates all operations in oplist to use the new architecture
##
ArchUpdate := function(oplist, arch)
    local newlist, ops, qubits, T;
    newlist := [];
    for ops in oplist do
        # op is [[qubits], Transform]
        qubits := ops[1];
        T := ops[2].recursive_def(arch);
        Add(newlist, [qubits, T]);
    od;
    return newlist;
end;

##
#F qCirc( <arch>, <n>, <ops>) Object
##
#F Given architecture arch and number of qubits n, embed each operation in ops
#F an operation is a [[qubit list], <Non-Terminal>] list
#F ops in an operation list
Class(qCirc, TaggedNonTerminal, rec(
  abbrevs   := [ (arch, n, ops) -> Checked(IsPosInt(n), [arch, n, ops]) ],
  dims      := self >> let(size := 2^self.params[2], [size, size]),
  terminate := self >> CircTerm(self.params[3], self.params[2], self.params[1]),
  isReal    := self >> false,
  recursive_def := (self, arch) >> self.__bases__[1](arch, self.params[2], ArchUpdate(self.params[3], arch) ),
  rChildren := self >> self.params,
  from_rChildren := (self, rch) >> self.__bases__[1](rch[1], rch[2], rch[3]),
  SmallRandom := () -> Random([2..5]),
  LargeRandom := () -> Random([6..15]),
  normalizedArithCost := self >> Error("ArithCost not implemented"),
  TType := T_Complex(64)
));

##
#F GenCircChildren( <arch>, <n>, <ops> )
##
#F given a list of operations to perform on target qubits, the number of qubits, and the hardware architecture,
#F expand out the qCircuit object as a matrix product of qEmbed objects
##
GenCircChildren := function(arch, n, ops)
    local current_op, ops, h1, h, rest;
    current_op := ops[1];
    h1 := qEmbed(current_op[1], n, arch, current_op[2]);
    h := h1;
    if Length(ops) > 1 then
        rest := [2..Length(ops)];
        rest := Map(rest, i -> ops[i]);
        h := h * qCirc(arch, n, rest);
    fi;
    return [h];
end;

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

    # qCirc_Expand rule
    # qCirc_Expand qCirc(arch, n, ops) -> qEmbed(qubits, n, arch, <Non-Terminal>) * ...
    qCirc_Expand := rec (
        forTransposition := false,
        minSize          := 2,
        applicable       := (self, nt) >> (nt.params[3] <> []),
        children         := nt -> List([GenCircChildren(nt.params[1], nt.params[2], nt.params[3])]),
        apply            := (nt, c, cnt) -> c[1],
        switch := true,
    ),

    # qCirc_Base rule
    # QCirc_Base qCirc(arch, n, []) -> I(2^n)
    qCirc_Base := rec(
        info             := "qCirc -> Identity",
        forTransposition := false,
        applicable       := (self, nt) >> (nt.params[3] = []),
        apply            := (nt, c, cnt) -> I(2^(nt.params[2])),
    )

));


# Define a pregroup by giving a list of generator names and
# a (partial) multiplication table
InstallGlobalFunction(PregroupByTableNC,
function(enams, inv, table)
    local r,e;

    r := rec( PregroupElementNames := enams
            , inv := inv
            , table := table );
    r.fam := NewFamily( "PregroupElementsFamily", IsElementOfPregroup );
    r.elt_t := NewType( r!.fam, IsElementOfPregroupRep );
    r.wfam := NewFamily( "PregroupWordFamily", IsPregroupWord );
    r.word_t := NewType( r!.wfam, IsPregroupWordListRep );
    r.elts := List( [1..Length(table)], i -> Objectify(r.elt_t, rec(parent := r, elt := i)));
    r.invs := [];
    for e in [1..Length(r.elts)] do
        r.elts[e]!.inv := r.elts[inv(e)];
    od;
    Objectify(PregroupByTableType, r);
    SetPregroupElementNames(r, enams);
    return r;
end);

InstallGlobalFunction(PregroupInversesFromTable,
function(table)
    local i,j,inv;

    inv := [];
    for i in [1..Length(table)] do
        for j in [1..Length(table[i])] do
            if table[i][j] = 1 then
                if IsBound(inv[i]) then
                    if inv[i] <> j then
                        Error("inverses not well-defined");
                    fi;
                else
                    inv[i] := j;
                fi;
            fi;
        od;
    od;
    inv := PermList(inv);
    if inv = fail then
        Error("inverses not well-defined");
    fi;
    return x -> x^inv;
end);

InstallGlobalFunction(PregroupByTable,
function(enams, table)
    local nels, inv, row, e, f, g, h;

    # We assume that the length of the list of
    # element names is the number of elements
    nels := Length(enams);

    if Length(table) <> nels then
        Error("PregroupByTable: Length of enams does not match number of rows in table");
    fi;
    for row in table do
        if Length(row) <> nels then
            Error("PregroupByTable: Multiplication table is not square");
        fi;
        for e in row do
            if (not IsInt(e)) or (e < 0) or (e > nels) then
                Error("PregroupByTable: Table entry ", e, " is invalid, needs to be an integer between 0 and ", nels);
            fi;
        od;
    od;

    inv := PregroupInversesFromTable(table);
    for e in [1..nels] do
        if inv(inv(e)) <> e then
            Error("PregroupByTable: inv needs to be an involution");
        fi;
    od;
    for e in [1..nels] do
        if (table[1][e] <> e) or (table[e][1] <> e) then
            Error("PregroupByTable: ",e,"*1 = ", e, " or 1*", e, " = ", e, " not satisfied");
        fi;
        if (table[e][inv(e)] <> 1) or (table[inv(e)][e] <> 1) then
            Error("PregroupByTable: inverses");
        fi;
    od;

    for e in [1..nels] do
        for f in [1..nels] do
            for g in [1..nels] do
                if table[e][f] > 0 and table[f][g] > 0 then
                    if (table[table[e][f]][g] = 0 and table[e][table[f][g]] > 0) or
                       (table[table[e][f]][g] > 0 and table[e][table[f][g]] = 0) then
                        Error("PregroupByTable: associativity");
                    fi;
                fi;
            od;
        od;
    od;

    for e in [1..nels] do
        for f in [1..nels] do
            if table[e][f] > 0 then
                for g in [1..nels] do
                    if table[f][g] > 0 then
                        for h in [1..nels] do
                            if table[g][h] > 0 then
                                if table[table[e][f]][g] = 0 and table[table[f][g]][h] = 0 then
                                    Error("PregroupByTable: P5 violated");
                                fi;
                            fi;
                        od;
                    fi;
                od;
            fi;
        od;
    od;
    return PregroupByTableNC(enams, inv, table);
end);

InstallMethod(\[\]
             , "for a pregroup in table rep"
             , [IsPregroupTableRep, IsInt],
function(f,a)
    return f!.elts[a];
end);

InstallMethod(Iterator
             , "for a pregroup"
             , [IsPregroupTableRep],
function(pgp)
    local r;

    r := rec( pgp := pgp
            , pos := 0
            , length := Size(pgp)
            , NextIterator := function(iter)
                if iter!.pos < iter!.length then
                    iter!.pos := iter!.pos + 1;
                    return iter!.pgp[iter!.pos];
                else
                    return fail;
                fi;
            end
            , IsDoneIterator := iter -> iter!.pos = iter!.length
            , ShallowCopy := iter -> rec( pgp := iter!.pgp, pos := iter!.pos )
            );

    return IteratorByFunctions(r);
end);

InstallMethod(PregroupElementNames
             , "for a pregroup"
             , [IsPregroupTableRep]
             , p -> p!.elementnames );

InstallMethod(SetPregroupElementNames
             , "for a pregroup"
             , [IsPregroupTableRep, IsList]
             , function(p, n)
                 p!.elementnames := n;
             end );

InstallMethod(ViewString
             , "for a pregroup in table rep"
             , [IsPregroupTableRep],
function(pg)
    return STRINGIFY("<pregroup with ", Size(pg), " elements in table rep>");
end);

InstallMethod(Size
             , "for a pregroup in table rep"
             , [IsPregroup and IsPregroupTableRep],
function(pg)
    return Length(pg!.elts);
end);

#XXX at the moment [1,x] and [x,1] intermult, but I don't think
#    this is really needed?
#XXX Intermult is only defined for elements other than 1
InstallMethod(IntermultPairs
             , "for a pregroup in table rep"
             , [IsPregroupTableRep],
function(pg)
    local i, j, k, pairs;

    pairs := [];
    for i in [2..Size(pg)] do
        for j in [2..Size(pg)] do
            if (i <> pg!.inv(j)) then
                if (pg!.table[i][j] > 0) then
                    Add(pairs, [pg[i],pg[j]]);
                else
                    for k in [2..Size(pg)] do
                        if (pg!.table[i][k] > 0) and
                           (pg!.table[pg!.inv(k)][j] > 0) then
                            Add(pairs, [pg[i],pg[j]]);
                            break;
                        fi;
                    od;
                fi;
            fi;
        od;
    od;
    return pairs;
end);

InstallMethod(IntermultPairsIDs
             , "for a pregroup in table rep"
             , [IsPregroupTableRep],
function(pg)
    local i, j, k, pairs;

    pairs := [];
    for i in [2..Size(pg)] do
        for j in [2..Size(pg)] do
            if (i <> pg!.inv(j)) then
                if (pg!.table[i][j] > 0) then
                    Add(pairs, [i,j]);
                else
                    for k in [2..Size(pg)] do
                        if (pg!.table[i][k] > 0) and
                           (pg!.table[pg!.inv(k)][j] > 0) then
                            Add(pairs, [i,j]);
                            break;
                        fi;
                    od;
                fi;
            fi;
        od;
    od;
    return pairs;
end);

InstallMethod(IntermultMapIDs
             , "for a pregroup in table rep"
             , [IsPregroupTableRep],
function(pg)
    local i, j, k, map;

    map := [];
    for i in [1..Size(pg)] do
        map[i] := [];
    od;

    for i in [2..Size(pg)] do
        for j in [2..Size(pg)] do
            if (i <> pg!.inv(j)) then
                if (pg!.table[i][j] > 0) then
                    Add(map[i], j);
                else
                    for k in [2..Size(pg)] do
                        if (pg!.table[i][k] > 0) and
                           (pg!.table[pg!.inv(k)][j] > 0) then
                            Add(map[i],j);
                            break;
                        fi;
                    od;
                fi;
            fi;
        od;
    od;
    return map;
end);

InstallMethod(IntermultMap
             , "for a pregroup in table rep"
             , [IsPregroupTableRep],
function(pg)
    return List(IntermultMapIDs(pg), x -> List(x, i -> pg[i]));
end);

InstallMethod(IntermultTable
             , "for a pregroup in table rep"
             , [IsPregroupTableRep],
function(pg)
    local i, j, k, map;

    map := [];
    for i in [1..Size(pg)] do
        map[i] := [false];
    od;

    for i in [2..Size(pg)] do
        for j in [2..Size(pg)] do
            map[i][j] := false;
            if (i <> pg!.inv(j)) then
                if (pg!.table[i][j] > 0) then
                    map[i][j] := true;
                else
                    for k in [2..Size(pg)] do
                        if (pg!.table[i][k] > 0) and
                          (pg!.table[pg!.inv(k)][j] > 0) then
                            map[i][j] := true;
                            break;
                        fi;
                    od;
                fi;
            fi;
        od;
    od;
    return map;
end);

InstallMethod(One, "for a pregroup",
              [IsPregroup],
              pg -> pg!.elts[1]);

# This is very inefficient, but I don't care at the moment
InstallMethod(MultiplicationTableIDs,
              "for a pregroup",
              [IsPregroup],
function(pg)
    local i, j, table;

    table := [];
    for i in [1..Size(pg)] do
        table[i] := [];
        for j in [1..Size(pg)] do
            table[i][j] := pg[i] * pg[j];
            if table[i][j] = fail then
                table[i][j] := 0;
            else
                table[i][j] := __ID(table[i][j]);
            fi;
        od;
    od;
    return table;
end);

InstallMethod(MultiplicationTable,
              "for a pregroup",
              [IsPregroup],
function(pg)
    local i, j, table;

    table := [];
    for i in [1..Size(pg)] do
        table[i] := [];
        for j in [1..Size(pg)] do
            table[i][j] := pg[i] * pg[j];
        od;
    od;
    return table;
end);

#
# Pregroup elements
#
InstallMethod(IntermultMap
             , "for a pregroup element"
             , [IsElementOfPregroupRep],
function(pge)
    return IntermultMap(pge!.parent)[__ID(pge)];
end);

InstallMethod(ViewString
             , "for a pregroup element"
             , [IsElementOfPregroupRep],
function(pge)
    if pge!.elt > 0 then
        return PregroupElementNames(pge!.parent)[pge!.elt];
    else
        return "undefined";
    fi;
end);

InstallMethod(String
             , "for a pregroup element"
             , [IsElementOfPregroupRep],
function(pge)
    if pge!.elt > 0 then
        return PregroupElementNames(pge!.parent)[pge!.elt];
    else
        return "undefined";
    fi;
end);

InstallMethod(InverseOp
             , "for a pregroup element"
             , [IsElementOfPregroupRep]
             , 0,
function(x)
    return PregroupInverse(x);
end);

#XXX Is fail as a result for multiplication acceptable?
InstallMethod(\*
             , "for pregroup elements"
             , IsIdenticalObj
             , [IsElementOfPregroupRep, IsElementOfPregroupRep]
             , 0,
function(x,y)
    local pg, r;

    pg := x!.parent;

    r := pg!.table[x!.elt][y!.elt];

    if r > 0 then
        return pg!.elts[r];
    else
        return fail;
    fi;
end);

InstallMethod(\=
             , "for pregroup elements"
             , IsIdenticalObj
             , [IsElementOfPregroupRep, IsElementOfPregroupRep]
             , 0,
function(x,y)
    return x!.elt = y!.elt;
end);

# Artificial ordering on pregroup to make sets work
InstallMethod(\<
             , "for pregroup elements"
             , IsIdenticalObj
             , [ IsElementOfPregroupRep, IsElementOfPregroupRep]
             , 0,
function(x,y)
    return x!.elt < y!.elt;
end);

InstallMethod(PregroupOf
             , "for pregroup elements"
             , [ IsElementOfPregroupRep ]
             , 0,
function(a)
    return a!.parent;
end);

InstallMethod(PregroupInverse
             , "for pregroup elements"
             , [ IsElementOfPregroupRep ]
             , 0,
             a -> a!.inv);

InstallMethod(PregroupElementId
             , "for pregroup elements"
             , [ IsElementOfPregroupRep]
             , 0,
             a -> a!.elt);

InstallMethod(__ID
             , "for pregroup elements"
             , [IsElementOfPregroup]
             , 0,
             x -> x!.elt);

InstallMethod(IsDefinedMultiplication
             , "for pregroup elements"
             , IsIdenticalObj
             , [IsElementOfPregroup, IsElementOfPregroup]
             , 0,
function(a,b)
    local pg;

    pg := PregroupOf(a);

    return pg!.table[a!.elt][b!.elt] > 0;
end);

# We could cache intermult pairs,
# or predetermine them, depending
# on the number of intermult lookups
# that could benefit runtime
InstallMethod(IsIntermultPair
             , "for pregroup elements"
             , IsIdenticalObj
             , [IsElementOfPregroup, IsElementOfPregroup]
             , 0,
function(a,b)
    local x, nontriv;

    return IntermultTable(a!.parent)[__ID(a)][__ID(b)];

    if a = PregroupInverse(b) then
        return false;
    elif IsDefinedMultiplication(a, b) then
        return true;
    else
        nontriv := List(PregroupOf(a), x -> x);
        Remove(nontriv, 1);
        for x in nontriv do
            if IsDefinedMultiplication(a,x)
               and IsDefinedMultiplication(PregroupInverse(x), b) then
                return true;
            fi;
        od;
        return false;
    fi;
    # Should not be reached
    Error("This shouldn't happen.");
end);


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

#F qYT( n ) - Y Gate non-terminal
#F Definition: (2^n x 2^n)-matrix  that applies an n-point Y Transform to the target qubits
#F Note:       qYT(1) denotes the matrix[[0, -i], [i, 0]],
#F             qYT(_) is not symmetric.
#F
#F qYT( n ) -> an n-qubit Y transform
Class(qYT, TaggedNonTerminal, rec(
  abbrevs   := [ n -> Checked(IsPosInt(n), [n]) ],
  dims      := self >> let(size := 2^self.params[1], [size, size]),
  terminate := self >> Tensor(Replicate(self.params[1], qX())),
  isReal    := self >> true,
  groups    := self >> [Replicate(self.params[1], 1)],
  rChildren := self >> self.params,
  from_rChildren := (self, rch) >> self.__bases__[1](rch[1]),
  recursive_def := (self, arch) >> self.__bases__[1](self.params[1]),
  connected := self >> true,
  SmallRandom := () -> Random([2..5]),
  LargeRandom := () -> Random([6..15]),
  normalizedArithCost := self >> Error("ArithCost not implemented"),
  TType := T_Complex(64),
));

NewRulesFor(qYT, rec(

    # qYT_BinSplit rule
    # qYT_BinSplit qYT_(k) -> (qYT_(k1) tensor I) (I tensor qYT_(k2))
    # k1 + k2 = k
    qYT_BinSplit := rec (
        forTransposition := false,
        minSize          := 2,
        applicable       := (self, nt) >> nt.params[1] > 1,
        children         := nt -> List( [1..nt.params[1] - 1],  i -> [ Tensor(qYT(i), qYT(nt.params[1]-i)).withTags(nt.getTags()) ]  ),
        apply            := (nt, c, cnt) -> c[1],
        switch := true,
    ),

    #F qYT_Base: qYT(1) = qY() SPL object
    #F Directly represent as an implementable gate
    qYT_Base := rec(
        info             := "qYT_(1) -> qY()",
        forTransposition := false,
        applicable       := (self, nt) >> nt.params[1]=1,
        apply            := (nt, c, cnt) -> qY(),
    )

));


#!/usr/bin/gap

# https://cp4space.wordpress.com/2020/05/10/minimalistic-quantum-computation/

Print("running universal.gap\n");;

r2 := Sqrt(2);;
ir2 := 1/r2;;

i := [[1, 0], [0, 1]];;
w := [[E(4), 0], [0, E(4)]];;
x := [[0, 1], [1, 0]];;
z := [[1, 0], [0, -1]];;
s := [[1, 0], [0, E(4)]];;
h := [[ir2, ir2], [ir2, -ir2]];;

Cliff1 := Group(w, s, h);; # Order 192
Pauli1 := Group(w, x, z);; # Order 32

xi := KroneckerProduct(x, i);;
ix := KroneckerProduct(i, x);;
zi := KroneckerProduct(z, i);;
iz := KroneckerProduct(i, z);;
si := KroneckerProduct(s, i);;
is := KroneckerProduct(i, s);;
hi := KroneckerProduct(h, i);;
ih := KroneckerProduct(i, h);;
wi := KroneckerProduct(w, i);;

cz := [
    [1, 0, 0, 0],
    [0, 1, 0, 0],
    [0, 0, 1, 0],
    [0, 0, 0, -1]];;

Cliff2 := Group(si, is, hi, ih, wi, cz);; # Order 92160
#for g in Cliff2 do Print(g, "\n"); od;
Pauli2 := Group(wi, xi, ix, zi, iz);;

xii := KroneckerProduct(xi, i);;
ixi := KroneckerProduct(i, xi);;
iix := KroneckerProduct(i, ix);;

zii := KroneckerProduct(zi, i);;
izi := KroneckerProduct(i, zi);;
iiz := KroneckerProduct(i, iz);;

sii := KroneckerProduct(si, i);;
isi := KroneckerProduct(i, si);;
iis := KroneckerProduct(i, is);;

hii := KroneckerProduct(hi, i);;
ihi := KroneckerProduct(i, hi);;
iih := KroneckerProduct(i, ih);;

wii := KroneckerProduct(wi, i);;

icz := KroneckerProduct(i, cz);;
czi := KroneckerProduct(cz, i);;

Tofolli := [
    [1, 0, 0, 0, 0, 0, 0, 0],
    [0, 1, 0, 0, 0, 0, 0, 0],
    [0, 0, 1, 0, 0, 0, 0, 0],
    [0, 0, 0, 1, 0, 0, 0, 0],
    [0, 0, 0, 0, 1, 0, 0, 0],
    [0, 0, 0, 0, 0, 1, 0, 0],
    [0, 0, 0, 0, 0, 0, 0, 1],
    [0, 0, 0, 0, 0, 0, 1, 0]];;

zhh := zii*ihi*iih;
hzh := izi*hii*iih;
hhz := iiz*hii*ihi;

xhh := xii*ihi*iih;
hxh := ixi*hii*iih;
hhx := iix*hii*ihi;

Gx := Group(Tofolli, xhh, hxh, hhx);
Gz := Group(Tofolli, zhh, hzh, hhz);

Print("Order(Gz) = ", Order(Gz), "\n");
Print("Order(Gx) = ", Order(Gx), "\n");

L7:= SimpleLieAlgebra("E", 7, Rationals);;
R7:= RootSystem(L7);;
W7:= WeylGroup(R7);
Print("Order(W7) = ", Order(W7), "\n");

f := IsomorphismGroups(Gz, W7);
Print("IsomorphismGroups(Gz, E7) = ", f, "\n");

L8:= SimpleLieAlgebra("E", 8, Rationals);;
R8:= RootSystem(L8);;
W8:= WeylGroup(R8);
Print("Order(W8) = ", Order(W8), "\n");

f := IsomorphismGroups(Gx, W8);
Print("IsomorphismGroups(Gx, E8) = ", f, "\n");