GAP 4.8.9 installation with standard packages -- copy to your CoCalc project to get it

1
#include <typedef.h>
2
#include <getput.h>
3
#include <matrix.h>
4
#include <datei.h>
5
#include <gmp.h>
6
#include <zass.h>
7
#include <longtools.h>
8
#include <presentation.h>
9
#include <base.h>
10
#include <graph.h>
11

12
#define DEBUG FALSE
13

14
int INFO_LEVEL;
15
extern int SFLAG;
16

17

18
static int is_trivial(bravais_TYP *G){
19

20
  int i;
21

22
  for (i=0;i<G->gen_no;Check_mat(G->gen[i]),i++);
23
  for (i=0;i<G->gen_no &&
24
           G->gen[i]->flags.Scalar &&
25
           G->gen[i]->array.SZ[i][i] == 1;i++);
26

27
  return i == G->gen_no;
28

29
}
30

31
int main(int argc,char **argv){
32

33
  matrix_TYP **X,
34
              *N,
35
             **Y,
36
             **TR,
37
             **base,
38
              *relator_input,
39
             **matinv;
40

41
  word *relator;
42

43
  bravais_TYP *G, *R;
44

45
  int i,
46
      anz,
47
     *len;
48

49
  long dim;
50

51
  bahn **strong;
52

53

54
  MP_INT number,
55
        *names;
56

57
  char comment[1000],
58
       file[1000],
59
      *NAME,
60
      *FN;
61

62
  read_header(argc,argv);
63

64
  if ((is_option('h') && optionnumber('h')==0) || (FILEANZ < 1)
65
      || (is_option('i') && FILEANZ<2)){
66
      printf("Usage: %s ['file1'] 'file2' ['file3'] [-n] [-i] [-t=n] [-v] [-C] [-H] [-F] [-S]\n",argv[0]);
67
      printf("\n");
68
      printf("file1:  matrix_TYP containing a presentation of the group (cf. Presentation,\n");
69
      printf("        Roundcor)\n");
70
      printf("file2:  bravais_TYP containing the group (and its normalizer).\n");
71
      printf("file3:  (OPTIONAL) containing cocycles for identification.\n");
72
      printf("\n");
73
      printf("Calculates representatives of the isomorphism classes of extension of\n");
74
      printf("the group in file2 with presentation in file1 with the natural lattice.\n");
75
      printf("Output lists representative vectorsystems. (Output can be used as input\n");
76
      printf("for Extract). Also the isomorphism type of the extension group is given.\n");
77
      printf("\n");
78
      printf("Options:\n");
79
      printf("\n");
80
      printf(" -n:      only calculates the number of extensions, without computing\n");
81
      printf("          representatives. This option is much faster for big cohomology\n");
82
      printf("          groups. WARNING: Try this option first for 2-groups in dimension\n");
83
      printf("          greater than 4.\n");
84
      printf(" -v:      verbose mode. Give some echoing to stderr to\n");
85
      printf("          indicate a little what the program is doing.\n");
86
      printf(" -i:      Identify the cozycles given in file3, ie. give\n");
87
      printf("          the described space groups a name. CAUTION: The\n");
88
      printf("          name will depend on the generating set of the group\n");
89
      printf("          in file2 and the presentation in file1.\n");
90
      printf("          Can be used to test isomorphism of space groups with equal\n");
91
      printf("          point groups. The name is 0 iff the extension splits.\n");
92
      printf(" -t=n:    Has an effect only if given with -i. Outputs the\n");
93
      printf("          isomophism needed to transform the space group\n");
94
      printf("          By default, only the linear part is calculated. To\n");
95
      printf("          get a full transformation matrix, use -t=2.\n");
96
      printf(" -C:      Ignore the operation of the normalizer, just work\n");
97
      printf("          on the level of extensions.\n");
98
      printf(" -H:      echo the isomorphism type of the cohomology group\n");
99
      printf("          H^1(G,Q^n/Z^n) to stderr.\n");
100
      printf(" -F:      Only construct those extensions which gie rise to\n");
101
      printf("          torsion free space groups. Does not work in conjunction\n");
102
      printf("          with -n.\n");
103
      printf(" -S:      write corresponding space groups in files\n");
104
      printf("\n");
105
      printf(" CAUTION: THE PROGRAM RELIES HEAVILY ON THE FOLLOWING TWO FACTS:\n");
106
      printf("           - THE PRESENTATION GIVEN IN file1 IS INDEED A\n");
107
      printf("             PRESENTATION. CHECKED IS ONLY THAT THE GIVEN\n");
108
      printf("             GENERATORS FULFILL THE RELATIONS.\n");
109
      printf("           - THE NORMALIZER IN GL_n(Z) FOR THE GROUP IN file2\n");
110
      printf("             IS CORRECT. THE PROGRAM MIGHT NOT FINISH OR\n");
111
      printf("             GIVE WRONG ANSWERS OTHERWISE.\n");
112
      printf("\n");
113
      printf("Cf. also Zass_main, Extract, Same_generators, Presentation.\n");
114
      printf("Synonyms: Vectorsystems,Extensions\n");
115
      if (is_option('h')){
116
         exit(0);
117
      }
118
      else{
119
         exit(31);
120
      }
121
  }
122

123
  INFO_LEVEL = optionnumber('h');
124

125
  if (INFO_LEVEL & 12){
126
     SFLAG = 1;
127
  }
128

129

130
  if ((FILEANZ > 2)
131
      || (FILEANZ == 2 && ! is_option('i'))){
132
    /* reading the group */
133
    G = get_bravais(FILENAMES[1]);
134

135
    /* reading the presentation */
136
    X = mget_mat(FILENAMES[0],&i);
137
    if (i>1){
138
      fprintf(stderr,"you should only give a single matrix as presentation\n");
139
      exit(3);
140
    }
141

142
    FN = FILENAMES[1];
143
  }
144
  else{
145
    /* reading the group */
146
    G = get_bravais(FILENAMES[0]);
147

148
    /* calculate a presentation */
149
    base = get_base(G);
150

151
    strong = strong_generators(base,G,TRUE);
152

153
    if (DEBUG){
154
      check_base(strong,G);
155
    }
156

157
    X = (matrix_TYP **) malloc(sizeof(matrix_TYP *));
158
    X[0] = pres(strong,G,NULL);
159

160
    for (i=0;i<G->dim;i++){
161
      free_mat(base[i]);
162
      free_bahn(strong[i]);
163
      free(strong[i]);
164
    }
165
    free(strong);
166
    free(base);
167
    FN = FILENAMES[0];
168
  }
169

170

171
  relator_input = X[0];
172
  free(X);
173

174
  /* if C is an option, completely forget the normalizer and centralizer */
175
  if (is_option('C')){
176
     for (i=0;i<G->normal_no;i++) free_mat(G->normal[i]);
177
     if (G->normal_no > 0){
178
        G->normal_no = 0;
179
        free(G->normal);
180
     }
181
     for (i=0;i<G->cen_no;i++) free_mat(G->cen[i]);
182
     if (G->cen_no > 0){
183
        G->cen_no = 0;
184
        free(G->cen);
185
     }
186
  }
187

188
  /* we have to have at least the identity to generate the normalizer */
189
  if (G->normal_no == 0){
190
     G->normal_no = 1;
191
     G->normal = (matrix_TYP **) malloc(1 * sizeof(matrix_TYP *));
192
     G->normal[0] = init_mat(G->dim,G->dim,"1");
193
  }
194

195
  /* bereitstellen eines pointers fuer die inversen von mat */
196
  matinv = (matrix_TYP **) calloc(G->gen_no,sizeof(matrix_TYP *));
197

198
  /* speicher fuer die worte */
199
  relator = (word *) calloc(relator_input->rows,sizeof(word));
200

201
  /* konvertieren der inputmatrix in relator-format */
202
  for (i=0;i<relator_input->rows;i++){
203
    matrix_2_word(relator_input,relator+i,i);
204
  }
205

206
  X = cohomology(&dim,G->gen,matinv,relator,G->gen_no,relator_input->rows);
207

208
  /* there is a special case to handle, which is the case that there
209
     isn't a cohomology group at all */
210
  if (X[0]->cols <1){
211
     if (is_option('H')){
212
        fprintf(stderr,"H^1(G,Q^n/Z^n) is trivial\n");
213
     }
214
     if (is_option('n')){
215
        printf("number of extensions of group in %s with natural lattice %d\n",
216
              FN,1);
217
     }
218
     else if(is_option('i')){
219
        printf("There is only one extension of this group with the natural\n");
220
        printf("lattice, and this splits.\n");
221
     }
222
     else if(is_option('F')){
223
        if (is_trivial(G)){
224
           X[0] = init_mat(G->gen_no * G->dim,1,"");
225
           printf("#%d\n",1);
226
           sprintf(comment,"%% the %d-th cozycle to the group of %s",
227
                   1,FN);
228
           if (is_option('S')){
229
              sprintf(file, "%s.%s", FN, "0");
230
              R = extract_r(G, X[0]);
231
	      put_bravais(R, file, comment);
232
	      free_bravais(R);
233
	   }
234
	   else{
235
              put_cocycle(X[0],G->dim,G->gen_no,NULL,comment);
236
	   }
237
           free_mat(X[0]);
238
        }
239
        else{
240
           /* only one extension, this splits and is not torsion free
241
              for this reason */
242
           printf("#0\n");
243
        }
244
     }
245
     else{
246
        X[0] = init_mat(G->gen_no * G->dim,1,"");
247
        printf("#%d\n",1);
248
        sprintf(comment,"%% the %d-th cozycle to the group of %s",
249
                1,FN);
250
        if (is_option('S')){
251
           sprintf(file, "%s.%s", FN, "0");
252
           R = extract_r(G, X[0]);
253
	   put_bravais(R, file, comment);
254
	   free_bravais(R);
255
	}
256
	else{
257
           put_cocycle(X[0],G->dim,G->gen_no,NULL,comment);
258
	}
259
     }
260
     exit(0);
261
  }
262

263
  if (is_option('H')){
264
     fprintf(stderr,"Isomorphism type of H^1(G,Q^n/Z^n): \n");
265
     i=0;
266
     while(X[1]->array.SZ[i][i] == 1) i++;
267
     fprintf(stderr,"C_%d",X[1]->array.SZ[i][i]);
268
     for (i=i+1;i<X[1]->cols;i++){
269
        if (X[1]->array.SZ[i][i] != 0 &&
270
            X[1]->array.SZ[i][i] != 1){
271
           fprintf(stderr," X ");
272
           fprintf(stderr,"C_%d",X[1]->array.SZ[i][i]);
273
        }
274
     }
275
     fprintf(stderr,"\n");
276
  }
277

278
  if (is_option('n')){
279
      mpz_init(&number);
280
      mpz_set_si(&number,0);
281
      no_of_extensions(X[0],X[1],X[2],G,&number);
282
      printf("number of extensions of group in %s with natural lattice ",
283
              FN);
284
      mpz_out_str(stdout,10,&number);
285
      printf("\n");
286
      mpz_clear(&number);
287
  }
288
  else if(is_option('i')){
289

290
     if (FILEANZ > 2){
291
       Y = mget_mat(FILENAMES[2],&anz);
292
     }
293
     else{
294
       Y = mget_mat(FILENAMES[1],&anz);
295
     }
296

297
     convert_cocycle_to_column(Y,anz,G->dim,G->gen_no);
298
     names = (MP_INT *) malloc(anz*sizeof(MP_INT));
299
     for (i=0;i<anz;i++) mpz_init_set_si(names+i,0);
300
     i = is_option('t');
301
     if (i && optionnumber('t') == 2) i = 3;
302
     TR = identify(X[0],X[1],X[2],G,Y,names,anz,i,NULL,NULL);
303
     for (i=0;i<anz;i++){
304
        printf("Name for the %d-th extension in %s: ",i+1,FN);
305
        mpz_out_str(stdout,10,names+i);
306
        printf("\n");
307
        if (TR!=NULL){
308
           sprintf(comment,"transformation matrix to extension %d of %s",
309
                    i+1,FN);
310
           put_mat(TR[i],NULL,comment,2);
311
        }
312
     }
313
     for (i=0;i<anz;i++){
314
        mpz_clear(names+i);
315
        free_mat(Y[i]);
316
        if (TR != NULL) free_mat(TR[i]);
317
     }
318
     free(names);
319
     free(Y);
320
     if (TR != NULL) free(TR);
321
  }
322
  else{
323
     Y = extensions(X[0],X[1],X[2],G,&len,&names,&anz,is_option('F'));
324

325
     printf("#%d\n",anz);
326
     
327
     for (i=0;i<anz;i++){
328
        NAME = (char * ) malloc( mpz_sizeinbase( names + i , 10 ) + 2 );
329
        mpz_get_str( NAME ,10,names+i);
330
        sprintf(comment,
331
             "%% the %d-th cozycle, length of orbit %d,name: %s",i+1,len[i],NAME);
332
        if (is_option('S')){
333
           sprintf(file, "%s.%s", FN, NAME);
334
           R = extract_r(G, Y[i]);
335
	   put_bravais(R, file, comment);
336
	   free_bravais(R);
337
	}
338
	else{
339
           put_cocycle(Y[i],G->dim,G->gen_no,NULL,comment);
340
	}
341
        free_mat(Y[i]);
342
        mpz_clear(names+i);
343
        free(NAME);
344
     }
345
     free(names);
346
     free(Y);
347
     Y = NULL;
348
     free(len);
349
  }
350

351
  for (i=0;i<3;i++) free_mat(X[i]);
352
  for (i=0;i<G->gen_no;i++) if (matinv[i] != NULL) free_mat(matinv[i]);
353
  free(matinv);
354
  for (i=0;i<relator_input->rows;i++) wordfree(relator+i);
355
  free(relator);
356
  free_mat(relator_input);
357
  free(X);
358
  free_bravais(G);
359

360
  if (INFO_LEVEL & 12){
361
     pointer_statistics(0,0);
362
  }
363

364

365
  exit(0);
366
} /* main */
367

368

369