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

NewRulesFor(Circulant, rec(
    Circulant_PRDFT_FDataNT := rec(
    	forTransposition := false,
    	switch           := true,

    	applicable       := nt -> ObjId(nt.params[2]) = FDataNT and ObjId(nt.params[2].nt) = IPRDFT and
                                  nt.params[2].nt.params = [nt.params[1], 1] and nt.params[1] = -nt.params[3],

    	children      := nt -> let(n := nt.params[1],
    	    [[ spiral.transforms.realdft.IPRDFT(n, 1), spiral.transforms.realdft.PRDFT(n, -1) ]]),

        apply := (nt, C, cnt) -> C[1] * RCDiag(FDataOfs(nt.params[2].var, Cols(nt.params[2].nt), 0)) * C[2]
    )
));

#_isFractionP := (n, p) -> IntDouble(p*n)/p = n;
#
#NewRulesFor(TResample, rec(
#    TResample_TGath := rec(
#    	forTransposition := false,
#    	switch           := true,
#
#    	applicable       := nt -> ForAny(Zip2(nt.params[1], nt.params[2]), l-> l[1]<l[2]),
#
#    	children      := nt -> [[TResample(nt.params[1], nt.params[1], nt.params[3]), TGath(_toBox(nt.params[2], nt.params[1]))]],
#
#        apply := (nt, C, cnt) -> C[1] * C[2]
#    ),
#
#    TResample_TScath := rec(
#    	forTransposition := false,
#    	switch           := true,
#
#    	applicable       := nt -> ForAny(Zip2(nt.params[1], nt.params[2]), l-> l[1]>l[2]),
#
#    	children      := nt -> [[TScat(_toBox(nt.params[1], nt.params[2])), TResample(nt.params[2], nt.params[2], nt.params[3])]],
#
#        apply := (nt, C, cnt) -> C[1] * C[2]
#    ),
#
#    TResample_RC := rec(
#    	forTransposition := false,
#    	switch           := true,
#
#    	applicable       := nt -> Length(nt.params[1]) > 1 and Length(nt.params[2]) > 1 and Length(nt.params[3]) > 1
#                                  and nt.params[1][1] = nt.params[2][1],
#
#    	children      := nt -> [ List(Zip2(Zip2(nt.params[1], nt.params[2]), nt.params[3]), e-> ApplyFunc(TResample, List(Flat(e), i->[i]))) ],
#
#        apply := (nt, C, cnt) -> let(_C:= Reversed(C), n := Length(nt.params), Compose(
#            List([1..n], i->let(lens := List(_C, j->j.dims()[1]), Tensor(I(Product(lens{[1..i-1]})), _C[i], I(Product(lens{[i+1..n]})))))))
#    ),
#
#    TResample_I := rec(
#    	forTransposition := false,
#    	switch           := true,
#
#    	applicable       := nt -> Length(nt.params[1]) = 1 and Length(nt.params[2]) = 1 and Length(nt.params[3]) = 1
#                                  and nt.params[1][1] = nt.params[2][1]  and nt.params[3][1] = 0,
#
#    	children      := nt -> [[]],
#
#        apply := (nt, C, cnt) -> I(nt.dims()[1])
#    ),
#
#    TResample_PRDFT_frac := rec(
#    	forTransposition := false,
#        denominator      := 2,
#    	switch           := true,
#
#    	applicable       := (self,nt) >> Length(nt.params[1]) = 1 and Length(nt.params[2]) = 1 and Length(nt.params[3]) = 1
#                                  and nt.params[1][1] = nt.params[2][1] and nt.params[3][1] <> 0 and _isFractionP(nt.params[3][1], self.denominator),
#
#    	children      := nt -> [[ IPRDFT1(nt.params[1][1], -1), PRDFT1(nt.params[1][1], 1) ]],
#
#        apply := (self, nt, C, cnt) >> let(n := nt.params[1][1], nf := n/2+1, shft := IntDouble(nt.params[3][1] * self.denominator),
#            df := diagMul(fConst(nf, 1/n), fCompose(dOmega(self.denominator*n, shft), dLin(nf, 1, 0, TInt))),
#            dm :=RCDiag(RCData(df)),
#            C[1] *dm * C[2])
#    )
#));
#


lpbp := (1,2,3);
rpbp := (1,3,4);

gpbp := Group([lpbp, rpbp]);

lfbp := (1,2,3)(4,5,6);
rfbp := (1,6,7)(4,3,8);

gfbp := Group([lfbp,rfbp]);

bs := Blocks(gfbp, [1..8]);

hom := ActionHomomorphism(gfbp, bs, OnSets);

im := Image(hom);

iso := IsomorphismGroups(im, gfbp);

k := Kernel(im);


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

# ==========================================================================
# Scale
# ==========================================================================
Class(Scale, BaseContainer, rec(
    new := meth(self, s, spl)
        Constraint(IsSPL(spl));
	if s = 1 then return spl; fi;
        Constraint(IsScalarOrNum(s));
        return SPL(WithBases( self,
	    rec( _children := [spl],
		scalar := s,
		dimensions := spl.dims() )));
    end,

    rChildren := self >> [self.scalar, self._children[1]],
    rSetChild := meth(self, n, what)
        if n=1 then self.scalar := what;
        elif n=2 then self._children[1] := what;
        else Error("<n> must be in [1..2]");
        fi;
    end,
    #from_rChildren  -- inherited
    #-----------------------------------------------------------------------
    isPermutation := False,
    #-----------------------------------------------------------------------
    isReal := self >> IsRealNumber(self.scalar) and IsRealSPL(self._children[1]),
    #-----------------------------------------------------------------------
    toAMat := self >> EvalScalar(self.scalar) * AMatSPL(self._children[1]),
    #-----------------------------------------------------------------------
    arithmeticCost := meth(self, costMul, costAddMul)
        return costMul(self.scalar) * Minimum(self.dimensions)
	       + self._children[1].arithmeticCost(costMul, costAddMul);
    end
));


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

_ToDec := v -> let(d:=Length(v), Sum(List([1..d], e -> v[e]*2^(d-e))));
_ToBin := (i,d) -> List([1..d], e -> BinAnd(QuoInt(i, 2^(d-e)), 1));

_TB := (i, n) -> GF(2).one * _ToBin(i, n);
_TD := (i) -> _ToDec(IntVecFFE(i));

PrintHex := function(lst, del)
    local i;
    if Length(lst) = 0 then
        return;
    fi;
    Print(HexInt(lst[1]));
    for i in [2..Length(lst)] do
        Print(del, HexInt(lst[i]));
    od;
end;

Declare(B);
Class(B, PermClass, rec(
    def := (n,l) -> Checked(
        # make sure the 1s are inside the matrix.
        ForAll(l, e ->
            IsPosInt(e[1]) and IsPosInt(e[2])
            and e[1] <= Log2Int(n) and e[2] <= Log2Int(n)),
        # make sure 'l' is a list.
        IsList(l),
	# done
	rec()),

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

    # return the bit matrix
    bm := meth(self)
        local n, m, i;

        n := Log2Int(self.params[1]);

        # generate matrix of zeros.
        m := List([1..n], e -> List([1..n], ee -> 0));

        # fill in identity
        for i in [1..n] do
            m[i][i] := 1;
        od;

        # xor in individual 1s from 'l'
        for i in self.params[2] do
            m[i[1]][i[2]] := BinXor(m[i[1]][i[2]], 1);
        od;

        return m * GF(2).root;
    end,

    # convert the sparse bit matrix info into a permutation matrix
    toAMat := meth(self)
        local m, n, i, M;

        m := self.bm();
        n := self.params[1];

        # generate full permutation matrix
        M := [];
        for i in [0..(n-1)] do
            Add(M, BasisVec(
                n,
                _TD(m * _TB(i, Log2Int(n)))
            ));
        od;

        return AMatMat(M);
    end,

    transpose := (self) >> self(
        self.params[1],
        self._mklist(
            MatAMat(
                InverseAMat(
                    AMatMat(self.bm())
                )
            )
        )
    ),

    _mklist := function(b)
        local l, i, j;

        Constraint(Dimensions(b)[1] = Dimensions(b)[2]);

        b := b - MatSPL(I(Dimensions(b)[1])) * GF(2).root;

        l := [];
        for i in [1..Length(b)] do
            for j in [1..Length(b)] do
                if b[i][j] = GF(2).root then
                    Add(l, [i,j]);
                fi;
            od;
        od;

        return l;
    end,

    transpose := self >> B(self.params[1], List(self.params[2], e -> [e[2],e[1]])),

    sums := (self) >> Chain(Error("Don't use legacy sumsgen!!"), true),
));

Declare(B2);

Class(B2, PermClass, rec(
    def := (N, E, S) -> Checked(
            Is2Power(N),
            Is2Power(E),
            Is2Power(S),
            E*(S^2) >= N,
            rec( transposed := false)
    ),

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

    transpose := self >> CopyFields(
        ApplyFunc(B2, self.params), rec(transposed := not self.transposed)),

    getES := (self) >> Product(self.params{[2..3]}),

    bm := meth(self)
        local n, nes, b, i;

        n := Log2Int(self.params[1]);
        nes := n - Log2Int(self.params[2] * self.params[3]);

        b := MatSPL(I(n)) * GF(2).root;

        if self.transposed then
            for i in [1..nes] do
                b[i+nes][i] := GF(2).root;
            od;
        else
            for i in [1..nes] do
                b[i][i+nes] := GF(2).root;
            od;
        fi;

        return b * GF(2).root;
    end,

    toAMat := meth(self)
        local b, n, i, M;

        b := self.bm();
        n := self.params[1];

        # generate full permutation matrix
        M := [];
        for i in [0..(n-1)] do
            Add(M, BasisVec(
                n,
                _TD(_TB(i, Log2Int(n)) * b)
            ));
        od;

        return AMatMat(M);
    end,
));

Declare(BP);

BPI := (n) -> BP(MatSPL(I(Log2Int(n)))*GF(2).root);
BPL := (n,str) -> BP(MatSPL(Z(Log2Int(n), Log2Int(str)))*GF(2).root);

Class(BP, PermClass, rec(
    # p must be a full rank 2-d square matrix of size no larger than 29x29.
    def := function(arg)
        local n, m;

        n := Length(arg);

        if n = 1 and IsMat(arg[1]) then
            m := arg[1];
            n := Dimensions(m)[1];
        else if n > 0 and IsInt(arg[1]) then

            Constraint(ForAny(arg, e -> e < 2^n));
            m := List(arg, e -> _TB(e, n));
        fi; fi;

        # ints in SPIRAL are 29bits long, the upper bits are used for flags
        Constraint(IsInvertibleMat(AMatMat(m)) and Dimensions(m)[1] < 30);

        # NOTE: this is buggy, because fields below are not exposed through .rChildren
        return rec(
            size := 2^Dimensions(m)[1],
            mat:= m,
            fast := List(m, e -> _TD(e)),
            operations := rec(
                Print := (self) >> Print(self.name, "(", PrintCS(self.fast), ")")
            )
        );
    end,

    # NOTE: this is buggy, because .size is not exposed through .rChildren
    domain := self >> self.size,
    range  := self >> self.size,

#    this method converts 'i' to an array of bits, multiplies by the matrix, and converts back
#
#    lambda := self >> let(
#       d := Dimensions(self.params[1])[1],
#       i := Ind(self.size),
#       Lambda(i, todec(self.params[1] * tobin(i,d)))),

#   alternative method: ands a row of the matrix with the input and uses a parity
#   check to see if the bit is set in the output. shifts the output to the proper place. repeat
    lambda := self >> let(
        f := Length(self.fast),
        i := Ind(self.size),
        Lambda(i, Sum(List([1..f], e -> bin_parity(bin_and(self.fast[e], i))*2^(f-e))))),

    transpose := self >> self.__bases__[1](TransposedMat(self.mat))
));

## -----------------------------------------------------------------------------
# CL(N, STR, [E,S,A,R]) - counters a stride L(N, STR) for cache given by [E,S,A,R]
#
# this returns a compound object, namely, P * B where
#
# P = I(N/(E*S)) x L(E*S, Ceil(E*S/STR))
#
# and B is a permutation specified by a function linear on the bits
# which forces the P*B object to span the sets in the cache after L.
#

CL := function(N, STR, CS)
    local E,S,A,Q,P,l,k,i,j, n;

    E := CS[1];
    S := CS[2];

    # deal with degenerate cases and check params.

    # if cache is larger/equal to transform size, no
    # fancy footwork is necessary.
    if E * S >= N then
        return I(N);
    fi;

    # the cache must be large enough, otherwise this method
    # will not build an adequate perm to counteract the stride.
    if S^2 * E < N then
        Error("CL failure: Cache inadequately sized.");
    fi;

    # build the P portion as a bit matrix
    P := MatSPL(DirectSum(
        I(Log2Int(N/(E*S))),
        Z(Log2Int(E*S), Log2Int(E*S) - Log2Int(Maximum(E*S/ Maximum(2*S/E, STR),1)))
#        Z(Log2Int(E*S), Log2Int(E*S) - Log2Int(Maximum(E*S/STR,1)))
    )) * GF(2).root;

    # build the list of 1's in the B matrix.
    l := [];
    k := Log2Int(Minimum(STR, (N/(E*S))));
    i := Log2Int(N/(E*S)) + 1;
    n := Log2Int(N);

    # paranoia check
    if i-k < 1 then
        Error("Problem!!");
    fi;

    A := Copy(P);

    for j in [0..i-2] do
        A[j+1][j+i] := GF(2).root;
    od;

    Q := (TransposedMat(P) * A) - (MatSPL(I(n))*GF(2).root);

    for j in [1..n] do
        for i in [1..n] do
            if Q[j][i] = GF(2).root then
                Add(l, [j,i]);
            fi;
        od;
    od;

    # rebuild P as a normal perm matrix that corresponds to the
    # bit matrix from earlier.
    j := Maximum(E*S/ Maximum(2*S/E, STR),1);

    P := When(E*S = j or j = 1,
        I(N),
        Tensor(
            I(N/(E*S)),
            L(E*S, j)
        )
    );

    # combine the two and return
    # temp -- remove the B matrix, to remove the xor/and/shifts
    # this means we no longer guarantee spanning of the elements/sets
    # but the expressions should reduce better.
    return Compose(P,B(N, l));
end;

#F fB describes a permutation which can be expressed as a sparse linear
#F     function on the bits.
#F
#F I_2^n -> I_2^N
#F
#F params:
#F  n (input size)
#F  N (output size)
#F  l (list of location of 1s in the bit matrix)
#F
#F additional details:
#F   l defines a list of pairs. each pair describes the position
#F   of a 1 in bit matrix of size Nxn. The output mapping is described
#F   by (I + BM)(index), where BM is the sparse bit matrix generated by the
#F   pairs. the pairs themselves are in SPIRAL parlance, that is, [ROW, COL]
#F   where the first row/col is index 1.
#F
#F NOTE:
#F   in order for composition to work like matrix multiplication, the index
#F   is now applied from the LEFT (eg: (index)(I + BM)) instead of from the
#F   right (eg: (I + BM)(index)).
#F
#F example: fB(8,8, [[1,2],[2,3]])
#F
#F [ 1 1 0
#F   0 1 1
#F   0 0 1 ]
#F
#F
#F
Class(fB, FuncClass, rec(
    # full input definition.
    def := (n,N,l) -> rec(),
    range := self >> self.params[2],
    domain := self >> self.params[1],

    # abbreviated input forms, from most complex to simplest.
    abbrevs := [
        (n, N, l) -> Checked(Is2Power(n), Is2Power(N), IsList(l),
            [n,N,l]),
        (n, l) -> Checked(Is2Power(n), IsList(l),
            [n,n,l]),
        (n) -> Checked(Is2Power(n),
            [n,n,[]])
    ],

    transpose := (self) >> self(
        self.params[2],
        self.params[1],
        self._mklist(
            MatAMat(
                InverseAMat(
                    AMatMat(self.bm())
                )
            )
        )
    ),

    # LAMBDA with index on the LEFT: (index)(I + BM)
    lambdaLEFT := self >> let(
        i := Ind(self.params[1]),
        Lambda(i,
            When(Length(self.params[3]) = 0,
                i,
                ApplyFunc(
                    xor,
                    Concat([i], List(self.params[3], e -> let(
                        a := Log2Int(self.params[1]) - e[1],
                        b := Log2Int(self.params[2]) - e[2],
                        When(b = a,
                            bin_and(i, V(2^a)),
                            When(b > a,
                                shl(bin_and(i, V(2^a)), b - a),
                                shr(bin_and(i, V(2^a)), a - b)
                            )
                        )
                    )))
                )
            )
        )
    ),

    # LAMBDA with index on the RIGHT: (I + BM)(index)
    lambdaRIGHT := self >> let(
        i := Ind(self.params[1]),
        Lambda(i,
            When(Length(self.params[3]) = 0,
                i,
                ApplyFunc(
                    xor,
                    Concat([i], List(self.params[3], e -> let(
                        a := Log2Int(self.params[1]) - e[2],
                        b := Log2Int(self.params[2]) - e[1],
                        When(b = a,
                            bin_and(i, V(2^a)),
                            When(b > a,
                                shl(bin_and(i, V(2^a)), b - a),
                                shr(bin_and(i, V(2^a)), a - b)
                            )
                        )
                    )))
                )
            )
        )
    ),

    lambda := self >> self.lambdaLEFT(),

    # a bit more complicated than the B case since matrix is not necessarily
    # square.
    bm := meth(self)
        local n, N, m, minn, minN, j, i;

        n := Log2Int(self.params[1]);
        N := Log2Int(self.params[2]);

        # since we multiply the index from the right, i * BM,
        # and n -> N, the bit matrix is nxN. (n rows, N cols)

        # generate matrix of zeros.
        m := List([1..n], e -> List([1..N], ee -> 0));

        # fill in identity
        minn := When(N > n, 1, n - N + 1);
        minN := When(n > N, 1, N - n + 1);
        for i in [minn..n] do
            m[i][i-minn+minN] := 1;
        od;

        # xor in individual 1s from 'l'
        for i in self.params[3] do
            m[i[1]][i[2]] := BinXor(m[i[1]][i[2]], 1);
        od;

        return m * GF(2).root;
    end,

    # given a bit matrix, make a list.
    _mklist := function(b)
        local n,N, m, minn, minN, i, j, l;

        ## generate identity...
        #

        n := Dimensions(b)[1];
        N := Dimensions(b)[2];

        # generate matrix of zeros.
        m := List([1..n], e -> List([1..N], ee -> GF(2).root*0));

        # fill in identity
        minn := When(N > n, 1, n - N + 1);
        minN := When(n > N, 1, N - n + 1);
        for i in [minn..n] do
            m[i][i-minn+minN] := GF(2).root;
        od;

        ## subtract out identity.
        b := b - m;

        ## add a list entry for each nonzero elem in b.

        l := [];
        for j in [1..Length(b)] do #rows
            for i in [1..Length(b[1])] do # cols
                if b[j][i] = GF(2).root then
                    Add(l, [j,i]);
                fi;
            od;
        od;

        return l;
    end,
));

Class(fB2, fTensorBase, rec(
    __call__ := meth(arg)
        local self, children, lkup, res, h, es;
        self := arg[1];
        es := arg[2];
        children := Flat(Drop(arg, 2));
        if self.skipOneChild and Length(children)=1 then return children[1]; fi;

        h := self.hash;
        if h<>false then
            lkup := h.objLookup(self, children);
            if lkup[1]<>false then return lkup[1]; fi;
        fi;
        res := WithBases(self, rec(es := es, operations := RewritableObjectOps, _children := children));
        if h<>false then return h.objAdd(res, lkup[2]);
        else return res;
        fi;
    end,

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

    # this works just like the normal fTensor except that
    # subject to some conditions, the variables responsible for the
    # top-end of the range get XORed with variables responsible
    # for the middle of the range.

    lambda := meth(self)
        local es;

        es := self.es;

        # flatten the fTensors first
        # ensure we always work with 2 children
        if self.numChildren() > 2 then
            return self.leftBinary().lambda();
        fi;

        # the expression is now guaranteed to be a left sided
        # binary tree. we need to tell each node/leaf how it is
        # to be split according to the params available to the fB2.

    end,

    combine_op := (self, jv, split, f, g) >> let(a := Error("fB2.lambda()!"), self),
    transpose := self >> self.__bases__[1](List(self.children(), c->c.transpose()))
));


f := function(x,y)
    local z, helper;
    z := 1 - y;
    helper := function(bla)
        return x + y*z - bla;
    end;
    return helper;
end;

x -> x + 1;
{x,y} -> x + y + 1;

Print("This is a string\n");

for n in [1..100] do
  for i in [1..NrSmallGroups(n)] do
    G := SmallGroup(n,i);
    Print("SmallGroup(", n, ",", i, ") is abelian? ", IsAbelian(G), "\n");
    if IsPerfectGroup(G) = true then
      break;
    fi;
  od;
od;

BindGlobal("foo", 1);
BIND_GLOBAL("bar", 2);

r := rec(
    a := [1,2,3],
    b := true,
    c := fail,
   );

InstallImmediateMethod( IsFinitelyGeneratedGroup,
    IsGroup and HasGeneratorsOfGroup,
    function( G )
    if IsFinite( GeneratorsOfGroup( G ) ) then
      return true;
    fi;
    TryNextMethod();
    end );


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

########################################################################
#   rules for A x I, I x A, (A x I)L, (I x A)L
NewRulesFor(TTensorI, rec(
#   loop splitting for A x I
    AxI_LS_L := rec(
        info := "(A_rxs x I_n)(L|I) -> Sum(Sum(SAG))",
        forTransposition := false,
        applicable := nt -> let(P := nt.params,
            P[3] = AVec
            and nt.isTag(1, AVecMemL)
            and IsInt(P[2]/nt.firstTag().v)
            and P[2]/nt.firstTag().v>1
        ),
        children := nt -> [[
            When(nt.numTags() = 1,
                nt.params[1],
                nt.params[1].setTags(nt.params[1].withoutFirstTag())
            )
        ]],
        apply := (nt, C, cnt) -> let(
            v := nt.firstTag().v,
            i := Ind(v),
            m_by_v := nt.params[2]/v,
            j := Ind(m_by_v),
            d := C[1].dims(),
            fr := When(nt.params[4] = AVec,
                fTensor(fId(d[2]), fBase(m_by_v, j), fBase(v, i)),
                fTensor(fBase(m_by_v, j), fBase(v, i), fId(d[2]))
            ),

            ISumLS(j, m_by_v,
                Buf(Scat(fTensor(
                    fId(d[1]), fBase(m_by_v, j), fId(v)
                )))
                * ISum(i, v, Scat(fTensor(
                    fId(d[1]), fBase(v, i))) * C[1] * Gath(fr)
                )
            )
        )

#D        isApplicable := P -> P[3].isVec and Length(P[5]) > 0 and P[5][1].isMemL and IsInt(P[2]/P[5][1].v) and P[2]/P[5][1].v>1,
#D        allChildren := P -> let(pv:=P[5], v:=pv[1].v, d:=P[1].dims(), [[When(Length(pv)=1, P[1], P[1].setpv(Drop(pv, 1)))]]),
#D        rule := (P, C) -> let(
#D                v:=P[5][1].v, i:=Ind(v), m_by_v := P[2]/v, j:=Ind(m_by_v), d:=C[1].dims(),
#D                fr:=When(P[4].isVec, fTensor(fId(d[2]), fBase(m_by_v, j), fBase(v, i)), fTensor(fBase(m_by_v, j), fBase(v, i), fId(d[2]))),
#D                ISumLS(j, m_by_v, Buf(Scat(fTensor(fId(d[1]), fBase(m_by_v, j), fId(v)))) *
#D                    ISum(i, v, Scat(fTensor(fId(d[1]), fBase(v, i))) * C[1] * Gath(fr)))
#D            )
    ),
    AxI_LS_R := rec(
        info := "(I|L)(A_rxs x I_n) -> Sum(Sum(SAG))",
        forTransposition := false,
        applicable := nt -> let(P := nt.params,
            P[4] = AVec
            and nt.isTag(1, AVecMemR)
            and IsInt(P[2]/nt.firstTag().v)
            and P[2]/nt.firstTag().v > 1
        ),
        children := nt -> [[
            When(nt.numTags() = 1,
                nt.params[1],
                nt.params[1].setTags(nt.params[1].withoutFirstTag())
            )
        ]],
        apply := (nt, C, cnt) -> let(
            v := nt.firstTag().v,
            i := Ind(v),
            m_by_v := nt.params[2]/v,
            j := Ind(m_by_v),
            d := C[1].dims(),
            fw := When(nt.params[3] = AVec,
                fTensor(fId(d[1]), fBase(m_by_v, j), fBase(v, i)),
                fTensor(fBase(m_by_v, j), fBase(v, i), fId(d[1]))
            ),

            ISumLS(j, m_by_v,
                ISum(i, v, Scat(fw) * C[1] * Gath(fTensor(fId(d[2]), fBase(v, i))))
                * Buf(Gath(fTensor(
                    fId(d[2]), fBase(m_by_v, j), fId(v)
                )))
            )
        )

#D        isApplicable := P -> P[4].isVec and Length(P[5]) > 0 and P[5][1].isMemR and IsInt(P[2]/P[5][1].v) and P[2]/P[5][1].v>1,
#D        allChildren := P -> let(pv:=P[5], v:=pv[1].v, d:=P[1].dims(), [[When(Length(pv)=1, P[1], P[1].setpv(Drop(pv, 1)))]]),
#D        rule := (P, C) -> let(
#D                v:=P[5][1].v, i:=Ind(v), m_by_v := P[2]/v, j:=Ind(m_by_v), d:=C[1].dims(),
#D                fw:=When(P[3].isVec, fTensor(fId(d[1]), fBase(m_by_v, j), fBase(v, i)), fTensor(fBase(m_by_v, j), fBase(v, i), fId(d[1]))),
#D                ISumLS(j, m_by_v,
#D                    ISum(i, v, Scat(fw) * C[1] * Gath(fTensor(fId(d[2]), fBase(v, i)))) *
#D                            Buf(Gath(fTensor(fId(d[2]), fBase(m_by_v, j), fId(v)))))
#D            )
    ),
    LS_drop := rec(
        info := "drop tag",
        forTransposition := false,
        applicable := nt -> let(P := nt.params,
            (nt.isTag(1, AVecMemL) or nt.isTag(1, AVecMemR))
            and (
                (not IsInt(P[2]/nt.firstTag().v))
                or P[2]/nt.firstTag().v = 1
            )
        ),
        children := nt -> let(P := nt.params,
            [[ TTensorI(P[1], P[2], P[3], P[4]) ]]
        ),
        apply := (nt, C, cnt) -> C[1],

#D        isApplicable := P -> Length(P[5]) > 0 and (P[5][1].isMemL or P[5][1].isMemR) and
#D                            ((not IsInt(P[2]/P[5][1].v)) or P[2]/P[5][1].v=1),
#D        allChildren := P -> [[TTensorI(P[1], P[2], P[3], P[4], [])]],
#D        rule := (P, C) -> C[1],
    )
));

########################################################################
#   TCompose rules
NewRulesFor(TCompose, rec(
    TCompose_LS_L := rec(
        info := "TCompose loop splitting left",
        forTransposition := false,
        applicable := nt -> nt.isTag(1, AVecMemL),
        children := nt -> [ Concat(
            [ nt.params[1][1].setTags(nt.getTags()) ],
            Drop(nt.params[1], 1)
        )],
        apply := (nt, C, cnt) -> Compose(C)
#D        isApplicable := P -> Length(P[2]) > 0 and P[2][1].isMemL,
#D        allChildren := P -> [Concat([P[1][1].setpv(P[2])], Drop(P[1], 1))],
#D        rule := (P, C) -> Compose(C)
    ),
    TCompose_LS_R := rec(
        info := "TCompose loop splitting right",
        forTransposition := false,
        applicable := nt -> nt.isTag(1, AVecMemR),
        children := nt -> [ Concat(
            DropLast(nt.params[1], 1),
            [
                nt.params[1][Length(nt.params[1])].setTags(nt.getTags())
            ]
        )],
        apply := (nt, C, cnt) -> Compose(C)

#D        isApplicable := P -> Length(P[2]) > 0 and P[2][1].isMemR,
#D        allChildren := P -> [Concat(DropLast(P[1], 1), [P[1][Length(P[1])].setpv(P[2])])],
#D        rule := (P, C) -> Compose(C)
    )
));


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

Class(DWT, NonTerminal, DataNonTerminalMixin, rec(
    abbrevs := [
       (n,w) -> Checked(IsPosInt(n), IsEvenInt(n), n>=2, IsList(w), Length(w)=2,
	   [n, toFiltFunc(w[1]), toFiltFunc(w[2])]),
       (n,g,h) -> Checked(IsPosInt(n), IsEvenInt(n), n>=2,
	   [n, toFiltFunc(g), toFiltFunc(h)]),
    ],
    isReal := self >> true,

    setData := meth(self, gdata, hdata)
       self.params[2][1] := gdata; self.params[3][1] := hdata; return self;
    end,

    dims := self >> let(n:=self.params[1], k:=self.params[2][1].domain(),
                        [n, n + k - 2]),

    terminate := self >> let(
	n := self.params[1],
	g := self.params[2],
	h := self.params[3],
	VStack(Filt(n/2,g[1],g[2],2).terminate(), Filt(n/2,h[1],h[2],2).terminate())),

    HashId := self >> [ self.params[1], self.params[2][1].domain() ]
));

KnownCoeffs := filtfunc -> ObjId(filtfunc[1])=FList or
                           (ObjId(filtfunc[1])=FData and IsBound(filtfunc[1].var.value));

RulesFor(DWT, rec(
    #F DWT_Base: (base case)
    #F
    #F Computes DWT by definition
    #F
    DWT_Filt := rec(
	forTransposition := true,
	limit            := -1, # means no limit
	isApplicable     := (self, P) >> When(self.limit < 0, true,
	    P[1] <= self.limit or P[2][1].domain() <= self.limit),

	allChildren := P -> let(n := P[1], g := P[2], h := P[3],
	    [[ Filt(n/2,g[1],g[2],2), Filt(n/2,h[1],h[2],2) ]]),

	rule := (P, C) -> VStack(C[1], C[2])
    ),

    DWT_Base2 := rec(
	isApplicable := P -> true,
	rule := (P, C) -> let(n := P[1], g := P[2][1].tolist(), h := P[3][1].tolist(),
	    diff := Length(h) - Length(g),
	    gg := Cond(diff <= 0, g, Concatenation(g, Replicate(diff,0))),
	    hh := Cond(diff >= 0, h, Concatenation(h, Replicate(-diff,0))),
	    k := Maximum(Length(g), Length(h)),
	    When(n=1, Mat([gg,hh]), L(n,2)*RowTensor(n/2,k-2,Mat([gg,hh]))))
    ),

    DWT_Base4 := rec(
	isApplicable := P -> P[1] mod 4 = 0,
	rule := (P, C) -> let(n := P[1], g := P[2][1].tolist(), h := P[3][1].tolist(),
	    diff := Length(h) - Length(g),
	    gg := Cond(diff <= 0, g, Concatenation(g, Replicate(diff,0))),
	    hh := Cond(diff >= 0, h, Concatenation(h, Replicate(-diff,0))),
	    k := Maximum(Length(g), Length(h)),
	    When(n=1, Mat([gg,hh]), L(n,2)*RowTensor(n/4,k-2,BB(RowTensor(2,k-2,Mat([gg,hh]))))))
    ),
    DWT_Base8 := rec(
	isApplicable := P -> P[1] mod 8 = 0,
	rule := (P, C) -> let(n := P[1], g := P[2][1].tolist(), h := P[3][1].tolist(),
	    diff := Length(h) - Length(g),
	    gg := Cond(diff <= 0, g, Concatenation(g, Replicate(diff,0))),
	    hh := Cond(diff >= 0, h, Concatenation(h, Replicate(-diff,0))),
	    k := Maximum(Length(g), Length(h)),
	    When(n=1, Mat([gg,hh]), L(n,2)*RowTensor(n/8,k-2,BB(RowTensor(4,k-2,Mat([gg,hh]))))))
    ),

    #F DWT_Lifting: lifting steps, does not work yet
    #F
    DWT_Lifting := rec(
        info             := "DWT(n,g,h) -> Lifting steps",
        forTransposition := false,
        isApplicable     := P -> P[1]>2 and P[1] mod 2 =0 and KnownCoeffs(P[2]),
	switch := false,
        allChildren := function ( P )
            local n,g,h,vg,vh, lift_schemes,children,scheme,step,filts,pol;
            n       := P[1];
	    [g, h]  := [List(P[2][1].tolist(), EvalScalar), List(P[3][1].tolist(), EvalScalar)];
	    [vg,vh] := [P[2][2], P[3][2]];

            lift_schemes := Copy(HashLookupWav(HashTableWavelets, [[g,h],[vg,vh]]));
	    children := [];

            for scheme in lift_schemes do
	        filts := [];
	        for step in Drop(scheme,1) do
		    pol := FillZeros(ListPoly(step));
		    Add(filts, Filt(n/2, pol[1], pol[2]));
		od;
                # attach the indicator of the type of the first liftings step
		filts[1].lift := scheme[1];
		Add(children, filts);
            od;
            return children;
        end,

        rule := function ( P, C, Nonterms )
            local n, i, ind, b, l, M, ind0, ind1, lstep;
            n := P[1];
            b := Nonterms[1].lift;
            l:=Length(C);

	    ind0 := fTensor(fBase(2,0), fId(Rows(C[3])));
	    ind1 := fTensor(fBase(2,1), fId(Rows(C[3])));
	    lstep := (f,b) -> When(b=0,
		LStep(Scat(ind0) * f * Gath(ind1)),
		LStep(Scat(ind1) * f * Gath(ind0)));

            M := When(b < 0,
		SUM(Scat(ind0)*C[2]*Gath(ind1), Scat(ind1)*C[1]*Gath(ind0)),
		SUM(Scat(ind0)*C[2]*Gath(ind0), Scat(ind1)*C[1]*Gath(ind1)));

	    b := (b+2) mod 2; # make b positive
	    for i in [1 .. l-2] do
	        M := M * lstep(C[i+2], b);
		b := (b+1) mod 2;
            od;

	    return M.child(1) * Inplace(Compose(Drop(M.children(),1))) * L(n,2);
       end
    )
));


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

# This rule seems to be unnecessary
#

RulesFor(WHT, rec(
    #F WHT_Dirsum: switched off...
    #F
    #F see tensor products as direct sums so that they can be
    #F split separately
    #F
    #F   WHT_(2^k) =
    #F     prod_(i = 1)^r
    #F       dirsum_(a = 1)^2^(k_1 + .. + k_(i-1))
    #F         ( dirsum_(b = 1)^2^(k_(i+1) + .. + k_r) WHT_(2^(k_i))) ^
    #F           L^(2^(k_i + .. + k_r))_(2^(k_(i+1) + .. + k_r))
    #F         )
    #F
    WHT_Dirsum := rec (
	info             := "WHT_(2^k) -> prod dirsum (dirsum WHT_(2^ki))^L",
	forTransposition := false,
	switch           := false,
	isApplicable     := P -> P <> 1,
	isDerivable := meth ( self, S, C )
	    local C1, i, c, j;
	    if not (IsApplicableRule(self, S) and
		    ForAll(C, c -> ObjId(c) = WHT)) then return false; fi;
	    i  := 1;
	    C1 := [ ];
	    while i <= Length(C) do
	        c := C[i];
		for j in [i..i + 2^(S.params - c.params) - 1] do
		    if c.params <> C[j].params then
			return false;
		    fi;
		od;
		Add(C1, c);
		i := i + 2^(S.params - c.params);
	    od;
	    return Sum(C1, c -> c.params) = S.params;
	end,

	allChildren := function ( P )
	    local C, C1, p, c, i, k;
	    C := OrderedPartitions(P);
	    Unbind(C[Length(C)]);
	    C1 := [ ];
	    for p in C do
	         c := [ ];
		 for i in p do
		     for k in [1..2^(P - i)] do Add(c, WHT(i)); od;
		 od;
		 Add(C1, c);
	    od;
	    return C1;
	end,

	randomChildren := function ( P )
	    local C, sum, rand;
	    C   := [ ];
	    sum := 0;
	    while sum < P do
	        if sum = 0 then	rand := RandomList( [1..(P-1)] );
		else		rand := RandomList( [1..(P-sum)] );
		fi;
		Add( C, rand );
		sum := sum + rand;
	    od;
	    return Concatenation(List(C, c -> List([1..2^(P - c)], i -> WHT(c))));
	end,

	rule := function ( P, C )
	    local C1, c, left, right, factors, i;
	    i  := 1;
	    C1 := [ ];
	    while i <= Length(C) do
	        c := C[i];
		Add(C1, c);
	        i := i + 2^P/c.dimensions[1];
	    od;

	    left    := 1;
	    right   := 2^P / C1[1].dimensions[1];
	    factors := [ ];

            # first factor
	    Add(factors,
		Conjugate(
		    DirectSum(List([1..right], l -> C1[1])),
		    L(2^P, right))
	    );

	    left  := left * C1[1].dimensions[1];
	    right := right / C1[2].dimensions[1];

            # middle factors
	    for i in [2..Length(C1) - 1] do
  	        Add(factors, DirectSum(
		    List([1..left],
			k -> Conjugate(
			    DirectSum(List([1..right], l -> C1[i])),
			    L(right * C1[i].dimensions[1], right))
		    )
		));
		left  := left * C1[i].dimensions[1];
		right := right / C1[i+1].dimensions[1];
	    od;

            # last factor
	    Add(factors, DirectSum(List([1..left], k -> C1[Length(C1)])));
	    return Compose(factors);
	 end
    )
));


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

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

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

#sList(rels,r->Value(r,[vars[22]],[vars[2]+vars[12]]);

#
# c_1, c_2 not 0 , so they can be choosen c_1=c_2=1 => c_3=c_1/2
#
handleReg:=function()
	# a test that the coeffs are right
	#a:=root_group(1,xvars[1]);
	#b:=root_group(2,xvars[2]);
	#c:=root_group(3,xvars[3]);
	#test1:=evaluate_U(a*b*c,[[[xvars[1]],[One(APR)]],[[xvars[2]],[One(APR)]],[[xvars[3]],[One(APR)/2]]]);
	#test2:=evaluate_U(a*b*c,[[[xvars[1]],[One(APR)*2]],[[xvars[2]],[One(APR)*2]],[[xvars[3]],[One(APR)*2]]]);
	#test2-test1^2;

	local ua,ub,uab,u,e,nn,vals,rels,i,v;
	#ua:=root_group(1,2);
	#ub:=root_group(2,2);
	#uab:=root_group(3,2);
	ua:=root_group(1,1);
	ub:=root_group(2,1);
	uab:=root_group(3,1/2);
	u:=ua*ub*uab;
	e:=u-id_mat;

	nn:=List([1..2*nr_pos_roots+rank],i->xvars[i]);

	vals:=[];
	Append(vals,[[[xvars[6]],[Zero(APR)]]]);
	Append(vals,[[[xvars[4]],[Zero(APR)]]]);
	Append(vals,[[[xvars[5]],[Zero(APR)]]]);
	Append(vals,[[[xvars[7]],[2*xvars[8]]]]);
	Append(vals,[[[xvars[8]],[Zero(APR)]]]);
	Append(vals,[[[xvars[2]],[xvars[1]]]]);
	##
	#Append(vals,[[[xvars[1]],[Zero(APR)]]]);
	#Append(vals,[[[xvars[3]],[Zero(APR)]]]);
	#Append(vals,[[[xvars[7]],[Zero(APR)]]]);

	#
	# atentie la ordinea transpunerilor
	#
	rels:=nn*TransposedMat(u)-nn;
	for i in [1..Length(rels)] do
		for v in vals do
			Print(rels[i],"\n");
			rels[i]:=One(APR)*Value(rels[i],v[1],v[2]);
			nn[i]:=One(APR)*Value(nn[i],v[1],v[2]);
		od;
	od;
	return [u,nn,rels];
end;

#
# c_2=0
#
handle2:=function()
	local ua,ub,uab,u,e,nn,vals,rels,i,v;
	ua:=root_group(1,1);
	uab:=root_group(3,1);
	u:=ua*uab;
	e:=u-id_mat;

	nn:=List([1..2*nr_pos_roots+rank],i->xvars[i]);

	vals:=[];
	Append(vals,[[[xvars[4]],[Zero(APR)]]]);
	Append(vals,[[[xvars[6]],[Zero(APR)]]]);
	Append(vals,[[[xvars[2]],[-xvars[7]-xvars[8]]]]);
	Append(vals,[[[xvars[5]],[-2*xvars[7]+xvars[8]]]]);
	##
	Append(vals,[[[xvars[1]],[Zero(APR)]]]);
	Append(vals,[[[xvars[3]],[Zero(APR)]]]);
	Append(vals,[[[xvars[7]],[Zero(APR)]]]);

	#
	# atentie la ordinea transpunerilor
	#
	rels:=nn*TransposedMat(u)-nn;
	for i in [1..Length(rels)] do
		for v in vals do
			Print(rels[i],"\n");
			rels[i]:=One(APR)*Value(rels[i],v[1],v[2]);
			nn[i]:=One(APR)*Value(nn[i],v[1],v[2]);
		od;
	od;
	return [u,nn,rels];
end;


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

###############################################################################
##
#R  IsSelfSimFamilyRep
##
##  Any object from category SelfSimFamily which is created here, lies in a
##  category IsSelfSimFamilyRep.
##  Family of SelfSim object  < a >  contains all essential information about
##  (mathematical) automaton which generates group containing  < a > :
##  it contains automaton, properties of automaton and group generated by it,
##  etc.
##  Also family contains group generated by states of underlying automaton.
##
DeclareRepresentation("IsSelfSimFamilyRep",
                      IsComponentObjectRep and IsAttributeStoringRep,
                      [ "freegroup",      # IsSelfSim objects store words from this group
                        "freegens",       # list [f1, f2, ..., fn, f1^-1, ..., fn^-1, 1]
                                          # where f1..fn are generators of freegroup,
                                          # n is numstates; 1 is stored if and only if
                                          # trivstate is not zero.
                                          # Some fi^-1 may be missing if corresponding
                                          # generator is not invertible (but the list still
                                          # has the length of 2n + 1).
                        "recurgens",      # Generators of the group, list of length n.
                        "numstates",      # number of non - trivial generating states
                        "deg",
                        "trivstate",      # 0 or 2*numstates + 1
                        "isgroup",        # whether all generators are invertible
                        "names",          # list of non - trivial generating states
                        "recurlist",      # the automaton table, states correspond to freegens
                        "oldstates",      # mapping from states in the original table used to
                                          # define the group to the states in recurlist:
                                          # SelfSim(fam!.freegens[oldtstates[k]], fam) is the element
                                          # which corresponds to k-th state in the original automaton
                        "rws",            # rewriting system
                        "use_rws",        # whether to use rewriting system in multiplication
                        "use_contraction" # whether to use contraction in IsOne
                      ]);

BindGlobal("AG_FixRecurList",
function(list, oldstates, names)
  local i, j, k, reduced, deg, isgroup, numstates, perm, trivstate, trivstates, new_trivstates;

  deg := Length(list[1]) - 1;
  isgroup := true;
  trivstate := 0;
  trivstates := [];
  numstates := Length(list);

  # convert list to a "canonical" form

  for i in [1..numstates] do
    for j in [1..deg] do
      if not IsList(list[i][j]) then list[i][j] := [list[i][j]]; fi;
    od;
  od;

  # find if there are any "obviously" trivial states

  repeat
    new_trivstates := [];
    #  find new trivial states (new ones may appear in every iteration)
    for i in [1..Length(list)] do
      if (not i in trivstates) and AG_IsObviouslyTrivialStateInList(i, list) then
        Add(new_trivstates, i);
        numstates := numstates - 1;
      fi;
    od;

    for trivstate in new_trivstates do
      for i in [1..Length(list)] do
        for j in [1..deg] do
      #  remove trivstate from everywhere
          list[i][j] := Filtered(list[i][j], x -> AbsInt(x) <> trivstate);
      #  freely reduce words
          repeat
            reduced := true;
            for k in [1..Length(list[i][j]) - 1] do
              if list[i][j][k] = -list[i][j][k + 1] then
                Remove(list[i][j], k);
                Remove(list[i][j], k);
                reduced := false;
                break;
              fi;
            od;
          until reduced;
        od;
      od;
    od;
    Append(trivstates, new_trivstates);
  until new_trivstates = [];

  # move trivial state to the end
  Sort(trivstates);
  trivstates := Reversed(trivstates);

  for trivstate in trivstates do
    for i in [1..Length(list)] do
      for j in [1..deg] do
    #  remove trivstate from everywhere
        Apply(list[i][j], function(x)
                            if x > trivstate then return x - 1;
                            elif x < -trivstate then return x + 1;
                            fi;
                            return x;
                          end);
      od;
    od;

    for i in [1..Length(oldstates)] do
      if oldstates[i] = trivstate then
        oldstates[i] := 2*numstates + 1;
      elif oldstates[i] > trivstate then
        oldstates[i] := oldstates[i] - 1;
      fi;
    od;
    Remove(list, trivstate);
    Remove(names, trivstate);
  od;

  if trivstates <> [] then
    trivstate := 2*numstates + 1;
    list[trivstate] := List([1..deg], k -> []);
    list[trivstate][deg + 1] := ();
  fi;

  # add inverses of states
  for i in [1..numstates] do
    if AG_IsInvertibleStateInList(i, list) then
      list[i + numstates] := [];

      list[i][deg + 1] := AG_PermFromTransformation(list[i][deg + 1]);

      perm := list[i][deg + 1];
      list[i + numstates][deg + 1] := perm^-1;
      for j in [1..deg] do
        list[i + numstates][j] := -Reversed(list[i][j^(perm^-1)]);
      od;
    else
      isgroup := false;
      if list[i][deg + 1]^-1<>fail then
        list[i][deg + 1] := AG_PermFromTransformation(list[i][deg + 1]);
      fi;
    fi;
  od;

  return [list, numstates, trivstate, isgroup];
end);

###############################################################################
##
#M  SelfSimFamily( <list>, <names>, <bind_vars> )
##
InstallMethod(SelfSimFamily, "for [IsList, IsList, IsBool]",
              [IsList, IsList, IsBool],
function (list, names, bind_global)
  local deg, tmp, trivstate, numstates, i,
        freegroup, freegens, a, family, oldstates,
        isgroup;

  if not AG_IsCorrectRecurList(list, false) then
    Error("in SelfSimFamily(IsList, IsList, IsString):\n",
          "  given list is not a correct list representing self-similar group\n");
  fi;

# 1. make a local copy of arguments, since they will be modified and put into the result

  list := StructuralCopy(list);
  names := StructuralCopy(names);
  deg := Length(list[1]) - 1;

# 2. Find trivial states, permute states

  oldstates := [1..Length(list)];
  tmp := AG_FixRecurList(list, oldstates, names);
  list := tmp[1];
  numstates := tmp[2];
  trivstate := tmp[3];
  isgroup := tmp[4];

# 3. Create FreeGroup and FreeGens

  freegroup := FreeGroup(names);
  freegens := ShallowCopy(FreeGeneratorsOfFpGroup(freegroup));
  for i in [1..numstates] do
    if IsBound(list[i + numstates]) then
      freegens[i + numstates] := freegens[i]^-1;
    fi;
  od;
  if trivstate <> 0 then
    freegens[trivstate] := One(freegroup);
  fi;

# 4. Create family

  if isgroup then
    family := NewFamily("SelfSimFamily",
                        IsInvertibleSelfSim,
                        IsInvertibleSelfSim,
                        IsSelfSimFamily and IsSelfSimFamilyRep);
  else
    family := NewFamily("SelfSimFamily",
                        IsSelfSim,
                        IsSelfSim,
                        IsSelfSimFamily and IsSelfSimFamilyRep);
  fi;

  family!.isgroup := isgroup;
  family!.deg := deg;
  family!.numstates := numstates;
  family!.trivstate := trivstate;
  family!.names := names;
  family!.freegroup := freegroup;
  family!.freegens := freegens;
  family!.recurlist := list;
  family!.oldstates := oldstates;
  family!.use_rws := false;
  family!.rws := fail;
  family!.use_contraction := false;

  SetIsActingOnBinaryTree(family, deg = 2);
  SetDegreeOfTree(family, deg);
  SetTopDegreeOfTree(family, deg);

  family!.recurgens := [];
  for i in [1..Length(list)] do
    if IsBound(list[i]) then
      family!.recurgens[i]  :=
        __AG_CreateSelfSim(family, freegens[i],
                        List([1..deg], j -> AssocWordByLetterRep(FamilyObj(freegens[1]), list[i][j])),
                        list[i][deg + 1],
                        i > numstates or IsBound(list[i + numstates]));
    fi;
  od;

  # XXX It's evil to bind global names, consider AssignGeneratorVariables
  # XXX Check whether names are actually valid names for variables
  if bind_global then
    for i in [1..family!.numstates] do
      if IsBoundGlobal(family!.names[i]) then
        UnbindGlobal(family!.names[i]);
      fi;
      BindGlobal(family!.names[i], family!.recurgens[i]);
      MakeReadWriteGlobal(family!.names[i]);
    od;
    #BindGlobal(AG_Globals.identity_symbol, One(family));
    #MakeReadWriteGlobal(AG_Globals.identity_symbol);
  fi;

  return family;
end);

###############################################################################
##
#M  SelfSimFamily( <list> )
##
InstallMethod(SelfSimFamily, "for [IsList]", [IsList],
function(list)
  return SelfSimFamily(list, false);
end);

###############################################################################
##
#M  SelfSimFamily( <list>, <bind_vars> )
##
InstallMethod(SelfSimFamily, "for [IsList, IsBool]", [IsList, IsBool],
function(list, bind_vars)
  if not AG_IsCorrectRecurList(list, false) then
    Error("in SelfSimFamily(IsList):\n",
          "  given list is not a correct list representing self-similar group\n");
  fi;

  return SelfSimFamily(list,
                     List([1..Length(list)],
                          i -> Concatenation(AG_Globals.state_symbol, String(i))),
                     bind_vars);
end);

###############################################################################
##
#M  SelfSimFamily( <list>, <names> )
##
InstallMethod(SelfSimFamily, "for [IsList, IsList]", [IsList, IsList],
function(list, names)
  if not AG_IsCorrectRecurList(list, false) then
    Error("in SelfSimFamily(IsList, IsList):\n",
          "  given list is not a correct list representing automaton\n");
  fi;

  return SelfSimFamily(list, names, AG_Globals.bind_vars_autom_family);
end);

###############################################################################
##
#M  One( <fam> )
##
InstallMethod(One, "for [IsSelfSimFamily]", [IsSelfSimFamily],
function(fam)
  return __AG_CreateSelfSim(fam, One(fam!.freegroup),
                         List([1..fam!.deg], i -> One(fam!.freegroup)),
                         (), true);
end);

###############################################################################
##
#M  GroupOfSelfSimFamily( <fam> )
##
InstallMethod(GroupOfSelfSimFamily, "for [IsSelfSimFamily]",
              [IsSelfSimFamily],
function(fam)
  local g;

  if not fam!.isgroup then
    return fail;
  fi;

  if fam!.numstates > 0 then
    g := GroupWithGenerators(fam!.recurgens{[1..fam!.numstates]});
  else
    g := Group(One(fam));
  fi;

  SetUnderlyingSelfSimFamily(g, fam);
  SetIsGroupOfSelfSimFamily(g, true);
  # XXX
  SetGeneratingRecurList(g, fam!.recurlist);
  SetRecurList(g, fam!.recurlist);
  SetDegreeOfTree(g, fam!.deg);
  SetTopDegreeOfTree(g, fam!.deg);
  SetIsActingOnBinaryTree(g, fam!.deg = 2);

  return g;
end);

###############################################################################
##
#M  SemigroupOfSelfSimFamily( <fam> )
##
InstallMethod(SemigroupOfSelfSimFamily, "for [IsSelfSimFamily]",
              [IsSelfSimFamily],
function(fam)
  local g;

  if fam!.trivstate <> 0 then
    if fam!.numstates = 0 then
      g := SemigroupByGenerators([One(fam!.recurgens[fam!.trivstate])]);
    else
      g := MonoidByGenerators(fam!.recurgens{[1..fam!.numstates]});
    fi;
  else
    g := SemigroupByGenerators(fam!.recurgens{[1..fam!.numstates]});
  fi;

  SetUnderlyingSelfSimFamily(g, fam);

  # XXX
  SetGeneratingRecurList(g, fam!.recurlist);
  SetRecurList(g, fam!.recurlist);

  SetDegreeOfTree(g, fam!.deg);
  SetTopDegreeOfTree(g, fam!.deg);
  SetIsActingOnBinaryTree(g, fam!.deg = 2);
  SetIsSelfSimilarSemigroup(g, true);

  return g;
end);

###############################################################################
##
#M  UnderlyingFreeMonoid( <G> )
##
InstallMethod(UnderlyingFreeMonoid, "for [IsSelfSimFamily]",
              [IsSelfSimFamily],
function(fam)
  local monoid;

  if fam!.numstates <> 0 then
    monoid := MonoidByGenerators(GeneratorsOfGroup(fam!.freegroup));
    SetSize(monoid, infinity);
  else
    monoid := MonoidByGenerators(fam!.freegens[1]);
    SetSize(monoid, 1);
  fi;

  return monoid;
end);

###############################################################################
##
#M  UnderlyingFreeGroup( <G> )
##
InstallMethod(UnderlyingFreeGroup, "for [IsSelfSimFamily]",
              [IsSelfSimFamily],
function(fam)
  return fam!.freegroup;
end);

###############################################################################
##
#M  IsObviouslyFiniteState( <G> )
##
##  returns `true' if there are no words longer than 1 in the wreath recursion
InstallMethod(IsObviouslyFiniteState, "for [IsSelfSimFamily]",
              [IsSelfSimFamily],
function(fam)
  local list, g, i;
  list := fam!.recurlist;
  for g in list do
    for i in [1..fam!.deg] do
      if Length(g[i]) > 1 then return false; fi;
    od;
  od;
  IsFiniteState(GroupOfSelfSimFamily(fam));
  return true;
end);

#############################################################################
##
#M  GeneratorsOfOrderTwo( <fam> )
##
InstallMethod(GeneratorsOfOrderTwo, "for [IsSelfSimFamily]", [IsSelfSimFamily],
function(fam)
  if not fam!.isgroup then
    Error("not all generators of the family are invertible");
  fi;
  return Filtered(GeneratorsOfGroup(GroupOfSelfSimFamily(fam)), g -> IsOne(g^2));
end);

###############################################################################
##
##  AG_AbelImagesGenerators(<fam>)
##
InstallMethod(AG_AbelImagesGenerators, "for [IsAutomFamily]",
              [IsSelfSimFamily],
function(fam)
  if not fam!.isgroup then
    Error("the underlying group is not generated by automorphisms");
  fi;
  return AG_AbelImageAutomatonInList(fam!.recurlist);
end);

#E


# A Taggable operator (see tags.gi) is translated into an analogous SIMT operator that carries dim tag info

Class(SIMTTensor, Tensor, rec(

    abbrevs := [ (simt_dim, spl) -> When(IsASIMTDim(simt_dim) and ObjId(spl) = Tensor, [Flat([simt_dim, spl._children])], [[simt_dim, spl]] )  ]
                :: Tensor.abbrevs,

    new := meth(self, arg)
        local simt_dim, L;
        Constraint(IsList(arg) and Length(arg) >= 2);
        simt_dim := arg[1];
        L := arg{[2..Length(arg)]};
#        L:=Filtered(L,x->x<>I(1));
        if (Length(L)=0) then return I(1); fi;
        if Length(L)=1 then return L[1]; fi;

        return SPL(WithBases( self,
                        rec( simt_dim := simt_dim,
                             _children := L,
                             dimensions := [ Product(L, t -> t.dims()[1]),
                                             Product(L, t -> t.dims()[2]) ] )));
    end,

    from_rChildren := (self, rch) >> ApplyFunc(ObjId(self), [self.simt_dim]::rch).appendAobj(self)

    ));

Class(SIMTISum, ISum, rec(

    abbrevs := [ (simt_dim, spl) -> When(IsASIMTDim(simt_dim) and ObjId(spl) = ISum, [simt_dim, spl.var, spl.domain, spl._children[1]], [simt_dim, spl] )  ],

    new := meth(self, simt_dim, var, domain, expr)
        local res;
        Constraint(IsSPL(expr));
        # if domain is an integer (not symbolic) it must be positive
        Constraint(not IsInt(domain) or domain >= 0);
        var.isLoopIndex := true;
        res := SPL(WithBases(self, rec(_children := [expr], simt_dim := simt_dim, var := var, domain := domain)));
        res.dimensions := res.dims();
        return res;
    end,

    print := (self, i, is) >> Print(
        self.name, "(", self.simt_dim, ", ", self.var, ", ", self.domain, ",\n",
        Blanks(i+is), self._children[1].print(i+is, is), "\n",
        Blanks(i), ")", self.printA(),
        When(IsBound(self._setDims), Print(".overrideDims(", self._setDims, ")"), Print(""))
    )

    ));

Class(SIMTSUM, SUM, rec(

    new := meth(self, arg)
        local dims, simt_dim, L;
        Constraint(IsList(arg) and Length(arg) >= 2);
        simt_dim := arg[1];
        L := arg{[2..Length(arg)]};
        Constraint(Length(L) >= 1); Constraint(ForAll(L, IsSPL));
#        if Length(L) = 1 then return L[1]; fi;
        dims := L[1].dims();
        if not (IsSymbolic(dims[1]) or IsSymbolic(dims[2])) and
           not ForAll(Drop(L, 1), x -> let(d:=x.dims(),
                   IsSymbolic(d[1]) or IsSymbolic(d[2]) or d = dims))
            then Error("Dimensions of summands do not match"); fi;
        return SPL(WithBases(self, rec( simt_dim := simt_dim, _children := L, dimensions := dims)));
    end,

    from_rChildren := (self, rch) >> ApplyFunc(ObjId(self), [self.simt_dim]::rch).appendAobj(self),

    print := meth(self, i, is)
        local s, first, newline;

        if self._short_print or ForAll(self._children, x->not IsRec(x) or IsSPLSym(x) or IsSPLMat(x)) then
            newline := Ignore;
        else
            newline := self._newline;
        fi;
        first := true;
        Print(self.name, "( ", self.simt_dim, ",");
        for s in self._children do
                if(first) then first:=false;
                else Print(", "); fi;
                newline(i + is);
                When(IsSPL(s) or (IsRec(s) and IsBound(s.print) and NumGenArgs(s.print)=2),
                    s.print(i + is, is),
                    Print(s));
        od;
        newline(i);
        Print(")");
        self.printA();

        if IsBound(self._setDims) then
            Print(".overrideDims(", self._setDims, ")");
        fi;
    end,

    ));

Class(SIMTDirectSum, DirectSum, rec(

    abbrevs := [ arg ->
        [ Filtered(
            Flat(List(Flat(arg),
                s -> When(IsSPL(s) and ObjId(s)=DirectSum, s.children(), s))), x-> IsASIMTDim(x) or x.dimensions<>[0,0]) ]
    ],

    new := meth(self, arg)
        local simt_dim, L;
        Constraint(IsList(arg) and Length(arg) >= 2);
        simt_dim := arg[1];
        L := arg{[2..Length(arg)]};
        if ForAll(L, IsIdentitySPL)
            then return I(Sum(L, Rows));
        else
            return SPL(WithBases( self,
            rec( simt_dim := simt_dim, _children := L,
            dimensions := [ Sum(L, t -> t.dimensions[1]),
                            Sum(L, t -> t.dimensions[2]) ] )));
        fi;
    end,

    from_rChildren := (self, rch) >> ApplyFunc(ObjId(self), [self.simt_dim]::rch).appendAobj(self)

    ));

Class(SIMTVStack, VStack, rec(

    abbrevs := [ (simt_dim, spl) -> When(IsASIMTDim(simt_dim) and ObjId(spl) = VStack, [Flat([simt_dim, spl._children])], [[simt_dim, spl]] )  ]
                :: VStack.abbrevs,

    new := (self, arg) >> let(simt_dim := Checked(IsList(arg), arg[1]), spls := arg{[2..Length(arg)]},
                                Checked(
                                    Length(spls) >= 1,
                                    ForAll(spls, s -> IsSymbolic(Cols(s)) or IsSymbolic(Cols(spls[1])) or Cols(s) <= Cols(spls[1])),
                                    SPL(WithBases(self, rec(simt_dim := simt_dim, _children := spls)).setDims())
                                )
                            ),

    from_rChildren := (self, rch) >> ApplyFunc(ObjId(self), [self.simt_dim]::rch).appendAobj(self)

    ));

Class(SIMTHStack, HStack, rec(

    abbrevs := [ (simt_dim, spl) -> When(IsASIMTDim(simt_dim) and ObjId(spl) = HStack, [Flat([simt_dim, spl._children])], [[simt_dim, spl]] )  ]
                :: HStack.abbrevs,

    new := (self, arg) >> let(simt_dim := Checked(IsList(arg), arg[1]), spls := arg{[2..Length(arg)]},
                                Checked(
                                    IsList(spls),
                                    Length(spls) >= 1,
                                    ForAll(spls, s->Rows(s)<=Rows(spls[1])),
                                    SPL(WithBases(self, rec(simt_dim := simt_dim, _children := spls)).setDims())
                                )
                            ),

    from_rChildren := (self, rch) >> ApplyFunc(ObjId(self), [self.simt_dim]::rch).appendAobj(self)

));

Class(SIMTHStack1, SIMTHStack);

Class(SIMTBaseIterative, BaseIterative, rec(

    abbrevs := [ (simt_dim, spl) -> When(IsASIMTDim(simt_dim) and IsIterative(spl), [simt_dim, spl.var, spl.domain, spl._children[1]], [simt_dim, spl] )  ],

    new := meth(self, simt_dim, var, domain, expr)
        local res;
        Constraint(IsSPL(expr));
        # if domain is an integer (not symbolic) it must be positive
        Constraint(not IsInt(domain) or domain >= 0);
        var.isLoopIndex := true;
        res := SPL(WithBases(self, rec(_children := [expr], simt_dim := simt_dim, var := var, domain := domain)));
        res.dimensions := res.dims();
        return res;
    end,

    print := (self, i, is) >> Print(
        self.name, "(", self.simt_dim, ", ",  self.var, ", ", self.domain, ",\n",
        Blanks(i+is), self._children[1].print(i+is, is), "\n",
        Blanks(i), ")", self.printA(),
        When(IsBound(self._setDims), Print(".overrideDims(", self._setDims, ")"), Print(""))
    )
));

Class(SIMTIterVStack, SIMTBaseIterative, rec(
    dims := self >> [ self.child(1).dimensions[1] * self.domain,
                      self.child(1).dimensions[2] ],
));

Class(SIMTIterHStack, SIMTBaseIterative, rec(
    dims := self >> [ self.child(1).dimensions[1],
                      self.child(1).dimensions[2] * self.domain ],
));

Class(SIMTIterHStack1, SIMTIterHStack);

Class(SIMTIDirSum, SIMTBaseIterative, rec(
    dims := self >> let(d:=self._children[1].dimensions, [d[1]* self.domain, d[2]*self.domain])
));

Class(SIMTGrp, Grp);


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

Class(ISumn, ISum, rec(
    abbrevs := [ (dom, expr) -> Checked(IsPosIntSym(dom), IsSPL(expr), [dom, expr]) ],

    new := meth(self, domain, expr)
        local res;
	# ??? if domain = 1 then return SubstBottomUp(expr, var, e->V(0));
	res := SPL(WithBases(self, rec(_children := [expr], domain := domain)));
	res.dimensions := res.dims();
	return res;
    end,
    #-----------------------------------------------------------------------
    unrolledChildren := self >> Error("not implemented"),
    #    List(listRange(self.domain), u ->
    #	       SubstBottomUp(Copy(self._children[1]), self.var, e->V(u))),
    #-----------------------------------------------------------------------
    rChildren := self >> [self.domain, self._children[1]],
    rSetChild := meth(self, n, what)
        if n=1 then self.domain := what;
	elif n=2 then self._children[1] := what;
	else Error("<n> must be in [1,2]"); fi;
    end,
    #-----------------------------------------------------------------------
    print := (self,i,is) >> Print(self.name, "(", self.domain, ",\n",
	Blanks(i+is), self._children[1].print(i+is, is), "\n", Blanks(i), ")"),
    #-----------------------------------------------------------------------
    sums := self >> let(base := self.__bases__[1],
	base(self.var, self.domain, self._children[1].sums())),
));

Tensor.sumsn := meth(self)
    local ch, col_prods, row_prods, col_prods_rev, row_prods_rev, i, c,
          cp1, cp2, rp1, rp2, cols, rows, prod, term, scat, gath;
    if self.isPermutation() then return
	Prm(ApplyFunc(self.fTensor, List(self.children(), c->c.sums().func)));
    elif ForAll(self.children(), x->ObjId(x)=Diag) then return
	Diag(ApplyFunc(diagTensor, List(self.children(), c->c.element)));
    fi;

    ch := self.children();
    col_prods := ScanL(ch, (x,y)->x*Cols(y), 1);
    col_prods_rev := Drop(ScanR(ch, (x,y)->x*Cols(y), 1), 1);
    #row_prods := ScanL(ch, (x,y)->x*Rows(y), 1);
    #row_prods_rev := DropLast(ScanR(ch, (x,y)->x*Rows(y), 1), 1);

    prod := [];
    for i in [1..Length(ch)] do
        c := ch[i];
        if not IsIdentitySPL(c) then
	    [cp1, cp2] := [col_prods[i], col_prods_rev[i]];
	    #[rp1, rp2] := [row_prods[i], row_prods_rev[i]];
	    [rows, cols] := Dimensions(c);
	    [scat, gath] := [[cp2], [cp2]];
	    if cp2 <> 1 then
		Add(scat, 1);
		Add(gath, 1); fi;
	    if cp1 <> 1 then
		Add(scat, cp2*rows);
		Add(gath, cp2*cols); fi;

	    term := Scat(HH(cp1*rows*cp2, rows, 0, scat)) *
	            c.sums() *
		    Gath(HH(cp1*cols*cp2, cols, 0, gath));

	    if cp2 <> 1 then term := ISumn(cp2, term); fi;
	    if cp1 <> 1 then term := ISumn(cp1, term); fi;
	    Add(prod, term);
	fi;
    od;
    return Compose(prod);
end;

IterDirectSum.sumsn := self >> let(A := self.child(1),
    ISumn(self.domain,
	  Scat(HH(Rows(self), Rows(A), 0, [1, Rows(A)])) *
#	  spiral.sigma.SumsSPL( # NOTE: subst to ind -- potentially unsafe! (other loops!)
	      SubstVars(Copy(A), rec((self.var.id) := ind(self.var.range, 1))).sums() *
	  Gath(HH(Cols(self), Cols(A), 0, [1, Cols(A)]))));

RowTensor.sumsn := self >> let(A := self.child(1),
    ISumn(self.isize,
	  Scat(HH(Rows(self), Rows(A), 0, [1, Rows(A)])) *
#	  spiral.sigma.SumsSPL(A) *
	  A.sums() *
	  Gath(HH(Cols(self), Cols(A), 0, [1, Cols(A) - self.overlap]))));


# Dirty implementation
# Only P3 format, an image is a list of 3 matrices (r, g, b)
# Max color is always 255
WriteImage := function(name, img)
  local f, r, g, b, i, j, maxcolor, nrow, ncol, dim;
  f := OutputTextFile(name, false);
  r := img[1];
  g := img[2];
  b := img[3];
  dim := DimensionsMat(r);
  nrow := dim[1];
  ncol := dim[2];
  maxcolor := 255;
  WriteLine(f, "P3");
  WriteLine(f, Concatenation(String(ncol), " ", String(nrow), " ", String(maxcolor)));
  for i in [1 .. nrow] do
    for j in [1 .. ncol] do
      WriteLine(f, Concatenation(String(r[i][j]), " ", String(g[i][j]), " ", String(b[i][j])));
    od;
  od;
  CloseStream(f);
end;

PutPixel := function(img, i, j, color)
  img[1][i][j] := color[1];
  img[2][i][j] := color[2];
  img[3][i][j] := color[3];
end;

GetPixel := function(img, i, j)
  return [img[1][i][j], img[2][i][j], img[3][i][j]];
end;

NewImage := function(nrow, ncol, color)
  local r, g, b;
  r := color[1] + NullMat(nrow, ncol);
  g := color[2] + NullMat(nrow, ncol);
  b := color[3] + NullMat(nrow, ncol);
  return [r, g, b];
end;

# Reproducing the example from Wikipedia
black := [ 0, 0, 0 ];
g := NewImage(2, 3, black);
PutPixel(g, 1, 1, [255, 0, 0]);
PutPixel(g, 1, 2, [0, 255, 0]);
PutPixel(g, 1, 3, [0, 0, 255]);
PutPixel(g, 2, 1, [255, 255, 0]);
PutPixel(g, 2, 2, [255, 255, 255]);
PutPixel(g, 2, 3, [0, 0, 0]);
WriteImage("example.ppm", g);


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

DropMat := function(fmat)
    local mat;
    mat := Copy(fmat);
    if IsBound(mat.mat) then Unbind(mat.mat); fi;
    return mat;
end;

#   All size x size digit swap permutations that could be implemented in register for v
AllDigitSwaps := function(size, v)
    local ll, l, Nl, N, nl, n, r, mats, L1, L2, spl;

    mats := [];
    ll := DropLast(DivisorsInt(v), 1);
    for l in ll do
        Nl := Filtered(DivisorsInt(size/l), i -> i >= 4);
        for N in Nl do
            r:= size/(N*l);
            nl := DivisorsIntDrop(N);
            for n in nl do
                if l=1 then L1 := []; else L1 := [I(l)]; fi;
                if r=1 then L2 := []; else L2 := [I(r)]; fi;
                spl := Tensor(Concat(L1, [L(N,n)], L2));
                Add(mats, rec(spl:=spl, mat:=MatSPL(spl), l:=l, N:=N, n:=n, r:=r));
            od;
        od;
    od;

    return mats;
end;

#   NOTE: Better algorithm: outer loop over AllDigitSwaps

BuildCandidates := function(ops, v)
    local mats, op, p, v;
    mats := [];
    for op in ops do
        for p in op.permparams() do
            Add(mats,
                rec(instr := op,
                    p := p,
#   NOTE - how to get op.v correctly? maybe introduce op.getVLen() method
                    mat := let(ov := When(IsInt(op.v), op.v, op.v()), When(op.isUnop(),
                        TransposedMat(List([0..ov-1], i->op.semantic(BasisVec(ov, i), p))),
                        TransposedMat(Concat(List([0..ov-1], i->op.semantic(BasisVec(ov, i), Replicate(v, 0), p)),
                            List([0..ov-1], i->op.semantic(Replicate(v, 0), BasisVec(ov, i), p))))
                        ))
                ));
        od;
    od;
    return mats;
end;

#   Build rules from binary operations
#
BuildBinRules := function(arch)
    local archrules, binops, p, op1, op2, i1, i2, v, binmats, binperms, dsperms, opmat, fmat;

    v := arch.v;
    archrules := [];
    binops := Filtered(arch.instr, i->i.isBinop());

    #   find al candidate instructions to build permutations
    binmats := BuildCandidates(binops, v);

    # find all pairs of binops to build valid swap perms
    dsperms := AllDigitSwaps(2*v, v);
    for op1 in binmats do
        for op2 in binmats do
            opmat := Concat(op1.mat, op2.mat);
            if IsPermMat(AMatMat(opmat)) then
                fmat := Filtered(dsperms, i->i.mat=opmat);
                if Length(fmat)=1 then
                    i1 := op1.instr; i2 := op2.instr;
                    Add(archrules, rec(perm := DropMat(fmat[1]), instr:=[DropMat(op1), DropMat(op2)], v:=v, # NOTE: use full list!
                                vperm := VPerm(fmat[1].spl,
                                Subst((y,x) -> chain(
                                assign(vref(y, 0,$v), $i1(vref(x,0,$v), vref(x,$v,$v), $(op1.p))),
                                assign(vref(y,$v,$v), $i2(vref(x,0,$v), vref(x,$v,$v), $(op2.p))))),
                            v, op1.instr.vcost + op2.instr.vcost)
                            ));
                    dsperms := Filtered(dsperms, i->opmat<>i.mat);
                fi;
            fi;
        od;
    od;
    return archrules;
end;

#   Build rules from binary operations - first shuffle Inputs by LxI
#
BuildBinRulesLxI := function(arch, binrules, left, right)
    local archrules, binops, p, op1, op2, i1, i2, v, binmats, binperms, dsperms, opmat, fmat, lm, lmleft, lmright,
        lmc, lmvleft, lmvright, opmatconcat, i2v, splleft, splright, lval, rval;

    v := arch.v;
    archrules := [];
    binops := Filtered(arch.instr, i->i.isBinop());

    lm := MatSPL(Tensor(L(4,2), I(v/2)));
    lmleft := When(left, lm, MatSPL(I(2*v)));
    splleft := When(left, Tensor(L(4,2), I(v/2)), I(2*v));
    lmright := When(right, lm, MatSPL(I(2*v)));
    splright := When(right, Tensor(L(4,2), I(v/2)), I(2*v));
    i2v := MatSPL(I(2*v));

    lmc := Filtered(binrules, i->(i.perm.l=1 and i.perm.r=v/2 and i.perm.N=4 and i.perm.n=2));

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

    lmvleft := When(left, lmc[1].vperm, VTensor(I(2), v));
    lmvright := When(right, lmc[1].vperm, VTensor(I(2), v));

    lval := When(left, lmc[1].vperm._vcost + 0.2, 0);
    rval := When(right, lmc[1].vperm._vcost + 0.2, 0);

    #   find al candidate instructions to build permutations
    binmats := BuildCandidates(binops, v);

    # find all pairs of binops to build valid swap perms
    dsperms := AllDigitSwaps(2*v, v);
    for op1 in binmats do
        for op2 in binmats do
            opmatconcat := Concat(op1.mat, op2.mat);
            if opmatconcat  <> i2v then
                opmat := lmleft * opmatconcat * lmright;
                if IsPermMat(AMatMat(opmat)) then
                    fmat := Filtered(dsperms, i->i.mat=opmat);
                    if Length(fmat)=1 then
                        i1 := op1.instr; i2 := op2.instr;
                        Add(archrules, rec(perm := DropMat(fmat[1]), instr:=[DropMat(op1), DropMat(op2)], v:=v, # NOTE: use full list!
                                    vperm := lmvleft * VPerm(splleft * fmat[1].spl * splright,
                                    Subst((y,x) -> chain(
                                    assign(vref(y, 0,$v), $i1(vref(x,0,$v), vref(x,$v,$v), $(op1.p))),
                                    assign(vref(y,$v,$v), $i2(vref(x,0,$v), vref(x,$v,$v), $(op2.p))))),
                                v, 2 + lval + rval) * lmvright
                                ));
                        dsperms := Filtered(dsperms, i->opmat<>i.mat);
                    fi;
                fi;
            fi;
        od;
    od;
    return archrules;
end;

#   Build rules from unary operations
#
BuildUnRules := function(arch)
    local archrules, unops, unmats, unperms, unperms2, unmats2, p, op, op1, op2, v, dsperms, opmat, fmat, i1, i2;

    v := arch.v;
    archrules := [];

    #   unops -> perms
    unops := Filtered(arch.instr, i->i.isUnop());
    unmats := BuildCandidates(unops, v);

    # find all unops to build valid swap perms
    dsperms := AllDigitSwaps(v, v);
    unmats2 := [];
    for op in unmats do
        opmat := op.mat;
        if IsPermMat(AMatMat(opmat)) then
            fmat := Filtered(dsperms, i->i.mat=opmat);

            if Length(fmat)>=1 then
        i1 := op.instr;
        Add(archrules, rec(perm := DropMat(fmat[1]), instr:=DropMat(op), v:=v, # NOTE: use full list!
                    vperm := VPerm(fmat[1].spl,
                                   Subst((y,x) -> assign(vref(y, 0, $v), $i1(vref(x,0,$v), $(op.p)))),
                   v, 0.9*op.instr.vcost) # NOTE: avoid unops as they may not exist
        ));
                dsperms := Filtered(dsperms, i->opmat<>i.mat);
            else
                Add(unmats2, op);
            fi;
        fi;
    od;

    #   product of unops -> perms
    for op1 in unmats2 do
        for op2 in unmats2 do
            opmat := op2.mat * op1.mat;
            if IsPermMat(AMatMat(opmat)) then
                fmat := Filtered(dsperms, i->opmat=i.mat);

                if Length(fmat)=1 then
                    i1 := op1.instr;
                    i2 := op2.instr;
                    Add(archrules, rec(
                        perm  := DropMat(fmat[1]),
                        instr := [DropMat(op1), DropMat(op2)],
                        v     := v, # NOTE: use full list!
                        vperm := VPerm( fmat[1].spl, Subst((y,x) -> let(t := TempVec(TArray(x.t.t, $v)),
                                        decl(t, chain(assign(vref(t,0,$v), $i1(vref(x,0,$v), $(op1.p))),
                                                      assign(vref(y,0,$v), $i2(vref(t,0,$v), $(op2.p))))))),
                                        v, 0.9*(op1.instr.vcost+op2.instr.vcost))
                    ));
                    dsperms := Filtered(dsperms, i->opmat<>i.mat);
                fi;
            fi;
        od;
    od;

    return archrules;
end;

Find_x_I_vby2 := function(arch, i, j)
    local gmat, v, binops, binmats, fmat, op;

    v := arch.v;
    binops := Filtered(arch.instr, i->i.isBinop());

    #   find al candidate instructions to build permutations
    binmats := BuildCandidates(binops, v);
    gmat := MatSPL(Gath(fTensor(fDirsum(fBase(2,i), fBase(2,j)), fId(v/2))));

    fmat := Filtered(binmats, i->i.mat=gmat);
    return When(Length(fmat) > 0, DropMat(fmat[1]), []);
end;

Build_x_I_vby2 := arch -> List([0,1], i-> List([0,1], j-> Find_x_I_vby2(arch,i,j)));


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

Declare(rDFTSkew, realDFTPerm, fRealAccPease, _rDFT_u_func);

# A function to calculate "next" values of u for iteration j (used in rDFTSkew C-T rule)
_rDFT_u_func := function(u, j, k)
    if (u=0) then
        return V(fdiv(j, (2*k)));
    else
        if (IsEvenInt(j)) then
            return fdiv((u + idiv(j,2)), k);
        else
            return fdiv((1 - u + idiv(j,2)), k);
        fi;
    fi;
end;

# Recusively determine the value for u given k, q, and l, where
#    k = radix/2,
#    q = log_k(m),
#    l = access function (or iterator).
_rDFT_u_rec := function(depth, u, k, q, l)
   if (depth = q) then
       return V(u);
   else
       return _rDFT_u_func(_rDFT_u_rec(depth+1, u, k, q, l), idiv(imod(l, k^(depth+1)), V(k^(depth))), k);
   fi;
end;

# An Exp wrapper for _rDFT_u_rec.  This is used so Spiral does not try to evaluate the expression
# until Process_fPrecompute is called.
Class(_rDFT_u_rec_exp, Exp, rec(
    ev := self >> let(
        depth := self.args[1].ev(),
        u := self.args[2].ev(),
        k := self.args[3].ev(),
        q := self.args[4].ev(),
        l := self.args[5].ev(),
        _rDFT_u_rec(depth, u, k, q, l).ev()
    ),

    computeType := self >> TReal
));

# A function wrapper for _rDFT_u_rec_exp.  The rewriting rule uses this function.  Then, it is evaluated to the
# Exp above.  Then, that will evetually be evaluated into the final value.
Class(_rDFT_u_rec_wrapper, FuncClass, rec(
    def := (d, u, k, q, l) -> rec(N := 1, n := 1),
    lambda := self >> let(i := Ind(1), Lambda(i, _rDFT_u_rec_exp(self.params[1], self.params[2], self.params[3], self.params[4], self.params[5]))),
    t := TReal,
    eval := self >> When(self.domain() = 1 and self.rank() = 0, self.at(0).eval(), self),
    ev := self >> Checked(self.domain() = 1, self.at(0).ev()),
));

# An Exp wrapper for _rDFT_u_func.  This is used in the C-T rule, so the "next" values of u can be
# calcualted (but not evaluated until they can be.)
Class(_rDFT_u_r_exp, Exp, rec(
   ev := self >> let(
       u := self.args[1].ev(),
       j := self.args[2].ev(),
       k := self.args[3].ev(),
       _rDFT_u_func(u, j, k).ev()
   ),

   computeType := self >> TReal
));

# rDFTSkew(n,u).  This is the transform our streaming and Pease rules apply to.
Class(rDFTSkew, TaggedNonTerminal, rec(
    abbrevs := [(n,u) -> Checked(IsPosInt(n), [n, u])],
    dims := self >> let(n := self.params[1], [n,n]),
    isReal := self >> true,

    terminate := self >> let(
        n := self.params[1],
        k := 2,
        m := n/(2*k),
        a := Cond(IsValue(self.params[2]), self.params[2], V(self.params[2])),
        Cond(n=4,

            Cond(a=0,
                Tensor(F(2), I(2)),
                Diag(1,1,1,-1) * Tensor(F(2), I(2)) *
                   DirectSum(I(2), Mat([[cospi(a.ev()), -1*sinpi(a.ev())], [sinpi(a.ev()), cospi(a.ev())]])) *
                   L(4,2)
            ),

            RC(Cond(a=0, Kp(k*m, m), K(k*m, m))) *
            DirectSum(
                rDFTSkew(2*m, _rDFT_u_func(a, 0, k)).terminate(),
                rDFTSkew(2*m, _rDFT_u_func(a, 1, k)).terminate()
            ) *
            Tensor(rDFTSkew(2*k, a), I(m))
        )
    ),
));

NewRulesFor(PkRDFT1, rec(

    # PkRDFT1(n,0) --> DirectSum(F(2), I(n-2)) * rDFTSkew(n,0)
    # We simplify by writing the direct sum already in TTensorInd form.

    PkRDFT1_rDFTSkew := rec(
        forTransposition := false,
        applicable := (self, nt) >> nt.params[2] = 1,  #! temporary hack
        children := (self, t) >> let(
            n := t.params[1],
            i := Ind(n/2),
            tags := t.getTags(),

            [[ TCompose([TTensorInd(COND(eq(i,0), F(2), I(2)), i, APar, APar), rDFTSkew(n,V(0))]).withTags(tags) ]]
        ),

        apply := (nt, c, cnt) -> c[1]
    ),

    PkRDFT1_DFT := rec(
        forTransposition := false,
        applicable := (self, nt) >> nt.params[2] = 1, #! temporary
        children := (self, t) >>
            [[TCompose([TConjEven(t.params[1]), TRC(DFT(t.params[1]/2))]).withTags(t.getTags())]],

        apply := (nt, c, cnt) -> c[1]
    )
));

NewRulesFor(rDFTSkew, rec(
    # opts.breakdownRules := rec(rDFTSkew := [CopyFields(rDFT_Skew_CT, rec(radix:=4))])
    #

    # rDFTSkew(2*k*m,0) --> Perm * (I_k x rDFTSkew(2*m, f(u,l))) * (rDFTSkew(2*k, u) x I_m)
    rDFT_Skew_CT := rec(
        forTransposition := false,
        applicable := (self, nt) >> nt.params[1] > 4 and not nt.isTag(1, AStream),
        children := (self, t) >> let(
            n := t.params[1],
            m := 2,
            k := n/(2*m),

            u := t.params[2],
            j := Ind(k),

            [[ rDFTSkew(2*m, _rDFT_u_r_exp(u, j, k)), rDFTSkew(2*k, u), InfoNt(j) ]]
         ),

        apply := (t,c,nt) -> let(
            n := t.params[1],
            m := 2,
            k := n/(2*m),
            u := t.params[2],
            j := nt[3].params[1],
            D := Dat1d(TReal, 1),

            Data(D, fPrecompute(FList(TReal, [cospi(u)])),
                COND(eq(nth(D,0),1), Tensor(Kp(k*m,m), I(2)), Tensor(K(k*m,m), I(2))) *
                IDirSum(j, k, c[1]) *
                Tensor(c[2], I(m))
            )

        )

    ),

    # rDFTSkew(4,u) base rule.
    rDFT_Skew_Base4 := rec(
        forTransposition := false,
        applicable := (self, nt) >> nt.params[1] = 4,
        apply := (t, c, nt) -> let(
            u := t.params[2],
            DC := Dat1d(TReal, 1),
            DS := Dat1d(TReal, 1),

            Data(DC, fPrecompute(FList(TReal, [cospi(u)])),
                Data(DS, fPrecompute(FList(TReal, [sinpi(u)])),
                    COND(eq(nth(DC,0),1), I(4), Diag(1,1,1,-1)) *
                    Tensor(F(2), I(2)) *
                    DirectSum(I(2), Mat([[nth(DC,0), -1*nth(DS,0)], [nth(DS,0), nth(DC,0)]])) *
                    COND(eq(nth(DC,0),1), I(4), L(4,2))
                )

            )
        )
    ),

    # Streaming rDFTSkew(n,u) rule.
    rDFT_Skew_Stream := rec(
        forTransposition := false,

        radix := 4,

        applicable := (self, nt) >> let(
            k := self.radix/2,
            m := nt.params[1]/(2*k),
            logM := LogInt(m,k),
            IsInt(nt.params[1]/(2*k)) and nt.isTag(1, AStream) and nt.getTags()[1].bs >= self.radix and
            (k ^ logM = m)
        ),

        freedoms := t -> [[ ]],

        children := (self, nt) >> let(
            P    := nt.params,
            k    := self.radix/2,
            m    := P[1]/(k*2),
            tags := nt.getTags(),
            q    := LogInt(m,k),
            u    := nt.params[2],

            itvars := List([0..q], i->Ind(m)),

            [[ TCompose(Concatenation(
                 [ TPrm(realDFTPerm(2*k*m, k, u)) ],
                 [ TTensorInd(rDFTSkew(2*k, _rDFT_u_rec_wrapper(0, u, k, q, itvars[1])), itvars[1], APar, APar) ],
                 List([1..q], i-> TCompose([
                     Cond(i=1,
                         TTensorI(TPrm(L(2*k^(i+1), 2*k)), m/(k^i), APar, APar),
                         TTensorI(TPrm(Compose(Tensor(I(k), L(2*(k^i), k^(i-1))), L(2*k^(i+1), 2*k))), m/(k^i), APar, APar)
                     ),
                     TTensorInd(rDFTSkew(2*k, _rDFT_u_rec_wrapper(0, u, k, q-i, bin_shr(itvars[i+1], Log2Int(k^i)))),
                         itvars[i+1], APar, APar)

                 ])),
                 [ TPrm(L(2*k^(q+1), m)) ]
             )).withTags(tags)]]
        ),

        apply := (nt, c, cnt) -> c[1]

    ),

    # Non-uniform radix streaming breakdown rule for rDFTSkew(n,u)
    # This does not work correctly when u<>0 and k > 2.   I still need to debug this.
    # NOTE
    rDFT_Skew_Stream_Mult_Radices := rec(
        forTransposition := false,

        applicable := (self, nt) >> let(
            n  := nt.params[1],
            rp := paradigms.stream.rDFT_Skew_Stream.radix,
            kp := rp/2,
            mp := kp ^ LogInt(n/(2*kp), kp),
            m  := kp * mp,
            k  := n/(2*m),
            u := nt.params[2],

            IsInt(nt.params[1]/(2*k)) and nt.isTag(1, AStream) and
                not paradigms.stream.rDFT_Skew_Stream.applicable(nt) and (u=0 or k<=2)
        ),

        freedoms := t -> [[ ]],

        children := (self, nt) >> let(
            n  := nt.params[1],
            rp := paradigms.stream.rDFT_Skew_Stream.radix,
            kp := rp/2,
            mp := kp ^ LogInt(n/(2*kp), kp),
            m  := kp * mp,
            k  := n/(2*m),
            logM := LogInt(m,k),

            tags := nt.getTags(),
            u := nt.params[2],
            i := Ind(k),

            [[ TCompose([ TPrm(Tensor(COND(eq(u,0), Kp(k*m, m), K(k*m,m)), I(2))),
                          TTensorInd(rDFTSkew(2*m, _rDFT_u_r_exp(u, i, k)), i, APar, APar),
                          TPrm(L(2*k*m, 2*k)),
                          TTensorI(rDFTSkew(2*k, u), m, APar, APar),
                          TPrm(L(2*k*m, m)) ]).withTags(tags) ]]

        ),

        apply := (nt, c, cnt) -> c[1]

    ),

    # Pease rDFTSkew(n,0) rule
    rDFT_Skew_Pease := rec(
        forTransposition := false,

        unroll_its := 1,
        radix      := 4,

        # For some k between minRadix/2 and maxRadix/2, P[1]=2*k*m, where m=k^p where p is an integer
        applicable := (self, nt) >> let(
            k := self.radix/2,
            m := nt.params[1]/(2*k),
            logM := LogInt(m, k),

            nt.params[2] = 0 and   # If we were to support u <> 0, we would need to change the
                                   # the way we store constants.  The trick we currently use
                                   # to go from O(n log n) to O(n) would not work without modification
                                   # (it may in fact not work at all).
            IsInt(nt.params[1]/(2*k)) and
            (k ^ logM = m) and
            IsInt((logM+1)/self.unroll_its) and
            (logM+1)/self.unroll_its > 1 and
            nt.isTag(1, AStream)
        ),

        freedoms := t -> [[ ]],

	    children := (self, nt) >> let(
            P     := nt.params,
            k     := self.radix/2,
            m     := P[1]/(k*2),
            tags  := nt.getTags(),
            q     := LogInt(m,k),
            it_i  := Ind((q+1) / self.unroll_its),
            it_l  := Ind(m),
            u     := 0,

            it_ur := i >> self.unroll_its * it_i + i,
            f_ur  := i >> fComputeOnline(fRealAccPease(k, m, it_ur(i), it_l)),
            u_ur  := i >> _rDFT_u_rec_wrapper(0, u, k, q, f_ur(i)),

            # This provides stage i of the datapath.
            stage      := i >> TCompose([TTensorInd(rDFTSkew(2*k, u_ur(i)), it_l, APar, APar), TL(2*k*m, 2*m, 1, 1)]),

            # This gives a full stage (multiple stage(i) when we unroll).
            full_stage := List([1..self.unroll_its], t -> stage(t-1)),

            [[ TCompose([
                  realDFTPerm(2*k*m, k, u),
                  TICompose(it_i, it_i.range, TCompose(full_stage)),
                  TL(2*k*m, k*m, 1, 1)
               ]).withTags(tags)]]
        ),

        apply := (nt, c, cnt) -> c[1]
    ),
));

# Pease rDFTSkew access function for rDFTSkew(2*k*m, 0) where i is the stage and l is the position in stage.
#     fRealAccPease(k, m, i, l)
Class(fRealAccPease, FuncClass, rec(
   def := (k, m, i, l) -> rec(N:=m, n:=1),

   domain := self >> 1,
   range  := self >> self.params[2],

   lambda := self >> let(k := self.params[1],
                         m := self.params[2],
                         i := self.params[3],
			             l := self.params[4],
			             j := Ind(1),
                         logk := LogInt(k,2),

       Lambda(j, bin_and(l, bin_shr(m-1, logk*i)))),

   computeType := self >> TInt,
   t := TInt,
   eval := self >> When(self.domain() = 1 and self.rank() = 0, self.at(0).eval(), self),
   ev := self >> Checked(self.domain() = 1, self.at(0).ev())

));

# The output permutation in Pease or streaming rDFTSkew algorithms
# realDFTPerm(n, k), where n = 2*k*m
Class(realDFTPerm, TaggedNonTerminal, rec(

    abbrevs := [(n, k, u)      -> [n, k, u]],

    dims := self >> [ self.params[1], self.params[1] ],
    domain := self >> self.params[1],
    range := self >> self.params[1],

    terminate := self >> let(
	    n := self.params[1],
        k := self.params[2],
        u := Cond(IsExp(self.params[3]), self.params[3].ev(), self.params[3]),
        m := n/(2*k),
        r := LogInt(m,k),

        res := Cond(n < 8, I(n),
            Cond(u=0,
	            Tensor(
                    Compose(List([0..r-1], l->
                        DirectSum(Kp(k*m/(k^l), k*m/(k^(l+1))),
                            Tensor(I(k^l-1), K(k*m/(k^l), k*m/(k^(l+1))))
                        )
                    )),
                    I(2)
                ),
	            Tensor(
                    Compose(List([0..r-1], l->
                        Tensor(I(k^l), K(k*m/(k^l), k*m/(k^(l+1))))
                    )),
                    I(2)
                )
            )
        ),

        Cond(self.transposed, res.transpose(), res)
    ),

    isReal := self >> true,

    print := meth(self, indent, indentStep)
        local lparams, mparams;
        if not IsBound(self.params) then Print(self.name); return; fi;
        Print(self.name, "(");
        if IsList(self.params) then
            lparams := Filtered(self.params, i->not (IsList(i) and i=[]));
            mparams := Filtered(lparams, i->not (IsBool(i) and not i));
            DoForAllButLast(mparams, x -> Print(x, ", "));
            Print(Last(mparams));
        else
            Print(self.params);
        fi;
    Print(")", When(self.transposed, ".transpose()", ""));
    end,

));

NewRulesFor(realDFTPerm, rec(

    # Rule to place realDFTPerm into a StreamPermGen wrapper.
    # realDFTPerm --> StreamPermGen(realDFTPerm)

    realDFTPerm_Stream := rec(
        isApplicable := (self, P) >> Checked(IsList(P[2]) and IsBound(P[2][1].bs),
	                                      IsInt((2^P[1])/P[2][1].bs)),

      children := (self, nt) >> [[]],
      apply := (nt, c, cnt) -> StreamPerm([realDFTPerm(nt.params[1], nt.params[2], nt.params[3])], 1, nt.getTags()[1].bs, 0),
   )
));

Class(TConjEvenStreamBB, NonTerminal, rec(
    abbrevs := [(n,j) -> Checked(IsPosInt(n), [n,j])],
    dims    := self >> [4,4],
    isReal  := self >> true,

    terminate := self >> let(
        j  := self.params[2].ev(),
        n  := self.params[1],

        c  := cospi(2*j/n)/2,
        s  := sinpi(2*j/n)/2,

        Cond(j=0,
            Mat([[1,1,0,0], [1, -1, 0, 0], [0, 0, 1, 0], [0, 0, 0, 1]]),

            Diag(1,1,1,-1) *
            Tensor(F(2), I(2)) *
            DirectSum(Diag(1/2, 1/2), Mat([[c, -1*s], [s, c]])) *
            L(4,2) *
            Mat([[1,0,1,0],[0,1,0,1],[0,1,0,-1],[-1,0,1,0]])

        )
    )
));

NewRulesFor(TConjEven, rec(
    TConjEven_stream := rec(
        switch := false,
        applicable := (self, t) >> 2^Log2Int(t.params[1]) = t.params[1] and
                                       t.isTag(1, AStream) and t.getTags()[1].bs >= 4,

        children := (self, nt) >> let(
            n    := nt.params[1],
            tags := nt.getTags(),
            i    := Ind(n/4),
	    rot  := nt.params[2],

            [[ TCompose([
#                    TPrm(Tensor(DirectSum(I(n/4+1), J(n/4-1)) * L(n/2,2), I(2))),
#                    TPrm(Tensor(Kp(n/2, 2), I(2))),
                    TRC(TPrm(Kp(n/2, 2))),
		    # YSV: NOTE -- handle <rot> below
                    TTensorInd(TConjEvenStreamBB(n, i), i, APar, APar),
#                    TPrm(Tensor(L(n/2, n/4) * DirectSum(I(n/4+1), J(n/4-1)), I(2)))
#                    TPrm(Tensor(Kp(n/2, 2).transpose(), I(2)))
                    TRC(TPrm(Kp(n/2, 2).transpose()))
               ]).withTags(tags)]]
        ),

        apply := (nt, c, cnt) -> c[1]

    )
));

NewRulesFor(TConjEvenStreamBB, rec(
    TConjEvenStreamBB_base := rec(
        switch := false,
        forTransposition := false,
        applicable := (self, nt) >> IsPosInt(nt.params[1]),

        # new: better alg.  store n/2 words, perform 4 multiplications
        apply := (t, c, nt) -> let(
            j := t.params[2],
            n := t.params[1],
            cs := Dat1d(TReal, 1),
            sn := Dat1d(TReal, 1),

            Data(cs, fPrecompute(FList(TReal, [fdiv(cospi(fdiv(2*j,n)),2)])),
                Data(sn, fPrecompute(FList(TReal, [fdiv(sinpi(fdiv(2*j,n)),2)])),
                    COND(eq(j,0),
                        Mat([[1, 1, 0, 0], [1, -1, 0, 0], [0, 0, 1, 0], [0, 0, 0, 1]]),
                        Diag(1,1,1,-1) *
                        Tensor(F(2), I(2)) *
                        Mat([[1/2, 0, 0, 0], [0, 1/2, 0, 0], [0, 0, nth(cs,0), -1*nth(sn,0)], [0, 0, nth(sn,0), nth(cs,0)]]) *
                        L(4,2) *
                        Mat([[1, 0, 1, 0], [0, 1, 0, 1], [0, 1, 0, -1], [-1, 0, 1, 0]])
                    )
                )
            )
        )

        # Store n/2 words
#         apply := (t, c, nt) -> let(
#             j := t.params[2],
#             n := t.params[1],
#             d0 := Dat1d(TReal, 1),
#             d1 := Dat1d(TReal, 1),

#             Data(d0, fPrecompute(FList(TReal, [fdiv(sinpi(fdiv(2*j,n)),2)])),
#                 Data(d1, fPrecompute(FList(TReal, [fdiv((cospi(fdiv(2*j,n))),2)])),
#                     COND(eq(j,0),
#                         Mat([[1, 1, 0, 0], [1, -1, 0, 0], [0, 0, 1, 0], [0, 0, 0, 1]]),
#                         let(
#                             b0 := 0.5+nth(d0,0),
#                             b2 := 0.5-nth(d0,0),
#                             Mat([[b0, nth(d1,0), b2, nth(d1,0)],
#                                  [-1*nth(d1, 0), b0, nth(d1,0), -1*b2],
#                                  [b2, -1*nth(d1,0), b0, -1*nth(d1,0)],
#                                  [-1*nth(d1, 0), -1*b2, nth(d1,0), b0]])
#                         )
#                     )
#             ))
#         )

        # Store 3n/4 words
#         apply := (t, c, nt) -> let(
#             j := t.params[2],
#             n := t.params[1],
#             d0 := Dat1d(TReal, 1),
#             d1 := Dat1d(TReal, 1),
#             d2 := Dat1d(TReal, 1),

#             Data(d0, fPrecompute(FList(TReal, [fdiv((1+sinpi(fdiv(2*j,n))),2)])),
#                 Data(d1, fPrecompute(FList(TReal, [fdiv((cospi(fdiv(2*j,n))),2)])),
#                     Data(d2, fPrecompute(FList(TReal, [fdiv((1-sinpi(fdiv(2*j,n))),2)])),
#                         COND(eq(j,0),
#                             Mat([[1, 1, 0, 0], [1, -1, 0, 0], [0, 0, 1, 0], [0, 0, 0, 1]]),
#                             Mat([[nth(d0, 0), nth(d1,0), nth(d2,0), nth(d1,0)],
#                                  [-1*nth(d1, 0), nth(d0,0), nth(d1,0), -1*nth(d2,0)],
#                                  [nth(d2, 0), -1*nth(d1,0), nth(d0,0), -1*nth(d1,0)],
#                                  [-1*nth(d1, 0), -1*nth(d2,0), nth(d1,0), nth(d0,0)]])
#                         )
#             )))
#         )

     )
));


#############################################################################
##
#W    matgrp.gi                                                  Bettina Eick
##
##    This file contains the header functions to handle the 3- and
##    4-dimensional almost crystallographic integral matrix groups.
##

#############################################################################
##
#F AlmostCrystallographicDim3( type, param )
##
InstallGlobalFunction( AlmostCrystallographicDim3,
function( type, param )
    local g, G, info;

    # type is integer or string
    if IsString( type ) then
        g := Int( type );
    elif IsInt( type ) then
        g := type;
    else
        g := false;
    fi;
    if not g in [1..17] then
        Error("type does not define a valid ac-group type");
    fi;

    # check parameters
    if IsBool( param ) then
        param := List( [1..ACDim3Param[g]], x -> Random(Integers) );
        if param[1] = 0 then param[1] := Random(Integers)^2 + 1; fi;
    elif IsInt( param ) then
        param := List( [1..ACDim3Param[g]], x -> param );
    elif Length( param ) <> ACDim3Param[g] then
        Error("parameter should be a list of length ", ACDim3Param[g] );
    fi;

    # get group
    if Length( param ) = 4 then
        G := ACDim3Funcs[g](param[1], param[2], param[3], param[4]);
    elif Length(param) = 2 then
        G := ACDim3Funcs[g](param[1], param[2] );
    elif Length(param) = 1 then
        G := ACDim3Funcs[g](param[1]);
    fi;

    # set some information
    info := rec( dim := 3, type := g, param := param );
    SetAlmostCrystallographicInfo( G, info );
    SetIsAlmostCrystallographic( G, true );
    SetDimensionOfMatrixGroup( G, 4 );
    SetFieldOfMatrixGroup( G, Rationals );
    SetSize( G, infinity );
    return G;
end );

#############################################################################
##
#F AlmostCrystallographicDim4( type, param )
##
InstallGlobalFunction( AlmostCrystallographicDim4,
function( type, param )
    local g, G, info;

    # type is integer or string
    if IsString( type ) then
        g := Position( ACDim4Types, type );
    elif IsInt( type ) then
        g := type;
    else
        g := false;
    fi;
    if not g in [1..95] then
        Error("type does not define a valid ac-group type");
    fi;

    # check parameters
    if IsBool( param ) then
        param := List( [1..ACDim4Param[g]], x -> Random(Integers) );
        if param[1] = 0 then param[1] := Random(Integers)^2 + 1; fi;
    elif IsInt( param ) then
        param := List( [1..ACDim4Param[g]], x -> param );
    elif Length( param ) <> ACDim4Param[g] then
        Error("parameter should be a list of length ", ACDim4Param[g] );
    fi;

    # get group
    if Length(param) = 7 then
        G := ACDim4Funcs[g]( param[1], param[2], param[3], param[4],
                             param[5], param[6], param[7]);
    elif Length(param) = 6 then
        G := ACDim4Funcs[g]( param[1], param[2], param[3], param[4],
                             param[5], param[6]);
    elif Length(param) = 5 then
        G := ACDim4Funcs[g]( param[1], param[2], param[3], param[4],
                             param[5]);
    elif Length(param) = 4 then
        G := ACDim4Funcs[g]( param[1], param[2], param[3], param[4]);
    elif Length(param) = 3 then
        G := ACDim4Funcs[g]( param[1], param[2], param[3]);
    fi;

    # set some information
    info := rec( dim := 4, type := g, param := param );
    SetAlmostCrystallographicInfo( G, info );
    SetIsAlmostCrystallographic( G, true );
    SetDimensionOfMatrixGroup( G, 5 );
    SetFieldOfMatrixGroup( G, Rationals );
    SetSize( G, infinity );
    return G;
end );

#############################################################################
##
#F AlmostCrystallographicGroup( dim, type, param )
##
InstallGlobalFunction( AlmostCrystallographicGroup,
function( dim, type, param )
    if dim = 3 then
        return AlmostCrystallographicDim3( type, param );
    elif dim = 4 then
        return AlmostCrystallographicDim4( type, param );
    else
        Error("dimension must be 3 or 4");
    fi;
end );

#############################################################################
##
#F IsAlmostCrystallographic( <G> )
##
InstallMethod( IsAlmostCrystallographic, "for groups", true,
    [IsGroup ], 0,
function( G )
    if HasAlmostCrystallographicInfo( G ) then
        return true;
    else
        Print("sorry - cannot check this property \n");
        return fail;
    fi;
end );


# Here . and , print and read an integer, not a character
Brainfuck := function(prog)
  local pointer, stack, leftcells, rightcells, instr, stackptr, len,
    output, input, jump, i, j, set, get;
  input := InputTextUser();
  output := OutputTextUser();
  instr := 1;
  pointer := 0;
  leftcells := [ ];
  rightcells := [ ];
  stack := [ ];
  stackptr := 0;
  len := Length(prog);
  jump := [ ];

  get := function()
    local p;
    if pointer >= 0 then
      p := pointer + 1;
      if IsBound(rightcells[p]) then
        return rightcells[p];
      else
        return 0;
      fi;
    else
      p := -pointer;
      if IsBound(leftcells[p]) then
        return leftcells[p];
      else
        return 0;
      fi;
    fi;
  end;

  set := function(value)
    local p;
    if pointer >= 0 then
      p := pointer + 1;
      if value = 0 then
        Unbind(rightcells[p]);
      else
        rightcells[p] := value;
      fi;
    else
      p := -pointer;
      if value = 0 then
        Unbind(leftcells[p]);
      else
        leftcells[p] := value;
      fi;
    fi;
  end;

  # find jumps for faster execution
  for i in [1 .. len] do
    if prog[i] = '[' then
      stackptr := stackptr + 1;
      stack[stackptr] := i;
    elif prog[i] = ']' then
      j := stack[stackptr];
      stackptr := stackptr - 1;
      jump[i] := j;
      jump[j] := i;
    fi;
  od;

  while instr <= len do
    c := prog[instr];
    if c = '<' then
      pointer := pointer - 1;
    elif c = '>' then
      pointer := pointer + 1;
    elif c = '+' then
      set(get() + 1);
    elif c = '-' then
      set(get() - 1);
    elif c = '.' then
      WriteLine(output, String(get()));
    elif c = ',' then
      set(Int(Chomp(ReadLine(input))));
    elif c = '[' then
      if get() = 0 then
        instr := jump[instr];
      fi;
    elif c = ']' then
      if get() <> 0 then
        instr := jump[instr];
      fi;
    fi;
    instr := instr + 1;
  od;
  CloseStream(input);
  CloseStream(output);
  # for debugging purposes, return last state
  return [leftcells, rightcells, pointer];
end;

# An addition
Brainfuck("+++.<+++++.[->+<]>.");
# 3
# 5
# 8