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