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


# 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


#############################################################################
##
#W    matgrp3.gi                                                Karel Dekimpe
#W                                                               Bettina Eick
##
##    This file contains the 3-dimensional almost crystallographic groups
##    as integral matrix groups. There are 17 types of groups.
##

ACDim3Nr01 := function ( k1 )
local a, b, c;
a:=[[1, 0, -k1/2, 0], [0, 1, 0, 1], [0, 0, 1, 0], [0, 0, 0, 1]];
b:=[[1, k1/2, 0, 0], [0, 1, 0, 0], [0, 0, 1, 1], [0, 0, 0, 1]];
c:=[[1, 0, 0, 1], [0, 1, 0, 0], [0, 0, 1, 0], [0, 0, 0, 1]];
return Group( [a , b, c] , IdentityMat(4) );
end;

ACDim3Nr02 := function ( k1, k2, k3, k4)
local a, b, c, alfa;
a:=[[1, 0, -k1/2, 0], [0, 1, 0, 1], [0, 0, 1, 0], [0, 0, 0, 1]];
b:=[[1, k1/2, 0, 0], [0, 1, 0, 0], [0, 0, 1, 1], [0, 0, 0, 1]];
c:=[[1, 0, 0, 1], [0, 1, 0, 0], [0, 0, 1, 0], [0, 0, 0, 1]];
alfa:=[[1, k2, k3, k4/2], [0, -1, 0, 0], [0, 0, -1, 0], [0, 0, 0, 1]];
return Group( [a , b, c, alfa] , IdentityMat(4) );
end;

ACDim3Nr03 := function ( k1, k2 )
local a, b, c, alfa;
a:=[[1, 0, -k1/2, 0], [0, 1, 0, 1], [0, 0, 1, 0], [0, 0, 0, 1]];
b:=[[1, k1/2, 0, 0], [0, 1, 0, 0], [0, 0, 1, 1], [0, 0, 0, 1]];
c:=[[1, 0, 0, 1], [0, 1, 0, 0], [0, 0, 1, 0], [0, 0, 0, 1]];
alfa:=[[-1, -k2, 0, 0], [0, 1, 0, 0], [0, 0, -1, 0], [0, 0, 0, 1]];
return Group( [a , b, c, alfa] , IdentityMat(4) );
end;

ACDim3Nr04 := function ( k1, k2 )
local a, b, c, alfa;
a:=[[1, 0, -k1, 0], [0, 1, 0, 1], [0, 0, 1, 0], [0, 0, 0, 1]];
b:=[[1, k1, 0, 0], [0, 1, 0, 0], [0, 0, 1, 1], [0, 0, 0, 1]];
c:=[[1, 0, 0, 1], [0, 1, 0, 0], [0, 0, 1, 0], [0, 0, 0, 1]];
alfa:=[[-1, 2*k2, k1/2, 0], [0, 1, 0, 1/2], [0, 0, -1, 0], [0, 0, 0, 1]];
return Group( [a , b, c, alfa] , IdentityMat(4) );
end;

ACDim3Nr05 := function ( k1, k2 )
local a, b, c, alfa;
a:=[[1, 0, -k1/2, 0], [0, 1, 0, 1], [0, 0, 1, 0], [0, 0, 0, 1]];
b:=[[1, k1/2, 0, 0], [0, 1, 0, 0], [0, 0, 1, 1], [0, 0, 0, 1]];
c:=[[1, 0, 0, 1], [0, 1, 0, 0], [0, 0, 1, 0], [0, 0, 0, 1]];
alfa:=[[-1, -k2, -k2, 0], [0, 0, 1, 0], [0, 1, 0, 0], [0, 0, 0, 1]];
return Group( [a , b, c, alfa ] , IdentityMat(4) );
end;

ACDim3Nr06 := function ( k1, k2, k3, k4)
local a, b, c, alfa, beta;
a:=[[1, 0, -k1/2, 0], [0, 1, 0, 1], [0, 0, 1, 0], [0, 0, 0, 1]];
b:=[[1, k1/2, 0, 0], [0, 1, 0, 0], [0, 0, 1, 1], [0, 0, 0, 1]];
c:=[[1, 0, 0, 1], [0, 1, 0, 0], [0, 0, 1, 0], [0, 0, 0, 1]];
alfa:=[[1, k2, k3, k4/2], [0, -1, 0, 0], [0, 0, -1, 0], [0, 0, 0, 1]];
beta:=[[-1, -k2, 0, 0], [0, 1, 0, 0], [0, 0, -1, 0], [0, 0, 0, 1]];
return Group( [a , b, c, alfa, beta] , IdentityMat(4) );
end;

ACDim3Nr07 := function ( k1, k2, k3, k4)
local a, b, c, alfa, beta;
a:=[[1, 0, -k1, 0], [0, 1, 0, 1], [0, 0, 1, 0], [0, 0, 0, 1]];
b:=[[1, k1, 0, 0], [0, 1, 0, 0], [0, 0, 1, 1], [0, 0, 0, 1]];
c:=[[1, 0, 0, 1], [0, 1, 0, 0], [0, 0, 1, 0], [0, 0, 0, 1]];
alfa:=[[1, k2, -2*(k3 + k4), k3/2], [0, -1, 0, 0], [0, 0, -1, 0], [0, 0, 0, 1]];
beta:=[[-1, k1/2 - k2, 0, 0], [0, 1, 0, 0], [0, 0, -1, 1/2], [0, 0, 0, 1]];
return Group( [a , b, c, alfa, beta] , IdentityMat(4) );
end;

ACDim3Nr08 := function ( k1, k2, k3, k4)
local a, b, c, alfa, beta;
a:=[[1, 0, -k1, 0], [0, 1, 0, 1], [0, 0, 1, 0], [0, 0, 0, 1]];
b:=[[1, k1, 0, 0], [0, 1, 0, 0], [0, 0, 1, 1], [0, 0, 0, 1]];
c:=[[1, 0, 0, 1], [0, 1, 0, 0], [0, 0, 1, 0], [0, 0, 0, 1]];
alfa:=[[1, k1 + 2*k3, -k1 + 2*k2 - 2*k3, k4/2], [0, -1, 0, 0], [0, 0, -1, 0],
 [0, 0, 0, 1]];
beta:=[[-1, -k1/2 - 2*k3, k1/2, 0], [0, 1, 0, 1/2], [0, 0, -1, 1/2], [0, 0, 0, 1]];
return Group( [a , b, c, alfa, beta] , IdentityMat(4) );
end;

ACDim3Nr09 := function ( k1, k2, k3, k4)
local a, b, c, alfa, beta;
a:=[[1, 0, -k1/2, 0], [0, 1, 0, 1], [0, 0, 1, 0], [0, 0, 0, 1]];
b:=[[1, k1/2, 0, 0], [0, 1, 0, 0], [0, 0, 1, 1], [0, 0, 0, 1]];
c:=[[1, 0, 0, 1], [0, 1, 0, 0], [0, 0, 1, 0], [0, 0, 0, 1]];
alfa:=[[1, k2, -k2 + 2*k3, k4/2], [0, -1, 0, 0], [0, 0, -1, 0], [0, 0, 0, 1]];
beta:=[[-1, -k3, -k3, 0], [0, 0, 1, 0], [0, 1, 0, 0], [0, 0, 0, 1]];
return Group( [a , b, c, alfa, beta] , IdentityMat(4) );
end;

ACDim3Nr10 := function ( k1, k2, k3, k4)
local a, b, c, alfa;
a:=[[1, 0, -k1/2, 0], [0, 1, 0, 1], [0, 0, 1, 0], [0, 0, 0, 1]];
b:=[[1, k1/2, 0, 0], [0, 1, 0, 0], [0, 0, 1, 1], [0, 0, 0, 1]];
c:=[[1, 0, 0, 1], [0, 1, 0, 0], [0, 0, 1, 0], [0, 0, 0, 1]];
alfa:=[[1, k2, k3, k4/4], [0, 0, -1, 0], [0, 1, 0, 0], [0, 0, 0, 1]];
return Group( [a , b, c, alfa] , IdentityMat(4) );
end;

ACDim3Nr11 := function ( k1, k2, k3, k4)
local a, b, c, alfa, beta;
a:=[[1, 0, -k1/2, 0], [0, 1, 0, 1], [0, 0, 1, 0], [0, 0, 0, 1]];
b:=[[1, k1/2, 0, 0], [0, 1, 0, 0], [0, 0, 1, 1], [0, 0, 0, 1]];
c:=[[1, 0, 0, 1], [0, 1, 0, 0], [0, 0, 1, 0], [0, 0, 0, 1]];
alfa:=[[1, k2, k3, k4/4], [0, 0, -1, 0], [0, 1, 0, 0], [0, 0, 0, 1]];
beta:=[[-1, -k2 - k3, 0,  0], [0, 1, 0, 0], [0, 0, -1, 0], [0, 0, 0, 1]];
return Group( [a , b, c, alfa, beta] , IdentityMat(4) );
end;

ACDim3Nr12 := function ( k1, k2, k3, k4)
local a, b, c, alfa, beta;
a:=[[1, 0, -k1, 0], [0, 1, 0, 1], [0, 0, 1, 0], [0, 0, 0, 1]];
b:=[[1, k1, 0, 0], [0, 1, 0, 0], [0, 0, 1, 1], [0, 0, 0, 1]];
c:=[[1, 0, 0, 1], [0, 1, 0, 0], [0, 0, 1, 0], [0, 0, 0, 1]];
alfa:=[[1, k2, k1 - k2 - 2*k3, k4/4], [0, 0, -1, 0], [0, 1, 0, 0], [0, 0, 0, 1]];
beta:=[[-1, -k1/2 + 2*k3, k1/2, 0], [0, 1, 0, 1/2], [0, 0, -1, 1/2], [0, 0, 0, 1]];
return Group( [a , b, c, alfa, beta] , IdentityMat(4) );
end;

ACDim3Nr13 := function ( k1, k2, k3, k4)
local a, b, c, alfa;
a:=[[1, 0, -k1/2, 0], [0, 1, 0, 1], [0, 0, 1, 0], [0, 0, 0, 1]];
b:=[[1, k1/2, 0, 0], [0, 1, 0, 0], [0, 0, 1, 1], [0, 0, 0, 1]];
c:=[[1, 0, 0, 1], [0, 1, 0, 0], [0, 0, 1, 0], [0, 0, 0, 1]];
alfa:=[[1, k2, -k1/2 + k3, k4/3], [0, 0, -1, 0], [0, 1, -1, 0], [0, 0, 0, 1]];
return Group( [a , b, c, alfa] , IdentityMat(4) );
end;

ACDim3Nr14 := function ( k1, k2, k3, k4)
local a, b, c, alfa, beta;
a:=[[1, 0, -k1/2, 0], [0, 1, 0, 1], [0, 0, 1, 0], [0, 0, 0, 1]];
b:=[[1, k1/2, 0, 0], [0, 1, 0, 0], [0, 0, 1, 1], [0, 0, 0, 1]];
c:=[[1, 0, 0, 1], [0, 1, 0, 0], [0, 0, 1, 0], [0, 0, 0, 1]];
alfa:=[[1, k2, -k1/2 + k3, k4/3], [0, 0, -1, 0], [0, 1, -1, 0], [0, 0, 0, 1]];
beta:=[[-1, -k2 , k2 , 0], [0, 0, -1, 0], [0, -1, 0, 0], [0, 0, 0, 1]];
return Group( [a , b, c, alfa, beta] , IdentityMat(4) );
end;

ACDim3Nr15 := function ( k1, k2, k3, k4)
local a, b, c, alfa, beta;
a:=[[1, 0, -k1/2, 0], [0, 1, 0, 1], [0, 0, 1, 0], [0, 0, 0, 1]];
b:=[[1, k1/2, 0, 0], [0, 1, 0, 0], [0, 0, 1, 1], [0, 0, 0, 1]];
c:=[[1, 0, 0, 1], [0, 1, 0, 0], [0, 0, 1, 0], [0, 0, 0, 1]];
alfa:=[[1, k1 - 2*k3 + 3*k2, -k1/2 + k3, k4/3], [0, 0, -1, 0], [0, 1, -1, 0],
 [0, 0, 0, 1]];
beta:=[[-1, -k2, -k2,  0], [0, 0, 1, 0], [0, 1, 0, 0], [0, 0, 0, 1]];
return Group( [a , b, c, alfa, beta] , IdentityMat(4) );
end;

ACDim3Nr16 := function ( k1, k2, k3, k4)
local a, b, c, alfa;
a:=[[1, 0, -k1/2, 0], [0, 1, 0, 1], [0, 0, 1, 0], [0, 0, 0, 1]];
b:=[[1, k1/2, 0, 0], [0, 1, 0, 0], [0, 0, 1, 1], [0, 0, 0, 1]];
c:=[[1, 0, 0, 1], [0, 1, 0, 0], [0, 0, 1, 0], [0, 0, 0, 1]];
alfa:=[[1, -k1/2 + k2, k3, k4/6], [0, 1, -1, 0], [0, 1, 0, 0],
 [0, 0, 0, 1]];
return Group( [a , b, c, alfa] , IdentityMat(4) );
end;

ACDim3Nr17 := function ( k1, k2, k3, k4)
local a, b, c, alfa, beta;
a:=[[1, 0, -k1/2, 0], [0, 1, 0, 1], [0, 0, 1, 0], [0, 0, 0, 1]];
b:=[[1, k1/2, 0, 0], [0, 1, 0, 0], [0, 0, 1, 1], [0, 0, 0, 1]];
c:=[[1, 0, 0, 1], [0, 1, 0, 0], [0, 0, 1, 0], [0, 0, 0, 1]];
alfa:=[[1, -k1/2 + k2, k3, k4/6], [0, 1, -1, 0], [0, 1, 0, 0],
 [0, 0, 0, 1]];
beta:=[[-1, -k3, -k3, 0], [0, 0, 1, 0], [0, 1, 0, 0], [0, 0, 0, 1]];
return Group( [a , b, c, alfa, beta] , IdentityMat(4) );
end;

#############################################################################
##
#V ACDim3Funcs
#V ACDim3Param
##
ACDim3Funcs := [ ACDim3Nr01, ACDim3Nr02, ACDim3Nr03, ACDim3Nr04, ACDim3Nr05,
ACDim3Nr06, ACDim3Nr07, ACDim3Nr08, ACDim3Nr09, ACDim3Nr10, ACDim3Nr11,
ACDim3Nr12, ACDim3Nr13, ACDim3Nr14, ACDim3Nr15, ACDim3Nr16, ACDim3Nr17 ];
MakeReadOnlyGlobal( "ACDim3Funcs" );

ACDim3Param := [ 1,4,2,2,2,4,4,4,4,4,4,4,4,4,4,4,4 ];
MakeReadOnlyGlobal( "ACDim3Param" );


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

Declare(_numBlocks);

#F NumBlocks(<sums>, <blocksize>, <comp>)
#F
#F counts the number of blocks of <blocksize> in <sums>, and <comp> is
#F a boolean that tells the function to only count blocks that actually do
#F some computation. It checks for computation by testing the presence of the
#F Blk() structure.

NumBlocks := (S, blocksize, comp) ->
    _numBlocks(S, blocksize, S.dims()[1], comp);

_numBlocks := function(S, blocksize, size, comp)

    if ObjId(S) = ISum then
        size := size / S.var.range;

        if size <= blocksize then
            return When(comp = false or Collect(S, Blk) <> [], 1, 0);
        fi;
    fi;

    return Sum(S.rChildren(), e -> _numBlocks(e, blocksize, size, comp));
end;

Declare(_numWBlocks);

NumWeightedBlocks := (S, blocksize, comp) ->
    _numWBlocks(S, blocksize, S.dims()[1], S.dims()[1], comp);

_numWBlocks := function(S, blocksize, size, fullsize, comp)
    if ObjId(S) = ISum then
        size := size / S.var.range;

        if size <= blocksize then
            return When(comp = false or Collect(S, Blk) <> [],
                fullsize / size,
                0
            );
        fi;
    fi;

    return Sum(S.rChildren(), e -> _numWBlocks(e, blocksize, size, fullsize, comp));
end;

Declare(_numW2Blocks);

#F NumW2Blocks(<sums>, <blocksize>, <comp>)
#F
#F
#F
NumW2Blocks := (S, blocksize, comp) ->
    _numW2Blocks(S, blocksize, S.dims()[1], S.dims()[1], comp);

_numW2Blocks := function(S, blocksize, size, fullsize, comp)

    if ObjId(S) = ISum then
        size := size / S.var.range;

        # <fullsize / size> gives the number of times a block of size
        # <size> is executed.  <2 * size> is the number of out of
        # block accesses a <size> sized block requires. <(2 * size) *
        # (fullsize / size)> is the total number of out-of-block
        # accesses required by this block.
        #
        # <size * fullsize> is an algebraic simplification.
        #
        # since fullsize is a constant factor, we drop it.
        #
        if size <= blocksize then
            return When(comp = false or Collect(S, Blk) <> [],
                size,
                0
            );
        fi;
    fi;

    return Sum(S.rChildren(), e -> _numW2Blocks(e, blocksize, size, fullsize, comp));
end;


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

#######################################################################################
#   tSPL DFT rules
NewRulesFor(PrunedDFT, rec(
    PrunedDFT_tSPL_CT := rec(

    forTransposition := true,

    maxSize       := false,

    applicable    := (self, nt) >> nt.params[1] > 2
        and (self.maxSize = false or nt.params[1] <= self.maxSize)
        and not IsPrime(nt.params[1])
        and nt.params[3] > 1
        and nt.hasTags(),

    children      := nt -> Map2(Filtered(DivisorPairs(nt.params[1]), (l) -> IsInt(nt.params[3]/l[1])), (m,n) -> [
        TCompose([
            TGrp(TCompose([
                TTensorI(DFT(m, nt.params[2] mod m), n, AVec, AVec),
                TDiag(fPrecompute(Tw1(m*n, n, nt.params[2])))
            ])),
            TGrp(TTensorI(PrunedDFT(n, nt.params[2] mod n, nt.params[3]/m, nt.params[4]), m, APar, AVec))
        ]).withTags(nt.getTags())
    ]),

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

    switch := false
    )
));

NewRulesFor(IOPrunedDFT, rec(
    IOPrunedDFT_tSPL_CT := rec(

    forTransposition := true,

    maxSize       := false,

    applicable    := (self, nt) >> nt.params[1] > 2
        and (self.maxSize = false or nt.params[1] <= self.maxSize)
        and not IsPrime(nt.params[1])
        and nt.params[3] * nt.params[5] >= nt.params[1]
        and nt.hasTags(),

    children      := nt -> Map2(Filtered(DivisorPairs(nt.params[1]), (l) -> IsInt(nt.params[3]/l[2]) and IsInt(nt.params[5]/l[1])), (m,n) -> [
        TCompose([
            TGrp(TCompose([
                TTensorI(PrunedDFT(m, nt.params[2] mod m, nt.params[3]/n, nt.params[4]).transpose(), n, AVec, AVec),
                TDiag(fPrecompute(Tw1(m*n, n, nt.params[2])))
            ])),
            TGrp(TTensorI(PrunedDFT(n, nt.params[2] mod n, nt.params[5]/m, nt.params[6]), m, APar, AVec))
        ]).withTags(nt.getTags())
    ]),

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

    switch := false
    )
));