Group Theory – GAP Isomorphism Between Finitely Presented p-Groups

gapgroup-presentationgroup-theory

I have finitely presented nilpotent p-groups with exponenta 5 G = $\langle x1, x2, x3, x4: [x1, x2] = 1, [x3, x4] = 1, [x1, x4] = [x3, x2], [x2, x4] = [x1, x3]^{-2}] \rangle$ and H = $\langle x1, x2, x3, x4: [x1, x2] = 1, [x3, x4] = 1, [x1, x4] = [x3, x2], [x2, x4] = [x1, x3]^{-3}] \rangle$ of order $5^{6}$ and I want to find explicit isomorphism between them. I tried using polycyclic group presentation and it gives isomorphism, but it rewrites generators and relations in power-commutator presentation. I need to know image of generators [x1, x2, x3, x4] of group G. I tried using IsomorphismGroups(G, H), but it works too slow.
My code in GAP:

F := FreeGroup("x1", "x2", "x3", "x4");;
r1 := LeftNormedComm([F.1, F.2]);;  
r2 := LeftNormedComm([F.3, F.4]);;  
r3 := LeftNormedComm([F.1, F.4])*LeftNormedComm([F.2, F.3]);;  
r4 := LeftNormedComm([F.2, F.4])*LeftNormedComm([F.1, F.3])^(-2);;  
r4_ := LeftNormedComm([F.2, F.4])*LeftNormedComm([F.1, F.3])^(-3);;  
r5 := F.1^5;;  
r6 := F.2^5;;  
r7 := F.3^5;;  
r8 := F.4^5;;  
r9 := LeftNormedComm([F.1, F.3, F.1]);;  
r10 := LeftNormedComm([F.1, F.3, F.2]);;  
r11 := LeftNormedComm([F.1, F.3, F.3]);;  
r12 := LeftNormedComm([F.1, F.3, F.4]);;  
r13 := LeftNormedComm([F.1, F.4, F.1]);;  
r14 := LeftNormedComm([F.1, F.4, F.2]);;  
r15 := LeftNormedComm([F.1, F.4, F.3]);;  
r16 := LeftNormedComm([F.1, F.4, F.4]);;  
G := F/[r1, r2, r3, r4, r5, r6, r7, r8, r9, r10, r11, r12, r13, r14, r15, r16];;  
H := F/[r1, r2, r3, r4_, r5, r6, r7, r8, r9, r10, r11, r12, r13, r14, r15, r16];;

Best Answer

First, working with groups as finitely presented groups is usually the slowest way for calculations. For $p$-groups a polycyclic presentation is often more effective. You can use the operation IsomorphismPcGroup, or (in the case of $p$-groups EpimorphismPGroup, to keep track of elements:

gap> homG:=EpimorphismPGroup(G,5,6);
[ x1, x2, x3, x4 ] -> [ a1, a2, a3, a4 ]
gap> homH:=EpimorphismPGroup(H,5,6);
[ x1, x2, x3, x4 ] -> [ a1, a2, a3, a4 ]
gap> GP:=Image(homG,G);
<pc group of size 15625 with 6 generators>
gap> HP:=Image(homH,H);
<pc group of size 15625 with 6 generators>

Secondly, $p$-group isomorphism, in particular for the given orders, is hard. The most effective way of doing it is probably by using the standard presentation routine from the anupq package.

gap> LoadPackage("anupq");

This can be done using the function below, that will be added to the next GAP release.

With this we can calculate an isomorphism, and if desired pull back to the original group:

gap> iso:=IsomorphismPGroups(GP,HP);
gap> invmap:=InverseGeneralMapping(homH);
[ a1, a2, a3, a4 ] -> [ x1, x2, x3, x4 ]
gap> SetIsBijective(invmap,true);
gap> homG*iso*invmap;
[ x1, x2, x3, x4 ] ->
[ x1*x3^2*x4*(x1^-1*x3^-1*x1*x3)^16*(x2^-1*x3^-1*x2*x3)^8,
  x2^3*x3^4*x4^4*(x1^-1*x3^-1*x1*x3)^3*x1^-1*x3^-1*x1*(x3*x2^-1*x3^-1*x2)^12*\
x3, x1^2*x2^4*x4^2*(x2^-1*x3^-1*x2*x3)^16,
  x1*x2^4*x3*(x3*x1^-1*x3^-1*x1)^4*(x3*x2^-1*x3^-1*x2)^16*x3

You might prefer your elements shortened if possible. This can be done by first forcing reduction for H, before taking the product of maps:

gap> SetReducedMultiplication(H); #This takes a while
gap> homG*iso*invmap;
[ x1, x2, x3, x4 ] -> [ x4*x3*x2^2*x1^3*x3*x2^3*x1^3, x4^4*x3^2*(x3*x2^4)^2,
  x4^2*x3^4*x2^2*x1^4*x3*x2^2*x1^3, x3*x2^4*x1*x3

The new function:

IsomorphismPGroups:=function(G,H)
local s,p,eG,eH,fG,fH,pc,imgs;
  s:=Size(G);
  if Size(H)<>s then return fail;fi;
  p:=Collected(Factors(s));
  if Length(p)>1 then TryNextMethod();fi;
  p:=p[1][1];
  eG:=CallFuncList(ValueGlobal("EpimorphismPqStandardPresentation"),[G]:
    Prime:=p);
  eH:=CallFuncList(ValueGlobal("EpimorphismPqStandardPresentation"),[H]:
    Prime:=p);

  # check presentations
  fG:=Range(eG);
  fH:=Range(eH);
  if List(RelatorsOfFpGroup(fG),
    x->MappedWord(x,FreeGeneratorsOfFpGroup(fG),FreeGeneratorsOfFpGroup(fH)))
      <>RelatorsOfFpGroup(fH) then
    return fail;
  fi;

  # move to pc pres
  pc:=PcGroupFpGroup(fG);

  # new maps to pc
  imgs:=List(MappingGeneratorsImages(eG)[2],
    x->MappedWord(UnderlyingElement(x),
      FreeGeneratorsOfFpGroup(fG),GeneratorsOfGroup(pc)));
  eG:=GroupHomomorphismByImages(G,pc,MappingGeneratorsImages(eG)[1],imgs);

  imgs:=List(MappingGeneratorsImages(eH)[2],
    x->MappedWord(UnderlyingElement(x),
      FreeGeneratorsOfFpGroup(fH),GeneratorsOfGroup(pc)));
  eH:=GroupHomomorphismByImages(H,pc,MappingGeneratorsImages(eH)[1],imgs);

  return AsGroupGeneralMappingByImages(eG*InverseGeneralMapping(eH));
end;
Related Question