1#############################################################################
2##
3#W  rcwagrp.gd                GAP4 Package `RCWA'                 Stefan Kohl
4##
5##  This file contains declarations of functions, operations etc. for
6##  computing with rcwa groups.
7##
8##  See the definitions given in the file rcwamap.gd.
9##
10#############################################################################
11
12#############################################################################
13##
14#S  Basic definitions. //////////////////////////////////////////////////////
15##
16#############################################################################
17
18#############################################################################
19##
20#C  CategoryCollections( IsRcwaMappingOfZ ) . . . . . . . rcwa domains over Z
21##
22##  The category of all domains formed out of rcwa mappings of Z.
23##
24DeclareCategoryCollections( "IsRcwaMappingOfZ" );
25
26#############################################################################
27##
28#C  IsRcwaGroupOverZ . . . . . . . . . . . . . . . . . . . rcwa groups over Z
29#C  IsRcwaGroupOverZxZ . . . . . . . . . . . . . . . . . rcwa groups over Z^2
30#C  IsRcwaGroupOverZ_pi . . . . . . . . . . . . . . . rcwa groups over Z_(pi)
31#C  IsRcwaGroupOverGFqx . . . . . . . . . . . . . . rcwa groups over GF(q)[x]
32#C  IsRcwaGroupOverZOrZ_pi . . . . . . . . . . . rcwa groups over Z or Z_(pi)
33##
34##  The category of all rcwa groups over Z, over Z^2, over semilocalizations
35##  of Z or over polynomial rings in one variable over a finite field,
36##  respectively. The category `IsRcwaGroupOverZOrZ_pi' is the union of
37##  `IsRcwaGroupOverZ' and `IsRcwaGroupOverZ_pi'.
38##
39DeclareSynonym( "IsRcwaGroupOverZ",
40                 CategoryCollections(IsRcwaMappingOfZ) and IsGroup );
41DeclareSynonym( "IsRcwaGroupOverZxZ",
42                 CategoryCollections(IsRcwaMappingOfZxZ) and IsGroup );
43DeclareSynonym( "IsRcwaGroupOverZ_pi",
44                 CategoryCollections(IsRcwaMappingOfZ_pi) and IsGroup );
45DeclareSynonym( "IsRcwaGroupOverGFqx",
46                 CategoryCollections(IsRcwaMappingOfGFqx) and IsGroup );
47DeclareSynonym( "IsRcwaGroupOverZOrZ_pi",
48                 CategoryCollections(IsRcwaMappingOfZOrZ_pi) and IsGroup );
49
50#############################################################################
51##
52#R  IsRcwaGroupsIteratorRep . . . . . . . . . . . . . iterator representation
53##
54DeclareRepresentation( "IsRcwaGroupsIteratorRep",
55                       IsComponentObjectRep,
56                       [ "G", "sphere", "oldsphere", "pos" ] );
57
58#############################################################################
59##
60#V  TrivialRcwaGroupOverZ . . . . . . . . . . . . . trivial rcwa group over Z
61#V  TrivialRcwaGroupOverZxZ . . . . . . . . . . . trivial rcwa group over Z^2
62##
63DeclareGlobalVariable( "TrivialRcwaGroupOverZ" );
64DeclareGlobalVariable( "TrivialRcwaGroupOverZxZ" );
65
66#############################################################################
67##
68#S  RCWA(R) and CT(R). //////////////////////////////////////////////////////
69##
70#############################################################################
71
72#############################################################################
73##
74#O  RCWACons( <R> ) . . . . . . . . . . . . . . . . . .  RCWA( R ) for ring R
75#F  RCWA( <R> )
76##
77DeclareConstructor( "RCWACons", [ IsRcwaGroup, IsRing ] );
78DeclareConstructor( "RCWACons", [ IsRcwaGroup, IsRowModule ] );
79DeclareGlobalFunction( "RCWA" );
80
81#############################################################################
82##
83#P  IsNaturalRCWA( <G> ) . . . . . . . . . . . . . . . . . . . . .  RCWA( R )
84#P  IsNaturalRCWA_Z( <G> ) . . . . . . . . . . . . . . . . . . . .  RCWA( Z )
85#P  IsNaturalRCWA_ZxZ( <G> ) . . . . . . . . . . . . . . . . . .  RCWA( Z^2 )
86#P  IsNaturalRCWA_Z_pi( <G> )  . . . . . . . . . . . . . . . . RCWA( Z_(pi) )
87#P  IsNaturalRCWA_GFqx( <G> )  . . . . . . . . . . . . . . . RCWA( GF(q)[x] )
88##
89DeclareProperty( "IsNaturalRCWA", IsRcwaGroup );
90DeclareProperty( "IsNaturalRCWA_Z", IsRcwaGroup );
91DeclareProperty( "IsNaturalRCWA_ZxZ", IsRcwaGroup );
92DeclareProperty( "IsNaturalRCWA_Z_pi", IsRcwaGroup );
93DeclareProperty( "IsNaturalRCWA_GFqx", IsRcwaGroup );
94
95#############################################################################
96##
97#F  NrConjugacyClassesOfRCWAZOfOrder( <ord> ) . #Ccl of RCWA(Z) / order <ord>
98#F  NrConjugacyClassesOfCTZOfOrder( <ord> ) . . . #Ccl of CT(Z) / order <ord>
99##
100##  Returns the number of conjugacy classes of the whole group RCWA(Z),
101##  respectively CT(Z), of elements of order <ord>. The latter assumes the
102##  conjecture that CT(Z) is the setwise stabilizer of N_0 in RCWA(Z).
103##
104DeclareGlobalFunction( "NrConjugacyClassesOfRCWAZOfOrder" );
105DeclareGlobalFunction( "NrConjugacyClassesOfCTZOfOrder" );
106
107#############################################################################
108##
109#A  Sign( <g> ) . . . . . . . . . . . .  sign of the element <g> of RCWA( Z )
110##
111##  The *sign* of the rcwa permutation <g>.
112##  The sign mapping is an epimorphism from RCWA(Z) to U(Z) = <-1> = C_2.
113##
114DeclareAttribute( "Sign", IsRcwaMapping );
115
116#############################################################################
117##
118#A  SignInOddCTPZ( <g> ) . . .  sign of <g> as element of CT_P(Z), 2 \notin P
119##
120##  The *sign* of the element <g> of CT_P(Z), where P does not contain 2.
121##  This sign mapping is an epimorphism from CT_P(Z) to U(Z) = <-1> = C_2.
122##  Since there is no such epimorphism if P contains 2, the prime set of <g>
123##  must not contain 2.
124##
125DeclareAttribute( "SignInOddCTPZ", IsRcwaMappingOfZ );
126
127#############################################################################
128##
129#O  CTCons( <R> ) . . . . . . . . . . . . . . . . . . . .  CT( R ) for ring R
130#O  CTCons( <P>, <R> )  . . . . . . . . . . . . . . . . CT( P, R ) for ring R
131#F  CT( <R> )
132#F  CT( <P>, <R> )
133##
134DeclareConstructor( "CTCons", [ IsRcwaGroup, IsRing ] );
135DeclareConstructor( "CTCons", [ IsRcwaGroup, IsList, IsRing ] );
136DeclareConstructor( "CTCons", [ IsRcwaGroup, IsRowModule ] );
137DeclareGlobalFunction( "CT" );
138
139#############################################################################
140##
141#P  IsNaturalCT( <G> ) . . . . . . . . . . . . . . . . . . . . . . .  CT( R )
142#P  IsNaturalCT_Z( <G> ) . . . . . . . . . . . . . . . . . . . . . .  CT( Z )
143#P  IsNaturalCTP_Z( <G> )  . . . . . . . . . . . . . . . . . . . . CT( P, Z )
144#P  IsNaturalCT_ZxZ( <G> ) . . . . . . . . . . . . . . . . . . . .  CT( Z^2 )
145#P  IsNaturalCT_Z_pi( <G> )  . . . . . . . . . . . . . . . . . . CT( Z_(pi) )
146#P  IsNaturalCT_GFqx( <G> )  . . . . . . . . . . . . . . . . . CT( GF(q)[x] )
147##
148DeclareProperty( "IsNaturalCT", IsRcwaGroup );
149DeclareProperty( "IsNaturalCT_Z", IsRcwaGroup );
150DeclareProperty( "IsNaturalCTP_Z", IsRcwaGroup );
151DeclareProperty( "IsNaturalCT_ZxZ", IsRcwaGroup );
152DeclareProperty( "IsNaturalCT_Z_pi", IsRcwaGroup );
153DeclareProperty( "IsNaturalCT_GFqx", IsRcwaGroup );
154
155#############################################################################
156##
157#F  AllElementsOfCTZWithGivenModulus( m ) .  elements of CT(Z) with modulus m
158##
159##  Returns a list of all elements of CT(Z) with modulus m, under the
160##  assumption of the conjecture that CT(Z) is the setwise stabilizer of the
161##  nonnegative integers in RCWA(Z).
162##
163DeclareGlobalFunction( "AllElementsOfCTZWithGivenModulus" );
164
165#############################################################################
166##
167#A  DecompositionIntoPermutationalAndOrderPreservingElement( <g> )
168##
169DeclareAttribute( "DecompositionIntoPermutationalAndOrderPreservingElement",
170                  IsRcwaMapping );
171
172#############################################################################
173##
174#P  IsNaturalRCWA_OR_CT( <G> ) . . . . . . . . . . . . . RCWA( R ) or CT( R )
175##
176DeclareProperty( "IsNaturalRCWA_OR_CT", IsRcwaGroup );
177
178#############################################################################
179##
180#S  Constructing rcwa groups. ///////////////////////////////////////////////
181##
182#############################################################################
183
184#############################################################################
185##
186#O  IsomorphismRcwaGroup( <G>, <R> ) . .  rcwa representation of <G> over <R>
187#O  IsomorphismRcwaGroup( <G>, <cl> )  . . rcwa representation of <G> on <cl>
188#O  IsomorphismRcwaGroup( <G> )  . . . . .  rcwa representation of <G> over Z
189#A  IsomorphismRcwaGroupOverZ( <G> ) . . . . . .  the corresponding attribute
190##
191##  Returns a faithful rcwa representation of the group <G> over
192##  the ring <R>, respectively over Z.
193##
194DeclareOperation( "IsomorphismRcwaGroup", [ IsGroup, IsRing ] );
195DeclareOperation( "IsomorphismRcwaGroup", [ IsGroup, IsResidueClass ] );
196DeclareOperation( "IsomorphismRcwaGroup", [ IsGroup ] );
197DeclareAttribute( "IsomorphismRcwaGroupOverZ", IsGroup );
198
199#############################################################################
200##
201#O  Restriction( <g>, <f> ) . . . . . . . . . . . . restriction of <g> by <f>
202#O  Restriction( <M>, <f> ) . . . . . . . . . . . . restriction of <M> by <f>
203##
204##  Returns the *restriction* of the rcwa mapping <g> resp. rcwa monoid <M>
205##  by (i.e. to the image of) the rcwa mapping <f>. The mapping <f> must be
206##  injective.
207##
208DeclareOperation( "Restriction", [ IsRcwaMapping, IsRcwaMapping ] );
209DeclareOperation( "Restriction", [ IsRcwaMonoid, IsRcwaMapping ] );
210
211#############################################################################
212##
213#O  Induction( <g>, <f> ) . . . . . . . . . . . . . . induction of <g> by <f>
214#O  Induction( <M>, <f> ) . . . . . . . . . . . . . . induction of <M> by <f>
215##
216##  Returns the *induction* of the rcwa mapping <g> resp. the rcwa monoid <M>
217##  by the rcwa mapping <f>.
218##
219##  The mapping <f> must be injective. In the first case, the support of <g>
220##  and its images under powers of <g> must be subsets of the image of <f>.
221##  In the second case, the support of <M> and its images under all elements
222##  of <M> must be subsets of the image of <f>. If <M> is an rcwa group, the
223##  latter simplifies to the condition that the support of <M> is a subset of
224##  the image of <f>.
225##
226##  We have Induction( Restriction( <g>, <f> ), <f> ) = <g> as well as
227##  Induction( Restriction( <M>, <f> ), <f> ) = <M>. Therefore induction is
228##  the right inverse of restriction.
229##
230DeclareOperation( "Induction", [ IsRcwaMapping, IsRcwaMapping ] );
231DeclareOperation( "Induction", [ IsRcwaMonoid, IsRcwaMapping ] );
232
233#############################################################################
234##
235#O  Mirrored( <f> ) . .  conjugate of the rcwa mapping <f> under n |-> -n - 1
236#O  Mirrored( <M> ) . .  conjugate of the rcwa monoid  <M> under n |-> -n - 1
237##
238##  The conjugate of an rcwa mapping <f> or an rcwa monoid <M> under the per-
239##  mutation n |-> -n - 1 acts on the nonnegative integers as <f>, respec-
240##  tively, <M> does on the negative integers, and vice versa.
241##
242DeclareOperation( "Mirrored", [ IsRcwaMappingOfZ ] );
243DeclareOperation( "Mirrored", [ IsRcwaMonoidOverZ ] );
244
245#############################################################################
246##
247#F  GroupByResidueClasses( <classes> ) . . . . . .  group permuting <classes>
248##
249##  Returns the group which is generated by all class transpositions which
250##  interchange disjoint residue classes in <classes>.
251##
252##  The argument <classes> must be a list of residue classes.
253##
254##  Examples: If the residue classes in <classes> are pairwise disjoint, then
255##            the returned group is the symmetric group on <classes>.
256##            If every class in <classes> has nontrivial intersection with
257##            every other class, then the returned group is trivial.
258##
259##  In many cases, the returned group is infinite.
260##
261DeclareGlobalFunction( "GroupByResidueClasses" );
262
263#############################################################################
264##
265#O  MergerExtension( <G>, <points>, <point> )
266##
267##  Thinking of the moved points of the finite permutation group <G> being
268##  infinite sets themselves, this operation returns a group isomorphic
269##  to <G,g>, where g is an involution which interchanges the union of the
270##  points in <points> and the point <point>.
271##
272##  The arguments are a finite permutation group <G>, a set <points> of
273##  points moved by <G> and a single point <point> moved by <G> which is not
274##  in <points>.
275##
276DeclareOperation( "MergerExtension", [ IsPermGroup, IsList, IsPosInt ] );
277
278#############################################################################
279##
280#S  The action of an rcwa group on the underlying ring. /////////////////////
281##
282#############################################################################
283
284#############################################################################
285##
286#C  IsRcwaGroupOrbit . . . category of orbits under the action of rcwa groups
287##
288##  The category of all orbits under the action of rcwa groups which are
289##  neither represented as lists nor as residue class unions.
290##
291DeclareCategory( "IsRcwaGroupOrbit", IsListOrCollection );
292
293#############################################################################
294##
295#A  UnderlyingGroup( <orbit> ) . . . . . . . . . underlying group of an orbit
296##
297DeclareAttribute( "UnderlyingGroup", IsRcwaGroupOrbit );
298
299#############################################################################
300##
301#R  IsRcwaGroupOrbitStandardRep . . . . . "standard" representation of orbits
302##
303DeclareRepresentation( "IsRcwaGroupOrbitStandardRep",
304                       IsComponentObjectRep and IsAttributeStoringRep,
305                       [ "group", "representative", "action" ] );
306
307#############################################################################
308##
309#R  IsRcwaGroupOrbitsIteratorRep . .  repr. of iterators of rcwa group orbits
310##
311DeclareRepresentation( "IsRcwaGroupOrbitsIteratorRep",
312                       IsComponentObjectRep,
313                       [ "orbit", "sphere", "oldsphere", "pos" ] );
314
315#############################################################################
316##
317#O  GrowthFunctionOfOrbit( <G>, <n>, <r_max>, <size_max> )
318#O  GrowthFunctionOfOrbit( <orbit>, <r_max>, <size_max> )
319##
320##  Returns a list whose (r+1)-th entry is the size of the sphere of radius r
321##  about <n> under the action of the group <G>.
322##
323##  The argument <r_max> is the largest possible radius to be considered,
324##  and the computation stops once the sphere size exceeds <size_max>.
325##
326##  In place of the arguments <G> and <n>, one can also supply an orbit
327##  object.
328##
329DeclareOperation( "GrowthFunctionOfOrbit",
330                  [ IsGroup, IsObject, IsPosInt, IsPosInt ] );
331DeclareOperation( "GrowthFunctionOfOrbit",
332                  [ IsListOrCollection, IsPosInt, IsPosInt ] );
333
334#############################################################################
335##
336#O  CyclesOnFiniteOrbit( <G>, <g>, <n> ) . . . cycles of <g> on orbit <n>^<G>
337##
338##  Returns a list of all cycles of the rcwa permutation <g> on the orbit
339##  of the point <n> under the action of the rcwa group <G>. It is assumed
340##  that <g> is an element of <G>, and that the orbit of <n> under the action
341##  of <G> is finite. These conditions are not checked.
342##
343DeclareOperation( "CyclesOnFiniteOrbit",
344                  [ IsRcwaGroup, IsRcwaMapping, IsObject ] );
345
346#############################################################################
347##
348#O  IsTransitive( <G>, <S> ) . . . . . . . . . . . . . . . .  for rcwa groups
349#O  Transitivity( <G>, <S> )
350#O  IsPrimitive( <G>, <S> )
351##
352DeclareOperation( "IsTransitive", [ IsRcwaGroup, IsListOrCollection ] );
353DeclareOperation( "Transitivity", [ IsRcwaGroup, IsListOrCollection ] );
354DeclareOperation( "IsPrimitive",  [ IsRcwaGroup, IsListOrCollection ] );
355
356#############################################################################
357##
358#P  IsTransitiveOnNonnegativeIntegersInSupport( <G> )
359##
360##  Returns true or false, depending on whether the action of the rcwa group
361##  G < RCWA(Z) on the set of its nonnegative moved points is transitive.
362##  As such transitivity test is a computationally hard problem, methods may
363##  fail or run into an infinite loop.
364##
365DeclareProperty( "IsTransitiveOnNonnegativeIntegersInSupport",
366                 IsRcwaGroupOverZ );
367
368#############################################################################
369##
370#O  TryIsTransitiveOnNonnegativeIntegersInSupport( <G>, <searchlimit> )
371##
372##  This operation tries to figure out whether the action of the group
373##  G < RCWA(Z) on the set of its nonnegative moved points is transitive.
374##  It returns a string briefly describing the situation. If the determina-
375##  tion of transitivity is successful, the property `IsTransitiveOnNonnega-
376##  tiveIntegersInSupport' is set accordingly. The argument <searchlimit>
377##  is a bound on the efforts to be made -- more precisely, this is the
378##  maximum search radius for a smaller point in a sphere about a point.
379##
380DeclareOperation( "TryIsTransitiveOnNonnegativeIntegersInSupport",
381                  [ IsRcwaGroupOverZ, IsPosInt ] );
382
383#############################################################################
384##
385#A  TransitivityCertificate( <G> )
386##
387##  Given an rcwa group <G> over Z which acts transitively on the set of
388##  nonnegative integers in its support, this attribute is a record
389##  containing components 'phi', 'words' and 'classes' as follows:
390##
391##  - 'phi' is an epimorphism from a free group to <G> which maps generators
392##    to generators.
393##
394##  - 'words' is a list, where words[i] is a preimage under phi of an element
395##    of <G> which maps all sufficiently large positive integers in the
396##    residue classes classes[i] to smaller integers.
397##
398##  There are no methods installed for `TransitivityCertificate' -- attribute
399##  values are computed with `TryToComputeTransitivityCertificate'.
400##
401DeclareAttribute( "TransitivityCertificate", IsRcwaGroup );
402
403#############################################################################
404##
405#O  TryToComputeTransitivityCertificate( <G>, <searchlimit> )
406#O  SimplifiedCertificate( <cert> )
407##
408##  The operation `TryToComputeTransitivityCertificate' tries to compute a
409##  "transitivity certificate" as described above for the action of the rcwa
410##  group <G> over Z on the set of nonnegative integers in its support. Of
411##  course this can be successful only if this action is indeed transitive.
412##  The argument <searchlimit> is the largest radius of a ball about a point
413##  within which smaller points are looked for and taken into consideration.
414##  The computed certificate is returned.
415##
416##  The operation `SimplifiedCertificate' tries to simplify the transitivity
417##  certificate <cert> by removing redundant words.
418##  The simplified certificate is returned.
419##
420DeclareOperation( "TryToComputeTransitivityCertificate",
421                  [ IsRcwaGroup, IsPosInt ] );
422DeclareOperation( "SimplifiedCertificate", [ IsRecord ] );
423
424#############################################################################
425##
426#O  DistanceToNextSmallerPointInOrbit( <G>, <n> )
427##
428##  Returns the smallest number d such that there is a product g of d genera-
429##  tors or inverses of generators of <G> which maps <n> to an integer with
430##  absolute value less than |<n>|.
431##
432DeclareOperation( "DistanceToNextSmallerPointInOrbit", [ IsGroup, IsInt ] );
433
434#############################################################################
435##
436#O  ShortResidueClassOrbits( <G>, <modulusbound>, <maxlng> )
437##
438##  Returns a list of all orbits of residue classes of the rcwa group <G>
439##  which contain a residue class r(m) such that m divides <modulusbound>,
440##  and which are not longer than <maxlng>.
441##
442DeclareOperation( "ShortResidueClassOrbits", [ IsRcwaGroup, IsRingElement,
443                                               IsPosInt ] );
444
445#############################################################################
446##
447#O  StabilizerOp( <G>, <n> ) . . . . . . .  point stabilizer in an rcwa group
448#O  StabilizerOp( <G>, <S>, <action> ) . . .  set stabilizer in an rcwa group
449#A  StabilizerInfo( <G> ) . .  info. on what is stabilized under which action
450##
451DeclareOperation( "StabilizerOp", [ IsRcwaGroup, IsRingElement ] );
452DeclareOperation( "StabilizerOp", [ IsRcwaGroup, IsListOrCollection ] );
453DeclareOperation( "StabilizerOp", [ IsRcwaGroup, IsListOrCollection,
454                                    IsFunction ] );
455DeclareAttribute( "StabilizerInfo", IsRcwaGroup );
456
457#############################################################################
458##
459#O  RepresentativeActionOp( <G>, <src>, <dest>, <act> )
460##
461DeclareOperation( "RepresentativeActionOp",
462                  [ IsGroup, IsObject, IsObject, IsFunction ] );
463
464#############################################################################
465##
466#O  RepresentativeActionPreImage( <G>, <src>, <dest>, <act>, <F> )
467#O  RepresentativesActionPreImage( <G>, <src>, <dest>, <act>, <F> )
468##
469##  Returns a preimage, respectively a list of preimages, of an element of
470##  <G> which maps <src> to <dest> under the natural projection from the
471##  free group <F> onto <G>. The rank of <F> must be equal to the number of
472##  generators of <G>. Often, finding several representatives of the preimage
473##  is not harder than computing just one.
474##
475DeclareOperation( "RepresentativeActionPreImage",
476                  [ IsGroup, IsObject, IsObject, IsFunction, IsFreeGroup ] );
477DeclareOperation( "RepresentativesActionPreImage",
478                  [ IsGroup, IsObject, IsObject, IsFunction, IsFreeGroup ] );
479
480#############################################################################
481##
482#O  OrbitUnion( <G>, <S> ) . . . . . . .  union of the orbit of <S> under <G>
483##
484##  Returns the union of the elements of the orbit of the set <S> under the
485##  rcwa group <G>. In particular, <S> can be a union of residue classes.
486##
487DeclareOperation( "OrbitUnion", [ IsRcwaGroup, IsListOrCollection ] );
488
489#############################################################################
490##
491#O  ProjectionsToInvariantUnionsOfResidueClasses( <G>, <m> )
492##
493##  Projections of the rcwa group <G> to unions of residue classes (mod m)
494##  which it fixes setwise.
495##
496DeclareOperation( "ProjectionsToInvariantUnionsOfResidueClasses",
497                  [ IsRcwaGroup, IsRingElement ] );
498
499#############################################################################
500##
501#O  CollatzLikeMappingByOrbitTree( <G>, <root>, <min_r>, <max_r> )
502##
503##  This operation is so far undocumented since its meaning has yet to be
504##  settled.
505##
506DeclareOperation( "CollatzLikeMappingByOrbitTree",
507                  [ IsRcwaGroup, IsRingElement, IsPosInt, IsPosInt ] );
508
509#############################################################################
510##
511#F  DrawOrbitPicture( <G>, <p0>, <r>, <height>, <width>, <colored>,
512#F                    <palette>, <filename> )
513##
514##  Draws a picture of the orbit(s) of the point(s) <p0> under the action of
515##  the group <G> on Z^2.
516##
517##  The argument <p0> is either one point or a list of points. The argument
518##  <r> denotes the radius of the ball around <p0> to be computed. The size
519##  of the created picture is <height>x<width> pixels. The argument <colored>
520##  is a boolean which specifies whether a 24-bit True Color picture or a
521##  monochrome picture should be created. In the former case, <palette> must
522##  be a list of triples of integers in the range 0..255, denoting the RGB
523##  values of colors to be used. In the latter case, the argument <palette>
524##  is not used, and any value can be passed.
525##
526##  The resulting picture is written in bitmap- (bmp-) format to a file named
527##  <filename>. The filename should include the entire pathname.
528##
529DeclareGlobalFunction( "DrawOrbitPicture" );
530
531#############################################################################
532##
533#S  Tame rcwa groups and respected partitions. //////////////////////////////
534##
535#############################################################################
536
537#############################################################################
538##
539#A  RespectedPartition( <G> ) . . . . . . . . . . . . . . respected partition
540#A  RespectedPartition( <sigma> )
541##
542##  A partition of the base ring R into a finite number of residue classes
543##  on which the rcwa group <G> acts as a permutation group, and on whose
544##  elements all elements of <G> are affine. Provided that R has a residue
545##  class ring of cardinality 2, such a partition exists if and only if <G>
546##  is tame. The respected partition of a bijective rcwa mapping <sigma> is
547##  defined as the respected partition of the cyclic group generated by
548##  <sigma>.
549##
550DeclareAttribute( "RespectedPartition", IsRcwaGroup );
551DeclareAttribute( "RespectedPartition", IsRcwaMapping );
552
553#############################################################################
554##
555#O  RespectsPartition( <G>, <P> )
556#O  RespectsPartition( <sigma>, <P> )
557##
558##  Checks whether the rcwa group <G> resp. the rcwa permutation <sigma>
559##  respects the partition <P>.
560##
561DeclareOperation( "RespectsPartition", [ IsObject, IsList ] );
562
563#############################################################################
564##
565#A  ActionOnRespectedPartition( <G> ) .  action of <G> on respected partition
566##
567##  The action of the tame group <G> on its stored respected partition.
568##
569DeclareAttribute( "ActionOnRespectedPartition", IsRcwaGroup );
570
571#############################################################################
572##
573#A  KernelOfActionOnRespectedPartition( <G> )
574#A  RankOfKernelOfActionOnRespectedPartition( <G> )
575##
576##  The kernel of the action of <G> on the stored respected partition,
577##  resp. the rank of the largest free abelian group fitting into it.
578##  The group <G> must be tame.
579##
580DeclareAttribute( "KernelOfActionOnRespectedPartition", IsRcwaGroup );
581DeclareAttribute( "RankOfKernelOfActionOnRespectedPartition", IsRcwaGroup );
582
583#############################################################################
584##
585#A  RefinedRespectedPartitions( <G> )
586#A  KernelActionIndices( <G> )
587##
588##  Refinements of the stored respected partition P of <G>, resp. the orders
589##  of the permutation groups induced by the kernel of the action of <G> on P
590##  on these refinements.
591##
592DeclareAttribute( "RefinedRespectedPartitions", IsRcwaGroup );
593DeclareAttribute( "KernelActionIndices", IsRcwaGroup );
594
595#############################################################################
596##
597#A  IsomorphismMatrixGroup( <G> ) . . . . . . .  matrix representation of <G>
598##
599##  A linear representation of the rcwa group <G> over the quotient field of
600##  its underlying ring.
601##
602##  Tame rcwa groups have linear representations over the quotient field of
603##  their underlying ring. There is such a representation whose degree is
604##  twice the length of a respected partition.
605##
606DeclareAttribute( "IsomorphismMatrixGroup", IsGroup );
607
608#############################################################################
609##
610#A  IntegralConjugate( <g> ) . . . . . . . . . . .  integral conjugate of <g>
611#A  IntegralConjugate( <G> ) . . . . . . . . . . .  integral conjugate of <G>
612#A  IntegralizingConjugator( <g> ) . . . . . . . mapping x: <g>^x is integral
613#A  IntegralizingConjugator( <G> ) . . . . . . . mapping x: <G>^x is integral
614##
615##  Some integral conjugate of the rcwa mapping <g> resp. rcwa group <G>
616##  in RCWA(R).
617##
618##  Such a conjugate exists always if <g> is a tame bijective rcwa mapping
619##  respectively if <G> is a tame rcwa group, and if the underlying ring R
620##  has residue class rings of any finite cardinality. Integral conjugates
621##  are of course not unique.
622##
623DeclareAttribute( "IntegralConjugate", IsRcwaMapping );
624DeclareAttribute( "IntegralConjugate", IsRcwaGroup );
625DeclareAttribute( "IntegralizingConjugator", IsRcwaMapping );
626DeclareAttribute( "IntegralizingConjugator", IsRcwaGroup );
627
628#############################################################################
629##
630#A  StandardConjugate( <g> ) . .  standard rep. of the conjugacy class of <g>
631#A  StandardConjugate( <G> ) . .  standard rep. of the conjugacy class of <G>
632#A  StandardizingConjugator( <g> ) . . . . . . . mapping x: <g>^x is standard
633#A  StandardizingConjugator( <G> ) . . . . . . . mapping x: <G>^x is standard
634##
635##  The "standard conjugate" is some "nice" canonical representative of the
636##  conjugacy class of RCWA(R) which the bijective rcwa mapping <g> resp. the
637##  rcwa group <G> belongs to. Two rcwa mappings / rcwa groups are conjugate
638##  in RCWA(R) if and only if their "standard conjugates" are the same. Such
639##  standard class representatives are currently only defined in rare cases.
640##
641DeclareAttribute( "StandardConjugate", IsRcwaMapping );
642DeclareAttribute( "StandardConjugate", IsRcwaGroup );
643DeclareAttribute( "StandardizingConjugator", IsRcwaMapping );
644DeclareAttribute( "StandardizingConjugator", IsRcwaGroup );
645
646#############################################################################
647##
648#O  CompatibleConjugate( <g>, <h> ) . . . . . . . . . .  compatible conjugate
649##
650##  Returns an rcwa permutation <h>^r such that there is a partition which is
651##  respected by both <g> and <h>^r, hence such that the group generated by
652##  <g> and <h>^r is tame. Methods may choose any such mapping.
653##
654DeclareOperation( "CompatibleConjugate", [ IsRcwaMapping, IsRcwaMapping ] );
655
656#############################################################################
657##
658#F  CommonRefinementOfPartitionsOfR_NC( <partitions> ) . . . . . general case
659#F  CommonRefinementOfPartitionsOfZ_NC( <partitions> ) . . special case R = Z
660##
661##  Returns the coarsest common refinement of the list <partitions> of
662##  partitions of Z, respectively a ring R, into unions of residue classes.
663##  Here the term "common refinement" means that each set in the returned
664##  partition is a subset of exactly one set in each of the partitions in
665##  <partitions>. The ring R may be any base ring supported by RCWA.
666##  For R = Z the last-mentioned function is more efficient.
667##
668DeclareGlobalFunction( "CommonRefinementOfPartitionsOfR_NC" );
669DeclareGlobalFunction( "CommonRefinementOfPartitionsOfZ_NC" );
670
671#############################################################################
672##
673#O  RefinementSequence( <G>, <maxlng>, <maxparts> )
674##
675##  Returns a sequence P of partitions of the base ring of <G> as follows:
676##
677##  - P[1] is the return value of `CommonRefinementOfPartitionsOfR_NC' when
678##    called for the list of respected partitions of the generators of <G>.
679##
680##  - For k > 1, P[k] is what `CommonRefinementOfPartitionsOfR_NC' returns
681##    when called for the list of images of P[k-1] under the generators of
682##    <G> (plus the identity).
683##
684##  The sequence is returned once its length reaches <maxlng> or the length
685##  of a partition exceeds <maxparts>.
686##
687DeclareOperation( "RefinementSequence",
688                  [ IsRcwaGroup, IsPosInt, IsPosInt ] );
689
690#############################################################################
691##
692#P  IsNaturalRcwaRepresentationOfGLOrSL
693##
694DeclareProperty( "IsNaturalRcwaRepresentationOfGLOrSL",
695                  IsGroupHomomorphism and IsBijective );
696
697#############################################################################
698##
699#S  Words, free groups and fp groups. ///////////////////////////////////////
700##
701#############################################################################
702
703#############################################################################
704##
705#O  EpimorphismsUpToAutomorphisms( G, H )
706##
707##  Epimorphisms from <G> to <H>, up to automorphisms of <H>.
708##
709DeclareOperation( "EpimorphismsUpToAutomorphisms", [ IsGroup, IsGroup ] );
710
711#############################################################################
712##
713#F  ReducedWordByOrdersOfGenerators( <w>, <gensords> )
714##
715##  Given a word <w>, this function returns the word obtained from <w> by
716##  reducing the exponents of powers of generators modulo their orders, as
717##  specified in the list <gensords>.
718##
719DeclareGlobalFunction( "ReducedWordByOrdersOfGenerators" );
720
721#############################################################################
722##
723#O  NormalizedRelator( <w>, <gensords> )
724##
725##  Given a word <w>, this operation returns its normal form obtained by
726##
727##    1. reducing the exponents of powers of generators modulo their orders,
728##       as specified in the list <gensords>,
729##    2. cyclic reduction and
730##    3. cyclic conjugation to the lexicographically smallest such conjugate.
731##
732##  As the name of the operation suggests, the main purpose of this operation
733##  is to get the relators in a finite presentation short and nice, and to be
734##  able to spot and remove redundant relators in easy cases.
735##
736DeclareOperation( "NormalizedRelator", [ IsAssocWord, IsList ] );
737
738#############################################################################
739##
740#A  RankOfFreeGroup( <Fn> )
741##
742DeclareAttribute( "RankOfFreeGroup", IsRcwaGroup );
743
744#############################################################################
745##
746#O  EpimorphismFromFpGroup( <G>, <r> ) . .  epimorphism from an fp group to G
747#O  EpimorphismFromFpGroup( <G>, <r>, <maxparts> )
748##
749##  Returns an epimorphism from a finitely presented group to the group <G>
750##  The argument <r> denotes the radius of the ball around 1 which should be
751##  searched for relations. If the optional argument <maxparts> is given, it
752##  limits the search space to elements with at most <maxparts> affine parts.
753##
754DeclareOperation( "EpimorphismFromFpGroup",
755                  [ IsFinitelyGeneratedGroup, IsPosInt ] );
756DeclareOperation( "EpimorphismFromFpGroup",
757                  [ IsFinitelyGeneratedGroup, IsPosInt, IsPosInt ] );
758
759#############################################################################
760##
761#O  PreImagesRepresentatives( <map>, <elm> ) . . . .  several representatives
762##
763##  This is an analogon to `PreImagesRepresentative', which returns a list
764##  of possibly several representatives if computing these is not harder than
765##  computing just one representative.
766##
767DeclareOperation( "PreImagesRepresentatives",
768                  [ IsGeneralMapping, IsObject ] );
769
770#############################################################################
771##
772#S  Data libraries. /////////////////////////////////////////////////////////
773##
774#############################################################################
775
776#############################################################################
777##
778#F  LoadRCWAExamples( ) . . . . . . . . . . . . . . .  load examples database
779##
780##  This function loads RCWA's collection of examples.
781##  It returns a record containing the individual examples as components.
782##
783DeclareGlobalFunction( "LoadRCWAExamples" );
784DeclareSynonym( "RCWALoadExamples", LoadRCWAExamples );
785
786#############################################################################
787##
788#F  LoadDatabaseOfProductsOf2ClassTranspositions( )
789##
790##  This function loads the data library of products of 2 class transposi-
791##  tions which interchange residue classes with moduli <= 6.
792##  It returns a record containing all data in the library.
793##
794DeclareGlobalFunction( "LoadDatabaseOfProductsOf2ClassTranspositions" );
795
796#############################################################################
797##
798#F  LoadDatabaseOfNonbalancedProductsOfClassTranspositions( )
799##
800##  This function loads the data library of nonbalanced products of class
801##  transpositions. It returns a record containing all data in the library.
802##  Note that name and contents of this library will likely be changed in
803##  the future.
804##
805DeclareGlobalFunction(
806  "LoadDatabaseOfNonbalancedProductsOfClassTranspositions" );
807
808#############################################################################
809##
810#F  LoadDatabaseOfGroupsGeneratedBy3ClassTranspositions( )
811##
812##  This function loads the data library of groups generated by 3 class
813##  transpositions which interchange residue classes with moduli <= 6.
814##  It returns a record containing all data in the library.
815##
816DeclareGlobalFunction(
817  "LoadDatabaseOfGroupsGeneratedBy3ClassTranspositions" );
818
819#############################################################################
820##
821#F  LoadDatabaseOfGroupsGeneratedBy4ClassTranspositions( )
822##
823##  This function loads the data library of groups generated by 4 class
824##  transpositions which interchange residue classes with moduli <= 6.
825##  It returns a record containing all data in the library.
826##
827DeclareGlobalFunction(
828  "LoadDatabaseOfGroupsGeneratedBy4ClassTranspositions" );
829
830#############################################################################
831##
832#F  LoadDatabaseOfCTGraphs( )
833##
834##  This function loads the database of realizations of finite graphs as
835##  'class transposition graphs' -- the vertices are class transpositions,
836##  and there is an edge connecting two vertices iff their product has finite
837##  order, or equivalently, iff both vertices respect a common partition.
838##
839DeclareGlobalFunction( "LoadDatabaseOfCTGraphs" );
840
841#############################################################################
842##
843#E  rcwagrp.gd . . . . . . . . . . . . . . . . . . . . . . . . . .  ends here
844