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 : /** (second part) **/
19 : /** **/
20 : /********************************************************************/
21 : #include "pari.h"
22 : #include "paripriv.h"
23 :
24 : /*********************************************************************/
25 : /** **/
26 : /** MAP FUNCTIONS WITH GIVEN PROTOTYPES **/
27 : /** **/
28 : /*********************************************************************/
29 : GEN
30 462 : map_proto_G(GEN (*f)(GEN), GEN x)
31 : {
32 462 : if (is_matvec_t(typ(x))) pari_APPLY_same(map_proto_G(f, gel(x,i)));
33 462 : return f(x);
34 : }
35 :
36 : GEN
37 37253320 : map_proto_lG(long (*f)(GEN), GEN x)
38 : {
39 37253404 : if (is_matvec_t(typ(x))) pari_APPLY_same(map_proto_lG(f, gel(x,i)));
40 37231636 : return stoi(f(x));
41 : }
42 :
43 : GEN
44 126 : map_proto_lGL(long (*f)(GEN,long), GEN x, long y)
45 : {
46 154 : if (is_matvec_t(typ(x))) pari_APPLY_same(map_proto_lGL(f,gel(x,i),y));
47 119 : return stoi(f(x,y));
48 : }
49 :
50 : static GEN
51 2205289 : _domul(void *data, GEN x, GEN y)
52 : {
53 2205289 : GEN (*mul)(GEN,GEN)=(GEN (*)(GEN,GEN)) data;
54 2205289 : return mul(x,y);
55 : }
56 :
57 : GEN
58 2419288 : gassoc_proto(GEN (*f)(GEN,GEN), GEN x, GEN y)
59 : {
60 2419288 : if (!y)
61 : {
62 2419288 : pari_sp av = avma;
63 2419288 : switch(typ(x))
64 : {
65 21 : case t_LIST:
66 21 : x = list_data(x); if (!x) return gen_1;
67 : case t_VEC:
68 2419274 : case t_COL: break;
69 7 : default: pari_err_TYPE("association",x);
70 : }
71 2419274 : return gerepileupto(av, gen_product(x, (void *)f, _domul));
72 :
73 : }
74 0 : return f(x,y);
75 : }
76 : /*******************************************************************/
77 : /* */
78 : /* CREATION OF A P-ADIC GEN */
79 : /* */
80 : /*******************************************************************/
81 : GEN
82 16932385 : cgetp(GEN x)
83 : {
84 16932385 : GEN y = cgetg(5,t_PADIC);
85 16932354 : y[1] = (x[1]&PRECPBITS) | _evalvalp(0);
86 16932354 : gel(y,2) = icopy(gel(x,2));
87 16932257 : gel(y,3) = icopy(gel(x,3));
88 16932307 : gel(y,4) = cgeti(lgefint(gel(x,3))); return y;
89 : }
90 :
91 : /*******************************************************************/
92 : /* */
93 : /* SIZES */
94 : /* */
95 : /*******************************************************************/
96 :
97 : long
98 5145683 : glength(GEN x)
99 : {
100 5145683 : long tx = typ(x);
101 5145683 : switch(tx)
102 : {
103 126 : case t_INT: return lgefint(x)-2;
104 609 : case t_LIST: {
105 609 : GEN L = list_data(x);
106 609 : return L? lg(L)-1: 0;
107 : }
108 14 : case t_REAL: return signe(x)? lg(x)-2: 0;
109 11 : case t_STR: return strlen( GSTR(x) );
110 91 : case t_VECSMALL: return lg(x)-1;
111 : }
112 5144832 : return lg(x) - lontyp[tx];
113 : }
114 :
115 : long
116 3878 : gtranslength(GEN x)
117 : {
118 3878 : switch(typ(x))
119 : {
120 0 : case t_VEC: case t_COL:
121 0 : return lg(x)-1;
122 3878 : case t_MAT:
123 3878 : return lg(x)==1 ? 0: nbrows(x);
124 0 : default:
125 0 : pari_err_TYPE("trans",x);
126 : return 0; /* LCOV_EXCL_LINE */
127 : }
128 : }
129 :
130 : GEN
131 1862 : matsize(GEN x)
132 : {
133 1862 : long L = lg(x) - 1;
134 1862 : switch(typ(x))
135 : {
136 7 : case t_VEC: return mkvec2s(1, L);
137 7 : case t_COL: return mkvec2s(L, 1);
138 1841 : case t_MAT: return mkvec2s(L? nbrows(x): 0, L);
139 : }
140 7 : pari_err_TYPE("matsize",x);
141 : return NULL; /* LCOV_EXCL_LINE */
142 : }
143 :
144 : /*******************************************************************/
145 : /* */
146 : /* CONVERSION GEN --> long */
147 : /* */
148 : /*******************************************************************/
149 :
150 : long
151 77 : gtolong(GEN x)
152 : {
153 77 : switch(typ(x))
154 : {
155 42 : case t_INT:
156 42 : return itos(x);
157 7 : case t_REAL:
158 7 : return (long)(rtodbl(x) + 0.5);
159 7 : case t_FRAC:
160 7 : { pari_sp av = avma; return gc_long(av, itos(ground(x))); }
161 7 : case t_COMPLEX:
162 7 : if (gequal0(gel(x,2))) return gtolong(gel(x,1)); break;
163 7 : case t_QUAD:
164 7 : if (gequal0(gel(x,3))) return gtolong(gel(x,2)); break;
165 : }
166 7 : pari_err_TYPE("gtolong",x);
167 : return 0; /* LCOV_EXCL_LINE */
168 : }
169 :
170 : /*******************************************************************/
171 : /* */
172 : /* COMPARISONS */
173 : /* */
174 : /*******************************************************************/
175 : static void
176 189 : chk_true_err()
177 : {
178 189 : GEN E = pari_err_last();
179 189 : switch(err_get_num(E))
180 : {
181 0 : case e_STACK: case e_MEM: case e_ALARM:
182 0 : pari_err(0, E); /* rethrow */
183 : }
184 189 : }
185 : /* x - y == 0 or undefined */
186 : static int
187 3187231 : gequal_try(GEN x, GEN y)
188 : {
189 : int i;
190 3187231 : pari_CATCH(CATCH_ALL) { chk_true_err(); return 0; }
191 3187231 : pari_TRY { i = gequal0(gadd(x, gneg_i(y))); } pari_ENDCATCH;
192 3187049 : return i;
193 : }
194 : /* x + y == 0 or undefined */
195 : static int
196 28 : gmequal_try(GEN x, GEN y)
197 : {
198 : int i;
199 28 : pari_CATCH(CATCH_ALL) { chk_true_err(); return 0; }
200 28 : pari_TRY { i = gequal0(gadd(x, y)); } pari_ENDCATCH;
201 21 : return i;
202 : }
203 :
204 : int
205 455939474 : isexactzero(GEN g)
206 : {
207 : long i, lx;
208 455939474 : switch (typ(g))
209 : {
210 397817404 : case t_INT:
211 397817404 : return !signe(g);
212 1095079 : case t_INTMOD:
213 1095079 : return !signe(gel(g,2));
214 14831244 : case t_COMPLEX:
215 14831244 : return isexactzero(gel(g,1)) && isexactzero(gel(g,2));
216 8109581 : case t_FFELT:
217 8109581 : return FF_equal0(g);
218 490 : case t_QUAD:
219 490 : return isexactzero(gel(g,2)) && isexactzero(gel(g,3));
220 278170 : case t_POLMOD:
221 278170 : return isexactzero(gel(g,2));
222 12359186 : case t_POL:
223 12359186 : lx = lg(g); /* cater for Mod(0,2)*x^0 */
224 12359186 : return lx == 2 || (lx == 3 && isexactzero(gel(g,2)));
225 460422 : case t_RFRAC:
226 460422 : return isexactzero(gel(g,1)); /* may occur: Mod(0,2)/x */
227 43393 : case t_VEC: case t_COL: case t_MAT:
228 43694 : for (i=lg(g)-1; i; i--)
229 43589 : if (!isexactzero(gel(g,i))) return 0;
230 105 : return 1;
231 : }
232 20944505 : return 0;
233 : }
234 : GEN
235 62301498 : gisexactzero(GEN g)
236 : {
237 : long i, lx;
238 : GEN a, b;
239 62301498 : switch (typ(g))
240 : {
241 26746677 : case t_INT:
242 26746677 : return !signe(g)? g: NULL;
243 5639984 : case t_INTMOD:
244 5639984 : return !signe(gel(g,2))? g: NULL;
245 2632 : case t_COMPLEX:
246 2632 : a = gisexactzero(gel(g,1)); if (!a) return NULL;
247 616 : b = gisexactzero(gel(g,2)); if (!b) return NULL;
248 0 : return ggcd(a,b);
249 20363 : case t_FFELT:
250 20363 : return FF_equal0(g)? g: NULL;
251 518 : case t_QUAD:
252 518 : a = gisexactzero(gel(g,2)); if (!a) return NULL;
253 77 : b = gisexactzero(gel(g,3)); if (!b) return NULL;
254 7 : return ggcd(a,b);
255 17151 : case t_POLMOD:
256 17151 : return gisexactzero(gel(g,2));
257 28082240 : case t_POL:
258 28082240 : lx = lg(g); /* cater for Mod(0,2)*x^0 */
259 28082240 : if (lx == 2) return gen_0;
260 22760537 : if (lx == 3) return gisexactzero(gel(g,2));
261 19037694 : return NULL;
262 1190293 : case t_RFRAC:
263 1190293 : return gisexactzero(gel(g,1)); /* may occur: Mod(0,2)/x */
264 0 : case t_VEC: case t_COL: case t_MAT:
265 0 : a = gen_0;
266 0 : for (i=lg(g)-1; i; i--)
267 : {
268 0 : b = gisexactzero(gel(g,i));
269 0 : if (!b) return NULL;
270 0 : a = ggcd(a, b);
271 : }
272 0 : return a;
273 : }
274 601640 : return NULL;
275 : }
276 :
277 : int
278 556274617 : isrationalzero(GEN g)
279 : {
280 : long i;
281 556274617 : switch (typ(g))
282 : {
283 347732839 : case t_INT:
284 347732839 : return !signe(g);
285 39427440 : case t_COMPLEX:
286 39427440 : return isintzero(gel(g,1)) && isintzero(gel(g,2));
287 1449 : case t_QUAD:
288 1449 : return isintzero(gel(g,2)) && isintzero(gel(g,3));
289 450377 : case t_POLMOD:
290 450377 : return isrationalzero(gel(g,2));
291 23770089 : case t_POL: return lg(g) == 2;
292 91 : case t_VEC: case t_COL: case t_MAT:
293 322 : for (i=lg(g)-1; i; i--)
294 231 : if (!isrationalzero(gel(g,i))) return 0;
295 91 : return 1;
296 : }
297 144892332 : return 0;
298 : }
299 :
300 : int
301 2289751105 : gequal0(GEN x)
302 : {
303 2289751105 : switch(typ(x))
304 : {
305 2126816276 : case t_INT: case t_REAL: case t_POL: case t_SER:
306 2126816276 : return !signe(x);
307 :
308 7073338 : case t_INTMOD:
309 7073338 : return !signe(gel(x,2));
310 :
311 651092 : case t_FFELT:
312 651092 : return FF_equal0(x);
313 :
314 105133384 : case t_COMPLEX:
315 : /* is 0 iff norm(x) would be 0 (can happen with Re(x) and Im(x) != 0
316 : * only if Re(x) and Im(x) are of type t_REAL). See mp.c:addrr().
317 : */
318 105133384 : if (gequal0(gel(x,1)))
319 : {
320 7995580 : if (gequal0(gel(x,2))) return 1;
321 7611281 : if (typ(gel(x,1))!=t_REAL || typ(gel(x,2))!=t_REAL) return 0;
322 273120 : return (expo(gel(x,1))>=expo(gel(x,2)));
323 : }
324 97138876 : if (gequal0(gel(x,2)))
325 : {
326 1690424 : if (typ(gel(x,1))!=t_REAL || typ(gel(x,2))!=t_REAL) return 0;
327 1606427 : return (expo(gel(x,2))>=expo(gel(x,1)));
328 : }
329 95450552 : return 0;
330 :
331 2046668 : case t_PADIC:
332 2046668 : return !signe(gel(x,4));
333 :
334 1750 : case t_QUAD:
335 1750 : return gequal0(gel(x,2)) && gequal0(gel(x,3));
336 :
337 8504813 : case t_POLMOD:
338 8504813 : return gequal0(gel(x,2));
339 :
340 6101597 : case t_RFRAC:
341 6101597 : return gequal0(gel(x,1));
342 :
343 9786648 : case t_VEC: case t_COL: case t_MAT:
344 : {
345 : long i;
346 22697669 : for (i=lg(x)-1; i; i--)
347 18929024 : if (!gequal0(gel(x,i))) return 0;
348 3768645 : return 1;
349 : }
350 : }
351 23635539 : return 0;
352 : }
353 :
354 : /* x a t_POL or t_SER, return 1 if test(coeff(X,d)) is true and
355 : * coeff(X,i) = 0 for all i != d. Return 0 (false) otherwise */
356 : static int
357 15241099 : is_monomial_test(GEN x, long d, int(*test)(GEN))
358 : {
359 15241099 : long i, l = lg(x);
360 15241099 : if (typ(x) == t_SER)
361 : { /* "0" * x^v * (1+O(x)) ? v <= 0 or null ring */
362 602 : if (l == 3 && isexactzero(gel(x,2))) return d >= 2 || test(gel(x,2));
363 553 : if (d < 2) return 0; /* v > 0 */
364 : }
365 15240868 : if (d >= l)
366 : {
367 60086 : if (typ(x) == t_POL) return 0; /* l = 2 */
368 : /* t_SER, v = 2-d <= 0 */
369 56 : if (!signe(x)) return 1;
370 : }
371 15180782 : else if (!test(gel(x,d))) return 0;
372 7359649 : for (i = 2; i < l; i++) /* 2 <= d < l */
373 4978125 : if (i != d && !gequal0(gel(x,i))) return 0;
374 2381524 : return 1;
375 : }
376 : static int
377 294560 : col_test(GEN x, int(*test)(GEN))
378 : {
379 294560 : long i, l = lg(x);
380 294560 : if (l == 1 || !test(gel(x,1))) return 0;
381 13167 : for (i = 2; i < l; i++)
382 11186 : if (!gequal0(gel(x,i))) return 0;
383 1981 : return 1;
384 : }
385 : static int
386 16366 : mat_test(GEN x, int(*test)(GEN))
387 : {
388 16366 : long i, j, l = lg(x);
389 16366 : if (l == 1) return 1;
390 16352 : if (l != lgcols(x)) return 0;
391 52283 : for (i = 1; i < l; i++)
392 140973 : for (j = 1; j < l; j++)
393 105042 : if (i == j) {
394 36015 : if (!test(gcoeff(x,i,i))) return 0;
395 : } else {
396 69027 : if (!gequal0(gcoeff(x,i,j))) return 0;
397 : }
398 16268 : return 1;
399 : }
400 :
401 : /* returns 1 whenever x = 1, and 0 otherwise */
402 : int
403 327587215 : gequal1(GEN x)
404 : {
405 327587215 : switch(typ(x))
406 : {
407 307932276 : case t_INT:
408 307932276 : return equali1(x);
409 :
410 71064 : case t_REAL:
411 : {
412 71064 : long s = signe(x);
413 71064 : if (!s) return expo(x) >= 0;
414 70966 : return s > 0 ? absrnz_equal1(x): 0;
415 : }
416 350994 : case t_INTMOD:
417 350994 : return is_pm1(gel(x,2)) || is_pm1(gel(x,1));
418 393491 : case t_POLMOD:
419 393491 : return !degpol(gel(x,1)) || gequal1(gel(x,2));
420 :
421 15988 : case t_FFELT:
422 15988 : return FF_equal1(x);
423 :
424 1683284 : case t_FRAC:
425 1683284 : return 0;
426 :
427 23994 : case t_COMPLEX:
428 23994 : return gequal1(gel(x,1)) && gequal0(gel(x,2));
429 :
430 166302 : case t_PADIC:
431 166302 : if (!signe(gel(x,4))) return valp(x) <= 0;
432 166260 : return valp(x) == 0 && gequal1(gel(x,4));
433 :
434 42 : case t_QUAD:
435 42 : return gequal1(gel(x,2)) && gequal0(gel(x,3));
436 :
437 15240428 : case t_POL: return is_monomial_test(x, 2, &gequal1);
438 476 : case t_SER: return is_monomial_test(x, 2 - valser(x), &gequal1);
439 :
440 1028333 : case t_RFRAC: return gequal(gel(x,1), gel(x,2));
441 294511 : case t_COL: return col_test(x, &gequal1);
442 16254 : case t_MAT: return mat_test(x, &gequal1);
443 : }
444 369778 : return 0;
445 : }
446 :
447 : /* returns 1 whenever the x = -1, 0 otherwise */
448 : int
449 74232934 : gequalm1(GEN x)
450 : {
451 : pari_sp av;
452 : GEN t;
453 :
454 74232934 : switch(typ(x))
455 : {
456 74224083 : case t_INT:
457 74224083 : return equalim1(x);
458 :
459 1484 : case t_REAL:
460 : {
461 1484 : long s = signe(x);
462 1484 : if (!s) return expo(x) >= 0;
463 1477 : return s < 0 ? absrnz_equal1(x): 0;
464 : }
465 4616 : case t_INTMOD:
466 4616 : av = avma; return gc_bool(av, equalii(addui(1,gel(x,2)), gel(x,1)));
467 :
468 154 : case t_FRAC:
469 154 : return 0;
470 :
471 42 : case t_FFELT:
472 42 : return FF_equalm1(x);
473 :
474 2044 : case t_COMPLEX:
475 2044 : return gequalm1(gel(x,1)) && gequal0(gel(x,2));
476 :
477 7 : case t_QUAD:
478 7 : return gequalm1(gel(x,2)) && gequal0(gel(x,3));
479 :
480 49 : case t_PADIC:
481 49 : t = gel(x,4); if (!signe(t)) return valp(x) <= 0;
482 21 : av = avma; return gc_bool(av, !valp(x) && equalii(addui(1,t), gel(x,3)));
483 :
484 56 : case t_POLMOD:
485 56 : return !degpol(gel(x,1)) || gequalm1(gel(x,2));
486 :
487 70 : case t_POL: return is_monomial_test(x, 2, &gequalm1);
488 126 : case t_SER: return is_monomial_test(x, 2 - valser(x), &gequalm1);
489 :
490 28 : case t_RFRAC:
491 28 : av = avma; return gc_bool(av, gmequal_try(gel(x,1), gel(x,2)));
492 49 : case t_COL: return col_test(x, &gequalm1);
493 112 : case t_MAT: return mat_test(x, &gequalm1);
494 : }
495 14 : return 0;
496 : }
497 :
498 : int
499 1470109 : gequalX(GEN x) { return typ(x) == t_POL && lg(x) == 4
500 2955068 : && isintzero(gel(x,2)) && isint1(gel(x,3)); }
501 :
502 : static int
503 672 : cmp_str(const char *x, const char *y)
504 : {
505 672 : int f = strcmp(x, y);
506 : return f > 0? 1
507 672 : : f? -1: 0;
508 : }
509 :
510 : static int
511 39220271 : cmp_universal_rec(GEN x, GEN y, long i0)
512 : {
513 39220271 : long i, lx = lg(x), ly = lg(y);
514 39220271 : if (lx < ly) return -1;
515 39217496 : if (lx > ly) return 1;
516 69371816 : for (i = i0; i < lx; i++)
517 : {
518 60449865 : int f = cmp_universal(gel(x,i), gel(y,i));
519 60449865 : if (f) return f;
520 : }
521 8921951 : return 0;
522 : }
523 : /* Universal "meaningless" comparison function. Transitive, returns 0 iff
524 : * gidentical(x,y) */
525 : int
526 85033364 : cmp_universal(GEN x, GEN y)
527 : {
528 85033364 : long lx, ly, i, tx = typ(x), ty = typ(y);
529 :
530 85033364 : if (tx < ty) return -1;
531 84661220 : if (ty < tx) return 1;
532 84132361 : switch(tx)
533 : {
534 43976359 : case t_INT: return cmpii(x,y);
535 651 : case t_STR: return cmp_str(GSTR(x),GSTR(y));
536 934997 : case t_REAL:
537 : case t_VECSMALL:
538 934997 : lx = lg(x);
539 934997 : ly = lg(y);
540 934997 : if (lx < ly) return -1;
541 886725 : if (lx > ly) return 1;
542 3586440 : for (i = 1; i < lx; i++)
543 : {
544 3478808 : if (x[i] < y[i]) return -1;
545 3109879 : if (x[i] > y[i]) return 1;
546 : }
547 107632 : return 0;
548 :
549 771689 : case t_POL:
550 : {
551 771689 : long X = x[1] & (VARNBITS|SIGNBITS);
552 771689 : long Y = y[1] & (VARNBITS|SIGNBITS);
553 771689 : if (X < Y) return -1;
554 771668 : if (X > Y) return 1;
555 771612 : return cmp_universal_rec(x, y, 2);
556 : }
557 881076 : case t_SER:
558 : case t_FFELT:
559 : case t_CLOSURE:
560 881076 : if (x[1] < y[1]) return -1;
561 881069 : if (x[1] > y[1]) return 1;
562 881062 : return cmp_universal_rec(x, y, 2);
563 :
564 35 : case t_LIST:
565 : {
566 35 : long tx = list_typ(x), ty = list_typ(y);
567 : GEN vx, vy;
568 : pari_sp av;
569 35 : if (tx < ty) return -1;
570 35 : if (tx > ty) return 1;
571 35 : vx = list_data(x);
572 35 : vy = list_data(y);
573 35 : if (!vx) return vy? -1: 0;
574 35 : if (!vy) return 1;
575 35 : av = avma;
576 35 : if (tx == t_LIST_MAP)
577 : {
578 14 : vx = maptomat_shallow(x);
579 14 : vy = maptomat_shallow(y);
580 : }
581 35 : return gc_int(av, cmp_universal_rec(vx, vy, 1));
582 : }
583 37567554 : default:
584 37567554 : return cmp_universal_rec(x, y, lontyp[tx]);
585 : }
586 : }
587 :
588 : static int
589 4588944 : cmpfrac(GEN x, GEN y)
590 : {
591 4588944 : pari_sp av = avma;
592 4588944 : GEN a = gel(x,1), b = gel(x,2);
593 4588944 : GEN c = gel(y,1), d = gel(y,2);
594 4588944 : return gc_bool(av, cmpii(mulii(a, d), mulii(b, c)));
595 : }
596 : static int
597 455541 : cmpifrac(GEN a, GEN y)
598 : {
599 455541 : pari_sp av = avma;
600 455541 : GEN c = gel(y,1), d = gel(y,2);
601 455541 : return gc_int(av, cmpii(mulii(a, d), c));
602 : }
603 : static int
604 81217 : cmprfrac(GEN a, GEN y)
605 : {
606 81217 : pari_sp av = avma;
607 81217 : GEN c = gel(y,1), d = gel(y,2);
608 81217 : return gc_int(av, cmpri(mulri(a, d), c));
609 : }
610 : static int
611 161 : cmpgen(GEN x, GEN y)
612 : {
613 161 : pari_sp av = avma;
614 161 : return gc_int(av, gsigne(gsub(x,y)));
615 : }
616 :
617 : /* returns the sign of x - y when it makes sense. 0 otherwise */
618 : int
619 290944558 : gcmp(GEN x, GEN y)
620 : {
621 290944558 : long tx = typ(x), ty = typ(y);
622 :
623 290944558 : if (tx == ty) /* generic case */
624 281451040 : switch(tx)
625 : {
626 153424816 : case t_INT: return cmpii(x, y);
627 123344992 : case t_REAL: return cmprr(x, y);
628 4588944 : case t_FRAC: return cmpfrac(x, y);
629 70 : case t_QUAD: return cmpgen(x, y);
630 21 : case t_STR: return cmp_str(GSTR(x), GSTR(y));
631 104683 : case t_INFINITY:
632 : {
633 104683 : long sx = inf_get_sign(x), sy = inf_get_sign(y);
634 104683 : if (sx < sy) return -1;
635 42 : if (sx > sy) return 1;
636 14 : return 0;
637 : }
638 : }
639 9481032 : if (ty == t_INFINITY) return -inf_get_sign(y);
640 8535739 : switch(tx)
641 : {
642 8119723 : case t_INT:
643 : switch(ty)
644 : {
645 7806948 : case t_REAL: return cmpir(x, y);
646 312761 : case t_FRAC: return cmpifrac(x, y);
647 7 : case t_QUAD: return cmpgen(x, y);
648 : }
649 7 : break;
650 215160 : case t_REAL:
651 : switch(ty)
652 : {
653 178292 : case t_INT: return cmpri(x, y);
654 36847 : case t_FRAC: return cmprfrac(x, y);
655 14 : case t_QUAD: return cmpgen(x, y);
656 : }
657 7 : break;
658 187164 : case t_FRAC:
659 : switch(ty)
660 : {
661 142780 : case t_INT: return -cmpifrac(y, x);
662 44370 : case t_REAL: return -cmprfrac(y, x);
663 7 : case t_QUAD: return cmpgen(x, y);
664 : }
665 7 : break;
666 63 : case t_QUAD:
667 63 : return cmpgen(x, y);
668 31660 : case t_INFINITY: return inf_get_sign(x);
669 : }
670 24 : pari_err_TYPE2("comparison",x,y);
671 : return 0;/*LCOV_EXCL_LINE*/
672 : }
673 :
674 : int
675 780699 : gcmpsg(long s, GEN y)
676 : {
677 780699 : switch(typ(y))
678 : {
679 12236 : case t_INT: return cmpsi(s,y);
680 763290 : case t_REAL: return cmpsr(s,y);
681 5173 : case t_FRAC: {
682 5173 : pari_sp av = avma;
683 5173 : return gc_int(av, cmpii(mulsi(s,gel(y,2)), gel(y,1)));
684 : }
685 0 : case t_QUAD: {
686 0 : pari_sp av = avma;
687 0 : return gc_int(av, gsigne(gsubsg(s, y)));
688 : }
689 0 : case t_INFINITY: return -inf_get_sign(y);
690 : }
691 0 : pari_err_TYPE2("comparison",stoi(s),y);
692 : return 0; /* LCOV_EXCL_LINE */
693 : }
694 :
695 : static long
696 3232871 : roughtype(GEN x)
697 : {
698 3232871 : switch(typ(x))
699 : {
700 2114 : case t_MAT: return t_MAT;
701 742486 : case t_VEC: case t_COL: return t_VEC;
702 1613554 : case t_VECSMALL: return t_VECSMALL;
703 874717 : default: return t_INT;
704 : }
705 : }
706 :
707 : static int lexcmpsg(long x, GEN y);
708 42 : static int lexcmpgs(GEN x, long y) { return -lexcmpsg(y,x); }
709 : /* lexcmp(stoi(x),y), y t_VEC/t_COL/t_MAT */
710 : static int
711 21 : lexcmp_s_matvec(long x, GEN y)
712 : {
713 : int fl;
714 21 : if (lg(y)==1) return 1;
715 14 : fl = lexcmpsg(x,gel(y,1));
716 14 : if (fl) return fl;
717 7 : return -1;
718 : }
719 : /* x a scalar, y a t_VEC/t_COL/t_MAT */
720 : static int
721 357 : lexcmp_scal_matvec(GEN x, GEN y)
722 : {
723 : int fl;
724 357 : if (lg(y)==1) return 1;
725 357 : fl = lexcmp(x,gel(y,1));
726 357 : if (fl) return fl;
727 7 : return -1;
728 : }
729 : /* x a scalar, y a t_VECSMALL */
730 : static int
731 42 : lexcmp_scal_vecsmall(GEN x, GEN y)
732 : {
733 : int fl;
734 42 : if (lg(y)==1) return 1;
735 42 : fl = lexcmpgs(x, y[1]);
736 42 : if (fl) return fl;
737 0 : return -1;
738 : }
739 :
740 : /* tx = ty = t_MAT, or x and y are both vect_t */
741 : static int
742 372034 : lexcmp_similar(GEN x, GEN y)
743 : {
744 372034 : long i, lx = lg(x), ly = lg(y), l = minss(lx,ly);
745 456923 : for (i=1; i<l; i++)
746 : {
747 425283 : int fl = lexcmp(gel(x,i),gel(y,i));
748 425282 : if (fl) return fl;
749 : }
750 31640 : if (lx == ly) return 0;
751 35 : return (lx < ly)? -1 : 1;
752 : }
753 : /* x a t_VECSMALL, y a t_VEC/t_COL ~ lexcmp_similar */
754 : static int
755 154 : lexcmp_vecsmall_vec(GEN x, GEN y)
756 : {
757 154 : long i, lx = lg(x), ly = lg(y), l = minss(lx,ly);
758 343 : for (i=1; i<l; i++)
759 : {
760 287 : int fl = lexcmpsg(x[i], gel(y,i));
761 287 : if (fl) return fl;
762 : }
763 56 : if (lx == ly) return 0;
764 21 : return (lx < ly)? -1 : 1;
765 : }
766 :
767 : /* x t_VEC/t_COL, y t_MAT */
768 : static int
769 98 : lexcmp_vec_mat(GEN x, GEN y)
770 : {
771 : int fl;
772 98 : if (lg(x)==1) return -1;
773 98 : if (lg(y)==1) return 1;
774 98 : fl = lexcmp_similar(x,gel(y,1));
775 98 : if (fl) return fl;
776 7 : return -1;
777 : }
778 : /* x t_VECSMALl, y t_MAT ~ lexcmp_vec_mat */
779 : static int
780 42 : lexcmp_vecsmall_mat(GEN x, GEN y)
781 : {
782 : int fl;
783 42 : if (lg(x)==1) return -1;
784 42 : if (lg(y)==1) return 1;
785 42 : fl = lexcmp_vecsmall_vec(x, gel(y,1));
786 42 : if (fl) return fl;
787 0 : return -1;
788 : }
789 :
790 : /* x a t_VECSMALL, not y */
791 : static int
792 196 : lexcmp_vecsmall_other(GEN x, GEN y, long ty)
793 : {
794 196 : switch(ty)
795 : {
796 42 : case t_MAT: return lexcmp_vecsmall_mat(x, y);
797 112 : case t_VEC: return lexcmp_vecsmall_vec(x, y);
798 42 : default: return -lexcmp_scal_vecsmall(y, x); /*y scalar*/
799 : }
800 : }
801 :
802 : /* lexcmp(stoi(s), y) */
803 : static int
804 343 : lexcmpsg(long x, GEN y)
805 : {
806 343 : switch(roughtype(y))
807 : {
808 21 : case t_MAT:
809 : case t_VEC:
810 21 : return lexcmp_s_matvec(x,y);
811 14 : case t_VECSMALL: /* ~ lexcmp_scal_matvec */
812 14 : if (lg(y)==1) return 1;
813 7 : return (x > y[1])? 1: -1;
814 308 : default: return gcmpsg(x,y);
815 : }
816 : }
817 :
818 : /* as gcmp for vector/matrices, using lexicographic ordering on components */
819 : static int
820 1616266 : lexcmp_i(GEN x, GEN y)
821 : {
822 1616266 : const long tx = roughtype(x), ty = roughtype(y);
823 1616267 : if (tx == ty)
824 1615616 : switch(tx)
825 : {
826 371936 : case t_MAT:
827 371936 : case t_VEC: return lexcmp_similar(x,y);
828 806672 : case t_VECSMALL: return vecsmall_lexcmp(x,y);
829 437008 : default: return gcmp(x,y);
830 : }
831 651 : if (tx == t_VECSMALL) return lexcmp_vecsmall_other(x,y,ty);
832 518 : if (ty == t_VECSMALL) return -lexcmp_vecsmall_other(y,x,tx);
833 :
834 455 : if (tx == t_INT) return lexcmp_scal_matvec(x,y); /*scalar*/
835 203 : if (ty == t_INT) return -lexcmp_scal_matvec(y,x);
836 :
837 98 : if (ty==t_MAT) return lexcmp_vec_mat(x,y);
838 42 : return -lexcmp_vec_mat(y,x); /*tx==t_MAT*/
839 : }
840 : int
841 1616266 : lexcmp(GEN x, GEN y)
842 : {
843 1616266 : pari_sp av = avma;
844 1616266 : if (typ(x) == t_COMPLEX)
845 : {
846 875 : x = mkvec2(gel(x,1), gel(x,2));
847 875 : if (typ(y) == t_COMPLEX) y = mkvec2(gel(y,1), gel(y,2));
848 49 : else y = mkvec2(y, gen_0);
849 : }
850 1615391 : else if (typ(y) == t_COMPLEX)
851 : {
852 63 : x = mkvec2(x, gen_0);
853 63 : y = mkvec2(gel(y,1), gel(y,2));
854 : }
855 1616266 : return gc_int(av, lexcmp_i(x, y));
856 : }
857 :
858 : /*****************************************************************/
859 : /* */
860 : /* EQUALITY */
861 : /* returns 1 if x == y, 0 otherwise */
862 : /* */
863 : /*****************************************************************/
864 : /* x,y t_POL */
865 : static int
866 1520475 : polidentical(GEN x, GEN y)
867 : {
868 : long lx;
869 1520475 : if (x[1] != y[1]) return 0;
870 1520377 : lx = lg(x); if (lg(y) != lg(x)) return 0;
871 7532355 : for (lx--; lx >= 2; lx--) if (!gidentical(gel(x,lx), gel(y,lx))) return 0;
872 1520286 : return 1;
873 : }
874 : /* x,y t_SER */
875 : static int
876 14 : seridentical(GEN x, GEN y) { return polidentical(x,y); }
877 : /* typ(x) = typ(y) = t_VEC/COL/MAT */
878 : static int
879 5264160 : vecidentical(GEN x, GEN y)
880 : {
881 : long i;
882 5264160 : if ((x[0] ^ y[0]) & (TYPBITS|LGBITS)) return 0;
883 16814585 : for (i = lg(x)-1; i; i--)
884 12843895 : if (! gidentical(gel(x,i),gel(y,i)) ) return 0;
885 3970690 : return 1;
886 : }
887 : static int
888 1547 : identicalrr(GEN x, GEN y)
889 : {
890 1547 : long i, lx = lg(x);
891 1547 : if (lg(y) != lx) return 0;
892 1547 : if (x[1] != y[1]) return 0;
893 5465 : i=2; while (i<lx && x[i]==y[i]) i++;
894 1540 : return (i == lx);
895 : }
896 :
897 : static int
898 70 : closure_identical(GEN x, GEN y)
899 : {
900 70 : if (lg(x)!=lg(y) || x[1]!=y[1]) return 0;
901 56 : if (!gidentical(gel(x,2),gel(y,2)) || !gidentical(gel(x,3),gel(y,3))
902 56 : || !gidentical(gel(x,4),gel(y,4))) return 0;
903 42 : if (lg(x)<8) return 1;
904 0 : return gidentical(gel(x,7),gel(y,7));
905 : }
906 :
907 : static int
908 343 : list_cmp(GEN x, GEN y, int cmp(GEN x, GEN y))
909 : {
910 343 : int t = list_typ(x);
911 : GEN vx, vy;
912 : long lvx, lvy;
913 343 : if (list_typ(y)!=t) return 0;
914 343 : vx = list_data(x);
915 343 : vy = list_data(y);
916 343 : lvx = vx ? lg(vx): 1;
917 343 : lvy = vy ? lg(vy): 1;
918 343 : if (lvx==1 && lvy==1) return 1;
919 329 : if (lvx != lvy) return 0;
920 301 : switch (t)
921 : {
922 280 : case t_LIST_MAP:
923 : {
924 280 : pari_sp av = avma;
925 280 : GEN mx = maptomat_shallow(x), my = maptomat_shallow(y);
926 280 : int ret = gidentical(gel(mx, 1), gel(my, 1)) && cmp(gel(mx, 2), gel(my, 2));
927 280 : return gc_bool(av, ret);
928 : }
929 21 : default:
930 21 : return cmp(vx, vy);
931 : }
932 : }
933 :
934 : int
935 54362024 : gidentical(GEN x, GEN y)
936 : {
937 : long tx;
938 :
939 54362024 : if (x == y) return 1;
940 50657238 : tx = typ(x); if (typ(y) != tx) return 0;
941 50429741 : switch(tx)
942 : {
943 13578043 : case t_INT:
944 13578043 : return equalii(x,y);
945 :
946 1547 : case t_REAL:
947 1547 : return identicalrr(x,y);
948 :
949 431622 : case t_FRAC: case t_INTMOD:
950 431622 : return equalii(gel(x,2), gel(y,2)) && equalii(gel(x,1), gel(y,1));
951 :
952 343 : case t_COMPLEX:
953 343 : return gidentical(gel(x,2),gel(y,2)) && gidentical(gel(x,1),gel(y,1));
954 14 : case t_PADIC:
955 14 : return valp(x) == valp(y)
956 14 : && equalii(gel(x,2),gel(y,2))
957 14 : && equalii(gel(x,3),gel(y,3))
958 28 : && equalii(gel(x,4),gel(y,4));
959 3913 : case t_POLMOD:
960 3913 : return gidentical(gel(x,2),gel(y,2)) && polidentical(gel(x,1),gel(y,1));
961 1520440 : case t_POL:
962 1520440 : return polidentical(x,y);
963 14 : case t_SER:
964 14 : return seridentical(x,y);
965 2814 : case t_FFELT:
966 2814 : return FF_equal(x,y);
967 :
968 401624 : case t_QFB:
969 401624 : return equalii(gel(x,1),gel(y,1))
970 401617 : && equalii(gel(x,2),gel(y,2))
971 803241 : && equalii(gel(x,3),gel(y,3));
972 :
973 14 : case t_QUAD:
974 14 : return ZX_equal(gel(x,1),gel(y,1))
975 7 : && gidentical(gel(x,2),gel(y,2))
976 21 : && gidentical(gel(x,3),gel(y,3));
977 :
978 7 : case t_RFRAC:
979 7 : return gidentical(gel(x,1),gel(y,1)) && gidentical(gel(x,2),gel(y,2));
980 :
981 70 : case t_STR:
982 70 : return !strcmp(GSTR(x),GSTR(y));
983 5264160 : case t_VEC: case t_COL: case t_MAT:
984 5264160 : return vecidentical(x,y);
985 29224906 : case t_VECSMALL:
986 29224906 : return zv_equal(x,y);
987 28 : case t_CLOSURE:
988 28 : return closure_identical(x,y);
989 161 : case t_LIST:
990 161 : return list_cmp(x, y, gidentical);
991 21 : case t_INFINITY: return gidentical(gel(x,1),gel(y,1));
992 : }
993 0 : return 0;
994 : }
995 : /* x,y t_POL in the same variable */
996 : static int
997 7750423 : polequal(GEN x, GEN y)
998 : {
999 : long lx, ly;
1000 : /* Can't do that: Mod(0,1)*x^0 == x^0
1001 : if (signe(x) != signe(y)) return 0; */
1002 7750423 : lx = lg(x); ly = lg(y);
1003 7750423 : while (lx > ly) if (!gequal0(gel(x,--lx))) return 0;
1004 7746902 : while (ly > lx) if (!gequal0(gel(y,--ly))) return 0;
1005 30827541 : for (lx--; lx >= 2; lx--) if (!gequal(gel(x,lx), gel(y,lx))) return 0;
1006 7674868 : return 1;
1007 : }
1008 :
1009 : /* x,y t_SER in the same variable */
1010 : static int
1011 420 : serequal(GEN x, GEN y)
1012 : {
1013 : long LX, LY, lx, ly, vx, vy;
1014 420 : if (!signe(x) && !signe(y)) return 1;
1015 56 : lx = lg(x); vx = valser(x); LX = lx + vx;
1016 56 : ly = lg(y); vy = valser(y); LY = ly + vy;
1017 56 : if (LX > LY) lx = LY - vx; else ly = LX - vy;
1018 282877 : while (lx >= 3 && ly >= 3)
1019 282821 : if (!gequal(gel(x,--lx), gel(y,--ly))) return 0;
1020 56 : while(--ly >= 2) if (!gequal0(gel(y,ly))) return 0;
1021 84 : while(--lx >= 2) if (!gequal0(gel(x,lx))) return 0;
1022 49 : return 1;
1023 : }
1024 :
1025 : /* typ(x) = typ(y) = t_VEC/COL/MAT */
1026 : static int
1027 5518582 : vecequal(GEN x, GEN y)
1028 : {
1029 : long i;
1030 5518582 : if ((x[0] ^ y[0]) & (TYPBITS|LGBITS)) return 0;
1031 18432962 : for (i = lg(x)-1; i; i--)
1032 16122347 : if (! gequal(gel(x,i),gel(y,i)) ) return 0;
1033 2310615 : return 1;
1034 : }
1035 :
1036 : int
1037 232325456 : gequal(GEN x, GEN y)
1038 : {
1039 : pari_sp av;
1040 : GEN A, B, a, b;
1041 : long tx, ty;
1042 :
1043 232325456 : if (x == y) return 1;
1044 202333604 : tx = typ(x); ty = typ(y);
1045 202333604 : if (tx == ty)
1046 194549105 : switch(tx)
1047 : {
1048 168532771 : case t_INT:
1049 168532771 : return equalii(x,y);
1050 :
1051 20460 : case t_REAL:
1052 20460 : return equalrr(x,y);
1053 :
1054 294256 : case t_FRAC:
1055 294256 : return equalii(gel(x,2), gel(y,2)) && equalii(gel(x,1), gel(y,1));
1056 :
1057 6519688 : case t_INTMOD:
1058 6519688 : A = gel(x,1); B = gel(y,1);
1059 6519688 : a = gel(x,2); b = gel(y,2);
1060 6519688 : if (equalii(A, B)) return equalii(a, b);
1061 14 : av = avma; A = gcdii(A, B);
1062 14 : return gc_bool(av, equalii(modii(a,A), modii(b,A)));
1063 :
1064 1316 : case t_COMPLEX:
1065 1316 : return gequal(gel(x,2),gel(y,2)) && gequal(gel(x,1),gel(y,1));
1066 770 : case t_PADIC:
1067 770 : if (!equalii(gel(x,2),gel(y,2))) return 0;
1068 770 : av = avma; return gc_bool(av, gequal0(gsub(x,y)));
1069 :
1070 3188289 : case t_POLMOD:
1071 3188289 : A = gel(x,1); B = gel(y,1);
1072 3188289 : if (varn(A) != varn(B)) break;
1073 3188268 : a = gel(x,2); b = gel(y,2);
1074 3188268 : if (RgX_equal_var(A, B)) return gequal(a,b);
1075 14 : av = avma; A = ggcd(A, B);
1076 14 : return gc_bool(av, gequal(gmod(a,A), gmod(b,A)));
1077 :
1078 7758949 : case t_POL:
1079 7758949 : if (varn(x) != varn(y)) break;
1080 7750423 : return polequal(x,y);
1081 420 : case t_SER:
1082 420 : if (varn(x) != varn(y)) break;
1083 420 : return serequal(x,y);
1084 :
1085 61250 : case t_FFELT:
1086 61250 : return FF_equal(x,y);
1087 :
1088 1097034 : case t_QFB:
1089 1097034 : return equalii(gel(x,1),gel(y,1))
1090 247773 : && equalii(gel(x,2),gel(y,2))
1091 1344807 : && equalii(gel(x,3),gel(y,3));
1092 :
1093 7 : case t_QUAD:
1094 7 : return ZX_equal(gel(x,1),gel(y,1))
1095 0 : && gequal(gel(x,2),gel(y,2))
1096 7 : && gequal(gel(x,3),gel(y,3));
1097 :
1098 73759 : case t_RFRAC:
1099 : {
1100 73759 : GEN a = gel(x,1), b = gel(x,2), c = gel(y,1), d = gel(y,2);
1101 73759 : if (gequal(b,d)) return gequal(a,c); /* simple case */
1102 0 : av = avma;
1103 0 : a = simplify_shallow(gmul(a,d));
1104 0 : b = simplify_shallow(gmul(b,c));
1105 0 : return gc_bool(av, gequal(a,b));
1106 : }
1107 :
1108 64995 : case t_STR:
1109 64995 : return !strcmp(GSTR(x),GSTR(y));
1110 5518584 : case t_VEC: case t_COL: case t_MAT:
1111 5518584 : return vecequal(x,y);
1112 1416312 : case t_VECSMALL:
1113 1416312 : return zv_equal(x,y);
1114 182 : case t_LIST:
1115 182 : return list_cmp(x, y, gequal);
1116 42 : case t_CLOSURE:
1117 42 : return closure_identical(x,y);
1118 28 : case t_INFINITY:
1119 28 : return gequal(gel(x,1),gel(y,1));
1120 : }
1121 7793039 : if (is_noncalc_t(tx) || is_noncalc_t(ty)) return 0;
1122 7793147 : if (tx == t_INT && !signe(x)) return gequal0(y);
1123 7790830 : if (ty == t_INT && !signe(y)) return gequal0(x);
1124 3187231 : (void)&av; av = avma; /* emulate volatile */
1125 3187231 : return gc_bool(av, gequal_try(x, y));
1126 : }
1127 :
1128 : int
1129 43988 : gequalsg(long s, GEN x)
1130 43988 : { pari_sp av = avma; return gc_bool(av, gequal(stoi(s), x)); }
1131 :
1132 : /* a and b are t_INT, t_FRAC, t_REAL or t_COMPLEX of those. Check whether
1133 : * a-b is invertible */
1134 : int
1135 49981 : cx_approx_equal(GEN a, GEN b)
1136 : {
1137 49981 : pari_sp av = avma;
1138 : GEN d;
1139 49981 : if (a == b) return 1;
1140 24486 : d = gsub(a,b);
1141 24486 : return gc_bool(av, gequal0(d) || (typ(d)==t_COMPLEX && gequal0(cxnorm(d))));
1142 : }
1143 : static int
1144 1748522 : r_approx0(GEN x, long e) { return e - expo(x) > bit_prec(x); }
1145 : /* x ~ 0 compared to reference y */
1146 : int
1147 2477401 : cx_approx0(GEN x, GEN y)
1148 : {
1149 : GEN a, b;
1150 : long e;
1151 2477401 : switch(typ(x))
1152 : {
1153 469 : case t_COMPLEX:
1154 469 : a = gel(x,1); b = gel(x,2);
1155 469 : if (typ(a) != t_REAL)
1156 : {
1157 14 : if (!gequal0(a)) return 0;
1158 0 : a = NULL;
1159 : }
1160 455 : else if (!signe(a)) a = NULL;
1161 455 : if (typ(b) != t_REAL)
1162 : {
1163 0 : if (!gequal0(b)) return 0;
1164 0 : if (!a) return 1;
1165 0 : b = NULL;
1166 : }
1167 455 : else if (!signe(b))
1168 : {
1169 7 : if (!a) return 1;
1170 7 : b = NULL;
1171 : }
1172 : /* a or b is != NULL iff it is non-zero t_REAL; one of them is */
1173 455 : e = gexpo(y);
1174 455 : return (!a || r_approx0(a, e)) && (!b || r_approx0(b, e));
1175 1748255 : case t_REAL:
1176 1748255 : return !signe(x) || r_approx0(x, gexpo(y));
1177 728677 : default:
1178 728677 : return gequal0(x);
1179 : }
1180 : }
1181 : /*******************************************************************/
1182 : /* */
1183 : /* VALUATION */
1184 : /* p is either a t_INT or a t_POL. */
1185 : /* returns the largest exponent of p dividing x when this makes */
1186 : /* sense : error for types real, integermod and polymod if p does */
1187 : /* not divide the modulus, q-adic if q!=p. */
1188 : /* */
1189 : /*******************************************************************/
1190 :
1191 : static long
1192 329 : minval(GEN x, GEN p)
1193 : {
1194 329 : long i,k, val = LONG_MAX, lx = lg(x);
1195 6524 : for (i=lontyp[typ(x)]; i<lx; i++)
1196 : {
1197 6195 : k = gvaluation(gel(x,i),p);
1198 6195 : if (k < val) val = k;
1199 : }
1200 329 : return val;
1201 : }
1202 :
1203 : static int
1204 91 : intdvd(GEN x, GEN y, GEN *z) { GEN r; *z = dvmdii(x,y,&r); return (r==gen_0); }
1205 :
1206 : /* x t_FRAC, p t_INT, return v_p(x) */
1207 : static long
1208 292589 : frac_val(GEN x, GEN p) {
1209 292589 : long v = Z_pval(gel(x,2),p);
1210 292589 : if (v) return -v;
1211 292454 : return Z_pval(gel(x,1),p);
1212 : }
1213 : long
1214 9304315 : Q_pval(GEN x, GEN p)
1215 : {
1216 9304315 : if (lgefint(p) == 3) return Q_lval(x, uel(p,2));
1217 552 : return (typ(x)==t_INT)? Z_pval(x, p): frac_val(x, p);
1218 : }
1219 :
1220 : static long
1221 370710 : frac_lval(GEN x, ulong p) {
1222 370710 : long v = Z_lval(gel(x,2),p);
1223 370710 : if (v) return -v;
1224 221752 : return Z_lval(gel(x,1),p);
1225 : }
1226 : long
1227 9308511 : Q_lval(GEN x, ulong p){return (typ(x)==t_INT)? Z_lval(x, p): frac_lval(x, p);}
1228 :
1229 : long
1230 6304206 : Q_pvalrem(GEN x, GEN p, GEN *y)
1231 : {
1232 : GEN a, b;
1233 : long v;
1234 6304206 : if (lgefint(p) == 3) return Q_lvalrem(x, uel(p,2), y);
1235 5807 : if (typ(x) == t_INT) return Z_pvalrem(x, p, y);
1236 0 : a = gel(x,1);
1237 0 : b = gel(x,2);
1238 0 : v = Z_pvalrem(b, p, &b);
1239 0 : if (v) { *y = isint1(b)? a: mkfrac(a, b); return -v; }
1240 0 : v = Z_pvalrem(a, p, &a);
1241 0 : *y = mkfrac(a, b); return v;
1242 : }
1243 : long
1244 6302610 : Q_lvalrem(GEN x, ulong p, GEN *y)
1245 : {
1246 : GEN a, b;
1247 : long v;
1248 6302610 : if (typ(x) == t_INT) return Z_lvalrem(x, p, y);
1249 398341 : a = gel(x,1);
1250 398341 : b = gel(x,2);
1251 398341 : v = Z_lvalrem(b, p, &b);
1252 398343 : if (v) { *y = isint1(b)? a: mkfrac(a, b); return -v; }
1253 228917 : v = Z_lvalrem(a, p, &a);
1254 228917 : *y = mkfrac(a, b); return v;
1255 : }
1256 :
1257 : long
1258 1166023 : gvaluation(GEN x, GEN p)
1259 : {
1260 1166023 : long tx = typ(x), tp;
1261 : pari_sp av;
1262 :
1263 1166023 : if (!p)
1264 28 : switch(tx)
1265 : {
1266 7 : case t_PADIC: return valp(x);
1267 7 : case t_POL: return RgX_val(x);
1268 7 : case t_SER: return valser(x);
1269 7 : default: pari_err_TYPE("gvaluation", x);
1270 : }
1271 1165995 : tp = typ(p);
1272 1165995 : switch(tp)
1273 : {
1274 1158981 : case t_INT:
1275 1158981 : if (signe(p) && !is_pm1(p)) break;
1276 28 : pari_err_DOMAIN("gvaluation", "p", "=", p, p);
1277 7007 : case t_POL:
1278 7007 : if (degpol(p) > 0) break;
1279 : default:
1280 7 : pari_err_DOMAIN("gvaluation", "p", "=", p, p);
1281 : }
1282 :
1283 1165960 : switch(tx)
1284 : {
1285 144599 : case t_INT:
1286 144599 : if (!signe(x)) return LONG_MAX;
1287 144494 : if (tp == t_POL) return 0;
1288 144172 : return Z_pval(x,p);
1289 :
1290 49 : case t_REAL:
1291 49 : if (tp == t_POL) return 0;
1292 21 : break;
1293 :
1294 28 : case t_FFELT:
1295 28 : if (tp == t_POL) return FF_equal0(x)? LONG_MAX: 0;
1296 14 : break;
1297 :
1298 105 : case t_INTMOD: {
1299 105 : GEN a = gel(x,1), b = gel(x,2);
1300 : long val;
1301 133 : if (tp == t_POL) return signe(b)? 0: LONG_MAX;
1302 42 : av = avma;
1303 42 : if (!intdvd(a, p, &a)) break;
1304 28 : if (!intdvd(b, p, &b)) return gc_long(av,0);
1305 14 : val = 1; while (intdvd(a,p,&a) && intdvd(b,p,&b)) val++;
1306 14 : return gc_long(av,val);
1307 : }
1308 :
1309 292509 : case t_FRAC:
1310 292509 : if (tp == t_POL) return 0;
1311 292495 : return frac_val(x, p);
1312 :
1313 721908 : case t_PADIC:
1314 721908 : if (tp == t_POL) return 0;
1315 721887 : if (!equalii(p,gel(x,2))) break;
1316 721880 : return valp(x);
1317 :
1318 35 : case t_POLMOD: {
1319 35 : GEN a = gel(x,1), b = gel(x,2);
1320 : long v, val;
1321 35 : if (tp == t_INT) return gvaluation(b,p);
1322 21 : v = varn(p);
1323 21 : if (varn(a) != v) return 0;
1324 21 : av = avma;
1325 21 : a = RgX_divrem(a, p, ONLY_DIVIDES);
1326 21 : if (!a) break;
1327 28 : if (typ(b) != t_POL || varn(b) != v ||
1328 21 : !(b = RgX_divrem(b, p, ONLY_DIVIDES)) ) return gc_long(av,0);
1329 7 : val = 1;
1330 28 : while ((a = RgX_divrem(a, p, ONLY_DIVIDES)) &&
1331 21 : (b = RgX_divrem(b, p, ONLY_DIVIDES)) ) val++;
1332 7 : return gc_long(av,val);
1333 : }
1334 6062 : case t_POL: {
1335 6062 : if (tp == t_POL) {
1336 5880 : long vp = varn(p), vx = varn(x);
1337 5880 : if (vp == vx)
1338 : {
1339 : long val;
1340 5866 : if (RgX_is_monomial(p))
1341 : {
1342 5831 : val = RgX_val(x); if (val == LONG_MAX) return LONG_MAX;
1343 5754 : return val / degpol(p);
1344 : }
1345 35 : if (!signe(x)) return LONG_MAX;
1346 21 : av = avma;
1347 21 : for (val=0; ; val++)
1348 : {
1349 35 : x = RgX_divrem(x,p,ONLY_DIVIDES);
1350 35 : if (!x) return gc_long(av,val);
1351 14 : if (gc_needed(av,1))
1352 : {
1353 0 : if(DEBUGMEM>1) pari_warn(warnmem,"gvaluation");
1354 0 : x = gerepilecopy(av, x);
1355 : }
1356 : }
1357 : }
1358 14 : if (varncmp(vx, vp) > 0) return 0;
1359 : }
1360 189 : return minval(x,p);
1361 : }
1362 :
1363 490 : case t_SER: {
1364 490 : if (tp == t_POL) {
1365 476 : long vp = varn(p), vx = varn(x);
1366 476 : if (vp == vx)
1367 : {
1368 469 : long val = RgX_val(p);
1369 469 : if (!val) pari_err_DOMAIN("gvaluation", "p", "=", p, p);
1370 462 : return (long)(valser(x) / val);
1371 : }
1372 7 : if (varncmp(vx, vp) > 0) return 0;
1373 : }
1374 14 : return minval(x,p);
1375 : }
1376 :
1377 49 : case t_RFRAC:
1378 49 : return gvaluation(gel(x,1),p) - gvaluation(gel(x,2),p);
1379 :
1380 126 : case t_COMPLEX: case t_QUAD: case t_VEC: case t_COL: case t_MAT:
1381 126 : return minval(x,p);
1382 : }
1383 63 : pari_err_OP("valuation", x,p);
1384 : return 0; /* LCOV_EXCL_LINE */
1385 : }
1386 : GEN
1387 3808 : gpvaluation(GEN x, GEN p)
1388 : {
1389 3808 : long v = gvaluation(x,p);
1390 3703 : return v == LONG_MAX? mkoo(): stoi(v);
1391 : }
1392 :
1393 : /* x is nonzero */
1394 : long
1395 87607407 : u_lvalrem(ulong x, ulong p, ulong *py)
1396 : {
1397 : ulong vx;
1398 87607407 : if (p == 2) { vx = vals(x); *py = x >> vx; return vx; }
1399 77505427 : for(vx = 0;;)
1400 : {
1401 124366433 : if (x % p) { *py = x; return vx; }
1402 46861006 : x /= p; /* gcc is smart enough to make a single div */
1403 46861006 : vx++;
1404 : }
1405 : }
1406 : long
1407 65861015 : u_lval(ulong x, ulong p)
1408 : {
1409 : ulong vx;
1410 65861015 : if (p == 2) return vals(x);
1411 62553229 : for(vx = 0;;)
1412 : {
1413 101869680 : if (x % p) return vx;
1414 39316451 : x /= p; /* gcc is smart enough to make a single div */
1415 39316451 : vx++;
1416 : }
1417 : }
1418 :
1419 : long
1420 1824633 : z_lval(long s, ulong p) { return u_lval(labs(s), p); }
1421 : long
1422 87345 : z_lvalrem(long s, ulong p, long *py)
1423 : {
1424 : long v;
1425 87345 : if (s < 0)
1426 : {
1427 0 : ulong u = (ulong)-s;
1428 0 : v = u_lvalrem(u, p, &u);
1429 0 : *py = -(long)u;
1430 : }
1431 : else
1432 : {
1433 87345 : ulong u = (ulong)s;
1434 87345 : v = u_lvalrem(u, p, &u);
1435 87344 : *py = (long)u;
1436 : }
1437 87344 : return v;
1438 : }
1439 : /* assume |p| > 1 */
1440 : long
1441 1318011 : z_pval(long s, GEN p)
1442 : {
1443 1318011 : if (lgefint(p) > 3) return 0;
1444 1318011 : return z_lval(s, uel(p,2));
1445 : }
1446 : /* assume |p| > 1 */
1447 : long
1448 399 : z_pvalrem(long s, GEN p, long *py)
1449 : {
1450 399 : if (lgefint(p) > 3) { *py = s; return 0; }
1451 399 : return z_lvalrem(s, uel(p,2), py);
1452 : }
1453 :
1454 : /* return v_q(x) and set *py = x / q^v_q(x), using divide & conquer */
1455 : static long
1456 2147626 : Z_pvalrem_DC(GEN x, GEN q, GEN *py)
1457 : {
1458 2147626 : GEN r, z = dvmdii(x, q, &r);
1459 : long v;
1460 2147551 : if (r != gen_0) { *py = x; return 0; }
1461 1485997 : if (2 * lgefint(q) <= lgefint(z)+3) /* avoid squaring if pointless */
1462 1468846 : v = Z_pvalrem_DC(z, sqri(q), py) << 1;
1463 : else
1464 17151 : { v = 0; *py = z; }
1465 1486007 : z = dvmdii(*py, q, &r);
1466 1486087 : if (r != gen_0) return v + 1;
1467 621728 : *py = z; return v + 2;
1468 : }
1469 :
1470 : static const long VAL_DC_THRESHOLD = 16;
1471 :
1472 : long
1473 62910488 : Z_lval(GEN x, ulong p)
1474 : {
1475 : long vx;
1476 : pari_sp av;
1477 62910488 : if (p == 2) return vali(x);
1478 48434990 : if (lgefint(x) == 3) return u_lval(uel(x,2), p);
1479 2193187 : av = avma;
1480 2193187 : for(vx = 0;;)
1481 10694783 : {
1482 : ulong r;
1483 12887970 : GEN q = absdiviu_rem(x, p, &r);
1484 12888755 : if (r) break;
1485 10879380 : vx++; x = q;
1486 10879380 : if (vx == VAL_DC_THRESHOLD) {
1487 184597 : if (p == 1) pari_err_DOMAIN("Z_lval", "p", "=", gen_1, gen_1);
1488 184597 : vx += Z_pvalrem_DC(x, sqru(p), &x) << 1;
1489 184597 : q = absdiviu_rem(x, p, &r); if (!r) vx++;
1490 184597 : break;
1491 : }
1492 : }
1493 2193972 : return gc_long(av,vx);
1494 : }
1495 : long
1496 63331160 : Z_lvalrem(GEN x, ulong p, GEN *py)
1497 : {
1498 : long vx, sx;
1499 : pari_sp av;
1500 63331160 : if (p == 2) { vx = vali(x); *py = shifti(x, -vx); return vx; }
1501 49990236 : if (lgefint(x) == 3) {
1502 : ulong u;
1503 43518863 : vx = u_lvalrem(uel(x,2), p, &u);
1504 43518495 : *py = signe(x) < 0? utoineg(u): utoipos(u);
1505 43516927 : return vx;
1506 : }
1507 6471373 : av = avma; (void)new_chunk(lgefint(x));
1508 6471888 : sx = signe(x);
1509 6471888 : for(vx = 0;;)
1510 17024145 : {
1511 : ulong r;
1512 23496033 : GEN q = absdiviu_rem(x, p, &r);
1513 23496021 : if (r) break;
1514 17517722 : vx++; x = q;
1515 17517722 : if (vx == VAL_DC_THRESHOLD) {
1516 493577 : if (p == 1) pari_err_DOMAIN("Z_lvalrem", "p", "=", gen_1, gen_1);
1517 493577 : vx += Z_pvalrem_DC(x, sqru(p), &x) << 1;
1518 493571 : q = absdiviu_rem(x, p, &r); if (!r) { vx++; x = q; }
1519 493573 : break;
1520 : }
1521 : }
1522 6471872 : set_avma(av); *py = icopy(x); setsigne(*py, sx); return vx;
1523 : }
1524 :
1525 : /* Is |q| <= p ? */
1526 : static int
1527 15029442 : isless_iu(GEN q, ulong p) {
1528 15029442 : long l = lgefint(q);
1529 15029442 : return l==2 || (l == 3 && uel(q,2) <= p);
1530 : }
1531 :
1532 : long
1533 134889675 : u_lvalrem_stop(ulong *n, ulong p, int *stop)
1534 : {
1535 134889675 : ulong N = *n, q = N / p, r = N % p; /* gcc makes a single div */
1536 134889675 : long v = 0;
1537 134889675 : if (!r)
1538 : {
1539 21229323 : do { v++; N = q; q = N / p; r = N % p; } while (!r);
1540 13684577 : *n = N;
1541 : }
1542 134889675 : *stop = q <= p; return v;
1543 : }
1544 : /* Assume n > 0. Return v_p(n), set *n := n/p^v_p(n). Set 'stop' if now
1545 : * n < p^2 [implies n prime if no prime < p divides n] */
1546 : long
1547 117720473 : Z_lvalrem_stop(GEN *n, ulong p, int *stop)
1548 : {
1549 : pari_sp av;
1550 : long v;
1551 : ulong r;
1552 : GEN N, q;
1553 :
1554 117720473 : if (lgefint(*n) == 3)
1555 : {
1556 102691375 : r = (*n)[2];
1557 102691375 : v = u_lvalrem_stop(&r, p, stop);
1558 102691174 : if (v) *n = utoipos(r);
1559 102692678 : return v;
1560 : }
1561 15029098 : av = avma; v = 0; q = absdiviu_rem(*n, p, &r);
1562 15029449 : if (r) set_avma(av);
1563 : else
1564 : {
1565 : do {
1566 265377 : v++; N = q;
1567 265377 : if (v == VAL_DC_THRESHOLD)
1568 : {
1569 629 : v += Z_pvalrem_DC(N,sqru(p),&N) << 1;
1570 629 : q = absdiviu_rem(N, p, &r); if (!r) { v++; N = q; }
1571 629 : break;
1572 : }
1573 264748 : q = absdiviu_rem(N, p, &r);
1574 264748 : } while (!r);
1575 223988 : *n = N;
1576 : }
1577 15029450 : *stop = isless_iu(q,p); return v;
1578 : }
1579 :
1580 : /* x is a nonzero integer, |p| > 1 */
1581 : long
1582 67677375 : Z_pvalrem(GEN x, GEN p, GEN *py)
1583 : {
1584 : long vx;
1585 : pari_sp av;
1586 :
1587 67677375 : if (lgefint(p) == 3) return Z_lvalrem(x, uel(p,2), py);
1588 13870607 : if (lgefint(x) == 3) { *py = icopy(x); return 0; }
1589 1573323 : av = avma; vx = 0; (void)new_chunk(lgefint(x));
1590 : for(;;)
1591 21654 : {
1592 1595015 : GEN r, q = dvmdii(x,p,&r);
1593 1595015 : if (r != gen_0) { set_avma(av); *py = icopy(x); return vx; }
1594 21654 : vx++; x = q;
1595 : }
1596 : }
1597 : long
1598 2622669 : u_pvalrem(ulong x, GEN p, ulong *py)
1599 : {
1600 2622669 : if (lgefint(p) == 3) return u_lvalrem(x, uel(p,2), py);
1601 554 : *py = x; return 0;
1602 : }
1603 : long
1604 136939 : u_pval(ulong x, GEN p)
1605 : {
1606 136939 : if (lgefint(p) == 3) return u_lval(x, uel(p,2));
1607 0 : return 0;
1608 : }
1609 : long
1610 47227680 : Z_pval(GEN x, GEN p) {
1611 : long vx;
1612 : pari_sp av;
1613 :
1614 47227680 : if (lgefint(p) == 3) return Z_lval(x, uel(p,2));
1615 32950 : if (lgefint(x) == 3) return 0;
1616 7977 : av = avma; vx = 0;
1617 : for(;;)
1618 25442 : {
1619 33419 : GEN r, q = dvmdii(x,p,&r);
1620 33436 : if (r != gen_0) return gc_long(av,vx);
1621 25442 : vx++; x = q;
1622 : }
1623 : }
1624 :
1625 : /* return v_p(n!) = [n/p] + [n/p^2] + ... */
1626 : long
1627 1991876 : factorial_lval(ulong n, ulong p)
1628 : {
1629 : ulong q, v;
1630 1991876 : if (p == 2) return n - hammingl(n);
1631 1319797 : q = p; v = 0;
1632 1448460 : do { v += n/q; q *= p; } while (n >= q);
1633 1319797 : return (long)v;
1634 : }
1635 :
1636 : /********** Same for "containers" ZX / ZV / ZC **********/
1637 :
1638 : /* If the t_INT q divides the ZX/ZV x, return the quotient. Otherwise NULL.
1639 : * Stack clean; assumes lg(x) > 1 */
1640 : static GEN
1641 6883 : gen_Z_divides(GEN x, GEN q, long imin)
1642 : {
1643 : long i, l;
1644 6883 : GEN y = cgetg_copy(x, &l);
1645 :
1646 6883 : y[1] = x[1]; /* Needed for ZX; no-op if ZV, overwritten in first iteration */
1647 89987 : for (i = imin; i < l; i++)
1648 : {
1649 87270 : GEN r, xi = gel(x,i);
1650 87270 : if (!signe(xi)) { gel(y,i) = xi; continue; }
1651 56685 : gel(y,i) = dvmdii(xi, q, &r);
1652 56685 : if (r != gen_0) { set_avma((pari_sp)(y+l)); return NULL; }
1653 : }
1654 2717 : return y;
1655 : }
1656 : /* If q divides the ZX/ZV x, return the quotient. Otherwise NULL.
1657 : * Stack clean; assumes lg(x) > 1 */
1658 : static GEN
1659 5082 : gen_z_divides(GEN x, ulong q, long imin)
1660 : {
1661 : long i, l;
1662 5082 : GEN y = cgetg_copy(x, &l);
1663 :
1664 5082 : y[1] = x[1]; /* Needed for ZX; no-op if ZV, overwritten in first iteration */
1665 44105 : for (i = imin; i < l; i++)
1666 : {
1667 : ulong r;
1668 42727 : GEN xi = gel(x,i);
1669 42727 : if (!signe(xi)) { gel(y,i) = xi; continue; }
1670 29342 : gel(y,i) = absdiviu_rem(xi, q, &r);
1671 29342 : if (r) { set_avma((pari_sp)(y+l)); return NULL; }
1672 25638 : affectsign_safe(xi, &gel(y,i));
1673 : }
1674 1378 : return y;
1675 : }
1676 :
1677 : /* return v_q(x) and set *py = x / q^v_q(x), using divide & conquer */
1678 : static long
1679 11927 : gen_pvalrem_DC(GEN x, GEN q, GEN *py, long imin)
1680 : {
1681 :
1682 11927 : pari_sp av = avma;
1683 11927 : long v, i, l, lz = LONG_MAX;
1684 11927 : GEN y = cgetg_copy(x, &l);
1685 :
1686 11927 : y[1] = x[1];
1687 137044 : for (i = imin; i < l; i++)
1688 : {
1689 130161 : GEN r, xi = gel(x,i);
1690 130161 : if (!signe(xi)) { gel(y,i) = xi; continue; }
1691 88257 : gel(y,i) = dvmdii(xi, q, &r);
1692 88257 : if (r != gen_0) { *py = x; return gc_long(av,0); }
1693 83213 : lz = minss(lz, lgefint(gel(y,i)));
1694 : }
1695 6883 : if (2 * lgefint(q) <= lz+3) /* avoid squaring if pointless */
1696 6831 : v = gen_pvalrem_DC(y, sqri(q), py, imin) << 1;
1697 : else
1698 52 : { v = 0; *py = y; }
1699 :
1700 6883 : y = gen_Z_divides(*py, q, imin);
1701 6883 : if (!y) return v+1;
1702 2717 : *py = y; return v+2;
1703 : }
1704 :
1705 : static long
1706 773485 : gen_2val(GEN x, long imin)
1707 : {
1708 773485 : long i, lx = lg(x), v = LONG_MAX;
1709 2927310 : for (i = imin; i < lx; i++)
1710 : {
1711 2488984 : GEN c = gel(x,i);
1712 : long w;
1713 2488984 : if (!signe(c)) continue;
1714 2277575 : w = vali(c);
1715 2277575 : if (w < v) { v = w; if (!v) break; }
1716 : }
1717 773485 : return v;
1718 : }
1719 : static long
1720 871225 : gen_lval(GEN x, ulong p, long imin)
1721 : {
1722 : long i, lx, v;
1723 : pari_sp av;
1724 : GEN y;
1725 871225 : if (p == 2) return gen_2val(x, imin);
1726 97740 : av = avma;
1727 97740 : lx = lg(x); y = leafcopy(x);
1728 293437 : for(v = 0;; v++)
1729 1441076 : for (i = imin; i < lx; i++)
1730 : {
1731 : ulong r;
1732 1245379 : gel(y,i) = absdiviu_rem(gel(y,i), p, &r);
1733 1245379 : if (r) return gc_long(av,v);
1734 : }
1735 : }
1736 : long
1737 748784 : ZX_lval(GEN x, ulong p) { return gen_lval(x, p, 2); }
1738 : long
1739 0 : ZV_lval(GEN x, ulong p) { return gen_lval(x, p, 1); }
1740 :
1741 : long
1742 28931 : zx_lval(GEN f, long p)
1743 : {
1744 28931 : long i, l = lg(f), x = LONG_MAX;
1745 30219 : for(i=2; i<l; i++)
1746 : {
1747 : long y;
1748 29477 : if (f[i] == 0) continue;
1749 29428 : y = z_lval(f[i], p);
1750 29428 : if (y < x) { x = y; if (x == 0) return x; }
1751 : }
1752 742 : return x;
1753 : }
1754 :
1755 : static long
1756 132759 : gen_pval(GEN x, GEN p, long imin)
1757 : {
1758 : long i, lx, v;
1759 : pari_sp av;
1760 : GEN y;
1761 132759 : if (lgefint(p) == 3) return gen_lval(x, p[2], imin);
1762 10318 : av = avma;
1763 10318 : lx = lg(x); y = leafcopy(x);
1764 10318 : for(v = 0;; v++)
1765 : {
1766 10318 : if (v == VAL_DC_THRESHOLD)
1767 : {
1768 0 : if (is_pm1(p)) pari_err_DOMAIN("gen_pval", "p", "=", p, p);
1769 0 : v += gen_pvalrem_DC(y, p, &y, imin);
1770 0 : return gc_long(av,v);
1771 : }
1772 :
1773 10318 : for (i = imin; i < lx; i++)
1774 : {
1775 10318 : GEN r; gel(y,i) = dvmdii(gel(y,i), p, &r);
1776 10318 : if (r != gen_0) return gc_long(av,v);
1777 : }
1778 : }
1779 : }
1780 : long
1781 101898 : ZX_pval(GEN x, GEN p) { return gen_pval(x, p, 2); }
1782 : long
1783 30861 : ZV_pval(GEN x, GEN p) { return gen_pval(x, p, 1); }
1784 : /* v = 0 (mod p) */
1785 : int
1786 1225 : ZV_Z_dvd(GEN v, GEN p)
1787 : {
1788 1225 : pari_sp av = avma;
1789 1225 : long i, l = lg(v);
1790 4256 : for (i=1; i<l; i++)
1791 3150 : if (!dvdii(gel(v,i), p)) return gc_int(av, 0);
1792 1106 : return gc_int(av, 1);
1793 : }
1794 :
1795 : static long
1796 4812959 : gen_2valrem(GEN x, GEN *px, long imin)
1797 : {
1798 4812959 : long i, lx = lg(x), v = LONG_MAX;
1799 : GEN z;
1800 13881544 : for (i = imin; i < lx; i++)
1801 : {
1802 12566246 : GEN c = gel(x,i);
1803 : long w;
1804 12566246 : if (!signe(c)) continue;
1805 11677588 : w = vali(c);
1806 11677778 : if (w < v) {
1807 6931350 : v = w;
1808 6931350 : if (!v) { *px = x; return 0; } /* early abort */
1809 : }
1810 : }
1811 1315298 : z = cgetg_copy(x, &lx); z[1] = x[1];
1812 8491555 : for (i=imin; i<lx; i++) gel(z,i) = shifti(gel(x,i), -v);
1813 1315015 : *px = z; return v;
1814 : }
1815 : static long
1816 8251896 : gen_lvalrem(GEN x, ulong p, GEN *px, long imin)
1817 : {
1818 : long i, lx, v;
1819 : GEN y;
1820 8251896 : if (p == 2) return gen_2valrem(x, px, imin);
1821 3439022 : y = cgetg_copy(x, &lx);
1822 3439280 : y[1] = x[1];
1823 3439280 : x = leafcopy(x);
1824 3438739 : for(v = 0;; v++)
1825 : {
1826 4876402 : if (v == VAL_DC_THRESHOLD)
1827 : {
1828 5082 : if (p == 1) pari_err_DOMAIN("gen_lvalrem", "p", "=", gen_1, gen_1);
1829 5082 : v += gen_pvalrem_DC(x, sqru(p), px, imin) << 1;
1830 5082 : x = gen_z_divides(*px, p, imin);
1831 5082 : if (x) { *px = x; v++; }
1832 5082 : return v;
1833 : }
1834 :
1835 15811437 : for (i = imin; i < lx; i++)
1836 : {
1837 14373774 : ulong r; gel(y,i) = absdiviu_rem(gel(x,i), p, &r);
1838 14373554 : if (r) { *px = x; return v; }
1839 10939419 : affectsign_safe(gel(x,i), &gel(y,i));
1840 : }
1841 1437663 : swap(x, y);
1842 : }
1843 : }
1844 : long
1845 721 : ZX_lvalrem(GEN x, ulong p, GEN *px) { return gen_lvalrem(x,p,px, 2); }
1846 : long
1847 0 : ZV_lvalrem(GEN x, ulong p, GEN *px) { return gen_lvalrem(x,p,px, 1); }
1848 :
1849 : static long
1850 8264093 : gen_pvalrem(GEN x, GEN p, GEN *px, long imin)
1851 : {
1852 : long i, lx, v;
1853 : GEN y;
1854 8264093 : if (lgefint(p) == 3) return gen_lvalrem(x, p[2], px, imin);
1855 12939 : y = cgetg_copy(x, &lx);
1856 12945 : y[1] = x[1];
1857 12945 : x = leafcopy(x);
1858 12945 : for(v = 0;; v++)
1859 : {
1860 13734 : if (v == VAL_DC_THRESHOLD)
1861 : {
1862 14 : if (is_pm1(p)) pari_err_DOMAIN("gen_pvalrem", "p", "=", p, p);
1863 14 : return v + gen_pvalrem_DC(x, p, px, imin);
1864 : }
1865 :
1866 22384 : for (i = imin; i < lx; i++)
1867 : {
1868 21595 : GEN r; gel(y,i) = dvmdii(gel(x,i), p, &r);
1869 21595 : if (r != gen_0) { *px = x; return v; }
1870 : }
1871 789 : swap(x, y);
1872 : }
1873 : }
1874 : long
1875 4311305 : ZX_pvalrem(GEN x, GEN p, GEN *px) { return gen_pvalrem(x,p,px, 2); }
1876 : long
1877 3952804 : ZV_pvalrem(GEN x, GEN p, GEN *px) { return gen_pvalrem(x,p,px, 1); }
1878 :
1879 : static long
1880 1176 : ZX_gen_pvalrem(GEN x, GEN p, GEN *px, long imin)
1881 : {
1882 : long i, lx, v;
1883 : GEN y;
1884 1176 : y = cgetg_copy(x, &lx);
1885 1176 : y[1] = x[1];
1886 1176 : x = leafcopy(x);
1887 12880 : for (i = imin; i < lx; i++)
1888 11704 : if (typ(gel(x, i)) != t_INT)
1889 : {
1890 10633 : gel(x, i) = leafcopy(gel(x,i));
1891 10633 : gel(y, i) = leafcopy(gel(x,i));
1892 : }
1893 1176 : for(v = 0;; v++)
1894 : {
1895 : #if 0
1896 : if (v == VAL_DC_THRESHOLD) /* TODO */
1897 : {
1898 : if (is_pm1(p)) pari_err_DOMAIN("ZX_gen_pvalrem", "p", "=", p, p);
1899 : return v + ZX_gen_pvalrem_DC(x, p, px, imin);
1900 : }
1901 : #endif
1902 :
1903 1176 : for (i = imin; i < lx; i++)
1904 : {
1905 1176 : GEN r, xi = gel(x,i);
1906 1176 : if (typ(xi) == t_INT)
1907 : {
1908 0 : gel(y,i) = dvmdii(xi, p, &r);
1909 1176 : if (r != gen_0) { *px = x; return v; }
1910 : } else
1911 : {
1912 1176 : long j, lxi = lg(xi);
1913 3017 : for(j = 2; j < lxi; j++)
1914 : {
1915 3017 : gmael(y,i,j) = dvmdii(gel(xi,j), p, &r);
1916 3017 : if (r != gen_0) { *px = x; return v; }
1917 : }
1918 : }
1919 : }
1920 0 : swap(x, y);
1921 : }
1922 : }
1923 :
1924 : long
1925 1176 : ZXX_pvalrem(GEN x, GEN p, GEN *px) { return ZX_gen_pvalrem(x,p,px, 2); }
1926 : long
1927 0 : ZXV_pvalrem(GEN x, GEN p, GEN *px) { return ZX_gen_pvalrem(x,p,px, 1); }
1928 :
1929 : /*******************************************************************/
1930 : /* */
1931 : /* NEGATION: Create -x */
1932 : /* */
1933 : /*******************************************************************/
1934 :
1935 : GEN
1936 465527234 : gneg(GEN x)
1937 : {
1938 : GEN y;
1939 465527234 : switch(typ(x))
1940 : {
1941 137064582 : case t_INT:
1942 137064582 : return signe(x)? negi(x): gen_0;
1943 241639993 : case t_REAL:
1944 241639993 : return mpneg(x);
1945 :
1946 157833 : case t_INTMOD: y=cgetg(3,t_INTMOD);
1947 157833 : gel(y,1) = icopy(gel(x,1));
1948 157833 : gel(y,2) = signe(gel(x,2))? subii(gel(y,1),gel(x,2)): gen_0;
1949 157833 : break;
1950 :
1951 3084666 : case t_FRAC:
1952 3084666 : y = cgetg(3, t_FRAC);
1953 3084662 : gel(y,1) = negi(gel(x,1));
1954 3084661 : gel(y,2) = icopy(gel(x,2)); break;
1955 :
1956 75637353 : case t_COMPLEX:
1957 75637353 : y=cgetg(3, t_COMPLEX);
1958 75638848 : gel(y,1) = gneg(gel(x,1));
1959 75640764 : gel(y,2) = gneg(gel(x,2));
1960 75640790 : break;
1961 :
1962 246584 : case t_POLMOD:
1963 246584 : retmkpolmod(gneg(gel(x,2)), RgX_copy(gel(x,1)));
1964 :
1965 153335 : case t_RFRAC:
1966 153335 : y = cgetg(3, t_RFRAC);
1967 153335 : gel(y,1) = gneg(gel(x,1));
1968 153335 : gel(y,2) = RgX_copy(gel(x,2)); break;
1969 :
1970 650302 : case t_PADIC:
1971 650302 : if (!signe(gel(x,4))) return gcopy(x);
1972 646683 : y = cgetg(5, t_PADIC);
1973 646682 : y[1] = x[1];
1974 646682 : gel(y,2) = icopy(gel(x,2));
1975 646682 : gel(y,3) = icopy(gel(x,3));
1976 646683 : gel(y,4) = subii(gel(x,3),gel(x,4));
1977 646682 : break;
1978 :
1979 133 : case t_QUAD:
1980 133 : y=cgetg(4,t_QUAD);
1981 133 : gel(y,1) = ZX_copy(gel(x,1));
1982 133 : gel(y,2) = gneg(gel(x,2));
1983 133 : gel(y,3) = gneg(gel(x,3)); break;
1984 :
1985 82160 : case t_FFELT: return FF_neg(x);
1986 6498718 : case t_POL: return RgX_neg(x);
1987 16688 : case t_SER: pari_APPLY_ser_normalized(gneg(gel(x,i)));
1988 1533 : case t_VEC: return RgV_neg(x);
1989 422434 : case t_COL: return RgC_neg(x);
1990 1211 : case t_MAT: return RgM_neg(x);
1991 784 : case t_INFINITY: return inf_get_sign(x) == 1? mkmoo(): mkoo();
1992 0 : default:
1993 0 : pari_err_TYPE("gneg",x);
1994 : return NULL; /* LCOV_EXCL_LINE */
1995 : }
1996 79683396 : return y;
1997 : }
1998 :
1999 : GEN
2000 133185758 : gneg_i(GEN x)
2001 : {
2002 : GEN y;
2003 133185758 : switch(typ(x))
2004 : {
2005 67853172 : case t_INT:
2006 67853172 : return signe(x)? negi(x): gen_0;
2007 31853168 : case t_REAL:
2008 31853168 : return mpneg(x);
2009 :
2010 590466 : case t_INTMOD: y=cgetg(3,t_INTMOD);
2011 590466 : gel(y,1) = gel(x,1);
2012 590466 : gel(y,2) = signe(gel(x,2))? subii(gel(y,1),gel(x,2)): gen_0;
2013 590466 : break;
2014 :
2015 5381341 : case t_FRAC:
2016 5381341 : y = cgetg(3, t_FRAC);
2017 5381339 : gel(y,1) = negi(gel(x,1));
2018 5381338 : gel(y,2) = gel(x,2); break;
2019 :
2020 10763444 : case t_COMPLEX:
2021 10763444 : y = cgetg(3, t_COMPLEX);
2022 10763530 : gel(y,1) = gneg_i(gel(x,1));
2023 10763590 : gel(y,2) = gneg_i(gel(x,2)); break;
2024 :
2025 2015057 : case t_PADIC: y = cgetg(5,t_PADIC);
2026 2015057 : y[1] = x[1];
2027 2015057 : gel(y,2) = gel(x,2);
2028 2015057 : gel(y,3) = gel(x,3);
2029 2015057 : gel(y,4) = signe(gel(x,4))? subii(gel(x,3),gel(x,4)): gen_0; break;
2030 :
2031 138338 : case t_POLMOD:
2032 138338 : retmkpolmod(gneg_i(gel(x,2)), RgX_copy(gel(x,1)));
2033 :
2034 84539 : case t_FFELT: return FF_neg_i(x);
2035 :
2036 672 : case t_QUAD: y=cgetg(4,t_QUAD);
2037 672 : gel(y,1) = gel(x,1);
2038 672 : gel(y,2) = gneg_i(gel(x,2));
2039 672 : gel(y,3) = gneg_i(gel(x,3)); break;
2040 :
2041 2478 : case t_VEC:
2042 : case t_COL:
2043 13594 : case t_MAT: pari_APPLY_same(gneg_i(gel(x,i)));
2044 36548929 : case t_POL: pari_APPLY_pol_normalized(gneg_i(gel(x,i)));
2045 3749049 : case t_SER: pari_APPLY_ser_normalized(gneg_i(gel(x,i)));
2046 :
2047 5005678 : case t_RFRAC:
2048 5005678 : y = cgetg(3, t_RFRAC);
2049 5005678 : gel(y,1) = gneg_i(gel(x,1));
2050 5005672 : gel(y,2) = gel(x,2); break;
2051 :
2052 0 : default:
2053 0 : pari_err_TYPE("gneg_i",x);
2054 : return NULL; /* LCOV_EXCL_LINE */
2055 : }
2056 23756855 : return y;
2057 : }
2058 :
2059 : /******************************************************************/
2060 : /* */
2061 : /* ABSOLUTE VALUE */
2062 : /* Create abs(x) if x is integer, real, fraction or complex. */
2063 : /* Error otherwise. */
2064 : /* */
2065 : /******************************************************************/
2066 : static int
2067 0 : is_negative(GEN x) {
2068 0 : switch(typ(x))
2069 : {
2070 0 : case t_INT: case t_REAL:
2071 0 : return (signe(x) < 0);
2072 0 : case t_FRAC:
2073 0 : return (signe(gel(x,1)) < 0);
2074 : }
2075 0 : return 0;
2076 : }
2077 :
2078 : GEN
2079 53242185 : gabs(GEN x, long prec)
2080 : {
2081 : long lx;
2082 : pari_sp av;
2083 : GEN y, N;
2084 :
2085 53242185 : switch(typ(x))
2086 : {
2087 35217044 : case t_INT: case t_REAL:
2088 35217044 : return mpabs(x);
2089 :
2090 12804 : case t_FRAC:
2091 12804 : return absfrac(x);
2092 :
2093 17915419 : case t_COMPLEX:
2094 17915419 : av=avma; N=cxnorm(x);
2095 17895906 : switch(typ(N))
2096 : {
2097 266 : case t_INT:
2098 266 : if (!Z_issquareall(N, &y)) break;
2099 105 : return gerepileupto(av, y);
2100 21735 : case t_FRAC: {
2101 : GEN a,b;
2102 36036 : if (!Z_issquareall(gel(N,1), &a)) break;
2103 14301 : if (!Z_issquareall(gel(N,2), &b)) break;
2104 0 : return gerepileupto(av, gdiv(a,b));
2105 : }
2106 : }
2107 17895801 : return gerepileupto(av, gsqrt(N,prec));
2108 :
2109 21 : case t_QUAD:
2110 21 : av = avma;
2111 21 : return gerepileuptoleaf(av, gabs(quadtofp(x, prec), prec));
2112 :
2113 0 : case t_POL:
2114 0 : lx = lg(x); if (lx<=2) return RgX_copy(x);
2115 0 : return is_negative(gel(x,lx-1))? RgX_neg(x): RgX_copy(x);
2116 :
2117 7 : case t_SER:
2118 7 : if (!signe(x)) pari_err_DOMAIN("abs", "argument", "=", gen_0, x);
2119 7 : if (valser(x)) pari_err_DOMAIN("abs", "series valuation", "!=", gen_0, x);
2120 0 : return is_negative(gel(x,2))? gneg(x): gcopy(x);
2121 :
2122 101996 : case t_VEC: case t_COL: case t_MAT:
2123 591552 : pari_APPLY_same(gabs(gel(x,i),prec));
2124 :
2125 14 : case t_INFINITY:
2126 14 : return mkoo();
2127 : }
2128 0 : pari_err_TYPE("gabs",x);
2129 : return NULL; /* LCOV_EXCL_LINE */
2130 : }
2131 :
2132 : GEN
2133 79310 : gmax(GEN x, GEN y) { return gcopy(gmax_shallow(x,y)); }
2134 : GEN
2135 0 : gmaxgs(GEN x, long s) { return (gcmpsg(s,x)>=0)? stoi(s): gcopy(x); }
2136 :
2137 : GEN
2138 12285 : gmin(GEN x, GEN y) { return gcopy(gmin_shallow(x,y)); }
2139 : GEN
2140 0 : gmings(GEN x, long s) { return (gcmpsg(s,x)>0)? gcopy(x): stoi(s); }
2141 :
2142 : long
2143 503190 : vecindexmax(GEN x)
2144 : {
2145 503190 : long lx = lg(x), i0, i;
2146 : GEN s;
2147 :
2148 503190 : if (lx==1) pari_err_DOMAIN("vecindexmax", "empty argument", "=", x,x);
2149 503191 : switch(typ(x))
2150 : {
2151 503191 : case t_VEC: case t_COL:
2152 503191 : s = gel(x,i0=1);
2153 1502453 : for (i=2; i<lx; i++)
2154 999260 : if (gcmp(gel(x,i),s) > 0) s = gel(x,i0=i);
2155 503193 : return i0;
2156 0 : case t_VECSMALL:
2157 0 : return vecsmall_indexmax(x);
2158 0 : default: pari_err_TYPE("vecindexmax",x);
2159 : }
2160 : /* LCOV_EXCL_LINE */
2161 0 : return 0;
2162 : }
2163 : long
2164 181366 : vecindexmin(GEN x)
2165 : {
2166 181366 : long lx = lg(x), i0, i;
2167 : GEN s;
2168 :
2169 181366 : if (lx==1) pari_err_DOMAIN("vecindexmin", "empty argument", "=", x,x);
2170 181366 : switch(typ(x))
2171 : {
2172 181366 : case t_VEC: case t_COL:
2173 181366 : s = gel(x,i0=1);
2174 943837 : for (i=2; i<lx; i++)
2175 762471 : if (gcmp(gel(x,i),s) < 0) s = gel(x,i0=i);
2176 181366 : return i0;
2177 0 : case t_VECSMALL:
2178 0 : return vecsmall_indexmin(x);
2179 0 : default: pari_err_TYPE("vecindexmin",x);
2180 : }
2181 : /* LCOV_EXCL_LINE */
2182 0 : return 0;
2183 : }
2184 :
2185 : GEN
2186 226751 : vecmax0(GEN x, GEN *pi)
2187 : {
2188 226751 : long i, lx = lg(x), tx = typ(x);
2189 226751 : if (!is_matvec_t(tx) && tx != t_VECSMALL
2190 49 : && (tx != t_LIST || list_typ(x) != t_LIST_RAW)) return gcopy(x);
2191 226730 : if (tx == t_LIST)
2192 28 : { if (list_data(x)) { x = list_data(x); lx = lg(x); } else lx = 1; }
2193 226730 : if (lx==1) pari_err_DOMAIN("vecmax", "empty argument", "=", x,x);
2194 226688 : switch(typ(x))
2195 : {
2196 226211 : case t_VEC: case t_COL:
2197 226211 : i = vecindexmax(x); if (pi) *pi = utoipos(i);
2198 226214 : return gcopy(gel(x,i));
2199 456 : case t_MAT: {
2200 456 : long j, i0 = 1, j0 = 1, lx2 = lgcols(x);
2201 : GEN s;
2202 456 : if (lx2 == 1) pari_err_DOMAIN("vecmax", "empty argument", "=", x,x);
2203 449 : s = gcoeff(x,i0,j0); i = 2;
2204 1205 : for (j=1; j<lx; j++,i=1)
2205 : {
2206 756 : GEN c = gel(x,j);
2207 1817 : for (; i<lx2; i++)
2208 1061 : if (gcmp(gel(c,i),s) > 0) { s = gel(c,i); j0=j; i0=i; }
2209 : }
2210 449 : if (pi) *pi = mkvec2(utoipos(i0), utoipos(j0));
2211 449 : return gcopy(s);
2212 : }
2213 21 : case t_VECSMALL:
2214 21 : i = vecsmall_indexmax(x); if (pi) *pi = utoipos(i);
2215 21 : return stoi(x[i]);
2216 : }
2217 : return NULL;/*LCOV_EXCL_LINE*/
2218 : }
2219 : GEN
2220 146716 : vecmin0(GEN x, GEN *pi)
2221 : {
2222 146716 : long i, lx = lg(x), tx = typ(x);
2223 146716 : if (!is_matvec_t(tx) && tx != t_VECSMALL
2224 49 : && (tx != t_LIST || list_typ(x) != t_LIST_RAW)) return gcopy(x);
2225 146695 : if (tx == t_LIST)
2226 28 : { if (list_data(x)) { x = list_data(x); lx = lg(x); } else lx = 1; }
2227 146695 : if (lx==1) pari_err_DOMAIN("vecmin", "empty argument", "=", x,x);
2228 146660 : switch(typ(x))
2229 : {
2230 146618 : case t_VEC: case t_COL:
2231 146618 : i = vecindexmin(x); if (pi) *pi = utoipos(i);
2232 146618 : return gcopy(gel(x,i));
2233 21 : case t_MAT: {
2234 21 : long j, i0 = 1, j0 = 1, lx2 = lgcols(x);
2235 : GEN s;
2236 21 : if (lx2 == 1) pari_err_DOMAIN("vecmin", "empty argument", "=", x,x);
2237 21 : s = gcoeff(x,i0,j0); i = 2;
2238 63 : for (j=1; j<lx; j++,i=1)
2239 : {
2240 42 : GEN c = gel(x,j);
2241 105 : for (; i<lx2; i++)
2242 63 : if (gcmp(gel(c,i),s) < 0) { s = gel(c,i); j0=j; i0=i; }
2243 : }
2244 21 : if (pi) *pi = mkvec2(utoipos(i0), utoipos(j0));
2245 21 : return gcopy(s);
2246 : }
2247 21 : case t_VECSMALL:
2248 21 : i = vecsmall_indexmin(x); if (pi) *pi = utoipos(i);
2249 21 : return stoi(x[i]);
2250 : }
2251 : return NULL;/*LCOV_EXCL_LINE*/
2252 : }
2253 :
2254 : GEN
2255 66166 : vecmax(GEN x) { return vecmax0(x, NULL); }
2256 : GEN
2257 34548 : vecmin(GEN x) { return vecmin0(x, NULL); }
2258 :
2259 : /*******************************************************************/
2260 : /* */
2261 : /* AFFECT long --> GEN */
2262 : /* affect long s to GEN x. Useful for initialization. */
2263 : /* */
2264 : /*******************************************************************/
2265 :
2266 : static void
2267 0 : padicaff0(GEN x)
2268 : {
2269 0 : if (signe(gel(x,4)))
2270 : {
2271 0 : x[1] = evalvalp(valp(x)+precp(x));
2272 0 : affsi(0,gel(x,4));
2273 : }
2274 0 : }
2275 :
2276 : void
2277 91840 : gaffsg(long s, GEN x)
2278 : {
2279 91840 : switch(typ(x))
2280 : {
2281 90930 : case t_INT: affsi(s,x); break;
2282 910 : case t_REAL: affsr(s,x); break;
2283 0 : case t_INTMOD: modsiz(s,gel(x,1),gel(x,2)); break;
2284 0 : case t_FRAC: affsi(s,gel(x,1)); affsi(1,gel(x,2)); break;
2285 0 : case t_COMPLEX: gaffsg(s,gel(x,1)); gaffsg(0,gel(x,2)); break;
2286 0 : case t_PADIC: {
2287 : long vx;
2288 : GEN y;
2289 0 : if (!s) { padicaff0(x); break; }
2290 0 : vx = Z_pvalrem(stoi(s), gel(x,2), &y);
2291 0 : setvalp(x,vx); modiiz(y,gel(x,3),gel(x,4));
2292 0 : break;
2293 : }
2294 0 : case t_QUAD: gaffsg(s,gel(x,2)); gaffsg(0,gel(x,3)); break;
2295 0 : default: pari_err_TYPE2("=",stoi(s),x);
2296 : }
2297 91840 : }
2298 :
2299 : /*******************************************************************/
2300 : /* */
2301 : /* GENERIC AFFECTATION */
2302 : /* Affect the content of x to y, whenever possible */
2303 : /* */
2304 : /*******************************************************************/
2305 : /* x PADIC, Y INT, return lift(x * Mod(1,Y)) */
2306 : GEN
2307 4298 : padic_to_Fp(GEN x, GEN Y) {
2308 4298 : pari_sp av = avma;
2309 4298 : GEN p = gel(x,2), z;
2310 4298 : long vy, vx = valp(x);
2311 4298 : if (!signe(Y)) pari_err_INV("padic_to_Fp",Y);
2312 4298 : vy = Z_pvalrem(Y,p, &z);
2313 4298 : if (vx < 0 || !gequal1(z)) pari_err_OP("",x, mkintmod(gen_1,Y));
2314 4277 : if (vx >= vy) { set_avma(av); return gen_0; }
2315 3962 : z = gel(x,4);
2316 3962 : if (!signe(z) || vy > vx + precp(x)) pari_err_OP("",x, mkintmod(gen_1,Y));
2317 3962 : if (vx) z = mulii(z, powiu(p,vx));
2318 3962 : return gerepileuptoint(av, remii(z, Y));
2319 : }
2320 : ulong
2321 421694 : padic_to_Fl(GEN x, ulong Y) {
2322 421694 : GEN p = gel(x,2);
2323 : ulong u, z;
2324 421694 : long vy, vx = valp(x);
2325 421694 : vy = u_pvalrem(Y,p, &u);
2326 421697 : if (vx < 0 || u != 1) pari_err_OP("",x, mkintmodu(1,Y));
2327 : /* Y = p^vy */
2328 421697 : if (vx >= vy) return 0;
2329 375987 : z = umodiu(gel(x,4), Y);
2330 375992 : if (!z || vy > vx + precp(x)) pari_err_OP("",x, mkintmodu(1,Y));
2331 375992 : if (vx) {
2332 0 : ulong pp = p[2];
2333 0 : z = Fl_mul(z, upowuu(pp,vx), Y); /* p^vx < p^vy = Y */
2334 : }
2335 375992 : return z;
2336 : }
2337 :
2338 : static void
2339 0 : croak(const char *s) {
2340 : char *t;
2341 0 : t = stack_sprintf("gaffect [overwriting universal object: %s]",s);
2342 0 : pari_err_BUG(t);
2343 0 : }
2344 :
2345 : void
2346 664578 : gaffect(GEN x, GEN y)
2347 : {
2348 664578 : long vx, i, lx, ly, tx = typ(x), ty = typ(y);
2349 : pari_sp av;
2350 : GEN p1, num, den;
2351 :
2352 664578 : if (tx == ty) switch(tx) {
2353 215629 : case t_INT:
2354 572738 : if (!is_universal_constant(y)) { affii(x,y); return; }
2355 : /* y = gen_0, gnil, gen_1 or gen_2 */
2356 0 : if (y==gen_0) croak("gen_0");
2357 0 : if (y==gen_1) croak("gen_1");
2358 0 : if (y==gen_m1) croak("gen_m1");
2359 0 : if (y==gen_m2) croak("gen_m2");
2360 0 : if (y==gen_2) croak("gen_2");
2361 0 : croak("gnil)");
2362 188958 : case t_REAL: affrr(x,y); return;
2363 0 : case t_INTMOD:
2364 0 : if (!dvdii(gel(x,1),gel(y,1))) pari_err_OP("",x,y);
2365 0 : modiiz(gel(x,2),gel(y,1),gel(y,2)); return;
2366 0 : case t_FRAC:
2367 0 : affii(gel(x,1),gel(y,1));
2368 0 : affii(gel(x,2),gel(y,2)); return;
2369 95438 : case t_COMPLEX:
2370 95438 : gaffect(gel(x,1),gel(y,1));
2371 95438 : gaffect(gel(x,2),gel(y,2)); return;
2372 0 : case t_PADIC:
2373 0 : if (!equalii(gel(x,2),gel(y,2))) pari_err_OP("",x,y);
2374 0 : modiiz(gel(x,4),gel(y,3),gel(y,4));
2375 0 : setvalp(y,valp(x)); return;
2376 0 : case t_QUAD:
2377 0 : if (! ZX_equal(gel(x,1),gel(y,1))) pari_err_OP("",x,y);
2378 0 : affii(gel(x,2),gel(y,2));
2379 0 : affii(gel(x,3),gel(y,3)); return;
2380 72713 : case t_VEC: case t_COL: case t_MAT:
2381 72713 : lx = lg(x); if (lx != lg(y)) pari_err_DIM("gaffect");
2382 194584 : for (i=1; i<lx; i++) gaffect(gel(x,i),gel(y,i));
2383 72713 : return;
2384 : }
2385 :
2386 : /* Various conversions. Avoid them, use specialized routines ! */
2387 :
2388 91840 : if (!is_const_t(ty)) pari_err_TYPE2("=",x,y);
2389 91840 : switch(tx)
2390 : {
2391 0 : case t_INT:
2392 : switch(ty)
2393 : {
2394 0 : case t_REAL:
2395 0 : affir(x,y); break;
2396 :
2397 0 : case t_INTMOD:
2398 0 : modiiz(x,gel(y,1),gel(y,2)); break;
2399 :
2400 0 : case t_COMPLEX:
2401 0 : gaffect(x,gel(y,1)); gaffsg(0,gel(y,2)); break;
2402 :
2403 0 : case t_PADIC:
2404 0 : if (!signe(x)) { padicaff0(y); break; }
2405 0 : av = avma;
2406 0 : setvalp(y, Z_pvalrem(x,gel(y,2),&p1));
2407 0 : affii(modii(p1,gel(y,3)), gel(y,4));
2408 0 : set_avma(av); break;
2409 :
2410 0 : case t_QUAD: gaffect(x,gel(y,2)); gaffsg(0,gel(y,3)); break;
2411 0 : default: pari_err_TYPE2("=",x,y);
2412 : }
2413 0 : break;
2414 :
2415 91840 : case t_REAL:
2416 : switch(ty)
2417 : {
2418 91840 : case t_COMPLEX: gaffect(x,gel(y,1)); gaffsg(0,gel(y,2)); break;
2419 0 : default: pari_err_TYPE2("=",x,y);
2420 : }
2421 91840 : break;
2422 :
2423 0 : case t_FRAC:
2424 : switch(ty)
2425 : {
2426 0 : case t_REAL: rdiviiz(gel(x,1),gel(x,2), y); break;
2427 0 : case t_INTMOD: av = avma;
2428 0 : p1 = Fp_inv(gel(x,2),gel(y,1));
2429 0 : affii(modii(mulii(gel(x,1),p1),gel(y,1)), gel(y,2));
2430 0 : set_avma(av); break;
2431 0 : case t_COMPLEX: gaffect(x,gel(y,1)); gaffsg(0,gel(y,2)); break;
2432 0 : case t_PADIC:
2433 0 : if (!signe(gel(x,1))) { padicaff0(y); break; }
2434 0 : num = gel(x,1);
2435 0 : den = gel(x,2);
2436 0 : av = avma; vx = Z_pvalrem(num, gel(y,2), &num);
2437 0 : if (!vx) vx = -Z_pvalrem(den,gel(y,2),&den);
2438 0 : setvalp(y,vx);
2439 0 : p1 = mulii(num,Fp_inv(den,gel(y,3)));
2440 0 : affii(modii(p1,gel(y,3)), gel(y,4)); set_avma(av); break;
2441 0 : case t_QUAD: gaffect(x,gel(y,2)); gaffsg(0,gel(y,3)); break;
2442 0 : default: pari_err_TYPE2("=",x,y);
2443 : }
2444 0 : break;
2445 :
2446 0 : case t_COMPLEX:
2447 0 : if (!gequal0(gel(x,2))) pari_err_TYPE2("=",x,y);
2448 0 : gaffect(gel(x,1), y);
2449 0 : break;
2450 :
2451 0 : case t_PADIC:
2452 : switch(ty)
2453 : {
2454 0 : case t_INTMOD:
2455 0 : av = avma; affii(padic_to_Fp(x, gel(y,1)), gel(y,2));
2456 0 : set_avma(av); break;
2457 0 : default: pari_err_TYPE2("=",x,y);
2458 : }
2459 0 : break;
2460 :
2461 0 : case t_QUAD:
2462 : switch(ty)
2463 : {
2464 0 : case t_INT: case t_INTMOD: case t_FRAC: case t_PADIC:
2465 0 : pari_err_TYPE2("=",x,y);
2466 :
2467 0 : case t_REAL:
2468 0 : av = avma; affgr(quadtofp(x,realprec(y)), y); set_avma(av); break;
2469 0 : case t_COMPLEX:
2470 0 : ly = precision(y); if (!ly) pari_err_TYPE2("=",x,y);
2471 0 : av = avma; gaffect(quadtofp(x,ly), y); set_avma(av); break;
2472 0 : default: pari_err_TYPE2("=",x,y);
2473 : }
2474 0 : default: pari_err_TYPE2("=",x,y);
2475 : }
2476 : }
2477 :
2478 : /*******************************************************************/
2479 : /* */
2480 : /* CONVERSION QUAD --> REAL, COMPLEX OR P-ADIC */
2481 : /* */
2482 : /*******************************************************************/
2483 : GEN
2484 252 : quadtofp(GEN x, long prec)
2485 : {
2486 252 : GEN b, D, z, u = gel(x,2), v = gel(x,3);
2487 : pari_sp av;
2488 252 : if (prec < LOWDEFAULTPREC) prec = LOWDEFAULTPREC;
2489 252 : if (isintzero(v)) return cxcompotor(u, prec);
2490 252 : av = avma; D = quad_disc(x); b = gel(gel(x,1),3); /* 0 or -1 */
2491 : /* u + v (-b + sqrt(D)) / 2 */
2492 252 : if (!signe(b)) b = NULL;
2493 252 : if (b) u = gadd(gmul2n(u,1), v);
2494 252 : z = sqrtr_abs(itor(D, prec));
2495 252 : if (!b) shiftr_inplace(z, -1);
2496 252 : z = gmul(v, z);
2497 252 : if (signe(D) < 0)
2498 : {
2499 35 : z = mkcomplex(cxcompotor(u, prec), z);
2500 35 : if (!b) return gerepilecopy(av, z);
2501 0 : z = gmul2n(z, -1);
2502 : }
2503 : else
2504 : { /* if (b) x ~ (u + z) / 2 and quadnorm(x) ~ (u^2 - z^2) / 4
2505 : * else x ~ u + z and quadnorm(x) ~ u^2 - z^2 */
2506 217 : long s = gsigne(u);
2507 217 : if (s == -gsigne(v)) /* conjugate expression avoids cancellation */
2508 : {
2509 14 : z = gdiv(quadnorm(x), gsub(u, z));
2510 14 : if (b) shiftr_inplace(z, 1);
2511 : }
2512 : else
2513 : {
2514 203 : if (s) z = gadd(u, z);
2515 203 : if (b) shiftr_inplace(z, -1);
2516 : }
2517 : }
2518 217 : return gerepileupto(av, z);
2519 : }
2520 :
2521 : static GEN
2522 28 : qtop(GEN x, GEN p, long d)
2523 : {
2524 28 : GEN z, D, P, b, u = gel(x,2), v = gel(x,3);
2525 : pari_sp av;
2526 28 : if (gequal0(v)) return cvtop(u, p, d);
2527 28 : P = gel(x,1);
2528 28 : b = gel(P,3);
2529 28 : av = avma; D = quad_disc(x);
2530 28 : if (absequaliu(p,2)) d += 2;
2531 28 : z = Qp_sqrt(cvtop(D,p,d));
2532 28 : if (!z) pari_err_SQRTN("Qp_sqrt",D);
2533 14 : z = gmul2n(gsub(z, b), -1);
2534 :
2535 14 : z = gadd(u, gmul(v, z));
2536 14 : if (typ(z) != t_PADIC) /* t_INTMOD for t_QUAD of t_INTMODs... */
2537 0 : z = cvtop(z, p, d);
2538 14 : return gerepileupto(av, z);
2539 : }
2540 : static GEN
2541 14 : ctop(GEN x, GEN p, long d)
2542 : {
2543 14 : pari_sp av = avma;
2544 14 : GEN z, u = gel(x,1), v = gel(x,2);
2545 14 : if (isrationalzero(v)) return cvtop(u, p, d);
2546 14 : z = Qp_sqrt(cvtop(gen_m1, p, d - gvaluation(v, p))); /* = I */
2547 14 : if (!z) pari_err_SQRTN("Qp_sqrt",gen_m1);
2548 :
2549 14 : z = gadd(u, gmul(v, z));
2550 14 : if (typ(z) != t_PADIC) /* t_INTMOD for t_COMPLEX of t_INTMODs... */
2551 0 : z = cvtop(z, p, d);
2552 14 : return gerepileupto(av, z);
2553 : }
2554 :
2555 : /* cvtop2(stoi(s), y) */
2556 : GEN
2557 399 : cvstop2(long s, GEN y)
2558 : {
2559 399 : GEN z, p = gel(y,2);
2560 399 : long v, d = signe(gel(y,4))? precp(y): 0;
2561 399 : if (!s) return zeropadic_shallow(p, d);
2562 399 : v = z_pvalrem(s, p, &s);
2563 399 : if (d <= 0) return zeropadic_shallow(p, v);
2564 399 : z = cgetg(5, t_PADIC);
2565 399 : z[1] = evalprecp(d) | evalvalp(v);
2566 399 : gel(z,2) = p;
2567 399 : gel(z,3) = gel(y,3);
2568 399 : gel(z,4) = modsi(s, gel(y,3)); return z;
2569 : }
2570 :
2571 : static GEN
2572 17610583 : itop2_coprime(GEN x, GEN y, long v, long d)
2573 : {
2574 17610583 : GEN z = cgetg(5, t_PADIC);
2575 17609944 : z[1] = evalprecp(d) | evalvalp(v);
2576 17609975 : gel(z,2) = gel(y,2);
2577 17609975 : gel(z,3) = gel(y,3);
2578 17609975 : gel(z,4) = modii(x, gel(y,3)); return z;
2579 : }
2580 : /* cvtop(x, gel(y,2), precp(y)), shallow */
2581 : GEN
2582 17618217 : cvtop2(GEN x, GEN y)
2583 : {
2584 17618217 : GEN p = gel(y,2);
2585 17618217 : long v, d = signe(gel(y,4))? precp(y): 0;
2586 17618217 : switch(typ(x))
2587 : {
2588 14819689 : case t_INT:
2589 14819689 : if (!signe(x)) return zeropadic_shallow(p, d);
2590 14819689 : if (d <= 0) return zeropadic_shallow(p, Z_pval(x,p));
2591 14815300 : v = Z_pvalrem(x, p, &x); return itop2_coprime(x, y, v, d);
2592 :
2593 0 : case t_INTMOD:
2594 0 : v = Z_pval(gel(x,1),p); if (v > d) v = d;
2595 0 : return cvtop(gel(x,2), p, v);
2596 :
2597 2797504 : case t_FRAC:
2598 : {
2599 : GEN num, den;
2600 2797504 : if (d <= 0) return zeropadic_shallow(p, Q_pval(x,p));
2601 2796223 : num = gel(x,1); v = Z_pvalrem(num, p, &num);
2602 2796215 : den = gel(x,2); if (!v) v = -Z_pvalrem(den, p, &den);
2603 2796216 : if (!is_pm1(den)) num = mulii(num, Fp_inv(den, gel(y,3)));
2604 2796214 : return itop2_coprime(num, y, v, d);
2605 : }
2606 7 : case t_COMPLEX: return ctop(x, p, d);
2607 28 : case t_QUAD: return qtop(x, p, d);
2608 1197 : case t_PADIC:
2609 1197 : if (!signe(gel(x,4))) return zeropadic_shallow(p, d);
2610 1197 : if (precp(x) <= d) return x;
2611 35 : return itop2_coprime(gel(x,4), y, valp(x), d); /* reduce accuracy */
2612 : }
2613 0 : pari_err_TYPE("cvtop2",x);
2614 : return NULL; /* LCOV_EXCL_LINE */
2615 : }
2616 :
2617 : /* assume is_const_t(tx) */
2618 : GEN
2619 600505 : cvtop(GEN x, GEN p, long d)
2620 : {
2621 : GEN z;
2622 : long v;
2623 :
2624 600505 : if (typ(p) != t_INT) pari_err_TYPE("cvtop",p);
2625 600505 : switch(typ(x))
2626 : {
2627 268229 : case t_INT:
2628 268229 : if (!signe(x)) return zeropadic(p, d);
2629 267011 : if (d <= 0) return zeropadic(p, Z_pval(x,p));
2630 266955 : v = Z_pvalrem(x, p, &x);
2631 266955 : z = cgetg(5, t_PADIC);
2632 266955 : z[1] = evalprecp(d) | evalvalp(v);
2633 266955 : gel(z,2) = icopy(p);
2634 266955 : gel(z,3) = powiu(p, d);
2635 266955 : gel(z,4) = modii(x, gel(z,3)); return z; /* not memory-clean */
2636 :
2637 28 : case t_INTMOD:
2638 28 : v = Z_pval(gel(x,1),p); if (v > d) v = d;
2639 28 : return cvtop(gel(x,2), p, v);
2640 :
2641 163019 : case t_FRAC:
2642 : {
2643 : GEN num, den;
2644 163019 : if (d <= 0) return zeropadic(p, Q_pval(x,p));
2645 163005 : num = gel(x,1); v = Z_pvalrem(num, p, &num);
2646 163005 : den = gel(x,2); if (!v) v = -Z_pvalrem(den, p, &den);
2647 163005 : z = cgetg(5, t_PADIC);
2648 163005 : z[1] = evalprecp(d) | evalvalp(v);
2649 163005 : gel(z,2) = icopy(p);
2650 163005 : gel(z,3) = powiu(p, d);
2651 163005 : if (!is_pm1(den)) num = mulii(num, Fp_inv(den, gel(z,3)));
2652 163005 : gel(z,4) = modii(num, gel(z,3)); return z; /* not memory-clean */
2653 : }
2654 7 : case t_COMPLEX: return ctop(x, p, d);
2655 169222 : case t_PADIC:
2656 169222 : p = gel(x,2); /* override */
2657 169222 : if (!signe(gel(x,4))) return zeropadic(p, d);
2658 169138 : z = cgetg(5,t_PADIC);
2659 169138 : z[1] = x[1]; setprecp(z,d);
2660 169138 : gel(z,2) = icopy(p);
2661 169138 : gel(z,3) = powiu(p, d);
2662 169138 : gel(z,4) = modii(gel(x,4), gel(z,3)); return z;
2663 :
2664 0 : case t_QUAD: return qtop(x, p, d);
2665 : }
2666 0 : pari_err_TYPE("cvtop",x);
2667 : return NULL; /* LCOV_EXCL_LINE */
2668 : }
2669 :
2670 : GEN
2671 126 : gcvtop(GEN x, GEN p, long r)
2672 : {
2673 126 : switch(typ(x))
2674 : {
2675 63 : case t_POL: pari_APPLY_pol_normalized(gcvtop(gel(x,i),p,r));
2676 35 : case t_SER: pari_APPLY_ser_normalized(gcvtop(gel(x,i),p,r));
2677 0 : case t_POLMOD: case t_RFRAC: case t_VEC: case t_COL: case t_MAT:
2678 0 : pari_APPLY_same(gcvtop(gel(x,i),p,r));
2679 : }
2680 98 : return cvtop(x,p,r);
2681 : }
2682 :
2683 : long
2684 821761603 : gexpo_safe(GEN x)
2685 : {
2686 821761603 : long tx = typ(x), lx, e, f, i;
2687 :
2688 821761603 : switch(tx)
2689 : {
2690 167437681 : case t_INT:
2691 167437681 : return expi(x);
2692 :
2693 1070002 : case t_FRAC:
2694 1070002 : return expi(gel(x,1)) - expi(gel(x,2));
2695 :
2696 457613794 : case t_REAL:
2697 457613794 : return expo(x);
2698 :
2699 87178657 : case t_COMPLEX:
2700 87178657 : e = gexpo(gel(x,1));
2701 87178736 : f = gexpo(gel(x,2)); return maxss(e, f);
2702 :
2703 91 : case t_QUAD: {
2704 91 : GEN p = gel(x,1); /* mod = X^2 + {0,1}* X - {D/4, (1-D)/4})*/
2705 91 : long d = 1 + expi(gel(p,2))/2; /* ~ expo(sqrt(D)) */
2706 91 : e = gexpo(gel(x,2));
2707 91 : f = gexpo(gel(x,3)) + d; return maxss(e, f);
2708 : }
2709 76955031 : case t_POL: case t_SER:
2710 76955031 : lx = lg(x); f = -(long)HIGHEXPOBIT;
2711 307624667 : for (i=2; i<lx; i++) { e=gexpo(gel(x,i)); if (e>f) f=e; }
2712 76950210 : return f;
2713 31623186 : case t_VEC: case t_COL: case t_MAT:
2714 31623186 : lx = lg(x); f = -(long)HIGHEXPOBIT;
2715 217248903 : for (i=1; i<lx; i++) { e=gexpo(gel(x,i)); if (e>f) f=e; }
2716 31623214 : return f;
2717 : }
2718 48 : return -1-(long)HIGHEXPOBIT;
2719 : }
2720 : long
2721 821521247 : gexpo(GEN x)
2722 : {
2723 821521247 : long e = gexpo_safe(x);
2724 821524009 : if (e < -(long)HIGHEXPOBIT) pari_err_TYPE("gexpo",x);
2725 821527904 : return e;
2726 : }
2727 : GEN
2728 89795 : gpexponent(GEN x)
2729 : {
2730 89795 : long e = gexpo(x);
2731 89795 : return e == -(long)HIGHEXPOBIT? mkmoo(): stoi(e);
2732 : }
2733 :
2734 : long
2735 7 : sizedigit(GEN x)
2736 : {
2737 7 : return gequal0(x)? 0: (long) ((gexpo(x)+1) * LOG10_2) + 1;
2738 : }
2739 :
2740 : /* normalize series. avma is not updated */
2741 : GEN
2742 13353268 : normalizeser(GEN x)
2743 : {
2744 13353268 : long i, lx = lg(x), vx=varn(x), vp=valser(x);
2745 : GEN y, z;
2746 :
2747 13353268 : if (lx == 2) { setsigne(x,0); return x; }
2748 13352904 : if (lx == 3) {
2749 191358 : z = gel(x,2);
2750 191358 : if (!gequal0(z)) { setsigne(x,1); return x; }
2751 23758 : if (isrationalzero(z)) return zeroser(vx,vp+1);
2752 4291 : if (isexactzero(z)) {
2753 : /* dangerous case: already normalized ? */
2754 252 : if (!signe(x)) return x;
2755 35 : setvalser(x,vp+1); /* no: normalize */
2756 : }
2757 4074 : setsigne(x,0); return x;
2758 : }
2759 13455662 : for (i=2; i<lx; i++)
2760 13408930 : if (! isrationalzero(gel(x,i))) break;
2761 13161546 : if (i == lx) return zeroser(vx,lx-2+vp);
2762 13114814 : z = gel(x,i);
2763 13118615 : while (i<lx && isexactzero(gel(x,i))) i++;
2764 13114814 : if (i == lx)
2765 : {
2766 273 : i -= 3; y = x + i;
2767 273 : stackdummy((pari_sp)y, (pari_sp)x);
2768 273 : gel(y,2) = z;
2769 273 : y[1] = evalsigne(0) | evalvalser(lx-2+vp) | evalvarn(vx);
2770 273 : y[0] = evaltyp(t_SER) | _evallg(3);
2771 273 : return y;
2772 : }
2773 :
2774 13114541 : i -= 2; y = x + i; lx -= i;
2775 13114541 : y[1] = evalsigne(1) | evalvalser(vp+i) | evalvarn(vx);
2776 13114541 : y[0] = evaltyp(t_SER) | _evallg(lx);
2777 :
2778 13114541 : stackdummy((pari_sp)y, (pari_sp)x);
2779 13143568 : for (i = 2; i < lx; i++)
2780 13142679 : if (!gequal0(gel(y, i))) return y;
2781 889 : setsigne(y, 0); return y;
2782 : }
2783 :
2784 : GEN
2785 0 : normalizepol_approx(GEN x, long lx)
2786 : {
2787 : long i;
2788 0 : for (i = lx-1; i>1; i--)
2789 0 : if (! gequal0(gel(x,i))) break;
2790 0 : stackdummy((pari_sp)(x + lg(x)), (pari_sp)(x + i+1));
2791 0 : setlg(x, i+1); setsigne(x, i!=1); return x;
2792 : }
2793 :
2794 : GEN
2795 784115200 : normalizepol_lg(GEN x, long lx)
2796 : {
2797 784115200 : long i, LX = 0;
2798 784115200 : GEN KEEP = NULL;
2799 :
2800 1038517339 : for (i = lx-1; i>1; i--)
2801 : {
2802 933447236 : GEN z = gel(x,i);
2803 933447236 : if (! gequal0(z) ) {
2804 679260550 : if (!LX) LX = i+1;
2805 679260550 : stackdummy((pari_sp)(x + lg(x)), (pari_sp)(x + LX));
2806 679248383 : x[0] = evaltyp(t_POL) | _evallg(LX);
2807 679248383 : setsigne(x,1); return x;
2808 254157163 : } else if (!isexactzero(z)) {
2809 976486 : if (!LX) LX = i+1; /* to be kept as leading coeff */
2810 253429324 : } else if (!isrationalzero(z))
2811 827988 : KEEP = z; /* to be kept iff all other coeffs are exact 0s */
2812 : }
2813 105070103 : if (!LX) {
2814 104552254 : if (KEEP) { /* e.g. Pol(Mod(0,2)) */
2815 347042 : gel(x,2) = KEEP;
2816 347042 : LX = 3;
2817 : } else
2818 104205212 : LX = 2; /* Pol(0) */
2819 : }
2820 105070103 : stackdummy((pari_sp)(x + lg(x)), (pari_sp)(x + LX));
2821 104955489 : x[0] = evaltyp(t_POL) | _evallg(LX);
2822 104955489 : setsigne(x,0); return x;
2823 : }
2824 :
2825 : /* normalize polynomial x in place */
2826 : GEN
2827 99325269 : normalizepol(GEN x)
2828 : {
2829 99325269 : return normalizepol_lg(x, lg(x));
2830 : }
2831 :
2832 : int
2833 79459857 : gsigne(GEN x)
2834 : {
2835 79459857 : switch(typ(x))
2836 : {
2837 79079523 : case t_INT: case t_REAL: return signe(x);
2838 379709 : case t_FRAC: return signe(gel(x,1));
2839 623 : case t_QUAD:
2840 : {
2841 623 : pari_sp av = avma;
2842 623 : GEN T = gel(x,1), a = gel(x,2), b = gel(x,3);
2843 : long sa, sb;
2844 623 : if (signe(gel(T,2)) > 0) break;
2845 609 : a = gmul2n(a,1);
2846 609 : if (signe(gel(T,3))) a = gadd(a,b);
2847 : /* a + b sqrt(D) > 0 ? */
2848 609 : sa = gsigne(a);
2849 609 : sb = gsigne(b); if (sa == sb) return gc_int(av,sa);
2850 224 : if (sa == 0) return gc_int(av,sb);
2851 217 : if (sb == 0) return gc_int(av,sa);
2852 : /* different signs, take conjugate expression */
2853 210 : sb = gsigne(gsub(gsqr(a), gmul(quad_disc(x), gsqr(b))));
2854 210 : return gc_int(av, sb*sa);
2855 : }
2856 14 : case t_INFINITY: return inf_get_sign(x);
2857 : }
2858 12 : pari_err_TYPE("gsigne",x);
2859 : return 0; /* LCOV_EXCL_LINE */
2860 : }
2861 :
2862 : /*******************************************************************/
2863 : /* */
2864 : /* LISTS */
2865 : /* */
2866 : /*******************************************************************/
2867 : /* make sure L can hold l elements, at least doubling the previous max number
2868 : * of components. */
2869 : static void
2870 810971 : ensure_nb(GEN L, long l)
2871 : {
2872 810971 : long nmax = list_nmax(L), i, lw;
2873 : GEN v, w;
2874 810971 : if (l <= nmax) return;
2875 1246 : if (nmax)
2876 : {
2877 490 : nmax <<= 1;
2878 490 : if (l > nmax) nmax = l;
2879 490 : w = list_data(L); lw = lg(w);
2880 490 : v = newblock(nmax+1);
2881 490 : v[0] = w[0];
2882 1070958 : for (i=1; i < lw; i++) gel(v,i) = gel(w, i);
2883 490 : killblock(w);
2884 : }
2885 : else /* unallocated */
2886 : {
2887 756 : nmax = 32;
2888 756 : if (list_data(L))
2889 0 : pari_err(e_MISC, "store list in variable before appending elements");
2890 756 : v = newblock(nmax+1);
2891 756 : v[0] = evaltyp(t_VEC) | _evallg(1);
2892 : }
2893 1246 : list_data(L) = v;
2894 1246 : L[1] = evaltyp(list_typ(L))|evallg(nmax);
2895 : }
2896 :
2897 : GEN
2898 6891 : mklist_typ(long t)
2899 : {
2900 6891 : GEN L = cgetg(3,t_LIST);
2901 6891 : L[1] = evaltyp(t);
2902 6891 : list_data(L) = NULL; return L;
2903 : }
2904 :
2905 : GEN
2906 6835 : mklist(void)
2907 : {
2908 6835 : return mklist_typ(t_LIST_RAW);
2909 : }
2910 :
2911 : GEN
2912 49 : mkmap(void)
2913 : {
2914 49 : return mklist_typ(t_LIST_MAP);
2915 : }
2916 :
2917 : /* return a list with single element x, allocated on stack */
2918 : GEN
2919 63 : mklistcopy(GEN x)
2920 : {
2921 63 : GEN y = mklist();
2922 63 : list_data(y) = mkveccopy(x);
2923 63 : return y;
2924 : }
2925 :
2926 : GEN
2927 776125 : listput(GEN L, GEN x, long index)
2928 : {
2929 : long l;
2930 : GEN z;
2931 :
2932 776125 : if (index < 0) pari_err_COMPONENT("listput", "<", gen_0, stoi(index));
2933 776118 : z = list_data(L);
2934 776118 : l = z? lg(z): 1;
2935 :
2936 776118 : x = gclone(x);
2937 776118 : if (!index || index >= l)
2938 : {
2939 775964 : ensure_nb(L, l);
2940 775964 : z = list_data(L); /* it may change ! */
2941 775964 : index = l;
2942 775964 : l++;
2943 : } else
2944 154 : gunclone_deep( gel(z, index) );
2945 776118 : gel(z,index) = x;
2946 776118 : z[0] = evaltyp(t_VEC) | evallg(l); /*must be after gel(z,index) is set*/
2947 776118 : return gel(z,index);
2948 : }
2949 :
2950 : GEN
2951 724955 : listput0(GEN L, GEN x, long index)
2952 : {
2953 724955 : if (typ(L) != t_LIST || list_typ(L) != t_LIST_RAW)
2954 14 : pari_err_TYPE("listput",L);
2955 724941 : (void) listput(L, x, index);
2956 724934 : return x;
2957 : }
2958 :
2959 : GEN
2960 35014 : listinsert(GEN L, GEN x, long index)
2961 : {
2962 : long l, i;
2963 : GEN z;
2964 :
2965 35014 : z = list_data(L); l = z? lg(z): 1;
2966 35014 : if (index <= 0) pari_err_COMPONENT("listinsert", "<=", gen_0, stoi(index));
2967 35007 : if (index > l) index = l;
2968 35007 : ensure_nb(L, l);
2969 35007 : BLOCK_SIGINT_START
2970 35007 : z = list_data(L);
2971 87552507 : for (i=l; i > index; i--) gel(z,i) = gel(z,i-1);
2972 35007 : z[0] = evaltyp(t_VEC) | evallg(l+1);
2973 35007 : gel(z,index) = gclone(x);
2974 35007 : BLOCK_SIGINT_END
2975 35007 : return gel(z,index);
2976 : }
2977 :
2978 : GEN
2979 35028 : listinsert0(GEN L, GEN x, long index)
2980 : {
2981 35028 : if (typ(L) != t_LIST || list_typ(L) != t_LIST_RAW)
2982 14 : pari_err_TYPE("listinsert",L);
2983 35014 : (void) listinsert(L, x, index);
2984 35007 : return x;
2985 : }
2986 :
2987 : void
2988 21917 : listpop(GEN L, long index)
2989 : {
2990 : long l, i;
2991 : GEN z;
2992 :
2993 21917 : if (typ(L) != t_LIST) pari_err_TYPE("listinsert",L);
2994 21917 : if (index < 0) pari_err_COMPONENT("listpop", "<", gen_0, stoi(index));
2995 21917 : z = list_data(L);
2996 21917 : if (!z || (l = lg(z)-1) == 0) return;
2997 :
2998 21903 : if (!index || index > l) index = l;
2999 21903 : BLOCK_SIGINT_START
3000 21903 : gunclone_deep( gel(z, index) );
3001 21903 : z[0] = evaltyp(t_VEC) | _evallg(l);
3002 21910 : for (i=index; i < l; i++) z[i] = z[i+1];
3003 21903 : BLOCK_SIGINT_END
3004 : }
3005 :
3006 : void
3007 56 : listpop0(GEN L, long index)
3008 : {
3009 56 : if (typ(L) != t_LIST || list_typ(L) != t_LIST_RAW)
3010 14 : pari_err_TYPE("listpop",L);
3011 42 : listpop(L, index);
3012 42 : }
3013 :
3014 : /* return a copy fully allocated on stack. gclone from changevalue is
3015 : * supposed to malloc() it */
3016 : GEN
3017 5930 : gtolist(GEN x)
3018 : {
3019 : GEN y;
3020 :
3021 5930 : if (!x) return mklist();
3022 370 : switch(typ(x))
3023 : {
3024 300 : case t_VEC: case t_COL:
3025 300 : y = mklist();
3026 300 : if (lg(x) == 1) return y;
3027 279 : list_data(y) = gcopy(x);
3028 279 : settyp(list_data(y), t_VEC);
3029 279 : return y;
3030 7 : case t_LIST:
3031 7 : y = mklist();
3032 7 : list_data(y) = list_data(x)? gcopy(list_data(x)): NULL;
3033 7 : return y;
3034 63 : default:
3035 63 : return mklistcopy(x);
3036 : }
3037 : }
3038 :
3039 : void
3040 21 : listsort(GEN L, long flag)
3041 : {
3042 : long i, l;
3043 21 : pari_sp av = avma;
3044 : GEN perm, v, vnew;
3045 :
3046 21 : if (typ(L) != t_LIST) pari_err_TYPE("listsort",L);
3047 21 : v = list_data(L); l = v? lg(v): 1;
3048 21 : if (l < 3) return;
3049 21 : if (flag)
3050 : {
3051 : long lnew;
3052 14 : perm = gen_indexsort_uniq(L, (void*)&cmp_universal, cmp_nodata);
3053 14 : lnew = lg(perm); /* may have changed since 'uniq' */
3054 14 : vnew = cgetg(lnew,t_VEC);
3055 56 : for (i=1; i<lnew; i++) {
3056 42 : long c = perm[i];
3057 42 : gel(vnew,i) = gel(v,c);
3058 42 : gel(v,c) = NULL;
3059 : }
3060 14 : if (l != lnew) { /* was shortened */
3061 105 : for (i=1; i<l; i++)
3062 91 : if (gel(v,i)) gunclone_deep(gel(v,i));
3063 14 : l = lnew;
3064 : }
3065 : }
3066 : else
3067 : {
3068 7 : perm = gen_indexsort(L, (void*)&cmp_universal, cmp_nodata);
3069 7 : vnew = cgetg(l,t_VEC);
3070 63 : for (i=1; i<l; i++) gel(vnew,i) = gel(v,perm[i]);
3071 : }
3072 119 : for (i=1; i<l; i++) gel(v,i) = gel(vnew,i);
3073 21 : v[0] = vnew[0]; set_avma(av);
3074 : }
|
