1#############################################################################
2##
3##  This file is part of GAP, a system for computational discrete algebra.
4##  This file's authors include Frank Celler.
5##
6##  Copyright of GAP belongs to its developers, whose names are too numerous
7##  to list here. Please refer to the COPYRIGHT file for details.
8##
9##  SPDX-License-Identifier: GPL-2.0-or-later
10##
11##  This file contains the methods for matrix groups.
12##
13
14
15#############################################################################
16##
17#M  KnowsHowToDecompose( <mat-grp> )
18##
19InstallMethod( KnowsHowToDecompose, "matrix groups",
20        [ IsMatrixGroup, IsList ], ReturnFalse );
21
22
23#############################################################################
24##
25#M  DefaultFieldOfMatrixGroup( <mat-grp> )
26##
27InstallMethod(DefaultFieldOfMatrixGroup,"for a matrix group",[IsMatrixGroup],
28function( grp )
29local gens,R;
30  gens:= GeneratorsOfGroup( grp );
31  if IsEmpty( gens ) then
32    return Field( One( grp )[1,1] );
33  else
34    R:=DefaultScalarDomainOfMatrixList(gens);
35    if not IsField(R) then
36      R:=FieldOfMatrixList(gens);
37    fi;
38  fi;
39  return R;
40end );
41
42InstallMethod( DefaultFieldOfMatrixGroup,
43    "for matrix group over the cyclotomics",
44    [ IsCyclotomicMatrixGroup ],
45    grp -> Cyclotomics );
46
47InstallMethod( DefaultFieldOfMatrixGroup,
48    "for a matrix group over an s.c. algebra",
49    [ IsMatrixGroup and IsSCAlgebraObjCollCollColl ],
50    grp -> ElementsFamily( ElementsFamily( ElementsFamily(
51               FamilyObj( grp ) ) ) )!.fullSCAlgebra );
52
53# InstallOtherMethod( DefaultFieldOfMatrixGroup,
54#         "from source of nice monomorphism",
55#         [ IsMatrixGroup and HasNiceMonomorphism ],
56#     grp -> DefaultFieldOfMatrixGroup( Source( NiceMonomorphism( grp ) ) ) );
57#T this was illegal,
58#T since it assumes that the source is a different object than the
59#T original group; if this fails then we run into an infinite recursion!
60
61
62#############################################################################
63##
64#M  FieldOfMatrixGroup( <mat-grp> )
65##
66InstallMethod( FieldOfMatrixGroup,
67  "for a matrix group",
68    [ IsMatrixGroup ],
69    function( grp )
70    local gens;
71
72    gens:= GeneratorsOfGroup( grp );
73    if IsEmpty( gens ) then
74      return Field( One( grp )[1,1] );
75    else
76      return FieldOfMatrixList(gens);
77    fi;
78end );
79
80
81#############################################################################
82##
83#M  DimensionOfMatrixGroup( <mat-grp> )
84##
85InstallMethod( DimensionOfMatrixGroup, "from generators",
86    [ IsMatrixGroup and HasGeneratorsOfGroup ],
87    function( grp )
88    if not IsEmpty( GeneratorsOfGroup( grp ) )  then
89      return NumberRows( GeneratorsOfGroup( grp )[1] );
90    else
91        TryNextMethod();
92    fi;
93end );
94
95InstallMethod( DimensionOfMatrixGroup, "from one",
96    [ IsMatrixGroup and HasOne ], 1,
97    grp -> NumberRows( One( grp ) ) );
98
99# InstallOtherMethod( DimensionOfMatrixGroup,
100#         "from source of nice monomorphism",
101#         [ IsMatrixGroup and HasNiceMonomorphism ],
102#     grp -> DimensionOfMatrixGroup( Source( NiceMonomorphism( grp ) ) ) );
103#T this was illegal,
104#T since it assumes that the source is a different object than the
105#T original group; if this fails then we run into an infinite recursion!
106
107#T why not delegate to `Representative' instead of installing
108#T different methods?
109
110
111#############################################################################
112##
113#M  TransposedMatrixGroup( <G> ) . . . . . . . . .transpose of a matrix group
114##
115InstallMethod( TransposedMatrixGroup,
116    [ IsMatrixGroup ],
117function( G )
118    local T;
119    T := GroupByGenerators( List( GeneratorsOfGroup( G ), TransposedMat ),
120                            One( G ) );
121#T avoid calling `One'!
122    UseIsomorphismRelation( G, T );
123    SetTransposedMatrixGroup( T, G );
124    return T;
125end );
126
127
128#############################################################################
129##
130#F  NaturalActedSpace( [<G>,]<acts>,<veclist> )
131##
132InstallGlobalFunction(NaturalActedSpace,function(arg)
133local f,i,j,veclist,acts;
134  veclist:=arg[Length(arg)];
135  acts:=arg[Length(arg)-1];
136  if Length(arg)=3 and IsGroup(arg[1]) and acts=GeneratorsOfGroup(arg[1]) then
137    f:=DefaultFieldOfMatrixGroup(arg[1]);
138  else
139    f:=FieldOfMatrixList(acts);
140  fi;
141  for i in veclist do
142    for j in i do
143      if not j in f then
144        f:=ClosureField(f,j);
145      fi;
146    od;
147  od;
148  return f^Length(veclist[1]);
149end);
150
151InstallGlobalFunction(BasisVectorsForMatrixAction,function(G)
152local F, gens, evals, espaces, is, ise, gen, i, j,module,list,ind,vecs,mins;
153
154  F := DefaultFieldOfMatrixGroup(G);
155  # `Cyclotomics', the default field for rational matrix groups causes
156  # problems with a subsequent factorization
157  if IsIdenticalObj(F,Cyclotomics) then
158    # cyclotomics really is too large here
159    F:=FieldOfMatrixGroup(G);
160  fi;
161
162  list:=[];
163  if false and ValueOption("nosubmodules")=fail and IsFinite(F) then
164    module:=GModuleByMats(GeneratorsOfGroup(G),F);
165    if not MTX.IsIrreducible(module) then
166      mins:=Filtered(MTX.BasesCompositionSeries(module),x->Length(x)>0);
167      if Length(mins)<=5 then
168	mins:=MTX.BasesMinimalSubmodules(module);
169      else
170	if Length(mins)>7 then
171	  mins:=mins{Set([1..7],x->Random(1,Length(mins)))};
172	fi;
173      fi;
174
175      # now get potential basis vectors from submodules
176      for i in mins do
177	ind:=MTX.InducedActionSubmodule(module,i);
178	vecs:=BasisVectorsForMatrixAction(Group(ind.generators):nosubmodules);
179	Append(list,vecs*i);
180      od;
181
182    fi;
183  fi;
184
185  # use Murray/OBrien method
186
187  gens := ShallowCopy( GeneratorsOfGroup( G ) ); # Need copy for mutability
188  while Length( gens ) < 10 do
189      Add( gens, PseudoRandom( G ) );
190  od;
191
192  evals := [];  espaces := [];
193  for gen in gens do
194      evals := Concatenation( evals, GeneralisedEigenvalues(F,gen) );
195      espaces := Concatenation( espaces, GeneralisedEigenspaces(F,gen) );
196  od;
197
198  is:=[];
199  # the `AddSet' wil automatically put small spaces first
200  for i in [1..Length(espaces)] do
201    for j in [i+1..Length(espaces)] do
202      ise:=Intersection(espaces[i],espaces[j]);
203      if Dimension(ise)>0 and not ise in is then
204	Add(is,ise);
205      fi;
206    od;
207  od;
208  Append(list,Concatenation(List(is,i->BasisVectors(Basis(i)))));
209  return list;
210end);
211
212#############################################################################
213##
214#F  DoSparseLinearActionOnFaithfulSubset( <G>,<act>,<sort> )
215##
216##  computes a linear action of the matrix group <G> on the span of the
217##  standard basis. The action <act> must be `OnRight', or
218##  `OnLines'. The calculation of further orbits stops, once a basis for the
219##  underlying space has been reached, often giving a smaller degree
220##  permutation representation.
221##  The boolean <sort> indicates, whether the domain will be sorted.
222BindGlobal("DoSparseLinearActionOnFaithfulSubset",
223function(G,act,sort)
224local field, dict, acts, start, j, zerov, zero, dim, base, partbas, heads,
225      orb, delay, permimg, maxlim, starti, ll, ltwa, img, v, en, p, kill,
226      i, lo, imgs, xset, hom, R;
227
228  field:=DefaultFieldOfMatrixGroup(G);
229  acts:=GeneratorsOfGroup(G);
230
231  if Length(acts)=0 then
232    start:= RowsOfMatrix( One( G) );
233  elif act=OnRight then
234    start:= Concatenation( BasisVectorsForMatrixAction( G ),
235                           RowsOfMatrix( One( G ) ) );
236  elif act=OnLines then
237    j:=One(G);
238    start:=Concatenation(List(BasisVectorsForMatrixAction(G),
239	    x->OnLines(x,j)),j);
240  else
241    Error("illegal action");
242  fi;
243
244  zerov:=Zero(start[1]);
245  zero:=zerov[1];
246  dim:=Length(zerov);
247
248  base:=[]; # elements of start which are a base in the permgrp sense
249  partbas:=[]; # la basis of space spanned so far
250  heads:=[];
251  orb:=[];
252  delay:=[]; # Vectors we delay later, because they are potentially very
253             # expensive.
254  permimg:=List(acts,i->[]);
255  maxlim:=200000;
256
257  starti:=1;
258  while Length(partbas)<dim or
259    (act=OnLines and not OnLines(Sum(base),One(G)) in orb) do
260    Info(InfoGroup,2,"dim=",Length(partbas)," ",
261         "|orb|=",Length(orb));
262    if Length(partbas)=dim and act=OnLines then
263      Info(InfoGroup,2,"add sum for projective action");
264      img:=OnLines(Sum(base),One(G));
265    else
266      if starti>Length(start) then
267	Sort(delay);
268	for i in delay do
269	  Add(start,i[2]);
270	od;
271	maxlim:=maxlim*100;
272	Info(InfoGroup,2,
273	    "original pool exhausted, use delayed.  maxlim=",maxlim);
274	delay:=[];
275      fi;
276
277      ll:=Length(orb);
278      ltwa:=Maximum(maxlim,(ll+1)*20);
279      img:=start[starti];
280      v:=ShallowCopy(img);
281      for j in [ 1 .. Length( heads ) ] do
282	en:=v[heads[j]];
283	if en <> zero then
284	  AddRowVector( v, partbas[j], - en );
285	fi;
286      od;
287    fi;
288
289    if not IsZero(v) then
290      # do not go positional dictionary if we know it to be overkill
291      if HasSize(G) then
292        dict := NewDictionary( v, true , field ^ Length( One( G ))
293                  :blistlimi:=Maximum(10,Size(field))*Size(G) );
294      else
295        dict := NewDictionary( v, true , field ^ Length( One( G ) ) );
296      fi;
297      # force `img' over field
298      if (Size(field)=2 and not IsGF2VectorRep(img)) or
299	 (Size(field)>2 and Size(field)<=256 and not (Is8BitVectorRep(img)
300	 and Q_VEC8BIT(img)=Size(field))) then
301	img:=ShallowCopy(img);
302	ConvertToVectorRep(img,Size(field));
303      fi;
304      Add(orb,img);
305      p:=Length(orb);
306      AddDictionary(dict,img,Length(orb));
307      kill:=false;
308
309      # orbit algorithm with image keeper
310      while p<=Length(orb) do
311	i:=1;
312	while i<=Length(acts) do
313	  img := act(orb[p],acts[i]);
314	  v:=LookupDictionary(dict,img);
315	  if v=fail then
316	    if Length(orb)>ltwa then
317	      Info(InfoGroup,2,"Very long orbit, delay");
318	      Add(delay,[Length(orb)-ll,orb[ll+1]]);
319	      kill:=true;
320	      for p in [ll+1..Length(orb)] do
321	        Unbind(orb[p]);
322		for i in [1..Length(acts)] do
323		  Unbind(permimg[i][p]);
324		od;
325	      od;
326	      i:=Length(acts)+1;
327	      p:=Length(orb)+1;
328	    else
329	      Add(orb,img);
330	      AddDictionary(dict,img,Length(orb));
331	      permimg[i][p]:=Length(orb);
332	    fi;
333	  else
334	    permimg[i][p]:=v;
335	  fi;
336	  i:=i+1;
337	od;
338	p:=p+1;
339      od;
340    fi;
341    starti:=starti+1;
342
343    if not kill then
344      # break criterion: do we actually *want* more points?
345      i:=ll+1;
346      lo:=Length(orb);
347      while i<=lo do
348	v:=ShallowCopy(orb[i]);
349	for j in [ 1 .. Length( heads ) ] do
350	  en:=v[heads[j]];
351	  if en <> zero then
352	    AddRowVector( v, partbas[j], - en );
353	  fi;
354	od;
355	if v<>zerov then
356	  Add(base,orb[i]);
357	  Add(partbas,ShallowCopy(orb[i]));
358	  TriangulizeMat(partbas);
359	  heads:=List(partbas,PositionNonZero);
360	  if Length(partbas)>=dim then
361	    # full dimension reached
362	    i:=lo;
363	  fi;
364	fi;
365	i:=i+1;
366      od;
367    fi;
368
369  od;
370
371  # Das Dictionary hat seine Schuldigkeit getan
372  Unbind(dict);
373  Info(InfoGroup,1,"found degree=",Length(orb));
374
375  # any asymptotic argument is pointless here: In practice sorting is much
376  # quicker than image computation.
377  if sort then
378    imgs:=Sortex(orb); # permutation we must apply to the points to be sorted.
379    # was: permimg:=List(permimg,i->OnTuples(Permuted(i,imgs),imgs));
380    # run in loop to save memory
381    for i in [1..Length(permimg)] do
382      permimg[i]:=Permuted(permimg[i],imgs);
383      permimg[i]:=OnTuples(permimg[i],imgs);
384    od;
385  fi;
386
387#check routine
388#  Print("check!\n");
389#  for p in [1..Length(orb)] do
390#    for i in [1..Length(acts)] do
391#      img:=act(orb[p],acts[i]);
392#      v:=LookupDictionary(dict,img);
393#      if v<>permimg[i][p] then
394#        Error("wrong!");
395#      fi;
396#    od;
397#  od;
398#  Error("hier");
399
400  for i in [1..Length(permimg)] do
401    permimg[i]:=PermList(permimg[i]);
402  od;
403
404  if fail in permimg then
405    Error("not permutations");
406  fi;
407  xset:=ExternalSet( G, orb, acts, acts, act);
408
409  # when acting projectively the sum of the base vectors must be part of the
410  # base -- that will guarantee that we can distinguish diagonal from scalar
411  # matrices.
412  if act=OnLines then
413    if Length(base)<=dim then
414      Add(base,OnLines(Sum(base),One(G)));
415    fi;
416  fi;
417
418  # We know that the points corresponding to `start' give a base of the
419  # vector space. We can use
420  # this to get images quickly, using a stabilizer chain in the permutation
421  # group
422  SetBaseOfGroup( xset, base );
423  xset!.basePermImage:=List(base,b->PositionCanonical(orb,b));
424
425  hom := ActionHomomorphism( xset,"surjective" );
426  if act <> OnLines then
427    SetIsInjective(hom, true); # we know by construction that it is injective.
428  fi;
429
430  R:=Group(permimg,()); # `permimg' arose from `PermList'
431  SetBaseOfGroup(R,xset!.basePermImage);
432
433  if HasSize(G) and act=OnRight then
434    SetSize(R,Size(G)); # faithful action
435  fi;
436
437  SetRange(hom,R);
438  SetImagesSource(hom,R);
439  SetMappingGeneratorsImages(hom,[acts,permimg]);
440#  p:=RUN_IN_GGMBI; # no niceomorphism translation here
441#  RUN_IN_GGMBI:=true;
442#  SetAsGroupGeneralMappingByImages ( hom, GroupHomomorphismByImagesNC
443#            ( G, R, acts, permimg ) );
444#
445#  SetFilterObj( hom, IsActionHomomorphismByBase );
446#  RUN_IN_GGMBI:=p;
447  if act=OnRight or act=OnPoints then
448    # only store for action on right. projective action needs is own call to
449    # `LinearActionBase' as this will set other needed parameters.
450    base:=ImmutableMatrix(field,base);
451    SetLinearActionBasis(hom,base);
452  fi;
453
454  return hom;
455end);
456
457#############################################################################
458##
459#M  IsomorphismPermGroup( <mat-grp> )
460##
461
462BindGlobal( "NicomorphismOfGeneralMatrixGroup", function( grp,canon,sort )
463local   nice,img,module,b;
464  b:=SeedFaithfulAction(grp);
465  if canon=false and b<>fail then
466    Info(InfoGroup,1,"using predefined action seed");
467    # the user (or code) gave a seed for a faithful action
468    nice:=MultiActionsHomomorphism(grp,b.points,b.ops);
469  # don't be too clever if it is a matrix over a non-field domain
470  elif not IsField(DefaultFieldOfMatrixGroup(grp)) then
471    Info(InfoGroup,1,"over nonfield");
472    #nice:=ActionHomomorphism( grp,AsSSortedList(grp),OnRight,"surjective");
473    if canon then
474      nice:= SortedSparseActionHomomorphism( grp,
475                 RowsOfMatrix( One( grp ) ) );
476      SetIsCanonicalNiceMonomorphism(nice,true);
477    else
478      nice:= SparseActionHomomorphism( grp,
479                 RowsOfMatrix( One( grp ) ) );
480      nice:=nice*SmallerDegreePermutationRepresentation(Image(nice):cheap);
481    fi;
482  elif IsFinite(grp) and ( (HasIsNaturalGL(grp) and IsNaturalGL(grp)) or
483             (HasIsNaturalSL(grp) and IsNaturalSL(grp)) ) then
484    # for full GL/SL we get never better than the full vector space as domain
485    Info(InfoGroup,1,"is GL/SL");
486    return NicomorphismFFMatGroupOnFullSpace(grp);
487  elif canon then
488    Info(InfoGroup,1,"canonical niceo");
489    nice:= SortedSparseActionHomomorphism( grp,
490               RowsOfMatrix( One( grp ) ) );
491    SetIsCanonicalNiceMonomorphism(nice,true);
492  else
493    Info(InfoGroup,1,"act to find base");
494    nice:=DoSparseLinearActionOnFaithfulSubset( grp, OnRight, sort);
495    SetIsSurjective( nice, true );
496
497    img:=Image(nice);
498    if not IsFinite(DefaultFieldOfMatrixGroup(grp)) or
499    Length(GeneratorsOfGroup(grp))=0 then
500      module:=fail;
501    else
502      module:=GModuleByMats(GeneratorsOfGroup(grp),DefaultFieldOfMatrixGroup(grp));
503    fi;
504    #improve,
505    # try hard, unless absirr and orbit lengths at least 1/q^2 of domain --
506    #then we expect improvements to be of little help
507    if module<>fail and not (NrMovedPoints(img)>=
508      Size( DefaultFieldOfMatrixGroup( grp ) )^( NumberRows( One( grp ) )-2 )
509      and MTX.IsAbsolutelyIrreducible(module)) then
510	nice:=nice*SmallerDegreePermutationRepresentation(img:cheap);
511    else
512      nice:=nice*SmallerDegreePermutationRepresentation(img:cheap);
513    fi;
514  fi;
515  SetIsInjective( nice, true );
516
517  return nice;
518end );
519
520InstallMethod( IsomorphismPermGroup,"matrix group", true,
521  [ IsMatrixGroup ], 10,
522function(G)
523local map;
524  if HasNiceMonomorphism(G) and IsPermGroup(Range(NiceMonomorphism(G))) then
525    map:=NiceMonomorphism(G);
526    if IsIdenticalObj(Source(map),G) then
527      return map;
528    fi;
529    return GeneralRestrictedMapping(map,G,Image(map,G));
530  else
531    if not HasIsFinite(G) then
532      Info(InfoWarning,1,
533           "IsomorphismPermGroup: The group is not known to be finite");
534    fi;
535    map:=NicomorphismOfGeneralMatrixGroup(G,false,false);
536    SetNiceMonomorphism(G,map);
537    return map;
538  fi;
539end);
540
541#############################################################################
542##
543#M  NiceMonomorphism( <mat-grp> )
544##
545InstallMethod( NiceMonomorphism,"use NicomorphismOfGeneralMatrixGroup",
546  [ IsMatrixGroup and IsFinite ],
547  G->NicomorphismOfGeneralMatrixGroup(G,false,false));
548
549#############################################################################
550##
551#M  CanonicalNiceMonomorphism( <mat-grp> )
552##
553InstallMethod( CanonicalNiceMonomorphism, [ IsMatrixGroup and IsFinite ],
554  G->NicomorphismOfGeneralMatrixGroup(G,true,true));
555
556#############################################################################
557##
558#F  ProjectiveActionHomomorphismMatrixGroup(<G>)
559##
560InstallGlobalFunction(ProjectiveActionHomomorphismMatrixGroup,
561  G->DoSparseLinearActionOnFaithfulSubset(G,OnLines,true));
562
563#############################################################################
564##
565#M  GeneratorsSmallest(<finite matrix group>)
566##
567##  This algorithm takes <bas>:=the points corresponding to the standard basis
568##  and then computes a minimal generating system for the permutation group
569##  wrt. this base <bas>. As lexicographical comparison of matrices is
570##  compatible with comparison of base images wrt. the standard base this
571##  also is the smallest (irredundant) generating set of the matrix group!
572InstallMethod(GeneratorsSmallest,"matrix group via niceo",
573  [IsMatrixGroup and IsFinite],
574function(G)
575local gens,s,dom,mon,no;
576  mon:=CanonicalNiceMonomorphism(G);
577  no:=Image(mon,G);
578  dom:=UnderlyingExternalSet(mon);
579  s:=StabChainOp(no,rec(base:=List(BaseOfGroup(dom),
580				      i->Position(HomeEnumerator(dom),i))));
581  # call the recursive function to do the work
582  gens:= SCMinSmaGens( no, s, [], One( no ), true ).gens;
583  SetMinimalStabChain(G,s);
584  return List(gens,i->PreImagesRepresentative(mon,i));
585end);
586
587#############################################################################
588##
589#M  MinimalStabChain(<finite matrix group>)
590##
591##  used for cosets where we probably won't need the smallest generators
592InstallOtherMethod(MinimalStabChain,"matrix group via niceo",
593  [IsMatrixGroup and IsFinite],
594function(G)
595local s,dom,mon,no;
596  mon:=CanonicalNiceMonomorphism(G);
597  no:=Image(mon,G);
598  dom:=UnderlyingExternalSet(mon);
599  s:=StabChainOp(no,rec(base:=List(BaseOfGroup(dom),
600				      i->Position(HomeEnumerator(dom),i))));
601  # call the recursive function to do the work
602  SCMinSmaGens( no, s, [], One( no ), false );
603  return s;
604end);
605
606#############################################################################
607##
608#M  LargestElementGroup(<finite matrix group>)
609##
610InstallOtherMethod(LargestElementGroup,"matrix group via niceo",
611  [IsMatrixGroup and IsFinite],
612function(G)
613local s,dom,mon, img;
614  mon:=CanonicalNiceMonomorphism(G);
615  dom:=UnderlyingExternalSet(mon);
616  img:= Image( mon, G );
617  s:=StabChainOp( img, rec(base:=List(BaseOfGroup(dom),
618				      i->Position(HomeEnumerator(dom),i))));
619  # call the recursive function to do the work
620  s:= LargestElementStabChain( s, One( img ) );
621  return PreImagesRepresentative(mon,s);
622end);
623
624#############################################################################
625##
626#M  CanonicalRightCosetElement(<finite matrix group>,<rep>)
627##
628InstallMethod(CanonicalRightCosetElement,"finite matric group",IsCollsElms,
629  [IsMatrixGroup and IsFinite,IsMatrix],
630function(U,e)
631local mon,dom,S,o,oimgs,p,i,g;
632  mon:=CanonicalNiceMonomorphism(U);
633  dom:=UnderlyingExternalSet(mon);
634  S:=StabChainOp(Image(mon,U),rec(base:=List(BaseOfGroup(dom),
635				      i->Position(HomeEnumerator(dom),i))));
636  dom:=HomeEnumerator(dom);
637
638  while not IsEmpty(S.generators) do
639    o:=dom{S.orbit}; # the relevant vectors
640    oimgs:=List(o,i->i*e); #their images
641
642    # find the smallest image
643    p:=1;
644    for i in [2..Length(oimgs)] do
645      if oimgs[i]<oimgs[p] then
646        p:=i;
647      fi;
648    od;
649
650    # the point corresponding to the preimage
651    p:=S.orbit[p];
652
653    # now find an element that maps S.orbit[1] to p;
654    g:=S.identity;
655    while S.orbit[1]^g<>p do
656      g:=LeftQuotient(S.transversal[p/g],g);
657    od;
658
659    # change by corresponding matrix element
660    e:=PreImagesRepresentative(mon,g)*e;
661
662    S:=S.stabilizer;
663  od;
664
665  return e;
666end);
667
668#############################################################################
669##
670#M  ViewObj( <matgrp> )
671##
672InstallMethod( ViewObj,
673    "for a matrix group with stored generators",
674    [ IsMatrixGroup and HasGeneratorsOfGroup ],
675function(G)
676local gens;
677  gens:=GeneratorsOfGroup(G);
678  if Length(gens)>0 and
679     Length(gens) * DimensionOfMatrixGroup(G)^2 / GAPInfo.ViewLength > 8 then
680    Print("<matrix group");
681    if HasSize(G) then
682      Print(" of size ",Size(G));
683    fi;
684    Print(" with ",Length(GeneratorsOfGroup(G)),
685          " generators>");
686  else
687    Print("Group(");
688    ViewObj(GeneratorsOfGroup(G));
689    Print(")");
690  fi;
691end);
692
693#############################################################################
694##
695#M  ViewObj( <matgrp> )
696##
697InstallMethod( ViewObj,"for a matrix group",
698    [ IsMatrixGroup ],
699function(G)
700local d;
701  d:=DimensionOfMatrixGroup(G);
702  Print("<group of ",d,"x",d," matrices");
703  if HasSize(G) then
704    Print(" of size ",Size(G));
705  fi;
706  if HasFieldOfMatrixGroup(G) then
707    Print(" over ",FieldOfMatrixGroup(G),">");
708  elif HasDefaultFieldOfMatrixGroup(G) then
709    Print(" over ",DefaultFieldOfMatrixGroup(G),">");
710  else
711    Print(" in characteristic ",Characteristic(One(G)),">");
712  fi;
713end);
714
715#############################################################################
716##
717#M  PrintObj( <matgrp> )
718##
719InstallMethod( PrintObj,"for a matrix group",
720    [ IsMatrixGroup ],
721function(G)
722local l;
723  l:=GeneratorsOfGroup(G);
724  if Length(l)=0 then
725    Print("Group([],",One(G),")");
726  else
727    Print("Group(",l,")");
728  fi;
729end);
730
731#############################################################################
732##
733#M  IsGeneralLinearGroup(<G>)
734##
735InstallMethod(IsGeneralLinearGroup,"try natural",[IsMatrixGroup],
736function(G)
737  if HasIsNaturalGL(G) and IsNaturalGL(G) then
738    return true;
739  else
740    TryNextMethod();
741  fi;
742end);
743
744#############################################################################
745##
746#M  IsSubgroupSL
747##
748InstallMethod(IsSubgroupSL,"determinant test for generators",
749  [IsMatrixGroup and HasGeneratorsOfGroup],
750    G -> ForAll(GeneratorsOfGroup(G),i->IsOne(DeterminantMat(i))) );
751
752#############################################################################
753##
754#M  <mat> in <G>  . . . . . . . . . . . . . . . . . . . .  is form invariant?
755##
756InstallMethod( \in, "respecting bilinear form", IsElmsColls,
757    [ IsMatrix, IsFullSubgroupGLorSLRespectingBilinearForm ],
758    NICE_FLAGS,  # this method is better than the one using a nice monom.
759function( mat, G )
760    local inv;
761    if not IsSubset( FieldOfMatrixGroup( G ), FieldOfMatrixList( [ mat ] ) )
762       or ( IsSubgroupSL( G ) and not IsOne( DeterminantMat( mat ) ) ) then
763      return false;
764    fi;
765    inv:= InvariantBilinearForm(G).matrix;
766    return mat * inv * TransposedMat( mat ) = inv;
767end );
768
769InstallMethod( \in, "respecting sesquilinear form", IsElmsColls,
770    [ IsMatrix, IsFullSubgroupGLorSLRespectingSesquilinearForm ],
771    NICE_FLAGS,  # this method is better than the one using a nice monom.
772function( mat, G )
773    local pow, inv;
774    if not IsSubset( FieldOfMatrixGroup( G ), FieldOfMatrixList( [ mat ] ) )
775       or ( IsSubgroupSL( G ) and not IsOne( DeterminantMat( mat ) ) ) then
776      return false;
777    fi;
778    pow:= RootInt( Size( FieldOfMatrixGroup( G ) ) );
779    inv:= InvariantSesquilinearForm(G).matrix;
780    return mat * inv * List( TransposedMat( mat ),
781                             row -> List( row, x -> x^pow ) )
782           = inv;
783end );
784
785
786#############################################################################
787##
788#M  IsGeneratorsOfMagmaWithInverses( <matlist> )
789##
790##  Check that all entries are matrices of the same dimension, and that they
791##  are all invertible.
792##
793InstallMethod( IsGeneratorsOfMagmaWithInverses,
794    "for a list of matrices",
795    [ IsRingElementCollCollColl ],
796    function( matlist )
797    local nrows, ncols;
798
799    if IsList( matlist ) and ForAll( matlist, IsMatrixObj ) then
800      nrows:= NumberRows( matlist[1] );
801      ncols:= NumberColumns( matlist[1] );
802      return nrows = ncols and
803             ForAll( matlist,
804                     mat -> NumberRows( mat ) = nrows and
805                            NumberColumns( mat ) = ncols ) and
806             ForAll( matlist, mat -> Inverse( mat ) <> fail );
807    fi;
808    return false;
809    end );
810
811
812#############################################################################
813##
814#M  GroupWithGenerators( <mats> )
815#M  GroupWithGenerators( <mats>, <id> )
816##
817InstallMethod( GroupWithGenerators,
818    "list of matrices",
819    [ IsFFECollCollColl ],
820#T ???
821function( gens )
822local G,typ,f;
823
824  if not IsFinite(gens) then TryNextMethod(); fi;
825  typ:=MakeGroupyType(FamilyObj(gens),
826          IsGroup and IsAttributeStoringRep
827            and HasGeneratorsOfMagmaWithInverses
828            and IsFinitelyGeneratedGroup and HasIsEmpty and IsFinite,
829          gens,false,true);
830
831  f:=DefaultScalarDomainOfMatrixList(gens);
832  gens:=List(Immutable(gens),i->ImmutableMatrix(f,i));
833
834  G:=rec();
835  ObjectifyWithAttributes(G,typ,GeneratorsOfMagmaWithInverses,AsList(gens));
836
837  if IsField(f) then SetDefaultFieldOfMatrixGroup(G,f);fi;
838
839  return G;
840end );
841
842InstallMethod( GroupWithGenerators,
843  "list of matrices with identity", IsCollsElms,
844  [ IsFFECollCollColl,IsMultiplicativeElementWithInverse and IsFFECollColl],
845function( gens, id )
846local G,typ,f;
847
848  if not IsFinite(gens) then TryNextMethod(); fi;
849  typ:=MakeGroupyType(FamilyObj(gens), IsGroup and IsAttributeStoringRep
850          and HasGeneratorsOfMagmaWithInverses and IsFinitelyGeneratedGroup
851          and HasIsEmpty and IsFinite and HasOne,
852          gens,id,true);
853
854  f:=DefaultScalarDomainOfMatrixList(gens);
855  gens:=List(Immutable(gens),i->ImmutableMatrix(f,i));
856  id:=ImmutableMatrix(f,id);
857
858  G:=rec();
859  ObjectifyWithAttributes(G,typ,GeneratorsOfMagmaWithInverses,AsList(gens),
860                          One,id);
861
862  if IsField(f) then SetDefaultFieldOfMatrixGroup(G,f);fi;
863
864  return G;
865end );
866
867InstallMethod( GroupWithGenerators,
868  "empty list of matrices with identity", true,
869  [ IsList and IsEmpty,IsMultiplicativeElementWithInverse and IsFFECollColl],
870function( gens, id )
871local G,fam,typ,f;
872
873  if not IsFinite(gens) then TryNextMethod(); fi;
874  typ:=MakeGroupyType(FamilyObj([id]), IsGroup and IsAttributeStoringRep
875            and HasGeneratorsOfMagmaWithInverses and HasOne and IsTrivial,
876            gens,id,true);
877
878  f:=DefaultScalarDomainOfMatrixList([id]);
879  id:=ImmutableMatrix(f,id);
880
881  G:=rec();
882  ObjectifyWithAttributes(G,typ,GeneratorsOfMagmaWithInverses,AsList(gens),
883                          One,id);
884
885  if IsField(f) then SetDefaultFieldOfMatrixGroup(G,f);fi;
886
887  return G;
888end );
889
890
891#############################################################################
892##
893#M  IsConjugatorIsomorphism( <hom> )
894##
895InstallMethod( IsConjugatorIsomorphism,
896    "for a matrix group general mapping",
897    [ IsGroupGeneralMapping ], 1,
898    # There is no filter to test whether source and range of a homomorphism
899    # are matrix groups.
900    # So we have to test explicitly and make this method
901    # higher ranking than the default one in `ghom.gi'.
902    function( hom )
903
904    local s, r, dim, Fs, Fr, F, genss, rep;
905
906    s:= Source( hom );
907    if not IsMatrixGroup( s ) then
908      TryNextMethod();
909    elif not ( IsGroupHomomorphism( hom ) and IsBijective( hom ) ) then
910      return false;
911    elif IsEndoGeneralMapping( hom ) and IsInnerAutomorphism( hom ) then
912      return true;
913    fi;
914    r:= Range( hom );
915
916    # Check whether dimensions and fields of matrix entries are compatible.
917    dim:= DimensionOfMatrixGroup( s );
918    if dim <> DimensionOfMatrixGroup( r ) then
919      return false;
920    fi;
921    Fs:= DefaultFieldOfMatrixGroup( s );
922    Fr:= DefaultFieldOfMatrixGroup( r );
923    if FamilyObj( Fs ) <> FamilyObj( Fr ) then
924      return false;
925    fi;
926    if not ( IsField( Fs ) and IsField( Fr ) ) then
927      TryNextMethod();
928    fi;
929    F:= ClosureField( Fs, Fr );
930    if not IsFinite( F ) then
931      TryNextMethod();
932    fi;
933
934    # Compute a conjugator in the full linear group.
935    genss:= GeneratorsOfGroup( s );
936    rep:= RepresentativeAction( GL( dim, Size( F ) ), genss, List( genss,
937                    i -> ImagesRepresentative( hom, i ) ), OnTuples );
938
939    # Return the result.
940    if rep <> fail then
941      Assert( 1, ForAll( genss, i -> Image( hom, i ) = i^rep ) );
942      SetConjugatorOfConjugatorIsomorphism( hom, rep );
943      return true;
944    else
945      return false;
946    fi;
947    end );
948
949
950#############################################################################
951##
952#F  AffineActionByMatrixGroup( <M> )
953##
954InstallGlobalFunction( AffineActionByMatrixGroup, function(M)
955local   gens,V,  G, A;
956
957  # build the vector space
958  V := DefaultFieldOfMatrixGroup( M ) ^ DimensionOfMatrixGroup( M );
959
960  # the linear part
961  G := Action( M, V );
962
963  # the translation part
964  gens:=List( Basis( V ), b -> Permutation( b, V, \+ ) );
965
966  # construct the affine group
967  A := GroupByGenerators(Concatenation(gens,GeneratorsOfGroup( G )));
968  SetSize( A, Size( M ) * Size( V ) );
969
970  if HasName( M )  then
971      SetName( A, Concatenation( String( Size( DefaultFieldOfMatrixGroup( M ) ) ),
972	      "^", String( DimensionOfMatrixGroup( M ) ), ":",
973	      Name( M ) ) );
974  fi;
975  # the !.matrixGroup component is not documented!
976  A!.matrixGroup := M;
977#T what the hell shall this misuse be good for?
978  return A;
979
980end );
981
982
983#############################################################################
984##
985##  n. Code needed for ``blow up isomorphisms'' of matrix groups
986##
987
988
989#############################################################################
990##
991#F  IsBlowUpIsomorphism
992##
993##  We define this filter for additive as well as for multiplicative
994##  general mappings,
995##  so the ``respectings'' of the mappings must be set explicitly.
996##
997DeclareFilter( "IsBlowUpIsomorphism", IsSPGeneralMapping and IsBijective );
998
999
1000#############################################################################
1001##
1002#M  ImagesRepresentative( <iso>, <mat> ) . . . . .  for a blow up isomorphism
1003##
1004InstallMethod( ImagesRepresentative,
1005    "for a blow up isomorphism, and a matrix in the source",
1006    FamSourceEqFamElm,
1007    [ IsBlowUpIsomorphism, IsMatrix ],
1008    function( iso, mat )
1009    return BlownUpMat( Basis( iso ), mat );
1010    end );
1011
1012
1013#############################################################################
1014##
1015#M  PreImagesRepresentative( <iso>, <mat> )  . . .  for a blow up isomorphism
1016##
1017InstallMethod( PreImagesRepresentative,
1018    "for a blow up isomorphism, and a matrix in the range",
1019    FamRangeEqFamElm,
1020    [ IsBlowUpIsomorphism, IsMatrix ],
1021    function( iso, mat )
1022
1023    local B,
1024          d,
1025          n,
1026          Binv,
1027          preim,
1028          i,
1029          row,
1030          j,
1031          submat,
1032          elm,
1033          k;
1034
1035    B:= Basis( iso );
1036    d:= Length( B );
1037    n:= NumberRows( mat ) / d;
1038
1039    if not IsInt( n ) then
1040      return fail;
1041    fi;
1042
1043    Binv:= List( B, Inverse );
1044    preim:= [];
1045
1046    for i in [ 1 .. n ] do
1047      row:= [];
1048      for j in [ 1 .. n ] do
1049
1050        # Compute the entry in the `i'-th row in the `j'-th column.
1051        submat:= mat{ [ 1 .. d ] + (i-1)*d }{ [ 1 .. d ] + (j-1)*d };
1052        elm:= Binv[1] * LinearCombination( B, submat[1] );
1053
1054        # Check that the matrix is in the image of the isomorphism.
1055        for k in [ 2 .. d ] do
1056          if B[k] * elm <> LinearCombination( B, submat[k] ) then
1057            return fail;
1058          fi;
1059        od;
1060
1061        row[j]:= elm;
1062
1063      od;
1064      preim[i]:= row;
1065    od;
1066
1067    return preim;
1068    end );
1069
1070
1071#############################################################################
1072##
1073#F  BlowUpIsomorphism( <matgrp>, <B> )
1074##
1075InstallGlobalFunction( "BlowUpIsomorphism", function( matgrp, B )
1076
1077    local gens,
1078          preimgs,
1079          imgs,
1080          range,
1081          iso;
1082
1083    gens:= GeneratorsOfGroup( matgrp );
1084    if IsEmpty( gens ) then
1085      preimgs:= [ One( matgrp ) ];
1086      imgs:= [ IdentityMat( Length( preimgs[1] ) * Length( B ),
1087                   LeftActingDomain( UnderlyingLeftModule( B ) ) ) ];
1088      range:= GroupByGenerators( [], imgs[1] );
1089    else
1090      preimgs:= gens;
1091      imgs:= List( gens, mat -> BlownUpMat( B, mat ) );
1092      range:= GroupByGenerators( imgs );
1093    fi;
1094
1095    iso:= rec();
1096    ObjectifyWithAttributes( iso,
1097        NewType( GeneralMappingsFamily( FamilyObj( preimgs[1] ),
1098                                        FamilyObj( imgs[1] ) ),
1099                     IsBlowUpIsomorphism
1100                 and IsGroupGeneralMapping
1101                 and IsAttributeStoringRep ),
1102        Source, matgrp,
1103        Range, range,
1104        Basis, B );
1105
1106    return iso;
1107    end );
1108
1109
1110#############################################################################
1111##
1112##  stuff concerning invariant forms of matrix groups
1113#T add code for computing invariant forms,
1114#T and transforming matrices for normalizing the forms
1115#T (which is useful, e.g., for embedding the groups from AtlasRep into
1116#T the unitary, symplectic, or orthogonal groups in question)
1117##
1118
1119
1120#############################################################################
1121##
1122#M  InvariantBilinearForm( <matgrp> )
1123##
1124InstallMethod( InvariantBilinearForm,
1125    "for a matrix group with known `InvariantQuadraticForm'",
1126    [ IsMatrixGroup and HasInvariantQuadraticForm ],
1127    function( matgrp )
1128    local Q;
1129
1130    Q:= InvariantQuadraticForm( matgrp ).matrix;
1131    return rec( matrix:= ( Q + TransposedMat( Q ) ) );
1132    end );
1133