Line data Source code
1 : /* Copyright (C) 2016 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 : #include "pari.h"
16 : #include "paripriv.h"
17 : /*******************************************************************/
18 : /* LOGARITHMIC CLASS GROUP */
19 : /*******************************************************************/
20 : /* min(v, v(Log_p Norm_{F_\p/Q_p}(x))) */
21 : static long
22 294 : vlognorm(GEN nf, GEN T, GEN x, GEN p, long v)
23 : {
24 294 : GEN a = nf_to_scalar_or_alg(nf, x);
25 294 : GEN N = RgXQ_norm(a, T);
26 294 : if (typ(N) != t_PADIC) N = cvtop(N, p, v);
27 294 : return minss(v, valp( Qp_log(N) ));
28 : }
29 : /* K number field, pr a maximal ideal, let K_pr be the attached local
30 : * field, K_pr = Q_p[X] / (T), T irreducible. Return \tilde{e}(K_pr/Q_p) */
31 : static long
32 553 : etilde(GEN nf, GEN pr, GEN T)
33 : {
34 553 : GEN gp = pr_get_p(pr);
35 553 : ulong e = pr_get_e(pr);
36 : long v, voo, vmin, p, k;
37 :
38 553 : if (!u_pval(e, gp))
39 : {
40 448 : v = u_pval(pr_get_f(pr), gp);
41 448 : return itou( mului(e, powiu(gp, v)) );
42 : }
43 105 : p = itou(gp);
44 105 : k = e / (p-1) + 1;
45 : /* log Norm_{F_P/Q_p} (1 + P^k) = Tr(P^k) = p^[(k + v(Diff))/ e] Z_p */
46 105 : voo = (k + idealval(nf, nf_get_diff(nf), pr)) / e;
47 105 : vmin = vlognorm(nf, T, pr_get_gen(pr), gp, voo);
48 105 : if (k > 1)
49 : {
50 105 : GEN U = idealprincipalunits(nf, pr, k);
51 105 : GEN gen = abgrp_get_gen(U), cyc = abgrp_get_cyc(U);
52 105 : long i, l = lg(cyc);
53 294 : for (i = 1; i < l; i++)
54 : {
55 189 : if (voo - Z_lval(gel(cyc,i), p) >= vmin) break;
56 189 : vmin = vlognorm(nf, T, gel(gen,i), gp, vmin);
57 : }
58 : }
59 105 : v = u_lval(degpol(T), p) + (p == 2UL? 2 : 1) - vmin;
60 105 : (void)u_lvalrem(e, p, &e);
61 105 : return e * upowuu(p,v);
62 : }
63 : static long
64 490 : ftilde_from_e(GEN pr, long e) { return pr_get_e(pr) * pr_get_f(pr) / e; }
65 : /* true nf */
66 : static long
67 490 : ftilde(GEN nf, GEN pr, GEN T) { return ftilde_from_e(pr, etilde(nf, pr, T)); }
68 :
69 : static long
70 560 : get_ZpX_index(GEN K, GEN pr, GEN T)
71 : {
72 : GEN p, pi;
73 560 : long j, l = lg(T);
74 560 : if (l == 2) return 1;
75 434 : p = pr_get_p(pr); pi = nf_to_scalar_or_alg(K, pr_get_gen(pr));
76 1323 : for (j = 1; j < l; j++)
77 : {
78 1323 : GEN t = gel(T,j);
79 1323 : if (t && gvaluation(RgXQ_norm(pi, t), p)) return j;
80 : }
81 0 : return 0;
82 : }
83 :
84 : /* Given a number field K and a prime p, return
85 : * S = places of K above p [primedec]
86 : * R = corresponding p-adic factors of K.pol (mod p^k), in the same order */
87 : static GEN
88 245 : padicfact(GEN K, GEN S, long k)
89 : {
90 245 : GEN R, p = pr_get_p(gel(S,1));
91 245 : GEN T = gel(factorpadic(nf_get_pol(K), p, k), 1);
92 : long l, i;
93 245 : S = idealprimedec(K, p);
94 245 : R = cgetg_copy(S, &l);
95 784 : for (i = 1; i < l; i++)
96 : {
97 539 : long j = get_ZpX_index(K, gel(S,i), T);
98 539 : gel(R,i) = gel(T,j);
99 539 : gel(T,j) = NULL;
100 : }
101 245 : return R;
102 : }
103 :
104 : /* K a bnf, compute Cl'(K) = ell-Sylow of Cl(K) / (places above ell).
105 : * Return [D, u, R0, U0, ordS]
106 : * - D: cyclic factors for Cl'(K)
107 : * - u: generators of cyclic factors (all coprime to ell)
108 : * - R0: subgroup isprincipal(<S>) (divides K.cyc)
109 : * - U0: generators of R0 are of the form S . U0
110 : * - ordS[i] = order of S[i] in CL(K) */
111 : static GEN
112 182 : CL_prime(GEN K, GEN ell, GEN Sell)
113 : {
114 182 : GEN g, ordS, R0, U0, U, D, u, cyc = bnf_get_cyc(K);
115 182 : long i, l, lD, lS = lg(Sell);
116 :
117 182 : g = leafcopy(bnf_get_gen(K));
118 182 : l = lg(g);
119 518 : for (i = 1; i < l; i++)
120 : {
121 336 : GEN A = gel(g,i), a = gcoeff(A,1,1);
122 336 : long v = Z_pvalrem(a, ell, &a);
123 336 : if (v) gel(g,i) = hnfmodid(A, a); /* make coprime to ell */
124 : }
125 182 : R0 = cgetg(lS, t_MAT);
126 182 : ordS = cgetg(lS, t_VEC);
127 651 : for (i = 1; i < lS; i++)
128 : {
129 469 : gel(R0,i) = isprincipal(K, gel(Sell,i));
130 469 : gel(ordS,i) = charorder(cyc, gel(R0,i)); /* order of Sell[i] */
131 : }
132 182 : R0 = shallowconcat(R0, diagonal_shallow(cyc));
133 : /* R0 = subgroup generated by S in Cl(K) [ divides diagonal(K.cyc) ]*/
134 182 : R0 = ZM_hnfall(R0, &U0, 2); /* [S | cyc] * U0 = R0 in HNF */
135 182 : D = ZM_snfall(R0, &U,NULL);
136 182 : D = RgM_diagonal_shallow(D);
137 182 : lD = lg(D);
138 182 : u = ZM_inv(U, NULL); settyp(u, t_VEC);
139 518 : for (i = 1; i < lD; i++) gel(u,i) = idealfactorback(K,g,gel(u,i),1);
140 182 : setlg(U0, l);
141 182 : U0 = rowslice(U0,1,lS-1); /* restrict to 'S' part */
142 182 : return mkvec5(D, u, R0, U0, ordS);
143 : }
144 :
145 : static GEN
146 203 : ell1(GEN ell) { return equaliu(ell,2)? utoipos(5): addiu(ell,1); }
147 :
148 : /* log N_{F_P/Q_p}(x) */
149 : static GEN
150 182505 : vtilde_i(GEN K, GEN x, GEN T, GEN ell, long prec)
151 : {
152 : GEN N, cx;
153 182505 : if (typ(x) != t_POL) x = nf_to_scalar_or_alg(K, x);
154 182505 : if (typ(x) != t_POL) { cx = x; N = NULL; }
155 : else
156 : {
157 168655 : x = Q_primitive_part(x,&cx);
158 168655 : N = resultant(RgX_rem(x,T), T);
159 168655 : N = cvtop(N,ell,prec);
160 : }
161 182505 : if (cx)
162 : {
163 180959 : (void)Q_pvalrem(cx, ell, &cx);
164 180959 : if (!isint1(cx))
165 : {
166 170781 : cx = gpowgs(cvtop(cx,ell,prec), degpol(T));
167 170781 : N = N? gmul(N, cx): cx;
168 : }
169 : }
170 182505 : return N? Qp_log(N): gen_0;
171 : }
172 : static GEN
173 3178 : vecvtilde_i(GEN K, GEN x, GEN T, GEN ell, long prec)
174 184647 : { pari_APPLY_same(vtilde_i(K, gel(x,i), T, ell, prec)); }
175 : static GEN
176 4214 : vtilde(GEN K, GEN x, GEN T, GEN deg, GEN ell, long prec)
177 : {
178 : pari_sp av;
179 : GEN v, G, E;
180 4214 : if (typ(x) != t_MAT) return gdiv(vtilde_i(K,x,T,ell,prec), deg);
181 3178 : G = gel(x,1);
182 3178 : E = gel(x,2); av = avma; v = vecvtilde_i(K,G,T,ell,prec);
183 3178 : return gerepileupto(av, gdiv(RgV_dotproduct(E, v), deg));
184 : }
185 :
186 : /* v[i] = deg S[i] mod p^prec */
187 : static GEN
188 182 : get_vdegS(GEN Ftilde, GEN ell, long prec)
189 : {
190 182 : long i, l = lg(Ftilde);
191 182 : GEN v = cgetg(l, t_VEC), degell = Qp_log( cvtop(ell1(ell), ell, prec) );
192 651 : for (i = 1; i < l; i++) gel(v,i) = gmulsg(Ftilde[i], degell);
193 182 : return v;
194 : }
195 : /* K a bnf. Compute kernel \tilde{Cl}_K(ell); return cyclic factors.
196 : * Set *pM to (vtilde_S[i](US[j]))_{i,j} */
197 : static GEN
198 182 : CL_tilde(GEN K, GEN US, GEN ell, GEN T, long imin, GEN vdegS,
199 : GEN *pM, long prec)
200 : {
201 182 : long i, j, k, lD, l = lg(T), lU = lg(US);
202 : GEN D, M, ellk;
203 :
204 : /* p = P^e: \tilde{Cl}(l) = (1) */
205 182 : if (l == 2) { *pM = cgetg(1, t_MAT); return cgetg(1, t_VEC); }
206 133 : M = cgetg(lU, t_MAT);
207 805 : for (j = 1; j < lU; j++)
208 : {
209 672 : GEN c = cgetg(l, t_COL), a = gel(US,j);
210 3892 : for (i = 1; i < l; i++)
211 3220 : gel(c,i) = vtilde(K, a, gel(T,i), gel(vdegS,i), ell, prec);
212 672 : gel(M,j) = c;
213 : }
214 133 : k = padicprec(M, ell); ellk = powiu(ell, k);
215 133 : *pM = M = gmod(M, ellk);
216 133 : M = ZM_hnfmodid(rowsplice(M, imin), ellk);
217 133 : D = matsnf0(M, 4); lD = lg(D);
218 133 : if (lD > 1 && Z_pval(gel(D,1), ell) >= k) return NULL;
219 133 : return D;
220 : }
221 :
222 : /* [L:K] = ell^k; return 1 if L/K is locally cyclotomic at ell, 0 otherwise */
223 : long
224 35 : rnfislocalcyclo(GEN rnf)
225 : {
226 35 : pari_sp av = avma;
227 : GEN K, L, S, SK, TK, SLs, SL2, TL, ell;
228 : ulong ll;
229 : long i, j, k, lk, lSK;
230 35 : checkrnf(rnf);
231 35 : lk = rnf_get_degree(rnf);
232 35 : if (lk == 1) return 1;
233 28 : k = uisprimepower(lk, &ll);
234 28 : if (!k) pari_err_IMPL("rnfislocalcyclo for non-l-extensions");
235 21 : ell = utoi(ll);
236 21 : K = rnf_get_nf(rnf);
237 21 : L = rnf_build_nfabs(rnf, nf_get_prec(K));
238 21 : S = rnfidealprimedec(rnf, ell);
239 21 : SK = gel(S,1);
240 21 : SLs = gel(S,2);
241 21 : SL2 = shallowconcat1(SLs);
242 21 : TK = padicfact(K, SK, 100); lSK = lg(SK);
243 21 : TL = padicfact(L, SL2, 100);
244 35 : for (i = 1; i < lSK; i++)
245 : {
246 21 : long eK = etilde(K, gel(SK,i), gel(TK,i));
247 21 : GEN SL = gel(SLs,i);
248 21 : long lSL = lg(SL);
249 35 : for (j = 1; j < lSL; j++)
250 : {
251 21 : long iS = gen_search(SL2, gel(SL,j), (void*)&cmp_prime_over_p,
252 : &cmp_nodata);
253 21 : long eL = etilde(L, gel(SL,j), gel(TL,iS));
254 21 : if (dvdui(eL/eK, ell)) return gc_long(av,0);
255 : }
256 : };
257 14 : return gc_long(av,1);
258 : }
259 :
260 : #if 0
261 : /* Return 1 if L/Q is locally cyclotomic at ell */
262 : static int
263 : islocalcycloQ(GEN L, GEN ell)
264 : {
265 : GEN SL = idealprimedec(L,ell), TL;
266 : long i, lSL = lg(SL);
267 : TL = padicfact(L, SL, 100);
268 : for (i = 1; i < lSL; i++)
269 : {
270 : long eL = etilde(L, gel(SL,i), gel(TL,i));
271 : if (dvdui(eL,ell)) return 0;
272 : }
273 : return 1;
274 : }
275 : #endif
276 :
277 : /* true nf, pr a prid */
278 : static long
279 105 : nfislocalpower_i(GEN nf, GEN pr, GEN a, GEN n)
280 : {
281 : long v, e, t;
282 : GEN p, G, L;
283 105 : a = nf_to_scalar_or_basis(nf,a);
284 105 : if (!signe(n)) return isint1(a);
285 91 : v = nfvalrem(nf, a, pr, &a); if (!dvdsi(v, n)) return 0;
286 77 : p = pr_get_p(pr);
287 77 : v = Z_pvalrem(n, p, &n);
288 77 : if (!equali1(n))
289 : {
290 28 : GEN T, modpr = zk_to_Fq_init(nf, &pr, &T, &p);
291 28 : GEN ap = nf_to_Fq(nf, a, modpr);
292 28 : if (!Fq_ispower(ap, n, T, p)) return 0;
293 : }
294 70 : if (!v) return 1;
295 63 : e = pr_get_e(pr);
296 63 : if (v == 1) /* optimal formula */
297 49 : t = itos( divii(mului(e,p), subiu(p,1)) ) + 1;
298 : else /* straight Hensel */
299 14 : t = 2 * e * v + 1;
300 63 : G = Idealstarprk(nf, pr, t, nf_INIT);
301 63 : L = ideallogmod(nf, a, G, powiu(p, v));
302 63 : return ZV_equal0(L) || ZV_pval(L, p) >= v;
303 : }
304 : long
305 119 : nfislocalpower(GEN nf, GEN pr, GEN a, GEN n)
306 : {
307 119 : pari_sp av = avma;
308 119 : if (typ(n) != t_INT) pari_err_TYPE("nfislocalpower",n);
309 119 : nf = checknf(nf); checkprid(pr);
310 105 : return gc_long(av, nfislocalpower_i(nf, pr, a, n));
311 : }
312 :
313 : /* v_ell( exponent(D) ) */
314 : static long
315 364 : ellexpo(GEN D, GEN ell) { return lg(D) == 1? 0: Z_pval(gel(D,1), ell); }
316 :
317 : static GEN
318 161 : ellsylow(GEN cyc, GEN ell)
319 : {
320 : long i, l;
321 161 : GEN d = cgetg_copy(cyc, &l);
322 343 : for (i = 1; i < l; i++)
323 : {
324 266 : GEN c = gel(cyc,i), a;
325 266 : if (!Z_pvalrem(c, ell, &a)) break;
326 182 : gel(d,i) = diviiexact(c, a);
327 : }
328 161 : setlg(d, i); return d;
329 : }
330 :
331 : static long
332 20140 : vnorm_x(GEN nf, GEN x, GEN ell)
333 : {
334 20140 : x = nf_to_scalar_or_alg(nf,x);
335 20140 : if (typ(x) != t_POL) return 0;
336 17906 : x = Q_primpart(x);
337 17906 : return Q_pval(nfnorm(nf,x), ell);
338 : }
339 : static long
340 469 : vtilde_prec_x(GEN nf, GEN x, GEN ell)
341 : {
342 : long i, l, v;
343 : GEN G;
344 469 : if (typ(x) != t_MAT) return vnorm_x(nf,x,ell);
345 469 : G = gel(x,1); l = lg(G); v = 0;
346 20609 : for (i = 1; i < l; i++) v = maxss(v, vnorm_x(nf,gel(G,i),ell));
347 469 : return v;
348 : }
349 : /* upper bound for \delta(vec): estimate loss of accuracy when evaluating
350 : * \tilde{v} on the vec[i] */
351 : static long
352 182 : vtilde_prec(GEN nf, GEN vec, GEN ell)
353 : {
354 182 : long v0 = 0, i, l = lg(vec);
355 651 : for (i = 1; i < l; i++)
356 469 : v0 = maxss(v0, vtilde_prec_x(nf, gel(vec,i), ell));
357 182 : return 3 + v0 + z_pval(nf_get_degree(nf), ell);
358 : }
359 : static GEN
360 182 : get_Ftilde(GEN nf, GEN S, GEN T, GEN ell, long *pimin)
361 : {
362 182 : long j, lS = lg(S), vmin = lS;
363 182 : GEN Ftilde = cgetg(lS, t_VECSMALL);
364 182 : *pimin = 1;
365 651 : for (j = 1; j < lS; j++)
366 : {
367 469 : long f = ftilde(nf, gel(S,j), gel(T,j)), v = z_pval(f, ell);
368 469 : Ftilde[j] = f; if (v < vmin) { vmin = v; *pimin = j; }
369 : }
370 182 : return Ftilde;
371 : }
372 : static GEN
373 182 : bnflog_i(GEN bnf, GEN ell)
374 : {
375 : long prec0, prec;
376 : GEN nf, US, vdegS, S, T, M, CLp, CLt, Ftilde, vtG, ellk;
377 : GEN D, Ap, cycAp, fu;
378 : long imin, i, j, lvAp;
379 :
380 182 : bnf = checkbnf(bnf); nf = bnf_get_nf(bnf);
381 182 : S = idealprimedec(nf, ell);
382 182 : US = sunits_mod_units(bnf, S);
383 182 : prec0 = maxss(30, vtilde_prec(nf, US, ell));
384 182 : if (!(fu = bnf_build_cheapfu(bnf)) && !(fu = bnf_compactfu(bnf)))
385 0 : bnf_build_units(bnf);
386 182 : US = shallowconcat(fu, US);
387 182 : settyp(US, t_COL);
388 182 : T = padicfact(nf, S, prec0);
389 182 : Ftilde = get_Ftilde(nf, S, T, ell, &imin);
390 182 : CLp = CL_prime(bnf, ell, S);
391 182 : cycAp = gel(CLp,1);
392 182 : Ap = gel(CLp,2);
393 : for(;;)
394 : {
395 182 : vdegS = get_vdegS(Ftilde, ell, prec0);
396 182 : CLt = CL_tilde(nf, US, ell, T, imin, vdegS, &vtG, prec0);
397 182 : if (CLt) break;
398 0 : prec0 <<= 1;
399 0 : T = padicfact(nf, S, prec0);
400 : }
401 182 : prec = ellexpo(cycAp, ell) + ellexpo(CLt,ell) + 1;
402 182 : if (prec == 1) return mkvec3(cgetg(1,t_VEC), cgetg(1,t_VEC), cgetg(1,t_VEC));
403 :
404 161 : ellk = powiu(ell, prec);
405 161 : lvAp = lg(Ap);
406 161 : if (lvAp > 1)
407 : {
408 154 : long lS = lg(S);
409 154 : GEN Kcyc = bnf_get_cyc(bnf);
410 154 : GEN C = zeromatcopy(lvAp-1, lS-1);
411 154 : GEN Rell = gel(CLp,3), Uell = gel(CLp,4), ordS = gel(CLp,5);
412 476 : for (i = 1; i < lvAp; i++)
413 : {
414 322 : GEN a, b, bi, A = gel(Ap,i), d = gel(cycAp,i);
415 322 : bi = isprincipal(bnf, A);
416 322 : a = ZV_ZV_mod(ZC_Z_mul(bi,d), Kcyc);
417 : /* a in subgroup generated by S = Rell; hence b integral */
418 322 : b = hnf_invimage(Rell, a);
419 322 : b = ZV_ZV_mod(ZM_ZC_mul(Uell, ZC_neg(b)), ordS);
420 322 : A = mkvec2(A, trivial_fact());
421 322 : A = idealpowred(nf, A, d);
422 : /* find a principal representative of A_i^cycA_i up to elements of S */
423 322 : a = isprincipalfact(bnf,gel(A,1),S,b,nf_GENMAT|nf_FORCE);
424 322 : if (!gequal0(gel(a,1))) pari_err_BUG("bnflog");
425 322 : a = famat_mul_shallow(gel(A,2), gel(a,2)); /* principal part */
426 322 : if (lg(a) == 1) continue;
427 1316 : for (j = 1; j < lS; j++)
428 994 : gcoeff(C,i,j) = vtilde(nf, a, gel(T,j), gel(vdegS,j), ell, prec0);
429 : }
430 154 : C = gmod(gneg(C),ellk);
431 154 : C = shallowtrans(C);
432 154 : M = mkmat2(mkcol2(diagonal_shallow(cycAp), C), mkcol2(gen_0, vtG));
433 154 : M = shallowmatconcat(M); /* relation matrix */
434 : }
435 : else
436 7 : M = vtG;
437 161 : M = ZM_hnfmodid(M, ellk);
438 161 : D = matsnf0(M, 4);
439 161 : if (lg(D) == 1 || !dvdii(gel(D,1), ellk))
440 0 : pari_err_BUG("bnflog [missing Z_l component]");
441 161 : D = vecslice(D,2,lg(D)-1);
442 161 : return mkvec3(D, CLt, ellsylow(cycAp, ell));
443 : }
444 : GEN
445 182 : bnflog(GEN bnf, GEN ell)
446 : {
447 182 : pari_sp av = avma;
448 182 : return gerepilecopy(av, bnflog_i(bnf, ell));
449 : }
450 :
451 : GEN
452 42 : bnflogef(GEN nf, GEN pr)
453 : {
454 42 : pari_sp av = avma;
455 : long e, f, ef;
456 : GEN p;
457 42 : checkprid(pr); p = pr_get_p(pr);
458 42 : nf = checknf(nf);
459 42 : e = pr_get_e(pr);
460 42 : f = pr_get_f(pr); ef = e*f;
461 42 : if (u_pval(ef, p))
462 : {
463 21 : GEN T = gel(factorpadic(nf_get_pol(nf), p, 100), 1);
464 21 : long j = get_ZpX_index(nf, pr, T);
465 21 : e = etilde(nf, pr, gel(T,j));
466 21 : f = ef / e;
467 : }
468 42 : set_avma(av); return mkvec2s(e,f);
469 : }
470 :
471 : GEN
472 21 : bnflogdegree(GEN nf, GEN A, GEN ell)
473 : {
474 21 : pari_sp av = avma;
475 : GEN AZ, A0Z, NA0;
476 : long vAZ;
477 :
478 21 : if (typ(ell) != t_INT) pari_err_TYPE("bnflogdegree", ell);
479 21 : nf = checknf(nf);
480 21 : A = idealhnf_shallow(nf, A);
481 21 : AZ = gcoeff(A,1,1);
482 21 : vAZ = Z_pvalrem(AZ, ell, &A0Z);
483 21 : if (is_pm1(A0Z))
484 0 : NA0 = gen_1;
485 : else
486 21 : (void)Z_pvalrem(idealnorm(nf,A), ell, &NA0);
487 21 : if (vAZ)
488 : {
489 21 : GEN Aell = ZM_hnfmodid(A, powiu(ell,vAZ));
490 21 : GEN S = idealprimedec(nf, ell), T;
491 21 : long l, i, s = 0;
492 21 : T = padicfact(nf, S, 100);
493 21 : l = lg(S);
494 49 : for (i = 1; i < l; i++)
495 : {
496 28 : GEN P = gel(S,i);
497 28 : long v = idealval(nf, Aell, P);
498 28 : if (v) s += v * ftilde(nf, P, gel(T,i));
499 : }
500 21 : if (s) NA0 = gmul(NA0, gpowgs(ell1(ell), s));
501 : }
502 21 : return gerepileupto(av, NA0);
503 : }
|
