GAP 4.8.9 installation with standard packages -- copy to your CoCalc project to get it
##########################################################################
#0
#F CrystGcomplex
## Input: A set F of crystallographic matrices, a G-full basis B and
## check=1 (check is for future use of implementation of Bredon
## homology)
##
## Output: G-equivalent CW-space for group G generated by F.
##
##
InstallGlobalFunction(CrystGcomplex,
function(gens,basis,check)
local i,x,k,combin,n,j,r,m,vect,c,
B,G,T,S,Bt,Action,Sign,FinalBoundary,BoundaryList,
L,kcells,cells,w,StabGrp,ActionRecord,lnth,PseudoRotSubGroup,
RotSubGroupList,
Dimension,SearchOrbit,pos,StabilizerOfPoint,PseudoBoundary,
RotSubGroup,
Elts,Boundary,Stabilizer,DVF,DVFRec,Homotopy,rmult,FinalHomotopy;
B:=basis[1];
c:=basis[2];
vect:=c-Sum(B)/2;
vect:=0*vect;
G:=AffineCrystGroup(gens);
T:=TranslationSubGroup(G);
Bt:=T!.TranslationBasis;
S:=RightTransversal(G,T);
n:=DimensionOfMatrixGroup(G)-1;
Elts:=[One(G)];
Append(Elts,gens);
lnth:=1000;
if check=1 then # B is the G-full basis
L:=[];
for k in [0..n] do
L[k+1]:=[];
### list all centers of k-cells
kcells:=[];
combin:=Combinations([1..n],k);
for x in combin do
w:=[];
for i in [1..n] do
if i in x then
Add(w,[1/2]);
else Add(w,[0,1]);
fi;
od;
cells:=Cartesian(w);
Append(kcells,cells*B+vect);
od;
### search for k-orbits
Add(L[k+1],kcells[1]);
for i in [2..Length(kcells)] do
r:=0;
for j in [1..Length(L[k+1])] do
if IsList(IsCrystSameOrbit(G,Bt,S,
kcells[i],L[k+1][j])) then
break;
fi;
r:=r+1;
od;
if r=Length(L[k+1]) then Add(L[k+1],kcells[i]);fi;
od;
od;
# Cubical subdividing the fundamental region:
# slice the fundamental cell into 2^n parts to get a
# proper action of G on R^n
elif check=0 then
Apply(B,x->x/2);
L:=[];
for k in [0..n] do
L[k+1]:=[];
### list all centers of k-cells
kcells:=[];
combin:=Combinations([1..n],k);
for x in combin do
w:=[];
for i in [1..n] do
if i in x then
Add(w,[1/2,3/2]);
else Add(w,[0,1,2]);
fi;
od;
cells:=Cartesian(w);
Append(kcells,cells*B+vect);
od;
### search for k-orbits
Add(L[k+1],kcells[1]);
for i in [2..Length(kcells)] do
r:=0;
for j in [1..Length(L[k+1])] do
if IsList(IsCrystSameOrbit(G,Bt,S,
kcells[i],L[k+1][j])) then
break;
fi;
r:=r+1;
od;
if r=Length(L[k+1]) then Add(L[k+1],kcells[i]);fi;
od;
od;
else
Print("check is either 1 for B is G-full basis and 0 for proper action", "\n");
return fail;
fi;
###################################################################
#1
#F Dimension
##
## Input: An integer k
## Output: ZG-rank of C_k(X)
##
Dimension:=function(k)
if k>n then
return 0;
fi;
return Length(L[k+1]);
end;
###################################################################
###################################################################
#1
#F pos
##
## Input: A matrix g
## Output: If g in Elts then return the position of g, otherwise
## add g to Elts and return the position.
##
pos:=function(g)
local p;
p:=Position(Elts,g);
if p=fail then
Add(Elts,g);
return Length(Elts);
else
return p;
fi;
end;
###################################################################
###################################################################
#1
#F SearchOrbit
##
## Input: A matrix g
## Output: If g in Elts then return the position of g, otherwise
## add g to Elts and return the position.
##
SearchOrbit:=function(g,k)
local i,p,h;
for i in [1..Length(L[k+1])] do
p:=IsCrystSameOrbit(G,Bt,S,L[k+1][i],g);
if IsList(p) then
h:=pos(p);
return [i,h];
fi;
od;
end;
###################################################################
# Create a record for the Action
ActionRecord:=[];
for m in [1..lnth+1] do
ActionRecord[m]:=[];
for k in [1..Dimension(m-1)] do
ActionRecord[m][k]:=[];
od;
od;
###################################################################
#1
#F rmult
##
## Input: A list L, degree k, position g of an element
## Output: Product of g and L by the action on right.
##
rmult:=function(L,k,g)
local x,w,t,h,y,vv;
vv:=[];
for x in [1..Length(L)] do
w:=Elts[L[x][2]]*Elts[g];
L[x][1]:=Sign(k,L[x][1],pos(w))*L[x][1];
w:=CanonicalRightCosetElement(StabGrp[k+1]
[AbsInt(L[x][1])],w);
t:=pos(w);
Add(vv,[Sign(k,L[x][1],t)*L[x][1],t]);
od;
return vv;
end;
###################################################################
###################################################################
#1
#F Action
##
## Input: Degree m, position k of a generator and position g of
## an element.
## Output: 1 or -1.
##
Action:=function(m,k,g)
local id,r,u,H,abk,ans,x,h,l,i;
abk:=AbsInt(k);
if not IsBound(ActionRecord[m+1][abk][g]) then
H:=StabGrp[m+1][abk];
if Order(H)=infinity then
# We are assuming that any infinite stabilizer
# group acts trivially.
ActionRecord[m+1][abk][g]:=1;
else
id:=CanonicalRightCosetElement(H,Identity(H));
r:=CanonicalRightCosetElement(H,Elts[g]^-1);
r:=id^-1*r;
u:=r*Elts[g];
if u in RotSubGroupList[m+1][abk] then
ans:= 1;
else
ans:= -1;
fi;
ActionRecord[m+1][abk][g]:=ans;
fi;
fi;
return ActionRecord[m+1][abk][g];
end;
###################################################################
###################################################################
#1
#F Action
##
## Input: Degree m, position k of a generator and position g of
## an element.
## Output: 1 or -1.
##
PseudoBoundary:=function(k,s)
local f,x,bdry,i,Fnt,Bck,j,ss;
ss:=AbsInt(s);
f:=L[k+1][ss];
if k=0 then return [];fi;
#x:=f*B^-1;
x:=(f-vect)*B^-1;
bdry:=[];
j:=0;
for i in [1..n] do
Fnt:=StructuralCopy(x);
Bck:=StructuralCopy(x);
if not IsInt(x[i]) then
j:=j+1;
Fnt[i]:=Fnt[i]-1/2;
Bck[i]:=Bck[i]+1/2;
#Fnt:=Fnt*B;
#Bck:=Bck*B;
Fnt:=Fnt*B+vect;
Bck:=Bck*B+vect;
Append(bdry,[SearchOrbit(Fnt,k-1),SearchOrbit(Bck,k-1)]);
#Append(bdry,[SearchOrbit(Fnt,k-1),SearchOrbit(Bck,k-1)]);
fi;
od;
return bdry;
end;
###################################################################
###################################################################
#1
#F Sign
##
## Input: Degree m, position k of a generator and position g of
## an element.
## Output: 1 or -1.
##
Sign:=function(m,k,g)
local x,h,p,r,c,i,y,f,s,kk,e,B1,B2,w;
kk:=AbsInt(k);
if m=0 then return 1;fi;
h:=Elts[g];
p:=CrystFinitePartOfMatrix(h);
e:=L[m+1][kk];
#x:=e*B^-1;
x:=e*B^-1;
r:=[];
for i in [1..Length(x)] do
if not IsInt(x[i]) then
Add(r,i);
fi;
od;
B1:=B{r};
B1:=B1*p;
e:=Flat(e);
Add(e,1);
f:=e*h;
Remove(f);
y:=f*B^-1;
c:=[];
for i in [1..Length(y)] do
if not IsInt(y[i]) then
Add(c,i);
fi;
od;
B2:=B{c};
s:=[];
for i in [1..Length(B2)] do
Add(s,SolutionMat(B1,B2[i]));
od;
#Print(s);
return SignRat(Determinant(s));
end;
###################################################################
###################################################################
#1
#F Boundary
##
## Input: degree k and position s of a generator.
##
## Output: the boundary d(k,s).
##
Boundary:=function(k,s)
local psbdry,j,w,bdry;
psbdry:=PseudoBoundary(k,s);
bdry:=[];
for j in [1..Length(psbdry)] do
w:=psbdry[j];
if (j mod 4 = 3) or (j mod 4 = 2) then
#if IsEvenInt(j) then
Add(bdry,Negate([Sign(k-1,w[1],w[2])*w[1],w[2]]));
else
Add(bdry,[Sign(k-1,w[1],w[2])*w[1],w[2]]);
fi;
od;
if s<0 then
return NegateWord(bdry);
else
return bdry;
fi;
end;
###################################################################
# Create a list of boundary
BoundaryList:=[];
for i in [1..n] do
BoundaryList[i]:=[];
for j in [1..Dimension(i)] do
BoundaryList[i][j]:=Boundary(i,j);
od;
od;
###################################################################
###################################################################
#1
#F FinalBoundary
##
## Input: degree n and position k of a generator.
##
## Output: the boundary d(k,s).
##
FinalBoundary:=function(n,k)
if k>0 then
return BoundaryList[n][k];
else
return NegateWord(BoundaryList[n][AbsInt(k)]);
fi;
end;
###################################################################
###################################################################
#1
#F StabilizerOfPoint
##
## Input: a point g in R^n.
##
## Output: The stabilizer subgroup of g.
##
StabilizerOfPoint:=function(g)
local H,stbgens,i,h,p;
g:=Flat(g);
Add(g,1);
stbgens:=[];
for i in [1..Length(S)] do
h:=g*S[i]-g;
Remove(h);
p:=h*Bt^-1;
if IsIntList(p) then Add(stbgens,S[i]*
VectorToCrystMatrix(h)^-1);fi;
od;
H:=Group(stbgens);
return H;
end;
###################################################################
###################################################################
# Create a empty list for containing the stabilizer subgroup
StabGrp:=[];
for i in [1..(n+1)] do
StabGrp[i]:=[];
for j in [1..Length(L[i])] do
StabGrp[i][j]:=StabilizerOfPoint(L[i][j]);
od;
od;
###################################################################
###################################################################
#1
#F Stabilizer
##
## Input: degree m and position k of a generator (the k-th m-cell).
##
## Output: The stabilizer subgroup for the above cell.
##
Stabilizer:=function(m,k)
local kk;
kk:=AbsInt(k);
return StabGrp[m+1][k];
end;
###################################################################
###################################################################
#1
#F PseudoRotSubGroup
##
## Input: degree m and position k of a generator (the k-th m-cell).
##
## Output: The rotation subgroup of the above cell.
##
PseudoRotSubGroup:=function(m,k)
local x,kk,l,h,i,w,r,y,H,id,eltsH,g,RotSbGrp;
kk:=AbsInt(k);
RotSbGrp:=[];
H:=StabGrp[m+1][k];
eltsH:=Elements(H);
for g in eltsH do
if Sign(m,k,pos(g))=1 then
Add(RotSbGrp,g);
fi;
od;
RotSubGroupList[m+1][kk]:=Group(RotSbGrp);
return Group(RotSbGrp);
end;
###################################################################
###################################################################
# Create an empty list for containing the rotation subgroups
RotSubGroupList:=[];
for i in [1..(n+1)] do
RotSubGroupList[i]:=[];
for j in [1..Length(L[i])] do
RotSubGroupList[i][j]:=PseudoRotSubGroup(i-1,j);
od;
od;
###################################################################
###################################################################
#1
#F RotSubGroup
##
## Input: degree m and position k of a generator (the k-th m-cell).
##
## Output: The rotation subgroup of the above cell.
##
RotSubGroup:=function(m,k)
local kk;
kk:=AbsInt(k);
return RotSubGroupList[m+1][kk];
end;
###################################################################
###################################################################
# Create a record for discrete vector field
DVFRec:=[];
for k in [1..n+1] do
DVFRec[k]:=[];
for i in [1..Length(L[k])] do
DVFRec[k][i]:=[];
od;
od;
###################################################################
if check=1 then
###################################################################
#1
#F DVF
##
## input an n-cell acts like the starting point of an arrow
## the function returns n+1-cell acts like the end
## point of the above arrow
## those cells presented by its center.
##
## Input: an n-cell.
##
## Output: n+1-cell.
##
DVF:=function(k,w)
local
f,x,g,i,y,ww,s,b,j;
ww:=[AbsInt(w[1]),w[2]];
if not IsBound(DVFRec[k+1][ww[1]][ww[2]]) then
x:=StructuralCopy(L[k+1][ww[1]]);
Add(x,1);
x:=x*Elts[ww[2]];
Remove(x);
f:=(x-vect)*B^-1;
for i in [1..n] do
if not f[i]=0 then
if not IsInt(f[i]) then
DVFRec[k+1][ww[1]][ww[2]]:=[];
return DVFRec[k+1][ww[1]][ww[2]];
else
s:=SignRat(f[i]);
f[i]:=f[i]-s*1/2;
x:=f*B;
y:=SearchOrbit(x,k+1);
y[2]:=pos(CanonicalRightCosetElement
(StabGrp[k+2][y[1]],Elts[y[2]]));
DVFRec[k+1][ww[1]][ww[2]]:=y;
return DVFRec[k+1][ww[1]][ww[2]];
fi;
fi;
od;
DVFRec[k+1][ww[1]][ww[2]]:=[];
return DVFRec[k+1][ww[1]][ww[2]];
else
return DVFRec[k+1][ww[1]][ww[2]];
fi;
end;
###################################################################
###################################################################
#1
#F Homotopy
##
## Input: Degree k and a word w.
##
## Output: The homotopy h(k,w).
##
Homotopy:=function(k,w)
local
h,d,x,y,i,ww,b,p1,p2,s1,s2,v,s,p,t,a,u;
if w=[] then return [];fi;
a:=Sign(AbsInt(k),w[1],w[2]);
d:=[];
w[2]:=pos(CanonicalRightCosetElement(StabGrp[k+1][AbsInt(w[1])],
Elts[w[2]]));
w[1]:=a*Sign(k,w[1],w[2])*w[1];
ww:=[AbsInt(w[1]),w[2]];
h:=StructuralCopy(DVF(k,ww));
if h=[] then
return [];
fi;
x:=PseudoBoundary(k+1,h[1]);
u:=List(x,v->[v[1],Elts[v[2]]*Elts[h[2]]]);
u:=List(u,v->[v[1],pos(CanonicalRightCosetElement
(StabGrp[k+1][AbsInt(v[1])],v[2]))]);
p:=Position(u,ww);
s:=1;;
b:=StructuralCopy(FinalBoundary(k+1,h[1]));
b:=rmult(b,k,h[2]);
c:=StructuralCopy(b);
t:=SignInt(b[p][1]);
Remove(c,p);
Add(d,h);
for i in [1..Length(c)] do
Append(d,NegateWord(Homotopy(k,c[i])));
od;
if w[1]*t<0 then
return NegateWord(d);
else
return d;
fi;
end;
###############################################################
else
DVF:=fail;
Homotopy:=fail;
fi;
###################################################################
return Objectify(HapNonFreeResolution,
rec(
dimension:=Dimension,
boundary:=FinalBoundary,
PseudoBoundary:=PseudoBoundary,
dvf:=DVF,
CellList:=L,
Sign:=Sign,
homotopy:=Homotopy,
elts:=Elts,
group:=G,
stabilizer:=Stabilizer,
action:=Action,
RotSubGroup:=RotSubGroup,
properties:=
[["length",100],
["characteristic",0],
["type","resolution"]] ));
end);
################### end of CrystGcomplex ############################
##########################################################################
#0
#F ResolutionCubicalCrystGroup
## Input: A crystallographic group G and an positive integer n
##
## Output: The first n+1 terms of a free ZG-resolution of Z.
##
##
InstallGlobalFunction(ResolutionCubicalCrystGroup,
function(G,n)
local gens,B,C,R,Gram, pos, Homotopy,Cnew;
Gram:=GramianOfAverageScalarProductFromFiniteMatrixGroup(
PointGroup(G));
if Gram=IdentityMat(DimensionOfMatrixGroup(PointGroup(G))) then
gens:=GeneratorsOfGroup(G);
G:=AffineCrystGroup(gens);
B:=CrystGFullBasis(G);
if IsList(B) then
C:=CrystGcomplex(gens,B,1);
Cnew:=CrystGcomplex(gens,B,1);
Apply(Cnew!.elts,x->x^-1);
pos:=function(L,g)
local p;
p:=Position(L,g);
if p=fail then
Add(L,g);
return Length(L);
else
return p;
fi;
end;
Homotopy:=function(n,w)
local p,h;
p:=pos(C!.elts,Cnew!.elts[w[2]]^-1);
h:=StructuralCopy(C!.homotopy(n,[w[1],p]));
Apply(h,x->[x[1],pos(Cnew!.elts,C!.elts[x[2]]^-1)]);
return h;
end;
Cnew!.homotopy:=Homotopy;
R:=FreeZGResolution(Cnew,n);
return R;
else
return fail;
fi;
else
Print("Gramian matrix is not identity \n");
return fail;
fi;
end);
################### end of ResolutionCubicalCrystGroup ###################
##########################################################################
#0
#F TensorWithComplexRepresentationRing
## Input:
##
## Output:
##
##
InstallGlobalFunction(TensorWithComplexRepresentationRing,
function(C)
local StabIrrTable,i,j,N,
Dimension,PairToTriple,BoundaryMatrix,Boundary,
TripleToPair,StabGrp,BoundaryRec,PartialBoundaryMatrix;
StabGrp:=[];
i:=0;
while C!.dimension(i)>0 do
StabGrp[i+1]:=[];
for j in [1..C!.dimension(i)] do
Add(StabGrp[i+1],C!.stabilizer(i,j));
od;
i:=i+1;
od;
StabIrrTable:=[];
i:=0;
while C!.dimension(i)>0 do
StabIrrTable[i+1]:=[];
for j in [1..C!.dimension(i)] do
Add(StabIrrTable[i+1],OrdinaryCharacterTable(StabGrp[i+1][j]));
od;
i:=i+1;
od;
N:=i-1;
Dimension:=function(k)
local d,i;
d:=0;
for i in [1..C!.dimension(k)] do
d:=d+Size(Irr(StabIrrTable[k+1][i]));
od;
return d;
end;
PairToTriple:=function(i,j)
local k,x;
k:=j;
x:=1;
while k>Size(Irr(StabIrrTable[i+1][x])) do
k:=k-Size(Irr(StabIrrTable[i+1][x]));
x:=x+1;
od;
return [i,x,k];
end;
TripleToPair:=function(i,j,k)
local d,x;
d:=0;
for x in [1..(j-1)] do
d:=d+Size(Irr(StabIrrTable[i+1][x]));
od;
d:=d+k;
return [i,d];
end;
PartialBoundaryMatrix:=function(n,k)
local bdry,x,Coeffs,Mat,W,A,B,i,xx,irrA,perm,tbA,tbB,c,M,ccA,ccB,ccBA;
bdry:=C!.boundary(n,k);
Mat:=[];
for i in [1..Length(bdry)] do
x:=bdry[i][1];
xx:=AbsInt(x);
B:=StabGrp[n+1][k];
A:=ConjugateGroup(B,C!.elts[bdry[i][2]]);
tbA:=OrdinaryCharacterTable(A);
tbB:=OrdinaryCharacterTable(B);
ccB:=tbB!.ConjugacyClasses;
ccA:=tbA!.ConjugacyClasses;
ccBA:=List(ccB,w->(Representative(w)^C!.elts[bdry[i][2]])^A);
c:=List(ccBA,w->Position(ccA,w));
M:=TransposedMat(List([1..Size(ccA)],w->TransposedMat(Irr(A))[c[w]]));
perm:=TransformingPermutations(M,Irr(B));
irrA:=Permuted(List(Irr(A),x->Permuted(x,perm.columns)),perm.rows);
Coeffs:=MatScalarProducts(Irr(StabIrrTable[n][xx]),InducedClassFunctions(irrA,StabGrp[n][xx]));
Add(Mat,[SignInt(x),xx,Coeffs]);
od;
return Mat;
end;
BoundaryRec:=[];
for i in [1..N] do
BoundaryRec[i]:=[];
for j in [1..C!.dimension(i)] do
Add(BoundaryRec[i],PartialBoundaryMatrix(i,j));
# Print([i,j],BoundaryRec[i][j],"\n");
od;
od;
Boundary:=function(n,k)
local w,x,y,i,j,b,d;
b:=[];
for i in [1..Dimension(n-1)] do
Add(b,0);
od;
w:=PairToTriple(n,k);
#Print("w=",w,"\n");
x:=StructuralCopy(BoundaryRec[n][w[2]]);
y:=List(x,a->[a[1],a[2],a[3][w[3]]]);
#Print("y=",y,"\n");
for i in [1..Length(y)] do
for j in [1..Length(y[i][3])] do
if not y[i][3][j]=0 then
#Print("[n-1,y[i][2],j]",[n-1,y[i][2],j],"\n");
d:=TripleToPair(n-1,y[i][2],j)[2];
b[d]:=b[d]+y[i][1]*y[i][3][j];
#Add(b,[y[i][1]*TripleToPair(n-1,y[i][2],j)[2],y[i][3][j]]);
fi;
od;
od;
#b:=AlgebraicReduction(b);
return b;
end;
return Objectify(HapChainComplex,
rec(
#elts:=C!.elts,
dimension:=Dimension,
boundarymatrix:=PartialBoundaryMatrix,
boundary:=Boundary,
#homotopy:=fail,
#group:=Integers,
properties:=
[["length",N],
["characteristic",0],
["type","chainComplex"]] ));
end);
################### end of TensorWithComplexRepresentationRing ############################
###########################################################################################
#0
#F TensorWithBurnsideRing
## Input:
##
## Output:
##
##
InstallGlobalFunction(TensorWithBurnsideRing,
function(C)
local StabConjClss,i,j,N,
Dimension,PairToTriple,BoundaryMatrix,Boundary,
TripleToPair,StabGrp,BoundaryRec,PartialBoundaryMatrix;
StabGrp:=[];
i:=0;
while C!.dimension(i)>0 do
StabGrp[i+1]:=[];
for j in [1..C!.dimension(i)] do
Add(StabGrp[i+1],C!.stabilizer(i,j));
od;
i:=i+1;
od;
StabConjClss:=[];
i:=0;
while C!.dimension(i)>0 do
StabConjClss[i+1]:=[];
for j in [1..C!.dimension(i)] do
Add(StabConjClss[i+1],ConjugacyClassesSubgroups(StabGrp[i+1][j]));
od;
i:=i+1;
od;
N:=i-1;
Dimension:=function(k)
local d,i;
d:=0;
for i in [1..C!.dimension(k)] do
d:=d+Size(StabConjClss[k+1][i]);
od;
return d;
end;
PairToTriple:=function(i,j)
local k,x;
k:=j;
x:=1;
while k>Size(StabConjClss[i+1][x]) do
k:=k-Size(StabConjClss[i+1][x]);
x:=x+1;
od;
return [i,x,k];
end;
TripleToPair:=function(i,j,k)
local d,x;
d:=0;
for x in [1..(j-1)] do
d:=d+Size(StabConjClss[i+1][x]);
od;
d:=d+k;
return [i,d];
end;
PartialBoundaryMatrix:=function(n,k)
local bdry,x,Coeffs,Mat,A,i,xx,L,j,B,ccB,ccA;
bdry:=C!.boundary(n,k);
Mat:=[];
for i in [1..Length(bdry)] do
x:=bdry[i][1];
xx:=AbsInt(x);
B:=StabGrp[n+1][k];
A:=ConjugateGroup(B,C!.elts[bdry[i][2]]);
ccB:=ConjugacyClassesSubgroups(B);
ccA:=List(ccB,w->(Representative(w)^C!.elts[bdry[i][2]])^A);
L:=List(ccA,w->PositionsProperty(StabConjClss[n][xx],c->Representative(w) in c));
Coeffs:=[];
for j in [1..Length(L)] do
Coeffs[j]:=[];
for i in [1..Length(StabConjClss[n][xx])] do
if i in L[j] then Coeffs[j][i]:=1;
else Coeffs[j][i]:=0;
fi;
od;
od;
Add(Mat,[SignInt(x),xx,Coeffs]);
od;
return Mat;
end;
BoundaryRec:=[];
for i in [1..N] do
BoundaryRec[i]:=[];
for j in [1..C!.dimension(i)] do
Add(BoundaryRec[i],PartialBoundaryMatrix(i,j));
# Print([i,j],BoundaryRec[i][j],"\n");
od;
od;
Boundary:=function(n,k)
local w,x,y,i,j,b,d;
b:=[];
for i in [1..Dimension(n-1)] do
Add(b,0);
od;
w:=PairToTriple(n,k);
x:=StructuralCopy(BoundaryRec[n][w[2]]);
y:=List(x,a->[a[1],a[2],a[3][w[3]]]);
for i in [1..Length(y)] do
for j in [1..Length(y[i][3])] do
if not y[i][3][j]=0 then
d:=TripleToPair(n-1,y[i][2],j)[2];
b[d]:=b[d]+y[i][1]*y[i][3][j];
#Add(b,[y[i][1]*TripleToPair(n-1,y[i][2],j)[2],y[i][3][j]]);
fi;
od;
od;
#b:=AlgebraicReduction(b);
return b;
end;
return Objectify(HapChainComplex,
rec(
#elts:=C!.elts,
classes:=StabConjClss,
dimension:=Dimension,
boundarymatrix:=PartialBoundaryMatrix,
boundary:=Boundary,
#homotopy:=fail,
#group:=Integers,
properties:=
[["length",N],
["characteristic",0],
["type","chainComplex"]] ));
end);
################### end of TensorWithBurnsideRing ############################