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 33476664 : get_tab(GEN nf, long *N)
33 : {
34 33476664 : GEN tab = (typ(nf) == t_MAT)? nf: gel(nf,9);
35 33476664 : *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 1119458587 : _mulii(GEN x, GEN y) {
41 1823454009 : return is_pm1(x)? (signe(x) < 0)? negi(y): y
42 1823358541 : : mulii(x, y);
43 : }
44 :
45 : GEN
46 18585 : tablemul_ei_ej(GEN M, long i, long j)
47 : {
48 : long N;
49 18585 : GEN tab = get_tab(M, &N);
50 18585 : 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 10437 : tablemul_ei(GEN M, GEN x, long i)
58 : {
59 : long j, k, N;
60 : GEN v, tab;
61 :
62 10437 : if (i==1) return gcopy(x);
63 10437 : tab = get_tab(M, &N);
64 10437 : if (typ(x) != t_COL) { v = zerocol(N); gel(v,i) = gcopy(x); return v; }
65 10437 : tab += (i-1)*N; v = cgetg(N+1,t_COL);
66 : /* wi . x = [ sum_j tab[k,j] x[j] ]_k */
67 72919 : for (k=1; k<=N; k++)
68 : {
69 62482 : pari_sp av = avma;
70 62482 : GEN s = gen_0;
71 449148 : for (j=1; j<=N; j++)
72 : {
73 386666 : GEN c = gcoeff(tab,k,j);
74 386666 : if (!gequal0(c)) s = gadd(s, gmul(c, gel(x,j)));
75 : }
76 62482 : gel(v,k) = gerepileupto(av,s);
77 : }
78 10437 : return v;
79 : }
80 : /* as tablemul_ei, assume x a ZV of correct length */
81 : GEN
82 26047505 : zk_ei_mul(GEN nf, GEN x, long i)
83 : {
84 : long j, k, N;
85 : GEN v, tab;
86 :
87 26047505 : if (i==1) return ZC_copy(x);
88 26047491 : tab = get_tab(nf, &N); tab += (i-1)*N;
89 26047427 : v = cgetg(N+1,t_COL);
90 203182699 : for (k=1; k<=N; k++)
91 : {
92 177137131 : pari_sp av = avma;
93 177137131 : GEN s = gen_0;
94 2626709166 : for (j=1; j<=N; j++)
95 : {
96 2449828068 : GEN c = gcoeff(tab,k,j);
97 2449828068 : if (signe(c)) s = addii(s, _mulii(c, gel(x,j)));
98 : }
99 176881098 : gel(v,k) = gerepileuptoint(av, s);
100 : }
101 26045568 : return v;
102 : }
103 :
104 : /* table of multiplication by wi in R[w1,..., wN] */
105 : GEN
106 38170 : ei_multable(GEN TAB, long i)
107 : {
108 : long k,N;
109 38170 : GEN m, tab = get_tab(TAB, &N);
110 38170 : tab += (i-1)*N;
111 38170 : m = cgetg(N+1,t_MAT);
112 147767 : for (k=1; k<=N; k++) gel(m,k) = gel(tab,k);
113 38170 : return m;
114 : }
115 :
116 : GEN
117 11243546 : zk_multable(GEN nf, GEN x)
118 : {
119 11243546 : long i, l = lg(x);
120 11243546 : GEN mul = cgetg(l,t_MAT);
121 11243221 : gel(mul,1) = x; /* assume w_1 = 1 */
122 36909472 : for (i=2; i<l; i++) gel(mul,i) = zk_ei_mul(nf,x,i);
123 11241228 : return mul;
124 : }
125 : GEN
126 2163 : multable(GEN M, GEN x)
127 : {
128 : long i, N;
129 : GEN mul;
130 2163 : 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 7295588 : zk_scalar_or_multable(GEN nf, GEN x)
143 : {
144 7295588 : long tx = typ(x);
145 7295588 : if (tx == t_MAT || tx == t_INT) return x;
146 7192169 : x = nf_to_scalar_or_basis(nf, x);
147 7191972 : return (typ(x) == t_COL)? zk_multable(nf, x): x;
148 : }
149 :
150 : GEN
151 20740 : nftrace(GEN nf, GEN x)
152 : {
153 20740 : pari_sp av = avma;
154 20740 : nf = checknf(nf);
155 20744 : x = nf_to_scalar_or_basis(nf, x);
156 20723 : x = (typ(x) == t_COL)? RgV_dotproduct(x, gel(nf_get_Tr(nf),1))
157 20744 : : gmulgs(x, nf_get_degree(nf));
158 20744 : 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 : : gmulgs(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 103334 : nfnorm(GEN nf, GEN x)
184 : {
185 103334 : pari_sp av = avma;
186 : GEN c, den;
187 : long n;
188 103334 : nf = checknf(nf);
189 103334 : n = nf_get_degree(nf);
190 103335 : if (typ(x) == t_MAT) return famat_norm(nf, x);
191 103328 : x = nf_to_scalar_or_basis(nf, x);
192 103328 : if (typ(x)!=t_COL)
193 11319 : return gerepileupto(av, gpowgs(x, n));
194 92009 : x = nf_to_scalar_or_alg(nf, Q_primitive_part(x, &c));
195 92009 : x = Q_remove_denom(x, &den);
196 92008 : x = ZX_resultant_all(nf_get_pol(nf), x, den, 0);
197 92008 : 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 18030271 : nfadd(GEN nf, GEN x, GEN y)
224 : {
225 18030271 : pari_sp av = avma;
226 : GEN z;
227 :
228 18030271 : nf = checknf(nf);
229 18030271 : x = nf_to_scalar_or_basis(nf, x);
230 18030271 : y = nf_to_scalar_or_basis(nf, y);
231 18030271 : if (typ(x) != t_COL)
232 14531580 : { z = (typ(y) == t_COL)? RgC_Rg_add(y, x): gadd(x,y); }
233 : else
234 3498691 : { z = (typ(y) == t_COL)? RgC_add(x, y): RgC_Rg_add(x, y); }
235 18030271 : return gerepileupto(av, z);
236 : }
237 : /* x - y in nf */
238 : GEN
239 1283443 : nfsub(GEN nf, GEN x, GEN y)
240 : {
241 1283443 : pari_sp av = avma;
242 : GEN z;
243 :
244 1283443 : nf = checknf(nf);
245 1283443 : x = nf_to_scalar_or_basis(nf, x);
246 1283443 : y = nf_to_scalar_or_basis(nf, y);
247 1283443 : if (typ(x) != t_COL)
248 918407 : { z = (typ(y) == t_COL)? Rg_RgC_sub(x,y): gsub(x,y); }
249 : else
250 365036 : { z = (typ(y) == t_COL)? RgC_sub(x,y): RgC_Rg_sub(x,y); }
251 1283443 : 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 3485413 : nfmuli_ZC(GEN nf, GEN x, GEN y)
257 : {
258 : long i, j, k, N;
259 3485413 : GEN TAB = get_tab(nf, &N), v = cgetg(N+1,t_COL);
260 :
261 20270250 : for (k = 1; k <= N; k++)
262 : {
263 16784881 : pari_sp av = avma;
264 16784881 : GEN s, TABi = TAB;
265 16784881 : if (k == 1)
266 3485390 : s = mulii(gel(x,1),gel(y,1));
267 : else
268 13299248 : s = addii(mulii(gel(x,1),gel(y,k)),
269 13299491 : mulii(gel(x,k),gel(y,1)));
270 159515864 : for (i=2; i<=N; i++)
271 : {
272 142735767 : GEN t, xi = gel(x,i);
273 142735767 : TABi += N;
274 142735767 : if (!signe(xi)) continue;
275 :
276 67884365 : t = NULL;
277 953234361 : for (j=2; j<=N; j++)
278 : {
279 885351962 : GEN p1, c = gcoeff(TABi, k, j); /* m^{i,j}_k */
280 885351962 : if (!signe(c)) continue;
281 245354543 : p1 = _mulii(c, gel(y,j));
282 245360627 : t = t? addii(t, p1): p1;
283 : }
284 67882399 : if (t) s = addii(s, mulii(xi, t));
285 : }
286 16780097 : gel(v,k) = gerepileuptoint(av,s);
287 : }
288 3485369 : return v;
289 : }
290 : static int
291 48366460 : is_famat(GEN x) { return typ(x) == t_MAT && lg(x) == 3; }
292 : /* product of x and y in nf */
293 : GEN
294 24505036 : nfmul(GEN nf, GEN x, GEN y)
295 : {
296 : GEN z;
297 24505036 : pari_sp av = avma;
298 :
299 24505036 : if (x == y) return nfsqr(nf,x);
300 :
301 20905532 : nf = checknf(nf);
302 20905531 : if (is_famat(x) || is_famat(y)) return famat_mul(x, y);
303 20905440 : x = nf_to_scalar_or_basis(nf, x);
304 20905437 : y = nf_to_scalar_or_basis(nf, y);
305 20905437 : if (typ(x) != t_COL)
306 : {
307 15291705 : if (isintzero(x)) return gen_0;
308 10443348 : z = (typ(y) == t_COL)? RgC_Rg_mul(y, x): gmul(x,y); }
309 : else
310 : {
311 5613732 : if (typ(y) != t_COL)
312 : {
313 3881998 : if (isintzero(y)) return gen_0;
314 1272298 : z = RgC_Rg_mul(x, y);
315 : }
316 : else
317 : {
318 : GEN dx, dy;
319 1731734 : x = Q_remove_denom(x, &dx);
320 1731735 : y = Q_remove_denom(y, &dy);
321 1731735 : z = nfmuli_ZC(nf,x,y);
322 1731734 : dx = mul_denom(dx,dy);
323 1731735 : if (dx) z = ZC_Z_div(z, dx);
324 : }
325 : }
326 13447373 : return gerepileupto(av, z);
327 : }
328 : /* square of ZC x in nf */
329 : static GEN
330 3878792 : nfsqri_ZC(GEN nf, GEN x)
331 : {
332 : long i, j, k, N;
333 3878792 : GEN TAB = get_tab(nf, &N), v = cgetg(N+1,t_COL);
334 :
335 25447444 : for (k = 1; k <= N; k++)
336 : {
337 21568702 : pari_sp av = avma;
338 21568702 : GEN s, TABi = TAB;
339 21568702 : if (k == 1)
340 3878777 : s = sqri(gel(x,1));
341 : else
342 17689925 : s = shifti(mulii(gel(x,1),gel(x,k)), 1);
343 224265879 : for (i=2; i<=N; i++)
344 : {
345 202714068 : GEN p1, c, t, xi = gel(x,i);
346 202714068 : TABi += N;
347 202714068 : if (!signe(xi)) continue;
348 :
349 65786141 : c = gcoeff(TABi, k, i);
350 65786141 : t = signe(c)? _mulii(c,xi): NULL;
351 643303234 : for (j=i+1; j<=N; j++)
352 : {
353 577517236 : c = gcoeff(TABi, k, j);
354 577517236 : if (!signe(c)) continue;
355 221552959 : p1 = _mulii(c, shifti(gel(x,j),1));
356 221557738 : t = t? addii(t, p1): p1;
357 : }
358 65785998 : if (t) s = addii(s, mulii(xi, t));
359 : }
360 21551811 : gel(v,k) = gerepileuptoint(av,s);
361 : }
362 3878742 : return v;
363 : }
364 : /* square of x in nf */
365 : GEN
366 5621106 : nfsqr(GEN nf, GEN x)
367 : {
368 5621106 : pari_sp av = avma;
369 : GEN z;
370 :
371 5621106 : nf = checknf(nf);
372 5621111 : if (is_famat(x)) return famat_sqr(x);
373 5621112 : x = nf_to_scalar_or_basis(nf, x);
374 5621110 : if (typ(x) != t_COL) z = gsqr(x);
375 : else
376 : {
377 : GEN dx;
378 235647 : x = Q_remove_denom(x, &dx);
379 235647 : z = nfsqri_ZC(nf,x);
380 235651 : if (dx) z = RgC_Rg_div(z, sqri(dx));
381 : }
382 5621114 : return gerepileupto(av, z);
383 : }
384 :
385 : /* x a ZC, v a t_COL of ZC/Z */
386 : GEN
387 135779 : zkC_multable_mul(GEN v, GEN x)
388 : {
389 135779 : long i, l = lg(v);
390 135779 : GEN y = cgetg(l, t_COL);
391 478178 : for (i = 1; i < l; i++)
392 : {
393 342399 : GEN c = gel(v,i);
394 342399 : if (typ(c)!=t_COL) {
395 0 : if (!isintzero(c)) c = ZC_Z_mul(gel(x,1), c);
396 : } else {
397 342399 : c = ZM_ZC_mul(x,c);
398 342399 : if (ZV_isscalar(c)) c = gel(c,1);
399 : }
400 342399 : gel(y,i) = c;
401 : }
402 135779 : return y;
403 : }
404 :
405 : GEN
406 46321 : nfC_multable_mul(GEN v, GEN x)
407 : {
408 46321 : long i, l = lg(v);
409 46321 : GEN y = cgetg(l, t_COL);
410 323590 : for (i = 1; i < l; i++)
411 : {
412 277269 : GEN c = gel(v,i);
413 277269 : if (typ(c)!=t_COL) {
414 230326 : if (!isintzero(c)) c = RgC_Rg_mul(gel(x,1), c);
415 : } else {
416 46943 : c = RgM_RgC_mul(x,c);
417 46943 : if (QV_isscalar(c)) c = gel(c,1);
418 : }
419 277269 : gel(y,i) = c;
420 : }
421 46321 : return y;
422 : }
423 :
424 : GEN
425 172186 : nfC_nf_mul(GEN nf, GEN v, GEN x)
426 : {
427 : long tx;
428 : GEN y;
429 :
430 172186 : x = nf_to_scalar_or_basis(nf, x);
431 172186 : tx = typ(x);
432 172186 : if (tx != t_COL)
433 : {
434 : long l, i;
435 133033 : if (tx == t_INT)
436 : {
437 124163 : long s = signe(x);
438 124163 : if (!s) return zerocol(lg(v)-1);
439 117513 : if (is_pm1(x)) return s > 0? leafcopy(v): RgC_neg(v);
440 : }
441 44667 : l = lg(v); y = cgetg(l, t_COL);
442 326158 : for (i=1; i < l; i++)
443 : {
444 281491 : GEN c = gel(v,i);
445 281491 : if (typ(c) != t_COL) c = gmul(c, x); else c = RgC_Rg_mul(c, x);
446 281491 : gel(y,i) = c;
447 : }
448 44667 : return y;
449 : }
450 : else
451 : {
452 : GEN dx;
453 39153 : x = zk_multable(nf, Q_remove_denom(x,&dx));
454 39153 : y = nfC_multable_mul(v, x);
455 39153 : return dx? RgC_Rg_div(y, dx): y;
456 : }
457 : }
458 : static GEN
459 9639 : mulbytab(GEN M, GEN c)
460 9639 : { return typ(c) == t_COL? RgM_RgC_mul(M,c): RgC_Rg_mul(gel(M,1), c); }
461 : GEN
462 2163 : tablemulvec(GEN M, GEN x, GEN v)
463 : {
464 : long l, i;
465 : GEN y;
466 :
467 2163 : 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 2163 : x = multable(M, x); /* multiplication table by x */
473 2163 : y = cgetg_copy(v, &l);
474 2163 : if (typ(v) == t_POL)
475 : {
476 2163 : y[1] = v[1];
477 11802 : for (i=2; i < l; i++) gel(y,i) = mulbytab(x, gel(v,i));
478 2163 : 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 2163 : return y;
485 : }
486 :
487 : GEN
488 436180 : zkmultable_capZ(GEN mx) { return Q_denom(zkmultable_inv(mx)); }
489 : GEN
490 585276 : 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 149098 : zk_inv(GEN nf, GEN x) { return zkmultable_inv(zk_multable(nf,x)); }
494 :
495 : /* inverse of x in nf */
496 : GEN
497 73108 : nfinv(GEN nf, GEN x)
498 : {
499 73108 : pari_sp av = avma;
500 : GEN z;
501 :
502 73108 : nf = checknf(nf);
503 73108 : if (is_famat(x)) return famat_inv(x);
504 73108 : x = nf_to_scalar_or_basis(nf, x);
505 73108 : if (typ(x) == t_COL)
506 : {
507 : GEN d;
508 29365 : x = Q_remove_denom(x, &d);
509 29365 : z = zk_inv(nf, x);
510 29365 : if (d) z = RgC_Rg_mul(z, d);
511 : }
512 : else
513 43743 : z = ginv(x);
514 73108 : return gerepileupto(av, z);
515 : }
516 :
517 : /* quotient of x and y in nf */
518 : GEN
519 31204 : nfdiv(GEN nf, GEN x, GEN y)
520 : {
521 31204 : pari_sp av = avma;
522 : GEN z;
523 :
524 31204 : nf = checknf(nf);
525 31204 : if (is_famat(x) || is_famat(y)) return famat_div(x,y);
526 31113 : y = nf_to_scalar_or_basis(nf, y);
527 31113 : if (typ(y) != t_COL)
528 : {
529 19988 : x = nf_to_scalar_or_basis(nf, x);
530 19988 : z = (typ(x) == t_COL)? RgC_Rg_div(x, y): gdiv(x,y);
531 : }
532 : else
533 : {
534 : GEN d;
535 11125 : y = Q_remove_denom(y, &d);
536 11125 : z = nfmul(nf, x, zk_inv(nf,y));
537 11125 : if (d) z = typ(z) == t_COL? RgC_Rg_mul(z, d): gmul(z, d);
538 : }
539 31113 : return gerepileupto(av, z);
540 : }
541 :
542 : /* product of INTEGERS (t_INT or ZC) x and y in (true) nf */
543 : GEN
544 2272114 : nfmuli(GEN nf, GEN x, GEN y)
545 : {
546 2272114 : if (typ(x) == t_INT) return (typ(y) == t_COL)? ZC_Z_mul(y, x): mulii(x,y);
547 1932044 : if (typ(y) == t_INT) return ZC_Z_mul(x, y);
548 1753642 : return nfmuli_ZC(nf, x, y);
549 : }
550 : GEN
551 3643073 : nfsqri(GEN nf, GEN x)
552 3643073 : { 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 44569 : tablesqr(GEN TAB, GEN x)
595 : {
596 : long i, j, k, N;
597 : GEN s, v;
598 :
599 44569 : if (typ(x) != t_COL) return gsqr(x);
600 44569 : N = lg(x)-1;
601 44569 : v = cgetg(N+1,t_COL);
602 :
603 320243 : for (k=1; k<=N; k++)
604 : {
605 275674 : pari_sp av = avma;
606 275674 : GEN TABi = TAB;
607 275674 : if (k == 1)
608 44569 : s = gsqr(gel(x,1));
609 : else
610 231105 : s = gmul2n(gmul(gel(x,1),gel(x,k)), 1);
611 1770440 : for (i=2; i<=N; i++)
612 : {
613 1494766 : GEN p1, c, t, xi = gel(x,i);
614 1494766 : TABi += N;
615 1494766 : if (gequal0(xi)) continue;
616 :
617 384335 : c = gcoeff(TABi, k, i);
618 384335 : t = !gequal0(c)? gmul(c,xi): NULL;
619 1551025 : for (j=i+1; j<=N; j++)
620 : {
621 1166690 : c = gcoeff(TABi, k, j);
622 1166690 : if (gequal0(c)) continue;
623 597618 : p1 = gmul(gmul2n(c,1), gel(x,j));
624 597618 : t = t? gadd(t, p1): p1;
625 : }
626 384335 : if (t) s = gadd(s, gmul(xi, t));
627 : }
628 275674 : gel(v,k) = gerepileupto(av,s);
629 : }
630 44569 : return v;
631 : }
632 :
633 : static GEN
634 309635 : _mul(void *data, GEN x, GEN y) { return nfmuli((GEN)data,x,y); }
635 : static GEN
636 924614 : _sqr(void *data, GEN x) { return nfsqri((GEN)data,x); }
637 :
638 : /* Compute z^n in nf, left-shift binary powering */
639 : GEN
640 784193 : nfpow(GEN nf, GEN z, GEN n)
641 : {
642 784193 : pari_sp av = avma;
643 : long s;
644 : GEN x, cx;
645 :
646 784193 : if (typ(n)!=t_INT) pari_err_TYPE("nfpow",n);
647 784193 : nf = checknf(nf);
648 784193 : s = signe(n); if (!s) return gen_1;
649 784193 : if (is_famat(z)) return famat_pow(z, n);
650 784181 : x = nf_to_scalar_or_basis(nf, z);
651 784180 : if (typ(x) != t_COL) return powgi(x,n);
652 718499 : if (s < 0)
653 : { /* simplified nfinv */
654 : GEN d;
655 41334 : x = Q_remove_denom(x, &d);
656 41333 : x = zk_inv(nf, x);
657 41334 : x = primitive_part(x, &cx);
658 41334 : cx = mul_content(cx, d);
659 41334 : n = negi(n);
660 : }
661 : else
662 677165 : x = primitive_part(x, &cx);
663 718484 : x = gen_pow_i(x, n, (void*)nf, _sqr, _mul);
664 718494 : if (cx)
665 84839 : x = gerepileupto(av, gmul(x, powgi(cx, n)));
666 : else
667 633655 : x = gerepilecopy(av, x);
668 718501 : return x;
669 : }
670 : /* Compute z^n in nf, left-shift binary powering */
671 : GEN
672 209026 : nfpow_u(GEN nf, GEN z, ulong n)
673 : {
674 209026 : pari_sp av = avma;
675 : GEN x, cx;
676 :
677 209026 : if (!n) return gen_1;
678 209026 : x = nf_to_scalar_or_basis(nf, z);
679 209025 : if (typ(x) != t_COL) return gpowgs(x,n);
680 172733 : x = primitive_part(x, &cx);
681 172732 : x = gen_powu_i(x, n, (void*)nf, _sqr, _mul);
682 172733 : if (cx)
683 : {
684 25578 : x = gmul(x, powgi(cx, utoipos(n)));
685 25578 : return gerepileupto(av,x);
686 : }
687 147155 : return gerepilecopy(av, x);
688 : }
689 :
690 : static GEN
691 63 : idmulred(void *nf, GEN x, GEN y) { return idealmulred((GEN) nf, x, y); }
692 : static GEN
693 420 : idpowred(void *nf, GEN x, GEN n) { return idealpowred((GEN) nf, x, n); }
694 : static GEN
695 189943 : idmul(void *nf, GEN x, GEN y) { return idealmul((GEN) nf, x, y); }
696 : static GEN
697 214158 : idpow(void *nf, GEN x, GEN n) { return idealpow((GEN) nf, x, n); }
698 : GEN
699 70893 : idealfactorback(GEN nf, GEN L, GEN e, int red)
700 : {
701 70893 : nf = checknf(nf);
702 70893 : if (red) return gen_factorback(L, e, (void*)nf, &idmulred, &idpowred, NULL);
703 70536 : else return gen_factorback(L, e, (void*)nf, &idmul, &idpow, NULL);
704 : }
705 : static GEN
706 320986 : eltmul(void *nf, GEN x, GEN y) { return nfmul((GEN) nf, x, y); }
707 : static GEN
708 396114 : eltpow(void *nf, GEN x, GEN n) { return nfpow((GEN) nf, x, n); }
709 : GEN
710 75137 : nffactorback(GEN nf, GEN L, GEN e)
711 75137 : { return gen_factorback(L, e, (void*)checknf(nf), &eltmul, &eltpow, NULL); }
712 :
713 : static GEN
714 2748116 : _nf_red(void *E, GEN x) { (void)E; return x; }
715 :
716 : static GEN
717 11555663 : _nf_add(void *E, GEN x, GEN y) { return nfadd((GEN)E,x,y); }
718 :
719 : static GEN
720 673666 : _nf_neg(void *E, GEN x) { (void)E; return gneg(x); }
721 :
722 : static GEN
723 13818462 : _nf_mul(void *E, GEN x, GEN y) { return nfmul((GEN)E,x,y); }
724 :
725 : static GEN
726 44933 : _nf_inv(void *E, GEN x) { return nfinv((GEN)E,x); }
727 :
728 : static GEN
729 8806 : _nf_s(void *E, long x) { (void)E; return stoi(x); }
730 :
731 : static const struct bb_field nf_field={_nf_red,_nf_add,_nf_mul,_nf_neg,
732 : _nf_inv,&gequal0,_nf_s };
733 :
734 196903 : const struct bb_field *get_nf_field(void **E, GEN nf)
735 196903 : { *E = (void*)nf; return &nf_field; }
736 :
737 : GEN
738 14 : nfM_det(GEN nf, GEN M)
739 : {
740 : void *E;
741 14 : const struct bb_field *S = get_nf_field(&E, nf);
742 14 : return gen_det(M, E, S);
743 : }
744 : GEN
745 8792 : nfM_inv(GEN nf, GEN M)
746 : {
747 : void *E;
748 8792 : const struct bb_field *S = get_nf_field(&E, nf);
749 8792 : return gen_Gauss(M, matid(lg(M)-1), E, S);
750 : }
751 : GEN
752 8526 : nfM_mul(GEN nf, GEN A, GEN B)
753 : {
754 : void *E;
755 8526 : const struct bb_field *S = get_nf_field(&E, nf);
756 8526 : return gen_matmul(A, B, E, S);
757 : }
758 : GEN
759 179571 : nfM_nfC_mul(GEN nf, GEN A, GEN B)
760 : {
761 : void *E;
762 179571 : const struct bb_field *S = get_nf_field(&E, nf);
763 179571 : return gen_matcolmul(A, B, E, S);
764 : }
765 :
766 : /* valuation of integral x (ZV), with resp. to prime ideal pr */
767 : long
768 28085583 : ZC_nfvalrem(GEN x, GEN pr, GEN *newx)
769 : {
770 28085583 : pari_sp av = avma;
771 : long i, v, l;
772 28085583 : GEN r, y, p = pr_get_p(pr), mul = pr_get_tau(pr);
773 :
774 : /* p inert */
775 28085759 : if (typ(mul) == t_INT) return newx? ZV_pvalrem(x, p, newx):ZV_pval(x, p);
776 27761624 : y = cgetg_copy(x, &l); /* will hold the new x */
777 27761650 : x = leafcopy(x);
778 27760388 : for(v=0;; v++)
779 : {
780 130147429 : for (i=1; i<l; i++)
781 : { /* is (x.b)[i] divisible by p ? */
782 118552065 : gel(y,i) = dvmdii(ZMrow_ZC_mul(mul,x,i),p,&r);
783 118553755 : if (r != gen_0) { if (newx) *newx = x; return v; }
784 : }
785 11595364 : swap(x, y);
786 11595364 : if (!newx && (v & 0xf) == 0xf) v += pr_get_e(pr) * ZV_pvalrem(x, p, &x);
787 11595364 : if (gc_needed(av,1))
788 : {
789 0 : if(DEBUGMEM>1) pari_warn(warnmem,"ZC_nfvalrem, v >= %ld", v);
790 0 : gerepileall(av, 2, &x, &y);
791 : }
792 : }
793 : }
794 : long
795 25746048 : ZC_nfval(GEN x, GEN P)
796 25746048 : { return ZC_nfvalrem(x, P, NULL); }
797 :
798 : /* v_P(x) != 0, x a ZV. Simpler version of ZC_nfvalrem */
799 : int
800 1171824 : ZC_prdvd(GEN x, GEN P)
801 : {
802 1171824 : pari_sp av = avma;
803 : long i, l;
804 1171824 : GEN p = pr_get_p(P), mul = pr_get_tau(P);
805 1171827 : if (typ(mul) == t_INT) return ZV_Z_dvd(x, p);
806 1171484 : l = lg(x);
807 4701603 : for (i=1; i<l; i++)
808 4213603 : if (!dvdii(ZMrow_ZC_mul(mul,x,i), p)) return gc_bool(av,0);
809 488000 : return gc_bool(av,1);
810 : }
811 :
812 : int
813 28 : pr_equal(GEN P, GEN Q)
814 : {
815 28 : GEN gQ, p = pr_get_p(P);
816 28 : long e = pr_get_e(P), f = pr_get_f(P), n;
817 28 : if (!equalii(p, pr_get_p(Q)) || e != pr_get_e(Q) || f != pr_get_f(Q))
818 14 : return 0;
819 14 : gQ = pr_get_gen(Q); n = lg(gQ)-1;
820 14 : if (2*e*f > n) return 1; /* room for only one such pr */
821 7 : return ZV_equal(pr_get_gen(P), gQ) || ZC_prdvd(gQ, P);
822 : }
823 :
824 : GEN
825 1022 : famat_nfvalrem(GEN nf, GEN x, GEN pr, GEN *py)
826 : {
827 1022 : pari_sp av = avma;
828 1022 : GEN P = gel(x,1), E = gel(x,2), V = gen_0, y = NULL;
829 1022 : long l = lg(P), simplify = 0, i;
830 1022 : if (py) { *py = gen_1; y = cgetg(l, t_COL); }
831 :
832 294851 : for (i = 1; i < l; i++)
833 : {
834 293829 : GEN e = gel(E,i);
835 : long v;
836 293829 : if (!signe(e))
837 : {
838 7 : if (py) gel(y,i) = gen_1;
839 7 : simplify = 1; continue;
840 : }
841 293822 : v = nfvalrem(nf, gel(P,i), pr, py? &gel(y,i): NULL);
842 293822 : if (v == LONG_MAX) { set_avma(av); if (py) *py = gen_0; return mkoo(); }
843 293822 : V = addmulii(V, stoi(v), e);
844 : }
845 1022 : if (!py) V = gerepileuptoint(av, V);
846 : else
847 : {
848 42 : y = mkmat2(y, gel(x,2));
849 42 : if (simplify) y = famat_remove_trivial(y);
850 42 : gerepileall(av, 2, &V, &y); *py = y;
851 : }
852 1022 : return V;
853 : }
854 : long
855 1697666 : nfval(GEN nf, GEN x, GEN pr)
856 : {
857 1697666 : pari_sp av = avma;
858 : long w, e;
859 : GEN cx, p;
860 :
861 1697666 : if (gequal0(x)) return LONG_MAX;
862 1695940 : nf = checknf(nf);
863 1695936 : checkprid(pr);
864 1695938 : p = pr_get_p(pr);
865 1695935 : e = pr_get_e(pr);
866 1695933 : x = nf_to_scalar_or_basis(nf, x);
867 1695872 : if (typ(x) != t_COL) return e*Q_pval(x,p);
868 433646 : x = Q_primitive_part(x, &cx);
869 433697 : w = ZC_nfval(x,pr);
870 433621 : if (cx) w += e*Q_pval(cx,p);
871 433641 : return gc_long(av,w);
872 : }
873 :
874 : /* want to write p^v = uniformizer^(e*v) * z^v, z coprime to pr */
875 : /* z := tau^e / p^(e-1), algebraic integer coprime to pr; return z^v */
876 : static GEN
877 933698 : powp(GEN nf, GEN pr, long v)
878 : {
879 : GEN b, z;
880 : long e;
881 933698 : if (!v) return gen_1;
882 407546 : b = pr_get_tau(pr);
883 407546 : if (typ(b) == t_INT) return gen_1;
884 111698 : e = pr_get_e(pr);
885 111698 : z = gel(b,1);
886 111698 : if (e != 1) z = gdiv(nfpow_u(nf, z, e), powiu(pr_get_p(pr),e-1));
887 111698 : if (v < 0) { v = -v; z = nfinv(nf, z); }
888 111698 : if (v != 1) z = nfpow_u(nf, z, v);
889 111698 : return z;
890 : }
891 : long
892 2048070 : nfvalrem(GEN nf, GEN x, GEN pr, GEN *py)
893 : {
894 2048070 : pari_sp av = avma;
895 : long w, e;
896 : GEN cx, p, t;
897 :
898 2048070 : if (!py) return nfval(nf,x,pr);
899 1741092 : if (gequal0(x)) { *py = gen_0; return LONG_MAX; }
900 1741037 : nf = checknf(nf);
901 1741035 : checkprid(pr);
902 1741036 : p = pr_get_p(pr);
903 1741036 : e = pr_get_e(pr);
904 1741036 : x = nf_to_scalar_or_basis(nf, x);
905 1741036 : if (typ(x) != t_COL) {
906 521050 : w = Q_pvalrem(x,p, py);
907 521050 : if (!w) { *py = gerepilecopy(av, x); return 0; }
908 318423 : *py = gerepileupto(av, gmul(powp(nf, pr, w), *py));
909 318423 : return e*w;
910 : }
911 1219986 : x = Q_primitive_part(x, &cx);
912 1219986 : w = ZC_nfvalrem(x,pr, py);
913 1219961 : if (cx)
914 : {
915 615275 : long v = Q_pvalrem(cx,p, &t);
916 615275 : *py = nfmul(nf, *py, gmul(powp(nf,pr,v), t));
917 615275 : *py = gerepileupto(av, *py);
918 615275 : w += e*v;
919 : }
920 : else
921 604686 : *py = gerepilecopy(av, *py);
922 1219990 : return w;
923 : }
924 : GEN
925 14693 : gpnfvalrem(GEN nf, GEN x, GEN pr, GEN *py)
926 : {
927 : long v;
928 14693 : if (is_famat(x)) return famat_nfvalrem(nf, x, pr, py);
929 14686 : v = nfvalrem(nf,x,pr,py);
930 14686 : return v == LONG_MAX? mkoo(): stoi(v);
931 : }
932 :
933 : /* true nf */
934 : GEN
935 104365 : coltoalg(GEN nf, GEN x)
936 : {
937 104365 : return mkpolmod( nf_to_scalar_or_alg(nf, x), nf_get_pol(nf) );
938 : }
939 :
940 : GEN
941 151429 : basistoalg(GEN nf, GEN x)
942 : {
943 : GEN T;
944 :
945 151429 : nf = checknf(nf);
946 151429 : switch(typ(x))
947 : {
948 98226 : case t_COL: {
949 98226 : pari_sp av = avma;
950 98226 : return gerepilecopy(av, coltoalg(nf, x));
951 : }
952 32039 : case t_POLMOD:
953 32039 : T = nf_get_pol(nf);
954 32039 : if (!RgX_equal_var(T,gel(x,1)))
955 0 : pari_err_MODULUS("basistoalg", T,gel(x,1));
956 32039 : return gcopy(x);
957 1848 : case t_POL:
958 1848 : T = nf_get_pol(nf);
959 1848 : if (varn(T) != varn(x)) pari_err_VAR("basistoalg",x,T);
960 1848 : retmkpolmod(RgX_rem(x, T), ZX_copy(T));
961 19316 : case t_INT:
962 : case t_FRAC:
963 19316 : T = nf_get_pol(nf);
964 19316 : retmkpolmod(gcopy(x), ZX_copy(T));
965 0 : default:
966 0 : pari_err_TYPE("basistoalg",x);
967 : return NULL; /* LCOV_EXCL_LINE */
968 : }
969 : }
970 :
971 : /* true nf, x a t_POL */
972 : static GEN
973 4168475 : pol_to_scalar_or_basis(GEN nf, GEN x)
974 : {
975 4168475 : GEN T = nf_get_pol(nf);
976 4168470 : long l = lg(x);
977 4168470 : if (varn(x) != varn(T)) pari_err_VAR("nf_to_scalar_or_basis", x,T);
978 4168412 : if (l >= lg(T)) { x = RgX_rem(x, T); l = lg(x); }
979 4168412 : if (l == 2) return gen_0;
980 3138488 : if (l == 3)
981 : {
982 780408 : x = gel(x,2);
983 780408 : if (!is_rational_t(typ(x))) pari_err_TYPE("nf_to_scalar_or_basis",x);
984 780401 : return x;
985 : }
986 2358080 : return poltobasis(nf,x);
987 : }
988 : /* Assume nf is a genuine nf. */
989 : GEN
990 109048511 : nf_to_scalar_or_basis(GEN nf, GEN x)
991 : {
992 109048511 : switch(typ(x))
993 : {
994 73042360 : case t_INT: case t_FRAC:
995 73042360 : return x;
996 205777 : case t_POLMOD:
997 205777 : x = checknfelt_mod(nf,x,"nf_to_scalar_or_basis");
998 205714 : switch(typ(x))
999 : {
1000 35980 : case t_INT: case t_FRAC: return x;
1001 169734 : case t_POL: return pol_to_scalar_or_basis(nf,x);
1002 : }
1003 0 : break;
1004 3998752 : case t_POL: return pol_to_scalar_or_basis(nf,x);
1005 31804634 : case t_COL:
1006 31804634 : if (lg(x)-1 != nf_get_degree(nf)) break;
1007 31804451 : return QV_isscalar(x)? gel(x,1): x;
1008 : }
1009 54 : pari_err_TYPE("nf_to_scalar_or_basis",x);
1010 : return NULL; /* LCOV_EXCL_LINE */
1011 : }
1012 : /* Let x be a polynomial with coefficients in Q or nf. Return the same
1013 : * polynomial with coefficients expressed as vectors (on the integral basis).
1014 : * No consistency checks, not memory-clean. */
1015 : GEN
1016 23905 : RgX_to_nfX(GEN nf, GEN x)
1017 : {
1018 : long i, l;
1019 23905 : GEN y = cgetg_copy(x, &l); y[1] = x[1];
1020 203952 : for (i=2; i<l; i++) gel(y,i) = nf_to_scalar_or_basis(nf, gel(x,i));
1021 23905 : return y;
1022 : }
1023 :
1024 : /* Assume nf is a genuine nf. */
1025 : GEN
1026 2764939 : nf_to_scalar_or_alg(GEN nf, GEN x)
1027 : {
1028 2764939 : switch(typ(x))
1029 : {
1030 83613 : case t_INT: case t_FRAC:
1031 83613 : return x;
1032 0 : case t_POLMOD:
1033 0 : x = checknfelt_mod(nf,x,"nf_to_scalar_or_alg");
1034 0 : if (typ(x) != t_POL) return x;
1035 : /* fall through */
1036 : case t_POL:
1037 : {
1038 4144 : GEN T = nf_get_pol(nf);
1039 4144 : long l = lg(x);
1040 4144 : if (varn(x) != varn(T)) pari_err_VAR("nf_to_scalar_or_alg", x,T);
1041 4144 : if (l >= lg(T)) { x = RgX_rem(x, T); l = lg(x); }
1042 4144 : if (l == 2) return gen_0;
1043 4144 : if (l == 3) return gel(x,2);
1044 2919 : return x;
1045 : }
1046 2677141 : case t_COL:
1047 : {
1048 : GEN dx;
1049 2677141 : if (lg(x)-1 != nf_get_degree(nf)) break;
1050 5311281 : if (QV_isscalar(x)) return gel(x,1);
1051 2634055 : x = Q_remove_denom(x, &dx);
1052 2634059 : x = RgV_RgC_mul(nf_get_zkprimpart(nf), x);
1053 2634119 : dx = mul_denom(dx, nf_get_zkden(nf));
1054 2634096 : return gdiv(x,dx);
1055 : }
1056 : }
1057 42 : pari_err_TYPE("nf_to_scalar_or_alg",x);
1058 : return NULL; /* LCOV_EXCL_LINE */
1059 : }
1060 :
1061 : /* gmul(A, RgX_to_RgC(x)), A t_MAT of compatible dimensions */
1062 : GEN
1063 1337 : RgM_RgX_mul(GEN A, GEN x)
1064 : {
1065 1337 : long i, l = lg(x)-1;
1066 : GEN z;
1067 1337 : if (l == 1) return zerocol(nbrows(A));
1068 1337 : z = gmul(gel(x,2), gel(A,1));
1069 2541 : for (i = 2; i < l; i++)
1070 1204 : if (!gequal0(gel(x,i+1))) z = gadd(z, gmul(gel(x,i+1), gel(A,i)));
1071 1337 : return z;
1072 : }
1073 : GEN
1074 7741514 : ZM_ZX_mul(GEN A, GEN x)
1075 : {
1076 7741514 : long i, l = lg(x)-1;
1077 : GEN z;
1078 7741514 : if (l == 1) return zerocol(nbrows(A));
1079 7740380 : z = ZC_Z_mul(gel(A,1), gel(x,2));
1080 26481087 : for (i = 2; i < l ; i++)
1081 18743488 : if (signe(gel(x,i+1))) z = ZC_add(z, ZC_Z_mul(gel(A,i), gel(x,i+1)));
1082 7737599 : return z;
1083 : }
1084 : /* x a t_POL, nf a genuine nf. No garbage collecting. No check. */
1085 : GEN
1086 7136044 : poltobasis(GEN nf, GEN x)
1087 : {
1088 7136044 : GEN d, T = nf_get_pol(nf);
1089 7135986 : if (varn(x) != varn(T)) pari_err_VAR( "poltobasis", x,T);
1090 7135853 : if (degpol(x) >= degpol(T)) x = RgX_rem(x,T);
1091 7135778 : x = Q_remove_denom(x, &d);
1092 7135851 : if (!RgX_is_ZX(x)) pari_err_TYPE("poltobasis",x);
1093 7135812 : x = ZM_ZX_mul(nf_get_invzk(nf), x);
1094 7134128 : if (d) x = RgC_Rg_div(x, d);
1095 7134280 : return x;
1096 : }
1097 :
1098 : GEN
1099 514588 : algtobasis(GEN nf, GEN x)
1100 : {
1101 : pari_sp av;
1102 :
1103 514588 : nf = checknf(nf);
1104 514587 : switch(typ(x))
1105 : {
1106 107940 : case t_POLMOD:
1107 107940 : if (!RgX_equal_var(nf_get_pol(nf),gel(x,1)))
1108 7 : pari_err_MODULUS("algtobasis", nf_get_pol(nf),gel(x,1));
1109 107933 : x = gel(x,2);
1110 107933 : switch(typ(x))
1111 : {
1112 7497 : case t_INT:
1113 7497 : case t_FRAC: return scalarcol(x, nf_get_degree(nf));
1114 100436 : case t_POL:
1115 100436 : av = avma;
1116 100436 : return gerepileupto(av,poltobasis(nf,x));
1117 : }
1118 0 : break;
1119 :
1120 245949 : case t_POL:
1121 245949 : av = avma;
1122 245949 : return gerepileupto(av,poltobasis(nf,x));
1123 :
1124 81683 : case t_COL:
1125 81683 : if (!RgV_is_QV(x)) pari_err_TYPE("nfalgtobasis",x);
1126 81677 : if (lg(x)-1 != nf_get_degree(nf)) pari_err_DIM("nfalgtobasis");
1127 81677 : return gcopy(x);
1128 :
1129 79016 : case t_INT:
1130 79016 : case t_FRAC: return scalarcol(x, nf_get_degree(nf));
1131 : }
1132 0 : pari_err_TYPE("algtobasis",x);
1133 : return NULL; /* LCOV_EXCL_LINE */
1134 : }
1135 :
1136 : GEN
1137 44212 : rnfbasistoalg(GEN rnf,GEN x)
1138 : {
1139 44212 : const char *f = "rnfbasistoalg";
1140 : long lx, i;
1141 44212 : pari_sp av = avma;
1142 : GEN z, nf, R, T;
1143 :
1144 44212 : checkrnf(rnf);
1145 44212 : nf = rnf_get_nf(rnf);
1146 44212 : T = nf_get_pol(nf);
1147 44212 : R = QXQX_to_mod_shallow(rnf_get_pol(rnf), T);
1148 44212 : switch(typ(x))
1149 : {
1150 826 : case t_COL:
1151 826 : z = cgetg_copy(x, &lx);
1152 2478 : for (i=1; i<lx; i++)
1153 : {
1154 1701 : GEN c = nf_to_scalar_or_alg(nf, gel(x,i));
1155 1652 : if (typ(c) == t_POL) c = mkpolmod(c,T);
1156 1652 : gel(z,i) = c;
1157 : }
1158 777 : z = RgV_RgC_mul(gel(rnf_get_zk(rnf),1), z);
1159 714 : return gerepileupto(av, gmodulo(z,R));
1160 :
1161 29757 : case t_POLMOD:
1162 29757 : x = polmod_nffix(f, rnf, x, 0);
1163 29554 : if (typ(x) != t_POL) break;
1164 13629 : retmkpolmod(RgX_copy(x), RgX_copy(R));
1165 1099 : case t_POL:
1166 1099 : if (varn(x) == varn(T)) { RgX_check_QX(x,f); x = gmodulo(x,T); break; }
1167 875 : if (varn(x) == varn(R))
1168 : {
1169 826 : x = RgX_nffix(f,nf_get_pol(nf),x,0);
1170 826 : return gmodulo(x, R);
1171 : }
1172 49 : pari_err_VAR(f, x,R);
1173 : }
1174 28630 : retmkpolmod(scalarpol(x, varn(R)), RgX_copy(R));
1175 : }
1176 :
1177 : GEN
1178 1967 : matbasistoalg(GEN nf,GEN x)
1179 : {
1180 : long i, j, li, lx;
1181 1967 : GEN z = cgetg_copy(x, &lx);
1182 :
1183 1967 : if (lx == 1) return z;
1184 1960 : switch(typ(x))
1185 : {
1186 56 : case t_VEC: case t_COL:
1187 217 : for (i=1; i<lx; i++) gel(z,i) = basistoalg(nf, gel(x,i));
1188 56 : return z;
1189 1904 : case t_MAT: break;
1190 0 : default: pari_err_TYPE("matbasistoalg",x);
1191 : }
1192 1904 : li = lgcols(x);
1193 7154 : for (j=1; j<lx; j++)
1194 : {
1195 5250 : GEN c = cgetg(li,t_COL), xj = gel(x,j);
1196 5250 : gel(z,j) = c;
1197 25165 : for (i=1; i<li; i++) gel(c,i) = basistoalg(nf, gel(xj,i));
1198 : }
1199 1904 : return z;
1200 : }
1201 :
1202 : GEN
1203 29308 : matalgtobasis(GEN nf,GEN x)
1204 : {
1205 : long i, j, li, lx;
1206 29308 : GEN z = cgetg_copy(x, &lx);
1207 :
1208 29308 : if (lx == 1) return z;
1209 28944 : switch(typ(x))
1210 : {
1211 28937 : case t_VEC: case t_COL:
1212 72322 : for (i=1; i<lx; i++) gel(z,i) = algtobasis(nf, gel(x,i));
1213 28937 : return z;
1214 7 : case t_MAT: break;
1215 0 : default: pari_err_TYPE("matalgtobasis",x);
1216 : }
1217 7 : li = lgcols(x);
1218 14 : for (j=1; j<lx; j++)
1219 : {
1220 7 : GEN c = cgetg(li,t_COL), xj = gel(x,j);
1221 7 : gel(z,j) = c;
1222 21 : for (i=1; i<li; i++) gel(c,i) = algtobasis(nf, gel(xj,i));
1223 : }
1224 7 : return z;
1225 : }
1226 : GEN
1227 9114 : RgM_to_nfM(GEN nf,GEN x)
1228 : {
1229 : long i, j, li, lx;
1230 9114 : GEN z = cgetg_copy(x, &lx);
1231 :
1232 9114 : if (lx == 1) return z;
1233 9114 : li = lgcols(x);
1234 69531 : for (j=1; j<lx; j++)
1235 : {
1236 60417 : GEN c = cgetg(li,t_COL), xj = gel(x,j);
1237 60417 : gel(z,j) = c;
1238 406826 : for (i=1; i<li; i++) gel(c,i) = nf_to_scalar_or_basis(nf, gel(xj,i));
1239 : }
1240 9114 : return z;
1241 : }
1242 : GEN
1243 79877 : RgC_to_nfC(GEN nf, GEN x)
1244 587349 : { pari_APPLY_type(t_COL, nf_to_scalar_or_basis(nf, gel(x,i))) }
1245 :
1246 : /* x a t_POLMOD, supposedly in rnf = K[z]/(T), K = Q[y]/(Tnf) */
1247 : GEN
1248 135079 : polmod_nffix(const char *f, GEN rnf, GEN x, int lift)
1249 135079 : { return polmod_nffix2(f, rnf_get_nfpol(rnf), rnf_get_pol(rnf), x,lift); }
1250 : GEN
1251 135170 : polmod_nffix2(const char *f, GEN T, GEN R, GEN x, int lift)
1252 : {
1253 135170 : if (RgX_equal_var(gel(x,1), R))
1254 : {
1255 124432 : x = gel(x,2);
1256 124432 : if (typ(x) == t_POL && varn(x) == varn(R))
1257 : {
1258 95060 : x = RgX_nffix(f, T, x, lift);
1259 95060 : switch(lg(x))
1260 : {
1261 5782 : case 2: return gen_0;
1262 11179 : case 3: return gel(x,2);
1263 : }
1264 78099 : return x;
1265 : }
1266 : }
1267 40110 : return Rg_nffix(f, T, x, lift);
1268 : }
1269 : GEN
1270 1204 : rnfalgtobasis(GEN rnf,GEN x)
1271 : {
1272 1204 : const char *f = "rnfalgtobasis";
1273 1204 : pari_sp av = avma;
1274 : GEN T, R;
1275 :
1276 1204 : checkrnf(rnf);
1277 1204 : R = rnf_get_pol(rnf);
1278 1204 : T = rnf_get_nfpol(rnf);
1279 1204 : switch(typ(x))
1280 : {
1281 49 : case t_COL:
1282 49 : if (lg(x)-1 != rnf_get_degree(rnf)) pari_err_DIM(f);
1283 28 : x = RgV_nffix(f, T, x, 0);
1284 21 : return gerepilecopy(av, x);
1285 :
1286 1071 : case t_POLMOD:
1287 1071 : x = polmod_nffix(f, rnf, x, 0);
1288 1036 : if (typ(x) != t_POL) break;
1289 714 : return gerepileupto(av, RgM_RgX_mul(rnf_get_invzk(rnf), x));
1290 56 : case t_POL:
1291 56 : if (varn(x) == varn(T))
1292 : {
1293 21 : RgX_check_QX(x,f);
1294 14 : if (degpol(x) >= degpol(T)) x = RgX_rem(x,T);
1295 14 : x = mkpolmod(x,T); break;
1296 : }
1297 35 : x = RgX_nffix(f, T, x, 0);
1298 28 : if (degpol(x) >= degpol(R)) x = RgX_rem(x, R);
1299 28 : return gerepileupto(av, RgM_RgX_mul(rnf_get_invzk(rnf), x));
1300 : }
1301 364 : return gerepileupto(av, scalarcol(x, rnf_get_degree(rnf)));
1302 : }
1303 :
1304 : /* Given a and b in nf, gives an algebraic integer y in nf such that a-b.y
1305 : * is "small" */
1306 : GEN
1307 259 : nfdiveuc(GEN nf, GEN a, GEN b)
1308 : {
1309 259 : pari_sp av = avma;
1310 259 : a = nfdiv(nf,a,b);
1311 259 : return gerepileupto(av, ground(a));
1312 : }
1313 :
1314 : /* Given a and b in nf, gives a "small" algebraic integer r in nf
1315 : * of the form a-b.y */
1316 : GEN
1317 259 : nfmod(GEN nf, GEN a, GEN b)
1318 : {
1319 259 : pari_sp av = avma;
1320 259 : GEN p1 = gneg_i(nfmul(nf,b,ground(nfdiv(nf,a,b))));
1321 259 : return gerepileupto(av, nfadd(nf,a,p1));
1322 : }
1323 :
1324 : /* Given a and b in nf, gives a two-component vector [y,r] in nf such
1325 : * that r=a-b.y is "small". */
1326 : GEN
1327 259 : nfdivrem(GEN nf, GEN a, GEN b)
1328 : {
1329 259 : pari_sp av = avma;
1330 259 : GEN p1,z, y = ground(nfdiv(nf,a,b));
1331 :
1332 259 : p1 = gneg_i(nfmul(nf,b,y));
1333 259 : z = cgetg(3,t_VEC);
1334 259 : gel(z,1) = gcopy(y);
1335 259 : gel(z,2) = nfadd(nf,a,p1); return gerepileupto(av, z);
1336 : }
1337 :
1338 : /*************************************************************************/
1339 : /** **/
1340 : /** LOGARITHMIC EMBEDDINGS **/
1341 : /** **/
1342 : /*************************************************************************/
1343 :
1344 : static int
1345 858059 : low_prec(GEN x)
1346 : {
1347 858059 : switch(typ(x))
1348 : {
1349 0 : case t_INT: return !signe(x);
1350 858059 : case t_REAL: return !signe(x) || realprec(x) <= DEFAULTPREC;
1351 0 : default: return 0;
1352 : }
1353 : }
1354 :
1355 : static GEN
1356 29241 : cxlog_1(GEN nf) { return zerocol(lg(nf_get_roots(nf))-1); }
1357 : static GEN
1358 0 : cxlog_m1(GEN nf, long prec)
1359 : {
1360 0 : long i, l = lg(nf_get_roots(nf)), r1 = nf_get_r1(nf);
1361 0 : GEN v = cgetg(l, t_COL), p, P;
1362 0 : p = mppi(prec); P = mkcomplex(gen_0, p);
1363 0 : for (i = 1; i <= r1; i++) gel(v,i) = P; /* IPi*/
1364 0 : if (i < l) P = gmul2n(P,1);
1365 0 : for ( ; i < l; i++) gel(v,i) = P; /* 2IPi */
1366 0 : return v;
1367 : }
1368 : static GEN
1369 28427 : famat_cxlog(GEN nf, GEN fa, long prec)
1370 : {
1371 28427 : GEN g, e, y = NULL;
1372 : long i, l;
1373 :
1374 28427 : if (typ(fa) != t_MAT) pari_err_TYPE("famat_cxlog",fa);
1375 28427 : if (lg(fa) == 1) return cxlog_1(nf);
1376 28427 : g = gel(fa,1);
1377 28427 : e = gel(fa,2); l = lg(e);
1378 52609 : for (i = 1; i < l; i++)
1379 : {
1380 24182 : GEN t, x = nf_to_scalar_or_basis(nf, gel(g,i));
1381 : /* multiplicative arch would be better (save logs), but exponents overflow
1382 : * [ could keep track of expo separately, but not worth it ] */
1383 24182 : t = nf_cxlog(nf,x,prec); if (!t) return NULL;
1384 24182 : if (gel(t,1) == gen_0) continue; /* positive rational */
1385 14763 : t = RgC_Rg_mul(t, gel(e,i));
1386 14763 : y = y? RgV_add(y,t): t;
1387 : }
1388 28427 : return y ? y: cxlog_1(nf);
1389 : }
1390 : /* Archimedean components: [e_i Log( sigma_i(X) )], where X = primpart(x),
1391 : * and e_i = 1 (resp 2.) for i <= R1 (resp. > R1) */
1392 : GEN
1393 329972 : nf_cxlog(GEN nf, GEN x, long prec)
1394 : {
1395 : long i, l, r1;
1396 : GEN v;
1397 329972 : if (typ(x) == t_MAT) return famat_cxlog(nf,x,prec);
1398 301545 : x = nf_to_scalar_or_basis(nf,x);
1399 301545 : if (typ(x) != t_COL) return gsigne(x) > 0? cxlog_1(nf): cxlog_m1(nf, prec);
1400 291482 : x = RgM_RgC_mul(nf_get_M(nf), Q_primpart(x));
1401 291484 : l = lg(x); r1 = nf_get_r1(nf);
1402 759685 : for (i = 1; i <= r1; i++)
1403 468201 : if (low_prec(gel(x,i))) return NULL;
1404 461284 : for ( ; i < l; i++)
1405 169799 : if (low_prec(gnorm(gel(x,i)))) return NULL;
1406 291485 : v = cgetg(l,t_COL);
1407 759687 : for (i = 1; i <= r1; i++) gel(v,i) = glog(gel(x,i),prec);
1408 461285 : for ( ; i < l; i++) gel(v,i) = gmul2n(glog(gel(x,i),prec),1);
1409 291485 : return v;
1410 : }
1411 : GEN
1412 91 : nfV_cxlog(GEN nf, GEN x, long prec)
1413 : {
1414 : long i, l;
1415 91 : GEN v = cgetg_copy(x, &l);
1416 161 : for (i = 1; i < l; i++)
1417 70 : if (!(gel(v,i) = nf_cxlog(nf, gel(x,i), prec))) return NULL;
1418 91 : return v;
1419 : }
1420 :
1421 : static GEN
1422 7602 : scalar_logembed(GEN nf, GEN u, GEN *emb)
1423 : {
1424 : GEN v, logu;
1425 7602 : long i, s = signe(u), RU = lg(nf_get_roots(nf))-1, R1 = nf_get_r1(nf);
1426 :
1427 7602 : if (!s) pari_err_DOMAIN("nflogembed","argument","=",gen_0,u);
1428 7602 : v = cgetg(RU+1, t_COL); logu = logr_abs(u);
1429 9548 : for (i = 1; i <= R1; i++) gel(v,i) = logu;
1430 7602 : if (i <= RU)
1431 : {
1432 6727 : GEN logu2 = shiftr(logu,1);
1433 25375 : for ( ; i <= RU; i++) gel(v,i) = logu2;
1434 : }
1435 7602 : if (emb) *emb = const_col(RU, u);
1436 7602 : return v;
1437 : }
1438 :
1439 : static GEN
1440 1309 : famat_logembed(GEN nf,GEN x,GEN *emb,long prec)
1441 : {
1442 1309 : GEN A, M, T, a, t, g = gel(x,1), e = gel(x,2);
1443 1309 : long i, l = lg(e);
1444 :
1445 1309 : if (l == 1) return scalar_logembed(nf, real_1(prec), emb);
1446 1309 : A = NULL; T = emb? cgetg(l, t_COL): NULL;
1447 1309 : if (emb) *emb = M = mkmat2(T, e);
1448 62338 : for (i = 1; i < l; i++)
1449 : {
1450 61029 : a = nflogembed(nf, gel(g,i), &t, prec);
1451 61029 : if (!a) return NULL;
1452 61029 : a = RgC_Rg_mul(a, gel(e,i));
1453 61029 : A = A? RgC_add(A, a): a;
1454 61029 : if (emb) gel(T,i) = t;
1455 : }
1456 1309 : return A;
1457 : }
1458 :
1459 : /* Get archimedean components: [e_i log( | sigma_i(x) | )], with e_i = 1
1460 : * (resp 2.) for i <= R1 (resp. > R1) and set emb to the embeddings of x.
1461 : * Return NULL if precision problem */
1462 : GEN
1463 98793 : nflogembed(GEN nf, GEN x, GEN *emb, long prec)
1464 : {
1465 : long i, l, r1;
1466 : GEN v, t;
1467 :
1468 98793 : if (typ(x) == t_MAT) return famat_logembed(nf,x,emb,prec);
1469 97484 : x = nf_to_scalar_or_basis(nf,x);
1470 97484 : if (typ(x) != t_COL) return scalar_logembed(nf, gtofp(x,prec), emb);
1471 89882 : x = RgM_RgC_mul(nf_get_M(nf), x);
1472 89882 : l = lg(x); r1 = nf_get_r1(nf); v = cgetg(l,t_COL);
1473 116660 : for (i = 1; i <= r1; i++)
1474 : {
1475 26777 : t = gabs(gel(x,i),prec); if (low_prec(t)) return NULL;
1476 26777 : gel(v,i) = glog(t,prec);
1477 : }
1478 283168 : for ( ; i < l; i++)
1479 : {
1480 193286 : t = gnorm(gel(x,i)); if (low_prec(t)) return NULL;
1481 193285 : gel(v,i) = glog(t,prec);
1482 : }
1483 89882 : if (emb) *emb = x;
1484 89882 : return v;
1485 : }
1486 :
1487 : /*************************************************************************/
1488 : /** **/
1489 : /** REAL EMBEDDINGS **/
1490 : /** **/
1491 : /*************************************************************************/
1492 : static GEN
1493 484331 : sarch_get_cyc(GEN sarch) { return gel(sarch,1); }
1494 : static GEN
1495 694116 : sarch_get_archp(GEN sarch) { return gel(sarch,2); }
1496 : static GEN
1497 169196 : sarch_get_MI(GEN sarch) { return gel(sarch,3); }
1498 : static GEN
1499 169196 : sarch_get_lambda(GEN sarch) { return gel(sarch,4); }
1500 : static GEN
1501 169196 : sarch_get_F(GEN sarch) { return gel(sarch,5); }
1502 :
1503 : /* x not a scalar, true nf, return number of positive roots of char_x */
1504 : static long
1505 1278 : num_positive(GEN nf, GEN x)
1506 : {
1507 1278 : GEN T = nf_get_pol(nf), B, charx;
1508 : long dnf, vnf, N;
1509 1278 : x = nf_to_scalar_or_alg(nf, x); /* not a scalar */
1510 1278 : charx = ZXQ_charpoly(x, T, 0);
1511 1278 : charx = ZX_radical(charx);
1512 1278 : N = degpol(T) / degpol(charx);
1513 : /* real places are unramified ? */
1514 1278 : if (N == 1 || ZX_sturm(charx) * N == nf_get_r1(nf))
1515 1271 : return ZX_sturmpart(charx, mkvec2(gen_0,mkoo())) * N;
1516 : /* painful case, multiply by random square until primitive */
1517 7 : dnf = nf_get_degree(nf);
1518 7 : vnf = varn(T);
1519 7 : B = int2n(10);
1520 : for(;;)
1521 0 : {
1522 7 : GEN y = RgXQ_sqr(random_FpX(dnf, vnf, B), T);
1523 7 : y = RgXQ_mul(x, y, T);
1524 7 : charx = ZXQ_charpoly(y, T, 0);
1525 7 : if (ZX_is_squarefree(charx))
1526 7 : return ZX_sturmpart(charx, mkvec2(gen_0,mkoo())) * N;
1527 : }
1528 : }
1529 :
1530 : /* x a QC: return sigma_k(x) where 1 <= k <= r1+r2; correct but inefficient
1531 : * if x in Q. M = nf_get_M(nf) */
1532 : static GEN
1533 91 : nfembed_i(GEN M, GEN x, long k)
1534 : {
1535 91 : long i, l = lg(M);
1536 91 : GEN z = gel(x,1);
1537 364 : for (i = 2; i < l; i++) z = gadd(z, gmul(gcoeff(M,k,i), gel(x,i)));
1538 91 : return z;
1539 : }
1540 : GEN
1541 0 : nfembed(GEN nf, GEN x, long k)
1542 : {
1543 0 : pari_sp av = avma;
1544 0 : nf = checknf(nf);
1545 0 : x = nf_to_scalar_or_basis(nf,x);
1546 0 : if (typ(x) != t_COL) return gerepilecopy(av, x);
1547 0 : return gerepileupto(av, nfembed_i(nf_get_M(nf),x,k));
1548 : }
1549 :
1550 : /* x a ZC */
1551 : static GEN
1552 782854 : zk_embed(GEN M, GEN x, long k)
1553 : {
1554 782854 : long i, l = lg(x);
1555 782854 : GEN z = gel(x,1); /* times M[k,1], which is 1 */
1556 2556675 : for (i = 2; i < l; i++) z = mpadd(z, mpmul(gcoeff(M,k,i), gel(x,i)));
1557 782838 : return z;
1558 : }
1559 :
1560 : /* Given floating point approximation z of sigma_k(x), decide its sign
1561 : * [0/+, 1/- and -1 for FAIL] */
1562 : static long
1563 764357 : eval_sign_embed(GEN z)
1564 : { /* dubious, fail */
1565 764357 : if (typ(z) == t_REAL && realprec(z) <= LOWDEFAULTPREC) return -1;
1566 763492 : return (signe(z) < 1)? 1: 0;
1567 : }
1568 : /* return v such that (-1)^v = sign(sigma_k(x)), x primitive ZC */
1569 : static long
1570 651536 : eval_sign(GEN M, GEN x, long k)
1571 651536 : { return eval_sign_embed( zk_embed(M, x, k) ); }
1572 :
1573 : /* check that signs[i..#signs] == s; signs = NULL encodes "totally positive" */
1574 : static int
1575 0 : oksigns(long l, GEN signs, long i, long s)
1576 : {
1577 0 : if (!signs) return s == 0;
1578 0 : for (; i < l; i++)
1579 0 : if (signs[i] != s) return 0;
1580 0 : return 1;
1581 : }
1582 : /* check that signs[i] = s and signs[i+1..#signs] = 1-s */
1583 : static int
1584 0 : oksigns2(long l, GEN signs, long i, long s)
1585 : {
1586 0 : if (!signs) return s == 0 && i == l-1;
1587 0 : return signs[i] == s && oksigns(l, signs, i+1, 1-s);
1588 : }
1589 :
1590 : /* true nf, x a ZC (primitive for efficiency), embx its embeddings or NULL */
1591 : static int
1592 99274 : nfchecksigns_i(GEN nf, GEN x, GEN embx, GEN signs, GEN archp)
1593 : {
1594 99274 : long l = lg(archp), i;
1595 99274 : GEN M = nf_get_M(nf), sarch = NULL;
1596 99274 : long np = -1;
1597 166178 : for (i = 1; i < l; i++)
1598 : {
1599 : long s;
1600 128435 : if (embx)
1601 112832 : s = eval_sign_embed(gel(embx,i));
1602 : else
1603 15603 : s = eval_sign(M, x, archp[i]);
1604 : /* 0 / + or 1 / -; -1 for FAIL */
1605 128435 : if (s < 0) /* failure */
1606 : {
1607 0 : long ni, r1 = nf_get_r1(nf);
1608 : GEN xi;
1609 0 : if (np < 0)
1610 : {
1611 0 : np = num_positive(nf, x);
1612 0 : if (np == 0) return oksigns(l, signs, i, 1);
1613 0 : if (np == r1) return oksigns(l, signs, i, 0);
1614 0 : sarch = nfarchstar(nf, NULL, identity_perm(r1));
1615 : }
1616 0 : xi = set_sign_mod_divisor(nf, vecsmall_ei(r1, archp[i]), gen_1, sarch);
1617 0 : xi = Q_primpart(xi);
1618 0 : ni = num_positive(nf, nfmuli(nf,x,xi));
1619 0 : if (ni == 0) return oksigns2(l, signs, i, 0);
1620 0 : if (ni == r1) return oksigns2(l, signs, i, 1);
1621 0 : s = ni < np? 0: 1;
1622 : }
1623 128435 : if (s != (signs? signs[i]: 0)) return 0;
1624 : }
1625 37743 : return 1;
1626 : }
1627 : static void
1628 4214 : pl_convert(GEN pl, GEN *psigns, GEN *parchp)
1629 : {
1630 4214 : long i, j, l = lg(pl);
1631 4214 : GEN signs = cgetg(l, t_VECSMALL);
1632 4214 : GEN archp = cgetg(l, t_VECSMALL);
1633 36218 : for (i = j = 1; i < l; i++)
1634 : {
1635 32004 : if (!pl[i]) continue;
1636 16072 : archp[j] = i;
1637 16072 : signs[j] = (pl[i] < 0)? 1: 0;
1638 16072 : j++;
1639 : }
1640 4214 : setlg(archp, j); *parchp = archp;
1641 4214 : setlg(signs, j); *psigns = signs;
1642 4214 : }
1643 : /* pl : requested signs for real embeddings, 0 = no sign constraint */
1644 : int
1645 4739 : nfchecksigns(GEN nf, GEN x, GEN pl)
1646 : {
1647 4739 : pari_sp av = avma;
1648 : GEN signs, archp;
1649 4739 : nf = checknf(nf);
1650 4739 : x = nf_to_scalar_or_basis(nf,x);
1651 4739 : if (typ(x) != t_COL)
1652 : {
1653 525 : long i, l = lg(pl), s = gsigne(x);
1654 1064 : for (i = 1; i < l; i++)
1655 539 : if (pl[i] && pl[i] != s) return gc_bool(av,0);
1656 525 : return gc_bool(av,1);
1657 : }
1658 4214 : pl_convert(pl, &signs, &archp);
1659 4214 : return gc_bool(av, nfchecksigns_i(nf, x, NULL, signs, archp));
1660 : }
1661 :
1662 : /* signs = NULL: totally positive, else sign[i] = 0 (+) or 1 (-) */
1663 : static GEN
1664 169196 : get_C(GEN lambda, long l, GEN signs)
1665 : {
1666 : long i;
1667 : GEN C, mlambda;
1668 169196 : if (!signs) return const_vec(l-1, lambda);
1669 130528 : C = cgetg(l, t_COL); mlambda = gneg(lambda);
1670 334200 : for (i = 1; i < l; i++) gel(C,i) = signs[i]? mlambda: lambda;
1671 130528 : return C;
1672 : }
1673 : /* signs = NULL: totally positive at archp */
1674 : static GEN
1675 283652 : nfsetsigns(GEN nf, GEN signs, GEN x, GEN sarch)
1676 : {
1677 283652 : long i, l = lg(sarch_get_archp(sarch));
1678 : GEN ex;
1679 : /* Is signature already correct ? */
1680 283652 : if (typ(x) != t_COL)
1681 : {
1682 188595 : long s = gsigne(x);
1683 188595 : if (!s) i = 1;
1684 188581 : else if (!signs)
1685 4963 : i = (s < 0)? 1: l;
1686 : else
1687 : {
1688 183618 : s = s < 0? 1: 0;
1689 310374 : for (i = 1; i < l; i++)
1690 234576 : if (signs[i] != s) break;
1691 : }
1692 188595 : ex = (i < l)? const_col(l-1, x): NULL;
1693 : }
1694 : else
1695 : {
1696 95057 : pari_sp av = avma;
1697 95057 : GEN cex, M = nf_get_M(nf), archp = sarch_get_archp(sarch);
1698 95060 : GEN xp = Q_primitive_part(x,&cex);
1699 95059 : ex = cgetg(l,t_COL);
1700 226379 : for (i = 1; i < l; i++) gel(ex,i) = zk_embed(M,xp,archp[i]);
1701 95060 : if (nfchecksigns_i(nf, xp, ex, signs, archp)) { ex = NULL; set_avma(av); }
1702 61230 : else if (cex) ex = RgC_Rg_mul(ex, cex); /* put back content */
1703 : }
1704 283654 : if (ex)
1705 : { /* If no, fix it */
1706 169196 : GEN MI = sarch_get_MI(sarch), F = sarch_get_F(sarch);
1707 169196 : GEN lambda = sarch_get_lambda(sarch);
1708 169196 : GEN t = RgC_sub(get_C(lambda, l, signs), ex);
1709 : long e;
1710 169192 : t = grndtoi(RgM_RgC_mul(MI,t), &e);
1711 169180 : if (lg(F) != 1) t = ZM_ZC_mul(F, t);
1712 169189 : x = typ(x) == t_COL? RgC_add(t, x): RgC_Rg_add(t, x);
1713 : }
1714 283642 : return x;
1715 : }
1716 : /* - true nf
1717 : * - sarch = nfarchstar(nf, F);
1718 : * - x encodes a vector of signs at arch.archp: either a t_VECSMALL
1719 : * (vector of signs as {0,1}-vector), NULL (totally positive at archp),
1720 : * or a nonzero number field element (replaced by its signature at archp);
1721 : * - y is a nonzero number field element
1722 : * Return z = y (mod F) with signs(y, archp) = signs(x) (a {0,1}-vector) */
1723 : GEN
1724 315416 : set_sign_mod_divisor(GEN nf, GEN x, GEN y, GEN sarch)
1725 : {
1726 315416 : GEN archp = sarch_get_archp(sarch);
1727 315415 : if (lg(archp) == 1) return y;
1728 282277 : if (x && typ(x) != t_VECSMALL) x = nfsign_arch(nf, x, archp);
1729 282277 : y = nf_to_scalar_or_basis(nf,y);
1730 282279 : return nfsetsigns(nf, x, y, sarch);
1731 : }
1732 :
1733 : static GEN
1734 82583 : setsigns_init(GEN nf, GEN archp, GEN F, GEN DATA)
1735 : {
1736 82583 : GEN lambda, Mr = rowpermute(nf_get_M(nf), archp), MI = F? RgM_mul(Mr,F): Mr;
1737 82581 : lambda = gmul2n(matrixnorm(MI,DEFAULTPREC), -1);
1738 82582 : if (typ(lambda) != t_REAL) lambda = gmul(lambda, sstoQ(1001,1000));
1739 82582 : if (lg(archp) < lg(MI))
1740 : {
1741 58391 : GEN perm = gel(indexrank(MI), 2);
1742 58391 : if (!F) F = matid(nf_get_degree(nf));
1743 58391 : MI = vecpermute(MI, perm);
1744 58391 : F = vecpermute(F, perm);
1745 : }
1746 82582 : if (!F) F = cgetg(1,t_MAT);
1747 82582 : MI = RgM_inv(MI);
1748 82582 : return mkvec5(DATA, archp, MI, lambda, F);
1749 : }
1750 : /* F nonzero integral ideal in HNF (or NULL: Z_K), compute elements in 1+F
1751 : * whose sign matrix at archp is identity; archp in 'indices' format */
1752 : GEN
1753 258318 : nfarchstar(GEN nf, GEN F, GEN archp)
1754 : {
1755 258318 : long nba = lg(archp) - 1;
1756 258318 : if (!nba) return mkvec2(cgetg(1,t_VEC), archp);
1757 81212 : if (F && equali1(gcoeff(F,1,1))) F = NULL;
1758 81212 : if (F) F = idealpseudored(F, nf_get_roundG(nf));
1759 81210 : return setsigns_init(nf, archp, F, const_vec(nba, gen_2));
1760 : }
1761 :
1762 : /*************************************************************************/
1763 : /** **/
1764 : /** IDEALCHINESE **/
1765 : /** **/
1766 : /*************************************************************************/
1767 : static int
1768 3087 : isprfact(GEN x)
1769 : {
1770 : long i, l;
1771 : GEN L, E;
1772 3087 : if (typ(x) != t_MAT || lg(x) != 3) return 0;
1773 3087 : L = gel(x,1); l = lg(L);
1774 3087 : E = gel(x,2);
1775 7602 : for(i=1; i<l; i++)
1776 : {
1777 4515 : checkprid(gel(L,i));
1778 4515 : if (typ(gel(E,i)) != t_INT) return 0;
1779 : }
1780 3087 : return 1;
1781 : }
1782 :
1783 : /* initialize projectors mod pr[i]^e[i] for idealchinese */
1784 : static GEN
1785 3087 : pr_init(GEN nf, GEN fa, GEN w, GEN dw)
1786 : {
1787 3087 : GEN U, E, F, L = gel(fa,1), E0 = gel(fa,2);
1788 3087 : long i, r = lg(L);
1789 :
1790 3087 : if (w && lg(w) != r) pari_err_TYPE("idealchinese", w);
1791 3087 : if (r == 1 && !dw) return cgetg(1,t_VEC);
1792 3080 : E = leafcopy(E0); /* do not destroy fa[2] */
1793 7595 : for (i = 1; i < r; i++)
1794 4515 : if (signe(gel(E,i)) < 0) gel(E,i) = gen_0;
1795 3080 : F = factorbackprime(nf, L, E);
1796 3080 : if (dw)
1797 : {
1798 700 : F = ZM_Z_mul(F, dw);
1799 1603 : for (i = 1; i < r; i++)
1800 : {
1801 903 : GEN pr = gel(L,i);
1802 903 : long e = itos(gel(E0,i)), v = idealval(nf, dw, pr);
1803 903 : if (e >= 0)
1804 896 : gel(E,i) = addiu(gel(E,i), v);
1805 7 : else if (v + e <= 0)
1806 0 : F = idealmulpowprime(nf, F, pr, stoi(-v)); /* coprime to pr */
1807 : else
1808 : {
1809 7 : F = idealmulpowprime(nf, F, pr, stoi(e));
1810 7 : gel(E,i) = stoi(v + e);
1811 : }
1812 : }
1813 : }
1814 3080 : U = cgetg(r, t_VEC);
1815 7595 : for (i = 1; i < r; i++)
1816 : {
1817 : GEN u;
1818 4515 : if (w && gequal0(gel(w,i))) u = gen_0; /* unused */
1819 : else
1820 : {
1821 4438 : GEN pr = gel(L,i), e = gel(E,i), t;
1822 4438 : t = idealdivpowprime(nf,F, pr, e);
1823 4438 : u = hnfmerge_get_1(t, idealpow(nf, pr, e));
1824 4438 : if (!u) pari_err_COPRIME("idealchinese", t,pr);
1825 : }
1826 4515 : gel(U,i) = u;
1827 : }
1828 3080 : F = idealpseudored(F, nf_get_roundG(nf));
1829 3080 : return mkvec2(F, U);
1830 : }
1831 :
1832 : static GEN
1833 1785 : pl_normalize(GEN nf, GEN pl)
1834 : {
1835 1785 : const char *fun = "idealchinese";
1836 1785 : if (lg(pl)-1 != nf_get_r1(nf)) pari_err_TYPE(fun,pl);
1837 1785 : switch(typ(pl))
1838 : {
1839 714 : case t_VEC: RgV_check_ZV(pl,fun); pl = ZV_to_zv(pl);
1840 : /* fall through */
1841 1785 : case t_VECSMALL: break;
1842 0 : default: pari_err_TYPE(fun,pl);
1843 : }
1844 1785 : return pl;
1845 : }
1846 :
1847 : static int
1848 7357 : is_chineseinit(GEN x)
1849 : {
1850 : GEN fa, pl;
1851 : long l;
1852 7357 : if (typ(x) != t_VEC || lg(x)!=3) return 0;
1853 5677 : fa = gel(x,1);
1854 5677 : pl = gel(x,2);
1855 5677 : if (typ(fa) != t_VEC || typ(pl) != t_VEC) return 0;
1856 2905 : l = lg(fa);
1857 2905 : if (l != 1)
1858 : {
1859 2884 : if (l != 3 || typ(gel(fa,1)) != t_MAT || typ(gel(fa,2)) != t_VEC)
1860 7 : return 0;
1861 : }
1862 2898 : l = lg(pl);
1863 2898 : if (l != 1)
1864 : {
1865 511 : if (l != 6 || typ(gel(pl,3)) != t_MAT || typ(gel(pl,1)) != t_VECSMALL
1866 511 : || typ(gel(pl,2)) != t_VECSMALL)
1867 0 : return 0;
1868 : }
1869 2898 : return 1;
1870 : }
1871 :
1872 : /* nf a true 'nf' */
1873 : static GEN
1874 3220 : chineseinit_i(GEN nf, GEN fa, GEN w, GEN dw)
1875 : {
1876 3220 : const char *fun = "idealchineseinit";
1877 3220 : GEN archp = NULL, pl = NULL;
1878 3220 : switch(typ(fa))
1879 : {
1880 1785 : case t_VEC:
1881 1785 : if (is_chineseinit(fa))
1882 : {
1883 0 : if (dw) pari_err_DOMAIN(fun, "denom(y)", "!=", gen_1, w);
1884 0 : return fa;
1885 : }
1886 1785 : if (lg(fa) != 3) pari_err_TYPE(fun, fa);
1887 : /* of the form [x,s] */
1888 1785 : pl = pl_normalize(nf, gel(fa,2));
1889 1785 : fa = gel(fa,1);
1890 1785 : archp = vecsmall01_to_indices(pl);
1891 : /* keep pr_init, reset pl */
1892 1785 : if (is_chineseinit(fa)) { fa = gel(fa,1); break; }
1893 : /* fall through */
1894 : case t_MAT: /* factorization? */
1895 3087 : if (isprfact(fa)) { fa = pr_init(nf, fa, w, dw); break; }
1896 0 : default: pari_err_TYPE(fun,fa);
1897 : }
1898 :
1899 3220 : if (!pl) pl = cgetg(1,t_VEC);
1900 : else
1901 : {
1902 1785 : long r = lg(archp);
1903 1785 : if (r == 1) pl = cgetg(1, t_VEC);
1904 : else
1905 : {
1906 1365 : GEN F = (lg(fa) == 1)? NULL: gel(fa,1), signs = cgetg(r, t_VECSMALL);
1907 : long i;
1908 3374 : for (i = 1; i < r; i++) signs[i] = (pl[archp[i]] < 0)? 1: 0;
1909 1365 : pl = setsigns_init(nf, archp, F, signs);
1910 : }
1911 : }
1912 3220 : return mkvec2(fa, pl);
1913 : }
1914 :
1915 : /* Given a prime ideal factorization x, possibly with 0 or negative exponents,
1916 : * and a vector w of elements of nf, gives b such that
1917 : * v_p(b-w_p)>=v_p(x) for all prime ideals p in the ideal factorization
1918 : * and v_p(b)>=0 for all other p, using the standard proof given in GTM 138. */
1919 : GEN
1920 5985 : idealchinese(GEN nf, GEN x, GEN w)
1921 : {
1922 5985 : const char *fun = "idealchinese";
1923 5985 : pari_sp av = avma;
1924 : GEN x1, x2, s, dw, F;
1925 :
1926 5985 : nf = checknf(nf);
1927 5985 : if (!w) return gerepilecopy(av, chineseinit_i(nf,x,NULL,NULL));
1928 :
1929 3787 : if (typ(w) != t_VEC) pari_err_TYPE(fun,w);
1930 3787 : w = Q_remove_denom(matalgtobasis(nf,w), &dw);
1931 3787 : if (!is_chineseinit(x)) x = chineseinit_i(nf,x,w,dw);
1932 : /* x is a 'chineseinit' */
1933 3787 : x1 = gel(x,1); s = NULL;
1934 3787 : x2 = gel(x,2);
1935 3787 : if (lg(x1) == 1) F = NULL;
1936 : else
1937 : {
1938 3766 : GEN U = gel(x1,2);
1939 3766 : long i, r = lg(w);
1940 3766 : F = gel(x1,1);
1941 11305 : for (i=1; i<r; i++)
1942 7539 : if (!gequal0(gel(w,i)))
1943 : {
1944 4459 : GEN t = nfmuli(nf, gel(U,i), gel(w,i));
1945 4459 : s = s? ZC_add(s,t): t;
1946 : }
1947 3766 : if (s) s = ZC_reducemodmatrix(s, F);
1948 : }
1949 3787 : if (lg(x2) != 1) s = nfsetsigns(nf, gel(x2,1), s? s: gen_0, x2);
1950 3787 : if (!s) { s = zerocol(nf_get_degree(nf)); dw = NULL; }
1951 :
1952 3787 : if (dw) s = RgC_Rg_div(s,dw);
1953 3787 : return gerepileupto(av, s);
1954 : }
1955 :
1956 : /*************************************************************************/
1957 : /** **/
1958 : /** (Z_K/I)^* **/
1959 : /** **/
1960 : /*************************************************************************/
1961 : GEN
1962 1785 : vecsmall01_to_indices(GEN v)
1963 : {
1964 1785 : long i, k, l = lg(v);
1965 1785 : GEN p = new_chunk(l) + l;
1966 4788 : for (k=1, i=l-1; i; i--)
1967 3003 : if (v[i]) { *--p = i; k++; }
1968 1785 : *--p = evallg(k) | evaltyp(t_VECSMALL);
1969 1785 : set_avma((pari_sp)p); return p;
1970 : }
1971 : GEN
1972 744368 : vec01_to_indices(GEN v)
1973 : {
1974 : long i, k, l;
1975 : GEN p;
1976 :
1977 744368 : switch (typ(v))
1978 : {
1979 698695 : case t_VECSMALL: return v;
1980 45673 : case t_VEC: break;
1981 0 : default: pari_err_TYPE("vec01_to_indices",v);
1982 : }
1983 45673 : l = lg(v);
1984 45673 : p = new_chunk(l) + l;
1985 137451 : for (k=1, i=l-1; i; i--)
1986 91778 : if (signe(gel(v,i))) { *--p = i; k++; }
1987 45673 : *--p = evallg(k) | evaltyp(t_VECSMALL);
1988 45673 : set_avma((pari_sp)p); return p;
1989 : }
1990 : GEN
1991 136613 : indices_to_vec01(GEN p, long r)
1992 : {
1993 136613 : long i, l = lg(p);
1994 136613 : GEN v = zerovec(r);
1995 206253 : for (i = 1; i < l; i++) gel(v, p[i]) = gen_1;
1996 136610 : return v;
1997 : }
1998 :
1999 : /* return (column) vector of R1 signatures of x (0 or 1) */
2000 : GEN
2001 698695 : nfsign_arch(GEN nf, GEN x, GEN arch)
2002 : {
2003 698695 : GEN sarch, M, V, archp = vec01_to_indices(arch);
2004 698695 : long i, s, np, n = lg(archp)-1;
2005 : pari_sp av;
2006 :
2007 698695 : if (!n) return cgetg(1,t_VECSMALL);
2008 641988 : if (typ(x) == t_MAT)
2009 : { /* factorisation */
2010 219931 : GEN g = gel(x,1), e = gel(x,2);
2011 219931 : long l = lg(g);
2012 219931 : V = zero_zv(n);
2013 591799 : for (i = 1; i < l; i++)
2014 371868 : if (mpodd(gel(e,i)))
2015 293174 : Flv_add_inplace(V, nfsign_arch(nf,gel(g,i),archp), 2);
2016 219931 : set_avma((pari_sp)V); return V;
2017 : }
2018 422057 : av = avma; V = cgetg(n+1,t_VECSMALL);
2019 422057 : x = nf_to_scalar_or_basis(nf, x);
2020 422058 : switch(typ(x))
2021 : {
2022 90928 : case t_INT:
2023 90928 : s = signe(x);
2024 90928 : if (!s) pari_err_DOMAIN("nfsign_arch","element","=",gen_0,x);
2025 90928 : set_avma(av); return const_vecsmall(n, (s < 0)? 1: 0);
2026 329 : case t_FRAC:
2027 329 : s = signe(gel(x,1));
2028 329 : set_avma(av); return const_vecsmall(n, (s < 0)? 1: 0);
2029 : }
2030 330801 : x = Q_primpart(x); M = nf_get_M(nf); sarch = NULL; np = -1;
2031 965902 : for (i = 1; i <= n; i++)
2032 : {
2033 635930 : long s = eval_sign(M, x, archp[i]);
2034 635923 : if (s < 0) /* failure */
2035 : {
2036 865 : long ni, r1 = nf_get_r1(nf);
2037 : GEN xi;
2038 865 : if (np < 0)
2039 : {
2040 865 : np = num_positive(nf, x);
2041 865 : if (np == 0) { set_avma(av); return const_vecsmall(n, 1); }
2042 817 : if (np == r1){ set_avma(av); return const_vecsmall(n, 0); }
2043 413 : sarch = nfarchstar(nf, NULL, identity_perm(r1));
2044 : }
2045 413 : xi = set_sign_mod_divisor(nf, vecsmall_ei(r1, archp[i]), gen_1, sarch);
2046 413 : xi = Q_primpart(xi);
2047 413 : ni = num_positive(nf, nfmuli(nf,x,xi));
2048 413 : if (ni == 0) { set_avma(av); V = const_vecsmall(n, 1); V[i] = 0; return V; }
2049 413 : if (ni == r1){ set_avma(av); V = const_vecsmall(n, 0); V[i] = 1; return V; }
2050 36 : s = ni < np? 0: 1;
2051 : }
2052 635094 : V[i] = s;
2053 : }
2054 329972 : set_avma((pari_sp)V); return V;
2055 : }
2056 : static void
2057 6384 : chk_ind(const char *s, long i, long r1)
2058 : {
2059 6384 : if (i <= 0) pari_err_DOMAIN(s, "index", "<=", gen_0, stoi(i));
2060 6370 : if (i > r1) pari_err_DOMAIN(s, "index", ">", utoi(r1), utoi(i));
2061 6335 : }
2062 : static GEN
2063 93436 : parse_embed(GEN ind, long r, const char *f)
2064 : {
2065 : long l, i;
2066 93436 : if (!ind) return identity_perm(r);
2067 4354 : switch(typ(ind))
2068 : {
2069 154 : case t_INT: case t_VEC: case t_COL: ind = gtovecsmall(ind); break;
2070 4200 : case t_VECSMALL: break;
2071 0 : default: pari_err_TYPE(f, ind);
2072 : }
2073 4354 : l = lg(ind);
2074 10689 : for (i = 1; i < l; i++) chk_ind(f, ind[i], r);
2075 4305 : return ind;
2076 : }
2077 : GEN
2078 91903 : nfeltsign(GEN nf, GEN x, GEN ind0)
2079 : {
2080 91903 : pari_sp av = avma;
2081 : long i, l;
2082 : GEN v, ind;
2083 91903 : nf = checknf(nf);
2084 91903 : ind = parse_embed(ind0, nf_get_r1(nf), "nfeltsign");
2085 91882 : l = lg(ind);
2086 91882 : if (is_rational_t(typ(x)))
2087 : { /* nfsign_arch would test this, but avoid converting t_VECSMALL -> t_VEC */
2088 : GEN s;
2089 2086 : switch(gsigne(x))
2090 : {
2091 525 : case -1:s = gen_m1; break;
2092 1554 : case 1: s = gen_1; break;
2093 7 : default: s = gen_0; break;
2094 : }
2095 2086 : set_avma(av);
2096 2086 : return (ind0 && typ(ind0) == t_INT)? s: const_vec(l-1, s);
2097 : }
2098 89796 : v = nfsign_arch(nf, x, ind);
2099 89796 : if (ind0 && typ(ind0) == t_INT) { set_avma(av); return v[1]? gen_m1: gen_1; }
2100 89782 : settyp(v, t_VEC);
2101 256095 : for (i = 1; i < l; i++) gel(v,i) = v[i]? gen_m1: gen_1;
2102 89782 : return gerepileupto(av, v);
2103 : }
2104 :
2105 : GEN
2106 63 : nfeltembed(GEN nf, GEN x, GEN ind0, long prec0)
2107 : {
2108 63 : pari_sp av = avma;
2109 : long i, e, l, r1, r2, prec, prec1;
2110 : GEN v, ind, cx;
2111 63 : nf = checknf(nf); nf_get_sign(nf,&r1,&r2);
2112 63 : x = nf_to_scalar_or_basis(nf, x);
2113 56 : ind = parse_embed(ind0, r1+r2, "nfeltembed");
2114 49 : l = lg(ind);
2115 49 : if (typ(x) != t_COL)
2116 : {
2117 0 : if (!(ind0 && typ(ind0) == t_INT)) x = const_vec(l-1, x);
2118 0 : return gerepilecopy(av, x);
2119 : }
2120 49 : x = Q_primitive_part(x, &cx);
2121 49 : prec1 = prec0; e = gexpo(x);
2122 49 : if (e > 8) prec1 += nbits2extraprec(e);
2123 49 : prec = prec1;
2124 49 : if (nf_get_prec(nf) < prec) nf = nfnewprec_shallow(nf, prec);
2125 49 : v = cgetg(l, t_VEC);
2126 : for(;;)
2127 7 : {
2128 56 : GEN M = nf_get_M(nf);
2129 140 : for (i = 1; i < l; i++)
2130 : {
2131 91 : GEN t = nfembed_i(M, x, ind[i]);
2132 91 : long e = gexpo(t);
2133 91 : if (gequal0(t) || precision(t) < prec0
2134 91 : || (e < 0 && prec < prec1 + nbits2extraprec(-e)) ) break;
2135 84 : if (cx) t = gmul(t, cx);
2136 84 : gel(v,i) = t;
2137 : }
2138 56 : if (i == l) break;
2139 7 : prec = precdbl(prec);
2140 7 : if (DEBUGLEVEL>1) pari_warn(warnprec,"eltnfembed", prec);
2141 7 : nf = nfnewprec_shallow(nf, prec);
2142 : }
2143 49 : if (ind0 && typ(ind0) == t_INT) v = gel(v,1);
2144 49 : return gerepilecopy(av, v);
2145 : }
2146 :
2147 : /* number of distinct roots of sigma(f) */
2148 : GEN
2149 1477 : nfpolsturm(GEN nf, GEN f, GEN ind0)
2150 : {
2151 1477 : pari_sp av = avma;
2152 : long d, l, r1, single;
2153 : GEN ind, u, v, vr1, T, s, t;
2154 :
2155 1477 : nf = checknf(nf); T = nf_get_pol(nf); r1 = nf_get_r1(nf);
2156 1477 : ind = parse_embed(ind0, r1, "nfpolsturm");
2157 1456 : single = ind0 && typ(ind0) == t_INT;
2158 1456 : l = lg(ind);
2159 :
2160 1456 : if (gequal0(f)) pari_err_ROOTS0("nfpolsturm");
2161 1449 : if (typ(f) == t_POL && varn(f) != varn(T))
2162 : {
2163 1428 : f = RgX_nffix("nfpolsturm", T, f,1);
2164 1428 : if (lg(f) == 3) f = NULL;
2165 : }
2166 : else
2167 : {
2168 21 : (void)Rg_nffix("nfpolsturm", T, f, 0);
2169 21 : f = NULL;
2170 : }
2171 1449 : if (!f) { set_avma(av); return single? gen_0: zerovec(l-1); }
2172 1428 : d = degpol(f);
2173 1428 : if (d == 1) { set_avma(av); return single? gen_1: const_vec(l-1,gen_1); }
2174 :
2175 1393 : vr1 = const_vecsmall(l-1, 1);
2176 1393 : u = Q_primpart(f); s = ZV_to_zv(nfeltsign(nf, gel(u,d+2), ind));
2177 1393 : v = RgX_deriv(u); t = odd(d)? leafcopy(s): zv_neg(s);
2178 : for(;;)
2179 182 : {
2180 1575 : GEN r = RgX_neg( Q_primpart(RgX_pseudorem(u, v)) ), sr;
2181 1575 : long i, dr = degpol(r);
2182 1575 : if (dr < 0) break;
2183 1575 : sr = ZV_to_zv(nfeltsign(nf, gel(r,dr+2), ind));
2184 3934 : for (i = 1; i < l; i++)
2185 2359 : if (sr[i] != s[i]) { s[i] = sr[i], vr1[i]--; }
2186 1575 : if (odd(dr)) sr = zv_neg(sr);
2187 3934 : for (i = 1; i < l; i++)
2188 2359 : if (sr[i] != t[i]) { t[i] = sr[i], vr1[i]++; }
2189 1575 : if (!dr) break;
2190 182 : u = v; v = r;
2191 : }
2192 1393 : if (single) { set_avma(av); return stoi(vr1[1]); }
2193 1386 : return gerepileupto(av, zv_to_ZV(vr1));
2194 : }
2195 :
2196 : /* True nf; return the vector of signs of x; the matrix of such if x is a vector
2197 : * of nf elements */
2198 : GEN
2199 43792 : nfsign(GEN nf, GEN x)
2200 : {
2201 : long i, l;
2202 : GEN archp, S;
2203 :
2204 43792 : archp = identity_perm( nf_get_r1(nf) );
2205 43792 : if (typ(x) != t_VEC) return nfsign_arch(nf, x, archp);
2206 35882 : l = lg(x); S = cgetg(l, t_MAT);
2207 147671 : for (i=1; i<l; i++) gel(S,i) = nfsign_arch(nf, gel(x,i), archp);
2208 35882 : return S;
2209 : }
2210 :
2211 : /* x integral elt, A integral ideal in HNF; reduce x mod A */
2212 : static GEN
2213 3749727 : zk_modHNF(GEN x, GEN A)
2214 3749727 : { return (typ(x) == t_COL)? ZC_hnfrem(x, A): modii(x, gcoeff(A,1,1)); }
2215 :
2216 : /* given an element x in Z_K and an integral ideal y in HNF, coprime with x,
2217 : outputs an element inverse of x modulo y */
2218 : GEN
2219 105 : nfinvmodideal(GEN nf, GEN x, GEN y)
2220 : {
2221 105 : pari_sp av = avma;
2222 105 : GEN a, yZ = gcoeff(y,1,1);
2223 :
2224 105 : if (equali1(yZ)) return gen_0;
2225 105 : x = nf_to_scalar_or_basis(nf, x);
2226 105 : if (typ(x) == t_INT) return gerepileupto(av, Fp_inv(x, yZ));
2227 :
2228 49 : a = hnfmerge_get_1(idealhnf_principal(nf,x), y);
2229 49 : if (!a) pari_err_INV("nfinvmodideal", x);
2230 49 : return gerepileupto(av, zk_modHNF(nfdiv(nf,a,x), y));
2231 : }
2232 :
2233 : static GEN
2234 1877329 : nfsqrmodideal(GEN nf, GEN x, GEN id)
2235 1877329 : { return zk_modHNF(nfsqri(nf,x), id); }
2236 : static GEN
2237 4493124 : nfmulmodideal(GEN nf, GEN x, GEN y, GEN id)
2238 4493124 : { return x? zk_modHNF(nfmuli(nf,x,y), id): y; }
2239 : /* assume x integral, k integer, A in HNF */
2240 : GEN
2241 3010555 : nfpowmodideal(GEN nf,GEN x,GEN k,GEN A)
2242 : {
2243 3010555 : long s = signe(k);
2244 : pari_sp av;
2245 : GEN y;
2246 :
2247 3010555 : if (!s) return gen_1;
2248 3010555 : av = avma;
2249 3010555 : x = nf_to_scalar_or_basis(nf, x);
2250 3010809 : if (typ(x) != t_COL) return Fp_pow(x, k, gcoeff(A,1,1));
2251 1541812 : if (s < 0) { x = nfinvmodideal(nf, x,A); k = negi(k); }
2252 1542107 : for(y = NULL;;)
2253 : {
2254 3419540 : if (mpodd(k)) y = nfmulmodideal(nf,y,x,A);
2255 3419348 : k = shifti(k,-1); if (!signe(k)) break;
2256 1876610 : x = nfsqrmodideal(nf,x,A);
2257 : }
2258 1541946 : return gerepileupto(av, y);
2259 : }
2260 :
2261 : /* a * g^n mod id */
2262 : static GEN
2263 1980340 : nfmulpowmodideal(GEN nf, GEN a, GEN g, GEN n, GEN id)
2264 : {
2265 1980340 : return nfmulmodideal(nf, a, nfpowmodideal(nf,g,n,id), id);
2266 : }
2267 :
2268 : /* assume (num(g[i]), id) = 1 for all i. Return prod g[i]^e[i] mod id.
2269 : * EX = multiple of exponent of (O_K/id)^* */
2270 : GEN
2271 1174229 : famat_to_nf_modideal_coprime(GEN nf, GEN g, GEN e, GEN id, GEN EX)
2272 : {
2273 1174229 : GEN EXo2, plus = NULL, minus = NULL, idZ = gcoeff(id,1,1);
2274 1174229 : long i, lx = lg(g);
2275 :
2276 1174229 : if (equali1(idZ)) return gen_1; /* id = Z_K */
2277 1173742 : EXo2 = (expi(EX) > 10)? shifti(EX,-1): NULL;
2278 3967669 : for (i = 1; i < lx; i++)
2279 : {
2280 2794057 : GEN h, n = centermodii(gel(e,i), EX, EXo2);
2281 2793512 : long sn = signe(n);
2282 2793512 : if (!sn) continue;
2283 :
2284 1725707 : h = nf_to_scalar_or_basis(nf, gel(g,i));
2285 1726183 : switch(typ(h))
2286 : {
2287 889929 : case t_INT: break;
2288 0 : case t_FRAC:
2289 0 : h = Fp_div(gel(h,1), gel(h,2), idZ); break;
2290 836254 : default:
2291 : {
2292 : GEN dh;
2293 836254 : h = Q_remove_denom(h, &dh);
2294 836379 : if (dh) h = FpC_Fp_mul(h, Fp_inv(dh,idZ), idZ);
2295 : }
2296 : }
2297 1726236 : if (sn > 0)
2298 1724675 : plus = nfmulpowmodideal(nf, plus, h, n, id);
2299 : else /* sn < 0 */
2300 1561 : minus = nfmulpowmodideal(nf, minus, h, negi(n), id);
2301 : }
2302 1173612 : if (minus) plus = nfmulmodideal(nf, plus, nfinvmodideal(nf,minus,id), id);
2303 1173707 : return plus? plus: gen_1;
2304 : }
2305 :
2306 : /* given 2 integral ideals x, y in HNF s.t x | y | x^2, compute (1+x)/(1+y) in
2307 : * the form [[cyc],[gen], U], where U := ux^-1 as a pair [ZM, denom(U)] */
2308 : static GEN
2309 235455 : zidealij(GEN x, GEN y)
2310 : {
2311 235455 : GEN U, G, cyc, xp = gcoeff(x,1,1), xi = hnf_invscale(x, xp);
2312 : long j, N;
2313 :
2314 : /* x^(-1) y = relations between the 1 + x_i (HNF) */
2315 235445 : cyc = ZM_snf_group(ZM_Z_divexact(ZM_mul(xi, y), xp), &U, &G);
2316 235439 : N = lg(cyc); G = ZM_mul(x,G); settyp(G, t_VEC); /* new generators */
2317 570085 : for (j=1; j<N; j++)
2318 : {
2319 334662 : GEN c = gel(G,j);
2320 334662 : gel(c,1) = addiu(gel(c,1), 1); /* 1 + g_j */
2321 334629 : if (ZV_isscalar(c)) gel(G,j) = gel(c,1);
2322 : }
2323 235423 : return mkvec4(cyc, G, ZM_mul(U,xi), xp);
2324 : }
2325 :
2326 : /* lg(x) > 1, x + 1; shallow */
2327 : static GEN
2328 167905 : ZC_add1(GEN x)
2329 : {
2330 167905 : long i, l = lg(x);
2331 167905 : GEN y = cgetg(l, t_COL);
2332 387959 : for (i = 2; i < l; i++) gel(y,i) = gel(x,i);
2333 167911 : gel(y,1) = addiu(gel(x,1), 1); return y;
2334 : }
2335 : /* lg(x) > 1, x - 1; shallow */
2336 : static GEN
2337 69215 : ZC_sub1(GEN x)
2338 : {
2339 69215 : long i, l = lg(x);
2340 69215 : GEN y = cgetg(l, t_COL);
2341 171113 : for (i = 2; i < l; i++) gel(y,i) = gel(x,i);
2342 69215 : gel(y,1) = subiu(gel(x,1), 1); return y;
2343 : }
2344 :
2345 : /* x,y are t_INT or ZC */
2346 : static GEN
2347 0 : zkadd(GEN x, GEN y)
2348 : {
2349 0 : long tx = typ(x);
2350 0 : if (tx == typ(y))
2351 0 : return tx == t_INT? addii(x,y): ZC_add(x,y);
2352 : else
2353 0 : return tx == t_INT? ZC_Z_add(y,x): ZC_Z_add(x,y);
2354 : }
2355 : /* x a t_INT or ZC, x+1; shallow */
2356 : static GEN
2357 253498 : zkadd1(GEN x)
2358 : {
2359 253498 : long tx = typ(x);
2360 253498 : return tx == t_INT? addiu(x,1): ZC_add1(x);
2361 : }
2362 : /* x a t_INT or ZC, x-1; shallow */
2363 : static GEN
2364 253531 : zksub1(GEN x)
2365 : {
2366 253531 : long tx = typ(x);
2367 253531 : return tx == t_INT? subiu(x,1): ZC_sub1(x);
2368 : }
2369 : /* x,y are t_INT or ZC; x - y */
2370 : static GEN
2371 0 : zksub(GEN x, GEN y)
2372 : {
2373 0 : long tx = typ(x), ty = typ(y);
2374 0 : if (tx == ty)
2375 0 : return tx == t_INT? subii(x,y): ZC_sub(x,y);
2376 : else
2377 0 : return tx == t_INT? Z_ZC_sub(x,y): ZC_Z_sub(x,y);
2378 : }
2379 : /* x is t_INT or ZM (mult. map), y is t_INT or ZC; x * y */
2380 : static GEN
2381 253494 : zkmul(GEN x, GEN y)
2382 : {
2383 253494 : long tx = typ(x), ty = typ(y);
2384 253494 : if (ty == t_INT)
2385 184302 : return tx == t_INT? mulii(x,y): ZC_Z_mul(gel(x,1),y);
2386 : else
2387 69192 : return tx == t_INT? ZC_Z_mul(y,x): ZM_ZC_mul(x,y);
2388 : }
2389 :
2390 : /* (U,V) = 1 coprime ideals. Want z = x mod U, = y mod V; namely
2391 : * z =vx + uy = v(x-y) + y, where u + v = 1, u in U, v in V.
2392 : * zkc = [v, UV], v a t_INT or ZM (mult. by v map), UV a ZM (ideal in HNF);
2393 : * shallow */
2394 : GEN
2395 0 : zkchinese(GEN zkc, GEN x, GEN y)
2396 : {
2397 0 : GEN v = gel(zkc,1), UV = gel(zkc,2), z = zkadd(zkmul(v, zksub(x,y)), y);
2398 0 : return zk_modHNF(z, UV);
2399 : }
2400 : /* special case z = x mod U, = 1 mod V; shallow */
2401 : GEN
2402 253528 : zkchinese1(GEN zkc, GEN x)
2403 : {
2404 253528 : GEN v = gel(zkc,1), UV = gel(zkc,2), z = zkadd1(zkmul(v, zksub1(x)));
2405 253505 : return (typ(z) == t_INT)? z: ZC_hnfrem(z, UV);
2406 : }
2407 : static GEN
2408 235622 : zkVchinese1(GEN zkc, GEN v)
2409 : {
2410 : long i, ly;
2411 235622 : GEN y = cgetg_copy(v, &ly);
2412 489108 : for (i=1; i<ly; i++) gel(y,i) = zkchinese1(zkc, gel(v,i));
2413 235579 : return y;
2414 : }
2415 :
2416 : /* prepare to solve z = x (mod A), z = y mod (B) [zkchinese or zkchinese1] */
2417 : GEN
2418 235371 : zkchineseinit(GEN nf, GEN A, GEN B, GEN AB)
2419 : {
2420 235371 : GEN v = idealaddtoone_raw(nf, A, B);
2421 : long e;
2422 235366 : if ((e = gexpo(v)) > 5)
2423 : {
2424 81948 : GEN b = (typ(v) == t_COL)? v: scalarcol_shallow(v, nf_get_degree(nf));
2425 81948 : b= ZC_reducemodlll(b, AB);
2426 81951 : if (gexpo(b) < e) v = b;
2427 : }
2428 235363 : return mkvec2(zk_scalar_or_multable(nf,v), AB);
2429 : }
2430 : /* prepare to solve z = x (mod A), z = 1 mod (B)
2431 : * and then z = 1 (mod A), z = y mod (B) [zkchinese1 twice] */
2432 : static GEN
2433 259 : zkchinese1init2(GEN nf, GEN A, GEN B, GEN AB)
2434 : {
2435 259 : GEN zkc = zkchineseinit(nf, A, B, AB);
2436 259 : GEN mv = gel(zkc,1), mu;
2437 259 : if (typ(mv) == t_INT) return mkvec2(zkc, mkvec2(subui(1,mv),AB));
2438 35 : mu = RgM_Rg_add_shallow(ZM_neg(mv), gen_1);
2439 35 : return mkvec2(mkvec2(mv,AB), mkvec2(mu,AB));
2440 : }
2441 :
2442 : static GEN
2443 1638860 : apply_U(GEN L, GEN a)
2444 : {
2445 1638860 : GEN e, U = gel(L,3), dU = gel(L,4);
2446 1638860 : if (typ(a) == t_INT)
2447 467128 : e = ZC_Z_mul(gel(U,1), subiu(a, 1));
2448 : else
2449 : { /* t_COL */
2450 1171732 : GEN t = shallowcopy(a);
2451 1171783 : gel(t,1) = subiu(gel(t,1), 1); /* t = a - 1 */
2452 1171666 : e = ZM_ZC_mul(U, t);
2453 : }
2454 1638791 : return gdiv(e, dU);
2455 : }
2456 :
2457 : /* true nf; vectors of [[cyc],[g],U.X^-1]. Assume k > 1. */
2458 : static GEN
2459 168290 : principal_units(GEN nf, GEN pr, long k, GEN prk)
2460 : {
2461 : GEN list, prb;
2462 168290 : ulong mask = quadratic_prec_mask(k);
2463 168290 : long a = 1;
2464 :
2465 168290 : prb = pr_hnf(nf,pr);
2466 168294 : list = vectrunc_init(k);
2467 403750 : while (mask > 1)
2468 : {
2469 235457 : GEN pra = prb;
2470 235457 : long b = a << 1;
2471 :
2472 235457 : if (mask & 1) b--;
2473 235457 : mask >>= 1;
2474 : /* compute 1 + pr^a / 1 + pr^b, 2a <= b */
2475 235457 : prb = (b >= k)? prk: idealpows(nf,pr,b);
2476 235456 : vectrunc_append(list, zidealij(pra, prb));
2477 235458 : a = b;
2478 : }
2479 168293 : return list;
2480 : }
2481 : /* a = 1 mod (pr) return log(a) on local-gens of 1+pr/1+pr^k */
2482 : static GEN
2483 916238 : log_prk1(GEN nf, GEN a, long nh, GEN L2, GEN prk)
2484 : {
2485 916238 : GEN y = cgetg(nh+1, t_COL);
2486 916239 : long j, iy, c = lg(L2)-1;
2487 2555063 : for (j = iy = 1; j <= c; j++)
2488 : {
2489 1638846 : GEN L = gel(L2,j), cyc = gel(L,1), gen = gel(L,2), E = apply_U(L,a);
2490 1638772 : long i, nc = lg(cyc)-1;
2491 1638772 : int last = (j == c);
2492 4302201 : for (i = 1; i <= nc; i++, iy++)
2493 : {
2494 2663377 : GEN t, e = gel(E,i);
2495 2663377 : if (typ(e) != t_INT) pari_err_COPRIME("zlog_prk1", a, prk);
2496 2663370 : t = Fp_neg(e, gel(cyc,i));
2497 2663323 : gel(y,iy) = negi(t);
2498 2663415 : if (!last && signe(t)) a = nfmulpowmodideal(nf, a, gel(gen,i), t, prk);
2499 : }
2500 : }
2501 916217 : return y;
2502 : }
2503 : /* true nf */
2504 : static GEN
2505 56196 : principal_units_relations(GEN nf, GEN L2, GEN prk, long nh)
2506 : {
2507 56196 : GEN h = cgetg(nh+1,t_MAT);
2508 56196 : long ih, j, c = lg(L2)-1;
2509 179555 : for (j = ih = 1; j <= c; j++)
2510 : {
2511 123361 : GEN L = gel(L2,j), F = gel(L,1), G = gel(L,2);
2512 123361 : long k, lG = lg(G);
2513 301488 : for (k = 1; k < lG; k++,ih++)
2514 : { /* log(g^f) mod pr^e */
2515 178129 : GEN a = nfpowmodideal(nf,gel(G,k),gel(F,k),prk);
2516 178124 : gel(h,ih) = ZC_neg(log_prk1(nf, a, nh, L2, prk));
2517 178127 : gcoeff(h,ih,ih) = gel(F,k);
2518 : }
2519 : }
2520 56194 : return h;
2521 : }
2522 : /* true nf; k > 1; multiplicative group (1 + pr) / (1 + pr^k) */
2523 : static GEN
2524 168289 : idealprincipalunits_i(GEN nf, GEN pr, long k, GEN *pU)
2525 : {
2526 168289 : GEN cyc, gen, L2, prk = idealpows(nf, pr, k);
2527 :
2528 168289 : L2 = principal_units(nf, pr, k, prk);
2529 168294 : if (k == 2)
2530 : {
2531 112099 : GEN L = gel(L2,1);
2532 112099 : cyc = gel(L,1);
2533 112099 : gen = gel(L,2);
2534 112099 : if (pU) *pU = matid(lg(gen)-1);
2535 : }
2536 : else
2537 : {
2538 56195 : long c = lg(L2), j;
2539 56195 : GEN EX, h, Ui, vg = cgetg(c, t_VEC);
2540 179551 : for (j = 1; j < c; j++) gel(vg, j) = gmael(L2,j,2);
2541 56194 : vg = shallowconcat1(vg);
2542 56196 : h = principal_units_relations(nf, L2, prk, lg(vg)-1);
2543 56196 : h = ZM_hnfall_i(h, NULL, 0);
2544 56196 : cyc = ZM_snf_group(h, pU, &Ui);
2545 56194 : c = lg(Ui); gen = cgetg(c, t_VEC); EX = cyc_get_expo(cyc);
2546 186495 : for (j = 1; j < c; j++)
2547 130302 : gel(gen,j) = famat_to_nf_modideal_coprime(nf, vg, gel(Ui,j), prk, EX);
2548 : }
2549 168293 : return mkvec4(cyc, gen, prk, L2);
2550 : }
2551 : GEN
2552 119 : idealprincipalunits(GEN nf, GEN pr, long k)
2553 : {
2554 : pari_sp av;
2555 : GEN v;
2556 119 : nf = checknf(nf);
2557 119 : if (k == 1) { checkprid(pr); retmkvec3(gen_1,cgetg(1,t_VEC),cgetg(1,t_VEC)); }
2558 112 : av = avma; v = idealprincipalunits_i(nf, pr, k, NULL);
2559 112 : return gerepilecopy(av, mkvec3(powiu(pr_norm(pr), k-1), gel(v,1), gel(v,2)));
2560 : }
2561 :
2562 : /* true nf; given an ideal pr^k dividing an integral ideal x (in HNF form)
2563 : * compute an 'sprk', the structure of G = (Z_K/pr^k)^* [ x = NULL for x=pr^k ]
2564 : * Return a vector with at least 4 components [cyc],[gen],[HNF pr^k,pr,k],ff,
2565 : * where
2566 : * cyc : type of G as abelian group (SNF)
2567 : * gen : generators of G, coprime to x
2568 : * pr^k: in HNF
2569 : * ff : data for log_g in (Z_K/pr)^*
2570 : * Two extra components are present iff k > 1: L2, U
2571 : * L2 : list of data structures to compute local DL in (Z_K/pr)^*,
2572 : * and 1 + pr^a/ 1 + pr^b for various a < b <= min(2a, k)
2573 : * U : base change matrices to convert a vector of local DL to DL wrt gen
2574 : * If MOD is not NULL, initialize G / G^MOD instead */
2575 : static GEN
2576 422469 : sprkinit(GEN nf, GEN pr, long k, GEN x, GEN MOD)
2577 : {
2578 422469 : GEN T, p, Ld, modpr, cyc, gen, g, g0, A, prk, U, L2, ord0 = NULL;
2579 422469 : long f = pr_get_f(pr);
2580 :
2581 422467 : if(DEBUGLEVEL>3) err_printf("treating pr^%ld, pr = %Ps\n",k,pr);
2582 422467 : modpr = nf_to_Fq_init(nf, &pr,&T,&p);
2583 422479 : if (MOD)
2584 : {
2585 377623 : GEN A = subiu(powiu(p,f), 1), d = gcdii(A, MOD), fa = Z_factor(d);
2586 377585 : ord0 = mkvec2(A, fa); /* true order, factorization of order in G/G^MOD */
2587 377573 : Ld = gel(fa,1);
2588 377573 : if (lg(Ld) > 1 && equaliu(gel(Ld,1),2)) Ld = vecslice(Ld,2,lg(Ld)-1);
2589 : }
2590 : /* (Z_K / pr)^* */
2591 422438 : if (f == 1)
2592 : {
2593 335026 : g0 = g = MOD? pgener_Fp_local(p, Ld): pgener_Fp(p);
2594 335048 : if (!ord0) ord0 = get_arith_ZZM(subiu(p,1));
2595 : }
2596 : else
2597 : {
2598 87412 : g0 = g = MOD? gener_FpXQ_local(T, p, Ld): gener_FpXQ(T,p, &ord0);
2599 87416 : g = Fq_to_nf(g, modpr);
2600 87416 : if (typ(g) == t_POL) g = poltobasis(nf, g);
2601 : }
2602 422469 : A = gel(ord0, 1); /* Norm(pr)-1 */
2603 : /* If MOD != NULL, d = gcd(A, MOD): g^(A/d) has order d */
2604 422469 : if (k == 1)
2605 : {
2606 254294 : cyc = mkvec(A);
2607 254289 : gen = mkvec(g);
2608 254285 : prk = pr_hnf(nf,pr);
2609 254292 : L2 = U = NULL;
2610 : }
2611 : else
2612 : { /* local-gens of (1 + pr)/(1 + pr^k) = SNF-gens * U */
2613 : GEN AB, B, u, v, w;
2614 : long j, l;
2615 168175 : w = idealprincipalunits_i(nf, pr, k, &U);
2616 : /* incorporate (Z_K/pr)^*, order A coprime to B = expo(1+pr/1+pr^k)*/
2617 168180 : cyc = leafcopy(gel(w,1)); B = cyc_get_expo(cyc); AB = mulii(A,B);
2618 168156 : gen = leafcopy(gel(w,2));
2619 168169 : prk = gel(w,3);
2620 168169 : g = nfpowmodideal(nf, g, B, prk);
2621 168182 : g0 = Fq_pow(g0, modii(B,A), T, p); /* update primitive root */
2622 168176 : L2 = mkvec3(A, g, gel(w,4));
2623 168179 : gel(cyc,1) = AB;
2624 168179 : gel(gen,1) = nfmulmodideal(nf, gel(gen,1), g, prk);
2625 168165 : u = mulii(Fp_inv(A,B), A);
2626 168160 : v = subui(1, u); l = lg(U);
2627 502421 : for (j = 1; j < l; j++) gcoeff(U,1,j) = Fp_mul(u, gcoeff(U,1,j), AB);
2628 168169 : U = mkvec2(Rg_col_ei(v, lg(gen)-1, 1), U);
2629 : }
2630 : /* local-gens of (Z_K/pr^k)^* = SNF-gens * U */
2631 422469 : if (x)
2632 : {
2633 235108 : GEN uv = zkchineseinit(nf, idealmulpowprime(nf,x,pr,utoineg(k)), prk, x);
2634 235105 : gen = zkVchinese1(uv, gen);
2635 : }
2636 422431 : return mkvecn(U? 6: 4, cyc, gen, prk, mkvec3(modpr,g0,ord0), L2, U);
2637 : }
2638 : static GEN
2639 2121198 : sprk_get_cyc(GEN s) { return gel(s,1); }
2640 : static GEN
2641 527492 : sprk_get_expo(GEN s) { return cyc_get_expo(sprk_get_cyc(s)); }
2642 : static GEN
2643 333531 : sprk_get_gen(GEN s) { return gel(s,2); }
2644 : static GEN
2645 2015409 : sprk_get_prk(GEN s) { return gel(s,3); }
2646 : static GEN
2647 1091298 : sprk_get_ff(GEN s) { return gel(s,4); }
2648 : static GEN
2649 632148 : sprk_get_pr(GEN s) { GEN ff = gel(s,4); return modpr_get_pr(gel(ff,1)); }
2650 : /* L2 to 1 + pr / 1 + pr^k */
2651 : static GEN
2652 799801 : sprk_get_L2(GEN s) { return gmael(s,5,3); }
2653 : /* lift to nf of primitive root of k(pr) */
2654 : static GEN
2655 10360 : sprk_get_gnf(GEN s) { return gmael(s,5,2); }
2656 : static void
2657 792199 : sprk_get_U2(GEN s, GEN *U1, GEN *U2)
2658 792199 : { GEN v = gel(s,6); *U1 = gel(v,1); *U2 = gel(v,2); }
2659 : static int
2660 1091239 : sprk_is_prime(GEN s) { return lg(s) == 5; }
2661 :
2662 : static GEN
2663 527429 : famat_zlog_pr(GEN nf, GEN g, GEN e, GEN sprk, GEN mod)
2664 : {
2665 527429 : GEN x, expo = sprk_get_expo(sprk);
2666 527429 : if (mod) expo = gcdii(expo,mod);
2667 527410 : x = famat_makecoprime(nf, g, e, sprk_get_pr(sprk), sprk_get_prk(sprk), expo);
2668 527434 : return log_prk(nf, x, sprk, mod);
2669 : }
2670 : /* famat_zlog_pr assuming (g,sprk.pr) = 1 */
2671 : static GEN
2672 63 : famat_zlog_pr_coprime(GEN nf, GEN g, GEN e, GEN sprk, GEN MOD)
2673 : {
2674 63 : GEN x = famat_to_nf_modideal_coprime(nf, g, e, sprk_get_prk(sprk),
2675 : sprk_get_expo(sprk));
2676 63 : return log_prk(nf, x, sprk, MOD);
2677 : }
2678 :
2679 : /* o t_INT, O = [ord,fa] format for multiple of o (for Fq_log);
2680 : * return o in [ord,fa] format */
2681 : static GEN
2682 443281 : order_update(GEN o, GEN O)
2683 : {
2684 443281 : GEN p = gmael(O,2,1), z = o, P, E;
2685 443281 : long i, j, l = lg(p);
2686 443281 : P = cgetg(l, t_COL);
2687 443275 : E = cgetg(l, t_COL);
2688 491988 : for (i = j = 1; i < l; i++)
2689 : {
2690 491988 : long v = Z_pvalrem(z, gel(p,i), &z);
2691 491944 : if (v)
2692 : {
2693 476957 : gel(P,j) = gel(p,i);
2694 476957 : gel(E,j) = utoipos(v); j++;
2695 476982 : if (is_pm1(z)) break;
2696 : }
2697 : }
2698 443253 : setlg(P, j);
2699 443252 : setlg(E, j); return mkvec2(o, mkmat2(P,E));
2700 : }
2701 :
2702 : /* a in Z_K (t_COL or t_INT), pr prime ideal, sprk = sprkinit(nf,pr,k,x),
2703 : * mod positive t_INT or NULL (meaning mod=0).
2704 : * return log(a) modulo mod on SNF-generators of (Z_K/pr^k)^* */
2705 : GEN
2706 1164255 : log_prk(GEN nf, GEN a, GEN sprk, GEN mod)
2707 : {
2708 : GEN e, prk, g, U1, U2, y, ff, O, o, oN, gN, N, T, p, modpr, pr, cyc;
2709 :
2710 1164255 : if (typ(a) == t_MAT) return famat_zlog_pr(nf, gel(a,1), gel(a,2), sprk, mod);
2711 1091290 : N = NULL;
2712 1091290 : ff = sprk_get_ff(sprk);
2713 1091297 : pr = gel(ff,1); /* modpr */
2714 1091297 : g = gN = gel(ff,2);
2715 1091297 : O = gel(ff,3); /* order of g = |Fq^*|, in [ord, fa] format */
2716 1091297 : o = oN = gel(O,1); /* order as a t_INT */
2717 1091297 : prk = sprk_get_prk(sprk);
2718 1091314 : modpr = nf_to_Fq_init(nf, &pr, &T, &p);
2719 1091299 : if (mod)
2720 : {
2721 999705 : GEN d = gcdii(o,mod);
2722 999433 : if (!equalii(o, d))
2723 : {
2724 633681 : N = diviiexact(o,d); /* > 1, coprime to p */
2725 633628 : a = nfpowmodideal(nf, a, N, prk);
2726 633789 : oN = d; /* order of g^N mod pr */
2727 : }
2728 : }
2729 1091147 : if (equali1(oN))
2730 388300 : e = gen_0;
2731 : else
2732 : {
2733 702929 : if (N) { O = order_update(oN, O); gN = Fq_pow(g, N, T, p); }
2734 702914 : e = Fq_log(nf_to_Fq(nf,a,modpr), gN, O, T, p);
2735 : }
2736 : /* 0 <= e < oN is correct modulo oN */
2737 1091295 : if (sprk_is_prime(sprk)) return mkcol(e); /* k = 1 */
2738 :
2739 395419 : sprk_get_U2(sprk, &U1,&U2);
2740 395488 : cyc = sprk_get_cyc(sprk);
2741 395489 : if (mod)
2742 : {
2743 372419 : cyc = ZV_snf_gcd(cyc, mod);
2744 372391 : if (signe(remii(mod,p))) return vecmodii(ZC_Z_mul(U1,e), cyc);
2745 : }
2746 341379 : if (signe(e))
2747 : {
2748 10360 : GEN E = N? mulii(e, N): e;
2749 10360 : a = nfmulpowmodideal(nf, a, sprk_get_gnf(sprk), Fp_neg(E, o), prk);
2750 : }
2751 : /* a = 1 mod pr */
2752 341379 : y = log_prk1(nf, a, lg(U2)-1, sprk_get_L2(sprk), prk);
2753 341408 : if (N)
2754 : { /* from DL(a^N) to DL(a) */
2755 135414 : GEN E = gel(sprk_get_cyc(sprk), 1), q = powiu(p, Z_pval(E, p));
2756 135413 : y = ZC_Z_mul(y, Fp_inv(N, q));
2757 : }
2758 341409 : y = ZC_lincomb(gen_1, e, ZM_ZC_mul(U2,y), U1);
2759 341409 : return vecmodii(y, cyc);
2760 : }
2761 : /* true nf */
2762 : GEN
2763 88949 : log_prk_init(GEN nf, GEN pr, long k, GEN MOD)
2764 88949 : { return sprkinit(nf,pr,k,NULL,MOD);}
2765 : GEN
2766 497 : veclog_prk(GEN nf, GEN v, GEN sprk)
2767 : {
2768 497 : long l = lg(v), i;
2769 497 : GEN w = cgetg(l, t_MAT);
2770 1232 : for (i = 1; i < l; i++) gel(w,i) = log_prk(nf, gel(v,i), sprk, NULL);
2771 497 : return w;
2772 : }
2773 :
2774 : static GEN
2775 358326 : famat_zlog(GEN nf, GEN fa, GEN sgn, zlog_S *S)
2776 : {
2777 358326 : long i, l0, l = lg(S->U);
2778 358326 : GEN g = gel(fa,1), e = gel(fa,2), y = cgetg(l, t_COL);
2779 358326 : l0 = lg(S->sprk); /* = l (trivial arch. part), or l-1 */
2780 812790 : for (i=1; i < l0; i++) gel(y,i) = famat_zlog_pr(nf, g, e, gel(S->sprk,i), S->mod);
2781 358322 : if (l0 != l)
2782 : {
2783 181158 : if (!sgn) sgn = nfsign_arch(nf, fa, S->archp);
2784 181158 : gel(y,l0) = Flc_to_ZC(sgn);
2785 : }
2786 358322 : return y;
2787 : }
2788 :
2789 : /* assume that cyclic factors are normalized, in particular != [1] */
2790 : static GEN
2791 256262 : split_U(GEN U, GEN Sprk)
2792 : {
2793 256262 : long t = 0, k, n, l = lg(Sprk);
2794 256262 : GEN vU = cgetg(l+1, t_VEC);
2795 589002 : for (k = 1; k < l; k++)
2796 : {
2797 332736 : n = lg(sprk_get_cyc(gel(Sprk,k))) - 1; /* > 0 */
2798 332735 : gel(vU,k) = vecslice(U, t+1, t+n);
2799 332740 : t += n;
2800 : }
2801 : /* t+1 .. lg(U)-1 */
2802 256266 : n = lg(U) - t - 1; /* can be 0 */
2803 256266 : if (!n) setlg(vU,l); else gel(vU,l) = vecslice(U, t+1, t+n);
2804 256270 : return vU;
2805 : }
2806 :
2807 : static void
2808 969747 : init_zlog_mod(zlog_S *S, GEN bid, GEN mod)
2809 : {
2810 969747 : GEN fa2 = bid_get_fact2(bid);
2811 969738 : S->U = bid_get_U(bid);
2812 969733 : S->hU = lg(bid_get_cyc(bid))-1;
2813 969725 : S->archp = bid_get_archp(bid);
2814 969725 : S->sprk = bid_get_sprk(bid);
2815 969720 : S->bid = bid;
2816 969720 : S->mod = mod;
2817 969720 : S->P = gel(fa2,1);
2818 969720 : S->k = gel(fa2,2);
2819 969720 : S->no2 = lg(S->P) == lg(gel(bid_get_fact(bid),1));
2820 969724 : }
2821 : void
2822 377075 : init_zlog(zlog_S *S, GEN bid)
2823 : {
2824 377075 : return init_zlog_mod(S, bid, NULL);
2825 : }
2826 :
2827 : /* a a t_FRAC/t_INT, reduce mod bid */
2828 : static GEN
2829 14 : Q_mod_bid(GEN bid, GEN a)
2830 : {
2831 14 : GEN xZ = gcoeff(bid_get_ideal(bid),1,1);
2832 14 : GEN b = Rg_to_Fp(a, xZ);
2833 14 : if (gsigne(a) < 0) b = subii(b, xZ);
2834 14 : return signe(b)? b: xZ;
2835 : }
2836 : /* Return decomposition of a on the CRT generators blocks attached to the
2837 : * S->sprk and sarch; sgn = sign(a, S->arch), NULL if unknown */
2838 : static GEN
2839 378654 : zlog(GEN nf, GEN a, GEN sgn, zlog_S *S)
2840 : {
2841 : long k, l;
2842 : GEN y;
2843 378654 : a = nf_to_scalar_or_basis(nf, a);
2844 378652 : switch(typ(a))
2845 : {
2846 161524 : case t_INT: break;
2847 14 : case t_FRAC: a = Q_mod_bid(S->bid, a); break;
2848 217114 : default: /* case t_COL: */
2849 : {
2850 : GEN den;
2851 217114 : check_nfelt(a, &den);
2852 217125 : if (den)
2853 : {
2854 98 : a = Q_muli_to_int(a, den);
2855 98 : a = mkmat2(mkcol2(a, den), mkcol2(gen_1, gen_m1));
2856 98 : return famat_zlog(nf, a, sgn, S);
2857 : }
2858 : }
2859 : }
2860 378557 : if (sgn)
2861 372523 : sgn = (lg(sgn) == 1)? NULL: leafcopy(sgn);
2862 : else
2863 6034 : sgn = (lg(S->archp) == 1)? NULL: nfsign_arch(nf, a, S->archp);
2864 378551 : l = lg(S->sprk);
2865 378551 : y = cgetg(sgn? l+1: l, t_COL);
2866 910011 : for (k = 1; k < l; k++)
2867 : {
2868 531510 : GEN sprk = gel(S->sprk,k);
2869 531510 : gel(y,k) = log_prk(nf, a, sprk, S->mod);
2870 : }
2871 378501 : if (sgn) gel(y,l) = Flc_to_ZC(sgn);
2872 378512 : return y;
2873 : }
2874 :
2875 : /* true nf */
2876 : GEN
2877 43265 : pr_basis_perm(GEN nf, GEN pr)
2878 : {
2879 43265 : long f = pr_get_f(pr);
2880 : GEN perm;
2881 43265 : if (f == nf_get_degree(nf)) return identity_perm(f);
2882 37604 : perm = cgetg(f+1, t_VECSMALL);
2883 37604 : perm[1] = 1;
2884 37604 : if (f > 1)
2885 : {
2886 2849 : GEN H = pr_hnf(nf,pr);
2887 : long i, k;
2888 10633 : for (i = k = 2; k <= f; i++)
2889 7784 : if (!equali1(gcoeff(H,i,i))) perm[k++] = i;
2890 : }
2891 37604 : return perm;
2892 : }
2893 :
2894 : /* \sum U[i]*y[i], U[i] ZM, y[i] ZC. We allow lg(y) > lg(U). */
2895 : static GEN
2896 736872 : ZMV_ZCV_mul(GEN U, GEN y)
2897 : {
2898 736872 : long i, l = lg(U);
2899 736872 : GEN z = NULL;
2900 736872 : if (l == 1) return cgetg(1,t_COL);
2901 2076137 : for (i = 1; i < l; i++)
2902 : {
2903 1339357 : GEN u = ZM_ZC_mul(gel(U,i), gel(y,i));
2904 1339322 : z = z? ZC_add(z, u): u;
2905 : }
2906 736780 : return z;
2907 : }
2908 : /* A * (U[1], ..., U[d] */
2909 : static GEN
2910 518 : ZM_ZMV_mul(GEN A, GEN U)
2911 : {
2912 : long i, l;
2913 518 : GEN V = cgetg_copy(U,&l);
2914 1057 : for (i = 1; i < l; i++) gel(V,i) = ZM_mul(A,gel(U,i));
2915 518 : return V;
2916 : }
2917 :
2918 : /* a = 1 mod pr, sprk mod pr^e, e >= 1 */
2919 : static GEN
2920 396735 : sprk_log_prk1_2(GEN nf, GEN a, GEN sprk)
2921 : {
2922 396735 : GEN U1, U2, y, L2 = sprk_get_L2(sprk);
2923 396733 : sprk_get_U2(sprk, &U1,&U2);
2924 396735 : y = ZM_ZC_mul(U2, log_prk1(nf, a, lg(U2)-1, L2, sprk_get_prk(sprk)));
2925 396727 : return vecmodii(y, sprk_get_cyc(sprk));
2926 : }
2927 : /* true nf; assume e >= 2 */
2928 : static GEN
2929 104710 : sprk_log_gen_pr2(GEN nf, GEN sprk, long e)
2930 : {
2931 104710 : GEN M, G, pr = sprk_get_pr(sprk);
2932 : long i, l;
2933 104710 : if (e == 2)
2934 : {
2935 61698 : GEN L2 = sprk_get_L2(sprk), L = gel(L2,1);
2936 61698 : G = gel(L,2); l = lg(G);
2937 : }
2938 : else
2939 : {
2940 43012 : GEN perm = pr_basis_perm(nf,pr), PI = nfpow_u(nf, pr_get_gen(pr), e-1);
2941 43013 : l = lg(perm);
2942 43013 : G = cgetg(l, t_VEC);
2943 43013 : if (typ(PI) == t_INT)
2944 : { /* zk_ei_mul doesn't allow t_INT */
2945 5654 : long N = nf_get_degree(nf);
2946 5654 : gel(G,1) = addiu(PI,1);
2947 8649 : for (i = 2; i < l; i++)
2948 : {
2949 2996 : GEN z = col_ei(N, 1);
2950 2996 : gel(G,i) = z; gel(z, perm[i]) = PI;
2951 : }
2952 : }
2953 : else
2954 : {
2955 37359 : gel(G,1) = nfadd(nf, gen_1, PI);
2956 44023 : for (i = 2; i < l; i++)
2957 6664 : gel(G,i) = nfadd(nf, gen_1, zk_ei_mul(nf, PI, perm[i]));
2958 : }
2959 : }
2960 104710 : M = cgetg(l, t_MAT);
2961 231765 : for (i = 1; i < l; i++) gel(M,i) = sprk_log_prk1_2(nf, gel(G,i), sprk);
2962 104694 : return M;
2963 : }
2964 : /* Log on bid.gen of generators of P_{1,I pr^{e-1}} / P_{1,I pr^e} (I,pr) = 1,
2965 : * defined implicitly via CRT. 'ind' is the index of pr in modulus
2966 : * factorization; true nf */
2967 : GEN
2968 410966 : log_gen_pr(zlog_S *S, long ind, GEN nf, long e)
2969 : {
2970 410966 : GEN Uind = gel(S->U, ind);
2971 410966 : if (e == 1) retmkmat( gel(Uind,1) );
2972 102663 : return ZM_mul(Uind, sprk_log_gen_pr2(nf, gel(S->sprk,ind), e));
2973 : }
2974 : /* true nf */
2975 : GEN
2976 2037 : sprk_log_gen_pr(GEN nf, GEN sprk, long e)
2977 : {
2978 2037 : if (e == 1)
2979 : {
2980 0 : long n = lg(sprk_get_cyc(sprk))-1;
2981 0 : retmkmat(col_ei(n, 1));
2982 : }
2983 2037 : return sprk_log_gen_pr2(nf, sprk, e);
2984 : }
2985 : /* a = 1 mod pr */
2986 : GEN
2987 269663 : sprk_log_prk1(GEN nf, GEN a, GEN sprk)
2988 : {
2989 269663 : if (lg(sprk) == 5) return mkcol(gen_0); /* mod pr */
2990 269663 : return sprk_log_prk1_2(nf, a, sprk);
2991 : }
2992 : /* Log on bid.gen of generator of P_{1,f} / P_{1,f v[index]}
2993 : * v = vector of r1 real places */
2994 : GEN
2995 85320 : log_gen_arch(zlog_S *S, long index)
2996 : {
2997 85320 : GEN U = gel(S->U, lg(S->U)-1);
2998 85320 : return gel(U, index);
2999 : }
3000 :
3001 : /* compute bid.clgp: [h,cyc] or [h,cyc,gen] */
3002 : static GEN
3003 257324 : bid_grp(GEN nf, GEN U, GEN cyc, GEN g, GEN F, GEN sarch)
3004 : {
3005 257324 : GEN G, h = ZV_prod(cyc);
3006 : long c;
3007 257335 : if (!U) return mkvec2(h,cyc);
3008 257055 : c = lg(U);
3009 257055 : G = cgetg(c,t_VEC);
3010 257055 : if (c > 1)
3011 : {
3012 227264 : GEN U0, Uoo, EX = cyc_get_expo(cyc); /* exponent of bid */
3013 227264 : long i, hU = nbrows(U), nba = lg(sarch_get_cyc(sarch))-1; /* #f_oo */
3014 227274 : if (!nba) { U0 = U; Uoo = NULL; }
3015 79931 : else if (nba == hU) { U0 = NULL; Uoo = U; }
3016 : else
3017 : {
3018 70838 : U0 = rowslice(U, 1, hU-nba);
3019 70836 : Uoo = rowslice(U, hU-nba+1, hU);
3020 : }
3021 691612 : for (i = 1; i < c; i++)
3022 : {
3023 464353 : GEN t = gen_1;
3024 464353 : if (U0) t = famat_to_nf_modideal_coprime(nf, g, gel(U0,i), F, EX);
3025 464327 : if (Uoo) t = set_sign_mod_divisor(nf, ZV_to_Flv(gel(Uoo,i),2), t, sarch);
3026 464339 : gel(G,i) = t;
3027 : }
3028 : }
3029 257050 : return mkvec3(h, cyc, G);
3030 : }
3031 :
3032 : /* remove prime ideals of norm 2 with exponent 1 from factorization */
3033 : static GEN
3034 257016 : famat_strip2(GEN fa)
3035 : {
3036 257016 : GEN P = gel(fa,1), E = gel(fa,2), Q, F;
3037 257016 : long l = lg(P), i, j;
3038 257016 : Q = cgetg(l, t_COL);
3039 257018 : F = cgetg(l, t_COL);
3040 629098 : for (i = j = 1; i < l; i++)
3041 : {
3042 372067 : GEN pr = gel(P,i), e = gel(E,i);
3043 372067 : if (!absequaliu(pr_get_p(pr), 2) || itou(e) != 1 || pr_get_f(pr) != 1)
3044 : {
3045 333516 : gel(Q,j) = pr;
3046 333516 : gel(F,j) = e; j++;
3047 : }
3048 : }
3049 257031 : setlg(Q,j);
3050 257028 : setlg(F,j); return mkmat2(Q,F);
3051 : }
3052 : static int
3053 134005 : checkarchp(GEN v, long r1)
3054 : {
3055 134005 : long i, l = lg(v);
3056 134005 : pari_sp av = avma;
3057 : GEN p;
3058 134005 : if (l == 1) return 1;
3059 47087 : if (l == 2) return v[1] > 0 && v[1] <= r1;
3060 21992 : p = zero_zv(r1);
3061 66066 : for (i = 1; i < l; i++)
3062 : {
3063 44100 : long j = v[i];
3064 44100 : if (j <= 0 || j > r1 || p[j]) return gc_long(av, 0);
3065 44065 : p[j] = 1;
3066 : }
3067 21966 : return gc_long(av, 1);
3068 : }
3069 :
3070 : /* True nf. Compute [[ideal,arch], [h,[cyc],[gen]], idealfact, [liste], U]
3071 : flag may include nf_GEN | nf_INIT */
3072 : static GEN
3073 257050 : Idealstarmod_i(GEN nf, GEN ideal, long flag, GEN MOD)
3074 : {
3075 : long i, nbp, R1;
3076 257050 : GEN y, cyc, U, u1 = NULL, fa, fa2, sprk, x, arch, archp, E, P, sarch, gen;
3077 :
3078 257050 : R1 = nf_get_r1(nf);
3079 257048 : if (typ(ideal) == t_VEC && lg(ideal) == 3)
3080 : {
3081 177739 : arch = gel(ideal,2);
3082 177739 : ideal= gel(ideal,1);
3083 355442 : switch(typ(arch))
3084 : {
3085 43734 : case t_VEC:
3086 43734 : if (lg(arch) != R1+1)
3087 0 : pari_err_TYPE("Idealstar [incorrect archimedean component]",arch);
3088 43734 : archp = vec01_to_indices(arch);
3089 43734 : break;
3090 134005 : case t_VECSMALL:
3091 134005 : if (!checkarchp(arch, R1))
3092 35 : pari_err_TYPE("Idealstar [incorrect archimedean component]",arch);
3093 133974 : archp = arch;
3094 133974 : arch = indices_to_vec01(archp, R1);
3095 133969 : break;
3096 0 : default:
3097 0 : pari_err_TYPE("Idealstar [incorrect archimedean component]",arch);
3098 : return NULL;/*LCOV_EXCL_LINE*/
3099 : }
3100 : }
3101 : else
3102 : {
3103 79309 : arch = zerovec(R1);
3104 79302 : archp = cgetg(1, t_VECSMALL);
3105 : }
3106 257003 : if (MOD)
3107 : {
3108 213575 : if (typ(MOD) != t_INT) pari_err_TYPE("bnrinit [incorrect cycmod]", MOD);
3109 213575 : if (mpodd(MOD) && lg(archp) != 1)
3110 231 : MOD = shifti(MOD, 1); /* ensure elements of G^MOD are >> 0 */
3111 : }
3112 256998 : if (is_nf_factor(ideal))
3113 : {
3114 39802 : fa = ideal;
3115 39802 : x = factorbackprime(nf, gel(fa,1), gel(fa,2));
3116 : }
3117 : else
3118 : {
3119 217199 : fa = idealfactor(nf, ideal);
3120 217247 : x = ideal;
3121 : }
3122 257048 : if (typ(x) != t_MAT) x = idealhnf_shallow(nf, x);
3123 257032 : if (lg(x) == 1) pari_err_DOMAIN("Idealstar", "ideal","=",gen_0,x);
3124 257032 : if (typ(gcoeff(x,1,1)) != t_INT)
3125 7 : pari_err_DOMAIN("Idealstar","denominator(ideal)", "!=",gen_1,x);
3126 257025 : sarch = nfarchstar(nf, x, archp);
3127 257016 : fa2 = famat_strip2(fa);
3128 257025 : P = gel(fa2,1);
3129 257025 : E = gel(fa2,2);
3130 257025 : nbp = lg(P)-1;
3131 257025 : sprk = cgetg(nbp+1,t_VEC);
3132 257035 : if (nbp)
3133 : {
3134 218109 : GEN t = (lg(gel(fa,1))==2)? NULL: x; /* beware fa != fa2 */
3135 218109 : cyc = cgetg(nbp+2,t_VEC);
3136 218101 : gen = cgetg(nbp+1,t_VEC);
3137 551641 : for (i = 1; i <= nbp; i++)
3138 : {
3139 333527 : GEN L = sprkinit(nf, gel(P,i), itou(gel(E,i)), t, MOD);
3140 333533 : gel(sprk,i) = L;
3141 333533 : gel(cyc,i) = sprk_get_cyc(L);
3142 : /* true gens are congruent to those mod x AND positive at archp */
3143 333532 : gel(gen,i) = sprk_get_gen(L);
3144 : }
3145 218114 : gel(cyc,i) = sarch_get_cyc(sarch);
3146 218113 : cyc = shallowconcat1(cyc);
3147 218119 : gen = shallowconcat1(gen);
3148 218120 : cyc = ZV_snf_group(cyc, &U, (flag & nf_GEN)? &u1: NULL);
3149 : }
3150 : else
3151 : {
3152 38926 : cyc = sarch_get_cyc(sarch);
3153 38926 : gen = cgetg(1,t_VEC);
3154 38927 : U = matid(lg(cyc)-1);
3155 38927 : if (flag & nf_GEN) u1 = U;
3156 : }
3157 257024 : y = bid_grp(nf, u1, cyc, gen, x, sarch);
3158 257034 : if (!(flag & nf_INIT)) return y;
3159 256222 : U = split_U(U, sprk);
3160 256226 : return mkvec5(mkvec2(x, arch), y, mkvec2(fa,fa2), mkvec2(sprk, sarch), U);
3161 : }
3162 : GEN
3163 256781 : Idealstarmod(GEN nf, GEN ideal, long flag, GEN MOD)
3164 : {
3165 256781 : pari_sp av = avma;
3166 256781 : nf = nf? checknf(nf): nfinit(pol_x(0), DEFAULTPREC);
3167 256783 : return gerepilecopy(av, Idealstarmod_i(nf, ideal, flag, MOD));
3168 : }
3169 : GEN
3170 952 : Idealstar(GEN nf, GEN ideal, long flag) { return Idealstarmod(nf, ideal, flag, NULL); }
3171 : GEN
3172 273 : Idealstarprk(GEN nf, GEN pr, long k, long flag)
3173 : {
3174 273 : pari_sp av = avma;
3175 273 : GEN z = Idealstarmod_i(nf, mkmat2(mkcol(pr),mkcols(k)), flag, NULL);
3176 273 : return gerepilecopy(av, z);
3177 : }
3178 :
3179 : /* FIXME: obsolete */
3180 : GEN
3181 0 : zidealstarinitgen(GEN nf, GEN ideal)
3182 0 : { return Idealstar(nf,ideal, nf_INIT|nf_GEN); }
3183 : GEN
3184 0 : zidealstarinit(GEN nf, GEN ideal)
3185 0 : { return Idealstar(nf,ideal, nf_INIT); }
3186 : GEN
3187 0 : zidealstar(GEN nf, GEN ideal)
3188 0 : { return Idealstar(nf,ideal, nf_GEN); }
3189 :
3190 : GEN
3191 98 : idealstarmod(GEN nf, GEN ideal, long flag, GEN MOD)
3192 : {
3193 98 : switch(flag)
3194 : {
3195 0 : case 0: return Idealstarmod(nf,ideal, nf_GEN, MOD);
3196 84 : case 1: return Idealstarmod(nf,ideal, nf_INIT, MOD);
3197 14 : case 2: return Idealstarmod(nf,ideal, nf_INIT|nf_GEN, MOD);
3198 0 : default: pari_err_FLAG("idealstar");
3199 : }
3200 : return NULL; /* LCOV_EXCL_LINE */
3201 : }
3202 : GEN
3203 0 : idealstar0(GEN nf, GEN ideal,long flag) { return idealstarmod(nf, ideal, flag, NULL); }
3204 :
3205 : void
3206 217122 : check_nfelt(GEN x, GEN *den)
3207 : {
3208 217122 : long l = lg(x), i;
3209 217122 : GEN t, d = NULL;
3210 217122 : if (typ(x) != t_COL) pari_err_TYPE("check_nfelt", x);
3211 800222 : for (i=1; i<l; i++)
3212 : {
3213 583100 : t = gel(x,i);
3214 583100 : switch (typ(t))
3215 : {
3216 582883 : case t_INT: break;
3217 217 : case t_FRAC:
3218 217 : if (!d) d = gel(t,2); else d = lcmii(d, gel(t,2));
3219 217 : break;
3220 0 : default: pari_err_TYPE("check_nfelt", x);
3221 : }
3222 : }
3223 217122 : *den = d;
3224 217122 : }
3225 :
3226 : GEN
3227 3825434 : vecmodii(GEN x, GEN y)
3228 11410821 : { pari_APPLY_same(modii(gel(x,i), gel(y,i))) }
3229 : GEN
3230 1145522 : ZV_snf_gcd(GEN x, GEN mod)
3231 2947783 : { pari_APPLY_same(gcdii(gel(x,i), mod)); }
3232 :
3233 : GEN
3234 27594 : vecmoduu(GEN x, GEN y)
3235 88893 : { pari_APPLY_ulong(uel(x,i) % uel(y,i)) }
3236 :
3237 : /* assume a true bnf and bid */
3238 : GEN
3239 226217 : ideallog_units0(GEN bnf, GEN bid, GEN MOD)
3240 : {
3241 226217 : GEN nf = bnf_get_nf(bnf), D, y, C, cyc;
3242 226217 : long j, lU = lg(bnf_get_logfu(bnf)); /* r1+r2 */
3243 : zlog_S S;
3244 226216 : init_zlog_mod(&S, bid, MOD);
3245 226215 : if (!S.hU) return zeromat(0,lU);
3246 226215 : cyc = bid_get_cyc(bid);
3247 226215 : if (MOD) cyc = ZV_snf_gcd(cyc, MOD);
3248 226172 : D = nfsign_fu(bnf, bid_get_archp(bid));
3249 226216 : y = cgetg(lU, t_MAT);
3250 226218 : if ((C = bnf_build_cheapfu(bnf)))
3251 372507 : { for (j = 1; j < lU; j++) gel(y,j) = zlog(nf, gel(C,j), gel(D,j), &S); }
3252 : else
3253 : {
3254 21 : long i, l = lg(S.U), l0 = lg(S.sprk);
3255 : GEN X, U;
3256 21 : if (!(C = bnf_compactfu_mat(bnf))) bnf_build_units(bnf); /* error */
3257 21 : X = gel(C,1); U = gel(C,2);
3258 42 : for (j = 1; j < lU; j++) gel(y,j) = cgetg(l, t_COL);
3259 42 : for (i = 1; i < l0; i++)
3260 : {
3261 21 : GEN sprk = gel(S.sprk, i);
3262 21 : GEN Xi = sunits_makecoprime(X, sprk_get_pr(sprk), sprk_get_prk(sprk));
3263 42 : for (j = 1; j < lU; j++)
3264 21 : gcoeff(y,i,j) = famat_zlog_pr_coprime(nf, Xi, gel(U,j), sprk, MOD);
3265 : }
3266 21 : if (l0 != l)
3267 14 : for (j = 1; j < lU; j++) gcoeff(y,l0,j) = Flc_to_ZC(gel(D,j));
3268 : }
3269 226210 : y = vec_prepend(y, zlog(nf, bnf_get_tuU(bnf), nfsign_tu(bnf, S.archp), &S));
3270 598737 : for (j = 1; j <= lU; j++)
3271 372526 : gel(y,j) = vecmodii(ZMV_ZCV_mul(S.U, gel(y,j)), cyc);
3272 226211 : return y;
3273 : }
3274 : GEN
3275 84 : ideallog_units(GEN bnf, GEN bid)
3276 84 : { return ideallog_units0(bnf, bid, NULL); }
3277 : GEN
3278 518 : log_prk_units(GEN nf, GEN D, GEN sprk)
3279 : {
3280 518 : GEN L, Ltu = log_prk(nf, gel(D,1), sprk, NULL);
3281 518 : D = gel(D,2);
3282 518 : if (lg(D) != 3 || typ(gel(D,2)) != t_MAT) L = veclog_prk(nf, D, sprk);
3283 : else
3284 : {
3285 21 : GEN X = gel(D,1), U = gel(D,2);
3286 21 : long j, lU = lg(U);
3287 21 : X = sunits_makecoprime(X, sprk_get_pr(sprk), sprk_get_prk(sprk));
3288 21 : L = cgetg(lU, t_MAT);
3289 63 : for (j = 1; j < lU; j++)
3290 42 : gel(L,j) = famat_zlog_pr_coprime(nf, X, gel(U,j), sprk, NULL);
3291 : }
3292 518 : return vec_prepend(L, Ltu);
3293 : }
3294 :
3295 : static GEN
3296 366481 : ideallog_i(GEN nf, GEN x, zlog_S *S)
3297 : {
3298 366481 : pari_sp av = avma;
3299 : GEN y;
3300 366481 : if (!S->hU) return cgetg(1, t_COL);
3301 364360 : if (typ(x) == t_MAT)
3302 358228 : y = famat_zlog(nf, x, NULL, S);
3303 : else
3304 6132 : y = zlog(nf, x, NULL, S);
3305 364351 : y = ZMV_ZCV_mul(S->U, y);
3306 364353 : return gerepileupto(av, vecmodii(y, bid_get_cyc(S->bid)));
3307 : }
3308 : GEN
3309 373159 : ideallogmod(GEN nf, GEN x, GEN bid, GEN mod)
3310 : {
3311 : zlog_S S;
3312 373159 : if (!nf)
3313 : {
3314 6671 : if (mod) pari_err_IMPL("Zideallogmod");
3315 6671 : return Zideallog(bid, x);
3316 : }
3317 366488 : checkbid(bid); init_zlog_mod(&S, bid, mod);
3318 366481 : return ideallog_i(checknf(nf), x, &S);
3319 : }
3320 : GEN
3321 13265 : ideallog(GEN nf, GEN x, GEN bid) { return ideallogmod(nf, x, bid, NULL); }
3322 :
3323 : /*************************************************************************/
3324 : /** **/
3325 : /** JOIN BID STRUCTURES, IDEAL LISTS **/
3326 : /** **/
3327 : /*************************************************************************/
3328 : /* bid1, bid2: for coprime modules m1 and m2 (without arch. part).
3329 : * Output: bid for m1 m2 */
3330 : static GEN
3331 469 : join_bid(GEN nf, GEN bid1, GEN bid2)
3332 : {
3333 469 : pari_sp av = avma;
3334 : long nbgen, l1,l2;
3335 : GEN I1,I2, G1,G2, sprk1,sprk2, cyc1,cyc2, sarch;
3336 469 : GEN sprk, fa,fa2, U, cyc, y, u1 = NULL, x, gen;
3337 :
3338 469 : I1 = bid_get_ideal(bid1);
3339 469 : I2 = bid_get_ideal(bid2);
3340 469 : if (gequal1(gcoeff(I1,1,1))) return bid2; /* frequent trivial case */
3341 259 : G1 = bid_get_grp(bid1);
3342 259 : G2 = bid_get_grp(bid2);
3343 259 : x = idealmul(nf, I1,I2);
3344 259 : fa = famat_mul_shallow(bid_get_fact(bid1), bid_get_fact(bid2));
3345 259 : fa2= famat_mul_shallow(bid_get_fact2(bid1), bid_get_fact2(bid2));
3346 259 : sprk1 = bid_get_sprk(bid1);
3347 259 : sprk2 = bid_get_sprk(bid2);
3348 259 : sprk = shallowconcat(sprk1, sprk2);
3349 :
3350 259 : cyc1 = abgrp_get_cyc(G1); l1 = lg(cyc1);
3351 259 : cyc2 = abgrp_get_cyc(G2); l2 = lg(cyc2);
3352 259 : gen = (lg(G1)>3 && lg(G2)>3)? gen_1: NULL;
3353 259 : nbgen = l1+l2-2;
3354 259 : cyc = ZV_snf_group(shallowconcat(cyc1,cyc2), &U, gen? &u1: NULL);
3355 259 : if (nbgen)
3356 : {
3357 259 : GEN U1 = bid_get_U(bid1), U2 = bid_get_U(bid2);
3358 0 : U1 = l1==1? const_vec(lg(sprk1), cgetg(1,t_MAT))
3359 259 : : ZM_ZMV_mul(vecslice(U, 1, l1-1), U1);
3360 0 : U2 = l2==1? const_vec(lg(sprk2), cgetg(1,t_MAT))
3361 259 : : ZM_ZMV_mul(vecslice(U, l1, nbgen), U2);
3362 259 : U = shallowconcat(U1, U2);
3363 : }
3364 : else
3365 0 : U = const_vec(lg(sprk), cgetg(1,t_MAT));
3366 :
3367 259 : if (gen)
3368 : {
3369 259 : GEN uv = zkchinese1init2(nf, I2, I1, x);
3370 518 : gen = shallowconcat(zkVchinese1(gel(uv,1), abgrp_get_gen(G1)),
3371 259 : zkVchinese1(gel(uv,2), abgrp_get_gen(G2)));
3372 : }
3373 259 : sarch = bid_get_sarch(bid1); /* trivial */
3374 259 : y = bid_grp(nf, u1, cyc, gen, x, sarch);
3375 259 : x = mkvec2(x, bid_get_arch(bid1));
3376 259 : y = mkvec5(x, y, mkvec2(fa, fa2), mkvec2(sprk, sarch), U);
3377 259 : return gerepilecopy(av,y);
3378 : }
3379 :
3380 : typedef struct _ideal_data {
3381 : GEN nf, emb, L, pr, prL, sgnU, archp;
3382 : } ideal_data;
3383 :
3384 : /* z <- ( z | f(v[i])_{i=1..#v} ) */
3385 : static void
3386 758960 : concat_join(GEN *pz, GEN v, GEN (*f)(ideal_data*,GEN), ideal_data *data)
3387 : {
3388 758960 : long i, nz, lv = lg(v);
3389 : GEN z, Z;
3390 758960 : if (lv == 1) return;
3391 222983 : z = *pz; nz = lg(z)-1;
3392 222983 : *pz = Z = cgetg(lv + nz, typ(z));
3393 371712 : for (i = 1; i <=nz; i++) gel(Z,i) = gel(z,i);
3394 223358 : Z += nz;
3395 492079 : for (i = 1; i < lv; i++) gel(Z,i) = f(data, gel(v,i));
3396 : }
3397 : static GEN
3398 469 : join_idealinit(ideal_data *D, GEN x)
3399 469 : { return join_bid(D->nf, x, D->prL); }
3400 : static GEN
3401 268556 : join_ideal(ideal_data *D, GEN x)
3402 268556 : { return idealmulpowprime(D->nf, x, D->pr, D->L); }
3403 : static GEN
3404 448 : join_unit(ideal_data *D, GEN x)
3405 : {
3406 448 : GEN bid = join_idealinit(D, gel(x,1)), u = gel(x,2), v = mkvec(D->emb);
3407 448 : if (lg(u) != 1) v = shallowconcat(u, v);
3408 448 : return mkvec2(bid, v);
3409 : }
3410 :
3411 : GEN
3412 49 : log_prk_units_init(GEN bnf)
3413 : {
3414 49 : GEN U = bnf_has_fu(bnf);
3415 49 : if (U) U = matalgtobasis(bnf_get_nf(bnf), U);
3416 21 : else if (!(U = bnf_compactfu_mat(bnf))) (void)bnf_build_units(bnf);
3417 49 : return mkvec2(bnf_get_tuU(bnf), U);
3418 : }
3419 : /* flag & nf_GEN : generators, otherwise no
3420 : * flag &2 : units, otherwise no
3421 : * flag &4 : ideals in HNF, otherwise bid
3422 : * flag &8 : omit ideals which cannot be conductors (pr^1 with Npr=2) */
3423 : static GEN
3424 11331 : Ideallist(GEN bnf, ulong bound, long flag)
3425 : {
3426 11331 : const long do_units = flag & 2, big_id = !(flag & 4), cond = flag & 8;
3427 11331 : const long istar_flag = (flag & nf_GEN) | nf_INIT;
3428 : pari_sp av;
3429 : long i, j;
3430 11331 : GEN nf, z, p, fa, id, BOUND, U, empty = cgetg(1,t_VEC);
3431 : forprime_t S;
3432 : ideal_data ID;
3433 : GEN (*join_z)(ideal_data*, GEN);
3434 :
3435 11331 : if (do_units)
3436 : {
3437 21 : bnf = checkbnf(bnf);
3438 21 : nf = bnf_get_nf(bnf);
3439 21 : join_z = &join_unit;
3440 : }
3441 : else
3442 : {
3443 11310 : nf = checknf(bnf);
3444 11310 : join_z = big_id? &join_idealinit: &join_ideal;
3445 : }
3446 11331 : if ((long)bound <= 0) return empty;
3447 11331 : id = matid(nf_get_degree(nf));
3448 11332 : if (big_id) id = Idealstar(nf,id, istar_flag);
3449 :
3450 : /* z[i] will contain all "objects" of norm i. Depending on flag, this means
3451 : * an ideal, a bid, or a couple [bid, log(units)]. Such objects are stored
3452 : * in vectors, computed one primary component at a time; join_z
3453 : * reconstructs the global object */
3454 11332 : BOUND = utoipos(bound);
3455 11332 : z = const_vec(bound, empty);
3456 11332 : U = do_units? log_prk_units_init(bnf): NULL;
3457 11332 : gel(z,1) = mkvec(U? mkvec2(id, empty): id);
3458 11333 : ID.nf = nf;
3459 :
3460 11333 : p = cgetipos(3);
3461 11332 : u_forprime_init(&S, 2, bound);
3462 11333 : av = avma;
3463 92489 : while ((p[2] = u_forprime_next(&S)))
3464 : {
3465 81610 : if (DEBUGLEVEL>1) err_printf("%ld ",p[2]);
3466 81610 : fa = idealprimedec_limit_norm(nf, p, BOUND);
3467 162668 : for (j = 1; j < lg(fa); j++)
3468 : {
3469 81512 : GEN pr = gel(fa,j), z2 = leafcopy(z);
3470 81513 : ulong Q, q = upr_norm(pr);
3471 : long l;
3472 81514 : ID.pr = ID.prL = pr;
3473 81514 : if (cond && q == 2) { l = 2; Q = 4; } else { l = 1; Q = q; }
3474 184093 : for (; Q <= bound; l++, Q *= q) /* add pr^l */
3475 : {
3476 : ulong iQ;
3477 103041 : ID.L = utoipos(l);
3478 103039 : if (big_id) {
3479 210 : ID.prL = Idealstarprk(nf, pr, l, istar_flag);
3480 210 : if (U)
3481 189 : ID.emb = Q == 2? empty
3482 189 : : log_prk_units(nf, U, gel(bid_get_sprk(ID.prL),1));
3483 : }
3484 861473 : for (iQ = Q,i = 1; iQ <= bound; iQ += Q,i++)
3485 758894 : concat_join(&gel(z,iQ), gel(z2,i), join_z, &ID);
3486 : }
3487 : }
3488 81156 : if (gc_needed(av,1))
3489 : {
3490 39 : if(DEBUGMEM>1) pari_warn(warnmem,"Ideallist");
3491 39 : z = gerepilecopy(av, z);
3492 : }
3493 : }
3494 11333 : return z;
3495 : }
3496 : GEN
3497 49 : gideallist(GEN bnf, GEN B, long flag)
3498 : {
3499 49 : pari_sp av = avma;
3500 49 : if (typ(B) != t_INT)
3501 : {
3502 0 : B = gfloor(B);
3503 0 : if (typ(B) != t_INT) pari_err_TYPE("ideallist", B);
3504 0 : if (signe(B) < 0) B = gen_0;
3505 : }
3506 49 : if (signe(B) < 0)
3507 : {
3508 14 : if (flag != 4) pari_err_IMPL("ideallist with bid for single norm");
3509 14 : return gerepilecopy(av, ideals_by_norm(bnf_get_nf(bnf), absi(B)));
3510 : }
3511 35 : if (flag < 0 || flag > 15) pari_err_FLAG("ideallist");
3512 35 : return gerepilecopy(av, Ideallist(bnf, itou(B), flag));
3513 : }
3514 : GEN
3515 11296 : ideallist0(GEN bnf, long bound, long flag)
3516 : {
3517 11296 : pari_sp av = avma;
3518 11296 : if (flag < 0 || flag > 15) pari_err_FLAG("ideallist");
3519 11296 : return gerepilecopy(av, Ideallist(bnf, bound, flag));
3520 : }
3521 : GEN
3522 10563 : ideallist(GEN bnf,long bound) { return ideallist0(bnf,bound,4); }
3523 :
3524 : /* bid = for module m (without arch. part), arch = archimedean part.
3525 : * Output: bid for [m,arch] */
3526 : static GEN
3527 42 : join_bid_arch(GEN nf, GEN bid, GEN archp)
3528 : {
3529 42 : pari_sp av = avma;
3530 : GEN G, U;
3531 42 : GEN sprk, cyc, y, u1 = NULL, x, sarch, gen;
3532 :
3533 42 : checkbid(bid);
3534 42 : G = bid_get_grp(bid);
3535 42 : x = bid_get_ideal(bid);
3536 42 : sarch = nfarchstar(nf, bid_get_ideal(bid), archp);
3537 42 : sprk = bid_get_sprk(bid);
3538 :
3539 42 : gen = (lg(G)>3)? gel(G,3): NULL;
3540 42 : cyc = diagonal_shallow(shallowconcat(gel(G,2), sarch_get_cyc(sarch)));
3541 42 : cyc = ZM_snf_group(cyc, &U, gen? &u1: NULL);
3542 42 : y = bid_grp(nf, u1, cyc, gen, x, sarch);
3543 42 : U = split_U(U, sprk);
3544 42 : y = mkvec5(mkvec2(x, archp), y, gel(bid,3), mkvec2(sprk, sarch), U);
3545 42 : return gerepilecopy(av,y);
3546 : }
3547 : static GEN
3548 42 : join_arch(ideal_data *D, GEN x) {
3549 42 : return join_bid_arch(D->nf, x, D->archp);
3550 : }
3551 : static GEN
3552 14 : join_archunit(ideal_data *D, GEN x) {
3553 14 : GEN bid = join_arch(D, gel(x,1)), u = gel(x,2), v = mkvec(D->emb);
3554 14 : if (lg(u) != 1) v = shallowconcat(u, v);
3555 14 : return mkvec2(bid, v);
3556 : }
3557 :
3558 : /* L from ideallist, add archimedean part */
3559 : GEN
3560 14 : ideallistarch(GEN bnf, GEN L, GEN arch)
3561 : {
3562 : pari_sp av;
3563 14 : long i, j, l = lg(L), lz;
3564 : GEN v, z, V, nf;
3565 : ideal_data ID;
3566 : GEN (*join_z)(ideal_data*, GEN);
3567 :
3568 14 : if (typ(L) != t_VEC) pari_err_TYPE("ideallistarch",L);
3569 14 : if (l == 1) return cgetg(1,t_VEC);
3570 14 : z = gel(L,1);
3571 14 : if (typ(z) != t_VEC) pari_err_TYPE("ideallistarch",z);
3572 14 : z = gel(z,1); /* either a bid or [bid,U] */
3573 14 : ID.archp = vec01_to_indices(arch);
3574 14 : if (lg(z) == 3)
3575 : { /* [bid,U]: do units */
3576 7 : bnf = checkbnf(bnf); nf = bnf_get_nf(bnf);
3577 7 : if (typ(z) != t_VEC) pari_err_TYPE("ideallistarch",z);
3578 7 : ID.emb = zm_to_ZM( rowpermute(nfsign_units(bnf,NULL,1), ID.archp) );
3579 7 : join_z = &join_archunit;
3580 : }
3581 : else
3582 : {
3583 7 : join_z = &join_arch;
3584 7 : nf = checknf(bnf);
3585 : }
3586 14 : ID.nf = nf;
3587 14 : av = avma; V = cgetg(l, t_VEC);
3588 63 : for (i = 1; i < l; i++)
3589 : {
3590 49 : z = gel(L,i); lz = lg(z);
3591 49 : gel(V,i) = v = cgetg(lz,t_VEC);
3592 91 : for (j=1; j<lz; j++) gel(v,j) = join_z(&ID, gel(z,j));
3593 : }
3594 14 : return gerepilecopy(av,V);
3595 : }
|
