#############################################################################
####
##
#W  anupqid.gi              ANUPQ package                       Werner Nickel
#W                                                                Greg Gamble
##
##  This file installs functions to do with evaluating identities.
##
#Y  Copyright (C) 2001  Lehrstuhl D fuer Mathematik,  RWTH Aachen,  Germany
##

#############################################################################
##
#F  PqEvalSingleRelation( <proc>, <r>, <instances> )
##
InstallGlobalFunction( PqEvalSingleRelation, function( proc, r, instances )
    local   w, datarec;

#    Print( instances, "\n" );

    datarec := ANUPQDataRecord(proc);
    datarec.nwords := datarec.nwords + 1;
    w := CallFuncList( r, instances );
    if w <> w^0 then
#        Print( w );
#        Print( "\n" );
#        PqSetOutputLevel( proc, 3 );
        PqCollect( proc, String(w) );
        PqEchelonise( proc );
#        PqSetOutputLevel( proc, 0 );
    fi;
end );

#############################################################################
##
#F  PqEnumerateWords( <proc>, <data>, <r> )
##
##    The parameters of PqEnumerateWords() have the following meaning:
##
##    <r>          a relation involving identical generators.
##    <instances>  the list of instances to be built up corresponding the
##                 identical generators.
##    <n>          the index of the current word in <instances>
##    <g>          the next generator in the current word
##    <wt>         the weight that can be spent on the next generators.
##
InstallGlobalFunction( PqEnumerateWords, function( proc, data, r )
    local   n,  g,  wt,  u,  save_wt,  save_u,  save_g;

    n  := data.currentinst;
    g  := data.currentgen;
    wt := data.weightleft;
    u  := data.instances[ n ];

    save_wt := wt;
    save_u  := u;
    save_g  := g;

    if wt = 0 then
        PqEvalSingleRelation( proc, r, data.instances );
        Info( InfoANUPQ, 3, "Instance: ", data.instances[ n ] );
        return;
    fi;

    if g > Length( data.pcgens ) then return; fi;

    while g <= data.nrpcgens and data.pcweights[g] <= wt do
        while data.pcweights[g] <= wt do
            u := u * data.pcgens[g];
            wt := wt - data.pcweights[g];

            data.instances[ n ] := u;
            data.weightleft     := wt;
            data.currentgen     := g+1;
            PqEnumerateWords( proc, data, r );

            if n < Length(data.instances) then
                data.currentinst := n+1;
                data.currentgen  := 1;
                PqEnumerateWords( proc, data, r );
                data.currentinst := n;
            fi;
        od;
        u  := save_u; wt := save_wt; g := g+1;
    od;
    data.instances[ n ] := save_u;
    data.weightleft     := save_wt;
    data.currentgen     := save_g;
end );

#############################################################################
##
#F  PqEvaluateIdentity( <proc>, <r>, <arity> )
##
InstallGlobalFunction( PqEvaluateIdentity, function( proc, r, arity )
    local   n,  class,  gens,  data,  c;

    n     := PqNrPcGenerators( proc );
    class := PqWeight( proc, n );
    if class > 1 then
        while n > 0 and PqWeight( proc, n ) = class do n := n-1; od;
    fi;

    if n = 0 then return; fi;

    gens := GeneratorsOfGroup( FreeGroup( n, "x" ) );
    data := rec( instances   := List( [1..arity], i->gens[1]^0 ),
                 currentinst := 1,
                 currentgen  := 1,
                 weightleft  := 0,
                 pcgens      := gens,
                 nrpcgens    := n,
                 pcweights   := List( [1..n], i->PqWeight( proc, i ) )
                 );

    for c in [1..class] do
#        Print( "words of class ", c, "\n" );
        data.weightleft := c;
        PqEnumerateWords( proc, data, r );
    od;

end );

#############################################################################
##
#F  PqWithIdentity( <G>, <p>, <Cl>, <identity> )
##
##  constructs a <p>-quotient <Q> of the fp or pc group <G> of class at  most
##  <Cl> that satisfies $<identity>(<w1>, \dots, <wn>) =  1$  for  all  words
##  $<w1>, \dots, <wn>$ in the pc generators of <Q>. The  following  examples
##  demonstrate its usage.
##
##  \beginexample
###  gap> F := FreeGroup(2);
##  <free group on the generators [ f1, f2 ]>
##  gap> f := w -> w^4;
##  function( w ) ... end
##  gap> PqWithIdentity( F, 2, 20, f );
##  #I  Evaluated 5 instances.
##  #I  Class 2 with 5 generators.
##  #I  Evaluated 18 instances.
##  #I  Class 3 with 7 generators.
##  #I  Evaluated 44 instances.
##  #I  Class 4 with 10 generators.
##  #I  Evaluated 95 instances.
##  #I  Class 5 with 12 generators.
##  #I  Evaluated 192 instances.
##  #I  Class 6 with 12 generators.
##  <pc group of size 4096 with 12 generators>
##  gap>
##  gap> G := F/[ F.1^11, F.2^11 ];
##  <fp group on the generators [ f1, f2 ]>
##  gap> f := function(u, v) return PqLeftNormComm( [u, v, v, v] ); end;
##  function( u, v ) ... end
##  gap> H := PqWithIdentity( G, 11, 20, f );
##  #I  Evaluated 14 instances.
##  #I  Class 2 with 3 generators.
##  #I  Evaluated 44 instances.
##  #I  Class 3 with 5 generators.
##  #I  Evaluated 122 instances.
##  #I  Class 4 with 5 generators.
##  <pc group of size 161051 with 5 generators>
##  gap> f( Random(H), Random(H) );
##  <identity> of ...
##  gap> f( H.1, H.2 );
##  <identity> of ...
##  \endexample
##
##  Compare    the    above    examples    with    those    generated     by:
##  `PqExample("B2-4-Id");' and `PqExample("11gp-3-Engel-Id");' which do  the
##  same as above using the function `Pq' with the `Identities' option.
##
##  `PqWithIdentity' and the functions it calls,  with  minor  modifications,
##  constitute the prototype provided by Werner Nickel,  for  constructing  a
##  quotient that satisfies an identity. The prototype  functions  have  been
##  merged into the single function `PQ_EVALUATE_IDENTITY' which is called by
##  `PQ_EVALUATE_IDENTITIES'    which    in     turn     is     called     by
##  `PQ_FINISH_NEXT_CLASS'   which   is   called   by   `PQ_NEXT_CLASS'   and
##  `PQ_EPI_OR_PCOVER',  if   the   `Identities'   option   has   been   set.
##  `PQ_EPI_OR_PCOVER' is the function called  by  `Pq',  `PqEpimorphism'  or
##  `PqPCover'.
##
InstallGlobalFunction( PqWithIdentity, function( G, p, Cl, identity )
    local   proc,  datarec,  prev_n,  class,  grp, arity;

    arity := NumberArgumentsFunction( identity );

    proc := PqStart( G : Prime := p );
    datarec := ANUPQData.io[ proc ];
    datarec.nwords := 0;

    prev_n := 0;
    Pq( proc : ClassBound := 1 );    class := 1;

    PqEvaluateIdentity( proc, identity, arity );
    PqEliminateRedundantGenerators( proc );

    if PqNrPcGenerators( proc ) = 0 then
        return TrivialGroup( IsPcGroup );
    fi;

    while class < Cl and prev_n <> PqNrPcGenerators( proc ) do
        prev_n := PqNrPcGenerators( proc );

        PqSetupTablesForNextClass( proc );
        PqTails( proc, 0 );
        PqDoConsistencyChecks( proc, 0, 0 );
        PqCollectDefiningRelations( proc );

        PqDoExponentChecks( proc );

        datarec.nwords := 0;
        PqEvaluateIdentity( proc, identity, arity );
        Info(InfoANUPQ, 2, "Evaluated ", datarec.nwords, " instances." );

        PqEliminateRedundantGenerators( proc );

        class := class + 1;

        Info(InfoANUPQ, 1, "Class ", class, " with ",
                           PqNrPcGenerators(proc), " generators." );
    od;

    grp := PqCurrentGroup( proc );

    PqQuit( proc );

    return grp;
end );

#############################################################################
##
#F  PQ_EVALUATE_IDENTITY( <proc>, <identity> )
##
InstallGlobalFunction( PQ_EVALUATE_IDENTITY, function( proc, identity )
    local   EnumerateWords, data, datarec, nwords, arity, c;

    EnumerateWords := function()
      local   i,  g,  wt,  u,  w,  save_wt,  save_u,  save_g;

      i  := data.currentinst;
      g  := data.currentgen;
      wt := data.weightleft;
      u  := data.instances[ i ];

      save_wt := wt;
      save_u  := u;
      save_g  := g;

      if wt = 0 then
        #evaluate a single relation
        nwords := nwords + 1;
        w := CallFuncList( identity, data.instances );
        if w <> w^0 then
#         Print( w );
#         Print( "\n" );
#         PqSetOutputLevel( proc, 3 );
          PqCollect( proc, String(w) );
          PqEchelonise( proc );
#         PqSetOutputLevel( proc, 0 );
        fi;
        Info( InfoANUPQ, 3, "Instance: ", data.instances[ i ] );
        return;
      fi;

      while g <= data.nrpcgens and data.pcweights[g] <= wt do
        while data.pcweights[g] <= wt do
            u  := u * data.pcgens[g];
            wt := wt - data.pcweights[g];

            data.instances[ i ] := u;
            data.weightleft     := wt;
            data.currentgen     := g+1;
            EnumerateWords();

            if i < Length(data.instances) then
                data.currentinst := i+1;
                data.currentgen  := 1;
                EnumerateWords();
                data.currentinst := i;
            fi;
        od;
        u  := save_u; wt := save_wt; g := g+1;
      od;
      data.instances[ i ] := save_u;
      data.weightleft     := save_wt;
      data.currentgen     := save_g;
    end;

    data := rec( nrpcgens := PqNrPcGenerators( proc ) );
    if data.nrpcgens = 0 then
      return;
    fi;

    datarec  := ANUPQDataRecord( proc );
    if datarec.class > 1 then
      data.nrpcgens := datarec.ngens[ Length(datarec.ngens) - 1 ];
    fi;

    nwords := 0;
    arity  := NumberArgumentsFunction(identity);

    data.pcgens      := GeneratorsOfGroup( FreeGroup( data.nrpcgens, "x" ) );
    data.instances   := List( [1 .. arity], i -> data.pcgens[1]^0 );
    data.currentinst := 1;
    data.currentgen  := 1;
    data.pcweights   := List( [1 .. data.nrpcgens], i -> PqWeight( proc, i ) );

    for c in [1 .. datarec.class] do
#        Print( "words of class ", c, "\n" );
      data.weightleft := c;
      EnumerateWords();
    od;
    Info(InfoANUPQ, 2, "Evaluated ", nwords, " instances." );
end );

#E  anupqid.gi  . . . . . . . . . . . . . . . . . . . . . . . . . . ends here


RequirePackage("grape");

GC := function(x,y,i,j) return x[i]*y[j] - x[j]*y[i]; end;

G2 := function(q)
    local P, Q;
    if q mod 2 = 0 then
        Q := [[0,0,0,0,1,0,0],[0,0,0,0,0,1,0],[0,0,0,0,0,0,1],[0,0,0,1,0,0,0],[0,0,0,0,0,0,0],[0,0,0,0,0,0,0],[0,0,0,0,0,0,0]]*Z(q)^0;;
    else
        Q := [[0,0,0,0,1,0,0],[0,0,0,0,0,1,0],[0,0,0,0,0,0,1],[0,0,0,1,0,0,0],[1,0,0,0,0,0,0],[0,1,0,0,0,0,0],[0,0,1,0,0,0,0]]*Z(q)^0;;
    fi;
    P := Filtered(List(Subspaces(GF(q)^7, 1), y -> Elements(y)[2]), x -> x*Q*x = 0*Z(q));;

    return Graph(Group(()), P, function(x,y) return x; end,
        function(x,y)
            return x <> y and x*Q*y = 0*Z(q) and y*Q*x = 0*Z(q) and
            [ GC(x,y,2,3), GC(x,y,6,5), GC(x,y,3,1), GC(x,y,7,6), GC(x,y,1,2), GC(x,y,5,7) ] =
            [ GC(x,y,4,5), GC(x,y,4,3), GC(x,y,4,6), GC(x,y,4,1), GC(x,y,4,7), GC(x,y,4,2) ];
        end, true);;
end;


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

ZeroCoef := function(p)
local i, L;
L:=p.coefficients;
for i in [1..Length(p.coefficients)] do
  if AbsFloat(ReComplex(ComplexAny(p.coefficients[i]))) < FloatString("1e-4") then
    L[i] := p.baseRing.zero;
  fi;
od;
return Polynomial(p.baseRing, L, p.valuation);
end;

# Recursive implementation of the long division for Laurent polynomials h(z) and g(z)
# There are deg(h)-deg(g)+2 different schemes for division
LaurentRemainder := function ( arg )

local a, b, q, q1, r1, q2, r2, Ls, Lt, z,
      deghigha, deglowa, deghighb, deglowb, dega, degb, coefa, coefb,  divs;

if IsList(arg[1]) then arg:=arg[1];fi;
a:=arg[1];
b:=arg[2];

#Print("check");
if not (IsPolynomial(a) and IsPolynomial(a)) then
  Error("<a> and <b> must be polynomials");
elif not a.baseRing.name = b.baseRing.name then
  Error("Both polynomials have to be over the same field");
elif not IsBound(PolynomialRing(a.baseRing).isEuclideanRing) then
  Error("Polymonials must be constructed over a field, not over a ring");
fi;

z:=Indeterminate(a.baseRing);
z.name:="z";
if Length(arg)=3 then q:=arg[3]; else q:=0*z^0; fi;

deglowa := a.valuation;
deglowb := b.valuation;
dega := Length(a.coefficients)-1;
degb := Length(b.coefficients)-1;
deghigha := deglowa + dega;
deghighb := deglowb + degb;

coefa := a.coefficients;
coefb := b.coefficients;

if dega<degb then return [[q,a]];fi;

  q1 := Polynomial(a.baseRing,[coefa[dega+1]/coefb[degb+1]],deghigha-deghighb);
  r1 := a - q1 * b;
  q1 := q1 + q;
#  Print(q1);
#  Print("\n");
#  Print(r1);
#Print("\n");

#  q2 := coefa[1]/coefb[1] * z^(deglowa-deglowb);
  q2 := Polynomial(a.baseRing,[coefa[1]/coefb[1]],deglowa-deglowb);
  r2 := a - q2 * b;
  q2 := q2 + q;
  Ls := [];
  for divs in [[r1,b,q1],[r2,b,q2]] do
     Lt := LaurentRemainder(divs);
     Add(Ls,Lt);
  od;
  Ls := Flat(Ls);
  Ls := List([1..Length(Ls)/2], i->[Ls[2*i-1],Ls[2*i]]);
  Ls := List(Collected(Ls), col->col[1]);
  if not IsList(Ls[1]) then return [Ls];
  else return Ls;
  fi;

end;

#
# Note:
# ! Because we now use double floats, the LiftingScheme generates more LS than
# possible because of finite precision. There will be a bunch of the same lifting
# schemes generated multiple times with coefficients different after 10th
# decimal or so. This requies fixing !
#

#F LiftingScheme( <poly1>, <poly2> )
#F   returns a list of Laurent polynomials that represent
#F   primal and dual lifting steps factorization of the polyphase
#F   matrix of polynomials <poly1> and <poly2>:
#F            P(z)= [[ <poly1_even>, <poly1_odd>],
#F                   [ <poly2_even>, <poly2_odd>]]
#F   In Discrete Wavelet Transform notation, <poly1> represents
#F   a low-pass filter impulse response, whereas <poly2> represents
#F   a high-pass one.
#F
#F   The output is in the following format:
#F   [ b, l1(z), l2(z), .... , ln(z), c1, c2]
#F
#F   b - a binary symbol that determines the type of the
#F       initial lifting step (0 - primal, 1 - dual)
#F   li(z) - polynomial representing i-th lifting step
#F   c1, c2 - scaling constants
#F
#F   Example:
#F
#F   P(z)=  [ c1, 0  ] * [ 1, l2(z)] * [ 1    , 0 ]
#F          [  0, c2 ]   [ 0, 1    ]   [ l1(z), 1 ]
#F          ----------   -----------   ------------
#F           scaling      primal l.s.   dual l.s. (b=1)
#F
#F   Note: Factorization is implemented in Laurent Polynomial
#F   ring over the base field inherited from <poly1>, <poly2>.
#F

LiftingScheme := function ( M )

local he, ho, ge, go, hen, hon, gen, gon, b, QR, z, Le, Lo, L, Lc, Ls, ve, vo, P, factor, scheme;

#Print("Recursion \n");
# Check if h(z) and g(z) in fact represent a perfect reconstruction
# filter bank -> determinant of the polyphase matrix should be
# a monomial
he := M[1][1];ho := M[1][2]; ge := M[2][1]; go := M[2][2];
  if not Length(ZeroCoef(Determinant([[he, ho],[ge, go]])).coefficients) = 1 then
     Error("h(z) and g(z) must satisfy the perfect reconstruction condition P(z)*P'(z)^(-1) = I where P and P' are analysis and synthesis polyphase matrices");
  fi;

  z:=Indeterminate(he.baseRing);
  z.name:="z";
# Factoring Algorithm
  b:=0;

  if LaurentDegree(he) >= LaurentDegree(ho) then b:=1; fi;

  if (ho=0*z^0 or ge=0*z^0) then
    L:=[];
    if ho=0*z^0 then Add(L,ZeroCoef(ge)*
         Polynomial(he.baseRing,[1/ ZeroCoef(go).coefficients[1]], -go.valuation));
    else Add(L,ho/he); fi;
    Add(L, he);
    Add(L, go);
    Add(L, b);
    return [Reversed(L)];
  fi;
  if (he=0*z^0 or go=0*z^0) then
    L:=[];
    if he=0*z^0 then Add(L,ZeroCoef(go)*
         Polynomial(he.baseRing,[1/ ZeroCoef(ge).coefficients[1]], -ge.valuation));
    else Add(L,he/ho); fi;
    Add(L, ho);
    Add(L, ge);
    Add(L, b-2);
    return [Reversed(L)];
  fi;
  L:=[];
    if b=0 then
      QR:=LaurentRemainder(ho,he);
      for factor in QR do
        hon := factor[2];
        hon := ZeroCoef(hon);
        gon := go - ge * factor[1];
        gon := ZeroCoef(gon);

        Lc:=LiftingScheme([[he,hon],[ge,gon]]);
        for scheme in Lc do Add(scheme,factor[1]); od;
        Append(L,Lc);
      od;

    else
      QR:=LaurentRemainder(he,ho);
      for factor in QR do
        hen := factor[2];
        hen := ZeroCoef(hen);
        gen := ge - go * factor[1];
        gen := ZeroCoef(gen);
        Lc:=LiftingScheme([[hen,ho],[gen,go]]);
        for scheme in Lc do Add(scheme,factor[1]); od;
        Append(L,Lc);
      od;

    fi;

return(L);

end;

Lifting := function(M)
local Lt, Ls, L, factor, p, normM, normDiff;

L:=LiftingScheme(M,[]);
Lt:=[];
Ls:=[];

for factor in L do
  Add(Ls, factor);
 if IsInt(factor) then  Add(Lt, Ls); Ls:=[];fi;
od;
return Lt;
end;

VerifyLiftingScheme:=function(P,L2)

local P, M, b, i, l,z,p, normM, normDiff;

  z:=Indeterminate(P[1].baseRing);
  z.name:="z";

#P:=[[P[1],P[2]],[P[3],P[4]]];
M:= [[1, 0],[0,1]];

L2:=Reversed(L2);
l:=Length(L2);
b:=L2[l];
for i in [1 .. l-3] do
 if b=-2 then
   M:= M * [[0*z^0,1*z^0 ], [1*z^0, L2[l-i-2]]]; b:=1;
 elif b=-1 then
   M:= M * [[L2[l-i-2],1*z^0 ], [1*z^0, 0*z^0]]; b:=0;
 elif b=0 then
   M:= M * [[1*z^0, L2[l-i-2]], [0*z^0, 1*z^0]]; b:=1;
 else
   M:= M * [[1*z^0, 0*z^0], [L2[l-i-2], 1*z^0]]; b:=0;
 fi;
od;
M:=[[L2[l-2], 0*z^0],[0*z^0, L2[l-1]]]*M;
#Print([[P[1],P[2]],[P[3],P[4]]]);
if Same(P[1][1].baseRing, Doubles) then
  normM:=Sum(M, l->Sum(l, p->(Sum(p.coefficients,i->i^2))^1/2))^1/2;
  normDiff:=Sum(M-P, l->Sum(l, p->(Sum(p.coefficients,i->i^2))^1/2))^1/2;
  Print("error: ",normDiff/normM,"\n");
  if (normDiff/normM > FloatString("1e-4")) then return false;
  else return true;
  fi;
else return[M,P,M=P];
fi;
end;

ArithmeticCostLS := function(L)
local step, mult, add, i;

mult:=0;
add:=0;
L:=Reversed(L);
for step in [1..Length(L)-3] do
  for i in L[step].coefficients do
     if not i = 0 then mult:=mult+1; add:=add+1;fi;
  od;
od;
mult:=mult+2;
return [add,mult,Length(L)-3];
end;

#F MatPoly := function(h,g)
#F   returns a matrix formed of two filters h(z) and g(z)
#F   also returns largest and the smallest degree of the
#F   coefficients in the matrix.
#F   Format: [<mat>, q, p]

MatPoly := function(h,g)

local hc, gc, hsmall, hlarge,
      gsmall, glarge, q, p, M;

    # Check the degrees of the filters
    hc := h.coefficients;
    gc := g.coefficients;
    hsmall := h.valuation;
    hlarge := Length(hc) + hsmall - 1;
    gsmall := g.valuation;
    glarge := Length(gc) + gsmall - 1;
    q := Minimum([hsmall,gsmall]);
    p := Maximum([hlarge,glarge]);

# Construct the 2 x l matrix of filter coefficients

    M :=
      [
       Concat(List([1..AbsInt(q-hsmall)],i->h.baseRing.zero),
               hc, List([1..p-hlarge],i->h.baseRing.zero)
             ),
       Concat(List([1..AbsInt(q-gsmall)],i->h.baseRing.zero),
               gc, List([1..p-glarge],i->h.baseRing.zero)
             )
      ];

    return ([M, hsmall, hlarge, gsmall, glarge]);
end;

Polyphase := function(p1,p2)

local  he, ho, ge, go, z, h, g;

if not (IsPolynomial(p1) and IsPolynomial(p1)) then
  Error("<p1> and <p2> must be polynomials");
elif not p1.baseRing.name = p2.baseRing.name then
  Error("Both polynomials have to be over the same field");
elif not IsBound(PolynomialRing(p1.baseRing).isEuclideanRing) then
  Error("Polymonials must be constructed over a field, not over a ring");
fi;

  z:=Indeterminate(p1.baseRing);
  z.name:="z";

        h := DownsampleTwo(ListPoly(p1));
        g := DownsampleTwo(ListPoly(p2));
        he := Polynomial(p1.baseRing, h[1][1], h[1][2]);
        ho := Polynomial(p1.baseRing, h[2][1], h[2][2]);
        ge := Polynomial(p1.baseRing, g[1][1], g[1][2]);
        go := Polynomial(p1.baseRing, g[2][1], g[2][2]);

# Find he(z) and ho(z)
#  Lo:=Sublist(p1.coefficients, Filtered([1..Length(p1.coefficients)],IsEvenInt));
#  Le:=Sublist(p1.coefficients, Filtered([1..Length(p1.coefficients)],IsOddInt));
#  if (p1.valuation mod 2 = 1) then L:=Le; Le:=Lo; Lo:=L;
#    ve := Int((p1.valuation + 1)/2); vo := ve;
#  else ve := Int(p1.valuation/2); vo := ve + 1;
#  fi;
#  he:=Polynomial(p1.baseRing, Le, ve);
#  ho:=Polynomial(p1.baseRing, Lo, vo);
#
# Find ge(z) and go(z)

#  Lo:=Sublist(p2.coefficients, Filtered([1..Length(p2.coefficients)],IsEvenInt));
#  Le:=Sublist(p2.coefficients, Filtered([1..Length(p2.coefficients)],IsOddInt));
#  if (p2.valuation mod 2 = 1) then L:=Le; Le:=Lo; Lo:=L;
#    ve := Int((p2.valuation + 1)/2); vo := ve;
#  else ve := Int(p2.valuation/2); vo := ve+1;
#  fi;
#  ge:=Polynomial(p2.baseRing, Le, ve);
#  go:=Polynomial(p2.baseRing, Lo, vo);

return [[he,ho],[ge,go]];
end;

# PolyPolyphaseMat:=function(M)
# Returns a list of 2 polynomials from a polyphase matrix

PolyPolyphaseMat:=function(M)

local he,ho,ge,go,h,g,z;

he:=M[1][1];
ho:=M[1][2];
ge:=M[2][1];
go:=M[2][2];
z:=Indeterminate(he.baseRing);
z.name:="z";

h:=Upsample(he)+z^(1)*Upsample(ho);
g:=Upsample(ge)+z^(1)*Upsample(go);

return([h,g]);
end;


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

#####################
# General Rule
#####################

PRF34_CT_Children := (N,k,DFTp,PRF3,PRFt) -> Map2(DivisorPairs(N),
    (m,n) -> When(IsEvenInt(n),
	[ DFTp(m, k), PRF3(n, k) ],
	[ DFTp(m, k), PRF3(n, k), PRFt(m, k) ])
);

PRF34_CT_Rule := (N,k,C,Conj,Tw) -> let(
    m:=Rows(C[1]), n:=Cols(C[2]), Nc:=Int((N+1)/2),
    nf:=Int(n/2), nc:=Int((n+1)/2), mf:=Int(m/2), mc:=Int((m+1)/2), j:=Ind(nf),

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

IPRF34_CT_Rule := (N,k,C,Conj,Tw) -> let(
    m:=Rows(C[1]), n:=Rows(C[2]), Nc:=Int((N+1)/2),
    nf:=Int(n/2), nc:=Int((n+1)/2), mf:=Int(m/2), mc:=Int((m+1)/2), j:=Ind(nf),

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

#####################
# Special Cases
#####################

RulesFor(PRDFT4, rec(
    PRDFT4_Base1 := BaseRule(PRDFT4, [1, @]),
    PRDFT4_Base2 := rec(
	isApplicable := P -> P[1]=2,
	rule := (P, C) -> F(2) * Mat(1/2*MatSPL(PDHT4(2,P[2])))  # DHT4(2) is a diagonal
    ),
    PRDFT4_CT := rec(
	isApplicable := P -> not IsPrime(P[1]),
	allChildren  := P -> PRF34_CT_Children(P[1], P[2], DFT2, PRDFT3, PRDFT4),
	rule := (P,C) -> let(N:=P[1], k:=P[2], m:=Rows(C[1]),
	    PRF34_CT_Rule(N, k, C, Diag(BHD(m,-1,1)), j->RC(Diag(fPrecompute(Twid(N,m,k,1/2,1/2,j))))))),
    PRDFT4_Trig := rec(
	isApplicable := P -> P[1] > 2 and IsEvenInt(P[1]) and P[2]=1,
	allChildren := P -> [[ DCT4(P[1]/2), DST4(P[1]/2) ]],
	rule := (P, C) -> let(n:=P[1]/2,
	    L(2*n, n) * DirectSum(C[1], C[2]) * SymSplit4(n)))
));

RulesFor(IPRDFT4, rec(
    IPRDFT4_Base1 := BaseRule(IPRDFT4, [1, @]),
    IPRDFT4_Base2 := rec(
	isApplicable := P -> P[1]=2,
	rule := (P, C) -> Mat(1/2*MatSPL(PDHT4(2,P[2]))) * F(2)  # DHT4(2) is a diagonal
    ),
    IPRDFT4_CT := rec(
	isApplicable := P -> not IsPrime(P[1]),
	allChildren  := P -> PRF34_CT_Children(P[1], P[2], DFT3, IPRDFT2, IPRDFT4),
	rule := (P,C) -> let(N:=P[1], k:=P[2], m:=Rows(C[1]),
	    IPRF34_CT_Rule(N, k, C, Diag(BHD(m,-1,1)), j->RC(Diag(fPrecompute(Twid(N,m,k,1/2,1/2,j)))))))
));

RulesFor(PRDFT3, rec(
    PRDFT3_Base1 := BaseRule(PRDFT3, [1, @]),
    PRDFT3_Base2 := rec(
	isApplicable := P -> P[1]=2,
	rule := (P, C) -> Cond(
	    P[2] mod 4 = 1, I(2),
	    P[2] mod 4 = 3, Diag(1,-1),
	    Error("Bad second parameter for PRDFT3(n,k), gcd(n,k)=1 does not hold"))
    ),
    PRDFT3_CT := rec(
	isApplicable := P -> not IsPrime(P[1]),
	allChildren  := P -> PRF34_CT_Children(P[1], P[2], DFT1, PRDFT3, PRDFT3),
	rule := (P,C) -> let(N:=P[1], k:=P[2], m:=Rows(C[1]),
	    PRF34_CT_Rule(N, k, C, Diag(BHD(m,1,-1)), j->RC(Diag(fPrecompute(Twid(N,m,k,1/2,0,j))))))),
    PRDFT3_Trig := rec(
	isApplicable := P -> P[1] > 2 and IsEvenInt(P[1]) and P[2]=1,
	allChildren := P -> [[ DCT3(P[1]/2), DST3(P[1]/2) ]],
	rule := (P, C) -> let(n:=P[1]/2,
	    L(2*n, n) * DirectSum(C[1], C[2]) * SymSplit3(n))),

    PRDFT3_OddToPRDFT1 := rec(
	isApplicable := P -> IsOddInt(P[1]),
	allChildren := P -> [[ PRDFT(P[1], P[2]) ]],
	rule := (P, C) -> rperm_ev(P[1]) * C[1] * pdiag(P[1], P[2])
    )
));

RulesFor(IPRDFT2, rec(
    IPRDFT2_Base1 := BaseRule(IPRDFT2, [1, @]),
    IPRDFT2_Base2 := rec(
	isApplicable := P -> P[1]=2,
	rule := (P, C) -> Cond(
	    P[2] mod 4 = 1, Diag(2,-2),
	    P[2] mod 4 = 3, Diag(2,2),
	    Error("Bad second parameter for IPRDFT2(n,k), gcd(n,k)=1 does not hold"))
    ),
    IPRDFT2_CT := rec(
	isApplicable := P -> not IsPrime(P[1]),
	allChildren  := P -> PRF34_CT_Children(P[1], P[2], DFT1, IPRDFT2, IPRDFT2),
	rule := (P,C) -> let(N:=P[1], k:=P[2], m:=Rows(C[1]),
	    IPRF34_CT_Rule(N, k, C, Diag(BHD(m,1,-1)), j->RC(Diag(fPrecompute(Twid(N,m,k,1/2,0,j)))))))
));

RulesFor(PDHT4, rec(
    PDHT4_Base2 := BaseRule(PDHT4, [2, @]),
    PDHT4_CT := rec(
	isApplicable := P -> not IsPrime(P[1]),
	allChildren  := P -> PRF34_CT_Children(P[1], P[2], DFT2, PDHT3, PDHT4),
	rule := (P,C) -> let(N:=P[1], k:=P[2], m:=Rows(C[1]),
	    PRF34_CT_Rule(N, k, C, TopHalf(m, -J(2)),
		          j -> RCDiag(RCData(fPrecompute(Twid(N,m,-k,1/2,1/2,j))), -J(2))))),
    PDHT4_Trig := rec(
	isApplicable := P -> P[1] > 2 and IsEvenInt(P[1]) and P[2]=1,
	allChildren := P -> [[ DCT4(P[1]/2), DST4(P[1]/2) ]],
	rule := (P, C) -> let(n:=P[1]/2,
	    Tensor(I(n), F(2)) * L(2*n,n) * DirectSum(C[1], C[2]) * SymSplit4(n)))
));

RulesFor(PDHT3, rec(
    PDHT3_Base2 := rec(
	isApplicable := P -> P[1]=2,
	rule := (P, C) -> Cond(
	    P[2] mod 4 = 1, F(2),
	    P[2] mod 4 = 3, J(2)*F(2),
	    Error("Bad second parameter for PRDFT3(n,k), gcd(n,k)=1 does not hold"))
    ),

    PDHT3_CT := rec(
	isApplicable := P -> not IsPrime(P[1]),
	allChildren  := P -> PRF34_CT_Children(P[1], P[2], DFT1, PDHT3, PDHT3),
	rule := (P,C) -> let(N:=P[1], k:=P[2], m:=Rows(C[1]),
	    PRF34_CT_Rule(N, k, C, TopHalf(m, J(2)),
		          j -> RCDiag(RCData(fPrecompute(Twid(N,m,-k,1/2,0,j))), J(2))))),
    PDHT3_Trig := rec(
	isApplicable := P -> P[1] > 2 and IsEvenInt(P[1]) and P[2]=1,
	allChildren := P -> [[ DCT3(P[1]/2), DST3(P[1]/2) ]],
	rule := (P, C) -> let(n:=P[1]/2,
	    Tensor(I(n), F(2)) * L(2*n,n) * DirectSum(C[1], C[2]) * SymSplit3(n)))

));


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

RulesFor(DCT4, rec(

    #F DCT4_Base2: DCT4_2 = (1,2) * R_13/8
    #F
    DCT4_Base2 := rec(
	info             := "DCT4_2 -> R_13/8",
	forTransposition := false,
	isApplicable     := P -> P[1] = 2,
	rule := (P, C) -> J(2) * Rot(13/8)
    ),

    #F DCT4_Base3: (base case for size 3)
    #F
    #F   DCT4_2 = (2,3) * (F_2 dirsum 1) * (a dirsum M) * (F_2 dirsum 1) * (2,3)
    #F
    #F derived by hand starting with AREP's decomposition by mon-mon symmetry.
    #F
    DCT4_Base3 := rec (
	info             := "DCT4_3 -> F_2, M, F_2",
	forTransposition := false,
	isApplicable     := P -> P[1] = 3,
	rule := (P, C) ->
	    Perm((2,3), 3) *
	    DirectSum(F(2), I(1)) *
	    DirectSum(Diag(Sqrt(3/8)), Sqrt(1/2)*Mat([[1/2, 1], [1, -1]])) *
	    DirectSum(F(2), I(1)) *
	    Perm((2,3), 3)
    ),

    #F DCT4_DCT2: DCT4_n = sums * DCT2_n * diag
    #F
    #F   inverse - transpose of RuleDCT4_2
    #F
    DCT4_DCT2 := rec (
	info             := "DCT4_n --> DCT2'_n",
	isApplicable     := P -> P[1] > 2,
	allChildren := P -> [[ DCT2(P[1]) ]],
	rule := (P, C) ->
	    sums1(P[1]) *
	    C[1] *
	    Diag(List([0..P[1]-1], i -> 1/(2*CosPi((2*i+1)/(4*P[1])))))
    ),

    #F DCT4_DCT2t: 1985, DCT4_n = sums * DCT2_n * diag
    #F
    #F   Chan:
    #F     Direct Methods for computing discrete sinusoidal transforms
    #F     IEE Proceedings, Vol. 137, 1990, pp. 433--442
    #F
    # switched off since critical path too long (sums6)
    # also there seems to be one mult too much
    DCT4_DCT2t := rec (
	info             := "DCT4_n --> DCT2'_n",
	switch           := false,
	isApplicable     := P -> P[1] > 2,
	allChildren      := P -> [[ DCT2(P[1]) ]],
	rule := ( P, C ) ->
	    sums6(P[1]) *
	    C[1] *
	    Diag(List([0..P[1] - 1], i -> 2 * CosPi((2*i + 1)/(4*P[1]))))
    ),

    #F DCT4_DCT2andDST2: 1985
    #F
    #F   DCT4_n = blocks * perm * (DCT2_n/2 dirsum DST2_n/2) * rotations
    #F
    #F   Wang: (transposed)
    #F     On Computing the Discrete Fourier ans Cosine Transforms,
    #F     IEEE Trans. on Signal Proc., 1985, pp. 1341--1344
    #F
    DCT4_DCT2andDST2 := rec (
	info             := "DCT4_n --> DCT2'_n/2, DST2'_n/2",
	isApplicable     := P -> IsInt(P[1]) and P[1] > 2 and P[1] mod 2 = 0,
	allChildren := P -> [[ DCT2(P[1]/2), DST2(P[1]/2) ]],
	rule := (P, C) ->
	    DirectSum(I(1),
		      Tensor(I(P[1]/2-1), F(2)*J(2)),
		      I(1)) *
	    DirectSum(C[1], C[2]) ^ L(P[1], 2) *
	    DirectSum(List([0..P[1]/2-1], i -> J(2)*Rot(2-(2*P[1]-2*i-1)/(4*P[1])))) *
	    LIJ(P[1])

	  # LIJ(P[1]) *
	  # DirectSum(C[1], C[2] ^ J(P[1]/2)) *
	  # DirectSum(List([0..P[1]/2-1], i -> J(2)*Rot(2-(2*P[1]-2*i-1)/(4*P[1]))))
	  #    ^ LIJ(P[1])
    ),

    #F DCT4_DST4andDST2: 1988
    #F
    #F   DCT4_n = diag * sums * perm * (DST4_n/2 dirsum DST2_n/2) * sign *
    #F            (DFT_2 tensor I_n/2) * diag * perm
    #F
    #F   Rao/Yip:
    #F     The Decimation-in-Frequency Algorithms for a family of
    #F     Discrete Sine and Cosine Algorithms.
    #F     Circuits, Systems, and Signal Processing, 1988, pp. 3--19
    #F
    DCT4_DST4andDST2 := rec (
	info             := "DCT4_n --> DST4_n/2, DST2_n/2",
	switch           := false,
	isApplicable     := P -> IsInt(P[1]) and P[1] > 2 and P[1] mod 2 = 0,

	allChildren := P -> [[ DST4(P[1]/2), DST2(P[1]/2) ]],

	rule := (P, C) ->
	    Diag(List([0..P[1] - 1], i -> (-1)^i)) *
	    sums1(P[1]).transpose() *
	    L(P[1], P[1]/2) *
	    DirectSum(C[1], C[2] * (-1)) *
	    Tensor(F(2), I(P[1]/2)) *
	    Diag(Concat(List([1..P[1]/2], i -> 1/(2*SinPi((2*i - 1)/(4*P[1])))),
		        List([1..P[1]/2], i -> 1/(2*CosPi((2*i - 1)/(4*P[1])))))) *
	    IJ(P[1], P[1]/2)
    ),

    #F DCT4_Iterative: 1985, DCT4_n = iterative
    #F
    #F   Chen/Smith/Fralick:
    #F     A Fast Computational Algorithm for the Discrete Cosine Transform,
    #F     IEEE Trans. on Comm., 1977, pp. 1004--1009
    #F   corrected in:
    #F   Wang:
    #F     Reconsideration of --above--, IEEE Trans. on Comm., 1983, pp. 121--123
    #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
    DCT4_Iterative := rec (
	info             := "DCT4_n iterative",
	isApplicable     := P -> P[1] > 2 and Is2Power(P[1]),
	rule := (P, C) ->
	    LIJ(P[1]) * L(P[1], 2) *
	    DirectSum(List([1..P[1]/2], i -> Rot(1/2-(4*i-3)/(4*P[1])) * J(2))) *

	    Compose(List([1..Log2Int(P[1])-1], j -> let(jj := 2^j,
		    Tensor(I(jj/2), F(2), I(P[1]/jj)) *
		    Tensor(I(jj/2),
			DirectSum(I(P[1]/jj), List([1..P[1]/jj/2],
			     i -> Rot(1/2-(4*i-3)/(2*P[1]/jj)) * J(2))))))) *
	    perm6(P[1])
    )
));


#
# Read("~/Workspace/groupsSB/epi/G2/generic.UU.gi");
#

type:="G";
rank:=2;
nr_pos_roots:=6;

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

handleUaUbUc:=function()
	local rels, vals,i,v;
	# UaUb=Uc = U(a1+b1,a2+b2,a3+b3+a2*b1)
	rels:=Set(Concatenation(Ua*Ub-Uc));

	vals:=[];
	Append(vals,[[[vars[22]],[vars[2]+vars[12]]]]);
	Append(vals,[[[vars[21]],[vars[1]+vars[11]]]]);
	Append(vals,[[[vars[23]],[vars[3]+vars[13]+vars[2]*vars[11]]]]);
#a_{2}^2*b_{1}+2*a_{2}*b_{1}*b_{2}-2*a_{3}*b_{2}-a_{4}-b_{4}
#-a_{2}*b_{1}^2-2*a_{3}*b_{1}-a_{4}-b_{4}+c_{4},
	Append(vals,[[[vars[24]],[vars[2]*vars[11]^2+2*vars[3]*vars[11]+vars[4]+vars[14]]]]);
#a_{2}*b_{1}^3+3*a_{3}*b_{1}^2+3*a_{4}*b_{1}+a_{5}+b_{5}-c_{5}
	Append(vals,[[[vars[25]],[vars[2]*vars[11]^3+3*vars[3]*vars[11]^2+3*vars[4]*vars[11]+vars[5]+vars[15]]]]);
#a_{2}^2*b_{1}^3
#-a_{2}*b_{1}^3*b_{2}
#+3*a_{2}*a_{3}*b_{1}^2
#+3*a_{2}*b_{1}^2*b_{3}
#-3*a_{3}*b_{1}^2*b_{2}

#+3*a_{3}^2*b_{1}
#+6*a_{3}*b_{1}*b_{3}
#-3*a_{4}*b_{1}*b_{2}
#+3*a_{4}*b_{3}
#-a_{5}*b_{2}
#-a_{6}-b_{6}+c_{6}
	Append(vals,[[[vars[26]],[
-vars[2]^2*vars[11]^3
+vars[2]*vars[11]^3*vars[12]
-3*vars[2]*vars[3]*vars[11]^2
-3*vars[2]*vars[11]^2*vars[13]
+3*vars[3]*vars[11]^2*vars[12]
-3*vars[3]^2*vars[11]
-6*vars[3]*vars[11]*vars[13]
+3*vars[4]*vars[11]*vars[12]
-3*vars[4]*vars[13]
+vars[5]*vars[12]
+vars[6]+vars[16]]]]);

	for i in [1..Length(rels)] do
		for v in vals do
			Print(rels[i],"\n");
			rels[i]:=One(APR)*Value(rels[i],v[1],v[2]);
		od;
	od;
	return [vals,rels];
end;


#############################################################################
##
##  Cone.gi             JConvex package
##                      Martin Bies
##
##  Copyright 2021      University of Pennsylvania
##
##  A Gap package to do convex geometry by Polymake
##
## Chapter: Cones
##
#############################################################################

InstallMethod( ExternalPolymakeCone,
               [ IsCone ],
   function( cone )

    if IsBound( cone!.input_rays ) and Length( cone!.input_rays ) = 1 and IsZero( cone!.input_rays ) then
        return Polymake_ConeByGenerators( cone!.input_rays[ 1 ] );
    fi;

    if IsBound( cone!.input_rays ) then
        return Polymake_ConeByGenerators( cone!.input_rays );
    fi;

    if IsBound( cone!.input_equalities ) then
        return Polymake_ConeFromInequalities( cone!.input_inequalities, cone!.input_equalities );
    fi;

    # otherwise our fallback is cone from inequalities
    return Polymake_ConeFromInequalities( cone!.input_inequalities );

end );

InstallMethod( RayGenerators,
               [ IsCone ],
    function( cone )
    local rays, lin;

    rays := Polymake_Rays( ExternalPolymakeCone( cone ) );
    lin := Polymake_Lineality( ExternalPolymakeCone( cone ) );
    return Set( Concatenation( rays, lin, (-1) * lin ) );

end );

InstallMethod( IsPointed,
               [ IsCone ],
    function( cone )

    return Polymake_IsPointed( ExternalPolymakeCone( cone ) );

end );

InstallMethod( Dimension,
               [ IsCone ],
    function( cone )

    return Polymake_Dimension( ExternalPolymakeCone( cone ) );

end );

InstallMethod( DefiningInequalities,
               [ IsCone ],
  function( cone )
    local ineqs, eqs;

    ineqs := Polymake_Inequalities( ExternalPolymakeCone( cone ) );
    eqs := Polymake_Equalities( ExternalPolymakeCone( cone ) );
    return Set( Concatenation( eqs, (-1) * eqs, ineqs ) );

end );

InstallMethod( LinealitySpaceGenerators,
               [ IsCone ],
  function( cone )

    return Set( Polymake_Lineality( ExternalPolymakeCone( cone ) ) );

end );

InstallMethod( RaysInFacets,
               [ IsCone ],
    function( cone )

    return Polymake_RaysInFacets( ExternalPolymakeCone( cone ) );

end );

InstallMethod( RaysInFaces,
               " for cones",
               [ IsCone ],

  function( cone )

    return Set( Polymake_RaysInFaces( ExternalPolymakeCone( cone ) ) );

end );

InstallMethod( IntersectionOfCones,
               "for homalg cones",
               [ IsCone, IsCone ],
  function( cone1, cone2 )
    local ext_cone, ineqs, eqs, cone;

    if not Rank( ContainingGrid( cone1 ) ) = Rank( ContainingGrid( cone2 ) ) then
        Error( "cones are not from the same grid" );
    fi;

    # compute the intersection cone in Polymake
    ext_cone := Polymake_Intersection( ExternalPolymakeCone( cone1 ), ExternalPolymakeCone( cone2 ) );
    ineqs := ext_cone!.inequalities;
    eqs := ext_cone!.equalities;
    cone := ConeByEqualitiesAndInequalities( eqs, ineqs );
    SetContainingGrid( cone, ContainingGrid( cone1 ) );

    # and return it
    return cone;

end );


#############################################################################
##
#W  rws.gi                  automgrp package                   Yevgen Muntyan
#W                                                             Dmytro Savchuk
##
#Y  Copyright (C) 2003 - 2018 Yevgen Muntyan, Dmytro Savchuk
##

DeclareGlobalFunction("__AG_FindRelators");

# It's not an IsRewritingSytem object
DeclareCategory("IsAGRewritingSystem", IsObject);

DeclareRepresentation("IsAGRewritingSystemRep",
                      IsComponentObjectRep,
                      ["rels",    # list of relators, they are words in the family's free group
                       "kb",      # Knuth-Bendix rewriting system
                       "fam",     # the automata family
                       "fpg_fam", # family of the elements from FP group <freegroup / rels>
                       "fpm_fam", # family of the elements of FP monoid obtained from the above group
                       "mhom",    # isomorphism from the FP group to the FP monoid
                      ]);

__AG_CreateRewritingSystem := function(fam, rels)
  local grp, fr_grp, fp_grp, fp_mon, fmon,
        ord, m_gens, rws, rws_data;

  rws_data := rec(fam := fam);

  if rels = fail then
    rels := __AG_FindRelators(fam, AG_Globals.max_rws_relator_len);
  fi;
  rws_data.rels := Difference(rels, [Word(One(fam))]);

  if IsAutomFamily(fam) then
    grp := GroupOfAutomFamily(fam);
  else
    grp := GroupOfSelfSimFamily(fam);
  fi;

  fr_grp := UnderlyingFreeGroup(grp);
  fp_grp := fr_grp / rels;
  rws_data.mhom := IsomorphismFpMonoid(fp_grp);
  fp_mon := Image(rws_data.mhom);
  fmon := FreeMonoidOfFpMonoid(fp_mon);

  rws_data.fpg_fam := FamilyObj(One(fp_grp));
  rws_data.fpm_fam := FamilyObj(One(fp_mon));

  m_gens := GeneratorsOfMonoid(fmon);
#  Print("mgens1=",m_gens,"\n");
#  m_gens := Permuted(m_gens, Product(List([1..Length(m_gens)/2], k->(2*k-1, 2*k))));
#  Print("mgens2=",m_gens,"\n");
  ord := ShortLexOrdering(FamilyObj(One(fmon)), m_gens);

  rws_data.kb := KnuthBendixRewritingSystem(fp_mon, ord);
  MakeConfluent(rws_data.kb);

  rws := Objectify(NewType(NewFamily("AGRewritingSystem"),
                           IsAGRewritingSystem and IsAGRewritingSystemRep),
                   rws_data);

  return rws;
end;

__AG_ReducedForm := function(rws, word)
  local reduced, word_mon;
  word_mon := ImageElm(rws!.mhom, ElementOfFpGroup(rws!.fpg_fam, word));
  reduced := ReducedForm(rws!.kb, UnderlyingElement(word_mon));
  word_mon := ElementOfFpMonoid(rws!.fpm_fam, reduced);
  return UnderlyingElement(PreImagesRepresentative(rws!.mhom, word_mon));
end;

InstallGlobalFunction(__AG_FindRelators,
function(fam, max_len)
  local fr_grp, w, elm, rels;

  if fam!.rws = fail then
    rels := [];
  else
    rels := List(fam!.rws!.rels);
  fi;

  fr_grp := UnderlyingFreeGroup(fam);

  # XXX FindRelations?
  for w in fr_grp do
    if Length(w) > max_len then
      break;
    fi;
    if IsAutomFamily(fam) then
      elm := Autom(w, fam);
    else
      elm := SelfSim(w, fam);
    fi;
    if IsOne(elm) then
      Add(rels, w);
    fi;
  od;

  return Difference(rels, [One(fr_grp)]);
end);

__AG_UpdateRewritingSystem := function(arg)
  local fam, max_len, new_rels;

  fam := arg[1];
  if Length(arg) > 1 then
    max_len := arg[2];
  else
    max_len := AG_Globals.max_rws_relator_len;
  fi;

  new_rels := __AG_FindRelators(fam, max_len);
  if fam!.rws = fail or new_rels <> fam!.rws!.rels then
    fam!.rws := __AG_CreateRewritingSystem(fam, new_rels);
  fi;

  return fail;
end;

__AG_UseRewritingSystem := function(fam, use)
  if fam!.use_rws <> use then
    if use then
      if fam!.rws = fail then
        fam!.rws := __AG_CreateRewritingSystem(fam, fail);
      fi;
    fi;
    fam!.use_rws := use;
  fi;
end;

__AG_RewritingSystem := function(fam)
  return fam!.rws;
end;

__AG_AddRelators := function(fam, rels)
  local old_rels;
  if fam!.rws = fail then
    old_rels := [];
  else
    old_rels := fam!.rws!.rels;
  fi;
  rels := Difference(Union(old_rels, rels), [One(UnderlyingFreeGroup(fam))]);
  if rels <> old_rels then
    fam!.rws := __AG_CreateRewritingSystem(fam, rels);
  fi;
end;

InstallMethod(AG_ReducedForm, [IsAGRewritingSystem, IsAssocWord],
function(rws, w)
  return __AG_ReducedForm(rws, w);
end);

InstallMethod(AG_ReducedForm, [IsAGRewritingSystem, IsList and IsAssocWordCollection],
function(rws, words)
  return Difference(List(words, w -> __AG_ReducedForm(rws, w)), [One(words[1])]);
end);

__AG_ReducedFormOfGroup := function(group, fam, construct)
  local gens, rws;

  if not fam!.use_rws then
    return group;
  fi;

  gens := GeneratorsOfGroup(group);
  gens := List(AG_ReducedForm(fam!.rws, List(gens, a -> Word(a))), w -> construct(w, fam));
  gens := Difference(gens, [One(group)]);
  if IsEmpty(gens) then
    return Group(One(group));
  else
    return GroupWithGenerators(gens);
  fi;
end;

InstallMethod(AG_ReducedForm, [IsAutomGroup],
function(group)
  return __AG_ReducedFormOfGroup(group, UnderlyingAutomFamily(group), Autom);
end);

InstallMethod(AG_ReducedForm, [IsSelfSimGroup],
function(group)
  return __AG_ReducedFormOfGroup(group, UnderlyingSelfSimFamily(group), SelfSim);
end);

__AG_ReducedFormOfElm := function(g, construct)
  local fam;

  fam := FamilyObj(g);

  if not fam!.use_rws then
    return g;
  else
    return construct(AG_ReducedForm(fam!.rws, Word(g)), fam);
  fi;
end;

InstallMethod(AG_ReducedForm, [IsAutom],
function(g)
  return __AG_ReducedFormOfElm(g, Autom);
end);

InstallMethod(AG_ReducedForm, [IsSelfSim],
function(g)
  return __AG_ReducedFormOfElm(g, SelfSim);
end);

InstallMethod(AG_UseRewritingSystem, [IsObject],
function(obj)
  AG_UseRewritingSystem(obj, true);
end);

InstallMethod(AG_UseRewritingSystem, [IsAutomFamily, IsBool],
function(fam, use)
  __AG_UseRewritingSystem(fam, use);
end);

InstallMethod(AG_UseRewritingSystem, [IsAutomGroup, IsBool],
function(grp, use)
  AG_UseRewritingSystem(UnderlyingAutomFamily(grp), use);
end);

InstallMethod(AG_UseRewritingSystem, [IsSelfSimFamily, IsBool],
function(fam, use)
  __AG_UseRewritingSystem(fam, use);
end);

InstallMethod(AG_UseRewritingSystem, [IsSelfSimGroup, IsBool],
function(grp, use)
  AG_UseRewritingSystem(UnderlyingSelfSimFamily(grp), use);
end);

InstallMethod(AG_UpdateRewritingSystem, [IsObject],
function(obj)
  AG_UpdateRewritingSystem(obj, AG_Globals.max_rws_relator_len);
end);

InstallMethod(AG_UpdateRewritingSystem, [IsAutomFamily, IsPosInt],
function(fam, max_len)
  __AG_UpdateRewritingSystem(fam, max_len);
end);

InstallMethod(AG_UpdateRewritingSystem, [IsAutomGroup, IsPosInt],
function(grp, max_len)
  AG_UpdateRewritingSystem(UnderlyingAutomFamily(grp), max_len);
end);

InstallMethod(AG_UpdateRewritingSystem, [IsSelfSimFamily, IsPosInt],
function(fam, max_len)
  __AG_UpdateRewritingSystem(fam, max_len);
end);

InstallMethod(AG_UpdateRewritingSystem, [IsSelfSimGroup, IsPosInt],
function(grp, max_len)
  AG_UpdateRewritingSystem(UnderlyingSelfSimFamily(grp), max_len);
end);

InstallMethod(AG_RewritingSystem, [IsAutomFamily],
function(fam)
  return __AG_RewritingSystem(fam);
end);

InstallMethod(AG_RewritingSystem, [IsAutomGroup],
function(grp)
  return AG_RewritingSystem(UnderlyingAutomFamily(grp));
end);

InstallMethod(AG_RewritingSystem, [IsSelfSimFamily],
function(fam)
  return __AG_RewritingSystem(fam);
end);

InstallMethod(AG_RewritingSystem, [IsSelfSimGroup],
function(grp)
  return AG_RewritingSystem(UnderlyingSelfSimFamily(grp));
end);

InstallMethod(AG_RewritingSystemRules, [IsObject],
function(obj)
  return Rules(AG_RewritingSystem(obj)!.kb);
end);

InstallMethod(AG_AddRelators, [IsAutomGroup, IsList and IsAssocWordCollection],
function(obj, rels) __AG_AddRelators(UnderlyingAutomFamily(obj), rels); end);

InstallMethod(AG_AddRelators, [IsAutomFamily, IsList and IsAssocWordCollection],
function(obj, rels) __AG_AddRelators(obj, rels); end);

InstallMethod(AG_AddRelators, [IsSelfSimGroup, IsList and IsAssocWordCollection],
function(obj, rels) __AG_AddRelators(UnderlyingSelfSimFamily(obj), rels); end);

InstallMethod(AG_AddRelators, [IsSelfSimFamily, IsList and IsAssocWordCollection],
function(obj, rels) __AG_AddRelators(obj, rels); end);

InstallMethod(AG_AddRelators, [IsObject, IsList and IsAutomCollection],
function(obj, list)
  AG_AddRelators(obj, List(list, g -> Word(g)));
end);

InstallMethod(AG_AddRelators, [IsObject, IsList and IsSelfSimCollection],
function(obj, list)
  AG_AddRelators(obj, List(list, g -> Word(g)));
end);


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

RulesFor(DFT, rec(
    DFT_CT_Inplace := rec(
	info          := "DFT(mn,k) -> DFT(m, k%m), DFT(n, k%n)",
	maxCodeletSize := 16,

	isApplicable := (self, P) >> P[1] > 2 and not IsPrime(P[1]),

	allChildren  := (self, P) >> Map2(
	    Filtered(DivisorPairs(P[1]), d -> d[1] <= self.maxCodeletSize),
	    (m,n) -> [
		DFT(m, P[2] mod m),
		DFT(n, P[2] mod n) ]),

	rule := (self,P,C) >> let(mn := P[1], m := Rows(C[1]), n := Rows(C[2]),
            di := fPrecompute(Tw1(mn, n, P[2])),

	    When(mn > self.maxCodeletSize, # why BB?
		Inplace(Tensor(C[1], I(n)) * Diag(di)),
		        Tensor(C[1], I(n)) * Diag(di)) *
	    Tensor(I(m), C[2]) *
	    L(mn, m))
    ),

    DFT_SplitRadix_Inplace := rec(
	info             := "DFT_n -> DFT_n/2, DFT_n/4, DFT_n/4",
	forTransposition := true,
	maxSize := 64,

	isApplicable := (self, P) >> let(N := P[1],
	    N >= 8 and N mod 4 = 0 and N <= self.maxSize),

	allChildren := P -> let(N := P[1], w := P[2],
	    [[ DFT(N/2, w), DFT(N/4, w) ]]),

	rule := (P, C) -> let(N := P[1], w := P[2],
	    Inplace(Tensor(F(2), I(N/2))) *
	    DirectSum(
		C[1],
		Inplace(BB(
			Tensor(Diag(1, E(4)^w) * F(2), I(N/4)) *
			Diag(Concat(List([0..N/4-1], i->E(N)^(w*i))),
			            List([0..N/4-1], i->E(N)^(3*w*i))))) *
	        Tensor(I(2), C[2])*L(N/2,2)
	    ) *
	    L(N, 2))
    ),

));


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

TrPRDFT1 := arg -> let(x:=ApplyFunc(PRDFT1, arg).transpose(), Chain(PrintLine(x, " ", x.dimensions), x));
TrPRDFT2 := arg -> ApplyFunc(PRDFT2, arg).transpose();
TrPRDFT3 := arg -> ApplyFunc(PRDFT3, arg).transpose();
TrPRDFT4 := arg -> ApplyFunc(PRDFT4, arg).transpose();

DFTSymmetries := rec(    #n-even, #n-odd
    DFT  := [
	[Real ,                 [CE0_R2Cpx(W_RFT, 1), [PRDFT1,   PRDFT1], 1]],
	[CE0_R2Cpx(W_URFTT, 1), [Real,                [TrPRDFT1, TrPRDFT1], 1]],
	[Even0, [Even0, [DCT1, DCT5], 1]],
	[Odd00, [Odd00, [DST1, DST5], E(4)]]  # *j
    ],

    DFT2 := [
	[Real ,                 [CO0_R2Cpx(W_RFT, -E(4)), [PRDFT2,   PRDFT2], 1]],
	[CE1_R2Cpx(W_URFTT, 1), [Real,                    [TrPRDFT3, TrPRDFT3], 1]],
	[Even1, [Odd0,   [DCT2, DCT6], 1]],
	[Odd1 , [Even00, [DST2, DST6], E(4)]]
    ],

    DFT3 := [
	[Real ,                    [CE1_R2Cpx(W_RFT, 1), [PRDFT3,   PRDFT3], 1]],
	[CO1_R2Cpx(W_URFTT, E(4)), [Real,                [TrPRDFT2, TrPRDFT2], 1]],
	[Real , [CE1_R2Cpx(W_RFT, 1), [PRDFT3, PRDFT3], 1]],
	[Odd0 , [Even1, [DCT3, DCT7], 1]],
	[Even00,[Odd1,  [DST3, DST7], E(4)]]
    ],

    DFT4 := [
	[Real ,                    [CO1_R2Cpx(W_RFT, -E(4)), [PRDFT4,   PRDFT4], 1]],
	[CO1_R2Cpx(W_URFTT, E(4)), [Real,                    [TrPRDFT4, TrPRDFT4], 1]],
	[Odd1 , [Odd1,  [DCT4, DCT8], 1]],
	[Even1, [Even1, [DST4, DST8], E(4)]]
    ]
);

_dftSym := function(nt, sym)
    local pos, entry, dftsym;
    if not IsBound(DFTSymmetries.(nt.name))
	then return false; fi;

    dftsym := DFTSymmetries.(nt.name);
    pos := PositionProperty(dftsym, x->x[1]=sym);
    if pos = false then
	return false; fi;

    entry := dftsym[pos][2];
    if IsEvenInt(Rows(nt)) then return [entry[1], entry[2][1], entry[3]];
    else                        return [entry[1], entry[2][2], entry[3]];
    fi;
end;

# let Q := JDFTp_Reconstruct(n), p = 1..4 (DFT type)
# Q is defined to be the matrix that satisfies
#    Q * DFTp(n) = DFTp(n) * J(n)
#    Q = J(n) ^ (DFTp(n)^-1)
#
#spiral> PrintMat( MatSPL(J(8))^(MatSPL(DFT(8))^-1) );

Class(JRecTwid1, DiagFunc, rec(
    def := n -> rec(size:=n),
    range := self >> TComplex,
    lambda := self >> let(n:=self.params[1], i:=Ind(n),
	Lambda(i, omega(n, -i)))
));

Class(JRecTwid3, DiagFunc, rec(
    def := n -> rec(size:=n),
    range := self >> TComplex,
    lambda := self >> let(n:=self.params[1], i:=Ind(n),
	Lambda(i, omega(2*n, (-2*i + n - 1))))
));

mk_InvDFT_Reconstruct := dft -> (let(n:=dft.params[1], Cond(
    ObjId(dft) = DFT1, DirectSum(I(1), J(n-1)),
    ObjId(dft) = DFT2, DirectSum(I(1), -J(n-1)),
    ObjId(dft) = DFT3, J(n),
    ObjId(dft) = DFT4, -J(n),
    Error("<dft> must be a non-terminal DFT1, DFT2, DFT3, or DFT4"))));

mk_JInvDFT_Reconstruct := dft -> (let(n:=dft.params[1], Cond(
    ObjId(dft) = DFT1, Diag(JRecTwid1(n)),
    ObjId(dft) = DFT2, I(n),
    ObjId(dft) = DFT3, Diag(JRecTwid3(n)),
    ObjId(dft) = DFT4, -I(n),
    Error("<dft> must be a non-terminal DFT1, DFT2, DFT3, or DFT4"))));

mk_JDFT_Reconstruct := dft -> (let(n:=dft.params[1], Cond(
    ObjId(dft) = DFT1, Diag(JRecTwid1(n)) * mk_InvDFT_Reconstruct(dft),
    ObjId(dft) = DFT2, mk_InvDFT_Reconstruct(dft),
    ObjId(dft) = DFT3, Diag(JRecTwid3(n)) * mk_InvDFT_Reconstruct(dft),
    ObjId(dft) = DFT4, -mk_InvDFT_Reconstruct(dft),
    Error("<dft> must be a non-terminal DFT1, DFT2, DFT3, or DFT4"))));

verify_JInvDFT_Reconstruct := dft -> let(T:=ObjId(dft), n:=dft.params[1], k:=dft.params[2],
    MatSPL(dft * J(n)) - MatSPL(mk_JInvDFT_Reconstruct(dft) * T(n, -k))
);
verify_JDFT_Reconstruct := dft -> let(T:=ObjId(dft), n:=dft.params[1], k:=dft.params[2],
    MatSPL(dft * J(n)) - MatSPL(mk_JDFT_Reconstruct(dft) * dft)
);

Class(RulesDFTSymmetry, RuleSet);
RewriteRules(RulesDFTSymmetry, rec(

     DFT1_upgrade := ARule(Compose, [@(1,DFT), [@(2,GathExtend), @, @(3).cond(e->e in [Even1, Odd1])]],
	 e -> let(n := Cols(@(1).val), [ Diag(Twid(n,n,-1,1/2,0,0)), DFT2(n), @(2).val])),

     DFT3_upgrade := ARule(Compose, [@(1,DFT3), [@(2,GathExtend), @, @(3).cond(e->e in [Even1, Odd1])]],
	 e -> let(n := Cols(@(1).val), [ Diag(Twid(n,n,-1,1/2,1/2,0)), DFT4(n), @(2).val])),

     DFT1_upgradeCE := ARule(Compose, [@(1,DFT), [@(2,GathExtend), @, @(3, [CE1_R2Cpx, CO1_R2Cpx])]],
	 e -> let(n := Cols(@(1).val), [ Diag(Twid(n,n,-1,1/2,0,0)), DFT2(n), @(2).val])),

     DFT3_upgradeCE := ARule(Compose, [@(1,DFT3), [@(2,GathExtend), @, @(3, [CE1_R2Cpx, CO1_R2Cpx])]],
	 e -> let(n := Cols(@(1).val), [ Diag(Twid(n,n,-1,1/2,1/2,0)), DFT4(n), @(2).val])),

     DFT_EO_Symmetry := ARule(Compose,
	 [ @(1,[DFT,DFT2,DFT3,DFT4]),
	   [ @(2, GathExtend), @, @(3).cond(e->_dftSym(@(1).val, e)<>false)] ],
	 e ->
	     let(sym := _dftSym(@(1).val, @(3).val),
		 out := sym[1],
		 transf := sym[2],
		 n := When(@(3).val.tsize = "cols", Cols(@(2).val), Rows(@(2).val)),
		 scale := sym[3],
		 [PushL(GathExtendU(Rows(@(1).val), out)), scale*transf(n)])),

     L_Real := ARule(Compose, [[L, @(1), @(2)], [@(3,GathExtend), @, Real]],
	 e -> let(N:=@(1).val, k:=@(2).val,
	     [ GathExtend(N, Real), L(N, k) ])),

     L_Conj0_R2Cpx := ARule(Compose, [[L, @(1), @(2)], [@(3,GathExtend), @, @(4, [CE0_R2Cpx, CO0_R2Cpx])]],
	 e -> let(N:=@(1).val, k:=@(2).val, m:=N/k, nn:=Cols(@(3).val)/2,
	          sym  := @(4).val,
	          sym1 := When(ObjId(sym)=CE0_R2Cpx, CE1_R2Cpx(sym.w, sym.j), CO1_R2Cpx(sym.w, sym.j)),
		  diag := When(ObjId(sym)=CE0_R2Cpx, Diag(BHD(m, 1, -1)), Diag(BHD(m, -1, 1))),
	     [ DirectSum(GathExtend(m, sym), GathExtend(N-m, sym1)),
	       DirectSum(I(Int(m+1+_even(m))), Tensor(I(Int((k-1)/2)), diag), I(_even(k)*(m+_odd(m)))),
	       RC(VStack(Gath(Refl(nn, N, Int((m+2)/2), L(N,k))),
		         Gath(Refl(nn, N, nn-Int((m+2)/2), fCompose(L(N,k), fAdd(N, N-m, m)))))) ])),

     L_Conj1_R2Cpx := ARule(Compose, [[L, @(1), @(2)], [@(3,GathExtend), @, @(4, [CE1_R2Cpx, CO1_R2Cpx])]],
	 e -> let(N:=@(1).val, k:=@(2).val, m:=N/k, nn:=Cols(@(3).val)/2,
	          sym  := @(4).val,
		  diag := When(sym=CE1_R2Cpx, Diag(BHD(m, 1, -1)), Diag(BHD(m, -1, 1))),
	     [ GathExtend(N, sym),
	       DirectSum(Tensor(I(Int(k/2)), diag), When(IsOddInt(k), I(m+_odd(m)), [])),
	       RC(Gath(Refl(nn, N-1, nn, L(N,k)))) ])),

     L_Even0 := ARule(Compose, [[L, @(1), @(2)], [@(3,GathExtend), @, Even0]],
	 e -> let(N:=@(1).val, k:=@(2).val, m:=N/k, nn:=Cols(@(3).val),
	     [ DirectSum(GathExtend(m, Even0), GathExtend(N-m, Even1)),
	       VStack(Gath(Refl(nn, N, Int((m+2)/2), L(N,k))),
		      Gath(Refl(nn, N, nn-Int((m+2)/2), fCompose(L(N,k), fAdd(N, N-m, m))))) ])),

     L_Even00 := ARule(Compose, [[L, @(1), @(2)], [@(3,GathExtend), @, Even00]],
	 e -> let(N:=@(1).val, k:=@(2).val, m:=N/k, nn:=Cols(@(3).val),
	     [ DirectSum(GathExtend(m, Even00), GathExtend(N-m, Even1)),
	       VStack(Gath(Refl(nn, N-2, Int(m/2), fCompose(fAdd(N,N,-1), L(N,k), fAdd(N, N-1, 1)))),
		      Gath(Refl(nn, N-2, nn-Int(m/2), fCompose(fAdd(N,N,-1), L(N,k), fAdd(N, N-m, m))))) ])),

     L_Odd0 := ARule(Compose, [[L, @(1), @(2)], [@(3,GathExtend), @, Odd0]],
	 e -> let(N:=@(1).val, k:=@(2).val, m:=N/k, nn:=Cols(@(3).val),
	     [ DirectSum(GathExtend(m, Odd0),  GathExtend(m*(k-1), Odd1)),
	       DirectSum(I(Int((m+1)/2)), Tensor(I(Int((k-1)/2)), Diag(BHN(m))), When(IsEvenInt(k), I(Int(m/2)), [])),
	       VStack(Gath(Refl(nn, N, Int((m+1)/2), L(N,k))),
		      Gath(Refl(nn, N, nn-Int((m+1)/2), fCompose(L(N,k), fAdd(N, N-m, m))))) ])),

     L_Odd00 := ARule(Compose, [[L, @(1), @(2)], [@(3,GathExtend), @, Odd00]],
	 e -> let(N:=@(1).val, k:=@(2).val, m:=N/k, nn:=Cols(@(3).val),
	     [ DirectSum(GathExtend(m, Odd00), GathExtend(m*(k-1), Odd1)),
	       DirectSum(I(Int((m-1)/2)), Tensor(I(Int((k-1)/2)), Diag(BHN(m))), When(IsEvenInt(k), I(Int(m/2)), [])),
	       VStack(Gath(Refl(nn, N-2, Int((m-1)/2), fCompose(fAdd(N,N,-1), L(N,k), fAdd(N, N-1, 1)))),
		      Gath(Refl(nn, N-2, nn-Int((m-1)/2), fCompose(fAdd(N,N,-1), L(N,k), fAdd(N, N-m, m))))) ])),

     L_Even1 := ARule(Compose, [[L, @(1), @(2)], [@(3,GathExtend), @, Even1]],
	 e -> let(N:=@(1).val, k:=@(2).val, m:=N/k, nn:=Cols(@(3).val),
	     [ GathExtend(N, Even1),
	       Gath(Refl(nn, N-1, nn, L(N,k))) ])),

     L_Odd1 := ARule(Compose, [[L, @(1), @(2)], [@(3,GathExtend), @, Odd1]],
	 e -> let(N:=@(1).val, k:=@(2).val, m:=N/k, nn:=Cols(@(3).val),
	     [ GathExtend(N, Odd1),
	       DirectSum(Tensor(I(Int(k/2)), Diag(BHN(m))), When(IsOddInt(k), I(Int(m/2)), [])),
	       Gath(Refl(nn, N-1, nn, L(N,k))) ])),

     CRT_Even1 := ARule(Compose, [@(1, CRT), [@(2,GathExtend), @, Even1]],
	 e -> let(N:=Rows(@(2).val),  nn:=Cols(@(2).val),
	     [ GathExtend(N, Even1),
	       Gath(Refl(nn, N-1, nn, @(1).val)) ])),

     Tensor_Dirsum_split := ARule(Compose,
	 [[Tensor, [I, @(1)], @(2)], [DirectSum, @(3).cond(e->Rows(e)=Cols(@(2).val)), @(4)]],
	 e -> [ DirectSum(@(2).val * @(3).val, Tensor(I(@(1).val-1), @(2).val) * @(4).val) ]),

     IxDFT_EO1 := ARule(Compose,
	 [[Tensor, [I, @(1)], [@(2,[DFT,DFT2,DFT3,DFT4]), @, 1, ...]], [@(3,GathExtend), @, @(4).cond(e->e in [Even1, Odd1])]],
	 e -> let(k:=@(1).val, n:=Cols(@(2).val), transf:=@(2).val, sign := When(@(4).val=Odd1, -1, 1),
	        When(k mod 2 = 0,
	         [ # Below is actually a scaled type 1 extension! exploit this for final rewriting phase
                   PushL(DirectSum(I(n*k/2), Tensor(I(k/2), mk_JDFT_Reconstruct(transf)*J(n))) *
                         @(3).val) *
		   Tensor(I(k/2), transf) ],

                   # again, a scaled type 1 extension!
		 [ PushL(VStack(I(n*(k+1)/2),
			        Tensor(J((k-1)/2), sign * mk_JDFT_Reconstruct(transf))
				   * Gath(fAdd(n*(k+1)/2, n*(k-1)/2, 0)))),
		   DirectSum(Tensor(I((k-1)/2), 1/2*transf),
			     transf * GathExtend(n, @(4).val))]))),

 #     IxDFT_EO1 := ARule(Compose,
# 	 [[Tensor, [I, @(1)], [@(2,[DFT,DFT2,DFT3,DFT4]), @, 1, ...]], [GathExtend, @(3), @(4).cond(e->e in [Even1, Odd1])]],
# 	 e -> let(k:=@(1).val, n:=Cols(@(2).val), transf:=@(2).val, sign := When(@(4).val=Odd1, -1, 1),
# 	        When(k mod 2 = 0,
# 	         [ # Below is actually a scaled type 1 extension! exploit this for final rewriting phase
#                    PushL(VStack(I(n*k/2), Tensor(J(k/2), sign * mk_JDFT_Reconstruct(transf)))),
# 		   Tensor(I(k/2), 1/2*transf) ],

#                    # again, a scaled type 1 extension!
# 		 [ PushL(VStack(I(n*(k+1)/2),
# 			        Tensor(J((k-1)/2), sign * mk_JDFT_Reconstruct(transf))
# 				   * Gath(fAdd(n*(k+1)/2, n*(k-1)/2, 0)))),
# 		   DirectSum(Tensor(I((k-1)/2), 1/2*transf),
# 			     transf * GathExtend(n, @(4).val))]))),

     IxDFT_CEO1_RFTT_DHT := ARule(Compose,
	 [[Tensor, [I, @(1)], @(2,[DFT,DFT2,DFT3,DFT4])],
	  [GathExtend, @(3), @(4,[CE1_R2Cpx, CO1_R2Cpx],e->e.w in [W_RFTT, W_URFTT, W_DHT, W_DHT])]],

	 e -> let(k:=@(1).val, n:=Cols(@(2).val),
	          transf := @(2).val, sign := When(ObjId(@(4).val)=CO1_R2Cpx, -1, 1),
	          newtransf := RC(ObjId(transf)(transf.params[1], -transf.params[2])),
		  winv := @(4).val.w^-1,
		  pack1 := Mat([winv[1]]),
		  pack2 := Mat([winv[2]]),

	        When(k mod 2 = 0,
	         [ PushL(VStack(Tensor(I(n*k/2), pack1),
			        Tensor(J(k/2), sign * Tensor(I(n), pack2)*
				               RC(mk_JInvDFT_Reconstruct(transf))))),
		   Tensor(I(k/2), newtransf) ],

		 [ PushL(VStack(DirectSum(Tensor(I(n*(k-1)/2), pack1), I(n)),
			        Tensor(J((k-1)/2), sign * Tensor(I(n), pack2) *
				                   RC(mk_JInvDFT_Reconstruct(transf))) * Gath(fAdd(n*k, n*(k-1), 0)))),
		   DirectSum(Tensor(I((k-1)/2), newtransf),
			     transf * GathExtend(n, @(4).val))]))),

     IxDFT_Real := ARule(Compose,
	 [[Tensor, [I, @(1)], [@(2,[DFT,DFT2,DFT3,DFT4]), @, 1, ...]], [GathExtend, @(3), Real]],
	 e -> [ Tensor(I(@(1).val), @(2).val * GathExtend(Cols(@(2).val), Real)) ]),

     DFTxI_Ext := ARule(Compose,
	 [[@(1,Tensor), [@(2,[DFT,DFT2,DFT3,DFT4]), @, 1, ...], I], @(4, GathExtend)],
	 e -> [ @(1).val.parallelForm() * @(4).val]),

     Tensor_J1 := Rule([Tensor, [J, 1], @(1)], e -> @(1).val),
     Tensor_I1 := Rule([Tensor, [I, 1], @(1)], e -> @(1).val),
     Tensor_I0 := Rule([Tensor, ..., [I, 0], ...], e -> I(0)),
     Compose_I := ARule(Compose, [I], e -> []),
     DirectSum_I0 := ARule(DirectSum, [[I, 0]], e -> []),
     DirectSum_Assoc := ARule(DirectSum, [@(1,DirectSum)], e -> [@(1).val.children()]),
     DirectSum_Single := Rule([DirectSum, @(1)], e -> @(1).val),
     Compose_Assoc := ARule(Compose, [@(1,Compose)], e -> [@(1).val.children()]),
     Compose_Single := Rule([Compose, @(1)], e -> @(1).val),
     J_J := ARule(Compose, [@(1,J), @(2,J)], e -> [ I(@(1).val.params[1]) ]),

     # ===============
     # Diags
     # ================
     Diag_Diag := ARule(Compose, [[Diag, @(1)], [Diag, @(2)]], e ->
         [ Diag(diagMul(@(1).val, @(2).val)) ]),

     Diag_L_Diag := ARule(Compose, [[Diag, @(1)], @(2, L), [Diag, @(3)]], e ->
         [ Diag(diagMul(@(1).val, fCompose(@(3).val, @(2).val))) * @(2).val ]),

     Tensor_Diag := Rule([Tensor, [I, @(1)], [Diag, @(2)]],
         e -> Diag(diagTensor(fConst(@(1).val, 1), @(2).val))),
     DirectSum_Diag := Rule([DirectSum, [I, @(1)], [Diag, @(2)]],
         e -> Diag(diagDirsum(fConst(@(1).val, 1), @(2).val))),

     E1_Diag_E1 := ARule(Compose, [[@(1,GathExtend,e->e.transposed), @, Odd1],
                                   [Diag, @(2)],
                                   [@(1,GathExtend,e->not e.transposed), @, Odd1]],
      e -> let(n:=@(2).val.domain(), f := @(2).val,
           [Diag(diagMul(fConst(n/2, 1/4),
                       diagAdd(fCompose(f, fTensor(fBase(2, 0), fId(n/2))),
                               fCompose(f, fTensor(fBase(2, 1), J(n/2))))))])),

     Scale_Scale := Rule([Scale, @(1), [Scale, @(2), @(3)]], e->Scale(@(1).val * @(2).val, @(3))),
     Scale_1 := Rule([Scale, @(1).cond(e->e=1), @(2)], e->@(2).val),

     # =============
     # PushL/PushR
     # =============
     PushL_within_PushL := Rule(@@(1,PushL, (e,cx)->IsBound(cx.PushL) and cx.PushL<>[]), e -> e.child(1)),

     Compose_PushL_PushL := ARule(Compose, [[PushL, @(1)], [PushL, @(2)]], e -> [ PushL(@(1).val * @(2).val) ]),
     Compose_PushR_PushL := ARule(Compose, [[PushR, @(1)], [PushL, @(2)]], e -> [ PushR(@(1).val * @(2).val) ]),
     XXX_PushL := ARule(Compose, [@(1, [Diag, L]), [PushL, @(2)]], e -> [PushL(@(1).val * @(2).val)]),

     Tensor_PushL := Rule([Tensor, @(1, I), [Compose, @(2, PushL), @(3)]],
	 e -> PushL(Tensor(@(1).val, @(2).val.child(1))) * Tensor(@(1).val, @(3).val)),

     DirectSum_PushL := Rule(@(1, DirectSum,
	     e -> ForAny(e.children(),
		 c -> ObjId(c)=PushL or (ObjId(c)=Compose and ObjId(c.child(1)) = PushL))),

	 e -> let(ch := @(1).val.children(),
	          split := List(ch, e -> Cond(ObjId(e) = PushL,
			                          [e, I(Cols(e))],
			                      ObjId(e) = Compose and ObjId(e.child(1))=PushL,
					          [e.child(1).child(1), Drop(e.children(), 1)],
					      [I(Rows(e)), e])),
		  PushL(DirectSum(List(split, x->x[1]))) * DirectSum(List(split, x->x[2]))))
));

RewriteRules(RulesDFTSymmetry, rec(
     BRDFT3_ExtendOdd0 := ARule(Compose, [[BRDFT3, @(1).cond(e->IsEvenInt(e)), 1/4], [GathExtend, @, Odd0]],
	 e -> let(k:=@(1).val,
	     [ GathExtend(k,Upsample0),SkewDTT(DCT3(k/2),1/2)])),

     Odd1_split := ARule(Compose, [[Tensor, [I,@(1)],@(2)],[GathExtend, @, Odd1]],
	 e -> let(n:=@(1).val,A:=@(2).val,k:=When(IsEvenInt(n),n/2, (n-1)/2),When(IsEvenInt(n),
	     [VStack(Tensor(I(k),A)*(1/2),Tensor(J(k),A*J(Cols(A))*(-1/2)))],
	     [VStack(DirectSum(Tensor(I(k),A)*(1/2),A*GathExtend(Cols(A),Odd1)),Tensor(J(k),A*J(Cols(A))*(-1/2)))]))),

     ReduceUpsample0_RC := ARule(Compose, [[ScatReduce, @(1), Upsample0],[RC, @(2)]],
	 e -> [@(2).val*ScatReduce(@(1).val,Upsample0)]),

     Push_ScatReduceWithinSum :=  ARule(Compose, [[ScatReduce, @, Upsample0],[@(1,IterDirectSum).cond(e->IsEvenInt(e.domain)),@(2)]],
	 e -> [IterDirectSum(@(1).val.var,@(1).val.domain,ScatReduce(Rows(@(2).val),Upsample0)*@(2).val)]
),

     Cut_SkewPRDFT := ARule(Compose, [[ScatReduce, @, Upsample0],[BSkewPRDFT,@(1),@(2)]],
	 e ->  let(n:=@(1).val,a:=@(2).val,f:=2*cospi(2*a),
	        [SkewDTT(DCT3(n/2),2*a)*When(IsEvenInt(n/2),
		     HStack(I(n/2),DirectSum(Mat([[f/2]]),Tensor(I(((n/2)-2)/2),Mat([[f,-1],[-1,f]])),Mat([[f-1]]))^M((n)/2,n/4)),
		     HStack(I(n/2),DirectSum(Mat([[f/2]]),Conjugate(Tensor(I((n/2-1)/2),Mat([[f,-1],[-1,f]])),M(n/2-1,(n/2-1)/2)))))])),

     SplitIterDirectSum := Rule([@(1,IterDirectSum), [Compose,@(2,SkewDTT),@(3,HStack)]],
	 e->let(i:=@(1).val.var,IterDirectSum(@(1).val.var,@(1).val.domain,@(2).val)*IterDirectSum(@(1).val.var,@(1).val.domain,@(3).val))),

     BRDFT3_ExtendOdd1 := ARule(Compose, [[BRDFT3, @(1).cond(e->IsEvenInt(e)), 1/4], [GathExtend, @, Odd1]],
         e -> let(k:=@(1).val,i:=Ind(),
	        [IterDirectSum(i,k/2,Mat([[1/2+cospi((2*i+1)/k)],[-1/2]]))*PolyDTT(DCT4(k/2))])),

     BRDFT3_J := ARule(Compose, [[BRDFT3, @(1).cond(e->IsEvenInt(e)), 1/4], [J, @]],
         e -> let(k:=@(1).val,i:=Ind(),
                [IterDirectSum(i,k/2,Mat([[-2*cospi((2*i+1)/k),-1-2*cospi((2*i+1)/(k/2))],[1,-2*cospi((2*((k/2)-i)-1)/k)]]))*BRDFT3(k)]))
));

#z := L(15,3) * GathExtend(15, Odd0);; zz := RulesDFTSymmetry(z);; PrintMat(MatSPL(z)-MatSPL(zz));
#z := L(16,4) * GathExtend(16, Odd0);; zz := RulesDFTSymmetry(z);; PrintMat(MatSPL(z)-MatSPL(zz));

#z := L(15,3) * GathExtend(15, Even00);; zz := RulesDFTSymmetry(z);; PrintMat(MatSPL(z)-MatSPL(zz));
#z := L(16,4) * GathExtend(16, Odd1);; zz := RulesDFTSymmetry(z);; PrintMat(MatSPL(z)-MatSPL(zz));

#RulesDFTSymmetry(Tensor(I(3), DFT(5))*L(15,3)*GathExtend(15, Even0));
#RulesDFTSymmetry(Tensor(I(2), DFT3(8))*L(16,2)*GathExtend(16, Even0));

dft1 := (N, k) -> Tensor(DFT1(k), I(N/k)) * Diag(Tw1(N, N/k, 1)) * Tensor(I(k), DFT1(N/k)) * L(N, k);
dft2 := (N, k) -> Tensor(DFT2(k), I(N/k)) * Diag(Tw2(N, N/k, 1)) * Tensor(I(k), DFT1(N/k)) * L(N, k);
dft3 := (N, k) -> Tensor(DFT1(k), I(N/k)) * Diag(Tw3(N, N/k, 1)) * Tensor(I(k), DFT3(N/k)) * L(N, k);
dft4 := (N, k) -> Tensor(DFT2(k), I(N/k)) * Diag(Tw4(N, N/k, 1)) * Tensor(I(k), DFT3(N/k)) * L(N, k);

pdft1 := (N, k, lsym, rsym) -> GathExtend(N, lsym).transpose() * dft1(N, k) * GathExtend(N, rsym);
pdft2 := (N, k, lsym, rsym) -> GathExtend(N, lsym).transpose() * dft2(N, k) * GathExtend(N, rsym);
pdft3 := (N, k, lsym, rsym) -> GathExtend(N, lsym).transpose() * dft3(N, k) * GathExtend(N, rsym);
pdft4 := (N, k, lsym, rsym) -> GathExtend(N, lsym).transpose() * dft4(N, k) * GathExtend(N, rsym);

# DCT6(8)
f := L(15, 3) * Tensor(I(5), DFT2(3, 1)) * L(15, 5) *
     Diag(Tw2(15, 5, 1)) *
     Tensor(I(3), DFT(5, 1)) * L(15, 3);
ff := GathExtend(Rows(f), Odd0).transpose() * f * GathExtend(Cols(f), Even1);

# f := L(16,4) * Tensor(I(4), DFT(4)) * L(16,4) * Diag(Tw1(16,4,1)) * Tensor(I(4), DFT(4)) * L(16,4);
# ff := GathExtend(Rows(f), Odd00).transpose() * f * GathExtend(Cols(f), Odd00);

# DCT2/DCT6
# f := L(16,4) * Tensor(I(4), DFT2(4)) * L(16,4) * Diag(Tw2(16,4)) * Tensor(I(4), DFT(4)) * L(16,4);
#ff := GathExtend(Rows(f), Odd0).transpose() * f * GathExtend(Cols(f), Even1);

# f4 := L(16,4) * Tensor(I(4), DFT2(4)) * L(16,4) * Diag(Tw4(16,4)) * Tensor(I(4), DFT3(4)) * L(16,4);
# ff := GathExtend(Rows(f), Odd1).transpose() * f4 * GathExtend(Cols(f), Odd1);

#  fo := L(21,3) * Tensor(I(7), DFT2(3)) * L(21,7) * Diag(Tw4(21,7)) * Tensor(I(3), DFT3(7)) * L(21,3);
# ffo := GathExtend(Rows(fo), Odd1).transpose() * fo * GathExtend(Cols(fo), Odd1);

# fr1 := GathExtend(16, CE0_R2Cpx(W_RFT, 1).invertW()).transpose() * f * GathExtend(16, Real);

 fr2 := GathExtend(21, CE0_R2Cpx(W_RFT, 1).invertW()).transpose() *
        L(21,3) * Tensor(I(7), DFT(3)) * L(21,7) * Diag(Tw1(21,7,1)) * Tensor(I(3), DFT(7)) * L(21,3) *
	GathExtend(21, Real);

 fr4 := GathExtend(21, CO1_R2Cpx(W_RFT, -E(4)).invertW()).transpose() *
        L(21,3) * Tensor(I(7), DFT2(3)) * L(21,7) * Diag(Tw4(21,7,1)) * Tensor(I(3), DFT3(7)) * L(21,3) *
	GathExtend(21, Real);

# fr4 := GathExtend(16, CO1_R2Cpx).transpose() * L(16,4) * Tensor(I(4), DFT2(4)) * L(16,4) * Diag(Tw4(16,4)) * Tensor(I(4), DFT3(4)) * L(16,4) * GathExtend(16, Real);

#p  := Mat(1/2*[[1,  E(4)]]);
#pp := Mat(1/2*[[1, -E(4)]]);

#them := MatSPL(DFT(4) * Tensor(I(4), 2*pp));;
#me   := MatSPL(Tensor(I(4), 2*pp) * RC(DFT(4,1)));;

# y = DFT x* = (DFT* x)* ?
#
# C IxP = IxP' RC(C)
# IxP' = C IxP RC(C)^-1

# C IxP =IxP' C Ix(1,j)

dftproj := function(f)
    f := RulesDFTSymmetry(f);
    f := f.transpose();
    f := RulesDFTSymmetry(f);
    f := f.transpose();
    return f;
end;


#
# usage:
# Read("~/Workspace/Chevalley.gap/init.gi"); Read(Filename(home_dir,"load.gi")); Read(Filename(f4_dir_char3,"_init_char3.gi")); Read(Filename(f4_dir_char3,"F4(a2).gi"));
#
# Read(Filename(f4_dir_char3,"F4(a2).gi"));
#

label:="F_4(a_2)";
orb_nr:=Position(labels,label);
#orb:=AllClasses(orbs)[2];
orb:=AllClasses(orbs)[orb_nr];
info:=infos[orb_nr];

#
# ------------------------------------------------------------------------
#

Print("Consider the class ",Label(orb)," in characteristic ",Characteristic(ring(sys)),":\n");
Print("\tBorel representative \n\t",coefficients(BorelRep(orb)),"\n");
Print("\tconnected C_U(u) \n\t",coefficients(info[1]),"\n");
Print("\tconnected double C_U(u) in Levi \n\t",coefficients(info[2]),"\n");
Print("\tconnected double C_U(u) \n\t",coefficients(info[3]),"\n");

#
# ------------------------------------------------------------------------
#

tmp:=handle3char3();
Print("\nComponent group check:\n");
Print("\ta^u= \n",coefficients(tmp[1]),"\n");
Print("\tconnected center= \n",coefficients(tmp[2]),"\n");


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

#############################
# General Case Cooley-Tukey
#############################

# R1 -> (R1, C1, R3) (R1)
# R2 -> (R2, C2, R4) (R1)
PRF12_CT_Children := (N,k,PRFt,DFTt,PRFtp,PRF1) -> Map2(DivisorPairs(N),
    (m,n) -> When(IsEvenInt(n),
	[ PRFt(m,k), DFTt(m,k), PRF1(n,k), PRFtp(m,k) ],
	[ PRFt(m,k), DFTt(m,k), PRF1(n,k) ] )
);

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

    SUM(
	RC(Scat(H(Nf+1,mf+1,0,n))) * C[1] * Gath(H(2*(nf+1)*m, m, 0, 2*(nf+1))),

	When(nc=1, [],
	ISum(j,
	     RC(Scat(BH(Nf+1,N,m,j+1,n))) *
	     Conj * RC(C[2]) * Tw(j) *
	     RC(Gath(H((nf+1)*m, m, j+1, nf+1))))),

	When(IsOddInt(n), [],
	RC(Scat(H(Nf+1,mc,nf,n))) * C[4] * Gath(H(2*(nf+1)*m, m, 2*nf, 2*(nf+1))))
    ) *
    Tensor(I(m), C[3]) * L(N,m)
);

IPRF12_CT_Rule := (N,k,C,Conj,Tw) -> let(m:=Rows(C[1]), n:=Rows(C[3]), Nf:=Int(N/2),
    nf:=Int(n/2), nc:=Int((n+1)/2), mf:=Int(m/2), mc:=Int((m+1)/2), j:=Ind(nc-1),

    L(N,n) * Tensor(I(m), C[3]) *
    SUM(
	Scat(H(2*(nf+1)*m, m, 0, 2*(nf+1))) * C[1] * RC(Gath(H(Nf+1,mf+1,0,n))),

	When(nc=1, [],
	ISum(j,
	     RC(Scat(H((nf+1)*m, m, j+1, nf+1))) *
	     Tw(j) *
	     RC(C[2]) *
	     Conj *
	     RC(Gath(BH(Nf+1,N,m,j+1,n))))),

	When(IsOddInt(n), [],
	Scat(H(2*(nf+1)*m, m, 2*nf, 2*(nf+1))) * C[4] * RC(Gath(H(Nf+1,mc,nf,n))))
    )
  );

####################
# Prime Factor
####################

PRF12_PF_Children := (N,k,PRFt,DFTt,PRF1) -> Map2(DivisorPairsRP(N),
    (m,n) -> When(IsEvenInt(n),
	[ PRFt(m,k*n), DFTt(m,k*n), PRF1(n,k*m), PRF1(m,k*n) ],
	[ PRFt(m,k*n), DFTt(m,k*n), PRF1(n,k*m) ] )
);

 RC.toAMat := self >> AMatMat(RCMatCyc( MatSPL(self.child(1)) ));

PRF12_PF_Rule := (N,k,C) -> let(m:=Cols(C[1]), n:=Cols(C[3]), Nf:=Int(N/2), Nc:=Int((N+1)/2),
    nf:=Int(n/2), nc:=Int((n+1)/2), mf:=Int(m/2), mc:=Int((m+1)/2), j:=Ind(nc-1),
    alpha := (1/n) mod m,
    beta := (1/m) mod n,
    jj:=Ind(m), q := Ind(2*m),

    SUM(
	RC(Scat(H(Nf+1,mf+1,0,n))) * C[1] * Gath(H(2*(nf+1)*m, m, 0, 2*(nf+1))),

	When(nc=1, [],
	ISum(j,
	     RC(Scat(Refl(Nf+1, N, m, HZ(N, m, (j+1)*m, n)))) *
	     # conjugate those values which indices will be reflected by the scatter Refl
	     # NOTE: Unless 1.0 is used below, vector code will break due to TVect(TInt, ...)
	     Diag(Lambda(q, cond(neq(imod(q, 2),0), cond(leq(imod(n*idiv(q, 2) + (j+1)*m, N), Nc-1), 1.0, -1.0), 1.0))) *
	     RC(C[2]) *
	     RC(Gath(H((nf+1)*m, m, j+1, nf+1))))),

	When(IsOddInt(n), [],
	     let(inds := HZ(N, mc, nc*m, n).tolist(),
		 conj := ConcatList(inds{[1..mc]}, i -> When(i.v > Nf, [1.0,-1.0], [1.0,1.0])),

		 RC(Scat(Refl(Nf+1, N, mc, HZ(N, mc, nc*m, n)))) *
		 #RC(Scat(H(Nf+1, mc, nf, n))) *
		 Diag(conj) * C[4] *
		 Gath(H(2*(nf+1)*m, m, 2*nf, 2*(nf+1)))
	     ))
    ) *
    Tensor(I(m), C[3]) * CRT(m,n,1,1)
);

# s := PRF12_PF_Rule(6,1,PRF12_PF_Children(6,1,PRDFT1, DFT1, PRDFT1)[1]);
# Print(s);
# me := MatSPL(s);
# them := MatSPL(PRDFT(6));

###########
# RDFT    #
###########

Declare(PRDFT1_PF);

RulesFor(PRDFT1, rec(
    PRDFT1_Base1 := BaseRule(PRDFT1, [1, @]),
    PRDFT1_Base2 := BaseRule(PRDFT1, [2, @]),

    #F PRDFT1_CT: projection of DFT_CT
    PRDFT1_CT := rec(
	forcePrimeFactor := false,
	isApplicable := (self, P) >> not IsPrime(P[1]) and
	    When(self.forcePrimeFactor, not PRDFT1_PF.isApplicable(P), true),

	allChildren  := P -> PRF12_CT_Children(P[1], P[2], PRDFT1, DFT1, PRDFT3, PRDFT1),
	rule := (P,C) -> let(N:=P[1], k:=P[2], m:=Cols(C[1]),
	    PRF12_CT_Rule(N, k, C, Diag(BHD(m,1,-1)), j->RC(Diag(fPrecompute(Twid(N,m,k,0,0,j+1))))))),

    #F PRDFT1_Complex: computes PRDFT using half of the outputs of complex DFT
    #F                this rule can be successfully pruned by the compiler, and thus
    #F                works for all sizes, including primes
    PRDFT1_Complex := rec(
	switch           := false,
	isApplicable     := P -> not Is2Power(P[1]),
	allChildren      := P -> [[ DFT(P[1], P[2]) ]],
	forTransposition := false,
	rule             := (P,C) -> let(n := P[1], nn:=Int(n/2)+1,
	    Buf(Gath(H(2*n,2*nn, 0, 1))) *
	    Diag(diagDirsum(fConst(2*nn,1), fConst(2*n-2*nn,0))) *
	    RC(C[1]) *
	    Tensor(I(n), Diag(1,0)) *
	    Buf(Scat(H(2*n,n,0,2)))
	)
    ),

    # transpose of RC(DFT(n)) is RC(DFT(n,-1)), since correct transposition is not implemented,
    # we need a separate rule
    PRDFT1_Complex_T := rec(
	switch           := false,
	isApplicable     := P -> not Is2Power(P[1]),
	allChildren      := P -> [[ DFT(P[1], -P[2]) ]],
	forTransposition := false,
	transposed := true,
	rule             := (P,C) -> let(n := P[1], nn:=Int(n/2)+1,
	    Buf(Gath(H(2*n,n,0,2))) *
	    Tensor(I(n), Diag(1,0)) *
	    RC(C[1]) *
	    Diag(diagDirsum(fConst(2*nn,1), fConst(2*n-2*nn,0))) *
	    Buf(Scat(H(2*n,2*nn, 0, 1)))
	)
    ),

    #F PRDFT1_Trig: PRDFT1_n -> P (DCT1_(n/2+1) dirsum DST1_(n/2-1)) A
    #F
    PRDFT1_Trig := rec(
	isApplicable := P -> P[1] > 2 and IsEvenInt(P[1]) and (P[2] mod P[1]) in [1,-1 mod P[1]],
	allChildren := P -> [[ DCT1(P[1]/2+1), DST1(P[1]/2-1) ]],
	rule := (P, C) -> let(n:=P[1]/2,
	    Z(2*n+2,2) *
	    DirectSum(Mat([[1,0],[0,0],[0,1],[0,0]]), L(2*n-2,n-1)) *
	    DirectSum(Z(n+1,-1)*C[1], Scale(P[2],C[2])) * SymSplit1(n))),

    PRDFT1_PF := rec(
	maxSize := false,
    	isApplicable := (self, P) >> (self.maxSize=false or P[1]<=self.maxSize) and not IsPrime(P[1]) and DivisorPairsRP(P[1])<>[],
    	allChildren  := P -> PRF12_PF_Children(P[1], P[2], PRDFT1, DFT1, PRDFT1),
    	rule := (P,C) -> let(N:=P[1], k:=P[2], m:=Cols(C[1]),
    	    PRF12_PF_Rule(N, k, C)))
));

RulesFor(IPRDFT1, rec(
    IPRDFT1_Base1 := BaseRule(IPRDFT1, [1, @]),
    IPRDFT1_Base2 := BaseRule(IPRDFT1, [2, @]),

    IPRDFT1_CT := rec(
	isApplicable := P -> not IsPrime(P[1]),
	allChildren  := P -> PRF12_CT_Children(P[1], P[2], IPRDFT1, DFT1, IPRDFT2, IPRDFT1),
	rule := (P,C) -> let(N:=P[1], k:=P[2], m:=Rows(C[1]),
	    IPRF12_CT_Rule(N, k, C, Diag(BHD(m,1,-1)), j->RC(Diag(fPrecompute(Twid(N,m,k,0,0,j+1))))))),

    IPRDFT1_Complex := rec(
 	switch           := false,
 	isApplicable     := P -> IsPrime(P[1]),
 	allChildren      := P -> [[ DFT(P[1], P[2]) ]],
	forTransposition := false,
	rule             := (P,C) -> let(n := P[1], nn:=Int(n/2)+1,
	    Mat(MatSPL(Gath(H(2*n,n,0,2)))) *
	    #Tensor(I(n), Diag(1,0)) *
	    RC(C[1]) *
	    Mat(MatSPL(Scat(H(2*n,2*nn, 0, 1))))
	)
    )
));

RulesFor(PRDFT2, rec(
    PRDFT2_Base1 := BaseRule(PRDFT2, [1, @]),
    PRDFT2_Base2 := BaseRule(PRDFT2, [2, @]),

    #F PRDFT2_CT: projection of DFT2_CT
    PRDFT2_CT := rec(
	isApplicable := P -> not IsPrime(P[1]),
	allChildren  := P -> PRF12_CT_Children(P[1], P[2], PRDFT2, DFT2, PRDFT4, PRDFT1),
	rule := (P,C) -> let(N:=P[1], k:=P[2], m:=Cols(C[1]),
	    PRF12_CT_Rule(N, k, C, Diag(BHD(m,-1,1)), j->RC(Diag(fPrecompute(Twid(N,m,k,0,1/2,j+1)))))))
));

RulesFor(IPRDFT3, rec(
    IPRDFT3_Base1 := BaseRule(IPRDFT3, [1, @]),
    IPRDFT3_Base2 := BaseRule(IPRDFT3, [2, @]),

    IPRDFT3_CT := rec(
	isApplicable := P -> not IsPrime(P[1]),
	allChildren  := P -> PRF12_CT_Children(P[1], P[2], IPRDFT3, DFT3, IPRDFT4, IPRDFT1),
	rule := (P,C) -> let(N:=P[1], k:=P[2], m:=Rows(C[1]),
	    IPRF12_CT_Rule(N, k, C, Diag(BHD(m,-1,1)), j->RC(Diag(fPrecompute(Twid(N,m,k,0,1/2,j+1)))))))
));

###########
# Hartley #
###########

RulesFor(PDHT1, rec(
    PDHT1_Base2 := rec(
	isApplicable := P -> P[1]=2,
	rule := (P, C) -> Tensor(I(2), Mat([[1],[1]])) * F(2)
    ),

    PDHT1_CT := rec(
	isApplicable := P -> not IsPrime(P[1]),
	allChildren  := P -> PRF12_CT_Children(P[1], P[2], PDHT1, DFT1, PDHT3, PDHT1),
	rule := (P,C) -> let(N:=P[1], k:=P[2], m:=Cols(C[1]),
	    PRF12_CT_Rule(N, k, C, TopHalf(m, J(2)), j->HTwid(N,m,k,0,0,j+1,J(2)).obj)))
));

RulesFor(PDHT2, rec(
   PDHT2_Base2 := rec(
	isApplicable := P -> P[1]=2,
	rule := (P, C) -> DirectSum(Mat([[1],[1]]), Mat([[1],[-1]])) * Mat(MatSPL(PRDFT2(P[1], P[2])){[1,4]})
    ),
    PDHT2_CT := rec(
	isApplicable := P -> not IsPrime(P[1]),
	allChildren  := P -> PRF12_CT_Children(P[1], P[2], PDHT2, DFT2, PDHT4, PDHT1),
	rule := (P,C) -> let(N:=P[1], k:=P[2], m:=Cols(C[1]),
	    PRF12_CT_Rule(N, k, C, TopHalf(m, -J(2)), j->HTwid(N,m,k,0,1/2,j+1,-J(2)).obj)))
));


# Examples/Tests for ANATPH

# Jack Button's Group
# -------------------
#
# With presentation
#
# Alan Logan says this is hyperbolic, but noone wants to publish
# this result alone.
#
# Tester now proves this to be hyperbolic, after corrected
# relation. Bug reported by email by Chris Chalk <chalk235@gmail.com>
#
InstallGlobalFunction("JackButtonGroup",
function()
    local pg;

    pg := PregroupOfFreeGroup(3);
    SetPregroupElementNames(pg, "1aAbBtT");
    return NewPregroupPresentation(pg, [ pg_word( pg, [7,2,6,5,3])
                                       , pg_word( pg, [7,4,6,3,5]) ]);
end);

# Triangle Groups
# ---------------
# As demonstrated in Proposition 9.4 of anatph, for l > 2 (and hence n > 3 if the
# group is supposed to be hyperbolic) there are no instantiable green places, and if
# l = 2 then there are exactly two instantiable green places.
InstallGlobalFunction("TriangleGroup",
function(l,m,n)
    local pg;
    pg := PregroupOfFreeProduct( CyclicGroup( IsPermGroup, l)
                               , CyclicGroup( IsPermGroup, m) );

    # This is a bit icky, we can't tell which element of pg is the one of the
    # second cyclic group
    return NewPregroupPresentation(pg, [ pg_word( pg, Repeat(n, [2, l + 1]))]);
end);

# Example from Theorem 9.5, triangle-like: quotient of 2-3-m triangle group
# our choice of pregroup is the free product of cyclic groups of order 2 and 3
#T see what happens if we present this group as
#T <x,y,z | x^2, y^3, z^m, (zxY)^n > ?
#T we push a parameter into the pregroup
InstallGlobalFunction(TriangleCommutatorQuotient,
function(m,n)
    local pg;
    pg := PregroupOfFreeProduct( CyclicGroup(IsPermGroup, 2)
                               , CyclicGroup(IsPermGroup, 3) );
    # Do this to have slightly nicer display. Maybe we need to give the user
    # a way to label generators
    pg!.enams := "1xyY";
    return NewPregroupPresentation(pg,
                                   [ pg_word(pg, Repeat(m, [2,3])),
                                     pg_word(pg, Repeat(n, [2,3,2,4]))
                                   ]);
end);

InstallGlobalFunction(RandomTriangleQuotient,
function(p,q,r,len)
    local pg;
    pg := PregroupOfFreeProduct( CyclicGroup(IsPermGroup, p)
                               , CyclicGroup(IsPermGroup, q) );
    # Do this to have slightly nicer display. Maybe we need to give the user
    # a way to label generators
    pg!.enams := "1xyY";
    return NewPregroupPresentation(pg,
                                   [ pg_word(pg, Repeat(r, [2,3])),
                                     RandomPregroupWord(pg, len)
                                   ]);
end);

InstallGlobalFunction(RandomPregroupWord,
function(pg, len)
    local i, lett, rel;

    rel := [];

    rel[1] := Random([2..Size(pg)]);
    for i in [2..len-1] do
        rel[i] := Random(Difference( [2..Size(pg)]
                                   , [__ID(PregroupInverse(pg[rel[i-1]]))]));
    od;
    rel[len] := Random(Difference([2..Size(pg)]
                                 , [ __ID(PregroupInverse(pg[rel[len - 1]]))
                                   , __ID(PregroupInverse(pg[rel[1]]))
                                   ] ));
    return pg_word(pg, rel);
end);

# Given a pregroup make a random presentation with nrel relators
# of length lrel
InstallGlobalFunction(RandomPregroupPresentation,
function(pg, nrel, lrel)
    local rels;

    rels := List([1..nrel], i -> RandomPregroupWord(pg, lrel));
    return NewPregroupPresentation(pg, rels);
end);

BindGlobal("CreateRandomExample",
function(path, pg, nrel, lrel)
    local pgp;

    if not IsDirectoryPath(path) then
        Error("path does not exist or is not a directory");
        return;
    fi;
    pgp := RandomPregroupPresentation(pg, nrel, lrel);

    # Write the pregroup presentation to file
    PregroupPresentationToFile(Concatenation(path, "/presentation-gap"), pgp);
    PregroupPresentationToSimpleFile(Concatenation(path, "/presentation-simple"), pgp);

    if WALRUS_kbmag_available then
    # Also create a KBMAG input file, if RSymTest succeeds on this presentation,
    # we can try computing an automatic structure and run gpgeowa on the result
    # to check whether the group is hyperbolic.
    WriteRWS(KBMAGRewritingSystem(PregroupPresentationToFpGroup(pgp)),
             Concatenation(path, "/presentation-kbmag"));
    fi;
end);

# Create a series of examples
BindGlobal("CreateRandomSeries",
function(pg, nrels, lrels, nexs, prf, basepath)
    local path, path2, i, pgp, lrel, nrel;

    if not IsDirectoryPath(basepath) then
        Error("path does not exist or is not a directory");
        return;
    fi;
    path := basepath;

    for lrel in lrels do
        CreateDir(Concatenation(path, "/", String(lrel)));
        for nrel in nrels do
            CreateDir(Concatenation(path, "/", String(lrel), "/", String(nrel)));
            for i in [1..nexs] do
                path2 := Concatenation(path, "/", String(lrel), "/", String(nrel), "/", String(i));
                prf("creating example nr ", i, " in ", path2, " \c");

                CreateDir(path2);
                CreateRandomExample(path2, pg, nrel, lrel);
                prf("\n");
            od;
        od;
    od;
end);

BindGlobal("CreateRandomSeriesOverSmallPregroups",
function(basepath)
    local i, n, sizes, path;

    if not IsDirectoryPath(basepath) then
        Error("path does not exist or is not a directory");
        return;
    fi;

    # at the moment we only have pregroups
    # of size 6
    sizes := [6];
    for n in sizes do
        CreateDir(Concatenation(basepath, "/", String(n)));
        for i in [1..NrSmallPregroups(n)] do
            path := Concatenation(basepath, "/", String(n), "/", String(i));
            CreateDir(path);
            CreateRandomSeries( SmallPregroup(n, i)
                              , [1,2,4,8,10]
                              , [5,10,15,20,25,30,35,40,45,50]
                              , 20
                              , Print
                              , path);
        od;
    od;
end);

BindGlobal("CreateRandomSeriesOverFreeGroup",
function(basepath)
    local i, n, sizes, path;

    if not IsDirectoryPath(basepath) then
        Error("path does not exist or is not a directory");
        return;
    fi;

    # ranks of free group
    sizes := [2,4,8,16,32,64];
    for n in sizes do
        path := Concatenation(basepath, "/", String(n));
        CreateDir(path);
        CreateRandomSeries( PregroupOfFreeGroup(n)
                          , [1,2,4,8,10]
                          , [5,10,15,20,25,30,35,40,45,50]
                          , 20
                          , Print
                          , path);
    od;
end);

BindGlobal("CreateRandomSeriesOverTrianglePregroup",
function(eps, p, q, nrel, lrel, nexs, prf, path)
    local pg;
    pg := PregroupOfFreeProduct( CyclicGroup( IsPermGroup, p)
                                , CyclicGroup( IsPermGroup, q) );
    pg!.enams := "1xyY";
    CreateRandomSeries( pg
                      , [1]
                      , [5,10,15,20,25,30,35,40,45,50]
                      , 20
                      , Print
                      , path );
end);

BindGlobal("CreateRandomSeriesOverTriangleGroup",
          function(eps, p, q, nrel, lrel, nexs, prf, path)
              local pg;
              pg := PregroupOfFreeProduct( CyclicGroup( IsPermGroup, p)
                                         , CyclicGroup( IsPermGroup, q) );
              pg!.enams := "1xyY";
              CreateRandomSeries( pg
                                , [1]
                                , [5,10,15,20,25,30,35,40,45,50]
                                , 20
                                , Print
                                , path );
          end);

BindGlobal("BenchmarkRandomPresentation",
function(pg, eps, nrel, lrel, nexs, prf, path)
    local i, pgp, start, stop, estart, estop, n, nfail, res, runt, fid, stream;

    n := 0;
    runt := [];

    start := NanosecondsSinceEpoch();
    for i in [1..nexs] do
        prf("creating example nr ", i, ", \c");
        pgp := RandomPregroupPresentation(pg, nrel, lrel);
        prf("starting RSymTest, \c");
        estart := NanosecondsSinceEpoch();
        res := RSymTest(pgp, eps);
        estop := NanosecondsSinceEpoch();
        if res = true then
            prf("succeeded after \c");
        else
            prf("failed \c");
        fi;
#        LogPregroupPresentation(path, pgp, res);
        prf(Float((estop - estart) / 1000000000), " seconds\n");
        Add(runt, [pgp, res, estop - estart]);
    od;
    stop := NanosecondsSinceEpoch();
    return rec( runtime := (stop - start) / 1000000000,
                samples := runt );
end);

BindGlobal("RandomPregroupFromSmallGroups",
function()
    local n, i, g1, g2;

    n := Random([1..64]);
    i := Random([1..NrSmallGroups(n)]);
    g1 := SmallGroup(n,i);

    n := Random([1..64]);
    i := Random([1..NrSmallGroups(n)]);
    g2 := SmallGroup(n,i);

    return PregroupOfFreeProduct(g1, g2);
end);

BindGlobal("BenchmarkRandom_TriPregroup",
function(eps, nrel, lrel, nexs, prf, path)
    local pg;
    pg := PregroupOfFreeProduct( CyclicGroup( IsPermGroup, 2)
                               , CyclicGroup( IsPermGroup, 3) );
    pg!.enams := "1xyY";
    return BenchmarkRandomPresentation(pg, eps, nrel, lrel, nexs, prf, path);
end);

BindGlobal("BenchmarkRandom_FreeGroupPregroup",
function(eps, ngen, nrel, lrel, nexs, prf, path)
    local pg;
    pg := PregroupOfFreeGroup(ngen);
    return BenchmarkRandomPresentation(pg, eps, nrel, lrel, nexs, prf, path);
end);

BindGlobal("BenchmarkRandom_OverSmallPregroup",
function(eps, nrel, lrel, nexs, prf, path)
    local pg, res;

    res := [];
    # FIXME: We only have pregroups of size 6 at the moment
    for pg in ANATPH_small_pregroups[6] do
        pg := PregroupByTable([1,'a','b','c','d', 'e'], pg);
        Add(res, BenchmarkRandomPresentation(pg, eps, nrel, lrel, nexs, prf, path));
    od;
    return res;
end);

BindGlobal("_VARIANCE",
function(v)
    local q, avg;
    if Length(v) = 1 then
        q := 1;
    else
        q := Length(v) - 1;
    fi;
    avg := Average(v);
    return Sum(List(v, x -> (x - avg)^2)) / (q);
end);

BindGlobal("AnalyseBenchmarkResult",
function(res)
    local r, succed, failed;

    r := rec();

    r.n := Length(res.samples);
    r.rt_avg := Average(List(res.samples, x->x[3]));
    r.rt_std := Sqrt(Float(_VARIANCE(List(res.samples, x->x[3]))));

    succed := Filtered(res.samples, x -> not IsList(x[2]));
    r.succed_n := Length(succed);
    if r.succed_n > 0 then
        r.succed_rt_avg := Average(List(succed, x->x[3]));
        r.succed_rt_std := Sqrt(Float(_VARIANCE(List(succed, x->x[3]))));
    fi;

    failed := Filtered(res.samples, x -> IsList(x[2]));
    r.failed_n := Length(failed);
    if r.failed_n > 0 then
        r.failed_rt_avg := Average(List(failed, x->x[3]));
        r.failed_rt_std := Sqrt(Float(_VARIANCE(List(failed, x->x[3]))));
    fi;

    return r;
end);

BindGlobal("StringBenchResult",
function(r)
    local res;

    res := STRINGIFY("n: ", r.n, ", s: ", r.succed_n, " f: ", r.failed_n, " (", Float(r.succed_n) / r.n, ")\n",
                     " (", Float(r.rt_avg), ",", r.rt_std, ")\n");
    Append(res, STRINGIFY(" success: ", r.succed_n));
    if r.succed_n > 0 then
        Append(res, STRINGIFY(" ", Float(r.succed_rt_avg), ",", r.succed_rt_std, "\n"));
    fi;
    Append(res, STRINGIFY(" failure: ", r.failed_n));
    if r.failed_n > 0 then
        Append(res, STRINGIFY(" ", Float(r.failed_rt_avg), ",", r.failed_rt_std, "\n"));
    fi;
    if res[Length(res)] <> '\n' then
        Add(res, '\n');
    fi;
    return res;
end);

BindGlobal("StandardBenchmarks",
function(nsamples, prn)
    local d, ngens, rlen, nrels, r, path;

    path := DirectoryTemporary();
    prn("running standard benchmarks for anatph, ", nsamples, " each\n");

    prn("= = = = = = =\n");
    prn(" Quotients of free group pregroup\n");
    prn("= = = = = = =\n");
    for ngens in [2,4,8,16] do
        for nrels in [1,2,3,4] do
            for rlen in [10,20,30,40,50] do
                prn("running "
                   , ngens, " generators, "
                   , nrels, " relators "
                   , "of length ", rlen, "\n");
                r := BenchmarkRandom_FreeGroupPregroup(
                                                    1/12
                                                  , ngens
                                                  , nrels
                                                  , rlen
                                                  , nsamples
                                                  , prn
                                                  , path
                     );
                prn(StringBenchResult(AnalyseBenchmarkResult(r)));
            od;
        od;
    od;

    prn("= = = = = = =\n");
    prn(" Quotients of 2-3-triangle group pregroup\n");
    prn("= = = = = = =\n");
    for nrels in [1,2,3,4] do
        for rlen in [10,20,30,40,50] do
            prn("running ", nrels, "relators of length ", rlen, "\n");
            r := BenchmarkRandom_TriPregroup(
                                              1/12
                                            , nrels
                                            , rlen
                                            , nsamples
                                            , prn
                                            , path
                     );
            prn(StringBenchResult(AnalyseBenchmarkResult(r)));
        od;
    od;

end);

BenchmarkSinglePres := function(eps, pg, nrel, len)
    local r,t,res;
    r := RandomPregroupPresentation(pg, nrel, len);
    t := NanosecondsSinceEpoch();
    res := RSymTest(r, eps);
    t := NanosecondsSinceEpoch() - t;
    return [r, res, t / 1000000000.];
end;

if IsBound(OutputAnnotatedCodeCoverageFiles) then
    ProfileSinglePresentation := function(eps, pg, nrel, len)
    local t, dir, fn;

    dir := DirectoryTemporary();
    fn := Filename(dir, "anatph.gz");

    Print("Profiling presentation to ", fn, "\n");
    ProfileLineByLine(fn);
    t := BenchmarkSinglePres(eps, pg, nrel, len);
    UnprofileLineByLine();

    Print("Writing annotated code coverage to ", Filename(dir, ""), "\n");
    OutputAnnotatedCodeCoverageFiles(fn, Filename(dir, ""));

    return t;
end;

else
    Print("profiling package is not available, disabling ProfileSinglePresentation\n");
fi;

# Benchmark the RSym tester with a presentation given density
# and length
BenchmarkGromovDensity := function(eps, ngens, length, density)
    local pg, nrels;

    pg := PregroupOfFreeGroup(ngens);
    nrels := Int( (2 * ngens - 1)^Float(density * length ) );
    Print("number of relators: ", nrels, "\n");
    return BenchmarkSinglePres(eps
                              , pg
                              , nrels
                              , length );
end;


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

unpacklo := (l1,l2,n,k) -> Flat(List([1..n/(2*k)], i-> [
        List([1..k], j->l1[(i-1)*k+j]),
        List([1..k], j->l2[(i-1)*k+j])
]));

unpackhi := (l1,l2,n,k) -> Flat(List([1..n/(2*k)], i -> [
        List([1..k], j->l1[n/2+(i-1)*k+j]),
        List([1..k], j->l2[n/2+(i-1)*k+j])
]));

# saturation in pack_semantic is not taken into account
pack_semantic := (l1, l2, n) -> Flat(List( [1..n], i -> [l1[i], l2[i]]));

sparams := (l,n) -> List([1..l], i->[1..n]);

shuffle := (in1, in2, p, n, k) -> Flat([
    List([1..n/(2*k)],     i->List([1..k], j->in1[(p[i]-1)*k+j])),
    List([n/(2*k)+1..n/k], i->List([1..k], j->in2[(p[i]-1)*k+j]))
]);

inverse_ushuffle := (inp, p, n) -> List([1..n], i->inp[p[i]]);

shufflehi := (in1, p, n, k) -> Concat(
    Sublist(in1, [1..n/2]),
    let(l := Sublist(in1, [n/2+1..n]), shuffle(l, l, p, n/2, k)));

shufflelo := (in1, p, n, k) -> Concat(
    let(l := Sublist(in1, [1..n/2]), shuffle(l, l, p, n/2, k)),
    Sublist(in1, [n/2+1..n]));

iclshuffle := p -> Print("_MM_SHUFFLE", When(Length(p)=2, "2", ""), "(", PrintCS(Reversed(p-1)), ")");

iclprintop := self >> Print(self.icl, "(", _vcprintcs(self.args), ")");

iperm4 := self >> Filtered(Cartesian(self.params()), i->i[1]<>i[2] and i[3] <> i[4]);

vtakehi := (v) -> Checked(IsValue(v) and IsVecT(v.t) and v.t.size>1,  TakeLast(v.v, Length(v.v)/2));
vtakelo := (v) -> Checked(IsValue(v) and IsVecT(v.t) and v.t.size>1,  Take(v.v, Length(v.v)/2));


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

################################################################################
##
#F DwG_simples(<group>,<int>,<function>) . . . . . compute simples in D^w(G)
##
InstallGlobalFunction( DwG_simples, function(G,n,w)
  local x,Zx,wx,CC,SimpleObjects,projective_characters,chi;
  CC:=List(ConjugacyClasses(G),Representative);;
  SimpleObjects:=[];
  for x in CC do
    Zx:=Centralizer(G,x);
    wx:=function(g,h) return w(g,h,x)*w(x,g,h)*(w(g,x,h)^-1); end;;
    projective_characters:=projective_reps(Zx,wx,n);
    if not(Sum(List(projective_characters,chi->chi[1]^2))=Order(Zx)) then
      Display("ERROR");
    fi;
    for chi in projective_characters do
      Append(SimpleObjects,[[x,chi,ConjugacyClass(G,x),wx,Zx]]);
    od;
  od;
  return SimpleObjects;
end );

################################################################################
##
#F DwG_S_and_T(<list>,<group>) . . . . . . . . . .compute S and T for D^w(G)
##
InstallGlobalFunction(DwG_S_and_T, function(Simples,G)
  local r,S,T,i,simple1,x,chi,Kx,betax,Zx,x_idx,Zx_Transversal,j,simple2,y,chi_prime,Ky,betay,Zy,Zy_Transversal,a,g,Zg,b,g_prime,h_prime,h,h_idx,h_prime_idx;

  r:=Length(Simples);
  S:=NullMat(r,r);;
  T:=List([1..r],i->0);
  for i in [1..r] do
    simple1:=Simples[i];
    x:=simple1[1];
    chi:=simple1[2];
    Kx:=simple1[3];
    betax:=simple1[4];
    Zx:=simple1[5];
    #x_idx:=Position(GSet,x);
    x_idx:=Position(AsSet(Zx),x);
    T[i]:=chi[x_idx]/chi[Position(AsSet(Zx),Identity(Zx))];
    Zx_Transversal:=RightTransversal(G,Zx);
    for j in [i..r] do
      simple2:=Simples[j];
      y:=simple2[1];
      chi_prime:=simple2[2];
      Ky:=simple2[3];
      betay:=simple2[4];
      Zy:=simple2[5];
      #y_idx:=Position(GSet,y);
      Zy_Transversal:=RightTransversal(G,Zy);
      for a in Zx_Transversal do
        g:=(a^-1)*x*a;
        if not(g in Kx) then
          continue;
        fi;
        Zg:=Centralizer(G,g);
        for b in Zy_Transversal do
          g_prime:=(b^-1)*y*b;
          if not((g_prime in Ky) and (g_prime in Zg)) then
            continue;
          fi;
          h_prime:=b*g*(b^-1);
          h:=a*g_prime*(a^-1);
          h_idx:=Position(AsSet(Zx),h);
          h_prime_idx:=Position(AsSet(Zy),h_prime);
          S[i][j]:=S[i][j]+betax(a,g_prime)*betax(a*g_prime,a^-1)*betay(b,g)*betay(b*g,b^-1)*(betax(a,a^-1)^-1)*(betay(b,b^-1)^-1)*chi[h_idx]*chi_prime[h_prime_idx];
        od;
      od;
      S[j][i]:=S[i][j];
    od;
  od;

  return [S,T];
end);

################################################################################
##
#F DwG_data(<group>,<function>,<int>) . . . . . compute data of D^w(G)
InstallGlobalFunction(DwG_data,function(G,w,n)
  local Simples, S_and_T, pseudounitary_data, S, T, N, FPdimC, FPdim,sorted_data;
  Simples := DwG_simples(G,n,w);;
  S_and_T := DwG_S_and_T(Simples,G);;
  S := S_and_T[1];
  T := S_and_T[2];
  pseudounitary_data := pseudounitary_sort(S,T,Simples);
  Simples := pseudounitary_data[1];
  S := pseudounitary_data[2];
  T := pseudounitary_data[3];
  FPdim := pseudounitary_data[4];
  FPdimC := pseudounitary_data[5];
  sorted_data := dimension_sort(S,T,Simples,FPdim);
  Simples := sorted_data[1];
  S := sorted_data[2];
  T := sorted_data[3];
  FPdim := sorted_data[4];
  N:=compute_fusion_rules(S,FPdimC);;
  return [Simples, S, T, N, FPdim, FPdimC];;
end);

#E DwG_data.gi . . . . . . . . . . . . . . . . . . . . . . . . . . . . ends here