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 : /* RNF STRUCTURE AND OPERATIONS */
17 : /* */
18 : /*******************************************************************/
19 : #include "pari.h"
20 : #include "paripriv.h"
21 :
22 : /* must return a t_POL */
23 : GEN
24 21133 : eltreltoabs(GEN rnfeq, GEN x)
25 : {
26 : long i, k, v;
27 21133 : pari_sp av = avma;
28 : GEN T, pol, teta, a, s;
29 :
30 21133 : pol = gel(rnfeq,1);
31 21133 : a = gel(rnfeq,2);
32 21133 : k = itos(gel(rnfeq,3));
33 21133 : T = gel(rnfeq,4);
34 :
35 21133 : v = varn(pol);
36 21133 : if (varncmp(gvar(x), v) > 0) x = scalarpol(x,v);
37 21133 : x = RgX_nffix("eltreltoabs", T, x, 1);
38 : /* Mod(X - k a, pol(X)), a root of the polynomial defining base */
39 21126 : teta = gadd(pol_x(v), gmulsg(-k,a));
40 21126 : s = gen_0;
41 78533 : for (i=lg(x)-1; i>1; i--)
42 : {
43 57407 : GEN c = gel(x,i);
44 57407 : if (typ(c) == t_POL) c = RgX_RgXQ_eval(c, a, pol);
45 57407 : s = RgX_rem(gadd(c, gmul(teta,s)), pol);
46 : }
47 21126 : return gerepileupto(av, s);
48 : }
49 : GEN
50 43316 : rnfeltreltoabs(GEN rnf,GEN x)
51 : {
52 43316 : const char *f = "rnfeltreltoabs";
53 : GEN pol;
54 43316 : checkrnf(rnf);
55 43316 : pol = rnf_get_polabs(rnf);
56 43316 : switch(typ(x))
57 : {
58 7700 : case t_INT: return icopy(x);
59 21 : case t_FRAC: return gcopy(x);
60 : case t_POLMOD:
61 34951 : if (RgX_equal_var(gel(x,1), pol))
62 : { /* already in 'abs' form, unless possibly if nf = Q */
63 13867 : if (rnf_get_nfdegree(rnf) == 1)
64 : {
65 13846 : GEN y = gel(x,2);
66 13846 : pari_sp av = avma;
67 13846 : y = simplify_shallow(liftpol_shallow(y));
68 13846 : return gerepilecopy(av, mkpolmod(y, pol));
69 : }
70 21 : return gcopy(x);
71 : }
72 21084 : x = polmod_nffix(f,rnf,x,0);
73 21070 : if (typ(x) == t_POLMOD) return rnfeltup(rnf,x);
74 17220 : retmkpolmod(eltreltoabs(rnf_get_map(rnf), x), ZX_copy(pol));
75 : case t_POL:
76 595 : if (varn(x) == rnf_get_nfvarn(rnf)) return rnfeltup(rnf,x);
77 539 : retmkpolmod(eltreltoabs(rnf_get_map(rnf), x), ZX_copy(pol));
78 : }
79 49 : pari_err_TYPE(f,x); return NULL;
80 : }
81 :
82 : GEN
83 16877 : eltabstorel_lift(GEN rnfeq, GEN P)
84 : {
85 16877 : GEN k, T = gel(rnfeq,4), relpol = gel(rnfeq,5);
86 16877 : if (is_scalar_t(typ(P))) return P;
87 16597 : k = gel(rnfeq,3);
88 16597 : P = lift_shallow(P);
89 16597 : if (signe(k)) P = RgXQX_translate(P, deg1pol_shallow(k, gen_0, varn(T)), T);
90 16597 : P = RgXQX_rem(P, relpol, T);
91 16597 : return QXQX_to_mod_shallow(P, T);
92 : }
93 : /* rnfeq = [pol,a,k,T,relpol], P a t_POL or scalar
94 : * Return Mod(P(x + k Mod(y, T(y))), pol(x)) */
95 : GEN
96 16821 : eltabstorel(GEN rnfeq, GEN P)
97 : {
98 16821 : GEN T = gel(rnfeq,4), relpol = gel(rnfeq,5);
99 16821 : return mkpolmod(eltabstorel_lift(rnfeq,P), QXQX_to_mod_shallow(relpol,T));
100 : }
101 : GEN
102 44646 : rnfeltabstorel(GEN rnf,GEN x)
103 : {
104 44646 : const char *f = "rnfeltabstorel";
105 44646 : pari_sp av = avma;
106 : GEN pol, T, P, NF;
107 44646 : checkrnf(rnf);
108 44646 : T = rnf_get_nfpol(rnf);
109 44646 : P = rnf_get_pol(rnf);
110 44646 : pol = rnf_get_polabs(rnf);
111 44646 : switch(typ(x))
112 : {
113 77 : case t_INT: return icopy(x);
114 49 : case t_FRAC: return gcopy(x);
115 : case t_POLMOD:
116 43204 : if (RgX_equal_var(P, gel(x,1)))
117 : {
118 14000 : x = polmod_nffix(f, rnf, x, 0);
119 14000 : P = QXQX_to_mod_shallow(P,T);
120 14000 : return gerepilecopy(av, mkpolmod(x,P));
121 : }
122 29204 : if (RgX_equal_var(T, gel(x,1))) { x = Rg_nffix(f, T, x, 0); goto END; }
123 29120 : if (!RgX_equal_var(pol, gel(x,1))) pari_err_MODULUS(f, gel(x,1),pol);
124 29078 : x = gel(x,2); break;
125 875 : case t_POL: break;
126 : case t_COL:
127 441 : NF = obj_check(rnf, rnf_NFABS);
128 441 : if (!NF) pari_err_TYPE("rnfeltabstorel, apply nfinit(rnf)",x);
129 294 : x = nf_to_scalar_or_alg(NF,x); break;
130 : default:
131 0 : pari_err_TYPE(f,x);
132 0 : return NULL;
133 : }
134 30247 : switch(typ(x))
135 : {
136 9891 : case t_INT: return icopy(x);
137 56 : case t_FRAC: return gcopy(x);
138 20300 : case t_POL: break;
139 0 : default: pari_err_TYPE(f, x);
140 : }
141 20300 : RgX_check_QX(x,f);
142 20223 : if (varn(x) != varn(pol))
143 : {
144 70 : if (varn(x) == varn(T)) { x = Rg_nffix(f,T,x,0); goto END; }
145 28 : pari_err_VAR(f, x,pol);
146 : }
147 20153 : switch(lg(x))
148 : {
149 3010 : case 2: avma = av; return gen_0;
150 1827 : case 3: return gerepilecopy(av, gel(x,2));
151 : }
152 : END:
153 15442 : return gerepilecopy(av, eltabstorel(rnf_get_map(rnf), x));
154 : }
155 :
156 : /* x a t_VEC of rnf elements in 'alg' form (t_POL). Assume maximal rank or 0 */
157 : static GEN
158 1330 : modulereltoabs(GEN rnf, GEN x)
159 : {
160 1330 : GEN W=gel(x,1), I=gel(x,2), rnfeq = rnf_get_map(rnf), polabs = gel(rnfeq,1);
161 1330 : long i, j, k, m, N = lg(W)-1;
162 : GEN zknf, czknf, M;
163 :
164 1330 : if (!N) return cgetg(1, t_VEC);
165 1267 : rnf_get_nfzk(rnf, &zknf,&czknf);
166 1267 : m = rnf_get_nfdegree(rnf);
167 1267 : M = cgetg(N*m+1, t_VEC);
168 4648 : for (k=i=1; i<=N; i++)
169 : {
170 3381 : GEN c0, cid, w = gel(W,i), id = gel(I,i);
171 :
172 3381 : if (lg(id) == 1) continue; /* must be a t_MAT */
173 3332 : id = Q_primitive_part(id, &cid);
174 3332 : w = Q_primitive_part(eltreltoabs(rnfeq,w), &c0);
175 3332 : c0 = mul_content(c0, mul_content(cid,czknf));
176 3332 : if (typ(id) == t_INT)
177 6237 : for (j=1; j<=m; j++)
178 : {
179 4123 : GEN z = RgX_rem(gmul(w, gel(zknf,j)), polabs);
180 4123 : if (c0) z = RgX_Rg_mul(z, c0);
181 4123 : gel(M,k++) = z;
182 : }
183 : else
184 4186 : for (j=1; j<=m; j++)
185 : {
186 2968 : GEN c, z = Q_primitive_part(RgV_RgC_mul(zknf,gel(id,j)), &c);
187 2968 : z = RgX_rem(gmul(w, z), polabs);
188 2968 : c = mul_content(c, c0); if (c) z = RgX_Rg_mul(z, c);
189 2968 : gel(M,k++) = z;
190 : }
191 : }
192 1267 : setlg(M, k); return M;
193 : }
194 :
195 : /* Z-basis for absolute maximal order: [NF.pol, NF.zk] */
196 : GEN
197 882 : rnf_zkabs(GEN rnf)
198 : {
199 882 : GEN d, M = modulereltoabs(rnf, rnf_get_zk(rnf));
200 882 : GEN T = rnf_get_polabs(rnf);
201 882 : long n = degpol(T);
202 882 : M = Q_remove_denom(M, &d); /* t_VEC of t_POL */
203 882 : if (d)
204 : {
205 630 : M = RgXV_to_RgM(M,n);
206 630 : M = ZM_hnfmodall(M, d, hnf_MODID|hnf_CENTER);
207 630 : M = RgM_Rg_div(M, d);
208 : }
209 : else
210 252 : M = matid(n);
211 882 : return mkvec2(T, RgM_to_RgXV(M, varn(T)));
212 : }
213 :
214 : static GEN
215 855 : mknfabs(GEN rnf, long prec)
216 : {
217 : GEN NF;
218 855 : if ((NF = obj_check(rnf,rnf_NFABS)))
219 1 : { if (nf_get_prec(NF) < prec) NF = nfnewprec_shallow(NF,prec); }
220 : else
221 854 : NF = nfinit(rnf_zkabs(rnf), prec);
222 855 : return NF;
223 : }
224 :
225 : static GEN
226 854 : mkupdown(GEN rnf)
227 : {
228 854 : GEN NF = obj_check(rnf, rnf_NFABS), M, zknf, czknf;
229 : long i, m;
230 854 : rnf_get_nfzk(rnf, &zknf, &czknf);
231 854 : if (isint1(czknf)) czknf = NULL;
232 854 : m = lg(zknf)-1; M = cgetg(m+1, t_MAT);
233 854 : gel(M,1) = vec_ei(nf_get_degree(NF), 1);
234 1575 : for (i = 2; i <= m; i++)
235 : {
236 721 : GEN c = poltobasis(NF, gel(zknf,i));
237 721 : if (czknf) c = gmul(c, czknf);
238 721 : gel(M,i) = c;
239 : }
240 854 : return Qevproj_init(M);
241 : }
242 : GEN
243 22295 : rnf_build_nfabs(GEN rnf, long prec)
244 : {
245 22295 : GEN NF = obj_checkbuild_prec(rnf, rnf_NFABS, &mknfabs, &nf_get_prec, prec);
246 22295 : (void)obj_checkbuild(rnf, rnf_MAPS, &mkupdown);
247 22295 : return NF;
248 : }
249 :
250 : void
251 1484 : rnfcomplete(GEN rnf)
252 1484 : { (void)rnf_build_nfabs(rnf, nf_get_prec(rnf_get_nf(rnf))); }
253 :
254 : void
255 1050 : nf_nfzk(GEN nf, GEN rnfeq, GEN *zknf, GEN *czknf)
256 : {
257 1050 : GEN pol = gel(rnfeq,1), a = gel(rnfeq,2);
258 1050 : GEN C, zk = nf_get_zkprimpart(nf), D = nf_get_zkden(nf);
259 1050 : zk = QXV_QXQ_eval(zk, a, pol);
260 1050 : *zknf = Q_primitive_part(zk, &C);
261 1050 : if (!C) C = gen_1;
262 1050 : *czknf = gdiv(C, D);
263 1050 : }
264 :
265 : GEN
266 1050 : rnfinit0(GEN nf, GEN polrel, long flag)
267 : {
268 1050 : pari_sp av = avma;
269 : GEN rnf, bas, D,d,f, B, rnfeq, zknf,czknf;
270 1050 : nf = checknf(nf);
271 1050 : bas = rnfallbase(nf,&polrel, &D,&d, &f);
272 1043 : B = matbasistoalg(nf,gel(bas,1));
273 1043 : gel(bas,1) = lift_if_rational( RgM_to_RgXV(B,varn(polrel)) );
274 1043 : rnfeq = nf_rnfeq(nf,polrel);
275 1043 : nf_nfzk(nf, rnfeq, &zknf, &czknf);
276 1043 : rnf = obj_init(11, 2);
277 1043 : gel(rnf,1) = polrel;
278 1043 : gel(rnf,2) = mkvec2(zknf, czknf);
279 1043 : gel(rnf,3) = mkvec2(D, d);
280 1043 : gel(rnf,4) = f;
281 1043 : gel(rnf,5) = cgetg(1, t_VEC); /* dummy */
282 1043 : gel(rnf,6) = cgetg(1, t_VEC); /* dummy */
283 1043 : gel(rnf,7) = bas;
284 1043 : gel(rnf,8) = lift_if_rational( RgM_inv_upper(B) );
285 1043 : gel(rnf,9) = typ(f) == t_INT? gen_1: RgM_det_triangular(f);
286 1043 : gel(rnf,10)= nf;
287 1043 : gel(rnf,11)= rnfeq;
288 1043 : rnf = gerepilecopy(av, rnf);
289 1043 : if (flag) rnfcomplete(rnf);
290 1043 : return rnf;
291 : }
292 : GEN
293 336 : rnfinit(GEN nf, GEN T) { return rnfinit0(nf,T,0); }
294 :
295 : GEN
296 5782 : rnfeltup0(GEN rnf, GEN x, long flag)
297 : {
298 5782 : pari_sp av = avma;
299 : GEN zknf, czknf, nf, NF, POL;
300 5782 : long tx = typ(x);
301 5782 : checkrnf(rnf);
302 5782 : if (flag) rnfcomplete(rnf);
303 5782 : NF = obj_check(rnf,rnf_NFABS);
304 5782 : POL = rnf_get_polabs(rnf);
305 5782 : if (tx == t_POLMOD && RgX_equal_var(gel(x,1), POL))
306 : {
307 28 : if (flag) x = nf_to_scalar_or_basis(NF,x);
308 28 : return gerepilecopy(av, x);
309 : }
310 5754 : if (NF && tx == t_COL && lg(x)-1 == nf_get_degree(NF))
311 : {
312 0 : x = flag? nf_to_scalar_or_basis(NF,x)
313 0 : : mkpolmod(nf_to_scalar_or_alg(NF,x), POL);
314 0 : return gerepilecopy(av, x);
315 : }
316 5754 : nf = rnf_get_nf(rnf);
317 5754 : if (NF)
318 : {
319 : GEN d, proj;
320 5523 : x = nf_to_scalar_or_basis(nf, x);
321 5523 : if (typ(x) != t_COL) return gerepilecopy(av, x);
322 4767 : proj = obj_check(rnf,rnf_MAPS);
323 4767 : x = Q_remove_denom(x,&d);
324 4767 : x = ZM_ZC_mul(gel(proj,1), x);
325 4767 : if (d) x = gdiv(x,d);
326 4767 : if (!flag) x = basistoalg(NF,x);
327 : }
328 : else
329 : {
330 231 : rnf_get_nfzk(rnf, &zknf, &czknf);
331 231 : x = nfeltup(nf, x, zknf, czknf);
332 112 : if (typ(x) == t_POL) x = mkpolmod(x, POL);
333 : }
334 4879 : return gerepilecopy(av, x);
335 : }
336 : GEN
337 5516 : rnfeltup(GEN rnf, GEN x) { return rnfeltup0(rnf,x,0); }
338 :
339 : GEN
340 259 : nfeltup(GEN nf, GEN x, GEN zknf, GEN czknf)
341 : {
342 : GEN c;
343 259 : x = nf_to_scalar_or_basis(nf, x);
344 140 : if (typ(x) != t_COL) return x;
345 42 : x = Q_primitive_part(x, &c);
346 42 : if (!RgV_is_ZV(x)) pari_err_TYPE("rnfeltup", x);
347 42 : c = mul_content(c, czknf);
348 42 : x = RgV_RgC_mul(zknf, x); if (c) x = RgX_Rg_mul(x, c);
349 42 : return x;
350 : }
351 :
352 : static void
353 49 : fail(const char *f, GEN x)
354 49 : { pari_err_DOMAIN(f,"element","not in", strtoGENstr("the base field"),x); }
355 : /* x t_COL of length degabs */
356 : static GEN
357 0 : eltdown(GEN rnf, GEN x, long flag)
358 : {
359 0 : GEN z,y, d, proj = obj_check(rnf,rnf_MAPS);
360 0 : GEN M= gel(proj,1), iM=gel(proj,2), diM=gel(proj,3), perm=gel(proj,4);
361 0 : x = Q_remove_denom(x,&d);
362 0 : if (!RgV_is_ZV(x)) pari_err_TYPE("rnfeltdown", x);
363 0 : y = ZM_ZC_mul(iM, vecpermute(x, perm));
364 0 : z = ZM_ZC_mul(M,y);
365 0 : if (!isint1(diM)) z = ZC_Z_mul(z,diM);
366 0 : if (!ZV_equal(z,x)) fail("rnfeltdown",x);
367 :
368 0 : d = mul_denom(d, diM);
369 0 : if (d) y = gdiv(y,d);
370 0 : if (!flag) y = basistoalg(rnf_get_nf(rnf), y);
371 0 : return y;
372 : }
373 : GEN
374 1757 : rnfeltdown0(GEN rnf, GEN x, long flag)
375 : {
376 1757 : const char *f = "rnfeltdown";
377 1757 : pari_sp av = avma;
378 : GEN z, T, NF, nf;
379 : long v;
380 :
381 1757 : checkrnf(rnf);
382 1757 : NF = obj_check(rnf,rnf_NFABS);
383 1757 : nf = rnf_get_nf(rnf);
384 1757 : T = nf_get_pol(nf);
385 1757 : v = varn(T);
386 1757 : switch(typ(x))
387 : { /* directly belonging to base field ? */
388 490 : case t_INT: return icopy(x);
389 56 : case t_FRAC:return gcopy(x);
390 : case t_POLMOD:
391 1099 : if (RgX_equal_var(gel(x,1), rnf_get_polabs(rnf)))
392 : {
393 168 : if (degpol(T) == 1)
394 : {
395 140 : x = simplify_shallow(liftpol_shallow(gel(x,2)));
396 140 : if (typ(x) != t_POL) return gerepilecopy(av,x);
397 : }
398 35 : break;
399 : }
400 931 : x = polmod_nffix(f,rnf,x,0);
401 : /* x was defined mod the relative polynomial & non constant => fail */
402 917 : if (typ(x) == t_POL) fail(f,x);
403 896 : if (flag) x = nf_to_scalar_or_basis(nf,x);
404 896 : return gerepilecopy(av, x);
405 :
406 : case t_POL:
407 63 : if (varn(x) != v) break;
408 21 : x = Rg_nffix(f,T,x,0);
409 14 : if (flag) x = nf_to_scalar_or_basis(nf,x);
410 14 : return gerepilecopy(av, x);
411 : case t_COL:
412 : {
413 49 : long n = lg(x)-1;
414 49 : if (n == degpol(T) && RgV_is_QV(x))
415 : {
416 7 : if (RgV_isscalar(x)) return gcopy(gel(x,1));
417 0 : if (!flag) return gcopy(x);
418 0 : return basistoalg(nf,x);
419 : }
420 42 : if (NF) break;
421 : }
422 42 : default: pari_err_TYPE(f, x);
423 : }
424 : /* x defined mod the absolute equation */
425 77 : if (NF)
426 : {
427 0 : x = nf_to_scalar_or_basis(NF, x);
428 0 : if (typ(x) == t_COL) x = eltdown(rnf,x,flag);
429 0 : return gerepilecopy(av, x);
430 : }
431 77 : z = rnfeltabstorel(rnf,x);
432 56 : switch(typ(z))
433 : {
434 : case t_INT:
435 14 : case t_FRAC: return z;
436 : }
437 : /* typ(z) = t_POLMOD, varn of both components is rnf_get_varn(rnf) */
438 42 : z = gel(z,2);
439 42 : if (typ(z) == t_POL)
440 : {
441 42 : if (lg(z) != 3) fail(f,x);
442 14 : z = gel(z,2);
443 : }
444 14 : return gerepilecopy(av, z);
445 : }
446 : GEN
447 1512 : rnfeltdown(GEN rnf, GEN x) { return rnfeltdown0(rnf,x,0); }
448 :
449 : /* vector of rnf elt -> matrix of nf elts */
450 : static GEN
451 476 : rnfV_to_nfM(GEN rnf, GEN x)
452 : {
453 476 : long i, l = lg(x);
454 476 : GEN y = cgetg(l, t_MAT);
455 476 : for (i = 1; i < l; i++) gel(y,i) = rnfalgtobasis(rnf,gel(x,i));
456 476 : return y;
457 : }
458 :
459 : static GEN
460 770 : rnfprincipaltohnf(GEN rnf,GEN x)
461 : {
462 770 : pari_sp av = avma;
463 770 : GEN bas = rnf_get_zk(rnf), nf = rnf_get_nf(rnf);
464 770 : x = rnfbasistoalg(rnf,x);
465 434 : x = gmul(x, gmodulo(gel(bas,1), rnf_get_pol(rnf)));
466 434 : return gerepileupto(av, nfhnf(nf, mkvec2(rnfV_to_nfM(rnf,x), gel(bas,2))));
467 : }
468 :
469 : /* pseudo-basis for the 0 ideal */
470 : static GEN
471 154 : rnfideal0(void) { retmkvec2(cgetg(1,t_MAT),cgetg(1,t_VEC)); }
472 :
473 : GEN
474 1316 : rnfidealhnf(GEN rnf, GEN x)
475 : {
476 : GEN z, nf, bas;
477 :
478 1316 : checkrnf(rnf); nf = rnf_get_nf(rnf);
479 1316 : switch(typ(x))
480 : {
481 : case t_INT: case t_FRAC:
482 168 : if (isintzero(x)) return rnfideal0();
483 112 : bas = rnf_get_zk(rnf); z = cgetg(3,t_VEC);
484 112 : gel(z,1) = matid(rnf_get_degree(rnf));
485 112 : gel(z,2) = gmul(x, gel(bas,2)); return z;
486 :
487 : case t_VEC:
488 266 : if (lg(x) == 3 && typ(gel(x,1)) == t_MAT) return nfhnf(nf, x);
489 : case t_MAT:
490 252 : return rnfidealabstorel(rnf, x);
491 :
492 : case t_POLMOD: case t_POL: case t_COL:
493 770 : return rnfprincipaltohnf(rnf,x);
494 : }
495 0 : pari_err_TYPE("rnfidealhnf",x);
496 : return NULL; /* LCOV_EXCL_LINE */
497 : }
498 :
499 : static GEN
500 105 : prodidnorm(GEN nf, GEN I)
501 : {
502 105 : long i, l = lg(I);
503 : GEN z;
504 105 : if (l == 1) return gen_1;
505 105 : z = idealnorm(nf, gel(I,1));
506 105 : for (i=2; i<l; i++) z = gmul(z, idealnorm(nf, gel(I,i)));
507 105 : return z;
508 : }
509 :
510 : GEN
511 196 : rnfidealnormrel(GEN rnf, GEN id)
512 : {
513 196 : pari_sp av = avma;
514 196 : GEN nf, z = gel(rnfidealhnf(rnf,id), 2);
515 126 : if (lg(z) == 1) return cgetg(1, t_MAT);
516 98 : nf = rnf_get_nf(rnf); z = idealprod(nf, z);
517 98 : return gerepileupto(av, idealmul(nf,z, rnf_get_index(rnf)));
518 : }
519 :
520 : GEN
521 203 : rnfidealnormabs(GEN rnf, GEN id)
522 : {
523 203 : pari_sp av = avma;
524 203 : GEN nf, z = gel(rnfidealhnf(rnf,id), 2);
525 133 : if (lg(z) == 1) return gen_0;
526 105 : nf = rnf_get_nf(rnf); z = prodidnorm(nf, z);
527 105 : return gerepileupto(av, gmul(z, gel(rnf,9)));
528 : }
529 :
530 : static GEN
531 490 : rnfidealreltoabs_i(GEN rnf, GEN x)
532 : {
533 : long i, l;
534 : GEN w;
535 490 : x = rnfidealhnf(rnf,x);
536 350 : w = gel(x,1); l = lg(w); settyp(w, t_VEC);
537 350 : for (i=1; i<l; i++) gel(w,i) = lift_shallow( rnfbasistoalg(rnf, gel(w,i)) );
538 350 : return modulereltoabs(rnf, x);
539 : }
540 : GEN
541 0 : rnfidealreltoabs(GEN rnf, GEN x)
542 : {
543 0 : pari_sp av = avma;
544 0 : return gerepilecopy(av, rnfidealreltoabs_i(rnf,x));
545 : }
546 : GEN
547 238 : rnfidealreltoabs0(GEN rnf, GEN x, long flag)
548 : {
549 238 : pari_sp av = avma;
550 : long i, l;
551 : GEN NF;
552 :
553 238 : x = rnfidealreltoabs_i(rnf, x);
554 168 : if (!flag) return gerepilecopy(av,x);
555 35 : rnfcomplete(rnf);
556 35 : NF = obj_check(rnf,rnf_NFABS);
557 35 : l = lg(x); settyp(x, t_MAT);
558 35 : for (i=1; i<l; i++) gel(x,i) = algtobasis(NF, gel(x,i));
559 35 : return gerepileupto(av, idealhnf(NF,x));
560 : }
561 :
562 : GEN
563 455 : rnfidealabstorel(GEN rnf, GEN x)
564 : {
565 455 : long n, N, j, tx = typ(x);
566 455 : pari_sp av = avma;
567 : GEN A, I, invbas;
568 :
569 455 : checkrnf(rnf);
570 455 : invbas = rnf_get_invzk(rnf);
571 455 : if (tx != t_VEC && tx != t_MAT) pari_err_TYPE("rnfidealabstorel",x);
572 315 : N = lg(x)-1;
573 315 : if (N != rnf_get_absdegree(rnf))
574 : {
575 196 : if (!N) return rnfideal0();
576 105 : pari_err_DIM("rnfidealabstorel");
577 : }
578 119 : n = rnf_get_degree(rnf);
579 119 : A = cgetg(N+1,t_MAT);
580 119 : I = cgetg(N+1,t_VEC);
581 833 : for (j=1; j<=N; j++)
582 : {
583 714 : GEN t = lift_shallow( rnfeltabstorel(rnf, gel(x,j)) );
584 714 : if (typ(t) == t_POL)
585 595 : t = RgM_RgX_mul(invbas, t);
586 : else
587 119 : t = scalarcol_shallow(t, n);
588 714 : gel(A,j) = t;
589 714 : gel(I,j) = gen_1;
590 : }
591 119 : return gerepileupto(av, nfhnf(rnf_get_nf(rnf), mkvec2(A,I)));
592 : }
593 :
594 : GEN
595 217 : rnfidealdown(GEN rnf,GEN x)
596 : {
597 217 : pari_sp av = avma;
598 : GEN I;
599 217 : if (typ(x) == t_MAT)
600 : {
601 : GEN d;
602 28 : x = Q_remove_denom(x,&d);
603 28 : if (RgM_is_ZM(x))
604 : {
605 28 : GEN NF = obj_check(rnf,rnf_NFABS);
606 28 : if (NF)
607 : {
608 28 : GEN z, proj = obj_check(rnf,rnf_MAPS), ZK = gel(proj,1);
609 : long i, lz, l;
610 28 : x = idealhnf(NF,x);
611 42 : if (lg(x) == 1) { avma = av; return cgetg(1,t_MAT); }
612 14 : z = ZM_lll(shallowconcat(ZK,x), 0.99, LLL_KER);
613 14 : lz = lg(z); l = lg(ZK);
614 14 : for (i = 1; i < lz; i++) setlg(gel(z,i), l);
615 14 : z = ZM_hnfmodid(z, gcoeff(x,1,1));
616 14 : if (d) z = gdiv(z,d);
617 14 : return gerepileupto(av, z);
618 : }
619 : }
620 : }
621 189 : x = rnfidealhnf(rnf,x); I = gel(x,2);
622 126 : if (lg(I) == 1) { avma = av; return cgetg(1,t_MAT); }
623 105 : return gerepilecopy(av, gel(I,1));
624 : }
625 :
626 : /* lift ideal x to the relative extension, returns a Z-basis */
627 : GEN
628 217 : rnfidealup(GEN rnf,GEN x)
629 : {
630 217 : pari_sp av = avma;
631 : long i, n;
632 : GEN nf, bas, bas2, I, x2;
633 :
634 217 : checkrnf(rnf); nf = rnf_get_nf(rnf);
635 217 : n = rnf_get_degree(rnf);
636 217 : bas = rnf_get_zk(rnf); bas2 = gel(bas,2);
637 :
638 217 : (void)idealtyp(&x, &I); /* I is junk */
639 203 : x2 = idealtwoelt(nf,x);
640 98 : I = cgetg(n+1,t_VEC);
641 287 : for (i=1; i<=n; i++)
642 : {
643 189 : GEN c = gel(bas2,i), d;
644 189 : if (typ(c) == t_MAT)
645 : {
646 0 : c = Q_remove_denom(c,&d);
647 0 : c = idealHNF_mul(nf,c,x2);
648 0 : if (d) c = gdiv(c,d);
649 : }
650 : else
651 189 : c = idealmul(nf,c,x);
652 189 : gel(I,i) = c;
653 : }
654 98 : return gerepilecopy(av, modulereltoabs(rnf, mkvec2(gel(bas,1), I)));
655 : }
656 : GEN
657 994 : rnfidealup0(GEN rnf,GEN x, long flag)
658 : {
659 994 : pari_sp av = avma;
660 : GEN NF, nf, proj, d, x2;
661 :
662 994 : if (!flag) return rnfidealup(rnf,x);
663 777 : checkrnf(rnf); nf = rnf_get_nf(rnf);
664 777 : rnfcomplete(rnf);
665 777 : proj = obj_check(rnf,rnf_MAPS);
666 777 : NF = obj_check(rnf,rnf_NFABS);
667 :
668 777 : (void)idealtyp(&x, &d); /* d is junk */
669 777 : x2 = idealtwoelt(nf,x);
670 777 : x2 = Q_remove_denom(x2,&d);
671 777 : gel(x2,2) = ZM_ZC_mul(gel(proj,1),gel(x2,2));
672 777 : x2 = idealhnf_two(NF, x2);
673 777 : if (d) x2 = gdiv(x2,d);
674 777 : return gerepileupto(av, x2);
675 : }
676 :
677 : /* x a relative HNF => vector of 2 generators (relative polmods) */
678 : GEN
679 252 : rnfidealtwoelement(GEN rnf, GEN x)
680 : {
681 252 : pari_sp av = avma;
682 : GEN y, cy, z, NF;
683 :
684 252 : y = rnfidealreltoabs_i(rnf,x);
685 182 : rnfcomplete(rnf);
686 182 : NF = obj_check(rnf,rnf_NFABS);
687 182 : y = matalgtobasis(NF, y); settyp(y, t_MAT);
688 182 : y = Q_primitive_part(y, &cy);
689 182 : y = ZM_hnf(y);
690 182 : if (lg(y) == 1) { avma = av; return mkvec2(gen_0, gen_0); }
691 147 : y = idealtwoelt(NF, y);
692 140 : if (cy) y = RgV_Rg_mul(y, cy);
693 140 : z = gel(y,2);
694 140 : if (typ(z) == t_COL) z = rnfeltabstorel(rnf, nf_to_scalar_or_alg(NF, z));
695 140 : return gerepilecopy(av, mkvec2(gel(y,1), z));
696 : }
697 :
698 : GEN
699 49 : rnfidealmul(GEN rnf,GEN x,GEN y)
700 : {
701 49 : pari_sp av = avma;
702 : GEN nf, z, x1, x2, p1, p2, bas;
703 :
704 49 : y = rnfidealtwoelement(rnf,y);
705 49 : if (isintzero(gel(y,1))) { avma = av; return rnfideal0(); }
706 42 : nf = rnf_get_nf(rnf);
707 42 : bas = rnf_get_zk(rnf);
708 42 : x = rnfidealhnf(rnf,x);
709 42 : x1 = gmodulo(gmul(gel(bas,1), matbasistoalg(nf,gel(x,1))), rnf_get_pol(rnf));
710 42 : x2 = gel(x,2);
711 42 : p1 = gmul(gel(y,1), gel(x,1));
712 42 : p2 = rnfV_to_nfM(rnf, gmul(gel(y,2), x1));
713 42 : z = mkvec2(shallowconcat(p1, p2), shallowconcat(x2, x2));
714 42 : return gerepileupto(av, nfhnf(nf,z));
715 : }
716 :
717 : static GEN
718 35 : rnfidealprimedec_1(GEN rnf, GEN SL, GEN prK)
719 : {
720 35 : GEN v, piL = rnfeltup0(rnf, pr_get_gen(prK), 1);
721 : long i, c, l;
722 35 : if (typ(piL) != t_COL) return SL; /* p inert in K/Q */
723 35 : v = cgetg_copy(SL, &l);
724 70 : for (i = c = 1; i < l; i++)
725 : {
726 35 : GEN P = gel(SL,i);
727 35 : if (ZC_prdvd(piL, P)) gel(v,c++) = P;
728 : }
729 35 : setlg(v, c); return v;
730 : }
731 : GEN
732 35 : rnfidealprimedec(GEN rnf, GEN pr)
733 : {
734 35 : pari_sp av = avma;
735 : GEN p, z, NF, nf, SL;
736 35 : checkrnf(rnf);
737 35 : rnfcomplete(rnf);
738 35 : NF = obj_check(rnf,rnf_NFABS);
739 35 : nf = rnf_get_nf(rnf);
740 35 : if (typ(pr) == t_INT)
741 : {
742 28 : p = pr;
743 28 : pr = NULL;
744 : }
745 : else
746 : {
747 7 : checkprid(pr);
748 7 : p = pr_get_p(pr);
749 : }
750 35 : SL = idealprimedec(NF, p);
751 35 : if (pr) z = rnfidealprimedec_1(rnf, SL, pr);
752 : else
753 : {
754 28 : GEN vK = idealprimedec(nf, p), vL;
755 28 : long l = lg(vK), i;
756 28 : vL = cgetg(l, t_VEC);
757 28 : for (i = 1; i < l; i++) gel(vL,i) = rnfidealprimedec_1(rnf, SL, gel(vK,i));
758 28 : z = mkvec2(vK, vL);
759 : }
760 35 : return gerepilecopy(av, z);
761 : }
762 :
763 : GEN
764 35 : rnfidealfactor(GEN rnf, GEN x)
765 : {
766 35 : pari_sp av = avma;
767 : GEN NF;
768 35 : checkrnf(rnf);
769 35 : rnfcomplete(rnf);
770 35 : NF = obj_check(rnf,rnf_NFABS);
771 35 : return gerepileupto(av, idealfactor(NF, rnfidealreltoabs0(rnf, x, 1)));
772 : }
773 :
774 : GEN
775 1421 : rnfequationall(GEN A, GEN B, long *pk, GEN *pLPRS)
776 : {
777 : long lA, lB;
778 : GEN nf, C;
779 :
780 1421 : A = get_nfpol(A, &nf); lA = lg(A);
781 1421 : if (!nf) {
782 273 : if (lA<=3) pari_err_CONSTPOL("rnfequation");
783 273 : RgX_check_ZX(A,"rnfequation");
784 : }
785 1421 : B = RgX_nffix("rnfequation", A,B,1); lB = lg(B);
786 1421 : if (lB<=3) pari_err_CONSTPOL("rnfequation");
787 1421 : B = Q_primpart(B);
788 :
789 1421 : if (!nfissquarefree(A,B))
790 0 : pari_err_DOMAIN("rnfequation","issquarefree(B)","=",gen_0,B);
791 :
792 1421 : *pk = 0; C = ZX_ZXY_resultant_all(A, B, pk, pLPRS);
793 1421 : if (gsigne(leading_coeff(C)) < 0) C = RgX_neg(C);
794 1421 : *pk = -*pk; return Q_primpart(C);
795 : }
796 :
797 : GEN
798 1372 : rnfequation0(GEN A, GEN B, long flall)
799 : {
800 1372 : pari_sp av = avma;
801 : GEN LPRS, C;
802 : long k;
803 :
804 1372 : C = rnfequationall(A, B, &k, flall? &LPRS: NULL);
805 1372 : if (flall)
806 : { /* a,b,c root of A,B,C = compositum, c = b + k a */
807 1253 : GEN a, mH0 = RgX_neg(gel(LPRS,1)), H1 = gel(LPRS,2);
808 1253 : a = RgXQ_mul(mH0, QXQ_inv(H1, C), C);
809 1253 : C = mkvec3(C, mkpolmod(a, C), stoi(k));
810 : }
811 1372 : return gerepilecopy(av, C);
812 : }
813 : GEN
814 105 : rnfequation(GEN nf, GEN pol) { return rnfequation0(nf,pol,0); }
815 : GEN
816 1141 : rnfequation2(GEN nf, GEN pol) { return rnfequation0(nf,pol,1); }
817 : GEN
818 1127 : nf_rnfeq(GEN nf, GEN relpol)
819 : {
820 : GEN pol, a, k, junk, eq;
821 1127 : relpol = liftpol_shallow(relpol);
822 1127 : eq = rnfequation2(nf, relpol);
823 1127 : pol = gel(eq,1);
824 1127 : a = gel(eq,2); if (typ(a) == t_POLMOD) a = gel(a,2);
825 1127 : k = gel(eq,3);
826 1127 : return mkvec5(pol,a,k,get_nfpol(nf, &junk),relpol);
827 : }
828 : /* only allow abstorel */
829 : GEN
830 14 : nf_rnfeqsimple(GEN nf, GEN relpol)
831 : {
832 : long sa;
833 14 : GEN junk, pol = rnfequationall(nf, relpol, &sa, NULL);
834 14 : return mkvec5(pol,gen_0/*dummy*/,stoi(sa),get_nfpol(nf, &junk),relpol);
835 : }
836 :
837 : /*******************************************************************/
838 : /* */
839 : /* RELATIVE LLL */
840 : /* */
841 : /*******************************************************************/
842 : static GEN
843 196 : nftau(long r1, GEN x)
844 : {
845 196 : long i, l = lg(x);
846 196 : GEN s = r1? gel(x,1): gmul2n(real_i(gel(x,1)),1);
847 196 : for (i=2; i<=r1; i++) s = gadd(s, gel(x,i));
848 196 : for ( ; i < l; i++) s = gadd(s, gmul2n(real_i(gel(x,i)),1));
849 196 : return s;
850 : }
851 :
852 : static GEN
853 28 : initmat(long l)
854 : {
855 28 : GEN x = cgetg(l, t_MAT);
856 : long i;
857 28 : for (i = 1; i < l; i++) gel(x,i) = cgetg(l, t_COL);
858 28 : return x;
859 : }
860 :
861 : static GEN
862 1022 : nftocomplex(GEN nf, GEN x)
863 : {
864 1022 : GEN M = nf_get_M(nf);
865 1022 : x = nf_to_scalar_or_basis(nf,x);
866 1022 : if (typ(x) != t_COL) return const_col(nbrows(M), x);
867 161 : return RgM_RgC_mul(M, x);
868 : }
869 : /* assume x a square t_MAT, return a t_VEC of embeddings of its columns */
870 : static GEN
871 14 : mattocomplex(GEN nf, GEN x)
872 : {
873 14 : long i,j, l = lg(x);
874 14 : GEN v = cgetg(l, t_VEC);
875 98 : for (j=1; j<l; j++)
876 : {
877 84 : GEN c = gel(x,j), b = cgetg(l, t_MAT);
878 84 : for (i=1; i<l; i++) gel(b,i) = nftocomplex(nf, gel(c,i));
879 84 : b = shallowtrans(b); settyp(b, t_COL);
880 84 : gel(v,j) = b;
881 : }
882 14 : return v;
883 : }
884 :
885 : static GEN
886 14 : nf_all_roots(GEN nf, GEN x, long prec)
887 : {
888 14 : long i, j, l = lg(x), ru = lg(nf_get_roots(nf));
889 14 : GEN y = cgetg(l, t_POL), v, z;
890 :
891 14 : x = RgX_to_nfX(nf, x);
892 14 : y[1] = x[1];
893 14 : for (i=2; i<l; i++) gel(y,i) = nftocomplex(nf, gel(x,i));
894 14 : i = gprecision(y); if (i && i <= 3) return NULL;
895 :
896 14 : v = cgetg(ru, t_VEC);
897 14 : z = cgetg(l, t_POL); z[1] = x[1];
898 42 : for (i=1; i<ru; i++)
899 : {
900 28 : for (j = 2; j < l; j++) gel(z,j) = gmael(y,j,i);
901 28 : gel(v,i) = cleanroots(z, prec);
902 : }
903 14 : return v;
904 : }
905 :
906 : static GEN
907 357 : rnfscal(GEN m, GEN x, GEN y)
908 : {
909 357 : long i, l = lg(m);
910 357 : GEN z = cgetg(l, t_COL);
911 1071 : for (i = 1; i < l; i++)
912 714 : gel(z,i) = gmul(gconj(shallowtrans(gel(x,i))), gmul(gel(m,i), gel(y,i)));
913 357 : return z;
914 : }
915 :
916 : /* x ideal in HNF */
917 : static GEN
918 364 : findmin(GEN nf, GEN x, GEN muf)
919 : {
920 364 : pari_sp av = avma;
921 : long e;
922 364 : GEN cx, y, m, M = nf_get_M(nf);
923 :
924 364 : x = Q_primitive_part(x, &cx);
925 364 : if (gequal1(gcoeff(x,1,1))) y = M;
926 : else
927 : {
928 210 : GEN G = nf_get_G(nf);
929 210 : m = lllfp(RgM_mul(G,x), 0.75, 0);
930 210 : if (typ(m) != t_MAT)
931 : {
932 0 : x = ZM_lll(x, 0.75, LLL_INPLACE);
933 0 : m = lllfp(RgM_mul(G,x), 0.75, 0);
934 0 : if (typ(m) != t_MAT) pari_err_PREC("rnflllgram");
935 : }
936 210 : x = ZM_mul(x, m);
937 210 : y = RgM_mul(M, x);
938 : }
939 364 : m = RgM_solve_realimag(y, muf);
940 364 : if (!m) return NULL; /* precision problem */
941 364 : if (cx) m = RgC_Rg_div(m, cx);
942 364 : m = grndtoi(m, &e);
943 364 : if (e >= 0) return NULL; /* precision problem */
944 364 : m = ZM_ZC_mul(x, m);
945 364 : if (cx) m = RgC_Rg_mul(m, cx);
946 364 : return gerepileupto(av, m);
947 : }
948 :
949 : static int
950 364 : RED(long k, long l, GEN U, GEN mu, GEN MC, GEN nf, GEN I, GEN *Ik_inv)
951 : {
952 : GEN x, xc, ideal;
953 : long i;
954 :
955 364 : if (!*Ik_inv) *Ik_inv = idealinv(nf, gel(I,k));
956 364 : ideal = idealmul(nf,gel(I,l), *Ik_inv);
957 364 : x = findmin(nf, ideal, gcoeff(mu,k,l));
958 364 : if (!x) return 0;
959 364 : if (gequal0(x)) return 1;
960 :
961 294 : xc = nftocomplex(nf,x);
962 294 : gel(MC,k) = gsub(gel(MC,k), vecmul(xc,gel(MC,l)));
963 294 : gel(U,k) = gsub(gel(U,k), gmul(coltoalg(nf,x), gel(U,l)));
964 294 : gcoeff(mu,k,l) = gsub(gcoeff(mu,k,l), xc);
965 1029 : for (i=1; i<l; i++)
966 735 : gcoeff(mu,k,i) = gsub(gcoeff(mu,k,i), vecmul(xc,gcoeff(mu,l,i)));
967 294 : return 1;
968 : }
969 :
970 : static int
971 84 : check_0(GEN B)
972 : {
973 84 : long i, l = lg(B);
974 252 : for (i = 1; i < l; i++)
975 168 : if (gsigne(gel(B,i)) <= 0) return 1;
976 84 : return 0;
977 : }
978 :
979 : static int
980 98 : do_SWAP(GEN I, GEN MC, GEN MCS, GEN h, GEN mu, GEN B, long kmax, long k,
981 : const long alpha, long r1)
982 : {
983 : GEN p1, p2, muf, mufc, Bf, temp;
984 : long i, j;
985 :
986 196 : p1 = nftau(r1, gadd(gel(B,k),
987 196 : gmul(gnorml2(gcoeff(mu,k,k-1)), gel(B,k-1))));
988 98 : p2 = nftau(r1, gel(B,k-1));
989 98 : if (gcmp(gmulsg(alpha,p1), gmulsg(alpha-1,p2)) > 0) return 0;
990 :
991 14 : swap(gel(MC,k-1),gel(MC,k));
992 14 : swap(gel(h,k-1), gel(h,k));
993 14 : swap(gel(I,k-1), gel(I,k));
994 14 : for (j=1; j<=k-2; j++) swap(gcoeff(mu,k-1,j),gcoeff(mu,k,j));
995 14 : muf = gcoeff(mu,k,k-1);
996 14 : mufc = gconj(muf);
997 14 : Bf = gadd(gel(B,k), vecmul(real_i(vecmul(muf,mufc)), gel(B,k-1)));
998 14 : if (check_0(Bf)) return 1; /* precision problem */
999 :
1000 14 : p1 = vecdiv(gel(B,k-1),Bf);
1001 14 : gcoeff(mu,k,k-1) = vecmul(mufc,p1);
1002 14 : temp = gel(MCS,k-1);
1003 14 : gel(MCS,k-1) = gadd(gel(MCS,k), vecmul(muf,gel(MCS,k-1)));
1004 42 : gel(MCS,k) = gsub(vecmul(vecdiv(gel(B,k),Bf), temp),
1005 28 : vecmul(gcoeff(mu,k,k-1), gel(MCS,k)));
1006 14 : gel(B,k) = vecmul(gel(B,k),p1);
1007 14 : gel(B,k-1) = Bf;
1008 14 : for (i=k+1; i<=kmax; i++)
1009 : {
1010 0 : temp = gcoeff(mu,i,k);
1011 0 : gcoeff(mu,i,k) = gsub(gcoeff(mu,i,k-1), vecmul(muf, gcoeff(mu,i,k)));
1012 0 : gcoeff(mu,i,k-1) = gadd(temp, vecmul(gcoeff(mu,k,k-1),gcoeff(mu,i,k)));
1013 : }
1014 14 : return 1;
1015 : }
1016 :
1017 : static GEN
1018 14 : rel_T2(GEN nf, GEN pol, long lx, long prec)
1019 : {
1020 : long ru, i, j, k, l;
1021 : GEN T2, s, unro, roorder, powreorder;
1022 :
1023 14 : roorder = nf_all_roots(nf, pol, prec);
1024 14 : if (!roorder) return NULL;
1025 14 : ru = lg(roorder);
1026 14 : unro = cgetg(lx,t_COL); for (i=1; i<lx; i++) gel(unro,i) = gen_1;
1027 14 : powreorder = cgetg(lx,t_MAT); gel(powreorder,1) = unro;
1028 14 : T2 = cgetg(ru, t_VEC);
1029 42 : for (i = 1; i < ru; i++)
1030 : {
1031 28 : GEN ro = gel(roorder,i);
1032 28 : GEN m = initmat(lx);
1033 168 : for (k=2; k<lx; k++)
1034 : {
1035 140 : GEN c = cgetg(lx, t_COL); gel(powreorder,k) = c;
1036 1232 : for (j=1; j < lx; j++)
1037 1092 : gel(c,j) = gmul(gel(ro,j), gmael(powreorder,k-1,j));
1038 : }
1039 196 : for (l = 1; l < lx; l++)
1040 882 : for (k = 1; k <= l; k++)
1041 : {
1042 714 : s = gen_0;
1043 6636 : for (j = 1; j < lx; j++)
1044 5922 : s = gadd(s, gmul(gconj(gmael(powreorder,k,j)),
1045 5922 : gmael(powreorder,l,j)));
1046 714 : if (l == k)
1047 168 : gcoeff(m, l, l) = real_i(s);
1048 : else
1049 : {
1050 546 : gcoeff(m, k, l) = s;
1051 546 : gcoeff(m, l, k) = gconj(s);
1052 : }
1053 : }
1054 28 : gel(T2,i) = m;
1055 : }
1056 14 : return T2;
1057 : }
1058 :
1059 : /* given a base field nf (e.g main variable y), a polynomial pol with
1060 : * coefficients in nf (e.g main variable x), and an order as output
1061 : * by rnfpseudobasis, outputs a reduced order. */
1062 : GEN
1063 14 : rnflllgram(GEN nf, GEN pol, GEN order,long prec)
1064 : {
1065 14 : pari_sp av = avma;
1066 14 : long j, k, l, kmax, r1, lx, count = 0;
1067 : GEN M, I, h, H, mth, MC, MPOL, MCS, B, mu;
1068 14 : const long alpha = 10, MAX_COUNT = 4;
1069 :
1070 14 : nf = checknf(nf); r1 = nf_get_r1(nf);
1071 14 : check_ZKmodule(order, "rnflllgram");
1072 14 : M = gel(order,1);
1073 14 : I = gel(order,2); lx = lg(I);
1074 14 : if (lx < 3) return gcopy(order);
1075 14 : if (lx-1 != degpol(pol)) pari_err_DIM("rnflllgram");
1076 14 : I = leafcopy(I);
1077 14 : H = NULL;
1078 14 : MPOL = matbasistoalg(nf, M);
1079 14 : MCS = matid(lx-1); /* dummy for gerepile */
1080 : PRECNF:
1081 14 : if (count == MAX_COUNT)
1082 : {
1083 0 : prec = precdbl(prec); count = 0;
1084 0 : if (DEBUGLEVEL) pari_warn(warnprec,"rnflllgram",prec);
1085 0 : nf = nfnewprec_shallow(nf,prec);
1086 : }
1087 14 : mth = rel_T2(nf, pol, lx, prec);
1088 14 : if (!mth) { count = MAX_COUNT; goto PRECNF; }
1089 14 : h = NULL;
1090 : PRECPB:
1091 14 : if (h)
1092 : { /* precision problem, recompute. If no progress, increase nf precision */
1093 0 : if (++count == MAX_COUNT || RgM_isidentity(h)) {count = MAX_COUNT; goto PRECNF;}
1094 0 : H = H? gmul(H, h): h;
1095 0 : MPOL = gmul(MPOL, h);
1096 : }
1097 14 : h = matid(lx-1);
1098 14 : MC = mattocomplex(nf, MPOL);
1099 14 : mu = cgetg(lx,t_MAT);
1100 14 : B = cgetg(lx,t_COL);
1101 98 : for (j=1; j<lx; j++)
1102 : {
1103 84 : gel(mu,j) = zerocol(lx - 1);
1104 84 : gel(B,j) = gen_0;
1105 : }
1106 14 : if (DEBUGLEVEL) err_printf("k = ");
1107 14 : gel(B,1) = real_i(rnfscal(mth,gel(MC,1),gel(MC,1)));
1108 14 : gel(MCS,1) = gel(MC,1);
1109 14 : kmax = 1; k = 2;
1110 : do
1111 : {
1112 98 : GEN Ik_inv = NULL;
1113 98 : if (DEBUGLEVEL) err_printf("%ld ",k);
1114 98 : if (k > kmax)
1115 : { /* Incremental Gram-Schmidt */
1116 70 : kmax = k; gel(MCS,k) = gel(MC,k);
1117 343 : for (j=1; j<k; j++)
1118 : {
1119 546 : gcoeff(mu,k,j) = vecdiv(rnfscal(mth,gel(MCS,j),gel(MC,k)),
1120 273 : gel(B,j));
1121 273 : gel(MCS,k) = gsub(gel(MCS,k), vecmul(gcoeff(mu,k,j),gel(MCS,j)));
1122 : }
1123 70 : gel(B,k) = real_i(rnfscal(mth,gel(MCS,k),gel(MCS,k)));
1124 70 : if (check_0(gel(B,k))) goto PRECPB;
1125 : }
1126 98 : if (!RED(k, k-1, h, mu, MC, nf, I, &Ik_inv)) goto PRECPB;
1127 98 : if (do_SWAP(I,MC,MCS,h,mu,B,kmax,k,alpha, r1))
1128 : {
1129 14 : if (!B[k]) goto PRECPB;
1130 14 : if (k > 2) k--;
1131 : }
1132 : else
1133 : {
1134 350 : for (l=k-2; l; l--)
1135 266 : if (!RED(k, l, h, mu, MC, nf, I, &Ik_inv)) goto PRECPB;
1136 84 : k++;
1137 : }
1138 98 : if (gc_needed(av,2))
1139 : {
1140 0 : if(DEBUGMEM>1) pari_warn(warnmem,"rnflllgram");
1141 0 : gerepileall(av, H?10:9, &nf,&mth,&h,&MPOL,&B,&MC,&MCS,&mu,&I,&H);
1142 : }
1143 : }
1144 98 : while (k < lx);
1145 14 : MPOL = gmul(MPOL,h);
1146 14 : if (H) h = gmul(H, h);
1147 14 : if (DEBUGLEVEL) err_printf("\n");
1148 14 : MPOL = RgM_to_nfM(nf,MPOL);
1149 14 : h = RgM_to_nfM(nf,h);
1150 14 : return gerepilecopy(av, mkvec2(mkvec2(MPOL,I), h));
1151 : }
1152 :
1153 : GEN
1154 7 : rnfpolred(GEN nf, GEN pol, long prec)
1155 : {
1156 7 : pari_sp av = avma;
1157 7 : long i, j, n, v = varn(pol);
1158 : GEN id, w, I, O, bnf, nfpol;
1159 :
1160 7 : if (typ(pol)!=t_POL) pari_err_TYPE("rnfpolred",pol);
1161 7 : bnf = nf; nf = checknf(bnf);
1162 7 : bnf = (nf == bnf)? NULL: checkbnf(bnf);
1163 7 : if (degpol(pol) <= 1) { w = cgetg(2, t_VEC); gel(w,1) = pol_x(v); return w; }
1164 7 : nfpol = nf_get_pol(nf);
1165 :
1166 7 : id = rnfpseudobasis(nf,pol);
1167 7 : if (bnf && is_pm1( bnf_get_no(bnf) )) /* if bnf is principal */
1168 : {
1169 : GEN newI, newO;
1170 0 : O = gel(id,1);
1171 0 : I = gel(id,2); n = lg(I)-1;
1172 0 : newI = cgetg(n+1,t_VEC);
1173 0 : newO = cgetg(n+1,t_MAT);
1174 0 : for (j=1; j<=n; j++)
1175 : {
1176 0 : GEN al = gen_if_principal(bnf,gel(I,j));
1177 0 : gel(newI,j) = gen_1;
1178 0 : gel(newO,j) = nfC_nf_mul(nf, gel(O,j), al);
1179 : }
1180 0 : id = mkvec2(newO, newI);
1181 : }
1182 :
1183 7 : id = gel(rnflllgram(nf,pol,id,prec),1);
1184 7 : O = gel(id,1);
1185 7 : I = gel(id,2); n = lg(I)-1;
1186 7 : w = cgetg(n+1,t_VEC);
1187 7 : pol = lift_shallow(pol);
1188 70 : for (j=1; j<=n; j++)
1189 : {
1190 63 : GEN newpol, L, a, Ij = gel(I,j);
1191 63 : a = RgC_Rg_mul(gel(O,j), (typ(Ij) == t_MAT)? gcoeff(Ij,1,1): Ij);
1192 63 : for (i=n; i; i--) gel(a,i) = nf_to_scalar_or_alg(nf, gel(a,i));
1193 63 : a = RgV_to_RgX(a, v);
1194 63 : newpol = RgXQX_red(RgXQ_charpoly(a, pol, v), nfpol);
1195 63 : newpol = Q_primpart(newpol);
1196 :
1197 63 : (void)nfgcd_all(newpol, RgX_deriv(newpol), nfpol, nf_get_index(nf), &newpol);
1198 63 : L = leading_coeff(newpol);
1199 133 : gel(w,j) = (typ(L) == t_POL)? RgXQX_div(newpol, L, nfpol)
1200 70 : : RgX_Rg_div(newpol, L);
1201 : }
1202 7 : return gerepilecopy(av,w);
1203 : }
1204 :
1205 : /*******************************************************************/
1206 : /* */
1207 : /* LINEAR ALGEBRA OVER Z_K (HNF,SNF) */
1208 : /* */
1209 : /*******************************************************************/
1210 : /* A torsion-free module M over Z_K is given by [A,I].
1211 : * I=[a_1,...,a_k] is a row vector of k fractional ideals given in HNF.
1212 : * A is an n x k matrix (same k) such that if A_j is the j-th column of A then
1213 : * M=a_1 A_1+...+a_k A_k. We say that [A,I] is a pseudo-basis if k=n */
1214 :
1215 : /* Given an element x and an ideal I in HNF, gives an r such that x-r is in H
1216 : * and r is small */
1217 : GEN
1218 7 : nfreduce(GEN nf, GEN x, GEN I)
1219 : {
1220 7 : pari_sp av = avma;
1221 : GEN aI;
1222 7 : x = nf_to_scalar_or_basis(checknf(nf), x);
1223 7 : if (idealtyp(&I,&aI) != id_MAT || lg(I)==1) pari_err_TYPE("nfreduce",I);
1224 7 : if (typ(x) != t_COL) x = scalarcol( gmod(x, gcoeff(I,1,1)), lg(I)-1 );
1225 7 : else x = reducemodinvertible(x, I);
1226 7 : return gerepileupto(av, x);
1227 : }
1228 : /* Given an element x and an ideal in HNF, gives an a in ideal such that
1229 : * x-a is small. No checks */
1230 : static GEN
1231 30506 : element_close(GEN nf, GEN x, GEN ideal)
1232 : {
1233 30506 : pari_sp av = avma;
1234 30506 : GEN y = gcoeff(ideal,1,1);
1235 30506 : x = nf_to_scalar_or_basis(nf, x);
1236 30506 : if (typ(y) == t_INT && is_pm1(y)) return ground(x);
1237 29281 : if (typ(x) == t_COL)
1238 12950 : x = closemodinvertible(x, ideal);
1239 : else
1240 16331 : x = gmul(y, gdivround(x,y));
1241 29281 : return gerepileupto(av, x);
1242 : }
1243 :
1244 : /* A + v B */
1245 : static GEN
1246 115528 : colcomb1(GEN nf, GEN v, GEN A, GEN B)
1247 : {
1248 115528 : if (isintzero(v)) return A;
1249 75873 : return RgC_to_nfC(nf, RgC_add(A, nfC_nf_mul(nf,B,v)));
1250 : }
1251 : /* u A + v B */
1252 : static GEN
1253 98868 : colcomb(GEN nf, GEN u, GEN v, GEN A, GEN B)
1254 : {
1255 98868 : if (isintzero(u)) return nfC_nf_mul(nf,B,v);
1256 85001 : if (u != gen_1) A = nfC_nf_mul(nf,A,u);
1257 85001 : return colcomb1(nf, v, A, B);
1258 : }
1259 :
1260 : /* return m[i,1..lim] * x */
1261 : static GEN
1262 231 : element_mulvecrow(GEN nf, GEN x, GEN m, long i, long lim)
1263 : {
1264 231 : long j, l = minss(lg(m), lim+1);
1265 231 : GEN dx, y = cgetg(l, t_VEC);
1266 231 : x = nf_to_scalar_or_basis(nf, x);
1267 231 : if (typ(x) == t_COL)
1268 : {
1269 91 : x = zk_multable(nf, Q_remove_denom(x, &dx));
1270 350 : for (j=1; j<l; j++)
1271 : {
1272 259 : GEN t = gcoeff(m,i,j);
1273 259 : if (!isintzero(t))
1274 : {
1275 112 : if (typ(t) == t_COL)
1276 28 : t = RgM_RgC_mul(x, t);
1277 : else
1278 84 : t = RgC_Rg_mul(gel(x,1), t);
1279 112 : if (dx) t = gdiv(t, dx);
1280 112 : t = nf_to_scalar_or_basis(nf,t);
1281 : }
1282 259 : gel(y,j) = t;
1283 : }
1284 : }
1285 : else
1286 : {
1287 140 : for (j=1; j<l; j++) gel(y,j) = gmul(x, gcoeff(m,i,j));
1288 : }
1289 231 : return y;
1290 : }
1291 :
1292 : /* u Z[s,] + v Z[t,], limitied to the first lim entries */
1293 : static GEN
1294 154 : rowcomb(GEN nf, GEN u, GEN v, long s, long t, GEN Z, long lim)
1295 : {
1296 : GEN z;
1297 154 : if (gequal0(u))
1298 7 : z = element_mulvecrow(nf,v,Z,t, lim);
1299 : else
1300 : {
1301 147 : z = element_mulvecrow(nf,u,Z,s, lim);
1302 147 : if (!gequal0(v)) z = gadd(z, element_mulvecrow(nf,v,Z,t, lim));
1303 : }
1304 154 : return z;
1305 : }
1306 :
1307 : /* nfbezout(0,b,A,B). Either bB = NULL or b*B */
1308 : static GEN
1309 54180 : zero_nfbezout(GEN nf,GEN bB, GEN b, GEN A,GEN B,GEN *u,GEN *v,GEN *w,GEN *di)
1310 : {
1311 : GEN d;
1312 54180 : if (isint1(b))
1313 : {
1314 52801 : *v = gen_1;
1315 52801 : *w = A;
1316 52801 : d = B;
1317 52801 : *di = idealinv(nf,d);
1318 : }
1319 : else
1320 : {
1321 1379 : *v = nfinv(nf,b);
1322 1379 : *w = idealmul(nf,A,*v);
1323 1379 : d = bB? bB: idealmul(nf,b,B);
1324 1379 : *di = idealHNF_inv(nf,d);
1325 : }
1326 54180 : *u = gen_0; return d;
1327 : }
1328 :
1329 : /* Given elements a,b and ideals A, B, outputs d = a.A+b.B and gives
1330 : * di=d^-1, w=A.B.di, u, v such that au+bv=1 and u in A.di, v in B.di.
1331 : * Assume A, B non-zero, but a or b can be zero (not both) */
1332 : static GEN
1333 58233 : nfbezout(GEN nf,GEN a,GEN b, GEN A,GEN B, GEN *pu,GEN *pv,GEN *pw,GEN *pdi)
1334 : {
1335 : GEN w, u, v, d, di, aA, bB;
1336 :
1337 58233 : if (isintzero(a)) return zero_nfbezout(nf,NULL,b,A,B,pu,pv,pw,pdi);
1338 58233 : if (isintzero(b)) return zero_nfbezout(nf,NULL,a,B,A,pv,pu,pw,pdi);
1339 :
1340 58233 : if (a != gen_1) /* frequently called with a = gen_1 */
1341 : {
1342 36596 : a = nf_to_scalar_or_basis(nf,a);
1343 36596 : if (isint1(a)) a = gen_1;
1344 : }
1345 58233 : aA = (a == gen_1)? idealhnf_shallow(nf,A): idealmul(nf,a,A);
1346 58233 : bB = idealmul(nf,b,B);
1347 58233 : d = idealadd(nf,aA,bB);
1348 58233 : if (gequal(aA, d)) return zero_nfbezout(nf,aA, a,B,A,pv,pu,pw,pdi);
1349 24920 : if (gequal(bB, d)) return zero_nfbezout(nf,bB, b,A,B,pu,pv,pw,pdi);
1350 : /* general case is slow */
1351 4053 : di = idealHNF_inv(nf,d);
1352 4053 : aA = idealmul(nf,aA,di); /* integral */
1353 4053 : bB = idealmul(nf,bB,di); /* integral */
1354 :
1355 4053 : u = idealaddtoone_i(nf, aA, bB);
1356 4053 : w = idealmul(nf,aA,B);
1357 4053 : v = nfdiv(nf, nfsub(nf, gen_1, u), b);
1358 4053 : if (a != gen_1)
1359 : {
1360 1631 : GEN inva = nfinv(nf, a);
1361 1631 : u = nfmul(nf,u,inva);
1362 1631 : w = idealmul(nf, inva, w); /* AB/d */
1363 : }
1364 4053 : *pu = u;
1365 4053 : *pv = v;
1366 4053 : *pw = w;
1367 4053 : *pdi = di; return d;
1368 : }
1369 : /* v a vector of ideals, simplify in place the ones generated by elts of Q */
1370 : static void
1371 8260 : idV_simplify(GEN v)
1372 : {
1373 8260 : long i, l = lg(v);
1374 46613 : for (i = 1; i < l; i++)
1375 : {
1376 38353 : GEN M = gel(v,i);
1377 38353 : if (typ(M)==t_MAT && RgM_isscalar(M,NULL))
1378 11837 : gel(v,i) = Q_abs_shallow(gcoeff(M,1,1));
1379 : }
1380 8260 : }
1381 : /* Given a torsion-free module x outputs a pseudo-basis for x in HNF */
1382 : GEN
1383 6489 : nfhnf0(GEN nf, GEN x, long flag)
1384 : {
1385 : long i, j, def, idef, m, n;
1386 6489 : pari_sp av0 = avma, av;
1387 : GEN y, A, I, J, U;
1388 :
1389 6489 : nf = checknf(nf);
1390 6489 : check_ZKmodule(x, "nfhnf");
1391 6489 : A = gel(x,1); RgM_dimensions(A, &m, &n);
1392 6489 : I = gel(x,2);
1393 6489 : if (!n) {
1394 49 : if (!flag) return gcopy(x);
1395 0 : retmkvec2(gcopy(x), cgetg(1,t_MAT));
1396 : }
1397 6440 : U = flag? matid(n): NULL;
1398 6440 : idef = (n < m)? m-n : 0;
1399 6440 : av = avma;
1400 6440 : A = RgM_to_nfM(nf,A);
1401 6440 : I = leafcopy(I);
1402 6440 : J = zerovec(n); def = n;
1403 35994 : for (i=m; i>idef; i--)
1404 : {
1405 29554 : GEN d, di = NULL;
1406 :
1407 29554 : j=def; while (j>=1 && isintzero(gcoeff(A,i,j))) j--;
1408 29554 : if (!j)
1409 : { /* no pivot on line i */
1410 7 : if (idef) idef--;
1411 7 : continue;
1412 : }
1413 29547 : if (j==def) j--;
1414 : else {
1415 490 : swap(gel(A,j), gel(A,def));
1416 490 : swap(gel(I,j), gel(I,def));
1417 490 : if (U) swap(gel(U,j), gel(U,def));
1418 : }
1419 175840 : for ( ; j; j--)
1420 : {
1421 146293 : GEN a,b, u,v,w, S, T, S0, T0 = gel(A,j);
1422 146293 : b = gel(T0,i); if (isintzero(b)) continue;
1423 :
1424 40978 : S0 = gel(A,def); a = gel(S0,i);
1425 40978 : d = nfbezout(nf, a,b, gel(I,def),gel(I,j), &u,&v,&w,&di);
1426 40978 : S = colcomb(nf, u,v, S0,T0);
1427 40978 : T = colcomb(nf, a,gneg(b), T0,S0);
1428 40978 : gel(A,def) = S; gel(A,j) = T;
1429 40978 : gel(I,def) = d; gel(I,j) = w;
1430 40978 : if (U)
1431 : {
1432 42 : S0 = gel(U,def);
1433 42 : T0 = gel(U,j);
1434 42 : gel(U,def) = colcomb(nf, u,v, S0,T0);
1435 42 : gel(U,j) = colcomb(nf, a,gneg(b), T0,S0);
1436 : }
1437 : }
1438 29547 : y = gcoeff(A,i,def);
1439 29547 : if (!isint1(y))
1440 : {
1441 651 : GEN yi = nfinv(nf,y);
1442 651 : gel(A,def) = nfC_nf_mul(nf, gel(A,def), yi);
1443 651 : gel(I,def) = idealmul(nf, y, gel(I,def));
1444 651 : if (U) gel(U,def) = nfC_nf_mul(nf, gel(U,def), yi);
1445 651 : di = NULL;
1446 : }
1447 29547 : if (!di) di = idealinv(nf,gel(I,def));
1448 29547 : d = gel(I,def);
1449 29547 : gel(J,def) = di;
1450 94626 : for (j=def+1; j<=n; j++)
1451 : {
1452 65079 : GEN mc, c = gcoeff(A,i,j); if (isintzero(c)) continue;
1453 23226 : c = element_close(nf, c, idealmul(nf,d,gel(J,j)));
1454 23226 : mc = gneg(c);
1455 23226 : gel(A,j) = colcomb1(nf, mc, gel(A,j),gel(A,def));
1456 23226 : if (U) gel(U,j) = colcomb1(nf, mc, gel(U,j),gel(U,def));
1457 : }
1458 29547 : def--;
1459 29547 : if (gc_needed(av,2))
1460 : {
1461 0 : if(DEBUGMEM>1) pari_warn(warnmem,"nfhnf, i = %ld", i);
1462 0 : gerepileall(av,U?4:3, &A,&I,&J,&U);
1463 : }
1464 : }
1465 6440 : n -= def;
1466 6440 : A += def; A[0] = evaltyp(t_MAT)|evallg(n+1);
1467 6440 : I += def; I[0] = evaltyp(t_VEC)|evallg(n+1);
1468 6440 : idV_simplify(I);
1469 6440 : x = mkvec2(A,I);
1470 6440 : if (U) x = mkvec2(x,U);
1471 6440 : return gerepilecopy(av0, x);
1472 : }
1473 :
1474 : GEN
1475 6475 : nfhnf(GEN nf, GEN x) { return nfhnf0(nf, x, 0); }
1476 :
1477 : static GEN
1478 0 : RgV_find_denom(GEN x)
1479 : {
1480 0 : long i, l = lg(x);
1481 0 : for (i = 1; i < l; i++)
1482 0 : if (Q_denom(gel(x,i)) != gen_1) return gel(x,i);
1483 0 : return NULL;
1484 : }
1485 : /* A torsion module M over Z_K will be given by a row vector [A,I,J] with
1486 : * three components. I=[b_1,...,b_n] is a row vector of n fractional ideals
1487 : * given in HNF, J=[a_1,...,a_n] is a row vector of n fractional ideals in
1488 : * HNF. A is an nxn matrix (same n) such that if A_j is the j-th column of A
1489 : * and e_n is the canonical basis of K^n, then
1490 : * M=(b_1e_1+...+b_ne_n)/(a_1A_1+...a_nA_n) */
1491 :
1492 : /* x=[A,I,J] a torsion module as above. Output the
1493 : * smith normal form as K=[c_1,...,c_n] such that x = Z_K/c_1+...+Z_K/c_n */
1494 : GEN
1495 21 : nfsnf0(GEN nf, GEN x, long flag)
1496 : {
1497 : long i, j, k, l, n, m;
1498 : pari_sp av;
1499 : GEN z,u,v,w,d,dinv,A,I,J, U,V;
1500 :
1501 21 : nf = checknf(nf);
1502 21 : if (typ(x)!=t_VEC || lg(x)!=4) pari_err_TYPE("nfsnf",x);
1503 21 : A = gel(x,1);
1504 21 : I = gel(x,2);
1505 21 : J = gel(x,3);
1506 21 : if (typ(A)!=t_MAT) pari_err_TYPE("nfsnf",A);
1507 21 : n = lg(A)-1;
1508 21 : if (typ(I)!=t_VEC) pari_err_TYPE("nfsnf",I);
1509 21 : if (typ(J)!=t_VEC) pari_err_TYPE("nfsnf",J);
1510 21 : if (lg(I)!=n+1 || lg(J)!=n+1) pari_err_DIM("nfsnf");
1511 21 : RgM_dimensions(A, &m, &n);
1512 21 : if (!n || n != m) pari_err_IMPL("nfsnf for empty or non square matrices");
1513 :
1514 21 : av = avma;
1515 21 : if (!flag) U = V = NULL;
1516 : else
1517 : {
1518 7 : U = matid(m);
1519 7 : V = matid(n);
1520 : }
1521 21 : A = RgM_to_nfM(nf, A);
1522 21 : I = leafcopy(I);
1523 21 : J = leafcopy(J);
1524 21 : for (i = 1; i <= n; i++) gel(J,i) = idealinv(nf, gel(J,i));
1525 21 : z = zerovec(n);
1526 126 : for (i=n; i>=1; i--)
1527 : {
1528 : GEN Aii, a, b, db;
1529 105 : long c = 0;
1530 238 : for (j=i-1; j>=1; j--)
1531 : {
1532 133 : GEN S, T, S0, T0 = gel(A,j);
1533 133 : b = gel(T0,i); if (gequal0(b)) continue;
1534 :
1535 49 : S0 = gel(A,i); a = gel(S0,i);
1536 49 : d = nfbezout(nf, a,b, gel(J,i),gel(J,j), &u,&v,&w,&dinv);
1537 49 : S = colcomb(nf, u,v, S0,T0);
1538 49 : T = colcomb(nf, a,gneg(b), T0,S0);
1539 49 : gel(A,i) = S; gel(A,j) = T;
1540 49 : gel(J,i) = d; gel(J,j) = w;
1541 49 : if (V)
1542 : {
1543 21 : T0 = gel(V,j);
1544 21 : S0 = gel(V,i);
1545 21 : gel(V,i) = colcomb(nf, u,v, S0,T0);
1546 21 : gel(V,j) = colcomb(nf, a,gneg(b), T0,S0);
1547 : }
1548 : }
1549 238 : for (j=i-1; j>=1; j--)
1550 : {
1551 : GEN ri, rj;
1552 133 : b = gcoeff(A,j,i); if (gequal0(b)) continue;
1553 :
1554 56 : a = gcoeff(A,i,i);
1555 56 : d = nfbezout(nf, a,b, gel(I,i),gel(I,j), &u,&v,&w,&dinv);
1556 56 : ri = rowcomb(nf, u,v, i,j, A, i);
1557 56 : rj = rowcomb(nf, a,gneg(b), j,i, A, i);
1558 210 : for (k=1; k<=i; k++) {
1559 154 : gcoeff(A,j,k) = gel(rj,k);
1560 154 : gcoeff(A,i,k) = gel(ri,k);
1561 : }
1562 56 : if (U)
1563 : {
1564 21 : ri = rowcomb(nf, u,v, i,j, U, m);
1565 21 : rj = rowcomb(nf, a,gneg(b), j,i, U, m);
1566 84 : for (k=1; k<=m; k++) {
1567 63 : gcoeff(U,j,k) = gel(rj,k);
1568 63 : gcoeff(U,i,k) = gel(ri,k);
1569 : }
1570 : }
1571 56 : gel(I,i) = d; gel(I,j) = w; c = 1;
1572 : }
1573 147 : if (c) { i++; continue; }
1574 :
1575 63 : Aii = gcoeff(A,i,i); if (gequal0(Aii)) continue;
1576 63 : gel(J,i) = idealmul(nf, gel(J,i), Aii);
1577 63 : gcoeff(A,i,i) = gen_1;
1578 63 : if (V) gel(V,i) = nfC_nf_mul(nf, gel(V,i), nfinv(nf,Aii));
1579 63 : gel(z,i) = idealmul(nf,gel(J,i),gel(I,i));
1580 63 : b = Q_remove_denom(gel(z,i), &db);
1581 126 : for (k=1; k<i; k++)
1582 168 : for (l=1; l<i; l++)
1583 : {
1584 105 : GEN d, D, p1, p2, p3, Akl = gcoeff(A,k,l);
1585 : long t;
1586 105 : if (gequal0(Akl)) continue;
1587 :
1588 91 : p1 = idealmul(nf,Akl,gel(J,l));
1589 91 : p3 = idealmul(nf, p1, gel(I,k));
1590 91 : if (db) p3 = RgM_Rg_mul(p3, db);
1591 91 : if (RgM_is_ZM(p3) && hnfdivide(b, p3)) continue;
1592 :
1593 : /* find d in D = I[k]/I[i] not in J[i]/(A[k,l] J[l]) */
1594 0 : D = idealdiv(nf,gel(I,k),gel(I,i));
1595 0 : p2 = idealdiv(nf,gel(J,i), p1);
1596 0 : d = RgV_find_denom( RgM_solve(p2, D) );
1597 0 : if (!d) pari_err_BUG("nfsnf");
1598 0 : p1 = element_mulvecrow(nf,d,A,k,i);
1599 0 : for (t=1; t<=i; t++) gcoeff(A,i,t) = gadd(gcoeff(A,i,t),gel(p1,t));
1600 0 : if (U)
1601 : {
1602 0 : p1 = element_mulvecrow(nf,d,U,k,i);
1603 0 : for (t=1; t<=i; t++) gcoeff(U,i,t) = gadd(gcoeff(U,i,t),gel(p1,t));
1604 : }
1605 :
1606 0 : k = i; c = 1; break;
1607 : }
1608 63 : if (gc_needed(av,1))
1609 : {
1610 0 : if(DEBUGMEM>1) pari_warn(warnmem,"nfsnf");
1611 0 : gerepileall(av,U?6:4, &A,&I,&J,&z,&U,&V);
1612 : }
1613 63 : if (c) i++; /* iterate on row/column i */
1614 : }
1615 21 : if (U) z = mkvec3(z,U,V);
1616 21 : return gerepilecopy(av, z);
1617 : }
1618 : GEN
1619 0 : nfsnf(GEN nf, GEN x) { return nfsnf0(nf,x,0); }
1620 :
1621 : /* Given a pseudo-basis x, outputs a multiple of its ideal determinant */
1622 : GEN
1623 14 : nfdetint(GEN nf, GEN x)
1624 : {
1625 : GEN pass,c,v,det1,piv,pivprec,vi,p1,A,I,id,idprod;
1626 14 : long i, j, k, rg, n, m, m1, cm=0, N;
1627 14 : pari_sp av = avma, av1;
1628 :
1629 14 : nf = checknf(nf); N = nf_get_degree(nf);
1630 14 : check_ZKmodule(x, "nfdetint");
1631 14 : A = gel(x,1);
1632 14 : I = gel(x,2);
1633 14 : n = lg(A)-1; if (!n) return gen_1;
1634 :
1635 14 : m1 = lgcols(A); m = m1-1;
1636 14 : id = matid(N);
1637 14 : c = new_chunk(m1); for (k=1; k<=m; k++) c[k] = 0;
1638 14 : piv = pivprec = gen_1;
1639 :
1640 14 : av1 = avma;
1641 14 : det1 = idprod = gen_0; /* dummy for gerepileall */
1642 14 : pass = cgetg(m1,t_MAT);
1643 14 : v = cgetg(m1,t_COL);
1644 49 : for (j=1; j<=m; j++)
1645 : {
1646 35 : gel(pass,j) = zerocol(m);
1647 35 : gel(v,j) = gen_0; /* dummy */
1648 : }
1649 63 : for (rg=0,k=1; k<=n; k++)
1650 : {
1651 49 : long t = 0;
1652 182 : for (i=1; i<=m; i++)
1653 133 : if (!c[i])
1654 : {
1655 77 : vi=nfmul(nf,piv,gcoeff(A,i,k));
1656 287 : for (j=1; j<=m; j++)
1657 210 : if (c[j]) vi=gadd(vi,nfmul(nf,gcoeff(pass,i,j),gcoeff(A,j,k)));
1658 77 : gel(v,i) = vi; if (!t && !gequal0(vi)) t=i;
1659 : }
1660 49 : if (t)
1661 : {
1662 49 : pivprec = piv;
1663 49 : if (rg == m-1)
1664 : {
1665 28 : if (!cm)
1666 : {
1667 14 : cm=1; idprod = id;
1668 49 : for (i=1; i<=m; i++)
1669 35 : if (i!=t)
1670 56 : idprod = (idprod==id)? gel(I,c[i])
1671 35 : : idealmul(nf,idprod,gel(I,c[i]));
1672 : }
1673 28 : p1 = idealmul(nf,gel(v,t),gel(I,k)); c[t]=0;
1674 28 : det1 = (typ(det1)==t_INT)? p1: idealadd(nf,p1,det1);
1675 : }
1676 : else
1677 : {
1678 21 : rg++; piv=gel(v,t); c[t]=k;
1679 77 : for (i=1; i<=m; i++)
1680 56 : if (!c[i])
1681 : {
1682 105 : for (j=1; j<=m; j++)
1683 77 : if (c[j] && j!=t)
1684 : {
1685 14 : p1 = gsub(nfmul(nf,piv,gcoeff(pass,i,j)),
1686 14 : nfmul(nf,gel(v,i),gcoeff(pass,t,j)));
1687 21 : gcoeff(pass,i,j) = rg>1? nfdiv(nf,p1,pivprec)
1688 14 : : p1;
1689 : }
1690 28 : gcoeff(pass,i,t) = gneg(gel(v,i));
1691 : }
1692 : }
1693 : }
1694 49 : if (gc_needed(av1,1))
1695 : {
1696 0 : if(DEBUGMEM>1) pari_warn(warnmem,"nfdetint");
1697 0 : gerepileall(av1,6, &det1,&piv,&pivprec,&pass,&v,&idprod);
1698 : }
1699 : }
1700 14 : if (!cm) { avma = av; return cgetg(1,t_MAT); }
1701 14 : return gerepileupto(av, idealmul(nf,idprod,det1));
1702 : }
1703 :
1704 : /* reduce in place components of x[1..lim] mod D (destroy x). D in HNF */
1705 : static void
1706 15610 : nfcleanmod(GEN nf, GEN x, long lim, GEN D)
1707 : {
1708 : long i;
1709 : GEN DZ, DZ2, dD;
1710 15610 : D = Q_remove_denom(D, &dD);
1711 15610 : if (dD) x = RgC_Rg_mul(x, dD);
1712 15610 : DZ = gcoeff(D,1,1);
1713 15610 : DZ2 = shifti(DZ,-1);
1714 75138 : for (i=1; i<=lim; i++) {
1715 59528 : GEN c = gel(x,i);
1716 59528 : c = nf_to_scalar_or_basis(nf, c);
1717 59528 : switch(typ(c)) /* c = centermod(c, D) */
1718 : {
1719 : case t_INT:
1720 58436 : if (!signe(c)) break;
1721 32802 : c = centermodii(c, DZ, DZ2);
1722 32802 : if (dD) c = Qdivii(c,dD);
1723 32802 : break;
1724 : case t_FRAC: {
1725 21 : GEN dc = gel(c,2), nc = gel(c,1), N = mulii(DZ, dc);
1726 21 : c = centermodii(nc, N, shifti(N,-1));
1727 21 : c = Qdivii(c, dD ? mulii(dc,dD): dc);
1728 21 : break;
1729 : }
1730 : case t_COL: {
1731 : GEN dc;
1732 1071 : c = Q_remove_denom(c, &dc);
1733 1071 : c = ZC_hnfrem(c, dc? ZM_Z_mul(D,dc): D);
1734 1071 : if (ZV_isscalar(c))
1735 : {
1736 49 : c = gel(c,1);
1737 49 : if (dD) c = Qdivii(c,dD);
1738 : }
1739 : else
1740 1022 : if (dD) c = RgC_Rg_div(c, dD);
1741 1071 : break;
1742 : }
1743 : }
1744 59528 : gel(x,i) = c;
1745 : }
1746 15610 : }
1747 :
1748 : GEN
1749 1820 : nfhnfmod(GEN nf, GEN x, GEN detmat)
1750 : {
1751 : long li, co, i, j, def, ldef;
1752 1820 : pari_sp av0=avma, av;
1753 : GEN dA, dI, d0, w, p1, d, u, v, A, I, J, di;
1754 :
1755 1820 : nf = checknf(nf);
1756 1820 : check_ZKmodule(x, "nfhnfmod");
1757 1820 : A = gel(x,1);
1758 1820 : I = gel(x,2);
1759 1820 : co = lg(A); if (co==1) return cgetg(1,t_MAT);
1760 :
1761 1820 : li = lgcols(A);
1762 1820 : if (typ(detmat)!=t_MAT) detmat = idealhnf_shallow(nf, detmat);
1763 1820 : detmat = Q_remove_denom(detmat, NULL);
1764 1820 : RgM_check_ZM(detmat, "nfhnfmod");
1765 :
1766 1820 : av = avma;
1767 1820 : A = RgM_to_nfM(nf, A);
1768 1820 : A = Q_remove_denom(A, &dA);
1769 1820 : I = Q_remove_denom(leafcopy(I), &dI);
1770 1820 : dA = mul_denom(dA,dI);
1771 1820 : if (dA) detmat = ZM_Z_mul(detmat, powiu(dA, minss(li,co)));
1772 :
1773 1820 : def = co; ldef = (li>co)? li-co+1: 1;
1774 10626 : for (i=li-1; i>=ldef; i--)
1775 : {
1776 8806 : def--; j=def; while (j>=1 && isintzero(gcoeff(A,i,j))) j--;
1777 8806 : if (!j) continue;
1778 8806 : if (j==def) j--;
1779 : else {
1780 1379 : swap(gel(A,j), gel(A,def));
1781 1379 : swap(gel(I,j), gel(I,def));
1782 : }
1783 40068 : for ( ; j; j--)
1784 : {
1785 31262 : GEN a, b, S, T, S0, T0 = gel(A,j);
1786 31262 : b = gel(T0,i); if (isintzero(b)) continue;
1787 :
1788 8344 : S0 = gel(A,def); a = gel(S0,i);
1789 8344 : d = nfbezout(nf, a,b, gel(I,def),gel(I,j), &u,&v,&w,&di);
1790 8344 : S = colcomb(nf, u,v, S0,T0);
1791 8344 : T = colcomb(nf, a,gneg(b), T0,S0);
1792 8344 : if (u != gen_0 && v != gen_0) /* already reduced otherwise */
1793 280 : nfcleanmod(nf, S, i, idealmul(nf,detmat,di));
1794 8344 : nfcleanmod(nf, T, i, idealdiv(nf,detmat,w));
1795 8344 : gel(A,def) = S; gel(A,j) = T;
1796 8344 : gel(I,def) = d; gel(I,j) = w;
1797 : }
1798 8806 : if (gc_needed(av,2))
1799 : {
1800 0 : if(DEBUGMEM>1) pari_warn(warnmem,"[1]: nfhnfmod, i = %ld", i);
1801 0 : gerepileall(av,dA? 4: 3, &A,&I,&detmat,&dA);
1802 : }
1803 : }
1804 1820 : def--; d0 = detmat;
1805 1820 : A += def; A[0] = evaltyp(t_MAT)|evallg(li);
1806 1820 : I += def; I[0] = evaltyp(t_VEC)|evallg(li);
1807 1820 : J = cgetg(li,t_VEC);
1808 10626 : for (i=li-1; i>=1; i--)
1809 : {
1810 8806 : GEN b = gcoeff(A,i,i);
1811 8806 : d = nfbezout(nf, gen_1,b, d0,gel(I,i), &u,&v,&w,&di);
1812 8806 : p1 = nfC_nf_mul(nf,gel(A,i),v);
1813 8806 : if (i > 1)
1814 : {
1815 6986 : d0 = idealmul(nf,d0,di);
1816 6986 : nfcleanmod(nf, p1, i, d0);
1817 : }
1818 8806 : gel(A,i) = p1; gel(p1,i) = gen_1;
1819 8806 : gel(I,i) = d;
1820 8806 : gel(J,i) = di;
1821 : }
1822 8806 : for (i=li-2; i>=1; i--)
1823 : {
1824 6986 : d = gel(I,i);
1825 28147 : for (j=i+1; j<li; j++)
1826 : {
1827 21161 : GEN c = gcoeff(A,i,j); if (isintzero(c)) continue;
1828 7280 : c = element_close(nf, c, idealmul(nf,d,gel(J,j)));
1829 7280 : gel(A,j) = colcomb1(nf, gneg(c), gel(A,j),gel(A,i));
1830 : }
1831 6986 : if (gc_needed(av,2))
1832 : {
1833 0 : if(DEBUGMEM>1) pari_warn(warnmem,"[2]: nfhnfmod, i = %ld", i);
1834 0 : gerepileall(av,dA? 4: 3, &A,&I,&J,&dA);
1835 : }
1836 : }
1837 1820 : idV_simplify(I);
1838 1820 : if (dA) I = gdiv(I,dA);
1839 1820 : return gerepilecopy(av0, mkvec2(A, I));
1840 : }
|
