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