SSL tom.gi Sprache: unbekannt

#############################################################################
##
## This file is part of GAP, a system for computational discrete algebra.
## This file's authors include Götz Pfeiffer, Thomas Merkwitz.
##
## Copyright of GAP belongs to its developers, whose names are too numerous
## to list here. Please refer to the COPYRIGHT file for details.
##
## SPDX-License-Identifier: GPL-2.0-or-later
##
## This file contains methods for tables of marks.
##
## 1. Tables of Marks
## 2. More about Tables of Marks
## 3. Table of Marks Objects in {\GAP}
## 4. Constructing Tables of Marks
## 5. Printing Tables of Marks
## 6. Sorting Tables of Marks
## 7. Technical Details about Tables of Marks
## 8. Attributes of Tables of Marks
## 9. Properties of Tables of Marks
## 10. Other Operations for Tables of Marks
## 11. Accessing Subgroups via Tables of Marks
## 12. The Interface between Tables of Marks and Character Tables
## 13. Generic Construction of Tables of Marks
##

#############################################################################
##
## 4. Constructing Tables of Marks
##

#############################################################################
##
#F GeneratorsListTom( <G>, <classes> ) . . . . . . . . . . create generators
##
## `GeneratorsListTom' lists a set of generators for a representative
## of each conjugacy class of subgroups.
##
BindGlobal( "GeneratorsListTom", function( G, classes )
 local sub, gen, res;

 # take the generators
 sub:= List( classes, x -> GeneratorsOfGroup( Representative( x ) ) );

 # form the generators list
 gen:= Union( sub );

 # compute the positions
 res:= List( sub, grp -> List( grp, elm -> Position( gen, elm ) ) );
 return [ gen, res ];
 end );

#############################################################################
##
#M TableOfMarks( <G> ) . . . . . . . . compute the table of marks of a group
##
InstallMethod( TableOfMarks,
 "for a cyclic group",
 [ IsGroup and IsCyclic ],
 function( G )
 local n, c, tom, gens, gen, subs, marks, classNames,
 name, i, j, divs, index;

 n:= Size( G );

 # construct the table of marks without the group

 # initialize
 divs:= DivisorsInt( n );
 c:= Length( divs );
 subs:= [];
 marks:= [];
 classNames:=[];

 # Compute generators for each subgroup.
 gens:= GeneratorsOfGroup( G );
 if 1 < Length( gens ) then
 gens:= MinimalGeneratingSet( G );
 fi;
 if 0 < Length( gens ) then
 gen:= gens[1];
 else
 gen:= One( G );
 fi;
 gens:= [ List( divs, d -> gen^(n/d) ),
 List( [ 1 .. c ], i -> [ i ] ) ];

 # construct each subgroup (each divisor)
 for i in [ 1 .. c ] do

 classNames[i]:= String( divs[i] );
 ConvertToStringRep( classNames[i] );

 index:= n / divs[i];
 subs[i]:= [];
 marks[i]:= [];
 for j in [1..i] do
 if divs[i] mod divs[j] = 0 then
 Add( subs[i], j );
 Add( marks[i], index );
 fi;
 od;

 od;

 # add new components
 if HasName( G ) then
 name:= Name( G );
 else
 name:= Concatenation( "C", String( n ) );
 fi;

 # make the object
 tom:= rec( Identifier := name,
 SubsTom := subs,
 MarksTom := marks,
 NormalizersTom := List( [ 1 .. c ], x -> c ),
 DerivedSubgroupsTomUnique := List( [ 1 .. c ], x -> 1 ),
 UnderlyingGroup := G,
 GeneratorsSubgroupsTom := gens );

 tom:= ConvertToTableOfMarks( tom );
 SetClassNamesTom( tom, classNames );
 return tom;
 end );

#############################################################################
##
#F TableOfMarksByLattice( <G> )
##
InstallGlobalFunction( TableOfMarksByLattice, function( G )
 local marks, # components of the table of marks
 subs,
 normalizers,
 derivedSubgroups,
 tom,
 mrks, # marks for one class
 ind, # index of in <N>
 zuppos, # generators of prime power order
 classes, # list of all classes
 classesZups, # zuppos blist of classes
 I, # representative of a class
 Ielms, # elements of 
 Izups, # zuppos blist of 
 N, # normalizer of 
 D, # derived subgroup of ,
 Delms, # elements of <D>,
 Dzups, # zuppos blist of <D>
 DG, # derived subgroup of <G>
 DGzups, # zuppos blist of <DG>
 Jzups, # zuppos of a conjugate of 
 Kzups, # zuppos of a representative in <classes>
 reps, # transversal of <N> in <G>
 i,k,r; # loop variables

#T Is this necessary at all?
 LatticeSubgroups( G );

 # compute the lattice,fetch the classes,zuppos,and representatives
 classes:= ShallowCopy( ConjugacyClassesSubgroups( G ) );

 # sort the classes
 SortBy(classes,a->Size(Representative(a)));
 classesZups:=[];

 # compute a system of generators for the cyclic sgr. of prime power size
 zuppos:=Zuppos(G);

 # initialize the table of marks
 Info(InfoLattice,1,"computing table of marks");
 subs:=List([1..Length(classes)],x->[]);
 marks:=List([1..Length(classes)],x->[]);
 derivedSubgroups:=[];
 normalizers:=[];
 DG:= DerivedSubgroup( G );
 if Size(DG) = Size(G) then # G perfect
 derivedSubgroups[Length(classes)]:= Length(classes);
 elif Size(DG) = 1 then # G abelian
 derivedSubgroups[Length(classes)]:= 1;
 else
 DGzups:=BlistList(zuppos,AttributeValueNotSet(AsList,DG));
 fi;
 Unbind(DG);

 # loop over all classes
 for i in [1..Length(classes)-1] do

 # take the subgroup 
 I:=Representative(classes[i]);

 # compute the zuppos blist of 
 Ielms:=AttributeValueNotSet(AsList,I);
 Izups:=BlistList(zuppos,Ielms);
 classesZups[i]:=Izups;

 # compute the normalizer of 
 N:=Normalizer(G,I);
 ind:=Size(N)/Size(I);
 if Size(N)=Size(I) then # selfnormalizing
 normalizers[i]:=i;
 elif Size(N)=Size(G) then # normal
 normalizers[i]:=Length(classes);
 else
 normalizers[i]:=BlistList(zuppos,
 AttributeValueNotSet(AsList,N));
 fi;

 # compute the derived subgroup
 D:= AttributeValueNotSet( DerivedSubgroup, I );
 if Size(D) = Size(I) then # perfect
 derivedSubgroups[i]:=i;
 elif Size(D) = 1 then # abelian
 derivedSubgroups[i]:=1;
 else
 Delms:=AttributeValueNotSet(AsList,D);
 Dzups:=BlistList(zuppos,Delms);
 fi;

 # compute the right transversal (but don't store it)
 reps:=RightTransversalOp(G,N);

 # set up the marking list
 mrks :=ListWithIdenticalEntries(Length(classes),0);
 mrks[1]:=Length(reps) * ind;
 mrks[i]:=1 * ind;

 # loop over the conjugates of 
 for r in [1..Length(reps)] do

 # compute the zuppos blist of the conjugate
 if reps[r] = One(G) then
 Jzups:=Izups;
 else
 Jzups:=BlistList(zuppos,OnTuples(Ielms,reps[r]));
 if not IsBound(derivedSubgroups[i]) then
 Dzups:= BlistList(zuppos,OnTuples(Delms,reps[r]));
 fi;
 fi;

 #look if the conjugate of is the normalizer of a smaller
 #class
 for k in [2..i-1] do
 if normalizers[k]=Jzups then
 normalizers[k]:=i;
 fi;
 od;

 # look if it is the derived subgroup of G
 if IsBound(DGzups) and DGzups = Jzups then
 derivedSubgroups[Length(classes)]:=i;
 Unbind(DGzups);
 fi;

 # loop over all other (smaller classes)
 for k in [2..i-1] do
 Kzups:=classesZups[k];

 #test if the <K> is the derived subgroup of <J>
 if not IsBound(derivedSubgroups[i]) and Kzups = Dzups then
 derivedSubgroups[i]:=k;
 Unbind(Dzups);
 fi;

 # test if the <K> is a subgroup of <J>
 if IsSubsetBlist(Jzups,Kzups) then
 mrks[k]:=mrks[k] + ind;
 fi;

 od;

 od;

 # compress this line into the table of marks
 for k in [1..i] do
 if mrks[k] <> 0 then
 Add(subs[i],k);
 Add(marks[i],mrks[k]);
 fi;
 od;

 Unbind(Ielms);
 Unbind(Delms);
 Unbind(reps);
 Info( InfoLattice, 2,
 "testing class ",i,", size = ",Size(I),
 ", length = ",Size(G) / Size(N),", includes ",
 Length(marks[i])," classes");

 od;

 # Handle the whole group.
 Info( InfoLattice,2,"testing class ",Length(classes),", size = ",
 Size(G), ", length = ",1,", includes ",
 Length(marks[Length(classes)])," classes");
 subs[Length(classes)]:=[1..Length(classes)] + 0;
 marks[Length(classes)]:=ListWithIdenticalEntries(Length(classes),1);
 normalizers[Length(classes)]:=Length(classes);

 # Make the object.
 tom:= rec( SubsTom := subs,
 MarksTom := marks,
 NormalizersTom := normalizers,
 DerivedSubgroupsTomUnique := derivedSubgroups,
 UnderlyingGroup := G,
 GeneratorsSubgroupsTom := GeneratorsListTom( G, classes ) );
 ConvertToTableOfMarks( tom );
 if HasName( G ) then
 SetIdentifier( tom, Name( G ) );
 fi;

 return tom;
end );

InstallMethod( TableOfMarks,
 "for a group with lattice",
 [ IsGroup and HasLatticeSubgroups ], 10,
 TableOfMarksByLattice );

InstallMethod( TableOfMarks,
 "for solvable groups (call `LatticeSubgroups' and use the lattice)",
 [ IsSolvableGroup ],
 TableOfMarksByLattice );

InstallMethod( TableOfMarks,
 "cyclic extension method",
 [ IsGroup ],
 function( G )
 local factors, # factorization of <G>'s size
 zuppos, # generators of prime power order
 ll,
 zupposPrime, # corresponding prime
 zupposPower, # index of power of generator
 nrClasses, # number of classes
 classesZups, # zuppos blist of classes
 classesExts, # extend-by blist of classes
 perfect, # classes of perfect subgroups of <G>
 perfectNew, # this class of perfect subgroups is new
 perfectZups, # zuppos blist of perfect subgroups
 layerb, # begin of previous layer
 layere, # end of previous layer
 H, # representative of a class
 Hzups, # zuppos blist of <H>
 Hexts, # extend blist of <H>
 I, # new subgroup found
 Ielms, # elements of 
 Izups, # zuppos blist of 
 N, # normalizer of 
 Nzups, # zuppos blist of <N>
 Jzups, # zuppos of a conjugate of 
 Kzups, # zuppos of a representative in <classes>
 reps, # transversal of <N> in <G>
 h,i,k,l,r, # loop variables
 tom, # table of marks (result)
 marks, # components of the table of marks
 subs, #
 normalizers, #
 derivedSubgroups, #
 groups, #
 generators, #
 genszups, # mark the generators
 zupposmarks, # mark the zuppos used
 gr, pos, # used to computed generators for the perfect
 # subgroups
 mrks, # marks for one class
 ind, # index of in <N>
 D, # derived subgroup of ,
 Delms, # elements of <D>,
 Dzups, # zuppos blist of <D>
 DGzups, # zuppos blist of <DG>
 order, list, perm; # used to sort the table of marks

 # compute the factorized size of <G>
 factors:=Factors(Size(G));

 # compute a system of generators for the cyclic sgr. of prime power size
 zuppos:=Zuppos(G);
 ll:=Length(zuppos);

 Info(InfoLattice,1,"<G> has ",Length(zuppos)," zuppos");

 # compute the prime corresponding to each zuppo and the index of power
 zupposPrime:=[];
 zupposPower:=[];
 for r in zuppos do
 i:=SmallestRootInt(Order(r));
 Add(zupposPrime,i);
 k:=0;
 while k <> false do
 k:=k + 1;
 if GcdInt(i,k) = 1 then
 l:=Position(zuppos,r^(i*k));
 if l <> fail then
 Add(zupposPower,l);
 k:=false;
 fi;
 fi;
 od;
 od;
 Info(InfoLattice,1,"powers computed");

 # get the perfect subgroups
 perfect:=RepresentativesPerfectSubgroups(G);
 perfect:=Filtered(perfect,i->Size(i)>1 and Size(i)<Size(G));

 perfectZups:=[];
 perfectNew :=[];
 for i in [1..Length(perfect)] do
 I:=perfect[i];
 perfectZups[i]:=BlistList(zuppos,AttributeValueNotSet(AsList,I));
 perfectNew[i]:=true;
 od;
 Info(InfoLattice,1,"<G> has ",Length(perfect),
 " representatives of perfect subgroups");

 # initialize the classes list
 nrClasses:=1;
 classesZups:=[BlistList(zuppos,[One(G)])];
 classesExts:=[DifferenceBlist(BlistList(zuppos,zuppos),classesZups[1])];
 zupposmarks:=ListWithIdenticalEntries(Length(zuppos),false);
 layere:=1;
 layerb:=1;

 # initialize the table of marks
 Info(InfoLattice,1,"computing table of marks");
 subs:=[[1]];
 marks:=[[Size(G)]];
 normalizers:=[fail];
 derivedSubgroups:=[1];
 genszups:=[[]];

 I:= DerivedSubgroup( G );
 if Size( I ) = Size( G ) then # G perfect
 DGzups:=fail;
 elif Size(I) = 1 then # G abelian
 DGzups:=1;
 else
 DGzups:=BlistList(zuppos,AsList(I));
 fi;
 Unbind(I);

 # loop over the layers of group (except the group itself)
 for l in [1..Length(factors)-1] do
 Info(InfoLattice,1,"doing layer ",l,",",
 "previous layer has ",layere-layerb+1," classes");

 # extend representatives of the classes of the previous layer
 for h in [layerb..layere] do

 # get the representative,its zuppos blist and extend-by blist
 H:=Subgroup( Parent(G), zuppos{genszups[h]});
 Hzups:=classesZups[h];
 Hexts:=classesExts[h];

 Info(InfoLattice,2,"extending subgroup ",h,", size = ",Size(H));

 # loop over the zuppos whose -th power lies in <H>
 for i in [1..Length(zuppos)] do
 if Hexts[i] and Hzups[zupposPower[i]] then

 # make the new subgroup 
 I:=SubgroupNC(Parent(G),Concatenation(GeneratorsOfGroup(H),
 [zuppos[i]]));

 SetSize(I,Size(H) * zupposPrime[i]);

 # compute the zuppos blist of 
 Ielms:=AttributeValueNotSet(AsList,I);
 Izups:=BlistList(zuppos,Ielms);

 # compute the normalizer of 
 N:= Normalizer(G,I);
 ind:=Size(N) / Size(I);
 Info( InfoLattice, 2,
 "found new class ", nrClasses + 1,
 ", size = ", Size(I),
 ", length = ", Size(G) / Size(N) );

 # make the new conjugacy class
 nrClasses:=nrClasses + 1;
 if l < Length(factors) -1 then
 classesZups[nrClasses]:=Izups;
 fi;
 subs[nrClasses]:=[];
 marks[nrClasses]:=[];
 genszups[nrClasses]:=ShallowCopy(genszups[h]);
 Add(genszups[nrClasses],i);
 zupposmarks[i]:=true;

 #store the extend by blist and initialize the normalizer
 if Size(N)=Size(I) then # selfnormalizing
 normalizers[nrClasses]:=nrClasses;
 if l < Length(factors)-1 then
 classesExts[nrClasses]:=
 ListWithIdenticalEntries(ll,false);
 fi;
 elif Size(N)=Size(G) then # normal
 normalizers[nrClasses]:=fail;
 if l < Length(factors) -1 then
 classesExts[nrClasses]:=
 DifferenceBlist(BlistList([1..ll],[1..ll]), Izups);
 fi;
 else
 Nzups:=BlistList(zuppos,AttributeValueNotSet(AsList,N));
 normalizers[nrClasses]:=ShallowCopy(Nzups);
 if l < Length(factors) -1 then
 SubtractBlist(Nzups,Izups);
 classesExts[nrClasses]:=Nzups;
 fi;
 fi;
 Unbind( Nzups);

 # compute the derived subgroup
 D:= AttributeValueNotSet( DerivedSubgroup, I );
 if Size(D) = Size(I) then # perfect
 derivedSubgroups[nrClasses]:=nrClasses;
 elif Size(D) = 1 then # abelian
 derivedSubgroups[nrClasses]:=1;
 else
 Delms:=AttributeValueNotSet(AsList,D);
 Dzups:=BlistList(zuppos,Delms);
 fi;
 Unbind(D);

 # compute the transversal
 reps:=RightTransversalOp(G,N);

 # set up the marking list
 mrks:=ListWithIdenticalEntries(nrClasses,0);
 mrks[nrClasses]:=1 * ind;

 # loop over the conjugates of 
 for r in reps do

 # compute the zuppos blist of the conjugate
 if r = One(G) then
 Jzups:=Izups;
 else
 Jzups:=BlistList(zuppos,OnTuples(Ielms,r));
 if not IsBound(derivedSubgroups[nrClasses]) then
 Dzups:=BlistList(zuppos,OnTuples(Delms,r));
 fi;
 fi;

 # look if the conjugate of is the normalizer of
 # a smaller class
 for k in [2..layere] do
 if normalizers[k]=Jzups then
 normalizers[k]:=nrClasses;
 fi;
 od;

 # look if it is the derived subgroup of G
 if IsList(DGzups) and DGzups = Jzups then
 DGzups:=nrClasses;
 fi;

 # loop over the already found classes
 for k in [1..layere] do
 Kzups:=classesZups[k];

 #test if the <K> is the derived subgroup of <J>
 if not IsBound(derivedSubgroups[nrClasses]) and
 Kzups = Dzups then
 derivedSubgroups[nrClasses]:=k;
 Unbind(Dzups);
 Unbind(Delms);
 fi;

 # test if the <K> is a subgroup of <J>
 if IsSubsetBlist(Jzups,Kzups) then
 mrks[k]:=mrks[k] + ind;
 # don't extend <K> by the elements of <J>
 if k >= h then
 SubtractBlist(classesExts[k],Jzups);
 fi;
 fi;

 od;#for k in [2..layere]

 od;#for r in reps

 # compress this line into the table of marks
 for k in [1..nrClasses] do
 if mrks[k] <> 0 then
 Add(subs[nrClasses],k);
 Add(marks[nrClasses],mrks[k]);
 fi;
 od;
 Info(InfoLattice,2,"testing class ",nrClasses,
 " size = ", Size(I),
 ", length = ",Size(G) / Size(N),", includes ",
 Length(marks[nrClasses])," classes");

 # now we are done with the new class
 Unbind(Ielms);
 Unbind(reps);
 Unbind(I);
 Unbind(N);
 Info(InfoLattice,2,"tested inclusions");

 fi; # if Hexts[i] and Hzups[zupposPower[i]] then ...
 od; # for i in [1..Length(zuppos)] do ...

 #remove the stuff we don't need anymore
 classesExts[h]:=false;
 Unbind(H);
 od; # for h in [layerb..layere] do ...

 # add the classes of perfect subgroups
 for i in [1..Length(perfect)] do
 if perfectNew[i]
 and IsPerfectGroup(perfect[i])
 and Length(Factors(Size(perfect[i]))) = l
 then

 # make the new subgroup 
 I:=perfect[i];

 # compute the zuppos blist of 
 Ielms:=AttributeValueNotSet(AsList,I);
 Izups:=BlistList(zuppos,Ielms);

 # compute the normalizer of 
 N:= Normalizer(G,I);
 ind:=Size(N) / Size(I);

 Info(InfoLattice,2,"found new class ",nrClasses+1,
 ", size = ",Size(I),
 " length = ",Size(G) / Size(N));

 # make the new conjugacy class
 nrClasses:=nrClasses + 1;
 if l < Length(factors) -1 then
 classesZups[nrClasses]:=Izups;
 fi;
 subs[nrClasses]:=[];
 marks[nrClasses]:=[];
 gr:=TrivialSubgroup(G);
 genszups[nrClasses]:=[];
 k:=0;
 while Size(gr) <> Size(I) do
 k:=k+1;
 if Izups[k] and not zuppos[k] in gr then
 gr:=ClosureGroup(gr,zuppos[k]);
 Add(genszups[nrClasses],k);
 zupposmarks[k]:=true;
 fi;
 od;

 #store the extend by blist and initialize the normalizer
 if Size(N)=Size(I) then # selfnormalizing
 normalizers[nrClasses]:=nrClasses;
 if l < Length(factors)-1 then
 classesExts[nrClasses]:=
 ListWithIdenticalEntries(ll,false);
 fi;
 elif Size(N)=Size(G) then # normal
 normalizers[nrClasses]:=fail;
 if l < Length(factors) -1 then
 classesExts[nrClasses]:=
 DifferenceBlist(BlistList([1..ll],[1..ll]),Izups);
 fi;
 else
 Nzups:=BlistList(zuppos,AttributeValueNotSet(AsList,N));
 normalizers[nrClasses]:=ShallowCopy(Nzups);
 if l < Length(factors) -1 then
 SubtractBlist(Nzups,Izups);
 classesExts[nrClasses]:=Nzups;
 fi;
 fi;

 # compute the derived subgroup
 derivedSubgroups[nrClasses]:=nrClasses;

 # compute the transversal
 reps:=RightTransversalOp(G,N);

 # set up the marking list
 mrks:=ListWithIdenticalEntries(nrClasses,0);
 mrks[1]:=Length(reps) * ind;
 mrks[nrClasses]:=1 * ind;

 # loop over the conjugates of 
 for r in reps do

 # compute the zuppos blist of the conjugate
 if r = One(G) then
 Jzups:=Izups;
 else
 Jzups:=BlistList(zuppos,OnTuples(Ielms,r));
 fi;

 #look if the conjugate of is the normalizer of a
 #smaller class
 for k in [2..layere] do
 if normalizers[k]=Jzups then
 normalizers[k]:=nrClasses;
 fi;
 od;

 # look if it is the derived subgroup of G
 if IsList(DGzups) and DGzups = Jzups then
 DGzups:=nrClasses;
 fi;

 # loop over the perfect classes
 for k in [i+1..Length(perfect)] do
 Kzups:=perfectZups[k];

 # throw away classes that appear twice in perfect
 if Jzups = Kzups then
 perfectNew[k]:=false;
 perfectZups[k]:=[];
 fi;

 od;

 # loop over all other (smaller) classes
 for k in [2..layere] do
 Kzups:=classesZups[k];

 # test if the <K> is a subgroup of <J>
 if IsSubsetBlist(Jzups,Kzups) then
 mrks[k]:=mrks[k] + ind;
 fi;

 od;
 od;

 # compress this line into the table of marks
 for k in [1..nrClasses] do
 if mrks[k] <> 0 then
 Add(subs[nrClasses],k);
 Add(marks[nrClasses],mrks[k]);
 fi;
 od;

 Info(InfoLattice,2,"testing class ",nrClasses,", size = ",
 Size(I),
 ", length = ",Size(G) / Size(N),", includes ",
 Length(marks[nrClasses])," classes");

 # now we are done with the new class
 Unbind(Ielms);
 Unbind(reps);
 Unbind(I);
 Info(InfoLattice,2,"tested equalities");

 # unbind the stuff we dont need any more
 perfectZups[i]:=[];
 fi;
 # if IsPerfectGroup(I) and Length(Factors(Size(I))) = layer ...
 od; # for i in [1..Length(perfect)] do

 # on to the next layer
 layerb:=layere+1;
 layere:=nrClasses;
 od; # for l in [1..Length(factors)-1] do ...
 Unbind(classesZups);

 # add the whole group to the list of classes
 Info(InfoLattice,1,"doing layer ",Length(factors),",",
 " previous layer has ",layere-layerb+1," classes");
 if Size(G)>1 then
 Info(InfoLattice,2,"found whole group, size = ",Size(G),",",
 "length = 1");
 nrClasses:=nrClasses + 1;
 subs[nrClasses]:=[1..nrClasses] + 0;
 marks[nrClasses]:=ListWithIdenticalEntries(nrClasses,1);
 if DGzups = fail then
 derivedSubgroups[nrClasses]:=nrClasses;
 else
 derivedSubgroups[nrClasses]:=DGzups;
 fi;
 normalizers[nrClasses]:=nrClasses;
 Info(InfoLattice,2,"testing class ",nrClasses,", size = ",
 Size(G), ", length = ",1,", includes ",
 Length(marks[nrClasses])," classes");
 fi;

 # set the normalizer for normal subgroups
 for i in [1..nrClasses-1] do
 if normalizers[i] = fail then
 normalizers[i]:=nrClasses;
 fi;
 od;

 #Sort the table of marks
 order:=List(marks,x->Size(G)/x[1]);
 list:=[1..nrClasses];
 Sort(list, function(a,b) return order[a] < order[b] or(order[a] =
 order[b] and order[normalizers[b]] <order[normalizers[a]]); end);

 perm:=Sortex(list)^-1;
 derivedSubgroups:=List(derivedSubgroups,x->x^perm);
 derivedSubgroups:=Permuted(derivedSubgroups, perm);
 normalizers:=List(normalizers, x-> x^perm);
 normalizers:=Permuted(normalizers, perm);
 subs:=List(subs,x-> List(x, y-> y^perm));
 subs:=Permuted(subs,perm);
 marks:=Permuted(marks, perm);
 for i in [1..Length(marks)] do
 SortParallel(subs[i], marks[i]);
 od;
 genszups:=Permuted(genszups, perm);

 # compute generators for each subgroup
 k:=1;
 pos:=[];
 for i in [1..Length(zuppos)] do
 if zupposmarks[i] then
 zupposmarks[i]:=k;
 k:=k+1;
 Add(pos,i);
 fi;
 od;
 generators:=Concatenation(zuppos{pos},GeneratorsOfGroup(G));
 groups:=[];
 for i in [1..nrClasses-1] do
 groups[i]:=zupposmarks{genszups[i]};
 od;
 groups[nrClasses]:=[k..k+Length(GeneratorsOfGroup(G))-1 ];

 # Make the object.
 tom:= rec( SubsTom := subs,
 MarksTom := marks,
 NormalizersTom := normalizers,
 DerivedSubgroupsTomUnique := derivedSubgroups,
 UnderlyingGroup := G,
 GeneratorsSubgroupsTom := [ generators, groups ] );
 ConvertToTableOfMarks( tom );
 if HasName( G ) then
 SetIdentifier( tom, Name( G ) );
 fi;

 return tom;
end );

#############################################################################
##
#M TableOfMarks( <mat> ) . . . . . . . . table of marks defined by a matrix
##
InstallMethod( TableOfMarks,
 "for a matrix or a lower triangular matrix",
 [ IsTable ],
 function( mat )
 local i, j, val, subs, marks, tom;

 # Check the argument.
 if not ( ForAll( mat, IsHomogeneousList )
 and ForAll( [ 1 .. Length( mat ) ],
 i -> Length( mat[i] ) >= i ) ) then
 TryNextMethod();
 fi;

 # Setup `SubsTom' and `MarksTom' values.
 subs:= [];
 marks:= [];
 for i in [ 1 .. Length( mat ) ] do

 if mat[i][1] <= 0 then
 Info( InfoTom, 1, "first column must have positive entries" );
 return fail;
 elif mat[i][i] = 0 then
 Info( InfoTom, 1, "diagonal entries must be nonzero" );
 return fail;
 fi;
 for j in [ i+1 .. Length( mat[i] ) ] do
 if mat[i][j] <> 0 then
 Info( InfoTom, 1, "the matrix must be lower triangular" );
 return fail;
 fi;
 od;

 subs[i]:= [];
 marks[i]:= [];

 for j in [ 1 .. i ] do
 val:= mat[i][j];
 if val < 0 then
 Info( InfoTom, 1, "all entries must be nonnegative integers" );
 return fail;
 elif 0 < val then
 Add( subs[i], j );
 Add( marks[i], mat[i][j] );
 fi;
 od;

 od;

 # Make the object.
 tom:= rec( SubsTom := subs,
 MarksTom := marks );
 ConvertToTableOfMarks( tom );

 # Test it.
 if not IsInternallyConsistent( tom ) then
 return fail;
 fi;

 # Return it.
 return tom;
 end );

#############################################################################
##
#F TableOfMarksFromLibrary( <name> )
##
## The `TableOfMarks' method for a string calls `TableOfMarksFromLibrary'.
## If the library of tables of marks is not available then we bind this
## to a dummy function that signals an error.
##
if not IsBoundGlobal( "TableOfMarksFromLibrary" ) then
 BindGlobal( "TableOfMarksFromLibrary", function( arg )
 Error( "sorry, the GAP Tables Of Marks Library is not installed" );
 end );
fi;

#############################################################################
##
#M TableOfMarks( <name> ) . . . . . . . . . . library table with given name
##
InstallMethod( TableOfMarks,
 "for a string (dispatch to `TableOfMarksFromLibrary')",
 [ IsString ],
 str -> TableOfMarksFromLibrary( str ) );

#############################################################################
##
#M LatticeSubroups( <G> )
##
## method for a group with table of marks
## method for a cyclic group
##
## LatticeSubgroupsByTom( <G> )
##
InstallGlobalFunction( LatticeSubgroupsByTom, function( G )
 local marks, i, lattice, classes, tom;

 # Get the classes.
 tom:= TableOfMarks( G );
 classes:= List( [1..Length(OrdersTom( tom))], x-> ConjugacyClassSubgroups
 (G, RepresentativeTom( tom, x)));

 marks:=MarksTom(tom);
 for i in [1..Length(classes)] do
 SetSize(classes[i],marks[i][1]/Last(marks[i]));
 od;

 # Create the lattice.
 lattice:=Objectify(NewType(FamilyObj(classes),IsLatticeSubgroupsRep),
 rec());
 lattice!.conjugacyClassesSubgroups:=classes;
 lattice!.group :=G;

 # Return the lattice.
 return lattice;
 end );

InstallMethod( LatticeSubgroups,
 "for a group with table of marks",
 [ IsGroup and HasTableOfMarks ], 10,
 LatticeSubgroupsByTom );

InstallMethod( LatticeSubgroups,
 "for a cyclic group",
 [ IsGroup and IsCyclic ],
 LatticeSubgroupsByTom );

#############################################################################
##
## 5. Printing Tables of Marks
##

#############################################################################
##
#M ViewObj( <tom> ) . . . . . . . . . . . . . . . . . print a table of marks
##
InstallMethod( ViewObj,
 [ IsTableOfMarks ],
 function( tom )
 Print( "TableOfMarks( " );
 if HasIdentifier( tom ) then
 Print( "\"", Identifier( tom ), "\"" );
 elif HasUnderlyingGroup( tom ) then
 ViewObj( UnderlyingGroup( tom ) );
 elif HasMarksTom( tom ) then
 Print( "<", Length( MarksTom( tom ) ), " classes>" );
 else
 Print( "<nothing useful known>" );
 fi;
 Print( " )" );
 end );

#############################################################################
##
#M PrintObj( <tom> )
##
InstallMethod( PrintObj,
 [ IsTableOfMarks ],
 function( tom )
 Print( "TableOfMarks( " );
 if HasIdentifier( tom ) then
 Print( "\"", Identifier( tom ), "\"" );
 elif HasUnderlyingGroup( tom ) then
 PrintObj( UnderlyingGroup( tom ) );
 elif HasMarksTom( tom ) then
 Print( "<", Length( MarksTom( tom ) ), " classes>" );
 else
 Print( "<nothing useful known>" );
 fi;
 Print( " )" );
 end );

#############################################################################
##
#M Display( <tom>[, <options>] ) . . . . . . . . . display a table of marks
##
InstallMethod( Display,
 "for a table of marks (add empty options record)",
 [ IsTableOfMarks ],
 function( tom )
 Display( tom, rec() );
 end );

InstallOtherMethod( Display,
 "for a table of marks and an options record",
 [ IsTableOfMarks, IsRecord ],
 function( tom, options )
 local i, j, k, l, pr1, ll, lk, von, bis, pos, llength, pr, vals, subs,
 classes, lc, ci, wt;

 # default values.
 subs:= SubsTom(tom);
 ll:= Length(subs);
 classes:= [1..ll];
 vals:= MarksTom(tom);

 # adjust parameters.
 if IsBound(options.classes) and IsList(options.classes) then
 classes:= options.classes;
 fi;
 if IsBound(options.form) then
 if options.form = "supergroups" then
 vals:= ShallowCopy(vals);
 wt:= WeightsTom(tom);
 for i in [1..ll] do
 vals[i]:= vals[i]/wt[i];
 od;
 elif options.form = "subgroups" then
 vals:= NrSubsTom(tom);
 fi;
 fi;

 llength:= SizeScreen()[1];
 von:= 1;
 pr1:= LogInt(ll, 10);

 # determine column width.
 pr:= List([1..ll], x->0);
 for i in [1..ll] do
 for j in [1..Length(subs[i])] do
 pr[subs[i][j]]:= Maximum(pr[subs[i][j]], LogInt(vals[i][j], 10));
 od;
 od;

 lc:= Length(classes);
 while von <= lc do
 bis:= von;

 # how many columns on this page?
 lk:= pr1 + 5 + pr[classes[von]];
 while bis < lc and lk+2+pr[classes[bis+1]] <= llength do
 bis:= bis+1;
 lk:= lk+2+pr[classes[bis]];
 od;

 # loop over rows.
 for i in [von..lc] do
 ci:= classes[i];
 for k in [1 .. pr1-LogInt(ci, 10)] do
 Print(" ");
 od;
 Print(ci, ": ");

 # loop over columns.
 for j in [von .. Minimum(i, bis)] do
 pos:= Position(subs[ci], classes[j]);
 if pos <> fail and pos > 0 then
 l:= LogInt(vals[ci][pos], 10)-1;
 else
 l:= -1;
 fi;
 for k in [1 .. pr[classes[j]] - l] do
 Print(" ");
 od;
 if pos = fail then
 Print(".\c");
 else
 Print(vals[ci][pos], "\c");
 fi;
 od;
 Print("\n");
 od;

 von:= bis+1;
 Print("\n");
 od;
 end );

#############################################################################
##
## 6. Sorting Tables of Marks
##

#############################################################################
##
#M SortedTom( <tom>, <perm> ) . . . . . . . . . . . . sorted table of marks
##
InstallMethod( SortedTom,
 [ IsTableOfMarks, IsPerm ],
 function( tom, perm )
 local i, components;

 components:= rec();

 if HasIdentifier( tom ) then
 components.Identifier:= Identifier( tom );
 fi;
 components.SubsTom:= Permuted( List( SubsTom( tom ),
 x -> ShallowCopy( OnTuples( x, perm ) ) ),
 perm);
 components.MarksTom:= Permuted( List( MarksTom( tom ), ShallowCopy ),
 perm );
 for i in [ 1 .. Length( components.SubsTom ) ] do
 SortParallel( components.SubsTom[i], components.MarksTom[i] );
 od;
 if HasNormalizersTom( tom ) then
 components.NormalizersTom:=
 Permuted( OnTuples( NormalizersTom( tom ), perm ), perm );
 fi;
 if HasDerivedSubgroupsTomUnique( tom ) then
 components.DerivedSubgroupsTomUnique:=
 Permuted( OnTuples( DerivedSubgroupsTomUnique( tom ), perm ),
 perm );
 fi;
 if HasUnderlyingGroup( tom ) then
 components.UnderlyingGroup:= UnderlyingGroup( tom );
 fi;
 if HasStraightLineProgramsTom( tom ) then
 components.StraightLineProgramsTom:=
 Permuted( StraightLineProgramsTom( tom ), perm );
 fi;
 if HasGeneratorsSubgroupsTom(tom) then
 components.GeneratorsSubgroupsTom:=
 [ GeneratorsSubgroupsTom( tom )[1],
 Permuted( GeneratorsSubgroupsTom( tom )[2], perm ) ];
 fi;

 ConvertToTableOfMarks( components );

 if HasPermutationTom( tom ) then
 SetPermutationTom( components, PermutationTom( tom ) * perm );
 else
 SetPermutationTom( components, perm );
 fi;

 return components;
 end );

#############################################################################
##
## 7. Technical Details about Tables of Marks
##

#############################################################################
##
#F ConvertToTableOfMarks( <record> )
##
InstallGlobalFunction( ConvertToTableOfMarks, function( record )
 local i, names;
 names:= RecNames( record );

 # Make the object.
 Objectify( NewType( TableOfMarksFamily,
 IsTableOfMarks and IsAttributeStoringRep ),
 record );

 # Set the attributes values.
 for i in [ 1, 3 .. Length( TableOfMarksComponents )-1 ] do
 if TableOfMarksComponents[i] in names then
 Setter( TableOfMarksComponents[i+1] )( record,
 record!.( TableOfMarksComponents[i] ) );
 fi;
 od;

 return record;
 end );

#############################################################################
##
## 8. Attributes of Tables of Marks
##

#############################################################################
##
#M MarksTom( <tom> ) . . . . . . . . . . . . . . . . . . . . . . . the marks
##
InstallMethod( MarksTom,
 "for a table of marks with known `NrSubsTom' and `OrdersTom'",
 [ IsTableOfMarks and HasNrSubsTom and HasOrdersTom ],
 function( tom )
 local i, j, ll, order, length, nrSubs, subs, marks, ord;

 # get the attributes and initialize
 order:=OrdersTom(tom);
 subs:=SubsTom(tom);
 length:=LengthsTom(tom);
 nrSubs:=NrSubsTom(tom);
 ll:=Length(order);
 ord:=order[ll];
 marks:=[[ord]];

 # Compute the marks.
 for i in [ 2 .. ll ] do
 marks[i]:= [ ord / order[i] ];
 for j in [ 2 .. Length( subs[i] ) ] do
 marks[i][j]:= nrSubs[i][j] * marks[i][1] / length[ subs[i][j] ];
 if not IsInt( marks[i][j] ) or marks[i][j] < 0 then
 Info( InfoTom, 1,
 "orbit length ", i, ", ", j, ": ", marks[i][j] );
 fi;
 od;
 od;

 return marks;
 end );

#############################################################################
##
#M NrSubsTom( <tom> ) . . . . . . . . . . . . . . . . . numbers of subgroups
##
InstallMethod( NrSubsTom,
 "for a table of marks",
 [ IsTableOfMarks ],
 function( tom )
 local i, j, nrSubs, subs, marks, length, index;

 # initialize
 length:= [];
 nrSubs:= [];
 subs:= SubsTom( tom );
 marks:= MarksTom( tom );

 # compute the numbers row by row
 for i in [ 1 .. Length( subs ) ] do
 index:= marks[i][Position(subs[i], 1)];
 length[i]:= index / marks[i][Position(subs[i], i)];
 nrSubs[i]:= [];

 for j in [1..Length(subs[i])] do
 nrSubs[i][j]:= marks[i][j] * length[subs[i][j]] / index;
 if not IsInt( nrSubs[i][j] ) or nrSubs[i][j] < 0 then
 Info( InfoTom, 1,
 "orbit length ", i, ", ", j, ": ", nrSubs[i][j] );
 fi;
 od;

 od;

 return nrSubs;
 end );

#############################################################################
##
#M OrdersTom( <tom> ) . . . . . . . . . . . . . . . . . orders of subgroups
##
InstallMethod( OrdersTom,
 "for a table of marks",
 [ IsTableOfMarks ],
 function( tom )
 local subs, marks;
 subs:= SubsTom( tom );
 marks:= MarksTom( tom );
 return List( [ 1 .. Length( subs ) ],
 i -> marks[1][1] / marks[i][ Position( subs[i], 1 ) ] );
 end );

#############################################################################
##
#M LengthsTom( <tom> ) . . . . . . . . . . length of the conjugacy classes
##
InstallMethod( LengthsTom,
 "for a table of marks",
 [ IsTableOfMarks ],
 function( tom )
 local nrSubs;
 nrSubs:= NrSubsTom( tom );
 return Last(nrSubs);
 end );

#############################################################################
##
#M ClassTypesTom( <tom> ) . . . . . . . . . . . . . . . types of subgroups
##
InstallMethod( ClassTypesTom,
 "for a table of marks",
 [ IsTableOfMarks ],
 function( tom )
 local i, j, nrsubs, subs, order, type, struct, nrtypes;

 nrsubs:= NrSubsTom(tom);
 subs:= SubsTom(tom);
 order:=OrdersTom(tom);
 type:= [];
 struct:= [];
 nrtypes:= 1;

 for i in [1..Length(subs)] do

 # determine type
 # classify according to the number of subgroups
 struct[i]:= [];
 for j in [2..Length(subs[i])-1] do
 if IsBound(struct[i][type[subs[i][j]]]) then
 struct[i][type[subs[i][j]]]:=
 struct[i][type[subs[i][j]]] + nrsubs[i][j];
 else
 struct[i][type[subs[i][j]]]:= nrsubs[i][j];
 fi;
 od;

 # consider the order
 for j in [1..i-1] do
 if order[j] = order[i] and struct[j] = struct[i] then
 type[i]:= type[j];
 fi;
 od;

 if not IsBound(type[i]) then
 type[i]:= nrtypes;
 nrtypes:= nrtypes+1;
 fi;
 od;

 return type;
 end );

#############################################################################
##
#F ClassNamesTom( <tom> ) . . . . . . . . . . . . . . . . . . . class names
##
InstallMethod( ClassNamesTom,
 "for a table of marks",
 [ IsTableOfMarks ],
 function( tom )
 local i, c, classes, type, name, count, ord, alp, la;

 type:= ClassTypesTom(tom);

 # form classes.
 classes:= List([1..Maximum(type)], x-> rec(elts:= []));
 for i in [1..Length(type)] do
 Add(classes[type[i]].elts, i);
 od;

 # determine type.
 count:= rec();
 for i in [1..Length(classes)] do
 ord:= String(OrdersTom(tom)[classes[i].elts[1]]);
 if IsBound(count.(ord)) then
 count.(ord).nr:= count.(ord).nr + 1;
 if count.(ord).nr < 10 then
 classes[i].type:=
 Concatenation("_", String(count.(ord).nr));
 else
 classes[i].type:=
 Concatenation("_{", String(count.(ord).nr), "}");
 fi;
 else
 count.(ord):= rec(first:= classes[i], nr:= 1);
 classes[i].type:= "_1";
 fi;

 # cyclic?
 if Set(NrSubsTom(tom)[classes[i].elts[1]]) = [1]
 and IsCyclicTom(tom, classes[i].elts[1]) then
 classes[i].order:= ord;
 classes[i].type:= "";
 else
 classes[i].order:= Concatenation("(", ord, ")");
 fi;

 od;

 # omit unique types.
 for i in RecNames(count) do
 if count.(i).nr = 1 then
 count.(i).first.type:= "";
 fi;
 od;

 # construct names.
 name:= [];
 alp:= ["a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m",
 "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z"];
 la:= Length(alp);
 for c in classes do
 if Length(c.elts) = 1 then
 name[c.elts[1]]:= Concatenation(c.order, c.type);
 else
 for i in [1..Length(c.elts)] do
 if i <= la then
 name[c.elts[i]]:= Concatenation(c.order,c.type,alp[i]);
 elif i <= la * (la+1) then
 name[c.elts[i]]:= Concatenation(c.order, c.type,
 alp[QuoInt(i-1, la)], alp[((i-1) mod la) +1]);

 else
 Error("did not expect more than ", la * (la+1),
 "classes of the same type");

 fi;
 od;
 fi;
 od;

 for c in name do
 ConvertToStringRep( c );
 od;

 return name;
 end );

#############################################################################
##
#M FusionsTom( <tom> )
##
InstallMethod( FusionsTom,
 "for a table of marks",
 [ IsTableOfMarks ],
 x -> [] );

#############################################################################
##
#M IdempotentsTom( <tom> ) . . . . . . . . . . . . . . . . . . . idempotents
##
InstallMethod( IdempotentsTom,
 "for a table of marks",
 [ IsTableOfMarks ],
 function( tom )
 local i, c, classes, p, ext, marks;

 marks:= MarksTom( tom );
 classes:= [ 1 .. Length( marks ) ];

 for p in PrimeDivisors( marks[1][1] ) do
 ext:= CyclicExtensionsTom( tom, p );
 for c in ext do
 for i in c do
 classes[i]:= classes[ c[1] ];
 od;
 od;
 od;

 for i in [ 1 .. Length( classes ) ] do
 classes[i]:= classes[ classes[i] ];
 od;

 return classes;
 end );

#############################################################################
##
#M IdempotentsTomInfo( <tom> ) . . . . . . . . . . . . . . . . . idempotents
##
InstallMethod( IdempotentsTomInfo,
 "for a table of marks",
 [ IsTableOfMarks ],
 function( tom )
 local ext, ll, result, class, idem;

 ext:= CyclicExtensionsTom( tom );
 ll:= Length( SubsTom( tom ) );
 result:= rec( primidems := [],
 fixpointvectors := [] );

 for class in ext do

 idem:= ListWithIdenticalEntries( ll, 0 );
 idem{ class }:= List( class, x -> 1 );
 Add( result.fixpointvectors, idem );
 Add( result.primidems, DecomposedFixedPointVector( tom, idem ) );

 od;

 return result;
 end );

#############################################################################
##
#M MatTom( <tom> ) . . . . . . convert compressed table of marks into matrix
##
InstallMethod( MatTom,
 "for a table of marks",
 [ IsTableOfMarks ],
 function( tom )
 local i, j, subs, marks, ll, res;

 marks:= MarksTom( tom );
 subs:= SubsTom( tom );
 ll:= [ 1 .. Length( subs ) ];

 res:= [];
 for i in ll do
 res[i]:= ListWithIdenticalEntries( Length( ll ), 0 );
 for j in [ 1 .. Length( subs[i] ) ] do
 res[i][ subs[i][j] ]:= marks[i][j];
 od;
 od;

 return res;
 end );

#############################################################################
##
#M MoebiusTom( <tom> ) . . . . . . . . . . . . . . . . . . Moebius function
##
InstallMethod( MoebiusTom,
 "for a table of marks",
 [ IsTableOfMarks ],
 function( tom )
 local i, j, mline, nline, ll, mdec, ndec, expec, done, no, comsec,
 order, subs, nrsubs, length, der, result;

 nrsubs:= NrSubsTom(tom);
 subs:= SubsTom(tom);
 length:= LengthsTom(tom);
 order:=OrdersTom(tom);
 mline:= List(subs, x-> 0);
 nline:= List(subs, x-> 0);
 ll:= Length( subs );
 mline[ll]:= 1;
 nline[ll]:= 1;

 # decompose mline with tom
 # decompose nline w.r.t. incidence
 mdec:= [];
 done:= false;
 i:= Length(mline);
 while not done do
 while i>0 and mline[i] = 0 do
 i:= i-1;
 od;
 if i = 0 then
 done:= true;
 else
 mdec[i]:= mline[i];
 for j in [1..Length(subs[i])] do
 mline[subs[i][j]]:= mline[subs[i][j]] - mdec[i]*nrsubs[i][j];
 od;
 mdec[i]:= mdec[i] / length[i];
 fi;
 od;

 ndec:= [];
 done:= false;
 i:= Length(nline);
 while not done do
 while i>0 and nline[i] = 0 do
 i:= i-1;
 od;
 if i = 0 then
 done:= true;
 else
 ndec[i]:= nline[i];
 for j in subs[i] do
 nline[j]:= nline[j] - ndec[i];
 od;
 fi;
 od;

 result:= rec( mu := mdec,
 nu := ndec );

 # Determine intersections with the derived subgroup of the whole group
 # if this can be uniquely determined.
 der:= DerivedSubgroupTom( tom, ll );
 if IsInt( der ) then

 expec:= [];
 if der <> ll then
 comsec:= [];
 for i in [ 1 .. ll ] do

 # There is only one intersection with normal subgroups.
 comsec[i]:= Number( IntersectionsTom( tom, i, der ), x -> x <> 0 );

 od;
 for i in [ 1 .. Length( ndec ) ] do
 if IsBound( ndec[i] ) then
 no:= NormalizersTom( tom )[i];

 # maybe the normalizer is not unique.
 if IsList( no ) then
 no:= List( no, x -> order[ comsec[x] ] );
 no:= Set( no );
 if Size( no ) > 1 then
 Info( InfoTom, 2,
 "Size of normalizer ", i, " not unique." );
 else
 no:= no[1];
 fi;
 else
 no:= order[ comsec[ no ] ];
 fi;
 expec[i]:= ndec[i] * no / order[ comsec[i] ];
 fi;
 od;

 else

 # The group is perfect.
 for i in [ 1 .. Length( ndec ) ] do
 if IsBound( ndec[i] ) then
 expec[i]:= ndec[i] * order[ ll ] / order[i] / length[i];
 fi;
 od;

 fi;

 result.ex:= expec;
 result.hyp:= Filtered( [ 1 .. Length( expec ) ],
 function( x )
 if IsBound( expec[x] ) then
 return ( not IsBound( mdec[x] ) )
 or expec[x] <> mdec[x];
 else
 return IsBound( mdec[x] );
 fi;
 end );

 fi;

 return result;
 end );

#############################################################################
##
#M WeightsTom( <tom> ) . . . . . . . . . . . . . . . . . . . . . . . weights
##
InstallMethod( WeightsTom,
 "for a table of marks",
 [ IsTableOfMarks ],
 function( tom )
 local subs, marks;

 marks:= MarksTom(tom);
 subs:= SubsTom(tom);

 return List( [ 1 .. Length( subs ) ],
 i -> marks[i][ Position( subs[i], i ) ] );
 end );

#############################################################################
##
## 9. Properties of Tables of Marks
##

#############################################################################
##
#M IsAbelianTom( <tom>[, ] )
##
## If the group of <tom> is known then `IsAbelianTom' delegates the task
## to the group.
## Otherwise it is used that a group is abelian if and only if all subgroups
## are normal and the group contains no quaternion group of order $8$.
##
InstallMethod( IsAbelianTom,
 "for a table of marks",
 [ IsTableOfMarks ],
 function( tom )
 local marks, subs, nrSubs, order, result, sub, number, sub1;

 result:=true;
 marks:=MarksTom(tom);
 order:=OrdersTom(tom);
 subs:=SubsTom(tom);
 nrSubs:=NrSubsTom(tom);

 # All subgroups must be normal.
 for sub in [ 1 .. Length( order ) ] do
 if marks[ sub ][1] <> Last(marks[ sub ]) then
 return false;
 fi;
 od;

 # Test the subgroups of order $8$.
 for sub in [2..Length(order)] do
 if order[sub]=8 then
 #count the number of subgroups of sub
 number:=0;
 for sub1 in subs[sub] do
 number:=number+nrSubs[sub][Position(subs[sub],sub1)];
 od;
 #q8 is determined by its number of subgroups
 if number=6 then
 return false;
 fi;
 fi;
 od;

 return result;
 end );

InstallMethod( IsAbelianTom,
 "for a table of marks and a positive integer",
 [ IsTableOfMarks, IsPosInt ], 10,
 function( tom, sub )
 sub:= DerivedSubgroupTom( tom, sub );
 if IsInt( sub ) then
 return sub = 1;
 elif not 1 in sub then
 return false;
 else
 TryNextMethod();
 fi;
 end );

InstallMethod( IsAbelianTom,
 "for a table of marks with known der. subgroups, and a positive integer",
 [ IsTableOfMarks and HasDerivedSubgroupsTomUnique, IsPosInt ], 1000,
 function( tom, sub )
 return DerivedSubgroupsTomUnique( tom )[ sub ] = 1;
 end );

InstallMethod( IsAbelianTom,
 "for a table of marks with generators, and a positive integer",
 [ IsTableOfMarks and IsTableOfMarksWithGens, IsPosInt ],
 function( tom, sub )
 return IsAbelian( RepresentativeTom( tom, sub ) );
 end );

#############################################################################
##
#M IsCyclicTom( <tom>[, ] ) . . . . check whether a subgroup is cyclic
##
## A subgroup is cyclic if and only if the sum of the corresponding row of
## the inverse table of marks is nonzero (see Kerber, S. 125).
## Thus we only have to decompose the corresponding idempotent.
##
InstallMethod( IsCyclicTom,
 "for a table of marks",
 [ IsTableOfMarks ],
 tom -> IsCyclicTom( tom, Length( SubsTom( tom ) ) ) );

InstallMethod( IsCyclicTom,
 "for a table of marks and a positive integer",
 [ IsTableOfMarks, IsPosInt ],
 function( tom, sub )
 local mline;

 mline:= 0 * [ 1 .. sub ];
 mline[ sub ]:= 1;

 # Decompose mline w.r.t. tom, and determine whether the sum is nonzero.
 return Sum( DecomposedFixedPointVector( tom, mline ), 0 ) <> 0;
 end );

#############################################################################
##
#M IsNilpotentTom( <tom>[, ] )
##
InstallMethod( IsNilpotentTom,
 "for a table of marks",
 [ IsTableOfMarks ],
 tom -> IsNilpotentTom( tom, Length( SubsTom( tom ) ) ) );

InstallMethod( IsNilpotentTom,
 "for a table of marks and a positive integer",
 [ IsTableOfMarks, IsPosInt ],
 function( tom, sub )
 local factors, primes, exponents, i, pos;

 factors:=Factors(OrdersTom(tom)[sub]);
 factors:=Collected(factors);
 primes:=List(factors,x->x[1]);
 exponents:=List(factors,x->x[2]);
 for i in [1..Length(primes)] do
 pos:= Position( OrdersTom( tom ){ SubsTom( tom )[ sub ] },
 primes[i]^exponents[i] );
 if ContainedTom(tom,SubsTom(tom)[sub][pos],sub) > 1 then
 return false;
 fi;
 od;
 return true;
 end );

#############################################################################
##
#M IsPerfectTom( <tom>[, ] )
##
## A finite group is perfect if and only if it has no normal subgroup of
## prime index.
## This is tested here.
##
## If <tom> knows its underlying group the task is delegated to th group.
##
InstallMethod( IsPerfectTom,
 "for a table of marks",
 [ IsTableOfMarks ],
 tom -> IsPerfectTom( tom, Length( SubsTom( tom ) ) ) );

InstallMethod( IsPerfectTom,
 "for a table of marks with known der. subgroups, and a positive integer",
 [ IsTableOfMarks and HasDerivedSubgroupsTomUnique, IsPosInt ],
 function( tom, sub )
 return DerivedSubgroupsTomUnique( tom )[ sub ] = sub;
 end );

InstallMethod( IsPerfectTom,
 "for a table of marks and a positive integer",
 [ IsTableOfMarks, IsPosInt ],
 function( tom, sub )
 local ext, pos;
 ext:=CyclicExtensionsTom(tom);
 pos:=PositionProperty(ext,x-> sub in x);
 return sub = Minimum(ext[pos]);
 end );

#############################################################################
##
#M IsSolvableTom( <tom>[, ] )
##
InstallMethod( IsSolvableTom,
 "for a table of marks",
 [ IsTableOfMarks ],
 tom -> IsSolvableTom( tom, Length( SubsTom( tom ) ) ) );

InstallMethod( IsSolvableTom,
 "for a table of marks and a positive integer",
 [ IsTableOfMarks, IsPosInt ],
 function( tom, sub )
 local ext, pos;

 ext:= CyclicExtensionsTom( tom );
 pos:= PositionProperty( ext, x -> 1 in x );

 return sub in ext[ pos ];
 end );

#############################################################################
##
## 10. Other Operations for Tables of Marks
##

#############################################################################
##
#M IsInternallyConsistent( <tom> ) . . consistency check for table of marks
##
## The tensor product of two rows of the table of marks decomposes into
## rows of the table of marks with integer coefficients.
##
BindGlobal( "TestRow", function( tom, n )
 local i, j, k, a, b, dec, test, marks, subs;

 test:= true;
 marks:= MarksTom(tom);
 subs:= SubsTom(tom);

 a:= [];

 # decompress the nth line of <tom>
 for i in [1..Length(subs[n])] do
 a[subs[n][i]]:= marks[n][i];
 od;

 for i in Reversed([1..n]) do
 # build the tensor product with row 
 b:= [];
 for j in [1..Length(subs[i])] do
 k:= subs[i][j];
 if IsBound(a[k]) then
 b[k]:= a[k]*marks[i][j];
 fi;
 od;
 for j in [1..Length(b)] do
 if not IsBound(b[j]) then
 b[j]:= 0;
 fi;
 od;

 # deompose and test the tensor product
 dec:= DecomposedFixedPointVector(tom, b);
 if ForAny(Set(dec), x-> not IsInt(x) or (x < 0)) then
 Info(InfoTom,2, n, ".", i, " = ", dec);
 test:= false;
 fi;
 od;

 return test;
end );

InstallMethod( IsInternallyConsistent,
 "for a table of marks, decomposition test",
 [ IsTableOfMarks ],
 function( tom )
 local test, g, i;

 test:= true;

 # Check that the underlying group has the right order.
 if HasUnderlyingGroup( tom ) then
 g:= UnderlyingGroup( tom );
 if Size( g ) <> Size( Group( GeneratorsOfGroup( g ), One( g ) ) ) then
 return false;
 fi;
 fi;

 for i in [ 1 .. Length( SubsTom( tom ) ) ] do
 if not TestRow( tom, i ) then
 return false;
 fi;
 od;

 return test;
 end );

#############################################################################
##
#M DerivedSubgroupTom( <tom>, )
##
InstallMethod( DerivedSubgroupTom,
 "for a table of marks, and a positive integer",
 [ IsTableOfMarks, IsPosInt ],
 function( tom, sub )
 local set, primes, normalsubs, minindex, p, nrsubs, ext, pos, extp,
 extps, sub1, sub2, result, i, j, indexsub1, indexsub2, index, int,
 notnormal, res, factorel, norm, oddord,
 normext, bool, n, orders, subs, isnormal, grd, der, poss;

 # Check whether the derived subgroup has been computed already.
 if HasDerivedSubgroupsTomUnique( tom ) then
 return DerivedSubgroupsTomUnique( tom )[ sub ];
 fi;

 # Perhaps this is not the first time one has asked for this value.
 poss:= DerivedSubgroupsTomPossible( tom );
 if IsBound( poss[ sub ] ) then
 return poss[ sub ];
 fi;

 # First consider the trivial cases.
 if IsCyclicTom( tom, sub ) then
 result:= 1;
 elif IsPerfectTom( tom, sub ) then
 result:= sub;
 else

 # Compute the possibilities.
 isnormal:=function(tom,sub1,sub2)
 local sub, result;
 result:=false;
 if ContainedTom(tom,sub1,sub2)=1 then
 result:=true;
 else
 if IsInt(NormalizersTom(tom)[sub1]) then
 if NormalizersTom(tom)[sub1]=sub2 then
 result:=true;
 elif sub2 in subs[NormalizersTom(tom)[sub1]] then
 result:=0;
 fi;
 else
 for sub in NormalizersTom(tom)[sub1] do
 if sub2 in subs[sub] then
 result:=0;
 fi;
 od;
 fi;
 fi;
 return result;
 end;

 orders:=OrdersTom(tom);
 subs:=SubsTom(tom);

 # find normal subgroups of prime index
 set:=PrimeDivisors(orders[sub]);
 primes:=[];
 normalsubs:=[];
 minindex:=1;
 for p in set do
 nrsubs:=0;
 ext:=CyclicExtensionsTom(tom,p);
 pos:=PositionProperty(ext,x->sub in x);
 extp:=Filtered(ext[pos],x->x in subs[sub] and orders[x] =
 orders[sub]/p);

 extps:=Filtered(ext[pos],x-> x in subs[sub] and orders[x]
 = orders[sub]/p^2);
 extps:=Filtered(extps,x->isnormal(tom,x,sub) = true);
 Append(normalsubs,extps);
 for sub1 in extp do
 nrsubs:=nrsubs + ContainedTom(tom,sub1,sub);
 Add(primes,p);
 if Length(Intersection(subs[sub1],extps)) = 0 then
 Add(normalsubs,sub1);
 fi;
 od;
 if nrsubs <> 0 then
 nrsubs:=Length(Factors(nrsubs*(p-1)+1));
 minindex:=minindex*p^nrsubs;
 fi;
 od;
 primes:=Set(primes);

 # compute subgroups of sub which are connected by a chain of normal
 # extensions or order in primes
 ext:=CyclicExtensionsTom(tom,primes);
 ext:=ext[PositionProperty(ext,x-> sub in x)];

 # consider intersections of two normal subgroups
 # for each such intersection the derived subgroup must be
 # contained in one of the possible intersections returned by
 # `IntersectionsTom'.
 # Additionally there must be a chain of
 # normal extensions connecting the derived subgroup and the groupext;
 result:=Filtered(subs[normalsubs[1]], x-> x in ext);
 for i in [1..Length(normalsubs)] do
 sub1:=normalsubs[i];
 indexsub1:=orders[sub]/orders[sub1];
 for j in [i..Length(normalsubs)] do
 sub2:=normalsubs[j];
 if sub1<>sub2 or(ContainedTom(tom,sub1,sub)<>1 and
 IsPrime(indexsub1)) then
 indexsub2:=orders[sub]/orders[sub2];
 index:=[indexsub1*indexsub2];
 if not (IsPrime(indexsub1) or IsPrime(indexsub2) or
 indexsub1<>
 indexsub2) then
 Add(index,Factors(indexsub1)[1]^3);
 fi;
 int:=IntersectionsTom(tom,sub1,sub2);
 int:= Filtered( [ 1 .. Length( int ) ], x -> int[x] <> 0 );
 int:=Filtered(int,x->orders[sub]/orders[x] in index);
 int:=Filtered(int,x-> x in ext);
 int:=List(int,x->subs[x]);

 int:=Flat(int);
 int:=Filtered(int,x-> x in ext);
 result:=Intersection(result,int);
 fi;
 od;
 od;

 if IsTableOfMarksWithGens(tom) then
 # correct size is known
 der:=DerivedSubgroup(RepresentativeTom(tom,sub));
 result:=Filtered(result,x->orders[x] = Size(der));

 else
 # forget all collected subgroups whose index is too small
 result:=Filtered(result,x->(orders[sub]/orders[x])
 >=minindex);
 fi;

 # the derived subgroup must be normal
 notnormal:=Filtered(subs[sub],x-> isnormal(tom,x,sub)=false);
 result:=Difference(result,notnormal);

 # sub cannot be abelian if it contains a not-normal subgroup
 if IntersectionSet( notnormal, subs[ sub ] ) <> [] then
 RemoveSet( result, 1 );
 fi;

 if Length( result ) = 1 then
 result:= result[1];
 else

 # the factor group cannot contain a not normal member
 # if the factor group for one possible solution is cyclic
 # it must contain the derived subgroup
 res:=[];
 for sub1 in Filtered(result,x->ContainedTom(tom,x,sub) = 1) do
 #inspecting the factor group if possible
 #collect the elements of the factor group that are not normal
 factorel:=Filtered(subs[sub], x->sub1 in subs[x]
 and x in notnormal);

 if Length(factorel) >0 then
 Add(res,sub1);
 fi;
 od;
 result:=Difference(result,res);

 if Length( result ) = 1 then
 result:= result[1];
 else

 # the derived subgroup must be normal in every normal extension of sub
 # and the derived subgroup can't be an involution if any normal
 # extension of sub has a cyclic subgroup of odd order 'n' and no
 # cyclic subgroup of order '2*n'
 norm:=NormalizersTom(tom)[sub];
 if IsInt(norm) then
 normext:=Filtered(subs[norm],x->sub in subs[x] and
 isnormal(tom,sub,x)=true);
 res:=Filtered(result,
 x->ForAny(normext, y->isnormal(tom,x,y) = false));
 result:=Difference(result,res);
 if 2 in orders{result} then
 bool:=true;
 for sub1 in normext do
 res:=Filtered(subs[sub1],x->IsCyclicTom(tom,x));
 oddord:=2*Filtered(orders{res},IsOddInt);

--> --------------------

--> maximum size reached

--> --------------------

SSL tom.gi Sprache: unbekannt

[ zur Elbe Produktseite wechseln0.68Quellennavigators Analyse erneut starten ]