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 10626039 : get_tab(GEN nf, long *N)
30 : {
31 10626039 : GEN tab = (typ(nf) == t_MAT)? nf: gel(nf,9);
32 10626039 : *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 405518860 : _mulii(GEN x, GEN y) {
38 1025211894 : return is_pm1(x)? (signe(x) < 0)? negi(y): y
39 619693034 : : mulii(x, y);
40 : }
41 :
42 : GEN
43 2492 : tablemul_ei_ej(GEN M, long i, long j)
44 : {
45 : long N;
46 2492 : GEN tab = get_tab(M, &N);
47 2492 : 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 3255 : tablemul_ei(GEN M, GEN x, long i)
55 : {
56 : long j, k, N;
57 : GEN v, tab;
58 :
59 3255 : if (i==1) return gcopy(x);
60 3255 : tab = get_tab(M, &N);
61 3255 : if (typ(x) != t_COL) { v = zerocol(N); gel(v,i) = gcopy(x); return v; }
62 3255 : tab += (i-1)*N; v = cgetg(N+1,t_COL);
63 : /* wi . x = [ sum_j tab[k,j] x[j] ]_k */
64 20965 : for (k=1; k<=N; k++)
65 : {
66 17710 : pari_sp av = avma;
67 17710 : GEN s = gen_0;
68 121590 : for (j=1; j<=N; j++)
69 : {
70 103880 : GEN c = gcoeff(tab,k,j);
71 103880 : if (!gequal0(c)) s = gadd(s, gmul(c, gel(x,j)));
72 : }
73 17710 : gel(v,k) = gerepileupto(av,s);
74 : }
75 3255 : return v;
76 : }
77 : /* as tablemul_ei, assume x a ZV of correct length */
78 : GEN
79 9355093 : zk_ei_mul(GEN nf, GEN x, long i)
80 : {
81 : long j, k, N;
82 : GEN v, tab;
83 :
84 9355093 : if (i==1) return ZC_copy(x);
85 9355079 : tab = get_tab(nf, &N); tab += (i-1)*N;
86 9355079 : v = cgetg(N+1,t_COL);
87 68718999 : for (k=1; k<=N; k++)
88 : {
89 59363920 : pari_sp av = avma;
90 59363920 : GEN s = gen_0;
91 736806480 : for (j=1; j<=N; j++)
92 : {
93 677442560 : GEN c = gcoeff(tab,k,j);
94 677442560 : if (signe(c)) s = addii(s, _mulii(c, gel(x,j)));
95 : }
96 59363920 : gel(v,k) = gerepileuptoint(av, s);
97 : }
98 9355079 : return v;
99 : }
100 :
101 : /* table of multiplication by wi in R[w1,..., wN] */
102 : GEN
103 4375 : ei_multable(GEN TAB, long i)
104 : {
105 : long k,N;
106 4375 : GEN m, tab = get_tab(TAB, &N);
107 4375 : tab += (i-1)*N;
108 4375 : m = cgetg(N+1,t_MAT);
109 4375 : for (k=1; k<=N; k++) gel(m,k) = gel(tab,k);
110 4375 : return m;
111 : }
112 :
113 : GEN
114 3817119 : zk_multable(GEN nf, GEN x)
115 : {
116 3817119 : long i, l = lg(x);
117 3817119 : GEN mul = cgetg(l,t_MAT);
118 3817119 : gel(mul,1) = x; /* assume w_1 = 1 */
119 3817119 : for (i=2; i<l; i++) gel(mul,i) = zk_ei_mul(nf,x,i);
120 3817119 : return mul;
121 : }
122 : GEN
123 742 : multable(GEN M, GEN x)
124 : {
125 : long i, N;
126 : GEN mul;
127 742 : 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 7995339 : zk_scalar_or_multable(GEN nf, GEN x)
140 : {
141 7995339 : long tx = typ(x);
142 7995339 : if (tx == t_MAT || tx == t_INT) return x;
143 2696891 : x = nf_to_scalar_or_basis(nf, x);
144 2696891 : return (typ(x) == t_COL)? zk_multable(nf, x): x;
145 : }
146 :
147 : GEN
148 42 : nftrace(GEN nf, GEN x)
149 : {
150 42 : pari_sp av = avma;
151 42 : nf = checknf(nf);
152 42 : x = nf_to_scalar_or_basis(nf, x);
153 105 : x = (typ(x) == t_COL)? RgV_dotproduct(x, gel(nf_get_Tr(nf),1))
154 63 : : gmulgs(x, nf_get_degree(nf));
155 42 : return gerepileupto(av, x);
156 : }
157 : GEN
158 567 : rnfelttrace(GEN rnf, GEN x)
159 : {
160 567 : pari_sp av = avma;
161 567 : checkrnf(rnf);
162 567 : x = rnfeltabstorel(rnf, x);
163 1344 : x = (typ(x) == t_POLMOD)? rnfeltdown(rnf, gtrace(x))
164 868 : : gmulgs(x, rnf_get_degree(rnf));
165 476 : return gerepileupto(av, x);
166 : }
167 :
168 : /* assume nf is a genuine nf, fa a famat */
169 : static GEN
170 7 : famat_norm(GEN nf, GEN fa)
171 : {
172 7 : pari_sp av = avma;
173 7 : GEN g = gel(fa,1), e = gel(fa,2), N = gen_1;
174 7 : long i, l = lg(g);
175 21 : for (i = 1; i < l; i++)
176 14 : N = gmul(N, powgi(nfnorm(nf, gel(g,i)), gel(e,i)));
177 7 : return gerepileupto(av, N);
178 : }
179 : GEN
180 21186 : nfnorm(GEN nf, GEN x)
181 : {
182 21186 : pari_sp av = avma;
183 21186 : nf = checknf(nf);
184 21186 : if (typ(x) == t_MAT) return famat_norm(nf, x);
185 21179 : x = nf_to_scalar_or_alg(nf, x);
186 61213 : x = (typ(x) == t_POL)? RgXQ_norm(x, nf_get_pol(nf))
187 40034 : : gpowgs(x, nf_get_degree(nf));
188 21179 : 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 1617399 : nfadd(GEN nf, GEN x, GEN y)
205 : {
206 1617399 : pari_sp av = avma;
207 : GEN z;
208 :
209 1617399 : nf = checknf(nf);
210 1617399 : x = nf_to_scalar_or_basis(nf, x);
211 1617399 : y = nf_to_scalar_or_basis(nf, y);
212 1617399 : if (typ(x) != t_COL)
213 1166667 : { z = (typ(y) == t_COL)? RgC_Rg_add(y, x): gadd(x,y); }
214 : else
215 450732 : { z = (typ(y) == t_COL)? RgC_add(x, y): RgC_Rg_add(x, y); }
216 1617399 : return gerepileupto(av, z);
217 : }
218 : /* x - y in nf */
219 : GEN
220 68789 : nfsub(GEN nf, GEN x, GEN y)
221 : {
222 68789 : pari_sp av = avma;
223 : GEN z;
224 :
225 68789 : nf = checknf(nf);
226 68789 : x = nf_to_scalar_or_basis(nf, x);
227 68789 : y = nf_to_scalar_or_basis(nf, y);
228 68789 : if (typ(x) != t_COL)
229 24689 : { z = (typ(y) == t_COL)? Rg_RgC_sub(x,y): gsub(x,y); }
230 : else
231 44100 : { z = (typ(y) == t_COL)? RgC_sub(x,y): RgC_Rg_sub(x,y); }
232 68789 : return gerepileupto(av, z);
233 : }
234 :
235 : /* product of x and y in nf */
236 : GEN
237 4276114 : nfmul(GEN nf, GEN x, GEN y)
238 : {
239 : GEN z;
240 4276114 : pari_sp av = avma;
241 :
242 4276114 : if (x == y) return nfsqr(nf,x);
243 :
244 3815479 : nf = checknf(nf);
245 3815479 : x = nf_to_scalar_or_basis(nf, x);
246 3815479 : y = nf_to_scalar_or_basis(nf, y);
247 3815479 : if (typ(x) != t_COL)
248 : {
249 3126371 : if (isintzero(x)) return gen_0;
250 2563480 : z = (typ(y) == t_COL)? RgC_Rg_mul(y, x): gmul(x,y); }
251 : else
252 : {
253 689108 : if (typ(y) != t_COL)
254 : {
255 467967 : if (isintzero(y)) return gen_0;
256 148911 : z = RgC_Rg_mul(x, y);
257 : }
258 : else
259 : {
260 : GEN dx, dy;
261 221141 : x = Q_remove_denom(x, &dx);
262 221141 : y = Q_remove_denom(y, &dy);
263 221141 : z = nfmuli(nf,x,y);
264 221141 : dx = mul_denom(dx,dy);
265 221141 : if (dx) z = RgC_Rg_div(z, dx);
266 : }
267 : }
268 2933532 : return gerepileupto(av, z);
269 : }
270 : /* square of x in nf */
271 : GEN
272 601835 : nfsqr(GEN nf, GEN x)
273 : {
274 601835 : pari_sp av = avma;
275 : GEN z;
276 :
277 601835 : nf = checknf(nf);
278 601835 : x = nf_to_scalar_or_basis(nf, x);
279 601835 : if (typ(x) != t_COL) z = gsqr(x);
280 : else
281 : {
282 : GEN dx;
283 93649 : x = Q_remove_denom(x, &dx);
284 93649 : z = nfsqri(nf,x);
285 93649 : if (dx) z = RgC_Rg_div(z, sqri(dx));
286 : }
287 601835 : return gerepileupto(av, z);
288 : }
289 :
290 : /* x a ZC, v a t_COL of ZC/Z */
291 : GEN
292 113490 : zkC_multable_mul(GEN v, GEN x)
293 : {
294 113490 : long i, l = lg(v);
295 113490 : GEN y = cgetg(l, t_COL);
296 409070 : for (i = 1; i < l; i++)
297 : {
298 295580 : GEN c = gel(v,i);
299 295580 : if (typ(c)!=t_COL) {
300 0 : if (!isintzero(c)) c = ZC_Z_mul(gel(x,1), c);
301 : } else {
302 295580 : c = ZM_ZC_mul(x,c);
303 295580 : if (ZV_isscalar(c)) c = gel(c,1);
304 : }
305 295580 : gel(y,i) = c;
306 : }
307 113490 : return y;
308 : }
309 :
310 : GEN
311 24728 : nfC_multable_mul(GEN v, GEN x)
312 : {
313 24728 : long i, l = lg(v);
314 24728 : GEN y = cgetg(l, t_COL);
315 143727 : for (i = 1; i < l; i++)
316 : {
317 118999 : GEN c = gel(v,i);
318 118999 : if (typ(c)!=t_COL) {
319 95383 : if (!isintzero(c)) c = RgC_Rg_mul(gel(x,1), c);
320 : } else {
321 23616 : c = RgM_RgC_mul(x,c);
322 23616 : if (QV_isscalar(c)) c = gel(c,1);
323 : }
324 118999 : gel(y,i) = c;
325 : }
326 24728 : return y;
327 : }
328 :
329 : GEN
330 76327 : nfC_nf_mul(GEN nf, GEN v, GEN x)
331 : {
332 : long tx;
333 : GEN y;
334 :
335 76327 : x = nf_to_scalar_or_basis(nf, x);
336 76327 : tx = typ(x);
337 76327 : if (tx != t_COL)
338 : {
339 : long l, i;
340 52635 : if (tx == t_INT)
341 : {
342 51340 : long s = signe(x);
343 51340 : if (!s) return zerocol(lg(v)-1);
344 48189 : if (is_pm1(x)) return s > 0? leafcopy(v): RgC_neg(v);
345 : }
346 13882 : l = lg(v); y = cgetg(l, t_COL);
347 108142 : for (i=1; i < l; i++)
348 : {
349 94260 : GEN c = gel(v,i);
350 94260 : if (typ(c) != t_COL) c = gmul(c, x); else c = RgC_Rg_mul(c, x);
351 94260 : gel(y,i) = c;
352 : }
353 13882 : return y;
354 : }
355 : else
356 : {
357 : GEN dx;
358 23692 : x = zk_multable(nf, Q_remove_denom(x,&dx));
359 23692 : y = nfC_multable_mul(v, x);
360 23692 : return dx? RgC_Rg_div(y, dx): y;
361 : }
362 : }
363 : static GEN
364 3339 : mulbytab(GEN M, GEN c)
365 3339 : { return typ(c) == t_COL? RgM_RgC_mul(M,c): RgC_Rg_mul(gel(M,1), c); }
366 : GEN
367 742 : tablemulvec(GEN M, GEN x, GEN v)
368 : {
369 : long l, i;
370 : GEN y;
371 :
372 742 : 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 742 : x = multable(M, x); /* multiplication table by x */
378 742 : y = cgetg_copy(v, &l);
379 742 : if (typ(v) == t_POL)
380 : {
381 742 : y[1] = v[1];
382 742 : for (i=2; i < l; i++) gel(y,i) = mulbytab(x, gel(v,i));
383 742 : 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 742 : return y;
390 : }
391 :
392 : GEN
393 314581 : zkmultable_capZ(GEN mx) { return Q_denom(zkmultable_inv(mx)); }
394 :
395 : GEN
396 333701 : zkmultable_inv(GEN mx)
397 333701 : { return ZM_gauss(mx, col_ei(lg(mx)-1,1)); }
398 :
399 : /* nf a true nf, x a ZC */
400 : GEN
401 19120 : zk_inv(GEN nf, GEN x) { return zkmultable_inv(zk_multable(nf,x)); }
402 :
403 : /* inverse of x in nf */
404 : GEN
405 61495 : nfinv(GEN nf, GEN x)
406 : {
407 61495 : pari_sp av = avma;
408 : GEN z;
409 :
410 61495 : nf = checknf(nf);
411 61495 : x = nf_to_scalar_or_basis(nf, x);
412 61495 : if (typ(x) == t_COL)
413 : {
414 : GEN d;
415 6007 : x = Q_remove_denom(x, &d);
416 6007 : z = zk_inv(nf, x);
417 6007 : if (d) z = RgC_Rg_mul(z, d);
418 : }
419 : else
420 55488 : z = ginv(x);
421 61495 : return gerepileupto(av, z);
422 : }
423 :
424 : /* quotient of x and y in nf */
425 : GEN
426 10962 : nfdiv(GEN nf, GEN x, GEN y)
427 : {
428 10962 : pari_sp av = avma;
429 : GEN z;
430 :
431 10962 : nf = checknf(nf);
432 10962 : y = nf_to_scalar_or_basis(nf, y);
433 10962 : if (typ(y) != t_COL)
434 : {
435 2324 : x = nf_to_scalar_or_basis(nf, x);
436 2324 : z = (typ(x) == t_COL)? RgC_Rg_div(x, y): gdiv(x,y);
437 : }
438 : else
439 : {
440 : GEN d;
441 8638 : y = Q_remove_denom(y, &d);
442 8638 : z = nfmul(nf, x, zk_inv(nf,y));
443 8638 : if (d) z = RgC_Rg_mul(z, d);
444 : }
445 10962 : 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 607898 : nfmuli(GEN nf, GEN x, GEN y)
452 : {
453 : long i, j, k, N;
454 607898 : GEN s, v, TAB = get_tab(nf, &N);
455 :
456 607898 : if (typ(x) == t_INT) return (typ(y) == t_COL)? ZC_Z_mul(y, x): mulii(x,y);
457 530890 : if (typ(y) == t_INT) return ZC_Z_mul(x, y);
458 : /* both x and y are ZV */
459 511154 : v = cgetg(N+1,t_COL);
460 2597280 : for (k=1; k<=N; k++)
461 : {
462 2086126 : pari_sp av = avma;
463 2086126 : GEN TABi = TAB;
464 2086126 : if (k == 1)
465 511154 : s = mulii(gel(x,1),gel(y,1));
466 : else
467 3149944 : s = addii(mulii(gel(x,1),gel(y,k)),
468 3149944 : mulii(gel(x,k),gel(y,1)));
469 13553408 : for (i=2; i<=N; i++)
470 : {
471 11467282 : GEN t, xi = gel(x,i);
472 11467282 : TABi += N;
473 11467282 : if (!signe(xi)) continue;
474 :
475 7060063 : t = NULL;
476 86900257 : for (j=2; j<=N; j++)
477 : {
478 79840194 : GEN p1, c = gcoeff(TABi, k, j); /* m^{i,j}_k */
479 79840194 : if (!signe(c)) continue;
480 37208460 : p1 = _mulii(c, gel(y,j));
481 37208460 : t = t? addii(t, p1): p1;
482 : }
483 7060063 : if (t) s = addii(s, mulii(xi, t));
484 : }
485 2086126 : gel(v,k) = gerepileuptoint(av,s);
486 : }
487 511154 : return v;
488 : }
489 : /* square of INTEGER (t_INT or ZC) x in nf */
490 : GEN
491 652940 : nfsqri(GEN nf, GEN x)
492 : {
493 : long i, j, k, N;
494 652940 : GEN s, v, TAB = get_tab(nf, &N);
495 :
496 652940 : if (typ(x) == t_INT) return sqri(x);
497 652940 : v = cgetg(N+1,t_COL);
498 5117197 : for (k=1; k<=N; k++)
499 : {
500 4464257 : pari_sp av = avma;
501 4464257 : GEN TABi = TAB;
502 4464257 : if (k == 1)
503 652940 : s = sqri(gel(x,1));
504 : else
505 3811317 : s = shifti(mulii(gel(x,1),gel(x,k)), 1);
506 53757605 : for (i=2; i<=N; i++)
507 : {
508 49293348 : GEN p1, c, t, xi = gel(x,i);
509 49293348 : TABi += N;
510 49293348 : if (!signe(xi)) continue;
511 :
512 14880253 : c = gcoeff(TABi, k, i);
513 14880253 : t = signe(c)? _mulii(c,xi): NULL;
514 240006055 : for (j=i+1; j<=N; j++)
515 : {
516 225125802 : c = gcoeff(TABi, k, j);
517 225125802 : if (!signe(c)) continue;
518 119189419 : p1 = _mulii(c, shifti(gel(x,j),1));
519 119189419 : t = t? addii(t, p1): p1;
520 : }
521 14880253 : if (t) s = addii(s, mulii(xi, t));
522 : }
523 4464257 : gel(v,k) = gerepileuptoint(av,s);
524 : }
525 652940 : 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 6230 : tablesqr(GEN TAB, GEN x)
569 : {
570 : long i, j, k, N;
571 : GEN s, v;
572 :
573 6230 : if (typ(x) != t_COL) return gsqr(x);
574 6230 : N = lg(x)-1;
575 6230 : v = cgetg(N+1,t_COL);
576 :
577 45808 : for (k=1; k<=N; k++)
578 : {
579 39578 : pari_sp av = avma;
580 39578 : GEN TABi = TAB;
581 39578 : if (k == 1)
582 6230 : s = gsqr(gel(x,1));
583 : else
584 33348 : s = gmul2n(gmul(gel(x,1),gel(x,k)), 1);
585 265972 : for (i=2; i<=N; i++)
586 : {
587 226394 : GEN p1, c, t, xi = gel(x,i);
588 226394 : TABi += N;
589 226394 : if (gequal0(xi)) continue;
590 :
591 71505 : c = gcoeff(TABi, k, i);
592 71505 : t = !gequal0(c)? gmul(c,xi): NULL;
593 319200 : for (j=i+1; j<=N; j++)
594 : {
595 247695 : c = gcoeff(TABi, k, j);
596 247695 : if (gequal0(c)) continue;
597 131978 : p1 = gmul(gmul2n(c,1), gel(x,j));
598 131978 : t = t? gadd(t, p1): p1;
599 : }
600 71505 : if (t) s = gadd(s, gmul(xi, t));
601 : }
602 39578 : gel(v,k) = gerepileupto(av,s);
603 : }
604 6230 : return v;
605 : }
606 :
607 : static GEN
608 30380 : _mul(void *data, GEN x, GEN y) { return nfmuli((GEN)data,x,y); }
609 : static GEN
610 103778 : _sqr(void *data, GEN x) { return nfsqri((GEN)data,x); }
611 :
612 : /* Compute z^n in nf, left-shift binary powering */
613 : GEN
614 119403 : nfpow(GEN nf, GEN z, GEN n)
615 : {
616 119403 : pari_sp av = avma;
617 : long s;
618 : GEN x, cx;
619 :
620 119403 : if (typ(n)!=t_INT) pari_err_TYPE("nfpow",n);
621 119403 : nf = checknf(nf);
622 119403 : s = signe(n); if (!s) return gen_1;
623 119403 : x = nf_to_scalar_or_basis(nf, z);
624 119403 : if (typ(x) != t_COL) return powgi(x,n);
625 108195 : if (s < 0)
626 : { /* simplified nfinv */
627 : GEN d;
628 1874 : x = Q_remove_denom(x, &d);
629 1874 : x = zk_inv(nf, x);
630 1874 : x = primitive_part(x, &cx);
631 1874 : cx = mul_content(cx, d);
632 1874 : n = absi(n);
633 : }
634 : else
635 106321 : x = primitive_part(x, &cx);
636 108195 : x = gen_pow(x, n, (void*)nf, _sqr, _mul);
637 108195 : if (cx) x = gmul(x, powgi(cx, n));
638 108195 : return av==avma? gcopy(x): gerepileupto(av,x);
639 : }
640 : /* Compute z^n in nf, left-shift binary powering */
641 : GEN
642 31234 : nfpow_u(GEN nf, GEN z, ulong n)
643 : {
644 31234 : pari_sp av = avma;
645 : GEN x, cx;
646 :
647 31234 : nf = checknf(nf);
648 31234 : if (!n) return gen_1;
649 31234 : x = nf_to_scalar_or_basis(nf, z);
650 31234 : if (typ(x) != t_COL) return gpowgs(x,n);
651 4389 : x = primitive_part(x, &cx);
652 4389 : x = gen_powu(x, n, (void*)nf, _sqr, _mul);
653 4389 : if (cx) x = gmul(x, powgi(cx, utoipos(n)));
654 4389 : return av==avma? gcopy(x): gerepileupto(av,x);
655 : }
656 :
657 : static GEN
658 346962 : _nf_red(void *E, GEN x) { (void)E; return x; }
659 :
660 : static GEN
661 1511958 : _nf_add(void *E, GEN x, GEN y) { return nfadd((GEN)E,x,y); }
662 :
663 : static GEN
664 86359 : _nf_neg(void *E, GEN x) { (void)E; return gneg(x); }
665 :
666 : static GEN
667 1794086 : _nf_mul(void *E, GEN x, GEN y) { return nfmul((GEN)E,x,y); }
668 :
669 : static GEN
670 6020 : _nf_inv(void *E, GEN x) { return nfinv((GEN)E,x); }
671 :
672 : static GEN
673 1358 : _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 24920 : const struct bb_field *get_nf_field(void **E, GEN nf)
679 24920 : { *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 1344 : nfM_inv(GEN nf, GEN M)
690 : {
691 : void *E;
692 1344 : const struct bb_field *S = get_nf_field(&E, nf);
693 1344 : return gen_Gauss(M, matid(lg(M)-1), E, S);
694 : }
695 : GEN
696 1260 : nfM_mul(GEN nf, GEN A, GEN B)
697 : {
698 : void *E;
699 1260 : const struct bb_field *S = get_nf_field(&E, nf);
700 1260 : return gen_matmul(A, B, E, S);
701 : }
702 : GEN
703 22302 : nfM_nfC_mul(GEN nf, GEN A, GEN B)
704 : {
705 : void *E;
706 22302 : const struct bb_field *S = get_nf_field(&E, nf);
707 22302 : return gen_matcolmul(A, B, E, S);
708 : }
709 :
710 : /* valuation of integral x (ZV), with resp. to prime ideal pr */
711 : long
712 5025792 : ZC_nfvalrem(GEN nf, GEN x, GEN pr, GEN *newx)
713 : {
714 : long i, v, l;
715 5025792 : GEN r, y, p = pr_get_p(pr), mul = zk_scalar_or_multable(nf, pr_get_tau(pr));
716 :
717 : /* p inert */
718 5025792 : if (typ(mul) == t_INT) return newx? ZV_pvalrem(x, p, newx):ZV_pval(x, p);
719 5019944 : y = cgetg_copy(x, &l); /* will hold the new x */
720 5019944 : x = leafcopy(x);
721 7409571 : for(v=0;; v++)
722 : {
723 25510074 : for (i=1; i<l; i++)
724 : { /* is (x.b)[i] divisible by p ? */
725 23120447 : gel(y,i) = dvmdii(ZMrow_ZC_mul(mul,x,i),p,&r);
726 23120447 : if (r != gen_0) { if (newx) *newx = x; return v; }
727 : }
728 2389627 : swap(x, y);
729 2389627 : }
730 : }
731 : long
732 4814822 : ZC_nfval(GEN nf, GEN x, GEN P)
733 4814822 : { return ZC_nfvalrem(nf, x, P, NULL); }
734 :
735 : /* v_P(x) != 0, x a ZV. Simpler version of ZC_nfvalrem */
736 : int
737 201859 : ZC_prdvd(GEN nf, GEN x, GEN P)
738 : {
739 201859 : pari_sp av = avma;
740 : long i, l;
741 201859 : GEN p = pr_get_p(P), mul = zk_scalar_or_multable(nf, pr_get_tau(P));
742 201859 : if (typ(mul) == t_INT) return ZV_Z_dvd(x, p);
743 201782 : l = lg(x);
744 825342 : for (i=1; i<l; i++)
745 753428 : if (remii(ZMrow_ZC_mul(mul,x,i), p) != gen_0) { avma = av; return 0; }
746 71914 : avma = av; return 1;
747 : }
748 :
749 : int
750 28 : pr_equal(GEN nf, 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(nf, gQ, P);
759 : }
760 :
761 : long
762 1319976 : nfval(GEN nf, GEN x, GEN pr)
763 : {
764 1319976 : pari_sp av = avma;
765 : long w, e;
766 : GEN cx, p;
767 :
768 1319976 : if (gequal0(x)) return LONG_MAX;
769 1319248 : nf = checknf(nf);
770 1319248 : checkprid(pr);
771 1319248 : p = pr_get_p(pr);
772 1319248 : e = pr_get_e(pr);
773 1319248 : x = nf_to_scalar_or_basis(nf, x);
774 1319248 : if (typ(x) != t_COL) return e*Q_pval(x,p);
775 136857 : x = Q_primitive_part(x, &cx);
776 136857 : w = ZC_nfval(nf,x,pr);
777 136857 : if (cx) w += e*Q_pval(cx,p);
778 136857 : 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 4333 : powp(GEN nf, GEN pr, long v)
785 : {
786 : GEN b, z;
787 : long e;
788 4333 : if (!v) return gen_1;
789 4312 : b = pr_get_tau(pr);
790 4312 : if (typ(b) == t_INT) return gen_1;
791 1085 : e = pr_get_e(pr);
792 1085 : z = gel(b,1);
793 1085 : if (e != 1) z = gdiv(nfpow_u(nf, z, e), powiu(pr_get_p(pr),e-1));
794 1085 : return nfpow_u(nf, z, v);
795 : }
796 : long
797 15351 : nfvalrem(GEN nf, GEN x, GEN pr, GEN *py)
798 : {
799 15351 : pari_sp av = avma;
800 : long w, e;
801 : GEN cx, p, t;
802 :
803 15351 : if (!py) return nfval(nf,x,pr);
804 15232 : if (gequal0(x)) { *py = gcopy(x); return LONG_MAX; }
805 15218 : nf = checknf(nf);
806 15218 : checkprid(pr);
807 15218 : p = pr_get_p(pr);
808 15218 : e = pr_get_e(pr);
809 15218 : x = nf_to_scalar_or_basis(nf, x);
810 15218 : if (typ(x) != t_COL) {
811 3500 : w = Q_pvalrem(x,p, py);
812 3500 : if (!w) { *py = gerepilecopy(av, x); return 0; }
813 3346 : *py = gerepileupto(av, gmul(powp(nf, pr, w), *py));
814 3346 : return e*w;
815 : }
816 11718 : x = Q_primitive_part(x, &cx);
817 11718 : w = ZC_nfvalrem(nf,x,pr, py);
818 11718 : if (cx)
819 : {
820 987 : long v = Q_pvalrem(cx,p, &t);
821 987 : *py = nfmul(nf, *py, gmul(powp(nf,pr,v), t));
822 987 : *py = gerepileupto(av, *py);
823 987 : w += e*v;
824 : }
825 : else
826 10731 : *py = gerepilecopy(av, *py);
827 11718 : return w;
828 : }
829 : GEN
830 147 : gpnfvalrem(GEN nf, GEN x, GEN pr, GEN *py)
831 : {
832 147 : long v = nfvalrem(nf,x,pr,py);
833 147 : return v == LONG_MAX? mkoo(): stoi(v);
834 : }
835 :
836 : GEN
837 49398 : coltoalg(GEN nf, GEN x)
838 : {
839 49398 : return mkpolmod( coltoliftalg(nf, x), nf_get_pol(nf) );
840 : }
841 :
842 : GEN
843 52451 : basistoalg(GEN nf, GEN x)
844 : {
845 : GEN z, T;
846 :
847 52451 : nf = checknf(nf);
848 52451 : switch(typ(x))
849 : {
850 : case t_COL: {
851 43259 : pari_sp av = avma;
852 43259 : return gerepilecopy(av, coltoalg(nf, x));
853 : }
854 : case t_POLMOD:
855 119 : T = nf_get_pol(nf);
856 119 : if (!RgX_equal_var(T,gel(x,1)))
857 0 : pari_err_MODULUS("basistoalg", T,gel(x,1));
858 119 : return gcopy(x);
859 : case t_POL:
860 574 : T = nf_get_pol(nf);
861 574 : if (varn(T) != varn(x)) pari_err_VAR("basistoalg",x,T);
862 574 : z = cgetg(3,t_POLMOD);
863 574 : gel(z,1) = ZX_copy(T);
864 574 : gel(z,2) = RgX_rem(x, T); return z;
865 : case t_INT:
866 : case t_FRAC:
867 8499 : T = nf_get_pol(nf);
868 8499 : z = cgetg(3,t_POLMOD);
869 8499 : gel(z,1) = ZX_copy(T);
870 8499 : gel(z,2) = gcopy(x); return z;
871 : default:
872 0 : pari_err_TYPE("basistoalg",x);
873 0 : return NULL; /* not reached */
874 : }
875 : }
876 :
877 : /* Assume nf is a genuine nf. */
878 : GEN
879 18717263 : nf_to_scalar_or_basis(GEN nf, GEN x)
880 : {
881 18717263 : switch(typ(x))
882 : {
883 : case t_INT: case t_FRAC:
884 11471186 : return x;
885 : case t_POLMOD:
886 72289 : x = checknfelt_mod(nf,x,"nf_to_scalar_or_basis");
887 72219 : if (typ(x) != t_POL) return x;
888 : /* fall through */
889 : case t_POL:
890 : {
891 198779 : GEN T = nf_get_pol(nf);
892 198779 : long l = lg(x);
893 198779 : if (varn(x) != varn(T)) pari_err_VAR("nf_to_scalar_or_basis", x,T);
894 198723 : if (l >= lg(T)) { x = RgX_rem(x, T); l = lg(x); }
895 198723 : if (l == 2) return gen_0;
896 141834 : if (l == 3) return gel(x,2);
897 108698 : return poltobasis(nf,x);
898 : }
899 : case t_COL:
900 6995743 : if (lg(x) != lg(nf_get_zk(nf))) break;
901 6995680 : return QV_isscalar(x)? gel(x,1): x;
902 : }
903 70 : pari_err_TYPE("nf_to_scalar_or_basis",x);
904 0 : return NULL; /* not reached */
905 : }
906 : /* Let x be a polynomial with coefficients in Q or nf. Return the same
907 : * polynomial with coefficients expressed as vectors (on the integral basis).
908 : * No consistency checks, not memory-clean. */
909 : GEN
910 2633 : RgX_to_nfX(GEN nf, GEN x)
911 : {
912 : long i, l;
913 2633 : GEN y = cgetg_copy(x, &l); y[1] = x[1];
914 2633 : for (i=2; i<l; i++) gel(y,i) = nf_to_scalar_or_basis(nf, gel(x,i));
915 2633 : return y;
916 : }
917 :
918 : /* Assume nf is a genuine nf. */
919 : GEN
920 85849 : nf_to_scalar_or_alg(GEN nf, GEN x)
921 : {
922 85849 : switch(typ(x))
923 : {
924 : case t_INT: case t_FRAC:
925 5963 : return x;
926 : case t_POLMOD:
927 1141 : x = checknfelt_mod(nf,x,"nf_to_scalar_or_alg");
928 1141 : if (typ(x) != t_POL) return x;
929 : /* fall through */
930 : case t_POL:
931 : {
932 12489 : GEN T = nf_get_pol(nf);
933 12489 : long l = lg(x);
934 12489 : if (varn(x) != varn(T)) pari_err_VAR("nf_to_scalar_or_alg", x,T);
935 12489 : if (l >= lg(T)) { x = RgX_rem(x, T); l = lg(x); }
936 12489 : if (l == 2) return gen_0;
937 12489 : if (l == 3) return gel(x,2);
938 12279 : return x;
939 : }
940 : case t_COL:
941 67341 : if (lg(x) != lg(nf_get_zk(nf))) break;
942 67341 : return QV_isscalar(x)? gel(x,1): coltoliftalg(nf, x);
943 : }
944 49 : pari_err_TYPE("nf_to_scalar_or_alg",x);
945 0 : return NULL; /* not reached */
946 : }
947 :
948 : /* gmul(A, RgX_to_RgC(x)), A t_MAT (or t_VEC) of compatible dimensions */
949 : GEN
950 1445034 : mulmat_pol(GEN A, GEN x)
951 : {
952 : long i,l;
953 : GEN z;
954 1445034 : if (typ(x) != t_POL) return gmul(x,gel(A,1)); /* scalar */
955 1444915 : l=lg(x)-1; if (l == 1) return typ(A)==t_VEC? gen_0: zerocol(nbrows(A));
956 1443955 : x++; z = gmul(gel(x,1), gel(A,1));
957 6899164 : for (i=2; i<l ; i++)
958 5455209 : if (!gequal0(gel(x,i))) z = gadd(z, gmul(gel(x,i), gel(A,i)));
959 1443955 : return z;
960 : }
961 :
962 : /* x a t_POL, nf a genuine nf. No garbage collecting. No check. */
963 : GEN
964 1304518 : poltobasis(GEN nf, GEN x)
965 : {
966 1304518 : GEN P = nf_get_pol(nf);
967 1304518 : if (varn(x) != varn(P)) pari_err_VAR( "poltobasis", x,P);
968 1304462 : if (degpol(x) >= degpol(P)) x = RgX_rem(x,P);
969 1304462 : return mulmat_pol(nf_get_invzk(nf), x);
970 : }
971 :
972 : GEN
973 65517 : algtobasis(GEN nf, GEN x)
974 : {
975 : pari_sp av;
976 :
977 65517 : nf = checknf(nf);
978 65517 : switch(typ(x))
979 : {
980 : case t_POLMOD:
981 39361 : if (!RgX_equal_var(nf_get_pol(nf),gel(x,1)))
982 7 : pari_err_MODULUS("algtobasis", nf_get_pol(nf),gel(x,1));
983 39354 : x = gel(x,2);
984 39354 : switch(typ(x))
985 : {
986 : case t_INT:
987 2898 : case t_FRAC: return scalarcol(x, nf_get_degree(nf));
988 : case t_POL:
989 36456 : av = avma;
990 36456 : return gerepileupto(av,poltobasis(nf,x));
991 : }
992 0 : break;
993 :
994 : case t_POL:
995 9248 : av = avma;
996 9248 : return gerepileupto(av,poltobasis(nf,x));
997 :
998 : case t_COL:
999 7409 : if (lg(x)-1 != nf_get_degree(nf)) pari_err_DIM("nfalgtobasis");
1000 7409 : return gcopy(x);
1001 :
1002 : case t_INT:
1003 9499 : case t_FRAC: return scalarcol(x, nf_get_degree(nf));
1004 : }
1005 0 : pari_err_TYPE("algtobasis",x);
1006 0 : return NULL; /* not reached */
1007 : }
1008 :
1009 : GEN
1010 35637 : rnfbasistoalg(GEN rnf,GEN x)
1011 : {
1012 35637 : const char *f = "rnfbasistoalg";
1013 : long lx, i;
1014 35637 : pari_sp av = avma;
1015 : GEN z, nf, relpol, T;
1016 :
1017 35637 : checkrnf(rnf);
1018 35637 : nf = rnf_get_nf(rnf);
1019 35637 : T = nf_get_pol(nf);
1020 35637 : relpol = QXQX_to_mod_shallow(rnf_get_pol(rnf), T);
1021 35637 : switch(typ(x))
1022 : {
1023 : case t_COL:
1024 798 : z = cgetg_copy(x, &lx);
1025 2338 : for (i=1; i<lx; i++)
1026 : {
1027 1589 : GEN c = nf_to_scalar_or_alg(nf, gel(x,i));
1028 1540 : if (typ(c) == t_POL) c = mkpolmod(c,T);
1029 1540 : gel(z,i) = c;
1030 : }
1031 749 : z = RgV_RgC_mul(gel(rnf_get_zk(rnf),1), z);
1032 686 : return gerepileupto(av, gmodulo(z,relpol));
1033 :
1034 : case t_POLMOD:
1035 23688 : x = polmod_nffix(f, rnf, x, 0);
1036 23478 : if (typ(x) != t_POL) break;
1037 9555 : retmkpolmod(RgX_copy(x), RgX_copy(relpol));
1038 : case t_POL:
1039 819 : if (varn(x) == varn(T)) { RgX_check_QX(x,f); x = gmodulo(x,T); break; }
1040 595 : if (varn(x) == varn(relpol))
1041 : {
1042 546 : x = RgX_nffix(f,nf_get_pol(nf),x,0);
1043 546 : return gmodulo(x, relpol);
1044 : }
1045 49 : pari_err_VAR(f, x,relpol);
1046 : }
1047 24430 : retmkpolmod(scalarpol(x, varn(relpol)), RgX_copy(relpol));
1048 : }
1049 :
1050 : GEN
1051 833 : matbasistoalg(GEN nf,GEN x)
1052 : {
1053 : long i, j, li, lx;
1054 833 : GEN z = cgetg_copy(x, &lx);
1055 :
1056 833 : if (lx == 1) return z;
1057 826 : switch(typ(x))
1058 : {
1059 : case t_VEC: case t_COL:
1060 28 : for (i=1; i<lx; i++) gel(z,i) = basistoalg(nf, gel(x,i));
1061 28 : return z;
1062 798 : case t_MAT: break;
1063 0 : default: pari_err_TYPE("matbasistoalg",x);
1064 : }
1065 798 : li = lgcols(x);
1066 2933 : for (j=1; j<lx; j++)
1067 : {
1068 2135 : GEN c = cgetg(li,t_COL), xj = gel(x,j);
1069 2135 : gel(z,j) = c;
1070 2135 : for (i=1; i<li; i++) gel(c,i) = basistoalg(nf, gel(xj,i));
1071 : }
1072 798 : return z;
1073 : }
1074 :
1075 : GEN
1076 1771 : matalgtobasis(GEN nf,GEN x)
1077 : {
1078 : long i, j, li, lx;
1079 1771 : GEN z = cgetg_copy(x, &lx);
1080 :
1081 1771 : if (lx == 1) return z;
1082 1715 : switch(typ(x))
1083 : {
1084 : case t_VEC: case t_COL:
1085 1708 : for (i=1; i<lx; i++) gel(z,i) = algtobasis(nf, gel(x,i));
1086 1708 : return z;
1087 7 : case t_MAT: break;
1088 0 : default: pari_err_TYPE("matalgtobasis",x);
1089 : }
1090 7 : li = lgcols(x);
1091 14 : for (j=1; j<lx; j++)
1092 : {
1093 7 : GEN c = cgetg(li,t_COL), xj = gel(x,j);
1094 7 : gel(z,j) = c;
1095 7 : for (i=1; i<li; i++) gel(c,i) = algtobasis(nf, gel(xj,i));
1096 : }
1097 7 : return z;
1098 : }
1099 : GEN
1100 3276 : RgM_to_nfM(GEN nf,GEN x)
1101 : {
1102 : long i, j, li, lx;
1103 3276 : GEN z = cgetg_copy(x, &lx);
1104 :
1105 3276 : if (lx == 1) return z;
1106 3276 : li = lgcols(x);
1107 23800 : for (j=1; j<lx; j++)
1108 : {
1109 20524 : GEN c = cgetg(li,t_COL), xj = gel(x,j);
1110 20524 : gel(z,j) = c;
1111 20524 : for (i=1; i<li; i++) gel(c,i) = nf_to_scalar_or_basis(nf, gel(xj,i));
1112 : }
1113 3276 : return z;
1114 : }
1115 : GEN
1116 38254 : RgC_to_nfC(GEN nf,GEN x)
1117 : {
1118 38254 : long i, lx = lg(x);
1119 38254 : GEN z = cgetg(lx, t_COL);
1120 38254 : for (i=1; i<lx; i++) gel(z,i) = nf_to_scalar_or_basis(nf, gel(x,i));
1121 38254 : return z;
1122 : }
1123 :
1124 : /* x a t_POLMOD, supposedly in rnf = K[z]/(T), K = Q[y]/(Tnf) */
1125 : GEN
1126 60529 : polmod_nffix(const char *f, GEN rnf, GEN x, int lift)
1127 60529 : { return polmod_nffix2(f, rnf_get_nfpol(rnf), rnf_get_pol(rnf), x,lift); }
1128 : GEN
1129 60620 : polmod_nffix2(const char *f, GEN T, GEN relpol, GEN x, int lift)
1130 : {
1131 60620 : if (RgX_equal_var(gel(x,1),relpol))
1132 : {
1133 55370 : x = gel(x,2);
1134 55370 : if (typ(x) == t_POL && varn(x) == varn(relpol))
1135 : {
1136 39963 : x = RgX_nffix(f, T, x, lift);
1137 39963 : switch(lg(x))
1138 : {
1139 11130 : case 2: return gen_0;
1140 3913 : case 3: return gel(x,2);
1141 : }
1142 24920 : return x;
1143 : }
1144 : }
1145 20657 : return Rg_nffix(f, T, x, lift);
1146 : }
1147 : GEN
1148 1176 : rnfalgtobasis(GEN rnf,GEN x)
1149 : {
1150 1176 : const char *f = "rnfalgtobasis";
1151 1176 : pari_sp av = avma;
1152 : GEN T, relpol;
1153 :
1154 1176 : checkrnf(rnf);
1155 1176 : relpol = rnf_get_pol(rnf);
1156 1176 : T = rnf_get_nfpol(rnf);
1157 1176 : switch(typ(x))
1158 : {
1159 : case t_COL:
1160 49 : if (lg(x)-1 != rnf_get_degree(rnf)) pari_err_DIM(f);
1161 28 : x = RgV_nffix(f, T, x, 0);
1162 21 : return gerepilecopy(av, x);
1163 :
1164 : case t_POLMOD:
1165 1043 : x = polmod_nffix(f, rnf, x, 0);
1166 1001 : if (typ(x) != t_POL) break;
1167 707 : return gerepileupto(av, mulmat_pol(rnf_get_invzk(rnf), x));
1168 : case t_POL:
1169 56 : if (varn(x) == varn(T)) { RgX_check_QX(x,f); x = mkpolmod(x,T); break; }
1170 35 : x = RgX_nffix(f, T, x, 0);
1171 28 : if (degpol(x) >= degpol(relpol)) x = RgX_rem(x,relpol);
1172 28 : return gerepileupto(av, mulmat_pol(rnf_get_invzk(rnf), x));
1173 : }
1174 336 : return gerepileupto(av, scalarcol(x, rnf_get_degree(rnf)));
1175 : }
1176 :
1177 : /* Given a and b in nf, gives an algebraic integer y in nf such that a-b.y
1178 : * is "small" */
1179 : GEN
1180 259 : nfdiveuc(GEN nf, GEN a, GEN b)
1181 : {
1182 259 : pari_sp av = avma;
1183 259 : a = nfdiv(nf,a,b);
1184 259 : return gerepileupto(av, ground(a));
1185 : }
1186 :
1187 : /* Given a and b in nf, gives a "small" algebraic integer r in nf
1188 : * of the form a-b.y */
1189 : GEN
1190 259 : nfmod(GEN nf, GEN a, GEN b)
1191 : {
1192 259 : pari_sp av = avma;
1193 259 : GEN p1 = gneg_i(nfmul(nf,b,ground(nfdiv(nf,a,b))));
1194 259 : return gerepileupto(av, nfadd(nf,a,p1));
1195 : }
1196 :
1197 : /* Given a and b in nf, gives a two-component vector [y,r] in nf such
1198 : * that r=a-b.y is "small". */
1199 : GEN
1200 259 : nfdivrem(GEN nf, GEN a, GEN b)
1201 : {
1202 259 : pari_sp av = avma;
1203 259 : GEN p1,z, y = ground(nfdiv(nf,a,b));
1204 :
1205 259 : p1 = gneg_i(nfmul(nf,b,y));
1206 259 : z = cgetg(3,t_VEC);
1207 259 : gel(z,1) = gcopy(y);
1208 259 : gel(z,2) = nfadd(nf,a,p1); return gerepileupto(av, z);
1209 : }
1210 :
1211 : /*************************************************************************/
1212 : /** **/
1213 : /** (Z_K/I)^* **/
1214 : /** **/
1215 : /*************************************************************************/
1216 : /* return sign(sigma_k(x)), x t_COL (integral, primitive) */
1217 : static long
1218 378751 : eval_sign(GEN M, GEN x, long k)
1219 : {
1220 378751 : long i, l = lg(x);
1221 378751 : GEN z = gel(x,1); /* times M[k,1], which is 1 */
1222 378751 : for (i = 2; i < l; i++) z = mpadd(z, mpmul(gcoeff(M,k,i), gel(x,i)));
1223 378751 : if (realprec(z) < DEFAULTPREC) pari_err_PREC("nfsign_arch");
1224 378751 : return signe(z);
1225 : }
1226 :
1227 : /* sigma_k(x), assuming x not rational (or nf != Q) */
1228 : static GEN
1229 287 : nfembed_i(GEN nf, GEN x, long k)
1230 : {
1231 : long i, l;
1232 : GEN z, M;
1233 287 : M = nf_get_M(nf); l = lg(M); /* > 2 */
1234 287 : z = gel(x,1);
1235 287 : for (i=2; i<l; i++) z = gadd(z, gmul(gcoeff(M,k,i), gel(x,i)));
1236 287 : return z;
1237 : }
1238 : GEN
1239 1568 : nfembed(GEN nf, GEN x, long k)
1240 : {
1241 1568 : pari_sp av = avma;
1242 1568 : nf = checknf(nf);
1243 1568 : x = nf_to_scalar_or_basis(nf,x);
1244 1568 : if (typ(x) != t_COL) return gerepilecopy(av, x);
1245 0 : return gerepileupto(av, nfembed_i(nf,x,k));
1246 : }
1247 :
1248 : /* pl : requested signs for real embeddings, 0 = no sign constraint */
1249 : /* FIXME: not rigorous */
1250 : int
1251 1113 : nfchecksigns(GEN nf, GEN x, GEN pl)
1252 : {
1253 1113 : pari_sp av = avma;
1254 1113 : long l = lg(pl), i;
1255 1113 : nf = checknf(nf);
1256 1113 : x = nf_to_scalar_or_basis(nf,x);
1257 1113 : if (typ(x) != t_COL)
1258 : {
1259 791 : long s = gsigne(x);
1260 1631 : for (i = 1; i < l; i++)
1261 1036 : if (pl[i] && pl[i] != s) { avma = av; return 0; }
1262 : }
1263 : else
1264 : {
1265 525 : for (i = 1; i < l; i++)
1266 322 : if (pl[i] && pl[i] != gsigne(nfembed_i(nf,x,i))) { avma = av; return 0; }
1267 : }
1268 798 : avma = av; return 1;
1269 : }
1270 :
1271 : GEN
1272 595 : vecsmall01_to_indices(GEN v)
1273 : {
1274 595 : long i, k, l = lg(v);
1275 595 : GEN p = new_chunk(l) + l;
1276 1526 : for (k=1, i=l-1; i; i--)
1277 931 : if (v[i]) { *--p = i; k++; }
1278 595 : *--p = evallg(k) | evaltyp(t_VECSMALL);
1279 595 : avma = (pari_sp)p; return p;
1280 : }
1281 : GEN
1282 532468 : vec01_to_indices(GEN v)
1283 : {
1284 : long i, k, l;
1285 : GEN p;
1286 :
1287 532468 : switch (typ(v))
1288 : {
1289 429778 : case t_VECSMALL: return v;
1290 102690 : case t_VEC: break;
1291 0 : default: pari_err_TYPE("vec01_to_indices",v);
1292 : }
1293 102690 : l = lg(v);
1294 102690 : p = new_chunk(l) + l;
1295 361984 : for (k=1, i=l-1; i; i--)
1296 259294 : if (signe(gel(v,i))) { *--p = i; k++; }
1297 102690 : *--p = evallg(k) | evaltyp(t_VECSMALL);
1298 102690 : avma = (pari_sp)p; return p;
1299 : }
1300 : GEN
1301 4452 : indices_to_vec01(GEN p, long r)
1302 : {
1303 4452 : long i, l = lg(p);
1304 4452 : GEN v = zerovec(r);
1305 4452 : for (i = 1; i < l; i++) gel(v, p[i]) = gen_1;
1306 4452 : return v;
1307 : }
1308 :
1309 : /* return (column) vector of R1 signatures of x (0 or 1) */
1310 : GEN
1311 525475 : nfsign_arch(GEN nf, GEN x, GEN arch)
1312 : {
1313 525475 : GEN M, V, archp = vec01_to_indices(arch);
1314 525475 : long i, s, n = lg(archp)-1;
1315 : pari_sp av;
1316 :
1317 525475 : if (!n) return cgetg(1,t_VECSMALL);
1318 416075 : nf = checknf(nf);
1319 416075 : if (typ(x) == t_MAT)
1320 : { /* factorisation */
1321 101994 : GEN g = gel(x,1), e = gel(x,2);
1322 101994 : V = zero_zv(n);
1323 313192 : for (i=1; i<lg(g); i++)
1324 211198 : if (mpodd(gel(e,i)))
1325 170405 : Flv_add_inplace(V, nfsign_arch(nf,gel(g,i),archp), 2);
1326 101994 : avma = (pari_sp)V; return V;
1327 : }
1328 314081 : av = avma; V = cgetg(n+1,t_VECSMALL);
1329 314081 : x = nf_to_scalar_or_basis(nf, x);
1330 314081 : switch(typ(x))
1331 : {
1332 : case t_INT:
1333 78081 : s = signe(x);
1334 78081 : if (!s) pari_err_DOMAIN("nfsign_arch","element","=",gen_0,x);
1335 78081 : avma = av; return const_vecsmall(n, (s < 0)? 1: 0);
1336 : case t_FRAC:
1337 441 : s = signe(gel(x,1));
1338 441 : avma = av; return const_vecsmall(n, (s < 0)? 1: 0);
1339 : }
1340 235559 : x = Q_primpart(x); M = nf_get_M(nf);
1341 235559 : for (i = 1; i <= n; i++) V[i] = (eval_sign(M, x, archp[i]) < 0)? 1: 0;
1342 235559 : avma = (pari_sp)V; return V;
1343 : }
1344 :
1345 : /* return the vector of signs of x; the matrix of such if x is a vector
1346 : * of nf elements */
1347 : GEN
1348 378 : nfsign(GEN nf, GEN x)
1349 : {
1350 : long i, l;
1351 : GEN archp, S;
1352 :
1353 378 : nf = checknf(nf);
1354 378 : archp = identity_perm( nf_get_r1(nf) );
1355 378 : if (typ(x) != t_VEC) return nfsign_arch(nf, x, archp);
1356 70 : l = lg(x); S = cgetg(l, t_MAT);
1357 70 : for (i=1; i<l; i++) gel(S,i) = nfsign_arch(nf, gel(x,i), archp);
1358 70 : return S;
1359 : }
1360 :
1361 : /* multiply y by t = 1 mod^* f such that sign(x) = sign(y) at arch = divisor[2].
1362 : * If x == NULL, make y >> 0 at sarch */
1363 : GEN
1364 87444 : set_sign_mod_divisor(GEN nf, GEN x, GEN y, GEN sarch)
1365 : {
1366 : GEN s, archp, gen;
1367 : long nba,i;
1368 87444 : if (!sarch) return y;
1369 87444 : gen = gel(sarch,2); nba = lg(gen);
1370 87444 : if (nba == 1) return y;
1371 :
1372 72828 : archp = gel(sarch,4);
1373 72828 : y = nf_to_scalar_or_basis(nf, y);
1374 72828 : s = nfsign_arch(nf, y, archp);
1375 72828 : if (x) Flv_add_inplace(s, nfsign_arch(nf, x, archp), 2);
1376 72828 : s = Flm_Flc_mul(gel(sarch,3), s, 2);
1377 170653 : for (i=1; i<nba; i++)
1378 97825 : if (s[i]) y = nfmul(nf,y,gel(gen,i));
1379 72828 : return y;
1380 : }
1381 :
1382 : /* x integral elt, A integral ideal in HNF; reduce x mod A */
1383 : static GEN
1384 572131 : zk_modHNF(GEN x, GEN A)
1385 572131 : { return (typ(x) == t_COL)? ZC_hnfrem(x, A): modii(x, gcoeff(A,1,1)); }
1386 :
1387 : /* given an element x in Z_K and an integral ideal y in HNF, coprime with x,
1388 : outputs an element inverse of x modulo y */
1389 : GEN
1390 364 : nfinvmodideal(GEN nf, GEN x, GEN y)
1391 : {
1392 364 : pari_sp av = avma;
1393 364 : GEN a, yZ = gcoeff(y,1,1);
1394 :
1395 364 : if (is_pm1(yZ)) return gen_0;
1396 364 : x = nf_to_scalar_or_basis(nf, x);
1397 364 : if (typ(x) == t_INT) return gerepileupto(av, Fp_inv(x, yZ));
1398 :
1399 217 : a = hnfmerge_get_1(idealhnf_principal(nf,x), y);
1400 217 : if (!a) pari_err_INV("nfinvmodideal", x);
1401 217 : return gerepileupto(av, zk_modHNF(nfdiv(nf,a,x), y));
1402 : }
1403 :
1404 : static GEN
1405 282307 : nfsqrmodideal(GEN nf, GEN x, GEN id)
1406 282307 : { return zk_modHNF(nfsqri(nf,x), id); }
1407 : static GEN
1408 603249 : nfmulmodideal(GEN nf, GEN x, GEN y, GEN id)
1409 603249 : { return x? zk_modHNF(nfmuli(nf,x,y), id): y; }
1410 : /* assume x integral, k integer, A in HNF */
1411 : GEN
1412 386695 : nfpowmodideal(GEN nf,GEN x,GEN k,GEN A)
1413 : {
1414 386695 : long s = signe(k);
1415 : pari_sp av;
1416 : GEN y;
1417 :
1418 386695 : if (!s) return gen_1;
1419 386695 : av = avma;
1420 386695 : x = nf_to_scalar_or_basis(nf, x);
1421 386695 : if (typ(x) != t_COL) return Fp_pow(x, k, gcoeff(A,1,1));
1422 200449 : if (s < 0) { x = nfinvmodideal(nf, x,A); k = absi(k); }
1423 200449 : for(y = NULL;;)
1424 : {
1425 482756 : if (mpodd(k)) y = nfmulmodideal(nf,y,x,A);
1426 482756 : k = shifti(k,-1); if (!signe(k)) break;
1427 282307 : x = nfsqrmodideal(nf,x,A);
1428 282307 : }
1429 200449 : return gerepileupto(av, y);
1430 : }
1431 :
1432 : /* a * g^n mod id */
1433 : static GEN
1434 326635 : elt_mulpow_modideal(GEN nf, GEN a, GEN g, GEN n, GEN id)
1435 : {
1436 326635 : return nfmulmodideal(nf, a, nfpowmodideal(nf,g,n,id), id);
1437 : }
1438 :
1439 : /* assume (num(g[i]), id) = 1 for all i. Return prod g[i]^e[i] mod id.
1440 : * EX = multiple of exponent of (O_K/id)^* */
1441 : GEN
1442 113193 : famat_to_nf_modideal_coprime(GEN nf, GEN g, GEN e, GEN id, GEN EX)
1443 : {
1444 113193 : GEN EXo2, plus = NULL, minus = NULL, idZ = gcoeff(id,1,1);
1445 113193 : long i, lx = lg(g);
1446 :
1447 113193 : if (is_pm1(idZ)) return gen_1; /* id = Z_K */
1448 113102 : EXo2 = (expi(EX) > 10)? shifti(EX,-1): NULL;
1449 456585 : for (i = 1; i < lx; i++)
1450 : {
1451 343483 : GEN h, n = centermodii(gel(e,i), EX, EXo2);
1452 343483 : long sn = signe(n);
1453 343483 : if (!sn) continue;
1454 :
1455 246529 : h = nf_to_scalar_or_basis(nf, gel(g,i));
1456 246529 : switch(typ(h))
1457 : {
1458 160748 : case t_INT: break;
1459 : case t_FRAC:
1460 0 : h = Fp_div(gel(h,1), gel(h,2), idZ); break;
1461 : default:
1462 : {
1463 : GEN dh;
1464 85781 : h = Q_remove_denom(h, &dh);
1465 85781 : if (dh) h = FpC_Fp_mul(h, Fp_inv(dh,idZ), idZ);
1466 : }
1467 : }
1468 246529 : if (sn > 0)
1469 245003 : plus = elt_mulpow_modideal(nf, plus, h, n, id);
1470 : else /* sn < 0 */
1471 1526 : minus = elt_mulpow_modideal(nf, minus, h, absi(n), id);
1472 : }
1473 113102 : if (minus) plus = nfmulmodideal(nf, plus, nfinvmodideal(nf,minus,id), id);
1474 113102 : return plus? plus: gen_1;
1475 : }
1476 :
1477 : /* given 2 integral ideals x, y in HNF s.t x | y | x^2, compute the quotient
1478 : (1+x)/(1+y) in the form [[cyc],[gen]], if U != NULL, set *U := ux^-1 */
1479 : static GEN
1480 13482 : zidealij(GEN x, GEN y, GEN *U)
1481 : {
1482 : GEN G, cyc;
1483 : long j, N;
1484 :
1485 : /* x^(-1) y = relations between the 1 + x_i (HNF) */
1486 13482 : cyc = ZM_snf_group(hnf_solve(x, y), U, &G);
1487 13482 : N = lg(cyc); G = ZM_mul(x,G); settyp(G, t_VEC); /* new generators */
1488 61747 : for (j=1; j<N; j++)
1489 : {
1490 48265 : GEN c = gel(G,j);
1491 48265 : gel(c,1) = addiu(gel(c,1), 1); /* 1 + g_j */
1492 48265 : if (ZV_isscalar(c)) gel(G,j) = gel(c,1);
1493 : }
1494 13482 : if (U) *U = RgM_mul(*U, RgM_inv(x));
1495 13482 : return mkvec2(cyc, G);
1496 : }
1497 :
1498 : static GEN
1499 300743 : Fq_FpXQ_log(GEN a, GEN g, GEN ord, GEN T, GEN p)
1500 : {
1501 300743 : if (!T) return Fp_log(a,g,ord,p);
1502 121105 : if (typ(a)==t_INT) return Fp_FpXQ_log(a,g,ord,T,p);
1503 83640 : return FpXQ_log(a,g,ord,T,p);
1504 : }
1505 : /* same in nf.zk / pr */
1506 : static GEN
1507 300743 : nf_log(GEN nf, GEN a, GEN g, GEN ord, GEN pr)
1508 : {
1509 300743 : pari_sp av = avma;
1510 300743 : GEN T,p, modpr = nf_to_Fq_init(nf, &pr, &T, &p);
1511 300743 : GEN A = nf_to_Fq(nf,a,modpr);
1512 300743 : GEN G = nf_to_Fq(nf,g,modpr);
1513 300743 : return gerepileuptoint(av, Fq_FpXQ_log(A,G,ord,T,p));
1514 : }
1515 :
1516 : /* lg(x) > 1, x + 1; shallow */
1517 : static GEN
1518 3640 : ZC_add1(GEN x)
1519 : {
1520 3640 : long i, l = lg(x);
1521 3640 : GEN y = cgetg(l, t_COL);
1522 3640 : for (i = 2; i < l; i++) gel(y,i) = gel(x,i);
1523 3640 : gel(y,1) = addiu(gel(x,1), 1); return y;
1524 : }
1525 : /* lg(x) > 1, x - 1; shallow */
1526 : static GEN
1527 1631 : ZC_sub1(GEN x)
1528 : {
1529 1631 : long i, l = lg(x);
1530 1631 : GEN y = cgetg(l, t_COL);
1531 1631 : for (i = 2; i < l; i++) gel(y,i) = gel(x,i);
1532 1631 : gel(y,1) = subiu(gel(x,1), 1); return y;
1533 : }
1534 :
1535 : /* x,y are t_INT or ZC */
1536 : static GEN
1537 0 : zkadd(GEN x, GEN y)
1538 : {
1539 0 : long tx = typ(x);
1540 0 : if (tx == typ(y))
1541 0 : return tx == t_INT? addii(x,y): ZC_add(x,y);
1542 : else
1543 0 : return tx == t_INT? ZC_Z_add(y,x): ZC_Z_add(x,y);
1544 : }
1545 : /* x a t_INT or ZC, x+1; shallow */
1546 : static GEN
1547 4410 : zkadd1(GEN x)
1548 : {
1549 4410 : long tx = typ(x);
1550 4410 : return tx == t_INT? addiu(x,1): ZC_add1(x);
1551 : }
1552 : /* x a t_INT or ZC, x-1; shallow */
1553 : static GEN
1554 4410 : zksub1(GEN x)
1555 : {
1556 4410 : long tx = typ(x);
1557 4410 : return tx == t_INT? subiu(x,1): ZC_sub1(x);
1558 : }
1559 : /* x,y are t_INT or ZC; x - y */
1560 : static GEN
1561 0 : zksub(GEN x, GEN y)
1562 : {
1563 0 : long tx = typ(x), ty = typ(y);
1564 0 : if (tx == ty)
1565 0 : return tx == t_INT? subii(x,y): ZC_sub(x,y);
1566 : else
1567 0 : return tx == t_INT? Z_ZC_sub(x,y): ZC_Z_sub(x,y);
1568 : }
1569 : /* x is t_INT or ZM (mult. map), y is t_INT or ZC; x * y */
1570 : static GEN
1571 4410 : zkmul(GEN x, GEN y)
1572 : {
1573 4410 : long tx = typ(x), ty = typ(y);
1574 4410 : if (ty == t_INT)
1575 2779 : return tx == t_INT? mulii(x,y): ZC_Z_mul(gel(x,1),y);
1576 : else
1577 1631 : return tx == t_INT? ZC_Z_mul(y,x): ZM_ZC_mul(x,y);
1578 : }
1579 :
1580 : /* (U,V) = 1 coprime ideals. Want z = x mod U, = y mod V; namely
1581 : * z =vx + uy = v(x-y) + y, where u + v = 1, u in U, v in V.
1582 : * zkc = [v, UV], v a t_INT or ZM (mult. by v map), UV a ZM (ideal in HNF);
1583 : * shallow */
1584 : GEN
1585 0 : zkchinese(GEN zkc, GEN x, GEN y)
1586 : {
1587 0 : GEN v = gel(zkc,1), UV = gel(zkc,2), z = zkadd(zkmul(v, zksub(x,y)), y);
1588 0 : return zk_modHNF(z, UV);
1589 : }
1590 : /* special case z = x mod U, = 1 mod V; shallow */
1591 : GEN
1592 4410 : zkchinese1(GEN zkc, GEN x)
1593 : {
1594 4410 : GEN v = gel(zkc,1), UV = gel(zkc,2), z = zkadd1(zkmul(v, zksub1(x)));
1595 4410 : return (typ(z) == t_INT)? z: ZC_hnfrem(z, UV);
1596 : }
1597 : static GEN
1598 518 : zkVchinese1(GEN zkc, GEN v)
1599 : {
1600 : long i, ly;
1601 518 : GEN y = cgetg_copy(v, &ly);
1602 518 : for (i=1; i<ly; i++) gel(y,i) = zkchinese1(zkc, gel(v,i));
1603 518 : return y;
1604 : }
1605 :
1606 : /* prepare to solve z = x (mod A), z = y mod (B) [zkchinese or zkchinese1] */
1607 : GEN
1608 2646 : zkchineseinit(GEN nf, GEN A, GEN B, GEN AB)
1609 : {
1610 : GEN v;
1611 2646 : nf = checknf(nf);
1612 2646 : v = idealaddtoone_i(nf, A, B);
1613 2646 : return mkvec2(zk_scalar_or_multable(nf,v), AB);
1614 : }
1615 : /* prepare to solve z = x (mod A), z = 1 mod (B)
1616 : * and then z = 1 (mod A), z = y mod (B) [zkchinese1 twice] */
1617 : static GEN
1618 259 : zkchinese1init2(GEN nf, GEN A, GEN B, GEN AB)
1619 : {
1620 259 : GEN zkc = zkchineseinit(nf, A, B, AB);
1621 259 : GEN mv = gel(zkc,1), mu;
1622 259 : if (typ(mv) == t_INT) return mkvec2(zkc, mkvec2(subui(1,mv),AB));
1623 238 : mu = RgM_Rg_add_shallow(ZM_neg(mv), gen_1);
1624 238 : return mkvec2(mkvec2(mv,AB), mkvec2(mu,AB));
1625 : }
1626 :
1627 : /* Given an ideal pr^ep, and an integral ideal x (in HNF form) compute a list
1628 : * of vectors,corresponding to the abelian groups (O_K/pr)^*, and
1629 : * 1 + pr^i/ 1 + pr^min(2i, ep), i = 1,...
1630 : * Each vector has 5 components as follows :
1631 : * [[cyc],[g],[g'],[sign],U.X^-1].
1632 : * cyc = type as abelian group
1633 : * g, g' = generators. (g',x) = 1, not necessarily so for g
1634 : * sign = vector of the sign(g') at arch.
1635 : * If x = NULL, the original ideal was a prime power */
1636 : static GEN
1637 13181 : zprimestar(GEN nf, GEN pr, GEN ep, GEN x, GEN arch)
1638 : {
1639 13181 : pari_sp av = avma;
1640 13181 : long a, e = itos(ep), f = pr_get_f(pr);
1641 13181 : GEN p = pr_get_p(pr), list, g, g0, y, uv, prb, pre;
1642 : ulong mask;
1643 :
1644 13181 : if(DEBUGLEVEL>3) err_printf("treating pr^%ld, pr = %Ps\n",e,pr);
1645 13181 : if (f == 1)
1646 6440 : g = pgener_Fp(p);
1647 : else
1648 : {
1649 6741 : GEN T, modpr = zk_to_Fq_init(nf, &pr, &T, &p);
1650 6741 : g = Fq_to_nf(gener_FpXQ(T,p,NULL), modpr);
1651 6741 : g = poltobasis(nf, g);
1652 : }
1653 : /* g generates (Z_K / pr)^* */
1654 13181 : prb = idealhnf_two(nf,pr);
1655 13181 : pre = (e==1)? prb: idealpow(nf,pr,ep);
1656 13181 : if (x)
1657 : {
1658 2387 : uv = zkchineseinit(nf, idealdivpowprime(nf,x,pr,ep), pre, x);
1659 2387 : g0 = zkchinese1(uv, g);
1660 : }
1661 : else
1662 : {
1663 10794 : uv = NULL; /* gcc -Wall */
1664 10794 : g0 = g;
1665 : }
1666 :
1667 13181 : y = mkvec5(mkvec(subiu(powiu(p,f), 1)),
1668 : mkvec(g),
1669 : mkvec(g0),
1670 : mkvec(nfsign_arch(nf,g0,arch)),
1671 : gen_1);
1672 13181 : if (e == 1) return gerepilecopy(av, mkvec(y));
1673 7840 : list = vectrunc_init(e+1);
1674 7840 : vectrunc_append(list, y);
1675 7840 : mask = quadratic_prec_mask(e);
1676 7840 : a = 1;
1677 27601 : while (mask > 1)
1678 : {
1679 11921 : GEN pra = prb, gen, z, s, U;
1680 11921 : long i, l, b = a << 1;
1681 :
1682 11921 : if (mask & 1) b--;
1683 11921 : mask >>= 1;
1684 : /* compute 1 + pr^a / 1 + pr^b, 2a <= b */
1685 11921 : if(DEBUGLEVEL>3) err_printf(" treating a = %ld, b = %ld\n",a,b);
1686 11921 : prb = (b >= e)? pre: idealpows(nf,pr,b);
1687 11921 : z = zidealij(pra, prb, &U);
1688 11921 : gen = leafcopy(gel(z,2));
1689 11921 : s = cgetg_copy(gen, &l);
1690 58156 : for (i = 1; i < l; i++)
1691 : {
1692 46235 : if (x) gel(gen,i) = zkchinese1(uv, gel(gen,i));
1693 46235 : gel(s,i) = nfsign_arch(nf, gel(gen,i), arch);
1694 : }
1695 11921 : y = mkvec5(gel(z,1), gel(z,2), gen, s, U);
1696 11921 : vectrunc_append(list, y);
1697 11921 : a = b;
1698 : }
1699 7840 : return gerepilecopy(av, list);
1700 : }
1701 :
1702 : static GEN
1703 223381 : apply_U(GEN U, GEN a)
1704 : {
1705 : GEN e;
1706 223381 : if (typ(a) == t_INT)
1707 93724 : e = RgC_Rg_mul(gel(U,1), subis(a, 1));
1708 : else
1709 : { /* t_COL */
1710 129657 : GEN t = gel(a,1);
1711 129657 : gel(a,1) = addsi(-1, gel(a,1)); /* a -= 1 */
1712 129657 : e = RgM_RgC_mul(U, a);
1713 129657 : gel(a,1) = t; /* restore */
1714 : }
1715 223381 : return e;
1716 : }
1717 : /* a in Z_K (t_COL or t_INT), pr prime ideal, prk = pr^k,
1718 : * list = zprimestar(nf, pr, k, ...) */
1719 : static GEN
1720 300743 : zlog_pk(GEN nf, GEN a, GEN y, GEN pr, GEN prk, GEN list, GEN *psigne)
1721 : {
1722 300743 : long i,j, llist = lg(list)-1;
1723 823698 : for (j = 1; j <= llist; j++)
1724 : {
1725 522962 : GEN L = gel(list,j), e;
1726 522962 : GEN cyc = gel(L,1), gen = gel(L,2), s = gel(L,4), U = gel(L,5);
1727 522962 : if (j == 1)
1728 300743 : e = mkcol( nf_log(nf, a, gel(gen,1), gel(cyc,1), pr) );
1729 : else
1730 222219 : e = apply_U(U, a);
1731 : /* here lg(e) == lg(cyc) */
1732 1595197 : for (i = 1; i < lg(cyc); i++)
1733 : {
1734 : GEN t;
1735 1072242 : if (typ(gel(e,i)) != t_INT) pari_err_COPRIME("zlog_pk", a, pr);
1736 1072235 : t = modii(negi(gel(e,i)), gel(cyc,i));
1737 1072235 : gel(++y,0) = negi(t); if (!signe(t)) continue;
1738 :
1739 337796 : if (mod2(t)) Flv_add_inplace(*psigne, gel(s,i), 2);
1740 337796 : if (j != llist) a = elt_mulpow_modideal(nf, a, gel(gen,i), t, prk);
1741 : }
1742 : }
1743 300736 : return y;
1744 : }
1745 :
1746 : static void
1747 289186 : zlog_add_sign(GEN y0, GEN sgn, GEN sarch)
1748 : {
1749 : GEN y, s;
1750 : long i;
1751 578372 : if (!sgn) return;
1752 289186 : y = y0 + lg(y0);
1753 289186 : s = Flm_Flc_mul(gel(sarch,3), sgn, 2);
1754 289186 : for (i = lg(s)-1; i > 0; i--) gel(--y,0) = s[i]? gen_1: gen_0;
1755 : }
1756 :
1757 : static GEN
1758 95697 : famat_zlog(GEN nf, GEN fa, GEN sgn, GEN bid)
1759 : {
1760 95697 : GEN g = gel(fa,1), e = gel(fa,2);
1761 95697 : GEN vp = gmael(bid, 3,1), ep = gmael(bid, 3,2);
1762 95697 : GEN arch = bid_get_arch(bid);
1763 95697 : GEN cyc = bid_get_cyc(bid), sprk = bid_get_sprk(bid), U = bid_get_U(bid);
1764 95697 : GEN y0, x, y, EX = gel(cyc,1);
1765 : long i, l;
1766 :
1767 95697 : y0 = y = cgetg(lg(U), t_COL);
1768 95697 : if (!sgn) sgn = nfsign_arch(nf, mkmat2(g,e), arch);
1769 95697 : l = lg(vp);
1770 190186 : for (i=1; i < l; i++)
1771 : {
1772 94489 : GEN pr = gel(vp,i), prk, ex;
1773 94489 : if (l == 2) {
1774 67323 : prk = bid_get_ideal(bid);
1775 67323 : ex = EX;
1776 : } else { /* try to improve EX: should be group exponent mod prf, not f */
1777 27166 : GEN k = gel(ep,i);
1778 27166 : prk = idealpow(nf, pr, k);
1779 : /* upper bound: gcd(EX, (Nv-1)p^(k-1)) = (Nv-1) p^min(k-1,v_p(EX)) */
1780 27166 : ex = subis(pr_norm(pr),1);
1781 27166 : if (!is_pm1(k)) {
1782 3563 : GEN p = pr_get_p(pr), k_1 = subis(k,1);
1783 3563 : long v = Z_pval(EX, p);
1784 3563 : if (abscmpui(v, k_1) > 0) v = itos(k_1);
1785 3563 : if (v) ex = mulii(ex, powiu(p, v));
1786 : }
1787 : }
1788 94489 : x = famat_makecoprime(nf, g, e, pr, prk, ex);
1789 94489 : y = zlog_pk(nf, x, y, pr, prk, gel(sprk,i), &sgn);
1790 : }
1791 95697 : zlog_add_sign(y0, sgn, bid_get_sarch(bid));
1792 95697 : return y0;
1793 : }
1794 :
1795 : static GEN
1796 13734 : get_index(GEN sprk)
1797 : {
1798 13734 : long t = 0, k, l = lg(sprk);
1799 13734 : GEN ind = cgetg(l, t_VECSMALL);
1800 27496 : for (k = 1; k < l; k++)
1801 : {
1802 13762 : GEN L = gel(sprk,k);
1803 13762 : long j, lL = lg(L);
1804 13762 : ind[k] = t;
1805 13762 : for (j=1; j<lL; j++) t += lg(gmael(L,j,1)) - 1;
1806 : }
1807 13734 : return ind;
1808 : }
1809 :
1810 : static void
1811 130818 : init_zlog(zlog_S *S, long n, GEN P, GEN e, GEN sprk, GEN sarch, GEN ind, GEN U)
1812 : {
1813 130818 : S->n = n;
1814 130818 : S->U = U;
1815 130818 : S->P = P;
1816 130818 : S->e = e;
1817 130818 : S->archp = gel(sarch,4);
1818 130818 : S->sprk = sprk;
1819 130818 : S->sarch = sarch;
1820 130818 : S->ind = ind;
1821 130818 : }
1822 : void
1823 118981 : init_zlog_bid(zlog_S *S, GEN bid)
1824 : {
1825 118981 : GEN fa = bid_get_fact(bid), sprk = bid_get_sprk(bid), U = bid_get_U(bid);
1826 118981 : GEN sarch = bid_get_sarch(bid), ind = bid_get_ind(bid);
1827 118981 : init_zlog(S, lg(U)-1, gel(fa,1), gel(fa,2), sprk, sarch, ind, U);
1828 118981 : }
1829 :
1830 : /* Return decomposition of a on the S->n successive generators contained in
1831 : * S->sprk and S->sarch. If index !=0, do the computation for the
1832 : * corresponding prime ideal and set to 0 the other components. */
1833 : static GEN
1834 176563 : zlog_ind(GEN nf, GEN a, zlog_S *S, GEN sgn, long index)
1835 : {
1836 176563 : GEN y0 = zerocol(S->n), y;
1837 176563 : pari_sp av = avma;
1838 : long k, kmin, kmax;
1839 :
1840 176563 : a = nf_to_scalar_or_basis(nf,a);
1841 176563 : if (index)
1842 : {
1843 59416 : kmin = kmax = index;
1844 59416 : y = y0 + S->ind[index];
1845 : }
1846 : else
1847 : {
1848 117147 : kmin = 1; kmax = lg(S->P)-1;
1849 117147 : y = y0;
1850 : }
1851 176563 : if (!sgn) sgn = nfsign_arch(nf, a, S->archp);
1852 378988 : for (k = kmin; k <= kmax; k++)
1853 : {
1854 202432 : GEN L = gel(S->sprk,k), pr = gel(S->P,k);
1855 202432 : GEN prk = idealpow(nf, pr, gel(S->e,k));
1856 202432 : y = zlog_pk(nf, a, y, pr, prk, L, &sgn);
1857 : }
1858 176556 : zlog_add_sign(y0, sgn, S->sarch);
1859 176556 : return gerepilecopy(av, y0);
1860 : }
1861 : /* sgn = sign(a, S->arch) or NULL if unknown */
1862 : GEN
1863 117147 : zlog(GEN nf, GEN a, GEN sgn, zlog_S *S) { return zlog_ind(nf, a, S, sgn, 0); }
1864 :
1865 : /* Log on bid.gen of generators of P_{1,I pr^{e-1}} / P_{1,I pr^e} (I,pr) = 1,
1866 : * defined implicitly via CRT. 'index' is the index of pr in modulus
1867 : * factorization */
1868 : GEN
1869 9989 : log_gen_pr(zlog_S *S, long index, GEN nf, long e)
1870 : {
1871 9989 : long i, l, yind = S->ind[index];
1872 9989 : GEN y, A, L, L2 = gel(S->sprk,index);
1873 :
1874 9989 : if (e == 1)
1875 : {
1876 6839 : L = gel(L2,1);
1877 6839 : y = col_ei(S->n, yind+1);
1878 6839 : zlog_add_sign(y, gmael(L,4,1), S->sarch);
1879 6839 : retmkmat( ZM_ZC_mul(S->U, y) );
1880 : }
1881 : else
1882 : {
1883 3150 : GEN prk, g, pr = gel(S->P,index);
1884 3150 : long narchp = lg(S->archp)-1;
1885 :
1886 3150 : if (e == 2)
1887 1960 : L = gel(L2,2);
1888 : else
1889 1190 : L = zidealij(idealpows(nf,pr,e-1), idealpows(nf,pr,e), NULL);
1890 3150 : g = gel(L,2);
1891 3150 : l = lg(g); A = cgetg(l, t_MAT);
1892 3150 : prk = idealpow(nf, pr, gel(S->e,index));
1893 6972 : for (i = 1; i < l; i++)
1894 : {
1895 3822 : GEN G = gel(g,i), sgn = zero_zv(narchp); /*positive at f_oo*/
1896 3822 : y = zerocol(S->n);
1897 3822 : (void)zlog_pk(nf, G, y + yind, pr, prk, L2, &sgn);
1898 3822 : zlog_add_sign(y, sgn, S->sarch);
1899 3822 : gel(A,i) = y;
1900 : }
1901 3150 : return ZM_mul(S->U, A);
1902 : }
1903 : }
1904 : /* Log on bid.gen of generator of P_{1,f} / P_{1,f v[index]}
1905 : * v = vector of r1 real places */
1906 : GEN
1907 6272 : log_gen_arch(zlog_S *S, long index)
1908 : {
1909 6272 : GEN y = zerocol(S->n);
1910 6272 : zlog_add_sign(y, vecsmall_ei(lg(S->archp)-1, index), S->sarch);
1911 6272 : return ZM_ZC_mul(S->U, y);
1912 : }
1913 :
1914 : /* add [h,cyc] or [h,cyc,gen] to bid */
1915 : static void
1916 13734 : add_grp(GEN nf, GEN u1, GEN cyc, GEN gen, GEN bid)
1917 : {
1918 13734 : GEN h = ZV_prod(cyc);
1919 13734 : if (u1)
1920 : {
1921 7497 : GEN G = mkvec3(h,cyc,NULL/*dummy, bid[2] needed below*/);
1922 7497 : gel(bid,2) = G;
1923 7497 : if (u1 != gen_1)
1924 : {
1925 5971 : long i, c = lg(u1);
1926 5971 : GEN g = cgetg(c,t_VEC);
1927 18557 : for (i=1; i<c; i++)
1928 12586 : gel(g,i) = famat_to_nf_moddivisor(nf, gen, gel(u1,i), bid);
1929 5971 : gen = g;
1930 : }
1931 7497 : gel(G,3) = gen; /* replace dummy */
1932 : }
1933 : else
1934 6237 : gel(bid,2) = mkvec2(h,cyc);
1935 13734 : }
1936 :
1937 : /* Compute [[ideal,arch], [h,[cyc],[gen]], idealfact, [liste], U]
1938 : flag may include nf_GEN | nf_INIT */
1939 : static GEN
1940 13440 : Idealstar_i(GEN nf, GEN ideal, long flag)
1941 : {
1942 : long i, j, k, nbp, R1, nbgen;
1943 13440 : GEN t, y, cyc, U, u1 = NULL, fa, sprk, x, arch, archp, E, P, sarch, gen, ind;
1944 :
1945 13440 : nf = checknf(nf);
1946 13440 : R1 = nf_get_r1(nf);
1947 13440 : if (typ(ideal) == t_VEC && lg(ideal) == 3)
1948 : {
1949 5376 : arch = gel(ideal,2);
1950 5376 : ideal= gel(ideal,1);
1951 5376 : switch(typ(arch))
1952 : {
1953 : case t_VEC:
1954 5341 : if (lg(arch) != R1+1)
1955 0 : pari_err_TYPE("Idealstar [incorrect archimedean component]",arch);
1956 5341 : archp = vec01_to_indices(arch);
1957 5341 : break;
1958 : case t_VECSMALL:
1959 35 : archp = arch;
1960 35 : k = lg(archp)-1;
1961 35 : if (k && archp[k] > R1)
1962 7 : pari_err_TYPE("Idealstar [incorrect archimedean component]",arch);
1963 28 : arch = indices_to_vec01(archp, R1);
1964 28 : break;
1965 : default:
1966 0 : pari_err_TYPE("Idealstar [incorrect archimedean component]",arch);
1967 0 : return NULL;
1968 : }
1969 5369 : }
1970 : else
1971 : {
1972 8064 : arch = zerovec(R1);
1973 8064 : archp = cgetg(1, t_VECSMALL);
1974 : }
1975 13433 : if (is_nf_factor(ideal))
1976 : {
1977 6286 : fa = ideal;
1978 6286 : x = idealfactorback(nf, gel(fa,1), gel(fa,2), 0);
1979 : }
1980 : else
1981 : {
1982 7147 : fa = NULL;
1983 7147 : x = idealhnf_shallow(nf, ideal);
1984 : }
1985 13433 : if (lg(x) == 1) pari_err_DOMAIN("Idealstar", "ideal","=",gen_0,x);
1986 13426 : if (typ(gcoeff(x,1,1)) != t_INT)
1987 7 : pari_err_DOMAIN("Idealstar","denominator(ideal)", "!=",gen_1,x);
1988 13419 : sarch = nfarchstar(nf, x, archp);
1989 13419 : if (!fa) fa = idealfactor(nf, ideal);
1990 13419 : P = gel(fa,1);
1991 13419 : E = gel(fa,2); nbp = lg(P)-1;
1992 13419 : sprk = cgetg(nbp+1,t_VEC);
1993 13419 : if (nbp)
1994 : {
1995 : GEN h;
1996 11837 : long cp = 0;
1997 : zlog_S S;
1998 :
1999 : /* rough upper bound */
2000 11837 : nbgen = nbp + 1; for (i=1; i<=nbp; i++) nbgen += itos(gel(E,i));
2001 11837 : gen = cgetg(nbgen+1,t_VEC);
2002 11837 : nbgen = 1;
2003 11837 : t = (nbp==1)? NULL: x;
2004 25018 : for (i=1; i<=nbp; i++)
2005 : {
2006 13181 : GEN L = zprimestar(nf, gel(P,i), gel(E,i), t, archp);
2007 13181 : gel(sprk,i) = L;
2008 13181 : for (j = 1; j < lg(L); j++) gel(gen, nbgen++) = gmael(L,j,3);
2009 : }
2010 11837 : gel(gen, nbgen++) = gel(sarch,2); setlg(gen, nbgen);
2011 11837 : gen = shallowconcat1(gen); nbgen = lg(gen)-1;
2012 :
2013 11837 : h = cgetg(nbgen+1,t_MAT);
2014 11837 : ind = get_index(sprk);
2015 11837 : init_zlog(&S, nbgen, P, E, sprk, sarch, ind, NULL);
2016 25018 : for (i=1; i<=nbp; i++)
2017 : {
2018 13181 : GEN L2 = gel(sprk,i);
2019 38283 : for (j=1; j < lg(L2); j++)
2020 : {
2021 25102 : GEN L = gel(L2,j), F = gel(L,1), G = gel(L,3);
2022 84518 : for (k=1; k<lg(G); k++)
2023 : { /* log(g^f) mod divisor */
2024 59416 : GEN g = gel(G,k), f = gel(F,k), a = nfpowmodideal(nf,g,f,x);
2025 129997 : GEN sgn = mpodd(f)? nfsign_arch(nf, g, S.archp)
2026 70581 : : zero_zv(lg(S.archp)-1);
2027 59416 : gel(h,++cp) = ZC_neg(zlog_ind(nf, a, &S, sgn, i));
2028 59416 : gcoeff(h,cp,cp) = f;
2029 : }
2030 : }
2031 : }
2032 16604 : for (j=1; j<lg(archp); j++)
2033 : {
2034 4767 : gel(h,++cp) = zerocol(nbgen);
2035 4767 : gcoeff(h,cp,cp) = gen_2;
2036 : }
2037 : /* assert(cp == nbgen) */
2038 11837 : h = ZM_hnfall_i(h,NULL,0);
2039 11837 : cyc = ZM_snf_group(h, &U, (flag & nf_GEN)? &u1: NULL);
2040 : }
2041 : else
2042 : {
2043 1582 : ind = get_index(sprk);
2044 1582 : gen = gel(sarch,2); nbgen = lg(gen)-1;
2045 1582 : cyc = const_vec(nbgen, gen_2);
2046 1582 : U = matid(nbgen);
2047 1582 : if (flag & nf_GEN) u1 = gen_1;
2048 : }
2049 :
2050 13419 : y = cgetg(6,t_VEC);
2051 13419 : gel(y,1) = mkvec2(x, arch);
2052 13419 : gel(y,3) = fa;
2053 13419 : gel(y,4) = mkvec3(sprk, sarch, ind);
2054 13419 : gel(y,5) = U;
2055 13419 : add_grp(nf, u1, cyc, gen, y);
2056 13419 : return (flag & nf_INIT)? y: gel(y,2);
2057 : }
2058 : GEN
2059 7553 : Idealstar(GEN nf, GEN ideal, long flag)
2060 : {
2061 : pari_sp av;
2062 7553 : if (!nf) return ZNstar(ideal, flag);
2063 7273 : av = avma;
2064 7273 : return gerepilecopy(av, Idealstar_i(nf, ideal, flag));
2065 : }
2066 : GEN
2067 6167 : Idealstarprk(GEN nf, GEN pr, long k, long flag)
2068 : {
2069 6167 : pari_sp av = avma;
2070 6167 : GEN z = Idealstar_i(nf, mkmat2(mkcol(pr),mkcols(k)), flag);
2071 6167 : return gerepilecopy(av, z);
2072 : }
2073 :
2074 : /* vectors of [[cyc],[g],U.X^-1] */
2075 : static GEN
2076 238 : principal_units(GEN nf, GEN pr, long e, GEN pre)
2077 : {
2078 238 : pari_sp av = avma;
2079 : long a;
2080 : GEN list, prb;
2081 : ulong mask;
2082 :
2083 238 : if(DEBUGLEVEL>3) err_printf("treating pr^%ld, pr = %Ps\n",e,pr);
2084 238 : if (e == 1) return cgetg(1, t_VEC);
2085 238 : prb = idealhnf_two(nf,pr);
2086 238 : list = vectrunc_init(e);
2087 238 : mask = quadratic_prec_mask(e);
2088 238 : a = 1;
2089 847 : while (mask > 1)
2090 : {
2091 371 : GEN pra = prb, z, U;
2092 371 : long b = a << 1;
2093 :
2094 371 : if (mask & 1) b--;
2095 371 : mask >>= 1;
2096 : /* compute 1 + pr^a / 1 + pr^b, 2a <= b */
2097 371 : if(DEBUGLEVEL>3) err_printf(" treating a = %ld, b = %ld\n",a,b);
2098 371 : prb = (b >= e)? pre: idealpows(nf,pr,b);
2099 371 : z = zidealij(pra, prb, &U);
2100 371 : vectrunc_append(list, mkvec3(gel(z,1),gel(z,2),U));
2101 371 : a = b;
2102 : }
2103 238 : return gerepilecopy(av, list);
2104 : }
2105 :
2106 : static GEN
2107 630 : log_prk(GEN nf, GEN a, long nbgen, GEN list, GEN prk)
2108 : {
2109 630 : GEN y = zerocol(nbgen);
2110 630 : long i,j, iy = 1, llist = lg(list)-1;
2111 :
2112 1792 : for (j = 1; j <= llist; j++)
2113 : {
2114 1162 : GEN L = gel(list,j);
2115 1162 : GEN cyc = gel(L,1), gen = gel(L,2), U = gel(L,3);
2116 1162 : GEN e = apply_U(U, a);
2117 : /* here lg(e) == lg(cyc) */
2118 3906 : for (i = 1; i < lg(cyc); i++)
2119 : {
2120 2744 : GEN t = modii(negi(gel(e,i)), gel(cyc,i));
2121 2744 : gel(y, iy++) = negi(t); if (!signe(t)) continue;
2122 280 : if (j != llist) a = elt_mulpow_modideal(nf, a, gel(gen,i), t, prk);
2123 : }
2124 : }
2125 630 : return y;
2126 : }
2127 :
2128 : /* multiplicative group (1 + pr) / (1 + pr^e) */
2129 : GEN
2130 238 : idealprincipalunits(GEN nf, GEN pr, long e)
2131 : {
2132 238 : pari_sp av = avma;
2133 : long c, i, j, k, nbgen;
2134 238 : GEN cyc, u1 = NULL, pre, gen;
2135 : GEN g, EX, h, L2;
2136 238 : long cp = 0;
2137 :
2138 238 : nf = checknf(nf); pre = idealpows(nf, pr, e);
2139 238 : L2 = principal_units(nf, pr, e, pre);
2140 238 : c = lg(L2); gen = cgetg(c, t_VEC);
2141 238 : for (j = 1; j < c; j++) gel(gen, j) = gmael(L2,j,2);
2142 238 : gen = shallowconcat1(gen); nbgen = lg(gen)-1;
2143 :
2144 238 : h = cgetg(nbgen+1,t_MAT);
2145 609 : for (j=1; j < lg(L2); j++)
2146 : {
2147 371 : GEN L = gel(L2,j), F = gel(L,1), G = gel(L,2);
2148 1001 : for (k=1; k<lg(G); k++)
2149 : { /* log(g^f) mod pr^e */
2150 630 : GEN g = gel(G,k), f = gel(F,k), a = nfpowmodideal(nf,g,f,pre);
2151 630 : gel(h,++cp) = ZC_neg(log_prk(nf, a, nbgen, L2, pre));
2152 630 : gcoeff(h,cp,cp) = f;
2153 : }
2154 : }
2155 : /* assert(cp == nbgen) */
2156 238 : h = ZM_hnfall_i(h,NULL,0);
2157 238 : cyc = ZM_snf_group(h, NULL, &u1);
2158 238 : c = lg(u1); g = cgetg(c, t_VEC); EX = gel(cyc,1);
2159 679 : for (i=1; i<c; i++)
2160 441 : gel(g,i) = famat_to_nf_modideal_coprime(nf, gen, gel(u1,i), pre, EX);
2161 238 : return gerepilecopy(av, mkvec3(powiu(pr_norm(pr), e-1), cyc, g));
2162 : }
2163 :
2164 : /* FIXME: obsolete */
2165 : GEN
2166 0 : zidealstarinitgen(GEN nf, GEN ideal)
2167 0 : { return Idealstar(nf,ideal, nf_INIT|nf_GEN); }
2168 : GEN
2169 0 : zidealstarinit(GEN nf, GEN ideal)
2170 0 : { return Idealstar(nf,ideal, nf_INIT); }
2171 : GEN
2172 0 : zidealstar(GEN nf, GEN ideal)
2173 0 : { return Idealstar(nf,ideal, nf_GEN); }
2174 :
2175 : GEN
2176 350 : idealstar0(GEN nf, GEN ideal,long flag)
2177 : {
2178 350 : switch(flag)
2179 : {
2180 0 : case 0: return Idealstar(nf,ideal, nf_GEN);
2181 315 : case 1: return Idealstar(nf,ideal, nf_INIT);
2182 35 : case 2: return Idealstar(nf,ideal, nf_INIT|nf_GEN);
2183 0 : default: pari_err_FLAG("idealstar");
2184 : }
2185 0 : return NULL; /* not reached */
2186 : }
2187 :
2188 : void
2189 143613 : check_nfelt(GEN x, GEN *den)
2190 : {
2191 143613 : long l = lg(x), i;
2192 143613 : GEN t, d = NULL;
2193 143613 : if (typ(x) != t_COL) pari_err_TYPE("check_nfelt", x);
2194 596704 : for (i=1; i<l; i++)
2195 : {
2196 453091 : t = gel(x,i);
2197 453091 : switch (typ(t))
2198 : {
2199 351078 : case t_INT: break;
2200 : case t_FRAC:
2201 102013 : if (!d) d = gel(t,2); else d = lcmii(d, gel(t,2));
2202 102013 : break;
2203 0 : default: pari_err_TYPE("check_nfelt", x);
2204 : }
2205 : }
2206 143613 : *den = d;
2207 143613 : }
2208 :
2209 : GEN
2210 415398 : vecmodii(GEN a, GEN b)
2211 : {
2212 : long i, l;
2213 415398 : GEN c = cgetg_copy(a, &l);
2214 415398 : for (i = 1; i < l; i++) gel(c,i) = modii(gel(a,i), gel(b,i));
2215 415398 : return c;
2216 : }
2217 :
2218 : /* Given x (not necessarily integral), and bid as output by zidealstarinit,
2219 : * compute the vector of components on the generators bid[2].
2220 : * Assume (x,bid) = 1 and sgn is either NULL or nfsign_arch(x, bid) */
2221 : GEN
2222 200370 : ideallog_sgn(GEN nf, GEN x, GEN sgn, GEN bid)
2223 : {
2224 : pari_sp av;
2225 : long lcyc;
2226 : GEN den, cyc, y;
2227 :
2228 200370 : nf = checknf(nf); checkbid(bid);
2229 200363 : cyc = bid_get_cyc(bid);
2230 200363 : lcyc = lg(cyc); if (lcyc == 1) return cgetg(1, t_COL);
2231 200335 : av = avma;
2232 200335 : if (typ(x) == t_MAT) {
2233 48371 : if (lg(x) == 1) return zerocol(lcyc-1); /* x = 1 */
2234 48371 : y = famat_zlog(nf, x, sgn, bid);
2235 48371 : goto END;
2236 : }
2237 151964 : x = nf_to_scalar_or_basis(nf, x);
2238 151964 : switch(typ(x))
2239 : {
2240 : case t_INT:
2241 8344 : den = NULL;
2242 8344 : break;
2243 : case t_FRAC:
2244 7 : den = gel(x,2);
2245 7 : x = gel(x,1);
2246 7 : break;
2247 : default: /* case t_COL: */
2248 143613 : check_nfelt(x, &den);
2249 143613 : if (den) x = Q_muli_to_int(x, den);
2250 : }
2251 151964 : if (den)
2252 : {
2253 47326 : x = mkmat2(mkcol2(x, den), mkcol2(gen_1, gen_m1));
2254 47326 : y = famat_zlog(nf, x, sgn, bid);
2255 : }
2256 : else
2257 : {
2258 104638 : zlog_S S; init_zlog_bid(&S, bid);
2259 104638 : y = zlog(nf, x, sgn, &S);
2260 : }
2261 : END:
2262 200328 : y = ZM_ZC_mul(bid_get_U(bid), y);
2263 200328 : return gerepileupto(av, vecmodii(y, cyc));
2264 : }
2265 : GEN
2266 207076 : ideallog(GEN nf, GEN x, GEN bid)
2267 : {
2268 207076 : if (!nf) return Zideallog(bid, x);
2269 200370 : return ideallog_sgn(nf, x, NULL, bid);
2270 : }
2271 :
2272 : /*************************************************************************/
2273 : /** **/
2274 : /** JOIN BID STRUCTURES, IDEAL LISTS **/
2275 : /** **/
2276 : /*************************************************************************/
2277 :
2278 : /* bid1, bid2: for coprime modules m1 and m2 (without arch. part).
2279 : * Output: bid [[m1 m2,arch],[h,[cyc],[gen]],idealfact,[liste],U] for m1 m2 */
2280 : static GEN
2281 476 : join_bid(GEN nf, GEN bid1, GEN bid2)
2282 : {
2283 476 : pari_sp av = avma;
2284 : long nbgen, l1,l2;
2285 : GEN I1,I2, G1,G2, fa1,fa2, sprk1,sprk2, cyc1,cyc2;
2286 476 : GEN sprk, fa, U, cyc, y, u1 = NULL, x, gen;
2287 :
2288 476 : I1 = bid_get_ideal(bid1);
2289 476 : I2 = bid_get_ideal(bid2);
2290 476 : if (gequal1(gcoeff(I1,1,1))) return bid2; /* frequent trivial case */
2291 259 : G1 = bid_get_grp(bid1);
2292 259 : G2 = bid_get_grp(bid2);
2293 259 : fa1= bid_get_fact(bid1);
2294 259 : fa2= bid_get_fact(bid2); x = idealmul(nf, I1,I2);
2295 259 : fa = famat_mul_shallow(fa1, fa2);
2296 259 : sprk1 = bid_get_sprk(bid1);
2297 259 : sprk2 = bid_get_sprk(bid2);
2298 259 : sprk = shallowconcat(sprk1, sprk2);
2299 :
2300 259 : cyc1 = abgrp_get_cyc(G1); l1 = lg(cyc1);
2301 259 : cyc2 = abgrp_get_cyc(G2); l2 = lg(cyc2);
2302 259 : gen = (lg(G1)>3 && lg(G2)>3)? gen_1: NULL;
2303 259 : nbgen = l1+l2-2;
2304 259 : cyc = ZV_snf_group(shallowconcat(cyc1,cyc2), &U, gen? &u1: NULL);
2305 259 : if (nbgen) {
2306 259 : GEN U1 = bid_get_U(bid1), U2 = bid_get_U(bid2);
2307 259 : U1 = l1 == 1? zeromat(nbgen,lg(U1)-1): ZM_mul(vecslice(U, 1, l1-1), U1);
2308 259 : U2 = l2 == 1? zeromat(nbgen,lg(U2)-1): ZM_mul(vecslice(U, l1, nbgen), U2);
2309 259 : U = shallowconcat(U1, U2);
2310 : }
2311 : else
2312 0 : U = zeromat(0, lg(sprk)-1);
2313 :
2314 259 : if (gen)
2315 : {
2316 259 : GEN uv = zkchinese1init2(nf, I2, I1, x);
2317 518 : gen = shallowconcat(zkVchinese1(gel(uv,1), abgrp_get_gen(G1)),
2318 259 : zkVchinese1(gel(uv,2), abgrp_get_gen(G2)));
2319 : }
2320 259 : y = cgetg(6,t_VEC);
2321 259 : gel(y,1) = mkvec2(x, bid_get_arch(bid1));
2322 259 : gel(y,3) = fa;
2323 259 : gel(y,4) = mkvec3(sprk, bid_get_sarch(bid1), get_index(sprk));
2324 259 : gel(y,5) = U;
2325 259 : add_grp(nf, u1, cyc, gen, y);
2326 259 : return gerepilecopy(av,y);
2327 : }
2328 :
2329 : typedef struct _ideal_data {
2330 : GEN nf, emb, L, pr, prL, arch, sgnU;
2331 : } ideal_data;
2332 :
2333 : /* z <- ( z | f(v[i])_{i=1..#v} ) */
2334 : static void
2335 43414 : concat_join(GEN *pz, GEN v, GEN (*f)(ideal_data*,GEN), ideal_data *data)
2336 : {
2337 43414 : long i, nz, lv = lg(v);
2338 : GEN z, Z;
2339 86828 : if (lv == 1) return;
2340 18942 : z = *pz; nz = lg(z)-1;
2341 18942 : *pz = Z = cgetg(lv + nz, typ(z));
2342 18942 : for (i = 1; i <=nz; i++) gel(Z,i) = gel(z,i);
2343 18942 : Z += nz;
2344 18942 : for (i = 1; i < lv; i++) gel(Z,i) = f(data, gel(v,i));
2345 : }
2346 : static GEN
2347 476 : join_idealinit(ideal_data *D, GEN x) {
2348 476 : return join_bid(D->nf, x, D->prL);
2349 : }
2350 : static GEN
2351 26222 : join_ideal(ideal_data *D, GEN x) {
2352 26222 : return idealmulpowprime(D->nf, x, D->pr, D->L);
2353 : }
2354 : static GEN
2355 455 : join_unit(ideal_data *D, GEN x) {
2356 455 : return mkvec2(join_idealinit(D, gel(x,1)), vconcat(gel(x,2), D->emb));
2357 : }
2358 :
2359 : /* compute matrix of zlogs of units; sgnU = vector of signs of units at
2360 : * S.archp or NULL (S.archp empty) */
2361 : GEN
2362 434 : zlog_units(GEN nf, GEN U, GEN sgnU, GEN bid)
2363 : {
2364 434 : long j, l = lg(U);
2365 434 : GEN m = cgetg(l, t_MAT);
2366 434 : zlog_S S; init_zlog_bid(&S, bid);
2367 434 : if (lg(S.archp) == 1) sgnU = NULL;
2368 434 : if (sgnU)
2369 : {
2370 14 : sgnU = rowpermute(sgnU, S.archp);
2371 14 : for (j = 1; j < l; j++) gel(m,j) = zlog(nf, gel(U,j), gel(sgnU,j), &S);
2372 : }
2373 : else
2374 : {
2375 420 : GEN empty = cgetg(1, t_VECSMALL);
2376 420 : for (j = 1; j < l; j++) gel(m,j) = zlog(nf, gel(U,j), empty, &S);
2377 : }
2378 434 : return m;
2379 : }
2380 :
2381 : /* archimedean part of units zlog */
2382 : static GEN
2383 28 : zlog_unitsarch(GEN sgnU, GEN bid)
2384 : {
2385 28 : GEN sarch = bid_get_sarch(bid);
2386 28 : GEN m = rowpermute(sgnU, gel(sarch,4));
2387 28 : return Flm_mul(gel(sarch,3), m, 2);
2388 : }
2389 :
2390 : /* flag & nf_GEN : generators, otherwise no
2391 : * flag &2 : units, otherwise no
2392 : * flag &4 : ideals in HNF, otherwise bid */
2393 : static GEN
2394 350 : Ideallist(GEN bnf, ulong bound, long flag)
2395 : {
2396 350 : const long do_units = flag & 2, big_id = !(flag & 4);
2397 350 : const long istar_flag = (flag & nf_GEN) | nf_INIT;
2398 350 : pari_sp av, av0 = avma;
2399 : long i, j, l;
2400 350 : GEN nf, z, p, fa, id, BOUND, U, empty = cgetg(1,t_VEC);
2401 : forprime_t S;
2402 : ideal_data ID;
2403 350 : GEN (*join_z)(ideal_data*, GEN) =
2404 : do_units? &join_unit
2405 350 : : (big_id? &join_idealinit: &join_ideal);
2406 :
2407 350 : nf = checknf(bnf);
2408 350 : if ((long)bound <= 0) return empty;
2409 350 : id = matid(nf_get_degree(nf));
2410 350 : if (big_id) id = Idealstar(nf,id, istar_flag);
2411 :
2412 : /* z[i] will contain all "objects" of norm i. Depending on flag, this means
2413 : * an ideal, a bid, or a couple [bid, log(units)]. Such objects are stored
2414 : * in vectors, computed one primary component at a time; join_z
2415 : * reconstructs the global object */
2416 350 : BOUND = utoipos(bound);
2417 350 : z = cgetg(bound+1,t_VEC);
2418 350 : if (do_units) {
2419 14 : U = bnf_build_units(bnf);
2420 14 : gel(z,1) = mkvec( mkvec2(id, zlog_units(nf, U, NULL, id)) );
2421 : } else {
2422 336 : U = NULL; /* -Wall */
2423 336 : gel(z,1) = mkvec(id);
2424 : }
2425 350 : for (i=2; i<=(long)bound; i++) gel(z,i) = empty;
2426 350 : ID.nf = nf;
2427 :
2428 350 : p = cgetipos(3);
2429 350 : u_forprime_init(&S, 2, bound);
2430 350 : av = avma;
2431 5726 : while ((p[2] = u_forprime_next(&S)))
2432 : {
2433 5026 : if (DEBUGLEVEL>1) { err_printf("%ld ",p[2]); err_flush(); }
2434 5026 : fa = idealprimedec_limit_norm(nf, p, BOUND);
2435 10073 : for (j=1; j<lg(fa); j++)
2436 : {
2437 5047 : GEN pr = gel(fa,j), z2;
2438 5047 : ulong q, Q = upr_norm(pr);
2439 :
2440 5047 : z2 = leafcopy(z);
2441 5047 : q = Q;
2442 5047 : ID.pr = ID.prL = pr;
2443 13370 : for (l=1; Q <= bound; l++, Q *= q) /* add pr^l */
2444 : {
2445 : ulong iQ;
2446 8323 : ID.L = utoipos(l);
2447 8323 : if (big_id) {
2448 217 : ID.prL = Idealstarprk(nf, pr, l, istar_flag);
2449 217 : if (do_units) ID.emb = zlog_units(nf, U, NULL, ID.prL);
2450 : }
2451 51737 : for (iQ = Q,i = 1; iQ <= bound; iQ += Q,i++)
2452 43414 : concat_join(&gel(z,iQ), gel(z2,i), join_z, &ID);
2453 : }
2454 : }
2455 5026 : if (gc_needed(av,1))
2456 : {
2457 0 : if(DEBUGMEM>1) pari_warn(warnmem,"Ideallist");
2458 0 : z = gerepilecopy(av, z);
2459 : }
2460 : }
2461 763 : if (do_units) for (i = 1; i < lg(z); i++)
2462 : {
2463 413 : GEN s = gel(z,i);
2464 413 : long l = lg(s);
2465 882 : for (j = 1; j < l; j++) {
2466 469 : GEN v = gel(s,j), bid = gel(v,1);
2467 469 : gel(v,2) = ZM_mul(bid_get_U(bid), gel(v,2));
2468 : }
2469 : }
2470 350 : return gerepilecopy(av0, z);
2471 : }
2472 : GEN
2473 28 : ideallist0(GEN bnf,long bound, long flag) {
2474 28 : if (flag<0 || flag>4) pari_err_FLAG("ideallist");
2475 28 : return Ideallist(bnf,bound,flag);
2476 : }
2477 : GEN
2478 322 : ideallist(GEN bnf,long bound) { return Ideallist(bnf,bound,4); }
2479 :
2480 : /* bid1 = for module m1 (without arch. part), arch = archimedean part.
2481 : * Output: bid [[m1,arch],[h,[cyc],[gen]],idealfact,[liste],U] for m1.arch */
2482 : static GEN
2483 56 : join_bid_arch(GEN nf, GEN bid1, GEN arch)
2484 : {
2485 56 : pari_sp av = avma;
2486 : GEN G1, fa1, U;
2487 56 : GEN sprk, cyc, y, u1 = NULL, x, sarch, gen;
2488 :
2489 56 : checkbid(bid1);
2490 56 : G1 = bid_get_grp(bid1);
2491 56 : fa1= bid_get_fact(bid1);
2492 56 : x = bid_get_ideal(bid1);
2493 56 : sarch = nfarchstar(nf, x, arch);
2494 56 : sprk = bid_get_sprk(bid1);
2495 :
2496 56 : gen = (lg(G1)>3)? gen_1: NULL;
2497 56 : cyc = diagonal_shallow(shallowconcat(gel(G1,2), gel(sarch,1)));
2498 56 : cyc = ZM_snf_group(cyc, &U, gen? &u1: NULL);
2499 56 : if (gen) gen = shallowconcat(gel(G1,3), gel(sarch,2));
2500 56 : y = cgetg(6,t_VEC);
2501 56 : gel(y,1) = mkvec2(x, arch);
2502 56 : gel(y,3) = fa1;
2503 56 : gel(y,4) = mkvec3(sprk, sarch, get_index(sprk));
2504 56 : gel(y,5) = U;
2505 56 : add_grp(nf, u1, cyc, gen, y);
2506 56 : return gerepilecopy(av,y);
2507 : }
2508 : static GEN
2509 56 : join_arch(ideal_data *D, GEN x) {
2510 56 : return join_bid_arch(D->nf, x, D->arch);
2511 : }
2512 : static GEN
2513 28 : join_archunit(ideal_data *D, GEN x) {
2514 28 : GEN bid = join_arch(D, gel(x,1)), u = gel(x,2);
2515 28 : u = ZM_mul(bid_get_U(bid), vconcat(u, zm_to_ZM(zlog_unitsarch(D->sgnU,bid))));
2516 28 : return mkvec2(bid, u);
2517 : }
2518 :
2519 : /* L from ideallist, add archimedean part */
2520 : GEN
2521 14 : ideallistarch(GEN bnf, GEN L, GEN arch)
2522 : {
2523 : pari_sp av;
2524 14 : long i, j, l = lg(L), lz;
2525 : GEN v, z, V;
2526 : ideal_data ID;
2527 : GEN (*join_z)(ideal_data*, GEN);
2528 :
2529 14 : if (typ(L) != t_VEC) pari_err_TYPE("ideallistarch",L);
2530 14 : if (l == 1) return cgetg(1,t_VEC);
2531 14 : z = gel(L,1);
2532 14 : if (typ(z) != t_VEC) pari_err_TYPE("ideallistarch",z);
2533 14 : z = gel(z,1); /* either a bid or [bid,U] */
2534 14 : if (lg(z) == 3) { /* the latter: do units */
2535 7 : if (typ(z) != t_VEC) pari_err_TYPE("ideallistarch",z);
2536 7 : ID.sgnU = nfsign_units(bnf, NULL, 1);
2537 7 : join_z = &join_archunit;
2538 : } else
2539 7 : join_z = &join_arch;
2540 14 : ID.nf = checknf(bnf);
2541 14 : ID.arch = vec01_to_indices(arch);
2542 14 : av = avma; V = cgetg(l, t_VEC);
2543 70 : for (i = 1; i < l; i++)
2544 : {
2545 56 : z = gel(L,i); lz = lg(z);
2546 56 : gel(V,i) = v = cgetg(lz,t_VEC);
2547 56 : for (j=1; j<lz; j++) gel(v,j) = join_z(&ID, gel(z,j));
2548 : }
2549 14 : return gerepilecopy(av,V);
2550 : }
|
