Book a Demo!
CoCalc Logo Icon
StoreFeaturesDocsShareSupportNewsAboutPoliciesSign UpSign In
Download

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

563641 views
1
/***** Main program for the automorphism program AUTO *****/
2
3
#include "typedef.h"
4
#include "types.h"
5
6
static int normal_option;
7
static int perp_no;
8
static int ***perp;
9
static int perpdim;
10
static int ***perpbase;
11
static int ***perpprod;
12
static int *perpvec;
13
14
#include "auttools.c"
15
#include "bachtools.c"
16
#include "iotools.c"
17
#include "lattools.c"
18
#include "mattools.c"
19
#include "orbtools.c"
20
#include "preproc.c"
21
#include "sorttools.c"
22
23
/*************************************************************************\
24
| The functions 'autgrp' calculates generators and the order of the group
25
| G := {g in GL_n(Z) | g * Fo[i] * g^{tr} = Fo[i], 1<= i<= Foanz}
26
| returned via a pointer to 'bravais_TYP'.
27
|
28
| The arguments of autgrp are:
29
| matrix_TYP **Fo: a set of n times n matrices,
30
| the first must be positiv definite
31
| int Foanz: the number of the matrices given in 'Fo'.
32
| matrix_TYP **Erz: if already element of G are known,
33
| they can be used for calculating generators
34
| for the whole group.
35
| The matrices of known elements can be given
36
| to the function by the pointer 'Erz'.
37
| int Erzanz: The number of matrices given in 'Erz"
38
| matrix_TYP *SV: The rows of the matrix 'SV' must be the vectors
39
| x in Z^n with x * F[0] * x^{tr} <= m, where
40
| m is the maximal diagonal entry of the Matrix
41
| F[0]
42
| int *options: see below.
43
|
44
| options is a pointer to integer (of length 6)
45
| The possible options are encoded in the following way:
46
| options[0]: The depth, up to wich scalar product combinations
47
| shall be calculated. The value should be small.
48
| options[0] > 0 should be used only, if the automorphismn
49
| group is expected to be small (with respect to the number
50
| of shortest vectors).
51
| options[1]: The n-point stabiliser with respect to different basis
52
| will be calculated.
53
| options[2]: If options[2] = 1, additional output is written to the
54
| file AUTO.tmp
55
| options[3]: If options[3] = 1, Bacher polynomials are used.
56
| If options[3] = 2, Bacher polynomial are used up to a deepth
57
| specified in options[4].
58
| If options[3] = 3, Bacher polynomials are used, using
59
| combinations of vectors having the scalar
60
| product specified in options[5]
61
| options[3] = 4 is the combination of options[3] = 2 and
62
| options[3] = 3.
63
| options[4]: A natural number number or zero (if options[3] = 2 or 4)
64
| options[5]: An integral number (if options[3] = 3 or 4)
65
|
66
| It is possible to use NULL for options,
67
| in this case option is assumed to be [0,0,0,0,0,0]
68
\*************************************************************************/
69
70
71
bravais_TYP *autgrp(Fo, Foanz, SV, Erz, Erzanz, options)
72
matrix_TYP **Fo, **Erz, *SV;
73
int Foanz, Erzanz, *options;
74
{
75
FILE *outfile;
76
bachpol *bach;
77
flagstruct flags;
78
scpcomb *comb;
79
group G;
80
invar F;
81
veclist V, norm;
82
fpstruct fp;
83
int dim, max, fail, *vec;
84
int ***H, nH, ngen, **sumveclist, **sumvecbase;
85
int i, j, k, l, n, *Vvi, *Vvj, **Fvi, *Fvij, **FAi;
86
bravais_TYP *B;
87
88
normal_option = FALSE;
89
/* get the flags from the command line */
90
getflags(&flags, options);
91
if(Erzanz > 0)
92
flags.GEN = 1;
93
else
94
flags.GEN = 0;
95
/* F.n is the number of invariant forms */
96
F.n = Foanz;
97
if ((F.A = (int***)malloc(F.n * sizeof(int**))) == 0)
98
exit (2);
99
/* read the invariant forms */
100
F.dim = Fo[0]->cols;
101
dim = F.dim;
102
for(i=0;i<F.n;i++)
103
{
104
if(Fo[i]->cols != F.dim || Fo[i]->rows != F.dim)
105
{
106
printf("forms in autgrp have different dimension\n");
107
exit(2);
108
}
109
}
110
for(i=0;i<F.n;i++)
111
{
112
if ((F.A[i] = (int**)malloc(dim * sizeof(int*))) == 0)
113
exit (2);
114
for(j=0;j<F.dim;j++)
115
{
116
if ((F.A[i][j] = (int*)malloc(dim * sizeof(int))) == 0)
117
exit (2);
118
for(k=0;k<F.dim;k++)
119
F.A[i][j][k] = Fo[i]->array.SZ[j][k];
120
}
121
}
122
if (flags.GEN == 1)
123
/* some automorphisms are already known */
124
{
125
ngen = Erzanz;
126
if ((H = (int***)malloc(ngen * sizeof(int**))) == 0)
127
exit (2);
128
nH = 0;
129
fail = 0;
130
for(i=0;i<ngen;i++)
131
{
132
if(Erz[i]->cols != dim || Erz[i]->rows != dim)
133
{
134
printf("Elements 'Erz' have wrong dimension\n");
135
exit(3);
136
}
137
}
138
i = 0;
139
while (nH+fail < ngen)
140
{
141
if ((H[nH] = (int**)malloc(dim * sizeof(int*))) == 0)
142
exit (2);
143
for(j=0;j<dim;j++)
144
{
145
if ((H[nH][j] = (int*)malloc(dim * sizeof(int))) == 0)
146
exit (2);
147
for(k=0;k<dim;k++)
148
H[nH][j][k] = Erz[i]->array.SZ[j][k];
149
}
150
/* check whether the matrix is really an automorphism, i.e. fixes the forms */
151
if (checkgen(H[nH], F) == 0)
152
/* the matrix is not an automorphism */
153
{
154
++fail;
155
for (j = 0; j < dim; ++j)
156
free(H[nH][j]);
157
free(H[nH]);
158
}
159
else
160
/* the matrix fixes all forms in F */
161
++nH;
162
i++;
163
}
164
}
165
else
166
nH = 0;
167
168
169
170
V.dim = dim;
171
V.len = dim + F.n;
172
/* get the short vectors */
173
V.n = SV->rows;
174
if ((V.v = (int**)malloc((V.n+1) * sizeof(int*))) == 0)
175
exit (2);
176
for(i=0;i<=V.n;i++)
177
{
178
if ((V.v[i] = (int*)malloc(V.len * sizeof(int))) == 0)
179
exit (2);
180
}
181
for(i=1;i<= V.n;i++)
182
{
183
for(j=0;j<=dim;j++)
184
V.v[i][j] = SV->array.SZ[i-1][j];
185
}
186
/* the first nonzero entry of each vector is made positive and the maximal
187
entry of the vectors is determined */
188
max = 1;
189
for (i = 1; i <= V.n; ++i)
190
{
191
Vvi = V.v[i];
192
for (j = 0; j < dim && Vvi[j] == 0; ++j);
193
if (j < dim && Vvi[j] < 0)
194
{
195
for (k = j; k < dim; ++k)
196
Vvi[k] *= -1;
197
}
198
for (k = j; k < dim; ++k)
199
{
200
if (abs(Vvi[k]) > max)
201
max = abs(Vvi[k]);
202
}
203
}
204
if (max > MAXENTRY)
205
/* there is an entry, which is bigger than MAXENTRY, which might cause overflow,
206
since the program doesn't use long integer arithmetic */
207
{
208
fprintf(stderr, "Error: Found entry %d in short vectors.\nTo avoid overflow, the entries should not exceed %d.\n", max, MAXENTRY);
209
exit (3);
210
}
211
/* V.prime is a prime p, such that every entry x in the short vectors remains
212
unchanged under reduction mod p in symmetric form, i.e. -p/2 < x <= p/2 */
213
for (V.prime = 2*max + 1; isprime(V.prime) == 0; ++V.prime);
214
/* sort the vectors and delete doublets */
215
sortvecs(&V);
216
/* the norm-vector (i.e. the vector of the norms with respect to the different
217
invariant forms) of each vector must be equal to the norm-vector of one
218
of the vectors from the standard-base */
219
if ((norm.v = (int**)malloc((dim+1) * sizeof(int*))) == 0)
220
exit (2);
221
norm.n = dim;
222
norm.dim = F.n;
223
norm.len = F.n;
224
for (i = 1; i <= norm.n; ++i)
225
{
226
/* norm.v[i] is the norm combination of the (i-1)-th base-vector */
227
if ((norm.v[i] = (int*)malloc(norm.dim * sizeof(int))) == 0)
228
exit (2);
229
for (k = 0; k < norm.dim; ++k)
230
norm.v[i][k] = F.A[k][i-1][i-1];
231
}
232
sortvecs(&norm);
233
/* delete those vectors, which can not be the image of any of the standard-base
234
vectors */
235
checkvecs(&V, F, norm);
236
for (i = 1; i <= norm.n; ++i)
237
free(norm.v[i]);
238
free(norm.v);
239
/* print the invariant forms, if output is in ASCII-format */
240
/*********************************************
241
printf("#%d\n", F.n);
242
for (i = 0; i < F.n; ++i)
243
putform(F.A[i], dim);
244
**********************************************/
245
/* F.v[i][j] is the transposed of the product of the Gram-matrix F.A[i] with the
246
transposed of the vector v[j], hence the scalar product of v[j] and v[k] with
247
respect to the Gram-matrix F.A[i] can be computed as standard scalar product
248
of v[j] and F.v[i][k] */
249
if ((F.v = (int***)malloc(F.n * sizeof(int**))) == 0)
250
exit (2);
251
/* the product of the maximal entry in the short vectors with the maximal entry
252
in F.v[i] should not exceed MAXNORM to avoid overflow */
253
max = MAXNORM / max;
254
for (i = 0; i < F.n; ++i)
255
{
256
FAi = F.A[i];
257
if ((F.v[i] = (int**)malloc((V.n+1) * sizeof(int*))) == 0)
258
exit (2);
259
Fvi = F.v[i];
260
for (j = 1; j <= V.n; ++j)
261
{
262
Vvj = V.v[j];
263
if ((Fvi[j] = (int*)malloc(dim * sizeof(int))) == 0)
264
exit (2);
265
Fvij = Fvi[j];
266
for (k = 0; k < dim; ++k)
267
{
268
Fvij[k] = sscp(FAi[k], Vvj, dim);
269
if (abs(Fvij[k]) > max)
270
/* some entry in F.v[i] is too large */
271
{
272
fprintf(stderr, "Error: Found entry %d in F.v.\nTo avoid overflow, the entries should not exceed %d.\n", Fvij[k], max);
273
exit (3);
274
}
275
}
276
}
277
}
278
/* fp.per is the order in which the images of the base-vectors are set */
279
if ((fp.per = (int*)malloc(dim * sizeof(int))) == 0)
280
exit (2);
281
/* fp.e[i] is the index in V.v of the i-th vector of the standard-base in the
282
new order */
283
if ((fp.e = (int*)malloc(dim * sizeof(int))) == 0)
284
exit (2);
285
/* fp.diag is the diagonal of the fingerprint in the new order, fp.diag[i] is
286
an upper bound for the length of the orbit of the i-th base-vector under
287
the stabilizer of the preceding ones */
288
if ((fp.diag = (int*)malloc(dim * sizeof(int))) == 0)
289
exit (2);
290
/* compute the fingerprint */
291
fingerprint(&fp, F, V);
292
if (flags.PRINT == 1)
293
/* if the -P option is given, print the diagonal fp.diag and the number of short
294
vectors on AUTO.tmp */
295
{
296
outfile = fopen("AUTO.tmp", "a");
297
fprintf(outfile, "%d short vectors\n", 2*V.n);
298
fprintf(outfile, "fingerprint diagonal:\n");
299
for (i = 0; i < dim; ++i)
300
fprintf(outfile, " %2d", fp.diag[i]);
301
fprintf(outfile, "\n");
302
fclose(outfile);
303
}
304
/* get the standard basis in the new order */
305
if ((vec = (int*)malloc(dim * sizeof(int))) == 0)
306
exit (2);
307
for (i = 0; i < dim; ++i)
308
{
309
for (j = 0; j < dim; ++j)
310
vec[j] = 0;
311
vec[fp.per[i]] = 1;
312
fp.e[i] = numberof(vec, V);
313
if (abs(fp.e[i]) > V.n)
314
/* the standard-base must occur in the set of short vectors, since Id is
315
certainly an automorphism */
316
{
317
fprintf(stderr, "Error: standard basis vector nr. %d not found\n", i);
318
exit (3);
319
}
320
}
321
free(vec);
322
/* if the -D option is given, the scalar product combinations and the
323
corresponding vector sums are computed for the standard-basis */
324
if (flags.DEPTH > 0)
325
{
326
if ((comb = (scpcomb*)malloc(dim * sizeof(scpcomb))) == 0)
327
exit (2);
328
for (i = 0; i < dim; ++i)
329
{
330
/* compute the list of scalar product combinations and the corresponding
331
vector sums */
332
scpvecs(&comb[i].list, &sumveclist, i, fp.e, flags.DEPTH, V, F);
333
/* compute a basis for the lattice that is generated by the vector sums and
334
a transformation matrix that expresses the basis in terms of the
335
vector sums */
336
base(&comb[i], &sumvecbase, sumveclist, F.A[0], dim);
337
if (flags.PRINT == 1)
338
/* if the -P option is given, print the rank of the lattice generated by the
339
vector sums on level i on AUTO.tmp */
340
{
341
outfile = fopen("AUTO.tmp", "a");
342
fprintf(outfile, "comb[%d].rank = %d\n", i, comb[i].rank);
343
fclose(outfile);
344
}
345
/* compute the coefficients of the vector sums in terms of the basis */
346
coef(&comb[i], sumvecbase, sumveclist, F.A[0], dim);
347
for (j = 0; j <= comb[i].list.n; ++j)
348
free(sumveclist[j]);
349
free(sumveclist);
350
/* compute the scalar products of the base-vectors */
351
scpforms(&comb[i], sumvecbase, F);
352
for (j = 0; j < comb[i].rank; ++j)
353
free(sumvecbase[j]);
354
free(sumvecbase);
355
}
356
}
357
/* the Bacher-polynomials for the first BACHDEP base-vectors are computed,
358
if no scalar product was given as an argument, the scalar product is set
359
to 1/2 the norm of the base-vector (with respect to the first form) */
360
if (flags.BACH[0] == 1)
361
{
362
if ((bach = (bachpol*)malloc(flags.BACHDEP * sizeof(bachpol))) == 0)
363
exit (2);
364
for (i = 0; i < flags.BACHDEP; ++i)
365
{
366
if (flags.BACH[2] == 0)
367
/* no scalar product was given as an option */
368
flags.BACHSCP = V.v[fp.e[i]][dim] / 2;
369
/* compute the Bacher-polynomial */
370
bacher(&bach[i], fp.e[i], flags.BACHSCP, V, F.v[0]);
371
if (flags.PRINT == 1)
372
/* if the -P option is given, print the Bacher-polynomial on AUTO.tmp */
373
{
374
outfile = fopen("AUTO.tmp", "a");
375
fprintf(outfile, "Bacher-polynomial of base vector fp.e[%d]:\n", i);
376
fputbach(outfile, bach[i]);
377
fclose(outfile);
378
}
379
}
380
}
381
/* set up the group: the generators in G.g[i] are matrices that fix the
382
first i base-vectors but do not fix fp.e[i] */
383
if ((G.g = (int****)malloc(dim * sizeof(int***))) == 0)
384
exit (2);
385
/* G.ng is the number of generators in G.g[i] */
386
if ((G.ng = (int*)malloc(dim * sizeof(int))) == 0)
387
exit (2);
388
/* the first G.nsg[i] generators in G.g[i] are obtained as stabilizer elements
389
and are not necessary to generate the group */
390
if ((G.nsg = (int*)malloc(dim * sizeof(int))) == 0)
391
exit (2);
392
/* G.ord[i] is the orbit length of fp.e[i] under the generators in
393
G.g[i] ... G.g[dim-1] */
394
if ((G.ord = (int*)malloc(dim * sizeof(int))) == 0)
395
exit (2);
396
for (i = 0; i < dim; ++i)
397
{
398
if ((G.g[i] = (int***)malloc(1 * sizeof(int**))) == 0)
399
exit (2);
400
G.ng[i] = 0;
401
G.nsg[i] = 0;
402
}
403
G.dim = dim;
404
if ((G.g[0][0] = (int**)malloc(dim * sizeof(int*))) == 0)
405
exit (2);
406
/* -Id is always an automorphism */
407
for (i = 0; i < dim; ++i)
408
{
409
if ((G.g[0][0][i] = (int*)malloc(dim * sizeof(int))) == 0)
410
exit (2);
411
for (j = 0; j < dim; ++j)
412
G.g[0][0][i][j] = 0;
413
G.g[0][0][i][i] = -1;
414
G.ng[0] = 1;
415
}
416
/* fill in the generators which were given as input */
417
for (i = 0; i < nH; ++i)
418
{
419
for (j = 0; j < dim && operate(fp.e[j], H[i], V) == fp.e[j]; ++j);
420
if (j < dim)
421
/* the generator is not Id and fixes fp.e[0],...,fp.e[j-1] but not fp.e[j] */
422
{
423
++G.ng[j];
424
if ((G.g[j] = (int***)realloc(G.g[j], G.ng[j] * sizeof(int**))) == 0)
425
exit (2);
426
if ((G.g[j][G.ng[j]-1] = (int**)malloc(dim * sizeof(int*))) == 0)
427
exit (2);
428
for (k = 0; k < dim; ++k)
429
{
430
if ((G.g[j][G.ng[j]-1][k] = (int*)malloc(dim * sizeof(int))) == 0)
431
exit (2);
432
for (l = 0; l < dim; ++l)
433
G.g[j][G.ng[j]-1][k][l] = H[i][k][l];
434
}
435
}
436
for (k = 0; k < dim; ++k)
437
free(H[i][k]);
438
free(H[i]);
439
}
440
if (nH > 0)
441
free(H);
442
nH = 0;
443
for (i = 0; i < dim; ++i)
444
nH += G.ng[i];
445
if ((H = (int***)malloc(nH * sizeof(int**))) == 0)
446
exit (2);
447
/* calculate the orbit lengths under the automorphisms known so far */
448
for (i = 0; i < dim; ++i)
449
{
450
if (G.ng[i] > 0)
451
{
452
nH = 0;
453
for (j = i; j < dim; ++j)
454
{
455
for (k = 0; k < G.ng[j]; ++k)
456
{
457
H[nH] = G.g[j][k];
458
++nH;
459
}
460
}
461
G.ord[i] = orbitlen(fp.e[i], fp.diag[i], H, nH, V);
462
}
463
else
464
G.ord[i] = 1;
465
}
466
free(H);
467
/* compute the full automorphism group */
468
autom(&G, V, F, fp, comb, bach, flags);
469
/* print the generators of the group, which are necessary for generating */
470
B = putgens(G, flags);
471
n = 0;
472
for (i = flags.STAB; i < dim; ++i)
473
{
474
if (G.ord[i] > 1)
475
++n;
476
}
477
/* print a base to AUTO.tmp if the print-flag is set */
478
if (flags.PRINT == 1)
479
{
480
outfile = fopen("AUTO.tmp", "a");
481
fprintf(outfile, "%dx%d\n", n, dim);
482
for (i = flags.STAB; i < dim; ++i)
483
{
484
if (G.ord[i] > 1)
485
{
486
for (j = 0; j < dim; ++j)
487
fprintf(outfile, " %d", V.v[fp.e[i]][j]);
488
fprintf(outfile, "\n");
489
}
490
}
491
fclose(outfile);
492
}
493
/* print the order of the group */
494
putord(G, flags, B);
495
496
497
if (flags.BACH[0] == 1)
498
{
499
for (i = 0; i < flags.BACHDEP; ++i)
500
free(bach[i].coef);
501
free(bach);
502
}
503
if (flags.DEPTH > 0)
504
{
505
for(i=0;i<dim;i++)
506
{
507
for(j=0;j<=comb[i].list.n;j++)
508
free(comb[i].coef[j]);
509
free(comb[i].coef);
510
for(j=0;j<=comb[i].list.n;j++)
511
free(comb[i].list.v[j]);
512
free(comb[i].list.v);
513
for(j=0;j<comb[i].rank;j++)
514
free(comb[i].trans[j]);
515
free(comb[i].trans);
516
for(j=0;j<F.n;j++)
517
{
518
for(k=0;k<comb[i].rank;k++)
519
free(comb[i].F[j][k]);
520
free(comb[i].F[j]);
521
}
522
free(comb[i].F);
523
}
524
free(comb);
525
}
526
for(i=0;i<F.n;i++)
527
{
528
for(j=1;j<=V.n;j++)
529
free(F.v[i][j]);
530
free(F.v[i]);
531
for(j=0;j<dim;j++)
532
free(F.A[i][j]);
533
free(F.A[i]);
534
}
535
free(F.A); free(F.v);
536
for(i=0;i<=V.n;i++)
537
free(V.v[i]);
538
free(V.v);
539
free(fp.diag); free(fp.per); free(fp.e);
540
for(i=0;i<dim;i++)
541
{
542
for(j=0;j<G.ng[i];j++)
543
{
544
for(k=0;k<dim;k++)
545
free(G.g[i][j][k]);
546
free(G.g[i][j]);
547
}
548
free(G.g[i]);
549
}
550
free(G.g); free(G.ord); free(G.ng); free(G.nsg);
551
552
return(B);
553
}
554
555
556
557
bravais_TYP *perfect_normalizer(Fo, SV, Erz, Erzanz, options, P, Panz, Pdim, Pbase)
558
matrix_TYP *Fo, **Erz, *SV, **P, **Pbase;
559
int Erzanz, *options, Panz, Pdim;
560
{
561
FILE *outfile;
562
bachpol *bach;
563
flagstruct flags;
564
scpcomb *comb;
565
group G;
566
invar F;
567
veclist V, norm;
568
fpstruct fp;
569
int dim, max, fail, *vec;
570
int ***H, nH, ngen, **sumveclist, **sumvecbase;
571
int i, j, k, l, n, *Vvi, *Vvj, **Fvi, *Fvij, **FAi;
572
bravais_TYP *B;
573
574
extern matrix_TYP *init_mat();
575
576
normal_option = TRUE;
577
perp_no = Panz;
578
if((perp = (int ***)malloc(perp_no *sizeof(int **))) == 0)
579
{
580
printf("malloc of 'perp' in 'perfect_normalizer' failed\n");
581
exit(2);
582
}
583
for(i=0;i<perp_no;i++)
584
perp[i] = P[i]->array.SZ
585
perpdim = Pdim;
586
if((perpbase = (int ***)malloc(perpdim *sizeof(int **))) == 0)
587
{
588
printf("malloc of 'perpbase' in 'perfect_normalizer' failed\n");
589
exit(2);
590
}
591
for(i=0;i<perpdim;i++)
592
perpbase[i] = Pbase[i]->array.SZ;
593
if((perpprod = (int ***)malloc(perpdim *sizeof(int **))) == 0)
594
{
595
printf("malloc of 'perpprod' in 'perfect_normalizer' failed\n");
596
exit(2);
597
}
598
for(i=0;i<perpdim;i++)
599
{
600
if((perpprod[i] = (int **)malloc(Fo->cols *sizeof(int *))) == 0)
601
{
602
printf("malloc of 'perpprod[i]' in 'perfect_normalizer' failed\n");
603
exit(2);
604
}
605
for(j=0;j<Fo->cols;j++)
606
{
607
if((perpprod[i][j] = (int *)malloc((j+1) *sizeof(int))) == 0)
608
{
609
printf("malloc of 'perpprod[i]' in 'perfect_normalizer' failed\n");
610
exit(2);
611
}
612
}
613
}
614
if((perpvec = (int *)malloc(perpdim *sizeof(int))) == 0)
615
{
616
printf("malloc of 'perpvec' in 'perfect_normalizer' failed\n");
617
exit(2);
618
}
619
for(i=0;i<perpdim;i++)
620
perpprod[i] = init_mat(Fo->cols, Fo->cols, "");
621
/* get the flags from the command line */
622
getflags(&flags, options);
623
if(Erzanz > 0)
624
flags.GEN = 1;
625
else
626
flags.GEN = 0;
627
/* F.n is the number of invariant forms */
628
F.n = 1;
629
if ((F.A = (int***)malloc(1 * sizeof(int**))) == 0)
630
exit (2);
631
/* read the invariant forms */
632
F.dim = Fo->cols;
633
dim = F.dim;
634
if(Fo->cols != F.dim || Fo->rows != F.dim)
635
{
636
printf("error form 'Fo' in autgrp must be a square matrix\n");
637
exit(2);
638
}
639
if ((F.A[0] = (int**)malloc(dim * sizeof(int*))) == 0)
640
exit (2);
641
for(j=0;j<F.dim;j++)
642
{
643
if ((F.A[0][j] = (int*)malloc(dim * sizeof(int))) == 0)
644
exit (2);
645
for(k=0;k<F.dim;k++)
646
F.A[0][j][k] = Fo->array.SZ[j][k];
647
}
648
if (flags.GEN == 1)
649
/* some automorphisms are already known */
650
{
651
ngen = Erzanz;
652
if ((H = (int***)malloc(ngen * sizeof(int**))) == 0)
653
exit (2);
654
nH = 0;
655
fail = 0;
656
for(i=0;i<ngen;i++)
657
{
658
if(Erz[i]->cols != dim || Erz[i]->rows != dim)
659
{
660
printf("Elements 'Erz' have wrong dimension\n");
661
exit(3);
662
}
663
}
664
i = 0;
665
while (nH+fail < ngen)
666
{
667
if ((H[nH] = (int**)malloc(dim * sizeof(int*))) == 0)
668
exit (2);
669
for(j=0;j<dim;j++)
670
{
671
if ((H[nH][j] = (int*)malloc(dim * sizeof(int))) == 0)
672
exit (2);
673
for(k=0;k<dim;k++)
674
H[nH][j][k] = Erz[i]->array.SZ[j][k];
675
}
676
/* check whether the matrix is really an automorphism, i.e. fixes the forms */
677
if (checkgen(H[nH], F) == 0)
678
/* the matrix is not an automorphism */
679
{
680
++fail;
681
for (j = 0; j < dim; ++j)
682
free(H[nH][j]);
683
free(H[nH]);
684
}
685
else
686
/* the matrix fixes all forms in F */
687
++nH;
688
i++;
689
}
690
}
691
else
692
nH = 0;
693
694
695
696
V.dim = dim;
697
V.len = dim + F.n;
698
/* get the short vectors */
699
V.n = SV->rows;
700
if ((V.v = (int**)malloc((V.n+1) * sizeof(int*))) == 0)
701
exit (2);
702
if ((V.v[0] = (int*)malloc(V.len * sizeof(int))) == 0)
703
exit (2);
704
for(i=1;i<= V.n;i++)
705
{
706
V.v[i] = SV->array.SZ[i-1];
707
}
708
/* the first nonzero entry of each vector is made positive and the maximal
709
entry of the vectors is determined */
710
max = 1;
711
for (i = 1; i <= V.n; ++i)
712
{
713
Vvi = V.v[i];
714
for (j = 0; j < dim && Vvi[j] == 0; ++j);
715
if (j < dim && Vvi[j] < 0)
716
{
717
for (k = j; k < dim; ++k)
718
Vvi[k] *= -1;
719
}
720
for (k = j; k < dim; ++k)
721
{
722
if (abs(Vvi[k]) > max)
723
max = abs(Vvi[k]);
724
}
725
}
726
if (max > MAXENTRY)
727
/* there is an entry, which is bigger than MAXENTRY, which might cause overflow,
728
since the program doesn't use long integer arithmetic */
729
{
730
fprintf(stderr, "Error: Found entry %d in short vectors.\nTo avoid overflow, the entries should not exceed %d.\n", max, MAXENTRY);
731
exit (3);
732
}
733
/* V.prime is a prime p, such that every entry x in the short vectors remains
734
unchanged under reduction mod p in symmetric form, i.e. -p/2 < x <= p/2 */
735
for (V.prime = 2*max + 1; isprime(V.prime) == 0; ++V.prime);
736
/* sort the vectors and delete doublets */
737
sortvecs(&V);
738
/* the norm-vector (i.e. the vector of the norms with respect to the different
739
invariant forms) of each vector must be equal to the norm-vector of one
740
of the vectors from the standard-base */
741
if ((norm.v = (int**)malloc((dim+1) * sizeof(int*))) == 0)
742
exit (2);
743
norm.n = dim;
744
norm.dim = F.n;
745
norm.len = F.n;
746
for (i = 1; i <= norm.n; ++i)
747
{
748
/* norm.v[i] is the norm combination of the (i-1)-th base-vector */
749
if ((norm.v[i] = (int*)malloc(norm.dim * sizeof(int))) == 0)
750
exit (2);
751
for (k = 0; k < norm.dim; ++k)
752
norm.v[i][k] = F.A[k][i-1][i-1];
753
}
754
sortvecs(&norm);
755
/* delete those vectors, which can not be the image of any of the standard-base
756
vectors */
757
checkvecs(&V, F, norm);
758
for (i = 1; i <= norm.n; ++i)
759
free(norm.v[i]);
760
free(norm.v);
761
/* print the invariant forms, if output is in ASCII-format */
762
/*********************************************
763
printf("#%d\n", F.n);
764
for (i = 0; i < F.n; ++i)
765
putform(F.A[i], dim);
766
**********************************************/
767
/* F.v[i][j] is the transposed of the product of the Gram-matrix F.A[i] with the
768
transposed of the vector v[j], hence the scalar product of v[j] and v[k] with
769
respect to the Gram-matrix F.A[i] can be computed as standard scalar product
770
of v[j] and F.v[i][k] */
771
if ((F.v = (int***)malloc(F.n * sizeof(int**))) == 0)
772
exit (2);
773
/* the product of the maximal entry in the short vectors with the maximal entry
774
in F.v[i] should not exceed MAXNORM to avoid overflow */
775
max = MAXNORM / max;
776
for (i = 0; i < F.n; ++i)
777
{
778
FAi = F.A[i];
779
if ((F.v[i] = (int**)malloc((V.n+1) * sizeof(int*))) == 0)
780
exit (2);
781
Fvi = F.v[i];
782
for (j = 1; j <= V.n; ++j)
783
{
784
Vvj = V.v[j];
785
if ((Fvi[j] = (int*)malloc(dim * sizeof(int))) == 0)
786
exit (2);
787
Fvij = Fvi[j];
788
for (k = 0; k < dim; ++k)
789
{
790
Fvij[k] = sscp(FAi[k], Vvj, dim);
791
if (abs(Fvij[k]) > max)
792
/* some entry in F.v[i] is too large */
793
{
794
fprintf(stderr, "Error: Found entry %d in F.v.\nTo avoid overflow, the entries should not exceed %d.\n", Fvij[k], max);
795
exit (3);
796
}
797
}
798
}
799
}
800
/* fp.per is the order in which the images of the base-vectors are set */
801
if ((fp.per = (int*)malloc(dim * sizeof(int))) == 0)
802
exit (2);
803
/* fp.e[i] is the index in V.v of the i-th vector of the standard-base in the
804
new order */
805
if ((fp.e = (int*)malloc(dim * sizeof(int))) == 0)
806
exit (2);
807
/* fp.diag is the diagonal of the fingerprint in the new order, fp.diag[i] is
808
an upper bound for the length of the orbit of the i-th base-vector under
809
the stabilizer of the preceding ones */
810
if ((fp.diag = (int*)malloc(dim * sizeof(int))) == 0)
811
exit (2);
812
/* compute the fingerprint */
813
fingerprint(&fp, F, V);
814
if (flags.PRINT == 1)
815
/* if the -P option is given, print the diagonal fp.diag and the number of short
816
vectors on AUTO.tmp */
817
{
818
outfile = fopen("AUTO.tmp", "a");
819
fprintf(outfile, "%d short vectors\n", 2*V.n);
820
fprintf(outfile, "fingerprint diagonal:\n");
821
for (i = 0; i < dim; ++i)
822
fprintf(outfile, " %2d", fp.diag[i]);
823
fprintf(outfile, "\n");
824
fclose(outfile);
825
}
826
/* get the standard basis in the new order */
827
if ((vec = (int*)malloc(dim * sizeof(int))) == 0)
828
exit (2);
829
for (i = 0; i < dim; ++i)
830
{
831
for (j = 0; j < dim; ++j)
832
vec[j] = 0;
833
vec[fp.per[i]] = 1;
834
fp.e[i] = numberof(vec, V);
835
if (abs(fp.e[i]) > V.n)
836
/* the standard-base must occur in the set of short vectors, since Id is
837
certainly an automorphism */
838
{
839
fprintf(stderr, "Error: standard basis vector nr. %d not found\n", i);
840
exit (3);
841
}
842
}
843
free(vec);
844
/* if the -D option is given, the scalar product combinations and the
845
corresponding vector sums are computed for the standard-basis */
846
if (flags.DEPTH > 0)
847
{
848
if ((comb = (scpcomb*)malloc(dim * sizeof(scpcomb))) == 0)
849
exit (2);
850
for (i = 0; i < dim; ++i)
851
{
852
/* compute the list of scalar product combinations and the corresponding
853
vector sums */
854
scpvecs(&comb[i].list, &sumveclist, i, fp.e, flags.DEPTH, V, F);
855
/* compute a basis for the lattice that is generated by the vector sums and
856
a transformation matrix that expresses the basis in terms of the
857
vector sums */
858
base(&comb[i], &sumvecbase, sumveclist, F.A[0], dim);
859
if (flags.PRINT == 1)
860
/* if the -P option is given, print the rank of the lattice generated by the
861
vector sums on level i on AUTO.tmp */
862
{
863
outfile = fopen("AUTO.tmp", "a");
864
fprintf(outfile, "comb[%d].rank = %d\n", i, comb[i].rank);
865
fclose(outfile);
866
}
867
/* compute the coefficients of the vector sums in terms of the basis */
868
coef(&comb[i], sumvecbase, sumveclist, F.A[0], dim);
869
for (j = 0; j <= comb[i].list.n; ++j)
870
free(sumveclist[j]);
871
free(sumveclist);
872
/* compute the scalar products of the base-vectors */
873
scpforms(&comb[i], sumvecbase, F);
874
for (j = 0; j < comb[i].rank; ++j)
875
free(sumvecbase[j]);
876
free(sumvecbase);
877
}
878
}
879
/* the Bacher-polynomials for the first BACHDEP base-vectors are computed,
880
if no scalar product was given as an argument, the scalar product is set
881
to 1/2 the norm of the base-vector (with respect to the first form) */
882
if (flags.BACH[0] == 1)
883
{
884
if ((bach = (bachpol*)malloc(flags.BACHDEP * sizeof(bachpol))) == 0)
885
exit (2);
886
for (i = 0; i < flags.BACHDEP; ++i)
887
{
888
if (flags.BACH[2] == 0)
889
/* no scalar product was given as an option */
890
flags.BACHSCP = V.v[fp.e[i]][dim] / 2;
891
/* compute the Bacher-polynomial */
892
bacher(&bach[i], fp.e[i], flags.BACHSCP, V, F.v[0]);
893
if (flags.PRINT == 1)
894
/* if the -P option is given, print the Bacher-polynomial on AUTO.tmp */
895
{
896
outfile = fopen("AUTO.tmp", "a");
897
fprintf(outfile, "Bacher-polynomial of base vector fp.e[%d]:\n", i);
898
fputbach(outfile, bach[i]);
899
fclose(outfile);
900
}
901
}
902
}
903
/* set up the group: the generators in G.g[i] are matrices that fix the
904
first i base-vectors but do not fix fp.e[i] */
905
if ((G.g = (int****)malloc(dim * sizeof(int***))) == 0)
906
exit (2);
907
/* G.ng is the number of generators in G.g[i] */
908
if ((G.ng = (int*)malloc(dim * sizeof(int))) == 0)
909
exit (2);
910
/* the first G.nsg[i] generators in G.g[i] are obtained as stabilizer elements
911
and are not necessary to generate the group */
912
if ((G.nsg = (int*)malloc(dim * sizeof(int))) == 0)
913
exit (2);
914
/* G.ord[i] is the orbit length of fp.e[i] under the generators in
915
G.g[i] ... G.g[dim-1] */
916
if ((G.ord = (int*)malloc(dim * sizeof(int))) == 0)
917
exit (2);
918
for (i = 0; i < dim; ++i)
919
{
920
if ((G.g[i] = (int***)malloc(1 * sizeof(int**))) == 0)
921
exit (2);
922
G.ng[i] = 0;
923
G.nsg[i] = 0;
924
}
925
G.dim = dim;
926
if ((G.g[0][0] = (int**)malloc(dim * sizeof(int*))) == 0)
927
exit (2);
928
/* -Id is always an automorphism */
929
for (i = 0; i < dim; ++i)
930
{
931
if ((G.g[0][0][i] = (int*)malloc(dim * sizeof(int))) == 0)
932
exit (2);
933
for (j = 0; j < dim; ++j)
934
G.g[0][0][i][j] = 0;
935
G.g[0][0][i][i] = -1;
936
G.ng[0] = 1;
937
}
938
/* fill in the generators which were given as input */
939
for (i = 0; i < nH; ++i)
940
{
941
for (j = 0; j < dim && operate(fp.e[j], H[i], V) == fp.e[j]; ++j);
942
if (j < dim)
943
/* the generator is not Id and fixes fp.e[0],...,fp.e[j-1] but not fp.e[j] */
944
{
945
++G.ng[j];
946
if ((G.g[j] = (int***)realloc(G.g[j], G.ng[j] * sizeof(int**))) == 0)
947
exit (2);
948
if ((G.g[j][G.ng[j]-1] = (int**)malloc(dim * sizeof(int*))) == 0)
949
exit (2);
950
for (k = 0; k < dim; ++k)
951
{
952
if ((G.g[j][G.ng[j]-1][k] = (int*)malloc(dim * sizeof(int))) == 0)
953
exit (2);
954
for (l = 0; l < dim; ++l)
955
G.g[j][G.ng[j]-1][k][l] = H[i][k][l];
956
}
957
}
958
for (k = 0; k < dim; ++k)
959
free(H[i][k]);
960
free(H[i]);
961
}
962
if (nH > 0)
963
free(H);
964
nH = 0;
965
for (i = 0; i < dim; ++i)
966
nH += G.ng[i];
967
if ((H = (int***)malloc(nH * sizeof(int**))) == 0)
968
exit (2);
969
/* calculate the orbit lengths under the automorphisms known so far */
970
for (i = 0; i < dim; ++i)
971
{
972
if (G.ng[i] > 0)
973
{
974
nH = 0;
975
for (j = i; j < dim; ++j)
976
{
977
for (k = 0; k < G.ng[j]; ++k)
978
{
979
H[nH] = G.g[j][k];
980
++nH;
981
}
982
}
983
G.ord[i] = orbitlen(fp.e[i], fp.diag[i], H, nH, V);
984
}
985
else
986
G.ord[i] = 1;
987
}
988
free(H);
989
/* compute the full automorphism group */
990
autom(&G, V, F, fp, comb, bach, flags);
991
/* print the generators of the group, which are necessary for generating */
992
B = putgens(G, flags);
993
n = 0;
994
for (i = flags.STAB; i < dim; ++i)
995
{
996
if (G.ord[i] > 1)
997
++n;
998
}
999
/* print a base to AUTO.tmp if the print-flag is set */
1000
if (flags.PRINT == 1)
1001
{
1002
outfile = fopen("AUTO.tmp", "a");
1003
fprintf(outfile, "%dx%d\n", n, dim);
1004
for (i = flags.STAB; i < dim; ++i)
1005
{
1006
if (G.ord[i] > 1)
1007
{
1008
for (j = 0; j < dim; ++j)
1009
fprintf(outfile, " %d", V.v[fp.e[i]][j]);
1010
fprintf(outfile, "\n");
1011
}
1012
}
1013
fclose(outfile);
1014
}
1015
/* print the order of the group */
1016
putord(G, flags, B);
1017
1018
1019
if (flags.BACH[0] == 1)
1020
{
1021
for (i = 0; i < flags.BACHDEP; ++i)
1022
free(bach[i].coef);
1023
free(bach);
1024
}
1025
if (flags.DEPTH > 0)
1026
{
1027
for(i=0;i<dim;i++)
1028
{
1029
for(j=0;j<=comb[i].list.n;j++)
1030
free(comb[i].coef[j]);
1031
free(comb[i].coef);
1032
for(j=0;j<=comb[i].list.n;j++)
1033
free(comb[i].list.v[j]);
1034
free(comb[i].list.v);
1035
for(j=0;j<comb[i].rank;j++)
1036
free(comb[i].trans[j]);
1037
free(comb[i].trans);
1038
for(j=0;j<F.n;j++)
1039
{
1040
for(k=0;k<comb[i].rank;k++)
1041
free(comb[i].F[j][k]);
1042
free(comb[i].F[j]);
1043
}
1044
free(comb[i].F);
1045
}
1046
free(comb);
1047
}
1048
for(i=0;i<F.n;i++)
1049
{
1050
for(j=1;j<=V.n;j++)
1051
free(F.v[i][j]);
1052
free(F.v[i]);
1053
for(j=0;j<dim;j++)
1054
free(F.A[i][j]);
1055
free(F.A[i]);
1056
}
1057
free(F.A); free(F.v);
1058
free(V.v);
1059
free(perp);
1060
free(perpbase);
1061
for(i=0;i<perpdim;i++)
1062
{
1063
for(j=0;j<Fo->cols;j++)
1064
free(perpprod[i][j]);
1065
free(perpprod[i]);
1066
}
1067
free(perpprod);
1068
free(perpvec);
1069
free(fp.diag); free(fp.per); free(fp.e);
1070
for(i=0;i<dim;i++)
1071
{
1072
for(j=0;j<G.ng[i];j++)
1073
{
1074
for(k=0;k<dim;k++)
1075
free(G.g[i][j][k]);
1076
free(G.g[i][j]);
1077
}
1078
free(G.g[i]);
1079
}
1080
free(G.g); free(G.ord); free(G.ng); free(G.nsg);
1081
1082
return(B);
1083
}
1084
1085