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