Code coverage tests

This page documents the degree to which the PARI/GP source code is tested by our public test suite, distributed with the source distribution in directory src/test/. This is measured by the gcov utility; we then process gcov output using the lcov frond-end.

We test a few variants depending on Configure flags on the pari.math.u-bordeaux.fr machine (x86_64 architecture), and agregate them in the final report:

The target is to exceed 90% coverage for all mathematical modules (given that branches depending on DEBUGLEVEL or DEBUGMEM are not covered). This script is run to produce the results below.

LCOV - code coverage report
Current view: top level - basemath - bibli2.c (source / functions) Hit Total Coverage
Test: PARI/GP v2.18.0 lcov report (development 29685-209b4888d8) Lines: 1255 1315 95.4 %
Date: 2024-11-05 09:09:42 Functions: 116 121 95.9 %
Legend: Lines: hit not hit

          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             : #include "pari.h"
      16             : #include "paripriv.h"
      17             : 
      18             : /*******************************************************************/
      19             : /**                                                               **/
      20             : /**                      SPECIAL POLYNOMIALS                      **/
      21             : /**                                                               **/
      22             : /*******************************************************************/
      23             : /* Tchebichev polynomial: T0=1; T1=X; T(n)=2*X*T(n-1)-T(n-2)
      24             :  * T(n) = (n/2) sum_{k=0}^{n/2} a_k x^(n-2k)
      25             :  *   where a_k = (-1)^k 2^(n-2k) (n-k-1)! / k!(n-2k)! is an integer
      26             :  *   and a_0 = 2^(n-1), a_k / a_{k-1} = - (n-2k+2)(n-2k+1) / 4k(n-k) */
      27             : GEN
      28        2156 : polchebyshev1(long n, long v) /* Assume 4*n < LONG_MAX */
      29             : {
      30             :   long k, l;
      31             :   pari_sp av;
      32             :   GEN q,a,r;
      33             : 
      34        2156 :   if (v<0) v = 0;
      35             :   /* polchebyshev(-n,1) = polchebyshev(n,1) */
      36        2156 :   if (n < 0) n = -n;
      37        2156 :   if (n==0) return pol_1(v);
      38        2135 :   if (n==1) return pol_x(v);
      39             : 
      40        2093 :   q = cgetg(n+3, t_POL); r = q + n+2;
      41        2093 :   a = int2n(n-1);
      42        2093 :   gel(r--,0) = a;
      43        2093 :   gel(r--,0) = gen_0;
      44       31955 :   for (k=1,l=n; l>1; k++,l-=2)
      45             :   {
      46       29862 :     av = avma;
      47       29862 :     a = diviuuexact(muluui(l, l-1, a), 4*k, n-k);
      48       29862 :     togglesign(a); a = gerepileuptoint(av, a);
      49       29862 :     gel(r--,0) = a;
      50       29862 :     gel(r--,0) = gen_0;
      51             :   }
      52        2093 :   q[1] = evalsigne(1) | evalvarn(v);
      53        2093 :   return q;
      54             : }
      55             : static void
      56          70 : polchebyshev1_eval_aux(long n, GEN x, GEN *pt1, GEN *pt2)
      57             : {
      58             :   GEN t1, t2, b;
      59          70 :   if (n == 1) { *pt1 = gen_1; *pt2 = x; return; }
      60          56 :   if (n == 0) { *pt1 = x; *pt2 = gen_1; return; }
      61          56 :   polchebyshev1_eval_aux((n+1) >> 1, x, &t1, &t2);
      62          56 :   b = gsub(gmul(gmul2n(t1,1), t2), x);
      63          56 :   if (odd(n)) { *pt1 = gadd(gmul2n(gsqr(t1), 1), gen_m1); *pt2 = b; }
      64          42 :   else        { *pt1 = b; *pt2 = gadd(gmul2n(gsqr(t2), 1), gen_m1); }
      65             : }
      66             : static GEN
      67          14 : polchebyshev1_eval(long n, GEN x)
      68             : {
      69             :   GEN t1, t2;
      70             :   long i, v;
      71             :   pari_sp av;
      72             : 
      73          14 :   if (n < 0) n = -n;
      74          14 :   if (n==0) return gen_1;
      75          14 :   if (n==1) return gcopy(x);
      76          14 :   av = avma;
      77          14 :   v = u_lvalrem(n, 2, (ulong*)&n);
      78          14 :   polchebyshev1_eval_aux((n+1)>>1, x, &t1, &t2);
      79          14 :   if (n != 1) t2 = gsub(gmul(gmul2n(t1,1), t2), x);
      80          35 :   for (i = 1; i <= v; i++) t2 = gadd(gmul2n(gsqr(t2), 1), gen_m1);
      81          14 :   return gerepileupto(av, t2);
      82             : }
      83             : 
      84             : /* Chebychev  polynomial of the second kind U(n,x): the coefficient in front of
      85             :  * x^(n-2*m) is (-1)^m * 2^(n-2m)*(n-m)!/m!/(n-2m)!  for m=0,1,...,n/2 */
      86             : GEN
      87        2135 : polchebyshev2(long n, long v)
      88             : {
      89             :   pari_sp av;
      90             :   GEN q, a, r;
      91             :   long m;
      92        2135 :   int neg = 0;
      93             : 
      94        2135 :   if (v<0) v = 0;
      95             :   /* polchebyshev(-n,2) = -polchebyshev(n-2,2) */
      96        2135 :   if (n < 0) {
      97        1050 :     if (n == -1) return zeropol(v);
      98        1029 :     neg = 1; n = -n-2;
      99             :   }
     100        2114 :   if (n==0) return neg ? scalar_ZX_shallow(gen_m1, v): pol_1(v);
     101             : 
     102        2072 :   q = cgetg(n+3, t_POL); r = q + n+2;
     103        2072 :   a = int2n(n);
     104        2072 :   if (neg) togglesign(a);
     105        2072 :   gel(r--,0) = a;
     106        2072 :   gel(r--,0) = gen_0;
     107       30807 :   for (m=1; 2*m<= n; m++)
     108             :   {
     109       28735 :     av = avma;
     110       28735 :     a = diviuuexact(muluui(n-2*m+2, n-2*m+1, a), 4*m, n-m+1);
     111       28735 :     togglesign(a); a = gerepileuptoint(av, a);
     112       28735 :     gel(r--,0) = a;
     113       28735 :     gel(r--,0) = gen_0;
     114             :   }
     115        2072 :   q[1] = evalsigne(1) | evalvarn(v);
     116        2072 :   return q;
     117             : }
     118             : static void
     119          91 : polchebyshev2_eval_aux(long n, GEN x, GEN *pu1, GEN *pu2)
     120             : {
     121             :   GEN u1, u2, u, mu1;
     122          91 :   if (n == 1) { *pu1 = gen_1; *pu2 = gmul2n(x,1); return; }
     123          70 :   if (n == 0) { *pu1 = gen_0; *pu2 = gen_1; return; }
     124          70 :   polchebyshev2_eval_aux(n >> 1, x, &u1, &u2);
     125          70 :   mu1 = gneg(u1);
     126          70 :   u = gmul(gadd(u2,u1), gadd(u2,mu1));
     127          70 :   if (odd(n)) { *pu1 = u; *pu2 = gmul(gmul2n(u2,1), gadd(gmul(x,u2), mu1)); }
     128          35 :   else        { *pu2 = u; *pu1 = gmul(gmul2n(u1,1), gadd(u2, gmul(x,mu1))); }
     129             : }
     130             : static GEN
     131          35 : polchebyshev2_eval(long n, GEN x)
     132             : {
     133             :   GEN u1, u2, mu1;
     134          35 :   long neg = 0;
     135             :   pari_sp av;
     136             : 
     137          35 :   if (n < 0) {
     138          14 :     if (n == -1) return gen_0;
     139           7 :     neg = 1; n = -n-2;
     140             :   }
     141          28 :   if (n==0) return neg ? gen_m1: gen_1;
     142          21 :   av = avma;
     143          21 :   polchebyshev2_eval_aux(n>>1, x, &u1, &u2);
     144          21 :   mu1 = gneg(u1);
     145          21 :   if (odd(n)) u2 = gmul(gmul2n(u2,1), gadd(gmul(x,u2), mu1));
     146          14 :   else        u2 = gmul(gadd(u2,u1), gadd(u2,mu1));
     147          21 :   if (neg) u2 = gneg(u2);
     148          21 :   return gerepileupto(av, u2);
     149             : }
     150             : 
     151             : GEN
     152        4284 : polchebyshev(long n, long kind, long v)
     153             : {
     154        4284 :   switch (kind)
     155             :   {
     156        2149 :     case 1: return polchebyshev1(n, v);
     157        2135 :     case 2: return polchebyshev2(n, v);
     158           0 :     default: pari_err_FLAG("polchebyshev");
     159             :   }
     160             :   return NULL; /* LCOV_EXCL_LINE */
     161             : }
     162             : GEN
     163        4333 : polchebyshev_eval(long n, long kind, GEN x)
     164             : {
     165        4333 :   if (!x) return polchebyshev(n, kind, 0);
     166          63 :   if (gequalX(x)) return polchebyshev(n, kind, varn(x));
     167          49 :   switch (kind)
     168             :   {
     169          14 :     case 1: return polchebyshev1_eval(n, x);
     170          35 :     case 2: return polchebyshev2_eval(n, x);
     171           0 :     default: pari_err_FLAG("polchebyshev");
     172             :   }
     173             :   return NULL; /* LCOV_EXCL_LINE */
     174             : }
     175             : 
     176             : /* Hermite polynomial H(n,x):  H(n+1) = 2x H(n) - 2n H(n-1)
     177             :  * The coefficient in front of x^(n-2*m) is
     178             :  * (-1)^m * n! * 2^(n-2m)/m!/(n-2m)!  for m=0,1,...,n/2.. */
     179             : GEN
     180        1442 : polhermite(long n, long v)
     181             : {
     182             :   long m;
     183             :   pari_sp av;
     184             :   GEN q,a,r;
     185             : 
     186        1442 :   if (v<0) v = 0;
     187        1442 :   if (n==0) return pol_1(v);
     188             : 
     189        1435 :   q = cgetg(n+3, t_POL); r = q + n+2;
     190        1435 :   a = int2n(n);
     191        1435 :   gel(r--,0) = a;
     192        1435 :   gel(r--,0) = gen_0;
     193       40327 :   for (m=1; 2*m<= n; m++)
     194             :   {
     195       38892 :     av = avma;
     196       38892 :     a = diviuexact(muluui(n-2*m+2, n-2*m+1, a), 4*m);
     197       38892 :     togglesign(a);
     198       38892 :     gel(r--,0) = a = gerepileuptoint(av, a);
     199       38892 :     gel(r--,0) = gen_0;
     200             :   }
     201        1435 :   q[1] = evalsigne(1) | evalvarn(v);
     202        1435 :   return q;
     203             : }
     204             : static void
     205          21 : err_hermite(long n)
     206          21 : { pari_err_DOMAIN("polhermite", "degree", "<", gen_0, stoi(n)); }
     207             : GEN
     208        1477 : polhermite_eval0(long n, GEN x, long flag)
     209             : {
     210             :   long i;
     211             :   pari_sp av, av2;
     212             :   GEN x2, u, v;
     213             : 
     214        1477 :   if (n < 0) err_hermite(n);
     215        1470 :   if (!x || gequalX(x))
     216             :   {
     217        1442 :     long v = x? varn(x): 0;
     218        1442 :     if (flag)
     219             :     {
     220          14 :       if (!n) err_hermite(-1);
     221           7 :       retmkvec2(polhermite(n-1,v),polhermite(n,v));
     222             :     }
     223        1428 :     return polhermite(n, v);
     224             :   }
     225          28 :   if (n==0)
     226             :   {
     227           7 :     if (flag) err_hermite(-1);
     228           0 :     return gen_1;
     229             :   }
     230          21 :   if (n==1)
     231             :   {
     232           0 :     if (flag) retmkvec2(gen_1, gmul2n(x,1));
     233           0 :     return gmul2n(x,1);
     234             :   }
     235          21 :   av = avma; x2 = gmul2n(x,1); v = gen_1; u = x2;
     236          21 :   av2= avma;
     237        7070 :   for (i=1; i<n; i++)
     238             :   { /* u = H_i(x), v = H_{i-1}(x), compute t = H_{i+1}(x) */
     239             :     GEN t;
     240        7049 :     if ((i & 0xff) == 0) gerepileall(av2,2,&u, &v);
     241        7049 :     t = gsub(gmul(x2, u), gmulsg(2*i,v));
     242        7049 :     v = u; u = t;
     243             :   }
     244          21 :   if (flag) return gerepilecopy(av, mkvec2(v, u));
     245          14 :   return gerepileupto(av, u);
     246             : }
     247             : GEN
     248           0 : polhermite_eval(long n, GEN x) { return polhermite_eval0(n, x, 0); }
     249             : 
     250             : /* Legendre polynomial
     251             :  * L0=1; L1=X; (n+1)*L(n+1)=(2*n+1)*X*L(n)-n*L(n-1)
     252             :  * L(n) = 2^-n sum_{k=0}^{n/2} a_k x^(n-2k)
     253             :  *   where a_k = (-1)^k (2n-2k)! / k! (n-k)! (n-2k)! is an integer
     254             :  *   and a_0 = binom(2n,n), a_k / a_{k-1} = - (n-2k+1)(n-2k+2) / 2k (2n-2k+1) */
     255             : GEN
     256        2163 : pollegendre(long n, long v)
     257             : {
     258             :   long k, l;
     259             :   pari_sp av;
     260             :   GEN a, r, q;
     261             : 
     262        2163 :   if (v<0) v = 0;
     263             :   /* pollegendre(-n) = pollegendre(n-1) */
     264        2163 :   if (n < 0) n = -n-1;
     265        2163 :   if (n==0) return pol_1(v);
     266        2121 :   if (n==1) return pol_x(v);
     267             : 
     268        2079 :   av = avma;
     269        2079 :   q = cgetg(n+3, t_POL); r = q + n+2;
     270        2079 :   gel(r--,0) = a = binomialuu(n<<1,n);
     271        2079 :   gel(r--,0) = gen_0;
     272       31423 :   for (k=1,l=n; l>1; k++,l-=2)
     273             :   { /* l = n-2*k+2 */
     274       29344 :     av = avma;
     275       29344 :     a = diviuuexact(muluui(l, l-1, a), 2*k, n+l-1);
     276       29344 :     togglesign(a); a = gerepileuptoint(av, a);
     277       29344 :     gel(r--,0) = a;
     278       29344 :     gel(r--,0) = gen_0;
     279             :   }
     280        2079 :   q[1] = evalsigne(1) | evalvarn(v);
     281        2079 :   return gerepileupto(av, gmul2n(q,-n));
     282             : }
     283             : /* q such that Ln * 2^n = q(x^2) [n even] or x q(x^2) [n odd] */
     284             : GEN
     285           0 : pollegendre_reduced(long n, long v)
     286             : {
     287             :   long k, l, N;
     288             :   pari_sp av;
     289             :   GEN a, r, q;
     290             : 
     291           0 :   if (v<0) v = 0;
     292             :   /* pollegendre(-n) = pollegendre(n-1) */
     293           0 :   if (n < 0) n = -n-1;
     294           0 :   if (n<=1) return n? scalarpol_shallow(gen_2,v): pol_1(v);
     295             : 
     296           0 :   N = n >> 1;
     297           0 :   q = cgetg(N+3, t_POL); r = q + N+2;
     298           0 :   gel(r--,0) = a = binomialuu(n<<1,n);
     299           0 :   for (k=1,l=n; l>1; k++,l-=2)
     300             :   { /* l = n-2*k+2 */
     301           0 :     av = avma;
     302           0 :     a = diviuuexact(muluui(l, l-1, a), 2*k, n+l-1);
     303           0 :     togglesign(a);
     304           0 :     gel(r--,0) = a = gerepileuptoint(av, a);
     305             :   }
     306           0 :   q[1] = evalsigne(1) | evalvarn(v);
     307           0 :   return q;
     308             : }
     309             : 
     310             : GEN
     311        2177 : pollegendre_eval0(long n, GEN x, long flag)
     312             : {
     313             :   pari_sp av;
     314             :   GEN u, v;
     315             :   long i;
     316             : 
     317        2177 :   if (n < 0) n = -n-1; /* L(-n) = L(n-1) */
     318             :   /* n >= 0 */
     319        2177 :   if (flag && flag != 1) pari_err_FLAG("pollegendre");
     320        2177 :   if (!x || gequalX(x))
     321             :   {
     322        2156 :     long v = x? varn(x): 0;
     323        2156 :     if (flag) retmkvec2(pollegendre(n-1,v), pollegendre(n,v));
     324        2149 :     return pollegendre(n, v);
     325             :   }
     326          21 :   if (n==0)
     327             :   {
     328           0 :     if (flag) retmkvec2(gen_1, gcopy(x));
     329           0 :     return gen_1;
     330             :   }
     331          21 :   if (n==1)
     332             :   {
     333           0 :     if (flag) retmkvec2(gcopy(x), gen_1);
     334           0 :     return gcopy(x);
     335             :   }
     336          21 :   av = avma; v = gen_1; u = x;
     337        7070 :   for (i=1; i<n; i++)
     338             :   { /* u = P_i(x), v = P_{i-1}(x), compute t = P_{i+1}(x) */
     339             :     GEN t;
     340        7049 :     if ((i & 0xff) == 0) gerepileall(av,2,&u, &v);
     341        7049 :     t = gdivgu(gsub(gmul(gmulsg(2*i+1,x), u), gmulsg(i,v)), i+1);
     342        7049 :     v = u; u = t;
     343             :   }
     344          21 :   if (flag) return gerepilecopy(av, mkvec2(v, u));
     345          14 :   return gerepileupto(av, u);
     346             : }
     347             : GEN
     348           0 : pollegendre_eval(long n, GEN x) { return pollegendre_eval0(n, x, 0); }
     349             : 
     350             : /* Laguerre polynomial
     351             :  * L0^a = 1; L1^a = -X+a+1;
     352             :  * (n+1)*L^a(n+1) = (-X+(2*n+a+1))*L^a(n) - (n+a)*L^a(n-1)
     353             :  * L^a(n) = sum_{k=0}^n (-1)^k * binom(n+a,n-k) * x^k/k! */
     354             : GEN
     355        2128 : pollaguerre(long n, GEN a, long v)
     356             : {
     357        2128 :   pari_sp av = avma;
     358        2128 :   GEN L = cgetg(n+3, t_POL), c1 = gen_1, c2 = mpfact(n);
     359             :   long i;
     360             : 
     361        2128 :   L[1] = evalsigne(1) | evalvarn(v);
     362        2128 :   if (odd(n)) togglesign_safe(&c2);
     363      117404 :   for (i = n; i >= 0; i--)
     364             :   {
     365      115276 :     gel(L, i+2) = gdiv(c1, c2);
     366      115276 :     if (i)
     367             :     {
     368      113148 :       c2 = divis(c2,-i);
     369      113148 :       c1 = gdivgu(gmul(c1, gaddsg(i,a)), n+1-i);
     370             :     }
     371             :   }
     372        2128 :   return gerepilecopy(av, L);
     373             : }
     374             : static void
     375          21 : err_lag(long n)
     376          21 : { pari_err_DOMAIN("pollaguerre", "degree", "<", gen_0, stoi(n)); }
     377             : GEN
     378        2163 : pollaguerre_eval0(long n, GEN a, GEN x, long flag)
     379             : {
     380        2163 :   pari_sp av = avma;
     381             :   long i;
     382             :   GEN v, u;
     383             : 
     384        2163 :   if (n < 0) err_lag(n);
     385        2156 :   if (flag && flag != 1) pari_err_FLAG("pollaguerre");
     386        2156 :   if (!a) a = gen_0;
     387        2156 :   if (!x || gequalX(x))
     388             :   {
     389        2128 :     long v = x? varn(x): 0;
     390        2128 :     if (flag)
     391             :     {
     392          14 :       if (!n) err_lag(-1);
     393           7 :       retmkvec2(pollaguerre(n-1,a,v), pollaguerre(n,a,v));
     394             :     }
     395        2114 :     return pollaguerre(n,a,v);
     396             :   }
     397          28 :   if (n==0)
     398             :   {
     399           7 :     if (flag) err_lag(-1);
     400           0 :     return gen_1;
     401             :   }
     402          21 :   if (n==1)
     403             :   {
     404           0 :     if (flag) retmkvec2(gsub(gaddgs(a,1),x), gen_1);
     405           0 :     return gsub(gaddgs(a,1),x);
     406             :   }
     407          21 :   av = avma; v = gen_1; u = gsub(gaddgs(a,1),x);
     408        7070 :   for (i=1; i<n; i++)
     409             :   { /* u = P_i(x), v = P_{i-1}(x), compute t = P_{i+1}(x) */
     410             :     GEN t;
     411        7049 :     if ((i & 0xff) == 0) gerepileall(av,2,&u, &v);
     412        7049 :     t = gdivgu(gsub(gmul(gsub(gaddsg(2*i+1,a),x), u), gmul(gaddsg(i,a),v)), i+1);
     413        7049 :     v = u; u = t;
     414             :   }
     415          21 :   if (flag) return gerepilecopy(av, mkvec2(v, u));
     416          14 :   return gerepileupto(av, u);
     417             : }
     418             : GEN
     419           0 : pollaguerre_eval(long n, GEN x, GEN a) { return pollaguerre_eval0(n, x, a, 0); }
     420             : 
     421             : /* polcyclo(p) = X^(p-1) + ... + 1 */
     422             : static GEN
     423      504725 : polcyclo_prime(long p, long v)
     424             : {
     425      504725 :   GEN T = cgetg(p+2, t_POL);
     426             :   long i;
     427      504725 :   T[1] = evalsigne(1) | evalvarn(v);
     428     3432639 :   for (i = 2; i < p+2; i++) gel(T,i) = gen_1;
     429      504725 :   return T;
     430             : }
     431             : 
     432             : /* cyclotomic polynomial */
     433             : GEN
     434      629730 : polcyclo(long n, long v)
     435             : {
     436             :   long s, q, i, l;
     437      629730 :   pari_sp av=avma;
     438             :   GEN T, P;
     439             : 
     440      629730 :   if (v<0) v = 0;
     441      629730 :   if (n < 3)
     442      125005 :     switch(n)
     443             :     {
     444       32998 :       case 1: return deg1pol_shallow(gen_1, gen_m1, v);
     445       92007 :       case 2: return deg1pol_shallow(gen_1, gen_1, v);
     446           0 :       default: pari_err_DOMAIN("polcyclo", "index", "<=", gen_0, stoi(n));
     447             :     }
     448      504725 :   P = gel(factoru(n), 1); l = lg(P);
     449      504725 :   s = P[1]; T = polcyclo_prime(s, v);
     450      793622 :   for (i = 2; i < l; i++)
     451             :   { /* Phi_{np}(X) = Phi_n(X^p) / Phi_n(X) */
     452      288897 :     s *= P[i];
     453      288897 :     T = RgX_div(RgX_inflate(T, P[i]), T);
     454             :   }
     455             :   /* s = squarefree part of n */
     456      504725 :   q = n / s;
     457      504725 :   if (q == 1) return gerepileupto(av, T);
     458      243133 :   return gerepilecopy(av, RgX_inflate(T,q));
     459             : }
     460             : 
     461             : /* cyclotomic polynomial */
     462             : GEN
     463      100218 : polcyclo_eval(long n, GEN x)
     464             : {
     465      100218 :   pari_sp av= avma;
     466             :   GEN P, md, xd, yneg, ypos;
     467      100218 :   long vpx, l, s, i, j, q, tx, root_of_1 = 0;
     468             : 
     469      100218 :   if (!x) return polcyclo(n, 0);
     470       15112 :   tx = typ(x);
     471       15112 :   if (gequalX(x)) return polcyclo(n, varn(x));
     472       14517 :   if (n <= 0) pari_err_DOMAIN("polcyclo", "index", "<=", gen_0, stoi(n));
     473       14517 :   if (n == 1) return gsubgs(x, 1);
     474       14517 :   if (tx == t_INT && !signe(x)) return gen_1;
     475       15693 :   while ((n & 3) == 0) { n >>= 1; x = gsqr(x); } /* Phi_4n(x) = Phi_2n(x^2) */
     476             :   /* n not divisible by 4 */
     477       14517 :   if (n == 2) return gerepileupto(av, gaddgs(x,1));
     478        6397 :   if (!odd(n)) { n >>= 1; x = gneg(x); } /* Phi_2n(x) = Phi_n(-x) for n>1 odd */
     479             :   /* n odd > 2.  s largest squarefree divisor of n */
     480        6397 :   P = gel(factoru(n), 1); s = zv_prod(P);
     481             :   /* replace n by largest squarefree divisor */
     482        6397 :   q = n/s; if (q != 1) { x = gpowgs(x, q); n = s; }
     483        6397 :   l = lg(P)-1;
     484             :   /* n squarefree odd > 2, l distinct prime divisors. Now handle x = 1 or -1 */
     485        6397 :   if (tx == t_INT) { /* shortcut */
     486        1715 :     if (is_pm1(x))
     487             :     {
     488          56 :       set_avma(av);
     489          56 :       if (signe(x) > 0 && l == 1) return utoipos(P[1]);
     490          35 :       return gen_1;
     491             :     }
     492             :   } else {
     493        4682 :     if (gequal1(x))
     494             :     { /* n is prime, return n; multiply by x to keep the type */
     495          14 :       if (l == 1) return gerepileupto(av, gmulgu(x,n));
     496           7 :       return gerepilecopy(av, x); /* else 1 */
     497             :     }
     498        4668 :     if (gequalm1(x)) return gerepileupto(av, gneg(x)); /* -1 */
     499             :   }
     500             :   /* Heuristic: evaluation will probably not improve things */
     501        6320 :   if (tx == t_POL || tx == t_MAT || lg(x) > n)
     502          24 :     return gerepileupto(av, poleval(polcyclo(n,0), x));
     503             : 
     504        6296 :   xd = cgetg((1L<<l) + 1, t_VEC); /* the x^d, where d | n */
     505        6296 :   md = cgetg((1L<<l) + 1, t_VECSMALL); /* the mu(d), where d | n */
     506        6296 :   gel(xd, 1) = x;
     507        6296 :   md[1] = 1;
     508             :   /* Use Phi_n(x) = Prod_{d|n} (x^d-1)^mu(n/d).
     509             :    * If x has exact order D, n = Dq, then the result is 0 if q = 1. Otherwise
     510             :    * the factors with x^d-1, D|d are omitted and we multiply at the end by
     511             :    *   prod_{d | q} d^mu(q/d) = q if prime, 1 otherwise */
     512             :   /* We store the factors with mu(d)= 1 (resp.-1) in ypos (resp yneg).
     513             :    * At the end we return ypos/yneg if mu(n)=1 and yneg/ypos if mu(n)=-1 */
     514        6296 :   ypos = gsubgs(x,1);
     515        6296 :   yneg = gen_1;
     516        6296 :   vpx = (typ(x) == t_PADIC)? valp(x): 0;
     517       13933 :   for (i = 1; i <= l; i++)
     518             :   {
     519        7637 :     long ti = 1L<<(i-1), p = P[i];
     520       16713 :     for (j = 1; j <= ti; j++) {
     521        9076 :       GEN X = gel(xd,j), t;
     522        9076 :       if (vpx > 0)
     523             :       { /* ypos, X t_PADIC */
     524          98 :         ulong a = umuluu_or_0(p, valp(X)), b = precp(ypos) - 1;
     525          98 :         long e = (a && a < b) ? b - a : 0;
     526          98 :         if (precp(X) > e) X = cvtop(X, gel(ypos,2), e);
     527          98 :         if (e > 0) X = gpowgs(X, p); /* avoid valp overflow of p-adic 0*/
     528             :       }
     529             :       else
     530        8978 :         X = gpowgs(X, p);
     531        9076 :       md[ti+j] = -md[j];
     532        9076 :       gel(xd,ti+j) = X;
     533             :       /* avoid precp overflow */
     534        9076 :       t = (vpx > 0 && gequal0(X))? gen_m1: gsubgs(X,1);
     535        9076 :       if (gequal0(t))
     536             :       { /* x^d = 1; root_of_1 := the smallest index ti+j such that X == 1
     537             :         * (whose bits code d: bit i-1 is set iff P[i] | d). If no such index
     538             :         * exists, then root_of_1 remains 0. Do not multiply with X-1 if X = 1,
     539             :         * we handle these factors at the end */
     540          28 :         if (!root_of_1) root_of_1 = ti+j;
     541             :       }
     542             :       else
     543             :       {
     544        9048 :         if (md[ti+j] == 1) ypos = gmul(ypos, t);
     545        7672 :         else               yneg = gmul(yneg, t);
     546             :       }
     547             :     }
     548             :   }
     549        6296 :   ypos = odd(l)? gdiv(yneg,ypos): gdiv(ypos,yneg);
     550        6296 :   if (root_of_1)
     551             :   {
     552          21 :     GEN X = gel(xd,(1<<l)); /* = x^n = 1 */
     553          21 :     long bitmask_q = (1<<l) - root_of_1;
     554             :     /* bitmask_q encodes q = n/d: bit (i-1) is 1 iff P[i] | q */
     555             : 
     556             :     /* x is a root of unity.  If bitmask_q = 0, then x was a primitive n-th
     557             :      * root of 1 and the result is zero. Return X - 1 to preserve type. */
     558          21 :     if (!bitmask_q) return gerepileupto(av, gsubgs(X, 1));
     559             :     /* x is a primitive d-th root of unity, where d|n and d<n: we
     560             :      * must multiply ypos by if(isprime(n/d), n/d, 1) */
     561           7 :     ypos = gmul(ypos, X); /* multiply by X = 1 to preserve type */
     562             :     /* If bitmask_q = 1<<(i-1) for some i <= l, then q == P[i] and we multiply
     563             :      * by P[i]; otherwise q is composite and nothing more needs to be done */
     564           7 :     if (!(bitmask_q & (bitmask_q-1))) /* detects power of 2, since bitmask!=0 */
     565             :     {
     566           7 :       i = vals(bitmask_q)+1; /* q = P[i] */
     567           7 :       ypos = gmulgu(ypos, P[i]);
     568             :     }
     569             :   }
     570        6282 :   return gerepileupto(av, ypos);
     571             : }
     572             : /********************************************************************/
     573             : /**                                                                **/
     574             : /**                  HILBERT & PASCAL MATRICES                     **/
     575             : /**                                                                **/
     576             : /********************************************************************/
     577             : GEN
     578         133 : mathilbert(long n) /* Hilbert matrix of order n */
     579             : {
     580             :   long i,j;
     581             :   GEN p;
     582             : 
     583         133 :   if (n < 0) pari_err_DOMAIN("mathilbert", "dimension", "<", gen_0, stoi(n));
     584         133 :   p = cgetg(n+1,t_MAT);
     585        1120 :   for (j=1; j<=n; j++)
     586             :   {
     587         987 :     gel(p,j) = cgetg(n+1,t_COL);
     588       16583 :     for (i=1+(j==1); i<=n; i++)
     589       15596 :       gcoeff(p,i,j) = mkfrac(gen_1, utoipos(i+j-1));
     590             :   }
     591         133 :   if (n) gcoeff(p,1,1) = gen_1;
     592         133 :   return p;
     593             : }
     594             : 
     595             : /* q-Pascal triangle = (choose(i,j)_q) (ordinary binomial if q = NULL) */
     596             : GEN
     597       35951 : matqpascal(long n, GEN q)
     598             : {
     599             :   long i, j, I;
     600       35951 :   pari_sp av = avma;
     601       35951 :   GEN m, qpow = NULL; /* gcc -Wall */
     602             : 
     603       35951 :   if (n < -1)  pari_err_DOMAIN("matpascal", "n", "<", gen_m1, stoi(n));
     604       35951 :   n++; m = cgetg(n+1,t_MAT);
     605      152905 :   for (j=1; j<=n; j++) gel(m,j) = cgetg(n+1,t_COL);
     606       35951 :   if (q)
     607             :   {
     608          42 :     I = (n+1)/2;
     609          42 :     if (I > 1) { qpow = new_chunk(I+1); gel(qpow,2)=q; }
     610          84 :     for (j=3; j<=I; j++) gel(qpow,j) = gmul(q, gel(qpow,j-1));
     611             :   }
     612      152905 :   for (i=1; i<=n; i++)
     613             :   {
     614      116954 :     I = (i+1)/2; gcoeff(m,i,1)= gen_1;
     615      116954 :     if (q)
     616             :     {
     617         483 :       for (j=2; j<=I; j++)
     618         238 :         gcoeff(m,i,j) = gadd(gmul(gel(qpow,j),gcoeff(m,i-1,j)),
     619         238 :                              gcoeff(m,i-1,j-1));
     620             :     }
     621             :     else
     622             :     {
     623     1104654 :       for (j=2; j<=I; j++)
     624      987945 :         gcoeff(m,i,j) = addii(gcoeff(m,i-1,j), gcoeff(m,i-1,j-1));
     625             :     }
     626     1162438 :     for (   ; j<=i; j++) gcoeff(m,i,j) = gcoeff(m,i,i+1-j);
     627     2150621 :     for (   ; j<=n; j++) gcoeff(m,i,j) = gen_0;
     628             :   }
     629       35951 :   return gerepilecopy(av, m);
     630             : }
     631             : 
     632             : GEN
     633          77 : eulerianpol(long N, long v)
     634             : {
     635          77 :   pari_sp av = avma;
     636          77 :   long n, n2, k = 0;
     637             :   GEN A;
     638          77 :   if (v < 0) v = 0;
     639          77 :   if (N < 0) pari_err_DOMAIN("eulerianpol", "index", "<", gen_0, stoi(N));
     640          70 :   if (N <= 1) return pol_1(v);
     641          42 :   if (N == 2) return deg1pol_shallow(gen_1, gen_1, v);
     642          35 :   A = cgetg(N+1, t_VEC);
     643          35 :   gel(A,1) = gen_1; gel(A,2) = gen_1; /* A_2 = x+1 */
     644         567 :   for (n = 3; n <= N; n++)
     645             :   { /* A(n,k) = (n-k)A(n-1,k-1) + (k+1)A(n-1,k) */
     646         532 :     n2 = n >> 1;
     647         532 :     if (odd(n)) gel(A,n2+1) = mului(n+1, gel(A,n2));
     648        8652 :     for (k = n2-1; k; k--)
     649        8120 :       gel(A,k+1) = addii(mului(n-k, gel(A,k)), mului(k+1, gel(A,k+1)));
     650         532 :     if (gc_needed(av,1))
     651             :     {
     652           0 :       if (DEBUGMEM>1) pari_warn(warnmem,"eulerianpol, %ld/%ld",n,N);
     653           0 :       for (k = odd(n)? n2+1: n2; k < N; k++) gel(A,k+1) = gen_0;
     654           0 :       A = gerepilecopy(av, A);
     655             :     }
     656             :   }
     657          35 :   k = N >> 1; if (odd(N)) k++;
     658         329 :   for (; k < N; k++) gel(A,k+1) = gel(A, N-k);
     659          35 :   return gerepilecopy(av, RgV_to_RgX(A, v));
     660             : }
     661             : 
     662             : /******************************************************************/
     663             : /**                                                              **/
     664             : /**                       PRECISION CHANGES                      **/
     665             : /**                                                              **/
     666             : /******************************************************************/
     667             : 
     668             : GEN
     669          98 : gprec(GEN x, long d)
     670             : {
     671          98 :   pari_sp av = avma;
     672          98 :   if (d <= 0) pari_err_DOMAIN("gprec", "precision", "<=", gen_0, stoi(d));
     673          98 :   return gerepilecopy(av, gprec_w(x, ndec2prec(d)));
     674             : }
     675             : 
     676             : /* not GC-safe */
     677             : GEN
     678    11426434 : gprec_w(GEN x, long pr)
     679             : {
     680             :   long lx, i;
     681             :   GEN y;
     682             : 
     683    11426434 :   switch(typ(x))
     684             :   {
     685     7749921 :     case t_REAL:
     686     7749921 :       if (signe(x)) return realprec(x) != pr? rtor(x,pr): x;
     687       67637 :       i = -prec2nbits(pr);
     688       67637 :       return real_0_bit(minss(i,expo(x)));
     689     1907568 :     case t_COMPLEX:
     690     1907568 :       y = cgetg(3, t_COMPLEX);
     691     1907566 :       gel(y,1) = gprec_w(gel(x,1),pr);
     692     1907567 :       gel(y,2) = gprec_w(gel(x,2),pr);
     693     1907567 :       break;
     694      612601 :    case t_POL: case t_SER:
     695      612601 :       y = cgetg_copy(x, &lx); y[1] = x[1];
     696     3897152 :       for (i=2; i<lx; i++) gel(y,i) = gprec_w(gel(x,i),pr);
     697      612600 :       break;
     698      444540 :     case t_POLMOD: case t_RFRAC: case t_VEC: case t_COL: case t_MAT:
     699     1977791 :       pari_APPLY_same(gprec_w(gel(x,i), pr));
     700      711804 :     default: return x;
     701             :   }
     702     2520167 :   return y;
     703             : }
     704             : /* not GC-safe */
     705             : GEN
     706     6290450 : gprec_wensure(GEN x, long pr)
     707             : {
     708             :   long lx, i;
     709             :   GEN y;
     710             : 
     711     6290450 :   switch(typ(x))
     712             :   {
     713     5411529 :     case t_REAL:
     714     5411529 :       if (signe(x)) return realprec(x) < pr? rtor(x,pr): x;
     715       17179 :       i = -prec2nbits(pr);
     716       17179 :       return real_0_bit(minss(i,expo(x)));
     717      331544 :     case t_COMPLEX:
     718      331544 :       y = cgetg(3, t_COMPLEX);
     719      331544 :       gel(y,1) = gprec_wensure(gel(x,1),pr);
     720      331544 :       gel(y,2) = gprec_wensure(gel(x,2),pr);
     721      331544 :       break;
     722       49784 :    case t_POL: case t_SER:
     723       49784 :       y = cgetg_copy(x, &lx); y[1] = x[1];
     724      868336 :       for (i=2; i<lx; i++) gel(y,i) = gprec_wensure(gel(x,i),pr);
     725       49784 :       break;
     726       83529 :     case t_POLMOD: case t_RFRAC: case t_VEC: case t_COL: case t_MAT:
     727     1300863 :       pari_APPLY_same(gprec_wensure(gel(x,i), pr));
     728      414064 :     default: return x;
     729             :   }
     730      381328 :   return y;
     731             : }
     732             : 
     733             : /* not GC-safe; truncate mantissa to precision 'pr' but never increase it */
     734             : GEN
     735     3680916 : gprec_wtrunc(GEN x, long pr)
     736             : {
     737             :   long lx, i;
     738             :   GEN y;
     739             : 
     740     3680916 :   switch(typ(x))
     741             :   {
     742     3203831 :     case t_REAL:
     743     3203831 :       return (signe(x) && realprec(x) > pr)? rtor(x,pr): x;
     744      310537 :     case t_COMPLEX:
     745      310537 :       y = cgetg(3, t_COMPLEX);
     746      310538 :       gel(y,1) = gprec_wtrunc(gel(x,1),pr);
     747      310537 :       gel(y,2) = gprec_wtrunc(gel(x,2),pr);
     748      310537 :       break;
     749        4347 :     case t_POL:
     750             :     case t_SER:
     751        4347 :       y = cgetg_copy(x, &lx); y[1] = x[1];
     752       26656 :       for (i=2; i<lx; i++) gel(y,i) = gprec_wtrunc(gel(x,i),pr);
     753        4347 :       break;
     754       88512 :     case t_POLMOD: case t_RFRAC: case t_VEC: case t_COL: case t_MAT:
     755      402427 :       pari_APPLY_same(gprec_wtrunc(gel(x,i), pr));
     756       73689 :     default: return x;
     757             :   }
     758      314884 :   return y;
     759             : }
     760             : 
     761             : /********************************************************************/
     762             : /**                                                                **/
     763             : /**                      SERIES TRANSFORMS                         **/
     764             : /**                                                                **/
     765             : /********************************************************************/
     766             : /**                  LAPLACE TRANSFORM (OF A SERIES)               **/
     767             : /********************************************************************/
     768             : static GEN
     769          14 : serlaplace(GEN x)
     770             : {
     771          14 :   long i, l = lg(x), e = valser(x);
     772          14 :   GEN t, y = cgetg(l,t_SER);
     773          14 :   if (e < 0) pari_err_DOMAIN("laplace","valuation","<",gen_0,stoi(e));
     774          14 :   t = mpfact(e); y[1] = x[1];
     775         154 :   for (i=2; i<l; i++)
     776             :   {
     777         140 :     gel(y,i) = gmul(t, gel(x,i));
     778         140 :     e++; t = mului(e,t);
     779             :   }
     780          14 :   return y;
     781             : }
     782             : static GEN
     783          14 : pollaplace(GEN x)
     784             : {
     785          14 :   long i, e = 0, l = lg(x);
     786          14 :   GEN t = gen_1, y = cgetg(l,t_POL);
     787          14 :   y[1] = x[1];
     788          63 :   for (i=2; i<l; i++)
     789             :   {
     790          49 :     gel(y,i) = gmul(t, gel(x,i));
     791          49 :     e++; t = mului(e,t);
     792             :   }
     793          14 :   return y;
     794             : }
     795             : GEN
     796          35 : laplace(GEN x)
     797             : {
     798          35 :   pari_sp av = avma;
     799          35 :   switch(typ(x))
     800             :   {
     801          14 :     case t_POL: x = pollaplace(x); break;
     802          14 :     case t_SER: x = serlaplace(x); break;
     803           7 :     default: if (is_scalar_t(typ(x))) return gcopy(x);
     804           0 :              pari_err_TYPE("laplace",x);
     805             :   }
     806          28 :   return gerepilecopy(av, x);
     807             : }
     808             : 
     809             : /********************************************************************/
     810             : /**              CONVOLUTION PRODUCT (OF TWO SERIES)               **/
     811             : /********************************************************************/
     812             : GEN
     813          14 : convol(GEN x, GEN y)
     814             : {
     815          14 :   long j, lx, ly, ex, ey, vx = varn(x);
     816             :   GEN z;
     817             : 
     818          14 :   if (typ(x) != t_SER) pari_err_TYPE("convol",x);
     819          14 :   if (typ(y) != t_SER) pari_err_TYPE("convol",y);
     820          14 :   if (varn(y) != vx) pari_err_VAR("convol", x,y);
     821          14 :   ex = valser(x);
     822          14 :   ey = valser(y);
     823          14 :   if (ser_isexactzero(x))
     824             :   {
     825           7 :     z = scalarser(gadd(Rg_get_0(x), Rg_get_0(y)), varn(x), 1);
     826           7 :     setvalser(z, maxss(ex,ey)); return z;
     827             :   }
     828           7 :   lx = lg(x) + ex; x -= ex;
     829           7 :   ly = lg(y) + ey; y -= ey;
     830             :   /* inputs shifted: x[i] and y[i] now correspond to monomials of same degree */
     831           7 :   if (ly < lx) lx = ly; /* min length */
     832           7 :   if (ex < ey) ex = ey; /* max valuation */
     833           7 :   if (lx - ex < 3) return zeroser(vx, lx-2);
     834             : 
     835           7 :   z = cgetg(lx - ex, t_SER);
     836           7 :   z[1] = evalvalser(ex) | evalvarn(vx);
     837         119 :   for (j = ex+2; j<lx; j++) gel(z,j-ex) = gmul(gel(x,j),gel(y,j));
     838           7 :   return normalizeser(z);
     839             : }
     840             : 
     841             : /***********************************************************************/
     842             : /*               OPERATIONS ON DIRICHLET SERIES: *, /                  */
     843             : /* (+, -, scalar multiplication are done on the corresponding vectors) */
     844             : /***********************************************************************/
     845             : static long
     846      869316 : dirval(GEN x)
     847             : {
     848      869316 :   long i = 1, lx = lg(x);
     849      869337 :   while (i < lx && gequal0(gel(x,i))) i++;
     850      869316 :   return i;
     851             : }
     852             : 
     853             : GEN
     854         336 : dirmul(GEN x, GEN y)
     855             : {
     856         336 :   pari_sp av = avma, av2;
     857             :   long nx, ny, nz, dx, dy, i, j, k;
     858             :   GEN z;
     859             : 
     860         336 :   if (typ(x)!=t_VEC) pari_err_TYPE("dirmul",x);
     861         336 :   if (typ(y)!=t_VEC) pari_err_TYPE("dirmul",y);
     862         336 :   dx = dirval(x); nx = lg(x)-1;
     863         336 :   dy = dirval(y); ny = lg(y)-1;
     864         336 :   if (ny-dy < nx-dx) { swap(x,y); lswap(nx,ny); lswap(dx,dy); }
     865         336 :   nz = minss(nx*dy,ny*dx);
     866         336 :   y = RgV_kill0(y);
     867         336 :   av2 = avma;
     868         336 :   z = zerovec(nz);
     869       39095 :   for (j=dx; j<=nx; j++)
     870             :   {
     871       38759 :     GEN c = gel(x,j);
     872       38759 :     if (gequal0(c)) continue;
     873       17031 :     if (gequal1(c))
     874             :     {
     875       94199 :       for (k=dy,i=j*dy; i<=nz; i+=j,k++)
     876       88550 :         if (gel(y,k)) gel(z,i) = gadd(gel(z,i),gel(y,k));
     877             :     }
     878       11382 :     else if (gequalm1(c))
     879             :     {
     880        5649 :       for (k=dy,i=j*dy; i<=nz; i+=j,k++)
     881        4298 :         if (gel(y,k)) gel(z,i) = gsub(gel(z,i),gel(y,k));
     882             :     }
     883             :     else
     884             :     {
     885       46508 :       for (k=dy,i=j*dy; i<=nz; i+=j,k++)
     886       36477 :         if (gel(y,k)) gel(z,i) = gadd(gel(z,i),gmul(c,gel(y,k)));
     887             :     }
     888       17031 :     if (gc_needed(av2,3))
     889             :     {
     890           0 :       if (DEBUGMEM>1) pari_warn(warnmem,"dirmul, %ld/%ld",j,nx);
     891           0 :       z = gerepilecopy(av2,z);
     892             :     }
     893             :   }
     894         336 :   return gerepilecopy(av,z);
     895             : }
     896             : 
     897             : GEN
     898      434322 : dirdiv(GEN x, GEN y)
     899             : {
     900      434322 :   pari_sp av = avma, av2;
     901             :   long nx,ny,nz, dx,dy, i,j,k;
     902             :   GEN p1;
     903             : 
     904      434322 :   if (typ(x)!=t_VEC) pari_err_TYPE("dirdiv",x);
     905      434322 :   if (typ(y)!=t_VEC) pari_err_TYPE("dirdiv",y);
     906      434322 :   dx = dirval(x); nx = lg(x)-1;
     907      434322 :   dy = dirval(y); ny = lg(y)-1;
     908      434322 :   if (dy != 1 || !ny) pari_err_INV("dirdiv",y);
     909      434322 :   nz = minss(nx,ny*dx);
     910      434322 :   p1 = gel(y,1);
     911      434322 :   if (gequal1(p1)) p1 = NULL; else y = gdiv(y,p1);
     912      434322 :   y = RgV_kill0(y);
     913      434322 :   av2 = avma;
     914      434322 :   x = p1 ? gdiv(x,p1): leafcopy(x);
     915      434329 :   for (j=1; j<dx; j++) gel(x,j) = gen_0;
     916      434322 :   setlg(x,nz+1);
     917   109807992 :   for (j=dx; j<=nz; j++)
     918             :   {
     919   109373670 :     GEN c = gel(x,j);
     920   109373670 :     if (gequal0(c)) continue;
     921    75821501 :     if (gequal1(c))
     922             :     {
     923   133758387 :       for (i=j+j,k=2; i<=nz; i+=j,k++)
     924   131988864 :         if (gel(y,k)) gel(x,i) = gsub(gel(x,i),gel(y,k));
     925             :     }
     926    74051978 :     else if (gequalm1(c))
     927             :     {
     928    28856261 :       for (i=j+j,k=2; i<=nz; i+=j,k++)
     929    27302821 :         if (gel(y,k)) gel(x,i) = gadd(gel(x,i),gel(y,k));
     930             :     }
     931             :     else
     932             :     {
     933   331182936 :       for (i=j+j,k=2; i<=nz; i+=j,k++)
     934   258684398 :         if (gel(y,k)) gel(x,i) = gsub(gel(x,i),gmul(c,gel(y,k)));
     935             :     }
     936    75821501 :     if (gc_needed(av2,3))
     937             :     {
     938           0 :       if (DEBUGMEM>1) pari_warn(warnmem,"dirdiv, %ld/%ld",j,nz);
     939           0 :       x = gerepilecopy(av2,x);
     940             :     }
     941             :   }
     942      434322 :   return gerepilecopy(av,x);
     943             : }
     944             : 
     945             : /*******************************************************************/
     946             : /**                                                               **/
     947             : /**                       COMBINATORICS                           **/
     948             : /**                                                               **/
     949             : /*******************************************************************/
     950             : /**                      BINOMIAL COEFFICIENTS                    **/
     951             : /*******************************************************************/
     952             : /* Lucas's formula for v_p(\binom{n}{k}), used in the tough case p <= sqrt(n) */
     953             : static long
     954        3206 : binomial_lval(ulong n, ulong k, ulong p)
     955             : {
     956        3206 :   ulong r = 0, e = 0;
     957             :   do
     958             :   {
     959       10290 :     ulong a = n % p, b = k % p + r;
     960       10290 :     n /= p; k /= p;
     961       10290 :     if (a < b) { e++; r = 1; } else r = 0;
     962       10290 :   } while (n);
     963        3206 :   return e;
     964             : }
     965             : GEN
     966       81263 : binomialuu(ulong n, ulong k)
     967             : {
     968       81263 :   pari_sp av = avma;
     969             :   ulong p, nk, sn;
     970             :   long c, l;
     971             :   forprime_t T;
     972             :   GEN v, z;
     973       81263 :   if (k > n) return gen_0;
     974       81256 :   nk = n-k; if (k > nk) lswap(nk, k);
     975       81256 :   if (!k) return gen_1;
     976       79632 :   if (k == 1) return utoipos(n);
     977       74284 :   if (k == 2) return muluu(odd(n)? n: n-1, n>>1);
     978       54250 :   if (k < 1000 || ((double)k/ n) * log((double)n) < 0.5)
     979             :   { /* k "small" */
     980       54236 :     z = diviiexact(mulu_interval(n-k+1, n), mulu_interval(2UL, k));
     981       54241 :     return gerepileuptoint(av, z);
     982             :   }
     983          14 :   sn = usqrt(n);
     984             :   /* use Lucas's formula, k <= n/2 */
     985          14 :   l = minuu(1UL << 20, n); v = cgetg(l+1, t_VECSMALL); c = 1;
     986          14 :   u_forprime_init(&T, nk+1, n);
     987     1553958 :   while ((p = u_forprime_next(&T))) /* all primes n-k < p <= n occur, v_p = 1 */
     988             :   {
     989     1553944 :     if (c == l) { ulong L = l << 1; v = vecsmall_lengthen(v, L); l = L; }
     990     1553944 :     v[c++] = p;
     991             :   }
     992          14 :   u_forprime_init(&T, sn+1, n >> 1);
     993     2437785 :   while ((p = u_forprime_next(&T))) /* p^2 > n, v_p <= 1 */
     994     2437771 :     if (n % p < k % p)
     995             :     {
     996     1428679 :       if (c == l) { ulong L = l << 1; v = vecsmall_lengthen(v, L); l = L; }
     997     1428679 :       v[c++] = p;
     998             :     }
     999          14 :   setlg(v, c); z = zv_prod_Z(v);
    1000          14 :   u_forprime_init(&T, 3, sn);
    1001          14 :   l = minuu(1UL << 20, sn); v = cgetg(l + 1, t_VEC); c = 1;
    1002        3220 :   while ((p = u_forprime_next(&T))) /* p <= sqrt(n) */
    1003             :   {
    1004        3206 :     ulong e = binomial_lval(n, k, p);
    1005        3206 :     if (e)
    1006             :     {
    1007        2541 :       if (c == l) { ulong L = l << 1; v = vec_lengthen(v, L); l = L; }
    1008        2541 :       gel(v, c++) = powuu(p, e);
    1009             :     }
    1010             :   }
    1011          14 :   setlg(v, c); z = mulii(z, ZV_prod(v));
    1012             :   { /* p = 2 */
    1013          14 :     ulong e = hammingl(k);
    1014          14 :     e += (k == nk)? e: hammingl(nk);
    1015          14 :     e -= hammingl(n); if (e) z = shifti(z, e);
    1016             :   }
    1017          14 :   return gerepileuptoint(av, z);
    1018             : }
    1019             : 
    1020             : GEN
    1021      102692 : binomial(GEN n, long k)
    1022             : {
    1023      102692 :   long i, prec, tn = typ(n);
    1024             :   pari_sp av;
    1025             :   GEN y;
    1026             : 
    1027      102692 :   av = avma;
    1028      102692 :   if (tn == t_INT)
    1029             :   {
    1030             :     long sn;
    1031             :     GEN z;
    1032      102517 :     if (k == 0) return gen_1;
    1033       69127 :     sn = signe(n);
    1034       69127 :     if (sn == 0) return gen_0; /* k != 0 */
    1035       69127 :     if (sn > 0)
    1036             :     { /* n > 0 */
    1037       68693 :       if (k < 0) return gen_0;
    1038       68693 :       if (k == 1) return icopy(n);
    1039       42681 :       z = subiu(n, k);
    1040       42680 :       if (cmpiu(z, k) < 0)
    1041             :       {
    1042        1442 :         switch(signe(z))
    1043             :         {
    1044           7 :           case -1: return gc_const(av, gen_0);
    1045          63 :           case 0: return gc_const(av, gen_1);
    1046             :         }
    1047        1372 :         k = z[2];
    1048        1372 :         if (k == 1) { set_avma(av); return icopy(n); }
    1049             :       }
    1050       42148 :       set_avma(av);
    1051       42148 :       if (lgefint(n) == 3) return binomialuu(n[2],(ulong)k);
    1052             :     }
    1053             :     else
    1054             :     { /* n < 0, k != 0; use Kronenburg's definition */
    1055         434 :       if (k > 0)
    1056         413 :         z = binomial(subsi(k - 1, n), k);
    1057             :       else
    1058             :       {
    1059          21 :         z = subis(n, k); if (signe(z) < 0) return gen_0;
    1060          14 :         n = stoi(-k-1); k = itos(z);
    1061          14 :         z = binomial(n, k);
    1062             :       }
    1063         427 :       if (odd(k)) togglesign_safe(&z);
    1064         427 :       return gerepileuptoint(av, z);
    1065             :     }
    1066             :     /* n >= 0 and huge, k != 0 */
    1067           8 :     if (k < 0) return gen_0;
    1068           8 :     if (k == 1) return icopy(n);
    1069             :     /* k > 1 */
    1070           8 :     y = cgetg(k+1,t_VEC); gel(y,1) = n;
    1071          18 :     for (i = 2; i <= k; i++) gel(y,i) = subiu(n,i-1);
    1072           8 :     y = diviiexact(ZV_prod(y), mpfact(k));
    1073           8 :     return gerepileuptoint(av, y);
    1074             :   }
    1075         175 :   if (is_noncalc_t(tn)) pari_err_TYPE("binomial",n);
    1076         175 :   if (k <= 1)
    1077             :   {
    1078          14 :     if (k < 0) return Rg_get_0(n);
    1079           7 :     if (k == 0) return Rg_get_1(n);
    1080           0 :     return gcopy(n);
    1081             :   }
    1082         161 :   prec = precision(n);
    1083         161 :   if (prec && k > 200 + 0.8*prec2nbits(prec)) {
    1084           7 :     GEN A = mpfactr(k, prec), B = ggamma(gsubgs(n,k-1), prec);
    1085           7 :     return gerepileupto(av, gdiv(ggamma(gaddgs(n,1), prec), gmul(A,B)));
    1086             :   }
    1087             : 
    1088         154 :   y = cgetg(k+1,t_VEC);
    1089       12236 :   for (i=1; i<=k; i++) gel(y,i) = gsubgs(n,i-1);
    1090         154 :   return gerepileupto(av, gdiv(RgV_prod(y), mpfact(k)));
    1091             : }
    1092             : 
    1093             : GEN
    1094        1850 : binomial0(GEN x, GEN k)
    1095             : {
    1096        1850 :   if (!k)
    1097             :   {
    1098          21 :     if (typ(x) != t_INT || signe(x) < 0) pari_err_TYPE("binomial", x);
    1099           7 :     return vecbinomial(itos(x));
    1100             :   }
    1101        1829 :   if (typ(k) != t_INT) pari_err_TYPE("binomial", k);
    1102        1822 :   return binomial(x, itos(k));
    1103             : }
    1104             : 
    1105             : /* Assume n >= 0, return bin, bin[k+1] = binomial(n, k) */
    1106             : GEN
    1107      153634 : vecbinomial(long n)
    1108             : {
    1109             :   long d, k;
    1110             :   GEN C;
    1111      153634 :   if (!n) return mkvec(gen_1);
    1112      153263 :   C = cgetg(n+2, t_VEC) + 1; /* C[k] = binomial(n, k) */
    1113      153263 :   gel(C,0) = gen_1;
    1114      153263 :   gel(C,1) = utoipos(n); d = (n + 1) >> 1;
    1115      707865 :   for (k=2; k <= d; k++)
    1116             :   {
    1117      554601 :     pari_sp av = avma;
    1118      554601 :     gel(C,k) = gerepileuptoint(av, diviuexact(mului(n-k+1, gel(C,k-1)), k));
    1119             :   }
    1120      783179 :   for (   ; k <= n; k++) gel(C,k) = gel(C,n-k);
    1121      153264 :   return C - 1;
    1122             : }
    1123             : 
    1124             : /********************************************************************/
    1125             : /**                  STIRLING NUMBERS                              **/
    1126             : /********************************************************************/
    1127             : /* Stirling number of the 2nd kind. The number of ways of partitioning
    1128             :    a set of n elements into m nonempty subsets. */
    1129             : GEN
    1130        1694 : stirling2(ulong n, ulong m)
    1131             : {
    1132        1694 :   pari_sp av = avma;
    1133             :   GEN s, bmk;
    1134             :   ulong k;
    1135        1694 :   if (n==0) return (m == 0)? gen_1: gen_0;
    1136        1694 :   if (m > n || m == 0) return gen_0;
    1137        1694 :   if (m==n) return gen_1;
    1138             :   /* k = 0 */
    1139        1694 :   bmk = gen_1; s  = powuu(m, n);
    1140       20314 :   for (k = 1; k <= ((m-1)>>1); ++k)
    1141             :   { /* bmk = binomial(m, k) */
    1142             :     GEN c, kn, mkn;
    1143       18620 :     bmk = diviuexact(mului(m-k+1, bmk), k);
    1144       18620 :     kn  = powuu(k, n); mkn = powuu(m-k, n);
    1145       18620 :     c = odd(m)? subii(mkn,kn): addii(mkn,kn);
    1146       18620 :     c = mulii(bmk, c);
    1147       18620 :     s = odd(k)? subii(s, c): addii(s, c);
    1148       18620 :     if (gc_needed(av,2))
    1149             :     {
    1150           0 :       if(DEBUGMEM>1) pari_warn(warnmem,"stirling2");
    1151           0 :       gerepileall(av, 2, &s, &bmk);
    1152             :     }
    1153             :   }
    1154             :   /* k = m/2 */
    1155        1694 :   if (!odd(m))
    1156             :   {
    1157             :     GEN c;
    1158         805 :     bmk = diviuexact(mului(k+1, bmk), k);
    1159         805 :     c = mulii(bmk, powuu(k,n));
    1160         805 :     s = odd(k)? subii(s, c): addii(s, c);
    1161             :   }
    1162        1694 :   return gerepileuptoint(av, diviiexact(s, mpfact(m)));
    1163             : }
    1164             : 
    1165             : /* Stirling number of the first kind. Up to the sign, the number of
    1166             :    permutations of n symbols which have exactly m cycles. */
    1167             : GEN
    1168         154 : stirling1(ulong n, ulong m)
    1169             : {
    1170         154 :   pari_sp ltop=avma;
    1171             :   ulong k;
    1172             :   GEN s, t;
    1173         154 :   if (n < m) return gen_0;
    1174         154 :   else if (n==m) return gen_1;
    1175             :   /* t = binomial(n-1+k, m-1) * binomial(2n-m, n-m-k) */
    1176             :   /* k = n-m > 0 */
    1177         154 :   t = binomialuu(2*n-m-1, m-1);
    1178         154 :   s = mulii(t, stirling2(2*(n-m), n-m));
    1179         154 :   if (odd(n-m)) togglesign(s);
    1180        1547 :   for (k = n-m-1; k > 0; --k)
    1181             :   {
    1182             :     GEN c;
    1183        1393 :     t = diviuuexact(muluui(n-m+k+1, n+k+1, t), n+k, n-m-k);
    1184        1393 :     c = mulii(t, stirling2(n-m+k, k));
    1185        1393 :     s = odd(k)? subii(s, c): addii(s, c);
    1186        1393 :     if ((k & 0x1f) == 0) {
    1187          21 :       t = gerepileuptoint(ltop, t);
    1188          21 :       s = gerepileuptoint(avma, s);
    1189             :     }
    1190             :   }
    1191         154 :   return gerepileuptoint(ltop, s);
    1192             : }
    1193             : 
    1194             : GEN
    1195         301 : stirling(long n, long m, long flag)
    1196             : {
    1197         301 :   if (n < 0) pari_err_DOMAIN("stirling", "n", "<", gen_0, stoi(n));
    1198         301 :   if (m < 0) pari_err_DOMAIN("stirling", "m", "<", gen_0, stoi(m));
    1199         301 :   switch (flag)
    1200             :   {
    1201         154 :     case 1: return stirling1((ulong)n,(ulong)m);
    1202         147 :     case 2: return stirling2((ulong)n,(ulong)m);
    1203           0 :     default: pari_err_FLAG("stirling");
    1204             :   }
    1205             :   return NULL; /*LCOV_EXCL_LINE*/
    1206             : }
    1207             : 
    1208             : /*******************************************************************/
    1209             : /**                                                               **/
    1210             : /**                     RECIPROCAL POLYNOMIAL                     **/
    1211             : /**                                                               **/
    1212             : /*******************************************************************/
    1213             : /* return coefficients s.t x = x_0 X^n + ... + x_n */
    1214             : GEN
    1215         161 : polrecip(GEN x)
    1216             : {
    1217         161 :   long tx = typ(x);
    1218         161 :   if (is_scalar_t(tx)) return gcopy(x);
    1219         154 :   if (tx != t_POL) pari_err_TYPE("polrecip",x);
    1220         154 :   return RgX_recip(x);
    1221             : }
    1222             : 
    1223             : /********************************************************************/
    1224             : /**                                                                **/
    1225             : /**                  POLYNOMIAL INTERPOLATION                      **/
    1226             : /**                                                                **/
    1227             : /********************************************************************/
    1228             : /* given complex roots L[i], i <= n of some monic T in C[X], return
    1229             :  * the T'(L[i]), computed stably via products of differences */
    1230             : GEN
    1231       84077 : vandermondeinverseinit(GEN L)
    1232             : {
    1233       84077 :   long i, j, l = lg(L);
    1234       84077 :   GEN V = cgetg(l, t_VEC);
    1235      471885 :   for (i = 1; i < l; i++)
    1236             :   {
    1237      387810 :     pari_sp av = avma;
    1238      387810 :     GEN W = cgetg(l-1,t_VEC);
    1239      387811 :     long k = 1;
    1240     4235399 :     for (j = 1; j < l; j++)
    1241     3847767 :       if (i != j) gel(W, k++) = gsub(gel(L,i), gel(L,j));
    1242      387632 :     gel(V,i) = gerepileupto(av, RgV_prod(W));
    1243             :   }
    1244       84075 :   return V;
    1245             : }
    1246             : 
    1247             : /* Compute the inverse of the van der Monde matrix of T multiplied by den */
    1248             : GEN
    1249       53186 : vandermondeinverse(GEN L, GEN T, GEN den, GEN V)
    1250             : {
    1251       53186 :   pari_sp av = avma;
    1252       53186 :   long i, n = lg(L)-1;
    1253       53186 :   GEN M = cgetg(n+1, t_MAT);
    1254             : 
    1255       53186 :   if (!V) V = vandermondeinverseinit(L);
    1256       53186 :   if (den && equali1(den)) den = NULL;
    1257      290930 :   for (i = 1; i <= n; i++)
    1258             :   {
    1259      475488 :     GEN d = gel(V,i), P = RgX_Rg_mul(RgX_div_by_X_x(T, gel(L,i), NULL),
    1260      237746 :                                      den? gdiv(den,d): ginv(d));
    1261      237741 :     gel(M,i) = RgX_to_RgC(P, n);
    1262             :   }
    1263       53184 :   return gerepilecopy(av, M);
    1264             : }
    1265             : 
    1266             : static GEN
    1267         224 : RgV_polint_fast(GEN X, GEN Y, long v)
    1268             : {
    1269             :   GEN p, pol;
    1270             :   long t, pa;
    1271         224 :   if (X) t = RgV_type2(X,Y, &p, &pol, &pa);
    1272          21 :   else   t = Rg_type(Y, &p, &pol, &pa);
    1273         224 :   if (t != t_INTMOD) return NULL;
    1274           7 :   Y = RgC_to_FpC(Y, p);
    1275           7 :   X = X? RgC_to_FpC(X, p): identity_ZV(lg(Y)-1);
    1276           7 :   return FpX_to_mod(FpV_polint(X, Y, p, v), p);
    1277             : }
    1278             : /* allow X = NULL for [1,...,n] */
    1279             : GEN
    1280         224 : RgV_polint(GEN X, GEN Y, long v)
    1281             : {
    1282         224 :   pari_sp av0 = avma, av;
    1283         224 :   GEN Q, L, P = NULL;
    1284         224 :   long i, l = lg(Y);
    1285         224 :   if ((Q = RgV_polint_fast(X,Y,v))) return Q;
    1286         217 :   if (!X) X = identity_ZV(l-1);
    1287         217 :   L = vandermondeinverseinit(X);
    1288         217 :   Q = roots_to_pol(X, v); av = avma;
    1289         553 :   for (i=1; i<l; i++)
    1290             :   {
    1291             :     GEN T, dP;
    1292         336 :     if (gequal0(gel(Y,i))) continue;
    1293         238 :     T = RgX_div_by_X_x(Q, gel(X,i), NULL);
    1294         238 :     dP = RgX_Rg_mul(T, gdiv(gel(Y,i), gel(L,i)));
    1295         238 :     P = P? RgX_add(P, dP): dP;
    1296         238 :     if (gc_needed(av,2))
    1297             :     {
    1298           0 :       if (DEBUGMEM>1) pari_warn(warnmem,"RgV_polint i = %ld/%ld", i, l-1);
    1299           0 :       P = gerepileupto(av, P);
    1300             :     }
    1301             :   }
    1302         217 :   if (!P) { set_avma(av); return zeropol(v); }
    1303         147 :   return gerepileupto(av0, P);
    1304             : }
    1305             : static int
    1306       17357 : inC(GEN x)
    1307             : {
    1308       17357 :   switch(typ(x)) {
    1309        1365 :     case t_INT: case t_REAL: case t_FRAC: case t_COMPLEX: case t_QUAD: return 1;
    1310       15992 :     default: return 0;
    1311             :   }
    1312             : }
    1313             : static long
    1314       16188 : check_dy(GEN X, GEN x, long n)
    1315             : {
    1316       16188 :   GEN D = NULL;
    1317       16188 :   long i, ns = 0;
    1318       16188 :   if (!inC(x)) return -1;
    1319        1176 :   for (i = 0; i < n; i++)
    1320             :   {
    1321         966 :     GEN t = gsub(x, gel(X,i));
    1322         966 :     if (!inC(t)) return -1;
    1323         952 :     t = gabs(t, DEFAULTPREC);
    1324         952 :     if (!D || gcmp(t,D) < 0) { ns = i; D = t; }
    1325             :   }
    1326             :   /* X[ns] is closest to x */
    1327         210 :   return ns;
    1328             : }
    1329             : /* X,Y are "spec" GEN vectors with n > 0 components ( at X[0], ... X[n-1] ) */
    1330             : GEN
    1331       16223 : polintspec(GEN X, GEN Y, GEN x, long n, long *pe)
    1332             : {
    1333             :   long i, m, ns;
    1334       16223 :   pari_sp av = avma, av2;
    1335       16223 :   GEN y, c, d, dy = NULL; /* gcc -Wall */
    1336             : 
    1337       16223 :   if (pe) *pe = -HIGHEXPOBIT;
    1338       16223 :   if (n == 1) return gmul(gel(Y,0), Rg_get_1(x));
    1339       16188 :   if (!X) X = identity_ZV(n) + 1;
    1340       16188 :   av2 = avma;
    1341       16188 :   ns = check_dy(X, x, n); if (ns < 0) { pe = NULL; ns = 0; }
    1342       16188 :   c = cgetg(n+1, t_VEC);
    1343       81031 :   d = cgetg(n+1, t_VEC); for (i=0; i<n; i++) gel(c,i+1) = gel(d,i+1) = gel(Y,i);
    1344       16188 :   y = gel(d,ns+1);
    1345             :   /* divided differences */
    1346       64836 :   for (m = 1; m < n; m++)
    1347             :   {
    1348      146238 :     for (i = 0; i < n-m; i++)
    1349             :     {
    1350       97590 :       GEN ho = gsub(gel(X,i),x), hp = gsub(gel(X,i+m),x), den = gsub(ho,hp);
    1351       97590 :       if (gequal0(den))
    1352             :       {
    1353           7 :         char *x1 = stack_sprintf("X[%ld]", i+1);
    1354           7 :         char *x2 = stack_sprintf("X[%ld]", i+m+1);
    1355           7 :         pari_err_DOMAIN("polinterpolate",x1,"=",strtoGENstr(x2), X);
    1356             :       }
    1357       97583 :       den = gdiv(gsub(gel(c,i+2),gel(d,i+1)), den);
    1358       97583 :       gel(c,i+1) = gmul(ho,den);
    1359       97583 :       gel(d,i+1) = gmul(hp,den);
    1360             :     }
    1361       48648 :     dy = (2*ns < n-m)? gel(c,ns+1): gel(d,ns--);
    1362       48648 :     y = gadd(y,dy);
    1363       48648 :     if (gc_needed(av2,2))
    1364             :     {
    1365           0 :       if (DEBUGMEM>1) pari_warn(warnmem,"polint, %ld/%ld",m,n-1);
    1366           0 :       gerepileall(av2, 4, &y, &c, &d, &dy);
    1367             :     }
    1368             :   }
    1369       16181 :   if (pe && inC(dy)) *pe = gexpo(dy);
    1370       16181 :   return gerepileupto(av, y);
    1371             : }
    1372             : 
    1373             : GEN
    1374         329 : polint_i(GEN X, GEN Y, GEN t, long *pe)
    1375             : {
    1376         329 :   long lx = lg(X), vt;
    1377             : 
    1378         329 :   if (! is_vec_t(typ(X))) pari_err_TYPE("polinterpolate",X);
    1379         329 :   if (Y)
    1380             :   {
    1381         301 :     if (! is_vec_t(typ(Y))) pari_err_TYPE("polinterpolate",Y);
    1382         301 :     if (lx != lg(Y)) pari_err_DIM("polinterpolate");
    1383             :   }
    1384             :   else
    1385             :   {
    1386          28 :     Y = X;
    1387          28 :     X = NULL;
    1388             :   }
    1389         329 :   if (pe) *pe = -HIGHEXPOBIT;
    1390         329 :   vt = t? gvar(t): 0;
    1391         329 :   if (vt != NO_VARIABLE)
    1392             :   { /* formal interpolation */
    1393             :     pari_sp av;
    1394         224 :     long v0, vY = gvar(Y);
    1395             :     GEN P;
    1396         224 :     if (X) vY = varnmax(vY, gvar(X));
    1397             :     /* shortcut */
    1398         224 :     if (varncmp(vY, vt) > 0 && (!t || gequalX(t))) return RgV_polint(X, Y, vt);
    1399          84 :     av = avma;
    1400             :     /* first interpolate in high priority variable, then substitute t */
    1401          84 :     v0 = fetch_var_higher();
    1402          84 :     P = RgV_polint(X, Y, v0);
    1403          84 :     P = gsubst(P, v0, t? t: pol_x(0));
    1404          84 :     (void)delete_var();
    1405          84 :     return gerepileupto(av, P);
    1406             :   }
    1407             :   /* numerical interpolation */
    1408         105 :   if (lx == 1) return Rg_get_0(t);
    1409          91 :   return polintspec(X? X+1: NULL,Y+1,t,lx-1, pe);
    1410             : }
    1411             : GEN
    1412         329 : polint(GEN X, GEN Y, GEN t, GEN *pe)
    1413             : {
    1414             :   long e;
    1415         329 :   GEN p = polint_i(X, Y, t, &e);
    1416         322 :   if (pe) *pe = stoi(e);
    1417         322 :   return p;
    1418             : }
    1419             : 
    1420             : /********************************************************************/
    1421             : /**                                                                **/
    1422             : /**                       MODREVERSE                               **/
    1423             : /**                                                                **/
    1424             : /********************************************************************/
    1425             : static void
    1426           7 : err_reverse(GEN x, GEN T)
    1427             : {
    1428           7 :   pari_err_DOMAIN("modreverse","deg(minpoly(z))", "<", stoi(degpol(T)),
    1429             :                   mkpolmod(x,T));
    1430           0 : }
    1431             : 
    1432             : /* return y such that Mod(y, charpoly(Mod(a,T)) = Mod(a,T) */
    1433             : GEN
    1434         175 : RgXQ_reverse(GEN a, GEN T)
    1435             : {
    1436         175 :   pari_sp av = avma;
    1437         175 :   long n = degpol(T);
    1438             :   GEN y;
    1439             : 
    1440         175 :   if (n <= 1) {
    1441           7 :     if (n <= 0) return gcopy(a);
    1442           7 :     return gerepileupto(av, gneg(gdiv(gel(T,2), gel(T,3))));
    1443             :   }
    1444         168 :   if (typ(a) != t_POL || !signe(a)) err_reverse(a,T);
    1445         168 :   y = RgXV_to_RgM(RgXQ_powers(a,n-1,T), n);
    1446         168 :   y = RgM_solve(y, col_ei(n, 2));
    1447         168 :   if (!y) err_reverse(a,T);
    1448         161 :   return gerepilecopy(av, RgV_to_RgX(y, varn(T)));
    1449             : }
    1450             : GEN
    1451        6090 : QXQ_reverse(GEN a, GEN T)
    1452             : {
    1453        6090 :   pari_sp av = avma;
    1454        6090 :   long n = degpol(T);
    1455             :   GEN y;
    1456             : 
    1457        6090 :   if (n <= 1) {
    1458          14 :     if (n <= 0) return gcopy(a);
    1459          14 :     return gerepileupto(av, gneg(gdiv(gel(T,2), gel(T,3))));
    1460             :   }
    1461        6076 :   if (typ(a) != t_POL || !signe(a)) err_reverse(a,T);
    1462        6076 :   if (gequalX(a)) return gcopy(a);
    1463        5922 :   y = RgXV_to_RgM(QXQ_powers(a,n-1,T), n);
    1464        5922 :   y = QM_gauss(y, col_ei(n, 2));
    1465        5922 :   if (!y) err_reverse(a,T);
    1466        5922 :   return gerepilecopy(av, RgV_to_RgX(y, varn(T)));
    1467             : }
    1468             : 
    1469             : GEN
    1470          28 : modreverse(GEN x)
    1471             : {
    1472             :   long v, n;
    1473             :   GEN T, a;
    1474             : 
    1475          28 :   if (typ(x)!=t_POLMOD) pari_err_TYPE("modreverse",x);
    1476          28 :   T = gel(x,1); n = degpol(T); if (n <= 0) return gcopy(x);
    1477          21 :   a = gel(x,2);
    1478          21 :   v = varn(T);
    1479          21 :   retmkpolmod(RgXQ_reverse(a, T),
    1480             :               (n==1)? gsub(pol_x(v), a): RgXQ_charpoly(a, T, v));
    1481             : }
    1482             : 
    1483             : /********************************************************************/
    1484             : /**                                                                **/
    1485             : /**                          MERGESORT                             **/
    1486             : /**                                                                **/
    1487             : /********************************************************************/
    1488             : static int
    1489          77 : cmp_small(GEN x, GEN y) {
    1490          77 :   long a = (long)x, b = (long)y;
    1491          77 :   return a>b? 1: (a<b? -1: 0);
    1492             : }
    1493             : 
    1494             : static int
    1495      295015 : veccmp(void *data, GEN x, GEN y)
    1496             : {
    1497      295015 :   GEN k = (GEN)data;
    1498      295015 :   long i, s, lk = lg(k), lx = minss(lg(x), lg(y));
    1499             : 
    1500      295015 :   if (!is_vec_t(typ(x))) pari_err_TYPE("lexicographic vecsort",x);
    1501      295015 :   if (!is_vec_t(typ(y))) pari_err_TYPE("lexicographic vecsort",y);
    1502      306684 :   for (i=1; i<lk; i++)
    1503             :   {
    1504      295043 :     long c = k[i];
    1505      295043 :     if (c >= lx)
    1506          14 :       pari_err_TYPE("lexicographic vecsort, index too large", stoi(c));
    1507      295029 :     s = lexcmp(gel(x,c), gel(y,c));
    1508      295029 :     if (s) return s;
    1509             :   }
    1510       11641 :   return 0;
    1511             : }
    1512             : 
    1513             : /* return permutation sorting v[1..n], removing duplicates. Assume n > 0 */
    1514             : static GEN
    1515     2274664 : gen_sortspec_uniq(GEN v, long n, void *E, int (*cmp)(void*,GEN,GEN))
    1516             : {
    1517             :   pari_sp av;
    1518             :   long NX, nx, ny, m, ix, iy, i;
    1519             :   GEN x, y, w, W;
    1520             :   int s;
    1521     2274664 :   switch(n)
    1522             :   {
    1523       98916 :     case 1: return mkvecsmall(1);
    1524      958426 :     case 2:
    1525      958426 :       s = cmp(E,gel(v,1),gel(v,2));
    1526      958434 :       if      (s < 0) return mkvecsmall2(1,2);
    1527      328569 :       else if (s > 0) return mkvecsmall2(2,1);
    1528       31619 :       return mkvecsmall(1);
    1529      285138 :     case 3:
    1530      285138 :       s = cmp(E,gel(v,1),gel(v,2));
    1531      285138 :       if (s < 0) {
    1532      182141 :         s = cmp(E,gel(v,2),gel(v,3));
    1533      182141 :         if (s < 0) return mkvecsmall3(1,2,3);
    1534       67271 :         else if (s == 0) return mkvecsmall2(1,2);
    1535       66542 :         s = cmp(E,gel(v,1),gel(v,3));
    1536       66542 :         if      (s < 0) return mkvecsmall3(1,3,2);
    1537       34769 :         else if (s > 0) return mkvecsmall3(3,1,2);
    1538        2408 :         return mkvecsmall2(1,2);
    1539      102997 :       } else if (s > 0) {
    1540       98839 :         s = cmp(E,gel(v,1),gel(v,3));
    1541       98839 :         if (s < 0) return mkvecsmall3(2,1,3);
    1542       67298 :         else if (s == 0) return mkvecsmall2(2,1);
    1543       65129 :         s = cmp(E,gel(v,2),gel(v,3));
    1544       65129 :         if (s < 0) return mkvecsmall3(2,3,1);
    1545       31850 :         else if (s > 0) return mkvecsmall3(3,2,1);
    1546         721 :         return mkvecsmall2(2,1);
    1547             :       } else {
    1548        4158 :         s = cmp(E,gel(v,1),gel(v,3));
    1549        4158 :         if (s < 0) return mkvecsmall2(1,3);
    1550        1855 :         else if (s == 0) return mkvecsmall(1);
    1551        1001 :         return mkvecsmall2(3,1);
    1552             :       }
    1553             :   }
    1554      932184 :   NX = nx = n>>1; ny = n-nx;
    1555      932184 :   av = avma;
    1556      932184 :   x = gen_sortspec_uniq(v,   nx,E,cmp); nx = lg(x)-1;
    1557      932214 :   y = gen_sortspec_uniq(v+NX,ny,E,cmp); ny = lg(y)-1;
    1558      932223 :   w = cgetg(n+1, t_VECSMALL);
    1559      932211 :   m = ix = iy = 1;
    1560    10267066 :   while (ix<=nx && iy<=ny)
    1561             :   {
    1562     9334853 :     s = cmp(E, gel(v,x[ix]), gel(v,y[iy]+NX));
    1563     9334855 :     if (s < 0)
    1564     4425387 :       w[m++] = x[ix++];
    1565     4909468 :     else if (s > 0)
    1566     3760576 :       w[m++] = y[iy++]+NX;
    1567             :     else {
    1568     1148892 :       w[m++] = x[ix++];
    1569     1148892 :       iy++;
    1570             :     }
    1571             :   }
    1572     1421336 :   while (ix<=nx) w[m++] = x[ix++];
    1573     2333726 :   while (iy<=ny) w[m++] = y[iy++]+NX;
    1574      932213 :   set_avma(av);
    1575      932211 :   W = cgetg(m, t_VECSMALL);
    1576    12157685 :   for (i = 1; i < m; i++) W[i] = w[i];
    1577      932208 :   return W;
    1578             : }
    1579             : 
    1580             : /* return permutation sorting v[1..n]. Assume n > 0 */
    1581             : static GEN
    1582   190741236 : gen_sortspec(GEN v, long n, void *E, int (*cmp)(void*,GEN,GEN))
    1583             : {
    1584             :   long nx, ny, m, ix, iy;
    1585             :   GEN x, y, w;
    1586   190741236 :   switch(n)
    1587             :   {
    1588     5781926 :     case 1:
    1589     5781926 :       (void)cmp(E,gel(v,1),gel(v,1)); /* check for type error */
    1590     5782002 :       return mkvecsmall(1);
    1591    78873027 :     case 2:
    1592   135370440 :       return cmp(E,gel(v,1),gel(v,2)) <= 0? mkvecsmall2(1,2)
    1593   135370323 :                                           : mkvecsmall2(2,1);
    1594    37359020 :     case 3:
    1595    37359020 :       if (cmp(E,gel(v,1),gel(v,2)) <= 0) {
    1596    27135221 :         if (cmp(E,gel(v,2),gel(v,3)) <= 0) return mkvecsmall3(1,2,3);
    1597    12086001 :         return (cmp(E,gel(v,1),gel(v,3)) <= 0)? mkvecsmall3(1,3,2)
    1598    12086009 :                                               : mkvecsmall3(3,1,2);
    1599             :       } else {
    1600    10223796 :         if (cmp(E,gel(v,1),gel(v,3)) <= 0) return mkvecsmall3(2,1,3);
    1601    10722836 :         return (cmp(E,gel(v,2),gel(v,3)) <= 0)? mkvecsmall3(2,3,1)
    1602    10722835 :                                               : mkvecsmall3(3,2,1);
    1603             :       }
    1604             :   }
    1605    68727263 :   nx = n>>1; ny = n-nx;
    1606    68727263 :   w = cgetg(n+1,t_VECSMALL);
    1607    68729021 :   x = gen_sortspec(v,   nx,E,cmp);
    1608    68728995 :   y = gen_sortspec(v+nx,ny,E,cmp);
    1609    68729060 :   m = ix = iy = 1;
    1610   459787075 :   while (ix<=nx && iy<=ny)
    1611   391058083 :     if (cmp(E, gel(v,x[ix]), gel(v,y[iy]+nx))<=0)
    1612   216886663 :       w[m++] = x[ix++];
    1613             :     else
    1614   174171352 :       w[m++] = y[iy++]+nx;
    1615   104682752 :   while (ix<=nx) w[m++] = x[ix++];
    1616   174713038 :   while (iy<=ny) w[m++] = y[iy++]+nx;
    1617    68728992 :   set_avma((pari_sp)w); return w;
    1618             : }
    1619             : 
    1620             : static void
    1621    46510048 : init_sort(GEN *x, long *tx, long *lx)
    1622             : {
    1623    46510048 :   *tx = typ(*x);
    1624    46510048 :   if (*tx == t_LIST)
    1625             :   {
    1626          35 :     if (list_typ(*x)!=t_LIST_RAW) pari_err_TYPE("sort",*x);
    1627          35 :     *x = list_data(*x);
    1628          35 :     *lx = *x? lg(*x): 1;
    1629             :   } else {
    1630    46510013 :     if (!is_matvec_t(*tx) && *tx != t_VECSMALL) pari_err_TYPE("gen_sort",*x);
    1631    46509972 :     *lx = lg(*x);
    1632             :   }
    1633    46510007 : }
    1634             : 
    1635             : /* (x o y)[1..lx-1], destroy y */
    1636             : INLINE GEN
    1637     3157450 : sort_extract(GEN x, GEN y, long tx, long lx)
    1638             : {
    1639             :   long i;
    1640     3157450 :   switch(tx)
    1641             :   {
    1642           7 :     case t_VECSMALL:
    1643          35 :       for (i=1; i<lx; i++) y[i] = x[y[i]];
    1644           7 :       break;
    1645           7 :     case t_LIST:
    1646           7 :       settyp(y,t_VEC);
    1647          35 :       for (i=1; i<lx; i++) gel(y,i) = gel(x,y[i]);
    1648           7 :       return gtolist(y);
    1649     3157436 :     default:
    1650     3157436 :       settyp(y,tx);
    1651     9711118 :       for (i=1; i<lx; i++) gel(y,i) = gcopy(gel(x,y[i]));
    1652             :   }
    1653     3157494 :   return y;
    1654             : }
    1655             : 
    1656             : static GEN
    1657     1945478 : triv_sort(long tx) { return tx == t_LIST? mklist(): cgetg(1, tx); }
    1658             : /* Sort the vector x, using cmp to compare entries. */
    1659             : GEN
    1660      347928 : gen_sort_uniq(GEN x, void *E, int (*cmp)(void*,GEN,GEN))
    1661             : {
    1662             :   long tx, lx;
    1663             :   GEN y;
    1664             : 
    1665      347928 :   init_sort(&x, &tx, &lx);
    1666      347928 :   if (lx==1) return triv_sort(tx);
    1667      343252 :   y = gen_sortspec_uniq(x,lx-1,E,cmp);
    1668      343252 :   return sort_extract(x, y, tx, lg(y)); /* lg(y) <= lx */
    1669             : }
    1670             : /* Sort the vector x, using cmp to compare entries. */
    1671             : GEN
    1672     4754961 : gen_sort(GEN x, void *E, int (*cmp)(void*,GEN,GEN))
    1673             : {
    1674             :   long tx, lx;
    1675             :   GEN y;
    1676             : 
    1677     4754961 :   init_sort(&x, &tx, &lx);
    1678     4754940 :   if (lx==1) return triv_sort(tx);
    1679     2814138 :   y = gen_sortspec(x,lx-1,E,cmp);
    1680     2814203 :   return sort_extract(x, y, tx, lx);
    1681             : }
    1682             : /* indirect sort: return the permutation that would sort x */
    1683             : GEN
    1684       73835 : gen_indexsort_uniq(GEN x, void *E, int (*cmp)(void*,GEN,GEN))
    1685             : {
    1686             :   long tx, lx;
    1687       73835 :   init_sort(&x, &tx, &lx);
    1688       73826 :   if (lx==1) return cgetg(1, t_VECSMALL);
    1689       67028 :   return gen_sortspec_uniq(x,lx-1,E,cmp);
    1690             : }
    1691             : /* indirect sort: return the permutation that would sort x */
    1692             : GEN
    1693      829493 : gen_indexsort(GEN x, void *E, int (*cmp)(void*,GEN,GEN))
    1694             : {
    1695             :   long tx, lx;
    1696      829493 :   init_sort(&x, &tx, &lx);
    1697      829490 :   if (lx==1) return cgetg(1, t_VECSMALL);
    1698      829182 :   return gen_sortspec(x,lx-1,E,cmp);
    1699             : }
    1700             : 
    1701             : /* Sort the vector x in place, using cmp to compare entries */
    1702             : void
    1703    40101525 : gen_sort_inplace(GEN x, void *E, int (*cmp)(void*,GEN,GEN), GEN *perm)
    1704             : {
    1705             :   long tx, lx, i;
    1706    40101525 :   pari_sp av = avma;
    1707             :   GEN y;
    1708             : 
    1709    40101525 :   init_sort(&x, &tx, &lx);
    1710    40101524 :   if (lx<=2)
    1711             :   {
    1712      566082 :     if (perm) *perm = lx == 1? cgetg(1, t_VECSMALL): mkvecsmall(1);
    1713      566082 :     return;
    1714             :   }
    1715    39535442 :   y = gen_sortspec(x,lx-1, E, cmp);
    1716    39535427 :   if (perm)
    1717             :   {
    1718       15351 :     GEN z = new_chunk(lx);
    1719      121324 :     for (i=1; i<lx; i++) gel(z,i) = gel(x,y[i]);
    1720      121324 :     for (i=1; i<lx; i++) gel(x,i) = gel(z,i);
    1721       15351 :     *perm = y;
    1722       15351 :     set_avma((pari_sp)y);
    1723             :   } else {
    1724   283449373 :     for (i=1; i<lx; i++) gel(y,i) = gel(x,y[i]);
    1725   283449385 :     for (i=1; i<lx; i++) gel(x,i) = gel(y,i);
    1726    39520076 :     set_avma(av);
    1727             :   }
    1728             : }
    1729             : GEN
    1730      402339 : gen_sort_shallow(GEN x, void *E, int (*cmp)(void*,GEN,GEN))
    1731             : {
    1732             :   long tx, lx, i;
    1733             :   pari_sp av;
    1734             :   GEN y, z;
    1735             : 
    1736      402339 :   init_sort(&x, &tx, &lx);
    1737      402339 :   if (lx<=2) return x;
    1738      240968 :   z = cgetg(lx, tx); av = avma;
    1739      240968 :   y = gen_sortspec(x,lx-1, E, cmp);
    1740     1246616 :   for (i=1; i<lx; i++) gel(z,i) = gel(x,y[i]);
    1741      240968 :   return gc_const(av, z);
    1742             : }
    1743             : 
    1744             : static int
    1745        7909 : closurecmp(void *data, GEN x, GEN y)
    1746             : {
    1747        7909 :   pari_sp av = avma;
    1748        7909 :   long s = gsigne(closure_callgen2((GEN)data, x,y));
    1749        7909 :   set_avma(av); return s;
    1750             : }
    1751             : static void
    1752         133 : check_positive_entries(GEN k)
    1753             : {
    1754         133 :   long i, l = lg(k);
    1755         301 :   for (i=1; i<l; i++)
    1756         168 :     if (k[i] <= 0) pari_err_DOMAIN("sort_function", "index", "<", gen_0, stoi(k[i]));
    1757         133 : }
    1758             : 
    1759             : typedef int (*CMP_FUN)(void*,GEN,GEN);
    1760             : /* return NULL if t_CLOSURE k is a "key" (arity 1) and not a sorting func */
    1761             : static CMP_FUN
    1762      126861 : sort_function(void **E, GEN x, GEN k)
    1763             : {
    1764      126861 :   int (*cmp)(GEN,GEN) = &lexcmp;
    1765      126861 :   long tx = typ(x);
    1766      126861 :   if (!k)
    1767             :   {
    1768      126175 :     *E = (void*)((typ(x) == t_VECSMALL)? cmp_small: cmp);
    1769      126175 :     return &cmp_nodata;
    1770             :   }
    1771         686 :   if (tx == t_VECSMALL) pari_err_TYPE("sort_function", x);
    1772         672 :   switch(typ(k))
    1773             :   {
    1774          98 :     case t_INT: k = mkvecsmall(itos(k));  break;
    1775          35 :     case t_VEC: case t_COL: k = ZV_to_zv(k); break;
    1776           0 :     case t_VECSMALL: break;
    1777         539 :     case t_CLOSURE:
    1778         539 :      if (closure_is_variadic(k))
    1779           0 :        pari_err_TYPE("sort_function, variadic cmpf",k);
    1780         539 :      *E = (void*)k;
    1781         539 :      switch(closure_arity(k))
    1782             :      {
    1783          35 :        case 1: return NULL; /* wrt key */
    1784         504 :        case 2: return &closurecmp;
    1785           0 :        default: pari_err_TYPE("sort_function, cmpf arity != 1, 2",k);
    1786             :      }
    1787           0 :     default: pari_err_TYPE("sort_function",k);
    1788             :   }
    1789         133 :   check_positive_entries(k);
    1790         133 :   *E = (void*)k; return &veccmp;
    1791             : }
    1792             : 
    1793             : #define cmp_IND 1
    1794             : #define cmp_LEX 2 /* FIXME: backward compatibility, ignored */
    1795             : #define cmp_REV 4
    1796             : #define cmp_UNIQ 8
    1797             : GEN
    1798         735 : vecsort0(GEN x, GEN k, long flag)
    1799             : {
    1800             :   void *E;
    1801         735 :   int (*CMP)(void*,GEN,GEN) = sort_function(&E, x, k);
    1802             : 
    1803         728 :   if (flag < 0 || flag > (cmp_REV|cmp_LEX|cmp_IND|cmp_UNIQ))
    1804           0 :     pari_err_FLAG("vecsort");
    1805         728 :   if (!CMP)
    1806             :   { /* wrt key: precompute all values, O(n) calls instead of O(n log n) */
    1807          28 :     pari_sp av = avma;
    1808             :     GEN v, y;
    1809             :     long i, tx, lx;
    1810          28 :     init_sort(&x, &tx, &lx);
    1811          28 :     if (lx == 1) return flag&cmp_IND? cgetg(1,t_VECSMALL): triv_sort(tx);
    1812          28 :     v = cgetg(lx, t_VEC);
    1813         140 :     for (i = 1; i < lx; i++) gel(v,i) = closure_callgen1(k, gel(x,i));
    1814          28 :     y = vecsort0(v, NULL, flag | cmp_IND);
    1815          28 :     y = flag&cmp_IND? y: sort_extract(x, y, tx, lg(y));
    1816          28 :     return gerepileupto(av, y);
    1817             :   }
    1818         700 :   if (flag&cmp_UNIQ)
    1819          35 :     x = flag&cmp_IND? gen_indexsort_uniq(x, E, CMP): gen_sort_uniq(x, E, CMP);
    1820             :   else
    1821         665 :     x = flag&cmp_IND? gen_indexsort(x, E, CMP): gen_sort(x, E, CMP);
    1822         686 :   if (flag & cmp_REV)
    1823             :   { /* reverse order */
    1824          35 :     GEN y = x;
    1825          35 :     if (typ(x)==t_LIST) { y = list_data(x); if (!y) return x; }
    1826          28 :     vecreverse_inplace(y);
    1827             :   }
    1828         679 :   return x;
    1829             : }
    1830             : 
    1831             : GEN
    1832      204778 : indexsort(GEN x) { return gen_indexsort(x, (void*)&gcmp, cmp_nodata); }
    1833             : GEN
    1834           0 : indexlexsort(GEN x) { return gen_indexsort(x, (void*)&lexcmp, cmp_nodata); }
    1835             : GEN
    1836          42 : indexvecsort(GEN x, GEN k)
    1837             : {
    1838          42 :   if (typ(k) != t_VECSMALL) pari_err_TYPE("vecsort",k);
    1839          42 :   return gen_indexsort(x, (void*)k, &veccmp);
    1840             : }
    1841             : 
    1842             : GEN
    1843     1835211 : sort(GEN x) { return gen_sort(x, (void*)gcmp, cmp_nodata); }
    1844             : GEN
    1845      127980 : lexsort(GEN x) { return gen_sort(x, (void*)lexcmp, cmp_nodata); }
    1846             : GEN
    1847        2954 : vecsort(GEN x, GEN k)
    1848             : {
    1849        2954 :   if (typ(k) != t_VECSMALL) pari_err_TYPE("vecsort",k);
    1850        2954 :   return gen_sort(x, (void*)k, &veccmp);
    1851             : }
    1852             : /* adapted from gen_search; don't export: keys of T[i] should be precomputed */
    1853             : static long
    1854           7 : key_search(GEN T, GEN x, GEN code)
    1855             : {
    1856           7 :   long u = lg(T)-1, i, l, s;
    1857             : 
    1858           7 :   if (!u) return 0;
    1859           7 :   l = 1; x = closure_callgen1(code, x);
    1860             :   do
    1861             :   {
    1862          14 :     i = (l+u)>>1; s = lexcmp(x, closure_callgen1(code, gel(T,i)));
    1863          14 :     if (!s) return i;
    1864           7 :     if (s<0) u=i-1; else l=i+1;
    1865           7 :   } while (u>=l);
    1866           0 :   return 0;
    1867             : }
    1868             : long
    1869      126126 : vecsearch(GEN v, GEN x, GEN k)
    1870             : {
    1871      126126 :   pari_sp av = avma;
    1872             :   long r;
    1873             :   void *E;
    1874      126126 :   int (*CMP)(void*,GEN,GEN) = sort_function(&E, v, k);
    1875      126119 :   switch(typ(v))
    1876             :   {
    1877          21 :     case t_VECSMALL: x = (GEN)itos(x); break;
    1878      126077 :     case t_VEC: case t_COL: break;
    1879          21 :     case t_LIST:
    1880          21 :       if (list_typ(v)==t_LIST_RAW)
    1881             :       {
    1882          21 :         v = list_data(v); if (!v) v = cgetg(1, t_VEC);
    1883          21 :         break;
    1884             :       }
    1885             :       /* fall through */
    1886             :     default:
    1887           0 :       pari_err_TYPE("vecsearch", v);
    1888             :   }
    1889      126119 :   r = CMP? gen_search(v, x, E, CMP): key_search(v, x, k);
    1890      126119 :   return gc_long(av, r < 0? 0: r);
    1891             : }
    1892             : 
    1893             : GEN
    1894        3759 : ZV_indexsort(GEN L) { return gen_indexsort(L, (void*)&cmpii, &cmp_nodata); }
    1895             : GEN
    1896          63 : ZV_sort(GEN L) { return gen_sort(L, (void*)&cmpii, &cmp_nodata); }
    1897             : GEN
    1898       60977 : ZV_sort_uniq(GEN L) { return gen_sort_uniq(L, (void*)&cmpii, &cmp_nodata); }
    1899             : void
    1900     1221322 : ZV_sort_inplace(GEN L) { gen_sort_inplace(L, (void*)&cmpii, &cmp_nodata,NULL); }
    1901             : GEN
    1902       37470 : ZV_sort_uniq_shallow(GEN L)
    1903             : {
    1904       37470 :   GEN v = gen_indexsort_uniq(L, (void*)&cmpii, &cmp_nodata);
    1905       37470 :   return vecpermute(L, v);
    1906             : }
    1907             : GEN
    1908        1288 : ZV_sort_shallow(GEN L)
    1909             : {
    1910        1288 :   GEN v = gen_indexsort(L, (void*)&cmpii, &cmp_nodata);
    1911        1288 :   return vecpermute(L, v);
    1912             : }
    1913             : 
    1914             : GEN
    1915        1127 : vec_equiv(GEN F)
    1916             : {
    1917        1127 :   pari_sp av = avma;
    1918        1127 :   long j, k, L = lg(F);
    1919        1127 :   GEN w = cgetg(L, t_VEC);
    1920        1127 :   GEN perm = gen_indexsort(F, (void*)&cmp_universal, cmp_nodata);
    1921        3213 :   for (j = k = 1; j < L;)
    1922             :   {
    1923        2086 :     GEN v = cgetg(L, t_VECSMALL);
    1924        2086 :     long l = 1, o = perm[j];
    1925        2086 :     v[l++] = o;
    1926        4921 :     for (j++; j < L; v[l++] = perm[j++])
    1927        3794 :       if (!gequal(gel(F,o), gel(F, perm[j]))) break;
    1928        2086 :     setlg(v, l); gel(w, k++) = v;
    1929             :   }
    1930        1127 :   setlg(w, k); return gerepilecopy(av,w);
    1931             : }
    1932             : 
    1933             : GEN
    1934       21252 : vec_reduce(GEN v, GEN *pE)
    1935             : {
    1936       21252 :   GEN E, F, P = gen_indexsort(v, (void*)cmp_universal, cmp_nodata);
    1937             :   long i, m, l;
    1938       21252 :   F = cgetg_copy(v, &l);
    1939       21252 :   *pE = E = cgetg(l, t_VECSMALL);
    1940       54187 :   for (i = m = 1; i < l;)
    1941             :   {
    1942       32935 :     GEN u = gel(v, P[i]);
    1943             :     long k;
    1944       38283 :     for(k = i + 1; k < l; k++)
    1945       17038 :       if (cmp_universal(gel(v, P[k]), u)) break;
    1946       32935 :     E[m] = k - i; gel(F, m) = u; i = k; m++;
    1947             :   }
    1948       21252 :   setlg(F, m);
    1949       21252 :   setlg(E, m); return F;
    1950             : }
    1951             : 
    1952             : /********************************************************************/
    1953             : /**                      SEARCH IN SORTED VECTOR                   **/
    1954             : /********************************************************************/
    1955             : /* index of x in table T, 0 otherwise */
    1956             : long
    1957     1126817 : tablesearch(GEN T, GEN x, int (*cmp)(GEN,GEN))
    1958             : {
    1959     1126817 :   long l = 1, u = lg(T)-1, i, s;
    1960             : 
    1961     8170465 :   while (u>=l)
    1962             :   {
    1963     8125003 :     i = (l+u)>>1; s = cmp(x, gel(T,i));
    1964     8125004 :     if (!s) return i;
    1965     7043648 :     if (s<0) u=i-1; else l=i+1;
    1966             :   }
    1967       45462 :   return 0;
    1968             : }
    1969             : 
    1970             : /* looks if x belongs to the set T and returns the index if yes, 0 if no */
    1971             : long
    1972    23574726 : gen_search(GEN T, GEN x, void *data, int (*cmp)(void*,GEN,GEN))
    1973             : {
    1974    23574726 :   long u = lg(T)-1, i, l, s;
    1975             : 
    1976    23574726 :   if (!u) return -1;
    1977    23574698 :   l = 1;
    1978             :   do
    1979             :   {
    1980   110212921 :     i = (l+u) >> 1; s = cmp(data, x, gel(T,i));
    1981   110212921 :     if (!s) return i;
    1982    86691738 :     if (s < 0) u = i-1; else l = i+1;
    1983    86691738 :   } while (u >= l);
    1984       53515 :   return -((s < 0)? i: i+1);
    1985             : }
    1986             : 
    1987             : long
    1988     1073739 : ZV_search(GEN x, GEN y) { return tablesearch(x, y, cmpii); }
    1989             : 
    1990             : long
    1991    12874882 : zv_search(GEN T, long x)
    1992             : {
    1993    12874882 :   long l = 1, u = lg(T)-1;
    1994    52254079 :   while (u>=l)
    1995             :   {
    1996    41785820 :     long i = (l+u)>>1;
    1997    41785820 :     if (x < T[i]) u = i-1;
    1998    25888706 :     else if (x > T[i]) l = i+1;
    1999     2406623 :     else return i;
    2000             :   }
    2001    10468259 :   return 0;
    2002             : }
    2003             : 
    2004             : /********************************************************************/
    2005             : /**                   COMPARISON FUNCTIONS                         **/
    2006             : /********************************************************************/
    2007             : int
    2008   645114093 : cmp_nodata(void *data, GEN x, GEN y)
    2009             : {
    2010   645114093 :   int (*cmp)(GEN,GEN)=(int (*)(GEN,GEN)) data;
    2011   645114093 :   return cmp(x,y);
    2012             : }
    2013             : 
    2014             : /* assume x and y come from the same idealprimedec call (uniformizer unique) */
    2015             : int
    2016     3367179 : cmp_prime_over_p(GEN x, GEN y)
    2017             : {
    2018     3367179 :   long k = pr_get_f(x) - pr_get_f(y); /* diff. between residue degree */
    2019      222170 :   return k? ((k > 0)? 1: -1)
    2020     3589328 :           : ZV_cmp(pr_get_gen(x), pr_get_gen(y));
    2021             : }
    2022             : 
    2023             : int
    2024      672310 : cmp_prime_ideal(GEN x, GEN y)
    2025             : {
    2026      672310 :   int k = cmpii(pr_get_p(x), pr_get_p(y));
    2027      672309 :   return k? k: cmp_prime_over_p(x,y);
    2028             : }
    2029             : 
    2030             : /* assume x and y are t_POL in the same variable whose coeffs can be
    2031             :  * compared (used to sort polynomial factorizations) */
    2032             : int
    2033     5521489 : gen_cmp_RgX(void *data, GEN x, GEN y)
    2034             : {
    2035     5521489 :   int (*coeff_cmp)(GEN,GEN)=(int(*)(GEN,GEN))data;
    2036     5521489 :   long i, lx = lg(x), ly = lg(y);
    2037             :   int fl;
    2038     5521489 :   if (lx > ly) return  1;
    2039     5484391 :   if (lx < ly) return -1;
    2040    12289689 :   for (i=lx-1; i>1; i--)
    2041    11516553 :     if ((fl = coeff_cmp(gel(x,i), gel(y,i)))) return fl;
    2042      773136 :   return 0;
    2043             : }
    2044             : 
    2045             : static int
    2046        3609 : cmp_RgX_Rg(GEN x, GEN y)
    2047             : {
    2048        3609 :   long lx = lgpol(x), ly;
    2049        3609 :   if (lx > 1) return  1;
    2050           0 :   ly = gequal0(y) ? 0:1;
    2051           0 :   if (lx > ly) return  1;
    2052           0 :   if (lx < ly) return -1;
    2053           0 :   if (lx==0) return 0;
    2054           0 :   return gcmp(gel(x,2), y);
    2055             : }
    2056             : int
    2057      111061 : cmp_RgX(GEN x, GEN y)
    2058             : {
    2059      111061 :   if (typ(x) == t_POLMOD) x = gel(x,2);
    2060      111061 :   if (typ(y) == t_POLMOD) y = gel(y,2);
    2061      111061 :   if (typ(x) == t_POL) {
    2062       55971 :     if (typ(y) != t_POL) return cmp_RgX_Rg(x, y);
    2063             :   } else {
    2064       55090 :     if (typ(y) != t_POL) return gcmp(x,y);
    2065        3364 :     return - cmp_RgX_Rg(y,x);
    2066             :   }
    2067       55726 :   return gen_cmp_RgX((void*)&gcmp,x,y);
    2068             : }
    2069             : 
    2070             : int
    2071      323603 : cmp_Flx(GEN x, GEN y)
    2072             : {
    2073      323603 :   long i, lx = lg(x), ly = lg(y);
    2074      323603 :   if (lx > ly) return  1;
    2075      307588 :   if (lx < ly) return -1;
    2076      548802 :   for (i=lx-1; i>1; i--)
    2077      463879 :     if (uel(x,i) != uel(y,i)) return uel(x,i)<uel(y,i)? -1: 1;
    2078       84923 :   return 0;
    2079             : }
    2080             : /********************************************************************/
    2081             : /**                   MERGE & SORT FACTORIZATIONS                  **/
    2082             : /********************************************************************/
    2083             : /* merge fx, fy two factorizations, whose 1st column is sorted in strictly
    2084             :  * increasing order wrt cmp */
    2085             : GEN
    2086      692238 : merge_factor(GEN fx, GEN fy, void *data, int (*cmp)(void *,GEN,GEN))
    2087             : {
    2088      692238 :   GEN x = gel(fx,1), e = gel(fx,2), M, E;
    2089      692238 :   GEN y = gel(fy,1), f = gel(fy,2);
    2090      692238 :   long ix, iy, m, lx = lg(x), ly = lg(y), l = lx+ly-1;
    2091             : 
    2092      692238 :   M = cgetg(l, t_COL);
    2093      692238 :   E = cgetg(l, t_COL);
    2094             : 
    2095      692238 :   m = ix = iy = 1;
    2096    10044851 :   while (ix<lx && iy<ly)
    2097             :   {
    2098     9352613 :     int s = cmp(data, gel(x,ix), gel(y,iy));
    2099     9352613 :     if (s < 0)
    2100     8717960 :     { gel(M,m) = gel(x,ix); gel(E,m) = gel(e,ix); ix++; }
    2101      634653 :     else if (s == 0)
    2102             :     {
    2103       94997 :       GEN z = gel(x,ix), g = addii(gel(e,ix), gel(f,iy));
    2104       94997 :       iy++; ix++; if (!signe(g)) continue;
    2105       11060 :       gel(M,m) = z; gel(E,m) = g;
    2106             :     }
    2107             :     else
    2108      539656 :     { gel(M,m) = gel(y,iy); gel(E,m) = gel(f,iy); iy++; }
    2109     9268676 :     m++;
    2110             :   }
    2111     4860275 :   while (ix<lx) { gel(M,m) = gel(x,ix); gel(E,m) = gel(e,ix); ix++; m++; }
    2112      937921 :   while (iy<ly) { gel(M,m) = gel(y,iy); gel(E,m) = gel(f,iy); iy++; m++; }
    2113      692238 :   setlg(M, m);
    2114      692238 :   setlg(E, m); return mkmat2(M, E);
    2115             : }
    2116             : 
    2117             : GEN
    2118       30948 : ZM_merge_factor(GEN A, GEN B)
    2119             : {
    2120       30948 :   return merge_factor(A, B, (void*)&cmpii, cmp_nodata);
    2121             : }
    2122             : 
    2123             : /* merge two sorted vectors, removing duplicates. Shallow */
    2124             : GEN
    2125      451980 : merge_sort_uniq(GEN x, GEN y, void *data, int (*cmp)(void *,GEN,GEN))
    2126             : {
    2127      451980 :   long i, j, k, lx = lg(x), ly = lg(y);
    2128      451980 :   GEN z = cgetg(lx + ly - 1, typ(x));
    2129      451979 :   i = j = k = 1;
    2130      592058 :   while (i<lx && j<ly)
    2131             :   {
    2132      140079 :     int s = cmp(data, gel(x,i), gel(y,j));
    2133      140079 :     if (s < 0)
    2134      118973 :       gel(z,k++) = gel(x,i++);
    2135       21106 :     else if (s > 0)
    2136       21085 :       gel(z,k++) = gel(y,j++);
    2137             :     else
    2138          21 :     { gel(z,k++) = gel(x,i++); j++; }
    2139             :   }
    2140      803207 :   while (i<lx) gel(z,k++) = gel(x,i++);
    2141      579753 :   while (j<ly) gel(z,k++) = gel(y,j++);
    2142      451979 :   setlg(z, k); return z;
    2143             : }
    2144             : /* in case of equal keys in x,y, take the key from x */
    2145             : static GEN
    2146       34734 : ZV_union_shallow_t(GEN x, GEN y, long t)
    2147             : {
    2148       34734 :   long i, j, k, lx = lg(x), ly = lg(y);
    2149       34734 :   GEN z = cgetg(lx + ly - 1, t);
    2150       34734 :   i = j = k = 1;
    2151       78218 :   while (i<lx && j<ly)
    2152             :   {
    2153       43484 :     int s = cmpii(gel(x,i), gel(y,j));
    2154       43484 :     if (s < 0)
    2155       23632 :       gel(z,k++) = gel(x,i++);
    2156       19852 :     else if (s > 0)
    2157       10353 :       gel(z,k++) = gel(y,j++);
    2158             :     else
    2159        9499 :     { gel(z,k++) = gel(x,i++); j++; }
    2160             :   }
    2161       41860 :   while (i < lx) gel(z,k++) = gel(x,i++);
    2162       70399 :   while (j < ly) gel(z,k++) = gel(y,j++);
    2163       34734 :   setlg(z, k); return z;
    2164             : }
    2165             : GEN
    2166       34552 : ZV_union_shallow(GEN x, GEN y)
    2167       34552 : { return ZV_union_shallow_t(x, y, t_VEC); }
    2168             : GEN
    2169         182 : ZC_union_shallow(GEN x, GEN y)
    2170         182 : { return ZV_union_shallow_t(x, y, t_COL); }
    2171             : 
    2172             : /* sort generic factorization, in place */
    2173             : GEN
    2174     9886440 : sort_factor(GEN y, void *data, int (*cmp)(void *,GEN,GEN))
    2175             : {
    2176             :   GEN a, b, A, B, w;
    2177             :   pari_sp av;
    2178             :   long n, i;
    2179             : 
    2180     9886440 :   a = gel(y,1); n = lg(a); if (n == 1) return y;
    2181     9863972 :   b = gel(y,2); av = avma;
    2182     9863972 :   A = new_chunk(n);
    2183     9863900 :   B = new_chunk(n);
    2184     9863723 :   w = gen_sortspec(a, n-1, data, cmp);
    2185    29599473 :   for (i=1; i<n; i++) { long k=w[i]; gel(A,i) = gel(a,k); gel(B,i) = gel(b,k); }
    2186    29599762 :   for (i=1; i<n; i++) { gel(a,i) = gel(A,i); gel(b,i) = gel(B,i); }
    2187     9864013 :   set_avma(av); return y;
    2188             : }
    2189             : /* sort polynomial factorization, in place */
    2190             : GEN
    2191     1986913 : sort_factor_pol(GEN y,int (*cmp)(GEN,GEN))
    2192             : {
    2193     1986913 :   (void)sort_factor(y,(void*)cmp, &gen_cmp_RgX);
    2194     1986918 :   return y;
    2195             : }
    2196             : 
    2197             : /***********************************************************************/
    2198             : /*                                                                     */
    2199             : /*                          SET OPERATIONS                             */
    2200             : /*                                                                     */
    2201             : /***********************************************************************/
    2202             : GEN
    2203      227101 : gtoset(GEN x)
    2204             : {
    2205             :   long lx;
    2206      227101 :   if (!x) return cgetg(1, t_VEC);
    2207      227101 :   switch(typ(x))
    2208             :   {
    2209      227073 :     case t_VEC:
    2210      227073 :     case t_COL: lx = lg(x); break;
    2211          14 :     case t_LIST:
    2212          14 :       if (list_typ(x)==t_LIST_MAP) return mapdomain(x);
    2213          14 :       x = list_data(x); lx = x? lg(x): 1; break;
    2214           7 :     case t_VECSMALL: lx = lg(x); x = zv_to_ZV(x); break;
    2215           7 :     default: return mkveccopy(x);
    2216             :   }
    2217      227094 :   if (lx==1) return cgetg(1,t_VEC);
    2218      226919 :   x = gen_sort_uniq(x, (void*)&cmp_universal, cmp_nodata);
    2219      226919 :   settyp(x, t_VEC); /* it may be t_COL */
    2220      226919 :   return x;
    2221             : }
    2222             : 
    2223             : long
    2224          14 : setisset(GEN x)
    2225             : {
    2226          14 :   long i, lx = lg(x);
    2227             : 
    2228          14 :   if (typ(x) != t_VEC) return 0;
    2229          14 :   if (lx == 1) return 1;
    2230          70 :   for (i=1; i<lx-1; i++)
    2231          63 :     if (cmp_universal(gel(x,i+1), gel(x,i)) <= 0) return 0;
    2232           7 :   return 1;
    2233             : }
    2234             : 
    2235             : long
    2236       83622 : setsearch(GEN T, GEN y, long flag)
    2237             : {
    2238             :   long i, lx;
    2239       83622 :   switch(typ(T))
    2240             :   {
    2241       83608 :     case t_VEC: lx = lg(T); break;
    2242           7 :     case t_LIST:
    2243           7 :     if (list_typ(T) != t_LIST_RAW) pari_err_TYPE("setsearch",T);
    2244           7 :     T = list_data(T); lx = T? lg(T): 1; break;
    2245           7 :     default: pari_err_TYPE("setsearch",T);
    2246             :       return 0; /*LCOV_EXCL_LINE*/
    2247             :   }
    2248       83615 :   if (lx==1) return flag? 1: 0;
    2249       83615 :   i = gen_search(T,y,(void*)cmp_universal,cmp_nodata);
    2250       83615 :   if (i > 0) return flag? 0: i;
    2251          56 :   return flag ? -i: 0;
    2252             : }
    2253             : 
    2254             : GEN
    2255           7 : setunion_i(GEN x, GEN y)
    2256           7 : { return merge_sort_uniq(x,y, (void*)cmp_universal, cmp_nodata); }
    2257             : 
    2258             : GEN
    2259           7 : setunion(GEN x, GEN y)
    2260             : {
    2261           7 :   pari_sp av = avma;
    2262           7 :   if (typ(x) != t_VEC) pari_err_TYPE("setunion",x);
    2263           7 :   if (typ(y) != t_VEC) pari_err_TYPE("setunion",y);
    2264           7 :   return gerepilecopy(av, setunion_i(x, y));
    2265             : }
    2266             : 
    2267             : GEN
    2268          14 : setdelta(GEN x, GEN y)
    2269             : {
    2270          14 :   long ix = 1, iy = 1, iz = 1, lx = lg(x), ly = lg(y);
    2271          14 :   pari_sp av = avma;
    2272          14 :   GEN z = cgetg(lx + ly - 1,t_VEC);
    2273          14 :   if (typ(x) != t_VEC) pari_err_TYPE("setdelta",x);
    2274          14 :   if (typ(y) != t_VEC) pari_err_TYPE("setdelta",y);
    2275          84 :   while (ix < lx && iy < ly)
    2276             :   {
    2277          70 :     int c = cmp_universal(gel(x,ix), gel(y,iy));
    2278          70 :     if      (c < 0) gel(z, iz++) = gel(x,ix++);
    2279          42 :     else if (c > 0) gel(z, iz++) = gel(y,iy++);
    2280          28 :     else { ix++; iy++; }
    2281             :   }
    2282          21 :   while (ix<lx) gel(z,iz++) = gel(x,ix++);
    2283          14 :   while (iy<ly) gel(z,iz++) = gel(y,iy++);
    2284          14 :   setlg(z,iz); return gerepilecopy(av,z);
    2285             : }
    2286             : 
    2287             : GEN
    2288           7 : setintersect(GEN x, GEN y)
    2289             : {
    2290           7 :   long ix = 1, iy = 1, iz = 1, lx = lg(x), ly = lg(y);
    2291           7 :   pari_sp av = avma;
    2292           7 :   GEN z = cgetg(lx,t_VEC);
    2293           7 :   if (typ(x) != t_VEC) pari_err_TYPE("setintersect",x);
    2294           7 :   if (typ(y) != t_VEC) pari_err_TYPE("setintersect",y);
    2295          70 :   while (ix < lx && iy < ly)
    2296             :   {
    2297          63 :     int c = cmp_universal(gel(x,ix), gel(y,iy));
    2298          63 :     if      (c < 0) ix++;
    2299          35 :     else if (c > 0) iy++;
    2300          21 :     else { gel(z, iz++) = gel(x,ix); ix++; iy++; }
    2301             :   }
    2302           7 :   setlg(z,iz); return gerepilecopy(av,z);
    2303             : }
    2304             : 
    2305             : GEN
    2306         259 : gen_setminus(GEN A, GEN B, int (*cmp)(GEN,GEN))
    2307             : {
    2308         259 :   pari_sp ltop = avma;
    2309         259 :   long i = 1, j = 1, k = 1, lx = lg(A), ly = lg(B);
    2310         259 :   GEN  diff = cgetg(lx,t_VEC);
    2311        5481 :   while (i < lx && j < ly)
    2312        5222 :     switch ( cmp(gel(A,i),gel(B,j)) )
    2313             :     {
    2314         938 :       case -1: gel(diff,k++) = gel(A,i++); break;
    2315        2044 :       case 1: j++; break;
    2316        2240 :       case 0: i++; break;
    2317             :     }
    2318         308 :   while (i < lx) gel(diff,k++) = gel(A,i++);
    2319         259 :   setlg(diff,k);
    2320         259 :   return gerepilecopy(ltop,diff);
    2321             : }
    2322             : 
    2323             : GEN
    2324         259 : setminus(GEN x, GEN y)
    2325             : {
    2326         259 :   if (typ(x) != t_VEC) pari_err_TYPE("setminus",x);
    2327         259 :   if (typ(y) != t_VEC) pari_err_TYPE("setminus",y);
    2328         259 :   return gen_setminus(x,y,cmp_universal);
    2329             : }
    2330             : 
    2331             : GEN
    2332          21 : setbinop(GEN f, GEN x, GEN y)
    2333             : {
    2334          21 :   pari_sp av = avma;
    2335          21 :   long i, j, lx, ly, k = 1;
    2336             :   GEN z;
    2337          21 :   if (typ(f) != t_CLOSURE || closure_arity(f) != 2 || closure_is_variadic(f))
    2338           7 :     pari_err_TYPE("setbinop [function needs exactly 2 arguments]",f);
    2339          14 :   lx = lg(x);
    2340          14 :   if (typ(x) != t_VEC) pari_err_TYPE("setbinop", x);
    2341          14 :   if (y == NULL) { /* assume x = y and f symmetric */
    2342           7 :     z = cgetg((((lx-1)*lx) >> 1) + 1, t_VEC);
    2343          28 :     for (i = 1; i < lx; i++)
    2344          63 :       for (j = i; j < lx; j++)
    2345          42 :         gel(z, k++) = closure_callgen2(f, gel(x,i),gel(x,j));
    2346             :   } else {
    2347           7 :     ly = lg(y);
    2348           7 :     if (typ(y) != t_VEC) pari_err_TYPE("setbinop", y);
    2349           7 :     z = cgetg((lx-1)*(ly-1) + 1, t_VEC);
    2350          28 :     for (i = 1; i < lx; i++)
    2351          84 :       for (j = 1; j < ly; j++)
    2352          63 :         gel(z, k++) = closure_callgen2(f, gel(x,i),gel(y,j));
    2353             :   }
    2354          14 :   return gerepileupto(av, gtoset(z));
    2355             : }

Generated by: LCOV version 1.16