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; either version 2 of the License, or (at your option) any later
8 : version. It is distributed in the hope that it will be useful, but WITHOUT
9 : ANY WARRANTY WHATSOEVER.
10 :
11 : Check the License for details. You should have received a copy of it, along
12 : with the package; see the file 'COPYING'. If not, write to the Free Software
13 : Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
14 :
15 : /*******************************************************************/
16 : /* */
17 : /* BASIC NF OPERATIONS */
18 : /* */
19 : /*******************************************************************/
20 : #include "pari.h"
21 : #include "paripriv.h"
22 :
23 : #define DEBUGLEVEL DEBUGLEVEL_nf
24 :
25 : /*******************************************************************/
26 : /* */
27 : /* OPERATIONS OVER NUMBER FIELD ELEMENTS. */
28 : /* represented as column vectors over the integral basis */
29 : /* */
30 : /*******************************************************************/
31 : static GEN
32 34548918 : get_tab(GEN nf, long *N)
33 : {
34 34548918 : GEN tab = (typ(nf) == t_MAT)? nf: gel(nf,9);
35 34548918 : *N = nbrows(tab); return tab;
36 : }
37 :
38 : /* x != 0, y t_INT. Return x * y (not memory clean if x = 1) */
39 : static GEN
40 1165745246 : _mulii(GEN x, GEN y) {
41 1889511687 : return is_pm1(x)? (signe(x) < 0)? negi(y): y
42 1889357109 : : mulii(x, y);
43 : }
44 :
45 : GEN
46 18655 : tablemul_ei_ej(GEN M, long i, long j)
47 : {
48 : long N;
49 18655 : GEN tab = get_tab(M, &N);
50 18655 : tab += (i-1)*N; return gel(tab,j);
51 : }
52 :
53 : /* Outputs x.ei, where ei is the i-th elt of the algebra basis.
54 : * x an RgV of correct length and arbitrary content (polynomials, scalars...).
55 : * M is the multiplication table ei ej = sum_k M_k^(i,j) ek */
56 : GEN
57 10458 : tablemul_ei(GEN M, GEN x, long i)
58 : {
59 : long j, k, N;
60 : GEN v, tab;
61 :
62 10458 : if (i==1) return gcopy(x);
63 10458 : tab = get_tab(M, &N);
64 10458 : if (typ(x) != t_COL) { v = zerocol(N); gel(v,i) = gcopy(x); return v; }
65 10458 : tab += (i-1)*N; v = cgetg(N+1,t_COL);
66 : /* wi . x = [ sum_j tab[k,j] x[j] ]_k */
67 73024 : for (k=1; k<=N; k++)
68 : {
69 62566 : pari_sp av = avma;
70 62566 : GEN s = gen_0;
71 449568 : for (j=1; j<=N; j++)
72 : {
73 387002 : GEN c = gcoeff(tab,k,j);
74 387002 : if (!gequal0(c)) s = gadd(s, gmul(c, gel(x,j)));
75 : }
76 62566 : gel(v,k) = gerepileupto(av,s);
77 : }
78 10458 : return v;
79 : }
80 : /* as tablemul_ei, assume x a ZV of correct length */
81 : GEN
82 24988805 : zk_ei_mul(GEN nf, GEN x, long i)
83 : {
84 : long j, k, N;
85 : GEN v, tab;
86 :
87 24988805 : if (i==1) return ZC_copy(x);
88 24988791 : tab = get_tab(nf, &N); tab += (i-1)*N;
89 24988668 : v = cgetg(N+1,t_COL);
90 207831314 : for (k=1; k<=N; k++)
91 : {
92 182844551 : pari_sp av = avma;
93 182844551 : GEN s = gen_0;
94 2696140423 : for (j=1; j<=N; j++)
95 : {
96 2513603320 : GEN c = gcoeff(tab,k,j);
97 2513603320 : if (signe(c)) s = addii(s, _mulii(c, gel(x,j)));
98 : }
99 182537103 : gel(v,k) = gerepileuptoint(av, s);
100 : }
101 24986763 : return v;
102 : }
103 :
104 : /* table of multiplication by wi in R[w1,..., wN] */
105 : GEN
106 38240 : ei_multable(GEN TAB, long i)
107 : {
108 : long k,N;
109 38240 : GEN m, tab = get_tab(TAB, &N);
110 38240 : tab += (i-1)*N;
111 38240 : m = cgetg(N+1,t_MAT);
112 148250 : for (k=1; k<=N; k++) gel(m,k) = gel(tab,k);
113 38240 : return m;
114 : }
115 :
116 : GEN
117 8777571 : zk_multable(GEN nf, GEN x)
118 : {
119 8777571 : long i, l = lg(x);
120 8777571 : GEN mul = cgetg(l,t_MAT);
121 8777327 : gel(mul,1) = x; /* assume w_1 = 1 */
122 33323295 : for (i=2; i<l; i++) gel(mul,i) = zk_ei_mul(nf,x,i);
123 8775150 : return mul;
124 : }
125 : GEN
126 2177 : multable(GEN M, GEN x)
127 : {
128 : long i, N;
129 : GEN mul;
130 2177 : if (typ(x) == t_MAT) return x;
131 0 : M = get_tab(M, &N);
132 0 : if (typ(x) != t_COL) return scalarmat(x, N);
133 0 : mul = cgetg(N+1,t_MAT);
134 0 : gel(mul,1) = x; /* assume w_1 = 1 */
135 0 : for (i=2; i<=N; i++) gel(mul,i) = tablemul_ei(M,x,i);
136 0 : return mul;
137 : }
138 :
139 : /* x integral in nf; table of multiplication by x in ZK = Z[w1,..., wN].
140 : * Return a t_INT if x is scalar, and a ZM otherwise */
141 : GEN
142 4295861 : zk_scalar_or_multable(GEN nf, GEN x)
143 : {
144 4295861 : long tx = typ(x);
145 4295861 : if (tx == t_MAT || tx == t_INT) return x;
146 4189821 : x = nf_to_scalar_or_basis(nf, x);
147 4189639 : return (typ(x) == t_COL)? zk_multable(nf, x): x;
148 : }
149 :
150 : GEN
151 21403 : nftrace(GEN nf, GEN x)
152 : {
153 21403 : pari_sp av = avma;
154 21403 : nf = checknf(nf);
155 21403 : x = nf_to_scalar_or_basis(nf, x);
156 21382 : x = (typ(x) == t_COL)? RgV_dotproduct(x, gel(nf_get_Tr(nf),1))
157 21403 : : gmulgu(x, nf_get_degree(nf));
158 21405 : return gerepileupto(av, x);
159 : }
160 : GEN
161 784 : rnfelttrace(GEN rnf, GEN x)
162 : {
163 784 : pari_sp av = avma;
164 784 : checkrnf(rnf);
165 784 : x = rnfeltabstorel(rnf, x);
166 616 : x = (typ(x) == t_POLMOD)? rnfeltdown(rnf, gtrace(x))
167 693 : : gmulgu(x, rnf_get_degree(rnf));
168 693 : return gerepileupto(av, x);
169 : }
170 :
171 : /* assume nf is a genuine nf, fa a famat */
172 : static GEN
173 7 : famat_norm(GEN nf, GEN fa)
174 : {
175 7 : pari_sp av = avma;
176 7 : GEN g = gel(fa,1), e = gel(fa,2), N = gen_1;
177 7 : long i, l = lg(g);
178 21 : for (i = 1; i < l; i++)
179 14 : N = gmul(N, powgi(nfnorm(nf, gel(g,i)), gel(e,i)));
180 7 : return gerepileupto(av, N);
181 : }
182 : GEN
183 100384 : nfnorm(GEN nf, GEN x)
184 : {
185 100384 : pari_sp av = avma;
186 : GEN c, den;
187 : long n;
188 100384 : nf = checknf(nf);
189 100384 : n = nf_get_degree(nf);
190 100384 : if (typ(x) == t_MAT) return famat_norm(nf, x);
191 100377 : x = nf_to_scalar_or_basis(nf, x);
192 100377 : if (typ(x)!=t_COL)
193 12082 : return gerepileupto(av, gpowgs(x, n));
194 88295 : x = nf_to_scalar_or_alg(nf, Q_primitive_part(x, &c));
195 88295 : x = Q_remove_denom(x, &den);
196 88296 : x = ZX_resultant_all(nf_get_pol(nf), x, den, 0);
197 88296 : return gerepileupto(av, c ? gmul(x, gpowgs(c, n)): x);
198 : }
199 :
200 : static GEN
201 70 : to_RgX(GEN P, long vx)
202 : {
203 70 : return varn(P) == vx ? P: scalarpol_shallow(P, vx);
204 : }
205 :
206 : GEN
207 231 : rnfeltnorm(GEN rnf, GEN x)
208 : {
209 231 : pari_sp av = avma;
210 : GEN nf, pol;
211 231 : long v = rnf_get_varn(rnf);
212 231 : checkrnf(rnf);
213 231 : x = liftpol_shallow(rnfeltabstorel(rnf, x));
214 140 : nf = rnf_get_nf(rnf); pol = rnf_get_pol(rnf);
215 280 : x = (typ(x) == t_POL)
216 70 : ? rnfeltdown(rnf, nfX_resultant(nf,pol,to_RgX(x,v)))
217 140 : : gpowgs(x, rnf_get_degree(rnf));
218 140 : return gerepileupto(av, x);
219 : }
220 :
221 : /* x + y in nf */
222 : GEN
223 18014045 : nfadd(GEN nf, GEN x, GEN y)
224 : {
225 18014045 : pari_sp av = avma;
226 : GEN z;
227 :
228 18014045 : nf = checknf(nf);
229 18014045 : x = nf_to_scalar_or_basis(nf, x);
230 18014045 : y = nf_to_scalar_or_basis(nf, y);
231 18014045 : if (typ(x) != t_COL)
232 14545979 : { z = (typ(y) == t_COL)? RgC_Rg_add(y, x): gadd(x,y); }
233 : else
234 3468066 : { z = (typ(y) == t_COL)? RgC_add(x, y): RgC_Rg_add(x, y); }
235 18014045 : return gerepileupto(av, z);
236 : }
237 : /* x - y in nf */
238 : GEN
239 1285235 : nfsub(GEN nf, GEN x, GEN y)
240 : {
241 1285235 : pari_sp av = avma;
242 : GEN z;
243 :
244 1285235 : nf = checknf(nf);
245 1285235 : x = nf_to_scalar_or_basis(nf, x);
246 1285235 : y = nf_to_scalar_or_basis(nf, y);
247 1285235 : if (typ(x) != t_COL)
248 920178 : { z = (typ(y) == t_COL)? Rg_RgC_sub(x,y): gsub(x,y); }
249 : else
250 365057 : { z = (typ(y) == t_COL)? RgC_sub(x,y): RgC_Rg_sub(x,y); }
251 1285235 : return gerepileupto(av, z);
252 : }
253 :
254 : /* product of ZC x,y in (true) nf; ( sum_i x_i sum_j y_j m^{i,j}_k )_k */
255 : static GEN
256 4526140 : nfmuli_ZC(GEN nf, GEN x, GEN y)
257 : {
258 : long i, j, k, N;
259 4526140 : GEN TAB = get_tab(nf, &N), v = cgetg(N+1,t_COL);
260 :
261 24893948 : for (k = 1; k <= N; k++)
262 : {
263 20367872 : pari_sp av = avma;
264 20367872 : GEN s, TABi = TAB;
265 20367872 : if (k == 1)
266 4526124 : s = mulii(gel(x,1),gel(y,1));
267 : else
268 15841480 : s = addii(mulii(gel(x,1),gel(y,k)),
269 15841748 : mulii(gel(x,k),gel(y,1)));
270 160524323 : for (i=2; i<=N; i++)
271 : {
272 140163705 : GEN t, xi = gel(x,i);
273 140163705 : TABi += N;
274 140163705 : if (!signe(xi)) continue;
275 :
276 69166100 : t = NULL;
277 890181650 : for (j=2; j<=N; j++)
278 : {
279 821021944 : GEN p1, c = gcoeff(TABi, k, j); /* m^{i,j}_k */
280 821021944 : if (!signe(c)) continue;
281 237772169 : p1 = _mulii(c, gel(y,j));
282 237782940 : t = t? addii(t, p1): p1;
283 : }
284 69159706 : if (t) s = addii(s, mulii(xi, t));
285 : }
286 20360618 : gel(v,k) = gerepileuptoint(av,s);
287 : }
288 4526076 : return v;
289 : }
290 : static int
291 48433562 : is_famat(GEN x) { return typ(x) == t_MAT && lg(x) == 3; }
292 : /* product of x and y in nf */
293 : GEN
294 24522829 : nfmul(GEN nf, GEN x, GEN y)
295 : {
296 : GEN z;
297 24522829 : pari_sp av = avma;
298 :
299 24522829 : if (x == y) return nfsqr(nf,x);
300 :
301 20918718 : nf = checknf(nf);
302 20918719 : if (is_famat(x) || is_famat(y)) return famat_mul(x, y);
303 20918445 : x = nf_to_scalar_or_basis(nf, x);
304 20918444 : y = nf_to_scalar_or_basis(nf, y);
305 20918446 : if (typ(x) != t_COL)
306 : {
307 15312160 : if (isintzero(x)) return gen_0;
308 10459219 : z = (typ(y) == t_COL)? RgC_Rg_mul(y, x): gmul(x,y); }
309 : else
310 : {
311 5606286 : if (typ(y) != t_COL)
312 : {
313 3885137 : if (isintzero(y)) return gen_0;
314 1275369 : z = RgC_Rg_mul(x, y);
315 : }
316 : else
317 : {
318 : GEN dx, dy;
319 1721149 : x = Q_remove_denom(x, &dx);
320 1721150 : y = Q_remove_denom(y, &dy);
321 1721151 : z = nfmuli_ZC(nf,x,y);
322 1721150 : dx = mul_denom(dx,dy);
323 1721150 : if (dx) z = ZC_Z_div(z, dx);
324 : }
325 : }
326 13455729 : return gerepileupto(av, z);
327 : }
328 : /* square of ZC x in nf */
329 : static GEN
330 4968942 : nfsqri_ZC(GEN nf, GEN x)
331 : {
332 : long i, j, k, N;
333 4968942 : GEN TAB = get_tab(nf, &N), v = cgetg(N+1,t_COL);
334 :
335 31488047 : for (k = 1; k <= N; k++)
336 : {
337 26519208 : pari_sp av = avma;
338 26519208 : GEN s, TABi = TAB;
339 26519208 : if (k == 1)
340 4968991 : s = sqri(gel(x,1));
341 : else
342 21550217 : s = shifti(mulii(gel(x,1),gel(x,k)), 1);
343 244111742 : for (i=2; i<=N; i++)
344 : {
345 217620745 : GEN p1, c, t, xi = gel(x,i);
346 217620745 : TABi += N;
347 217620745 : if (!signe(xi)) continue;
348 :
349 72005295 : c = gcoeff(TABi, k, i);
350 72005295 : t = signe(c)? _mulii(c,xi): NULL;
351 642487730 : for (j=i+1; j<=N; j++)
352 : {
353 570484215 : c = gcoeff(TABi, k, j);
354 570484215 : if (!signe(c)) continue;
355 228957341 : p1 = _mulii(c, shifti(gel(x,j),1));
356 228966392 : t = t? addii(t, p1): p1;
357 : }
358 72003515 : if (t) s = addii(s, mulii(xi, t));
359 : }
360 26490997 : gel(v,k) = gerepileuptoint(av,s);
361 : }
362 4968839 : return v;
363 : }
364 : /* square of x in nf */
365 : GEN
366 5629448 : nfsqr(GEN nf, GEN x)
367 : {
368 5629448 : pari_sp av = avma;
369 : GEN z;
370 :
371 5629448 : nf = checknf(nf);
372 5629451 : if (is_famat(x)) return famat_sqr(x);
373 5629450 : x = nf_to_scalar_or_basis(nf, x);
374 5629449 : if (typ(x) != t_COL) z = gsqr(x);
375 : else
376 : {
377 : GEN dx;
378 239109 : x = Q_remove_denom(x, &dx);
379 239109 : z = nfsqri_ZC(nf,x);
380 239111 : if (dx) z = RgC_Rg_div(z, sqri(dx));
381 : }
382 5629450 : return gerepileupto(av, z);
383 : }
384 :
385 : /* x a ZC, v a t_COL of ZC/Z */
386 : GEN
387 203175 : zkC_multable_mul(GEN v, GEN x)
388 : {
389 203175 : long i, l = lg(v);
390 203175 : GEN y = cgetg(l, t_COL);
391 786752 : for (i = 1; i < l; i++)
392 : {
393 583577 : GEN c = gel(v,i);
394 583577 : if (typ(c)!=t_COL) {
395 0 : if (!isintzero(c)) c = ZC_Z_mul(gel(x,1), c);
396 : } else {
397 583577 : c = ZM_ZC_mul(x,c);
398 583577 : if (ZV_isscalar(c)) c = gel(c,1);
399 : }
400 583577 : gel(y,i) = c;
401 : }
402 203175 : return y;
403 : }
404 :
405 : GEN
406 46445 : nfC_multable_mul(GEN v, GEN x)
407 : {
408 46445 : long i, l = lg(v);
409 46445 : GEN y = cgetg(l, t_COL);
410 324114 : for (i = 1; i < l; i++)
411 : {
412 277669 : GEN c = gel(v,i);
413 277669 : if (typ(c)!=t_COL) {
414 230734 : if (!isintzero(c)) c = RgC_Rg_mul(gel(x,1), c);
415 : } else {
416 46935 : c = RgM_RgC_mul(x,c);
417 46935 : if (QV_isscalar(c)) c = gel(c,1);
418 : }
419 277669 : gel(y,i) = c;
420 : }
421 46445 : return y;
422 : }
423 :
424 : GEN
425 176701 : nfC_nf_mul(GEN nf, GEN v, GEN x)
426 : {
427 : long tx;
428 : GEN y;
429 :
430 176701 : x = nf_to_scalar_or_basis(nf, x);
431 176701 : tx = typ(x);
432 176701 : if (tx != t_COL)
433 : {
434 : long l, i;
435 137466 : if (tx == t_INT)
436 : {
437 128548 : long s = signe(x);
438 128548 : if (!s) return zerocol(lg(v)-1);
439 121765 : if (is_pm1(x)) return s > 0? leafcopy(v): RgC_neg(v);
440 : }
441 45780 : l = lg(v); y = cgetg(l, t_COL);
442 335664 : for (i=1; i < l; i++)
443 : {
444 289884 : GEN c = gel(v,i);
445 289884 : if (typ(c) != t_COL) c = gmul(c, x); else c = RgC_Rg_mul(c, x);
446 289884 : gel(y,i) = c;
447 : }
448 45780 : return y;
449 : }
450 : else
451 : {
452 : GEN dx;
453 39235 : x = zk_multable(nf, Q_remove_denom(x,&dx));
454 39235 : y = nfC_multable_mul(v, x);
455 39235 : return dx? RgC_Rg_div(y, dx): y;
456 : }
457 : }
458 : static GEN
459 9660 : mulbytab(GEN M, GEN c)
460 9660 : { return typ(c) == t_COL? RgM_RgC_mul(M,c): RgC_Rg_mul(gel(M,1), c); }
461 : GEN
462 2177 : tablemulvec(GEN M, GEN x, GEN v)
463 : {
464 : long l, i;
465 : GEN y;
466 :
467 2177 : if (typ(x) == t_COL && RgV_isscalar(x))
468 : {
469 0 : x = gel(x,1);
470 0 : return typ(v) == t_POL? RgX_Rg_mul(v,x): RgV_Rg_mul(v,x);
471 : }
472 2177 : x = multable(M, x); /* multiplication table by x */
473 2177 : y = cgetg_copy(v, &l);
474 2177 : if (typ(v) == t_POL)
475 : {
476 2177 : y[1] = v[1];
477 11837 : for (i=2; i < l; i++) gel(y,i) = mulbytab(x, gel(v,i));
478 2177 : y = normalizepol(y);
479 : }
480 : else
481 : {
482 0 : for (i=1; i < l; i++) gel(y,i) = mulbytab(x, gel(v,i));
483 : }
484 2177 : return y;
485 : }
486 :
487 : GEN
488 640057 : zkmultable_capZ(GEN mx) { return Q_denom(zkmultable_inv(mx)); }
489 : GEN
490 791591 : zkmultable_inv(GEN mx) { return ZM_gauss(mx, col_ei(lg(mx)-1,1)); }
491 : /* nf a true nf, x a ZC */
492 : GEN
493 151538 : zk_inv(GEN nf, GEN x) { return zkmultable_inv(zk_multable(nf,x)); }
494 :
495 : /* inverse of x in nf */
496 : GEN
497 74102 : nfinv(GEN nf, GEN x)
498 : {
499 74102 : pari_sp av = avma;
500 : GEN z;
501 :
502 74102 : nf = checknf(nf);
503 74102 : if (is_famat(x)) return famat_inv(x);
504 74102 : x = nf_to_scalar_or_basis(nf, x);
505 74102 : if (typ(x) == t_COL)
506 : {
507 : GEN d;
508 30058 : x = Q_remove_denom(x, &d);
509 30058 : z = zk_inv(nf, x);
510 30058 : if (d) z = RgC_Rg_mul(z, d);
511 : }
512 : else
513 44044 : z = ginv(x);
514 74102 : return gerepileupto(av, z);
515 : }
516 :
517 : /* quotient of x and y in nf */
518 : GEN
519 32736 : nfdiv(GEN nf, GEN x, GEN y)
520 : {
521 32736 : pari_sp av = avma;
522 : GEN z;
523 :
524 32736 : nf = checknf(nf);
525 32736 : if (is_famat(x) || is_famat(y)) return famat_div(x,y);
526 32645 : y = nf_to_scalar_or_basis(nf, y);
527 32645 : if (typ(y) != t_COL)
528 : {
529 20461 : x = nf_to_scalar_or_basis(nf, x);
530 20461 : z = (typ(x) == t_COL)? RgC_Rg_div(x, y): gdiv(x,y);
531 : }
532 : else
533 : {
534 : GEN d;
535 12184 : y = Q_remove_denom(y, &d);
536 12184 : z = nfmul(nf, x, zk_inv(nf,y));
537 12184 : if (d) z = typ(z) == t_COL? RgC_Rg_mul(z, d): gmul(z, d);
538 : }
539 32645 : return gerepileupto(av, z);
540 : }
541 :
542 : /* product of INTEGERS (t_INT or ZC) x and y in (true) nf */
543 : GEN
544 4125004 : nfmuli(GEN nf, GEN x, GEN y)
545 : {
546 4125004 : if (typ(x) == t_INT) return (typ(y) == t_COL)? ZC_Z_mul(y, x): mulii(x,y);
547 3021574 : if (typ(y) == t_INT) return ZC_Z_mul(x, y);
548 2804954 : return nfmuli_ZC(nf, x, y);
549 : }
550 : GEN
551 4729791 : nfsqri(GEN nf, GEN x)
552 4729791 : { return (typ(x) == t_INT)? sqri(x): nfsqri_ZC(nf, x); }
553 :
554 : /* both x and y are RgV */
555 : GEN
556 0 : tablemul(GEN TAB, GEN x, GEN y)
557 : {
558 : long i, j, k, N;
559 : GEN s, v;
560 0 : if (typ(x) != t_COL) return gmul(x, y);
561 0 : if (typ(y) != t_COL) return gmul(y, x);
562 0 : N = lg(x)-1;
563 0 : v = cgetg(N+1,t_COL);
564 0 : for (k=1; k<=N; k++)
565 : {
566 0 : pari_sp av = avma;
567 0 : GEN TABi = TAB;
568 0 : if (k == 1)
569 0 : s = gmul(gel(x,1),gel(y,1));
570 : else
571 0 : s = gadd(gmul(gel(x,1),gel(y,k)),
572 0 : gmul(gel(x,k),gel(y,1)));
573 0 : for (i=2; i<=N; i++)
574 : {
575 0 : GEN t, xi = gel(x,i);
576 0 : TABi += N;
577 0 : if (gequal0(xi)) continue;
578 :
579 0 : t = NULL;
580 0 : for (j=2; j<=N; j++)
581 : {
582 0 : GEN p1, c = gcoeff(TABi, k, j); /* m^{i,j}_k */
583 0 : if (gequal0(c)) continue;
584 0 : p1 = gmul(c, gel(y,j));
585 0 : t = t? gadd(t, p1): p1;
586 : }
587 0 : if (t) s = gadd(s, gmul(xi, t));
588 : }
589 0 : gel(v,k) = gerepileupto(av,s);
590 : }
591 0 : return v;
592 : }
593 : GEN
594 44653 : tablesqr(GEN TAB, GEN x)
595 : {
596 : long i, j, k, N;
597 : GEN s, v;
598 :
599 44653 : if (typ(x) != t_COL) return gsqr(x);
600 44653 : N = lg(x)-1;
601 44653 : v = cgetg(N+1,t_COL);
602 :
603 320663 : for (k=1; k<=N; k++)
604 : {
605 276010 : pari_sp av = avma;
606 276010 : GEN TABi = TAB;
607 276010 : if (k == 1)
608 44653 : s = gsqr(gel(x,1));
609 : else
610 231357 : s = gmul2n(gmul(gel(x,1),gel(x,k)), 1);
611 1771784 : for (i=2; i<=N; i++)
612 : {
613 1495774 : GEN p1, c, t, xi = gel(x,i);
614 1495774 : TABi += N;
615 1495774 : if (gequal0(xi)) continue;
616 :
617 384587 : c = gcoeff(TABi, k, i);
618 384587 : t = !gequal0(c)? gmul(c,xi): NULL;
619 1551557 : for (j=i+1; j<=N; j++)
620 : {
621 1166970 : c = gcoeff(TABi, k, j);
622 1166970 : if (gequal0(c)) continue;
623 597730 : p1 = gmul(gmul2n(c,1), gel(x,j));
624 597730 : t = t? gadd(t, p1): p1;
625 : }
626 384587 : if (t) s = gadd(s, gmul(xi, t));
627 : }
628 276010 : gel(v,k) = gerepileupto(av,s);
629 : }
630 44653 : return v;
631 : }
632 :
633 : static GEN
634 201667 : _mul(void *data, GEN x, GEN y) { return nfmuli((GEN)data,x,y); }
635 : static GEN
636 721686 : _sqr(void *data, GEN x) { return nfsqri((GEN)data,x); }
637 :
638 : /* Compute z^n in nf, left-shift binary powering */
639 : GEN
640 812460 : nfpow(GEN nf, GEN z, GEN n)
641 : {
642 812460 : pari_sp av = avma;
643 : long s;
644 : GEN x, cx;
645 :
646 812460 : if (typ(n)!=t_INT) pari_err_TYPE("nfpow",n);
647 812460 : nf = checknf(nf);
648 812458 : s = signe(n); if (!s) return gen_1;
649 812458 : if (is_famat(z)) return famat_pow(z, n);
650 752160 : x = nf_to_scalar_or_basis(nf, z);
651 752161 : if (typ(x) != t_COL) return powgi(x,n);
652 635634 : if (s < 0)
653 : { /* simplified nfinv */
654 : GEN d;
655 41217 : x = Q_remove_denom(x, &d);
656 41217 : x = zk_inv(nf, x);
657 41217 : x = primitive_part(x, &cx);
658 41217 : cx = mul_content(cx, d);
659 41217 : n = negi(n);
660 : }
661 : else
662 594417 : x = primitive_part(x, &cx);
663 635625 : x = gen_pow_i(x, n, (void*)nf, _sqr, _mul);
664 635630 : if (cx)
665 46234 : x = gerepileupto(av, gmul(x, powgi(cx, n)));
666 : else
667 589396 : x = gerepilecopy(av, x);
668 635640 : return x;
669 : }
670 : /* Compute z^n in nf, left-shift binary powering */
671 : GEN
672 214844 : nfpow_u(GEN nf, GEN z, ulong n)
673 : {
674 214844 : pari_sp av = avma;
675 : GEN x, cx;
676 :
677 214844 : if (!n) return gen_1;
678 214844 : x = nf_to_scalar_or_basis(nf, z);
679 214844 : if (typ(x) != t_COL) return gpowgs(x,n);
680 178946 : x = primitive_part(x, &cx);
681 178946 : x = gen_powu_i(x, n, (void*)nf, _sqr, _mul);
682 178947 : if (cx)
683 : {
684 27501 : x = gmul(x, powgi(cx, utoipos(n)));
685 27501 : return gerepileupto(av,x);
686 : }
687 151446 : return gerepilecopy(av, x);
688 : }
689 :
690 : long
691 56 : nfissquare(GEN nf, GEN z, GEN *px)
692 : {
693 56 : pari_sp av = avma;
694 56 : long v = fetch_var_higher();
695 : GEN R;
696 56 : nf = checknf(nf);
697 56 : if (nf_get_degree(nf) == 1)
698 : {
699 21 : z = algtobasis(nf, z);
700 21 : if (!issquareall(gel(z,1), px)) return gc_long(av, 0);
701 14 : if (px) *px = gerepileupto(av, *px); else set_avma(av);
702 14 : return 1;
703 : }
704 35 : z = nf_to_scalar_or_alg(nf, z);
705 35 : R = nfroots(nf, deg2pol_shallow(gen_m1, gen_0, z, v));
706 35 : delete_var(); if (lg(R) == 1) return gc_long(av, 0);
707 28 : if (px) *px = gerepilecopy(av, nf_to_scalar_or_basis(nf, gel(R,1)));
708 14 : else set_avma(av);
709 28 : return 1;
710 : }
711 :
712 : long
713 6411 : nfispower(GEN nf, GEN z, long n, GEN *px)
714 : {
715 6411 : pari_sp av = avma;
716 6411 : long v = fetch_var_higher();
717 : GEN R;
718 6411 : nf = checknf(nf);
719 6411 : if (nf_get_degree(nf) == 1)
720 : {
721 329 : z = algtobasis(nf, z);
722 329 : if (!ispower(gel(z,1), stoi(n), px)) return gc_long(av, 0);
723 147 : if (px) *px = gerepileupto(av, *px); else set_avma(av);
724 147 : return 1;
725 : }
726 6082 : if (n <= 0)
727 0 : pari_err_DOMAIN("nfeltispower","exponent","<=",gen_0,stoi(n));
728 6082 : z = nf_to_scalar_or_alg(nf, z);
729 6082 : if (n==1)
730 : {
731 0 : if (px) *px = gerepilecopy(av, z);
732 0 : return 1;
733 : }
734 6082 : R = nfroots(nf, gsub(pol_xn(n, v), z));
735 6082 : delete_var(); if (lg(R) == 1) return gc_long(av, 0);
736 1428 : if (px) *px = gerepilecopy(av, nf_to_scalar_or_basis(nf, gel(R,1)));
737 1414 : else set_avma(av);
738 1428 : return 1;
739 : }
740 :
741 : static GEN
742 49 : idmulred(void *nf, GEN x, GEN y) { return idealmulred((GEN) nf, x, y); }
743 : static GEN
744 406 : idpowred(void *nf, GEN x, GEN n) { return idealpowred((GEN) nf, x, n); }
745 : static GEN
746 227216 : idmul(void *nf, GEN x, GEN y) { return idealmul((GEN) nf, x, y); }
747 : static GEN
748 262418 : idpow(void *nf, GEN x, GEN n) { return idealpow((GEN) nf, x, n); }
749 : GEN
750 84657 : idealfactorback(GEN nf, GEN L, GEN e, int red)
751 : {
752 84657 : nf = checknf(nf);
753 84657 : if (red) return gen_factorback(L, e, (void*)nf, &idmulred, &idpowred, NULL);
754 84300 : else return gen_factorback(L, e, (void*)nf, &idmul, &idpow, NULL);
755 : }
756 : static GEN
757 299888 : eltmul(void *nf, GEN x, GEN y) { return nfmul((GEN) nf, x, y); }
758 : static GEN
759 436357 : eltpow(void *nf, GEN x, GEN n) { return nfpow((GEN) nf, x, n); }
760 : GEN
761 264218 : nffactorback(GEN nf, GEN L, GEN e)
762 264218 : { return gen_factorback(L, e, (void*)checknf(nf), &eltmul, &eltpow, NULL); }
763 :
764 : static GEN
765 2753863 : _nf_red(void *E, GEN x) { (void)E; return gcopy(x); }
766 :
767 : static GEN
768 11567717 : _nf_add(void *E, GEN x, GEN y) { return nfadd((GEN)E,x,y); }
769 :
770 : static GEN
771 674751 : _nf_neg(void *E, GEN x) { (void)E; return gneg(x); }
772 :
773 : static GEN
774 13834975 : _nf_mul(void *E, GEN x, GEN y) { return nfmul((GEN)E,x,y); }
775 :
776 : static GEN
777 45129 : _nf_inv(void *E, GEN x) { return nfinv((GEN)E,x); }
778 :
779 : static GEN
780 8862 : _nf_s(void *E, long x) { (void)E; return stoi(x); }
781 :
782 : static const struct bb_field nf_field={_nf_red,_nf_add,_nf_mul,_nf_neg,
783 : _nf_inv,&gequal0,_nf_s };
784 :
785 197512 : const struct bb_field *get_nf_field(void **E, GEN nf)
786 197512 : { *E = (void*)nf; return &nf_field; }
787 :
788 : GEN
789 14 : nfM_det(GEN nf, GEN M)
790 : {
791 : void *E;
792 14 : const struct bb_field *S = get_nf_field(&E, nf);
793 14 : return gen_det(M, E, S);
794 : }
795 : GEN
796 8848 : nfM_inv(GEN nf, GEN M)
797 : {
798 : void *E;
799 8848 : const struct bb_field *S = get_nf_field(&E, nf);
800 8848 : return gen_Gauss(M, matid(lg(M)-1), E, S);
801 : }
802 :
803 : GEN
804 0 : nfM_ker(GEN nf, GEN M)
805 : {
806 : void *E;
807 0 : const struct bb_field *S = get_nf_field(&E, nf);
808 0 : return gen_ker(M, 0, E, S);
809 : }
810 :
811 : GEN
812 8582 : nfM_mul(GEN nf, GEN A, GEN B)
813 : {
814 : void *E;
815 8582 : const struct bb_field *S = get_nf_field(&E, nf);
816 8582 : return gen_matmul(A, B, E, S);
817 : }
818 : GEN
819 180068 : nfM_nfC_mul(GEN nf, GEN A, GEN B)
820 : {
821 : void *E;
822 180068 : const struct bb_field *S = get_nf_field(&E, nf);
823 180068 : return gen_matcolmul(A, B, E, S);
824 : }
825 :
826 : /* valuation of integral x (ZV), with resp. to prime ideal pr */
827 : long
828 35921292 : ZC_nfvalrem(GEN x, GEN pr, GEN *newx)
829 : {
830 35921292 : pari_sp av = avma;
831 : long i, v, l;
832 35921292 : GEN r, y, p = pr_get_p(pr), mul = pr_get_tau(pr);
833 :
834 : /* p inert */
835 35921543 : if (typ(mul) == t_INT) return newx? ZV_pvalrem(x, p, newx):ZV_pval(x, p);
836 35549633 : y = cgetg_copy(x, &l); /* will hold the new x */
837 35549681 : x = leafcopy(x);
838 35548126 : for(v=0;; v++)
839 : {
840 168441209 : for (i=1; i<l; i++)
841 : { /* is (x.b)[i] divisible by p ? */
842 153245366 : gel(y,i) = dvmdii(ZMrow_ZC_mul(mul,x,i),p,&r);
843 153246908 : if (r != gen_0) { if (newx) *newx = x; return v; }
844 : }
845 15195843 : swap(x, y);
846 15195843 : if (!newx && (v & 0xf) == 0xf) v += pr_get_e(pr) * ZV_pvalrem(x, p, &x);
847 15195843 : if (gc_needed(av,1))
848 : {
849 0 : if(DEBUGMEM>1) pari_warn(warnmem,"ZC_nfvalrem, v >= %ld", v);
850 0 : gerepileall(av, 2, &x, &y);
851 : }
852 : }
853 : }
854 : long
855 32380082 : ZC_nfval(GEN x, GEN P)
856 32380082 : { return ZC_nfvalrem(x, P, NULL); }
857 :
858 : /* v_P(x) != 0, x a ZV. Simpler version of ZC_nfvalrem */
859 : int
860 1240939 : ZC_prdvd(GEN x, GEN P)
861 : {
862 1240939 : pari_sp av = avma;
863 : long i, l;
864 1240939 : GEN p = pr_get_p(P), mul = pr_get_tau(P);
865 1241031 : if (typ(mul) == t_INT) return ZV_Z_dvd(x, p);
866 1240688 : l = lg(x);
867 5027680 : for (i=1; i<l; i++)
868 4515664 : if (!dvdii(ZMrow_ZC_mul(mul,x,i), p)) return gc_bool(av,0);
869 512016 : return gc_bool(av,1);
870 : }
871 :
872 : int
873 266 : pr_equal(GEN P, GEN Q)
874 : {
875 266 : GEN gQ, p = pr_get_p(P);
876 266 : long e = pr_get_e(P), f = pr_get_f(P), n;
877 266 : if (!equalii(p, pr_get_p(Q)) || e != pr_get_e(Q) || f != pr_get_f(Q))
878 245 : return 0;
879 21 : gQ = pr_get_gen(Q); n = lg(gQ)-1;
880 21 : if (2*e*f > n) return 1; /* room for only one such pr */
881 14 : return ZV_equal(pr_get_gen(P), gQ) || ZC_prdvd(gQ, P);
882 : }
883 :
884 : GEN
885 420140 : famat_nfvalrem(GEN nf, GEN x, GEN pr, GEN *py)
886 : {
887 420140 : pari_sp av = avma;
888 420140 : GEN P = gel(x,1), E = gel(x,2), V = gen_0, y = NULL;
889 420140 : long l = lg(P), simplify = 0, i;
890 420140 : if (py) { *py = gen_1; y = cgetg(l, t_COL); }
891 :
892 2353128 : for (i = 1; i < l; i++)
893 : {
894 1932988 : GEN e = gel(E,i);
895 : long v;
896 1932988 : if (!signe(e))
897 : {
898 7 : if (py) gel(y,i) = gen_1;
899 7 : simplify = 1; continue;
900 : }
901 1932981 : v = nfvalrem(nf, gel(P,i), pr, py? &gel(y,i): NULL);
902 1932981 : if (v == LONG_MAX) { set_avma(av); if (py) *py = gen_0; return mkoo(); }
903 1932981 : V = addmulii(V, stoi(v), e);
904 : }
905 420140 : if (!py) V = gerepileuptoint(av, V);
906 : else
907 : {
908 42 : y = mkmat2(y, gel(x,2));
909 42 : if (simplify) y = famat_remove_trivial(y);
910 42 : gerepileall(av, 2, &V, &y); *py = y;
911 : }
912 420140 : return V;
913 : }
914 : long
915 3349644 : nfval(GEN nf, GEN x, GEN pr)
916 : {
917 3349644 : pari_sp av = avma;
918 : long w, e;
919 : GEN cx, p;
920 :
921 3349644 : if (gequal0(x)) return LONG_MAX;
922 3347887 : nf = checknf(nf);
923 3347891 : checkprid(pr);
924 3347889 : p = pr_get_p(pr);
925 3347882 : e = pr_get_e(pr);
926 3347884 : x = nf_to_scalar_or_basis(nf, x);
927 3347831 : if (typ(x) != t_COL) return e*Q_pval(x,p);
928 1540457 : x = Q_primitive_part(x, &cx);
929 1540508 : w = ZC_nfval(x,pr);
930 1540408 : if (cx) w += e*Q_pval(cx,p);
931 1540422 : return gc_long(av,w);
932 : }
933 :
934 : /* want to write p^v = uniformizer^(e*v) * z^v, z coprime to pr */
935 : /* z := tau^e / p^(e-1), algebraic integer coprime to pr; return z^v */
936 : static GEN
937 939368 : powp(GEN nf, GEN pr, long v)
938 : {
939 : GEN b, z;
940 : long e;
941 939368 : if (!v) return gen_1;
942 412381 : b = pr_get_tau(pr);
943 412381 : if (typ(b) == t_INT) return gen_1;
944 115119 : e = pr_get_e(pr);
945 115119 : z = gel(b,1);
946 115119 : if (e != 1) z = gdiv(nfpow_u(nf, z, e), powiu(pr_get_p(pr),e-1));
947 115119 : if (v < 0) { v = -v; z = nfinv(nf, z); }
948 115119 : if (v != 1) z = nfpow_u(nf, z, v);
949 115119 : return z;
950 : }
951 : long
952 3717881 : nfvalrem(GEN nf, GEN x, GEN pr, GEN *py)
953 : {
954 3717881 : pari_sp av = avma;
955 : long w, e;
956 : GEN cx, p, t;
957 :
958 3717881 : if (!py) return nfval(nf,x,pr);
959 1771762 : if (gequal0(x)) { *py = gen_0; return LONG_MAX; }
960 1771704 : nf = checknf(nf);
961 1771704 : checkprid(pr);
962 1771704 : p = pr_get_p(pr);
963 1771703 : e = pr_get_e(pr);
964 1771703 : x = nf_to_scalar_or_basis(nf, x);
965 1771703 : if (typ(x) != t_COL) {
966 525973 : w = Q_pvalrem(x,p, py);
967 525973 : if (!w) { *py = gerepilecopy(av, x); return 0; }
968 320852 : *py = gerepileupto(av, gmul(powp(nf, pr, w), *py));
969 320852 : return e*w;
970 : }
971 1245730 : x = Q_primitive_part(x, &cx);
972 1245732 : w = ZC_nfvalrem(x,pr, py);
973 1245706 : if (cx)
974 : {
975 618516 : long v = Q_pvalrem(cx,p, &t);
976 618516 : *py = nfmul(nf, *py, gmul(powp(nf,pr,v), t));
977 618516 : *py = gerepileupto(av, *py);
978 618515 : w += e*v;
979 : }
980 : else
981 627190 : *py = gerepilecopy(av, *py);
982 1245732 : return w;
983 : }
984 : GEN
985 14952 : gpnfvalrem(GEN nf, GEN x, GEN pr, GEN *py)
986 : {
987 : long v;
988 14952 : if (is_famat(x)) return famat_nfvalrem(nf, x, pr, py);
989 14945 : v = nfvalrem(nf,x,pr,py);
990 14945 : return v == LONG_MAX? mkoo(): stoi(v);
991 : }
992 :
993 : /* true nf */
994 : GEN
995 99113 : coltoalg(GEN nf, GEN x)
996 : {
997 99113 : return mkpolmod( nf_to_scalar_or_alg(nf, x), nf_get_pol(nf) );
998 : }
999 :
1000 : GEN
1001 148001 : basistoalg(GEN nf, GEN x)
1002 : {
1003 : GEN T;
1004 :
1005 148001 : nf = checknf(nf);
1006 148001 : switch(typ(x))
1007 : {
1008 92974 : case t_COL: {
1009 92974 : pari_sp av = avma;
1010 92974 : return gerepilecopy(av, coltoalg(nf, x));
1011 : }
1012 32039 : case t_POLMOD:
1013 32039 : T = nf_get_pol(nf);
1014 32039 : if (!RgX_equal_var(T,gel(x,1)))
1015 0 : pari_err_MODULUS("basistoalg", T,gel(x,1));
1016 32039 : return gcopy(x);
1017 1862 : case t_POL:
1018 1862 : T = nf_get_pol(nf);
1019 1862 : if (varn(T) != varn(x)) pari_err_VAR("basistoalg",x,T);
1020 1862 : retmkpolmod(RgX_rem(x, T), ZX_copy(T));
1021 21126 : case t_INT:
1022 : case t_FRAC:
1023 21126 : T = nf_get_pol(nf);
1024 21126 : retmkpolmod(gcopy(x), ZX_copy(T));
1025 0 : default:
1026 0 : pari_err_TYPE("basistoalg",x);
1027 : return NULL; /* LCOV_EXCL_LINE */
1028 : }
1029 : }
1030 :
1031 : /* true nf, x a t_POL */
1032 : static GEN
1033 4215359 : pol_to_scalar_or_basis(GEN nf, GEN x)
1034 : {
1035 4215359 : GEN T = nf_get_pol(nf);
1036 4215350 : long l = lg(x);
1037 4215350 : if (varn(x) != varn(T)) pari_err_VAR("nf_to_scalar_or_basis", x,T);
1038 4215288 : if (l >= lg(T)) { x = RgX_rem(x, T); l = lg(x); }
1039 4215288 : if (l == 2) return gen_0;
1040 3186260 : if (l == 3)
1041 : {
1042 786450 : x = gel(x,2);
1043 786450 : if (!is_rational_t(typ(x))) pari_err_TYPE("nf_to_scalar_or_basis",x);
1044 786443 : return x;
1045 : }
1046 2399810 : return poltobasis(nf,x);
1047 : }
1048 : /* Assume nf is a genuine nf. */
1049 : GEN
1050 113666302 : nf_to_scalar_or_basis(GEN nf, GEN x)
1051 : {
1052 113666302 : switch(typ(x))
1053 : {
1054 76011561 : case t_INT: case t_FRAC:
1055 76011561 : return x;
1056 219111 : case t_POLMOD:
1057 219111 : x = checknfelt_mod(nf,x,"nf_to_scalar_or_basis");
1058 219050 : switch(typ(x))
1059 : {
1060 36001 : case t_INT: case t_FRAC: return x;
1061 183049 : case t_POL: return pol_to_scalar_or_basis(nf,x);
1062 : }
1063 0 : break;
1064 4032319 : case t_POL: return pol_to_scalar_or_basis(nf,x);
1065 33406722 : case t_COL:
1066 33406722 : if (lg(x)-1 != nf_get_degree(nf)) break;
1067 33406598 : return QV_isscalar(x)? gel(x,1): x;
1068 : }
1069 54 : pari_err_TYPE("nf_to_scalar_or_basis",x);
1070 : return NULL; /* LCOV_EXCL_LINE */
1071 : }
1072 : /* Let x be a polynomial with coefficients in Q or nf. Return the same
1073 : * polynomial with coefficients expressed as vectors (on the integral basis).
1074 : * No consistency checks, not memory-clean. */
1075 : GEN
1076 24024 : RgX_to_nfX(GEN nf, GEN x)
1077 : {
1078 : long i, l;
1079 24024 : GEN y = cgetg_copy(x, &l); y[1] = x[1];
1080 204463 : for (i=2; i<l; i++) gel(y,i) = nf_to_scalar_or_basis(nf, gel(x,i));
1081 24024 : return y;
1082 : }
1083 :
1084 : /* Assume nf is a genuine nf. */
1085 : GEN
1086 3001895 : nf_to_scalar_or_alg(GEN nf, GEN x)
1087 : {
1088 3001895 : switch(typ(x))
1089 : {
1090 100771 : case t_INT: case t_FRAC:
1091 100771 : return x;
1092 0 : case t_POLMOD:
1093 0 : x = checknfelt_mod(nf,x,"nf_to_scalar_or_alg");
1094 0 : if (typ(x) != t_POL) return x;
1095 : /* fall through */
1096 : case t_POL:
1097 : {
1098 4620 : GEN T = nf_get_pol(nf);
1099 4620 : long l = lg(x);
1100 4620 : if (varn(x) != varn(T)) pari_err_VAR("nf_to_scalar_or_alg", x,T);
1101 4620 : if (l >= lg(T)) { x = RgX_rem(x, T); l = lg(x); }
1102 4620 : if (l == 2) return gen_0;
1103 4620 : if (l == 3) return gel(x,2);
1104 3150 : return x;
1105 : }
1106 2896458 : case t_COL:
1107 : {
1108 : GEN dx;
1109 2896458 : if (lg(x)-1 != nf_get_degree(nf)) break;
1110 5741419 : if (QV_isscalar(x)) return gel(x,1);
1111 2844883 : x = Q_remove_denom(x, &dx);
1112 2844886 : x = RgV_RgC_mul(nf_get_zkprimpart(nf), x);
1113 2844967 : dx = mul_denom(dx, nf_get_zkden(nf));
1114 2844949 : return gdiv(x,dx);
1115 : }
1116 : }
1117 46 : pari_err_TYPE("nf_to_scalar_or_alg",x);
1118 : return NULL; /* LCOV_EXCL_LINE */
1119 : }
1120 :
1121 : /* gmul(A, RgX_to_RgC(x)), A t_MAT of compatible dimensions */
1122 : GEN
1123 1337 : RgM_RgX_mul(GEN A, GEN x)
1124 : {
1125 1337 : long i, l = lg(x)-1;
1126 : GEN z;
1127 1337 : if (l == 1) return zerocol(nbrows(A));
1128 1337 : z = gmul(gel(x,2), gel(A,1));
1129 2541 : for (i = 2; i < l; i++)
1130 1204 : if (!gequal0(gel(x,i+1))) z = gadd(z, gmul(gel(x,i+1), gel(A,i)));
1131 1337 : return z;
1132 : }
1133 : GEN
1134 8209644 : ZM_ZX_mul(GEN A, GEN x)
1135 : {
1136 8209644 : long i, l = lg(x)-1;
1137 : GEN z;
1138 8209644 : if (l == 1) return zerocol(nbrows(A));
1139 8208510 : z = ZC_Z_mul(gel(A,1), gel(x,2));
1140 27428241 : for (i = 2; i < l ; i++)
1141 19223153 : if (signe(gel(x,i+1))) z = ZC_add(z, ZC_Z_mul(gel(A,i), gel(x,i+1)));
1142 8205088 : return z;
1143 : }
1144 : /* x a t_POL, nf a genuine nf. No garbage collecting. No check. */
1145 : GEN
1146 7625782 : poltobasis(GEN nf, GEN x)
1147 : {
1148 7625782 : GEN d, T = nf_get_pol(nf);
1149 7625731 : if (varn(x) != varn(T)) pari_err_VAR( "poltobasis", x,T);
1150 7625598 : if (degpol(x) >= degpol(T)) x = RgX_rem(x,T);
1151 7625511 : x = Q_remove_denom(x, &d);
1152 7625536 : if (!RgX_is_ZX(x)) pari_err_TYPE("poltobasis",x);
1153 7625515 : x = ZM_ZX_mul(nf_get_invzk(nf), x);
1154 7623462 : if (d) x = RgC_Rg_div(x, d);
1155 7623566 : return x;
1156 : }
1157 :
1158 : GEN
1159 524119 : algtobasis(GEN nf, GEN x)
1160 : {
1161 : pari_sp av;
1162 :
1163 524119 : nf = checknf(nf);
1164 524117 : switch(typ(x))
1165 : {
1166 107772 : case t_POLMOD:
1167 107772 : if (!RgX_equal_var(nf_get_pol(nf),gel(x,1)))
1168 7 : pari_err_MODULUS("algtobasis", nf_get_pol(nf),gel(x,1));
1169 107765 : x = gel(x,2);
1170 107765 : switch(typ(x))
1171 : {
1172 7497 : case t_INT:
1173 7497 : case t_FRAC: return scalarcol(x, nf_get_degree(nf));
1174 100268 : case t_POL:
1175 100268 : av = avma;
1176 100268 : return gerepileupto(av,poltobasis(nf,x));
1177 : }
1178 0 : break;
1179 :
1180 248964 : case t_POL:
1181 248964 : av = avma;
1182 248964 : return gerepileupto(av,poltobasis(nf,x));
1183 :
1184 82866 : case t_COL:
1185 82866 : if (!RgV_is_QV(x)) pari_err_TYPE("nfalgtobasis",x);
1186 82858 : if (lg(x)-1 != nf_get_degree(nf)) pari_err_DIM("nfalgtobasis");
1187 82858 : return gcopy(x);
1188 :
1189 84517 : case t_INT:
1190 84517 : case t_FRAC: return scalarcol(x, nf_get_degree(nf));
1191 : }
1192 0 : pari_err_TYPE("algtobasis",x);
1193 : return NULL; /* LCOV_EXCL_LINE */
1194 : }
1195 :
1196 : GEN
1197 44499 : rnfbasistoalg(GEN rnf,GEN x)
1198 : {
1199 44499 : const char *f = "rnfbasistoalg";
1200 : long lx, i;
1201 44499 : pari_sp av = avma;
1202 : GEN z, nf, R, T;
1203 :
1204 44499 : checkrnf(rnf);
1205 44499 : nf = rnf_get_nf(rnf);
1206 44499 : T = nf_get_pol(nf);
1207 44499 : R = QXQX_to_mod_shallow(rnf_get_pol(rnf), T);
1208 44499 : switch(typ(x))
1209 : {
1210 826 : case t_COL:
1211 826 : z = cgetg_copy(x, &lx);
1212 2478 : for (i=1; i<lx; i++)
1213 : {
1214 1701 : GEN c = nf_to_scalar_or_alg(nf, gel(x,i));
1215 1652 : if (typ(c) == t_POL) c = mkpolmod(c,T);
1216 1652 : gel(z,i) = c;
1217 : }
1218 777 : z = RgV_RgC_mul(gel(rnf_get_zk(rnf),1), z);
1219 714 : return gerepileupto(av, gmodulo(z,R));
1220 :
1221 29883 : case t_POLMOD:
1222 29883 : x = polmod_nffix(f, rnf, x, 0);
1223 29680 : if (typ(x) != t_POL) break;
1224 13699 : retmkpolmod(RgX_copy(x), RgX_copy(R));
1225 1106 : case t_POL:
1226 1106 : if (varn(x) == varn(T)) { RgX_check_QX(x,f); x = gmodulo(x,T); break; }
1227 882 : if (varn(x) == varn(R))
1228 : {
1229 833 : x = RgX_nffix(f,nf_get_pol(nf),x,0);
1230 833 : return gmodulo(x, R);
1231 : }
1232 49 : pari_err_VAR(f, x,R);
1233 : }
1234 28840 : retmkpolmod(scalarpol(x, varn(R)), RgX_copy(R));
1235 : }
1236 :
1237 : GEN
1238 2002 : matbasistoalg(GEN nf,GEN x)
1239 : {
1240 : long i, j, li, lx;
1241 2002 : GEN z = cgetg_copy(x, &lx);
1242 :
1243 2002 : if (lx == 1) return z;
1244 1995 : switch(typ(x))
1245 : {
1246 77 : case t_VEC: case t_COL:
1247 280 : for (i=1; i<lx; i++) gel(z,i) = basistoalg(nf, gel(x,i));
1248 77 : return z;
1249 1918 : case t_MAT: break;
1250 0 : default: pari_err_TYPE("matbasistoalg",x);
1251 : }
1252 1918 : li = lgcols(x);
1253 7196 : for (j=1; j<lx; j++)
1254 : {
1255 5278 : GEN c = cgetg(li,t_COL), xj = gel(x,j);
1256 5278 : gel(z,j) = c;
1257 25249 : for (i=1; i<li; i++) gel(c,i) = basistoalg(nf, gel(xj,i));
1258 : }
1259 1918 : return z;
1260 : }
1261 :
1262 : GEN
1263 29721 : matalgtobasis(GEN nf,GEN x)
1264 : {
1265 : long i, j, li, lx;
1266 29721 : GEN z = cgetg_copy(x, &lx);
1267 :
1268 29722 : if (lx == 1) return z;
1269 29295 : switch(typ(x))
1270 : {
1271 29288 : case t_VEC: case t_COL:
1272 74934 : for (i=1; i<lx; i++) gel(z,i) = algtobasis(nf, gel(x,i));
1273 29289 : return z;
1274 7 : case t_MAT: break;
1275 0 : default: pari_err_TYPE("matalgtobasis",x);
1276 : }
1277 7 : li = lgcols(x);
1278 14 : for (j=1; j<lx; j++)
1279 : {
1280 7 : GEN c = cgetg(li,t_COL), xj = gel(x,j);
1281 7 : gel(z,j) = c;
1282 21 : for (i=1; i<li; i++) gel(c,i) = algtobasis(nf, gel(xj,i));
1283 : }
1284 7 : return z;
1285 : }
1286 : GEN
1287 9317 : RgM_to_nfM(GEN nf,GEN x)
1288 : {
1289 : long i, j, li, lx;
1290 9317 : GEN z = cgetg_copy(x, &lx);
1291 :
1292 9317 : if (lx == 1) return z;
1293 9317 : li = lgcols(x);
1294 71050 : for (j=1; j<lx; j++)
1295 : {
1296 61733 : GEN c = cgetg(li,t_COL), xj = gel(x,j);
1297 61733 : gel(z,j) = c;
1298 416843 : for (i=1; i<li; i++) gel(c,i) = nf_to_scalar_or_basis(nf, gel(xj,i));
1299 : }
1300 9317 : return z;
1301 : }
1302 : GEN
1303 81641 : RgC_to_nfC(GEN nf, GEN x)
1304 601986 : { pari_APPLY_type(t_COL, nf_to_scalar_or_basis(nf, gel(x,i))) }
1305 :
1306 : /* x a t_POLMOD, supposedly in rnf = K[z]/(T), K = Q[y]/(Tnf) */
1307 : GEN
1308 135037 : polmod_nffix(const char *f, GEN rnf, GEN x, int lift)
1309 135037 : { return polmod_nffix2(f, rnf_get_nfpol(rnf), rnf_get_pol(rnf), x,lift); }
1310 : GEN
1311 135128 : polmod_nffix2(const char *f, GEN T, GEN R, GEN x, int lift)
1312 : {
1313 135128 : if (RgX_equal_var(gel(x,1), R))
1314 : {
1315 124838 : x = gel(x,2);
1316 124838 : if (typ(x) == t_POL && varn(x) == varn(R))
1317 : {
1318 95396 : x = RgX_nffix(f, T, x, lift);
1319 95396 : switch(lg(x))
1320 : {
1321 5782 : case 2: return gen_0;
1322 11305 : case 3: return gel(x,2);
1323 : }
1324 78309 : return x;
1325 : }
1326 : }
1327 39732 : return Rg_nffix(f, T, x, lift);
1328 : }
1329 : GEN
1330 1204 : rnfalgtobasis(GEN rnf,GEN x)
1331 : {
1332 1204 : const char *f = "rnfalgtobasis";
1333 1204 : pari_sp av = avma;
1334 : GEN T, R;
1335 :
1336 1204 : checkrnf(rnf);
1337 1204 : R = rnf_get_pol(rnf);
1338 1204 : T = rnf_get_nfpol(rnf);
1339 1204 : switch(typ(x))
1340 : {
1341 49 : case t_COL:
1342 49 : if (lg(x)-1 != rnf_get_degree(rnf)) pari_err_DIM(f);
1343 28 : x = RgV_nffix(f, T, x, 0);
1344 21 : return gerepilecopy(av, x);
1345 :
1346 1071 : case t_POLMOD:
1347 1071 : x = polmod_nffix(f, rnf, x, 0);
1348 1036 : if (typ(x) != t_POL) break;
1349 714 : return gerepileupto(av, RgM_RgX_mul(rnf_get_invzk(rnf), x));
1350 56 : case t_POL:
1351 56 : if (varn(x) == varn(T))
1352 : {
1353 21 : RgX_check_QX(x,f);
1354 14 : if (degpol(x) >= degpol(T)) x = RgX_rem(x,T);
1355 14 : x = mkpolmod(x,T); break;
1356 : }
1357 35 : x = RgX_nffix(f, T, x, 0);
1358 28 : if (degpol(x) >= degpol(R)) x = RgX_rem(x, R);
1359 28 : return gerepileupto(av, RgM_RgX_mul(rnf_get_invzk(rnf), x));
1360 : }
1361 364 : return gerepileupto(av, scalarcol(x, rnf_get_degree(rnf)));
1362 : }
1363 :
1364 : /* Given a and b in nf, gives an algebraic integer y in nf such that a-b.y
1365 : * is "small" */
1366 : GEN
1367 259 : nfdiveuc(GEN nf, GEN a, GEN b)
1368 : {
1369 259 : pari_sp av = avma;
1370 259 : a = nfdiv(nf,a,b);
1371 259 : return gerepileupto(av, ground(a));
1372 : }
1373 :
1374 : /* Given a and b in nf, gives a "small" algebraic integer r in nf
1375 : * of the form a-b.y */
1376 : GEN
1377 259 : nfmod(GEN nf, GEN a, GEN b)
1378 : {
1379 259 : pari_sp av = avma;
1380 259 : GEN p1 = gneg_i(nfmul(nf,b,ground(nfdiv(nf,a,b))));
1381 259 : return gerepileupto(av, nfadd(nf,a,p1));
1382 : }
1383 :
1384 : /* Given a and b in nf, gives a two-component vector [y,r] in nf such
1385 : * that r=a-b.y is "small". */
1386 : GEN
1387 259 : nfdivrem(GEN nf, GEN a, GEN b)
1388 : {
1389 259 : pari_sp av = avma;
1390 259 : GEN p1,z, y = ground(nfdiv(nf,a,b));
1391 :
1392 259 : p1 = gneg_i(nfmul(nf,b,y));
1393 259 : z = cgetg(3,t_VEC);
1394 259 : gel(z,1) = gcopy(y);
1395 259 : gel(z,2) = nfadd(nf,a,p1); return gerepileupto(av, z);
1396 : }
1397 :
1398 : /*************************************************************************/
1399 : /** **/
1400 : /** LOGARITHMIC EMBEDDINGS **/
1401 : /** **/
1402 : /*************************************************************************/
1403 :
1404 : static int
1405 3367722 : low_prec(GEN x)
1406 : {
1407 3367722 : switch(typ(x))
1408 : {
1409 0 : case t_INT: return !signe(x);
1410 3367722 : case t_REAL: return !signe(x) || realprec(x) <= DEFAULTPREC;
1411 0 : default: return 0;
1412 : }
1413 : }
1414 :
1415 : static GEN
1416 23113 : cxlog_1(GEN nf) { return zerocol(lg(nf_get_roots(nf))-1); }
1417 : static GEN
1418 434 : cxlog_m1(GEN nf, long prec)
1419 : {
1420 434 : long i, l = lg(nf_get_roots(nf)), r1 = nf_get_r1(nf);
1421 434 : GEN v = cgetg(l, t_COL), p, P;
1422 434 : p = mppi(prec); P = mkcomplex(gen_0, p);
1423 1001 : for (i = 1; i <= r1; i++) gel(v,i) = P; /* IPi*/
1424 434 : if (i < l) P = gmul2n(P,1);
1425 987 : for ( ; i < l; i++) gel(v,i) = P; /* 2IPi */
1426 434 : return v;
1427 : }
1428 : static GEN
1429 1088973 : ZC_cxlog(GEN nf, GEN x, long prec)
1430 : {
1431 : long i, l, r1;
1432 : GEN v;
1433 1088973 : x = RgM_RgC_mul(nf_get_M(nf), Q_primpart(x));
1434 1088975 : l = lg(x); r1 = nf_get_r1(nf);
1435 2438883 : for (i = 1; i <= r1; i++)
1436 1349908 : if (low_prec(gel(x,i))) return NULL;
1437 2878153 : for ( ; i < l; i++)
1438 1789192 : if (low_prec(gnorm(gel(x,i)))) return NULL;
1439 1088961 : v = cgetg(l,t_COL);
1440 2438869 : for (i = 1; i <= r1; i++) gel(v,i) = glog(gel(x,i),prec);
1441 2878095 : for ( ; i < l; i++) gel(v,i) = gmul2n(glog(gel(x,i),prec),1);
1442 1088959 : return v;
1443 : }
1444 : static GEN
1445 222431 : famat_cxlog(GEN nf, GEN fa, long prec)
1446 : {
1447 222431 : GEN G, E, y = NULL;
1448 : long i, l;
1449 :
1450 222431 : if (typ(fa) != t_MAT) pari_err_TYPE("famat_cxlog",fa);
1451 222431 : if (lg(fa) == 1) return cxlog_1(nf);
1452 222431 : G = gel(fa,1);
1453 222431 : E = gel(fa,2); l = lg(E);
1454 1104770 : for (i = 1; i < l; i++)
1455 : {
1456 882353 : GEN t, e = gel(E,i), x = nf_to_scalar_or_basis(nf, gel(G,i));
1457 : /* multiplicative arch would be better (save logs), but exponents overflow
1458 : * [ could keep track of expo separately, but not worth it ] */
1459 882353 : switch(typ(x))
1460 : { /* ignore positive rationals */
1461 16002 : case t_FRAC: x = gel(x,1); /* fall through */
1462 268358 : case t_INT: if (signe(x) > 0) continue;
1463 14 : if (!mpodd(e)) continue;
1464 14 : t = cxlog_m1(nf, prec); /* we probably should not reach this line */
1465 14 : break;
1466 613995 : default: /* t_COL */
1467 613995 : t = ZC_cxlog(nf,x,prec); if (!t) return NULL;
1468 613981 : t = RgC_Rg_mul(t, e);
1469 : }
1470 613995 : y = y? RgV_add(y,t): t;
1471 : }
1472 222417 : return y ? y: cxlog_1(nf);
1473 : }
1474 : /* Archimedean components: [e_i Log( sigma_i(X) )], where X = primpart(x),
1475 : * and e_i = 1 (resp 2.) for i <= R1 (resp. > R1) */
1476 : GEN
1477 698473 : nf_cxlog(GEN nf, GEN x, long prec)
1478 : {
1479 698473 : if (typ(x) == t_MAT) return famat_cxlog(nf,x,prec);
1480 476042 : x = nf_to_scalar_or_basis(nf,x);
1481 476042 : switch(typ(x))
1482 : {
1483 0 : case t_FRAC: x = gel(x,1); /* fall through */
1484 1064 : case t_INT:
1485 1064 : return signe(x) > 0? cxlog_1(nf): cxlog_m1(nf, prec);
1486 474978 : default:
1487 474978 : return ZC_cxlog(nf, x, prec);
1488 : }
1489 : }
1490 : GEN
1491 98 : nfV_cxlog(GEN nf, GEN x, long prec)
1492 : {
1493 : long i, l;
1494 98 : GEN v = cgetg_copy(x, &l);
1495 168 : for (i = 1; i < l; i++)
1496 70 : if (!(gel(v,i) = nf_cxlog(nf, gel(x,i), prec))) return NULL;
1497 98 : return v;
1498 : }
1499 :
1500 : static GEN
1501 22099 : scalar_logembed(GEN nf, GEN u, GEN *emb)
1502 : {
1503 : GEN v, logu;
1504 22099 : long i, s = signe(u), RU = lg(nf_get_roots(nf))-1, R1 = nf_get_r1(nf);
1505 :
1506 22099 : if (!s) pari_err_DOMAIN("nflogembed","argument","=",gen_0,u);
1507 22099 : v = cgetg(RU+1, t_COL); logu = logr_abs(u);
1508 24171 : for (i = 1; i <= R1; i++) gel(v,i) = logu;
1509 22099 : if (i <= RU)
1510 : {
1511 21217 : GEN logu2 = shiftr(logu,1);
1512 83335 : for ( ; i <= RU; i++) gel(v,i) = logu2;
1513 : }
1514 22099 : if (emb) *emb = const_col(RU, u);
1515 22099 : return v;
1516 : }
1517 :
1518 : static GEN
1519 1309 : famat_logembed(GEN nf,GEN x,GEN *emb,long prec)
1520 : {
1521 1309 : GEN A, M, T, a, t, g = gel(x,1), e = gel(x,2);
1522 1309 : long i, l = lg(e);
1523 :
1524 1309 : if (l == 1) return scalar_logembed(nf, real_1(prec), emb);
1525 1309 : A = NULL; T = emb? cgetg(l, t_COL): NULL;
1526 1309 : if (emb) *emb = M = mkmat2(T, e);
1527 79591 : for (i = 1; i < l; i++)
1528 : {
1529 78282 : a = nflogembed(nf, gel(g,i), &t, prec);
1530 78282 : if (!a) return NULL;
1531 78282 : a = RgC_Rg_mul(a, gel(e,i));
1532 78282 : A = A? RgC_add(A, a): a;
1533 78282 : if (emb) gel(T,i) = t;
1534 : }
1535 1309 : return A;
1536 : }
1537 :
1538 : /* Get archimedean components: [e_i log( | sigma_i(x) | )], with e_i = 1
1539 : * (resp 2.) for i <= R1 (resp. > R1) and set emb to the embeddings of x.
1540 : * Return NULL if precision problem */
1541 : GEN
1542 116096 : nflogembed(GEN nf, GEN x, GEN *emb, long prec)
1543 : {
1544 : long i, l, r1;
1545 : GEN v, t;
1546 :
1547 116096 : if (typ(x) == t_MAT) return famat_logembed(nf,x,emb,prec);
1548 114787 : x = nf_to_scalar_or_basis(nf,x);
1549 114787 : if (typ(x) != t_COL) return scalar_logembed(nf, gtofp(x,prec), emb);
1550 92688 : x = RgM_RgC_mul(nf_get_M(nf), x);
1551 92687 : l = lg(x); r1 = nf_get_r1(nf); v = cgetg(l,t_COL);
1552 119700 : for (i = 1; i <= r1; i++)
1553 : {
1554 27013 : t = gabs(gel(x,i),prec); if (low_prec(t)) return NULL;
1555 27013 : gel(v,i) = glog(t,prec);
1556 : }
1557 294296 : for ( ; i < l; i++)
1558 : {
1559 201609 : t = gnorm(gel(x,i)); if (low_prec(t)) return NULL;
1560 201609 : gel(v,i) = glog(t,prec);
1561 : }
1562 92687 : if (emb) *emb = x;
1563 92687 : return v;
1564 : }
1565 :
1566 : /*************************************************************************/
1567 : /** **/
1568 : /** REAL EMBEDDINGS **/
1569 : /** **/
1570 : /*************************************************************************/
1571 : static GEN
1572 485182 : sarch_get_cyc(GEN sarch) { return gel(sarch,1); }
1573 : static GEN
1574 699873 : sarch_get_archp(GEN sarch) { return gel(sarch,2); }
1575 : static GEN
1576 172182 : sarch_get_MI(GEN sarch) { return gel(sarch,3); }
1577 : static GEN
1578 172182 : sarch_get_lambda(GEN sarch) { return gel(sarch,4); }
1579 : static GEN
1580 172182 : sarch_get_F(GEN sarch) { return gel(sarch,5); }
1581 :
1582 : /* x not a scalar, true nf, return number of positive roots of char_x */
1583 : static long
1584 1259 : num_positive(GEN nf, GEN x)
1585 : {
1586 1259 : GEN T = nf_get_pol(nf), B, charx;
1587 : long dnf, vnf, N;
1588 1259 : x = nf_to_scalar_or_alg(nf, x); /* not a scalar */
1589 1259 : charx = ZXQ_charpoly(x, T, 0);
1590 1259 : charx = ZX_radical(charx);
1591 1259 : N = degpol(T) / degpol(charx);
1592 : /* real places are unramified ? */
1593 1259 : if (N == 1 || ZX_sturm(charx) * N == nf_get_r1(nf))
1594 1252 : return ZX_sturmpart(charx, mkvec2(gen_0,mkoo())) * N;
1595 : /* painful case, multiply by random square until primitive */
1596 7 : dnf = nf_get_degree(nf);
1597 7 : vnf = varn(T);
1598 7 : B = int2n(10);
1599 : for(;;)
1600 0 : {
1601 7 : GEN y = RgXQ_sqr(random_FpX(dnf, vnf, B), T);
1602 7 : y = RgXQ_mul(x, y, T);
1603 7 : charx = ZXQ_charpoly(y, T, 0);
1604 7 : if (ZX_is_squarefree(charx))
1605 7 : return ZX_sturmpart(charx, mkvec2(gen_0,mkoo())) * N;
1606 : }
1607 : }
1608 :
1609 : /* x a QC: return sigma_k(x) where 1 <= k <= r1+r2; correct but inefficient
1610 : * if x in Q. M = nf_get_M(nf) */
1611 : static GEN
1612 629 : nfembed_i(GEN M, GEN x, long k)
1613 : {
1614 629 : long i, l = lg(M);
1615 629 : GEN z = gel(x,1);
1616 3972 : for (i = 2; i < l; i++) z = gadd(z, gmul(gcoeff(M,k,i), gel(x,i)));
1617 629 : return z;
1618 : }
1619 : GEN
1620 0 : nfembed(GEN nf, GEN x, long k)
1621 : {
1622 0 : pari_sp av = avma;
1623 0 : nf = checknf(nf);
1624 0 : x = nf_to_scalar_or_basis(nf,x);
1625 0 : if (typ(x) != t_COL) return gerepilecopy(av, x);
1626 0 : return gerepileupto(av, nfembed_i(nf_get_M(nf),x,k));
1627 : }
1628 :
1629 : /* x a ZC */
1630 : static GEN
1631 890809 : zk_embed(GEN M, GEN x, long k)
1632 : {
1633 890809 : long i, l = lg(x);
1634 890809 : GEN z = gel(x,1); /* times M[k,1], which is 1 */
1635 2826684 : for (i = 2; i < l; i++) z = mpadd(z, mpmul(gcoeff(M,k,i), gel(x,i)));
1636 890781 : return z;
1637 : }
1638 :
1639 : /* Given floating point approximation z of sigma_k(x), decide its sign
1640 : * [0/+, 1/- and -1 for FAIL] */
1641 : static long
1642 872134 : eval_sign_embed(GEN z)
1643 : { /* dubious, fail */
1644 872134 : if (typ(z) == t_REAL && realprec(z) <= LOWDEFAULTPREC) return -1;
1645 871290 : return (signe(z) < 1)? 1: 0;
1646 : }
1647 : /* return v such that (-1)^v = sign(sigma_k(x)), x primitive ZC */
1648 : static long
1649 757398 : eval_sign(GEN M, GEN x, long k)
1650 757398 : { return eval_sign_embed( zk_embed(M, x, k) ); }
1651 :
1652 : /* check that signs[i..#signs] == s; signs = NULL encodes "totally positive" */
1653 : static int
1654 0 : oksigns(long l, GEN signs, long i, long s)
1655 : {
1656 0 : if (!signs) return s == 0;
1657 0 : for (; i < l; i++)
1658 0 : if (signs[i] != s) return 0;
1659 0 : return 1;
1660 : }
1661 : /* check that signs[i] = s and signs[i+1..#signs] = 1-s */
1662 : static int
1663 0 : oksigns2(long l, GEN signs, long i, long s)
1664 : {
1665 0 : if (!signs) return s == 0 && i == l-1;
1666 0 : return signs[i] == s && oksigns(l, signs, i+1, 1-s);
1667 : }
1668 :
1669 : /* true nf, x a ZC (primitive for efficiency) which is not a scalar; embx its
1670 : * embeddings or NULL */
1671 : static int
1672 96464 : nfchecksigns_i(GEN nf, GEN x, GEN embx, GEN signs, GEN archp)
1673 : {
1674 96464 : long l = lg(archp), i;
1675 96464 : GEN M = nf_get_M(nf), sarch = NULL;
1676 96464 : long np = -1;
1677 148882 : for (i = 1; i < l; i++)
1678 : {
1679 : long s;
1680 115419 : if (embx)
1681 114761 : s = eval_sign_embed(gel(embx,i));
1682 : else
1683 658 : s = eval_sign(M, x, archp[i]);
1684 : /* 0 / + or 1 / -; -1 for FAIL */
1685 115419 : if (s < 0) /* failure */
1686 : {
1687 0 : long ni, r1 = nf_get_r1(nf);
1688 : GEN xi;
1689 0 : if (np < 0)
1690 : {
1691 0 : np = num_positive(nf, x);
1692 0 : if (np == 0) return oksigns(l, signs, i, 1);
1693 0 : if (np == r1) return oksigns(l, signs, i, 0);
1694 0 : sarch = nfarchstar(nf, NULL, identity_perm(r1));
1695 : }
1696 0 : xi = set_sign_mod_divisor(nf, vecsmall_ei(r1, archp[i]), gen_1, sarch);
1697 0 : xi = Q_primpart(xi);
1698 0 : ni = num_positive(nf, nfmuli(nf,x,xi));
1699 0 : if (ni == 0) return oksigns2(l, signs, i, 0);
1700 0 : if (ni == r1) return oksigns2(l, signs, i, 1);
1701 0 : s = ni < np? 0: 1;
1702 : }
1703 115419 : if (s != (signs? signs[i]: 0)) return 0;
1704 : }
1705 33463 : return 1;
1706 : }
1707 : static void
1708 378 : pl_convert(GEN pl, GEN *psigns, GEN *parchp)
1709 : {
1710 378 : long i, j, l = lg(pl);
1711 378 : GEN signs = cgetg(l, t_VECSMALL);
1712 378 : GEN archp = cgetg(l, t_VECSMALL);
1713 1589 : for (i = j = 1; i < l; i++)
1714 : {
1715 1211 : if (!pl[i]) continue;
1716 686 : archp[j] = i;
1717 686 : signs[j] = (pl[i] < 0)? 1: 0;
1718 686 : j++;
1719 : }
1720 378 : setlg(archp, j); *parchp = archp;
1721 378 : setlg(signs, j); *psigns = signs;
1722 378 : }
1723 : /* pl : requested signs for real embeddings, 0 = no sign constraint */
1724 : int
1725 903 : nfchecksigns(GEN nf, GEN x, GEN pl)
1726 : {
1727 903 : pari_sp av = avma;
1728 : GEN signs, archp;
1729 903 : nf = checknf(nf);
1730 903 : x = nf_to_scalar_or_basis(nf,x);
1731 903 : if (typ(x) != t_COL)
1732 : {
1733 525 : long i, l = lg(pl), s = gsigne(x);
1734 1064 : for (i = 1; i < l; i++)
1735 539 : if (pl[i] && pl[i] != s) return gc_bool(av,0);
1736 525 : return gc_bool(av,1);
1737 : }
1738 378 : pl_convert(pl, &signs, &archp);
1739 378 : return gc_bool(av, nfchecksigns_i(nf, x, NULL, signs, archp));
1740 : }
1741 :
1742 : /* signs = NULL: totally positive, else sign[i] = 0 (+) or 1 (-) */
1743 : static GEN
1744 172182 : get_C(GEN lambda, long l, GEN signs)
1745 : {
1746 : long i;
1747 : GEN C, mlambda;
1748 172182 : if (!signs) return const_vec(l-1, lambda);
1749 133430 : C = cgetg(l, t_COL); mlambda = gneg(lambda);
1750 342235 : for (i = 1; i < l; i++) gel(C,i) = signs[i]? mlambda: lambda;
1751 133428 : return C;
1752 : }
1753 : /* signs = NULL: totally positive at archp.
1754 : * Assume that a t_COL x is not a scalar */
1755 : static GEN
1756 286164 : nfsetsigns(GEN nf, GEN signs, GEN x, GEN sarch)
1757 : {
1758 286164 : long i, l = lg(sarch_get_archp(sarch));
1759 : GEN ex;
1760 : /* Is signature already correct ? */
1761 286164 : if (typ(x) != t_COL)
1762 : {
1763 190078 : long s = gsigne(x);
1764 190078 : if (!s) i = 1;
1765 190057 : else if (!signs)
1766 4900 : i = (s < 0)? 1: l;
1767 : else
1768 : {
1769 185157 : s = s < 0? 1: 0;
1770 312914 : for (i = 1; i < l; i++)
1771 236785 : if (signs[i] != s) break;
1772 : }
1773 190078 : ex = (i < l)? const_col(l-1, x): NULL;
1774 : }
1775 : else
1776 : { /* inefficient if x scalar, wrong if x = 0 */
1777 96086 : pari_sp av = avma;
1778 96086 : GEN cex, M = nf_get_M(nf), archp = sarch_get_archp(sarch);
1779 96088 : GEN xp = Q_primitive_part(x,&cex);
1780 96087 : ex = cgetg(l,t_COL);
1781 229497 : for (i = 1; i < l; i++) gel(ex,i) = zk_embed(M,xp,archp[i]);
1782 96086 : if (nfchecksigns_i(nf, xp, ex, signs, archp)) { ex = NULL; set_avma(av); }
1783 62987 : else if (cex) ex = RgC_Rg_mul(ex, cex); /* put back content */
1784 : }
1785 286167 : if (ex)
1786 : { /* If no, fix it */
1787 172182 : GEN MI = sarch_get_MI(sarch), F = sarch_get_F(sarch);
1788 172182 : GEN lambda = sarch_get_lambda(sarch);
1789 172182 : GEN t = RgC_sub(get_C(lambda, l, signs), ex);
1790 172179 : t = grndtoi(RgM_RgC_mul(MI,t), NULL);
1791 172172 : if (lg(F) != 1) t = ZM_ZC_mul(F, t);
1792 172175 : x = typ(x) == t_COL? RgC_add(t, x): RgC_Rg_add(t, x);
1793 : }
1794 286158 : return x;
1795 : }
1796 : /* - true nf
1797 : * - sarch = nfarchstar(nf, F);
1798 : * - x encodes a vector of signs at arch.archp: either a t_VECSMALL
1799 : * (vector of signs as {0,1}-vector), NULL (totally positive at archp),
1800 : * or a nonzero number field element (replaced by its signature at archp);
1801 : * - y is a nonzero number field element
1802 : * Return z = y (mod F) with signs(y, archp) = signs(x) (a {0,1}-vector).
1803 : * Not stack-clean */
1804 : GEN
1805 317627 : set_sign_mod_divisor(GEN nf, GEN x, GEN y, GEN sarch)
1806 : {
1807 317627 : GEN archp = sarch_get_archp(sarch);
1808 317627 : if (lg(archp) == 1) return y;
1809 284454 : if (x && typ(x) != t_VECSMALL) x = nfsign_arch(nf, x, archp);
1810 284454 : return nfsetsigns(nf, x, nf_to_scalar_or_basis(nf,y), sarch);
1811 : }
1812 :
1813 : static GEN
1814 83213 : setsigns_init(GEN nf, GEN archp, GEN F, GEN DATA)
1815 : {
1816 83213 : GEN lambda, Mr = rowpermute(nf_get_M(nf), archp), MI = F? RgM_mul(Mr,F): Mr;
1817 83216 : lambda = gmul2n(matrixnorm(MI,DEFAULTPREC), -1);
1818 83217 : if (typ(lambda) != t_REAL) lambda = gmul(lambda, uutoQ(1001,1000));
1819 83217 : if (lg(archp) < lg(MI))
1820 : {
1821 58911 : GEN perm = gel(indexrank(MI), 2);
1822 58911 : if (!F) F = matid(nf_get_degree(nf));
1823 58911 : MI = vecpermute(MI, perm);
1824 58911 : F = vecpermute(F, perm);
1825 : }
1826 83217 : if (!F) F = cgetg(1,t_MAT);
1827 83217 : MI = RgM_inv(MI);
1828 83213 : return mkvec5(DATA, archp, MI, lambda, F);
1829 : }
1830 : /* F nonzero integral ideal in HNF (or NULL: Z_K), compute elements in 1+F
1831 : * whose sign matrix at archp is identity; archp in 'indices' format */
1832 : GEN
1833 258771 : nfarchstar(GEN nf, GEN F, GEN archp)
1834 : {
1835 258771 : long nba = lg(archp) - 1;
1836 258771 : if (!nba) return mkvec2(cgetg(1,t_VEC), archp);
1837 81506 : if (F && equali1(gcoeff(F,1,1))) F = NULL;
1838 81506 : if (F) F = idealpseudored(F, nf_get_roundG(nf));
1839 81503 : return setsigns_init(nf, archp, F, const_vec(nba, gen_2));
1840 : }
1841 :
1842 : /*************************************************************************/
1843 : /** **/
1844 : /** IDEALCHINESE **/
1845 : /** **/
1846 : /*************************************************************************/
1847 : static int
1848 3276 : isprfact(GEN x)
1849 : {
1850 : long i, l;
1851 : GEN L, E;
1852 3276 : if (typ(x) != t_MAT || lg(x) != 3) return 0;
1853 3276 : L = gel(x,1); l = lg(L);
1854 3276 : E = gel(x,2);
1855 9226 : for(i=1; i<l; i++)
1856 : {
1857 5950 : checkprid(gel(L,i));
1858 5950 : if (typ(gel(E,i)) != t_INT) return 0;
1859 : }
1860 3276 : return 1;
1861 : }
1862 :
1863 : /* initialize projectors mod pr[i]^e[i] for idealchinese */
1864 : static GEN
1865 3276 : pr_init(GEN nf, GEN fa, GEN w, GEN dw)
1866 : {
1867 3276 : GEN U, E, F, FZ, L = gel(fa,1), E0 = gel(fa,2);
1868 3276 : long i, r = lg(L);
1869 :
1870 3276 : if (w && lg(w) != r) pari_err_TYPE("idealchinese", w);
1871 3276 : if (r == 1 && !dw) return cgetg(1,t_VEC);
1872 3269 : E = leafcopy(E0); /* do not destroy fa[2] */
1873 9219 : for (i = 1; i < r; i++)
1874 5950 : if (signe(gel(E,i)) < 0) gel(E,i) = gen_0;
1875 3269 : F = factorbackprime(nf, L, E);
1876 3269 : if (dw)
1877 : {
1878 707 : F = ZM_Z_mul(F, dw);
1879 1638 : for (i = 1; i < r; i++)
1880 : {
1881 931 : GEN pr = gel(L,i);
1882 931 : long e = itos(gel(E0,i)), v = idealval(nf, dw, pr);
1883 931 : if (e >= 0)
1884 924 : gel(E,i) = addiu(gel(E,i), v);
1885 7 : else if (v + e <= 0)
1886 0 : F = idealmulpowprime(nf, F, pr, stoi(-v)); /* coprime to pr */
1887 : else
1888 : {
1889 7 : F = idealmulpowprime(nf, F, pr, stoi(e));
1890 7 : gel(E,i) = stoi(v + e);
1891 : }
1892 : }
1893 : }
1894 3269 : U = cgetg(r, t_VEC);
1895 9219 : for (i = 1; i < r; i++)
1896 : {
1897 : GEN u;
1898 5950 : if (w && gequal0(gel(w,i))) u = gen_0; /* unused */
1899 : else
1900 : {
1901 5873 : GEN pr = gel(L,i), e = gel(E,i), t;
1902 5873 : t = idealdivpowprime(nf,F, pr, e);
1903 5873 : u = hnfmerge_get_1(t, idealpow(nf, pr, e));
1904 5873 : if (!u) pari_err_COPRIME("idealchinese", t,pr);
1905 : }
1906 5950 : gel(U,i) = u;
1907 : }
1908 3269 : FZ = gcoeff(F, 1, 1);
1909 3269 : F = idealpseudored(F, nf_get_roundG(nf));
1910 3269 : return mkvec2(mkvec2(F, FZ), U);
1911 : }
1912 :
1913 : static GEN
1914 2121 : pl_normalize(GEN nf, GEN pl)
1915 : {
1916 2121 : const char *fun = "idealchinese";
1917 2121 : if (lg(pl)-1 != nf_get_r1(nf)) pari_err_TYPE(fun,pl);
1918 2121 : switch(typ(pl))
1919 : {
1920 721 : case t_VEC: RgV_check_ZV(pl,fun); pl = ZV_to_zv(pl);
1921 : /* fall through */
1922 2121 : case t_VECSMALL: break;
1923 0 : default: pari_err_TYPE(fun,pl);
1924 : }
1925 2121 : return pl;
1926 : }
1927 :
1928 : static int
1929 8267 : is_chineseinit(GEN x)
1930 : {
1931 : GEN fa, pl;
1932 : long l;
1933 8267 : if (typ(x) != t_VEC || lg(x)!=3) return 0;
1934 6566 : fa = gel(x,1);
1935 6566 : pl = gel(x,2);
1936 6566 : if (typ(fa) != t_VEC || typ(pl) != t_VEC) return 0;
1937 3129 : l = lg(fa);
1938 3129 : if (l != 1)
1939 : {
1940 : GEN z;
1941 3108 : if (l != 3) return 0;
1942 3108 : z = gel(fa, 1);
1943 3108 : if (typ(z) != t_VEC || lg(z) != 3 || typ(gel(z,1)) != t_MAT
1944 3101 : || typ(gel(z,2)) != t_INT
1945 3101 : || typ(gel(fa,2)) != t_VEC)
1946 7 : return 0;
1947 : }
1948 3122 : l = lg(pl);
1949 3122 : if (l != 1)
1950 : {
1951 518 : if (l != 6 || typ(gel(pl,3)) != t_MAT || typ(gel(pl,1)) != t_VECSMALL
1952 518 : || typ(gel(pl,2)) != t_VECSMALL)
1953 0 : return 0;
1954 : }
1955 3122 : return 1;
1956 : }
1957 :
1958 : /* nf a true 'nf' */
1959 : static GEN
1960 3731 : chineseinit_i(GEN nf, GEN fa, GEN w, GEN dw)
1961 : {
1962 3731 : const char *fun = "idealchineseinit";
1963 3731 : GEN archp = NULL, pl = NULL;
1964 3731 : switch(typ(fa))
1965 : {
1966 2121 : case t_VEC:
1967 2121 : if (is_chineseinit(fa))
1968 : {
1969 0 : if (dw) pari_err_DOMAIN(fun, "denom(y)", "!=", gen_1, w);
1970 0 : return fa;
1971 : }
1972 2121 : if (lg(fa) != 3) pari_err_TYPE(fun, fa);
1973 : /* of the form [x,s] */
1974 2121 : pl = pl_normalize(nf, gel(fa,2));
1975 2121 : fa = gel(fa,1);
1976 2121 : archp = vecsmall01_to_indices(pl);
1977 : /* keep pr_init, reset pl */
1978 2121 : if (is_chineseinit(fa)) { fa = gel(fa,1); break; }
1979 : /* fall through */
1980 : case t_MAT: /* factorization? */
1981 3276 : if (isprfact(fa)) { fa = pr_init(nf, fa, w, dw); break; }
1982 0 : default: pari_err_TYPE(fun,fa);
1983 : }
1984 :
1985 3731 : if (!pl) pl = cgetg(1,t_VEC);
1986 : else
1987 : {
1988 2121 : long r = lg(archp);
1989 2121 : if (r == 1) pl = cgetg(1, t_VEC);
1990 : else
1991 : {
1992 1701 : GEN F = (lg(fa) == 1)? NULL: gmael(fa,1,1), signs = cgetg(r, t_VECSMALL);
1993 : long i;
1994 4802 : for (i = 1; i < r; i++) signs[i] = (pl[archp[i]] < 0)? 1: 0;
1995 1701 : pl = setsigns_init(nf, archp, F, signs);
1996 : }
1997 : }
1998 3731 : return mkvec2(fa, pl);
1999 : }
2000 :
2001 : /* Given a prime ideal factorization x, possibly with 0 or negative exponents,
2002 : * and a vector w of elements of nf, gives b such that
2003 : * v_p(b-w_p)>=v_p(x) for all prime ideals p in the ideal factorization
2004 : * and v_p(b)>=0 for all other p, using the standard proof given in GTM 138. */
2005 : GEN
2006 6398 : idealchinese(GEN nf, GEN x0, GEN w)
2007 : {
2008 6398 : const char *fun = "idealchinese";
2009 6398 : pari_sp av = avma;
2010 6398 : GEN x = x0, x1, x2, s, dw, F;
2011 :
2012 6398 : nf = checknf(nf);
2013 6398 : if (!w) return gerepilecopy(av, chineseinit_i(nf,x,NULL,NULL));
2014 :
2015 4025 : if (typ(w) != t_VEC) pari_err_TYPE(fun,w);
2016 4025 : w = Q_remove_denom(matalgtobasis(nf,w), &dw);
2017 4025 : if (!is_chineseinit(x)) x = chineseinit_i(nf,x,w,dw);
2018 : /* x is a 'chineseinit' */
2019 4025 : x1 = gel(x,1); s = NULL;
2020 4025 : x2 = gel(x,2);
2021 4025 : if (lg(x1) == 1) { F = NULL; dw = NULL; }
2022 : else
2023 : {
2024 4004 : GEN U = gel(x1,2), FZ;
2025 4004 : long i, r = lg(w);
2026 4004 : F = gmael(x1,1,1); FZ = gmael(x1,1,2);
2027 13510 : for (i=1; i<r; i++)
2028 9506 : if (!ZV_equal0(gel(w,i)))
2029 : {
2030 7210 : GEN t = nfmuli(nf, gel(U,i), gel(w,i));
2031 7210 : s = s? ZC_add(s,t): t;
2032 : }
2033 4004 : if (s)
2034 : {
2035 3983 : s = ZC_reducemodmatrix(s, F);
2036 3983 : if (dw && x == x0) /* input was a chineseinit */
2037 : {
2038 7 : dw = modii(dw, FZ);
2039 7 : s = FpC_Fp_mul(s, Fp_inv(dw, FZ), FZ);
2040 7 : dw = NULL;
2041 : }
2042 3983 : if (ZV_isscalar(s)) s = icopy(gel(s,1));
2043 : }
2044 : }
2045 4025 : if (lg(x2) != 1)
2046 : {
2047 1708 : s = nfsetsigns(nf, gel(x2,1), s? s: gen_0, x2);
2048 1708 : if (typ(s) == t_COL && QV_isscalar(s))
2049 : {
2050 280 : s = gel(s,1); if (!dw) s = gcopy(s);
2051 : }
2052 : }
2053 2317 : else if (!s) return gc_const(av, gen_0);
2054 3997 : return gerepileupto(av, dw? gdiv(s, dw): s);
2055 : }
2056 :
2057 : /*************************************************************************/
2058 : /** **/
2059 : /** (Z_K/I)^* **/
2060 : /** **/
2061 : /*************************************************************************/
2062 : GEN
2063 2121 : vecsmall01_to_indices(GEN v)
2064 : {
2065 2121 : long i, k, l = lg(v);
2066 2121 : GEN p = new_chunk(l) + l;
2067 6223 : for (k=1, i=l-1; i; i--)
2068 4102 : if (v[i]) { *--p = i; k++; }
2069 2121 : *--p = evallg(k) | evaltyp(t_VECSMALL);
2070 2121 : set_avma((pari_sp)p); return p;
2071 : }
2072 : GEN
2073 1042718 : vec01_to_indices(GEN v)
2074 : {
2075 : long i, k, l;
2076 : GEN p;
2077 :
2078 1042718 : switch (typ(v))
2079 : {
2080 996770 : case t_VECSMALL: return v;
2081 45948 : case t_VEC: break;
2082 0 : default: pari_err_TYPE("vec01_to_indices",v);
2083 : }
2084 45948 : l = lg(v);
2085 45948 : p = new_chunk(l) + l;
2086 138761 : for (k=1, i=l-1; i; i--)
2087 92813 : if (signe(gel(v,i))) { *--p = i; k++; }
2088 45948 : *--p = evallg(k) | evaltyp(t_VECSMALL);
2089 45948 : set_avma((pari_sp)p); return p;
2090 : }
2091 : GEN
2092 136525 : indices_to_vec01(GEN p, long r)
2093 : {
2094 136525 : long i, l = lg(p);
2095 136525 : GEN v = zerovec(r);
2096 206122 : for (i = 1; i < l; i++) gel(v, p[i]) = gen_1;
2097 136525 : return v;
2098 : }
2099 :
2100 : /* return (column) vector of R1 signatures of x (0 or 1) */
2101 : GEN
2102 996770 : nfsign_arch(GEN nf, GEN x, GEN arch)
2103 : {
2104 996770 : GEN sarch, M, V, archp = vec01_to_indices(arch);
2105 996770 : long i, s, np, n = lg(archp)-1;
2106 : pari_sp av;
2107 :
2108 996770 : if (!n) return cgetg(1,t_VECSMALL);
2109 795983 : if (typ(x) == t_MAT)
2110 : { /* factorisation */
2111 272796 : GEN g = gel(x,1), e = gel(x,2);
2112 272796 : long l = lg(g);
2113 272796 : V = zero_zv(n);
2114 740606 : for (i = 1; i < l; i++)
2115 467812 : if (mpodd(gel(e,i)))
2116 392723 : Flv_add_inplace(V, nfsign_arch(nf,gel(g,i),archp), 2);
2117 272794 : set_avma((pari_sp)V); return V;
2118 : }
2119 523187 : av = avma; V = cgetg(n+1,t_VECSMALL);
2120 523187 : x = nf_to_scalar_or_basis(nf, x);
2121 523186 : switch(typ(x))
2122 : {
2123 135680 : case t_INT:
2124 135680 : s = signe(x);
2125 135680 : if (!s) pari_err_DOMAIN("nfsign_arch","element","=",gen_0,x);
2126 135680 : set_avma(av); return const_vecsmall(n, (s < 0)? 1: 0);
2127 357 : case t_FRAC:
2128 357 : s = signe(gel(x,1));
2129 357 : set_avma(av); return const_vecsmall(n, (s < 0)? 1: 0);
2130 : }
2131 387149 : x = Q_primpart(x); M = nf_get_M(nf); sarch = NULL; np = -1;
2132 1143069 : for (i = 1; i <= n; i++)
2133 : {
2134 756733 : long s = eval_sign(M, x, archp[i]);
2135 756724 : if (s < 0) /* failure */
2136 : {
2137 844 : long ni, r1 = nf_get_r1(nf);
2138 : GEN xi;
2139 844 : if (np < 0)
2140 : {
2141 844 : np = num_positive(nf, x);
2142 844 : if (np == 0) { set_avma(av); return const_vecsmall(n, 1); }
2143 813 : if (np == r1){ set_avma(av); return const_vecsmall(n, 0); }
2144 415 : sarch = nfarchstar(nf, NULL, identity_perm(r1));
2145 : }
2146 415 : xi = set_sign_mod_divisor(nf, vecsmall_ei(r1, archp[i]), gen_1, sarch);
2147 415 : xi = Q_primpart(xi);
2148 415 : ni = num_positive(nf, nfmuli(nf,x,xi));
2149 415 : if (ni == 0) { set_avma(av); V = const_vecsmall(n, 1); V[i] = 0; return V; }
2150 415 : if (ni == r1){ set_avma(av); V = const_vecsmall(n, 0); V[i] = 1; return V; }
2151 33 : s = ni < np? 0: 1;
2152 : }
2153 755913 : V[i] = s;
2154 : }
2155 386336 : set_avma((pari_sp)V); return V;
2156 : }
2157 : static void
2158 6405 : chk_ind(const char *s, long i, long r1)
2159 : {
2160 6405 : if (i <= 0) pari_err_DOMAIN(s, "index", "<=", gen_0, stoi(i));
2161 6391 : if (i > r1) pari_err_DOMAIN(s, "index", ">", utoi(r1), utoi(i));
2162 6356 : }
2163 : static GEN
2164 95424 : parse_embed(GEN ind, long r, const char *f)
2165 : {
2166 : long l, i;
2167 95424 : if (!ind) return identity_perm(r);
2168 4375 : switch(typ(ind))
2169 : {
2170 70 : case t_INT: ind = mkvecsmall(itos(ind)); break;
2171 84 : case t_VEC: case t_COL: ind = vec_to_vecsmall(ind); break;
2172 4221 : case t_VECSMALL: break;
2173 0 : default: pari_err_TYPE(f, ind);
2174 : }
2175 4375 : l = lg(ind);
2176 10731 : for (i = 1; i < l; i++) chk_ind(f, ind[i], r);
2177 4326 : return ind;
2178 : }
2179 : GEN
2180 93674 : nfeltsign(GEN nf, GEN x, GEN ind0)
2181 : {
2182 93674 : pari_sp av = avma;
2183 : long i, l;
2184 : GEN v, ind;
2185 93674 : nf = checknf(nf);
2186 93674 : ind = parse_embed(ind0, nf_get_r1(nf), "nfeltsign");
2187 93653 : l = lg(ind);
2188 93653 : if (is_rational_t(typ(x)))
2189 : { /* nfsign_arch would test this, but avoid converting t_VECSMALL -> t_VEC */
2190 : GEN s;
2191 2093 : switch(gsigne(x))
2192 : {
2193 525 : case -1:s = gen_m1; break;
2194 1561 : case 1: s = gen_1; break;
2195 7 : default: s = gen_0; break;
2196 : }
2197 2093 : set_avma(av);
2198 2093 : return (ind0 && typ(ind0) == t_INT)? s: const_vec(l-1, s);
2199 : }
2200 91560 : v = nfsign_arch(nf, x, ind);
2201 91560 : if (ind0 && typ(ind0) == t_INT) { set_avma(av); return v[1]? gen_m1: gen_1; }
2202 91546 : settyp(v, t_VEC);
2203 259154 : for (i = 1; i < l; i++) gel(v,i) = v[i]? gen_m1: gen_1;
2204 91546 : return gerepileupto(av, v);
2205 : }
2206 :
2207 : GEN
2208 273 : nfeltembed(GEN nf, GEN x, GEN ind0, long prec0)
2209 : {
2210 273 : pari_sp av = avma;
2211 : long i, e, l, r1, r2, prec, prec1;
2212 : GEN v, ind, cx;
2213 273 : nf = checknf(nf); nf_get_sign(nf,&r1,&r2);
2214 273 : x = nf_to_scalar_or_basis(nf, x);
2215 266 : ind = parse_embed(ind0, r1+r2, "nfeltembed");
2216 259 : l = lg(ind);
2217 259 : if (typ(x) != t_COL)
2218 : {
2219 0 : if (!(ind0 && typ(ind0) == t_INT)) x = const_vec(l-1, x);
2220 0 : return gerepilecopy(av, x);
2221 : }
2222 259 : x = Q_primitive_part(x, &cx);
2223 259 : prec1 = prec0; e = gexpo(x);
2224 259 : if (e > 8) prec1 += nbits2extraprec(e);
2225 259 : prec = prec1;
2226 259 : if (nf_get_prec(nf) < prec) nf = nfnewprec_shallow(nf, prec);
2227 259 : v = cgetg(l, t_VEC);
2228 : for(;;)
2229 41 : {
2230 300 : GEN M = nf_get_M(nf);
2231 888 : for (i = 1; i < l; i++)
2232 : {
2233 629 : GEN t = nfembed_i(M, x, ind[i]);
2234 629 : long e = gexpo(t);
2235 629 : if (gequal0(t) || precision(t) < prec0
2236 629 : || (e < 0 && prec < prec1 + nbits2extraprec(-e)) ) break;
2237 588 : if (cx) t = gmul(t, cx);
2238 588 : gel(v,i) = t;
2239 : }
2240 300 : if (i == l) break;
2241 41 : prec = precdbl(prec);
2242 41 : if (DEBUGLEVEL>1) pari_warn(warnprec,"eltnfembed", prec);
2243 41 : nf = nfnewprec_shallow(nf, prec);
2244 : }
2245 259 : if (ind0 && typ(ind0) == t_INT) v = gel(v,1);
2246 259 : return gerepilecopy(av, v);
2247 : }
2248 :
2249 : /* number of distinct roots of sigma(f) */
2250 : GEN
2251 1484 : nfpolsturm(GEN nf, GEN f, GEN ind0)
2252 : {
2253 1484 : pari_sp av = avma;
2254 : long d, l, r1, single;
2255 : GEN ind, u, v, vr1, T, s, t;
2256 :
2257 1484 : nf = checknf(nf); T = nf_get_pol(nf); r1 = nf_get_r1(nf);
2258 1484 : ind = parse_embed(ind0, r1, "nfpolsturm");
2259 1463 : single = ind0 && typ(ind0) == t_INT;
2260 1463 : l = lg(ind);
2261 :
2262 1463 : if (gequal0(f)) pari_err_ROOTS0("nfpolsturm");
2263 1456 : if (typ(f) == t_POL && varn(f) != varn(T))
2264 : {
2265 1435 : f = RgX_nffix("nfpolsturm", T, f,1);
2266 1435 : if (lg(f) == 3) f = NULL;
2267 : }
2268 : else
2269 : {
2270 21 : (void)Rg_nffix("nfpolsturm", T, f, 0);
2271 21 : f = NULL;
2272 : }
2273 1456 : if (!f) { set_avma(av); return single? gen_0: zerovec(l-1); }
2274 1435 : d = degpol(f);
2275 1435 : if (d == 1) { set_avma(av); return single? gen_1: const_vec(l-1,gen_1); }
2276 :
2277 1400 : vr1 = const_vecsmall(l-1, 1);
2278 1400 : u = Q_primpart(f); s = ZV_to_zv(nfeltsign(nf, gel(u,d+2), ind));
2279 1400 : v = RgX_deriv(u); t = odd(d)? leafcopy(s): zv_neg(s);
2280 : for(;;)
2281 182 : {
2282 1582 : GEN r = RgX_neg( Q_primpart(RgX_pseudorem(u, v)) ), sr;
2283 1582 : long i, dr = degpol(r);
2284 1582 : if (dr < 0) break;
2285 1582 : sr = ZV_to_zv(nfeltsign(nf, gel(r,dr+2), ind));
2286 3948 : for (i = 1; i < l; i++)
2287 2366 : if (sr[i] != s[i]) { s[i] = sr[i], vr1[i]--; }
2288 1582 : if (odd(dr)) sr = zv_neg(sr);
2289 3948 : for (i = 1; i < l; i++)
2290 2366 : if (sr[i] != t[i]) { t[i] = sr[i], vr1[i]++; }
2291 1582 : if (!dr) break;
2292 182 : u = v; v = r;
2293 : }
2294 1400 : if (single) { set_avma(av); return stoi(vr1[1]); }
2295 1393 : return gerepileupto(av, zv_to_ZV(vr1));
2296 : }
2297 :
2298 : /* True nf; return the vector of signs of x; the matrix of such if x is a vector
2299 : * of nf elements */
2300 : GEN
2301 43848 : nfsign(GEN nf, GEN x)
2302 : {
2303 : long i, l;
2304 : GEN archp, S;
2305 :
2306 43848 : archp = identity_perm( nf_get_r1(nf) );
2307 43848 : if (typ(x) != t_VEC) return nfsign_arch(nf, x, archp);
2308 35938 : l = lg(x); S = cgetg(l, t_MAT);
2309 148062 : for (i=1; i<l; i++) gel(S,i) = nfsign_arch(nf, gel(x,i), archp);
2310 35938 : return S;
2311 : }
2312 :
2313 : /* x integral elt, A integral ideal in HNF; reduce x mod A */
2314 : static GEN
2315 7826410 : zk_modHNF(GEN x, GEN A)
2316 7826410 : { return (typ(x) == t_COL)? ZC_hnfrem(x, A): modii(x, gcoeff(A,1,1)); }
2317 :
2318 : /* given an element x in Z_K and an integral ideal y in HNF, coprime with x,
2319 : outputs an element inverse of x modulo y */
2320 : GEN
2321 175 : nfinvmodideal(GEN nf, GEN x, GEN y)
2322 : {
2323 175 : pari_sp av = avma;
2324 175 : GEN a, yZ = gcoeff(y,1,1);
2325 :
2326 175 : if (equali1(yZ)) return gen_0;
2327 175 : x = nf_to_scalar_or_basis(nf, x);
2328 175 : if (typ(x) == t_INT) return gerepileupto(av, Fp_inv(x, yZ));
2329 :
2330 119 : a = hnfmerge_get_1(idealhnf_principal(nf,x), y);
2331 119 : if (!a) pari_err_INV("nfinvmodideal", x);
2332 119 : return gerepileupto(av, zk_modHNF(nfdiv(nf,a,x), y));
2333 : }
2334 :
2335 : static GEN
2336 3056430 : nfsqrmodideal(GEN nf, GEN x, GEN id)
2337 3056430 : { return zk_modHNF(nfsqri(nf,x), id); }
2338 : static GEN
2339 6560683 : nfmulmodideal(GEN nf, GEN x, GEN y, GEN id)
2340 6560683 : { return x? zk_modHNF(nfmuli(nf,x,y), id): y; }
2341 : /* assume x integral, k integer, A in HNF */
2342 : GEN
2343 4652583 : nfpowmodideal(GEN nf,GEN x,GEN k,GEN A)
2344 : {
2345 4652583 : long s = signe(k);
2346 : pari_sp av;
2347 : GEN y;
2348 :
2349 4652583 : if (!s) return gen_1;
2350 4652583 : av = avma;
2351 4652583 : x = nf_to_scalar_or_basis(nf, x);
2352 4652918 : if (typ(x) != t_COL) return Fp_pow(x, k, gcoeff(A,1,1));
2353 2154980 : if (s < 0) { k = negi(k); x = nfinvmodideal(nf, x,A); }
2354 2154980 : if (equali1(k)) return gerepileupto(av, s > 0? zk_modHNF(x, A): x);
2355 1212486 : for(y = NULL;;)
2356 : {
2357 4269024 : if (mpodd(k)) y = nfmulmodideal(nf,y,x,A);
2358 4268990 : k = shifti(k,-1); if (!signe(k)) break;
2359 3055957 : x = nfsqrmodideal(nf,x,A);
2360 : }
2361 1212486 : return gerepileupto(av, y);
2362 : }
2363 :
2364 : /* a * g^n mod id */
2365 : static GEN
2366 3603630 : nfmulpowmodideal(GEN nf, GEN a, GEN g, GEN n, GEN id)
2367 : {
2368 3603630 : return nfmulmodideal(nf, a, nfpowmodideal(nf,g,n,id), id);
2369 : }
2370 :
2371 : /* assume (num(g[i]), id) = 1 for all i. Return prod g[i]^e[i] mod id.
2372 : * EX = multiple of exponent of (O_K/id)^* */
2373 : GEN
2374 1616962 : famat_to_nf_modideal_coprime(GEN nf, GEN g, GEN e, GEN id, GEN EX)
2375 : {
2376 1616962 : GEN EXo2, plus = NULL, minus = NULL, idZ = gcoeff(id,1,1);
2377 1616962 : long i, lx = lg(g);
2378 :
2379 1616962 : if (equali1(idZ)) return gen_1; /* id = Z_K */
2380 1616464 : EXo2 = (expi(EX) > 10)? shifti(EX,-1): NULL;
2381 6066962 : for (i = 1; i < lx; i++)
2382 : {
2383 4450632 : GEN h, n = centermodii(gel(e,i), EX, EXo2);
2384 4450025 : long sn = signe(n);
2385 4450025 : if (!sn) continue;
2386 :
2387 2952639 : h = nf_to_scalar_or_basis(nf, gel(g,i));
2388 2953137 : switch(typ(h))
2389 : {
2390 1759650 : case t_INT: break;
2391 0 : case t_FRAC:
2392 0 : h = Fp_div(gel(h,1), gel(h,2), idZ); break;
2393 1193487 : default:
2394 : {
2395 : GEN dh;
2396 1193487 : h = Q_remove_denom(h, &dh);
2397 1193632 : if (dh) h = FpC_Fp_mul(h, Fp_inv(dh,idZ), idZ);
2398 : }
2399 : }
2400 2953201 : if (sn > 0)
2401 2951297 : plus = nfmulpowmodideal(nf, plus, h, n, id);
2402 : else /* sn < 0 */
2403 1904 : minus = nfmulpowmodideal(nf, minus, h, negi(n), id);
2404 : }
2405 1616330 : if (minus) plus = nfmulmodideal(nf, plus, nfinvmodideal(nf,minus,id), id);
2406 1616453 : return plus? plus: gen_1;
2407 : }
2408 :
2409 : /* given 2 integral ideals x, y in HNF s.t x | y | x^2, compute (1+x)/(1+y) in
2410 : * the form [[cyc],[gen], U], where U := ux^-1 as a pair [ZM, denom(U)] */
2411 : static GEN
2412 236427 : zidealij(GEN x, GEN y)
2413 : {
2414 236427 : GEN U, G, cyc, xp = gcoeff(x,1,1), xi = hnf_invscale(x, xp);
2415 : long j, N;
2416 :
2417 : /* x^(-1) y = relations between the 1 + x_i (HNF) */
2418 236419 : cyc = ZM_snf_group(ZM_Z_divexact(ZM_mul(xi, y), xp), &U, &G);
2419 236406 : N = lg(cyc); G = ZM_mul(x,G); settyp(G, t_VEC); /* new generators */
2420 572696 : for (j=1; j<N; j++)
2421 : {
2422 336297 : GEN c = gel(G,j);
2423 336297 : gel(c,1) = addiu(gel(c,1), 1); /* 1 + g_j */
2424 336259 : if (ZV_isscalar(c)) gel(G,j) = gel(c,1);
2425 : }
2426 236399 : return mkvec4(cyc, G, ZM_mul(U,xi), xp);
2427 : }
2428 :
2429 : /* lg(x) > 1, x + 1; shallow */
2430 : static GEN
2431 169507 : ZC_add1(GEN x)
2432 : {
2433 169507 : long i, l = lg(x);
2434 169507 : GEN y = cgetg(l, t_COL);
2435 395711 : for (i = 2; i < l; i++) gel(y,i) = gel(x,i);
2436 169509 : gel(y,1) = addiu(gel(x,1), 1); return y;
2437 : }
2438 : /* lg(x) > 1, x - 1; shallow */
2439 : static GEN
2440 70326 : ZC_sub1(GEN x)
2441 : {
2442 70326 : long i, l = lg(x);
2443 70326 : GEN y = cgetg(l, t_COL);
2444 176469 : for (i = 2; i < l; i++) gel(y,i) = gel(x,i);
2445 70325 : gel(y,1) = subiu(gel(x,1), 1); return y;
2446 : }
2447 :
2448 : /* x,y are t_INT or ZC */
2449 : static GEN
2450 0 : zkadd(GEN x, GEN y)
2451 : {
2452 0 : long tx = typ(x);
2453 0 : if (tx == typ(y))
2454 0 : return tx == t_INT? addii(x,y): ZC_add(x,y);
2455 : else
2456 0 : return tx == t_INT? ZC_Z_add(y,x): ZC_Z_add(x,y);
2457 : }
2458 : /* x a t_INT or ZC, x+1; shallow */
2459 : static GEN
2460 255119 : zkadd1(GEN x)
2461 : {
2462 255119 : long tx = typ(x);
2463 255119 : return tx == t_INT? addiu(x,1): ZC_add1(x);
2464 : }
2465 : /* x a t_INT or ZC, x-1; shallow */
2466 : static GEN
2467 255167 : zksub1(GEN x)
2468 : {
2469 255167 : long tx = typ(x);
2470 255167 : return tx == t_INT? subiu(x,1): ZC_sub1(x);
2471 : }
2472 : /* x,y are t_INT or ZC; x - y */
2473 : static GEN
2474 0 : zksub(GEN x, GEN y)
2475 : {
2476 0 : long tx = typ(x), ty = typ(y);
2477 0 : if (tx == ty)
2478 0 : return tx == t_INT? subii(x,y): ZC_sub(x,y);
2479 : else
2480 0 : return tx == t_INT? Z_ZC_sub(x,y): ZC_Z_sub(x,y);
2481 : }
2482 : /* x is t_INT or ZM (mult. map), y is t_INT or ZC; x * y */
2483 : static GEN
2484 255130 : zkmul(GEN x, GEN y)
2485 : {
2486 255130 : long tx = typ(x), ty = typ(y);
2487 255130 : if (ty == t_INT)
2488 184826 : return tx == t_INT? mulii(x,y): ZC_Z_mul(gel(x,1),y);
2489 : else
2490 70304 : return tx == t_INT? ZC_Z_mul(y,x): ZM_ZC_mul(x,y);
2491 : }
2492 :
2493 : /* (U,V) = 1 coprime ideals. Want z = x mod U, = y mod V; namely
2494 : * z =vx + uy = v(x-y) + y, where u + v = 1, u in U, v in V.
2495 : * zkc = [v, UV], v a t_INT or ZM (mult. by v map), UV a ZM (ideal in HNF);
2496 : * shallow */
2497 : GEN
2498 0 : zkchinese(GEN zkc, GEN x, GEN y)
2499 : {
2500 0 : GEN v = gel(zkc,1), UV = gel(zkc,2), z = zkadd(zkmul(v, zksub(x,y)), y);
2501 0 : return zk_modHNF(z, UV);
2502 : }
2503 : /* special case z = x mod U, = 1 mod V; shallow */
2504 : GEN
2505 255161 : zkchinese1(GEN zkc, GEN x)
2506 : {
2507 255161 : GEN v = gel(zkc,1), UV = gel(zkc,2), z = zkadd1(zkmul(v, zksub1(x)));
2508 255108 : return (typ(z) == t_INT)? z: ZC_hnfrem(z, UV);
2509 : }
2510 : static GEN
2511 237220 : zkVchinese1(GEN zkc, GEN v)
2512 : {
2513 : long i, ly;
2514 237220 : GEN y = cgetg_copy(v, &ly);
2515 492310 : for (i=1; i<ly; i++) gel(y,i) = zkchinese1(zkc, gel(v,i));
2516 237150 : return y;
2517 : }
2518 :
2519 : /* prepare to solve z = x (mod A), z = y mod (B) [zkchinese or zkchinese1] */
2520 : GEN
2521 236992 : zkchineseinit(GEN nf, GEN A, GEN B, GEN AB)
2522 : {
2523 236992 : GEN v = idealaddtoone_raw(nf, A, B);
2524 : long e;
2525 236969 : if ((e = gexpo(v)) > 5)
2526 : {
2527 83229 : GEN b = (typ(v) == t_COL)? v: scalarcol_shallow(v, nf_get_degree(nf));
2528 83229 : b= ZC_reducemodlll(b, AB);
2529 83228 : if (gexpo(b) < e) v = b;
2530 : }
2531 236963 : return mkvec2(zk_scalar_or_multable(nf,v), AB);
2532 : }
2533 : /* prepare to solve z = x (mod A), z = 1 mod (B)
2534 : * and then z = 1 (mod A), z = y mod (B) [zkchinese1 twice] */
2535 : static GEN
2536 259 : zkchinese1init2(GEN nf, GEN A, GEN B, GEN AB)
2537 : {
2538 259 : GEN zkc = zkchineseinit(nf, A, B, AB);
2539 259 : GEN mv = gel(zkc,1), mu;
2540 259 : if (typ(mv) == t_INT) return mkvec2(zkc, mkvec2(subui(1,mv),AB));
2541 35 : mu = RgM_Rg_add_shallow(ZM_neg(mv), gen_1);
2542 35 : return mkvec2(mkvec2(mv,AB), mkvec2(mu,AB));
2543 : }
2544 :
2545 : static GEN
2546 2141260 : apply_U(GEN L, GEN a)
2547 : {
2548 2141260 : GEN e, U = gel(L,3), dU = gel(L,4);
2549 2141260 : if (typ(a) == t_INT)
2550 664049 : e = ZC_Z_mul(gel(U,1), subiu(a, 1));
2551 : else
2552 : { /* t_COL */
2553 1477211 : GEN t = shallowcopy(a);
2554 1477262 : gel(t,1) = subiu(gel(t,1), 1); /* t = a - 1 */
2555 1477142 : e = ZM_ZC_mul(U, t);
2556 : }
2557 2141194 : return gdiv(e, dU);
2558 : }
2559 :
2560 : /* true nf; vectors of [[cyc],[g],U.X^-1]. Assume k > 1. */
2561 : static GEN
2562 168823 : principal_units(GEN nf, GEN pr, long k, GEN prk)
2563 : {
2564 : GEN list, prb;
2565 168823 : ulong mask = quadratic_prec_mask(k);
2566 168823 : long a = 1;
2567 :
2568 168823 : prb = pr_hnf(nf,pr);
2569 168825 : list = vectrunc_init(k);
2570 405248 : while (mask > 1)
2571 : {
2572 236427 : GEN pra = prb;
2573 236427 : long b = a << 1;
2574 :
2575 236427 : if (mask & 1) b--;
2576 236427 : mask >>= 1;
2577 : /* compute 1 + pr^a / 1 + pr^b, 2a <= b */
2578 236427 : prb = (b >= k)? prk: idealpows(nf,pr,b);
2579 236428 : vectrunc_append(list, zidealij(pra, prb));
2580 236426 : a = b;
2581 : }
2582 168821 : return list;
2583 : }
2584 : /* a = 1 mod (pr) return log(a) on local-gens of 1+pr/1+pr^k */
2585 : static GEN
2586 1323591 : log_prk1(GEN nf, GEN a, long nh, GEN L2, GEN prk)
2587 : {
2588 1323591 : GEN y = cgetg(nh+1, t_COL);
2589 1323595 : long j, iy, c = lg(L2)-1;
2590 3464806 : for (j = iy = 1; j <= c; j++)
2591 : {
2592 2141241 : GEN L = gel(L2,j), cyc = gel(L,1), gen = gel(L,2), E = apply_U(L,a);
2593 2141152 : long i, nc = lg(cyc)-1;
2594 2141152 : int last = (j == c);
2595 5791435 : for (i = 1; i <= nc; i++, iy++)
2596 : {
2597 3650224 : GEN t, e = gel(E,i);
2598 3650224 : if (typ(e) != t_INT) pari_err_COPRIME("zlog_prk1", a, prk);
2599 3650217 : t = Fp_neg(e, gel(cyc,i));
2600 3650177 : gel(y,iy) = negi(t);
2601 3650284 : if (!last && signe(t)) a = nfmulpowmodideal(nf, a, gel(gen,i), t, prk);
2602 : }
2603 : }
2604 1323565 : return y;
2605 : }
2606 : /* true nf */
2607 : static GEN
2608 56515 : principal_units_relations(GEN nf, GEN L2, GEN prk, long nh)
2609 : {
2610 56515 : GEN h = cgetg(nh+1,t_MAT);
2611 56515 : long ih, j, c = lg(L2)-1;
2612 180628 : for (j = ih = 1; j <= c; j++)
2613 : {
2614 124113 : GEN L = gel(L2,j), F = gel(L,1), G = gel(L,2);
2615 124113 : long k, lG = lg(G);
2616 303504 : for (k = 1; k < lG; k++,ih++)
2617 : { /* log(g^f) mod pr^e */
2618 179391 : GEN a = nfpowmodideal(nf,gel(G,k),gel(F,k),prk);
2619 179390 : gel(h,ih) = ZC_neg(log_prk1(nf, a, nh, L2, prk));
2620 179391 : gcoeff(h,ih,ih) = gel(F,k);
2621 : }
2622 : }
2623 56515 : return h;
2624 : }
2625 : /* true nf; k > 1; multiplicative group (1 + pr) / (1 + pr^k) */
2626 : static GEN
2627 168823 : idealprincipalunits_i(GEN nf, GEN pr, long k, GEN *pU)
2628 : {
2629 168823 : GEN cyc, gen, L2, prk = idealpows(nf, pr, k);
2630 :
2631 168823 : L2 = principal_units(nf, pr, k, prk);
2632 168824 : if (k == 2)
2633 : {
2634 112309 : GEN L = gel(L2,1);
2635 112309 : cyc = gel(L,1);
2636 112309 : gen = gel(L,2);
2637 112309 : if (pU) *pU = matid(lg(gen)-1);
2638 : }
2639 : else
2640 : {
2641 56515 : long c = lg(L2), j;
2642 56515 : GEN EX, h, Ui, vg = cgetg(c, t_VEC);
2643 180626 : for (j = 1; j < c; j++) gel(vg, j) = gmael(L2,j,2);
2644 56515 : vg = shallowconcat1(vg);
2645 56515 : h = principal_units_relations(nf, L2, prk, lg(vg)-1);
2646 56518 : h = ZM_hnfall_i(h, NULL, 0);
2647 56516 : cyc = ZM_snf_group(h, pU, &Ui);
2648 56518 : c = lg(Ui); gen = cgetg(c, t_VEC); EX = cyc_get_expo(cyc);
2649 187828 : for (j = 1; j < c; j++)
2650 131311 : gel(gen,j) = famat_to_nf_modideal_coprime(nf, vg, gel(Ui,j), prk, EX);
2651 : }
2652 168827 : return mkvec4(cyc, gen, prk, L2);
2653 : }
2654 : GEN
2655 119 : idealprincipalunits(GEN nf, GEN pr, long k)
2656 : {
2657 : pari_sp av;
2658 : GEN v;
2659 119 : nf = checknf(nf);
2660 119 : if (k == 1) { checkprid(pr); retmkvec3(gen_1,cgetg(1,t_VEC),cgetg(1,t_VEC)); }
2661 112 : av = avma; v = idealprincipalunits_i(nf, pr, k, NULL);
2662 112 : return gerepilecopy(av, mkvec3(powiu(pr_norm(pr), k-1), gel(v,1), gel(v,2)));
2663 : }
2664 :
2665 : /* true nf; given an ideal pr^k dividing an integral ideal x (in HNF form)
2666 : * compute an 'sprk', the structure of G = (Z_K/pr^k)^* [ x = NULL for x=pr^k ]
2667 : * Return a vector with at least 4 components [cyc],[gen],[HNF pr^k,pr,k],ff,
2668 : * where
2669 : * cyc : type of G as abelian group (SNF)
2670 : * gen : generators of G, coprime to x
2671 : * pr^k: in HNF
2672 : * ff : data for log_g in (Z_K/pr)^*
2673 : * Two extra components are present iff k > 1: L2, U
2674 : * L2 : list of data structures to compute local DL in (Z_K/pr)^*,
2675 : * and 1 + pr^a/ 1 + pr^b for various a < b <= min(2a, k)
2676 : * U : base change matrices to convert a vector of local DL to DL wrt gen
2677 : * If MOD is not NULL, initialize G / G^MOD instead */
2678 : static GEN
2679 425223 : sprkinit(GEN nf, GEN pr, long k, GEN x, GEN MOD)
2680 : {
2681 425223 : GEN T, p, Ld, modpr, cyc, gen, g, g0, A, prk, U, L2, ord0 = NULL;
2682 425223 : long f = pr_get_f(pr);
2683 :
2684 425221 : if(DEBUGLEVEL>3) err_printf("treating pr^%ld, pr = %Ps\n",k,pr);
2685 425221 : modpr = nf_to_Fq_init(nf, &pr,&T,&p);
2686 425229 : if (MOD)
2687 : {
2688 377895 : GEN A = subiu(powiu(p,f), 1), d = gcdii(A, MOD), fa = Z_factor(d);
2689 377864 : ord0 = mkvec2(A, fa); /* true order, factorization of order in G/G^MOD */
2690 377852 : Ld = gel(fa,1);
2691 377852 : if (lg(Ld) > 1 && equaliu(gel(Ld,1),2)) Ld = vecslice(Ld,2,lg(Ld)-1);
2692 : }
2693 : /* (Z_K / pr)^* */
2694 425200 : if (f == 1)
2695 : {
2696 336239 : g0 = g = MOD? pgener_Fp_local(p, Ld): pgener_Fp(p);
2697 336241 : if (!ord0) ord0 = get_arith_ZZM(subiu(p,1));
2698 : }
2699 : else
2700 : {
2701 88961 : g0 = g = MOD? gener_FpXQ_local(T, p, Ld): gener_FpXQ(T,p, &ord0);
2702 88962 : g = Fq_to_nf(g, modpr);
2703 88961 : if (typ(g) == t_POL) g = poltobasis(nf, g);
2704 : }
2705 425223 : A = gel(ord0, 1); /* Norm(pr)-1 */
2706 : /* If MOD != NULL, d = gcd(A, MOD): g^(A/d) has order d */
2707 425223 : if (k == 1)
2708 : {
2709 256512 : cyc = mkvec(A);
2710 256502 : gen = mkvec(g);
2711 256502 : prk = pr_hnf(nf,pr);
2712 256519 : L2 = U = NULL;
2713 : }
2714 : else
2715 : { /* local-gens of (1 + pr)/(1 + pr^k) = SNF-gens * U */
2716 : GEN AB, B, u, v, w;
2717 : long j, l;
2718 168711 : w = idealprincipalunits_i(nf, pr, k, &U);
2719 : /* incorporate (Z_K/pr)^*, order A coprime to B = expo(1+pr/1+pr^k)*/
2720 168713 : cyc = leafcopy(gel(w,1)); B = cyc_get_expo(cyc); AB = mulii(A,B);
2721 168687 : gen = leafcopy(gel(w,2));
2722 168695 : prk = gel(w,3);
2723 168695 : g = nfpowmodideal(nf, g, B, prk);
2724 168716 : g0 = Fq_pow(g0, modii(B,A), T, p); /* update primitive root */
2725 168704 : L2 = mkvec3(A, g, gel(w,4));
2726 168709 : gel(cyc,1) = AB;
2727 168709 : gel(gen,1) = nfmulmodideal(nf, gel(gen,1), g, prk);
2728 168701 : u = mulii(Fp_inv(A,B), A);
2729 168691 : v = subui(1, u); l = lg(U);
2730 504583 : for (j = 1; j < l; j++) gcoeff(U,1,j) = Fp_mul(u, gcoeff(U,1,j), AB);
2731 168698 : U = mkvec2(Rg_col_ei(v, lg(gen)-1, 1), U);
2732 : }
2733 : /* local-gens of (Z_K/pr^k)^* = SNF-gens * U */
2734 425226 : if (x)
2735 : {
2736 236726 : GEN uv = zkchineseinit(nf, idealmulpowprime(nf,x,pr,utoineg(k)), prk, x);
2737 236703 : gen = zkVchinese1(uv, gen);
2738 : }
2739 425145 : return mkvecn(U? 6: 4, cyc, gen, prk, mkvec3(modpr,g0,ord0), L2, U);
2740 : }
2741 : GEN
2742 2971307 : sprk_get_cyc(GEN s) { return gel(s,1); }
2743 : GEN
2744 966129 : sprk_get_expo(GEN s) { return cyc_get_expo(sprk_get_cyc(s)); }
2745 : GEN
2746 335346 : sprk_get_gen(GEN s) { return gel(s,2); }
2747 : GEN
2748 2904533 : sprk_get_prk(GEN s) { return gel(s,3); }
2749 : GEN
2750 1538655 : sprk_get_ff(GEN s) { return gel(s,4); }
2751 : GEN
2752 1598627 : sprk_get_pr(GEN s) { GEN ff = gel(s,4); return modpr_get_pr(gel(ff,1)); }
2753 : /* L2 to 1 + pr / 1 + pr^k */
2754 : static GEN
2755 1205751 : sprk_get_L2(GEN s) { return gmael(s,5,3); }
2756 : /* lift to nf of primitive root of k(pr) */
2757 : static GEN
2758 318892 : sprk_get_gnf(GEN s) { return gmael(s,5,2); }
2759 : /* A = Npr-1, <g> = (Z_K/pr)^*, L2 to 1 + pr / 1 + pr^k */
2760 : void
2761 0 : sprk_get_AgL2(GEN s, GEN *A, GEN *g, GEN *L2)
2762 0 : { GEN v = gel(s,5); *A = gel(v,1); *g = gel(v,2); *L2 = gel(v,3); }
2763 : void
2764 1197798 : sprk_get_U2(GEN s, GEN *U1, GEN *U2)
2765 1197798 : { GEN v = gel(s,6); *U1 = gel(v,1); *U2 = gel(v,2); }
2766 : static int
2767 1538631 : sprk_is_prime(GEN s) { return lg(s) == 5; }
2768 :
2769 : GEN
2770 965968 : famat_zlog_pr(GEN nf, GEN g, GEN e, GEN sprk, GEN mod)
2771 : {
2772 965968 : GEN x, expo = sprk_get_expo(sprk);
2773 965971 : if (mod) expo = gcdii(expo,mod);
2774 965952 : x = famat_makecoprime(nf, g, e, sprk_get_pr(sprk), sprk_get_prk(sprk), expo);
2775 965978 : return log_prk(nf, x, sprk, mod);
2776 : }
2777 : /* famat_zlog_pr assuming (g,sprk.pr) = 1 */
2778 : static GEN
2779 161 : famat_zlog_pr_coprime(GEN nf, GEN g, GEN e, GEN sprk, GEN MOD)
2780 : {
2781 161 : GEN x = famat_to_nf_modideal_coprime(nf, g, e, sprk_get_prk(sprk),
2782 : sprk_get_expo(sprk));
2783 161 : return log_prk(nf, x, sprk, MOD);
2784 : }
2785 :
2786 : /* o t_INT, O = [ord,fa] format for multiple of o (for Fq_log);
2787 : * return o in [ord,fa] format */
2788 : static GEN
2789 460250 : order_update(GEN o, GEN O)
2790 : {
2791 460250 : GEN p = gmael(O,2,1), z = o, P, E;
2792 460250 : long i, j, l = lg(p);
2793 460250 : P = cgetg(l, t_COL);
2794 460239 : E = cgetg(l, t_COL);
2795 511240 : for (i = j = 1; i < l; i++)
2796 : {
2797 511240 : long v = Z_pvalrem(z, gel(p,i), &z);
2798 511186 : if (v)
2799 : {
2800 496297 : gel(P,j) = gel(p,i);
2801 496297 : gel(E,j) = utoipos(v); j++;
2802 496325 : if (is_pm1(z)) break;
2803 : }
2804 : }
2805 460210 : setlg(P, j);
2806 460209 : setlg(E, j); return mkvec2(o, mkmat2(P,E));
2807 : }
2808 :
2809 : /* a in Z_K (t_COL or t_INT), pr prime ideal, sprk = sprkinit(nf,pr,k,x),
2810 : * mod positive t_INT or NULL (meaning mod=0).
2811 : * return log(a) modulo mod on SNF-generators of (Z_K/pr^k)^* */
2812 : GEN
2813 1612433 : log_prk(GEN nf, GEN a, GEN sprk, GEN mod)
2814 : {
2815 : GEN e, prk, g, U1, U2, y, ff, O, o, oN, gN, N, T, p, modpr, pr, cyc;
2816 :
2817 1612433 : if (typ(a) == t_MAT) return famat_zlog_pr(nf, gel(a,1), gel(a,2), sprk, mod);
2818 1538641 : N = NULL;
2819 1538641 : ff = sprk_get_ff(sprk);
2820 1538653 : pr = gel(ff,1); /* modpr */
2821 1538653 : g = gN = gel(ff,2);
2822 1538653 : O = gel(ff,3); /* order of g = |Fq^*|, in [ord, fa] format */
2823 1538653 : o = oN = gel(O,1); /* order as a t_INT */
2824 1538653 : prk = sprk_get_prk(sprk);
2825 1538659 : modpr = nf_to_Fq_init(nf, &pr, &T, &p);
2826 1538655 : if (mod)
2827 : {
2828 1022951 : GEN d = gcdii(o,mod);
2829 1022611 : if (!equalii(o, d))
2830 : {
2831 650110 : N = diviiexact(o,d); /* > 1, coprime to p */
2832 650054 : a = nfpowmodideal(nf, a, N, prk);
2833 650226 : oN = d; /* order of g^N mod pr */
2834 : }
2835 : }
2836 1538455 : if (equali1(oN))
2837 395513 : e = gen_0;
2838 : else
2839 : {
2840 1143051 : if (N) { O = order_update(oN, O); gN = Fq_pow(g, N, T, p); }
2841 1143031 : e = Fq_log(nf_to_Fq(nf,a,modpr), gN, O, T, p);
2842 : }
2843 : /* 0 <= e < oN is correct modulo oN */
2844 1538643 : if (sprk_is_prime(sprk)) return mkcol(e); /* k = 1 */
2845 :
2846 798018 : sprk_get_U2(sprk, &U1,&U2);
2847 798100 : cyc = sprk_get_cyc(sprk);
2848 798103 : if (mod)
2849 : {
2850 376976 : cyc = ZV_snf_gcd(cyc, mod);
2851 376937 : if (signe(remii(mod,p))) return vecmodii(ZC_Z_mul(U1,e), cyc);
2852 : }
2853 744479 : if (signe(e))
2854 : {
2855 318892 : GEN E = N? mulii(e, N): e;
2856 318892 : a = nfmulpowmodideal(nf, a, sprk_get_gnf(sprk), Fp_neg(E, o), prk);
2857 : }
2858 : /* a = 1 mod pr */
2859 744479 : y = log_prk1(nf, a, lg(U2)-1, sprk_get_L2(sprk), prk);
2860 744520 : if (N)
2861 : { /* from DL(a^N) to DL(a) */
2862 134902 : GEN E = gel(sprk_get_cyc(sprk), 1), q = powiu(p, Z_pval(E, p));
2863 134900 : y = ZC_Z_mul(y, Fp_inv(N, q));
2864 : }
2865 744519 : y = ZC_lincomb(gen_1, e, ZM_ZC_mul(U2,y), U1);
2866 744517 : return vecmodii(y, cyc);
2867 : }
2868 : /* true nf */
2869 : GEN
2870 89934 : log_prk_init(GEN nf, GEN pr, long k, GEN MOD)
2871 89934 : { return sprkinit(nf,pr,k,NULL,MOD);}
2872 : GEN
2873 497 : veclog_prk(GEN nf, GEN v, GEN sprk)
2874 : {
2875 497 : long l = lg(v), i;
2876 497 : GEN w = cgetg(l, t_MAT);
2877 1232 : for (i = 1; i < l; i++) gel(w,i) = log_prk(nf, gel(v,i), sprk, NULL);
2878 497 : return w;
2879 : }
2880 :
2881 : static GEN
2882 376096 : famat_zlog(GEN nf, GEN fa, GEN sgn, zlog_S *S)
2883 : {
2884 376096 : long i, l0, l = lg(S->U);
2885 376096 : GEN g = gel(fa,1), e = gel(fa,2), y = cgetg(l, t_COL);
2886 376097 : l0 = lg(S->sprk); /* = l (trivial arch. part), or l-1 */
2887 851340 : for (i=1; i < l0; i++) gel(y,i) = famat_zlog_pr(nf, g, e, gel(S->sprk,i), S->mod);
2888 376101 : if (l0 != l)
2889 : {
2890 187564 : if (!sgn) sgn = nfsign_arch(nf, fa, S->archp);
2891 187564 : gel(y,l0) = Flc_to_ZC(sgn);
2892 : }
2893 376101 : return y;
2894 : }
2895 :
2896 : /* assume that cyclic factors are normalized, in particular != [1] */
2897 : static GEN
2898 256725 : split_U(GEN U, GEN Sprk)
2899 : {
2900 256725 : long t = 0, k, n, l = lg(Sprk);
2901 256725 : GEN vU = cgetg(l+1, t_VEC);
2902 591284 : for (k = 1; k < l; k++)
2903 : {
2904 334558 : n = lg(sprk_get_cyc(gel(Sprk,k))) - 1; /* > 0 */
2905 334557 : gel(vU,k) = vecslice(U, t+1, t+n);
2906 334561 : t += n;
2907 : }
2908 : /* t+1 .. lg(U)-1 */
2909 256726 : n = lg(U) - t - 1; /* can be 0 */
2910 256726 : if (!n) setlg(vU,l); else gel(vU,l) = vecslice(U, t+1, t+n);
2911 256731 : return vU;
2912 : }
2913 :
2914 : static void
2915 988139 : init_zlog_mod(zlog_S *S, GEN bid, GEN mod)
2916 : {
2917 988139 : GEN fa2 = bid_get_fact2(bid);
2918 988289 : S->U = bid_get_U(bid);
2919 988291 : S->hU = lg(bid_get_cyc(bid))-1;
2920 988285 : S->archp = bid_get_archp(bid);
2921 988279 : S->sprk = bid_get_sprk(bid);
2922 988272 : S->bid = bid;
2923 988272 : S->mod = mod;
2924 988272 : S->P = gel(fa2,1);
2925 988272 : S->k = gel(fa2,2);
2926 988272 : S->no2 = lg(S->P) == lg(gel(bid_get_fact(bid),1));
2927 988279 : }
2928 : void
2929 377114 : init_zlog(zlog_S *S, GEN bid)
2930 : {
2931 377114 : return init_zlog_mod(S, bid, NULL);
2932 : }
2933 :
2934 : /* a a t_FRAC/t_INT, reduce mod bid */
2935 : static GEN
2936 14 : Q_mod_bid(GEN bid, GEN a)
2937 : {
2938 14 : GEN xZ = gcoeff(bid_get_ideal(bid),1,1);
2939 14 : GEN b = Rg_to_Fp(a, xZ);
2940 14 : if (gsigne(a) < 0) b = subii(b, xZ);
2941 14 : return signe(b)? b: xZ;
2942 : }
2943 : /* Return decomposition of a on the CRT generators blocks attached to the
2944 : * S->sprk and sarch; sgn = sign(a, S->arch), NULL if unknown */
2945 : static GEN
2946 380297 : zlog(GEN nf, GEN a, GEN sgn, zlog_S *S)
2947 : {
2948 : long k, l;
2949 : GEN y;
2950 380297 : a = nf_to_scalar_or_basis(nf, a);
2951 380291 : switch(typ(a))
2952 : {
2953 161990 : case t_INT: break;
2954 14 : case t_FRAC: a = Q_mod_bid(S->bid, a); break;
2955 218287 : default: /* case t_COL: */
2956 : {
2957 : GEN den;
2958 218287 : check_nfelt(a, &den);
2959 218303 : if (den)
2960 : {
2961 105 : a = Q_muli_to_int(a, den);
2962 105 : a = mkmat2(mkcol2(a, den), mkcol2(gen_1, gen_m1));
2963 105 : return famat_zlog(nf, a, sgn, S);
2964 : }
2965 : }
2966 : }
2967 380192 : if (sgn)
2968 373696 : sgn = (lg(sgn) == 1)? NULL: leafcopy(sgn);
2969 : else
2970 6496 : sgn = (lg(S->archp) == 1)? NULL: nfsign_arch(nf, a, S->archp);
2971 380197 : l = lg(S->sprk);
2972 380197 : y = cgetg(sgn? l+1: l, t_COL);
2973 920175 : for (k = 1; k < l; k++)
2974 : {
2975 540050 : GEN sprk = gel(S->sprk,k);
2976 540050 : gel(y,k) = log_prk(nf, a, sprk, S->mod);
2977 : }
2978 380125 : if (sgn) gel(y,l) = Flc_to_ZC(sgn);
2979 380136 : return y;
2980 : }
2981 :
2982 : /* true nf */
2983 : GEN
2984 43259 : pr_basis_perm(GEN nf, GEN pr)
2985 : {
2986 43259 : long f = pr_get_f(pr);
2987 : GEN perm;
2988 43259 : if (f == nf_get_degree(nf)) return identity_perm(f);
2989 37988 : perm = cgetg(f+1, t_VECSMALL);
2990 37988 : perm[1] = 1;
2991 37988 : if (f > 1)
2992 : {
2993 2912 : GEN H = pr_hnf(nf,pr);
2994 : long i, k;
2995 10815 : for (i = k = 2; k <= f; i++)
2996 7903 : if (!equali1(gcoeff(H,i,i))) perm[k++] = i;
2997 : }
2998 37988 : return perm;
2999 : }
3000 :
3001 : /* \sum U[i]*y[i], U[i] ZM, y[i] ZC. We allow lg(y) > lg(U). */
3002 : static GEN
3003 756325 : ZMV_ZCV_mul(GEN U, GEN y)
3004 : {
3005 756325 : long i, l = lg(U);
3006 756325 : GEN z = NULL;
3007 756325 : if (l == 1) return cgetg(1,t_COL);
3008 2132860 : for (i = 1; i < l; i++)
3009 : {
3010 1376637 : GEN u = ZM_ZC_mul(gel(U,i), gel(y,i));
3011 1376613 : z = z? ZC_add(z, u): u;
3012 : }
3013 756223 : return z;
3014 : }
3015 : /* A * (U[1], ..., U[d] */
3016 : static GEN
3017 518 : ZM_ZMV_mul(GEN A, GEN U)
3018 : {
3019 : long i, l;
3020 518 : GEN V = cgetg_copy(U,&l);
3021 1057 : for (i = 1; i < l; i++) gel(V,i) = ZM_mul(A,gel(U,i));
3022 518 : return V;
3023 : }
3024 :
3025 : /* a = 1 mod pr, sprk mod pr^e, e >= 1 */
3026 : static GEN
3027 399720 : sprk_log_prk1_2(GEN nf, GEN a, GEN sprk)
3028 : {
3029 399720 : GEN U1, U2, y, L2 = sprk_get_L2(sprk);
3030 399719 : sprk_get_U2(sprk, &U1,&U2);
3031 399722 : y = ZM_ZC_mul(U2, log_prk1(nf, a, lg(U2)-1, L2, sprk_get_prk(sprk)));
3032 399711 : return vecmodii(y, sprk_get_cyc(sprk));
3033 : }
3034 : /* true nf; assume e >= 2 */
3035 : GEN
3036 104559 : sprk_log_gen_pr2(GEN nf, GEN sprk, long e)
3037 : {
3038 104559 : GEN M, G, pr = sprk_get_pr(sprk);
3039 : long i, l;
3040 104559 : if (e == 2)
3041 : {
3042 61555 : GEN L2 = sprk_get_L2(sprk), L = gel(L2,1);
3043 61555 : G = gel(L,2); l = lg(G);
3044 : }
3045 : else
3046 : {
3047 43004 : GEN perm = pr_basis_perm(nf,pr), PI = nfpow_u(nf, pr_get_gen(pr), e-1);
3048 43008 : l = lg(perm);
3049 43008 : G = cgetg(l, t_VEC);
3050 43008 : if (typ(PI) == t_INT)
3051 : { /* zk_ei_mul doesn't allow t_INT */
3052 5264 : long N = nf_get_degree(nf);
3053 5264 : gel(G,1) = addiu(PI,1);
3054 8239 : for (i = 2; i < l; i++)
3055 : {
3056 2975 : GEN z = col_ei(N, 1);
3057 2975 : gel(G,i) = z; gel(z, perm[i]) = PI;
3058 : }
3059 : }
3060 : else
3061 : {
3062 37744 : gel(G,1) = nfadd(nf, gen_1, PI);
3063 44527 : for (i = 2; i < l; i++)
3064 6783 : gel(G,i) = nfadd(nf, gen_1, zk_ei_mul(nf, PI, perm[i]));
3065 : }
3066 : }
3067 104563 : M = cgetg(l, t_MAT);
3068 231720 : for (i = 1; i < l; i++) gel(M,i) = sprk_log_prk1_2(nf, gel(G,i), sprk);
3069 104549 : return M;
3070 : }
3071 : /* Log on bid.gen of generators of P_{1,I pr^{e-1}} / P_{1,I pr^e} (I,pr) = 1,
3072 : * defined implicitly via CRT. 'ind' is the index of pr in modulus
3073 : * factorization; true nf */
3074 : GEN
3075 410425 : log_gen_pr(zlog_S *S, long ind, GEN nf, long e)
3076 : {
3077 410425 : GEN Uind = gel(S->U, ind);
3078 410425 : if (e == 1) retmkmat( gel(Uind,1) );
3079 101906 : return ZM_mul(Uind, sprk_log_gen_pr2(nf, gel(S->sprk,ind), e));
3080 : }
3081 : /* true nf */
3082 : GEN
3083 2037 : sprk_log_gen_pr(GEN nf, GEN sprk, long e)
3084 : {
3085 2037 : if (e == 1)
3086 : {
3087 0 : long n = lg(sprk_get_cyc(sprk))-1;
3088 0 : retmkmat(col_ei(n, 1));
3089 : }
3090 2037 : return sprk_log_gen_pr2(nf, sprk, e);
3091 : }
3092 : /* a = 1 mod pr */
3093 : GEN
3094 272549 : sprk_log_prk1(GEN nf, GEN a, GEN sprk)
3095 : {
3096 272549 : if (lg(sprk) == 5) return mkcol(gen_0); /* mod pr */
3097 272549 : return sprk_log_prk1_2(nf, a, sprk);
3098 : }
3099 : /* Log on bid.gen of generator of P_{1,f} / P_{1,f v[index]}
3100 : * v = vector of r1 real places */
3101 : GEN
3102 85300 : log_gen_arch(zlog_S *S, long index)
3103 : {
3104 85300 : GEN U = gel(S->U, lg(S->U)-1);
3105 85300 : return gel(U, index);
3106 : }
3107 :
3108 : /* compute bid.clgp: [h,cyc] or [h,cyc,gen] */
3109 : static GEN
3110 257768 : bid_grp(GEN nf, GEN U, GEN cyc, GEN g, GEN F, GEN sarch)
3111 : {
3112 257768 : GEN G, h = ZV_prod(cyc);
3113 : long c;
3114 257794 : if (!U) return mkvec2(h,cyc);
3115 257458 : c = lg(U);
3116 257458 : G = cgetg(c,t_VEC);
3117 257456 : if (c > 1)
3118 : {
3119 227652 : GEN U0, Uoo, EX = cyc_get_expo(cyc); /* exponent of bid */
3120 227652 : long i, hU = nbrows(U), nba = lg(sarch_get_cyc(sarch))-1; /* #f_oo */
3121 227661 : if (!nba) { U0 = U; Uoo = NULL; }
3122 80222 : else if (nba == hU) { U0 = NULL; Uoo = U; }
3123 : else
3124 : {
3125 71129 : U0 = rowslice(U, 1, hU-nba);
3126 71131 : Uoo = rowslice(U, hU-nba+1, hU);
3127 : }
3128 694329 : for (i = 1; i < c; i++)
3129 : {
3130 466672 : GEN t = gen_1;
3131 466672 : if (U0) t = famat_to_nf_modideal_coprime(nf, g, gel(U0,i), F, EX);
3132 466659 : if (Uoo) t = set_sign_mod_divisor(nf, ZV_to_Flv(gel(Uoo,i),2), t, sarch);
3133 466667 : gel(G,i) = t;
3134 : }
3135 : }
3136 257461 : return mkvec3(h, cyc, G);
3137 : }
3138 :
3139 : /* remove prime ideals of norm 2 with exponent 1 from factorization */
3140 : static GEN
3141 258022 : famat_strip2(GEN fa)
3142 : {
3143 258022 : GEN P = gel(fa,1), E = gel(fa,2), Q, F;
3144 258022 : long l = lg(P), i, j;
3145 258022 : Q = cgetg(l, t_COL);
3146 258018 : F = cgetg(l, t_COL);
3147 632489 : for (i = j = 1; i < l; i++)
3148 : {
3149 374467 : GEN pr = gel(P,i), e = gel(E,i);
3150 374467 : if (!absequaliu(pr_get_p(pr), 2) || itou(e) != 1 || pr_get_f(pr) != 1)
3151 : {
3152 335866 : gel(Q,j) = pr;
3153 335866 : gel(F,j) = e; j++;
3154 : }
3155 : }
3156 258022 : setlg(Q,j);
3157 258020 : setlg(F,j); return mkmat2(Q,F);
3158 : }
3159 : static int
3160 133959 : checkarchp(GEN v, long r1)
3161 : {
3162 133959 : long i, l = lg(v);
3163 133959 : pari_sp av = avma;
3164 : GEN p;
3165 133959 : if (l == 1) return 1;
3166 47036 : if (l == 2) return v[1] > 0 && v[1] <= r1;
3167 21992 : p = zero_zv(r1);
3168 66078 : for (i = 1; i < l; i++)
3169 : {
3170 44115 : long j = v[i];
3171 44115 : if (j <= 0 || j > r1 || p[j]) return gc_long(av, 0);
3172 44080 : p[j] = 1;
3173 : }
3174 21963 : return gc_long(av, 1);
3175 : }
3176 :
3177 : /* True nf. Put ideal to form [[ideal,arch]] and set fa and fa2 to its
3178 : * factorization, archp to the indices of arch places */
3179 : GEN
3180 257970 : check_mod_factored(GEN nf, GEN ideal, GEN *fa_, GEN *fa2_, GEN *archp_, GEN MOD)
3181 : {
3182 : GEN arch, x, fa, fa2, archp;
3183 : long R1;
3184 :
3185 257970 : R1 = nf_get_r1(nf);
3186 257998 : if (typ(ideal) == t_VEC && lg(ideal) == 3)
3187 : {
3188 178074 : arch = gel(ideal,2);
3189 178074 : ideal= gel(ideal,1);
3190 356110 : switch(typ(arch))
3191 : {
3192 44114 : case t_VEC:
3193 44114 : if (lg(arch) != R1+1)
3194 7 : pari_err_TYPE("Idealstar [incorrect archimedean component]",arch);
3195 44107 : archp = vec01_to_indices(arch);
3196 44107 : break;
3197 133960 : case t_VECSMALL:
3198 133960 : if (!checkarchp(arch, R1))
3199 35 : pari_err_TYPE("Idealstar [incorrect archimedean component]",arch);
3200 133928 : archp = arch;
3201 133928 : arch = indices_to_vec01(archp, R1);
3202 133929 : break;
3203 0 : default:
3204 0 : pari_err_TYPE("Idealstar [incorrect archimedean component]",arch);
3205 : return NULL;/*LCOV_EXCL_LINE*/
3206 : }
3207 : }
3208 : else
3209 : {
3210 79924 : arch = zerovec(R1);
3211 79910 : archp = cgetg(1, t_VECSMALL);
3212 : }
3213 257944 : if (MOD)
3214 : {
3215 213536 : if (typ(MOD) != t_INT) pari_err_TYPE("bnrinit [incorrect cycmod]", MOD);
3216 213536 : if (mpodd(MOD) && lg(archp) != 1)
3217 231 : MOD = shifti(MOD, 1); /* ensure elements of G^MOD are >> 0 */
3218 : }
3219 257941 : if (is_nf_factor(ideal))
3220 : {
3221 39788 : fa = ideal;
3222 39788 : x = factorbackprime(nf, gel(fa,1), gel(fa,2));
3223 : }
3224 : else
3225 : {
3226 218149 : fa = idealfactor(nf, ideal);
3227 218208 : x = ideal;
3228 : }
3229 257996 : if (typ(x) != t_MAT) x = idealhnf_shallow(nf, x);
3230 257973 : if (lg(x) == 1) pari_err_DOMAIN("Idealstar", "ideal","=",gen_0,x);
3231 257973 : if (typ(gcoeff(x,1,1)) != t_INT)
3232 7 : pari_err_DOMAIN("Idealstar","denominator(ideal)", "!=",gen_1,x);
3233 :
3234 257966 : fa2 = famat_strip2(fa);
3235 257957 : if (fa_ != NULL) *fa_ = fa;
3236 257957 : if (fa2_ != NULL) *fa2_ = fa2;
3237 257957 : if (fa2_ != NULL) *archp_ = archp;
3238 257957 : return mkvec2(x, arch);
3239 : }
3240 :
3241 : /* True nf. Compute [[ideal,arch], [h,[cyc],[gen]], idealfact, [liste], U]
3242 : flag may include nf_GEN | nf_INIT */
3243 : static GEN
3244 257429 : Idealstarmod_i(GEN nf, GEN ideal, long flag, GEN MOD)
3245 : {
3246 : long i, nbp;
3247 257429 : GEN y, cyc, U, u1 = NULL, fa, fa2, sprk, x_arch, x, arch, archp, E, P, sarch, gen;
3248 :
3249 257429 : x_arch = check_mod_factored(nf, ideal, &fa, &fa2, &archp, MOD);
3250 257421 : x = gel(x_arch, 1);
3251 257421 : arch = gel(x_arch, 2);
3252 :
3253 257421 : sarch = nfarchstar(nf, x, archp);
3254 257419 : P = gel(fa2,1);
3255 257419 : E = gel(fa2,2);
3256 257419 : nbp = lg(P)-1;
3257 257419 : sprk = cgetg(nbp+1,t_VEC);
3258 257429 : if (nbp)
3259 : {
3260 218489 : GEN t = (lg(gel(fa,1))==2)? NULL: x; /* beware fa != fa2 */
3261 218489 : cyc = cgetg(nbp+2,t_VEC);
3262 218481 : gen = cgetg(nbp+1,t_VEC);
3263 553793 : for (i = 1; i <= nbp; i++)
3264 : {
3265 335291 : GEN L = sprkinit(nf, gel(P,i), itou(gel(E,i)), t, MOD);
3266 335290 : gel(sprk,i) = L;
3267 335290 : gel(cyc,i) = sprk_get_cyc(L);
3268 : /* true gens are congruent to those mod x AND positive at archp */
3269 335289 : gel(gen,i) = sprk_get_gen(L);
3270 : }
3271 218502 : gel(cyc,i) = sarch_get_cyc(sarch);
3272 218501 : cyc = shallowconcat1(cyc);
3273 218509 : gen = shallowconcat1(gen);
3274 218509 : cyc = ZV_snf_group(cyc, &U, (flag & nf_GEN)? &u1: NULL);
3275 : }
3276 : else
3277 : {
3278 38940 : cyc = sarch_get_cyc(sarch);
3279 38940 : gen = cgetg(1,t_VEC);
3280 38940 : U = matid(lg(cyc)-1);
3281 38940 : if (flag & nf_GEN) u1 = U;
3282 : }
3283 257414 : y = bid_grp(nf, u1, cyc, gen, x, sarch);
3284 257440 : if (!(flag & nf_INIT)) return y;
3285 256628 : U = split_U(U, sprk);
3286 256626 : return mkvec5(mkvec2(x, arch), y, mkvec2(fa,fa2), mkvec2(sprk, sarch), U);
3287 : }
3288 :
3289 : static long
3290 56 : idealHNF_norm_pval(GEN x, GEN p)
3291 : {
3292 56 : long i, v = 0, l = lg(x);
3293 161 : for (i = 1; i < l; i++) v += Z_pval(gcoeff(x,i,i), p);
3294 56 : return v;
3295 : }
3296 : static long
3297 56 : sprk_get_k(GEN sprk)
3298 : {
3299 : GEN pr, prk;
3300 56 : if (sprk_is_prime(sprk)) return 1;
3301 56 : pr = sprk_get_pr(sprk);
3302 56 : prk = sprk_get_prk(sprk);
3303 56 : return idealHNF_norm_pval(prk, pr_get_p(pr)) / pr_get_f(pr);
3304 : }
3305 : /* true nf, L a sprk */
3306 : GEN
3307 56 : sprk_to_bid(GEN nf, GEN L, long flag)
3308 : {
3309 56 : GEN y, cyc, U, u1 = NULL, fa, fa2, arch, sarch, gen, sprk;
3310 :
3311 56 : arch = zerovec(nf_get_r1(nf));
3312 56 : fa = to_famat_shallow(sprk_get_pr(L), utoipos(sprk_get_k(L)));
3313 56 : sarch = nfarchstar(nf, NULL, cgetg(1, t_VECSMALL));
3314 56 : fa2 = famat_strip2(fa);
3315 56 : sprk = mkvec(L);
3316 56 : cyc = shallowconcat(sprk_get_cyc(L), sarch_get_cyc(sarch));
3317 56 : gen = sprk_get_gen(L);
3318 56 : cyc = ZV_snf_group(cyc, &U, (flag & nf_GEN)? &u1: NULL);
3319 56 : y = bid_grp(nf, u1, cyc, gen, NULL, sarch);
3320 56 : if (!(flag & nf_INIT)) return y;
3321 56 : return mkvec5(mkvec2(sprk_get_prk(L), arch), y, mkvec2(fa,fa2),
3322 : mkvec2(sprk, sarch), split_U(U, sprk));
3323 : }
3324 : GEN
3325 257171 : Idealstarmod(GEN nf, GEN ideal, long flag, GEN MOD)
3326 : {
3327 257171 : pari_sp av = avma;
3328 257171 : nf = nf? checknf(nf): nfinit(pol_x(0), DEFAULTPREC);
3329 257176 : return gerepilecopy(av, Idealstarmod_i(nf, ideal, flag, MOD));
3330 : }
3331 : GEN
3332 952 : Idealstar(GEN nf, GEN ideal, long flag) { return Idealstarmod(nf, ideal, flag, NULL); }
3333 : GEN
3334 273 : Idealstarprk(GEN nf, GEN pr, long k, long flag)
3335 : {
3336 273 : pari_sp av = avma;
3337 273 : GEN z = Idealstarmod_i(nf, mkmat2(mkcol(pr),mkcols(k)), flag, NULL);
3338 273 : return gerepilecopy(av, z);
3339 : }
3340 :
3341 : /* FIXME: obsolete */
3342 : GEN
3343 0 : zidealstarinitgen(GEN nf, GEN ideal)
3344 0 : { return Idealstar(nf,ideal, nf_INIT|nf_GEN); }
3345 : GEN
3346 0 : zidealstarinit(GEN nf, GEN ideal)
3347 0 : { return Idealstar(nf,ideal, nf_INIT); }
3348 : GEN
3349 0 : zidealstar(GEN nf, GEN ideal)
3350 0 : { return Idealstar(nf,ideal, nf_GEN); }
3351 :
3352 : GEN
3353 98 : idealstarmod(GEN nf, GEN ideal, long flag, GEN MOD)
3354 : {
3355 98 : switch(flag)
3356 : {
3357 0 : case 0: return Idealstarmod(nf,ideal, nf_GEN, MOD);
3358 84 : case 1: return Idealstarmod(nf,ideal, nf_INIT, MOD);
3359 14 : case 2: return Idealstarmod(nf,ideal, nf_INIT|nf_GEN, MOD);
3360 0 : default: pari_err_FLAG("idealstar");
3361 : }
3362 : return NULL; /* LCOV_EXCL_LINE */
3363 : }
3364 : GEN
3365 0 : idealstar0(GEN nf, GEN ideal,long flag) { return idealstarmod(nf, ideal, flag, NULL); }
3366 :
3367 : void
3368 218300 : check_nfelt(GEN x, GEN *den)
3369 : {
3370 218300 : long l = lg(x), i;
3371 218300 : GEN t, d = NULL;
3372 218300 : if (typ(x) != t_COL) pari_err_TYPE("check_nfelt", x);
3373 806292 : for (i=1; i<l; i++)
3374 : {
3375 587989 : t = gel(x,i);
3376 587989 : switch (typ(t))
3377 : {
3378 587758 : case t_INT: break;
3379 231 : case t_FRAC:
3380 231 : if (!d) d = gel(t,2); else d = lcmii(d, gel(t,2));
3381 231 : break;
3382 0 : default: pari_err_TYPE("check_nfelt", x);
3383 : }
3384 : }
3385 218303 : *den = d;
3386 218303 : }
3387 :
3388 : GEN
3389 4273746 : vecmodii(GEN x, GEN y)
3390 12750583 : { pari_APPLY_same(modii(gel(x,i), gel(y,i))) }
3391 : GEN
3392 1149704 : ZV_snf_gcd(GEN x, GEN mod)
3393 2955480 : { pari_APPLY_same(gcdii(gel(x,i), mod)); }
3394 :
3395 : GEN
3396 49784 : vecmoduu(GEN x, GEN y)
3397 174881 : { pari_APPLY_ulong(uel(x,i) % uel(y,i)) }
3398 :
3399 : /* assume a true bnf and bid */
3400 : GEN
3401 226596 : ideallog_units0(GEN bnf, GEN bid, GEN MOD)
3402 : {
3403 226596 : GEN nf = bnf_get_nf(bnf), D, y, C, cyc;
3404 226595 : long j, lU = lg(bnf_get_logfu(bnf)); /* r1+r2 */
3405 : zlog_S S;
3406 226595 : init_zlog_mod(&S, bid, MOD);
3407 226602 : if (!S.hU) return zeromat(0,lU);
3408 226602 : cyc = bid_get_cyc(bid);
3409 226600 : if (MOD) cyc = ZV_snf_gcd(cyc, MOD);
3410 226567 : D = nfsign_fu(bnf, bid_get_archp(bid));
3411 226611 : y = cgetg(lU, t_MAT);
3412 226603 : if ((C = bnf_build_cheapfu(bnf)))
3413 373652 : { for (j = 1; j < lU; j++) gel(y,j) = zlog(nf, gel(C,j), gel(D,j), &S); }
3414 : else
3415 : {
3416 42 : long i, l = lg(S.U), l0 = lg(S.sprk);
3417 : GEN X, U;
3418 42 : if (!(C = bnf_compactfu_mat(bnf))) bnf_build_units(bnf); /* error */
3419 42 : X = gel(C,1); U = gel(C,2);
3420 105 : for (j = 1; j < lU; j++) gel(y,j) = cgetg(l, t_COL);
3421 112 : for (i = 1; i < l0; i++)
3422 : {
3423 70 : GEN sprk = gel(S.sprk, i);
3424 70 : GEN Xi = sunits_makecoprime(X, sprk_get_pr(sprk), sprk_get_prk(sprk));
3425 189 : for (j = 1; j < lU; j++)
3426 119 : gcoeff(y,i,j) = famat_zlog_pr_coprime(nf, Xi, gel(U,j), sprk, MOD);
3427 : }
3428 42 : if (l0 != l)
3429 14 : for (j = 1; j < lU; j++) gcoeff(y,l0,j) = Flc_to_ZC(gel(D,j));
3430 : }
3431 226597 : y = vec_prepend(y, zlog(nf, bnf_get_tuU(bnf), nfsign_tu(bnf, S.archp), &S));
3432 600338 : for (j = 1; j <= lU; j++)
3433 373740 : gel(y,j) = vecmodii(ZMV_ZCV_mul(S.U, gel(y,j)), cyc);
3434 226598 : return y;
3435 : }
3436 : GEN
3437 84 : ideallog_units(GEN bnf, GEN bid)
3438 84 : { return ideallog_units0(bnf, bid, NULL); }
3439 : GEN
3440 518 : log_prk_units(GEN nf, GEN D, GEN sprk)
3441 : {
3442 518 : GEN L, Ltu = log_prk(nf, gel(D,1), sprk, NULL);
3443 518 : D = gel(D,2);
3444 518 : if (lg(D) != 3 || typ(gel(D,2)) != t_MAT) L = veclog_prk(nf, D, sprk);
3445 : else
3446 : {
3447 21 : GEN X = gel(D,1), U = gel(D,2);
3448 21 : long j, lU = lg(U);
3449 21 : X = sunits_makecoprime(X, sprk_get_pr(sprk), sprk_get_prk(sprk));
3450 21 : L = cgetg(lU, t_MAT);
3451 63 : for (j = 1; j < lU; j++)
3452 42 : gel(L,j) = famat_zlog_pr_coprime(nf, X, gel(U,j), sprk, NULL);
3453 : }
3454 518 : return vec_prepend(L, Ltu);
3455 : }
3456 :
3457 : static GEN
3458 384601 : ideallog_i(GEN nf, GEN x, zlog_S *S)
3459 : {
3460 384601 : pari_sp av = avma;
3461 : GEN y;
3462 384601 : if (!S->hU) return cgetg(1, t_COL);
3463 382592 : if (typ(x) == t_MAT)
3464 375991 : y = famat_zlog(nf, x, NULL, S);
3465 : else
3466 6601 : y = zlog(nf, x, NULL, S);
3467 382590 : y = ZMV_ZCV_mul(S->U, y);
3468 382588 : return gerepileupto(av, vecmodii(y, bid_get_cyc(S->bid)));
3469 : }
3470 : GEN
3471 391282 : ideallogmod(GEN nf, GEN x, GEN bid, GEN mod)
3472 : {
3473 : zlog_S S;
3474 391282 : if (!nf)
3475 : {
3476 6671 : if (mod) pari_err_IMPL("Zideallogmod");
3477 6671 : return Zideallog(bid, x);
3478 : }
3479 384611 : checkbid(bid); init_zlog_mod(&S, bid, mod);
3480 384601 : return ideallog_i(checknf(nf), x, &S);
3481 : }
3482 : GEN
3483 13755 : ideallog(GEN nf, GEN x, GEN bid) { return ideallogmod(nf, x, bid, NULL); }
3484 :
3485 : /*************************************************************************/
3486 : /** **/
3487 : /** JOIN BID STRUCTURES, IDEAL LISTS **/
3488 : /** **/
3489 : /*************************************************************************/
3490 : /* bid1, bid2: for coprime modules m1 and m2 (without arch. part).
3491 : * Output: bid for m1 m2 */
3492 : static GEN
3493 469 : join_bid(GEN nf, GEN bid1, GEN bid2)
3494 : {
3495 469 : pari_sp av = avma;
3496 : long nbgen, l1,l2;
3497 : GEN I1,I2, G1,G2, sprk1,sprk2, cyc1,cyc2, sarch;
3498 469 : GEN sprk, fa,fa2, U, cyc, y, u1 = NULL, x, gen;
3499 :
3500 469 : I1 = bid_get_ideal(bid1);
3501 469 : I2 = bid_get_ideal(bid2);
3502 469 : if (gequal1(gcoeff(I1,1,1))) return bid2; /* frequent trivial case */
3503 259 : G1 = bid_get_grp(bid1);
3504 259 : G2 = bid_get_grp(bid2);
3505 259 : x = idealmul(nf, I1,I2);
3506 259 : fa = famat_mul_shallow(bid_get_fact(bid1), bid_get_fact(bid2));
3507 259 : fa2= famat_mul_shallow(bid_get_fact2(bid1), bid_get_fact2(bid2));
3508 259 : sprk1 = bid_get_sprk(bid1);
3509 259 : sprk2 = bid_get_sprk(bid2);
3510 259 : sprk = shallowconcat(sprk1, sprk2);
3511 :
3512 259 : cyc1 = abgrp_get_cyc(G1); l1 = lg(cyc1);
3513 259 : cyc2 = abgrp_get_cyc(G2); l2 = lg(cyc2);
3514 259 : gen = (lg(G1)>3 && lg(G2)>3)? gen_1: NULL;
3515 259 : nbgen = l1+l2-2;
3516 259 : cyc = ZV_snf_group(shallowconcat(cyc1,cyc2), &U, gen? &u1: NULL);
3517 259 : if (nbgen)
3518 : {
3519 259 : GEN U1 = bid_get_U(bid1), U2 = bid_get_U(bid2);
3520 0 : U1 = l1==1? const_vec(lg(sprk1), cgetg(1,t_MAT))
3521 259 : : ZM_ZMV_mul(vecslice(U, 1, l1-1), U1);
3522 0 : U2 = l2==1? const_vec(lg(sprk2), cgetg(1,t_MAT))
3523 259 : : ZM_ZMV_mul(vecslice(U, l1, nbgen), U2);
3524 259 : U = shallowconcat(U1, U2);
3525 : }
3526 : else
3527 0 : U = const_vec(lg(sprk), cgetg(1,t_MAT));
3528 :
3529 259 : if (gen)
3530 : {
3531 259 : GEN uv = zkchinese1init2(nf, I2, I1, x);
3532 518 : gen = shallowconcat(zkVchinese1(gel(uv,1), abgrp_get_gen(G1)),
3533 259 : zkVchinese1(gel(uv,2), abgrp_get_gen(G2)));
3534 : }
3535 259 : sarch = bid_get_sarch(bid1); /* trivial */
3536 259 : y = bid_grp(nf, u1, cyc, gen, x, sarch);
3537 259 : x = mkvec2(x, bid_get_arch(bid1));
3538 259 : y = mkvec5(x, y, mkvec2(fa, fa2), mkvec2(sprk, sarch), U);
3539 259 : return gerepilecopy(av,y);
3540 : }
3541 :
3542 : typedef struct _ideal_data {
3543 : GEN nf, emb, L, pr, prL, sgnU, archp;
3544 : } ideal_data;
3545 :
3546 : /* z <- ( z | f(v[i])_{i=1..#v} ) */
3547 : static void
3548 759053 : concat_join(GEN *pz, GEN v, GEN (*f)(ideal_data*,GEN), ideal_data *data)
3549 : {
3550 759053 : long i, nz, lv = lg(v);
3551 : GEN z, Z;
3552 759053 : if (lv == 1) return;
3553 222884 : z = *pz; nz = lg(z)-1;
3554 222884 : *pz = Z = cgetg(lv + nz, typ(z));
3555 371720 : for (i = 1; i <=nz; i++) gel(Z,i) = gel(z,i);
3556 223373 : Z += nz;
3557 492072 : for (i = 1; i < lv; i++) gel(Z,i) = f(data, gel(v,i));
3558 : }
3559 : static GEN
3560 469 : join_idealinit(ideal_data *D, GEN x)
3561 469 : { return join_bid(D->nf, x, D->prL); }
3562 : static GEN
3563 268560 : join_ideal(ideal_data *D, GEN x)
3564 268560 : { return idealmulpowprime(D->nf, x, D->pr, D->L); }
3565 : static GEN
3566 448 : join_unit(ideal_data *D, GEN x)
3567 : {
3568 448 : GEN bid = join_idealinit(D, gel(x,1)), u = gel(x,2), v = mkvec(D->emb);
3569 448 : if (lg(u) != 1) v = shallowconcat(u, v);
3570 448 : return mkvec2(bid, v);
3571 : }
3572 :
3573 : GEN
3574 49 : log_prk_units_init(GEN bnf)
3575 : {
3576 49 : GEN U = bnf_has_fu(bnf);
3577 49 : if (U) U = matalgtobasis(bnf_get_nf(bnf), U);
3578 21 : else if (!(U = bnf_compactfu_mat(bnf))) (void)bnf_build_units(bnf);
3579 49 : return mkvec2(bnf_get_tuU(bnf), U);
3580 : }
3581 : /* flag & nf_GEN : generators, otherwise no
3582 : * flag &2 : units, otherwise no
3583 : * flag &4 : ideals in HNF, otherwise bid
3584 : * flag &8 : omit ideals which cannot be conductors (pr^1 with Npr=2) */
3585 : static GEN
3586 11333 : Ideallist(GEN bnf, ulong bound, long flag)
3587 : {
3588 11333 : const long do_units = flag & 2, big_id = !(flag & 4), cond = flag & 8;
3589 11333 : const long istar_flag = (flag & nf_GEN) | nf_INIT;
3590 : pari_sp av;
3591 : long i, j;
3592 11333 : GEN nf, z, p, fa, id, BOUND, U, empty = cgetg(1,t_VEC);
3593 : forprime_t S;
3594 : ideal_data ID;
3595 : GEN (*join_z)(ideal_data*, GEN);
3596 :
3597 11333 : if (do_units)
3598 : {
3599 21 : bnf = checkbnf(bnf);
3600 21 : nf = bnf_get_nf(bnf);
3601 21 : join_z = &join_unit;
3602 : }
3603 : else
3604 : {
3605 11312 : nf = checknf(bnf);
3606 11312 : join_z = big_id? &join_idealinit: &join_ideal;
3607 : }
3608 11333 : if ((long)bound <= 0) return empty;
3609 11333 : id = matid(nf_get_degree(nf));
3610 11333 : if (big_id) id = Idealstar(nf,id, istar_flag);
3611 :
3612 : /* z[i] will contain all "objects" of norm i. Depending on flag, this means
3613 : * an ideal, a bid, or a couple [bid, log(units)]. Such objects are stored
3614 : * in vectors, computed one primary component at a time; join_z
3615 : * reconstructs the global object */
3616 11333 : BOUND = utoipos(bound);
3617 11333 : z = const_vec(bound, empty);
3618 11333 : U = do_units? log_prk_units_init(bnf): NULL;
3619 11333 : gel(z,1) = mkvec(U? mkvec2(id, empty): id);
3620 11333 : ID.nf = nf;
3621 :
3622 11333 : p = cgetipos(3);
3623 11333 : u_forprime_init(&S, 2, bound);
3624 11333 : av = avma;
3625 92418 : while ((p[2] = u_forprime_next(&S)))
3626 : {
3627 81614 : if (DEBUGLEVEL>1) err_printf("%ld ",p[2]);
3628 81614 : fa = idealprimedec_limit_norm(nf, p, BOUND);
3629 162599 : for (j = 1; j < lg(fa); j++)
3630 : {
3631 81514 : GEN pr = gel(fa,j), z2 = leafcopy(z);
3632 81514 : ulong Q, q = upr_norm(pr);
3633 : long l;
3634 81514 : ID.pr = ID.prL = pr;
3635 81514 : if (cond && q == 2) { l = 2; Q = 4; } else { l = 1; Q = q; }
3636 184027 : for (; Q <= bound; l++, Q *= q) /* add pr^l */
3637 : {
3638 : ulong iQ;
3639 103044 : ID.L = utoipos(l);
3640 103041 : if (big_id) {
3641 210 : ID.prL = Idealstarprk(nf, pr, l, istar_flag);
3642 210 : if (U)
3643 189 : ID.emb = Q == 2? empty
3644 189 : : log_prk_units(nf, U, gel(bid_get_sprk(ID.prL),1));
3645 : }
3646 861531 : for (iQ = Q,i = 1; iQ <= bound; iQ += Q,i++)
3647 759018 : concat_join(&gel(z,iQ), gel(z2,i), join_z, &ID);
3648 : }
3649 : }
3650 81085 : if (gc_needed(av,1))
3651 : {
3652 18 : if(DEBUGMEM>1) pari_warn(warnmem,"Ideallist");
3653 18 : z = gerepilecopy(av, z);
3654 : }
3655 : }
3656 11333 : return z;
3657 : }
3658 : GEN
3659 49 : gideallist(GEN bnf, GEN B, long flag)
3660 : {
3661 49 : pari_sp av = avma;
3662 49 : if (typ(B) != t_INT)
3663 : {
3664 0 : B = gfloor(B);
3665 0 : if (typ(B) != t_INT) pari_err_TYPE("ideallist", B);
3666 0 : if (signe(B) < 0) B = gen_0;
3667 : }
3668 49 : if (signe(B) < 0)
3669 : {
3670 14 : if (flag != 4) pari_err_IMPL("ideallist with bid for single norm");
3671 14 : return gerepilecopy(av, ideals_by_norm(bnf_get_nf(bnf), absi(B)));
3672 : }
3673 35 : if (flag < 0 || flag > 15) pari_err_FLAG("ideallist");
3674 35 : return gerepilecopy(av, Ideallist(bnf, itou(B), flag));
3675 : }
3676 : GEN
3677 11298 : ideallist0(GEN bnf, long bound, long flag)
3678 : {
3679 11298 : pari_sp av = avma;
3680 11298 : if (flag < 0 || flag > 15) pari_err_FLAG("ideallist");
3681 11298 : return gerepilecopy(av, Ideallist(bnf, bound, flag));
3682 : }
3683 : GEN
3684 10563 : ideallist(GEN bnf,long bound) { return ideallist0(bnf,bound,4); }
3685 :
3686 : /* bid = for module m (without arch. part), arch = archimedean part.
3687 : * Output: bid for [m,arch] */
3688 : static GEN
3689 42 : join_bid_arch(GEN nf, GEN bid, GEN archp)
3690 : {
3691 42 : pari_sp av = avma;
3692 : GEN G, U;
3693 42 : GEN sprk, cyc, y, u1 = NULL, x, sarch, gen;
3694 :
3695 42 : checkbid(bid);
3696 42 : G = bid_get_grp(bid);
3697 42 : x = bid_get_ideal(bid);
3698 42 : sarch = nfarchstar(nf, bid_get_ideal(bid), archp);
3699 42 : sprk = bid_get_sprk(bid);
3700 :
3701 42 : gen = (lg(G)>3)? gel(G,3): NULL;
3702 42 : cyc = diagonal_shallow(shallowconcat(gel(G,2), sarch_get_cyc(sarch)));
3703 42 : cyc = ZM_snf_group(cyc, &U, gen? &u1: NULL);
3704 42 : y = bid_grp(nf, u1, cyc, gen, x, sarch);
3705 42 : U = split_U(U, sprk);
3706 42 : y = mkvec5(mkvec2(x, archp), y, gel(bid,3), mkvec2(sprk, sarch), U);
3707 42 : return gerepilecopy(av,y);
3708 : }
3709 : static GEN
3710 42 : join_arch(ideal_data *D, GEN x) {
3711 42 : return join_bid_arch(D->nf, x, D->archp);
3712 : }
3713 : static GEN
3714 14 : join_archunit(ideal_data *D, GEN x) {
3715 14 : GEN bid = join_arch(D, gel(x,1)), u = gel(x,2), v = mkvec(D->emb);
3716 14 : if (lg(u) != 1) v = shallowconcat(u, v);
3717 14 : return mkvec2(bid, v);
3718 : }
3719 :
3720 : /* L from ideallist, add archimedean part */
3721 : GEN
3722 14 : ideallistarch(GEN bnf, GEN L, GEN arch)
3723 : {
3724 : pari_sp av;
3725 14 : long i, j, l = lg(L), lz;
3726 : GEN v, z, V, nf;
3727 : ideal_data ID;
3728 : GEN (*join_z)(ideal_data*, GEN);
3729 :
3730 14 : if (typ(L) != t_VEC) pari_err_TYPE("ideallistarch",L);
3731 14 : if (l == 1) return cgetg(1,t_VEC);
3732 14 : z = gel(L,1);
3733 14 : if (typ(z) != t_VEC) pari_err_TYPE("ideallistarch",z);
3734 14 : z = gel(z,1); /* either a bid or [bid,U] */
3735 14 : ID.archp = vec01_to_indices(arch);
3736 14 : if (lg(z) == 3)
3737 : { /* [bid,U]: do units */
3738 7 : bnf = checkbnf(bnf); nf = bnf_get_nf(bnf);
3739 7 : if (typ(z) != t_VEC) pari_err_TYPE("ideallistarch",z);
3740 7 : ID.emb = zm_to_ZM( rowpermute(nfsign_units(bnf,NULL,1), ID.archp) );
3741 7 : join_z = &join_archunit;
3742 : }
3743 : else
3744 : {
3745 7 : join_z = &join_arch;
3746 7 : nf = checknf(bnf);
3747 : }
3748 14 : ID.nf = nf;
3749 14 : av = avma; V = cgetg(l, t_VEC);
3750 63 : for (i = 1; i < l; i++)
3751 : {
3752 49 : z = gel(L,i); lz = lg(z);
3753 49 : gel(V,i) = v = cgetg(lz,t_VEC);
3754 91 : for (j=1; j<lz; j++) gel(v,j) = join_z(&ID, gel(z,j));
3755 : }
3756 14 : return gerepilecopy(av,V);
3757 : }
|
