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