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

Declare(ISRDFT, ISRDFT2, ISRDFT3, ISRDFT4);

Class(SRDFT, PRDFT, rec(
    dims := self >> [self.params[1], self.params[1]],
    inverse := self >> ISRDFT(self.params[1], -self.params[2]).setTransposed(self.transposed),
    inverseViaDiag := self >> self.transpose() * ISRDFT.diag(self.params[1]),
    terminate := self >> let(N := self.params[1], k := self.params[2],
	m  := MatSPL(PRDFT(N,k)),
	sm := Mat(Cond(IsOddInt(N),
	         Concatenation([m[1]], m{[3..Length(m)]}),
	         Concatenation([m[1]], m{[3..Length(m)-2]}, [m[Length(m)-1]]))),
	Cond(self.transposed, sm.transpose(), sm)),
));
SRDFT1 := SRDFT;
Class(SRDFT2, PRDFT2, rec(
    dims := self >> [self.params[1], self.params[1]],
    inverse := self >> ISRDFT3(self.params[1], -self.params[2]).setTransposed(self.transposed),
    terminate := self >> let(N := self.params[1], k := self.params[2],
	m  := MatSPL(PRDFT2(N,k)),
	sm := Mat(Cond(IsOddInt(N),
	         Concatenation([m[1]], m{[3..Length(m)]}),
	         Concatenation([m[1]], m{[3..Length(m)-2]}, [m[Length(m)]]))),
	Cond(self.transposed, sm.transpose(), sm)),
));
Class(SRDFT3, PRDFT3, rec(
    dims := self >> [self.params[1], self.params[1]],
    inverse := self >> ISRDFT2(self.params[1], -self.params[2]).setTransposed(self.transposed),
    terminate := self >> let(N := self.params[1], k := self.params[2],
	m  := MatSPL(PRDFT3(N,k)),
	sm := Mat(Cond(IsOddInt(N),
	         m{[1..Length(m)-1]},
	         m)),
	Cond(self.transposed, sm.transpose(), sm)),
));
Class(SRDFT4, PRDFT4, rec(
    dims := self >> [self.params[1], self.params[1]],
    inverse := self >> ISRDFT4(self.params[1], -self.params[2]).setTransposed(self.transposed),
    terminate := self >> let(N := self.params[1], k := self.params[2],
	m  := MatSPL(PRDFT4(N,k)),
	sm := Mat(Cond(IsOddInt(N),
	         Concatenation(m{[1..Length(m)-2]}, [m[Length(m)]]),
	         m)),
	Cond(self.transposed, sm.transpose(), sm)),
));

Class(ISRDFT, IPRDFT, rec(
    dims := self >> [self.params[1], self.params[1]],
    diag := n -> When(n=2, I(2),
        Diag(diagDirsum(fConst(TReal, 1, 1), fConst(TReal, 2*Int((n-1)/2), 2),
                When(IsEvenInt(n), fConst(TReal, 1, 1), [])))),

    terminate := self >> let(N := self.params[1], k := self.params[2],
	m  := MatSPL(IPRDFT(N,k)),
	sm := Mat(Cond(IsOddInt(N),
	         List(m, r->Concatenation([r[1]], r{[3..Length(r)]})),
	         List(m, r->Concatenation([r[1]], r{[3..Length(r)-2]}, [r[Length(r)-1]])))),
	Cond(self.transposed, sm.transpose(), sm)),
));
Class(ISRDFT2, IPRDFT2, rec(
    dims := self >> [self.params[1], self.params[1]],
    terminate := self >> let(N := self.params[1], k := self.params[2],
	m  := MatSPL(IPRDFT2(N,k)),
	sm := Mat(Cond(IsOddInt(N),
	         List(m, r->r{[1..Length(r)-1]}),
	         m)),
	Cond(self.transposed, sm.transpose(), sm)),
));
Class(ISRDFT3, IPRDFT3, rec(
    dims := self >> [self.params[1], self.params[1]],
    terminate := self >> let(N := self.params[1], k := self.params[2],
	m  := MatSPL(IPRDFT3(N,k)),
	sm := Mat(Cond(IsOddInt(N),
	         List(m, r->Concatenation([r[1]], r{[3..Length(r)]})),
	         List(m, r->Concatenation([r[1]], r{[3..Length(r)-2]}, [r[Length(r)]])))),
	Cond(self.transposed, sm.transpose(), sm)),
));
Class(ISRDFT4, IPRDFT4, rec(
    dims := self >> [self.params[1], self.params[1]],
    terminate := self >> let(N := self.params[1], k := self.params[2],
	m  := MatSPL(IPRDFT4(N,k)),
	sm := Mat(Cond(IsOddInt(N),
	         List(m, r->Concatenation(r{[1..Length(r)-2]}, [r[Length(r)]])),
	         m)),
	Cond(self.transposed, sm.transpose(), sm)),
));

RulesFor(SRDFT1, rec(
    SRDFT1_toPRDFT1 := rec(
	isApplicable := P -> true,
	allChildren := P -> [[ PRDFT1(P[1], P[2]) ]],
	rule := (P, C) -> Pack_CCS(P[1]) * C[1]
    )
));

RulesFor(SRDFT3, rec(
    SRDFT3_toPRDFT3 := rec(
	isApplicable := P -> true,
	allChildren := P -> [[ PRDFT3(P[1], P[2]) ]],
	rule := (P, C) -> Pack_CCS3(P[1]) * C[1]
    )
));


#
# ---------- Group Arithmetics ----------
#

InstallMethod(Subword,
              "Subword of a unipotent element by total degree of coefficients",
              [IsUnipotent,IsPosInt],
              function(u,degree)
              local sys,
              coeffs,poly_degree;

              sys:=chevalleyAdj(u);
              if not IsPolynomialRing(ring(sys)) then
                  Error("Subword: The ring is not a polynomial ring to evaluate!\n");
              fi;

              coeffs:=Filtered(coefficients(u),i->TotalDegree(i[2])=degree);

              return Unipotent(sys,coeffs,Ordering(u));
end);

#
# ---------- Algebraic Operations ----------
#

InstallMethod(Value,
              "Evaluation of the parameter polynomials",
              [IsUnipotent,IsList,IsList],
              function(u,vars,vals)
              local sys,
              lista,i,len;

              sys:=chevalleyAdj(u);
              if not IsPolynomialRing(ring(sys)) then
                  Error("Value: The ring is not a polynomial ring to evaluate.");
              fi;

              lista:=List(coefficients(u),i->[i[1],One(ring(sys))*Value(i[2],vars,vals)]);
              i:=1;
              len:=Length(lista);
              while i <= len do
                  if lista[i][2]=Zero(ring(sys)) then
                      Remove(lista,i);
                      len:=len-1;
                  else i:=i+1; fi;
              od;

              return Unipotent(sys,lista,Ordering(u));
              #return Unipotent(chevalleyAdj(sys),lista,Ordering(u)); # which one is better? I multiply by One(ring(sys))
end);

InstallMethod(Descend,
              "Changes the parameters from the polynomial ring to the coefficients ring",
              [IsUnipotent],
              function(u)
              local sys,
              check;

              sys:=chevalleyAdj(u);
              if not IsPolynomialRing(ring(sys)) then
                  Error("The ring is not a polynomial ring to evaluate.");
              fi;

              if IsAlgebraicU(sys) then sys:=chevalleyAdj(u);
              else sys:=ChevalleyAdj(sys,CoefficientsRing(ring(sys))); fi;

              check:=List(coefficients(u),i->LeadingMonomial(i[2]));
              check:=List(check,i->Sum(i{2*[1..Length(i)/2]}));
              check:=Filtered(check,i->i<>0);
              if check=[] then
                  return Unipotent(sys,
                                   List(coefficients(u),i->[i[1],LeadingCoefficient(i[2])]),
                                   Ordering(u),
                                   Order(u));
              fi;

              return fail;
end);

InstallMethod(Descend,
              "If possible changes the parameters from the polynomial ring to the coefficients ring",
              [IsUnipotent,IsChevalleyAdj],
              function(u,sys)
              local sysu,
              check;

              sysu:=chevalleyAdj(u);

              if not IsPolynomialRing(ring(sysu)) then
                  Error("The ring is not a polynomial ring to evaluate.");
              elif CoefficientsRing(ring(sysu))<>ring(sys) then
                  Error("Cannot descend unipotent to given simple adjoint system");
              fi;

              check:=List(coefficients(u),i->LeadingMonomial(i[2]));
              check:=List(check,i->Sum(i{2*[1..Length(i)/2]}));
              check:=Filtered(check,i->i<>0);
              if check=[] then
                  return Unipotent(sys,
                                   List(coefficients(u),i->[i[1],LeadingCoefficient(i[2])]),
                                   Ordering(u),
                                   Order(u));
              fi;

              return u;
end);

InstallMethod(Ascend,
              "If possible embed Unipotent into AlgebraicU",
              [IsUnipotent,IsAlgebraicU],
              function(u,sys)
              local sysu,
              check;

              if chevalleyAdj(u)<>chevalleyAdj(sys) then
                  Error("Cannot ascend Unipotent to AlgebraicU: different chevalleyAdj!\n");
              fi;

              return Unipotent(sys,
                               List(coefficients(u),i->[i[1],One(ring(sys))*i[2]]),
                               Ordering(u),
                               Order(u));
end);

InstallMethod(Ascend,
              "If possible embed the parameters in a polynomial ring with coefficients ring the base ring",
              [IsUnipotent,IsChevalleyAdj],
              function(u,sys)
              local sysu,
              check;

              sysu:=chevalleyAdj(u);

              if not IsPolynomialRing(ring(sys)) then
                  Error("The new ring is not a polynomial ring to embed in.");
              elif CoefficientsRing(ring(sys))<>ring(sysu) then
                  Error("CoefficientsRing and ring(sysu) do not coincide.");
              fi;

              return Unipotent(sys,
                               List(coefficients(u),i->[i[1],One(ring(sys))*i[2]]),
                               Ordering(u),
                               Order(u));
end);

InstallMethod(Ascend,
              "If possible embed the parameters in a polynomial ring with coefficients ring the base ring",
              [IsUnipotent,IsPolynomialRing],
              function(u,inel)
              local sys,
              check;

              sys:=chevalleyAdj(u);

              if not IsPolynomialRing(inel) then
                  Error("The new ring is not a polynomial ring to embed in.");
              elif CoefficientsRing(inel)<>ring(sys) then
                  Error("CoefficientsRing and ring(sys) do not coincide.");
              fi;

              return Unipotent(ChevalleyAdj(sys,inel),
                               List(coefficients(u),i->[i[1],One(inel)*i[2]]),
                               Ordering(u),
                               Order(u));
end);

InstallMethod(UnipotentCentralizer,
              "Centralizer of unipotent element in algebraicU",
              [IsUnipotent],
              function(u)
              local result,
              sys,pr,pr_len,uu,
              APR,avars,avars_free,generic,
              relations,sol,torsion,
              i,new_indices;

              sys:=chevalleyAdj(u);
              if not IsAlgebraicU(sys) then
                  sys:=AlgebraicU(sys);
                  u:=Ascend(u,sys);
              fi;
              pr:=positiveRoots(sys);
              pr_len:=Length(pr);
              APR:=ring(sys);
              avars:=IndeterminatesOfPolynomialRing(APR){[1..pr_len]};

              generic:=Unipotent(sys,List([1..pr_len],i->[i,avars[pr_len-i+1]]),[1..pr_len],0);

              result:=List([1..pr_len],i->avars[i]);

              torsion:=[];
              for i in [2..pr_len] do
                  #relations:=coefficients(CommMod(generic,u,i));
              relations:=coefficients(CommMod(u,generic,i));   #!!!ATENTIE CommMod(a,b,i) foloseste Ordering lui b care tre sa fie [1..pr_len]
                  relations:=List(relations,i->i[2]);
              #Print("\nsolving ",i,": ",relations,"\n");
              #if i=8 then Error("!"); fi;
                  sol:=SolveRelations(relations,avars,result,APR);
                  if sol[2]<>[] then Print(" >>>",i," UnipotentCentralizer: could not solve all relations!",relations,"\n"); fi;
                  Add(torsion,sol[3]);
                  result:=sol[1];
                  result:=List(result,i->i*One(APR));
              #Print("result :",result,"\n");
                  generic:=Unipotent(sys,List([1..pr_len],i->[i,result[pr_len-i+1]]),[1..pr_len],0);
              od;

              avars_free:=result{Filtered([1..pr_len],i->result[i] in avars)};
              avars_free:=avars_free{Filtered([1..Length(avars_free)],i->not avars_free[i] in avars_free{[1..i-1]})};

              new_indices:=Reversed([1..Length(avars_free)]);
              result:=List(result,i->Value(i,avars_free,avars{new_indices})*One(APR));
              generic:=Unipotent(sys,List([1..pr_len],i->[i,result[pr_len-i+1]]),[1..pr_len],0);

              return [generic,u,Concatenation(torsion),relations];
end);

#
#
#  THIS DOES NOT WORK
#
#
InstallMethod(UnipotentCentralizer2,
              "Centralizer of unipotent element in algebraicU",
              [IsUnipotent],
              function(u)
              local result,
              sys,pr,pr_len,uu,
              APR,avars,avars_free,generic,
              relations,sol,torsion,
              root_support,other_roots,
              i,new_indices;

              sys:=chevalleyAdj(u);
              if not IsAlgebraicU(sys) then
                  sys:=AlgebraicU(sys);
                  u:=Ascend(u,sys);
              fi;
              pr:=positiveRoots(sys);
              pr_len:=Length(pr);
              APR:=ring(sys);
              avars:=IndeterminatesOfPolynomialRing(APR){[1..pr_len]};

              root_support:=[];
              for i in [1..pr_len] do
                  generic:=Unipotent(sys,[[i,avars[1]]]);
                  generic:=Conj(generic,u);
                  if Length(coefficients(generic))=1 and coefficients(generic)[1][2]=avars[1] then Add(root_support,i); fi;
              od;
              other_roots:=Difference([1..pr_len],root_support);

              #generic:=Unipotent(sys,List([1..pr_len],i->[i,avars[pr_len-i+1]]),[1..pr_len],0);
              #generic:=Subword(generic,other_roots);
              generic:=Unipotent(sys,List(other_roots,i->[i,avars[pr_len-i+1]]),[1..pr_len],0);

              result:=List([1..pr_len],i->avars[i]);
              for i in root_support do result[pr_len-i+1]:=Zero(APR); od;

              torsion:=[];
              for i in [2..pr_len] do
                  #relations:=coefficients(CommMod(generic,u,i));
              relations:=coefficients(CommMod(u,generic,i));   #!!!ATENTIE CommMod(a,b,i) foloseste Ordering lui b care tre sa fie [1..pr_len]
                  relations:=List(relations,i->i[2]);
              #Print("\nsolving ",i,": ",relations,"\n");
              #if i=8 then Error("!"); fi;
                  sol:=SolveRelations(relations,avars,result,APR);
                  if sol[2]<>[] then Print(" >>>",i," UnipotentCentralizer: could not solve all relations!",relations,"\n"); fi;
                  Add(torsion,sol[3]);
                  result:=sol[1];
                  result:=List(result,i->i*One(APR));
              #Print("result :",result,"\n");
                  generic:=Unipotent(sys,List([1..pr_len],i->[i,result[pr_len-i+1]]),[1..pr_len],0);
              od;
              Error("!");
              for i in root_support do result[pr_len-i+1]:=avars[pr_len-i+1]; od;

              avars_free:=result{Filtered([1..pr_len],i->result[i] in avars)};
              avars_free:=avars_free{Filtered([1..Length(avars_free)],i->not avars_free[i] in avars_free{[1..i-1]})};

              new_indices:=Reversed([1..Length(avars_free)]);
              result:=List(result,i->Value(i,avars_free,avars{new_indices})*One(APR));
              generic:=Unipotent(sys,List([1..pr_len],i->[i,result[pr_len-i+1]]),[1..pr_len],0);

              return [generic,u,Concatenation(torsion),relations];
end);

InstallMethod(TangentSpace,
              "Returns a basis of Nilpotents representing for the tangent space",
              [IsUnipotent],
              function(u)
              local result,
              sysAPR,APR,avars,
              dim,BPR,xvars,
              order,exp,vals,tmp,tmp_len,i,j,monoms;

              sysAPR:=chevalleyAdj(u);
              APR:=ring(sysAPR);
              avars:=IndeterminatesOfPolynomialRing(APR){[1..Length(positiveRoots(sysAPR))]};
              dim:=Length(Set(List(Filtered(coefficients(u),i->i[2] in avars),j->j[2])));
              avars:=avars{[1..dim]};

              vals:=List([1..dim],i->Zero(APR));
              result:=[];
              for i in [1..dim] do
                  vals[i]:=avars[1];
                  tmp:=Value(u,avars,vals);
                  #SetOrder(tmp,Order(u));
                  tmp:=ShallowCopy(coefficients(tmp));
                  tmp_len:=Length(tmp);
                  j:=1;
                  while j <= tmp_len do
                       monoms:=ExtRepPolynomialRatFun(tmp[j][2]);
                       monoms:=List(2*[1..Length(monoms)/2]-1,i->[monoms[i],monoms[i+1]]);
                       monoms:=Filtered(monoms,i->i[1][2]=1);
                       if monoms<>[] then
                          tmp[j]:=[tmp[j][1],monoms[1][2]*One(APR)];
                          j:=j+1;
                      else
                          Remove(tmp,j);
                          tmp_len:=tmp_len-1;
                      fi;
                  od;
                  Add(result,tmp);
                  vals[i]:=Zero(APR);
              od;

              result:=List(result,i->NilpotentChv(sysAPR,i));
              return result;
end);

InstallMethod(Zentrum,
              "Centre of connected unipotent algebraic group",
              [IsUnipotent],
              function(u)
              local result,
              APR,avars,
              relations,
              tang,adu_res,unu;

              APR:=ring(chevalleyAdj(u));
              avars:=IndeterminatesOfPolynomialRing(APR);
              avars:=Filtered(coefficients(u),i->i[2] in avars);
              avars:=Set(List(avars,i->i[2]));

              tang:=TangentSpace(u);
              #Error("!");
              adu_res:=RestrictedAdu(u,tang);

              unu:=DiagonalMat(List([1..Length(avars)],i->One(APR)));

              relations:=Concatenation(adu_res-unu);
              relations:=Filtered(relations,i->i<>Zero(APR));

#return relations;

              #Print(avars," with ",relations,"\n");

              result:=SolveRelations(relations,avars,avars,APR);

              if result[2]<>[] then Print("Zentrum: could not solve all relations! ",result[2],"\n"); fi;

              return Value(u,avars,result[1]);
end);

InstallMethod(ParameterPieces,
              "Subvarieties for each parameter",
              [IsUnipotent],
              function(u)
              local result,
              sysAPR,APR,avars,avar,
              dim,BPR,xvars,
              order,exp,vals,tmp,tmp_len,i,j,monoms;

              sysAPR:=chevalleyAdj(u);
              APR:=ring(sysAPR);
              avars:=IndeterminatesOfPolynomialRing(APR){[1..Length(positiveRoots(sysAPR))]};
              avar:=avars[1];
              avars:=Set(List(Filtered(coefficients(u),i->i[2] in avars),j->j[2]));
              Sort(avars,function(a,b) return ExtRepPolynomialRatFun(a)[1][1]<ExtRepPolynomialRatFun(b)[1][1]; end);
              dim:=Length(avars);
              #avars:=avars{[1..dim]};

              vals:=List([1..dim],i->Zero(APR));
              result:=[];
              for i in [1..dim] do
                  vals[i]:=avar;#avars[1];
                  tmp:=Value(u,avars,vals);
                  #Print(coefficients(tmp));
                  #SetOrder(tmp,Order(u));
                  tmp:=ShallowCopy(coefficients(tmp));
                  tmp_len:=Length(tmp);
                  Add(result,tmp);
                  vals[i]:=Zero(APR);
              od;

              result:=List(result,i->Unipotent(sysAPR,i,Ordering(u),-2));
              return result;
end);

InstallMethod(Dimension,
              "Dimension of subvariety in unipotent group",
              [IsUnipotent],
              function(u)
              local avars_free;

              avars_free:=List(coefficients(u),i->i[2]);
              avars_free:=List(avars_free,i->ExtRepPolynomialRatFun(i));
              avars_free:=Concatenation(avars_free);
              avars_free:=avars_free{2*[1..Length(avars_free)/2]-1};
              avars_free:=Concatenation(avars_free);
              avars_free:=avars_free{2*[1..Length(avars_free)/2]-1};

              return Length(Set(avars_free));
end);

#
# ---------- Witt Group Operations ----------
#

InstallMethod(GenericWittGroup,
              "Witt group with generic polynomials along the unipotent group gr",
              [IsUnipotent,IsWitt,IsList],
              function(gr,w,values)
              local result,
              coeffs,
              APR,avars,avars_free,avars_free_len,avars_ext,
              BPR,bvars,
              CPR,cvarnames,cvars,
              poly,monom,i,j,k,pos;

              coeffs:=coefficients(gr);

              # APR's
              APR:=ring(chevalleyAdj(gr));
              avars:=IndeterminatesOfPolynomialRing(APR);
              avars_free:=Filtered(coeffs,i->i[2] in avars);
              avars_free:=Set(List(avars_free,i->i[2]));
              Sort(avars_free,function(a,b) return ExtRepPolynomialRatFun(a)[1][1]<ExtRepPolynomialRatFun(b)[1][1]; end);
              avars_free_len:=Length(avars_free);
              avars_ext:=List(avars_free,i->ExtRepPolynomialRatFun(i));
              avars_ext:=List(avars_ext,i->i[1][1]);

              # BPR's
              BPR:=ring(chevalleyAdjBPR(w));

              # CPR's
              cvarnames:=List([1..avars_free_len],i->Concatenation("c_",String(i)));
              CPR:=PolynomialRing(BPR,cvarnames);
              cvars:=IndeterminatesOfPolynomialRing(CPR);

              coeffs:=List(coeffs,i->[i[1],List(ExtRepPolynomialRatFun(i[2]))]);
              result:=[];
              for i in [1..Length(coeffs)] do
                  poly:=Zero(CPR);
                  for j in [1..Length(coeffs[i][2])/2] do
                      monom:=One(CPR);
                      for k in [1..Length(coeffs[i][2][2*j-1])/2] do
                          pos:=Position(avars_ext,coeffs[i][2][2*j-1][2*k-1]);
                          monom:=monom*cvars[pos]^coeffs[i][2][2*j-1][2*k];
                      od;
                      monom:=monom*((coeffs[i][2][2*j]*One(APR))*One(BPR));
                      poly:=poly+monom;
                  od;
                  Add(result,[coeffs[i][1],poly]);
              od;

              result:=List(result,i->[i[1],Value(i[2],cvars,values)]);

              return Unipotent(chevalleyAdjBPR(w),result,Ordering(gr),-2);
end);

InstallMethod(SolveWittRoot,
              "Solution for witt group construction at certain root",
              [IsUnipotent,IsWitt,IsPosInt,IsList,IsInt],
              function(wx,w,root,values,step)
              local result,
              APR,avars,avars_free,avars_free_len,
              BPR,dim,xvar,yvar,wy,
              gws,gen_poly,gen_poly_len,xy_poly,total_degree,relations,i;

              gws:=GenericSum(w);

              # BPR's
              BPR:=ring(chevalleyAdjBPR(w));
              dim:=Dimension(w);
              xvar:=IndeterminatesOfPolynomialRing(BPR){[1..dim]};
              yvar:=IndeterminatesOfPolynomialRing(BPR){dim+[1..dim]};

              wy:=Value(wx,xvar,yvar);
              xy_poly:=coefficients(Subword(wx*wy,[root]));
              if xy_poly=[] then
                  return [Zero(BPR),values,step];
              else
                  xy_poly:=xy_poly[1][2];
              fi;

              # APR's
              APR:=ring(algebraicU(w));
              avars:=IndeterminatesOfPolynomialRing(APR);

              result:=ShallowCopy(values);

              # construct generic polynomial
              total_degree:=TotalDegree(xy_poly);
              gen_poly:=Concatenation(GenericLevelPolynomials(w){[1..total_degree]});
              gen_poly_len:=Length(gen_poly);
              gen_poly:=Sum(List([1..gen_poly_len],i->result[step+i]*gen_poly[i]));

              # contruct relations
              relations:=Value(gen_poly,xvar,gws)-gen_poly-Value(gen_poly,xvar,yvar)-xy_poly;
              relations:=ExtRepPolynomialRatFun(relations);
              relations:=relations{2*[1..Length(relations)/2]};

              # solve relations
              result:=SolveRelations(relations,avars,result,APR);
              if result[2]<>[] then Error("SolveWittRoot: coulde not solve all relations!"); return fail; fi;
              result:=result[1];

              # rearrange free variables
              avars_free:=Filtered([1..gen_poly_len+step],i->result[i] in avars);
              avars_free:=result{avars_free};
              avars_free_len:=Length(avars_free);
#    result:=List(result,i->i*One(APR));
#    result:=List(result,i->Value(i,avars_free,avars{[1..avars_free_len]})*One(APR));

              gen_poly:=Concatenation(GenericLevelPolynomials(w){[1..total_degree]});
              gen_poly:=Sum(List([1..Length(gen_poly)],i->result[i+step]*gen_poly[i]));

              return [gen_poly,result,step+gen_poly_len];
end);

InstallMethod(WittGroup,
              "Witt group of unipotent inside group",
              [IsUnipotent,IsUnipotent,IsWitt],
              function(u,centralizer,w)
              local result,u_ordered,
              APR,avars,avars_free,avars_ext,
              BPR,dim,xvars,xvars_ext,
              coeffs,
              i,j,k,pos,sol,step,values,update_poly,monom,
              wg;

              # APR's
              #APR:=ring(algebraicU(w)); asta de ce nu merge?
              APR:=ring(chevalleyAdj(u));
              avars:=IndeterminatesOfPolynomialRing(APR);

              # BPR's
              BPR:=ring(chevalleyAdjBPR(w));
              dim:=Dimension(w);
              xvars:=IndeterminatesOfPolynomialRing(BPR){[1..dim]};

              # centralizer
              #centralizer:=UnipotentCentralizer(algebraicAdj(w),u,distP);
              avars_free:=Set(List(Filtered(coefficients(centralizer),i->i[2] in avars),j->j[2]));
              Sort(avars_free,function(a,b) return ExtRepPolynomialRatFun(a)[1][1]<ExtRepPolynomialRatFun(b)[1][1]; end);
              avars_ext:=List(avars_free,i->ExtRepPolynomialRatFun(i));
              avars_ext:=List(avars_ext,i->i[1][1]);

              result:=List(avars_free,i->Zero(BPR));
              coeffs:=coefficients(centralizer);
              u_ordered:=Unipotent(chevalleyAdj(u),#algebraicU(w), asta de ce nu merge?
                                   coefficients(u),#coefficients(Ascend(u,simpleAdjAPR(algebraicAdj(w)))),
                                   [1..Length(positiveRoots(chevalleyAdjBPR(w)))],
                                   -2);
              for i in coefficients(u_ordered) do
                  k:=Filtered(coeffs,j->j[1]=i[1]);
                  if k = [] then return fail; fi;
                  k:=k[1];
                  if k[2] in avars_free then
                      pos:=Position(avars_free,k[2]);
                      result[pos]:=xvars[1];
                  fi;
              od;
              wg:=GenericWittGroup(centralizer,w,result);

              # function for handeling free variables udpate
              xvars_ext:=List(xvars,i->ExtRepPolynomialRatFun(i));
              xvars_ext:=List(xvars_ext,i->i[1][1]);
              update_poly:=function(poly,values)
                  local result,
                  monom,ext,j,k,pos;
                  result:=Zero(BPR);
                  ext:=ExtRepPolynomialRatFun(poly);
                  for j in [1..Length(ext)/2] do
                      monom:=One(BPR);
                      for k in [1..Length(ext[2*j-1])/2] do
                          pos:=Position(xvars_ext,ext[2*j-1][2*k-1]);
                          monom:=monom*xvars[pos]^ext[2*j-1][2*k];
                      od;
                      monom:=monom*(Value(ext[2*j],avars,values)*One(APR));
                      result:=result+monom;
                  od;
                  return result;
              end;

              values:=ShallowCopy(avars);
              step:=0;
              for i in coeffs do
                  if i[2] in avars_free then
                      pos:=Position(avars_free,i[2]);
                      if result[pos]=Zero(BPR) then
                          # value of free variable
                          sol:=SolveWittRoot(wg,w,i[1],values,step);
                          #if sol=fail then return fail; fi;
                          values:=sol[2];
                          step:=sol[3];
                          # update the construction made so far
                          result:=List(result,i->update_poly(i,values));
                          # set free variable
                          result[pos]:=sol[1];
                          # rebuild group
                          wg:=GenericWittGroup(centralizer,w,result);
                      fi;
                  fi;
              od;

              return wg;
end);

InstallMethod(TestWittGroup,
              "Test if the given unipotent element has the structure of a given witt group",
              [IsUnipotent,IsWitt],
              function(ux,w)
              local dim,p,BPR,xvar,yvar,
              uy,uxy,xcoeff,xycoeff,
              gws,i;

              dim:=Dimension(w);
              BPR:=ring(chevalleyAdjBPR(w));
              xvar:=IndeterminatesOfPolynomialRing(BPR){[1..dim]};
              yvar:=IndeterminatesOfPolynomialRing(BPR){dim+[1..dim]};

              uy:=Value(ux,xvar,yvar);
              gws:=GenericSum(w);

              uxy:=ux*uy;
              for i in [1..Length(positiveRoots(chevalleyAdj(ux)))] do
                  xcoeff:=coefficients(Subword(ux,[i]));
                  xycoeff:=coefficients(Subword(uxy,[i]));
                  if xcoeff=[] and xycoeff<>[] then return i;
                  elif xcoeff<>[] and xycoeff=[] then return i;
                  elif xcoeff<>[] and xycoeff<>[] and Value(xcoeff[1][2],xvar,gws)<>xycoeff[1][2] then return i;
                  fi;
              od;

              return true;
end);

InstallMethod(WittDecomposition,
              "Decomposition of abelian algebraic group into witt group factors",
              [IsUnipotent,IsWitt],
              function(abelian,w)
              local result,
              APR,avars,p,vals,i,tmp,dim,exp,
              handled,support;

              APR:=ring(chevalleyAdj(abelian));
              avars:=IndeterminatesOfPolynomialRing(APR);
              avars:=Filtered(coefficients(abelian),i->i[2] in avars);
              avars:=Set(List(avars,i->i[2]));
              Sort(avars,function(a,b) return ExtRepPolynomialRatFun(a)[1][1]<ExtRepPolynomialRatFun(b)[1][1]; end);
              dim:=Length(avars);
              #    Print("dim=",dim,"\n");

              p:=Characteristic(APR);
              exp:=Maximum(List(ParameterPieces(abelian),i->OrderOp(i)));
              exp:=LogInt(exp,p);

              vals:=List([1..dim],i->Zero(APR));
              result:=[];
              handled:=[];
              for i in [1..dim] do
                  vals[i]:=One(APR);#avars[1];
                  tmp:=Value(abelian,avars,vals);
                  support:=List(coefficients(tmp),i->i[1]);
                  if not IsSubset(handled,support) then
                      #tmp:=WittGr(tmp,abelian,w[LogInt(OrderOp(tmp),p)]);
                      tmp:=WittGroup(tmp,abelian,w);
                      Add(result,tmp);
                      support:=List(coefficients(tmp),i->i[1]);
                      handled:=Concatenation(handled,support);
                  fi;
                  vals[i]:=Zero(APR);
              od;

#    result:=List(result,i->UnipotentLieElement(sysAPR,i,0,ordering(u),1));
              return result;
end);


SymmetricDifference := function(a, b)
  return Union(Difference(a, b), Difference(b, a));
end;

a := ["John", "Serena", "Bob", "Mary", "Serena"];
b := ["Jim", "Mary", "John", "Jim", "Bob"];
SymmetricDifference(a,b);
[ "Jim", "Serena" ]


# Some small pregroups

# The lists of small pregroups were generated by
# Chris Jefferson <caj21@st-andrews.ac.uk> and
# Richard Parker.
ANATPH_small_pregroups[1] :=
   [ [ [ 1 ] ] ];

ANATPH_small_pregroups[2] :=
   [ [ [1, 2],
       [2, 1] ] ];

ANATPH_small_pregroups[3] :=
   [ [ [1, 2, 3],
       [2, 1, 0],
       [3, 0, 1] ] ];
# missing: Cyclic group of order 3

ANATPH_small_pregroups[4] :=
 [ [ [1, 2, 3, 4],
     [2, 1, 0, 0],
     [3, 0, 1, 0],
     [4, 0, 0, 1] ],
   [ [1, 2, 3, 4],
     [2, 1, 4, 3],
     [3, 4, 1, 2],
     [4, 3, 2, 1] ],
   [ [1, 2, 3, 4],
     [2, 1, 0, 0],
     [3, 0, 0, 1],
     [4, 0, 1, 0] ],
   [ [1, 2, 3, 4],
     [2, 1, 0, 0],
     [3, 0, 4, 1],
     [4, 0, 1, 3] ],
   [ [1, 2, 3, 4],
     [2, 1, 4, 3],
     [3, 4, 2, 1],
     [4, 3, 1, 2] ] ];

ANATPH_small_pregroups[5] :=
   [ [ [1, 2, 3, 4, 5],
       [2, 1, 0, 0, 0],
       [3, 0, 1, 0, 0],
       [4, 0, 0, 1, 0],
       [5, 0, 0, 0, 1] ],
     [ [1, 2, 3, 4, 5],
       [2, 1, 4, 3, 0],
       [3, 4, 1, 2, 0],
       [4, 3, 2, 1, 0],
       [5, 0, 0, 0, 1]],
     [ [1, 2, 3, 4, 5],
       [2, 1, 0, 0, 0],
       [3, 0, 1, 0, 0],
       [4, 0, 0, 0, 1],
       [5, 0, 0, 1, 0]],
     [ [1, 2, 3, 4, 5],
       [2, 1, 0, 0, 0],
       [3, 0, 1, 0, 0],
       [4, 0, 0, 5, 1],
       [5, 0, 0, 1, 4]],
     [ [1, 2, 3, 4, 5],
       [2, 1, 4, 3, 0],
       [3, 4, 2, 1, 0],
       [4, 3, 1, 2, 0],
       [5, 0, 0, 0, 1]],
     [ [1, 2, 3, 4, 5],
       [2, 0, 1, 0, 0],
       [3, 1, 0, 0, 0],
       [4, 0, 0, 0, 1],
       [5, 0, 0, 1, 0]],
     [ [1, 2, 3, 4, 5],
       [2, 3, 1, 0, 0],
       [3, 1, 2, 0, 0],
       [4, 0, 0, 0, 1],
       [5, 0, 0, 1, 0]],
     [ [1, 2, 3, 4, 5],
       [2, 3, 1, 0, 0],
       [3, 1, 2, 0, 0],
       [4, 0, 0, 5, 1],
       [5, 0, 0, 1, 4]],
     [ [1, 2, 3, 4, 5],
       [2, 3, 4, 5, 1],
       [3, 4, 5, 1, 2],
       [4, 5, 1, 2, 3],
       [5, 1, 2, 3, 4]]];

ANATPH_small_pregroups[6] :=
    [ [ [1,2,3,4,5,6],
        [2,1,0,5,4,0],
        [3,6,0,1,0,0],
        [4,0,1,0,0,2],
        [5,0,2,0,0,1],
        [6,3,0,0,1,0] ],
      [ [1,2,3,4,5,6],
        [2,1,5,0,3,0],
        [3,0,0,1,0,2],
        [4,6,1,0,0,0],
        [5,0,0,2,0,1],
        [6,4,0,0,1,0] ],
      [ [1,2,3,4,5,6],
        [2,1,0,6,0,4],
        [3,5,0,1,0,0],
        [4,0,1,0,2,0],
        [5,3,0,0,0,1],
        [6,0,2,0,1,0] ],
      [ [1,2,3,4,5,6],
        [2,1,5,6,3,4],
        [3,5,0,1,0,2],
        [4,6,1,0,2,0],
        [5,3,0,2,0,1],
        [6,4,2,0,1,0] ],
      [ [1,2,3,4,5,6],
        [2,1,6,0,0,3],
        [3,0,0,1,2,0],
        [4,5,1,0,0,0],
        [5,4,0,0,0,1],
        [6,0,0,2,1,0] ],
      [ [1,2,3,4,5,6],
        [2,1,6,5,4,3],
        [3,6,0,1,2,0],
        [4,5,1,0,0,2],
        [5,4,2,0,0,1],
        [6,3,0,2,1,0] ],
      [ [1,2,3,4,5,6],
        [2,1,5,6,3,4],
        [3,6,1,0,0,2],
        [4,5,0,1,2,0],
        [5,4,2,0,0,1],
        [6,3,0,2,1,0] ],
      [ [1,2,3,4,5,6],
        [2,1,0,6,0,4],
        [3,0,1,5,4,0],
        [4,5,6,1,2,3],
        [5,4,0,3,0,1],
        [6,0,4,2,1,0] ],
      [ [1,2,3,4,5,6],
        [2,1,0,5,4,0],
        [3,0,1,6,0,4],
        [4,6,5,1,3,2],
        [5,0,4,2,0,1],
        [6,4,0,3,1,0] ],
      [ [1,2,3,4,5,6],
        [2,1,6,0,0,3],
        [3,5,1,6,2,4],
        [4,0,5,1,3,0],
        [5,3,4,0,0,1],
        [6,0,2,3,1,0] ],
      [ [1,2,3,4,5,6],
        [2,1,4,3,6,5],
        [3,4,1,2,0,0],
        [4,3,2,1,0,0],
        [5,6,0,0,2,1],
        [6,5,0,0,1,2] ],
      [ [1,2,3,4,5,6],
        [2,1,4,3,0,0],
        [3,4,1,2,6,5],
        [4,3,2,1,0,0],
        [5,0,6,0,3,1],
        [6,0,5,0,1,3] ],
      [ [1,2,3,4,5,6],
        [2,1,4,3,0,0],
        [3,4,1,2,0,0],
        [4,3,2,1,6,5],
        [5,0,0,6,4,1],
        [6,0,0,5,1,4] ],
      [ [1,2,3,4,5,6],
        [2,1,6,5,4,3],
        [3,6,1,0,0,2],
        [4,5,0,1,2,0],
        [5,4,0,2,1,0],
        [6,3,2,0,0,1] ],
      [ [1,2,3,4,5,6],
        [2,1,6,0,0,3],
        [3,6,1,5,4,2],
        [4,0,5,1,3,0],
        [5,0,4,3,1,0],
        [6,3,2,0,0,1] ],
      [ [1,2,3,4,5,6],
        [2,1,5,6,3,4],
        [3,5,1,0,2,0],
        [4,6,0,1,0,2],
        [5,3,2,0,1,0],
        [6,4,0,2,0,1] ],
      [ [1,2,3,4,5,6],
        [2,1,0,6,0,4],
        [3,0,1,5,4,0],
        [4,6,5,1,3,2],
        [5,0,4,3,1,0],
        [6,4,0,2,0,1] ],
      [ [1,2,3,4,5,6],
        [2,1,5,0,3,0],
        [3,5,1,6,2,4],
        [4,0,6,1,0,3],
        [5,3,2,0,1,0],
        [6,0,4,3,0,1] ],
      [ [1,2,3,4,5,6],
        [2,1,0,5,4,0],
        [3,0,1,6,0,4],
        [4,5,6,1,2,3],
        [5,4,0,2,1,0],
        [6,0,4,3,0,1] ],
      [ [1,2,3,4,5,6],
        [2,1,4,3,6,5],
        [3,4,1,2,0,0],
        [4,3,2,1,0,0],
        [5,6,0,0,1,2],
        [6,5,0,0,2,1] ],
      [ [1,2,3,4,5,6],
        [2,1,0,0,6,5],
        [3,0,1,5,4,0],
        [4,0,5,1,3,0],
        [5,6,4,3,1,2],
        [6,5,0,0,2,1] ],
      [ [1,2,3,4,5,6],
        [2,1,0,0,6,5],
        [3,0,1,6,0,4],
        [4,0,6,1,0,3],
        [5,6,0,0,1,2],
        [6,5,4,3,2,1] ],
      [ [1,2,3,4,5,6],
        [2,1,4,3,0,0],
        [3,4,1,2,6,5],
        [4,3,2,1,0,0],
        [5,0,6,0,1,3],
        [6,0,5,0,3,1] ],
      [ [1,2,3,4,5,6],
        [2,1,0,5,4,0],
        [3,0,1,0,6,5],
        [4,5,0,1,2,0],
        [5,4,6,2,1,3],
        [6,0,5,0,3,1] ],
      [ [1,2,3,4,5,6],
        [2,1,0,6,0,4],
        [3,0,1,0,6,5],
        [4,6,0,1,0,2],
        [5,0,6,0,1,3],
        [6,4,5,2,3,1] ],
      [ [1,2,3,4,5,6],
        [2,1,4,3,0,0],
        [3,4,1,2,0,0],
        [4,3,2,1,6,5],
        [5,0,0,6,1,4],
        [6,0,0,5,4,1] ],
      [ [1,2,3,4,5,6],
        [2,1,5,0,3,0],
        [3,5,1,0,2,0],
        [4,0,0,1,6,5],
        [5,3,2,6,1,4],
        [6,0,0,5,4,1] ],
      [ [1,2,3,4,5,6],
        [2,1,6,0,0,3],
        [3,6,1,0,0,2],
        [4,0,0,1,6,5],
        [5,0,0,6,1,4],
        [6,3,2,5,4,1] ]
    ];

ANATPH_small_pregroups[7] :=
    [ [ [1, 2, 3, 4, 5, 6, 7],
        [2, 1, 0, 0, 0, 0, 0],
        [3, 0, 1, 0, 0, 0, 0],
        [4, 0, 0, 1, 0, 0, 0],
        [5, 0, 0, 0, 1, 0, 0],
        [6, 0, 0, 0, 0, 1, 0],
        [7, 0, 0, 0, 0, 0, 1] ],
      [ [1, 2, 3, 4, 5, 6, 7],
        [2, 1, 4, 3, 0, 0, 0],
        [3, 4, 1, 2, 0, 0, 0],
        [4, 3, 2, 1, 0, 0, 0],
        [5, 0, 0, 0, 1, 0, 0],
        [6, 0, 0, 0, 0, 1, 0],
        [7, 0, 0, 0, 0, 0, 1] ],
      [ [1, 2, 3, 4, 5, 6, 7],
        [2, 1, 4, 3, 0, 0, 0],
        [3, 4, 1, 2, 0, 0, 0],
        [4, 3, 2, 1, 0, 0, 0],
        [5, 0, 0, 0, 1, 7, 6],
        [6, 0, 0, 0, 7, 1, 5],
        [7, 0, 0, 0, 6, 5, 1] ],
      [ [1, 2, 3, 4, 5, 6, 7],
        [2, 1, 4, 3, 6, 5, 0],
        [3, 4, 1, 2, 0, 0, 0],
        [4, 3, 2, 1, 0, 0, 0],
        [5, 6, 0, 0, 1, 2, 0],
        [6, 5, 0, 0, 2, 1, 0],
        [7, 0, 0, 0, 0, 0, 1] ],
      [ [1, 2, 3, 4, 5, 6, 7],
        [2, 1, 0, 0, 0, 0, 0],
        [3, 0, 1, 0, 0, 0, 0],
        [4, 0, 0, 1, 0, 0, 0],
        [5, 0, 0, 0, 1, 0, 0],
        [6, 0, 0, 0, 0, 0, 1],
        [7, 0, 0, 0, 0, 1, 0] ],
      [ [1, 2, 3, 4, 5, 6, 7],
        [2, 1, 0, 0, 0, 0, 0],
        [3, 0, 1, 0, 0, 0, 0],
        [4, 0, 0, 1, 0, 0, 0],
        [5, 0, 0, 0, 1, 0, 0],
        [6, 0, 0, 0, 0, 7, 1],
        [7, 0, 0, 0, 0, 1, 6] ],
      [ [1, 2, 3, 4, 5, 6, 7],
        [2, 1, 4, 3, 0, 0, 0],
        [3, 4, 1, 2, 0, 0, 0],
        [4, 3, 2, 1, 0, 0, 0],
        [5, 0, 0, 0, 1, 0, 0],
        [6, 0, 0, 0, 0, 0, 1],
        [7, 0, 0, 0, 0, 1, 0] ],
      [ [1, 2, 3, 4, 5, 6, 7],
        [2, 1, 4, 3, 0, 0, 0],
        [3, 4, 1, 2, 0, 0, 0],
        [4, 3, 2, 1, 0, 0, 0],
        [5, 0, 0, 0, 1, 0, 0],
        [6, 0, 0, 0, 0, 7, 1],
        [7, 0, 0, 0, 0, 1, 6] ],
      [ [1, 2, 3, 4, 5, 6, 7],
        [2, 1, 4, 3, 0, 0, 0],
        [3, 4, 1, 2, 0, 0, 0],
        [4, 3, 2, 1, 0, 0, 0],
        [5, 0, 0, 0, 1, 7, 6],
        [6, 0, 0, 0, 7, 5, 1],
        [7, 0, 0, 0, 6, 1, 5] ],
      [ [1, 2, 3, 4, 5, 6, 7],
        [2, 1, 4, 3, 6, 5, 0],
        [3, 4, 1, 2, 0, 0, 0],
        [4, 3, 2, 1, 0, 0, 0],
        [5, 6, 0, 0, 2, 1, 0],
        [6, 5, 0, 0, 1, 2, 0],
        [7, 0, 0, 0, 0, 0, 1] ],
      [ [1, 2, 3, 4, 5, 6, 7],
        [2, 1, 4, 3, 6, 5, 0],
        [3, 5, 1, 0, 2, 0, 0],
        [4, 6, 2, 0, 1, 0, 0],
        [5, 3, 0, 1, 0, 2, 0],
        [6, 4, 0, 2, 0, 1, 0],
        [7, 0, 0, 0, 0, 0, 1] ],
      [ [1, 2, 3, 4, 5, 6, 7],
        [2, 1, 4, 3, 6, 5, 0],
        [3, 5, 1, 6, 2, 4, 0],
        [4, 6, 2, 5, 1, 3, 0],
        [5, 3, 6, 1, 4, 2, 0],
        [6, 4, 5, 2, 3, 1, 0],
        [7, 0, 0, 0, 0, 0, 1] ],
      [ [1, 2, 3, 4, 5, 6, 7],
        [2, 1, 0, 0, 0, 0, 0],
        [3, 0, 1, 0, 0, 0, 0],
        [4, 0, 0, 0, 1, 0, 0],
        [5, 0, 0, 1, 0, 0, 0],
        [6, 0, 0, 0, 0, 0, 1],
        [7, 0, 0, 0, 0, 1, 0] ],
      [ [1, 2, 3, 4, 5, 6, 7],
        [2, 1, 0, 0, 0, 0, 0],
        [3, 0, 1, 0, 0, 0, 0],
        [4, 0, 0, 5, 1, 0, 0],
        [5, 0, 0, 1, 4, 0, 0],
        [6, 0, 0, 0, 0, 0, 1],
        [7, 0, 0, 0, 0, 1, 0] ],
      [ [1, 2, 3, 4, 5, 6, 7],
        [2, 1, 0, 0, 0, 0, 0],
        [3, 0, 1, 0, 0, 0, 0],
        [4, 0, 0, 5, 1, 0, 0],
        [5, 0, 0, 1, 4, 0, 0],
        [6, 0, 0, 0, 0, 7, 1],
        [7, 0, 0, 0, 0, 1, 6] ],
      [ [1, 2, 3, 4, 5, 6, 7],
        [2, 1, 0, 0, 0, 0, 0],
        [3, 0, 1, 0, 0, 0, 0],
        [4, 0, 0, 5, 6, 7, 1],
        [5, 0, 0, 6, 7, 1, 4],
        [6, 0, 0, 7, 1, 4, 5],
        [7, 0, 0, 1, 4, 5, 6] ],
      [ [1, 2, 3, 4, 5, 6, 7],
        [2, 1, 4, 3, 0, 0, 0],
        [3, 4, 2, 1, 0, 0, 0],
        [4, 3, 1, 2, 0, 0, 0],
        [5, 0, 0, 0, 1, 0, 0],
        [6, 0, 0, 0, 0, 1, 0],
        [7, 0, 0, 0, 0, 0, 1] ],
      [ [1, 2, 3, 4, 5, 6, 7],
        [2, 1, 4, 3, 0, 0, 0],
        [3, 4, 2, 1, 0, 0, 0],
        [4, 3, 1, 2, 0, 0, 0],
        [5, 0, 0, 0, 1, 0, 0],
        [6, 0, 0, 0, 0, 0, 1],
        [7, 0, 0, 0, 0, 1, 0] ],
      [ [1, 2, 3, 4, 5, 6, 7],
        [2, 1, 4, 3, 0, 0, 0],
        [3, 4, 2, 1, 0, 0, 0],
        [4, 3, 1, 2, 0, 0, 0],
        [5, 0, 0, 0, 1, 0, 0],
        [6, 0, 0, 0, 0, 7, 1],
        [7, 0, 0, 0, 0, 1, 6] ],
      [ [1, 2, 3, 4, 5, 6, 7],
        [2, 1, 4, 3, 0, 0, 0],
        [3, 4, 2, 1, 0, 0, 0],
        [4, 3, 1, 2, 0, 0, 0],
        [5, 0, 0, 0, 1, 7, 6],
        [6, 0, 0, 0, 7, 5, 1],
        [7, 0, 0, 0, 6, 1, 5] ],
      [ [1, 2, 3, 4, 5, 6, 7],
        [2, 1, 4, 3, 6, 5, 0],
        [3, 4, 2, 1, 0, 0, 0],
        [4, 3, 1, 2, 0, 0, 0],
        [5, 6, 0, 0, 2, 1, 0],
        [6, 5, 0, 0, 1, 2, 0],
        [7, 0, 0, 0, 0, 0, 1] ],
      [ [1, 2, 3, 4, 5, 6, 7],
        [2, 1, 4, 3, 0, 0, 0],
        [3, 0, 0, 0, 1, 2, 0],
        [4, 0, 0, 0, 2, 1, 0],
        [5, 6, 1, 0, 0, 0, 0],
        [6, 5, 0, 1, 0, 0, 0],
        [7, 0, 0, 0, 0, 0, 1] ],
      [ [1, 2, 3, 4, 5, 6, 7],
        [2, 1, 4, 3, 0, 0, 0],
        [3, 0, 0, 0, 1, 2, 4],
        [4, 0, 0, 0, 2, 1, 3],
        [5, 6, 1, 7, 0, 0, 0],
        [6, 5, 7, 1, 0, 0, 0],
        [7, 0, 0, 0, 6, 5, 1] ],
      [ [1, 2, 3, 4, 5, 6, 7],
        [2, 1, 4, 3, 6, 5, 0],
        [3, 4, 0, 0, 1, 2, 0],
        [4, 3, 0, 0, 2, 1, 0],
        [5, 6, 1, 2, 0, 0, 0],
        [6, 5, 2, 1, 0, 0, 0],
        [7, 0, 0, 0, 0, 0, 1] ],
      [ [1, 2, 3, 4, 5, 6, 7],
        [2, 1, 4, 3, 6, 5, 0],
        [3, 4, 5, 6, 1, 2, 0],
        [4, 3, 6, 5, 2, 1, 0],
        [5, 6, 1, 2, 3, 4, 0],
        [6, 5, 2, 1, 4, 3, 0],
        [7, 0, 0, 0, 0, 0, 1] ],
      [ [1, 2, 3, 4, 5, 6, 7],
        [2, 0, 1, 0, 0, 0, 0],
        [3, 1, 0, 0, 0, 0, 0],
        [4, 0, 0, 0, 1, 0, 0],
        [5, 0, 0, 1, 0, 0, 0],
        [6, 0, 0, 0, 0, 0, 1],
        [7, 0, 0, 0, 0, 1, 0] ],
      [ [1, 2, 3, 4, 5, 6, 7],
        [2, 3, 1, 0, 0, 0, 0],
        [3, 1, 2, 0, 0, 0, 0],
        [4, 0, 0, 0, 1, 0, 0],
        [5, 0, 0, 1, 0, 0, 0],
        [6, 0, 0, 0, 0, 0, 1],
        [7, 0, 0, 0, 0, 1, 0] ],
      [ [1, 2, 3, 4, 5, 6, 7],
        [2, 3, 1, 0, 0, 0, 0],
        [3, 1, 2, 0, 0, 0, 0],
        [4, 0, 0, 5, 1, 0, 0],
        [5, 0, 0, 1, 4, 0, 0],
        [6, 0, 0, 0, 0, 0, 1],
        [7, 0, 0, 0, 0, 1, 0] ],
      [ [1, 2, 3, 4, 5, 6, 7],
        [2, 3, 1, 0, 0, 0, 0],
        [3, 1, 2, 0, 0, 0, 0],
        [4, 0, 0, 5, 1, 0, 0],
        [5, 0, 0, 1, 4, 0, 0],
        [6, 0, 0, 0, 0, 7, 1],
        [7, 0, 0, 0, 0, 1, 6] ],
      [ [1, 2, 3, 4, 5, 6, 7],
        [2, 0, 1, 5, 0, 0, 0],
        [3, 1, 0, 0, 4, 0, 0],
        [4, 0, 0, 0, 0, 1, 3],
        [5, 0, 0, 0, 0, 2, 1],
        [6, 0, 7, 1, 0, 0, 0],
        [7, 6, 0, 0, 1, 0, 0] ],
      [ [1, 2, 3, 4, 5, 6, 7],
        [2, 3, 1, 0, 0, 0, 0],
        [3, 1, 2, 0, 0, 0, 0],
        [4, 0, 0, 5, 6, 7, 1],
        [5, 0, 0, 6, 7, 1, 4],
        [6, 0, 0, 7, 1, 4, 5],
        [7, 0, 0, 1, 4, 5, 6] ],
      [ [1, 2, 3, 4, 5, 6, 7],
        [2, 3, 4, 5, 1, 0, 0],
        [3, 4, 5, 1, 2, 0, 0],
        [4, 5, 1, 2, 3, 0, 0],
        [5, 1, 2, 3, 4, 0, 0],
        [6, 0, 0, 0, 0, 0, 1],
        [7, 0, 0, 0, 0, 1, 0] ],
      [ [1, 2, 3, 4, 5, 6, 7],
        [2, 3, 4, 5, 6, 7, 1],
        [3, 4, 5, 6, 7, 1, 2],
        [4, 5, 6, 7, 1, 2, 3],
        [5, 6, 7, 1, 2, 3, 4],
        [6, 7, 1, 2, 3, 4, 5],
        [7, 1, 2, 3, 4, 5, 6] ]
    ];

InstallGlobalFunction("NrSmallPregroups",
function(n)
    if not IsPosInt(n) then
        Error("n has to be a positive integer");
    fi;

    if IsBound(ANATPH_small_pregroups[n]) then
        return Length(ANATPH_small_pregroups[n]);
    fi;
    return fail;
end);

InstallGlobalFunction("SmallPregroup",
function(n,i)
    local names;
    if not IsPosInt(n) then
        Error("n has to be a positive integer");
    fi;

    if IsPosInt(i) and
       IsBound(ANATPH_small_pregroups[n]) and
       IsBound(ANATPH_small_pregroups[n][i]) then
        names := Concatenation( ["1"]
                              , List([2..n], y -> Concatenation("p", String(y-1))));
        return PregroupByTable(names, ANATPH_small_pregroups[n][i]);
    else
        Error("small pregroup of size ", n, " with index ", i, " not available");
    fi;
end);


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

# mn=16, m=4, n=4, h=3
ImportAll(spiral);

# even k, P permutation on pairs
 P := (km,k) -> (i -> let(m := km/k, h := Int((m+2)/2), mc:=Int((m+1)/2),
	 Cond(
	     i < h, k*i,
	     i >= km/2-mc+1, k/2 + k*(i-(km/2-mc+1)),
	     ((i-h) mod m) mod 2 = 0, k*((i-h) mod m)/2 + 1 + Int((i-h)/m),
		              k*((i-h) mod m)/2 + 1 + Int(k/2-1-(i-h)/m)
	 )));

# even k, P permutation on single el-s
 rP := (km,k) -> (i -> let(m := km/k,
	 Cond(
	     i = 0, 0,
	     1 <= i and i < m, -1 + 2*k*Int((i+1)/2) + ((i-1) mod 2),
	     i >= km-m, k + 2*k*Int((i-(km-m))/2) - 1 + ((i-m) mod 2),
	     (Int((i-m)/2) mod m) mod 2 = 0, k*(Int((i-m)/2) mod m) + 1 + 2*Int((i-m)/(2*m)) + (i-m) mod 2,
	                                     k*(Int((i-m)/2) mod m) + 1 + 2*Int((km-m-i)/(2*m)) + (i-m) mod 2
	 )));

# odd k, \hat{P} permutation on pairs
 Phat := (km,k) -> (i -> let(m := km/k, h := Int((m+2)/2),
	 Cond(
	     i < h, k*i,
	     ((i-h) mod m) mod 2 = 0, Int(k*((i-h) mod m)/2) + 1 + Int((i-h)/m),
		                      Int(k*((i-h) mod m)/2) +  Int((k+1)/2-(i-h)/m)
	 )));

# odd k
 rPhat := (km,k) -> (i -> let(m := km/k,
	 Cond(
	     i = 0, 0,
	     1 <= i and i < m, -1 + 2*k*Int((i+1)/2) + ((i-1) mod 2),
	     (Int((i-m)/2) mod m) mod 2 = 0, k*(Int((i-m)/2) mod m) + 1 + 2*Int((i-m)/(2*m)) + (i-m) mod 2,
		                             k*(Int((i-m)/2) mod m) +     2*Int((km-i)/(2*m)) + (i-m) mod 2
	 )));

# odd k
 rQhat := (km,k) -> (i -> let(m := km/k,
	 Cond(
	     i >= km-m, k-1 + 2*k*Int((i-(km-m))/2) + (i-(km-m)) mod 2,
	     (Int(i/2) mod m) mod 2 = 0, k*(Int(i/2) mod m) +     2*Int(i/(2*m)) + i mod 2,
	                                 k*(Int(i/2) mod m) + 1 + 2*Int((km-m-i)/(2*m)) + i mod 2
	 )));

# Pshow := (km,k)->let(N := Int(km/2)+1, pm(Perm(PermFunc(P(km,k),N),N)));
# rPshow := (km,k)->let(N := km, pm(Perm(PermFunc(rP(km,k),N),N)));
# Phatshow := (km,k)->let(N := Int((km+2)/2), pm(Perm(PermFunc(Phat(km,k),N),N)));

PermP := (m, k) -> Checked(IsEvenInt(k), PermFunc(rP(k*m,k),k*m)^-1);
PermPhat := (m, k) -> Checked(IsOddInt(k), PermFunc(rPhat(k*m,k),k*m)^-1);
PermQhat := (m, k) -> Checked(IsOddInt(k), PermFunc(rQhat(k*m,k),k*m)^-1);

p_4_4 := PermP(4,4);
p_4_8 := PermP(4,8);
p_8_4 := PermP(8,4);
p_8_8 := PermP(8,8);

p_3_4 := PermP(3,4);
p_5_4 := PermP(5,4);
p_5_8 := PermP(5,8);

phat_4_3 := PermPhat(4,3);
phat_4_5 := PermPhat(4,5);
phat_8_5 := PermPhat(8,5);
phat_8_7 := PermPhat(8,7);
phat_7_7 := PermPhat(7,7);

qhat_4_3 := PermQhat(4,3);
qhat_4_5 := PermQhat(4,5);
qhat_8_5 := PermQhat(8,5);
qhat_8_7 := PermQhat(8,7);
qhat_7_7 := PermQhat(7,7);


# Copyright (c) 2018-2020, Carnegie Mellon University
# See LICENSE for details
#
# Utility functions for checking properties of the adjacency matrix NISQ topology
#

##
#F GetEdges( <arch>, <q> )
##
## Gets a list of edges in arch for a target qubit q
GetEdges := function(arch, q)
    local row, inqub, edges, e, edges;
    row := arch[q+1];
    inqub := 0;
    edges := [];
    for e in row do
        if e = 1 then
            Add(edges, inqub);
        fi;
        inqub := inqub + 1;
    od;
    # now have a list of adjacent qubits to the chosen qubit
    return edges;
end;

##
#F HasEdge( <i>, <j>, <arch> )
##
#F Checks if there is an edge between qubits i and j in arch
HasEdge:= function (i, j, arch)
    local row;
    row := arch[i+1];
    return row[j+1];
end;

##
#F GetDist( <i>, <j>, <arch> )
##
#F Returns the minimum distance in the architecture from qubit i to qubit j
GetDist := function (i, j, arch)
    local es, distances, dist, adjmat, n, inc;
    if (i = j) then
        return 0;
    fi;
    adjmat := arch;
    n := Length(arch);
    dist := 1;
    inc := 0;
    while (adjmat[i+1][j+1] <= 0 and inc <= n) do
        adjmat := adjmat * adjmat;
        dist := dist + 1;
        inc := inc + 1;
    od;
    if inc > n then # not possible, maybe do something better than returning null
        return n+2; #psuedo-null
    fi;
    return dist;
end;

##
#F Best_Move( <i>, <j>, <arch> )
##
#F Returns the most straightforward swap to perform to bring i and j closer
Best_Move := function (i, j, arch)
    local es, distances, shortest_path, e, best_move, l, tes;
    es := GetEdges(arch, i);
    tes := GetEdges(arch, j);
    if ContainsElement(es, j) then # if immediate neighbors
        return j;
    fi;
    l := Filtered(es, (e)-> ContainsElement(tes, e)); # find the immediate children they share, see if any match
    if l <> [] then
        return l[1];
    fi;
    # have to calculate distances
    distances := Map(es, e -> (GetDist(e, j, arch)));
    shortest_path := Minimum(distances);
    shortest_path := PositionProperty(distances, (e) -> (e = shortest_path));
    best_move := es[shortest_path];
    return best_move;
end;

##
#F VerifyPath( <target>, <source>, <arch> )
##
#F verifies that target and source are connected in arch
VerifyPath := function (target, source, arch)
    local i, q;
    i := 1;
    for q in target do
        if(GetDist(target[i], source[i], arch) > Length(arch)) then
            return false;
        fi;
        i := i + 1;
    od;
    return true;
end;


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

NewRulesFor(DFT, rec(
    DFT_PRDFT := rec(
    switch := false,
    applicable := t -> Rows(t) >= 3 and t.getTags()=[],
    children := t -> [[ PRDFT1(Rows(t),t.params[2]) ]],
    apply := (t, ch, nonterms) -> let(n := Rows(t),
        bc := Mat([[1, E(4)], [1, -E(4)]]),
        DirectSum(
        Mat([[1,0]]),
        LIJ(n-1).transpose() * Cond(IsEvenInt(n),
            DirectSum(Tensor(I((n-2)/2), bc), Mat([[1,0]])),
            Tensor(I((n-1)/2), bc))) *
        ch[1])

    )
));

NewRulesFor(DFT2, rec(
    DFT2_PRDFT2 := rec(
    switch := false,
    applicable := t -> Rows(t) >= 3,
    children := t -> [[ PRDFT2(Rows(t), t.params[2]) ]],
    apply := (t, ch, nonterms) -> let(n := Rows(t), sgn := (-1)^t.params[2],
        bc := Mat([[1, E(4)], sgn*[1, -E(4)]]),
        DirectSum(
        Mat([[1,0]]),
        LIJ(n-1).transpose() * Cond(IsEvenInt(n),
            DirectSum(Tensor(I((n-2)/2), bc), Mat([[0,E(4)]])),
            Tensor(I((n-1)/2), bc))) *
        ch[1])

    )
));

NewRulesFor(DFT3, rec(
    DFT3_PRDFT3 := rec(
    switch := false,
    applicable := t -> Rows(t) >= 3,
    children := t -> [[ PRDFT3(Rows(t), t.params[2]) ]],
    apply := (t, ch, nonterms) -> let(n := Rows(t),
        bc := Mat([[1, E(4)], [1, -E(4)]]),
        LIJ(n).transpose() *
        Cond(IsEvenInt(n),
         Tensor(I(n/2), bc),
         DirectSum(Tensor(I((n-1)/2), bc), Mat([[1,0]]))) *
        ch[1])

    )
));

NewRulesFor(DFT4, rec(
    DFT4_PRDFT4 := rec(
    switch := false,
    applicable := t -> Rows(t) >= 3,
    children := t -> [[ PRDFT4(Rows(t),t.params[2]) ]],
    apply := (t, ch, nonterms) -> let(n := Rows(t), sgn := (-1)^t.params[2], jj := E(4)^t.params[2],
        bc := Mat([[1, E(4)], sgn*[1, -E(4)]]),
        LIJ(n).transpose() *
        Cond(IsEvenInt(n),
         Tensor(I(n/2), bc),
                 # last element could be real or imaginary based on
                 # rotation (t.params[2]) (but not both), so we scale both slots
         DirectSum(Tensor(I((n-1)/2), bc), Mat([[jj,jj]]))) *
        ch[1])

    )
));


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

############################################################################
##
#M  Degree(<G>)
##
##  see IRREDSOL documentation
##
InstallMethod(Degree, "for matrix group", true, [IsMatrixGroup], 0,
    DegreeOfMatrixGroup);

############################################################################
##
#M  DegreeOfMatrixGroup(<G>)
##
##  see IRREDSOL documentation
##
InstallMethod(DegreeOfMatrixGroup, "for matrix group with dimension", true,
    [IsMatrixGroup and HasDimension], 0,
    Dimension);

############################################################################
##
#M  IsIrreducible(<G>)
##
##  see IRREDSOL documentation
##
InstallMethod(IsIrreducible, "for matrix group", true, [IsMatrixGroup], 0,
    function(G)
        return IsIrreducibleMatrixGroup(G, FieldOfMatrixGroup(G));
    end);

############################################################################
##
#M  IsIrreducible(<G>, <F>)
##
##  see IRREDSOL documentation
##
InstallMethod(IsIrreducible, "for matrix group and field", IsMatGroupOverFieldFam,
    [IsMatrixGroup, IsField], 0,
    function(G, F)
        return IsIrreducibleMatrixGroup(G, F);
    end);

############################################################################
##
#M  IsIrreducibleMatrixGroup(<G>)
##
##
InstallOtherMethod(IsIrreducibleMatrixGroup, "for matrix group", true, [IsMatrixGroup], 0,
    function(G)
        return IsIrreducibleMatrixGroup(G, FieldOfMatrixGroup(G));
    end);

############################################################################
##
#M  IsIrreducibleMatrixGroup(<G>, <F>)
##
InstallMethod(IsIrreducibleMatrixGroupOp, "for matrix group and finite field - use MeatAxe",
    IsMatGroupOverFieldFam, [IsFFEMatrixGroup, IsField and IsFinite], 0,
    function(G, F)

        if not IsSubset(F, FieldOfMatrixGroup(G)) then
            Error("G must be a matrix group over F");
        fi;
        if DegreeOfMatrixGroup(G) = 1 then
            return true;
        elif IsTrivial(G) then
            return false;
        elif IsSubset(F, FieldOfMatrixGroup(G)) then
            return MTX.IsIrreducible (GModuleByMats (GeneratorsOfGroup(G), F));
        else
            Error("G must be a matrix group over F");
        fi;
    end);

############################################################################
##
#M  IsIrreducibleMatrixGroup(<G>, <F>)
##
InstallMethod(IsIrreducibleMatrixGroupOp, "for matrix group and finite field - test attr IsIrreducibleMatrixGroup",
    IsMatGroupOverFieldFam, [IsFFEMatrixGroup and HasIsIrreducibleMatrixGroup,
        IsField and IsFinite], 0,
    function(G, F)

        if not IsSubset(F, FieldOfMatrixGroup(G)) then
            Error("G must be a matrix group over F");
        fi;
        if IsIrreducibleMatrixGroup(G) then
            if F = FieldOfMatrixGroup(G) then
                return true;
            fi;
        elif IsSubset(F, FieldOfMatrixGroup(G)) then
            return false;
        fi;
        TryNextMethod();
    end);

############################################################################
##
#M  IsIrreducibleMatrixGroup(<G>, <F>)
##
InstallMethod(IsIrreducibleMatrixGroupOp, "for matrix group and finite field - for absolutely irreducible matrix group",
    IsMatGroupOverFieldFam, [IsFFEMatrixGroup and IsAbsolutelyIrreducibleMatrixGroup,
        IsField and IsFinite], RankFilter(HasIsIrreducibleMatrixGroup),
    function(G, F)

        if not IsSubset(F, FieldOfMatrixGroup(G)) then
            Error("G must be a matrix group over F");
        fi;
        return true;
    end);

############################################################################
##
#M  IsAbsolutelyIrreducible(<G>)
##
InstallMethod(IsAbsolutelyIrreducible, "for matrix group", true, [IsMatrixGroup], 0,
    function(G)
        return IsAbsolutelyIrreducibleMatrixGroup(G);
    end);

############################################################################
##
#M  IsAbsolutelyIrreducibleMatrixGroup(<G>)
##
##  we use `InstallOtherMethod' because otherwise there will be a warning
##  generated by KeyDependentOperation
##
InstallOtherMethod(IsAbsolutelyIrreducibleMatrixGroup, "for mat group over finite field", true,
    [IsFFEMatrixGroup], 0,

    function(G)

    local M;

    if DegreeOfMatrixGroup(G) = 1 then
        return true;
    elif IsTrivial(G) then
        return false;
    else
        M := GModuleByMats (GeneratorsOfGroup(G), DefaultFieldOfMatrixGroup(G));
        return MTX.IsIrreducible (M) and MTX.IsAbsolutelyIrreducible (M);
    fi;
end);

############################################################################
##
#M  IsPrimitive(<G>)
##
##  see IRREDSOL documentation
##
InstallMethod(IsPrimitive, "for matrix group", true, [IsMatrixGroup], 0,
    function(G)
        return IsPrimitiveMatrixGroup(G,  FieldOfMatrixGroup(G));
    end);

############################################################################
##
#M  IsPrimitiveMatrixGroup(<G>)
##
##  we need an OtherMethod to avoid the warning generated by
##  KeyDependentOperation
##
InstallOtherMethod(IsPrimitiveMatrixGroup, "for matrix group", true, [IsMatrixGroup], 0,
    function(G)
        return IsPrimitiveMatrixGroup(G, FieldOfMatrixGroup(G));
    end);

############################################################################
##
#M  IsPrimitive(<G>, <F>)
##
##  see IRREDSOL documentation
##
InstallMethod(IsPrimitive, "for matrix group over field",
    IsMatGroupOverFieldFam, [IsMatrixGroup, IsField], 0,
    function(G, F)

        return IsPrimitiveMatrixGroup(G, F);
    end);

############################################################################
##
#M  IsPrimitiveMatrixGroupOp(<G>, <F>)
##
##  see IRREDSOL documentation
##
InstallMethod(IsPrimitiveMatrixGroupOp, "for matrix group over finite field, construct IsomorphismPcGroup",
    IsMatGroupOverFieldFam,
    [IsFFEMatrixGroup and IsSolvableGroup, IsField and IsFinite], 0,

    function(G, F)
        local iso, inv;
        if not IsSubset(F, FieldOfMatrixGroup(G)) then
            Error("G must be a matrix group over F");
        fi;
        iso := IsomorphismPcGroup(G);
        inv := InverseGeneralMapping (iso);
        SetIsBijective (inv, true);
        SetIsGroupHomomorphism (inv, true);
        return SmallBlockDimensionOfRepresentation (ImagesSource (iso), inv, F, DegreeOfMatrixGroup(G)) = DegreeOfMatrixGroup(G);
    end);

############################################################################
##
#M  IsPrimitiveMatrixGroupOp(<G>, <F>)
##
##  see IRREDSOL documentation
##
InstallMethod(IsPrimitiveMatrixGroupOp, "for matrix group over finite field, use RepresentationIsomorphism",
    IsMatGroupOverFieldFam,
    [IsFFEMatrixGroup and HasRepresentationIsomorphism, IsField and IsFinite],
    RankFilter (IsHandledByNiceMonomorphism) + 1, # rank higher than the nice mono. method

    function(G, F)
        if not IsSubset(F, FieldOfMatrixGroup(G)) then
            Error("G must be a matrix group over F");
        fi;
        return SmallBlockDimensionOfRepresentation (
            Source (RepresentationIsomorphism (G)), RepresentationIsomorphism (G), F, DegreeOfMatrixGroup(G)) = DegreeOfMatrixGroup(G);
    end);

############################################################################
##
#M  IsPrimitiveMatrixGroupOp(<G>, <F>)
##
##  see IRREDSOL documentation
##
InstallMethod(IsPrimitiveMatrixGroupOp, "for matrix group over finite field, use nice monomorphism",
    IsMatGroupOverFieldFam,
    [IsFFEMatrixGroup and IsHandledByNiceMonomorphism, IsField and IsFinite],
    0,

    function(G, F)
        local iso, inv;
        if not IsSubset(F, FieldOfMatrixGroup(G)) then
            Error("G must be a matrix group over F");
        fi;
        iso := NiceMonomorphism (G);
        inv := GroupHomomorphismByFunction(NiceObject (G), G,
            h -> PreImagesRepresentative(iso, h),
            g -> ImageElm(iso, g));
        SetIsBijective (inv, true);
        return SmallBlockDimensionOfRepresentation (NiceObject (G), inv, F, DegreeOfMatrixGroup(G)) = DegreeOfMatrixGroup(G);
    end);

############################################################################
##
#M  IsPrimitiveMatrixGroupOp(<G>, <F>)
##
##  see IRREDSOL documentation
##
InstallMethod(IsPrimitiveMatrixGroupOp, "for matrix group over finite field, try if IsPrimitive is set",
    IsMatGroupOverFieldFam,
    [IsFFEMatrixGroup and HasIsPrimitive, IsField and IsFinite],
    RankFilter (IsHandledByNiceMonomorphism) + 3, # rank higher than the nice mono. method

    function(G, F)
        if not IsSubset(F, FieldOfMatrixGroup(G)) then
            Error("G must be a matrix group over F");
        fi;
        if IsPrimitive(G) then
            if FieldOfMatrixGroup(G) = F then
                return true;
            fi;
        else
            return false;
        fi;
        TryNextMethod();
    end);

############################################################################
##
#F  SmallBlockDimensionOfRepresentation(G, hom, F, limit)
##
##  hom must be a homomorphism G -> GL(n, F), where G is a group and F a finite
##  field such that Image(hom, G) is irreducible over F. limit is an integer
##  The function returns an integer k such that Im hom has a block system
##  of block dimension k, where k < limit, or k >= limit and G has no
##  block system of block dimesnion < limit
##
InstallGlobalFunction(SmallBlockDimensionOfRepresentation, function(G, hom, F, limit)

    # computes a block dimension smaller than limit, if it exists,
    # or the smallest block dimension otherwise
    local max, min, dim, M, m, cf, i;

    max := AttributeValueNotSet(MaximalSubgroupClassReps, G);
    min := DegreeOfMatrixGroup(Range (hom));
    for M in max do
        if not IsTrivial(M) then
            m := GModuleByMats (List(GeneratorsOfGroup(M), x -> ImageElm(hom, x)), F);
            if not MTX.IsIrreducible (m) then
                cf := First (MTX.CompositionFactors(m),
                    cf -> MTX.Dimension (cf) * IndexNC(G, M) = DegreeOfMatrixGroup(Range (hom))
                            and Length(MTX.Homomorphisms (cf, m)) > 0);
                if cf <> fail then
                    dim := SmallBlockDimensionOfRepresentation (M,
                        GroupHomomorphismByImagesNC(M, GL(MTX.Dimension (cf), Size(F)),
                        GeneratorsOfGroup(M), MTX.Generators (cf)),
                        F, limit);
                    if dim < min then
                        min := dim;
                        if min < limit then
                            return min;
                        fi;
                    fi;
                fi;
            fi;
        fi;
    od;
    return min;
end);

############################################################################
##
#M  MinimalBlockDimension(<G>)
##
##  see IRREDSOL documentation
##
InstallMethod(MinimalBlockDimension, "for matrix group", true, [IsMatrixGroup], 0,
    function(G)
        return MinimalBlockDimensionOfMatrixGroup(G);
    end);

############################################################################
##
#M  MinimalBlockDimension(<G>, <F>)
##
##  see IRREDSOL documentation
##
InstallMethod(MinimalBlockDimension, "for matrix group and field",
    IsMatGroupOverFieldFam, [IsMatrixGroup, IsField], 0,
    function(G, F)

        if not IsSubset(F, FieldOfMatrixGroup(G)) then
            Error("G must be a matrix group over F");
        fi;
        return MinimalBlockDimensionOfMatrixGroup(G, F);
    end);

############################################################################
##
#M  MinimalBlockDimensionOfMatrixGroup(<G>)
##
##  see IRREDSOL documentation
##
InstallOtherMethod(MinimalBlockDimensionOfMatrixGroup, "for matrix group", true,
    [IsMatrixGroup], 0,
    function(G)
        return MinimalBlockDimensionOfMatrixGroup(G, FieldOfMatrixGroup(G));
    end);

############################################################################
##
#M  MinimalBlockDimensionOfMatrixGroupOp(<G>, <F>)
##
##  see IRREDSOL documentation
##
InstallMethod(MinimalBlockDimensionOfMatrixGroupOp, "for matrix group over finite field",
    IsMatGroupOverFieldFam,
    [IsFFEMatrixGroup and IsSolvableGroup, IsField and IsFinite], 0,

    function(G, F)
        local iso, inv;
        if not IsSubset(F, FieldOfMatrixGroup(G)) then
            Error("G must be a matrix group over F");
        fi;

        if not IsIrreducibleMatrixGroup(G, F) then
            TryNextMethod();
        fi;

        iso := IsomorphismPcGroup(G);
        inv := InverseGeneralMapping (iso);
        SetIsBijective (inv, true);
        SetIsGroupHomomorphism (inv, true);
        return SmallBlockDimensionOfRepresentation (ImagesSource (iso), inv, F, 2);
    end);

############################################################################
##
#M  MinimalBlockDimensionOfMatrixGroupOp(<G>, <F>)
##
##  see IRREDSOL documentation
##
InstallMethod(MinimalBlockDimensionOfMatrixGroupOp,
    "for matrix group over finite field with representation homomorphism",
    IsMatGroupOverFieldFam,
    [IsFFEMatrixGroup and HasRepresentationIsomorphism, IsField and IsFinite],
        RankFilter (IsHandledByNiceMonomorphism) + 1, # rank higher than the nice mono. method

    function(G, F)
        if not IsSubset(F, FieldOfMatrixGroup(G)) then
            Error("G must be a matrix group over F");
        fi;
        if not IsIrreducibleMatrixGroup(G, F) then
            TryNextMethod();
        fi;
        return SmallBlockDimensionOfRepresentation (
            Source (RepresentationIsomorphism (G)), RepresentationIsomorphism (G), F, 2) ;
    end);

############################################################################
##
#M  MinimalBlockDimensionOfMatrixGroupOp(<G>, <F>)
##
##  see IRREDSOL documentation
##
InstallMethod(MinimalBlockDimensionOfMatrixGroupOp, "for matrix group over finite field, use NiceMonomorphism",
    IsMatGroupOverFieldFam,
    [IsFFEMatrixGroup and IsHandledByNiceMonomorphism, IsField and IsFinite],
    0,

    function(G, F)
        local iso, inv;
        if not IsSubset(F, FieldOfMatrixGroup(G)) then
            Error("G must be a matrix group over F");
        fi;
        if not IsIrreducibleMatrixGroup(G, F) then
            TryNextMethod();
        fi;
        iso := NiceMonomorphism (G);
        inv := GroupHomomorphismByFunction(NiceObject (G), G,
            h -> PreImagesRepresentative(iso, h),
            g -> ImageElm(iso, g));
        SetIsBijective (inv, true);
        return SmallBlockDimensionOfRepresentation (NiceObject (G), inv, F, 2);
    end);

############################################################################
##
#M  MinimalBlockDimensionOfMatrixGroupOp(<G>, <F>)
##
##  see IRREDSOL documentation
##
InstallMethod(MinimalBlockDimensionOfMatrixGroupOp,
    "for matrix group over finite field which has MinimalBlockDimension",
    IsMatGroupOverFieldFam,
    [IsFFEMatrixGroup and HasMinimalBlockDimension, IsField and IsFinite],
        RankFilter (IsHandledByNiceMonomorphism) + 1, # rank higher than the nice mono. method

    function(G, F)
        if not IsSubset(F, FieldOfMatrixGroup(G)) then
            Error("G must be a matrix group over F");
        fi;
        if F = FieldOfMatrixGroup(G) then
            return MinimalBlockDimension (G);
        elif MinimalBlockDimension (G) = 1 then
            return 1;
        fi;
        TryNextMethod();
    end);

############################################################################
##
#M  CharacteristicOfField(<G>)
##
##  see IRREDSOL documentation
##
InstallMethod(CharacteristicOfField, "for matrix group", true, [IsMatrixGroup], 0,
    M -> Characteristic (DefaultFieldOfMatrixGroup(M)));

############################################################################
##
#M  Characteristic(<G>)
##
##  see IRREDSOL documentation
##
InstallMethod(Characteristic, "for matrix group", true, [IsMatrixGroup], 0,
    CharacteristicOfField);

############################################################################
##
#M  RepresentationIsomorphism(<G>)
##
##  see IRREDSOL documentation
##
InstallMethod(RepresentationIsomorphism, "for mat group handled by nice mono.", true,
    [IsMatrixGroup and IsHandledByNiceMonomorphism], 0,
    function(G)

        local nice, H;

        nice := NiceMonomorphism (G);
        H := NiceObject(G);

        if IsSolvableGroup(H) then
            nice := IsomorphismPcGroup(G);
            H := Range (nice);
        fi;

        return GroupHomomorphismByFunction(H, G,
            x -> PreImagesRepresentative(nice, x),
            x -> ImageElm(nice, x));
    end);

############################################################################
##
#M  RepresentationIsomorphism(<G>)
##
##  see IRREDSOL documentation
##
InstallMethod(RepresentationIsomorphism, "soluble group: inverse of IsomorphismPcGroup", true,
    [IsMatrixGroup], 0,
    function(G)

        local nice;

        nice := IsomorphismPcGroup(G);
        return GroupHomomorphismByFunction(Range(nice), G,
            x -> PreImagesRepresentative(nice, x),
            x -> ImageElm(nice, x));
    end);

############################################################################
##
#F  ImprimitivitySystemsForRepresentation(G, rep, F, limit)
##
##  G is a group, F a finite field, rep: G -> GL(n, F)
##
##  If G has no block system with block dimension <= limit, the function
##  computes a list of all imprimitivity systems of Im rep as a
##  subgroup of GL(n, F). Otherwise, the function computes systems of imprimitivity,
##  one of which will have block dimension <= limit.
##
##  Each imprimitivity system is represented by a record with the following entries:
##  bases: a list of lists of vectors, each list of vectors being a basis of a block
##            in the imprimitivity system
##  stab1: the stabilizer in G of the first block (i. e., the block with basis bases[1])
##  min:    true if the block system is a minimal block system amongst the systems returned
##
InstallGlobalFunction(ImprimitivitySystemsForRepresentation, function(G, rep, F, limit)

    local systems, max, M, gens, m, c, cf, hom, subsys, sys, newsys, homBasis, homSpace, bas, bas2, newbasis, pos, orb;

    if DegreeOfMatrixGroup(Range (rep))< limit then
        return     [rec(bases := [IdentityMat (DegreeOfMatrixGroup(Range (rep)), F)], stab1 := G, min := true)];
    fi;
    systems := [];
    max := AttributeValueNotSet(MaximalSubgroupClassReps, G);
    for M in max do
        if not IsTrivial(M) then # inducing up from the trivial rep gives a reducible representation
            gens := List(GeneratorsOfGroup(M), x -> ImageElm(rep, x));
            m := GModuleByMats (gens, F);
            if not MTX.IsIrreducible (m) then
                for c in MTX.CollectedFactors(m) do
                    cf := c[1];
                    if MTX.Dimension (cf) * IndexNC(G, M) = Degree (Range (rep)) then
                        homBasis := MTX.Homomorphisms (cf, m);
                        if Length(homBasis) > 0 then # submodule isomorphic with cf

                            # get imprimitivity systems for cf

                            hom := GroupHomomorphismByImagesNC(M, GL(MTX.Dimension (cf), Size(F)),
                                GeneratorsOfGroup(M), MTX.Generators (cf));
                            subsys := ImprimitivitySystemsForRepresentation (M, hom, F, limit);
                            Add(subsys, rec(bases := [IdentityMat (MTX.Dimension (cf), F)], stab1 := M,
                                min := Length(subsys) = 0));

                            # translate result back

                            homSpace := VectorSpace(F, homBasis{[2..Length(homBasis)]}, 0*homBasis[1], "basis");
                            for bas2 in Enumerator(homSpace) do
                                bas := homBasis[1] + bas2;
                                  for sys in subsys do
                                    newbasis := List(sys.bases[1]*bas, ShallowCopy);
                                    TriangulizeMat (newbasis);
                                    if ForAll (systems, sys -> not newbasis in sys.bases) then
                                        orb := Orbit (ImagesSet(rep, G), newbasis, OnSubspacesByCanonicalBasis);
                                        Assert(1, Length(orb) * Length(newbasis) = Degree (Range (rep)));
                                        Assert(1, Length(orb) = IndexNC(G, sys.stab1));
                                        if orb[1] <> newbasis then
                                            pos := Position (orb, newbasis);
                                            orb{[1, pos]} := orb{[pos, 1]};
                                        fi;
                                        Add(systems, rec(bases := orb, stab1 := sys.stab1, min := sys.min));
                                    fi;
                                od;
                            od;
                        fi;
                    fi;
                od;
            fi;
        fi;
    od;

    # add trivial system

    Add(systems, rec(bases := [IdentityMat (Degree (Range (rep)), F)], stab1 := G, min := Length(systems) = 0));
    return systems;
end);

############################################################################
##
#A  ImprimitivitySystemsOp(<G>, <F>)
##
##  see IRREDSOL documentation
##
InstallMethod(ImprimitivitySystemsOp, "for matrix group handled by nice mono. and finite field",
    IsMatGroupOverFieldFam,
    [IsFFEMatrixGroup and IsHandledByNiceMonomorphism, IsField and IsFinite], 0,
    function(G, F)
        local rep;
        rep := RepresentationIsomorphism (G);
        return ImprimitivitySystemsForRepresentation (Source (rep), rep, F, 0);
    end);

############################################################################
##
#M  ImprimitivitySystemsOp(<G>, <F>)
##
##  see IRREDSOL documentation
##
InstallMethod(ImprimitivitySystemsOp, "for matrix group handled by nice mono. and finite field",
    IsMatGroupOverFieldFam,
    [IsFFEMatrixGroup and IsHandledByNiceMonomorphism, IsField and IsFinite], 0,
    function(G, F)
        local rep;
        rep := RepresentationIsomorphism (G);
        return ImprimitivitySystemsForRepresentation (Source (rep), rep, F, 0);
    end);

############################################################################
##
#M  ImprimitivitySystems(<G>)
##
##  see IRREDSOL documentation
##
InstallOtherMethod(ImprimitivitySystems, "for matrix group: use FieldOfMatrixGroup", true,
    [IsFFEMatrixGroup], 0,
    function(G)
        return ImprimitivitySystems (G, FieldOfMatrixGroup(G));
    end);

############################################################################
##
#M  MinimalBlockDimensionOfMatrixGroupOp(<G>, <F>)
##
##  see IRREDSOL documentation
##
InstallMethod(MinimalBlockDimensionOfMatrixGroupOp, "for matrix group having imprimitivity systems",
    IsMatGroupOverFieldFam,
    [IsFFEMatrixGroup and HasComputedImprimitivitySystemss, IsField],
    0,
    function(G, F)

        local known, i, sys, d, l;

        known := ComputedImprimitivitySystemss (G);
        for i in [1,3..Length(known)-1] do
            if known[i] = F then
                d := DegreeOfMatrixGroup(G);
                for sys in known[i+1] do
                    l := Length(sys.bases[1]);
                    if l < d then
                        d := l;
                    fi;
                od;
                return d;
            fi;
        od;
        TryNextMethod();
    end);

############################################################################
##
#M  TraceField(<G>)
##
##  see IRREDSOL documentation
##
InstallMethod(TraceField, "for irreducible matrix group over finite field", true,
    [IsFFEMatrixGroup and IsFinite], 1,

    function(G)

    local ext, gens, q, q0, module, module2, gens2, c, i, p;

    q := Size(FieldOfMatrixGroup(G));
    Info(InfoIrredsol, 3, "TraceField: matrix group is over GF(",q,")");

    if IsTrivial(G) then
        Info(InfoIrredsol, 4, "TraceField: trivial group case");
        return FieldOfMatrixGroup(G);
    fi;

    # guess a field contained in the smallest field over which module can be realised

    q0 := Size( Field (List([1..LogInt(Size(G), 2) + 10], i -> TraceMat(PseudoRandom(G)))));

    if q = q0 then
        Info(InfoIrredsol, 3, "TraceField: trace field is GF(", q0, ")");
        return FieldOfMatrixGroup(G);
    fi;

    Info(InfoIrredsol, 3, "TraceField: trace field contains GF(",q0, ")");

    module := GModuleByMats (GeneratorsOfGroup(G), FieldOfMatrixGroup(G));

    if not MTX.IsIrreducible (module) then
        Info(InfoIrredsol, 3, "TraceField: trace field contains GF(",q0, ")");
        TryNextMethod();
    fi;

    for c in Collected (Factors(LogInt(q, q0))) do
        p := c[1];
        for i in [1..c[2]] do

            Info(InfoIrredsol, 1, "TraceField: trying if trace field is GF(",q0, ")");
            # compute Galois conjugate of module
            gens2 := List(MTX.Generators (module), g -> List(g, row -> List(row, a -> a^q0)));
            module2 := GModuleByMats (gens2, MTX.Field (module));

            # If module1 and module2 are conjugate, their traces are the same, and thus
            # invariant under the Galois automorphism. Therefore the traces must belong to GF(q0).
            # Thus by a theorem of Brauer, module1 (and module2) can be written over GF(q0).
            # Conversely, if module1^x is over GF(q0) for some matrix x,
            # then module1^x = (module1^x)^q0 = (module1^q0)^(x^q0) = module2^(x^q0)
            # which shows that module1 and module2 are conjugate.

            # see also S. P. Glasby, R. B. Howlett, Writing representations over mnimal fields,
            # Comm. Alg. 25 (1997), 1703--1711

             if MTX.Isomorphism (module, module2) <> fail then
                Info(InfoIrredsol, 1, "TraceField: trace field is GF(",q0, ")");
                return GF(q0);
            fi;

            q0 := q0^p; # size of minimal superfield of GF(q0)
        od;
    od;

    Info(InfoIrredsol, 1, "TraceField: not rewritable over subfield: trace field is GF(",q0, ")");

    return GF(q0);
end);

############################################################################
##
#M  TraceField(<G>)
##
InstallMethod(TraceField, "generic method for finite matrix groups via conjugacy classes", true,
    [IsMatrixGroup and IsFinite], 0,
    function(G)

        local F, rep;

        F := FieldOfMatrixGroup(G);
        if IsPrimeField (F) then
            return F;
        elif F = Field (List(GeneratorsOfGroup(G), TraceMat)) then
            return F;
        else
            rep := RepresentationIsomorphism (G);
            return Field (List(ConjugacyClasses (Source (rep)), cl -> TraceMat(ImageElm(rep, Representative(cl)))));
        fi;
    end);

RedispatchOnCondition (TraceField, true, [IsMatrixGroup], [IsFinite], 0);

############################################################################
##
#M  SplittingField(<G>)
##
InstallMethod(SplittingField, "use MeatAxe", true,
    [IsFFEMatrixGroup], 0,
    function(G)

        local F, module;

        F := FieldOfMatrixGroup(G);
        module := GModuleByMats (GeneratorsOfGroup(G), F);
        if MTX.IsIrreducible (module) then
            return GF(Characteristic (F)^MTX.DegreeSplittingField (module));
        else
            Error("G must be irreducible over FieldOfMatrixGroup(G)");
        fi;
    end);

############################################################################
##
#M  ConjugatingMatTraceField(<G>)
##
##  returns a matrix x such that the matrix entries of G^x lie in the
##  trace field of G.
##
##  The absolutely irreducible case is an impelemntation of an algorithm by
##  S. P. Glasby, R. B. Howlett, Writing representations over mnimal fields,
##  Comm. Alg. 25 (1997), 1703--1711
##
InstallMethod(ConjugatingMatTraceField, "for irreducible FFE matrix group",
    true,
    [IsFFEMatrixGroup], 0,

    function(G)

        local ext, q, q1, t, C, CC, D, Y, A, i, j, mu, nu,
            basis, moduleG, module, module2, module3, absirred;

        if Length(GeneratorsOfGroup(G)) = 0 or TraceField(G) = FieldOfMatrixGroup(G) then
            return One(G);
        fi;

        q := Size(TraceField (G));

        moduleG := GModuleByMats (GeneratorsOfGroup(G), FieldOfMatrixGroup(G));

        # reduce to the absolutely irreducible case

        if not MTX.IsIrreducible (moduleG) then
            TryNextMethod();
        fi;

        absirred := MTX.IsAbsolutelyIrreducible (moduleG);
        if absirred then
            module := moduleG;
            ext := FieldOfMatrixGroup(G);
        else
            ext := GF(CharacteristicOfField (G)^MTX.DegreeSplittingField (moduleG));
            module := GModuleByMats (GeneratorsOfGroup(G), ext);
            repeat
                basis := MTX.ProperSubmoduleBasis (module);
                module := MTX.InducedActionSubmodule (module, basis);
            until MTX.IsIrreducible (module);
            Assert(1, MTX.IsAbsolutelyIrreducible (module));
        fi;

        # moduleG can be rewritten over TraceField(G) but over no proper subfield
        # let GF(q1) be the trace field of module, then over GF(q1),
        # moduleG has block diagonal matrices which are conjugate via
        # a Galois automorphism of GF(q1) of order Deg(G)/Dim(module)
        # so GF(q1) has dimension Dim(moduleG)/Dim(module) over TraceField(G).

        # Thus, taking q1-th powers is a generator of Gal (MTX.Field(module)/GF(q1))

        q1 := q^(MTX.Dimension (moduleG)/MTX.Dimension(module));
        t := LogInt(Size(ext), q1);

        module2 := GModuleByMats (List(MTX.Generators (module),
            A -> List(A, row -> List(row, x -> x^q1))), ext);

        C := MTX.Isomorphism (module, module2);

        if C = fail then
            Error("panic: cannot rewrite matrix group over trace field!");
        fi;

        CC := C;
        D := C;
        for i in [1..t-1] do
            CC := List(CC, row -> List(row, x -> x^q1));
            D := D*CC;
        od;

        mu := D[1][1];

        repeat
            nu := Random(ext);
        until Norm(ext, GF(q1), nu) = mu;

        C := nu^-1 * C;

        repeat
            Y := RandomMat(MTX.Dimension(module), MTX.Dimension(module), ext);
            A := Y;
            for i in [2..t] do
                A := Y + C * List(A, row -> List(row, x -> x^q1));
            od;
        until Length(NullspaceMat(A)) = 0;

        Assert(1, ForAll(MTX.Generators(module), g -> IsSubset(GF(q1), Field(Flat(g^A)))));

        # now we have a solution for the absolutely irreducible case

        if absirred then
            MakeImmutable(A);
            ConvertToMatrixRep(A, ext);
            return A;
        fi;

        basis := CanonicalBasis(AsVectorSpace(GF(q), GF(q1)));

        module3 := GModuleByMats(List(MTX.Generators(module), x -> BlownUpMat(basis, x^A)), MTX.Field(moduleG));

        A := Immutable(MTX.Isomorphism(moduleG, module3));

        if A = fail then
            Error("could not find conjugating matrix");
        fi;
        Assert(1, ForAll(GeneratorsOfGroup(G), g -> IsSubset(GF(q), Field(Flat(g^A)))));
        ConvertToMatrixRep(A, FieldOfMatrixGroup(G));

        return A;

    end);

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


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

fId.canTensorSplit := (self, div) >> self.domain() mod div = 0;
fId.tensorSplit    := (self, div) >> [fId(div), fId(self.size/div)];
fBase.canTensorSplit := (self, div) >> self.range() mod div = 0;
fBase.tensorSplit := (self, div) >> [ fBase(div,        idiv(self.params[2], self.range()/div)),
                                      fBase(self.range()/div, imod(self.params[2], self.range()/div)) ];

CanTensorSplit := (what, div) -> When(not IsRec(what) or not IsBound(what.canTensorSplit), false,
                                      what.canTensorSplit(div));

TensorSplit    := (what, div) -> what.tensorSplit(div);

try_split := function(i, flist, fdim, N)
    local ffrun, next, len, split;
    len := Length(flist);
    ffrun := fdim(flist[i]);
    while i < len and ffrun < N do
        next := flist[i+1];
	if ffrun * fdim(next) > N then
            if N mod ffrun <> 0 or not CanTensorSplit(next, N/ffrun) then
		return false;
        #Error("can't merge incompatible tensor chains (could not split)",
         #     "N=", N, " ffrun=", ffrun, " next=", next);
            else
		split := TensorSplit(next, N/ffrun);
		flist := Concat(flist{[1..i]}, split, flist{[i+2..len]});
		ffrun := ffrun * N/ffrun; # = N
            fi;
	else
            ffrun := ffrun * fdim(next);
	fi;
	i := i+1;
    od;
    #Print([i, flist], "\n");
    return [i, flist];
end;

full_merge_tensor_chains := function(target, ff, gg, compose, ftensor, gtensor, fid, gid, fdom, gran)
   local i, j, nf, ng, res, ffrun, ggrun, ibegin, jbegin, split;
   nf := Length(ff);    ng := Length(gg);
   res := []; i:=1; j:=1;

   while i <= nf or j <= ng do
       # handle domain=1 or range=1, which are always mergeable
       if (i<=nf and fdom(ff[i])=1) or (j<=ng and gran(gg[j])=1) then
	   if i<=nf and fdom(ff[i]) = 1 then
               Add(res, fid(ff[i]));
               i := i + 1;
	   fi;
	   if j<=ng and gran(gg[j]) = 1 then
               Add(res, gid(gg[j]));
               j := j + 1;
	   fi;

       # try to combine terms to get a match
       elif (i <= nf and j <= ng) then
	   if AnySyms(fdom(ff[i]), gran(gg[j])) then
               return false;
           elif fdom(ff[i]) = gran(gg[j]) then
               Add(res, compose(ff[i], gg[j]));
	   else
               ibegin := i;
               jbegin := j;
               if fdom(ff[i]) < gran(gg[j]) then
		   if CanTensorSplit(gg[j], fdom(ff[i])) then
		       split := TensorSplit(gg[j], fdom(ff[i]));
		       gg := Concat(gg{[1..j-1]}, split, gg{[j+1..ng]});
		       ng := ng + 1;
		   else
		       split := try_split(i, ff, fdom, gran(gg[j]));
		       if split=false then return false; fi;
		       i := split[1];
		       ff := split[2]; nf := Length(ff);
		   fi;
               else
		   if CanTensorSplit(ff[i], gran(gg[j])) then
		       split := TensorSplit(ff[i], gran(gg[j]));
		       if split=false then return false; fi;
		       ff := Concat(ff{[1..i-1]}, split, ff{[i+1..nf]});
		       nf := nf + 1;
		   else
		       split := try_split(j, gg, gran, fdom(ff[i]));
		       if split=false then return false; fi;
		       j := split[1];
		       gg := split[2]; ng := Length(gg);
		   fi;
               fi;
               Add(res, compose(ftensor(ff{[ibegin..i]}), gtensor(gg{[jbegin..j]})));
	   fi;
	   i := i+1;
	   j := j+1;
       else
	   return false;
       fi;
   od;
   target.val := res;
   return res;
end;

# *******************************************************************
# make sure ff[i] is not a diag function, where merging chains doesn't make sense (does it?)
fully_compat_tensor_chains := (ff,gg,fdom,gran) ->
    Length(ff) = Length(gg) and
    ForAll([1..Length(ff)], i -> ff[i].range()<>false and
                             fdom(ff[i])=gran(gg[i]));

merge_fc_tensor_chains := (ff,gg,combine) ->
   List([1..Length(ff)], i -> combine(ff[i], gg[i]));

# this assumes compat_domain_range compatibility
compat_tensor_chains := (f,g,fdom,gran) -> let(
    ff := Filtered(f, c->let(d:=fdom(c), IsSymbolic(d) or d > 1)),
    gg := Filtered(g, c->let(r:=gran(c), IsSymbolic(r) or r > 1)),
    fully_compat_tensor_chains(ff, gg, fdom, gran));

# this assumes compat_domain_range compatibility
merge_tensor_chains := function(ff, gg, compose, fidentity, gidentity, fdom, gran)
   local i, j, nf, ng, res;
   nf := Length(ff);    ng := Length(gg);
   res := []; i:=1; j:=1;

   while i <= nf or j <= ng do
       if (i <= nf and j <= ng) and fdom(ff[i]) = gran(gg[j]) then
       Add(res, compose(ff[i], gg[j]));
       i := i+1;
       j := j+1;
       else
       if i<=nf and fdom(ff[i]) = 1 then
           Add(res, fidentity(ff[i]));
           i := i + 1;
       elif j<=ng and gran(gg[j]) = 1 then
           Add(res, gidentity(gg[j]));
           j := j + 1;
       else Error("can't merge incompatible tensor chains");
       fi;
       fi;
   od;
   return res;
end;


accu := function(n)
  local f, v;
  v := n;
  f := function(a)
    v := v + a;
    return v;
  end;
  return f;
end;

a := accu(0);
# function( a ) ... end
b := accu(100);
# function( a ) ... end
a(6);
# 6
b(6);
# 106
a(1);
# 7
b(1);
# 107
# These functions also accept other types, as long as addition is meaningful
b(1/FLOAT_INT(3))
# 107.333
a(2/3);
# 23/3
a([1, 2, 3]);
# [ 26/3, 29/3, 32/3 ]


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

Declare(Compose);
Declare(ComposeDists);
Declare(ComposeStreams);

ccFunc := function(list)
      local i, l;
      l := [];
      for i in list do
          Cond(IsBound(i.createCode), Append(l, [i.createCode()]), Append(l, [i]));
      od;
      return Flat(l);
end;

# ==========================================================================
# Compose
# ==========================================================================
Class(Compose, BaseOperation, rec(
    # flatten by associativity
    abbrevs := [ arg ->
    [ Flat(List(Flat(arg),
            s -> When(IsSPL(s) and ObjId(s)=Compose, s.children(), s))) ]
    ],

    withTags := (self, tags) >> ApplyFunc(
	ObjId(self),
	List(self.children(), x -> x.withTags(tags))).takeAobj(self),

    checkDims := children -> let(chdims := List(children, c->c.dims()),
        DoForAll([1..Length(chdims)-1], i ->
            DoForAll(Zip2(chdims[i][2],chdims[i+1][1]), x->
        When( not(IsSymbolic(x[1]) or IsSymbolic(x[2])) and (x[1] <> x[2]),
            Error("Dimensions of children ",i," and ",i+1," do not match (",x[1]," <> ",x[2],") in ", children), 0)))),

    new := meth(self, L)
        local dim;
        Constraint(IsList(L) and L<>[]);
        #ForAll(L, x -> Constraint(IsSPL(x)));
        if Length(L) = 1 then return L[1]; fi;

        dim := Rows(L[1]);
        self.checkDims(L);
        L := Filtered(L, x -> not IsIdentityObj(x));
        if L = [] then   # all factors are identities
            return I(dim);
        elif Length(L) = 1 then
            return L[1];
        else
            return SPL(WithBases(self, rec(
                         _children := L,
                         dimensions := [L[1].dims()[1], L[Length(L)].dims()[2]])));
        fi;
    end,

     rng:= self>>let(c := self._children, c[1].rng()),
     dmn:= self>>let(c := self._children, Last(c).dmn()),
    #-----------------------------------------------------------------------
 #   dims := self >> let(c := self._children, [Rows(c[1]), Cols(Last(c))]),
     advdims := self >> [self._children[1].advdims()[1], Last(self._children).advdims()[2]],
    #-----------------------------------------------------------------------
    isPermutation := self >> ForAll(self._children, IsPermutationSPL),
    #-----------------------------------------------------------------------
    toAMat := self >> Product(List(self._children, AMatSPL)),
    #-----------------------------------------------------------------------
    transpose := self >>
        CopyFields(self, rec(
        _children := Reversed(List(self._children, x -> x.transpose())),
        dimensions := Reversed(self.dimensions))),
    conjTranspose := self >>
        CopyFields(self, rec(
        _children := Reversed(List(self._children, x -> x.conjTranspose())),
        dimensions := Reversed(self.dimensions))),
    inverse := self >>
        CopyFields(self, rec(
        _children := Reversed(List(self._children, x -> x.inverse())),
        dimensions := Reversed(self.dimensions))),
    #-----------------------------------------------------------------------
    printSeparationChar := " * ",
    print := meth(self, indent, indentStep)
        local s, newline;

    s := self.children();
    if Length(s) = 2 and ((IsBound(s[1]._sym) and IsBound(s[2]._mat))
                       or (IsBound(s[2]._sym) and IsBound(s[1]._mat)))
       or ForAll(s, x->IsBound(x._sym))
        then newline := Ignore;
    else newline := self._newline; fi;

        DoForAllButLast(s, c->Chain(SPLOps.Print(c, indent, indentStep),
                                Print(self.printSeparationChar),
                    newline(indent)));

    Last(s).print(indent, indentStep);

    end,
    #-----------------------------------------------------------------------
    arithmeticCost := (self, costMul, costAddMul) >>
        Sum(List(self.children(), x -> x.arithmeticCost(costMul, costAddMul))),

    createCode := self >> let (l := self._children, l2 := ccFunc(List(l)),
          Compose(l2)),

    normalizedArithCost := self >> Sum(List(self.children(), i->i.normalizedArithCost())),
    latexSymbol := "\\cdot"

 ));

Class(ComposeDists, Compose, rec(
    printSeparationChar := " |*| ",
    leftMostParScat := self >> self._children[1].leftMostParScat(),
    rightMostParGath := self >> self._children[Length(self._children)].rightMostParGath(),
));

Class(ComposeStreams, Compose, rec(
    printSeparationChar := " -*- ",
    leftMostParScat := self >> self._children[1].leftMostParScat(),
    rightMostParGath := self >> self._children[Length(self._children)].rightMostParGath(),
));


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

Declare(DirectSum);
# ==========================================================================
# DirectSum
# ==========================================================================
Class(DirectSum, BaseOperation, rec(
    _spl_name := "direct_sum",

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

    new := meth(self, L)
        #ForAll(L, x -> Constraint(IsSPL(x)));
    if ForAll(L, IsIdentitySPL)
        then return I(Sum(L, Rows));
    else
        return SPL(WithBases( self,
        rec( _children := L,
        dimensions := [ Sum(L, t -> t.dimensions[1]),
                        Sum(L, t -> t.dimensions[2]) ] )));
    fi;
    end,
    #-----------------------------------------------------------------------
    dims := self >> [ Sum(self._children, t -> t.dimensions[1]),
                  Sum(self._children, t -> t.dimensions[2]) ],
    area := self >> Sum(self._children, t -> t.area()),
    #-----------------------------------------------------------------------
    isPermutation := self >> ForAll(self._children, IsPermutationSPL),
    #-----------------------------------------------------------------------
    toAMat := self >> DirectSumAMat(List(self._children, AMatSPL)),
    #-----------------------------------------------------------------------
    transpose := self >> CopyFields(self, rec(
        _children := List(self._children, x->x.transpose()),
        dimensions := Reversed(self.dimensions))),
    conjTranspose := self >> CopyFields(self, rec(
        _children := List(self._children, x->x.conjTranspose()),
        dimensions := Reversed(self.dimensions))),
    inverse := self >> CopyFields(self, rec(
        _children := List(self._children, x->x.inverse()),
        dimensions := Reversed(self.dimensions))),
    #-----------------------------------------------------------------------
    arithmeticCost := (self, costMul, costAddMul) >>
        Sum(List(self.children(), x -> x.arithmeticCost(costMul, costAddMul)))
));

Class(DelayedDirectSum, DirectSum, rec(sums := self >> self));