Book a Demo!
CoCalc Logo Icon
StoreFeaturesDocsShareSupportNewsAboutPoliciesSign UpSign In
Download

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

28485 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
#define DEBUGLEVEL DEBUGLEVEL_pol
19
20
/*******************************************************************/
21
/* */
22
/* GENERIC */
23
/* */
24
/*******************************************************************/
25
26
/* Return optimal parameter l for the evaluation of n/m polynomials of degree d
27
Fractional values can be used if the evaluations are done with different
28
accuracies, and thus have different weights.
29
*/
30
long
31
brent_kung_optpow(long d, long n, long m)
32
{
33
long p, r;
34
long pold=1, rold=n*(d-1);
35
for(p=2; p<=d; p++)
36
{
37
r = m*(p-1) + n*((d-1)/p);
38
if (r<rold) { pold=p; rold=r; }
39
}
40
return pold;
41
}
42
43
static GEN
44
gen_RgXQ_eval_powers(GEN P, GEN V, long a, long n, void *E, const struct bb_algebra *ff,
45
GEN cmul(void *E, GEN P, long a, GEN x))
46
{
47
pari_sp av = avma;
48
long i;
49
GEN z = cmul(E,P,a,ff->one(E));
50
if (!z) z = gen_0;
51
for (i=1; i<=n; i++)
52
{
53
GEN t = cmul(E,P,a+i,gel(V,i+1));
54
if (t) {
55
z = ff->add(E, z, t);
56
if (gc_needed(av,2)) z = gerepileupto(av, z);
57
}
58
}
59
return ff->red(E,z);
60
}
61
62
/* Brent & Kung
63
* (Fast algorithms for manipulating formal power series, JACM 25:581-595, 1978)
64
*
65
* V as output by FpXQ_powers(x,l,T,p). For optimal performance, l is as given
66
* by brent_kung_optpow */
67
GEN
68
gen_bkeval_powers(GEN P, long d, GEN V, void *E, const struct bb_algebra *ff,
69
GEN cmul(void *E, GEN P, long a, GEN x))
70
{
71
pari_sp av = avma;
72
long l = lg(V)-1;
73
GEN z, u;
74
75
if (d < 0) return ff->zero(E);
76
if (d < l) return gerepileupto(av, gen_RgXQ_eval_powers(P,V,0,d,E,ff,cmul));
77
if (l<2) pari_err_DOMAIN("gen_RgX_bkeval_powers", "#powers", "<",gen_2,V);
78
if (DEBUGLEVEL>=8)
79
{
80
long cnt = 1 + (d - l) / (l-1);
81
err_printf("RgX_RgXQV_eval(%ld/%ld): %ld RgXQ_mul\n", d, l-1, cnt);
82
}
83
d -= l;
84
z = gen_RgXQ_eval_powers(P,V,d+1,l-1,E,ff,cmul);
85
while (d >= l-1)
86
{
87
d -= l-1;
88
u = gen_RgXQ_eval_powers(P,V,d+1,l-2,E,ff,cmul);
89
z = ff->add(E,u, ff->mul(E,z,gel(V,l)));
90
if (gc_needed(av,2))
91
z = gerepileupto(av, z);
92
}
93
u = gen_RgXQ_eval_powers(P,V,0,d,E,ff,cmul);
94
z = ff->add(E,u, ff->mul(E,z,gel(V,d+2)));
95
return gerepileupto(av, ff->red(E,z));
96
}
97
98
GEN
99
gen_bkeval(GEN Q, long d, GEN x, int use_sqr, void *E, const struct bb_algebra *ff,
100
GEN cmul(void *E, GEN P, long a, GEN x))
101
{
102
pari_sp av = avma;
103
GEN z, V;
104
long rtd;
105
if (d < 0) return ff->zero(E);
106
rtd = (long) sqrt((double)d);
107
V = gen_powers(x,rtd,use_sqr,E,ff->sqr,ff->mul,ff->one);
108
z = gen_bkeval_powers(Q, d, V, E, ff, cmul);
109
return gerepileupto(av, z);
110
}
111
112
static GEN
113
_gen_nored(void *E, GEN x) { (void)E; return x; }
114
static GEN
115
_gen_add(void *E, GEN x, GEN y) { (void)E; return gadd(x, y); }
116
static GEN
117
_gen_sub(void *E, GEN x, GEN y) { (void)E; return gsub(x, y); }
118
static GEN
119
_gen_mul(void *E, GEN x, GEN y) { (void)E; return gmul(x, y); }
120
static GEN
121
_gen_sqr(void *E, GEN x) { (void)E; return gsqr(x); }
122
static GEN
123
_gen_one(void *E) { (void)E; return gen_1; }
124
static GEN
125
_gen_zero(void *E) { (void)E; return gen_0; }
126
127
static struct bb_algebra Rg_algebra = { _gen_nored, _gen_add, _gen_sub,
128
_gen_mul, _gen_sqr,_gen_one,_gen_zero };
129
130
static GEN
131
_gen_cmul(void *E, GEN P, long a, GEN x)
132
{(void)E; return gmul(gel(P,a+2), x);}
133
134
GEN
135
RgX_RgV_eval(GEN Q, GEN x)
136
{
137
return gen_bkeval_powers(Q, degpol(Q), x, NULL, &Rg_algebra, _gen_cmul);
138
}
139
140
GEN
141
RgX_Rg_eval_bk(GEN Q, GEN x)
142
{
143
return gen_bkeval(Q, degpol(Q), x, 1, NULL, &Rg_algebra, _gen_cmul);
144
}
145
146
GEN
147
RgXV_RgV_eval(GEN Q, GEN x)
148
{
149
long i, l = lg(Q), vQ = gvar(Q);
150
GEN v = cgetg(l, t_VEC);
151
for (i = 1; i < l; i++)
152
{
153
GEN Qi = gel(Q, i);
154
gel(v, i) = typ(Qi)==t_POL && varn(Qi)==vQ? RgX_RgV_eval(Qi, x): gcopy(Qi);
155
}
156
return v;
157
}
158
159
GEN
160
RgX_homogenous_evalpow(GEN P, GEN A, GEN B)
161
{
162
pari_sp av = avma;
163
long d, i;
164
GEN s;
165
if (typ(P)!=t_POL)
166
return mkvec2(P, gen_1);
167
d = degpol(P);
168
s = gel(P, d+2);
169
for (i = d-1; i >= 0; i--)
170
{
171
s = gadd(gmul(s, A), gmul(gel(B,d+1-i), gel(P,i+2)));
172
if (gc_needed(av,1))
173
{
174
if(DEBUGMEM>1) pari_warn(warnmem,"RgX_homogenous_eval(%ld)",i);
175
s = gerepileupto(av, s);
176
}
177
}
178
s = gerepileupto(av, s);
179
return mkvec2(s, gel(B,d+1));
180
}
181
182
GEN
183
QXQX_homogenous_evalpow(GEN P, GEN A, GEN B, GEN T)
184
{
185
pari_sp av = avma;
186
long i, d = degpol(P), v = varn(A);
187
GEN s;
188
if (signe(P)==0) return mkvec2(pol_0(v), pol_1(v));
189
s = scalarpol_shallow(gel(P, d+2), v);
190
for (i = d-1; i >= 0; i--)
191
{
192
GEN c = gel(P,i+2), b = gel(B,d+1-i);
193
s = RgX_add(QXQX_mul(s, A, T), typ(c)==t_POL ? QXQX_QXQ_mul(b, c, T): gmul(b, c));
194
if (gc_needed(av,1))
195
{
196
if(DEBUGMEM>1) pari_warn(warnmem,"QXQX_homogenous_eval(%ld)",i);
197
s = gerepileupto(av, s);
198
}
199
}
200
s = gerepileupto(av, s);
201
return mkvec2(s, gel(B,d+1));
202
}
203
204
const struct bb_algebra *
205
get_Rg_algebra(void)
206
{
207
return &Rg_algebra;
208
}
209
210
static struct bb_ring Rg_ring = { _gen_add, _gen_mul, _gen_sqr };
211
212
static GEN
213
_RgX_divrem(void *E, GEN x, GEN y, GEN *r)
214
{
215
(void) E;
216
return RgX_divrem(x, y, r);
217
}
218
219
GEN
220
RgX_digits(GEN x, GEN T)
221
{
222
pari_sp av = avma;
223
long d = degpol(T), n = (lgpol(x)+d-1)/d;
224
GEN z = gen_digits(x,T,n,NULL, &Rg_ring, _RgX_divrem);
225
return gerepileupto(av, z);
226
}
227
228
/*******************************************************************/
229
/* */
230
/* RgX */
231
/* */
232
/*******************************************************************/
233
234
long
235
RgX_equal(GEN x, GEN y)
236
{
237
long i = lg(x);
238
239
if (i != lg(y)) return 0;
240
for (i--; i > 1; i--)
241
if (!gequal(gel(x,i),gel(y,i))) return 0;
242
return 1;
243
}
244
245
/* Returns 1 in the base ring over which x is defined */
246
/* HACK: this also works for t_SER */
247
GEN
248
Rg_get_1(GEN x)
249
{
250
GEN p, T;
251
long i, lx, tx = Rg_type(x, &p, &T, &lx);
252
if (RgX_type_is_composite(tx))
253
RgX_type_decode(tx, &i /*junk*/, &tx);
254
switch(tx)
255
{
256
case t_INTMOD: retmkintmod(is_pm1(p)? gen_0: gen_1, icopy(p));
257
case t_PADIC: return cvtop(gen_1, p, lx);
258
case t_FFELT: return FF_1(T);
259
default: return gen_1;
260
}
261
}
262
/* Returns 0 in the base ring over which x is defined */
263
/* HACK: this also works for t_SER */
264
GEN
265
Rg_get_0(GEN x)
266
{
267
GEN p, T;
268
long i, lx, tx = Rg_type(x, &p, &T, &lx);
269
if (RgX_type_is_composite(tx))
270
RgX_type_decode(tx, &i /*junk*/, &tx);
271
switch(tx)
272
{
273
case t_INTMOD: retmkintmod(gen_0, icopy(p));
274
case t_PADIC: return zeropadic(p, lx);
275
case t_FFELT: return FF_zero(T);
276
default: return gen_0;
277
}
278
}
279
280
GEN
281
QX_ZXQV_eval(GEN P, GEN V, GEN dV)
282
{
283
long i, n = degpol(P);
284
GEN z, dz, dP;
285
if (n < 0) return gen_0;
286
P = Q_remove_denom(P, &dP);
287
z = gel(P,2); if (n == 0) return icopy(z);
288
if (dV) z = mulii(dV, z); /* V[1] = dV */
289
z = ZX_Z_add_shallow(ZX_Z_mul(gel(V,2),gel(P,3)), z);
290
for (i=2; i<=n; i++) z = ZX_add(ZX_Z_mul(gel(V,i+1),gel(P,2+i)), z);
291
dz = mul_denom(dP, dV);
292
return dz? RgX_Rg_div(z, dz): z;
293
}
294
295
/* Return P(h * x), not memory clean */
296
GEN
297
RgX_unscale(GEN P, GEN h)
298
{
299
long i, l = lg(P);
300
GEN hi = gen_1, Q = cgetg(l, t_POL);
301
Q[1] = P[1];
302
if (l == 2) return Q;
303
gel(Q,2) = gcopy(gel(P,2));
304
for (i=3; i<l; i++)
305
{
306
hi = gmul(hi,h);
307
gel(Q,i) = gmul(gel(P,i), hi);
308
}
309
return Q;
310
}
311
/* P a ZX, Return P(h * x), not memory clean; optimize for h = -1 */
312
GEN
313
ZX_z_unscale(GEN P, long h)
314
{
315
long i, l = lg(P);
316
GEN Q = cgetg(l, t_POL);
317
Q[1] = P[1];
318
if (l == 2) return Q;
319
gel(Q,2) = gel(P,2);
320
if (l == 3) return Q;
321
if (h == -1)
322
for (i = 3; i < l; i++)
323
{
324
gel(Q,i) = negi(gel(P,i));
325
if (++i == l) break;
326
gel(Q,i) = gel(P,i);
327
}
328
else
329
{
330
GEN hi;
331
gel(Q,3) = mulis(gel(P,3), h);
332
hi = sqrs(h);
333
for (i = 4; i < l; i++)
334
{
335
gel(Q,i) = mulii(gel(P,i), hi);
336
if (i != l-1) hi = mulis(hi,h);
337
}
338
}
339
return Q;
340
}
341
/* P a ZX, h a t_INT. Return P(h * x), not memory clean; optimize for h = -1 */
342
GEN
343
ZX_unscale(GEN P, GEN h)
344
{
345
long i, l;
346
GEN Q, hi;
347
i = itos_or_0(h); if (i) return ZX_z_unscale(P, i);
348
l = lg(P); Q = cgetg(l, t_POL);
349
Q[1] = P[1];
350
if (l == 2) return Q;
351
gel(Q,2) = gel(P,2);
352
if (l == 3) return Q;
353
hi = h;
354
gel(Q,3) = mulii(gel(P,3), hi);
355
for (i = 4; i < l; i++)
356
{
357
hi = mulii(hi,h);
358
gel(Q,i) = mulii(gel(P,i), hi);
359
}
360
return Q;
361
}
362
/* P a ZX. Return P(x << n), not memory clean */
363
GEN
364
ZX_unscale2n(GEN P, long n)
365
{
366
long i, ni = n, l = lg(P);
367
GEN Q = cgetg(l, t_POL);
368
Q[1] = P[1];
369
if (l == 2) return Q;
370
gel(Q,2) = gel(P,2);
371
if (l == 3) return Q;
372
gel(Q,3) = shifti(gel(P,3), ni);
373
for (i=4; i<l; i++)
374
{
375
ni += n;
376
gel(Q,i) = shifti(gel(P,i), ni);
377
}
378
return Q;
379
}
380
/* P(h*X) / h, assuming h | P(0), i.e. the result is a ZX */
381
GEN
382
ZX_unscale_div(GEN P, GEN h)
383
{
384
long i, l = lg(P);
385
GEN hi, Q = cgetg(l, t_POL);
386
Q[1] = P[1];
387
if (l == 2) return Q;
388
gel(Q,2) = diviiexact(gel(P,2), h);
389
if (l == 3) return Q;
390
gel(Q,3) = gel(P,3);
391
if (l == 4) return Q;
392
hi = h;
393
gel(Q,4) = mulii(gel(P,4), hi);
394
for (i=5; i<l; i++)
395
{
396
hi = mulii(hi,h);
397
gel(Q,i) = mulii(gel(P,i), hi);
398
}
399
return Q;
400
}
401
402
GEN
403
RgXV_unscale(GEN v, GEN h)
404
{
405
long i, l;
406
GEN w;
407
if (!h || isint1(h)) return v;
408
w = cgetg_copy(v, &l);
409
for (i=1; i<l; i++) gel(w,i) = RgX_unscale(gel(v,i), h);
410
return w;
411
}
412
413
/* Return h^degpol(P) P(x / h), not memory clean */
414
GEN
415
RgX_rescale(GEN P, GEN h)
416
{
417
long i, l = lg(P);
418
GEN Q = cgetg(l,t_POL), hi = h;
419
gel(Q,l-1) = gel(P,l-1);
420
for (i=l-2; i>=2; i--)
421
{
422
gel(Q,i) = gmul(gel(P,i), hi);
423
if (i == 2) break;
424
hi = gmul(hi,h);
425
}
426
Q[1] = P[1]; return Q;
427
}
428
429
/* A(X^d) --> A(X) */
430
GEN
431
RgX_deflate(GEN x0, long d)
432
{
433
GEN z, y, x;
434
long i,id, dy, dx = degpol(x0);
435
if (d == 1 || dx <= 0) return leafcopy(x0);
436
dy = dx/d;
437
y = cgetg(dy+3, t_POL); y[1] = x0[1];
438
z = y + 2;
439
x = x0+ 2;
440
for (i=id=0; i<=dy; i++,id+=d) gel(z,i) = gel(x,id);
441
return y;
442
}
443
444
/* F a t_RFRAC */
445
long
446
rfrac_deflate_order(GEN F)
447
{
448
GEN N = gel(F,1), D = gel(F,2);
449
long m = (degpol(D) <= 0)? 0: RgX_deflate_order(D);
450
if (m == 1) return 1;
451
if (typ(N) == t_POL && varn(N) == varn(D))
452
m = cgcd(m, RgX_deflate_order(N));
453
return m;
454
}
455
/* F a t_RFRAC */
456
GEN
457
rfrac_deflate_max(GEN F, long *m)
458
{
459
*m = rfrac_deflate_order(F);
460
return rfrac_deflate(F, *m);
461
}
462
/* F a t_RFRAC */
463
GEN
464
rfrac_deflate(GEN F, long m)
465
{
466
GEN N = gel(F,1), D = gel(F,2);
467
if (m == 1) return F;
468
if (typ(N) == t_POL && varn(N) == varn(D)) N = RgX_deflate(N, m);
469
D = RgX_deflate(D, m); return mkrfrac(N, D);
470
}
471
472
/* return x0(X^d) */
473
GEN
474
RgX_inflate(GEN x0, long d)
475
{
476
long i, id, dy, dx = degpol(x0);
477
GEN x = x0 + 2, z, y;
478
if (dx <= 0) return leafcopy(x0);
479
dy = dx*d;
480
y = cgetg(dy+3, t_POL); y[1] = x0[1];
481
z = y + 2;
482
for (i=0; i<=dy; i++) gel(z,i) = gen_0;
483
for (i=id=0; i<=dx; i++,id+=d) gel(z,id) = gel(x,i);
484
return y;
485
}
486
487
/* return P(X + c) using destructive Horner, optimize for c = 1,-1 */
488
static GEN
489
RgX_translate_basecase(GEN P, GEN c)
490
{
491
pari_sp av = avma;
492
GEN Q, R;
493
long i, k, n;
494
495
if (!signe(P) || gequal0(c)) return RgX_copy(P);
496
Q = leafcopy(P);
497
R = Q+2; n = degpol(P);
498
if (isint1(c))
499
{
500
for (i=1; i<=n; i++)
501
{
502
for (k=n-i; k<n; k++) gel(R,k) = gadd(gel(R,k), gel(R,k+1));
503
if (gc_needed(av,2))
504
{
505
if(DEBUGMEM>1) pari_warn(warnmem,"RgX_translate(1), i = %ld/%ld", i,n);
506
Q = gerepilecopy(av, Q); R = Q+2;
507
}
508
}
509
}
510
else if (isintm1(c))
511
{
512
for (i=1; i<=n; i++)
513
{
514
for (k=n-i; k<n; k++) gel(R,k) = gsub(gel(R,k), gel(R,k+1));
515
if (gc_needed(av,2))
516
{
517
if(DEBUGMEM>1) pari_warn(warnmem,"RgX_translate(-1), i = %ld/%ld", i,n);
518
Q = gerepilecopy(av, Q); R = Q+2;
519
}
520
}
521
}
522
else
523
{
524
for (i=1; i<=n; i++)
525
{
526
for (k=n-i; k<n; k++) gel(R,k) = gadd(gel(R,k), gmul(c, gel(R,k+1)));
527
if (gc_needed(av,2))
528
{
529
if(DEBUGMEM>1) pari_warn(warnmem,"RgX_translate, i = %ld/%ld", i,n);
530
Q = gerepilecopy(av, Q); R = Q+2;
531
}
532
}
533
}
534
return gerepilecopy(av, Q);
535
}
536
GEN
537
RgX_translate(GEN P, GEN c)
538
{
539
pari_sp av = avma;
540
long n = degpol(P);
541
if (n < 40)
542
return RgX_translate_basecase(P, c);
543
else
544
{
545
long d = n >> 1;
546
GEN Q = RgX_translate(RgX_shift_shallow(P, -d), c);
547
GEN R = RgX_translate(RgXn_red_shallow(P, d), c);
548
GEN S = gpowgs(deg1pol_shallow(gen_1, c, varn(P)), d);
549
return gerepileupto(av, RgX_add(RgX_mul(Q, S), R));
550
}
551
}
552
553
/* return lift( P(X + c) ) using Horner, c in R[y]/(T) */
554
GEN
555
RgXQX_translate(GEN P, GEN c, GEN T)
556
{
557
pari_sp av = avma;
558
GEN Q, R;
559
long i, k, n;
560
561
if (!signe(P) || gequal0(c)) return RgX_copy(P);
562
Q = leafcopy(P);
563
R = Q+2; n = degpol(P);
564
for (i=1; i<=n; i++)
565
{
566
for (k=n-i; k<n; k++)
567
{
568
pari_sp av2 = avma;
569
gel(R,k) = gerepileupto(av2,
570
RgX_rem(gadd(gel(R,k), gmul(c, gel(R,k+1))), T));
571
}
572
if (gc_needed(av,2))
573
{
574
if(DEBUGMEM>1) pari_warn(warnmem,"RgXQX_translate, i = %ld/%ld", i,n);
575
Q = gerepilecopy(av, Q); R = Q+2;
576
}
577
}
578
return gerepilecopy(av, Q);
579
}
580
581
/********************************************************************/
582
/** **/
583
/** CONVERSIONS **/
584
/** (not memory clean) **/
585
/** **/
586
/********************************************************************/
587
/* to INT / FRAC / (POLMOD mod T), not memory clean because T not copied,
588
* but everything else is */
589
static GEN
590
QXQ_to_mod(GEN x, GEN T)
591
{
592
long d;
593
switch(typ(x))
594
{
595
case t_INT: return icopy(x);
596
case t_FRAC: return gcopy(x);
597
case t_POL:
598
d = degpol(x);
599
if (d < 0) return gen_0;
600
if (d == 0) return gcopy(gel(x,2));
601
return mkpolmod(RgX_copy(x), T);
602
default: pari_err_TYPE("QXQ_to_mod",x);
603
return NULL;/* LCOV_EXCL_LINE */
604
}
605
}
606
/* pure shallow version */
607
GEN
608
QXQ_to_mod_shallow(GEN x, GEN T)
609
{
610
long d;
611
switch(typ(x))
612
{
613
case t_INT:
614
case t_FRAC: return x;
615
case t_POL:
616
d = degpol(x);
617
if (d < 0) return gen_0;
618
if (d == 0) return gel(x,2);
619
return mkpolmod(x, T);
620
default: pari_err_TYPE("QXQ_to_mod",x);
621
return NULL;/* LCOV_EXCL_LINE */
622
}
623
}
624
/* T a ZX, z lifted from (Q[Y]/(T(Y)))[X], apply QXQ_to_mod to all coeffs.
625
* Not memory clean because T not copied, but everything else is */
626
static GEN
627
QXQX_to_mod(GEN z, GEN T)
628
{
629
long i,l = lg(z);
630
GEN x = cgetg(l,t_POL);
631
for (i=2; i<l; i++) gel(x,i) = QXQ_to_mod(gel(z,i), T);
632
x[1] = z[1]; return normalizepol_lg(x,l);
633
}
634
/* pure shallow version */
635
GEN
636
QXQX_to_mod_shallow(GEN z, GEN T)
637
{
638
long i,l = lg(z);
639
GEN x = cgetg(l,t_POL);
640
for (i=2; i<l; i++) gel(x,i) = QXQ_to_mod_shallow(gel(z,i), T);
641
x[1] = z[1]; return normalizepol_lg(x,l);
642
}
643
/* Apply QXQX_to_mod to all entries. Memory-clean ! */
644
GEN
645
QXQXV_to_mod(GEN V, GEN T)
646
{
647
long i, l = lg(V);
648
GEN z = cgetg(l, t_VEC); T = ZX_copy(T);
649
for (i=1;i<l; i++) gel(z,i) = QXQX_to_mod(gel(V,i), T);
650
return z;
651
}
652
/* Apply QXQ_to_mod to all entries. Memory-clean ! */
653
GEN
654
QXQV_to_mod(GEN V, GEN T)
655
{
656
long i, l = lg(V);
657
GEN z = cgetg(l, t_VEC); T = ZX_copy(T);
658
for (i=1;i<l; i++) gel(z,i) = QXQ_to_mod(gel(V,i), T);
659
return z;
660
}
661
662
/* Apply QXQ_to_mod to all entries. Memory-clean ! */
663
GEN
664
QXQC_to_mod_shallow(GEN V, GEN T)
665
{
666
long i, l = lg(V);
667
GEN z = cgetg(l, t_COL);
668
for (i=1;i<l; i++) gel(z,i) = QXQ_to_mod_shallow(gel(V,i), T);
669
return z;
670
}
671
672
GEN
673
QXQM_to_mod_shallow(GEN V, GEN T)
674
{
675
long i, l = lg(V);
676
GEN z = cgetg(l, t_MAT);
677
for (i=1; i<l; i++) gel(z,i) = QXQC_to_mod_shallow(gel(V,i), T);
678
return z;
679
}
680
681
GEN
682
RgX_renormalize_lg(GEN x, long lx)
683
{
684
long i;
685
for (i = lx-1; i>1; i--)
686
if (! gequal0(gel(x,i))) break; /* _not_ isexactzero */
687
stackdummy((pari_sp)(x + lg(x)), (pari_sp)(x + i+1));
688
setlg(x, i+1); setsigne(x, i != 1); return x;
689
}
690
691
GEN
692
RgV_to_RgX(GEN x, long v)
693
{
694
long i, k = lg(x);
695
GEN p;
696
697
while (--k && gequal0(gel(x,k)));
698
if (!k) return pol_0(v);
699
i = k+2; p = cgetg(i,t_POL);
700
p[1] = evalsigne(1) | evalvarn(v);
701
x--; for (k=2; k<i; k++) gel(p,k) = gel(x,k);
702
return p;
703
}
704
GEN
705
RgV_to_RgX_reverse(GEN x, long v)
706
{
707
long j, k, l = lg(x);
708
GEN p;
709
710
for (k = 1; k < l; k++)
711
if (!gequal0(gel(x,k))) break;
712
if (k == l) return pol_0(v);
713
k -= 1;
714
l -= k;
715
x += k;
716
p = cgetg(l+1,t_POL);
717
p[1] = evalsigne(1) | evalvarn(v);
718
for (j=2, k=l; j<=l; j++) gel(p,j) = gel(x,--k);
719
return p;
720
}
721
722
/* return the (N-dimensional) vector of coeffs of p */
723
GEN
724
RgX_to_RgC(GEN x, long N)
725
{
726
long i, l;
727
GEN z;
728
l = lg(x)-1; x++;
729
if (l > N+1) l = N+1; /* truncate higher degree terms */
730
z = cgetg(N+1,t_COL);
731
for (i=1; i<l ; i++) gel(z,i) = gel(x,i);
732
for ( ; i<=N; i++) gel(z,i) = gen_0;
733
return z;
734
}
735
GEN
736
Rg_to_RgC(GEN x, long N)
737
{
738
return (typ(x) == t_POL)? RgX_to_RgC(x,N): scalarcol_shallow(x, N);
739
}
740
741
/* vector of polynomials (in v) whose coefs are given by the columns of x */
742
GEN
743
RgM_to_RgXV(GEN x, long v)
744
{ pari_APPLY_type(t_VEC, RgV_to_RgX(gel(x,i), v)) }
745
GEN
746
RgM_to_RgXV_reverse(GEN x, long v)
747
{ pari_APPLY_type(t_VEC, RgV_to_RgX_reverse(gel(x,i), v)) }
748
749
/* matrix whose entries are given by the coeffs of the polynomials in
750
* vector v (considered as degree n-1 polynomials) */
751
GEN
752
RgV_to_RgM(GEN x, long n)
753
{ pari_APPLY_type(t_MAT, Rg_to_RgC(gel(x,i), n)) }
754
755
GEN
756
RgXV_to_RgM(GEN x, long n)
757
{ pari_APPLY_type(t_MAT, RgX_to_RgC(gel(x,i), n)) }
758
759
/* polynomial (in v) of polynomials (in w) whose coeffs are given by the columns of x */
760
GEN
761
RgM_to_RgXX(GEN x, long v,long w)
762
{
763
long j, lx = lg(x);
764
GEN y = cgetg(lx+1, t_POL);
765
y[1] = evalsigne(1) | evalvarn(v);
766
y++;
767
for (j=1; j<lx; j++) gel(y,j) = RgV_to_RgX(gel(x,j), w);
768
return normalizepol_lg(--y, lx+1);
769
}
770
771
/* matrix whose entries are given by the coeffs of the polynomial v in
772
* two variables (considered as degree n-1 polynomials) */
773
GEN
774
RgXX_to_RgM(GEN v, long n)
775
{
776
long j, N = lg(v)-1;
777
GEN y = cgetg(N, t_MAT);
778
for (j=1; j<N; j++) gel(y,j) = Rg_to_RgC(gel(v,j+1), n);
779
return y;
780
}
781
782
/* P(X,Y) --> P(Y,X), n is an upper bound for deg_Y(P) */
783
GEN
784
RgXY_swapspec(GEN x, long n, long w, long nx)
785
{
786
long j, ly = n+3;
787
GEN y = cgetg(ly, t_POL);
788
y[1] = evalsigne(1);
789
for (j=2; j<ly; j++)
790
{
791
long k;
792
GEN a = cgetg(nx+2,t_POL);
793
a[1] = evalsigne(1) | evalvarn(w);
794
for (k=0; k<nx; k++)
795
{
796
GEN xk = gel(x,k);
797
if (typ(xk)==t_POL)
798
gel(a,k+2) = j<lg(xk)? gel(xk,j): gen_0;
799
else
800
gel(a,k+2) = j==2 ? xk: gen_0;
801
}
802
gel(y,j) = normalizepol_lg(a, nx+2);
803
}
804
return normalizepol_lg(y,ly);
805
}
806
807
/* P(X,Y) --> P(Y,X), n is an upper bound for deg_Y(P) */
808
GEN
809
RgXY_swap(GEN x, long n, long w)
810
{
811
GEN z = RgXY_swapspec(x+2, n, w, lgpol(x));
812
setvarn(z, varn(x)); return z;
813
}
814
815
long
816
RgXY_degreex(GEN b)
817
{
818
long deg = 0, i;
819
if (!signe(b)) return -1;
820
for (i = 2; i < lg(b); ++i)
821
{
822
GEN bi = gel(b, i);
823
if (typ(bi) == t_POL)
824
deg = maxss(deg, degpol(bi));
825
}
826
return deg;
827
}
828
829
GEN
830
RgXY_derivx(GEN x)
831
{
832
long i,lx;
833
GEN y = cgetg_copy(x,&lx);
834
for (i=2; i<lx ; i++)
835
gel(y,i) = RgX_deriv(gel(x,i));
836
y[1] = x[1]; return normalizepol_lg(y,i);
837
}
838
839
/* return (x % X^n). Shallow */
840
GEN
841
RgXn_red_shallow(GEN a, long n)
842
{
843
long i, L = n+2, l = lg(a);
844
GEN b;
845
if (L >= l) return a; /* deg(x) < n */
846
b = cgetg(L, t_POL); b[1] = a[1];
847
for (i=2; i<L; i++) gel(b,i) = gel(a,i);
848
return normalizepol_lg(b,L);
849
}
850
851
GEN
852
RgXnV_red_shallow(GEN x, long n)
853
{ pari_APPLY_type(t_VEC, RgXn_red_shallow(gel(x,i), n)) }
854
855
/* return (x * X^n). Shallow */
856
GEN
857
RgX_shift_shallow(GEN a, long n)
858
{
859
long i, l = lg(a);
860
GEN b;
861
if (l == 2 || !n) return a;
862
l += n;
863
if (n < 0)
864
{
865
if (l <= 2) return pol_0(varn(a));
866
b = cgetg(l, t_POL); b[1] = a[1];
867
a -= n;
868
for (i=2; i<l; i++) gel(b,i) = gel(a,i);
869
} else {
870
b = cgetg(l, t_POL); b[1] = a[1];
871
a -= n; n += 2;
872
for (i=2; i<n; i++) gel(b,i) = gen_0;
873
for ( ; i<l; i++) gel(b,i) = gel(a,i);
874
}
875
return b;
876
}
877
/* return (x * X^n). */
878
GEN
879
RgX_shift(GEN a, long n)
880
{
881
long i, l = lg(a);
882
GEN b;
883
if (l == 2 || !n) return RgX_copy(a);
884
l += n;
885
if (n < 0)
886
{
887
if (l <= 2) return pol_0(varn(a));
888
b = cgetg(l, t_POL); b[1] = a[1];
889
a -= n;
890
for (i=2; i<l; i++) gel(b,i) = gcopy(gel(a,i));
891
} else {
892
b = cgetg(l, t_POL); b[1] = a[1];
893
a -= n; n += 2;
894
for (i=2; i<n; i++) gel(b,i) = gen_0;
895
for ( ; i<l; i++) gel(b,i) = gcopy(gel(a,i));
896
}
897
return b;
898
}
899
900
GEN
901
RgX_rotate_shallow(GEN P, long k, long p)
902
{
903
long i, l = lgpol(P);
904
GEN r;
905
if (signe(P)==0)
906
return pol_0(varn(P));
907
r = cgetg(p+2,t_POL); r[1] = P[1];
908
for(i=0; i<p; i++)
909
{
910
long s = 2+(i+k)%p;
911
gel(r,s) = i<l? gel(P,2+i): gen_0;
912
}
913
return RgX_renormalize(r);
914
}
915
916
GEN
917
RgX_mulXn(GEN x, long d)
918
{
919
pari_sp av;
920
GEN z;
921
long v;
922
if (d >= 0) return RgX_shift(x, d);
923
d = -d;
924
v = RgX_val(x);
925
if (v >= d) return RgX_shift(x, -d);
926
av = avma;
927
z = gred_rfrac_simple(RgX_shift_shallow(x, -v), pol_xn(d - v, varn(x)));
928
return gerepileupto(av, z);
929
}
930
931
long
932
RgXV_maxdegree(GEN x)
933
{
934
long d = -1, i, l = lg(x);
935
for (i = 1; i < l; i++)
936
d = maxss(d, degpol(gel(x,i)));
937
return d;
938
}
939
940
long
941
RgX_val(GEN x)
942
{
943
long i, lx = lg(x);
944
if (lx == 2) return LONG_MAX;
945
for (i = 2; i < lx; i++)
946
if (!isexactzero(gel(x,i))) break;
947
if (i == lx) return LONG_MAX;/* possible with nonrational zeros */
948
return i - 2;
949
}
950
long
951
RgX_valrem(GEN x, GEN *Z)
952
{
953
long v, i, lx = lg(x);
954
if (lx == 2) { *Z = pol_0(varn(x)); return LONG_MAX; }
955
for (i = 2; i < lx; i++)
956
if (!isexactzero(gel(x,i))) break;
957
/* possible with nonrational zeros */
958
if (i == lx) { *Z = pol_0(varn(x)); return LONG_MAX; }
959
v = i - 2;
960
*Z = RgX_shift_shallow(x, -v);
961
return v;
962
}
963
long
964
RgX_valrem_inexact(GEN x, GEN *Z)
965
{
966
long v;
967
if (!signe(x)) { if (Z) *Z = pol_0(varn(x)); return LONG_MAX; }
968
for (v = 0;; v++)
969
if (!gequal0(gel(x,2+v))) break;
970
if (Z) *Z = RgX_shift_shallow(x, -v);
971
return v;
972
}
973
974
GEN
975
RgXQC_red(GEN x, GEN T)
976
{ pari_APPLY_type(t_COL, grem(gel(x,i), T)) }
977
978
GEN
979
RgXQV_red(GEN x, GEN T)
980
{ pari_APPLY_type(t_VEC, grem(gel(x,i), T)) }
981
982
GEN
983
RgXQM_red(GEN x, GEN T)
984
{ pari_APPLY_same(RgXQC_red(gel(x,i), T)) }
985
986
GEN
987
RgXQM_mul(GEN P, GEN Q, GEN T)
988
{
989
return RgXQM_red(RgM_mul(P, Q), T);
990
}
991
992
GEN
993
RgXQX_red(GEN P, GEN T)
994
{
995
long i, l = lg(P);
996
GEN Q = cgetg(l, t_POL);
997
Q[1] = P[1];
998
for (i=2; i<l; i++) gel(Q,i) = grem(gel(P,i), T);
999
return normalizepol_lg(Q, l);
1000
}
1001
1002
GEN
1003
RgX_deriv(GEN x)
1004
{
1005
long i,lx = lg(x)-1;
1006
GEN y;
1007
1008
if (lx<3) return pol_0(varn(x));
1009
y = cgetg(lx,t_POL); gel(y,2) = gcopy(gel(x,3));
1010
for (i=3; i<lx ; i++) gel(y,i) = gmulsg(i-1,gel(x,i+1));
1011
y[1] = x[1]; return normalizepol_lg(y,i);
1012
}
1013
1014
GEN
1015
RgX_recipspec_shallow(GEN x, long l, long n)
1016
{
1017
long i;
1018
GEN z = cgetg(n+2,t_POL);
1019
z[1] = 0; z += 2;
1020
for(i=0; i<l; i++) gel(z,n-i-1) = gel(x,i);
1021
for( ; i<n; i++) gel(z, n-i-1) = gen_0;
1022
return normalizepol_lg(z-2,n+2);
1023
}
1024
1025
GEN
1026
RgXn_recip_shallow(GEN P, long n)
1027
{
1028
GEN Q = RgX_recipspec_shallow(P+2, lgpol(P), n);
1029
setvarn(Q, varn(P));
1030
return Q;
1031
}
1032
1033
/* return coefficients s.t x = x_0 X^n + ... + x_n */
1034
GEN
1035
RgX_recip(GEN x)
1036
{
1037
long lx, i, j;
1038
GEN y = cgetg_copy(x, &lx);
1039
y[1] = x[1]; for (i=2,j=lx-1; i<lx; i++,j--) gel(y,i) = gcopy(gel(x,j));
1040
return normalizepol_lg(y,lx);
1041
}
1042
/* shallow version */
1043
GEN
1044
RgX_recip_shallow(GEN x)
1045
{
1046
long lx, i, j;
1047
GEN y = cgetg_copy(x, &lx);
1048
y[1] = x[1]; for (i=2,j=lx-1; i<lx; i++,j--) gel(y,i) = gel(x,j);
1049
return normalizepol_lg(y,lx);
1050
}
1051
1052
GEN
1053
RgX_recip_i(GEN x)
1054
{
1055
long lx, i, j;
1056
GEN y = cgetg_copy(x, &lx);
1057
y[1] = x[1]; for (i=2,j=lx-1; i<lx; i++,j--) gel(y,i) = gel(x,j);
1058
return y;
1059
}
1060
/*******************************************************************/
1061
/* */
1062
/* ADDITION / SUBTRACTION */
1063
/* */
1064
/*******************************************************************/
1065
/* same variable */
1066
GEN
1067
RgX_add(GEN x, GEN y)
1068
{
1069
long i, lx = lg(x), ly = lg(y);
1070
GEN z;
1071
if (ly <= lx) {
1072
z = cgetg(lx,t_POL); z[1] = x[1];
1073
for (i=2; i < ly; i++) gel(z,i) = gadd(gel(x,i),gel(y,i));
1074
for ( ; i < lx; i++) gel(z,i) = gcopy(gel(x,i));
1075
z = normalizepol_lg(z, lx);
1076
} else {
1077
z = cgetg(ly,t_POL); z[1] = y[1];
1078
for (i=2; i < lx; i++) gel(z,i) = gadd(gel(x,i),gel(y,i));
1079
for ( ; i < ly; i++) gel(z,i) = gcopy(gel(y,i));
1080
z = normalizepol_lg(z, ly);
1081
}
1082
return z;
1083
}
1084
GEN
1085
RgX_sub(GEN x, GEN y)
1086
{
1087
long i, lx = lg(x), ly = lg(y);
1088
GEN z;
1089
if (ly <= lx) {
1090
z = cgetg(lx,t_POL); z[1] = x[1];
1091
for (i=2; i < ly; i++) gel(z,i) = gsub(gel(x,i),gel(y,i));
1092
for ( ; i < lx; i++) gel(z,i) = gcopy(gel(x,i));
1093
z = normalizepol_lg(z, lx);
1094
} else {
1095
z = cgetg(ly,t_POL); z[1] = y[1];
1096
for (i=2; i < lx; i++) gel(z,i) = gsub(gel(x,i),gel(y,i));
1097
for ( ; i < ly; i++) gel(z,i) = gneg(gel(y,i));
1098
z = normalizepol_lg(z, ly);
1099
}
1100
return z;
1101
}
1102
GEN
1103
RgX_neg(GEN x)
1104
{
1105
long i, lx = lg(x);
1106
GEN y = cgetg(lx, t_POL); y[1] = x[1];
1107
for (i=2; i<lx; i++) gel(y,i) = gneg(gel(x,i));
1108
return y;
1109
}
1110
1111
GEN
1112
RgX_Rg_add(GEN y, GEN x)
1113
{
1114
GEN z;
1115
long lz = lg(y), i;
1116
if (lz == 2) return scalarpol(x,varn(y));
1117
z = cgetg(lz,t_POL); z[1] = y[1];
1118
gel(z,2) = gadd(gel(y,2),x);
1119
for(i=3; i<lz; i++) gel(z,i) = gcopy(gel(y,i));
1120
/* probably useless unless lz = 3, but cannot be skipped if y is
1121
* an inexact 0 */
1122
return normalizepol_lg(z,lz);
1123
}
1124
GEN
1125
RgX_Rg_add_shallow(GEN y, GEN x)
1126
{
1127
GEN z;
1128
long lz = lg(y), i;
1129
if (lz == 2) return scalarpol(x,varn(y));
1130
z = cgetg(lz,t_POL); z[1] = y[1];
1131
gel(z,2) = gadd(gel(y,2),x);
1132
for(i=3; i<lz; i++) gel(z,i) = gel(y,i);
1133
return z = normalizepol_lg(z,lz);
1134
}
1135
GEN
1136
RgX_Rg_sub(GEN y, GEN x)
1137
{
1138
GEN z;
1139
long lz = lg(y), i;
1140
if (lz == 2)
1141
{ /* scalarpol(gneg(x),varn(y)) optimized */
1142
long v = varn(y);
1143
if (isrationalzero(x)) return pol_0(v);
1144
z = cgetg(3,t_POL);
1145
z[1] = gequal0(x)? evalvarn(v)
1146
: evalvarn(v) | evalsigne(1);
1147
gel(z,2) = gneg(x); return z;
1148
}
1149
z = cgetg(lz,t_POL); z[1] = y[1];
1150
gel(z,2) = gsub(gel(y,2),x);
1151
for(i=3; i<lz; i++) gel(z,i) = gcopy(gel(y,i));
1152
return z = normalizepol_lg(z,lz);
1153
}
1154
GEN
1155
Rg_RgX_sub(GEN x, GEN y)
1156
{
1157
GEN z;
1158
long lz = lg(y), i;
1159
if (lz == 2) return scalarpol(x,varn(y));
1160
z = cgetg(lz,t_POL); z[1] = y[1];
1161
gel(z,2) = gsub(x, gel(y,2));
1162
for(i=3; i<lz; i++) gel(z,i) = gneg(gel(y,i));
1163
return z = normalizepol_lg(z,lz);
1164
}
1165
/*******************************************************************/
1166
/* */
1167
/* KARATSUBA MULTIPLICATION */
1168
/* */
1169
/*******************************************************************/
1170
#if 0
1171
/* to debug Karatsuba-like routines */
1172
GEN
1173
zx_debug_spec(GEN x, long nx)
1174
{
1175
GEN z = cgetg(nx+2,t_POL);
1176
long i;
1177
for (i=0; i<nx; i++) gel(z,i+2) = stoi(x[i]);
1178
z[1] = evalsigne(1); return z;
1179
}
1180
1181
GEN
1182
RgX_debug_spec(GEN x, long nx)
1183
{
1184
GEN z = cgetg(nx+2,t_POL);
1185
long i;
1186
for (i=0; i<nx; i++) z[i+2] = x[i];
1187
z[1] = evalsigne(1); return z;
1188
}
1189
#endif
1190
1191
/* generic multiplication */
1192
GEN
1193
RgX_addspec_shallow(GEN x, GEN y, long nx, long ny)
1194
{
1195
GEN z, t;
1196
long i;
1197
if (nx == ny) {
1198
z = cgetg(nx+2,t_POL); z[1] = evalsigne(1)|evalvarn(0); t = z+2;
1199
for (i=0; i < nx; i++) gel(t,i) = gadd(gel(x,i),gel(y,i));
1200
return normalizepol_lg(z, nx+2);
1201
}
1202
if (ny < nx) {
1203
z = cgetg(nx+2,t_POL); z[1] = evalsigne(1)|evalvarn(0); t = z+2;
1204
for (i=0; i < ny; i++) gel(t,i) = gadd(gel(x,i),gel(y,i));
1205
for ( ; i < nx; i++) gel(t,i) = gel(x,i);
1206
return normalizepol_lg(z, nx+2);
1207
} else {
1208
z = cgetg(ny+2,t_POL); z[1] = evalsigne(1)|evalvarn(0); t = z+2;
1209
for (i=0; i < nx; i++) gel(t,i) = gadd(gel(x,i),gel(y,i));
1210
for ( ; i < ny; i++) gel(t,i) = gel(y,i);
1211
return normalizepol_lg(z, ny+2);
1212
}
1213
}
1214
GEN
1215
RgX_addspec(GEN x, GEN y, long nx, long ny)
1216
{
1217
GEN z, t;
1218
long i;
1219
if (nx == ny) {
1220
z = cgetg(nx+2,t_POL); z[1] = evalsigne(1)|evalvarn(0); t = z+2;
1221
for (i=0; i < nx; i++) gel(t,i) = gadd(gel(x,i),gel(y,i));
1222
return normalizepol_lg(z, nx+2);
1223
}
1224
if (ny < nx) {
1225
z = cgetg(nx+2,t_POL); z[1] = evalsigne(1)|evalvarn(0); t = z+2;
1226
for (i=0; i < ny; i++) gel(t,i) = gadd(gel(x,i),gel(y,i));
1227
for ( ; i < nx; i++) gel(t,i) = gcopy(gel(x,i));
1228
return normalizepol_lg(z, nx+2);
1229
} else {
1230
z = cgetg(ny+2,t_POL); z[1] = evalsigne(1)|evalvarn(0); t = z+2;
1231
for (i=0; i < nx; i++) gel(t,i) = gadd(gel(x,i),gel(y,i));
1232
for ( ; i < ny; i++) gel(t,i) = gcopy(gel(y,i));
1233
return normalizepol_lg(z, ny+2);
1234
}
1235
}
1236
1237
/* Return the vector of coefficients of x, where we replace rational 0s by NULL
1238
* [ to speed up basic operation s += x[i]*y[j] ]. We create a proper
1239
* t_VECSMALL, to hold this, which can be left on stack: gerepile
1240
* will not crash on it. The returned vector itself is not a proper GEN,
1241
* we access the coefficients as x[i], i = 0..deg(x) */
1242
static GEN
1243
RgXspec_kill0(GEN x, long lx)
1244
{
1245
GEN z = cgetg(lx+1, t_VECSMALL) + 1; /* inhibit gerepile-wise */
1246
long i;
1247
for (i=0; i <lx; i++)
1248
{
1249
GEN c = gel(x,i);
1250
z[i] = (long)(isrationalzero(c)? NULL: c);
1251
}
1252
return z;
1253
}
1254
1255
INLINE GEN
1256
RgX_mulspec_basecase_limb(GEN x, GEN y, long a, long b)
1257
{
1258
pari_sp av = avma;
1259
GEN s = NULL;
1260
long i;
1261
1262
for (i=a; i<b; i++)
1263
if (gel(y,i) && gel(x,-i))
1264
{
1265
GEN t = gmul(gel(y,i), gel(x,-i));
1266
s = s? gadd(s, t): t;
1267
}
1268
return s? gerepileupto(av, s): gen_0;
1269
}
1270
1271
/* assume nx >= ny > 0, return x * y * t^v */
1272
static GEN
1273
RgX_mulspec_basecase(GEN x, GEN y, long nx, long ny, long v)
1274
{
1275
long i, lz, nz;
1276
GEN z;
1277
1278
x = RgXspec_kill0(x,nx);
1279
y = RgXspec_kill0(y,ny);
1280
lz = nx + ny + 1; nz = lz-2;
1281
lz += v;
1282
z = cgetg(lz, t_POL) + 2; /* x:y:z [i] = term of degree i */
1283
for (i=0; i<v; i++) gel(z++, 0) = gen_0;
1284
for (i=0; i<ny; i++)gel(z,i) = RgX_mulspec_basecase_limb(x+i,y, 0, i+1);
1285
for ( ; i<nx; i++) gel(z,i) = RgX_mulspec_basecase_limb(x+i,y, 0,ny);
1286
for ( ; i<nz; i++) gel(z,i) = RgX_mulspec_basecase_limb(x+i,y, i-nx+1,ny);
1287
z -= v+2; z[1] = 0; return normalizepol_lg(z, lz);
1288
}
1289
1290
/* return (x * X^d) + y. Assume d > 0 */
1291
GEN
1292
RgX_addmulXn_shallow(GEN x0, GEN y0, long d)
1293
{
1294
GEN x, y, xd, yd, zd;
1295
long a, lz, nx, ny;
1296
1297
if (!signe(x0)) return y0;
1298
ny = lgpol(y0);
1299
nx = lgpol(x0);
1300
zd = (GEN)avma;
1301
x = x0 + 2; y = y0 + 2; a = ny-d;
1302
if (a <= 0)
1303
{
1304
lz = nx+d+2;
1305
(void)new_chunk(lz); xd = x+nx; yd = y+ny;
1306
while (xd > x) gel(--zd,0) = gel(--xd,0);
1307
x = zd + a;
1308
while (zd > x) gel(--zd,0) = gen_0;
1309
}
1310
else
1311
{
1312
xd = new_chunk(d); yd = y+d;
1313
x = RgX_addspec_shallow(x,yd, nx,a);
1314
lz = (a>nx)? ny+2: lg(x)+d;
1315
x += 2; while (xd > x) *--zd = *--xd;
1316
}
1317
while (yd > y) *--zd = *--yd;
1318
*--zd = x0[1];
1319
*--zd = evaltyp(t_POL) | evallg(lz); return zd;
1320
}
1321
GEN
1322
RgX_addmulXn(GEN x0, GEN y0, long d)
1323
{
1324
GEN x, y, xd, yd, zd;
1325
long a, lz, nx, ny;
1326
1327
if (!signe(x0)) return RgX_copy(y0);
1328
nx = lgpol(x0);
1329
ny = lgpol(y0);
1330
zd = (GEN)avma;
1331
x = x0 + 2; y = y0 + 2; a = ny-d;
1332
if (a <= 0)
1333
{
1334
lz = nx+d+2;
1335
(void)new_chunk(lz); xd = x+nx; yd = y+ny;
1336
while (xd > x) gel(--zd,0) = gcopy(gel(--xd,0));
1337
x = zd + a;
1338
while (zd > x) gel(--zd,0) = gen_0;
1339
}
1340
else
1341
{
1342
xd = new_chunk(d); yd = y+d;
1343
x = RgX_addspec(x,yd, nx,a);
1344
lz = (a>nx)? ny+2: lg(x)+d;
1345
x += 2; while (xd > x) *--zd = *--xd;
1346
}
1347
while (yd > y) gel(--zd,0) = gcopy(gel(--yd,0));
1348
*--zd = x0[1];
1349
*--zd = evaltyp(t_POL) | evallg(lz); return zd;
1350
}
1351
1352
/* return x * y mod t^n */
1353
static GEN
1354
RgXn_mul_basecase(GEN x, GEN y, long n)
1355
{
1356
long i, lz = n+2, lx = lgpol(x), ly = lgpol(y);
1357
GEN z;
1358
if (lx < 0) return pol_0(varn(x));
1359
if (ly < 0) return pol_0(varn(x));
1360
z = cgetg(lz, t_POL) + 2;
1361
x+=2; if (lx > n) lx = n;
1362
y+=2; if (ly > n) ly = n;
1363
z[-1] = x[-1];
1364
if (ly > lx) { swap(x,y); lswap(lx,ly); }
1365
x = RgXspec_kill0(x, lx);
1366
y = RgXspec_kill0(y, ly);
1367
/* x:y:z [i] = term of degree i */
1368
for (i=0;i<ly; i++) gel(z,i) = RgX_mulspec_basecase_limb(x+i,y, 0,i+1);
1369
for ( ; i<lx; i++) gel(z,i) = RgX_mulspec_basecase_limb(x+i,y, 0,ly);
1370
for ( ; i<n; i++) gel(z,i) = RgX_mulspec_basecase_limb(x+i,y, i-lx+1,ly);
1371
return normalizepol_lg(z - 2, lz);
1372
}
1373
/* Mulders / Karatsuba product f*g mod t^n (Hanrot-Zimmermann variant) */
1374
static GEN
1375
RgXn_mul2(GEN f, GEN g, long n)
1376
{
1377
pari_sp av = avma;
1378
GEN fe,fo, ge,go, l,h,m;
1379
long n0, n1;
1380
if (degpol(f) + degpol(g) < n) return RgX_mul(f,g);
1381
if (n < 80) return RgXn_mul_basecase(f,g,n);
1382
n0 = n>>1; n1 = n-n0;
1383
RgX_even_odd(f, &fe, &fo);
1384
RgX_even_odd(g, &ge, &go);
1385
l = RgXn_mul2(fe,ge,n1);
1386
h = RgXn_mul2(fo,go,n0);
1387
m = RgX_sub(RgXn_mul2(RgX_add(fe,fo),RgX_add(ge,go),n0), RgX_add(l,h));
1388
/* n1-1 <= n0 <= n1, deg l,m <= n1-1, deg h <= n0-1
1389
* result is t^2 h(t^2) + t m(t^2) + l(t^2) */
1390
l = RgX_inflate(l,2); /* deg l <= 2n1 - 2 <= n-1 */
1391
/* deg(t m(t^2)) <= 2n1 - 1 <= n, truncate to < n */
1392
if (2*degpol(m)+1 == n) m = normalizepol_lg(m, lg(m)-1);
1393
m = RgX_inflate(m,2);
1394
/* deg(t^2 h(t^2)) <= 2n0 <= n, truncate to < n */
1395
if (2*degpol(h)+2 == n) h = normalizepol_lg(h, lg(h)-1);
1396
h = RgX_inflate(h,2);
1397
h = RgX_addmulXn(RgX_addmulXn_shallow(h,m,1), l,1);
1398
return gerepileupto(av, h);
1399
}
1400
/* (f*g) \/ x^n */
1401
static GEN
1402
RgX_mulhigh_i2(GEN f, GEN g, long n)
1403
{
1404
long d = degpol(f)+degpol(g) + 1 - n;
1405
GEN h;
1406
if (d <= 2) return RgX_shift_shallow(RgX_mul(f,g), -n);
1407
h = RgX_recip_i(RgXn_mul2(RgX_recip_i(f),
1408
RgX_recip_i(g), d));
1409
return RgX_shift_shallow(h, d-1-degpol(h)); /* possibly (fg)(0) = 0 */
1410
}
1411
1412
/* (f*g) \/ x^n */
1413
static GEN
1414
RgX_sqrhigh_i2(GEN f, long n)
1415
{
1416
long d = 2*degpol(f)+ 1 - n;
1417
GEN h;
1418
if (d <= 2) return RgX_shift_shallow(RgX_sqr(f), -n);
1419
h = RgX_recip_i(RgXn_sqr(RgX_recip_i(f), d));
1420
return RgX_shift_shallow(h, d-1-degpol(h)); /* possibly (fg)(0) = 0 */
1421
}
1422
1423
/* fast product (Karatsuba) of polynomials a,b. These are not real GENs, a+2,
1424
* b+2 were sent instead. na, nb = number of terms of a, b.
1425
* Only c, c0, c1, c2 are genuine GEN.
1426
*/
1427
GEN
1428
RgX_mulspec(GEN a, GEN b, long na, long nb)
1429
{
1430
GEN a0, c, c0;
1431
long n0, n0a, i, v = 0;
1432
pari_sp av;
1433
1434
while (na && isrationalzero(gel(a,0))) { a++; na--; v++; }
1435
while (nb && isrationalzero(gel(b,0))) { b++; nb--; v++; }
1436
if (na < nb) swapspec(a,b, na,nb);
1437
if (!nb) return pol_0(0);
1438
1439
if (nb < RgX_MUL_LIMIT) return RgX_mulspec_basecase(a,b,na,nb, v);
1440
RgX_shift_inplace_init(v);
1441
i = (na>>1); n0 = na-i; na = i;
1442
av = avma; a0 = a+n0; n0a = n0;
1443
while (n0a && isrationalzero(gel(a,n0a-1))) n0a--;
1444
1445
if (nb > n0)
1446
{
1447
GEN b0,c1,c2;
1448
long n0b;
1449
1450
nb -= n0; b0 = b+n0; n0b = n0;
1451
while (n0b && isrationalzero(gel(b,n0b-1))) n0b--;
1452
c = RgX_mulspec(a,b,n0a,n0b);
1453
c0 = RgX_mulspec(a0,b0, na,nb);
1454
1455
c2 = RgX_addspec_shallow(a0,a, na,n0a);
1456
c1 = RgX_addspec_shallow(b0,b, nb,n0b);
1457
1458
c1 = RgX_mulspec(c1+2,c2+2, lgpol(c1),lgpol(c2));
1459
c2 = RgX_sub(c1, RgX_add(c0,c));
1460
c0 = RgX_addmulXn_shallow(c0, c2, n0);
1461
}
1462
else
1463
{
1464
c = RgX_mulspec(a,b,n0a,nb);
1465
c0 = RgX_mulspec(a0,b,na,nb);
1466
}
1467
c0 = RgX_addmulXn(c0,c,n0);
1468
return RgX_shift_inplace(gerepileupto(av,c0), v);
1469
}
1470
1471
INLINE GEN
1472
RgX_sqrspec_basecase_limb(GEN x, long a, long i)
1473
{
1474
pari_sp av = avma;
1475
GEN s = NULL;
1476
long j, l = (i+1)>>1;
1477
for (j=a; j<l; j++)
1478
{
1479
GEN xj = gel(x,j), xx = gel(x,i-j);
1480
if (xj && xx)
1481
{
1482
GEN t = gmul(xj, xx);
1483
s = s? gadd(s, t): t;
1484
}
1485
}
1486
if (s) s = gshift(s,1);
1487
if ((i&1) == 0)
1488
{
1489
GEN t = gel(x, i>>1);
1490
if (t) {
1491
t = gsqr(t);
1492
s = s? gadd(s, t): t;
1493
}
1494
}
1495
return s? gerepileupto(av,s): gen_0;
1496
}
1497
static GEN
1498
RgX_sqrspec_basecase(GEN x, long nx, long v)
1499
{
1500
long i, lz, nz;
1501
GEN z;
1502
1503
if (!nx) return pol_0(0);
1504
x = RgXspec_kill0(x,nx);
1505
lz = (nx << 1) + 1, nz = lz-2;
1506
lz += v;
1507
z = cgetg(lz,t_POL) + 2;
1508
for (i=0; i<v; i++) gel(z++, 0) = gen_0;
1509
for (i=0; i<nx; i++)gel(z,i) = RgX_sqrspec_basecase_limb(x, 0, i);
1510
for ( ; i<nz; i++) gel(z,i) = RgX_sqrspec_basecase_limb(x, i-nx+1, i);
1511
z -= v+2; z[1] = 0; return normalizepol_lg(z, lz);
1512
}
1513
/* return x^2 mod t^n */
1514
static GEN
1515
RgXn_sqr_basecase(GEN x, long n)
1516
{
1517
long i, lz = n+2, lx = lgpol(x);
1518
GEN z;
1519
if (lx < 0) return pol_0(varn(x));
1520
z = cgetg(lz, t_POL);
1521
z[1] = x[1];
1522
x+=2; if (lx > n) lx = n;
1523
x = RgXspec_kill0(x,lx);
1524
z+=2;/* x:z [i] = term of degree i */
1525
for (i=0;i<lx; i++) gel(z,i) = RgX_sqrspec_basecase_limb(x, 0, i);
1526
for ( ; i<n; i++) gel(z,i) = RgX_sqrspec_basecase_limb(x, i-lx+1, i);
1527
z -= 2; return normalizepol_lg(z, lz);
1528
}
1529
/* Mulders / Karatsuba product f^2 mod t^n (Hanrot-Zimmermann variant) */
1530
static GEN
1531
RgXn_sqr2(GEN f, long n)
1532
{
1533
pari_sp av = avma;
1534
GEN fe,fo, l,h,m;
1535
long n0, n1;
1536
if (2*degpol(f) < n) return RgX_sqr_i(f);
1537
if (n < 80) return RgXn_sqr_basecase(f,n);
1538
n0 = n>>1; n1 = n-n0;
1539
RgX_even_odd(f, &fe, &fo);
1540
l = RgXn_sqr(fe,n1);
1541
h = RgXn_sqr(fo,n0);
1542
m = RgX_sub(RgXn_sqr(RgX_add(fe,fo),n0), RgX_add(l,h));
1543
/* n1-1 <= n0 <= n1, deg l,m <= n1-1, deg h <= n0-1
1544
* result is t^2 h(t^2) + t m(t^2) + l(t^2) */
1545
l = RgX_inflate(l,2); /* deg l <= 2n1 - 2 <= n-1 */
1546
/* deg(t m(t^2)) <= 2n1 - 1 <= n, truncate to < n */
1547
if (2*degpol(m)+1 == n) m = normalizepol_lg(m, lg(m)-1);
1548
m = RgX_inflate(m,2);
1549
/* deg(t^2 h(t^2)) <= 2n0 <= n, truncate to < n */
1550
if (2*degpol(h)+2 == n) h = normalizepol_lg(h, lg(h)-1);
1551
h = RgX_inflate(h,2);
1552
h = RgX_addmulXn(RgX_addmulXn_shallow(h,m,1), l,1);
1553
return gerepileupto(av, h);
1554
}
1555
GEN
1556
RgX_sqrspec(GEN a, long na)
1557
{
1558
GEN a0, c, c0, c1;
1559
long n0, n0a, i, v = 0;
1560
pari_sp av;
1561
1562
while (na && isrationalzero(gel(a,0))) { a++; na--; v += 2; }
1563
if (na<RgX_SQR_LIMIT) return RgX_sqrspec_basecase(a, na, v);
1564
RgX_shift_inplace_init(v);
1565
i = (na>>1); n0 = na-i; na = i;
1566
av = avma; a0 = a+n0; n0a = n0;
1567
while (n0a && isrationalzero(gel(a,n0a-1))) n0a--;
1568
1569
c = RgX_sqrspec(a,n0a);
1570
c0 = RgX_sqrspec(a0,na);
1571
c1 = gmul2n(RgX_mulspec(a0,a, na,n0a), 1);
1572
c0 = RgX_addmulXn_shallow(c0,c1, n0);
1573
c0 = RgX_addmulXn(c0,c,n0);
1574
return RgX_shift_inplace(gerepileupto(av,c0), v);
1575
}
1576
1577
/* (X^a + A)(X^b + B) - X^(a+b), where deg A < a, deg B < b */
1578
GEN
1579
RgX_mul_normalized(GEN A, long a, GEN B, long b)
1580
{
1581
GEN z = RgX_mul(A, B);
1582
if (a < b)
1583
z = RgX_addmulXn_shallow(RgX_addmulXn_shallow(A, B, b-a), z, a);
1584
else if (a > b)
1585
z = RgX_addmulXn_shallow(RgX_addmulXn_shallow(B, A, a-b), z, b);
1586
else
1587
z = RgX_addmulXn_shallow(RgX_add(A, B), z, a);
1588
return z;
1589
}
1590
1591
GEN
1592
RgX_mul_i(GEN x, GEN y)
1593
{
1594
GEN z = RgX_mulspec(x+2, y+2, lgpol(x), lgpol(y));
1595
setvarn(z, varn(x)); return z;
1596
}
1597
1598
GEN
1599
RgX_sqr_i(GEN x)
1600
{
1601
GEN z = RgX_sqrspec(x+2, lgpol(x));
1602
setvarn(z,varn(x)); return z;
1603
}
1604
1605
/*******************************************************************/
1606
/* */
1607
/* DIVISION */
1608
/* */
1609
/*******************************************************************/
1610
GEN
1611
RgX_Rg_divexact(GEN x, GEN y) {
1612
long i, lx = lg(x);
1613
GEN z;
1614
if (lx == 2) return gcopy(x);
1615
switch(typ(y))
1616
{
1617
case t_INT:
1618
if (is_pm1(y)) return signe(y) < 0 ? RgX_neg(x): RgX_copy(x);
1619
break;
1620
case t_INTMOD: case t_POLMOD: return RgX_Rg_mul(x, ginv(y));
1621
}
1622
z = cgetg(lx, t_POL); z[1] = x[1];
1623
for (i=2; i<lx; i++) gel(z,i) = gdivexact(gel(x,i),y);
1624
return z;
1625
}
1626
GEN
1627
RgX_Rg_div(GEN x, GEN y) {
1628
long i, lx = lg(x);
1629
GEN z;
1630
if (lx == 2) return gcopy(x);
1631
switch(typ(y))
1632
{
1633
case t_INT:
1634
if (is_pm1(y)) return signe(y) < 0 ? RgX_neg(x): RgX_copy(x);
1635
break;
1636
case t_INTMOD: case t_POLMOD: return RgX_Rg_mul(x, ginv(y));
1637
}
1638
z = cgetg(lx, t_POL); z[1] = x[1];
1639
for (i=2; i<lx; i++) gel(z,i) = gdiv(gel(x,i),y);
1640
return normalizepol_lg(z, lx);
1641
}
1642
GEN
1643
RgX_normalize(GEN x)
1644
{
1645
GEN z, d = NULL;
1646
long i, n = lg(x)-1;
1647
for (i = n; i > 1; i--) { d = gel(x,i); if (!gequal0(d)) break; }
1648
if (i == 1) return pol_0(varn(x));
1649
if (i == n && isint1(d)) return x;
1650
n = i; z = cgetg(n+1, t_POL); z[1] = x[1];
1651
for (i=2; i<n; i++) gel(z,i) = gdiv(gel(x,i),d);
1652
gel(z,n) = Rg_get_1(d); return z;
1653
}
1654
GEN
1655
RgX_divs(GEN x, long y) {
1656
long i, lx;
1657
GEN z = cgetg_copy(x, &lx); z[1] = x[1];
1658
for (i=2; i<lx; i++) gel(z,i) = gdivgs(gel(x,i),y);
1659
return normalizepol_lg(z, lx);
1660
}
1661
GEN
1662
RgX_div_by_X_x(GEN a, GEN x, GEN *r)
1663
{
1664
long l = lg(a), i;
1665
GEN a0, z0, z;
1666
1667
if (l <= 3)
1668
{
1669
if (r) *r = l == 2? gen_0: gcopy(gel(a,2));
1670
return pol_0(0);
1671
}
1672
z = cgetg(l-1, t_POL);
1673
z[1] = a[1];
1674
a0 = a + l-1;
1675
z0 = z + l-2; *z0 = *a0--;
1676
for (i=l-3; i>1; i--) /* z[i] = a[i+1] + x*z[i+1] */
1677
{
1678
GEN t = gadd(gel(a0--,0), gmul(x, gel(z0--,0)));
1679
gel(z0,0) = t;
1680
}
1681
if (r) *r = gadd(gel(a0,0), gmul(x, gel(z0,0)));
1682
return z;
1683
}
1684
/* Polynomial division x / y:
1685
* if pr = ONLY_REM return remainder, otherwise return quotient
1686
* if pr = ONLY_DIVIDES return quotient if division is exact, else NULL
1687
* if pr != NULL set *pr to remainder, as the last object on stack */
1688
/* assume, typ(x) = typ(y) = t_POL, same variable */
1689
static GEN
1690
RgX_divrem_i(GEN x, GEN y, GEN *pr)
1691
{
1692
pari_sp avy, av, av1;
1693
long dx,dy,dz,i,j,sx,lr;
1694
GEN z,p1,p2,rem,y_lead,mod,p;
1695
GEN (*f)(GEN,GEN);
1696
1697
if (!signe(y)) pari_err_INV("RgX_divrem",y);
1698
1699
dy = degpol(y);
1700
y_lead = gel(y,dy+2);
1701
if (gequal0(y_lead)) /* normalize denominator if leading term is 0 */
1702
{
1703
pari_warn(warner,"normalizing a polynomial with 0 leading term");
1704
for (dy--; dy>=0; dy--)
1705
{
1706
y_lead = gel(y,dy+2);
1707
if (!gequal0(y_lead)) break;
1708
}
1709
}
1710
if (!dy) /* y is constant */
1711
{
1712
if (pr == ONLY_REM) return pol_0(varn(x));
1713
z = RgX_Rg_div(x, y_lead);
1714
if (pr == ONLY_DIVIDES) return z;
1715
if (pr) *pr = pol_0(varn(x));
1716
return z;
1717
}
1718
dx = degpol(x);
1719
if (dx < dy)
1720
{
1721
if (pr == ONLY_REM) return RgX_copy(x);
1722
if (pr == ONLY_DIVIDES) return signe(x)? NULL: pol_0(varn(x));
1723
z = pol_0(varn(x));
1724
if (pr) *pr = RgX_copy(x);
1725
return z;
1726
}
1727
1728
/* x,y in R[X], y non constant */
1729
av = avma;
1730
p = NULL;
1731
if (RgX_is_FpX(x, &p) && RgX_is_FpX(y, &p) && p)
1732
{
1733
z = FpX_divrem(RgX_to_FpX(x, p), RgX_to_FpX(y, p), p, pr);
1734
if (!z) return gc_NULL(av);
1735
z = FpX_to_mod(z, p);
1736
if (!pr || pr == ONLY_REM || pr == ONLY_DIVIDES)
1737
return gerepileupto(av, z);
1738
*pr = FpX_to_mod(*pr, p);
1739
gerepileall(av, 2, pr, &z);
1740
return z;
1741
}
1742
switch(typ(y_lead))
1743
{
1744
case t_REAL:
1745
y_lead = ginv(y_lead);
1746
f = gmul; mod = NULL;
1747
break;
1748
case t_INTMOD:
1749
case t_POLMOD: y_lead = ginv(y_lead);
1750
f = gmul; mod = gmodulo(gen_1, gel(y_lead,1));
1751
break;
1752
default: if (gequal1(y_lead)) y_lead = NULL;
1753
f = gdiv; mod = NULL;
1754
}
1755
1756
if (y_lead == NULL)
1757
p2 = gel(x,dx+2);
1758
else {
1759
for(;;) {
1760
p2 = f(gel(x,dx+2),y_lead);
1761
p2 = simplify_shallow(p2);
1762
if (!isexactzero(p2) || (--dx < 0)) break;
1763
}
1764
if (dx < dy) /* leading coeff of x was in fact zero */
1765
{
1766
if (pr == ONLY_DIVIDES) {
1767
set_avma(av);
1768
return (dx < 0)? pol_0(varn(x)) : NULL;
1769
}
1770
if (pr == ONLY_REM)
1771
{
1772
if (dx < 0)
1773
return gerepilecopy(av, scalarpol(p2, varn(x)));
1774
else
1775
{
1776
GEN t;
1777
set_avma(av);
1778
t = cgetg(dx + 3, t_POL); t[1] = x[1];
1779
for (i = 2; i < dx + 3; i++) gel(t,i) = gcopy(gel(x,i));
1780
return t;
1781
}
1782
}
1783
if (pr) /* cf ONLY_REM above */
1784
{
1785
if (dx < 0)
1786
{
1787
p2 = gclone(p2);
1788
set_avma(av);
1789
z = pol_0(varn(x));
1790
x = scalarpol(p2, varn(x));
1791
gunclone(p2);
1792
}
1793
else
1794
{
1795
GEN t;
1796
set_avma(av);
1797
z = pol_0(varn(x));
1798
t = cgetg(dx + 3, t_POL); t[1] = x[1];
1799
for (i = 2; i < dx + 3; i++) gel(t,i) = gcopy(gel(x,i));
1800
x = t;
1801
}
1802
*pr = x;
1803
}
1804
else
1805
{
1806
set_avma(av);
1807
z = pol_0(varn(x));
1808
}
1809
return z;
1810
}
1811
}
1812
/* dx >= dy */
1813
avy = avma;
1814
dz = dx-dy;
1815
z = cgetg(dz+3,t_POL); z[1] = x[1];
1816
x += 2;
1817
z += 2;
1818
y += 2;
1819
gel(z,dz) = gcopy(p2);
1820
1821
for (i=dx-1; i>=dy; i--)
1822
{
1823
av1=avma; p1=gel(x,i);
1824
for (j=i-dy+1; j<=i && j<=dz; j++) p1 = gsub(p1, gmul(gel(z,j),gel(y,i-j)));
1825
if (y_lead) p1 = simplify(f(p1,y_lead));
1826
1827
if (isrationalzero(p1)) { set_avma(av1); p1 = gen_0; }
1828
else
1829
p1 = avma==av1? gcopy(p1): gerepileupto(av1,p1);
1830
gel(z,i-dy) = p1;
1831
}
1832
if (!pr) return gerepileupto(av,z-2);
1833
1834
rem = (GEN)avma; av1 = (pari_sp)new_chunk(dx+3);
1835
for (sx=0; ; i--)
1836
{
1837
p1 = gel(x,i);
1838
/* we always enter this loop at least once */
1839
for (j=0; j<=i && j<=dz; j++) p1 = gsub(p1, gmul(gel(z,j),gel(y,i-j)));
1840
if (mod && avma==av1) p1 = gmul(p1,mod);
1841
if (!gequal0(p1)) { sx = 1; break; } /* remainder is nonzero */
1842
if (!isexactzero(p1)) break;
1843
if (!i) break;
1844
set_avma(av1);
1845
}
1846
if (pr == ONLY_DIVIDES)
1847
{
1848
if (sx) return gc_NULL(av);
1849
set_avma((pari_sp)rem); return gerepileupto(av,z-2);
1850
}
1851
lr=i+3; rem -= lr;
1852
if (avma==av1) { set_avma((pari_sp)rem); p1 = gcopy(p1); }
1853
else p1 = gerepileupto((pari_sp)rem,p1);
1854
rem[0] = evaltyp(t_POL) | evallg(lr);
1855
rem[1] = z[-1];
1856
rem += 2;
1857
gel(rem,i) = p1;
1858
for (i--; i>=0; i--)
1859
{
1860
av1=avma; p1 = gel(x,i);
1861
for (j=0; j<=i && j<=dz; j++) p1 = gsub(p1, gmul(gel(z,j),gel(y,i-j)));
1862
if (mod && avma==av1) p1 = gmul(p1,mod);
1863
gel(rem,i) = avma==av1? gcopy(p1):gerepileupto(av1,p1);
1864
}
1865
rem -= 2;
1866
if (!sx) (void)normalizepol_lg(rem, lr);
1867
if (pr == ONLY_REM) return gerepileupto(av,rem);
1868
z -= 2;
1869
{
1870
GEN *gptr[2]; gptr[0]=&z; gptr[1]=&rem;
1871
gerepilemanysp(av,avy,gptr,2); *pr = rem; return z;
1872
}
1873
}
1874
1875
GEN
1876
RgX_divrem(GEN x, GEN y, GEN *pr)
1877
{
1878
if (pr == ONLY_REM) return RgX_rem(x, y);
1879
return RgX_divrem_i(x, y, pr);
1880
}
1881
1882
/* x and y in (R[Y]/T)[X] (lifted), T in R[Y]. y preferably monic */
1883
GEN
1884
RgXQX_divrem(GEN x, GEN y, GEN T, GEN *pr)
1885
{
1886
long vx, dx, dy, dz, i, j, sx, lr;
1887
pari_sp av0, av, tetpil;
1888
GEN z,p1,rem,lead;
1889
1890
if (!signe(y)) pari_err_INV("RgXQX_divrem",y);
1891
vx = varn(x);
1892
dx = degpol(x);
1893
dy = degpol(y);
1894
if (dx < dy)
1895
{
1896
if (pr)
1897
{
1898
av0 = avma; x = RgXQX_red(x, T);
1899
if (pr == ONLY_DIVIDES) { set_avma(av0); return signe(x)? NULL: gen_0; }
1900
if (pr == ONLY_REM) return x;
1901
*pr = x;
1902
}
1903
return pol_0(vx);
1904
}
1905
lead = leading_coeff(y);
1906
if (!dy) /* y is constant */
1907
{
1908
if (pr && pr != ONLY_DIVIDES)
1909
{
1910
if (pr == ONLY_REM) return pol_0(vx);
1911
*pr = pol_0(vx);
1912
}
1913
if (gequal1(lead)) return RgX_copy(x);
1914
av0 = avma; x = gmul(x, ginvmod(lead,T)); tetpil = avma;
1915
return gerepile(av0,tetpil,RgXQX_red(x,T));
1916
}
1917
av0 = avma; dz = dx-dy;
1918
lead = gequal1(lead)? NULL: gclone(ginvmod(lead,T));
1919
set_avma(av0);
1920
z = cgetg(dz+3,t_POL); z[1] = x[1];
1921
x += 2; y += 2; z += 2;
1922
1923
p1 = gel(x,dx); av = avma;
1924
gel(z,dz) = lead? gerepileupto(av, grem(gmul(p1,lead), T)): gcopy(p1);
1925
for (i=dx-1; i>=dy; i--)
1926
{
1927
av=avma; p1=gel(x,i);
1928
for (j=i-dy+1; j<=i && j<=dz; j++) p1 = gsub(p1, gmul(gel(z,j),gel(y,i-j)));
1929
if (lead) p1 = gmul(grem(p1, T), lead);
1930
tetpil=avma; gel(z,i-dy) = gerepile(av,tetpil, grem(p1, T));
1931
}
1932
if (!pr) { guncloneNULL(lead); return z-2; }
1933
1934
rem = (GEN)avma; av = (pari_sp)new_chunk(dx+3);
1935
for (sx=0; ; i--)
1936
{
1937
p1 = gel(x,i);
1938
for (j=0; j<=i && j<=dz; j++) p1 = gsub(p1, gmul(gel(z,j),gel(y,i-j)));
1939
tetpil=avma; p1 = grem(p1, T); if (!gequal0(p1)) { sx = 1; break; }
1940
if (!i) break;
1941
set_avma(av);
1942
}
1943
if (pr == ONLY_DIVIDES)
1944
{
1945
guncloneNULL(lead);
1946
if (sx) return gc_NULL(av0);
1947
return gc_const((pari_sp)rem, z-2);
1948
}
1949
lr=i+3; rem -= lr;
1950
rem[0] = evaltyp(t_POL) | evallg(lr);
1951
rem[1] = z[-1];
1952
p1 = gerepile((pari_sp)rem,tetpil,p1);
1953
rem += 2; gel(rem,i) = p1;
1954
for (i--; i>=0; i--)
1955
{
1956
av=avma; p1 = gel(x,i);
1957
for (j=0; j<=i && j<=dz; j++)
1958
p1 = gsub(p1, gmul(gel(z,j),gel(y,i-j)));
1959
tetpil=avma; gel(rem,i) = gerepile(av,tetpil, grem(p1, T));
1960
}
1961
rem -= 2;
1962
guncloneNULL(lead);
1963
if (!sx) (void)normalizepol_lg(rem, lr);
1964
if (pr == ONLY_REM) return gerepileupto(av0,rem);
1965
*pr = rem; return z-2;
1966
}
1967
1968
/*******************************************************************/
1969
/* */
1970
/* PSEUDO-DIVISION */
1971
/* */
1972
/*******************************************************************/
1973
INLINE GEN
1974
rem(GEN c, GEN T)
1975
{
1976
if (T && typ(c) == t_POL && varn(c) == varn(T)) c = RgX_rem(c, T);
1977
return c;
1978
}
1979
1980
/* x, y, are ZYX, lc(y) is an integer, T is a ZY */
1981
int
1982
ZXQX_dvd(GEN x, GEN y, GEN T)
1983
{
1984
long dx, dy, dz, i, p, T_ismonic;
1985
pari_sp av = avma, av2;
1986
GEN y_lead;
1987
1988
if (!signe(y)) pari_err_INV("ZXQX_dvd",y);
1989
dy = degpol(y); y_lead = gel(y,dy+2);
1990
if (typ(y_lead) == t_POL) y_lead = gel(y_lead, 2); /* t_INT */
1991
/* if monic, no point in using pseudo-division */
1992
if (gequal1(y_lead)) return signe(RgXQX_rem(x, y, T)) == 0;
1993
T_ismonic = gequal1(leading_coeff(T));
1994
dx = degpol(x);
1995
if (dx < dy) return !signe(x);
1996
(void)new_chunk(2);
1997
x = RgX_recip_i(x)+2;
1998
y = RgX_recip_i(y)+2;
1999
/* pay attention to sparse divisors */
2000
for (i = 1; i <= dy; i++)
2001
if (!signe(gel(y,i))) gel(y,i) = NULL;
2002
dz = dx-dy; p = dz+1;
2003
av2 = avma;
2004
for (;;)
2005
{
2006
GEN m, x0 = gel(x,0), y0 = y_lead, cx = content(x0);
2007
x0 = gneg(x0); p--;
2008
m = gcdii(cx, y0);
2009
if (!equali1(m))
2010
{
2011
x0 = gdiv(x0, m);
2012
y0 = diviiexact(y0, m);
2013
if (equali1(y0)) y0 = NULL;
2014
}
2015
for (i=1; i<=dy; i++)
2016
{
2017
GEN c = gel(x,i); if (y0) c = gmul(y0, c);
2018
if (gel(y,i)) c = gadd(c, gmul(x0,gel(y,i)));
2019
if (typ(c) == t_POL) c = T_ismonic ? ZX_rem(c, T): RgX_rem(c, T);
2020
gel(x,i) = c;
2021
}
2022
for ( ; i<=dx; i++)
2023
{
2024
GEN c = gel(x,i); if (y0) c = gmul(y0, c);
2025
if (typ(c) == t_POL) c = T_ismonic ? ZX_rem(c, T): RgX_rem(c, T);
2026
gel(x,i) = c;
2027
}
2028
do { x++; dx--; } while (dx >= 0 && !signe(gel(x,0)));
2029
if (dx < dy) break;
2030
if (gc_needed(av2,1))
2031
{
2032
if(DEBUGMEM>1) pari_warn(warnmem,"ZXQX_dvd dx = %ld >= %ld",dx,dy);
2033
gerepilecoeffs(av2,x,dx+1);
2034
}
2035
}
2036
return gc_bool(av, dx < 0);
2037
}
2038
2039
/* T either NULL or a t_POL. */
2040
GEN
2041
RgXQX_pseudorem(GEN x, GEN y, GEN T)
2042
{
2043
long vx = varn(x), dx, dy, dz, i, lx, p;
2044
pari_sp av = avma, av2;
2045
GEN y_lead;
2046
2047
if (!signe(y)) pari_err_INV("RgXQX_pseudorem",y);
2048
dy = degpol(y); y_lead = gel(y,dy+2);
2049
/* if monic, no point in using pseudo-division */
2050
if (gequal1(y_lead)) return T? RgXQX_rem(x, y, T): RgX_rem(x, y);
2051
dx = degpol(x);
2052
if (dx < dy) return RgX_copy(x);
2053
(void)new_chunk(2);
2054
x = RgX_recip_i(x)+2;
2055
y = RgX_recip_i(y)+2;
2056
/* pay attention to sparse divisors */
2057
for (i = 1; i <= dy; i++)
2058
if (isexactzero(gel(y,i))) gel(y,i) = NULL;
2059
dz = dx-dy; p = dz+1;
2060
av2 = avma;
2061
for (;;)
2062
{
2063
gel(x,0) = gneg(gel(x,0)); p--;
2064
for (i=1; i<=dy; i++)
2065
{
2066
GEN c = gmul(y_lead, gel(x,i));
2067
if (gel(y,i)) c = gadd(c, gmul(gel(x,0),gel(y,i)));
2068
gel(x,i) = rem(c, T);
2069
}
2070
for ( ; i<=dx; i++)
2071
{
2072
GEN c = gmul(y_lead, gel(x,i));
2073
gel(x,i) = rem(c, T);
2074
}
2075
do { x++; dx--; } while (dx >= 0 && gequal0(gel(x,0)));
2076
if (dx < dy) break;
2077
if (gc_needed(av2,1))
2078
{
2079
if(DEBUGMEM>1) pari_warn(warnmem,"RgX_pseudorem dx = %ld >= %ld",dx,dy);
2080
gerepilecoeffs(av2,x,dx+1);
2081
}
2082
}
2083
if (dx < 0) return pol_0(vx);
2084
lx = dx+3; x -= 2;
2085
x[0] = evaltyp(t_POL) | evallg(lx);
2086
x[1] = evalsigne(1) | evalvarn(vx);
2087
x = RgX_recip_i(x);
2088
if (p)
2089
{ /* multiply by y[0]^p [beware dummy vars from FpX_FpXY_resultant] */
2090
GEN t = y_lead;
2091
if (T && typ(t) == t_POL && varn(t) == varn(T))
2092
t = RgXQ_powu(t, p, T);
2093
else
2094
t = gpowgs(t, p);
2095
for (i=2; i<lx; i++)
2096
{
2097
GEN c = gmul(gel(x,i), t);
2098
gel(x,i) = rem(c,T);
2099
}
2100
if (!T) return gerepileupto(av, x);
2101
}
2102
return gerepilecopy(av, x);
2103
}
2104
2105
GEN
2106
RgX_pseudorem(GEN x, GEN y) { return RgXQX_pseudorem(x,y, NULL); }
2107
2108
/* Compute z,r s.t lc(y)^(dx-dy+1) x = z y + r */
2109
GEN
2110
RgXQX_pseudodivrem(GEN x, GEN y, GEN T, GEN *ptr)
2111
{
2112
long vx = varn(x), dx, dy, dz, i, iz, lx, lz, p;
2113
pari_sp av = avma, av2;
2114
GEN z, r, ypow, y_lead;
2115
2116
if (!signe(y)) pari_err_INV("RgXQX_pseudodivrem",y);
2117
dy = degpol(y); y_lead = gel(y,dy+2);
2118
if (gequal1(y_lead)) return T? RgXQX_divrem(x,y, T, ptr): RgX_divrem(x,y, ptr);
2119
dx = degpol(x);
2120
if (dx < dy) { *ptr = RgX_copy(x); return pol_0(vx); }
2121
if (dx == dy)
2122
{
2123
GEN x_lead = gel(x,lg(x)-1);
2124
x = RgX_renormalize_lg(leafcopy(x), lg(x)-1);
2125
y = RgX_renormalize_lg(leafcopy(y), lg(y)-1);
2126
r = RgX_sub(RgX_Rg_mul(x, y_lead), RgX_Rg_mul(y, x_lead));
2127
*ptr = gerepileupto(av, r); return scalarpol(x_lead, vx);
2128
}
2129
(void)new_chunk(2);
2130
x = RgX_recip_i(x)+2;
2131
y = RgX_recip_i(y)+2;
2132
/* pay attention to sparse divisors */
2133
for (i = 1; i <= dy; i++)
2134
if (isexactzero(gel(y,i))) gel(y,i) = NULL;
2135
dz = dx-dy; p = dz+1;
2136
lz = dz+3;
2137
z = cgetg(lz, t_POL);
2138
z[1] = evalsigne(1) | evalvarn(vx);
2139
for (i = 2; i < lz; i++) gel(z,i) = gen_0;
2140
ypow = new_chunk(dz+1);
2141
gel(ypow,0) = gen_1;
2142
gel(ypow,1) = y_lead;
2143
for (i=2; i<=dz; i++)
2144
{
2145
GEN c = gmul(gel(ypow,i-1), y_lead);
2146
gel(ypow,i) = rem(c,T);
2147
}
2148
av2 = avma;
2149
for (iz=2;;)
2150
{
2151
p--;
2152
gel(z,iz++) = rem(gmul(gel(x,0), gel(ypow,p)), T);
2153
for (i=1; i<=dy; i++)
2154
{
2155
GEN c = gmul(y_lead, gel(x,i));
2156
if (gel(y,i)) c = gsub(c, gmul(gel(x,0),gel(y,i)));
2157
gel(x,i) = rem(c, T);
2158
}
2159
for ( ; i<=dx; i++)
2160
{
2161
GEN c = gmul(y_lead, gel(x,i));
2162
gel(x,i) = rem(c,T);
2163
}
2164
x++; dx--;
2165
while (dx >= dy && gequal0(gel(x,0))) { x++; dx--; iz++; }
2166
if (dx < dy) break;
2167
if (gc_needed(av2,1))
2168
{
2169
GEN X = x-2;
2170
if(DEBUGMEM>1) pari_warn(warnmem,"RgX_pseudodivrem dx=%ld >= %ld",dx,dy);
2171
X[0] = evaltyp(t_POL)|evallg(dx+3); X[1] = z[1]; /* hack */
2172
gerepileall(av2,2, &X, &z); x = X+2;
2173
}
2174
}
2175
while (dx >= 0 && gequal0(gel(x,0))) { x++; dx--; }
2176
if (dx < 0)
2177
x = pol_0(vx);
2178
else
2179
{
2180
lx = dx+3; x -= 2;
2181
x[0] = evaltyp(t_POL) | evallg(lx);
2182
x[1] = evalsigne(1) | evalvarn(vx);
2183
x = RgX_recip_i(x);
2184
}
2185
z = RgX_recip_i(z);
2186
r = x;
2187
if (p)
2188
{
2189
GEN c = gel(ypow,p); r = RgX_Rg_mul(r, c);
2190
if (T && typ(c) == t_POL && varn(c) == varn(T)) r = RgXQX_red(r, T);
2191
}
2192
gerepileall(av, 2, &z, &r);
2193
*ptr = r; return z;
2194
}
2195
GEN
2196
RgX_pseudodivrem(GEN x, GEN y, GEN *ptr)
2197
{ return RgXQX_pseudodivrem(x,y,NULL,ptr); }
2198
2199
GEN
2200
RgXQX_mul(GEN x, GEN y, GEN T)
2201
{
2202
return RgXQX_red(RgX_mul(x,y), T);
2203
}
2204
GEN
2205
RgX_Rg_mul(GEN y, GEN x) {
2206
long i, ly;
2207
GEN z = cgetg_copy(y, &ly); z[1] = y[1];
2208
if (ly == 2) return z;
2209
for (i = 2; i < ly; i++) gel(z,i) = gmul(x,gel(y,i));
2210
return normalizepol_lg(z,ly);
2211
}
2212
GEN
2213
RgX_muls(GEN y, long x) {
2214
long i, ly;
2215
GEN z = cgetg_copy(y, &ly); z[1] = y[1];
2216
if (ly == 2) return z;
2217
for (i = 2; i < ly; i++) gel(z,i) = gmulsg(x,gel(y,i));
2218
return normalizepol_lg(z,ly);
2219
}
2220
GEN
2221
RgXQX_RgXQ_mul(GEN x, GEN y, GEN T)
2222
{
2223
return RgXQX_red(RgX_Rg_mul(x,y), T);
2224
}
2225
GEN
2226
RgXQV_RgXQ_mul(GEN v, GEN x, GEN T)
2227
{
2228
return RgXQV_red(RgV_Rg_mul(v,x), T);
2229
}
2230
2231
GEN
2232
RgXQX_sqr(GEN x, GEN T)
2233
{
2234
return RgXQX_red(RgX_sqr(x), T);
2235
}
2236
2237
GEN
2238
RgXQX_powers(GEN P, long n, GEN T)
2239
{
2240
GEN v = cgetg(n+2, t_VEC);
2241
long i;
2242
gel(v, 1) = pol_1(varn(T));
2243
if (n==0) return v;
2244
gel(v, 2) = gcopy(P);
2245
for (i = 2; i <= n; i++) gel(v,i+1) = RgXQX_mul(P, gel(v,i), T);
2246
return v;
2247
}
2248
2249
static GEN
2250
_add(void *data, GEN x, GEN y) { (void)data; return RgX_add(x, y); }
2251
static GEN
2252
_sub(void *data, GEN x, GEN y) { (void)data; return RgX_sub(x, y); }
2253
static GEN
2254
_sqr(void *data, GEN x) { return RgXQ_sqr(x, (GEN)data); }
2255
static GEN
2256
_pow(void *data, GEN x, GEN n) { return RgXQ_pow(x, n, (GEN)data); }
2257
static GEN
2258
_mul(void *data, GEN x, GEN y) { return RgXQ_mul(x,y, (GEN)data); }
2259
static GEN
2260
_cmul(void *data, GEN P, long a, GEN x) { (void)data; return RgX_Rg_mul(x,gel(P,a+2)); }
2261
static GEN
2262
_one(void *data) { return pol_1(varn((GEN)data)); }
2263
static GEN
2264
_zero(void *data) { return pol_0(varn((GEN)data)); }
2265
static GEN
2266
_red(void *data, GEN x) { (void)data; return gcopy(x); }
2267
2268
static struct bb_algebra RgXQ_algebra = { _red, _add, _sub,
2269
_mul, _sqr, _one, _zero };
2270
2271
GEN
2272
RgX_RgXQV_eval(GEN Q, GEN x, GEN T)
2273
{
2274
return gen_bkeval_powers(Q,degpol(Q),x,(void*)T,&RgXQ_algebra,_cmul);
2275
}
2276
2277
GEN
2278
RgX_RgXQ_eval(GEN Q, GEN x, GEN T)
2279
{
2280
int use_sqr = 2*degpol(x) >= degpol(T);
2281
return gen_bkeval(Q,degpol(Q),x,use_sqr,(void*)T,&RgXQ_algebra,_cmul);
2282
}
2283
2284
/* mod X^n */
2285
struct modXn {
2286
long v; /* varn(X) */
2287
long n;
2288
} ;
2289
static GEN
2290
_sqrXn(void *data, GEN x) {
2291
struct modXn *S = (struct modXn*)data;
2292
return RgXn_sqr(x, S->n);
2293
}
2294
static GEN
2295
_mulXn(void *data, GEN x, GEN y) {
2296
struct modXn *S = (struct modXn*)data;
2297
return RgXn_mul(x,y, S->n);
2298
}
2299
static GEN
2300
_oneXn(void *data) {
2301
struct modXn *S = (struct modXn*)data;
2302
return pol_1(S->v);
2303
}
2304
static GEN
2305
_zeroXn(void *data) {
2306
struct modXn *S = (struct modXn*)data;
2307
return pol_0(S->v);
2308
}
2309
static struct bb_algebra RgXn_algebra = { _red, _add, _sub, _mulXn, _sqrXn,
2310
_oneXn, _zeroXn };
2311
2312
GEN
2313
RgXn_powers(GEN x, long m, long n)
2314
{
2315
long d = degpol(x);
2316
int use_sqr = (d<<1) >= n;
2317
struct modXn S;
2318
S.v = varn(x); S.n = n;
2319
return gen_powers(x,m,use_sqr,(void*)&S,_sqrXn,_mulXn,_oneXn);
2320
}
2321
2322
GEN
2323
RgXn_powu_i(GEN x, ulong m, long n)
2324
{
2325
struct modXn S;
2326
long v;
2327
if (n == 1) return x;
2328
v = RgX_valrem(x, &x);
2329
if (v) n -= m * v;
2330
S.v = varn(x); S.n = n;
2331
x = gen_powu_i(x, m, (void*)&S,_sqrXn,_mulXn);
2332
if (v) x = RgX_shift_shallow(x, m * v);
2333
return x;
2334
}
2335
GEN
2336
RgXn_powu(GEN x, ulong m, long n)
2337
{
2338
pari_sp av;
2339
if (n == 1) return gcopy(x);
2340
av = avma; return gerepilecopy(av, RgXn_powu_i(x, m, n));
2341
}
2342
2343
GEN
2344
RgX_RgXnV_eval(GEN Q, GEN x, long n)
2345
{
2346
struct modXn S;
2347
S.v = varn(gel(x,2)); S.n = n;
2348
return gen_bkeval_powers(Q,degpol(Q),x,(void*)&S,&RgXn_algebra,_cmul);
2349
}
2350
2351
GEN
2352
RgX_RgXn_eval(GEN Q, GEN x, long n)
2353
{
2354
int use_sqr = 2*degpol(x) >= n;
2355
struct modXn S;
2356
S.v = varn(x); S.n = n;
2357
return gen_bkeval(Q,degpol(Q),x,use_sqr,(void*)&S,&RgXn_algebra,_cmul);
2358
}
2359
2360
/* Q(x) mod t^n, x in R[t], n >= 1 */
2361
GEN
2362
RgXn_eval(GEN Q, GEN x, long n)
2363
{
2364
long d = degpol(x);
2365
int use_sqr;
2366
struct modXn S;
2367
if (d == 1 && isrationalzero(gel(x,2)))
2368
{
2369
GEN y = RgX_unscale(Q, gel(x,3));
2370
setvarn(y, varn(x)); return y;
2371
}
2372
S.v = varn(x);
2373
S.n = n;
2374
use_sqr = (d<<1) >= n;
2375
return gen_bkeval(Q,degpol(Q),x,use_sqr,(void*)&S,&RgXn_algebra,_cmul);
2376
}
2377
2378
/* (f*g mod t^n) \ t^n2, assuming 2*n2 >= n */
2379
static GEN
2380
RgXn_mulhigh(GEN f, GEN g, long n2, long n)
2381
{
2382
GEN F = RgX_blocks(f, n2, 2), fl = gel(F,1), fh = gel(F,2);
2383
return RgX_add(RgX_mulhigh_i(fl, g, n2), RgXn_mul(fh, g, n - n2));
2384
}
2385
2386
/* (f^2 mod t^n) \ t^n2, assuming 2*n2 >= n */
2387
static GEN
2388
RgXn_sqrhigh(GEN f, long n2, long n)
2389
{
2390
GEN F = RgX_blocks(f, n2, 2), fl = gel(F,1), fh = gel(F,2);
2391
return RgX_add(RgX_mulhigh_i(fl, f, n2), RgXn_mul(fh, f, n - n2));
2392
}
2393
2394
GEN
2395
RgXn_inv_i(GEN f, long e)
2396
{
2397
pari_sp av;
2398
ulong mask;
2399
GEN W, a;
2400
long v = varn(f), n = 1;
2401
2402
if (!signe(f)) pari_err_INV("RgXn_inv",f);
2403
a = ginv(gel(f,2));
2404
if (e == 1) return scalarpol(a, v);
2405
else if (e == 2)
2406
{
2407
GEN b;
2408
if (degpol(f) <= 0 || gequal0(b = gel(f,3))) return scalarpol(a, v);
2409
b = gneg(b);
2410
if (!gequal1(a)) b = gmul(b, gsqr(a));
2411
return deg1pol(b, a, v);
2412
}
2413
av = avma;
2414
W = scalarpol_shallow(a,v);
2415
mask = quadratic_prec_mask(e);
2416
while (mask > 1)
2417
{
2418
GEN u, fr;
2419
long n2 = n;
2420
n<<=1; if (mask & 1) n--;
2421
mask >>= 1;
2422
fr = RgXn_red_shallow(f, n);
2423
u = RgXn_mul(W, RgXn_mulhigh(fr, W, n2, n), n-n2);
2424
W = RgX_sub(W, RgX_shift_shallow(u, n2));
2425
if (gc_needed(av,2))
2426
{
2427
if(DEBUGMEM>1) pari_warn(warnmem,"RgXn_inv, e = %ld", n);
2428
W = gerepileupto(av, W);
2429
}
2430
}
2431
return W;
2432
}
2433
2434
static GEN
2435
RgXn_inv_FpX(GEN x, long e, GEN p)
2436
{
2437
pari_sp av = avma;
2438
GEN r;
2439
if (lgefint(p) == 3)
2440
{
2441
ulong pp = uel(p, 2);
2442
if (pp == 2)
2443
r = F2x_to_ZX(F2xn_inv(RgX_to_F2x(x), e));
2444
else
2445
r = Flx_to_ZX_inplace(Flxn_inv(RgX_to_Flx(x, pp), e, pp));
2446
}
2447
else
2448
r = FpXn_inv(RgX_to_FpX(x, p), e, p);
2449
return gerepileupto(av, FpX_to_mod(r, p));
2450
}
2451
2452
static GEN
2453
RgXn_inv_FpXQX(GEN x, long n, GEN pol, GEN p)
2454
{
2455
pari_sp av = avma;
2456
GEN r, T = RgX_to_FpX(pol, p);
2457
if (signe(T) == 0) pari_err_OP("/", gen_1, x);
2458
r = FpXQXn_inv(RgX_to_FpXQX(x, T, p), n, T, p);
2459
return gerepileupto(av, FpXQX_to_mod(r, T, p));
2460
}
2461
2462
#define code(t1,t2) ((t1 << 6) | t2)
2463
2464
static GEN
2465
RgXn_inv_fast(GEN x, long e)
2466
{
2467
GEN p, pol;
2468
long pa;
2469
long t = RgX_type(x,&p,&pol,&pa);
2470
switch(t)
2471
{
2472
case t_INTMOD: return RgXn_inv_FpX(x, e, p);
2473
case code(t_POLMOD, t_INTMOD):
2474
return RgXn_inv_FpXQX(x, e, pol, p);
2475
default: return NULL;
2476
}
2477
}
2478
#undef code
2479
2480
GEN
2481
RgXn_inv(GEN f, long e)
2482
{
2483
pari_sp av = avma;
2484
GEN h = RgXn_inv_fast(f, e);
2485
if (h) return h;
2486
return gerepileupto(av, RgXn_inv_i(f, e));
2487
}
2488
2489
/* Compute intformal(x^n*S)/x^(n+1) */
2490
static GEN
2491
RgX_integXn(GEN x, long n)
2492
{
2493
long i, lx = lg(x);
2494
GEN y;
2495
if (lx == 2) return RgX_copy(x);
2496
y = cgetg(lx, t_POL); y[1] = x[1];
2497
for (i=2; i<lx; i++)
2498
gel(y,i) = gdivgs(gel(x,i), n+i-1);
2499
return RgX_renormalize_lg(y, lx);;
2500
}
2501
2502
GEN
2503
RgXn_expint(GEN h, long e)
2504
{
2505
pari_sp av = avma, av2;
2506
long v = varn(h), n;
2507
GEN f = pol_1(v), g;
2508
ulong mask;
2509
2510
if (!signe(h)) return f;
2511
g = pol_1(v);
2512
n = 1; mask = quadratic_prec_mask(e);
2513
av2 = avma;
2514
for (;mask>1;)
2515
{
2516
GEN u, w;
2517
long n2 = n;
2518
n<<=1; if (mask & 1) n--;
2519
mask >>= 1;
2520
u = RgXn_mul(g, RgX_mulhigh_i(f, RgXn_red_shallow(h, n2-1), n2-1), n-n2);
2521
u = RgX_add(u, RgX_shift_shallow(RgXn_red_shallow(h, n-1), 1-n2));
2522
w = RgXn_mul(f, RgX_integXn(u, n2-1), n-n2);
2523
f = RgX_add(f, RgX_shift_shallow(w, n2));
2524
if (mask<=1) break;
2525
u = RgXn_mul(g, RgXn_mulhigh(f, g, n2, n), n-n2);
2526
g = RgX_sub(g, RgX_shift_shallow(u, n2));
2527
if (gc_needed(av2,2))
2528
{
2529
if (DEBUGMEM>1) pari_warn(warnmem,"RgXn_expint, e = %ld", n);
2530
gerepileall(av2, 2, &f, &g);
2531
}
2532
}
2533
return gerepileupto(av, f);
2534
}
2535
2536
GEN
2537
RgXn_exp(GEN h, long e)
2538
{
2539
long d = degpol(h);
2540
if (d < 0) return pol_1(varn(h));
2541
if (!d || !gequal0(gel(h,2)))
2542
pari_err_DOMAIN("RgXn_exp","valuation", "<", gen_1, h);
2543
return RgXn_expint(RgX_deriv(h), e);
2544
}
2545
2546
GEN
2547
RgXn_reverse(GEN f, long e)
2548
{
2549
pari_sp av = avma, av2;
2550
ulong mask;
2551
GEN fi, a, df, W, an;
2552
long v = varn(f), n=1;
2553
if (degpol(f)<1 || !gequal0(gel(f,2)))
2554
pari_err_INV("serreverse",f);
2555
fi = ginv(gel(f,3));
2556
a = deg1pol_shallow(fi,gen_0,v);
2557
if (e <= 2) return gerepilecopy(av, a);
2558
W = scalarpol(fi,v);
2559
df = RgX_deriv(f);
2560
mask = quadratic_prec_mask(e);
2561
av2 = avma;
2562
for (;mask>1;)
2563
{
2564
GEN u, fa, fr;
2565
long n2 = n, rt;
2566
n<<=1; if (mask & 1) n--;
2567
mask >>= 1;
2568
fr = RgXn_red_shallow(f, n);
2569
rt = brent_kung_optpow(degpol(fr), 4, 3);
2570
an = RgXn_powers(a, rt, n);
2571
if (n>1)
2572
{
2573
long n4 = (n2+1)>>1;
2574
GEN dfr = RgXn_red_shallow(df, n2);
2575
dfr = RgX_RgXnV_eval(dfr, RgXnV_red_shallow(an, n2), n2);
2576
u = RgX_shift(RgX_Rg_sub(RgXn_mul(W, dfr, n2), gen_1), -n4);
2577
W = RgX_sub(W, RgX_shift(RgXn_mul(u, W, n2-n4), n4));
2578
}
2579
fa = RgX_sub(RgX_RgXnV_eval(fr, an, n), pol_x(v));
2580
fa = RgX_shift(fa, -n2);
2581
a = RgX_sub(a, RgX_shift(RgXn_mul(W, fa, n-n2), n2));
2582
if (gc_needed(av2,2))
2583
{
2584
if(DEBUGMEM>1) pari_warn(warnmem,"RgXn_reverse, e = %ld", n);
2585
gerepileall(av2, 2, &a, &W);
2586
}
2587
}
2588
return gerepileupto(av, a);
2589
}
2590
2591
GEN
2592
RgXn_sqrt(GEN h, long e)
2593
{
2594
pari_sp av = avma, av2;
2595
long v = varn(h), n = 1;
2596
GEN f = scalarpol(gen_1, v), df = f;
2597
ulong mask = quadratic_prec_mask(e);
2598
if (degpol(h)<0 || !gequal1(gel(h,2)))
2599
pari_err_SQRTN("RgXn_sqrt",h);
2600
av2 = avma;
2601
while(1)
2602
{
2603
long n2 = n, m;
2604
GEN g;
2605
n<<=1; if (mask & 1) n--;
2606
mask >>= 1;
2607
m = n-n2;
2608
g = RgX_sub(RgXn_sqrhigh(f, n2, n), RgX_shift_shallow(RgXn_red_shallow(h, n),-n2));
2609
f = RgX_sub(f, RgX_shift_shallow(RgXn_mul(gmul2n(df, -1), g, m), n2));
2610
if (mask==1) return gerepileupto(av, f);
2611
g = RgXn_mul(df, RgXn_mulhigh(df, f, n2, n), m);
2612
df = RgX_sub(df, RgX_shift_shallow(g, n2));
2613
if (gc_needed(av2,2))
2614
{
2615
if(DEBUGMEM>1) pari_warn(warnmem,"RgXn_sqrt, e = %ld", n);
2616
gerepileall(av2, 2, &f, &df);
2617
}
2618
}
2619
}
2620
2621
/* x,T in Rg[X], n in N, compute lift(x^n mod T)) */
2622
GEN
2623
RgXQ_powu(GEN x, ulong n, GEN T)
2624
{
2625
pari_sp av = avma;
2626
2627
if (!n) return pol_1(varn(x));
2628
if (n == 1) return RgX_copy(x);
2629
x = gen_powu_i(x, n, (void*)T, &_sqr, &_mul);
2630
return gerepilecopy(av, x);
2631
}
2632
/* x,T in Rg[X], n in N, compute lift(x^n mod T)) */
2633
GEN
2634
RgXQ_pow(GEN x, GEN n, GEN T)
2635
{
2636
pari_sp av;
2637
long s = signe(n);
2638
2639
if (!s) return pol_1(varn(x));
2640
if (is_pm1(n) == 1)
2641
return (s < 0)? RgXQ_inv(x, T): RgX_copy(x);
2642
av = avma;
2643
if (s < 0) x = RgXQ_inv(x, T);
2644
x = gen_pow_i(x, n, (void*)T, &_sqr, &_mul);
2645
return gerepilecopy(av, x);
2646
}
2647
static GEN
2648
_ZXQsqr(void *data, GEN x) { return ZXQ_sqr(x, (GEN)data); }
2649
static GEN
2650
_ZXQmul(void *data, GEN x, GEN y) { return ZXQ_mul(x,y, (GEN)data); }
2651
2652
/* generates the list of powers of x of degree 0,1,2,...,l*/
2653
GEN
2654
ZXQ_powers(GEN x, long l, GEN T)
2655
{
2656
int use_sqr = 2*degpol(x) >= degpol(T);
2657
return gen_powers(x, l, use_sqr, (void *)T,_ZXQsqr,_ZXQmul,_one);
2658
}
2659
2660
/* x,T in Z[X], n in N, compute lift(x^n mod T)) */
2661
GEN
2662
ZXQ_powu(GEN x, ulong n, GEN T)
2663
{
2664
pari_sp av = avma;
2665
2666
if (!n) return pol_1(varn(x));
2667
if (n == 1) return ZX_copy(x);
2668
x = gen_powu_i(x, n, (void*)T, &_ZXQsqr, &_ZXQmul);
2669
return gerepilecopy(av, x);
2670
}
2671
2672
/* generates the list of powers of x of degree 0,1,2,...,l*/
2673
GEN
2674
RgXQ_powers(GEN x, long l, GEN T)
2675
{
2676
int use_sqr = 2*degpol(x) >= degpol(T);
2677
return gen_powers(x, l, use_sqr, (void *)T,_sqr,_mul,_one);
2678
}
2679
2680
GEN
2681
RgXQV_factorback(GEN L, GEN e, GEN T)
2682
{
2683
return gen_factorback(L, e, (void*)T, &_mul, &_pow, &_one);
2684
}
2685
2686
/* a in K = Q[X]/(T), returns [a^0, ..., a^n] */
2687
GEN
2688
QXQ_powers(GEN a, long n, GEN T)
2689
{
2690
GEN den, v = ZXQ_powers(Q_remove_denom(a, &den), n, T);
2691
/* den*a integral; v[i+1] = (den*a)^i in K */
2692
if (den)
2693
{ /* restore denominators */
2694
GEN d = den;
2695
long i;
2696
gel(v,2) = a;
2697
for (i=3; i<=n+1; i++) {
2698
d = mulii(d,den);
2699
gel(v,i) = RgX_Rg_div(gel(v,i), d);
2700
}
2701
}
2702
return v;
2703
}
2704
2705
static GEN
2706
do_QXQ_eval(GEN v, long imin, GEN a, GEN T)
2707
{
2708
long l, i, m = 0;
2709
GEN dz, z;
2710
GEN V = cgetg_copy(v, &l);
2711
for (i = imin; i < l; i++)
2712
{
2713
GEN c = gel(v, i);
2714
if (typ(c) == t_POL) m = maxss(m, degpol(c));
2715
}
2716
z = Q_remove_denom(QXQ_powers(a, m, T), &dz);
2717
for (i = 1; i < imin; i++) V[i] = v[i];
2718
for (i = imin; i < l; i++)
2719
{
2720
GEN c = gel(v,i);
2721
if (typ(c) == t_POL) c = QX_ZXQV_eval(c, z, dz);
2722
gel(V,i) = c;
2723
}
2724
return V;
2725
}
2726
/* [ s(a mod T) | s <- lift(v) ], a,T are QX, v a QXV */
2727
GEN
2728
QXV_QXQ_eval(GEN v, GEN a, GEN T)
2729
{ return do_QXQ_eval(v, 1, a, T); }
2730
2731
GEN
2732
QXY_QXQ_evalx(GEN v, GEN a, GEN T)
2733
{ return normalizepol(do_QXQ_eval(v, 2, a, T)); }
2734
2735
GEN
2736
RgXQ_matrix_pow(GEN y, long n, long m, GEN P)
2737
{
2738
return RgXV_to_RgM(RgXQ_powers(y,m-1,P),n);
2739
}
2740
2741
GEN
2742
RgXQ_norm(GEN x, GEN T)
2743
{
2744
pari_sp av;
2745
long dx = degpol(x);
2746
GEN L, y;
2747
2748
av = avma; y = resultant(T, x);
2749
L = leading_coeff(T);
2750
if (gequal1(L) || !signe(x)) return y;
2751
return gerepileupto(av, gdiv(y, gpowgs(L, dx)));
2752
}
2753
2754
GEN
2755
RgXQ_trace(GEN x, GEN T)
2756
{
2757
pari_sp av = avma;
2758
GEN dT = RgX_deriv(T);
2759
long n = degpol(dT);
2760
GEN z = RgXQ_mul(x, dT, T);
2761
if (degpol(z)<n) return gc_const(av, gen_0);
2762
return gerepileupto(av, gdiv(gel(z,2+n), gel(T,3+n)));
2763
}
2764
2765
GEN
2766
RgX_blocks(GEN P, long n, long m)
2767
{
2768
GEN z = cgetg(m+1,t_VEC);
2769
long i,j, k=2, l = lg(P);
2770
for(i=1; i<=m; i++)
2771
{
2772
GEN zi = cgetg(n+2,t_POL);
2773
zi[1] = P[1];
2774
gel(z,i) = zi;
2775
for(j=2; j<n+2; j++)
2776
gel(zi, j) = k==l ? gen_0 : gel(P,k++);
2777
zi = RgX_renormalize_lg(zi, n+2);
2778
}
2779
return z;
2780
}
2781
2782
/* write p(X) = e(X^2) + Xo(X^2), shallow function */
2783
void
2784
RgX_even_odd(GEN p, GEN *pe, GEN *po)
2785
{
2786
long n = degpol(p), v = varn(p), n0, n1, i;
2787
GEN p0, p1;
2788
2789
if (n <= 0) { *pe = RgX_copy(p); *po = zeropol(v); return; }
2790
2791
n0 = (n>>1)+1; n1 = n+1 - n0; /* n1 <= n0 <= n1+1 */
2792
p0 = cgetg(n0+2, t_POL); p0[1] = evalvarn(v)|evalsigne(1);
2793
p1 = cgetg(n1+2, t_POL); p1[1] = evalvarn(v)|evalsigne(1);
2794
for (i=0; i<n1; i++)
2795
{
2796
p0[2+i] = p[2+(i<<1)];
2797
p1[2+i] = p[3+(i<<1)];
2798
}
2799
if (n1 != n0)
2800
p0[2+i] = p[2+(i<<1)];
2801
*pe = normalizepol(p0);
2802
*po = normalizepol(p1);
2803
}
2804
2805
/* write p(X) = a_0(X^k) + Xa_1(X^k) + ... + X^(k-1)a_{k-1}(X^k), shallow function */
2806
GEN
2807
RgX_splitting(GEN p, long k)
2808
{
2809
long n = degpol(p), v = varn(p), m, i, j, l;
2810
GEN r;
2811
2812
m = n/k;
2813
r = cgetg(k+1,t_VEC);
2814
for(i=1; i<=k; i++)
2815
{
2816
gel(r,i) = cgetg(m+3, t_POL);
2817
mael(r,i,1) = evalvarn(v)|evalsigne(1);
2818
}
2819
for (j=1, i=0, l=2; i<=n; i++)
2820
{
2821
gmael(r,j,l) = gel(p,2+i);
2822
if (j==k) { j=1; l++; } else j++;
2823
}
2824
for(i=1; i<=k; i++)
2825
gel(r,i) = normalizepol_lg(gel(r,i),i<j?l+1:l);
2826
return r;
2827
}
2828
2829
/*******************************************************************/
2830
/* */
2831
/* Kronecker form */
2832
/* */
2833
/*******************************************************************/
2834
2835
/* z in R[Y] representing an elt in R[X,Y] mod T(Y) in Kronecker form,
2836
* i.e subst(lift(z), x, y^(2deg(z)-1)). Recover the "real" z, with
2837
* normalized coefficients */
2838
GEN
2839
Kronecker_to_mod(GEN z, GEN T)
2840
{
2841
long i,j,lx,l = lg(z), N = (degpol(T)<<1) + 1;
2842
GEN x, t = cgetg(N,t_POL);
2843
t[1] = T[1];
2844
lx = (l-2) / (N-2); x = cgetg(lx+3,t_POL);
2845
x[1] = z[1];
2846
T = RgX_copy(T);
2847
for (i=2; i<lx+2; i++, z+= N-2)
2848
{
2849
for (j=2; j<N; j++) gel(t,j) = gel(z,j);
2850
gel(x,i) = mkpolmod(RgX_rem(normalizepol_lg(t,N), T), T);
2851
}
2852
N = (l-2) % (N-2) + 2;
2853
for (j=2; j<N; j++) t[j] = z[j];
2854
gel(x,i) = mkpolmod(RgX_rem(normalizepol_lg(t,N), T), T);
2855
return normalizepol_lg(x, i+1);
2856
}
2857
2858
/*******************************************************************/
2859
/* */
2860
/* Domain detection */
2861
/* */
2862
/*******************************************************************/
2863
2864
static GEN
2865
zero_FpX_mod(GEN p, long v)
2866
{
2867
GEN r = cgetg(3,t_POL);
2868
r[1] = evalvarn(v);
2869
gel(r,2) = mkintmod(gen_0, icopy(p));
2870
return r;
2871
}
2872
2873
static GEN
2874
RgX_mul_FpX(GEN x, GEN y, GEN p)
2875
{
2876
pari_sp av = avma;
2877
GEN r;
2878
if (lgefint(p) == 3)
2879
{
2880
ulong pp = uel(p, 2);
2881
r = Flx_to_ZX_inplace(Flx_mul(RgX_to_Flx(x, pp),
2882
RgX_to_Flx(y, pp), pp));
2883
}
2884
else
2885
r = FpX_mul(RgX_to_FpX(x, p), RgX_to_FpX(y, p), p);
2886
if (signe(r)==0) { set_avma(av); return zero_FpX_mod(p, varn(x)); }
2887
return gerepileupto(av, FpX_to_mod(r, p));
2888
}
2889
2890
static GEN
2891
zero_FpXQX_mod(GEN pol, GEN p, long v)
2892
{
2893
GEN r = cgetg(3,t_POL);
2894
r[1] = evalvarn(v);
2895
gel(r,2) = mkpolmod(mkintmod(gen_0, icopy(p)), gcopy(pol));
2896
return r;
2897
}
2898
2899
static GEN
2900
RgX_mul_FpXQX(GEN x, GEN y, GEN pol, GEN p)
2901
{
2902
pari_sp av = avma;
2903
long dT;
2904
GEN kx, ky, r;
2905
GEN T = RgX_to_FpX(pol, p);
2906
if (signe(T)==0) pari_err_OP("*", x, y);
2907
dT = degpol(T);
2908
kx = RgXX_to_Kronecker(RgX_to_FpXQX(x, T, p), dT);
2909
ky = RgXX_to_Kronecker(RgX_to_FpXQX(y, T, p), dT);
2910
r = FpX_mul(kx, ky, p);
2911
if (signe(r)==0) { set_avma(av); return zero_FpXQX_mod(pol, p, varn(x)); }
2912
return gerepileupto(av, Kronecker_to_mod(FpX_to_mod(r, p), pol));
2913
}
2914
2915
static GEN
2916
RgX_liftred(GEN x, GEN T)
2917
{ return RgXQX_red(liftpol_shallow(x), T); }
2918
2919
static GEN
2920
RgX_mul_QXQX(GEN x, GEN y, GEN T)
2921
{
2922
pari_sp av = avma;
2923
long dT = degpol(T);
2924
GEN r = QX_mul(RgXX_to_Kronecker(RgX_liftred(x, T), dT),
2925
RgXX_to_Kronecker(RgX_liftred(y, T), dT));
2926
return gerepileupto(av, Kronecker_to_mod(r, T));
2927
}
2928
2929
static GEN
2930
RgX_sqr_FpX(GEN x, GEN p)
2931
{
2932
pari_sp av = avma;
2933
GEN r;
2934
if (lgefint(p) == 3)
2935
{
2936
ulong pp = uel(p, 2);
2937
r = Flx_to_ZX_inplace(Flx_sqr(RgX_to_Flx(x, pp), pp));
2938
}
2939
else
2940
r = FpX_sqr(RgX_to_FpX(x, p), p);
2941
if (signe(r)==0) { set_avma(av); return zero_FpX_mod(p, varn(x)); }
2942
return gerepileupto(av, FpX_to_mod(r, p));
2943
}
2944
2945
static GEN
2946
RgX_sqr_FpXQX(GEN x, GEN pol, GEN p)
2947
{
2948
pari_sp av = avma;
2949
long dT;
2950
GEN kx, r, T = RgX_to_FpX(pol, p);
2951
if (signe(T)==0) pari_err_OP("*",x,x);
2952
dT = degpol(T);
2953
kx = RgXX_to_Kronecker(RgX_to_FpXQX(x, T, p), dT);
2954
r = FpX_sqr(kx, p);
2955
if (signe(r)==0) { set_avma(av); return zero_FpXQX_mod(pol, p, varn(x)); }
2956
return gerepileupto(av, Kronecker_to_mod(FpX_to_mod(r, p), pol));
2957
}
2958
2959
static GEN
2960
RgX_sqr_QXQX(GEN x, GEN T)
2961
{
2962
pari_sp av = avma;
2963
long dT = degpol(T);
2964
GEN r = QX_sqr(RgXX_to_Kronecker(RgX_liftred(x, T), dT));
2965
return gerepileupto(av, Kronecker_to_mod(r, T));
2966
}
2967
2968
static GEN
2969
RgX_rem_FpX(GEN x, GEN y, GEN p)
2970
{
2971
pari_sp av = avma;
2972
GEN r;
2973
if (lgefint(p) == 3)
2974
{
2975
ulong pp = uel(p, 2);
2976
r = Flx_to_ZX_inplace(Flx_rem(RgX_to_Flx(x, pp),
2977
RgX_to_Flx(y, pp), pp));
2978
}
2979
else
2980
r = FpX_rem(RgX_to_FpX(x, p), RgX_to_FpX(y, p), p);
2981
if (signe(r)==0) { set_avma(av); return zero_FpX_mod(p, varn(x)); }
2982
return gerepileupto(av, FpX_to_mod(r, p));
2983
}
2984
2985
static GEN
2986
RgX_rem_QXQX(GEN x, GEN y, GEN T)
2987
{
2988
pari_sp av = avma;
2989
GEN r;
2990
r = RgXQX_rem(RgX_liftred(x, T), RgX_liftred(y, T), T);
2991
return gerepilecopy(av, QXQX_to_mod_shallow(r, T));
2992
}
2993
static GEN
2994
RgX_rem_FpXQX(GEN x, GEN y, GEN pol, GEN p)
2995
{
2996
pari_sp av = avma;
2997
GEN r;
2998
GEN T = RgX_to_FpX(pol, p);
2999
if (signe(T) == 0) pari_err_OP("%", x, y);
3000
if (lgefint(p) == 3)
3001
{
3002
ulong pp = uel(p, 2);
3003
GEN Tp = ZX_to_Flx(T, pp);
3004
r = FlxX_to_ZXX(FlxqX_rem(RgX_to_FlxqX(x, Tp, pp),
3005
RgX_to_FlxqX(y, Tp, pp), Tp, pp));
3006
}
3007
else
3008
r = FpXQX_rem(RgX_to_FpXQX(x, T, p), RgX_to_FpXQX(y, T, p), T, p);
3009
if (signe(r)==0) { set_avma(av); return zero_FpXQX_mod(pol, p, varn(x)); }
3010
return gerepileupto(av, FpXQX_to_mod(r, T, p));
3011
}
3012
3013
#define code(t1,t2) ((t1 << 6) | t2)
3014
static GEN
3015
RgX_mul_fast(GEN x, GEN y)
3016
{
3017
GEN p, pol;
3018
long pa;
3019
long t = RgX_type2(x,y, &p,&pol,&pa);
3020
switch(t)
3021
{
3022
case t_INT: return ZX_mul(x,y);
3023
case t_FRAC: return QX_mul(x,y);
3024
case t_FFELT: return FFX_mul(x, y, pol);
3025
case t_INTMOD: return RgX_mul_FpX(x, y, p);
3026
case code(t_POLMOD, t_INT):
3027
case code(t_POLMOD, t_FRAC):
3028
return RgX_mul_QXQX(x, y, pol);
3029
case code(t_POLMOD, t_INTMOD):
3030
return RgX_mul_FpXQX(x, y, pol, p);
3031
default: return NULL;
3032
}
3033
}
3034
static GEN
3035
RgX_sqr_fast(GEN x)
3036
{
3037
GEN p, pol;
3038
long pa;
3039
long t = RgX_type(x,&p,&pol,&pa);
3040
switch(t)
3041
{
3042
case t_INT: return ZX_sqr(x);
3043
case t_FRAC: return QX_sqr(x);
3044
case t_FFELT: return FFX_sqr(x, pol);
3045
case t_INTMOD: return RgX_sqr_FpX(x, p);
3046
case code(t_POLMOD, t_INT):
3047
case code(t_POLMOD, t_FRAC):
3048
return RgX_sqr_QXQX(x, pol);
3049
case code(t_POLMOD, t_INTMOD):
3050
return RgX_sqr_FpXQX(x, pol, p);
3051
default: return NULL;
3052
}
3053
}
3054
3055
static GEN
3056
RgX_rem_fast(GEN x, GEN y)
3057
{
3058
GEN p, pol;
3059
long pa;
3060
long t = RgX_type2(x,y, &p,&pol,&pa);
3061
switch(t)
3062
{
3063
case t_INT: return ZX_is_monic(y) ? ZX_rem(x,y): NULL;
3064
case t_FRAC: return RgX_is_ZX(y) && ZX_is_monic(y) ? QX_ZX_rem(x,y): NULL;
3065
case t_FFELT: return FFX_rem(x, y, pol);
3066
case t_INTMOD: return RgX_rem_FpX(x, y, p);
3067
case code(t_POLMOD, t_INT):
3068
case code(t_POLMOD, t_FRAC):
3069
return RgX_rem_QXQX(x, y, pol);
3070
case code(t_POLMOD, t_INTMOD):
3071
return RgX_rem_FpXQX(x, y, pol, p);
3072
default: return NULL;
3073
}
3074
}
3075
3076
#undef code
3077
3078
GEN
3079
RgX_mul(GEN x, GEN y)
3080
{
3081
GEN z = RgX_mul_fast(x,y);
3082
if (!z) z = RgX_mul_i(x,y);
3083
return z;
3084
}
3085
3086
GEN
3087
RgX_sqr(GEN x)
3088
{
3089
GEN z = RgX_sqr_fast(x);
3090
if (!z) z = RgX_sqr_i(x);
3091
return z;
3092
}
3093
3094
GEN
3095
RgX_rem(GEN x, GEN y)
3096
{
3097
GEN z = RgX_rem_fast(x, y);
3098
if (!z) z = RgX_divrem_i(x, y, ONLY_REM);
3099
return z;
3100
}
3101
3102
GEN
3103
RgXn_mul(GEN f, GEN g, long n)
3104
{
3105
pari_sp av = avma;
3106
GEN h = RgX_mul_fast(f,g);
3107
if (!h) return RgXn_mul2(f,g,n);
3108
if (degpol(h) < n) return h;
3109
return gerepilecopy(av, RgXn_red_shallow(h, n));
3110
}
3111
3112
GEN
3113
RgXn_sqr(GEN f, long n)
3114
{
3115
pari_sp av = avma;
3116
GEN g = RgX_sqr_fast(f);
3117
if (!g) return RgXn_sqr2(f,n);
3118
if (degpol(g) < n) return g;
3119
return gerepilecopy(av, RgXn_red_shallow(g, n));
3120
}
3121
3122
/* (f*g) \/ x^n */
3123
GEN
3124
RgX_mulhigh_i(GEN f, GEN g, long n)
3125
{
3126
GEN h = RgX_mul_fast(f,g);
3127
return h? RgX_shift_shallow(h, -n): RgX_mulhigh_i2(f,g,n);
3128
}
3129
3130
/* (f*g) \/ x^n */
3131
GEN
3132
RgX_sqrhigh_i(GEN f, long n)
3133
{
3134
GEN h = RgX_sqr_fast(f);
3135
return h? RgX_shift_shallow(h, -n): RgX_sqrhigh_i2(f,n);
3136
}
3137
3138