1#(C) Graham Ellis, 2005-2006 2#RT:=0; 3##################################################################### 4InstallGlobalFunction(ResolutionFiniteDirectProduct, 5function(arg) 6local 7 R,S, 8 G,H,E,K,GhomE,HhomE,EhomG,EhomH,EltsE,eltse,elts2intrec, 9 ghome, hhome, ehomg, ehomh, 10 DimensionR,BoundaryR,HomotopyR, 11 DimensionS,BoundaryS,HomotopyS, 12 Lngth,Dimension,Boundary,Homotopy, 13 PseudoBoundary, 14 DimPQ, 15 Int2Pair, Pair2Int, 16 Charact, 17 AddWrds, 18 Int2Vector, Int2Vectorrec, 19 Vector2Int, Vector2IntRec, 20 Elts2Int, 21 HomotopyGradedGen, 22 HomotopyRec, 23 HomotopyOfWord, 24 FinalHomotopy, 25 HorizontalBoundaryGen, 26 HorizontalBoundaryWord, 27 F,FhomE, 28 gensE, gensE1, gensE2, 29 Boole,HGrec, DimPQrec, 30 i,j,k,p,q,r,s,b,g,h,fn; 31 32R:=arg[1]; 33S:=arg[2]; 34 35G:=R!.group; 36H:=S!.group; 37 38 39####################### DIRECT PRODUCT OF GROUPS ########### 40if Length(arg)=2 then 41 42if (not IsFinite(G)) or (not IsFinite(H)) then 43return ResolutionDirectProduct(R,S); fi; 44 45E:=DirectProduct(G,H); 46if Size(G)=infinity or Size(H)=infinity then SetSize(E,infinity);fi; 47GhomE:=Embedding(E,1); 48HhomE:=Embedding(E,2); 49EhomG:=Projection(E,1); 50EhomH:=Projection(E,2); 51 52else #if G and H both lie in a group K, and if they commute and have 53 #have trivial intersection then we create their direct product as 54 #a subgroup of K. We treat pcp groups as a seperate case. 55 56#####PCP CASE ####################### 57if IsPcpGroup(G) then 58K:=PcpGroupByCollector(Collector(Identity(G))); 59 60gensE:=Igs(Concatenation(GeneratorsOfGroup(G),GeneratorsOfGroup(H))); 61E:=Group(gensE); 62 63 fn:=function(x,S) 64 local v,w,y; 65 v:=GenExpList(x); 66 v:=List([1..Length(v)/2],i->[Igs(K)[v[2*i-1]],v[2*i]]); 67 w:=Identity(K); 68 for y in v do 69 if y[1] in S then w:=w*y[1]^y[2]; fi; 70 od; 71 return w; 72 end; 73 74GhomE:=GroupHomomorphismByFunction(G,E,x->x); 75HhomE:=GroupHomomorphismByFunction(H,E,x->x); 76EhomG:=GroupHomomorphismByFunction(E,G,x->fn(x,G)); 77EhomH:=GroupHomomorphismByFunction(E,H,x->fn(x,H)); 78fi; 79############PCP CASE DONE########### 80 81############OTHER CASE############## 82if not IsPcpGroup(G) then 83gensE:=Concatenation(GeneratorsOfGroup(G),GeneratorsOfGroup(H)); 84E:=Group(gensE); 85 86gensE1:=Concatenation(GeneratorsOfGroup(G), 87 List([1..Length(GeneratorsOfGroup(H))],x->Identity(G))); 88 gensE2:=Concatenation(List([1..Length(GeneratorsOfGroup(G))],x->Identity(H)), 89 GeneratorsOfGroup(H)); 90 91GhomE:=GroupHomomorphismByFunction(G,E,x->x); 92HhomE:=GroupHomomorphismByFunction(H,E,x->x); 93EhomG:=GroupHomomorphismByImagesNC(E,G,gensE,gensE1); 94EhomH:=GroupHomomorphismByImagesNC(E,H,gensE,gensE2); 95fi; 96###########OTHER CASE DONE######### 97 98fi; 99################ DIRECT PRODUCT OF GROUPS CONSTRUCTED ######### 100 101 102 103EltsE:=[Identity(E)]; 104for g in R!.elts do 105for h in S!.elts do 106AddSet(EltsE,Image(GhomE,g)*Image(HhomE,h)); 107AddSet(EltsE,Image(HhomE,h)*Image(GhomE,g)); 108od; 109od; 110i:=Position(EltsE,Identity(E)); 111EltsE[i]:=EltsE[1]; 112EltsE[1]:=Identity(E); 113 114 115 116 117PseudoBoundary:=[]; 118DimensionR:=R!.dimension; 119DimensionS:=S!.dimension; 120BoundaryS:= S!.boundary; 121 122BoundaryR:=R!.boundary; 123HomotopyR:=R!.homotopy; 124HomotopyS:=S!.homotopy; 125 126#################DETERMINE VARIOUS PROPERTIES######################## 127Lngth:=Minimum(EvaluateProperty(R,"length"),EvaluateProperty(S,"length")); 128 129if EvaluateProperty(R,"characteristic")=0 130and EvaluateProperty(S,"characteristic")=0 131then Charact:=EvaluateProperty(R,"characteristic"); 132fi; 133 134if EvaluateProperty(R,"characteristic")=0 135and EvaluateProperty(S,"characteristic")>0 136then Charact:=EvaluateProperty(S,"characteristic"); 137fi; 138 139if EvaluateProperty(R,"characteristic")>0 140and EvaluateProperty(S,"characteristic")=0 141then Charact:=EvaluateProperty(R,"characteristic"); 142fi; 143 144if EvaluateProperty(R,"characteristic")>0 145and EvaluateProperty(S,"characteristic")>0 146then Charact:=Product(Intersection([ 147DivisorsInt(EvaluateProperty(R,"characteristic")), 148DivisorsInt(EvaluateProperty(S,"characteristic")) 149])); 150fi; 151 152if Charact=0 then AddWrds:=AddFreeWords; else 153 AddWrds:=function(v,w); 154 return AddFreeWordsModP(v,w,Charact); 155 end; 156fi; 157####################PROPERTIES DETERMINED############################ 158 159 160##################################################################### 161Dimension:=function(i) 162local D,j; 163if i<0 then return 0; fi; 164if i=0 then return 1; else 165D:=0; 166 167for j in [0..i] do 168D:=D+DimensionR(j)*DimensionS(i-j); 169od; 170 171return D; fi; 172end; 173##################################################################### 174 175for i in [1..Lngth] do 176PseudoBoundary[i]:=[1..Dimension(i)]; 177od; 178 179DimPQrec:=[]; 180for i in [1..Lngth+1] do 181DimPQrec[i]:=[]; 182od; 183 184##################################################################### 185DimPQ:=function(p,q) 186local D,j; 187 188if (p<0) or (q<0) then return 0; fi; 189if not IsBound(DimPQrec[p+1][q+1]) then 190D:=0; 191for j in [0..q] do 192D:=D+DimensionR(p+q-j)*DimensionS(j); 193od; 194DimPQrec[p+1][q+1]:=D; 195fi; 196 197return DimPQrec[p+1][q+1]; 198end; 199##################################################################### 200 201##################################################################### 202Int2Pair:=function(i,p,q) #Assume that x<=DimR(p)*DimS(q). 203local s,r,x; 204 #The idea is that the generator f_i in F 205 #corresponds to a tensor (e_r x e_s) 206x:=AbsoluteValue(i)-DimPQ(p+1,q-1); #with e_r in R_p, e_s in S_q. If we 207s:= x mod DimensionS(q); #input i we get output [r,s]. 208r:=(x-s)/DimensionS(q); 209 210if s=0 then return [SignInt(i)*r,DimensionS(q)]; 211else return [SignInt(i)*(r+1),s]; fi; 212 213end; 214##################################################################### 215 216##################################################################### 217Pair2Int:=function(x,p,q) 218local y; #Pair2Int is the inverse of Int2Pair. 219y:=[AbsoluteValue(x[1]),AbsoluteValue(x[2])]; 220return SignInt(x[1])*SignInt(x[2])*((y[1]-1)*DimensionS(q)+y[2]+DimPQ(p+1,q-1)); 221end; 222##################################################################### 223 224Int2Vectorrec:=[]; 225for i in [1..Lngth+1] do 226Int2Vectorrec[i]:=[]; 227od; 228 229##################################################################### 230Int2Vector:=function(k,j) 231local tmp,p,q; 232 233if not IsBound(Int2Vectorrec[k+1][j]) then 234p:=k;q:=0; 235while j>=DimPQ(p,q)+1 do 236p:=p-1;q:=q+1; 237od; #p,q are now computed from k,j 238 239tmp:=Int2Pair(j,p,q); 240Int2Vectorrec[k+1][j]:=[p,q,tmp[1],tmp[2]]; 241fi; 242return Int2Vectorrec[k+1][j]; 243end; 244##################################################################### 245 246Vector2IntRec:=[]; 247for p in [1..Lngth+1] do 248Vector2IntRec[p]:=[]; 249for q in [1..Lngth+1] do 250Vector2IntRec[p][q]:=[]; 251for r in [1..R!.dimension(p-1)] do 252Vector2IntRec[p][q][r]:=[]; 253od;od;od; 254##################################################################### 255Vector2Int:=function(p,q,r,s) 256local rr, ss; 257rr:=AbsInt(r); ss:=AbsInt(s); 258if not IsBound(Vector2IntRec[p+1][q+1][rr][ss]) then 259Vector2IntRec[p+1][q+1][rr][ss]:= Pair2Int([rr,ss],p,q); 260fi; 261return SignInt(r)*SignInt(s)*Vector2IntRec[p+1][q+1][rr][ss]; 262end; 263##################################################################### 264 265##################################################################### 266Elts2Int:=function(x) 267local pos; 268 269pos:=Position(EltsE,x); 270if IsPosInt(pos) then return pos; 271else 272 Append(EltsE,[x]); 273 return Length(EltsE); 274fi; 275end; 276##################################################################### 277eltse:=Elements(E); 278elts2intrec:=List([1..Length(eltse)],i->Elts2Int(eltse[i])); 279##################################################################### 280Elts2Int:=function(x); 281return elts2intrec[PositionSorted(eltse,x)]; 282end; 283##################################################################### 284 285############################################### 286ghome:=List([1..Order(G)],i->Elts2Int(Image(GhomE,R!.elts[i]))); 287hhome:=List([1..Order(H)],i->Elts2Int(Image(HhomE,S!.elts[i]))); 288ehomg:=List([1..Order(E)],i->Position(R!.elts,Image(EhomG,EltsE[i]))); 289ehomh:=List([1..Order(E)],i->Position(S!.elts,Image(EhomH,EltsE[i]))); 290############################################### 291 292##################################################################### 293Boundary:=function(k,jj) 294local j, p,q,r,s,tmp, horizontal, vertical; 295 296if k<1 then return []; fi; 297j:=AbsoluteValue(jj); 298 #################IF BOUNDARY NOT ALREADY COMPUTED############ 299if IsInt(PseudoBoundary[k][j]) then 300tmp:=Int2Vector(k,j); 301p:=tmp[1]; q:=tmp[2]; r:=tmp[3]; s:=tmp[4]; 302 303horizontal:=ShallowCopy(BoundaryR(p,r)); 304#Apply(horizontal,x->[x[1],Elts2Int( Image(GhomE,R!.elts[x[2]]) ) ]); 305Apply(horizontal,x->[x[1],1*ghome[x[2]]]); 306Apply(horizontal,x->[Vector2Int(p-1,q,x[1],s),x[2]]); 307 308vertical:=ShallowCopy(BoundaryS(q,s)); 309#Apply(vertical,x->[x[1],Elts2Int( Image(HhomE,S!.elts[x[2]]) ) ]); 310Apply(vertical,x->[x[1],1*hhome[x[2]] ]); 311Apply(vertical,x->[Vector2Int(p,q-1,r,x[1]),x[2]]); 312if IsOddInt(p) then 313vertical:=NegateWord(vertical); 314fi; 315 316 317PseudoBoundary[k][j]:= Concatenation(horizontal, vertical); 318fi; 319 ################IF ENDS###################################### 320 321if SignInt(jj)=1 then 322return PseudoBoundary[k][j]; 323else 324return NegateWord(PseudoBoundary[k][j]); 325fi; 326end; 327##################################################################### 328 329##################################################################### 330HorizontalBoundaryGen:=function(n,y) 331local a,i, p,q,r,s, tmp,horizontal; 332 333a:=AbsoluteValue(y[1]); 334tmp:=Int2Vector(n,a); 335 336p:=tmp[1]; q:=tmp[2]; r:=tmp[3]; s:=tmp[4]; 337 338horizontal:=StructuralCopy(BoundaryR(p,r)); 339 340#Apply(horizontal,x->[x[1],Elts2Int( EltsE[y[2]]*Image(GhomE,R!.elts[x[2]]) )]); 341Apply(horizontal,x->[x[1],Elts2Int( EltsE[y[2]]*EltsE[ghome[x[2]]]) ]); 342 343 344Apply(horizontal,x->[Vector2Int(p-1,q,x[1],s),x[2]]); 345 346return horizontal; 347 348end; 349##################################################################### 350 351##################################################################### 352HorizontalBoundaryWord:=function(n,w) 353local x, bnd; 354 355bnd:=[]; 356for x in w do 357Append(bnd,HorizontalBoundaryGen(n,x)); 358od; 359return bnd; 360 361end; 362##################################################################### 363 364HGrec:=[]; 365for p in [1..Lngth+1] do 366HGrec[p]:=[]; 367for q in [1..Lngth-p+1] do 368HGrec[p][q]:=[]; 369for r in [1..R!.dimension(p)+2] do #why +2? 370HGrec[p][q][r]:=[]; 371for s in [1..S!.dimension(q)+2] do #why +2? 372HGrec[p][q][r][s]:=[]; 373for b in [1,2] do 374HGrec[p][q][r][s][b]:=[]; 375od;od;od;od;od; 376 377##################################################################### 378HomotopyGradedGen:=function(g,p,q,r,s,bool) #Assume EltsE[g] exists! 379local aa,hty, hty1, Eg, Eg1, Eg2, g1, g2,b; #bool=true for vertical homotopy 380 381if bool=true then b:=1; else b:=2; fi; 382if IsBound(HGrec[p+1][q+1][r+1][s+1][b][g]) then 383return 1*HGrec[p+1][q+1][r+1][s+1][b][g]; fi; 384 385 386 387#This function seems to work! But I should really check the maths again!! 388 389g2:=1*ehomh[g]; 390g1:=1*ehomg[g]; 391Eg1:=EltsE[ghome[g1]]; 392Eg2:=EltsE[hhome[g2]]; 393 394hty:=HomotopyS(q,[s,g2]); 395if Length(hty)>0 then 396#Apply(hty,x->[ Vector2Int(p,q+1,r,x[1]), Image(HhomE,S!.elts[x[2]])]); 397Apply(hty,x->[ Vector2Int(p,q+1,r,x[1]), hhome[x[2]]]); 398Apply(hty,x->[ x[1], Elts2Int(Eg1*EltsE[x[2]])]); 399if IsOddInt(p) then 400hty:=NegateWord(hty); fi; 401fi; 402 403if (p=0 and q>0) or bool then return hty; fi; 404 405if p>0 then 406if Length(hty)>0 then 407hty1:=HomotopyOfWord(p+q,1*HorizontalBoundaryWord(p+q+1,hty),false); 408Append(hty, NegateWord(hty1)); 409fi; 410fi; 411 412if q>0 then return hty; fi; 413 414 415hty1:=HomotopyR(p,[r,g1]); 416if Length(hty1)>0 then 417#Apply(hty1,x->[ Vector2Int(p+1,q,x[1],s), Image(GhomE,R!.elts[x[2]])]); 418Apply(hty1,x->[ Vector2Int(p+1,q,x[1],s), ghome[x[2]]]); 419#Apply(hty1,x->[ x[1], Elts2Int(x[2])]); #Here 420 421Append(hty,hty1); 422 423hty1:=HomotopyOfWord(p+q,StructuralCopy(HorizontalBoundaryWord(p+q+1,hty1)),true); 424 425Append(hty,NegateWord(hty1)); 426 427hty1:=HomotopyOfWord(p+q,StructuralCopy(HorizontalBoundaryWord(p+q+1,hty1)),false); 428 429 430Append(hty,hty1); #I think this perturbation term is always zero and 431 #thus not necessary. 432fi; 433HGrec[p+1][q+1][r+1][s+1][b][g]:=hty; 434 435return 1*HGrec[p+1][q+1][r+1][s+1][b][g]; 436 437end; 438##################################################################### 439 440##################################################################### 441Homotopy:=function(n,x,bool) 442local vec,a; 443 444 445a:=AbsoluteValue(x[1]); 446vec:=Int2Vector(n,a); 447if SignInt(x[1])=1 then 448return HomotopyGradedGen(x[2],vec[1],vec[2],vec[3],vec[4],bool); 449else 450return NegateWord(HomotopyGradedGen(x[2],vec[1],vec[2],vec[3],vec[4],bool)); 451fi; 452end; 453##################################################################### 454 455##################################################################### 456HomotopyOfWord:=function(n,w,bool) 457local x, hty; 458 459hty:=[]; 460for x in w do 461Append(hty,Homotopy(n,x,bool)); 462od; 463 464return hty; 465 466end; 467##################################################################### 468 469HomotopyRec:=[]; 470for i in [1..Lngth] do 471HomotopyRec[i]:=[]; 472for j in [1..Dimension(i-1)] do 473HomotopyRec[i][j]:=[]; 474od;od; 475 476##################################################################### 477FinalHomotopy:=function(n,x) 478local a; 479 480 481a:=AbsInt(x[1]); 482if not IsBound(HomotopyRec[n+1][a][x[2]]) then 483HomotopyRec[n+1][a][x[2]]:=Homotopy(n,[a,x[2]],false); 484fi; 485 486if SignInt(x[1])=1 then 487return StructuralCopy(HomotopyRec[n+1][a][x[2]]); 488else 489return NegateWord(StructuralCopy(HomotopyRec[n+1][a][x[2]])); 490fi; 491end; 492##################################################################### 493 494 495if HomotopyR=fail or HomotopyS=fail then 496FinalHomotopy:=fail; 497fi; 498 499for i in [1..Lngth] do 500for j in [1..Dimension(i)] do 501g:=Boundary(i,j); 502od; 503od; 504 505 506 507Boole:=false; 508if EvaluateProperty(R,"reduced")=true 509and EvaluateProperty(S,"reduced")=true 510then Boole:=true; 511fi; 512 513 514return Objectify(HapResolution, 515 rec( 516 dimension:=Dimension, 517 boundary:=Boundary, 518 homotopy:=FinalHomotopy, 519 elts:=EltsE, 520 group:=E, 521 firstProjection:=EhomG, 522 secondProjection:=EhomH, 523 Int2Vector:=Int2Vector, 524 Vector2Int:=Vector2Int, 525 properties:= 526 [["type","resolution"], 527 ["length",Lngth], 528 ["reduced",Boole], 529 ["characteristic",Charact] ])); 530 531end); 532##################################################################### 533 534