#############################################################################
##
#W  pcgs.gi                     GAP Library                      Frank Celler
##
#H  @(#)$Id: pcgs.gi,v 4.100.2.1 2002/10/29 09:48:27 werner Exp $
##
#Y  Copyright (C)  1996,  Lehrstuhl D fuer Mathematik,  RWTH Aachen,  Germany
#Y  (C) 1998 School Math and Comp. Sci., University of St.  Andrews, Scotland
#Y  Copyright (C) 2002 The GAP Group
##
##  This file contains the methods for polycylic generating systems.
##
Revision.pcgs_gi :=
    "@(#)$Id: pcgs.gi,v 4.100.2.1 2002/10/29 09:48:27 werner Exp $";

#############################################################################
##
#M  Pcgs( <A> ) . . . . . . . .  from independent generators of abelian group
##
InstallGlobalFunction( PcgsByIndependentGeneratorsOfAbelianGroup, function( A )
    local   pcgs,  pcs,  rel,  gen,  f;
    
    pcs := [  ];
    rel := [  ];
    for gen  in IndependentGeneratorsOfAbelianGroup( A )  do
        for f  in FactorsInt( Order( gen ) )  do
            Add( pcs, gen );
            Add( rel, f );
            gen := gen ^ f;
        od;
    od;
    pcgs := PcgsByPcSequenceNC( FamilyObj( One( A ) ), pcs );
    SetOneOfPcgs( pcgs, One( A ) );
    SetRelativeOrders( pcgs, rel );
    SetIsPrimeOrdersPcgs( pcgs, true );
    return pcgs;
end );

InstallMethod( Pcgs, "from independent generators of abelian group", true,
    [ IsGroup and IsAbelian and HasIndependentGeneratorsOfAbelianGroup ], 0,
function(A)
  if HasHomePcgs(A) then
    TryNextMethod();
  else
    return PcgsByIndependentGeneratorsOfAbelianGroup(A);
  fi;
end);

#############################################################################
##
#M  SetPcgs( <G>, fail )  . . . . . . . . . . . . . . . . .  never set `fail'
##
##  `HasPcgs' implies  `CanEasilyComputePcgs',  which implies `IsSolvable',
##  so a  pcgs cannot be set for insoluble permutation groups.
##  As Pcgs may return 'fail' for insolvable permutation groups, this method
##  is necessary.
##
InstallMethod( SetPcgs, true, [ IsGroup, IsBool ], 0,
function( G, failval )
    SetIsSolvableGroup( G, false );
end );


#############################################################################
##
#M  IsBound[ <pos> ]
##
InstallMethod( IsBound\[\],
    "pcgs",
    true,
    [ IsPcgs,
      IsPosInt ],
    0,

function( pcgs, pos )
    return pos <= Length(pcgs);
end );


#############################################################################
##
#M  Length( <pcgs> )
##
InstallMethod( Length,
    "pcgs",
    true,
    [ IsPcgs and IsPcgsDefaultRep ],
    0,
    pcgs -> Length(pcgs!.pcSequence) );

#############################################################################
##
#M  AsList( <pcgs> )
##
InstallMethod( AsList, "pcgs", true,
    [ IsPcgs and IsPcgsDefaultRep ], 0,
    pcgs -> pcgs!.pcSequence );

#############################################################################
##
#M  Position( <pcgs>, <elm>, <from> )
##
InstallMethod( Position,
    "pcgs, object, int",
    true,
    [ IsPcgs and IsPcgsDefaultRep,
      IsObject,
      IsInt ],
    0,

function( pcgs, obj, from )
    return Position( pcgs!.pcSequence, obj, from );
end );


#############################################################################
##
#M  PrintObj( <pcgs> )
##
InstallMethod( PrintObj, "pcgs", true, [ IsPcgs and IsPcgsDefaultRep ], 0,
function(pcgs)
  Print( "Pcgs(", pcgs!.pcSequence, ")" );
end );

#############################################################################
##
#M  ViewObj( <pcgs> )
##
InstallMethod( ViewObj, "pcgs", true, [ IsPcgs and IsPcgsDefaultRep ], 0,
function(pcgs)
  Print("Pcgs(");
  View(pcgs!.pcSequence);
  Print(")");
end );


#############################################################################
##
#M  <pcgs> [ <pos> ]
##
InstallMethod( \[\],
    "pcgs, pos int",
    true,
    [ IsPcgs and IsPcgsDefaultRep,
      IsPosInt ],
    0,

function( pcgs, pos )
    return pcgs!.pcSequence[pos];
end );

#############################################################################
##
#M  <pcgs>{[ <pos> ]}
##
InstallMethod( ELMS_LIST, "pcgs, range", true, [ IsPcgs, IsDenseList ], 0,
function( pcgs, ran )
    return pcgs!.pcSequence{ran};
end );

#############################################################################
##
#M  PcgsByPcSequenceCons( <req-filter>, <imp-filter>, <fam>, <pcs> )
##
InstallMethod( PcgsByPcSequenceCons, "generic constructor", true,
    [ IsPcgsDefaultRep, IsObject, IsFamily, IsList,IsList ], 0,
function( filter, imp, efam, pcs,attl )
    local   pcgs,  fam,one;

    imp:=filter and imp;
    # if the <efam> has a family pcgs check if the are equal
    if HasDefiningPcgs(efam) and DefiningPcgs(efam) = pcs  then
      imp := imp and IsFamilyPcgs;
    fi;
    imp:=imp and HasLength;

    # construct a pcgs object
    pcgs := rec(
      pcSequence := Immutable(pcs),
      zeroVector := Immutable(ListWithIdenticalEntries(Length(pcs),0)),
      powers:=[],
      conjugates:=List(pcs,i->[]));

    # get the pcgs family
    fam := CollectionsFamily(efam);

    # set a one
    if HasOne(efam)  then
      one:=One(efam);
    elif 0 < Length(pcs)  then
      one:=One(pcs[1]);
    else
      one:=fail;
    fi;
    if one<>fail then
      attl:=Concatenation([pcgs, NewType( fam, imp and HasOneOfPcgs),
			  Length,Length(pcs),OneOfPcgs,one],attl);
    else
      attl:=Concatenation([pcgs, NewType( fam, imp ),
			  Length,Length(pcs)],attl);
    fi;

    # convert record into component object
    CallFuncList( ObjectifyWithAttributes,attl );

    # a place to cache powers
    pcgs!.pcSeqPowers:=List(pcs,i->[]);
    pcgs!.pcSeqPowersInv:=List(pcs,i->[]);

    # and return
    return pcgs;

end );


#############################################################################
##
#M  IsPrimeOrdersPcgs( <pcgs> )
##
InstallMethod( IsPrimeOrdersPcgs,
    true,
    [ IsPcgs ],
    0,

function( pcgs )
    return ForAll( RelativeOrders(pcgs), x -> IsPrimeInt(x) );
end );

#############################################################################
##
#M RefinedPcGroup( <G> )
##
InstallMethod( RefinedPcGroup, 
               "group with refined pcgs", true, [IsPcGroup], 0,
function( G )
  return Range(IsomorphismRefinedPcGroup(G));
end);

#############################################################################
##
#M IsomorphismRefinedPcGroup( <G> )
##
InstallMethod( IsomorphismRefinedPcGroup, 
               "group with refined pcgs", true, [IsPcGroup], 0,
function( G )
    local word, expo, pcgs, rels, new, ord, i, facs, g, f, n, F, gens,
          rela, w, t, H, map, j;

    word := function( exp, gens, id )
        local h, i;
        h := id;
        for i in [1..Length(exp)] do
            h := h * gens[i]^exp[i];
        od;
        return h;
    end;

    expo := function( pcgs, g, map )
        local exp, new, i, c;
        exp := ExponentsOfPcElement( pcgs, g );
        new := [];
        for i in [1..Length(exp)] do
            c := CoefficientsMultiadic( Reversed(map[i]), exp[i] );
            Append( new, Reversed( c ) );
        od;
        return new;
    end;

    # get the pcgs of G
    pcgs := Pcgs(G);
    rels := RelativeOrders( pcgs );
    if ForAll( rels, IsPrime ) then return IdentityMapping(G); fi;

    # get the refined pcgs
    new := [];
    ord := [];
    map := [];
    for i in [1..Length(pcgs)] do
        facs := FactorsInt( rels[i] );
        g    := pcgs[i];
        for f in facs do
            Add( new, g );
            Add( ord, f );
            g := g^f;
        od;
        Add( map, facs );
    od;

    # compute a group with respect to <new>
    n := Length( new );
    F := FreeGroup(IsSyllableWordsFamily, n );
    gens := GeneratorsOfGroup( F );
    rela := [];

    for i in [1..n] do
 
        # the power 
        w := gens[i]^ord[i];
        t := expo( pcgs, new[i]^ord[i], map );
        t := word( t, gens, One(F) );
        Add( rela, w/t );    
 
        for j in [i+1..n] do
            
            # the commutator
            w := Comm( gens[i], gens[j] );
            t := expo( pcgs, Comm( new[i], new[j] ), map );
            t := word( t, gens, One(F) );
            Add( rela, w/t );    
        od;
    od;

    H := F/rela;
    H:=PcGroupFpGroup( H );
    return GroupHomomorphismByImagesNC(G,H,new,FamilyPcgs(H));
end );

#############################################################################
##
#M  IsFiniteOrdersPcgs( <pcgs> )
##
InstallTrueMethod( IsFiniteOrdersPcgs, IsPrimeOrdersPcgs );

#############################################################################
##
#M  IsFiniteOrdersPcgs( <pcgs> )
##
InstallMethod( IsFiniteOrdersPcgs,
    true,
    [ IsPcgs ],
    0,

function( pcgs )
    return ForAll( RelativeOrders(pcgs), x -> x <> 0 and x <> infinity );
end );


#############################################################################
##
#M  DepthOfPcElement( <pcgs>, <elm> )
##
InstallMethod( DepthOfPcElement,
    "generic methods, ExponentsOfPcElement",
    IsCollsElms,
    [ IsPcgs,
      IsObject ],
    0,

function( pcgs, elm )
    return PositionNot( ExponentsOfPcElement( pcgs, elm ), 0 );
end );


#############################################################################
##
#M  DepthOfPcElement( <pcgs>, <elm>, <min> )
##
InstallOtherMethod( DepthOfPcElement,
    "pcgs modulo pcgs, ignoring <min>",
    function(a,b,c) return IsCollsElms(a,b); end,
    [ IsPcgs,
      IsObject,
      IsInt ],
    0,

function( pcgs, elm, min )
    local   dep;

    dep := DepthOfPcElement( pcgs, elm );
    if dep < min  then
        Error( "minimal depth <min> is incorrect" );
    fi;
    return dep;
end );


#############################################################################
##
#M  DifferenceOfPcElement( <pcgs>, <left>, <right> )
##
InstallMethod( DifferenceOfPcElement,
    "generic methods, PcElementByExponents/ExponentsOfPcElement",
    IsCollsElmsElms,
    [ IsPcgs,
      IsObject,
      IsObject ],
    0,

function( pcgs, left, right )
    return PcElementByExponentsNC( pcgs,
        ExponentsOfPcElement(pcgs,left)-ExponentsOfPcElement(pcgs,right) );
end );


#############################################################################
##
#M  ExponentOfPcElement( <pcgs>, <elm>, <pos> )
##
InstallMethod( ExponentOfPcElement,
    "generic method, ExponentsOfPcElement",
    function(F1,F2,F3) return IsCollsElms(F1,F2); end,
    [ IsPcgs,
      IsObject,
      IsPosInt ],
    0,

function( pcgs, elm, pos )
    return ExponentsOfPcElement(pcgs,elm)[pos];
end );


#############################################################################
##
#M  ExponentsOfPcElement( <pcgs>, <elm>, <poss> )
##
InstallOtherMethod( ExponentsOfPcElement,
    "with positions, falling back to ExponentsOfPcElement",
    function(F1,F2,F3) return IsCollsElms(F1,F2); end,
    [ IsPcgs,
      IsObject,
      IsList ],
    0,

function( pcgs, elm, pos )
    return ExponentsOfPcElement(pcgs,elm){pos};
end );

#############################################################################
##
#M  ExponentsOfConjugate( <pcgs>, <i>, <j> )
##
InstallMethod( ExponentsOfConjugate,"generic: compute conjugate",true,
    [ IsModuloPcgs, IsPosInt,IsPosInt], 0,
function( pcgs, i, j )
  if not IsBound(pcgs!.conjugates[i][j]) then
    pcgs!.conjugates[i][j]:=ExponentsOfPcElement(pcgs,pcgs[i]^pcgs[j]);
  fi;
  return pcgs!.conjugates[i][j];
end );

#############################################################################
##
#M  ExponentsOfRelativePower( <pcgs>, <i> )
##
InstallMethod( ExponentsOfRelativePower,"generic: compute power",true,
    [ IsModuloPcgs, IsPosInt], 0,
function( pcgs, i )
  return ExponentsOfPcElement(pcgs,pcgs[i]^RelativeOrders(pcgs)[i]);
end );

#############################################################################
##
#M  ExponentsOfCommutator( <pcgs>, <i>, <j> )
##
InstallMethod( ExponentsOfCommutator,"generic: compute commutator",true,
    [ IsModuloPcgs, IsPosInt,IsPosInt], 0,
function( pcgs, i, j )
  return ExponentsOfPcElement(pcgs,Comm(pcgs[i],pcgs[j]));
end );


#############################################################################
##
#M  HeadPcElementByNumber( <pcgs>, <elm>, <num> )
##
InstallMethod( HeadPcElementByNumber,
    "using 'ExponentsOfPcElement', 'PcElementByExponents'",
    true,
    [ IsPcgs,
      IsObject,
      IsInt ],
    0,

function( pcgs, elm, pos )
    local   exp,  i;

    exp := ShallowCopy(ExponentsOfPcElement( pcgs, elm ));
    if pos < 1  then pos := 1;  fi;
    for i  in [ pos .. Length(exp) ]  do
        exp[i] := 0;
    od;
    return PcElementByExponentsNC( pcgs, exp );
end );

#############################################################################
##
#M  ParentPcgs( <pcgs> )
##
InstallOtherMethod( ParentPcgs, true, [ IsPcgs ], 0, IdFunc );

#############################################################################
##
#M  LeadingExponentOfPcElement( <pcgs>, <elm> )
##
InstallMethod( LeadingExponentOfPcElement,
    "generic methods, ExponentsOfPcElement",
    IsCollsElms,
    [ IsPcgs,
      IsObject ],
    0,

function( pcgs, elm )
    local   exp,  dep;

    exp := ExponentsOfPcElement( pcgs, elm );
    dep := PositionNot( exp, 0 );
    if Length(exp) < dep  then
        return fail;
    else
        return exp[dep];
    fi;
end );

#############################################################################
##
#M  PcElementByExponents( <pcgs>, <empty-list> )
##
InstallGlobalFunction(PcElementByExponents,function(arg)
local i,ro;
  if Length(arg)=2 then
    if Length(arg[1])<>Length(arg[2]) then
      Error( "<list> and <pcgs> have different lengths" );
    fi;
    ro:=RelativeOrders(arg[1]);
    for i in [1..Length(ro)] do
      if ro[i]<>0 and IsRat(arg[2][i]) 
	 and (arg[2][i]<0 or arg[2][i]>=ro[i]) then
        Error("Exponent out of range!");
      fi;
    od;
    return PcElementByExponentsNC(arg[1],arg[2]);
  else
    if Length(arg[3])<>Length(arg[2]) then
      Error( "<list> and <basis> have different lengths" );
    fi;
    return PcElementByExponentsNC(arg[1],arg[2],arg[3]);
  fi;
end);

InstallMethod( PcElementByExponentsNC,
    "generic method for empty lists",
    true,
    [ IsPcgs,
      IsList and IsEmpty ],
    0,

function( pcgs, list )
    return OneOfPcgs(pcgs);
end );

#############################################################################
##
#F  PowerPcgsElement( <pcgs>, <i>,<exp> )
##
InstallGlobalFunction(PowerPcgsElement,function( pcgs, i,exp )
local l,e;
  if exp=0 then
    return OneOfPcgs(pcgs);
  elif exp>0 then
    l:=pcgs!.pcSeqPowers[i];
    e:=exp;
  else
    l:=pcgs!.pcSeqPowersInv[i];
    e:=-exp;
  fi;
  if not IsBound(l[e]) then
    l[e]:=pcgs[i]^exp;
  fi;
  return l[e];
end );

#############################################################################
##
#F  LeftQuotientPowerPcgsElement( <pcgs>, <i>,<exp> )
##
InstallGlobalFunction(LeftQuotientPowerPcgsElement,function( pcgs, i,exp,elm )
  return LeftQuotient(PowerPcgsElement(pcgs,i,exp),elm);
# the following code seemed more clever, but somehow `LeftQuotient'
# performs better. 5-5-99, AH
#local e;
#  e:=pcgs[i];
#  if NumberSyllables(UnderlyingElement(e))=1 then
#    # single pc element (or its power): LeftQuotient is clever
#    return LeftQuotient(e^exp,elm);
#  else
#    # more complicated element: rather go via the inverse power
#    return PowerPcgsElement(pcgs,i,-exp)*elm;
#  fi;
end );

#############################################################################
##
#M  LinearCombinationPcgs( <pcgs>, <list> )
##
InstallGlobalFunction(LinearCombinationPcgs,function(arg)
local pcgs,list,elm,  i;

    pcgs:=arg[1];
    list:=arg[2];
    if Length(pcgs)=0 then
      if Length(arg)>2 then
	return arg[3];
      else
	return OneOfPcgs(pcgs);
      fi;
    fi;
    elm := fail;

    for i  in [ 1 .. Length(list) ]  do
        if list[i] <> 0  then
	  if elm=fail then elm := pcgs[i] ^ Int(list[i]);
	  else elm := elm * pcgs[i] ^ Int(list[i]);fi;
        fi;
    od;
    if elm=fail then
      if Length(arg)>2 then
	return arg[3];
      else
	return One(pcgs[1]);
      fi;
    fi;

    return elm;

end );


#############################################################################
##
#M  PcElementByExponentsNC( <pcgs>, <list> )
##
InstallOtherMethod( PcElementByExponentsNC,
    "generic method: call LinearCombinationPcgs",
    true,
    [ IsList,
      IsRowVector and IsCyclotomicCollection ],
    0, LinearCombinationPcgs);

#############################################################################
##
#M  PcElementByExponentsNC( <pcgs>, <ffe-list> )
##
InstallOtherMethod( PcElementByExponentsNC, "generic method", true,
    [ IsList, IsRowVector and IsFFECollection ], 0,
function( pcgs, list )
local   elm,  i,z;

    if Length(pcgs)=0 then
      return OneOfPcgs(pcgs);
    fi;
    elm := fail;

    for i  in [ 1 .. Length(list) ]  do
      z :=IntFFE(list[i]);
      if z=1 then
	if elm=fail then elm := pcgs[i] ;
	else elm := elm * pcgs[i] ; fi;
      elif z>1 then
	if elm=fail then elm := pcgs[i] ^ z;
	else elm := elm * pcgs[i] ^ z;fi;
      fi;
    od;
    if elm=fail then elm := One(pcgs[1]);fi;

    return elm;

end );


#############################################################################
##
#M  PcElementByExponentsNC( <pcgs>, <basis>, <empty-list> )
##
InstallOtherMethod( PcElementByExponentsNC,
    "generic method for empty lists",
    true,
    [ IsPcgs,
      IsList and IsEmpty,
      IsList and IsEmpty ],
    0,

function( pcgs, basis, list )
    return OneOfPcgs(pcgs);
end );


#############################################################################
##
#M  PcElementByExponentsNC( <pcgs>, <basis>, <list> )
##
InstallOtherMethod( PcElementByExponentsNC,"multiply basis elements",
    IsFamFamX, [ IsPcgs, IsList, IsRowVector and IsCyclotomicCollection ], 0,
function( pcgs, basis, list )
local   elm,  i;

    elm := OneOfPcgs(pcgs);

    for i  in [ 1 .. Length(list) ]  do
        if list[i] <> 0  then
            elm := elm * basis[i] ^ list[i];
        fi;
    od;

    return elm;

end );


#############################################################################
##
#M  PcElementByExponentsNC( <pcgs>, <basis>, <list> )
##
InstallOtherMethod( PcElementByExponentsNC,"multiply base elts., FFE",
    IsFamFamX, [ IsPcgs, IsList, IsRowVector and IsFFECollection ], 0,
function( pcgs, basis, list )
    local   elm,  i,  z;

    elm := OneOfPcgs(pcgs);

    for i  in [ 1 .. Length(list) ]  do
        z := IntFFE(list[i]);
        if z <> 0  then
            elm := elm * basis[i] ^ z;
        fi;
    od;

    return elm;

end );

#############################################################################
##
#M  PcElementByExponentsNC( <pcgs>, <basisindex>, <list> )
##
InstallOtherMethod( PcElementByExponentsNC,"index: defer to basis", true,
  [ IsModuloPcgs, IsRowVector and IsCyclotomicCollection, 
    IsRowVector and IsFFECollection ], 0,
function( pcgs, ind, list )
local   elm,  i,z;
  elm := OneOfPcgs(pcgs);
  for i  in [ 1 .. Length(list) ]  do
    z := IntFFE(list[i]);
    if z<> 0  then
      elm := elm * pcgs[ind[i]] ^ z;
    fi;
  od;
  return elm;
end );

InstallOtherMethod( PcElementByExponentsNC,"index: defer to basis,FFE",true,
  [ IsModuloPcgs, IsRowVector and IsCyclotomicCollection, 
    IsRowVector and IsCyclotomicCollection ], 0,
function( pcgs, ind, list )
local   elm,  i;
  elm := OneOfPcgs(pcgs);
  for i  in [ 1 .. Length(list) ]  do
    if list[i] <> 0  then
      elm := elm * pcgs[ind[i]] ^ list[i];
    fi;
  od;
  return elm;
end );


#############################################################################
##
#M  ReducedPcElement( <pcgs>, <left>, <right> )
##
InstallMethod( ReducedPcElement,
    "generic method",
    IsCollsElmsElms,
    [ IsPcgs and IsPrimeOrdersPcgs,
      IsObject,
      IsObject ],
    0,

function( pcgs, left, right )
    local   d,  ll,  lr,  ord;

    d := DepthOfPcElement( pcgs, left );
    if d <> DepthOfPcElement( pcgs, right )  then
        Error( "pc elms <left> and <right> have different depth" );
    fi;
    ll  := LeadingExponentOfPcElement( pcgs, left );
    lr  := LeadingExponentOfPcElement( pcgs, right );
    ord := RelativeOrderOfPcElement( pcgs, left );
    return LeftQuotient( right^(ll/lr mod ord), left );
end );


#############################################################################
##
#M  RelativeOrderOfPcElement( <pcgs>, <elm> )
##
InstallMethod( RelativeOrderOfPcElement,
    "for IsPrimeOrdersPcgs using RelativeOrders",
    IsCollsElms,
    [ IsPcgs and IsPrimeOrdersPcgs,
      IsObject ],
    0,

function( pcgs, elm )
    local   d;

    d := DepthOfPcElement(pcgs,elm);
    if d > Length(pcgs)  then
        return 1;
    else
        return RelativeOrders(pcgs)[d];
    fi;
end );

InstallMethod( RelativeOrderOfPcElement,
    "general method using RelativeOrders",
    IsCollsElms,
    [ IsPcgs, IsObject ],
    0,

function( pcgs, elm )
    local   d,  e,  ro;

    d := DepthOfPcElement(pcgs,elm);
    if d > Length(pcgs)  then
         return 1;
    fi;

    e  := ExponentOfPcElement( pcgs, elm, d );
    ro := RelativeOrders(pcgs)[d];

    return ro / Gcd( e, ro );
end );


#############################################################################
##
#M  CleanedTailPcElement( <pcgs>, <elm>,<dep> )
##
InstallMethod( CleanedTailPcElement, "generic: do nothing", IsCollsElmsX,
    [ IsPcgs , IsMultiplicativeElementWithInverse, IsPosInt ], 0,
function( pcgs, elm,dep )
  return elm;
end);


#############################################################################
##
#M  SetRelativeOrders( <prime-orders-pcgs>, <orders> )
##

# the following is the system setter for `RelativeOrders'.
SET_RELATIVE_ORDERS := SETTER_FUNCTION(
    "RelativeOrders", HasRelativeOrders );


InstallMethod( SetRelativeOrders,
    "setting orders for prime orders pcgs",
    true,
    [ IsPcgs and IsComponentObjectRep and IsAttributeStoringRep and
        HasIsPrimeOrdersPcgs and HasIsFiniteOrdersPcgs,
      IsList ],
    1, #better than the following method
    # only call the system setter function
    SET_RELATIVE_ORDERS );


#############################################################################
##
#M  SetRelativeOrders( <pcgs>, <orders> )
##
InstallMethod( SetRelativeOrders,
    "setting orders and checking for prime orders",
    true,
    [ IsPcgs and IsComponentObjectRep and IsAttributeStoringRep,
      IsList ],
    0,

function( pcgs, orders )
    if not HasIsFiniteOrdersPcgs(pcgs)  then
        SetIsFiniteOrdersPcgs( pcgs,
            ForAll( orders, x -> x <> 0 and x <> infinity ) );
    fi;
    if IsFiniteOrdersPcgs(pcgs) and not HasIsPrimeOrdersPcgs(pcgs)  then
        SetIsPrimeOrdersPcgs( pcgs, ForAll( orders, x -> IsPrimeInt(x) ) );
    fi;
    # and call the system setter function
    SET_RELATIVE_ORDERS( pcgs, orders );
end );


#############################################################################
##
#M  SumOfPcElement( <pcgs>, <left>, <right> )
##
InstallMethod( SumOfPcElement,
    "generic methods, PcElementByExponents+ExponentsOfPcElement",
    IsCollsElmsElms,
    [ IsPcgs,
      IsObject,
      IsObject ],
    0,

function( pcgs, left, right )
    return PcElementByExponentsNC( pcgs,
        ExponentsOfPcElement(pcgs,left)+ExponentsOfPcElement(pcgs,right) );
end );


#############################################################################
##
#M  ExtendedPcgs( <N>, <no-gens> )
##
InstallMethod( ExtendedPcgs, "pcgs, empty list", true,
        [ IsPcgs, IsList and IsEmpty ], 0,
    function( N, gens )
    return N;
end );


#############################################################################
##
#M  ExtendedIntersectionSumPcgs( <parent-pcgs>, <n>, <u>, <modpcgs> )
##
InstallMethod( ExtendedIntersectionSumPcgs,
    "generic method for modulo pcgs",
    true,
    #function(a,b,c) return IsIdenticalObj(a,b) and IsIdenticalObj(a,c); end,
    [ IsPcgs and IsPrimeOrdersPcgs, IsList, IsList, IsObject ], 0,
function( pcgs, n, u, pcgsM )
    local   id,  G,  ls,  rs,  is,  g,  z,  I,  ros,  al,  ar,  tmp,  
            sum,  int;

    # set up
    id := OneOfPcgs( pcgs );
    G  := GroupOfPcgs( pcgs );

    # What  follows  is a Zassenhausalgorithm: <ls> and <rs> are the left and
    # rights  sides. They are initialized with [ n, n ] and [ u, 1 ]. <is> is
    # the  intersection.  <I>  contains  the  words  [ u, 1 ]  which  must be
    # Sifted through [ <ls>, <rs> ].

    ls := List( pcgs, x -> id );
    rs := List( pcgs, x -> id );
    is := List( pcgs, x -> id );

    for g in u do
        z := DepthOfPcElement( pcgs, g );
        ls[z] := g;
        rs[z] := g;
    od;

    I := [];
    for g in n do
        z := DepthOfPcElement( pcgs, g );
        if ls[z] = id  then
            ls[z] := g;
        else
            Add( I, g );
        fi;
    od;

    # enter the pairs [ u, 1 ] of <I> into [ <ls>, <rs> ]
    ros := RelativeOrders(pcgs);
    for al  in I  do
        ar := id;
	if IsInt(pcgsM) then
	  if DepthOfPcElement(pcgs,al)>=pcgsM then
	    al:=id;
	  fi;
        elif not IsBool( pcgsM ) then 
            al := SiftedPcElement( pcgsM, al );
        fi;
        z  := DepthOfPcElement( pcgs, al );

        # shift through and reduced from the left
        while al <> id and ls[z] <> id  do
            tmp := LeadingExponentOfPcElement( pcgs, al )
                   / LeadingExponentOfPcElement( pcgs, ls[z] )
                   mod ros[z];
            al := LeftQuotient( ls[z]^tmp, al );
	    if IsInt(pcgsM) then
	      if DepthOfPcElement(pcgs,al)>=pcgsM then
		al:=id;
	      fi;
	    elif not IsBool( pcgsM ) then 
                al := SiftedPcElement( pcgsM, al );
            fi;
            ar := LeftQuotient( rs[z]^tmp, ar );
            z  := DepthOfPcElement( pcgs, al );
        od;

        # have we a new sum or intersection generator
        if al <> id  then
            ls[z] := al;
            rs[z] := ar;
        else
            z := DepthOfPcElement( pcgs, ar );
            while ar <> id and is[z] <> id  do
                ar := ReducedPcElement( pcgs, ar, is[z] );
		if IsInt(pcgsM) then
		  if DepthOfPcElement(pcgs,ar)>=pcgsM then
		    ar:=id;
		  fi;
		elif not IsBool( pcgsM ) then 
                    ar := SiftedPcElement( pcgsM, ar );
                fi;
                z  := DepthOfPcElement( pcgs, ar );
            od;
            if ar <> id  then
                is[z] := ar;
            fi;
        fi;
    od;

    # Construct  the sum and intersection aggroups. Return left and right
    # sides, so one can decompose words of <N> * <U>.

    #sum := InducedPcgsByPcSequence( pcgs, Filtered( ls, x -> x <> id ) );
    #int := InducedPcgsByPcSequence( pcgs,
    #                    Filtered( is, x -> x <> id ) );
    sum := Filtered( ls, x -> x <> id );
    int := Filtered( is, x -> x <> id );
   
    return rec(
        leftSide     := ls,
        rightSide    := rs,
        sum          := sum,
        intersection := int );
end );


#############################################################################
##
#M  IntersectionSumPcgs( <parent-pcgs>, <n>, <u> )
##
InstallMethod( IntersectionSumPcgs,
    "using 'ExtendedIntersectionSumPcgs'",
    function(a,b,c) return IsIdenticalObj(a,b) and IsIdenticalObj(a,c); end,
    [ IsPcgs and IsPrimeOrdersPcgs, IsList, IsList ], 0,
function( pcgs, n, u ) 
local e;
  e:=ExtendedIntersectionSumPcgs(pcgs, n, u, true);
  e.sum:=InducedPcgsByPcSequenceNC(pcgs,e.sum);
  e.intersection:=InducedPcgsByPcSequenceNC(pcgs,e.intersection);
  return e;
end );


#############################################################################
##
#M  NormalIntersectionPcgs( <parent-pcgs>, <n>, <u> )
##
InstallMethod( NormalIntersectionPcgs,
    "using 'ExtendedIntersectionSumPcgs'",
    function(a,b,c) return IsIdenticalObj(a,b) and IsIdenticalObj(a,c); end,
    [ IsPcgs and IsPrimeOrdersPcgs,
      IsList,
      IsList ],
    0,

function( p, n, u )
   return InducedPcgsByPcSequenceNC(p,
            ExtendedIntersectionSumPcgs(p,n,u,true).intersection);
end );


#############################################################################
##
#M  SumPcgs( <parent-pcgs>, <n>, <u> )
##
InstallMethod( SumPcgs,
    "generic method",
    function(a,b,c) return IsIdenticalObj(a,b) and IsIdenticalObj(a,c); end,
    [ IsPcgs and IsPrimeOrdersPcgs,
      IsList,
      IsList ],
    0,

function( pcgs, n, u )
    local   id,  G,  ls,  g,  z,  I,  ros,  al,  tmp;

    if false and IsPcgs(u) and IsPcgs(n) and ParentPcgs(n)=pcgs
        and ParentPcgs(u)=pcgs then
      if ForAll(n,i->i in u) then
        return u;
      elif ForAll(u,i->i in n) then
        return n;
      fi;
    fi;

    # set up
    id := OneOfPcgs( pcgs );
    G  := GroupOfPcgs( pcgs );

    # what follows is a Zassenhausalgorithm
    ls := List( pcgs, x -> id );

    for g in u do
        z := DepthOfPcElement( pcgs, g );
        ls[z] := g;
    od;

    I := [];
    for g in n do
        z := DepthOfPcElement( pcgs, g );
        if ls[z] = id  then
            ls[z] := g;
        else
            Add( I, g );
        fi;
    od;

    # enter the elements of <I> into <ls>
    ros := RelativeOrders(pcgs);
    for al  in I  do
        z  := DepthOfPcElement( pcgs, al );

        # shift through and reduced from the left
        while al <> id and ls[z] <> id  do
            tmp := LeadingExponentOfPcElement( pcgs, al )
                   / LeadingExponentOfPcElement( pcgs, ls[z] )
                   mod ros[z];
            al := LeftQuotient( ls[z]^tmp, al );
            z  := DepthOfPcElement( pcgs, al );
        od;

        # have we a new sum or intersection generator
        if al <> id  then
            ls[z] := al;
        fi;
    od;

    return InducedPcgsByPcSequence( pcgs, Filtered( ls, x -> x <> id ) );

end );


#############################################################################
##
#M  SumFactorizationFunctionPcgs( <parent-pcgs>, <u>, <n>, <modpcgs> )
##
InstallMethod( SumFactorizationFunctionPcgs,
    "generic method",
    #function(a,b,c) return IsIdenticalObj(a,b) and IsIdenticalObj(a,c); end,
    true,
    [ IsPcgs and IsPrimeOrdersPcgs, IsList, IsList, IsObject ], 0,
function( pcgs, u, n, pcgsM )
    local   id,  S,  f;

    # do we want to prune the tails?
    if IsInt(pcgsM) and pcgsM<0 then
      pcgsM:=-pcgsM;
      # this will not affect the result -- as we have a tail we only want
      # the result modulo a normal subgroup
      u:=List(u,i->CleanedTailPcElement(pcgs,i,pcgsM));
      n:=List(n,i->CleanedTailPcElement(pcgs,i,pcgsM));
    fi;

    id := OneOfPcgs( pcgs );
    S  := ExtendedIntersectionSumPcgs( pcgs, n, u, pcgsM );

    # decomposition function
    f := function( un )
        local a, u, w, z;

        # Catch trivial case.
        if un = id  then
            return rec( u := id, n := id );
        fi;

        # Shift  through  'leftSide'  and  do  the  inverse  operations  with
        # 'rightSide'. This will give the <N> part.
        u := id;
        a := un;
        w := DepthOfPcElement( pcgs, a );
        while a <> id and S.leftSide[ w ] <> id  do
            z := LeadingExponentOfPcElement( pcgs, a )
                   / LeadingExponentOfPcElement( pcgs, S.leftSide[ w ] )
                 mod RelativeOrderOfPcElement( pcgs, a );
            a := LeftQuotient( S.leftSide[ w ] ^ z, a );
            u := u * S.rightSide[ w ] ^ z;
            w := DepthOfPcElement( pcgs, a );
        od;
        return rec( u := u, n := u^-1 * un );
    end;

    # Return the sum, intersection and the function.
    return rec( sum           := S.sum,
                intersection  := S.intersection,
                factorization := f );

end );


#############################################################################
##
#M  PcGroupWithPcgs( <pcgs> )
##
GROUP_BY_PCGS_FINITE_ORDERS := function( pcgs )
    local   f,  e,  m,  i,  type,  s,  id,  tmp,  j;

    # construct a new free group
    f := FreeGroup(IsSyllableWordsFamily, Length(pcgs) );
    e := ElementsFamily( FamilyObj(f) );

    # and a default type
    if 0 = Length(pcgs)  then
        m := 1;
    else
        m := Maximum(RelativeOrders(pcgs));
    fi;
    i := 1;
    while i < 4 and e!.expBitsInfo[i] <= m  do
        i := i + 1;
    od;
    type := e!.types[i];

    # and use a single collector
    s := SingleCollector( f, RelativeOrders(pcgs) );

    # compute the power relations
    id := pcgs!.zeroVector;
    for i  in [ 1 .. Length(pcgs) ]  do
        #tmp := pcgs[i]^RelativeOrderOfPcElement(pcgs,pcgs[i]);
        tmp := ExponentsOfRelativePower(pcgs,i);
        if tmp <> id  then
            #tmp := ExponentsOfPcElement( pcgs, tmp );
            tmp := ObjByVector( type, tmp );
            SetPowerNC( s, i, tmp );
        fi;
    od;

    # compute the conjugates
    for i  in [ 1 .. Length(pcgs) ]  do
        for j  in [ i+1 .. Length(pcgs) ]  do
            #tmp := pcgs[j] ^ pcgs[i];
            tmp := ExponentsOfConjugate(pcgs,j,i);
            if tmp <> id  then
                #tmp := ExponentsOfPcElement( pcgs, tmp );
                tmp := ObjByVector( type, tmp );
                SetConjugateNC( s, j, i, tmp );
            fi;
        od;
    od;

    # and return the new group
    return GroupByRwsNC(s);

end;


InstallMethod( PcGroupWithPcgs,
    true,
    [ IsPcgs ],
    0,

function( pcgs )

    # the following only works for finite orders
    if not IsFiniteOrdersPcgs(pcgs)  then
        TryNextMethod();
    fi;
    return GROUP_BY_PCGS_FINITE_ORDERS(pcgs);

end );


#############################################################################
##
#M  GroupOfPcgs( <pcgs> )
##
InstallMethod( GroupOfPcgs,
    true,
    [ IsPcgs ],
    0,

function( pcgs )
    local   tmp;

    tmp := GroupByGenerators( AsList( pcgs ), OneOfPcgs(pcgs) );
    if HasIsFiniteOrdersPcgs(pcgs) then
      SetIsFinite( tmp, IsFiniteOrdersPcgs(pcgs) );
    fi;
    SetPcgs(     tmp, pcgs                     );
    return tmp;
end );


#############################################################################
##
#R  IsEnumeratorByPcgsRep
##
DeclareRepresentation( "IsEnumeratorByPcgsRep",
    IsAttributeStoringRep, [ "pcgs", "sublist" ] );


#############################################################################
##
#M  EnumeratorByPcgs( <pcgs> )
##
InstallMethod( EnumeratorByPcgs,"pcgs", true, [ IsPcgs ], 0,
function( pcgs )
    return Objectify(
        NewType( FamilyObj(pcgs), IsList and IsEnumeratorByPcgsRep ),
        rec( pcgs := pcgs, sublist := [ 1 .. Length(pcgs) ],
             relativeOrders := RelativeOrders(pcgs),
             complementList := [] ) );
end );


#############################################################################
##
#M  EnumeratorByPcgs( <pcgs>, <sublist> )
##
InstallOtherMethod( EnumeratorByPcgs,"pcgs, sublist",true,[IsPcgs,IsList],0,
function( pcgs, sublist )
    return Objectify(
        NewType( FamilyObj(pcgs), IsList and IsEnumeratorByPcgsRep ),
        rec( pcgs := pcgs, sublist := sublist,
             relativeOrders := RelativeOrders(pcgs),
             complementList := Difference([1..Length(pcgs)],sublist) ) );
end );


#############################################################################
##
#M  Length( <enum-by-pcgs> )
##
InstallMethod( Length,"enum-by-pcgs", true,
    [ IsList and IsEnumeratorByPcgsRep ],
    0,
    enum -> Product(enum!.relativeOrders{enum!.sublist}) );


#############################################################################
##
#M  <enum-by-pcgs> [ <pos> ]
##
InstallMethod( \[\],"enum-by-pcgs",
    true,
    [ IsList and IsEnumeratorByPcgsRep,
      IsPosInt ],
    0,

function( enum, pos )
    local   pcgs,  elm,  i,  p;
    
    pcgs := enum!.pcgs;
    elm  := OneOfPcgs( pcgs );
    pos  := pos - 1;
    for i  in Reversed( enum!.sublist )  do
        p   := enum!.relativeOrders[i];
        elm := pcgs[ i ] ^ ( pos mod p ) * elm;
        pos := QuoInt( pos, p );
    od;
    return elm;
end );


#############################################################################
##
#M  Position( <enum-by-pcgs>, <elm>, <zero> )
##
InstallMethod( Position,"enum-by-pcgs",
    IsCollsElmsX,
    [ IsList and IsEnumeratorByPcgsRep,
      IsMultiplicativeElementWithInverse,
      IsZeroCyc ],
    0,

function( enum, elm, zero )
    local   pcgs,  exp,  pos,  i;

    pcgs := enum!.pcgs;
    exp  := ExponentsOfPcElement( pcgs, elm );
    pos  := 0;
    if exp=fail or ForAny( enum!.complementList, x -> 0 <> exp[x] )  then
      return fail;
    fi;
    for i  in enum!.sublist  do
      pos := pos * enum!.relativeOrders[i] + exp[i];
    od;
    # the element is not necessarily contained. So we must check
    if elm<>enum[pos+1] then
      return fail;
    fi;
    return pos + 1;
end );


#############################################################################
##
#M  PositionCanonical( <enum-by-pcgs>, <elm> )
##
InstallMethod( PositionCanonical,"enum-by-pcgs",
    IsCollsElms,
    [ IsList and IsEnumeratorByPcgsRep,
      IsMultiplicativeElementWithInverse ],
    0,

function( enum, elm )
    local   pcgs,  exp,  pos,  i;

    pcgs := enum!.pcgs;
    exp  := ExponentsOfPcElement( pcgs, elm );
    pos  := 0;
    for i  in enum!.sublist  do
      pos := pos * enum!.relativeOrders[i] + exp[i];
    od;
    # the element is not necessarily contained. So we must check
    if elm<>enum[pos+1] then
      return fail;
    fi;
    return pos + 1;
end );


#############################################################################
##
#M  NormalSeriesByPcgs( <pcgs> )
##
InstallMethod(NormalSeriesByPcgs,"via SubgroupByPcgs",true,
  [IsPcgs],0,
function(pcgs)
local p,l,g,h,i,ipcgs,home;
  home:=ParentPcgs(pcgs);
  l:=IndicesNormalSteps(pcgs);
  p := GroupOfPcgs(pcgs);
  SetInducedPcgs(home,p,pcgs);
  g:=[p];
  for i in [2..Length(l)-1] do
    ipcgs:=InducedPcgsByPcSequenceNC(home,pcgs{[l[i]..Length(pcgs)]});
    h:=SubgroupByPcgs(p,ipcgs);
    SetInducedPcgs(home,p,ipcgs);
    Add(g,h);
  od;
  Add(g,TrivialSubgroup(p));
  return g;
end);

InstallMethod(NormalSeriesByPcgs,"from PcSeries",true,
  [IsPcgs and HasPcSeries],0,
function(pcgs)
  return PcSeries(pcgs){IndicesNormalSteps(pcgs)};
end);

#############################################################################
##
#M  IsPcgsElementaryAbelianSeries( <pcgs> )
##
InstallMethod(IsPcgsElementaryAbelianSeries,"test if elm. abelian",true,
  [IsPcgs],0,
function(p)
local u,n,i,ro,ran,o,d,j;
  u:=PcSeries(p);
  if HasIndicesNormalSteps(p) then
    n:=IndicesNormalSteps(p); # get the indices stored already
  else
    n:=[Length(p)+1];
    o:=Length(p); # next attempted normal level
    j:=o; # generator currently conjugated
    while j>0 do
      repeat
	i:=1; # conjugating generator
	while i<o do
	  d:=DepthOfPcElement(p,p[j]^p[i]);
	  if d<o then
	    # NT is larger than expected
	    o:=d;
	  fi;
	  i:=i+1;
	od;
	j:=j-1;
      until j<o; 
      # we've found another normal step
      Add(n,o);
      o:=j;
    od;
    n:=Reversed(n);
  fi;
  ro:=RelativeOrders(p);
  for i in [1..Length(n)-1] do
    ran:=[n[i]..n[i+1]-1]; #pcgs range
    o:=Set(ro{ran});
    if Length(o)>1 then
      return false; # could this ever happen anyhow?
    fi;
    o:=o[1];
    if ForAny(p{ran},j->DepthOfPcElement(p,j^o)<n[i+1]) then
      return false; # not exponent p
    fi;
    if ForAny(p{ran},
              k->ForAny(p{ran},j->DepthOfPcElement(p,Comm(j,k))<n[i+1])) then
      return false; # not abelian
    fi;
  od;
  SetIndicesNormalSteps(p,n);
  return true;
end);

InstallGlobalFunction(LiftedPcElement,function(new,old,elm)
local e;
  e:=ShallowCopy(new!.zeroVector);
  e{[1..Length(old)]}:=ExponentsOfPcElement(old,elm);
  return PcElementByExponentsNC(new,e);
end);

InstallGlobalFunction(ProjectedPcElement,function(old,new,elm)
  return PcElementByExponentsNC(new,ExponentsOfPcElement(old,elm)
                                      {[1..Length(new)]});
end);

InstallGlobalFunction(ProjectedInducedPcgs,function(old,new,pcgs)
local p,i,e;
  p:=[];
  for i in pcgs!.pcSequence do
    e:=ProjectedPcElement(old,new,i);
    if not IsOne(e) then
      Add(p,e);
    fi;
  od;
  return InducedPcgsByPcSequenceNC(new,p);
end);

InstallGlobalFunction(LiftedInducedPcgs,function(new,old,pcgs,ker)
local p,i;
  p:=[];
  for i in pcgs do
    Add(p,LiftedPcElement(new,old,i));
  od;
  return InducedPcgsByPcSequenceNC(new,Concatenation(p,ker));
end);

#############################################################################
##
#M  IsPcgsElementaryAbelianSeries( <pcgs> )
##
BindGlobal("DoPcgsElementaryAbelianSeries",function(param)
local G,e,ind,s,m,i,p;
  if IsList(param) then
    G:=param[1];
    if HasPcgsElementaryAbelianSeries(G) then
      # can we use the known pcgs?
      p:=PcgsElementaryAbelianSeries(G);
      e:=NormalSeriesByPcgs(p);
      if ForAll(param,i->i in e) then
        return p;
      fi;
    fi;
  else
    G:=param;
  fi;
  if not IsSolvableGroup(G) then
    Error("<G> must be solvable");
  fi;
  e:=ElementaryAbelianSeriesLargeSteps(param);
  ind:=[];
  s:=[];
  for i in [1..Length(e)-1] do
    m:=ModuloPcgs(e[i],e[i+1]);
    Add(ind,Length(s)+1);
    Append(s,m);
  od;
  Add(ind,Length(s)+1);
  p:=PcgsByPcSequence(FamilyObj(One(G)),s);
  SetIsPcgsElementaryAbelianSeries(p,true);
  SetIsPrimeOrdersPcgs(p,true);
  SetIndicesNormalSteps(p,ind);
  SetNormalSeriesByPcgs(p,e);
  return p;
end);

#############################################################################
##
#M  PcgsElementaryAbelianSeries( <G> )
##
InstallMethod( PcgsElementaryAbelianSeries, "generic group", true,
  [ IsGroup ], 0, DoPcgsElementaryAbelianSeries);

InstallOtherMethod( PcgsElementaryAbelianSeries, "group list", true,
  [ IsList ], 0, DoPcgsElementaryAbelianSeries);


#############################################################################
##
#E
##

