home *** CD-ROM | disk | FTP | other *** search
/ Math Solutions 1995 October / Math_Solutions_CD-ROM_Walnut_Creek_October_1995.iso / pc / mac / discrete / lib / fpgrp.g < prev    next >
Encoding:
Text File  |  1993-05-05  |  63.9 KB  |  1,965 lines
  1. #############################################################################
  2. ##
  3. #A  fpgrp.g                     GAP library                  Martin Schoenert
  4. ##
  5. #A  @(#)$Id: fpgrp.g,v 3.12 1993/02/09 14:25:55 martin Rel $
  6. ##
  7. #Y  Copyright 1990-1992,  Lehrstuhl D fuer Mathematik,  RWTH Aachen,  Germany
  8. ##
  9. ##  This file contains the  functions dealing with finitely presented groups.
  10. ##
  11. #H  $Log: fpgrp.g,v $
  12. #H  Revision 3.12  1993/02/09  14:25:55  martin
  13. #H  made undefined globals local
  14. #H
  15. #H  Revision 3.11  1992/12/16  19:47:27  martin
  16. #H  replaced quoted record names with escaped ones
  17. #H
  18. #H  Revision 3.10  1992/12/03  12:57:43  fceller
  19. #H  renamed 'IsEquivalent' to 'IsIdentical'
  20. #H
  21. #H  Revision 3.9  1992/10/07  08:43:30  martin
  22. #H  fixed another minor problem in 'LowIndexSubgroupsFpGroup'
  23. #H
  24. #H  Revision 3.8  1992/10/02  17:38:39  martin
  25. #H  added 'FpGroupOps.GroupHomomorphismByImages'
  26. #H
  27. #H  Revision 3.7  1992/10/02  17:20:33  martin
  28. #H  fixed 'LowIndexSubgroupsFpGroup'
  29. #H
  30. #H  Revision 3.6  1992/10/02  17:14:30  martin
  31. #H  added some information printing to 'CosetTableFpGroup'
  32. #H
  33. #H  Revision 3.5  1992/08/14  15:41:31  fceller
  34. #H  'FpGroupOps.AbelianInvariants' now calls 'DiagonalizeMat'
  35. #H  instead of 'ElementaryDivisorsMat'
  36. #H
  37. #H  Revision 3.4  1992/08/14  09:24:26  fceller
  38. #H  replaced handle comparision by 'IsEquivalent'
  39. #H
  40. #H  Revision 3.3  1992/07/15  13:36:19  martin
  41. #H  added packages "fpsgpres" and "fptietze"
  42. #H
  43. #H  Revision 3.2  1992/07/15  12:42:39  martin
  44. #H  added 'RelsSortedByStartGens' and modified 'CosetTableFpGroup'
  45. #H
  46. #H  Revision 3.1  1992/04/07  19:41:42  martin
  47. #H  initial revision under RCS
  48. #H
  49. ##
  50.  
  51.  
  52. #############################################################################
  53. ##
  54. #F  InfoFpGroup?(...) . . . . . information function for the fp group package
  55. ##
  56. if not IsBound(InfoFpGroup1)  then InfoFpGroup1 := Ignore;  fi;
  57. if not IsBound(InfoFpGroup2)  then InfoFpGroup2 := Ignore;  fi;
  58.  
  59.  
  60. #############################################################################
  61. ##
  62. #F  FreeGroup( <rank> [, <name> ] ) . . . . . . . .  free group of given rank
  63. ##
  64. FreeGroup := function ( arg )
  65.     local   F,          # free group of rank <rank>, result
  66.             gens,       # generators of <F>
  67.             rank,       # rank of the free group, first argument
  68.             name,       # name of the group, optional second argument
  69.             i;          # loop variable
  70.  
  71.     # get and check the argument list
  72.     rank := arg[1];
  73.     if   Length( arg ) = 1  then
  74.         name := "f";
  75.     elif Length( arg ) = 2  then
  76.         name := arg[2];
  77.     else
  78.         Error("usage: FreeGroup( <rank> [, <name>] )");
  79.     fi;
  80.  
  81.     # make the generators
  82.     gens := [];
  83.     for i  in [ 1 .. arg[1] ]  do
  84.         gens[i] := AbstractGenerator(
  85.                         ConcatenationString( name, ".", String(i) )
  86.                    );
  87.     od;
  88.  
  89.     # make the group
  90.     F := Group( gens, IdWord );
  91.  
  92.     # return the group
  93.     return F;
  94. end;
  95.  
  96.  
  97. #############################################################################
  98. ##
  99. #V  Words . . . . . . . . . . . . . . . . . . . . . . . . domain of all words
  100. #V  WordsOps  . . . . . . . . . operations record for the domain of all words
  101. ##
  102. Words                           := rec();
  103. Words.isDomain                  := true;
  104.  
  105. Words.name                      := "Words";
  106.  
  107. Words.isFinite                  := false;
  108. Words.size                      := "infinity";
  109.  
  110. Words.operations                := Copy( GroupElementsOps );
  111. WordsOps                        := Words.operations;
  112.  
  113.  
  114. #############################################################################
  115. ##
  116. #F  WordsOps.\in( <g>, Words ) . membership test for the domain of all words
  117. ##
  118. WordsOps.\in := function ( g, Words )
  119.     return IsWord( g );
  120. end;
  121.  
  122.  
  123. #############################################################################
  124. ##
  125. #F  IsFpGroup(<D>)  . . . . . . . . . . . . . is an object a fin. pres. group
  126. ##
  127. IsFpGroup := function ( obj )
  128.     return     IsRec( obj )
  129.            and IsBound( obj.isFpGroup )  and obj.isFpGroup;
  130. end;
  131.  
  132.  
  133. #############################################################################
  134. ##
  135. #F  WordsOps.Group  . . . . . . . . . . . . . . . . create a fin. pres. group
  136. ##
  137. WordsOps.Group := function ( Words, gens, id )
  138.     local   G;          # finitely presented group, result
  139.  
  140.     # check that all generators have length 1
  141.     if not ForAll( gens, g -> LengthWord( g ) = 1 )  then
  142.         Error("the generators must have length 1 (maybe use 'Subgroup')");
  143.     fi;
  144.  
  145.     # let the default function do the main work
  146.     G := GroupElementsOps.Group( Words, gens, id );
  147.  
  148.     # add the tag
  149.     G.isFpGroup         := true;
  150.  
  151.     # add the operations record
  152.     G.operations        := FpGroupOps;
  153.  
  154.     # return the group
  155.     return G;
  156. end;
  157.  
  158.  
  159. #############################################################################
  160. ##
  161. #V  FpGroupOps  . . . . . . . . . . . operations record for fin. pres. groups
  162. ##
  163. FpGroupOps := Copy( GroupOps );
  164.  
  165.  
  166. #############################################################################
  167. ##
  168. #F  FpGroupOps.Subgroup(<G>,<gens>) .   make a subgroup of a fin. pres. group
  169. ##
  170. FpGroupOps.Subgroup := function ( G, gens )
  171.     local   S;          # subgroup, result
  172.  
  173.     # let the default function do the main work
  174.     S := GroupOps.Subgroup( G, gens );
  175.  
  176.     # add the finitely presented groups tag
  177.     S.isFpGroup := true;
  178.  
  179.     # add the finitely presented groups operations record
  180.     S.operations := FpGroupOps;
  181.  
  182.     # return the subgroup
  183.     return S;
  184. end;
  185.  
  186.  
  187. #############################################################################
  188. ##
  189. #F  FpGroupOps.TrivialSubgroup(<G>) .  trivial subgroup of a fin. pres. group
  190. ##
  191. FpGroupOps.TrivialSubgroup := function ( G )
  192.     local   T;          # trivial subgroup of <G>, result
  193.  
  194.     # let the default function do the main work
  195.     T := GroupOps.TrivialSubgroup( G );
  196.  
  197.     # remove the elements list
  198.     Unbind( T.elements );
  199.  
  200.     # return the trivial subgroup
  201.     return T;
  202. end;
  203.  
  204.  
  205. #############################################################################
  206. ##
  207. #F  CyclicPermutationsWords( <words> )  . . . . .  set of cyclic permutations
  208. #F                                                         of a list of words
  209. ##
  210. ##  'CyclicPermutationsWords' returns      the set   of     all   the  cyclic
  211. ##  permutations of the words in the list <words> and their inverses.
  212. ##
  213. ##  The Todd Coxeter with the Felsch  strategy  needs  the  extended  set  of
  214. ##  relators, it is also sometimes useful when using the HLT strategy.
  215. ##
  216. CyclicPermutationsWords := function ( words )
  217.     local  cycperms,  word,  w;
  218.     cycperms := [];
  219.     for word  in words  do
  220.         while LengthWord( word^Subword(word,1,1) ) < LengthWord( word )  do
  221.             word := word ^ Subword(word,1,1);
  222.         od;
  223.         if not word in cycperms  then
  224.             w := word;
  225.             repeat
  226.                 AddSet( cycperms, w );
  227.                 AddSet( cycperms, w^-1 );
  228.                 w := w ^ Subword( w, 1, 1 );
  229.             until w = word;
  230.         fi;
  231.     od;
  232.     return cycperms;
  233. end;
  234.  
  235.  
  236. #############################################################################
  237. ##
  238. #F  RelatorRepresentatives( <rels> )  . . . . . . set of representatives of a
  239. #F                                                           list of relators
  240. ##
  241. ##  'RelatorRepresentatives'  returns a set of  cyclically reduced represent-
  242. ##  atives, with respect to conjugation or inversion,  of the relators in the
  243. ##  list <rels>.
  244. ##
  245. ##  The Todd Coxeter with the Felsch  strategy  needs  the  extended  set  of
  246. ##  relators,  it is also  sometimes  useful  when  using  the  HLT strategy.
  247. ##  Moreover, it is used by the Reduced Reidemeister-Schreier.
  248. ##
  249. RelatorRepresentatives := function ( rels )
  250.  
  251.     local contained, invreps, rel, relreps, word;
  252.  
  253.     relreps := [];
  254.     invreps := [];
  255.     for rel in rels do
  256.         while LengthWord( rel^Subword( rel, 1, 1 ) ) < LengthWord( rel ) do
  257.             rel := rel ^ Subword( rel, 1, 1 );
  258.         od;
  259.         word := rel;
  260.         contained := word = [] or word in relreps or word in invreps;
  261.         while not contained do
  262.             word := word ^ Subword( word, 1, 1 );
  263.             if word = rel then
  264.                 Add( relreps, word );
  265.                 Add( invreps, word^-1 );
  266.                 contained := true;
  267.             else
  268.                 contained := word = [] or word in relreps or word in invreps;
  269.             fi;
  270.         od;
  271.     od;
  272.  
  273.     return relreps;
  274. end;
  275.  
  276.  
  277. #############################################################################
  278. ##
  279. #F  RelsSortedByStartGen( <parent group>, <coset table> [,<sort>] ) . . . . .
  280. #F                                         relators sorted by start generator
  281. ##
  282. ##  'RelsSortedByStartGen'  is a  subroutine of the  Felsch Todd-Coxeter  and
  283. ##  the  Reduced Reidemeister-Schreier  routines. It returns a list which for
  284. ##  each  generator or  inverse generator  contains a list  of all cyclically
  285. ##  reduced relators,  starting  with that element,  which can be obtained by
  286. ##  conjugating or inverting given relators.  The relators are represented as
  287. ##  lists of the coset table columns corresponding to the generators and,  in
  288. ##  addition, as lists of the respective column numbers.
  289. ##
  290. ##  If a third argument  is specified  and equal to true,  then the resulting
  291. ##  list will be sorted.
  292. ##
  293. RelsSortedByStartGen := function ( arg )
  294.  
  295.     local base, base2, cols, extleng, G, gen, i, invcols, invnums, j, k,
  296.           length, less, numcols, numgens, nums, p, p1, p2, rel, relsGen,
  297.           sort, sortlist, table, word;
  298.  
  299.  
  300.     less := function ( triple1, triple2 )
  301.  
  302.         # 'less' defines an ordering on the triples [ nums, cols, startpos ]
  303.         # in list relsGen.
  304.         local diff, i, k, nums1, nums2;
  305.  
  306.         if triple1[1][1] <> triple2[1][1] then
  307.             return( triple1[1][1] < triple2[1][1] );
  308.         fi;
  309.  
  310.         nums1 := triple1[1];  nums2 := triple2[1];
  311.         i := triple1[3];
  312.         diff := triple2[3] - i;
  313.         k := i + nums1[1] + 2;
  314.         while i < k do
  315.             if nums1[i] <> nums2[i+diff] then
  316.                 return( nums1[i] < nums2[i+diff] );
  317.             fi;
  318.             i := i + 2;
  319.         od;
  320.  
  321.         return( false );
  322.     end;
  323.  
  324.  
  325.     # get the arguments.
  326.     G := arg[1];
  327.     table := arg[2];
  328.     sort := false;
  329.     if Length( arg ) > 2 then  sort := arg[3];  fi;
  330.  
  331.     # check table length and number of generators to be consistent.
  332.     numgens := Length( G.generators );
  333.     numcols := Length( table );
  334.     if numcols <> 2 * numgens then
  335.         Error( "table length is inconsistent with number of generators" );
  336.     fi;
  337.  
  338.     # initialize the list to be constructed.
  339.     relsGen := 0 * [1 .. numcols];
  340.     for i in [ 1 .. numcols ] do
  341.         if Mod( i, 2 ) = 1 or not IsIdentical( table[i], table[i-1] ) then
  342.             relsGen[i] := [ ];
  343.         else
  344.             relsGen[i] := relsGen[i-1];
  345.         fi;
  346.     od;
  347.  
  348.     # now loop over all parent group relators.
  349.     for rel in RelatorRepresentatives( G.relators ) do
  350.  
  351.         # get the length and the basic length of relator rel.
  352.         length := LengthWord( rel );
  353.         base := 1;
  354.         word := rel ^ Subword( rel, 1, 1 );
  355.         while word <> rel do
  356.             base := base + 1;
  357.             word := word ^ Subword( word, 1, 1 );
  358.         od;
  359.  
  360.         if length = 2 and base = 1 then
  361.  
  362.             # check the table columns corresponding to an involutory
  363.             # generator and its inverse to be identical.
  364.             gen := Subword( rel, 1, 1 );
  365.             p := Position( G.generators, gen );
  366.             if p = false then  p := Position( G.generators, gen^-1 );  fi;
  367.             if not IsIdentical( table[2*p-1], table[2*p] ) then
  368.                 Error( "table inconsistent with square relators" );
  369.             fi;
  370.  
  371.         else
  372.  
  373.             # initialize the columns and numbers lists corresponding to the
  374.             # current relator.
  375.             base2 := 2 * base;
  376.             extleng := 2 * ( base + length ) - 1;
  377.             nums := 0 * [1 .. extleng];  invnums := 0 * [1 .. extleng];
  378.             cols := 0 * [1 .. extleng];  invcols := 0 * [1 .. extleng];
  379.  
  380.             # compute the lists.
  381.             i := 0;  j := 1;  k := base2 + 3;
  382.             while i < base do
  383.                 i := i + 1;  j := j + 2;  k := k - 2;
  384.                 gen := Subword( rel, i, i );
  385.                 p := Position( G.generators, gen );
  386.                 if p = false then
  387.                     p := Position( G.generators, gen^-1 );
  388.                     p1 := 2 * p;
  389.                     p2 := 2 * p - 1;
  390.                 else
  391.                     p1 := 2 * p - 1;
  392.                     p2 := 2 * p;
  393.                 fi;
  394.                 nums[j]   := p1;         invnums[k-1] := p1;
  395.                 nums[j-1] := p2;         invnums[k]   := p2;
  396.                 cols[j]   := table[p1];  invcols[k-1] := table[p1];
  397.                 cols[j-1] := table[p2];  invcols[k]   := table[p2];
  398.                 Add( relsGen[p1], [ nums, cols, j ] );
  399.                 Add( relsGen[p2], [ invnums, invcols, k ] );
  400.             od;
  401.  
  402.             while j < extleng do
  403.                 j := j + 1;
  404.                 nums[j] := nums[j-base2];  invnums[j] := invnums[j-base2];
  405.                 cols[j] := cols[j-base2];  invcols[j] := invcols[j-base2];
  406.             od;
  407.  
  408.             nums[1] := length;          invnums[1] := length;
  409.             cols[1] := 2 * length - 3;  invcols[1] := cols[1];
  410.         fi;
  411.     od;
  412.  
  413.     if sort then
  414.         # sort the resulting lists to get better results of the Reduced Rei-
  415.         # demeister-Schreier (this is not needed for the Felsch Todd-Coxeter)
  416.         for i in [ 1 .. numcols ] do
  417.             Sort( relsGen[i], less );
  418.         od;
  419.     fi;
  420.  
  421.     return relsGen;
  422. end;
  423.  
  424.  
  425. #############################################################################
  426. ##
  427. #F  CosetTableFpGroup(<G>,<H>)  . . . . . . . . . . .  do a coset enumeration
  428. ##
  429. ##  'CosetTableFpGroup'   applies   a  Felsch  strategy   Todd-Coxeter  coset
  430. ##  enumeration to construct a coset table of H in G.
  431. ##
  432. if not IsBound( CosetTableFpGroupDefaultLimit )  then
  433.     CosetTableFpGroupDefaultLimit := 1000;
  434. fi;
  435.  
  436. CosetTableFpGroup := function ( G, H )
  437.     local   next,  prev,            # next and previous coset on lists
  438.             firstFree,  lastFree,   # first and last free coset
  439.             firstDef,   lastDef,    # first and last defined coset
  440.             firstCoinc, lastCoinc,  # first and last coincidence coset
  441.             table,                  # columns in the table for gens
  442.             relsGen,                # relators sorted by start generator
  443.             subgroup,               # rows for the subgroup gens
  444.             deductions,             # deduction queue
  445.             i, gen, inv,            # loop variables for generator
  446.             g,                      # loop variable for generator col
  447.             rel,                    # loop variable for relation
  448.             p, p1, p2,              # generator position numbers
  449.             app,                    # arguments list for 'MakeConsequences'
  450.             limit,                  # limit of the table
  451.             j,                      # integer variable
  452.             length, length2,        # length of relator
  453.             cols,
  454.             gen,
  455.             nums,
  456.             l,
  457.             nrdef,                  # number of defined cosets
  458.             nrmax,                  # maximal value of the above
  459.             nrdel,                  # number of deleted cosets
  460.             nrinf;                  # number for next information message
  461.  
  462.     # check the arguments
  463.     if not IsParent( G )  or G <> Parent( H )  then
  464.         Error( "<G> must be the parent group of <H>" );
  465.     fi;
  466.  
  467.     # give some information
  468.     InfoFpGroup1( "#I  ", "CosetTableFpGroup called:\n" );
  469.     InfoFpGroup2( "#I      defined deleted alive   maximal\n");
  470.     nrdef := 1;
  471.     nrmax := 1;
  472.     nrdel := 0;
  473.     nrinf := 1000;
  474.  
  475.     # initial size of the table
  476.     limit := CosetTableFpGroupDefaultLimit;
  477.  
  478.     # define one coset (1)
  479.     firstDef  := 1;  lastDef  := 1;
  480.     firstFree := 2;  lastFree := limit;
  481.  
  482.     # make the lists that link together all the cosets
  483.     next := [2..limit+1];  next[1] := 0;  next[limit] := 0;
  484.     prev := [0..limit-1];  prev[2] := 0;
  485.  
  486.     # make the columns for the generators
  487.     table := [];
  488.     for gen  in G.generators  do
  489.         g := 0 * [1..limit];
  490.         Add( table, g );
  491.         if not ( gen^2 in G.relators or gen^-2 in G.relators ) then
  492.             g := 0 * [1..limit];
  493.         fi;
  494.         Add( table, g );
  495.     od;
  496.  
  497.     # make the rows for the relators and distribute over relsGen
  498.     relsGen := RelsSortedByStartGen( G, table );
  499.  
  500.     # make the rows for the subgroup generators
  501.     subgroup := [];
  502.     for rel  in H.generators  do
  503.         length := LengthWord( rel );
  504.         length2 := 2 * length;
  505.         nums := 0 * [1 .. length2];
  506.         cols := 0 * [1 .. length2];
  507.  
  508.         # compute the lists.
  509.         i := 0;  j := 0;
  510.         while i < length do
  511.             i := i + 1;  j := j + 2;
  512.             gen := Subword( rel, i, i );
  513.             p := Position( G.generators, gen );
  514.             if p = false then
  515.                 p := Position( G.generators, gen^-1 );
  516.                 p1 := 2 * p;
  517.                 p2 := 2 * p - 1;
  518.             else
  519.                 p1 := 2 * p - 1;
  520.                 p2 := 2 * p;
  521.             fi;
  522.             nums[j]   := p1;  cols[j]   := table[p1];
  523.             nums[j-1] := p2;  cols[j-1] := table[p2];
  524.         od;
  525.         Add( subgroup, [ nums, cols ] );
  526.     od;
  527.  
  528.     # add an empty deduction list
  529.     deductions := [];
  530.  
  531.     # make the structure that is passed to 'MakeConsequences'
  532.     app := [ table, next, prev, relsGen, subgroup ];
  533.  
  534.     # run over all the cosets
  535.     while firstDef <> 0  do
  536.  
  537.         # run through all the rows and look for undefined entries
  538.         for i  in [ 1 .. Length( table ) ]  do
  539.             gen := table[i];
  540.  
  541.             if gen[firstDef] = 0  then
  542.  
  543.                 inv := table[i + 2*(i mod 2) - 1];
  544.  
  545.                 # if necessary expand the table
  546.                 if firstFree = 0  then
  547.                     next[2*limit] := 0;
  548.                     prev[2*limit] := 2*limit-1;
  549.                     for g  in table  do g[2*limit] := 0;  od;
  550.                     for l  in [limit+2..2*limit-1]  do
  551.                         next[l] := l+1;
  552.                         prev[l] := l-1;
  553.                         for g  in table  do g[l] := 0;  od;
  554.                     od;
  555.                     next[limit+1] := limit+2;
  556.                     prev[limit+1] := 0;
  557.                     for g  in table  do g[limit+1] := 0;  od;
  558.                     firstFree := limit+1;
  559.                     limit := 2*limit;
  560.                     lastFree := limit;
  561.                 fi;
  562.  
  563.                 # update the debugging information
  564.                 nrdef := nrdef + 1;
  565.                 if nrmax <= firstFree  then
  566.                     nrmax := firstFree;
  567.                 fi;
  568.  
  569.                 # define a new coset
  570.                 gen[firstDef]   := firstFree;
  571.                 inv[firstFree]  := firstDef;
  572.                 next[lastDef]   := firstFree;
  573.                 prev[firstFree] := lastDef;
  574.                 lastDef         := firstFree;
  575.                 firstFree       := next[firstFree];
  576.                 next[lastDef]   := 0;
  577.  
  578.                 # set up the deduction queue and run over it until it's empty
  579.                 app[6] := firstFree;
  580.                 app[7] := lastFree;
  581.                 app[8] := firstDef;
  582.                 app[9] := lastDef;
  583.                 app[10] := i;
  584.                 app[11] := firstDef;
  585.                 nrdel := nrdel + MakeConsequences( app );
  586.                 firstFree := app[6];
  587.                 lastFree := app[7];
  588.                 firstDef := app[8];
  589.                 lastDef  := app[9];
  590.  
  591.                 # give some information
  592.                 while nrinf <= nrdef+nrdel  do
  593.                     InfoFpGroup2( "#I\t", nrdef, "\t", nrinf-nrdef, "\t",
  594.                                           2*nrdef-nrinf, "\t", nrmax, "\n" );
  595.                     nrinf := nrinf + 1000;
  596.                 od;
  597.  
  598.             fi;
  599.         od;
  600.  
  601.         firstDef := next[firstDef];
  602.     od;
  603.  
  604.     InfoFpGroup1( "#I\t", nrdef, "\t", nrdel, "\t",
  605.                           nrdef-nrdel, "\t", nrmax, "\n" );
  606.  
  607.     # standardize the table
  608.     StandardizeTable( table );
  609.  
  610.     # return the table
  611.     return table;
  612. end;
  613.  
  614.  
  615. #############################################################################
  616. ##
  617. #F  FpGroupOps.\in( <w>, <G> ) . . . . membership test for fin. pres. groups
  618. ##
  619. FpGroupOps.\in := function ( w, H )
  620.     local   G,          # parent of <H>
  621.             g,          # one generator of <G>
  622.             c,          # coset in tracing
  623.             i;          # loop variable
  624.  
  625.     # handle trivial case first
  626.     if not IsWord( w )  then
  627.         return false;
  628.  
  629.     # handle the parent group by testing the letters of the word
  630.     elif IsParent( H )  then
  631.         for i  in [ 1 .. LengthWord( w ) ]  do
  632.             g := Subword( w, i, i );
  633.             if not g in H.generators  and not g^-1 in H.generators  then
  634.                 return false;
  635.             fi;
  636.         od;
  637.         return true;
  638.  
  639.     # otherwise trace the word through the coset table
  640.     else
  641.         G := Parent( H );
  642.         if not IsBound( H.cosetTable )  then
  643.             H.cosetTable := CosetTableFpGroup( G, H );
  644.         fi;
  645.         c := 1;
  646.         for i  in [ 1 .. LengthWord( w ) ]  do
  647.             g := Subword( w, i, i );
  648.             if g in G.generators  then
  649.                 c := H.cosetTable[ 2*Position(G.generators,g)-1 ][ c ];
  650.             elif g^-1 in G.generators  then
  651.                 c := H.cosetTable[ 2*Position(G.generators,g^-1) ][ c ];
  652.             else
  653.                 return false;
  654.             fi;
  655.         od;
  656.         return c = 1;
  657.  
  658.     fi;
  659.  
  660. end;
  661.  
  662.  
  663. #############################################################################
  664. ##
  665. #F  FpGroupOps.IsSubset(<G>,<H>)  . . . . is one fp group a subset of another
  666. ##
  667. FpGroupOps.IsSubset := function ( G, H )
  668.     local   isSub;
  669.  
  670.     # avoid calling 'IsFinite' as in 'GroupOps.IsSubset'
  671.     if IsGroup( G )  then
  672.         if IsGroup( H )  then
  673.             isSub :=    G.generators = H.generators
  674.                      or IsSubsetSet( G.generators, H.generators )
  675.                      or (IsBound( H.parent ) and G = H.parent)
  676.                      or ForAll( H.generators, gen -> gen in G );
  677.         elif IsCoset( H )  then
  678.             isSub := IsSubset( G, H.group )
  679.                  and H.representative in G;
  680.         else
  681.             isSub := DomainOps.IsSubset( G, H );
  682.         fi;
  683.     elif IsCoset( G )  then
  684.         if IsGroup( H )  then
  685.             isSub := H.identity in G
  686.                  and ForAll( H.generators, gen -> gen in G );
  687.         else
  688.             isSub := DomainOps.IsSubset( G, H );
  689.         fi;
  690.     else
  691.         isSub := DomainOps.IsSubset( G, H );
  692.     fi;
  693.     return isSub;
  694.  
  695. end;
  696.  
  697.  
  698. #############################################################################
  699. ##
  700. #F  FpGroupOps.Size(<G>)  . . . . . . . . . . . .  size of a fin. pres. group
  701. ##
  702. FpGroupOps.Size := function ( G )
  703.  
  704.     # handle free group
  705.     if IsParent( G )  and not IsBound( G.relators )  then
  706.         return "infinity";
  707.  
  708.     # handle parent group by computing the index of the trivial subgroup
  709.     elif IsParent( G )  then
  710.         return Index( G, TrivialSubgroup( G ) );
  711.  
  712.     # handle other groups via 'Index'
  713.     else
  714.         return Size( Parent( G ) ) / Index( Parent( G ), G );
  715.     fi;
  716.  
  717. end;
  718.  
  719.  
  720. #############################################################################
  721. ##
  722. #F  FpGroupOps.Index(<G>,<H>) . . . . . . . . . . . . . .  index of subgroups
  723. ##
  724. FpGroupOps.Index := function ( G, H )
  725.     if IsParent( G )  then
  726.         if not IsBound( H.cosetTable )  then
  727.             H.cosetTable := CosetTableFpGroup( G, H );
  728.         fi;
  729.         return Length( H.cosetTable[1] );
  730.     else
  731.         return Index( Parent( H ), H ) / Index( Parent( G ), G );
  732.     fi;
  733. end;
  734.  
  735.  
  736. #############################################################################
  737. ##
  738. #F  FpGroupOps.Elements(<G>)  . . . . . . . .  elements of a fin. pres. group
  739. ##
  740. FpGroupOps.Elements := function ( G )
  741.     local   elms,       # elements of <G>, result
  742.             table,      # coset table of <1> in <G>
  743.             c,          # one coset in of <1> in <G>
  744.             i, k, l;    # loop variables
  745.  
  746.     # handle parent groups
  747.     if IsParent( G )  then
  748.         if Size( G ) = "infinity"  then
  749.             Error("sorry cannot list the elements of the free group <G>");
  750.         fi;
  751.         table := G.trivialSubgroup.cosetTable;
  752.         elms := [ IdWord ];
  753.         for i  in [ 2 .. Length( table[1] ) ]  do
  754.             k := 1;
  755.             for l  in [ 2 .. Length( G.generators ) ]  do
  756.                 if table[ 2*l ][ i ] < table[ 2*k ][ i ]  then
  757.                     k := l;
  758.                 fi;
  759.             od;
  760.             Add( elms, elms[ table[ 2*k ][ i ] ] * G.generators[ k ] );
  761.         od;
  762.         return elms;
  763.  
  764.     # otherwise
  765.     else
  766.         elms := Filtered( Elements( Parent( G ) ), elm -> elm in G );
  767.         return elms;
  768.     fi;
  769.  
  770. end;
  771.  
  772.  
  773. #############################################################################
  774. ##
  775. #F  FpGroupOps.Intersection(<G>,<H>)  . intersection of two fin. pres. groups
  776. ##
  777. FpGroupOps.Intersection := function ( G, H )
  778.     local   I,          # intersection of <G> and <H>, result
  779.             table,      # coset table for <I> in its parent
  780.             nrcos,      # number of cosets of <I>
  781.             tableG,     # coset table of <G>
  782.             nrcosG,     # number of cosets of <G>
  783.             tableH,     # coset table of <H>
  784.             nrcosH,     # number of cosets of <H>
  785.             nrgens,     # number of generators of the parent of <G> and <H>
  786.             ren,        # if 'ren[<i>]' is 'nrcosH * <iG> + <iH>' then the
  787.                         # coset <i> of <I> corresponds to the intersection
  788.                         # of the pair of cosets <iG> of <G> and <iH> of <H>
  789.             ner,        # the inverse mapping of 'ren'
  790.             cos,        # coset loop variable
  791.             gen,        # generator loop variable
  792.             img;        # image of <cos> under <gen>
  793.  
  794.     # delegate exceptional case
  795.     if Parent( G ) <> Parent( H )  then
  796.         return DomainOps.Intersection( G, H );
  797.     fi;
  798.  
  799.     # handle trivial cases
  800.     if IsParent( G )  then
  801.         return H;
  802.     elif IsParent( H )  then
  803.         return G;
  804.     fi;
  805.  
  806.     # make sure both subgroups have a coset table
  807.     if not IsBound( G.cosetTable )  then
  808.         G.cosetTable := CosetTableFpGroup( Parent( G ), G );
  809.     fi;
  810.     tableG := G.cosetTable;
  811.     nrcosG := Length( tableG[1] ) + 1;
  812.     if not IsBound( H.cosetTable )  then
  813.         H.cosetTable := CosetTableFpGroup( Parent( H ), H );
  814.     fi;
  815.     tableH := H.cosetTable;
  816.     nrcosH := Length( tableH[1] ) + 1;
  817.  
  818.     # initialize the table for the intersection
  819.     nrgens := Length( Parent( G ).generators );
  820.     table := [];
  821.     for gen  in [ 1 .. nrgens ]  do
  822.         table[ 2*gen-1 ] := [];
  823.         if     Parent( G ).generators[ gen ]^2  in Parent( G ).relators
  824.             or Parent( G ).generators[ gen ]^-2 in Parent( G ).relators
  825.         then
  826.             table[ 2*gen ] := table[ 2*gen-1 ];
  827.         else
  828.             table[ 2*gen ] := [];
  829.         fi;
  830.     od;
  831.  
  832.     # set up the renumbering
  833.     ren := 0 * [ 1 .. nrcosG * nrcosH ];
  834.     ner := 0 * [ 1 .. nrcosG * nrcosH ];
  835.     ren[ 1*nrcosH + 1 ] := 1;
  836.     ner[ 1 ] := 1*nrcosH + 1;
  837.     nrcos := 1;
  838.  
  839.     # the coset table for the intersection is the transitive component of 1
  840.     # in the *tensored* permutation representation
  841.     cos := 1;
  842.     while cos <= nrcos  do
  843.  
  844.         # loop over all entries in this row
  845.         for gen  in [ 1 .. nrgens ]  do
  846.  
  847.             # get the coset pair
  848.             img := nrcosH * tableG[ 2*gen-1 ][ QuoInt( ner[ cos ], nrcosH ) ]
  849.                           + tableH[ 2*gen-1 ][ ner[ cos ] mod nrcosH ];
  850.  
  851.             # if this pair is new give it the next available coset number
  852.             if ren[ img ] = 0  then
  853.                 nrcos := nrcos + 1;
  854.                 ren[ img ] := nrcos;
  855.                 ner[ nrcos ] := img;
  856.             fi;
  857.  
  858.             # and enter it into the coset table
  859.             table[ 2*gen-1 ][ cos ] := ren[ img ];
  860.             table[ 2*gen   ][ ren[ img ] ] := cos;
  861.  
  862.         od;
  863.  
  864.         cos := cos + 1;
  865.     od;
  866.  
  867.     # now make the subgroup
  868.     I := Subgroup( Parent( G ), GeneratorsCosetTable( Parent( G ), table ) );
  869.     I.cosetTable := table;
  870.  
  871.     # and return it
  872.     return I;
  873. end;
  874.  
  875. GeneratorsCosetTable := function ( G, table )
  876.     local   gens,               # generators for the subgroup
  877.             relsGen,            # relators sorted by start generator
  878.             deductions,         # deduction queue
  879.             ded,                # index of current deduction in above
  880.             nrdeds,             # current number of deductions in above
  881.             nrgens,             # number of generators of <G>
  882.             cos,                # loop variable for coset
  883.             i, gen, inv,        # loop variables for generator
  884.             g,                  # loop variable for generator col
  885.             rel,                # loop variable for relation
  886.             p, p1, p2,          # generator position numbers
  887.             triple,             # loop variable for relators as triples
  888.             app,                # arguments list for 'ApplyRel'
  889.             x, y, c;
  890.  
  891.     nrgens := 2 * Length( G.generators ) + 1;
  892.     gens := [];
  893.  
  894.     # make all entries in the table negative
  895.     for cos  in [ 1 .. Length( table[1] ) ]  do
  896.         for gen  in table  do
  897.             if 0 < gen[cos]  then
  898.                 gen[cos] := -gen[cos];
  899.             fi;
  900.         od;
  901.     od;
  902.  
  903.     # make the rows for the relators and distribute over relsGen
  904.     relsGen := RelsSortedByStartGen( G, table );
  905.  
  906.     # make the structure that is passed to 'ApplyRel'
  907.     app := 0 * [ 1 .. 4 ];
  908.  
  909.     # run over all the cosets
  910.     cos := 1;
  911.     while cos <= Length( table[1] )  do
  912.  
  913.         # run through all the rows and look for undefined entries
  914.         for i  in [1..Length(G.generators)]  do
  915.             gen := table[2*i-1];
  916.  
  917.             if gen[cos] < 0  then
  918.  
  919.                 inv := table[2*i];
  920.  
  921.                 # make the Schreier generator for this entry
  922.                 x := IdWord;
  923.                 c := cos;
  924.                 while c <> 1  do
  925.                     g := nrgens - 1;
  926.                     y := nrgens - 1;
  927.                     while 0 < g  do
  928.                         if AbsInt(table[g][c]) <= AbsInt(table[y][c])  then
  929.                             y := g;
  930.                         fi;
  931.                         g := g - 2;
  932.                     od;
  933.                     x := G.generators[ y/2 ] * x;
  934.                     c := AbsInt(table[y][c]);
  935.                 od;
  936.                 x := x * G.generators[ i ];
  937.                 c := AbsInt( gen[ cos ] );
  938.                 while c <> 1  do
  939.                     g := nrgens - 1;
  940.                     y := nrgens - 1;
  941.                     while 0 < g  do
  942.                         if AbsInt(table[g][c]) <= AbsInt(table[y][c])  then
  943.                             y := g;
  944.                         fi;
  945.                         g := g - 2;
  946.                     od;
  947.                     x := x * G.generators[ y/2 ]^-1;
  948.                     c := AbsInt(table[y][c]);
  949.                 od;
  950.                 if x <> IdWord  then
  951.                     Add( gens, x );
  952.                 fi;
  953.  
  954.                 # define a new coset
  955.                 gen[cos]   := - gen[cos];
  956.                 inv[ gen[cos] ] := cos;
  957.  
  958.                 # set up the deduction queue and run over it until it's empty
  959.                 deductions := [ [i,cos] ];
  960.                 nrdeds := 1;
  961.                 ded := 1;
  962.                 while ded <= nrdeds  do
  963.  
  964.                     # apply all relators that start with this generator
  965.                     for triple in relsGen[deductions[ded][1]] do
  966.                         app[1] := triple[3];
  967.                         app[2] := deductions[ded][2];
  968.                         app[3] := -1;
  969.                         app[4] := app[2];
  970.                         if ApplyRel( app, triple[2] ) then
  971.                             triple[2][app[1]][app[2]] := app[4];
  972.                             triple[2][app[3]][app[4]] := app[2];
  973.                             nrdeds := nrdeds + 1;
  974.                             deductions[nrdeds] := [triple[1][app[1]],app[2]];
  975.                         fi;
  976.                     od;
  977.  
  978.                     ded := ded + 1;
  979.                 od;
  980.  
  981.             fi;
  982.         od;
  983.  
  984.         cos := cos + 1;
  985.     od;
  986.  
  987.     # return the generators
  988.     return gens;
  989. end;
  990.  
  991.  
  992. #############################################################################
  993. ##
  994. #F  FpGroupOps.Order(<G>,<w>) . . . order of an element in a fin. pres. group
  995. ##
  996. FpGroupOps.Order := function ( G, w )
  997.     local   ord,        # order of <w>, result
  998.             table,      # coset table of the trivial subgroup of <G>
  999.             g,          # one generator of <G>
  1000.             c,          # coset in tracing
  1001.             i;          # loop variable
  1002.  
  1003.     # trace the word through the coset table of the identity until we hit 1
  1004.     G := Parent( G );
  1005.     if Size( G ) = "infinity"  then
  1006.       Error("sorry, cannot find the order of <w> in the infinite group <G>");
  1007.     fi;
  1008.     table := G.trivialSubgroup.cosetTable;
  1009.     c := 1;
  1010.     ord := 0;
  1011.     repeat
  1012.         for i  in [ 1 .. LengthWord( w ) ]  do
  1013.             g := Subword( w, i, i );
  1014.             if g in G.generators  then
  1015.                 c := table[ 2*Position(G.generators,g)-1 ][ c ];
  1016.             elif g^-1 in G.generators  then
  1017.                 c := table[ 2*Position(G.generators,g^-1) ][ c ];
  1018.             else
  1019.                 Error("<w> must lie in <G>");
  1020.             fi;
  1021.         od;
  1022.         ord := ord + 1;
  1023.     until c = 1;
  1024.     return ord;
  1025.  
  1026. end;
  1027.  
  1028.  
  1029. #############################################################################
  1030. ##
  1031. #F  FpGroupOps.Closure(<G>,<g>) . closure of a subgroup in a fin. pres. group
  1032. ##
  1033. FpGroupOps.Closure := function ( G, w )
  1034.     local   C,          # closure of <G> and <w>, result
  1035.             g;          # one generator
  1036.  
  1037.     # closure with the parent
  1038.     if IsParent( G )  then
  1039.         return G;
  1040.     fi;
  1041.  
  1042.     # handle the closure of a subgroup with another subgroup
  1043.     if IsGroup( w )  then
  1044.         C := G;
  1045.         for g  in w.generators  do
  1046.             C := Closure( C, g );
  1047.         od;
  1048.         return C;
  1049.     fi;
  1050.  
  1051.     # if possible test if the element lies in the group already
  1052.     if IsBound( G.cosetTable )  and w in G  then
  1053.         return G;
  1054.     fi;
  1055.  
  1056.     # otherwise make a new group
  1057.     C := Subgroup( Parent( G ), Concatenation( G.generators, [ w ] ) );
  1058.  
  1059.     # return the closure
  1060.     return C;
  1061. end;
  1062.  
  1063.  
  1064. #############################################################################
  1065. ##
  1066. #F  FpGroupOps.Normalizer(<G>,<H>)  . . . .  normalizer in a fin. pres. group
  1067. ##
  1068. FpGroupOps.Normalizer := function ( G, H )
  1069.     local   N,          # normalizer of <H> in <G>, result
  1070.             table,      # coset table of <H> in its parent
  1071.             nrcos,      # number of cosets in the table
  1072.             nrgens,     # 2*(number of generators of <H>s parent)+1
  1073.             iseql,      # true if coset <c> normalizes <H>
  1074.             r, s,       # renumbering of the coset table and its inverse
  1075.             c, d, e,    # coset loop variables
  1076.             g, h;       # generator loop variables
  1077.  
  1078.     # handle the case the <H> is contained in <G>
  1079.     if IsParent( G )  or IsSubgroup( G, H )  then
  1080.  
  1081.         # first we need the coset table of <H>
  1082.         if not IsBound( H.cosetTable )  then
  1083.             H.cosetTable := CosetTableFpGroup( Parent( H ), H );
  1084.         fi;
  1085.         table := H.cosetTable;
  1086.         nrcos := Length( table[1] );
  1087.         nrgens := 2*Length( Parent(H).generators ) + 1;
  1088.  
  1089.         # find the cosets of <H> in its parent whose elements normalize <H>
  1090.         N := H;
  1091.         for c  in [ 2 .. nrcos ]  do
  1092.  
  1093.             # test if the renumbered table is equal to the original table
  1094.             r := 0 * [ 1 .. nrcos ];
  1095.             s := 0 * [ 1 .. nrcos ];
  1096.             r[c] := 1;  s[1] := c;
  1097.             e := 1;
  1098.             iseql := true;
  1099.             d := 1;
  1100.             while d <= nrcos  and iseql  do
  1101.                 g := 1;
  1102.                 while g < nrgens  and iseql  do
  1103.                     if r[ table[g][s[d]] ] = 0  then
  1104.                         e := e + 1;
  1105.                         r[ table[g][s[d]] ] := e;
  1106.                         s[ e ] := table[g][s[d]];
  1107.                     fi;
  1108.                     iseql := (r[ table[g][s[d]] ] = table[g][d]);
  1109.                     g := g + 2;
  1110.                 od;
  1111.                 d := d + 1;
  1112.             od;
  1113.  
  1114.             # add the representative of this coset if it normalizes
  1115.             if iseql  then
  1116.                 r := IdWord;
  1117.                 d := c;
  1118.                 while d <> 1  do
  1119.                     g := nrgens - 1;
  1120.                     h := nrgens - 1;
  1121.                     while 0 < g  do
  1122.                         if table[g][d] <= table[h][d]  then
  1123.                             h := g;
  1124.                         fi;
  1125.                         g := g - 2;
  1126.                     od;
  1127.                     r := Parent( H ).generators[ h/2 ] * r;
  1128.                     d := table[h][d];
  1129.                 od;
  1130.                 if r in G  and not r in N  then
  1131.                     N := Closure( N, r );
  1132.                 fi;
  1133.             fi;
  1134.  
  1135.         od;
  1136.  
  1137.     # delegate other cases
  1138.     else
  1139.  
  1140.         N := GroupOps.Normalizer( G, H );
  1141.  
  1142.     fi;
  1143.  
  1144.     # return the normalizer
  1145.     return N;
  1146. end;
  1147.  
  1148.  
  1149. #############################################################################
  1150. ##
  1151. #F  FpGroupOps.IsAbelian( <G> ) . . . . test if a fin. pres. group is abelian
  1152. ##
  1153. FpGroupOps.IsAbelian := function ( G )
  1154.     local   isAbelian,  # result
  1155.             g, h,       # two generators of <G>
  1156.             i, k;       # loop variables
  1157.     isAbelian := true;
  1158.     for i  in [ 1 .. Length( G.generators ) - 1 ]  do
  1159.         g := G.generators[i];
  1160.         for k  in [ i + 1 .. Length( G.generators ) ]  do
  1161.             h := G.generators[k];
  1162.             isAbelian :=     isAbelian
  1163.                          and (Comm( g, h ) in G.relators
  1164.                            or Comm( g, h ) in TrivialSubgroup( G ));
  1165.         od;
  1166.     od;
  1167.     return isAbelian;
  1168. end;
  1169.  
  1170.  
  1171. #############################################################################
  1172. ##
  1173. #F  FpGroupOps.CommutatorFactorGroup( <G> ) . . . . . commutator factor group
  1174. #F                                                      of a fin. pres. group
  1175. ##
  1176. FpGroupOps.CommutatorFactorGroup := function ( G )
  1177.     local   C,          # commutator factor group of <G>, result
  1178.             gens,       # generators of <C>
  1179.             rels,       # relators of <C>
  1180.             rel,        # one relation of <C>
  1181.             old,        # one relation of <G>
  1182.             g, h,       # two generators of <G> or <C>
  1183.             i, k;       # loop variables
  1184.  
  1185.     # we can handle only groups with relators
  1186.     if not IsParent( G )  then
  1187.         G := FpGroup( G );
  1188.     fi;
  1189.  
  1190.     # make a new set of generators
  1191.     gens := [];
  1192.     for i  in [ 1 .. Length( G.generators ) ]  do
  1193.         gens[i] := AbstractGenerator(
  1194.                         ConcatenationString( "c.", String( i ) )
  1195.                    );
  1196.     od;
  1197.  
  1198.     # make the relators
  1199.     rels := [];
  1200.     for old  in G.relators  do
  1201.         rel := IdWord;
  1202.         for i  in [ 1 .. LengthWord( old ) ]  do
  1203.             g := Subword( old, i, i );
  1204.             if g in G.generators  then
  1205.                 rel := rel * gens[ Position( G.generators, g ) ];
  1206.             else
  1207.                 rel := rel * gens[ Position( G.generators, g^-1 ) ]^-1;
  1208.             fi;
  1209.         od;
  1210.         Add( rels, rel );
  1211.     od;
  1212.  
  1213.     # add the commutator relators
  1214.     for i  in [ 1 .. Length( gens ) - 1 ]  do
  1215.         g := gens[i];
  1216.         for k  in [ i + 1 .. Length( gens ) ]  do
  1217.             h := gens[k];
  1218.             if not Comm( g, h ) in rels  then
  1219.                 Add( rels, Comm( g, h ) );
  1220.             fi;
  1221.         od;
  1222.     od;
  1223.  
  1224.     # make the commutator factor group and return it
  1225.     C := Group( gens, IdWord );
  1226.     C.relators := rels;
  1227.     C.isAbelian := true;
  1228.     return C;
  1229. end;
  1230.  
  1231.  
  1232. #############################################################################
  1233. ##
  1234. #F  FpGroupOps.AbelianInvariants(<G>) . . .  abelian invariants of an abelian
  1235. #F                                                           fin. pres. group
  1236. ##
  1237. FpGroupOps.AbelianInvariants := function ( G )
  1238.  
  1239.     local   abl,        # abelian invariants of <G>, result
  1240.             mat,        # relation matrix of <G>
  1241.             row,        # one row of <mat>
  1242.             rel,        # one relation of <G>
  1243.             g,          # one letter of <rel>
  1244.             p,          # position of <g> or its inverse in '<G>.generators'
  1245.             i,          # loop variable
  1246.             divs,       # elementary divisors
  1247.             gcd,        # extended gcd
  1248.             m, n, k;
  1249.  
  1250.     # we can handle only groups with relators
  1251.     if not IsParent( G )  then
  1252.         G := FpGroup( G );
  1253.     fi;
  1254.  
  1255.     # make the relation matrix
  1256.     mat := [];
  1257.     for rel  in G.relators  do
  1258.         row := [];
  1259.         for i  in [ 1 .. Length( G.generators ) ]  do
  1260.             row[i] := 0;
  1261.         od;
  1262.         for i  in [ 1 .. LengthWord( rel ) ]  do
  1263.             g := Subword( rel, i, i );
  1264.             p := Position( G.generators, g );
  1265.             if p <> false  then
  1266.                 row[ p ] := row[ p ] + 1;
  1267.             else
  1268.                 p := Position( G.generators, g^-1 );
  1269.                 row[ p ] := row[ p ] - 1;
  1270.             fi;
  1271.         od;
  1272.         Add( mat, row );
  1273.     od;
  1274.  
  1275.     # diagonalize the matrix
  1276.     DiagonalizeMat( mat );
  1277.  
  1278.     # get the diagonal elements
  1279.     m := Length(mat);  n := Length(mat[1]);
  1280.     divs := [];
  1281.     for i  in [1..Minimum(m,n)]  do
  1282.         divs[i] := mat[i][i];
  1283.     od;
  1284.  
  1285.     # transform the divisors so that every divisor divides the next
  1286.     for i  in [1..Length(divs)-1]  do
  1287.         for k  in [i+1..Length(divs)]  do
  1288.             if divs[i] <> 0  and divs[k] mod divs[i] <> 0  then
  1289.                 gcd     := GcdInt( divs[i], divs[k] );
  1290.                 divs[k] := divs[k] / gcd * divs[i];
  1291.                 divs[i] := gcd;
  1292.             fi;
  1293.         od;
  1294.     od;
  1295.  
  1296.     # and return the ablian invariants
  1297.     abl := [];
  1298.     for i  in divs  do
  1299.         if i <> 1  then
  1300.             Add( abl, i );
  1301.         fi;
  1302.     od;
  1303.     return abl;
  1304. end;
  1305.  
  1306.  
  1307. #############################################################################
  1308. ##
  1309. #F  OperationCosetsFpGroup(<G>,<H>) . . . . . . . . . operation on the cosets
  1310. ##
  1311. OperationCosetsFpGroup := function ( G, H )
  1312.     local   P,          # permutation group, result
  1313.             gens,       # generators of <P>
  1314.             i;          # loop variable
  1315.  
  1316.     # check the arguments
  1317.     if not IsParent( G )  or G <> Parent( H )  then
  1318.         Error("<G> must be the parent group of <H>");
  1319.     fi;
  1320.  
  1321.     # first we need the coset table of <H>
  1322.     if not IsBound( H.cosetTable )  then
  1323.         H.cosetTable := CosetTableFpGroup( G, H );
  1324.     fi;
  1325.  
  1326.     # now make the permutation group
  1327.     gens := [];
  1328.     for i  in [1..Length(H.cosetTable)/2]  do
  1329.         Add( gens, PermList( H.cosetTable[2*i-1] ) );
  1330.     od;
  1331.     P := Group( gens, () );
  1332.     P.operationGroup     := G;
  1333.     P.operationDomain    := H;
  1334.     P.operationOperation := "OperationCosetsFpGroup";
  1335.     P.operationImages    := gens;
  1336.  
  1337.     # return the permutation group
  1338.     return P;
  1339. end;
  1340.  
  1341.  
  1342. #############################################################################
  1343. ##
  1344. #F  FpGroupOps.OperationHomomorphism(<G>,<P>) . . . .  operation homomorphism
  1345. #F                                            from a finitely presented group
  1346. ##
  1347. FpGroupOps.OperationHomomorphism := function ( G, P )
  1348.     local   hom;
  1349.     if P.operationOperation = "OperationCosetsFpGroup"  then
  1350.         hom := GroupHomomorphismByImages( G, P,
  1351.                                           G.generators, P.operationImages );
  1352.         hom.isMapping := true;
  1353.     else
  1354.         hom := GroupOps.OperationsHomomorphism( G, P );
  1355.     fi;
  1356.     return hom;
  1357. end;
  1358.  
  1359.  
  1360. #############################################################################
  1361. ##
  1362. #F  FpGroupOps.GroupHomomorphismByImages(<G>,<H>,<gens>,<imgs>) . . .  create
  1363. #F   a finitely presented group homomorphism by images of a generating system
  1364. ##
  1365. FpGroupHomomorphismByImagesOps := Copy( GroupHomomorphismByImagesOps );
  1366.  
  1367. FpGroupOps.GroupHomomorphismByImages := function ( G, H, gens, imgs )
  1368.     local   hom;        # homomorphism from <G> to <H>, result
  1369.  
  1370.     # check that we can handle the situation
  1371.     if Set( gens ) <>  Set( G.generators )  then
  1372.         Error("arbitrary generating systems not yet allowed for fp groups");
  1373.     fi;
  1374.  
  1375.     # make the homomorphism
  1376.     hom := rec();
  1377.     hom.isGeneralMapping := true;
  1378.     hom.domain          := Mappings;
  1379.  
  1380.     # enter the identifying information
  1381.     hom.source          := G;
  1382.     hom.range           := H;
  1383.     hom.generators      := gens;
  1384.     hom.genimages       := imgs;
  1385.  
  1386.     # enter usefull information (precious little)
  1387.     if IsEqualSet( gens, G.generators )  then
  1388.         hom.preimage    := G;
  1389.     else
  1390.         hom.preimage    := Parent(G).operations.Subgroup( Parent(G), gens );
  1391.     fi;
  1392.     if IsSubsetSet( imgs, H.generators )  then
  1393.         hom.image       := H;
  1394.     else
  1395.         hom.image       := Parent(H).operations.Subgroup( Parent(H), imgs );
  1396.     fi;
  1397.  
  1398.     # enter the operations record
  1399.     hom.operations      := FpGroupHomomorphismByImagesOps;
  1400.  
  1401.     # return the homomorphism
  1402.     return hom;
  1403. end;
  1404.  
  1405. FpGroupHomomorphismByImagesOps.CoKernel := function ( hom )
  1406.     local   C;
  1407.  
  1408.     C := NormalClosure( hom.image,
  1409.                         Subgroup( Parent( hom.image ),
  1410.                                   List( hom.source.relators,
  1411.                                         rel -> MappedWord( rel,
  1412.                                                            hom.generators,
  1413.                                                            hom.genimages))));
  1414.  
  1415.     return C;
  1416. end;
  1417.  
  1418. FpGroupHomomorphismByImagesOps.IsMapping := function ( hom )
  1419.     return hom.source = hom.preimage
  1420.        and ForAll( hom.source.relators,
  1421.                    rel -> MappedWord( rel, hom.generators, hom.genimages )
  1422.                           = hom.range.identity );
  1423. end;
  1424.  
  1425. FpGroupHomomorphismByImagesOps.IsGroupHomomorphism := function ( hom )
  1426.     return IsMapping( hom );
  1427. end;
  1428.  
  1429. FpGroupHomomorphismByImagesOps.ImageElm := function ( hom, elm )
  1430.     if not IsMapping( hom )  then
  1431.         Error("<hom> must be a single valued mapping");
  1432.     fi;
  1433.     return MappedWord( elm, hom.generators, hom.genimages );
  1434. end;
  1435.  
  1436. FpGroupHomomorphismByImagesOps.ImagesElm := function ( hom, elm )
  1437.     if not IsBound( hom.coKernel )  then
  1438.         hom.coKernel := hom.operations.CoKernel( hom );
  1439.     fi;
  1440.     return hom.coKernel * MappedWord( elm, hom.generators, hom.genimages );
  1441. end;
  1442.  
  1443. FpGroupHomomorphismByImagesOps.ImagesSet := function ( hom, elms )
  1444.     if IsGroup( elms )  and IsSubset( hom.source, elms )  then
  1445.         if not IsBound( hom.coKernel )  then
  1446.             hom.coKernel := hom.operations.CoKernel( hom );
  1447.         fi;
  1448.         return Closure( hom.coKernel,
  1449.                         Parent( hom.range ).operations.Subgroup(
  1450.                                 Parent( hom.range ),
  1451.                                 List( elms.generators,
  1452.                                       gen -> MappedWord( gen,
  1453.                                                          hom.generators,
  1454.                                                          hom.genimages))));
  1455.     else
  1456.         return GroupHomomorphismOps.ImagesSet( hom, elms );
  1457.     fi;
  1458. end;
  1459.  
  1460. FpGroupHomomorphismByImagesOps.ImagesRepresentative := function ( hom, elm )
  1461.     return MappedWord( elm, hom.generators, hom.genimages );
  1462. end;
  1463.  
  1464. FpGroupHomomorphismByImagesOps.CompositionMapping := function ( hom1, hom2 )
  1465.     local   prd;        # product of <hom1> and <hom2>, result
  1466.  
  1467.     # product of a homomorphism by generator images
  1468.     if IsHomomorphism( hom2 )  and IsBound( hom2.genimages )  then
  1469.  
  1470.         # with another homomorphism
  1471.         if IsHomomorphism( hom1 )  then
  1472.  
  1473.             # just do it
  1474.             prd := GroupHomomorphismByImages(
  1475.                         hom2.source,
  1476.                         hom1.range,
  1477.                         hom2.generators,
  1478.                         List( hom2.genimages, img -> Image( hom1, img ) ) );
  1479.  
  1480.         # with another mapping
  1481.         else
  1482.  
  1483.             prd := MappingOps.CompositionMapping( hom1, hom2 );
  1484.  
  1485.         fi;
  1486.  
  1487.     # of something else
  1488.     else
  1489.         prd := MappingOps.CompositionMapping( hom1, hom2 );
  1490.     fi;
  1491.  
  1492.     # return the product
  1493.     return prd;
  1494. end;
  1495.  
  1496. FpGroupHomomorphismByImagesOps.Print := function ( hom )
  1497.     Print( "GroupHomomorphismByImages( ",
  1498.            hom.source, ", ", hom.range, ", ",
  1499.            hom.generators, ", ", hom.genimages, " )" );
  1500. end;
  1501.  
  1502.  
  1503. #############################################################################
  1504. ##
  1505. #F  LowIndexSubgroupsFpGroup(<G>,<index>) . find all subgroups of small index
  1506. #F                                                      in a fin. pres. group
  1507. ##
  1508. LowIndexSubgroupsFpGroup := function ( G, H, index )
  1509.     local   subs,       # subgroups of <G>, result
  1510.             sub,        # one subgroup
  1511.             gens,       # generators of <sub>
  1512.             table,      # coset table
  1513.             nrgens,     # 2*(number of generators)+1
  1514.             nrcos,      # number of cosets in the coset table
  1515.             action,     # 'action[<i>]' is "definition" or "choice" or "ded"
  1516.             actgen,     # 'actgen[<i>]' is the gen where this action was
  1517.             actcos,     # 'actcos[<i>]' is the coset where this action was
  1518.             nract,      # number of actions
  1519.             nrded,      # number of deductions already handled
  1520.             coinc,      # 'true' if a coincidence happened
  1521.             gen,        # current generator
  1522.             cos,        # current coset
  1523.             relsGen,    # relators sorted by start generator
  1524.             subgroup,   # rows for the subgroup gens
  1525.             app,        # arguments list for 'ApplyRel'
  1526.             later,      # 'later[<i>]' is <> 0 if <i> is smaller than 1
  1527.             nrfix,      # index of a subgroup in its normalizer
  1528.             pair,       # loop variable for subgroup generators as pairs
  1529.             rel,        # loop variable for relators
  1530.             triple,     # loop variable for relators as triples
  1531.             r, s, x, y, # loop variables
  1532.             g, c, d,    # loop variables
  1533.             p, p1, p2,  # generator position numbers
  1534.             length,     # relator length
  1535.             length2,    # twice a relator length
  1536.             cols,
  1537.             gen,
  1538.             nums,
  1539.             i, j;       # loop variables
  1540.  
  1541.     # give some information
  1542.     InfoFpGroup1("#I  LowIndexSubgroupsFpGroup called\n");
  1543.  
  1544.     # check the arguments
  1545.     if not IsParent( G )  or G <> Parent( H )  then
  1546.         Error("<G> must be the parent group of <H>");
  1547.     fi;
  1548.  
  1549.     # initialize the subgroup list
  1550.     subs := [];
  1551.  
  1552.     # initialize table
  1553.     nrgens := 2*Length(G.generators)+1;
  1554.     nrcos := 1;
  1555.     table := [];
  1556.     for gen  in G.generators  do
  1557.         g := 0*[1..index];
  1558.         Add( table, g );
  1559.         if not ( gen^2 in G.relators or gen^-2 in G.relators ) then
  1560.             g := 0*[1..index];
  1561.         fi;
  1562.         Add( table, g );
  1563.     od;
  1564.  
  1565.     # make the rows for the relators and distribute over relsGen
  1566.     relsGen := RelsSortedByStartGen( G, table );
  1567.  
  1568.     # make the rows for the subgroup generators
  1569.     subgroup := [];
  1570.     for rel  in H.generators  do
  1571.         length := LengthWord( rel );
  1572.         length2 := 2 * length;
  1573.         nums := 0 * [1 .. length2];
  1574.         cols := 0 * [1 .. length2];
  1575.  
  1576.         # compute the lists.
  1577.         i := 0;  j := 0;
  1578.         while i < length do
  1579.             i := i + 1;  j := j + 2;
  1580.             gen := Subword( rel, i, i );
  1581.             p := Position( G.generators, gen );
  1582.             if p = false then
  1583.                 p := Position( G.generators, gen^-1 );
  1584.                 p1 := 2 * p;
  1585.                 p2 := 2 * p - 1;
  1586.             else
  1587.                 p1 := 2 * p - 1;
  1588.                 p2 := 2 * p;
  1589.             fi;
  1590.             nums[j]   := p1;  cols[j]   := table[p1];
  1591.             nums[j-1] := p2;  cols[j-1] := table[p2];
  1592.         od;
  1593.         Add( subgroup, [ nums, cols ] );
  1594.     od;
  1595.  
  1596.     # make an structure that is passed to 'ApplyRel'
  1597.     app := 0 * [ 1 .. 4 ];
  1598.  
  1599.     # set up the action stack
  1600.     nract := 1;
  1601.     action := [ "choice" ];
  1602.     gen := 1;
  1603.     actgen := [ gen ];
  1604.     cos := 1;
  1605.     actcos := [ cos ];
  1606.  
  1607.     # set up the lexicographical information list
  1608.     later := 0 * [1..index];
  1609.  
  1610.     # do an exhaustive backtrack search
  1611.     while 1 < nract  or table[1][1] < 2  do
  1612.  
  1613.         # find the next choice that does not already appear in this col.
  1614.         c := table[ gen ][ cos ];
  1615.         repeat
  1616.             c := c + 1;
  1617.         until index < c  or table[ gen+1 ][ c ] = 0;
  1618.  
  1619.         # if there is a further choice try it
  1620.         if action[nract] <> "definition"  and c <= index  then
  1621.  
  1622.             # remove the last choice from the table
  1623.             d := table[ gen ][ cos ];
  1624.             if d <> 0  then
  1625.                 table[ gen+1 ][ d ] := 0;
  1626.             fi;
  1627.  
  1628.             # enter it in the table
  1629.             table[ gen ][ cos ] := c;
  1630.             table[ gen+1 ][ c ] := cos;
  1631.  
  1632.             # and put information on the action stack
  1633.             if c = nrcos + 1  then
  1634.                 nrcos := nrcos + 1;
  1635.                 action[ nract ] := "definition";
  1636.             else
  1637.                 action[ nract ] := "choice";
  1638.             fi;
  1639.  
  1640.             # run through the deduction queue until it is empty
  1641.             nrded := nract;
  1642.             coinc := false;
  1643.             while nrded <= nract and not coinc  do
  1644.  
  1645.                 # if there are still subgroup generators apply them
  1646.                 for pair in subgroup  do
  1647.                     app[1] := 2;
  1648.                     app[2] := 1;
  1649.                     app[3] := Length(pair[2])-1;
  1650.                     app[4] := 1;
  1651.                     if ApplyRel( app, pair[2] )  then
  1652.                         if   pair[2][app[1]][app[2]] <> 0  then
  1653.                             coinc := true;
  1654.                         elif pair[2][app[3]][app[4]] <> 0  then
  1655.                             coinc := true;
  1656.                         else
  1657.                             pair[2][app[1]][app[2]] := app[4];
  1658.                             pair[2][app[3]][app[4]] := app[2];
  1659.                             nract := nract + 1;
  1660.                             action[ nract ] := "deduction";
  1661.                             actgen[ nract ] := pair[1][app[1]];
  1662.                             actcos[ nract ] := app[2];
  1663.                         fi;
  1664.                     fi;
  1665.                 od;
  1666.  
  1667.                 # apply all relators that start with this generator
  1668.                 for triple in relsGen[actgen[nrded]]  do
  1669.                     app[1] := triple[3];
  1670.                     app[2] := actcos[ nrded ];
  1671.                     app[3] := -1;
  1672.                     app[4] := app[2];
  1673.                     if ApplyRel( app, triple[2] )  then
  1674.                         if   triple[2][app[1]][app[2]] <> 0  then
  1675.                             coinc := true;
  1676.                         elif triple[2][app[3]][app[4]] <> 0  then
  1677.                             coinc := true;
  1678.                         else
  1679.                             triple[2][app[1]][app[2]] := app[4];
  1680.                             triple[2][app[3]][app[4]] := app[2];
  1681.                             nract := nract + 1;
  1682.                             action[ nract ] := "deduction";
  1683.                             actgen[ nract ] := triple[1][app[1]];
  1684.                             actcos[ nract ] := app[2];
  1685.                         fi;
  1686.                     fi;
  1687.                 od;
  1688.  
  1689.                 nrded := nrded + 1;
  1690.             od;
  1691.  
  1692.             # unless there was a coincidence check lexicography
  1693.             nrfix := 1;
  1694.             for x  in [2..nrcos]  do
  1695.  
  1696.                 # set up the renumbering
  1697.                 r := 0 * [1..nrcos];
  1698.                 s := 0 * [1..nrcos];
  1699.                 r[x] := 1;  s[1] := x;
  1700.  
  1701.                 # run through the old and the new table in parallel
  1702.                 c := 1;  y := 1;
  1703.                 while c <= nrcos  and not coinc  and later[x] = 0  do
  1704.  
  1705.                     # get the corresponding coset for the new table
  1706.                     d := s[c];
  1707.  
  1708.                     # loop over the entries in this row
  1709.                     g := 1;
  1710.                     while   g < nrgens
  1711.                         and c <= nrcos  and not coinc  and later[x] = 0  do
  1712.  
  1713.                         # if either entry is missing we cannot decide yet
  1714.                         if table[g][c] = 0  or table[g][d] = 0  then
  1715.                             c := nrcos + 1;
  1716.  
  1717.                         # if old and new both contain a definition
  1718.                         elif r[ table[g][d] ] = 0 and table[g][c] = y+1  then
  1719.                             y := y + 1;
  1720.                             r[ table[g][d] ] := y;
  1721.                             s[ y ] := table[g][d];
  1722.  
  1723.                         # if only new is a definition
  1724.                         elif r[ table[g][d] ] = 0  then
  1725.                             later[x] := nract;
  1726.  
  1727.                         # if new is the smaller one we have a coincidence
  1728.                         elif r[ table[g][d] ] < table[g][c]  then
  1729.                             #N  05-Feb-91 martin check that <x> fixes <H>
  1730.                             coinc := true;
  1731.  
  1732.                         # if the old is smaller one very good
  1733.                         elif table[g][c] < r[ table[g][d] ]  then
  1734.                             later[x] := nract;
  1735.  
  1736.                         fi;
  1737.  
  1738.                         g := g + 2;
  1739.                     od;
  1740.  
  1741.                     c := c + 1;
  1742.                 od;
  1743.  
  1744.                 if c = nrcos + 1  then
  1745.                     nrfix := nrfix + 1;
  1746.                 fi;
  1747.  
  1748.             od;
  1749.  
  1750.             # if there was no coincidence
  1751.             if not coinc  then
  1752.  
  1753.                 # look for another empty place
  1754.                 c := cos;
  1755.                 g := gen;
  1756.                 while c <= nrcos  and table[ g ][ c ] <> 0  do
  1757.                     g := g + 2;
  1758.                     if g = nrgens  then
  1759.                         c := c + 1;
  1760.                         g := 1;
  1761.                     fi;
  1762.                 od;
  1763.  
  1764.                 # if there is an empty place, make this a new choice point
  1765.                 if c <= nrcos  then
  1766.  
  1767.                     nract := nract + 1;
  1768.                     action[ nract ] := "choice"; # necessary?
  1769.                     gen := g;
  1770.                     actgen[ nract ] := gen;
  1771.                     cos := c;
  1772.                     actcos[ nract ] := cos;
  1773.                     table[ gen ][ cos ] := 0; # necessary?
  1774.  
  1775.                 # otherwise we found a subgroup
  1776.                 else
  1777.  
  1778.                     # give some information
  1779.                     InfoFpGroup2( "#I   class ", Length(subs)+1,
  1780.                                   " of index ", nrcos,
  1781.                                   " and length ", nrcos / nrfix, "\n" );
  1782.  
  1783.                     # find a generating system for the subgroup
  1784.                     gens := [];
  1785.                     for i  in [ 1 .. nract ]  do
  1786.                         if action[ i ] = "choice"  then
  1787.                             x := IdWord;
  1788.                             c := actcos[i];
  1789.                             while c <> 1  do
  1790.                                 g := nrgens - 1;
  1791.                                 y := nrgens - 1;
  1792.                                 while 0 < g  do
  1793.                                     if table[g][c] <= table[y][c]  then
  1794.                                         y := g;
  1795.                                     fi;
  1796.                                     g := g - 2;
  1797.                                 od;
  1798.                                 x := G.generators[ y/2 ] * x;
  1799.                                 c := table[y][c];
  1800.                             od;
  1801.                             x := x * G.generators[ (actgen[i]+1)/2 ];
  1802.                             c := table[ actgen[i] ][ actcos[i] ];
  1803.                             while c <> 1  do
  1804.                                 g := nrgens - 1;
  1805.                                 y := nrgens - 1;
  1806.                                 while 0 < g  do
  1807.                                     if table[g][c] <= table[y][c]  then
  1808.                                         y := g;
  1809.                                     fi;
  1810.                                     g := g - 2;
  1811.                                 od;
  1812.                                 x := x * G.generators[ y/2 ]^-1;
  1813.                                 c := table[y][c];
  1814.                             od;
  1815.                             Add( gens, x );
  1816.                         fi;
  1817.                     od;
  1818.  
  1819.                     # add the coset table
  1820.                     sub := Subgroup( Parent( G ), gens );
  1821.                     sub.cosetTable := [];
  1822.                     for g  in [ 1 .. Length( G.generators ) ]  do
  1823.                         sub.cosetTable[2*g-1]
  1824.                                 := Sublist( table[2*g-1], [1..nrcos] );
  1825.                         if     G.generators[g]^2  in G.relators
  1826.                             or G.generators[g]^-2 in G.relators
  1827.                         then
  1828.                             sub.cosetTable[2*g]
  1829.                                 := sub.cosetTable[2*g-1];
  1830.                         else
  1831.                             sub.cosetTable[2*g]
  1832.                                 := Sublist( table[2*g], [1..nrcos] );
  1833.                         fi;
  1834.                     od;
  1835.  
  1836.                     # add this subgroup to the list of subgroups
  1837.                     #N  05-Feb-92 martin should be 'ConjugacyClassSubgroup'
  1838.                     Add( subs, sub );
  1839.  
  1840.                     # undo all deductions since the previous choice point
  1841.                     while action[ nract ] = "deduction"  do
  1842.                         g := actgen[ nract ];
  1843.                         c := actcos[ nract ];
  1844.                         d := table[ g ][ c ];
  1845.                         if g mod 2 = 1  then
  1846.                             table[ g   ][ c ] := 0;
  1847.                             table[ g+1 ][ d ] := 0;
  1848.                         else
  1849.                             table[ g   ][ c ] := 0;
  1850.                             table[ g-1 ][ d ] := 0;
  1851.                         fi;
  1852.                         nract := nract - 1;
  1853.                     od;
  1854.                     for x  in [2..index]  do
  1855.                         if nract <= later[x]  then
  1856.                             later[x] := 0;
  1857.                         fi;
  1858.                     od;
  1859.  
  1860.                 fi;
  1861.  
  1862.             # if there was a coincendence go back to the current choice point
  1863.             else
  1864.  
  1865.                 # undo all deductions since the previous choice point
  1866.                 while action[ nract ] = "deduction"  do
  1867.                     g := actgen[ nract ];
  1868.                     c := actcos[ nract ];
  1869.                     d := table[ g ][ c ];
  1870.                     if g mod 2 = 1  then
  1871.                         table[ g   ][ c ] := 0;
  1872.                         table[ g+1 ][ d ] := 0;
  1873.                     else
  1874.                         table[ g   ][ c ] := 0;
  1875.                         table[ g-1 ][ d ] := 0;
  1876.                     fi;
  1877.                     nract := nract - 1;
  1878.                 od;
  1879.                 for x  in [2..index]  do
  1880.                     if nract <= later[x]  then
  1881.                         later[x] := 0;
  1882.                     fi;
  1883.                 od;
  1884.  
  1885.             fi;
  1886.  
  1887.         # go back to the previous choice point if there are no more choices
  1888.         else
  1889.  
  1890.             # undo the choice point
  1891.             if action[ nract ] = "definition"  then
  1892.                 nrcos := nrcos - 1;
  1893.             fi;
  1894.             g := actgen[ nract ];
  1895.             c := actcos[ nract ];
  1896.             d := table[ g ][ c ];
  1897.             if g mod 2 = 1  then
  1898.                 table[ g   ][ c ] := 0;
  1899.                 table[ g+1 ][ d ] := 0;
  1900.             else
  1901.                 table[ g   ][ c ] := 0;
  1902.                 table[ g-1 ][ d ] := 0;
  1903.             fi;
  1904.             nract := nract - 1;
  1905.  
  1906.             # undo all deductions since the previous choice point
  1907.             while action[ nract ] = "deduction"  do
  1908.                 g := actgen[ nract ];
  1909.                 c := actcos[ nract ];
  1910.                 d := table[ g ][ c ];
  1911.                 if g mod 2 = 1  then
  1912.                     table[ g   ][ c ] := 0;
  1913.                     table[ g+1 ][ d ] := 0;
  1914.                 else
  1915.                     table[ g   ][ c ] := 0;
  1916.                     table[ g-1 ][ d ] := 0;
  1917.                 fi;
  1918.                 nract := nract - 1;
  1919.             od;
  1920.             for x  in [2..index]  do
  1921.                 if nract <= later[x]  then
  1922.                     later[x] := 0;
  1923.                 fi;
  1924.             od;
  1925.  
  1926.             cos := actcos[ nract ];
  1927.             gen := actgen[ nract ];
  1928.  
  1929.         fi;
  1930.  
  1931.     od;
  1932.  
  1933.     # give some final information
  1934.     InfoFpGroup1("#I  LowIndexSubgroupsFpGroup returns ",
  1935.                  Length(subs), " classes\n" );
  1936.  
  1937.     # return the subgroups
  1938.     return subs;
  1939. end;
  1940.  
  1941.  
  1942. #############################################################################
  1943. ##
  1944. #R  Read  . . . . . . . . . . . . .  read other function from the other files
  1945. ##
  1946. ReadLib( "fptietze" );
  1947. ReadLib( "fpsgpres" );
  1948.  
  1949.  
  1950. #############################################################################
  1951. ##
  1952. #E  Emacs . . . . . . . . . . . . . . . . . . . . . . . local emacs variables
  1953. ##
  1954. ##  Local Variables:
  1955. ##  mode:               outline
  1956. ##  outline-regexp:     "#F\\|#V\\|#E"
  1957. ##  fill-column:        73
  1958. ##  fill-prefix:        "##  "
  1959. ##  eval:               (hide-body)
  1960. ##  End:
  1961. ##
  1962.  
  1963.  
  1964.  
  1965.