GAP 4.8.9 installation with standard packages -- copy to your CoCalc project to get it
#(C) Graham Ellis, 2005-2006 ##################################################################### InstallGlobalFunction(PrimePartDerivedFunctor, function(G,R,F,n) local C,P, DCRS, DCRS1, DCRSpruned,L,Y,GroupL, X, K, gensK, S, f,fx, P1, HP, HK, HPK, HKhomHPK, HPKhomHP, HKhomHP, HKx,HPKx, HKxhomHPKx, HPKxhomHP, HKxhomHP, HKhomHKx, HKhomHP2, HPrels, x, y, i,prime, core, conjs, conjelt,CentP, HPpres,G1,epi,HPP,rho, bool; C:=F(R); #P:=StructuralCopy(R!.group); P:=Group(SmallGeneratingSet(R!.group)); HP:=GroupHomomorphismByFunction(P,P,x->x); HP:=EquivariantChainMap(R,R,HP); HP:=F(HP); HP:=Homology(HP,n); HP:=Source(HP); HPrels:=[Identity(HP)]; if Length(AbelianInvariants(HP))=0 then return []; fi; P1:=Normalizer(G,P); prime:=Factors(Order(P))[1]; if not IsPrimeInt(Order(P)) then DCRS1:=List(DoubleCosetRepsAndSizes(G,P1,P1),x->x[1]); else DCRS1:=[]; fi; if Order(P1)>Order(P) then Append(DCRS1,Filtered(ReduceGenerators(GeneratorsOfGroup(P1),P1), x->not x in P)); fi; core:=[]; for x in P do if Order(x)=prime then AddSet(core,x); fi; od; DCRS:=[]; for x in DCRS1 do #I've forgotten what all this means!! for y in core do if x*y*x^-1 in core then Add(DCRS,x); break; fi; od;od; DCRSpruned:=[]; conjs:=[]; conjelt:=[]; for x in DCRS do Y:=Intersection(P,P^x); AddSet(conjs,Y); Append(conjelt,[[x,Y]]); #An improvement would be to not save all Y (twice!). od; for Y in conjs do L:=Filtered(conjelt,x->x[2]=Y); L:=List(L,x->x[1]); GroupL:=Group(L); Add(DCRSpruned,ReduceGenerators(L,GroupL)); od; DCRSpruned:=Filtered(DCRSpruned,x->Length(x)>0); for L in DCRSpruned do K:=Intersection(P,P^L[1]); gensK:=ReduceGenerators(GeneratorsOfGroup(K),K); if not Length(gensK)=0 then G1:=Group(gensK); if Order(G1)<64 and n<4 then ##NEED TO FIND AN "OPTIMAL" CHOICE HERE S:=ResolutionFiniteGroup(gensK,n+1); S!.group:=Group(SmallGeneratingSet(S!.group)); else S:=ResolutionNormalSeries(LowerCentralSeries(G1),n+1); S!.group:=Group(SmallGeneratingSet(S!.group)); fi; if not (Homology(F(S),n)=[]) then f:=GroupHomomorphismByFunction(K,P,x->x); HKhomHPK:=Homology(F(EquivariantChainMap(S,R,f)),n); #################################rho################## if "twist" in NamesOfComponents(F(R)) then rho:=F(R)!.twist; else rho:=function(x) return 1; end; fi; #################################rho done############# HK:=Source(HKhomHPK); HPK:=Range(HKhomHPK); HPKhomHP:=GroupHomomorphismByImagesNC(HPK,HP,GeneratorsOfGroup(HPK), GeneratorsOfGroup(HP)); HKhomHP:=GroupHomomorphismByFunction(HK,HP,x-> Image(HPKhomHP, Image(HKhomHPK,x) ) ); for X in L do fx:=GroupHomomorphismByFunction(K,P,g->Image(f,g)^(X^-1)); HKxhomHPKx:=Homology(F(EquivariantChainMap(S,R,fx)),n); HKx:=Source(HKxhomHPKx); HPKx:=Parent(Range(HKxhomHPKx)); HPKxhomHP:=GroupHomomorphismByImagesNC(HPKx,HP,GeneratorsOfGroup(HPKx), GeneratorsOfGroup(HP)); HKxhomHP:=GroupHomomorphismByFunction(HKx,HP,x-> Image(HPKxhomHP, Image(HKxhomHPKx,x) )^rho(X) ); HKhomHKx:=GroupHomomorphismByImagesNC(HK,HKx,GeneratorsOfGroup(HK),GeneratorsOfGroup(HKx)); HKhomHP2:=GroupHomomorphismByFunction(HK,HP,a-> Image(HKxhomHP, Image(HKhomHKx,a))); for x in GeneratorsOfGroup(HK) do Append(HPrels, [Image(HKhomHP,x)*Image(HKhomHP2,x)^-1]); od; od; fi; fi; od; if IsPcpGroup(HP) or IsPcGroup(HP) then HPP:=HP/Group(SSortedList(HPrels)); else epi:=EpimorphismNilpotentQuotient(HP,1); HPP:=Range(epi)/Group(SSortedList(List(HPrels,x->Image(epi,x)))); #HPP:=HP/Group(SSortedList(HPrels)); fi; return AbelianInvariants(HPP); end); #####################################################################