Line data Source code
1 : /* Copyright (C) 2020 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 : #include "pari.h"
15 : #include "paripriv.h"
16 :
17 : #define DEBUGLEVEL DEBUGLEVEL_bnf
18 :
19 : /* if x a famat, assume it is a true unit (very costly to check even that
20 : * it's an algebraic integer) */
21 : GEN
22 1645 : bnfisunit(GEN bnf, GEN x)
23 : {
24 1645 : long tx = typ(x), i, r1, RU, e, n, prec;
25 1645 : pari_sp av = avma;
26 : GEN t, logunit, ex, nf, pi2_sur_w, rx, emb, arg;
27 :
28 1645 : bnf = checkbnf(bnf); nf = bnf_get_nf(bnf);
29 1645 : RU = lg(bnf_get_logfu(bnf));
30 1645 : n = bnf_get_tuN(bnf); /* # { roots of 1 } */
31 1645 : if (tx == t_MAT)
32 : { /* famat, assumed OK */
33 1309 : if (lg(x) != 3) pari_err_TYPE("bnfisunit [not a factorization]", x);
34 : } else {
35 336 : x = nf_to_scalar_or_basis(nf,x);
36 336 : if (typ(x) != t_COL)
37 : { /* rational unit ? */
38 : GEN v;
39 : long s;
40 140 : if (typ(x) != t_INT || !is_pm1(x)) return cgetg(1,t_COL);
41 133 : s = signe(x); set_avma(av); v = zerocol(RU);
42 133 : gel(v,RU) = utoi((s > 0)? 0: n>>1);
43 133 : return v;
44 : }
45 196 : if (!isint1(Q_denom(x))) retgc_const(av, cgetg(1, t_COL));
46 : }
47 :
48 1505 : r1 = nf_get_r1(nf);
49 1505 : prec = nf_get_prec(nf);
50 1505 : for (i = 1;; i++)
51 0 : {
52 : GEN rlog;
53 1505 : nf = bnf_get_nf(bnf);
54 1505 : logunit = bnf_get_logfu(bnf);
55 1505 : rlog = real_i(logunit);
56 1505 : rx = nflogembed(nf,x,&emb, prec);
57 1505 : if (rx)
58 : {
59 1505 : GEN logN = RgV_sum(rx); /* log(Nx), should be ~ 0 */
60 1505 : if (gexpo(logN) > -20)
61 : { /* precision problem ? */
62 14 : if (typ(logN) != t_REAL) retgc_const(av, cgetg(1, t_COL)); /*no*/
63 28 : if (i == 1 && typ(x) != t_MAT &&
64 28 : !is_pm1(nfnorm(nf, x))) retgc_const(av, cgetg(1, t_COL));
65 : }
66 : else
67 : {
68 504 : ex = RU == 1? cgetg(1,t_COL)
69 1491 : : RgM_solve(rlog, rx); /* ~ fundamental units exponents */
70 1491 : if (ex) { ex = grndtoi(ex, &e); if (e < -4) break; }
71 : }
72 : }
73 0 : if (i == 1)
74 0 : prec = nbits2prec(gexpo(x) + 128);
75 : else
76 : {
77 0 : if (i > 4) pari_err_PREC("bnfisunit");
78 0 : prec = precdbl(prec);
79 : }
80 0 : if (DEBUGLEVEL) pari_warn(warnprec,"bnfisunit",prec);
81 0 : bnf = bnfnewprec_shallow(bnf, prec);
82 : }
83 : /* choose a large embedding => small relative error */
84 2069 : for (i = 1; i < RU; i++)
85 1418 : if (signe(gel(rx,i)) > -1) break;
86 1491 : if (RU == 1) t = gen_0;
87 : else
88 : {
89 987 : t = imag_i( row_i(logunit,i, 1,RU-1) );
90 987 : t = RgV_dotproduct(t, ex);
91 987 : if (i > r1) t = gmul2n(t, -1);
92 : }
93 1491 : if (typ(emb) != t_MAT) arg = garg(gel(emb,i), prec);
94 : else
95 : {
96 1309 : GEN p = gel(emb,1), e = gel(emb,2);
97 1309 : long j, l = lg(p);
98 1309 : arg = NULL;
99 62132 : for (j = 1; j < l; j++)
100 : {
101 60823 : GEN a = gmul(gel(e,j), garg(gel(gel(p,j),i), prec));
102 60823 : arg = arg? gadd(arg, a): a;
103 : }
104 : }
105 1491 : t = gsub(arg, t); /* = arg(the missing root of 1) */
106 1491 : pi2_sur_w = divru(mppi(prec), n>>1); /* 2pi / n */
107 1491 : e = umodiu(roundr(divrr(t, pi2_sur_w)), n);
108 1491 : if (n > 2)
109 : {
110 7 : GEN z = algtobasis(nf, bnf_get_tuU(bnf)); /* primitive root of 1 */
111 7 : GEN ro = RgV_dotproduct(row(nf_get_M(nf), i), z);
112 7 : GEN p2 = roundr(divrr(garg(ro, prec), pi2_sur_w));
113 7 : e *= Fl_inv(umodiu(p2,n), n);
114 7 : e %= n;
115 : }
116 1491 : gel(ex,RU) = utoi(e); setlg(ex, RU+1); return gc_GEN(av, ex);
117 : }
118 :
119 : /* split M a square ZM in HNF as [H, B; 0, Id], H in HNF without 1-eigenvalue */
120 : static GEN
121 1015 : hnfsplit(GEN M, GEN *pB)
122 : {
123 1015 : long i, l = lg(M);
124 3531 : for (i = l-1; i; i--)
125 3230 : if (!equali1(gcoeff(M,i,i))) break;
126 1015 : if (!i) { *pB = zeromat(0, l-1); return cgetg(1, t_MAT); }
127 714 : *pB = matslice(M, 1, i, i+1, l-1); return matslice(M, 1, i, 1, i);
128 : }
129 :
130 : /* S a list of prime ideal in idealprimedec format. If pH != NULL, set it to
131 : * the HNF of the S-class group and return bnfsunit, else return bnfunits */
132 : static GEN
133 1449 : bnfsunit_i(GEN bnf, GEN S, GEN *pH, GEN *pA, GEN *pden)
134 : {
135 1449 : long FLAG, i, lS = lg(S);
136 : GEN M, U1, U2, U, V, H, Sunit, B, g;
137 :
138 1449 : if (!is_vec_t(typ(S))) pari_err_TYPE("bnfsunit",S);
139 1449 : bnf = checkbnf(bnf);
140 1449 : if (lS == 1)
141 : {
142 434 : *pA = cgetg(1,t_MAT);
143 434 : *pden = gen_1; return cgetg(1,t_VEC);
144 : }
145 1015 : M = cgetg(lS,t_MAT); /* relation matrix for the S class group */
146 1015 : g = cgetg(lS,t_MAT); /* principal part */
147 1015 : FLAG = pH ? 0: nf_GENMAT;
148 6111 : for (i = 1; i < lS; i++)
149 : {
150 5096 : GEN pr = gel(S,i);
151 5096 : checkprid(pr);
152 5096 : if (pH)
153 1855 : gel(M,i) = isprincipal(bnf, pr);
154 : else
155 : {
156 3241 : GEN v = bnfisprincipal0(bnf, pr, FLAG);
157 3241 : gel(M,i) = gel(v,1);
158 3241 : gel(g,i) = gel(v,2);
159 : }
160 : }
161 : /* S class group and S units, use ZM_hnflll to get small 'U' */
162 1015 : M = shallowconcat(M, diagonal_shallow(bnf_get_cyc(bnf)));
163 1015 : H = ZM_hnflll(M, &U, 1); setlg(U, lS); if (pH) *pH = H;
164 1015 : U1 = rowslice(U,1, lS-1);
165 1015 : U2 = rowslice(U,lS, lg(M)-1); /* (M | cyc) [U1; U2] = 0 */
166 1015 : H = ZM_hnflll(U1, pH? NULL: &V, 0);
167 : /* U1 = upper left corner of U, invertible. S * U1 = principal ideals
168 : * whose generators generate the S-units */
169 1015 : H = hnfsplit(H, &B);
170 : /* [ H B ] [ H^-1 - H^-1 B ]
171 : * U1 * V = HNF(U1) = [ 0 Id ], inverse = [ 0 Id ]
172 : * S * HNF(U1) = integral generators for S-units = Sunit */
173 1015 : Sunit = cgetg(lS, t_VEC);
174 1015 : if (pH)
175 : {
176 168 : long nH = lg(H) - 1;
177 168 : FLAG = nf_FORCE | nf_GEN;
178 2023 : for (i = 1; i < lS; i++)
179 : {
180 1855 : GEN C = NULL, E;
181 1855 : if (i <= nH) E = gel(H,i); else { C = gel(S,i), E = gel(B,i-nH); }
182 1855 : gel(Sunit,i) = gel(isprincipalfact(bnf, C, S, E, FLAG), 2);
183 : }
184 : }
185 : else
186 : {
187 847 : GEN cycgen = bnf_build_cycgen(bnf);
188 847 : U1 = ZM_mul(U1, V);
189 847 : U2 = ZM_mul(U2, V);
190 847 : FLAG = nf_FORCE | nf_GENMAT;
191 4088 : for (i = 1; i < lS; i++)
192 : {
193 3241 : GEN a = famatV_factorback(g, gel(U1,i));
194 3241 : GEN b = famatV_factorback(cycgen, ZC_neg(gel(U2,i)));
195 3241 : gel(Sunit,i) = famat_reduce(famat_mul(a, b));
196 : }
197 : }
198 1015 : H = ZM_inv(H, pden);
199 1015 : *pA = shallowconcat(H, ZM_neg(ZM_mul(H,B))); /* top inverse * den */
200 1015 : return Sunit;
201 : }
202 : GEN
203 175 : bnfsunit(GEN bnf,GEN S,long prec)
204 : {
205 175 : pari_sp av = avma;
206 175 : long i, l = lg(S);
207 175 : GEN v, R, nf, A, den, U, cl, H = NULL;
208 175 : bnf = checkbnf(bnf); nf = bnf_get_nf(bnf);
209 175 : v = cgetg(7, t_VEC);
210 175 : gel(v,1) = U = bnfsunit_i(bnf, S, &H, &A, &den);
211 175 : gel(v,2) = mkvec2(A, den);
212 175 : gel(v,3) = cgetg(1,t_VEC); /* dummy */
213 175 : R = bnf_get_reg(bnf);
214 175 : cl = bnf_get_clgp(bnf);
215 175 : if (l != 1)
216 : {
217 168 : GEN u,A, G = bnf_get_gen(bnf), D = ZM_snf_group(H,NULL,&u), h = ZV_prod(D);
218 168 : long lD = lg(D);
219 168 : A = cgetg(lD, t_VEC);
220 189 : for(i = 1; i < lD; i++) gel(A,i) = idealfactorback(nf, G, gel(u,i), 1);
221 168 : cl = mkvec3(h, D, A);
222 168 : R = mpmul(R, h);
223 2023 : for (i = 1; i < l; i++)
224 : {
225 1855 : GEN pr = gel(S,i), p = pr_get_p(pr);
226 1855 : long f = pr_get_f(pr);
227 1855 : R = mpmul(R, logr_abs(itor(p,prec)));
228 1855 : if (f != 1) R = mulru(R, f);
229 1855 : gel(U,i) = nf_to_scalar_or_alg(nf, gel(U,i));
230 : }
231 : }
232 175 : gel(v,4) = R;
233 175 : gel(v,5) = cl;
234 175 : gel(v,6) = S; return gc_GEN(av, v);
235 : }
236 : GEN
237 1092 : bnfunits(GEN bnf, GEN S)
238 : {
239 1092 : pari_sp av = avma;
240 : GEN A, den, U, fu, tu;
241 1092 : bnf = checkbnf(bnf);
242 1092 : U = bnfsunit_i(bnf, S? S: cgetg(1,t_VEC), NULL, &A, &den);
243 1092 : if (!S) S = cgetg(1,t_VEC);
244 1092 : fu = bnf_compactfu(bnf);
245 1092 : if (!fu)
246 : {
247 : long i, l;
248 231 : fu = bnf_has_fu(bnf); if (!fu) bnf_build_units(bnf);
249 231 : fu = shallowcopy(fu); l = lg(fu);
250 686 : for (i = 1; i < l; i++) gel(fu,i) = to_famat_shallow(gel(fu,i),gen_1);
251 : }
252 1092 : tu = nf_to_scalar_or_basis(bnf_get_nf(bnf), bnf_get_tuU(bnf));
253 1092 : U = shallowconcat(U, vec_append(fu, to_famat_shallow(tu,gen_1)));
254 1092 : return gc_GEN(av, mkvec4(U, S, A, den));
255 : }
256 : GEN
257 182 : sunits_mod_units(GEN bnf, GEN S)
258 : {
259 182 : pari_sp av = avma;
260 : GEN A, den;
261 182 : bnf = checkbnf(bnf);
262 182 : return gc_GEN(av, bnfsunit_i(bnf, S, NULL, &A, &den));
263 : }
264 :
265 : /* v_S(x), x in famat form */
266 : static GEN
267 105 : sunit_famat_val(GEN nf, GEN S, GEN x)
268 : {
269 105 : long i, l = lg(S);
270 105 : GEN v = cgetg(l, t_VEC);
271 1085 : for (i = 1; i < l; i++) gel(v,i) = famat_nfvalrem(nf, x, gel(S,i), NULL);
272 105 : return v;
273 : }
274 : /* v_S(x) */
275 : static GEN
276 1498 : sunit_val(GEN nf, GEN S, GEN x)
277 : {
278 1498 : long i, l = lg(S);
279 1498 : GEN v, Nx, dx, Ndx = gen_1;
280 1498 : if (isintzero(x)) return NULL;
281 1498 : v = zerocol(l-1);
282 1498 : x = Q_remove_denom(x, &dx);
283 1498 : Nx = idealnorm(nf, x);
284 1498 : if (dx) Ndx = powiu(dx, nf_get_degree(nf)); else if (is_pm1(Nx)) return v;
285 37121 : for (i = 1; i < l; i++)
286 : {
287 35896 : GEN P = gel(S,i), p = pr_get_p(P);
288 35896 : long f = pr_get_f(P), vn = 0, vd = 0;
289 35896 : if (dvdii(Nx, p))
290 : {
291 2170 : vn = nfval(nf, x, P);
292 2170 : if (vn) Nx = diviiexact(Nx, powiu(p, vn * f));
293 : }
294 35896 : if (dx && dvdii(dx, p))
295 : {
296 35 : vd = pr_get_e(P) * Z_pval(dx, p);
297 35 : if (vd) Ndx = diviiexact(Ndx, powiu(p, vd * f));
298 : }
299 35896 : vn -= vd; if (vn) gel(v,i) = stoi(vn);
300 : }
301 1225 : return is_pm1(Nx) && is_pm1(Ndx)? v: NULL;
302 : }
303 :
304 : /* if *px a famat, assume it's an S-unit */
305 : static GEN
306 1631 : make_unit(GEN nf, GEN U, GEN *px)
307 : {
308 1631 : GEN den, v, w, A, gen = gel(U,1), S = gel(U,2), x = *px;
309 1631 : long cH, i, l = lg(S);
310 :
311 1631 : if (l == 1) return cgetg(1, t_COL);
312 1603 : A = gel(U,3); den = gel(U,4);
313 1603 : cH = nbrows(A);
314 1603 : if (typ(x) == t_MAT && lg(x) == 3)
315 105 : w = sunit_famat_val(nf, S, x); /* x = S v */
316 : else
317 : {
318 1498 : x = nf_to_scalar_or_basis(nf,x);
319 1498 : w = sunit_val(nf, S, x);
320 1498 : if (!w) return NULL;
321 : }
322 1582 : v = ZM_ZC_mul(A, w);
323 1582 : w += cH; w[0] = evaltyp(t_COL) | _evallg(lg(A) - cH);
324 2810 : if (!is_pm1(den)) for (i = 1; i <= cH; i++)
325 : {
326 : GEN r;
327 1228 : gel(v,i) = dvmdii(gel(v,i), den, &r);
328 1228 : if (r != gen_0) return NULL;
329 : }
330 1582 : v = shallowconcat(v, w); /* append bottom of w (= [0 Id] part) */
331 41202 : for (i = 1; i < l; i++)
332 : {
333 39620 : GEN e = gel(v,i);
334 39620 : if (signe(e)) x = famat_mulpow_shallow(x, gel(gen,i), negi(e));
335 : }
336 1582 : *px = x; return v;
337 : }
338 :
339 : static GEN
340 1631 : bnfissunit_i(GEN bnf, GEN x, GEN U)
341 : {
342 1631 : GEN w, nf, v = NULL;
343 1631 : bnf = checkbnf(bnf);
344 1631 : nf = bnf_get_nf(bnf);
345 1631 : if ( (w = make_unit(nf, U, &x)) ) v = bnfisunit(bnf, x);
346 1631 : if (!v || lg(v) == 1) return NULL;
347 1596 : return mkvec2(v, w);
348 : }
349 : static int
350 126 : checkU(GEN U)
351 : {
352 126 : if (typ(U) != t_VEC || lg(U) != 5) return 0;
353 126 : return typ(gel(U,1)) == t_VEC && is_vec_t(typ(gel(U,2)))
354 252 : && typ(gel(U,4))==t_INT;
355 : }
356 : GEN
357 161 : bnfisunit0(GEN bnf, GEN x, GEN U)
358 : {
359 161 : pari_sp av = avma;
360 : GEN z;
361 161 : if (!U) return bnfisunit(bnf, x);
362 126 : if (!checkU(U)) pari_err_TYPE("bnfisunit",U);
363 126 : z = bnfissunit_i(bnf, x, U);
364 126 : if (!z) retgc_const(av, cgetg(1, t_COL));
365 112 : return gc_GEN(av, shallowconcat(gel(z,2), gel(z,1)));
366 : }
367 :
368 : /* OBSOLETE */
369 : static int
370 1505 : checkbnfS_i(GEN v)
371 : {
372 : GEN S, g, w;
373 1505 : if (typ(v) != t_VEC || lg(v) != 7) return 0;
374 1505 : g = gel(v,1); w = gel(v,2); S = gel(v,6);
375 1505 : if (typ(g) != t_VEC || !is_vec_t(typ(S)) || lg(S) != lg(g)) return 0;
376 1505 : return typ(w) == t_VEC && lg(w) == 3;
377 : }
378 : /* OBSOLETE */
379 : GEN
380 1505 : bnfissunit(GEN bnf, GEN bnfS, GEN x)
381 : {
382 1505 : pari_sp av = avma;
383 : GEN z, U;
384 1505 : if (!checkbnfS_i(bnfS)) pari_err_TYPE("bnfissunit",bnfS);
385 1505 : U = mkvec4(gel(bnfS,1), gel(bnfS,6), gmael(bnfS,2,1), gmael(bnfS,2,2));
386 1505 : z = bnfissunit_i(bnf, x, U);
387 1505 : if (!z) retgc_const(av, cgetg(1, t_COL));
388 1484 : return gc_GEN(av, shallowconcat(gel(z,1), gel(z,2)));
389 : }
|
