CoCalc -- GAP_present.c

Real-time collaboration for Jupyter Notebooks, Linux Terminals, LaTeX, VS Code, R IDE, and more,
all in one place.

GAP 4.8.9 installation with standard packages -- copy to your CoCalc project to get it
Project: cocalc-sagemath-dev-slelievre
Path: gap4r8 / pkg / anupq-3.2 / src / GAP_present.c
Views: ⁴¹⁸³⁴⁶
1
/****************************************************************************
2
**
3
*A  GAP_present.c               ANUPQ source                   Eamonn O'Brien
4
*A                                                             & Frank Celler
5
*A                                                           & Benedikt Rothe
6
**
7
*Y  Copyright 1995-1997,  Lehrstuhl D fuer Mathematik,  RWTH Aachen,  Germany
8
*Y  Copyright 1995-1997,  School of Mathematical Sciences, ANU,     Australia
9
**
10
*/
11
#include "pq_defs.h"
12
#include "pcp_vars.h"
13
#include "pga_vars.h"
14
#include "constants.h"
15
#include "pq_functions.h"
16
#include "menus.h"
17

18

19
/****************************************************************************
20
**
21
*F  print_GAP_word
22
**                                     print out a word of a pcp presentation
23
*/
24
void print_GAP_word(FILE *file, int ptr, struct pcp_vars *pcp)
25
{
26
   register int *y = y_address;
27

28
   int gen, exp;
29
   int i;
30
   int count;
31
#include "access.h"
32

33
   if (ptr == 0)
34
      fprintf(file, " One(F)");
35
   else if (ptr > 0)
36
      fprintf(file, " F.%d", ptr);
37
   else {
38
      ptr = -ptr + 1;
39
      count = y[ptr];
40
      fprintf(file, " %s", (1 < count) ? "(" : "");
41
      for (i = 1; i <= count; i++) {
42
         exp = FIELD1(y[ptr + i]);
43
         gen = FIELD2(y[ptr + i]);
44
         fprintf(file, "F.%d", gen);
45
         if (exp != 1)
46
            fprintf(file, "^%d", exp);
47
         if (i != count)
48
            fprintf(file, "*");
49
      }
50
      if (1 < count)
51
         fprintf(file, ")");
52
   }
53
}
54

55

56
/****************************************************************************
57
**
58
*F  GAP_presentation
59
**                                write pq presentation to file in GAP format
60
*/
61
void GAP_presentation(FILE *file, struct pcp_vars *pcp, int aspcgroup)
62
{
63
   register int *y = y_address;
64

65
   int i;
66
   int j;
67
   int k;
68
   int l;
69
   int p1;
70
   int p2;
71
   int weight;
72
   int comma;
73
   int ndgen = pcp->ndgen;
74
   int dgen = pcp->dgen;
75

76
#include "access.h"
77

78
   /* construct a free group with enough generators                       */
79
   fprintf(file, "F := FreeGroup( %d );\n", pcp->lastg);
80

81
   if (aspcgroup) {
82
      fprintf(file, "F := PcGroupFpGroupNC( F / [\n");
83
   } else
84
      fprintf(file, "F := F / [\n");
85

86
   /* write power-relators with possible non-trivial rhs                  */
87
   comma = 0;
88
   k = y[pcp->clend + pcp->cc - 1];
89
   for (i = 1; i <= k; i++) {
90
      if (comma)
91
         fprintf(file, ",\n");
92
      else
93
         comma = 1;
94
      p2 = y[pcp->ppower + i];
95
      if (p2 == 0)
96
         fprintf(file, " F.%d^%d", i, pcp->p);
97
      else {
98
         fprintf(file, " F.%d^%d /", i, pcp->p);
99
         print_GAP_word(file, p2, pcp);
100
      }
101
   }
102

103
   /* write power-relators with trivial rhs                               */
104
   for (i = k + 1; i <= pcp->lastg; ++i) {
105
      if (comma)
106
         fprintf(file, ",\n");
107
      else
108
         comma = 1;
109
      fprintf(file, " F.%d^%d", i, pcp->p);
110
   }
111

112
   /* write commutator-relators                                           */
113
   for (i = 2; i <= k; i++) {
114
      weight = WT(y[pcp->structure + i]);
115
      p1 = y[pcp->ppcomm + i];
116
      l = MIN(i - 1, y[pcp->clend + pcp->cc - weight]);
117
      for (j = 1; j <= l; j++) {
118
         p2 = y[p1 + j];
119
         if (p2 != 0) {
120
            fprintf(file, ",\n");
121
            fprintf(file, " Comm( F.%d, F.%d ) /", i, j);
122
            print_GAP_word(file, p2, pcp);
123
         }
124
      }
125
   }
126

127
   if (aspcgroup)
128
      fprintf(file, "] );\n");
129
   else
130
      fprintf(file, "];\n");
131

132
   /* store the relation between pc gens and fp gens                      */
133
   fprintf(file, "MapImages := [];\n");
134
   for (i = 1; i <= ndgen; i++) {
135
      p2 = y[dgen + i];
136
      fprintf(file, "MapImages[%d] := ", i);
137
      print_GAP_word(file, p2, pcp);
138
      fprintf(file, ";\n");
139
   }
140
}
141

142

143
/****************************************************************************
144
**
145
*F  MakeNameList
146
**                             create p-group generation identifier for group
147
*/
148
char *nextnumber(char *ident)
149
{
150
   while (*ident != '\0' && *ident != '#')
151
      ident++;
152
   if (*ident == '#')
153
      ident++;
154
   return ident;
155
}
156

157
void MakeNameList(FILE *file, char *ident)
158
{
159
   int first = 1;
160

161
   fprintf(file, "SetANUPQIdentity( F, [ ");
162
   while (*(ident = nextnumber(ident)) != '\0') {
163
      if (!first)
164
         fprintf(file, ",");
165
      first = 0;
166
      fprintf(file, "[");
167
      do
168
         fprintf(file, "%c", *ident);
169
      while (*++ident != ';');
170
      ident++;
171
      fprintf(file, ",");
172
      do {
173
         fprintf(file, "%c", *ident);
174
         ident++;
175
      } while ('0' <= *ident && *ident <= '9');
176
      fprintf(file, "]");
177
   }
178
   fprintf(file, " ] );\n");
179
}
180

181

182
/****************************************************************************
183
**
184
*F  write_GAP_library
185
**               write GAP library file in form suitable for reading into GAP
186
*/
187
int countcall = 0;
188

189
void write_GAP_library(FILE *file, struct pcp_vars *pcp)
190
{
191
   /* if this is the first call initialise 'ANUgroups'                    */
192
   if (countcall == 0) {
193
      fprintf(file, "ANUPQgroups := [];\n");
194
      fprintf(file, "ANUPQautos  := [];\n\n");
195
   }
196
   countcall++;
197

198
   /* write function call to <countcall>.th position of <ANUPQgroups>     */
199
   fprintf(file, "## group number: %d\n", countcall);
200
   fprintf(file, "ANUPQgroups[%d] := function( L )\n", countcall);
201
   fprintf(file, "local   MapImages,  F;\n\n");
202

203
   /* write the GAP presentation to file                                  */
204
   GAP_presentation(file, pcp, 0);
205

206
   /* convert <F> to a pc group in descendants case
207
      ... has to be done here; otherwise, we lose the property/attributes */
208
   fprintf(file, "if IsList(L) then\n    F := PcGroupFpGroupNC(F);\nfi;\n");
209

210
   /* add info. whether group is capable, and its nuclear and mult'r ranks*/
211
   fprintf(file, "SetIsCapable(F, %s);\n", (pcp->newgen) ? "true" : "false");
212
   fprintf(file, "SetNuclearRank(F, %d);\n", pcp->newgen);
213
   fprintf(file, "SetMultiplicatorRank (F, %d);\n", pcp->multiplicator_rank);
214

215
   /* add the pq identitfier                                              */
216
   MakeNameList(file, pcp->ident);
217

218
   /* add the group <F> to <L>                                            */
219
   fprintf(file, "if IsList(L) then\n    Add( L, F );\n");
220
   fprintf(file, "else\n    L.group := F;\n    L.map := MapImages;\nfi;");
221

222
   fprintf(file, "\nend;\n\n\n");
223
}
224

225

226
/****************************************************************************
227
**
228
*F  GAP_auts
229
**               write a description of the automorphism group of the current
230
**                      group to a file in a format suitable for input to GAP
231
*/
232
void GAP_auts(FILE *file,
233
              int ***central,
234
              int ***stabiliser,
235
              struct pga_vars *pga,
236
              struct pcp_vars *pcp)
237
{
238
   register int *y = y_address;
239

240
   int i, j, k, ngens, first;
241

242
   /* if this is the first call something is wrong  '                     */
243
   if (countcall == 0) {
244
      fprintf(stderr, "internal error in 'GAP_auts'");
245
      exit(FAILURE);
246
   }
247

248
   /* write function call to <countcall>.th position of <ANUPQgroups>     */
249
   fprintf(file, "## automorphisms number: %d\n", countcall);
250
   fprintf(file, "ANUPQautos[%d] := function( G )\n", countcall);
251
   fprintf(file, "local   frattGens,\n");
252
   fprintf(file, "        relOrders,\n");
253
   fprintf(file, "        centralAutos,\n");
254
   fprintf(file, "        otherAutos;\n");
255

256

257
   /* write information about automorphisms to file                       */
258
   ngens = y[pcp->clend + 1];
259
   fprintf(file,
260
           "SetIsPcgsAutomorphisms(G,%s);\n",
261
           pga->soluble ? "true" : "false");
262
   fprintf(file, "SetIsCapable(G,%s);\n", pga->capable ? "true" : "false");
263

264
   /* first write the Frattini generators                                 */
265
   fprintf(file, "frattGens := [");
266
   for (k = 1; k <= ngens; k++) {
267
      if (k != 1)
268
         fprintf(file, ",");
269
      fprintf(file, "G.%d", k);
270
   }
271
   fprintf(file, "];\n");
272

273
   fprintf(file,
274
           "centralAutos := [];  # nr of central autos: %d\n",
275
           pga->nmr_centrals);
276

277
   /* write out all central automorphisms                                 */
278
   for (i = 1; i <= pga->nmr_centrals; ++i) {
279
      fprintf(file, "Add( centralAutos, [");
280
      for (j = 1; j <= pga->ndgen; ++j) {
281
         if (j != 1)
282
            fprintf(file, ",");
283
         first = 1;
284
         for (k = 1; k <= pcp->lastg; ++k) {
285
            if (0 != central[i][j][k]) {
286
               if (!first)
287
                  fprintf(file, "*");
288
               first = 0;
289
               if (1 != central[i][j][k])
290
                  fprintf(file, "G.%d^%d", k, central[i][j][k]);
291
               else
292
                  fprintf(file, "G.%d", k);
293
            }
294
         }
295
         if (first) {
296
            fprintf(stderr, "internal error in 'GAP_auts'\n");
297
            exit(FAILURE);
298
         }
299
      }
300
      fprintf(file, "] );\n");
301
   }
302

303

304
   fprintf(file,
305
           "otherAutos := [];  # nr of other autos: %d\n",
306
           pga->nmr_stabilisers);
307

308
   /* write out all other automorphisms                                   */
309
   for (i = 1; i <= pga->nmr_stabilisers; ++i) {
310
      fprintf(file, "Add( otherAutos, [");
311
      for (j = 1; j <= pga->ndgen; ++j) {
312
         if (j != 1)
313
            fprintf(file, ",");
314
         first = 1;
315
         for (k = 1; k <= pcp->lastg; ++k) {
316
            if (0 != stabiliser[i][j][k]) {
317
               if (!first)
318
                  fprintf(file, "*");
319
               first = 0;
320
               if (1 != stabiliser[i][j][k])
321
                  fprintf(file, "G.%d^%d", k, stabiliser[i][j][k]);
322
               else
323
                  fprintf(file, "G.%d", k);
324
            }
325
         }
326
         if (first) {
327
            fprintf(stderr, "internal error in 'GAP_auts'\n");
328
            exit(FAILURE);
329
         }
330
      }
331
      fprintf(file, "] );\n");
332
   }
333

334

335
   fprintf(file, "relOrders := [");
336
   if (pga->nmr_soluble > 0) {
337
      for (i = 1; i <= pga->nmr_soluble; ++i)
338
         fprintf(file, "%d, ", pga->relative[i]);
339
      fprintf(file, "%d", pga->relative[pga->nmr_soluble]);
340
   }
341
   fprintf(file, "];\n");
342

343

344
   fprintf(file, "ANUPQSetAutomorphismGroup( ");
345
   fprintf(file, "G, frattGens, centralAutos, otherAutos, relOrders, ");
346
   fprintf(file, "%s );\n", pga->soluble ? "true" : "false");
347
   fprintf(file, "end;\n\n\n");
348
}
349

350
Real-time collaboration for Jupyter Notebooks, Linux Terminals, LaTeX, VS Code, R IDE, and more,
all in one place.

Product

Resources

Company

Real-time collaboration for Jupyter Notebooks, Linux Terminals, LaTeX, VS Code, R IDE, and more, all in one place.

Real-time collaboration for Jupyter Notebooks, Linux Terminals, LaTeX, VS Code, R IDE, and more,
all in one place.
