Branch data 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 : : /* BASIC NF OPERATIONS */
17 : : /* */
18 : : /*******************************************************************/
19 : : #include "pari.h"
20 : : #include "paripriv.h"
21 : :
22 : : /*******************************************************************/
23 : : /* */
24 : : /* OPERATIONS OVER NUMBER FIELD ELEMENTS. */
25 : : /* represented as column vectors over the integral basis */
26 : : /* */
27 : : /*******************************************************************/
28 : : static GEN
29 : 7348206 : get_tab(GEN nf, long *N)
30 : : {
31 [ + + ]: 7348206 : GEN tab = (typ(nf) == t_MAT)? nf: gel(nf,9);
32 : 7348206 : *N = nbrows(tab); return tab;
33 : : }
34 : :
35 : : /* x != 0, y t_INT. Return x * y (not memory clean if x = 1) */
36 : : static GEN
37 : 303563775 : _mulii(GEN x, GEN y) {
38 [ + + ]: 763750329 : return is_pm1(x)? (signe(x) < 0)? negi(y): y
39 [ + + ]: 460186554 : : mulii(x, y);
40 : : }
41 : :
42 : : GEN
43 : 835 : tablemul_ei_ej(GEN M, long i, long j)
44 : : {
45 : : long N;
46 : 835 : GEN tab = get_tab(M, &N);
47 : 835 : tab += (i-1)*N; return gel(tab,j);
48 : : }
49 : :
50 : : /* Outputs x.ei, where ei is the i-th elt of the algebra basis.
51 : : * x an RgV of correct length and arbitrary content (polynomials, scalars...).
52 : : * M is the multiplication table ei ej = sum_k M_k^(i,j) ek */
53 : : GEN
54 : 6500 : tablemul_ei(GEN M, GEN x, long i)
55 : : {
56 : : long j, k, N;
57 : : GEN v, tab;
58 : :
59 [ + + ]: 6500 : if (i==1) return gcopy(x);
60 : 5650 : tab = get_tab(M, &N);
61 [ - + ]: 5650 : if (typ(x) != t_COL) { v = zerocol(N); gel(v,i) = gcopy(x); return v; }
62 : 5650 : tab += (i-1)*N; v = cgetg(N+1,t_COL);
63 : : /* wi . x = [ sum_j tab[k,j] x[j] ]_k */
64 [ + + ]: 46830 : for (k=1; k<=N; k++)
65 : : {
66 : 41180 : pari_sp av = avma;
67 : 41180 : GEN s = gen_0;
68 [ + + ]: 351780 : for (j=1; j<=N; j++)
69 : : {
70 : 310600 : GEN c = gcoeff(tab,k,j);
71 [ + + ]: 310600 : if (!gequal0(c)) s = gadd(s, gmul(c, gel(x,j)));
72 : : }
73 : 41180 : gel(v,k) = gerepileupto(av,s);
74 : : }
75 : 6500 : return v;
76 : : }
77 : : /* as tablemul_ei, assume x a ZV of correct length */
78 : : GEN
79 : 6561652 : zk_ei_mul(GEN nf, GEN x, long i)
80 : : {
81 : : long j, k, N;
82 : : GEN v, tab;
83 : :
84 [ + + ]: 6561652 : if (i==1) return ZC_copy(x);
85 : 6561642 : tab = get_tab(nf, &N); tab += (i-1)*N;
86 : 6561642 : v = cgetg(N+1,t_COL);
87 [ + + ]: 48401524 : for (k=1; k<=N; k++)
88 : : {
89 : 41839882 : pari_sp av = avma;
90 : 41839882 : GEN s = gen_0;
91 [ + + ]: 508357362 : for (j=1; j<=N; j++)
92 : : {
93 : 466517480 : GEN c = gcoeff(tab,k,j);
94 [ + + ]: 466517480 : if (signe(c)) s = addii(s, _mulii(c, gel(x,j)));
95 : : }
96 : 41839882 : gel(v,k) = gerepileuptoint(av, s);
97 : : }
98 : 6561652 : return v;
99 : : }
100 : :
101 : : /* table of multiplication by wi in R[w1,..., wN] */
102 : : GEN
103 : 1778 : ei_multable(GEN TAB, long i)
104 : : {
105 : : long k,N;
106 : 1778 : GEN m, tab = get_tab(TAB, &N);
107 : 1778 : tab += (i-1)*N;
108 : 1778 : m = cgetg(N+1,t_MAT);
109 [ + + ]: 13656 : for (k=1; k<=N; k++) gel(m,k) = gel(tab,k);
110 : 1778 : return m;
111 : : }
112 : :
113 : : GEN
114 : 2502076 : zk_multable(GEN nf, GEN x)
115 : : {
116 : 2502076 : long i, l = lg(x);
117 : 2502076 : GEN mul = cgetg(l,t_MAT);
118 : 2502076 : gel(mul,1) = x; /* assume w_1 = 1 */
119 [ + + ]: 9024076 : for (i=2; i<l; i++) gel(mul,i) = zk_ei_mul(nf,x,i);
120 : 2502076 : return mul;
121 : : }
122 : : GEN
123 : 320 : multable(GEN M, GEN x)
124 : : {
125 : : long i, N;
126 : : GEN mul;
127 [ + - ]: 320 : if (typ(x) == t_MAT) return x;
128 : 0 : M = get_tab(M, &N);
129 [ # # ]: 0 : if (typ(x) != t_COL) return scalarmat(x, N);
130 : 0 : mul = cgetg(N+1,t_MAT);
131 : 0 : gel(mul,1) = x; /* assume w_1 = 1 */
132 [ # # ]: 0 : for (i=2; i<=N; i++) gel(mul,i) = tablemul_ei(M,x,i);
133 : 320 : return mul;
134 : : }
135 : :
136 : : /* x integral in nf; table of multiplication by x in ZK = Z[w1,..., wN].
137 : : * Return a t_INT if x is scalar, and a ZM otherwise */
138 : : GEN
139 : 10944466 : zk_scalar_or_multable(GEN nf, GEN x)
140 : : {
141 : 10944466 : long tx = typ(x);
142 [ + + ][ + + ]: 10944466 : if (tx == t_MAT || tx == t_INT) return x;
143 : 2285539 : x = nf_to_scalar_or_basis(nf, x);
144 [ + + ]: 10944466 : return (typ(x) == t_COL)? zk_multable(nf, x): x;
145 : : }
146 : :
147 : : GEN
148 : 30 : nftrace(GEN nf, GEN x)
149 : : {
150 : 30 : pari_sp av = avma;
151 : 30 : nf = checknf(nf);
152 : 30 : x = nf_to_scalar_or_basis(nf, x);
153 : 15 : x = (typ(x) == t_COL)? RgV_dotproduct(x, gel(nf_get_Tr(nf),1))
154 [ + + ]: 45 : : gmulgs(x, nf_get_degree(nf));
155 : 30 : return gerepileupto(av, x);
156 : : }
157 : : GEN
158 : 160 : rnfelttrace(GEN rnf, GEN x)
159 : : {
160 : 160 : pari_sp av = avma;
161 : 160 : checkrnf(rnf);
162 : 160 : x = rnfeltabstorel(rnf, x);
163 : 65 : x = (typ(x) == t_POLMOD)? rnfeltdown(rnf, gtrace(x))
164 [ + + ]: 160 : : gmulgs(x, rnf_get_degree(rnf));
165 : 95 : return gerepileupto(av, x);
166 : : }
167 : :
168 : : /* assume nf is a genuine nf, fa a famat */
169 : : static GEN
170 : 5 : famat_norm(GEN nf, GEN fa)
171 : : {
172 : 5 : pari_sp av = avma;
173 : 5 : GEN g = gel(fa,1), e = gel(fa,2), N = gen_1;
174 : 5 : long i, l = lg(g);
175 [ + + ]: 15 : for (i = 1; i < l; i++)
176 : 10 : N = gmul(N, powgi(nfnorm(nf, gel(g,i)), gel(e,i)));
177 : 5 : return gerepileupto(av, N);
178 : : }
179 : : GEN
180 : 7180 : nfnorm(GEN nf, GEN x)
181 : : {
182 : 7180 : pari_sp av = avma;
183 : 7180 : nf = checknf(nf);
184 [ + + ]: 7180 : if (typ(x) == t_MAT) return famat_norm(nf, x);
185 : 7175 : x = nf_to_scalar_or_alg(nf, x);
186 : 6850 : x = (typ(x) == t_POL)? RgXQ_norm(x, nf_get_pol(nf))
187 [ + + ]: 14025 : : gpowgs(x, nf_get_degree(nf));
188 : 7180 : return gerepileupto(av, x);
189 : : }
190 : :
191 : : GEN
192 : 160 : rnfeltnorm(GEN rnf, GEN x)
193 : : {
194 : 160 : pari_sp av = avma;
195 : 160 : checkrnf(rnf);
196 : 160 : x = rnfeltabstorel(rnf, x);
197 : 65 : x = (typ(x) == t_POLMOD)? rnfeltdown(rnf, gnorm(x))
198 [ + + ]: 160 : : gpowgs(x, rnf_get_degree(rnf));
199 : 95 : return gerepileupto(av, x);
200 : : }
201 : :
202 : : /* sum of x and y in nf */
203 : : GEN
204 : 16736 : nfadd(GEN nf, GEN x, GEN y)
205 : : {
206 : : GEN z;
207 : 16736 : pari_sp av = avma;
208 : :
209 : 16736 : nf = checknf(nf);
210 : 16736 : x = nf_to_scalar_or_basis(nf, x);
211 : 16736 : y = nf_to_scalar_or_basis(nf, y);
212 [ + + ]: 16736 : if (typ(x) != t_COL) {
213 [ + + ]: 4533 : if (typ(y) == t_COL) z = RgC_Rg_add(y, x);
214 : : else {
215 : 1853 : long N = nf_get_degree(nf);
216 : 1853 : z = zerocol(N); gel(z,1) = gadd(x,y);
217 : : }
218 : : } else {
219 [ + + ]: 12203 : if (typ(y) != t_COL) z = RgC_Rg_add(x, y);
220 : 4929 : else z = RgC_add(x, y);
221 : : }
222 : 16736 : return gerepileupto(av, z);
223 : : }
224 : :
225 : : /* product of x and y in nf */
226 : : GEN
227 : 115342 : nfmul(GEN nf, GEN x, GEN y)
228 : : {
229 : : GEN z;
230 : 115342 : pari_sp av = avma;
231 : :
232 [ + + ]: 115342 : if (x == y) return nfsqr(nf,x);
233 : :
234 : 115297 : nf = checknf(nf);
235 : 115297 : x = nf_to_scalar_or_basis(nf, x);
236 : 115237 : y = nf_to_scalar_or_basis(nf, y);
237 [ + + ]: 115237 : if (typ(x) != t_COL)
238 : : {
239 [ + + ]: 42034 : if (typ(y) == t_COL) z = RgC_Rg_mul(y, x);
240 : : else {
241 : 20449 : long N = nf_get_degree(nf);
242 : 20449 : z = zerocol(N); gel(z,1) = gmul(x,y);
243 : : }
244 : : }
245 : : else
246 : : {
247 [ + + ]: 73203 : if (typ(y) != t_COL) z = RgC_Rg_mul(x, y);
248 : : else {
249 : : GEN dx, dy;
250 : 46800 : x = Q_remove_denom(x, &dx);
251 : 46800 : y = Q_remove_denom(y, &dy);
252 : 46800 : z = nfmuli(nf,x,y);
253 : 46800 : dx = mul_denom(dx,dy);
254 [ + + ]: 46800 : if (dx) z = RgC_Rg_div(z, dx);
255 : : }
256 : : }
257 : 115282 : return gerepileupto(av, z);
258 : : }
259 : : /* square of x in nf */
260 : : GEN
261 : 7490 : nfsqr(GEN nf, GEN x)
262 : : {
263 : 7490 : pari_sp av = avma;
264 : : GEN z;
265 : :
266 : 7490 : nf = checknf(nf);
267 : 7490 : x = nf_to_scalar_or_basis(nf, x);
268 [ + + ]: 7490 : if (typ(x) != t_COL)
269 : : {
270 : 6430 : long N = nf_get_degree(nf);
271 : 6430 : z = zerocol(N); gel(z,1) = gsqr(x);
272 : : }
273 : : else
274 : : {
275 : : GEN dx;
276 : 1060 : x = Q_remove_denom(x, &dx);
277 : 1060 : z = nfsqri(nf,x);
278 [ + + ]: 1060 : if (dx) z = RgC_Rg_div(z, sqri(dx));
279 : : }
280 : 7490 : return gerepileupto(av, z);
281 : : }
282 : :
283 : : GEN
284 : 144745 : nfC_nf_mul(GEN nf, GEN v, GEN x)
285 : : {
286 : : long tx, l, i;
287 : 144745 : GEN y, dx = NULL;
288 : :
289 : 144745 : x = nf_to_scalar_or_basis(nf, x);
290 : 144745 : tx = typ(x);
291 [ + + ]: 144745 : if (tx != t_COL) {
292 [ + + ]: 28950 : if (tx == t_INT)
293 : : {
294 : 28480 : long s = signe(x);
295 [ + + ]: 28480 : if (!s) return zerocol(lg(v)-1);
296 [ + + ][ + + ]: 26850 : if (is_pm1(x)) return s > 0? leafcopy(v): RgC_neg(v);
297 : : }
298 : 7747 : l = lg(v); y = cgetg(l, t_COL);
299 [ + + ]: 65068 : for (i=1; i < l; i++)
300 : : {
301 : 57321 : GEN c = gel(v,i);
302 [ + + ]: 57321 : if (typ(c) != t_COL) c = gmul(c, x); else c = RgC_Rg_mul(c, x);
303 : 57321 : gel(y,i) = c;
304 : : }
305 : : }
306 : : else
307 : : {
308 : 115795 : x = Q_remove_denom(x, &dx);
309 : 115795 : x = zk_multable(nf, x);
310 : 115795 : l = lg(v); y = cgetg(l, t_COL);
311 [ + + ]: 458461 : for (i=1; i < l; i++)
312 : : {
313 : 342666 : GEN c = gel(v,i);
314 [ + + ]: 342666 : if (typ(c)!=t_COL) {
315 [ + + ]: 51843 : if (!isintzero(c)) c = RgC_Rg_mul(gel(x,1), c);
316 : : } else {
317 : 290823 : c = RgM_RgC_mul(x,c);
318 [ + + ]: 290823 : if (QV_isscalar(c)) c = gel(c,1);
319 : : }
320 : 342666 : gel(y,i) = c;
321 : : }
322 : : }
323 [ + + ]: 144745 : return dx? RgC_Rg_div(y, dx): y;
324 : : }
325 : : static GEN
326 : 1815 : mulbytab(GEN M, GEN c)
327 [ + + ]: 1815 : { return typ(c) == t_COL? RgM_RgC_mul(M,c): RgC_Rg_mul(gel(M,1), c); }
328 : : GEN
329 : 320 : tablemulvec(GEN M, GEN x, GEN v)
330 : : {
331 : : long l, i;
332 : : GEN y;
333 : :
334 [ - + ][ # # ]: 320 : if (typ(x) == t_COL && RgV_isscalar(x))
335 : : {
336 : 0 : x = gel(x,1);
337 [ # # ]: 0 : return typ(v) == t_POL? RgX_Rg_mul(v,x): RgV_Rg_mul(v,x);
338 : : }
339 : 320 : x = multable(M, x); /* multiplication table by x */
340 : 320 : y = cgetg_copy(v, &l);
341 [ + - ]: 320 : if (typ(v) == t_POL)
342 : : {
343 : 320 : y[1] = v[1];
344 [ + + ]: 2135 : for (i=2; i < l; i++) gel(y,i) = mulbytab(x, gel(v,i));
345 : 320 : y = normalizepol(y);
346 : : }
347 : : else
348 : : {
349 [ # # ]: 0 : for (i=1; i < l; i++) gel(y,i) = mulbytab(x, gel(v,i));
350 : : }
351 : 320 : return y;
352 : : }
353 : :
354 : : /* inverse of x in nf */
355 : : GEN
356 : 38290 : nfinv(GEN nf, GEN x)
357 : : {
358 : 38290 : pari_sp av = avma;
359 : : GEN T, z;
360 : :
361 : 38290 : nf = checknf(nf); T = nf_get_pol(nf);
362 : 38290 : x = nf_to_scalar_or_alg(nf, x);
363 [ + + ]: 38290 : if (typ(x) == t_POL)
364 : 2650 : z = poltobasis(nf, QXQ_inv(x, T));
365 : : else {
366 : 35640 : z = zerocol(degpol(T)); gel(z,1) = ginv(x);
367 : : }
368 : 38290 : return gerepileupto(av, z);
369 : : }
370 : :
371 : : /* quotient of x and y in nf */
372 : : GEN
373 : 7950 : nfdiv(GEN nf, GEN x, GEN y)
374 : : {
375 : 7950 : pari_sp av = avma;
376 : : GEN T, z;
377 : :
378 : 7950 : nf = checknf(nf); T = nf_get_pol(nf);
379 : 7950 : y = nf_to_scalar_or_alg(nf, y);
380 [ + + ]: 7760 : if (typ(y) != t_POL) {
381 : 1417 : x = nf_to_scalar_or_basis(nf, x);
382 [ + + ]: 1417 : if (typ(x) == t_COL) z = RgC_Rg_div(x, y);
383 : : else {
384 : 670 : z = zerocol(degpol(T)); gel(z,1) = gdiv(x,y);
385 : : }
386 : : }
387 : : else
388 : : {
389 : 6343 : x = nf_to_scalar_or_alg(nf, x);
390 : 6313 : z = QXQ_inv(y, T);
391 [ + + ]: 6313 : z = (typ(x) == t_POL)? RgXQ_mul(z, x, T): RgX_Rg_mul(z, x);
392 : 6313 : z = poltobasis(nf, z);
393 : : }
394 : 7710 : return gerepileupto(av, z);
395 : : }
396 : :
397 : : /* product of INTEGERS (t_INT or ZC) x and y in nf
398 : : * compute xy as ( sum_i x_i sum_j y_j m^{i,j}_k )_k */
399 : : GEN
400 : 316728 : nfmuli(GEN nf, GEN x, GEN y)
401 : : {
402 : : long i, j, k, N;
403 : 316728 : GEN s, v, TAB = get_tab(nf, &N);
404 : :
405 [ + + ]: 316728 : if (typ(x) == t_INT)
406 : : {
407 [ + + ]: 64145 : if (typ(y) == t_INT) return scalarcol(mulii(x,y), N);
408 : 6010 : return ZC_Z_mul(y, x);
409 : : }
410 [ + + ]: 252583 : if (typ(y) == t_INT) return ZC_Z_mul(x, y);
411 : : /* both x and y are ZV */
412 : 233859 : v = cgetg(N+1,t_COL);
413 [ + + ]: 1537204 : for (k=1; k<=N; k++)
414 : : {
415 : 1303345 : pari_sp av = avma;
416 : 1303345 : GEN TABi = TAB;
417 [ + + ]: 1303345 : if (k == 1)
418 : 233859 : s = mulii(gel(x,1),gel(y,1));
419 : : else
420 : 1069486 : s = addii(mulii(gel(x,1),gel(y,k)),
421 : 2138972 : mulii(gel(x,k),gel(y,1)));
422 [ + + ]: 10516647 : for (i=2; i<=N; i++)
423 : : {
424 : 9213302 : GEN t, xi = gel(x,i);
425 : 9213302 : TABi += N;
426 [ + + ]: 9213302 : if (!signe(xi)) continue;
427 : :
428 : 5890190 : t = NULL;
429 [ + + ]: 78955062 : for (j=2; j<=N; j++)
430 : : {
431 : 73064872 : GEN p1, c = gcoeff(TABi, k, j); /* m^{i,j}_k */
432 [ + + ]: 73064872 : if (!signe(c)) continue;
433 : 31039282 : p1 = _mulii(c, gel(y,j));
434 [ + + ]: 31039282 : t = t? addii(t, p1): p1;
435 : : }
436 [ + + ]: 5890190 : if (t) s = addii(s, mulii(xi, t));
437 : : }
438 : 1303345 : gel(v,k) = gerepileuptoint(av,s);
439 : : }
440 : 316728 : return v;
441 : : }
442 : : /* square of INTEGER (t_INT or ZC) x in nf */
443 : : GEN
444 : 461573 : nfsqri(GEN nf, GEN x)
445 : : {
446 : : long i, j, k, N;
447 : 461573 : GEN s, v, TAB = get_tab(nf, &N);
448 : :
449 [ - + ]: 461573 : if (typ(x) == t_INT) return scalarcol(sqri(x), N);
450 : 461573 : v = cgetg(N+1,t_COL);
451 [ + + ]: 3785734 : for (k=1; k<=N; k++)
452 : : {
453 : 3324161 : pari_sp av = avma;
454 : 3324161 : GEN TABi = TAB;
455 [ + + ]: 3324161 : if (k == 1)
456 : 461573 : s = sqri(gel(x,1));
457 : : else
458 : 2862588 : s = shifti(mulii(gel(x,1),gel(x,k)), 1);
459 [ + + ]: 39445095 : for (i=2; i<=N; i++)
460 : : {
461 : 36120934 : GEN p1, c, t, xi = gel(x,i);
462 : 36120934 : TABi += N;
463 [ + + ]: 36120934 : if (!signe(xi)) continue;
464 : :
465 : 12411493 : c = gcoeff(TABi, k, i);
466 [ + + ]: 12411493 : t = signe(c)? _mulii(c,xi): NULL;
467 [ + + ]: 182007708 : for (j=i+1; j<=N; j++)
468 : : {
469 : 169596215 : c = gcoeff(TABi, k, j);
470 [ + + ]: 169596215 : if (!signe(c)) continue;
471 : 90216923 : p1 = _mulii(c, shifti(gel(x,j),1));
472 [ + + ]: 90216923 : t = t? addii(t, p1): p1;
473 : : }
474 [ + + ]: 12411493 : if (t) s = addii(s, mulii(xi, t));
475 : : }
476 : 3324161 : gel(v,k) = gerepileuptoint(av,s);
477 : : }
478 : 461573 : return v;
479 : : }
480 : :
481 : : /* both x and y are RgV */
482 : : GEN
483 : 0 : tablemul(GEN TAB, GEN x, GEN y)
484 : : {
485 : : long i, j, k, N;
486 : : GEN s, v;
487 [ # # ]: 0 : if (typ(x) != t_COL) return gmul(x, y);
488 [ # # ]: 0 : if (typ(y) != t_COL) return gmul(y, x);
489 : 0 : N = lg(x)-1;
490 : 0 : v = cgetg(N+1,t_COL);
491 [ # # ]: 0 : for (k=1; k<=N; k++)
492 : : {
493 : 0 : pari_sp av = avma;
494 : 0 : GEN TABi = TAB;
495 [ # # ]: 0 : if (k == 1)
496 : 0 : s = gmul(gel(x,1),gel(y,1));
497 : : else
498 : 0 : s = gadd(gmul(gel(x,1),gel(y,k)),
499 : 0 : gmul(gel(x,k),gel(y,1)));
500 [ # # ]: 0 : for (i=2; i<=N; i++)
501 : : {
502 : 0 : GEN t, xi = gel(x,i);
503 : 0 : TABi += N;
504 [ # # ]: 0 : if (gequal0(xi)) continue;
505 : :
506 : 0 : t = NULL;
507 [ # # ]: 0 : for (j=2; j<=N; j++)
508 : : {
509 : 0 : GEN p1, c = gcoeff(TABi, k, j); /* m^{i,j}_k */
510 [ # # ]: 0 : if (gequal0(c)) continue;
511 : 0 : p1 = gmul(c, gel(y,j));
512 [ # # ]: 0 : t = t? gadd(t, p1): p1;
513 : : }
514 [ # # ]: 0 : if (t) s = gadd(s, gmul(xi, t));
515 : : }
516 : 0 : gel(v,k) = gerepileupto(av,s);
517 : : }
518 : 0 : return v;
519 : : }
520 : : GEN
521 : 2155 : tablesqr(GEN TAB, GEN x)
522 : : {
523 : : long i, j, k, N;
524 : : GEN s, v;
525 : :
526 [ - + ]: 2155 : if (typ(x) != t_COL) return gsqr(x);
527 : 2155 : N = lg(x)-1;
528 : 2155 : v = cgetg(N+1,t_COL);
529 : :
530 [ + + ]: 18495 : for (k=1; k<=N; k++)
531 : : {
532 : 16340 : pari_sp av = avma;
533 : 16340 : GEN TABi = TAB;
534 [ + + ]: 16340 : if (k == 1)
535 : 2155 : s = gsqr(gel(x,1));
536 : : else
537 : 14185 : s = gmul2n(gmul(gel(x,1),gel(x,k)), 1);
538 [ + + ]: 126640 : for (i=2; i<=N; i++)
539 : : {
540 : 110300 : GEN p1, c, t, xi = gel(x,i);
541 : 110300 : TABi += N;
542 [ + + ]: 110300 : if (gequal0(xi)) continue;
543 : :
544 : 43440 : c = gcoeff(TABi, k, i);
545 [ + + ]: 43440 : t = !gequal0(c)? gmul(c,xi): NULL;
546 [ + + ]: 204260 : for (j=i+1; j<=N; j++)
547 : : {
548 : 160820 : c = gcoeff(TABi, k, j);
549 [ + + ]: 160820 : if (gequal0(c)) continue;
550 : 87255 : p1 = gmul(gmul2n(c,1), gel(x,j));
551 [ + + ]: 87255 : t = t? gadd(t, p1): p1;
552 : : }
553 [ + + ]: 43440 : if (t) s = gadd(s, gmul(xi, t));
554 : : }
555 : 16340 : gel(v,k) = gerepileupto(av,s);
556 : : }
557 : 2155 : return v;
558 : : }
559 : :
560 : : static GEN
561 : 32700 : _mul(void *data, GEN x, GEN y) { return nfmuli((GEN)data,x,y); }
562 : : static GEN
563 : 195678 : _sqr(void *data, GEN x) { return nfsqri((GEN)data,x); }
564 : :
565 : : /* Compute z^n in nf, left-shift binary powering */
566 : : GEN
567 : 156531 : nfpow(GEN nf, GEN z, GEN n)
568 : : {
569 : 156531 : pari_sp av = avma;
570 : : long s, N;
571 : : GEN x, cx, T;
572 : :
573 [ - + ]: 156531 : if (typ(n)!=t_INT) pari_err_TYPE("nfpow",n);
574 : 156531 : nf = checknf(nf); T = nf_get_pol(nf); N = degpol(T);
575 [ - + ]: 156531 : s = signe(n); if (!s) return scalarcol_shallow(gen_1,N);
576 : 156531 : x = nf_to_scalar_or_basis(nf, z);
577 [ + + ]: 156531 : if (typ(x) != t_COL) { GEN y = zerocol(N); gel(y,1) = powgi(x,n); return y; }
578 [ + + ]: 156195 : if (s < 0) { /* simplified nfinv */
579 : 1370 : x = nf_to_scalar_or_alg(nf, z);
580 : 1370 : x = poltobasis(nf, QXQ_inv(x, T));
581 : 1370 : n = absi(n);
582 : : }
583 : 156195 : x = primitive_part(x, &cx);
584 : 156195 : x = gen_pow(x, n, (void*)nf, _sqr, _mul);
585 [ + + ]: 156195 : if (cx) x = RgC_Rg_mul(x, powgi(cx, n));
586 [ - + ]: 156531 : return av==avma? gcopy(x): gerepileupto(av,x);
587 : : }
588 : : /* Compute z^n in nf, left-shift binary powering */
589 : : GEN
590 : 3600 : nfpow_u(GEN nf, GEN z, ulong n)
591 : : {
592 : 3600 : pari_sp av = avma;
593 : : long N;
594 : : GEN x, cx, T;
595 : :
596 : 3600 : nf = checknf(nf); T = nf_get_pol(nf); N = degpol(T);
597 [ - + ]: 3600 : if (!n) return scalarcol_shallow(gen_1,N);
598 : 3600 : x = nf_to_scalar_or_basis(nf, z);
599 [ + + ]: 3600 : if (typ(x) != t_COL) { GEN y = zerocol(N); gel(y,1) = gpowgs(x,n); return y; }
600 : 3080 : x = primitive_part(x, &cx);
601 : 3080 : x = gen_powu(x, n, (void*)nf, _sqr, _mul);
602 [ + + ]: 3080 : if (cx) x = RgC_Rg_mul(x, powgi(cx, utoipos(n)));
603 [ - + ]: 3600 : return av==avma? gcopy(x): gerepileupto(av,x);
604 : : }
605 : :
606 : : typedef struct {
607 : : GEN nf, p;
608 : : long I;
609 : : } eltmod_muldata;
610 : :
611 : : static GEN
612 : 84055 : sqr_mod(void *data, GEN x)
613 : : {
614 : 84055 : eltmod_muldata *D = (eltmod_muldata*)data;
615 : 84055 : return FpC_red(nfsqri(D->nf, x), D->p);
616 : : }
617 : : static GEN
618 : 38677 : ei_msqr_mod(void *data, GEN x)
619 : : {
620 : 38677 : GEN x2 = sqr_mod(data, x);
621 : 38677 : eltmod_muldata *D = (eltmod_muldata*)data;
622 : 38677 : return FpC_red(zk_ei_mul(D->nf, x2, D->I), D->p);
623 : : }
624 : :
625 : : /* x = I-th vector of the Z-basis of Z_K, in Z^n, compute lift(x^n mod p) */
626 : : GEN
627 : 58577 : pow_ei_mod_p(GEN nf, long I, GEN n, GEN p)
628 : : {
629 : 58577 : pari_sp av = avma;
630 : : eltmod_muldata D;
631 : : long s,N;
632 : : GEN y;
633 : :
634 [ - + ]: 58577 : if (typ(n) != t_INT) pari_err_TYPE("nfpow",n);
635 : 58577 : nf = checknf(nf); N = nf_get_degree(nf);
636 : 58577 : s = signe(n);
637 [ - + ]: 58577 : if (s < 0) pari_err_IMPL("negative power in pow_ei_mod_p");
638 [ + - ][ + + ]: 58577 : if (!s || I == 1) return scalarcol_shallow(gen_1,N);
639 : 49483 : D.nf = nf;
640 : 49483 : D.p = p;
641 : 49483 : D.I = I;
642 : 49483 : y = gen_pow_fold(col_ei(N, I), n, (void*)&D, &sqr_mod, &ei_msqr_mod);
643 : 58577 : return gerepileupto(av,y);
644 : : }
645 : :
646 : : /* valuation of integral x (ZV), with resp. to prime ideal pr */
647 : : long
648 : 8641435 : ZC_nfvalrem(GEN nf, GEN x, GEN pr, GEN *newx)
649 : : {
650 : : long i, v, l;
651 : 8641435 : GEN r, y, p = pr_get_p(pr), mul = zk_scalar_or_multable(nf, pr_get_tau(pr));
652 : :
653 : : /* p inert */
654 [ + + ][ + + ]: 8641435 : if (typ(mul) == t_INT) return newx? ZV_pvalrem(x, p, newx):ZV_pval(x, p);
655 : 8639985 : y = cgetg_copy(x, &l); /* will hold the new x */
656 : 8639985 : x = leafcopy(x);
657 : 8639985 : for(v=0;; v++)
658 : : {
659 [ + + ]: 40008472 : for (i=1; i<l; i++)
660 : : { /* is (x.b)[i] divisible by p ? */
661 : 36438937 : gel(y,i) = dvmdii(ZMrow_ZC_mul(mul,x,i),p,&r);
662 [ + + ][ + + ]: 36438937 : if (r != gen_0) { if (newx) *newx = x; return v; }
663 : : }
664 : 3569535 : swap(x, y);
665 : 12210970 : }
666 : : }
667 : : long
668 : 8464523 : ZC_nfval(GEN nf, GEN x, GEN P)
669 : 8464523 : { return ZC_nfvalrem(nf, x, P, NULL); }
670 : :
671 : : /* v_P(x) != 0, x a ZV. Simpler version of ZC_nfvalrem */
672 : : int
673 : 1322 : ZC_prdvd(GEN nf, GEN x, GEN P)
674 : : {
675 : 1322 : pari_sp av = avma;
676 : : long i, l;
677 : 1322 : GEN p = pr_get_p(P), mul = zk_scalar_or_multable(nf, pr_get_tau(P));
678 [ - + ]: 1322 : if (typ(mul) == t_INT) return ZV_Z_dvd(x, p);
679 : 1322 : l = lg(x);
680 [ + + ]: 5816 : for (i=1; i<l; i++)
681 [ + + ]: 5516 : if (remii(ZMrow_ZC_mul(mul,x,i), p) != gen_0) { avma = av; return 0; }
682 : 1322 : avma = av; return 1;
683 : : }
684 : :
685 : : int
686 : 20 : pr_equal(GEN nf, GEN P, GEN Q)
687 : : {
688 : 20 : GEN gQ, p = pr_get_p(P);
689 : 20 : long e = pr_get_e(P), f = pr_get_f(P), n;
690 [ + - ][ + - ]: 20 : if (!equalii(p, pr_get_p(Q)) || e != pr_get_e(Q) || f != pr_get_f(Q))
[ + + ]
691 : 10 : return 0;
692 : 10 : gQ = pr_get_gen(Q); n = lg(gQ)-1;
693 [ + + ]: 10 : if (2*e*f > n) return 1; /* room for only one such pr */
694 [ - + ][ # # ]: 20 : return ZV_equal(pr_get_gen(P), gQ) || ZC_prdvd(nf, gQ, P);
695 : : }
696 : :
697 : : long
698 : 229936 : nfval(GEN nf, GEN x, GEN pr)
699 : : {
700 : 229936 : pari_sp av = avma;
701 : : long w, e;
702 : : GEN cx, p;
703 : :
704 [ + + ]: 229936 : if (gequal0(x)) return LONG_MAX;
705 : 229761 : nf = checknf(nf);
706 : 229761 : checkprid(pr);
707 : 229761 : p = pr_get_p(pr);
708 : 229761 : e = pr_get_e(pr);
709 : 229761 : x = nf_to_scalar_or_basis(nf, x);
710 [ + + ]: 229761 : if (typ(x) != t_COL) return e*Q_pval(x,p);
711 : 124101 : x = Q_primitive_part(x, &cx);
712 : 124101 : w = ZC_nfval(nf,x,pr);
713 [ + + ]: 124101 : if (cx) w += e*Q_pval(cx,p);
714 : 229936 : avma = av; return w;
715 : : }
716 : :
717 : : /* want to write p^v = uniformizer^(e*v) * z^v, z coprime to pr */
718 : : /* z := tau^e / p^(e-1), algebraic integer coprime to pr; return z^v */
719 : : static GEN
720 : 2804 : powp(GEN nf, GEN pr, long v)
721 : : {
722 : : GEN b, z;
723 : : long e;
724 [ + + ]: 2804 : if (!v) return gen_1;
725 : 2794 : b = pr_get_tau(pr);
726 [ + + ]: 2794 : if (typ(b) == t_INT) return gen_1;
727 : 494 : e = pr_get_e(pr);
728 : 494 : z = gel(b,1);
729 [ + - ]: 494 : if (e != 1) z = gdiv(nfpow_u(nf, z, e), powiu(pr_get_p(pr),e-1));
730 : 2804 : return nfpow_u(nf, z, v);
731 : : }
732 : : long
733 : 6854 : nfvalrem(GEN nf, GEN x, GEN pr, GEN *py)
734 : : {
735 : 6854 : pari_sp av = avma;
736 : : long w, e;
737 : : GEN cx, p, t;
738 : :
739 [ + + ]: 6854 : if (!py) return nfval(nf,x,pr);
740 [ + + ]: 6769 : if (gequal0(x)) { *py = gcopy(x); return LONG_MAX; }
741 : 6759 : nf = checknf(nf);
742 : 6759 : checkprid(pr);
743 : 6759 : p = pr_get_p(pr);
744 : 6759 : e = pr_get_e(pr);
745 : 6759 : x = nf_to_scalar_or_basis(nf, x);
746 [ + + ]: 6759 : if (typ(x) != t_COL) {
747 : 2405 : w = Q_pvalrem(x,p, py);
748 [ + + ]: 2405 : if (!w) { *py = gerepilecopy(av, x); return 0; }
749 : 2350 : *py = gerepileupto(av, gmul(powp(nf, pr, w), *py));
750 : 2350 : return e*w;
751 : : }
752 : 4354 : x = Q_primitive_part(x, &cx);
753 : 4354 : w = ZC_nfvalrem(nf,x,pr, py);
754 [ + + ]: 4354 : if (cx)
755 : : {
756 : 454 : long v = Q_pvalrem(cx,p, &t);
757 : 454 : *py = nfmul(nf, *py, gmul(powp(nf,pr,v), t));
758 : 454 : *py = gerepileupto(av, *py);
759 : 454 : w += e*v;
760 : : }
761 : : else
762 : 3900 : *py = gerepilecopy(av, *py);
763 : 6854 : return w;
764 : : }
765 : : GEN
766 : 105 : gpnfvalrem(GEN nf, GEN x, GEN pr, GEN *py)
767 : : {
768 : 105 : long v = nfvalrem(nf,x,pr,py);
769 [ + + ]: 105 : return v == LONG_MAX? mkoo(): stoi(v);
770 : : }
771 : :
772 : : GEN
773 : 11160 : coltoalg(GEN nf, GEN x)
774 : : {
775 : 11160 : return mkpolmod( coltoliftalg(nf, x), nf_get_pol(nf) );
776 : : }
777 : :
778 : : GEN
779 : 17485 : basistoalg(GEN nf, GEN x)
780 : : {
781 : : GEN z, T;
782 : :
783 : 17485 : nf = checknf(nf);
784 [ + + + + : 17485 : switch(typ(x))
- ]
785 : : {
786 : : case t_COL: {
787 : 2015 : pari_sp av = avma;
788 : 2015 : return gerepilecopy(av, coltoalg(nf, x));
789 : : }
790 : : case t_POLMOD:
791 : 10 : T = nf_get_pol(nf);
792 [ - + ]: 10 : if (!RgX_equal_var(T,gel(x,1)))
793 : 0 : pari_err_MODULUS("basistoalg", T,gel(x,1));
794 : 10 : return gcopy(x);
795 : : case t_POL:
796 : 105 : T = nf_get_pol(nf);
797 [ - + ]: 105 : if (varn(T) != varn(x)) pari_err_VAR("basistoalg",x,T);
798 : 105 : z = cgetg(3,t_POLMOD);
799 : 105 : gel(z,1) = ZX_copy(T);
800 : 105 : gel(z,2) = RgX_rem(x, T); return z;
801 : : case t_INT:
802 : : case t_FRAC:
803 : 15355 : T = nf_get_pol(nf);
804 : 15355 : z = cgetg(3,t_POLMOD);
805 : 15355 : gel(z,1) = ZX_copy(T);
806 : 15355 : gel(z,2) = gcopy(x); return z;
807 : : default:
808 : 0 : pari_err_TYPE("basistoalg",x);
809 : 17485 : return NULL; /* not reached */
810 : : }
811 : : }
812 : :
813 : : /* Assume nf is a genuine nf. */
814 : : GEN
815 : 4974234 : nf_to_scalar_or_basis(GEN nf, GEN x)
816 : : {
817 [ + + + + : 4974234 : switch(typ(x))
- ]
818 : : {
819 : : case t_INT: case t_FRAC:
820 : 751628 : return x;
821 : : case t_POLMOD:
822 : 34792 : x = checknfelt_mod(nf,x,"nf_to_scalar_or_basis");
823 [ + + ]: 34742 : if (typ(x) != t_POL) return x;
824 : : /* fall through */
825 : : case t_POL:
826 : : {
827 : 35638 : GEN T = nf_get_pol(nf);
828 : 35638 : long l = lg(x);
829 [ + + ]: 35638 : if (varn(x) != varn(T)) pari_err_VAR("nf_to_scalar_or_basis", x,T);
830 [ + + ]: 35598 : if (l >= lg(T)) { x = RgX_rem(x, T); l = lg(x); }
831 [ + + ]: 35598 : if (l == 2) return gen_0;
832 [ + + ]: 32498 : if (l == 3) return gel(x,2);
833 : 29626 : return poltobasis(nf,x);
834 : : }
835 : : case t_COL:
836 [ + + ]: 4164169 : if (lg(x) != lg(nf_get_zk(nf))) break;
837 [ + + ]: 4164124 : return QV_isscalar(x)? gel(x,1): x;
838 : : }
839 : 45 : pari_err_TYPE("nf_to_scalar_or_basis",x);
840 : 4974099 : return NULL; /* not reached */
841 : : }
842 : : /* Let x be a polynomial with coefficients in Q or nf. Return the same
843 : : * polynomial with coefficients expressed as vectors (on the integral basis).
844 : : * No consistency checks, not memory-clean. */
845 : : GEN
846 : 615 : RgX_to_nfX(GEN nf, GEN x)
847 : : {
848 : : long i, l;
849 : 615 : GEN y = cgetg_copy(x, &l); y[1] = x[1];
850 [ + + ]: 8520 : for (i=2; i<l; i++) gel(y,i) = nf_to_scalar_or_basis(nf, gel(x,i));
851 : 615 : return y;
852 : : }
853 : :
854 : : /* Assume nf is a genuine nf. */
855 : : GEN
856 : 72080 : nf_to_scalar_or_alg(GEN nf, GEN x)
857 : : {
858 [ + + + + : 72080 : switch(typ(x))
+ ]
859 : : {
860 : : case t_INT: case t_FRAC:
861 : 38970 : return x;
862 : : case t_POLMOD:
863 : 1110 : x = checknfelt_mod(nf,x,"nf_to_scalar_or_alg");
864 [ + + ]: 1110 : if (typ(x) != t_POL) return x;
865 : : /* fall through */
866 : : case t_POL:
867 : : {
868 : 9348 : GEN T = nf_get_pol(nf);
869 : 9348 : long l = lg(x);
870 [ + + ]: 9348 : if (varn(x) != varn(T)) pari_err_VAR("nf_to_scalar_or_alg", x,T);
871 [ + + ]: 9248 : if (l >= lg(T)) { x = RgX_rem(x, T); l = lg(x); }
872 [ + + ]: 9248 : if (l == 2) return gen_0;
873 [ + + ]: 9243 : if (l == 3) return gel(x,2);
874 : 8833 : return x;
875 : : }
876 : : case t_COL:
877 [ + + ]: 23542 : if (lg(x) != lg(nf_get_zk(nf))) break;
878 [ + + ]: 23422 : return QV_isscalar(x)? gel(x,1): coltoliftalg(nf, x);
879 : : }
880 : 155 : pari_err_TYPE("nf_to_scalar_or_alg",x);
881 : 71825 : return NULL; /* not reached */
882 : : }
883 : :
884 : : /* gmul(A, RgX_to_Rg(x)), A t_MAT (or t_VEC) of compatible dimensions */
885 : : GEN
886 : 907179 : mulmat_pol(GEN A, GEN x)
887 : : {
888 : : long i,l;
889 : : GEN z;
890 [ + + ]: 907179 : if (typ(x) != t_POL) return gmul(x,gel(A,1)); /* scalar */
891 [ + + ][ + - ]: 907129 : l=lg(x)-1; if (l == 1) return typ(A)==t_VEC? gen_0: zerocol(nbrows(A));
892 : 906254 : x++; z = gmul(gel(x,1), gel(A,1));
893 [ + + ]: 4124667 : for (i=2; i<l ; i++)
894 [ + + ]: 3218413 : if (!gequal0(gel(x,i))) z = gadd(z, gmul(gel(x,i), gel(A,i)));
895 : 907179 : return z;
896 : : }
897 : :
898 : : /* x a t_POL, nf a genuine nf. No garbage collecting. No check. */
899 : : GEN
900 : 831725 : poltobasis(GEN nf, GEN x)
901 : : {
902 : 831725 : GEN P = nf_get_pol(nf);
903 [ + + ]: 831725 : if (varn(x) != varn(P)) pari_err_VAR( "poltobasis", x,P);
904 [ + + ]: 831575 : if (degpol(x) >= degpol(P)) x = RgX_rem(x,P);
905 : 831575 : return mulmat_pol(nf_get_invzk(nf), x);
906 : : }
907 : :
908 : : GEN
909 : 12954 : algtobasis(GEN nf, GEN x)
910 : : {
911 : : pari_sp av;
912 : :
913 : 12954 : nf = checknf(nf);
914 [ + + + + : 12954 : switch(typ(x))
- ]
915 : : {
916 : : case t_POLMOD:
917 [ + + ]: 880 : if (!RgX_equal_var(nf_get_pol(nf),gel(x,1)))
918 : 5 : pari_err_MODULUS("algtobasis", nf_get_pol(nf),gel(x,1));
919 : 875 : x = gel(x,2);
920 [ + + - ]: 875 : switch(typ(x))
921 : : {
922 : : case t_INT:
923 : 5 : case t_FRAC: return scalarcol(x, nf_get_degree(nf));
924 : : case t_POL:
925 : 870 : av = avma;
926 : 870 : return gerepileupto(av,poltobasis(nf,x));
927 : : }
928 : 0 : break;
929 : :
930 : : case t_POL:
931 : 4935 : av = avma;
932 : 4935 : return gerepileupto(av,poltobasis(nf,x));
933 : :
934 : : case t_COL:
935 [ - + ]: 4260 : if (lg(x)-1 != nf_get_degree(nf)) pari_err_DIM("nfalgtobasis");
936 : 4260 : return gcopy(x);
937 : :
938 : : case t_INT:
939 : 2879 : case t_FRAC: return scalarcol(x, nf_get_degree(nf));
940 : : }
941 : 0 : pari_err_TYPE("algtobasis",x);
942 : 12949 : return NULL; /* not reached */
943 : : }
944 : :
945 : : GEN
946 : 1045 : rnfbasistoalg(GEN rnf,GEN x)
947 : : {
948 : 1045 : const char *f = "rnfbasistoalg";
949 : : long lx, i;
950 : 1045 : pari_sp av = avma;
951 : : GEN z, nf, relpol, T;
952 : :
953 : 1045 : checkrnf(rnf);
954 : 1045 : nf = rnf_get_nf(rnf);
955 : 1045 : T = nf_get_pol(nf);
956 : 1045 : relpol = QXQX_to_mod_shallow(rnf_get_pol(rnf), T);
957 [ + + + + ]: 1045 : switch(typ(x))
958 : : {
959 : : case t_COL:
960 : 500 : z = cgetg_copy(x, &lx);
961 [ + + ]: 1460 : for (i=1; i<lx; i++)
962 : : {
963 : 995 : GEN c = nf_to_scalar_or_alg(nf, gel(x,i));
964 [ + + ]: 960 : if (typ(c) == t_POL) c = mkpolmod(c,T);
965 : 960 : gel(z,i) = c;
966 : : }
967 : 465 : z = RgV_RgC_mul(gel(rnf_get_zk(rnf),1), z);
968 : 420 : return gerepileupto(av, gmodulo(z,relpol));
969 : :
970 : : case t_POLMOD:
971 : 305 : x = polmod_nffix(f, rnf, x, 0);
972 [ + + ]: 155 : if (typ(x) != t_POL) break;
973 : 45 : retmkpolmod(RgX_copy(x), RgX_copy(relpol));
974 : : case t_POL:
975 [ + + ]: 220 : if (varn(x) == varn(T))
976 : : {
977 [ + + ]: 85 : if (!RgX_is_QX(x)) pari_err_TYPE(f,x);
978 : 50 : x = gmodulo(x,T); break;
979 : : }
980 [ + + ]: 135 : if (varn(x) == varn(relpol))
981 : : {
982 : 100 : x = RgX_nffix(f,nf_get_pol(nf),x,0);
983 : 100 : return gmodulo(x, relpol);
984 : : }
985 : 35 : pari_err_VAR(f, x,relpol);
986 : : }
987 : 745 : retmkpolmod(scalarpol(x, varn(relpol)), RgX_copy(relpol));
988 : : }
989 : :
990 : : GEN
991 : 560 : matbasistoalg(GEN nf,GEN x)
992 : : {
993 : : long i, j, li, lx;
994 : 560 : GEN z = cgetg_copy(x, &lx);
995 : :
996 [ + + ]: 560 : if (lx == 1) return z;
997 [ + + - ]: 550 : switch(typ(x))
998 : : {
999 : : case t_VEC: case t_COL:
1000 [ + + ]: 40 : for (i=1; i<lx; i++) gel(z,i) = basistoalg(nf, gel(x,i));
1001 : 20 : return z;
1002 : 530 : case t_MAT: break;
1003 : 0 : default: pari_err_TYPE("matbasistoalg",x);
1004 : : }
1005 : 530 : li = lgcols(x);
1006 [ + + ]: 3245 : for (j=1; j<lx; j++)
1007 : : {
1008 : 2715 : GEN c = cgetg(li,t_COL), xj = gel(x,j);
1009 : 2715 : gel(z,j) = c;
1010 [ + + ]: 20025 : for (i=1; i<li; i++) gel(c,i) = basistoalg(nf, gel(xj,i));
1011 : : }
1012 : 560 : return z;
1013 : : }
1014 : :
1015 : : GEN
1016 : 350 : matalgtobasis(GEN nf,GEN x)
1017 : : {
1018 : : long i, j, li, lx;
1019 : 350 : GEN z = cgetg_copy(x, &lx);
1020 : :
1021 [ + + ]: 350 : if (lx == 1) return z;
1022 [ + + - ]: 330 : switch(typ(x))
1023 : : {
1024 : : case t_VEC: case t_COL:
1025 [ + + ]: 1630 : for (i=1; i<lx; i++) gel(z,i) = algtobasis(nf, gel(x,i));
1026 : 325 : return z;
1027 : 5 : case t_MAT: break;
1028 : 0 : default: pari_err_TYPE("matalgtobasis",x);
1029 : : }
1030 : 5 : li = lgcols(x);
1031 [ + + ]: 10 : for (j=1; j<lx; j++)
1032 : : {
1033 : 5 : GEN c = cgetg(li,t_COL), xj = gel(x,j);
1034 : 5 : gel(z,j) = c;
1035 [ + + ]: 15 : for (i=1; i<li; i++) gel(c,i) = algtobasis(nf, gel(xj,i));
1036 : : }
1037 : 350 : return z;
1038 : : }
1039 : : GEN
1040 : 1675 : RgM_to_nfM(GEN nf,GEN x)
1041 : : {
1042 : : long i, j, li, lx;
1043 : 1675 : GEN z = cgetg_copy(x, &lx);
1044 : :
1045 [ - + ]: 1675 : if (lx == 1) return z;
1046 : 1675 : li = lgcols(x);
1047 [ + + ]: 12815 : for (j=1; j<lx; j++)
1048 : : {
1049 : 11140 : GEN c = cgetg(li,t_COL), xj = gel(x,j);
1050 : 11140 : gel(z,j) = c;
1051 [ + + ]: 76410 : for (i=1; i<li; i++) gel(c,i) = nf_to_scalar_or_basis(nf, gel(xj,i));
1052 : : }
1053 : 1675 : return z;
1054 : : }
1055 : : GEN
1056 : 21808 : RgC_to_nfC(GEN nf,GEN x)
1057 : : {
1058 : 21808 : long i, lx = lg(x);
1059 : 21808 : GEN z = cgetg(lx, t_COL);
1060 [ + + ]: 162388 : for (i=1; i<lx; i++) gel(z,i) = nf_to_scalar_or_basis(nf, gel(x,i));
1061 : 21808 : return z;
1062 : : }
1063 : :
1064 : : /* x a t_POLMOD, supposedly in rnf = K[z]/(T), K = Q[y]/(Tnf) */
1065 : : GEN
1066 : 1215 : polmod_nffix(const char *f, GEN rnf, GEN x, int lift)
1067 : 1215 : { return polmod_nffix2(f, rnf_get_nfpol(rnf), rnf_get_pol(rnf), x,lift); }
1068 : : GEN
1069 : 1280 : polmod_nffix2(const char *f, GEN T, GEN relpol, GEN x, int lift)
1070 : : {
1071 [ + + ]: 1280 : if (RgX_equal_var(gel(x,1),relpol))
1072 : : {
1073 : 815 : x = gel(x,2);
1074 [ + + ][ + - ]: 815 : if (typ(x) == t_POL && varn(x) == varn(relpol))
1075 : : {
1076 : 810 : x = RgX_nffix(f, T, x, lift);
1077 [ + + + ]: 810 : switch(lg(x))
1078 : : {
1079 : 20 : case 2: return gen_0;
1080 : 165 : case 3: return gel(x,2);
1081 : : }
1082 : 625 : return x;
1083 : : }
1084 : : }
1085 : 1280 : return Rg_nffix(f, T, x, lift);
1086 : : }
1087 : : GEN
1088 : 820 : rnfalgtobasis(GEN rnf,GEN x)
1089 : : {
1090 : 820 : const char *f = "rnfalgtobasis";
1091 : 820 : pari_sp av = avma;
1092 : : GEN T, relpol;
1093 : :
1094 : 820 : checkrnf(rnf);
1095 : 820 : relpol = rnf_get_pol(rnf);
1096 : 820 : T = rnf_get_nfpol(rnf);
1097 [ + + + + ]: 820 : switch(typ(x))
1098 : : {
1099 : : case t_COL:
1100 [ + + ]: 35 : if (lg(x)-1 != rnf_get_degree(rnf)) pari_err_DIM(f);
1101 : 20 : x = RgV_nffix(f, T, x, 0);
1102 : 15 : return gerepilecopy(av, x);
1103 : :
1104 : : case t_POLMOD:
1105 : 725 : x = polmod_nffix(f, rnf, x, 0);
1106 [ + + ]: 695 : if (typ(x) != t_POL) break;
1107 : 490 : return gerepileupto(av, mulmat_pol(rnf_get_invzk(rnf), x));
1108 : : case t_POL:
1109 [ + + ]: 40 : if (varn(x) == varn(T))
1110 : : {
1111 [ + + ]: 15 : if (!RgX_is_QX(x)) pari_err_TYPE(f,x);
1112 : 10 : x = mkpolmod(x,T); break;
1113 : : }
1114 : 25 : x = RgX_nffix(f, T, x, 0);
1115 [ + + ]: 20 : if (degpol(x) >= degpol(relpol)) x = RgX_rem(x,relpol);
1116 : 20 : return gerepileupto(av, mulmat_pol(rnf_get_invzk(rnf), x));
1117 : : }
1118 : 760 : return gerepileupto(av, scalarcol(x, rnf_get_degree(rnf)));
1119 : : }
1120 : :
1121 : : /* Given a and b in nf, gives an algebraic integer y in nf such that a-b.y
1122 : : * is "small" */
1123 : : GEN
1124 : 190 : nfdiveuc(GEN nf, GEN a, GEN b)
1125 : : {
1126 : 190 : pari_sp av = avma;
1127 : 190 : a = nfdiv(nf,a,b);
1128 : 190 : return gerepileupto(av, ground(a));
1129 : : }
1130 : :
1131 : : /* Given a and b in nf, gives a "small" algebraic integer r in nf
1132 : : * of the form a-b.y */
1133 : : GEN
1134 : 190 : nfmod(GEN nf, GEN a, GEN b)
1135 : : {
1136 : 190 : pari_sp av = avma;
1137 : 190 : GEN p1 = gneg_i(nfmul(nf,b,ground(nfdiv(nf,a,b))));
1138 : 190 : return gerepileupto(av, nfadd(nf,a,p1));
1139 : : }
1140 : :
1141 : : /* Given a and b in nf, gives a two-component vector [y,r] in nf such
1142 : : * that r=a-b.y is "small". */
1143 : : GEN
1144 : 190 : nfdivrem(GEN nf, GEN a, GEN b)
1145 : : {
1146 : 190 : pari_sp av = avma;
1147 : 190 : GEN p1,z, y = ground(nfdiv(nf,a,b));
1148 : :
1149 : 190 : p1 = gneg_i(nfmul(nf,b,y));
1150 : 190 : z = cgetg(3,t_VEC);
1151 : 190 : gel(z,1) = gcopy(y);
1152 : 190 : gel(z,2) = nfadd(nf,a,p1); return gerepileupto(av, z);
1153 : : }
1154 : :
1155 : : /*************************************************************************/
1156 : : /** **/
1157 : : /** (Z_K/I)^* **/
1158 : : /** **/
1159 : : /*************************************************************************/
1160 : : /* return sign(sigma_k(x)), x t_COL (integral, primitive) */
1161 : : static long
1162 : 346339 : eval_sign(GEN M, GEN x, long k)
1163 : : {
1164 : 346339 : long i, l = lg(x);
1165 : 346339 : GEN z = gel(x,1); /* times M[k,1], which is 1 */
1166 [ + + ]: 985448 : for (i = 2; i < l; i++)
1167 : 639109 : z = mpadd(z, mpmul(gcoeff(M,k,i), gel(x,i)));
1168 [ - + ]: 346339 : if (realprec(z) < DEFAULTPREC) pari_err_PREC("nfsign_arch");
1169 : 346339 : return signe(z);
1170 : : }
1171 : :
1172 : : GEN
1173 : 552847 : vec01_to_indices(GEN v)
1174 : : {
1175 : : long i, k, l;
1176 : : GEN p;
1177 : :
1178 [ + + - ]: 552847 : switch (typ(v))
1179 : : {
1180 : 338233 : case t_VECSMALL: return v;
1181 : 214614 : case t_VEC: break;
1182 : 0 : default: pari_err_TYPE("vec01_to_indices",v);
1183 : : }
1184 : 214614 : l = lg(v);
1185 : 214614 : p = new_chunk(l) + l;
1186 [ + + ]: 760649 : for (k=1, i=l-1; i; i--)
1187 [ + + ]: 546035 : if (signe(gel(v,i))) { *--p = i; k++; }
1188 : 214614 : *--p = evallg(k) | evaltyp(t_VECSMALL);
1189 : 552847 : avma = (pari_sp)p; return p;
1190 : : }
1191 : : GEN
1192 : 2259 : indices_to_vec01(GEN p, long r)
1193 : : {
1194 : 2259 : long i, l = lg(p);
1195 : 2259 : GEN v = zerovec(r);
1196 [ + + ]: 3584 : for (i = 1; i < l; i++) gel(v, p[i]) = gen_1;
1197 : 2259 : return v;
1198 : : }
1199 : :
1200 : : /* return (column) vector of R1 signatures of x (0 or 1) */
1201 : : GEN
1202 : 421287 : nfsign_arch(GEN nf, GEN x, GEN arch)
1203 : : {
1204 : 421287 : GEN M, V, archp = vec01_to_indices(arch);
1205 : 421287 : long i, s, n = lg(archp)-1;
1206 : : pari_sp av;
1207 : :
1208 [ + + ]: 421287 : if (!n) return cgetg(1,t_VECSMALL);
1209 : 366443 : nf = checknf(nf);
1210 [ + + ]: 366443 : if (typ(x) == t_MAT)
1211 : : { /* factorisation */
1212 : 95175 : GEN g = gel(x,1), e = gel(x,2);
1213 : 95175 : V = zero_zv(n);
1214 [ + + ]: 290173 : for (i=1; i<lg(g); i++)
1215 [ + + ]: 194998 : if (mpodd(gel(e,i)))
1216 : 165126 : Flv_add_inplace(V, nfsign_arch(nf,gel(g,i),archp), 2);
1217 : 95175 : avma = (pari_sp)V; return V;
1218 : : }
1219 : 271268 : av = avma; V = cgetg(n+1,t_VECSMALL);
1220 : 271268 : x = nf_to_scalar_or_basis(nf, x);
1221 [ + + + ]: 271268 : switch(typ(x))
1222 : : {
1223 : : case t_INT:
1224 : 70001 : s = signe(x);
1225 [ - + ]: 70001 : if (!s) pari_err_DOMAIN("nfsign_arch","element","=",gen_0,x);
1226 : 70001 : avma = av; return const_vecsmall(n, (s < 0)? 1: 0);
1227 : : case t_FRAC:
1228 : 645 : s = signe(gel(x,1));
1229 : 645 : avma = av; return const_vecsmall(n, (s < 0)? 1: 0);
1230 : : }
1231 : 200622 : x = Q_primpart(x); M = nf_get_M(nf);
1232 [ + + ]: 546961 : for (i = 1; i <= n; i++) V[i] = (eval_sign(M, x, archp[i]) < 0)? 1: 0;
1233 : 421287 : avma = (pari_sp)V; return V;
1234 : : }
1235 : :
1236 : : /* return the vector of signs of x; the matrix of such if x is a vector
1237 : : * of nf elements */
1238 : : GEN
1239 : 35 : nfsign(GEN nf, GEN x)
1240 : : {
1241 : : long i, l;
1242 : : GEN arch, S;
1243 : :
1244 : 35 : nf = checknf(nf);
1245 : 35 : arch = identity_perm( nf_get_r1(nf) );
1246 [ + + ]: 35 : if (typ(x) != t_VEC) return nfsign_arch(nf, x, arch);
1247 : 25 : l = lg(x); S = cgetg(l, t_MAT);
1248 [ + + ]: 176 : for (i=1; i<l; i++) gel(S,i) = nfsign_arch(nf, gel(x,i), arch);
1249 : 35 : return S;
1250 : : }
1251 : :
1252 : : /* multiply y by t = 1 mod^* f such that sign(x) = sign(y) at arch = divisor[2].
1253 : : * If x == NULL, make y >> 0 at sarch */
1254 : : GEN
1255 : 48787 : set_sign_mod_divisor(GEN nf, GEN x, GEN y, GEN divisor, GEN sarch)
1256 : : {
1257 : : GEN s, archp, gen;
1258 : : long nba,i;
1259 [ - + ]: 48787 : if (!sarch) return y;
1260 : 48787 : gen = gel(sarch,2); nba = lg(gen);
1261 [ + + ]: 48787 : if (nba == 1) return y;
1262 : :
1263 : 41572 : archp = vec01_to_indices(gel(divisor,2));
1264 : 41572 : s = nfsign_arch(nf, y, archp);
1265 [ + + ]: 41572 : if (x) Flv_add_inplace(s, nfsign_arch(nf, x, archp), 2);
1266 : 41572 : s = Flm_Flc_mul(gel(sarch,3), s, 2);
1267 [ + + ]: 100884 : for (i=1; i<nba; i++)
1268 [ + + ]: 59312 : if (s[i]) y = nfmul(nf,y,gel(gen,i));
1269 : 48787 : return y;
1270 : : }
1271 : :
1272 : : /* given an element x in Z_K and an integral ideal y in HNF, coprime with x,
1273 : : outputs an element inverse of x modulo y */
1274 : : GEN
1275 : 101 : nfinvmodideal(GEN nf, GEN x, GEN y)
1276 : : {
1277 : 101 : pari_sp av = avma;
1278 : 101 : GEN a, yZ = gcoeff(y,1,1);
1279 : :
1280 [ - + ]: 101 : if (is_pm1(yZ)) return zerocol( nf_get_degree(nf) );
1281 : 101 : x = nf_to_scalar_or_basis(nf, x);
1282 [ + + ]: 101 : if (typ(x) == t_INT) return gerepileupto(av, Fp_inv(x, yZ));
1283 : :
1284 : 56 : a = hnfmerge_get_1(idealhnf_principal(nf,x), y);
1285 [ - + ]: 56 : if (!a) pari_err_INV("nfinvmodideal", x);
1286 : 101 : return gerepileupto(av, ZC_hnfrem(nfdiv(nf,a,x), y));
1287 : : }
1288 : :
1289 : : static GEN
1290 : 180780 : nfsqrmodideal(GEN nf, GEN x, GEN id) {
1291 : 180780 : return ZC_hnfrem(nfsqri(nf,x), id);
1292 : : }
1293 : : static GEN
1294 : 433977 : nfmulmodideal(GEN nf, GEN x, GEN y, GEN id) {
1295 [ + + ]: 433977 : return x? ZC_hnfrem(nfmuli(nf,x,y), id): y;
1296 : : }
1297 : : /* assume x integral, k integer, A in HNF */
1298 : : GEN
1299 : 294648 : nfpowmodideal(GEN nf,GEN x,GEN k,GEN A)
1300 : : {
1301 : 294648 : long s = signe(k);
1302 : : pari_sp av;
1303 : : GEN y;
1304 : :
1305 [ - + ]: 294648 : if (!s) return gen_1;
1306 : 294648 : av = avma;
1307 : 294648 : x = nf_to_scalar_or_basis(nf, x);
1308 [ + + ]: 294648 : if (typ(x) != t_COL) return Fp_pow(x, k, gcoeff(A,1,1));
1309 [ - + ]: 132971 : if (s < 0) { x = nfinvmodideal(nf, x,A); k = absi(k); }
1310 : 132971 : for(y = NULL;;)
1311 : : {
1312 [ + + ]: 313751 : if (mpodd(k)) y = nfmulmodideal(nf,y,x,A);
1313 [ + + ]: 313751 : k = shifti(k,-1); if (!signe(k)) break;
1314 : 180780 : x = nfsqrmodideal(nf,x,A);
1315 : 180780 : }
1316 : 294648 : return gerepileupto(av, y);
1317 : : }
1318 : :
1319 : : /* a * g^n mod id */
1320 : : static GEN
1321 : 254950 : elt_mulpow_modideal(GEN nf, GEN a, GEN g, GEN n, GEN id)
1322 : : {
1323 : 254950 : return nfmulmodideal(nf, a, nfpowmodideal(nf,g,n,id), id);
1324 : : }
1325 : :
1326 : : /* assume (num(g[i]), id) = 1 for all i. Return prod g[i]^e[i] mod id.
1327 : : * EX = multiple of exponent of (O_K/id)^* */
1328 : : GEN
1329 : 98902 : famat_to_nf_modideal_coprime(GEN nf, GEN g, GEN e, GEN id, GEN EX)
1330 : : {
1331 : 98902 : GEN plus = NULL, minus = NULL, idZ = gcoeff(id,1,1);
1332 : 98902 : pari_sp av = avma, lim = stack_lim(av,2);
1333 : 98902 : long i, lx = lg(g);
1334 [ + + ]: 98902 : GEN EXo2 = (expi(EX) > 10)? shifti(EX,-1): NULL;
1335 : :
1336 [ + + ]: 98902 : if (is_pm1(idZ)) lx = 1; /* id = Z_K */
1337 [ + + ]: 351195 : for (i=1; i<lx; i++)
1338 : : {
1339 : 252293 : GEN h, n = centermodii(gel(e,i), EX, EXo2);
1340 : 252293 : long sn = signe(n);
1341 [ + + ]: 252293 : if (!sn) continue;
1342 : :
1343 : 212192 : h = nf_to_scalar_or_basis(nf, gel(g,i));
1344 [ + - + ]: 212192 : switch(typ(h))
1345 : : {
1346 : 144988 : case t_INT: break;
1347 : : case t_FRAC:
1348 : 0 : h = Fp_div(gel(h,1), gel(h,2), idZ); break;
1349 : : default:
1350 : : {
1351 : : GEN dh;
1352 : 67204 : h = Q_remove_denom(h, &dh);
1353 [ - + ]: 67204 : if (dh) h = FpC_Fp_mul(h, Fp_inv(dh,idZ), idZ);
1354 : : }
1355 : : }
1356 [ + + ]: 212192 : if (sn > 0)
1357 : 211296 : plus = elt_mulpow_modideal(nf, plus, h, n, id);
1358 : : else /* sn < 0 */
1359 : 896 : minus = elt_mulpow_modideal(nf, minus, h, absi(n), id);
1360 : :
1361 [ - + ]: 212192 : if (low_stack(lim, stack_lim(av, 2)))
1362 : : {
1363 [ # # ]: 0 : if(DEBUGMEM>1) pari_warn(warnmem,"famat_to_nf_modideal_coprime");
1364 [ # # ]: 0 : if (!plus) plus = gen_0;
1365 [ # # ]: 0 : if (!minus) minus = gen_0;
1366 : 0 : gerepileall(av,2, &plus, &minus);
1367 [ # # ]: 0 : if (isintzero(plus)) plus = NULL;
1368 [ # # ]: 0 : if (isintzero(minus)) minus = NULL;
1369 : : }
1370 : : }
1371 [ + + ]: 98902 : if (minus)
1372 : 101 : plus = nfmulmodideal(nf, plus, nfinvmodideal(nf,minus,id), id);
1373 [ + + ]: 98902 : return plus? plus: scalarcol_shallow(gen_1, lg(id)-1);
1374 : : }
1375 : :
1376 : : /* given 2 integral ideals x, y in HNF s.t x | y | x^2, compute the quotient
1377 : : (1+x)/(1+y) in the form [[cyc],[gen]], if U != NULL, set *U := ux^-1 */
1378 : : static GEN
1379 : 8160 : zidealij(GEN x, GEN y, GEN *U)
1380 : : {
1381 : : GEN G, cyc;
1382 : : long j, N;
1383 : :
1384 : : /* x^(-1) y = relations between the 1 + x_i (HNF) */
1385 : 8160 : cyc = ZM_snf_group(hnf_solve(x, y), U, &G);
1386 : 8160 : N = lg(cyc); G = ZM_mul(x,G); settyp(G, t_VEC); /* new generators */
1387 [ + + ]: 40186 : for (j=1; j<N; j++)
1388 : : {
1389 : 32026 : GEN c = gel(G,j);
1390 : 32026 : gel(c,1) = addiu(gel(c,1), 1); /* 1 + g_j */
1391 [ + + ]: 32026 : if (ZV_isscalar(c)) gel(G,j) = gel(c,1);
1392 : : }
1393 [ + + ]: 8160 : if (U) *U = RgM_mul(*U, RgM_inv(x));
1394 : 8160 : return mkvec2(cyc, G);
1395 : : }
1396 : :
1397 : : static GEN
1398 : 224701 : Fq_FpXQ_log(GEN a, GEN g, GEN ord, GEN T, GEN p)
1399 : : {
1400 [ + + ]: 224701 : if (!T) return Fp_log(a,g,ord,p);
1401 [ + + ]: 67440 : if (typ(a)==t_INT) return Fp_FpXQ_log(a,g,ord,T,p);
1402 : 224701 : return FpXQ_log(a,g,ord,T,p);
1403 : : }
1404 : : /* same in nf.zk / pr */
1405 : : static GEN
1406 : 224701 : nf_log(GEN nf, GEN a, GEN g, GEN ord, GEN pr)
1407 : : {
1408 : 224701 : pari_sp av = avma;
1409 : 224701 : GEN T,p, modpr = nf_to_Fq_init(nf, &pr, &T, &p);
1410 : 224701 : GEN A = nf_to_Fq(nf,a,modpr);
1411 : 224701 : GEN G = nf_to_Fq(nf,g,modpr);
1412 : 224701 : return gerepileuptoint(av, Fq_FpXQ_log(A,G,ord,T,p));
1413 : : }
1414 : :
1415 : : /* Product of cyc entries, with cyc = diagonal(Smith Normal Form), assumed != 0.
1416 : : * Set L to the index of the last non-trivial (!= 1) entry */
1417 : : GEN
1418 : 5008 : detcyc(GEN cyc, long *L)
1419 : : {
1420 : 5008 : pari_sp av = avma;
1421 : 5008 : long i, l = lg(cyc);
1422 : 5008 : GEN s = gel(cyc,1);
1423 : :
1424 [ + + ]: 5008 : if (l == 1) { *L = 1; return gen_1; }
1425 [ + + ]: 6876 : for (i=2; i<l; i++)
1426 : : {
1427 : 2479 : GEN t = gel(cyc,i);
1428 [ + + ]: 2479 : if (is_pm1(t)) break;
1429 : 1873 : s = mulii(s, t);
1430 : : }
1431 [ + + ]: 5008 : *L = i; return i <= 2? icopy(s): gerepileuptoint(av,s);
1432 : : }
1433 : :
1434 : : /* (U,V) = 1. Return y = x mod U, = 1 mod V (uv: u + v = 1, u in U, v in V),
1435 : : * namely u + x*v.
1436 : : * Either (u,mv) are both t_INT, or
1437 : : * u is a t_COL, mv is a t_MAT, multiplication table by v */
1438 : : static GEN
1439 : 2969 : makeprimetoideal(GEN UV, GEN u,GEN mv, GEN x)
1440 : : {
1441 : : GEN t;
1442 [ + + ]: 2969 : if (typ(mv) == t_INT) /* u t_INT */
1443 : : {
1444 [ + + ]: 760 : if (typ(x) == t_INT) return addii(mulii(x,mv), u);
1445 : 390 : t = ZC_Z_add(ZC_Z_mul(x,mv), u);
1446 : : }
1447 : : else
1448 : : {
1449 [ + + ]: 2209 : t = typ(x) == t_INT? ZC_Z_mul(gel(mv,1),x): ZM_ZC_mul(mv,x);
1450 : 2209 : t = ZC_add(t, u);
1451 : : }
1452 : 2969 : return ZC_hnfrem(t, UV);
1453 : : }
1454 : :
1455 : : static GEN
1456 : 740 : makeprimetoidealvec(GEN UV, GEN u,GEN mv, GEN gen)
1457 : : {
1458 : : long i, ly;
1459 : 740 : GEN y = cgetg_copy(gen, &ly);
1460 [ + + ]: 1520 : for (i=1; i<ly; i++) gel(y,i) = makeprimetoideal(UV,u,mv, gel(gen,i));
1461 : 740 : return y;
1462 : : }
1463 : :
1464 : : /* Given an ideal pr^ep, and an integral ideal x (in HNF form) compute a list
1465 : : * of vectors,corresponding to the abelian groups (O_K/pr)^*, and
1466 : : * 1 + pr^i/ 1 + pr^min(2i, ep), i = 1,...
1467 : : * Each vector has 5 components as follows :
1468 : : * [[cyc],[g],[g'],[sign],U.X^-1].
1469 : : * cyc = type as abelian group
1470 : : * g, g' = generators. (g',x) = 1, not necessarily so for g
1471 : : * sign = vector of the sign(g') at arch.
1472 : : * If x = NULL, the original ideal was a prime power */
1473 : : static GEN
1474 : 8465 : zprimestar(GEN nf, GEN pr, GEN ep, GEN x, GEN arch)
1475 : : {
1476 : 8465 : pari_sp av = avma;
1477 : 8465 : long a, e = itos(ep), f = pr_get_f(pr);
1478 : 8465 : GEN p = pr_get_p(pr), list, g, g0, y, u,v, prb, pre;
1479 : : ulong mask;
1480 : :
1481 [ - + ]: 8465 : if(DEBUGLEVEL>3) err_printf("treating pr^%ld, pr = %Ps\n",e,pr);
1482 [ + + ]: 8465 : if (f == 1)
1483 : 3931 : g = pgener_Fp(p);
1484 : : else
1485 : : {
1486 : 4534 : GEN T, modpr = zk_to_Fq_init(nf, &pr, &T, &p);
1487 : 4534 : g = Fq_to_nf(gener_FpXQ(T,p,NULL), modpr);
1488 : 4534 : g = poltobasis(nf, g);
1489 : : }
1490 : : /* g generates (Z_K / pr)^* */
1491 : 8465 : prb = idealhnf_two(nf,pr);
1492 [ + + ]: 8465 : pre = (e==1)? prb: idealpow(nf,pr,ep);
1493 [ + + ]: 8465 : if (x)
1494 : : {
1495 : : GEN mv;
1496 : 1372 : v = idealaddtoone_i(nf,idealdivpowprime(nf,x,pr,ep), pre);
1497 : 1367 : mv = zk_scalar_or_multable(nf, v);
1498 [ + + ]: 1367 : u = typ(mv) == t_INT? subui(1,mv): unnf_minus_x(v);
1499 : 1367 : v = mv;
1500 : 1367 : g0 = makeprimetoideal(x,u,mv,g);
1501 : : }
1502 : : else
1503 : : {
1504 : 7093 : u = v = NULL; /* gcc -Wall */
1505 : 7093 : g0 = g;
1506 : : }
1507 : :
1508 : 8460 : y = mkvec5(mkvec(subiu(powiu(p,f), 1)),
1509 : : mkvec(g),
1510 : : mkvec(g0),
1511 : : mkvec(nfsign_arch(nf,g0,arch)),
1512 : : gen_1);
1513 [ + + ]: 8460 : if (e == 1) return gerepilecopy(av, mkvec(y));
1514 : 5037 : list = vectrunc_init(e+1);
1515 : 5037 : vectrunc_append(list, y);
1516 : 5037 : mask = quadratic_prec_mask(e);
1517 : 5037 : a = 1;
1518 [ + + ]: 12539 : while (mask > 1)
1519 : : {
1520 : 7502 : GEN pra = prb, gen, z, s, U;
1521 : 7502 : long i, l, b = a << 1;
1522 : :
1523 [ + + ]: 7502 : if (mask & 1) b--;
1524 : 7502 : mask >>= 1;
1525 : : /* compute 1 + pr^a / 1 + pr^b, 2a <= b */
1526 [ - + ]: 7502 : if(DEBUGLEVEL>3) err_printf(" treating a = %ld, b = %ld\n",a,b);
1527 [ + + ]: 7502 : prb = (b >= e)? pre: idealpows(nf,pr,b);
1528 : 7502 : z = zidealij(pra, prb, &U);
1529 : 7502 : gen = leafcopy(gel(z,2));
1530 : 7502 : s = cgetg_copy(gen, &l);
1531 [ + + ]: 38710 : for (i = 1; i < l; i++)
1532 : : {
1533 [ + + ]: 31208 : if (x) gel(gen,i) = makeprimetoideal(x,u,v,gel(gen,i));
1534 : 31208 : gel(s,i) = nfsign_arch(nf,gel(gen,i),arch);
1535 : : }
1536 : 7502 : y = mkvec5(gel(z,1), gel(z,2), gen, s, U);
1537 : 7502 : vectrunc_append(list, y);
1538 : 7502 : a = b;
1539 : : }
1540 : 8460 : return gerepilecopy(av, list);
1541 : : }
1542 : :
1543 : : /* increment y, which runs through [-d,d]^k. Return 0 when done. */
1544 : : static int
1545 : 2125 : increment(GEN y, long k, long d)
1546 : : {
1547 : 2125 : long i = 0, j;
1548 : : do
1549 : : {
1550 [ - + ]: 2965 : if (++i > k) return 0;
1551 : 2965 : y[i]++;
1552 [ + + ]: 2965 : } while (y[i] > d);
1553 [ + + ]: 2965 : for (j = 1; j < i; j++) y[j] = -d;
1554 : 2125 : return 1;
1555 : : }
1556 : :
1557 : : GEN
1558 : 1200 : archstar_full_rk(GEN x, GEN bas, GEN v, GEN gen)
1559 : : {
1560 : 1200 : long i, r, lgmat, N = lg(bas)-1, nba = nbrows(v);
1561 : 1200 : GEN lambda = cgetg(N+1, t_VECSMALL), mat = cgetg(nba+1,t_MAT);
1562 : :
1563 : 1200 : lgmat = lg(v); setlg(mat, lgmat+1);
1564 [ + + ]: 2400 : for (i = 1; i < lgmat; i++) gel(mat,i) = gel(v,i);
1565 [ + + ]: 2400 : for ( ; i <= nba; i++) gel(mat,i) = cgetg(nba+1, t_VECSMALL);
1566 : :
1567 [ + + ]: 1200 : if (x) { x = ZM_lll(x, 0.75, LLL_INPLACE); bas = RgV_RgM_mul(bas, x); }
1568 : :
1569 : 1200 : for (r=1;; r++)
1570 : : { /* reset */
1571 : 1200 : (void)vec_setconst(lambda, (GEN)0);
1572 [ + + ]: 1200 : if (!x) lambda[1] = r;
1573 [ + - ]: 2125 : while (increment(lambda, N, r))
1574 : : {
1575 : 2125 : pari_sp av1 = avma;
1576 : 2125 : GEN a = RgM_zc_mul(bas, lambda), c = gel(mat,lgmat);
1577 [ + + ]: 6375 : for (i = 1; i <= nba; i++)
1578 : : {
1579 [ + + ]: 4250 : GEN t = x? gadd(gel(a,i), gen_1): gel(a,i);
1580 : 4250 : c[i] = (gsigne(t) < 0)? 1: 0;
1581 : : }
1582 [ + + ]: 2125 : avma = av1; if (Flm_deplin(mat, 2)) continue;
1583 : :
1584 : : /* c independent of previous sign vectors */
1585 [ + + ]: 1200 : if (!x) a = zc_to_ZC(lambda);
1586 : : else
1587 : : {
1588 : 895 : a = ZM_zc_mul(x, lambda);
1589 : 895 : gel(a,1) = addis(gel(a,1), 1);
1590 : : }
1591 : 1200 : gel(gen,lgmat) = a;
1592 [ + - ]: 1200 : if (lgmat++ == nba) {
1593 : 1200 : mat = Flm_inv(mat,2); /* full rank */
1594 : 1200 : settyp(mat, t_VEC); return mat;
1595 : : }
1596 : 0 : setlg(mat,lgmat+1);
1597 : : }
1598 : 0 : }
1599 : : }
1600 : :
1601 : : /* x non-0 integral ideal in HNF, compute elements in 1+x (in x, if x = zk)
1602 : : * whose sign matrix is invertible. archp in 'indices' format */
1603 : : GEN
1604 : 9092 : nfarchstar(GEN nf, GEN x, GEN archp)
1605 : : {
1606 : 9092 : long nba = lg(archp) - 1;
1607 : : GEN cyc, gen, mat;
1608 : :
1609 [ + + ]: 9092 : if (!nba)
1610 : 5798 : cyc = gen = mat = cgetg(1, t_VEC);
1611 : : else
1612 : : {
1613 : 3294 : GEN xZ = gcoeff(x,1,1), gZ;
1614 : 3294 : pari_sp av = avma;
1615 [ + + ]: 3294 : if (is_pm1(xZ)) x = NULL; /* x = O_K */
1616 [ + + ]: 3294 : gZ = x? subsi(1, xZ): gen_m1; /* gZ << 0, gZ = 1 mod x */
1617 [ + + ]: 3294 : if (nba == 1)
1618 : : {
1619 : 2099 : gen = mkvec(gZ);
1620 : 2099 : mat = mkvec( mkvecsmall(1) );
1621 : : }
1622 : : else
1623 : : {
1624 : 1195 : GEN bas = nf_get_M(nf);
1625 [ + + ]: 1195 : if (lgcols(bas) > lg(archp)) bas = rowpermute(bas, archp);
1626 : 1195 : gen = cgetg(nba+1,t_VEC);
1627 : 1195 : gel(gen,1) = gZ;
1628 : 1195 : mat = archstar_full_rk(x, bas, mkmat(const_vecsmall(nba,1)), gen);
1629 : 1195 : gerepileall(av,2,&gen,&mat);
1630 : : }
1631 : 3294 : cyc = const_vec(nba, gen_2);
1632 : : }
1633 : 9092 : return mkvec3(cyc,gen,mat);
1634 : : }
1635 : :
1636 : : static GEN
1637 : 150782 : apply_U(GEN U, GEN a)
1638 : : {
1639 : : GEN e;
1640 [ + + ]: 150782 : if (typ(a) == t_INT)
1641 : 52713 : e = RgC_Rg_mul(gel(U,1), subis(a, 1));
1642 : : else
1643 : : { /* t_COL */
1644 : 98069 : GEN t = gel(a,1);
1645 : 98069 : gel(a,1) = addsi(-1, gel(a,1)); /* a -= 1 */
1646 : 98069 : e = RgM_RgC_mul(U, a);
1647 : 98069 : gel(a,1) = t; /* restore */
1648 : : }
1649 : 150782 : return e;
1650 : : }
1651 : : /* a in Z_K (t_COL or t_INT), pr prime ideal, prk = pr^k,
1652 : : * list = zprimestar(nf, pr, k, ...) */
1653 : : static GEN
1654 : 224701 : zlog_pk(GEN nf, GEN a, GEN y, GEN pr, GEN prk, GEN list, GEN *psigne)
1655 : : {
1656 : 224701 : long i,j, llist = lg(list)-1;
1657 [ + + ]: 600059 : for (j = 1; j <= llist; j++)
1658 : : {
1659 : 375363 : GEN L = gel(list,j), e;
1660 : 375363 : GEN cyc = gel(L,1), gen = gel(L,2), s = gel(L,4), U = gel(L,5);
1661 [ + + ]: 375363 : if (j == 1)
1662 : 224701 : e = mkcol( nf_log(nf, a, gel(gen,1), gel(cyc,1), pr) );
1663 : : else
1664 : 150662 : e = apply_U(U, a);
1665 : : /* here lg(e) == lg(cyc) */
1666 [ + + ]: 1098465 : for (i = 1; i < lg(cyc); i++)
1667 : : {
1668 : : GEN t;
1669 [ + + ]: 723107 : if (typ(gel(e,i)) != t_INT) pari_err_COPRIME("zlog_pk", a, pr);
1670 : 723102 : t = modii(negi(gel(e,i)), gel(cyc,i));
1671 [ + + ]: 723102 : gel(++y,0) = negi(t); if (!signe(t)) continue;
1672 : :
1673 [ + + ]: 220934 : if (mod2(t)) Flv_add_inplace(*psigne, gel(s,i), 2);
1674 [ + + ]: 220934 : if (j != llist) a = elt_mulpow_modideal(nf, a, gel(gen,i), t, prk);
1675 : : }
1676 : : }
1677 : 224696 : return y;
1678 : : }
1679 : :
1680 : : static void
1681 : 219004 : zlog_add_sign(GEN y0, GEN sgn, GEN lists)
1682 : : {
1683 : : GEN y, s;
1684 : : long i;
1685 [ - + ]: 438008 : if (!sgn) return;
1686 : 219004 : y = y0 + lg(y0);
1687 : 219004 : s = Flm_Flc_mul(gmael(lists, lg(lists)-1, 3), sgn, 2);
1688 [ + + ][ + + ]: 508098 : for (i = lg(s)-1; i > 0; i--) gel(--y,0) = s[i]? gen_1: gen_0;
1689 : : }
1690 : :
1691 : : static GEN
1692 : 90821 : famat_zlog(GEN nf, GEN fa, GEN sgn, GEN bid)
1693 : : {
1694 : 90821 : GEN g = gel(fa,1), e = gel(fa,2);
1695 : 90821 : GEN vp = gmael(bid, 3,1), ep = gmael(bid, 3,2);
1696 : 90821 : GEN arch = bid_get_arch(bid);
1697 : 90821 : GEN cyc = bid_get_cyc(bid), lists = gel(bid,4), U = gel(bid,5);
1698 : 90821 : GEN y0, x, y, EX = gel(cyc,1);
1699 : : long i, l;
1700 : :
1701 : 90821 : y0 = y = cgetg(lg(U), t_COL);
1702 [ + - ]: 90821 : if (!sgn) sgn = nfsign_arch(nf, mkmat2(g,e), arch);
1703 : 90821 : l = lg(vp);
1704 [ + + ]: 178727 : for (i=1; i < l; i++)
1705 : : {
1706 : 87906 : GEN pr = gel(vp,i), prk, ex;
1707 [ + + ]: 87906 : if (l == 2) {
1708 : 62775 : prk = bid_get_ideal(bid);
1709 : 62775 : ex = EX;
1710 : : } else { /* try to improve EX: should be group exponent mod prf, not f */
1711 : 25131 : GEN k = gel(ep,i);
1712 : 25131 : prk = idealpow(nf, pr, k);
1713 : : /* upper bound: gcd(EX, (Nv-1)p^(k-1)) = (Nv-1) p^min(k-1,v_p(EX)) */
1714 : 25131 : ex = subis(pr_norm(pr),1);
1715 [ + + ]: 25131 : if (!is_pm1(k)) {
1716 : 2092 : GEN p = pr_get_p(pr), k_1 = subis(k,1);
1717 : 2092 : long v = Z_pval(EX, p);
1718 [ - + ]: 2092 : if (cmpui(v, k_1) > 0) v = itos(k_1);
1719 [ + - ]: 2092 : if (v) ex = mulii(ex, powiu(p, v));
1720 : : }
1721 : : }
1722 : 87906 : x = famat_makecoprime(nf, g, e, pr, prk, ex);
1723 : 87906 : y = zlog_pk(nf, x, y, pr, prk, gel(lists,i), &sgn);
1724 : : }
1725 : 90821 : zlog_add_sign(y0, sgn, lists);
1726 : 90821 : return y0;
1727 : : }
1728 : :
1729 : : static GEN
1730 : 86585 : get_index(GEN lists)
1731 : : {
1732 : 86585 : long t = 0, j, k, l = lg(lists)-1;
1733 : 86585 : GEN L, ind = cgetg(l+1, t_VECSMALL);
1734 : :
1735 [ + + ]: 190868 : for (k = 1; k < l; k++)
1736 : : {
1737 : 104283 : L = gel(lists,k);
1738 : 104283 : ind[k] = t;
1739 [ + + ]: 257990 : for (j=1; j<lg(L); j++) t += lg(gmael(L,j,1)) - 1;
1740 : : }
1741 : : /* for arch. components */
1742 : 86585 : ind[k] = t; return ind;
1743 : : }
1744 : :
1745 : : static void
1746 : 86585 : init_zlog(zlog_S *S, long n, GEN P, GEN e, GEN arch, GEN lists, GEN U)
1747 : : {
1748 : 86585 : S->n = n;
1749 : 86585 : S->U = U;
1750 : 86585 : S->P = P;
1751 : 86585 : S->e = e;
1752 : 86585 : S->archp = vec01_to_indices(arch);
1753 : 86585 : S->lists = lists;
1754 : 86585 : S->ind = get_index(lists);
1755 : 86585 : }
1756 : : void
1757 : 78863 : init_zlog_bid(zlog_S *S, GEN bid)
1758 : : {
1759 : 78863 : GEN fa = gel(bid,3), lists = gel(bid,4), U = gel(bid,5);
1760 : 78863 : GEN arch = gel(bid_get_mod(bid), 2);
1761 : 78863 : init_zlog(S, lg(U)-1, gel(fa,1), gel(fa,2), arch, lists, U);
1762 : 78863 : }
1763 : :
1764 : : /* Return decomposition of a on the S->n successive generators contained in
1765 : : * S->lists. If index !=0, do the computation for the corresponding prime
1766 : : * ideal and set to 0 the other components. */
1767 : : static GEN
1768 : 118033 : zlog_ind(GEN nf, GEN a, zlog_S *S, GEN sgn, long index)
1769 : : {
1770 : 118033 : GEN y0 = zerocol(S->n), y;
1771 : 118033 : pari_sp av = avma;
1772 : : long k, kmin, kmax;
1773 : :
1774 : 118033 : a = nf_to_scalar_or_basis(nf,a);
1775 [ + + ]: 118033 : if (index)
1776 : : {
1777 : 39668 : kmin = kmax = index;
1778 : 39668 : y = y0 + S->ind[index];
1779 : : }
1780 : : else
1781 : : {
1782 : 78365 : kmin = 1; kmax = lg(S->P)-1;
1783 : 78365 : y = y0;
1784 : : }
1785 [ + + ]: 118033 : if (!sgn) sgn = nfsign_arch(nf, a, S->archp);
1786 [ + + ]: 252966 : for (k = kmin; k <= kmax; k++)
1787 : : {
1788 : 134938 : GEN list= gel(S->lists,k);
1789 : 134938 : GEN pr = gel(S->P,k);
1790 : 134938 : GEN prk = idealpow(nf, pr, gel(S->e,k));
1791 : 134938 : y = zlog_pk(nf, a, y, pr, prk, list, &sgn);
1792 : : }
1793 : 118028 : zlog_add_sign(y0, sgn, S->lists);
1794 : 118028 : return gerepilecopy(av, y0);
1795 : : }
1796 : : /* sgn = sign(a, S->arch) or NULL if unknown */
1797 : : GEN
1798 : 78365 : zlog(GEN nf, GEN a, GEN sgn, zlog_S *S) { return zlog_ind(nf, a, S, sgn, 0); }
1799 : :
1800 : : /* Log on bid.gen of generators of P_{1,I pr^{e-1}} / P_{1,I pr^e} (I,pr) = 1,
1801 : : * defined implicitly via CRT. 'index' is the index of pr in modulus
1802 : : * factorization */
1803 : : GEN
1804 : 5851 : log_gen_pr(zlog_S *S, long index, GEN nf, long e)
1805 : : {
1806 : 5851 : long i, l, yind = S->ind[index];
1807 : 5851 : GEN y, A, L, L2 = gel(S->lists,index);
1808 : :
1809 [ + + ]: 5851 : if (e == 1)
1810 : : {
1811 : 4299 : L = gel(L2,1);
1812 : 4299 : y = col_ei(S->n, yind+1);
1813 : 4299 : zlog_add_sign(y, gmael(L,4,1), S->lists);
1814 : 4299 : retmkmat( ZM_ZC_mul(S->U, y) );
1815 : : }
1816 : : else
1817 : : {
1818 : 1552 : GEN prk, g, pr = gel(S->P,index);
1819 : 1552 : long narchp = lg(S->archp)-1;
1820 : :
1821 [ + + ]: 1552 : if (e == 2)
1822 : 914 : L = gel(L2,2);
1823 : : else
1824 : 638 : L = zidealij(idealpows(nf,pr,e-1), idealpows(nf,pr,e), NULL);
1825 : 1552 : g = gel(L,2);
1826 : 1552 : l = lg(g); A = cgetg(l, t_MAT);
1827 : 1552 : prk = idealpow(nf, pr, gel(S->e,index));
1828 [ + + ]: 3409 : for (i = 1; i < l; i++)
1829 : : {
1830 : 1857 : GEN G = gel(g,i), sgn = zero_zv(narchp); /*positive at f_oo*/
1831 : 1857 : y = zerocol(S->n);
1832 : 1857 : (void)zlog_pk(nf, G, y + yind, pr, prk, L2, &sgn);
1833 : 1857 : zlog_add_sign(y, sgn, S->lists);
1834 : 1857 : gel(A,i) = y;
1835 : : }
1836 : 5851 : return ZM_mul(S->U, A);
1837 : : }
1838 : : }
1839 : : /* Log on bid.gen of generator of P_{1,f} / P_{1,f v[index]}
1840 : : * v = vector of r1 real places */
1841 : : GEN
1842 : 3999 : log_gen_arch(zlog_S *S, long index)
1843 : : {
1844 : 3999 : GEN y = zerocol(S->n);
1845 : 3999 : zlog_add_sign(y, vecsmall_ei(lg(S->archp)-1, index), S->lists);
1846 : 3999 : return ZM_ZC_mul(S->U, y);
1847 : : }
1848 : :
1849 : : /* add [h,cyc] or [h,cyc,gen] to bid */
1850 : : static void
1851 : 8957 : add_grp(GEN nf, GEN u1, GEN cyc, GEN gen, GEN bid)
1852 : : {
1853 : 8957 : GEN h = ZV_prod(cyc);
1854 [ + + ]: 8957 : if (u1)
1855 : : {
1856 : 4573 : GEN G = mkvec3(h,cyc,NULL/*dummy, bid[2] needed below*/);
1857 : 4573 : gel(bid,2) = G;
1858 [ + + ]: 4573 : if (u1 != gen_1)
1859 : : {
1860 : 3793 : long i, c = lg(u1);
1861 : 3793 : GEN g = cgetg(c,t_VEC);
1862 [ + + ]: 11620 : for (i=1; i<c; i++)
1863 : 7827 : gel(g,i) = famat_to_nf_moddivisor(nf, gen, gel(u1,i), bid);
1864 : 3793 : gen = g;
1865 : : }
1866 : 4573 : gel(G,3) = gen; /* replace dummy */
1867 : : }
1868 : : else
1869 : 4384 : gel(bid,2) = mkvec2(h,cyc);
1870 : 8957 : }
1871 : :
1872 : : static int
1873 : 2385 : RgV_is_prV(GEN v)
1874 : : {
1875 : 2385 : long l = lg(v), i;
1876 [ + + ]: 2435 : for (i = 1; i < l; i++)
1877 [ + + ]: 2385 : if (!get_prid(gel(v,i))) return 0;
1878 : 2385 : return 1;
1879 : : }
1880 : :
1881 : : static int
1882 : 8562 : is_nf_factor(GEN F)
1883 : : {
1884 [ + + ]: 16145 : return typ(F) == t_MAT && lg(F) == 3
1885 [ + + ][ + + ]: 16145 : && RgV_is_prV(gel(F,1)) && RgV_is_ZV(gel(F,2));
[ + - ]
1886 : : }
1887 : :
1888 : : /* Compute [[ideal,arch], [h,[cyc],[gen]], idealfact, [liste], U]
1889 : : flag may include nf_GEN | nf_INIT */
1890 : : GEN
1891 : 8562 : Idealstar(GEN nf, GEN ideal, long flag)
1892 : : {
1893 : 8562 : pari_sp av = avma;
1894 : : long i, j, k, nbp, R1, nbgen;
1895 : 8562 : GEN t, y, cyc, U, u1 = NULL, fa, lists, x, arch, archp, E, P, sarch, gen;
1896 : :
1897 : 8562 : nf = checknf(nf);
1898 : 8562 : R1 = nf_get_r1(nf);
1899 [ + + ][ + + ]: 8562 : if (typ(ideal) == t_VEC && lg(ideal) == 3)
1900 : : {
1901 : 2873 : arch = gel(ideal,2);
1902 : 2873 : ideal= gel(ideal,1);
1903 [ + - - ]: 2873 : switch(typ(arch))
1904 : : {
1905 : : case t_VEC:
1906 [ - + ]: 2873 : if (lg(arch) != R1+1)
1907 : 0 : pari_err_TYPE("Idealstar [incorrect archimedean component]",arch);
1908 : 2873 : archp = vec01_to_indices(arch);
1909 : 2873 : break;
1910 : : case t_VECSMALL:
1911 : 0 : archp = arch;
1912 : 0 : arch = vec01_to_indices(archp);
1913 : 0 : break;
1914 : : default:
1915 : 0 : pari_err_TYPE("Idealstar [incorrect archimedean component]",arch);
1916 : 0 : return NULL;
1917 : : }
1918 : 2873 : }
1919 : : else
1920 : : {
1921 : 5689 : arch = zerovec(R1);
1922 : 5689 : archp = cgetg(1, t_VECSMALL);
1923 : : }
1924 [ + + ]: 8562 : if (is_nf_factor(ideal))
1925 : : {
1926 : 50 : fa = ideal;
1927 : 50 : x = idealfactorback(nf, gel(fa,1), gel(fa,2), 0);
1928 : : }
1929 : : else
1930 : : {
1931 : 8512 : fa = NULL;
1932 : 8512 : x = idealhnf_shallow(nf, ideal);
1933 : : }
1934 [ + + ]: 8562 : if (lg(x) == 1) pari_err_DOMAIN("Idealstar", "ideal","=",gen_0,x);
1935 [ + + ]: 8557 : if (typ(gcoeff(x,1,1)) != t_INT)
1936 : 5 : pari_err_DOMAIN("Idealstar","denominator(ideal)", "!=",gen_1,x);
1937 : 8552 : sarch = nfarchstar(nf, x, archp);
1938 [ + + ]: 8552 : if (!fa) fa = idealfactor(nf, ideal);
1939 : 8552 : P = gel(fa,1);
1940 : 8552 : E = gel(fa,2); nbp = lg(P)-1;
1941 [ + + ]: 8552 : if (nbp)
1942 : : {
1943 : : GEN h;
1944 : 7727 : long cp = 0;
1945 : : zlog_S S;
1946 : :
1947 : 7727 : lists = cgetg(nbp+2,t_VEC);
1948 : : /* rough upper bound */
1949 [ + + ]: 16197 : nbgen = nbp + 1; for (i=1; i<=nbp; i++) nbgen += itos(gel(E,i));
1950 : 7727 : gen = cgetg(nbgen+1,t_VEC);
1951 : 7727 : nbgen = 1;
1952 [ + + ]: 7727 : t = (nbp==1)? NULL: x;
1953 [ + + ]: 16187 : for (i=1; i<=nbp; i++)
1954 : : {
1955 : 8465 : GEN L = zprimestar(nf, gel(P,i), gel(E,i), t, archp);
1956 : 8460 : gel(lists,i) = L;
1957 [ + + ]: 24422 : for (j = 1; j < lg(L); j++) gel(gen, nbgen++) = gmael(L,j,3);
1958 : : }
1959 : 7722 : gel(lists,i) = sarch;
1960 : 7722 : gel(gen, nbgen++) = gel(sarch,2); setlg(gen, nbgen);
1961 : 7722 : gen = shallowconcat1(gen); nbgen = lg(gen)-1;
1962 : :
1963 : 7722 : h = cgetg(nbgen+1,t_MAT);
1964 : 7722 : init_zlog(&S, nbgen, P, E, archp, lists, NULL);
1965 [ + + ]: 16182 : for (i=1; i<=nbp; i++)
1966 : : {
1967 : 8460 : GEN L2 = gel(lists,i);
1968 [ + + ]: 24422 : for (j=1; j < lg(L2); j++)
1969 : : {
1970 : 15962 : GEN L = gel(L2,j), F = gel(L,1), G = gel(L,3);
1971 [ + + ]: 55630 : for (k=1; k<lg(G); k++)
1972 : : { /* log(g^f) mod divisor */
1973 : 39668 : GEN g = gel(G,k), f = gel(F,k), a = nfpowmodideal(nf,g,f,x);
1974 : 39668 : GEN sgn = mpodd(f)? nfsign_arch(nf, g, S.archp)
1975 [ + + ]: 39668 : : zero_zv(lg(S.archp)-1);
1976 : 39668 : gel(h,++cp) = ZC_neg(zlog_ind(nf, a, &S, sgn, i));
1977 : 39668 : gcoeff(h,cp,cp) = f;
1978 : : }
1979 : : }
1980 : : }
1981 [ + + ]: 10806 : for (j=1; j<lg(archp); j++)
1982 : : {
1983 : 3084 : gel(h,++cp) = zerocol(nbgen);
1984 : 3084 : gcoeff(h,cp,cp) = gen_2;
1985 : : }
1986 : : /* assert(cp == nbgen) */
1987 : 7722 : h = ZM_hnfall(h,NULL,0);
1988 [ + + ]: 7722 : cyc = ZM_snf_group(h, &U, (flag & nf_GEN)? &u1: NULL);
1989 : : }
1990 : : else
1991 : : {
1992 : 825 : lists = mkvec(sarch);
1993 : 825 : gen = gel(sarch,2); nbgen = lg(gen)-1;
1994 : 825 : cyc = const_vec(nbgen, gen_2);
1995 : 825 : U = matid(nbgen);
1996 [ + + ]: 825 : if (flag & nf_GEN) u1 = gen_1;
1997 : : }
1998 : :
1999 : 8547 : y = cgetg(6,t_VEC);
2000 : 8547 : gel(y,1) = mkvec2(x, arch);
2001 : 8547 : gel(y,3) = fa;
2002 : 8547 : gel(y,4) = lists;
2003 : 8547 : gel(y,5) = U;
2004 : 8547 : add_grp(nf, u1, cyc, gen, y);
2005 [ + + ]: 8547 : if (!(flag & nf_INIT)) y = gel(y,2);
2006 : 8547 : return gerepilecopy(av, y);
2007 : : }
2008 : :
2009 : : /* vectors of [[cyc],[g],U.X^-1] */
2010 : : static GEN
2011 : 5 : principal_units(GEN nf, GEN pr, long e)
2012 : : {
2013 : 5 : pari_sp av = avma;
2014 : : long a;
2015 : : GEN list, y, prb, pre;
2016 : : ulong mask;
2017 : :
2018 [ - + ]: 5 : if(DEBUGLEVEL>3) err_printf("treating pr^%ld, pr = %Ps\n",e,pr);
2019 [ - + ]: 5 : if (e == 1) return cgetg(1, t_VEC);
2020 : 5 : prb = idealhnf_two(nf,pr);
2021 : 5 : pre = idealpows(nf,pr,e);
2022 : 5 : list = vectrunc_init(e);
2023 : 5 : mask = quadratic_prec_mask(e);
2024 : 5 : a = 1;
2025 [ + + ]: 25 : while (mask > 1)
2026 : : {
2027 : 20 : GEN pra = prb, z, U;
2028 : 20 : long b = a << 1;
2029 : :
2030 [ + + ]: 20 : if (mask & 1) b--;
2031 : 20 : mask >>= 1;
2032 : : /* compute 1 + pr^a / 1 + pr^b, 2a <= b */
2033 [ - + ]: 20 : if(DEBUGLEVEL>3) err_printf(" treating a = %ld, b = %ld\n",a,b);
2034 [ + + ]: 20 : prb = (b >= e)? pre: idealpows(nf,pr,b);
2035 : 20 : z = zidealij(pra, prb, &U);
2036 : 20 : y = mkvec3(gel(z,1), gel(z,2), U);
2037 : 20 : vectrunc_append(list, y);
2038 : 20 : a = b;
2039 : : }
2040 : 5 : return gerepilecopy(av, list);
2041 : : }
2042 : :
2043 : : static GEN
2044 : 30 : log_prk(GEN nf, GEN a, long nbgen, GEN list, GEN prk)
2045 : : {
2046 : 30 : GEN y = zerocol(nbgen);
2047 : 30 : long i,j, iy = 1, llist = lg(list)-1;
2048 : :
2049 [ + + ]: 150 : for (j = 1; j <= llist; j++)
2050 : : {
2051 : 120 : GEN L = gel(list,j);
2052 : 120 : GEN cyc = gel(L,1), gen = gel(L,2), U = gel(L,3);
2053 : 120 : GEN e = apply_U(U, a);
2054 : : /* here lg(e) == lg(cyc) */
2055 [ + + ]: 300 : for (i = 1; i < lg(cyc); i++)
2056 : : {
2057 : 180 : GEN t = modii(negi(gel(e,i)), gel(cyc,i));
2058 [ + + ]: 180 : gel(y, iy++) = negi(t); if (!signe(t)) continue;
2059 [ + + ]: 20 : if (j != llist) a = elt_mulpow_modideal(nf, a, gel(gen,i), t, prk);
2060 : : }
2061 : : }
2062 : 30 : return y;
2063 : : }
2064 : :
2065 : : /* multiplicative group (1 + pr) / (1 + pr^e) */
2066 : : GEN
2067 : 5 : idealprincipalunits(GEN nf, GEN pr, long e)
2068 : : {
2069 : 5 : pari_sp av = avma;
2070 : : long c, i, j, k, nbgen;
2071 : 5 : GEN cyc, u1 = NULL, pre, gen;
2072 : : GEN g, EX, h, L2;
2073 : 5 : long cp = 0;
2074 : :
2075 : 5 : nf = checknf(nf); pre = idealpows(nf, pr, e);
2076 : 5 : L2 = principal_units(nf, pr, e);
2077 : 5 : c = lg(L2); gen = cgetg(c, t_VEC);
2078 [ + + ]: 25 : for (j = 1; j < c; j++) gel(gen, j) = gmael(L2,j,2);
2079 : 5 : gen = shallowconcat1(gen); nbgen = lg(gen)-1;
2080 : :
2081 : 5 : h = cgetg(nbgen+1,t_MAT);
2082 [ + + ]: 25 : for (j=1; j < lg(L2); j++)
2083 : : {
2084 : 20 : GEN L = gel(L2,j), F = gel(L,1), G = gel(L,2);
2085 [ + + ]: 50 : for (k=1; k<lg(G); k++)
2086 : : { /* log(g^f) mod pr^e */
2087 : 30 : GEN g = gel(G,k), f = gel(F,k), a = nfpowmodideal(nf,g,f,pre);
2088 : 30 : gel(h,++cp) = ZC_neg(log_prk(nf, a, nbgen, L2, pre));
2089 : 30 : gcoeff(h,cp,cp) = f;
2090 : : }
2091 : : }
2092 : : /* assert(cp == nbgen) */
2093 : 5 : h = ZM_hnfall(h,NULL,0);
2094 : 5 : cyc = ZM_snf_group(h, NULL, &u1);
2095 : 5 : c = lg(u1); g = cgetg(c, t_VEC); EX = gel(cyc,1);
2096 [ + + ]: 20 : for (i=1; i<c; i++)
2097 : 15 : gel(g,i) = famat_to_nf_modideal_coprime(nf, gen, gel(u1,i), pre, EX);
2098 : 5 : return gerepilecopy(av, mkvec3(powiu(pr_norm(pr), e-1), cyc, g));
2099 : : }
2100 : :
2101 : : /* FIXME: obsolete */
2102 : : GEN
2103 : 0 : zidealstarinitgen(GEN nf, GEN ideal)
2104 : 0 : { return Idealstar(nf,ideal, nf_INIT|nf_GEN); }
2105 : : GEN
2106 : 3512 : zidealstarinit(GEN nf, GEN ideal)
2107 : 3512 : { return Idealstar(nf,ideal, nf_INIT); }
2108 : : GEN
2109 : 0 : zidealstar(GEN nf, GEN ideal)
2110 : 0 : { return Idealstar(nf,ideal, nf_GEN); }
2111 : :
2112 : : GEN
2113 : 60 : idealstar0(GEN nf, GEN ideal,long flag)
2114 : : {
2115 [ + + + - ]: 60 : switch(flag)
2116 : : {
2117 : 5 : case 0: return Idealstar(nf,ideal, nf_GEN);
2118 : 45 : case 1: return Idealstar(nf,ideal, nf_INIT);
2119 : 10 : case 2: return Idealstar(nf,ideal, nf_INIT|nf_GEN);
2120 : 0 : default: pari_err_FLAG("idealstar");
2121 : : }
2122 : 45 : return NULL; /* not reached */
2123 : : }
2124 : :
2125 : : void
2126 : 118459 : check_nfelt(GEN x, GEN *den)
2127 : : {
2128 : 118459 : long l = lg(x), i;
2129 : 118459 : GEN t, d = NULL;
2130 [ - + ]: 118459 : if (typ(x) != t_COL) pari_err_TYPE("check_nfelt", x);
2131 [ + + ]: 491416 : for (i=1; i<l; i++)
2132 : : {
2133 : 372957 : t = gel(x,i);
2134 [ + + - ]: 372957 : switch (typ(t))
2135 : : {
2136 : 263124 : case t_INT: break;
2137 : : case t_FRAC:
2138 [ + + ]: 109833 : if (!d) d = gel(t,2); else d = lcmii(d, gel(t,2));
2139 : 109833 : break;
2140 : 0 : default: pari_err_TYPE("check_nfelt", x);
2141 : : }
2142 : : }
2143 : 118459 : *den = d;
2144 : 118459 : }
2145 : :
2146 : : GEN
2147 : 327562 : vecmodii(GEN a, GEN b)
2148 : : {
2149 : : long i, l;
2150 : 327562 : GEN c = cgetg_copy(a, &l);
2151 [ + + ]: 1072675 : for (i = 1; i < l; i++) gel(c,i) = modii(gel(a,i), gel(b,i));
2152 : 327562 : return c;
2153 : : }
2154 : :
2155 : : /* Given x (not necessarily integral), and bid as output by zidealstarinit,
2156 : : * compute the vector of components on the generators bid[2].
2157 : : * Assume (x,bid) = 1 and sgn is either NULL or nfsign_arch(x, bid) */
2158 : : GEN
2159 : 160772 : ideallog_sgn(GEN nf, GEN x, GEN sgn, GEN bid)
2160 : : {
2161 : : pari_sp av;
2162 : : long lcyc;
2163 : : GEN den, cyc, y;
2164 : :
2165 : 160772 : nf = checknf(nf); checkbid(bid);
2166 : 160772 : cyc = bid_get_cyc(bid);
2167 [ + + ]: 160772 : lcyc = lg(cyc); if (lcyc == 1) return cgetg(1, t_COL);
2168 : 160752 : av = avma;
2169 [ + + ]: 160752 : if (typ(x) == t_MAT) {
2170 [ - + ]: 39332 : if (lg(x) == 1) return zerocol(lcyc-1); /* x = 1 */
2171 : 39332 : y = famat_zlog(nf, x, sgn, bid);
2172 : 39332 : goto END;
2173 : : }
2174 : 121420 : x = nf_to_scalar_or_basis(nf, x);
2175 [ + + + ]: 121420 : switch(typ(x))
2176 : : {
2177 : : case t_INT:
2178 : 2956 : den = NULL;
2179 : 2956 : break;
2180 : : case t_FRAC:
2181 : 5 : den = gel(x,2);
2182 : 5 : x = gel(x,1);
2183 : 5 : break;
2184 : : default: /* case t_COL: */
2185 : 118459 : check_nfelt(x, &den);
2186 [ + + ]: 118459 : if (den) x = Q_muli_to_int(x, den);
2187 : : }
2188 [ + + ]: 121420 : if (den)
2189 : : {
2190 : 51489 : x = mkmat2(mkcol2(x, den), mkcol2(gen_1, gen_m1));
2191 : 51489 : y = famat_zlog(nf, x, sgn, bid);
2192 : : }
2193 : : else
2194 : : {
2195 : 69931 : zlog_S S; init_zlog_bid(&S, bid);
2196 : 69931 : y = zlog(nf, x, sgn, &S);
2197 : : }
2198 : : END:
2199 : 160747 : y = ZM_ZC_mul(gel(bid,5), y);
2200 : 160767 : return gerepileupto(av, vecmodii(y, cyc));
2201 : : }
2202 : : GEN
2203 : 160772 : ideallog(GEN nf, GEN x, GEN bid) { return ideallog_sgn(nf, x, NULL, bid); }
2204 : :
2205 : : /*************************************************************************/
2206 : : /** **/
2207 : : /** JOIN BID STRUCTURES, IDEAL LISTS **/
2208 : : /** **/
2209 : : /*************************************************************************/
2210 : :
2211 : : /* bid1, bid2: for coprime modules m1 and m2 (without arch. part).
2212 : : * Output: bid [[m1 m2,arch],[h,[cyc],[gen]],idealfact,[liste],U] for m1 m2 */
2213 : : static GEN
2214 : 650 : join_bid(GEN nf, GEN bid1, GEN bid2)
2215 : : {
2216 : 650 : pari_sp av = avma;
2217 : : long i, nbgen, lx, lx1,lx2, l1,l2;
2218 : : GEN I1,I2, G1,G2, fa1,fa2, lists1,lists2, cyc1,cyc2;
2219 : 650 : GEN lists, fa, U, cyc, y, u1 = NULL, x, gen;
2220 : :
2221 : 650 : I1 = bid_get_ideal(bid1);
2222 : 650 : I2 = bid_get_ideal(bid2);
2223 [ + + ]: 650 : if (gequal1(gcoeff(I1,1,1))) return bid2; /* frequent trivial case */
2224 : 370 : G1 = bid_get_grp(bid1);
2225 : 370 : G2 = bid_get_grp(bid2);
2226 : 370 : fa1= gel(bid1,3);
2227 : 370 : fa2= gel(bid2,3); x = idealmul(nf, I1,I2);
2228 : 370 : fa = famat_mul_shallow(fa1, fa2);
2229 : 370 : lists1 = gel(bid1,4); lx1 = lg(lists1);
2230 : 370 : lists2 = gel(bid2,4); lx2 = lg(lists2);
2231 : : /* concat (lists1 - last elt [nfarchstar]) + lists2 */
2232 : 370 : lx = lx1+lx2-2; lists = cgetg(lx,t_VEC);
2233 [ + + ]: 770 : for (i=1; i<lx1-1; i++) gel(lists,i) = gel(lists1,i);
2234 [ + + ]: 1110 : for ( ; i<lx; i++) gel(lists,i) = gel(lists2,i-lx1+2);
2235 : :
2236 : 370 : cyc1 = abgrp_get_cyc(G1); l1 = lg(cyc1);
2237 : 370 : cyc2 = abgrp_get_cyc(G2); l2 = lg(cyc2);
2238 [ + - ][ + - ]: 370 : gen = (lg(G1)>3 && lg(G2)>3)? gen_1: NULL;
2239 : 370 : nbgen = l1+l2-2;
2240 [ + - ]: 370 : cyc = ZM_snf_group(diagonal_shallow(shallowconcat(cyc1,cyc2)),
2241 : : &U, gen? &u1: NULL);
2242 [ + - ]: 370 : if (nbgen) {
2243 : 370 : GEN U1 = gel(bid1,5), U2 = gel(bid2,5);
2244 [ - + ]: 370 : U1 = l1 == 1? zeromat(nbgen,lg(U1)-1): ZM_mul(vecslice(U, 1, l1-1), U1);
2245 [ - + ]: 370 : U2 = l2 == 1? zeromat(nbgen,lg(U2)-1): ZM_mul(vecslice(U, l1, nbgen), U2);
2246 : 370 : U = shallowconcat(U1, U2);
2247 : : }
2248 : : else
2249 : 0 : U = zeromat(0, lx-2);
2250 : :
2251 [ + - ]: 370 : if (gen)
2252 : : {
2253 : 370 : GEN mu,mv, u,v = idealaddtoone_i(nf,I2,I1);
2254 : 370 : mv = zk_scalar_or_multable(nf, v);
2255 [ + + ]: 370 : if (typ(mv) == t_INT)
2256 : : {
2257 : 30 : mu = u = subui(1,mv);
2258 : 30 : v = mv;
2259 : : }
2260 : : else
2261 : : {
2262 : 340 : u = unnf_minus_x(v);
2263 : 340 : mu = RgM_Rg_add(ZM_neg(mv), gen_1); /* mult by u = 1-v */
2264 : : }
2265 : 370 : gen = shallowconcat(makeprimetoidealvec(x,u,mv, abgrp_get_gen(G1)),
2266 : : makeprimetoidealvec(x,v,mu, abgrp_get_gen(G2)));
2267 : : }
2268 : 370 : y = cgetg(6,t_VEC);
2269 : 370 : gel(y,1) = mkvec2(x, bid_get_arch(bid1));
2270 : 370 : gel(y,3) = fa;
2271 : 370 : gel(y,4) = lists;
2272 : 370 : gel(y,5) = U;
2273 : 370 : add_grp(nf, u1, cyc, gen, y);
2274 : 650 : return gerepilecopy(av,y);
2275 : : }
2276 : :
2277 : : typedef struct _ideal_data {
2278 : : GEN nf, emb, L, pr, prL, arch, sgnU;
2279 : : } ideal_data;
2280 : :
2281 : : /* z <- ( z | f(v[i])_{i=1..#v} ) */
2282 : : static void
2283 : 31385 : concat_join(GEN *pz, GEN v, GEN (*f)(ideal_data*,GEN), ideal_data *data)
2284 : : {
2285 : 31385 : long i, nz, lv = lg(v);
2286 : : GEN z, Z;
2287 [ + + ]: 45095 : if (lv == 1) return;
2288 : 13710 : z = *pz; nz = lg(z)-1;
2289 : 13710 : *pz = Z = cgetg(lv + nz, typ(z));
2290 [ + + ]: 26505 : for (i = 1; i <=nz; i++) gel(Z,i) = gel(z,i);
2291 : 13710 : Z += nz;
2292 [ + + ]: 33020 : for (i = 1; i < lv; i++) gel(Z,i) = f(data, gel(v,i));
2293 : : }
2294 : : static GEN
2295 : 650 : join_idealinit(ideal_data *D, GEN x) {
2296 : 650 : return join_bid(D->nf, x, D->prL);
2297 : : }
2298 : : static GEN
2299 : 18660 : join_ideal(ideal_data *D, GEN x) {
2300 : 18660 : return idealmulpowprime(D->nf, x, D->pr, D->L);
2301 : : }
2302 : : static GEN
2303 : 635 : join_unit(ideal_data *D, GEN x) {
2304 : 635 : return mkvec2(join_idealinit(D, gel(x,1)), vconcat(gel(x,2), D->emb));
2305 : : }
2306 : :
2307 : : /* compute matrix of zlogs of units */
2308 : : GEN
2309 : 30 : zlog_units(GEN nf, GEN U, GEN sgnU, GEN bid)
2310 : : {
2311 : 30 : long j, l = lg(U);
2312 : 30 : GEN m = cgetg(l, t_MAT);
2313 : 30 : zlog_S S; init_zlog_bid(&S, bid);
2314 [ + + ]: 85 : for (j = 1; j < l; j++)
2315 : 55 : gel(m,j) = zlog(nf, gel(U,j), vecsmallpermute(gel(sgnU,j), S.archp), &S);
2316 : 30 : return m;
2317 : : }
2318 : : /* compute matrix of zlogs of units, assuming S.archp = [] */
2319 : : GEN
2320 : 485 : zlog_units_noarch(GEN nf, GEN U, GEN bid)
2321 : : {
2322 : 485 : long j, l = lg(U);
2323 : 485 : GEN m = cgetg(l, t_MAT), empty = cgetg(1, t_COL);
2324 : 485 : zlog_S S; init_zlog_bid(&S, bid);
2325 [ + + ]: 1440 : for (j = 1; j < l; j++) gel(m,j) = zlog(nf, gel(U,j), empty, &S);
2326 : 485 : return m;
2327 : : }
2328 : :
2329 : : /* calcule la matrice des zlog des unites */
2330 : : static GEN
2331 : 20 : zlog_unitsarch(GEN sgnU, GEN bid)
2332 : : {
2333 : 20 : GEN lists = gel(bid,4), arch = gmael(bid,1,2);
2334 : 20 : GEN listslast = gel(lists,lg(lists)-1);
2335 : 20 : GEN m = rowpermute(sgnU, vec01_to_indices(arch));
2336 : 20 : return Flm_mul(gel(listslast,3), m, 2);
2337 : : }
2338 : :
2339 : : /* flag & nf_GEN : generators, otherwise no
2340 : : * flag &2 : units, otherwise no
2341 : : * flag &4 : ideals in HNF, otherwise bid */
2342 : : static GEN
2343 : 255 : Ideallist(GEN bnf, ulong bound, long flag)
2344 : : {
2345 : 255 : const long do_units = flag & 2, big_id = !(flag & 4);
2346 : 255 : const long istar_flag = (flag & nf_GEN) | nf_INIT;
2347 : 255 : pari_sp lim, av, av0 = avma;
2348 : : long i, j, l;
2349 : 255 : GEN nf, z, p, fa, id, U, empty = cgetg(1,t_VEC);
2350 : : forprime_t S;
2351 : : ideal_data ID;
2352 : 255 : GEN (*join_z)(ideal_data*, GEN) =
2353 : : do_units? &join_unit
2354 [ + + ][ + + ]: 255 : : (big_id? &join_idealinit: &join_ideal);
2355 : :
2356 : 255 : nf = checknf(bnf);
2357 [ - + ]: 255 : if ((long)bound <= 0) return empty;
2358 : 255 : id = matid(nf_get_degree(nf));
2359 [ + + ]: 255 : if (big_id) id = Idealstar(nf,id, istar_flag);
2360 : :
2361 : : /* z[i] will contain all "objects" of norm i. Depending on flag, this means
2362 : : * an ideal, a bid, or a couple [bid, log(units)]. Such objects are stored
2363 : : * in vectors, computed one primary component at a time; join_z
2364 : : * reconstructs the global object */
2365 : 255 : z = cgetg(bound+1,t_VEC);
2366 [ + + ]: 255 : if (do_units) {
2367 : 15 : U = init_units(bnf);
2368 : 15 : gel(z,1) = mkvec( mkvec2(id, zlog_units_noarch(nf, U, id)) );
2369 : : } else {
2370 : 240 : U = NULL; /* -Wall */
2371 : 240 : gel(z,1) = mkvec(id);
2372 : : }
2373 [ + + ]: 12040 : for (i=2; i<=(long)bound; i++) gel(z,i) = empty;
2374 : 255 : ID.nf = nf;
2375 : :
2376 : 255 : p = cgetipos(3);
2377 : 255 : u_forprime_init(&S, 2, bound);
2378 : 255 : av = avma; lim = stack_lim(av,1);
2379 [ + + ]: 3890 : while ((p[2] = u_forprime_next(&S)))
2380 : : {
2381 [ - + ]: 3635 : if (DEBUGLEVEL>1) { err_printf("%ld ",p[2]); err_flush(); }
2382 : 3635 : fa = idealprimedec(nf, p);
2383 [ + + ]: 7290 : for (j=1; j<lg(fa); j++)
2384 : : {
2385 : 5550 : GEN pr = gel(fa,j), z2;
2386 : 5550 : long f = pr_get_f(pr);
2387 : 5550 : ulong q, Q = upowuu(p[2], f);
2388 [ + - ][ + + ]: 5550 : if (!Q || Q > bound) break;
2389 : :
2390 : 3655 : z2 = leafcopy(z);
2391 : 3655 : q = Q;
2392 : 3655 : ID.pr = ID.prL = pr;
2393 [ + + ]: 9675 : for (l=1; Q <= bound; l++, Q *= q) /* add pr^l */
2394 : : {
2395 : : ulong iQ;
2396 : 6020 : ID.L = utoipos(l);
2397 [ + + ]: 6020 : if (big_id) {
2398 [ + + ]: 280 : if (l > 1) ID.prL = idealpow(nf,pr,ID.L);
2399 : 280 : ID.prL = Idealstar(nf,ID.prL, istar_flag);
2400 [ + + ]: 280 : if (do_units) ID.emb = zlog_units_noarch(nf, U, ID.prL);
2401 : : }
2402 [ + + ]: 37405 : for (iQ = Q,i = 1; iQ <= bound; iQ += Q,i++)
2403 : 31385 : concat_join(&gel(z,iQ), gel(z2,i), join_z, &ID);
2404 : : }
2405 : : }
2406 [ - + ]: 3635 : if (low_stack(lim, stack_lim(av,1)))
2407 : : {
2408 [ # # ]: 0 : if(DEBUGMEM>1) pari_warn(warnmem,"Ideallist");
2409 : 0 : z = gerepilecopy(av, z);
2410 : : }
2411 : : }
2412 [ + + ][ + + ]: 825 : if (do_units) for (i = 1; i < lg(z); i++)
2413 : : {
2414 : 570 : GEN s = gel(z,i);
2415 : 570 : long l = lg(s);
2416 [ + + ]: 1220 : for (j = 1; j < l; j++) {
2417 : 650 : GEN v = gel(s,j), bid = gel(v,1);
2418 : 650 : gel(v,2) = ZM_mul(gel(bid,5), gel(v,2));
2419 : : }
2420 : : }
2421 : 255 : return gerepilecopy(av0, z);
2422 : : }
2423 : : GEN
2424 : 25 : ideallist0(GEN bnf,long bound, long flag) {
2425 [ + - ][ - + ]: 25 : if (flag<0 || flag>4) pari_err_FLAG("ideallist");
2426 : 25 : return Ideallist(bnf,bound,flag);
2427 : : }
2428 : : GEN
2429 : 230 : ideallist(GEN bnf,long bound) { return Ideallist(bnf,bound,4); }
2430 : :
2431 : : /* bid1 = for module m1 (without arch. part), arch = archimedean part.
2432 : : * Output: bid [[m1,arch],[h,[cyc],[gen]],idealfact,[liste],U] for m1.arch */
2433 : : static GEN
2434 : 40 : join_bid_arch(GEN nf, GEN bid1, GEN arch)
2435 : : {
2436 : 40 : pari_sp av = avma;
2437 : : GEN f1, G1, fa1, U;
2438 : 40 : GEN lists, cyc, y, u1 = NULL, x, sarch, gen;
2439 : :
2440 : 40 : checkbid(bid1);
2441 : 40 : f1 = gel(bid1,1); G1 = gel(bid1,2); fa1 = gel(bid1,3);
2442 : 40 : x = gel(f1,1);
2443 : 40 : sarch = nfarchstar(nf, x, arch);
2444 : 40 : lists = leafcopy(gel(bid1,4));
2445 : 40 : gel(lists,lg(lists)-1) = sarch;
2446 : :
2447 [ + + ]: 40 : gen = (lg(G1)>3)? gen_1: NULL;
2448 : 40 : cyc = diagonal_shallow(shallowconcat(gel(G1,2), gel(sarch,1)));
2449 [ + + ]: 40 : cyc = ZM_snf_group(cyc, &U, gen? &u1: NULL);
2450 [ + + ]: 40 : if (gen) gen = shallowconcat(gel(G1,3), gel(sarch,2));
2451 : 40 : y = cgetg(6,t_VEC);
2452 : 40 : gel(y,1) = mkvec2(x, arch);
2453 : 40 : gel(y,3) = fa1;
2454 : 40 : gel(y,4) = lists;
2455 : 40 : gel(y,5) = U;
2456 : 40 : add_grp(nf, u1, cyc, gen, y);
2457 : 40 : return gerepilecopy(av,y);
2458 : : }
2459 : : static GEN
2460 : 40 : join_arch(ideal_data *D, GEN x) {
2461 : 40 : return join_bid_arch(D->nf, x, D->arch);
2462 : : }
2463 : : static GEN
2464 : 20 : join_archunit(ideal_data *D, GEN x) {
2465 : 20 : GEN bid = join_arch(D, gel(x,1)), U = gel(x,2);
2466 : 20 : U = ZM_mul(gel(bid,5), vconcat(U, zm_to_ZM(zlog_unitsarch(D->sgnU, bid))));
2467 : 20 : return mkvec2(bid, U);
2468 : : }
2469 : :
2470 : : /* L from ideallist, add archimedean part */
2471 : : GEN
2472 : 10 : ideallistarch(GEN bnf, GEN L, GEN arch)
2473 : : {
2474 : : pari_sp av;
2475 : 10 : long i, j, l = lg(L), lz;
2476 : : GEN v, z, V;
2477 : : ideal_data ID;
2478 : : GEN (*join_z)(ideal_data*, GEN);
2479 : :
2480 [ - + ]: 10 : if (typ(L) != t_VEC) pari_err_TYPE("ideallistarch",L);
2481 [ - + ]: 10 : if (l == 1) return cgetg(1,t_VEC);
2482 : 10 : z = gel(L,1);
2483 [ - + ]: 10 : if (typ(z) != t_VEC) pari_err_TYPE("ideallistarch",z);
2484 : 10 : z = gel(z,1); /* either a bid or [bid,U] */
2485 [ + + ]: 10 : if (lg(z) == 3) { /* the latter: do units */
2486 [ - + ]: 5 : if (typ(z) != t_VEC) pari_err_TYPE("ideallistarch",z);
2487 : 5 : ID.sgnU = nfsign_units(bnf, NULL, 1);
2488 : 5 : join_z = &join_archunit;
2489 : : } else
2490 : 5 : join_z = &join_arch;
2491 : 10 : ID.nf = checknf(bnf);
2492 : 10 : ID.arch = vec01_to_indices(arch);
2493 : 10 : av = avma; V = cgetg(l, t_VEC);
2494 [ + + ]: 50 : for (i = 1; i < l; i++)
2495 : : {
2496 : 40 : z = gel(L,i); lz = lg(z);
2497 : 40 : gel(V,i) = v = cgetg(lz,t_VEC);
2498 [ + + ]: 80 : for (j=1; j<lz; j++) gel(v,j) = join_z(&ID, gel(z,j));
2499 : : }
2500 : 10 : return gerepilecopy(av,V);
2501 : : }
|
