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 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 - polarit1.c (source / functions) Hit Total Coverage
Test: PARI/GP v2.8.0 lcov report (development 19214-1621e44) Lines: 319 334 95.5 %
Date: 2016-07-26 07:10:39 Functions: 31 31 100.0 %
Legend: Lines: hit not hit

          Line data    Source code
       1             : /* Copyright (C) 2000-2004  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. It is distributed in the hope that it will be useful, but WITHOUT
       8             : ANY WARRANTY WHATSOEVER.
       9             : 
      10             : Check the License for details. You should have received a copy of it, along
      11             : with the package; see the file 'COPYING'. If not, write to the Free Software
      12             : Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
      13             : 
      14             : /***********************************************************************/
      15             : /**                                                                   **/
      16             : /**               ARITHMETIC OPERATIONS ON POLYNOMIALS                **/
      17             : /**                         (first part)                              **/
      18             : /**                                                                   **/
      19             : /***********************************************************************/
      20             : #include "pari.h"
      21             : #include "paripriv.h"
      22             : /*******************************************************************/
      23             : /*                                                                 */
      24             : /*                  POLYNOMIAL EUCLIDEAN DIVISION                  */
      25             : /*                                                                 */
      26             : /*******************************************************************/
      27             : /* x t_POLMOD, y t_POL in the same variable as x[1], return x % y */
      28             : static GEN
      29         112 : polmod_mod(GEN x, GEN y)
      30             : {
      31         112 :   GEN z, a, T = gel(x,1);
      32         112 :   if (RgX_equal(T, y)) return gcopy(x);
      33          14 :   z = cgetg(3,t_POLMOD); T = RgX_gcd(T,y); a = gel(x,2);
      34          14 :   gel(z,1) = T;
      35          14 :   gel(z,2) = (typ(a)==t_POL && varn(a)==varn(T))? RgX_rem(a, T): gcopy(a);
      36          14 :   return z;
      37             : }
      38             : /* x,y two "scalars", return 0 with type info */
      39             : static GEN
      40           7 : rem_scal_scal(GEN x, GEN y)
      41             : {
      42           7 :   pari_sp av = avma;
      43           7 :   GEN z = gadd(gmul(gen_0,x), gmul(gen_0,y));
      44           7 :   if (gequal0(y)) pari_err_INV("grem",y);
      45           7 :   return gerepileupto(av, simplify(z));
      46             : }
      47             : /* x pol, y "scalar", return 0 with type info */
      48             : static GEN
      49         112 : rem_pol_scal(GEN x, GEN y)
      50             : {
      51         112 :   pari_sp av = avma;
      52         112 :   if (gequal0(y)) pari_err_INV("grem",y);
      53         112 :   return gerepileupto(av, simplify(gmul(RgX_get_0(x),y)));
      54             : }
      55             : /* x "scalar", y pol, return x % y with type info */
      56             : static GEN
      57      201708 : rem_scal_pol(GEN x, GEN y)
      58             : {
      59      201708 :   if (degpol(y))
      60             :   {
      61      201708 :     if (!signe(y)) pari_err_INV("grem",y);
      62      201708 :     return gmul(x, RgX_get_1(y));
      63             :   }
      64           0 :   y = gel(y,2); return rem_scal_scal(x,y);
      65             : }
      66             : GEN
      67         245 : poldivrem(GEN x, GEN y, GEN *pr)
      68             : {
      69         245 :   const char *f = "euclidean division";
      70         245 :   long tx = typ(x), ty = typ(y), vx = gvar(x), vy = gvar(y);
      71             :   GEN z;
      72             : 
      73         245 :   if (!is_extscalar_t(tx) || !is_extscalar_t(ty)) pari_err_TYPE2(f,x,y);
      74         245 :   if (vx == vy && ((tx==t_POLMOD) ^ (ty==t_POLMOD))) pari_err_TYPE2(f,x,y);
      75         231 :   if (ty != t_POL || varncmp(vx, vy) < 0) /* y "scalar" */
      76             :   {
      77          63 :     if (!pr || pr == ONLY_DIVIDES) return gdiv(x,y);
      78          63 :     if (tx != t_POL || varncmp(vy, vx) < 0) /* x "scalar" */
      79           0 :       z = rem_scal_scal(x,y);
      80             :     else
      81          63 :       z = rem_pol_scal(x,y);
      82          63 :     if (pr == ONLY_REM) return z;
      83          63 :     *pr = z; return gdiv(x,y);
      84             :   }
      85         168 :   if (tx != t_POL || varncmp(vx, vy) > 0) /* x "scalar" */
      86             :   {
      87          91 :     if (!degpol(y)) /* constant t_POL, treat as scalar */
      88             :     {
      89           7 :       y = gel(y,2);
      90           7 :       if (!pr || pr == ONLY_DIVIDES) gdiv(x,y);
      91           7 :       z = rem_scal_scal(x,y);
      92           7 :       if (pr == ONLY_REM) return z;
      93           7 :       *pr = z; return gdiv(x,y);
      94             :     }
      95          84 :     if (!signe(y)) pari_err_INV("poldivrem",y);
      96          84 :     if (!pr || pr == ONLY_DIVIDES) return gequal0(x)? RgX_get_0(y): NULL;
      97          84 :     z = gmul(x, RgX_get_1(y));
      98          84 :     if (pr == ONLY_REM) return z;
      99          84 :     *pr = z; return RgX_get_0(y);
     100             :   }
     101          77 :   return RgX_divrem(x,y,pr);
     102             : }
     103             : GEN
     104         490 : gdeuc(GEN x, GEN y)
     105             : {
     106         490 :   const char *f = "euclidean division";
     107         490 :   long tx = typ(x), ty = typ(y), vx = gvar(x), vy = gvar(y);
     108         490 :   if (!is_extscalar_t(tx) || !is_extscalar_t(ty)) pari_err_TYPE2(f,x,y);
     109         476 :   if (vx == vy && ((tx==t_POLMOD) ^ (ty==t_POLMOD))) pari_err_TYPE2(f,x,y);
     110         448 :   if (ty != t_POL || varncmp(vx, vy) < 0) return gdiv(x,y); /* y "scalar" */
     111         329 :   if (tx != t_POL || varncmp(vx, vy) > 0)
     112             :   { /* x "scalar" */
     113         133 :     if (!signe(y)) pari_err_INV("gdeuc",y);
     114         133 :     if (!degpol(y)) return gdiv(x, gel(y,2)); /* constant */
     115         133 :     return RgX_get_0(y);
     116             :   }
     117         196 :   return RgX_div(x,y);
     118             : }
     119             : GEN
     120     1508553 : grem(GEN x, GEN y)
     121             : {
     122     1508553 :   const char *f = "euclidean division";
     123     1508553 :   long tx = typ(x), ty = typ(y), vx = gvar(x), vy = gvar(y);
     124             : 
     125     1508506 :   if (ty == t_POL)
     126             :   {
     127     1508464 :     if (varncmp(vx,vy) >= 0)
     128             :     {
     129             :       pari_sp av;
     130             :       GEN z;
     131     1508435 :       if (!signe(y)) pari_err_INV("grem",y);
     132     1508489 :       if (vx != vy) return rem_scal_pol(x,y);
     133     1306781 :       switch(tx)
     134             :       {
     135         112 :         case t_POLMOD: return polmod_mod(x,y);
     136     1305849 :         case t_POL: return RgX_rem(x,y);
     137             :         case t_RFRAC:
     138         756 :           av = avma; z = gmul(gel(x,1), RgXQ_inv(gel(x,2),y));
     139         756 :           return gerepileupto(av, grem(z,y));
     140             :         case t_SER:
     141          49 :           if (RgX_is_monomial(y))
     142             :           {
     143          28 :             if (lg(x)-2 + valp(x) < degpol(y)) pari_err_OP("%",x,y);
     144          21 :             av = avma;
     145          21 :             return gerepileupto(av, gmod(ser2rfrac_i(x), y));
     146             :           }
     147          36 :         default: pari_err_TYPE2("%",x,y);
     148             :       }
     149             :     }
     150           0 :     else switch(tx)
     151             :     {
     152             :       case t_POL:
     153           0 :       case t_RFRAC: return rem_pol_scal(x,y);
     154           0 :       default: pari_err_TYPE2("%",x,y);
     155             :     }
     156             :   }
     157          48 :   if (!is_extscalar_t(tx) || !is_extscalar_t(ty)) pari_err_TYPE2(f,x,y);
     158          56 :   if (vx == vy && ty==t_POLMOD) pari_err_TYPE2(f,x,y);
     159          49 :   if (tx != t_POL || varncmp(vx,vy) > 0)
     160             :   { /* x a "scalar" */
     161           0 :     if (ty != t_POL || varncmp(vx, vy) < 0) return rem_scal_scal(x,y);
     162           0 :     return rem_scal_pol(x,y);
     163             :   }
     164          49 :   if (ty != t_POL || varncmp(vx, vy) < 0) /* y a "scalar" */
     165          49 :     return rem_pol_scal(x,y);
     166           0 :   return RgX_rem(x,y);
     167             : }
     168             : 
     169             : /*******************************************************************/
     170             : /*                                                                 */
     171             : /*                  CONVERSIONS RELATED TO p-ADICS                 */
     172             : /*                                                                 */
     173             : /*******************************************************************/
     174             : /* x t_PADIC, p a prime or NULL (unset). Consistency check */
     175             : static void
     176         196 : check_padic_p(GEN x, GEN p)
     177             : {
     178         196 :   GEN q = gel(x,2);
     179         196 :   if (p && !equalii(p, q)) pari_err_MODULUS("Zp_to_Z", p,q);
     180         175 : }
     181             : /* shallow */
     182             : static GEN
     183        1694 : Zp_to_Z(GEN x, GEN p) {
     184        1694 :   switch(typ(x))
     185             :   {
     186        1582 :     case t_INT: break;
     187             :     case t_PADIC:
     188         112 :       check_padic_p(x, p);
     189          91 :       x = gtrunc(x); break;
     190           0 :     default: pari_err_TYPE("Zp_to_Z",x);
     191             :   }
     192        1673 :   return x;
     193             : }
     194             : /* shallow */
     195             : static GEN
     196         294 : ZpX_to_ZX(GEN f, GEN p) {
     197         294 :   long i, l = lg(f);
     198         294 :   GEN F = cgetg_copy(f, &l); F[1] = f[1];
     199         294 :   for (i=2; i<l; i++) gel(F,i) = Zp_to_Z(gel(f,i), p);
     200         280 :   return F;
     201             : }
     202             : 
     203             : static GEN
     204         280 : get_padic_content(GEN f, GEN p)
     205             : {
     206         280 :   GEN c = content(f);
     207         280 :   if (gequal0(c)) /*  O(p^n) can occur */
     208             :   {
     209           0 :     if (typ(c) != t_PADIC) pari_err_TYPE("QpX_to_ZX",f);
     210           0 :     check_padic_p(c, p);
     211           0 :     c = powis(p, valp(c));
     212             :   }
     213         280 :   return c;
     214             : }
     215             : /* make f suitable for [root|factor]padic. Shallow */
     216             : static GEN
     217         245 : QpX_to_ZX(GEN f, GEN p)
     218             : {
     219         245 :   GEN c = get_padic_content(f, p);
     220         245 :   f = RgX_Rg_div(f, c);
     221         245 :   return ZpX_to_ZX(f, p);
     222             : }
     223             : 
     224             : /* x in Z return x + O(pr), pr = p^r. Shallow */
     225             : static GEN
     226        1316 : Z_to_Zp(GEN x, GEN p, GEN pr, long r)
     227             : {
     228             :   GEN y;
     229        1316 :   long v, sx = signe(x);
     230             : 
     231        1316 :   if (!sx) return zeropadic_shallow(p,r);
     232        1022 :   v = Z_pvalrem(x,p,&x);
     233        1022 :   if (v) {
     234         301 :     if (r <= v) return zeropadic_shallow(p,r);
     235         266 :     r -= v;
     236         266 :     pr = powiu(p,r);
     237             :   }
     238         987 :   y = cgetg(5,t_PADIC);
     239         987 :   y[1] = evalprecp(r)|evalvalp(v);
     240         987 :   gel(y,2) = p;
     241         987 :   gel(y,3) = pr;
     242         987 :   gel(y,4) = modii(x,pr); return y;
     243             : }
     244             : /* shallow */
     245             : static GEN
     246          42 : ZV_to_ZpV(GEN z, GEN p, long r)
     247             : {
     248          42 :   long i, l = lg(z);
     249          42 :   GEN Z = cgetg(l, typ(z)), q = powiu(p, r);
     250          42 :   for (i=1; i<lg(z); i++) gel(Z,i) = Z_to_Zp(gel(z,i),p,q,r);
     251          42 :   return Z;
     252             : }
     253             : /* shallow */
     254             : static GEN
     255         343 : ZX_to_ZpX(GEN z, GEN p, GEN q, long r)
     256             : {
     257         343 :   long i, l = lg(z);
     258         343 :   GEN Z = cgetg(l, t_POL); Z[1] = z[1];
     259         343 :   for (i=2; i<lg(z); i++) gel(Z,i) = Z_to_Zp(gel(z,i),p,q,r);
     260         343 :   return Z;
     261             : }
     262             : /* return (x + O(p^r)) normalized (multiply by a unit such that leading coeff
     263             :  * is a power of p), x in Z[X] (or Z_p[X]). Shallow */
     264             : static GEN
     265         350 : ZX_to_ZpX_normalized(GEN x, GEN p, GEN pr, long r)
     266             : {
     267         350 :   long i, lx = lg(x);
     268         350 :   GEN z, lead = leading_coeff(x);
     269             : 
     270         350 :   if (gequal1(lead)) return ZX_to_ZpX(x, p, pr, r);
     271          28 :   (void)Z_pvalrem(lead, p, &lead); lead = Fp_inv(lead, pr);
     272          28 :   z = cgetg(lx,t_POL);
     273          28 :   for (i=2; i < lx; i++) gel(z,i) = Z_to_Zp(mulii(lead,gel(x,i)),p,pr,r);
     274          28 :   z[1] = x[1]; return z;
     275             : }
     276             : static GEN
     277          21 : ZXV_to_ZpXQV(GEN z, GEN T, GEN p, long r)
     278             : {
     279          21 :   long i, l = lg(z);
     280          21 :   GEN Z = cgetg(l, typ(z)), q = powiu(p, r);
     281          21 :   T = ZX_copy(T);
     282          21 :   for (i=1; i<lg(z); i++) gel(Z,i) = mkpolmod(ZX_to_ZpX(gel(z,i),p,q,r),T);
     283          21 :   return Z;
     284             : }
     285             : /* shallow */
     286             : static GEN
     287          35 : QpXQX_to_ZXY(GEN f, GEN p)
     288             : {
     289          35 :   GEN c = get_padic_content(f, p);
     290          35 :   long i, l = lg(f);
     291          35 :   f = RgX_Rg_div(f,c);
     292         168 :   for (i=2; i<l; i++)
     293             :   {
     294         140 :     GEN t = gel(f,i);
     295         140 :     switch(typ(t))
     296             :     {
     297             :       case t_POLMOD:
     298          21 :         t = gel(t,2);
     299          21 :         t = (typ(t) == t_POL)? ZpX_to_ZX(t, p): Zp_to_Z(t, p);
     300          21 :         break;
     301           0 :       case t_POL: t = ZpX_to_ZX(t, p); break;
     302         119 :       default: t = Zp_to_Z(t, p); break;
     303             :     }
     304         133 :     gel(f,i) = t;
     305             :   }
     306          28 :   return f;
     307             : }
     308             : 
     309             : /*******************************************************************/
     310             : /*                                                                 */
     311             : /*                         p-ADIC ROOTS                            */
     312             : /*                                                                 */
     313             : /*******************************************************************/
     314             : 
     315             : /* f primitive ZX, squarefree, leading term prime to p; a in Z such that
     316             :  * f(a) = 0 mod p. Return p-adic roots of f equal to a mod p, in
     317             :  * precision >= prec */
     318             : GEN
     319         336 : ZX_Zp_root(GEN f, GEN a, GEN p, long prec)
     320             : {
     321         336 :   GEN z, R, a0 = modii(a, p);
     322             :   long i, j, k;
     323             : 
     324         336 :   if (signe(FpX_eval(FpX_deriv(f, p), a0, p)))
     325             :   { /* simple zero mod p, go all the way to p^prec */
     326         189 :     if (prec > 1) a0 = ZpX_liftroot(f, a0, p, prec);
     327         189 :     return mkcol(a0);
     328             :   }
     329             : 
     330         147 :   f = ZX_unscale_div(RgX_translate(f,a), p); /* f(pX + a) / p */
     331         147 :   (void)ZX_pvalrem(f,p,&f);
     332         147 :   z = cgetg(degpol(f)+1,t_COL);
     333             : 
     334         147 :   R = FpX_roots(f, p);
     335         350 :   for (j=i=1; i<lg(R); i++)
     336             :   {
     337         203 :     GEN u = ZX_Zp_root(f, gel(R,i), p, prec-1);
     338         203 :     for (k=1; k<lg(u); k++) gel(z,j++) = addii(a, mulii(p, gel(u,k)));
     339             :   }
     340         147 :   setlg(z,j); return z;
     341             : }
     342             : 
     343             : /* a t_PADIC, return vector of p-adic roots of f equal to a (mod p) */
     344             : GEN
     345          42 : Zp_appr(GEN f, GEN a)
     346             : {
     347          42 :   pari_sp av = avma;
     348          42 :   GEN z, p = gel(a,2);
     349          42 :   long prec = gequal0(a)? valp(a): precp(a);
     350             : 
     351          42 :   f = QpX_to_ZX(f, p);
     352          28 :   if (degpol(f) <= 0) pari_err_CONSTPOL("Zp_appr");
     353          28 :   (void)ZX_gcd_all(f, ZX_deriv(f), &f);
     354          28 :   a = padic_to_Q(a);
     355          28 :   if (signe(FpX_eval(f,a,p))) { avma = av; return cgetg(1,t_COL); }
     356          21 :   z = ZX_Zp_root(f, a, p, prec);
     357          21 :   return gerepilecopy(av, ZV_to_ZpV(z, p, prec));
     358             : }
     359             : /* vector of p-adic roots of the ZX f, leading term prime to p. Shallow */
     360             : static GEN
     361          21 : ZX_Zp_roots(GEN f, GEN p, long prec)
     362             : {
     363             :   GEN y, z, rac;
     364             :   long lx, i, j, k;
     365             : 
     366          21 :   (void)ZX_gcd_all(f, ZX_deriv(f), &f);
     367          21 :   rac = FpX_roots(f, p);
     368          21 :   lx = lg(rac); if (lx == 1) return rac;
     369          21 :   y = cgetg(degpol(f)+1,t_COL);
     370          77 :   for (j=i=1; i<lx; i++)
     371             :   {
     372          56 :     z = ZX_Zp_root(f, gel(rac,i), p, prec);
     373          56 :     for (k=1; k<lg(z); k++,j++) gel(y,j) = gel(z,k);
     374             :   }
     375          21 :   setlg(y,j); return ZV_to_ZpV(y, p, prec);
     376             : }
     377             : 
     378             : /* f a ZX */
     379             : static GEN
     380         175 : pnormalize(GEN f, GEN p, long prec, long n, GEN *plead, long *pprec, int *prev)
     381             : {
     382         175 :   *plead = leading_coeff(f);
     383         175 :   *pprec = prec;
     384         175 :   *prev = 0;
     385         175 :   if (!is_pm1(*plead))
     386             :   {
     387          21 :     long v = Z_pval(*plead,p), v1 = Z_pval(constant_coeff(f),p);
     388          21 :     if (v1 < v)
     389             :     {
     390          21 :       *prev = 1; f = RgX_recip_shallow(f);
     391             :      /* beware loss of precision from lc(factor), whose valuation is <= v */
     392          21 :       *pprec += v; v = v1;
     393             :     }
     394          21 :     *pprec += v * n;
     395             :   }
     396         175 :   return ZX_Q_normalize(f, plead);
     397             : }
     398             : 
     399             : /* return p-adic roots of f, precision prec */
     400             : GEN
     401          28 : rootpadic(GEN f, GEN p, long prec)
     402             : {
     403          28 :   pari_sp av = avma;
     404             :   GEN lead,y;
     405             :   long PREC,i,k;
     406             :   int reverse;
     407             : 
     408          28 :   if (typ(p)!=t_INT) pari_err_TYPE("rootpadic",p);
     409          28 :   if (typ(f)!=t_POL) pari_err_TYPE("rootpadic",f);
     410          28 :   if (gequal0(f)) pari_err_ROOTS0("rootpadic");
     411          28 :   if (prec <= 0)
     412           7 :     pari_err_DOMAIN("rootpadic", "precision", "<=",gen_0,stoi(prec));
     413          21 :   f = QpX_to_ZX(f, p);
     414          21 :   f = pnormalize(f, p, prec, 1, &lead, &PREC, &reverse);
     415          21 :   y = ZX_Zp_roots(f,p,PREC);
     416          21 :   k = lg(y);
     417          21 :   if (lead != gen_1)
     418          21 :     for (i=1; i<k; i++) gel(y,i) = gdiv(gel(y,i), lead);
     419          21 :   if (reverse)
     420           0 :     for (i=1; i<k; i++) gel(y,i) = ginv(gel(y,i));
     421          21 :   return gerepilecopy(av, y);
     422             : }
     423             : 
     424             : /**************************************************************************/
     425             : 
     426             : static void
     427         189 : scalar_getprec(GEN x, long *pprec, GEN *pp)
     428             : {
     429         189 :   if (typ(x)==t_PADIC)
     430             :   {
     431          84 :     long e = valp(x); if (signe(gel(x,4))) e += precp(x);
     432          84 :     if (e < *pprec) *pprec = e;
     433          84 :     check_padic_p(x, *pp);
     434          84 :     *pp = gel(x,2);
     435             :   }
     436         189 : }
     437             : static void
     438          70 : getprec(GEN x, long *pprec, GEN *pp)
     439             : {
     440             :   long i;
     441          70 :   if (typ(x) != t_POL) scalar_getprec(x, pprec, pp);
     442             :   else
     443          49 :     for (i = lg(x)-1; i>1; i--) scalar_getprec(gel(x,i), pprec, pp);
     444          70 : }
     445             : 
     446             : /* assume f(a) = 0 (mod T,p) */
     447             : static GEN
     448          35 : ZXY_ZpQ_root(GEN f, GEN a, GEN T, GEN p, long prec)
     449             : {
     450             :   GEN z, R;
     451             :   long i, j, k, lR;
     452          35 :   if (signe(FqX_eval(FqX_deriv(f,T,p), a, T,p)))
     453             :   { /* simple zero mod (T,p), go all the way to p^prec */
     454          21 :     if (prec > 1) a = ZpXQX_liftroot(f, a, T, p, prec);
     455          21 :     return mkcol(a);
     456             :   }
     457          14 :   f = RgX_unscale(RgXQX_translate(f, a, T), p);
     458          14 :   f = RgX_Rg_div(f, powiu(p, gvaluation(f,p)));
     459          14 :   z = cgetg(degpol(f)+1,t_COL);
     460          14 :   R = FpXQX_roots(FqX_red(f,T,p), T, p); lR = lg(R);
     461          28 :   for(j=i=1; i<lR; i++)
     462             :   {
     463          14 :     GEN u = ZXY_ZpQ_root(f, gel(R,i), T, p, prec-1);
     464          14 :     for (k=1; k<lg(u); k++) gel(z,j++) = gadd(a, gmul(p, gel(u,k)));
     465             :   }
     466          14 :   setlg(z,j); return z;
     467             : }
     468             : 
     469             : /* a belongs to finite extension of Q_p, return all roots of f equal to a
     470             :  * mod p. Don't assume f(a) = 0 (mod p) */
     471             : GEN
     472          77 : padicappr(GEN f, GEN a)
     473             : {
     474             :   GEN p, z, T;
     475             :   long prec;
     476          77 :   pari_sp av = avma;
     477             : 
     478          77 :   if (typ(f)!=t_POL) pari_err_TYPE("padicappr",f);
     479          77 :   switch(typ(a)) {
     480          42 :     case t_PADIC: return Zp_appr(f,a);
     481          35 :     case t_POLMOD: break;
     482           0 :     default: pari_err_TYPE("padicappr",a);
     483             :   }
     484          35 :   if (gequal0(f)) pari_err_ROOTS0("padicappr");
     485          35 :   z = RgX_gcd(f, RgX_deriv(f));
     486          35 :   if (degpol(z) > 0) f = RgX_div(f,z);
     487          35 :   T = gel(a,1);
     488          35 :   a = gel(a,2);
     489          35 :   p = NULL; prec = LONG_MAX;
     490          35 :   getprec(a, &prec, &p);
     491          35 :   getprec(T, &prec, &p); if (!p) pari_err_TYPE("padicappr",T);
     492          35 :   f = QpXQX_to_ZXY(f, p);
     493          28 :   if (typ(a) != t_POL) a = scalarpol_shallow(a, varn(T));
     494          28 :   a = ZpX_to_ZX(a,p);
     495          28 :   T = QpX_to_ZX(T,p);
     496          28 :   if (!gequal0(FqX_eval(FqX_red(f,T,p), a, T,p))) /* check f(a) = 0 (mod p,T) */
     497           7 :   { avma = av; return cgetg(1,t_COL); }
     498          21 :   z = ZXY_ZpQ_root(f, a, T, p, prec);
     499          21 :   return gerepilecopy(av, ZXV_to_ZpXQV(z, T, p, prec));
     500             : }
     501             : 
     502             : /*******************************************************************/
     503             : /*                                                                 */
     504             : /*             FACTORIZATION in Zp[X], using ROUND4                */
     505             : /*                                                                 */
     506             : /*******************************************************************/
     507             : 
     508             : int
     509         175 : cmp_padic(GEN x, GEN y)
     510             : {
     511             :   long vx, vy;
     512         175 :   if (x == gen_0) return -1;
     513         175 :   if (y == gen_0) return  1;
     514         175 :   vx = valp(x);
     515         175 :   vy = valp(y);
     516         175 :   if (vx < vy) return  1;
     517         175 :   if (vx > vy) return -1;
     518         126 :   return cmpii(gel(x,4), gel(y,4));
     519             : }
     520             : 
     521             : static int
     522         469 : expo_is_squarefree(GEN e)
     523             : {
     524         469 :   long i, l = lg(e);
     525         539 :   for (i=1; i<l; i++)
     526         483 :     if (e[i] != 1) return 0;
     527          56 :   return 1;
     528             : }
     529             : 
     530             : /* assume f a ZX with leading_coeff 1, degree > 0 */
     531             : GEN
     532         476 : ZX_monic_factorpadic(GEN f, GEN p, long prec)
     533             : {
     534             :   GEN w, poly, p1, p2, ex, P, E;
     535         476 :   long n=degpol(f), i, k, j;
     536             : 
     537         476 :   if (n==1) return mkmat2(mkcol(f), mkcol(gen_1));
     538             : 
     539         448 :   poly = ZX_squff(f,&ex);
     540         448 :   P = cgetg(n+1,t_COL);
     541         448 :   E = cgetg(n+1,t_COL); n = lg(poly);
     542         917 :   for (j=i=1; i<n; i++)
     543             :   {
     544         469 :     pari_sp av1 = avma;
     545         469 :     GEN fx = gel(poly,i), fa = FpX_factor(fx,p);
     546         469 :     w = gel(fa,1);
     547         469 :     if (expo_is_squarefree(gel(fa,2)))
     548             :     { /* no repeated factors: Hensel lift */
     549          56 :       p1 = ZpX_liftfact(fx, w, NULL, p, prec, powiu(p,prec));
     550          56 :       p2 = utoipos(ex[i]);
     551         126 :       for (k=1; k<lg(p1); k++,j++)
     552             :       {
     553          70 :         gel(P,j) = gel(p1,k);
     554          70 :         gel(E,j) = p2;
     555             :       }
     556          56 :       continue;
     557             :     }
     558             :     /* use Round 4 */
     559         413 :     p2 = maxord_i(p, fx, ZpX_disc_val(fx,p), w, prec);
     560         413 :     if (p2)
     561             :     {
     562         161 :       p2 = gerepilecopy(av1,p2);
     563         161 :       p1 = gel(p2,1);
     564         161 :       p2 = gel(p2,2);
     565         518 :       for (k=1; k<lg(p1); k++,j++)
     566             :       {
     567         357 :         gel(P,j) = gel(p1,k);
     568         357 :         gel(E,j) = muliu(gel(p2,k),ex[i]);
     569             :       }
     570             :     }
     571             :     else
     572             :     {
     573         252 :       avma = av1;
     574         252 :       gel(P,j) = fx;
     575         252 :       gel(E,j) = utoipos(ex[i]); j++;
     576             :     }
     577             :   }
     578         448 :   setlg(P,j);
     579         448 :   setlg(E,j); return mkmat2(P, E);
     580             : }
     581             : 
     582             : GEN
     583         161 : factorpadic(GEN f,GEN p,long r)
     584             : {
     585         161 :   pari_sp av = avma;
     586             :   GEN y, P, ppow, lead, lt;
     587         161 :   long i, l, pr, n = degpol(f);
     588         161 :   int reverse = 0;
     589             : 
     590         161 :   if (typ(f)!=t_POL) pari_err_TYPE("factorpadic",f);
     591         161 :   if (typ(p)!=t_INT) pari_err_TYPE("factorpadic",p);
     592         161 :   if (r <= 0) pari_err_DOMAIN("factorpadic", "precision", "<=",gen_0,stoi(r));
     593         154 :   if (!signe(f)) return prime_fact(f);
     594         154 :   if (n == 0) return trivial_fact();
     595             : 
     596         154 :   f = QpX_to_ZX(f, p); (void)Z_pvalrem(leading_coeff(f), p, &lt);
     597         154 :   f = pnormalize(f, p, r, n-1, &lead, &pr, &reverse);
     598         154 :   y = ZX_monic_factorpadic(f, p, pr);
     599         154 :   P = gel(y,1); l = lg(P);
     600         154 :   if (lead != gen_1)
     601         154 :     for (i=1; i<l; i++) gel(P,i) = Q_primpart( RgX_unscale(gel(P,i), lead) );
     602         154 :   ppow = powiu(p,r);
     603         504 :   for (i=1; i<l; i++)
     604             :   {
     605         350 :     GEN t = gel(P,i);
     606         350 :     if (reverse) t = normalizepol(RgX_recip_shallow(t));
     607         350 :     gel(P,i) = ZX_to_ZpX_normalized(t,p,ppow,r);
     608             :   }
     609         154 :   if (!gequal1(lt)) gel(P,1) = gmul(gel(P,1), lt);
     610         154 :   return gerepilecopy(av, sort_factor_pol(y, cmp_padic));
     611             : }

Generated by: LCOV version 1.11