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