home *** CD-ROM | disk | FTP | other *** search
/ Math Solutions 1995 October / Math_Solutions_CD-ROM_Walnut_Creek_October_1995.iso / pc / mac / discrete / lib / lattgrp.g < prev    next >
Encoding:
Text File  |  1993-05-05  |  70.7 KB  |  2,353 lines
  1. #############################################################################
  2. ##
  3. #A  lattgrp.g                   GAP library                    J\"urgen Mnich
  4. ##
  5. #A  @(#)$Id: lattgrp.g,v 3.10 1993/02/09 15:46:04 martin Rel $
  6. ##
  7. #Y  Copyright 1990-1992,  Lehrstuhl D fuer Mathematik,  RWTH Aachen,  Germany
  8. ##
  9. ##  This file contains the program for calculating the lattice of subgroups.
  10. ##
  11. #H  $Log: lattgrp.g,v $
  12. #H  Revision 3.10  1993/02/09  15:46:04  martin
  13. #H  changed argument test in 'TableOfMarks'
  14. #H
  15. #H  Revision 3.9  1993/02/09  14:25:55  martin
  16. #H  made undefined globals local
  17. #H
  18. #H  Revision 3.8  1993/01/20  17:40:03  felsch
  19. #H  removed overlong lines
  20. #H
  21. #H  Revision 3.7  1993/01/20  17:35:28  felsch
  22. #H  moved 'TableOfMarks' to "tom.g", changed 'Lattice' to sort classes
  23. #H
  24. #H  Revision 3.6  1992/12/16  19:47:27  martin
  25. #H  replaced quoted record names with escaped ones
  26. #H
  27. #H  Revision 3.5  1992/08/18  09:30:20  fceller
  28. #H  added Juergen's lattice print functions
  29. #H
  30. #H  Revision 3.4  1992/08/12  14:07:37  martin
  31. #H  changed 'Representative' to 'RepresentativeOperation'
  32. #H
  33. #H  Revision 3.3  1992/03/17  12:31:20  jmnich
  34. #H  minor style changes, more bug fixes
  35. #H
  36. #H  Revision 3.2  1992/02/29  13:25:11  jmnich
  37. #H  general library review, some bug fixes
  38. #H
  39. #H  Revision 3.1  1992/02/12  15:37:22  martin
  40. #H  initial revision under RCS
  41. #H
  42. ##
  43.  
  44.  
  45. #############################################################################
  46. ##
  47. #F  InfoLattice1(...) . . . . . . . . . . . . . . . . . . package information
  48. #F  InfoLattice2(...) . . . . . . . . . . . . . . . package debug information
  49. ##
  50. if not IsBound( InfoLattice1 )  then  InfoLattice1 := Ignore;  fi;
  51. if not IsBound( InfoLattice2 )  then  InfoLattice2 := Ignore;  fi;
  52.  
  53.  
  54. LatticeBreak := false;
  55.  
  56.  
  57. #############################################################################
  58. ##
  59. #F  Zuppos( <group> ) . . . . . . . . . . . . . . . . . . . .  compute zuppos
  60. ##
  61. ##  This function computes the zuppos of <group>.
  62. ##
  63. Zuppos := function( D )
  64.     local   zuppos;
  65.  
  66.     if IsDomain( D ) and IsBound( D.zuppos ) then
  67.         zuppos := D.zuppos;
  68.     elif  IsDomain( D ) and IsParent( D )
  69.       and IsBound( D.operations.SylowZuppos ) then
  70.         D.zuppos := D.operations.SylowZuppos( D );
  71.         zuppos := D.zuppos;
  72.     elif  IsDomain( D ) and IsBound( D.operations.Zuppos ) then
  73.         D.zuppos := D.operations.Zuppos( D );
  74.         zuppos := D.zuppos;
  75.     else
  76.         Error( "sorry, can't compute zuppos for domain" );
  77.     fi;
  78.     return zuppos;
  79. end;
  80.  
  81.  
  82. #############################################################################
  83. ##
  84. #F  ZuppoBlist( <group> ) . . . . . . . . . . . . . . compute blist of zuppos
  85. ##
  86. ##  This  function  computes the blist of zuppos of <group> relative to those
  87. ##  of its parent group.
  88. ##
  89. ZuppoBlist := function( D )
  90.     local   zuppob;
  91.  
  92.     if IsDomain( D ) and IsBound( D.zuppoBlist ) then
  93.         zuppob := D.zuppoBlist;
  94.     elif  IsDomain( D ) and IsBound( D.operations.ZuppoBlist ) then
  95.         D.zuppoBlist := D.operations.ZuppoBlist( D );
  96.         zuppob := D.zuppoBlist;
  97.     else
  98.         Error( "sorry, can't compute zuppo blist for domain" );
  99.     fi;
  100.     return zuppob;
  101. end;
  102.  
  103.  
  104. #############################################################################
  105. ##
  106. #F  GeneratorZuppos( <group> )  . . . . . . . . compute zuppos for generators
  107. ##
  108. ##  This  function computes the zuppos for the generators of <group>.
  109. ##
  110. GeneratorZuppos := function( D )
  111.     local   zuppos;
  112.  
  113.     if IsDomain( D ) and IsBound( D.generatorZuppos ) then
  114.         zuppos := D.generatorZuppos;
  115.     elif IsDomain( D ) and IsBound( D.operations.GeneratorZuppos ) then
  116.         D.generatorZuppos := D.operations.GeneratorZuppos( D );
  117.         zuppos := D.generatorZuppos;
  118.     else
  119.         Error( "sorry, can't compute generator zuppos for domain" );
  120.     fi;
  121.     return zuppos;
  122. end;
  123.  
  124.  
  125. #############################################################################
  126. ##
  127. #F  GeneratorZuppoBlist( <group> )  .  compute blist of zuppos for generators
  128. ##
  129. ##  This  function computes the blist of zuppos for the generators of <group>
  130. ##  relative to those of its parent group.
  131. ##
  132. GeneratorZuppoBlist := function( D )
  133.     local   zuppob;
  134.  
  135.     if IsDomain( D ) and IsBound( D.generatorZuppoBlist ) then
  136.         zuppob := D.generatorZuppoBlist;
  137.     elif IsDomain( D ) and IsBound( D.operations.GeneratorZuppoBlist ) then
  138.         D.generatorZuppoBlist := D.operations.GeneratorZuppoBlist( D );
  139.         zuppob := D.generatorZuppoBlist;
  140.     else
  141.         Error( "sorry, can't compute generator zuppo blist for domain" );
  142.     fi;
  143.     return zuppob;
  144. end;
  145.  
  146.  
  147. #############################################################################
  148. ##
  149. #F  ConjugateZuppos( <group>, <subgroup>, <conjugand> ) . . . . . . . . . . .
  150. #F  . . . . . . . . . . . . . . . . . . . . . . . .  compute conjugate zuppos
  151. ##
  152. ##
  153. ##
  154. ConjugateZuppos := function( H, g )
  155.     local   zuppos;
  156.  
  157.     if IsDomain( H ) and IsBound( H.operations.ConjugateZuppos ) then
  158.         zuppos := H.operations.ConjugateZuppos( H, g );
  159.     else
  160.         Error( "sorry, can't compute conjugate zuppos for domain" );
  161.     fi;
  162.     return zuppos;
  163. end;
  164.  
  165.  
  166. #############################################################################
  167. ##
  168. #F  ConjugateZuppoBlist( <group>, <conjugand> ) . . . . . . . . . . . . . . .
  169. #F  . . . . . . . . . . . . . . . . . . . . compute blist of conjugate zuppos
  170. ##
  171. ##
  172. ##
  173. ConjugateZuppoBlist := function( H, g )
  174.     local   zuppob;
  175.  
  176.     if IsDomain( H ) and IsBound( H.operations.ConjugateZuppos ) then
  177.         zuppob := H.operations.ConjugateZuppoBlist( H, g );
  178.     else
  179.         Error( "sorry, can't compute conjugate zuppos for domain" );
  180.     fi;
  181.     return zuppob;
  182. end;
  183.  
  184.  
  185. #############################################################################
  186. ##
  187. #F  SetLatticeStatus( <lattice>, <subgroup>, <status> ) . . . . . . . . . . .
  188. #F  . . . . . . . . . . . . . . . . . . . . . . set a lattice subgroup status
  189. ##
  190. ##
  191. ##
  192. SetLatticeStatus := function( L, H, status )
  193.  
  194.     if IsDomain( H ) and IsBound( H.operations.SetLatticeStatus ) then
  195.         return H.operations.SetLatticeStatus( L, H, status );
  196.     elif IsConjugacyClassSubgroups( H )
  197.       and IsBound( H.representative.operations.SetLatticeStatus ) then
  198.         return H.representative.operations.SetLatticeStatus( L, H, status );
  199.     else
  200.         Error( "sorry, can't set lattice status for group or class" );
  201.     fi;
  202. end;
  203.  
  204.  
  205. #############################################################################
  206. ##
  207. #F  IsLattice( <object> ) . . . . . . . . . . . test if a record is a lattice
  208. ##
  209. IsLattice := x -> IsRec( x ) and IsBound( x.isLattice ) and x.isLattice;
  210.  
  211.  
  212. #############################################################################
  213. ##
  214. #F  IsSubgroupLattice( <object> ) . .  test if a record is a subgroup lattice
  215. ##
  216. IsSubgroupLattice := x ->     IsRec( x ) and IsBound( x.isSubgroupLattice )
  217.                           and x.isSubgroupLattice;
  218.  
  219.  
  220. #############################################################################
  221. ##
  222. #F  Lattice( <domain> ) . . . . . . . . . . . . . . . . . lattice of a domain
  223. ##
  224. Lattice := function( obj )
  225.     local   lattice;
  226.  
  227.     if IsRec( obj ) and IsBound( obj.lattice ) then
  228.         lattice := obj.lattice;
  229.     elif IsRec( obj ) and IsBound( obj.operations )
  230.       and IsBound( obj.operations.Lattice ) then
  231.         obj.lattice := obj.operations.Lattice( obj );
  232.         lattice := obj.lattice;
  233.     else
  234.         Error( "sorry, can't compute a lattice for <domain>" );
  235.     fi;
  236.     return lattice;
  237. end;
  238.  
  239.  
  240. #############################################################################
  241. ##
  242. #F  StopLattice() . . . . . . . . . . . . . . terminate a lattice calculation
  243. ##
  244. StopLattice := function()
  245.     LatticeBreak := true;
  246. end;
  247.  
  248.  
  249. #############################################################################
  250. ##
  251. #F  ClearLatticeQueue( <domain> ) . . . . . . . . .  clear queue of a lattice
  252. ##
  253. ClearLatticeQueue := function( obj )
  254.  
  255.     if IsRec( obj ) and IsBound( obj.operations )
  256.       and IsBound( obj.operations.ClearLatticeQueue ) then
  257.         obj.operations.ClearLatticeQueue( obj );
  258.     else
  259.         Error( "sorry, can't clear lattice queue for <domain>" );
  260.     fi;
  261. end;
  262.  
  263.  
  264. #############################################################################
  265. ##
  266. #F  RightTransversal( <G>, <H> )  . . . . . . . determine a right transversal
  267. ##
  268. ##  returns
  269. ##
  270. ##      <list>
  271. ##
  272. RightTransversal := function( G, H )
  273.     local rt;
  274.  
  275.     if IsBound( H.rightTransversal ) and IsParent( G ) then
  276.         rt := H.rightTransversal;
  277.     elif IsDomain( G ) and IsBound( G.operations.RightTransversal ) then
  278.         rt := G.operations.RightTransversal( G, H );
  279.         if IsBound( G.elements ) then
  280.             rt := ListBlist( G.elements, BlistList( G.elements, rt ) );
  281.         fi;
  282.         if IsParent( G ) then
  283.             H.rightTransversal := rt;
  284.         fi;
  285.     fi;
  286.     return rt;
  287. end;
  288.  
  289.  
  290. #############################################################################
  291. ##
  292. #F  PerfectSubgroups( <group> ) . . . . . . . determine all perfect subgroups
  293. ##
  294. ##  returns
  295. ##
  296. ##      <list>
  297. ##
  298. PerfectSubgroups := function( obj )
  299.     local   pg;
  300.  
  301.     if IsDomain( obj ) and IsBound( obj.perfectSubgroups ) then
  302.         pg := obj.perfectSubgroups;
  303.     elif IsDomain( obj ) and IsBound( obj.operations.PerfectSubgroups ) then
  304.         obj.perfectSubgroups := obj.operations.PerfectSubgroups( obj );
  305.         pg := obj.perfectSubgroups;
  306.     else
  307.         Error( "sorry, can't compute perfect subgroups for <domain>" );
  308.     fi;
  309.     return pg;
  310. end;
  311.  
  312.  
  313. #############################################################################
  314. ##
  315. #F  IsConjugacyClassSubgroups( <C> )  . . . . . . . . . . . . . . . . . . . .
  316. #F  . . . . . . .  test if an object is a conjugacy class of subgroups record
  317. ##
  318. IsConjugacyClassSubgroups := function ( C )
  319.     return     IsRec( C )
  320.            and IsBound( C.isConjugacyClassSubgroups )
  321.            and C.isConjugacyClassSubgroups;
  322. end;
  323.  
  324.  
  325. #############################################################################
  326. ##
  327. #F  ConjugacyClassSubgroups(<G>,<H>)  . . . . . . . . . . . . . . . . . . . .
  328. #F  . . . . . . . . . . . . . . . . . conjugacy class of subgroups in a group
  329. ##
  330. ConjugacyClassSubgroups := function ( G, H )
  331.     if not IsSubgroup( G, H ) then
  332.         Error( "sorry, <H> must be a subgroup of <G>" );
  333.     fi;
  334.     if IsDomain( G ) and IsBound( G.operations.ConjugacyClassSubgroups ) then
  335.         return G.operations.ConjugacyClassSubgroups( G, H );
  336.     else
  337.         Error( "sorry, can't create conjugacy class of subgroups for <G>" );
  338.     fi;
  339. end;
  340.  
  341.  
  342. #############################################################################
  343. ##
  344. #F  ConjugacyClassesSubgroups( <G> )  . . . . . . . . . . . . . . . . . . . .
  345. #F  . . . . . . . . . . . . . . . . conjugacy classes of subgroups of a group
  346. ##
  347. ConjugacyClassesSubgroups := function ( G )
  348.     local   cc;
  349.  
  350.     if IsDomain( G ) and IsBound( G.conjugacyClassesSubgroups ) then
  351.         cc := G.conjugacyClassesSubgroups;
  352.     elif IsDomain( G ) and IsBound( G.operations.ConjugacyClassesSubgroups )
  353.         then
  354.         G.conjugacyClassesSubgroups :=
  355.             G.operations.ConjugacyClassesSubgroups( G );
  356.         cc := G.conjugacyClassesSubgroups;
  357.     else
  358.         Error(
  359.          "sorry, can't compute a conjugacy classes of subgroups for <domain>"
  360.         );
  361.     fi;
  362.     return cc;
  363. end;
  364.  
  365.  
  366. #############################################################################
  367. ##
  368. #F  GroupOps.Zuppos( <group> )  . . . . . . . . . . . . . . .  compute zuppos
  369. ##
  370. ##  This function handles the general case for zuppo calculation.
  371. ##  The  calculation of the zuppos for a parent group differs from that for a
  372. ##  subgroup  as some more data is to be allocated for parent groups in order
  373. ##  to ensure efficient work with zuppos.
  374. ##  This  data  consists  of  the list of zuppo-generators (zuppos), for each
  375. ##  element of the group the canonical zuppo-generator (zuppo_generator), for
  376. ##  each zuppo-generator the zuppo-generator of its prime-power (zuppo_power)
  377. ##  and  for  each  zuppo-generator the corresponding prime (zuppo_prime) and
  378. ##  exponent (zuppo_exponent).
  379. ##  Additionally the function itself will bound all the data to the record.
  380. ##
  381. GroupOps.Zuppos := function( group )
  382.     local   zuppos, zuppo_gens, zuppo_powers, zuppo_primes, zuppo_exponents,
  383.             nz, zg, elems, pos, cyc, g, known, order, forder, sorder,
  384.             good, bad, x, p, parent;
  385.  
  386.     if IsParent( group ) then
  387.  
  388.         # initialize the calculated data
  389.  
  390.         nz := 0;
  391.         zuppos := [];
  392.         zuppo_gens := [ false ];
  393.         zuppo_powers := [];
  394.         zuppo_primes := [];
  395.         zuppo_exponents := [];
  396.  
  397.         # remember good and bad orders
  398.  
  399.         good := [];
  400.         bad  := [];
  401.  
  402.         # sorry, but we will loop over all elements
  403.  
  404.         elems := Elements( group );
  405.         known := BlistList( elems, [ group.identity ] );
  406.         pos   := Position( known, false );
  407.         while pos <> false do
  408.  
  409.             # determine the next cyclic subgroup
  410.  
  411.             cyc   := [ group.identity ];
  412.             g     := elems[pos];
  413.             order := 1;
  414.             while g <> group.identity do
  415.                 order := order + 1;
  416.                 cyc[order] := g;
  417.                 g := g * elems[pos];
  418.             od;
  419.  
  420.             # check whether it yields a zuppo
  421.  
  422.             forder := Factors( order );
  423.             sorder := Set( forder );
  424.  
  425.             if not (order in good or order in bad) then
  426.                 if Length( sorder ) = 1 then
  427.                     AddSet( good, order );
  428.                 else
  429.                     AddSet( bad, order );
  430.                 fi;
  431.             fi;
  432.  
  433.             if order in good then
  434.  
  435.                 # we have found a new zuppo.
  436.                 # now behave like this: the actual generator will be our
  437.                 # new zuppo-generator. this will ensure that the resulting
  438.                 # zuppo-list is in fact a set. all other zuppo-generators
  439.                 # in 'cyclic' are marked as known. this is done below.
  440.                 # remember to take elements from 'elems' to save memory.
  441.                 # we do not need to do that for 'zuppo_power' here, this
  442.                 # list is rewritten at the end of the function.
  443.  
  444.                 nz := nz + 1;
  445.                 zg := nz;
  446.                 zuppos[nz]          := elems[pos];
  447.                 zuppo_primes[nz]    := forder[1];
  448.                 zuppo_exponents[nz] := Length( forder );
  449.                 if zuppo_exponents[nz] = 1 then
  450.                     zuppo_powers[nz] := false;
  451.                 else
  452.                     zuppo_powers[nz] := Position(
  453.                         elems, cyc[zuppo_primes[nz]+1] );
  454.                 fi;
  455.  
  456.             else
  457.                 zg := false;
  458.             fi;
  459.  
  460.             # mark all generators of the cyclic group as known and put
  461.             # the canonical generator in zuppo_gen.
  462.             # remark: this is also done for non-zuppos (who cares ?)
  463.  
  464.             for p in sorder do
  465.                 for x in [0..order/p-1] do
  466.                     Unbind( cyc[x*p+1] );
  467.                 od;
  468.             od;
  469.             for x in cyc do
  470.                 p := Position( elems, x );
  471.                 zuppo_gens[p] := zg;
  472.                 known[p] := true;
  473.             od;
  474.  
  475.             pos := Position( known, false, pos );
  476.         od;
  477.  
  478.         # now convert 'zuppos' to a set
  479.  
  480.         if not IsSet( zuppos ) then
  481.             Error( "fatal error, zuppo list is no set" );
  482.         fi;
  483.  
  484.         # correct the values in zuppo_powers to contain 'zuppos' elements
  485.  
  486.         for x in [1..nz] do
  487.             if zuppo_powers[x] <> false then
  488.                 zuppo_powers[x] := zuppo_gens[zuppo_powers[x]];
  489.             fi;
  490.         od;
  491.  
  492.         group.zuppos := zuppos;
  493.         group.zuppo_generators := zuppo_gens;
  494.         group.zuppo_powers := zuppo_powers;
  495.         group.zuppo_primes := zuppo_primes;
  496.         group.zuppo_exponents := zuppo_exponents;
  497.  
  498.     else
  499.  
  500.         parent := Parent( group );
  501.         zuppos := ListBlist( Zuppos( parent ),
  502.                     BlistList( Zuppos( parent ), Elements( group ) ) );
  503.  
  504.     fi;
  505.     return zuppos;
  506. end;
  507.  
  508.  
  509. #############################################################################
  510. ##
  511. #F  GroupOps.ZuppoBlist( <group> )  . . . . . . . . . compute blist of zuppos
  512. ##
  513. ##  This  functions  computes the zuppos of a group represented as a blist on
  514. ##  the zuppos of the parent group.
  515. ##
  516. GroupOps.ZuppoBlist := function( group )
  517.     local   zuppob, rng;
  518.  
  519.     if IsParent( group ) then
  520.         rng    := [1 .. Length( Zuppos( group ) )];
  521.         zuppob := BlistList( rng, rng );
  522.     else
  523.         zuppob := BlistList( Zuppos( Parent( group ) ), Elements( group ) );
  524.     fi;
  525.  
  526.     return zuppob;
  527. end;
  528.  
  529.  
  530. #############################################################################
  531. ##
  532. #F  GroupOps.GeneratorZuppos  . . . . . . . . determine zuppos for generators
  533. ##
  534. GroupOps.GeneratorZuppos := function( H )
  535.     local   g, facord, prm, coprm, p, gzup, zuppos, parent;
  536.  
  537.     parent := Parent( H );
  538.     zuppos := Zuppos( parent );
  539.     gzup   := [];
  540.     for g in H.generators do
  541.         facord := Factors( Order( H, g ) );
  542.         for prm in Set( facord ) do
  543.             coprm := 1;
  544.             for p in facord do if p <> prm then coprm := coprm * p; fi; od;
  545.             Add( gzup, zuppos[parent.zuppo_generators[Position(
  546.                 parent.elements, g ^ coprm )]] );
  547.         od;
  548.     od;
  549.     return gzup;
  550. end;
  551.  
  552.  
  553. #############################################################################
  554. ##
  555. #F  GroupOps.GeneratorZuppoBlist  . . . . determine zuppoblist for generators
  556. ##
  557. GroupOps.GeneratorZuppoBlist := function( H )
  558.     local   g, facord, prm, coprm, p, gzup, zuppos, parent;
  559.  
  560.     parent := Parent( H );
  561.     zuppos := Zuppos( parent );
  562.     gzup   := BlistList( zuppos, [] );
  563.     for g in H.generators do
  564.         facord := Factors( Order( H, g ) );
  565.         for prm in Set( facord ) do
  566.             coprm := 1;
  567.             for p in facord do if p <> prm then coprm := coprm * p; fi; od;
  568.             gzup[parent.zuppo_generators[Position(
  569.                 parent.elements, g ^ coprm )]] := true;
  570.         od;
  571.     od;
  572.     return gzup;
  573. end;
  574.  
  575.  
  576. #############################################################################
  577. ##
  578. #F  GroupOps.ConjugateZuppos( <group>, <conjugand> )  . . . . . . . . . . . .
  579. #F  . . . . . . . . . . . . . . . . . . . . compute blist of conjugate zuppos
  580. ##
  581. ##
  582. ##
  583. GroupOps.ConjugateZuppos := function( H, g )
  584.     local   zuppos, zuppop, parent, x, i;
  585.  
  586.     parent := Parent( H );
  587.     zuppop := Zuppos( parent );
  588.     zuppos := ShallowCopy( Zuppos( H ) );
  589.     for i in [1..Length( zuppos )] do
  590.         x := zuppos[i];
  591.         x := parent.zuppo_generators[Position( parent.elements, x ^ g )];
  592.         zuppos[i] := zuppop[x];
  593.     od;
  594.  
  595.     return Set( zuppos );
  596. end;
  597.  
  598.  
  599. #############################################################################
  600. ##
  601. #F  GroupOps.ConjugateZuppoBlist( <group>, <conjugand> )  . . . . . . . . . .
  602. #F  . . . . . . . . . . . . . . . . . . . . compute blist of conjugate zuppos
  603. ##
  604. ##
  605. ##
  606. GroupOps.ConjugateZuppoBlist := function( H, g )
  607.     local   zuppob, zuppop, parent, x;
  608.  
  609.     parent := Parent( H );
  610.     zuppop := Zuppos( parent );
  611.     zuppob := BlistList( [1..Length( zuppop )], [] );
  612.     for x in Zuppos( H ) do
  613.         x := parent.zuppo_generators[Position( parent.elements, x ^ g )];
  614.         zuppob[x] := true;
  615.     od;
  616.  
  617.     return zuppob;
  618. end;
  619.  
  620.  
  621. #############################################################################
  622. ##
  623. #F  GroupOps.SetLatticeStatus( <L>, <object>, <status> )  . . . . . . . . . .
  624. #F  . . . . . . . . . . . . . . . . . . . . . . set status of lattice objects
  625. ##
  626. ##  returns
  627. ##
  628. ##      [ <class>, <conjugand>, <isnew> ]
  629. ##
  630. ##
  631. GroupOps.SetLatticeStatus := function( L, H, status )
  632.     local   G, CH, N, CN, C, CC, T, equals, qequals, subs, sups,
  633.             hzup, czup, gzup, isnew, issup, size, nelem, pos, t, i, x;
  634.  
  635.  
  636.     G := L.group;
  637.  
  638.     # the first step is to convert H to a conjugacy class of subgroups
  639.     # if it is a group.
  640.  
  641.     if IsGroup( H ) then
  642.  
  643.         # determine its layer
  644.  
  645.         CH   := ConjugacyClassSubgroups( G, H );
  646.         size := Size( H );
  647.  
  648.         if size = 1 then    CH.layer := 0;
  649.         else                CH.layer := Length( Factors( size ) );
  650.         fi;
  651.  
  652.         CH.status := "0 new";
  653.  
  654.     else
  655.  
  656.         CH   := H;
  657.         H    := CH.representative;
  658.         size := Size( H );
  659.  
  660.         if not IsBound( CH.status ) then
  661.             if size = 1 then    CH.layer := 0;
  662.             else                CH.layer := Length( Factors( size ) );
  663.             fi;
  664.  
  665.             CH.status := "0 new";
  666.         fi;
  667.  
  668.     fi;
  669.  
  670.     InfoLattice2( "#I  setstatus ", H, ", size ", size, " to ", status,
  671.                   "in layer ", CH.layer, "\n" );
  672.  
  673.     # if the status of the class is higher than the requested one,
  674.     # return it itself.
  675.  
  676.     if CH.status >= status then
  677.         return [ CH, G.identity, false ];
  678.     fi;
  679.  
  680.     # find list of possibly equal classes
  681.  
  682.     if IsBound( CH.equalClasses ) then
  683.  
  684.         # this has been done already
  685.  
  686.         equals := CH.equalClasses;
  687.  
  688.     elif CH.status >= "2 class" then
  689.  
  690.         # there is no need to test for equality if the class has already
  691.         # been added to the lattice.
  692.  
  693.         equals := [];
  694.  
  695.     else
  696.  
  697.         # o.k. now, go through the list of classes and have a look.
  698.  
  699.         gzup := GeneratorZuppoBlist( H );
  700.         equals := [];
  701.         for CC in L.classes do
  702.             C := CC.representative;
  703.             if C.size = size then
  704.                 if IsSubsetBlist( ZuppoBlist( C ), gzup ) then
  705.  
  706.                     # we were able to identify the representative
  707.  
  708.                     L.statistics.equalGroups := L.statistics.equalGroups + 1;
  709.                     if IsBound( CH.normalsubgroups ) then
  710.                         for x in CH.normalsubgroups do
  711.                             x.normalizerLattice := [ CC, G.identity ];
  712.                         od;
  713.                     fi;
  714.                     InfoLattice2( "#I  ...found in lattice\n" );
  715.                     return [ CC, G.identity, false ];
  716.  
  717.                 else
  718.                     Add( equals, CC );
  719.                 fi;
  720.             fi;
  721.         od;
  722.     fi;
  723.  
  724.     # now go on and improve the objects status one by one.
  725.     # first: shall we add the group to the queue ?
  726.  
  727.     if status = "1 group" then
  728.  
  729.         # make sure H is not already in the queue
  730.  
  731.         gzup := GeneratorZuppoBlist( H );
  732.  
  733.         for i in [1..Length( L.queue )] do
  734.             if IsBound( L.queue[i] ) then
  735.                 CC := L.queue[i];
  736.                 C  := CC.representative;
  737.                 if C.size = size then
  738.                     if IsSubsetBlist( ZuppoBlist( C ), gzup ) then
  739.  
  740.                         # oh, yes. there is a queue group equal to ours.
  741.  
  742.                         L.statistics.equalGroups :=
  743.                             L.statistics.equalGroups + 1;
  744.                         if IsBound( CH.normalsubgroups ) then
  745.                             if not IsBound( CC.normalsubgroups ) then
  746.                                 CC.normalsubgroups := [];
  747.                             fi;
  748.                             for x in CH.normalsubgroups do
  749.                                 x.normalizerLattice := [ CC, G.identity ];
  750.                                 Add( CC.normalsubgroups, x );
  751.                             od;
  752.                         fi;
  753.                         InfoLattice2( "#I  ...found in queue\n" );
  754.                         return [ CC, G.identity, false ];
  755.  
  756.                     fi;
  757.                 fi;
  758.             fi;
  759.         od;
  760.  
  761.         InfoLattice1( "#I  ...added to queue\n" );
  762.  
  763.         CH.status       := "1 group";
  764.         CH.equalClasses := equals;
  765.  
  766.         Add( L.queue, CH );
  767.  
  768.         return [ CH, G.identity, false ];
  769.     fi;
  770.  
  771.     # the class will have higher status than being a queue group so
  772.     # remove the list of possibly equal classes.
  773.  
  774.     Unbind( CH.equalClasses );
  775.  
  776.     # second: shall we add the group to the lattice ?
  777.  
  778.     if CH.status < "2 class" and status >= "2 class" then
  779.  
  780.         # if we have to create the class we need the normalizer of H
  781.         # and its (right) transversal in G.
  782.  
  783.         InfoLattice2( "#I  calculating normalizer of H\n" );
  784.  
  785.         N  := G.operations.Normalizer( G, H );
  786.         CN := ConjugacyClassSubgroups( G, N );
  787.         T  := G.operations.RightTransversal( G, N );
  788.  
  789.         L.statistics.normalizers := L.statistics.normalizers + 1;
  790.  
  791.         CN.normalsubgroups   := [ CH ];
  792.         CH.normalizerLattice := [ CN, G.identity ];
  793.         CH.conjugands        := T;
  794.         CH.size              := Length( T );
  795.  
  796.         if Size( N ) <> size then
  797.  
  798.             InfoLattice2( "#I  handling normalizer\n" );
  799.  
  800.             isnew := SetLatticeStatus( L, CN, L.calculatedGroups );
  801.             CH.normalizerLattice := [ isnew[1], isnew[2] ];
  802.             isnew := isnew[3];
  803.  
  804.         else
  805.  
  806.             InfoLattice2( "#I  group is selfnormal -- no handling\n" );
  807.  
  808.             CH.normalizerLattice := [ CH, G.identity ];
  809.             isnew := false;
  810.  
  811.         fi;
  812.  
  813.         # if H's normalizer wasn't known before, H itself must be new.
  814.  
  815.         if isnew then
  816.             equals := [];
  817.         fi;
  818.  
  819.         # we continue with the determination of possible subgroups...
  820.  
  821.         subs := [];
  822.         for CC in L.classes do
  823.             C := CC.representative;
  824.             if CC.layer = CH.layer - 1 and CC.status = "3 extending"
  825.               and size mod C.size = 0 then
  826.                 Add( subs, CC );
  827.             fi;
  828.         od;
  829.  
  830.         # ... and the possibly equal queue groups
  831.  
  832.         gzup    := GeneratorZuppoBlist( H );
  833.         qequals := [];
  834.         for i in [1..Length( L.queue )] do
  835.             if IsBound( L.queue[i] ) then
  836.                 CC := L.queue[i];
  837.                 C  := CC.representative;
  838.                 if C.size = size then
  839.                     if IsSubsetBlist( ZuppoBlist( C ), gzup ) then
  840.  
  841.                         # oh, there is a group in the queue equal to ours.
  842.  
  843.                         L.statistics.equalGroups :=
  844.                             L.statistics.equalGroups + 1;
  845.                         if IsBound( CC.normalsubgroups ) then
  846.                             if not IsBound( CH.normalsubgroups ) then
  847.                                 CH.normalsubgroups := [];
  848.                             fi;
  849.                             for x in CC.normalsubgroups do
  850.                                 x.normalizerLattice := [ CH, G.identity ];
  851.                                 Add( CH.normalsubgroups, x );
  852.                             od;
  853.                         fi;
  854.                         InfoLattice2( "#I  ...found in queue\n" );
  855.                         Unbind( L.queue[i] );
  856.  
  857.                     else
  858.                         Add( qequals, i );
  859.                     fi;
  860.                 fi;
  861.             fi;
  862.         od;
  863.  
  864.         # is there anything to do with the conjugates so far ?
  865.  
  866.         if equals = [] and qequals = [] and subs = [] then
  867.             T := [];
  868.         fi;
  869.  
  870.         # generate each conjugate, i.e. its zuppos one after the other,
  871.         # performing all necessary actions with each zuppo blist right
  872.         # here.
  873.  
  874.         InfoLattice2( "#I  conjugating H\n" );
  875.  
  876.         for t in T do
  877.  
  878.             czup := H.operations.ConjugateZuppoBlist( H, t );
  879.             L.statistics.conjugateZuppos := L.statistics.conjugateZuppos + 1;
  880.  
  881.             # first check whether this conjugate is the representative of a
  882.             # known class of subgroups
  883.  
  884.             for CC in equals do
  885.                 C := CC.representative;
  886.                 if ZuppoBlist( C ) = czup then
  887.  
  888.                     # in fact there is a class that contains the conjugate
  889.  
  890.                     L.statistics.equalGroups := L.statistics.equalGroups + 1;
  891.                     if IsBound( CH.normalsubgroups ) then
  892.                         for x in CH.normalsubgroups do
  893.                             x.normalizerLattice :=
  894.                                 [ CC, t^-1 * x.normalizerLattice[2] ];
  895.                         od;
  896.                     fi;
  897.                     InfoLattice2( "#I  ...found in lattice\n" );
  898.                     return [ CC, t^-1, false ];
  899.  
  900.                 fi;
  901.             od;
  902.  
  903.             # next check whether this group is a member of the queue
  904.  
  905.             for i in qequals do
  906.                 if IsBound( L.queue[i] ) then
  907.                     CC := L.queue[i];
  908.                     C  := CC.representative;
  909.                     if ZuppoBlist( C ) = czup then
  910.  
  911.                         # bingo, we found a group in the queue equal to the
  912.                         # conjugate of H.
  913.  
  914.                         L.statistics.equalGroups :=
  915.                             L.statistics.equalGroups + 1;
  916.                         if IsBound( CC.normalsubgroups ) then
  917.                             if not IsBound( CH.normalsubgroups ) then
  918.                                 CH.normalsubgroups := [];
  919.                             fi;
  920.                             for x in CC.normalsubgroups do
  921.                                 x.normalizerLattice := [ CH, t ];
  922.                                 Add( CH.normalsubgroups, x );
  923.                             od;
  924.                         fi;
  925.                         InfoLattice2( "#I  identified queue group\n" );
  926.                         Unbind( L.queue[i] );
  927.  
  928.                     fi;
  929.                 fi;
  930.             od;
  931.  
  932.             # next reduce the extendingZuppos blists of those classes that
  933.             # are yet to be extended and whose representative may be a
  934.             # subgroup of this conjugate.
  935.  
  936.             for CC in subs do
  937.                 C := CC.representative;
  938.                 if IsSubsetBlist( czup, ZuppoBlist( C ) ) then
  939.                     InfoLattice2( "#I  found a subgroup\n" );
  940.                     SubtractBlist( CC.extendingZuppos, czup );
  941.                 fi;
  942.             od;
  943.         od;
  944.  
  945.         # the group survived this step, so it is new
  946.  
  947.         CH.status := "2 class";
  948.  
  949.         Unbind( CH.normalsubgroups );
  950.         Add( L.classes, CH );
  951.  
  952.         InfoLattice1( "#I  Class of size ", size, " and length ", CH.size,
  953.             " added\n" );
  954.     fi;
  955.  
  956.     # third: shall the extendingZuppos blist of the class be created ?
  957.  
  958.     if CH.status < "3 extending" and status >= "3 extending"
  959.       and not LatticeBreak then
  960.  
  961.         # initialize the extendingZuppos blist
  962.  
  963.         CH.extendingZuppos := ShallowCopy( CH.normalizerLattice[1].
  964.             representative.operations.ConjugateZuppoBlist(
  965.                 CH.normalizerLattice[1].representative,
  966.                 CH.normalizerLattice[2]
  967.             )
  968.         );
  969.         SubtractBlist( CH.extendingZuppos, ZuppoBlist( H ) );
  970.         L.statistics.conjugateZuppos := L.statistics.conjugateZuppos + 1;
  971.  
  972.         # change it to reflect the proper list of extending zuppos.
  973.  
  974.         gzup := GeneratorZuppos( H );
  975.  
  976.         for CC in L.classes do
  977.             C := CC.representative;
  978.             if CC.layer = CH.layer + 1 and C.size mod size = 0 then
  979.                 T    := CC.conjugands;
  980.                 czup := ZuppoBlist( C );
  981.                 for t in T do
  982.                     issup := true;
  983.                     i     := Length( gzup );
  984.                     x     := t ^ -1;
  985.                     while issup and i > 0 do
  986.                         issup := czup[G.zuppo_generators[Position(
  987.                             G.elements, gzup[i]^x )]];
  988.                         i := i - 1;
  989.                     od;
  990.                     if issup then
  991.                         InfoLattice2( "#I  supergroup found\n" );
  992.                         SubtractBlist( CH.extendingZuppos,
  993.                             C.operations.ConjugateZuppoBlist( C, t ) );
  994.                         L.statistics.conjugateZuppos :=
  995.                             L.statistics.conjugateZuppos + 1;
  996.                     fi;
  997.                 od;
  998.             fi;
  999.         od;
  1000.  
  1001.         CH.status := "3 extending";
  1002.     fi;
  1003.  
  1004.     # fourth: shall we calculate all cyclic extensions of H ?
  1005.  
  1006.     if CH.status < "4 extended" and status >= "4 extended"
  1007.       and not LatticeBreak then
  1008.  
  1009.         InfoLattice2( "#I  calculating extensions of H\n" );
  1010.  
  1011.         hzup := ZuppoBlist( H );
  1012.         pos  := Position( CH.extendingZuppos, true );
  1013.  
  1014.         while pos <> false and not LatticeBreak do
  1015.  
  1016.             # is the zuppo generator of prime index over H ?
  1017.  
  1018.             if G.zuppo_powers[pos] = false or hzup[G.zuppo_powers[pos]] then
  1019.  
  1020.                 # put everything we know into N
  1021.  
  1022.                 N  := G.operations.Subgroup( G, Concatenation( H.generators,
  1023.                       [ G.zuppos[pos] ] ) );
  1024.                 CN := ConjugacyClassSubgroups( G, N );
  1025.  
  1026.                 CN.equalClasses := [];
  1027.  
  1028.                 # finally, add it to the lattice
  1029.  
  1030.                 SetLatticeStatus( L, CN, L.extensionGroups );
  1031.                 L.statistics.extensions := L.statistics.extensions + 1;
  1032.             fi;
  1033.  
  1034.             CH.extendingZuppos[pos] := false;
  1035.             pos := Position( CH.extendingZuppos, true, pos );
  1036.         od;
  1037.  
  1038.         if not LatticeBreak then
  1039.  
  1040.             # cleanup H
  1041.  
  1042.             CH.status := "4 extended";
  1043.             Unbind( CH.extendingZuppos );
  1044.             Unbind( H.generatorZuppos );
  1045.             Unbind( H.generatorZuppoBlist );
  1046.  
  1047.             if not IsParent( H ) then
  1048.                 Unbind( H.elements );
  1049.                 Unbind( H.zuppos );
  1050.             fi;
  1051.  
  1052.             InfoLattice2( "#I  extensions of H done\n" );
  1053.         fi;
  1054.     fi;
  1055.  
  1056.     return [ CH, G.identity, true ];
  1057. end;
  1058.  
  1059.  
  1060. #############################################################################
  1061. ##
  1062. #F  GroupOps.Lattice( <group> ) . . . . . . . . . .  compute subgroup lattice
  1063. ##
  1064. ##  This function determines the lattice of subgroups.
  1065. ##
  1066. GroupOps.Lattice := function( group )
  1067.     local   L, C, layers, p, g, cp, qp, i, j;
  1068.  
  1069.     if IsGroup( group ) then
  1070.         L := rec(
  1071.             group    := group,
  1072.             classes  := [],
  1073.             queue    := [],
  1074.  
  1075.             externalGroups   := "1 group",
  1076.             calculatedGroups := "1 group",
  1077.             extensionGroups  := "2 class",
  1078.             queueGroups      := "3 extending",
  1079.             classGroups      := "4 extended",
  1080.  
  1081. #T          method := "b-t",
  1082.             method := "l-r",
  1083.  
  1084.             statistics := rec(
  1085.                 normalizers     := 0,
  1086.                 conjugateZuppos := 0,
  1087.                 extensions      := 0,
  1088.                 queueGroups     := 0,
  1089.                 classGroups     := 0,
  1090.                 equalGroups     := 0
  1091.             ),
  1092.  
  1093.             isLattice         := true,
  1094.             isSubgroupLattice := true,
  1095.  
  1096.             operations := SubgroupLatticeOps
  1097.         );
  1098.  
  1099.         # make sure that the zuppos are known
  1100.  
  1101.         Zuppos( group );
  1102.     else
  1103.         L     := group;
  1104.         group := L.group;
  1105.     fi;
  1106.  
  1107.     # if the lattice is empty, add the perfect groups, the identity
  1108.     # and the group itself.
  1109.  
  1110.     if L.classes = [] and L.queue = [] then
  1111.         SetLatticeStatus( L, TrivialSubgroup( group ), L.externalGroups );
  1112.         SetLatticeStatus( L, group, L.externalGroups );
  1113.         for p in PerfectSubgroups( group ) do
  1114.             SetLatticeStatus( L, p, L.externalGroups );
  1115.         od;
  1116.     fi;
  1117.  
  1118.     if L.method = "b-t" then
  1119.  
  1120.         # the first method is to extend every class, and insert every
  1121.         # group in chronological order
  1122.         qp := 1;
  1123.         cp := 1;
  1124.  
  1125.         while (qp <= Length( L.queue ) or cp <= Length( L.classes ))
  1126.           and not LatticeBreak do
  1127.  
  1128.             while qp <= Length( L.queue ) and not LatticeBreak do
  1129.                 if IsBound( L.queue[qp] ) then
  1130.                     C := L.queue[qp];
  1131.                     Unbind( L.queue[qp] );
  1132.                     SetLatticeStatus( L, C, L.queueGroups );
  1133.                 fi;
  1134.                 qp := qp + 1;
  1135.             od;
  1136.             qp := Length( L.queue ) + 1;
  1137.  
  1138.             while cp <= Length( L.classes ) and not LatticeBreak do
  1139.                 C := L.classes[cp];
  1140.                 SetLatticeStatus( L, C, L.classGroups );
  1141.                 cp := cp + 1;
  1142.             od;
  1143.  
  1144.         od;
  1145.  
  1146.     elif L.method = "l-r" then
  1147.  
  1148.         # the second method is to extend classes and handle groups
  1149.         # layerwise.
  1150.  
  1151.         layers := Length( Factors( Size( group ) ) );
  1152.  
  1153.         for i in [0..layers] do
  1154.  
  1155.             # first set all classes to the layer below to "3 extending"
  1156.  
  1157.             if i > 0 then
  1158.                 for C in L.classes do
  1159.                     if LatticeBreak then  return L;  fi;
  1160.                     if C.layer = i-1 then
  1161.                         SetLatticeStatus( L, C, "3 extending" );
  1162.                     fi;
  1163.                 od;
  1164.             fi;
  1165.  
  1166.             # now insert all groups in the queue belonging to the
  1167.             # current layer
  1168.  
  1169.             for j in [1..Length( L.queue )] do
  1170.                 if LatticeBreak then  return L;  fi;
  1171.                 if IsBound( L.queue[j] ) then
  1172.                     C := L.queue[j];
  1173.                     if C.layer = i then
  1174.                         Unbind( L.queue[j] );
  1175.                         SetLatticeStatus( L, C, L.queueGroups );
  1176.                     fi;
  1177.                 fi;
  1178.             od;
  1179.  
  1180.             # extend all classes in the layer below
  1181.  
  1182.             if i > 0 then
  1183.                 for C in L.classes do
  1184.                     if LatticeBreak then  return L;  fi;
  1185.                     if C.layer = i-1 then
  1186.                         SetLatticeStatus( L, C, L.classGroups );
  1187.                     fi;
  1188.                 od;
  1189.             fi;
  1190.         od;
  1191.  
  1192.     fi;
  1193.  
  1194.     # sort the conjugacy classes by increasing subgroup orders.
  1195.     Sort( L.classes,
  1196.         function( x, y )
  1197.             return x.representative.size < y.representative.size;
  1198.         end );
  1199.  
  1200.     return L;
  1201.  
  1202.     LatticeBreak := false;
  1203. end;
  1204.  
  1205.  
  1206. #############################################################################
  1207. ##
  1208. #F  GroupOps.ConjugacyClassSubgroups(<G>,<H>) . . . . . . . . . . . . . . . .
  1209. ##
  1210. GroupOps.ConjugacyClassSubgroups := function ( G, H )
  1211.     local   C;
  1212.  
  1213.     # make the domain
  1214.     C := rec( );
  1215.     C.isDomain                  := true;
  1216.     C.isConjugacyClassSubgroups := true;
  1217.  
  1218.     # enter the identifying information
  1219.     C.group          := G;
  1220.     C.representative := H;
  1221.  
  1222.     # enter the operations record
  1223.     C.operations     := ConjugacyClassSubgroupsGroupOps;
  1224.  
  1225.     # return the conjugacy class
  1226.     return C;
  1227.  
  1228. end;
  1229.  
  1230.  
  1231. #############################################################################
  1232. ##
  1233. #F  GroupOps.ConjugacyClassesSubgroups( <G> ) . . . . . . . . . . . . . . . .
  1234. ##
  1235. GroupOps.ConjugacyClassesSubgroups := function ( G )
  1236.    return Lattice( G ).classes;
  1237. end;
  1238.  
  1239.  
  1240. #############################################################################
  1241. ##
  1242. #F  GroupOps.TableOfMarks( <group>[, <classes>]
  1243. #F                  [, "full"|"upper"][, "unweighted"][, "compressed"] )
  1244. ##
  1245. ##  returns
  1246. ##
  1247. ##      <matrix>
  1248. ##
  1249. ##  or
  1250. ##
  1251. ##      <compressed matrix>
  1252. ##
  1253. ##
  1254. ##  may be it should better be
  1255. ##
  1256. ##      rec(
  1257. ##          group   := <group>,
  1258. ##          matrix  := <matrix> or <compressed matrix>,
  1259. ##          classes := <list>,
  1260. ##          modes   := <list>
  1261. ##      )
  1262. ##
  1263. GroupOps.TableOfMarks := function( arg )
  1264.     local   usage, group, classes, reps, dim, m, count, zuppos, left, right,
  1265.             lreps, rreps, vargs, t, i, j;
  1266.  
  1267.     usage := ConcatenationString(
  1268.         "usage: TableOfMarks( <group>[, <classes>]",
  1269.         "[, \"full\"|\"upper\"][, \"unweighted\"][, \"compressed\"] )"
  1270.     );
  1271.  
  1272.     vargs := [ "full", "upper", "unweighted", "compressed" ];
  1273.  
  1274.     if Length( arg ) = 0 then Error( usage ); fi;
  1275.     group := arg[1];
  1276.  
  1277.     if Length( arg ) = 1 then
  1278.         classes := ShallowCopy( ConjugacyClassesSubgroups( group ) );
  1279.  
  1280.         # ensure that the classes are sorted by increasing subgroup
  1281.         # orders.
  1282.         for i in [ 2 .. Length( classes ) ] do
  1283.             if classes[i].representative.size <
  1284.                 classes[i-1].representative.size then
  1285.                     Error( "classes of subgroups are not sorted" );
  1286.             fi;
  1287.         od;
  1288. #T      Sort( classes,
  1289. #T          function( x, y )
  1290. #T              return x.representative.size < y.representative.size;
  1291. #T          end );
  1292.  
  1293.     elif IsList( arg[2] ) and not IsString( arg[2] )  then
  1294.         if not IsSubset( vargs, Sublist( arg, [3..Length( arg )] ) ) then
  1295.             Error( "sorry, unkown argument options" );
  1296.         fi;
  1297.  
  1298.         classes := arg[2];
  1299.     else
  1300.         if not IsSubset( vargs, Sublist( arg, [2..Length( arg )] ) ) then
  1301.             Error( "sorry, unkown argument options" );
  1302.         fi;
  1303.  
  1304.         classes := ShallowCopy( ConjugacyClassesSubgroups( group ) );
  1305.  
  1306.         # ensure that the classes are sorted by increasing subgroup
  1307.         # orders.
  1308.         for i in [ 2 .. Length( classes ) ] do
  1309.             if classes[i].representative.size <
  1310.                 classes[i-1].representative.size then
  1311.                     Error( "classes of subgroups are not sorted" );
  1312.             fi;
  1313.         od;
  1314. #T      Sort( classes,
  1315. #T          function( x, y )
  1316. #T              return x.representative.size < y.representative.size;
  1317. #T          end );
  1318.  
  1319.     fi;
  1320.  
  1321.     reps  := List( classes, x -> x.representative );
  1322.     dim   := Length( classes );
  1323.     left  := "full" in arg or not "upper" in arg;
  1324.     right := "full" in arg or "upper" in arg;
  1325.  
  1326.     if "compressed" in arg then
  1327.         m := [ List( classes, x -> [] ), List( classes, x -> [] ) ];
  1328.         if "unweighted" in arg then
  1329.             for i in [1..dim] do
  1330.                 Add( m[1][i], i );
  1331.                 Add( m[2][i], 1 );
  1332.             od;
  1333.         else
  1334.             for i in [1..dim] do
  1335.                 Add( m[1][i], i );
  1336.                 Add( m[2][i], classes[i].normalizerLattice[1].
  1337.                     representative.size / reps[i].size );
  1338.             od;
  1339.         fi;
  1340.         for i in [1..dim] do
  1341.             if reps[i].size = 1 and right then
  1342.                 for j in [i+1..dim] do
  1343.                     Add( m[1][i], j );
  1344.                     Add( m[2][i], m[2][i][1] );
  1345.                 od;
  1346.             elif reps[i].size = Size( group ) and left then
  1347.                 for j in [1..i-1] do
  1348.                     Add( m[1][i], j );
  1349.                     Add( m[2][i], m[2][i][1] );
  1350.                 od;
  1351.             else
  1352.                 lreps := [];
  1353.                 rreps := [];
  1354.                 count := List( classes, x -> 0 );
  1355.                 if left then
  1356.                     for j in [1..i-1] do
  1357.                         if reps[i].size mod reps[j].size = 0 then
  1358.                             Add( lreps, j );
  1359.                         fi;
  1360.                     od;
  1361.                 fi;
  1362.                 if right then
  1363.                     for j in [i+1..dim] do
  1364.                         if reps[j].size mod reps[i].size = 0 then
  1365.                             Add( rreps, j );
  1366.                         fi;
  1367.                     od;
  1368.                 fi;
  1369.  
  1370.                 for t in classes[i].conjugands do
  1371.                     if t = group.identity then
  1372.                         zuppos := ZuppoBlist( reps[i] );
  1373.                     else
  1374.                         zuppos := ConjugateZuppoBlist( reps[i], t );
  1375.                     fi;
  1376.  
  1377.                     for j in lreps do
  1378.                         if IsSubsetBlist( zuppos, reps[j].zuppoBlist ) then
  1379.                            count[j] := count[j] + 1;
  1380.                         fi;
  1381.                     od;
  1382.                     for j in rreps do
  1383.                         if IsSubsetBlist( reps[j].zuppoBlist, zuppos ) then
  1384.                            count[j] := count[j] + 1;
  1385.                         fi;
  1386.                     od;
  1387.                 od;
  1388.  
  1389.                 for j in lreps do
  1390.                     if count[j] <> 0 then
  1391.                         Add( m[1][i], j );
  1392.                         Add( m[2][i], count[j] * m[2][i][1] );
  1393.                     fi;
  1394.                 od;
  1395.                 for j in rreps do
  1396.                     if count[j] <> 0 then
  1397.                         Add( m[1][i], j );
  1398.                         Add( m[2][i], count[j] * m[2][i][1] );
  1399.                     fi;
  1400.                 od;
  1401.             fi;
  1402.         od;
  1403.     else
  1404.         m := List( classes, x -> List( classes, x -> 0 ) );
  1405.         if "unweighted" in arg then
  1406.             for i in [1..dim] do
  1407.                 m[i][i] := 1;
  1408.             od;
  1409.         else
  1410.             for i in [1..dim] do
  1411.                m[i][i] := classes[i].normalizerLattice[1].representative.size
  1412.                / reps[i].size;
  1413.             od;
  1414.         fi;
  1415.         for i in [1..dim] do
  1416.             if reps[i].size = 1 and right then
  1417.                 for j in [i+1..dim] do m[i][j] := m[i][i]; od;
  1418.             elif reps[i].size = Size( group ) and left then
  1419.                 for j in [1..i-1] do m[i][j] := m[i][i]; od;
  1420.             else
  1421.                 lreps := [];
  1422.                 rreps := [];
  1423.                 if left then
  1424.                     for j in [1..i-1] do
  1425.                         if reps[i].size mod reps[j].size = 0 then
  1426.                             Add( lreps, j );
  1427.                         fi;
  1428.                     od;
  1429.                 fi;
  1430.                 if right then
  1431.                     for j in [i+1..dim] do
  1432.                         if reps[j].size mod reps[i].size = 0 then
  1433.                             Add( rreps, j );
  1434.                         fi;
  1435.                     od;
  1436.                 fi;
  1437.  
  1438.                 for t in classes[i].conjugands do
  1439.                     if t = group.identity then
  1440.                         zuppos := ZuppoBlist( reps[i] );
  1441.                     else
  1442.                         zuppos := ConjugateZuppoBlist( reps[i], t );
  1443.                     fi;
  1444.  
  1445.                     for j in lreps do
  1446.                         if IsSubsetBlist( zuppos, reps[j].zuppoBlist ) then
  1447.                             m[i][j] := m[i][j] + m[i][i];
  1448.                         fi;
  1449.                     od;
  1450.                     for j in rreps do
  1451.                         if IsSubsetBlist( reps[j].zuppoBlist, zuppos ) then
  1452.                             m[i][j] := m[i][j] + m[i][i];
  1453.                         fi;
  1454.                     od;
  1455.                 od;
  1456.             fi;
  1457.         od;
  1458.     fi;
  1459.  
  1460.     return m;
  1461.  
  1462. #T  return rec(
  1463. #T      group   := group,
  1464. #T      matrix  := m,
  1465. #T      classes := classes,
  1466. #T      modes   := Intersection( arg, vargs )
  1467. #T  );
  1468.  
  1469. end;
  1470.  
  1471.  
  1472. #############################################################################
  1473. ##
  1474. #V  ConjugacyClassSubgroupsGroupOps . . . . . . . . . . . . . . . . . . . . .
  1475. #V  . . . . . . . . . .  operations record for conjugacy classes of subgroups
  1476. ##
  1477. ConjugacyClassSubgroupsGroupOps := Copy( DomainOps );
  1478.  
  1479.  
  1480. #############################################################################
  1481. ##
  1482. #F  ConjugacyClassSubgroupsGroupOps.Elements( <C> ) . . . . . . . . . . . . .
  1483. ##
  1484. ConjugacyClassSubgroupsGroupOps.Elements := function ( C )
  1485.     return Set( Orbit( C.group, C.representative ) );
  1486. end;
  1487.  
  1488.  
  1489. #############################################################################
  1490. ##
  1491. #F  ConjugacyClassSubgroupsGroupOps.Size( <C> ) . . . . . . . . . . . . . . .
  1492. ##
  1493. ConjugacyClassSubgroupsGroupOps.Size := function ( C )
  1494.     if not IsBound( C.normalizerLattice )  then
  1495.         C.normalizerLattice := [
  1496.             ConjugacyClassSubgroups( C.group, Normalizer( C.group,
  1497.                 C.representative ) ),
  1498.             C.group.identity
  1499.         ];
  1500.     fi;
  1501.     return Index( C.group, C.normalizerLattice[1].representative );
  1502. end;
  1503.  
  1504.  
  1505. #############################################################################
  1506. ##
  1507. #F  ConjugacyClassSubgroupsGroupOps.\=( <C>, <D> ) . . . . . . . . . . . . .
  1508. ##
  1509. ConjugacyClassSubgroupsGroupOps.\= := function ( C, D )
  1510.     local    isEql;
  1511.  
  1512.     if    IsRec( C )  and IsBound( C.isConjugacyClassSubgroups )
  1513.       and IsRec( D )  and IsBound( D.isConjugacyClassSubgroups )
  1514.       and C.group = D.group
  1515.     then
  1516.         isEql := Size( C ) = Size( D )
  1517.              and Size( C.representative ) = Size( D.representative )
  1518.              and RepresentativeOperation( C.group,
  1519.                                           D.representative,
  1520.                                           C.representative ) <> false;
  1521.     else
  1522.         isEql := DomainOps.\=( C, D );
  1523.     fi;
  1524.     return isEql;
  1525.  
  1526. end;
  1527.  
  1528.  
  1529. #############################################################################
  1530. ##
  1531. #F  ConjugacyClassSubgroupsGroupOps.\in( <H>, <C> )  . . . . . . . . . . . .
  1532. ##
  1533. ConjugacyClassSubgroupsGroupOps.\in := function ( H, C )
  1534.     return     Size( H ) = Size( C.representative )
  1535.            and RepresentativeOperation( C.group,
  1536.                                         H,
  1537.                                         C.representative ) <> false;
  1538. end;
  1539.  
  1540.  
  1541. #############################################################################
  1542. ##
  1543. #F  ConjugacyClassSubgroupsGroupOps.Random( <C> ) . . . . . . . . . . . . . .
  1544. ##
  1545. ConjugacyClassSubgroupsGroupOps.Random := function ( C )
  1546.     return C.representative ^ Random( C.group );
  1547. end;
  1548.  
  1549.  
  1550. #############################################################################
  1551. ##
  1552. #F  ConjugacyClassGroupOps.\*( <C>, <D> )  . . . . . . . . . . . . . . . . .
  1553. ##
  1554. ConjugacyClassGroupOps.\* := function ( C, D )
  1555.     if IsConjugacyClass( C )  then
  1556.         return Elements( C ) * D;
  1557.     elif IsConjugacyClass( D )  then
  1558.         return C * Elements( D );
  1559.     else
  1560.         Error(
  1561.             "panic, neither <C> nor <D> is a conjugacy class of subgroups" );
  1562.     fi;
  1563. end;
  1564.  
  1565.  
  1566. #############################################################################
  1567. ##
  1568. #F  ConjugacyClassSubgroupsGroupOps.Print( <C> )  . . . . . . . . . . . . . .
  1569. ##
  1570. ConjugacyClassSubgroupsGroupOps.Print := function ( C )
  1571.     Print( "ConjugacyClassSubgroups( ", C.group, ", ", C.representative, " )"
  1572.     );
  1573. end;
  1574.  
  1575.  
  1576. #############################################################################
  1577. ##
  1578. #V  SubgroupLatticeOps  . . . . . . . operations record for subgroup lattices
  1579. ##
  1580. SubgroupLatticeOps := rec();
  1581.  
  1582.  
  1583. #############################################################################
  1584. ##
  1585. #F  SubgroupLatticeOps.Lattice( <lattice> ) . . resume an aborted calculation
  1586. ##
  1587. SubgroupLatticeOps.Lattice := GroupOps.Lattice;
  1588.  
  1589.  
  1590. #############################################################################
  1591. ##
  1592. #F  SubgroupLatticeOps.TableOfMarks( <lattice> )  . . . . . .  table of marks
  1593. ##
  1594. SubgroupLatticeOps.TableOfMarks := function( L )
  1595.     return TableOfMarks( L.group );
  1596. end;
  1597.  
  1598.  
  1599. #############################################################################
  1600. ##
  1601. #F  SubgroupLatticeOps.ClearLatticeQueue( <lattice> ) . . . . . . . . . . . .
  1602. #F  . . . . . . . . . . . . . . . . . . . . . .  move queue groups to lattice
  1603. ##
  1604. SubgroupLatticeOps.ClearLatticeQueue := function( L )
  1605.     local   C, i;
  1606.  
  1607.     for i in [1..Length( L.queue )] do
  1608.         if IsBound( L.queue[i] ) then
  1609.             C := L.queue[i];
  1610.             Unbind( L.queue[i] );
  1611.             SetLatticeStatus( L, C, L.queueGroups );
  1612.         fi;
  1613.     od;
  1614. end;
  1615.  
  1616.  
  1617. #############################################################################
  1618. ##
  1619. #F  SubgroupLatticeOps.Information( <lattice>[, <topics>] ) . . . . . . . . .
  1620. ##
  1621. ##  returns
  1622. ##
  1623. ##      rec(
  1624. ##          classes     := <integer>,
  1625. ##          groups      := <integer>,
  1626. ##          layers      := <integer>,
  1627. ##          groupsizes  := <list>,
  1628. ##          classizes   := <list>,
  1629. ##          classlayers := <list>,
  1630. ##          queuelayers := <list>,
  1631. ##          queuegroups := <integer>,
  1632. ##          queuesizes  := <list>,
  1633. ##          items       := <record>,
  1634. ##          queueitems  := <record>
  1635. ##      )
  1636. ##
  1637. SubgroupLatticeOps.Information := function( arg )
  1638.     local   L, topics, info, tmp, rep, layers, fld, x, i;
  1639.  
  1640.     if Length( arg ) = 1 then
  1641.         L      := arg[1];
  1642.         topics := [ "classes", "groups" ];
  1643.     elif Length( arg ) = 2 then
  1644.         L      := arg[1];
  1645.         topics := arg[2];
  1646.     else
  1647.         Error( "usage: Information( <lattice>[, <topics>] )" );
  1648.     fi;
  1649.  
  1650.     if not IsLattice( L ) or not IsList( topics ) then
  1651.         Error( "usage: Information( <lattice>[, <topics>] )" );
  1652.     fi;
  1653.  
  1654.     layers := Length( Factors( Size( L.group ) ) );
  1655.  
  1656.     info := rec();
  1657.  
  1658.     if "classes" in topics then
  1659.         info.classes := Length( L.classes );
  1660.     fi;
  1661.  
  1662.     if "groups" in topics then
  1663.         tmp := 0;
  1664.         for x in L.classes do
  1665.             tmp := tmp + x.size;
  1666.         od;
  1667.         info.groups := tmp;
  1668.     fi;
  1669.  
  1670.     if "layers" in topics then
  1671.         info.layers := layers;
  1672.     fi;
  1673.  
  1674.     if "groupsizes" in topics then
  1675.         tmp := ShallowCopy( L.classes );
  1676.         for i in [1..Length( tmp )] do
  1677.             tmp[i] := tmp[i].representative.size;
  1678.         od;
  1679.         info.sizes := tmp;
  1680.     fi;
  1681.  
  1682.     if "classizes" in topics then
  1683.         tmp := ShallowCopy( L.classes );
  1684.         for i in [1..Length( tmp )] do
  1685.             tmp[i] := tmp[i].size;
  1686.         od;
  1687.         info.classizes := tmp;
  1688.     fi;
  1689.  
  1690.     if "classlayers" in topics then
  1691.         tmp := [1..layers+1];
  1692.         for i in [1..layers+1] do
  1693.             tmp[i] := [];
  1694.         od;
  1695.         for x in L.classes do
  1696.             Add( tmp[x.layer+1], x );
  1697.         od;
  1698.         info.classlayers := tmp;
  1699.     fi;
  1700.  
  1701.     if "queuelayers" in topics then
  1702.         tmp := [1..layers+1];
  1703.         for i in [1..layers+1] do
  1704.             tmp[i] := [];
  1705.         od;
  1706.         for x in L.queue do
  1707.             Add( tmp[x.layer+1], x );
  1708.         od;
  1709.         info.queuelayers := tmp;
  1710.     fi;
  1711.  
  1712.     if "queuegroups" in topics then
  1713.         tmp := 0;
  1714.         for x in L.queue do
  1715.             tmp := tmp + 1;
  1716.         od;
  1717.         info.queuegroups := tmp;
  1718.     fi;
  1719.  
  1720.     if "queuesizes" in topics then
  1721.         tmp := [];
  1722.         for x in L.queue do
  1723.             Add( tmp, x.representative.size );
  1724.         od;
  1725.         info.queuesizes := tmp;
  1726.     fi;
  1727.  
  1728.     if "items" in topics then
  1729.  
  1730.         tmp := rec(
  1731.             elements   := 0,
  1732.             zuppos     := 0,
  1733.             zuppoBlist := 0
  1734.         );
  1735.  
  1736.         for x in L.classes do
  1737.             rep := x.representative;
  1738.             if IsBound( rep.elements ) then
  1739.                 tmp.elements := tmp.elements + 1;
  1740.             fi;
  1741.             if IsBound( rep.zuppos ) then
  1742.                 tmp.zuppos := tmp.zuppos + 1;
  1743.             fi;
  1744.             if IsBound( rep.zuppoBlist ) then
  1745.                 tmp.zuppoBlist := tmp.zuppoBlist + 1;
  1746.             fi;
  1747.         od;
  1748.  
  1749.         info.items := tmp;
  1750.     fi;
  1751.  
  1752.     if "queueitems" in topics then
  1753.  
  1754.         tmp := rec(
  1755.             elements   := 0,
  1756.             zuppos     := 0,
  1757.             zuppoBlist := 0
  1758.         );
  1759.  
  1760.         for x in L.queue do
  1761.             rep := x.representative;
  1762.             if IsBound( rep.elements ) then
  1763.                 tmp.elements := tmp.elements + 1;
  1764.             fi;
  1765.             if IsBound( rep.zuppos ) then
  1766.                 tmp.zuppos := tmp.zuppos + 1;
  1767.             fi;
  1768.             if IsBound( rep.zuppoBlist ) then
  1769.                 tmp.zuppoBlist := tmp.zuppoBlist + 1;
  1770.             fi;
  1771.         od;
  1772.  
  1773.         info.queueitems := tmp;
  1774.     fi;
  1775.  
  1776.     if "memory" in topics then
  1777.         tmp := rec( representative := rec() );
  1778.         for x in L.classes do
  1779.             rep := x.representative;
  1780.             for fld in RecFields( x ) do
  1781.                 if not fld in [ "group", "representative", "operations" ]
  1782.                     then
  1783.                     if IsRec( x.( fld ) ) then
  1784.                         Print( "#I  Warning: ignoring field '", fld, "'\n" );
  1785.                     else
  1786.                         if not IsBound( tmp.( fld ) ) then
  1787.                             tmp.( fld ) := 0;
  1788.                         fi;
  1789.                         tmp.( fld ) := (tmp.( fld )) + SIZE( x.( fld ) );
  1790.                     fi;
  1791.                 fi;
  1792.             od;
  1793.             for fld in RecFields( rep ) do
  1794.                 if not fld in [ "parent", "operations" ] then
  1795.                     if IsRec( rep.( fld ) ) then
  1796.                         Print( "#I  Warning: ignoring field '", fld, "'\n" );
  1797.                     else
  1798.                         if not IsBound( tmp.representative.( fld ) ) then
  1799.                             tmp.representative.( fld ) := 0;
  1800.                         fi;
  1801.                         tmp.representative.( fld ) := (tmp.representative.(
  1802.                             fld )) + SIZE( rep.( fld ) );
  1803.                     fi;
  1804.                 fi;
  1805.             od;
  1806.         od;
  1807.  
  1808.         info.memory := tmp;
  1809.     fi;
  1810.  
  1811.     return info;
  1812. end;
  1813.  
  1814.  
  1815. #############################################################################
  1816. ##
  1817. #F  GroupOps.RightTransversal( <G>, <H> ) . . . determine a right transversal
  1818. ##
  1819. ##  returns
  1820. ##
  1821. ##      <list>
  1822. ##
  1823. GroupOps.RightTransversal := function( G, H )
  1824.     return List( G.operations.RightCosets( G, H ), x -> x.representative );
  1825. end;
  1826.  
  1827.  
  1828. #############################################################################
  1829. ##
  1830. #F  GroupOps.CheckPerfectGroupType( <group>, <cat_entry> )  . . . . . . . . .
  1831. ##
  1832. GroupOps.CheckPerfectGroupType := function( G, CG )
  1833.     local type, cc, list;
  1834.  
  1835.  
  1836.     InfoLattice2( "#I  PerfectSubgroups: checking group types\n" );
  1837.  
  1838.     # make sure the conjugacy classes of G have '.size' bounded
  1839.  
  1840.     for cc in ConjugacyClasses( G ) do
  1841.         Size( cc );
  1842.     od;
  1843.  
  1844.     # now check all types specified in CG.grouptype
  1845.  
  1846.     for type in CG.grouptype do
  1847.  
  1848.         InfoLattice2( "#I   checking group type ", type, "\n" );
  1849.  
  1850.         if type[1] = 1 then
  1851.             list := Filtered( ConjugacyClasses( G ),
  1852.                               x -> Order( G, x.representative ) = type[2] );
  1853.             if Sum( List( list, Size ) ) <> type[3] then
  1854.                 InfoLattice2( "#I   type test 1 failed\n" );
  1855.                 return false;
  1856.             fi;
  1857.         elif type[1] = 2 then
  1858.             InfoLattice2("#I  perfect group type check 2 not implemented\n");
  1859.         elif type[1] = 3 then
  1860.             list := Filtered( ConjugacyClasses( G ),
  1861.                               x -> x.size = type[3]
  1862.                                and Order( G, x.representative ) = type[2] );
  1863.             if Length( list ) <> type[4] then
  1864.                 InfoLattice2( "#I   type test 3 failed\n" );
  1865.                 return false;
  1866.             fi;
  1867.         elif type[1] = 4 then
  1868.             InfoLattice2("#I  perfect group type check 4 not implemented\n");
  1869.         fi;
  1870.     od;
  1871.  
  1872.     InfoLattice2( "#I   group is of correct type\n" );
  1873.  
  1874.     return true;
  1875. end;
  1876.  
  1877.  
  1878. #############################################################################
  1879. ##
  1880. #F  GroupOps.FindPerfectGenerator( <group>, <cat_entry>, <C>, <gens> )  . . .
  1881. ##
  1882. GroupOps.FindPerfectGenerator := function( G, CG, U, gens )
  1883.     local k, cc, cclist, cyc, g, cent, w, type, list, orb, sum;
  1884.  
  1885.  
  1886.     k := Length( gens ) + 1;
  1887.  
  1888.     if k > Length( CG.generators ) then
  1889.  
  1890.         InfoLattice2( "#I  PerfectSubgroups: testing (anti)relations\n" );
  1891.  
  1892.         # now check if the (anti)relations are obeyed.
  1893.  
  1894.         for w in CG.relations do
  1895.             if MappedWord( w, CG.generators, gens ) <> G.identity then
  1896.                 InfoLattice2( "#I   relations are not fulfilled\n" );
  1897.                 return false;
  1898.             fi;
  1899.         od;
  1900.  
  1901.         for w in CG.antirelations do
  1902.             if MappedWord( w, CG.generators, gens ) = G.identity then
  1903.                 InfoLattice2( "#I   antirelations are not fulfilled\n" );
  1904.                 return false;
  1905.             fi;
  1906.         od;
  1907.  
  1908.         InfoLattice2( "#I   group is identified\n" );
  1909.         return true;
  1910.     else
  1911.  
  1912.         InfoLattice2("#I  PerfectSubgroups: searching generator ", k, "\n");
  1913.  
  1914.         # O.K. we have to find the k-th generator
  1915.  
  1916.         type := CG.generatortype[k];
  1917.  
  1918.         # type specifications 1 and 4 may be tested for full classes
  1919.  
  1920.         list := Filtered( ConjugacyClasses( G ),
  1921.                           x -> Order( G, x.representative ) = type[1] );
  1922.         list := Filtered( list,
  1923.                           x -> x.size = type[4] );
  1924.  
  1925.         # now try to find a generator in one of the remaining classes
  1926.  
  1927.         for cc in list do
  1928.  
  1929.             cclist := ShallowCopy( Elements( cc ) );
  1930.  
  1931.             while cclist <> [] do
  1932.  
  1933.                 g := cclist[1];
  1934.                 orb := Orbit( U, g );
  1935.                 gens[k] := g;
  1936.  
  1937.                 if Length( orb ) = type[2] then
  1938.                     cyc := Elements( Group( g ) );
  1939.                     cyc := Filtered( cyc, x -> Order( G, x ) = type[1] );
  1940.                     sum := 1;
  1941.                     SubtractSet( cyc, orb );
  1942.                     while cyc <> [] do
  1943.                         SubtractSet( cyc, Orbit( U, cyc[1] ) );
  1944.                         sum := sum + 1;
  1945.                     od;
  1946.                     if sum = type[3] then
  1947.                         cent := Centralizer( U, g );
  1948.                         if G.operations.FindPerfectGenerator( G, CG, cent,
  1949.                             gens ) then
  1950.                             return true;
  1951.                         fi;
  1952.                     fi;
  1953.                 fi;
  1954.  
  1955.                 SubtractSet( cclist, orb );
  1956.             od;
  1957.         od;
  1958.  
  1959.         Unbind( gens[k] );
  1960.         return false;
  1961.     fi;
  1962. end;
  1963.  
  1964.  
  1965. #############################################################################
  1966. ##
  1967. #F  SubgroupLatticeOps.SetPrintLevel( <L>, <lev> )  . . change amount of info
  1968. ##
  1969. SubgroupLatticeOps.SetPrintLevel := function( L, lev )
  1970.    if IsInt( lev ) then
  1971.       if   lev = 0 then   lev := [ 0, 0, 0, 0, 0 ];
  1972.       elif lev = 1 then   lev := [ 1, 0, 0, 0, 0 ];
  1973.       elif lev = 2 then   lev := [ 2, 1, 0, 1, 0 ];
  1974.       elif lev = 3 then   lev := [ 3, 2, 0, 1, 0 ];
  1975.       elif lev = 4 then   lev := [ 4, 2, 1, 2, 0 ];
  1976.       elif lev = 5 then   lev := [ 4, 2, 1, 2, 2 ];
  1977.       else
  1978.          Error( "sorry, <integer> must lie between 0 and 5" );
  1979.       fi;
  1980.    elif IsList( lev ) then
  1981.       if Length( lev ) <> 5 then
  1982.          Error( "sorry, <list> must hold 5 integers" );
  1983.       fi;
  1984.    else
  1985.       Error( "usage: SetPrintLevel( <lattice>, <integer>|<list> )" );
  1986.    fi;
  1987.    L.printLevel := lev;
  1988. end;
  1989.  
  1990.  
  1991. #############################################################################
  1992. ##
  1993. #F  SubgroupLatticeOps.Print( <lattice> ) . . . . .  print a subgroup lattice
  1994. ##
  1995. SubgroupLatticeOps.Print := function( L )
  1996.    local  c;
  1997.    if not IsBound( L.printLevel ) then
  1998.       L.operations.SetPrintLevel( L, 0 );
  1999.    fi;
  2000.    if Set( L.printLevel ) <> [ 0 ] then
  2001.       for c in [1..Length( L.classes )] do
  2002.          PrintClassSubgroupLattice( L, c );
  2003.       od;
  2004.    fi;
  2005.    Print( "Lattice( ", L.group, " )" );
  2006. end;
  2007.  
  2008.  
  2009. PrintClassSubgroupLattice := function( L, cl )
  2010.    local   i;
  2011.  
  2012.    if L.printLevel[1] >= 1 then
  2013.       Print( "#I  Class number ", String(cl,3), ", Length ",
  2014.          String(Size(L.classes[cl] ),4), ", Order ",
  2015.          Size( L.classes[cl].representative ), "\n" );
  2016.    fi;
  2017.    if L.printLevel[1] >= 2 then
  2018.       PrintGroupSubgroupLattice( L, cl, 1 );
  2019.       PrintMinSubgroupLattice( L, cl, 1 );
  2020.       PrintMaxSubgroupLattice( L, cl, 1 );
  2021.    fi;
  2022.    if L.printLevel[1] >= 3 then
  2023.       for i in [2..Size( L.classes[cl] )] do
  2024.          PrintGroupSubgroupLattice( L, cl, i );
  2025.          PrintMinSubgroupLattice( L, cl, i );
  2026.          PrintMaxSubgroupLattice( L, cl, i );
  2027.       od;
  2028.    fi;
  2029. end;
  2030.  
  2031.  
  2032. PrintGroupSubgroupLattice := function( L, cl, co )
  2033.    local c, g;
  2034.  
  2035.    c := L.classes[cl];
  2036.  
  2037.    if co = 1 then
  2038.        Print( "#I    Representative " );
  2039.    else
  2040.        Print( "#I    Conjugate ", co, " by ", c.conjugands[co], " is " );
  2041.    fi;
  2042.  
  2043.    if L.printLevel[2] >= 1 and co = 1 then
  2044.       Print( c.representative.generators );
  2045.    fi;
  2046.    if L.printLevel[2] >= 2 and co <> 1 then
  2047.       g := c.representative ^ c.conjugands[co];
  2048.       Print( g.generators );
  2049.    fi;
  2050.    Print( "\n" );
  2051. end;
  2052.  
  2053.  
  2054. PrintMaxSubgroupLattice := function( L, cl, co )
  2055.    local classes, count, i, id, k, mmlr, rep, repi, tinv, tt, zuppos;
  2056.  
  2057.    classes := L.classes;
  2058.    rep := classes[cl].representative;
  2059.    if rep.size = 1 then  return;  fi;
  2060.  
  2061.    # compute (and save) a list of the maximal subgroups and the minimal
  2062.    # supergroups of all class representative subgroups, if not yet done.
  2063.    mmlr := MinMaxLatticeRelation( L.group );
  2064.  
  2065.    if L.printLevel[4] >= 1 and co = 1 then
  2066.       # print the maximal subgroups of the given class representative
  2067.       # subgroup.
  2068.       Print( "#I    Max " );
  2069.       for i in [ 1 .. cl-1 ] do
  2070.          for k in mmlr[i][cl] do
  2071.             Print( " [", i, ",", k, "]" );
  2072.          od;
  2073.       od;
  2074.       Print( "\n" );
  2075.  
  2076.    elif L.printLevel[4] >= 2 and co <> 1 then
  2077.       # print the maximal subgroups of the given class non representative
  2078.       # subgroup.
  2079.       Print( "#I    Max " );
  2080.       id := L.group.identity;
  2081.       tinv := classes[cl].conjugands[co]^-1;
  2082.       for i in [ 1 .. cl-1 ] do
  2083.          count := Length( mmlr[i][cl] );
  2084.          if count > 0 then
  2085.             repi := classes[i].representative;
  2086.             k := 0;
  2087.             while count > 0 do
  2088.                k := k + 1;
  2089.                tt := classes[i].conjugands[k] * tinv;
  2090.                if tt = id then
  2091.                   zuppos := ZuppoBlist( repi );
  2092.                else
  2093.                   zuppos := ConjugateZuppoBlist( repi, tt );
  2094.                fi;
  2095.                if IsSubsetBlist( rep.zuppoBlist, zuppos ) then
  2096.                    Print( " [", i, ",", k, "]" );
  2097.                    count := count - 1;
  2098.                fi;
  2099.             od;
  2100.          fi;
  2101.       od;
  2102.       Print( "\n" );
  2103.    fi;
  2104. end;
  2105.  
  2106.  
  2107. PrintMinSubgroupLattice := function( L, cl, co )
  2108.    local classes, count, i, id, k, mmlr, rep, repi, t, tt, zuppos;
  2109.  
  2110.    classes := L.classes;
  2111.    rep := classes[cl].representative;
  2112.    if rep.size = Size( L.group ) then  return;  fi;
  2113.  
  2114.    # compute (and save) a list of the maximal subgroups and the minimal
  2115.    # supergroups of all class representative subgroups, if not yet done.
  2116.    mmlr := MinMaxLatticeRelation( L.group );
  2117.  
  2118.    if L.printLevel[5] >= 1 and co = 1 then
  2119.       # print the minimal supergroups of the given class representative
  2120.       # subgroup.
  2121.       Print( "#I    Min " );
  2122.       for i in [ cl+1 .. Length( classes ) ] do
  2123.          for k in mmlr[i][cl] do
  2124.             Print( " [", i, ",", k, "]" );
  2125.          od;
  2126.       od;
  2127.       Print( "\n" );
  2128.  
  2129.    elif L.printLevel[5] >= 2 and co <> 1 then
  2130.       # print the minimal supergroups of the given class non representative
  2131.       # subgroup.
  2132.       Print( "#I    Min " );
  2133.       id := L.group.identity;
  2134.       t := classes[cl].conjugands[co];
  2135.       for i in [ cl+1 .. Length( classes ) ] do
  2136.          count := Length( mmlr[i][cl] );
  2137.          if count > 0 then
  2138.             repi := classes[i].representative;
  2139.             k := 0;
  2140.             while count > 0 do
  2141.                k := k + 1;
  2142.                tt := t * classes[i].conjugands[k]^-1;
  2143.                if tt = id then
  2144.                   zuppos := ZuppoBlist( rep );
  2145.                else
  2146.                   zuppos := ConjugateZuppoBlist( rep, tt );
  2147.                fi;
  2148.                if IsSubsetBlist( repi.zuppoBlist, zuppos ) then
  2149.                    Print( " [", i, ",", k, "]" );
  2150.                    count := count - 1;
  2151.                fi;
  2152.             od;
  2153.          fi;
  2154.       od;
  2155.       Print( "\n" );
  2156.    fi;
  2157. end;
  2158.  
  2159.  
  2160. MinMaxLatticeRelation := function( D )
  2161.     local   rel;
  2162.  
  2163.     if IsDomain(D) and IsBound(D.minMaxLatticeRelation) then
  2164.         rel := D.minMaxLatticeRelation;
  2165.     elif  IsDomain(D) and IsBound(D.operations.MinMaxLatticeRelation) then
  2166.         D.minMaxLatticeRelation := D.operations.MinMaxLatticeRelation( D );
  2167.         rel := D.minMaxLatticeRelation;
  2168.     else
  2169.         Error( "sorry, can't compute lattice relation for domain" );
  2170.     fi;
  2171.     return rel;
  2172. end;
  2173.  
  2174.  
  2175. GroupOps.MinMaxLatticeRelation := function( arg )
  2176.  
  2177.     local   group, classes, reps, dim, m, count, zuppos, left, right,
  2178.             lreps, rreps, vargs, t, i, j, k;
  2179.  
  2180.     # check the arguments
  2181.     vargs := [ "min", "max" ];
  2182.     group := arg[1];
  2183.  
  2184.     if Length( arg ) = 1 then
  2185.         classes := ConjugacyClassesSubgroups( group );
  2186.         Append( arg, [ "min", "max" ] );
  2187.     elif IsList( arg[2] ) then
  2188.         if not IsSubset( vargs, Sublist( arg, [3..Length( arg )] ) ) then
  2189.             Error( "sorry, unkown argument options" );
  2190.         fi;
  2191.         classes := arg[2];
  2192.     else
  2193.         if not IsSubset( vargs, Sublist( arg, [2..Length( arg )] ) ) then
  2194.             Error( "sorry, unkown argument options" );
  2195.         fi;
  2196.  
  2197.         classes := ConjugacyClassesSubgroups( group );
  2198.     fi;
  2199.  
  2200.     # ensure that the classes are sorted by increasing subgroup
  2201.     # orders.
  2202.     for i in [ 2 .. Length( classes ) ] do
  2203.         if classes[i].representative.size <
  2204.             classes[i-1].representative.size then
  2205.                 Error( "classes of subgroups are not sorted" );
  2206.         fi;
  2207.     od;
  2208. #T  Sort( classes,
  2209. #T      function( x, y )
  2210. #T          return x.representative.size < y.representative.size;
  2211. #T      end );
  2212.  
  2213.     reps  := List( classes, x -> x.representative );
  2214.     dim   := Length( classes );
  2215.     left  := "min" in arg;
  2216.     right := "max" in arg;
  2217.  
  2218.     m := List( classes, x -> List( classes, x -> [] ) );
  2219.     for i in [1..dim] do
  2220.         m[i][i] := [ 1 ];
  2221.     od;
  2222.  
  2223.     for i in [1..dim] do
  2224.         if reps[i].size = 1 and right then
  2225.             for j in [i+1..dim] do m[i][j] := ShallowCopy( m[i][i] ); od;
  2226.         elif reps[i].size = Size( group ) and left then
  2227.             for j in [1..i-1] do m[i][j] := ShallowCopy( m[i][i] ); od;
  2228.         else
  2229.             lreps := [];
  2230.             rreps := [];
  2231.             if left then
  2232.                 for j in [1..i-1] do
  2233.                     if reps[i].size mod reps[j].size = 0 then
  2234.                         Add( lreps, j );
  2235.                     fi;
  2236.                 od;
  2237.             fi;
  2238.             if right then
  2239.                 for j in [i+1..dim] do
  2240.                     if reps[j].size mod reps[i].size = 0 then
  2241.                         Add( rreps, j );
  2242.                     fi;
  2243.                 od;
  2244.             fi;
  2245.             for k in [1..Length( classes[i].conjugands )] do
  2246.                 t := classes[i].conjugands[k];
  2247.                 if t = group.identity then
  2248.                     zuppos := ZuppoBlist( reps[i] );
  2249.                 else
  2250.                     zuppos := ConjugateZuppoBlist( reps[i], t );
  2251.                 fi;
  2252.                 for j in lreps do
  2253.                     if IsSubsetBlist( zuppos, reps[j].zuppoBlist ) then
  2254.                         Add( m[i][j], k );
  2255.                     fi;
  2256.                 od;
  2257.                 for j in rreps do
  2258.                     if IsSubsetBlist( reps[j].zuppoBlist, zuppos ) then
  2259.                         Add( m[i][j], k );
  2260.                     fi;
  2261.                 od;
  2262.             od;
  2263.         fi;
  2264.     od;
  2265.     for i in [1..dim] do
  2266.        for j in [1..dim] do
  2267.           if m[i][j] <> [] then
  2268.              if i > j then
  2269.                 for k in [i+1..dim] do
  2270.                     if m[k][i] <> [] then
  2271.                         m[k][j] := [];
  2272.                     fi;
  2273.                 od;
  2274.              elif i < j then
  2275.                  for k in [1..i-1] do
  2276.                      if m[k][i] <> [] then
  2277.                          m[k][j] := [];
  2278.                      fi;
  2279.                  od;
  2280.              fi;
  2281.           fi;
  2282.        od;
  2283.     od;
  2284.  
  2285.     return m;
  2286.  
  2287. end;
  2288.  
  2289.  
  2290. #############################################################################
  2291. ##
  2292. #F  GroupOps.PerfectSubgroups( <group> )  . . . . . . . . . . . . . . . . . .
  2293. ##
  2294. GroupOps.PerfectSubgroups := function( group )
  2295.     local list, gens, pergrp, catgrp, solres;
  2296.  
  2297.  
  2298.     # compute the solvable residuum of the group
  2299.  
  2300.     solres := DerivedSeries( group );
  2301.     solres := solres[Length( solres )];
  2302.  
  2303.     if Size( solres ) = 1 then
  2304.         return [];
  2305.     fi;
  2306.  
  2307.     for catgrp in PerfectGroupsCatalogue do
  2308.         if catgrp.size = solres.size then
  2309.             gens := [];
  2310.             if solres.operations.CheckPerfectGroupType( solres, catgrp )
  2311.               and solres.operations.FindPerfectGenerator( solres,
  2312.                                                           catgrp,
  2313.                                                           solres,
  2314.                                                           gens )
  2315.             then
  2316.                 list := [ solres ];
  2317.                 for pergrp in catgrp.subgroups do
  2318.                     Add( list, Subgroup( Parent( group ),
  2319.                         List( pergrp.generators,
  2320.                         x -> MappedWord( x, catgrp.generators, gens ) ) ) );
  2321.                 od;
  2322.                 FreePerfectGroupsCatalogue();
  2323.                 return list;
  2324.             fi;
  2325.         fi;
  2326.     od;
  2327.  
  2328.     Error( "sorry, can' t identify the group's solvable residuum" );
  2329. end;
  2330.  
  2331.  
  2332. #############################################################################
  2333. ##
  2334. #F  FreePerfectGroupsCatalogue()  . .  unload the catalogue of perfect groups
  2335. ##
  2336. FreePerfectGroupsCatalogue := function()
  2337.     AUTO( ReadLib( "lattperf" ), PerfectGroupsCatalogue );
  2338. end;
  2339.  
  2340.  
  2341. #############################################################################
  2342. ##
  2343. #E  Emacs . . . . . . . . . . . . . . . . . . . . . . . local emacs variables
  2344. ##
  2345. ##  Local Variables:
  2346. ##  mode:               outline
  2347. ##  outline-regexp:     "#F\\|#V\\|#E"
  2348. ##  fill-column:        73
  2349. ##  fill-prefix:        "##  "
  2350. ##  eval:               (hide-body)
  2351. ##  End:
  2352. ##
  2353.