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 : 9140069 : get_tab(GEN nf, long *N)
30 : : {
31 [ + + ]: 9140069 : GEN tab = (typ(nf) == t_MAT)? nf: gel(nf,9);
32 : 9140069 : *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 : 434457567 : _mulii(GEN x, GEN y) {
38 [ + + ]: 1094746396 : return is_pm1(x)? (signe(x) < 0)? negi(y): y
39 [ + + ]: 660288829 : : mulii(x, y);
40 : : }
41 : :
42 : : GEN
43 : 2142 : tablemul_ei_ej(GEN M, long i, long j)
44 : : {
45 : : long N;
46 : 2142 : GEN tab = get_tab(M, &N);
47 : 2142 : 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 : 15827 : tablemul_ei(GEN M, GEN x, long i)
55 : : {
56 : : long j, k, N;
57 : : GEN v, tab;
58 : :
59 [ + + ]: 15827 : if (i==1) return gcopy(x);
60 : 13545 : tab = get_tab(M, &N);
61 [ - + ]: 13545 : if (typ(x) != t_COL) { v = zerocol(N); gel(v,i) = gcopy(x); return v; }
62 : 13545 : tab += (i-1)*N; v = cgetg(N+1,t_COL);
63 : : /* wi . x = [ sum_j tab[k,j] x[j] ]_k */
64 [ + + ]: 100541 : for (k=1; k<=N; k++)
65 : : {
66 : 86996 : pari_sp av = avma;
67 : 86996 : GEN s = gen_0;
68 [ + + ]: 681366 : for (j=1; j<=N; j++)
69 : : {
70 : 594370 : GEN c = gcoeff(tab,k,j);
71 [ + + ]: 594370 : if (!gequal0(c)) s = gadd(s, gmul(c, gel(x,j)));
72 : : }
73 : 86996 : gel(v,k) = gerepileupto(av,s);
74 : : }
75 : 15827 : return v;
76 : : }
77 : : /* as tablemul_ei, assume x a ZV of correct length */
78 : : GEN
79 : 8021094 : zk_ei_mul(GEN nf, GEN x, long i)
80 : : {
81 : : long j, k, N;
82 : : GEN v, tab;
83 : :
84 [ + + ]: 8021094 : if (i==1) return ZC_copy(x);
85 : 8021080 : tab = get_tab(nf, &N); tab += (i-1)*N;
86 : 8021080 : v = cgetg(N+1,t_COL);
87 [ + + ]: 62828960 : for (k=1; k<=N; k++)
88 : : {
89 : 54807880 : pari_sp av = avma;
90 : 54807880 : GEN s = gen_0;
91 [ + + ]: 716408934 : for (j=1; j<=N; j++)
92 : : {
93 : 661601054 : GEN c = gcoeff(tab,k,j);
94 [ + + ]: 661601054 : if (signe(c)) s = addii(s, _mulii(c, gel(x,j)));
95 : : }
96 : 54807880 : gel(v,k) = gerepileuptoint(av, s);
97 : : }
98 : 8021094 : return v;
99 : : }
100 : :
101 : : /* table of multiplication by wi in R[w1,..., wN] */
102 : : GEN
103 : 2821 : ei_multable(GEN TAB, long i)
104 : : {
105 : : long k,N;
106 : 2821 : GEN m, tab = get_tab(TAB, &N);
107 : 2821 : tab += (i-1)*N;
108 : 2821 : m = cgetg(N+1,t_MAT);
109 [ + + ]: 20944 : for (k=1; k<=N; k++) gel(m,k) = gel(tab,k);
110 : 2821 : return m;
111 : : }
112 : :
113 : : GEN
114 : 3041203 : zk_multable(GEN nf, GEN x)
115 : : {
116 : 3041203 : long i, l = lg(x);
117 : 3041203 : GEN mul = cgetg(l,t_MAT);
118 : 3041203 : gel(mul,1) = x; /* assume w_1 = 1 */
119 [ + + ]: 11000817 : for (i=2; i<l; i++) gel(mul,i) = zk_ei_mul(nf,x,i);
120 : 3041203 : return mul;
121 : : }
122 : : GEN
123 : 679 : multable(GEN M, GEN x)
124 : : {
125 : : long i, N;
126 : : GEN mul;
127 [ + - ]: 679 : 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 : 679 : 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 : 7093167 : zk_scalar_or_multable(GEN nf, GEN x)
140 : : {
141 : 7093167 : long tx = typ(x);
142 [ + + ][ + + ]: 7093167 : if (tx == t_MAT || tx == t_INT) return x;
143 : 2751733 : x = nf_to_scalar_or_basis(nf, x);
144 [ + + ]: 7093167 : return (typ(x) == t_COL)? zk_multable(nf, x): x;
145 : : }
146 : :
147 : : GEN
148 : 42 : nftrace(GEN nf, GEN x)
149 : : {
150 : 42 : pari_sp av = avma;
151 : 42 : nf = checknf(nf);
152 : 42 : x = nf_to_scalar_or_basis(nf, x);
153 : 21 : x = (typ(x) == t_COL)? RgV_dotproduct(x, gel(nf_get_Tr(nf),1))
154 [ + + ]: 63 : : gmulgs(x, nf_get_degree(nf));
155 : 42 : return gerepileupto(av, x);
156 : : }
157 : : GEN
158 : 567 : rnfelttrace(GEN rnf, GEN x)
159 : : {
160 : 567 : pari_sp av = avma;
161 : 567 : checkrnf(rnf);
162 : 567 : x = rnfeltabstorel(rnf, x);
163 : 392 : x = (typ(x) == t_POLMOD)? rnfeltdown(rnf, gtrace(x))
164 [ + + ]: 868 : : gmulgs(x, rnf_get_degree(rnf));
165 : 476 : return gerepileupto(av, x);
166 : : }
167 : :
168 : : /* assume nf is a genuine nf, fa a famat */
169 : : static GEN
170 : 7 : famat_norm(GEN nf, GEN fa)
171 : : {
172 : 7 : pari_sp av = avma;
173 : 7 : GEN g = gel(fa,1), e = gel(fa,2), N = gen_1;
174 : 7 : long i, l = lg(g);
175 [ + + ]: 21 : for (i = 1; i < l; i++)
176 : 14 : N = gmul(N, powgi(nfnorm(nf, gel(g,i)), gel(e,i)));
177 : 7 : return gerepileupto(av, N);
178 : : }
179 : : GEN
180 : 10500 : nfnorm(GEN nf, GEN x)
181 : : {
182 : 10500 : pari_sp av = avma;
183 : 10500 : nf = checknf(nf);
184 [ + + ]: 10500 : if (typ(x) == t_MAT) return famat_norm(nf, x);
185 : 10493 : x = nf_to_scalar_or_alg(nf, x);
186 : 9688 : x = (typ(x) == t_POL)? RgXQ_norm(x, nf_get_pol(nf))
187 [ + + ]: 20181 : : gpowgs(x, nf_get_degree(nf));
188 : 10500 : return gerepileupto(av, x);
189 : : }
190 : :
191 : : GEN
192 : 231 : rnfeltnorm(GEN rnf, GEN x)
193 : : {
194 : 231 : pari_sp av = avma;
195 : 231 : checkrnf(rnf);
196 : 231 : x = rnfeltabstorel(rnf, x);
197 : 98 : x = (typ(x) == t_POLMOD)? rnfeltdown(rnf, gnorm(x))
198 [ + + ]: 238 : : gpowgs(x, rnf_get_degree(rnf));
199 : 140 : return gerepileupto(av, x);
200 : : }
201 : :
202 : : /* sum of x and y in nf */
203 : : GEN
204 : 24934 : nfadd(GEN nf, GEN x, GEN y)
205 : : {
206 : : GEN z;
207 : 24934 : pari_sp av = avma;
208 : :
209 : 24934 : nf = checknf(nf);
210 : 24934 : x = nf_to_scalar_or_basis(nf, x);
211 : 24934 : y = nf_to_scalar_or_basis(nf, y);
212 [ + + ]: 24934 : if (typ(x) != t_COL) {
213 [ + + ]: 7070 : if (typ(y) == t_COL) z = RgC_Rg_add(y, x);
214 : : else {
215 : 3171 : long N = nf_get_degree(nf);
216 : 3171 : z = zerocol(N); gel(z,1) = gadd(x,y);
217 : : }
218 : : } else {
219 [ + + ]: 17864 : if (typ(y) != t_COL) z = RgC_Rg_add(x, y);
220 : 7077 : else z = RgC_add(x, y);
221 : : }
222 : 24934 : return gerepileupto(av, z);
223 : : }
224 : :
225 : : /* product of x and y in nf */
226 : : GEN
227 : 177901 : nfmul(GEN nf, GEN x, GEN y)
228 : : {
229 : : GEN z;
230 : 177901 : pari_sp av = avma;
231 : :
232 [ + + ]: 177901 : if (x == y) return nfsqr(nf,x);
233 : :
234 : 177831 : nf = checknf(nf);
235 : 177831 : x = nf_to_scalar_or_basis(nf, x);
236 : 177747 : y = nf_to_scalar_or_basis(nf, y);
237 [ + + ]: 177747 : if (typ(x) != t_COL)
238 : : {
239 [ + + ]: 64798 : if (typ(y) == t_COL) z = RgC_Rg_mul(y, x);
240 : : else {
241 : 33753 : long N = nf_get_degree(nf);
242 : 33753 : z = zerocol(N); gel(z,1) = gmul(x,y);
243 : : }
244 : : }
245 : : else
246 : : {
247 [ + + ]: 112949 : if (typ(y) != t_COL) z = RgC_Rg_mul(x, y);
248 : : else {
249 : : GEN dx, dy;
250 : 66083 : x = Q_remove_denom(x, &dx);
251 : 66083 : y = Q_remove_denom(y, &dy);
252 : 66083 : z = nfmuli(nf,x,y);
253 : 66083 : dx = mul_denom(dx,dy);
254 [ + + ]: 66083 : if (dx) z = RgC_Rg_div(z, dx);
255 : : }
256 : : }
257 : 177817 : return gerepileupto(av, z);
258 : : }
259 : : /* square of x in nf */
260 : : GEN
261 : 11508 : nfsqr(GEN nf, GEN x)
262 : : {
263 : 11508 : pari_sp av = avma;
264 : : GEN z;
265 : :
266 : 11508 : nf = checknf(nf);
267 : 11508 : x = nf_to_scalar_or_basis(nf, x);
268 [ + + ]: 11508 : if (typ(x) != t_COL)
269 : : {
270 : 10017 : long N = nf_get_degree(nf);
271 : 10017 : z = zerocol(N); gel(z,1) = gsqr(x);
272 : : }
273 : : else
274 : : {
275 : : GEN dx;
276 : 1491 : x = Q_remove_denom(x, &dx);
277 : 1491 : z = nfsqri(nf,x);
278 [ + + ]: 1491 : if (dx) z = RgC_Rg_div(z, sqri(dx));
279 : : }
280 : 11508 : return gerepileupto(av, z);
281 : : }
282 : :
283 : : GEN
284 : 188169 : nfC_nf_mul(GEN nf, GEN v, GEN x)
285 : : {
286 : : long tx, l, i;
287 : 188169 : GEN y, dx = NULL;
288 : :
289 : 188169 : x = nf_to_scalar_or_basis(nf, x);
290 : 188169 : tx = typ(x);
291 [ + + ]: 188169 : if (tx != t_COL) {
292 [ + + ]: 51321 : if (tx == t_INT)
293 : : {
294 : 50159 : long s = signe(x);
295 [ + + ]: 50159 : if (!s) return zerocol(lg(v)-1);
296 [ + + ][ + + ]: 47478 : if (is_pm1(x)) return s > 0? leafcopy(v): RgC_neg(v);
297 : : }
298 : 13966 : l = lg(v); y = cgetg(l, t_COL);
299 [ + + ]: 109809 : for (i=1; i < l; i++)
300 : : {
301 : 95843 : GEN c = gel(v,i);
302 [ + + ]: 95843 : if (typ(c) != t_COL) c = gmul(c, x); else c = RgC_Rg_mul(c, x);
303 : 95843 : gel(y,i) = c;
304 : : }
305 : : }
306 : : else
307 : : {
308 : 136848 : x = Q_remove_denom(x, &dx);
309 : 136848 : x = zk_multable(nf, x);
310 : 136848 : l = lg(v); y = cgetg(l, t_COL);
311 [ + + ]: 541164 : for (i=1; i < l; i++)
312 : : {
313 : 404316 : GEN c = gel(v,i);
314 [ + + ]: 404316 : if (typ(c)!=t_COL) {
315 [ + + ]: 83861 : if (!isintzero(c)) c = RgC_Rg_mul(gel(x,1), c);
316 : : } else {
317 : 320455 : c = RgM_RgC_mul(x,c);
318 [ + + ]: 320455 : if (QV_isscalar(c)) c = gel(c,1);
319 : : }
320 : 404316 : gel(y,i) = c;
321 : : }
322 : : }
323 [ + + ]: 188169 : return dx? RgC_Rg_div(y, dx): y;
324 : : }
325 : : static GEN
326 : 3220 : mulbytab(GEN M, GEN c)
327 [ + + ]: 3220 : { return typ(c) == t_COL? RgM_RgC_mul(M,c): RgC_Rg_mul(gel(M,1), c); }
328 : : GEN
329 : 679 : tablemulvec(GEN M, GEN x, GEN v)
330 : : {
331 : : long l, i;
332 : : GEN y;
333 : :
334 [ - + ][ # # ]: 679 : 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 : 679 : x = multable(M, x); /* multiplication table by x */
340 : 679 : y = cgetg_copy(v, &l);
341 [ + - ]: 679 : if (typ(v) == t_POL)
342 : : {
343 : 679 : y[1] = v[1];
344 [ + + ]: 3899 : for (i=2; i < l; i++) gel(y,i) = mulbytab(x, gel(v,i));
345 : 679 : 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 : 679 : return y;
352 : : }
353 : :
354 : : /* inverse of x in nf */
355 : : GEN
356 : 54712 : nfinv(GEN nf, GEN x)
357 : : {
358 : 54712 : pari_sp av = avma;
359 : : GEN T, z;
360 : :
361 : 54712 : nf = checknf(nf); T = nf_get_pol(nf);
362 : 54712 : x = nf_to_scalar_or_alg(nf, x);
363 [ + + ]: 54712 : if (typ(x) == t_POL)
364 : 4193 : z = poltobasis(nf, QXQ_inv(x, T));
365 : : else {
366 : 50519 : z = zerocol(degpol(T)); gel(z,1) = ginv(x);
367 : : }
368 : 54712 : return gerepileupto(av, z);
369 : : }
370 : :
371 : : /* quotient of x and y in nf */
372 : : GEN
373 : 11995 : nfdiv(GEN nf, GEN x, GEN y)
374 : : {
375 : 11995 : pari_sp av = avma;
376 : : GEN T, z;
377 : :
378 : 11995 : nf = checknf(nf); T = nf_get_pol(nf);
379 : 11995 : y = nf_to_scalar_or_alg(nf, y);
380 [ + + ]: 11729 : if (typ(y) != t_POL) {
381 : 2471 : x = nf_to_scalar_or_basis(nf, x);
382 [ + + ]: 2471 : if (typ(x) == t_COL) z = RgC_Rg_div(x, y);
383 : : else {
384 : 1050 : z = zerocol(degpol(T)); gel(z,1) = gdiv(x,y);
385 : : }
386 : : }
387 : : else
388 : : {
389 : 9258 : x = nf_to_scalar_or_alg(nf, x);
390 : 9216 : z = QXQ_inv(y, T);
391 [ + + ]: 9216 : z = (typ(x) == t_POL)? RgXQ_mul(z, x, T): RgX_Rg_mul(z, x);
392 : 9216 : z = poltobasis(nf, z);
393 : : }
394 : 11659 : 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 : 440339 : nfmuli(GEN nf, GEN x, GEN y)
401 : : {
402 : : long i, j, k, N;
403 : 440339 : GEN s, v, TAB = get_tab(nf, &N);
404 : :
405 [ + + ]: 440339 : if (typ(x) == t_INT)
406 : : {
407 [ + + ]: 68953 : if (typ(y) == t_INT) return scalarcol(mulii(x,y), N);
408 : 7182 : return ZC_Z_mul(y, x);
409 : : }
410 [ + + ]: 371386 : if (typ(y) == t_INT) return ZC_Z_mul(x, y);
411 : : /* both x and y are ZV */
412 : 346207 : v = cgetg(N+1,t_COL);
413 [ + + ]: 2236742 : for (k=1; k<=N; k++)
414 : : {
415 : 1890535 : pari_sp av = avma;
416 : 1890535 : GEN TABi = TAB;
417 [ + + ]: 1890535 : if (k == 1)
418 : 346207 : s = mulii(gel(x,1),gel(y,1));
419 : : else
420 : 1544328 : s = addii(mulii(gel(x,1),gel(y,k)),
421 : 3088656 : mulii(gel(x,k),gel(y,1)));
422 [ + + ]: 15258969 : for (i=2; i<=N; i++)
423 : : {
424 : 13368434 : GEN t, xi = gel(x,i);
425 : 13368434 : TABi += N;
426 [ + + ]: 13368434 : if (!signe(xi)) continue;
427 : :
428 : 8598492 : t = NULL;
429 [ + + ]: 118454212 : for (j=2; j<=N; j++)
430 : : {
431 : 109855720 : GEN p1, c = gcoeff(TABi, k, j); /* m^{i,j}_k */
432 [ + + ]: 109855720 : if (!signe(c)) continue;
433 : 47191842 : p1 = _mulii(c, gel(y,j));
434 [ + + ]: 47191842 : t = t? addii(t, p1): p1;
435 : : }
436 [ + + ]: 8598492 : if (t) s = addii(s, mulii(xi, t));
437 : : }
438 : 1890535 : gel(v,k) = gerepileuptoint(av,s);
439 : : }
440 : 440339 : return v;
441 : : }
442 : : /* square of INTEGER (t_INT or ZC) x in nf */
443 : : GEN
444 : 660142 : nfsqri(GEN nf, GEN x)
445 : : {
446 : : long i, j, k, N;
447 : 660142 : GEN s, v, TAB = get_tab(nf, &N);
448 : :
449 [ - + ]: 660142 : if (typ(x) == t_INT) return scalarcol(sqri(x), N);
450 : 660142 : v = cgetg(N+1,t_COL);
451 [ + + ]: 5522594 : for (k=1; k<=N; k++)
452 : : {
453 : 4862452 : pari_sp av = avma;
454 : 4862452 : GEN TABi = TAB;
455 [ + + ]: 4862452 : if (k == 1)
456 : 660142 : s = sqri(gel(x,1));
457 : : else
458 : 4202310 : s = shifti(mulii(gel(x,1),gel(x,k)), 1);
459 [ + + ]: 58548200 : for (i=2; i<=N; i++)
460 : : {
461 : 53685748 : GEN p1, c, t, xi = gel(x,i);
462 : 53685748 : TABi += N;
463 [ + + ]: 53685748 : if (!signe(xi)) continue;
464 : :
465 : 18373238 : c = gcoeff(TABi, k, i);
466 [ + + ]: 18373238 : t = signe(c)? _mulii(c,xi): NULL;
467 [ + + ]: 263918971 : for (j=i+1; j<=N; j++)
468 : : {
469 : 245545733 : c = gcoeff(TABi, k, j);
470 [ + + ]: 245545733 : if (!signe(c)) continue;
471 : 129671142 : p1 = _mulii(c, shifti(gel(x,j),1));
472 [ + + ]: 129671142 : t = t? addii(t, p1): p1;
473 : : }
474 [ + + ]: 18373238 : if (t) s = addii(s, mulii(xi, t));
475 : : }
476 : 4862452 : gel(v,k) = gerepileuptoint(av,s);
477 : : }
478 : 660142 : 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 : 5726 : tablesqr(GEN TAB, GEN x)
522 : : {
523 : : long i, j, k, N;
524 : : GEN s, v;
525 : :
526 [ - + ]: 5726 : if (typ(x) != t_COL) return gsqr(x);
527 : 5726 : N = lg(x)-1;
528 : 5726 : v = cgetg(N+1,t_COL);
529 : :
530 [ + + ]: 42784 : for (k=1; k<=N; k++)
531 : : {
532 : 37058 : pari_sp av = avma;
533 : 37058 : GEN TABi = TAB;
534 [ + + ]: 37058 : if (k == 1)
535 : 5726 : s = gsqr(gel(x,1));
536 : : else
537 : 31332 : s = gmul2n(gmul(gel(x,1),gel(x,k)), 1);
538 [ + + ]: 253372 : for (i=2; i<=N; i++)
539 : : {
540 : 216314 : GEN p1, c, t, xi = gel(x,i);
541 : 216314 : TABi += N;
542 [ + + ]: 216314 : if (gequal0(xi)) continue;
543 : :
544 : 71015 : c = gcoeff(TABi, k, i);
545 [ + + ]: 71015 : t = !gequal0(c)? gmul(c,xi): NULL;
546 [ + + ]: 318045 : for (j=i+1; j<=N; j++)
547 : : {
548 : 247030 : c = gcoeff(TABi, k, j);
549 [ + + ]: 247030 : if (gequal0(c)) continue;
550 : 131278 : p1 = gmul(gmul2n(c,1), gel(x,j));
551 [ + + ]: 131278 : t = t? gadd(t, p1): p1;
552 : : }
553 [ + + ]: 71015 : if (t) s = gadd(s, gmul(xi, t));
554 : : }
555 : 37058 : gel(v,k) = gerepileupto(av,s);
556 : : }
557 : 5726 : return v;
558 : : }
559 : :
560 : : static GEN
561 : 46696 : _mul(void *data, GEN x, GEN y) { return nfmuli((GEN)data,x,y); }
562 : : static GEN
563 : 270426 : _sqr(void *data, GEN x) { return nfsqri((GEN)data,x); }
564 : :
565 : : /* Compute z^n in nf, left-shift binary powering */
566 : : GEN
567 : 208389 : nfpow(GEN nf, GEN z, GEN n)
568 : : {
569 : 208389 : pari_sp av = avma;
570 : : long s, N;
571 : : GEN x, cx, T;
572 : :
573 [ - + ]: 208389 : if (typ(n)!=t_INT) pari_err_TYPE("nfpow",n);
574 : 208389 : nf = checknf(nf); T = nf_get_pol(nf); N = degpol(T);
575 [ - + ]: 208389 : s = signe(n); if (!s) return scalarcol_shallow(gen_1,N);
576 : 208389 : x = nf_to_scalar_or_basis(nf, z);
577 [ + + ]: 208389 : if (typ(x) != t_COL) { GEN y = zerocol(N); gel(y,1) = powgi(x,n); return y; }
578 [ + + ]: 207829 : if (s < 0) { /* simplified nfinv */
579 : 1785 : x = nf_to_scalar_or_alg(nf, z);
580 : 1785 : x = poltobasis(nf, QXQ_inv(x, T));
581 : 1785 : n = absi(n);
582 : : }
583 : 207829 : x = primitive_part(x, &cx);
584 : 207829 : x = gen_pow(x, n, (void*)nf, _sqr, _mul);
585 [ + + ]: 207829 : if (cx) x = RgC_Rg_mul(x, powgi(cx, n));
586 [ - + ]: 208389 : return av==avma? gcopy(x): gerepileupto(av,x);
587 : : }
588 : : /* Compute z^n in nf, left-shift binary powering */
589 : : GEN
590 : 5285 : nfpow_u(GEN nf, GEN z, ulong n)
591 : : {
592 : 5285 : pari_sp av = avma;
593 : : long N;
594 : : GEN x, cx, T;
595 : :
596 : 5285 : nf = checknf(nf); T = nf_get_pol(nf); N = degpol(T);
597 [ - + ]: 5285 : if (!n) return scalarcol_shallow(gen_1,N);
598 : 5285 : x = nf_to_scalar_or_basis(nf, z);
599 [ + + ]: 5285 : if (typ(x) != t_COL) { GEN y = zerocol(N); gel(y,1) = gpowgs(x,n); return y; }
600 : 4508 : x = primitive_part(x, &cx);
601 : 4508 : x = gen_powu(x, n, (void*)nf, _sqr, _mul);
602 [ + + ]: 4508 : if (cx) x = RgC_Rg_mul(x, powgi(cx, utoipos(n)));
603 [ - + ]: 5285 : 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 : 130231 : sqr_mod(void *data, GEN x)
613 : : {
614 : 130231 : eltmod_muldata *D = (eltmod_muldata*)data;
615 : 130231 : return FpC_red(nfsqri(D->nf, x), D->p);
616 : : }
617 : : static GEN
618 : 60122 : ei_msqr_mod(void *data, GEN x)
619 : : {
620 : 60122 : GEN x2 = sqr_mod(data, x);
621 : 60122 : eltmod_muldata *D = (eltmod_muldata*)data;
622 : 60122 : 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 : 87861 : pow_ei_mod_p(GEN nf, long I, GEN n, GEN p)
628 : : {
629 : 87861 : pari_sp av = avma;
630 : : eltmod_muldata D;
631 : : long s,N;
632 : : GEN y;
633 : :
634 [ - + ]: 87861 : if (typ(n) != t_INT) pari_err_TYPE("nfpow",n);
635 : 87861 : nf = checknf(nf); N = nf_get_degree(nf);
636 : 87861 : s = signe(n);
637 [ - + ]: 87861 : if (s < 0) pari_err_IMPL("negative power in pow_ei_mod_p");
638 [ + - ][ + + ]: 87861 : if (!s || I == 1) return scalarcol_shallow(gen_1,N);
639 : 73977 : D.nf = nf;
640 : 73977 : D.p = p;
641 : 73977 : D.I = I;
642 : 73977 : y = gen_pow_fold(col_ei(N, I), n, (void*)&D, &sqr_mod, &ei_msqr_mod);
643 : 87861 : return gerepileupto(av,y);
644 : : }
645 : :
646 : : /* valuation of integral x (ZV), with resp. to prime ideal pr */
647 : : long
648 : 4343581 : ZC_nfvalrem(GEN nf, GEN x, GEN pr, GEN *newx)
649 : : {
650 : : long i, v, l;
651 : 4343581 : GEN r, y, p = pr_get_p(pr), mul = zk_scalar_or_multable(nf, pr_get_tau(pr));
652 : :
653 : : /* p inert */
654 [ + + ][ + + ]: 4343581 : if (typ(mul) == t_INT) return newx? ZV_pvalrem(x, p, newx):ZV_pval(x, p);
655 : 4340977 : y = cgetg_copy(x, &l); /* will hold the new x */
656 : 4340977 : x = leafcopy(x);
657 : 4340977 : for(v=0;; v++)
658 : : {
659 [ + + ]: 22719041 : for (i=1; i<l; i++)
660 : : { /* is (x.b)[i] divisible by p ? */
661 : 20618901 : gel(y,i) = dvmdii(ZMrow_ZC_mul(mul,x,i),p,&r);
662 [ + + ][ + + ]: 20618901 : if (r != gen_0) { if (newx) *newx = x; return v; }
663 : : }
664 : 2100140 : swap(x, y);
665 : 6443721 : }
666 : : }
667 : : long
668 : 4132124 : ZC_nfval(GEN nf, GEN x, GEN P)
669 : 4132124 : { return ZC_nfvalrem(nf, x, P, NULL); }
670 : :
671 : : /* v_P(x) != 0, x a ZV. Simpler version of ZC_nfvalrem */
672 : : int
673 : 2681 : ZC_prdvd(GEN nf, GEN x, GEN P)
674 : : {
675 : 2681 : pari_sp av = avma;
676 : : long i, l;
677 : 2681 : GEN p = pr_get_p(P), mul = zk_scalar_or_multable(nf, pr_get_tau(P));
678 [ + + ]: 2681 : if (typ(mul) == t_INT) return ZV_Z_dvd(x, p);
679 : 2632 : l = lg(x);
680 [ + + ]: 10017 : for (i=1; i<l; i++)
681 [ + + ]: 9429 : if (remii(ZMrow_ZC_mul(mul,x,i), p) != gen_0) { avma = av; return 0; }
682 : 2681 : avma = av; return 1;
683 : : }
684 : :
685 : : int
686 : 28 : pr_equal(GEN nf, GEN P, GEN Q)
687 : : {
688 : 28 : GEN gQ, p = pr_get_p(P);
689 : 28 : long e = pr_get_e(P), f = pr_get_f(P), n;
690 [ + - ][ + - ]: 28 : if (!equalii(p, pr_get_p(Q)) || e != pr_get_e(Q) || f != pr_get_f(Q))
[ + + ]
691 : 14 : return 0;
692 : 14 : gQ = pr_get_gen(Q); n = lg(gQ)-1;
693 [ + + ]: 14 : if (2*e*f > n) return 1; /* room for only one such pr */
694 [ - + ][ # # ]: 28 : return ZV_equal(pr_get_gen(P), gQ) || ZC_prdvd(nf, gQ, P);
695 : : }
696 : :
697 : : long
698 : 325178 : nfval(GEN nf, GEN x, GEN pr)
699 : : {
700 : 325178 : pari_sp av = avma;
701 : : long w, e;
702 : : GEN cx, p;
703 : :
704 [ + + ]: 325178 : if (gequal0(x)) return LONG_MAX;
705 : 324534 : nf = checknf(nf);
706 : 324534 : checkprid(pr);
707 : 324534 : p = pr_get_p(pr);
708 : 324534 : e = pr_get_e(pr);
709 : 324534 : x = nf_to_scalar_or_basis(nf, x);
710 [ + + ]: 324534 : if (typ(x) != t_COL) return e*Q_pval(x,p);
711 : 174426 : x = Q_primitive_part(x, &cx);
712 : 174426 : w = ZC_nfval(nf,x,pr);
713 [ + + ]: 174426 : if (cx) w += e*Q_pval(cx,p);
714 : 325178 : 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 : 3808 : powp(GEN nf, GEN pr, long v)
721 : : {
722 : : GEN b, z;
723 : : long e;
724 [ + + ]: 3808 : if (!v) return gen_1;
725 : 3794 : b = pr_get_tau(pr);
726 [ + + ]: 3794 : if (typ(b) == t_INT) return gen_1;
727 : 574 : e = pr_get_e(pr);
728 : 574 : z = gel(b,1);
729 [ + - ]: 574 : if (e != 1) z = gdiv(nfpow_u(nf, z, e), powiu(pr_get_p(pr),e-1));
730 : 3808 : return nfpow_u(nf, z, v);
731 : : }
732 : : long
733 : 9639 : nfvalrem(GEN nf, GEN x, GEN pr, GEN *py)
734 : : {
735 : 9639 : pari_sp av = avma;
736 : : long w, e;
737 : : GEN cx, p, t;
738 : :
739 [ + + ]: 9639 : if (!py) return nfval(nf,x,pr);
740 [ + + ]: 9520 : if (gequal0(x)) { *py = gcopy(x); return LONG_MAX; }
741 : 9506 : nf = checknf(nf);
742 : 9506 : checkprid(pr);
743 : 9506 : p = pr_get_p(pr);
744 : 9506 : e = pr_get_e(pr);
745 : 9506 : x = nf_to_scalar_or_basis(nf, x);
746 [ + + ]: 9506 : if (typ(x) != t_COL) {
747 : 3367 : w = Q_pvalrem(x,p, py);
748 [ + + ]: 3367 : if (!w) { *py = gerepilecopy(av, x); return 0; }
749 : 3290 : *py = gerepileupto(av, gmul(powp(nf, pr, w), *py));
750 : 3290 : return e*w;
751 : : }
752 : 6139 : x = Q_primitive_part(x, &cx);
753 : 6139 : w = ZC_nfvalrem(nf,x,pr, py);
754 [ + + ]: 6139 : if (cx)
755 : : {
756 : 518 : long v = Q_pvalrem(cx,p, &t);
757 : 518 : *py = nfmul(nf, *py, gmul(powp(nf,pr,v), t));
758 : 518 : *py = gerepileupto(av, *py);
759 : 518 : w += e*v;
760 : : }
761 : : else
762 : 5621 : *py = gerepilecopy(av, *py);
763 : 9639 : return w;
764 : : }
765 : : GEN
766 : 147 : gpnfvalrem(GEN nf, GEN x, GEN pr, GEN *py)
767 : : {
768 : 147 : long v = nfvalrem(nf,x,pr,py);
769 [ + + ]: 147 : return v == LONG_MAX? mkoo(): stoi(v);
770 : : }
771 : :
772 : : GEN
773 : 54432 : coltoalg(GEN nf, GEN x)
774 : : {
775 : 54432 : return mkpolmod( coltoliftalg(nf, x), nf_get_pol(nf) );
776 : : }
777 : :
778 : : GEN
779 : 84574 : basistoalg(GEN nf, GEN x)
780 : : {
781 : : GEN z, T;
782 : :
783 : 84574 : nf = checknf(nf);
784 [ + + + + : 84574 : switch(typ(x))
- ]
785 : : {
786 : : case t_COL: {
787 : 41090 : pari_sp av = avma;
788 : 41090 : return gerepilecopy(av, coltoalg(nf, x));
789 : : }
790 : : case t_POLMOD:
791 : 119 : T = nf_get_pol(nf);
792 [ - + ]: 119 : if (!RgX_equal_var(T,gel(x,1)))
793 : 0 : pari_err_MODULUS("basistoalg", T,gel(x,1));
794 : 119 : return gcopy(x);
795 : : case t_POL:
796 : 322 : T = nf_get_pol(nf);
797 [ - + ]: 322 : if (varn(T) != varn(x)) pari_err_VAR("basistoalg",x,T);
798 : 322 : z = cgetg(3,t_POLMOD);
799 : 322 : gel(z,1) = ZX_copy(T);
800 : 322 : gel(z,2) = RgX_rem(x, T); return z;
801 : : case t_INT:
802 : : case t_FRAC:
803 : 43043 : T = nf_get_pol(nf);
804 : 43043 : z = cgetg(3,t_POLMOD);
805 : 43043 : gel(z,1) = ZX_copy(T);
806 : 43043 : gel(z,2) = gcopy(x); return z;
807 : : default:
808 : 0 : pari_err_TYPE("basistoalg",x);
809 : 84574 : return NULL; /* not reached */
810 : : }
811 : : }
812 : :
813 : : /* Assume nf is a genuine nf. */
814 : : GEN
815 : 6281867 : nf_to_scalar_or_basis(GEN nf, GEN x)
816 : : {
817 [ + + + + : 6281867 : switch(typ(x))
- ]
818 : : {
819 : : case t_INT: case t_FRAC:
820 : 1073374 : return x;
821 : : case t_POLMOD:
822 : 62605 : x = checknfelt_mod(nf,x,"nf_to_scalar_or_basis");
823 [ + + ]: 62535 : if (typ(x) != t_POL) return x;
824 : : /* fall through */
825 : : case t_POL:
826 : : {
827 : 61290 : GEN T = nf_get_pol(nf);
828 : 61290 : long l = lg(x);
829 [ + + ]: 61290 : if (varn(x) != varn(T)) pari_err_VAR("nf_to_scalar_or_basis", x,T);
830 [ + + ]: 61234 : if (l >= lg(T)) { x = RgX_rem(x, T); l = lg(x); }
831 [ + + ]: 61234 : if (l == 2) return gen_0;
832 [ + + ]: 55347 : if (l == 3) return gel(x,2);
833 : 49929 : return poltobasis(nf,x);
834 : : }
835 : : case t_COL:
836 [ + + ]: 5108150 : if (lg(x) != lg(nf_get_zk(nf))) break;
837 [ + + ]: 5108087 : return QV_isscalar(x)? gel(x,1): x;
838 : : }
839 : 63 : pari_err_TYPE("nf_to_scalar_or_basis",x);
840 : 6281678 : 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 : 2072 : RgX_to_nfX(GEN nf, GEN x)
847 : : {
848 : : long i, l;
849 : 2072 : GEN y = cgetg_copy(x, &l); y[1] = x[1];
850 [ + + ]: 26999 : for (i=2; i<l; i++) gel(y,i) = nf_to_scalar_or_basis(nf, gel(x,i));
851 : 2072 : return y;
852 : : }
853 : :
854 : : /* Assume nf is a genuine nf. */
855 : : GEN
856 : 105272 : nf_to_scalar_or_alg(GEN nf, GEN x)
857 : : {
858 [ + + + + : 105272 : switch(typ(x))
+ ]
859 : : {
860 : : case t_INT: case t_FRAC:
861 : 56048 : return x;
862 : : case t_POLMOD:
863 : 1715 : x = checknfelt_mod(nf,x,"nf_to_scalar_or_alg");
864 [ + + ]: 1715 : if (typ(x) != t_POL) return x;
865 : : /* fall through */
866 : : case t_POL:
867 : : {
868 : 13615 : GEN T = nf_get_pol(nf);
869 : 13615 : long l = lg(x);
870 [ + + ]: 13615 : if (varn(x) != varn(T)) pari_err_VAR("nf_to_scalar_or_alg", x,T);
871 [ + + ]: 13475 : if (l >= lg(T)) { x = RgX_rem(x, T); l = lg(x); }
872 [ - + ]: 13475 : if (l == 2) return gen_0;
873 [ + + ]: 13475 : if (l == 3) return gel(x,2);
874 : 12887 : return x;
875 : : }
876 : : case t_COL:
877 [ + + ]: 35301 : if (lg(x) != lg(nf_get_zk(nf))) break;
878 [ + + ]: 35133 : return QV_isscalar(x)? gel(x,1): coltoliftalg(nf, x);
879 : : }
880 : 217 : pari_err_TYPE("nf_to_scalar_or_alg",x);
881 : 104915 : return NULL; /* not reached */
882 : : }
883 : :
884 : : /* gmul(A, RgX_to_RgC(x)), A t_MAT (or t_VEC) of compatible dimensions */
885 : : GEN
886 : 1223993 : mulmat_pol(GEN A, GEN x)
887 : : {
888 : : long i,l;
889 : : GEN z;
890 [ + + ]: 1223993 : if (typ(x) != t_POL) return gmul(x,gel(A,1)); /* scalar */
891 [ + + ][ + - ]: 1223923 : l=lg(x)-1; if (l == 1) return typ(A)==t_VEC? gen_0: zerocol(nbrows(A));
892 : 1221781 : x++; z = gmul(gel(x,1), gel(A,1));
893 [ + + ]: 6013264 : for (i=2; i<l ; i++)
894 [ + + ]: 4791483 : if (!gequal0(gel(x,i))) z = gadd(z, gmul(gel(x,i), gel(A,i)));
895 : 1223993 : return z;
896 : : }
897 : :
898 : : /* x a t_POL, nf a genuine nf. No garbage collecting. No check. */
899 : : GEN
900 : 1082364 : poltobasis(GEN nf, GEN x)
901 : : {
902 : 1082364 : GEN P = nf_get_pol(nf);
903 [ + + ]: 1082364 : if (varn(x) != varn(P)) pari_err_VAR( "poltobasis", x,P);
904 [ + + ]: 1082154 : if (degpol(x) >= degpol(P)) x = RgX_rem(x,P);
905 : 1082154 : return mulmat_pol(nf_get_invzk(nf), x);
906 : : }
907 : :
908 : : GEN
909 : 64909 : algtobasis(GEN nf, GEN x)
910 : : {
911 : : pari_sp av;
912 : :
913 : 64909 : nf = checknf(nf);
914 [ + + + + : 64909 : switch(typ(x))
- ]
915 : : {
916 : : case t_POLMOD:
917 [ + + ]: 39109 : if (!RgX_equal_var(nf_get_pol(nf),gel(x,1)))
918 : 7 : pari_err_MODULUS("algtobasis", nf_get_pol(nf),gel(x,1));
919 : 39102 : x = gel(x,2);
920 [ + + - ]: 39102 : switch(typ(x))
921 : : {
922 : : case t_INT:
923 : 2863 : case t_FRAC: return scalarcol(x, nf_get_degree(nf));
924 : : case t_POL:
925 : 36239 : av = avma;
926 : 36239 : return gerepileupto(av,poltobasis(nf,x));
927 : : }
928 : 0 : break;
929 : :
930 : : case t_POL:
931 : 11898 : av = avma;
932 : 11898 : return gerepileupto(av,poltobasis(nf,x));
933 : :
934 : : case t_COL:
935 [ - + ]: 6993 : if (lg(x)-1 != nf_get_degree(nf)) pari_err_DIM("nfalgtobasis");
936 : 6993 : return gcopy(x);
937 : :
938 : : case t_INT:
939 : 6909 : case t_FRAC: return scalarcol(x, nf_get_degree(nf));
940 : : }
941 : 0 : pari_err_TYPE("algtobasis",x);
942 : 64902 : return NULL; /* not reached */
943 : : }
944 : :
945 : : GEN
946 : 35406 : rnfbasistoalg(GEN rnf,GEN x)
947 : : {
948 : 35406 : const char *f = "rnfbasistoalg";
949 : : long lx, i;
950 : 35406 : pari_sp av = avma;
951 : : GEN z, nf, relpol, T;
952 : :
953 : 35406 : checkrnf(rnf);
954 : 35406 : nf = rnf_get_nf(rnf);
955 : 35406 : T = nf_get_pol(nf);
956 : 35406 : relpol = QXQX_to_mod_shallow(rnf_get_pol(rnf), T);
957 [ + + + + ]: 35406 : switch(typ(x))
958 : : {
959 : : case t_COL:
960 : 700 : z = cgetg_copy(x, &lx);
961 [ + + ]: 2044 : for (i=1; i<lx; i++)
962 : : {
963 : 1393 : GEN c = nf_to_scalar_or_alg(nf, gel(x,i));
964 [ + + ]: 1344 : if (typ(c) == t_POL) c = mkpolmod(c,T);
965 : 1344 : gel(z,i) = c;
966 : : }
967 : 651 : z = RgV_RgC_mul(gel(rnf_get_zk(rnf),1), z);
968 : 588 : return gerepileupto(av, gmodulo(z,relpol));
969 : :
970 : : case t_POLMOD:
971 : 23646 : x = polmod_nffix(f, rnf, x, 0);
972 [ + + ]: 23436 : if (typ(x) != t_POL) break;
973 : 9387 : retmkpolmod(RgX_copy(x), RgX_copy(relpol));
974 : : case t_POL:
975 [ + + ]: 798 : if (varn(x) == varn(T))
976 : : {
977 [ + + ]: 217 : if (!RgX_is_QX(x)) pari_err_TYPE(f,x);
978 : 168 : x = gmodulo(x,T); break;
979 : : }
980 [ + + ]: 581 : if (varn(x) == varn(relpol))
981 : : {
982 : 532 : x = RgX_nffix(f,nf_get_pol(nf),x,0);
983 : 532 : return gmodulo(x, relpol);
984 : : }
985 : 49 : pari_err_VAR(f, x,relpol);
986 : : }
987 : 34986 : retmkpolmod(scalarpol(x, varn(relpol)), RgX_copy(relpol));
988 : : }
989 : :
990 : : GEN
991 : 2527 : matbasistoalg(GEN nf,GEN x)
992 : : {
993 : : long i, j, li, lx;
994 : 2527 : GEN z = cgetg_copy(x, &lx);
995 : :
996 [ + + ]: 2527 : if (lx == 1) return z;
997 [ + + - ]: 2513 : switch(typ(x))
998 : : {
999 : : case t_VEC: case t_COL:
1000 [ + + ]: 56 : for (i=1; i<lx; i++) gel(z,i) = basistoalg(nf, gel(x,i));
1001 : 28 : return z;
1002 : 2485 : case t_MAT: break;
1003 : 0 : default: pari_err_TYPE("matbasistoalg",x);
1004 : : }
1005 : 2485 : li = lgcols(x);
1006 [ + + ]: 11578 : for (j=1; j<lx; j++)
1007 : : {
1008 : 9093 : GEN c = cgetg(li,t_COL), xj = gel(x,j);
1009 : 9093 : gel(z,j) = c;
1010 [ + + ]: 54551 : for (i=1; i<li; i++) gel(c,i) = basistoalg(nf, gel(xj,i));
1011 : : }
1012 : 2527 : return z;
1013 : : }
1014 : :
1015 : : GEN
1016 : 2750 : matalgtobasis(GEN nf,GEN x)
1017 : : {
1018 : : long i, j, li, lx;
1019 : 2750 : GEN z = cgetg_copy(x, &lx);
1020 : :
1021 [ + + ]: 2750 : if (lx == 1) return z;
1022 [ + + - ]: 2722 : switch(typ(x))
1023 : : {
1024 : : case t_VEC: case t_COL:
1025 [ + + ]: 10967 : for (i=1; i<lx; i++) gel(z,i) = algtobasis(nf, gel(x,i));
1026 : 2715 : return z;
1027 : 7 : case t_MAT: break;
1028 : 0 : default: pari_err_TYPE("matalgtobasis",x);
1029 : : }
1030 : 7 : li = lgcols(x);
1031 [ + + ]: 14 : for (j=1; j<lx; j++)
1032 : : {
1033 : 7 : GEN c = cgetg(li,t_COL), xj = gel(x,j);
1034 : 7 : gel(z,j) = c;
1035 [ + + ]: 21 : for (i=1; i<li; i++) gel(c,i) = algtobasis(nf, gel(xj,i));
1036 : : }
1037 : 2750 : return z;
1038 : : }
1039 : : GEN
1040 : 3360 : RgM_to_nfM(GEN nf,GEN x)
1041 : : {
1042 : : long i, j, li, lx;
1043 : 3360 : GEN z = cgetg_copy(x, &lx);
1044 : :
1045 [ - + ]: 3360 : if (lx == 1) return z;
1046 : 3360 : li = lgcols(x);
1047 [ + + ]: 24759 : for (j=1; j<lx; j++)
1048 : : {
1049 : 21399 : GEN c = cgetg(li,t_COL), xj = gel(x,j);
1050 : 21399 : gel(z,j) = c;
1051 [ + + ]: 139986 : for (i=1; i<li; i++) gel(c,i) = nf_to_scalar_or_basis(nf, gel(xj,i));
1052 : : }
1053 : 3360 : return z;
1054 : : }
1055 : : GEN
1056 : 36755 : RgC_to_nfC(GEN nf,GEN x)
1057 : : {
1058 : 36755 : long i, lx = lg(x);
1059 : 36755 : GEN z = cgetg(lx, t_COL);
1060 [ + + ]: 264009 : for (i=1; i<lx; i++) gel(z,i) = nf_to_scalar_or_basis(nf, gel(x,i));
1061 : 36755 : return z;
1062 : : }
1063 : :
1064 : : /* x a t_POLMOD, supposedly in rnf = K[z]/(T), K = Q[y]/(Tnf) */
1065 : : GEN
1066 : 60424 : polmod_nffix(const char *f, GEN rnf, GEN x, int lift)
1067 : 60424 : { return polmod_nffix2(f, rnf_get_nfpol(rnf), rnf_get_pol(rnf), x,lift); }
1068 : : GEN
1069 : 60515 : polmod_nffix2(const char *f, GEN T, GEN relpol, GEN x, int lift)
1070 : : {
1071 [ + + ]: 60515 : if (RgX_equal_var(gel(x,1),relpol))
1072 : : {
1073 : 55321 : x = gel(x,2);
1074 [ + + ][ + - ]: 55321 : if (typ(x) == t_POL && varn(x) == varn(relpol))
1075 : : {
1076 : 39599 : x = RgX_nffix(f, T, x, lift);
1077 [ + + + ]: 39599 : switch(lg(x))
1078 : : {
1079 : 11130 : case 2: return gen_0;
1080 : 4242 : case 3: return gel(x,2);
1081 : : }
1082 : 24227 : return x;
1083 : : }
1084 : : }
1085 : 60515 : return Rg_nffix(f, T, x, lift);
1086 : : }
1087 : : GEN
1088 : 1148 : rnfalgtobasis(GEN rnf,GEN x)
1089 : : {
1090 : 1148 : const char *f = "rnfalgtobasis";
1091 : 1148 : pari_sp av = avma;
1092 : : GEN T, relpol;
1093 : :
1094 : 1148 : checkrnf(rnf);
1095 : 1148 : relpol = rnf_get_pol(rnf);
1096 : 1148 : T = rnf_get_nfpol(rnf);
1097 [ + + + + ]: 1148 : switch(typ(x))
1098 : : {
1099 : : case t_COL:
1100 [ + + ]: 49 : if (lg(x)-1 != rnf_get_degree(rnf)) pari_err_DIM(f);
1101 : 28 : x = RgV_nffix(f, T, x, 0);
1102 : 21 : return gerepilecopy(av, x);
1103 : :
1104 : : case t_POLMOD:
1105 : 1015 : x = polmod_nffix(f, rnf, x, 0);
1106 [ + + ]: 973 : if (typ(x) != t_POL) break;
1107 : 686 : return gerepileupto(av, mulmat_pol(rnf_get_invzk(rnf), x));
1108 : : case t_POL:
1109 [ + + ]: 56 : if (varn(x) == varn(T))
1110 : : {
1111 [ + + ]: 21 : if (!RgX_is_QX(x)) pari_err_TYPE(f,x);
1112 : 14 : x = mkpolmod(x,T); break;
1113 : : }
1114 : 35 : x = RgX_nffix(f, T, x, 0);
1115 [ + + ]: 28 : if (degpol(x) >= degpol(relpol)) x = RgX_rem(x,relpol);
1116 : 28 : return gerepileupto(av, mulmat_pol(rnf_get_invzk(rnf), x));
1117 : : }
1118 : 1064 : 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 : 259 : nfdiveuc(GEN nf, GEN a, GEN b)
1125 : : {
1126 : 259 : pari_sp av = avma;
1127 : 259 : a = nfdiv(nf,a,b);
1128 : 259 : 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 : 259 : nfmod(GEN nf, GEN a, GEN b)
1135 : : {
1136 : 259 : pari_sp av = avma;
1137 : 259 : GEN p1 = gneg_i(nfmul(nf,b,ground(nfdiv(nf,a,b))));
1138 : 259 : 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 : 259 : nfdivrem(GEN nf, GEN a, GEN b)
1145 : : {
1146 : 259 : pari_sp av = avma;
1147 : 259 : GEN p1,z, y = ground(nfdiv(nf,a,b));
1148 : :
1149 : 259 : p1 = gneg_i(nfmul(nf,b,y));
1150 : 259 : z = cgetg(3,t_VEC);
1151 : 259 : gel(z,1) = gcopy(y);
1152 : 259 : 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 : 377750 : eval_sign(GEN M, GEN x, long k)
1163 : : {
1164 : 377750 : long i, l = lg(x);
1165 : 377750 : GEN z = gel(x,1); /* times M[k,1], which is 1 */
1166 [ + + ]: 1039700 : for (i = 2; i < l; i++) z = mpadd(z, mpmul(gcoeff(M,k,i), gel(x,i)));
1167 [ - + ]: 377750 : if (realprec(z) < DEFAULTPREC) pari_err_PREC("nfsign_arch");
1168 : 377750 : return signe(z);
1169 : : }
1170 : :
1171 : : /* sigma_k(x) */
1172 : : GEN
1173 : 2604 : nfembed(GEN nf, GEN x, long k)
1174 : : {
1175 : 2604 : pari_sp av = avma;
1176 : : long i, l;
1177 : : GEN z, M;
1178 : 2604 : nf = checknf(nf);
1179 : 2604 : x = nf_to_scalar_or_basis(nf,x);
1180 [ + + ]: 2604 : if (typ(x) != t_COL) return gerepilecopy(av, x);
1181 : 259 : M = nf_get_M(nf); l = lg(M); /* > 2 */
1182 : 259 : z = gel(x,1);
1183 [ + + ]: 742 : for (i=2; i<l; i++) z = gadd(z, gmul(gcoeff(M,k,i), gel(x,i)));
1184 : 2604 : return gerepileupto(av, z);
1185 : : }
1186 : :
1187 : : GEN
1188 : 245 : vecsmall01_to_indices(GEN v)
1189 : : {
1190 : 245 : long i, k, l = lg(v);
1191 : 245 : GEN p = new_chunk(l) + l;
1192 [ + + ]: 812 : for (k=1, i=l-1; i; i--)
1193 [ + - ]: 567 : if (v[i]) { *--p = i; k++; }
1194 : 245 : *--p = evallg(k) | evaltyp(t_VECSMALL);
1195 : 245 : avma = (pari_sp)p; return p;
1196 : : }
1197 : : GEN
1198 : 679010 : vec01_to_indices(GEN v)
1199 : : {
1200 : : long i, k, l;
1201 : : GEN p;
1202 : :
1203 [ + + - ]: 679010 : switch (typ(v))
1204 : : {
1205 : 414916 : case t_VECSMALL: return v;
1206 : 264094 : case t_VEC: break;
1207 : 0 : default: pari_err_TYPE("vec01_to_indices",v);
1208 : : }
1209 : 264094 : l = lg(v);
1210 : 264094 : p = new_chunk(l) + l;
1211 [ + + ]: 897093 : for (k=1, i=l-1; i; i--)
1212 [ + + ]: 632999 : if (signe(gel(v,i))) { *--p = i; k++; }
1213 : 264094 : *--p = evallg(k) | evaltyp(t_VECSMALL);
1214 : 679010 : avma = (pari_sp)p; return p;
1215 : : }
1216 : : GEN
1217 : 3304 : indices_to_vec01(GEN p, long r)
1218 : : {
1219 : 3304 : long i, l = lg(p);
1220 : 3304 : GEN v = zerovec(r);
1221 [ + + ]: 5264 : for (i = 1; i < l; i++) gel(v, p[i]) = gen_1;
1222 : 3304 : return v;
1223 : : }
1224 : :
1225 : : /* return (column) vector of R1 signatures of x (0 or 1) */
1226 : : GEN
1227 : 502105 : nfsign_arch(GEN nf, GEN x, GEN arch)
1228 : : {
1229 : 502105 : GEN M, V, archp = vec01_to_indices(arch);
1230 : 502105 : long i, s, n = lg(archp)-1;
1231 : : pari_sp av;
1232 : :
1233 [ + + ]: 502105 : if (!n) return cgetg(1,t_VECSMALL);
1234 : 421689 : nf = checknf(nf);
1235 [ + + ]: 421689 : if (typ(x) == t_MAT)
1236 : : { /* factorisation */
1237 : 103940 : GEN g = gel(x,1), e = gel(x,2);
1238 : 103940 : V = zero_zv(n);
1239 [ + + ]: 318645 : for (i=1; i<lg(g); i++)
1240 [ + + ]: 214705 : if (mpodd(gel(e,i)))
1241 : 177783 : Flv_add_inplace(V, nfsign_arch(nf,gel(g,i),archp), 2);
1242 : 103940 : avma = (pari_sp)V; return V;
1243 : : }
1244 : 317749 : av = avma; V = cgetg(n+1,t_VECSMALL);
1245 : 317749 : x = nf_to_scalar_or_basis(nf, x);
1246 [ + + + ]: 317749 : switch(typ(x))
1247 : : {
1248 : : case t_INT:
1249 : 79691 : s = signe(x);
1250 [ - + ]: 79691 : if (!s) pari_err_DOMAIN("nfsign_arch","element","=",gen_0,x);
1251 : 79691 : avma = av; return const_vecsmall(n, (s < 0)? 1: 0);
1252 : : case t_FRAC:
1253 : 924 : s = signe(gel(x,1));
1254 : 924 : avma = av; return const_vecsmall(n, (s < 0)? 1: 0);
1255 : : }
1256 : 237134 : x = Q_primpart(x); M = nf_get_M(nf);
1257 [ + + ]: 614884 : for (i = 1; i <= n; i++) V[i] = (eval_sign(M, x, archp[i]) < 0)? 1: 0;
1258 : 502105 : avma = (pari_sp)V; return V;
1259 : : }
1260 : :
1261 : : /* return the vector of signs of x; the matrix of such if x is a vector
1262 : : * of nf elements */
1263 : : GEN
1264 : 350 : nfsign(GEN nf, GEN x)
1265 : : {
1266 : : long i, l;
1267 : : GEN arch, S;
1268 : :
1269 : 350 : nf = checknf(nf);
1270 : 350 : arch = identity_perm( nf_get_r1(nf) );
1271 [ + + ]: 350 : if (typ(x) != t_VEC) return nfsign_arch(nf, x, arch);
1272 : 49 : l = lg(x); S = cgetg(l, t_MAT);
1273 [ + + ]: 329 : for (i=1; i<l; i++) gel(S,i) = nfsign_arch(nf, gel(x,i), arch);
1274 : 350 : return S;
1275 : : }
1276 : :
1277 : : /* multiply y by t = 1 mod^* f such that sign(x) = sign(y) at arch = divisor[2].
1278 : : * If x == NULL, make y >> 0 at sarch */
1279 : : GEN
1280 : 81438 : set_sign_mod_divisor(GEN nf, GEN x, GEN y, GEN divisor, GEN sarch)
1281 : : {
1282 : : GEN s, archp, gen;
1283 : : long nba,i;
1284 [ - + ]: 81438 : if (!sarch) return y;
1285 : 81438 : gen = gel(sarch,2); nba = lg(gen);
1286 [ + + ]: 81438 : if (nba == 1) return y;
1287 : :
1288 : 71022 : archp = vec01_to_indices(gel(divisor,2));
1289 : 71022 : s = nfsign_arch(nf, y, archp);
1290 [ + + ]: 71022 : if (x) Flv_add_inplace(s, nfsign_arch(nf, x, archp), 2);
1291 : 71022 : s = Flm_Flc_mul(gel(sarch,3), s, 2);
1292 [ + + ]: 167272 : for (i=1; i<nba; i++)
1293 [ + + ]: 96250 : if (s[i]) y = nfmul(nf,y,gel(gen,i));
1294 : 81438 : return y;
1295 : : }
1296 : :
1297 : : /* given an element x in Z_K and an integral ideal y in HNF, coprime with x,
1298 : : outputs an element inverse of x modulo y */
1299 : : GEN
1300 : 197 : nfinvmodideal(GEN nf, GEN x, GEN y)
1301 : : {
1302 : 197 : pari_sp av = avma;
1303 : 197 : GEN a, yZ = gcoeff(y,1,1);
1304 : :
1305 [ - + ]: 197 : if (is_pm1(yZ)) return zerocol( nf_get_degree(nf) );
1306 : 197 : x = nf_to_scalar_or_basis(nf, x);
1307 [ + + ]: 197 : if (typ(x) == t_INT) return gerepileupto(av, Fp_inv(x, yZ));
1308 : :
1309 : 134 : a = hnfmerge_get_1(idealhnf_principal(nf,x), y);
1310 [ - + ]: 134 : if (!a) pari_err_INV("nfinvmodideal", x);
1311 : 197 : return gerepileupto(av, ZC_hnfrem(nfdiv(nf,a,x), y));
1312 : : }
1313 : :
1314 : : static GEN
1315 : 257994 : nfsqrmodideal(GEN nf, GEN x, GEN id) {
1316 : 257994 : return ZC_hnfrem(nfsqri(nf,x), id);
1317 : : }
1318 : : static GEN
1319 : 560742 : nfmulmodideal(GEN nf, GEN x, GEN y, GEN id) {
1320 [ + + ]: 560742 : return x? ZC_hnfrem(nfmuli(nf,x,y), id): y;
1321 : : }
1322 : : /* assume x integral, k integer, A in HNF */
1323 : : GEN
1324 : 366891 : nfpowmodideal(GEN nf,GEN x,GEN k,GEN A)
1325 : : {
1326 : 366891 : long s = signe(k);
1327 : : pari_sp av;
1328 : : GEN y;
1329 : :
1330 [ - + ]: 366891 : if (!s) return gen_1;
1331 : 366891 : av = avma;
1332 : 366891 : x = nf_to_scalar_or_basis(nf, x);
1333 [ + + ]: 366891 : if (typ(x) != t_COL) return Fp_pow(x, k, gcoeff(A,1,1));
1334 [ - + ]: 183817 : if (s < 0) { x = nfinvmodideal(nf, x,A); k = absi(k); }
1335 : 183817 : for(y = NULL;;)
1336 : : {
1337 [ + + ]: 441811 : if (mpodd(k)) y = nfmulmodideal(nf,y,x,A);
1338 [ + + ]: 441811 : k = shifti(k,-1); if (!signe(k)) break;
1339 : 257994 : x = nfsqrmodideal(nf,x,A);
1340 : 257994 : }
1341 : 366891 : return gerepileupto(av, y);
1342 : : }
1343 : :
1344 : : /* a * g^n mod id */
1345 : : static GEN
1346 : 309778 : elt_mulpow_modideal(GEN nf, GEN a, GEN g, GEN n, GEN id)
1347 : : {
1348 : 309778 : return nfmulmodideal(nf, a, nfpowmodideal(nf,g,n,id), id);
1349 : : }
1350 : :
1351 : : /* assume (num(g[i]), id) = 1 for all i. Return prod g[i]^e[i] mod id.
1352 : : * EX = multiple of exponent of (O_K/id)^* */
1353 : : GEN
1354 : 113211 : famat_to_nf_modideal_coprime(GEN nf, GEN g, GEN e, GEN id, GEN EX)
1355 : : {
1356 : 113211 : GEN plus = NULL, minus = NULL, idZ = gcoeff(id,1,1);
1357 : 113211 : pari_sp av = avma;
1358 : 113211 : long i, lx = lg(g);
1359 [ + + ]: 113211 : GEN EXo2 = (expi(EX) > 10)? shifti(EX,-1): NULL;
1360 : :
1361 [ + + ]: 113211 : if (is_pm1(idZ)) lx = 1; /* id = Z_K */
1362 [ + + ]: 414224 : for (i=1; i<lx; i++)
1363 : : {
1364 : 301013 : GEN h, n = centermodii(gel(e,i), EX, EXo2);
1365 : 301013 : long sn = signe(n);
1366 [ + + ]: 301013 : if (!sn) continue;
1367 : :
1368 : 249713 : h = nf_to_scalar_or_basis(nf, gel(g,i));
1369 [ + - + ]: 249713 : switch(typ(h))
1370 : : {
1371 : 161682 : case t_INT: break;
1372 : : case t_FRAC:
1373 : 0 : h = Fp_div(gel(h,1), gel(h,2), idZ); break;
1374 : : default:
1375 : : {
1376 : : GEN dh;
1377 : 88031 : h = Q_remove_denom(h, &dh);
1378 [ - + ]: 88031 : if (dh) h = FpC_Fp_mul(h, Fp_inv(dh,idZ), idZ);
1379 : : }
1380 : : }
1381 [ + + ]: 249713 : if (sn > 0)
1382 : 248396 : plus = elt_mulpow_modideal(nf, plus, h, n, id);
1383 : : else /* sn < 0 */
1384 : 1317 : minus = elt_mulpow_modideal(nf, minus, h, absi(n), id);
1385 : :
1386 [ - + ]: 249713 : if (gc_needed(av, 2))
1387 : : {
1388 [ # # ]: 0 : if(DEBUGMEM>1) pari_warn(warnmem,"famat_to_nf_modideal_coprime");
1389 [ # # ]: 0 : if (!plus) plus = gen_0;
1390 [ # # ]: 0 : if (!minus) minus = gen_0;
1391 : 0 : gerepileall(av,2, &plus, &minus);
1392 [ # # ]: 0 : if (isintzero(plus)) plus = NULL;
1393 [ # # ]: 0 : if (isintzero(minus)) minus = NULL;
1394 : : }
1395 : : }
1396 [ + + ]: 113211 : if (minus)
1397 : 197 : plus = nfmulmodideal(nf, plus, nfinvmodideal(nf,minus,id), id);
1398 [ + + ]: 113211 : return plus? plus: scalarcol_shallow(gen_1, lg(id)-1);
1399 : : }
1400 : :
1401 : : /* given 2 integral ideals x, y in HNF s.t x | y | x^2, compute the quotient
1402 : : (1+x)/(1+y) in the form [[cyc],[gen]], if U != NULL, set *U := ux^-1 */
1403 : : static GEN
1404 : 11774 : zidealij(GEN x, GEN y, GEN *U)
1405 : : {
1406 : : GEN G, cyc;
1407 : : long j, N;
1408 : :
1409 : : /* x^(-1) y = relations between the 1 + x_i (HNF) */
1410 : 11774 : cyc = ZM_snf_group(hnf_solve(x, y), U, &G);
1411 : 11774 : N = lg(cyc); G = ZM_mul(x,G); settyp(G, t_VEC); /* new generators */
1412 [ + + ]: 57883 : for (j=1; j<N; j++)
1413 : : {
1414 : 46109 : GEN c = gel(G,j);
1415 : 46109 : gel(c,1) = addiu(gel(c,1), 1); /* 1 + g_j */
1416 [ + + ]: 46109 : if (ZV_isscalar(c)) gel(G,j) = gel(c,1);
1417 : : }
1418 [ + + ]: 11774 : if (U) *U = RgM_mul(*U, RgM_inv(x));
1419 : 11774 : return mkvec2(cyc, G);
1420 : : }
1421 : :
1422 : : static GEN
1423 : 270016 : Fq_FpXQ_log(GEN a, GEN g, GEN ord, GEN T, GEN p)
1424 : : {
1425 [ + + ]: 270016 : if (!T) return Fp_log(a,g,ord,p);
1426 [ + + ]: 93885 : if (typ(a)==t_INT) return Fp_FpXQ_log(a,g,ord,T,p);
1427 : 270016 : return FpXQ_log(a,g,ord,T,p);
1428 : : }
1429 : : /* same in nf.zk / pr */
1430 : : static GEN
1431 : 270016 : nf_log(GEN nf, GEN a, GEN g, GEN ord, GEN pr)
1432 : : {
1433 : 270016 : pari_sp av = avma;
1434 : 270016 : GEN T,p, modpr = nf_to_Fq_init(nf, &pr, &T, &p);
1435 : 270016 : GEN A = nf_to_Fq(nf,a,modpr);
1436 : 270016 : GEN G = nf_to_Fq(nf,g,modpr);
1437 : 270016 : return gerepileuptoint(av, Fq_FpXQ_log(A,G,ord,T,p));
1438 : : }
1439 : :
1440 : : /* Product of cyc entries, with cyc = diagonal(Smith Normal Form), assumed != 0.
1441 : : * Set L to the index of the last non-trivial (!= 1) entry */
1442 : : GEN
1443 : 7245 : detcyc(GEN cyc, long *L)
1444 : : {
1445 : 7245 : pari_sp av = avma;
1446 : 7245 : long i, l = lg(cyc);
1447 : 7245 : GEN s = gel(cyc,1);
1448 : :
1449 [ + + ]: 7245 : if (l == 1) { *L = 1; return gen_1; }
1450 [ + + ]: 10066 : for (i=2; i<l; i++)
1451 : : {
1452 : 3696 : GEN t = gel(cyc,i);
1453 [ + + ]: 3696 : if (is_pm1(t)) break;
1454 : 2849 : s = mulii(s, t);
1455 : : }
1456 [ + + ]: 7245 : *L = i; return i <= 2? icopy(s): gerepileuptoint(av,s);
1457 : : }
1458 : :
1459 : : /* (U,V) = 1. Return y = x mod U, = 1 mod V (uv: u + v = 1, u in U, v in V),
1460 : : * namely u + x*v.
1461 : : * Either (u,mv) are both t_INT, or
1462 : : * u is a t_COL, mv is a t_MAT, multiplication table by v */
1463 : : static GEN
1464 : 4046 : makeprimetoideal(GEN UV, GEN u,GEN mv, GEN x)
1465 : : {
1466 : : GEN t;
1467 [ + + ]: 4046 : if (typ(mv) == t_INT) /* u t_INT */
1468 : : {
1469 [ + + ]: 1106 : if (typ(x) == t_INT) return addii(mulii(x,mv), u);
1470 : 560 : t = ZC_Z_add(ZC_Z_mul(x,mv), u);
1471 : : }
1472 : : else
1473 : : {
1474 [ + + ]: 2940 : t = typ(x) == t_INT? ZC_Z_mul(gel(mv,1),x): ZM_ZC_mul(mv,x);
1475 : 2940 : t = ZC_add(t, u);
1476 : : }
1477 : 4046 : return ZC_hnfrem(t, UV);
1478 : : }
1479 : :
1480 : : static GEN
1481 : 518 : makeprimetoidealvec(GEN UV, GEN u,GEN mv, GEN gen)
1482 : : {
1483 : : long i, ly;
1484 : 518 : GEN y = cgetg_copy(gen, &ly);
1485 [ + + ]: 1064 : for (i=1; i<ly; i++) gel(y,i) = makeprimetoideal(UV,u,mv, gel(gen,i));
1486 : 518 : return y;
1487 : : }
1488 : :
1489 : : /* Given an ideal pr^ep, and an integral ideal x (in HNF form) compute a list
1490 : : * of vectors,corresponding to the abelian groups (O_K/pr)^*, and
1491 : : * 1 + pr^i/ 1 + pr^min(2i, ep), i = 1,...
1492 : : * Each vector has 5 components as follows :
1493 : : * [[cyc],[g],[g'],[sign],U.X^-1].
1494 : : * cyc = type as abelian group
1495 : : * g, g' = generators. (g',x) = 1, not necessarily so for g
1496 : : * sign = vector of the sign(g') at arch.
1497 : : * If x = NULL, the original ideal was a prime power */
1498 : : static GEN
1499 : 12159 : zprimestar(GEN nf, GEN pr, GEN ep, GEN x, GEN arch)
1500 : : {
1501 : 12159 : pari_sp av = avma;
1502 : 12159 : long a, e = itos(ep), f = pr_get_f(pr);
1503 : 12159 : GEN p = pr_get_p(pr), list, g, g0, y, u,v, prb, pre;
1504 : : ulong mask;
1505 : :
1506 [ - + ]: 12159 : if(DEBUGLEVEL>3) err_printf("treating pr^%ld, pr = %Ps\n",e,pr);
1507 [ + + ]: 12159 : if (f == 1)
1508 : 5670 : g = pgener_Fp(p);
1509 : : else
1510 : : {
1511 : 6489 : GEN T, modpr = zk_to_Fq_init(nf, &pr, &T, &p);
1512 : 6489 : g = Fq_to_nf(gener_FpXQ(T,p,NULL), modpr);
1513 : 6489 : g = poltobasis(nf, g);
1514 : : }
1515 : : /* g generates (Z_K / pr)^* */
1516 : 12159 : prb = idealhnf_two(nf,pr);
1517 [ + + ]: 12159 : pre = (e==1)? prb: idealpow(nf,pr,ep);
1518 [ + + ]: 12159 : if (x)
1519 : : {
1520 : : GEN mv;
1521 : 2254 : v = idealaddtoone_i(nf,idealdivpowprime(nf,x,pr,ep), pre);
1522 : 2247 : mv = zk_scalar_or_multable(nf, v);
1523 [ + + ]: 2247 : u = typ(mv) == t_INT? subui(1,mv): unnf_minus_x(v);
1524 : 2247 : v = mv;
1525 : 2247 : g0 = makeprimetoideal(x,u,mv,g);
1526 : : }
1527 : : else
1528 : : {
1529 : 9905 : u = v = NULL; /* gcc -Wall */
1530 : 9905 : g0 = g;
1531 : : }
1532 : :
1533 : 12152 : y = mkvec5(mkvec(subiu(powiu(p,f), 1)),
1534 : : mkvec(g),
1535 : : mkvec(g0),
1536 : : mkvec(nfsign_arch(nf,g0,arch)),
1537 : : gen_1);
1538 [ + + ]: 12152 : if (e == 1) return gerepilecopy(av, mkvec(y));
1539 : 7189 : list = vectrunc_init(e+1);
1540 : 7189 : vectrunc_append(list, y);
1541 : 7189 : mask = quadratic_prec_mask(e);
1542 : 7189 : a = 1;
1543 [ + + ]: 17983 : while (mask > 1)
1544 : : {
1545 : 10794 : GEN pra = prb, gen, z, s, U;
1546 : 10794 : long i, l, b = a << 1;
1547 : :
1548 [ + + ]: 10794 : if (mask & 1) b--;
1549 : 10794 : mask >>= 1;
1550 : : /* compute 1 + pr^a / 1 + pr^b, 2a <= b */
1551 [ - + ]: 10794 : if(DEBUGLEVEL>3) err_printf(" treating a = %ld, b = %ld\n",a,b);
1552 [ + + ]: 10794 : prb = (b >= e)? pre: idealpows(nf,pr,b);
1553 : 10794 : z = zidealij(pra, prb, &U);
1554 : 10794 : gen = leafcopy(gel(z,2));
1555 : 10794 : s = cgetg_copy(gen, &l);
1556 [ + + ]: 55699 : for (i = 1; i < l; i++)
1557 : : {
1558 [ + + ]: 44905 : if (x) gel(gen,i) = makeprimetoideal(x,u,v,gel(gen,i));
1559 : 44905 : gel(s,i) = nfsign_arch(nf,gel(gen,i),arch);
1560 : : }
1561 : 10794 : y = mkvec5(gel(z,1), gel(z,2), gen, s, U);
1562 : 10794 : vectrunc_append(list, y);
1563 : 10794 : a = b;
1564 : : }
1565 : 12152 : return gerepilecopy(av, list);
1566 : : }
1567 : :
1568 : : /* increment y, which runs through [-d,d]^k. Return 0 when done. */
1569 : : static int
1570 : 3150 : increment(GEN y, long k, long d)
1571 : : {
1572 : 3150 : long i = 0, j;
1573 : : do
1574 : : {
1575 [ - + ]: 4417 : if (++i > k) return 0;
1576 : 4417 : y[i]++;
1577 [ + + ]: 4417 : } while (y[i] > d);
1578 [ + + ]: 4417 : for (j = 1; j < i; j++) y[j] = -d;
1579 : 3150 : return 1;
1580 : : }
1581 : :
1582 : : GEN
1583 : 1701 : archstar_full_rk(GEN x, GEN bas, GEN v, GEN gen)
1584 : : {
1585 : 1701 : long i, r, lgmat, N = lg(bas)-1, nba = nbrows(v);
1586 : 1701 : GEN lambda = cgetg(N+1, t_VECSMALL), mat = cgetg(nba+1,t_MAT);
1587 : :
1588 : 1701 : lgmat = lg(v); setlg(mat, lgmat+1);
1589 [ + + ]: 3402 : for (i = 1; i < lgmat; i++) gel(mat,i) = gel(v,i);
1590 [ + + ]: 3430 : for ( ; i <= nba; i++) gel(mat,i) = cgetg(nba+1, t_VECSMALL);
1591 : :
1592 [ + + ]: 1701 : if (x) { x = ZM_lll(x, 0.75, LLL_INPLACE); bas = RgV_RgM_mul(bas, x); }
1593 : :
1594 : 1701 : for (r=1;; r++)
1595 : : { /* reset */
1596 : 1701 : (void)vec_setconst(lambda, (GEN)0);
1597 [ + + ]: 1701 : if (!x) lambda[1] = r;
1598 [ + - ]: 3150 : while (increment(lambda, N, r))
1599 : : {
1600 : 3150 : pari_sp av1 = avma;
1601 : 3150 : GEN a = RgM_zc_mul(bas, lambda), c = gel(mat,lgmat);
1602 [ + + ]: 9982 : for (i = 1; i <= nba; i++)
1603 : : {
1604 [ + + ]: 6832 : GEN t = x? gadd(gel(a,i), gen_1): gel(a,i);
1605 : 6832 : c[i] = (gsigne(t) < 0)? 1: 0;
1606 : : }
1607 [ + + ]: 3150 : avma = av1; if (Flm_deplin(mat, 2)) continue;
1608 : :
1609 : : /* c independent of previous sign vectors */
1610 [ + + ]: 1729 : if (!x) a = zc_to_ZC(lambda);
1611 : : else
1612 : : {
1613 : 1295 : a = ZM_zc_mul(x, lambda);
1614 : 1295 : gel(a,1) = addis(gel(a,1), 1);
1615 : : }
1616 : 1729 : gel(gen,lgmat) = a;
1617 [ + + ]: 1729 : if (lgmat++ == nba) {
1618 : 1701 : mat = Flm_inv(mat,2); /* full rank */
1619 : 1701 : settyp(mat, t_VEC); return mat;
1620 : : }
1621 : 28 : setlg(mat,lgmat+1);
1622 : : }
1623 : 0 : }
1624 : : }
1625 : :
1626 : : /* x non-0 integral ideal in HNF, compute elements in 1+x (in x, if x = zk)
1627 : : * whose sign matrix is invertible. archp in 'indices' format */
1628 : : GEN
1629 : 12901 : nfarchstar(GEN nf, GEN x, GEN archp)
1630 : : {
1631 : 12901 : long nba = lg(archp) - 1;
1632 : : GEN cyc, gen, mat;
1633 : :
1634 [ + + ]: 12901 : if (!nba)
1635 : 8204 : cyc = gen = mat = cgetg(1, t_VEC);
1636 : : else
1637 : : {
1638 : 4697 : GEN xZ = gcoeff(x,1,1), gZ;
1639 : 4697 : pari_sp av = avma;
1640 [ + + ]: 4697 : if (is_pm1(xZ)) x = NULL; /* x = O_K */
1641 [ + + ]: 4697 : gZ = x? subsi(1, xZ): gen_m1; /* gZ << 0, gZ = 1 mod x */
1642 [ + + ]: 4697 : if (nba == 1)
1643 : : {
1644 : 3003 : gen = mkvec(gZ);
1645 : 3003 : mat = mkvec( mkvecsmall(1) );
1646 : : }
1647 : : else
1648 : : {
1649 : 1694 : GEN bas = nf_get_M(nf);
1650 [ + + ]: 1694 : if (lgcols(bas) > lg(archp)) bas = rowpermute(bas, archp);
1651 : 1694 : gen = cgetg(nba+1,t_VEC);
1652 : 1694 : gel(gen,1) = gZ;
1653 : 1694 : mat = archstar_full_rk(x, bas, mkmat(const_vecsmall(nba,1)), gen);
1654 : 1694 : gerepileall(av,2,&gen,&mat);
1655 : : }
1656 : 4697 : cyc = const_vec(nba, gen_2);
1657 : : }
1658 : 12901 : return mkvec3(cyc,gen,mat);
1659 : : }
1660 : :
1661 : : static GEN
1662 : 198779 : apply_U(GEN U, GEN a)
1663 : : {
1664 : : GEN e;
1665 [ + + ]: 198779 : if (typ(a) == t_INT)
1666 : 73164 : e = RgC_Rg_mul(gel(U,1), subis(a, 1));
1667 : : else
1668 : : { /* t_COL */
1669 : 125615 : GEN t = gel(a,1);
1670 : 125615 : gel(a,1) = addsi(-1, gel(a,1)); /* a -= 1 */
1671 : 125615 : e = RgM_RgC_mul(U, a);
1672 : 125615 : gel(a,1) = t; /* restore */
1673 : : }
1674 : 198779 : return e;
1675 : : }
1676 : : /* a in Z_K (t_COL or t_INT), pr prime ideal, prk = pr^k,
1677 : : * list = zprimestar(nf, pr, k, ...) */
1678 : : static GEN
1679 : 270016 : zlog_pk(GEN nf, GEN a, GEN y, GEN pr, GEN prk, GEN list, GEN *psigne)
1680 : : {
1681 : 270016 : long i,j, llist = lg(list)-1;
1682 [ + + ]: 738636 : for (j = 1; j <= llist; j++)
1683 : : {
1684 : 468627 : GEN L = gel(list,j), e;
1685 : 468627 : GEN cyc = gel(L,1), gen = gel(L,2), s = gel(L,4), U = gel(L,5);
1686 [ + + ]: 468627 : if (j == 1)
1687 : 270016 : e = mkcol( nf_log(nf, a, gel(gen,1), gel(cyc,1), pr) );
1688 : : else
1689 : 198611 : e = apply_U(U, a);
1690 : : /* here lg(e) == lg(cyc) */
1691 [ + + ]: 1442577 : for (i = 1; i < lg(cyc); i++)
1692 : : {
1693 : : GEN t;
1694 [ + + ]: 973957 : if (typ(gel(e,i)) != t_INT) pari_err_COPRIME("zlog_pk", a, pr);
1695 : 973950 : t = modii(negi(gel(e,i)), gel(cyc,i));
1696 [ + + ]: 973950 : gel(++y,0) = negi(t); if (!signe(t)) continue;
1697 : :
1698 [ + + ]: 282364 : if (mod2(t)) Flv_add_inplace(*psigne, gel(s,i), 2);
1699 [ + + ]: 282364 : if (j != llist) a = elt_mulpow_modideal(nf, a, gel(gen,i), t, prk);
1700 : : }
1701 : : }
1702 : 270009 : return y;
1703 : : }
1704 : :
1705 : : static void
1706 : 259089 : zlog_add_sign(GEN y0, GEN sgn, GEN lists)
1707 : : {
1708 : : GEN y, s;
1709 : : long i;
1710 [ - + ]: 518178 : if (!sgn) return;
1711 : 259089 : y = y0 + lg(y0);
1712 : 259089 : s = Flm_Flc_mul(gmael(lists, lg(lists)-1, 3), sgn, 2);
1713 [ + + ][ + + ]: 556482 : for (i = lg(s)-1; i > 0; i--) gel(--y,0) = s[i]? gen_1: gen_0;
1714 : : }
1715 : :
1716 : : static GEN
1717 : 98172 : famat_zlog(GEN nf, GEN fa, GEN sgn, GEN bid)
1718 : : {
1719 : 98172 : GEN g = gel(fa,1), e = gel(fa,2);
1720 : 98172 : GEN vp = gmael(bid, 3,1), ep = gmael(bid, 3,2);
1721 : 98172 : GEN arch = bid_get_arch(bid);
1722 : 98172 : GEN cyc = bid_get_cyc(bid), lists = gel(bid,4), U = gel(bid,5);
1723 : 98172 : GEN y0, x, y, EX = gel(cyc,1);
1724 : : long i, l;
1725 : :
1726 : 98172 : y0 = y = cgetg(lg(U), t_COL);
1727 [ + - ]: 98172 : if (!sgn) sgn = nfsign_arch(nf, mkmat2(g,e), arch);
1728 : 98172 : l = lg(vp);
1729 [ + + ]: 195437 : for (i=1; i < l; i++)
1730 : : {
1731 : 97265 : GEN pr = gel(vp,i), prk, ex;
1732 [ + + ]: 97265 : if (l == 2) {
1733 : 69539 : prk = bid_get_ideal(bid);
1734 : 69539 : ex = EX;
1735 : : } else { /* try to improve EX: should be group exponent mod prf, not f */
1736 : 27726 : GEN k = gel(ep,i);
1737 : 27726 : prk = idealpow(nf, pr, k);
1738 : : /* upper bound: gcd(EX, (Nv-1)p^(k-1)) = (Nv-1) p^min(k-1,v_p(EX)) */
1739 : 27726 : ex = subis(pr_norm(pr),1);
1740 [ + + ]: 27726 : if (!is_pm1(k)) {
1741 : 3619 : GEN p = pr_get_p(pr), k_1 = subis(k,1);
1742 : 3619 : long v = Z_pval(EX, p);
1743 [ - + ]: 3619 : if (cmpui(v, k_1) > 0) v = itos(k_1);
1744 [ + - ]: 3619 : if (v) ex = mulii(ex, powiu(p, v));
1745 : : }
1746 : : }
1747 : 97265 : x = famat_makecoprime(nf, g, e, pr, prk, ex);
1748 : 97265 : y = zlog_pk(nf, x, y, pr, prk, gel(lists,i), &sgn);
1749 : : }
1750 : 98172 : zlog_add_sign(y0, sgn, lists);
1751 : 98172 : return y0;
1752 : : }
1753 : :
1754 : : static GEN
1755 : 100899 : get_index(GEN lists)
1756 : : {
1757 : 100899 : long t = 0, j, k, l = lg(lists)-1;
1758 : 100899 : GEN L, ind = cgetg(l+1, t_VECSMALL);
1759 : :
1760 [ + + ]: 226890 : for (k = 1; k < l; k++)
1761 : : {
1762 : 125991 : L = gel(lists,k);
1763 : 125991 : ind[k] = t;
1764 [ + + ]: 315507 : for (j=1; j<lg(L); j++) t += lg(gmael(L,j,1)) - 1;
1765 : : }
1766 : : /* for arch. components */
1767 : 100899 : ind[k] = t; return ind;
1768 : : }
1769 : :
1770 : : static void
1771 : 100899 : init_zlog(zlog_S *S, long n, GEN P, GEN e, GEN arch, GEN lists, GEN U)
1772 : : {
1773 : 100899 : S->n = n;
1774 : 100899 : S->U = U;
1775 : 100899 : S->P = P;
1776 : 100899 : S->e = e;
1777 : 100899 : S->archp = vec01_to_indices(arch);
1778 : 100899 : S->lists = lists;
1779 : 100899 : S->ind = get_index(lists);
1780 : 100899 : }
1781 : : void
1782 : 89979 : init_zlog_bid(zlog_S *S, GEN bid)
1783 : : {
1784 : 89979 : GEN fa = gel(bid,3), lists = gel(bid,4), U = gel(bid,5);
1785 : 89979 : GEN arch = gel(bid_get_mod(bid), 2);
1786 : 89979 : init_zlog(S, lg(U)-1, gel(fa,1), gel(fa,2), arch, lists, U);
1787 : 89979 : }
1788 : :
1789 : : /* Return decomposition of a on the S->n successive generators contained in
1790 : : * S->lists. If index !=0, do the computation for the corresponding prime
1791 : : * ideal and set to 0 the other components. */
1792 : : static GEN
1793 : 146140 : zlog_ind(GEN nf, GEN a, zlog_S *S, GEN sgn, long index)
1794 : : {
1795 : 146140 : GEN y0 = zerocol(S->n), y;
1796 : 146140 : pari_sp av = avma;
1797 : : long k, kmin, kmax;
1798 : :
1799 : 146140 : a = nf_to_scalar_or_basis(nf,a);
1800 [ + + ]: 146140 : if (index)
1801 : : {
1802 : 57057 : kmin = kmax = index;
1803 : 57057 : y = y0 + S->ind[index];
1804 : : }
1805 : : else
1806 : : {
1807 : 89083 : kmin = 1; kmax = lg(S->P)-1;
1808 : 89083 : y = y0;
1809 : : }
1810 [ + + ]: 146140 : if (!sgn) sgn = nfsign_arch(nf, a, S->archp);
1811 [ + + ]: 316049 : for (k = kmin; k <= kmax; k++)
1812 : : {
1813 : 169916 : GEN list= gel(S->lists,k);
1814 : 169916 : GEN pr = gel(S->P,k);
1815 : 169916 : GEN prk = idealpow(nf, pr, gel(S->e,k));
1816 : 169916 : y = zlog_pk(nf, a, y, pr, prk, list, &sgn);
1817 : : }
1818 : 146133 : zlog_add_sign(y0, sgn, S->lists);
1819 : 146133 : return gerepilecopy(av, y0);
1820 : : }
1821 : : /* sgn = sign(a, S->arch) or NULL if unknown */
1822 : : GEN
1823 : 89083 : zlog(GEN nf, GEN a, GEN sgn, zlog_S *S) { return zlog_ind(nf, a, S, sgn, 0); }
1824 : :
1825 : : /* Log on bid.gen of generators of P_{1,I pr^{e-1}} / P_{1,I pr^e} (I,pr) = 1,
1826 : : * defined implicitly via CRT. 'index' is the index of pr in modulus
1827 : : * factorization */
1828 : : GEN
1829 : 8624 : log_gen_pr(zlog_S *S, long index, GEN nf, long e)
1830 : : {
1831 : 8624 : long i, l, yind = S->ind[index];
1832 : 8624 : GEN y, A, L, L2 = gel(S->lists,index);
1833 : :
1834 [ + + ]: 8624 : if (e == 1)
1835 : : {
1836 : 6216 : L = gel(L2,1);
1837 : 6216 : y = col_ei(S->n, yind+1);
1838 : 6216 : zlog_add_sign(y, gmael(L,4,1), S->lists);
1839 : 6216 : retmkmat( ZM_ZC_mul(S->U, y) );
1840 : : }
1841 : : else
1842 : : {
1843 : 2408 : GEN prk, g, pr = gel(S->P,index);
1844 : 2408 : long narchp = lg(S->archp)-1;
1845 : :
1846 [ + + ]: 2408 : if (e == 2)
1847 : 1456 : L = gel(L2,2);
1848 : : else
1849 : 952 : L = zidealij(idealpows(nf,pr,e-1), idealpows(nf,pr,e), NULL);
1850 : 2408 : g = gel(L,2);
1851 : 2408 : l = lg(g); A = cgetg(l, t_MAT);
1852 : 2408 : prk = idealpow(nf, pr, gel(S->e,index));
1853 [ + + ]: 5243 : for (i = 1; i < l; i++)
1854 : : {
1855 : 2835 : GEN G = gel(g,i), sgn = zero_zv(narchp); /*positive at f_oo*/
1856 : 2835 : y = zerocol(S->n);
1857 : 2835 : (void)zlog_pk(nf, G, y + yind, pr, prk, L2, &sgn);
1858 : 2835 : zlog_add_sign(y, sgn, S->lists);
1859 : 2835 : gel(A,i) = y;
1860 : : }
1861 : 8624 : return ZM_mul(S->U, A);
1862 : : }
1863 : : }
1864 : : /* Log on bid.gen of generator of P_{1,f} / P_{1,f v[index]}
1865 : : * v = vector of r1 real places */
1866 : : GEN
1867 : 5733 : log_gen_arch(zlog_S *S, long index)
1868 : : {
1869 : 5733 : GEN y = zerocol(S->n);
1870 : 5733 : zlog_add_sign(y, vecsmall_ei(lg(S->archp)-1, index), S->lists);
1871 : 5733 : return ZM_ZC_mul(S->U, y);
1872 : : }
1873 : :
1874 : : /* add [h,cyc] or [h,cyc,gen] to bid */
1875 : : static void
1876 : 12390 : add_grp(GEN nf, GEN u1, GEN cyc, GEN gen, GEN bid)
1877 : : {
1878 : 12390 : GEN h = ZV_prod(cyc);
1879 [ + + ]: 12390 : if (u1)
1880 : : {
1881 : 6251 : GEN G = mkvec3(h,cyc,NULL/*dummy, bid[2] needed below*/);
1882 : 6251 : gel(bid,2) = G;
1883 [ + + ]: 6251 : if (u1 != gen_1)
1884 : : {
1885 : 5152 : long i, c = lg(u1);
1886 : 5152 : GEN g = cgetg(c,t_VEC);
1887 [ + + ]: 16023 : for (i=1; i<c; i++)
1888 : 10871 : gel(g,i) = famat_to_nf_moddivisor(nf, gen, gel(u1,i), bid);
1889 : 5152 : gen = g;
1890 : : }
1891 : 6251 : gel(G,3) = gen; /* replace dummy */
1892 : : }
1893 : : else
1894 : 6139 : gel(bid,2) = mkvec2(h,cyc);
1895 : 12390 : }
1896 : :
1897 : : static int
1898 : 3458 : RgV_is_prV(GEN v)
1899 : : {
1900 : 3458 : long l = lg(v), i;
1901 [ + + ]: 3528 : for (i = 1; i < l; i++)
1902 [ + + ]: 3458 : if (!get_prid(gel(v,i))) return 0;
1903 : 3458 : return 1;
1904 : : }
1905 : :
1906 : : static int
1907 : 12096 : is_nf_factor(GEN F)
1908 : : {
1909 [ + + ]: 22988 : return typ(F) == t_MAT && lg(F) == 3
1910 [ + + ][ + + ]: 22988 : && RgV_is_prV(gel(F,1)) && RgV_is_ZV(gel(F,2));
[ + - ]
1911 : : }
1912 : :
1913 : : /* Compute [[ideal,arch], [h,[cyc],[gen]], idealfact, [liste], U]
1914 : : flag may include nf_GEN | nf_INIT */
1915 : : GEN
1916 : 12096 : Idealstar(GEN nf, GEN ideal, long flag)
1917 : : {
1918 : 12096 : pari_sp av = avma;
1919 : : long i, j, k, nbp, R1, nbgen;
1920 : 12096 : GEN t, y, cyc, U, u1 = NULL, fa, lists, x, arch, archp, E, P, sarch, gen;
1921 : :
1922 : 12096 : nf = checknf(nf);
1923 : 12096 : R1 = nf_get_r1(nf);
1924 [ + + ][ + + ]: 12096 : if (typ(ideal) == t_VEC && lg(ideal) == 3)
1925 : : {
1926 : 4179 : arch = gel(ideal,2);
1927 : 4179 : ideal= gel(ideal,1);
1928 [ + - - ]: 4179 : switch(typ(arch))
1929 : : {
1930 : : case t_VEC:
1931 [ - + ]: 4179 : if (lg(arch) != R1+1)
1932 : 0 : pari_err_TYPE("Idealstar [incorrect archimedean component]",arch);
1933 : 4179 : archp = vec01_to_indices(arch);
1934 : 4179 : break;
1935 : : case t_VECSMALL:
1936 : 0 : archp = arch;
1937 : 0 : arch = vec01_to_indices(archp);
1938 : 0 : break;
1939 : : default:
1940 : 0 : pari_err_TYPE("Idealstar [incorrect archimedean component]",arch);
1941 : 0 : return NULL;
1942 : : }
1943 : 4179 : }
1944 : : else
1945 : : {
1946 : 7917 : arch = zerovec(R1);
1947 : 7917 : archp = cgetg(1, t_VECSMALL);
1948 : : }
1949 [ + + ]: 12096 : if (is_nf_factor(ideal))
1950 : : {
1951 : 70 : fa = ideal;
1952 : 70 : x = idealfactorback(nf, gel(fa,1), gel(fa,2), 0);
1953 : : }
1954 : : else
1955 : : {
1956 : 12026 : fa = NULL;
1957 : 12026 : x = idealhnf_shallow(nf, ideal);
1958 : : }
1959 [ + + ]: 12096 : if (lg(x) == 1) pari_err_DOMAIN("Idealstar", "ideal","=",gen_0,x);
1960 [ + + ]: 12089 : if (typ(gcoeff(x,1,1)) != t_INT)
1961 : 7 : pari_err_DOMAIN("Idealstar","denominator(ideal)", "!=",gen_1,x);
1962 : 12082 : sarch = nfarchstar(nf, x, archp);
1963 [ + + ]: 12082 : if (!fa) fa = idealfactor(nf, ideal);
1964 : 12082 : P = gel(fa,1);
1965 : 12082 : E = gel(fa,2); nbp = lg(P)-1;
1966 [ + + ]: 12082 : if (nbp)
1967 : : {
1968 : : GEN h;
1969 : 10927 : long cp = 0;
1970 : : zlog_S S;
1971 : :
1972 : 10927 : lists = cgetg(nbp+2,t_VEC);
1973 : : /* rough upper bound */
1974 [ + + ]: 23093 : nbgen = nbp + 1; for (i=1; i<=nbp; i++) nbgen += itos(gel(E,i));
1975 : 10927 : gen = cgetg(nbgen+1,t_VEC);
1976 : 10927 : nbgen = 1;
1977 [ + + ]: 10927 : t = (nbp==1)? NULL: x;
1978 [ + + ]: 23079 : for (i=1; i<=nbp; i++)
1979 : : {
1980 : 12159 : GEN L = zprimestar(nf, gel(P,i), gel(E,i), t, archp);
1981 : 12152 : gel(lists,i) = L;
1982 [ + + ]: 35098 : for (j = 1; j < lg(L); j++) gel(gen, nbgen++) = gmael(L,j,3);
1983 : : }
1984 : 10920 : gel(lists,i) = sarch;
1985 : 10920 : gel(gen, nbgen++) = gel(sarch,2); setlg(gen, nbgen);
1986 : 10920 : gen = shallowconcat1(gen); nbgen = lg(gen)-1;
1987 : :
1988 : 10920 : h = cgetg(nbgen+1,t_MAT);
1989 : 10920 : init_zlog(&S, nbgen, P, E, archp, lists, NULL);
1990 [ + + ]: 23072 : for (i=1; i<=nbp; i++)
1991 : : {
1992 : 12152 : GEN L2 = gel(lists,i);
1993 [ + + ]: 35098 : for (j=1; j < lg(L2); j++)
1994 : : {
1995 : 22946 : GEN L = gel(L2,j), F = gel(L,1), G = gel(L,3);
1996 [ + + ]: 80003 : for (k=1; k<lg(G); k++)
1997 : : { /* log(g^f) mod divisor */
1998 : 57057 : GEN g = gel(G,k), f = gel(F,k), a = nfpowmodideal(nf,g,f,x);
1999 : 57057 : GEN sgn = mpodd(f)? nfsign_arch(nf, g, S.archp)
2000 [ + + ]: 57057 : : zero_zv(lg(S.archp)-1);
2001 : 57057 : gel(h,++cp) = ZC_neg(zlog_ind(nf, a, &S, sgn, i));
2002 : 57057 : gcoeff(h,cp,cp) = f;
2003 : : }
2004 : : }
2005 : : }
2006 [ + + ]: 15295 : for (j=1; j<lg(archp); j++)
2007 : : {
2008 : 4375 : gel(h,++cp) = zerocol(nbgen);
2009 : 4375 : gcoeff(h,cp,cp) = gen_2;
2010 : : }
2011 : : /* assert(cp == nbgen) */
2012 : 10920 : h = ZM_hnfall(h,NULL,0);
2013 [ + + ]: 10920 : cyc = ZM_snf_group(h, &U, (flag & nf_GEN)? &u1: NULL);
2014 : : }
2015 : : else
2016 : : {
2017 : 1155 : lists = mkvec(sarch);
2018 : 1155 : gen = gel(sarch,2); nbgen = lg(gen)-1;
2019 : 1155 : cyc = const_vec(nbgen, gen_2);
2020 : 1155 : U = matid(nbgen);
2021 [ + + ]: 1155 : if (flag & nf_GEN) u1 = gen_1;
2022 : : }
2023 : :
2024 : 12075 : y = cgetg(6,t_VEC);
2025 : 12075 : gel(y,1) = mkvec2(x, arch);
2026 : 12075 : gel(y,3) = fa;
2027 : 12075 : gel(y,4) = lists;
2028 : 12075 : gel(y,5) = U;
2029 : 12075 : add_grp(nf, u1, cyc, gen, y);
2030 [ + + ]: 12075 : if (!(flag & nf_INIT)) y = gel(y,2);
2031 : 12075 : return gerepilecopy(av, y);
2032 : : }
2033 : :
2034 : : /* vectors of [[cyc],[g],U.X^-1] */
2035 : : static GEN
2036 : 7 : principal_units(GEN nf, GEN pr, long e)
2037 : : {
2038 : 7 : pari_sp av = avma;
2039 : : long a;
2040 : : GEN list, y, prb, pre;
2041 : : ulong mask;
2042 : :
2043 [ - + ]: 7 : if(DEBUGLEVEL>3) err_printf("treating pr^%ld, pr = %Ps\n",e,pr);
2044 [ - + ]: 7 : if (e == 1) return cgetg(1, t_VEC);
2045 : 7 : prb = idealhnf_two(nf,pr);
2046 : 7 : pre = idealpows(nf,pr,e);
2047 : 7 : list = vectrunc_init(e);
2048 : 7 : mask = quadratic_prec_mask(e);
2049 : 7 : a = 1;
2050 [ + + ]: 35 : while (mask > 1)
2051 : : {
2052 : 28 : GEN pra = prb, z, U;
2053 : 28 : long b = a << 1;
2054 : :
2055 [ + + ]: 28 : if (mask & 1) b--;
2056 : 28 : mask >>= 1;
2057 : : /* compute 1 + pr^a / 1 + pr^b, 2a <= b */
2058 [ - + ]: 28 : if(DEBUGLEVEL>3) err_printf(" treating a = %ld, b = %ld\n",a,b);
2059 [ + + ]: 28 : prb = (b >= e)? pre: idealpows(nf,pr,b);
2060 : 28 : z = zidealij(pra, prb, &U);
2061 : 28 : y = mkvec3(gel(z,1), gel(z,2), U);
2062 : 28 : vectrunc_append(list, y);
2063 : 28 : a = b;
2064 : : }
2065 : 7 : return gerepilecopy(av, list);
2066 : : }
2067 : :
2068 : : static GEN
2069 : 42 : log_prk(GEN nf, GEN a, long nbgen, GEN list, GEN prk)
2070 : : {
2071 : 42 : GEN y = zerocol(nbgen);
2072 : 42 : long i,j, iy = 1, llist = lg(list)-1;
2073 : :
2074 [ + + ]: 210 : for (j = 1; j <= llist; j++)
2075 : : {
2076 : 168 : GEN L = gel(list,j);
2077 : 168 : GEN cyc = gel(L,1), gen = gel(L,2), U = gel(L,3);
2078 : 168 : GEN e = apply_U(U, a);
2079 : : /* here lg(e) == lg(cyc) */
2080 [ + + ]: 420 : for (i = 1; i < lg(cyc); i++)
2081 : : {
2082 : 252 : GEN t = modii(negi(gel(e,i)), gel(cyc,i));
2083 [ + + ]: 252 : gel(y, iy++) = negi(t); if (!signe(t)) continue;
2084 [ + + ]: 28 : if (j != llist) a = elt_mulpow_modideal(nf, a, gel(gen,i), t, prk);
2085 : : }
2086 : : }
2087 : 42 : return y;
2088 : : }
2089 : :
2090 : : /* multiplicative group (1 + pr) / (1 + pr^e) */
2091 : : GEN
2092 : 7 : idealprincipalunits(GEN nf, GEN pr, long e)
2093 : : {
2094 : 7 : pari_sp av = avma;
2095 : : long c, i, j, k, nbgen;
2096 : 7 : GEN cyc, u1 = NULL, pre, gen;
2097 : : GEN g, EX, h, L2;
2098 : 7 : long cp = 0;
2099 : :
2100 : 7 : nf = checknf(nf); pre = idealpows(nf, pr, e);
2101 : 7 : L2 = principal_units(nf, pr, e);
2102 : 7 : c = lg(L2); gen = cgetg(c, t_VEC);
2103 [ + + ]: 35 : for (j = 1; j < c; j++) gel(gen, j) = gmael(L2,j,2);
2104 : 7 : gen = shallowconcat1(gen); nbgen = lg(gen)-1;
2105 : :
2106 : 7 : h = cgetg(nbgen+1,t_MAT);
2107 [ + + ]: 35 : for (j=1; j < lg(L2); j++)
2108 : : {
2109 : 28 : GEN L = gel(L2,j), F = gel(L,1), G = gel(L,2);
2110 [ + + ]: 70 : for (k=1; k<lg(G); k++)
2111 : : { /* log(g^f) mod pr^e */
2112 : 42 : GEN g = gel(G,k), f = gel(F,k), a = nfpowmodideal(nf,g,f,pre);
2113 : 42 : gel(h,++cp) = ZC_neg(log_prk(nf, a, nbgen, L2, pre));
2114 : 42 : gcoeff(h,cp,cp) = f;
2115 : : }
2116 : : }
2117 : : /* assert(cp == nbgen) */
2118 : 7 : h = ZM_hnfall(h,NULL,0);
2119 : 7 : cyc = ZM_snf_group(h, NULL, &u1);
2120 : 7 : c = lg(u1); g = cgetg(c, t_VEC); EX = gel(cyc,1);
2121 [ + + ]: 28 : for (i=1; i<c; i++)
2122 : 21 : gel(g,i) = famat_to_nf_modideal_coprime(nf, gen, gel(u1,i), pre, EX);
2123 : 7 : return gerepilecopy(av, mkvec3(powiu(pr_norm(pr), e-1), cyc, g));
2124 : : }
2125 : :
2126 : : /* FIXME: obsolete */
2127 : : GEN
2128 : 0 : zidealstarinitgen(GEN nf, GEN ideal)
2129 : 0 : { return Idealstar(nf,ideal, nf_INIT|nf_GEN); }
2130 : : GEN
2131 : 4949 : zidealstarinit(GEN nf, GEN ideal)
2132 : 4949 : { return Idealstar(nf,ideal, nf_INIT); }
2133 : : GEN
2134 : 0 : zidealstar(GEN nf, GEN ideal)
2135 : 0 : { return Idealstar(nf,ideal, nf_GEN); }
2136 : :
2137 : : GEN
2138 : 70 : idealstar0(GEN nf, GEN ideal,long flag)
2139 : : {
2140 [ - + + - ]: 70 : switch(flag)
2141 : : {
2142 : 0 : case 0: return Idealstar(nf,ideal, nf_GEN);
2143 : 56 : case 1: return Idealstar(nf,ideal, nf_INIT);
2144 : 14 : case 2: return Idealstar(nf,ideal, nf_INIT|nf_GEN);
2145 : 0 : default: pari_err_FLAG("idealstar");
2146 : : }
2147 : 49 : return NULL; /* not reached */
2148 : : }
2149 : :
2150 : : void
2151 : 124282 : check_nfelt(GEN x, GEN *den)
2152 : : {
2153 : 124282 : long l = lg(x), i;
2154 : 124282 : GEN t, d = NULL;
2155 [ - + ]: 124282 : if (typ(x) != t_COL) pari_err_TYPE("check_nfelt", x);
2156 [ + + ]: 520497 : for (i=1; i<l; i++)
2157 : : {
2158 : 396215 : t = gel(x,i);
2159 [ + + - ]: 396215 : switch (typ(t))
2160 : : {
2161 : 286260 : case t_INT: break;
2162 : : case t_FRAC:
2163 [ + + ]: 109955 : if (!d) d = gel(t,2); else d = lcmii(d, gel(t,2));
2164 : 109955 : break;
2165 : 0 : default: pari_err_TYPE("check_nfelt", x);
2166 : : }
2167 : : }
2168 : 124282 : *den = d;
2169 : 124282 : }
2170 : :
2171 : : GEN
2172 : 360321 : vecmodii(GEN a, GEN b)
2173 : : {
2174 : : long i, l;
2175 : 360321 : GEN c = cgetg_copy(a, &l);
2176 [ + + ]: 1195772 : for (i = 1; i < l; i++) gel(c,i) = modii(gel(a,i), gel(b,i));
2177 : 360321 : return c;
2178 : : }
2179 : :
2180 : : /* Given x (not necessarily integral), and bid as output by zidealstarinit,
2181 : : * compute the vector of components on the generators bid[2].
2182 : : * Assume (x,bid) = 1 and sgn is either NULL or nfsign_arch(x, bid) */
2183 : : GEN
2184 : 175642 : ideallog_sgn(GEN nf, GEN x, GEN sgn, GEN bid)
2185 : : {
2186 : : pari_sp av;
2187 : : long lcyc;
2188 : : GEN den, cyc, y;
2189 : :
2190 : 175642 : nf = checknf(nf); checkbid(bid);
2191 : 175642 : cyc = bid_get_cyc(bid);
2192 [ + + ]: 175642 : lcyc = lg(cyc); if (lcyc == 1) return cgetg(1, t_COL);
2193 : 175614 : av = avma;
2194 [ + + ]: 175614 : if (typ(x) == t_MAT) {
2195 [ - + ]: 46159 : if (lg(x) == 1) return zerocol(lcyc-1); /* x = 1 */
2196 : 46159 : y = famat_zlog(nf, x, sgn, bid);
2197 : 46159 : goto END;
2198 : : }
2199 : 129455 : x = nf_to_scalar_or_basis(nf, x);
2200 [ + + + ]: 129455 : switch(typ(x))
2201 : : {
2202 : : case t_INT:
2203 : 5166 : den = NULL;
2204 : 5166 : break;
2205 : : case t_FRAC:
2206 : 7 : den = gel(x,2);
2207 : 7 : x = gel(x,1);
2208 : 7 : break;
2209 : : default: /* case t_COL: */
2210 : 124282 : check_nfelt(x, &den);
2211 [ + + ]: 124282 : if (den) x = Q_muli_to_int(x, den);
2212 : : }
2213 [ + + ]: 129455 : if (den)
2214 : : {
2215 : 52013 : x = mkmat2(mkcol2(x, den), mkcol2(gen_1, gen_m1));
2216 : 52013 : y = famat_zlog(nf, x, sgn, bid);
2217 : : }
2218 : : else
2219 : : {
2220 : 77442 : zlog_S S; init_zlog_bid(&S, bid);
2221 : 77442 : y = zlog(nf, x, sgn, &S);
2222 : : }
2223 : : END:
2224 : 175607 : y = ZM_ZC_mul(gel(bid,5), y);
2225 : 175635 : return gerepileupto(av, vecmodii(y, cyc));
2226 : : }
2227 : : GEN
2228 : 175642 : ideallog(GEN nf, GEN x, GEN bid) { return ideallog_sgn(nf, x, NULL, bid); }
2229 : :
2230 : : /*************************************************************************/
2231 : : /** **/
2232 : : /** JOIN BID STRUCTURES, IDEAL LISTS **/
2233 : : /** **/
2234 : : /*************************************************************************/
2235 : :
2236 : : /* bid1, bid2: for coprime modules m1 and m2 (without arch. part).
2237 : : * Output: bid [[m1 m2,arch],[h,[cyc],[gen]],idealfact,[liste],U] for m1 m2 */
2238 : : static GEN
2239 : 476 : join_bid(GEN nf, GEN bid1, GEN bid2)
2240 : : {
2241 : 476 : pari_sp av = avma;
2242 : : long i, nbgen, lx, lx1,lx2, l1,l2;
2243 : : GEN I1,I2, G1,G2, fa1,fa2, lists1,lists2, cyc1,cyc2;
2244 : 476 : GEN lists, fa, U, cyc, y, u1 = NULL, x, gen;
2245 : :
2246 : 476 : I1 = bid_get_ideal(bid1);
2247 : 476 : I2 = bid_get_ideal(bid2);
2248 [ + + ]: 476 : if (gequal1(gcoeff(I1,1,1))) return bid2; /* frequent trivial case */
2249 : 259 : G1 = bid_get_grp(bid1);
2250 : 259 : G2 = bid_get_grp(bid2);
2251 : 259 : fa1= gel(bid1,3);
2252 : 259 : fa2= gel(bid2,3); x = idealmul(nf, I1,I2);
2253 : 259 : fa = famat_mul_shallow(fa1, fa2);
2254 : 259 : lists1 = gel(bid1,4); lx1 = lg(lists1);
2255 : 259 : lists2 = gel(bid2,4); lx2 = lg(lists2);
2256 : : /* concat (lists1 - last elt [nfarchstar]) + lists2 */
2257 : 259 : lx = lx1+lx2-2; lists = cgetg(lx,t_VEC);
2258 [ + + ]: 539 : for (i=1; i<lx1-1; i++) gel(lists,i) = gel(lists1,i);
2259 [ + + ]: 777 : for ( ; i<lx; i++) gel(lists,i) = gel(lists2,i-lx1+2);
2260 : :
2261 : 259 : cyc1 = abgrp_get_cyc(G1); l1 = lg(cyc1);
2262 : 259 : cyc2 = abgrp_get_cyc(G2); l2 = lg(cyc2);
2263 [ + - ][ + - ]: 259 : gen = (lg(G1)>3 && lg(G2)>3)? gen_1: NULL;
2264 : 259 : nbgen = l1+l2-2;
2265 [ + - ]: 259 : cyc = ZM_snf_group(diagonal_shallow(shallowconcat(cyc1,cyc2)),
2266 : : &U, gen? &u1: NULL);
2267 [ + - ]: 259 : if (nbgen) {
2268 : 259 : GEN U1 = gel(bid1,5), U2 = gel(bid2,5);
2269 [ - + ]: 259 : U1 = l1 == 1? zeromat(nbgen,lg(U1)-1): ZM_mul(vecslice(U, 1, l1-1), U1);
2270 [ - + ]: 259 : U2 = l2 == 1? zeromat(nbgen,lg(U2)-1): ZM_mul(vecslice(U, l1, nbgen), U2);
2271 : 259 : U = shallowconcat(U1, U2);
2272 : : }
2273 : : else
2274 : 0 : U = zeromat(0, lx-2);
2275 : :
2276 [ + - ]: 259 : if (gen)
2277 : : {
2278 : 259 : GEN mu,mv, u,v = idealaddtoone_i(nf,I2,I1);
2279 : 259 : mv = zk_scalar_or_multable(nf, v);
2280 [ + + ]: 259 : if (typ(mv) == t_INT)
2281 : : {
2282 : 21 : mu = u = subui(1,mv);
2283 : 21 : v = mv;
2284 : : }
2285 : : else
2286 : : {
2287 : 238 : u = unnf_minus_x(v);
2288 : 238 : mu = RgM_Rg_add(ZM_neg(mv), gen_1); /* mult by u = 1-v */
2289 : : }
2290 : 259 : gen = shallowconcat(makeprimetoidealvec(x,u,mv, abgrp_get_gen(G1)),
2291 : : makeprimetoidealvec(x,v,mu, abgrp_get_gen(G2)));
2292 : : }
2293 : 259 : y = cgetg(6,t_VEC);
2294 : 259 : gel(y,1) = mkvec2(x, bid_get_arch(bid1));
2295 : 259 : gel(y,3) = fa;
2296 : 259 : gel(y,4) = lists;
2297 : 259 : gel(y,5) = U;
2298 : 259 : add_grp(nf, u1, cyc, gen, y);
2299 : 476 : return gerepilecopy(av,y);
2300 : : }
2301 : :
2302 : : typedef struct _ideal_data {
2303 : : GEN nf, emb, L, pr, prL, arch, sgnU;
2304 : : } ideal_data;
2305 : :
2306 : : /* z <- ( z | f(v[i])_{i=1..#v} ) */
2307 : : static void
2308 : 42840 : concat_join(GEN *pz, GEN v, GEN (*f)(ideal_data*,GEN), ideal_data *data)
2309 : : {
2310 : 42840 : long i, nz, lv = lg(v);
2311 : : GEN z, Z;
2312 [ + + ]: 61537 : if (lv == 1) return;
2313 : 18697 : z = *pz; nz = lg(z)-1;
2314 : 18697 : *pz = Z = cgetg(lv + nz, typ(z));
2315 [ + + ]: 36260 : for (i = 1; i <=nz; i++) gel(Z,i) = gel(z,i);
2316 : 18697 : Z += nz;
2317 [ + + ]: 45136 : for (i = 1; i < lv; i++) gel(Z,i) = f(data, gel(v,i));
2318 : : }
2319 : : static GEN
2320 : 476 : join_idealinit(ideal_data *D, GEN x) {
2321 : 476 : return join_bid(D->nf, x, D->prL);
2322 : : }
2323 : : static GEN
2324 : 25963 : join_ideal(ideal_data *D, GEN x) {
2325 : 25963 : return idealmulpowprime(D->nf, x, D->pr, D->L);
2326 : : }
2327 : : static GEN
2328 : 455 : join_unit(ideal_data *D, GEN x) {
2329 : 455 : return mkvec2(join_idealinit(D, gel(x,1)), vconcat(gel(x,2), D->emb));
2330 : : }
2331 : :
2332 : : /* compute matrix of zlogs of units */
2333 : : GEN
2334 : 35 : zlog_units(GEN nf, GEN U, GEN sgnU, GEN bid)
2335 : : {
2336 : 35 : long j, l = lg(U);
2337 : 35 : GEN m = cgetg(l, t_MAT);
2338 : 35 : zlog_S S; init_zlog_bid(&S, bid);
2339 [ + + ]: 98 : for (j = 1; j < l; j++)
2340 : 63 : gel(m,j) = zlog(nf, gel(U,j), vecsmallpermute(gel(sgnU,j), S.archp), &S);
2341 : 35 : return m;
2342 : : }
2343 : : /* compute matrix of zlogs of units, assuming S.archp = [] */
2344 : : GEN
2345 : 399 : zlog_units_noarch(GEN nf, GEN U, GEN bid)
2346 : : {
2347 : 399 : long j, l = lg(U);
2348 : 399 : GEN m = cgetg(l, t_MAT), empty = cgetg(1, t_COL);
2349 : 399 : zlog_S S; init_zlog_bid(&S, bid);
2350 [ + + ]: 1176 : for (j = 1; j < l; j++) gel(m,j) = zlog(nf, gel(U,j), empty, &S);
2351 : 399 : return m;
2352 : : }
2353 : :
2354 : : /* calcule la matrice des zlog des unites */
2355 : : static GEN
2356 : 28 : zlog_unitsarch(GEN sgnU, GEN bid)
2357 : : {
2358 : 28 : GEN lists = gel(bid,4), arch = gmael(bid,1,2);
2359 : 28 : GEN listslast = gel(lists,lg(lists)-1);
2360 : 28 : GEN m = rowpermute(sgnU, vec01_to_indices(arch));
2361 : 28 : return Flm_mul(gel(listslast,3), m, 2);
2362 : : }
2363 : :
2364 : : /* flag & nf_GEN : generators, otherwise no
2365 : : * flag &2 : units, otherwise no
2366 : : * flag &4 : ideals in HNF, otherwise bid */
2367 : : static GEN
2368 : 343 : Ideallist(GEN bnf, ulong bound, long flag)
2369 : : {
2370 : 343 : const long do_units = flag & 2, big_id = !(flag & 4);
2371 : 343 : const long istar_flag = (flag & nf_GEN) | nf_INIT;
2372 : 343 : pari_sp av, av0 = avma;
2373 : : long i, j, l;
2374 : 343 : GEN nf, z, p, fa, id, BOUND, U, empty = cgetg(1,t_VEC);
2375 : : forprime_t S;
2376 : : ideal_data ID;
2377 : 343 : GEN (*join_z)(ideal_data*, GEN) =
2378 : : do_units? &join_unit
2379 [ + + ][ + + ]: 343 : : (big_id? &join_idealinit: &join_ideal);
2380 : :
2381 : 343 : nf = checknf(bnf);
2382 [ - + ]: 343 : if ((long)bound <= 0) return empty;
2383 : 343 : id = matid(nf_get_degree(nf));
2384 [ + + ]: 343 : if (big_id) id = Idealstar(nf,id, istar_flag);
2385 : :
2386 : : /* z[i] will contain all "objects" of norm i. Depending on flag, this means
2387 : : * an ideal, a bid, or a couple [bid, log(units)]. Such objects are stored
2388 : : * in vectors, computed one primary component at a time; join_z
2389 : : * reconstructs the global object */
2390 : 343 : BOUND = utoipos(bound);
2391 : 343 : z = cgetg(bound+1,t_VEC);
2392 [ + + ]: 343 : if (do_units) {
2393 : 14 : U = init_units(bnf);
2394 : 14 : gel(z,1) = mkvec( mkvec2(id, zlog_units_noarch(nf, U, id)) );
2395 : : } else {
2396 : 329 : U = NULL; /* -Wall */
2397 : 329 : gel(z,1) = mkvec(id);
2398 : : }
2399 [ + + ]: 16331 : for (i=2; i<=(long)bound; i++) gel(z,i) = empty;
2400 : 343 : ID.nf = nf;
2401 : :
2402 : 343 : p = cgetipos(3);
2403 : 343 : u_forprime_init(&S, 2, bound);
2404 : 343 : av = avma;
2405 [ + + ]: 5264 : while ((p[2] = u_forprime_next(&S)))
2406 : : {
2407 [ - + ]: 4921 : if (DEBUGLEVEL>1) { err_printf("%ld ",p[2]); err_flush(); }
2408 : 4921 : fa = idealprimedec_limit_norm(nf, p, BOUND);
2409 [ + + ]: 9835 : for (j=1; j<lg(fa); j++)
2410 : : {
2411 : 4914 : GEN pr = gel(fa,j), z2;
2412 : 4914 : ulong q, Q = upowuu(p[2], pr_get_f(pr));
2413 : :
2414 : 4914 : z2 = leafcopy(z);
2415 : 4914 : q = Q;
2416 : 4914 : ID.pr = ID.prL = pr;
2417 [ + + ]: 13069 : for (l=1; Q <= bound; l++, Q *= q) /* add pr^l */
2418 : : {
2419 : : ulong iQ;
2420 : 8155 : ID.L = utoipos(l);
2421 [ + + ]: 8155 : if (big_id) {
2422 [ + + ]: 217 : if (l > 1) ID.prL = idealpow(nf,pr,ID.L);
2423 : 217 : ID.prL = Idealstar(nf,ID.prL, istar_flag);
2424 [ + + ]: 217 : if (do_units) ID.emb = zlog_units_noarch(nf, U, ID.prL);
2425 : : }
2426 [ + + ]: 50995 : for (iQ = Q,i = 1; iQ <= bound; iQ += Q,i++)
2427 : 42840 : concat_join(&gel(z,iQ), gel(z2,i), join_z, &ID);
2428 : : }
2429 : : }
2430 [ - + ]: 4921 : if (gc_needed(av,1))
2431 : : {
2432 [ # # ]: 0 : if(DEBUGMEM>1) pari_warn(warnmem,"Ideallist");
2433 : 0 : z = gerepilecopy(av, z);
2434 : : }
2435 : : }
2436 [ + + ][ + + ]: 756 : if (do_units) for (i = 1; i < lg(z); i++)
2437 : : {
2438 : 413 : GEN s = gel(z,i);
2439 : 413 : long l = lg(s);
2440 [ + + ]: 882 : for (j = 1; j < l; j++) {
2441 : 469 : GEN v = gel(s,j), bid = gel(v,1);
2442 : 469 : gel(v,2) = ZM_mul(gel(bid,5), gel(v,2));
2443 : : }
2444 : : }
2445 : 343 : return gerepilecopy(av0, z);
2446 : : }
2447 : : GEN
2448 : 28 : ideallist0(GEN bnf,long bound, long flag) {
2449 [ + - ][ - + ]: 28 : if (flag<0 || flag>4) pari_err_FLAG("ideallist");
2450 : 28 : return Ideallist(bnf,bound,flag);
2451 : : }
2452 : : GEN
2453 : 315 : ideallist(GEN bnf,long bound) { return Ideallist(bnf,bound,4); }
2454 : :
2455 : : /* bid1 = for module m1 (without arch. part), arch = archimedean part.
2456 : : * Output: bid [[m1,arch],[h,[cyc],[gen]],idealfact,[liste],U] for m1.arch */
2457 : : static GEN
2458 : 56 : join_bid_arch(GEN nf, GEN bid1, GEN arch)
2459 : : {
2460 : 56 : pari_sp av = avma;
2461 : : GEN f1, G1, fa1, U;
2462 : 56 : GEN lists, cyc, y, u1 = NULL, x, sarch, gen;
2463 : :
2464 : 56 : checkbid(bid1);
2465 : 56 : f1 = gel(bid1,1); G1 = gel(bid1,2); fa1 = gel(bid1,3);
2466 : 56 : x = gel(f1,1);
2467 : 56 : sarch = nfarchstar(nf, x, arch);
2468 : 56 : lists = leafcopy(gel(bid1,4));
2469 : 56 : gel(lists,lg(lists)-1) = sarch;
2470 : :
2471 [ + + ]: 56 : gen = (lg(G1)>3)? gen_1: NULL;
2472 : 56 : cyc = diagonal_shallow(shallowconcat(gel(G1,2), gel(sarch,1)));
2473 [ + + ]: 56 : cyc = ZM_snf_group(cyc, &U, gen? &u1: NULL);
2474 [ + + ]: 56 : if (gen) gen = shallowconcat(gel(G1,3), gel(sarch,2));
2475 : 56 : y = cgetg(6,t_VEC);
2476 : 56 : gel(y,1) = mkvec2(x, arch);
2477 : 56 : gel(y,3) = fa1;
2478 : 56 : gel(y,4) = lists;
2479 : 56 : gel(y,5) = U;
2480 : 56 : add_grp(nf, u1, cyc, gen, y);
2481 : 56 : return gerepilecopy(av,y);
2482 : : }
2483 : : static GEN
2484 : 56 : join_arch(ideal_data *D, GEN x) {
2485 : 56 : return join_bid_arch(D->nf, x, D->arch);
2486 : : }
2487 : : static GEN
2488 : 28 : join_archunit(ideal_data *D, GEN x) {
2489 : 28 : GEN bid = join_arch(D, gel(x,1)), U = gel(x,2);
2490 : 28 : U = ZM_mul(gel(bid,5), vconcat(U, zm_to_ZM(zlog_unitsarch(D->sgnU, bid))));
2491 : 28 : return mkvec2(bid, U);
2492 : : }
2493 : :
2494 : : /* L from ideallist, add archimedean part */
2495 : : GEN
2496 : 14 : ideallistarch(GEN bnf, GEN L, GEN arch)
2497 : : {
2498 : : pari_sp av;
2499 : 14 : long i, j, l = lg(L), lz;
2500 : : GEN v, z, V;
2501 : : ideal_data ID;
2502 : : GEN (*join_z)(ideal_data*, GEN);
2503 : :
2504 [ - + ]: 14 : if (typ(L) != t_VEC) pari_err_TYPE("ideallistarch",L);
2505 [ - + ]: 14 : if (l == 1) return cgetg(1,t_VEC);
2506 : 14 : z = gel(L,1);
2507 [ - + ]: 14 : if (typ(z) != t_VEC) pari_err_TYPE("ideallistarch",z);
2508 : 14 : z = gel(z,1); /* either a bid or [bid,U] */
2509 [ + + ]: 14 : if (lg(z) == 3) { /* the latter: do units */
2510 [ - + ]: 7 : if (typ(z) != t_VEC) pari_err_TYPE("ideallistarch",z);
2511 : 7 : ID.sgnU = nfsign_units(bnf, NULL, 1);
2512 : 7 : join_z = &join_archunit;
2513 : : } else
2514 : 7 : join_z = &join_arch;
2515 : 14 : ID.nf = checknf(bnf);
2516 : 14 : ID.arch = vec01_to_indices(arch);
2517 : 14 : av = avma; V = cgetg(l, t_VEC);
2518 [ + + ]: 70 : for (i = 1; i < l; i++)
2519 : : {
2520 : 56 : z = gel(L,i); lz = lg(z);
2521 : 56 : gel(V,i) = v = cgetg(lz,t_VEC);
2522 [ + + ]: 112 : for (j=1; j<lz; j++) gel(v,j) = join_z(&ID, gel(z,j));
2523 : : }
2524 : 14 : return gerepilecopy(av,V);
2525 : : }
|
