Line data Source code
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 : /********************************************************************/
16 : /** **/
17 : /** GENERIC OPERATIONS **/
18 : /** (third part) **/
19 : /** **/
20 : /********************************************************************/
21 : #include "pari.h"
22 : #include "paripriv.h"
23 :
24 : /********************************************************************/
25 : /** **/
26 : /** PRINCIPAL VARIABLE NUMBER **/
27 : /** **/
28 : /********************************************************************/
29 : static void
30 26579 : recvar(hashtable *h, GEN x)
31 : {
32 26579 : long i = 1, lx = lg(x);
33 : void *v;
34 26579 : switch(typ(x))
35 : {
36 6090 : case t_POL: case t_SER:
37 6090 : v = (void*)varn(x);
38 6090 : if (!hash_search(h, v)) hash_insert(h, v, NULL);
39 6090 : i = 2; break;
40 1043 : case t_POLMOD: case t_RFRAC:
41 1043 : case t_VEC: case t_COL: case t_MAT: break;
42 14 : case t_LIST:
43 14 : x = list_data(x);
44 14 : lx = x? lg(x): 1; break;
45 19432 : default:
46 19432 : return;
47 : }
48 32669 : for (; i < lx; i++) recvar(h, gel(x,i));
49 : }
50 :
51 : GEN
52 1057 : variables_vecsmall(GEN x)
53 : {
54 1057 : hashtable *h = hash_create_ulong(100, 1);
55 1057 : recvar(h, x);
56 1057 : return vars_sort_inplace(hash_keys(h));
57 : }
58 :
59 : GEN
60 42 : variables_vec(GEN x)
61 42 : { return x? vars_to_RgXV(variables_vecsmall(x)): gpolvar(NULL); }
62 :
63 : long
64 128636312 : gvar(GEN x)
65 : {
66 : long i, v, w, lx;
67 128636312 : switch(typ(x))
68 : {
69 49203886 : case t_POL: case t_SER: return varn(x);
70 173658 : case t_POLMOD: return varn(gel(x,1));
71 14569491 : case t_RFRAC: return varn(gel(x,2));
72 3681717 : case t_VEC: case t_COL: case t_MAT:
73 3681717 : lx = lg(x); break;
74 14 : case t_LIST:
75 14 : x = list_data(x);
76 14 : lx = x? lg(x): 1; break;
77 61007546 : default:
78 61007546 : return NO_VARIABLE;
79 : }
80 3681731 : v = NO_VARIABLE;
81 32946695 : for (i=1; i < lx; i++) { w = gvar(gel(x,i)); if (varncmp(w,v) < 0) v = w; }
82 3681742 : return v;
83 : }
84 : /* T main polynomial in R[X], A auxiliary in R[X] (possibly degree 0).
85 : * Guess and return the main variable of R */
86 : static long
87 9968 : var2_aux(GEN T, GEN A)
88 : {
89 9968 : long a = gvar2(T);
90 9968 : long b = (typ(A) == t_POL && varn(A) == varn(T))? gvar2(A): gvar(A);
91 9968 : if (varncmp(a, b) > 0) a = b;
92 9968 : return a;
93 : }
94 : static long
95 7035 : var2_rfrac(GEN x) { return var2_aux(gel(x,2), gel(x,1)); }
96 : static long
97 2933 : var2_polmod(GEN x) { return var2_aux(gel(x,1), gel(x,2)); }
98 :
99 : /* main variable of x, with the convention that the "natural" main
100 : * variable of a POLMOD is mute, so we want the next one. */
101 : static long
102 55181 : gvar9(GEN x)
103 55181 : { return (typ(x) == t_POLMOD)? var2_polmod(x): gvar(x); }
104 :
105 : /* main variable of the ring over wich x is defined */
106 : long
107 20641161 : gvar2(GEN x)
108 : {
109 : long i, v, w;
110 20641161 : switch(typ(x))
111 : {
112 56 : case t_POLMOD:
113 56 : return var2_polmod(x);
114 16912 : case t_POL: case t_SER:
115 16912 : v = NO_VARIABLE;
116 71050 : for (i=2; i < lg(x); i++) {
117 54138 : w = gvar9(gel(x,i));
118 54138 : if (varncmp(w,v) < 0) v=w;
119 : }
120 16912 : return v;
121 7035 : case t_RFRAC:
122 7035 : return var2_rfrac(x);
123 49 : case t_VEC: case t_COL: case t_MAT:
124 49 : v = NO_VARIABLE;
125 147 : for (i=1; i < lg(x); i++) {
126 98 : w = gvar2(gel(x,i));
127 98 : if (varncmp(w,v)<0) v=w;
128 : }
129 49 : return v;
130 : }
131 20617109 : return NO_VARIABLE;
132 : }
133 :
134 : /*******************************************************************/
135 : /* */
136 : /* PRECISION OF SCALAR OBJECTS */
137 : /* */
138 : /*******************************************************************/
139 : static long
140 9413795 : prec0(long e) { return (e < 0)? nbits2prec(-e): 3; }
141 : static long
142 892591936 : precREAL(GEN x) { return signe(x) ? realprec(x): prec0(expo(x)); }
143 : /* x t_REAL, y an exact noncomplex type. Return precision(|x| + |y|) */
144 : static long
145 600829 : precrealexact(GEN x, GEN y)
146 : {
147 600829 : long lx, ey = gexpo(y), ex, e;
148 600842 : if (ey == -(long)HIGHEXPOBIT) return precREAL(x);
149 185828 : ex = expo(x);
150 185828 : e = ey - ex;
151 185828 : if (!signe(x)) return prec0((e >= 0)? -e: ex);
152 185779 : lx = realprec(x);
153 185779 : return (e > 0)? lx + nbits2extraprec(e): lx;
154 : }
155 : static long
156 16847339 : precCOMPLEX(GEN z)
157 : { /* ~ precision(|x| + |y|) */
158 16847339 : GEN x = gel(z,1), y = gel(z,2);
159 : long e, ex, ey, lz, lx, ly;
160 16847339 : if (typ(x) != t_REAL) {
161 1383757 : if (typ(y) != t_REAL) return 0;
162 588569 : return precrealexact(y, x);
163 : }
164 15463582 : if (typ(y) != t_REAL) return precrealexact(x, y);
165 : /* x, y are t_REALs, cf addrr_sign */
166 15451322 : ex = expo(x);
167 15451322 : ey = expo(y);
168 15451322 : e = ey - ex;
169 15451322 : if (!signe(x)) {
170 501044 : if (!signe(y)) return prec0( minss(ex,ey) );
171 500980 : if (e <= 0) return prec0(ex);
172 500789 : lz = nbits2prec(e);
173 500789 : ly = realprec(y); if (lz > ly) lz = ly;
174 500789 : return lz;
175 : }
176 14950278 : if (!signe(y)) {
177 75141 : if (e >= 0) return prec0(ey);
178 75134 : lz = nbits2prec(-e);
179 75134 : lx = realprec(x); if (lz > lx) lz = lx;
180 75134 : return lz;
181 : }
182 14875137 : if (e < 0) { swap(x, y); e = -e; }
183 14875137 : lx = realprec(x);
184 14875137 : ly = realprec(y);
185 14875137 : if (e) {
186 12199933 : long d = nbits2extraprec(e), l = ly-d;
187 12199944 : return (l > lx)? lx + d: ly;
188 : }
189 2675204 : return minss(lx, ly);
190 : }
191 : long
192 900657275 : precision(GEN z)
193 : {
194 900657275 : switch(typ(z))
195 : {
196 888717732 : case t_REAL: return precREAL(z);
197 11899007 : case t_COMPLEX: return precCOMPLEX(z);
198 : }
199 40536 : return 0;
200 : }
201 :
202 : long
203 12999097 : gprecision(GEN x)
204 : {
205 : long i, k, l;
206 :
207 12999097 : switch(typ(x))
208 : {
209 3459966 : case t_REAL: return precREAL(x);
210 4948388 : case t_COMPLEX: return precCOMPLEX(x);
211 855363 : case t_INT: case t_INTMOD: case t_FRAC: case t_FFELT:
212 : case t_PADIC: case t_QUAD: case t_POLMOD:
213 855363 : return 0;
214 :
215 182 : case t_POL: case t_SER:
216 182 : k = LONG_MAX;
217 826 : for (i=lg(x)-1; i>1; i--)
218 : {
219 644 : l = gprecision(gel(x,i));
220 644 : if (l && l<k) k = l;
221 : }
222 182 : return (k==LONG_MAX)? 0: k;
223 3735229 : case t_VEC: case t_COL: case t_MAT:
224 3735229 : k = LONG_MAX;
225 13517863 : for (i=lg(x)-1; i>0; i--)
226 : {
227 9782651 : l = gprecision(gel(x,i));
228 9782634 : if (l && l<k) k = l;
229 : }
230 3735212 : return (k==LONG_MAX)? 0: k;
231 :
232 7 : case t_RFRAC:
233 : {
234 7 : k=gprecision(gel(x,1));
235 7 : l=gprecision(gel(x,2)); if (l && (!k || l<k)) k=l;
236 7 : return k;
237 : }
238 7 : case t_QFB:
239 7 : return gprecision(gel(x,4));
240 : }
241 0 : return 0;
242 : }
243 :
244 : static long
245 413 : vec_padicprec_relative(GEN x, long imin)
246 : {
247 : long s, t, i;
248 1288 : for (s=LONG_MAX, i=lg(x)-1; i>=imin; i--)
249 : {
250 875 : t = padicprec_relative(gel(x,i)); if (t<s) s = t;
251 : }
252 413 : return s;
253 : }
254 : /* RELATIVE padic precision. Only accept decent types: don't try to make sense
255 : * of everything like padicprec */
256 : long
257 2359 : padicprec_relative(GEN x)
258 : {
259 2359 : switch(typ(x))
260 : {
261 427 : case t_INT: case t_FRAC:
262 427 : return LONG_MAX;
263 1519 : case t_PADIC:
264 1519 : return signe(gel(x,4))? precp(x): 0;
265 238 : case t_POLMOD: case t_VEC: case t_COL: case t_MAT:
266 238 : return vec_padicprec_relative(x, 1);
267 175 : case t_POL: case t_SER:
268 175 : return vec_padicprec_relative(x, 2);
269 : }
270 0 : pari_err_TYPE("padicprec_relative",x);
271 : return 0; /* LCOV_EXCL_LINE */
272 : }
273 :
274 : static long
275 826 : vec_padicprec(GEN x, GEN p, long imin)
276 : {
277 : long s, t, i;
278 4760 : for (s=LONG_MAX, i=lg(x)-1; i>=imin; i--)
279 : {
280 3934 : t = padicprec(gel(x,i),p); if (t<s) s = t;
281 : }
282 826 : return s;
283 : }
284 : static long
285 14 : vec_serprec(GEN x, long v, long imin)
286 : {
287 : long s, t, i;
288 42 : for (s=LONG_MAX, i=lg(x)-1; i>=imin; i--)
289 : {
290 28 : t = serprec(gel(x,i),v); if (t<s) s = t;
291 : }
292 14 : return s;
293 : }
294 :
295 : /* ABSOLUTE padic precision */
296 : long
297 4172 : padicprec(GEN x, GEN p)
298 : {
299 4172 : if (typ(p) != t_INT) pari_err_TYPE("padicprec",p);
300 4165 : switch(typ(x))
301 : {
302 42 : case t_INT: case t_FRAC:
303 42 : return LONG_MAX;
304 :
305 7 : case t_INTMOD:
306 7 : return Z_pval(gel(x,1),p);
307 :
308 3290 : case t_PADIC:
309 3290 : if (!equalii(gel(x,2),p)) pari_err_MODULUS("padicprec", gel(x,2), p);
310 3283 : return precp(x)+valp(x);
311 :
312 14 : case t_POL: case t_SER:
313 14 : return vec_padicprec(x, p, 2);
314 812 : case t_COMPLEX: case t_QUAD: case t_POLMOD: case t_RFRAC:
315 : case t_VEC: case t_COL: case t_MAT:
316 812 : return vec_padicprec(x, p, 1);
317 : }
318 0 : pari_err_TYPE("padicprec",x);
319 : return 0; /* LCOV_EXCL_LINE */
320 : }
321 : GEN
322 105 : gppadicprec(GEN x, GEN p)
323 : {
324 105 : long v = padicprec(x,p);
325 91 : return v == LONG_MAX? mkoo(): stoi(v);
326 : }
327 :
328 : /* ABSOLUTE X-adic precision */
329 : long
330 70 : serprec(GEN x, long v)
331 : {
332 : long w;
333 70 : switch(typ(x))
334 : {
335 21 : case t_INT: case t_REAL: case t_INTMOD: case t_FRAC: case t_FFELT:
336 : case t_COMPLEX: case t_PADIC: case t_QUAD: case t_QFB:
337 21 : return LONG_MAX;
338 :
339 7 : case t_POL:
340 7 : w = varn(x);
341 7 : if (varncmp(v,w) <= 0) return LONG_MAX;
342 7 : return vec_serprec(x, v, 2);
343 42 : case t_SER:
344 42 : w = varn(x);
345 42 : if (w == v)
346 : {
347 35 : long l = lg(x); /* Mod(0,2) + O(x) */
348 35 : if (l == 3 && !signe(x) && !isinexact(gel(x,2))) l--;
349 35 : return l - 2 + valser(x);
350 : }
351 7 : if (varncmp(v,w) < 0) return LONG_MAX;
352 7 : return vec_serprec(x, v, 2);
353 0 : case t_POLMOD: case t_RFRAC: case t_VEC: case t_COL: case t_MAT:
354 0 : return vec_serprec(x, v, 1);
355 : }
356 0 : pari_err_TYPE("serprec",x);
357 : return 0; /* LCOV_EXCL_LINE */
358 : }
359 : GEN
360 42 : gpserprec(GEN x, long v)
361 : {
362 42 : long p = serprec(x,v);
363 42 : return p == LONG_MAX? mkoo(): stoi(p);
364 : }
365 :
366 : /* Degree of x (scalar, t_POL, t_RFRAC) wrt variable v if v >= 0,
367 : * wrt to main variable if v < 0. */
368 : long
369 102051 : poldegree(GEN x, long v)
370 : {
371 102051 : const long DEGREE0 = -LONG_MAX;
372 102051 : long tx = typ(x), lx,w,i,d;
373 :
374 102051 : if (is_scalar_t(tx)) return gequal0(x)? DEGREE0: 0;
375 101697 : switch(tx)
376 : {
377 101606 : case t_POL:
378 101606 : if (!signe(x)) return DEGREE0;
379 101599 : w = varn(x);
380 101599 : if (v < 0 || v == w) return degpol(x);
381 144 : if (varncmp(v, w) < 0) return 0;
382 144 : lx = lg(x); d = DEGREE0;
383 684 : for (i=2; i<lx; i++)
384 : {
385 540 : long e = poldegree(gel(x,i), v);
386 540 : if (e > d) d = e;
387 : }
388 144 : return d;
389 :
390 91 : case t_RFRAC:
391 : {
392 91 : GEN a = gel(x,1), b = gel(x,2);
393 91 : if (gequal0(a)) return DEGREE0;
394 84 : if (v < 0)
395 : {
396 84 : v = varn(b); d = -degpol(b);
397 84 : if (typ(a) == t_POL && varn(a) == v) d += degpol(a);
398 84 : return d;
399 : }
400 0 : return poldegree(a,v) - poldegree(b,v);
401 : }
402 : }
403 0 : pari_err_TYPE("degree",x);
404 : return 0; /* LCOV_EXCL_LINE */
405 : }
406 : GEN
407 30783 : gppoldegree(GEN x, long v)
408 : {
409 30783 : long d = poldegree(x,v);
410 30783 : return d == -LONG_MAX? mkmoo(): stoi(d);
411 : }
412 :
413 : /* assume v >= 0 and x is a POLYNOMIAL in v, return deg_v(x) */
414 : long
415 501871 : RgX_degree(GEN x, long v)
416 : {
417 501871 : long tx = typ(x), lx, w, i, d;
418 :
419 501871 : if (is_scalar_t(tx)) return gequal0(x)? -1: 0;
420 302264 : switch(tx)
421 : {
422 302264 : case t_POL:
423 302264 : if (!signe(x)) return -1;
424 302243 : w = varn(x);
425 302243 : if (v == w) return degpol(x);
426 107085 : if (varncmp(v, w) < 0) return 0;
427 107085 : lx = lg(x); d = -1;
428 483216 : for (i=2; i<lx; i++)
429 : {
430 376131 : long e = RgX_degree(gel(x,i), v);
431 376131 : if (e > d) d = e;
432 : }
433 107085 : return d;
434 :
435 0 : case t_RFRAC:
436 0 : w = varn(gel(x,2));
437 0 : if (varncmp(v, w) < 0) return 0;
438 0 : if (RgX_degree(gel(x,2),v)) pari_err_TYPE("RgX_degree", x);
439 0 : return RgX_degree(gel(x,1),v);
440 : }
441 0 : pari_err_TYPE("RgX_degree",x);
442 : return 0; /* LCOV_EXCL_LINE */
443 : }
444 :
445 : long
446 6790 : degree(GEN x)
447 : {
448 6790 : return poldegree(x,-1);
449 : }
450 :
451 : /* If v<0, leading coeff with respect to the main variable, otherwise wrt v. */
452 : GEN
453 329 : pollead(GEN x, long v)
454 : {
455 329 : long tx = typ(x), w;
456 : pari_sp av;
457 :
458 329 : if (is_scalar_t(tx)) return gcopy(x);
459 329 : w = varn(x);
460 329 : switch(tx)
461 : {
462 294 : case t_POL:
463 294 : if (v < 0 || v == w)
464 : {
465 259 : long l = lg(x);
466 259 : return (l==2)? gen_0: gcopy(gel(x,l-1));
467 : }
468 35 : break;
469 :
470 35 : case t_SER:
471 35 : if (v < 0 || v == w) return signe(x)? gcopy(gel(x,2)): gen_0;
472 14 : if (varncmp(v, w) > 0) x = polcoef_i(x, valser(x), v);
473 14 : break;
474 :
475 0 : default:
476 0 : pari_err_TYPE("pollead",x);
477 : return NULL; /* LCOV_EXCL_LINE */
478 : }
479 49 : if (varncmp(v, w) < 0) return gcopy(x);
480 28 : av = avma; w = fetch_var_higher();
481 28 : x = gsubst(x, v, pol_x(w));
482 28 : x = pollead(x, w);
483 28 : delete_var(); return gerepileupto(av, x);
484 : }
485 :
486 : /* returns 1 if there's a real component in the structure, 0 otherwise */
487 : int
488 14336 : isinexactreal(GEN x)
489 : {
490 : long i;
491 14336 : switch(typ(x))
492 : {
493 1246 : case t_REAL: return 1;
494 2597 : case t_COMPLEX: return (typ(gel(x,1))==t_REAL || typ(gel(x,2))==t_REAL);
495 :
496 9905 : case t_INT: case t_INTMOD: case t_FRAC:
497 : case t_FFELT: case t_PADIC: case t_QUAD:
498 9905 : case t_QFB: return 0;
499 :
500 0 : case t_RFRAC: case t_POLMOD:
501 0 : return isinexactreal(gel(x,1)) || isinexactreal(gel(x,2));
502 :
503 588 : case t_POL: case t_SER:
504 5411 : for (i=lg(x)-1; i>1; i--)
505 4872 : if (isinexactreal(gel(x,i))) return 1;
506 539 : return 0;
507 :
508 0 : case t_VEC: case t_COL: case t_MAT:
509 0 : for (i=lg(x)-1; i>0; i--)
510 0 : if (isinexactreal(gel(x,i))) return 1;
511 0 : return 0;
512 0 : default: return 0;
513 : }
514 : }
515 : /* Check if x is approximately real with precision e */
516 : int
517 1158113 : isrealappr(GEN x, long e)
518 : {
519 : long i;
520 1158113 : switch(typ(x))
521 : {
522 264566 : case t_INT: case t_REAL: case t_FRAC:
523 264566 : return 1;
524 893551 : case t_COMPLEX:
525 893551 : return (gexpo(gel(x,2)) < e);
526 :
527 0 : case t_POL: case t_SER:
528 0 : for (i=lg(x)-1; i>1; i--)
529 0 : if (! isrealappr(gel(x,i),e)) return 0;
530 0 : return 1;
531 :
532 0 : case t_RFRAC: case t_POLMOD:
533 0 : return isrealappr(gel(x,1),e) && isrealappr(gel(x,2),e);
534 :
535 0 : case t_VEC: case t_COL: case t_MAT:
536 0 : for (i=lg(x)-1; i>0; i--)
537 0 : if (! isrealappr(gel(x,i),e)) return 0;
538 0 : return 1;
539 0 : default: pari_err_TYPE("isrealappr",x); return 0;
540 : }
541 : }
542 :
543 : /* returns 1 if there's an inexact component in the structure, and
544 : * 0 otherwise. */
545 : int
546 132800147 : isinexact(GEN x)
547 : {
548 : long lx, i;
549 :
550 132800147 : switch(typ(x))
551 : {
552 574189 : case t_REAL: case t_PADIC: case t_SER:
553 574189 : return 1;
554 89759816 : case t_INT: case t_INTMOD: case t_FFELT: case t_FRAC:
555 : case t_QFB:
556 89759816 : return 0;
557 2410887 : case t_COMPLEX: case t_QUAD: case t_RFRAC: case t_POLMOD:
558 2410887 : return isinexact(gel(x,1)) || isinexact(gel(x,2));
559 40055256 : case t_POL:
560 125505308 : for (i=lg(x)-1; i>1; i--)
561 85623283 : if (isinexact(gel(x,i))) return 1;
562 39882025 : return 0;
563 0 : case t_VEC: case t_COL: case t_MAT:
564 0 : for (i=lg(x)-1; i>0; i--)
565 0 : if (isinexact(gel(x,i))) return 1;
566 0 : return 0;
567 0 : case t_LIST:
568 0 : x = list_data(x); lx = x? lg(x): 1;
569 0 : for (i=1; i<lx; i++)
570 0 : if (isinexact(gel(x,i))) return 1;
571 0 : return 0;
572 : }
573 0 : return 0;
574 : }
575 :
576 : int
577 0 : isrationalzeroscalar(GEN g)
578 : {
579 0 : switch (typ(g))
580 : {
581 0 : case t_INT: return !signe(g);
582 0 : case t_COMPLEX: return isintzero(gel(g,1)) && isintzero(gel(g,2));
583 0 : case t_QUAD: return isintzero(gel(g,2)) && isintzero(gel(g,3));
584 : }
585 0 : return 0;
586 : }
587 :
588 : int
589 0 : iscomplex(GEN x)
590 : {
591 0 : switch(typ(x))
592 : {
593 0 : case t_INT: case t_REAL: case t_FRAC:
594 0 : return 0;
595 0 : case t_COMPLEX:
596 0 : return !gequal0(gel(x,2));
597 0 : case t_QUAD:
598 0 : return signe(gmael(x,1,2)) > 0;
599 : }
600 0 : pari_err_TYPE("iscomplex",x);
601 : return 0; /* LCOV_EXCL_LINE */
602 : }
603 :
604 : /*******************************************************************/
605 : /* */
606 : /* GENERIC REMAINDER */
607 : /* */
608 : /*******************************************************************/
609 : static int
610 1099 : is_realquad(GEN x) { GEN Q = gel(x,1); return signe(gel(Q,2)) < 0; }
611 : static int
612 177279 : is_realext(GEN x)
613 177279 : { long t = typ(x);
614 177279 : return (t == t_QUAD)? is_realquad(x): is_real_t(t);
615 : }
616 : /* euclidean quotient for scalars of admissible types */
617 : static GEN
618 875 : _quot(GEN x, GEN y)
619 : {
620 875 : GEN q = gdiv(x,y), f = gfloor(q);
621 637 : if (gsigne(y) < 0 && !gequal(f,q)) f = addiu(f, 1);
622 637 : return f;
623 : }
624 : /* y t_REAL, x \ y */
625 : static GEN
626 70 : _quotsr(long x, GEN y)
627 : {
628 : GEN q, f;
629 70 : if (!x) return gen_0;
630 70 : q = divsr(x,y); f = floorr(q);
631 70 : if (signe(y) < 0 && signe(subir(f,q))) f = addiu(f, 1);
632 70 : return f;
633 : }
634 : /* x t_REAL, x \ y */
635 : static GEN
636 28 : _quotrs(GEN x, long y)
637 : {
638 28 : GEN q = divrs(x,y), f = floorr(q);
639 28 : if (y < 0 && signe(subir(f,q))) f = addiu(f, 1);
640 28 : return f;
641 : }
642 : static GEN
643 7 : _quotri(GEN x, GEN y)
644 : {
645 7 : GEN q = divri(x,y), f = floorr(q);
646 7 : if (signe(y) < 0 && signe(subir(f,q))) f = addiu(f, 1);
647 7 : return f;
648 : }
649 : static GEN
650 70 : _quotsq(long x, GEN y)
651 : {
652 70 : GEN f = gfloor(gdivsg(x,y));
653 70 : if (gsigne(y) < 0) f = gaddgs(f, 1);
654 70 : return f;
655 : }
656 : static GEN
657 28 : _quotqs(GEN x, long y)
658 : {
659 28 : GEN f = gfloor(gdivgs(x,y));
660 28 : if (y < 0) f = addiu(f, 1);
661 28 : return f;
662 : }
663 :
664 : /* y t_FRAC, x \ y */
665 : static GEN
666 35 : _quotsf(long x, GEN y)
667 35 : { return truedivii(mulis(gel(y,2),x), gel(y,1)); }
668 : /* x t_FRAC, x \ y */
669 : static GEN
670 301 : _quotfs(GEN x, long y)
671 301 : { return truedivii(gel(x,1),mulis(gel(x,2),y)); }
672 : /* x t_FRAC, y t_INT, x \ y */
673 : static GEN
674 7 : _quotfi(GEN x, GEN y)
675 7 : { return truedivii(gel(x,1),mulii(gel(x,2),y)); }
676 :
677 : static GEN
678 777 : quot(GEN x, GEN y)
679 777 : { pari_sp av = avma; return gerepileupto(av, _quot(x, y)); }
680 : static GEN
681 14 : quotrs(GEN x, long y)
682 14 : { pari_sp av = avma; return gerepileuptoleaf(av, _quotrs(x,y)); }
683 : static GEN
684 301 : quotfs(GEN x, long s)
685 301 : { pari_sp av = avma; return gerepileuptoleaf(av, _quotfs(x,s)); }
686 : static GEN
687 35 : quotsr(long x, GEN y)
688 35 : { pari_sp av = avma; return gerepileuptoleaf(av, _quotsr(x, y)); }
689 : static GEN
690 35 : quotsf(long x, GEN y)
691 35 : { pari_sp av = avma; return gerepileuptoleaf(av, _quotsf(x, y)); }
692 : static GEN
693 35 : quotsq(long x, GEN y)
694 35 : { pari_sp av = avma; return gerepileuptoleaf(av, _quotsq(x, y)); }
695 : static GEN
696 14 : quotqs(GEN x, long y)
697 14 : { pari_sp av = avma; return gerepileuptoleaf(av, _quotqs(x, y)); }
698 : static GEN
699 7 : quotfi(GEN x, GEN y)
700 7 : { pari_sp av = avma; return gerepileuptoleaf(av, _quotfi(x, y)); }
701 : static GEN
702 7 : quotri(GEN x, GEN y)
703 7 : { pari_sp av = avma; return gerepileuptoleaf(av, _quotri(x, y)); }
704 :
705 : static GEN
706 14 : modrs(GEN x, long y)
707 : {
708 14 : pari_sp av = avma;
709 14 : GEN q = _quotrs(x,y);
710 14 : if (!signe(q)) { set_avma(av); return rcopy(x); }
711 7 : return gerepileuptoleaf(av, subri(x, mulis(q,y)));
712 : }
713 : static GEN
714 35 : modsr(long x, GEN y)
715 : {
716 35 : pari_sp av = avma;
717 35 : GEN q = _quotsr(x,y);
718 35 : if (!signe(q)) return gc_stoi(av, x);
719 7 : return gerepileuptoleaf(av, subsr(x, mulir(q,y)));
720 : }
721 : static GEN
722 35 : modsf(long x, GEN y)
723 : {
724 35 : pari_sp av = avma;
725 35 : return gerepileupto(av, Qdivii(modii(mulis(gel(y,2),x), gel(y,1)), gel(y,2)));
726 : }
727 :
728 : /* assume y a t_REAL, x a t_INT, t_FRAC or t_REAL.
729 : * Return x mod y or NULL if accuracy error */
730 : GEN
731 0 : modRr_safe(GEN x, GEN y)
732 : {
733 : GEN q, f;
734 : long e;
735 0 : if (isintzero(x)) return gen_0;
736 0 : q = gdiv(x,y); /* t_REAL */
737 :
738 0 : e = expo(q);
739 0 : if (e >= 0 && nbits2prec(e+1) > realprec(q)) return NULL;
740 0 : f = floorr(q);
741 0 : if (signe(y) < 0 && signe(subri(q,f))) f = addiu(f, 1);
742 0 : return signe(f)? gsub(x, mulir(f,y)): x;
743 : }
744 : GEN
745 4776285 : modRr_i(GEN x, GEN y, GEN iy)
746 : {
747 : GEN q, f;
748 : long e;
749 4776285 : if (isintzero(x)) return gen_0;
750 4776289 : q = gmul(x, iy); /* t_REAL */
751 :
752 4776210 : e = expo(q);
753 4776210 : if (e >= 0 && nbits2prec(e+1) > realprec(q)) return NULL;
754 4776209 : f = floorr(q);
755 4776085 : if (signe(y) < 0 && signe(subri(q,f))) f = addiu(f, 1);
756 4776194 : return signe(f)? gsub(x, mulir(f,y)): x;
757 : }
758 :
759 : GEN
760 46137253 : gmod(GEN x, GEN y)
761 : {
762 : pari_sp av;
763 : long ty, tx;
764 : GEN z;
765 :
766 46137253 : tx = typ(x); if (tx == t_INT && !is_bigint(x)) return gmodsg(itos(x),y);
767 1146488 : ty = typ(y); if (ty == t_INT && !is_bigint(y)) return gmodgs(x,itos(y));
768 1746132 : if (is_matvec_t(tx)) pari_APPLY_same(gmod(gel(x,i), y));
769 808590 : if (tx == t_POL || ty == t_POL) return grem(x,y);
770 511458 : if (!is_scalar_t(tx) || !is_scalar_t(ty)) pari_err_TYPE2("%",x,y);
771 511395 : switch(ty)
772 : {
773 510891 : case t_INT:
774 : switch(tx)
775 : {
776 507647 : case t_INT: return modii(x,y);
777 7 : case t_INTMOD: z=cgetg(3, t_INTMOD);
778 7 : gel(z,1) = gcdii(gel(x,1),y);
779 7 : gel(z,2) = modii(gel(x,2),gel(z,1)); return z;
780 491 : case t_FRAC: return Fp_div(gel(x,1),gel(x,2),y);
781 2711 : case t_PADIC: return padic_to_Fp(x, y);
782 14 : case t_QUAD: if (!is_realquad(x)) break;
783 : case t_REAL:
784 14 : av = avma; /* NB: conflicting semantic with lift(x * Mod(1,y)). */
785 14 : return gerepileupto(av, gsub(x, gmul(_quot(x,y),y)));
786 : }
787 21 : break;
788 126 : case t_QUAD:
789 126 : if (!is_realquad(y)) break;
790 : case t_REAL: case t_FRAC:
791 189 : if (!is_realext(x)) break;
792 84 : av = avma;
793 84 : return gerepileupto(av, gsub(x, gmul(_quot(x,y),y)));
794 : }
795 441 : pari_err_TYPE2("%",x,y);
796 : return NULL; /* LCOV_EXCL_LINE */
797 : }
798 :
799 : GEN
800 22027688 : gmodgs(GEN x, long y)
801 : {
802 : ulong u;
803 22027688 : long i, tx = typ(x);
804 : GEN z;
805 43821730 : if (is_matvec_t(tx)) pari_APPLY_same(gmodgs(gel(x,i), y));
806 19649432 : if (!y) pari_err_INV("gmodgs",gen_0);
807 19649432 : switch(tx)
808 : {
809 19566751 : case t_INT: return modis(x,y);
810 14 : case t_REAL: return modrs(x,y);
811 :
812 21 : case t_INTMOD: z=cgetg(3, t_INTMOD);
813 21 : u = (ulong)labs(y);
814 21 : i = ugcdiu(gel(x,1), u);
815 21 : gel(z,1) = utoi(i);
816 21 : gel(z,2) = modis(gel(x,2), i); return z;
817 :
818 81388 : case t_FRAC:
819 81388 : u = (ulong)labs(y);
820 81388 : return utoi( Fl_div(umodiu(gel(x,1), u),
821 81388 : umodiu(gel(x,2), u), u) );
822 28 : case t_QUAD:
823 : {
824 28 : pari_sp av = avma;
825 28 : if (!is_realquad(x)) break;
826 14 : return gerepileupto(av, gsub(x, gmulgs(_quotqs(x,y),y)));
827 : }
828 1174 : case t_PADIC: return padic_to_Fp(x, stoi(y));
829 14 : case t_POL: return scalarpol(Rg_get_0(x), varn(x));
830 14 : case t_POLMOD: return gmul(gen_0,x);
831 : }
832 42 : pari_err_TYPE2("%",x,stoi(y));
833 : return NULL; /* LCOV_EXCL_LINE */
834 : }
835 : GEN
836 44990765 : gmodsg(long x, GEN y)
837 : {
838 44990765 : switch(typ(y))
839 : {
840 44990408 : case t_INT: return modsi(x,y);
841 35 : case t_REAL: return modsr(x,y);
842 35 : case t_FRAC: return modsf(x,y);
843 63 : case t_QUAD:
844 : {
845 63 : pari_sp av = avma;
846 63 : if (!is_realquad(y)) break;
847 35 : return gerepileupto(av, gsubsg(x, gmul(_quotsq(x,y),y)));
848 : }
849 112 : case t_POL:
850 112 : if (!signe(y)) pari_err_INV("gmodsg",y);
851 112 : return degpol(y)? gmulsg(x, Rg_get_1(y)): Rg_get_0(y);
852 : }
853 140 : pari_err_TYPE2("%",stoi(x),y);
854 : return NULL; /* LCOV_EXCL_LINE */
855 : }
856 : /* divisibility: return 1 if y | x, 0 otherwise */
857 : int
858 15403 : gdvd(GEN x, GEN y)
859 : {
860 15403 : pari_sp av = avma;
861 15403 : return gc_bool(av, gequal0( gmod(x,y) ));
862 : }
863 :
864 : GEN
865 774518 : gmodulss(long x, long y)
866 : {
867 774518 : if (!y) pari_err_INV("%",gen_0);
868 774511 : y = labs(y);
869 774511 : retmkintmod(utoi(umodsu(x, y)), utoipos(y));
870 : }
871 : GEN
872 1076629 : gmodulsg(long x, GEN y)
873 : {
874 1076629 : switch(typ(y))
875 : {
876 828085 : case t_INT:
877 828085 : if (!is_bigint(y)) return gmodulss(x,itos(y));
878 62612 : retmkintmod(modsi(x,y), absi(y));
879 248537 : case t_POL:
880 248537 : if (!signe(y)) pari_err_INV("%", y);
881 248530 : retmkpolmod(degpol(y)? stoi(x): gen_0,RgX_copy(y));
882 : }
883 7 : pari_err_TYPE2("%",stoi(x),y);
884 : return NULL; /* LCOV_EXCL_LINE */
885 : }
886 : GEN
887 1596601 : gmodulo(GEN x,GEN y)
888 : {
889 1596601 : long tx = typ(x), vx, vy;
890 1596601 : if (tx == t_INT && !is_bigint(x)) return gmodulsg(itos(x), y);
891 1066310 : if (is_matvec_t(tx)) pari_APPLY_same(gmodulo(gel(x,i), y));
892 514999 : switch(typ(y))
893 : {
894 98205 : case t_INT:
895 98205 : if (!is_const_t(tx)) return gmul(x, gmodulsg(1,y));
896 98163 : if (tx == t_INTMOD) return gmod(x,y);
897 98156 : retmkintmod(Rg_to_Fp(x,y), absi(y));
898 416794 : case t_POL:
899 416794 : vx = gvar(x); vy = varn(y);
900 416794 : if (varncmp(vy, vx) > 0) return gmul(x, gmodulsg(1,y));
901 413042 : if (vx == vy && tx == t_POLMOD) return grem(x,y);
902 399644 : retmkpolmod(grem(x,y), RgX_copy(y));
903 : }
904 0 : pari_err_TYPE2("%",x,y);
905 : return NULL; /* LCOV_EXCL_LINE */
906 : }
907 :
908 : /*******************************************************************/
909 : /* */
910 : /* GENERIC EUCLIDEAN DIVISION */
911 : /* */
912 : /*******************************************************************/
913 : GEN
914 6200418 : gdivent(GEN x, GEN y)
915 : {
916 : long tx, ty;
917 6200418 : tx = typ(x); if (tx == t_INT && !is_bigint(x)) return gdiventsg(itos(x),y);
918 2188 : ty = typ(y); if (ty == t_INT && !is_bigint(y)) return gdiventgs(x,itos(y));
919 1960 : if (is_matvec_t(tx)) pari_APPLY_same(gdivent(gel(x,i), y));
920 1610 : if (tx == t_POL || ty == t_POL) return gdeuc(x,y);
921 1148 : switch(ty)
922 : {
923 112 : case t_INT:
924 : switch(tx)
925 : {
926 7 : case t_INT: return truedivii(x,y);
927 7 : case t_REAL: return quotri(x,y);
928 7 : case t_FRAC: return quotfi(x,y);
929 21 : case t_QUAD:
930 21 : if (!is_realquad(x)) break;
931 7 : return quot(x,y);
932 : }
933 84 : break;
934 252 : case t_QUAD:
935 252 : if (!is_realext(x) || !is_realquad(y)) break;
936 : case t_REAL: case t_FRAC:
937 252 : return quot(x,y);
938 : }
939 868 : pari_err_TYPE2("\\",x,y);
940 : return NULL; /* LCOV_EXCL_LINE */
941 : }
942 :
943 : GEN
944 292452 : gdiventgs(GEN x, long y)
945 : {
946 292452 : switch(typ(x))
947 : {
948 243794 : case t_INT: return truedivis(x,y);
949 14 : case t_REAL: return quotrs(x,y);
950 301 : case t_FRAC: return quotfs(x,y);
951 42 : case t_QUAD: if (!is_realquad(x)) break;
952 14 : return quotqs(x,y);
953 28 : case t_POL: return gdivgs(x,y);
954 282739 : case t_VEC: case t_COL: case t_MAT: pari_APPLY_same(gdiventgs(gel(x,i),y));
955 : }
956 168 : pari_err_TYPE2("\\",x,stoi(y));
957 : return NULL; /* LCOV_EXCL_LINE */
958 : }
959 : GEN
960 6198230 : gdiventsg(long x, GEN y)
961 : {
962 6198230 : switch(typ(y))
963 : {
964 6197775 : case t_INT: return truedivsi(x,y);
965 35 : case t_REAL: return quotsr(x,y);
966 35 : case t_FRAC: return quotsf(x,y);
967 91 : case t_QUAD: if (!is_realquad(y)) break;
968 35 : return quotsq(x,y);
969 70 : case t_POL:
970 70 : if (!signe(y)) pari_err_INV("gdiventsg",y);
971 70 : return degpol(y)? Rg_get_0(y): gdivsg(x,gel(y,2));
972 : }
973 280 : pari_err_TYPE2("\\",stoi(x),y);
974 : return NULL; /* LCOV_EXCL_LINE */
975 : }
976 :
977 : /* with remainder */
978 : static GEN
979 518 : quotrem(GEN x, GEN y, GEN *r)
980 : {
981 518 : GEN q = quot(x,y);
982 448 : pari_sp av = avma;
983 448 : *r = gerepileupto(av, gsub(x, gmul(q,y)));
984 448 : return q;
985 : }
986 :
987 : GEN
988 1064 : gdiventres(GEN x, GEN y)
989 : {
990 1064 : long tx = typ(x), ty = typ(y);
991 : GEN z;
992 :
993 1078 : if (is_matvec_t(tx)) pari_APPLY_same(gdiventres(gel(x,i), y));
994 1057 : z = cgetg(3,t_COL);
995 1057 : if (tx == t_POL || ty == t_POL)
996 : {
997 182 : gel(z,1) = poldivrem(x,y,(GEN*)(z+2));
998 168 : return z;
999 : }
1000 875 : switch(ty)
1001 : {
1002 252 : case t_INT:
1003 : switch(tx)
1004 : { /* equal to, but more efficient than next case */
1005 84 : case t_INT:
1006 84 : gel(z,1) = truedvmdii(x,y,(GEN*)(z+2));
1007 84 : return z;
1008 42 : case t_QUAD:
1009 42 : if (!is_realquad(x)) break;
1010 : case t_REAL: case t_FRAC:
1011 63 : gel(z,1) = quotrem(x,y,&gel(z,2));
1012 63 : return z;
1013 : }
1014 105 : break;
1015 154 : case t_QUAD:
1016 154 : if (!is_realext(x) || !is_realquad(y)) break;
1017 : case t_REAL: case t_FRAC:
1018 196 : gel(z,1) = quotrem(x,y,&gel(z,2));
1019 126 : return z;
1020 : }
1021 532 : pari_err_TYPE2("\\",x,y);
1022 : return NULL; /* LCOV_EXCL_LINE */
1023 : }
1024 :
1025 : GEN
1026 1057 : divrem(GEN x, GEN y, long v)
1027 : {
1028 1057 : pari_sp av = avma;
1029 : long vx, vy;
1030 : GEN q, r;
1031 1057 : if (v < 0 || typ(y) != t_POL || typ(x) != t_POL) return gdiventres(x,y);
1032 7 : vx = varn(x); if (vx != v) x = swap_vars(x,v);
1033 7 : vy = varn(y); if (vy != v) y = swap_vars(y,v);
1034 7 : q = RgX_divrem(x,y, &r);
1035 7 : if (v && (vx != v || vy != v))
1036 : {
1037 7 : GEN X = pol_x(v);
1038 7 : q = gsubst(q, v, X); /* poleval broken for t_RFRAC, subst is safe */
1039 7 : r = gsubst(r, v, X);
1040 : }
1041 7 : return gerepilecopy(av, mkcol2(q, r));
1042 : }
1043 :
1044 : GEN
1045 59808569 : diviiround(GEN x, GEN y)
1046 : {
1047 59808569 : pari_sp av1, av = avma;
1048 : GEN q,r;
1049 : int fl;
1050 :
1051 59808569 : q = dvmdii(x,y,&r); /* q = x/y rounded towards 0, sgn(r)=sgn(x) */
1052 59783420 : if (r==gen_0) return q;
1053 33786061 : av1 = avma;
1054 33786061 : fl = abscmpii(shifti(r,1),y);
1055 33809000 : set_avma(av1); cgiv(r);
1056 33812264 : if (fl >= 0) /* If 2*|r| >= |y| */
1057 : {
1058 18037872 : long sz = signe(x)*signe(y);
1059 18037872 : if (fl || sz > 0) q = gerepileuptoint(av, addis(q,sz));
1060 : }
1061 33817464 : return q;
1062 : }
1063 :
1064 : static GEN
1065 518 : _abs(GEN x)
1066 : {
1067 518 : if (typ(x) == t_QUAD) return (gsigne(x) < 0)? gneg(x): x;
1068 364 : return R_abs_shallow(x);
1069 : }
1070 :
1071 : /* If x and y are not both scalars, same as gdivent.
1072 : * Otherwise, compute the quotient x/y, rounded to the nearest integer
1073 : * (towards +oo in case of tie). */
1074 : GEN
1075 1465265 : gdivround(GEN x, GEN y)
1076 : {
1077 : pari_sp av;
1078 1465265 : long tx = typ(x), ty = typ(y);
1079 : GEN q, r;
1080 :
1081 1465265 : if (tx == t_INT && ty == t_INT) return diviiround(x,y);
1082 176067 : av = avma;
1083 176067 : if (is_realext(x) && is_realext(y))
1084 : { /* same as diviiround, less efficient */
1085 : pari_sp av1;
1086 : int fl;
1087 259 : q = quotrem(x,y,&r); av1 = avma;
1088 259 : fl = gcmp(gmul2n(_abs(r),1), _abs(y));
1089 259 : set_avma(av1); cgiv(r);
1090 259 : if (fl >= 0) /* If 2*|r| >= |y| */
1091 : {
1092 84 : long sz = gsigne(y);
1093 84 : if (fl || sz > 0) q = gerepileupto(av, gaddgs(q, sz));
1094 : }
1095 259 : return q;
1096 : }
1097 1586873 : if (is_matvec_t(tx)) pari_APPLY_same(gdivround(gel(x,i),y));
1098 931 : return gdivent(x,y);
1099 : }
1100 :
1101 : GEN
1102 0 : gdivmod(GEN x, GEN y, GEN *pr)
1103 : {
1104 0 : switch(typ(x))
1105 : {
1106 0 : case t_INT:
1107 0 : switch(typ(y))
1108 : {
1109 0 : case t_INT: return dvmdii(x,y,pr);
1110 0 : case t_POL: *pr=icopy(x); return gen_0;
1111 : }
1112 0 : break;
1113 0 : case t_POL: return poldivrem(x,y,pr);
1114 : }
1115 0 : pari_err_TYPE2("gdivmod",x,y);
1116 : return NULL;/*LCOV_EXCL_LINE*/
1117 : }
1118 :
1119 : /*******************************************************************/
1120 : /* */
1121 : /* SHIFT */
1122 : /* */
1123 : /*******************************************************************/
1124 :
1125 : /* Shift tronque si n<0 (multiplication tronquee par 2^n) */
1126 :
1127 : GEN
1128 44778563 : gshift(GEN x, long n)
1129 : {
1130 44778563 : switch(typ(x))
1131 : {
1132 37790383 : case t_INT: return shifti(x,n);
1133 6840114 : case t_REAL:return shiftr(x,n);
1134 35077 : case t_VEC: case t_COL: case t_MAT: pari_APPLY_same(gshift(gel(x,i),n));
1135 : }
1136 137629 : return gmul2n(x,n);
1137 : }
1138 :
1139 : /*******************************************************************/
1140 : /* */
1141 : /* SUBSTITUTION DANS UN POLYNOME OU UNE SERIE */
1142 : /* */
1143 : /*******************************************************************/
1144 :
1145 : /* Convert t_SER --> t_POL, ignoring valser. INTERNAL ! */
1146 : GEN
1147 9975794 : ser2pol_i(GEN x, long lx)
1148 : {
1149 9975794 : long i = lx-1;
1150 : GEN y;
1151 13748325 : while (i > 1 && isrationalzero(gel(x,i))) i--;
1152 9975794 : if (!signe(x))
1153 : { /* danger */
1154 105 : if (i == 1) return zeropol(varn(x));
1155 105 : y = cgetg(3,t_POL); y[1] = x[1] & ~VALSERBITS;
1156 105 : gel(y,2) = gel(x,2); return y;
1157 : }
1158 9975689 : y = cgetg(i+1, t_POL); y[1] = x[1] & ~VALSERBITS;
1159 42232163 : for ( ; i > 1; i--) gel(y,i) = gel(x,i);
1160 9975689 : return y;
1161 : }
1162 :
1163 : GEN
1164 740451 : ser2pol_i_normalize(GEN x, long l, long *v)
1165 : {
1166 740451 : long i = 2, j = l-1, k;
1167 : GEN y;
1168 740486 : while (i < l && gequal0(gel(x,i))) i++;
1169 740451 : *v = i - 2; if (i == l) return zeropol(varn(x));
1170 981264 : while (j > i && gequal0(gel(x,j))) j--;
1171 740437 : l = j - *v + 1;
1172 740437 : y = cgetg(l, t_POL); y[1] = x[1] & ~VALSERBITS;
1173 3833554 : k = l; while (k > 2) gel(y, --k) = gel(x,j--);
1174 740437 : return y;
1175 : }
1176 :
1177 : GEN
1178 38472 : ser_inv(GEN b)
1179 : {
1180 38472 : pari_sp av = avma;
1181 38472 : long e, l = lg(b);
1182 : GEN x, y;
1183 38472 : y = ser2pol_i_normalize(b, l, &e);
1184 38472 : if (e)
1185 : {
1186 0 : pari_warn(warner,"normalizing a series with 0 leading term");
1187 0 : l -= e; if (l <= 2) pari_err_INV("inv_ser", b);
1188 : }
1189 38472 : y = RgXn_inv_i(y, l-2);
1190 38465 : x = RgX_to_ser(y, l); setvalser(x, - valser(b) - e);
1191 38465 : return gerepilecopy(av, x);
1192 : }
1193 :
1194 : /* T t_POL in var v, mod out by T components of x which are t_POL/t_RFRAC in v.
1195 : * Recursively. Make sure that resulting polynomials of degree 0 in v are
1196 : * simplified (map K[X]_0 to K) */
1197 : static GEN
1198 196 : mod_r(GEN x, long v, GEN T)
1199 : {
1200 196 : long w, tx = typ(x);
1201 : GEN y;
1202 :
1203 196 : if (is_const_t(tx)) return x;
1204 175 : switch(tx)
1205 : {
1206 7 : case t_POLMOD:
1207 7 : w = varn(gel(x,1));
1208 7 : if (w == v) pari_err_PRIORITY("subst", gel(x,1), "=", v);
1209 7 : if (varncmp(v, w) < 0) return x;
1210 7 : return gmodulo(mod_r(gel(x,2),v,T), mod_r(gel(x,1),v,T));
1211 7 : case t_SER:
1212 7 : w = varn(x);
1213 7 : if (w == v) break; /* fail */
1214 7 : if (varncmp(v, w) < 0 || ser_isexactzero(x)) return x;
1215 21 : pari_APPLY_ser(mod_r(gel(x,i),v,T));
1216 133 : case t_POL:
1217 133 : w = varn(x);
1218 133 : if (w == v)
1219 : {
1220 105 : x = RgX_rem(x, T);
1221 105 : if (!degpol(x)) x = gel(x,2);
1222 105 : return x;
1223 : }
1224 28 : if (varncmp(v, w) < 0) return x;
1225 98 : pari_APPLY_pol(mod_r(gel(x,i),v,T));
1226 14 : case t_RFRAC:
1227 14 : x = gdiv(mod_r(gel(x,1),v,T), mod_r(gel(x,2),v,T));
1228 14 : if (typ(x) == t_POL && varn(x) == v && lg(x) == 3) x = gel(x,2);
1229 14 : return x;
1230 7 : case t_VEC: case t_COL: case t_MAT:
1231 21 : pari_APPLY_same(mod_r(gel(x,i),v,T));
1232 7 : case t_LIST:
1233 7 : y = mklist();
1234 7 : list_data(y) = list_data(x)? mod_r(list_data(x),v,T): NULL;
1235 7 : return y;
1236 : }
1237 0 : pari_err_TYPE("substpol",x);
1238 : return NULL;/*LCOV_EXCL_LINE*/
1239 : }
1240 : GEN
1241 8708 : gsubstpol(GEN x, GEN T, GEN y)
1242 : {
1243 8708 : pari_sp av = avma;
1244 : long v;
1245 : GEN z;
1246 8708 : if (typ(T) == t_POL && RgX_is_monomial(T) && gequal1(leading_coeff(T)))
1247 : { /* T = t^d */
1248 8687 : long d = degpol(T);
1249 8687 : v = varn(T); z = (d==1)? x: gdeflate(x, v, d);
1250 8673 : if (z) return gerepileupto(av, gsubst(z, v, y));
1251 : }
1252 49 : v = fetch_var(); T = simplify_shallow(T);
1253 49 : if (typ(T) == t_RFRAC)
1254 21 : z = gsub(gel(T,1), gmul(pol_x(v), gel(T,2)));
1255 : else
1256 28 : z = gsub(T, pol_x(v));
1257 49 : z = mod_r(x, gvar(T), z);
1258 49 : z = gsubst(z, v, y); (void)delete_var();
1259 49 : return gerepileupto(av, z);
1260 : }
1261 :
1262 : long
1263 308198 : RgX_deflate_order(GEN x)
1264 : {
1265 308198 : ulong d = 0, i, lx = (ulong)lg(x);
1266 1029635 : for (i=3; i<lx; i++)
1267 905475 : if (!gequal0(gel(x,i))) { d = ugcd(d,i-2); if (d == 1) return 1; }
1268 124160 : return d? (long)d: 1;
1269 : }
1270 : long
1271 510923 : ZX_deflate_order(GEN x)
1272 : {
1273 510923 : ulong d = 0, i, lx = (ulong)lg(x);
1274 1599325 : for (i=3; i<lx; i++)
1275 1409200 : if (signe(gel(x,i))) { d = ugcd(d,i-2); if (d == 1) return 1; }
1276 190125 : return d? (long)d: 1;
1277 : }
1278 :
1279 : /* deflate (non-leaf) x recursively */
1280 : static GEN
1281 63 : vdeflate(GEN x, long v, long d)
1282 : {
1283 63 : long i = lontyp[typ(x)], lx;
1284 63 : GEN z = cgetg_copy(x, &lx);
1285 63 : if (i == 2) z[1] = x[1];
1286 154 : for (; i<lx; i++)
1287 : {
1288 133 : gel(z,i) = gdeflate(gel(x,i),v,d);
1289 133 : if (!z[i]) return NULL;
1290 : }
1291 21 : return z;
1292 : }
1293 :
1294 : /* don't return NULL if substitution fails (fallback won't be able to handle
1295 : * t_SER anyway), fail with a meaningful message */
1296 : static GEN
1297 2961 : serdeflate(GEN x, long v, long d)
1298 : {
1299 2961 : long V, dy, lx, vx = varn(x);
1300 : pari_sp av;
1301 : GEN y;
1302 2961 : if (varncmp(vx, v) < 0) return vdeflate(x,v,d);
1303 2954 : if (varncmp(vx, v) > 0) return gcopy(x);
1304 2954 : av = avma;
1305 2954 : V = valser(x);
1306 2954 : lx = lg(x);
1307 2954 : if (lx == 2) return zeroser(v, V / d);
1308 2954 : y = ser2pol_i(x, lx);
1309 2954 : dy = degpol(y);
1310 2954 : if (V % d != 0 || (dy > 0 && RgX_deflate_order(y) % d != 0))
1311 : {
1312 14 : const char *s = stack_sprintf("valuation(x) %% %ld", d);
1313 14 : pari_err_DOMAIN("gdeflate", s, "!=", gen_0,x);
1314 : }
1315 2940 : if (dy > 0) y = RgX_deflate(y, d);
1316 2940 : y = RgX_to_ser(y, 3 + (lx-3)/d);
1317 2940 : setvalser(y, V/d); return gerepilecopy(av, y);
1318 : }
1319 : static GEN
1320 8722 : poldeflate(GEN x, long v, long d)
1321 : {
1322 8722 : long vx = varn(x);
1323 : pari_sp av;
1324 8722 : if (varncmp(vx, v) < 0) return vdeflate(x,v,d);
1325 8694 : if (varncmp(vx, v) > 0 || degpol(x) <= 0) return gcopy(x);
1326 8659 : av = avma;
1327 : /* x nonconstant */
1328 8659 : if (RgX_deflate_order(x) % d != 0) return NULL;
1329 8631 : return gerepilecopy(av, RgX_deflate(x,d));
1330 : }
1331 : static GEN
1332 21 : listdeflate(GEN x, long v, long d)
1333 : {
1334 21 : GEN y = NULL, z = mklist();
1335 21 : if (list_data(x))
1336 : {
1337 14 : y = vdeflate(list_data(x),v,d);
1338 14 : if (!y) return NULL;
1339 : }
1340 14 : list_data(z) = y; return z;
1341 : }
1342 : /* return NULL if substitution fails */
1343 : GEN
1344 11746 : gdeflate(GEN x, long v, long d)
1345 : {
1346 11746 : if (d <= 0) pari_err_DOMAIN("gdeflate", "degree", "<=", gen_0,stoi(d));
1347 11746 : switch(typ(x))
1348 : {
1349 28 : case t_INT:
1350 : case t_REAL:
1351 : case t_INTMOD:
1352 : case t_FRAC:
1353 : case t_FFELT:
1354 : case t_COMPLEX:
1355 : case t_PADIC:
1356 28 : case t_QUAD: return gcopy(x);
1357 8722 : case t_POL: return poldeflate(x,v,d);
1358 2961 : case t_SER: return serdeflate(x,v,d);
1359 7 : case t_POLMOD:
1360 7 : if (varncmp(varn(gel(x,1)), v) >= 0) return gcopy(x);
1361 : /* fall through */
1362 : case t_RFRAC:
1363 : case t_VEC:
1364 : case t_COL:
1365 14 : case t_MAT: return vdeflate(x,v,d);
1366 21 : case t_LIST: return listdeflate(x,v,d);
1367 : }
1368 0 : pari_err_TYPE("gdeflate",x);
1369 : return NULL; /* LCOV_EXCL_LINE */
1370 : }
1371 :
1372 : /* set *m to the largest d such that x0 = A(X^d); return A */
1373 : GEN
1374 297411 : RgX_deflate_max(GEN x, long *m)
1375 : {
1376 297411 : *m = RgX_deflate_order(x);
1377 297410 : return RgX_deflate(x, *m);
1378 : }
1379 : GEN
1380 315996 : ZX_deflate_max(GEN x, long *m)
1381 : {
1382 315996 : *m = ZX_deflate_order(x);
1383 315997 : return RgX_deflate(x, *m);
1384 : }
1385 :
1386 : static int
1387 20951 : serequalXk(GEN x)
1388 : {
1389 20951 : long i, l = lg(x);
1390 20951 : if (l == 2 || !isint1(gel(x,2))) return 0;
1391 9870 : for (i = 3; i < l; i++)
1392 7917 : if (!isintzero(gel(x,i))) return 0;
1393 1953 : return 1;
1394 : }
1395 :
1396 : static GEN
1397 84 : gsubst_v(GEN e, long v, GEN x)
1398 245 : { pari_APPLY_same(gsubst(e, v, gel(x,i))); }
1399 :
1400 : static GEN
1401 14 : constmat(GEN z, long n)
1402 : {
1403 14 : GEN y = cgetg(n+1, t_MAT), c = const_col(n, gcopy(z));
1404 : long i;
1405 35 : for (i = 1; i <= n; i++) gel(y, i) = c;
1406 14 : return y;
1407 : }
1408 : static GEN
1409 56 : scalarmat2(GEN o, GEN z, long n)
1410 : {
1411 : GEN y;
1412 : long i;
1413 56 : if (n == 0) return cgetg(1, t_MAT);
1414 56 : if (n == 1) retmkmat(mkcol(gcopy(o)));
1415 35 : y = cgetg(n+1, t_MAT); z = gcopy(z); o = gcopy(o);
1416 105 : for (i = 1; i <= n; i++) { gel(y, i) = const_col(n, z); gcoeff(y,i,i) = o; }
1417 35 : return y;
1418 : }
1419 : /* x * y^0, n = dim(y) if t_MAT, else -1 */
1420 : static GEN
1421 749041 : subst_higher(GEN x, GEN y, long n)
1422 : {
1423 749041 : GEN o = Rg_get_1(y);
1424 749041 : if (o == gen_1) return n < 0? gcopy(x): scalarmat(x,n);
1425 63 : x = gmul(x,o); return n < 0? x: scalarmat2(x, Rg_get_0(y), n);
1426 : }
1427 :
1428 : /* x t_POLMOD, v strictly lower priority than var(x) */
1429 : static GEN
1430 10969 : subst_polmod(GEN x, long v, GEN y)
1431 : {
1432 : long l, i;
1433 10969 : GEN a = gsubst(gel(x,2),v,y), b = gsubst(gel(x,1),v,y), z;
1434 :
1435 10969 : if (typ(b) != t_POL) pari_err_TYPE2("substitution",x,y);
1436 10969 : if (typ(a) != t_POL || varncmp(varn(a), varn(b)) >= 0) return gmodulo(a, b);
1437 532 : l = lg(a); z = cgetg(l,t_POL); z[1] = a[1];
1438 4067 : for (i = 2; i < l; i++) gel(z,i) = gmodulo(gel(a,i),b);
1439 532 : return normalizepol_lg(z, l);
1440 : }
1441 : /* Trunc to n terms; x + O(t^(n + v(x))). FIXME: export ? */
1442 : static GEN
1443 70 : sertrunc(GEN x, long n)
1444 : {
1445 70 : long i, l = n + 2;
1446 : GEN y;
1447 70 : if (l >= lg(x)) return x;
1448 14 : if (n <= 0) return zeroser(varn(x), n + valser(x));
1449 14 : y = cgetg(l, t_SER);
1450 28 : for (i = 2; i < l; i++) gel(y,i) = gel(x,i);
1451 14 : y[1] = x[1]; return y;
1452 : }
1453 : /* FIXME: export ? */
1454 : static GEN
1455 1960 : sertrunc_copy(GEN x, long n)
1456 : {
1457 1960 : long i, l = minss(n + 2, lg(x));
1458 1960 : GEN y = cgetg(l, t_SER);
1459 13433 : for (i = 2; i < l; i++) gel(y,i) = gcopy(gel(x,i));
1460 1960 : y[1] = x[1]; return y;
1461 : }
1462 :
1463 : GEN
1464 2734615 : gsubst(GEN x, long v, GEN y)
1465 : {
1466 2734615 : long tx = typ(x), ty = typ(y), lx = lg(x), ly = lg(y);
1467 : long l, vx, vy, ex, ey, i, j, k, jb, matn;
1468 : pari_sp av, av2;
1469 : GEN X, t, z;
1470 :
1471 2734615 : switch(ty)
1472 : {
1473 84 : case t_VEC: case t_COL:
1474 84 : return gsubst_v(x, v, y);
1475 175 : case t_MAT:
1476 175 : if (ly==1) return cgetg(1,t_MAT);
1477 168 : if (ly == lgcols(y)) { matn = ly - 1; break; }
1478 : /* fall through */
1479 : case t_QFB:
1480 7 : pari_err_TYPE2("substitution",x,y);
1481 2734356 : default: matn = -1;
1482 : }
1483 2734517 : if (is_scalar_t(tx))
1484 : {
1485 411792 : if (tx == t_POLMOD && varncmp(v, varn(gel(x,1))) > 0)
1486 : {
1487 10969 : av = avma;
1488 10969 : return gerepileupto(av, subst_polmod(x, v, y));
1489 : }
1490 400823 : return subst_higher(x, y, matn);
1491 : }
1492 :
1493 2322725 : switch(tx)
1494 : {
1495 2083565 : case t_POL:
1496 2083565 : vx = varn(x);
1497 2083565 : if (varncmp(vx, v) > 0) return subst_higher(x, y, matn);
1498 2081465 : if (varncmp(vx, v) < 0)
1499 : {
1500 176485 : av = avma; z = cgetg(lx, t_POL); z[1] = x[1];
1501 176485 : if (lx == 2) return z;
1502 819867 : for (i = 2; i < lx; i++) gel(z,i) = gsubst(gel(x,i),v,y);
1503 176044 : z = normalizepol_lg(z, lx); lx = lg(z);
1504 176044 : if (lx == 2) { set_avma(av); return zeropol(vx); }
1505 176030 : if (lx == 3) return gerepileupto(av, gmul(pol_1(vx), gel(z,2)));
1506 153728 : return gerepileupto(av, poleval(z, pol_x(vx)));
1507 : }
1508 : /* v = vx */
1509 1904980 : if (lx == 2)
1510 : {
1511 27867 : GEN z = Rg_get_0(y);
1512 27867 : return matn >= 0? constmat(z, matn): z;
1513 : }
1514 1877113 : if (lx == 3)
1515 : {
1516 346111 : x = subst_higher(gel(x,2), y, matn);
1517 346111 : if (matn >= 0) return x;
1518 346097 : vy = gvar(y);
1519 346097 : return (vy == NO_VARIABLE)? x: gmul(x, pol_1(vy));
1520 : }
1521 1531002 : return matn >= 0? RgX_RgM_eval(x, y): poleval(x,y);
1522 :
1523 25613 : case t_SER:
1524 25613 : vx = varn(x);
1525 25613 : if (varncmp(vx, v) > 0) return subst_higher(x, y, matn);
1526 25606 : ex = valser(x);
1527 25606 : if (varncmp(vx, v) < 0)
1528 : {
1529 56 : if (lx == 2) return matn >= 0? scalarmat(x, matn): gcopy(x);
1530 56 : av = avma; X = pol_x(vx);
1531 56 : av2 = avma;
1532 56 : z = gadd(gsubst(gel(x,lx-1),v,y), zeroser(vx,1));
1533 224 : for (i = lx-2; i>=2; i--)
1534 : {
1535 168 : z = gadd(gmul(z,X), gsubst(gel(x,i),v,y));
1536 168 : if (gc_needed(av2,1))
1537 : {
1538 0 : if(DEBUGMEM>1) pari_warn(warnmem,"gsubst (i = %ld)", i);
1539 0 : z = gerepileupto(av2, z);
1540 : }
1541 : }
1542 56 : if (ex) z = gmul(z, pol_xnall(ex,vx));
1543 56 : return gerepileupto(av, z);
1544 : }
1545 25550 : switch(ty) /* here vx == v */
1546 : {
1547 21063 : case t_SER:
1548 21063 : vy = varn(y); ey = valser(y);
1549 21063 : if (ey < 1 || lx == 2) return zeroser(vy, ey*(ex+lx-2));
1550 21063 : if (ey == 1 && serequalXk(y)
1551 1953 : && (varncmp(vx,vy) >= 0 || varncmp(gvar2(x), vy) >= 0))
1552 : { /* y = t + O(t^N) */
1553 1953 : if (lx > ly)
1554 : { /* correct number of significant terms */
1555 1624 : l = ly;
1556 1624 : if (!ex)
1557 1603 : for (i = 3; i < lx; i++)
1558 1603 : if (++l >= lx || !gequal0(gel(x,i))) break;
1559 1624 : lx = l;
1560 : }
1561 1953 : z = sertrunc_copy(x, lx - 2); if (vx != vy) setvarn(z,vy);
1562 1953 : return z;
1563 : }
1564 19110 : if (vy != vx)
1565 : {
1566 28 : long nx = lx - 2, n = minss(ey * nx, ly - 2);
1567 28 : av = avma; z = gel(x, nx+1);
1568 91 : for (i = nx; i > 1; i--)
1569 : {
1570 63 : z = gadd(gmul(y,z), gel(x,i));
1571 63 : if (gc_needed(av,1))
1572 : {
1573 0 : if(DEBUGMEM>1) pari_warn(warnmem,"gsubst (i = %ld)", i);
1574 0 : z = gerepileupto(av, z);
1575 : }
1576 : }
1577 28 : if (ex)
1578 : {
1579 21 : if (ex < 0) { y = ginv(y); ex = -ex; }
1580 21 : z = gmul(z, gpowgs(sertrunc(y, n), ex));
1581 : }
1582 28 : if (lg(z)-2 > n) z = sertrunc_copy(z, n);
1583 28 : return gerepileupto(av,z);
1584 : }
1585 19082 : l = (lx-2)*ey + 2;
1586 19082 : if (ex) { if (l>ly) l = ly; }
1587 19033 : else if (lx != 3)
1588 : {
1589 19047 : for (i = 3; i < lx; i++)
1590 19047 : if (!isexactzero(gel(x,i))) break;
1591 19033 : l = minss(l, (i-2)*ey + (gequal0(y)? 2 : ly));
1592 : }
1593 19082 : av = avma; t = leafcopy(y);
1594 19082 : if (l < ly) setlg(t, l);
1595 19082 : z = scalarser(gen_1, varn(y), l-2);
1596 19082 : gel(z,2) = gel(x,2); /* ensure lg(z) = l even if x[2] = 0 */
1597 76328 : for (i = 3, jb = ey; jb <= l-2; i++,jb += ey)
1598 : {
1599 57253 : if (i < lx) {
1600 130921 : for (j = jb+2; j < minss(l, jb+ly); j++)
1601 73731 : gel(z,j) = gadd(gel(z,j), gmul(gel(x,i),gel(t,j-jb)));
1602 : }
1603 92372 : for (j = minss(ly-1, l-1-jb-ey); j > 1; j--)
1604 : {
1605 35126 : GEN a = gmul(gel(t,2), gel(y,j));
1606 84679 : for (k=2; k<j; k++) a = gadd(a, gmul(gel(t,j-k+2), gel(y,k)));
1607 35126 : gel(t,j) = a;
1608 : }
1609 57246 : if (gc_needed(av,1))
1610 : {
1611 0 : if(DEBUGMEM>1) pari_warn(warnmem,"gsubst");
1612 0 : gerepileall(av,2, &z,&t);
1613 : }
1614 : }
1615 19075 : if (!ex) return gerepilecopy(av,z);
1616 49 : if (ex < 0) { ex = -ex; y = ginv(y); }
1617 49 : return gerepileupto(av, gmul(z, gpowgs(sertrunc(y, l-2), ex)));
1618 :
1619 4445 : case t_POL: case t_RFRAC:
1620 : {
1621 4445 : long N, n = lx-2;
1622 4445 : vy = gvar(y); ey = gval(y,vy);
1623 4445 : if (ey == LONG_MAX)
1624 : { /* y = 0 */
1625 49 : if (ex < 0) pari_err_INV("gsubst",y);
1626 35 : if (!n) return gcopy(x);
1627 28 : if (ex > 0) return Rg_get_0(ty == t_RFRAC? gel(y,2): y);
1628 14 : y = Rg_get_1(ty == t_RFRAC? gel(y,2): y);
1629 14 : return gmul(y, gel(x,2));
1630 : }
1631 4396 : if (ey < 1 || n == 0) return zeroser(vy, ey*(ex+n));
1632 4389 : av = avma;
1633 4389 : n *= ey;
1634 4389 : N = ex? n: maxss(n-ey,1);
1635 4389 : y = (ty == t_RFRAC)? rfrac_to_ser_i(y, N+2): RgX_to_ser(y, N+2);
1636 4389 : if (lg(y)-2 > n) setlg(y, n+2);
1637 4389 : x = ser2pol_i(x, lx);
1638 4389 : if (varncmp(vy,vx) > 0)
1639 49 : z = gadd(poleval(x, y), zeroser(vy,n));
1640 : else
1641 : {
1642 4340 : z = RgXn_eval(x, ser2rfrac_i(y), n);
1643 4340 : if (varn(z) == vy) z = RgX_to_ser(z, n+2);
1644 0 : else z = scalarser(z, vy, n);
1645 : }
1646 4389 : if (!ex) return gerepilecopy(av, z);
1647 4284 : return gerepileupto(av, gmul(z, gpowgs(y,ex)));
1648 : }
1649 :
1650 42 : default:
1651 42 : if (isexactzero(y))
1652 : {
1653 35 : if (ex < 0) pari_err_INV("gsubst",y);
1654 14 : if (ex > 0) return gcopy(y);
1655 7 : if (lx > 2) return gadd(gel(x,2), y); /*add maps to correct ring*/
1656 : }
1657 7 : pari_err_TYPE2("substitution",x,y);
1658 : }
1659 0 : break;
1660 :
1661 1253 : case t_RFRAC:
1662 : {
1663 1253 : GEN a = gel(x,1), b = gel(x,2);
1664 1253 : av = avma;
1665 1253 : a = gsubst(a, v, y);
1666 1253 : b = gsubst(b, v, y); return gerepileupto(av, gdiv(a, b));
1667 : }
1668 :
1669 659793 : case t_VEC: case t_COL: case t_MAT: pari_APPLY_same(gsubst(gel(x,i),v,y));
1670 56 : case t_LIST:
1671 56 : z = mklist();
1672 56 : list_data(z) = list_data(x)? gsubst(list_data(x),v,y): NULL;
1673 56 : return z;
1674 : }
1675 0 : return gcopy(x);
1676 : }
1677 :
1678 : /* Return P(x * h), not memory clean */
1679 : GEN
1680 4193 : ser_unscale(GEN P, GEN h)
1681 : {
1682 4193 : long l = lg(P);
1683 4193 : GEN Q = cgetg(l,t_SER);
1684 4193 : Q[1] = P[1];
1685 4193 : if (l != 2)
1686 : {
1687 4193 : long i = 2;
1688 4193 : GEN hi = gpowgs(h, valser(P));
1689 4193 : gel(Q,i) = gmul(gel(P,i), hi);
1690 200508 : for (i++; i<l; i++) { hi = gmul(hi,h); gel(Q,i) = gmul(gel(P,i), hi); }
1691 : }
1692 4193 : return Q;
1693 : }
1694 :
1695 : GEN
1696 959 : gsubstvec(GEN e, GEN v, GEN r)
1697 : {
1698 959 : pari_sp av = avma;
1699 959 : long i, j, k, l = lg(v);
1700 : GEN w, z, R;
1701 959 : if ( !is_vec_t(typ(v)) ) pari_err_TYPE("substvec",v);
1702 959 : if ( !is_vec_t(typ(r)) ) pari_err_TYPE("substvec",r);
1703 959 : if (lg(r)!=l) pari_err_DIM("substvec");
1704 959 : w = cgetg(l, t_VECSMALL);
1705 959 : z = cgetg(l, t_VECSMALL);
1706 959 : R = cgetg(l, t_VEC); k = 0;
1707 4235 : for(i = j = 1; i < l; i++)
1708 : {
1709 3276 : GEN T = gel(v,i), ri = gel(r,i);
1710 3276 : if (!gequalX(T)) pari_err_TYPE("substvec [not a variable]", T);
1711 3276 : if (gvar(ri) == NO_VARIABLE) /* no need to take precautions */
1712 : {
1713 1855 : e = gsubst(e, varn(T), ri);
1714 1855 : if (is_vec_t(typ(ri)) && k++) e = shallowconcat1(e);
1715 : }
1716 : else
1717 : {
1718 1421 : w[j] = varn(T);
1719 1421 : z[j] = fetch_var();
1720 1421 : gel(R,j) = ri; j++;
1721 : }
1722 : }
1723 2380 : for(i = 1; i < j; i++) e = gsubst(e,w[i],pol_x(z[i]));
1724 2380 : for(i = 1; i < j; i++)
1725 : {
1726 1421 : e = gsubst(e,z[i],gel(R,i));
1727 1421 : if (is_vec_t(typ(gel(R,i))) && k++) e = shallowconcat1(e);
1728 : }
1729 2380 : for(i = 1; i < j; i++) (void)delete_var();
1730 959 : return k > 1? gerepilecopy(av, e): gerepileupto(av, e);
1731 : }
1732 :
1733 : /*******************************************************************/
1734 : /* */
1735 : /* SERIE RECIPROQUE D'UNE SERIE */
1736 : /* */
1737 : /*******************************************************************/
1738 :
1739 : GEN
1740 98 : serreverse(GEN x)
1741 : {
1742 98 : long v=varn(x), lx = lg(x), i, mi;
1743 98 : pari_sp av0 = avma, av;
1744 : GEN a, y, u;
1745 :
1746 98 : if (typ(x)!=t_SER) pari_err_TYPE("serreverse",x);
1747 98 : if (valser(x)!=1) pari_err_DOMAIN("serreverse", "valuation", "!=", gen_1,x);
1748 91 : if (lx < 3) pari_err_DOMAIN("serreverse", "x", "=", gen_0,x);
1749 91 : y = ser_normalize(x);
1750 91 : if (y == x) a = NULL; else { a = gel(x,2); x = y; }
1751 91 : av = avma;
1752 252 : mi = lx-1; while (mi>=3 && gequal0(gel(x,mi))) mi--;
1753 91 : u = cgetg(lx,t_SER);
1754 91 : y = cgetg(lx,t_SER);
1755 91 : u[1] = y[1] = evalsigne(1) | _evalvalser(1) | evalvarn(v);
1756 91 : gel(u,2) = gel(y,2) = gen_1;
1757 91 : if (lx > 3)
1758 : {
1759 84 : gel(u,3) = gmulsg(-2,gel(x,3));
1760 84 : gel(y,3) = gneg(gel(x,3));
1761 : }
1762 1113 : for (i=3; i<lx-1; )
1763 : {
1764 : pari_sp av2;
1765 : GEN p1;
1766 1022 : long j, k, K = minss(i,mi);
1767 8456 : for (j=3; j<i+1; j++)
1768 : {
1769 7434 : av2 = avma; p1 = gel(x,j);
1770 39291 : for (k = maxss(3,j+2-mi); k < j; k++)
1771 31857 : p1 = gadd(p1, gmul(gel(u,k),gel(x,j-k+2)));
1772 7434 : p1 = gneg(p1);
1773 7434 : gel(u,j) = gerepileupto(av2, gadd(gel(u,j), p1));
1774 : }
1775 1022 : av2 = avma;
1776 1022 : p1 = gmulsg(i,gel(x,i+1));
1777 8309 : for (k = 2; k < K; k++)
1778 : {
1779 7287 : GEN p2 = gmul(gel(x,k+1),gel(u,i-k+2));
1780 7287 : p1 = gadd(p1, gmulsg(k,p2));
1781 : }
1782 1022 : i++;
1783 1022 : gel(u,i) = gerepileupto(av2, gneg(p1));
1784 1022 : gel(y,i) = gdivgu(gel(u,i), i-1);
1785 1022 : if (gc_needed(av,2))
1786 : {
1787 0 : GEN dummy = cgetg(1,t_VEC);
1788 0 : if(DEBUGMEM>1) pari_warn(warnmem,"serreverse");
1789 0 : for(k=i+1; k<lx; k++) gel(u,k) = gel(y,k) = dummy;
1790 0 : gerepileall(av,2, &u,&y);
1791 : }
1792 : }
1793 91 : if (a) y = ser_unscale(y, ginv(a));
1794 91 : return gerepilecopy(av0,y);
1795 : }
1796 :
1797 : /*******************************************************************/
1798 : /* */
1799 : /* DERIVATION ET INTEGRATION */
1800 : /* */
1801 : /*******************************************************************/
1802 : GEN
1803 24444 : derivser(GEN x)
1804 : {
1805 24444 : long i, vx = varn(x), e = valser(x), lx = lg(x);
1806 : GEN y;
1807 24444 : if (ser_isexactzero(x))
1808 : {
1809 7 : x = gcopy(x);
1810 7 : if (e) setvalser(x,e-1);
1811 7 : return x;
1812 : }
1813 24437 : if (e)
1814 : {
1815 602 : y = cgetg(lx,t_SER); y[1] = evalsigne(1)|evalvalser(e-1) | evalvarn(vx);
1816 22960 : for (i=2; i<lx; i++) gel(y,i) = gmulsg(i+e-2,gel(x,i));
1817 : } else {
1818 23835 : if (lx == 3) return zeroser(vx, 0);
1819 20741 : lx--;
1820 20741 : y = cgetg(lx,t_SER); y[1] = evalsigne(1)|_evalvalser(0) | evalvarn(vx);
1821 66780 : for (i=2; i<lx; i++) gel(y,i) = gmulsg(i-1,gel(x,i+1));
1822 : }
1823 21343 : return normalizeser(y);
1824 : }
1825 :
1826 : static GEN
1827 56 : rfrac_deriv(GEN x, long v)
1828 : {
1829 56 : pari_sp av = avma;
1830 56 : GEN y = cgetg(3,t_RFRAC), a = gel(x,1), b = gel(x,2), bp, b0, t, T;
1831 56 : long vx = varn(b);
1832 :
1833 56 : bp = deriv(b, v);
1834 56 : t = simplify_shallow(RgX_gcd(bp, b));
1835 56 : if (typ(t) != t_POL || varn(t) != vx)
1836 : {
1837 35 : if (gequal1(t)) b0 = b;
1838 : else
1839 : {
1840 0 : b0 = RgX_Rg_div(b, t);
1841 0 : bp = RgX_Rg_div(bp, t);
1842 : }
1843 35 : a = gsub(gmul(b0, deriv(a,v)), gmul(a, bp));
1844 35 : if (isexactzero(a)) return gerepileupto(av, a);
1845 35 : if (b0 == b)
1846 : {
1847 35 : gel(y,1) = gerepileupto((pari_sp)y, a);
1848 35 : gel(y,2) = RgX_sqr(b);
1849 : }
1850 : else
1851 : {
1852 0 : gel(y,1) = a;
1853 0 : gel(y,2) = RgX_Rg_mul(RgX_sqr(b0), t);
1854 0 : y = gerepilecopy(av, y);
1855 : }
1856 35 : return y;
1857 : }
1858 21 : b0 = gdivexact(b, t);
1859 21 : bp = gdivexact(bp,t);
1860 21 : a = gsub(gmul(b0, deriv(a,v)), gmul(a, bp));
1861 21 : if (isexactzero(a)) return gerepileupto(av, a);
1862 14 : T = RgX_gcd(a, t);
1863 14 : if (typ(T) != t_POL || varn(T) != vx)
1864 : {
1865 0 : a = gdiv(a, T);
1866 0 : t = gdiv(t, T);
1867 : }
1868 14 : else if (!gequal1(T))
1869 : {
1870 0 : a = gdivexact(a, T);
1871 0 : t = gdivexact(t, T);
1872 : }
1873 14 : gel(y,1) = a;
1874 14 : gel(y,2) = gmul(RgX_sqr(b0), t);
1875 14 : return gerepilecopy(av, y);
1876 : }
1877 :
1878 : GEN
1879 114128 : deriv(GEN x, long v)
1880 : {
1881 114128 : long tx = typ(x);
1882 114128 : if (is_const_t(tx))
1883 39795 : switch(tx)
1884 : {
1885 14 : case t_INTMOD: retmkintmod(gen_0, icopy(gel(x,1)));
1886 14 : case t_FFELT: return FF_zero(x);
1887 39767 : default: return gen_0;
1888 : }
1889 74333 : if (v < 0)
1890 : {
1891 49 : if (tx == t_CLOSURE) return closure_deriv(x);
1892 49 : v = gvar9(x);
1893 : }
1894 74333 : switch(tx)
1895 : {
1896 14 : case t_POLMOD:
1897 : {
1898 14 : GEN a = gel(x,2), b = gel(x,1);
1899 14 : if (v == varn(b)) return Rg_get_0(b);
1900 7 : retmkpolmod(deriv(a,v), RgX_copy(b));
1901 : }
1902 74074 : case t_POL:
1903 74074 : switch(varncmp(varn(x), v))
1904 : {
1905 0 : case 1: return Rg_get_0(x);
1906 66479 : case 0: return RgX_deriv(x);
1907 : }
1908 113505 : pari_APPLY_pol(deriv(gel(x,i),v));
1909 :
1910 147 : case t_SER:
1911 147 : switch(varncmp(varn(x), v))
1912 : {
1913 0 : case 1: return Rg_get_0(x);
1914 133 : case 0: return derivser(x);
1915 : }
1916 14 : if (ser_isexactzero(x)) return gcopy(x);
1917 28 : pari_APPLY_ser(deriv(gel(x,i),v));
1918 :
1919 56 : case t_RFRAC:
1920 56 : return rfrac_deriv(x,v);
1921 :
1922 42 : case t_VEC: case t_COL: case t_MAT:
1923 84 : pari_APPLY_same(deriv(gel(x,i),v));
1924 : }
1925 0 : pari_err_TYPE("deriv",x);
1926 : return NULL; /* LCOV_EXCL_LINE */
1927 : }
1928 :
1929 : /* n-th derivative of t_SER x, n > 0 */
1930 : static GEN
1931 189 : derivnser(GEN x, long n)
1932 : {
1933 189 : long i, vx = varn(x), e = valser(x), lx = lg(x);
1934 : GEN y;
1935 189 : if (ser_isexactzero(x))
1936 : {
1937 7 : x = gcopy(x);
1938 7 : if (e) setvalser(x,e-n);
1939 7 : return x;
1940 : }
1941 182 : if (e < 0 || e >= n)
1942 : {
1943 154 : y = cgetg(lx,t_SER);
1944 154 : y[1] = evalsigne(1)| evalvalser(e-n) | evalvarn(vx);
1945 742 : for (i=0; i<lx-2; i++)
1946 588 : gel(y,i+2) = gmul(muls_interval(i+e-n+1,i+e), gel(x,i+2));
1947 : } else {
1948 28 : if (lx <= n+2) return zeroser(vx, 0);
1949 28 : lx -= n;
1950 28 : y = cgetg(lx,t_SER);
1951 28 : y[1] = evalsigne(1)|_evalvalser(0) | evalvarn(vx);
1952 105 : for (i=0; i<lx-2; i++)
1953 77 : gel(y,i+2) = gmul(mulu_interval(i+1,i+n),gel(x,i+2+n-e));
1954 : }
1955 182 : return normalizeser(y);
1956 : }
1957 :
1958 : /* n-th derivative of t_POL x, n > 0 */
1959 : static GEN
1960 833 : RgX_derivn(GEN x, long n)
1961 : {
1962 833 : long i, vx = varn(x), lx = lg(x);
1963 : GEN y;
1964 833 : if (lx <= n+2) return pol_0(vx);
1965 749 : lx -= n;
1966 749 : y = cgetg(lx,t_POL);
1967 749 : y[1] = evalsigne(1)| evalvarn(vx);
1968 50904 : for (i=0; i<lx-2; i++)
1969 50155 : gel(y,i+2) = gmul(mulu_interval(i+1,i+n),gel(x,i+2+n));
1970 749 : return normalizepol_lg(y, lx);
1971 : }
1972 :
1973 : static GEN
1974 42 : rfrac_derivn(GEN x, long n, long vs)
1975 : {
1976 42 : pari_sp av = avma;
1977 42 : GEN u = gel(x,1), v = gel(x,2);
1978 42 : GEN dv = deriv(v, vs);
1979 : long i;
1980 112 : for (i=1; i<=n; i++)
1981 : {
1982 70 : GEN du = deriv(u, vs);
1983 70 : u = gadd(gmul(du, v), gmulsg (-i, gmul(dv, u)));
1984 : }
1985 42 : v = gpowgs(v, n+1);
1986 42 : return gerepileupto(av, gdiv(u, v));
1987 : }
1988 :
1989 : GEN
1990 1351 : derivn(GEN x, long n, long v)
1991 : {
1992 : long tx;
1993 1351 : if (n < 0) pari_err_DOMAIN("derivn","n","<", gen_0, stoi(n));
1994 1344 : if (n == 0) return gcopy(x);
1995 1344 : tx = typ(x);
1996 1344 : if (is_const_t(tx))
1997 49 : switch(tx)
1998 : {
1999 21 : case t_INTMOD: retmkintmod(gen_0, icopy(gel(x,1)));
2000 21 : case t_FFELT: return FF_zero(x);
2001 7 : default: return gen_0;
2002 : }
2003 1295 : if (v < 0)
2004 : {
2005 1057 : if (tx == t_CLOSURE) return closure_derivn(x, n);
2006 952 : v = gvar9(x);
2007 : }
2008 1190 : switch(tx)
2009 : {
2010 21 : case t_POLMOD:
2011 : {
2012 21 : GEN a = gel(x,2), b = gel(x,1);
2013 21 : if (v == varn(b)) return Rg_get_0(b);
2014 14 : retmkpolmod(derivn(a,n,v), RgX_copy(b));
2015 : }
2016 861 : case t_POL:
2017 861 : switch(varncmp(varn(x), v))
2018 : {
2019 0 : case 1: return Rg_get_0(x);
2020 833 : case 0: return RgX_derivn(x,n);
2021 : }
2022 84 : pari_APPLY_pol(derivn(gel(x,i),n,v));
2023 :
2024 196 : case t_SER:
2025 196 : switch(varncmp(varn(x), v))
2026 : {
2027 0 : case 1: return Rg_get_0(x);
2028 189 : case 0: return derivnser(x, n);
2029 : }
2030 7 : if (ser_isexactzero(x)) return gcopy(x);
2031 28 : pari_APPLY_ser(derivn(gel(x,i),n,v));
2032 :
2033 42 : case t_RFRAC:
2034 42 : return rfrac_derivn(x, n, v);
2035 :
2036 63 : case t_VEC: case t_COL: case t_MAT:
2037 126 : pari_APPLY_same(derivn(gel(x,i),n,v));
2038 : }
2039 7 : pari_err_TYPE("derivn",x);
2040 : return NULL; /* LCOV_EXCL_LINE */
2041 : }
2042 :
2043 : static long
2044 833 : lookup(GEN v, long vx)
2045 : {
2046 833 : long i ,l = lg(v);
2047 1491 : for(i=1; i<l; i++)
2048 1253 : if (varn(gel(v,i)) == vx) return i;
2049 238 : return 0;
2050 : }
2051 :
2052 : GEN
2053 3535 : diffop(GEN x, GEN v, GEN dv)
2054 : {
2055 : pari_sp av;
2056 3535 : long i, idx, lx, tx = typ(x), vx;
2057 : GEN y;
2058 3535 : if (!is_vec_t(typ(v))) pari_err_TYPE("diffop",v);
2059 3535 : if (!is_vec_t(typ(dv))) pari_err_TYPE("diffop",dv);
2060 3535 : if (lg(v)!=lg(dv)) pari_err_DIM("diffop");
2061 3535 : if (is_const_t(tx)) return gen_0;
2062 1148 : switch(tx)
2063 : {
2064 84 : case t_POLMOD:
2065 84 : av = avma;
2066 84 : vx = varn(gel(x,1)); idx = lookup(v,vx);
2067 84 : if (idx) /*Assume the users now what they are doing */
2068 0 : y = gmodulo(diffop(gel(x,2),v,dv), gel(x,1));
2069 : else
2070 : {
2071 84 : GEN m = gel(x,1), pol=gel(x,2);
2072 84 : GEN u = gneg(gdiv(diffop(m,v,dv),RgX_deriv(m)));
2073 84 : y = diffop(pol,v,dv);
2074 84 : if (typ(pol)==t_POL && varn(pol)==varn(m))
2075 70 : y = gadd(y, gmul(u,RgX_deriv(pol)));
2076 84 : y = gmodulo(y, gel(x,1));
2077 : }
2078 84 : return gerepileupto(av, y);
2079 952 : case t_POL:
2080 952 : if (signe(x)==0) return gen_0;
2081 742 : vx = varn(x); idx = lookup(v,vx);
2082 742 : av = avma; lx = lg(x);
2083 742 : y = diffop(gel(x,lx-1),v,dv);
2084 2842 : for (i=lx-2; i>=2; i--) y = gadd(gmul(y,pol_x(vx)),diffop(gel(x,i),v,dv));
2085 742 : if (idx) y = gadd(y, gmul(gel(dv,idx),RgX_deriv(x)));
2086 742 : return gerepileupto(av, y);
2087 :
2088 7 : case t_SER:
2089 7 : if (signe(x)==0) return gen_0;
2090 7 : vx = varn(x); idx = lookup(v,vx);
2091 7 : if (!idx) return gen_0;
2092 7 : av = avma;
2093 7 : if (ser_isexactzero(x)) y = x;
2094 : else
2095 : {
2096 7 : y = cgetg_copy(x, &lx); y[1] = x[1];
2097 119 : for (i=2; i<lx; i++) gel(y,i) = diffop(gel(x,i),v,dv);
2098 7 : y = normalizeser(y); /* y is probably invalid */
2099 7 : y = gsubst(y, vx, pol_x(vx)); /* Fix that */
2100 : }
2101 7 : y = gadd(y, gmul(gel(dv,idx),derivser(x)));
2102 7 : return gerepileupto(av, y);
2103 :
2104 105 : case t_RFRAC: {
2105 105 : GEN a = gel(x,1), b = gel(x,2), ap, bp;
2106 105 : av = avma;
2107 105 : ap = diffop(a, v, dv); bp = diffop(b, v, dv);
2108 105 : y = gsub(gdiv(ap,b),gdiv(gmul(a,bp),gsqr(b)));
2109 105 : return gerepileupto(av, y);
2110 : }
2111 :
2112 0 : case t_VEC: case t_COL: case t_MAT:
2113 0 : pari_APPLY_same(diffop(gel(x,i),v,dv));
2114 : }
2115 0 : pari_err_TYPE("diffop",x);
2116 : return NULL; /* LCOV_EXCL_LINE */
2117 : }
2118 :
2119 : GEN
2120 42 : diffop0(GEN x, GEN v, GEN dv, long n)
2121 : {
2122 42 : pari_sp av=avma;
2123 : long i;
2124 245 : for(i=1; i<=n; i++)
2125 203 : x = gerepileupto(av, diffop(x,v,dv));
2126 42 : return x;
2127 : }
2128 :
2129 : /********************************************************************/
2130 : /** **/
2131 : /** TAYLOR SERIES **/
2132 : /** **/
2133 : /********************************************************************/
2134 : /* swap vars (vx,v) in x (assume vx < v, vx main variable in x), then call
2135 : * act(data, v, x). FIXME: use in other places */
2136 : static GEN
2137 28 : swapvar_act(GEN x, long vx, long v, GEN (*act)(void*, long, GEN), void *data)
2138 : {
2139 28 : long v0 = fetch_var();
2140 28 : GEN y = act(data, v, gsubst(x,vx,pol_x(v0)));
2141 21 : y = gsubst(y,v0,pol_x(vx));
2142 21 : (void)delete_var(); return y;
2143 : }
2144 : /* x + O(v^data) */
2145 : static GEN
2146 14 : tayl_act(void *data, long v, GEN x) { return gadd(zeroser(v, (long)data), x); }
2147 : static GEN
2148 14 : integ_act(void *data, long v, GEN x) { (void)data; return integ(x,v); }
2149 :
2150 : GEN
2151 21 : tayl(GEN x, long v, long precS)
2152 : {
2153 21 : long vx = gvar9(x);
2154 : pari_sp av;
2155 :
2156 21 : if (varncmp(v, vx) <= 0) return gadd(zeroser(v,precS), x);
2157 14 : av = avma;
2158 14 : return gerepileupto(av, swapvar_act(x, vx, v, tayl_act, (void*)precS));
2159 : }
2160 :
2161 : GEN
2162 6636 : ggrando(GEN x, long n)
2163 : {
2164 : long m, v;
2165 :
2166 6636 : switch(typ(x))
2167 : {
2168 3780 : case t_INT:/* bug 3 + O(1) */
2169 3780 : if (signe(x) <= 0) pari_err_DOMAIN("O", "x", "<=", gen_0, x);
2170 3780 : if (!is_pm1(x)) return zeropadic(x,n);
2171 : /* +/-1 = x^0 */
2172 91 : v = m = 0; break;
2173 2849 : case t_POL:
2174 2849 : if (!signe(x)) pari_err_DOMAIN("O", "x", "=", gen_0, x);
2175 2849 : v = varn(x);
2176 2849 : m = n * RgX_val(x); break;
2177 7 : case t_RFRAC:
2178 7 : if (gequal0(gel(x,1))) pari_err_DOMAIN("O", "x", "=", gen_0, x);
2179 7 : v = gvar(x);
2180 7 : m = n * gval(x,v); break;
2181 0 : default: pari_err_TYPE("O", x);
2182 : v = m = 0; /* LCOV_EXCL_LINE */
2183 : }
2184 2947 : return zeroser(v,m);
2185 : }
2186 :
2187 : /*******************************************************************/
2188 : /* */
2189 : /* FORMAL INTEGRATION */
2190 : /* */
2191 : /*******************************************************************/
2192 : GEN
2193 105 : RgX_integ(GEN x)
2194 : {
2195 105 : long i, lx = lg(x);
2196 : GEN y;
2197 105 : if (lx == 2) return RgX_copy(x);
2198 91 : y = cgetg(lx+1, t_POL); y[1] = x[1]; gel(y,2) = gen_0;
2199 273 : for (i=3; i<=lx; i++) gel(y,i) = gdivgu(gel(x,i-1),i-2);
2200 91 : return y;
2201 : }
2202 :
2203 : static void
2204 35 : err_intformal(GEN x)
2205 35 : { pari_err_DOMAIN("intformal", "residue(series, pole)", "!=", gen_0, x); }
2206 :
2207 : GEN
2208 25074 : integser(GEN x)
2209 : {
2210 25074 : long i, lx = lg(x), vx = varn(x), e = valser(x);
2211 : GEN y;
2212 25074 : if (lx == 2) return zeroser(vx, e+1);
2213 21959 : y = cgetg(lx, t_SER);
2214 95830 : for (i=2; i<lx; i++)
2215 : {
2216 73878 : long j = i+e-1;
2217 73878 : GEN c = gel(x,i);
2218 73878 : if (j)
2219 73563 : c = gdivgs(c, j);
2220 : else
2221 : { /* should be isexactzero, but try to avoid error */
2222 315 : if (!gequal0(c)) err_intformal(x);
2223 308 : c = gen_0;
2224 : }
2225 73871 : gel(y,i) = c;
2226 : }
2227 21952 : y[1] = evalsigne(1) | evalvarn(vx) | evalvalser(e+1); return y;
2228 : }
2229 :
2230 : GEN
2231 350 : integ(GEN x, long v)
2232 : {
2233 350 : long tx = typ(x), vx, n;
2234 350 : pari_sp av = avma;
2235 : GEN y, p1;
2236 :
2237 350 : if (v < 0) { v = gvar9(x); if (v == NO_VARIABLE) v = 0; }
2238 350 : if (is_scalar_t(tx))
2239 : {
2240 63 : if (tx == t_POLMOD)
2241 : {
2242 14 : GEN a = gel(x,2), b = gel(x,1);
2243 14 : vx = varn(b);
2244 14 : if (varncmp(v, vx) > 0) retmkpolmod(integ(a,v), RgX_copy(b));
2245 7 : if (v == vx) pari_err_PRIORITY("intformal",x,"=",v);
2246 : }
2247 49 : return deg1pol(x, gen_0, v);
2248 : }
2249 :
2250 287 : switch(tx)
2251 : {
2252 112 : case t_POL:
2253 112 : vx = varn(x);
2254 112 : if (v == vx) return RgX_integ(x);
2255 42 : if (lg(x) == 2) {
2256 14 : if (varncmp(vx, v) < 0) v = vx;
2257 14 : return zeropol(v);
2258 : }
2259 28 : if (varncmp(vx, v) > 0) return deg1pol(x, gen_0, v);
2260 84 : pari_APPLY_pol(integ(gel(x,i),v));
2261 :
2262 77 : case t_SER:
2263 77 : vx = varn(x);
2264 77 : if (v == vx) return integser(x);
2265 21 : if (lg(x) == 2) {
2266 14 : if (varncmp(vx, v) < 0) v = vx;
2267 14 : return zeroser(v, valser(x));
2268 : }
2269 7 : if (varncmp(vx, v) > 0) return deg1pol(x, gen_0, v);
2270 28 : pari_APPLY_ser(integ(gel(x,i),v));
2271 :
2272 56 : case t_RFRAC:
2273 : {
2274 56 : GEN a = gel(x,1), b = gel(x,2), c, d, s;
2275 56 : vx = varn(b);
2276 56 : if (varncmp(vx, v) > 0) return deg1pol(x, gen_0, v);
2277 49 : if (varncmp(vx, v) < 0)
2278 14 : return gerepileupto(av, swapvar_act(x, vx, v, integ_act, NULL));
2279 :
2280 35 : n = degpol(b);
2281 35 : if (typ(a) == t_POL && varn(a) == vx) n += degpol(a);
2282 35 : y = integ(gadd(x, zeroser(v,n + 2)), v);
2283 35 : y = gdiv(gtrunc(gmul(b, y)), b);
2284 35 : if (typ(y) != t_RFRAC) pari_err_BUG("intformal(t_RFRAC)");
2285 35 : c = gel(y,1); d = gel(y,2);
2286 35 : s = gsub(gmul(deriv(c,v),d), gmul(c,deriv(d,v)));
2287 : /* (c'd-cd')/d^2 = y' = x = a/b ? */
2288 35 : if (!gequal(gmul(s,b), gmul(a,gsqr(d)))) err_intformal(x);
2289 7 : if (typ(y)==t_RFRAC && lg(gel(y,1)) == lg(gel(y,2)))
2290 : {
2291 7 : GEN p2 = leading_coeff(gel(y,2));
2292 7 : p1 = gel(y,1);
2293 7 : if (typ(p1) == t_POL && varn(p1) == vx) p1 = leading_coeff(p1);
2294 7 : y = gsub(y, gdiv(p1,p2));
2295 : }
2296 7 : return gerepileupto(av,y);
2297 : }
2298 :
2299 42 : case t_VEC: case t_COL: case t_MAT:
2300 84 : pari_APPLY_same(integ(gel(x,i),v));
2301 : }
2302 0 : pari_err_TYPE("integ",x);
2303 : return NULL; /* LCOV_EXCL_LINE */
2304 : }
2305 :
2306 : /*******************************************************************/
2307 : /* */
2308 : /* FLOOR */
2309 : /* */
2310 : /*******************************************************************/
2311 : static GEN
2312 518 : quad_floor(GEN x)
2313 : {
2314 518 : GEN Q = gel(x,1), D = quad_disc(x), u, v, b, d, z;
2315 518 : if (signe(D) < 0) return NULL;
2316 490 : x = Q_remove_denom(x, &d);
2317 490 : u = gel(x,2);
2318 490 : v = gel(x,3); b = gel(Q,3);
2319 490 : if (typ(u) != t_INT || typ(v) != t_INT) return NULL;
2320 : /* x0 = (2u + v*(-b + sqrt(D))) / (2d) */
2321 483 : z = sqrti(mulii(D, sqri(v)));
2322 483 : if (signe(v) < 0) { z = addiu(z,1); togglesign(z); }
2323 : /* z = floor(v * sqrt(D)) */
2324 483 : z = addii(subii(shifti(u,1), mulii(v,b)), z);
2325 483 : return truedivii(z, d? shifti(d,1): gen_2);
2326 : }
2327 : GEN
2328 5289374 : gfloor(GEN x)
2329 : {
2330 5289374 : switch(typ(x))
2331 : {
2332 5266108 : case t_INT: return icopy(x);
2333 35 : case t_POL: return RgX_copy(x);
2334 10659 : case t_REAL: return floorr(x);
2335 11746 : case t_FRAC: return truedivii(gel(x,1),gel(x,2));
2336 511 : case t_QUAD:
2337 : {
2338 511 : pari_sp av = avma;
2339 : GEN y;
2340 511 : if (!(y = quad_floor(x))) break;
2341 476 : return gerepileuptoint(av, y);
2342 : }
2343 14 : case t_RFRAC: return gdeuc(gel(x,1),gel(x,2));
2344 98 : case t_VEC: case t_COL: case t_MAT:
2345 1533 : pari_APPLY_same(gfloor(gel(x,i)));
2346 : }
2347 238 : pari_err_TYPE("gfloor",x);
2348 : return NULL; /* LCOV_EXCL_LINE */
2349 : }
2350 :
2351 : GEN
2352 233536 : gfrac(GEN x)
2353 : {
2354 : pari_sp av;
2355 : GEN y;
2356 233536 : switch(typ(x))
2357 : {
2358 21564 : case t_INT: return gen_0;
2359 7 : case t_POL: return pol_0(varn(x));
2360 177665 : case t_REAL: av = avma; return gerepileuptoleaf(av, subri(x, floorr(x)));
2361 30570 : case t_FRAC: retmkfrac(modii(gel(x,1),gel(x,2)), icopy(gel(x,2)));
2362 7 : case t_QUAD:
2363 7 : av = avma; if (!(y = quad_floor(x))) break;
2364 7 : return gerepileupto(av, gsub(x, y));
2365 7 : case t_RFRAC: retmkrfrac(grem(gel(x,1),gel(x,2)), gcopy(gel(x,2)));
2366 3688 : case t_VEC: case t_COL: case t_MAT:
2367 34423 : pari_APPLY_same(gfrac(gel(x,i)));
2368 : }
2369 28 : pari_err_TYPE("gfrac",x);
2370 : return NULL; /* LCOV_EXCL_LINE */
2371 : }
2372 :
2373 : /* assume x t_REAL */
2374 : GEN
2375 2066 : ceilr(GEN x)
2376 : {
2377 2066 : pari_sp av = avma;
2378 2066 : GEN y = floorr(x);
2379 2066 : if (cmpri(x, y)) return gerepileuptoint(av, addui(1,y));
2380 29 : return y;
2381 : }
2382 :
2383 : GEN
2384 30116 : gceil(GEN x)
2385 : {
2386 : pari_sp av;
2387 : GEN y;
2388 30116 : switch(typ(x))
2389 : {
2390 17615 : case t_INT: return icopy(x);
2391 21 : case t_POL: return RgX_copy(x);
2392 1988 : case t_REAL: return ceilr(x);
2393 10366 : case t_FRAC:
2394 10366 : av = avma; y = divii(gel(x,1),gel(x,2));
2395 10366 : if (signe(gel(x,1)) > 0) y = gerepileuptoint(av, addui(1,y));
2396 10366 : return y;
2397 49 : case t_QUAD:
2398 49 : if (!is_realquad(x)) break;
2399 42 : if (gequal0(gel(x,3))) return gceil(gel(x,2));
2400 35 : av = avma; return gerepileupto(av, addiu(gfloor(x), 1));
2401 7 : case t_RFRAC:
2402 7 : return gdeuc(gel(x,1),gel(x,2));
2403 35 : case t_VEC: case t_COL: case t_MAT:
2404 105 : pari_APPLY_same(gceil(gel(x,i)));
2405 : }
2406 42 : pari_err_TYPE("gceil",x);
2407 : return NULL; /* LCOV_EXCL_LINE */
2408 : }
2409 :
2410 : GEN
2411 5880 : round0(GEN x, GEN *pte)
2412 : {
2413 5880 : if (pte) { long e; x = grndtoi(x,&e); *pte = stoi(e); }
2414 5873 : return ground(x);
2415 : }
2416 :
2417 : /* x t_REAL, return q=floor(x+1/2), set e = expo(x-q) */
2418 : static GEN
2419 37578148 : round_i(GEN x, long *pe)
2420 : {
2421 : long e;
2422 37578148 : GEN B, q,r, m = mantissa_real(x, &e); /* x = m/2^e */
2423 37570351 : if (e <= 0)
2424 : {
2425 3607358 : if (e) m = shifti(m,-e);
2426 3607337 : if (pe) *pe = -e;
2427 3607337 : return m;
2428 : }
2429 33962993 : B = int2n(e-1);
2430 33960971 : m = addii(m, B);
2431 33962013 : q = shifti(m, -e);
2432 33961251 : r = remi2n(m, e);
2433 : /* 2^e (x+1/2) = m = 2^e q + r, sgn(r)=sgn(m), |r|<2^e */
2434 33965288 : if (!signe(r))
2435 8158 : { if (pe) *pe = -1; }
2436 : else
2437 : {
2438 33957130 : if (signe(m) < 0)
2439 : {
2440 12882382 : q = subiu(q,1);
2441 12882223 : r = addii(r, B);
2442 : }
2443 : else
2444 21074748 : r = subii(r, B);
2445 : /* |x - q| = |r| / 2^e */
2446 33960097 : if (pe) *pe = signe(r)? expi(r) - e: -e;
2447 33960772 : cgiv(r);
2448 : }
2449 33969916 : return q;
2450 : }
2451 : /* assume x a t_REAL */
2452 : GEN
2453 3135430 : roundr(GEN x)
2454 : {
2455 3135430 : long ex, s = signe(x);
2456 : pari_sp av;
2457 3135430 : if (!s || (ex=expo(x)) < -1) return gen_0;
2458 2436058 : if (ex == -1) return s>0? gen_1:
2459 223233 : absrnz_equal2n(x)? gen_0: gen_m1;
2460 1772295 : av = avma; x = round_i(x, &ex);
2461 1772339 : if (ex >= 0) pari_err_PREC( "roundr (precision loss in truncation)");
2462 1772339 : return gerepileuptoint(av, x);
2463 : }
2464 : GEN
2465 312930 : roundr_safe(GEN x)
2466 : {
2467 312930 : long ex, s = signe(x);
2468 : pari_sp av;
2469 :
2470 312930 : if (!s || (ex = expo(x)) < -1) return gen_0;
2471 312886 : if (ex == -1) return s>0? gen_1:
2472 0 : absrnz_equal2n(x)? gen_0: gen_m1;
2473 312859 : av = avma; x = round_i(x, NULL);
2474 312859 : return gerepileuptoint(av, x);
2475 : }
2476 :
2477 : GEN
2478 2660898 : ground(GEN x)
2479 : {
2480 : pari_sp av;
2481 : GEN y;
2482 :
2483 2660898 : switch(typ(x))
2484 : {
2485 554990 : case t_INT: return icopy(x);
2486 14 : case t_INTMOD: return gcopy(x);
2487 1548943 : case t_REAL: return roundr(x);
2488 59241 : case t_FRAC: return diviiround(gel(x,1), gel(x,2));
2489 49 : case t_QUAD:
2490 : {
2491 49 : GEN Q = gel(x,1), u, v, b, d, z;
2492 49 : av = avma;
2493 49 : if (is_realquad(x)) return gerepileupto(av, gfloor(gadd(x, ghalf)));
2494 7 : u = gel(x,2);
2495 7 : v = gel(x,3); b = gel(Q,3);
2496 7 : u = ground(gsub(u, gmul2n(gmul(v,b),-1)));
2497 7 : v = Q_remove_denom(v, &d);
2498 7 : if (!d) d = gen_1;
2499 : /* Im x = v sqrt(|D|) / (2d),
2500 : * Im(round(x)) = floor((d + v sqrt(|D|)) / (2d))
2501 : * = floor(floor(d + v sqrt(|D|)) / (2d)) */
2502 7 : z = sqrti(mulii(sqri(v), quad_disc(x)));
2503 7 : if (signe(v) < 0) { z = addiu(z,1); togglesign(z); }
2504 : /* z = floor(v * sqrt(|D|)) */
2505 7 : v = truedivii(addii(z, d), shifti(d,1));
2506 7 : return gerepilecopy(av, signe(v)? mkcomplex(u,v): u);
2507 : }
2508 14 : case t_POLMOD:
2509 14 : retmkpolmod(ground(gel(x,2)), RgX_copy(gel(x,1)));
2510 :
2511 4155 : case t_COMPLEX:
2512 4155 : av = avma; y = cgetg(3, t_COMPLEX);
2513 4155 : gel(y,2) = ground(gel(x,2));
2514 4155 : if (!signe(gel(y,2))) { set_avma(av); return ground(gel(x,1)); }
2515 168 : gel(y,1) = ground(gel(x,1)); return y;
2516 :
2517 91 : case t_POL:
2518 4011 : pari_APPLY_pol(ground(gel(x,i)));
2519 182 : case t_SER:
2520 182 : if (ser_isexactzero(x)) return gcopy(x);
2521 42 : pari_APPLY_ser(ground(gel(x,i)));
2522 21 : case t_RFRAC:
2523 21 : av = avma;
2524 21 : return gerepileupto(av, gdiv(ground(gel(x,1)), ground(gel(x,2))));
2525 493210 : case t_VEC: case t_COL: case t_MAT:
2526 2393782 : pari_APPLY_same(ground(gel(x,i)));
2527 : }
2528 6 : pari_err_TYPE("ground",x);
2529 : return NULL; /* LCOV_EXCL_LINE */
2530 : }
2531 :
2532 : /* e = number of error bits on integral part */
2533 : GEN
2534 48101676 : grndtoi(GEN x, long *e)
2535 : {
2536 : GEN y;
2537 : long i, lx, e1;
2538 : pari_sp av;
2539 :
2540 48101676 : if (e) *e = -(long)HIGHEXPOBIT;
2541 48101676 : switch(typ(x))
2542 : {
2543 3379252 : case t_INT: return icopy(x);
2544 37157039 : case t_REAL: {
2545 37157039 : long ex = expo(x);
2546 37157039 : if (!signe(x) || ex < -1)
2547 : {
2548 1663890 : if (e) *e = ex;
2549 1663890 : return gen_0;
2550 : }
2551 35493149 : av = avma; x = round_i(x, e);
2552 35491559 : return gerepileuptoint(av, x);
2553 : }
2554 29354 : case t_FRAC:
2555 29354 : y = diviiround(gel(x,1), gel(x,2)); if (!e) return y;
2556 28290 : av = avma; *e = gexpo(gsub(x, y)); set_avma(av);
2557 28290 : return y;
2558 7 : case t_INTMOD: return gcopy(x);
2559 7 : case t_QUAD:
2560 7 : y = ground(x); av = avma; if (!e) return y;
2561 7 : *e = gexpo(gsub(x,y)); set_avma(avma); return y;
2562 1632867 : case t_COMPLEX:
2563 1632867 : av = avma; y = cgetg(3, t_COMPLEX);
2564 1632867 : gel(y,2) = grndtoi(gel(x,2), e);
2565 1632867 : if (!signe(gel(y,2))) {
2566 244106 : set_avma(av);
2567 244106 : y = grndtoi(gel(x,1), e? &e1: NULL);
2568 : }
2569 : else
2570 1388761 : gel(y,1) = grndtoi(gel(x,1), e? &e1: NULL);
2571 1632867 : if (e && e1 > *e) *e = e1;
2572 1632867 : return y;
2573 :
2574 7 : case t_POLMOD:
2575 7 : retmkpolmod(grndtoi(gel(x,2), e), RgX_copy(gel(x,1)));
2576 :
2577 308027 : case t_POL:
2578 308027 : y = cgetg_copy(x, &lx); y[1] = x[1];
2579 3228490 : for (i=2; i<lx; i++)
2580 : {
2581 2920468 : gel(y,i) = grndtoi(gel(x,i), &e1);
2582 2920463 : if (e && e1 > *e) *e = e1;
2583 : }
2584 308022 : return normalizepol_lg(y, lx);
2585 168 : case t_SER:
2586 168 : if (ser_isexactzero(x)) return gcopy(x);
2587 154 : y = cgetg_copy(x, &lx); y[1] = x[1];
2588 462 : for (i=2; i<lx; i++)
2589 : {
2590 308 : gel(y,i) = grndtoi(gel(x,i), &e1);
2591 308 : if (e && e1 > *e) *e = e1;
2592 : }
2593 154 : return normalizeser(y);
2594 7 : case t_RFRAC:
2595 7 : y = cgetg(3,t_RFRAC);
2596 7 : gel(y,1) = grndtoi(gel(x,1), e? &e1: NULL); if (e && e1 > *e) *e = e1;
2597 7 : gel(y,2) = grndtoi(gel(x,2), e? &e1: NULL); if (e && e1 > *e) *e = e1;
2598 7 : return y;
2599 5595460 : case t_VEC: case t_COL: case t_MAT:
2600 5595460 : y = cgetg_copy(x, &lx);
2601 21010824 : for (i=1; i<lx; i++)
2602 : {
2603 15415496 : gel(y,i) = grndtoi(gel(x,i), e? &e1: NULL);
2604 15415364 : if (e && e1 > *e) *e = e1;
2605 : }
2606 5595328 : return y;
2607 : }
2608 6 : pari_err_TYPE("grndtoi",x);
2609 : return NULL; /* LCOV_EXCL_LINE */
2610 : }
2611 :
2612 : /* trunc(x * 2^s). lindep() sanity checks rely on this function to return a
2613 : * t_INT or fail when fed a non-t_COMPLEX input; so do not make this one
2614 : * recursive [ or change the lindep call ] */
2615 : GEN
2616 91393336 : gtrunc2n(GEN x, long s)
2617 : {
2618 : GEN z;
2619 91393336 : switch(typ(x))
2620 : {
2621 28111847 : case t_INT: return shifti(x, s);
2622 46760025 : case t_REAL: return trunc2nr(x, s);
2623 483 : case t_FRAC: {
2624 : pari_sp av;
2625 483 : GEN a = gel(x,1), b = gel(x,2), q;
2626 483 : if (s == 0) return divii(a, b);
2627 483 : av = avma;
2628 483 : if (s < 0) q = divii(shifti(a, s), b);
2629 : else {
2630 : GEN r;
2631 483 : q = dvmdii(a, b, &r);
2632 483 : q = addii(shifti(q,s), divii(shifti(r,s), b));
2633 : }
2634 483 : return gerepileuptoint(av, q);
2635 : }
2636 16616380 : case t_COMPLEX:
2637 16616380 : z = cgetg(3, t_COMPLEX);
2638 16619681 : gel(z,2) = gtrunc2n(gel(x,2), s);
2639 16615875 : if (!signe(gel(z,2))) {
2640 1568418 : set_avma((pari_sp)(z + 3));
2641 1568426 : return gtrunc2n(gel(x,1), s);
2642 : }
2643 15047457 : gel(z,1) = gtrunc2n(gel(x,1), s);
2644 15046559 : return z;
2645 0 : default: pari_err_TYPE("gtrunc2n",x);
2646 : return NULL; /* LCOV_EXCL_LINE */
2647 : }
2648 : }
2649 :
2650 : /* e = number of error bits on integral part */
2651 : GEN
2652 952433 : gcvtoi(GEN x, long *e)
2653 : {
2654 952433 : long tx = typ(x), lx, e1;
2655 : GEN y;
2656 :
2657 952433 : if (tx == t_REAL)
2658 : {
2659 952300 : long ex = expo(x); if (ex < 0) { *e = ex; return gen_0; }
2660 952195 : e1 = ex - bit_prec(x) + 1;
2661 952204 : y = mantissa2nr(x, e1);
2662 952188 : if (e1 <= 0) { pari_sp av = avma; e1 = expo(subri(x,y)); set_avma(av); }
2663 952183 : *e = e1; return y;
2664 : }
2665 133 : *e = -(long)HIGHEXPOBIT;
2666 133 : if (is_matvec_t(tx))
2667 : {
2668 : long i;
2669 28 : y = cgetg_copy(x, &lx);
2670 84 : for (i=1; i<lx; i++)
2671 : {
2672 56 : gel(y,i) = gcvtoi(gel(x,i),&e1);
2673 56 : if (e1 > *e) *e = e1;
2674 : }
2675 28 : return y;
2676 : }
2677 105 : return gtrunc(x);
2678 : }
2679 :
2680 : int
2681 468025 : isint(GEN n, GEN *ptk)
2682 : {
2683 468025 : switch(typ(n))
2684 : {
2685 419907 : case t_INT: *ptk = n; return 1;
2686 1330 : case t_REAL: {
2687 1330 : pari_sp av0 = avma;
2688 1330 : GEN z = floorr(n);
2689 1330 : pari_sp av = avma;
2690 1330 : long s = signe(subri(n, z));
2691 1330 : if (s) return gc_bool(av0,0);
2692 21 : *ptk = z; return gc_bool(av,1);
2693 : }
2694 29638 : case t_FRAC: return 0;
2695 16961 : case t_COMPLEX: return gequal0(gel(n,2)) && isint(gel(n,1),ptk);
2696 0 : case t_QUAD: return gequal0(gel(n,3)) && isint(gel(n,2),ptk);
2697 189 : default: pari_err_TYPE("isint",n);
2698 : return 0; /* LCOV_EXCL_LINE */
2699 : }
2700 : }
2701 :
2702 : int
2703 349802 : issmall(GEN n, long *ptk)
2704 : {
2705 349802 : pari_sp av = avma;
2706 : GEN z;
2707 : long k;
2708 349802 : if (!isint(n, &z)) return 0;
2709 348220 : k = itos_or_0(z); set_avma(av);
2710 348220 : if (k || lgefint(z) == 2) { *ptk = k; return 1; }
2711 0 : return 0;
2712 : }
2713 :
2714 : /* smallest integer greater than any incarnations of the real x
2715 : * Avoid "precision loss in truncation" */
2716 : GEN
2717 880693 : ceil_safe(GEN x)
2718 : {
2719 880693 : pari_sp av = avma;
2720 880693 : long e, tx = typ(x);
2721 : GEN y;
2722 :
2723 880693 : if (is_rational_t(tx)) return gceil(x);
2724 880431 : y = gcvtoi(x,&e);
2725 880427 : if (gsigne(x) >= 0)
2726 : {
2727 879928 : if (e < 0) e = 0;
2728 879928 : y = addii(y, int2n(e));
2729 : }
2730 880405 : return gerepileuptoint(av, y);
2731 : }
2732 : /* largest integer smaller than any incarnations of the real x
2733 : * Avoid "precision loss in truncation" */
2734 : GEN
2735 60875 : floor_safe(GEN x)
2736 : {
2737 60875 : pari_sp av = avma;
2738 60875 : long e, tx = typ(x);
2739 : GEN y;
2740 :
2741 60875 : if (is_rational_t(tx)) return gfloor(x);
2742 60875 : y = gcvtoi(x,&e);
2743 60873 : if (gsigne(x) <= 0)
2744 : {
2745 21 : if (e < 0) e = 0;
2746 21 : y = subii(y, int2n(e));
2747 : }
2748 60873 : return gerepileuptoint(av, y);
2749 : }
2750 :
2751 : GEN
2752 9961 : ser2rfrac_i(GEN x)
2753 : {
2754 9961 : long e = valser(x);
2755 9961 : GEN a = ser2pol_i(x, lg(x));
2756 9961 : if (e) {
2757 5544 : if (e > 0) a = RgX_shift_shallow(a, e);
2758 0 : else a = gred_rfrac_simple(a, pol_xn(-e, varn(a)));
2759 : }
2760 9961 : return a;
2761 : }
2762 :
2763 : static GEN
2764 532 : ser2rfrac(GEN x)
2765 : {
2766 532 : pari_sp av = avma;
2767 532 : return gerepilecopy(av, ser2rfrac_i(x));
2768 : }
2769 :
2770 : /* x t_PADIC, truncate to rational (t_INT/t_FRAC) */
2771 : GEN
2772 269722 : padic_to_Q(GEN x)
2773 : {
2774 269722 : GEN u = gel(x,4), p;
2775 : long v;
2776 269722 : if (!signe(u)) return gen_0;
2777 266628 : v = valp(x);
2778 266628 : if (!v) return icopy(u);
2779 167819 : p = gel(x,2);
2780 167819 : if (v>0)
2781 : {
2782 167706 : pari_sp av = avma;
2783 167706 : return gerepileuptoint(av, mulii(u, powiu(p,v)));
2784 : }
2785 113 : retmkfrac(icopy(u), powiu(p,-v));
2786 : }
2787 : GEN
2788 14 : padic_to_Q_shallow(GEN x)
2789 : {
2790 14 : GEN u = gel(x,4), p, q, q2;
2791 : long v;
2792 14 : if (!signe(u)) return gen_0;
2793 14 : q = gel(x,3); q2 = shifti(q,-1);
2794 14 : v = valp(x);
2795 14 : u = Fp_center_i(u, q, q2);
2796 14 : if (!v) return u;
2797 7 : p = gel(x,2);
2798 7 : if (v>0) return mulii(powiu(p,v), u);
2799 7 : return mkfrac(u, powiu(p,-v));
2800 : }
2801 : GEN
2802 196 : QpV_to_QV(GEN v)
2803 : {
2804 : long i, l;
2805 196 : GEN w = cgetg_copy(v, &l);
2806 931 : for (i = 1; i < l; i++)
2807 : {
2808 735 : GEN c = gel(v,i);
2809 735 : switch(typ(c))
2810 : {
2811 721 : case t_INT:
2812 721 : case t_FRAC: break;
2813 14 : case t_PADIC: c = padic_to_Q_shallow(c); break;
2814 0 : default: pari_err_TYPE("padic_to_Q", v);
2815 : }
2816 735 : gel(w,i) = c;
2817 : }
2818 196 : return w;
2819 : }
2820 :
2821 : GEN
2822 186492 : gtrunc(GEN x)
2823 : {
2824 186492 : switch(typ(x))
2825 : {
2826 82740 : case t_INT: return icopy(x);
2827 48706 : case t_REAL: return truncr(x);
2828 56 : case t_FRAC: return divii(gel(x,1),gel(x,2));
2829 23917 : case t_PADIC: return padic_to_Q(x);
2830 42 : case t_POL: return RgX_copy(x);
2831 14 : case t_RFRAC: return gdeuc(gel(x,1),gel(x,2));
2832 504 : case t_SER: return ser2rfrac(x);
2833 184576 : case t_VEC: case t_COL: case t_MAT: pari_APPLY_same(gtrunc(gel(x,i)));
2834 : }
2835 56 : pari_err_TYPE("gtrunc",x);
2836 : return NULL; /* LCOV_EXCL_LINE */
2837 : }
2838 :
2839 : GEN
2840 217 : trunc0(GEN x, GEN *pte)
2841 : {
2842 217 : if (pte) { long e; x = gcvtoi(x,&e); *pte = stoi(e); }
2843 189 : return gtrunc(x);
2844 : }
2845 : /*******************************************************************/
2846 : /* */
2847 : /* CONVERSIONS --> INT, POL & SER */
2848 : /* */
2849 : /*******************************************************************/
2850 :
2851 : /* return a_(n-1) B^(n-1) + ... + a_0, where B = 2^32.
2852 : * The a_i are 32bits integers */
2853 : GEN
2854 19526 : mkintn(long n, ...)
2855 : {
2856 : va_list ap;
2857 : GEN x, y;
2858 : long i;
2859 : #ifdef LONG_IS_64BIT
2860 16770 : long e = (n&1);
2861 16770 : n = (n+1) >> 1;
2862 : #endif
2863 19526 : va_start(ap,n);
2864 19526 : x = cgetipos(n+2);
2865 19526 : y = int_MSW(x);
2866 69038 : for (i=0; i <n; i++)
2867 : {
2868 : #ifdef LONG_IS_64BIT
2869 38700 : ulong a = (e && !i)? 0: (ulong) va_arg(ap, unsigned int);
2870 38700 : ulong b = (ulong) va_arg(ap, unsigned int);
2871 38700 : *y = (a << 32) | b;
2872 : #else
2873 10812 : *y = (ulong) va_arg(ap, unsigned int);
2874 : #endif
2875 49512 : y = int_precW(y);
2876 : }
2877 19526 : va_end(ap);
2878 19526 : return int_normalize(x, 0);
2879 : }
2880 :
2881 : /* 2^32 a + b */
2882 : GEN
2883 241494 : uu32toi(ulong a, ulong b)
2884 : {
2885 : #ifdef LONG_IS_64BIT
2886 194467 : return utoi((a<<32) | b);
2887 : #else
2888 47027 : return uutoi(a, b);
2889 : #endif
2890 : }
2891 : /* - (2^32 a + b), assume a or b != 0 */
2892 : GEN
2893 72148 : uu32toineg(ulong a, ulong b)
2894 : {
2895 : #ifdef LONG_IS_64BIT
2896 61723 : return utoineg((a<<32) | b);
2897 : #else
2898 10425 : return uutoineg(a, b);
2899 : #endif
2900 : }
2901 :
2902 : /* return a_(n-1) x^(n-1) + ... + a_0 */
2903 : GEN
2904 3689919 : mkpoln(long n, ...)
2905 : {
2906 : va_list ap;
2907 : GEN x, y;
2908 3689919 : long i, l = n+2;
2909 3689919 : va_start(ap,n);
2910 3689919 : x = cgetg(l, t_POL); y = x + 2;
2911 3694786 : x[1] = evalvarn(0);
2912 16764328 : for (i=n-1; i >= 0; i--) gel(y,i) = va_arg(ap, GEN);
2913 3697640 : va_end(ap); return normalizepol_lg(x, l);
2914 : }
2915 :
2916 : /* return [a_1, ..., a_n] */
2917 : GEN
2918 1102161 : mkvecn(long n, ...)
2919 : {
2920 : va_list ap;
2921 : GEN x;
2922 : long i;
2923 1102161 : va_start(ap,n);
2924 1102161 : x = cgetg(n+1, t_VEC);
2925 7035140 : for (i=1; i <= n; i++) gel(x,i) = va_arg(ap, GEN);
2926 1102152 : va_end(ap); return x;
2927 : }
2928 :
2929 : GEN
2930 1379 : mkcoln(long n, ...)
2931 : {
2932 : va_list ap;
2933 : GEN x;
2934 : long i;
2935 1379 : va_start(ap,n);
2936 1379 : x = cgetg(n+1, t_COL);
2937 11032 : for (i=1; i <= n; i++) gel(x,i) = va_arg(ap, GEN);
2938 1379 : va_end(ap); return x;
2939 : }
2940 :
2941 : GEN
2942 125182 : mkvecsmalln(long n, ...)
2943 : {
2944 : va_list ap;
2945 : GEN x;
2946 : long i;
2947 125182 : va_start(ap,n);
2948 125182 : x = cgetg(n+1, t_VECSMALL);
2949 872583 : for (i=1; i <= n; i++) x[i] = va_arg(ap, long);
2950 125182 : va_end(ap); return x;
2951 : }
2952 :
2953 : GEN
2954 16942504 : scalarpol(GEN x, long v)
2955 : {
2956 : GEN y;
2957 16942504 : if (isrationalzero(x)) return zeropol(v);
2958 5174324 : y = cgetg(3,t_POL);
2959 5174372 : y[1] = gequal0(x)? evalvarn(v)
2960 5174369 : : evalvarn(v) | evalsigne(1);
2961 5174369 : gel(y,2) = gcopy(x); return y;
2962 : }
2963 : GEN
2964 3015721 : scalarpol_shallow(GEN x, long v)
2965 : {
2966 : GEN y;
2967 3015721 : if (isrationalzero(x)) return zeropol(v);
2968 2906831 : y = cgetg(3,t_POL);
2969 2906836 : y[1] = gequal0(x)? evalvarn(v)
2970 2906836 : : evalvarn(v) | evalsigne(1);
2971 2906836 : gel(y,2) = x; return y;
2972 : }
2973 :
2974 : /* x0 + x1*T, do not assume x1 != 0 */
2975 : GEN
2976 555705 : deg1pol(GEN x1, GEN x0,long v)
2977 : {
2978 555705 : GEN x = cgetg(4,t_POL);
2979 555705 : x[1] = evalsigne(1) | evalvarn(v);
2980 555705 : gel(x,2) = x0 == gen_0? x0: gcopy(x0); /* gen_0 frequent */
2981 555705 : gel(x,3) = gcopy(x1); return normalizepol_lg(x,4);
2982 : }
2983 :
2984 : /* same, no copy */
2985 : GEN
2986 7693253 : deg1pol_shallow(GEN x1, GEN x0,long v)
2987 : {
2988 7693253 : GEN x = cgetg(4,t_POL);
2989 7693420 : x[1] = evalsigne(1) | evalvarn(v);
2990 7693420 : gel(x,2) = x0;
2991 7693420 : gel(x,3) = x1; return normalizepol_lg(x,4);
2992 : }
2993 :
2994 : GEN
2995 317632 : deg2pol_shallow(GEN x2, GEN x1, GEN x0, long v)
2996 : {
2997 317632 : GEN x = cgetg(5,t_POL);
2998 317634 : x[1] = evalsigne(1) | evalvarn(v);
2999 317634 : gel(x,2) = x0;
3000 317634 : gel(x,3) = x1;
3001 317634 : gel(x,4) = x2;
3002 317634 : return normalizepol_lg(x,5);
3003 : }
3004 :
3005 : static GEN
3006 3475435 : _gtopoly(GEN x, long v, int reverse)
3007 : {
3008 3475435 : long tx = typ(x);
3009 : GEN y;
3010 :
3011 3475435 : if (v<0) v = 0;
3012 3475435 : switch(tx)
3013 : {
3014 21 : case t_POL:
3015 21 : if (varncmp(varn(x), v) < 0) pari_err_PRIORITY("gtopoly", x, "<", v);
3016 21 : y = RgX_copy(x); break;
3017 28 : case t_SER:
3018 28 : if (varncmp(varn(x), v) < 0) pari_err_PRIORITY("gtopoly", x, "<", v);
3019 28 : y = ser2rfrac(x);
3020 28 : if (typ(y) != t_POL)
3021 0 : pari_err_DOMAIN("gtopoly", "valuation", "<", gen_0, x);
3022 28 : break;
3023 42 : case t_RFRAC:
3024 : {
3025 42 : GEN a = gel(x,1), b = gel(x,2);
3026 42 : long vb = varn(b);
3027 42 : if (varncmp(vb, v) < 0) pari_err_PRIORITY("gtopoly", x, "<", v);
3028 42 : if (typ(a) != t_POL || varn(a) != vb) return zeropol(v);
3029 21 : y = RgX_div(a,b); break;
3030 : }
3031 337043 : case t_VECSMALL: x = zv_to_ZV(x); /* fall through */
3032 3474784 : case t_QFB: case t_VEC: case t_COL: case t_MAT:
3033 : {
3034 3474784 : long j, k, lx = lg(x);
3035 : GEN z;
3036 3474784 : if (tx == t_QFB) lx--;
3037 3474784 : if (varncmp(gvar(x), v) <= 0) pari_err_PRIORITY("gtopoly", x, "<=", v);
3038 3474783 : y = cgetg(lx+1, t_POL);
3039 3474778 : y[1] = evalvarn(v);
3040 3474778 : if (reverse) {
3041 2434012 : x--;
3042 26224492 : for (j=2; j<=lx; j++) gel(y,j) = gel(x,j);
3043 : } else {
3044 5321740 : for (j=2, k=lx; k>=2; j++) gel(y,j) = gel(x,--k);
3045 : }
3046 3474778 : z = RgX_copy(normalizepol_lg(y,lx+1));
3047 3474785 : settyp(y, t_VECSMALL);/* left on stack */
3048 3474785 : return z;
3049 : }
3050 560 : default:
3051 560 : if (is_scalar_t(tx)) return scalarpol(x,v);
3052 7 : pari_err_TYPE("gtopoly",x);
3053 : return NULL; /* LCOV_EXCL_LINE */
3054 : }
3055 70 : setvarn(y,v); return y;
3056 : }
3057 :
3058 : GEN
3059 2434047 : gtopolyrev(GEN x, long v) { return _gtopoly(x,v,1); }
3060 :
3061 : GEN
3062 1041387 : gtopoly(GEN x, long v) { return _gtopoly(x,v,0); }
3063 :
3064 : static GEN
3065 1064 : gtovecpost(GEN x, long n)
3066 : {
3067 1064 : long i, imax, lx, tx = typ(x);
3068 1064 : GEN y = zerovec(n);
3069 :
3070 1064 : if (is_scalar_t(tx) || tx == t_RFRAC) { gel(y,1) = gcopy(x); return y; }
3071 315 : switch(tx)
3072 : {
3073 56 : case t_POL:
3074 56 : lx=lg(x); imax = minss(lx-2, n);
3075 224 : for (i=1; i<=imax; i++) gel(y,i) = gcopy(gel(x,lx-i));
3076 56 : return y;
3077 28 : case t_SER:
3078 28 : lx=lg(x); imax = minss(lx-2, n); x++;
3079 84 : for (i=1; i<=imax; i++) gel(y,i) = gcopy(gel(x,i));
3080 28 : return y;
3081 28 : case t_QFB: case t_VEC: case t_COL:
3082 28 : lx=lg(x); imax = minss(lx-1, n);
3083 84 : for (i=1; i<=imax; i++) gel(y,i) = gcopy(gel(x,i));
3084 28 : return y;
3085 63 : case t_LIST:
3086 63 : if (list_typ(x) == t_LIST_MAP) pari_err_TYPE("gtovec",x);
3087 56 : x = list_data(x); lx = x? lg(x): 1;
3088 56 : imax = minss(lx-1, n);
3089 252 : for (i=1; i<=imax; i++) gel(y,i) = gcopy(gel(x,i));
3090 56 : return y;
3091 56 : case t_STR:
3092 : {
3093 56 : char *s = GSTR(x);
3094 56 : imax = minss(strlen(s), n); s--;
3095 224 : for (i=1; i<=imax; i++) gel(y,i) = chartoGENstr(s[i]);
3096 56 : return y;
3097 : }
3098 28 : case t_VECSMALL:
3099 28 : lx=lg(x);
3100 28 : imax = minss(lx-1, n);
3101 84 : for (i=1; i<=imax; i++) gel(y,i) = stoi(x[i]);
3102 28 : return y;
3103 56 : default: pari_err_TYPE("gtovec",x);
3104 : return NULL; /*LCOV_EXCL_LINE*/
3105 : }
3106 : }
3107 :
3108 : static GEN
3109 3535 : init_vectopre(long a, long n, GEN y, long *imax)
3110 : {
3111 3535 : *imax = minss(a, n);
3112 3535 : return (n == *imax)? y: y + n - a;
3113 : }
3114 : static GEN
3115 3591 : gtovecpre(GEN x, long n)
3116 : {
3117 3591 : long i, imax, lx, tx = typ(x);
3118 3591 : GEN y = zerovec(n), y0;
3119 :
3120 3591 : if (is_scalar_t(tx) || tx == t_RFRAC) { gel(y,n) = gcopy(x); return y; }
3121 3535 : switch(tx)
3122 : {
3123 56 : case t_POL:
3124 56 : lx=lg(x);
3125 56 : y0 = init_vectopre(lx-2, n, y, &imax);
3126 224 : for (i=1; i<=imax; i++) gel(y0,i) = gcopy(gel(x,lx-i));
3127 56 : return y;
3128 3248 : case t_SER:
3129 3248 : lx=lg(x); x++;
3130 3248 : y0 = init_vectopre(lx-2, n, y, &imax);
3131 131425 : for (i=1; i<=imax; i++) gel(y0,i) = gcopy(gel(x,i));
3132 3248 : return y;
3133 28 : case t_QFB: case t_VEC: case t_COL:
3134 28 : lx=lg(x);
3135 28 : y0 = init_vectopre(lx-1, n, y, &imax);
3136 84 : for (i=1; i<=imax; i++) gel(y0,i) = gcopy(gel(x,i));
3137 28 : return y;
3138 63 : case t_LIST:
3139 63 : if (list_typ(x) == t_LIST_MAP) pari_err_TYPE("gtovec",x);
3140 56 : x = list_data(x); lx = x? lg(x): 1;
3141 56 : y0 = init_vectopre(lx-1, n, y, &imax);
3142 252 : for (i=1; i<=imax; i++) gel(y0,i) = gcopy(gel(x,i));
3143 56 : return y;
3144 56 : case t_STR:
3145 : {
3146 56 : char *s = GSTR(x);
3147 56 : y0 = init_vectopre(strlen(s), n, y, &imax); s--;
3148 224 : for (i=1; i<=imax; i++) gel(y,i) = chartoGENstr(s[i]);
3149 56 : return y;
3150 : }
3151 28 : case t_VECSMALL:
3152 28 : lx=lg(x);
3153 28 : y0 = init_vectopre(lx-1, n, y, &imax);
3154 84 : for (i=1; i<=imax; i++) gel(y0,i) = stoi(x[i]);
3155 28 : return y;
3156 56 : default: pari_err_TYPE("gtovec",x);
3157 : return NULL; /*LCOV_EXCL_LINE*/
3158 : }
3159 : }
3160 : GEN
3161 106014 : gtovec0(GEN x, long n)
3162 : {
3163 106014 : if (!n) return gtovec(x);
3164 4655 : if (n > 0) return gtovecpost(x, n);
3165 3591 : return gtovecpre(x, -n);
3166 : }
3167 :
3168 : GEN
3169 101695 : gtovec(GEN x)
3170 : {
3171 101695 : long i, lx, tx = typ(x);
3172 : GEN y;
3173 :
3174 101695 : if (is_scalar_t(tx)) return mkveccopy(x);
3175 101562 : switch(tx)
3176 : {
3177 15225 : case t_POL:
3178 15225 : lx=lg(x); y=cgetg(lx-1,t_VEC);
3179 1498336 : for (i=1; i<=lx-2; i++) gel(y,i) = gcopy(gel(x,lx-i));
3180 15225 : return y;
3181 385 : case t_SER:
3182 385 : lx=lg(x); y=cgetg(lx-1,t_VEC); x++;
3183 12264 : for (i=1; i<=lx-2; i++) gel(y,i) = gcopy(gel(x,i));
3184 385 : return y;
3185 28 : case t_RFRAC: return mkveccopy(x);
3186 70007 : case t_QFB:
3187 70007 : retmkvec3(icopy(gel(x,1)), icopy(gel(x,2)), icopy(gel(x,3)));
3188 14196 : case t_VEC: case t_COL: case t_MAT:
3189 14196 : lx=lg(x); y=cgetg(lx,t_VEC);
3190 1467298 : for (i=1; i<lx; i++) gel(y,i) = gcopy(gel(x,i));
3191 14196 : return y;
3192 76 : case t_LIST:
3193 76 : if (list_typ(x) == t_LIST_MAP) return mapdomain(x);
3194 62 : x = list_data(x); lx = x? lg(x): 1;
3195 62 : y = cgetg(lx, t_VEC);
3196 304 : for (i=1; i<lx; i++) gel(y,i) = gcopy(gel(x,i));
3197 62 : return y;
3198 105 : case t_STR:
3199 : {
3200 105 : char *s = GSTR(x);
3201 105 : lx = strlen(s)+1; y = cgetg(lx, t_VEC);
3202 105 : s--;
3203 340239 : for (i=1; i<lx; i++) gel(y,i) = chartoGENstr(s[i]);
3204 105 : return y;
3205 : }
3206 1498 : case t_VECSMALL:
3207 1498 : return vecsmall_to_vec(x);
3208 42 : case t_ERROR:
3209 42 : lx=lg(x); y = cgetg(lx,t_VEC);
3210 42 : gel(y,1) = errname(x);
3211 126 : for (i=2; i<lx; i++) gel(y,i) = gcopy(gel(x,i));
3212 42 : return y;
3213 0 : default: pari_err_TYPE("gtovec",x);
3214 : return NULL; /*LCOV_EXCL_LINE*/
3215 : }
3216 : }
3217 :
3218 : GEN
3219 287 : gtovecrev0(GEN x, long n)
3220 : {
3221 287 : GEN y = gtovec0(x, -n);
3222 259 : vecreverse_inplace(y);
3223 259 : return y;
3224 : }
3225 : GEN
3226 0 : gtovecrev(GEN x) { return gtovecrev0(x, 0); }
3227 :
3228 : GEN
3229 3626 : gtocol0(GEN x, long n)
3230 : {
3231 : GEN y;
3232 3626 : if (!n) return gtocol(x);
3233 3430 : y = gtovec0(x, n);
3234 3374 : settyp(y, t_COL); return y;
3235 : }
3236 : GEN
3237 196 : gtocol(GEN x)
3238 : {
3239 : long lx, tx, i, j, h;
3240 : GEN y;
3241 196 : tx = typ(x);
3242 196 : if (tx != t_MAT) { y = gtovec(x); settyp(y, t_COL); return y; }
3243 14 : lx = lg(x); if (lx == 1) return cgetg(1, t_COL);
3244 14 : h = lgcols(x); y = cgetg(h, t_COL);
3245 42 : for (i = 1 ; i < h; i++) {
3246 28 : gel(y,i) = cgetg(lx, t_VEC);
3247 112 : for (j = 1; j < lx; j++) gmael(y,i,j) = gcopy(gcoeff(x,i,j));
3248 : }
3249 14 : return y;
3250 : }
3251 :
3252 : GEN
3253 273 : gtocolrev0(GEN x, long n)
3254 : {
3255 273 : GEN y = gtocol0(x, -n);
3256 245 : long ly = lg(y), lim = ly>>1, i;
3257 700 : for (i = 1; i <= lim; i++) swap(gel(y,i), gel(y,ly-i));
3258 245 : return y;
3259 : }
3260 : GEN
3261 0 : gtocolrev(GEN x) { return gtocolrev0(x, 0); }
3262 :
3263 : static long
3264 18984 : Itos(GEN x)
3265 : {
3266 18984 : if (typ(x) != t_INT) pari_err_TYPE("vectosmall",x);
3267 18984 : return itos(x);
3268 : }
3269 :
3270 : static GEN
3271 91 : gtovecsmallpost(GEN x, long n)
3272 : {
3273 : long i, imax, lx;
3274 91 : GEN y = zero_Flv(n);
3275 :
3276 91 : switch(typ(x))
3277 : {
3278 7 : case t_INT:
3279 7 : y[1] = itos(x); return y;
3280 14 : case t_POL:
3281 14 : lx=lg(x); imax = minss(lx-2, n);
3282 56 : for (i=1; i<=imax; i++) y[i] = Itos(gel(x,lx-i));
3283 14 : return y;
3284 7 : case t_SER:
3285 7 : lx=lg(x); imax = minss(lx-2, n); x++;
3286 21 : for (i=1; i<=imax; i++) y[i] = Itos(gel(x,i));
3287 7 : return y;
3288 7 : case t_VEC: case t_COL:
3289 7 : lx=lg(x); imax = minss(lx-1, n);
3290 21 : for (i=1; i<=imax; i++) y[i] = Itos(gel(x,i));
3291 7 : return y;
3292 14 : case t_LIST:
3293 14 : x = list_data(x); lx = x? lg(x): 1;
3294 14 : imax = minss(lx-1, n);
3295 63 : for (i=1; i<=imax; i++) y[i] = Itos(gel(x,i));
3296 14 : return y;
3297 7 : case t_VECSMALL:
3298 7 : lx=lg(x);
3299 7 : imax = minss(lx-1, n);
3300 21 : for (i=1; i<=imax; i++) y[i] = x[i];
3301 7 : return y;
3302 14 : case t_STR:
3303 : {
3304 14 : unsigned char *s = (unsigned char*)GSTR(x);
3305 14 : imax = minss(strlen((const char *)s), n); s--;
3306 56 : for (i=1; i<=imax; i++) y[i] = (long)s[i];
3307 14 : return y;
3308 : }
3309 21 : default: pari_err_TYPE("gtovecsmall",x);
3310 : return NULL; /*LCOV_EXCL_LINE*/
3311 : }
3312 : }
3313 : static GEN
3314 91 : gtovecsmallpre(GEN x, long n)
3315 : {
3316 : long i, imax, lx;
3317 91 : GEN y = zero_Flv(n), y0;
3318 :
3319 91 : switch(typ(x))
3320 : {
3321 7 : case t_INT:
3322 7 : y[n] = itos(x); return y;
3323 14 : case t_POL:
3324 14 : lx=lg(x);
3325 14 : y0 = init_vectopre(lx-2, n, y, &imax);
3326 56 : for (i=1; i<=imax; i++) y0[i] = Itos(gel(x,lx-i));
3327 14 : return y;
3328 7 : case t_SER:
3329 7 : lx=lg(x); x++;
3330 7 : y0 = init_vectopre(lx-2, n, y, &imax);
3331 21 : for (i=1; i<=imax; i++) y0[i] = Itos(gel(x,i));
3332 7 : return y;
3333 7 : case t_VEC: case t_COL:
3334 7 : lx=lg(x);
3335 7 : y0 = init_vectopre(lx-1, n, y, &imax);
3336 21 : for (i=1; i<=imax; i++) y0[i] = Itos(gel(x,i));
3337 7 : return y;
3338 14 : case t_LIST:
3339 14 : x = list_data(x); lx = x? lg(x): 1;
3340 14 : y0 = init_vectopre(lx-1, n, y, &imax);
3341 63 : for (i=1; i<=imax; i++) y0[i] = Itos(gel(x,i));
3342 14 : return y;
3343 7 : case t_VECSMALL:
3344 7 : lx=lg(x);
3345 7 : y0 = init_vectopre(lx-1, n, y, &imax);
3346 21 : for (i=1; i<=imax; i++) y0[i] = x[i];
3347 7 : return y;
3348 14 : case t_STR:
3349 : {
3350 14 : unsigned char *s = (unsigned char*)GSTR(x);
3351 14 : y0 = init_vectopre(strlen((const char *)s), n, y, &imax); s--;
3352 56 : for (i=1; i<=imax; i++) y0[i] = (long)s[i];
3353 14 : return y;
3354 : }
3355 21 : default: pari_err_TYPE("gtovecsmall",x);
3356 : return NULL; /*LCOV_EXCL_LINE*/
3357 : }
3358 : }
3359 :
3360 : GEN
3361 7707 : gtovecsmall0(GEN x, long n)
3362 : {
3363 7707 : if (!n) return gtovecsmall(x);
3364 182 : if (n > 0) return gtovecsmallpost(x, n);
3365 91 : return gtovecsmallpre(x, -n);
3366 : }
3367 :
3368 : GEN
3369 18928 : gtovecsmall(GEN x)
3370 : {
3371 : GEN V;
3372 : long l, i;
3373 :
3374 18928 : switch(typ(x))
3375 : {
3376 112 : case t_INT: return mkvecsmall(itos(x));
3377 28 : case t_STR:
3378 : {
3379 28 : unsigned char *s = (unsigned char*)GSTR(x);
3380 28 : l = strlen((const char *)s);
3381 28 : V = cgetg(l+1, t_VECSMALL);
3382 28 : s--;
3383 1953 : for (i=1; i<=l; i++) V[i] = (long)s[i];
3384 28 : return V;
3385 : }
3386 13139 : case t_VECSMALL: return leafcopy(x);
3387 14 : case t_LIST:
3388 14 : x = list_data(x);
3389 14 : if (!x) return cgetg(1, t_VECSMALL);
3390 : /* fall through */
3391 : case t_VEC: case t_COL:
3392 5607 : l = lg(x); V = cgetg(l,t_VECSMALL);
3393 24290 : for(i=1; i<l; i++) V[i] = Itos(gel(x,i));
3394 5607 : return V;
3395 14 : case t_POL:
3396 14 : l = lg(x); V = cgetg(l-1,t_VECSMALL);
3397 63 : for (i=1; i<=l-2; i++) V[i] = Itos(gel(x,l-i));
3398 14 : return V;
3399 7 : case t_SER:
3400 7 : l = lg(x); V = cgetg(l-1,t_VECSMALL); x++;
3401 21 : for (i=1; i<=l-2; i++) V[i] = Itos(gel(x,i));
3402 7 : return V;
3403 21 : default:
3404 21 : pari_err_TYPE("vectosmall",x);
3405 : return NULL; /* LCOV_EXCL_LINE */
3406 : }
3407 : }
3408 :
3409 : GEN
3410 313 : compo(GEN x, long n)
3411 : {
3412 313 : long tx = typ(x);
3413 313 : ulong l, lx = (ulong)lg(x);
3414 :
3415 313 : if (!is_recursive_t(tx))
3416 : {
3417 63 : if (tx == t_VECSMALL)
3418 : {
3419 21 : if (n < 1) pari_err_COMPONENT("", "<", gen_1, stoi(n));
3420 21 : if ((ulong)n >= lx) pari_err_COMPONENT("", ">", utoi(lx-1), stoi(n));
3421 7 : return stoi(x[n]);
3422 : }
3423 42 : pari_err_TYPE("component [leaf]", x);
3424 : }
3425 250 : if (n < 1) pari_err_COMPONENT("", "<", gen_1, stoi(n));
3426 243 : if (tx == t_LIST) {
3427 28 : x = list_data(x); tx = t_VEC;
3428 28 : lx = (ulong)(x? lg(x): 1);
3429 : }
3430 243 : l = (ulong)lontyp[tx] + (ulong)n-1; /* beware overflow */
3431 243 : if (l >= lx) pari_err_COMPONENT("", ">", utoi(lx-lontyp[tx]), stoi(n));
3432 166 : return gcopy(gel(x,l));
3433 : }
3434 :
3435 : /* assume x a t_POL */
3436 : static GEN
3437 2249894 : _polcoef(GEN x, long n, long v)
3438 : {
3439 2249894 : long i, w, lx = lg(x), dx = lx-3;
3440 : GEN z;
3441 2249894 : if (dx < 0) return gen_0;
3442 1608680 : if (v < 0 || v == (w=varn(x)))
3443 1236602 : return (n < 0 || n > dx)? gen_0: gel(x,n+2);
3444 372078 : if (varncmp(w,v) > 0) return n? gen_0: x;
3445 : /* w < v */
3446 371238 : z = cgetg(lx, t_POL); z[1] = x[1];
3447 1789951 : for (i = 2; i < lx; i++) gel(z,i) = polcoef_i(gel(x,i), n, v);
3448 371231 : z = normalizepol_lg(z, lx);
3449 371234 : switch(lg(z))
3450 : {
3451 27974 : case 2: z = gen_0; break;
3452 124619 : case 3: z = gel(z,2); break;
3453 : }
3454 371234 : return z;
3455 : }
3456 :
3457 : /* assume x a t_SER */
3458 : static GEN
3459 110908 : _sercoef(GEN x, long n, long v)
3460 : {
3461 110908 : long i, w = varn(x), lx = lg(x), dx = lx-3, N;
3462 : GEN z;
3463 110908 : if (v < 0) v = w;
3464 110908 : N = v == w? n - valser(x): n;
3465 110908 : if (dx < 0)
3466 : {
3467 21 : if (N >= 0) pari_err_DOMAIN("polcoef", "t_SER", "=", x, x);
3468 14 : return gen_0;
3469 : }
3470 110887 : if (v == w)
3471 : {
3472 110845 : if (!dx && !signe(x) && !isinexact(gel(x,2))) dx = -1;
3473 110845 : if (N > dx)
3474 28 : pari_err_DOMAIN("polcoef", "degree", ">", stoi(dx+valser(x)), stoi(n));
3475 110817 : return (N < 0)? gen_0: gel(x,N+2);
3476 : }
3477 42 : if (varncmp(w,v) > 0) return N? gen_0: x;
3478 : /* w < v */
3479 28 : z = cgetg(lx, t_SER); z[1] = x[1];
3480 91 : for (i = 2; i < lx; i++) gel(z,i) = polcoef_i(gel(x,i), n, v);
3481 28 : return normalizeser(z);
3482 : }
3483 :
3484 : /* assume x a t_RFRAC(n) */
3485 : static GEN
3486 21 : _rfraccoef(GEN x, long n, long v)
3487 : {
3488 21 : GEN P,Q, p = gel(x,1), q = gel(x,2);
3489 21 : long vp = gvar(p), vq = gvar(q);
3490 21 : if (v < 0) v = varncmp(vp, vq) < 0? vp: vq;
3491 21 : P = (vp == v)? p: swap_vars(p, v);
3492 21 : Q = (vq == v)? q: swap_vars(q, v);
3493 21 : if (!RgX_is_monomial(Q)) pari_err_TYPE("polcoef", x);
3494 21 : n += degpol(Q);
3495 21 : return gdiv(_polcoef(P, n, v), leading_coeff(Q));
3496 : }
3497 :
3498 : GEN
3499 2946732 : polcoef_i(GEN x, long n, long v)
3500 : {
3501 2946732 : long tx = typ(x);
3502 2946732 : switch(tx)
3503 : {
3504 2249874 : case t_POL: return _polcoef(x,n,v);
3505 110908 : case t_SER: return _sercoef(x,n,v);
3506 21 : case t_RFRAC: return _rfraccoef(x,n,v);
3507 : }
3508 585929 : if (!is_scalar_t(tx)) pari_err_TYPE("polcoef", x);
3509 585763 : return n? gen_0: x;
3510 : }
3511 :
3512 : /* with respect to the main variable if v<0, with respect to the variable v
3513 : * otherwise. v ignored if x is not a polynomial/series. */
3514 : GEN
3515 727559 : polcoef(GEN x, long n, long v)
3516 : {
3517 727559 : pari_sp av = avma;
3518 727559 : x = polcoef_i(x,n,v);
3519 727349 : if (x == gen_0) return x;
3520 130725 : return (avma == av)? gcopy(x): gerepilecopy(av, x);
3521 : }
3522 :
3523 : static GEN
3524 111307 : vecdenom(GEN v, long imin, long imax)
3525 : {
3526 111307 : long i = imin;
3527 : GEN s;
3528 111307 : if (imin > imax) return gen_1;
3529 111307 : s = denom_i(gel(v,i));
3530 222152 : for (i++; i<=imax; i++)
3531 : {
3532 110845 : GEN t = denom_i(gel(v,i));
3533 110845 : if (t != gen_1) s = glcm(s,t);
3534 : }
3535 111307 : return s;
3536 : }
3537 : static GEN denompol(GEN x, long v);
3538 : static GEN
3539 14 : vecdenompol(GEN v, long imin, long imax, long vx)
3540 : {
3541 14 : long i = imin;
3542 : GEN s;
3543 14 : if (imin > imax) return gen_1;
3544 14 : s = denompol(gel(v,i), vx);
3545 14 : for (i++; i<=imax; i++)
3546 : {
3547 0 : GEN t = denompol(gel(v,i), vx);
3548 0 : if (t != gen_1) s = glcm(s,t);
3549 : }
3550 14 : return s;
3551 : }
3552 : GEN
3553 10364006 : denom_i(GEN x)
3554 : {
3555 10364006 : switch(typ(x))
3556 : {
3557 2906732 : case t_INT:
3558 : case t_REAL:
3559 : case t_INTMOD:
3560 : case t_FFELT:
3561 : case t_PADIC:
3562 : case t_SER:
3563 2906732 : case t_VECSMALL: return gen_1;
3564 81481 : case t_FRAC: return gel(x,2);
3565 252 : case t_COMPLEX: return vecdenom(x,1,2);
3566 69069 : case t_QUAD: return vecdenom(x,2,3);
3567 42 : case t_POLMOD: return denom_i(gel(x,2));
3568 7263457 : case t_RFRAC: return gel(x,2);
3569 973 : case t_POL: return pol_1(varn(x));
3570 41986 : case t_VEC: case t_COL: case t_MAT: return vecdenom(x, 1, lg(x)-1);
3571 : }
3572 14 : pari_err_TYPE("denom",x);
3573 : return NULL; /* LCOV_EXCL_LINE */
3574 : }
3575 : /* v has lower (or equal) priority as x's main variable */
3576 : static GEN
3577 119 : denompol(GEN x, long v)
3578 : {
3579 119 : long vx, tx = typ(x);
3580 119 : if (is_scalar_t(tx)) return gen_1;
3581 105 : switch(typ(x))
3582 : {
3583 14 : case t_SER:
3584 14 : if (varn(x) != v) return x;
3585 14 : vx = valser(x); return vx < 0? pol_xn(-vx, v): pol_1(v);
3586 63 : case t_RFRAC: x = gel(x,2); return varn(x) == v? x: pol_1(v);
3587 14 : case t_POL: return pol_1(v);
3588 14 : case t_VEC: case t_COL: case t_MAT: return vecdenompol(x, 1, lg(x)-1, v);
3589 : }
3590 0 : pari_err_TYPE("denom",x);
3591 : return NULL; /* LCOV_EXCL_LINE */
3592 : }
3593 : GEN
3594 225008 : denom(GEN x) { pari_sp av = avma; return gerepilecopy(av, denom_i(x)); }
3595 :
3596 : static GEN
3597 287 : denominator_v(GEN x, long v)
3598 : {
3599 287 : long v0 = gvar(x);
3600 : GEN d;
3601 287 : if (v0 == NO_VARIABLE || varncmp(v0,v) > 0) return pol_1(v);
3602 105 : if (v0 != v) { v0 = fetch_var_higher(); x = gsubst(x, v, pol_x(v0)); }
3603 105 : d = denompol(x, v0);
3604 105 : if (v0 != v) { d = gsubst(d, v0, pol_x(v)); (void)delete_var(); }
3605 105 : return d;
3606 : }
3607 : GEN
3608 124236 : denominator(GEN x, GEN D)
3609 : {
3610 124236 : pari_sp av = avma;
3611 : GEN d;
3612 124236 : if (!D) return denom(x);
3613 280 : if (isint1(D))
3614 : {
3615 140 : d = Q_denom_safe(x);
3616 140 : if (!d) { set_avma(av); return gen_1; }
3617 105 : return gerepilecopy(av, d);
3618 : }
3619 140 : if (!gequalX(D)) pari_err_TYPE("denominator", D);
3620 140 : return gerepileupto(av, denominator_v(x, varn(D)));
3621 : }
3622 : GEN
3623 8925 : numerator(GEN x, GEN D)
3624 : {
3625 8925 : pari_sp av = avma;
3626 : long v;
3627 8925 : if (!D) return numer(x);
3628 294 : if (isint1(D)) return Q_remove_denom(x,NULL);
3629 154 : if (!gequalX(D)) pari_err_TYPE("numerator", D);
3630 154 : v = varn(D); /* optimization */
3631 154 : if (typ(x) == t_RFRAC && varn(gel(x,2)) == v) return gcopy(gel(x,1));
3632 147 : return gerepileupto(av, gmul(x, denominator_v(x,v)));
3633 : }
3634 : GEN
3635 131005 : content0(GEN x, GEN D)
3636 : {
3637 131005 : pari_sp av = avma;
3638 : long v, v0;
3639 : GEN d;
3640 131005 : if (!D) return content(x);
3641 294 : if (isint1(D))
3642 : {
3643 140 : d = Q_content_safe(x);
3644 140 : return d? d: gen_1;
3645 : }
3646 154 : if (!gequalX(D)) pari_err_TYPE("content", D);
3647 154 : v = varn(D);
3648 154 : v0 = gvar(x); if (v0 == NO_VARIABLE) return gen_1;
3649 56 : if (varncmp(v0,v) > 0)
3650 : {
3651 0 : v0 = gvar2(x);
3652 0 : return v0 == NO_VARIABLE? gen_1: pol_1(v0);
3653 : }
3654 56 : if (v0 != v) { v0 = fetch_var_higher(); x = gsubst(x, v, pol_x(v0)); }
3655 56 : d = content(x);
3656 : /* gsubst is needed because of content([x]) = x */
3657 56 : if (v0 != v) { d = gsubst(d, v0, pol_x(v)); (void)delete_var(); }
3658 56 : return gerepileupto(av, d);
3659 : }
3660 :
3661 : GEN
3662 8990226 : numer_i(GEN x)
3663 : {
3664 8990226 : switch(typ(x))
3665 : {
3666 1728421 : case t_INT:
3667 : case t_REAL:
3668 : case t_INTMOD:
3669 : case t_FFELT:
3670 : case t_PADIC:
3671 : case t_SER:
3672 : case t_VECSMALL:
3673 1728421 : case t_POL: return x;
3674 28 : case t_POLMOD: return mkpolmod(numer_i(gel(x,2)), gel(x,1));
3675 7261588 : case t_FRAC:
3676 7261588 : case t_RFRAC: return gel(x,1);
3677 175 : case t_COMPLEX:
3678 : case t_QUAD:
3679 : case t_VEC:
3680 : case t_COL:
3681 175 : case t_MAT: return gmul(denom_i(x),x);
3682 : }
3683 14 : pari_err_TYPE("numer",x);
3684 : return NULL; /* LCOV_EXCL_LINE */
3685 : }
3686 : GEN
3687 8631 : numer(GEN x) { pari_sp av = avma; return gerepilecopy(av, numer_i(x)); }
3688 :
3689 : /* Lift only intmods if v does not occur in x, lift with respect to main
3690 : * variable of x if v < 0, with respect to variable v otherwise */
3691 : GEN
3692 2293624 : lift0(GEN x, long v)
3693 : {
3694 : GEN y;
3695 :
3696 2293624 : switch(typ(x))
3697 : {
3698 30359 : case t_INT: return icopy(x);
3699 2160008 : case t_INTMOD: return v < 0? icopy(gel(x,2)): gcopy(x);
3700 91742 : case t_POLMOD:
3701 91742 : if (v < 0 || v == varn(gel(x,1))) return gcopy(gel(x,2));
3702 14 : y = cgetg(3, t_POLMOD);
3703 14 : gel(y,1) = lift0(gel(x,1),v);
3704 14 : gel(y,2) = lift0(gel(x,2),v); return y;
3705 665 : case t_PADIC: return v < 0? padic_to_Q(x): gcopy(x);
3706 8715 : case t_POL:
3707 41405 : pari_APPLY_pol(lift0(gel(x,i), v));
3708 56 : case t_SER:
3709 56 : if (ser_isexactzero(x))
3710 : {
3711 14 : if (lg(x) == 2) return gcopy(x);
3712 14 : y = scalarser(lift0(gel(x,2),v), varn(x), 1);
3713 14 : setvalser(y, valser(x)); return y;
3714 : }
3715 434 : pari_APPLY_ser(lift0(gel(x,i), v));
3716 1897 : case t_COMPLEX: case t_QUAD: case t_RFRAC:
3717 : case t_VEC: case t_COL: case t_MAT:
3718 41104 : pari_APPLY_same(lift0(gel(x,i), v));
3719 182 : default: return gcopy(x);
3720 : }
3721 : }
3722 : /* same as lift, shallow */
3723 : GEN
3724 586553 : lift_shallow(GEN x)
3725 : {
3726 : GEN y;
3727 586553 : switch(typ(x))
3728 : {
3729 195971 : case t_INTMOD: case t_POLMOD: return gel(x,2);
3730 476 : case t_PADIC: return padic_to_Q(x);
3731 0 : case t_SER:
3732 0 : if (ser_isexactzero(x))
3733 : {
3734 0 : if (lg(x) == 2) return x;
3735 0 : y = scalarser(lift_shallow(gel(x,2)), varn(x), 1);
3736 0 : setvalser(y, valser(x)); return y;
3737 : }
3738 0 : pari_APPLY_ser(lift_shallow(gel(x,i)));
3739 47243 : case t_POL:
3740 267340 : pari_APPLY_pol(lift_shallow(gel(x,i)));
3741 11210 : case t_COMPLEX: case t_QUAD: case t_RFRAC:
3742 : case t_VEC: case t_COL: case t_MAT:
3743 275666 : pari_APPLY_same(lift_shallow(gel(x,i)));
3744 331653 : default: return x;
3745 : }
3746 : }
3747 : GEN
3748 2142776 : lift(GEN x) { return lift0(x,-1); }
3749 :
3750 : GEN
3751 2003435 : liftall_shallow(GEN x)
3752 : {
3753 : GEN y;
3754 2003435 : switch(typ(x))
3755 : {
3756 533778 : case t_INTMOD: return gel(x,2);
3757 547519 : case t_POLMOD:
3758 547519 : return liftall_shallow(gel(x,2));
3759 581 : case t_PADIC: return padic_to_Q(x);
3760 555912 : case t_POL:
3761 1356460 : pari_APPLY_pol(liftall_shallow(gel(x,i)));
3762 7 : case t_SER:
3763 7 : if (ser_isexactzero(x))
3764 : {
3765 0 : if (lg(x) == 2) return x;
3766 0 : y = scalarser(liftall_shallow(gel(x,2)), varn(x), 1);
3767 0 : setvalser(y, valser(x)); return y;
3768 : }
3769 35 : pari_APPLY_ser(liftall_shallow(gel(x,i)));
3770 132762 : case t_COMPLEX: case t_QUAD: case t_RFRAC:
3771 : case t_VEC: case t_COL: case t_MAT:
3772 760515 : pari_APPLY_same(liftall_shallow(gel(x,i)));
3773 232876 : default: return x;
3774 : }
3775 : }
3776 : GEN
3777 26243 : liftall(GEN x)
3778 26243 : { pari_sp av = avma; return gerepilecopy(av, liftall_shallow(x)); }
3779 :
3780 : GEN
3781 546 : liftint_shallow(GEN x)
3782 : {
3783 : GEN y;
3784 546 : switch(typ(x))
3785 : {
3786 266 : case t_INTMOD: return gel(x,2);
3787 28 : case t_PADIC: return padic_to_Q(x);
3788 21 : case t_POL:
3789 70 : pari_APPLY_pol(liftint_shallow(gel(x,i)));
3790 14 : case t_SER:
3791 14 : if (ser_isexactzero(x))
3792 : {
3793 7 : if (lg(x) == 2) return x;
3794 7 : y = scalarser(liftint_shallow(gel(x,2)), varn(x), 1);
3795 7 : setvalser(y, valser(x)); return y;
3796 : }
3797 35 : pari_APPLY_ser(liftint_shallow(gel(x,i)));
3798 161 : case t_POLMOD: case t_COMPLEX: case t_QUAD: case t_RFRAC:
3799 : case t_VEC: case t_COL: case t_MAT:
3800 504 : pari_APPLY_same(liftint_shallow(gel(x,i)));
3801 56 : default: return x;
3802 : }
3803 : }
3804 : GEN
3805 119 : liftint(GEN x)
3806 119 : { pari_sp av = avma; return gerepilecopy(av, liftint_shallow(x)); }
3807 :
3808 : GEN
3809 21204296 : liftpol_shallow(GEN x)
3810 : {
3811 : GEN y;
3812 21204296 : switch(typ(x))
3813 : {
3814 2044099 : case t_POLMOD:
3815 2044099 : return liftpol_shallow(gel(x,2));
3816 2821866 : case t_POL:
3817 11728095 : pari_APPLY_pol(liftpol_shallow(gel(x,i)));
3818 7 : case t_SER:
3819 7 : if (ser_isexactzero(x))
3820 : {
3821 0 : if (lg(x) == 2) return x;
3822 0 : y = scalarser(liftpol(gel(x,2)), varn(x), 1);
3823 0 : setvalser(y, valser(x)); return y;
3824 : }
3825 35 : pari_APPLY_ser(liftpol_shallow(gel(x,i)));
3826 131943 : case t_RFRAC: case t_VEC: case t_COL: case t_MAT:
3827 945910 : pari_APPLY_same(liftpol_shallow(gel(x,i)));
3828 16206381 : default: return x;
3829 : }
3830 : }
3831 : GEN
3832 5656 : liftpol(GEN x)
3833 5656 : { pari_sp av = avma; return gerepilecopy(av, liftpol_shallow(x)); }
3834 :
3835 : static GEN
3836 42518 : centerliftii(GEN x, GEN y)
3837 : {
3838 42518 : pari_sp av = avma;
3839 42518 : long i = cmpii(shifti(x,1), y);
3840 42518 : set_avma(av); return (i > 0)? subii(x,y): icopy(x);
3841 : }
3842 :
3843 : /* see lift0 */
3844 : GEN
3845 707 : centerlift0(GEN x, long v)
3846 707 : { return v < 0? centerlift(x): lift0(x,v); }
3847 : GEN
3848 60473 : centerlift(GEN x)
3849 : {
3850 : long v;
3851 : GEN y;
3852 60473 : switch(typ(x))
3853 : {
3854 784 : case t_INT: return icopy(x);
3855 784 : case t_INTMOD: return centerliftii(gel(x,2), gel(x,1));
3856 7 : case t_POLMOD: return gcopy(gel(x,2));
3857 1554 : case t_POL:
3858 9912 : pari_APPLY_pol(centerlift(gel(x,i)));
3859 7 : case t_SER:
3860 7 : if (ser_isexactzero(x)) return lift(x);
3861 35 : pari_APPLY_ser(centerlift(gel(x,i)));
3862 5551 : case t_COMPLEX: case t_QUAD: case t_RFRAC:
3863 : case t_VEC: case t_COL: case t_MAT:
3864 56210 : pari_APPLY_same(centerlift(gel(x,i)));
3865 51779 : case t_PADIC:
3866 51779 : if (!signe(gel(x,4))) return gen_0;
3867 41734 : v = valp(x);
3868 41734 : if (v>=0)
3869 : { /* here p^v is an integer */
3870 41727 : GEN z = centerliftii(gel(x,4), gel(x,3));
3871 : pari_sp av;
3872 41727 : if (!v) return z;
3873 27027 : av = avma; y = powiu(gel(x,2),v);
3874 27027 : return gerepileuptoint(av, mulii(y,z));
3875 : }
3876 7 : y = cgetg(3,t_FRAC);
3877 7 : gel(y,1) = centerliftii(gel(x,4), gel(x,3));
3878 7 : gel(y,2) = powiu(gel(x,2),-v);
3879 7 : return y;
3880 7 : default: return gcopy(x);
3881 : }
3882 : }
3883 :
3884 : /*******************************************************************/
3885 : /* */
3886 : /* REAL & IMAGINARY PARTS */
3887 : /* */
3888 : /*******************************************************************/
3889 :
3890 : static GEN
3891 125554335 : op_ReIm(GEN f(GEN), GEN x)
3892 : {
3893 125554335 : switch(typ(x))
3894 : {
3895 384572987 : case t_POL: pari_APPLY_pol(f(gel(x,i)));
3896 63154 : case t_SER: pari_APPLY_ser(f(gel(x,i)));
3897 42 : case t_RFRAC: {
3898 42 : pari_sp av = avma;
3899 42 : GEN n, d, dxb = conj_i(gel(x,2));
3900 42 : n = gmul(gel(x,1), dxb);
3901 42 : d = gmul(gel(x,2), dxb);
3902 42 : return gerepileupto(av, gdiv(f(n), d));
3903 : }
3904 32610533 : case t_VEC: case t_COL: case t_MAT: pari_APPLY_same(f(gel(x, i)));
3905 : }
3906 12 : pari_err_TYPE("greal/gimag",x);
3907 : return NULL; /* LCOV_EXCL_LINE */
3908 : }
3909 :
3910 : GEN
3911 226544179 : real_i(GEN x)
3912 : {
3913 226544179 : switch(typ(x))
3914 : {
3915 108184437 : case t_INT: case t_REAL: case t_FRAC:
3916 108184437 : return x;
3917 51948714 : case t_COMPLEX:
3918 51948714 : return gel(x,1);
3919 0 : case t_QUAD:
3920 0 : return gel(x,2);
3921 : }
3922 66411028 : return op_ReIm(real_i,x);
3923 : }
3924 : GEN
3925 194242174 : imag_i(GEN x)
3926 : {
3927 194242174 : switch(typ(x))
3928 : {
3929 103810144 : case t_INT: case t_REAL: case t_FRAC:
3930 103810144 : return gen_0;
3931 31388139 : case t_COMPLEX:
3932 31388139 : return gel(x,2);
3933 0 : case t_QUAD:
3934 0 : return gel(x,3);
3935 : }
3936 59043891 : return op_ReIm(imag_i,x);
3937 : }
3938 : GEN
3939 6146 : greal(GEN x)
3940 : {
3941 6146 : switch(typ(x))
3942 : {
3943 707 : case t_INT: case t_REAL:
3944 707 : return mpcopy(x);
3945 :
3946 7 : case t_FRAC:
3947 7 : return gcopy(x);
3948 :
3949 5187 : case t_COMPLEX:
3950 5187 : return gcopy(gel(x,1));
3951 :
3952 7 : case t_QUAD:
3953 7 : return gcopy(gel(x,2));
3954 : }
3955 238 : return op_ReIm(greal,x);
3956 : }
3957 : GEN
3958 29316 : gimag(GEN x)
3959 : {
3960 29316 : switch(typ(x))
3961 : {
3962 525 : case t_INT: case t_REAL: case t_FRAC:
3963 525 : return gen_0;
3964 :
3965 28189 : case t_COMPLEX:
3966 28189 : return gcopy(gel(x,2));
3967 :
3968 7 : case t_QUAD:
3969 7 : return gcopy(gel(x,3));
3970 : }
3971 595 : return op_ReIm(gimag,x);
3972 : }
3973 :
3974 : /* return Re(x * y), x and y scalars */
3975 : GEN
3976 11342760 : mulreal(GEN x, GEN y)
3977 : {
3978 11342760 : if (typ(x) == t_COMPLEX)
3979 : {
3980 11206369 : if (typ(y) == t_COMPLEX)
3981 : {
3982 10390660 : pari_sp av = avma;
3983 10390660 : GEN a = gmul(gel(x,1), gel(y,1));
3984 10390646 : GEN b = gmul(gel(x,2), gel(y,2));
3985 10390655 : return gerepileupto(av, gsub(a, b));
3986 : }
3987 815709 : x = gel(x,1);
3988 : }
3989 : else
3990 136391 : if (typ(y) == t_COMPLEX) y = gel(y,1);
3991 952100 : return gmul(x,y);
3992 : }
3993 : /* Compute Re(x * y), x and y matrices of compatible dimensions
3994 : * assume scalar entries */
3995 : GEN
3996 0 : RgM_mulreal(GEN x, GEN y)
3997 : {
3998 0 : long i, j, k, l, lx = lg(x), ly = lg(y);
3999 0 : GEN z = cgetg(ly,t_MAT);
4000 0 : l = (lx == 1)? 1: lgcols(x);
4001 0 : for (j=1; j<ly; j++)
4002 : {
4003 0 : GEN zj = cgetg(l,t_COL), yj = gel(y,j);
4004 0 : gel(z,j) = zj;
4005 0 : for (i=1; i<l; i++)
4006 : {
4007 0 : pari_sp av = avma;
4008 0 : GEN c = mulreal(gcoeff(x,i,1),gel(yj,1));
4009 0 : for (k=2; k<lx; k++) c = gadd(c, mulreal(gcoeff(x,i,k),gel(yj,k)));
4010 0 : gel(zj, i) = gerepileupto(av, c);
4011 : }
4012 : }
4013 0 : return z;
4014 : }
4015 :
4016 : /* Compute Re(x * y), symmetric result, x and y vectors of compatible
4017 : * dimensions; assume scalar entries */
4018 : GEN
4019 21273 : RgC_RgV_mulrealsym(GEN x, GEN y)
4020 : {
4021 21273 : long i, j, l = lg(x);
4022 21273 : GEN q = cgetg(l, t_MAT);
4023 85092 : for (j = 1; j < l; j++)
4024 : {
4025 63819 : gel(q,j) = cgetg(l,t_COL);
4026 191457 : for (i = 1; i <= j; i++)
4027 127638 : gcoeff(q,i,j) = gcoeff(q,j,i) = mulreal(gel(x,i), gel(y,j));
4028 : }
4029 21273 : return q;
4030 : }
4031 :
4032 : /*******************************************************************/
4033 : /* */
4034 : /* LOGICAL OPERATIONS */
4035 : /* */
4036 : /*******************************************************************/
4037 : static long
4038 107910347 : _egal_i(GEN x, GEN y)
4039 : {
4040 107910347 : x = simplify_shallow(x);
4041 107910385 : y = simplify_shallow(y);
4042 107910397 : if (typ(y) == t_INT)
4043 : {
4044 106941037 : if (equali1(y)) return gequal1(x);
4045 61779891 : if (equalim1(y)) return gequalm1(x);
4046 : }
4047 969360 : else if (typ(x) == t_INT)
4048 : {
4049 133 : if (equali1(x)) return gequal1(y);
4050 84 : if (equalim1(x)) return gequalm1(y);
4051 : }
4052 62617659 : return gequal(x, y);
4053 : }
4054 : static long
4055 107910340 : _egal(GEN x, GEN y)
4056 107910340 : { pari_sp av = avma; return gc_long(av, _egal_i(x, y)); }
4057 :
4058 : GEN
4059 6103955 : glt(GEN x, GEN y) { return gcmp(x,y)<0? gen_1: gen_0; }
4060 :
4061 : GEN
4062 7628273 : gle(GEN x, GEN y) { return gcmp(x,y)<=0? gen_1: gen_0; }
4063 :
4064 : GEN
4065 136428 : gge(GEN x, GEN y) { return gcmp(x,y)>=0? gen_1: gen_0; }
4066 :
4067 : GEN
4068 2341868 : ggt(GEN x, GEN y) { return gcmp(x,y)>0? gen_1: gen_0; }
4069 :
4070 : GEN
4071 47184340 : geq(GEN x, GEN y) { return _egal(x,y)? gen_1: gen_0; }
4072 :
4073 : GEN
4074 60725994 : gne(GEN x, GEN y) { return _egal(x,y)? gen_0: gen_1; }
4075 :
4076 : GEN
4077 573706 : gnot(GEN x) { return gequal0(x)? gen_1: gen_0; }
4078 :
4079 : /*******************************************************************/
4080 : /* */
4081 : /* FORMAL SIMPLIFICATIONS */
4082 : /* */
4083 : /*******************************************************************/
4084 :
4085 : GEN
4086 10817 : geval_gp(GEN x, GEN t)
4087 : {
4088 10817 : long lx, i, tx = typ(x);
4089 : pari_sp av;
4090 : GEN y, z;
4091 :
4092 10817 : if (is_const_t(tx) || tx==t_VECSMALL) return gcopy(x);
4093 10796 : switch(tx)
4094 : {
4095 10789 : case t_STR:
4096 10789 : return localvars_read_str(GSTR(x),t);
4097 :
4098 0 : case t_POLMOD:
4099 0 : av = avma;
4100 0 : return gerepileupto(av, gmodulo(geval_gp(gel(x,2),t),
4101 0 : geval_gp(gel(x,1),t)));
4102 :
4103 7 : case t_POL:
4104 7 : lx=lg(x); if (lx==2) return gen_0;
4105 7 : z = fetch_var_value(varn(x),t);
4106 7 : if (!z) return RgX_copy(x);
4107 7 : av = avma; y = geval_gp(gel(x,lx-1),t);
4108 14 : for (i=lx-2; i>1; i--)
4109 7 : y = gadd(geval_gp(gel(x,i),t), gmul(z,y));
4110 7 : return gerepileupto(av, y);
4111 :
4112 0 : case t_SER:
4113 0 : pari_err_IMPL( "evaluation of a power series");
4114 :
4115 0 : case t_RFRAC:
4116 0 : av = avma;
4117 0 : return gerepileupto(av, gdiv(geval_gp(gel(x,1),t), geval_gp(gel(x,2),t)));
4118 :
4119 0 : case t_QFB: case t_VEC: case t_COL: case t_MAT:
4120 0 : pari_APPLY_same(geval_gp(gel(x,i),t));
4121 :
4122 0 : case t_CLOSURE:
4123 0 : if (closure_arity(x) || closure_is_variadic(x))
4124 0 : pari_err_IMPL("eval on functions with parameters");
4125 0 : return closure_evalres(x);
4126 : }
4127 0 : pari_err_TYPE("geval",x);
4128 : return NULL; /* LCOV_EXCL_LINE */
4129 : }
4130 : GEN
4131 0 : geval(GEN x) { return geval_gp(x,NULL); }
4132 :
4133 : GEN
4134 526598064 : simplify_shallow(GEN x)
4135 : {
4136 : long v, lx;
4137 : GEN y, z;
4138 526598064 : if (!x) pari_err_BUG("simplify, NULL input");
4139 :
4140 526598067 : switch(typ(x))
4141 : {
4142 443707070 : case t_INT: case t_REAL: case t_INTMOD: case t_FRAC: case t_FFELT:
4143 : case t_PADIC: case t_QFB: case t_LIST: case t_STR: case t_VECSMALL:
4144 : case t_CLOSURE: case t_ERROR: case t_INFINITY:
4145 443707070 : return x;
4146 731531 : case t_COMPLEX: return isintzero(gel(x,2))? gel(x,1): x;
4147 805 : case t_QUAD: return isintzero(gel(x,3))? gel(x,2): x;
4148 :
4149 196726 : case t_POLMOD: y = cgetg(3,t_POLMOD);
4150 196726 : z = gel(x,1); v = varn(z); z = simplify_shallow(z);
4151 196726 : if (typ(z) != t_POL || varn(z) != v) z = scalarpol_shallow(z, v);
4152 196726 : gel(y,1) = z;
4153 196726 : gel(y,2) = simplify_shallow(gel(x,2)); return y;
4154 :
4155 69025763 : case t_POL:
4156 69025763 : lx = lg(x);
4157 69025763 : if (lx==2) return gen_0;
4158 61431457 : if (lx==3) return simplify_shallow(gel(x,2));
4159 198161828 : pari_APPLY_pol(simplify_shallow(gel(x,i)));
4160 :
4161 3437 : case t_SER:
4162 1064525 : pari_APPLY_ser(simplify_shallow(gel(x,i)));
4163 :
4164 651845 : case t_RFRAC: y = cgetg(3,t_RFRAC);
4165 651845 : gel(y,1) = simplify_shallow(gel(x,1));
4166 651845 : z = simplify_shallow(gel(x,2));
4167 651845 : if (typ(z) != t_POL) return gdiv(gel(y,1), z);
4168 651845 : gel(y,2) = z; return y;
4169 :
4170 12280890 : case t_VEC: case t_COL: case t_MAT:
4171 67890910 : pari_APPLY_same(simplify_shallow(gel(x,i)));
4172 : }
4173 0 : pari_err_BUG("simplify_shallow, type unknown");
4174 : return NULL; /* LCOV_EXCL_LINE */
4175 : }
4176 :
4177 : GEN
4178 10809864 : simplify(GEN x)
4179 : {
4180 10809864 : pari_sp av = avma;
4181 10809864 : GEN y = simplify_shallow(x);
4182 10809864 : return av == avma ? gcopy(y): gerepilecopy(av, y);
4183 : }
4184 :
4185 : /*******************************************************************/
4186 : /* */
4187 : /* EVALUATION OF SOME SIMPLE OBJECTS */
4188 : /* */
4189 : /*******************************************************************/
4190 : /* q is a real symmetric matrix, x a RgV. Horner-type evaluation of q(x)
4191 : * using (n^2+3n-2)/2 mul */
4192 : GEN
4193 16714 : qfeval(GEN q, GEN x)
4194 : {
4195 16714 : pari_sp av = avma;
4196 16714 : long i, j, l = lg(q);
4197 : GEN z;
4198 16714 : if (lg(x) != l) pari_err_DIM("qfeval");
4199 16707 : if (l==1) return gen_0;
4200 16707 : if (lgcols(q) != l) pari_err_DIM("qfeval");
4201 : /* l = lg(x) = lg(q) > 1 */
4202 16700 : z = gmul(gcoeff(q,1,1), gsqr(gel(x,1)));
4203 72866 : for (i=2; i<l; i++)
4204 : {
4205 56166 : GEN c = gel(q,i), s;
4206 56166 : if (isintzero(gel(x,i))) continue;
4207 42163 : s = gmul(gel(c,1), gel(x,1));
4208 125921 : for (j=2; j<i; j++) s = gadd(s, gmul(gel(c,j),gel(x,j)));
4209 42163 : s = gadd(gshift(s,1), gmul(gel(c,i),gel(x,i)));
4210 42163 : z = gadd(z, gmul(gel(x,i), s));
4211 : }
4212 16700 : return gerepileupto(av,z);
4213 : }
4214 :
4215 : static GEN
4216 347816 : qfbeval(GEN q, GEN z)
4217 : {
4218 347816 : GEN A, a = gel(q,1), b = gel(q,2), c = gel(q,3), x = gel(z,1), y = gel(z,2);
4219 347816 : pari_sp av = avma;
4220 347816 : A = gadd(gmul(x, gadd(gmul(a,x), gmul(b,y))), gmul(c, gsqr(y)));
4221 347816 : return gerepileupto(av, A);
4222 : }
4223 : static GEN
4224 7 : qfbevalb(GEN q, GEN z, GEN z2)
4225 : {
4226 7 : GEN A, a = gel(q,1), b = gel(q,2), c = gel(q,3);
4227 7 : GEN x = gel(z,1), y = gel(z,2);
4228 7 : GEN X = gel(z2,1), Y = gel(z2,2);
4229 7 : GEN a2 = shifti(a,1), c2 = shifti(c,1);
4230 7 : pari_sp av = avma;
4231 : /* a2 x X + b (x Y + X y) + c2 y Y */
4232 7 : A = gadd(gmul(x, gadd(gmul(a2,X), gmul(b,Y))),
4233 : gmul(y, gadd(gmul(c2,Y), gmul(b,X))));
4234 7 : return gerepileupto(av, gmul2n(A, -1));
4235 : }
4236 : GEN
4237 42 : qfb_apply_ZM(GEN q, GEN M)
4238 : {
4239 42 : pari_sp av = avma;
4240 42 : GEN A, B, C, a = gel(q,1), b = gel(q,2), c = gel(q,3);
4241 42 : GEN x = gcoeff(M,1,1), y = gcoeff(M,2,1);
4242 42 : GEN z = gcoeff(M,1,2), t = gcoeff(M,2,2);
4243 42 : GEN by = mulii(b,y), bt = mulii(b,t), bz = mulii(b,z);
4244 42 : GEN a2 = shifti(a,1), c2 = shifti(c,1);
4245 :
4246 42 : A = addii(mulii(x, addii(mulii(a,x), by)), mulii(c, sqri(y)));
4247 42 : B = addii(mulii(x, addii(mulii(a2,z), bt)),
4248 : mulii(y, addii(mulii(c2,t), bz)));
4249 42 : C = addii(mulii(z, addii(mulii(a,z), bt)), mulii(c, sqri(t)));
4250 42 : q = leafcopy(q);
4251 42 : gel(q,1) = A; gel(q,2) = B; gel(q,3) = C;
4252 42 : return gerepilecopy(av, q);
4253 : }
4254 :
4255 : static GEN
4256 347879 : qfnorm0(GEN q, GEN x)
4257 : {
4258 347879 : if (!q) switch(typ(x))
4259 : {
4260 7 : case t_VEC: case t_COL: return RgV_dotsquare(x);
4261 7 : case t_MAT: return gram_matrix(x);
4262 7 : default: pari_err_TYPE("qfeval",x);
4263 : }
4264 347858 : switch(typ(q))
4265 : {
4266 28 : case t_MAT: break;
4267 347823 : case t_QFB:
4268 347823 : if (lg(x) == 3) switch(typ(x))
4269 : {
4270 347816 : case t_VEC:
4271 347816 : case t_COL: return qfbeval(q,x);
4272 7 : case t_MAT: if (RgM_is_ZM(x)) return qfb_apply_ZM(q,x);
4273 0 : default: pari_err_TYPE("qfeval",x);
4274 : }
4275 7 : default: pari_err_TYPE("qfeval",q);
4276 : }
4277 28 : switch(typ(x))
4278 : {
4279 21 : case t_VEC: case t_COL: break;
4280 7 : case t_MAT: return qf_apply_RgM(q, x);
4281 0 : default: pari_err_TYPE("qfeval",x);
4282 : }
4283 21 : return qfeval(q,x);
4284 : }
4285 : /* obsolete, use qfeval0 */
4286 : GEN
4287 0 : qfnorm(GEN x, GEN q) { return qfnorm0(q,x); }
4288 :
4289 : /* assume q is square, x~ * q * y using n^2+n mul */
4290 : GEN
4291 21 : qfevalb(GEN q, GEN x, GEN y)
4292 : {
4293 21 : pari_sp av = avma;
4294 21 : long l = lg(q);
4295 21 : if (lg(x) != l || lg(y) != l) pari_err_DIM("qfevalb");
4296 14 : return gerepileupto(av, RgV_dotproduct(RgV_RgM_mul(x,q), y));
4297 : }
4298 :
4299 : /* obsolete, use qfeval0 */
4300 : GEN
4301 0 : qfbil(GEN x, GEN y, GEN q)
4302 : {
4303 0 : if (!is_vec_t(typ(x))) pari_err_TYPE("qfbil",x);
4304 0 : if (!is_vec_t(typ(y))) pari_err_TYPE("qfbil",y);
4305 0 : if (!q) {
4306 0 : if (lg(x) != lg(y)) pari_err_DIM("qfbil");
4307 0 : return RgV_dotproduct(x,y);
4308 : }
4309 0 : if (typ(q) != t_MAT) pari_err_TYPE("qfbil",q);
4310 0 : return qfevalb(q,x,y);
4311 : }
4312 : GEN
4313 347935 : qfeval0(GEN q, GEN x, GEN y)
4314 : {
4315 347935 : if (!y) return qfnorm0(q, x);
4316 56 : if (!is_vec_t(typ(x))) pari_err_TYPE("qfeval",x);
4317 42 : if (!is_vec_t(typ(y))) pari_err_TYPE("qfeval",y);
4318 42 : if (!q) {
4319 14 : if (lg(x) != lg(y)) pari_err_DIM("qfeval");
4320 7 : return RgV_dotproduct(x,y);
4321 : }
4322 28 : switch(typ(q))
4323 : {
4324 21 : case t_MAT: break;
4325 7 : case t_QFB:
4326 7 : if (lg(x) == 3 && lg(y) == 3) return qfbevalb(q,x,y);
4327 0 : default: pari_err_TYPE("qfeval",q);
4328 : }
4329 21 : return qfevalb(q,x,y);
4330 : }
4331 :
4332 : /* q a hermitian complex matrix, x a RgV */
4333 : GEN
4334 0 : hqfeval(GEN q, GEN x)
4335 : {
4336 0 : pari_sp av = avma;
4337 0 : long i, j, l = lg(q);
4338 : GEN z, xc;
4339 :
4340 0 : if (lg(x) != l) pari_err_DIM("hqfeval");
4341 0 : if (l==1) return gen_0;
4342 0 : if (lgcols(q) != l) pari_err_DIM("hqfeval");
4343 0 : if (l == 2) return gerepileupto(av, gmul(gcoeff(q,1,1), gnorm(gel(x,1))));
4344 : /* l = lg(x) = lg(q) > 2 */
4345 0 : xc = conj_i(x);
4346 0 : z = mulreal(gcoeff(q,2,1), gmul(gel(x,2),gel(xc,1)));
4347 0 : for (i=3;i<l;i++)
4348 0 : for (j=1;j<i;j++)
4349 0 : z = gadd(z, mulreal(gcoeff(q,i,j), gmul(gel(x,i),gel(xc,j))));
4350 0 : z = gshift(z,1);
4351 0 : for (i=1;i<l;i++) z = gadd(z, gmul(gcoeff(q,i,i), gnorm(gel(x,i))));
4352 0 : return gerepileupto(av,z);
4353 : }
4354 :
4355 : static void
4356 498912 : init_qf_apply(GEN q, GEN M, long *l)
4357 : {
4358 498912 : long k = lg(M);
4359 498912 : *l = lg(q);
4360 498912 : if (*l == 1) { if (k == 1) return; }
4361 498905 : else { if (k != 1 && lgcols(M) == *l) return; }
4362 0 : pari_err_DIM("qf_apply_RgM");
4363 : }
4364 : /* Return X = M'.q.M, assuming q is a symmetric matrix and M is a
4365 : * matrix of compatible dimensions. X_ij are X_ji identical, not copies */
4366 : GEN
4367 7601 : qf_apply_RgM(GEN q, GEN M)
4368 : {
4369 7601 : pari_sp av = avma;
4370 7601 : long l; init_qf_apply(q, M, &l); if (l == 1) return cgetg(1, t_MAT);
4371 7601 : return gerepileupto(av, RgM_transmultosym(M, RgM_mul(q, M)));
4372 : }
4373 : GEN
4374 491311 : qf_apply_ZM(GEN q, GEN M)
4375 : {
4376 491311 : pari_sp av = avma;
4377 491311 : long l; init_qf_apply(q, M, &l); if (l == 1) return cgetg(1, t_MAT);
4378 491304 : return gerepileupto(av, ZM_transmultosym(M, ZM_mul(q, M)));
4379 : }
4380 :
4381 : GEN
4382 2942841 : poleval(GEN x, GEN y)
4383 : {
4384 2942841 : long i, j, imin, tx = typ(x);
4385 2942841 : pari_sp av0 = avma, av;
4386 : GEN t, t2, r, s;
4387 :
4388 2942841 : if (is_scalar_t(tx)) return gcopy(x);
4389 2758346 : switch(tx)
4390 : {
4391 2709103 : case t_POL:
4392 2709103 : i = lg(x)-1; imin = 2; break;
4393 :
4394 1568 : case t_RFRAC:
4395 1568 : return gerepileupto(av0, gdiv(poleval(gel(x,1),y),
4396 1568 : poleval(gel(x,2),y)));
4397 :
4398 47675 : case t_VEC: case t_COL:
4399 47675 : i = lg(x)-1; imin = 1; break;
4400 0 : default: pari_err_TYPE("poleval",x);
4401 : return NULL; /* LCOV_EXCL_LINE */
4402 : }
4403 2756778 : if (i<=imin) return (i==imin)? gmul(gel(x,imin),Rg_get_1(y)): Rg_get_0(y);
4404 2613713 : if (isintzero(y)) return gcopy(gel(x,imin));
4405 :
4406 2606685 : t = gel(x,i); i--;
4407 2606685 : if (typ(y)!=t_COMPLEX)
4408 : {
4409 : #if 0 /* standard Horner's rule */
4410 : for ( ; i>=imin; i--)
4411 : t = gadd(gmul(t,y),gel(x,i));
4412 : #endif
4413 : /* specific attention to sparse polynomials */
4414 18592918 : for ( ; i>=imin; i=j-1)
4415 : {
4416 18785943 : for (j=i; isexactzero(gel(x,j)); j--)
4417 2701774 : if (j==imin)
4418 : {
4419 972150 : if (i!=j) y = gpowgs(y, i-j+1);
4420 972150 : return gerepileupto(av0, gmul(t,y));
4421 : }
4422 16084168 : r = (i==j)? y: gpowgs(y, i-j+1);
4423 16084168 : t = gadd(gmul(t,r), gel(x,j));
4424 16084122 : if (gc_needed(av0,2))
4425 : {
4426 103 : if (DEBUGMEM>1) pari_warn(warnmem,"poleval: i = %ld",i);
4427 103 : t = gerepileupto(av0, t);
4428 : }
4429 : }
4430 1536599 : return gerepileupto(av0, t);
4431 : }
4432 :
4433 97889 : t2 = gel(x,i); i--; r = gtrace(y); s = gneg_i(gnorm(y));
4434 97889 : av = avma;
4435 4124642 : for ( ; i>=imin; i--)
4436 : {
4437 4026753 : GEN p = gadd(t2, gmul(r, t));
4438 4026753 : t2 = gadd(gel(x,i), gmul(s, t)); t = p;
4439 4026753 : if (gc_needed(av0,2))
4440 : {
4441 0 : if (DEBUGMEM>1) pari_warn(warnmem,"poleval: i = %ld",i);
4442 0 : gerepileall(av, 2, &t, &t2);
4443 : }
4444 : }
4445 97889 : return gerepileupto(av0, gadd(t2, gmul(y, t)));
4446 : }
4447 :
4448 : /* Evaluate a polynomial using Horner. Unstable!
4449 : * If ui != NULL, ui = 1/u, evaluate P(1/u)*u^(deg P): useful for |u|>1 */
4450 : GEN
4451 2256507 : RgX_cxeval(GEN T, GEN u, GEN ui)
4452 : {
4453 2256507 : pari_sp ltop = avma;
4454 : GEN S;
4455 2256507 : long n, lim = lg(T)-1;
4456 2256507 : if (lim == 1) return gen_0;
4457 2256507 : if (lim == 2) return gcopy(gel(T,2));
4458 2255436 : if (!ui)
4459 : {
4460 1512229 : n = lim; S = gel(T,n);
4461 14320915 : for (n--; n >= 2; n--) S = gadd(gmul(u,S), gel(T,n));
4462 : }
4463 : else
4464 : {
4465 743207 : n = 2; S = gel(T,2);
4466 4494984 : for (n++; n <= lim; n++) S = gadd(gmul(ui,S), gel(T,n));
4467 743195 : S = gmul(gpowgs(u, lim-2), S);
4468 : }
4469 2255185 : return gerepileupto(ltop, S);
4470 : }
4471 :
4472 : GEN
4473 63 : RgXY_cxevalx(GEN x, GEN u, GEN ui)
4474 : {
4475 427 : pari_APPLY_pol(typ(gel(x,i))==t_POL? RgX_cxeval(gel(x,i), u, ui): gel(x,i));
4476 : }
|
