#
# 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 (c) 2018-2021, Carnegie Mellon University
# See LICENSE for details

Declare(VContainer);

###############################################################################
#F VContainer(<spl>, <isa>)
#F
#F   self.child(1) -- spl
#F   self.isa      -- isa
#F
Class(VContainer, VRC, rec(
    #-----------------------------------------------------------------------
    new := (self, spl, isa) >> SPL(WithBases(self, rec(
        _children := [spl], isa := isa))).setDims(),
    #-----------------------------------------------------------------------
    dims := self >> self.child(1).dims(),
    #-----------------------------------------------------------------------
    toAMat := (self) >> AMatMat(MatSPL(self.child(1))),
    #-----------------------------------------------------------------------
    isReal := self >> self.child(1).isReal(),
    #-----------------------------------------------------------------------
    conjTranspose := self >> ObjId(self)(self.child(1).conjTranspose(), self.isa),
    #-----------------------------------------------------------------------
    # NOTE: make sure rChildren properly exposes all parameters
    from_rChildren := (self, rch) >> VContainer(rch[1], self.isa),
    #-----------------------------------------------------------------------
    print := (self, i, is) >> Print(self.name, "(\n", Blanks(i+is),
	self.child(1).print(i+is,is), ",\n", Blanks(i+is), self.isa, ")",
	self.printA()),
    #-----------------------------------------------------------------------
    unroll := self >> self,
    #-----------------------------------------------------------------------
    transpose := self >> VContainer(self.child(1).transpose(), self.isa),
    #-----------------------------------------------------------------------
    vcost := self >>  self.child(1).vcost()
));

Class(VirtualPad, BaseContainer, SumsBase, rec(
    #-----------------------------------------------------------------------
    new := (self, rows, cols, ch) >> SPL(WithBases(self, rec(
        dimensions := [rows, cols], _children := [ch]))).setDims(),
    #-----------------------------------------------------------------------
    dims := self >> self.dimensions,
    #-----------------------------------------------------------------------
    toAMat := self >> let(m := MatSPL(self.child(1)), ch := self.child(1),
	AMatMat(
	    List(m, x -> x :: Replicate(Cols(self)-Cols(ch), 0)) ::
	    Replicate(Rows(self)-Rows(ch), Replicate(Cols(self), 0)))),
    #-----------------------------------------------------------------------
    rChildren := self >> [self.dimensions[1], self.dimensions[2], self._children[1]],
    #-----------------------------------------------------------------------
    rSetChild := meth(self, n, what)
        if   n=1 then self.dimensions[1] := Checked(IsIntSym(what), what);
        elif n=2 then self.dimensions[2] := Checked(IsIntSym(what), what);
	elif n=3 then self._children[1]  := Checked(IsSPL(what), what);
	else Error("<n> must be in [1..3]");
	fi;
    end,
));


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

#F DiagFunc - base class for diagonal generating functions
#F Required fields in subclasses:
#F    .abbrevs = [ (p1)     -> [parlist1],
#F                 (p1,...) -> [parlist2] ]
#F       Mapping from various lengths of parameter lists to a
#F       fixed signature .def
#F
#F    .lambda(self)  - must return Lambda() object representing the actual
#F                     function. One should use .params field here
#F
#F    .domain(self) -- must return the domain of the function (integer or type)
#F    .range(self)  -- must return the range of the function (integer or type)
#F
#F Optional:
#F    .def(self, p1, ...)  - this method is called from the constructor
#F                           before the instance object is created.
#F                           <self> = class in this case
#F                           .def() must return a record, all fields of the record
#F                           will be copied to the resulting instance object,
#F                           which will also have the field .params := [p1, ...].
#F                           additional error checking can be performed in .def
#F                           NB: parameter lists are normalized here, using .abbrevs
Class(DiagFunc, Function, Sym, rec(
    isSPL := false,

    range  := self >> Error(ObjId(self), " does not implement .range()"),
    domain := self >> Error(ObjId(self), " does not implement .domain()"),

    tensor_op := (v,rows,cols,fl,gl) ->
        Lambda(v, fl.at(idiv(v, cols)) * gl.at(imod(v, cols))),

    sums := self >> self,
    rSetChild := meth(self, n, newChild)
        self.params[n] := newChild;
    end,

    print := meth(self, i, is)
        local params;
        params := let(p:=self.params, When(IsList(p), p, [p]));
        Print(self.name, "(",
          DoForAllButLast(params, x -> Print(x, ", ")),
          Last(params), ")");
    end,

    def := arg -> rec(),

    fromDef := meth(arg)
        local result, self, params, h, lkup;
        self := arg[1];
        params := arg{[2..Length(arg)]};
        params := self.canonizeParams(params);
        self.checkParams(params);
        params := When(IsList(params), params, [params]);

        h := self.hash;
        if h<>false then
            lkup := h.objLookup(self, params);
            if lkup[1] <> false then return lkup[1]; fi;
        fi;

        result := SPL(WithBases(self, CopyFields(
                    rec(params := params),
                    ApplyFunc(self.def,params))));

        if h<>false then return h.objAdd(result, lkup[2]);
        else return result;
        fi;
    end,

    free := self >> Union(List(self.params, FreeVars)),
    __call__ := ~.fromDef,

    isReal := self >> not IsComplexT(self.range())
));

#F II - interval diagonal function
#F
#F II(<N>) - diagonal of N 1's
#F II(<N>, <to>) - diagonal with 1's from 0..<to>, and 0's after
#F II(<N>, <from>, <to>) - diagonal with 1's in <from>..<to>, 0's elsewhere
#F
Class(II, DiagFunc, rec(
    abbrevs := [ (N)         -> [N,0,N],
                 (N,to)      -> [N,0,to],
                 (N,from,to) -> [N,from,to] ],

    def := (N, from, to) -> Checked(
	IsPosInt0Sym(N), IsPosInt0Sym(from), IsPosInt0Sym(to), rec()),

    lambda := self >> let(
        i := Ind(self.params[1]), from := self.params[2], to := self.params[3],
        Lambda(i, cond(leq(from, i, to-1), 1, 0))),

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

#F fConst(<t>, <N>, <c>) - constant diagonal function, <N> values of <c> of type <t>
#F
Class(fConst, DiagFunc, rec(
    abbrevs := [   (N,c) -> Checked(           IsPosInt0Sym(N), [TReal, N,c]),
                 (t,N,c) -> Checked(IsType(t), IsPosInt0Sym(N), [t, N, c]) ],
    range := self >> self.params[1],
    domain := self >> self.params[2],
    lambda := self >> let(i := Ind(self.params[2]), Lambda(i, self.params[3]))
));

#F fUnk(<t>, <N>) - dummy diagonal that denotes an "unknown" function, <N> values of type <t>
#F   To be used for .hashAs methods of transforms
#F
Class(fUnk, DiagFunc, rec(
    abbrevs := [ N -> Checked(IsIntSym(N), [TReal, N]),
	        (t, N) -> Checked(IsType(t), IsIntSym(N), [t, N]) ],
    range := self >> self.params[1],
    domain := self >> self.params[2],
    lambda := self >> let(N:=self.params[2], i:=Ind(N),
	Cond(IsIntT(self.params[1]), Lambda(i, i+1),
	                             Lambda(i, self.params[1].one()/N*(i+1))))
));

# FUnk is for backwards compatibility, use fUnk
FUnk := n -> fUnk(TReal, n);

Declare(LD);

# UD(<N>, <shift>) - upper diagonal
#
Class(UD, Sym, rec(
    def := (n,k) -> Checked(k < n, Z(n,k) * Diag(II(n, k, n))),
    transpose := self >> ApplyFunc(LD, self.params)
));

# LD(<N>, <shift>) - lower diagonal
#
Class(LD, Sym, rec(
    def := (n,k) -> Checked(k < n, Z(n,n-k) * Diag(II(n, 0, n-k))),
    transpose := self >> ApplyFunc(UD, self.params)
));

# [ 1 1
#     1 1
#       ... ]
Class(S, Sym, rec(
    def := n -> SUM(I(n), UD(n,1))));

# Class(fComputeOnline, PlaceholderExp);
Class(fComputeOnline, FuncClassOper, rec(
    range  := self >> self._children[1].range(),
    domain := self >> self._children[1].domain(),
    lambda := self >> self._children[1].lambda(),
    tolist := self >> self._children[1].tolist(),
    free   := self >> self._children[1].free(),
    ev     := self >> self._children[1].ev(),
    eval   := self >> self._children[1].eval(),
));

Declare(fPrecompute);

# fPrecompute(<func>)
#
# Marks functions that should be precomputed by either generating a
# table (opts.generateInitCode := true) or runtime initialization code
# (opts.generateInitCode := true).
#
# Actual precomputation is done by Process_fPrecompute. Which uses
# options record 'opts' to determine the precomputation strategy.
#
Class(fPrecompute, FuncClassOper, rec(
    def    := func -> rec(t := TPtr(func.range())),
    range  := self >> self._children[1].range(),
    domain := self >> self._children[1].domain(),
    lambda := self >> self._children[1].lambda(),
    tolist := self >> self._children[1].tolist(),
    free   := self >> self._children[1].free(),
    isReal := self >> self._children[1].isReal()
));

# diagAdd(<f1>, <f2>,...) : i -> f1(i) + f2(i) + ...
# Pointwise addition of several diagonal functions
Class(diagAdd, FuncClassOper, rec(
    domain := self >> self.child(1).domain(),
    range  := self >> UnifyTypes(List(self.children(), x->x.range())),
    lambda := self >> let(v := Ind(self.domain()),
	Lambda(v, ApplyFunc(add, List(self.children(), i->i.at(v))))),
));

# diagMul(<f1>, <f2>,...) : i -> f1(i) * f2(i) * ...
# Pointwise multiplication of several diagonal functions
Class(diagMul, FuncClassOper, rec(
    domain := self >> self.child(1).domain(),
    range  := self >> UnifyTypes(List(self.children(), (x) -> x.range())),
    lambda := self >> let(v := Ind(self.domain()),
	Lambda(v, ApplyFunc(mul, List(self.children(), i->i.at(v))))),
));

Class(diagCond, FuncClassOper, rec(
    domain := self >> self.child(2).domain(),
    range  := self >> UnifyTypes(List(Drop(self.children(), 1), x->x.range())),
    lambda := self >> let(v := Ind(self.domain()),
	Lambda(v, cond(self.child(1), self.child(2).at(v), self.child(3).at(v))))
));

#F fCast(<toT>, <fromT>)  -- symbolic type cast function
#F
#F Example: fCast(TReal, TInt)
#F
Class(fCast, DiagFunc, rec(
    abbrevs := [ (toT, fromT)  -> Checked(IsType(toT), IsType(fromT), [toT, fromT]) ],
    range := self >> self.params[1],
    domain := self >> self.params[2],
    lambda := self >> let(i:=TempVar(self.domain()), Lambda(i, tcast(self.range(), i))),
));


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

#F ResolveMemos(<o>)
#F   This function removes all precomputed variables (with Data(v, expr, ...))
#F   by inserting the corresponding expressions
#F
ResolveMemos := o ->
   SubstTopDown(o, @(1,var,e->IsBound(e.mapping)), e->e.mapping);

_GenerateData := function(map, free, lambda)
    local newlambda, v, val, d, free1;
    if free = [] then
	newlambda := Copy(lambda);
	# NOTE: hardcoded [var, param] is ugly
	newlambda.expr := SubstParamsCustom(newlambda.expr, map, [var, param]);
	return newlambda.tolist();
    else
	v := free[1];
	d := [];
	free1 := Drop(free, 1);
	for val in [0..v.range-1] do
	    map.(v.id) := V(val);
	    Append(d, _GenerateData(map, free1, lambda));
	od;
	return d;
    fi;
end;

#Declare(fComputeOnline);

# PrecalculatedData - accumulating precalculated data variables so
# same constant data table (variable) could be reused in different places in code.
# Beware: search for table by key is inefficient here.

Class(PrecalculatedData, rec(

     # _tables is a list of rec(key, data, opts) items.
    _tables := [],

    __call__ := (self) >> self._tables,

    # keyForFunc - returns search key for function 'func' that has 'var' variables.
    # The key is just the same function with unnamed variables.

    keyForFunc := meth( self, func, vars)
        local i, j, map;
        map := rec();
        i := 1; j := Length(vars);
        while j>0 do
            map.(vars[i].id) := ind(vars[i].range, j);
            i := i+1; j := j-1;
        od;
	# NOTE: hardcoded [var, param] is ugly
        return SubstParamsCustom( Copy(func), map, [var, param]);
    end,

    # find(key, opts) - searching if data table already exists.
    find := meth( self, key, opts)
        local item;
        for item in self._tables do
            #NOTE: opts.dataType - just to distinguish single precision from double
            if item.key=key and item.opts.dataType=opts.dataType then
                return item.data;
            fi;
        od;
        return false;
    end,

    # add - remember data table assosiated with key, data is FData object.
    add := meth( self, key, data, opts)
        Add(self._tables, rec( key := key, data := data, opts := opts));
    end,

    clear := meth(self)
        self._tables := [];
    end,

));

GenerateData := function ( func, opts )
    local f, n, free, lambda, data, t, olvars, key, map, i;

    if ObjId(func)=FDataOfs then return func; fi;

    olvars := [];
    map := rec();

    func := SubstTopDown(Copy(func), fComputeOnline,
        function(s)
            local v;
            v := var.fresh_t("o", s._children[1].t);
            v.range := s._children[1].range();
            Add(olvars, v);
            map.(v.id) := s._children[1];
            return v;
        end
    );

    lambda := func.lambda();
    # NOTE: Collect is a hack
    # NOTE: hardcoded 'param' is ugly
    free := Difference(lambda.expr.free() :: Collect(lambda.expr, param), lambda.vars);
    free := Filtered(free, IsLoopIndex);

    for i in free do map.(i.id) := fBase(i); od;

    Append(free, olvars);

    Constraint(ForAll(free, v->IsBound(v.range)));
    Sort(free, (x,y) -> DoubleString(Drop(x.id,1)) <= DoubleString(Drop(y.id,1)));

    if IsBound(opts.dataSharing) and opts.dataSharing.enabled then
        key := PrecalculatedData.keyForFunc(func, free);
        data := PrecalculatedData.find(key, opts);
        if ObjId(data)=false then
            data := FData(_GenerateData(tab(), free, lambda));
            PrecalculatedData.add(key, data, opts);
        fi;
    else data := FData(_GenerateData(tab(), free, lambda));
    fi;

    n := lambda.domain();

    if (free=[] and olvars=[]) then return data.part(n,0);
    else return data.part(n, n * fTensor(List(free, i->map.(i.id))).at(0));
    fi;
end;

_GenerateInitCode := function(data, N, idx, free, lambda)
    local i, v, res;
    if free = [] then
	i := lambda.vars[1];
	res := loop(i, lambda.domain(),
		assign(nth(data, idx+i),
		       When(data.t.t = lambda.expr.t,
			        lambda.expr,
			    # else
				tcast(data.t.t, lambda.expr))));

        # ObjId<>loop, when i.range was 1, loop just returned its body
	if i.range <= 16 and ObjId(res)=loop then return SReduceSimple(res.unroll());
	else return SReduceSimple(res);
	fi;
    else
	v := free[1];
        # careful here, since N and v.range can be symbols we have to use div ,
        # since N/v.range will become an fdiv (floating point division) in the code,
        # div = integer division with divisible arguments (allows normal simplification as in fdiv)
	N := div(N, v.range);
	return loop(v, v.range,
	    _GenerateInitCode(data, N, idx+v*N, Drop(free,1), lambda));
    fi;
end;

GenerateInitCode := function ( func, data_container, opts )
    local f, N, n, free, lambda, data, map, initcode, res, range, key;
    if ObjId(func)=FDataOfs then return func; fi;
    lambda := func.lambda();

    # NOTE: Collect is a hack
    # NOTE: hardcoded 'param' is ugly
    free := Difference(lambda.expr.free() :: Collect(lambda.expr, param), lambda.vars);
    free := Filtered(free, IsLoopIndex);

    Constraint(ForAll(free, v->IsBound(v.range)));
    Sort(free, (x,y) -> DoubleString(Drop(x.id,1)) <= DoubleString(Drop(y.id,1)));

    n := func.domain();
    N := n * Product(free, x->x.range);

    range := func.range();

    if IsBound(opts.dataSharing) and opts.dataSharing.enabled then
        key := PrecalculatedData.keyForFunc(func, free);
        data := PrecalculatedData.find(key, opts);
    else
        data := false;
    fi;

    if data=false then
        if IsInt(range) or IsSymbolic(range) then
            data := data_container(TInt, N); # index mapping function, not diag
        else
	    if opts.unifyStoredDataType = "input" then
		range := UnifyTypes([range, opts.XType.t]);
	    elif opts.unifyStoredDataType = "output" then
		range := UnifyTypes([range, opts.YType.t]);
	    elif IsType(opts.unifyStoredDataType) then
		range := UnifyTypes([range, opts.unifyStoredDataType]);
	    fi;
            data := data_container(range, N);
        fi;
        data.init := _GenerateInitCode(data, N, 0, free, lambda);

        if IsBound(opts.dataSharing) and opts.dataSharing.enabled then
            PrecalculatedData.add(key, data, opts);
        fi;
    fi;

    if free=[] then
        res := FData(data).part(n,0);
    else
        res := FData(data).part(n, n * fTensor(List(free, fBase)).at(0));
    fi;
    res := res.setRange(range);
    res.init := res.var.init;

    return res;
end;

_Process_fPrecompute := (o, precompute_func, precond) -> SubstBottomUpRules(o, [
    [ [fPrecompute, @(1)],
      (e,cx) -> When(precond(e,cx) and e.rank()=0, precompute_func(ResolveMemos(e)), e),
      "ContextDependentLocalize_fPrecompute"],
]);

# Process_fPrecompute(<sums>, <opts>)
#
Process_fPrecompute := function(sums, opts)
    local bb, b, has_free_vars, precompute_func;

    # Autolib needs ability to disable fPrecompute when it uses strategies from LocalConfig.bench
    if IsBound(opts.disablePrecompute) and opts.disablePrecompute then
        return sums;
    fi;

    if IsBound(opts.dataSharing) and opts.dataSharing.enabled then
    	sums := ApplyStrategy(sums, opts.dataSharing.precomputeStrategy, UntilDone, opts);
    fi;

    bb := Collect(sums, @(1, [BB, RecursStep]));
    for b in bb do
        b.precomputed_free := b.free();
    od;

    has_free_vars := (e, cxentry) ->
        (CollectNR(e, param) <> []) or
        (Intersection(e.free(), cxentry[1].precomputed_free)<>[]);

    precompute_func := When(opts.generateInitFunc,
        e -> GenerateInitCode(e, Dat1d, opts),
        e -> GenerateData(e, opts));

    sums := _Process_fPrecompute(sums, precompute_func,
           (e, cx) -> (
                        ((not IsBound(cx.BB) or cx.BB=[]) and
                        (not IsBound(cx.RecursStep) or cx.RecursStep=[]) and
                        (not IsBound(cx.RS) or cx.RS=[]) and
                        (not IsBound(cx.RSBase) or cx.RSBase=[])) or
                        (IsBound(cx.BB) and cx.BB<>[] and has_free_vars(e, cx.BB)) or
	                    (IsBound(cx.RecursStep) and cx.RecursStep<>[] and has_free_vars(e, cx.RecursStep))
                    )
                    );
    return sums;
end;


#
#
#

Read("~/Workspace/Chevalley.gap/init.gi");

Read(Filename(home_dir,"lib/poly.gd"));
Read(Filename(home_dir,"lib/poly.gi"));


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


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

###############################################################################
##
#R  IsSelfSimRep
##
##  This is how IsSelfSim object is stored in GAP:
##  IsSelfSim object is a thing of kind "w = (w_1, w_2, ..., w_d)\pi", where
##    deg = d - arity of tree;
##    perm = \pi - permutation on first level;
##    w, w_1, ..., w_d - elements of free group representing elements of
##      automata group;
##    word = w;
##    states = [w_1, ..., w_d].
##
DeclareRepresentation("IsSelfSimRep",
                      IsComponentObjectRep and IsAttributeStoringRep,
                      ["word", "states", "perm", "deg"]);

InstallGlobalFunction(__AG_CreateSelfSim,
function(family, word, states, perm, invertible)
  local a, cat;

  if invertible then
    cat := IsInvertibleSelfSim and IsSelfSimRep;

    if perm^-1=fail then
      Error(perm, " is not invertible");
    else
      perm := AG_PermFromTransformation(perm);
    fi;
  else
    cat := IsSelfSim and IsSelfSimRep;
  fi;

  a := Objectify(NewType(family, cat),
                 rec(word := word,
                     states := states,
                     perm := perm,
                     deg := family!.deg));

  SetIsActingOnBinaryTree(a, a!.deg = 2);

  return a;
end);

###############################################################################
##
#M  SelfSim( <word>, <fam> )
##
InstallMethod(SelfSim, "for [IsAssocWord, IsSelfSimFamily]",
              [IsAssocWord, IsSelfSimFamily],
function(w, fam)
  local exp, wstates, curstate, newstate, curletter, newletter,
        nperm, i, j, perm, a, wtmp, reduced, invertible;

  if fam!.use_rws then
    w := AG_ReducedForm(fam!.rws, w);
  fi;

  if Length(w) = 0 then
    return One(fam);
  elif Length(w) = 1 then
    if ExponentSyllable(w, 1) = 1 then
      return fam!.recurgens[GeneratorSyllable(w, 1)];
    else
      if IsBound(fam!.recurgens[GeneratorSyllable(w, 1) + fam!.numstates]) then
        return fam!.recurgens[GeneratorSyllable(w, 1) + fam!.numstates];
      else
        Error(fam!.recurgens[GeneratorSyllable(w, 1)], " is not invertible");
      fi;
    fi;
  fi;

  exp := LetterRepAssocWord(w);
  for i in [1..Length(exp)] do
    if exp[i] < 0 then
      if IsBound(fam!.recurlist[-exp[i] + fam!.numstates]) then
        exp[i] := -exp[i] + fam!.numstates;
      else
        Error(fam!.recurgens[-exp[i]], " is not invertible");
      fi;
    fi;
  od;
  wstates := [];
  nperm := ();
  for i in [1..Length(exp)] do
    nperm := nperm * fam!.recurlist[exp[i]][fam!.deg+1];
  od;

  for i in [1..fam!.deg] do
    wstates[i] := One(fam!.freegroup);
    perm := ();

    for j in [1..Length(exp)] do
      wstates[i] := wstates[i]*fam!.recurgens[exp[j]]!.states[i^perm];
      perm := perm * fam!.recurlist[exp[j]][fam!.deg+1];
    od;

#    if fam!.use_rws and Length(wstates[i]) > 0 then
#      wstates[i] := AG_ReducedForm(fam!.rws, wstates[i]);
#    fi;
  od;

  invertible := true;
  if not fam!.isgroup then
    for i in exp do
      if i <= fam!.numstates and not IsInvertibleSelfSim(fam!.recurgens[i]) then
        invertible := false;
        break;
      fi;
    od;
  fi;

  return __AG_CreateSelfSim(fam, w, wstates, nperm, invertible);
end);

###############################################################################
##
#M  SelfSim( <word>, <a> )
##
InstallMethod(SelfSim, "for [IsAssocWord, IsSelfSim]", [IsAssocWord, IsSelfSim],
function(w, a)
  return SelfSim(w, FamilyObj(a));
end);

InstallMethod(MappedWord, [IsAssocWord,
                           IsList and IsAssocWordCollection,
                           IsList and IsSelfSimCollection],
function(w, fgens, agens)
  local img;
  img := MappedWord(w, fgens, List(agens, a -> a!.word));
  return SelfSim(img, FamilyObj(agens[1]));
end);

###############################################################################
##
#M  SelfSim( <word>, <list> )
##
InstallMethod(SelfSim, "for [IsAssocWord, IsList]",
                   [IsAssocWord, IsList],
function(w, list)
  local fam;
  fam := SelfSimFamily(list);
  if fam = fail then
    return fail;
  fi;
  return SelfSim(w, fam);
end);

###############################################################################
##
#M  PrintObj( <a> )
##
InstallMethod(PrintObj, "for [IsSelfSim]",
              [IsSelfSim],
function (a)
  local deg, printword, i;

  printword := function(w)
    if IsOne(w) then Print(AG_Globals.identity_symbol);
    else Print(w); fi;
  end;

  if true then
    View(a);
    return;
  fi;

  deg := a!.deg;
  printword(a!.word);
  Print(" = (");
  for i in [1..deg] do
    printword(a!.states[i]);
    if i <> deg then Print(", "); fi;
  od;
  Print(")");
  if not IsOne(a!.perm) then AG_PrintTransformation(a!.perm); fi;
end);

###############################################################################
##
#M  ViewObj( <a> )
##
InstallMethod(ViewObj, "for [IsSelfSim]",
              [IsSelfSim],
function (a)
  if IsOne(a!.word) then Print(AG_Globals.identity_symbol);
  else Print(a!.word); fi;
end);

###############################################################################
##
#M  String( <a> )
##
InstallMethod(String, "for [IsSelfSim]",
              [IsSelfSim],
function (a)
  if IsOne(a!.word) then return AG_Globals.identity_symbol;
  else return String(a!.word); fi;
end);

###############################################################################
##
#M  Perm( <a> )
##
InstallMethod(Perm, "for [IsSelfSim]", [IsSelfSim],
function(a)
    return a!.perm;
end);

###############################################################################
##
#M  Word(<a>)
##
InstallMethod(Word, "for [IsSelfSim]", [IsSelfSim],
function(a)
    return a!.word;
end);

###############################################################################
##
#M  <a1> * <a2>
##
InstallMethod(\*, "for [IsSelfSim, IsSelfSim]", [IsSelfSim, IsSelfSim],
function(a1, a2)
    local a, i, fam, word, states;

    fam := FamilyObj(a1);
    word := a1!.word * a2!.word;

    if fam!.use_rws then
      word := AG_ReducedForm(fam!.rws, word);
    fi;

    if IsOne(word) then
      return One(a1);
    fi;

    states := List([1..a1!.deg], i -> a1!.states[i] * a2!.states[i^(a1!.perm)]);

    if fam!.use_rws then
      for i in [1..a1!.deg] do
        states[i] := AG_ReducedForm(fam!.rws, states[i]);
      od;
    fi;

    return __AG_CreateSelfSim(FamilyObj(a1), word, states, a1!.perm * a2!.perm,
                           IsInvertibleSelfSim(a1) and IsInvertibleSelfSim(a2));
end);

###############################################################################
##
#M  a1 < a2
##
InstallMethod(\<, "for [IsSelfSim, IsSelfSim]", IsIdenticalObj, [IsSelfSim, IsSelfSim],
function(a1, a2)
  local d, checked, checked_words, p, pos, np, np_words, i, perm1, perm2, cmp, G1, G2;

  G1 := GroupOfSelfSimFamily(FamilyObj(a1));
  G2 := GroupOfSelfSimFamily(FamilyObj(a2));

  # if a1 or a2 are elements of semigroup, which is not a group, then G1 or G2 is `fail'

  if IsIdenticalObj(G1, G2) and HasIsFinite(G1) and IsFinite(G1) and a1 = a2 then
    return false;
  fi;

  d := a1!.deg;

  checked := [[a1, a2]];
  checked_words := [[a1!.word, a2!.word]];
  pos := 0;

  while Length(checked) <> pos do
    pos := pos + 1;
    p := checked[pos];
    perm1 := p[1]!.perm;
    perm2 := p[2]!.perm;
    cmp := AG_TrCmp(perm1, perm2, d);
    if cmp < 0 then
      return true;
    elif cmp > 0 then
      return false;
    fi;
    for i in [1..d] do
      np := [Section(p[1], i), Section(p[2], i)];
      np_words := List(np, x -> x!.word);
      if not np_words in checked_words then
        Add(checked, np);
        Add(checked_words, np_words);
      fi;
    od;
  od;

  return false;
end);

###############################################################################
##
#M  InverseOp( <a> )
##
InstallMethod(InverseOp, "for [IsInvertibleSelfSim]", [IsInvertibleSelfSim],
function(a)
  local i, inv, fam, word, states;

  fam := FamilyObj(a);
  word := a!.word ^ -1;
  if fam!.use_rws then
    word := AG_ReducedForm(fam!.rws, word);
    if IsOne(word) then
      return One(a);
    fi;
  fi;

  states := List([1..a!.deg], i -> a!.states[i^(a!.perm^-1)]^-1);

  if fam!.use_rws then
    for i in [1..a!.deg] do
      states[i] := AG_ReducedForm(fam!.rws, states[i]);
    od;
  fi;

  return __AG_CreateSelfSim(FamilyObj(a), word, states, a!.perm^-1, true);
end);

###############################################################################
##
#M  OneOp( <a> )
##
InstallMethod(OneOp, "for [IsSelfSim]", [IsSelfSim],
function(a)
    return One(FamilyObj(a));
end);

###############################################################################
##
#M  StatesWords( <a> )
##
InstallMethod(StatesWords, "for [IsSelfSim]", [IsSelfSim],
function(a)
  return a!.states;
end);

###############################################################################
##
#M  Sections( <a> )
##
InstallMethod(Sections, "for [IsSelfSim]", [IsSelfSim],
function(a)
  return List(a!.states, s -> SelfSim(s, a));
end);

###############################################################################
##
#M  Section( <a>, <k>)
##
InstallMethod(Section, "for [IsSelfSim, IsPosInt]", [IsSelfSim, IsPosInt],
function(a, k)
  if k > a!.deg then
    Error("in Section(IsSelfSim, IsPosInt): invalid vertex ", k);
  fi;
  return SelfSim(a!.states[k], a);
end);

###############################################################################
##
#M  Section(a, seq)
##
## TODO
InstallMethod(Section, "for [IsSelfSim, IsList]", [IsSelfSim, IsList],
function(a, v)
  if Length(v) = 0 then
    return a;
  fi;

  if Length(v) = 1 then
    return Section(a, v[1]);
  fi;

  return Section(Section(a, v[1]), v{[2..Length(v)]});
end);

###############################################################################
##
#M  k ^ a
##
InstallMethod(\^, "for [IsPosInt, IsSelfSim]", [IsPosInt, IsSelfSim],
function(k, a)
    return k ^ Perm(a);
end);

###############################################################################
##
#M  seq ^ a
##
InstallMethod(\^, "for [IsList, IsSelfSim]", [IsList, IsSelfSim],
function(seq, a)
    local i, deg, img, cur;

    deg := DegreeOfTree(a);
    for i in seq do
      if not IsInt(i) or i < 1 or i > deg then
        Print("\^(IsList, IsFGSelfSim): ",
              i, "is out of range 1..", deg, "\n");
        return seq;
      fi;
    od;

    if Length(seq) = 0 then return []; fi;
    if Length(seq) = 1 then return [seq[1]^Perm(a)]; fi;

    return Concatenation([seq[1]^Perm(a)], seq{[2..Length(seq)]}^Section(a, seq[1]));
end);

###############################################################################
##
#M  PermOnLevelOp( <a>, <k>)
##
## TODO
InstallMethod(PermOnLevelOp, "for [IsInvertibleSelfSim, IsPosInt]",
              [IsInvertibleSelfSim, IsPosInt],
function(a, k)
  local dom, perm;

  if k = 1 then
    return a!.perm;
  fi;

  dom := AsList(Tuples([1..a!.deg], k));
  perm := List(dom, s -> s^a);
  perm := PermListList(dom, perm);

  return perm;
end);

InstallMethod(TransformationOnFirstLevel, [IsSelfSim],
function(a)
  return AsTransformation(a!.perm);
end);

###############################################################################
##
#M  IsActingOnBinaryTree( <a> )
##
InstallMethod(IsActingOnBinaryTree, "for [IsSelfSim]",
              [IsSelfSim],
function(a)
    return a!.deg = 2;
end);

###############################################################################
##
#M  IsOne( <a> )
##
InstallMethod(IsOne, "for [IsSelfSim]",
              [IsSelfSim],
function(a)
  local st, state_words, IsOneLocal, G;

  G := GroupOfSelfSimFamily(FamilyObj(a));

  if HasIsFinite(G) and IsFinite(G) then
    return IsOne(Image(IsomorphismPermGroup(G), a));
  fi;

  if HasIsContracting(G) and IsContracting(G) then
    return IsOne(Image(MonomorphismToAutomatonGroup(G), a));
  fi;

  IsOneLocal := function(s)
    local i, triv;
    if not IsOne(Perm(s)) then return false; fi;
    if s!.word in state_words then  return true; fi;

    Add(state_words, s!.word);
    triv := true;
    i := 1;
    while triv and i<=s!.deg do
      triv := IsOneLocal(Section(s, i));
      i := i+1;
    od;
    return triv;
  end;

  state_words := [];

  return IsOneLocal(a);
end);

###############################################################################
##
#M  a1 = a2
##
##
InstallMethod(\=, "for [IsSelfSim, IsSelfSim]", IsIdenticalObj, [IsSelfSim, IsSelfSim],
function(a1, a2)
  local areequalstates, d, checked_pairs, G1, G2;

  G1 := GroupOfSelfSimFamily(FamilyObj(a1));
  G2 := GroupOfSelfSimFamily(FamilyObj(a2));

  # if a1 or a2 are elements of semigroup, which is not a group, then G1 or G2 is `fail'

  if IsIdenticalObj(G1, G2) and HasIsFinite(G1) and IsFinite(G1) then
    return IsOne(Image(IsomorphismPermGroup(G1), a1*a2^-1));
  fi;

  d := a1!.deg;

  areequalstates := function(a, b)
    local j;

    if a!.word = b!.word then
      return true;
    fi;

    if [a!.word, b!.word] in checked_pairs then
      return true;
    else
      if a!.perm <> b!.perm then
        return false;
      fi;
      AddSet(checked_pairs, [a!.word, b!.word]);
      for j in [1..d] do
        if not areequalstates(Section(a, j), Section(b, j)) then
          return false;
        fi;
      od;
      return true;
    fi;
  end;

  checked_pairs := [];
  return areequalstates(a1, a2);
end);

InstallMethod(OrderUsingSections, "[IsSelfSim, IsCyclotomic]", true,
              [IsSelfSim, IsCyclotomic],
function(a, max_depth)
  local OrderUsingSections_LOCAL, cur_list, F, degs, vertex, AreConjugateUsingSmallRels, gens_ord2, CyclicallyReduce, res;

  CyclicallyReduce := function(w)
    local i, j, wtmp, reduced;

    for i in [1..Length(w)] do
      if -w[i] in gens_ord2 then w[i] := -w[i]; fi;
    od;

    repeat
      reduced := true;
      j := 1;
      while reduced  and j<Length(w) do
        if w[j]=-w[j+1] or (w[j]=w[j+1] and w[j] in gens_ord2) then
          reduced := false;
          wtmp := ShallowCopy(w{[1..j-1]});
          Append(wtmp, w{[j+2..Length(w)]});
          w := wtmp;
        fi;
        j := j+1;
      od;
    until reduced;

    repeat
      if Length(w)<2 then return w; fi;
      reduced := true;
      if w[1]=-w[Length(w)] or (w[1]=w[Length(w)] and w[1] in gens_ord2) then
        w := w{[2..Length(w)-1]};
        reduced := false;
      fi;
    until reduced;

    return w;
  end;

  AreConjugateUsingSmallRels := function(g, h)
    local i, g_list, h_list, long_cycle, l;
    g_list := CyclicallyReduce(LetterRepAssocWord(g));
    h_list := CyclicallyReduce(LetterRepAssocWord(h));
    if Length(g_list)<>Length(h_list) then return false; fi;
    l := [2..Length(g_list)];
    Add(l, 1);
    long_cycle := PermList(l);
    for i in [0..Length(g_list)-1] do
      if h_list=Permuted(g_list, long_cycle^i) then return true; fi;
    od;
    return false;
  end;

  OrderUsingSections_LOCAL := function(g)
    local i, el, orb, Orbs, res, st, reduced_word, loc_order;
    if IsOne(g) then return 1; fi;

    if IsActingOnBinaryTree(g) and IsSphericallyTransitive(g) then
      Info(InfoAutomGrp, 3, g!.word, " acts transitively on levels and is obtained from (", a!.word, ")^", Product(degs{[1..Length(degs)]}), "\n    by taking sections and cyclic reductions at vertex ", vertex);
      return infinity;
    fi;

    for i in [1..Length(cur_list)] do
      el := cur_list[i];
      if (AreConjugateUsingSmallRels(g!.word, el!.word) or AreConjugateUsingSmallRels((g!.word)^(-1), el!.word)) then
        if Product(degs{[i..Length(degs)]})>1 then
          if i>1 then Info(InfoAutomGrp, 3, "(", a!.word, ")^", Product(degs{[1..i-1]}), " has ", el!.word, " as a section at vertex ", vertex{[1..i-1]}); fi;
          Info(InfoAutomGrp, 3, "(", el!.word, ")^", Product(degs{[i..Length(degs)]}), " has conjugate of ", g!.word, " as a section at vertex ", vertex{[i..Length(degs)]});
          SetIsFinite(GroupOfSelfSimFamily(FamilyObj(a)), false);
          return infinity;
        else
#          Info(InfoAutomGrp, 3, "The group <G> might not be contracting, ", g, " has itself as a section.");
          return 1;
        fi;
      fi;
    od;
    if Length(cur_list)>=max_depth then return fail; fi;
    Add(cur_list, g);
    Orbs := OrbitsPerms([g!.perm], [1..g!.deg]);
    loc_order := 1;

    for orb in Orbs do
      Add(degs, Length(orb));
      Add(vertex, orb[1]);
      st := Section(g^Length(orb), orb[1]);
      reduced_word := AssocWordByLetterRep(FamilyObj(st!.word), CyclicallyReduce(LetterRepAssocWord(st!.word)));
#      Print(st!.word, " at ", vertex, "\n");
      res := OrderUsingSections_LOCAL(SelfSim(reduced_word, FamilyObj(g)));
      if res = infinity then return res;
      elif res=fail then
        loc_order:=fail;
      fi;
      if loc_order<>fail then
        loc_order := Lcm(loc_order, res*Length(orb));
      fi;
      Remove(degs);
      Remove(vertex);
    od;
    Remove(cur_list);
    return loc_order;
  end;

  F := FamilyObj(a)!.freegroup;
  if IsObviouslyFiniteState(FamilyObj(a)) then
    gens_ord2 := GeneratorsOfOrderTwo(FamilyObj(a));
  else
    gens_ord2 := [];
  fi;
  cur_list := [];
# degs traces at what positions we raise to what power
  degs := []; vertex := [];
  res := OrderUsingSections_LOCAL(a);
  if res=infinity then
    SetIsFinite(GroupOfSelfSimFamily(FamilyObj(a)), false);
    SetOrder(a, infinity);
  fi;
  return res;
end);

InstallMethod(OrderUsingSections, "for [IsSelfSim]", true,
              [IsSelfSim],
function(a)
  return OrderUsingSections(a, infinity);
end);

InstallMethod(SphericalIndex, "for [IsSelfSim]", [IsSelfSim],
function(a)
  # XXX check uses of SphericalIndex everywhere
  return rec(start := [], period := [a!.deg]);
end);

# XXX check uses of this everywhere
InstallMethod(DegreeOfTree, "for [IsSelfSim]", [IsSelfSim],
function(a)
  return a!.deg;
end);

# XXX check uses of this everywhere
InstallMethod(TopDegreeOfTree, "for [IsSelfSim]", [IsSelfSim],
function(a)
  return a!.deg;
end);

###############################################################################
##
#M  CanEasilyTestSphericalTransitivity( <a> )
##
InstallTrueMethod(CanEasilyTestSphericalTransitivity,
                  IsActingOnBinaryTree and IsSelfSim and IsFiniteState);

###############################################################################
##
#M  IsSphericallyTransitive( <a> )
##
InstallMethod(IsSphericallyTransitive, "for [IsInvertibleSelfSim]",
              [IsInvertibleSelfSim],
function(a)
  local w, i, ab, abs;

  if IsOne(Word(a)) then
    Info(InfoAutomGrp, 3, "IsSphericallyTransitive(a): false");
    Info(InfoAutomGrp, 3, "  IsOne(Word(a)): a = ", a);
    return false;
  fi;

  TryNextMethod();
end);

#########################################################################
##
#M  Order( <a> )
##
InstallMethod(Order, "for [IsInvertibleSelfSim]", true,
                   [IsInvertibleSelfSim],
function(a)
  local ord_loc;
  if HasIsFiniteState(GroupOfSelfSimFamily(FamilyObj(a))) and IsFiniteState(GroupOfSelfSimFamily(FamilyObj(a))) then
    if IsGeneratedByBoundedAutomaton(UnderlyingAutomatonGroup(GroupOfSelfSimFamily(FamilyObj(a)))) then
      return OrderUsingSections(a, infinity);
    fi;
  fi;
  if IsActingOnBinaryTree(a) and IsSphericallyTransitive(a) then
    return infinity;
  fi;
  ord_loc := OrderUsingSections(a, 10);
  if ord_loc <> fail then
    return ord_loc;
  fi;
  return OrderUsingSections(a, infinity);
end);

#########################################################################
##
#M  IsTransitiveOnLevel( <a>, <lev> )
##
InstallMethod(IsTransitiveOnLevel, "for [IsInvertibleSelfSim, IsPosInt]",
              [IsInvertibleSelfSim, IsPosInt],
function(a, lev)
  return Length(OrbitPerms([PermOnLevel(a, lev)], 1)) = a!.deg^lev;
end);

#########################################################################
##
#M  IsFiniteState( <a> )
##
InstallMethod(IsFiniteState, "for [IsSelfSim]", [IsSelfSim],
function(a)
  local st, state_words, find_all_sections;

  find_all_sections := function(s)
    local i;
    if not s!.word in state_words then
      Add(state_words, s!.word);
      for i in [1..s!.deg] do find_all_sections(Section(s, i)); od;
    fi;
  end;

  state_words := [];
  find_all_sections(a);
  SetAllSections(a, List(state_words, x -> SelfSim(x, FamilyObj(a))));
  return true;
end);

#########################################################################
##
#M  AllSections( <a> )
##
InstallMethod(AllSections, "for [IsSelfSim]", [IsSelfSim],
function(a)
  if IsFiniteState(a) then return AllSections(a); fi;
end);

#E


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

#F _IPCodeSums(<sums-spl>, <x-input-output-var>)
#F
#F Generates unoptimize inplace loop code for <sums-spl>
#F if we know how (i.e. 'ipcode' methods exist for <sums-spl>)
#F
_IPCodeSums := function(sums, x)
    local code;
    code := sums.ipcode(x);
    code.dimensions := sums.dimensions;
    code.root := sums;
    return code;
end;

Inplace.ipcode := (self, x) >> _IPCodeSums(self.child(1), x);

Inplace.code := (self, y, x) >> self.child(1).code(y,x);
#let(i := Ind(),
#    chain(self.child(1).ipcode(x),
#	  loop(i, Rows(self), assign(nth(y,i), nth(x,i)))));
#
LStep.ipcode := (self, x) >> _CodeSumsAcc(self.child(1), x, x);

Compose.ipcode := (self, x) >> chain(
    List(Reversed(self.children()), c->_IPCodeSums(c, x)));

SUM.ipcode := (self, x) >> chain(
    List(self.children(), c->_IPCodeSums(c, x)));

#2x2 inplace blockmat (one entry must be 0)
#A B
#0 C
#Inplace(A%G0 + S0''*B*G1 + C%G1);
BB.ipcode := (self, x) >> MarkForUnrolling(_CodeSums(self.child(1), x, x));
Blk.ipcode := (self, x) >> MarkForUnrolling(_CodeSums(self, x, x));
ISum.ipcode := (self, x) >> _CodeSums(self,x,x);


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


# Code must be in 0 .. 255.
CharInt(65);
# 'A'
IntChar('Z');
# 90


# 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()),
));


for i in [1 .. 5] do
    for j in [1 .. i] do
        Print("*");
    od;
    Print("\n");
od;

# *
# **
# ***
# ****
# *****


############################################################################
##
##  recognizeprim.gi              IRREDSOL                  Burkhard Höfling
##
##  Copyright © 2003–2016 Burkhard Höfling
##

###########################################################################
##
#F  IdPrimitiveSolubleGroup(<grp>)
##
##  see IRREDSOL documentation
##
InstallMethod(IdPrimitiveSolubleGroup, "for soluble group",
     true, [IsSolvableGroup and IsFinite], 0,
     G -> IdIrreducibleSolubleMatrixGroup(IrreducibleMatrixGroupPrimitiveSolubleGroup(G)));

RedispatchOnCondition(IdPrimitiveSolubleGroup, true, [IsGroup],
     [IsFinite and IsSolvableGroup], 0);

###########################################################################
##
#F  IdPrimitiveSolubleGroupNC(<grp>)
##
##  see IRREDSOL documentation
##
InstallGlobalFunction(IdPrimitiveSolubleGroupNC,
     function(G)
          local id;
          id := IdIrreducibleSolubleMatrixGroup(IrreducibleMatrixGroupPrimitiveSolubleGroupNC(G));
          SetIdPrimitiveSolubleGroup(G, id);
          return id;
     end);

############################################################################
##
#F  RecognitionPrimitiveSolubleGroup(<G>)
##
##  see IRREDSOL documentation
##
InstallGlobalFunction(RecognitionPrimitiveSolubleGroup,
    function(G, wantiso)

        local N, F, p, pcgsN, C, pcgsC, one, i, mat, mats, CC, H, hom, infomat, info, rep, ext, imgs, g, r;

        N := FittingSubgroup(G);

        pcgsN := Pcgs(N);
        p := Set(RelativeOrders(pcgsN));
        if Length(p) <> 1 then
            Error("G must be primitive");
        fi;

        p := p[1];

        if not IsAbelian(N) or ForAny(pcgsN, g -> g^p <> One(G)) then
            Error("G must be primitive");
        fi;

        # now we know that N is elementary abelian of exponent p

        F := GF(p);
        one := One(F);

        mats := [];

        C := ComplementClassesRepresentatives(G, N);
        if Length(C) <> 1 then
          Error("G must be primitive");
        fi;

        C := C[1];

        # N is complemented

        pcgsC := Pcgs(C);
        for g in pcgsC do
            mat := [];
            for i in [1..Length(pcgsN)] do
                mat[i] := ExponentsOfPcElement(pcgsN, pcgsN[i]^g)*one;
            od;
            Add(mats, ImmutableMatrix(F, mat));
        od;

        if not MTX.IsIrreducible(GModuleByMats(mats, F)) then
            Error("G must be primitive");
        fi;

        H := Group(mats);

        # the recognition part works best if the source of the representation isomorphism is a pc group

        if IsPcGroup(C) then
            CC := C;
        else
            CC := PcGroupWithPcgs(Pcgs(C));
        fi;

        SetSize(H, Size(C));
        hom := GroupGeneralMappingByImagesNC(CC, H, Pcgs(CC), mats);
        SetIsGroupHomomorphism(hom, true);
        SetIsBijective(hom, true);
        SetRepresentationIsomorphism(H, hom);

        infomat := RecognitionIrreducibleSolubleMatrixGroup(H, wantiso, wantiso, wantiso);

        info := rec(id := infomat.id);
        if not wantiso then
            return info;
        fi;

        rep := RepresentationIsomorphism(infomat.group);

        ext := PcGroupExtensionByMatrixAction(Pcgs(Source(rep)), rep);

        imgs := [];
        for g in Pcgs(CC) do
            Add(imgs, ImageElm(ext.embed, ImageElm(infomat.iso, g)));
        od;
        for r in infomat.mat do
            g := PcElementByExponents(ext.pcgsV, List(r, IntFFE));
            Add(imgs, g);
        od;

        info.group := ext.E;
        info.iso := GroupHomomorphismByImages(G, ext.E,
            Concatenation(pcgsC, pcgsN), imgs);
        if info.iso = fail or not IsBijective(info.iso) then
            Error("wrong group homomorphism");
        fi;
        return info;
    end);

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


#!/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
));