/usr/share/gap/lib/ghomfp.gi

#############################################################################
##
#W  ghomfp.gi                   GAP library                  Alexander Hulpke
##
#Y  (C) 2000 School Math and Comp. Sci., University of St Andrews, Scotland
#Y  Copyright (C) 2002 The GAP Group
##

#############################################################################
##
##  methods for homomorphisms that map the standard generators -- no
##  rewriting necessary

#############################################################################
##
#M  ImagesRepresentative( <hom>, <elm> )
##
InstallMethod( ImagesRepresentative,
  "map from fp group or free group, use 'MappedWord'",
  FamSourceEqFamElm, [ IsFromFpGroupStdGensGeneralMappingByImages,
          IsMultiplicativeElementWithInverse ], 0,
function( hom, elm )
local mapi;
  mapi:=MappingGeneratorsImages(hom);
  return MappedWord(elm,mapi[1],mapi[2]);
end);


#############################################################################
##
#M  IsSingleValued
##
InstallMethod( IsSingleValued,
  "map from fp group or free group on arbitrary gens: rewrite",
  true,
  [IsFromFpGroupGeneralMappingByImages and HasMappingGeneratorsImages],0,
function(hom)
local m, fp, s, sg, o, gi;
  m:=MappingGeneratorsImages(hom);
  fp:=IsomorphismFpGroupByGenerators(Source(hom),m[1]);
  s:=Image(fp);
  sg:=FreeGeneratorsOfFpGroup(s);
  o:=One(Range(hom));
  gi:=m[2];
  return ForAll(RelatorsOfFpGroup(s),i->MappedWord(i,sg,gi)=o);
end);

InstallMethod( IsSingleValued,
  "map from whole fp group or free group, given on std. gens: test relators",
  true,
  [IsFromFpGroupStdGensGeneralMappingByImages],0,
function(hom)
local s,sg,o,gi;
  s:=Source(hom);
  if not IsWholeFamily(s) then
    TryNextMethod();
  fi;
  if IsFreeGroup(s) then
    return true;
  fi;
  sg:=FreeGeneratorsOfFpGroup(s);
  o:=One(Range(hom));
  # take the images corresponding to the free gens in case of reordering or
  # duplicates
  gi:=MappingGeneratorsImages(hom)[2]{hom!.genpositions};
  return ForAll(RelatorsOfFpGroup(s),i->MappedWord(i,sg,gi)=o);
end);

InstallMethod( IsSingleValued,
  "map from whole fp group or free group to perm, std. gens: test relators",
  true,
  [IsFromFpGroupStdGensGeneralMappingByImages and 
   IsToPermGroupGeneralMappingByImages],0,
function(hom)
local s, bas, sg, o, gi, l, p, rel, start, i;
  s:=Source(hom);
  if not IsWholeFamily(s) then
    TryNextMethod();
  fi;
  if IsFreeGroup(s) then
    return true;
  fi;
  bas:=BaseStabChain(StabChainMutable(Range(hom)));
  sg:=FreeGeneratorsOfFpGroup(s);
  o:=One(Range(hom));
  # take the images corresponding to the free gens in case of reordering or
  # duplicates
  gi:=MappingGeneratorsImages(hom)[2]{hom!.genpositions};
  for rel in RelatorsOfFpGroup(s) do
    l:=LetterRepAssocWord(rel);
    for start in bas do
      p:=start;
      for i in l do
	if i>0 then
	  p:=p^gi[i];
	else
	  p:=p/gi[-i];
	fi;
      od;
      if p<>start then
	return false;
      fi;
    od;
  od;
  return true;
end);


#############################################################################
##
#M  KernelOfMultiplicativeGeneralMapping( <hom> )
##
InstallMethod( KernelOfMultiplicativeGeneralMapping,
  "from fp/free group, std. gens., to perm group",
  true, [ IsFromFpGroupGeneralMapping
	  and IsToPermGroupGeneralMappingByImages ],0,
function(hom)
local f,p,t,orbs,o,cor,u,frg;

  f:=Source(hom);
  if not (HasIsWholeFamily(f) and IsWholeFamily(f)) then
    TryNextMethod();
  fi;
  frg:=FreeGeneratorsOfFpGroup(f);
  t:=List(GeneratorsOfGroup(f),i->Image(hom,i));
  p:=SubgroupNC(Range(hom),t);
  Assert(1,GeneratorsOfGroup(p)=t);
  # construct coset table
  t:=[];
  orbs:=OrbitsDomain(p,MovedPoints(p));
  cor:=f;

  for o in orbs do
    u:=SubgroupOfWholeGroupByQuotientSubgroup(FamilyObj(f),
         p,Core(p,Stabilizer(p,o[1])));
    cor:=Intersection(cor,u);
  od;

  if IsIdenticalObj(cor,f) then # in case we get a wrong parent
    SetIsNormalInParent(cor,true);
  fi;
  return cor;
end);


#############################################################################
##
## methods for arbitrary mappings. We must use rewriting.
##

#############################################################################
##
#F  SecondaryImagesAugmentedCosetTable(<aug>,<gens>,<genimages>) 
##
InstallGlobalFunction(SecondaryImagesAugmentedCosetTable,function(aug)
local si,sw,i,ug,tt,p;
  if not IsBound(aug.secondaryImages) then
    # set the secondary generators images
    si:=[];
    ug:=List(aug.homgens,UnderlyingElement);
    tt:=GeneratorTranslationAugmentedCosetTable(aug);
    sw:=SecondaryGeneratorWordsAugmentedCosetTable(aug);
    for i in [1..Length(tt)] do
      # get the word representative for the secondary generator
      p:=Position(ug,UnderlyingElement(sw[i]));
      if p<>fail then
	Add(si,aug.homgenims[p]);
      else
	# its not. We must map the image from the primary generators images.
	# For this we use that their images must be given already in `si', as
	# the primary generators come first.
	Add(si,MappedWord(tt[i],aug.primarySubgroupGenerators,
			  si{[1..Length(aug.primarySubgroupGenerators)]}));
      fi;
    od;
    aug.secondaryImages:=si;
  fi;
  return aug.secondaryImages;
end);

# test whether evaluating all the secondary images might be sensible.
InstallGlobalFunction(TrySecondaryImages,function(aug)
local p;
  p:=aug.primaryImages;
  if Length(p)>0 and (
    # would it cost too much storage, to store all secondary generators?
    (IsPerm(p[1]) and ForAll(p,i->LargestMovedPoint(i)<50)) or
    (IsNBitsPcWordRep(p[1])) ) then
    aug.secondaryImages:=ShallowCopy(p);
  fi;
end);

#############################################################################
##
#M  CosetTableFpHom(<hom>) 
##
InstallMethod(CosetTableFpHom,"for fp homomorphisms",true,
  [ IsFromFpGroupGeneralMappingByImages and IsGroupGeneralMappingByImages],0,
function(hom)
local u,aug,hgu,mapi;
  # source group with suitable generators
  u:=Source(hom);
  aug:=false;
  mapi:=MappingGeneratorsImages(hom);
  hgu:=List(mapi[1],UnderlyingElement);
  # try to re-use an existing augmented coset table:
  aug:=AugmentedCosetTableInWholeGroup(u,mapi[1]);
  if not IsSubset(hgu,aug.primaryGeneratorWords) then
    # we don't know what to do with the extra primary words, so enforce MTC
    # version
    aug:=AugmentedCosetTableMtcInWholeGroup(
           SubgroupNC(FamilyObj(u)!.wholeGroup,mapi[1]));
  fi;
  # as we add homomorphism specific entries, lets be safe and copy.
  aug:=CopiedAugmentedCosetTable(aug);

  aug.homgens:=mapi[1];
  aug.homgenims:=mapi[2];

  # assign the primary generator images
  aug.primaryImages:=List(aug.primaryGeneratorWords,
                          i->aug.homgenims[Position(hgu,i)]);

  TrySecondaryImages(aug);

  return aug;
end);

#############################################################################
##
#M  ImagesRepresentative( <hom>, <elm> )
##
InstallMethod( ImagesRepresentative, "map from (sub)fp group, rewrite",
  FamSourceEqFamElm, 
  [ IsFromFpGroupGeneralMappingByImages and IsGroupGeneralMappingByImages,
    IsMultiplicativeElementWithInverse ], 0,
function( hom, word )
local aug,si,r,i,j,tt,ct,cft,c,f,g,ind,e;
  # get a coset table
  aug:=CosetTableFpHom(hom);
  r:=One(Range(hom));

  if IsBound(aug.secondaryImages) then
    si:=aug.secondaryImages;
  elif IsBound(aug.primaryImages) then
    si:=aug.primaryImages;
  else
    Error("no decoding possible");
  fi;

  # instead of calling `RewriteWord', we rewrite locally in the images.
  # this ought to be a bit faster and better on memory.
  ct := aug.cosetTable;
  cft := aug.cosetFactorTable;

  # translation table for group generators to numbers
  if not IsBound(aug.transtab) then
    # should do better, also cope with inverses
    aug.transtab:=List(aug.groupGenerators,i->GeneratorSyllable(i,1));
  fi;
  tt:=aug.transtab;

  word:=UnderlyingElement(word);
  c:=1; # current coset

  if not IsLetterAssocWordRep(word) then
    # syllable version
    for i in [1..NrSyllables(word)] do
      g:=GeneratorSyllable(word,i);
      e:=ExponentSyllable(word,i);
      if e<0 then
	ind:=2*aug.transtab[g];
	e:=-e;
      else
	ind:=2*aug.transtab[g]-1;
      fi;
      for j in [1..e] do
	# apply the generator, collect cofactor
	f:=cft[ind][c]; # cofactor
	if f>0 then
	  r:=r*DecodedTreeEntry(aug.tree,si,f);
	elif f<0 then
	  r:=r/DecodedTreeEntry(aug.tree,si,-f);
	fi;
	c:=ct[ind][c]; # new coset number
      od;
    od;

  else
    # letter version
    word:=LetterRepAssocWord(word);
    for i in [1..Length(word)] do
      g:=word[i];
      if g<0 then
	g:=-g;
	ind:=2*aug.transtab[g];
      else
	ind:=2*aug.transtab[g]-1;
      fi;

      # apply the generator, collect cofactor
      f:=cft[ind][c]; # cofactor
      if f>0 then
	r:=r*DecodedTreeEntry(aug.tree,si,f);
      elif f<0 then
	r:=r/DecodedTreeEntry(aug.tree,si,-f);
      fi;
      c:=ct[ind][c]; # new coset number

    od;
  fi;

  # make sure we got back to start
  if c<>1 then 
    Error("<elm> is not contained in the source group");
  fi;

  return r;

end);


InstallMethod( ImagesRepresentative,
  "simple tests on equal words to check whether the `generators' are mapped",
  FamSourceEqFamElm,
  [ IsFromFpGroupGeneralMappingByImages and IsGroupGeneralMappingByImages,
    IsMultiplicativeElementWithInverse ], 
  # this is a better method than the previous, as it will probably avoid
  # rewriting.
    1,
function( hom, elm )
local he,ue,p,mapi;
  ue:=UnderlyingElement(elm);
  if IsLetterAssocWordRep(ue) and IsOne(ue) then
    return One(Range(hom));
  fi;
  mapi:=MappingGeneratorsImages(hom);
  p:=PositionProperty(mapi[1],i->IsIdenticalObj(UnderlyingElement(i),ue));
  if p<>fail then
    return mapi[2][p];
  fi;
  ue:=ue^-1;
  p:=PositionProperty(mapi[1],i->IsIdenticalObj(UnderlyingElement(i),ue));
  if p<>fail then
    return mapi[2][p]^-1;
  fi;
  TryNextMethod();
end);

#############################################################################
##
#M  KernelOfMultiplicativeGeneralMapping( <hom> )
##
InstallMethod( KernelOfMultiplicativeGeneralMapping, "hom from fp grp", true,
 [ IsFromFpGroupGeneralMapping and IsGroupGeneralMapping], 0,
function(hom)
local k;
  k:=PreImage(hom,TrivialSubgroup(Range(hom)));

  if HasIsSurjective(hom) and IsSurjective( hom ) and 
     HasIndexInWholeGroup( Source(hom) ) 
     and HasRange(hom) # surjective action homomorphisms do not store
                       # the range by default
     and HasSize( Range( hom ) ) then
          SetIndexInWholeGroup( k, 
                 IndexInWholeGroup( Source(hom) ) * Size( Range(hom) ));
  fi;
  return k;
end);

#############################################################################
##
#M  CoKernelOfMultiplicativeGeneralMapping( <hom> )
##
InstallMethod( CoKernelOfMultiplicativeGeneralMapping, "GHBI from fp grp", true,
 [ IsFromFpGroupGeneralMappingByImages 
   and IsGroupGeneralMappingByImages ], 0,
function(map)
local so,fp,isofp,rels,mapi;
  # the mapping is on the std. generators. So we just have to evaluate the
  # relators in the generators on the genimages and take the normal closure.
  so:=Source(map);
  mapi:=MappingGeneratorsImages(map);
  isofp:=IsomorphismFpGroupByGeneratorsNC(so,mapi[1],"F");
  fp:=Range(isofp);
  rels:=RelatorsOfFpGroup(fp);
  rels:=List(rels,i->MappedWord(i,FreeGeneratorsOfFpGroup(fp),mapi[2]));
  return NormalClosure(Range(map),SubgroupNC(Range(map),rels));
end);

BindGlobal("WreathElm",function(b,l,m)
local n,ran,r,d,p,i,j;
  n:=Length(l);
  ran:=[1..b];
  r:=0;
  d:=[];
  p:=[];
  # base bit
  for i in [1..n] do
    for j in ran do
      p[r+j]:=r+j^l[i];
    od;
    Add(d,ran+r);
    r:=r+b;
  od;
  # permuter bit
  p:=PermList(p)/PermList(Concatenation(Permuted(d,m)));
  return p;
end);

InstallGlobalFunction(KuKGenerators,
function(G,beta,alpha)
local q,r,tg,dtg,pemb,ugens,g,gi,d,o,gens,genims,i,gr,img,l,mapi;
  q:=Range(beta);
  d:=NrMovedPoints(q);
  # transversal (sorted)

  #better: orbit algo
  #r:=ShallowCopy(RightTransversal(q,qu));
  #Sort(r,function(a,b) return 1^a<1^b;end);
  #r:=List(r,i->PreImagesRepresentative(beta,i));

  # compute transversal with short words from orbit algorithm on points
  o:=[1];
  mapi:=MappingGeneratorsImages(beta);
  gens:=mapi[1];
  genims:=mapi[2];
  gr:=[1..Length(gens)];
  r:=[One(gens[1])];
  i:=1;
  while i<=Length(o) do
    for g in gr do
      img:=o[i]^genims[g];
      if not img in o then
        Add(o,img);
	Add(r,r[i]*gens[g]);
      fi;
    od;
    i:=i+1;
  od;
  SortParallel(o,r); # indices in right position -- this *is* important
        # because we use the index to get the transversal representative!

  tg:=Range(alpha);
  if IsPermGroup(tg) then
    pemb:=IdentityMapping(tg);
    dtg:=LargestMovedPoint(Range(pemb));
  elif Size(tg)<20 then
    pemb:=IsomorphismPermGroup(tg);
    dtg:=LargestMovedPoint(Range(pemb));
  else
    pemb:=IdentityMapping(tg);
    dtg:=-1;
  fi;
  if dtg=0 then
    dtg:=1; # the darn trivial group again.
  fi;

  # images of the generators in the wreath
  ugens:=[];
  for g in GeneratorsOfGroup(G) do
    gi:=ImagesRepresentative(beta,g);
    l:=[];
    for i in [1..d] do
      l[i]:=ImagesRepresentative(pemb,
		       ImagesRepresentative(alpha,r[i]*g/r[i^gi]));
    od;
    Add(ugens,WreathElm(dtg,l,gi) );
  od;
  return ugens;
end);

#############################################################################
##
#M  InducedRepFpGroup(<hom>,<u> )
##
##  induce <hom> def. on <u> up to the full group
BindGlobal("InducedRepFpGroup",function(thom,s)
local t,w,c,q,chom,tg,hi,u;
  w:=FamilyObj(s)!.wholeGroup;

  # permutation action on the cosets
  c:=CosetTableInWholeGroup(s); 
  c:=List(c{[1,3..Length(c)-1]},PermList);
  q:=Group(c,());  # `c' arose from `PermList'
  chom:=GroupHomomorphismByImagesNC(w,q,GeneratorsOfGroup(w),c);

  if Size(q)=1 then
    # degenerate case
    return thom;
  else
    u:=KuKGenerators(w,chom,thom);
  fi;
  q:=GroupWithGenerators(u,());  # `u' arose from `KuKGenerators'
  return GroupHomomorphismByImagesNC(w,q,GeneratorsOfGroup(w),u);
end);

BindGlobal("IsTransPermStab1",function(G,U)
  return IsPermGroup(G) and IsTransitive(G,MovedPoints(G)) 
    and (1 in MovedPoints(G)) and Length(Orbit(U,1))=1
    and Size(G)/Size(U)=Length(MovedPoints(G));
end);

#############################################################################
##
#M  PreImagesSet( <hom>, <u> )
##
InstallMethod( PreImagesSet, "map from (sub)group of fp group",
  CollFamRangeEqFamElms,
  [ IsFromFpGroupHomomorphism,IsGroup ],0,
function(hom,u)
local s,t,p,w,c,q,chom,tg,thom,hi,i,lp,max;
  s:=Source(hom);
  if HasIsWholeFamily(s) and IsWholeFamily(s) then
    t:=List(GeneratorsOfGroup(s),i->Image(hom,i));
    if IsPermGroup(Range(hom)) and LargestMovedPoint(t)<>NrMovedPoints(t) then
      c:=MappingPermListList(MovedPoints(t),[1..NrMovedPoints(t)]);
      t:=List(t,i->i^c);
      u:=u^c;
    else
      c:=false;
    fi;
    p:=GroupWithGenerators(t);
    if HasImagesSource(hom) and HasSize(Image(hom)) then
      SetSize(p,Size(Image(hom)));
    fi;
    if c=false then
      SetParent(p,Range(hom));
    fi;
    if HasIsSurjective(hom) and IsSurjective(hom) then
      SetIndexInParent(p,1);
    fi;
    return SubgroupOfWholeGroupByQuotientSubgroup(FamilyObj(s),p,u);
  fi;

  w:=FamilyObj(s)!.wholeGroup;

  # permutation action on the cosets
  if IsBound(s!.quot) and IsTransPermStab1(s!.quot,s!.sub) then
    q:=s!.quot;
    c:=GeneratorsOfGroup(q);
  else
    c:=CosetTableInWholeGroup(s); 
    c:=List(c{[1,3..Length(c)-1]},PermList);
    q:=Group(c,());  # `c' arose from `PermList'
    if IsBound(s!.quot) and HasSize(s!.quot) then
      # transfer size information
      StabChainOp(q,rec(limit:=Size(s!.quot)));
    fi;
  fi;

  chom:=GroupHomomorphismByImagesNC(w,q,GeneratorsOfGroup(w),c);

  # action on cosets of U
  hi:=Image(hom);
  if Index(hi,u)<>infinity then
    t:=CosetTableBySubgroup(hi,u);
    t:=List(t{[1,3..Length(t)-1]},PermList);
    tg:=Group(t,());  # `t' arose from `PermList'
    thom:=hom*GroupHomomorphismByImagesNC(hi,tg,GeneratorsOfGroup(hi),t);

    # don't use size -- could be expensive
    if ForAll(GeneratorsOfGroup(q),IsOne) then
      # degenerate case
      u:=List(GeneratorsOfGroup(w),i->ImageElm(thom,i));
      u:=GroupWithGenerators(u,());
    else
      u:=KuKGenerators(w,chom,thom);
      # could the group be too expensive?
      if (not IsBound(s!.quot)) or
        (IsPermGroup(s!.quot)
	  and Size(s!.quot)>10^50 and NrMovedPoints(s!.quot)>10000) then
	t:=[];
	max:=LargestMovedPoint(u);
	for i in u do
	  #Add(t,ListPerm(i));
	  lp:=ListPerm(i);
	  while Length(lp)<max do Add(lp,Length(lp)+1);od;
	  Add(t,lp);
	  #Add(t,ListPerm(i^-1));
	  lp:=ListPerm(i^-1);
	  while Length(lp)<max do Add(lp,Length(lp)+1);od;
	  Add(t,lp);
	od;
	return SubgroupOfWholeGroupByCosetTable(FamilyObj(s),t);
      fi;
      u:=GroupWithGenerators(u,());  # `u' arose from `KuKGenerators'
      # indicate wreath structure
      StabChainOp(u,rec(limit:=Size(tg)^NrMovedPoints(q)*Size(q)));
    fi;
  else
    #[hi:u] might be infinite
    u:=WreathProduct(hi,q);
    Error("infinite");
  fi;

  return SubgroupOfWholeGroupByQuotientSubgroup(FamilyObj(s),u,Stabilizer(u,1));
end);


#############################################################################
##
#M  IsConjugatorIsomorphism( <hom> )
##
InstallMethod( IsConjugatorIsomorphism,
    "for a f.p. group general mapping",
    true,
    [ IsGroupGeneralMapping ], 1,
    # There is no filter to test whether source and range of a homomorphism
    # are f.p. groups.
    # So we have to test explicitly and make this method
    # higher ranking than the default one in `ghom.gi'.
    function( hom )

    local s, r, G, genss, rep;

    s:= Source( hom );
    if not IsSubgroupFpGroup( s ) then
      TryNextMethod();
    elif not ( IsGroupHomomorphism( hom ) and IsBijective( hom ) ) then
      return false;
    elif IsEndoGeneralMapping( hom ) and IsInnerAutomorphism( hom ) then
      return true;
    fi;
    r:= Range( hom );

    # Check whether source and range are in the same family.
    if FamilyObj( s ) <> FamilyObj( r ) then
      return false;
    fi;

    # Compute a conjugator in the full f.p. group.
    G:= FamilyObj( s )!.wholeGroup;
    genss:= GeneratorsOfGroup( s );
    rep:= RepresentativeAction( G, genss, List( genss,
                    i -> ImagesRepresentative( hom, i ) ), OnTuples );

    # Return the result.
    if rep <> fail then
      Assert( 1, ForAll( genss, i -> Image( hom, i ) = i^rep ) );
      SetConjugatorOfConjugatorIsomorphism( hom, rep );
      return true;
    else
      return false;
    fi;
    end );

#############################################################################
##
#M  CompositionMapping2( <hom1>, <hom2> ) . . . . . . . . . . . .  via images
##
##  we override the method for group homomorphisms, to transfer the coset
##  table information as well.
InstallMethod( CompositionMapping2,
    "for gp. hom. and fp. hom, transferring the coset table",
    FamSource1EqFamRange2,
    [ IsGroupHomomorphism, 
      IsGroupHomomorphism and IsFromFpGroupGeneralMappingByImages and
      HasCosetTableFpHom], 0,
function( hom1, hom2 )
local map,tab,tab2,i;
  if IsNiceMonomorphism(hom2) then
    # this is unlikely, but who knows of the things to come...
    TryNextMethod();
  fi;
  if not IsSubset(Source(hom1),ImagesSource(hom2)) then
    TryNextMethod();
  fi;
  map:=MappingGeneratorsImages(hom2);
  map:=GroupGeneralMappingByImagesNC( Source( hom2 ), Range( hom1 ),
         map[1], List( map[2], img ->
	    ImagesRepresentative( hom1, img ) ) );
  SetIsMapping(map,true);
  tab:=CosetTableFpHom(hom2);
  tab2:=CopiedAugmentedCosetTable(tab);
  tab2.primaryImages:=[];
  for i in [1..Length(tab.primaryImages)] do
    if IsBound(tab.primaryImages[i]) then
      tab2.primaryImages[i]:=ImagesRepresentative(hom1,tab.primaryImages[i]);
    fi;
  od;
  TrySecondaryImages(tab2);
  SetCosetTableFpHom(map,tab2);
  return map;
end);


#############################################################################
##
##  methods for homomorphisms to fp groups.

#############################################################################
##
#M  PreImagesRepresentative
##
InstallMethod( PreImagesRepresentative,
  "hom. to standard generators of fp group, using 'MappedWord'",
  FamRangeEqFamElm,
  [IsToFpGroupHomomorphismByImages,IsMultiplicativeElementWithInverse],
  # there is no filter indicating the images are standard generators, so we
  # must rank higher than the default.
  1,
function(hom,elm)
local mapi;
  mapi:=MappingGeneratorsImages(hom);
  # check, whether we map to the standard generators
  if not (HasIsWholeFamily(Range(hom)) and IsWholeFamily(Range(hom)) and
	  Set(FreeGeneratorsOfFpGroup(Range(hom)))
	    =Set(List(GeneratorsOfGroup(Range(hom)),UnderlyingElement)) and
	  IsIdenticalObj(mapi[2],GeneratorsOfGroup(Range(hom))) and
	  ForAll(List(mapi[2],i->LetterRepAssocWord(UnderlyingElement(i))),
	  i->Length(i)=1 and i[1]>0) ) then
    TryNextMethod();
  fi;
  if Length(mapi[2])=0 then 
    mapi:=One(Source(hom));
  else
    mapi:=MappedWord(elm,mapi[2],mapi[1]);
  fi;
  return mapi;
end);

#############################################################################
##
##  methods to construct homomorphisms to fp groups
##
InstallOtherMethod(IsomorphismFpGroup,"subgroups of fp group",true,
  [IsSubgroupFpGroup,IsString],0,
function(u,str)
local aug,w,p,pres,f,fam,opt;
  if HasIsWholeFamily(u) and IsWholeFamily(u) then
    return IdentityMapping(u);
  fi;

  # catch trivial case of rank 0 group
  if Length(GeneratorsOfGroup(FamilyObj(u)!.wholeGroup))=0 then
    return IsomorphismFpGroup(FamilyObj(u)!.wholeGroup,str);
  fi;

  # get an augmented coset table from the group. Since we don't care about
  # any particular generating set, we let the function chose.
  aug:=AugmentedCosetTableInWholeGroup(u);

  Info( InfoFpGroup, 1, "Presentation with ",
    Length(aug.subgroupGenerators), " generators");

  # create a tietze object to reduce the presentation a bit
  if not IsBound(aug.subgroupRelators) then
    aug.subgroupRelators := RewriteSubgroupRelators( aug, aug.groupRelators);
  fi;

  # as the presentation might be rather long, we do not decode all secondary
  # generators and their images, but will do it ``on the fly'' when
  # rewriting.
  aug:=CopiedAugmentedCosetTable(aug);
  pres := PresentationAugmentedCosetTable( aug, "y",0# printlevel
		    ,true) ;# do not run the stupid `1or2' routine!
  opt:=TzOptions(pres);
  if ValueOption("expandLimit")<>fail then
    opt.expandLimit:=ValueOption("expandLimit");
  else
    opt.expandLimit:=108; # do not grow too much.
  fi;
  if ValueOption("eliminationsLimit")<>fail then
    opt.eliminationsLimit:=ValueOption("eliminationsLimit");
  else
    opt.eliminationsLimit:=20; # do not be too greedy
  fi;
  if ValueOption("lengthLimit")<>fail then
    opt.lengthLimit:=ValueOption("lengthLimit");
  else
    opt.lengthLimit:=Int(3/2*pres!.tietze[TZ_TOTAL]); # not too big.
  fi;

  TzOptions(pres).printLevel:=InfoLevel(InfoFpGroup); 
  TzGoGo(pres); # cleanup

  # new free group
  f:=FpGroupPresentation(pres,str);

  # images for the old primary generators
  aug.primaryImages:=Immutable(List(
        TzImagesOldGens(pres){[1..Length(aug.primaryGeneratorWords)]},
	i->MappedWord(i,GeneratorsOfPresentation(pres),GeneratorsOfGroup(f))));
  TrySecondaryImages(aug);
  # generator numbers of the new generators
  w:=List(TzPreImagesNewGens(pres),
	  i->aug.treeNumbers[Position(OldGeneratorsOfPresentation(pres),i)]);

  # and the corresponding words in the original group
  w:=List(w,i->TreeRepresentedWord(aug.primaryGeneratorWords,aug.tree,i));
  if not IsWord(One(u)) then
    fam:=ElementsFamily(FamilyObj(u));
    w:=List(w,i->ElementOfFpGroup(fam,i));
  fi;

  # write the homomorphism in terms of the image's free generators
  # (so preimages are cheap)
  f:=GroupHomomorphismByImagesNC(u,f,w,GeneratorsOfGroup(f));
  # but give it `aug' as coset table, so we will use rewriting for images
  SetCosetTableFpHom(f,aug);

  SetIsBijective(f,true);

  return f;
end);

InstallMethod(IsomorphismFpGroupByGeneratorsNC,"subgroups of fp group",
  IsFamFamX,
  [IsSubgroupFpGroup,IsList and IsMultiplicativeElementWithInverseCollection,
   IsString],0,
function(u,gens,nam)
local aug,w,p,pres,f,fam;
  if HasIsWholeFamily(u) and IsWholeFamily(u) and
    IsIdenticalObj(gens,GeneratorsOfGroup(u)) then
      return IdentityMapping(u);
  fi;
  # get an augmented coset table from the group. It must be compatible with
  # `gens', so we must always use MTC.
  if HasGeneratorsOfGroup(u) and IsIdenticalObj(GeneratorsOfGroup(u),gens) then
    aug:=AugmentedCosetTableMtcInWholeGroup(u);
  else
    w:=FamilyObj(u)!.wholeGroup;
    aug:=AugmentedCosetTableMtc(w,SubgroupNC(w,gens),2,"%");
    # do not store the generators for the subgroup (the user could do this
    # himself if he wanted), the danger of consequential errors due to a
    # wrong <gens> list is too high.
  fi;

  # force computation of words for the secondary generators
  SecondaryGeneratorWordsAugmentedCosetTable(aug);

  # create a tietze object to reduce the presentation a bit
  if not IsBound(aug.subgroupRelators) then
    aug.subgroupRelators := RewriteSubgroupRelators( aug, aug.groupRelators);
  fi;
  aug:=CopiedAugmentedCosetTable(aug);
  pres := PresentationAugmentedCosetTable( aug,nam,0,true );
  TzOptions(pres).printLevel:=InfoLevel(InfoFpGroup);
  DecodeTree(pres);

  # new free group
  f:=FpGroupPresentation(pres);
  aug.homgens:=gens;
  aug.homgenims:=GeneratorsOfGroup(f);
  aug.primaryImages:=GeneratorsOfGroup(f);
  SecondaryImagesAugmentedCosetTable(aug);

  f:=GroupHomomorphismByImagesNC(u,f,gens,GeneratorsOfGroup(f));

  # tell f, that `aug' can be used as its coset table
  SetCosetTableFpHom(f,aug);

  SetIsBijective(f,true);

  return f;
end);

#############################################################################
##
#F  IsomorphismSimplifiedFpGroup(G)
##
##
InstallMethod(IsomorphismSimplifiedFpGroup,"using tietze transformations",
  true,[IsSubgroupFpGroup],0,
function ( G )
local H, pres,map,mapi,opt;

  # check the given argument to be a finitely presented group.
  if not ( IsSubgroupFpGroup( G ) and IsGroupOfFamily( G ) ) then
      Error( "argument must be a finitely presented group" );
  fi;

  # convert the given group presentation to a Tietze presentation.
  pres := PresentationFpGroup( G, 0 );

  # perform Tietze transformations.
  opt:=TzOptions(pres);
  if ValueOption("expandLimit")<>fail then
    opt.expandLimit:=ValueOption("expandLimit");
  else
    opt.expandLimit:=120; # do not grow too much.
  fi;
  if ValueOption("eliminationsLimit")<>fail then
    opt.eliminationsLimit:=ValueOption("eliminationsLimit");
  else
    opt.eliminationsLimit:=20; # do not be too greedy
  fi;
  if ValueOption("lengthLimit")<>fail then
    opt.lengthLimit:=ValueOption("lengthLimit");
  else
    opt.lengthLimit:=Int(3*pres!.tietze[TZ_TOTAL]); # not too big.
  fi;

  if ValueOption("protected")<>fail then
    opt.expandLimit:=ValueOption("protected");
  fi;

  opt.printLevel:=InfoLevel(InfoFpGroup); 
  TzInitGeneratorImages(pres);
  TzGoGo( pres );

  # reconvert the Tietze presentation to a group presentation.
  H := FpGroupPresentation( pres );
  map:=GroupHomomorphismByImagesNC(G,H,GeneratorsOfGroup(G),
         List(TzImagesOldGens(pres),
	   i->MappedWord(i,GeneratorsOfPresentation(pres),
	                   GeneratorsOfGroup(H))));

  mapi:=GroupHomomorphismByImagesNC(H,G,GeneratorsOfGroup(H),
         List(TzPreImagesNewGens(pres),
	   i->MappedWord(i,OldGeneratorsOfPresentation(pres),
	                   GeneratorsOfGroup(G))));
  SetIsBijective(map,true);
  SetInverseGeneralMapping(map,mapi);
  SetInverseGeneralMapping(mapi,map);

  return map;
end );

#############################################################################
##
#M  NaturalHomomorphismByNormalSubgroup(<G>,<N>)
##
InstallMethod(NaturalHomomorphismByNormalSubgroupOp,
  "for subgroups of fp groups",IsIdenticalObj,
    [IsSubgroupFpGroup, IsSubgroupFpGroup],0,
function(G,N)
local T;

  # try to use rewriting if the index is not too big.
  if IndexInWholeGroup(G)>1 and IndexInWholeGroup(G)<=1000 
    and HasGeneratorsOfGroup(N) and not
    HasCosetTableInWholeGroup(N) then
    T:=IsomorphismFpGroup(G);
    return T*NaturalHomomorphismByNormalSubgroup(Image(T,G),Image(T,N));
  fi;

  if not HasCosetTableInWholeGroup(N) and not
    IsSubgroupOfWholeGroupByQuotientRep(N) then

    # try to compute a coset table
    T:=TryCosetTableInWholeGroup(N:silent:=true);
    if T=fail then
      if not (HasIsWholeFamily(G) and IsWholeFamily(G)) then
        TryNextMethod(); # can't do
      fi;
      # did not succeed - do the stupid thing
      T:=FactorGroupNC( G, GeneratorsOfGroup( N ) );
      T:=GroupHomomorphismByImagesNC(G,T,
          GeneratorsOfGroup(G),GeneratorsOfGroup(T));
      return T;
    fi;

  fi;
  return NaturalHomomorphismByNormalSubgroupNC(G,
           AsSubgroupOfWholeGroupByQuotient(N));
end);

InstallMethod(NaturalHomomorphismByNormalSubgroupOp,
  "for subgroups of fp groups by quotient rep.",IsIdenticalObj,
    [IsSubgroupFpGroup, 
     IsSubgroupFpGroup and IsSubgroupOfWholeGroupByQuotientRep ],0,
function(G,N)
local Q,B,Ggens,gens,hom;
  Q:=N!.quot;
  Ggens:=GeneratorsOfGroup(G);
  # generators of G in image
  gens:=List(Ggens,elm->
    MappedWord(UnderlyingElement(elm),
               FreeGeneratorsOfWholeGroup(N),GeneratorsOfGroup(Q)));
  B:=SubgroupNC(Q,gens);
  hom:=NaturalHomomorphismByNormalSubgroupNC(B,N!.sub);
  gens:=List(gens,i->ImageElm(hom,i));
  hom:=GroupHomomorphismByImagesNC(G,Range(hom),Ggens,gens);
  SetKernelOfMultiplicativeGeneralMapping(hom,N);
  return hom;
end);

InstallMethod(NaturalHomomorphismByNormalSubgroupOp,
  "trivial image fp case",IsIdenticalObj,
    [IsSubgroupFpGroup, 
     IsSubgroupFpGroup and IsWholeFamily ],0,
function(G,N)
local Q,Ggens,gens,hom;

  Ggens:=GeneratorsOfGroup(G);
  # generators of G in image
  gens:=List(Ggens,elm->());  # a new group is created
  Q:=GroupWithGenerators(gens);
  hom:=GroupHomomorphismByImagesNC(G,Q,Ggens,gens);
  SetKernelOfMultiplicativeGeneralMapping(hom,N);
  return hom;
end);

#########################################################
##
#M MaximalAbelianQuotient(<fp group>)
##
##
InstallMethod(MaximalAbelianQuotient,"whole fp group",
	true, [IsSubgroupFpGroup and IsWholeFamily], 0,
function(f)
local m,s,g,i,j,rel,gen,img,fin,hom,gens;

  # since f is the full group, exponent susm are in respect to its
  # generators.
  m:=List(RelatorsOfFpGroup(f),w->ExponentSums(w));

  gen:=GeneratorsOfGroup(f);
  g:= FreeGroup( Length( gen ) );
  gen:=GeneratorsOfGroup(g);

  rel:=[];
  for i in [1..Length(gen)-1] do
    for j in [i+1..Length(gen)] do
      Add(rel, Comm(gen[i],gen[j]));
    od;
  od;

  if Length(m)>0 then  
    s:=NormalFormIntMat(m,25); # 9+16: SNF with transforms, destructive
    SetAbelianInvariants(f,AbelianInvariantsOfList(DiagonalOfMat(s.normal)));
   
    if Length(m[1])>s.rank then
      for i in [1..s.rank] do  
        Add(rel,g.(i)^s.normal[i][i]);
      od;
      g:=g/rel;
      fin:=false;
    else  
      g:=AbelianGroup(DiagonalOfMat(s.normal));
      fin:=true;
    fi;
  
    gen:=GeneratorsOfGroup(g);
    s:=s.coltrans;
    img:=[];
    for i in [1..Length(s)] do
      m:=Identity(g);
      for j in [1..Length(gen)] do
        m:=m*gen[j]^s[i][j];
      od;
      Add(img,m);
    od;
  else 
    g:=g/rel;
    fin:=Length(gen)=0;
    img:=GeneratorsOfGroup(g);
  fi;

  SetIsFinite(g,fin);
  SetIsAbelian(g,true);

  hom:=GroupHomomorphismByImagesNC(f,g,GeneratorsOfGroup(f),img);
  SetIsSurjective(hom,true);
  return hom;
end);

InstallMethod(MaximalAbelianQuotient,
        "for subgroups of finitely presented groups",
	true, [IsSubgroupFpGroup], 0,
function(U)
local phi,m;
  phi:=IsomorphismFpGroup(U);
  m:=MaximalAbelianQuotient(Image(phi));
  SetAbelianInvariants(U,AbelianInvariants(Image(phi)));
  return phi*MaximalAbelianQuotient(Image(phi));
end);

# u must be a subgroup of the image of home
InstallGlobalFunction(
LargerQuotientBySubgroupAbelianization,function(hom,u)
local v,ma,mau,a,gens,imgs,q,k,co,aiu,aiv,primes,irrel;
  v:=PreImage(hom,u);
  aiv:=AbelianInvariants(v);
  aiu:=AbelianInvariants(u);
  if aiu=aiv then
    return fail;
  fi;
  # are there irrelevant primes?
  primes:=Set(Factors(Product(aiu)*Product(aiv)));
  irrel:=Filtered(primes,x->Filtered(aiv,z->IsInt(z/x))=
                            Filtered(aiu,z->IsInt(z/x)));

  Info(InfoFpGroup,1,"Larger by factor ",
    Product(AbelianInvariants(v))/Product(AbelianInvariants(u)),"\n");
  ma:=MaximalAbelianQuotient(v);
  mau:=MaximalAbelianQuotient(u);
  a:=Image(ma);
  k:=TrivialSubgroup(a);
  for primes in irrel do
    k:=ClosureGroup(k,GeneratorsOfGroup(SylowSubgroup(a,primes)));
  od;
  if Size(k)>1 then
    ma:=ma*NaturalHomomorphismByNormalSubgroup(a,k);
    a:=Image(ma);
    k:=TrivialSubgroup(Image(mau));
    for primes in irrel do
      k:=ClosureGroup(k,GeneratorsOfGroup(SylowSubgroup(Image(mau),primes)));
    od;
    mau:=mau*NaturalHomomorphismByNormalSubgroup(Image(mau),k);
  fi;

  gens:=SmallGeneratingSet(a);
  imgs:=List(gens,x->Image(mau,Image(hom,PreImagesRepresentative(ma,x))));
  q:=GroupHomomorphismByImages(a,Image(mau),gens,imgs);
  k:=KernelOfMultiplicativeGeneralMapping(q);
  co:=ComplementClassesRepresentatives(a,k);
  if Length(co)=0 then
    co:=List(ConjugacyClassesSubgroups(a),Representative);
    co:=Filtered(co,x->Size(Intersection(k,x))=1);
    Sort(co,function(a,b) return Size(a)>Size(b);end);
  fi;
  Info(InfoFpGroup,2,"Degree larger ",Index(a,co[1]),"\n");
  return PreImage(ma,co[1]);
end);

DeclareRepresentation("IsModuloPcgsFpGroupRep",
  IsModuloPcgs and IsPcgsDefaultRep, [ "hom", "impcgs", "groups" ] );


InstallMethod(ModuloPcgs,"subgroups fp",true,
  [IsSubgroupFpGroup,IsSubgroupFpGroup],0,
function(M,N)
local hom,pcgs,impcgs;
  hom:=NaturalHomomorphismByNormalSubgroupNC(M,N);
  hom:=hom*IsomorphismSpecialPcGroup(Image(hom,M));
  impcgs:=FamilyPcgs(Image(hom,M));
  pcgs:=PcgsByPcSequenceCons(IsPcgsDefaultRep,IsModuloPcgsFpGroupRep,
          ElementsFamily(FamilyObj(M)),
	  List(impcgs,i->PreImagesRepresentative(hom,i)),
	  []
	  );
  pcgs!.hom:=hom;
  pcgs!.impcgs:=impcgs;
  pcgs!.groups:=[M,N];
  if IsFiniteOrdersPcgs(impcgs) then
    SetIsFiniteOrdersPcgs(pcgs,true);
  fi;
  if IsPrimeOrdersPcgs(impcgs) then
    SetIsPrimeOrdersPcgs(pcgs,true);
  fi;
  return pcgs;
end);

InstallMethod(NumeratorOfModuloPcgs,"fp",true,[IsModuloPcgsFpGroupRep],0,
  p->GeneratorsOfGroup(p!.groups[1]));

InstallMethod(DenominatorOfModuloPcgs,"fp",true,[IsModuloPcgsFpGroupRep],0,
  p->GeneratorsOfGroup(p!.groups[2]));

InstallMethod(RelativeOrders,"fp",true,[IsModuloPcgsFpGroupRep],0,
  p->RelativeOrders(p!.impcgs));

InstallMethod(RelativeOrderOfPcElement,"fp",IsCollsElms,
  [IsModuloPcgsFpGroupRep,IsMultiplicativeElementWithInverse],0,
function(p,e)
  return RelativeOrderOfPcElement(p!.impcgs,ImagesRepresentative(p!.hom,e));
end);

InstallMethod(ExponentsOfPcElement,"fp",IsCollsElms,
  [IsModuloPcgsFpGroupRep,IsMultiplicativeElementWithInverse],0,
function(p,e)
  return ExponentsOfPcElement(p!.impcgs,ImagesRepresentative(p!.hom,e));
end);

InstallMethod(EpimorphismFromFreeGroup,"general",true,
  [IsGroup and HasGeneratorsOfGroup],0,
function(G)
local F,str;
  str:=ValueOption("names");
  if IsList(str) and ForAll(str,IsString) and
    Length(str)=Length(GeneratorsOfGroup(G)) then
    F:=FreeGroup(str);
  else
    if not IsString(str) then
      str:="x";
    fi;
    F:=FreeGroup(Length(GeneratorsOfGroup(G)),str);
  fi;
  return 
    GroupHomomorphismByImagesNC(F,G,GeneratorsOfGroup(F),GeneratorsOfGroup(G));
end);

#############################################################################
##
#E
##
gap-libs 4r6p5-3 / usr / share / gap / lib / ghomfp.gi
