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.10.0 lcov report (development 19844-48249ea) Lines: 292 306 95.4 %
Date: 2016-12-11 05:49:03 Functions: 29 29 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         546 : polmod_mod(GEN x, GEN y)
      30             : {
      31         546 :   GEN z, a, T = gel(x,1);
      32         546 :   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       83772 : rem_scal_pol(GEN x, GEN y)
      58             : {
      59       83772 :   if (degpol(y))
      60             :   {
      61       83772 :     if (!signe(y)) pari_err_INV("grem",y);
      62       83772 :     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     1100715 : grem(GEN x, GEN y)
     121             : {
     122     1100715 :   const char *f = "euclidean division";
     123     1100715 :   long tx = typ(x), ty = typ(y), vx = gvar(x), vy = gvar(y);
     124             : 
     125     1100634 :   if (ty == t_POL)
     126             :   {
     127     1100576 :     if (varncmp(vx,vy) >= 0)
     128             :     {
     129             :       pari_sp av;
     130             :       GEN z;
     131     1100602 :       if (!signe(y)) pari_err_INV("grem",y);
     132     1100605 :       if (vx != vy) return rem_scal_pol(x,y);
     133     1016833 :       switch(tx)
     134             :       {
     135         546 :         case t_POLMOD: return polmod_mod(x,y);
     136     1015492 :         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          18 :         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          58 :   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        3318 : Zp_to_Z(GEN x, GEN p) {
     184        3318 :   switch(typ(x))
     185             :   {
     186        3206 :     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        3297 :   return x;
     193             : }
     194             : /* shallow */
     195             : static GEN
     196         574 : ZpX_to_ZX(GEN f, GEN p) {
     197         574 :   long i, l = lg(f);
     198         574 :   GEN F = cgetg_copy(f, &l); F[1] = f[1];
     199         574 :   for (i=2; i<l; i++) gel(F,i) = Zp_to_Z(gel(f,i), p);
     200         560 :   return F;
     201             : }
     202             : 
     203             : static GEN
     204         560 : get_padic_content(GEN f, GEN p)
     205             : {
     206         560 :   GEN c = content(f);
     207         560 :   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         560 :   return c;
     214             : }
     215             : /* make f suitable for [root|factor]padic. Shallow */
     216             : static GEN
     217         525 : QpX_to_ZX(GEN f, GEN p)
     218             : {
     219         525 :   GEN c = get_padic_content(f, p);
     220         525 :   f = RgX_Rg_div(f, c);
     221         525 :   return ZpX_to_ZX(f, p);
     222             : }
     223             : 
     224             : /* x in Z return x + O(pr), pr = p^r. Shallow */
     225             : static GEN
     226        3255 : Z_to_Zp(GEN x, GEN p, GEN pr, long r)
     227             : {
     228             :   GEN y;
     229        3255 :   long v, sx = signe(x);
     230             : 
     231        3255 :   if (!sx) return zeropadic_shallow(p,r);
     232        2793 :   v = Z_pvalrem(x,p,&x);
     233        2793 :   if (v) {
     234         665 :     if (r <= v) return zeropadic_shallow(p,r);
     235         630 :     r -= v;
     236         630 :     pr = powiu(p,r);
     237             :   }
     238        2758 :   y = cgetg(5,t_PADIC);
     239        2758 :   y[1] = evalprecp(r)|evalvalp(v);
     240        2758 :   gel(y,2) = p;
     241        2758 :   gel(y,3) = pr;
     242        2758 :   gel(y,4) = modii(x,pr); return y;
     243             : }
     244             : /* shallow */
     245             : static GEN
     246          49 : ZV_to_ZpV(GEN z, GEN p, long r)
     247             : {
     248          49 :   long i, l = lg(z);
     249          49 :   GEN Z = cgetg(l, typ(z)), q = powiu(p, r);
     250          49 :   for (i=1; i<lg(z); i++) gel(Z,i) = Z_to_Zp(gel(z,i),p,q,r);
     251          49 :   return Z;
     252             : }
     253             : /* shallow */
     254             : static GEN
     255         938 : ZX_to_ZpX(GEN z, GEN p, GEN q, long r)
     256             : {
     257         938 :   long i, l = lg(z);
     258         938 :   GEN Z = cgetg(l, t_POL); Z[1] = z[1];
     259         938 :   for (i=2; i<lg(z); i++) gel(Z,i) = Z_to_Zp(gel(z,i),p,q,r);
     260         938 :   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         924 : ZX_to_ZpX_normalized(GEN x, GEN p, GEN pr, long r)
     266             : {
     267         924 :   long i, lx = lg(x);
     268         924 :   GEN z, lead = leading_coeff(x);
     269             : 
     270         924 :   if (gequal1(lead)) return ZX_to_ZpX(x, p, pr, r);
     271          35 :   (void)Z_pvalrem(lead, p, &lead); lead = Fp_inv(lead, pr);
     272          35 :   z = cgetg(lx,t_POL);
     273          35 :   for (i=2; i < lx; i++) gel(z,i) = Z_to_Zp(mulii(lead,gel(x,i)),p,pr,r);
     274          35 :   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         364 : ZX_Zp_root(GEN f, GEN a, GEN p, long prec)
     320             : {
     321         364 :   GEN z, R, a0 = modii(a, p);
     322             :   long i, j, k;
     323             : 
     324         364 :   if (signe(FpX_eval(FpX_deriv(f, p), a0, p)))
     325             :   { /* simple zero mod p, go all the way to p^prec */
     326         203 :     if (prec > 1) a0 = ZpX_liftroot(f, a0, p, prec);
     327         203 :     return mkcol(a0);
     328             :   }
     329             : 
     330         161 :   f = ZX_unscale_div(RgX_translate(f,a), p); /* f(pX + a) / p */
     331         161 :   (void)ZX_pvalrem(f,p,&f);
     332         161 :   z = cgetg(degpol(f)+1,t_COL);
     333             : 
     334         161 :   R = FpX_roots(f, p);
     335         385 :   for (j=i=1; i<lg(R); i++)
     336             :   {
     337         224 :     GEN u = ZX_Zp_root(f, gel(R,i), p, prec-1);
     338         224 :     for (k=1; k<lg(u); k++) gel(z,j++) = addii(a, mulii(p, gel(u,k)));
     339             :   }
     340         161 :   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 :   f = ZX_radical(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          28 : ZX_Zp_roots(GEN f, GEN p, long prec)
     362             : {
     363             :   GEN y, z, rac;
     364             :   long lx, i, j, k;
     365             : 
     366          28 :   f = ZX_radical(f);
     367          28 :   rac = FpX_roots(f, p);
     368          28 :   lx = lg(rac); if (lx == 1) return rac;
     369          28 :   y = cgetg(degpol(f)+1,t_COL);
     370          91 :   for (j=i=1; i<lx; i++)
     371             :   {
     372          63 :     z = ZX_Zp_root(f, gel(rac,i), p, prec);
     373          63 :     for (k=1; k<lg(z); k++,j++) gel(y,j) = gel(z,k);
     374             :   }
     375          28 :   setlg(y,j); return ZV_to_ZpV(y, p, prec);
     376             : }
     377             : 
     378             : /* f a ZX, f(0) != 0 */
     379             : static GEN
     380         455 : pnormalize(GEN f, GEN p, long prec, long n, GEN *plead, long *pprec, int *prev)
     381             : {
     382         455 :   *plead = leading_coeff(f);
     383         455 :   *pprec = prec;
     384         455 :   *prev = 0;
     385         455 :   if (!is_pm1(*plead))
     386             :   {
     387          35 :     long v = Z_pval(*plead,p), v1 = Z_pval(constant_coeff(f),p);
     388          35 :     if (v1 < v)
     389             :     {
     390          35 :       *prev = 1;
     391          35 :       f = RgX_recip_shallow(f); /* f(0) != 0 so degree is the same */
     392             :      /* beware loss of precision from lc(factor), whose valuation is <= v */
     393          35 :       *pprec += v; v = v1;
     394             :     }
     395          35 :     *pprec += v * n;
     396             :   }
     397         455 :   return ZX_Q_normalize(f, plead);
     398             : }
     399             : 
     400             : /* return p-adic roots of f, precision prec */
     401             : GEN
     402          35 : rootpadic(GEN f, GEN p, long prec)
     403             : {
     404          35 :   pari_sp av = avma;
     405             :   GEN lead,y;
     406             :   long PREC, i, k, v;
     407             :   int reverse;
     408             : 
     409          35 :   if (typ(p)!=t_INT) pari_err_TYPE("rootpadic",p);
     410          35 :   if (typ(f)!=t_POL) pari_err_TYPE("rootpadic",f);
     411          35 :   if (gequal0(f)) pari_err_ROOTS0("rootpadic");
     412          35 :   if (prec <= 0)
     413           7 :     pari_err_DOMAIN("rootpadic", "precision", "<=",gen_0,stoi(prec));
     414          28 :   v = RgX_valrem(f, &f);
     415          28 :   f = QpX_to_ZX(f, p);
     416          28 :   f = pnormalize(f, p, prec, 1, &lead, &PREC, &reverse);
     417          28 :   y = ZX_Zp_roots(f,p,PREC);
     418          28 :   k = lg(y);
     419          28 :   if (lead != gen_1)
     420          28 :     for (i=1; i<k; i++) gel(y,i) = gdiv(gel(y,i), lead);
     421          28 :   if (reverse)
     422           7 :     for (i=1; i<k; i++) gel(y,i) = ginv(gel(y,i));
     423          28 :   if (v) y = shallowconcat(zeropadic_shallow(p, prec), y);
     424          28 :   return gerepilecopy(av, y);
     425             : }
     426             : 
     427             : /**************************************************************************/
     428             : 
     429             : static void
     430         189 : scalar_getprec(GEN x, long *pprec, GEN *pp)
     431             : {
     432         189 :   if (typ(x)==t_PADIC)
     433             :   {
     434          84 :     long e = valp(x); if (signe(gel(x,4))) e += precp(x);
     435          84 :     if (e < *pprec) *pprec = e;
     436          84 :     check_padic_p(x, *pp);
     437          84 :     *pp = gel(x,2);
     438             :   }
     439         189 : }
     440             : static void
     441          70 : getprec(GEN x, long *pprec, GEN *pp)
     442             : {
     443             :   long i;
     444          70 :   if (typ(x) != t_POL) scalar_getprec(x, pprec, pp);
     445             :   else
     446          49 :     for (i = lg(x)-1; i>1; i--) scalar_getprec(gel(x,i), pprec, pp);
     447          70 : }
     448             : 
     449             : /* assume f(a) = 0 (mod T,p) */
     450             : static GEN
     451          35 : ZXY_ZpQ_root(GEN f, GEN a, GEN T, GEN p, long prec)
     452             : {
     453             :   GEN z, R;
     454             :   long i, j, k, lR;
     455          35 :   if (signe(FqX_eval(FqX_deriv(f,T,p), a, T,p)))
     456             :   { /* simple zero mod (T,p), go all the way to p^prec */
     457          21 :     if (prec > 1) a = ZpXQX_liftroot(f, a, T, p, prec);
     458          21 :     return mkcol(a);
     459             :   }
     460          14 :   f = RgX_unscale(RgXQX_translate(f, a, T), p);
     461          14 :   f = RgX_Rg_div(f, powiu(p, gvaluation(f,p)));
     462          14 :   z = cgetg(degpol(f)+1,t_COL);
     463          14 :   R = FpXQX_roots(FqX_red(f,T,p), T, p); lR = lg(R);
     464          28 :   for(j=i=1; i<lR; i++)
     465             :   {
     466          14 :     GEN u = ZXY_ZpQ_root(f, gel(R,i), T, p, prec-1);
     467          14 :     for (k=1; k<lg(u); k++) gel(z,j++) = gadd(a, gmul(p, gel(u,k)));
     468             :   }
     469          14 :   setlg(z,j); return z;
     470             : }
     471             : 
     472             : /* a belongs to finite extension of Q_p, return all roots of f equal to a
     473             :  * mod p. Don't assume f(a) = 0 (mod p) */
     474             : GEN
     475          77 : padicappr(GEN f, GEN a)
     476             : {
     477             :   GEN p, z, T;
     478             :   long prec;
     479          77 :   pari_sp av = avma;
     480             : 
     481          77 :   if (typ(f)!=t_POL) pari_err_TYPE("padicappr",f);
     482          77 :   switch(typ(a)) {
     483          42 :     case t_PADIC: return Zp_appr(f,a);
     484          35 :     case t_POLMOD: break;
     485           0 :     default: pari_err_TYPE("padicappr",a);
     486             :   }
     487          35 :   if (gequal0(f)) pari_err_ROOTS0("padicappr");
     488          35 :   z = RgX_gcd(f, RgX_deriv(f));
     489          35 :   if (degpol(z) > 0) f = RgX_div(f,z);
     490          35 :   T = gel(a,1);
     491          35 :   a = gel(a,2);
     492          35 :   p = NULL; prec = LONG_MAX;
     493          35 :   getprec(a, &prec, &p);
     494          35 :   getprec(T, &prec, &p); if (!p) pari_err_TYPE("padicappr",T);
     495          35 :   f = QpXQX_to_ZXY(f, p);
     496          28 :   if (typ(a) != t_POL) a = scalarpol_shallow(a, varn(T));
     497          28 :   a = ZpX_to_ZX(a,p);
     498          28 :   T = QpX_to_ZX(T,p);
     499          28 :   if (!gequal0(FqX_eval(FqX_red(f,T,p), a, T,p))) /* check f(a) = 0 (mod p,T) */
     500           7 :   { avma = av; return cgetg(1,t_COL); }
     501          21 :   z = ZXY_ZpQ_root(f, a, T, p, prec);
     502          21 :   return gerepilecopy(av, ZXV_to_ZpXQV(z, T, p, prec));
     503             : }
     504             : 
     505             : /*******************************************************************/
     506             : /*                                                                 */
     507             : /*             FACTORIZATION in Zp[X], using ROUND4                */
     508             : /*                                                                 */
     509             : /*******************************************************************/
     510             : 
     511             : int
     512        1911 : cmp_padic(GEN x, GEN y)
     513             : {
     514             :   long vx, vy;
     515        1911 :   if (x == gen_0) return -1;
     516        1911 :   if (y == gen_0) return  1;
     517        1911 :   vx = valp(x);
     518        1911 :   vy = valp(y);
     519        1911 :   if (vx < vy) return  1;
     520        1883 :   if (vx > vy) return -1;
     521        1736 :   return cmpii(gel(x,4), gel(y,4));
     522             : }
     523             : 
     524             : GEN
     525         434 : factorpadic(GEN f,GEN p,long r)
     526             : {
     527         434 :   pari_sp av = avma;
     528             :   GEN y, P, ppow, lead, lt;
     529         434 :   long i, l, pr, v, n = degpol(f);
     530         434 :   int reverse = 0;
     531             : 
     532         434 :   if (typ(f)!=t_POL) pari_err_TYPE("factorpadic",f);
     533         434 :   if (typ(p)!=t_INT) pari_err_TYPE("factorpadic",p);
     534         434 :   if (r <= 0) pari_err_DOMAIN("factorpadic", "precision", "<=",gen_0,stoi(r));
     535         427 :   if (!signe(f)) return prime_fact(f);
     536         427 :   if (n == 0) return trivial_fact();
     537             : 
     538         427 :   v = RgX_valrem(f, &f);
     539         427 :   f = QpX_to_ZX(f, p); (void)Z_pvalrem(leading_coeff(f), p, &lt);
     540         427 :   f = pnormalize(f, p, r, n-1, &lead, &pr, &reverse);
     541         427 :   y = ZpX_monic_factor(f, p, pr);
     542         427 :   P = gel(y,1); l = lg(P);
     543         427 :   if (lead != gen_1)
     544         427 :     for (i=1; i<l; i++) gel(P,i) = Q_primpart( RgX_unscale(gel(P,i), lead) );
     545         427 :   ppow = powiu(p,r);
     546        1351 :   for (i=1; i<l; i++)
     547             :   {
     548         924 :     GEN t = gel(P,i);
     549         924 :     if (reverse) t = normalizepol(RgX_recip_shallow(t));
     550         924 :     gel(P,i) = ZX_to_ZpX_normalized(t,p,ppow,r);
     551             :   }
     552         427 :   if (!gequal1(lt)) gel(P,1) = gmul(gel(P,1), lt);
     553         427 :   if (v)
     554             :   {
     555          28 :     GEN X = ZX_to_ZpX(pol_x(varn(f)), p, ppow, r);
     556          28 :     y = famat_mulpow_shallow(y, X, utoipos(v));
     557             :   }
     558         427 :   return gerepilecopy(av, sort_factor_pol(y, cmp_padic));
     559             : }

Generated by: LCOV version 1.11