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