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

563603 views
1
#include"typedef.h"
2
/**************************************************************************\
3
@---------------------------------------------------------------------------
4
@---------------------------------------------------------------------------
5
@ FILE: rest_short.c
6
@---------------------------------------------------------------------------
7
@---------------------------------------------------------------------------
8
@
9
\**************************************************************************/
10
11
#define EPS 0.001
12
13
static int n, min, *vec, anzahl;
14
static int **grn; /* Gram matrix */
15
static int **ba; /* basis transformation matrix */
16
static double **mo, *ge;
17
static matrix_TYP *SV;
18
static int SV_size, SV_ext;
19
static int break_opt, f_opt, c_opt;
20
static int *rv;
21
static double *rvd, rk, max;
22
23
24
static double scapr(i, j)
25
int i, j;
26
{
27
double r, *moi, *moj;
28
int l;
29
30
r = grn[i][j];
31
moi = mo[i];
32
moj = mo[j];
33
for (l = 0; l <= j-1; ++l)
34
r -= ge[l] * moi[l] * moj[l];
35
if (ge[j] == 0)
36
{
37
printf("Error: found norm 0 vector\n");
38
exit(3);
39
}
40
r = r / ge[j];
41
return r;
42
}
43
44
static double orth(i)
45
int i;
46
{
47
double r, *moi;
48
int l;
49
50
r = grn[i][i];
51
moi = mo[i];
52
for (l = 0; l <= i-1; ++l)
53
r -= ge[l] * moi[l] * moi[l];
54
return r;
55
}
56
57
/*---------------------------------------------------------*\
58
| makes model of the lattice (with same scalarproducts)
59
\*__________________________________________________________*/
60
61
static void modellmachen(a, e)
62
int a, e;
63
{
64
int i, j;
65
66
if (a == 0)
67
{
68
ge[0] = grn[0][0];
69
i = 1;
70
}
71
else
72
i = a;
73
while (i <= e)
74
{
75
for (j = 0; j < i; ++j)
76
mo[i][j] = scapr(i, j);
77
ge[i] = orth(i);
78
++i;
79
}
80
}
81
82
static int iround(r)
83
double r;
84
{
85
int i;
86
87
if (r >= 0)
88
i = (int)(2*r + 1) / 2;
89
else
90
i = -(int)(2*(-r) + 1) / 2;
91
return i;
92
}
93
94
static void red(k, l)
95
int k, l;
96
{
97
double r, *mok, *mol;
98
int i, ir, *bak, *bal, *grnk, *grnl;
99
100
r = mo[k][l];
101
if (2*r > 1.0 || 2*r < -1.0)
102
{
103
ir = iround(r);
104
mok = mo[k];
105
bak = ba[k];
106
grnk = grn[k];
107
mol = mo[l];
108
bal = ba[l];
109
grnl = grn[l];
110
for (i = 0; i < n; ++i)
111
{
112
mok[i] -= ir * mol[i];
113
bak[i] -= ir * bal[i];
114
grnk[i] -= ir * grnl[i];
115
}
116
rv[l] += ir * rv[k];
117
for (i = 0; i < n; ++i)
118
grn[i][k] -= ir * grn[i][l];
119
}
120
}
121
122
static int interchange(k)
123
int k;
124
{
125
int i, z, *zp;
126
127
zp = ba[k];
128
ba[k] = ba[k-1];
129
ba[k-1] = zp;
130
131
z = rv[k];
132
rv[k] = rv[k-1];
133
rv[k-1] = z;
134
135
zp = grn[k];
136
grn[k] = grn[k-1];
137
grn[k-1] = zp;
138
139
for (i = 0; i < n; ++i)
140
{
141
z = grn[i][k];
142
grn[i][k] = grn[i][k-1];
143
grn[i][k-1] = z;
144
}
145
if (k > 1)
146
return k-1;
147
else
148
return k;
149
}
150
151
static void reduzieren(k)
152
int k;
153
{
154
int l;
155
156
for (l = k-2; l >= 0; --l)
157
red(k, l);
158
}
159
160
161
/* prints the vector corresponding to vec */
162
/* in the model and its length */
163
164
static void vecschr(m, d)
165
int m;
166
double d;
167
{
168
int i, j, entry;
169
int l;
170
int *v;
171
172
l = iround(d);
173
if(l >= min)
174
{
175
anzahl++;
176
if(f_opt == TRUE)
177
break_opt = TRUE;
178
if(c_opt == TRUE)
179
return;
180
if(SV->rows == SV_size)
181
{
182
SV_size += SV_ext;
183
if((SV->array.SZ = (int **)realloc(SV->array.SZ, SV_size *sizeof(int *))) == 0)
184
exit(2);
185
}
186
if((v = (int *)malloc((n+1) *sizeof(int))) == 0)
187
exit(2);
188
for (i = 0; i < m; ++i)
189
{
190
v[i] = 0;
191
for (j = 0; j < m; ++j)
192
v[i] += vec[j] * ba[j][i];
193
}
194
v[m] = l;
195
SV->array.SZ[SV->rows] = v;
196
SV->rows++;
197
}
198
}
199
200
201
/* recursion for finding shortest vectors */
202
203
static void shrt(c, damage)
204
int c;
205
double damage;
206
{
207
double x, gec;
208
int i, j;
209
210
if (c == -1)
211
{
212
vecschr(n, damage);
213
if(break_opt == TRUE)
214
return;
215
}
216
else
217
{
218
x = 0.0;
219
for (j = c+1; j < n; ++j)
220
x += (vec[j] -rvd[j]) * mo[j][c];
221
x -= rvd[c];
222
i = -iround(x);
223
gec = ge[c];
224
if (gec*(x+i)*(x+i) + damage < max + EPS)
225
{
226
while ((gec*(x+i)*(x+i) + damage <= max + EPS) ||
227
(x + i <= 0))
228
++i;
229
--i;
230
while ((gec*(x+i)*(x+i) + damage < max + EPS))
231
{
232
vec[c] = i;
233
if(break_opt == TRUE)
234
return;
235
shrt(c-1, gec*(x+i)*(x+i) + damage);
236
--i;
237
}
238
}
239
}
240
}
241
242
243
244
245
246
247
/**************************************************************************\
248
@---------------------------------------------------------------------------
249
matrix_TYP *short_vectors(mat, length, lengthmin, find_opt, count_opt, anz)
250
matrix_TYP *mat;
251
int length, lengthmin, find_opt, count_opt, *anz;
252
253
@ matrix_TYP *rest_short(mat, restvec, rkgv, zaehler, nenner,
254
@ find_opt, count_opt, anz)
255
@ matrix_TYP *mat;
256
@ int *restvec, rkgv;
257
@ int zaehler, nenner, find_opt, count_opt, *anz;
258
@
259
@ The matrix mat must be a symmetric, positiv definite nxn-Matrix.
260
@ The function calculates all x in Z^n with
261
@
262
@ lengthmin <= n(x - 1/rkgv * restvec) <= length
263
@ where
264
@ n(y) := y * mat * y^{tr}.
265
@
266
@ In the pointer 'anz' the number of all these vectors is returned.
267
@ The vectors x are the rows of the returned matrix, called 'SV' in the
268
@ following.
269
@ So 'SV' is an integral matrix with 'anz' rows and 'n' columns.
270
@ For 'SV' n+1 columns are allocated. The last column contains the norm n(x).
271
@ Although n+1 columns are allocated, SV->cols = n.
272
@
273
@ If 'findoption == 1' the Algorithm stops,
274
@ if a vector of desired norm is found.
275
@ In this case the Matrix 'SV' has only one row.
276
@
277
@ If 'count_option == 1', shortest_vectors returns a zero-pointer,
278
@ only the number of found vectors is returned in the pointer 'anz'.
279
@
280
@ Warning: if 'mat' is not positiv definite, the function runs into an
281
@ infinite loop.
282
@
283
@---------------------------------------------------------------------------
284
@
285
\**************************************************************************/
286
matrix_TYP *rest_short(mat, restvec, rkgv, zaehler, nenner, find_opt, count_opt, anz)
287
matrix_TYP *mat;
288
int *restvec, rkgv;
289
int zaehler, nenner, find_opt, count_opt, *anz;
290
{
291
int i, j, ak, bk;
292
double de, cst = 0.75;
293
char c;
294
matrix_TYP *erg;
295
296
extern matrix_TYP *init_mat();
297
298
anzahl = 0;
299
n = mat->rows;
300
SV_ext = n * (n+1)/2;
301
break_opt = FALSE;
302
f_opt = find_opt;
303
c_opt = count_opt;
304
305
SV = init_mat(1, n+1, "");
306
free(SV->array.SZ[0]);
307
SV->cols--;
308
SV->rows = 0;
309
if(f_opt == TRUE)
310
SV_ext = 1;
311
else
312
{
313
if((SV->array.SZ = (int **)realloc(SV->array.SZ, SV_ext *sizeof(int *))) == 0)
314
exit(2);
315
SV_size = SV_ext;
316
}
317
if ((grn = (int**)malloc(n * sizeof(int*))) == 0)
318
exit (2);
319
if ((ba = (int**)malloc(n * sizeof(int*))) == 0)
320
exit (2);
321
if ((mo = (double**)malloc(n * sizeof(double*))) == 0)
322
exit (2);
323
if ((ge = (double*)malloc(n * sizeof(double))) == 0)
324
exit (2);
325
if ((vec = (int*)malloc(n * sizeof(int))) == 0)
326
exit (2);
327
if ((rv = (int*)malloc(n * sizeof(int))) == 0)
328
exit (2);
329
if ((rvd = (double*)malloc(n * sizeof(double))) == 0)
330
exit (2);
331
for (i = 0; i < n; ++i)
332
{
333
vec[i] = 0;
334
rv[i] = restvec[i];
335
if ((grn[i] = (int*)malloc(n * sizeof(int))) == 0)
336
exit (2);
337
if ((ba[i] = (int*)malloc(n * sizeof(int))) == 0)
338
exit (2);
339
if ((mo[i] = (double*)malloc(n * sizeof(double))) == 0)
340
exit (2);
341
for (j = 0; j < n; ++j)
342
{
343
ba[i][j] = 0;
344
mo[i][j] = 0.0;
345
}
346
ba[i][i] = 1;
347
mo[i][i] = 1.0;
348
349
/* read the Gram matrix (can be square or lower triangular) */
350
for (j = 0; j <= i; ++j)
351
{
352
grn[i][j] = mat->array.SZ[i][j];
353
grn[j][i] = grn[i][j];
354
}
355
}
356
rk = ((double) rkgv);
357
max = (double) zaehler; /* read the maximal length of the vectors */
358
max *= ((double) mat->kgv);
359
if(nenner != 0)
360
max = max /((double) nenner);
361
min = 0;
362
363
bk = 1;
364
while (bk < n)
365
{
366
ak = bk - 1;
367
modellmachen(ak, bk);
368
red(bk, bk-1);
369
if (ge[bk] < ((cst - mo[bk][bk-1]*mo[bk][bk-1]) * ge[bk-1]))
370
{
371
bk = interchange(bk);
372
modellmachen(bk-1, bk);
373
if (bk > 1)
374
--bk;
375
}
376
else
377
{
378
if (bk > 1)
379
reduzieren(bk);
380
++bk;
381
}
382
}
383
for(i=0;i<n;i++)
384
rvd[i] = ((double) rv[i])/rk;
385
386
shrt(n-1, 0.0); /* recursively calculate the vectors up to length max */
387
*anz = anzahl;
388
389
for(i=0;i<n;i++)
390
{
391
free(grn[i]);
392
free(ba[i]);
393
free(mo[i]);
394
}
395
free(grn); free(ba); free(mo); free(ge); free(vec);
396
free(rv); free(rvd);
397
398
erg = SV;
399
SV = NULL;
400
return(erg);
401
}
402
403