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 - buch4.c (source / functions) Hit Total Coverage
Test: PARI/GP v2.12.1 lcov report (development 25819-e703fe1174) Lines: 301 400 75.2 %
Date: 2020-09-18 06:10:04 Functions: 24 31 77.4 %
Legend: Lines: hit not hit

          Line data    Source code
       1             : /* Copyright (C) 2000  The PARI group.
       2             : 
       3             : This file is part of the PARI/GP package.
       4             : 
       5             : PARI/GP is free software; you can redistribute it and/or modify it under the
       6             : terms of the GNU General Public License as published by the Free Software
       7             : Foundation. 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             : /*               S-CLASS GROUP AND NORM SYMBOLS                    */
      17             : /*          (Denis Simon, desimon@math.u-bordeaux.fr)              */
      18             : /*                                                                 */
      19             : /*******************************************************************/
      20             : #include "pari.h"
      21             : #include "paripriv.h"
      22             : 
      23             : /* p > 2, T ZX, p prime, x t_INT */
      24             : static long
      25           0 : lemma6(GEN T, GEN p, long nu, GEN x)
      26             : {
      27             :   long la, mu;
      28           0 :   pari_sp av = avma;
      29           0 :   GEN gpx, gx = poleval(T, x);
      30             : 
      31           0 :   if (Zp_issquare(gx, p)) return gc_long(av,1);
      32             : 
      33           0 :   la = Z_pval(gx, p);
      34           0 :   gpx = poleval(ZX_deriv(T), x);
      35           0 :   mu = signe(gpx)? Z_pval(gpx,p)
      36           0 :                  : la+nu+1; /* mu = +oo */
      37           0 :   set_avma(av);
      38           0 :   if (la > mu<<1) return 1;
      39           0 :   if (la >= nu<<1 && mu >= nu) return 0;
      40           0 :   return -1;
      41             : }
      42             : /* p = 2, T ZX, x t_INT: return 1 = yes, -1 = no, 0 = inconclusive */
      43             : static long
      44           0 : lemma7(GEN T, long nu, GEN x)
      45             : {
      46             :   long odd4, la, mu;
      47           0 :   pari_sp av = avma;
      48           0 :   GEN gpx, oddgx, gx = poleval(T, x);
      49             : 
      50           0 :   if (Zp_issquare(gx,gen_2)) return 1;
      51             : 
      52           0 :   gpx = poleval(ZX_deriv(T), x);
      53           0 :   la = Z_lvalrem(gx, 2, &oddgx);
      54           0 :   odd4 = umodiu(oddgx,4); set_avma(av);
      55             : 
      56           0 :   mu = vali(gpx);
      57           0 :   if (mu < 0) mu = la+nu+1; /* mu = +oo */
      58             : 
      59           0 :   if (la > mu<<1) return 1;
      60           0 :   if (nu > mu)
      61             :   {
      62           0 :     long mnl = mu+nu-la;
      63           0 :     if (odd(la)) return -1;
      64           0 :     if (mnl==1) return 1;
      65           0 :     if (mnl==2 && odd4==1) return 1;
      66             :   }
      67             :   else
      68             :   {
      69           0 :     long nu2 = nu << 1;
      70           0 :     if (la >= nu2) return 0;
      71           0 :     if (la == nu2 - 2 && odd4==1) return 0;
      72             :   }
      73           0 :   return -1;
      74             : }
      75             : 
      76             : /* T a ZX, p a prime, pnu = p^nu, x0 t_INT */
      77             : static long
      78           0 : zpsol(GEN T, GEN p, long nu, GEN pnu, GEN x0)
      79             : {
      80             :   long i, res;
      81           0 :   pari_sp av = avma, btop;
      82             :   GEN x, pnup;
      83             : 
      84           0 :   res = absequaliu(p,2)? lemma7(T,nu,x0): lemma6(T,p,nu,x0);
      85           0 :   if (res== 1) return 1;
      86           0 :   if (res==-1) return 0;
      87           0 :   x = x0; pnup = mulii(pnu,p);
      88           0 :   btop = avma;
      89           0 :   for (i=0; i < itos(p); i++)
      90             :   {
      91           0 :     x = addii(x,pnu);
      92           0 :     if (zpsol(T,p,nu+1,pnup,x)) return gc_long(av,1);
      93           0 :     if (gc_needed(btop, 2))
      94             :     {
      95           0 :       x = gerepileupto(btop, x);
      96           0 :       if (DEBUGMEM > 1)
      97           0 :         pari_warn(warnmem, "hyperell_locally_soluble: %ld/%Ps",i,p);
      98             :     }
      99             :   }
     100           0 :   return gc_long(av,0);
     101             : }
     102             : 
     103             : /* return 1 if equation y^2=T(x) has a rational p-adic solution (possibly
     104             :  * infinite), 0 otherwise. */
     105             : long
     106           0 : hyperell_locally_soluble(GEN T,GEN p)
     107             : {
     108           0 :   pari_sp av = avma;
     109             :   long res;
     110           0 :   if (typ(T)!=t_POL) pari_err_TYPE("hyperell_locally_soluble",T);
     111           0 :   if (typ(p)!=t_INT) pari_err_TYPE("hyperell_locally_soluble",p);
     112           0 :   RgX_check_ZX(T, "hyperell_locally_soluble");
     113           0 :   res = zpsol(T,p,0,gen_1,gen_0) || zpsol(RgX_recip_shallow(T), p, 1, p, gen_0);
     114           0 :   return gc_long(av, res);
     115             : }
     116             : 
     117             : /* is t a square in (O_K/pr) ? Assume v_pr(t) = 0 */
     118             : static long
     119         140 : quad_char(GEN nf, GEN t, GEN pr)
     120             : {
     121         140 :   GEN ord, ordp, T, p, modpr = zk_to_Fq_init(nf, &pr,&T,&p);
     122         140 :   t = nf_to_Fq(nf,t,modpr);
     123         140 :   if (T)
     124             :   {
     125         140 :     ord = subiu( pr_norm(pr), 1 ); /* |(O_K / pr)^*| */
     126         140 :     ordp= subiu( p, 1);            /* |F_p^*|        */
     127         140 :     t = Fq_pow(t, diviiexact(ord, ordp), T,p); /* in F_p^* */
     128         140 :     if (typ(t) == t_POL)
     129             :     {
     130         140 :       if (degpol(t)) pari_err_BUG("nfhilbertp");
     131         140 :       t = gel(t,2);
     132             :     }
     133             :   }
     134         140 :   return kronecker(t, p);
     135             : }
     136             : /* quad_char(x), x in Z, non-zero mod p */
     137             : static long
     138         161 : Z_quad_char(GEN x, GEN pr)
     139             : {
     140         161 :   long f = pr_get_f(pr);
     141         161 :   if (!odd(f)) return 1;
     142         154 :   return kronecker(x, pr_get_p(pr));
     143             : }
     144             : 
     145             : /* (pr,2) = 1. return 1 if x in Z_K is a square in Z_{K_pr}, 0 otherwise.
     146             :  * modpr = zkmodprinit(nf,pr) */
     147             : static long
     148           0 : psquarenf(GEN nf,GEN x,GEN pr,GEN modpr)
     149             : {
     150           0 :   pari_sp av = avma;
     151           0 :   GEN p = pr_get_p(pr);
     152             :   long v;
     153             : 
     154           0 :   x = nf_to_scalar_or_basis(nf, x);
     155           0 :   if (typ(x) == t_INT) {
     156           0 :     if (!signe(x)) return 1;
     157           0 :     v = Z_pvalrem(x, p, &x) * pr_get_e(pr);
     158           0 :     if (v&1) return 0;
     159           0 :     v = (Z_quad_char(x, pr) == 1);
     160             :   } else {
     161           0 :     v = ZC_nfvalrem(x, pr, &x);
     162           0 :     if (v&1) return 0;
     163           0 :     v = (quad_char(nf, x, modpr) == 1);
     164             :   }
     165           0 :   return gc_long(av,v);
     166             : }
     167             : 
     168             : static long
     169        5908 : ZV_iseven(GEN zlog)
     170             : {
     171        5908 :   long i, l = lg(zlog);
     172       21546 :   for (i = 1; i < l; i++)
     173       21413 :     if (mpodd(gel(zlog,i))) return 0;
     174         133 :   return 1;
     175             : }
     176             : 
     177             : /* pr | 2, project to principal units (trivializes later discrete log) */
     178             : static GEN
     179        5908 : to_principal_unit(GEN nf, GEN x, GEN pr, GEN sprk)
     180             : {
     181        5908 :   if (pr_get_f(pr) != 1)
     182             :   {
     183        5656 :     GEN prk = gel(sprk,3);
     184        5656 :     x = nfpowmodideal(nf, x, gmael(sprk,5,1), prk);
     185             :   }
     186        5908 :   return x;
     187             : }
     188             : /* pr | 2. Return 1 if x in Z_K is square in Z_{K_pr}, 0 otherwise */
     189             : static int
     190         511 : psquare2nf(GEN nf, GEN x, GEN pr, GEN sprk)
     191             : {
     192         511 :   long v = nfvalrem(nf, x, pr, &x);
     193         511 :   if (v == LONG_MAX) return 1; /* x = 0 */
     194             :   /* (x,pr) = 1 */
     195         511 :   if (odd(v)) return 0;
     196         490 :   x = to_principal_unit(nf, x, pr, sprk); /* = 1 mod pr */
     197         490 :   return ZV_iseven(sprk_log_prk1(nf, x, sprk));
     198             : }
     199             : 
     200             : /*
     201             : For z in nf, z != 0.
     202             : quadratic characters modulo the prime ideal pr in nf.
     203             : pr output by nfmodprinit
     204             : pstar output by idealstar (only for p | 2).
     205             : For p odd, the output is a vector [v,c]*Mod(1,2), where
     206             : v = valuation(z,pr)
     207             : c = !issquare( z/pr^v mod pr)
     208             : For p | 2, the output is similar, with a longer sequence of 0,1 for c.
     209             : */
     210             : 
     211             : GEN
     212           0 : nf_quadchar_modpr(GEN nf, GEN z, GEN modpr, GEN pstar)
     213             : {
     214           0 :   pari_sp av = avma;
     215           0 :   GEN pr = modpr_get_pr(modpr);
     216           0 :   GEN v = stoi(nfvalrem(nf, z, pr, &z));
     217           0 :   if( equaliu(pr_get_p(pr),2))
     218             :   {
     219           0 :     GEN c = ideallog(nf, z, pstar);
     220           0 :     return gerepilecopy(av, shallowconcat(v, shallowtrans(c)));
     221             :   }
     222             :   else
     223             :   {
     224           0 :     GEN c = quad_char(nf, z, modpr)==1? gen_0: gen_1;
     225           0 :     return gerepilecopy(av, mkvec2(v,c));
     226             :   }
     227             : }
     228             : 
     229             : /* pr above an odd prime */
     230             : static long
     231           0 : lemma6nf(GEN nf, GEN T, GEN pr, long nu, GEN x, GEN modpr)
     232             : {
     233           0 :   pari_sp av = avma;
     234             :   long la, mu;
     235           0 :   GEN gpx, gx = nfpoleval(nf, T, x);
     236             : 
     237           0 :   if (psquarenf(nf,gx,pr,modpr)) return 1;
     238             : 
     239           0 :   la = nfval(nf,gx,pr);
     240           0 :   gpx = nfpoleval(nf, RgX_deriv(T), x);
     241           0 :   mu = gequal0(gpx)? la+nu+1 /* +oo */: nfval(nf,gpx,pr);
     242           0 :   set_avma(av);
     243           0 :   if (la > (mu<<1)) return 1;
     244           0 :   if (la >= (nu<<1) && mu >= nu) return 0;
     245           0 :   return -1;
     246             : }
     247             : /* pr above 2 */
     248             : static long
     249        5642 : lemma7nf(GEN nf, GEN T, GEN pr, long nu, GEN x, GEN sprk)
     250             : {
     251             :   long i, res, la, mu, q, e, v;
     252        5642 :   GEN M, y, gpx, loggx = NULL, gx = nfpoleval(nf, T, x);
     253             : 
     254        5642 :   la = nfvalrem(nf, gx, pr, &gx); /* gx /= pi^la, pi a pr-uniformizer */
     255        5642 :   if (la == LONG_MAX) return 1;
     256        5635 :   if (!odd(la))
     257             :   {
     258        5418 :     gx = to_principal_unit(nf, gx, pr, sprk); /* now 1 mod pr */
     259        5418 :     loggx = sprk_log_prk1(nf, gx, sprk); /* cheap */
     260        5418 :     if (ZV_iseven(loggx)) return 1;
     261             :   }
     262        5509 :   gpx = nfpoleval(nf, RgX_deriv(T), x);
     263        5509 :   mu = gequal0(gpx)? la+nu+1 /* oo */: nfval(nf,gpx,pr);
     264             : 
     265        5509 :   if (la > (mu << 1)) return 1;
     266        5509 :   if (nu > mu)
     267             :   {
     268          35 :     if (odd(la)) return -1;
     269          35 :     q = mu+nu-la; res = 1;
     270             :   }
     271             :   else
     272             :   {
     273        5474 :     q = (nu << 1) - la;
     274        5474 :     if (q <= 0) return 0;
     275        5173 :     if (odd(la)) return -1;
     276        4977 :     res = 0;
     277             :   }
     278             :   /* la even */
     279        5012 :   e = pr_get_e(pr);
     280        5012 :   if (q > e << 1)  return -1;
     281        4935 :   if (q == 1) return res;
     282             : 
     283             :   /* gx = 1 mod pr; square mod pi^q ? */
     284        4935 :   v = nfvalrem(nf, nfadd(nf, gx, gen_m1), pr, &y);
     285        4935 :   if (v >= q) return res;
     286             :   /* 1 + pi^v y = (1 + pi^vz z)^2 mod pr^q ? v < q <= 2e => vz < e => vz = vy/2
     287             :    * => y = x^2 mod pr^(min(q-v, e+v/2)), (y,pr) = 1 */
     288        4690 :   if (odd(v)) return -1;
     289             :   /* e > 1 */
     290        2037 :   M = cgetg(2*e+1 - q + 1, t_VEC);
     291        4074 :   for (i = q+1; i <= 2*e+1; i++) gel(M, i-q) = sprk_log_gen_pr(nf, sprk, i);
     292        2037 :   M = ZM_hnfmodid(shallowconcat1(M), gen_2);
     293        2037 :   return hnf_solve(M,loggx)? res: -1;
     294             : }
     295             : /* zinit either a sprk (pr | 2) or a modpr structure (pr | p odd).
     296             :    pnu = pi^nu, pi a uniformizer */
     297             : static long
     298        5642 : zpsolnf(GEN nf,GEN T,GEN pr,long nu,GEN pnu,GEN x0,GEN repr,GEN zinit)
     299             : {
     300             :   long i, res;
     301        5642 :   pari_sp av = avma;
     302             :   GEN pnup;
     303             : 
     304        5642 :   res = typ(zinit) == t_VEC? lemma7nf(nf,T,pr,nu,x0,zinit)
     305        5642 :                            : lemma6nf(nf,T,pr,nu,x0,zinit);
     306        5642 :   set_avma(av);
     307        5642 :   if (res== 1) return 1;
     308        5509 :   if (res==-1) return 0;
     309         574 :   pnup = nfmul(nf, pnu, pr_get_gen(pr));
     310         574 :   nu++;
     311        5558 :   for (i=1; i<lg(repr); i++)
     312             :   {
     313        5250 :     GEN x = nfadd(nf, x0, nfmul(nf,pnu,gel(repr,i)));
     314        5250 :     if (zpsolnf(nf,T,pr,nu,pnup,x,repr,zinit)) return gc_long(av,1);
     315             :   }
     316         308 :   return gc_long(av,0);
     317             : }
     318             : 
     319             : /* Let y = copy(x); y[k] := j; return y */
     320             : static GEN
     321        3206 : ZC_add_coeff(GEN x, long k, long j)
     322        3206 : { GEN y = shallowcopy(x); gel(y, k) = utoipos(j); return y; }
     323             : 
     324             : /* system of representatives for Zk/pr */
     325             : static GEN
     326         252 : repres(GEN nf, GEN pr)
     327             : {
     328         252 :   long f = pr_get_f(pr), N = nf_get_degree(nf), p = itos(pr_get_p(pr));
     329         252 :   long i, j, k, pi, pf = upowuu(p, f);
     330         252 :   GEN perm = pr_basis_perm(nf, pr), rep = cgetg(pf+1,t_VEC);
     331             : 
     332         252 :   gel(rep,1) = zerocol(N);
     333        1141 :   for (pi=i=1; i<=f; i++,pi*=p)
     334             :   {
     335         889 :     long t = perm[i];
     336        1778 :     for (j=1; j<p; j++)
     337        4095 :       for (k=1; k<=pi; k++) gel(rep, j*pi+k) = ZC_add_coeff(gel(rep,k), t, j);
     338             :   }
     339         252 :   return rep;
     340             : }
     341             : 
     342             : /* = 1 if equation y^2 = z^deg(T) * T(x/z) has a pr-adic rational solution
     343             :  * (possibly (1,y,0) = oo), 0 otherwise.
     344             :  * coeffs of T are algebraic integers in nf */
     345             : static long
     346         259 : locally_soluble(GEN nf,GEN T,GEN pr)
     347             : {
     348             :   GEN repr, zinit;
     349             : 
     350         259 :   if (typ(T)!=t_POL) pari_err_TYPE("nf_hyperell_locally_soluble",T);
     351         259 :   if (gequal0(T)) return 1;
     352         259 :   checkprid(pr); nf = checknf(nf);
     353         259 :   if (absequaliu(pr_get_p(pr), 2))
     354             :   { /* tough case */
     355         259 :     zinit = log_prk_init(nf, pr, 1+2*pr_get_e(pr), NULL);
     356         259 :     if (psquare2nf(nf,constant_coeff(T),pr,zinit)) return 1;
     357         252 :     if (psquare2nf(nf, leading_coeff(T),pr,zinit)) return 1;
     358             :   }
     359             :   else
     360             :   {
     361           0 :     zinit = zkmodprinit(nf, pr);
     362           0 :     if (psquarenf(nf,constant_coeff(T),pr,zinit)) return 1;
     363           0 :     if (psquarenf(nf, leading_coeff(T),pr,zinit)) return 1;
     364             :   }
     365         252 :   repr = repres(nf,pr); /* FIXME: inefficient if Npr is large */
     366         392 :   return zpsolnf(nf, T, pr, 0, gen_1, gen_0, repr, zinit) ||
     367         140 :          zpsolnf(nf, RgX_recip_shallow(T), pr, 1, pr_get_gen(pr),
     368             :                  gen_0, repr, zinit);
     369             : }
     370             : long
     371         259 : nf_hyperell_locally_soluble(GEN nf,GEN T,GEN pr)
     372             : {
     373         259 :   pari_sp av = avma;
     374         259 :   return gc_long(av, locally_soluble(nf, T, pr));
     375             : }
     376             : 
     377             : /* return a * denom(a)^2, as an 'liftalg' */
     378             : static GEN
     379         518 : den_remove(GEN nf, GEN a)
     380             : {
     381             :   GEN da;
     382         518 :   a = nf_to_scalar_or_basis(nf, a);
     383         518 :   switch(typ(a))
     384             :   {
     385          49 :     case t_INT: return a;
     386           0 :     case t_FRAC: return mulii(gel(a,1), gel(a,2));
     387         469 :     case t_COL:
     388         469 :       a = Q_remove_denom(a, &da);
     389         469 :       if (da) a = ZC_Z_mul(a, da);
     390         469 :       return nf_to_scalar_or_alg(nf, a);
     391           0 :     default: pari_err_TYPE("nfhilbert",a);
     392             :       return NULL;/*LCOV_EXCL_LINE*/
     393             :   }
     394             : }
     395             : 
     396             : static long
     397         259 : hilb2nf(GEN nf,GEN a,GEN b,GEN p)
     398             : {
     399         259 :   pari_sp av = avma;
     400             :   GEN pol;
     401         259 :   a = den_remove(nf, a);
     402         259 :   b = den_remove(nf, b);
     403         259 :   pol = mkpoln(3, a, gen_0, b);
     404             :   /* varn(nf.pol) = 0, pol is not a valid GEN  [as in Pol([x,x], x)].
     405             :    * But it is only used as a placeholder, hence it is not a problem */
     406         259 :   return gc_long(av, nf_hyperell_locally_soluble(nf,pol,p)? 1: -1);
     407             : }
     408             : 
     409             : /* local quadratic Hilbert symbol (a,b)_pr, for a,b (non-zero) in nf */
     410             : static long
     411         567 : nfhilbertp(GEN nf, GEN a, GEN b, GEN pr)
     412             : {
     413             :   GEN t;
     414             :   long va, vb;
     415         567 :   pari_sp av = avma;
     416             : 
     417         567 :   if (absequaliu(pr_get_p(pr), 2)) return hilb2nf(nf,a,b,pr);
     418             : 
     419             :   /* pr not above 2, compute t = tame symbol */
     420         308 :   va = nfval(nf,a,pr);
     421         308 :   vb = nfval(nf,b,pr);
     422         308 :   if (!odd(va) && !odd(vb)) return gc_long(av,1);
     423             :   /* Trick: pretend the exponent is 2, result is OK up to squares ! */
     424         301 :   t = famat_makecoprime(nf, mkvec2(a,b), mkvec2s(vb, -va),
     425             :                         pr, pr_hnf(nf, pr), gen_2);
     426             :   /* quad. symbol is image of t = (-1)^(v(a)v(b)) a^v(b) b^(-v(a))
     427             :    * by the quadratic character  */
     428         301 :   switch(typ(t))
     429             :   {
     430         147 :     default: /* t_COL */
     431         147 :       if (!ZV_isscalar(t)) break;
     432           7 :       t = gel(t,1); /* fall through */
     433         161 :     case t_INT:
     434         161 :       if (odd(va) && odd(vb)) t = negi(t);
     435         161 :       return gc_long(av,  Z_quad_char(t, pr));
     436             :   }
     437         140 :   if (odd(va) && odd(vb)) t = ZC_neg(t);
     438         140 :   return gc_long(av, quad_char(nf, t, pr));
     439             : }
     440             : 
     441             : /* Global quadratic Hilbert symbol (a,b):
     442             :  *  =  1 if X^2 - aY^2 - bZ^2 has a point in projective plane
     443             :  *  = -1 otherwise
     444             :  * a, b should be non-zero */
     445             : long
     446          21 : nfhilbert(GEN nf, GEN a, GEN b)
     447             : {
     448          21 :   pari_sp av = avma;
     449             :   long i, l;
     450             :   GEN S, S2, Sa, Sb, sa, sb;
     451             : 
     452          21 :   nf = checknf(nf);
     453          21 :   a = nf_to_scalar_or_basis(nf, a);
     454          21 :   b = nf_to_scalar_or_basis(nf, b);
     455             :   /* local solutions in real completions ? [ error in nfsign if arg is 0 ]*/
     456          21 :   sa = nfsign(nf, a);
     457          21 :   sb = nfsign(nf, b); l = lg(sa);
     458          35 :   for (i=1; i<l; i++)
     459          21 :     if (sa[i] && sb[i])
     460             :     {
     461           7 :       if (DEBUGLEVEL>3)
     462           0 :         err_printf("nfhilbert not soluble at real place %ld\n",i);
     463           7 :       return gc_long(av,-1);
     464             :     }
     465             : 
     466             :   /* local solutions in finite completions ? (pr | 2ab)
     467             :    * primes above 2 are toughest. Try the others first */
     468          14 :   Sa = idealfactor(nf, a);
     469          14 :   Sb = idealfactor(nf, b);
     470          14 :   S2 = idealfactor(nf, gen_2);
     471          14 :   S = merge_factor(Sa, Sb, (void*)&cmp_prime_ideal, &cmp_nodata);
     472          14 :   S = merge_factor(S,  S2, (void*)&cmp_prime_ideal, &cmp_nodata);
     473          14 :   S = gel(S,1);
     474             :   /* product of all hilbertp is 1 ==> remove one prime (above 2!) */
     475          28 :   for (i=lg(S)-1; i>1; i--)
     476          21 :     if (nfhilbertp(nf,a,b,gel(S,i)) < 0)
     477             :     {
     478           7 :       if (DEBUGLEVEL>3)
     479           0 :         err_printf("nfhilbert not soluble at finite place %Ps\n",S[i]);
     480           7 :       return gc_long(av,-1);
     481             :     }
     482           7 :   return gc_long(av,1);
     483             : }
     484             : 
     485             : long
     486         581 : nfhilbert0(GEN nf,GEN a,GEN b,GEN p)
     487             : {
     488         581 :   nf = checknf(nf);
     489         581 :   if (p) {
     490         560 :     checkprid(p);
     491         560 :     if (gequal0(a)) pari_err_DOMAIN("nfhilbert", "a", "=", gen_0, a);
     492         553 :     if (gequal0(b)) pari_err_DOMAIN("nfhilbert", "b", "=", gen_0, b);
     493         546 :     return nfhilbertp(nf,a,b,p);
     494             :   }
     495          21 :   return nfhilbert(nf,a,b);
     496             : }
     497             : 
     498             : static void
     499         609 : p_append(GEN p, hashtable *H, hashtable *H2)
     500             : {
     501         609 :   ulong h = H->hash(p);
     502         609 :   hashentry *e = hash_search2(H, (void*)p, h);
     503         609 :   if (!e)
     504             :   {
     505         539 :     hash_insert2(H, (void*)p, NULL, h);
     506         539 :     if (H2) hash_insert2(H2, (void*)p, NULL, h);
     507             :   }
     508         609 : }
     509             : 
     510             : /* N a t_INT */
     511             : static void
     512         196 : Zfa_append(GEN N, hashtable *H, hashtable *H2)
     513             : {
     514         196 :   if (!is_pm1(N))
     515             :   {
     516         126 :     GEN v = gel(absZ_factor(N),1);
     517         126 :     long i, l = lg(v);
     518         308 :     for (i=1; i<l; i++) p_append(gel(v,i), H, H2);
     519             :   }
     520         196 : }
     521             : /* N a t_INT or t_FRAC or ideal in HNF*/
     522             : static void
     523         140 : fa_append(GEN N, hashtable *H, hashtable *H2)
     524             : {
     525         140 :   switch(typ(N))
     526             :   {
     527         112 :     case t_INT:
     528         112 :       Zfa_append(N,H,H2);
     529         112 :       break;
     530           0 :     case t_FRAC:
     531           0 :       Zfa_append(gel(N,1),H,H2);
     532           0 :       Zfa_append(gel(N,2),H,H2);
     533           0 :       break;
     534          28 :     default: /*t_MAT*/
     535          28 :       Zfa_append(gcoeff(N,1,1),H,H2);
     536          28 :       break;
     537             :   }
     538         140 : }
     539             : 
     540             : /* apply lift(rnfeltup) to all coeffs, without rnf structure */
     541             : static GEN
     542           7 : nfX_eltup(GEN nf, GEN rnfeq, GEN x)
     543             : {
     544             :   long i, l;
     545           7 :   GEN y = cgetg_copy(x, &l), zknf = nf_nfzk(nf, rnfeq);
     546          35 :   for (i=2; i<l; i++) gel(y,i) = nfeltup(nf, gel(x,i), zknf);
     547           7 :   y[1] = x[1]; return y;
     548             : }
     549             : 
     550             : static hashtable *
     551         196 : hash_create_INT(ulong s)
     552         196 : { return hash_create(s, (ulong(*)(void*))&hash_GEN,
     553             :                         (int(*)(void*,void*))&equalii, 1); }
     554             : GEN
     555          56 : rnfisnorminit(GEN T, GEN R, int galois)
     556             : {
     557          56 :   pari_sp av = avma;
     558             :   long i, l, dR;
     559             :   GEN S, gen, cyc, bnf, nf, nfabs, rnfeq, bnfabs, k, polabs;
     560          56 :   GEN y = cgetg(9, t_VEC);
     561          56 :   hashtable *H = hash_create_INT(100UL);
     562             : 
     563          56 :   if (galois < 0 || galois > 2) pari_err_FLAG("rnfisnorminit");
     564          56 :   T = get_bnfpol(T, &bnf, &nf);
     565          56 :   if (!bnf) bnf = Buchall(nf? nf: T, nf_FORCE, DEFAULTPREC);
     566          56 :   if (!nf) nf = bnf_get_nf(bnf);
     567             : 
     568          56 :   R = get_bnfpol(R, &bnfabs, &nfabs);
     569          56 :   if (!gequal1(leading_coeff(R))) pari_err_IMPL("non monic relative equation");
     570          56 :   dR = degpol(R);
     571          56 :   if (dR <= 2) galois = 1;
     572             : 
     573          56 :   R = RgX_nffix("rnfisnorminit", T, R, 1);
     574          56 :   if (nf_get_degree(nf) == 1) /* over Q */
     575          35 :     rnfeq = mkvec5(R,gen_0,gen_0,T,R);
     576          21 :   else if (galois == 2) /* needs eltup+abstorel */
     577           7 :     rnfeq = nf_rnfeq(nf, R);
     578             :   else /* needs abstorel */
     579          14 :     rnfeq = nf_rnfeqsimple(nf, R);
     580          56 :   polabs = gel(rnfeq,1);
     581          56 :   k = gel(rnfeq,3);
     582          56 :   if (!bnfabs || !gequal0(k))
     583          28 :     bnfabs = Buchall(polabs, nf_FORCE, nf_get_prec(nf));
     584          56 :   if (!nfabs) nfabs = bnf_get_nf(bnfabs);
     585             : 
     586          56 :   if (galois == 2)
     587             :   {
     588          21 :     GEN P = polabs==R? leafcopy(R): nfX_eltup(nf, rnfeq, R);
     589          21 :     setvarn(P, fetch_var_higher());
     590          21 :     galois = !!nfroots_if_split(&nfabs, P);
     591          21 :     (void)delete_var();
     592             :   }
     593             : 
     594          56 :   cyc = bnf_get_cyc(bnfabs);
     595          56 :   gen = bnf_get_gen(bnfabs); l = lg(cyc);
     596          84 :   for(i=1; i<l; i++)
     597             :   {
     598          35 :     GEN g = gel(gen,i);
     599          35 :     if (ugcdiu(gel(cyc,i), dR) == 1) break;
     600          28 :     Zfa_append(gcoeff(g,1,1), H, NULL);
     601             :   }
     602          56 :   if (!galois)
     603             :   {
     604          21 :     GEN Ndiscrel = diviiexact(nf_get_disc(nfabs), powiu(nf_get_disc(nf), dR));
     605          21 :     Zfa_append(Ndiscrel, H, NULL);
     606             :   }
     607          56 :   S = hash_keys(H); settyp(S,t_VEC);
     608          56 :   gel(y,1) = bnf;
     609          56 :   gel(y,2) = bnfabs;
     610          56 :   gel(y,3) = R;
     611          56 :   gel(y,4) = rnfeq;
     612          56 :   gel(y,5) = S;
     613          56 :   gel(y,6) = nf_pV_to_prV(nf, S);
     614          56 :   gel(y,7) = nf_pV_to_prV(nfabs, S);
     615          56 :   gel(y,8) = stoi(galois); return gerepilecopy(av, y);
     616             : }
     617             : 
     618             : /* T as output by rnfisnorminit
     619             :  * if flag=0 assume extension is Galois (==> answer is unconditional)
     620             :  * if flag>0 add to S all primes dividing p <= flag
     621             :  * if flag<0 add to S all primes dividing abs(flag)
     622             : 
     623             :  * answer is a vector v = [a,b] such that
     624             :  * x = N(a)*b and x is a norm iff b = 1  [assuming S large enough] */
     625             : GEN
     626          70 : rnfisnorm(GEN T, GEN x, long flag)
     627             : {
     628          70 :   pari_sp av = avma;
     629             :   GEN bnf, rel, R, rnfeq, nfpol;
     630             :   GEN nf, aux, H, U, Y, M, A, bnfS, sunitrel, futu, S, S1, S2, Sx;
     631             :   long L, i, itu;
     632             :   hashtable *H0, *H2;
     633          70 :   if (typ(T) != t_VEC || lg(T) != 9)
     634           0 :     pari_err_TYPE("rnfisnorm [please apply rnfisnorminit()]", T);
     635          70 :   bnf = gel(T,1);
     636          70 :   rel = gel(T,2);
     637          70 :   bnf = checkbnf(bnf);
     638          70 :   rel = checkbnf(rel);
     639          70 :   nf = bnf_get_nf(bnf);
     640          70 :   x = nf_to_scalar_or_alg(nf,x);
     641          70 :   if (gequal0(x)) { set_avma(av); return mkvec2(gen_0, gen_1); }
     642          70 :   if (gequal1(x)) { set_avma(av); return mkvec2(gen_1, gen_1); }
     643          70 :   R = gel(T,3);
     644          70 :   rnfeq = gel(T,4);
     645          70 :   if (gequalm1(x) && odd(degpol(R)))
     646           0 :   { set_avma(av); return mkvec2(gen_m1, gen_1); }
     647             : 
     648             :   /* build set T of ideals involved in the solutions */
     649          70 :   nfpol = nf_get_pol(nf);
     650          70 :   S = gel(T,5);
     651          70 :   H0 = hash_create_INT(100UL);
     652          70 :   H2 = hash_create_INT(100UL);
     653          70 :   L = lg(S);
     654         147 :   for (i = 1; i < L; i++) p_append(gel(S,i),H0,NULL);
     655          70 :   S1 = gel(T,6);
     656          70 :   S2 = gel(T,7);
     657          70 :   if (flag && !gequal0(gel(T,8)))
     658           7 :     pari_warn(warner,"useless flag in rnfisnorm: the extension is Galois");
     659          70 :   if (flag > 0)
     660             :   {
     661             :     forprime_t T;
     662             :     ulong p;
     663          14 :     u_forprime_init(&T, 2, flag);
     664         364 :     while ((p = u_forprime_next(&T))) p_append(utoipos(p), H0,H2);
     665             :   }
     666          56 :   else if (flag < 0)
     667           7 :     Zfa_append(utoipos(-flag),H0,H2);
     668             :   /* overkill: prime ideals dividing x would be enough */
     669          70 :   A = idealnumden(nf, x);
     670          70 :   fa_append(gel(A,1), H0,H2);
     671          70 :   fa_append(gel(A,2), H0,H2);
     672          70 :   Sx = hash_keys(H2); L = lg(Sx);
     673          70 :   if (L > 1)
     674             :   { /* new primes */
     675          49 :     settyp(Sx, t_VEC);
     676          49 :     S1 = shallowconcat(S1, nf_pV_to_prV(nf, Sx));
     677          49 :     S2 = shallowconcat(S2, nf_pV_to_prV(rel, Sx));
     678             :   }
     679             : 
     680             :   /* computation on T-units */
     681          70 :   futu = shallowconcat(bnf_get_fu(rel), bnf_get_tuU(rel));
     682          70 :   bnfS = bnfsunit(bnf,S1,LOWDEFAULTPREC);
     683          70 :   sunitrel = shallowconcat(futu, gel(bnfsunit(rel,S2,LOWDEFAULTPREC), 1));
     684             : 
     685          70 :   A = lift_shallow(bnfissunit(bnf,bnfS,x));
     686          70 :   L = lg(sunitrel);
     687          70 :   itu = lg(nf_get_roots(nf))-1; /* index of torsion unit in bnfsunit(nf) output */
     688          70 :   M = cgetg(L+1,t_MAT);
     689        1449 :   for (i=1; i<L; i++)
     690             :   {
     691        1379 :     GEN u = eltabstorel(rnfeq, gel(sunitrel,i));
     692        1379 :     gel(sunitrel,i) = u;
     693        1379 :     u = bnfissunit(bnf,bnfS, gnorm(u));
     694        1379 :     if (lg(u) == 1) pari_err_BUG("rnfisnorm");
     695        1379 :     gel(u,itu) = lift_shallow(gel(u,itu)); /* lift root of 1 part */
     696        1379 :     gel(M,i) = u;
     697             :   }
     698          70 :   aux = zerocol(lg(A)-1); gel(aux,itu) = utoipos( bnf_get_tuN(rel) );
     699          70 :   gel(M,L) = aux;
     700          70 :   H = ZM_hnfall(M, &U, 2);
     701          70 :   Y = RgM_RgC_mul(U, inverseimage(H,A));
     702             :   /* Y: sols of MY = A over Q */
     703          70 :   setlg(Y, L);
     704          70 :   aux = factorback2(sunitrel, gfloor(Y));
     705          70 :   x = mkpolmod(x,nfpol);
     706          70 :   if (!gequal1(aux)) x = gdiv(x, gnorm(aux));
     707          70 :   x = lift_if_rational(x);
     708          70 :   if (typ(aux) == t_POLMOD && degpol(nfpol) == 1)
     709          21 :     gel(aux,2) = lift_if_rational(gel(aux,2));
     710          70 :   return gerepilecopy(av, mkvec2(aux, x));
     711             : }
     712             : 
     713             : GEN
     714          28 : bnfisnorm(GEN bnf, GEN x, long flag)
     715             : {
     716          28 :   pari_sp av = avma;
     717          28 :   GEN T = rnfisnorminit(pol_x(fetch_var()), bnf, flag == 0? 1: 2);
     718          28 :   GEN r = rnfisnorm(T, x, flag == 1? 0: flag);
     719          28 :   (void)delete_var();
     720          28 :   return gerepileupto(av,r);
     721             : }

Generated by: LCOV version 1.13