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 - polarit1.c (source / functions) Hit Total Coverage
Test: PARI/GP v2.12.1 lcov report (development 25406-bf255ab81b) Lines: 318 329 96.7 %
Date: 2020-06-04 05:59:24 Functions: 32 32 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       65289 : polmod_mod(GEN x, GEN y)
      30             : {
      31       65289 :   GEN z, a, T = gel(x,1);
      32       65289 :   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          14 : rem_scal_scal(GEN x, GEN y)
      41             : {
      42          14 :   pari_sp av = avma;
      43          14 :   GEN z = gadd(gmul(gen_0,x), gmul(gen_0,y));
      44          14 :   if (gequal0(y)) pari_err_INV("grem",y);
      45          14 :   return gerepileupto(av, simplify(z));
      46             : }
      47             : /* x pol, y "scalar", return 0 with type info */
      48             : static GEN
      49         140 : rem_pol_scal(GEN x, GEN y)
      50             : {
      51         140 :   pari_sp av = avma;
      52         140 :   if (gequal0(y)) pari_err_INV("grem",y);
      53         140 :   return gerepileupto(av, simplify(gmul(Rg_get_0(x),y)));
      54             : }
      55             : /* x "scalar", y pol, return x % y with type info */
      56             : static GEN
      57     2458279 : rem_scal_pol(GEN x, GEN y)
      58             : {
      59     2458279 :   if (degpol(y))
      60             :   {
      61     2458272 :     if (!signe(y)) pari_err_INV("grem",y);
      62     2458272 :     return gmul(x, Rg_get_1(y));
      63             :   }
      64           7 :   y = gel(y,2); return rem_scal_scal(x,y);
      65             : }
      66             : GEN
      67         273 : poldivrem(GEN x, GEN y, GEN *pr)
      68             : {
      69         273 :   const char *f = "euclidean division";
      70         273 :   long tx = typ(x), ty = typ(y), vx = gvar(x), vy = gvar(y);
      71             :   GEN z;
      72             : 
      73         273 :   if (!is_extscalar_t(tx) || !is_extscalar_t(ty)) pari_err_TYPE2(f,x,y);
      74         273 :   if (vx == vy && ((tx==t_POLMOD) ^ (ty==t_POLMOD))) pari_err_TYPE2(f,x,y);
      75         259 :   if (ty != t_POL || varncmp(vx, vy) < 0) /* y "scalar" */
      76             :   {
      77          70 :     if (!pr || pr == ONLY_DIVIDES) return gdiv(x,y);
      78          70 :     if (tx != t_POL || varncmp(vy, vx) < 0) /* x "scalar" */
      79           0 :       z = rem_scal_scal(x,y);
      80             :     else
      81          70 :       z = rem_pol_scal(x,y);
      82          70 :     if (pr == ONLY_REM) return z;
      83          70 :     *pr = z; return gdiv(x,y);
      84             :   }
      85         189 :   if (tx != t_POL || varncmp(vx, vy) > 0) /* x "scalar" */
      86             :   {
      87          84 :     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          77 :     if (!signe(y)) pari_err_INV("poldivrem",y);
      96          77 :     if (!pr || pr == ONLY_DIVIDES) return gequal0(x)? Rg_get_0(y): NULL;
      97          77 :     z = gmul(x, Rg_get_1(y));
      98          77 :     if (pr == ONLY_REM) return z;
      99          77 :     *pr = z; return Rg_get_0(y);
     100             :   }
     101         105 :   return RgX_divrem(x,y,pr);
     102             : }
     103             : GEN
     104         609 : gdeuc(GEN x, GEN y)
     105             : {
     106         609 :   const char *f = "euclidean division";
     107         609 :   long tx = typ(x), ty = typ(y), vx = gvar(x), vy = gvar(y);
     108         609 :   if (!is_extscalar_t(tx) || !is_extscalar_t(ty)) pari_err_TYPE2(f,x,y);
     109         595 :   if (vx == vy && ((tx==t_POLMOD) ^ (ty==t_POLMOD))) pari_err_TYPE2(f,x,y);
     110         567 :   if (ty != t_POL || varncmp(vx, vy) < 0) return gdiv(x,y); /* y "scalar" */
     111         434 :   if (tx != t_POL || varncmp(vx, vy) > 0)
     112             :   { /* x "scalar" */
     113         147 :     if (!signe(y)) pari_err_INV("gdeuc",y);
     114         147 :     if (!degpol(y)) return gdiv(x, gel(y,2)); /* constant */
     115         147 :     return Rg_get_0(y);
     116             :   }
     117         287 :   return RgX_div(x,y);
     118             : }
     119             : GEN
     120     6315066 : grem(GEN x, GEN y)
     121             : {
     122     6315066 :   const char *f = "euclidean division";
     123     6315066 :   long tx = typ(x), ty = typ(y), vx = gvar(x), vy = gvar(y);
     124             : 
     125     6315066 :   if (ty == t_POL)
     126             :   {
     127     6315003 :     if (varncmp(vx,vy) >= 0)
     128             :     {
     129             :       pari_sp av;
     130             :       GEN z;
     131     6314989 :       if (!signe(y)) pari_err_INV("grem",y);
     132     6314989 :       if (vx != vy) return rem_scal_pol(x,y);
     133     3856710 :       switch(tx)
     134             :       {
     135       65289 :         case t_POLMOD: return polmod_mod(x,y);
     136     3779311 :         case t_POL: return RgX_rem(x,y);
     137       12061 :         case t_RFRAC:
     138       12061 :           av = avma; z = RgXQ_inv(RgX_rem(gel(x,2), y), y);
     139       12054 :           return gerepileupto(av, grem(gmul(gel(x,1), z), y));
     140          49 :         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          21 :         default: pari_err_TYPE2("%",x,y);
     148             :       }
     149             :     }
     150          14 :     else switch(tx)
     151             :     {
     152          14 :       case t_POL:
     153          14 :       case t_RFRAC: return rem_pol_scal(x,y);
     154           0 :       default: pari_err_TYPE2("%",x,y);
     155             :     }
     156             :   }
     157          63 :   if (!is_extscalar_t(tx) || !is_extscalar_t(ty)) pari_err_TYPE2(f,x,y);
     158          63 :   if (vx == vy && ty==t_POLMOD) pari_err_TYPE2(f,x,y);
     159          56 :   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          56 :   if (ty != t_POL || varncmp(vx, vy) < 0) /* y a "scalar" */
     165          56 :     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         336 : check_padic_p(GEN x, GEN p)
     177             : {
     178         336 :   GEN q = gel(x,2);
     179         336 :   if (p && !equalii(p, q)) pari_err_MODULUS("Zp_to_Z", p,q);
     180         315 : }
     181             : /* shallow */
     182             : static GEN
     183        4193 : Zp_to_Z(GEN x, GEN p) {
     184        4193 :   switch(typ(x))
     185             :   {
     186        3955 :     case t_INT: break;
     187         238 :     case t_PADIC:
     188         238 :       check_padic_p(x, p);
     189         217 :       x = gtrunc(x); break;
     190           0 :     default: pari_err_TYPE("Zp_to_Z",x);
     191             :   }
     192        4172 :   return x;
     193             : }
     194             : /* shallow */
     195             : static GEN
     196         714 : ZpX_to_ZX(GEN f, GEN p) {
     197         714 :   long i, l = lg(f);
     198         714 :   GEN F = cgetg_copy(f, &l); F[1] = f[1];
     199        4746 :   for (i=2; i<l; i++) gel(F,i) = Zp_to_Z(gel(f,i), p);
     200         700 :   return F;
     201             : }
     202             : 
     203             : static GEN
     204         651 : get_padic_content(GEN f, GEN p)
     205             : {
     206         651 :   GEN c = content(f);
     207         651 :   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         651 :   return c;
     214             : }
     215             : /* make f suitable for [root|factor]padic. Shallow */
     216             : static GEN
     217         588 : QpX_to_ZX(GEN f, GEN p)
     218             : {
     219         588 :   GEN c = get_padic_content(f, p);
     220         588 :   f = RgX_Rg_div(f, c);
     221         588 :   return ZpX_to_ZX(f, p);
     222             : }
     223             : 
     224             : /* x in Z return x + O(pr), pr = p^r. Shallow */
     225             : static GEN
     226        4263 : Z_to_Zp(GEN x, GEN p, GEN pr, long r)
     227             : {
     228             :   GEN y;
     229        4263 :   long v, sx = signe(x);
     230             : 
     231        4263 :   if (!sx) return zeropadic_shallow(p,r);
     232        3759 :   v = Z_pvalrem(x,p,&x);
     233        3759 :   if (v) {
     234         826 :     if (r <= v) return zeropadic_shallow(p,r);
     235         721 :     r -= v;
     236         721 :     pr = powiu(p,r);
     237             :   }
     238        3654 :   y = cgetg(5,t_PADIC);
     239        3654 :   y[1] = evalprecp(r)|evalvalp(v);
     240        3654 :   gel(y,2) = p;
     241        3654 :   gel(y,3) = pr;
     242        3654 :   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         140 :   for (i=1; i<l; i++) gel(Z,i) = Z_to_Zp(gel(z,i),p,q,r);
     251          49 :   return Z;
     252             : }
     253             : /* shallow */
     254             : static GEN
     255        1260 : ZX_to_ZpX(GEN z, GEN p, GEN q, long r)
     256             : {
     257        1260 :   long i, l = lg(z);
     258        1260 :   GEN Z = cgetg(l, t_POL); Z[1] = z[1];
     259        5327 :   for (i=2; i<l; i++) gel(Z,i) = Z_to_Zp(gel(z,i),p,q,r);
     260        1260 :   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        1155 : ZX_to_ZpX_normalized(GEN x, GEN p, GEN pr, long r)
     266             : {
     267        1155 :   long i, lx = lg(x);
     268        1155 :   GEN z, lead = leading_coeff(x);
     269             : 
     270        1155 :   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         140 :   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          49 : ZXV_to_ZpXQV(GEN z, GEN T, GEN p, long r)
     278             : {
     279          49 :   long i, l = lg(z);
     280          49 :   GEN Z = cgetg(l, typ(z)), q = powiu(p, r);
     281          49 :   T = ZX_copy(T);
     282         126 :   for (i=1; i<lg(z); i++) gel(Z,i) = mkpolmod(ZX_to_ZpX(gel(z,i),p,q,r),T);
     283          49 :   return Z;
     284             : }
     285             : /* shallow */
     286             : static GEN
     287          63 : QpXQX_to_ZXY(GEN f, GEN p)
     288             : {
     289          63 :   GEN c = get_padic_content(f, p);
     290          63 :   long i, l = lg(f);
     291          63 :   f = RgX_Rg_div(f,c);
     292         287 :   for (i=2; i<l; i++)
     293             :   {
     294         231 :     GEN t = gel(f,i);
     295         231 :     switch(typ(t))
     296             :     {
     297          91 :       case t_POLMOD:
     298          91 :         t = gel(t,2);
     299          91 :         t = (typ(t) == t_POL)? ZpX_to_ZX(t, p): Zp_to_Z(t, p);
     300          91 :         break;
     301           0 :       case t_POL: t = ZpX_to_ZX(t, p); break;
     302         140 :       default: t = Zp_to_Z(t, p); break;
     303             :     }
     304         224 :     gel(f,i) = t;
     305             :   }
     306          56 :   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         476 :     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))) { set_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             : static long
     360          98 : pval(GEN x, GEN p) { return typ(x) == t_INT? Z_pval(x,p): ZX_pval(x,p); }
     361             : /* f a ZXX, f(0) != 0 */
     362             : static GEN
     363         518 : pnormalize(GEN f, GEN p, GEN T, long prec, long n,
     364             :            GEN *plead, long *pprec, int *prev)
     365             : {
     366         518 :   *plead = leading_coeff(f);
     367         518 :   *pprec = prec;
     368         518 :   *prev = 0;
     369         518 :   if (!isint1(*plead))
     370             :   {
     371          49 :     long v = pval(*plead,p), v1 = pval(constant_coeff(f),p);
     372          49 :     if (v1 < v)
     373             :     {
     374          35 :       *prev = 1;
     375          35 :       f = RgX_recip_shallow(f); /* f(0) != 0 so degree is the same */
     376             :      /* beware loss of precision from lc(factor), whose valuation is <= v */
     377          35 :       *pprec += v; v = v1;
     378             :     }
     379          49 :     *pprec += v * n;
     380             :   }
     381         518 :   if (!T) return ZX_Q_normalize(f, plead);
     382          14 :   *plead = gen_1;
     383          14 :   return FpXQX_normalize(f, T, powiu(p,*pprec));
     384             : }
     385             : 
     386             : /**************************************************************************/
     387             : 
     388             : static void
     389         238 : scalar_getprec(GEN x, long *pprec, GEN *pp)
     390             : {
     391         238 :   if (typ(x)==t_PADIC)
     392             :   {
     393          98 :     long e = valp(x); if (signe(gel(x,4))) e += precp(x);
     394          98 :     if (e < *pprec) *pprec = e;
     395          98 :     check_padic_p(x, *pp);
     396          98 :     *pp = gel(x,2);
     397             :   }
     398         238 : }
     399             : static void
     400          98 : getprec(GEN x, long *pprec, GEN *pp)
     401             : {
     402             :   long i;
     403          98 :   if (typ(x) != t_POL) scalar_getprec(x, pprec, pp);
     404             :   else
     405         266 :     for (i = lg(x)-1; i>1; i--) scalar_getprec(gel(x,i), pprec, pp);
     406          98 : }
     407             : 
     408             : /* assume f(a) = 0 (mod T,p) */
     409             : static GEN
     410         105 : ZXY_ZpQ_root(GEN f, GEN a, GEN T, GEN p, long prec)
     411             : {
     412             :   GEN z, R;
     413             :   long i, j, k, lR;
     414         105 :   if (signe(FqX_eval(FqX_deriv(f,T,p), a, T,p)))
     415             :   { /* simple zero mod (T,p), go all the way to p^prec */
     416          77 :     if (prec > 1) a = ZpXQX_liftroot(f, a, T, p, prec);
     417          77 :     return mkcol(a);
     418             :   }
     419          28 :   f = RgX_unscale(RgXQX_translate(f, a, T), p);
     420          28 :   f = RgX_Rg_div(f, powiu(p, gvaluation(f,p)));
     421          28 :   z = cgetg(degpol(f)+1,t_COL);
     422          28 :   R = FpXQX_roots(FqX_red(f,T,p), T, p); lR = lg(R);
     423          70 :   for(j=i=1; i<lR; i++)
     424             :   {
     425          42 :     GEN u = ZXY_ZpQ_root(f, gel(R,i), T, p, prec-1);
     426          84 :     for (k=1; k<lg(u); k++) gel(z,j++) = gadd(a, gmul(p, gel(u,k)));
     427             :   }
     428          28 :   setlg(z,j); return z;
     429             : }
     430             : 
     431             : /* a belongs to finite extension of Q_p, return all roots of f equal to a
     432             :  * mod p. Don't assume f(a) = 0 (mod p) */
     433             : GEN
     434          91 : padicappr(GEN f, GEN a)
     435             : {
     436             :   GEN p, z, T;
     437             :   long prec;
     438          91 :   pari_sp av = avma;
     439             : 
     440          91 :   if (typ(f)!=t_POL) pari_err_TYPE("padicappr",f);
     441          91 :   switch(typ(a)) {
     442          42 :     case t_PADIC: return Zp_appr(f,a);
     443          49 :     case t_POLMOD: break;
     444           0 :     default: pari_err_TYPE("padicappr",a);
     445             :   }
     446          49 :   if (gequal0(f)) pari_err_ROOTS0("padicappr");
     447          49 :   T = gel(a,1);
     448          49 :   a = gel(a,2);
     449          49 :   p = NULL; prec = LONG_MAX;
     450          49 :   getprec(a, &prec, &p);
     451          49 :   getprec(T, &prec, &p); if (!p) pari_err_TYPE("padicappr",T);
     452          49 :   f = QpXQX_to_ZXY(f, p);
     453          42 :   if (typ(a) != t_POL) a = scalarpol_shallow(a, varn(T));
     454          42 :   a = ZpX_to_ZX(a,p);
     455          42 :   T = QpX_to_ZX(T,p);
     456             :   /* ensure that f /= (f,f') is separable */
     457          42 :   (void)nfgcd_all(f, RgX_deriv(f), T, NULL, &f);
     458             : 
     459          42 :   if (!gequal0(FqX_eval(FqX_red(f,T,p), a, T,p))) /* check f(a) = 0 (mod p,T) */
     460           7 :   { set_avma(av); return cgetg(1,t_COL); }
     461          35 :   z = ZXY_ZpQ_root(f, a, T, p, prec);
     462          35 :   return gerepilecopy(av, ZXV_to_ZpXQV(z, T, p, prec));
     463             : }
     464             : 
     465             : /* vector of p-adic roots of the ZX f, leading term prime to p. Shallow */
     466             : static GEN
     467          35 : ZX_Zp_roots(GEN f, GEN p, long prec)
     468             : {
     469             :   long l, i;
     470             :   GEN r;
     471             : 
     472          35 :   f = ZX_radical(f);
     473          35 :   r = FpX_roots(f, p);
     474          35 :   l = lg(r); if (l == 1) return r;
     475          91 :   for (i = 1; i < l; i++) gel(r,i) = ZX_Zp_root(f, gel(r,i), p, prec);
     476          28 :   settyp(r, t_VEC); return ZV_to_ZpV(shallowconcat1(r), p, prec);
     477             : }
     478             : /* vector of p-adic roots of the ZXX f, leading term prime to p. Shallow */
     479             : static GEN
     480          14 : ZXY_ZpQ_roots(GEN f, GEN T, GEN p, long prec)
     481             : {
     482             :   long l, i;
     483             :   GEN r;
     484             : 
     485          14 :   (void)nfgcd_all(f, RgX_deriv(f), T, NULL, &f);
     486          14 :   r = FqX_roots(f, FpX_red(T,p), p);
     487          14 :   l = lg(r); if (l == 1) return r;
     488          42 :   for (i = 1; i < l; i++) gel(r,i) = ZXY_ZpQ_root(f, gel(r,i), T, p, prec);
     489          14 :   settyp(r, t_VEC); return ZXV_to_ZpXQV(shallowconcat1(r), T, p, prec);
     490             : }
     491             : 
     492             : /* return p-adic roots of f, precision prec */
     493             : GEN
     494          56 : polrootspadic(GEN f, GEN Tp, long prec)
     495             : {
     496          56 :   pari_sp av = avma;
     497             :   GEN lead, y, T, p;
     498             :   long PREC, i, k, v;
     499             :   int reverse;
     500             : 
     501          56 :   if (!ff_parse_Tp(Tp, &T,&p,0)) pari_err_TYPE("polrootspadic",Tp);
     502          56 :   if (typ(f)!=t_POL) pari_err_TYPE("polrootspadic",f);
     503          56 :   if (gequal0(f)) pari_err_ROOTS0("polrootspadic");
     504          56 :   if (prec <= 0)
     505           7 :     pari_err_DOMAIN("polrootspadic", "precision", "<=",gen_0,stoi(prec));
     506          49 :   f = T? QpXQX_to_ZXY(f, p): QpX_to_ZX(f, p);
     507          49 :   v = RgX_valrem(f, &f);
     508          49 :   f = pnormalize(f, p, T, prec, 1, &lead, &PREC, &reverse);
     509          49 :   y = T? ZXY_ZpQ_roots(f,T,p,PREC): ZX_Zp_roots(f,p,PREC);
     510          49 :   k = lg(y);
     511          49 :   if (lead != gen_1) y = RgC_Rg_div(y, lead);
     512          49 :   if (reverse)
     513           7 :     for (i=1; i<k; i++) gel(y,i) = ginv(gel(y,i));
     514          49 :   if (v) y = shallowconcat(zeropadic_shallow(p, prec), y);
     515          49 :   return gerepilecopy(av, y);
     516             : }
     517             : 
     518             : /*******************************************************************/
     519             : /*                                                                 */
     520             : /*             FACTORIZATION in Zp[X], using ROUND4                */
     521             : /*                                                                 */
     522             : /*******************************************************************/
     523             : 
     524             : int
     525        3015 : cmp_padic(GEN x, GEN y)
     526             : {
     527             :   long vx, vy;
     528        3015 :   if (x == gen_0) return -1;
     529        3015 :   if (y == gen_0) return  1;
     530        3015 :   vx = valp(x);
     531        3015 :   vy = valp(y);
     532        3015 :   if (vx < vy) return  1;
     533        2980 :   if (vx > vy) return -1;
     534        2728 :   return cmpii(gel(x,4), gel(y,4));
     535             : }
     536             : 
     537             : /* replace p^e by p*...*p [ factors are not known to be equal, only close at
     538             :  * input accuracy ] */
     539             : static GEN
     540          49 : famat_flatten(GEN fa)
     541             : {
     542          49 :   GEN y, P = gel(fa,1), E = gel(fa,2);
     543          49 :   long i, l = lg(E);
     544          49 :   y = cgetg(l, t_VEC);
     545         161 :   for (i = 1; i < l; i++)
     546             :   {
     547         112 :     GEN p = gel(P,i);
     548         112 :     long e = itou(gel(E,i));
     549         112 :     gel(y,i) = const_vec(e, p);
     550             :   }
     551          49 :   y = shallowconcat1(y); settyp(y, t_COL);
     552          49 :   return mkmat2(y, const_col(lg(y)-1, gen_1));
     553             : }
     554             : 
     555             : GEN
     556         504 : factorpadic(GEN f, GEN p, long r)
     557             : {
     558         504 :   pari_sp av = avma;
     559             :   GEN y, ppow;
     560             :   long v, n;
     561         504 :   int reverse = 0, exact;
     562             : 
     563         504 :   if (typ(f)!=t_POL) pari_err_TYPE("factorpadic",f);
     564         504 :   if (typ(p)!=t_INT) pari_err_TYPE("factorpadic",p);
     565         504 :   if (r <= 0) pari_err_DOMAIN("factorpadic", "precision", "<=",gen_0,stoi(r));
     566         497 :   if (!signe(f)) return prime_fact(f);
     567         497 :   if (!degpol(f)) return trivial_fact();
     568             : 
     569         497 :   exact = RgX_is_QX(f); /* before RgX_valrem which may lose type information */
     570         497 :   v = RgX_valrem_inexact(f, &f);
     571         497 :   ppow = powiu(p,r);
     572         497 :   n = degpol(f);
     573         497 :   if (!n)
     574          28 :     y = trivial_fact();
     575             :   else
     576             :   {
     577             :     GEN P, lead, lt;
     578             :     long i, l, pr;
     579             : 
     580         469 :     f = QpX_to_ZX(f, p); (void)Z_pvalrem(leading_coeff(f), p, &lt);
     581         469 :     f = pnormalize(f, p, NULL, r, n-1, &lead, &pr, &reverse);
     582         469 :     y = ZpX_monic_factor(f, p, pr);
     583         469 :     P = gel(y,1); l = lg(P);
     584         469 :     if (!isint1(lead))
     585         245 :       for (i=1; i<l; i++) gel(P,i) = Q_primpart(RgX_unscale(gel(P,i), lead));
     586        1624 :     for (i=1; i<l; i++)
     587             :     {
     588        1155 :       GEN t = gel(P,i);
     589        1155 :       if (reverse) t = normalizepol(RgX_recip_shallow(t));
     590        1155 :       gel(P,i) = ZX_to_ZpX_normalized(t,p,ppow,r);
     591             :     }
     592         469 :     if (!gequal1(lt)) gel(P,1) = gmul(gel(P,1), lt);
     593             :   }
     594         497 :   if (v)
     595             :   { /* v > 0 */
     596          63 :     GEN X = ZX_to_ZpX(pol_x(varn(f)), p, ppow, r);
     597          63 :     y = famat_mulpow_shallow(y, X, utoipos(v));
     598             :   }
     599         497 :   if (!exact) y = famat_flatten(y);
     600         497 :   return gerepilecopy(av, sort_factor_pol(y, cmp_padic));
     601             : }

Generated by: LCOV version 1.13