Branch data Line data Source code
1 : : /* Copyright (C) 2000 The PARI group.
2 : :
3 : : This file is part of the PARI/GP package.
4 : :
5 : : PARI/GP is free software; you can redistribute it and/or modify it under the
6 : : terms of the GNU General Public License as published by the Free Software
7 : : Foundation. It is distributed in the hope that it will be useful, but WITHOUT
8 : : ANY WARRANTY WHATSOEVER.
9 : :
10 : : Check the License for details. You should have received a copy of it, along
11 : : with the package; see the file 'COPYING'. If not, write to the Free Software
12 : : Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
13 : :
14 : : /*******************************************************************/
15 : : /* */
16 : : /* BASIC NF OPERATIONS */
17 : : /* */
18 : : /*******************************************************************/
19 : : #include "pari.h"
20 : : #include "paripriv.h"
21 : :
22 : : /*******************************************************************/
23 : : /* */
24 : : /* OPERATIONS OVER NUMBER FIELD ELEMENTS. */
25 : : /* represented as column vectors over the integral basis */
26 : : /* */
27 : : /*******************************************************************/
28 : : static GEN
29 : 10704887 : get_tab(GEN nf, long *N)
30 : : {
31 [ + + ]: 10704887 : GEN tab = (typ(nf) == t_MAT)? nf: gel(nf,9);
32 : 10704887 : *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 : 441541622 : _mulii(GEN x, GEN y) {
38 [ + + ]: 1112231621 : return is_pm1(x)? (signe(x) < 0)? negi(y): y
39 [ + + ]: 670689999 : : mulii(x, y);
40 : : }
41 : :
42 : : GEN
43 : 1169 : tablemul_ei_ej(GEN M, long i, long j)
44 : : {
45 : : long N;
46 : 1169 : GEN tab = get_tab(M, &N);
47 : 1169 : 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 : 9100 : tablemul_ei(GEN M, GEN x, long i)
55 : : {
56 : : long j, k, N;
57 : : GEN v, tab;
58 : :
59 [ + + ]: 9100 : if (i==1) return gcopy(x);
60 : 7910 : tab = get_tab(M, &N);
61 [ - + ]: 7910 : if (typ(x) != t_COL) { v = zerocol(N); gel(v,i) = gcopy(x); return v; }
62 : 7910 : tab += (i-1)*N; v = cgetg(N+1,t_COL);
63 : : /* wi . x = [ sum_j tab[k,j] x[j] ]_k */
64 [ + + ]: 65562 : for (k=1; k<=N; k++)
65 : : {
66 : 57652 : pari_sp av = avma;
67 : 57652 : GEN s = gen_0;
68 [ + + ]: 492492 : for (j=1; j<=N; j++)
69 : : {
70 : 434840 : GEN c = gcoeff(tab,k,j);
71 [ + + ]: 434840 : if (!gequal0(c)) s = gadd(s, gmul(c, gel(x,j)));
72 : : }
73 : 57652 : gel(v,k) = gerepileupto(av,s);
74 : : }
75 : 9100 : return v;
76 : : }
77 : : /* as tablemul_ei, assume x a ZV of correct length */
78 : : GEN
79 : 9596926 : zk_ei_mul(GEN nf, GEN x, long i)
80 : : {
81 : : long j, k, N;
82 : : GEN v, tab;
83 : :
84 [ + + ]: 9596926 : if (i==1) return ZC_copy(x);
85 : 9596912 : tab = get_tab(nf, &N); tab += (i-1)*N;
86 : 9596912 : v = cgetg(N+1,t_COL);
87 [ + + ]: 73136788 : for (k=1; k<=N; k++)
88 : : {
89 : 63539876 : pari_sp av = avma;
90 : 63539876 : GEN s = gen_0;
91 [ + + ]: 786402144 : for (j=1; j<=N; j++)
92 : : {
93 : 722862268 : GEN c = gcoeff(tab,k,j);
94 [ + + ]: 722862268 : if (signe(c)) s = addii(s, _mulii(c, gel(x,j)));
95 : : }
96 : 63539876 : gel(v,k) = gerepileuptoint(av, s);
97 : : }
98 : 9596926 : return v;
99 : : }
100 : :
101 : : /* table of multiplication by wi in R[w1,..., wN] */
102 : : GEN
103 : 2357 : ei_multable(GEN TAB, long i)
104 : : {
105 : : long k,N;
106 : 2357 : GEN m, tab = get_tab(TAB, &N);
107 : 2357 : tab += (i-1)*N;
108 : 2357 : m = cgetg(N+1,t_MAT);
109 [ + + ]: 18193 : for (k=1; k<=N; k++) gel(m,k) = gel(tab,k);
110 : 2357 : return m;
111 : : }
112 : :
113 : : GEN
114 : 3561497 : zk_multable(GEN nf, GEN x)
115 : : {
116 : 3561497 : long i, l = lg(x);
117 : 3561497 : GEN mul = cgetg(l,t_MAT);
118 : 3561497 : gel(mul,1) = x; /* assume w_1 = 1 */
119 [ + + ]: 13099572 : for (i=2; i<l; i++) gel(mul,i) = zk_ei_mul(nf,x,i);
120 : 3561497 : return mul;
121 : : }
122 : : GEN
123 : 448 : multable(GEN M, GEN x)
124 : : {
125 : : long i, N;
126 : : GEN mul;
127 [ + - ]: 448 : 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 : 448 : 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 : 15287621 : zk_scalar_or_multable(GEN nf, GEN x)
140 : : {
141 : 15287621 : long tx = typ(x);
142 [ + + ][ + + ]: 15287621 : if (tx == t_MAT || tx == t_INT) return x;
143 : 3205427 : x = nf_to_scalar_or_basis(nf, x);
144 [ + + ]: 15287621 : 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 : 21 : 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 : 224 : rnfelttrace(GEN rnf, GEN x)
159 : : {
160 : 224 : pari_sp av = avma;
161 : 224 : checkrnf(rnf);
162 : 224 : x = rnfeltabstorel(rnf, x);
163 : 91 : x = (typ(x) == t_POLMOD)? rnfeltdown(rnf, gtrace(x))
164 [ + + ]: 224 : : gmulgs(x, rnf_get_degree(rnf));
165 : 133 : 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 : 10052 : nfnorm(GEN nf, GEN x)
181 : : {
182 : 10052 : pari_sp av = avma;
183 : 10052 : nf = checknf(nf);
184 [ + + ]: 10052 : if (typ(x) == t_MAT) return famat_norm(nf, x);
185 : 10045 : x = nf_to_scalar_or_alg(nf, x);
186 : 9590 : x = (typ(x) == t_POL)? RgXQ_norm(x, nf_get_pol(nf))
187 [ + + ]: 19635 : : gpowgs(x, nf_get_degree(nf));
188 : 10052 : return gerepileupto(av, x);
189 : : }
190 : :
191 : : GEN
192 : 224 : rnfeltnorm(GEN rnf, GEN x)
193 : : {
194 : 224 : pari_sp av = avma;
195 : 224 : checkrnf(rnf);
196 : 224 : x = rnfeltabstorel(rnf, x);
197 : 91 : x = (typ(x) == t_POLMOD)? rnfeltdown(rnf, gnorm(x))
198 [ + + ]: 224 : : gpowgs(x, rnf_get_degree(rnf));
199 : 133 : return gerepileupto(av, x);
200 : : }
201 : :
202 : : /* sum of x and y in nf */
203 : : GEN
204 : 23301 : nfadd(GEN nf, GEN x, GEN y)
205 : : {
206 : : GEN z;
207 : 23301 : pari_sp av = avma;
208 : :
209 : 23301 : nf = checknf(nf);
210 : 23301 : x = nf_to_scalar_or_basis(nf, x);
211 : 23301 : y = nf_to_scalar_or_basis(nf, y);
212 [ + + ]: 23301 : if (typ(x) != t_COL) {
213 [ + + ]: 6258 : if (typ(y) == t_COL) z = RgC_Rg_add(y, x);
214 : : else {
215 : 2507 : long N = nf_get_degree(nf);
216 : 2507 : z = zerocol(N); gel(z,1) = gadd(x,y);
217 : : }
218 : : } else {
219 [ + + ]: 17043 : if (typ(y) != t_COL) z = RgC_Rg_add(x, y);
220 : 6868 : else z = RgC_add(x, y);
221 : : }
222 : 23301 : return gerepileupto(av, z);
223 : : }
224 : :
225 : : /* product of x and y in nf */
226 : : GEN
227 : 156617 : nfmul(GEN nf, GEN x, GEN y)
228 : : {
229 : : GEN z;
230 : 156617 : pari_sp av = avma;
231 : :
232 [ + + ]: 156617 : if (x == y) return nfsqr(nf,x);
233 : :
234 : 156554 : nf = checknf(nf);
235 : 156554 : x = nf_to_scalar_or_basis(nf, x);
236 : 156470 : y = nf_to_scalar_or_basis(nf, y);
237 [ + + ]: 156470 : if (typ(x) != t_COL)
238 : : {
239 [ + + ]: 53870 : if (typ(y) == t_COL) z = RgC_Rg_mul(y, x);
240 : : else {
241 : 25112 : long N = nf_get_degree(nf);
242 : 25112 : z = zerocol(N); gel(z,1) = gmul(x,y);
243 : : }
244 : : }
245 : : else
246 : : {
247 [ + + ]: 102600 : if (typ(y) != t_COL) z = RgC_Rg_mul(x, y);
248 : : else {
249 : : GEN dx, dy;
250 : 66024 : x = Q_remove_denom(x, &dx);
251 : 66024 : y = Q_remove_denom(y, &dy);
252 : 66024 : z = nfmuli(nf,x,y);
253 : 66024 : dx = mul_denom(dx,dy);
254 [ + + ]: 66024 : if (dx) z = RgC_Rg_div(z, dx);
255 : : }
256 : : }
257 : 156533 : return gerepileupto(av, z);
258 : : }
259 : : /* square of x in nf */
260 : : GEN
261 : 7833 : nfsqr(GEN nf, GEN x)
262 : : {
263 : 7833 : pari_sp av = avma;
264 : : GEN z;
265 : :
266 : 7833 : nf = checknf(nf);
267 : 7833 : x = nf_to_scalar_or_basis(nf, x);
268 [ + + ]: 7833 : if (typ(x) != t_COL)
269 : : {
270 : 7168 : long N = nf_get_degree(nf);
271 : 7168 : z = zerocol(N); gel(z,1) = gsqr(x);
272 : : }
273 : : else
274 : : {
275 : : GEN dx;
276 : 665 : x = Q_remove_denom(x, &dx);
277 : 665 : z = nfsqri(nf,x);
278 [ + + ]: 665 : if (dx) z = RgC_Rg_div(z, sqri(dx));
279 : : }
280 : 7833 : return gerepileupto(av, z);
281 : : }
282 : :
283 : : GEN
284 : 203975 : nfC_nf_mul(GEN nf, GEN v, GEN x)
285 : : {
286 : : long tx, l, i;
287 : 203975 : GEN y, dx = NULL;
288 : :
289 : 203975 : x = nf_to_scalar_or_basis(nf, x);
290 : 203975 : tx = typ(x);
291 [ + + ]: 203975 : if (tx != t_COL) {
292 [ + + ]: 40528 : if (tx == t_INT)
293 : : {
294 : 39870 : long s = signe(x);
295 [ + + ]: 39870 : if (!s) return zerocol(lg(v)-1);
296 [ + + ][ + + ]: 37588 : if (is_pm1(x)) return s > 0? leafcopy(v): RgC_neg(v);
297 : : }
298 : 10851 : l = lg(v); y = cgetg(l, t_COL);
299 [ + + ]: 91122 : for (i=1; i < l; i++)
300 : : {
301 : 80271 : GEN c = gel(v,i);
302 [ + + ]: 80271 : if (typ(c) != t_COL) c = gmul(c, x); else c = RgC_Rg_mul(c, x);
303 : 80271 : gel(y,i) = c;
304 : : }
305 : : }
306 : : else
307 : : {
308 : 163447 : x = Q_remove_denom(x, &dx);
309 : 163447 : x = zk_multable(nf, x);
310 : 163447 : l = lg(v); y = cgetg(l, t_COL);
311 [ + + ]: 647203 : for (i=1; i < l; i++)
312 : : {
313 : 483756 : GEN c = gel(v,i);
314 [ + + ]: 483756 : if (typ(c)!=t_COL) {
315 [ + + ]: 72546 : if (!isintzero(c)) c = RgC_Rg_mul(gel(x,1), c);
316 : : } else {
317 : 411210 : c = RgM_RgC_mul(x,c);
318 [ + + ]: 411210 : if (QV_isscalar(c)) c = gel(c,1);
319 : : }
320 : 483756 : gel(y,i) = c;
321 : : }
322 : : }
323 [ + + ]: 203975 : return dx? RgC_Rg_div(y, dx): y;
324 : : }
325 : : static GEN
326 : 2541 : mulbytab(GEN M, GEN c)
327 [ + + ]: 2541 : { return typ(c) == t_COL? RgM_RgC_mul(M,c): RgC_Rg_mul(gel(M,1), c); }
328 : : GEN
329 : 448 : tablemulvec(GEN M, GEN x, GEN v)
330 : : {
331 : : long l, i;
332 : : GEN y;
333 : :
334 [ - + ][ # # ]: 448 : if (typ(x) == t_COL && RgV_isscalar(x))
335 : : {
336 : 0 : x = gel(x,1);
337 [ # # ]: 0 : return typ(v) == t_POL? RgX_Rg_mul(v,x): RgV_Rg_mul(v,x);
338 : : }
339 : 448 : x = multable(M, x); /* multiplication table by x */
340 : 448 : y = cgetg_copy(v, &l);
341 [ + - ]: 448 : if (typ(v) == t_POL)
342 : : {
343 : 448 : y[1] = v[1];
344 [ + + ]: 2989 : for (i=2; i < l; i++) gel(y,i) = mulbytab(x, gel(v,i));
345 : 448 : y = normalizepol(y);
346 : : }
347 : : else
348 : : {
349 [ # # ]: 0 : for (i=1; i < l; i++) gel(y,i) = mulbytab(x, gel(v,i));
350 : : }
351 : 448 : return y;
352 : : }
353 : :
354 : : /* inverse of x in nf */
355 : : GEN
356 : 4627 : nfinv(GEN nf, GEN x)
357 : : {
358 : 4627 : pari_sp av = avma;
359 : : GEN T, z;
360 : :
361 : 4627 : nf = checknf(nf); T = nf_get_pol(nf);
362 : 4627 : x = nf_to_scalar_or_alg(nf, x);
363 [ + + ]: 4627 : if (typ(x) == t_POL)
364 : 3710 : z = poltobasis(nf, QXQ_inv(x, T));
365 : : else {
366 : 917 : z = zerocol(degpol(T)); gel(z,1) = ginv(x);
367 : : }
368 : 4627 : return gerepileupto(av, z);
369 : : }
370 : :
371 : : /* quotient of x and y in nf */
372 : : GEN
373 : 11114 : nfdiv(GEN nf, GEN x, GEN y)
374 : : {
375 : 11114 : pari_sp av = avma;
376 : : GEN T, z;
377 : :
378 : 11114 : nf = checknf(nf); T = nf_get_pol(nf);
379 : 11114 : y = nf_to_scalar_or_alg(nf, y);
380 [ + + ]: 10848 : if (typ(y) != t_POL) {
381 : 1971 : x = nf_to_scalar_or_basis(nf, x);
382 [ + + ]: 1971 : if (typ(x) == t_COL) z = RgC_Rg_div(x, y);
383 : : else {
384 : 938 : z = zerocol(degpol(T)); gel(z,1) = gdiv(x,y);
385 : : }
386 : : }
387 : : else
388 : : {
389 : 8877 : x = nf_to_scalar_or_alg(nf, x);
390 : 8835 : z = QXQ_inv(y, T);
391 [ + + ]: 8835 : z = (typ(x) == t_POL)? RgXQ_mul(z, x, T): RgX_Rg_mul(z, x);
392 : 8835 : z = poltobasis(nf, z);
393 : : }
394 : 10778 : return gerepileupto(av, z);
395 : : }
396 : :
397 : : /* product of INTEGERS (t_INT or ZC) x and y in nf
398 : : * compute xy as ( sum_i x_i sum_j y_j m^{i,j}_k )_k */
399 : : GEN
400 : 444943 : nfmuli(GEN nf, GEN x, GEN y)
401 : : {
402 : : long i, j, k, N;
403 : 444943 : GEN s, v, TAB = get_tab(nf, &N);
404 : :
405 [ + + ]: 444943 : if (typ(x) == t_INT)
406 : : {
407 [ + + ]: 90456 : if (typ(y) == t_INT) return scalarcol(mulii(x,y), N);
408 : 8496 : return ZC_Z_mul(y, x);
409 : : }
410 [ + + ]: 354487 : if (typ(y) == t_INT) return ZC_Z_mul(x, y);
411 : : /* both x and y are ZV */
412 : 328194 : v = cgetg(N+1,t_COL);
413 [ + + ]: 2160520 : for (k=1; k<=N; k++)
414 : : {
415 : 1832326 : pari_sp av = avma;
416 : 1832326 : GEN TABi = TAB;
417 [ + + ]: 1832326 : if (k == 1)
418 : 328194 : s = mulii(gel(x,1),gel(y,1));
419 : : else
420 : 1504132 : s = addii(mulii(gel(x,1),gel(y,k)),
421 : 3008264 : mulii(gel(x,k),gel(y,1)));
422 [ + + ]: 14771312 : for (i=2; i<=N; i++)
423 : : {
424 : 12938986 : GEN t, xi = gel(x,i);
425 : 12938986 : TABi += N;
426 [ + + ]: 12938986 : if (!signe(xi)) continue;
427 : :
428 : 8311980 : t = NULL;
429 [ + + ]: 110888316 : for (j=2; j<=N; j++)
430 : : {
431 : 102576336 : GEN p1, c = gcoeff(TABi, k, j); /* m^{i,j}_k */
432 [ + + ]: 102576336 : if (!signe(c)) continue;
433 : 43512043 : p1 = _mulii(c, gel(y,j));
434 [ + + ]: 43512043 : t = t? addii(t, p1): p1;
435 : : }
436 [ + + ]: 8311980 : if (t) s = addii(s, mulii(xi, t));
437 : : }
438 : 1832326 : gel(v,k) = gerepileuptoint(av,s);
439 : : }
440 : 444943 : return v;
441 : : }
442 : : /* square of INTEGER (t_INT or ZC) x in nf */
443 : : GEN
444 : 651596 : nfsqri(GEN nf, GEN x)
445 : : {
446 : : long i, j, k, N;
447 : 651596 : GEN s, v, TAB = get_tab(nf, &N);
448 : :
449 [ - + ]: 651596 : if (typ(x) == t_INT) return scalarcol(sqri(x), N);
450 : 651596 : v = cgetg(N+1,t_COL);
451 [ + + ]: 5372364 : for (k=1; k<=N; k++)
452 : : {
453 : 4720768 : pari_sp av = avma;
454 : 4720768 : GEN TABi = TAB;
455 [ + + ]: 4720768 : if (k == 1)
456 : 651596 : s = sqri(gel(x,1));
457 : : else
458 : 4069172 : s = shifti(mulii(gel(x,1),gel(x,k)), 1);
459 [ + + ]: 56073348 : for (i=2; i<=N; i++)
460 : : {
461 : 51352580 : GEN p1, c, t, xi = gel(x,i);
462 : 51352580 : TABi += N;
463 [ + + ]: 51352580 : if (!signe(xi)) continue;
464 : :
465 : 17566133 : c = gcoeff(TABi, k, i);
466 [ + + ]: 17566133 : t = signe(c)? _mulii(c,xi): NULL;
467 [ + + ]: 256110526 : for (j=i+1; j<=N; j++)
468 : : {
469 : 238544393 : c = gcoeff(TABi, k, j);
470 [ + + ]: 238544393 : if (!signe(c)) continue;
471 : 126591693 : p1 = _mulii(c, shifti(gel(x,j),1));
472 [ + + ]: 126591693 : t = t? addii(t, p1): p1;
473 : : }
474 [ + + ]: 17566133 : if (t) s = addii(s, mulii(xi, t));
475 : : }
476 : 4720768 : gel(v,k) = gerepileuptoint(av,s);
477 : : }
478 : 651596 : return v;
479 : : }
480 : :
481 : : /* both x and y are RgV */
482 : : GEN
483 : 0 : tablemul(GEN TAB, GEN x, GEN y)
484 : : {
485 : : long i, j, k, N;
486 : : GEN s, v;
487 [ # # ]: 0 : if (typ(x) != t_COL) return gmul(x, y);
488 [ # # ]: 0 : if (typ(y) != t_COL) return gmul(y, x);
489 : 0 : N = lg(x)-1;
490 : 0 : v = cgetg(N+1,t_COL);
491 [ # # ]: 0 : for (k=1; k<=N; k++)
492 : : {
493 : 0 : pari_sp av = avma;
494 : 0 : GEN TABi = TAB;
495 [ # # ]: 0 : if (k == 1)
496 : 0 : s = gmul(gel(x,1),gel(y,1));
497 : : else
498 : 0 : s = gadd(gmul(gel(x,1),gel(y,k)),
499 : 0 : gmul(gel(x,k),gel(y,1)));
500 [ # # ]: 0 : for (i=2; i<=N; i++)
501 : : {
502 : 0 : GEN t, xi = gel(x,i);
503 : 0 : TABi += N;
504 [ # # ]: 0 : if (gequal0(xi)) continue;
505 : :
506 : 0 : t = NULL;
507 [ # # ]: 0 : for (j=2; j<=N; j++)
508 : : {
509 : 0 : GEN p1, c = gcoeff(TABi, k, j); /* m^{i,j}_k */
510 [ # # ]: 0 : if (gequal0(c)) continue;
511 : 0 : p1 = gmul(c, gel(y,j));
512 [ # # ]: 0 : t = t? gadd(t, p1): p1;
513 : : }
514 [ # # ]: 0 : if (t) s = gadd(s, gmul(xi, t));
515 : : }
516 : 0 : gel(v,k) = gerepileupto(av,s);
517 : : }
518 : 0 : return v;
519 : : }
520 : : GEN
521 : 3017 : tablesqr(GEN TAB, GEN x)
522 : : {
523 : : long i, j, k, N;
524 : : GEN s, v;
525 : :
526 [ - + ]: 3017 : if (typ(x) != t_COL) return gsqr(x);
527 : 3017 : N = lg(x)-1;
528 : 3017 : v = cgetg(N+1,t_COL);
529 : :
530 [ + + ]: 25893 : for (k=1; k<=N; k++)
531 : : {
532 : 22876 : pari_sp av = avma;
533 : 22876 : GEN TABi = TAB;
534 [ + + ]: 22876 : if (k == 1)
535 : 3017 : s = gsqr(gel(x,1));
536 : : else
537 : 19859 : s = gmul2n(gmul(gel(x,1),gel(x,k)), 1);
538 [ + + ]: 177296 : for (i=2; i<=N; i++)
539 : : {
540 : 154420 : GEN p1, c, t, xi = gel(x,i);
541 : 154420 : TABi += N;
542 [ + + ]: 154420 : if (gequal0(xi)) continue;
543 : :
544 : 60816 : c = gcoeff(TABi, k, i);
545 [ + + ]: 60816 : t = !gequal0(c)? gmul(c,xi): NULL;
546 [ + + ]: 285964 : for (j=i+1; j<=N; j++)
547 : : {
548 : 225148 : c = gcoeff(TABi, k, j);
549 [ + + ]: 225148 : if (gequal0(c)) continue;
550 : 122157 : p1 = gmul(gmul2n(c,1), gel(x,j));
551 [ + + ]: 122157 : t = t? gadd(t, p1): p1;
552 : : }
553 [ + + ]: 60816 : if (t) s = gadd(s, gmul(xi, t));
554 : : }
555 : 22876 : gel(v,k) = gerepileupto(av,s);
556 : : }
557 : 3017 : return v;
558 : : }
559 : :
560 : : static GEN
561 : 45923 : _mul(void *data, GEN x, GEN y) { return nfmuli((GEN)data,x,y); }
562 : : static GEN
563 : 276541 : _sqr(void *data, GEN x) { return nfsqri((GEN)data,x); }
564 : :
565 : : /* Compute z^n in nf, left-shift binary powering */
566 : : GEN
567 : 221207 : nfpow(GEN nf, GEN z, GEN n)
568 : : {
569 : 221207 : pari_sp av = avma;
570 : : long s, N;
571 : : GEN x, cx, T;
572 : :
573 [ - + ]: 221207 : if (typ(n)!=t_INT) pari_err_TYPE("nfpow",n);
574 : 221207 : nf = checknf(nf); T = nf_get_pol(nf); N = degpol(T);
575 [ - + ]: 221207 : s = signe(n); if (!s) return scalarcol_shallow(gen_1,N);
576 : 221207 : x = nf_to_scalar_or_basis(nf, z);
577 [ + + ]: 221207 : if (typ(x) != t_COL) { GEN y = zerocol(N); gel(y,1) = powgi(x,n); return y; }
578 [ + + ]: 220736 : if (s < 0) { /* simplified nfinv */
579 : 1909 : x = nf_to_scalar_or_alg(nf, z);
580 : 1909 : x = poltobasis(nf, QXQ_inv(x, T));
581 : 1909 : n = absi(n);
582 : : }
583 : 220736 : x = primitive_part(x, &cx);
584 : 220736 : x = gen_pow(x, n, (void*)nf, _sqr, _mul);
585 [ + + ]: 220736 : if (cx) x = RgC_Rg_mul(x, powgi(cx, n));
586 [ - + ]: 221207 : return av==avma? gcopy(x): gerepileupto(av,x);
587 : : }
588 : : /* Compute z^n in nf, left-shift binary powering */
589 : : GEN
590 : 4248 : nfpow_u(GEN nf, GEN z, ulong n)
591 : : {
592 : 4248 : pari_sp av = avma;
593 : : long N;
594 : : GEN x, cx, T;
595 : :
596 : 4248 : nf = checknf(nf); T = nf_get_pol(nf); N = degpol(T);
597 [ - + ]: 4248 : if (!n) return scalarcol_shallow(gen_1,N);
598 : 4248 : x = nf_to_scalar_or_basis(nf, z);
599 [ + + ]: 4248 : if (typ(x) != t_COL) { GEN y = zerocol(N); gel(y,1) = powiu(x,n); return y; }
600 : 4108 : x = primitive_part(x, &cx);
601 : 4108 : x = gen_powu(x, n, (void*)nf, _sqr, _mul);
602 [ + + ]: 4108 : if (cx) x = RgC_Rg_mul(x, powgi(cx, utoipos(n)));
603 [ - + ]: 4248 : return av==avma? gcopy(x): gerepileupto(av,x);
604 : : }
605 : :
606 : : typedef struct {
607 : : GEN nf, p;
608 : : long I;
609 : : } eltmod_muldata;
610 : :
611 : : static GEN
612 : 122043 : sqr_mod(void *data, GEN x)
613 : : {
614 : 122043 : eltmod_muldata *D = (eltmod_muldata*)data;
615 : 122043 : return FpC_red(nfsqri(D->nf, x), D->p);
616 : : }
617 : : static GEN
618 : 57486 : ei_msqr_mod(void *data, GEN x)
619 : : {
620 : 57486 : GEN x2 = sqr_mod(data, x);
621 : 57486 : eltmod_muldata *D = (eltmod_muldata*)data;
622 : 57486 : return FpC_red(zk_ei_mul(D->nf, x2, D->I), D->p);
623 : : }
624 : :
625 : : /* x = I-th vector of the Z-basis of Z_K, in Z^n, compute lift(x^n mod p) */
626 : : GEN
627 : 82551 : pow_ei_mod_p(GEN nf, long I, GEN n, GEN p)
628 : : {
629 : 82551 : pari_sp av = avma;
630 : : eltmod_muldata D;
631 : : long s,N;
632 : : GEN y;
633 : :
634 [ - + ]: 82551 : if (typ(n) != t_INT) pari_err_TYPE("nfpow",n);
635 : 82551 : nf = checknf(nf); N = nf_get_degree(nf);
636 : 82551 : s = signe(n);
637 [ - + ]: 82551 : if (s < 0) pari_err_IMPL("negative power in pow_ei_mod_p");
638 [ + - ][ + + ]: 82551 : if (!s || I == 1) return scalarcol_shallow(gen_1,N);
639 : 69814 : D.nf = nf;
640 : 69814 : D.p = p;
641 : 69814 : D.I = I;
642 : 69814 : y = gen_pow_fold(col_ei(N, I), n, (void*)&D, &sqr_mod, &ei_msqr_mod);
643 : 82551 : return gerepileupto(av,y);
644 : : }
645 : :
646 : : /* valuation of integral x (ZV), with resp. to prime ideal pr */
647 : : long
648 : 12058276 : ZC_nfvalrem(GEN nf, GEN x, GEN pr, GEN *newx)
649 : : {
650 : : long i, v, l;
651 : 12058276 : GEN r, y, p = pr_get_p(pr), mul = zk_scalar_or_multable(nf, pr_get_tau(pr));
652 : :
653 : : /* p inert */
654 [ + + ][ + + ]: 12058276 : if (typ(mul) == t_INT) return newx? ZV_pvalrem(x, p, newx):ZV_pval(x, p);
655 : 12056274 : y = cgetg_copy(x, &l); /* will hold the new x */
656 : 12056274 : x = leafcopy(x);
657 : 12056274 : for(v=0;; v++)
658 : : {
659 [ + + ]: 55853451 : for (i=1; i<l; i++)
660 : : { /* is (x.b)[i] divisible by p ? */
661 : 50870342 : gel(y,i) = dvmdii(ZMrow_ZC_mul(mul,x,i),p,&r);
662 [ + + ][ + + ]: 50870342 : if (r != gen_0) { if (newx) *newx = x; return v; }
663 : : }
664 : 4983109 : swap(x, y);
665 : 17041385 : }
666 : : }
667 : : long
668 : 11808967 : ZC_nfval(GEN nf, GEN x, GEN P)
669 : 11808967 : { return ZC_nfvalrem(nf, x, P, NULL); }
670 : :
671 : : /* v_P(x) != 0, x a ZV. Simpler version of ZC_nfvalrem */
672 : : int
673 : 1848 : ZC_prdvd(GEN nf, GEN x, GEN P)
674 : : {
675 : 1848 : pari_sp av = avma;
676 : : long i, l;
677 : 1848 : GEN p = pr_get_p(P), mul = zk_scalar_or_multable(nf, pr_get_tau(P));
678 [ - + ]: 1848 : if (typ(mul) == t_INT) return ZV_Z_dvd(x, p);
679 : 1848 : l = lg(x);
680 [ + + ]: 8140 : for (i=1; i<l; i++)
681 [ + + ]: 7720 : if (remii(ZMrow_ZC_mul(mul,x,i), p) != gen_0) { avma = av; return 0; }
682 : 1848 : avma = av; return 1;
683 : : }
684 : :
685 : : int
686 : 28 : pr_equal(GEN nf, GEN P, GEN Q)
687 : : {
688 : 28 : GEN gQ, p = pr_get_p(P);
689 : 28 : long e = pr_get_e(P), f = pr_get_f(P), n;
690 [ + - ][ + - ]: 28 : if (!equalii(p, pr_get_p(Q)) || e != pr_get_e(Q) || f != pr_get_f(Q))
[ + + ]
691 : 14 : return 0;
692 : 14 : gQ = pr_get_gen(Q); n = lg(gQ)-1;
693 [ + + ]: 14 : if (2*e*f > n) return 1; /* room for only one such pr */
694 [ - + ][ # # ]: 28 : return ZV_equal(pr_get_gen(P), gQ) || ZC_prdvd(nf, gQ, P);
695 : : }
696 : :
697 : : long
698 : 173971 : nfval(GEN nf, GEN x, GEN pr)
699 : : {
700 : 173971 : pari_sp av = avma;
701 : : long w, e;
702 : : GEN cx, p;
703 : :
704 [ + + ]: 173971 : if (gequal0(x)) return LONG_MAX;
705 : 173908 : nf = checknf(nf);
706 : 173908 : checkprid(pr);
707 : 173908 : p = pr_get_p(pr);
708 : 173908 : e = pr_get_e(pr);
709 : 173908 : x = nf_to_scalar_or_basis(nf, x);
710 [ + + ]: 173908 : if (typ(x) != t_COL) return e*Q_pval(x,p);
711 : 172739 : x = Q_primitive_part(x, &cx);
712 : 172739 : w = ZC_nfval(nf,x,pr);
713 [ + + ]: 172739 : if (cx) w += e*Q_pval(cx,p);
714 : 173971 : avma = av; return w;
715 : : }
716 : :
717 : : /* want to write p^v = uniformizer^(e*v) * z^v, z coprime to pr */
718 : : /* z := tau^e / p^(e-1), algebraic integer coprime to pr; return z^v */
719 : : static GEN
720 : 637 : powp(GEN nf, GEN pr, long v)
721 : : {
722 : : GEN b, z;
723 : : long e;
724 [ + + ]: 637 : if (!v) return gen_1;
725 : 623 : b = pr_get_tau(pr);
726 [ + + ]: 623 : if (typ(b) == t_INT) return gen_1;
727 : 616 : e = pr_get_e(pr);
728 : 616 : z = gel(b,1);
729 [ + - ]: 616 : if (e != 1) z = gdiv(nfpow_u(nf, z, e), powiu(pr_get_p(pr),e-1));
730 : 637 : return nfpow_u(nf, z, v);
731 : : }
732 : : long
733 : 6346 : nfvalrem(GEN nf, GEN x, GEN pr, GEN *py)
734 : : {
735 : 6346 : pari_sp av = avma;
736 : : long w, e;
737 : : GEN cx, p, t;
738 : :
739 [ + + ]: 6346 : if (!py) return nfval(nf,x,pr);
740 [ + + ]: 6227 : if (gequal0(x)) { *py = gcopy(x); return LONG_MAX; }
741 : 6220 : nf = checknf(nf);
742 : 6220 : checkprid(pr);
743 : 6220 : p = pr_get_p(pr);
744 : 6220 : e = pr_get_e(pr);
745 : 6220 : x = nf_to_scalar_or_basis(nf, x);
746 [ + + ]: 6220 : if (typ(x) != t_COL) {
747 : 119 : w = Q_pvalrem(x,p, py);
748 [ + + ]: 119 : if (!w) { *py = gerepilecopy(av, x); return 0; }
749 : 42 : *py = gerepileupto(av, gmul(powp(nf, pr, w), *py));
750 : 42 : return e*w;
751 : : }
752 : 6101 : x = Q_primitive_part(x, &cx);
753 : 6101 : w = ZC_nfvalrem(nf,x,pr, py);
754 [ + + ]: 6101 : if (cx)
755 : : {
756 : 595 : long v = Q_pvalrem(cx,p, &t);
757 : 595 : *py = nfmul(nf, *py, gmul(powp(nf,pr,v), t));
758 : 595 : *py = gerepileupto(av, *py);
759 : 595 : w += e*v;
760 : : }
761 : : else
762 : 5506 : *py = gerepilecopy(av, *py);
763 : 6346 : return w;
764 : : }
765 : : GEN
766 : 147 : gpnfvalrem(GEN nf, GEN x, GEN pr, GEN *py)
767 : : {
768 : 147 : long v = nfvalrem(nf,x,pr,py);
769 [ + + ]: 147 : return v == LONG_MAX? mkoo(): stoi(v);
770 : : }
771 : :
772 : : GEN
773 : 15618 : coltoalg(GEN nf, GEN x)
774 : : {
775 : 15618 : return mkpolmod( coltoliftalg(nf, x), nf_get_pol(nf) );
776 : : }
777 : :
778 : : GEN
779 : 24367 : basistoalg(GEN nf, GEN x)
780 : : {
781 : : GEN z, T;
782 : :
783 : 24367 : nf = checknf(nf);
784 [ + + + + : 24367 : switch(typ(x))
- ]
785 : : {
786 : : case t_COL: {
787 : 2821 : pari_sp av = avma;
788 : 2821 : return gerepilecopy(av, coltoalg(nf, x));
789 : : }
790 : : case t_POLMOD:
791 : 14 : T = nf_get_pol(nf);
792 [ - + ]: 14 : if (!RgX_equal_var(T,gel(x,1)))
793 : 0 : pari_err_MODULUS("basistoalg", T,gel(x,1));
794 : 14 : return gcopy(x);
795 : : case t_POL:
796 : 35 : T = nf_get_pol(nf);
797 [ - + ]: 35 : if (varn(T) != varn(x)) pari_err_VAR("basistoalg",x,T);
798 : 35 : z = cgetg(3,t_POLMOD);
799 : 35 : gel(z,1) = ZX_copy(T);
800 : 35 : gel(z,2) = RgX_rem(x, T); return z;
801 : : case t_INT:
802 : : case t_FRAC:
803 : 21497 : T = nf_get_pol(nf);
804 : 21497 : z = cgetg(3,t_POLMOD);
805 : 21497 : gel(z,1) = ZX_copy(T);
806 : 21497 : gel(z,2) = gcopy(x); return z;
807 : : default:
808 : 0 : pari_err_TYPE("basistoalg",x);
809 : 24367 : return NULL; /* not reached */
810 : : }
811 : : }
812 : :
813 : : /* Assume nf is a genuine nf. */
814 : : GEN
815 : 6825708 : nf_to_scalar_or_basis(GEN nf, GEN x)
816 : : {
817 [ + + + + : 6825708 : switch(typ(x))
- ]
818 : : {
819 : : case t_INT: case t_FRAC:
820 : 900536 : return x;
821 : : case t_POLMOD:
822 : 47146 : x = checknfelt_mod(nf,x,"nf_to_scalar_or_basis");
823 [ + + ]: 47076 : if (typ(x) != t_POL) return x;
824 : : /* fall through */
825 : : case t_POL:
826 : : {
827 : 49774 : GEN T = nf_get_pol(nf);
828 : 49774 : long l = lg(x);
829 [ + + ]: 49774 : if (varn(x) != varn(T)) pari_err_VAR("nf_to_scalar_or_basis", x,T);
830 [ + + ]: 49718 : if (l >= lg(T)) { x = RgX_rem(x, T); l = lg(x); }
831 [ + + ]: 49718 : if (l == 2) return gen_0;
832 [ + + ]: 45378 : if (l == 3) return gel(x,2);
833 : 41361 : return poltobasis(nf,x);
834 : : }
835 : : case t_COL:
836 [ + + ]: 5845043 : if (lg(x) != lg(nf_get_zk(nf))) break;
837 [ + + ]: 5844980 : return QV_isscalar(x)? gel(x,1): x;
838 : : }
839 : 63 : pari_err_TYPE("nf_to_scalar_or_basis",x);
840 : 6825519 : return NULL; /* not reached */
841 : : }
842 : : /* Let x be a polynomial with coefficients in Q or nf. Return the same
843 : : * polynomial with coefficients expressed as vectors (on the integral basis).
844 : : * No consistency checks, not memory-clean. */
845 : : GEN
846 : 840 : RgX_to_nfX(GEN nf, GEN x)
847 : : {
848 : : long i, l;
849 : 840 : GEN y = cgetg_copy(x, &l); y[1] = x[1];
850 [ + + ]: 11844 : for (i=2; i<l; i++) gel(y,i) = nf_to_scalar_or_basis(nf, gel(x,i));
851 : 840 : return y;
852 : : }
853 : :
854 : : /* Assume nf is a genuine nf. */
855 : : GEN
856 : 51581 : nf_to_scalar_or_alg(GEN nf, GEN x)
857 : : {
858 [ + + + + : 51581 : switch(typ(x))
+ ]
859 : : {
860 : : case t_INT: case t_FRAC:
861 : 5525 : return x;
862 : : case t_POLMOD:
863 : 1554 : x = checknfelt_mod(nf,x,"nf_to_scalar_or_alg");
864 [ + + ]: 1554 : if (typ(x) != t_POL) return x;
865 : : /* fall through */
866 : : case t_POL:
867 : : {
868 : 13011 : GEN T = nf_get_pol(nf);
869 : 13011 : long l = lg(x);
870 [ + + ]: 13011 : if (varn(x) != varn(T)) pari_err_VAR("nf_to_scalar_or_alg", x,T);
871 [ + + ]: 12871 : if (l >= lg(T)) { x = RgX_rem(x, T); l = lg(x); }
872 [ + + ]: 12871 : if (l == 2) return gen_0;
873 [ + + ]: 12864 : if (l == 3) return gel(x,2);
874 : 12290 : return x;
875 : : }
876 : : case t_COL:
877 [ + + ]: 32737 : if (lg(x) != lg(nf_get_zk(nf))) break;
878 [ + + ]: 32569 : return QV_isscalar(x)? gel(x,1): coltoliftalg(nf, x);
879 : : }
880 : 217 : pari_err_TYPE("nf_to_scalar_or_alg",x);
881 : 51224 : return NULL; /* not reached */
882 : : }
883 : :
884 : : /* gmul(A, RgX_to_Rg(x)), A t_MAT (or t_VEC) of compatible dimensions */
885 : : GEN
886 : 1348524 : mulmat_pol(GEN A, GEN x)
887 : : {
888 : : long i,l;
889 : : GEN z;
890 [ + + ]: 1348524 : if (typ(x) != t_POL) return gmul(x,gel(A,1)); /* scalar */
891 [ + + ][ + - ]: 1348454 : l=lg(x)-1; if (l == 1) return typ(A)==t_VEC? gen_0: zerocol(nbrows(A));
892 : 1347227 : x++; z = gmul(gel(x,1), gel(A,1));
893 [ + + ]: 6251234 : for (i=2; i<l ; i++)
894 [ + + ]: 4904007 : if (!gequal0(gel(x,i))) z = gadd(z, gmul(gel(x,i), gel(A,i)));
895 : 1348524 : return z;
896 : : }
897 : :
898 : : /* x a t_POL, nf a genuine nf. No garbage collecting. No check. */
899 : : GEN
900 : 1241395 : poltobasis(GEN nf, GEN x)
901 : : {
902 : 1241395 : GEN P = nf_get_pol(nf);
903 [ + + ]: 1241395 : if (varn(x) != varn(P)) pari_err_VAR( "poltobasis", x,P);
904 [ + + ]: 1241185 : if (degpol(x) >= degpol(P)) x = RgX_rem(x,P);
905 : 1241185 : return mulmat_pol(nf_get_invzk(nf), x);
906 : : }
907 : :
908 : : GEN
909 : 17711 : algtobasis(GEN nf, GEN x)
910 : : {
911 : : pari_sp av;
912 : :
913 : 17711 : nf = checknf(nf);
914 [ + + + + : 17711 : switch(typ(x))
- ]
915 : : {
916 : : case t_POLMOD:
917 [ + + ]: 1232 : if (!RgX_equal_var(nf_get_pol(nf),gel(x,1)))
918 : 7 : pari_err_MODULUS("algtobasis", nf_get_pol(nf),gel(x,1));
919 : 1225 : x = gel(x,2);
920 [ + + - ]: 1225 : switch(typ(x))
921 : : {
922 : : case t_INT:
923 : 7 : case t_FRAC: return scalarcol(x, nf_get_degree(nf));
924 : : case t_POL:
925 : 1218 : av = avma;
926 : 1218 : return gerepileupto(av,poltobasis(nf,x));
927 : : }
928 : 0 : break;
929 : :
930 : : case t_POL:
931 : 6643 : av = avma;
932 : 6643 : return gerepileupto(av,poltobasis(nf,x));
933 : :
934 : : case t_COL:
935 [ - + ]: 5803 : if (lg(x)-1 != nf_get_degree(nf)) pari_err_DIM("nfalgtobasis");
936 : 5803 : return gcopy(x);
937 : :
938 : : case t_INT:
939 : 4033 : case t_FRAC: return scalarcol(x, nf_get_degree(nf));
940 : : }
941 : 0 : pari_err_TYPE("algtobasis",x);
942 : 17704 : return NULL; /* not reached */
943 : : }
944 : :
945 : : GEN
946 : 1463 : rnfbasistoalg(GEN rnf,GEN x)
947 : : {
948 : 1463 : const char *f = "rnfbasistoalg";
949 : : long lx, i;
950 : 1463 : pari_sp av = avma;
951 : : GEN z, nf, relpol, T;
952 : :
953 : 1463 : checkrnf(rnf);
954 : 1463 : nf = rnf_get_nf(rnf);
955 : 1463 : T = nf_get_pol(nf);
956 : 1463 : relpol = QXQX_to_mod_shallow(rnf_get_pol(rnf), T);
957 [ + + + + ]: 1463 : switch(typ(x))
958 : : {
959 : : case t_COL:
960 : 700 : z = cgetg_copy(x, &lx);
961 [ + + ]: 2044 : for (i=1; i<lx; i++)
962 : : {
963 : 1393 : GEN c = nf_to_scalar_or_alg(nf, gel(x,i));
964 [ + + ]: 1344 : if (typ(c) == t_POL) c = mkpolmod(c,T);
965 : 1344 : gel(z,i) = c;
966 : : }
967 : 651 : z = RgV_RgC_mul(gel(rnf_get_zk(rnf),1), z);
968 : 588 : return gerepileupto(av, gmodulo(z,relpol));
969 : :
970 : : case t_POLMOD:
971 : 427 : x = polmod_nffix(f, rnf, x, 0);
972 [ + + ]: 217 : if (typ(x) != t_POL) break;
973 : 63 : retmkpolmod(RgX_copy(x), RgX_copy(relpol));
974 : : case t_POL:
975 [ + + ]: 308 : if (varn(x) == varn(T))
976 : : {
977 [ + + ]: 119 : if (!RgX_is_QX(x)) pari_err_TYPE(f,x);
978 : 70 : x = gmodulo(x,T); break;
979 : : }
980 [ + + ]: 189 : if (varn(x) == varn(relpol))
981 : : {
982 : 140 : x = RgX_nffix(f,nf_get_pol(nf),x,0);
983 : 140 : return gmodulo(x, relpol);
984 : : }
985 : 49 : pari_err_VAR(f, x,relpol);
986 : : }
987 : 1043 : retmkpolmod(scalarpol(x, varn(relpol)), RgX_copy(relpol));
988 : : }
989 : :
990 : : GEN
991 : 784 : matbasistoalg(GEN nf,GEN x)
992 : : {
993 : : long i, j, li, lx;
994 : 784 : GEN z = cgetg_copy(x, &lx);
995 : :
996 [ + + ]: 784 : if (lx == 1) return z;
997 [ + + - ]: 770 : switch(typ(x))
998 : : {
999 : : case t_VEC: case t_COL:
1000 [ + + ]: 56 : for (i=1; i<lx; i++) gel(z,i) = basistoalg(nf, gel(x,i));
1001 : 28 : return z;
1002 : 742 : case t_MAT: break;
1003 : 0 : default: pari_err_TYPE("matbasistoalg",x);
1004 : : }
1005 : 742 : li = lgcols(x);
1006 [ + + ]: 4543 : for (j=1; j<lx; j++)
1007 : : {
1008 : 3801 : GEN c = cgetg(li,t_COL), xj = gel(x,j);
1009 : 3801 : gel(z,j) = c;
1010 [ + + ]: 28035 : for (i=1; i<li; i++) gel(c,i) = basistoalg(nf, gel(xj,i));
1011 : : }
1012 : 784 : return z;
1013 : : }
1014 : :
1015 : : GEN
1016 : 490 : matalgtobasis(GEN nf,GEN x)
1017 : : {
1018 : : long i, j, li, lx;
1019 : 490 : GEN z = cgetg_copy(x, &lx);
1020 : :
1021 [ + + ]: 490 : if (lx == 1) return z;
1022 [ + + - ]: 462 : switch(typ(x))
1023 : : {
1024 : : case t_VEC: case t_COL:
1025 [ + + ]: 2282 : for (i=1; i<lx; i++) gel(z,i) = algtobasis(nf, gel(x,i));
1026 : 455 : return z;
1027 : 7 : case t_MAT: break;
1028 : 0 : default: pari_err_TYPE("matalgtobasis",x);
1029 : : }
1030 : 7 : li = lgcols(x);
1031 [ + + ]: 14 : for (j=1; j<lx; j++)
1032 : : {
1033 : 7 : GEN c = cgetg(li,t_COL), xj = gel(x,j);
1034 : 7 : gel(z,j) = c;
1035 [ + + ]: 21 : for (i=1; i<li; i++) gel(c,i) = algtobasis(nf, gel(xj,i));
1036 : : }
1037 : 490 : return z;
1038 : : }
1039 : : GEN
1040 : 2345 : RgM_to_nfM(GEN nf,GEN x)
1041 : : {
1042 : : long i, j, li, lx;
1043 : 2345 : GEN z = cgetg_copy(x, &lx);
1044 : :
1045 [ - + ]: 2345 : if (lx == 1) return z;
1046 : 2345 : li = lgcols(x);
1047 [ + + ]: 17941 : for (j=1; j<lx; j++)
1048 : : {
1049 : 15596 : GEN c = cgetg(li,t_COL), xj = gel(x,j);
1050 : 15596 : gel(z,j) = c;
1051 [ + + ]: 106974 : for (i=1; i<li; i++) gel(c,i) = nf_to_scalar_or_basis(nf, gel(xj,i));
1052 : : }
1053 : 2345 : return z;
1054 : : }
1055 : : GEN
1056 : 30523 : RgC_to_nfC(GEN nf,GEN x)
1057 : : {
1058 : 30523 : long i, lx = lg(x);
1059 : 30523 : GEN z = cgetg(lx, t_COL);
1060 [ + + ]: 227315 : for (i=1; i<lx; i++) gel(z,i) = nf_to_scalar_or_basis(nf, gel(x,i));
1061 : 30523 : return z;
1062 : : }
1063 : :
1064 : : /* x a t_POLMOD, supposedly in rnf = K[z]/(T), K = Q[y]/(Tnf) */
1065 : : GEN
1066 : 1701 : polmod_nffix(const char *f, GEN rnf, GEN x, int lift)
1067 : 1701 : { return polmod_nffix2(f, rnf_get_nfpol(rnf), rnf_get_pol(rnf), x,lift); }
1068 : : GEN
1069 : 1792 : polmod_nffix2(const char *f, GEN T, GEN relpol, GEN x, int lift)
1070 : : {
1071 [ + + ]: 1792 : if (RgX_equal_var(gel(x,1),relpol))
1072 : : {
1073 : 1141 : x = gel(x,2);
1074 [ + + ][ + - ]: 1141 : if (typ(x) == t_POL && varn(x) == varn(relpol))
1075 : : {
1076 : 1134 : x = RgX_nffix(f, T, x, lift);
1077 [ + + + ]: 1134 : switch(lg(x))
1078 : : {
1079 : 28 : case 2: return gen_0;
1080 : 231 : case 3: return gel(x,2);
1081 : : }
1082 : 875 : return x;
1083 : : }
1084 : : }
1085 : 1792 : return Rg_nffix(f, T, x, lift);
1086 : : }
1087 : : GEN
1088 : 1148 : rnfalgtobasis(GEN rnf,GEN x)
1089 : : {
1090 : 1148 : const char *f = "rnfalgtobasis";
1091 : 1148 : pari_sp av = avma;
1092 : : GEN T, relpol;
1093 : :
1094 : 1148 : checkrnf(rnf);
1095 : 1148 : relpol = rnf_get_pol(rnf);
1096 : 1148 : T = rnf_get_nfpol(rnf);
1097 [ + + + + ]: 1148 : switch(typ(x))
1098 : : {
1099 : : case t_COL:
1100 [ + + ]: 49 : if (lg(x)-1 != rnf_get_degree(rnf)) pari_err_DIM(f);
1101 : 28 : x = RgV_nffix(f, T, x, 0);
1102 : 21 : return gerepilecopy(av, x);
1103 : :
1104 : : case t_POLMOD:
1105 : 1015 : x = polmod_nffix(f, rnf, x, 0);
1106 [ + + ]: 973 : if (typ(x) != t_POL) break;
1107 : 686 : return gerepileupto(av, mulmat_pol(rnf_get_invzk(rnf), x));
1108 : : case t_POL:
1109 [ + + ]: 56 : if (varn(x) == varn(T))
1110 : : {
1111 [ + + ]: 21 : if (!RgX_is_QX(x)) pari_err_TYPE(f,x);
1112 : 14 : x = mkpolmod(x,T); break;
1113 : : }
1114 : 35 : x = RgX_nffix(f, T, x, 0);
1115 [ + + ]: 28 : if (degpol(x) >= degpol(relpol)) x = RgX_rem(x,relpol);
1116 : 28 : return gerepileupto(av, mulmat_pol(rnf_get_invzk(rnf), x));
1117 : : }
1118 : 1064 : return gerepileupto(av, scalarcol(x, rnf_get_degree(rnf)));
1119 : : }
1120 : :
1121 : : /* Given a and b in nf, gives an algebraic integer y in nf such that a-b.y
1122 : : * is "small" */
1123 : : GEN
1124 : 266 : nfdiveuc(GEN nf, GEN a, GEN b)
1125 : : {
1126 : 266 : pari_sp av = avma;
1127 : 266 : a = nfdiv(nf,a,b);
1128 : 266 : return gerepileupto(av, ground(a));
1129 : : }
1130 : :
1131 : : /* Given a and b in nf, gives a "small" algebraic integer r in nf
1132 : : * of the form a-b.y */
1133 : : GEN
1134 : 266 : nfmod(GEN nf, GEN a, GEN b)
1135 : : {
1136 : 266 : pari_sp av = avma;
1137 : 266 : GEN p1 = gneg_i(nfmul(nf,b,ground(nfdiv(nf,a,b))));
1138 : 266 : return gerepileupto(av, nfadd(nf,a,p1));
1139 : : }
1140 : :
1141 : : /* Given a and b in nf, gives a two-component vector [y,r] in nf such
1142 : : * that r=a-b.y is "small". */
1143 : : GEN
1144 : 266 : nfdivrem(GEN nf, GEN a, GEN b)
1145 : : {
1146 : 266 : pari_sp av = avma;
1147 : 266 : GEN p1,z, y = ground(nfdiv(nf,a,b));
1148 : :
1149 : 266 : p1 = gneg_i(nfmul(nf,b,y));
1150 : 266 : z = cgetg(3,t_VEC);
1151 : 266 : gel(z,1) = gcopy(y);
1152 : 266 : gel(z,2) = nfadd(nf,a,p1); return gerepileupto(av, z);
1153 : : }
1154 : :
1155 : : /*************************************************************************/
1156 : : /** **/
1157 : : /** (Z_K/I)^* **/
1158 : : /** **/
1159 : : /*************************************************************************/
1160 : : /* return sign(sigma_k(x)), x t_COL (integral, primitive) */
1161 : : static long
1162 : 489483 : eval_sign(GEN M, GEN x, long k)
1163 : : {
1164 : 489483 : long i, l = lg(x);
1165 : 489483 : GEN z = gel(x,1); /* times M[k,1], which is 1 */
1166 [ + + ]: 1393292 : for (i = 2; i < l; i++)
1167 : 903809 : z = mpadd(z, mpmul(gcoeff(M,k,i), gel(x,i)));
1168 [ - + ]: 489483 : if (realprec(z) < DEFAULTPREC) pari_err_PREC("nfsign_arch");
1169 : 489483 : return signe(z);
1170 : : }
1171 : :
1172 : : GEN
1173 : 779460 : vec01_to_indices(GEN v)
1174 : : {
1175 : : long i, k, l;
1176 : : GEN p;
1177 : :
1178 [ + + - ]: 779460 : switch (typ(v))
1179 : : {
1180 : 476673 : case t_VECSMALL: return v;
1181 : 302787 : case t_VEC: break;
1182 : 0 : default: pari_err_TYPE("vec01_to_indices",v);
1183 : : }
1184 : 302787 : l = lg(v);
1185 : 302787 : p = new_chunk(l) + l;
1186 [ + + ]: 1074392 : for (k=1, i=l-1; i; i--)
1187 [ + + ]: 771605 : if (signe(gel(v,i))) { *--p = i; k++; }
1188 : 302787 : *--p = evallg(k) | evaltyp(t_VECSMALL);
1189 : 779460 : avma = (pari_sp)p; return p;
1190 : : }
1191 : : GEN
1192 : 3163 : indices_to_vec01(GEN p, long r)
1193 : : {
1194 : 3163 : long i, l = lg(p);
1195 : 3163 : GEN v = zerovec(r);
1196 [ + + ]: 5018 : for (i = 1; i < l; i++) gel(v, p[i]) = gen_1;
1197 : 3163 : return v;
1198 : : }
1199 : :
1200 : : /* return (column) vector of R1 signatures of x (0 or 1) */
1201 : : GEN
1202 : 594344 : nfsign_arch(GEN nf, GEN x, GEN arch)
1203 : : {
1204 : 594344 : GEN M, V, archp = vec01_to_indices(arch);
1205 : 594344 : long i, s, n = lg(archp)-1;
1206 : : pari_sp av;
1207 : :
1208 [ + + ]: 594344 : if (!n) return cgetg(1,t_VECSMALL);
1209 : 517275 : nf = checknf(nf);
1210 [ + + ]: 517275 : if (typ(x) == t_MAT)
1211 : : { /* factorisation */
1212 : 134437 : GEN g = gel(x,1), e = gel(x,2);
1213 : 134437 : V = zero_zv(n);
1214 [ + + ]: 409817 : for (i=1; i<lg(g); i++)
1215 [ + + ]: 275380 : if (mpodd(gel(e,i)))
1216 : 233294 : Flv_add_inplace(V, nfsign_arch(nf,gel(g,i),archp), 2);
1217 : 134437 : avma = (pari_sp)V; return V;
1218 : : }
1219 : 382838 : av = avma; V = cgetg(n+1,t_VECSMALL);
1220 : 382838 : x = nf_to_scalar_or_basis(nf, x);
1221 [ + + + ]: 382838 : switch(typ(x))
1222 : : {
1223 : : case t_INT:
1224 : 98657 : s = signe(x);
1225 [ - + ]: 98657 : if (!s) pari_err_DOMAIN("nfsign_arch","element","=",gen_0,x);
1226 : 98657 : avma = av; return const_vecsmall(n, (s < 0)? 1: 0);
1227 : : case t_FRAC:
1228 : 903 : s = signe(gel(x,1));
1229 : 903 : avma = av; return const_vecsmall(n, (s < 0)? 1: 0);
1230 : : }
1231 : 283278 : x = Q_primpart(x); M = nf_get_M(nf);
1232 [ + + ]: 772761 : for (i = 1; i <= n; i++) V[i] = (eval_sign(M, x, archp[i]) < 0)? 1: 0;
1233 : 594344 : avma = (pari_sp)V; return V;
1234 : : }
1235 : :
1236 : : /* return the vector of signs of x; the matrix of such if x is a vector
1237 : : * of nf elements */
1238 : : GEN
1239 : 49 : nfsign(GEN nf, GEN x)
1240 : : {
1241 : : long i, l;
1242 : : GEN arch, S;
1243 : :
1244 : 49 : nf = checknf(nf);
1245 : 49 : arch = identity_perm( nf_get_r1(nf) );
1246 [ + + ]: 49 : if (typ(x) != t_VEC) return nfsign_arch(nf, x, arch);
1247 : 35 : l = lg(x); S = cgetg(l, t_MAT);
1248 [ + + ]: 254 : for (i=1; i<l; i++) gel(S,i) = nfsign_arch(nf, gel(x,i), arch);
1249 : 49 : return S;
1250 : : }
1251 : :
1252 : : /* multiply y by t = 1 mod^* f such that sign(x) = sign(y) at arch = divisor[2].
1253 : : * If x == NULL, make y >> 0 at sarch */
1254 : : GEN
1255 : 68241 : set_sign_mod_divisor(GEN nf, GEN x, GEN y, GEN divisor, GEN sarch)
1256 : : {
1257 : : GEN s, archp, gen;
1258 : : long nba,i;
1259 [ - + ]: 68241 : if (!sarch) return y;
1260 : 68241 : gen = gel(sarch,2); nba = lg(gen);
1261 [ + + ]: 68241 : if (nba == 1) return y;
1262 : :
1263 : 58202 : archp = vec01_to_indices(gel(divisor,2));
1264 : 58202 : s = nfsign_arch(nf, y, archp);
1265 [ + + ]: 58202 : if (x) Flv_add_inplace(s, nfsign_arch(nf, x, archp), 2);
1266 : 58202 : s = Flm_Flc_mul(gel(sarch,3), s, 2);
1267 [ + + ]: 141240 : for (i=1; i<nba; i++)
1268 [ + + ]: 83038 : if (s[i]) y = nfmul(nf,y,gel(gen,i));
1269 : 68241 : return y;
1270 : : }
1271 : :
1272 : : /* given an element x in Z_K and an integral ideal y in HNF, coprime with x,
1273 : : outputs an element inverse of x modulo y */
1274 : : GEN
1275 : 140 : nfinvmodideal(GEN nf, GEN x, GEN y)
1276 : : {
1277 : 140 : pari_sp av = avma;
1278 : 140 : GEN a, yZ = gcoeff(y,1,1);
1279 : :
1280 [ - + ]: 140 : if (is_pm1(yZ)) return zerocol( nf_get_degree(nf) );
1281 : 140 : x = nf_to_scalar_or_basis(nf, x);
1282 [ + + ]: 140 : if (typ(x) == t_INT) return gerepileupto(av, Fp_inv(x, yZ));
1283 : :
1284 : 78 : a = hnfmerge_get_1(idealhnf_principal(nf,x), y);
1285 [ - + ]: 78 : if (!a) pari_err_INV("nfinvmodideal", x);
1286 : 140 : return gerepileupto(av, ZC_hnfrem(nfdiv(nf,a,x), y));
1287 : : }
1288 : :
1289 : : static GEN
1290 : 252347 : nfsqrmodideal(GEN nf, GEN x, GEN id) {
1291 : 252347 : return ZC_hnfrem(nfsqri(nf,x), id);
1292 : : }
1293 : : static GEN
1294 : 610274 : nfmulmodideal(GEN nf, GEN x, GEN y, GEN id) {
1295 [ + + ]: 610274 : return x? ZC_hnfrem(nfmuli(nf,x,y), id): y;
1296 : : }
1297 : : /* assume x integral, k integer, A in HNF */
1298 : : GEN
1299 : 414680 : nfpowmodideal(GEN nf,GEN x,GEN k,GEN A)
1300 : : {
1301 : 414680 : long s = signe(k);
1302 : : pari_sp av;
1303 : : GEN y;
1304 : :
1305 [ - + ]: 414680 : if (!s) return gen_1;
1306 : 414680 : av = avma;
1307 : 414680 : x = nf_to_scalar_or_basis(nf, x);
1308 [ + + ]: 414680 : if (typ(x) != t_COL) return Fp_pow(x, k, gcoeff(A,1,1));
1309 [ - + ]: 186891 : if (s < 0) { x = nfinvmodideal(nf, x,A); k = absi(k); }
1310 : 186891 : for(y = NULL;;)
1311 : : {
1312 [ + + ]: 439238 : if (mpodd(k)) y = nfmulmodideal(nf,y,x,A);
1313 [ + + ]: 439238 : k = shifti(k,-1); if (!signe(k)) break;
1314 : 252347 : x = nfsqrmodideal(nf,x,A);
1315 : 252347 : }
1316 : 414680 : return gerepileupto(av, y);
1317 : : }
1318 : :
1319 : : /* a * g^n mod id */
1320 : : static GEN
1321 : 358990 : elt_mulpow_modideal(GEN nf, GEN a, GEN g, GEN n, GEN id)
1322 : : {
1323 : 358990 : return nfmulmodideal(nf, a, nfpowmodideal(nf,g,n,id), id);
1324 : : }
1325 : :
1326 : : /* assume (num(g[i]), id) = 1 for all i. Return prod g[i]^e[i] mod id.
1327 : : * EX = multiple of exponent of (O_K/id)^* */
1328 : : GEN
1329 : 139628 : famat_to_nf_modideal_coprime(GEN nf, GEN g, GEN e, GEN id, GEN EX)
1330 : : {
1331 : 139628 : GEN plus = NULL, minus = NULL, idZ = gcoeff(id,1,1);
1332 : 139628 : pari_sp av = avma, lim = stack_lim(av,2);
1333 : 139628 : long i, lx = lg(g);
1334 [ + + ]: 139628 : GEN EXo2 = (expi(EX) > 10)? shifti(EX,-1): NULL;
1335 : :
1336 [ + + ]: 139628 : if (is_pm1(idZ)) lx = 1; /* id = Z_K */
1337 [ + + ]: 494712 : for (i=1; i<lx; i++)
1338 : : {
1339 : 355084 : GEN h, n = centermodii(gel(e,i), EX, EXo2);
1340 : 355084 : long sn = signe(n);
1341 [ + + ]: 355084 : if (!sn) continue;
1342 : :
1343 : 298968 : h = nf_to_scalar_or_basis(nf, gel(g,i));
1344 [ + - + ]: 298968 : switch(typ(h))
1345 : : {
1346 : 204089 : case t_INT: break;
1347 : : case t_FRAC:
1348 : 0 : h = Fp_div(gel(h,1), gel(h,2), idZ); break;
1349 : : default:
1350 : : {
1351 : : GEN dh;
1352 : 94879 : h = Q_remove_denom(h, &dh);
1353 [ - + ]: 94879 : if (dh) h = FpC_Fp_mul(h, Fp_inv(dh,idZ), idZ);
1354 : : }
1355 : : }
1356 [ + + ]: 298968 : if (sn > 0)
1357 : 297715 : plus = elt_mulpow_modideal(nf, plus, h, n, id);
1358 : : else /* sn < 0 */
1359 : 1253 : minus = elt_mulpow_modideal(nf, minus, h, absi(n), id);
1360 : :
1361 [ - + ]: 298968 : if (low_stack(lim, stack_lim(av, 2)))
1362 : : {
1363 [ # # ]: 0 : if(DEBUGMEM>1) pari_warn(warnmem,"famat_to_nf_modideal_coprime");
1364 [ # # ]: 0 : if (!plus) plus = gen_0;
1365 [ # # ]: 0 : if (!minus) minus = gen_0;
1366 : 0 : gerepileall(av,2, &plus, &minus);
1367 [ # # ]: 0 : if (isintzero(plus)) plus = NULL;
1368 [ # # ]: 0 : if (isintzero(minus)) minus = NULL;
1369 : : }
1370 : : }
1371 [ + + ]: 139628 : if (minus)
1372 : 140 : plus = nfmulmodideal(nf, plus, nfinvmodideal(nf,minus,id), id);
1373 [ + + ]: 139628 : return plus? plus: scalarcol_shallow(gen_1, lg(id)-1);
1374 : : }
1375 : :
1376 : : /* given 2 integral ideals x, y in HNF s.t x | y | x^2, compute the quotient
1377 : : (1+x)/(1+y) in the form [[cyc],[gen]], if U != NULL, set *U := ux^-1 */
1378 : : static GEN
1379 : 11380 : zidealij(GEN x, GEN y, GEN *U)
1380 : : {
1381 : : GEN G, cyc;
1382 : : long j, N;
1383 : :
1384 : : /* x^(-1) y = relations between the 1 + x_i (HNF) */
1385 : 11380 : cyc = ZM_snf_group(hnf_solve(x, y), U, &G);
1386 : 11380 : N = lg(cyc); G = ZM_mul(x,G); settyp(G, t_VEC); /* new generators */
1387 [ + + ]: 56354 : for (j=1; j<N; j++)
1388 : : {
1389 : 44974 : GEN c = gel(G,j);
1390 : 44974 : gel(c,1) = addiu(gel(c,1), 1); /* 1 + g_j */
1391 [ + + ]: 44974 : if (ZV_isscalar(c)) gel(G,j) = gel(c,1);
1392 : : }
1393 [ + + ]: 11380 : if (U) *U = RgM_mul(*U, RgM_inv(x));
1394 : 11380 : return mkvec2(cyc, G);
1395 : : }
1396 : :
1397 : : static GEN
1398 : 317004 : Fq_FpXQ_log(GEN a, GEN g, GEN ord, GEN T, GEN p)
1399 : : {
1400 [ + + ]: 317004 : if (!T) return Fp_log(a,g,ord,p);
1401 [ + + ]: 94783 : if (typ(a)==t_INT) return Fp_FpXQ_log(a,g,ord,T,p);
1402 : 317004 : return FpXQ_log(a,g,ord,T,p);
1403 : : }
1404 : : /* same in nf.zk / pr */
1405 : : static GEN
1406 : 317004 : nf_log(GEN nf, GEN a, GEN g, GEN ord, GEN pr)
1407 : : {
1408 : 317004 : pari_sp av = avma;
1409 : 317004 : GEN T,p, modpr = nf_to_Fq_init(nf, &pr, &T, &p);
1410 : 317004 : GEN A = nf_to_Fq(nf,a,modpr);
1411 : 317004 : GEN G = nf_to_Fq(nf,g,modpr);
1412 : 317004 : return gerepileuptoint(av, Fq_FpXQ_log(A,G,ord,T,p));
1413 : : }
1414 : :
1415 : : /* Product of cyc entries, with cyc = diagonal(Smith Normal Form), assumed != 0.
1416 : : * Set L to the index of the last non-trivial (!= 1) entry */
1417 : : GEN
1418 : 7005 : detcyc(GEN cyc, long *L)
1419 : : {
1420 : 7005 : pari_sp av = avma;
1421 : 7005 : long i, l = lg(cyc);
1422 : 7005 : GEN s = gel(cyc,1);
1423 : :
1424 [ + + ]: 7005 : if (l == 1) { *L = 1; return gen_1; }
1425 [ + + ]: 9609 : for (i=2; i<l; i++)
1426 : : {
1427 : 3459 : GEN t = gel(cyc,i);
1428 [ + + ]: 3459 : if (is_pm1(t)) break;
1429 : 2611 : s = mulii(s, t);
1430 : : }
1431 [ + + ]: 7005 : *L = i; return i <= 2? icopy(s): gerepileuptoint(av,s);
1432 : : }
1433 : :
1434 : : /* (U,V) = 1. Return y = x mod U, = 1 mod V (uv: u + v = 1, u in U, v in V),
1435 : : * namely u + x*v.
1436 : : * Either (u,mv) are both t_INT, or
1437 : : * u is a t_COL, mv is a t_MAT, multiplication table by v */
1438 : : static GEN
1439 : 4088 : makeprimetoideal(GEN UV, GEN u,GEN mv, GEN x)
1440 : : {
1441 : : GEN t;
1442 [ + + ]: 4088 : if (typ(mv) == t_INT) /* u t_INT */
1443 : : {
1444 [ + + ]: 1064 : if (typ(x) == t_INT) return addii(mulii(x,mv), u);
1445 : 546 : t = ZC_Z_add(ZC_Z_mul(x,mv), u);
1446 : : }
1447 : : else
1448 : : {
1449 [ + + ]: 3024 : t = typ(x) == t_INT? ZC_Z_mul(gel(mv,1),x): ZM_ZC_mul(mv,x);
1450 : 3024 : t = ZC_add(t, u);
1451 : : }
1452 : 4088 : return ZC_hnfrem(t, UV);
1453 : : }
1454 : :
1455 : : static GEN
1456 : 1036 : makeprimetoidealvec(GEN UV, GEN u,GEN mv, GEN gen)
1457 : : {
1458 : : long i, ly;
1459 : 1036 : GEN y = cgetg_copy(gen, &ly);
1460 [ + + ]: 2128 : for (i=1; i<ly; i++) gel(y,i) = makeprimetoideal(UV,u,mv, gel(gen,i));
1461 : 1036 : return y;
1462 : : }
1463 : :
1464 : : /* Given an ideal pr^ep, and an integral ideal x (in HNF form) compute a list
1465 : : * of vectors,corresponding to the abelian groups (O_K/pr)^*, and
1466 : : * 1 + pr^i/ 1 + pr^min(2i, ep), i = 1,...
1467 : : * Each vector has 5 components as follows :
1468 : : * [[cyc],[g],[g'],[sign],U.X^-1].
1469 : : * cyc = type as abelian group
1470 : : * g, g' = generators. (g',x) = 1, not necessarily so for g
1471 : : * sign = vector of the sign(g') at arch.
1472 : : * If x = NULL, the original ideal was a prime power */
1473 : : static GEN
1474 : 11815 : zprimestar(GEN nf, GEN pr, GEN ep, GEN x, GEN arch)
1475 : : {
1476 : 11815 : pari_sp av = avma;
1477 : 11815 : long a, e = itos(ep), f = pr_get_f(pr);
1478 : 11815 : GEN p = pr_get_p(pr), list, g, g0, y, u,v, prb, pre;
1479 : : ulong mask;
1480 : :
1481 [ - + ]: 11815 : if(DEBUGLEVEL>3) err_printf("treating pr^%ld, pr = %Ps\n",e,pr);
1482 [ + + ]: 11815 : if (f == 1)
1483 : 5479 : g = pgener_Fp(p);
1484 : : else
1485 : : {
1486 : 6336 : GEN T, modpr = zk_to_Fq_init(nf, &pr, &T, &p);
1487 : 6336 : g = Fq_to_nf(gener_FpXQ(T,p,NULL), modpr);
1488 : 6336 : g = poltobasis(nf, g);
1489 : : }
1490 : : /* g generates (Z_K / pr)^* */
1491 : 11815 : prb = idealhnf_two(nf,pr);
1492 [ + + ]: 11815 : pre = (e==1)? prb: idealpow(nf,pr,ep);
1493 [ + + ]: 11815 : if (x)
1494 : : {
1495 : : GEN mv;
1496 : 1902 : v = idealaddtoone_i(nf,idealdivpowprime(nf,x,pr,ep), pre);
1497 : 1895 : mv = zk_scalar_or_multable(nf, v);
1498 [ + + ]: 1895 : u = typ(mv) == t_INT? subui(1,mv): unnf_minus_x(v);
1499 : 1895 : v = mv;
1500 : 1895 : g0 = makeprimetoideal(x,u,mv,g);
1501 : : }
1502 : : else
1503 : : {
1504 : 9913 : u = v = NULL; /* gcc -Wall */
1505 : 9913 : g0 = g;
1506 : : }
1507 : :
1508 : 11808 : y = mkvec5(mkvec(subiu(powiu(p,f), 1)),
1509 : : mkvec(g),
1510 : : mkvec(g0),
1511 : : mkvec(nfsign_arch(nf,g0,arch)),
1512 : : gen_1);
1513 [ + + ]: 11808 : if (e == 1) return gerepilecopy(av, mkvec(y));
1514 : 7022 : list = vectrunc_init(e+1);
1515 : 7022 : vectrunc_append(list, y);
1516 : 7022 : mask = quadratic_prec_mask(e);
1517 : 7022 : a = 1;
1518 [ + + ]: 17492 : while (mask > 1)
1519 : : {
1520 : 10470 : GEN pra = prb, gen, z, s, U;
1521 : 10470 : long i, l, b = a << 1;
1522 : :
1523 [ + + ]: 10470 : if (mask & 1) b--;
1524 : 10470 : mask >>= 1;
1525 : : /* compute 1 + pr^a / 1 + pr^b, 2a <= b */
1526 [ - + ]: 10470 : if(DEBUGLEVEL>3) err_printf(" treating a = %ld, b = %ld\n",a,b);
1527 [ + + ]: 10470 : prb = (b >= e)? pre: idealpows(nf,pr,b);
1528 : 10470 : z = zidealij(pra, prb, &U);
1529 : 10470 : gen = leafcopy(gel(z,2));
1530 : 10470 : s = cgetg_copy(gen, &l);
1531 [ + + ]: 54310 : for (i = 1; i < l; i++)
1532 : : {
1533 [ + + ]: 43840 : if (x) gel(gen,i) = makeprimetoideal(x,u,v,gel(gen,i));
1534 : 43840 : gel(s,i) = nfsign_arch(nf,gel(gen,i),arch);
1535 : : }
1536 : 10470 : y = mkvec5(gel(z,1), gel(z,2), gen, s, U);
1537 : 10470 : vectrunc_append(list, y);
1538 : 10470 : a = b;
1539 : : }
1540 : 11808 : return gerepilecopy(av, list);
1541 : : }
1542 : :
1543 : : /* increment y, which runs through [-d,d]^k. Return 0 when done. */
1544 : : static int
1545 : 2975 : increment(GEN y, long k, long d)
1546 : : {
1547 : 2975 : long i = 0, j;
1548 : : do
1549 : : {
1550 [ - + ]: 4151 : if (++i > k) return 0;
1551 : 4151 : y[i]++;
1552 [ + + ]: 4151 : } while (y[i] > d);
1553 [ + + ]: 4151 : for (j = 1; j < i; j++) y[j] = -d;
1554 : 2975 : return 1;
1555 : : }
1556 : :
1557 : : GEN
1558 : 1680 : archstar_full_rk(GEN x, GEN bas, GEN v, GEN gen)
1559 : : {
1560 : 1680 : long i, r, lgmat, N = lg(bas)-1, nba = nbrows(v);
1561 : 1680 : GEN lambda = cgetg(N+1, t_VECSMALL), mat = cgetg(nba+1,t_MAT);
1562 : :
1563 : 1680 : lgmat = lg(v); setlg(mat, lgmat+1);
1564 [ + + ]: 3360 : for (i = 1; i < lgmat; i++) gel(mat,i) = gel(v,i);
1565 [ + + ]: 3360 : for ( ; i <= nba; i++) gel(mat,i) = cgetg(nba+1, t_VECSMALL);
1566 : :
1567 [ + + ]: 1680 : if (x) { x = ZM_lll(x, 0.75, LLL_INPLACE); bas = RgV_RgM_mul(bas, x); }
1568 : :
1569 : 1680 : for (r=1;; r++)
1570 : : { /* reset */
1571 : 1680 : (void)vec_setconst(lambda, (GEN)0);
1572 [ + + ]: 1680 : if (!x) lambda[1] = r;
1573 [ + - ]: 2975 : while (increment(lambda, N, r))
1574 : : {
1575 : 2975 : pari_sp av1 = avma;
1576 : 2975 : GEN a = RgM_zc_mul(bas, lambda), c = gel(mat,lgmat);
1577 [ + + ]: 8925 : for (i = 1; i <= nba; i++)
1578 : : {
1579 [ + + ]: 5950 : GEN t = x? gadd(gel(a,i), gen_1): gel(a,i);
1580 : 5950 : c[i] = (gsigne(t) < 0)? 1: 0;
1581 : : }
1582 [ + + ]: 2975 : avma = av1; if (Flm_deplin(mat, 2)) continue;
1583 : :
1584 : : /* c independent of previous sign vectors */
1585 [ + + ]: 1680 : if (!x) a = zc_to_ZC(lambda);
1586 : : else
1587 : : {
1588 : 1253 : a = ZM_zc_mul(x, lambda);
1589 : 1253 : gel(a,1) = addis(gel(a,1), 1);
1590 : : }
1591 : 1680 : gel(gen,lgmat) = a;
1592 [ + - ]: 1680 : if (lgmat++ == nba) {
1593 : 1680 : mat = Flm_inv(mat,2); /* full rank */
1594 : 1680 : settyp(mat, t_VEC); return mat;
1595 : : }
1596 : 0 : setlg(mat,lgmat+1);
1597 : : }
1598 : 0 : }
1599 : : }
1600 : :
1601 : : /* x non-0 integral ideal in HNF, compute elements in 1+x (in x, if x = zk)
1602 : : * whose sign matrix is invertible. archp in 'indices' format */
1603 : : GEN
1604 : 12705 : nfarchstar(GEN nf, GEN x, GEN archp)
1605 : : {
1606 : 12705 : long nba = lg(archp) - 1;
1607 : : GEN cyc, gen, mat;
1608 : :
1609 [ + + ]: 12705 : if (!nba)
1610 : 8093 : cyc = gen = mat = cgetg(1, t_VEC);
1611 : : else
1612 : : {
1613 : 4612 : GEN xZ = gcoeff(x,1,1), gZ;
1614 : 4612 : pari_sp av = avma;
1615 [ + + ]: 4612 : if (is_pm1(xZ)) x = NULL; /* x = O_K */
1616 [ + + ]: 4612 : gZ = x? subsi(1, xZ): gen_m1; /* gZ << 0, gZ = 1 mod x */
1617 [ + + ]: 4612 : if (nba == 1)
1618 : : {
1619 : 2939 : gen = mkvec(gZ);
1620 : 2939 : mat = mkvec( mkvecsmall(1) );
1621 : : }
1622 : : else
1623 : : {
1624 : 1673 : GEN bas = nf_get_M(nf);
1625 [ + + ]: 1673 : if (lgcols(bas) > lg(archp)) bas = rowpermute(bas, archp);
1626 : 1673 : gen = cgetg(nba+1,t_VEC);
1627 : 1673 : gel(gen,1) = gZ;
1628 : 1673 : mat = archstar_full_rk(x, bas, mkmat(const_vecsmall(nba,1)), gen);
1629 : 1673 : gerepileall(av,2,&gen,&mat);
1630 : : }
1631 : 4612 : cyc = const_vec(nba, gen_2);
1632 : : }
1633 : 12705 : return mkvec3(cyc,gen,mat);
1634 : : }
1635 : :
1636 : : static GEN
1637 : 212397 : apply_U(GEN U, GEN a)
1638 : : {
1639 : : GEN e;
1640 [ + + ]: 212397 : if (typ(a) == t_INT)
1641 : 74015 : e = RgC_Rg_mul(gel(U,1), subis(a, 1));
1642 : : else
1643 : : { /* t_COL */
1644 : 138382 : GEN t = gel(a,1);
1645 : 138382 : gel(a,1) = addsi(-1, gel(a,1)); /* a -= 1 */
1646 : 138382 : e = RgM_RgC_mul(U, a);
1647 : 138382 : gel(a,1) = t; /* restore */
1648 : : }
1649 : 212397 : return e;
1650 : : }
1651 : : /* a in Z_K (t_COL or t_INT), pr prime ideal, prk = pr^k,
1652 : : * list = zprimestar(nf, pr, k, ...) */
1653 : : static GEN
1654 : 317004 : zlog_pk(GEN nf, GEN a, GEN y, GEN pr, GEN prk, GEN list, GEN *psigne)
1655 : : {
1656 : 317004 : long i,j, llist = lg(list)-1;
1657 [ + + ]: 846230 : for (j = 1; j <= llist; j++)
1658 : : {
1659 : 529233 : GEN L = gel(list,j), e;
1660 : 529233 : GEN cyc = gel(L,1), gen = gel(L,2), s = gel(L,4), U = gel(L,5);
1661 [ + + ]: 529233 : if (j == 1)
1662 : 317004 : e = mkcol( nf_log(nf, a, gel(gen,1), gel(cyc,1), pr) );
1663 : : else
1664 : 212229 : e = apply_U(U, a);
1665 : : /* here lg(e) == lg(cyc) */
1666 [ + + ]: 1548910 : for (i = 1; i < lg(cyc); i++)
1667 : : {
1668 : : GEN t;
1669 [ + + ]: 1019684 : if (typ(gel(e,i)) != t_INT) pari_err_COPRIME("zlog_pk", a, pr);
1670 : 1019677 : t = modii(negi(gel(e,i)), gel(cyc,i));
1671 [ + + ]: 1019677 : gel(++y,0) = negi(t); if (!signe(t)) continue;
1672 : :
1673 [ + + ]: 310636 : if (mod2(t)) Flv_add_inplace(*psigne, gel(s,i), 2);
1674 [ + + ]: 310636 : if (j != llist) a = elt_mulpow_modideal(nf, a, gel(gen,i), t, prk);
1675 : : }
1676 : : }
1677 : 316997 : return y;
1678 : : }
1679 : :
1680 : : static void
1681 : 309015 : zlog_add_sign(GEN y0, GEN sgn, GEN lists)
1682 : : {
1683 : : GEN y, s;
1684 : : long i;
1685 [ - + ]: 618030 : if (!sgn) return;
1686 : 309015 : y = y0 + lg(y0);
1687 : 309015 : s = Flm_Flc_mul(gmael(lists, lg(lists)-1, 3), sgn, 2);
1688 [ + + ][ + + ]: 717833 : for (i = lg(s)-1; i > 0; i--) gel(--y,0) = s[i]? gen_1: gen_0;
1689 : : }
1690 : :
1691 : : static GEN
1692 : 128521 : famat_zlog(GEN nf, GEN fa, GEN sgn, GEN bid)
1693 : : {
1694 : 128521 : GEN g = gel(fa,1), e = gel(fa,2);
1695 : 128521 : GEN vp = gmael(bid, 3,1), ep = gmael(bid, 3,2);
1696 : 128521 : GEN arch = bid_get_arch(bid);
1697 : 128521 : GEN cyc = bid_get_cyc(bid), lists = gel(bid,4), U = gel(bid,5);
1698 : 128521 : GEN y0, x, y, EX = gel(cyc,1);
1699 : : long i, l;
1700 : :
1701 : 128521 : y0 = y = cgetg(lg(U), t_COL);
1702 [ + - ]: 128521 : if (!sgn) sgn = nfsign_arch(nf, mkmat2(g,e), arch);
1703 : 128521 : l = lg(vp);
1704 [ + + ]: 252857 : for (i=1; i < l; i++)
1705 : : {
1706 : 124336 : GEN pr = gel(vp,i), prk, ex;
1707 [ + + ]: 124336 : if (l == 2) {
1708 : 88939 : prk = bid_get_ideal(bid);
1709 : 88939 : ex = EX;
1710 : : } else { /* try to improve EX: should be group exponent mod prf, not f */
1711 : 35397 : GEN k = gel(ep,i);
1712 : 35397 : prk = idealpow(nf, pr, k);
1713 : : /* upper bound: gcd(EX, (Nv-1)p^(k-1)) = (Nv-1) p^min(k-1,v_p(EX)) */
1714 : 35397 : ex = subis(pr_norm(pr),1);
1715 [ + + ]: 35397 : if (!is_pm1(k)) {
1716 : 2932 : GEN p = pr_get_p(pr), k_1 = subis(k,1);
1717 : 2932 : long v = Z_pval(EX, p);
1718 [ - + ]: 2932 : if (cmpui(v, k_1) > 0) v = itos(k_1);
1719 [ + - ]: 2932 : if (v) ex = mulii(ex, powiu(p, v));
1720 : : }
1721 : : }
1722 : 124336 : x = famat_makecoprime(nf, g, e, pr, prk, ex);
1723 : 124336 : y = zlog_pk(nf, x, y, pr, prk, gel(lists,i), &sgn);
1724 : : }
1725 : 128521 : zlog_add_sign(y0, sgn, lists);
1726 : 128521 : return y0;
1727 : : }
1728 : :
1729 : : static GEN
1730 : 122156 : get_index(GEN lists)
1731 : : {
1732 : 122156 : long t = 0, j, k, l = lg(lists)-1;
1733 : 122156 : GEN L, ind = cgetg(l+1, t_VECSMALL);
1734 : :
1735 [ + + ]: 269237 : for (k = 1; k < l; k++)
1736 : : {
1737 : 147081 : L = gel(lists,k);
1738 : 147081 : ind[k] = t;
1739 [ + + ]: 363689 : for (j=1; j<lg(L); j++) t += lg(gmael(L,j,1)) - 1;
1740 : : }
1741 : : /* for arch. components */
1742 : 122156 : ind[k] = t; return ind;
1743 : : }
1744 : :
1745 : : static void
1746 : 122156 : init_zlog(zlog_S *S, long n, GEN P, GEN e, GEN arch, GEN lists, GEN U)
1747 : : {
1748 : 122156 : S->n = n;
1749 : 122156 : S->U = U;
1750 : 122156 : S->P = P;
1751 : 122156 : S->e = e;
1752 : 122156 : S->archp = vec01_to_indices(arch);
1753 : 122156 : S->lists = lists;
1754 : 122156 : S->ind = get_index(lists);
1755 : 122156 : }
1756 : : void
1757 : 111369 : init_zlog_bid(zlog_S *S, GEN bid)
1758 : : {
1759 : 111369 : GEN fa = gel(bid,3), lists = gel(bid,4), U = gel(bid,5);
1760 : 111369 : GEN arch = gel(bid_get_mod(bid), 2);
1761 : 111369 : init_zlog(S, lg(U)-1, gel(fa,1), gel(fa,2), arch, lists, U);
1762 : 111369 : }
1763 : :
1764 : : /* Return decomposition of a on the S->n successive generators contained in
1765 : : * S->lists. If index !=0, do the computation for the corresponding prime
1766 : : * ideal and set to 0 the other components. */
1767 : : static GEN
1768 : 166300 : zlog_ind(GEN nf, GEN a, zlog_S *S, GEN sgn, long index)
1769 : : {
1770 : 166300 : GEN y0 = zerocol(S->n), y;
1771 : 166300 : pari_sp av = avma;
1772 : : long k, kmin, kmax;
1773 : :
1774 : 166300 : a = nf_to_scalar_or_basis(nf,a);
1775 [ + + ]: 166300 : if (index)
1776 : : {
1777 : 55648 : kmin = kmax = index;
1778 : 55648 : y = y0 + S->ind[index];
1779 : : }
1780 : : else
1781 : : {
1782 : 110652 : kmin = 1; kmax = lg(S->P)-1;
1783 : 110652 : y = y0;
1784 : : }
1785 [ + + ]: 166300 : if (!sgn) sgn = nfsign_arch(nf, a, S->archp);
1786 [ + + ]: 356383 : for (k = kmin; k <= kmax; k++)
1787 : : {
1788 : 190090 : GEN list= gel(S->lists,k);
1789 : 190090 : GEN pr = gel(S->P,k);
1790 : 190090 : GEN prk = idealpow(nf, pr, gel(S->e,k));
1791 : 190090 : y = zlog_pk(nf, a, y, pr, prk, list, &sgn);
1792 : : }
1793 : 166293 : zlog_add_sign(y0, sgn, S->lists);
1794 : 166293 : return gerepilecopy(av, y0);
1795 : : }
1796 : : /* sgn = sign(a, S->arch) or NULL if unknown */
1797 : : GEN
1798 : 110652 : zlog(GEN nf, GEN a, GEN sgn, zlog_S *S) { return zlog_ind(nf, a, S, sgn, 0); }
1799 : :
1800 : : /* Log on bid.gen of generators of P_{1,I pr^{e-1}} / P_{1,I pr^e} (I,pr) = 1,
1801 : : * defined implicitly via CRT. 'index' is the index of pr in modulus
1802 : : * factorization */
1803 : : GEN
1804 : 8178 : log_gen_pr(zlog_S *S, long index, GEN nf, long e)
1805 : : {
1806 : 8178 : long i, l, yind = S->ind[index];
1807 : 8178 : GEN y, A, L, L2 = gel(S->lists,index);
1808 : :
1809 [ + + ]: 8178 : if (e == 1)
1810 : : {
1811 : 6024 : L = gel(L2,1);
1812 : 6024 : y = col_ei(S->n, yind+1);
1813 : 6024 : zlog_add_sign(y, gmael(L,4,1), S->lists);
1814 : 6024 : retmkmat( ZM_ZC_mul(S->U, y) );
1815 : : }
1816 : : else
1817 : : {
1818 : 2154 : GEN prk, g, pr = gel(S->P,index);
1819 : 2154 : long narchp = lg(S->archp)-1;
1820 : :
1821 [ + + ]: 2154 : if (e == 2)
1822 : 1272 : L = gel(L2,2);
1823 : : else
1824 : 882 : L = zidealij(idealpows(nf,pr,e-1), idealpows(nf,pr,e), NULL);
1825 : 2154 : g = gel(L,2);
1826 : 2154 : l = lg(g); A = cgetg(l, t_MAT);
1827 : 2154 : prk = idealpow(nf, pr, gel(S->e,index));
1828 [ + + ]: 4732 : for (i = 1; i < l; i++)
1829 : : {
1830 : 2578 : GEN G = gel(g,i), sgn = zero_zv(narchp); /*positive at f_oo*/
1831 : 2578 : y = zerocol(S->n);
1832 : 2578 : (void)zlog_pk(nf, G, y + yind, pr, prk, L2, &sgn);
1833 : 2578 : zlog_add_sign(y, sgn, S->lists);
1834 : 2578 : gel(A,i) = y;
1835 : : }
1836 : 8178 : return ZM_mul(S->U, A);
1837 : : }
1838 : : }
1839 : : /* Log on bid.gen of generator of P_{1,f} / P_{1,f v[index]}
1840 : : * v = vector of r1 real places */
1841 : : GEN
1842 : 5599 : log_gen_arch(zlog_S *S, long index)
1843 : : {
1844 : 5599 : GEN y = zerocol(S->n);
1845 : 5599 : zlog_add_sign(y, vecsmall_ei(lg(S->archp)-1, index), S->lists);
1846 : 5599 : return ZM_ZC_mul(S->U, y);
1847 : : }
1848 : :
1849 : : /* add [h,cyc] or [h,cyc,gen] to bid */
1850 : : static void
1851 : 12516 : add_grp(GEN nf, GEN u1, GEN cyc, GEN gen, GEN bid)
1852 : : {
1853 : 12516 : GEN h = ZV_prod(cyc);
1854 [ + + ]: 12516 : if (u1)
1855 : : {
1856 : 6396 : GEN G = mkvec3(h,cyc,NULL/*dummy, bid[2] needed below*/);
1857 : 6396 : gel(bid,2) = G;
1858 [ + + ]: 6396 : if (u1 != gen_1)
1859 : : {
1860 : 5304 : long i, c = lg(u1);
1861 : 5304 : GEN g = cgetg(c,t_VEC);
1862 [ + + ]: 16224 : for (i=1; i<c; i++)
1863 : 10920 : gel(g,i) = famat_to_nf_moddivisor(nf, gen, gel(u1,i), bid);
1864 : 5304 : gen = g;
1865 : : }
1866 : 6396 : gel(G,3) = gen; /* replace dummy */
1867 : : }
1868 : : else
1869 : 6120 : gel(bid,2) = mkvec2(h,cyc);
1870 : 12516 : }
1871 : :
1872 : : static int
1873 : 3339 : RgV_is_prV(GEN v)
1874 : : {
1875 : 3339 : long l = lg(v), i;
1876 [ + + ]: 3409 : for (i = 1; i < l; i++)
1877 [ + + ]: 3339 : if (!get_prid(gel(v,i))) return 0;
1878 : 3339 : return 1;
1879 : : }
1880 : :
1881 : : static int
1882 : 11963 : is_nf_factor(GEN F)
1883 : : {
1884 [ + + ]: 22555 : return typ(F) == t_MAT && lg(F) == 3
1885 [ + + ][ + + ]: 22555 : && RgV_is_prV(gel(F,1)) && RgV_is_ZV(gel(F,2));
[ + - ]
1886 : : }
1887 : :
1888 : : /* Compute [[ideal,arch], [h,[cyc],[gen]], idealfact, [liste], U]
1889 : : flag may include nf_GEN | nf_INIT */
1890 : : GEN
1891 : 11963 : Idealstar(GEN nf, GEN ideal, long flag)
1892 : : {
1893 : 11963 : pari_sp av = avma;
1894 : : long i, j, k, nbp, R1, nbgen;
1895 : 11963 : GEN t, y, cyc, U, u1 = NULL, fa, lists, x, arch, archp, E, P, sarch, gen;
1896 : :
1897 : 11963 : nf = checknf(nf);
1898 : 11963 : R1 = nf_get_r1(nf);
1899 [ + + ][ + + ]: 11963 : if (typ(ideal) == t_VEC && lg(ideal) == 3)
1900 : : {
1901 : 4016 : arch = gel(ideal,2);
1902 : 4016 : ideal= gel(ideal,1);
1903 [ + - - ]: 4016 : switch(typ(arch))
1904 : : {
1905 : : case t_VEC:
1906 [ - + ]: 4016 : if (lg(arch) != R1+1)
1907 : 0 : pari_err_TYPE("Idealstar [incorrect archimedean component]",arch);
1908 : 4016 : archp = vec01_to_indices(arch);
1909 : 4016 : break;
1910 : : case t_VECSMALL:
1911 : 0 : archp = arch;
1912 : 0 : arch = vec01_to_indices(archp);
1913 : 0 : break;
1914 : : default:
1915 : 0 : pari_err_TYPE("Idealstar [incorrect archimedean component]",arch);
1916 : 0 : return NULL;
1917 : : }
1918 : 4016 : }
1919 : : else
1920 : : {
1921 : 7947 : arch = zerovec(R1);
1922 : 7947 : archp = cgetg(1, t_VECSMALL);
1923 : : }
1924 [ + + ]: 11963 : if (is_nf_factor(ideal))
1925 : : {
1926 : 70 : fa = ideal;
1927 : 70 : x = idealfactorback(nf, gel(fa,1), gel(fa,2), 0);
1928 : : }
1929 : : else
1930 : : {
1931 : 11893 : fa = NULL;
1932 : 11893 : x = idealhnf_shallow(nf, ideal);
1933 : : }
1934 [ + + ]: 11963 : if (lg(x) == 1) pari_err_DOMAIN("Idealstar", "ideal","=",gen_0,x);
1935 [ + + ]: 11956 : if (typ(gcoeff(x,1,1)) != t_INT)
1936 : 7 : pari_err_DOMAIN("Idealstar","denominator(ideal)", "!=",gen_1,x);
1937 : 11949 : sarch = nfarchstar(nf, x, archp);
1938 [ + + ]: 11949 : if (!fa) fa = idealfactor(nf, ideal);
1939 : 11949 : P = gel(fa,1);
1940 : 11949 : E = gel(fa,2); nbp = lg(P)-1;
1941 [ + + ]: 11949 : if (nbp)
1942 : : {
1943 : : GEN h;
1944 : 10794 : long cp = 0;
1945 : : zlog_S S;
1946 : :
1947 : 10794 : lists = cgetg(nbp+2,t_VEC);
1948 : : /* rough upper bound */
1949 [ + + ]: 22616 : nbgen = nbp + 1; for (i=1; i<=nbp; i++) nbgen += itos(gel(E,i));
1950 : 10794 : gen = cgetg(nbgen+1,t_VEC);
1951 : 10794 : nbgen = 1;
1952 [ + + ]: 10794 : t = (nbp==1)? NULL: x;
1953 [ + + ]: 22602 : for (i=1; i<=nbp; i++)
1954 : : {
1955 : 11815 : GEN L = zprimestar(nf, gel(P,i), gel(E,i), t, archp);
1956 : 11808 : gel(lists,i) = L;
1957 [ + + ]: 34086 : for (j = 1; j < lg(L); j++) gel(gen, nbgen++) = gmael(L,j,3);
1958 : : }
1959 : 10787 : gel(lists,i) = sarch;
1960 : 10787 : gel(gen, nbgen++) = gel(sarch,2); setlg(gen, nbgen);
1961 : 10787 : gen = shallowconcat1(gen); nbgen = lg(gen)-1;
1962 : :
1963 : 10787 : h = cgetg(nbgen+1,t_MAT);
1964 : 10787 : init_zlog(&S, nbgen, P, E, archp, lists, NULL);
1965 [ + + ]: 22595 : for (i=1; i<=nbp; i++)
1966 : : {
1967 : 11808 : GEN L2 = gel(lists,i);
1968 [ + + ]: 34086 : for (j=1; j < lg(L2); j++)
1969 : : {
1970 : 22278 : GEN L = gel(L2,j), F = gel(L,1), G = gel(L,3);
1971 [ + + ]: 77926 : for (k=1; k<lg(G); k++)
1972 : : { /* log(g^f) mod divisor */
1973 : 55648 : GEN g = gel(G,k), f = gel(F,k), a = nfpowmodideal(nf,g,f,x);
1974 : 55648 : GEN sgn = mpodd(f)? nfsign_arch(nf, g, S.archp)
1975 [ + + ]: 55648 : : zero_zv(lg(S.archp)-1);
1976 : 55648 : gel(h,++cp) = ZC_neg(zlog_ind(nf, a, &S, sgn, i));
1977 : 55648 : gcoeff(h,cp,cp) = f;
1978 : : }
1979 : : }
1980 : : }
1981 [ + + ]: 15105 : for (j=1; j<lg(archp); j++)
1982 : : {
1983 : 4318 : gel(h,++cp) = zerocol(nbgen);
1984 : 4318 : gcoeff(h,cp,cp) = gen_2;
1985 : : }
1986 : : /* assert(cp == nbgen) */
1987 : 10787 : h = ZM_hnfall(h,NULL,0);
1988 [ + + ]: 10787 : cyc = ZM_snf_group(h, &U, (flag & nf_GEN)? &u1: NULL);
1989 : : }
1990 : : else
1991 : : {
1992 : 1155 : lists = mkvec(sarch);
1993 : 1155 : gen = gel(sarch,2); nbgen = lg(gen)-1;
1994 : 1155 : cyc = const_vec(nbgen, gen_2);
1995 : 1155 : U = matid(nbgen);
1996 [ + + ]: 1155 : if (flag & nf_GEN) u1 = gen_1;
1997 : : }
1998 : :
1999 : 11942 : y = cgetg(6,t_VEC);
2000 : 11942 : gel(y,1) = mkvec2(x, arch);
2001 : 11942 : gel(y,3) = fa;
2002 : 11942 : gel(y,4) = lists;
2003 : 11942 : gel(y,5) = U;
2004 : 11942 : add_grp(nf, u1, cyc, gen, y);
2005 [ + + ]: 11942 : if (!(flag & nf_INIT)) y = gel(y,2);
2006 : 11942 : return gerepilecopy(av, y);
2007 : : }
2008 : :
2009 : : /* vectors of [[cyc],[g],U.X^-1] */
2010 : : static GEN
2011 : 7 : principal_units(GEN nf, GEN pr, long e)
2012 : : {
2013 : 7 : pari_sp av = avma;
2014 : : long a;
2015 : : GEN list, y, prb, pre;
2016 : : ulong mask;
2017 : :
2018 [ - + ]: 7 : if(DEBUGLEVEL>3) err_printf("treating pr^%ld, pr = %Ps\n",e,pr);
2019 [ - + ]: 7 : if (e == 1) return cgetg(1, t_VEC);
2020 : 7 : prb = idealhnf_two(nf,pr);
2021 : 7 : pre = idealpows(nf,pr,e);
2022 : 7 : list = vectrunc_init(e);
2023 : 7 : mask = quadratic_prec_mask(e);
2024 : 7 : a = 1;
2025 [ + + ]: 35 : while (mask > 1)
2026 : : {
2027 : 28 : GEN pra = prb, z, U;
2028 : 28 : long b = a << 1;
2029 : :
2030 [ + + ]: 28 : if (mask & 1) b--;
2031 : 28 : mask >>= 1;
2032 : : /* compute 1 + pr^a / 1 + pr^b, 2a <= b */
2033 [ - + ]: 28 : if(DEBUGLEVEL>3) err_printf(" treating a = %ld, b = %ld\n",a,b);
2034 [ + + ]: 28 : prb = (b >= e)? pre: idealpows(nf,pr,b);
2035 : 28 : z = zidealij(pra, prb, &U);
2036 : 28 : y = mkvec3(gel(z,1), gel(z,2), U);
2037 : 28 : vectrunc_append(list, y);
2038 : 28 : a = b;
2039 : : }
2040 : 7 : return gerepilecopy(av, list);
2041 : : }
2042 : :
2043 : : static GEN
2044 : 42 : log_prk(GEN nf, GEN a, long nbgen, GEN list, GEN prk)
2045 : : {
2046 : 42 : GEN y = zerocol(nbgen);
2047 : 42 : long i,j, iy = 1, llist = lg(list)-1;
2048 : :
2049 [ + + ]: 210 : for (j = 1; j <= llist; j++)
2050 : : {
2051 : 168 : GEN L = gel(list,j);
2052 : 168 : GEN cyc = gel(L,1), gen = gel(L,2), U = gel(L,3);
2053 : 168 : GEN e = apply_U(U, a);
2054 : : /* here lg(e) == lg(cyc) */
2055 [ + + ]: 420 : for (i = 1; i < lg(cyc); i++)
2056 : : {
2057 : 252 : GEN t = modii(negi(gel(e,i)), gel(cyc,i));
2058 [ + + ]: 252 : gel(y, iy++) = negi(t); if (!signe(t)) continue;
2059 [ + + ]: 28 : if (j != llist) a = elt_mulpow_modideal(nf, a, gel(gen,i), t, prk);
2060 : : }
2061 : : }
2062 : 42 : return y;
2063 : : }
2064 : :
2065 : : /* multiplicative group (1 + pr) / (1 + pr^e) */
2066 : : GEN
2067 : 7 : idealprincipalunits(GEN nf, GEN pr, long e)
2068 : : {
2069 : 7 : pari_sp av = avma;
2070 : : long c, i, j, k, nbgen;
2071 : 7 : GEN cyc, u1 = NULL, pre, gen;
2072 : : GEN g, EX, h, L2;
2073 : 7 : long cp = 0;
2074 : :
2075 : 7 : nf = checknf(nf); pre = idealpows(nf, pr, e);
2076 : 7 : L2 = principal_units(nf, pr, e);
2077 : 7 : c = lg(L2); gen = cgetg(c, t_VEC);
2078 [ + + ]: 35 : for (j = 1; j < c; j++) gel(gen, j) = gmael(L2,j,2);
2079 : 7 : gen = shallowconcat1(gen); nbgen = lg(gen)-1;
2080 : :
2081 : 7 : h = cgetg(nbgen+1,t_MAT);
2082 [ + + ]: 35 : for (j=1; j < lg(L2); j++)
2083 : : {
2084 : 28 : GEN L = gel(L2,j), F = gel(L,1), G = gel(L,2);
2085 [ + + ]: 70 : for (k=1; k<lg(G); k++)
2086 : : { /* log(g^f) mod pr^e */
2087 : 42 : GEN g = gel(G,k), f = gel(F,k), a = nfpowmodideal(nf,g,f,pre);
2088 : 42 : gel(h,++cp) = ZC_neg(log_prk(nf, a, nbgen, L2, pre));
2089 : 42 : gcoeff(h,cp,cp) = f;
2090 : : }
2091 : : }
2092 : : /* assert(cp == nbgen) */
2093 : 7 : h = ZM_hnfall(h,NULL,0);
2094 : 7 : cyc = ZM_snf_group(h, NULL, &u1);
2095 : 7 : c = lg(u1); g = cgetg(c, t_VEC); EX = gel(cyc,1);
2096 [ + + ]: 28 : for (i=1; i<c; i++)
2097 : 21 : gel(g,i) = famat_to_nf_modideal_coprime(nf, gen, gel(u1,i), pre, EX);
2098 : 7 : return gerepilecopy(av, mkvec3(powiu(pr_norm(pr), e-1), cyc, g));
2099 : : }
2100 : :
2101 : : /* FIXME: obsolete */
2102 : : GEN
2103 : 0 : zidealstarinitgen(GEN nf, GEN ideal)
2104 : 0 : { return Idealstar(nf,ideal, nf_INIT|nf_GEN); }
2105 : : GEN
2106 : 4926 : zidealstarinit(GEN nf, GEN ideal)
2107 : 4926 : { return Idealstar(nf,ideal, nf_INIT); }
2108 : : GEN
2109 : 0 : zidealstar(GEN nf, GEN ideal)
2110 : 0 : { return Idealstar(nf,ideal, nf_GEN); }
2111 : :
2112 : : GEN
2113 : 84 : idealstar0(GEN nf, GEN ideal,long flag)
2114 : : {
2115 [ + + + - ]: 84 : switch(flag)
2116 : : {
2117 : 7 : case 0: return Idealstar(nf,ideal, nf_GEN);
2118 : 63 : case 1: return Idealstar(nf,ideal, nf_INIT);
2119 : 14 : case 2: return Idealstar(nf,ideal, nf_INIT|nf_GEN);
2120 : 0 : default: pari_err_FLAG("idealstar");
2121 : : }
2122 : 63 : return NULL; /* not reached */
2123 : : }
2124 : :
2125 : : void
2126 : 167653 : check_nfelt(GEN x, GEN *den)
2127 : : {
2128 : 167653 : long l = lg(x), i;
2129 : 167653 : GEN t, d = NULL;
2130 [ - + ]: 167653 : if (typ(x) != t_COL) pari_err_TYPE("check_nfelt", x);
2131 [ + + ]: 695394 : for (i=1; i<l; i++)
2132 : : {
2133 : 527741 : t = gel(x,i);
2134 [ + + - ]: 527741 : switch (typ(t))
2135 : : {
2136 : 371755 : case t_INT: break;
2137 : : case t_FRAC:
2138 [ + + ]: 155986 : if (!d) d = gel(t,2); else d = lcmii(d, gel(t,2));
2139 : 155986 : break;
2140 : 0 : default: pari_err_TYPE("check_nfelt", x);
2141 : : }
2142 : : }
2143 : 167653 : *den = d;
2144 : 167653 : }
2145 : :
2146 : : GEN
2147 : 463265 : vecmodii(GEN a, GEN b)
2148 : : {
2149 : : long i, l;
2150 : 463265 : GEN c = cgetg_copy(a, &l);
2151 [ + + ]: 1516516 : for (i = 1; i < l; i++) gel(c,i) = modii(gel(a,i), gel(b,i));
2152 : 463265 : return c;
2153 : : }
2154 : :
2155 : : /* Given x (not necessarily integral), and bid as output by zidealstarinit,
2156 : : * compute the vector of components on the generators bid[2].
2157 : : * Assume (x,bid) = 1 and sgn is either NULL or nfsign_arch(x, bid) */
2158 : : GEN
2159 : 227419 : ideallog_sgn(GEN nf, GEN x, GEN sgn, GEN bid)
2160 : : {
2161 : : pari_sp av;
2162 : : long lcyc;
2163 : : GEN den, cyc, y;
2164 : :
2165 : 227419 : nf = checknf(nf); checkbid(bid);
2166 : 227419 : cyc = bid_get_cyc(bid);
2167 [ + + ]: 227419 : lcyc = lg(cyc); if (lcyc == 1) return cgetg(1, t_COL);
2168 : 227391 : av = avma;
2169 [ + + ]: 227391 : if (typ(x) == t_MAT) {
2170 [ - + ]: 55604 : if (lg(x) == 1) return zerocol(lcyc-1); /* x = 1 */
2171 : 55604 : y = famat_zlog(nf, x, sgn, bid);
2172 : 55604 : goto END;
2173 : : }
2174 : 171787 : x = nf_to_scalar_or_basis(nf, x);
2175 [ + + + ]: 171787 : switch(typ(x))
2176 : : {
2177 : : case t_INT:
2178 : 4127 : den = NULL;
2179 : 4127 : break;
2180 : : case t_FRAC:
2181 : 7 : den = gel(x,2);
2182 : 7 : x = gel(x,1);
2183 : 7 : break;
2184 : : default: /* case t_COL: */
2185 : 167653 : check_nfelt(x, &den);
2186 [ + + ]: 167653 : if (den) x = Q_muli_to_int(x, den);
2187 : : }
2188 [ + + ]: 171787 : if (den)
2189 : : {
2190 : 72917 : x = mkmat2(mkcol2(x, den), mkcol2(gen_1, gen_m1));
2191 : 72917 : y = famat_zlog(nf, x, sgn, bid);
2192 : : }
2193 : : else
2194 : : {
2195 : 98870 : zlog_S S; init_zlog_bid(&S, bid);
2196 : 98870 : y = zlog(nf, x, sgn, &S);
2197 : : }
2198 : : END:
2199 : 227384 : y = ZM_ZC_mul(gel(bid,5), y);
2200 : 227412 : return gerepileupto(av, vecmodii(y, cyc));
2201 : : }
2202 : : GEN
2203 : 227419 : ideallog(GEN nf, GEN x, GEN bid) { return ideallog_sgn(nf, x, NULL, bid); }
2204 : :
2205 : : /*************************************************************************/
2206 : : /** **/
2207 : : /** JOIN BID STRUCTURES, IDEAL LISTS **/
2208 : : /** **/
2209 : : /*************************************************************************/
2210 : :
2211 : : /* bid1, bid2: for coprime modules m1 and m2 (without arch. part).
2212 : : * Output: bid [[m1 m2,arch],[h,[cyc],[gen]],idealfact,[liste],U] for m1 m2 */
2213 : : static GEN
2214 : 910 : join_bid(GEN nf, GEN bid1, GEN bid2)
2215 : : {
2216 : 910 : pari_sp av = avma;
2217 : : long i, nbgen, lx, lx1,lx2, l1,l2;
2218 : : GEN I1,I2, G1,G2, fa1,fa2, lists1,lists2, cyc1,cyc2;
2219 : 910 : GEN lists, fa, U, cyc, y, u1 = NULL, x, gen;
2220 : :
2221 : 910 : I1 = bid_get_ideal(bid1);
2222 : 910 : I2 = bid_get_ideal(bid2);
2223 [ + + ]: 910 : if (gequal1(gcoeff(I1,1,1))) return bid2; /* frequent trivial case */
2224 : 518 : G1 = bid_get_grp(bid1);
2225 : 518 : G2 = bid_get_grp(bid2);
2226 : 518 : fa1= gel(bid1,3);
2227 : 518 : fa2= gel(bid2,3); x = idealmul(nf, I1,I2);
2228 : 518 : fa = famat_mul_shallow(fa1, fa2);
2229 : 518 : lists1 = gel(bid1,4); lx1 = lg(lists1);
2230 : 518 : lists2 = gel(bid2,4); lx2 = lg(lists2);
2231 : : /* concat (lists1 - last elt [nfarchstar]) + lists2 */
2232 : 518 : lx = lx1+lx2-2; lists = cgetg(lx,t_VEC);
2233 [ + + ]: 1078 : for (i=1; i<lx1-1; i++) gel(lists,i) = gel(lists1,i);
2234 [ + + ]: 1554 : for ( ; i<lx; i++) gel(lists,i) = gel(lists2,i-lx1+2);
2235 : :
2236 : 518 : cyc1 = abgrp_get_cyc(G1); l1 = lg(cyc1);
2237 : 518 : cyc2 = abgrp_get_cyc(G2); l2 = lg(cyc2);
2238 [ + - ][ + - ]: 518 : gen = (lg(G1)>3 && lg(G2)>3)? gen_1: NULL;
2239 : 518 : nbgen = l1+l2-2;
2240 [ + - ]: 518 : cyc = ZM_snf_group(diagonal_shallow(shallowconcat(cyc1,cyc2)),
2241 : : &U, gen? &u1: NULL);
2242 [ + - ]: 518 : if (nbgen) {
2243 : 518 : GEN U1 = gel(bid1,5), U2 = gel(bid2,5);
2244 [ - + ]: 518 : U1 = l1 == 1? zeromat(nbgen,lg(U1)-1): ZM_mul(vecslice(U, 1, l1-1), U1);
2245 [ - + ]: 518 : U2 = l2 == 1? zeromat(nbgen,lg(U2)-1): ZM_mul(vecslice(U, l1, nbgen), U2);
2246 : 518 : U = shallowconcat(U1, U2);
2247 : : }
2248 : : else
2249 : 0 : U = zeromat(0, lx-2);
2250 : :
2251 [ + - ]: 518 : if (gen)
2252 : : {
2253 : 518 : GEN mu,mv, u,v = idealaddtoone_i(nf,I2,I1);
2254 : 518 : mv = zk_scalar_or_multable(nf, v);
2255 [ + + ]: 518 : if (typ(mv) == t_INT)
2256 : : {
2257 : 42 : mu = u = subui(1,mv);
2258 : 42 : v = mv;
2259 : : }
2260 : : else
2261 : : {
2262 : 476 : u = unnf_minus_x(v);
2263 : 476 : mu = RgM_Rg_add(ZM_neg(mv), gen_1); /* mult by u = 1-v */
2264 : : }
2265 : 518 : gen = shallowconcat(makeprimetoidealvec(x,u,mv, abgrp_get_gen(G1)),
2266 : : makeprimetoidealvec(x,v,mu, abgrp_get_gen(G2)));
2267 : : }
2268 : 518 : y = cgetg(6,t_VEC);
2269 : 518 : gel(y,1) = mkvec2(x, bid_get_arch(bid1));
2270 : 518 : gel(y,3) = fa;
2271 : 518 : gel(y,4) = lists;
2272 : 518 : gel(y,5) = U;
2273 : 518 : add_grp(nf, u1, cyc, gen, y);
2274 : 910 : return gerepilecopy(av,y);
2275 : : }
2276 : :
2277 : : typedef struct _ideal_data {
2278 : : GEN nf, emb, L, pr, prL, arch, sgnU;
2279 : : } ideal_data;
2280 : :
2281 : : /* z <- ( z | f(v[i])_{i=1..#v} ) */
2282 : : static void
2283 : 43939 : concat_join(GEN *pz, GEN v, GEN (*f)(ideal_data*,GEN), ideal_data *data)
2284 : : {
2285 : 43939 : long i, nz, lv = lg(v);
2286 : : GEN z, Z;
2287 [ + + ]: 63133 : if (lv == 1) return;
2288 : 19194 : z = *pz; nz = lg(z)-1;
2289 : 19194 : *pz = Z = cgetg(lv + nz, typ(z));
2290 [ + + ]: 37107 : for (i = 1; i <=nz; i++) gel(Z,i) = gel(z,i);
2291 : 19194 : Z += nz;
2292 [ + + ]: 46228 : for (i = 1; i < lv; i++) gel(Z,i) = f(data, gel(v,i));
2293 : : }
2294 : : static GEN
2295 : 910 : join_idealinit(ideal_data *D, GEN x) {
2296 : 910 : return join_bid(D->nf, x, D->prL);
2297 : : }
2298 : : static GEN
2299 : 26124 : join_ideal(ideal_data *D, GEN x) {
2300 : 26124 : return idealmulpowprime(D->nf, x, D->pr, D->L);
2301 : : }
2302 : : static GEN
2303 : 889 : join_unit(ideal_data *D, GEN x) {
2304 : 889 : return mkvec2(join_idealinit(D, gel(x,1)), vconcat(gel(x,2), D->emb));
2305 : : }
2306 : :
2307 : : /* compute matrix of zlogs of units */
2308 : : GEN
2309 : 42 : zlog_units(GEN nf, GEN U, GEN sgnU, GEN bid)
2310 : : {
2311 : 42 : long j, l = lg(U);
2312 : 42 : GEN m = cgetg(l, t_MAT);
2313 : 42 : zlog_S S; init_zlog_bid(&S, bid);
2314 [ + + ]: 119 : for (j = 1; j < l; j++)
2315 : 77 : gel(m,j) = zlog(nf, gel(U,j), vecsmallpermute(gel(sgnU,j), S.archp), &S);
2316 : 42 : return m;
2317 : : }
2318 : : /* compute matrix of zlogs of units, assuming S.archp = [] */
2319 : : GEN
2320 : 679 : zlog_units_noarch(GEN nf, GEN U, GEN bid)
2321 : : {
2322 : 679 : long j, l = lg(U);
2323 : 679 : GEN m = cgetg(l, t_MAT), empty = cgetg(1, t_COL);
2324 : 679 : zlog_S S; init_zlog_bid(&S, bid);
2325 [ + + ]: 2016 : for (j = 1; j < l; j++) gel(m,j) = zlog(nf, gel(U,j), empty, &S);
2326 : 679 : return m;
2327 : : }
2328 : :
2329 : : /* calcule la matrice des zlog des unites */
2330 : : static GEN
2331 : 28 : zlog_unitsarch(GEN sgnU, GEN bid)
2332 : : {
2333 : 28 : GEN lists = gel(bid,4), arch = gmael(bid,1,2);
2334 : 28 : GEN listslast = gel(lists,lg(lists)-1);
2335 : 28 : GEN m = rowpermute(sgnU, vec01_to_indices(arch));
2336 : 28 : return Flm_mul(gel(listslast,3), m, 2);
2337 : : }
2338 : :
2339 : : /* flag & nf_GEN : generators, otherwise no
2340 : : * flag &2 : units, otherwise no
2341 : : * flag &4 : ideals in HNF, otherwise bid */
2342 : : static GEN
2343 : 357 : Ideallist(GEN bnf, ulong bound, long flag)
2344 : : {
2345 : 357 : const long do_units = flag & 2, big_id = !(flag & 4);
2346 : 357 : const long istar_flag = (flag & nf_GEN) | nf_INIT;
2347 : 357 : pari_sp lim, av, av0 = avma;
2348 : : long i, j, l;
2349 : 357 : GEN nf, z, p, fa, id, U, empty = cgetg(1,t_VEC);
2350 : : forprime_t S;
2351 : : ideal_data ID;
2352 : 357 : GEN (*join_z)(ideal_data*, GEN) =
2353 : : do_units? &join_unit
2354 [ + + ][ + + ]: 357 : : (big_id? &join_idealinit: &join_ideal);
2355 : :
2356 : 357 : nf = checknf(bnf);
2357 [ - + ]: 357 : if ((long)bound <= 0) return empty;
2358 : 357 : id = matid(nf_get_degree(nf));
2359 [ + + ]: 357 : if (big_id) id = Idealstar(nf,id, istar_flag);
2360 : :
2361 : : /* z[i] will contain all "objects" of norm i. Depending on flag, this means
2362 : : * an ideal, a bid, or a couple [bid, log(units)]. Such objects are stored
2363 : : * in vectors, computed one primary component at a time; join_z
2364 : : * reconstructs the global object */
2365 : 357 : z = cgetg(bound+1,t_VEC);
2366 [ + + ]: 357 : if (do_units) {
2367 : 21 : U = init_units(bnf);
2368 : 21 : gel(z,1) = mkvec( mkvec2(id, zlog_units_noarch(nf, U, id)) );
2369 : : } else {
2370 : 336 : U = NULL; /* -Wall */
2371 : 336 : gel(z,1) = mkvec(id);
2372 : : }
2373 [ + + ]: 16856 : for (i=2; i<=(long)bound; i++) gel(z,i) = empty;
2374 : 357 : ID.nf = nf;
2375 : :
2376 : 357 : p = cgetipos(3);
2377 : 357 : u_forprime_init(&S, 2, bound);
2378 : 357 : av = avma; lim = stack_lim(av,1);
2379 [ + + ]: 5446 : while ((p[2] = u_forprime_next(&S)))
2380 : : {
2381 [ - + ]: 5089 : if (DEBUGLEVEL>1) { err_printf("%ld ",p[2]); err_flush(); }
2382 : 5089 : fa = idealprimedec(nf, p);
2383 [ + + ]: 10206 : for (j=1; j<lg(fa); j++)
2384 : : {
2385 : 7770 : GEN pr = gel(fa,j), z2;
2386 : 7770 : long f = pr_get_f(pr);
2387 : 7770 : ulong q, Q = upowuu(p[2], f);
2388 [ + - ][ + + ]: 7770 : if (!Q || Q > bound) break;
2389 : :
2390 : 5117 : z2 = leafcopy(z);
2391 : 5117 : q = Q;
2392 : 5117 : ID.pr = ID.prL = pr;
2393 [ + + ]: 13545 : for (l=1; Q <= bound; l++, Q *= q) /* add pr^l */
2394 : : {
2395 : : ulong iQ;
2396 : 8428 : ID.L = utoipos(l);
2397 [ + + ]: 8428 : if (big_id) {
2398 [ + + ]: 392 : if (l > 1) ID.prL = idealpow(nf,pr,ID.L);
2399 : 392 : ID.prL = Idealstar(nf,ID.prL, istar_flag);
2400 [ + + ]: 392 : if (do_units) ID.emb = zlog_units_noarch(nf, U, ID.prL);
2401 : : }
2402 [ + + ]: 52367 : for (iQ = Q,i = 1; iQ <= bound; iQ += Q,i++)
2403 : 43939 : concat_join(&gel(z,iQ), gel(z2,i), join_z, &ID);
2404 : : }
2405 : : }
2406 [ - + ]: 5089 : if (low_stack(lim, stack_lim(av,1)))
2407 : : {
2408 [ # # ]: 0 : if(DEBUGMEM>1) pari_warn(warnmem,"Ideallist");
2409 : 0 : z = gerepilecopy(av, z);
2410 : : }
2411 : : }
2412 [ + + ][ + + ]: 1155 : if (do_units) for (i = 1; i < lg(z); i++)
2413 : : {
2414 : 798 : GEN s = gel(z,i);
2415 : 798 : long l = lg(s);
2416 [ + + ]: 1708 : for (j = 1; j < l; j++) {
2417 : 910 : GEN v = gel(s,j), bid = gel(v,1);
2418 : 910 : gel(v,2) = ZM_mul(gel(bid,5), gel(v,2));
2419 : : }
2420 : : }
2421 : 357 : return gerepilecopy(av0, z);
2422 : : }
2423 : : GEN
2424 : 35 : ideallist0(GEN bnf,long bound, long flag) {
2425 [ + - ][ - + ]: 35 : if (flag<0 || flag>4) pari_err_FLAG("ideallist");
2426 : 35 : return Ideallist(bnf,bound,flag);
2427 : : }
2428 : : GEN
2429 : 322 : ideallist(GEN bnf,long bound) { return Ideallist(bnf,bound,4); }
2430 : :
2431 : : /* bid1 = for module m1 (without arch. part), arch = archimedean part.
2432 : : * Output: bid [[m1,arch],[h,[cyc],[gen]],idealfact,[liste],U] for m1.arch */
2433 : : static GEN
2434 : 56 : join_bid_arch(GEN nf, GEN bid1, GEN arch)
2435 : : {
2436 : 56 : pari_sp av = avma;
2437 : : GEN f1, G1, fa1, U;
2438 : 56 : GEN lists, cyc, y, u1 = NULL, x, sarch, gen;
2439 : :
2440 : 56 : checkbid(bid1);
2441 : 56 : f1 = gel(bid1,1); G1 = gel(bid1,2); fa1 = gel(bid1,3);
2442 : 56 : x = gel(f1,1);
2443 : 56 : sarch = nfarchstar(nf, x, arch);
2444 : 56 : lists = leafcopy(gel(bid1,4));
2445 : 56 : gel(lists,lg(lists)-1) = sarch;
2446 : :
2447 [ + + ]: 56 : gen = (lg(G1)>3)? gen_1: NULL;
2448 : 56 : cyc = diagonal_shallow(shallowconcat(gel(G1,2), gel(sarch,1)));
2449 [ + + ]: 56 : cyc = ZM_snf_group(cyc, &U, gen? &u1: NULL);
2450 [ + + ]: 56 : if (gen) gen = shallowconcat(gel(G1,3), gel(sarch,2));
2451 : 56 : y = cgetg(6,t_VEC);
2452 : 56 : gel(y,1) = mkvec2(x, arch);
2453 : 56 : gel(y,3) = fa1;
2454 : 56 : gel(y,4) = lists;
2455 : 56 : gel(y,5) = U;
2456 : 56 : add_grp(nf, u1, cyc, gen, y);
2457 : 56 : return gerepilecopy(av,y);
2458 : : }
2459 : : static GEN
2460 : 56 : join_arch(ideal_data *D, GEN x) {
2461 : 56 : return join_bid_arch(D->nf, x, D->arch);
2462 : : }
2463 : : static GEN
2464 : 28 : join_archunit(ideal_data *D, GEN x) {
2465 : 28 : GEN bid = join_arch(D, gel(x,1)), U = gel(x,2);
2466 : 28 : U = ZM_mul(gel(bid,5), vconcat(U, zm_to_ZM(zlog_unitsarch(D->sgnU, bid))));
2467 : 28 : return mkvec2(bid, U);
2468 : : }
2469 : :
2470 : : /* L from ideallist, add archimedean part */
2471 : : GEN
2472 : 14 : ideallistarch(GEN bnf, GEN L, GEN arch)
2473 : : {
2474 : : pari_sp av;
2475 : 14 : long i, j, l = lg(L), lz;
2476 : : GEN v, z, V;
2477 : : ideal_data ID;
2478 : : GEN (*join_z)(ideal_data*, GEN);
2479 : :
2480 [ - + ]: 14 : if (typ(L) != t_VEC) pari_err_TYPE("ideallistarch",L);
2481 [ - + ]: 14 : if (l == 1) return cgetg(1,t_VEC);
2482 : 14 : z = gel(L,1);
2483 [ - + ]: 14 : if (typ(z) != t_VEC) pari_err_TYPE("ideallistarch",z);
2484 : 14 : z = gel(z,1); /* either a bid or [bid,U] */
2485 [ + + ]: 14 : if (lg(z) == 3) { /* the latter: do units */
2486 [ - + ]: 7 : if (typ(z) != t_VEC) pari_err_TYPE("ideallistarch",z);
2487 : 7 : ID.sgnU = nfsign_units(bnf, NULL, 1);
2488 : 7 : join_z = &join_archunit;
2489 : : } else
2490 : 7 : join_z = &join_arch;
2491 : 14 : ID.nf = checknf(bnf);
2492 : 14 : ID.arch = vec01_to_indices(arch);
2493 : 14 : av = avma; V = cgetg(l, t_VEC);
2494 [ + + ]: 70 : for (i = 1; i < l; i++)
2495 : : {
2496 : 56 : z = gel(L,i); lz = lg(z);
2497 : 56 : gel(V,i) = v = cgetg(lz,t_VEC);
2498 [ + + ]: 112 : for (j=1; j<lz; j++) gel(v,j) = join_z(&ID, gel(z,j));
2499 : : }
2500 : 14 : return gerepilecopy(av,V);
2501 : : }
|
