1 /* $Id: base3.c 8269 2006-12-11 14:29:52Z kb $
2
3 Copyright (C) 2000 The PARI group.
4
5 This file is part of the PARI/GP package.
6
7 PARI/GP is free software; you can redistribute it and/or modify it under the
8 terms of the GNU General Public License as published by the Free Software
9 Foundation. It is distributed in the hope that it will be useful, but WITHOUT
10 ANY WARRANTY WHATSOEVER.
11
12 Check the License for details. You should have received a copy of it, along
13 with the package; see the file 'COPYING'. If not, write to the Free Software
14 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
15
16 /*******************************************************************/
17 /* */
18 /* BASIC NF OPERATIONS */
19 /* */
20 /*******************************************************************/
21 #include "pari.h"
22 #include "paripriv.h"
23
24 /*******************************************************************/
25 /* */
26 /* OPERATIONS OVER NUMBER FIELD ELEMENTS. */
27 /* represented as column vectors over the integral basis nf[7] */
28 /* */
29 /*******************************************************************/
30
31 int
RgV_isscalar(GEN x)32 RgV_isscalar(GEN x)
33 {
34 long lx = lg(x),i;
35 for (i=2; i<lx; i++)
36 if (!gcmp0(gel(x, i))) return 0;
37 return 1;
38 }
39 int
isnfscalar(GEN x)40 isnfscalar(GEN x) { return typ(x) == t_COL? RgV_isscalar(x): 0; }
41
42 static GEN
scal_mul(GEN nf,GEN x,GEN y,long ty)43 scal_mul(GEN nf, GEN x, GEN y, long ty)
44 {
45 pari_sp av=avma, tetpil;
46 GEN p1;
47
48 if (!is_extscalar_t(ty))
49 {
50 if (ty!=t_COL) pari_err(typeer,"nfmul");
51 y = coltoliftalg(nf, y);
52 }
53 p1 = gmul(x,y); tetpil=avma;
54 return gerepile(av,tetpil,algtobasis(nf,p1));
55 }
56
57 static GEN
get_tab(GEN nf,long * N)58 get_tab(GEN nf, long *N)
59 {
60 GEN tab = (typ(nf) == t_MAT)? nf: gel(nf,9);
61 *N = lg(tab[1])-1; return tab;
62 }
63
64 /* x != 0 t_INT. Return x * y (not memory clean) */
65 static GEN
_mulix(GEN x,GEN y)66 _mulix(GEN x, GEN y) {
67 return is_pm1(x)? (signe(x) < 0)? gneg(y): y
68 : gmul(x, y);
69 }
70 /* x != 0, y t_INT. Return x * y (not memory clean) */
71 static GEN
_mulii(GEN x,GEN y)72 _mulii(GEN x, GEN y) {
73 return is_pm1(x)? (signe(x) < 0)? negi(y): y
74 : mulii(x, y);
75 }
76
77 /* compute xy as ( sum_i x_i sum_j y_j m^{i,j}_k )_k.
78 * Assume tab in M_{N x N^2}(Z), with x, y R^N (R arbitrary) */
79 static GEN
mul_by_tabi(GEN tab,GEN x,GEN y)80 mul_by_tabi(GEN tab, GEN x, GEN y)
81 {
82 long i, j, k, N = lg(x)-1;
83 GEN s, v = cgetg(N+1,t_COL);
84
85 for (k=1; k<=N; k++)
86 {
87 pari_sp av = avma;
88 if (k == 1)
89 s = gmul(gel(x,1),gel(y,1));
90 else
91 s = gadd(gmul(gel(x,1),gel(y,k)),
92 gmul(gel(x,k),gel(y,1)));
93 for (i=2; i<=N; i++)
94 {
95 GEN t, xi = gel(x,i);
96 long base;
97 if (gcmp0(xi)) continue;
98
99 base = (i-1)*N;
100 t = NULL;
101 for (j=2; j<=N; j++)
102 {
103 GEN p1, c = gcoeff(tab,k,base+j); /* m^{i,j}_k */
104 if (!signe(c)) continue;
105 p1 = _mulix(c, gel(y,j));
106 t = t? gadd(t, p1): p1;
107 }
108 if (t) s = gadd(s, gmul(xi, t));
109 }
110 gel(v,k) = gerepileupto(av,s);
111 }
112 return v;
113 }
114
115 /* product of x and y in nf */
116 GEN
element_mul(GEN nf,GEN x,GEN y)117 element_mul(GEN nf, GEN x, GEN y)
118 {
119 long N,tx,ty;
120 GEN tab;
121
122 if (x == y) return element_sqr(nf,x);
123
124 tx=typ(x); ty=typ(y);
125 nf=checknf(nf);
126 if (tx==t_POLMOD) x=checknfelt_mod(nf,x,"element_mul");
127 if (ty==t_POLMOD) y=checknfelt_mod(nf,y,"element_mul");
128 if (is_extscalar_t(tx)) return scal_mul(nf,x,y,ty);
129 if (is_extscalar_t(ty)) return scal_mul(nf,y,x,tx);
130 if (tx != t_COL || ty != t_COL) pari_err(typeer,"element_mul");
131 if (RgV_isscalar(x)) return gmul(gel(x,1),y);
132 if (RgV_isscalar(y)) return gmul(gel(y,1),x);
133
134 tab = get_tab(nf, &N);
135 return mul_by_tabi(tab,x,y);
136 }
137
138 /* inverse of x in nf */
139 GEN
element_inv(GEN nf,GEN x)140 element_inv(GEN nf, GEN x)
141 {
142 pari_sp av=avma;
143 long i,N,tx=typ(x);
144 GEN p1;
145
146 nf=checknf(nf); N=degpol(nf[1]);
147 if (is_extscalar_t(tx))
148 {
149 if (tx==t_POLMOD) (void)checknfelt_mod(nf,x,"element_inv");
150 else if (tx==t_POL) x=gmodulo(x,gel(nf,1));
151 return gerepileupto(av, algtobasis(nf, ginv(x)));
152 }
153 if (tx != t_COL) pari_err(typeer,"element_inv");
154 if (RgV_isscalar(x))
155 {
156 p1=cgetg(N+1,t_COL); gel(p1,1) = ginv(gel(x,1));
157 for (i=2; i<=N; i++) gel(p1,i) = gcopy(gel(x,i));
158 return p1;
159 }
160 p1 = QXQ_inv(coltoliftalg(nf,x), gel(nf,1));
161 return gerepileupto(av, poltobasis(nf,p1));
162 }
163
164 /* quotient of x and y in nf */
165 GEN
element_div(GEN nf,GEN x,GEN y)166 element_div(GEN nf, GEN x, GEN y)
167 {
168 pari_sp av=avma;
169 long tx = typ(x), ty = typ(y);
170 GEN p1;
171
172 nf=checknf(nf);
173 if (tx==t_POLMOD) (void)checknfelt_mod(nf,x,"element_div");
174 else if (tx==t_POL) x=gmodulo(x,gel(nf,1));
175
176 if (ty==t_POLMOD) (void)checknfelt_mod(nf,y,"element_div");
177 else if (ty==t_POL) y=gmodulo(y,gel(nf,1));
178
179 if (is_extscalar_t(tx))
180 {
181 if (is_extscalar_t(ty)) p1=gdiv(x,y);
182 else
183 {
184 if (ty!=t_COL) pari_err(typeer,"nfdiv");
185 p1 = gdiv(x, coltoalg(nf, y));
186 }
187 return gerepileupto(av, algtobasis(nf,p1));
188 }
189 if (is_extscalar_t(ty))
190 {
191 if (tx!=t_COL) pari_err(typeer,"nfdiv");
192 p1 = gdiv(coltoalg(nf,x), y);
193 return gerepileupto(av, algtobasis(nf,p1));
194 }
195 if (tx != t_COL || ty != t_COL) pari_err(typeer,"element_div");
196
197 if (RgV_isscalar(y)) return gdiv(x,gel(y,1));
198 if (RgV_isscalar(x))
199 {
200 p1=element_inv(nf,y);
201 return gerepileupto(av, gmul(gel(x,1),p1));
202 }
203
204 p1 = gmul(coltoliftalg(nf,x), QXQ_inv(coltoliftalg(nf,y), gel(nf,1)));
205 p1 = RgX_rem(p1, gel(nf,1));
206 return gerepileupto(av, poltobasis(nf,p1));
207 }
208
209 /* product of INTEGERS (i.e vectors with integral coeffs) x and y in nf */
210 GEN
element_muli(GEN nf,GEN x,GEN y)211 element_muli(GEN nf, GEN x, GEN y)
212 {
213 long i, j, k, N, tx = typ(x), ty = typ(y);
214 GEN s, v, tab = get_tab(nf, &N);
215
216 if (tx == t_INT) { return ty == t_INT? gscalcol(mulii(x,y), N): gmul(x, y); }
217 if (tx != t_COL || lg(x) != N+1
218 || ty != t_COL || lg(y) != N+1) pari_err(typeer,"element_muli");
219 v = cgetg(N+1,t_COL);
220 for (k=1; k<=N; k++)
221 {
222 pari_sp av = avma;
223 if (k == 1)
224 s = mulii(gel(x,1),gel(y,1));
225 else
226 s = addii(mulii(gel(x,1),gel(y,k)),
227 mulii(gel(x,k),gel(y,1)));
228 for (i=2; i<=N; i++)
229 {
230 GEN t, xi = gel(x,i);
231 long base;
232 if (!signe(xi)) continue;
233
234 base = (i-1)*N;
235 t = NULL;
236 for (j=2; j<=N; j++)
237 {
238 GEN p1, c = gcoeff(tab,k,base+j); /* m^{i,j}_k */
239 if (!signe(c)) continue;
240 p1 = _mulii(c, gel(y,j));
241 t = t? addii(t, p1): p1;
242 }
243 if (t) s = addii(s, mulii(xi, t));
244 }
245 gel(v,k) = gerepileuptoint(av,s);
246 }
247 return v;
248 }
249
250 /* product of INTEGERS (i.e vectors with integral coeffs) x and y in nf */
251 GEN
element_sqri(GEN nf,GEN x)252 element_sqri(GEN nf, GEN x)
253 {
254 long i, j, k, N;
255 GEN s, v, tab = get_tab(nf, &N);
256
257 v = cgetg(N+1,t_COL);
258 for (k=1; k<=N; k++)
259 {
260 pari_sp av = avma;
261 if (k == 1)
262 s = sqri(gel(x,1));
263 else
264 s = shifti(mulii(gel(x,1),gel(x,k)), 1);
265 for (i=2; i<=N; i++)
266 {
267 GEN p1, c, t, xi = gel(x,i);
268 long base;
269 if (!signe(xi)) continue;
270
271 base = (i-1)*N;
272 c = gcoeff(tab,k,base+i);
273 t = signe(c)? _mulii(c,xi): NULL;
274 for (j=i+1; j<=N; j++)
275 {
276 c = gcoeff(tab,k,base+j);
277 if (!signe(c)) continue;
278 p1 = _mulii(c, shifti(gel(x,j),1));
279 t = t? addii(t, p1): p1;
280 }
281 if (t) s = addii(s, mulii(xi, t));
282 }
283 gel(v,k) = gerepileuptoint(av,s);
284 }
285 return v;
286 }
287
288 /* cf mul_by_tabi */
289 static GEN
sqr_by_tabi(GEN tab,GEN x)290 sqr_by_tabi(GEN tab, GEN x)
291 {
292 long i, j, k, N = lg(x)-1;
293 GEN s, v = cgetg(N+1,t_COL);
294
295 for (k=1; k<=N; k++)
296 {
297 pari_sp av = avma;
298 if (k == 1)
299 s = gsqr(gel(x,1));
300 else
301 s = gmul2n(gmul(gel(x,1),gel(x,k)), 1);
302 for (i=2; i<=N; i++)
303 {
304 GEN p1, c, t, xi = gel(x,i);
305 long base;
306 if (gcmp0(xi)) continue;
307
308 base = (i-1)*N;
309 c = gcoeff(tab,k,base+i);
310 t = signe(c)? _mulix(c,xi): NULL;
311 for (j=i+1; j<=N; j++)
312 {
313 c = gcoeff(tab,k,(i-1)*N+j);
314 if (!signe(c)) continue;
315 p1 = gmul(shifti(c,1), gel(x,j));
316 t = t? gadd(t, p1): p1;
317 }
318 if (t) s = gadd(s, gmul(xi, t));
319 }
320 gel(v,k) = gerepileupto(av,s);
321 }
322 return v;
323 }
324
325 /* cf sqr_by_tab. Assume nothing about tab */
326 GEN
sqr_by_tab(GEN tab,GEN x)327 sqr_by_tab(GEN tab, GEN x)
328 {
329 long i, j, k, N = lg(x)-1;
330 GEN s, v = cgetg(N+1,t_COL);
331
332 for (k=1; k<=N; k++)
333 {
334 pari_sp av = avma;
335 if (k == 1)
336 s = gsqr(gel(x,1));
337 else
338 s = gmul2n(gmul(gel(x,1),gel(x,k)), 1);
339 for (i=2; i<=N; i++)
340 {
341 GEN p1, c, t, xi = gel(x,i);
342 long base;
343 if (gcmp0(xi)) continue;
344
345 base = (i-1)*N;
346 c = gcoeff(tab,k,base+i);
347 t = !gcmp0(c)? gmul(c,xi): NULL;
348 for (j=i+1; j<=N; j++)
349 {
350 c = gcoeff(tab,k,(i-1)*N+j);
351 if (gcmp0(c)) continue;
352 p1 = gmul(gmul2n(c,1), gel(x,j));
353 t = t? gadd(t, p1): p1;
354 }
355 if (t) s = gadd(s, gmul(xi, t));
356 }
357 gel(v,k) = gerepileupto(av,s);
358 }
359 return v;
360 }
361
362 /* square of x in nf */
363 GEN
element_sqr(GEN nf,GEN x)364 element_sqr(GEN nf, GEN x)
365 {
366 long N, tx = typ(x);
367 GEN tab;
368
369 nf = checknf(nf);
370 if (tx==t_POLMOD) x=checknfelt_mod(nf,x,"element_sqr");
371 if (is_extscalar_t(tx))
372 {
373 pari_sp av = avma;
374 return gerepileupto(av, algtobasis(nf, gsqr(x)));
375 }
376 if (tx != t_COL) pari_err(typeer,"element_sqr");
377
378 tab = get_tab(nf, &N);
379 return sqr_by_tabi(tab,x);
380 }
381
382 static GEN
_mul(void * data,GEN x,GEN y)383 _mul(void *data, GEN x, GEN y) { return element_mul((GEN)data,x,y); }
384 static GEN
_sqr(void * data,GEN x)385 _sqr(void *data, GEN x) { return element_sqr((GEN)data,x); }
386
387 /* Compute x^n in nf, left-shift binary powering */
388 GEN
element_pow(GEN nf,GEN x,GEN n)389 element_pow(GEN nf, GEN x, GEN n)
390 {
391 pari_sp av = avma;
392 long s,N;
393 GEN y, cx;
394
395 if (typ(n)!=t_INT) pari_err(talker,"not an integer exponent in nfpow");
396 nf=checknf(nf); N=degpol(nf[1]);
397 s=signe(n); if (!s) return gscalcol_i(gen_1,N);
398 if (typ(x) != t_COL)
399 {
400 x = algtobasis(nf,x);
401 if (typ(x) != t_COL) pari_err(typeer,"element_pow");
402 }
403
404 if (RgV_isscalar(x))
405 {
406 y = gscalcol_i(gen_1,N);
407 gel(y,1) = powgi(gel(x,1),n); return y;
408 }
409 x = primitive_part(x, &cx);
410 y = leftright_pow(x, n, (void*)nf, _sqr, _mul);
411 if (s<0) y = element_inv(nf, y);
412 if (cx) y = gmul(y, powgi(cx, n));
413 return av==avma? gcopy(y): gerepileupto(av,y);
414 }
415
416 typedef struct {
417 GEN nf, p;
418 long I;
419 } eltmod_muldata;
420
421 static GEN
_mulidmod(void * data,GEN x,GEN y)422 _mulidmod(void *data, GEN x, GEN y)
423 {
424 eltmod_muldata *D = (eltmod_muldata*)data;
425 (void)y; /* ignored */
426 return FpC_red(element_mulid(D->nf, x, D->I), D->p);
427 }
428 static GEN
_sqrmod(void * data,GEN x)429 _sqrmod(void *data, GEN x)
430 {
431 eltmod_muldata *D = (eltmod_muldata*)data;
432 return FpC_red(element_sqri(D->nf, x), D->p);
433 }
434
435 /* x = I-th vector of the Z-basis of Z_K, in Z^n, compute lift(x^n mod p) */
436 GEN
element_powid_mod_p(GEN nf,long I,GEN n,GEN p)437 element_powid_mod_p(GEN nf, long I, GEN n, GEN p)
438 {
439 pari_sp av = avma;
440 eltmod_muldata D;
441 long s,N;
442 GEN y;
443
444 if (typ(n) != t_INT) pari_err(talker,"not an integer exponent in nfpow");
445 nf = checknf(nf); N = degpol(nf[1]);
446 s = signe(n);
447 if (s < 0) pari_err(talker,"negative power in element_powid_mod_p");
448 if (!s || I == 1) return gscalcol_i(gen_1,N);
449 D.nf = nf;
450 D.p = p;
451 D.I = I;
452 y = leftright_pow(col_ei(N, I), n, (void*)&D, &_sqrmod, &_mulidmod);
453 return gerepileupto(av,y);
454 }
455
456 GEN
element_mulidid(GEN nf,long i,long j)457 element_mulidid(GEN nf, long i, long j)
458 {
459 long N;
460 GEN tab = get_tab(nf, &N);
461 tab += (i-1)*N; return gel(tab,j);
462 }
463
464 /* Outputs x.w_i, where w_i is the i-th elt of the integral basis */
465 GEN
element_mulid(GEN nf,GEN x,long i)466 element_mulid(GEN nf, GEN x, long i)
467 {
468 long j, k, N;
469 GEN v, tab;
470
471 if (i==1) return gcopy(x);
472 tab = get_tab(nf, &N);
473 if (typ(x) != t_COL || lg(x) != N+1) pari_err(typeer,"element_mulid");
474 tab += (i-1)*N;
475 v = cgetg(N+1,t_COL);
476 for (k=1; k<=N; k++)
477 {
478 pari_sp av = avma;
479 GEN s = gen_0;
480 for (j=1; j<=N; j++)
481 {
482 GEN c = gcoeff(tab,k,j);
483 if (signe(c)) s = gadd(s, _mulix(c, gel(x,j)));
484 }
485 gel(v,k) = gerepileupto(av,s);
486 }
487 return v;
488 }
489
490 /* table of multiplication by wi in ZK = Z[w1,..., wN] */
491 GEN
eltmulid_get_table(GEN nf,long i)492 eltmulid_get_table(GEN nf, long i)
493 {
494 long k,N;
495 GEN m, tab = get_tab(nf, &N);
496 tab += (i-1)*N;
497 m = cgetg(N+1,t_COL);
498 for (k=1; k<=N; k++) m[k] = tab[k];
499 return m;
500 }
501
502 /* table of multiplication by x in ZK = Z[w1,..., wN] */
503 GEN
eltmul_get_table(GEN nf,GEN x)504 eltmul_get_table(GEN nf, GEN x)
505 {
506 if (typ(x) == t_MAT) return x;
507 else
508 {
509 long i, N = degpol(nf[1]);
510 GEN mul = cgetg(N+1,t_MAT);
511 x = algtobasis_i(nf, x);
512 if (RgV_isscalar(x)) return gscalmat(gel(x,1), N);
513 gel(mul,1) = x; /* assume w_1 = 1 */
514 for (i=2; i<=N; i++) gel(mul,i) = element_mulid(nf,x,i);
515 return mul;
516 }
517 }
518
519 /* valuation of integer x, with resp. to prime ideal P above p.
520 * p.P^(-1) = b Z_K, v >= val_p(norm(x)), and N = deg(nf)
521 * [b may be given as the 'multiplication by b' matrix]
522 */
523 long
int_elt_val(GEN nf,GEN x,GEN p,GEN b,GEN * newx)524 int_elt_val(GEN nf, GEN x, GEN p, GEN b, GEN *newx)
525 {
526 long i,k,w, N = degpol(nf[1]);
527 GEN r,a,y,mul;
528
529 mul = (typ(b) == t_MAT)? b: eltmul_get_table(nf, b);
530 y = cgetg(N+1, t_COL); /* will hold the new x */
531 x = shallowcopy(x);
532 for(w=0;; w++)
533 {
534 for (i=1; i<=N; i++)
535 { /* compute (x.b)_i */
536 a = mulii(gel(x,1), gcoeff(mul,i,1));
537 for (k=2; k<=N; k++) a = addii(a, mulii(gel(x,k), gcoeff(mul,i,k)));
538 /* is it divisible by p ? */
539 gel(y,i) = dvmdii(a,p,&r);
540 if (signe(r))
541 {
542 if (newx) *newx = x;
543 return w;
544 }
545 }
546 r=x; x=y; y=r;
547 }
548 }
549
550 long
element_val(GEN nf,GEN x,GEN vp)551 element_val(GEN nf, GEN x, GEN vp)
552 {
553 pari_sp av = avma;
554 long w, vcx, e;
555 GEN cx,p;
556
557 if (gcmp0(x)) return VERYBIGINT;
558 nf = checknf(nf);
559 checkprimeid(vp);
560 p = gel(vp,1);
561 e = itos(gel(vp,3));
562 switch(typ(x))
563 {
564 case t_INT: return e*Z_pval(x,p);
565 case t_FRAC:return e*(Z_pval(gel(x,1),p) - Z_pval(gel(x,2),p));
566 default: x = algtobasis_i(nf,x); break;
567 }
568 if (RgV_isscalar(x)) return e*ggval(gel(x,1),p);
569
570 cx = content(x);
571 if (gcmp1(cx)) vcx=0; else { x = gdiv(x,cx); vcx = ggval(cx,p); }
572 w = int_elt_val(nf,x,p,gel(vp,5),NULL);
573 avma = av; return w + vcx*e;
574 }
575
576 /* polegal without comparing variables */
577 long
polegal_spec(GEN x,GEN y)578 polegal_spec(GEN x, GEN y)
579 {
580 long i = lg(x);
581
582 if (i != lg(y)) return 0;
583 for (i--; i > 1; i--)
584 if (!gequal(gel(x,i),gel(y,i))) return 0;
585 return 1;
586 }
587
588 GEN
coltoalg(GEN nf,GEN x)589 coltoalg(GEN nf, GEN x)
590 {
591 return mkpolmod( coltoliftalg(nf, x), gel(nf,1) );
592 }
593
594 GEN
basistoalg(GEN nf,GEN x)595 basistoalg(GEN nf, GEN x)
596 {
597 long tx=typ(x),lx=lg(x),i,j,l;
598 GEN z;
599
600 nf = checknf(nf);
601 switch(tx)
602 {
603 case t_COL:
604 for (i=1; i<lx; i++)
605 {
606 long t = typ(x[i]);
607 if (is_matvec_t(t)) break;
608 }
609 if (i==lx) {
610 pari_sp av = avma;
611 return gerepilecopy(av, coltoalg(nf, x));
612 }
613 /* fall through */
614
615 case t_VEC: z=cgetg(lx,tx);
616 for (i=1; i<lx; i++) gel(z,i) = basistoalg(nf,gel(x,i));
617 return z;
618 case t_MAT: z=cgetg(lx,t_MAT);
619 if (lx == 1) return z;
620 l = lg(x[1]);
621 for (j=1; j<lx; j++)
622 {
623 gel(z,j) = cgetg(l,t_COL);
624 for (i=1; i<l; i++) gcoeff(z,i,j) = basistoalg(nf,gcoeff(x,i,j));
625 }
626 return z;
627
628 case t_POLMOD:
629 if (!polegal_spec(gel(nf,1),gel(x,1)))
630 pari_err(talker,"not the same number field in basistoalg");
631 return gcopy(x);
632 default: z=cgetg(3,t_POLMOD);
633 gel(z,1) = gcopy(gel(nf,1));
634 gel(z,2) = gtopoly(x, varn(nf[1])); return z;
635 }
636 }
637
638 /* FIXME: basistoalg and algtobasis should not treat recursive objects
639 * since t_COLs are ambiguous, and the functionnality is almost useless.
640 * (Even then, matbasistoalg and matalgtobasis can be used instead.)
641 * The following shallow functions do what the public functions should do,
642 * without sanity checks.
643 * Assume nf is a genuine nf. */
644 GEN
basistoalg_i(GEN nf,GEN x)645 basistoalg_i(GEN nf, GEN x)
646 { return typ(x) == t_COL? coltoalg(nf, x): x; }
647 GEN
algtobasis_i(GEN nf,GEN x)648 algtobasis_i(GEN nf, GEN x)
649 {
650 switch(typ(x))
651 {
652 case t_INT: case t_FRAC:
653 return gscalcol_i(x, degpol( gel(nf,1) ));
654 case t_POLMOD:
655 x = gel(x,2);
656 if (typ(x) != t_POL) return gscalcol_i(x, degpol( gel(nf,1) ));
657 /* fall through */
658 case t_POL:
659 return poltobasis(nf,x);
660 case t_COL:
661 if (lg(x) == lg(gel(nf,7))) break;
662 default: pari_err(typeer,"algtobasis_i");
663 }
664 return x;
665 }
666 GEN
algtobasis_cp(GEN nf,GEN x)667 algtobasis_cp(GEN nf, GEN x)
668 { return typ(x) == t_COL? gcopy(x): algtobasis(nf, x); }
669
670 /* gmul(A, RgX_to_RgV(x)), A t_MAT (or t_VEC) of compatible dimensions */
671 GEN
mulmat_pol(GEN A,GEN x)672 mulmat_pol(GEN A, GEN x)
673 {
674 long i,l;
675 GEN z;
676 if (typ(x) != t_POL) return gmul(x,gel(A,1)); /* scalar */
677 l=lg(x)-1; if (l == 1) return typ(A)==t_VEC? gen_0: zerocol(lg(A[1])-1);
678 x++; z = gmul(gel(x,1), gel(A,1));
679 for (i=2; i<l ; i++)
680 if (!gcmp0(gel(x,i))) z = gadd(z, gmul(gel(x,i), gel(A,i)));
681 return z;
682 }
683
684 /* valid for t_POL, nf a genuine nf or an rnf !
685 * No garbage collecting. No check. */
686 GEN
poltobasis(GEN nf,GEN x)687 poltobasis(GEN nf, GEN x)
688 {
689 GEN P = gel(nf,1);
690 if (degpol(x) >= degpol(P)) x = RgX_rem(x,P);
691 return mulmat_pol(gel(nf,8), x);
692 }
693
694 GEN
algtobasis(GEN nf,GEN x)695 algtobasis(GEN nf, GEN x)
696 {
697 long tx=typ(x),lx=lg(x),i,N;
698 pari_sp av=avma;
699 GEN z;
700
701 nf = checknf(nf);
702 switch(tx)
703 {
704 case t_VEC: case t_COL: case t_MAT:
705 z=cgetg(lx,tx);
706 for (i=1; i<lx; i++) gel(z,i) = algtobasis(nf,gel(x,i));
707 return z;
708 case t_POLMOD:
709 if (!polegal_spec(gel(nf,1),gel(x,1)))
710 pari_err(talker,"not the same number field in algtobasis");
711 x = gel(x,2);
712 if (typ(x) != t_POL) break;
713 /* fall through */
714 case t_POL:
715 if (varn(x) != varn(gel(nf,1)))
716 pari_err(talker,"incompatible variables in algtobasis");
717 return gerepileupto(av,poltobasis(nf,x));
718
719 }
720 N=degpol(nf[1]); return gscalcol(x,N);
721 }
722
723 GEN
rnfbasistoalg(GEN rnf,GEN x)724 rnfbasistoalg(GEN rnf,GEN x)
725 {
726 long tx = typ(x), lx = lg(x), i;
727 pari_sp av = avma;
728 GEN p1, z, nf;
729
730 checkrnf(rnf);
731 switch(tx)
732 {
733 case t_VEC: case t_COL:
734 p1 = cgetg(lx,t_COL); nf = gel(rnf,10);
735 for (i=1; i<lx; i++) gel(p1,i) = basistoalg_i(nf, gel(x,i));
736 p1 = gmul(gmael(rnf,7,1), p1);
737 return gerepileupto(av, gmodulo(p1,gel(rnf,1)));
738
739 case t_MAT:
740 z = cgetg(lx,tx);
741 for (i=1; i<lx; i++) gel(z,i) = rnfbasistoalg(rnf,gel(x,i));
742 return z;
743
744 case t_POLMOD:
745 return gcopy(x);
746
747 default: z = cgetg(3,t_POLMOD);
748 gel(z,1) = gcopy(gel(rnf,1));
749 gel(z,2) = gmul(x,pol_1[varn(rnf[1])]); return z;
750 }
751 }
752
753 GEN
matbasistoalg(GEN nf,GEN x)754 matbasistoalg(GEN nf,GEN x)
755 {
756 long i, j, li, lx = lg(x);
757 GEN c, z = cgetg(lx,t_MAT);
758
759 if (typ(x) != t_MAT) pari_err(talker,"not a matrix in matbasistoalg");
760 if (lx == 1) return z;
761 li = lg(x[1]);
762 for (j=1; j<lx; j++)
763 {
764 c = cgetg(li,t_COL); gel(z,j) = c;
765 for (i=1; i<li; i++) gel(c,i) = basistoalg(nf,gcoeff(x,i,j));
766 }
767 return z;
768 }
769
770 GEN
matalgtobasis(GEN nf,GEN x)771 matalgtobasis(GEN nf,GEN x)
772 {
773 long i, j, li, lx = lg(x);
774 GEN c, z = cgetg(lx, t_MAT);
775
776 if (typ(x) != t_MAT) pari_err(talker,"not a matrix in matalgtobasis");
777 if (lx == 1) return z;
778 li = lg(x[1]);
779 for (j=1; j<lx; j++)
780 {
781 c = cgetg(li,t_COL); gel(z,j) = c;
782 for (i=1; i<li; i++) gel(c,i) = algtobasis_cp(nf, gcoeff(x,i,j));
783 }
784 return z;
785 }
786
787 /* assume x is a t_POLMOD */
788 GEN
lift_to_pol(GEN x)789 lift_to_pol(GEN x)
790 {
791 GEN y = gel(x,2);
792 return (typ(y) != t_POL)? scalarpol(y,varn(x[1])): y;
793 }
794
795 GEN
rnfalgtobasis(GEN rnf,GEN x)796 rnfalgtobasis(GEN rnf,GEN x)
797 {
798 long tx = typ(x), i, lx;
799 GEN z;
800
801 checkrnf(rnf);
802 switch(tx)
803 {
804 case t_VEC: case t_COL: case t_MAT:
805 lx = lg(x); z = cgetg(lx,tx);
806 for (i=1; i<lx; i++) gel(z,i) = rnfalgtobasis(rnf,gel(x,i));
807 return z;
808
809 case t_POLMOD:
810 if (!polegal_spec(gel(rnf,1),gel(x,1)))
811 pari_err(talker,"not the same number field in rnfalgtobasis");
812 x = lift_to_pol(x); /* fall through */
813 case t_POL: {
814 pari_sp av = avma;
815 return gerepileupto(av, poltobasis(rnf, x));
816 }
817 }
818 return gscalcol(x, degpol(rnf[1]));
819 }
820
821 /* Given a and b in nf, gives an algebraic integer y in nf such that a-b.y
822 * is "small"
823 */
824 GEN
nfdiveuc(GEN nf,GEN a,GEN b)825 nfdiveuc(GEN nf, GEN a, GEN b)
826 {
827 pari_sp av=avma, tetpil;
828 a = element_div(nf,a,b); tetpil=avma;
829 return gerepile(av,tetpil,ground(a));
830 }
831
832 /* Given a and b in nf, gives a "small" algebraic integer r in nf
833 * of the form a-b.y
834 */
835 GEN
nfmod(GEN nf,GEN a,GEN b)836 nfmod(GEN nf, GEN a, GEN b)
837 {
838 pari_sp av=avma,tetpil;
839 GEN p1=gneg_i(element_mul(nf,b,ground(element_div(nf,a,b))));
840 tetpil=avma; return gerepile(av,tetpil,gadd(a,p1));
841 }
842
843 /* Given a and b in nf, gives a two-component vector [y,r] in nf such
844 * that r=a-b.y is "small". */
845 GEN
nfdivrem(GEN nf,GEN a,GEN b)846 nfdivrem(GEN nf, GEN a, GEN b)
847 {
848 pari_sp av = avma;
849 GEN p1,z, y = ground(element_div(nf,a,b));
850
851 p1 = gneg_i(element_mul(nf,b,y));
852 z = cgetg(3,t_VEC);
853 gel(z,1) = gcopy(y);
854 gel(z,2) = gadd(a,p1); return gerepileupto(av, z);
855 }
856
857 /*************************************************************************/
858 /** **/
859 /** (Z_K/I)^* **/
860 /** **/
861 /*************************************************************************/
862 /* return sign(sigma_k(x)), x t_COL (integral, primitive) */
863 static long
eval_sign(GEN M,GEN x,long k)864 eval_sign(GEN M, GEN x, long k)
865 {
866 long i, l = lg(x);
867 GEN z = mpmul(gcoeff(M,k,1), gel(x,1));
868 for (i = 2; i < l; i++)
869 z = mpadd(z, mpmul(gcoeff(M,k,i), gel(x,i)));
870 if (lg(z) < DEFAULTPREC) pari_err(precer,"zsigne");
871 return signe(z);
872 }
873
874 GEN
arch_to_perm(GEN arch)875 arch_to_perm(GEN arch)
876 {
877 long i, k, l;
878 GEN perm;
879
880 if (!arch) return cgetg(1, t_VECSMALL);
881 switch (typ(arch))
882 {
883 case t_VECSMALL: return arch;
884 case t_VEC: break;
885 default: pari_err(typeer,"arch_to_perm");
886 }
887 l = lg(arch);
888 perm = cgetg(l, t_VECSMALL);
889 for (k=1, i=1; i < l; i++)
890 if (signe(arch[i])) perm[k++] = i;
891 setlg(perm, k); return perm;
892 }
893 GEN
perm_to_arch(GEN nf,GEN archp)894 perm_to_arch(GEN nf, GEN archp)
895 {
896 long i, l;
897 GEN v;
898 if (typ(archp) == t_VEC) return archp;
899
900 l = lg(archp); nf = checknf(nf);
901 v = zerovec( nf_get_r1(nf) );
902 for (i = 1; i < l; i++) gel(v, archp[i]) = gen_1;
903 return v;
904 }
905
906 /* reduce mod 2 in place */
907 GEN
F2V_red_ip(GEN v)908 F2V_red_ip(GEN v)
909 {
910 long i, l = lg(v);
911 for (i = 1; i < l; i++) gel(v,i) = mpodd(gel(v,i))? gen_1: gen_0;
912 return v;
913 }
914
915 /* return (column) vector of R1 signatures of x (0 or 1)
916 * if arch = NULL, assume arch = [0,..0] */
917 GEN
zsigne(GEN nf,GEN x,GEN arch)918 zsigne(GEN nf,GEN x,GEN arch)
919 {
920 GEN M, V, archp = arch_to_perm(arch);
921 long i, s, l = lg(archp);
922 pari_sp av;
923
924 if (l == 1) return cgetg(1,t_COL);
925 V = cgetg(l,t_COL); av = avma;
926 nf = checknf(nf);
927 switch(typ(x))
928 {
929 case t_MAT: /* factorisation */
930 {
931 GEN g = gel(x,1), e = gel(x,2), z = vec_setconst(V, gen_0);
932 for (i=1; i<lg(g); i++)
933 if (mpodd(gel(e,i))) z = gadd(z, zsigne(nf,gel(g,i),archp));
934 for (i=1; i<l; i++) gel(V,i) = mpodd(gel(z,i))? gen_1: gen_0;
935 avma = av; return V;
936 }
937 case t_POLMOD: x = gel(x,2); /* fall through */
938 case t_POL: x = algtobasis(nf, x); /* fall through */
939 case t_COL: if (!RgV_isscalar(x)) break;
940 x = gel(x,1); /* fall through */
941 case t_INT: case t_FRAC:
942 s = gsigne(x); if (!s) pari_err(talker,"zero element in zsigne");
943 return vec_setconst(V, (s < 0)? gen_1: gen_0);
944 }
945 x = Q_primpart(x); M = gmael(nf,5,1);
946 for (i = 1; i < l; i++)
947 gel(V,i) = (eval_sign(M, x, archp[i]) > 0)? gen_0: gen_1;
948 avma = av; return V;
949 }
950
951 /* return the t_COL vector of signs of x; the matrix of such if x is a vector
952 * of nf elements */
953 GEN
zsigns(GEN nf,GEN x)954 zsigns(GEN nf, GEN x)
955 {
956 long r1, i, l;
957 GEN arch, S;
958
959 nf = checknf(nf); r1 = nf_get_r1(nf);
960 arch = cgetg(r1+1, t_VECSMALL); for (i=1; i<=r1; i++) arch[i] = i;
961 if (typ(x) != t_VEC) return zsigne(nf, x, arch);
962 l = lg(x); S = cgetg(l, t_MAT);
963 for (i=1; i<l; i++) gel(S,i) = zsigne(nf, gel(x,i), arch);
964 return S;
965 }
966
967 /* For internal use. Reduce x modulo (invertible) y */
968 GEN
close_modinvertible(GEN x,GEN y)969 close_modinvertible(GEN x, GEN y)
970 {
971 return gmul(y, ground(gauss(y,x)));
972 }
973 GEN
reducemodinvertible(GEN x,GEN y)974 reducemodinvertible(GEN x, GEN y)
975 {
976 return gadd(x, gneg(close_modinvertible(x,y)));
977 }
978 GEN
lllreducemodmatrix(GEN x,GEN y)979 lllreducemodmatrix(GEN x,GEN y)
980 {
981 return reducemodinvertible(x, lllint_ip(y,4));
982 }
983
984 /* Reduce column x modulo y in HNF */
985 GEN
colreducemodHNF(GEN x,GEN y,GEN * Q)986 colreducemodHNF(GEN x, GEN y, GEN *Q)
987 {
988 long i, l = lg(x);
989 GEN q;
990
991 if (Q) *Q = cgetg(l,t_COL);
992 if (l == 1) return cgetg(1,t_COL);
993 for (i = l-1; i>0; i--)
994 {
995 q = negi(diviiround(gel(x,i), gcoeff(y,i,i)));
996 if (Q) gel(*Q, i) = q;
997 if (signe(q)) x = gadd(x, gmul(q, gel(y,i)));
998 }
999 return x;
1000 }
1001
1002 /* for internal use...Reduce matrix x modulo matrix y */
1003 GEN
reducemodmatrix(GEN x,GEN y)1004 reducemodmatrix(GEN x, GEN y)
1005 {
1006 return reducemodHNF(x, hnfmod(y,detint(y)), NULL);
1007 }
1008
1009 /* x = y Q + R */
1010 GEN
reducemodHNF(GEN x,GEN y,GEN * Q)1011 reducemodHNF(GEN x, GEN y, GEN *Q)
1012 {
1013 long lx = lg(x), i;
1014 GEN R = cgetg(lx, t_MAT);
1015 if (Q)
1016 {
1017 GEN q = cgetg(lx, t_MAT); *Q = q;
1018 for (i=1; i<lx; i++) gel(R,i) = colreducemodHNF(gel(x,i),y,(GEN*)(q+i));
1019 }
1020 else
1021 for (i=1; i<lx; i++)
1022 {
1023 pari_sp av = avma;
1024 gel(R,i) = gerepileupto(av, colreducemodHNF(gel(x,i),y,NULL));
1025 }
1026 return R;
1027 }
1028
1029 /* For internal use. Reduce x modulo ideal (assumed non-zero, in HNF). We
1030 * want a non-zero result */
1031 GEN
nfreducemodideal_i(GEN x0,GEN ideal)1032 nfreducemodideal_i(GEN x0,GEN ideal)
1033 {
1034 GEN x = colreducemodHNF(x0, ideal, NULL);
1035 if (gcmp0(x)) return gel(ideal,1);
1036 return x == x0? gcopy(x) : x;
1037 }
1038 GEN
nfreducemodideal(GEN nf,GEN x0,GEN ideal)1039 nfreducemodideal(GEN nf,GEN x0,GEN ideal)
1040 {
1041 return nfreducemodideal_i(x0, idealhermite(nf,ideal));
1042 }
1043
1044 /* multiply y by t = 1 mod^* f such that sign(x) = sign(y) at arch = idele[2].
1045 * If x == NULL, make y >> 0 at sarch */
1046 GEN
set_sign_mod_idele(GEN nf,GEN x,GEN y,GEN idele,GEN sarch)1047 set_sign_mod_idele(GEN nf, GEN x, GEN y, GEN idele, GEN sarch)
1048 {
1049 GEN s, archp, gen;
1050 long nba,i;
1051 if (!sarch) return y;
1052 gen = gel(sarch,2); nba = lg(gen);
1053 if (nba == 1) return y;
1054
1055 archp = arch_to_perm(gel(idele,2));
1056 s = zsigne(nf, y, archp);
1057 if (x) s = gadd(s, zsigne(nf, x, archp));
1058 s = gmul(gel(sarch,3), s);
1059 for (i=1; i<nba; i++)
1060 if (mpodd(gel(s,i))) y = element_mul(nf,y,gel(gen,i));
1061 return y;
1062 }
1063
1064 /* compute elt = x mod idele, with sign(elt) = sign(x) at arch */
1065 GEN
nfreducemodidele(GEN nf,GEN x,GEN idele,GEN sarch)1066 nfreducemodidele(GEN nf,GEN x,GEN idele,GEN sarch)
1067 {
1068 GEN y;
1069
1070 if (gcmp0(x)) return gcopy(x);
1071 if (!sarch || typ(idele)!=t_VEC || lg(idele)!=3)
1072 return nfreducemodideal(nf,x,idele);
1073
1074 y = nfreducemodideal(nf,x,gel(idele,1));
1075 y = set_sign_mod_idele(nf, x, y, idele, sarch);
1076 return (gexpo(y) > gexpo(x))? x: y;
1077 }
1078
1079 /* given an element x in Z_K and an integral ideal y with x, y coprime,
1080 outputs an element inverse of x modulo y */
1081 GEN
element_invmodideal(GEN nf,GEN x,GEN y)1082 element_invmodideal(GEN nf, GEN x, GEN y)
1083 {
1084 pari_sp av = avma;
1085 GEN a, xh, yh;
1086
1087 nf = checknf(nf);
1088 if (gcmp1(gcoeff(y,1,1))) return zerocol( degpol(nf[1]) );
1089
1090 yh = get_hnfid(nf, y);
1091 switch (typ(x))
1092 {
1093 case t_POL: case t_POLMOD: case t_COL:
1094 xh = idealhermite_aux(nf,x); break;
1095 default: pari_err(typeer,"element_invmodideal");
1096 return NULL; /* not reached */
1097 }
1098 a = element_div(nf, hnfmerge_get_1(xh, yh), x);
1099 return gerepilecopy(av, nfreducemodideal_i(a, yh));
1100 }
1101
1102 static GEN
element_sqrmodideal(GEN nf,GEN x,GEN id)1103 element_sqrmodideal(GEN nf, GEN x, GEN id) {
1104 return nfreducemodideal_i(element_sqr(nf,x),id);
1105 }
1106 static GEN
element_mulmodideal(GEN nf,GEN x,GEN y,GEN id)1107 element_mulmodideal(GEN nf, GEN x, GEN y, GEN id) {
1108 return x? nfreducemodideal_i(element_mul(nf,x,y),id): algtobasis_i(nf, y);
1109 }
1110 /* assume k >= 0, ideal in HNF */
1111 GEN
element_powmodideal(GEN nf,GEN x,GEN k,GEN ideal)1112 element_powmodideal(GEN nf,GEN x,GEN k,GEN ideal)
1113 {
1114 GEN y = NULL;
1115 for(;;)
1116 {
1117 if (mpodd(k)) y = element_mulmodideal(nf,y,x,ideal);
1118 k = shifti(k,-1); if (!signe(k)) break;
1119 x = element_sqrmodideal(nf,x,ideal);
1120 }
1121 return y? y: gscalcol_i(gen_1,degpol(nf[1]));
1122 }
1123
1124 /* assume k >= 0, assume idele = [HNFideal, arch] */
1125 GEN
element_powmodidele(GEN nf,GEN x,GEN k,GEN idele,GEN sarch)1126 element_powmodidele(GEN nf,GEN x,GEN k,GEN idele,GEN sarch)
1127 {
1128 GEN y = element_powmodideal(nf,x,k,gel(idele,1));
1129 if (mpodd(k))
1130 { if (!gcmp1(k)) y = set_sign_mod_idele(nf, x, y, idele, sarch); }
1131 else
1132 { if (!gcmp0(k)) y = set_sign_mod_idele(nf, NULL, y, idele, sarch); }
1133 return y;
1134 }
1135
1136 /* a * g^n mod id */
1137 static GEN
elt_mulpow_modideal(GEN nf,GEN a,GEN g,GEN n,GEN id)1138 elt_mulpow_modideal(GEN nf, GEN a, GEN g, GEN n, GEN id)
1139 {
1140 return element_mulmodideal(nf, a, element_powmodideal(nf,g,n,id), id);
1141 }
1142
1143 /* assume (num(g[i]), id) = 1 for all i. Return prod g[i]^e[i] mod id.
1144 * EX = multiple of exponent of (O_K/id)^* */
1145 GEN
famat_to_nf_modideal_coprime(GEN nf,GEN g,GEN e,GEN id,GEN EX)1146 famat_to_nf_modideal_coprime(GEN nf, GEN g, GEN e, GEN id, GEN EX)
1147 {
1148 GEN dh, h, n, plus = NULL, minus = NULL, idZ = gcoeff(id,1,1);
1149 long i, lx = lg(g);
1150 GEN EXo2 = (expi(EX) > 10)? shifti(EX,-1): NULL;
1151
1152 if (is_pm1(idZ)) lx = 1; /* id = Z_K */
1153 for (i=1; i<lx; i++)
1154 {
1155 long sn;
1156 n = centermodii(gel(e,i), EX, EXo2);
1157 sn = signe(n); if (!sn) continue;
1158
1159 h = Q_remove_denom(gel(g,i), &dh);
1160 if (dh) h = FpC_Fp_mul(h, Fp_inv(dh,idZ), idZ);
1161 if (sn > 0)
1162 plus = elt_mulpow_modideal(nf, plus, h, n, id);
1163 else /* sn < 0 */
1164 minus = elt_mulpow_modideal(nf, minus, h, negi(n), id);
1165 }
1166 if (minus)
1167 plus = element_mulmodideal(nf, plus, element_invmodideal(nf,minus,id), id);
1168 return plus? plus: gscalcol_i(gen_1, lg(id)-1);
1169 }
1170
1171 /* given 2 integral ideals x, y in HNF s.t x | y | x^2, compute the quotient
1172 (1+x)/(1+y) in the form [[cyc],[gen]], if U != NULL, set *U := ux^-1 */
1173 static GEN
zidealij(GEN x,GEN y,GEN * U)1174 zidealij(GEN x, GEN y, GEN *U)
1175 {
1176 GEN G, p1, cyc;
1177 long j, N;
1178
1179 /* x^(-1) y = relations between the 1 + x_i (HNF) */
1180 cyc = smithrel(hnf_gauss(x, y), U, &G);
1181 N = lg(cyc); G = gmul(x,G); settyp(G, t_VEC); /* new generators */
1182 for (j=1; j<N; j++)
1183 {
1184 p1 = gel(G,j);
1185 gel(p1,1) = addsi(1, gel(p1,1)); /* 1 + g_j */
1186 }
1187 if (U) *U = gmul(*U, ginv(x));
1188 return mkvec2(cyc, G);
1189 }
1190
1191 /* smallest integer n such that g0^n=x modulo p prime. Assume g0 has order q
1192 * (p-1 if q = NULL) */
1193 GEN
Fp_shanks(GEN x,GEN g0,GEN p,GEN q)1194 Fp_shanks(GEN x,GEN g0,GEN p, GEN q)
1195 {
1196 pari_sp av=avma,av1,lim;
1197 long lbaby,i,k;
1198 GEN p1,smalltable,giant,perm,v,g0inv;
1199
1200 x = modii(x,p);
1201 if (is_pm1(x) || equaliu(p,2)) { avma = av; return gen_0; }
1202 p1 = addsi(-1, p); if (!q) q = p1;
1203 if (equalii(p1,x)) { avma = av; return shifti(q,-1); }
1204 p1 = sqrti(q);
1205 if (cmpiu(p1,LGBITS) >= 0) pari_err(talker,"module too large in Fp_shanks");
1206 lbaby = itos(p1)+1; smalltable = cgetg(lbaby+1,t_VEC);
1207 g0inv = Fp_inv(g0, p); p1 = x;
1208
1209 for (i=1;;i++)
1210 {
1211 av1 = avma;
1212 if (is_pm1(p1)) { avma = av; return stoi(i-1); }
1213 gel(smalltable,i) = p1; if (i==lbaby) break;
1214 p1 = gerepileuptoint(av1, remii(mulii(p1,g0inv), p));
1215 }
1216 giant = remii(mulii(x, Fp_inv(p1,p)), p);
1217 p1=cgetg(lbaby+1,t_VEC);
1218 perm = gen_sort(smalltable, cmp_IND | cmp_C, cmpii);
1219 for (i=1; i<=lbaby; i++) p1[i]=smalltable[perm[i]];
1220 smalltable=p1; p1=giant;
1221
1222 av1 = avma; lim=stack_lim(av1,2);
1223 for (k=1;;k++)
1224 {
1225 i=tablesearch(smalltable,p1,cmpii);
1226 if (i)
1227 {
1228 v=addis(mulss(lbaby-1,k),perm[i]);
1229 return gerepileuptoint(av,addsi(-1,v));
1230 }
1231 p1 = remii(mulii(p1,giant), p);
1232
1233 if (low_stack(lim, stack_lim(av1,2)))
1234 {
1235 if(DEBUGMEM>1) pari_warn(warnmem,"Fp_shanks, k = %ld", k);
1236 p1 = gerepileuptoint(av1, p1);
1237 }
1238 }
1239 }
1240
1241 /* Pohlig-Hellman */
1242 GEN
Fp_PHlog(GEN a,GEN g,GEN p,GEN ord)1243 Fp_PHlog(GEN a, GEN g, GEN p, GEN ord)
1244 {
1245 pari_sp av = avma;
1246 GEN v,t0,a0,b,q,g_q,n_q,ginv0,qj,ginv;
1247 GEN fa, ex;
1248 long e,i,j,l;
1249
1250 if (equalii(g, a)) return gen_1; /* frequent special case */
1251 if (!ord) ord = subis(p,1);
1252 if (typ(ord) == t_MAT)
1253 {
1254 fa = ord;
1255 ord= factorback(fa,NULL);
1256 }
1257 else
1258 fa = Z_factor(ord);
1259 ex = gel(fa,2);
1260 fa = gel(fa,1);
1261 l = lg(fa);
1262 ginv = Fp_inv(g,p);
1263 v = cgetg(l, t_VEC);
1264 for (i=1; i<l; i++)
1265 {
1266 q = gel(fa,i);
1267 e = itos(gel(ex,i));
1268 if (DEBUGLEVEL>5)
1269 fprintferr("Pohlig-Hellman: DL mod %Z^%ld\n",q,e);
1270 qj = new_chunk(e+1); gel(qj,0) = gen_1;
1271 for (j=1; j<=e; j++) gel(qj,j) = mulii(gel(qj,j-1), q);
1272 t0 = diviiexact(ord, gel(qj,e));
1273 a0 = Fp_pow(a, t0, p);
1274 ginv0 = Fp_pow(ginv, t0, p); /* order q^e */
1275 g_q = Fp_pow(g, diviiexact(ord,q), p); /* order q */
1276 n_q = gen_0;
1277 for (j=0; j<e; j++)
1278 {
1279 b = modii(mulii(a0, Fp_pow(ginv0, n_q, p)), p);
1280 b = Fp_pow(b, gel(qj,e-1-j), p);
1281 b = Fp_shanks(b, g_q, p, q);
1282 n_q = addii(n_q, mulii(b, gel(qj,j)));
1283 }
1284 gel(v,i) = gmodulo(n_q, gel(qj,e));
1285 }
1286 return gerepileuptoint(av, lift(chinese1(v)));
1287 }
1288
1289 /* discrete log in Fq for a in Fp^*, g primitive root in Fq^* */
1290 static GEN
ff_PHlog_Fp(GEN a,GEN g,GEN T,GEN p)1291 ff_PHlog_Fp(GEN a, GEN g, GEN T, GEN p)
1292 {
1293 pari_sp av = avma;
1294 GEN q,n_q,ord,ordp;
1295
1296 if (gcmp1(a)) { avma = av; return gen_0; }
1297 if (equaliu(p,2)) {
1298 if (!signe(a)) pari_err(talker,"a not invertible in ff_PHlog_Fp");
1299 avma = av; return gen_0;
1300 }
1301 ordp = subis(p, 1);
1302 ord = T? subis(powiu(p,degpol(T)), 1): p;
1303 if (equalii(a, ordp)) /* -1 */
1304 return gerepileuptoint(av, shifti(ord,-1));
1305
1306 if (!T) q = NULL;
1307 else
1308 { /* we want < g > = Fp^* */
1309 q = diviiexact(ord,ordp);
1310 g = FpXQ_pow(g,q,T,p);
1311 if (typ(g) == t_POL) g = constant_term(g);
1312 }
1313 n_q = Fp_PHlog(a,g,p,NULL);
1314 if (q) n_q = mulii(q, n_q);
1315 return gerepileuptoint(av, n_q);
1316 }
1317
1318 /* smallest n >= 0 such that g0^n=x modulo pr, assume g0 reduced
1319 * N = order of g0 is prime (and != p) */
1320 static GEN
ffshanks(GEN x,GEN g0,GEN N,GEN T,GEN p)1321 ffshanks(GEN x, GEN g0, GEN N, GEN T, GEN p)
1322 {
1323 pari_sp av = avma, av1, lim;
1324 long lbaby,i,k;
1325 GEN p1,smalltable,giant,perm,v,g0inv;
1326
1327 if (!degpol(x)) x = constant_term(x);
1328 if (typ(x) == t_INT)
1329 {
1330 if (!gcmp1(modii(p,N))) return gen_0;
1331 /* g0 in Fp^*, order N | (p-1) */
1332 if (typ(g0) == t_POL) g0 = constant_term(g0);
1333 return Fp_PHlog(x,g0,p,N);
1334 }
1335
1336 p1 = sqrti(N);
1337 if (cmpiu(p1,LGBITS) >= 0) pari_err(talker,"module too large in ffshanks");
1338 lbaby = itos(p1)+1; smalltable = cgetg(lbaby+1,t_VEC);
1339 g0inv = Fq_inv(g0,T,p);
1340 p1 = x;
1341
1342 for (i=1;;i++)
1343 {
1344 if (gcmp1(p1)) { avma = av; return stoi(i-1); }
1345 gel(smalltable,i) = p1; if (i==lbaby) break;
1346 av1 = avma;
1347 p1 = gerepileupto(av1, FpXQ_mul(p1,g0inv, T,p));
1348 }
1349 giant = FpXQ_div(x,p1,T,p);
1350 perm = gen_sort(smalltable, cmp_IND | cmp_C, cmp_pol);
1351 smalltable = vecpermute(smalltable, perm);
1352 p1 = giant;
1353
1354 av1 = avma; lim=stack_lim(av1,2);
1355 for (k=1;;k++)
1356 {
1357 i = tablesearch(smalltable,p1,cmp_pol);
1358 if (i)
1359 {
1360 v = addis(mulss(lbaby-1,k), perm[i]);
1361 return gerepileuptoint(av, addsi(-1,v));
1362 }
1363 p1 = FpXQ_mul(p1, giant, T,p);
1364
1365 if (low_stack(lim, stack_lim(av1,2)))
1366 {
1367 if(DEBUGMEM>1) pari_warn(warnmem,"ffshanks");
1368 p1 = gerepileupto(av1, p1);
1369 }
1370 }
1371 }
1372
1373 /* same in Fp[X]/T */
1374 GEN
ff_PHlog(GEN a,GEN g,GEN T,GEN p)1375 ff_PHlog(GEN a, GEN g, GEN T, GEN p)
1376 {
1377 pari_sp av = avma;
1378 GEN v,t0,a0,b,q,g_q,n_q,ginv0,qj,ginv,ord,fa,ex;
1379 long e,i,j,l;
1380
1381 if (typ(a) == t_INT)
1382 return gerepileuptoint(av, ff_PHlog_Fp(a,g,T,p));
1383 /* f > 1 ==> T != NULL */
1384 ord = subis(powiu(p, degpol(T)), 1);
1385 fa = factor(ord);
1386 ex = gel(fa,2);
1387 fa = gel(fa,1);
1388 l = lg(fa);
1389 ginv = Fq_inv(g,T,p);
1390 v = cgetg(l, t_VEC);
1391 for (i=1; i<l; i++)
1392 {
1393 q = gel(fa,i);
1394 e = itos(gel(ex,i));
1395 if (DEBUGLEVEL>5) fprintferr("nf_Pohlig-Hellman: DL mod %Z^%ld\n",q,e);
1396 qj = new_chunk(e+1); gel(qj,0) = gen_1;
1397 for (j=1; j<=e; j++) gel(qj,j) = mulii(gel(qj,j-1), q);
1398 t0 = diviiexact(ord, gel(qj,e));
1399 a0 = FpXQ_pow(a, t0, T,p);
1400 ginv0 = FpXQ_pow(ginv, t0, T,p); /* order q^e */
1401 g_q = FpXQ_pow(g, diviiexact(ord,q), T,p); /* order q */
1402 n_q = gen_0;
1403 for (j=0; j<e; j++)
1404 {
1405 b = FpXQ_mul(a0, FpXQ_pow(ginv0, n_q, T,p), T,p);
1406 b = FpXQ_pow(b, gel(qj,e-1-j), T,p);
1407 b = ffshanks(b, g_q, q, T,p);
1408 n_q = addii(n_q, mulii(b, gel(qj,j)));
1409 }
1410 gel(v,i) = gmodulo(n_q, gel(qj,e));
1411 }
1412 return gerepileuptoint(av, lift(chinese1(v)));
1413 }
1414
1415 /* same in nf.zk / pr */
1416 GEN
nf_PHlog(GEN nf,GEN a,GEN g,GEN pr)1417 nf_PHlog(GEN nf, GEN a, GEN g, GEN pr)
1418 {
1419 pari_sp av = avma;
1420 GEN T,p, modpr = nf_to_ff_init(nf, &pr, &T, &p);
1421 GEN A = nf_to_ff(nf,a,modpr);
1422 GEN G = nf_to_ff(nf,g,modpr);
1423 return gerepileuptoint(av, ff_PHlog(A,G,T,p));
1424 }
1425
1426 GEN
znlog(GEN x,GEN g0)1427 znlog(GEN x, GEN g0)
1428 {
1429 pari_sp av = avma;
1430 GEN p = gel(g0,1);
1431 if (typ(g0) != t_INTMOD) pari_err(talker,"not an element of (Z/pZ)* in znlog");
1432 return gerepileuptoint(av, Fp_PHlog(Rg_to_Fp(x,p),gel(g0,2),p,NULL));
1433 }
1434
1435 GEN
dethnf(GEN mat)1436 dethnf(GEN mat)
1437 {
1438 long i,l = lg(mat);
1439 pari_sp av;
1440 GEN s;
1441
1442 if (l<3) return l<2? gen_1: icopy(gcoeff(mat,1,1));
1443 av = avma; s = gcoeff(mat,1,1);
1444 for (i=2; i<l; i++) s = gmul(s,gcoeff(mat,i,i));
1445 return av==avma? gcopy(s): gerepileupto(av,s);
1446 }
1447
1448 GEN
dethnf_i(GEN mat)1449 dethnf_i(GEN mat)
1450 {
1451 pari_sp av;
1452 long i,l = lg(mat);
1453 GEN s;
1454
1455 if (l<3) return l<2? gen_1: icopy(gcoeff(mat,1,1));
1456 av = avma; s = gcoeff(mat,1,1);
1457 for (i=2; i<l; i++) s = mulii(s,gcoeff(mat,i,i));
1458 return gerepileuptoint(av,s);
1459 }
1460
1461 /* as above with cyc = diagonal(Smith Normal Form) */
1462 GEN
detcyc(GEN cyc,long * L)1463 detcyc(GEN cyc, long *L)
1464 {
1465 pari_sp av = avma;
1466 long i, l = lg(cyc);
1467 GEN s = gel(cyc,1);
1468
1469 if (l == 1) { *L = 1; return gen_1; }
1470 for (i=2; i<l; i++)
1471 {
1472 GEN t = gel(cyc,i);
1473 if (is_pm1(t)) break;
1474 s = mulii(s, t);
1475 }
1476 *L = i; return i <= 2? icopy(s): gerepileuptoint(av,s);
1477 }
1478
1479 /* (U,V) = 1. Return y = x mod U, = 1 mod V (uv: u + v = 1, u in U, v in V).
1480 * mv = multiplication table by v */
1481 static GEN
makeprimetoideal(GEN UV,GEN u,GEN mv,GEN x)1482 makeprimetoideal(GEN UV, GEN u,GEN mv, GEN x)
1483 {
1484 return nfreducemodideal_i(gadd(u, gmul(mv,x)), UV);
1485 }
1486
1487 static GEN
makeprimetoidealvec(GEN nf,GEN UV,GEN u,GEN v,GEN gen)1488 makeprimetoidealvec(GEN nf, GEN UV, GEN u,GEN v, GEN gen)
1489 {
1490 long i, lx = lg(gen);
1491 GEN y = cgetg(lx,t_VEC), mv = eltmul_get_table(nf, v);
1492 for (i=1; i<lx; i++) gel(y,i) = makeprimetoideal(UV,u,mv, gel(gen,i));
1493 return y;
1494 }
1495
1496 GEN
FpXQ_gener(GEN T,GEN p)1497 FpXQ_gener(GEN T, GEN p)
1498 {
1499 long i,j, k, vT = varn(T), f = degpol(T);
1500 GEN g, L, pf_1 = subis(powiu(p, f), 1);
1501 pari_sp av0 = avma, av;
1502
1503 L = (GEN)Z_factor(pf_1)[1];
1504 k = lg(L)-1;
1505
1506 for (i=1; i<=k; i++) gel(L,i) = diviiexact(pf_1, gel(L,i));
1507 for (av = avma;; avma = av)
1508 {
1509 g = FpX_rand(f, vT, p);
1510 if (degpol(g) < 1) continue;
1511 for (j=1; j<=k; j++)
1512 if (gcmp1(FpXQ_pow(g, gel(L,j), T, p))) break;
1513 if (j > k) return gerepilecopy(av0, g);
1514 }
1515 }
1516
1517 /* Given an ideal pr^ep, and an integral ideal x (in HNF form) compute a list
1518 * of vectors,corresponding to the abelian groups (O_K/pr)^*, and
1519 * 1 + pr^i/ 1 + pr^min(2i, ep), i = 1,...
1520 * Each vector has 5 components as follows :
1521 * [[cyc],[g],[g'],[sign],U.X^-1].
1522 * cyc = type as abelian group
1523 * g, g' = generators. (g',x) = 1, not necessarily so for g
1524 * sign = vector of the sign(g') at arch.
1525 * If x = NULL, the original ideal was a prime power */
1526 static GEN
zprimestar(GEN nf,GEN pr,GEN ep,GEN x,GEN arch)1527 zprimestar(GEN nf, GEN pr, GEN ep, GEN x, GEN arch)
1528 {
1529 pari_sp av = avma;
1530 long a, b, e = itos(ep), f = itos(gel(pr,4));
1531 GEN p = gel(pr,1), list, g, g0, y, u,v, prh, prb, pre;
1532
1533 if(DEBUGLEVEL>3) fprintferr("treating pr^%ld, pr = %Z\n",e,pr);
1534 if (f == 1)
1535 g = gscalcol_i(gener_Fp(p), degpol(nf[1]));
1536 else
1537 {
1538 GEN T, modpr = zk_to_ff_init(nf, &pr, &T, &p);
1539 g = ff_to_nf(FpXQ_gener(T,p), modpr);
1540 g = poltobasis(nf, g);
1541 }
1542 /* g generates (Z_K / pr)^* */
1543 prh = prime_to_ideal(nf,pr);
1544 pre = (e==1)? prh: idealpow(nf,pr,ep);
1545 g0 = g;
1546 u = v = NULL; /* gcc -Wall */
1547 if (x)
1548 {
1549 GEN uv = idealaddtoone(nf,pre, idealdivpowprime(nf,x,pr,ep));
1550 u = gel(uv,1);
1551 v = gel(uv,2); v = eltmul_get_table(nf, v);
1552 g0 = makeprimetoideal(x,u,v,g);
1553 }
1554
1555 list = cget1(e+1, t_VEC);
1556 y = cgetg(6,t_VEC); appendL(list, y);
1557 gel(y,1) = mkvec(addis(powiu(p,f), -1));
1558 gel(y,2) = mkvec(g);
1559 gel(y,3) = mkvec(g0);
1560 gel(y,4) = mkvec(zsigne(nf,g0,arch));
1561 gel(y,5) = gen_1;
1562 prb = prh;
1563 for (a = b = 1; a < e; a = b)
1564 {
1565 GEN pra = prb, gen, z, s, U;
1566 long i, l;
1567
1568 b <<= 1;
1569 /* compute 1 + pr^a / 1 + pr^b, 2a <= b */
1570 if(DEBUGLEVEL>3) fprintferr(" treating a = %ld, b = %ld\n",a,b);
1571 prb = (b >= e)? pre: idealpows(nf,pr,b);
1572 z = zidealij(pra, prb, &U);
1573 gen = shallowcopy(gel(z,2));
1574 l = lg(gen); s = cgetg(l, t_VEC);
1575 if(DEBUGLEVEL>3) fprintferr("zidealij done\n");
1576 for (i = 1; i < l; i++)
1577 {
1578 if (x) gel(gen,i) = makeprimetoideal(x,u,v,gel(gen,i));
1579 gel(s,i) = zsigne(nf,gel(gen,i),arch);
1580 }
1581 y = cgetg(6,t_VEC); appendL(list, y);
1582 y[1] = z[1];
1583 y[2] = z[2];
1584 gel(y,3) = gen;
1585 gel(y,4) = s;
1586 gel(y,5) = U;
1587 }
1588 return gerepilecopy(av, list);
1589 }
1590
1591 /* increment y, which runs through [-d,d]^k. Return 0 when done. */
1592 static int
increment(GEN y,long k,long d)1593 increment(GEN y, long k, long d)
1594 {
1595 long i = 0, j;
1596 do
1597 {
1598 if (++i > k) return 0;
1599 y[i]++;
1600 } while (y[i] > d);
1601 for (j = 1; j < i; j++) y[j] = -d;
1602 return 1;
1603 }
1604
1605 GEN
archstar_full_rk(GEN x,GEN bas,GEN v,GEN gen)1606 archstar_full_rk(GEN x, GEN bas, GEN v, GEN gen)
1607 {
1608 long i, r, lgmat, N = lg(bas)-1, nba = lg(v[1]) - 1;
1609 GEN lambda = cgetg(N+1, t_VECSMALL), mat = cgetg(nba+1,t_MAT);
1610
1611 lgmat = lg(v); setlg(mat, lgmat+1);
1612 for (i = 1; i < lgmat; i++) mat[i] = v[i];
1613 for ( ; i <= nba; i++) gel(mat,i) = cgetg(nba+1, t_VECSMALL);
1614
1615 if (x) { x = lllint_ip(x,4); bas = gmul(bas, x); }
1616
1617 for (r=1;; r++)
1618 { /* reset */
1619 (void)vec_setconst(lambda, (GEN)0);
1620 if (!x) lambda[1] = r;
1621 while (increment(lambda, N, r))
1622 {
1623 pari_sp av1 = avma;
1624 GEN a = RgM_zc_mul(bas, lambda), c = gel(mat,lgmat);
1625 for (i = 1; i <= nba; i++)
1626 {
1627 GEN t = x? gadd(gel(a,i), gen_1): gel(a,i);
1628 c[i] = (gsigne(t) < 0)? 1: 0;
1629 }
1630 avma = av1; if (Flm_deplin(mat, 2)) continue;
1631
1632 /* c independant of previous sign vectors */
1633 if (!x) a = zc_to_ZC(lambda);
1634 else
1635 {
1636 a = ZM_zc_mul(x, lambda);
1637 gel(a,1) = addis(gel(a,1), 1);
1638 }
1639 gel(gen,lgmat) = a;
1640 if (lgmat++ == nba) return Flm_to_ZM( Flm_inv(mat,2) ); /* full rank */
1641 setlg(mat,lgmat+1);
1642 }
1643 }
1644 }
1645
1646 /* x integral ideal, compute elements in 1+x (in x, if x = zk) whose sign
1647 * matrix is invertible */
1648 GEN
zarchstar(GEN nf,GEN x,GEN archp)1649 zarchstar(GEN nf, GEN x, GEN archp)
1650 {
1651 long i, nba;
1652 pari_sp av;
1653 GEN p1, y, bas, gen, mat, gZ, v;
1654
1655 archp = arch_to_perm(archp);
1656 nba = lg(archp) - 1;
1657 y = cgetg(4,t_VEC);
1658 if (!nba)
1659 {
1660 gel(y,1) = cgetg(1,t_VEC);
1661 gel(y,2) = cgetg(1,t_VEC);
1662 gel(y,3) = cgetg(1,t_MAT); return y;
1663 }
1664 p1 = cgetg(nba+1,t_VEC); for (i=1; i<=nba; i++) gel(p1,i) = gen_2;
1665 gel(y,1) = p1; av = avma;
1666 if (gcmp1(gcoeff(x,1,1))) x = NULL; /* x = O_K */
1667 gZ = x? subsi(1, gcoeff(x,1,1)): gen_m1; /* gZ << 0, gZ = 1 mod x */
1668 if (nba == 1)
1669 {
1670 gel(y,2) = mkvec(gZ);
1671 gel(y,3) = gscalmat(gen_1,1); return y;
1672 }
1673 bas = gmael(nf,5,1);
1674 if (lg(bas[1]) > lg(archp)) bas = rowpermute(bas, archp);
1675 gen = cgetg(nba+1,t_VEC);
1676 v = mkmat( const_vecsmall(nba, 1) );
1677 gel(gen,1) = gZ;
1678
1679 mat = archstar_full_rk(x, bas, v, gen);
1680 gerepileall(av,2,&gen,&mat);
1681
1682 gel(y,2) = gen;
1683 gel(y,3) = mat; return y;
1684 }
1685
1686 static GEN
zlog_pk(GEN nf,GEN a0,GEN y,GEN pr,GEN prk,GEN list,GEN * psigne)1687 zlog_pk(GEN nf, GEN a0, GEN y, GEN pr, GEN prk, GEN list, GEN *psigne)
1688 {
1689 GEN a = a0, L, e, cyc, gen, s, U;
1690 long i,j, llist = lg(list)-1;
1691
1692 for (j = 1; j <= llist; j++)
1693 {
1694 L = gel(list,j);
1695 cyc = gel(L,1);
1696 gen = gel(L,2);
1697 s = gel(L,4);
1698 U = gel(L,5);
1699 if (j == 1)
1700 e = mkcol( nf_PHlog(nf, a, gel(gen,1), pr) );
1701 else if (typ(a) == t_INT)
1702 e = gmul(subis(a, 1), gel(U,1));
1703 else
1704 { /* t_COL */
1705 GEN t = gel(a,1);
1706 gel(a,1) = addsi(-1, gel(a,1)); /* a -= 1 */
1707 e = gmul(U, a);
1708 gel(a,1) = t; /* restore */
1709 }
1710 /* here lg(e) == lg(cyc) */
1711 for (i = 1; i < lg(cyc); i++)
1712 {
1713 GEN t = modii(negi(gel(e,i)), gel(cyc,i));
1714 gel(++y,0) = negi(t); if (!signe(t)) continue;
1715
1716 if (mod2(t)) *psigne = *psigne? gadd(*psigne, gel(s,i)): gel(s,i);
1717 if (j != llist) a = elt_mulpow_modideal(nf, a, gel(gen,i), t, prk);
1718 }
1719 }
1720 return y;
1721 }
1722
1723 static void
zlog_add_sign(GEN y0,GEN sgn,GEN lists)1724 zlog_add_sign(GEN y0, GEN sgn, GEN lists)
1725 {
1726 GEN y, s;
1727 long i;
1728 if (!sgn) return;
1729 y = y0 + lg(y0);
1730 s = gmul(gmael(lists, lg(lists)-1, 3), sgn);
1731 for (i = lg(s)-1; i > 0; i--) gel(--y,0) = mpodd(gel(s,i))? gen_1: gen_0;
1732 }
1733
1734 static GEN
famat_zlog(GEN nf,GEN g,GEN e,GEN sgn,GEN bid)1735 famat_zlog(GEN nf, GEN g, GEN e, GEN sgn, GEN bid)
1736 {
1737 GEN vp = gmael(bid, 3,1), ep = gmael(bid, 3,2), arch = gmael(bid,1,2);
1738 GEN cyc = gmael(bid,2,2), lists = gel(bid,4), U = gel(bid,5);
1739 GEN y0, x, y, EX = gel(cyc,1);
1740 long i, l;
1741
1742 y0 = y = cgetg(lg(U), t_COL);
1743 if (!sgn) sgn = zsigne(nf, to_famat(g,e), arch);
1744 l = lg(vp);
1745 for (i=1; i < l; i++)
1746 {
1747 GEN pr = gel(vp,i), prk;
1748 prk = (l==2)? gmael(bid,1,1): idealpow(nf, pr, gel(ep,i));
1749 /* FIXME: FIX group exponent (should be mod prk, not f !) */
1750 x = famat_makecoprime(nf, g, e, pr, prk, EX);
1751 y = zlog_pk(nf, x, y, pr, prk, gel(lists,i), &sgn);
1752 }
1753 zlog_add_sign(y0, sgn, lists);
1754 return y0;
1755 }
1756
1757 static GEN
get_index(GEN lists)1758 get_index(GEN lists)
1759 {
1760 long t = 0, j, k, l = lg(lists)-1;
1761 GEN L, ind = cgetg(l+1, t_VECSMALL);
1762
1763 for (k = 1; k < l; k++)
1764 {
1765 L = gel(lists,k);
1766 ind[k] = t;
1767 for (j=1; j<lg(L); j++) t += lg(gmael(L,j,1)) - 1;
1768 }
1769 /* for arch. components */
1770 ind[k] = t; return ind;
1771 }
1772
1773 static void
init_zlog(zlog_S * S,long n,GEN P,GEN e,GEN arch,GEN lists,GEN U)1774 init_zlog(zlog_S *S, long n, GEN P, GEN e, GEN arch, GEN lists, GEN U)
1775 {
1776 S->n = n;
1777 S->U = U;
1778 S->P = P;
1779 S->e = e;
1780 S->archp = arch_to_perm(arch);
1781 S->lists = lists;
1782 S->ind = get_index(lists);
1783 }
1784 void
init_zlog_bid(zlog_S * S,GEN bid)1785 init_zlog_bid(zlog_S *S, GEN bid)
1786 {
1787 GEN ideal = gel(bid,1), fa = gel(bid,3), fa2 = gel(bid,4), U = gel(bid,5);
1788 GEN arch = (typ(ideal)==t_VEC && lg(ideal)==3)? gel(ideal,2): NULL;
1789 init_zlog(S, lg(U)-1, gel(fa,1), gel(fa,2), arch, fa2, U);
1790 }
1791
1792 /* Return decomposition of a on the S->nf successive generators contained in
1793 * S->lists. If index !=0, do the computation for the corresponding prime
1794 * ideal and set to 0 the other components. */
1795 static GEN
zlog_ind(GEN nf,GEN a,zlog_S * S,GEN sgn,long index)1796 zlog_ind(GEN nf, GEN a, zlog_S *S, GEN sgn, long index)
1797 {
1798 GEN y0 = zerocol(S->n), y, list, pr, prk;
1799 pari_sp av = avma;
1800 long i, k, kmin, kmax;
1801
1802 if (typ(a) != t_INT) a = algtobasis_i(nf,a);
1803 if (DEBUGLEVEL>3)
1804 {
1805 fprintferr("entering zlog, "); flusherr();
1806 if (DEBUGLEVEL>5) fprintferr("with a = %Z\n",a);
1807 }
1808 if (index)
1809 {
1810 kmin = kmax = index;
1811 y = y0 + S->ind[index];
1812 }
1813 else
1814 {
1815 kmin = 1; kmax = lg(S->P)-1;
1816 y = y0;
1817 }
1818 if (!sgn) sgn = zsigne(nf, a, S->archp);
1819 for (k = kmin; k <= kmax; k++)
1820 {
1821 list= (GEN)S->lists[k];
1822 pr = (GEN)S->P[k];
1823 prk = idealpow(nf, pr, (GEN)S->e[k]);
1824 y = zlog_pk(nf, a, y, pr, prk, list, &sgn);
1825 }
1826 zlog_add_sign(y0, sgn, S->lists);
1827 if (DEBUGLEVEL>3) { fprintferr("leaving\n"); flusherr(); }
1828 avma = av;
1829 for (i=1; i <= S->n; i++) gel(y0,i) = icopy(gel(y0,i));
1830 return y0;
1831 }
1832 /* sgn = sign(a, S->arch) or NULL if unknown */
1833 GEN
zlog(GEN nf,GEN a,GEN sgn,zlog_S * S)1834 zlog(GEN nf, GEN a, GEN sgn, zlog_S *S) { return zlog_ind(nf, a, S, sgn, 0); }
1835
1836 /* Log on bid.gen of generators of P_{1,I pr^{e-1}} / P_{1,I pr^e} (I,pr) = 1,
1837 * defined implicitly via CRT. 'index' is the index of pr in modulus
1838 * factorization */
1839 GEN
log_gen_pr(zlog_S * S,long index,GEN nf,long e)1840 log_gen_pr(zlog_S *S, long index, GEN nf, long e)
1841 {
1842 long i, l, yind = S->ind[index];
1843 GEN y, A, L, L2 = (GEN)S->lists[index];
1844
1845 if (e == 1)
1846 {
1847 L = gel(L2,1);
1848 y = zerocol(S->n); gel(y, yind+1) = gen_1;
1849 zlog_add_sign(y, gmael(L,4,1), S->lists);
1850 A = mkmat(y);
1851 }
1852 else
1853 {
1854 GEN pr = (GEN)S->P[index], prk, g;
1855
1856 if (e == 2)
1857 L = gel(L2,2);
1858 else
1859 L = zidealij(idealpows(nf,pr,e-1), idealpows(nf,pr,e), NULL);
1860 g = gel(L,2);
1861 l = lg(g);
1862 A = cgetg(l, t_MAT);
1863 prk = idealpow(nf, pr, (GEN)S->e[index]);
1864 for (i = 1; i < l; i++)
1865 {
1866 GEN G = gel(g,i), sgn = NULL; /* positive at f_oo */
1867 y = zerocol(S->n);
1868 (void)zlog_pk(nf, G, y + yind, pr, prk, L2, &sgn);
1869 zlog_add_sign(y, sgn, S->lists);
1870 gel(A,i) = y;
1871 }
1872 }
1873 return gmul(S->U, A);
1874 }
1875 /* Log on bid.gen of generator of P_{1,f} / P_{1,f v[index]}
1876 * v = vector of r1 real places */
1877 GEN
log_gen_arch(zlog_S * S,long index)1878 log_gen_arch(zlog_S *S, long index)
1879 {
1880 GEN y = zerocol(S->n);
1881 zlog_add_sign(y, col_ei(lg(S->archp)-1, index), S->lists);
1882 return gmul(S->U, y);
1883 }
1884
1885 static GEN
compute_gen(GEN nf,GEN u1,GEN gen,GEN bid)1886 compute_gen(GEN nf, GEN u1, GEN gen, GEN bid)
1887 {
1888 long i, c = lg(u1);
1889 GEN L = cgetg(c,t_VEC);
1890 for (i=1; i<c; i++)
1891 gel(L,i) = famat_to_nf_modidele(nf, gen, gel(u1,i), bid);
1892 return L;
1893 }
1894 static void
add_clgp(GEN nf,GEN u1,GEN cyc,GEN gen,GEN bid)1895 add_clgp(GEN nf, GEN u1, GEN cyc, GEN gen, GEN bid)
1896 {
1897 GEN c = cgetg(u1? 4: 3, t_VEC);
1898 long L;
1899 gel(bid,2) = c;
1900 gel(c,1) = detcyc(cyc, &L);
1901 gel(c,2) = cyc;
1902 if (u1) gel(c,3) = (u1 == gen_1? gen: compute_gen(nf, u1, gen, bid));
1903 }
1904
1905 /* Compute [[ideal,arch], [h,[cyc],[gen]], idealfact, [liste], U]
1906 gen not computed unless add_gen != 0 */
1907 GEN
Idealstar(GEN nf,GEN ideal,long add_gen)1908 Idealstar(GEN nf, GEN ideal,long add_gen)
1909 {
1910 pari_sp av = avma;
1911 long i, j, k, nbp, R1, nbgen;
1912 GEN t, y, cyc, U, u1 = NULL, fa, lists, x, arch, archp, E, P, sarch, gen;
1913
1914 nf = checknf(nf);
1915 R1 = nf_get_r1(nf);
1916 if (typ(ideal) == t_VEC && lg(ideal) == 3)
1917 {
1918 arch = gel(ideal,2); ideal = gel(ideal,1);
1919 i = typ(arch);
1920 if (!is_vec_t(i) || lg(arch) != R1+1)
1921 pari_err(talker,"incorrect archimedean component in Idealstar");
1922 archp = arch_to_perm(arch);
1923 }
1924 else
1925 {
1926 arch = zerovec(R1);
1927 archp = cgetg(1, t_VECSMALL);
1928 }
1929 x = idealhermite_aux(nf, ideal);
1930 if (lg(x) == 1 || !gcmp1(denom(gcoeff(x,1,1))))
1931 pari_err(talker,"Idealstar needs an integral non-zero ideal: %Z",x);
1932 fa = idealfactor(nf, ideal);
1933 P = gel(fa,1);
1934 E = gel(fa,2); nbp = lg(P)-1;
1935 lists = cgetg(nbp+2,t_VEC);
1936
1937 gen = cgetg(1,t_VEC);
1938 t = (nbp==1)? (GEN)NULL: x;
1939 for (i=1; i<=nbp; i++)
1940 {
1941 GEN L = zprimestar(nf, gel(P,i), gel(E,i), t, archp);
1942 gel(lists,i) = L;
1943 for (j=1; j<lg(L); j++) gen = shallowconcat(gen,gmael(L,j,3));
1944 }
1945 sarch = zarchstar(nf, x, archp);
1946 gel(lists,i) = sarch;
1947 gen = shallowconcat(gen, gel(sarch,2));
1948
1949 nbgen = lg(gen)-1;
1950 if (nbp)
1951 {
1952 GEN h = cgetg(nbgen+1,t_MAT);
1953 long cp = 0;
1954 zlog_S S; init_zlog(&S, nbgen, P, E, archp, lists, NULL);
1955 for (i=1; i<=nbp; i++)
1956 {
1957 GEN L2 = gel(lists,i);
1958 for (j=1; j < lg(L2); j++)
1959 {
1960 GEN L = gel(L2,j), F = gel(L,1), G = gel(L,3);
1961 for (k=1; k<lg(G); k++)
1962 { /* log(g^f) mod idele */
1963 GEN g = gel(G,k), f = gel(F,k), a = element_powmodideal(nf,g,f,x);
1964 GEN sgn = mpodd(f)? zsigne(nf, g, S.archp): zerocol(lg(S.archp)-1);
1965 gel(h,++cp) = gneg(zlog_ind(nf, a, &S, sgn, i));
1966 coeff(h,cp,cp) = F[k];
1967 }
1968 }
1969 }
1970 for (j=1; j<lg(archp); j++)
1971 {
1972 gel(h,++cp) = zerocol(nbgen);
1973 gcoeff(h,cp,cp) = gen_2;
1974 }
1975 /* assert(cp == nbgen) */
1976 h = hnfall_i(h,NULL,0);
1977 cyc = smithrel(h, &U, add_gen? &u1: NULL);
1978 }
1979 else
1980 {
1981 cyc = cgetg(nbgen+1, t_VEC);
1982 for (j=1; j<=nbgen; j++) gel(cyc,j) = gen_2;
1983 U = matid(nbgen);
1984 if (add_gen) u1 = gen_1;
1985 }
1986
1987 y = cgetg(6,t_VEC);
1988 gel(y,1) = mkvec2(x, arch);
1989 gel(y,3) = fa;
1990 gel(y,4) = lists;
1991 gel(y,5) = U;
1992 add_clgp(nf, u1, cyc, gen, y);
1993 return gerepilecopy(av, y);
1994 }
1995
1996 GEN
zidealstarinitgen(GEN nf,GEN ideal)1997 zidealstarinitgen(GEN nf, GEN ideal)
1998 { return Idealstar(nf,ideal,1); }
1999 GEN
zidealstarinit(GEN nf,GEN ideal)2000 zidealstarinit(GEN nf, GEN ideal)
2001 { return Idealstar(nf,ideal,0); }
2002 /* FIXME: obsolete */
2003 GEN
zidealstar(GEN nf,GEN ideal)2004 zidealstar(GEN nf, GEN ideal)
2005 {
2006 pari_sp av = avma;
2007 GEN y = Idealstar(nf,ideal,1);
2008 return gerepilecopy(av,gel(y,2));
2009 }
2010
2011 GEN
idealstar0(GEN nf,GEN ideal,long flag)2012 idealstar0(GEN nf, GEN ideal,long flag)
2013 {
2014 switch(flag)
2015 {
2016 case 0: return zidealstar(nf,ideal);
2017 case 1: return zidealstarinit(nf,ideal);
2018 case 2: return zidealstarinitgen(nf,ideal);
2019 default: pari_err(flagerr,"idealstar");
2020 }
2021 return NULL; /* not reached */
2022 }
2023
2024 void
check_nfelt(GEN x,GEN * den)2025 check_nfelt(GEN x, GEN *den)
2026 {
2027 long l = lg(x), i;
2028 GEN t, d = NULL;
2029 if (typ(x) != t_COL) pari_err(talker,"%Z not a nfelt", x);
2030 for (i=1; i<l; i++)
2031 {
2032 t = gel(x,i);
2033 switch (typ(t))
2034 {
2035 case t_INT: break;
2036 case t_FRAC:
2037 if (!d) d = gel(t,2); else d = lcmii(d, gel(t,2));
2038 break;
2039 default: pari_err(talker,"%Z not a nfelt", x);
2040 }
2041 }
2042 *den = d;
2043 }
2044
2045 GEN
vecmodii(GEN a,GEN b)2046 vecmodii(GEN a, GEN b)
2047 {
2048 long i, l = lg(a);
2049 GEN c = cgetg(l, typ(a));
2050 for (i = 1; i < l; i++) gel(c,i) = modii(gel(a,i), gel(b,i));
2051 return c;
2052 }
2053
2054 /* Given x (not necessarily integral), and bid as output by zidealstarinit,
2055 * compute the vector of components on the generators bid[2].
2056 * Assume (x,bid) = 1 and sgn is either NULL or zsigne(x, bid) */
2057 GEN
zideallog_sgn(GEN nf,GEN x,GEN sgn,GEN bid)2058 zideallog_sgn(GEN nf, GEN x, GEN sgn, GEN bid)
2059 {
2060 pari_sp av;
2061 long N, lcyc;
2062 GEN den, cyc, y;
2063 int ok = 0;
2064
2065 nf = checknf(nf); checkbid(bid);
2066 cyc = gmael(bid,2,2);
2067 lcyc = lg(cyc); if (lcyc == 1) return cgetg(1, t_COL);
2068 av = avma;
2069 N = degpol(nf[1]);
2070 switch(typ(x))
2071 {
2072 case t_INT: case t_FRAC:
2073 ok = 1; den = denom(x);
2074 break;
2075 case t_POLMOD: case t_POL:
2076 x = algtobasis(nf,x); break;
2077 case t_COL: break;
2078 case t_MAT:
2079 if (lg(x) == 1) return zerocol(lcyc-1);
2080 y = famat_zlog(nf, gel(x,1), gel(x,2), sgn, bid);
2081 goto END;
2082
2083 default: pari_err(talker,"not an element in zideallog");
2084 }
2085 if (!ok)
2086 {
2087 if (lg(x) != N+1) pari_err(talker,"not an element in zideallog");
2088 check_nfelt(x, &den);
2089 }
2090 if (den)
2091 {
2092 GEN g = mkcol2(Q_muli_to_int(x,den), den);
2093 GEN e = mkcol2(gen_1, gen_m1);
2094 y = famat_zlog(nf, g, e, sgn, bid);
2095 }
2096 else
2097 {
2098 zlog_S S; init_zlog_bid(&S, bid);
2099 y = zlog(nf, x, sgn, &S);
2100 }
2101 END:
2102 y = gmul(gel(bid,5), y);
2103 return gerepileupto(av, vecmodii(y, cyc));
2104 }
2105 GEN
zideallog(GEN nf,GEN x,GEN bid)2106 zideallog(GEN nf, GEN x, GEN bid) { return zideallog_sgn(nf, x, NULL, bid); }
2107
2108 /*************************************************************************/
2109 /** **/
2110 /** JOIN BID STRUCTURES, IDEAL LISTS **/
2111 /** **/
2112 /*************************************************************************/
2113
2114 /* bid1, bid2: for coprime modules m1 and m2 (without arch. part).
2115 * Output: bid [[m1 m2,arch],[h,[cyc],[gen]],idealfact,[liste],U] for m1 m2 */
2116 static GEN
join_bid(GEN nf,GEN bid1,GEN bid2)2117 join_bid(GEN nf, GEN bid1, GEN bid2)
2118 {
2119 pari_sp av = avma;
2120 long i, nbgen, lx, lx1,lx2, l1,l2;
2121 GEN I1,I2, f1,f2, G1,G2, fa1,fa2, lists1,lists2, cyc1,cyc2;
2122 GEN lists, fa, U, cyc, y, u1 = NULL, x, gen;
2123
2124 f1 = gel(bid1,1); I1 = gel(f1,1);
2125 f2 = gel(bid2,1); I2 = gel(f2,1);
2126 if (gcmp1(gcoeff(I1,1,1))) return bid2; /* frequent trivial case */
2127 G1 = gel(bid1,2); G2 = gel(bid2,2);
2128 fa1= gel(bid1,3); fa2= gel(bid2,3); x = idealmul(nf, I1,I2);
2129 fa = concat_factor(fa1, fa2);
2130
2131 lists1 = gel(bid1,4); lx1 = lg(lists1);
2132 lists2 = gel(bid2,4); lx2 = lg(lists2);
2133 /* concat (lists1 - last elt [zarchstar]) + lists2 */
2134 lx = lx1+lx2-2; lists = cgetg(lx,t_VEC);
2135 for (i=1; i<lx1-1; i++) lists[i] = lists1[i];
2136 for ( ; i<lx; i++) lists[i] = lists2[i-lx1+2];
2137
2138 cyc1 = gel(G1,2); l1 = lg(cyc1);
2139 cyc2 = gel(G2,2); l2 = lg(cyc2);
2140 gen = (lg(G1)>3 && lg(G2)>3)? gen_1: NULL;
2141 nbgen = l1+l2-2;
2142 cyc = smithrel(diagonal_i(shallowconcat(cyc1,cyc2)),
2143 &U, gen? &u1: NULL);
2144 if (nbgen) {
2145 GEN U1 = gel(bid1,5), U2 = gel(bid2,5);
2146 U1 = l1 == 1? zeromat(nbgen,lg(U1)-1): gmul(vecslice(U, 1, l1-1), U1);
2147 U2 = l2 == 1? zeromat(nbgen,lg(U2)-1): gmul(vecslice(U, l1, nbgen), U2);
2148 U = shallowconcat(U1, U2);
2149 }
2150 else
2151 U = zeromat(0, lx-2);
2152
2153 if (gen)
2154 {
2155 GEN u, v, uv = idealaddtoone(nf,gel(f1,1),gel(f2,1));
2156 u = gel(uv,1);
2157 v = gel(uv,2);
2158 gen = shallowconcat(makeprimetoidealvec(nf,x,u,v, gel(G1,3)),
2159 makeprimetoidealvec(nf,x,v,u, gel(G2,3)));
2160 }
2161 y = cgetg(6,t_VEC);
2162 gel(y,1) = mkvec2(x, gel(f1,2));
2163 gel(y,3) = fa;
2164 gel(y,4) = lists;
2165 gel(y,5) = U;
2166 add_clgp(nf, u1, cyc, gen, y);
2167 return gerepilecopy(av,y);
2168 }
2169
2170 /* bid1 = for module m1 (without arch. part), arch = archimedean part.
2171 * Output: bid [[m1,arch],[h,[cyc],[gen]],idealfact,[liste],U] for m1.arch */
2172 static GEN
join_bid_arch(GEN nf,GEN bid1,GEN arch)2173 join_bid_arch(GEN nf, GEN bid1, GEN arch)
2174 {
2175 pari_sp av = avma;
2176 long i, lx1;
2177 GEN f1, G1, fa1, lists1, U;
2178 GEN lists, cyc, y, u1 = NULL, x, sarch, gen;
2179
2180 checkbid(bid1);
2181 f1 = gel(bid1,1); G1 = gel(bid1,2); fa1 = gel(bid1,3);
2182 x = gel(f1,1);
2183 sarch = zarchstar(nf, x, arch);
2184 lists1 = gel(bid1,4); lx1 = lg(lists1);
2185 lists = cgetg(lx1,t_VEC);
2186 for (i=1; i<lx1-1; i++) lists[i] = lists1[i];
2187 gel(lists,i) = sarch;
2188
2189 gen = (lg(G1)>3)? gen_1: NULL;
2190 cyc = diagonal_i(shallowconcat(gel(G1,2), gel(sarch,1)));
2191 cyc = smithrel(cyc, &U, gen? &u1: NULL);
2192 if (gen) gen = shallowconcat(gel(G1,3), gel(sarch,2));
2193 y = cgetg(6,t_VEC);
2194 gel(y,1) = mkvec2(x, arch);
2195 gel(y,3) = fa1;
2196 gel(y,4) = lists;
2197 gel(y,5) = U;
2198 add_clgp(nf, u1, cyc, gen, y);
2199 return gerepilecopy(av,y);
2200 }
2201
2202 #if 0 /* could be useful somewhere else */
2203 /* z <- ( z | f(v[i])_{i=1..#v} )*/
2204 void
2205 concatmap(GEN *pz, GEN v, GEN (*f)(void*,GEN), void *data)
2206 {
2207 long i, nz, lv = lg(v);
2208 GEN z, Z, Zt;
2209 if (lv == 1) return;
2210 z = *pz; nz = lg(z)-1;
2211 Z = cgetg(lv + nz, typ(z));
2212 for (i = 1; i <=nz; i++) Z[i] = z[i];
2213 Zt = Z + nz;
2214 for (i = 1; i < lv; i++) gel(Zt,i) = f(data, gel(v,i));
2215 *pz = Z;
2216 }
2217 #endif
2218
2219 typedef struct _ideal_data {
2220 GEN nf, emb, L, pr, prL, arch, sgnU;
2221 } ideal_data;
2222 static void
concat_join(GEN * pz,GEN v,GEN (* f)(ideal_data *,GEN),ideal_data * data)2223 concat_join(GEN *pz, GEN v, GEN (*f)(ideal_data*,GEN), ideal_data *data)
2224 {
2225 long i, nz, lv = lg(v);
2226 GEN z, Z, Zt;
2227 if (lv == 1) return;
2228 z = *pz; nz = lg(z)-1;
2229 Z = cgetg(lv + nz, typ(z));
2230 for (i = 1; i <=nz; i++) Z[i] = z[i];
2231 Zt = Z + nz;
2232 for (i = 1; i < lv; i++) gel(Zt,i) = f(data, gel(v,i));
2233 *pz = Z;
2234 }
2235 static GEN
join_idealinit(ideal_data * D,GEN x)2236 join_idealinit(ideal_data *D, GEN x) {
2237 return join_bid(D->nf, x, D->prL);
2238 }
2239 static GEN
join_ideal(ideal_data * D,GEN x)2240 join_ideal(ideal_data *D, GEN x) {
2241 return idealmulpowprime(D->nf, x, D->pr, D->L);
2242 }
2243 static GEN
join_unit(ideal_data * D,GEN x)2244 join_unit(ideal_data *D, GEN x) {
2245 return mkvec2(join_idealinit(D, gel(x,1)), vconcat(gel(x,2), D->emb));
2246 }
2247
2248 /* compute matrix of zlogs of units */
2249 GEN
zlog_units(GEN nf,GEN U,GEN sgnU,GEN bid)2250 zlog_units(GEN nf, GEN U, GEN sgnU, GEN bid)
2251 {
2252 long j, l = lg(U);
2253 GEN m = cgetg(l, t_MAT);
2254 zlog_S S; init_zlog_bid(&S, bid);
2255 for (j = 1; j < l; j++)
2256 gel(m,j) = zlog(nf, gel(U,j), vecpermute(gel(sgnU,j), S.archp), &S);
2257 return m;
2258 }
2259 /* compute matrix of zlogs of units, assuming S.archp = [] */
2260 GEN
zlog_units_noarch(GEN nf,GEN U,GEN bid)2261 zlog_units_noarch(GEN nf, GEN U, GEN bid)
2262 {
2263 long j, l = lg(U);
2264 GEN m = cgetg(l, t_MAT), empty = cgetg(1, t_COL);
2265 zlog_S S; init_zlog_bid(&S, bid);
2266 for (j = 1; j < l; j++) gel(m,j) = zlog(nf, gel(U,j), empty, &S);
2267 return m;
2268 }
2269
2270 /* calcule la matrice des zlog des unites */
2271 static GEN
zlog_unitsarch(GEN sgnU,GEN bid)2272 zlog_unitsarch(GEN sgnU, GEN bid)
2273 {
2274 GEN U, liste = gel(bid,4), arch = gmael(bid,1,2);
2275 long i;
2276 U = gmul(gmael(liste, lg(liste)-1, 3),
2277 rowpermute(sgnU, arch_to_perm(arch)));
2278 for (i = 1; i < lg(U); i++) (void)F2V_red_ip(gel(U,i));
2279 return U;
2280 }
2281
2282 /* flag &1 : generators, otherwise no
2283 * flag &2 : units, otherwise no
2284 * flag &4 : ideals in HNF, otherwise bid */
2285 static GEN
Ideallist(GEN bnf,ulong bound,long flag)2286 Ideallist(GEN bnf, ulong bound, long flag)
2287 {
2288 const long do_gen = flag & 1, do_units = flag & 2, big_id = !(flag & 4);
2289 byteptr ptdif = diffptr;
2290 pari_sp lim, av, av0 = avma;
2291 long i, j, l;
2292 GEN nf, z, p, fa, id, U, empty = cgetg(1,t_VEC);
2293 ideal_data ID;
2294 GEN (*join_z)(ideal_data*, GEN) =
2295 do_units? &join_unit
2296 : (big_id? &join_idealinit: &join_ideal);
2297
2298 nf = checknf(bnf);
2299 if ((long)bound <= 0) return empty;
2300 id = matid(degpol(nf[1]));
2301 if (big_id) id = Idealstar(nf,id,do_gen);
2302
2303 /* z[i] will contain all "objects" of norm i. Depending on flag, this means
2304 * an ideal, a bid, or a couple [bid, log(units)]. Such objects are stored
2305 * in vectors, computed one primary component at a time; join_z
2306 * reconstructs the global object */
2307 z = cgetg(bound+1,t_VEC);
2308 if (do_units) {
2309 U = init_units(bnf);
2310 gel(z,1) = mkvec( mkvec2(id, zlog_units_noarch(nf, U, id)) );
2311 } else {
2312 U = NULL; /* -Wall */
2313 gel(z,1) = mkvec(id);
2314 }
2315 for (i=2; i<=(long)bound; i++) gel(z,i) = empty;
2316 ID.nf = nf;
2317
2318 p = cgeti(3); p[1] = evalsigne(1) | evallgefint(3);
2319 av = avma; lim = stack_lim(av,1);
2320 maxprime_check(bound);
2321 for (p[2] = 0; (ulong)p[2] <= bound; )
2322 {
2323 NEXT_PRIME_VIADIFF(p[2], ptdif);
2324 if (DEBUGLEVEL>1) { fprintferr("%ld ",p[2]); flusherr(); }
2325 fa = primedec(nf, p);
2326 for (j=1; j<lg(fa); j++)
2327 {
2328 GEN pr = gel(fa,j), z2;
2329 ulong q, iQ, Q = itou_or_0(pr_norm(pr));
2330 if (!Q || Q > bound) break;
2331
2332 z2 = shallowcopy(z);
2333 q = Q;
2334 ID.pr = ID.prL = pr;
2335 for (l=1; Q <= bound; l++, Q *= q) /* add pr^l */
2336 {
2337 ID.L = utoipos(l);
2338 if (big_id) {
2339 if (l > 1) ID.prL = idealpow(nf,pr,ID.L);
2340 ID.prL = Idealstar(nf,ID.prL,do_gen);
2341 if (do_units) ID.emb = zlog_units_noarch(nf, U, ID.prL);
2342 }
2343 for (iQ = Q,i = 1; iQ <= bound; iQ += Q,i++)
2344 concat_join(&gel(z,iQ), gel(z2,i), join_z, &ID);
2345 }
2346 }
2347 if (low_stack(lim, stack_lim(av,1)))
2348 {
2349 if(DEBUGMEM>1) pari_warn(warnmem,"Ideallist");
2350 z = gerepilecopy(av, z);
2351 }
2352 }
2353 if (do_units) for (i = 1; i < lg(z); i++)
2354 {
2355 GEN s = gel(z,i);
2356 long l = lg(s);
2357 for (j = 1; j < l; j++) {
2358 GEN v = gel(s,j), bid = gel(v,1);
2359 gel(v,2) = gmul(gel(bid,5), gel(v,2));
2360 }
2361 }
2362 return gerepilecopy(av0, z);
2363 }
2364 GEN
ideallist0(GEN bnf,long bound,long flag)2365 ideallist0(GEN bnf,long bound, long flag) {
2366 if (flag<0 || flag>4) pari_err(flagerr,"ideallist");
2367 return Ideallist(bnf,bound,flag);
2368 }
2369 GEN
ideallistzstar(GEN nf,long bound)2370 ideallistzstar(GEN nf,long bound) { return Ideallist(nf,bound,0); }
2371 GEN
ideallistzstargen(GEN nf,long bound)2372 ideallistzstargen(GEN nf,long bound) { return Ideallist(nf,bound,1); }
2373 GEN
ideallistunit(GEN nf,long bound)2374 ideallistunit(GEN nf,long bound) { return Ideallist(nf,bound,2); }
2375 GEN
ideallistunitgen(GEN nf,long bound)2376 ideallistunitgen(GEN nf,long bound) { return Ideallist(nf,bound,3); }
2377 GEN
ideallist(GEN bnf,long bound)2378 ideallist(GEN bnf,long bound) { return Ideallist(bnf,bound,4); }
2379
2380 static GEN
join_arch(ideal_data * D,GEN x)2381 join_arch(ideal_data *D, GEN x) {
2382 return join_bid_arch(D->nf, x, D->arch);
2383 }
2384 static GEN
join_archunit(ideal_data * D,GEN x)2385 join_archunit(ideal_data *D, GEN x) {
2386 GEN bid = join_arch(D, gel(x,1)), U = gel(x,2);
2387 U = gmul(gel(bid,5), vconcat(U, zlog_unitsarch(D->sgnU, bid)));
2388 return mkvec2(bid, U);
2389 }
2390
2391 /* L from ideallist, add archimedean part */
2392 GEN
ideallistarch(GEN bnf,GEN L,GEN arch)2393 ideallistarch(GEN bnf, GEN L, GEN arch)
2394 {
2395 pari_sp av;
2396 long i, j, l = lg(L), lz;
2397 GEN v, z, V;
2398 ideal_data ID;
2399 GEN (*join_z)(ideal_data*, GEN) = &join_arch;
2400
2401 if (typ(L) != t_VEC) pari_err(typeer, "ideallistarch");
2402 if (l == 1) return cgetg(1,t_VEC);
2403 z = gel(L,1);
2404 if (typ(z) != t_VEC) pari_err(typeer, "ideallistarch");
2405 z = gel(z,1); /* either a bid or [bid,U] */
2406 if (lg(z) == 3) { /* the latter: do units */
2407 if (typ(z) != t_VEC) pari_err(typeer,"ideallistarch");
2408 join_z = &join_archunit;
2409 ID.sgnU = zsignunits(bnf, NULL, 1);
2410 }
2411 ID.nf = checknf(bnf);
2412 arch = arch_to_perm(arch);
2413 av = avma; V = cgetg(l, t_VEC);
2414 for (i = 1; i < l; i++)
2415 {
2416 z = gel(L,i); lz = lg(z);
2417 gel(V,i) = v = cgetg(lz,t_VEC);
2418 for (j=1; j<lz; j++) gel(v,j) = join_z(&ID, gel(z,j));
2419 }
2420 return gerepilecopy(av,V);
2421 }
2422