Branch data Line data Source code
1 : : /* Copyright (C) 2000 The PARI group.
2 : :
3 : : This file is part of the PARI/GP package.
4 : :
5 : : PARI/GP is free software; you can redistribute it and/or modify it under the
6 : : terms of the GNU General Public License as published by the Free Software
7 : : Foundation. It is distributed in the hope that it will be useful, but WITHOUT
8 : : ANY WARRANTY WHATSOEVER.
9 : :
10 : : Check the License for details. You should have received a copy of it, along
11 : : with the package; see the file 'COPYING'. If not, write to the Free Software
12 : : Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
13 : :
14 : : /*******************************************************************/
15 : : /* */
16 : : /* BASIC NF OPERATIONS */
17 : : /* (continued 2) */
18 : : /* */
19 : : /*******************************************************************/
20 : : #include "pari.h"
21 : : #include "paripriv.h"
22 : :
23 : : /* must return a t_POL */
24 : : GEN
25 : 780 : eltreltoabs(GEN rnfeq, GEN x)
26 : : {
27 : : long i, k, v;
28 : 780 : pari_sp av = avma;
29 : : GEN T, pol, teta, a, s;
30 : :
31 : 780 : pol = gel(rnfeq,1);
32 : 780 : a = gel(rnfeq,2);
33 : 780 : k = itos(gel(rnfeq,3));
34 : 780 : T = gel(rnfeq,4);
35 : :
36 : 780 : v = varn(pol);
37 [ + + ]: 780 : if (varncmp(gvar(x), v) > 0) x = scalarpol(x,v);
38 : 780 : x = RgX_nffix("eltreltoabs", T, x, 1);
39 : : /* Mod(X - k a, pol(X)), a root of the polynomial defining base */
40 : 775 : teta = gadd(pol_x(v), gmulsg(-k,a));
41 : 775 : s = gen_0;
42 [ + + ]: 2120 : for (i=lg(x)-1; i>1; i--)
43 : : {
44 : 1345 : GEN c = gel(x,i);
45 [ + + ]: 1345 : if (typ(c) == t_POL) c = RgX_RgXQ_eval(c, a, pol);
46 : 1345 : s = RgX_rem(gadd(c, gmul(teta,s)), pol);
47 : : }
48 : 775 : return gerepileupto(av, s);
49 : : }
50 : : GEN
51 : 165 : rnfeltreltoabs(GEN rnf,GEN x)
52 : : {
53 : 165 : const char *f = "rnfeltreltoabs";
54 : : GEN pol;
55 : 165 : checkrnf(rnf);
56 : 165 : pol = rnf_get_polabs(rnf);
57 [ + + + + : 165 : switch(typ(x))
+ ]
58 : : {
59 : 10 : case t_INT: return icopy(x);
60 : 10 : case t_FRAC: return gcopy(x);
61 : : case t_POLMOD:
62 [ + + ]: 70 : if (RgX_equal_var(gel(x,1), pol))
63 : : { /* already in 'abs' form, unless possibly if nf = Q */
64 [ + + ]: 25 : if (rnf_get_nfdegree(rnf) == 1)
65 : : {
66 : 10 : GEN y = gel(x,2);
67 : 10 : pari_sp av = avma;
68 : 10 : y = simplify_shallow(liftpol_shallow(y));
69 : 10 : return gerepilecopy(av, mkpolmod(y, pol));
70 : : }
71 : 15 : return gcopy(x);
72 : : }
73 : 45 : x = polmod_nffix(f,rnf,x,0);
74 [ + + ]: 35 : if (typ(x) == t_POLMOD) return rnfeltup(rnf,x);
75 : 30 : retmkpolmod(eltreltoabs(rnf_get_map(rnf), x), RgX_copy(pol));
76 : : case t_POL:
77 [ + + ]: 40 : if (varn(x) == rnf_get_nfvarn(rnf)) return rnfeltup(rnf,x);
78 : 25 : retmkpolmod(eltreltoabs(rnf_get_map(rnf), x), RgX_copy(pol));
79 : : }
80 : 145 : pari_err_TYPE(f,x); return NULL;
81 : : }
82 : :
83 : : GEN
84 : 1445 : eltabstorel_lift(GEN rnfeq, GEN P)
85 : : {
86 : 1445 : GEN k, T = gel(rnfeq,4), relpol = gel(rnfeq,5);
87 [ + + ]: 1445 : if (is_scalar_t(typ(P))) return P;
88 : 1310 : k = gel(rnfeq,3);
89 : 1310 : P = lift_intern(P);
90 [ + + ]: 1310 : if (signe(k)) P = RgXQX_translate(P, deg1pol_shallow(k, gen_0, varn(T)), T);
91 : 1310 : P = RgXQX_rem(P, relpol, T);
92 : 1445 : return QXQX_to_mod_shallow(P, T);
93 : : }
94 : : /* rnfeq = [pol,a,k,T,relpol], P a t_POL or scalar
95 : : * Return Mod(P(x + k Mod(y, T(y))), pol(x)) */
96 : : GEN
97 : 1410 : eltabstorel(GEN rnfeq, GEN P)
98 : : {
99 : 1410 : GEN T = gel(rnfeq,4), relpol = gel(rnfeq,5);
100 : 1410 : return mkpolmod(eltabstorel_lift(rnfeq,P), QXQX_to_mod_shallow(relpol,T));
101 : : }
102 : : GEN
103 : 970 : rnfeltabstorel(GEN rnf,GEN x)
104 : : {
105 : 970 : const char *f = "rnfeltabstorel";
106 : 970 : pari_sp av = avma;
107 : : GEN pol, T, P;
108 : 970 : checkrnf(rnf);
109 : 970 : T = rnf_get_nfpol(rnf);
110 : 970 : P = rnf_get_pol(rnf);
111 [ + + + + : 970 : switch(typ(x))
+ ]
112 : : {
113 : 30 : case t_INT: return icopy(x);
114 : 30 : case t_FRAC: return gcopy(x);
115 : : case t_POLMOD:
116 [ + + ]: 225 : if (RgX_equal_var(P, gel(x,1)))
117 : : {
118 : 50 : x = polmod_nffix(f, rnf, x, 0);
119 : 50 : return gerepilecopy(av, mkpolmod(x,P));
120 : : }
121 [ + + ]: 175 : if (RgX_equal_var(T, gel(x,1))) { x = Rg_nffix(f, T, x, 0); goto END; }
122 : 115 : pol = rnf_get_polabs(rnf);
123 [ + + ]: 115 : if (!RgX_equal_var(pol, gel(x,1))) pari_err_MODULUS(f, gel(x,1),pol);
124 : 85 : x = gel(x,2);
125 [ + + + - ]: 85 : switch(typ(x))
126 : : {
127 : 20 : case t_INT: return icopy(x);
128 : 20 : case t_FRAC: return gcopy(x);
129 : 45 : case t_POL: break;
130 : 0 : default: pari_err_TYPE(f, x);
131 : : }
132 : 45 : break;
133 : : case t_POL:
134 : 545 : pol = rnf_get_polabs(rnf);
135 : 545 : break;
136 : : default:
137 : 140 : pari_err_TYPE(f,x);
138 : 0 : return NULL;
139 : : }
140 [ + + ]: 590 : if (!RgX_is_QX(x)) pari_err_TYPE(f,x);
141 [ + + ]: 535 : if (varn(x) != varn(pol))
142 : : {
143 [ + + ]: 50 : if (varn(x) == varn(T)) { x = Rg_nffix(f,T,x,0); goto END; }
144 : 20 : pari_err_VAR(f, x,pol);
145 : : }
146 [ + + + ]: 485 : switch(lg(x))
147 : : {
148 : 30 : case 2: avma = av; return gen_0;
149 : 50 : case 3: return gerepilecopy(av, gel(x,2));
150 : : }
151 : : END:
152 : 725 : return gerepilecopy(av, eltabstorel(rnf_get_map(rnf), x));
153 : : }
154 : :
155 : :
156 : : /* x a t_VEC of rnf elements in 'alg' form (t_POL). Assume maximal rank or 0 */
157 : : static GEN
158 : 395 : modulereltoabs(GEN rnf, GEN x)
159 : : {
160 : 395 : GEN W=gel(x,1), I=gel(x,2), rnfeq = rnf_get_map(rnf), polabs = gel(rnfeq,1);
161 : 395 : long i, j, k, m, N = lg(W)-1;
162 : : GEN zknf, czknf, M;
163 : :
164 [ + + ]: 395 : if (!N) return cgetg(1, t_VEC);
165 : 360 : rnf_get_nfzk(rnf, &zknf,&czknf);
166 : 360 : m = rnf_get_nfdegree(rnf);
167 : 360 : M = cgetg(N*m+1, t_VEC);
168 [ + + ]: 1110 : for (k=i=1; i<=N; i++)
169 : : {
170 : 760 : GEN c0, cid, w = gel(W,i), id = gel(I,i);
171 : :
172 [ + + ]: 760 : if (lg(id) == 1) continue; /* must be a t_MAT */
173 : 725 : id = Q_primitive_part(id, &cid);
174 : 725 : w = Q_primitive_part(eltreltoabs(rnfeq,w), &c0);
175 : 725 : c0 = mul_content(c0, mul_content(cid,czknf));
176 [ + + ]: 725 : if (typ(id) == t_INT)
177 [ + + ]: 1485 : for (j=1; j<=m; j++)
178 : : {
179 : 1100 : GEN z = RgX_rem(gmul(w, gel(zknf,j)), polabs);
180 [ + - ]: 1100 : if (c0) z = RgX_Rg_mul(z, c0);
181 : 1100 : gel(M,k++) = z;
182 : : }
183 : : else
184 [ + + ]: 1675 : for (j=1; j<=m; j++)
185 : : {
186 : 960 : GEN c, z = Q_primitive_part(RgV_RgC_mul(zknf,gel(id,j)), &c);
187 : 950 : z = RgX_rem(gmul(w, z), polabs);
188 [ + - ]: 950 : c = mul_content(c, c0); if (c) z = RgX_Rg_mul(z, c);
189 : 950 : gel(M,k++) = z;
190 : : }
191 : : }
192 : 385 : setlg(M, k); return M;
193 : : }
194 : :
195 : : /* Z-basis for absolute maximal order, as a t_MAT */
196 : : GEN
197 : 110 : rnf_basM(GEN rnf)
198 : : {
199 : 110 : GEN M, d, pol = rnf_get_polabs(rnf);
200 : 110 : long n = degpol(pol);
201 : : /* t_VEC of t_POL */
202 : 110 : M = Q_remove_denom(modulereltoabs(rnf, rnf_get_zk(rnf)), &d);
203 [ + - ]: 110 : if (d)
204 : : {
205 : 110 : M = ZM_hnfmodall(RgXV_to_RgM(M,n), d, hnf_MODID|hnf_CENTER);
206 : 110 : M = RgM_Rg_div(M, d);
207 : : }
208 : : else
209 : 0 : M = matid(n);
210 : 110 : return M;
211 : : }
212 : :
213 : : /* only fill in nf[1,3,4,7,8,9] */
214 : : static GEN
215 : 95 : makenfabs(GEN rnf)
216 : : {
217 : 95 : GEN nf = rnf_get_nf(rnf), pol = rnf_get_polabs(rnf), NF = zerovec(9);
218 : 95 : GEN M = rnf_basM(rnf);
219 : 95 : gel(NF,1) = pol;
220 : 95 : gel(NF,3) = mulii(powiu(nf_get_disc(nf), rnf_get_degree(rnf)),
221 : : idealnorm(nf, rnf_get_disc(rnf)));
222 : 95 : nf_set_multable(NF, M, NULL);
223 : 95 : gel(NF,4) = get_nfindex(nf_get_zk(NF));
224 : 95 : return NF;
225 : : }
226 : :
227 : : static GEN
228 : 5 : makenorms(GEN rnf)
229 : : {
230 : 5 : GEN f = rnf_get_index(rnf);
231 [ + - ]: 5 : return typ(f) == t_INT? gen_1: RgM_det_triangular(f);
232 : : }
233 : :
234 : : #define NFABS 1
235 : : #define NORMS 2
236 : : GEN
237 : 120 : check_and_build_nfabs(GEN rnf) {
238 : 120 : return obj_checkbuild(rnf, NFABS, &makenfabs);
239 : : }
240 : : GEN
241 : 70 : check_and_build_norms(GEN rnf) {
242 : 70 : return obj_checkbuild(rnf, NORMS, &makenorms);
243 : : }
244 : :
245 : : void
246 : 75 : nf_nfzk(GEN nf, GEN rnfeq, GEN *zknf, GEN *czknf)
247 : : {
248 : 75 : GEN pol = gel(rnfeq,1), a = gel(rnfeq,2);
249 : 75 : GEN zk = QXV_QXQ_eval(nf_get_zk(nf), a, pol);
250 : 75 : *zknf = Q_primitive_part(zk, czknf);
251 [ + + ]: 75 : if (!*czknf) *czknf = gen_1;
252 : 75 : }
253 : :
254 : : GEN
255 : 70 : rnfinit(GEN nf, GEN polrel)
256 : : {
257 : 70 : pari_sp av = avma;
258 : : GEN rnf, bas, D,d,f, B, rnfeq, basnf,cobasnf;
259 : 70 : nf = checknf(nf);
260 : 70 : bas = rnfallbase(nf,&polrel, &D,&d, &f);
261 : 70 : B = matbasistoalg(nf,gel(bas,1));
262 : 70 : gel(bas,1) = lift_if_rational( RgM_to_RgXV(B,varn(polrel)) );
263 : 70 : rnfeq = nf_rnfeq(nf,polrel);
264 : 70 : nf_nfzk(nf, rnfeq, &basnf, &cobasnf);
265 : 70 : rnf = cgetg(13, t_VEC);
266 : 70 : gel(rnf,1) = polrel;
267 : 70 : gel(rnf,2) = mkvec2(basnf, cobasnf);
268 : 70 : gel(rnf,3) = mkvec2(D, d);
269 : 70 : gel(rnf,4) = f;
270 : 70 : gel(rnf,5) = cgetg(1, t_VEC); /* dummy */
271 : 70 : gel(rnf,6) = cgetg(1, t_VEC); /* dummy */
272 : 70 : gel(rnf,7) = bas;
273 : 70 : gel(rnf,8) = lift_if_rational( RgM_inv(B) );
274 : 70 : gel(rnf,9) = cgetg(1,t_VEC); /* dummy */
275 : 70 : gel(rnf,10)= nf;
276 : 70 : gel(rnf,11)= rnfeq;
277 : 70 : gel(rnf,12)= zerovec(2);
278 : 70 : return gerepilecopy(av, rnf);
279 : : }
280 : :
281 : : GEN
282 : 185 : rnfeltup(GEN rnf, GEN x)
283 : : {
284 : 185 : pari_sp av = avma;
285 : : GEN zknf, czknf;
286 : 185 : checkrnf(rnf);
287 [ + + ][ + + ]: 185 : if (typ(x) == t_POLMOD && RgX_equal_var(gel(x,1), rnf_get_polabs(rnf)))
288 : 20 : return gcopy(x);
289 : 165 : rnf_get_nfzk(rnf, &zknf, &czknf);
290 : 165 : x = nfeltup(rnf_get_nf(rnf), x, zknf, czknf);
291 [ + + ]: 80 : if (typ(x) == t_POL) x = mkpolmod(x, rnf_get_polabs(rnf));
292 : 100 : return gerepilecopy(av, x);
293 : : }
294 : :
295 : : GEN
296 : 185 : nfeltup(GEN nf, GEN x, GEN zknf, GEN czknf)
297 : : {
298 : : GEN c;
299 : 185 : x = nf_to_scalar_or_basis(nf, x);
300 [ + + ]: 110 : if (typ(x) != t_COL) return x;
301 : 40 : x = Q_primitive_part(x, &c);
302 [ + + ]: 40 : if (!RgV_is_ZV(x)) pari_err_TYPE("rnfeltup", x);
303 : 30 : c = mul_content(c, czknf);
304 [ + - ]: 30 : x = RgV_RgC_mul(zknf, x); if (c) x = RgX_Rg_mul(x, c);
305 : 100 : return x;
306 : : }
307 : :
308 : : static void
309 : 35 : fail(const char *f, GEN x)
310 : 35 : { pari_err_DOMAIN(f,"element","not in", strtoGENstr("the base field"),x); }
311 : : GEN
312 : 305 : rnfeltdown(GEN rnf,GEN x)
313 : : {
314 : 305 : const char *f = "rnfeltdown";
315 : 305 : pari_sp av = avma;
316 : : GEN z, T;
317 : : long v;
318 : :
319 : 305 : checkrnf(rnf);
320 : 305 : T = rnf_get_nfpol(rnf);
321 : 305 : v = varn(T);
322 [ + + + + : 305 : switch(typ(x))
+ ]
323 : : { /* directly belonging to base field ? */
324 : 80 : case t_INT: return icopy(x);
325 : 25 : case t_FRAC:return gcopy(x);
326 : : case t_POLMOD:
327 [ + + ]: 120 : if (RgX_equal_var(gel(x,1), rnf_get_polabs(rnf))) break;
328 : 90 : x = polmod_nffix(f,rnf,x,0);
329 : : /* x was defined mod the relative polynomial & non constant => fail */
330 [ + + ]: 80 : if (typ(x) == t_POL) fail(f,x);
331 : 65 : return gerepilecopy(av, x);
332 : :
333 : : case t_POL:
334 [ + + ]: 45 : if (varn(x) != v) break;
335 : 15 : x = Rg_nffix(f,T,x,0);
336 : 10 : return gerepilecopy(av, x);
337 : : }
338 : : /* x defined mod the absolute equation */
339 : 95 : z = rnfeltabstorel(rnf,x);
340 [ + + ]: 45 : switch(typ(z))
341 : : {
342 : : case t_INT:
343 : 10 : case t_FRAC: return z;
344 : : }
345 : : /* typ(z) = t_POLMOD, varn of both components is rnf_get_varn(rnf) */
346 : 35 : z = gel(z,2);
347 [ + + ]: 35 : if (typ(z) == t_POL)
348 : : {
349 [ + + ]: 30 : if (lg(z) != 3) fail(f,x);
350 : 10 : z = gel(z,2);
351 : : }
352 : 205 : return gerepilecopy(av, z);
353 : : }
354 : :
355 : : /* vector of rnf elt -> matrix of nf elts */
356 : : static GEN
357 : 330 : rnfV_to_nfM(GEN rnf, GEN x)
358 : : {
359 : 330 : long i, l = lg(x);
360 : 330 : GEN y = cgetg(l, t_MAT);
361 [ + + ]: 990 : for (i = 1; i < l; i++) gel(y,i) = rnfalgtobasis(rnf,gel(x,i));
362 : 330 : return y;
363 : : }
364 : :
365 : : static GEN
366 : 540 : rnfprincipaltohnf(GEN rnf,GEN x)
367 : : {
368 : 540 : pari_sp av = avma;
369 : 540 : GEN bas = rnf_get_zk(rnf), nf = rnf_get_nf(rnf);
370 : 540 : x = rnfbasistoalg(rnf,x);
371 : 300 : x = gmul(x, gmodulo(gel(bas,1), rnf_get_pol(rnf)));
372 : 300 : return gerepileupto(av, nfhnf(nf, mkvec2(rnfV_to_nfM(rnf,x), gel(bas,2))));
373 : : }
374 : :
375 : : /* pseudo-basis for the 0 ideal */
376 : : static GEN
377 : 80 : rnfideal0() { retmkvec2(cgetg(1,t_MAT),cgetg(1,t_VEC)); }
378 : :
379 : : GEN
380 : 930 : rnfidealhnf(GEN rnf, GEN x)
381 : : {
382 : : GEN z, nf, bas;
383 : :
384 : 930 : checkrnf(rnf); nf = rnf_get_nf(rnf);
385 [ + + + + ]: 930 : switch(typ(x))
386 : : {
387 : : case t_INT: case t_FRAC:
388 [ + + ]: 115 : if (isintzero(x)) return rnfideal0();
389 : 75 : bas = rnf_get_zk(rnf); z = cgetg(3,t_VEC);
390 : 75 : gel(z,1) = matid(rnf_get_degree(rnf));
391 : 75 : gel(z,2) = gmul(x, gel(bas,2)); return z;
392 : :
393 : : case t_VEC:
394 [ + + ][ + - ]: 185 : if (lg(x) == 3 && typ(gel(x,1)) == t_MAT) return nfhnf(nf, x);
395 : 100 : return rnfidealabstorel(rnf, x);
396 : :
397 : : case t_POLMOD: case t_POL: case t_COL:
398 : 540 : return rnfprincipaltohnf(rnf,x);
399 : : }
400 : 90 : pari_err_TYPE("rnfidealhnf",x);
401 : 570 : return NULL; /* not reached */
402 : : }
403 : :
404 : : GEN
405 : 495 : prodid(GEN nf, GEN I)
406 : : {
407 : 495 : long i, l = lg(I);
408 : : GEN z;
409 [ + + ]: 495 : if (l == 1) return matid(nf_get_degree(nf));
410 : 490 : z = gel(I,1);
411 [ + + ]: 1080 : for (i=2; i<l; i++) z = idealmul(nf, z, gel(I,i));
412 : 495 : return z;
413 : : }
414 : :
415 : : static GEN
416 : 70 : prodidnorm(GEN nf, GEN I)
417 : : {
418 : 70 : long i, l = lg(I);
419 : : GEN z;
420 [ - + ]: 70 : if (l == 1) return gen_1;
421 : 70 : z = idealnorm(nf, gel(I,1));
422 [ + + ]: 140 : for (i=2; i<l; i++) z = gmul(z, idealnorm(nf, gel(I,i)));
423 : 70 : return z;
424 : : }
425 : :
426 : : GEN
427 : 140 : rnfidealnormrel(GEN rnf, GEN id)
428 : : {
429 : 140 : pari_sp av = avma;
430 : 140 : GEN nf, z = gel(rnfidealhnf(rnf,id), 2);
431 [ + + ]: 80 : if (lg(z) == 1) return cgetg(1, t_MAT);
432 : 65 : nf = rnf_get_nf(rnf); z = prodid(nf, z);
433 : 80 : return gerepileupto(av, idealmul(nf,z, rnf_get_index(rnf)));
434 : : }
435 : :
436 : : GEN
437 : 145 : rnfidealnormabs(GEN rnf, GEN id)
438 : : {
439 : 145 : pari_sp av = avma;
440 : 145 : GEN nf, z = gel(rnfidealhnf(rnf,id), 2);
441 [ + + ]: 85 : if (lg(z) == 1) return gen_0;
442 : 70 : nf = rnf_get_nf(rnf); z = prodidnorm(nf, z);
443 : 85 : return gerepileupto(av, gmul(z, check_and_build_norms(rnf)));
444 : : }
445 : :
446 : : GEN
447 : 325 : rnfidealreltoabs(GEN rnf,GEN x)
448 : : {
449 : 325 : pari_sp av = avma;
450 : : long i, l;
451 : : GEN w;
452 : :
453 : 325 : x = rnfidealhnf(rnf,x);
454 : 205 : w = gel(x,1); l = lg(w); settyp(w, t_VEC);
455 [ + + ]: 550 : for (i=1; i<l; i++) gel(w,i) = lift_intern( rnfbasistoalg(rnf, gel(w,i)) );
456 : 205 : return gerepilecopy(av, modulereltoabs(rnf, x));
457 : : }
458 : :
459 : : GEN
460 : 245 : rnfidealabstorel(GEN rnf, GEN x)
461 : : {
462 : : long N, j;
463 : 245 : pari_sp av = avma;
464 : : GEN A, I, invbas;
465 : :
466 : 245 : checkrnf(rnf);
467 : 245 : invbas = rnf_get_invzk(rnf);
468 [ + + ]: 245 : if (typ(x) != t_VEC) pari_err_TYPE("rnfidealabstorel",x);
469 : 130 : N = lg(x)-1;
470 [ + + ]: 130 : if (N != rnf_get_absdegree(rnf))
471 : : {
472 [ + + ]: 80 : if (!N) return rnfideal0();
473 : 45 : pari_err_DIM("rnfidealabstorel");
474 : : }
475 : 50 : A = cgetg(N+1,t_MAT);
476 : 50 : I = cgetg(N+1,t_VEC);
477 [ + + ]: 350 : for (j=1; j<=N; j++)
478 : : {
479 : 300 : GEN t = lift_intern( rnfeltabstorel(rnf, gel(x,j)) );
480 : 300 : gel(A,j) = mulmat_pol(invbas, t);
481 : 300 : gel(I,j) = gen_1;
482 : : }
483 : 85 : return gerepileupto(av, nfhnf(rnf_get_nf(rnf), mkvec2(A,I)));
484 : : }
485 : :
486 : : GEN
487 : 150 : rnfidealdown(GEN rnf,GEN x)
488 : : {
489 : 150 : pari_sp av = avma;
490 : : GEN I;
491 : 150 : x = rnfidealhnf(rnf,x); I = gel(x,2);
492 [ + + ]: 90 : if (lg(I) == 1) { avma = av; return cgetg(1,t_MAT); }
493 : 90 : return gerepilecopy(av, gel(I,1));
494 : : }
495 : :
496 : : /* lift ideal x to the relative extension, returns a Z-basis */
497 : : GEN
498 : 155 : rnfidealup(GEN rnf,GEN x)
499 : : {
500 : 155 : pari_sp av = avma;
501 : : long i, n;
502 : : GEN nf, bas, bas2, I;
503 : :
504 : 155 : checkrnf(rnf); nf = rnf_get_nf(rnf);
505 : 155 : n = rnf_get_degree(rnf);
506 : 155 : bas = rnf_get_zk(rnf); bas2 = gel(bas,2);
507 : :
508 : 155 : (void)idealtyp(&x, &I); /* I is junk */
509 : 145 : I = cgetg(n+1,t_VEC);
510 [ + + ]: 300 : for (i=1; i<=n; i++) gel(I,i) = idealmul(nf,x,gel(bas2,i));
511 : 80 : return gerepilecopy(av, modulereltoabs(rnf, mkvec2(gel(bas,1), I)));
512 : : }
513 : :
514 : : /* x a relative HNF => vector of 2 generators (relative polmods) */
515 : : GEN
516 : 180 : rnfidealtwoelement(GEN rnf, GEN x)
517 : : {
518 : 180 : pari_sp av = avma;
519 : : GEN y, cy, z, NF;
520 : :
521 : 180 : y = rnfidealreltoabs(rnf,x);
522 : 120 : NF = check_and_build_nfabs(rnf);
523 : 120 : y = matalgtobasis(NF, y); settyp(y, t_MAT);
524 : 120 : y = Q_primitive_part(y, &cy);
525 : 120 : y = ZM_hnf(y);
526 [ + + ]: 120 : if (lg(y) == 1) { avma = av; return mkvec2(gen_0, gen_0); }
527 : 100 : y = idealtwoelt(NF, y);
528 [ + + ]: 95 : if (cy) y = RgV_Rg_mul(y, cy);
529 : 95 : z = rnfeltabstorel(rnf, coltoliftalg(NF, gel(y,2)));
530 : 115 : return gerepilecopy(av, mkvec2(gel(y,1), z));
531 : : }
532 : :
533 : : GEN
534 : 35 : rnfidealmul(GEN rnf,GEN x,GEN y)
535 : : {
536 : 35 : pari_sp av = avma;
537 : : GEN nf, z, x1, x2, p1, p2, bas;
538 : :
539 : 35 : y = rnfidealtwoelement(rnf,y);
540 [ + + ]: 35 : if (isintzero(gel(y,1))) { avma = av; return rnfideal0(); }
541 : 30 : nf = rnf_get_nf(rnf);
542 : 30 : bas = rnf_get_zk(rnf);
543 : 30 : x = rnfidealhnf(rnf,x);
544 : 30 : x1 = gmodulo(gmul(gel(bas,1), matbasistoalg(nf,gel(x,1))), rnf_get_pol(rnf));
545 : 30 : x2 = gel(x,2);
546 : 30 : p1 = gmul(gel(y,1), gel(x,1));
547 : 30 : p2 = rnfV_to_nfM(rnf, gmul(gel(y,2), x1));
548 : 30 : z = mkvec2(shallowconcat(p1, p2), shallowconcat(x2, x2));
549 : 35 : return gerepileupto(av, nfhnf(nf,z));
550 : : }
551 : :
552 : : int
553 : 225 : nfissquarefree(GEN nf, GEN x)
554 : : {
555 : 225 : pari_sp av = avma;
556 : 225 : GEN g, y = RgX_deriv(x);
557 [ + + ]: 225 : if (RgX_is_rational(x))
558 : 70 : g = QX_gcd(x, y);
559 : : else
560 : 155 : g = nfgcd(x, y, nf, NULL);
561 : 225 : avma = av; return (degpol(g) == 0);
562 : : }
563 : :
564 : : GEN
565 : 225 : rnfequationall(GEN A, GEN B, long *pk, GEN *pLPRS)
566 : : {
567 : : long lA, lB;
568 : : GEN nf, C;
569 : :
570 : 225 : A = get_nfpol(A, &nf); lA = lg(A);
571 [ + + ]: 225 : if (!nf) {
572 [ - + ]: 90 : if (lA<=3) pari_err_CONSTPOL("rnfequation");
573 : 90 : RgX_check_ZX(A,"rnfequation");
574 : : }
575 : 225 : B = RgX_nffix("rnfequation", A,B,1); lB = lg(B);
576 [ - + ]: 225 : if (lB<=3) pari_err_CONSTPOL("rnfequation");
577 : 225 : B = Q_primpart(B);
578 : :
579 [ - + ]: 225 : if (!nfissquarefree(A,B))
580 : 0 : pari_err_DOMAIN("rnfequation","issquarefree(B)","=",gen_0,B);
581 : :
582 : 225 : *pk = 0; C = ZX_ZXY_resultant_all(A, B, pk, pLPRS);
583 [ - + ]: 225 : if (gsigne(leading_term(C)) < 0) C = RgX_neg(C);
584 : 225 : *pk = -*pk; return Q_primpart(C);
585 : : }
586 : :
587 : : GEN
588 : 195 : rnfequation0(GEN A, GEN B, long flall)
589 : : {
590 : 195 : pari_sp av = avma;
591 : : GEN LPRS, C;
592 : : long k;
593 : :
594 [ + + ]: 195 : C = rnfequationall(A, B, &k, flall? &LPRS: NULL);
595 [ + + ]: 195 : if (flall)
596 : : { /* a,b,c root of A,B,C = compositum, c = b + k a */
597 : 185 : GEN a, mH0 = RgX_neg(gel(LPRS,1)), H1 = gel(LPRS,2);
598 : 185 : a = RgXQ_mul(mH0, QXQ_inv(H1, C), C);
599 : 185 : C = mkvec3(C, mkpolmod(a, C), stoi(k));
600 : : }
601 : 195 : return gerepilecopy(av, C);
602 : : }
603 : : GEN
604 : 5 : rnfequation(GEN nf, GEN pol) { return rnfequation0(nf,pol,0); }
605 : : GEN
606 : 105 : rnfequation2(GEN nf, GEN pol) { return rnfequation0(nf,pol,1); }
607 : : GEN
608 : 100 : nf_rnfeq(GEN nf, GEN relpol)
609 : : {
610 : : GEN pol, a, k, junk, eq;
611 : 100 : relpol = liftpol_shallow(relpol);
612 : 100 : eq = rnfequation2(nf, relpol);
613 : 100 : pol = gel(eq,1);
614 [ + - ]: 100 : a = gel(eq,2); if (typ(a) == t_POLMOD) a = gel(a,2);
615 : 100 : k = gel(eq,3);
616 : 100 : return mkvec5(pol,a,k,get_nfpol(nf, &junk),relpol);
617 : : }
618 : : /* only allow abstorel */
619 : : GEN
620 : 5 : nf_rnfeqsimple(GEN nf, GEN relpol)
621 : : {
622 : : long sa;
623 : 5 : GEN junk, pol = rnfequationall(nf, relpol, &sa, NULL);
624 : 5 : return mkvec5(pol,gen_0/*dummy*/,stoi(sa),get_nfpol(nf, &junk),relpol);
625 : : }
626 : :
627 : : static GEN
628 : 140 : nftau(long r1, GEN x)
629 : : {
630 : 140 : long i, l = lg(x);
631 [ + - ]: 140 : GEN s = r1? gel(x,1): gmul2n(real_i(gel(x,1)),1);
632 [ + + ]: 280 : for (i=2; i<=r1; i++) s = gadd(s, gel(x,i));
633 [ - + ]: 140 : for ( ; i < l; i++) s = gadd(s, gmul2n(real_i(gel(x,i)),1));
634 : 140 : return s;
635 : : }
636 : :
637 : : static GEN
638 : 20 : initmat(long l)
639 : : {
640 : 20 : GEN x = cgetg(l, t_MAT);
641 : : long i;
642 [ + + ]: 140 : for (i = 1; i < l; i++) gel(x,i) = cgetg(l, t_COL);
643 : 20 : return x;
644 : : }
645 : :
646 : : static GEN
647 : 730 : nftocomplex(GEN nf, GEN x)
648 : : {
649 : 730 : GEN M = nf_get_M(nf);
650 : 730 : x = nf_to_scalar_or_basis(nf,x);
651 [ + + ]: 730 : if (typ(x) != t_COL) return const_col(nbrows(M), x);
652 : 730 : return RgM_RgC_mul(M, x);
653 : : }
654 : : /* assume x a square t_MAT, return a t_VEC of embeddings of its columns */
655 : : static GEN
656 : 10 : mattocomplex(GEN nf, GEN x)
657 : : {
658 : 10 : long i,j, l = lg(x);
659 : 10 : GEN v = cgetg(l, t_VEC);
660 [ + + ]: 70 : for (j=1; j<l; j++)
661 : : {
662 : 60 : GEN c = gel(x,j), b = cgetg(l, t_MAT);
663 [ + + ]: 510 : for (i=1; i<l; i++) gel(b,i) = nftocomplex(nf, gel(c,i));
664 : 60 : b = shallowtrans(b); settyp(b, t_COL);
665 : 60 : gel(v,j) = b;
666 : : }
667 : 10 : return v;
668 : : }
669 : :
670 : : static GEN
671 : 10 : nf_all_roots(GEN nf, GEN x, long prec)
672 : : {
673 : 10 : long i, j, l = lg(x), ru = lg(nf_get_roots(nf));
674 : 10 : GEN y = cgetg(l, t_POL), v, z;
675 : :
676 : 10 : x = RgX_to_nfX(nf, x);
677 : 10 : y[1] = x[1];
678 [ + + ]: 80 : for (i=2; i<l; i++) gel(y,i) = nftocomplex(nf, gel(x,i));
679 [ - + ][ # # ]: 10 : i = gprecision(y); if (i && i <= 3) return NULL;
680 : :
681 : 10 : v = cgetg(ru, t_VEC);
682 : 10 : z = cgetg(l, t_POL); z[1] = x[1];
683 [ + + ]: 30 : for (i=1; i<ru; i++)
684 : : {
685 [ + + ]: 160 : for (j = 2; j < l; j++) gel(z,j) = gmael(y,j,i);
686 : 20 : gel(v,i) = cleanroots(z, prec);
687 : : }
688 : 10 : return v;
689 : : }
690 : :
691 : : static GEN
692 : 255 : rnfscal(GEN m, GEN x, GEN y)
693 : : {
694 : 255 : long i, l = lg(m);
695 : 255 : GEN z = cgetg(l, t_COL);
696 [ + + ]: 765 : for (i = 1; i < l; i++)
697 : 510 : gel(z,i) = gmul(gconj(shallowtrans(gel(x,i))), gmul(gel(m,i), gel(y,i)));
698 : 255 : return z;
699 : : }
700 : :
701 : : /* x ideal in HNF */
702 : : static GEN
703 : 260 : findmin(GEN nf, GEN x, GEN muf)
704 : : {
705 : 260 : pari_sp av = avma;
706 : : long e;
707 : 260 : GEN cx, y, m, M = nf_get_M(nf);
708 : :
709 : 260 : x = Q_primitive_part(x, &cx);
710 [ + + ]: 260 : if (gequal1(gcoeff(x,1,1))) y = M;
711 : : else
712 : : {
713 : 150 : GEN G = nf_get_G(nf);
714 : 150 : m = lllfp(RgM_mul(G,x), 0.75, 0);
715 [ - + ]: 150 : if (typ(m) != t_MAT)
716 : : {
717 : 0 : x = ZM_lll(x, 0.75, LLL_INPLACE);
718 : 0 : m = lllfp(RgM_mul(G,x), 0.75, 0);
719 [ # # ]: 0 : if (typ(m) != t_MAT) pari_err_PREC("rnflllgram");
720 : : }
721 : 150 : x = ZM_mul(x, m);
722 : 150 : y = RgM_mul(M, x);
723 : : }
724 : 260 : m = RgM_solve_realimag(y, muf);
725 [ - + ]: 260 : if (!m) return NULL; /* precision problem */
726 [ + + ]: 260 : if (cx) m = RgC_Rg_div(m, cx);
727 : 260 : m = grndtoi(m, &e);
728 [ - + ]: 260 : if (e >= 0) return NULL; /* precision problem */
729 : 260 : m = ZM_ZC_mul(x, m);
730 [ + + ]: 260 : if (cx) m = RgC_Rg_mul(m, cx);
731 : 260 : return gerepileupto(av, m);
732 : : }
733 : :
734 : : static int
735 : 260 : RED(long k, long l, GEN U, GEN mu, GEN MC, GEN nf, GEN I, GEN *Ik_inv)
736 : : {
737 : : GEN x, xc, ideal;
738 : : long i;
739 : :
740 [ + + ]: 260 : if (!*Ik_inv) *Ik_inv = idealinv(nf, gel(I,k));
741 : 260 : ideal = idealmul(nf,gel(I,l), *Ik_inv);
742 : 260 : x = findmin(nf, ideal, gcoeff(mu,k,l));
743 [ - + ]: 260 : if (!x) return 0;
744 [ + + ]: 260 : if (gequal0(x)) return 1;
745 : :
746 : 210 : xc = nftocomplex(nf,x);
747 : 210 : gel(MC,k) = gsub(gel(MC,k), vecmul(xc,gel(MC,l)));
748 : 210 : gel(U,k) = gsub(gel(U,k), gmul(coltoalg(nf,x), gel(U,l)));
749 : 210 : gcoeff(mu,k,l) = gsub(gcoeff(mu,k,l), xc);
750 [ + + ]: 735 : for (i=1; i<l; i++)
751 : 525 : gcoeff(mu,k,i) = gsub(gcoeff(mu,k,i), vecmul(xc,gcoeff(mu,l,i)));
752 : 260 : return 1;
753 : : }
754 : :
755 : : static int
756 : 60 : check_0(GEN B)
757 : : {
758 : 60 : long i, l = lg(B);
759 [ + + ]: 180 : for (i = 1; i < l; i++)
760 [ - + ]: 120 : if (gsigne(gel(B,i)) <= 0) return 1;
761 : 60 : return 0;
762 : : }
763 : :
764 : : static int
765 : 70 : do_SWAP(GEN I, GEN MC, GEN MCS, GEN h, GEN mu, GEN B, long kmax, long k,
766 : : const long alpha, long r1)
767 : : {
768 : : GEN p1, p2, muf, mufc, Bf, temp;
769 : : long i, j;
770 : :
771 : 70 : p1 = nftau(r1, gadd(gel(B,k),
772 : 140 : gmul(gnorml2(gcoeff(mu,k,k-1)), gel(B,k-1))));
773 : 70 : p2 = nftau(r1, gel(B,k-1));
774 [ + + ]: 70 : if (gcmp(gmulsg(alpha,p1), gmulsg(alpha-1,p2)) > 0) return 0;
775 : :
776 : 10 : swap(gel(MC,k-1),gel(MC,k));
777 : 10 : swap(gel(h,k-1), gel(h,k));
778 : 10 : swap(gel(I,k-1), gel(I,k));
779 [ + + ]: 65 : for (j=1; j<=k-2; j++) swap(gcoeff(mu,k-1,j),gcoeff(mu,k,j));
780 : 10 : muf = gcoeff(mu,k,k-1);
781 : 10 : mufc = gconj(muf);
782 : 10 : Bf = gadd(gel(B,k), vecmul(real_i(vecmul(muf,mufc)), gel(B,k-1)));
783 [ - + ]: 10 : if (check_0(Bf)) return 1; /* precision problem */
784 : :
785 : 10 : p1 = vecdiv(gel(B,k-1),Bf);
786 : 10 : gcoeff(mu,k,k-1) = vecmul(mufc,p1);
787 : 10 : temp = gel(MCS,k-1);
788 : 10 : gel(MCS,k-1) = gadd(gel(MCS,k), vecmul(muf,gel(MCS,k-1)));
789 : 10 : gel(MCS,k) = gsub(vecmul(vecdiv(gel(B,k),Bf), temp),
790 : 20 : vecmul(gcoeff(mu,k,k-1), gel(MCS,k)));
791 : 10 : gel(B,k) = vecmul(gel(B,k),p1);
792 : 10 : gel(B,k-1) = Bf;
793 [ - + ]: 10 : for (i=k+1; i<=kmax; i++)
794 : : {
795 : 0 : temp = gcoeff(mu,i,k);
796 : 0 : gcoeff(mu,i,k) = gsub(gcoeff(mu,i,k-1), vecmul(muf, gcoeff(mu,i,k)));
797 : 0 : gcoeff(mu,i,k-1) = gadd(temp, vecmul(gcoeff(mu,k,k-1),gcoeff(mu,i,k)));
798 : : }
799 : 70 : return 1;
800 : : }
801 : :
802 : : static GEN
803 : 10 : rel_T2(GEN nf, GEN pol, long lx, long prec)
804 : : {
805 : : long ru, i, j, k, l;
806 : : GEN T2, s, unro, roorder, powreorder;
807 : :
808 : 10 : roorder = nf_all_roots(nf, pol, prec);
809 [ - + ]: 10 : if (!roorder) return NULL;
810 : 10 : ru = lg(roorder);
811 [ + + ]: 70 : unro = cgetg(lx,t_COL); for (i=1; i<lx; i++) gel(unro,i) = gen_1;
812 : 10 : powreorder = cgetg(lx,t_MAT); gel(powreorder,1) = unro;
813 : 10 : T2 = cgetg(ru, t_VEC);
814 [ + + ]: 30 : for (i = 1; i < ru; i++)
815 : : {
816 : 20 : GEN ro = gel(roorder,i);
817 : 20 : GEN m = initmat(lx);
818 [ + + ]: 120 : for (k=2; k<lx; k++)
819 : : {
820 : 100 : GEN c = cgetg(lx, t_COL); gel(powreorder,k) = c;
821 [ + + ]: 880 : for (j=1; j < lx; j++)
822 : 780 : gel(c,j) = gmul(gel(ro,j), gmael(powreorder,k-1,j));
823 : : }
824 [ + + ]: 140 : for (l = 1; l < lx; l++)
825 [ + + ]: 630 : for (k = 1; k <= l; k++)
826 : : {
827 : 510 : s = gen_0;
828 [ + + ]: 4740 : for (j = 1; j < lx; j++)
829 : 4230 : s = gadd(s, gmul(gconj(gmael(powreorder,k,j)),
830 : 4230 : gmael(powreorder,l,j)));
831 [ + + ]: 510 : if (l == k)
832 : 120 : gcoeff(m, l, l) = real_i(s);
833 : : else
834 : : {
835 : 390 : gcoeff(m, k, l) = s;
836 : 390 : gcoeff(m, l, k) = gconj(s);
837 : : }
838 : : }
839 : 20 : gel(T2,i) = m;
840 : : }
841 : 10 : return T2;
842 : : }
843 : :
844 : : /* given a base field nf (e.g main variable y), a polynomial pol with
845 : : * coefficients in nf (e.g main variable x), and an order as output
846 : : * by rnfpseudobasis, outputs a reduced order. */
847 : : GEN
848 : 10 : rnflllgram(GEN nf, GEN pol, GEN order,long prec)
849 : : {
850 : 10 : pari_sp av = avma, lim = stack_lim(av,2);
851 : 10 : long j, k, l, kmax, r1, lx, count = 0;
852 : : GEN M, I, h, H, mth, MC, MPOL, MCS, B, mu;
853 : 10 : const long alpha = 10, MAX_COUNT = 4;
854 : :
855 : 10 : nf = checknf(nf); r1 = nf_get_r1(nf);
856 : 10 : check_ZKmodule(order, "rnflllgram");
857 : 10 : M = gel(order,1);
858 : 10 : I = gel(order,2); lx = lg(I);
859 [ - + ]: 10 : if (lx < 3) return gcopy(order);
860 [ - + ]: 10 : if (lx-1 != degpol(pol)) pari_err_DIM("rnflllgram");
861 : 10 : I = leafcopy(I);
862 : 10 : H = NULL;
863 : 10 : MPOL = matbasistoalg(nf, M);
864 : 10 : MCS = matid(lx-1); /* dummy for gerepile */
865 : : PRECNF:
866 [ - + ]: 10 : if (count == MAX_COUNT)
867 : : {
868 : 0 : prec = precdbl(prec); count = 0;
869 [ # # ]: 0 : if (DEBUGLEVEL) pari_warn(warnprec,"rnflllgram",prec);
870 : 0 : nf = nfnewprec_shallow(nf,prec);
871 : : }
872 : 10 : mth = rel_T2(nf, pol, lx, prec);
873 [ - + ]: 10 : if (!mth) { count = MAX_COUNT; goto PRECNF; }
874 : 10 : h = NULL;
875 : : PRECPB:
876 [ - + ]: 10 : if (h)
877 : : { /* precision problem, recompute. If no progress, increase nf precision */
878 [ # # ][ # # ]: 0 : if (++count == MAX_COUNT || RgM_isidentity(h)) {count = MAX_COUNT; goto PRECNF;}
879 [ # # ]: 0 : H = H? gmul(H, h): h;
880 : 0 : MPOL = gmul(MPOL, h);
881 : : }
882 : 10 : h = matid(lx-1);
883 : 10 : MC = mattocomplex(nf, MPOL);
884 : 10 : mu = cgetg(lx,t_MAT);
885 : 10 : B = cgetg(lx,t_COL);
886 [ + + ]: 70 : for (j=1; j<lx; j++)
887 : : {
888 : 60 : gel(mu,j) = zerocol(lx - 1);
889 : 60 : gel(B,j) = gen_0;
890 : : }
891 [ - + ]: 10 : if (DEBUGLEVEL) err_printf("k = ");
892 : 10 : gel(B,1) = real_i(rnfscal(mth,gel(MC,1),gel(MC,1)));
893 : 10 : gel(MCS,1) = gel(MC,1);
894 : 10 : kmax = 1; k = 2;
895 : : do
896 : : {
897 : 70 : GEN Ik_inv = NULL;
898 [ - + ]: 70 : if (DEBUGLEVEL) err_printf("%ld ",k);
899 [ + + ]: 70 : if (k > kmax)
900 : : { /* Incremental Gram-Schmidt */
901 : 50 : kmax = k; gel(MCS,k) = gel(MC,k);
902 [ + + ]: 245 : for (j=1; j<k; j++)
903 : : {
904 : 195 : gcoeff(mu,k,j) = vecdiv(rnfscal(mth,gel(MCS,j),gel(MC,k)),
905 : 195 : gel(B,j));
906 : 195 : gel(MCS,k) = gsub(gel(MCS,k), vecmul(gcoeff(mu,k,j),gel(MCS,j)));
907 : : }
908 : 50 : gel(B,k) = real_i(rnfscal(mth,gel(MCS,k),gel(MCS,k)));
909 [ + - ]: 50 : if (check_0(gel(B,k))) goto PRECPB;
910 : : }
911 [ + - ]: 70 : if (!RED(k, k-1, h, mu, MC, nf, I, &Ik_inv)) goto PRECPB;
912 [ + + ]: 70 : if (do_SWAP(I,MC,MCS,h,mu,B,kmax,k,alpha, r1))
913 : : {
914 [ + - ]: 10 : if (!B[k]) goto PRECPB;
915 [ + - ]: 10 : if (k > 2) k--;
916 : : }
917 : : else
918 : : {
919 [ + + ]: 250 : for (l=k-2; l; l--)
920 [ + - ]: 190 : if (!RED(k, l, h, mu, MC, nf, I, &Ik_inv)) goto PRECPB;
921 : 60 : k++;
922 : : }
923 [ - + ]: 70 : if (low_stack(lim, stack_lim(av,2)))
924 : : {
925 [ # # ]: 0 : if(DEBUGMEM>1) pari_warn(warnmem,"rnflllgram");
926 [ # # ]: 0 : gerepileall(av, H?10:9, &nf,&mth,&h,&MPOL,&B,&MC,&MCS,&mu,&I,&H);
927 : : }
928 : : }
929 [ + + ]: 70 : while (k < lx);
930 : 10 : MPOL = gmul(MPOL,h);
931 [ - + ]: 10 : if (H) h = gmul(H, h);
932 [ - + ]: 10 : if (DEBUGLEVEL) err_printf("\n");
933 : 10 : MPOL = RgM_to_nfM(nf,MPOL);
934 : 10 : h = RgM_to_nfM(nf,h);
935 : 10 : return gerepilecopy(av, mkvec2(mkvec2(MPOL,I), h));
936 : : }
937 : :
938 : : GEN
939 : 5 : rnfpolred(GEN nf, GEN pol, long prec)
940 : : {
941 : 5 : pari_sp av = avma;
942 : 5 : long i, j, n, v = varn(pol);
943 : : GEN id, w, I, O, bnf, nfpol;
944 : :
945 [ - + ]: 5 : if (typ(pol)!=t_POL) pari_err_TYPE("rnfpolred",pol);
946 : 5 : bnf = nf; nf = checknf(bnf);
947 [ - + ]: 5 : bnf = (nf == bnf)? NULL: checkbnf(bnf);
948 [ - + ]: 5 : if (degpol(pol) <= 1) { w = cgetg(2, t_VEC); gel(w,1) = pol_x(v); return w; }
949 : 5 : nfpol = nf_get_pol(nf);
950 : :
951 : 5 : id = rnfpseudobasis(nf,pol);
952 [ - + ][ # # ]: 5 : if (bnf && is_pm1( bnf_get_no(bnf) )) /* if bnf is principal */
953 : : {
954 : : GEN newI, newO;
955 : 0 : O = gel(id,1);
956 : 0 : I = gel(id,2); n = lg(I)-1;
957 : 0 : newI = cgetg(n+1,t_VEC);
958 : 0 : newO = cgetg(n+1,t_MAT);
959 [ # # ]: 0 : for (j=1; j<=n; j++)
960 : : {
961 : 0 : GEN al = gen_if_principal(bnf,gel(I,j));
962 : 0 : gel(newI,j) = gen_1;
963 : 0 : gel(newO,j) = nfC_nf_mul(nf, gel(O,j), al);
964 : : }
965 : 0 : id = mkvec2(newO, newI);
966 : : }
967 : :
968 : 5 : id = gel(rnflllgram(nf,pol,id,prec),1);
969 : 5 : O = gel(id,1);
970 : 5 : I = gel(id,2); n = lg(I)-1;
971 : 5 : w = cgetg(n+1,t_VEC);
972 : 5 : pol = lift(pol);
973 [ + + ]: 50 : for (j=1; j<=n; j++)
974 : : {
975 : 45 : GEN newpol, L, a, Ij = gel(I,j);
976 [ + + ]: 45 : a = RgC_Rg_mul(gel(O,j), (typ(Ij) == t_MAT)? gcoeff(Ij,1,1): Ij);
977 [ + + ]: 450 : for (i=n; i; i--)
978 : : {
979 : 405 : GEN c = gel(a,i);
980 [ + + ]: 405 : if (typ(c) == t_COL) gel(a,i) = coltoliftalg(nf, c);
981 : : }
982 : 45 : a = RgV_to_RgX(a, v);
983 : 45 : newpol = RgXQX_red(RgXQ_charpoly(a, pol, v), nfpol);
984 : 45 : newpol = Q_primpart(newpol);
985 : :
986 : 45 : (void)nfgcd_all(newpol, RgX_deriv(newpol), nfpol, nf_get_index(nf), &newpol);
987 : 45 : L = leading_term(newpol);
988 : 90 : gel(w,j) = (typ(L) == t_POL)? RgXQX_div(newpol, L, nfpol)
989 [ - + ]: 45 : : RgX_Rg_div(newpol, L);
990 : : }
991 : 5 : return gerepilecopy(av,w);
992 : : }
|
