Line data Source code
1 : /* Copyright (C) 2000 The PARI group.
2 :
3 : This file is part of the PARI/GP package.
4 :
5 : PARI/GP is free software; you can redistribute it and/or modify it under the
6 : terms of the GNU General Public License as published by the Free Software
7 : Foundation. It is distributed in the hope that it will be useful, but WITHOUT
8 : ANY WARRANTY WHATSOEVER.
9 :
10 : Check the License for details. You should have received a copy of it, along
11 : with the package; see the file 'COPYING'. If not, write to the Free Software
12 : Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
13 :
14 : /*******************************************************************/
15 : /* */
16 : /* BASIC NF OPERATIONS */
17 : /* */
18 : /*******************************************************************/
19 : #include "pari.h"
20 : #include "paripriv.h"
21 :
22 : /*******************************************************************/
23 : /* */
24 : /* OPERATIONS OVER NUMBER FIELD ELEMENTS. */
25 : /* represented as column vectors over the integral basis */
26 : /* */
27 : /*******************************************************************/
28 : static GEN
29 11591152 : get_tab(GEN nf, long *N)
30 : {
31 11591152 : GEN tab = (typ(nf) == t_MAT)? nf: gel(nf,9);
32 11591152 : *N = nbrows(tab); return tab;
33 : }
34 :
35 : /* x != 0, y t_INT. Return x * y (not memory clean if x = 1) */
36 : static GEN
37 396567078 : _mulii(GEN x, GEN y) {
38 629747884 : return is_pm1(x)? (signe(x) < 0)? negi(y): y
39 629747884 : : mulii(x, y);
40 : }
41 :
42 : GEN
43 16989 : tablemul_ei_ej(GEN M, long i, long j)
44 : {
45 : long N;
46 16989 : GEN tab = get_tab(M, &N);
47 16989 : tab += (i-1)*N; return gel(tab,j);
48 : }
49 :
50 : /* Outputs x.ei, where ei is the i-th elt of the algebra basis.
51 : * x an RgV of correct length and arbitrary content (polynomials, scalars...).
52 : * M is the multiplication table ei ej = sum_k M_k^(i,j) ek */
53 : GEN
54 10213 : tablemul_ei(GEN M, GEN x, long i)
55 : {
56 : long j, k, N;
57 : GEN v, tab;
58 :
59 10213 : if (i==1) return gcopy(x);
60 10213 : tab = get_tab(M, &N);
61 10213 : if (typ(x) != t_COL) { v = zerocol(N); gel(v,i) = gcopy(x); return v; }
62 10213 : tab += (i-1)*N; v = cgetg(N+1,t_COL);
63 : /* wi . x = [ sum_j tab[k,j] x[j] ]_k */
64 69839 : for (k=1; k<=N; k++)
65 : {
66 59626 : pari_sp av = avma;
67 59626 : GEN s = gen_0;
68 417060 : for (j=1; j<=N; j++)
69 : {
70 357434 : GEN c = gcoeff(tab,k,j);
71 357434 : if (!gequal0(c)) s = gadd(s, gmul(c, gel(x,j)));
72 : }
73 59626 : gel(v,k) = gerepileupto(av,s);
74 : }
75 10213 : return v;
76 : }
77 : /* as tablemul_ei, assume x a ZV of correct length */
78 : GEN
79 9267372 : zk_ei_mul(GEN nf, GEN x, long i)
80 : {
81 : long j, k, N;
82 : GEN v, tab;
83 :
84 9267372 : if (i==1) return ZC_copy(x);
85 9267358 : tab = get_tab(nf, &N); tab += (i-1)*N;
86 9267358 : v = cgetg(N+1,t_COL);
87 63341926 : for (k=1; k<=N; k++)
88 : {
89 54074568 : pari_sp av = avma;
90 54074568 : GEN s = gen_0;
91 655280244 : for (j=1; j<=N; j++)
92 : {
93 601205676 : GEN c = gcoeff(tab,k,j);
94 601205676 : if (signe(c)) s = addii(s, _mulii(c, gel(x,j)));
95 : }
96 54074568 : gel(v,k) = gerepileuptoint(av, s);
97 : }
98 9267358 : return v;
99 : }
100 :
101 : /* table of multiplication by wi in R[w1,..., wN] */
102 : GEN
103 2422 : ei_multable(GEN TAB, long i)
104 : {
105 : long k,N;
106 2422 : GEN m, tab = get_tab(TAB, &N);
107 2422 : tab += (i-1)*N;
108 2422 : m = cgetg(N+1,t_MAT);
109 2422 : for (k=1; k<=N; k++) gel(m,k) = gel(tab,k);
110 2422 : return m;
111 : }
112 :
113 : GEN
114 4865337 : zk_multable(GEN nf, GEN x)
115 : {
116 4865337 : long i, l = lg(x);
117 4865337 : GEN mul = cgetg(l,t_MAT);
118 4865337 : gel(mul,1) = x; /* assume w_1 = 1 */
119 4865337 : for (i=2; i<l; i++) gel(mul,i) = zk_ei_mul(nf,x,i);
120 4865337 : return mul;
121 : }
122 : GEN
123 1813 : multable(GEN M, GEN x)
124 : {
125 : long i, N;
126 : GEN mul;
127 1813 : if (typ(x) == t_MAT) return x;
128 0 : M = get_tab(M, &N);
129 0 : if (typ(x) != t_COL) return scalarmat(x, N);
130 0 : mul = cgetg(N+1,t_MAT);
131 0 : gel(mul,1) = x; /* assume w_1 = 1 */
132 0 : for (i=2; i<=N; i++) gel(mul,i) = tablemul_ei(M,x,i);
133 0 : return mul;
134 : }
135 :
136 : /* x integral in nf; table of multiplication by x in ZK = Z[w1,..., wN].
137 : * Return a t_INT if x is scalar, and a ZM otherwise */
138 : GEN
139 3488471 : zk_scalar_or_multable(GEN nf, GEN x)
140 : {
141 3488471 : long tx = typ(x);
142 3488471 : if (tx == t_MAT || tx == t_INT) return x;
143 3439746 : x = nf_to_scalar_or_basis(nf, x);
144 3439746 : return (typ(x) == t_COL)? zk_multable(nf, x): x;
145 : }
146 :
147 : GEN
148 23583 : nftrace(GEN nf, GEN x)
149 : {
150 23583 : pari_sp av = avma;
151 23583 : nf = checknf(nf);
152 23583 : x = nf_to_scalar_or_basis(nf, x);
153 70728 : x = (typ(x) == t_COL)? RgV_dotproduct(x, gel(nf_get_Tr(nf),1))
154 47145 : : gmulgs(x, nf_get_degree(nf));
155 23583 : return gerepileupto(av, x);
156 : }
157 : GEN
158 784 : rnfelttrace(GEN rnf, GEN x)
159 : {
160 784 : pari_sp av = avma;
161 784 : checkrnf(rnf);
162 784 : x = rnfeltabstorel(rnf, x);
163 2002 : x = (typ(x) == t_POLMOD)? rnfeltdown(rnf, gtrace(x))
164 1309 : : gmulgs(x, rnf_get_degree(rnf));
165 693 : return gerepileupto(av, x);
166 : }
167 :
168 : /* assume nf is a genuine nf, fa a famat */
169 : static GEN
170 7 : famat_norm(GEN nf, GEN fa)
171 : {
172 7 : pari_sp av = avma;
173 7 : GEN g = gel(fa,1), e = gel(fa,2), N = gen_1;
174 7 : long i, l = lg(g);
175 21 : for (i = 1; i < l; i++)
176 14 : N = gmul(N, powgi(nfnorm(nf, gel(g,i)), gel(e,i)));
177 7 : return gerepileupto(av, N);
178 : }
179 : GEN
180 31381 : nfnorm(GEN nf, GEN x)
181 : {
182 31381 : pari_sp av = avma;
183 31381 : nf = checknf(nf);
184 31381 : if (typ(x) == t_MAT) return famat_norm(nf, x);
185 31374 : x = nf_to_scalar_or_alg(nf, x);
186 87549 : x = (typ(x) == t_POL)? RgXQ_norm(x, nf_get_pol(nf))
187 56175 : : gpowgs(x, nf_get_degree(nf));
188 31374 : return gerepileupto(av, x);
189 : }
190 :
191 : GEN
192 231 : rnfeltnorm(GEN rnf, GEN x)
193 : {
194 231 : pari_sp av = avma;
195 231 : checkrnf(rnf);
196 231 : x = rnfeltabstorel(rnf, x);
197 378 : x = (typ(x) == t_POLMOD)? rnfeltdown(rnf, gnorm(x))
198 238 : : gpowgs(x, rnf_get_degree(rnf));
199 140 : return gerepileupto(av, x);
200 : }
201 :
202 : /* x + y in nf */
203 : GEN
204 15589533 : nfadd(GEN nf, GEN x, GEN y)
205 : {
206 15589533 : pari_sp av = avma;
207 : GEN z;
208 :
209 15589533 : nf = checknf(nf);
210 15589533 : x = nf_to_scalar_or_basis(nf, x);
211 15589533 : y = nf_to_scalar_or_basis(nf, y);
212 15589533 : if (typ(x) != t_COL)
213 12683855 : { z = (typ(y) == t_COL)? RgC_Rg_add(y, x): gadd(x,y); }
214 : else
215 2905678 : { z = (typ(y) == t_COL)? RgC_add(x, y): RgC_Rg_add(x, y); }
216 15589533 : return gerepileupto(av, z);
217 : }
218 : /* x - y in nf */
219 : GEN
220 1193969 : nfsub(GEN nf, GEN x, GEN y)
221 : {
222 1193969 : pari_sp av = avma;
223 : GEN z;
224 :
225 1193969 : nf = checknf(nf);
226 1193969 : x = nf_to_scalar_or_basis(nf, x);
227 1193969 : y = nf_to_scalar_or_basis(nf, y);
228 1193969 : if (typ(x) != t_COL)
229 884534 : { z = (typ(y) == t_COL)? Rg_RgC_sub(x,y): gsub(x,y); }
230 : else
231 309435 : { z = (typ(y) == t_COL)? RgC_sub(x,y): RgC_Rg_sub(x,y); }
232 1193969 : return gerepileupto(av, z);
233 : }
234 :
235 : /* product of x and y in nf */
236 : GEN
237 20605619 : nfmul(GEN nf, GEN x, GEN y)
238 : {
239 : GEN z;
240 20605619 : pari_sp av = avma;
241 :
242 20605619 : if (x == y) return nfsqr(nf,x);
243 :
244 17749577 : nf = checknf(nf);
245 17749577 : x = nf_to_scalar_or_basis(nf, x);
246 17749577 : y = nf_to_scalar_or_basis(nf, y);
247 17749577 : if (typ(x) != t_COL)
248 : {
249 13738325 : if (isintzero(x)) return gen_0;
250 9854375 : z = (typ(y) == t_COL)? RgC_Rg_mul(y, x): gmul(x,y); }
251 : else
252 : {
253 4011252 : if (typ(y) != t_COL)
254 : {
255 2846375 : if (isintzero(y)) return gen_0;
256 640633 : z = RgC_Rg_mul(x, y);
257 : }
258 : else
259 : {
260 : GEN dx, dy;
261 1164877 : x = Q_remove_denom(x, &dx);
262 1164877 : y = Q_remove_denom(y, &dy);
263 1164877 : z = nfmuli(nf,x,y);
264 1164877 : dx = mul_denom(dx,dy);
265 1164877 : if (dx) z = ZC_Z_div(z, dx);
266 : }
267 : }
268 11659885 : return gerepileupto(av, z);
269 : }
270 : /* square of x in nf */
271 : GEN
272 4715623 : nfsqr(GEN nf, GEN x)
273 : {
274 4715623 : pari_sp av = avma;
275 : GEN z;
276 :
277 4715623 : nf = checknf(nf);
278 4715623 : x = nf_to_scalar_or_basis(nf, x);
279 4715623 : if (typ(x) != t_COL) z = gsqr(x);
280 : else
281 : {
282 : GEN dx;
283 80209 : x = Q_remove_denom(x, &dx);
284 80209 : z = nfsqri(nf,x);
285 80209 : if (dx) z = RgC_Rg_div(z, sqri(dx));
286 : }
287 4715623 : return gerepileupto(av, z);
288 : }
289 :
290 : /* x a ZC, v a t_COL of ZC/Z */
291 : GEN
292 129750 : zkC_multable_mul(GEN v, GEN x)
293 : {
294 129750 : long i, l = lg(v);
295 129750 : GEN y = cgetg(l, t_COL);
296 458116 : for (i = 1; i < l; i++)
297 : {
298 328366 : GEN c = gel(v,i);
299 328366 : if (typ(c)!=t_COL) {
300 0 : if (!isintzero(c)) c = ZC_Z_mul(gel(x,1), c);
301 : } else {
302 328366 : c = ZM_ZC_mul(x,c);
303 328366 : if (ZV_isscalar(c)) c = gel(c,1);
304 : }
305 328366 : gel(y,i) = c;
306 : }
307 129750 : return y;
308 : }
309 :
310 : GEN
311 51093 : nfC_multable_mul(GEN v, GEN x)
312 : {
313 51093 : long i, l = lg(v);
314 51093 : GEN y = cgetg(l, t_COL);
315 322105 : for (i = 1; i < l; i++)
316 : {
317 271012 : GEN c = gel(v,i);
318 271012 : if (typ(c)!=t_COL) {
319 221607 : if (!isintzero(c)) c = RgC_Rg_mul(gel(x,1), c);
320 : } else {
321 49405 : c = RgM_RgC_mul(x,c);
322 49405 : if (QV_isscalar(c)) c = gel(c,1);
323 : }
324 271012 : gel(y,i) = c;
325 : }
326 51093 : return y;
327 : }
328 :
329 : GEN
330 167909 : nfC_nf_mul(GEN nf, GEN v, GEN x)
331 : {
332 : long tx;
333 : GEN y;
334 :
335 167909 : x = nf_to_scalar_or_basis(nf, x);
336 167909 : tx = typ(x);
337 167909 : if (tx != t_COL)
338 : {
339 : long l, i;
340 123445 : if (tx == t_INT)
341 : {
342 115423 : long s = signe(x);
343 115423 : if (!s) return zerocol(lg(v)-1);
344 109043 : if (is_pm1(x)) return s > 0? leafcopy(v): RgC_neg(v);
345 : }
346 39498 : l = lg(v); y = cgetg(l, t_COL);
347 277721 : for (i=1; i < l; i++)
348 : {
349 238223 : GEN c = gel(v,i);
350 238223 : if (typ(c) != t_COL) c = gmul(c, x); else c = RgC_Rg_mul(c, x);
351 238223 : gel(y,i) = c;
352 : }
353 39498 : return y;
354 : }
355 : else
356 : {
357 : GEN dx;
358 44464 : x = zk_multable(nf, Q_remove_denom(x,&dx));
359 44464 : y = nfC_multable_mul(v, x);
360 44464 : return dx? RgC_Rg_div(y, dx): y;
361 : }
362 : }
363 : static GEN
364 7784 : mulbytab(GEN M, GEN c)
365 7784 : { return typ(c) == t_COL? RgM_RgC_mul(M,c): RgC_Rg_mul(gel(M,1), c); }
366 : GEN
367 1813 : tablemulvec(GEN M, GEN x, GEN v)
368 : {
369 : long l, i;
370 : GEN y;
371 :
372 1813 : if (typ(x) == t_COL && RgV_isscalar(x))
373 : {
374 0 : x = gel(x,1);
375 0 : return typ(v) == t_POL? RgX_Rg_mul(v,x): RgV_Rg_mul(v,x);
376 : }
377 1813 : x = multable(M, x); /* multiplication table by x */
378 1813 : y = cgetg_copy(v, &l);
379 1813 : if (typ(v) == t_POL)
380 : {
381 1813 : y[1] = v[1];
382 1813 : for (i=2; i < l; i++) gel(y,i) = mulbytab(x, gel(v,i));
383 1813 : y = normalizepol(y);
384 : }
385 : else
386 : {
387 0 : for (i=1; i < l; i++) gel(y,i) = mulbytab(x, gel(v,i));
388 : }
389 1813 : return y;
390 : }
391 :
392 : GEN
393 359465 : zkmultable_capZ(GEN mx) { return Q_denom(zkmultable_inv(mx)); }
394 :
395 : GEN
396 401354 : zkmultable_inv(GEN mx)
397 401354 : { return ZM_gauss(mx, col_ei(lg(mx)-1,1)); }
398 :
399 : /* nf a true nf, x a ZC */
400 : GEN
401 41889 : zk_inv(GEN nf, GEN x) { return zkmultable_inv(zk_multable(nf,x)); }
402 :
403 : /* inverse of x in nf */
404 : GEN
405 64155 : nfinv(GEN nf, GEN x)
406 : {
407 64155 : pari_sp av = avma;
408 : GEN z;
409 :
410 64155 : nf = checknf(nf);
411 64155 : x = nf_to_scalar_or_basis(nf, x);
412 64155 : if (typ(x) == t_COL)
413 : {
414 : GEN d;
415 24724 : x = Q_remove_denom(x, &d);
416 24724 : z = zk_inv(nf, x);
417 24724 : if (d) z = RgC_Rg_mul(z, d);
418 : }
419 : else
420 39431 : z = ginv(x);
421 64155 : return gerepileupto(av, z);
422 : }
423 :
424 : /* quotient of x and y in nf */
425 : GEN
426 21980 : nfdiv(GEN nf, GEN x, GEN y)
427 : {
428 21980 : pari_sp av = avma;
429 : GEN z;
430 :
431 21980 : nf = checknf(nf);
432 21980 : y = nf_to_scalar_or_basis(nf, y);
433 21980 : if (typ(y) != t_COL)
434 : {
435 12207 : x = nf_to_scalar_or_basis(nf, x);
436 12207 : z = (typ(x) == t_COL)? RgC_Rg_div(x, y): gdiv(x,y);
437 : }
438 : else
439 : {
440 : GEN d;
441 9773 : y = Q_remove_denom(y, &d);
442 9773 : z = nfmul(nf, x, zk_inv(nf,y));
443 9773 : if (d) z = RgC_Rg_mul(z, d);
444 : }
445 21980 : return gerepileupto(av, z);
446 : }
447 :
448 : /* product of INTEGERS (t_INT or ZC) x and y in nf
449 : * compute xy as ( sum_i x_i sum_j y_j m^{i,j}_k )_k */
450 : GEN
451 1614034 : nfmuli(GEN nf, GEN x, GEN y)
452 : {
453 : long i, j, k, N;
454 1614034 : GEN s, v, TAB = get_tab(nf, &N);
455 :
456 1614034 : if (typ(x) == t_INT) return (typ(y) == t_COL)? ZC_Z_mul(y, x): mulii(x,y);
457 1518018 : if (typ(y) == t_INT) return ZC_Z_mul(x, y);
458 : /* both x and y are ZV */
459 1484220 : v = cgetg(N+1,t_COL);
460 6049472 : for (k=1; k<=N; k++)
461 : {
462 4565252 : pari_sp av = avma;
463 4565252 : GEN TABi = TAB;
464 4565252 : if (k == 1)
465 1484220 : s = mulii(gel(x,1),gel(y,1));
466 : else
467 6162064 : s = addii(mulii(gel(x,1),gel(y,k)),
468 6162064 : mulii(gel(x,k),gel(y,1)));
469 23312388 : for (i=2; i<=N; i++)
470 : {
471 18747136 : GEN t, xi = gel(x,i);
472 18747136 : TABi += N;
473 18747136 : if (!signe(xi)) continue;
474 :
475 13020365 : t = NULL;
476 133579669 : for (j=2; j<=N; j++)
477 : {
478 120559304 : GEN p1, c = gcoeff(TABi, k, j); /* m^{i,j}_k */
479 120559304 : if (!signe(c)) continue;
480 54486699 : p1 = _mulii(c, gel(y,j));
481 54486699 : t = t? addii(t, p1): p1;
482 : }
483 13020365 : if (t) s = addii(s, mulii(xi, t));
484 : }
485 4565252 : gel(v,k) = gerepileuptoint(av,s);
486 : }
487 1484220 : return v;
488 : }
489 : /* square of INTEGER (t_INT or ZC) x in nf */
490 : GEN
491 680136 : nfsqri(GEN nf, GEN x)
492 : {
493 : long i, j, k, N;
494 680136 : GEN s, v, TAB = get_tab(nf, &N);
495 :
496 680136 : if (typ(x) == t_INT) return sqri(x);
497 680136 : v = cgetg(N+1,t_COL);
498 5361310 : for (k=1; k<=N; k++)
499 : {
500 4681174 : pari_sp av = avma;
501 4681174 : GEN TABi = TAB;
502 4681174 : if (k == 1)
503 680136 : s = sqri(gel(x,1));
504 : else
505 4001038 : s = shifti(mulii(gel(x,1),gel(x,k)), 1);
506 56475846 : for (i=2; i<=N; i++)
507 : {
508 51794672 : GEN p1, c, t, xi = gel(x,i);
509 51794672 : TABi += N;
510 51794672 : if (!signe(xi)) continue;
511 :
512 17527896 : c = gcoeff(TABi, k, i);
513 17527896 : t = signe(c)? _mulii(c,xi): NULL;
514 250613397 : for (j=i+1; j<=N; j++)
515 : {
516 233085501 : c = gcoeff(TABi, k, j);
517 233085501 : if (!signe(c)) continue;
518 121691730 : p1 = _mulii(c, shifti(gel(x,j),1));
519 121691730 : t = t? addii(t, p1): p1;
520 : }
521 17527896 : if (t) s = addii(s, mulii(xi, t));
522 : }
523 4681174 : gel(v,k) = gerepileuptoint(av,s);
524 : }
525 680136 : return v;
526 : }
527 :
528 : /* both x and y are RgV */
529 : GEN
530 0 : tablemul(GEN TAB, GEN x, GEN y)
531 : {
532 : long i, j, k, N;
533 : GEN s, v;
534 0 : if (typ(x) != t_COL) return gmul(x, y);
535 0 : if (typ(y) != t_COL) return gmul(y, x);
536 0 : N = lg(x)-1;
537 0 : v = cgetg(N+1,t_COL);
538 0 : for (k=1; k<=N; k++)
539 : {
540 0 : pari_sp av = avma;
541 0 : GEN TABi = TAB;
542 0 : if (k == 1)
543 0 : s = gmul(gel(x,1),gel(y,1));
544 : else
545 0 : s = gadd(gmul(gel(x,1),gel(y,k)),
546 0 : gmul(gel(x,k),gel(y,1)));
547 0 : for (i=2; i<=N; i++)
548 : {
549 0 : GEN t, xi = gel(x,i);
550 0 : TABi += N;
551 0 : if (gequal0(xi)) continue;
552 :
553 0 : t = NULL;
554 0 : for (j=2; j<=N; j++)
555 : {
556 0 : GEN p1, c = gcoeff(TABi, k, j); /* m^{i,j}_k */
557 0 : if (gequal0(c)) continue;
558 0 : p1 = gmul(c, gel(y,j));
559 0 : t = t? gadd(t, p1): p1;
560 : }
561 0 : if (t) s = gadd(s, gmul(xi, t));
562 : }
563 0 : gel(v,k) = gerepileupto(av,s);
564 : }
565 0 : return v;
566 : }
567 : GEN
568 40040 : tablesqr(GEN TAB, GEN x)
569 : {
570 : long i, j, k, N;
571 : GEN s, v;
572 :
573 40040 : if (typ(x) != t_COL) return gsqr(x);
574 40040 : N = lg(x)-1;
575 40040 : v = cgetg(N+1,t_COL);
576 :
577 278922 : for (k=1; k<=N; k++)
578 : {
579 238882 : pari_sp av = avma;
580 238882 : GEN TABi = TAB;
581 238882 : if (k == 1)
582 40040 : s = gsqr(gel(x,1));
583 : else
584 198842 : s = gmul2n(gmul(gel(x,1),gel(x,k)), 1);
585 1455440 : for (i=2; i<=N; i++)
586 : {
587 1216558 : GEN p1, c, t, xi = gel(x,i);
588 1216558 : TABi += N;
589 1216558 : if (gequal0(xi)) continue;
590 :
591 321069 : c = gcoeff(TABi, k, i);
592 321069 : t = !gequal0(c)? gmul(c,xi): NULL;
593 1241723 : for (j=i+1; j<=N; j++)
594 : {
595 920654 : c = gcoeff(TABi, k, j);
596 920654 : if (gequal0(c)) continue;
597 482706 : p1 = gmul(gmul2n(c,1), gel(x,j));
598 482706 : t = t? gadd(t, p1): p1;
599 : }
600 321069 : if (t) s = gadd(s, gmul(xi, t));
601 : }
602 238882 : gel(v,k) = gerepileupto(av,s);
603 : }
604 40040 : return v;
605 : }
606 :
607 : static GEN
608 47228 : _mul(void *data, GEN x, GEN y) { return nfmuli((GEN)data,x,y); }
609 : static GEN
610 142258 : _sqr(void *data, GEN x) { return nfsqri((GEN)data,x); }
611 :
612 : /* Compute z^n in nf, left-shift binary powering */
613 : GEN
614 117852 : nfpow(GEN nf, GEN z, GEN n)
615 : {
616 117852 : pari_sp av = avma;
617 : long s;
618 : GEN x, cx;
619 :
620 117852 : if (typ(n)!=t_INT) pari_err_TYPE("nfpow",n);
621 117852 : nf = checknf(nf);
622 117852 : s = signe(n); if (!s) return gen_1;
623 117852 : x = nf_to_scalar_or_basis(nf, z);
624 117852 : if (typ(x) != t_COL) return powgi(x,n);
625 117229 : if (s < 0)
626 : { /* simplified nfinv */
627 : GEN d;
628 3451 : x = Q_remove_denom(x, &d);
629 3451 : x = zk_inv(nf, x);
630 3451 : x = primitive_part(x, &cx);
631 3451 : cx = mul_content(cx, d);
632 3451 : n = negi(n);
633 : }
634 : else
635 113778 : x = primitive_part(x, &cx);
636 117229 : x = gen_pow(x, n, (void*)nf, _sqr, _mul);
637 117229 : if (cx) x = gmul(x, powgi(cx, n));
638 117229 : return av==avma? gcopy(x): gerepileupto(av,x);
639 : }
640 : /* Compute z^n in nf, left-shift binary powering */
641 : GEN
642 45941 : nfpow_u(GEN nf, GEN z, ulong n)
643 : {
644 45941 : pari_sp av = avma;
645 : GEN x, cx;
646 :
647 45941 : nf = checknf(nf);
648 45941 : if (!n) return gen_1;
649 45941 : x = nf_to_scalar_or_basis(nf, z);
650 45941 : if (typ(x) != t_COL) return gpowgs(x,n);
651 17675 : x = primitive_part(x, &cx);
652 17675 : x = gen_powu(x, n, (void*)nf, _sqr, _mul);
653 17675 : if (cx) x = gmul(x, powgi(cx, utoipos(n)));
654 17675 : return av==avma? gcopy(x): gerepileupto(av,x);
655 : }
656 :
657 : static GEN
658 2397969 : _nf_red(void *E, GEN x) { (void)E; return x; }
659 :
660 : static GEN
661 9326373 : _nf_add(void *E, GEN x, GEN y) { return nfadd((GEN)E,x,y); }
662 :
663 : static GEN
664 570948 : _nf_neg(void *E, GEN x) { (void)E; return gneg(x); }
665 :
666 : static GEN
667 11290489 : _nf_mul(void *E, GEN x, GEN y) { return nfmul((GEN)E,x,y); }
668 :
669 : static GEN
670 41566 : _nf_inv(void *E, GEN x) { return nfinv((GEN)E,x); }
671 :
672 : static GEN
673 8274 : _nf_s(void *E, long x) { (void)E; return stoi(x); }
674 :
675 : static const struct bb_field nf_field={_nf_red,_nf_add,_nf_mul,_nf_neg,
676 : _nf_inv,&gequal0,_nf_s };
677 :
678 177583 : const struct bb_field *get_nf_field(void **E, GEN nf)
679 177583 : { *E = (void*)nf; return &nf_field; }
680 :
681 : GEN
682 14 : nfM_det(GEN nf, GEN M)
683 : {
684 : void *E;
685 14 : const struct bb_field *S = get_nf_field(&E, nf);
686 14 : return gen_det(M, E, S);
687 : }
688 : GEN
689 8260 : nfM_inv(GEN nf, GEN M)
690 : {
691 : void *E;
692 8260 : const struct bb_field *S = get_nf_field(&E, nf);
693 8260 : return gen_Gauss(M, matid(lg(M)-1), E, S);
694 : }
695 : GEN
696 8050 : nfM_mul(GEN nf, GEN A, GEN B)
697 : {
698 : void *E;
699 8050 : const struct bb_field *S = get_nf_field(&E, nf);
700 8050 : return gen_matmul(A, B, E, S);
701 : }
702 : GEN
703 161259 : nfM_nfC_mul(GEN nf, GEN A, GEN B)
704 : {
705 : void *E;
706 161259 : const struct bb_field *S = get_nf_field(&E, nf);
707 161259 : return gen_matcolmul(A, B, E, S);
708 : }
709 :
710 : /* valuation of integral x (ZV), with resp. to prime ideal pr */
711 : long
712 5377240 : ZC_nfvalrem(GEN x, GEN pr, GEN *newx)
713 : {
714 : long i, v, l;
715 5377240 : GEN r, y, p = pr_get_p(pr), mul = pr_get_tau(pr);
716 :
717 : /* p inert */
718 5377240 : if (typ(mul) == t_INT) return newx? ZV_pvalrem(x, p, newx):ZV_pval(x, p);
719 5366082 : y = cgetg_copy(x, &l); /* will hold the new x */
720 5366082 : x = leafcopy(x);
721 8193787 : for(v=0;; v++)
722 : {
723 31338006 : for (i=1; i<l; i++)
724 : { /* is (x.b)[i] divisible by p ? */
725 25682596 : gel(y,i) = dvmdii(ZMrow_ZC_mul(mul,x,i),p,&r);
726 25682596 : if (r != gen_0) { if (newx) *newx = x; return v; }
727 : }
728 2827705 : swap(x, y);
729 : }
730 : }
731 : long
732 5140538 : ZC_nfval(GEN x, GEN P)
733 5140538 : { return ZC_nfvalrem(x, P, NULL); }
734 :
735 : /* v_P(x) != 0, x a ZV. Simpler version of ZC_nfvalrem */
736 : int
737 260666 : ZC_prdvd(GEN x, GEN P)
738 : {
739 260666 : pari_sp av = avma;
740 : long i, l;
741 260666 : GEN p = pr_get_p(P), mul = pr_get_tau(P);
742 260666 : if (typ(mul) == t_INT) return ZV_Z_dvd(x, p);
743 260421 : l = lg(x);
744 1014930 : for (i=1; i<l; i++)
745 900296 : if (!dvdii(ZMrow_ZC_mul(mul,x,i), p)) { avma = av; return 0; }
746 114634 : avma = av; return 1;
747 : }
748 :
749 : int
750 28 : pr_equal(GEN P, GEN Q)
751 : {
752 28 : GEN gQ, p = pr_get_p(P);
753 28 : long e = pr_get_e(P), f = pr_get_f(P), n;
754 28 : if (!equalii(p, pr_get_p(Q)) || e != pr_get_e(Q) || f != pr_get_f(Q))
755 14 : return 0;
756 14 : gQ = pr_get_gen(Q); n = lg(gQ)-1;
757 14 : if (2*e*f > n) return 1; /* room for only one such pr */
758 7 : return ZV_equal(pr_get_gen(P), gQ) || ZC_prdvd(gQ, P);
759 : }
760 :
761 : long
762 1303701 : nfval(GEN nf, GEN x, GEN pr)
763 : {
764 1303701 : pari_sp av = avma;
765 : long w, e;
766 : GEN cx, p;
767 :
768 1303701 : if (gequal0(x)) return LONG_MAX;
769 1302238 : nf = checknf(nf);
770 1302238 : checkprid(pr);
771 1302238 : p = pr_get_p(pr);
772 1302238 : e = pr_get_e(pr);
773 1302238 : x = nf_to_scalar_or_basis(nf, x);
774 1302238 : if (typ(x) != t_COL) return e*Q_pval(x,p);
775 107331 : x = Q_primitive_part(x, &cx);
776 107331 : w = ZC_nfval(x,pr);
777 107331 : if (cx) w += e*Q_pval(cx,p);
778 107331 : avma = av; return w;
779 : }
780 :
781 : /* want to write p^v = uniformizer^(e*v) * z^v, z coprime to pr */
782 : /* z := tau^e / p^(e-1), algebraic integer coprime to pr; return z^v */
783 : static GEN
784 20104 : powp(GEN nf, GEN pr, long v)
785 : {
786 : GEN b, z;
787 : long e;
788 20104 : if (!v) return gen_1;
789 19978 : b = pr_get_tau(pr);
790 19978 : if (typ(b) == t_INT) return gen_1;
791 1274 : e = pr_get_e(pr);
792 1274 : z = gel(b,1);
793 1274 : if (e != 1) z = gdiv(nfpow_u(nf, z, e), powiu(pr_get_p(pr),e-1));
794 1274 : if (v < 0) { v = -v; z = nfinv(nf, z); }
795 1274 : if (v != 1) z = nfpow_u(nf, z, v);
796 1274 : return z;
797 : }
798 : long
799 64925 : nfvalrem(GEN nf, GEN x, GEN pr, GEN *py)
800 : {
801 64925 : pari_sp av = avma;
802 : long w, e;
803 : GEN cx, p, t;
804 :
805 64925 : if (!py) return nfval(nf,x,pr);
806 64806 : if (gequal0(x)) { *py = gcopy(x); return LONG_MAX; }
807 64750 : nf = checknf(nf);
808 64750 : checkprid(pr);
809 64750 : p = pr_get_p(pr);
810 64750 : e = pr_get_e(pr);
811 64750 : x = nf_to_scalar_or_basis(nf, x);
812 64750 : if (typ(x) != t_COL) {
813 52871 : w = Q_pvalrem(x,p, py);
814 52871 : if (!w) { *py = gerepilecopy(av, x); return 0; }
815 18977 : *py = gerepileupto(av, gmul(powp(nf, pr, w), *py));
816 18977 : return e*w;
817 : }
818 11879 : x = Q_primitive_part(x, &cx);
819 11879 : w = ZC_nfvalrem(x,pr, py);
820 11879 : if (cx)
821 : {
822 1127 : long v = Q_pvalrem(cx,p, &t);
823 1127 : *py = nfmul(nf, *py, gmul(powp(nf,pr,v), t));
824 1127 : *py = gerepileupto(av, *py);
825 1127 : w += e*v;
826 : }
827 : else
828 10752 : *py = gerepilecopy(av, *py);
829 11879 : return w;
830 : }
831 : GEN
832 147 : gpnfvalrem(GEN nf, GEN x, GEN pr, GEN *py)
833 : {
834 147 : long v = nfvalrem(nf,x,pr,py);
835 147 : return v == LONG_MAX? mkoo(): stoi(v);
836 : }
837 :
838 : /* true nf */
839 : GEN
840 105252 : coltoalg(GEN nf, GEN x)
841 : {
842 105252 : return mkpolmod( nf_to_scalar_or_alg(nf, x), nf_get_pol(nf) );
843 : }
844 :
845 : GEN
846 148687 : basistoalg(GEN nf, GEN x)
847 : {
848 : GEN T;
849 :
850 148687 : nf = checknf(nf);
851 148687 : switch(typ(x))
852 : {
853 : case t_COL: {
854 99134 : pari_sp av = avma;
855 99134 : return gerepilecopy(av, coltoalg(nf, x));
856 : }
857 : case t_POLMOD:
858 32473 : T = nf_get_pol(nf);
859 32473 : if (!RgX_equal_var(T,gel(x,1)))
860 0 : pari_err_MODULUS("basistoalg", T,gel(x,1));
861 32473 : return gcopy(x);
862 : case t_POL:
863 1778 : T = nf_get_pol(nf);
864 1778 : if (varn(T) != varn(x)) pari_err_VAR("basistoalg",x,T);
865 1778 : retmkpolmod(RgX_rem(x, T), ZX_copy(T));
866 : case t_INT:
867 : case t_FRAC:
868 15302 : T = nf_get_pol(nf);
869 15302 : retmkpolmod(gcopy(x), ZX_copy(T));
870 : default:
871 0 : pari_err_TYPE("basistoalg",x);
872 : return NULL; /* LCOV_EXCL_LINE */
873 : }
874 : }
875 :
876 : /* true nf, x a t_POL */
877 : static GEN
878 1462874 : pol_to_scalar_or_basis(GEN nf, GEN x)
879 : {
880 1462874 : GEN T = nf_get_pol(nf);
881 1462874 : long l = lg(x);
882 1462874 : if (varn(x) != varn(T)) pari_err_VAR("nf_to_scalar_or_basis", x,T);
883 1462811 : if (l >= lg(T)) { x = RgX_rem(x, T); l = lg(x); }
884 1462811 : if (l == 2) return gen_0;
885 867286 : if (l == 3)
886 : {
887 201019 : x = gel(x,2);
888 201019 : if (!is_rational_t(typ(x))) pari_err_TYPE("nf_to_scalar_or_basis",x);
889 201019 : return x;
890 : }
891 666267 : return poltobasis(nf,x);
892 : }
893 : /* Assume nf is a genuine nf. */
894 : GEN
895 83521948 : nf_to_scalar_or_basis(GEN nf, GEN x)
896 : {
897 83521948 : switch(typ(x))
898 : {
899 : case t_INT: case t_FRAC:
900 62907375 : return x;
901 : case t_POLMOD:
902 196084 : x = checknfelt_mod(nf,x,"nf_to_scalar_or_basis");
903 196028 : switch(typ(x))
904 : {
905 34258 : case t_INT: case t_FRAC: return x;
906 161770 : case t_POL: return pol_to_scalar_or_basis(nf,x);
907 : }
908 0 : break;
909 1301104 : case t_POL: return pol_to_scalar_or_basis(nf,x);
910 : case t_COL:
911 19117385 : if (lg(x)-1 != nf_get_degree(nf)) break;
912 19117322 : return QV_isscalar(x)? gel(x,1): x;
913 : }
914 63 : pari_err_TYPE("nf_to_scalar_or_basis",x);
915 : return NULL; /* LCOV_EXCL_LINE */
916 : }
917 : /* Let x be a polynomial with coefficients in Q or nf. Return the same
918 : * polynomial with coefficients expressed as vectors (on the integral basis).
919 : * No consistency checks, not memory-clean. */
920 : GEN
921 5909 : RgX_to_nfX(GEN nf, GEN x)
922 : {
923 : long i, l;
924 5909 : GEN y = cgetg_copy(x, &l); y[1] = x[1];
925 5909 : for (i=2; i<l; i++) gel(y,i) = nf_to_scalar_or_basis(nf, gel(x,i));
926 5909 : return y;
927 : }
928 :
929 : /* Assume nf is a genuine nf. */
930 : GEN
931 216904 : nf_to_scalar_or_alg(GEN nf, GEN x)
932 : {
933 216904 : switch(typ(x))
934 : {
935 : case t_INT: case t_FRAC:
936 17170 : return x;
937 : case t_POLMOD:
938 1372 : x = checknfelt_mod(nf,x,"nf_to_scalar_or_alg");
939 1372 : if (typ(x) != t_POL) return x;
940 : /* fall through */
941 : case t_POL:
942 : {
943 14890 : GEN T = nf_get_pol(nf);
944 14890 : long l = lg(x);
945 14890 : if (varn(x) != varn(T)) pari_err_VAR("nf_to_scalar_or_alg", x,T);
946 14890 : if (l >= lg(T)) { x = RgX_rem(x, T); l = lg(x); }
947 14890 : if (l == 2) return gen_0;
948 14890 : if (l == 3) return gel(x,2);
949 14666 : return x;
950 : }
951 : case t_COL:
952 : {
953 : GEN dx;
954 184788 : if (lg(x)-1 != nf_get_degree(nf)) break;
955 369576 : if (QV_isscalar(x)) return gel(x,1);
956 148752 : x = Q_remove_denom(x, &dx);
957 148752 : x = RgV_RgC_mul(nf_get_zkprimpart(nf), x);
958 148752 : dx = mul_denom(dx, nf_get_zkden(nf));
959 148752 : return gdiv(x,dx);
960 : }
961 : }
962 49 : pari_err_TYPE("nf_to_scalar_or_alg",x);
963 : return NULL; /* LCOV_EXCL_LINE */
964 : }
965 :
966 : /* gmul(A, RgX_to_RgC(x)), A t_MAT of compatible dimensions */
967 : GEN
968 1337 : RgM_RgX_mul(GEN A, GEN x)
969 : {
970 1337 : long i, l = lg(x)-1;
971 : GEN z;
972 1337 : if (l == 1) return zerocol(nbrows(A));
973 1337 : z = gmul(gel(x,2), gel(A,1));
974 2541 : for (i = 2; i < l; i++)
975 1204 : if (!gequal0(gel(x,i+1))) z = gadd(z, gmul(gel(x,i+1), gel(A,i)));
976 1337 : return z;
977 : }
978 : GEN
979 2481436 : ZM_ZX_mul(GEN A, GEN x)
980 : {
981 2481436 : long i, l = lg(x)-1;
982 : GEN z;
983 2481436 : if (l == 1) return zerocol(nbrows(A));
984 2480655 : z = ZC_Z_mul(gel(A,1), gel(x,2));
985 9680044 : for (i = 2; i < l ; i++)
986 7199393 : if (signe(gel(x,i+1))) z = ZC_add(z, ZC_Z_mul(gel(A,i), gel(x,i+1)));
987 2480651 : return z;
988 : }
989 : /* x a t_POL, nf a genuine nf. No garbage collecting. No check. */
990 : GEN
991 2315595 : poltobasis(GEN nf, GEN x)
992 : {
993 2315595 : GEN d, T = nf_get_pol(nf);
994 2315595 : if (varn(x) != varn(T)) pari_err_VAR( "poltobasis", x,T);
995 2315539 : if (degpol(x) >= degpol(T)) x = RgX_rem(x,T);
996 2315539 : x = Q_remove_denom(x, &d);
997 2315539 : if (!RgX_is_ZX(x)) pari_err_TYPE("poltobasis",x);
998 2315518 : x = ZM_ZX_mul(nf_get_invzk(nf), x);
999 2315518 : if (d) x = RgC_Rg_div(x, d);
1000 2315518 : return x;
1001 : }
1002 :
1003 : GEN
1004 267690 : algtobasis(GEN nf, GEN x)
1005 : {
1006 : pari_sp av;
1007 :
1008 267690 : nf = checknf(nf);
1009 267690 : switch(typ(x))
1010 : {
1011 : case t_POLMOD:
1012 112518 : if (!RgX_equal_var(nf_get_pol(nf),gel(x,1)))
1013 7 : pari_err_MODULUS("algtobasis", nf_get_pol(nf),gel(x,1));
1014 112511 : x = gel(x,2);
1015 112511 : switch(typ(x))
1016 : {
1017 : case t_INT:
1018 7497 : case t_FRAC: return scalarcol(x, nf_get_degree(nf));
1019 : case t_POL:
1020 105014 : av = avma;
1021 105014 : return gerepileupto(av,poltobasis(nf,x));
1022 : }
1023 0 : break;
1024 :
1025 : case t_POL:
1026 73191 : av = avma;
1027 73191 : return gerepileupto(av,poltobasis(nf,x));
1028 :
1029 : case t_COL:
1030 14872 : if (lg(x)-1 != nf_get_degree(nf)) pari_err_DIM("nfalgtobasis");
1031 14872 : return gcopy(x);
1032 :
1033 : case t_INT:
1034 67109 : case t_FRAC: return scalarcol(x, nf_get_degree(nf));
1035 : }
1036 0 : pari_err_TYPE("algtobasis",x);
1037 : return NULL; /* LCOV_EXCL_LINE */
1038 : }
1039 :
1040 : GEN
1041 44212 : rnfbasistoalg(GEN rnf,GEN x)
1042 : {
1043 44212 : const char *f = "rnfbasistoalg";
1044 : long lx, i;
1045 44212 : pari_sp av = avma;
1046 : GEN z, nf, relpol, T;
1047 :
1048 44212 : checkrnf(rnf);
1049 44212 : nf = rnf_get_nf(rnf);
1050 44212 : T = nf_get_pol(nf);
1051 44212 : relpol = QXQX_to_mod_shallow(rnf_get_pol(rnf), T);
1052 44212 : switch(typ(x))
1053 : {
1054 : case t_COL:
1055 826 : z = cgetg_copy(x, &lx);
1056 2478 : for (i=1; i<lx; i++)
1057 : {
1058 1701 : GEN c = nf_to_scalar_or_alg(nf, gel(x,i));
1059 1652 : if (typ(c) == t_POL) c = mkpolmod(c,T);
1060 1652 : gel(z,i) = c;
1061 : }
1062 777 : z = RgV_RgC_mul(gel(rnf_get_zk(rnf),1), z);
1063 714 : return gerepileupto(av, gmodulo(z,relpol));
1064 :
1065 : case t_POLMOD:
1066 29715 : x = polmod_nffix(f, rnf, x, 0);
1067 29512 : if (typ(x) != t_POL) break;
1068 13286 : retmkpolmod(RgX_copy(x), RgX_copy(relpol));
1069 : case t_POL:
1070 1099 : if (varn(x) == varn(T)) { RgX_check_QX(x,f); x = gmodulo(x,T); break; }
1071 875 : if (varn(x) == varn(relpol))
1072 : {
1073 826 : x = RgX_nffix(f,nf_get_pol(nf),x,0);
1074 826 : return gmodulo(x, relpol);
1075 : }
1076 49 : pari_err_VAR(f, x,relpol);
1077 : }
1078 28973 : retmkpolmod(scalarpol(x, varn(relpol)), RgX_copy(relpol));
1079 : }
1080 :
1081 : GEN
1082 1582 : matbasistoalg(GEN nf,GEN x)
1083 : {
1084 : long i, j, li, lx;
1085 1582 : GEN z = cgetg_copy(x, &lx);
1086 :
1087 1582 : if (lx == 1) return z;
1088 1575 : switch(typ(x))
1089 : {
1090 : case t_VEC: case t_COL:
1091 42 : for (i=1; i<lx; i++) gel(z,i) = basistoalg(nf, gel(x,i));
1092 42 : return z;
1093 1533 : case t_MAT: break;
1094 0 : default: pari_err_TYPE("matbasistoalg",x);
1095 : }
1096 1533 : li = lgcols(x);
1097 5705 : for (j=1; j<lx; j++)
1098 : {
1099 4172 : GEN c = cgetg(li,t_COL), xj = gel(x,j);
1100 4172 : gel(z,j) = c;
1101 4172 : for (i=1; i<li; i++) gel(c,i) = basistoalg(nf, gel(xj,i));
1102 : }
1103 1533 : return z;
1104 : }
1105 :
1106 : GEN
1107 3906 : matalgtobasis(GEN nf,GEN x)
1108 : {
1109 : long i, j, li, lx;
1110 3906 : GEN z = cgetg_copy(x, &lx);
1111 :
1112 3906 : if (lx == 1) return z;
1113 3850 : switch(typ(x))
1114 : {
1115 : case t_VEC: case t_COL:
1116 3843 : for (i=1; i<lx; i++) gel(z,i) = algtobasis(nf, gel(x,i));
1117 3843 : return z;
1118 7 : case t_MAT: break;
1119 0 : default: pari_err_TYPE("matalgtobasis",x);
1120 : }
1121 7 : li = lgcols(x);
1122 14 : for (j=1; j<lx; j++)
1123 : {
1124 7 : GEN c = cgetg(li,t_COL), xj = gel(x,j);
1125 7 : gel(z,j) = c;
1126 7 : for (i=1; i<li; i++) gel(c,i) = algtobasis(nf, gel(xj,i));
1127 : }
1128 7 : return z;
1129 : }
1130 : GEN
1131 8582 : RgM_to_nfM(GEN nf,GEN x)
1132 : {
1133 : long i, j, li, lx;
1134 8582 : GEN z = cgetg_copy(x, &lx);
1135 :
1136 8582 : if (lx == 1) return z;
1137 8582 : li = lgcols(x);
1138 65758 : for (j=1; j<lx; j++)
1139 : {
1140 57176 : GEN c = cgetg(li,t_COL), xj = gel(x,j);
1141 57176 : gel(z,j) = c;
1142 57176 : for (i=1; i<li; i++) gel(c,i) = nf_to_scalar_or_basis(nf, gel(xj,i));
1143 : }
1144 8582 : return z;
1145 : }
1146 : GEN
1147 78617 : RgC_to_nfC(GEN nf, GEN x)
1148 78617 : { pari_APPLY_type(t_COL, nf_to_scalar_or_basis(nf, gel(x,i))) }
1149 :
1150 : /* x a t_POLMOD, supposedly in rnf = K[z]/(T), K = Q[y]/(Tnf) */
1151 : GEN
1152 134449 : polmod_nffix(const char *f, GEN rnf, GEN x, int lift)
1153 134449 : { return polmod_nffix2(f, rnf_get_nfpol(rnf), rnf_get_pol(rnf), x,lift); }
1154 : GEN
1155 134540 : polmod_nffix2(const char *f, GEN T, GEN relpol, GEN x, int lift)
1156 : {
1157 134540 : if (RgX_equal_var(gel(x,1),relpol))
1158 : {
1159 124376 : x = gel(x,2);
1160 124376 : if (typ(x) == t_POL && varn(x) == varn(relpol))
1161 : {
1162 94780 : x = RgX_nffix(f, T, x, lift);
1163 94780 : switch(lg(x))
1164 : {
1165 343 : case 2: return gen_0;
1166 21931 : case 3: return gel(x,2);
1167 : }
1168 72506 : return x;
1169 : }
1170 : }
1171 39760 : return Rg_nffix(f, T, x, lift);
1172 : }
1173 : GEN
1174 1204 : rnfalgtobasis(GEN rnf,GEN x)
1175 : {
1176 1204 : const char *f = "rnfalgtobasis";
1177 1204 : pari_sp av = avma;
1178 : GEN T, relpol;
1179 :
1180 1204 : checkrnf(rnf);
1181 1204 : relpol = rnf_get_pol(rnf);
1182 1204 : T = rnf_get_nfpol(rnf);
1183 1204 : switch(typ(x))
1184 : {
1185 : case t_COL:
1186 49 : if (lg(x)-1 != rnf_get_degree(rnf)) pari_err_DIM(f);
1187 28 : x = RgV_nffix(f, T, x, 0);
1188 21 : return gerepilecopy(av, x);
1189 :
1190 : case t_POLMOD:
1191 1071 : x = polmod_nffix(f, rnf, x, 0);
1192 1036 : if (typ(x) != t_POL) break;
1193 714 : return gerepileupto(av, RgM_RgX_mul(rnf_get_invzk(rnf), x));
1194 : case t_POL:
1195 56 : if (varn(x) == varn(T))
1196 : {
1197 21 : RgX_check_QX(x,f);
1198 14 : if (degpol(x) >= degpol(T)) x = RgX_rem(x,T);
1199 14 : x = mkpolmod(x,T); break;
1200 : }
1201 35 : x = RgX_nffix(f, T, x, 0);
1202 28 : if (degpol(x) >= degpol(relpol)) x = RgX_rem(x,relpol);
1203 28 : return gerepileupto(av, RgM_RgX_mul(rnf_get_invzk(rnf), x));
1204 : }
1205 364 : return gerepileupto(av, scalarcol(x, rnf_get_degree(rnf)));
1206 : }
1207 :
1208 : /* Given a and b in nf, gives an algebraic integer y in nf such that a-b.y
1209 : * is "small" */
1210 : GEN
1211 259 : nfdiveuc(GEN nf, GEN a, GEN b)
1212 : {
1213 259 : pari_sp av = avma;
1214 259 : a = nfdiv(nf,a,b);
1215 259 : return gerepileupto(av, ground(a));
1216 : }
1217 :
1218 : /* Given a and b in nf, gives a "small" algebraic integer r in nf
1219 : * of the form a-b.y */
1220 : GEN
1221 259 : nfmod(GEN nf, GEN a, GEN b)
1222 : {
1223 259 : pari_sp av = avma;
1224 259 : GEN p1 = gneg_i(nfmul(nf,b,ground(nfdiv(nf,a,b))));
1225 259 : return gerepileupto(av, nfadd(nf,a,p1));
1226 : }
1227 :
1228 : /* Given a and b in nf, gives a two-component vector [y,r] in nf such
1229 : * that r=a-b.y is "small". */
1230 : GEN
1231 259 : nfdivrem(GEN nf, GEN a, GEN b)
1232 : {
1233 259 : pari_sp av = avma;
1234 259 : GEN p1,z, y = ground(nfdiv(nf,a,b));
1235 :
1236 259 : p1 = gneg_i(nfmul(nf,b,y));
1237 259 : z = cgetg(3,t_VEC);
1238 259 : gel(z,1) = gcopy(y);
1239 259 : gel(z,2) = nfadd(nf,a,p1); return gerepileupto(av, z);
1240 : }
1241 :
1242 : /*************************************************************************/
1243 : /** **/
1244 : /** REAL EMBEDDINGS **/
1245 : /** **/
1246 : /*************************************************************************/
1247 : static GEN
1248 49399 : sarch_get_cyc(GEN sarch) { return gel(sarch,1); }
1249 : static GEN
1250 272411 : sarch_get_archp(GEN sarch) { return gel(sarch,2); }
1251 : static GEN
1252 55037 : sarch_get_MI(GEN sarch) { return gel(sarch,3); }
1253 : static GEN
1254 55037 : sarch_get_lambda(GEN sarch) { return gel(sarch,4); }
1255 : static GEN
1256 55037 : sarch_get_F(GEN sarch) { return gel(sarch,5); }
1257 :
1258 : /* true nf, return number of positive roots of char_x */
1259 : static long
1260 1999 : num_positive(GEN nf, GEN x)
1261 : {
1262 1999 : GEN T = nf_get_pol(nf);
1263 1999 : GEN charx = ZXQ_charpoly(nf_to_scalar_or_alg(nf,x), T, 0);
1264 : long np;
1265 1999 : charx = ZX_radical(charx);
1266 1999 : np = ZX_sturmpart(charx, mkvec2(gen_0,mkoo()));
1267 1999 : return np * (degpol(T) / degpol(charx));
1268 : }
1269 :
1270 : /* x a QC: return sigma_k(x) where 1 <= k <= r1+r2; correct but inefficient
1271 : * if x in Q. M = nf_get_M(nf) */
1272 : static GEN
1273 91 : nfembed_i(GEN M, GEN x, long k)
1274 : {
1275 91 : long i, l = lg(M);
1276 91 : GEN z = gel(x,1);
1277 91 : for (i = 2; i < l; i++) z = gadd(z, gmul(gcoeff(M,k,i), gel(x,i)));
1278 91 : return z;
1279 : }
1280 : GEN
1281 0 : nfembed(GEN nf, GEN x, long k)
1282 : {
1283 0 : pari_sp av = avma;
1284 0 : nf = checknf(nf);
1285 0 : x = nf_to_scalar_or_basis(nf,x);
1286 0 : if (typ(x) != t_COL) return gerepilecopy(av, x);
1287 0 : return gerepileupto(av, nfembed_i(nf_get_M(nf),x,k));
1288 : }
1289 :
1290 : /* x a ZC */
1291 : static GEN
1292 397055 : zk_embed(GEN M, GEN x, long k)
1293 : {
1294 397055 : long i, l = lg(x);
1295 397055 : GEN z = gel(x,1); /* times M[k,1], which is 1 */
1296 397055 : for (i = 2; i < l; i++) z = mpadd(z, mpmul(gcoeff(M,k,i), gel(x,i)));
1297 397055 : return z;
1298 : }
1299 :
1300 : /* Given floating point approximation z of sigma_k(x), decide its sign
1301 : * [0/+, 1/- and -1 for FAIL] */
1302 : static long
1303 386408 : eval_sign_embed(GEN z)
1304 : { /* dubious, fail */
1305 386408 : if (typ(z) == t_REAL && realprec(z) <= LOWDEFAULTPREC) return -1;
1306 385091 : return (signe(z) < 1)? 1: 0;
1307 : }
1308 : /* return v such that (-1)^v = sign(sigma_k(x)), x primitive ZC */
1309 : static long
1310 313454 : eval_sign(GEN M, GEN x, long k)
1311 313454 : { return eval_sign_embed( zk_embed(M, x, k) ); }
1312 :
1313 : /* check that signs[i..#signs] == s; signs = NULL encodes "totally positive" */
1314 : static int
1315 0 : oksigns(long l, GEN signs, long i, long s)
1316 : {
1317 0 : if (!signs) return s == 0;
1318 0 : for (; i < l; i++)
1319 0 : if (signs[i] != s) return 0;
1320 0 : return 1;
1321 : }
1322 : /* check that signs[i] = s and signs[i+1..#signs] = 1-s */
1323 : static int
1324 0 : oksigns2(long l, GEN signs, long i, long s)
1325 : {
1326 0 : if (!signs) return s == 0 && i == l-1;
1327 0 : return signs[i] == s && oksigns(l, signs, i+1, 1-s);
1328 : }
1329 :
1330 : /* true nf, x a ZC (primitive for efficiency), embx its embeddings or NULL */
1331 : static int
1332 63602 : nfchecksigns_i(GEN nf, GEN x, GEN embx, GEN signs, GEN archp)
1333 : {
1334 63602 : long l = lg(archp), i;
1335 63602 : GEN M = nf_get_M(nf), sarch = NULL;
1336 63602 : long np = -1;
1337 95333 : for (i = 1; i < l; i++)
1338 : {
1339 : long s;
1340 73423 : if (embx)
1341 72954 : s = eval_sign_embed(gel(embx,i));
1342 : else
1343 469 : s = eval_sign(M, x, archp[i]);
1344 : /* 0 / + or 1 / -; -1 for FAIL */
1345 73423 : if (s < 0) /* failure */
1346 : {
1347 0 : long ni, r1 = nf_get_r1(nf);
1348 : GEN xi;
1349 0 : if (np < 0)
1350 : {
1351 0 : np = num_positive(nf, x);
1352 0 : if (np == 0) return oksigns(l, signs, i, 1);
1353 0 : if (np == r1) return oksigns(l, signs, i, 0);
1354 0 : sarch = nfarchstar(nf, NULL, identity_perm(r1));
1355 : }
1356 0 : xi = set_sign_mod_divisor(nf, vecsmall_ei(r1, archp[i]), gen_1, sarch);
1357 0 : xi = Q_primpart(xi);
1358 0 : ni = num_positive(nf, nfmuli(nf,x,xi));
1359 0 : if (ni == 0) return oksigns2(l, signs, i, 0);
1360 0 : if (ni == r1) return oksigns2(l, signs, i, 1);
1361 0 : s = ni < np? 0: 1;
1362 : }
1363 73423 : if (s != (signs? signs[i]: 0)) return 0;
1364 : }
1365 21910 : return 1;
1366 : }
1367 : static void
1368 343 : pl_convert(GEN pl, GEN *psigns, GEN *parchp)
1369 : {
1370 343 : long i, j, l = lg(pl);
1371 343 : GEN signs = cgetg(l, t_VECSMALL);
1372 343 : GEN archp = cgetg(l, t_VECSMALL);
1373 1092 : for (i = j = 1; i < l; i++)
1374 : {
1375 749 : if (!pl[i]) continue;
1376 511 : archp[j] = i;
1377 511 : signs[j] = (pl[i] < 0)? 1: 0;
1378 511 : j++;
1379 : }
1380 343 : setlg(archp, j); *parchp = archp;
1381 343 : setlg(signs, j); *psigns = signs;
1382 343 : }
1383 : /* pl : requested signs for real embeddings, 0 = no sign constraint */
1384 : int
1385 861 : nfchecksigns(GEN nf, GEN x, GEN pl)
1386 : {
1387 861 : pari_sp av = avma;
1388 : GEN signs, archp;
1389 : int res;
1390 861 : nf = checknf(nf);
1391 861 : x = nf_to_scalar_or_basis(nf,x);
1392 861 : if (typ(x) != t_COL)
1393 : {
1394 518 : long i, l = lg(pl), s = gsigne(x);
1395 1050 : for (i = 1; i < l; i++)
1396 532 : if (pl[i] && pl[i] != s) { avma = av; return 0; }
1397 518 : avma = av; return 1;
1398 : }
1399 343 : pl_convert(pl, &signs, &archp);
1400 343 : res = nfchecksigns_i(nf, x, NULL, signs, archp);
1401 343 : avma = av; return res;
1402 : }
1403 :
1404 : /* signs = NULL: totally positive, else sign[i] = 0 (+) or 1 (-) */
1405 : static GEN
1406 55037 : get_C(GEN lambda, long l, GEN signs)
1407 : {
1408 : long i;
1409 : GEN C, mlambda;
1410 55037 : if (!signs) return const_vec(l-1, lambda);
1411 16194 : C = cgetg(l, t_COL); mlambda = gneg(lambda);
1412 16194 : for (i = 1; i < l; i++) gel(C,i) = signs[i]? mlambda: lambda;
1413 16194 : return C;
1414 : }
1415 : /* signs = NULL: totally positive at archp */
1416 : static GEN
1417 94230 : nfsetsigns(GEN nf, GEN signs, GEN x, GEN sarch)
1418 : {
1419 94230 : long i, l = lg(sarch_get_archp(sarch));
1420 : GEN ex;
1421 : /* Is signature already correct ? */
1422 94230 : if (typ(x) != t_COL)
1423 : {
1424 30971 : long s = gsigne(x);
1425 30971 : if (!s) i = 1;
1426 30957 : else if (!signs)
1427 3605 : i = (s < 0)? 1: l;
1428 : else
1429 : {
1430 27352 : s = s < 0? 1: 0;
1431 42990 : for (i = 1; i < l; i++)
1432 28941 : if (signs[i] != s) break;
1433 : }
1434 30971 : ex = (i < l)? const_col(l-1, x): NULL;
1435 : }
1436 : else
1437 : {
1438 63259 : pari_sp av = avma;
1439 63259 : GEN cex, M = nf_get_M(nf), archp = sarch_get_archp(sarch);
1440 63259 : GEN xp = Q_primitive_part(x,&cex);
1441 63259 : ex = cgetg(l,t_COL);
1442 63259 : for (i = 1; i < l; i++) gel(ex,i) = zk_embed(M,xp,archp[i]);
1443 63259 : if (nfchecksigns_i(nf, xp, ex, signs, archp)) { ex = NULL; avma = av; }
1444 41650 : else if (cex) ex = RgC_Rg_mul(ex, cex); /* put back content */
1445 : }
1446 94230 : if (ex)
1447 : { /* If no, fix it */
1448 55037 : GEN MI = sarch_get_MI(sarch), F = sarch_get_F(sarch);
1449 55037 : GEN lambda = sarch_get_lambda(sarch);
1450 55037 : GEN t = RgC_sub(get_C(lambda, l, signs), ex);
1451 : long e;
1452 55037 : t = grndtoi(RgM_RgC_mul(MI,t), &e);
1453 55037 : if (lg(F) != 1) t = ZM_ZC_mul(F, t);
1454 55037 : x = typ(x) == t_COL? RgC_add(t, x): RgC_Rg_add(t, x);
1455 : }
1456 94230 : return x;
1457 : }
1458 : /* - sarch = nfarchstar(nf, F);
1459 : * - x encodes a vector of signs at arch.archp: either a t_VECSMALL
1460 : * (vector of signs as {0,1}-vector), NULL (totally positive at archp),
1461 : * or a non-zero number field element (replaced by its signature at archp);
1462 : * - y is a non-zero number field element
1463 : * Return z = y (mod F) with signs(y, archp) = signs(x) (a {0,1}-vector) */
1464 : GEN
1465 114922 : set_sign_mod_divisor(GEN nf, GEN x, GEN y, GEN sarch)
1466 : {
1467 114922 : GEN archp = sarch_get_archp(sarch);
1468 114922 : if (lg(archp) == 1) return y;
1469 92872 : nf = checknf(nf);
1470 92872 : if (x && typ(x) != t_VECSMALL) x = nfsign_arch(nf, x, archp);
1471 92872 : y = nf_to_scalar_or_basis(nf,y);
1472 92872 : return nfsetsigns(nf, x, y, sarch);
1473 : }
1474 :
1475 : static GEN
1476 14654 : setsigns_init(GEN nf, GEN archp, GEN F, GEN DATA)
1477 : {
1478 14654 : GEN lambda, Mr = rowpermute(nf_get_M(nf), archp), MI = F? RgM_mul(Mr,F): Mr;
1479 14654 : lambda = gmul2n(matrixnorm(MI,DEFAULTPREC), -1);
1480 14654 : if (typ(lambda) != t_REAL) lambda = gmul(lambda, sstoQ(1001,1000));
1481 14654 : if (lg(archp) < lg(MI))
1482 : {
1483 12558 : GEN perm = gel(indexrank(MI), 2);
1484 12558 : if (!F) F = matid(nf_get_degree(nf));
1485 12558 : MI = vecpermute(MI, perm);
1486 12558 : F = vecpermute(F, perm);
1487 : }
1488 14654 : if (!F) F = cgetg(1,t_MAT);
1489 14654 : MI = RgM_inv(MI);
1490 14654 : return mkvec5(DATA, archp, MI, lambda, F);
1491 : }
1492 : /* F non-0 integral ideal in HNF (or NULL: Z_K), compute elements in 1+F
1493 : * whose sign matrix at archp is identity; archp in 'indices' format */
1494 : GEN
1495 28409 : nfarchstar(GEN nf, GEN F, GEN archp)
1496 : {
1497 28409 : long nba = lg(archp) - 1;
1498 28409 : if (!nba) return mkvec2(cgetg(1,t_VEC), archp);
1499 13303 : if (F && equali1(gcoeff(F,1,1))) F = NULL;
1500 13303 : if (F) F = idealpseudored(F, nf_get_roundG(nf));
1501 13303 : return setsigns_init(nf, archp, F, const_vec(nba, gen_2));
1502 : }
1503 :
1504 : /*************************************************************************/
1505 : /** **/
1506 : /** IDEALCHINESE **/
1507 : /** **/
1508 : /*************************************************************************/
1509 : static int
1510 2989 : isprfact(GEN x)
1511 : {
1512 : long i, l;
1513 : GEN L, E;
1514 2989 : if (typ(x) != t_MAT || lg(x) != 3) return 0;
1515 2989 : L = gel(x,1); l = lg(L);
1516 2989 : E = gel(x,2);
1517 7168 : for(i=1; i<l; i++)
1518 : {
1519 4179 : checkprid(gel(L,i));
1520 4179 : if (typ(gel(E,i)) != t_INT) return 0;
1521 : }
1522 2989 : return 1;
1523 : }
1524 :
1525 : /* initialize projectors mod pr[i]^e[i] for idealchinese */
1526 : static GEN
1527 2989 : pr_init(GEN nf, GEN fa, GEN w, GEN dw)
1528 : {
1529 2989 : GEN U, E, F, L = gel(fa,1), E0 = gel(fa,2);
1530 2989 : long i, r = lg(L);
1531 :
1532 2989 : if (w && lg(w) != r) pari_err_TYPE("idealchinese", w);
1533 2989 : if (r == 1 && !dw) return cgetg(1,t_VEC);
1534 2982 : E = leafcopy(E0); /* do not destroy fa[2] */
1535 7161 : for (i = 1; i < r; i++)
1536 4179 : if (signe(gel(E,i)) < 0) gel(E,i) = gen_0;
1537 2982 : F = factorbackprime(nf, L, E);
1538 2982 : if (dw)
1539 : {
1540 693 : F = ZM_Z_mul(F, dw);
1541 1582 : for (i = 1; i < r; i++)
1542 : {
1543 889 : GEN pr = gel(L,i);
1544 889 : long e = itos(gel(E0,i)), v = idealval(nf, dw, pr);
1545 889 : if (e >= 0)
1546 882 : gel(E,i) = addiu(gel(E,i), v);
1547 7 : else if (v + e <= 0)
1548 0 : F = idealmulpowprime(nf, F, pr, stoi(-v)); /* coprime to pr */
1549 : else
1550 : {
1551 7 : F = idealmulpowprime(nf, F, pr, stoi(e));
1552 7 : gel(E,i) = stoi(v + e);
1553 : }
1554 : }
1555 : }
1556 2982 : U = cgetg(r, t_VEC);
1557 7161 : for (i = 1; i < r; i++)
1558 : {
1559 : GEN u;
1560 4179 : if (w && gequal0(gel(w,i))) u = gen_0; /* unused */
1561 : else
1562 : {
1563 4102 : GEN pr = gel(L,i), e = gel(E,i), t;
1564 4102 : t = idealdivpowprime(nf,F, pr, e);
1565 4102 : u = hnfmerge_get_1(t, idealpow(nf, pr, e));
1566 4102 : if (!u) pari_err_COPRIME("idealchinese", t,pr);
1567 : }
1568 4179 : gel(U,i) = u;
1569 : }
1570 2982 : F = idealpseudored(F, nf_get_roundG(nf));
1571 2982 : return mkvec2(F, U);
1572 : }
1573 :
1574 : static GEN
1575 1771 : pl_normalize(GEN nf, GEN pl)
1576 : {
1577 1771 : const char *fun = "idealchinese";
1578 1771 : if (lg(pl)-1 != nf_get_r1(nf)) pari_err_TYPE(fun,pl);
1579 1771 : switch(typ(pl))
1580 : {
1581 707 : case t_VEC: RgV_check_ZV(pl,fun); pl = ZV_to_zv(pl);
1582 : /* fall through */
1583 1771 : case t_VECSMALL: break;
1584 0 : default: pari_err_TYPE(fun,pl);
1585 : }
1586 1771 : return pl;
1587 : }
1588 :
1589 : static int
1590 7091 : is_chineseinit(GEN x)
1591 : {
1592 : GEN fa, pl;
1593 : long l;
1594 7091 : if (typ(x) != t_VEC || lg(x)!=3) return 0;
1595 5425 : fa = gel(x,1);
1596 5425 : pl = gel(x,2);
1597 5425 : if (typ(fa) != t_VEC || typ(pl) != t_VEC) return 0;
1598 2681 : l = lg(fa);
1599 2681 : if (l != 1)
1600 : {
1601 2660 : if (l != 3 || typ(gel(fa,1)) != t_MAT || typ(gel(fa,2)) != t_VEC)
1602 7 : return 0;
1603 : }
1604 2674 : l = lg(pl);
1605 2674 : if (l != 1)
1606 : {
1607 511 : if (l != 6 || typ(gel(pl,3)) != t_MAT || typ(gel(pl,1)) != t_VECSMALL
1608 511 : || typ(gel(pl,2)) != t_VECSMALL)
1609 0 : return 0;
1610 : }
1611 2674 : return 1;
1612 : }
1613 :
1614 : /* nf a true 'nf' */
1615 : static GEN
1616 3122 : chineseinit_i(GEN nf, GEN fa, GEN w, GEN dw)
1617 : {
1618 3122 : const char *fun = "idealchineseinit";
1619 3122 : GEN archp = NULL, pl = NULL;
1620 3122 : switch(typ(fa))
1621 : {
1622 : case t_VEC:
1623 1771 : if (is_chineseinit(fa))
1624 : {
1625 0 : if (dw) pari_err_DOMAIN(fun, "denom(y)", "!=", gen_1, w);
1626 0 : return fa;
1627 : }
1628 1771 : if (lg(fa) != 3) pari_err_TYPE(fun, fa);
1629 : /* of the form [x,s] */
1630 1771 : pl = pl_normalize(nf, gel(fa,2));
1631 1771 : fa = gel(fa,1);
1632 1771 : archp = vecsmall01_to_indices(pl);
1633 : /* keep pr_init, reset pl */
1634 1771 : if (is_chineseinit(fa)) { fa = gel(fa,1); break; }
1635 : /* fall through */
1636 : case t_MAT: /* factorization? */
1637 2989 : if (isprfact(fa)) { fa = pr_init(nf, fa, w, dw); break; }
1638 0 : default: pari_err_TYPE(fun,fa);
1639 : }
1640 :
1641 3122 : if (!pl) pl = cgetg(1,t_VEC);
1642 : else
1643 : {
1644 1771 : long r = lg(archp);
1645 1771 : if (r == 1) pl = cgetg(1, t_VEC);
1646 : else
1647 : {
1648 1351 : GEN F = (lg(fa) == 1)? NULL: gel(fa,1), signs = cgetg(r, t_VECSMALL);
1649 : long i;
1650 1351 : for (i = 1; i < r; i++) signs[i] = (pl[archp[i]] < 0)? 1: 0;
1651 1351 : pl = setsigns_init(nf, archp, F, signs);
1652 : }
1653 : }
1654 3122 : return mkvec2(fa, pl);
1655 : }
1656 :
1657 : /* Given a prime ideal factorization x, possibly with 0 or negative exponents,
1658 : * and a vector w of elements of nf, gives b such that
1659 : * v_p(b-w_p)>=v_p(x) for all prime ideals p in the ideal factorization
1660 : * and v_p(b)>=0 for all other p, using the standard proof given in GTM 138. */
1661 : GEN
1662 5663 : idealchinese(GEN nf, GEN x, GEN w)
1663 : {
1664 5663 : const char *fun = "idealchinese";
1665 5663 : pari_sp av = avma;
1666 : GEN x1, x2, s, dw, F;
1667 :
1668 5663 : nf = checknf(nf);
1669 5663 : if (!w) return gerepilecopy(av, chineseinit_i(nf,x,NULL,NULL));
1670 :
1671 3549 : if (typ(w) != t_VEC) pari_err_TYPE(fun,w);
1672 3549 : w = Q_remove_denom(matalgtobasis(nf,w), &dw);
1673 3549 : if (!is_chineseinit(x)) x = chineseinit_i(nf,x,w,dw);
1674 : /* x is a 'chineseinit' */
1675 3549 : x1 = gel(x,1); s = NULL;
1676 3549 : x2 = gel(x,2);
1677 3549 : if (lg(x1) == 1) F = NULL;
1678 : else
1679 : {
1680 3528 : GEN U = gel(x1,2);
1681 3528 : long i, r = lg(w);
1682 3528 : F = gel(x1,1);
1683 10115 : for (i=1; i<r; i++)
1684 6587 : if (!gequal0(gel(w,i)))
1685 : {
1686 4123 : GEN t = nfmuli(nf, gel(U,i), gel(w,i));
1687 4123 : s = s? ZC_add(s,t): t;
1688 : }
1689 3528 : if (s) s = ZC_reducemodmatrix(s, F);
1690 : }
1691 3549 : if (lg(x2) != 1) s = nfsetsigns(nf, gel(x2,1), s? s: gen_0, x2);
1692 3549 : if (!s) { s = zerocol(nf_get_degree(nf)); dw = NULL; }
1693 :
1694 3549 : if (dw) s = RgC_Rg_div(s,dw);
1695 3549 : return gerepileupto(av, s);
1696 : }
1697 :
1698 : /*************************************************************************/
1699 : /** **/
1700 : /** (Z_K/I)^* **/
1701 : /** **/
1702 : /*************************************************************************/
1703 : GEN
1704 1771 : vecsmall01_to_indices(GEN v)
1705 : {
1706 1771 : long i, k, l = lg(v);
1707 1771 : GEN p = new_chunk(l) + l;
1708 4753 : for (k=1, i=l-1; i; i--)
1709 2982 : if (v[i]) { *--p = i; k++; }
1710 1771 : *--p = evallg(k) | evaltyp(t_VECSMALL);
1711 1771 : avma = (pari_sp)p; return p;
1712 : }
1713 : GEN
1714 363601 : vec01_to_indices(GEN v)
1715 : {
1716 : long i, k, l;
1717 : GEN p;
1718 :
1719 363601 : switch (typ(v))
1720 : {
1721 349370 : case t_VECSMALL: return v;
1722 14231 : case t_VEC: break;
1723 0 : default: pari_err_TYPE("vec01_to_indices",v);
1724 : }
1725 14231 : l = lg(v);
1726 14231 : p = new_chunk(l) + l;
1727 41594 : for (k=1, i=l-1; i; i--)
1728 27363 : if (signe(gel(v,i))) { *--p = i; k++; }
1729 14231 : *--p = evallg(k) | evaltyp(t_VECSMALL);
1730 14231 : avma = (pari_sp)p; return p;
1731 : }
1732 : GEN
1733 5159 : indices_to_vec01(GEN p, long r)
1734 : {
1735 5159 : long i, l = lg(p);
1736 5159 : GEN v = zerovec(r);
1737 5159 : for (i = 1; i < l; i++) gel(v, p[i]) = gen_1;
1738 5159 : return v;
1739 : }
1740 :
1741 : /* return (column) vector of R1 signatures of x (0 or 1) */
1742 : GEN
1743 349370 : nfsign_arch(GEN nf, GEN x, GEN arch)
1744 : {
1745 349370 : GEN sarch, M, V, archp = vec01_to_indices(arch);
1746 349370 : long i, s, np, n = lg(archp)-1;
1747 : pari_sp av;
1748 :
1749 349370 : if (!n) return cgetg(1,t_VECSMALL);
1750 348341 : nf = checknf(nf);
1751 348341 : if (typ(x) == t_MAT)
1752 : { /* factorisation */
1753 99418 : GEN g = gel(x,1), e = gel(x,2);
1754 99418 : V = zero_zv(n);
1755 289007 : for (i=1; i<lg(g); i++)
1756 189589 : if (mpodd(gel(e,i)))
1757 164214 : Flv_add_inplace(V, nfsign_arch(nf,gel(g,i),archp), 2);
1758 99418 : avma = (pari_sp)V; return V;
1759 : }
1760 248923 : av = avma; V = cgetg(n+1,t_VECSMALL);
1761 248923 : x = nf_to_scalar_or_basis(nf, x);
1762 248923 : switch(typ(x))
1763 : {
1764 : case t_INT:
1765 65034 : s = signe(x);
1766 65034 : if (!s) pari_err_DOMAIN("nfsign_arch","element","=",gen_0,x);
1767 65034 : avma = av; return const_vecsmall(n, (s < 0)? 1: 0);
1768 : case t_FRAC:
1769 35 : s = signe(gel(x,1));
1770 35 : avma = av; return const_vecsmall(n, (s < 0)? 1: 0);
1771 : }
1772 183854 : x = Q_primpart(x); M = nf_get_M(nf); sarch = NULL; np = -1;
1773 495522 : for (i = 1; i <= n; i++)
1774 : {
1775 312985 : long s = eval_sign(M, x, archp[i]);
1776 312985 : if (s < 0) /* failure */
1777 : {
1778 1317 : long ni, r1 = nf_get_r1(nf);
1779 : GEN xi;
1780 1317 : if (np < 0)
1781 : {
1782 1317 : np = num_positive(nf, x);
1783 1317 : if (np == 0) { avma = av; return const_vecsmall(n, 1); }
1784 1179 : if (np == r1){ avma = av; return const_vecsmall(n, 0); }
1785 682 : sarch = nfarchstar(nf, NULL, identity_perm(r1));
1786 : }
1787 682 : xi = set_sign_mod_divisor(nf, vecsmall_ei(r1, archp[i]), gen_1, sarch);
1788 682 : xi = Q_primpart(xi);
1789 682 : ni = num_positive(nf, nfmuli(nf,x,xi));
1790 682 : if (ni == 0) { avma = av; V = const_vecsmall(n, 1); V[i] = 0; return V; }
1791 544 : if (ni == r1){ avma = av; V = const_vecsmall(n, 0); V[i] = 1; return V; }
1792 0 : s = ni < np? 0: 1;
1793 : }
1794 311668 : V[i] = s;
1795 : }
1796 182537 : avma = (pari_sp)V; return V;
1797 : }
1798 : static void
1799 6797 : chk_ind(const char *s, long i, long r1)
1800 : {
1801 6797 : if (i <= 0) pari_err_DOMAIN(s, "index", "<=", gen_0, stoi(i));
1802 6783 : if (i > r1) pari_err_DOMAIN(s, "index", ">", utoi(r1), utoi(i));
1803 6748 : }
1804 : static GEN
1805 6286 : parse_embed(GEN ind, long r, const char *f)
1806 : {
1807 : long l, i;
1808 6286 : if (!ind) return identity_perm(r);
1809 4823 : switch(typ(ind))
1810 : {
1811 861 : case t_INT: case t_VEC: case t_COL: ind = gtovecsmall(ind); break;
1812 3962 : case t_VECSMALL: break;
1813 0 : default: pari_err_TYPE(f, ind);
1814 : }
1815 4823 : l = lg(ind);
1816 4823 : for (i = 1; i < l; i++) chk_ind(f, ind[i], r);
1817 4774 : return ind;
1818 : }
1819 : GEN
1820 4732 : nfeltsign(GEN nf, GEN x, GEN ind0)
1821 : {
1822 4732 : pari_sp av = avma;
1823 : long i, l, r1;
1824 : GEN v, ind;
1825 4732 : nf = checknf(nf); r1 = nf_get_r1(nf);
1826 4732 : x = nf_to_scalar_or_basis(nf, x);
1827 4732 : ind = parse_embed(ind0, r1, "nfeltsign");
1828 4711 : l = lg(ind);
1829 4711 : if (typ(x) != t_COL)
1830 : {
1831 : GEN s;
1832 2163 : switch(gsigne(x))
1833 : {
1834 532 : case -1:s = gen_m1; break;
1835 1624 : case 1: s = gen_1; break;
1836 7 : default: s = gen_0; break;
1837 : }
1838 2163 : avma = av;
1839 2163 : return (ind0 && typ(ind0) == t_INT)? s: const_vec(l-1, s);
1840 : }
1841 2548 : v = nfsign_arch(nf, x, ind);
1842 2548 : if (ind0 && typ(ind0) == t_INT) { avma = av; return v[1]? gen_m1: gen_1; }
1843 2541 : settyp(v, t_VEC);
1844 2541 : for (i = 1; i < l; i++) gel(v,i) = v[i]? gen_m1: gen_1;
1845 2541 : return gerepileupto(av, v);
1846 : }
1847 :
1848 : GEN
1849 63 : nfeltembed(GEN nf, GEN x, GEN ind0, long prec0)
1850 : {
1851 63 : pari_sp av = avma;
1852 : long i, e, l, r1, r2, prec, prec1;
1853 : GEN v, ind, cx;
1854 63 : nf = checknf(nf); nf_get_sign(nf,&r1,&r2);
1855 63 : x = nf_to_scalar_or_basis(nf, x);
1856 56 : ind = parse_embed(ind0, r1+r2, "nfeltembed");
1857 49 : l = lg(ind);
1858 49 : if (typ(x) != t_COL)
1859 : {
1860 0 : if (!(ind0 && typ(ind0) == t_INT)) x = const_vec(l-1, x);
1861 0 : return gerepilecopy(av, x);
1862 : }
1863 49 : x = Q_primitive_part(x, &cx);
1864 49 : prec1 = prec0; e = gexpo(x);
1865 49 : if (e > 8) prec1 += nbits2extraprec(e);
1866 49 : prec = prec1;
1867 49 : if (nf_get_prec(nf) < prec) nf = nfnewprec_shallow(nf, prec);
1868 49 : v = cgetg(l, t_VEC);
1869 : for(;;)
1870 7 : {
1871 56 : GEN M = nf_get_M(nf);
1872 140 : for (i = 1; i < l; i++)
1873 : {
1874 91 : GEN t = nfembed_i(M, x, ind[i]);
1875 91 : long e = gexpo(t);
1876 91 : if (gequal0(t) || precision(t) < prec0
1877 91 : || (e < 0 && prec < prec1 + nbits2extraprec(-e)) ) break;
1878 84 : if (cx) t = gmul(t, cx);
1879 84 : gel(v,i) = t;
1880 : }
1881 56 : if (i == l) break;
1882 7 : prec = precdbl(prec);
1883 7 : if (DEBUGLEVEL>1) pari_warn(warnprec,"eltnfembed", prec);
1884 7 : nf = nfnewprec_shallow(nf, prec);
1885 : }
1886 49 : if (ind0 && typ(ind0) == t_INT) v = gel(v,1);
1887 49 : return gerepilecopy(av, v);
1888 : }
1889 :
1890 : /* number of distinct roots of sigma(f) */
1891 : GEN
1892 1498 : nfpolsturm(GEN nf, GEN f, GEN ind0)
1893 : {
1894 1498 : pari_sp av = avma;
1895 : long d, l, r1, single;
1896 : GEN ind, u, v, vr1, T, s, t;
1897 :
1898 1498 : nf = checknf(nf); T = nf_get_pol(nf); r1 = nf_get_r1(nf);
1899 1498 : ind = parse_embed(ind0, r1, "nfpolsturm");
1900 1477 : single = ind0 && typ(ind0) == t_INT;
1901 1477 : l = lg(ind);
1902 :
1903 1477 : if (gequal0(f)) pari_err_ROOTS0("nfpolsturm");
1904 1470 : if (typ(f) == t_POL && varn(f) != varn(T))
1905 : {
1906 1449 : f = RgX_nffix("nfsturn", T, f,1);
1907 1449 : if (lg(f) == 3) f = NULL;
1908 : }
1909 : else
1910 : {
1911 21 : (void)Rg_nffix("nfpolsturm", T, f, 0);
1912 21 : f = NULL;
1913 : }
1914 1470 : if (!f) { avma = av; return single? gen_0: zerovec(l-1); }
1915 1449 : d = degpol(f);
1916 1449 : if (d == 1) { avma = av; return single? gen_1: const_vec(l-1,gen_1); }
1917 :
1918 1428 : vr1 = const_vecsmall(l-1, 1);
1919 1428 : u = Q_primpart(f); s = ZV_to_zv(nfeltsign(nf, gel(u,d+2), ind));
1920 1428 : v = RgX_deriv(u); t = odd(d)? leafcopy(s): zv_neg(s);
1921 : for(;;)
1922 154 : {
1923 1582 : GEN r = RgX_neg( Q_primpart(RgX_pseudorem(u, v)) ), sr;
1924 1582 : long i, dr = degpol(r);
1925 1582 : if (dr < 0) break;
1926 1582 : sr = ZV_to_zv(nfeltsign(nf, gel(r,dr+2), ind));
1927 3941 : for (i = 1; i < l; i++)
1928 2359 : if (sr[i] != s[i]) { s[i] = sr[i], vr1[i]--; }
1929 1582 : if (odd(dr)) sr = zv_neg(sr);
1930 3941 : for (i = 1; i < l; i++)
1931 2359 : if (sr[i] != t[i]) { t[i] = sr[i], vr1[i]++; }
1932 1582 : if (!dr) break;
1933 154 : u = v; v = r;
1934 : }
1935 1428 : if (single) { avma = av; return stoi(vr1[1]); }
1936 721 : return gerepileupto(av, zv_to_ZV(vr1));
1937 : }
1938 :
1939 :
1940 : /* return the vector of signs of x; the matrix of such if x is a vector
1941 : * of nf elements */
1942 : GEN
1943 1456 : nfsign(GEN nf, GEN x)
1944 : {
1945 : long i, l;
1946 : GEN archp, S;
1947 :
1948 1456 : nf = checknf(nf);
1949 1456 : archp = identity_perm( nf_get_r1(nf) );
1950 1456 : if (typ(x) != t_VEC) return nfsign_arch(nf, x, archp);
1951 252 : l = lg(x); S = cgetg(l, t_MAT);
1952 252 : for (i=1; i<l; i++) gel(S,i) = nfsign_arch(nf, gel(x,i), archp);
1953 252 : return S;
1954 : }
1955 :
1956 : /* x integral elt, A integral ideal in HNF; reduce x mod A */
1957 : static GEN
1958 604002 : zk_modHNF(GEN x, GEN A)
1959 604002 : { return (typ(x) == t_COL)? ZC_hnfrem(x, A): modii(x, gcoeff(A,1,1)); }
1960 :
1961 : /* given an element x in Z_K and an integral ideal y in HNF, coprime with x,
1962 : outputs an element inverse of x modulo y */
1963 : GEN
1964 154 : nfinvmodideal(GEN nf, GEN x, GEN y)
1965 : {
1966 154 : pari_sp av = avma;
1967 154 : GEN a, yZ = gcoeff(y,1,1);
1968 :
1969 154 : if (equali1(yZ)) return gen_0;
1970 154 : x = nf_to_scalar_or_basis(nf, x);
1971 154 : if (typ(x) == t_INT) return gerepileupto(av, Fp_inv(x, yZ));
1972 :
1973 84 : a = hnfmerge_get_1(idealhnf_principal(nf,x), y);
1974 84 : if (!a) pari_err_INV("nfinvmodideal", x);
1975 84 : return gerepileupto(av, zk_modHNF(nfdiv(nf,a,x), y));
1976 : }
1977 :
1978 : static GEN
1979 277327 : nfsqrmodideal(GEN nf, GEN x, GEN id)
1980 277327 : { return zk_modHNF(nfsqri(nf,x), id); }
1981 : static GEN
1982 735440 : nfmulmodideal(GEN nf, GEN x, GEN y, GEN id)
1983 735440 : { return x? zk_modHNF(nfmuli(nf,x,y), id): y; }
1984 : /* assume x integral, k integer, A in HNF */
1985 : GEN
1986 475929 : nfpowmodideal(GEN nf,GEN x,GEN k,GEN A)
1987 : {
1988 475929 : long s = signe(k);
1989 : pari_sp av;
1990 : GEN y;
1991 :
1992 475929 : if (!s) return gen_1;
1993 475929 : av = avma;
1994 475929 : x = nf_to_scalar_or_basis(nf, x);
1995 475929 : if (typ(x) != t_COL) return Fp_pow(x, k, gcoeff(A,1,1));
1996 226131 : if (s < 0) { x = nfinvmodideal(nf, x,A); k = negi(k); }
1997 226131 : for(y = NULL;;)
1998 : {
1999 780785 : if (mpodd(k)) y = nfmulmodideal(nf,y,x,A);
2000 503458 : k = shifti(k,-1); if (!signe(k)) break;
2001 277327 : x = nfsqrmodideal(nf,x,A);
2002 : }
2003 226131 : return gerepileupto(av, y);
2004 : }
2005 :
2006 : /* a * g^n mod id */
2007 : static GEN
2008 422736 : nfmulpowmodideal(GEN nf, GEN a, GEN g, GEN n, GEN id)
2009 : {
2010 422736 : return nfmulmodideal(nf, a, nfpowmodideal(nf,g,n,id), id);
2011 : }
2012 :
2013 : /* assume (num(g[i]), id) = 1 for all i. Return prod g[i]^e[i] mod id.
2014 : * EX = multiple of exponent of (O_K/id)^* */
2015 : GEN
2016 194842 : famat_to_nf_modideal_coprime(GEN nf, GEN g, GEN e, GEN id, GEN EX)
2017 : {
2018 194842 : GEN EXo2, plus = NULL, minus = NULL, idZ = gcoeff(id,1,1);
2019 194842 : long i, lx = lg(g);
2020 :
2021 194842 : if (equali1(idZ)) return gen_1; /* id = Z_K */
2022 194611 : EXo2 = (expi(EX) > 10)? shifti(EX,-1): NULL;
2023 874172 : for (i = 1; i < lx; i++)
2024 : {
2025 679561 : GEN h, n = centermodii(gel(e,i), EX, EXo2);
2026 679561 : long sn = signe(n);
2027 679561 : if (!sn) continue;
2028 :
2029 324374 : h = nf_to_scalar_or_basis(nf, gel(g,i));
2030 324374 : switch(typ(h))
2031 : {
2032 199921 : case t_INT: break;
2033 : case t_FRAC:
2034 0 : h = Fp_div(gel(h,1), gel(h,2), idZ); break;
2035 : default:
2036 : {
2037 : GEN dh;
2038 124453 : h = Q_remove_denom(h, &dh);
2039 124453 : if (dh) h = FpC_Fp_mul(h, Fp_inv(dh,idZ), idZ);
2040 : }
2041 : }
2042 324374 : if (sn > 0)
2043 322953 : plus = nfmulpowmodideal(nf, plus, h, n, id);
2044 : else /* sn < 0 */
2045 1421 : minus = nfmulpowmodideal(nf, minus, h, negi(n), id);
2046 : }
2047 194611 : if (minus) plus = nfmulmodideal(nf, plus, nfinvmodideal(nf,minus,id), id);
2048 194611 : return plus? plus: gen_1;
2049 : }
2050 :
2051 : /* given 2 integral ideals x, y in HNF s.t x | y | x^2, compute (1+x)/(1+y) in
2052 : * the form [[cyc],[gen], U], where U := ux^-1 as a pair [ZM, denom(U)] */
2053 : static GEN
2054 20839 : zidealij(GEN x, GEN y)
2055 : {
2056 20839 : GEN U, G, cyc, xp = gcoeff(x,1,1), xi = hnf_invscale(x, xp);
2057 : long j, N;
2058 :
2059 : /* x^(-1) y = relations between the 1 + x_i (HNF) */
2060 20839 : cyc = ZM_snf_group(ZM_Z_divexact(ZM_mul(xi, y), xp), &U, &G);
2061 20839 : N = lg(cyc); G = ZM_mul(x,G); settyp(G, t_VEC); /* new generators */
2062 77700 : for (j=1; j<N; j++)
2063 : {
2064 56861 : GEN c = gel(G,j);
2065 56861 : gel(c,1) = addiu(gel(c,1), 1); /* 1 + g_j */
2066 56861 : if (ZV_isscalar(c)) gel(G,j) = gel(c,1);
2067 : }
2068 20839 : return mkvec4(cyc, G, ZM_mul(U,xi), xp);
2069 : }
2070 :
2071 : /* lg(x) > 1, x + 1; shallow */
2072 : static GEN
2073 7098 : ZC_add1(GEN x)
2074 : {
2075 7098 : long i, l = lg(x);
2076 7098 : GEN y = cgetg(l, t_COL);
2077 7098 : for (i = 2; i < l; i++) gel(y,i) = gel(x,i);
2078 7098 : gel(y,1) = addiu(gel(x,1), 1); return y;
2079 : }
2080 : /* lg(x) > 1, x - 1; shallow */
2081 : static GEN
2082 3948 : ZC_sub1(GEN x)
2083 : {
2084 3948 : long i, l = lg(x);
2085 3948 : GEN y = cgetg(l, t_COL);
2086 3948 : for (i = 2; i < l; i++) gel(y,i) = gel(x,i);
2087 3948 : gel(y,1) = subiu(gel(x,1), 1); return y;
2088 : }
2089 :
2090 : /* x,y are t_INT or ZC */
2091 : static GEN
2092 0 : zkadd(GEN x, GEN y)
2093 : {
2094 0 : long tx = typ(x);
2095 0 : if (tx == typ(y))
2096 0 : return tx == t_INT? addii(x,y): ZC_add(x,y);
2097 : else
2098 0 : return tx == t_INT? ZC_Z_add(y,x): ZC_Z_add(x,y);
2099 : }
2100 : /* x a t_INT or ZC, x+1; shallow */
2101 : static GEN
2102 14812 : zkadd1(GEN x)
2103 : {
2104 14812 : long tx = typ(x);
2105 14812 : return tx == t_INT? addiu(x,1): ZC_add1(x);
2106 : }
2107 : /* x a t_INT or ZC, x-1; shallow */
2108 : static GEN
2109 14812 : zksub1(GEN x)
2110 : {
2111 14812 : long tx = typ(x);
2112 14812 : return tx == t_INT? subiu(x,1): ZC_sub1(x);
2113 : }
2114 : /* x,y are t_INT or ZC; x - y */
2115 : static GEN
2116 0 : zksub(GEN x, GEN y)
2117 : {
2118 0 : long tx = typ(x), ty = typ(y);
2119 0 : if (tx == ty)
2120 0 : return tx == t_INT? subii(x,y): ZC_sub(x,y);
2121 : else
2122 0 : return tx == t_INT? Z_ZC_sub(x,y): ZC_Z_sub(x,y);
2123 : }
2124 : /* x is t_INT or ZM (mult. map), y is t_INT or ZC; x * y */
2125 : static GEN
2126 14812 : zkmul(GEN x, GEN y)
2127 : {
2128 14812 : long tx = typ(x), ty = typ(y);
2129 14812 : if (ty == t_INT)
2130 10864 : return tx == t_INT? mulii(x,y): ZC_Z_mul(gel(x,1),y);
2131 : else
2132 3948 : return tx == t_INT? ZC_Z_mul(y,x): ZM_ZC_mul(x,y);
2133 : }
2134 :
2135 : /* (U,V) = 1 coprime ideals. Want z = x mod U, = y mod V; namely
2136 : * z =vx + uy = v(x-y) + y, where u + v = 1, u in U, v in V.
2137 : * zkc = [v, UV], v a t_INT or ZM (mult. by v map), UV a ZM (ideal in HNF);
2138 : * shallow */
2139 : GEN
2140 0 : zkchinese(GEN zkc, GEN x, GEN y)
2141 : {
2142 0 : GEN v = gel(zkc,1), UV = gel(zkc,2), z = zkadd(zkmul(v, zksub(x,y)), y);
2143 0 : return zk_modHNF(z, UV);
2144 : }
2145 : /* special case z = x mod U, = 1 mod V; shallow */
2146 : GEN
2147 14812 : zkchinese1(GEN zkc, GEN x)
2148 : {
2149 14812 : GEN v = gel(zkc,1), UV = gel(zkc,2), z = zkadd1(zkmul(v, zksub1(x)));
2150 14812 : return (typ(z) == t_INT)? z: ZC_hnfrem(z, UV);
2151 : }
2152 : static GEN
2153 13440 : zkVchinese1(GEN zkc, GEN v)
2154 : {
2155 : long i, ly;
2156 13440 : GEN y = cgetg_copy(v, &ly);
2157 13440 : for (i=1; i<ly; i++) gel(y,i) = zkchinese1(zkc, gel(v,i));
2158 13440 : return y;
2159 : }
2160 :
2161 : /* prepare to solve z = x (mod A), z = y mod (B) [zkchinese or zkchinese1] */
2162 : GEN
2163 13181 : zkchineseinit(GEN nf, GEN A, GEN B, GEN AB)
2164 : {
2165 : GEN v;
2166 : long e;
2167 13181 : nf = checknf(nf);
2168 13181 : v = idealaddtoone_raw(nf, A, B);
2169 13181 : if ((e = gexpo(v)) > 5)
2170 : {
2171 588 : GEN b = (typ(v) == t_COL)? v: scalarcol_shallow(v, nf_get_degree(nf));
2172 588 : b= ZC_reducemodlll(b, AB);
2173 588 : if (gexpo(b) < e) v = b;
2174 : }
2175 13181 : return mkvec2(zk_scalar_or_multable(nf,v), AB);
2176 : }
2177 : /* prepare to solve z = x (mod A), z = 1 mod (B)
2178 : * and then z = 1 (mod A), z = y mod (B) [zkchinese1 twice] */
2179 : static GEN
2180 259 : zkchinese1init2(GEN nf, GEN A, GEN B, GEN AB)
2181 : {
2182 259 : GEN zkc = zkchineseinit(nf, A, B, AB);
2183 259 : GEN mv = gel(zkc,1), mu;
2184 259 : if (typ(mv) == t_INT) return mkvec2(zkc, mkvec2(subui(1,mv),AB));
2185 35 : mu = RgM_Rg_add_shallow(ZM_neg(mv), gen_1);
2186 35 : return mkvec2(mkvec2(mv,AB), mkvec2(mu,AB));
2187 : }
2188 :
2189 : static GEN
2190 354772 : apply_U(GEN L, GEN a)
2191 : {
2192 354772 : GEN e, U = gel(L,3), dU = gel(L,4);
2193 354772 : if (typ(a) == t_INT)
2194 130904 : e = ZC_Z_mul(gel(U,1), subiu(a, 1));
2195 : else
2196 : { /* t_COL */
2197 223868 : GEN t = gel(a,1);
2198 223868 : gel(a,1) = subiu(gel(a,1), 1); /* a -= 1 */
2199 223868 : e = ZM_ZC_mul(U, a);
2200 223868 : gel(a,1) = t; /* restore */
2201 : }
2202 354772 : return gdiv(e, dU);
2203 : }
2204 :
2205 : /* true nf; vectors of [[cyc],[g],U.X^-1]. Assume k > 1. */
2206 : static GEN
2207 14154 : principal_units(GEN nf, GEN pr, long k, GEN prk)
2208 : {
2209 : GEN list, prb;
2210 14154 : ulong mask = quadratic_prec_mask(k);
2211 14154 : long a = 1;
2212 :
2213 14154 : if (DEBUGLEVEL>3) err_printf("treating pr^%ld, pr = %Ps\n",k,pr);
2214 14154 : prb = pr_hnf(nf,pr);
2215 14154 : list = vectrunc_init(k);
2216 49147 : while (mask > 1)
2217 : {
2218 20839 : GEN pra = prb;
2219 20839 : long b = a << 1;
2220 :
2221 20839 : if (mask & 1) b--;
2222 20839 : mask >>= 1;
2223 : /* compute 1 + pr^a / 1 + pr^b, 2a <= b */
2224 20839 : if(DEBUGLEVEL>3) err_printf(" treating a = %ld, b = %ld\n",a,b);
2225 20839 : prb = (b >= k)? prk: idealpows(nf,pr,b);
2226 20839 : vectrunc_append(list, zidealij(pra, prb));
2227 20839 : a = b;
2228 : }
2229 14154 : return list;
2230 : }
2231 : /* a = 1 mod (pr) return log(a) on local-gens of 1+pr/1+pr^k */
2232 : static GEN
2233 224950 : log_prk1(GEN nf, GEN a, long nh, GEN L2, GEN prk)
2234 : {
2235 224950 : GEN y = cgetg(nh+1, t_COL);
2236 224950 : long j, iy, c = lg(L2)-1;
2237 579715 : for (j = iy = 1; j <= c; j++)
2238 : {
2239 354772 : GEN L = gel(L2,j), cyc = gel(L,1), gen = gel(L,2), E = apply_U(L,a);
2240 354772 : long i, nc = lg(cyc)-1;
2241 354772 : int last = (j == c);
2242 1242006 : for (i = 1; i <= nc; i++, iy++)
2243 : {
2244 887241 : GEN t, e = gel(E,i);
2245 887241 : if (typ(e) != t_INT) pari_err_COPRIME("zlog_prk1", a, prk);
2246 887234 : t = Fp_neg(e, gel(cyc,i));
2247 887234 : gel(y,iy) = negi(t);
2248 887234 : if (!last && signe(t)) a = nfmulpowmodideal(nf, a, gel(gen,i), t, prk);
2249 : }
2250 : }
2251 224943 : return y;
2252 : }
2253 : /* true nf */
2254 : static GEN
2255 5768 : principal_units_relations(GEN nf, GEN L2, GEN prk, long nh)
2256 : {
2257 5768 : GEN h = cgetg(nh+1,t_MAT);
2258 5768 : long ih, j, c = lg(L2)-1;
2259 18221 : for (j = ih = 1; j <= c; j++)
2260 : {
2261 12453 : GEN L = gel(L2,j), F = gel(L,1), G = gel(L,2);
2262 12453 : long k, lG = lg(G);
2263 51583 : for (k = 1; k < lG; k++,ih++)
2264 : { /* log(g^f) mod pr^e */
2265 39130 : GEN a = nfpowmodideal(nf,gel(G,k),gel(F,k),prk);
2266 39130 : gel(h,ih) = ZC_neg(log_prk1(nf, a, nh, L2, prk));
2267 39130 : gcoeff(h,ih,ih) = gel(F,k);
2268 : }
2269 : }
2270 5768 : return h;
2271 : }
2272 : /* true nf; e > 1; multiplicative group (1 + pr) / (1 + pr^k),
2273 : * prk = pr^k or NULL */
2274 : static GEN
2275 14154 : idealprincipalunits_i(GEN nf, GEN pr, long k, GEN *pU)
2276 : {
2277 14154 : GEN cyc, gen, L2, prk = idealpows(nf, pr, k);
2278 :
2279 14154 : L2 = principal_units(nf, pr, k, prk);
2280 14154 : if (k == 2)
2281 : {
2282 8386 : GEN L = gel(L2,1);
2283 8386 : cyc = gel(L,1);
2284 8386 : gen = gel(L,2);
2285 8386 : if (pU) *pU = matid(lg(gen)-1);
2286 : }
2287 : else
2288 : {
2289 5768 : long c = lg(L2), j;
2290 5768 : GEN EX, h, Ui, vg = cgetg(c, t_VEC);
2291 5768 : for (j = 1; j < c; j++) gel(vg, j) = gmael(L2,j,2);
2292 5768 : vg = shallowconcat1(vg);
2293 5768 : h = principal_units_relations(nf, L2, prk, lg(vg)-1);
2294 5768 : h = ZM_hnfall_i(h, NULL, 0);
2295 5768 : cyc = ZM_snf_group(h, pU, &Ui);
2296 5768 : c = lg(Ui); gen = cgetg(c, t_VEC); EX = gel(cyc,1);
2297 32585 : for (j = 1; j < c; j++)
2298 26817 : gel(gen,j) = famat_to_nf_modideal_coprime(nf, vg, gel(Ui,j), prk, EX);
2299 : }
2300 14154 : return mkvec4(cyc, gen, prk, L2);
2301 : }
2302 : GEN
2303 112 : idealprincipalunits(GEN nf, GEN pr, long k)
2304 : {
2305 : pari_sp av;
2306 : GEN v;
2307 112 : nf = checknf(nf);
2308 112 : if (k == 1) { checkprid(pr); retmkvec3(gen_1,cgetg(1,t_VEC),cgetg(1,t_VEC)); }
2309 105 : av = avma; v = idealprincipalunits_i(nf, pr, k, NULL);
2310 105 : return gerepilecopy(av, mkvec3(powiu(pr_norm(pr), k-1), gel(v,1), gel(v,2)));
2311 : }
2312 :
2313 : /* true nf; given an ideal pr^k dividing an integral ideal x (in HNF form)
2314 : * compute an 'sprk', the structure of G = (Z_K/pr^k)^* [ x = NULL for x=pr^k ]
2315 : * Return a vector with at least 4 components [cyc],[gen],[HNF pr^k,pr,k],ff,
2316 : * where
2317 : * cyc : type of G as abelian group (SNF)
2318 : * gen : generators of G, coprime to x
2319 : * pr^k: in HNF
2320 : * ff : data for log_g in (Z_K/pr)^*
2321 : * Two extra components are present iff k > 1: L2, U
2322 : * L2 : list of data structures to compute local DL in (Z_K/pr)^*,
2323 : * and 1 + pr^a/ 1 + pr^b for various a < b <= min(2a, k)
2324 : * U : base change matrices to convert a vector of local DL to DL wrt gen */
2325 : static GEN
2326 31815 : sprkinit(GEN nf, GEN pr, GEN gk, GEN x)
2327 : {
2328 : GEN T, p, modpr, cyc, gen, g, g0, ord0, A, prk, U, L2;
2329 31815 : long k = itos(gk), f = pr_get_f(pr);
2330 :
2331 31815 : if(DEBUGLEVEL>3) err_printf("treating pr^%ld, pr = %Ps\n",k,pr);
2332 31815 : modpr = nf_to_Fq_init(nf, &pr,&T,&p);
2333 : /* (Z_K / pr)^* */
2334 31815 : if (f == 1)
2335 : {
2336 22827 : g0 = g = pgener_Fp(p);
2337 22827 : ord0 = get_arith_ZZM(subiu(p,1));
2338 : }
2339 : else
2340 : {
2341 8988 : g0 = g = gener_FpXQ(T,p, &ord0);
2342 8988 : g = Fq_to_nf(g, modpr);
2343 8988 : if (typ(g) == t_POL) g = poltobasis(nf, g);
2344 : }
2345 31815 : A = gel(ord0, 1); /* Norm(pr)-1 */
2346 31815 : if (k == 1)
2347 : {
2348 17766 : cyc = mkvec(A);
2349 17766 : gen = mkvec(g);
2350 17766 : prk = pr_hnf(nf,pr);
2351 17766 : L2 = U = NULL;
2352 : }
2353 : else
2354 : { /* local-gens of (1 + pr)/(1 + pr^k) = SNF-gens * U */
2355 : GEN AB, B, u, v, w;
2356 : long j, l;
2357 14049 : w = idealprincipalunits_i(nf, pr, k, &U);
2358 : /* incorporate (Z_K/pr)^*, order A coprime to B = expo(1+pr/1+pr^k)*/
2359 14049 : cyc = leafcopy(gel(w,1)); B = gel(cyc,1); AB = mulii(A,B);
2360 14049 : gen = leafcopy(gel(w,2));
2361 14049 : prk = gel(w,3);
2362 14049 : g = nfpowmodideal(nf, g, B, prk);
2363 14049 : g0 = Fq_pow(g0, modii(B,A), T, p); /* update primitive root */
2364 14049 : L2 = mkvec3(A, g, gel(w,4));
2365 14049 : gel(cyc,1) = AB;
2366 14049 : gel(gen,1) = nfmulmodideal(nf, gel(gen,1), g, prk);
2367 14049 : u = mulii(Fp_inv(A,B), A);
2368 14049 : v = subui(1, u); l = lg(U);
2369 14049 : for (j = 1; j < l; j++) gcoeff(U,1,j) = Fp_mul(u, gcoeff(U,1,j), AB);
2370 14049 : U = mkvec2(Rg_col_ei(v, lg(gen)-1, 1), U);
2371 : }
2372 : /* local-gens of (Z_K/pr^k)^* = SNF-gens * U */
2373 31815 : if (x)
2374 : {
2375 12922 : GEN uv = zkchineseinit(nf, idealdivpowprime(nf,x,pr,gk), prk, x);
2376 12922 : gen = zkVchinese1(uv, gen);
2377 : }
2378 31815 : return mkvecn(U? 6: 4, cyc, gen, prk, mkvec3(modpr,g0,ord0), L2, U);
2379 : }
2380 : static GEN
2381 346677 : sprk_get_cyc(GEN s) { return gel(s,1); }
2382 : static GEN
2383 110275 : sprk_get_expo(GEN s)
2384 : {
2385 110275 : GEN cyc = sprk_get_cyc(s);
2386 110275 : return lg(cyc) == 1? gen_1: gel(cyc, 1);
2387 : }
2388 : static GEN
2389 25683 : sprk_get_gen(GEN s) { return gel(s,2); }
2390 : static GEN
2391 296095 : sprk_get_prk(GEN s) { return gel(s,3); }
2392 : static GEN
2393 386974 : sprk_get_ff(GEN s) { return gel(s,4); }
2394 : static GEN
2395 129224 : sprk_get_pr(GEN s) { GEN ff = gel(s,4); return modpr_get_pr(gel(ff,1)); }
2396 : /* A = Npr-1, <g> = (Z_K/pr)^*, L2 to 1 + pr / 1 + pr^k */
2397 : static void
2398 196677 : sprk_get_L2(GEN s, GEN *A, GEN *g, GEN *L2)
2399 196677 : { GEN v = gel(s,5); *A = gel(v,1); *g = gel(v,2); *L2 = gel(v,3); }
2400 : static void
2401 185820 : sprk_get_U2(GEN s, GEN *U1, GEN *U2)
2402 185820 : { GEN v = gel(s,6); *U1 = gel(v,1); *U2 = gel(v,2); }
2403 : static int
2404 386974 : sprk_is_prime(GEN s) { return lg(s) == 5; }
2405 :
2406 : static GEN
2407 110275 : famat_zlog_pr(GEN nf, GEN g, GEN e, GEN sprk)
2408 : {
2409 110275 : GEN pr = sprk_get_pr(sprk);
2410 110275 : GEN prk = sprk_get_prk(sprk);
2411 110275 : GEN x = famat_makecoprime(nf, g, e, pr, prk, sprk_get_expo(sprk));
2412 110275 : return zlog_pr(nf, x, sprk);
2413 : }
2414 : /* log_g(a) in (Z_K/pr)^* */
2415 : static GEN
2416 386974 : nf_log(GEN nf, GEN a, GEN ff)
2417 : {
2418 386974 : GEN pr = gel(ff,1), g = gel(ff,2), ord = gel(ff,3);
2419 386974 : GEN T,p, modpr = nf_to_Fq_init(nf, &pr, &T, &p);
2420 386974 : return Fq_log(nf_to_Fq(nf,a,modpr), g, ord, T, p);
2421 : }
2422 : /* a in Z_K (t_COL or t_INT), pr prime ideal, sprk = sprkinit(nf,pr,k,x).
2423 : * return log(a) on SNF-generators of (Z_K/pr^k)^**/
2424 : GEN
2425 388010 : zlog_pr(GEN nf, GEN a, GEN sprk)
2426 : {
2427 : GEN e, prk, A, g, L2, U1, U2, y;
2428 :
2429 388010 : if (typ(a) == t_MAT) return famat_zlog_pr(nf, gel(a,1), gel(a,2), sprk);
2430 :
2431 386974 : e = nf_log(nf, a, sprk_get_ff(sprk));
2432 386974 : if (sprk_is_prime(sprk)) return mkcol(e); /* k = 1 */
2433 185820 : prk = sprk_get_prk(sprk);
2434 185820 : sprk_get_L2(sprk, &A,&g,&L2);
2435 185820 : if (signe(e))
2436 : {
2437 45957 : e = Fp_neg(e, A);
2438 45957 : a = nfmulpowmodideal(nf, a, g, e, prk);
2439 : }
2440 185820 : sprk_get_U2(sprk, &U1,&U2);
2441 185820 : y = ZM_ZC_mul(U2, log_prk1(nf, a, lg(U2)-1, L2, prk));
2442 185813 : if (signe(e)) y = ZC_sub(y, ZC_Z_mul(U1,e));
2443 185813 : return vecmodii(y, sprk_get_cyc(sprk));
2444 : }
2445 : GEN
2446 6132 : zlog_pr_init(GEN nf, GEN pr, long k)
2447 6132 : { return sprkinit(checknf(nf),pr,utoipos(k),NULL);}
2448 : GEN
2449 378 : vzlog_pr(GEN nf, GEN v, GEN sprk)
2450 : {
2451 378 : long l = lg(v), i;
2452 378 : GEN w = cgetg(l, t_MAT);
2453 378 : for (i = 1; i < l; i++) gel(w,i) = zlog_pr(nf, gel(v,i), sprk);
2454 378 : return w;
2455 : }
2456 :
2457 : static GEN
2458 113215 : famat_zlog(GEN nf, GEN fa, GEN sgn, zlog_S *S)
2459 : {
2460 113215 : long i, n0, n = lg(S->U)-1;
2461 : GEN g, e, y;
2462 113215 : if (lg(fa) == 1) return zerocol(n);
2463 113215 : g = gel(fa,1);
2464 113215 : e = gel(fa,2);
2465 113215 : y = cgetg(n+1, t_COL);
2466 113215 : n0 = lg(S->sprk)-1; /* n0 = n (trivial arch. part), or n-1 */
2467 113215 : for (i=1; i <= n0; i++) gel(y,i) = famat_zlog_pr(nf, g, e, gel(S->sprk,i));
2468 113215 : if (n0 != n)
2469 : {
2470 93174 : if (!sgn) sgn = nfsign_arch(nf, fa, S->archp);
2471 93174 : gel(y,n) = Flc_to_ZC(sgn);
2472 : }
2473 113215 : return y;
2474 : }
2475 :
2476 : /* assume that cyclic factors are normalized, in particular != [1] */
2477 : static GEN
2478 26089 : split_U(GEN U, GEN Sprk)
2479 : {
2480 26089 : long t = 0, k, n, l = lg(Sprk);
2481 26089 : GEN vU = cgetg(l+1, t_VEC);
2482 50995 : for (k = 1; k < l; k++)
2483 : {
2484 24906 : n = lg(sprk_get_cyc(gel(Sprk,k))) - 1; /* > 0 */
2485 24906 : gel(vU,k) = vecslice(U, t+1, t+n);
2486 24906 : t += n;
2487 : }
2488 : /* t+1 .. lg(U)-1 */
2489 26089 : n = lg(U) - t - 1; /* can be 0 */
2490 26089 : if (!n) setlg(vU,l); else gel(vU,l) = vecslice(U, t+1, t+n);
2491 26089 : return vU;
2492 : }
2493 :
2494 : void
2495 353261 : init_zlog(zlog_S *S, GEN bid)
2496 : {
2497 353261 : GEN fa2 = bid_get_fact2(bid);
2498 353261 : S->U = bid_get_U(bid);
2499 353261 : S->hU = lg(bid_get_cyc(bid))-1;
2500 353261 : S->archp = bid_get_archp(bid);
2501 353261 : S->sprk = bid_get_sprk(bid);
2502 353261 : S->bid = bid;
2503 353261 : S->P = gel(fa2,1);
2504 353261 : S->k = gel(fa2,2);
2505 353261 : S->no2 = lg(S->P) == lg(gel(bid_get_fact(bid),1));
2506 353261 : }
2507 :
2508 : /* a a t_FRAC/t_INT, reduce mod bid */
2509 : static GEN
2510 7 : Q_mod_bid(GEN bid, GEN a)
2511 : {
2512 7 : GEN xZ = gcoeff(bid_get_ideal(bid),1,1);
2513 7 : GEN b = Rg_to_Fp(a, xZ);
2514 7 : if (gsigne(a) < 0) b = subii(b, xZ);
2515 7 : return b;
2516 : }
2517 : /* Return decomposition of a on the CRT generators blocks attached to the
2518 : * S->sprk and sarch; sgn = sign(a, S->arch), NULL if unknown */
2519 : static GEN
2520 246140 : zlog(GEN nf, GEN a, GEN sgn, zlog_S *S)
2521 : {
2522 : long k, l;
2523 : GEN y;
2524 246140 : a = nf_to_scalar_or_basis(nf, a);
2525 246140 : switch(typ(a))
2526 : {
2527 64148 : case t_INT: break;
2528 7 : case t_FRAC: a = Q_mod_bid(S->bid, a); break;
2529 : default: /* case t_COL: */
2530 : {
2531 : GEN den;
2532 181985 : check_nfelt(a, &den);
2533 181985 : if (den)
2534 : {
2535 46407 : a = Q_muli_to_int(a, den);
2536 46407 : a = mkmat2(mkcol2(a, den), mkcol2(gen_1, gen_m1));
2537 46407 : return famat_zlog(nf, a, sgn, S);
2538 : }
2539 : }
2540 : }
2541 199733 : if (sgn)
2542 34608 : sgn = (lg(sgn) == 1)? NULL: leafcopy(sgn);
2543 : else
2544 165125 : sgn = (lg(S->archp) == 1)? NULL: nfsign_arch(nf, a, S->archp);
2545 199733 : l = lg(S->sprk);
2546 199733 : y = cgetg(sgn? l+1: l, t_COL);
2547 441754 : for (k = 1; k < l; k++)
2548 : {
2549 242028 : GEN sprk = gel(S->sprk,k);
2550 242028 : gel(y,k) = zlog_pr(nf, a, sprk);
2551 : }
2552 199726 : if (sgn) gel(y,l) = Flc_to_ZC(sgn);
2553 199726 : return y;
2554 : }
2555 :
2556 : /* true nf */
2557 : GEN
2558 8344 : pr_basis_perm(GEN nf, GEN pr)
2559 : {
2560 8344 : long f = pr_get_f(pr);
2561 : GEN perm;
2562 8344 : if (f == nf_get_degree(nf)) return identity_perm(f);
2563 6916 : perm = cgetg(f+1, t_VECSMALL);
2564 6916 : perm[1] = 1;
2565 6916 : if (f > 1)
2566 : {
2567 399 : GEN H = pr_hnf(nf,pr);
2568 : long i, k;
2569 1463 : for (i = k = 2; k <= f; i++)
2570 1064 : if (!equali1(gcoeff(H,i,i))) perm[k++] = i;
2571 : }
2572 6916 : return perm;
2573 : }
2574 :
2575 : /* \sum U[i]*y[i], U[i] ZM, y[i] ZC. We allow lg(y) > lg(U). */
2576 : static GEN
2577 312941 : ZMV_ZCV_mul(GEN U, GEN y)
2578 : {
2579 312941 : long i, l = lg(U);
2580 312941 : GEN z = NULL;
2581 312941 : if (l == 1) return cgetg(1,t_COL);
2582 862111 : for (i = 1; i < l; i++)
2583 : {
2584 549170 : GEN u = ZM_ZC_mul(gel(U,i), gel(y,i));
2585 549170 : z = z? ZC_add(z, u): u;
2586 : }
2587 312941 : return z;
2588 : }
2589 : /* A * (U[1], ..., U[d] */
2590 : static GEN
2591 518 : ZM_ZMV_mul(GEN A, GEN U)
2592 : {
2593 : long i, l;
2594 518 : GEN V = cgetg_copy(U,&l);
2595 518 : for (i = 1; i < l; i++) gel(V,i) = ZM_mul(A,gel(U,i));
2596 518 : return V;
2597 : }
2598 :
2599 : /* Log on bid.gen of generators of P_{1,I pr^{e-1}} / P_{1,I pr^e} (I,pr) = 1,
2600 : * defined implicitly via CRT. 'ind' is the index of pr in modulus
2601 : * factorization */
2602 : GEN
2603 50771 : log_gen_pr(zlog_S *S, long ind, GEN nf, long e)
2604 : {
2605 50771 : GEN A, sprk = gel(S->sprk,ind), Uind = gel(S->U, ind);
2606 :
2607 50771 : if (e == 1) retmkmat( gel(Uind,1) );
2608 : else
2609 : {
2610 18949 : GEN G, pr = sprk_get_pr(sprk);
2611 : long i, l;
2612 18949 : if (e == 2)
2613 : {
2614 10857 : GEN A, g, L, L2; sprk_get_L2(sprk,&A,&g,&L2); L = gel(L2,1);
2615 10857 : G = gel(L,2); l = lg(G);
2616 : }
2617 : else
2618 : {
2619 8092 : GEN perm = pr_basis_perm(nf,pr), PI = nfpow_u(nf, pr_get_gen(pr), e-1);
2620 8092 : l = lg(perm);
2621 8092 : G = cgetg(l, t_VEC);
2622 8092 : if (typ(PI) == t_INT)
2623 : { /* zk_ei_mul doesn't allow t_INT */
2624 1421 : long N = nf_get_degree(nf);
2625 1421 : gel(G,1) = addiu(PI,1);
2626 2289 : for (i = 2; i < l; i++)
2627 : {
2628 868 : GEN z = col_ei(N, 1);
2629 868 : gel(G,i) = z; gel(z, perm[i]) = PI;
2630 : }
2631 : }
2632 : else
2633 : {
2634 6671 : gel(G,1) = nfadd(nf, gen_1, PI);
2635 6881 : for (i = 2; i < l; i++)
2636 210 : gel(G,i) = nfadd(nf, gen_1, zk_ei_mul(nf, PI, perm[i]));
2637 : }
2638 : }
2639 18949 : A = cgetg(l, t_MAT);
2640 40649 : for (i = 1; i < l; i++)
2641 21700 : gel(A,i) = ZM_ZC_mul(Uind, zlog_pr(nf, gel(G,i), sprk));
2642 18949 : return A;
2643 : }
2644 : }
2645 : /* Log on bid.gen of generator of P_{1,f} / P_{1,f v[index]}
2646 : * v = vector of r1 real places */
2647 : GEN
2648 10003 : log_gen_arch(zlog_S *S, long index)
2649 : {
2650 10003 : GEN U = gel(S->U, lg(S->U)-1);
2651 10003 : return gel(U, index);
2652 : }
2653 :
2654 : /* compute bid.clgp: [h,cyc] or [h,cyc,gen] */
2655 : static GEN
2656 27153 : bid_grp(GEN nf, GEN U, GEN cyc, GEN g, GEN F, GEN sarch)
2657 : {
2658 27153 : GEN G, h = ZV_prod(cyc);
2659 : long c;
2660 27153 : if (!U) return mkvec2(h,cyc);
2661 26901 : c = lg(U);
2662 26901 : G = cgetg(c,t_VEC);
2663 26901 : if (c > 1)
2664 : {
2665 22505 : GEN U0, Uoo, EX = gel(cyc,1); /* exponent of bid */
2666 22505 : long i, hU = nbrows(U), nba = lg(sarch_get_cyc(sarch))-1; /* #f_oo */
2667 22505 : if (!nba) { U0 = U; Uoo = NULL; }
2668 11760 : else if (nba == hU) { U0 = NULL; Uoo = U; }
2669 : else
2670 : {
2671 9527 : U0 = rowslice(U, 1, hU-nba);
2672 9527 : Uoo = rowslice(U, hU-nba+1, hU);
2673 : }
2674 64526 : for (i = 1; i < c; i++)
2675 : {
2676 42021 : GEN t = gen_1;
2677 42021 : if (U0) t = famat_to_nf_modideal_coprime(nf, g, gel(U0,i), F, EX);
2678 42021 : if (Uoo) t = set_sign_mod_divisor(nf, ZV_to_Flv(gel(Uoo,i),2), t, sarch);
2679 42021 : gel(G,i) = t;
2680 : }
2681 : }
2682 26901 : return mkvec3(h, cyc, G);
2683 : }
2684 :
2685 : /* remove prime ideals of norm 2 with exponent 1 from factorization */
2686 : static GEN
2687 26838 : famat_strip2(GEN fa)
2688 : {
2689 26838 : GEN P = gel(fa,1), E = gel(fa,2), Q, F;
2690 26838 : long l = lg(P), i, j;
2691 26838 : Q = cgetg(l, t_COL);
2692 26838 : F = cgetg(l, t_COL);
2693 56560 : for (i = j = 1; i < l; i++)
2694 : {
2695 29722 : GEN pr = gel(P,i), e = gel(E,i);
2696 29722 : if (!absequaliu(pr_get_p(pr), 2) || itou(e) != 1 || pr_get_f(pr) != 1)
2697 : {
2698 25683 : gel(Q,j) = pr;
2699 25683 : gel(F,j) = e; j++;
2700 : }
2701 : }
2702 26838 : setlg(Q,j);
2703 26838 : setlg(F,j); return mkmat2(Q,F);
2704 : }
2705 :
2706 : /* Compute [[ideal,arch], [h,[cyc],[gen]], idealfact, [liste], U]
2707 : flag may include nf_GEN | nf_INIT */
2708 : static GEN
2709 26859 : Idealstar_i(GEN nf, GEN ideal, long flag)
2710 : {
2711 : long i, k, nbp, R1;
2712 26859 : GEN y, cyc, U, u1 = NULL, fa, fa2, sprk, x, arch, archp, E, P, sarch, gen;
2713 :
2714 26859 : nf = checknf(nf);
2715 26859 : R1 = nf_get_r1(nf);
2716 26859 : if (typ(ideal) == t_VEC && lg(ideal) == 3)
2717 : {
2718 12929 : arch = gel(ideal,2);
2719 12929 : ideal= gel(ideal,1);
2720 12929 : switch(typ(arch))
2721 : {
2722 : case t_VEC:
2723 12530 : if (lg(arch) != R1+1)
2724 0 : pari_err_TYPE("Idealstar [incorrect archimedean component]",arch);
2725 12530 : archp = vec01_to_indices(arch);
2726 12530 : break;
2727 : case t_VECSMALL:
2728 399 : archp = arch;
2729 399 : k = lg(archp)-1;
2730 399 : if (k && archp[k] > R1)
2731 7 : pari_err_TYPE("Idealstar [incorrect archimedean component]",arch);
2732 392 : arch = indices_to_vec01(archp, R1);
2733 392 : break;
2734 : default:
2735 0 : pari_err_TYPE("Idealstar [incorrect archimedean component]",arch);
2736 0 : return NULL;
2737 : }
2738 12922 : }
2739 : else
2740 : {
2741 13930 : arch = zerovec(R1);
2742 13930 : archp = cgetg(1, t_VECSMALL);
2743 : }
2744 26852 : if (is_nf_factor(ideal))
2745 : {
2746 721 : fa = ideal;
2747 721 : x = idealfactorback(nf, gel(fa,1), gel(fa,2), 0);
2748 : }
2749 : else
2750 : {
2751 26131 : fa = idealfactor(nf, ideal);
2752 26124 : x = ideal;
2753 : }
2754 26845 : if (typ(x) != t_MAT) x = idealhnf_shallow(nf, x);
2755 26845 : if (lg(x) == 1) pari_err_DOMAIN("Idealstar", "ideal","=",gen_0,x);
2756 26845 : if (typ(gcoeff(x,1,1)) != t_INT)
2757 7 : pari_err_DOMAIN("Idealstar","denominator(ideal)", "!=",gen_1,x);
2758 26838 : sarch = nfarchstar(nf, x, archp);
2759 26838 : fa2 = famat_strip2(fa);
2760 26838 : P = gel(fa2,1);
2761 26838 : E = gel(fa2,2);
2762 26838 : nbp = lg(P)-1;
2763 26838 : sprk = cgetg(nbp+1,t_VEC);
2764 26838 : if (nbp)
2765 : {
2766 20188 : GEN t = (lg(gel(fa,1))==2)? NULL: x; /* beware fa != fa2 */
2767 20188 : cyc = cgetg(nbp+2,t_VEC);
2768 20188 : gen = cgetg(nbp+1,t_VEC);
2769 45871 : for (i = 1; i <= nbp; i++)
2770 : {
2771 25683 : GEN L = sprkinit(nf, gel(P,i), gel(E,i), t);
2772 25683 : gel(sprk,i) = L;
2773 25683 : gel(cyc,i) = sprk_get_cyc(L);
2774 : /* true gens are congruent to those mod x AND positive at archp */
2775 25683 : gel(gen,i) = sprk_get_gen(L);
2776 : }
2777 20188 : gel(cyc,i) = sarch_get_cyc(sarch);
2778 20188 : cyc = shallowconcat1(cyc);
2779 20188 : gen = shallowconcat1(gen);
2780 20188 : cyc = ZV_snf_group(cyc, &U, (flag & nf_GEN)? &u1: NULL);
2781 : }
2782 : else
2783 : {
2784 6650 : cyc = sarch_get_cyc(sarch);
2785 6650 : gen = cgetg(1,t_VEC);
2786 6650 : U = matid(lg(cyc)-1);
2787 6650 : if (flag & nf_GEN) u1 = U;
2788 : }
2789 26838 : y = bid_grp(nf, u1, cyc, gen, x, sarch);
2790 26838 : if (!(flag & nf_INIT)) return y;
2791 26033 : U = split_U(U, sprk);
2792 26033 : return mkvec5(mkvec2(x, arch), y, mkvec2(fa,fa2), mkvec2(sprk, sarch), U);
2793 : }
2794 : GEN
2795 26586 : Idealstar(GEN nf, GEN ideal, long flag)
2796 : {
2797 26586 : pari_sp av = avma;
2798 26586 : if (!nf) nf = nfinit(pol_x(0), DEFAULTPREC);
2799 26586 : return gerepilecopy(av, Idealstar_i(nf, ideal, flag));
2800 : }
2801 : GEN
2802 273 : Idealstarprk(GEN nf, GEN pr, long k, long flag)
2803 : {
2804 273 : pari_sp av = avma;
2805 273 : GEN z = Idealstar_i(nf, mkmat2(mkcol(pr),mkcols(k)), flag);
2806 273 : return gerepilecopy(av, z);
2807 : }
2808 :
2809 : /* FIXME: obsolete */
2810 : GEN
2811 0 : zidealstarinitgen(GEN nf, GEN ideal)
2812 0 : { return Idealstar(nf,ideal, nf_INIT|nf_GEN); }
2813 : GEN
2814 0 : zidealstarinit(GEN nf, GEN ideal)
2815 0 : { return Idealstar(nf,ideal, nf_INIT); }
2816 : GEN
2817 0 : zidealstar(GEN nf, GEN ideal)
2818 0 : { return Idealstar(nf,ideal, nf_GEN); }
2819 :
2820 : GEN
2821 63 : idealstar0(GEN nf, GEN ideal,long flag)
2822 : {
2823 63 : switch(flag)
2824 : {
2825 0 : case 0: return Idealstar(nf,ideal, nf_GEN);
2826 49 : case 1: return Idealstar(nf,ideal, nf_INIT);
2827 14 : case 2: return Idealstar(nf,ideal, nf_INIT|nf_GEN);
2828 0 : default: pari_err_FLAG("idealstar");
2829 : }
2830 : return NULL; /* LCOV_EXCL_LINE */
2831 : }
2832 :
2833 : void
2834 181985 : check_nfelt(GEN x, GEN *den)
2835 : {
2836 181985 : long l = lg(x), i;
2837 181985 : GEN t, d = NULL;
2838 181985 : if (typ(x) != t_COL) pari_err_TYPE("check_nfelt", x);
2839 663618 : for (i=1; i<l; i++)
2840 : {
2841 481633 : t = gel(x,i);
2842 481633 : switch (typ(t))
2843 : {
2844 386539 : case t_INT: break;
2845 : case t_FRAC:
2846 95094 : if (!d) d = gel(t,2); else d = lcmii(d, gel(t,2));
2847 95094 : break;
2848 0 : default: pari_err_TYPE("check_nfelt", x);
2849 : }
2850 : }
2851 181985 : *den = d;
2852 181985 : }
2853 :
2854 : GEN
2855 1207041 : vecmodii(GEN x, GEN y)
2856 1207041 : { pari_APPLY_same(modii(gel(x,i), gel(y,i))) }
2857 :
2858 : GEN
2859 95004 : vecmoduu(GEN x, GEN y)
2860 95004 : { pari_APPLY_ulong(uel(x,i) % uel(y,i)) }
2861 :
2862 : static GEN
2863 314460 : ideallog_i(GEN nf, GEN x, GEN sgn, zlog_S *S)
2864 : {
2865 314460 : pari_sp av = avma;
2866 : GEN y, cyc;
2867 314460 : if (!S->hU) return cgetg(1, t_COL);
2868 312948 : cyc = bid_get_cyc(S->bid);
2869 312948 : if (typ(x) == t_MAT)
2870 : {
2871 66808 : if (lg(x) == 1) return zerocol(lg(cyc)-1);
2872 66808 : y = famat_zlog(nf, x, sgn, S);
2873 : }
2874 : else
2875 246140 : y = zlog(nf, x, sgn, S);
2876 312941 : y = ZMV_ZCV_mul(S->U, y);
2877 312941 : return gerepileupto(av, vecmodii(y, cyc));
2878 : }
2879 :
2880 : /* Given x (not necessarily integral), and bid as output by zidealstarinit,
2881 : * compute the vector of components on the generators bid[2].
2882 : * Assume (x,bid) = 1 and sgn is either NULL or nfsign_arch(x, bid) */
2883 : GEN
2884 301293 : ideallog_sgn(GEN nf, GEN x, GEN sgn, GEN bid)
2885 : {
2886 : zlog_S S;
2887 301293 : nf = checknf(nf); checkbid(bid);
2888 301286 : init_zlog(&S, bid);
2889 301286 : if (sgn && typ(x) == t_VEC) /* vector of elements and signatures */
2890 : {
2891 21434 : long i, l = lg(x);
2892 21434 : GEN y = cgetg(l, t_MAT);
2893 21434 : for (i = 1; i < l; i++) gel(y,i) = ideallog_i(nf, gel(x,i), gel(sgn,i), &S);
2894 21434 : return y;
2895 : }
2896 279852 : return ideallog_i(nf, x, sgn, &S);
2897 : }
2898 : GEN
2899 286530 : ideallog(GEN nf, GEN x, GEN bid)
2900 : {
2901 286530 : if (!nf) return Zideallog(bid, x);
2902 279859 : return ideallog_sgn(nf, x, NULL, bid);
2903 : }
2904 :
2905 : /*************************************************************************/
2906 : /** **/
2907 : /** JOIN BID STRUCTURES, IDEAL LISTS **/
2908 : /** **/
2909 : /*************************************************************************/
2910 : /* bid1, bid2: for coprime modules m1 and m2 (without arch. part).
2911 : * Output: bid for m1 m2 */
2912 : static GEN
2913 476 : join_bid(GEN nf, GEN bid1, GEN bid2)
2914 : {
2915 476 : pari_sp av = avma;
2916 : long nbgen, l1,l2;
2917 : GEN I1,I2, G1,G2, sprk1,sprk2, cyc1,cyc2, sarch;
2918 476 : GEN sprk, fa,fa2, U, cyc, y, u1 = NULL, x, gen;
2919 :
2920 476 : I1 = bid_get_ideal(bid1);
2921 476 : I2 = bid_get_ideal(bid2);
2922 476 : if (gequal1(gcoeff(I1,1,1))) return bid2; /* frequent trivial case */
2923 259 : G1 = bid_get_grp(bid1);
2924 259 : G2 = bid_get_grp(bid2);
2925 259 : x = idealmul(nf, I1,I2);
2926 259 : fa = famat_mul_shallow(bid_get_fact(bid1), bid_get_fact(bid2));
2927 259 : fa2= famat_mul_shallow(bid_get_fact2(bid1), bid_get_fact2(bid2));
2928 259 : sprk1 = bid_get_sprk(bid1);
2929 259 : sprk2 = bid_get_sprk(bid2);
2930 259 : sprk = shallowconcat(sprk1, sprk2);
2931 :
2932 259 : cyc1 = abgrp_get_cyc(G1); l1 = lg(cyc1);
2933 259 : cyc2 = abgrp_get_cyc(G2); l2 = lg(cyc2);
2934 259 : gen = (lg(G1)>3 && lg(G2)>3)? gen_1: NULL;
2935 259 : nbgen = l1+l2-2;
2936 259 : cyc = ZV_snf_group(shallowconcat(cyc1,cyc2), &U, gen? &u1: NULL);
2937 259 : if (nbgen)
2938 : {
2939 259 : GEN U1 = bid_get_U(bid1), U2 = bid_get_U(bid2);
2940 259 : U1 = l1==1? const_vec(lg(sprk1), cgetg(1,t_MAT))
2941 259 : : ZM_ZMV_mul(vecslice(U, 1, l1-1), U1);
2942 259 : U2 = l2==1? const_vec(lg(sprk2), cgetg(1,t_MAT))
2943 259 : : ZM_ZMV_mul(vecslice(U, l1, nbgen), U2);
2944 259 : U = shallowconcat(U1, U2);
2945 : }
2946 : else
2947 0 : U = const_vec(lg(sprk), cgetg(1,t_MAT));
2948 :
2949 259 : if (gen)
2950 : {
2951 259 : GEN uv = zkchinese1init2(nf, I2, I1, x);
2952 518 : gen = shallowconcat(zkVchinese1(gel(uv,1), abgrp_get_gen(G1)),
2953 259 : zkVchinese1(gel(uv,2), abgrp_get_gen(G2)));
2954 : }
2955 259 : sarch = bid_get_sarch(bid1); /* trivial */
2956 259 : y = bid_grp(nf, u1, cyc, gen, x, sarch);
2957 259 : x = mkvec2(x, bid_get_arch(bid1));
2958 259 : y = mkvec5(x, y, mkvec2(fa, fa2), mkvec2(sprk, sarch), U);
2959 259 : return gerepilecopy(av,y);
2960 : }
2961 :
2962 : typedef struct _ideal_data {
2963 : GEN nf, emb, L, pr, prL, sgnU, archp;
2964 : } ideal_data;
2965 :
2966 : /* z <- ( z | f(v[i])_{i=1..#v} ) */
2967 : static void
2968 86065 : concat_join(GEN *pz, GEN v, GEN (*f)(ideal_data*,GEN), ideal_data *data)
2969 : {
2970 86065 : long i, nz, lv = lg(v);
2971 : GEN z, Z;
2972 86065 : if (lv == 1) return;
2973 38143 : z = *pz; nz = lg(z)-1;
2974 38143 : *pz = Z = cgetg(lv + nz, typ(z));
2975 38143 : for (i = 1; i <=nz; i++) gel(Z,i) = gel(z,i);
2976 38143 : Z += nz;
2977 38143 : for (i = 1; i < lv; i++) gel(Z,i) = f(data, gel(v,i));
2978 : }
2979 : static GEN
2980 476 : join_idealinit(ideal_data *D, GEN x)
2981 476 : { return join_bid(D->nf, x, D->prL); }
2982 : static GEN
2983 47698 : join_ideal(ideal_data *D, GEN x)
2984 47698 : { return idealmulpowprime(D->nf, x, D->pr, D->L); }
2985 : static GEN
2986 455 : join_unit(ideal_data *D, GEN x)
2987 : {
2988 455 : GEN bid = join_idealinit(D, gel(x,1)), u = gel(x,2), v = mkvec(D->emb);
2989 455 : if (lg(u) != 1) v = shallowconcat(u, v);
2990 455 : return mkvec2(bid, v);
2991 : }
2992 :
2993 : /* flag & nf_GEN : generators, otherwise no
2994 : * flag &2 : units, otherwise no
2995 : * flag &4 : ideals in HNF, otherwise bid
2996 : * flag &8 : omit ideals which cannot be conductors (pr^1 with Npr=2) */
2997 : static GEN
2998 3192 : Ideallist(GEN bnf, ulong bound, long flag)
2999 : {
3000 3192 : const long cond = flag & 8;
3001 3192 : const long do_units = flag & 2, big_id = !(flag & 4);
3002 3192 : const long istar_flag = (flag & nf_GEN) | nf_INIT;
3003 3192 : pari_sp av, av0 = avma;
3004 : long i, j;
3005 3192 : GEN nf, z, p, fa, id, BOUND, U, empty = cgetg(1,t_VEC);
3006 : forprime_t S;
3007 : ideal_data ID;
3008 3192 : GEN (*join_z)(ideal_data*, GEN) =
3009 : do_units? &join_unit
3010 3192 : : (big_id? &join_idealinit: &join_ideal);
3011 :
3012 3192 : nf = checknf(bnf);
3013 3192 : if ((long)bound <= 0) return empty;
3014 3192 : id = matid(nf_get_degree(nf));
3015 3192 : if (big_id) id = Idealstar(nf,id, istar_flag);
3016 :
3017 : /* z[i] will contain all "objects" of norm i. Depending on flag, this means
3018 : * an ideal, a bid, or a couple [bid, log(units)]. Such objects are stored
3019 : * in vectors, computed one primary component at a time; join_z
3020 : * reconstructs the global object */
3021 3192 : BOUND = utoipos(bound);
3022 3192 : z = cgetg(bound+1,t_VEC);
3023 3192 : if (do_units) {
3024 14 : U = bnf_build_units(bnf);
3025 14 : gel(z,1) = mkvec( mkvec2(id, cgetg(1,t_VEC)) );
3026 : } else {
3027 3178 : U = NULL; /* -Wall */
3028 3178 : gel(z,1) = mkvec(id);
3029 : }
3030 3192 : for (i=2; i<=(long)bound; i++) gel(z,i) = empty;
3031 3192 : ID.nf = nf;
3032 :
3033 3192 : p = cgetipos(3);
3034 3192 : u_forprime_init(&S, 2, bound);
3035 3192 : av = avma;
3036 19600 : while ((p[2] = u_forprime_next(&S)))
3037 : {
3038 13216 : if (DEBUGLEVEL>1) { err_printf("%ld ",p[2]); err_flush(); }
3039 13216 : fa = idealprimedec_limit_norm(nf, p, BOUND);
3040 26859 : for (j=1; j<lg(fa); j++)
3041 : {
3042 13643 : GEN pr = gel(fa,j), z2 = leafcopy(z);
3043 13643 : ulong Q, q = upr_norm(pr);
3044 13643 : long l = (cond && q == 2)? 2: 1;
3045 :
3046 13643 : ID.pr = ID.prL = pr;
3047 33775 : for (Q = q; Q <= bound; l++, Q *= q) /* add pr^l */
3048 : {
3049 : ulong iQ;
3050 20132 : ID.L = utoipos(l);
3051 20132 : if (big_id) {
3052 217 : ID.prL = Idealstarprk(nf, pr, l, istar_flag);
3053 217 : if (do_units)
3054 : {
3055 196 : GEN sprk = bid_get_sprk(ID.prL);
3056 392 : ID.emb = lg(sprk) == 1? cgetg(1,t_VEC)
3057 196 : : vzlog_pr(nf, U, gel(sprk,1));
3058 : }
3059 : }
3060 106197 : for (iQ = Q,i = 1; iQ <= bound; iQ += Q,i++)
3061 86065 : concat_join(&gel(z,iQ), gel(z2,i), join_z, &ID);
3062 : }
3063 : }
3064 13216 : if (gc_needed(av,1))
3065 : {
3066 0 : if(DEBUGMEM>1) pari_warn(warnmem,"Ideallist");
3067 0 : z = gerepilecopy(av, z);
3068 : }
3069 : }
3070 3192 : return gerepilecopy(av0, z);
3071 : }
3072 : GEN
3073 350 : ideallist0(GEN bnf,long bound, long flag) {
3074 350 : if (flag<0 || flag>15) pari_err_FLAG("ideallist");
3075 350 : return Ideallist(bnf,bound,flag);
3076 : }
3077 : GEN
3078 2842 : ideallist(GEN bnf,long bound) { return Ideallist(bnf,bound,4); }
3079 :
3080 : /* bid = for module m (without arch. part), arch = archimedean part.
3081 : * Output: bid for [m,arch] */
3082 : static GEN
3083 56 : join_bid_arch(GEN nf, GEN bid, GEN archp)
3084 : {
3085 56 : pari_sp av = avma;
3086 : GEN G, U;
3087 56 : GEN sprk, cyc, y, u1 = NULL, x, sarch, gen;
3088 :
3089 56 : checkbid(bid);
3090 56 : G = bid_get_grp(bid);
3091 56 : x = bid_get_ideal(bid);
3092 56 : sarch = nfarchstar(nf, bid_get_ideal(bid), archp);
3093 56 : sprk = bid_get_sprk(bid);
3094 :
3095 56 : gen = (lg(G)>3)? gel(G,3): NULL;
3096 56 : cyc = diagonal_shallow(shallowconcat(gel(G,2), sarch_get_cyc(sarch)));
3097 56 : cyc = ZM_snf_group(cyc, &U, gen? &u1: NULL);
3098 56 : y = bid_grp(nf, u1, cyc, gen, x, sarch);
3099 56 : U = split_U(U, sprk);
3100 56 : y = mkvec5(mkvec2(x, archp), y, gel(bid,3), mkvec2(sprk, sarch), U);
3101 56 : return gerepilecopy(av,y);
3102 : }
3103 : static GEN
3104 56 : join_arch(ideal_data *D, GEN x) {
3105 56 : return join_bid_arch(D->nf, x, D->archp);
3106 : }
3107 : static GEN
3108 28 : join_archunit(ideal_data *D, GEN x) {
3109 28 : GEN bid = join_arch(D, gel(x,1)), u = gel(x,2), v = mkvec(D->emb);
3110 28 : if (lg(u) != 1) v = shallowconcat(u, v);
3111 28 : return mkvec2(bid, v);
3112 : }
3113 :
3114 : /* L from ideallist, add archimedean part */
3115 : GEN
3116 14 : ideallistarch(GEN bnf, GEN L, GEN arch)
3117 : {
3118 : pari_sp av;
3119 14 : long i, j, l = lg(L), lz;
3120 : GEN v, z, V;
3121 : ideal_data ID;
3122 : GEN (*join_z)(ideal_data*, GEN);
3123 :
3124 14 : if (typ(L) != t_VEC) pari_err_TYPE("ideallistarch",L);
3125 14 : if (l == 1) return cgetg(1,t_VEC);
3126 14 : z = gel(L,1);
3127 14 : if (typ(z) != t_VEC) pari_err_TYPE("ideallistarch",z);
3128 14 : z = gel(z,1); /* either a bid or [bid,U] */
3129 14 : ID.nf = checknf(bnf);
3130 14 : ID.archp = vec01_to_indices(arch);
3131 14 : if (lg(z) == 3) { /* the latter: do units */
3132 7 : if (typ(z) != t_VEC) pari_err_TYPE("ideallistarch",z);
3133 7 : ID.emb = zm_to_ZM( rowpermute(nfsign_units(bnf,NULL,1), ID.archp) );
3134 7 : join_z = &join_archunit;
3135 : } else
3136 7 : join_z = &join_arch;
3137 14 : av = avma; V = cgetg(l, t_VEC);
3138 70 : for (i = 1; i < l; i++)
3139 : {
3140 56 : z = gel(L,i); lz = lg(z);
3141 56 : gel(V,i) = v = cgetg(lz,t_VEC);
3142 56 : for (j=1; j<lz; j++) gel(v,j) = join_z(&ID, gel(z,j));
3143 : }
3144 14 : return gerepilecopy(av,V);
3145 : }
|
