GAP 4.8.9 installation with standard packages -- copy to your CoCalc project to get it
#(C) 2009 Graham Ellis ########################################################## ########################################################## InstallGlobalFunction(HomomorphismChainToCommutativeDiagram, function(L) local Ln,Arrows,Objects,i; Ln:=Length(L); Arrows:=List([1..Ln],i->[]); Objects:=[1..Ln+1]; for i in [1..Ln] do Arrows[i]:=[L[i],i,i+1]; od; return Objectify(HapCommutativeDiagram, rec( objects:=Objects, arrows:=Arrows, properties:=[ ["type","chain"]] )); end); ########################################################## ########################################################## ########################################################## ########################################################## InstallGlobalFunction(NerveOfCommutativeDiagram, function(D) local Obs,Arrs,ExitArrs,Tree,Answer,N,i; ############################### if not IsHapCommutativeDiagram(D) then Print("The function must be applied to a commutative diagram.\n"); fi; ############################### Obs:=D!.objects; Arrs:=D!.arrows; ExitArrs:=List([1..Size(Obs)],i->[]); #ExitArrs[i] is a list of integers j such that Arr[j] has source i. for i in [1..Length(Arrs)] do Add(ExitArrs[Arrs[i][2]], Arrs[i]); od; ######################################## Tree:=function(x) #Tree(x) will be a list of composed arrows corresponding to #a directed maximal tree in the directed diagram with root x. local T,Leaves,NewLeaves,y,f,yf; ##The tree T will grow, and at any stage Leaves is the latest # round of elements that are to be added to T. T:=[]; Leaves:=StructuralCopy(ExitArrs[x]); while Size(Leaves)>0 do Append(T,Leaves); NewLeaves:=[]; for y in Leaves do for f in ExitArrs[y[3]] do yf:=[y[1]*f[1],y[2],f[3]]; Add(NewLeaves,yf); od; od; Leaves:=NewLeaves; od; return T; end; ######################################## Answer:=[]; for i in Obs do Append(Answer,Tree(i)); od; return Objectify(HapCommutativeDiagram, rec( objects:=Obs, arrows:=Answer, properties:=[ ["type","nerve", EvaluateProperty(D,"type")]] )); end); ########################################################## ########################################################## ########################################################## ########################################################## InstallGlobalFunction(GroupHomologyOfCommutativeDiagram, function(arg) local D, deg, prime, Resol, ResLst, Obs, Arrs, tmp, hom,RG,G,RQ,eqmap,map,HomologyArrs, x,y;; #####INPUT################# D:=arg[1]; #A commutative diagram of groups deg:=arg[2]; #The degree in which homology will be calculated. if Length(arg)>2 then prime:=arg[3]; else prime:=PrimePGroup(Source(D!.arrows[1][1])); fi; if Length(arg)>3 then Resol:=arg[4]; else if not prime=0 then Resol:=ResolutionPrimePowerGroup; else Resol:=ResolutionFiniteGroup; fi; fi; ########################### Obs:=D!.objects; Arrs:=D!.arrows; ##################### ResLst:=[]; tmp:=[]; for x in Arrs do if not x[2] in tmp then Add(tmp,x[2]); G:=Source(x[1]); if Order(G)=1 then RG:=ResolutionFiniteGroup(G,deg+1); else RG:=Resol(G,deg+1); fi; ResLst[x[2]]:=RG; fi; if not x[3] in tmp then Add(tmp,x[3]); G:=Range(x[1]); if Order(G)=1 then RG:=ResolutionFiniteGroup(G,deg+1); else RG:=Resol(G,deg+1); fi; ResLst[x[3]]:=RG; fi; od; ############################ HomologyArrs:=[]; for x in Arrs do RG:=ResLst[x[2]]; RQ:=ResLst[x[3]]; hom:=x[1]; eqmap:=EquivariantChainMap(RG,RQ,hom); map:=TensorWithIntegersModP(eqmap,prime); Add(HomologyArrs,[HomologyVectorSpace(map,deg), x[2], x[3]]); od; return Objectify(HapCommutativeDiagram, rec( objects:=StructuralCopy(Obs), arrows:=HomologyArrs, properties:=[ ["type",EvaluateProperty(D,"type")]] )); end); ########################################################## ########################################################## ########################################################## ########################################################## InstallGlobalFunction(PersistentHomologyOfCommutativeDiagramOfPGroups, function(D,n) local H; H:=GroupHomologyOfCommutativeDiagram(D,n); H:=List(H!.arrows, x-> [Dimension(Source(x[1])), Dimension(Image(x[1])), Dimension(Range(x[1]))]); return H; end); ########################################################## ########################################################## ########################################################## ########################################################## InstallGlobalFunction(NormalSeriesToQuotientDiagram, function(arg) #SS is a decreasing or increasing series of groups, and RR is #a subseries of SS; local SS,RR,S,R,H, gens, HOMS,N,P,G,Q,iso,HhomHmodS,HhomHmodR,RShoms, SHOMS,RHOMS,RSHOMS,hom,hom1,Objects,Arrows,i; ##################### if Length(arg)=1 then S:=NormalSeriesToQuotientHomomorphisms(arg[1]); return HomomorphismChainToCommutativeDiagram(S); fi; ##################### SS:=arg[1]; RR:=arg[2]; ##### ERROR ########## if Length(SS)<Length(RR) then Print("Error: the second series is too long.\n"); return fail; fi; ###################### if Size(SS[1])<=Size(SS[Length(SS)]) then S:=SS; else S:=Reversed(SS); fi; if Size(RR[1])<=Size(RR[Length(RR)]) then R:=RR; else R:=Reversed(RR); fi; ##### ERROR ######### if not S[Length(S)]=R[Length(R)] then Print("The two series are subseries of different groups.\n"); return fail; fi; ##################### for i in [Length(R)+1..Length(S)] do R[i]:=R[Length(R)]; od; #NWe now hope that R is a subseries of S, and both have same length. ####################### H:=S[Length(S)]; HhomHmodS:=[]; for i in [1..Length(S)] do HhomHmodS[i]:=NaturalHomomorphismByNormalSubgroup(H,S[i]); od; HhomHmodR:=[]; for i in [1..Length(S)] do HhomHmodR[i]:=NaturalHomomorphismByNormalSubgroup(H,R[i]); od; ######################################## SHOMS:=[HhomHmodS[1]]; for i in [1..Length(S)-1] do P:=Range(HhomHmodS[i]); N:=List(GeneratorsOfGroup(S[i+1]),x->Image(HhomHmodS[i],x)); Add(N,Identity(P)); N:=Subgroup(P,N); hom:=NaturalHomomorphismByNormalSubgroup(P,N); gens:=GeneratorsOfGroup(Range(hom)); iso:=GroupHomomorphismByImagesNC(Range(hom),Range(HhomHmodS[i+1]), gens, List(gens, x-> Image(HhomHmodS[i+1], PreImagesRepresentative(HhomHmodS[i],PreImagesRepresentative(hom,x))) ) ); hom1:=GroupHomomorphismByImagesNC(P,Range(HhomHmodS[i+1]), GeneratorsOfGroup(P), List(GeneratorsOfGroup(P), x-> Image(iso,Image(hom,x)))); Add(SHOMS,hom1); od; ######################################### ######################################## RHOMS:=[HhomHmodR[1]]; for i in [1..Length(R)-1] do P:=Range(HhomHmodR[i]); N:=List(GeneratorsOfGroup(R[i+1]),x->Image(HhomHmodR[i],x)); Add(N,Identity(P)); N:=Subgroup(P,N); hom:=NaturalHomomorphismByNormalSubgroup(P,N); gens:=GeneratorsOfGroup(Range(hom)); iso:=GroupHomomorphismByImagesNC(Range(hom),Range(HhomHmodR[i+1]), gens, List(gens, x-> Image(HhomHmodR[i+1], PreImagesRepresentative(HhomHmodR[i],PreImagesRepresentative(hom,x))) ) ); hom1:=GroupHomomorphismByImagesNC(P,Image(HhomHmodR[i+1]), GeneratorsOfGroup(P), List(GeneratorsOfGroup(P), x-> Image(iso,Image(hom,x)))); Add(RHOMS,hom1); od; ######################################### ######################################## iso:=GroupHomomorphismByImagesNC(H,H, GeneratorsOfGroup(H), GeneratorsOfGroup(H) ); RSHOMS:=[iso]; for i in [1..Length(RHOMS)] do P:=Range(RHOMS[i]); Q:=Range(SHOMS[i]); gens:=GeneratorsOfGroup(P);; if i>1 then hom:=GroupHomomorphismByImagesNC(P,Q, gens, List(gens , x-> Image(SHOMS[i], Image(HhomHmodS[i-1],PreImagesRepresentative(HhomHmodR[i-1], PreImagesRepresentative(RHOMS[i],x)))) )); else hom:=GroupHomomorphismByImagesNC(P,Q, gens, List(gens , x-> Image(SHOMS[i], PreImagesRepresentative(RHOMS[i],x)) )); fi; RSHOMS[i+1]:=hom; od; ######################################### for i in [1..Length(SHOMS)] do SHOMS[i]:=[SHOMS[i],2*(i-1)+1,2*i+1]; RHOMS[i]:=[RHOMS[i],2*i,2*(i+1)]; od; for i in [1..Length(SHOMS)+1] do RSHOMS[i]:=[RSHOMS[i],2*i,2*(i-1)+1]; od; Arrows:=Concatenation( [SHOMS,RHOMS, RSHOMS] ); Objects:=[1..2*(Length(S)+1)]; return Objectify(HapCommutativeDiagram, rec( objects:=Objects, arrows:=Arrows, properties:=[ ["type","bichain"]] )); end); ########################################################## ##########################################################