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