Book a Demo!
CoCalc Logo Icon
StoreFeaturesDocsShareSupportNewsAboutPoliciesSign UpSign In
Download

Testing latest pari + WASM + node.js... and it works?! Wow.

28479 views
License: GPL3
ubuntu2004
1
/* Copyright (C) 2000 The PARI group.
2
3
This file is part of the PARI/GP package.
4
5
PARI/GP is free software; you can redistribute it and/or modify it under the
6
terms of the GNU General Public License as published by the Free Software
7
Foundation; either version 2 of the License, or (at your option) any later
8
version. It is distributed in the hope that it will be useful, but WITHOUT
9
ANY WARRANTY WHATSOEVER.
10
11
Check the License for details. You should have received a copy of it, along
12
with the package; see the file 'COPYING'. If not, write to the Free Software
13
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
14
15
#include "pari.h"
16
#include "paripriv.h"
17
18
static int
19
check_ZV(GEN x, long l)
20
{
21
long i;
22
for (i=1; i<l; i++)
23
if (typ(gel(x,i)) != t_INT) return 0;
24
return 1;
25
}
26
void
27
RgV_check_ZV(GEN A, const char *s)
28
{
29
if (!RgV_is_ZV(A)) pari_err_TYPE(stack_strcat(s," [integer vector]"), A);
30
}
31
void
32
RgM_check_ZM(GEN A, const char *s)
33
{
34
long n = lg(A);
35
if (n != 1)
36
{
37
long j, m = lgcols(A);
38
for (j=1; j<n; j++)
39
if (!check_ZV(gel(A,j), m))
40
pari_err_TYPE(stack_strcat(s," [integer matrix]"), A);
41
}
42
}
43
44
static long
45
ZV_max_lg_i(GEN x, long m)
46
{
47
long i, prec = 2;
48
for (i = 1; i < m; i++) prec = maxss(prec, lgefint(gel(x,i)));
49
return prec;
50
}
51
long
52
ZV_max_lg(GEN x) { return ZV_max_lg_i(x, lg(x)); }
53
54
static long
55
ZM_max_lg_i(GEN x, long n, long m)
56
{
57
long j, prec = 2;
58
for (j = 1; j < n; j++) prec = maxss(prec, ZV_max_lg_i(gel(x,j), m));
59
return prec;
60
}
61
long
62
ZM_max_lg(GEN x)
63
{
64
long n = lg(x);
65
if (n == 1) return 2;
66
return ZM_max_lg_i(x, n, lgcols(x));
67
}
68
69
GEN
70
ZM_supnorm(GEN x)
71
{
72
long i, j, h, lx = lg(x);
73
GEN s = gen_0;
74
if (lx == 1) return gen_1;
75
h = lgcols(x);
76
for (j=1; j<lx; j++)
77
{
78
GEN xj = gel(x,j);
79
for (i=1; i<h; i++)
80
{
81
GEN c = gel(xj,i);
82
if (abscmpii(c, s) > 0) s = c;
83
}
84
}
85
return absi(s);
86
}
87
88
/********************************************************************/
89
/** **/
90
/** MULTIPLICATION **/
91
/** **/
92
/********************************************************************/
93
/* x nonempty ZM, y a compatible nc (dimension > 0). */
94
static GEN
95
ZM_nc_mul_i(GEN x, GEN y, long c, long l)
96
{
97
long i, j;
98
pari_sp av;
99
GEN z = cgetg(l,t_COL), s;
100
101
for (i=1; i<l; i++)
102
{
103
av = avma; s = muliu(gcoeff(x,i,1),y[1]);
104
for (j=2; j<c; j++)
105
if (y[j]) s = addii(s, muliu(gcoeff(x,i,j),y[j]));
106
gel(z,i) = gerepileuptoint(av,s);
107
}
108
return z;
109
}
110
111
/* x ZV, y a compatible zc. */
112
GEN
113
ZV_zc_mul(GEN x, GEN y)
114
{
115
long j, l = lg(x);
116
pari_sp av = avma;
117
GEN s = mulis(gel(x,1),y[1]);
118
for (j=2; j<l; j++)
119
if (y[j]) s = addii(s, mulis(gel(x,j),y[j]));
120
return gerepileuptoint(av,s);
121
}
122
123
/* x nonempty ZM, y a compatible zc (dimension > 0). */
124
static GEN
125
ZM_zc_mul_i(GEN x, GEN y, long c, long l)
126
{
127
long i, j;
128
GEN z = cgetg(l,t_COL);
129
130
for (i=1; i<l; i++)
131
{
132
pari_sp av = avma;
133
GEN s = mulis(gcoeff(x,i,1),y[1]);
134
for (j=2; j<c; j++)
135
if (y[j]) s = addii(s, mulis(gcoeff(x,i,j),y[j]));
136
gel(z,i) = gerepileuptoint(av,s);
137
}
138
return z;
139
}
140
GEN
141
ZM_zc_mul(GEN x, GEN y) {
142
long l = lg(x);
143
if (l == 1) return cgetg(1, t_COL);
144
return ZM_zc_mul_i(x,y, l, lgcols(x));
145
}
146
147
/* y nonempty ZM, x a compatible zv (dimension > 0). */
148
GEN
149
zv_ZM_mul(GEN x, GEN y) {
150
long i,j, lx = lg(x), ly = lg(y);
151
GEN z;
152
if (lx == 1) return zerovec(ly-1);
153
z = cgetg(ly,t_VEC);
154
for (j=1; j<ly; j++)
155
{
156
pari_sp av = avma;
157
GEN s = mulsi(x[1], gcoeff(y,1,j));
158
for (i=2; i<lx; i++)
159
if (x[i]) s = addii(s, mulsi(x[i], gcoeff(y,i,j)));
160
gel(z,j) = gerepileuptoint(av,s);
161
}
162
return z;
163
}
164
165
/* x ZM, y a compatible zm (dimension > 0). */
166
GEN
167
ZM_zm_mul(GEN x, GEN y)
168
{
169
long j, c, l = lg(x), ly = lg(y);
170
GEN z = cgetg(ly, t_MAT);
171
if (l == 1) return z;
172
c = lgcols(x);
173
for (j = 1; j < ly; j++) gel(z,j) = ZM_zc_mul_i(x, gel(y,j), l,c);
174
return z;
175
}
176
/* x ZM, y a compatible zn (dimension > 0). */
177
GEN
178
ZM_nm_mul(GEN x, GEN y)
179
{
180
long j, c, l = lg(x), ly = lg(y);
181
GEN z = cgetg(ly, t_MAT);
182
if (l == 1) return z;
183
c = lgcols(x);
184
for (j = 1; j < ly; j++) gel(z,j) = ZM_nc_mul_i(x, gel(y,j), l,c);
185
return z;
186
}
187
188
/* Strassen-Winograd algorithm */
189
190
/* Return A[ma+1..ma+da, na+1..na+ea] - B[mb+1..mb+db, nb+1..nb+eb]
191
* as an (m x n)-matrix, padding the input with zeroes as necessary. */
192
static GEN
193
add_slices(long m, long n,
194
GEN A, long ma, long da, long na, long ea,
195
GEN B, long mb, long db, long nb, long eb)
196
{
197
long min_d = minss(da, db), min_e = minss(ea, eb), i, j;
198
GEN M = cgetg(n + 1, t_MAT), C;
199
200
for (j = 1; j <= min_e; j++) {
201
gel(M, j) = C = cgetg(m + 1, t_COL);
202
for (i = 1; i <= min_d; i++)
203
gel(C, i) = addii(gcoeff(A, ma + i, na + j),
204
gcoeff(B, mb + i, nb + j));
205
for (; i <= da; i++) gel(C, i) = gcoeff(A, ma + i, na + j);
206
for (; i <= db; i++) gel(C, i) = gcoeff(B, mb + i, nb + j);
207
for (; i <= m; i++) gel(C, i) = gen_0;
208
}
209
for (; j <= ea; j++) {
210
gel(M, j) = C = cgetg(m + 1, t_COL);
211
for (i = 1; i <= da; i++) gel(C, i) = gcoeff(A, ma + i, na + j);
212
for (; i <= m; i++) gel(C, i) = gen_0;
213
}
214
for (; j <= eb; j++) {
215
gel(M, j) = C = cgetg(m + 1, t_COL);
216
for (i = 1; i <= db; i++) gel(C, i) = gcoeff(B, mb + i, nb + j);
217
for (; i <= m; i++) gel(C, i) = gen_0;
218
}
219
for (; j <= n; j++) gel(M, j) = zerocol(m);
220
return M;
221
}
222
223
/* Return A[ma+1..ma+da, na+1..na+ea] - B[mb+1..mb+db, nb+1..nb+eb]
224
* as an (m x n)-matrix, padding the input with zeroes as necessary. */
225
static GEN
226
subtract_slices(long m, long n,
227
GEN A, long ma, long da, long na, long ea,
228
GEN B, long mb, long db, long nb, long eb)
229
{
230
long min_d = minss(da, db), min_e = minss(ea, eb), i, j;
231
GEN M = cgetg(n + 1, t_MAT), C;
232
233
for (j = 1; j <= min_e; j++) {
234
gel(M, j) = C = cgetg(m + 1, t_COL);
235
for (i = 1; i <= min_d; i++)
236
gel(C, i) = subii(gcoeff(A, ma + i, na + j),
237
gcoeff(B, mb + i, nb + j));
238
for (; i <= da; i++) gel(C, i) = gcoeff(A, ma + i, na + j);
239
for (; i <= db; i++) gel(C, i) = negi(gcoeff(B, mb + i, nb + j));
240
for (; i <= m; i++) gel(C, i) = gen_0;
241
}
242
for (; j <= ea; j++) {
243
gel(M, j) = C = cgetg(m + 1, t_COL);
244
for (i = 1; i <= da; i++) gel(C, i) = gcoeff(A, ma + i, na + j);
245
for (; i <= m; i++) gel(C, i) = gen_0;
246
}
247
for (; j <= eb; j++) {
248
gel(M, j) = C = cgetg(m + 1, t_COL);
249
for (i = 1; i <= db; i++) gel(C, i) = negi(gcoeff(B, mb + i, nb + j));
250
for (; i <= m; i++) gel(C, i) = gen_0;
251
}
252
for (; j <= n; j++) gel(M, j) = zerocol(m);
253
return M;
254
}
255
256
static GEN ZM_mul_i(GEN x, GEN y, long l, long lx, long ly);
257
258
/* Strassen-Winograd matrix product A (m x n) * B (n x p) */
259
static GEN
260
ZM_mul_sw(GEN A, GEN B, long m, long n, long p)
261
{
262
pari_sp av = avma;
263
long m1 = (m + 1)/2, m2 = m/2,
264
n1 = (n + 1)/2, n2 = n/2,
265
p1 = (p + 1)/2, p2 = p/2;
266
GEN A11, A12, A22, B11, B21, B22,
267
S1, S2, S3, S4, T1, T2, T3, T4,
268
M1, M2, M3, M4, M5, M6, M7,
269
V1, V2, V3, C11, C12, C21, C22, C;
270
271
T2 = subtract_slices(n1, p2, B, 0, n1, p1, p2, B, n1, n2, p1, p2);
272
S1 = subtract_slices(m2, n1, A, m1, m2, 0, n1, A, 0, m2, 0, n1);
273
M2 = ZM_mul_i(S1, T2, m2 + 1, n1 + 1, p2 + 1);
274
if (gc_needed(av, 1))
275
gerepileall(av, 2, &T2, &M2); /* destroy S1 */
276
T3 = subtract_slices(n1, p1, T2, 0, n1, 0, p2, B, 0, n1, 0, p1);
277
if (gc_needed(av, 1))
278
gerepileall(av, 2, &M2, &T3); /* destroy T2 */
279
S2 = add_slices(m2, n1, A, m1, m2, 0, n1, A, m1, m2, n1, n2);
280
T1 = subtract_slices(n1, p1, B, 0, n1, p1, p2, B, 0, n1, 0, p2);
281
M3 = ZM_mul_i(S2, T1, m2 + 1, n1 + 1, p2 + 1);
282
if (gc_needed(av, 1))
283
gerepileall(av, 4, &M2, &T3, &S2, &M3); /* destroy T1 */
284
S3 = subtract_slices(m1, n1, S2, 0, m2, 0, n1, A, 0, m1, 0, n1);
285
if (gc_needed(av, 1))
286
gerepileall(av, 4, &M2, &T3, &M3, &S3); /* destroy S2 */
287
A11 = matslice(A, 1, m1, 1, n1);
288
B11 = matslice(B, 1, n1, 1, p1);
289
M1 = ZM_mul_i(A11, B11, m1 + 1, n1 + 1, p1 + 1);
290
if (gc_needed(av, 1))
291
gerepileall(av, 5, &M2, &T3, &M3, &S3, &M1); /* destroy A11, B11 */
292
A12 = matslice(A, 1, m1, n1 + 1, n);
293
B21 = matslice(B, n1 + 1, n, 1, p1);
294
M4 = ZM_mul_i(A12, B21, m1 + 1, n2 + 1, p1 + 1);
295
if (gc_needed(av, 1))
296
gerepileall(av, 6, &M2, &T3, &M3, &S3, &M1, &M4); /* destroy A12, B21 */
297
C11 = add_slices(m1, p1, M1, 0, m1, 0, p1, M4, 0, m1, 0, p1);
298
if (gc_needed(av, 1))
299
gerepileall(av, 6, &M2, &T3, &M3, &S3, &M1, &C11); /* destroy M4 */
300
M5 = ZM_mul_i(S3, T3, m1 + 1, n1 + 1, p1 + 1);
301
S4 = subtract_slices(m1, n2, A, 0, m1, n1, n2, S3, 0, m1, 0, n2);
302
if (gc_needed(av, 1))
303
gerepileall(av, 7, &M2, &T3, &M3, &M1, &C11, &M5, &S4); /* destroy S3 */
304
T4 = add_slices(n2, p1, B, n1, n2, 0, p1, T3, 0, n2, 0, p1);
305
if (gc_needed(av, 1))
306
gerepileall(av, 7, &M2, &M3, &M1, &C11, &M5, &S4, &T4); /* destroy T3 */
307
V1 = subtract_slices(m1, p1, M1, 0, m1, 0, p1, M5, 0, m1, 0, p1);
308
if (gc_needed(av, 1))
309
gerepileall(av, 6, &M2, &M3, &S4, &T4, &C11, &V1); /* destroy M1, M5 */
310
B22 = matslice(B, n1 + 1, n, p1 + 1, p);
311
M6 = ZM_mul_i(S4, B22, m1 + 1, n2 + 1, p2 + 1);
312
if (gc_needed(av, 1))
313
gerepileall(av, 6, &M2, &M3, &T4, &C11, &V1, &M6); /* destroy S4, B22 */
314
A22 = matslice(A, m1 + 1, m, n1 + 1, n);
315
M7 = ZM_mul_i(A22, T4, m2 + 1, n2 + 1, p1 + 1);
316
if (gc_needed(av, 1))
317
gerepileall(av, 6, &M2, &M3, &C11, &V1, &M6, &M7); /* destroy A22, T4 */
318
V3 = add_slices(m1, p2, V1, 0, m1, 0, p2, M3, 0, m2, 0, p2);
319
C12 = add_slices(m1, p2, V3, 0, m1, 0, p2, M6, 0, m1, 0, p2);
320
if (gc_needed(av, 1))
321
gerepileall(av, 6, &M2, &M3, &C11, &V1, &M7, &C12); /* destroy V3, M6 */
322
V2 = add_slices(m2, p1, V1, 0, m2, 0, p1, M2, 0, m2, 0, p2);
323
if (gc_needed(av, 1))
324
gerepileall(av, 5, &M3, &C11, &M7, &C12, &V2); /* destroy V1, M2 */
325
C21 = add_slices(m2, p1, V2, 0, m2, 0, p1, M7, 0, m2, 0, p1);
326
if (gc_needed(av, 1))
327
gerepileall(av, 5, &M3, &C11, &C12, &V2, &C21); /* destroy M7 */
328
C22 = add_slices(m2, p2, V2, 0, m2, 0, p2, M3, 0, m2, 0, p2);
329
if (gc_needed(av, 1))
330
gerepileall(av, 4, &C11, &C12, &C21, &C22); /* destroy V2, M3 */
331
C = shallowconcat(vconcat(C11, C21), vconcat(C12, C22));
332
return gerepilecopy(av, C);
333
}
334
335
/* x[i,]*y. Assume lg(x) > 1 and 0 < i < lgcols(x) */
336
static GEN
337
ZMrow_ZC_mul_i(GEN x, GEN y, long i, long lx)
338
{
339
pari_sp av = avma;
340
GEN c = mulii(gcoeff(x,i,1), gel(y,1)), ZERO = gen_0;
341
long k;
342
for (k = 2; k < lx; k++)
343
{
344
GEN t = mulii(gcoeff(x,i,k), gel(y,k));
345
if (t != ZERO) c = addii(c, t);
346
}
347
return gerepileuptoint(av, c);
348
}
349
GEN
350
ZMrow_ZC_mul(GEN x, GEN y, long i)
351
{ return ZMrow_ZC_mul_i(x, y, i, lg(x)); }
352
353
/* return x * y, 1 < lx = lg(x), l = lgcols(x) */
354
static GEN
355
ZM_ZC_mul_i(GEN x, GEN y, long lx, long l)
356
{
357
GEN z = cgetg(l,t_COL);
358
long i;
359
for (i=1; i<l; i++) gel(z,i) = ZMrow_ZC_mul_i(x,y,i,lx);
360
return z;
361
}
362
363
static GEN
364
ZM_mul_classical(GEN x, GEN y, long l, long lx, long ly)
365
{
366
long j;
367
GEN z = cgetg(ly, t_MAT);
368
for (j = 1; j < ly; j++)
369
gel(z, j) = ZM_ZC_mul_i(x, gel(y, j), lx, l);
370
return z;
371
}
372
373
static GEN
374
ZM_mul_slice(GEN A, GEN B, GEN P, GEN *mod)
375
{
376
pari_sp av = avma;
377
long i, n = lg(P)-1;
378
GEN H, T;
379
if (n == 1)
380
{
381
ulong p = uel(P,1);
382
GEN a = ZM_to_Flm(A, p);
383
GEN b = ZM_to_Flm(B, p);
384
GEN Hp = gerepileupto(av, Flm_to_ZM(Flm_mul(a, b, p)));
385
*mod = utoi(p); return Hp;
386
}
387
T = ZV_producttree(P);
388
A = ZM_nv_mod_tree(A, P, T);
389
B = ZM_nv_mod_tree(B, P, T);
390
H = cgetg(n+1, t_VEC);
391
for(i=1; i <= n; i++)
392
gel(H,i) = Flm_mul(gel(A,i),gel(B,i),P[i]);
393
H = nmV_chinese_center_tree_seq(H, P, T, ZV_chinesetree(P, T));
394
*mod = gmael(T, lg(T)-1, 1);
395
gerepileall(av, 2, &H, mod);
396
return H;
397
}
398
399
GEN
400
ZM_mul_worker(GEN P, GEN A, GEN B)
401
{
402
GEN V = cgetg(3, t_VEC);
403
gel(V,1) = ZM_mul_slice(A, B, P, &gel(V,2));
404
return V;
405
}
406
407
static GEN
408
ZM_mul_fast(GEN A, GEN B, long lA, long lB, long sA, long sB)
409
{
410
pari_sp av = avma;
411
forprime_t S;
412
GEN H, worker;
413
long h;
414
if (sA == 2 || sB == 2) return zeromat(nbrows(A),lB-1);
415
h = 1 + (sA + sB - 4) * BITS_IN_LONG + expu(lA-1);
416
init_modular_big(&S);
417
worker = snm_closure(is_entry("_ZM_mul_worker"), mkvec2(A,B));
418
H = gen_crt("ZM_mul", worker, &S, NULL, h, 0, NULL,
419
nmV_chinese_center, FpM_center);
420
return gerepileupto(av, H);
421
}
422
423
/* s = min(log_BIL |x|, log_BIL |y|), use Strassen-Winograd when
424
* min(dims) > B */
425
static long
426
sw_bound(long s)
427
{ return s > 60 ? 2: s > 25 ? 4: s > 15 ? 8 : s > 8 ? 16 : 32; }
428
429
static GEN
430
ZM_mul_i(GEN x, GEN y, long l, long lx, long ly)
431
{
432
long sx, sy, B;
433
if (lx==3 && l==3 && ly==3) return ZM2_mul(x,y);
434
sx = ZM_max_lg_i(x, lx, l);
435
sy = ZM_max_lg_i(y, ly, lx);
436
if ((lx > 70 && ly > 70 && l > 70) && (sx <= 10 * sy && sy <= 10 * sx))
437
return ZM_mul_fast(x, y, lx, ly, sx, sy);
438
439
B = sw_bound(minss(sx, sy));
440
if (l <= B || lx <= B || ly <= B)
441
return ZM_mul_classical(x, y, l, lx, ly);
442
else
443
return ZM_mul_sw(x, y, l - 1, lx - 1, ly - 1);
444
}
445
446
GEN
447
ZM_mul(GEN x, GEN y)
448
{
449
long lx = lg(x), ly = lg(y);
450
if (ly == 1) return cgetg(1,t_MAT);
451
if (lx == 1) return zeromat(0, ly-1);
452
return ZM_mul_i(x, y, lgcols(x), lx, ly);
453
}
454
455
GEN
456
QM_mul(GEN x, GEN y)
457
{
458
GEN dx, nx = Q_primitive_part(x, &dx);
459
GEN dy, ny = Q_primitive_part(y, &dy);
460
GEN z = ZM_mul(nx, ny);
461
if (dx || dy)
462
{
463
GEN d = dx ? dy ? gmul(dx, dy): dx : dy;
464
if (!gequal1(d)) z = ZM_Q_mul(z, d);
465
}
466
return z;
467
}
468
469
GEN
470
QM_sqr(GEN x)
471
{
472
GEN dx, nx = Q_primitive_part(x, &dx);
473
GEN z = ZM_sqr(nx);
474
if (dx)
475
z = ZM_Q_mul(z, gsqr(dx));
476
return z;
477
}
478
479
GEN
480
QM_QC_mul(GEN x, GEN y)
481
{
482
GEN dx, nx = Q_primitive_part(x, &dx);
483
GEN dy, ny = Q_primitive_part(y, &dy);
484
GEN z = ZM_ZC_mul(nx, ny);
485
if (dx || dy)
486
{
487
GEN d = dx ? dy ? gmul(dx, dy): dx : dy;
488
if (!gequal1(d)) z = ZC_Q_mul(z, d);
489
}
490
return z;
491
}
492
493
/* assume result is symmetric */
494
GEN
495
ZM_multosym(GEN x, GEN y)
496
{
497
long j, lx, ly = lg(y);
498
GEN M;
499
if (ly == 1) return cgetg(1,t_MAT);
500
lx = lg(x); /* = lgcols(y) */
501
if (lx == 1) return cgetg(1,t_MAT);
502
/* ly = lgcols(x) */
503
M = cgetg(ly, t_MAT);
504
for (j=1; j<ly; j++)
505
{
506
GEN z = cgetg(ly,t_COL), yj = gel(y,j);
507
long i;
508
for (i=1; i<j; i++) gel(z,i) = gcoeff(M,j,i);
509
for (i=j; i<ly; i++)gel(z,i) = ZMrow_ZC_mul_i(x,yj,i,lx);
510
gel(M,j) = z;
511
}
512
return M;
513
}
514
515
/* compute m*diagonal(d), assume lg(d) = lg(m). Shallow */
516
GEN
517
ZM_mul_diag(GEN m, GEN d)
518
{
519
long j, l;
520
GEN y = cgetg_copy(m, &l);
521
for (j=1; j<l; j++)
522
{
523
GEN c = gel(d,j);
524
gel(y,j) = equali1(c)? gel(m,j): ZC_Z_mul(gel(m,j), c);
525
}
526
return y;
527
}
528
/* compute diagonal(d)*m, assume lg(d) = lg(m~). Shallow */
529
GEN
530
ZM_diag_mul(GEN d, GEN m)
531
{
532
long i, j, l = lg(d), lm = lg(m);
533
GEN y = cgetg(lm, t_MAT);
534
for (j=1; j<lm; j++) gel(y,j) = cgetg(l, t_COL);
535
for (i=1; i<l; i++)
536
{
537
GEN c = gel(d,i);
538
if (equali1(c))
539
for (j=1; j<lm; j++) gcoeff(y,i,j) = gcoeff(m,i,j);
540
else
541
for (j=1; j<lm; j++) gcoeff(y,i,j) = mulii(gcoeff(m,i,j), c);
542
}
543
return y;
544
}
545
546
/* assume lx > 1 is lg(x) = lg(y) */
547
static GEN
548
ZV_dotproduct_i(GEN x, GEN y, long lx)
549
{
550
pari_sp av = avma;
551
GEN c = mulii(gel(x,1), gel(y,1));
552
long i;
553
for (i = 2; i < lx; i++)
554
{
555
GEN t = mulii(gel(x,i), gel(y,i));
556
if (t != gen_0) c = addii(c, t);
557
}
558
return gerepileuptoint(av, c);
559
}
560
561
/* x~ * y, assuming result is symmetric */
562
GEN
563
ZM_transmultosym(GEN x, GEN y)
564
{
565
long i, j, l, ly = lg(y);
566
GEN M;
567
if (ly == 1) return cgetg(1,t_MAT);
568
/* lg(x) = ly */
569
l = lgcols(y); /* = lgcols(x) */
570
M = cgetg(ly, t_MAT);
571
for (i=1; i<ly; i++)
572
{
573
GEN xi = gel(x,i), c = cgetg(ly,t_COL);
574
gel(M,i) = c;
575
for (j=1; j<i; j++)
576
gcoeff(M,i,j) = gel(c,j) = ZV_dotproduct_i(xi,gel(y,j),l);
577
gel(c,i) = ZV_dotproduct_i(xi,gel(y,i),l);
578
}
579
return M;
580
}
581
/* x~ * y */
582
GEN
583
ZM_transmul(GEN x, GEN y)
584
{
585
long i, j, l, lx, ly = lg(y);
586
GEN M;
587
if (ly == 1) return cgetg(1,t_MAT);
588
lx = lg(x);
589
l = lgcols(y);
590
if (lgcols(x) != l) pari_err_OP("operation 'ZM_transmul'", x,y);
591
M = cgetg(ly, t_MAT);
592
for (i=1; i<ly; i++)
593
{
594
GEN yi = gel(y,i), c = cgetg(lx,t_COL);
595
gel(M,i) = c;
596
for (j=1; j<lx; j++) gel(c,j) = ZV_dotproduct_i(yi,gel(x,j),l);
597
}
598
return M;
599
}
600
601
static GEN
602
ZM_sqr_i(GEN x, long l)
603
{
604
long s = ZM_max_lg_i(x, l, l);
605
if (l > 70) return ZM_mul_fast(x, x, l, l, s, s);
606
if (l <= sw_bound(s))
607
return ZM_mul_classical(x, x, l, l, l);
608
else
609
return ZM_mul_sw(x, x, l - 1, l - 1, l - 1);
610
}
611
612
GEN
613
ZM_sqr(GEN x)
614
{
615
long lx=lg(x);
616
if (lx==1) return cgetg(1,t_MAT);
617
return ZM_sqr_i(x, lx);
618
}
619
GEN
620
ZM_ZC_mul(GEN x, GEN y)
621
{
622
long lx = lg(x);
623
return lx==1? cgetg(1,t_COL): ZM_ZC_mul_i(x, y, lx, lgcols(x));
624
}
625
626
GEN
627
ZC_Z_div(GEN x, GEN c)
628
{ pari_APPLY_type(t_COL, Qdivii(gel(x,i), c)) }
629
630
GEN
631
ZM_Z_div(GEN x, GEN c)
632
{ pari_APPLY_same(ZC_Z_div(gel(x, i), c)) }
633
634
GEN
635
ZC_Q_mul(GEN A, GEN z)
636
{
637
pari_sp av = avma;
638
long i, l = lg(A);
639
GEN d, n, Ad, B, u;
640
if (typ(z)==t_INT) return ZC_Z_mul(A,z);
641
n = gel(z, 1); d = gel(z, 2);
642
Ad = FpC_red(A, d);
643
u = gcdii(d, FpV_factorback(Ad, NULL, d));
644
B = cgetg(l, t_COL);
645
if (equali1(u))
646
{
647
for(i=1; i<l; i++)
648
gel(B, i) = mkfrac(mulii(n, gel(A,i)), d);
649
} else
650
{
651
for(i=1; i<l; i++)
652
{
653
GEN di = gcdii(gel(Ad, i), u), ni = mulii(n, diviiexact(gel(A,i), di));
654
if (equalii(d, di))
655
gel(B, i) = ni;
656
else
657
gel(B, i) = mkfrac(ni, diviiexact(d, di));
658
}
659
}
660
return gerepilecopy(av, B);
661
}
662
663
GEN
664
ZM_Q_mul(GEN x, GEN z)
665
{
666
if (typ(z)==t_INT) return ZM_Z_mul(x,z);
667
pari_APPLY_same(ZC_Q_mul(gel(x, i), z));
668
}
669
670
long
671
zv_dotproduct(GEN x, GEN y)
672
{
673
long i, lx = lg(x);
674
ulong c;
675
if (lx == 1) return 0;
676
c = uel(x,1)*uel(y,1);
677
for (i = 2; i < lx; i++)
678
c += uel(x,i)*uel(y,i);
679
return c;
680
}
681
682
GEN
683
ZV_ZM_mul(GEN x, GEN y)
684
{
685
long i, lx = lg(x), ly = lg(y);
686
GEN z;
687
if (lx == 1) return zerovec(ly-1);
688
z = cgetg(ly, t_VEC);
689
for (i = 1; i < ly; i++) gel(z,i) = ZV_dotproduct_i(x, gel(y,i), lx);
690
return z;
691
}
692
693
GEN
694
ZC_ZV_mul(GEN x, GEN y)
695
{
696
long i,j, lx=lg(x), ly=lg(y);
697
GEN z;
698
if (ly==1) return cgetg(1,t_MAT);
699
z = cgetg(ly,t_MAT);
700
for (j=1; j < ly; j++)
701
{
702
gel(z,j) = cgetg(lx,t_COL);
703
for (i=1; i<lx; i++) gcoeff(z,i,j) = mulii(gel(x,i),gel(y,j));
704
}
705
return z;
706
}
707
708
GEN
709
ZV_dotsquare(GEN x)
710
{
711
long i, lx;
712
pari_sp av;
713
GEN z;
714
lx = lg(x);
715
if (lx == 1) return gen_0;
716
av = avma; z = sqri(gel(x,1));
717
for (i=2; i<lx; i++) z = addii(z, sqri(gel(x,i)));
718
return gerepileuptoint(av,z);
719
}
720
721
GEN
722
ZV_dotproduct(GEN x,GEN y)
723
{
724
long lx;
725
if (x == y) return ZV_dotsquare(x);
726
lx = lg(x);
727
if (lx == 1) return gen_0;
728
return ZV_dotproduct_i(x, y, lx);
729
}
730
731
static GEN
732
_ZM_mul(void *data /*ignored*/, GEN x, GEN y)
733
{ (void)data; return ZM_mul(x,y); }
734
static GEN
735
_ZM_sqr(void *data /*ignored*/, GEN x)
736
{ (void)data; return ZM_sqr(x); }
737
GEN
738
ZM_pow(GEN x, GEN n)
739
{
740
pari_sp av = avma;
741
if (!signe(n)) return matid(lg(x)-1);
742
return gerepilecopy(av, gen_pow_i(x, n, NULL, &_ZM_sqr, &_ZM_mul));
743
}
744
GEN
745
ZM_powu(GEN x, ulong n)
746
{
747
pari_sp av = avma;
748
if (!n) return matid(lg(x)-1);
749
return gerepilecopy(av, gen_powu_i(x, n, NULL, &_ZM_sqr, &_ZM_mul));
750
}
751
/********************************************************************/
752
/** **/
753
/** ADD, SUB **/
754
/** **/
755
/********************************************************************/
756
static GEN
757
ZC_add_i(GEN x, GEN y, long lx)
758
{
759
GEN A = cgetg(lx, t_COL);
760
long i;
761
for (i=1; i<lx; i++) gel(A,i) = addii(gel(x,i), gel(y,i));
762
return A;
763
}
764
GEN
765
ZC_add(GEN x, GEN y) { return ZC_add_i(x, y, lg(x)); }
766
GEN
767
ZC_Z_add(GEN x, GEN y)
768
{
769
long k, lx = lg(x);
770
GEN z = cgetg(lx, t_COL);
771
if (lx == 1) pari_err_TYPE2("+",x,y);
772
gel(z,1) = addii(y,gel(x,1));
773
for (k = 2; k < lx; k++) gel(z,k) = icopy(gel(x,k));
774
return z;
775
}
776
777
static GEN
778
ZC_sub_i(GEN x, GEN y, long lx)
779
{
780
long i;
781
GEN A = cgetg(lx, t_COL);
782
for (i=1; i<lx; i++) gel(A,i) = subii(gel(x,i), gel(y,i));
783
return A;
784
}
785
GEN
786
ZC_sub(GEN x, GEN y) { return ZC_sub_i(x, y, lg(x)); }
787
GEN
788
ZC_Z_sub(GEN x, GEN y)
789
{
790
long k, lx = lg(x);
791
GEN z = cgetg(lx, t_COL);
792
if (lx == 1) pari_err_TYPE2("+",x,y);
793
gel(z,1) = subii(gel(x,1), y);
794
for (k = 2; k < lx; k++) gel(z,k) = icopy(gel(x,k));
795
return z;
796
}
797
GEN
798
Z_ZC_sub(GEN a, GEN x)
799
{
800
long k, lx = lg(x);
801
GEN z = cgetg(lx, t_COL);
802
if (lx == 1) pari_err_TYPE2("-",a,x);
803
gel(z,1) = subii(a, gel(x,1));
804
for (k = 2; k < lx; k++) gel(z,k) = negi(gel(x,k));
805
return z;
806
}
807
808
GEN
809
ZM_add(GEN x, GEN y)
810
{
811
long lx = lg(x), l, j;
812
GEN z;
813
if (lx == 1) return cgetg(1, t_MAT);
814
z = cgetg(lx, t_MAT); l = lgcols(x);
815
for (j = 1; j < lx; j++) gel(z,j) = ZC_add_i(gel(x,j), gel(y,j), l);
816
return z;
817
}
818
GEN
819
ZM_sub(GEN x, GEN y)
820
{
821
long lx = lg(x), l, j;
822
GEN z;
823
if (lx == 1) return cgetg(1, t_MAT);
824
z = cgetg(lx, t_MAT); l = lgcols(x);
825
for (j = 1; j < lx; j++) gel(z,j) = ZC_sub_i(gel(x,j), gel(y,j), l);
826
return z;
827
}
828
/********************************************************************/
829
/** **/
830
/** LINEAR COMBINATION **/
831
/** **/
832
/********************************************************************/
833
/* return X/c assuming division is exact */
834
GEN
835
ZC_Z_divexact(GEN x, GEN c)
836
{ pari_APPLY_type(t_COL, diviiexact(gel(x,i), c)) }
837
GEN
838
ZC_divexactu(GEN x, ulong c)
839
{ pari_APPLY_type(t_COL, diviuexact(gel(x,i), c)) }
840
841
GEN
842
ZM_Z_divexact(GEN x, GEN c)
843
{ pari_APPLY_same(ZC_Z_divexact(gel(x,i), c)) }
844
845
GEN
846
ZM_divexactu(GEN x, ulong c)
847
{ pari_APPLY_same(ZC_divexactu(gel(x,i), c)) }
848
849
GEN
850
ZC_Z_mul(GEN x, GEN c)
851
{
852
if (!signe(c)) return zerocol(lg(x)-1);
853
if (is_pm1(c)) return (signe(c) > 0)? ZC_copy(x): ZC_neg(x);
854
pari_APPLY_type(t_COL, mulii(gel(x,i), c))
855
}
856
857
GEN
858
ZC_z_mul(GEN x, long c)
859
{
860
if (!c) return zerocol(lg(x)-1);
861
if (c == 1) return ZC_copy(x);
862
if (c ==-1) return ZC_neg(x);
863
pari_APPLY_type(t_COL, mulsi(c, gel(x,i)))
864
}
865
866
GEN
867
zv_z_mul(GEN x, long n)
868
{ pari_APPLY_long(x[i]*n) }
869
870
/* return a ZM */
871
GEN
872
nm_Z_mul(GEN X, GEN c)
873
{
874
long i, j, h, l = lg(X), s = signe(c);
875
GEN A;
876
if (l == 1) return cgetg(1, t_MAT);
877
h = lgcols(X);
878
if (!s) return zeromat(h-1, l-1);
879
if (is_pm1(c)) {
880
if (s > 0) return Flm_to_ZM(X);
881
X = Flm_to_ZM(X); ZM_togglesign(X); return X;
882
}
883
A = cgetg(l, t_MAT);
884
for (j = 1; j < l; j++)
885
{
886
GEN a = cgetg(h, t_COL), x = gel(X, j);
887
for (i = 1; i < h; i++) gel(a,i) = muliu(c, x[i]);
888
gel(A,j) = a;
889
}
890
return A;
891
}
892
GEN
893
ZM_Z_mul(GEN X, GEN c)
894
{
895
long i, j, h, l = lg(X);
896
GEN A;
897
if (l == 1) return cgetg(1, t_MAT);
898
h = lgcols(X);
899
if (!signe(c)) return zeromat(h-1, l-1);
900
if (is_pm1(c)) return (signe(c) > 0)? ZM_copy(X): ZM_neg(X);
901
A = cgetg(l, t_MAT);
902
for (j = 1; j < l; j++)
903
{
904
GEN a = cgetg(h, t_COL), x = gel(X, j);
905
for (i = 1; i < h; i++) gel(a,i) = mulii(c, gel(x,i));
906
gel(A,j) = a;
907
}
908
return A;
909
}
910
void
911
ZC_lincomb1_inplace_i(GEN X, GEN Y, GEN v, long n)
912
{
913
long i;
914
for (i = n; i; i--) gel(X,i) = addmulii_inplace(gel(X,i), gel(Y,i), v);
915
}
916
/* X <- X + v Y (elementary col operation) */
917
void
918
ZC_lincomb1_inplace(GEN X, GEN Y, GEN v)
919
{
920
if (lgefint(v) != 2) return ZC_lincomb1_inplace_i(X, Y, v, lg(X)-1);
921
}
922
void
923
Flc_lincomb1_inplace(GEN X, GEN Y, ulong v, ulong q)
924
{
925
long i;
926
if (!v) return; /* v = 0 */
927
for (i = lg(X)-1; i; i--) X[i] = Fl_add(X[i], Fl_mul(Y[i], v, q), q);
928
}
929
930
/* X + v Y, wasteful if (v = 0) */
931
static GEN
932
ZC_lincomb1(GEN v, GEN x, GEN y)
933
{ pari_APPLY_type(t_COL, addmulii(gel(x,i), gel(y,i), v)) }
934
935
/* -X + vY */
936
static GEN
937
ZC_lincomb_1(GEN v, GEN x, GEN y)
938
{ pari_APPLY_type(t_COL, mulsubii(gel(y,i), v, gel(x,i))) }
939
940
/* X,Y compatible ZV; u,v in Z. Returns A = u*X + v*Y */
941
GEN
942
ZC_lincomb(GEN u, GEN v, GEN X, GEN Y)
943
{
944
long su, sv;
945
GEN A;
946
947
su = signe(u); if (!su) return ZC_Z_mul(Y, v);
948
sv = signe(v); if (!sv) return ZC_Z_mul(X, u);
949
if (is_pm1(v))
950
{
951
if (is_pm1(u))
952
{
953
if (su != sv) A = ZC_sub(X, Y);
954
else A = ZC_add(X, Y);
955
if (su < 0) ZV_togglesign(A); /* in place but was created above */
956
}
957
else
958
{
959
if (sv > 0) A = ZC_lincomb1 (u, Y, X);
960
else A = ZC_lincomb_1(u, Y, X);
961
}
962
}
963
else if (is_pm1(u))
964
{
965
if (su > 0) A = ZC_lincomb1 (v, X, Y);
966
else A = ZC_lincomb_1(v, X, Y);
967
}
968
else
969
{ /* not cgetg_copy: x may be a t_VEC */
970
long i, lx = lg(X);
971
A = cgetg(lx,t_COL);
972
for (i=1; i<lx; i++) gel(A,i) = lincombii(u,v,gel(X,i),gel(Y,i));
973
}
974
return A;
975
}
976
977
/********************************************************************/
978
/** **/
979
/** CONVERSIONS **/
980
/** **/
981
/********************************************************************/
982
GEN
983
ZV_to_nv(GEN x)
984
{ pari_APPLY_ulong(itou(gel(x,i))) }
985
986
GEN
987
zm_to_ZM(GEN x)
988
{ pari_APPLY_type(t_MAT, zc_to_ZC(gel(x,i))) }
989
990
GEN
991
zmV_to_ZMV(GEN x)
992
{ pari_APPLY_type(t_VEC, zm_to_ZM(gel(x,i))) }
993
994
/* same as Flm_to_ZM but do not assume positivity */
995
GEN
996
ZM_to_zm(GEN x)
997
{ pari_APPLY_same(ZV_to_zv(gel(x,i))) }
998
999
GEN
1000
zv_to_Flv(GEN x, ulong p)
1001
{ pari_APPLY_ulong(umodsu(x[i], p)) }
1002
1003
GEN
1004
zm_to_Flm(GEN x, ulong p)
1005
{ pari_APPLY_same(zv_to_Flv(gel(x,i),p)) }
1006
1007
GEN
1008
ZMV_to_zmV(GEN x)
1009
{ pari_APPLY_type(t_VEC, ZM_to_zm(gel(x,i))) }
1010
1011
/********************************************************************/
1012
/** **/
1013
/** COPY, NEGATION **/
1014
/** **/
1015
/********************************************************************/
1016
GEN
1017
ZC_copy(GEN x)
1018
{
1019
long i, lx = lg(x);
1020
GEN y = cgetg(lx, t_COL);
1021
for (i=1; i<lx; i++)
1022
{
1023
GEN c = gel(x,i);
1024
gel(y,i) = lgefint(c) == 2? gen_0: icopy(c);
1025
}
1026
return y;
1027
}
1028
1029
GEN
1030
ZM_copy(GEN x)
1031
{ pari_APPLY_same(ZC_copy(gel(x,i))) }
1032
1033
void
1034
ZV_neg_inplace(GEN M)
1035
{
1036
long l = lg(M);
1037
while (--l > 0) gel(M,l) = negi(gel(M,l));
1038
}
1039
GEN
1040
ZC_neg(GEN x)
1041
{ pari_APPLY_type(t_COL, negi(gel(x,i))) }
1042
1043
GEN
1044
zv_neg(GEN x)
1045
{ pari_APPLY_long(-x[i]) }
1046
GEN
1047
zv_neg_inplace(GEN M)
1048
{
1049
long l = lg(M);
1050
while (--l > 0) M[l] = -M[l];
1051
return M;
1052
}
1053
GEN
1054
zv_abs(GEN x)
1055
{ pari_APPLY_ulong(labs(x[i])) }
1056
GEN
1057
ZM_neg(GEN x)
1058
{ pari_APPLY_same(ZC_neg(gel(x,i))) }
1059
1060
void
1061
ZV_togglesign(GEN M)
1062
{
1063
long l = lg(M);
1064
while (--l > 0) togglesign_safe(&gel(M,l));
1065
}
1066
void
1067
ZM_togglesign(GEN M)
1068
{
1069
long l = lg(M);
1070
while (--l > 0) ZV_togglesign(gel(M,l));
1071
}
1072
1073
/********************************************************************/
1074
/** **/
1075
/** "DIVISION" mod HNF **/
1076
/** **/
1077
/********************************************************************/
1078
/* Reduce ZC x modulo ZM y in HNF, may return x itself (not a copy) */
1079
GEN
1080
ZC_hnfremdiv(GEN x, GEN y, GEN *Q)
1081
{
1082
long i, l = lg(x);
1083
GEN q;
1084
1085
if (Q) *Q = cgetg(l,t_COL);
1086
if (l == 1) return cgetg(1,t_COL);
1087
for (i = l-1; i>0; i--)
1088
{
1089
q = diviiround(gel(x,i), gcoeff(y,i,i));
1090
if (signe(q)) {
1091
togglesign(q);
1092
x = ZC_lincomb(gen_1, q, x, gel(y,i));
1093
}
1094
if (Q) gel(*Q, i) = q;
1095
}
1096
return x;
1097
}
1098
1099
/* x = y Q + R, may return some columns of x (not copies) */
1100
GEN
1101
ZM_hnfdivrem(GEN x, GEN y, GEN *Q)
1102
{
1103
long lx = lg(x), i;
1104
GEN R = cgetg(lx, t_MAT);
1105
if (Q)
1106
{
1107
GEN q = cgetg(lx, t_MAT); *Q = q;
1108
for (i=1; i<lx; i++) gel(R,i) = ZC_hnfremdiv(gel(x,i),y,(GEN*)(q+i));
1109
}
1110
else
1111
for (i=1; i<lx; i++)
1112
{
1113
pari_sp av = avma;
1114
GEN z = ZC_hnfrem(gel(x,i),y);
1115
gel(R,i) = (avma == av)? ZC_copy(z): gerepileupto(av, z);
1116
}
1117
return R;
1118
}
1119
1120
/********************************************************************/
1121
/** **/
1122
/** TESTS **/
1123
/** **/
1124
/********************************************************************/
1125
int
1126
zv_equal0(GEN V)
1127
{
1128
long l = lg(V);
1129
while (--l > 0)
1130
if (V[l]) return 0;
1131
return 1;
1132
}
1133
1134
int
1135
ZV_equal0(GEN V)
1136
{
1137
long l = lg(V);
1138
while (--l > 0)
1139
if (signe(gel(V,l))) return 0;
1140
return 1;
1141
}
1142
int
1143
ZMrow_equal0(GEN V, long i)
1144
{
1145
long l = lg(V);
1146
while (--l > 0)
1147
if (signe(gcoeff(V,i,l))) return 0;
1148
return 1;
1149
}
1150
1151
static int
1152
ZV_equal_lg(GEN V, GEN W, long l)
1153
{
1154
while (--l > 0)
1155
if (!equalii(gel(V,l), gel(W,l))) return 0;
1156
return 1;
1157
}
1158
int
1159
ZV_equal(GEN V, GEN W)
1160
{
1161
long l = lg(V);
1162
if (lg(W) != l) return 0;
1163
return ZV_equal_lg(V, W, l);
1164
}
1165
int
1166
ZM_equal(GEN A, GEN B)
1167
{
1168
long i, m, l = lg(A);
1169
if (lg(B) != l) return 0;
1170
if (l == 1) return 1;
1171
m = lgcols(A);
1172
if (lgcols(B) != m) return 0;
1173
for (i = 1; i < l; i++)
1174
if (!ZV_equal_lg(gel(A,i), gel(B,i), m)) return 0;
1175
return 1;
1176
}
1177
int
1178
ZM_equal0(GEN A)
1179
{
1180
long i, j, m, l = lg(A);
1181
if (l == 1) return 1;
1182
m = lgcols(A);
1183
for (j = 1; j < l; j++)
1184
for (i = 1; i < m; i++)
1185
if (signe(gcoeff(A,i,j))) return 0;
1186
return 1;
1187
}
1188
int
1189
zv_equal(GEN V, GEN W)
1190
{
1191
long l = lg(V);
1192
if (lg(W) != l) return 0;
1193
while (--l > 0)
1194
if (V[l] != W[l]) return 0;
1195
return 1;
1196
}
1197
1198
int
1199
zvV_equal(GEN V, GEN W)
1200
{
1201
long l = lg(V);
1202
if (lg(W) != l) return 0;
1203
while (--l > 0)
1204
if (!zv_equal(gel(V,l),gel(W,l))) return 0;
1205
return 1;
1206
}
1207
1208
int
1209
ZM_ishnf(GEN x)
1210
{
1211
long i,j, lx = lg(x);
1212
for (i=1; i<lx; i++)
1213
{
1214
GEN xii = gcoeff(x,i,i);
1215
if (signe(xii) <= 0) return 0;
1216
for (j=1; j<i; j++)
1217
if (signe(gcoeff(x,i,j))) return 0;
1218
for (j=i+1; j<lx; j++)
1219
{
1220
GEN xij = gcoeff(x,i,j);
1221
if (signe(xij)<0 || cmpii(xij,xii)>=0) return 0;
1222
}
1223
}
1224
return 1;
1225
}
1226
int
1227
ZM_isidentity(GEN x)
1228
{
1229
long i,j, lx = lg(x);
1230
1231
if (lx == 1) return 1;
1232
if (lx != lgcols(x)) return 0;
1233
for (j=1; j<lx; j++)
1234
{
1235
GEN c = gel(x,j);
1236
for (i=1; i<j; )
1237
if (signe(gel(c,i++))) return 0;
1238
/* i = j */
1239
if (!equali1(gel(c,i++))) return 0;
1240
for ( ; i<lx; )
1241
if (signe(gel(c,i++))) return 0;
1242
}
1243
return 1;
1244
}
1245
int
1246
ZM_isdiagonal(GEN x)
1247
{
1248
long i,j, lx = lg(x);
1249
if (lx == 1) return 1;
1250
if (lx != lgcols(x)) return 0;
1251
1252
for (j=1; j<lx; j++)
1253
{
1254
GEN c = gel(x,j);
1255
for (i=1; i<j; i++)
1256
if (signe(gel(c,i))) return 0;
1257
for (i++; i<lx; i++)
1258
if (signe(gel(c,i))) return 0;
1259
}
1260
return 1;
1261
}
1262
int
1263
ZM_isscalar(GEN x, GEN s)
1264
{
1265
long i, j, lx = lg(x);
1266
1267
if (lx == 1) return 1;
1268
if (!s) s = gcoeff(x,1,1);
1269
if (equali1(s)) return ZM_isidentity(x);
1270
if (lx != lgcols(x)) return 0;
1271
for (j=1; j<lx; j++)
1272
{
1273
GEN c = gel(x,j);
1274
for (i=1; i<j; )
1275
if (signe(gel(c,i++))) return 0;
1276
/* i = j */
1277
if (!equalii(gel(c,i++), s)) return 0;
1278
for ( ; i<lx; )
1279
if (signe(gel(c,i++))) return 0;
1280
}
1281
return 1;
1282
}
1283
1284
long
1285
ZC_is_ei(GEN x)
1286
{
1287
long i, j = 0, l = lg(x);
1288
for (i = 1; i < l; i++)
1289
{
1290
GEN c = gel(x,i);
1291
long s = signe(c);
1292
if (!s) continue;
1293
if (s < 0 || !is_pm1(c) || j) return 0;
1294
j = i;
1295
}
1296
return j;
1297
}
1298
1299
/********************************************************************/
1300
/** **/
1301
/** MISCELLANEOUS **/
1302
/** **/
1303
/********************************************************************/
1304
/* assume lg(x) = lg(y), x,y in Z^n */
1305
int
1306
ZV_cmp(GEN x, GEN y)
1307
{
1308
long fl,i, lx = lg(x);
1309
for (i=1; i<lx; i++)
1310
if (( fl = cmpii(gel(x,i), gel(y,i)) )) return fl;
1311
return 0;
1312
}
1313
/* assume lg(x) = lg(y), x,y in Z^n */
1314
int
1315
ZV_abscmp(GEN x, GEN y)
1316
{
1317
long fl,i, lx = lg(x);
1318
for (i=1; i<lx; i++)
1319
if (( fl = abscmpii(gel(x,i), gel(y,i)) )) return fl;
1320
return 0;
1321
}
1322
1323
long
1324
zv_content(GEN x)
1325
{
1326
long i, s, l = lg(x);
1327
if (l == 1) return 0;
1328
s = labs(x[1]);
1329
for (i = 2; i < l && s != 1; i++) s = ugcd(s, labs(x[i]));
1330
return s;
1331
}
1332
GEN
1333
ZV_content(GEN x)
1334
{
1335
long i, l = lg(x);
1336
pari_sp av = avma;
1337
GEN c;
1338
if (l == 1) return gen_0;
1339
if (l == 2) return absi(gel(x,1));
1340
c = gel(x,1);
1341
for (i = 2; i < l; i++)
1342
{
1343
c = gcdii(c, gel(x,i));
1344
if (is_pm1(c)) { set_avma(av); return gen_1; }
1345
}
1346
return gerepileuptoint(av, c);
1347
}
1348
1349
GEN
1350
ZM_det_triangular(GEN mat)
1351
{
1352
pari_sp av;
1353
long i,l = lg(mat);
1354
GEN s;
1355
1356
if (l<3) return l<2? gen_1: icopy(gcoeff(mat,1,1));
1357
av = avma; s = gcoeff(mat,1,1);
1358
for (i=2; i<l; i++) s = mulii(s,gcoeff(mat,i,i));
1359
return gerepileuptoint(av,s);
1360
}
1361
1362
/* assumes no overflow */
1363
long
1364
zv_prod(GEN v)
1365
{
1366
long n, i, l = lg(v);
1367
if (l == 1) return 1;
1368
n = v[1]; for (i = 2; i < l; i++) n *= v[i];
1369
return n;
1370
}
1371
1372
static GEN
1373
_mulii(void *E, GEN a, GEN b)
1374
{ (void) E; return mulii(a, b); }
1375
1376
/* product of ulongs */
1377
GEN
1378
zv_prod_Z(GEN v)
1379
{
1380
pari_sp av = avma;
1381
long k, m, n = lg(v)-1;
1382
GEN V;
1383
switch(n) {
1384
case 0: return gen_1;
1385
case 1: return utoi(v[1]);
1386
case 2: return muluu(v[1], v[2]);
1387
}
1388
m = n >> 1;
1389
V = cgetg(m + (odd(n)? 2: 1), t_VEC);
1390
for (k = 1; k <= m; k++) gel(V,k) = muluu(v[k<<1], v[(k<<1)-1]);
1391
if (odd(n)) gel(V,k) = utoipos(v[n]);
1392
return gerepileuptoint(av, gen_product(V, NULL, &_mulii));
1393
}
1394
GEN
1395
vecsmall_prod(GEN v)
1396
{
1397
pari_sp av = avma;
1398
long k, m, n = lg(v)-1;
1399
GEN V;
1400
switch (n) {
1401
case 0: return gen_1;
1402
case 1: return stoi(v[1]);
1403
case 2: return mulss(v[1], v[2]);
1404
}
1405
m = n >> 1;
1406
V = cgetg(m + (odd(n)? 2: 1), t_VEC);
1407
for (k = 1; k <= m; k++) gel(V,k) = mulss(v[k<<1], v[(k<<1)-1]);
1408
if (odd(n)) gel(V,k) = stoi(v[n]);
1409
return gerepileuptoint(av, gen_product(V, NULL, &_mulii));
1410
}
1411
1412
GEN
1413
ZV_prod(GEN v)
1414
{
1415
pari_sp av = avma;
1416
long i, l = lg(v);
1417
GEN n;
1418
if (l == 1) return gen_1;
1419
if (l > 7) return gerepileuptoint(av, gen_product(v, NULL, _mulii));
1420
n = gel(v,1);
1421
if (l == 2) return icopy(n);
1422
for (i = 2; i < l; i++) n = mulii(n, gel(v,i));
1423
return gerepileuptoint(av, n);
1424
}
1425
/* assumes no overflow */
1426
long
1427
zv_sum(GEN v)
1428
{
1429
long n, i, l = lg(v);
1430
if (l == 1) return 0;
1431
n = v[1]; for (i = 2; i < l; i++) n += v[i];
1432
return n;
1433
}
1434
/* assumes no overflow and 0 <= n <= #v */
1435
long
1436
zv_sumpart(GEN v, long n)
1437
{
1438
long i, p;
1439
if (!n) return 0;
1440
p = v[1]; for (i = 2; i <= n; i++) p += v[i];
1441
return p;
1442
}
1443
GEN
1444
ZV_sum(GEN v)
1445
{
1446
pari_sp av = avma;
1447
long i, l = lg(v);
1448
GEN n;
1449
if (l == 1) return gen_0;
1450
n = gel(v,1);
1451
if (l == 2) return icopy(n);
1452
for (i = 2; i < l; i++) n = addii(n, gel(v,i));
1453
return gerepileuptoint(av, n);
1454
}
1455
1456
/********************************************************************/
1457
/** **/
1458
/** GRAM SCHMIDT REDUCTION (integer matrices) **/
1459
/** **/
1460
/********************************************************************/
1461
1462
/* L[k,] += q * L[l,], l < k. Inefficient if q = 0 */
1463
static void
1464
Zupdate_row(long k, long l, GEN q, GEN L, GEN B)
1465
{
1466
long i, qq = itos_or_0(q);
1467
if (!qq)
1468
{
1469
for(i=1;i<l;i++) gcoeff(L,k,i) = addii(gcoeff(L,k,i),mulii(q,gcoeff(L,l,i)));
1470
gcoeff(L,k,l) = addii(gcoeff(L,k,l), mulii(q,B));
1471
return;
1472
}
1473
if (qq == 1) {
1474
for (i=1;i<l; i++) gcoeff(L,k,i) = addii(gcoeff(L,k,i),gcoeff(L,l,i));
1475
gcoeff(L,k,l) = addii(gcoeff(L,k,l), B);
1476
} else if (qq == -1) {
1477
for (i=1;i<l; i++) gcoeff(L,k,i) = subii(gcoeff(L,k,i),gcoeff(L,l,i));
1478
gcoeff(L,k,l) = addii(gcoeff(L,k,l), negi(B));
1479
} else {
1480
for(i=1;i<l;i++) gcoeff(L,k,i) = addii(gcoeff(L,k,i),mulsi(qq,gcoeff(L,l,i)));
1481
gcoeff(L,k,l) = addii(gcoeff(L,k,l), mulsi(qq,B));
1482
}
1483
}
1484
1485
/* update L[k,] */
1486
static void
1487
ZRED(long k, long l, GEN x, GEN L, GEN B)
1488
{
1489
GEN q = truedivii(addii(B,shifti(gcoeff(L,k,l),1)), shifti(B,1));
1490
if (!signe(q)) return;
1491
q = negi(q);
1492
Zupdate_row(k,l,q,L,B);
1493
gel(x,k) = ZC_lincomb(gen_1, q, gel(x,k), gel(x,l));
1494
}
1495
1496
/* Gram-Schmidt reduction, x a ZM */
1497
static void
1498
ZincrementalGS(GEN x, GEN L, GEN B, long k)
1499
{
1500
long i, j;
1501
for (j=1; j<=k; j++)
1502
{
1503
pari_sp av = avma;
1504
GEN u = ZV_dotproduct(gel(x,k), gel(x,j));
1505
for (i=1; i<j; i++)
1506
{
1507
u = subii(mulii(gel(B,i+1), u), mulii(gcoeff(L,k,i), gcoeff(L,j,i)));
1508
u = diviiexact(u, gel(B,i));
1509
}
1510
gcoeff(L,k,j) = gerepileuptoint(av, u);
1511
}
1512
gel(B,k+1) = gcoeff(L,k,k); gcoeff(L,k,k) = gen_1;
1513
}
1514
1515
/* Variant reducemodinvertible(ZC v, ZM y), when y singular.
1516
* Very inefficient if y is not LLL-reduced of maximal rank */
1517
static GEN
1518
ZC_reducemodmatrix_i(GEN v, GEN y)
1519
{
1520
GEN B, L, x = shallowconcat(y, v);
1521
long k, lx = lg(x), nx = lx-1;
1522
1523
B = scalarcol_shallow(gen_1, lx);
1524
L = zeromatcopy(nx, nx);
1525
for (k=1; k <= nx; k++) ZincrementalGS(x, L, B, k);
1526
for (k = nx-1; k >= 1; k--) ZRED(nx,k, x,L,gel(B,k+1));
1527
return gel(x,nx);
1528
}
1529
GEN
1530
ZC_reducemodmatrix(GEN v, GEN y) {
1531
pari_sp av = avma;
1532
return gerepilecopy(av, ZC_reducemodmatrix_i(v,y));
1533
}
1534
1535
/* Variant reducemodinvertible(ZM v, ZM y), when y singular.
1536
* Very inefficient if y is not LLL-reduced of maximal rank */
1537
static GEN
1538
ZM_reducemodmatrix_i(GEN v, GEN y)
1539
{
1540
GEN B, L, V;
1541
long j, k, lv = lg(v), nx = lg(y), lx = nx+1;
1542
1543
V = cgetg(lv, t_MAT);
1544
B = scalarcol_shallow(gen_1, lx);
1545
L = zeromatcopy(nx, nx);
1546
for (k=1; k < nx; k++) ZincrementalGS(y, L, B, k);
1547
for (j = 1; j < lg(v); j++)
1548
{
1549
GEN x = shallowconcat(y, gel(v,j));
1550
ZincrementalGS(x, L, B, nx); /* overwrite last */
1551
for (k = nx-1; k >= 1; k--) ZRED(nx,k, x,L,gel(B,k+1));
1552
gel(V,j) = gel(x,nx);
1553
}
1554
return V;
1555
}
1556
GEN
1557
ZM_reducemodmatrix(GEN v, GEN y) {
1558
pari_sp av = avma;
1559
return gerepilecopy(av, ZM_reducemodmatrix_i(v,y));
1560
}
1561
1562
GEN
1563
ZC_reducemodlll(GEN x,GEN y)
1564
{
1565
pari_sp av = avma;
1566
GEN z = ZC_reducemodmatrix(x, ZM_lll(y, 0.75, LLL_INPLACE));
1567
return gerepilecopy(av, z);
1568
}
1569
GEN
1570
ZM_reducemodlll(GEN x,GEN y)
1571
{
1572
pari_sp av = avma;
1573
GEN z = ZM_reducemodmatrix(x, ZM_lll(y, 0.75, LLL_INPLACE));
1574
return gerepilecopy(av, z);
1575
}
1576
1577