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

# ==========================================================================
# IDirSum(<var>, <range>, <spl>) - Iterative direct sum.
#    Dimensions of <spl> are assumed to not depend on <var>.
# ==========================================================================
Class(IDirSum, BaseIterative, rec(
    directOper := DirectSum,
    #-----------------------------------------------------------------------
    dims := self >> let(d:=self._children[1].dimensions,
        [d[1]* self.domain, d[2]*self.domain]),
#    dims := self >> _evInt(self.unroll().dims()),
    #-----------------------------------------------------------------------
    unroll := self >> DirectSum(self.unrolledChildren()),
    #-----------------------------------------------------------------------
    transpose := self >> CopyFields(self, rec(
        _children := [self._children[1].transpose()],
        dimensions := Reversed(self.dimensions))),
    #-----------------------------------------------------------------------
    conjTranspose := self >> CopyFields(self, rec(
        _children := [self._children[1].conjTranspose()],
        dimensions := Reversed(self.dimensions))),
    #-----------------------------------------------------------------------
    inverse := self >> CopyFields(self, rec(
        _children := [self._children[1].inverse()],
        dimensions := Reversed(self.dimensions)))
));

Declare(IColDirSum, IRowDirSum);

# ==========================================================================
# IRowDirSum(<var>, <range>, <overlap>, <spl>) - Iterative direct sum.
#    Dimensions of <spl> are assumed to not depend on <var>.
# ==========================================================================
Class(IRowDirSum, BaseIterative, rec(
    directOper := RowDirectSum,
    transposeOper := self >> IColDirSum,
    abbrevs := [ (v, expr) -> [v, v.range, 0, expr] ],

    rChildren := self >> Concat([self.var, self.overlap, self._children], When(IsBound(self._setDims), [self._setDims],[])),
    rSetChild := rSetChildFields("var", "overlap", "_children", "_setDims"),

    new := meth(self, var, domain, overlap, expr)
        local res;
        Constraint(IsSPL(expr));
        Constraint(not IsInt(domain) or domain > 0);
        var.isLoopIndex := true;
        res := SPL(WithBases(self, rec(_children := [expr], var := var, domain := domain, overlap := overlap)));
        res.dimensions := res.dims();
        return res;
    end,
    #-----------------------------------------------------------------------
    print := meth(self, indent, indentStep)
        Print(self.name, "(", self.var, ", ", self.domain, ", ", self.overlap, ",");
        self._newline(indent + indentStep);
        SPLOps.Print(self._children[1], indent+indentStep, indentStep); #, ", ", self.nt_maps);
        self._newline(indent);
        Print(")");
        if IsBound(self._setDims) then
            Print(".overrideDims(", self._setDims, ")");
        fi;
    end,
    #-----------------------------------------------------------------------
    _dims := self >> self.unroll().dims(),
    dims := self >> When(IsBound(self._setDims), self._setDims, let(d := Try(self._dims()), When(d[1], d[2], [errExp(), errExp()]))),
    #-----------------------------------------------------------------------
    unroll := self >> ApplyFunc(self.directOper, [self.overlap, self.unrolledChildren()]),
    #-----------------------------------------------------------------------
    transpose := self >> ApplyFunc(self.transposeOper(), [self.var, self.domain, self.overlap, self.child(1).transpose()]),
    #-----------------------------------------------------------------------
    conjTranspose := self >> ApplyFunc(self.transposeOper(), [self.var, self.domain, self.overlap, self.child(1).conjTranspose()])
));

# ==========================================================================
# IColDirSum(<var>, <range>, <overlap>, <spl>) - Iterative direct sum.
#    Dimensions of <spl> are assumed to not depend on <var>.
# ==========================================================================
Class(IColDirSum, IRowDirSum, rec(
    directOper := ColDirectSum,
    transposeOper := self >> IRowDirSum
));

# ==========================================================================
# IterCompose(<var>, <domain>, <spl>) - iterative compose
#     <spl> must be square
# ==========================================================================
Class(IterCompose, BaseIterative, rec(
    directOper := Compose,
    #-----------------------------------------------------------------------
    dims := self >> self._children[1].dimensions,
    #-----------------------------------------------------------------------
    unroll := self >> Compose(self.unrolledChildren()),
    #-----------------------------------------------------------------------
    # NOTE: this is incorrect, one has to reverse the order
    transpose := self >> CopyFields(self, rec(
        _children := [self._children[1].transpose()],
        domain := self.domain,
        dimensions := self.dimensions))
    # NOTE: conjTranspose() is missing
));

Declare(IterVStack);

# ==========================================================================
# IterHStack(<var>, <domain>, <spl>)
#    Dimensions of <spl> are assumed to not depend on <var>.
# ==========================================================================
Class(IterHStack, BaseIterative, rec(
    directOper := HStack,
    #-----------------------------------------------------------------------
    unroll := self >> HStack(self.unrolledChildren()),
    #-----------------------------------------------------------------------
    dims := self >> [ self.child(1).dimensions[1],
                  self.child(1).dimensions[2] * self.domain ],
    #-----------------------------------------------------------------------
    transpose := self >> IterVStack(self.var, self.domain, self.child(1).transpose()),
    conjTranspose := self >> IterVStack(self.var, self.domain, self.child(1).conjTranspose())
));

# this is a HStack that is guaranteed not to perform any ops, and doesnt need ScatAcc in SumsGen
Class(IterHStack1, IterHStack);
# ==========================================================================
# IterVStack(<var>, <domain>, <spl>)
#    Dimensions of <spl> are assumed to not depend on <var>.
# ==========================================================================
Class(IterVStack, BaseIterative, rec(
    directOper := VStack,
    #-----------------------------------------------------------------------
    unroll := self >> VStack(self.unrolledChildren()),
    #-----------------------------------------------------------------------
    dims := self >> [ self.child(1).dimensions[1] * self.domain,
                  self.child(1).dimensions[2] ],
     #-----------------------------------------------------------------------
    transpose := self >> IterHStack(self.var, self.domain, self.child(1).transpose()),
    conjTranspose := self >> IterHStack(self.var, self.domain, self.child(1).conjTranspose())
));

#IterDirectSum := IDirSum;
# ==========================================================================
# IterDirectSum(<var>, <domain>, <spl>)
#    Dimensions of <spl> are assumed to not depend on <var>.
# ==========================================================================
Class(IterDirectSum, BaseIterative, rec(
    directOper := DirectSum,
    #-----------------------------------------------------------------------
    unroll := self >> DirectSum(self.unrolledChildren()),
    #-----------------------------------------------------------------------
    dims := self >> [self.child(1).dimensions[1] * self.domain, self.child(1).dimensions[2]*self.domain],
    #-----------------------------------------------------------------------
    transpose := self >> IterHStack(self.var, self.domain, self.child(1).transpose()),
    conjTranspose := self >> IterHStack(self.var, self.domain, self.child(1).conjTranspose())
));


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

################################################################################
##
#F near_group_data(<group>,<int>). . . . . . compute the data
## . . . . . . . . . . . . . . . . . . . . . for a neargroup category k=0 is TY.
##
InstallGlobalFunction(near_group_data, function(G,k)
  local Simples,m,N,rank,x,FPdimC,FPdim,S,T,g_idx,h_idx,g,h;

  if k < 0 or not(IsInt(k)) then
    Error("k must be a non-negative integer\n");
  fi;

  if k > 0 then

    Error("k > 0 is not currently supported. We need to unravel Siehler's paper 'Near-group categories\n");

    if Order(G) > k+1 then
      Error("near group categories only admit monoidal structure for |G| <= k+1");
    fi;

    if Order(G) = k+1 and not(IsCyclic(G) and Size(Set(FactorsInt(Order(G)+1))) = 1) then
      Error("for |G| = k+1, the near group category only admits monoidal structure if G  is the multiplicative group of a finite field.");
    fi;

    if Order(G) = 1 and ( (k mod 4) = 2 or (k mod 4) = 3) then
      Error("For |G| = 1, the near group category does not admit  monoidal structure if k = 2 or 3 mod 4.");
    fi;
  fi;

  Simples := ShallowCopy(AsSet(G));
  m:="m";
  Add(Simples,m);
  rank:=Size(Simples);
  N:=List([1..rank],x->NullMat(rank,rank));
  # compute the fusion rules
  for g_idx in [1..rank] do
    g:=Simples[g_idx];
    for h_idx in [1..rank] do
      h:=Simples[h_idx];
      if g_idx = rank then
        if h_idx = rank then
          # m\otimes m = Sum_{k\in G}k+km
          N[g_idx][h_idx]:=List([1..rank],x->1);
          N[g_idx][h_idx][rank] := k;
        else
          N[g_idx][h_idx][rank] := 1; # m\otimes h = m
        fi;
      else
        if h_idx = rank then
          N[g_idx][h_idx][rank] := 1; # g\otimes m = m
        else
          # g\otimes h = gh
          N[g_idx][h_idx][Position(Simples,g*h)] := 1;
        fi;
      fi;
    od;
  od;

  FPdimC := 2*Order(G);
  FPdim := List([1..rank],x->1);
  FPdim[rank] := Sqrt(Order(G));
  return [Simples, N, FPdim, FPdimC];
end);

################################################################################
##
#F TY_data(<group>,<bicharacter>,<num>,<list>,<sign>). . . . compute the data for TY(G,chi,tau,delta,Tsign)
##
InstallGlobalFunction(TY_data, function(G,chi,tau,delta,Tsign)
  local Simples,m,N,rank,x,FPdimC,FPdim,S,T,sigma1,sigma3_1,sigma3,sigma3_squared,sigma3_squared_trace,g_idx,h_idx,g,h;

  if not(IsInt(Tsign)) or Tsign^2 <> 1 then
    Error("Tsign must be +/-1");
  fi;

  if Size(delta)<>Order(G)+1 or false in List(delta,x->(IsInt(x) and x^2=1)) then
    Error("delta must be a list of length |G|+1 and consist entirely of +/- 1");
  fi;

  if (1/tau)^2 <> Order(G) then
    Error("tau must be a choice of squareroot of 1/|G|");
  fi;

  Simples := ShallowCopy(AsSet(G));
  m:="m";
  Add(Simples,m);
  rank:=Size(Simples);
  N:=List([1..rank],x->NullMat(rank,rank));
  # compute the fusion rules
  for g_idx in [1..rank] do
    g:=Simples[g_idx];
    for h_idx in [1..rank] do
      h:=Simples[h_idx];
      if g_idx = rank then
        if h_idx = rank then
          # m\otimes m = Sum_{k\in G}k+km
          N[g_idx][h_idx]:=List([1..rank],x->1);
          N[g_idx][h_idx][rank] := 0;
        else
          N[g_idx][h_idx][rank] := 1; # m\otimes h = m
        fi;
      else
        if h_idx = rank then
          N[g_idx][h_idx][rank] := 1; # g\otimes m = m
        else
          # g\otimes h = gh
          N[g_idx][h_idx][Position(Simples,g*h)] := 1;
        fi;
      fi;
    od;
  od;

  FPdimC := 2*Order(G);
  FPdim := List([1..rank],x->1);
  FPdim[rank] := Sqrt(Order(G));

  if not(IsAbelian(G) and Exponent(G)=2) then
    # not braided. Return the fusion rules and simples (arxiv:math/0011037v1)
    Display("G is not an elementary abelian 2-group and so the associated category does not admit a braiding.");
    return [Simples, N, FPdim, FPdimC];
  else
    # the category admits a braiding.
    #
    # need to compute the S-matrix and T-matrix
    #
    # First we compute T
    sigma1:=List([1..rank-1],x->delta[x]*Sqrt(chi[x][x]));
    sigma3_1:=delta[1]*Sqrt(tau*Sum(sigma1));
    T:=List([1..rank],x->0);
    for x in [1..rank-1] do
      T[x] := chi[x][x];
    od;
    T[rank]:=Tsign/sigma3_1;
    S:=NullMat(rank,rank);
    # sigma1 = sigma2 (Seihler section 2.3)
    # since delta[x] = pm1 we have sigma1[g]*sigma2[g] = chi[g][g]
    sigma3:=List([1..rank-1],x->sigma3_1*sigma1[x]*chi[x][x]);
    sigma3_squared:=List(sigma3,x->x^2);
    sigma3_squared_trace:=Sum(sigma3);
    for g in [1..rank-1] do
      for h in [1..rank-1] do
        # group elements are invertible
        #S[g][h] := chi[g][h]*chi[h][g]*FPdim[g]*FPdim[h];
        S[g][h] := chi[g][h]*chi[h][g];
      od;
      #S[g][m] := sigma1[g]*sigma2[g]*FPdim[g]*FPdim[rank];
      # group elements are invertible
      S[g][rank] := chi[g][g]*FPdim[rank];
      S[rank][g] := S[g][rank];
    od;
    S[rank][rank] := sigma3_squared_trace*FPdim[rank]*FPdim[rank];
    Display("VERIFY S and T\n");
    return [Simples,S,T,N,FPdim,FPdimC];
  fi;
end);
#E near_group_data.gi  . . . . . . . . . . . . . . . . . . . . . . . . ends here


#############################################################################
##
#W  mindeg.gi            GAP 4 package SingerAlg                Thomas Breuer
##
##  This file contains the implementation for GAP functions related to
##  the numbers <M>m(q,e)</M>.
##

#############################################################################
##
#M  SingerAlgE(  )
#M  SingerAlgE( <q>[, <n>], <z> )
##
InstallMethod( SingerAlgE,
    [ "IsSingerAlgebra" ],
    A -> CallFuncList( SingerAlgE, ParametersOfSingerAlgebra( A ) ) );

InstallMethod( SingerAlgE,
    [ "IsPosInt", "IsPosInt", "IsPosInt" ],
    { q, n, z } -> (q^n-1) / z );

InstallMethod( SingerAlgE,
    [ "IsPosInt", "IsPosInt" ],
    { q, z } -> (q^OrderMod( q, z )-1) / z );

#############################################################################
##
#M  MinimalDegreeOfSingerAlgebraGAP(  )
#M  MinimalDegreeOfSingerAlgebraGAP( <q>, <e> )
#M  MinimalDegreeOfSingerAlgebraGAP( <q>, <n>, <e> )
##
##  If the <Ref Attr="LoewyStructureInfo" Label="for a Singer algebra"/>
##  value of the Singer algebra A is known then use it.
##  If the cheap criteria suffice then take their result.
##  Otherwise call the hard method for q and e;
##  if the dimension of the algebra is small then use the algebra
##  also if just the parameters q and e are given.
##
InstallMethod( MinimalDegreeOfSingerAlgebraGAP,
    [ "IsSingerAlgebra and HasLoewyStructureInfoGAP" ],
    A -> LoewyStructureInfoGAP( A ).m );

InstallMethod( MinimalDegreeOfSingerAlgebraGAP,
    [ "IsSingerAlgebra" ],
    function( A )
    local paras, q, n, e;

    # Note that we cannot assume that the parameter 'n' is equal to
    # the multiplicative order of 'q' modulo 'e'.
    paras:= ParametersOfSingerAlgebra( A );
    q:= paras[1];
    n:= paras[2];
    e:= SingerAlgE( A );
    return MinimalDegreeOfSingerAlgebraGAP( q, OrderModExt( q, e, n ), e );
    end );

InstallMethod( MinimalDegreeOfSingerAlgebraGAP,
    [ "IsPosInt", "IsPosInt" ],
    { q, e } -> MinimalDegreeOfSingerAlgebraGAP( q, OrderMod( q, e ), e ) );

InstallMethod( MinimalDegreeOfSingerAlgebraGAP,
    [ "IsPosInt", "IsPosInt", "IsPosInt" ],
    function( q, n, e )
    local e_str, cache_e, m;

    q:= q mod e;
    e_str:= String( e );  # large integers cannot be record component names

    if not IsBound( MinimalDegreeOfSingerAlgebraCache.( e_str ) ) then
      cache_e:= rec();
      MinimalDegreeOfSingerAlgebraCache.( e_str ):= cache_e;
    else
      cache_e:= MinimalDegreeOfSingerAlgebraCache.( e_str );
      if IsBound( cache_e.( q ) ) then
        return cache_e.( q );
      fi;
    fi;

    m:= MinimalDegreeCheapGAP( q, n, e );
    if m = 0 then
      m:= MinimalDegreeHardGAP( q, n, e );
    fi;

    # Extend the cache.
    cache_e.( q ):= m;

    return m;
    end );

#############################################################################
##
#F  MinimalDegreeCheapGAP( <q>, <n>, <e> )
##
##  Return either <C>0</C> or the number <M>m( q, e )</M>,
##  which is the smallest number of powers of q
##  such that e divides the sum of these powers.
##

##  The return value <C>0</C> means that the cheap criteria from
##  the two papers  and
##  do not suffice to determine <M>m( q, e )</M>.
##

##  We assume that
##  q is smaller than e,
##  the argument n is
##  <C>OrderMod( </C>q<C>, </C>e<C> )</C>.
##  The function does not use cached values of <M>m( q, e )</M>
##  or values known via the database of low dimensional Singer algebras.
##
InstallGlobalFunction( MinimalDegreeCheapGAP, function( q, n, e )
    local e1, e2, m;

    if e = 1 then
      return 1;
    fi;

    Assert( 2, PowerMod( q, n, e ) = 1 and OrderModExt( q, e, n ) = n );

    if q = 1 then
      # Example I.6.1.
      return e;
    elif IsEvenInt( n ) and PowerModInt( q, n/2, e ) = e-1 then
      # Decide the case m = 2, see Lemma I.6.3.
      return 2;
    elif n = 2 then
      # Prop. II.2.7.
      e1:= Gcd( e, q-1 );
      e2:= Gcd( e, q+1 );
      if e2 <= e1 or ( IsEvenInt( e ) and IsEvenInt( (q^2-1)/e ) ) then
        return e1;
      else
        return 2 * e1;
      fi;
    fi;

    # Deal with those cases where e is a prime power,
    # and where we know the value of m(q,e).
    if IsPrimePowerInt( e ) then
      # Let e = p^k for a prime p.
      if e mod 2 = 0 then
        # see Prop. II.2.9, note that here we have e > 4 and q mod e <> q-1.
        if q mod 4 = 1 then
          return Gcd( e, q-1 );
        else
          Assert( 1, ( q+1 ) mod e <> 0 );
          return 4;
        fi;
      else
        # see Prop. II.2.10, note that q \equiv 1 \pmod{p}
        # if and only if \gcd( e, q-1 ) \not= 1 holds.
        m:= Gcd( e, q-1 );
        if m <> 1 then
          return m;
        elif n mod 3 = 0 then
          # Here we know that m(q,e) > 2 and thus p \not= 3.
          # Hence \gcd( e, q^{n/3}-1 ) = 1 holds,
          # because otherwise q^{n/3} would be a p-element in (Z/eZ)^*.
          # Thus Lemma I.6.4 yields m(q,e) \leq 3.
          # (This is a generalization of Cor. II.2.11.)
          return 3;
        elif 2 * n = Phi( e ) then
          # Cor. II.2.14.
          return 3;
        elif e mod 11 = 0 then
          # Prop. II.2.16.
          return 5;
        fi;
      fi;
    fi;

    # Deal with those cases where e is twice an odd prime power,
    # and where we know the value of m(q,e).
    if IsEvenInt( e ) and IsPrimePowerInt( e/2 ) then
      # see Prop. II.2.17, note that the order of q mod e is a power of p
      # if and only if \gcd( e/2, q-1 ) \not= 1 holds.
      m:= Gcd( e, q-1 );
      if m > 2 then
        return m;
      fi;
    fi;

    # We give up.
    return 0;
    end );

#############################################################################
##
#F  VectorIterator( m, n, s )
##
##  iterator for all vectors of length n
##  with entries in { 0, 1, 2, ... m }
##  and coefficient sum s, such that ...
##
##  fill the first n positions in v with smallest partition of s into
##  numbers at most m
##  (we assume that s <= m*n)
##
BindGlobal( "VectorIterator_ResetPrefix", function( v, m, n, s )
    local rest, i, j;

    rest:= s;
    i:= 1;
    while m < rest do
      v[i]:= m;
      rest:= rest - m;
      i:= i + 1;
    od;
    v[i]:= rest;
    for j in [ i+1 .. n ] do
      v[j]:= 0;
    od;

    return v;
    end );

BindGlobal( "VectorIterator", function( m, n, s )
    local next;

    if s > m*n then
      # The iterator is empty.
      next:= false;
    else
      # Initialize the coefficient vector.
      next:= VectorIterator_ResetPrefix( [], m, n, s );
    fi;

    return IteratorByFunctions( rec(
             NextIterator:= function( iter )
               local result, pos, succ;

               result:= iter!.next;
               # Find the first position with a nonzero value
               # such that the value on the right is smaller than m.
               pos:= First( [ 1 .. iter!.n - 1 ],
                            i -> result[i] <> 0 and result[ i+1 ] < iter!.m );
               if pos = fail then
                 succ:= false;
               else
                 succ:= ShallowCopy( result );
                 succ[ pos ]:= result[ pos ] - 1;
                 succ[ pos + 1 ]:= result[ pos + 1 ] + 1;
                 VectorIterator_ResetPrefix( succ, iter!.m, pos,
                                         Sum( succ{ [ 1 .. pos ] } ) );
               fi;
               iter!.next:= succ;
               return result;
             end,

             IsDoneIterator:= iter -> ( iter!.next = false ),

             ShallowCopy:= function( iter )
             end,

             m:= m,
             n:= n,
             s:= s,

             next:= next,
           ) );
    end );

#############################################################################
##
#F  MinimalDegreeHardGAP( <q>, <n>, <e> )
##
##  - assume that the cheap criteria do not yield the result
##    (e.g., m = 2 cannot occur here)
##  - assume q < e
##  - assume that n equals OrderMod( q, e )
##  - do not use the cache
##  - do not create the monomials by computing all q-adic expansions at once,
##    but create these coefficient vectors one by one, using an iterator
##  - for increasing values of m, run over those coefficient vectors
##    of length n and with entries in \{ 0, 1, \ldots, m \}
##    such that the coefficient sum is s
##    and such that a largest entry is in the first position.
##
InstallGlobalFunction( MinimalDegreeHardGAP, function( q, n, e )
    local z, e1, m, powers, a, v;

    Assert( 2, PowerMod( q, n, e ) = 1 and OrderModExt( q, e, n ) = n );

    # If A[q,n,z] has small dimension and e is not very small
    # then enumerate its basis.
    # (For small e, we known that the m values are small,
    # so it is cheaper not to enumerate.)
    if e > 100 then
      z:= ( q^n - 1 ) / e;
      if z <= 10^5 then
        return LoewyStructureInfoGAP( q, n, z ).m;
      fi;
    fi;

    # m(q,e) is divisible by \gcd( e, q-1 ), and m(q,e) \geq 3.
    e1:= Gcd( e, q-1 );
    if e1 = 1 then
      m:= 3;
    elif e1 = 2 then
      m:= 4;
    else
      m:= e1;
    fi;

    powers:= List( [ 1 .. n-1 ], i -> PowerModInt( q, i, e ) );

    while true do
      for a in [ 1 .. m ] do
        for v in VectorIterator( a, n-1, m-a ) do
          if ( a + v * powers ) mod e = 0 then
            return m;
          fi;
        od;
      od;
      m:= m + e1;
    od;
    end );

#############################################################################
##
#M  MinimalDegreeOfSingerAlgebraJulia(  )
#M  MinimalDegreeOfSingerAlgebraJulia( <q>, <e> )
#M  MinimalDegreeOfSingerAlgebraJulia( <q>, <n>, <e> )
##
##  Use the same criteria as for the &GAP; variant.
##  These methods are available only if &Julia; is available.
##
if IsPackageMarkedForLoading( "JuliaInterface", "" ) then

InstallMethod( MinimalDegreeOfSingerAlgebraJulia,
    [ "IsSingerAlgebra and HasLoewyStructureInfoJulia" ],
    A -> JuliaToGAP( IsInt,
             Julia.Base.get( LoewyStructureInfoJulia( A ),
                             JuliaSymbol( "m" ), 0 )  ));

InstallMethod( MinimalDegreeOfSingerAlgebraJulia,
    [ "IsSingerAlgebra" ],
    function( A )
    local paras, q, n, e;

    # Note that we cannot assume that the parameter 'n' is equal to
    # the multiplicative order of 'q' modulo 'e'.
    paras:= ParametersOfSingerAlgebra( A );
    q:= paras[1];
    n:= paras[2];
    e:= SingerAlgE( A );

    # Supply 'A' as an argument in order to set the GAP attribute.
    return JuliaToGAP( IsInt,
               Julia.SingerAlg.MinimalDegree( q, OrderModExt( q, e, n ), e,
                                              A ) );
    end );

InstallMethod( MinimalDegreeOfSingerAlgebraJulia,
    [ "IsPosInt", "IsPosInt" ],
    { q, e } -> JuliaToGAP( IsInt,
                    Julia.SingerAlg.MinimalDegree( q, GAPToJulia( e ) ) ) );

InstallMethod( MinimalDegreeOfSingerAlgebraJulia,
    [ "IsPosInt", "IsPosInt", "IsPosInt" ],
    { q, n, e } -> JuliaToGAP( IsInt,
               Julia.SingerAlg.MinimalDegree( q, n, GAPToJulia( e ) ) ) );

fi;

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


#
# walrus: Computational Methods for Finitely Generated Monoids and Groups
#

InstallGlobalFunction(NewPregroupWord,
function(pg, word)
    local maxk, rel;
    maxk := MaxPowerK(word);
    return Objectify(IsPregroupRelatorType,
                     rec( pregroup := pg
                        , base := maxk[1]
                        , exponent := maxk[2]
                        , baselen := Length(maxk[1]) ) );
end);

InstallGlobalFunction(NewPregroupRelator,
function(pres, word, id)
    local maxk, rel;
    maxk := MaxPowerK(word);
    rel := Objectify(IsPregroupRelatorType,
                     rec( pres := pres
                        , base := maxk[1]
                        , exponent := maxk[2]
                        , baselen := Length(maxk[1])
                        , __ID := id)
                    );
    return rel;
end);

InstallMethod(Base, "for a pregroup relator",
              [IsPregroupRelator and IsPregroupRelatorRep ],
              r -> r!.base);

InstallMethod(Exponent, "for a pregroup relator",
              [IsPregroupRelator and IsPregroupRelatorRep ],
              r -> r!.exponent);

InstallMethod(Inverse, "for a pregroup relator",
              [ IsPregroupRelator and IsPregroupRelatorRep ],
              r -> Objectify(IsPregroupRelatorType,
                             rec( pres := r!.pres
                                , base := List(Reversed(r!.base), PregroupInverse)
                                , exponent := r!.exponent
                                , baselen := r!.baselen
                                , __ID := -r!.__ID)
                            ));
InstallMethod(PregroupPresentationOf,
              "for pregroup relators",
              [IsPregroupRelator],
              r -> r!.pres);

InstallMethod(Locations, "for a pregroup relator",
              [IsPregroupRelator],
function(r)
    return List([1..r!.baselen], i -> NewLocation(r, i));
end);

InstallMethod(\[\], "for a pregroup relator",
              [IsPregroupRelator and IsPregroupRelatorRep, IsInt],
function(r, p)
    local i, l;
    i := RemInt(p - 1, r!.baselen);
    if i < 0 then
        i := i + r!.baselen;
    fi;
    return r!.base[i + 1];
end);

InstallMethod(Length, "for a pregroup relator",
    [ IsPregroupRelator and IsPregroupRelatorRep ],
function(r)
    return r!.baselen * r!.exponent;
end);

# we could possibly store this on creation
# But this is run at most once anyway
InstallMethod(Places, "for a pregroup relator",
              [ IsPregroupRelator and IsPregroupRelatorRep ],
function(r)
    local P, res;

    res := [];

    for P in Places(PregroupPresentationOf(r)) do
        if Relator(P) = r then
            Add(res, P);
        fi;
    od;
    return res;
end);

InstallMethod(ViewString, "for a pregroup relator",
    [IsPregroupRelator],
function(r)
    if Exponent(r) > 1 then
        return STRINGIFY("<pregroup relator ("
                        , List(r!.base, ViewString)
                        , ")^", r!.exponent, ">");
    else
        return STRINGIFY("<pregroup relator "
                        , List(r!.base, ViewString)
                        , ">");
    fi;
end);

InstallMethod(IsBound\[\], "for a pregroup relator, and an position",
              [IsPregroupRelator, IsInt], ReturnTrue );

InstallMethod(\=, "for a pregroup relator, and a pregroup relator",
              [IsPregroupRelator, IsPregroupRelator],
function(l,r)
    # id is uniqe wrt pregroup presentation. We should probably
    # make a family of relators for each presentation etc
    return l!.__ID = r!.__ID;
    return (l!.exponent = r!.exponent)
           and (l!.base = r!.base);
end);

InstallMethod(\in, "for a generator and a pregroup relator",
              [ IsElementOfPregroup, IsPregroupRelator and IsPregroupRelatorRep],
function(e,r)
    return e in r!.base;
end);

#T redo and move to pregroup files
InstallGlobalFunction(ReduceUPregroupWord,
function(word)
    local rw, rw2, i, j, one;

    if Length(word) = 0 then
        return [];
    fi;

    one := PregroupOf(word[1])[1];
    rw := ShallowCopy(word);

    for i in [2..Length(rw)] do
        if rw[i-1] * rw[i] <> fail then
            rw[i] := rw[i-1] * rw[i];
            rw[i-1] := one;
        fi;
    od;

    i := 1; j := 1;
    rw2 := [];
    while i <= Length(rw) do
        if rw[i] <> one then
            rw2[j] := rw[i];
            j := j + 1;
        fi;
        i := i + 1;
    od;

    return rw2;
end);


MEMO_Base64Digits :=
  "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz-_";

InstallGlobalFunction(MEMO_Digits,
function(n, base, args...)
  local minlen, len, digits, str;
  # Adapted from the DigitsNumber function in GAPDoc-1.6.1
  if Length(args) = 0 then
    minlen := 0;
  elif Length(args) = 1 then
    minlen := args[1];
  else
    return fail;
  fi;
  digits := MEMO_Base64Digits;
  str := "";
  while n <> 0 do
    Add(str, digits[(n mod base) + 1]);
    n := QuoInt(n, base);
  od;
  if Length(str) < minlen then
    # Pad with zeroes
    Append(str, ListWithIdenticalEntries(minlen - Length(str), digits[1]));
  fi;
  return Reversed(str);
end);

InstallGlobalFunction(MEMO_Hash,
function(key)
  local str, ints, sum, i;
  IO_ClearPickleCache();  # In case IO_Pickle was recently interrupted
  str := IO_Pickle(key);  # Pickle the key to a string
  ints := SHA256String(str);  # Get the SHA-256 checksum in 32-bit chunks
  sum := 0;  # Bring all 256 bits together into a single integer
  for i in [1..Length(ints)] do
    sum := sum + ints[i] * 2 ^ (32 * (i-1));
  od;
  str := MEMO_Digits(sum, 64, 43);  # Make into a padded base-64 string
  return str;
end);


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

Declare(OLCompose);

Class(OLCompose, Compose, rec(
    printSeparationChar := " o ",
    toOperator := self >> (vec -> Checked(Length(vec)=self.dims()[2], OLCompose(DropLast(self._children, 1)).toOperator()(Last(self._children).toOperator()(vec))))
));

Class(LinearSystem,  BaseMat, rec(
    abbrevs := [ (A, b) -> [A, b] ],
    new := (self, A, b) >> SPL(WithBases(self, rec(
        mat := A, rhs := b, dimensions := [Rows(A), Cols(A)]))),
    print := (self, i, is) >> Print("LinearSystem(", self.mat, ", ", self.rhs, ")"),
    dims  := self >> self.dimensions,
    rChildren := self >> [self.mat, self.rhs],
    rSetChild := rSetChildFields("mat", "rhs"),
    isReal := True
));

Class(Reduction,  BaseMat, rec(
    abbrevs := [ (N, op, idval, isSaturated) -> [N, op, idval, isSaturated] ],
    new := (self, N, op, idval, isSaturated) >> SPL(WithBases(self, rec(
        N := N, op := op, idval := idval, isSaturated := isSaturated, dimensions := [1, N]))),
    print := (self, i, is) >> Print("Reduction(", self.N, ", ", self.op, ", ", self.idval, ", ", self.isSaturated, ")"),
    dims  := self >> self.dimensions,
    rChildren := self >> [self.N, self.op, self.idval, self.isSaturated],
    rSetChild := rSetChildFields("N", "op", "idval", "isSaturated"),
    transpose := self >> self,
    isReal := True,
    toOperator := self >> (vec -> Checked(Length(vec)=self.dims()[2], [RulesStrengthReduce(FoldL(vec, self.op, self.idval)).v]))
));

Class(Induction,  BaseMat, rec(
    abbrevs := [ (N, op, initval) -> [N, op, initval] ],
    new := (self, N, op, initval) >> SPL(WithBases(self, rec(
        N := N, op := op, initval := initval, dimensions := [N, 1]))),
    print := (self, i, is) >> Print("Induction(", self.N, ", ", self.op, ", ", self.initval, ")"),
    dims  := self >> self.dimensions,
    rChildren := self >> [self.N, self.op, self.initval],
    rSetChild := rSetChildFields("N", "op", "initval"),
    isReal := True,
    recurrence := self >> ((j,v)->When(j=0, self.initval, self.op.at(self.recurrence()(j-1,v),v))),
    toOperator := self >> (vec -> Checked(Length(vec)=self.dims()[2], List([0..self.N-1], i->_unwrap(RulesStrengthReduce(self.recurrence()(i,vec[1]))))))
));

Class(PointWise, BaseMat, rec(
    abbrevs := [ (N, op) -> [N, op] ],
    new := (self, N, op) >> SPL(WithBases(self, rec(
        N := N, op := op, dimensions := [N, N]))),
    print := (self, i, is) >> Print("PointWise(", self.N, ", ", self.op, ")"),
    dims  := self >> self.dimensions,
    rChildren := self >> [self.N, self.op],
    rSetChild := rSetChildFields("N", "op"),
    transpose := self >> self,
    isReal := True,
    toOperator := self >> (vec -> Checked(Length(vec)=self.dims()[2], List([0..Length(vec)-1], j->RulesStrengthReduce(self.op.at(vec[j+1], j)).v)))
));

Class(BinOp, BaseMat, rec(
    abbrevs := [ (N, op) -> [N, op] ],
    new := (self, N, op) >> SPL(WithBases(self, rec(
        N := N, op := op, dimensions := [N, 2*N]))),
    print := (self, i, is) >> Print("BinOp(", self.N, ", ", self.op, ")"),
    dims  := self >> self.dimensions,
    rChildren := self >> [self.N, self.op],
    rSetChild := rSetChildFields("N", "op"),
    isReal := True,
    toOperator := self >> (vec -> Checked(Length(vec)=self.dims()[2], List([1..Length(vec)/2], j->RulesStrengthReduce(self.op.at(vec[j], vec[j+self.N])).v)))
));

Class(ScalarProd,  BaseMat, rec(
    abbrevs := [ (N, scalars) -> [N, scalars] ],
    new := (self, N, scalars) >> SPL(WithBases(self, rec(
        N := N, scalars := scalars, dimensions := [1, N]))),
    print := (self, i, is) >> Print("ScalarProd(", self.N, ", ", self.scalars, ")"),
    dims  := self >> self.dimensions,
    rChildren := self >> [self.N, self.scalars],
    rSetChild := rSetChildFields("N", "scalars"),
    isReal := True,
    toOperator := self >>(vec -> Checked(Length(vec)=self.dims()[2], [_unwrapVec(self.scalars) * vec]))
));

Class(Constant, BaseMat, rec(
    abbrevs := [ x -> [x]],
    new := (self, x) >> SPL(WithBases(self, rec(
    value := x, dimensions := [1,0]))),
    print := (self, i ,is) >> Print("Constant(",self.value,")"),
    dims := self >> self.dimensions,
    rChildren := self >> [self.value],
    rSetChild := rSetChildFields("value"),
    isReal := True
));

spiral.spl.IterVStack.toOperator :=
  self >> (vec -> Checked(Length(vec)=self.dims()[2],
                     Flat(List([0..self.var.range-1],
                        j->RulesStrengthReduce(
                               SubstVars(Copy(self._children[1]),
                                         rec((self.var.id):=V(j))
                               )
                           ).toOperator()(vec) )
                     )
                  )
          );

spiral.spl.HStack.toOperator :=
   self >> (vec -> Checked(Length(vec)=self.dims()[1]*Length(self.children()),
      	   	      Sum(List([1..Length(self.children())],
	                 i->self.children()[i].toOperator()(vec{[(i-1)*self.dims()[1] + 1..i*self.dims()[1]]})
		      ))
	 	   )
           );

spiral.spl.DirectSum.toOperator := self >> (vec -> Checked(Length(vec)=Sum(List(self.children(), i->i.dims()[2])),
    ApplyFunc(Concat, List([1..Length(self.children())],
        i->self.children()[i].toOperator()(vec{
            [Sum(List(self.children(){[1..i-1]}, j->j.dims()[2]))+1..Sum(List(self.children(){[1..i]}, j->j.dims()[2]))]
            })))));

spiral.spl.I.N := self >> self.params[1];


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

ImportAll(paradigms.smp); # for AParSMP
ImportAll(paradigms.vector); # for VRCLR
Import(approx); # for CeilingRat.

_swrap := (nt) -> let(t:=nt.firstTag(), ScratchWrap(t.size,t.nsgmts,t.linesize));

_nodeFitsTensorDoesnt := (nt) -> let (
    k := nt.getTag(1).size,
    m := nt.params[1].dims()[2],
    n := nt.params[2],

    2*m <= k and m*n >= k
);

_isALStoreTag := (nt) -> nt.isTag(1,ALStore) or nt.isTag(1,ALStoreCx);

NewRulesFor(TTensorI, rec(
#   (In x Am)_{LS(<=k)} -> In x (Am)_{LS(<=k)} for m > k
    IxA_scratch_push := rec(
        forTransposition := false,
        applicable := nt -> nt.hasTags()
            and _isALStoreTag(nt)
            and IsParPar(nt.params)
            and nt.params[1].dims()[2] > nt.getTag(1).size,

        children := nt -> [[ nt.params[1].withTags(nt.getTags()) ]],
        apply := (nt, c, cnt) -> Tensor(I(nt.params[2]), c[1])
    ),

    AxI_scratch_push := rec(
        forTransposition := false,
        applicable := nt -> nt.hasTags()
            and _isALStoreTag(nt)
            and IsVecVec(nt.params)
            and nt.params[1].dims()[2] > nt.getTag(1).size,
        children := nt -> [[nt.params[1].withTags(nt.getTags())]],
        apply := (nt, c, cnt) -> Tensor(c[1], I(nt.params[2]))
    ),

#   ==========================================================
# synchronous rules

#   (In x Am)_{LS(<=k)} -> Imn/k x (Ik/m x Am) for m|k and k|mn
   IxA_scratch := rec(
        forTransposition := false,
        applicable := nt -> nt.hasTags()
            and _isALStoreTag(nt)
	        and IsParPar(nt.params)
            and IsPosInt(nt.getTag(1).size / nt.params[1].dims()[2])
            and IsPosInt(nt.params[1].dims()[2] * nt.params[2] / nt.getTag(1).size),

        children := nt -> [[
            TTensorI(
                nt.params[1],
                nt.getTag(1).size / nt.params[1].dims()[2],
                APar, APar
            ).withTags(Drop(nt.getTags(),1)).setWrap(
                _swrap(nt)
            )
        ]],
        apply := (nt, c, cnt) -> let(k := nt.getTag(1).size,  m := nt.params[1].dims()[2], n:= nt.params[2],
                DMAFence(Tensor(
                    I(m*n/k),
                    LSKernel(c[1], nt.params[1].normalizedArithCost() * k/m)
                )))
    ),

#   (Am x In)_{LS(<=k)} -> (L^m^2n/k_m x Ik/m) (Imn/k x (Am x Ik/m)) (L^m^2n/k_mn/k x Ik/m) for m|k and k|mn
    AxI_scratch := rec(
        forTransposition := false,
        applicable := nt -> nt.hasTags()
                            and _isALStoreTag(nt)
	                        and IsVecVec(nt.params)
                            and IsPosInt(nt.getTag(1).size / nt.params[1].dims()[2])
                            and IsPosInt(nt.params[1].dims()[2]*nt.params[2] / nt.getTag(1).size),

        children := nt -> [[ let(t := nt.firstTag(),
            TTensorI(
                nt.params[1],
                t.size / nt.params[1].dims()[2],
                AVec, AVec
            ).withTags(Drop(nt.getTags(),1)).setWrap(_swrap(nt))
        ) ]],

        apply := (nt, c, cnt) -> let(
            k := nt.getTag(1).size,
            m := nt.params[1].dims()[2],
            n:= nt.params[2],

            DMAFence(Prm(fTensor(L(m^2*n/k, m), fId(k/m))) *
            Tensor(
                I(m*n/k),
                LSKernel(c[1], nt.params[1].normalizedArithCost() * k/m)
            ) *
            Prm(fTensor(L(m^2*n/k, m*n/k), fId(k/m))))
        )
    ),

    IxAL_scratch := rec(
        forTransposition := false,
        applicable := nt -> nt.hasTags()
                            and _isALStoreTag(nt)
                            and IsParVec(nt.params)
                            and IsPosInt(nt.getTag(1).size/ nt.params[1].dims()[2])
                            and IsPosInt(nt.params[1].dims()[2]*nt.params[2]/nt.getTag(1).size),
        children := nt -> let(
            k := nt.firstTag().size,
            m := nt.params[1].dims()[2],

            [[ TTensorI(
                nt.params[1],
                k/m,
                APar,AVec
            ).withTags(Drop(nt.getTags(),1)).setWrap(_swrap(nt))
        ]]),

        apply := (self, nt, c, cnt) >> let(
            k := nt.getTag(1).size,
            m := nt.params[1].dims()[2],
            n := nt.params[2],

            DMAFence(
                Tensor(
                    I(m*n/k),
                    LSKernel(c[1],nt.normalizedArithCost() * k/m)
                ) *
                Prm(fTensor(L(m^2*n/k,m*n/k),fId(k/m)))
            )
        ),
    ),

    L_IxA_scratch :=  rec(
        forTransposition := false,
        applicable := nt -> nt.hasTags()
            and _isALStoreTag(nt)
	        and IsVecPar(nt.params),

        children := nt -> [[
            TTensorI(
                nt.params[1],
                nt.getTag(1).size / nt.params[1].dims()[2],
                AVec, APar
            ).withTags(Drop(nt.getTags(),1)).setWrap(
                _swrap(nt)
            )
        ]],

        apply := (self, nt, c, cnt) >> let(
            k := nt.getTag(1).size,
            m := nt.params[1].dims()[2],
            n:= nt.params[2],

            DMAFence(
                Prm(fTensor(L(m^2*n/k, m*n/k), fId(k/m))
                ) * Tensor(LSKernel(
                    c[1], nt.normalizedArithCost() * k/m
                ), I(m*n/k))
            )
        )
     ),
#====================================================================
# SWP Rules - double buffering is applied
   IxA_scratch_swp := rec(
        forTransposition := false,
        applicable := nt -> nt.hasTags()
            and _isALStoreTag(nt)
	        and IsParPar(nt.params)
            and IsPosInt(nt.getTag(1).size / (2 * nt.params[1].dims()[2]))
            and IsPosInt(2 * nt.params[1].dims()[2] * nt.params[2] / nt.getTag(1).size),

        children := nt -> [[
            TTensorI(
                nt.params[1],
                nt.getTag(1).size / (2 * nt.params[1].dims()[2]),
                APar, APar
            ).withTags(Drop(nt.getTags(),1)).setWrap(
                _swrap(nt)
            )
        ]],
        apply := (nt, c, cnt) -> let(k := nt.getTag(1).size,  m := nt.params[1].dims()[2], n:= nt.params[2],
                DMAFence(Tensor(
                    I(2*m*n/k),
                    LSKernel(c[1], nt.params[1].normalizedArithCost() * k/(2*m))
                )))
    ),

    AxI_scratch_swp := rec(
        forTransposition := false,
        applicable := nt -> nt.hasTags()
                            and _isALStoreTag(nt)
	                        and IsVecVec(nt.params)
                            and IsPosInt(nt.getTag(1).size / (2*nt.params[1].dims()[2]))
                            and IsPosInt(2*nt.params[1].dims()[2]*nt.params[2] / nt.getTag(1).size),

        children := nt -> [[ let(t := nt.firstTag(),
            TTensorI(
                nt.params[1],
                t.size / (2*nt.params[1].dims()[2]),
                AVec, AVec
            ).withTags(Drop(nt.getTags(),1)).setWrap(_swrap(nt))
        ) ]],

        apply := (nt, c, cnt) -> let(
            k := nt.getTag(1).size,
            m := nt.params[1].dims()[2],
            n:= nt.params[2],

            DMAFence(Prm(fTensor(L(2*m^2*n/k, 2*m), fId(k/(2*m)))) *
            Tensor(
                I(2*m*n/k),
                LSKernel(c[1], nt.params[1].normalizedArithCost() * k/(2*m))
            ) *
            Prm(fTensor(L(2*m^2*n/k, 2*m*n/k), fId(k/(2*m)))))
        )
    ),

    IxAL_scratch_swp := rec(
        forTransposition := false,
        applicable := nt -> nt.hasTags()
                            and _isALStoreTag(nt)
                            and IsParVec(nt.params)
                            and IsPosInt(nt.getTag(1).size/ (2*nt.params[1].dims()[2]))
                            and IsPosInt(2*nt.params[1].dims()[2]*nt.params[2]/nt.getTag(1).size),
        children := nt -> let(
            k := nt.firstTag().size,
            m := nt.params[1].dims()[2],

            [[ TTensorI(
                nt.params[1],
                k/(2*m),
                APar,AVec
            ).withTags(Drop(nt.getTags(),1)).setWrap(_swrap(nt))
        ]]),

        apply := (self, nt, c, cnt) >> let(
            k := nt.getTag(1).size,
            m := nt.params[1].dims()[2],
            n := nt.params[2],

            DMAFence(
                Tensor(
                    I(2*m*n/k),
                    LSKernel(c[1],nt.normalizedArithCost() * k/(2*m))
                ) *
                Prm(fTensor(L(2*m^2*n/k,2*m*n/k),fId(k/(2*m))))
            )
        ),
    ),

    L_IxA_scratch_swp :=  rec(
        forTransposition := false,
        applicable := nt -> nt.hasTags()
            and _isALStoreTag(nt)
	        and IsVecPar(nt.params)
            and IsPosInt(nt.getTag(1).size/ (2*nt.params[1].dims()[2]))
            and IsPosInt(2*nt.params[1].dims()[2]*nt.params[2]/nt.getTag(1).size),

        children := nt -> [[
            TTensorI(
                nt.params[1],
                nt.getTag(1).size / (2*nt.params[1].dims()[2]),
                AVec, APar
            ).withTags(Drop(nt.getTags(),1)).setWrap(
                _swrap(nt)
            )
        ]],

        apply := (self, nt, c, cnt) >> let(
            k := nt.getTag(1).size,
            m := nt.params[1].dims()[2],
            n:= nt.params[2],

            DMAFence(
                Prm(fTensor(L(2*m^2*n/k, 2*m*n/k), fId(k/(2*m)))
                ) * Tensor(LSKernel(
                    c[1], nt.normalizedArithCost() * k/(2*m)
                ), I(2*m*n/k))
            )
        )
     )
));


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

NewRulesFor(TRaderMid, rec(
    Pad_vec := rec(
        applicable := (self, t) >> t.isTag(1, AVecReg) or t.isTag(1, AVecRegCx),
        forTransposition := false,
        apply := (t, C, Nonterms) -> let(
            v := t.firstTag().v,
            ds := Rows(t)-1,
            When(IsInt(ds/v),
                DelayedDirectSum(VScat_sv(fId(1), v , 1), I(ds))
                * VecRaderMid(t.params[1], t.params[2], t.params[3], v)
                * DelayedDirectSum(VGath_sv(fId(1), v , 1), I(ds)),
                DelayedDirectSum(VScat_sv(fId(1), v , 1), VScat_sv(fId(ds), v, 1))
                * VecRaderMid(t.params[1], t.params[2], t.params[3], v)
                * DelayedDirectSum(VGath_sv(fId(1), v , 1), VGath_sv(fId(ds), v, 1))
            )
        )
    )
));


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

Class(UTwid, DiagFunc, rec(
    def := (N, n, k, a, b, i) -> rec(size:=n),
    lambda := self >> let(N:=self.params[1], n:=self.size, k:=self.params[3],
	a := self.params[4], b := self.params[5], i := self.params[6],
	na := Numerator(a),   nb := Numerator(b),
	da := Denominator(a), db := Denominator(b),
	w := E(N*da*db)^k, j := Ind(n),
	Lambda(j, cond(eq(j,n/2), omega(da*db,k), omega(N*da*db, k*(i*da+na)*(j*db+nb)))))
));
Class(UTwid1, DiagFunc, rec(
    def := (N, n, k, a, b, i) -> rec(size:=n),
    lambda := self >> let(N:=self.params[1], n:=self.size, k:=self.params[3],
	a := self.params[4], b := self.params[5], i := self.params[6],
	na := Numerator(a),   nb := Numerator(b),
	da := Denominator(a), db := Denominator(b),
	w := E(N*da*db)^k, j := Ind(n),
	Lambda(j, cond(eq(j,n/2), 1, omega(N*da*db, k*(i*da+na)*(j*db+nb)))))
));

Class(UDFT_NonTerm, DFT_NonTerm, rec(
    isReal := False,
));

Class(UDFT, UDFT_NonTerm, rec(
   abbrevs := [
    (n)    -> Checked(IsPosIntSym(n), AnySyms(n) or (n mod 2=0), [n, 1]),
    (n,k)  -> Checked(IsPosIntSym(n), AnySyms(n) or (n mod 2=0),
	              IsIntSym(k), AnySyms(n,k) or Gcd(n,k)=1,
		      [n, When(AnySyms(n,k), k, k mod n)]) ],
   omega4pow := (r,c)->4*r*c,
   terminate := self >> let(
	n:=self.params[1], k:=self.params[2], m:=MatSPL(DFT(2))^-1,
	DirectSum(Mat(m), I(n-2))^L(n,n/2) *
	DFT(n,k).terminate()),

   conjTranspose := self >> ObjId(self)(self.params[1], -self.params[2]).transpose()
));
UDFT1 := UDFT;

Class(UDFT2, UDFT_NonTerm, rec(
   abbrevs := [
    (n)    -> Checked(IsPosIntSym(n), AnySyms(n) or (n mod 2=0), [n, 1]),
    (n,k)  -> Checked(IsPosIntSym(n), AnySyms(n) or (n mod 2=0),
	              IsIntSym(k), AnySyms(n,k) or Gcd(n,k)=1,
		      [n, When(AnySyms(n,k), k, k mod (2*n))]) ],
    omega4pow := (r,c)->2*r*(2*c+1),
    terminate := self >> let(
	n:=self.params[1], k:=self.params[2], m:=MatSPL(DFT2(2,k))^-1,
	DirectSum(Mat(m), I(n-2))^L(n,n/2) *
	DFT2(n,k).terminate()),
));

Class(UUDFT, UDFT_NonTerm, rec(
   abbrevs := [
    (n)    -> Checked(IsPosIntSym(n), AnySyms(n) or (n mod 4=0), [n, 1]),
    (n,k)  -> Checked(IsPosIntSym(n), AnySyms(n) or (n mod 4=0),
	              IsIntSym(k), AnySyms(n,k) or Gcd(n,k)=1,
		      [n, When(AnySyms(n,k), k, k mod n)]) ],
    omega4pow := (r,c)->4*r*c,
    terminate := self >> let(
	n:=self.params[1], k:=self.params[2], m:=MatSPL(DFT(2))^-1,
	DirectSum(Mat(m), I((n-4)/2), Mat(m), I((n-4)/2))^L(n,n/2) *
	DFT(n,k).terminate()),
));
UUDFT1 := UUDFT;

Class(UUDFT2, UDFT_NonTerm, rec(
   abbrevs := [
    (n)    -> Checked(IsPosIntSym(n), AnySyms(n) or (n mod 4=0), [n, 1]),
    (n,k)  -> Checked(IsPosIntSym(n), AnySyms(n) or (n mod 4=0),
	              IsIntSym(k), AnySyms(n,k) or Gcd(n,k)=1,
		      [n, When(AnySyms(n,k), k, k mod (2*n))])  ],
    omega4pow := (r,c)->2*r*(2*c+1),
    terminate := self >> let(
	n:=self.params[1], k:=self.params[2], m:=MatSPL(DFT2(2,k))^-1,
	DirectSum(Mat(m), I((n-2)/2), Mat(m), I((n-2)/2))^L(n,n/2) *
	DFT2(n,k).terminate()),
));


#!/usr/bin/gap

# time gap -o 8g clifford.gap

# Build clifford groups, up to 3 qubits, and
# search for T operators defined by field extensions......

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

# See:
# https://www.mathstat.dal.ca/~selinger/papers/clifford.pdf

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

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

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

for U in Cliff1 do
    found := false;;
    #Udag := Inverse(U);
    #Print("found? ");
    for g in Pauli1 do
        if (U*g*Inverse(U)*Inverse(g) in Pauli1)  then found:=true; break; fi;
    od;
    if not found then Print("Not found\n"); fi;
od;

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

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

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

# Works:
for U in Cliff2 do
    found := false;;
    #Udag := Inverse(U);
    #Print("found? ");
    for g in Pauli2 do
        if (U*g*Inverse(U)*Inverse(g) in Pauli2)  then found:=true; break; fi;
    od;
    if not found then Print("Not found\n"); fi;
od;

a := [
    [0, 1, 0, 0],
    [0, 0, 1, 0],
    [0, 0, 0, 1],
    [-1, 0, 0, 0]];; # a in G2 = true

#Print(a*a, "\n");
#Print(a*a*a, "\n");
#Print(a*a*a*a, "\n");

# Print(Order(G2));

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

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

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

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

wii := KroneckerProduct(wi, i);;

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

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

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

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

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

Cliff3 := Group(sii, isi, iis, hii, ihi, iih, wii, icz, czi);; # Order 743178240
Pauli3 := Group(wii, xii, ixi, iix, zii, izi, iiz);; # Order 256

# Print(Order(Pauli3), "\n");;

# ca in Cliff3 = false
# ca in third level of clifford hierarchy = true

Cliff3_12 := Group(sii, isi, hii, ihi, wii, czi);;
Cliff3_13 := Group(sii, iis, hii, iih, wii);; # cz on 1&3 ??
Cliff3_23 := Group(isi, iis, ihi, iih, wii, icz);;

#SmCliff3 := Group(sii, isi, iis, hii, ihi, iih, icz, czi);; # Order 743178240

Print("warming up...\n");
Order(Cliff3);; # need this line otherwise membership test eats all memory...!
Print("Ok\n");

in_third_level := function(U)
    # Is U in the third level of the clifford hierarchy ?
    local A;
    for g in Pauli3 do
        A := U*g*Inverse(U)*Inverse(g);
        if A in Cliff3_12 then continue; fi;
        if A in Cliff3_13 then continue; fi;
        if A in Cliff3_23 then continue; fi;
        if A in Cliff3 then continue; fi;
        return false; # no
    od;
    return true; # yes
end;;

Print("in_third_level(ca):", in_third_level(ca), "\n"); # true
Print("in_third_level(cb):", in_third_level(cb), "\n"); # true
Print("in_third_level(cc):", in_third_level(cc), "\n"); # true
Print("in_third_level(Tofolli):", in_third_level(Tofolli), "\n"); # true
Print("in_third_level(Tofolli*ca):", in_third_level(Tofolli*ca), "\n"); # false

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

Print("# Where do control control 1-qubit Pauli gates live ?\n");
for g in Pauli1 do
    #Print(g, "\n");
    U3{[7,8]}{[7,8]} := g;
    if U3 in Pauli3 then Print("1\c"); continue; fi;
    if U3 in Cliff3 then Print("2\c"); continue; fi;
    if in_third_level(U3) then Print("3\c"); else Print(".\c"); fi;
od;
Print("\n");

Print("# Where do control control 1-qubit clifford gates live ?\n");
for g in Cliff1 do
    #Print(g, "\n");
    U3{[7,8]}{[7,8]} := g;
    if U3 in Pauli3 then Print("1\c"); continue; fi;
    if U3 in Cliff3 then Print("2\c"); continue; fi;
    if in_third_level(U3) then Print("3\c"); else Print(".\c"); fi;
od;
Print("\n");

Print("# Where do control 2-qubit Pauli gates live ?\n");
for g in Pauli2 do
    #Print(g, "\n");
    U3{[5,6,7,8]}{[5,6,7,8]} := g;
    if U3 in Pauli3 then Print("1\c"); continue; fi;
    if U3 in Cliff3 then Print("2\c"); continue; fi;
    if in_third_level(U3) then Print("3\c"); else Print(".\c"); fi;
od;
Print("\n");

Print("# Where do control 2-qubit clifford gates live ?\n");
for g in Cliff2 do
    #Print(g, "\n");
    U3{[5,6,7,8]}{[5,6,7,8]} := g;
    if U3 in Pauli3 then Print("1\c"); continue; fi;
    if U3 in Cliff3 then Print("2\c"); continue; fi;
    if in_third_level(U3) then Print("3\c"); else Print(".\c"); fi;
od;

Print("\n");

Print("Done.\n");


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

Declare(GT);
Declare(ListProduct);

ListProduct := function(l)
    local prod, i;
    if Length(l) <=0 then return 0; fi;
    prod := 1;
    for i in l do
      prod := prod * i;
    od;
    return(prod);
end;

GTVec := XChain([0,1]);
GTPar := XChain([1,0]);

TTensorI_GT := function(gt)
    local spl, g, s, v, tags;
    [spl,g,s,v] := gt.params;
    tags := gt.getTags();
    Constraint(IsList(v) and Length(v)=1 and IsPosInt(v[1]));
    g := When(g=XChain([0,1]), AVec, APar);
    s := When(s=XChain([0,1]), AVec, APar);
    return TTensorI(spl, v[1], s, g).withTags(tags);
end;

GT_TTensorI := function(tt)
    local spl, g, s, v, tags;
    [spl,v,s,g] := tt.params;
    tags := tt.getTags();
    g := When(g=AVec, GTVec, GTPar);
    s := When(s=AVec, GTVec, GTPar);
    return GT(spl, g, s, [v]).withTags(tags);
end;

IsGT := x -> IsRec(x) and IsBound(x.isGT) and x.isGT;

Class(GTBase, rec(
    isGT := true,

    freeTags := self >> Filtered(self.tags, x -> not x.isSticky),
    stickyTags := self >> Filtered(self.tags, x -> x.isSticky),

    stickyRank := self >> Length(self.stickyTags()),
    freeRank := self >> self.rank() - self.stickyRank(),
    freeLoops := self >> [self.stickyRank()+1 .. self.rank()],

    transposedTags := self >> List(self.tags, x->x.transpose()),

    getSpl := self >> self.params[1],
    setSpl := (self, spl) >> ApplyFunc(ObjId(self), Concatenation([spl], Drop(self.params, 1)))
        .withTags(self.tags),

    # need setIts(its) and getIts()
    _fmanip := meth(self, func_manip, gt_manip, newits)
         local cpy, z;
	 cpy := Copy(self);
 	 z :=  SubstTopDownNR_named(cpy, @.cond(x -> (not Same(x, cpy) and IsGT(x)) or IsFunction(x) or IsFuncExp(x) or ObjId(x)=ind),
	                e -> When(IsGT(e), gt_manip(e), func_manip(e)), "__GT._fmanip");
         return z.setIts(newits);
    end,

    bodyRank := self >> Maximum( [0] ::
	List(Collect(self.getSpl(), @.cond(e->IsFunction(e) or IsFuncExp(e))), _rank)),

    downRankFull := (self, inds) >> let(thisrank := self.rank(),
	self._fmanip(f -> f.downRankFull(inds),
	             e -> Cond(e.bodyRank()=0, e, Error(".downRankFull does not work with nested GTs")),
		     [])),

    downRank := (self, loopid, ind) >>
        self._fmanip(f -> f.downRank(loopid, ind),
	             e -> e.downRankOuter(loopid + e.rank(), ind),
	             ListWithout(self.getIts(), loopid)),
    # downRankOuter: notification that downRank performed on some outer GT,
    #   so that this GT can update its functions and notify children.
    downRankOuter := (self, loopid, ind) >>
        self._fmanip(f -> f.downRank(loopid + self.rank(), ind),
	             e -> e.downRankOuter(loopid + e.rank(), ind),
	             self.getIts()),

    rotate := (self, n) >> When(n=1, self, let(
	its := self.getIts(),
	tags := self.getTags(),	stags := self.stickyTags(), ftags := self.freeTags(),
        res := self._fmanip(
	    f -> f.rotate(n),
	    e -> Cond(e.bodyRank() <= e.rank(), e,
		      Error(".rotate() doesn't support nested GTs where inner GTs depend on outer indices")),
	    [its[n]] :: its{[1..n-1]} :: its{[n+1..Length(its)]}),
	Cond(self.stickyRank() = 0,
	        res,
	     n <= self.stickyRank(),
	        res.setTags( ftags :: [stags[n]] :: stags{[1..n-1]} :: stags{[n+1..Length(stags)]}),
	     # else, n > self.stickyRank(),
 	        Error("Can't make non-sticky rank <n> an inner loop, because sticky tags exist")
                # it could look like this instead: res.setTags( [ANoTag] :: tags )
	))),

    rotateIntoSticky := (self, n, newtag) >> let(
	its := self.getIts(),
	tags := self.getTags(),	stags := self.stickyTags(), ftags := self.freeTags(),
        res := self._fmanip(
	    f -> f.rotate(n),
	    e -> Cond(e.bodyRank() <= e.rank(), e,
		      Error(".rotate() doesn't support nested GTs where inner GTs depend on outer indices")),
	    [its[n]] :: its{[1..n-1]} :: its{[n+1..Length(its)]}),
	Cond(self.stickyRank() = 0,
	        res.setTags(tags :: [newtag]),
	     n <= self.stickyRank(),
	        res.setTags( ftags :: [newtag] :: stags{[1..n-1]} :: stags{[n+1..Length(stags)]}),
	     # else, n > self.stickyRank(),
                res.setTags( ftags :: [newtag] :: stags )
	)),

    # NOTE: upRank() leaves GT in inconsistent state, because sticky tags still need to be shifted
    upRank := self >> self._fmanip(
	f -> f.upRank(),
	e -> Cond(e.bodyRank() <= e.rank(), e,
	          Error(".upRank() doesn't support nested GTs where inner GTs depend on outer indices")),
	Concatenation([0], self.getIts())),

    # NOTE: upRank() leaves GT in inconsistent state, because sticky tags still need to be shifted
    upRankBy := (self, n) >> self._fmanip(
	f -> f.upRankBy(n),
	e -> Cond(e.bodyRank() <= e.rank(), e,
	          Error(".upRankBy() doesn't support nested GTs where inner GTs depend on outer indices")),
	Concatenation(Replicate(n, 0), self.getIts())),

    split := (self, loopid, inner_its, outer_its) >> let(its := self.getIts(),
        self._fmanip(
	    f -> f.split(loopid, inner_its, outer_its),
	    e -> e.splitOuter(loopid + e.rank(), inner_its, outer_its),
            Concatenation(its{[1..loopid-1]}, [inner_its, outer_its], its{[loopid+1..Length(its)]}))),
    # splitOuter: notification that some outer GT is splitting loop,
    #   so that this GT can update its functions and notify children.
    splitOuter := (self, loopid, inner_its, outer_its) >> let(its := self.getIts(),
        self._fmanip(
	    f -> f.split(loopid + self.rank(), inner_its, outer_its),
	    e -> e.splitOuter(loopid + e.rank(), inner_its, outer_its),
            its)),

    getGath := self >> Error("Must be implemented in a subclass"),

    getScat := self >> Error("Must be implemented in a subclass"),

    isReal := self >> self.params[1].isReal(),
    toAMat := self >> self.toSpl().toAMat(),
    # when self.getIts() returns empty list it actually means single iteration,
    # that's why [1] appended to the list
    normalizedArithCost := self >> self.getSpl().normalizedArithCost() * ListProduct(self.getIts() :: [1]),

    children := self >> [self.params[1]],
    child    := (self, n) >> Checked( n = 1, self.params[1] ),

    # overrideing withTags() to make sure non-sticky/sticky tags order is preserved
    # returns a copy of the object with 'tags' added on to any existing tags.
    withTags := (self, tags) >> self.setTags(Flat(TransposedMat(
        List([self.tags, tags], t -> SplitBy(t, e -> not e.isSticky))))),
));

# GT(<spl>, <gath>, <scat>, <v>) - generalized problem spec
#
# NOTE: assumes tightly packed data, i.e. Dims(GT(spl)) = Dims(spl) * Product(v)
#        (if gath/scat functions have domain&range == 0)
Class(GT, GTBase, Tagged_tSPL, rec(
    abbrevs := [
    (spl, gath, scat, v) -> Checked(
        IsSPL(spl), IsIndexMapping(gath), IsIndexMapping(scat), IsList(v),
        ForAll(v, IsPosInt0Sym),
        [spl, gath, scat, v]
    ) ],

    dims := self >> let(p := self.params, r := range(p[3]), c := range(p[2]), d := p[1].dims(),
        When(r<>0 and c<>0,
             [r, c],
         let(prod := Product(p[4]), [d[1]*prod, d[2]*prod]))), # NOTE: assumes XChain.

    advdims := self >> let(p := self.params, [p[3].advrange(), p[2].advrange()]),

    getIts := self >> self.params[4],
    setIts := (self,its) >> ObjId(self)(self.params[1], self.params[2], self.params[3], its).withTags(self.tags),
    getGath := self >> self.params[2],
    getScat := self >> self.params[3],

    rank := self >> Length(self.params[4]),

    _scat := Scat,
    _gath := Gath,

    # NOTE: toSpl doesn't work with nested GTs. It should use downRank method for function manipulations
    toSpl := self >> self.toSplCx([]),
    toSplCx := (self, outer_inds) >> let(
        p := self.params, spl := Copy(p[1]), g := Copy(p[2]), s := Copy(p[3]), dims := p[4],
        inds := List(dims, Ind), allinds := Concatenation(inds, outer_inds),
        kernel := self._scat(s.toSpl(allinds, Rows(spl))) * spl * self._gath(g.toSpl(allinds, Cols(spl))),
        kerneld := Cond(inds=[], kernel, # downRank only if not rank-0
            SubstTopDownNR(kernel, @.cond(e->IsFunction(e) or IsFuncExp(e)), e->e.downRankFull(allinds))),
        FoldL(inds, (ker, idx) -> ISum(idx.setAttr("GT"), ker), kerneld)
    ),

    toISums := self >> let(
    inds := List(self.getIts(), Ind),
    kernel := self._scat(self.getScat()) * self.params[1] * self._gath(self.getGath()),
    FoldL(inds, (ker, idx) -> ISum(idx.setAttr("GT"), ker), kernel)
    ),

    transpose := self >> let(p:=self.params,
        GT(p[1].transpose(), p[3], p[2], p[4]).withTags(self.transposedTags())),

    conjTranspose := self >> let(p:=self.params,
        GT(p[1].conjTranspose(), p[3], p[2], p[4]).withTags(self.transposedTags())),

    hashAs := self >> let(p:=self.params,
        ObjId(self)(HashAsSPL(p[1]), p[2], p[3], p[4]).withTags(self.tags)),
));

Declare(GTAccT, GTAcc0T);

# GTAcc(<spl>, <gath>, <scat>, <v>) - generalized problem spec with accumulation on output side
#
Class(GTAcc, GT, rec(
    transpose := self >> let(p:=self.params,
        GTAccT(p[1].transpose(), p[3], p[2], p[4]).withTags(self.transposedTags())),
    _scat := ScatAcc
));

Class(GTAcc0, GT, rec(
    transpose := self >> let(p:=self.params,
        GTAcc0T(p[1].transpose(), p[3], p[2], p[4]).withTags(self.transposedTags())),
    _scat := ScatAcc,

    toSplCx := (self, outer_inds) >> Checked(self.rank()=1, let( # NOTE: works only for rank-1
        dims := self.getIts(),
        inds0 := Concatenation(List(DropLast(dims,1), Ind), [0]),
        inds  := Concatenation(List(DropLast(dims,1), Ind), [Ind(Last(dims)-1)]),
        inds_shft := Concatenation(DropLast(inds,1), [Last(inds)+1]),

        dr0 := self.downRankFull(Concatenation(inds0, outer_inds)),
        dr  := self.downRankFull(Concatenation(inds_shft, outer_inds)),
        kernel0 := Scat(dr0.getScat())   * dr0.params[1] * self._gath(dr0.getGath()),
        kernel  := ScatAcc(dr.getScat()) * dr .params[1] * self._gath(dr .getGath()),
        When(Last(dims)=1,
            kernel0,
            SUM(kernel0, FoldL(inds, (ker, idx) -> ISum(idx.setAttr("GT"), ker), kernel))))
    ),
));

# GTAccT == GTAcc.transpose(), even though semantically GTAccT == GT, we need a separate object, so that
# GTAccT.transpose() is back to GTAcc itself.
Class(GTAccT, GT, rec(
    transpose := self >> let(p:=self.params,
        GTAcc(p[1].transpose(), p[3], p[2], p[4]).withTags(self.transposedTags())),
));

Class(GTAcc0T, GT, rec(
    transpose := self >> let(p:=self.params,
        GTAcc0(p[1].transpose(), p[3], p[2], p[4]).withTags(self.transposedTags())),
));

Declare(GTInplace);

Class(GTInplace, GTBase, Tagged_tSPL, rec(
    abbrevs := [ (spl, gathscat, v) -> Checked(
        IsSPL(spl), IsIndexMapping(gathscat), IsList(v), ForAll(v, IsPosInt0Sym),
        [spl, gathscat, v]) ],

    dims := self >> let(p := self.params, rc := range(p[2]), d := p[1].dims(),
        When(rc<>0,
             [rc, rc],
             let(prod:=Product(p[3]), [d[1]*prod, d[2]*prod]))), # NOTE: assumes XChain.

    getIts := self >> self.params[3],
    setIts := (self,its) >> GTInplace(self.params[1], self.params[2], its).withTags(self.tags),

    getGath := self >> self.params[2],
    getScat := self >> self.params[2],

    rank := self >> Length(self.params[3]),
    toGT := self >> let(p:=self.params, GT(p[1], p[2], p[2], p[3]).withTags(self.tags)),
    toNonInplace := self >> self.toGT(),
    toSpl := self >> Inplace(self.toGT().toSpl()),
    isInplace := self >> true,

    conjTranspose := self >> let(p:=self.params,
        GTInplace(p[1].conjTranspose(), p[2], p[3]).withTags(self.transposedTags())),

    transpose := self >> let(p:=self.params,
        GTInplace(p[1].transpose(), p[2], p[3]).withTags(self.transposedTags())),

    hashAs := self >> let(p:=self.params,
        ObjId(self)(HashAsSPL(p[1]), p[2], p[3]).withTags(self.tags))
));

#
# NOTE: what if there is no SUM scatters or gathers
#

Class(GTPS, GTBase, Tagged_tSPL, rec(
    abbrevs := [
    (spl, fb_cnt, gath, scat, v) -> Checked(
        IsSPL(spl), IsPosInt(fb_cnt), IsIndexMapping(gath), IsIndexMapping(scat), IsList(v),
        ForAll(v, IsPosInt0Sym),
        [spl, fb_cnt, gath, scat, v]
    ) ],

    dims := self >> let( p := self.params, r := range(p[4]), c := range(p[3]),
        d := p[1].dims(),
        [ StripList(Flat([d[1]]){[1..p[2]]} :: Flat([r])),
          StripList(Flat([d[2]]){[1..p[2]]} :: Flat([c])) ]),

    advdims := self >> let(p := self.params, r := p[4].advrange(), c := p[3].advrange(),
        d := p[1].advdims(),
        [ StripList(Flat([d[1]]){[1..p[2]]} :: Flat([r])),
          StripList(Flat([d[2]]){[1..p[2]]} :: Flat([c])) ]),

    getIts := self >> self.params[5],
    setIts := (self,its) >> ObjId(self)(self.params[1], self.params[2], self.params[3], self.params[4], its).withTags(self.tags),
    getGath := self >> fCross(List(Flat([self.params[1].advdims()[1]]){[1..self.params[2]]}, e -> fId(e)) :: [self.params[3]]),
    getScat := self >> fCross(List(Flat([self.params[1].advdims()[2]]){[1..self.params[2]]}, e -> fId(e)) :: [self.params[4]]),

    rank := self >> Length(self.params[5]),

    toSpl := self >> let(
        inds   := List(self.params[5], Ind),
        kernel := FoldR([1..self.rank()], (ker, i) -> ker.downRank(i, inds[i]), Copy(self)),
        spl    := Scat(kernel.getScat()) * kernel.child(1) * Gath(kernel.getGath()),
        FoldL(inds, (ker, idx) -> IParSeq(idx.setAttr("GT"), kernel.params[2], ker), spl)),

    hashAs := self >> let(p:=self.params,
        ObjId(self)(HashAsSPL(p[1]), p[2], p[3], p[4], p[5]).withTags(self.tags)),

));

# Useful identities:
#
# Tr(m,n) = GT(I(m), XChain([0,1]), XChain([1,0]), [n]) =
#           GT(I(n), XChain([1,0]), XChain([0,1]), [m]) = L(m*n, n)
GT_Tr1 := (m,n) -> GT(I(m), XChain([0,1]), XChain([1,0]), [n]);
GT_Tr2 := (m,n) -> GT(I(n), XChain([1,0]), XChain([0,1]), [m]);

GT_Tr1u := (m,n,u) -> let(uu:=When(m mod u = 0, u, 1),
    GT(BB(I(uu)), XChain([1,0,2]), XChain([2,1,0]), [m/uu, n]));

GT_Tr2u := (m,n,u) -> let(uu:=When(n mod u = 0, u, 1),
    GT(BB(I(uu)), XChain([2,1,0]), XChain([1,0,2]), [n/uu, m]));

NewRulesFor(GT, rec(
    GT_Base := rec(
	switch := false,
	a := rec(maxSize := false),
        # requiredFirstTag := ANoTag,
	applicable := (self, t) >> let(rank := Length(t.params[4]), spl := t.params[1],
            rank = 0 and (self.a.maxSize=false
		or Rows(spl) <= self.a.maxSize or Cols(spl) <= self.a.maxSize)),
        freedoms := (self, t) >> [],
	child := (t, fr) -> [ t.params[1].withTags(t.getTags()) ],
	apply := (t, C, Nonterms) -> let(
            g := t.params[2], s := t.params[3],
            Scat(s.toSpl([], Rows(C[1]))) * C[1] * Gath(g.toSpl([], Cols(C[1])))
        )
    ),

    GT_NthLoop := rec(
	    requiredFirstTag := [ANoTag, ALimitNthLoop],
	    applicable := t -> let(rank := Length(t.params[4]), rank > 0),

        # restrict to innermost first (i.e. loop interchange)
	    # to search over loop orders use [1..nloops]

        # Limit tag reduces the number of loop interchanges.
        # it is useful when you don't want the number of potential
        # ruletrees to explode, and you are not overtly concerned
        # with having access to all the potential ones.
        freedoms := t -> let(
            fr := [1..Length(t.params[4])],
            When(t.hasTag(ALimitNthLoop),
                [[1]],
                [fr]
            )
        ),

	    child := (t, fr) -> let(
	        spl := t.params[1],
            g := t.params[2],
            s := t.params[3],
            loopid := fr[1],
	        [
                GT(spl, g.without(loopid),
                    s.without(loopid), ListWithout(t.params[4], loopid)),
                InfoNt(loopid)
            ]
        ),

	    apply := (t, C, Nonterms) -> let(
	        loopid := Nonterms[2].params[1],
            dft := Nonterms[1].params[1],
	        g := t.params[2],
            s := t.params[3],
	        loop_dims := t.params[4],
	        i := Ind(loop_dims[loopid]),

	        ISum(i, Scat(s.part(loopid, i, Rows(dft), loop_dims))
            * C[1]
            * Gath(g.part(loopid, i, Cols(dft), loop_dims)))
        )
    ),

    GT_BufReshape := rec(
    bufIters      := [2, 4, 8, 16, 32],
    requiredFirstTag := ANoTag,

    applicable := (self, t) >> Length(t.params[4])=1 and let(
        N := Minimum(t.params[1].dimensions), its := t.params[4][1],
        PatternMatch(t, [GT, @, @(2,XChain), @(3,XChain), ...], empty_cx()) and
        (@(2).val.params[1] = [0,1] or @(3).val.params[1] = [0,1]) and
        ForAny(self.bufIters, bi -> bi < its and IsInt(its/bi))),

    u := [2,4,8,16],

    children := (self, t) >> let(
        spl := t.params[1], its := t.params[4][1],
        bufiters := Filtered(self.bufIters, bi -> (bi < its) and IsInt(its/bi)),
        Map2(Cartesian(bufiters, self.u), (bi, u) ->
        [ GT(spl, XChain([1,0]), XChain([1,0]), [bi]),
          InfoNt(u) ])),

    apply := (self, t, C, Nonterms) >> let(
        g := t.params[2].params[1], s := t.params[3].params[1],
        gg := When(g=[0,1], XChain([0,1,2]), XChain([1,2,0])),
        ss := When(s=[0,1], XChain([0,1,2]), XChain([1,2,0])),
        spl := t.params[1], its := t.params[4][1], inner := Nonterms[1].params[4][1],
        i := Ind(its / inner),
        u := When(IsBound(Nonterms[2]), Nonterms[2].params[1], 4),

        ISum(i, Scat(ss.part(1, i, Rows(spl), [i.range, inner])) *
            When(s=[0,1], GT_Tr2u(inner, Rows(spl), u).toSpl(), I(Rows(spl)*inner)) *
            C[1] *
            When(g=[0,1], GT_Tr1u(Cols(spl), inner, u).toSpl(), I(Cols(spl)*inner)) *
            Gath(gg.part(1, i, Cols(spl), [i.range, inner]))
        )
    )
    )
));


IsSymInf := x -> IsSymbolic(x) and IsBound(x.isSymInf) and x.isSymInf;

Class(SymInf, Symbolic, rec(
  __call__ := (self, t) >> WithBases(self, rec(
    t := Checked(IsType(t), t),
    operations := rec(Print := x-> When(IsBound(x.print), x.print(), Print(x.__name__)))
  )),
  print := self >> Print(self.__name__, "(", self.t, ")"),
  isSymInf := true,
  isValue := true,
  ev := self >> self,
  computeType := self >> self.t
));

# ==========================================================================
# Semiring
# ==========================================================================

IsSemiring := x -> IsType(x) and IsBound(x.isSemiring) and x.isSemiring;

IsSemiring_Arithmetic := x -> IsSemiring(x) and IsBound(x.isSemiring_Arithmetic) and x.isSemiring_Arithmetic;

IsSemiring_MinPlus := x -> IsSemiring(x) and IsBound(x.isSemiring_MinPlus) and x.isSemiring_MinPlus;

IsSemiring_MinTimes := x -> IsSemiring(x) and IsBound(x.IsSemiring_MinTimes) and x.isSemiring_MinTimes;

isSemiring_Boolean := x -> IsSemiring(x) and IsBound(x.isSemiring_Boolean) and x.isSemiring_Boolean;

Class(TSemiring, CompositeTyp, rec(
  __call__ := (self, t) >> WithBases(self, rec(
    t := Checked(IsType(t), t),
    operations := TypOps
  )),
  base_t := self >> self.t,
  isSemiring := true,

  print := self >> Print(self.__name__, "(", self.t, ")"),

  check := (self, v) >> Cond(
    UnifyTypes([self.t, InferType(v)]) = self.t,
      v,
    Error("type mismatch: semiring is type ", self.t)
  ),

  rChildren := self >> [self.t],
  rSetChild := rSetChildFields("t"),
  from_rChildren := (self, rch) >> self,

  zero := self >> Error("method on undefined semiring"),
  one := self >> Error("method on undefined semiring"),

  sum := self >> Error("method on undefined semiring"),
  product := self >> Error("method on undefined semiring")
));

Class(TSemiring_Arithmetic, TSemiring, rec(
  zero := self >> self.t.zero(),
  one := self >> self.t.one(),

  sum := (self, v1, v2) >> Cond(
    UnifyTypes([self.t, InferType(v1), InferType(v2)]) = self.t,
      self.t.sum(v1, v2),
    Error("type mismatch: semiring is type ", self.t)
  ),
  product := (self, v1, v2) >> Cond(
    UnifyTypes([self.t, InferType(v1), InferType(v2)]) = self.t,
      self.t.product(v1, v2),
    Error("type mismatch: semiring is type ", self.t)
  ),

  OpenMP_sum := "+",
  OpenMP_product := "*",

  isSemiring_Arithmetic := true
));

Class(TSemiring_MinPlus, TSemiring, rec(
  zero := self >> SymInf(self.t),
  one := self >> self.t.zero(),

  sum := (self, v1, v2) >> Cond(
    IsSymInf(v1) and IsSymInf(v2),
      SymInf(self.t),
    IsSymInf(v1) and UnifyTypes([self.t, v2.t]) = self.t,
      v2,
    IsSymInf(v2) and UnifyTypes([self.t, v1.t]) = self.t,
      v1,
    UnifyTypes([self.t, InferType(v1), InferType(v2)]) = self.t,
      min(v1, v2),
    Error("type mismatch: semiring is type ", self.t)
  ),
  product := (self, v1, v2) >> Cond(
    IsSymInf(v1) or IsSymInf(v2),
      SymInf(self.t),
    UnifyTypes([self.t, InferType(v1), InferType(v2)]) = self.t,
      self.t.sum(v1, v2),
    Error("type mismatch: semiring is type ", self.t)
  ),

  OpenMP_sum := "min",
  OpenMP_product := "+",

  isSemiring_MinPlus := true
));

Class(TSemiring_MinTimes, TSemiring, rec(
  zero := self >> SymInf(self.t),
  one := self >> self.t.zero(),

  sum := (self, v1, v2) >> Cond(
    IsSymInf(v1) and IsSymInf(v2),
      SymInf(self.t),
    IsSymInf(v1) and UnifyTypes([self.t, v2.t]) = self.t,
      v2,
    IsSymInf(v2) and UnifyTypes([self.t, v1.t]) = self.t,
      v1,
    UnifyTypes([self.t, InferType(v1), InferType(v2)]) = self.t,
      min(v1, v2),
    Error("type mismatch: semiring is type ", self.t)
  ),
  product := (self, v1, v2) >> Cond(
    UnifyTypes([self.t, InferType(v1), InferType(v2)]) = self.t,
      self.t.product(v1, v2),
    Error("type mismatch: semiring is type ", self.t)
  ),

  OpenMP_sum := "min",
  OpenMP_product := "*",

  isSemiring_MinTimes := true
));

Class(TSemiring_Boolean, TSemiring, rec(
  zero := self >> self.t.zero(),
  one := self >> self.t.one(),

  sum := (self, v1, v2) >> Cond(let(
    l := UnifyTypes([self.t, InferType(v1), InferType(v2)]), Cond(IsArrayT(l), l.t = self.t, l = self.t)),
      logic_or(v1, v2),
    Error("type mismatch: semiring is type ", self.t)
  ),
  product := (self, v1, v2) >> Cond(let(
    l := UnifyTypes([self.t, InferType(v1), InferType(v2)]), Cond(IsArrayT(l), l.t = self.t, l = self.t)),
      logic_and(v1,v2),
    Error("type mismatch: semiring is type ", self.t)
  ),

  OpenMP_sum := "||",
  OpenMP_product := "&&",

  isSemiring_Boolean := true
));