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; either version 2 of the License, or (at your option) any later
8 : version. It is distributed in the hope that it will be useful, but WITHOUT
9 : ANY WARRANTY WHATSOEVER.
10 :
11 : Check the License for details. You should have received a copy of it, along
12 : with the package; see the file 'COPYING'. If not, write to the Free Software
13 : Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
14 :
15 : /*******************************************************************/
16 : /* */
17 : /* RNF STRUCTURE AND OPERATIONS */
18 : /* */
19 : /*******************************************************************/
20 : #include "pari.h"
21 : #include "paripriv.h"
22 :
23 : #define DEBUGLEVEL DEBUGLEVEL_rnf
24 :
25 : /* eq is an rnfeq; must return a t_POL */
26 : GEN
27 95667 : eltreltoabs(GEN eq, GEN x)
28 : {
29 95667 : GEN Pabs = gel(eq,1), a = gel(eq,2), k = gel(eq,3), T = gel(eq,4), b, s;
30 95667 : long i, v = varn(Pabs);
31 95667 : pari_sp av = avma;
32 :
33 95667 : if (varncmp(gvar(x), v) > 0) x = scalarpol(x,v);
34 95667 : x = RgX_nffix("eltreltoabs", T, x, 1);
35 : /* Mod(X - k a, Pabs(X)) is a root of the relative polynomial */
36 95657 : if (signe(k))
37 19881 : x = RgXQX_RgXQ_translate(x, deg1pol_shallow(negi(k), gen_0, varn(T)), T);
38 95657 : b = pol_x(v);
39 95657 : s = gen_0;
40 274234 : for (i=lg(x)-1; i>1; i--)
41 : {
42 178577 : GEN c = gel(x,i);
43 178577 : if (typ(c) == t_POL) c = RgX_RgXQ_eval(c, a, Pabs);
44 178577 : s = RgX_rem(gadd(c, gmul(b,s)), Pabs);
45 : }
46 95657 : return gc_upto(av, s);
47 : }
48 : GEN
49 168691 : rnfeltreltoabs(GEN rnf,GEN x)
50 : {
51 168691 : const char *f = "rnfeltreltoabs";
52 : GEN pol;
53 168691 : checkrnf(rnf);
54 168691 : pol = rnf_get_polabs(rnf);
55 168691 : switch(typ(x))
56 : {
57 42912 : case t_INT: return icopy(x);
58 1610 : case t_FRAC: return gcopy(x);
59 119927 : case t_POLMOD:
60 119927 : if (RgX_equal_var(gel(x,1), pol))
61 : { /* already in 'abs' form, unless possibly if nf = Q */
62 15605 : if (rnf_get_nfdegree(rnf) == 1)
63 : {
64 15590 : GEN y = gel(x,2);
65 15590 : pari_sp av = avma;
66 15590 : y = simplify_shallow(liftpol_shallow(y));
67 15590 : return gc_GEN(av, mkpolmod(y, pol));
68 : }
69 15 : return gcopy(x);
70 : }
71 104322 : x = polmod_nffix(f,rnf,x,0);
72 104262 : if (typ(x) == t_POLMOD) return rnfeltup(rnf,x);
73 87260 : retmkpolmod(eltreltoabs(rnf_get_map(rnf), x), ZX_copy(pol));
74 4172 : case t_POL:
75 4172 : if (varn(x) == rnf_get_nfvarn(rnf)) return rnfeltup(rnf,x);
76 1802 : retmkpolmod(eltreltoabs(rnf_get_map(rnf), x), ZX_copy(pol));
77 : }
78 70 : pari_err_TYPE(f,x);
79 : return NULL;/*LCOV_EXCL_LINE*/
80 : }
81 :
82 : GEN
83 31609 : eltabstorel_lift(GEN rnfeq, GEN P)
84 : {
85 31609 : GEN k, T = gel(rnfeq,4), R = gel(rnfeq,5);
86 31609 : if (is_scalar_t(typ(P))) return P;
87 30866 : k = gel(rnfeq,3);
88 30866 : P = lift_shallow(P);
89 30866 : if (signe(k))
90 8321 : P = RgXQX_RgXQ_translate(P, deg1pol_shallow(k, gen_0, varn(T)), T);
91 30866 : P = RgXQX_rem(P, R, T);
92 30866 : return QXQX_to_mod_shallow(P, T);
93 : }
94 : /* rnfeq = [pol,a,k,T,R], P a t_POL or scalar
95 : * Return Mod(P(x + k Mod(y, T(y))), pol(x)) */
96 : GEN
97 26697 : eltabstorel(GEN rnfeq, GEN P)
98 : {
99 26697 : GEN T = gel(rnfeq,4), R = gel(rnfeq,5);
100 26697 : return mkpolmod(eltabstorel_lift(rnfeq,P), QXQX_to_mod_shallow(R,T));
101 : }
102 : GEN
103 61901 : rnfeltabstorel(GEN rnf,GEN x)
104 : {
105 61901 : const char *f = "rnfeltabstorel";
106 61901 : pari_sp av = avma;
107 : GEN pol, T, P, NF;
108 61901 : checkrnf(rnf);
109 61901 : T = rnf_get_nfpol(rnf);
110 61901 : P = rnf_get_pol(rnf);
111 61901 : pol = rnf_get_polabs(rnf);
112 61901 : switch(typ(x))
113 : {
114 4446 : case t_INT: return icopy(x);
115 78 : case t_FRAC: return gcopy(x);
116 54988 : case t_POLMOD:
117 54988 : if (RgX_equal_var(P, gel(x,1)))
118 : {
119 16202 : x = polmod_nffix(f, rnf, x, 0);
120 16202 : P = QXQX_to_mod_shallow(P,T);
121 16202 : return gc_GEN(av, mkpolmod(x,P));
122 : }
123 38786 : if (RgX_equal_var(T, gel(x,1))) { x = Rg_nffix(f, T, x, 0); goto END; }
124 38681 : if (!RgX_equal_var(pol, gel(x,1))) pari_err_MODULUS(f, gel(x,1),pol);
125 38501 : x = gel(x,2); break;
126 1969 : case t_POL: break;
127 420 : case t_COL:
128 420 : NF = obj_check(rnf, rnf_NFABS);
129 420 : if (!NF) pari_err_TYPE("rnfeltabstorel, apply nfinit(rnf)",x);
130 210 : x = nf_to_scalar_or_alg(NF,x); break;
131 0 : default:
132 0 : pari_err_TYPE(f,x);
133 : return NULL;/*LCOV_EXCL_LINE*/
134 : }
135 40680 : switch(typ(x))
136 : {
137 17413 : case t_INT: return icopy(x);
138 56 : case t_FRAC: return gcopy(x);
139 23211 : case t_POL: break;
140 0 : default: pari_err_TYPE(f, x);
141 : }
142 23211 : RgX_check_QX(x,f);
143 23141 : if (varn(x) != varn(pol))
144 : {
145 100 : if (varn(x) == varn(T)) { x = Rg_nffix(f,T,x,0); goto END; }
146 40 : pari_err_VAR(f, x,pol);
147 : }
148 23041 : switch(lg(x))
149 : {
150 0 : case 2: return gc_const(av, gen_0);
151 50 : case 3: return gc_GEN(av, gel(x,2));
152 : }
153 23156 : END:
154 23156 : return gc_GEN(av, eltabstorel(rnf_get_map(rnf), x));
155 : }
156 :
157 : /* x a t_VEC of rnf elements in 'alg' form (t_POL). Assume maximal rank or 0 */
158 : static GEN
159 2744 : modulereltoabs(GEN rnf, GEN x)
160 : {
161 2744 : GEN W=gel(x,1), I=gel(x,2), rnfeq = rnf_get_map(rnf), polabs = gel(rnfeq,1);
162 2744 : long i, j, k, m, N = lg(W)-1;
163 : GEN zknf, dzknf, M;
164 :
165 2744 : if (!N) return cgetg(1, t_VEC);
166 2699 : zknf = rnf_get_nfzk(rnf);
167 2699 : dzknf = gel(zknf,1);
168 2699 : m = rnf_get_nfdegree(rnf);
169 2699 : M = cgetg(N*m+1, t_VEC);
170 9339 : for (k=i=1; i<=N; i++)
171 : {
172 6640 : GEN c0, cid, w = gel(W,i), id = gel(I,i);
173 :
174 6640 : if (lg(id) == 1) continue; /* must be a t_MAT */
175 6605 : id = Q_primitive_part(id, &cid);
176 6605 : w = Q_primitive_part(eltreltoabs(rnfeq,w), &c0);
177 6605 : c0 = div_content(mul_content(c0,cid), dzknf);
178 6605 : if (typ(id) == t_INT)
179 15152 : for (j=1; j<=m; j++)
180 : {
181 9974 : GEN z = RgX_rem(gmul(w, gel(zknf,j)), polabs);
182 9974 : if (c0) z = RgX_Rg_mul(z, c0);
183 9974 : gel(M,k++) = z;
184 : }
185 : else
186 4896 : for (j=1; j<=m; j++)
187 : {
188 3469 : GEN c, z = Q_primitive_part(RgV_RgC_mul(zknf,gel(id,j)), &c);
189 3469 : z = RgX_rem(gmul(w, z), polabs);
190 3469 : c = mul_content(c, c0); if (c) z = RgX_Rg_mul(z, c);
191 3469 : gel(M,k++) = z;
192 : }
193 : }
194 2699 : setlg(M, k); return M;
195 : }
196 :
197 : /* Z-basis for absolute maximal order: [NF.pol, NF.zk] */
198 : GEN
199 2414 : rnf_zkabs(GEN rnf)
200 : {
201 2414 : GEN d, v, M = modulereltoabs(rnf, rnf_get_zk(rnf));
202 2414 : GEN T = rnf_get_polabs(rnf);
203 2414 : long n = degpol(T);
204 2414 : M = Q_remove_denom(M, &d); /* t_VEC of t_POL */
205 2414 : if (d)
206 : {
207 1645 : M = RgXV_to_RgM(M,n);
208 1645 : M = ZM_hnfmodall(M, d, hnf_MODID|hnf_CENTER);
209 1645 : M = RgM_Rg_div(M, d);
210 : }
211 : else
212 769 : M = matid(n);
213 2414 : v = rnf_get_ramified_primes(rnf);
214 2414 : if (lg(v) == 1)
215 : {
216 238 : GEN D = gel(rnf_get_disc(rnf),1);
217 238 : if (!isint1(D)) pari_err_TYPE("rnf_zkabs (old style rnf)", rnf);
218 : }
219 2414 : v = shallowconcat(nf_get_ramified_primes(rnf_get_nf(rnf)), v);
220 2414 : return mkvec3(T, RgM_to_RgXV(M, varn(T)), ZV_sort_uniq_shallow(v));
221 : }
222 :
223 : static GEN
224 2239 : mknfabs(GEN rnf, long prec)
225 : {
226 : GEN NF;
227 2239 : if ((NF = obj_check(rnf,rnf_NFABS)))
228 48 : { if (nf_get_prec(NF) < prec) NF = nfnewprec_shallow(NF,prec); }
229 : else
230 2191 : NF = nfinit(rnf_zkabs(rnf), prec);
231 2239 : return NF;
232 : }
233 :
234 : static GEN
235 2191 : mkupdown(GEN NF, GEN rnf)
236 : {
237 : GEN M, zknf, dzknf;
238 : long i, l;
239 2191 : zknf = rnf_get_nfzk(rnf);
240 2191 : dzknf = gel(zknf,1); if (gequal1(dzknf)) dzknf = NULL;
241 2191 : l = lg(zknf); M = cgetg(l, t_MAT);
242 2191 : gel(M,1) = vec_ei(nf_get_degree(NF), 1);
243 4163 : for (i = 2; i < l; i++)
244 : {
245 1972 : GEN c = poltobasis(NF, gel(zknf,i));
246 1972 : if (dzknf) c = gdiv(c, dzknf);
247 1972 : gel(M,i) = c;
248 : }
249 2191 : return Qevproj_init(M);
250 : }
251 : GEN
252 143996 : rnf_build_nfabs(GEN rnf, long prec)
253 : {
254 143996 : GEN NF = obj_checkbuild_prec(rnf, rnf_NFABS, &mknfabs, &nf_get_prec, prec);
255 143996 : GEN O = obj_check(rnf, rnf_MAPS);
256 143996 : if (!O)
257 2191 : { pari_sp av = avma; O = obj_insert(rnf, rnf_MAPS, mkupdown(NF, rnf)); set_avma(av); }
258 143996 : return NF;
259 : }
260 :
261 : void
262 53016 : rnfcomplete(GEN rnf)
263 53016 : { (void)rnf_build_nfabs(rnf, nf_get_prec(rnf_get_nf(rnf))); }
264 :
265 : GEN
266 2616 : nf_nfzk(GEN nf, GEN rnfeq)
267 : {
268 2616 : GEN pol = gel(rnfeq,1), a = gel(rnfeq,2);
269 2616 : return Q_primpart(QXV_QXQ_eval(nf_get_zkprimpart(nf), a, pol));
270 : }
271 :
272 : static GEN
273 4067 : rnfdisc_get_T_i(GEN P, GEN *lim)
274 : {
275 4067 : *lim = NULL;
276 4067 : if (typ(P) == t_VEC && lg(P) == 3)
277 : {
278 885 : GEN L = gel(P,2);
279 : long i, l;
280 885 : *lim = L;
281 885 : switch(typ(L))
282 : {
283 128 : case t_INT:
284 128 : if (signe(L) <= 0) return NULL;
285 128 : break;
286 757 : case t_VEC: case t_COL:
287 757 : l = lg(L);
288 2668 : for (i = 1; i < l; i++)
289 : {
290 1911 : GEN p = gel(L,i);
291 1911 : if (typ(p) == t_INT)
292 1901 : { if (signe(p) <= 0) return NULL; }
293 10 : else checkprid(p);
294 : }
295 757 : break;
296 0 : default: return NULL;
297 : }
298 885 : P = gel(P,1);
299 : }
300 4067 : return (typ(P) == t_POL)? P: NULL;
301 : }
302 : /* true nf */
303 : GEN
304 4067 : rnfdisc_get_T(GEN nf, GEN P, GEN *lim)
305 : {
306 4067 : GEN T = rnfdisc_get_T_i(P, lim);
307 4067 : if (!T) pari_err_TYPE("rnfdisc",P);
308 4067 : return RgX_nffix("rnfdisc", nf_get_pol(nf), T, 1);
309 : }
310 :
311 : GEN
312 91 : rnfpseudobasis(GEN nf, GEN pol)
313 : {
314 91 : pari_sp av = avma;
315 : GEN D, z, lim;
316 91 : nf = checknf(nf);
317 91 : pol = rnfdisc_get_T(nf, pol, &lim);
318 91 : z = rnfallbase(nf, pol, lim, NULL, &D, NULL, NULL);
319 76 : return gc_GEN(av, shallowconcat(z,D));
320 : }
321 :
322 : GEN
323 2576 : rnfinit0(GEN nf, GEN T, long flag)
324 : {
325 2576 : pari_sp av = avma;
326 2576 : GEN lim, bas, D, f, B, DKP, rnfeq, rnf = obj_init(11, 2);
327 2576 : nf = checknf(nf);
328 2576 : T = rnfdisc_get_T(nf, T, &lim);
329 2576 : gel(rnf,11) = rnfeq = nf_rnfeq(nf,T);
330 2576 : gel(rnf,2) = nf_nfzk(nf, rnfeq);
331 2576 : bas = rnfallbase(nf, T, lim, rnf, &D, &f, &DKP);
332 2571 : B = matbasistoalg(nf,gel(bas,1));
333 2571 : gel(bas,1) = lift_if_rational( RgM_to_RgXV(B,varn(T)) );
334 2571 : gel(rnf,1) = T;
335 2571 : gel(rnf,3) = D;
336 2571 : gel(rnf,4) = f;
337 2571 : gel(rnf,5) = DKP;
338 2571 : gel(rnf,6) = cgetg(1, t_VEC); /* dummy */
339 2571 : gel(rnf,7) = bas;
340 2571 : gel(rnf,8) = lift_if_rational( RgM_inv_upper(B) );
341 1601 : gel(rnf,9) = typ(f) == t_INT? powiu(f, nf_get_degree(nf))
342 2571 : : RgM_det_triangular(f);
343 2571 : gel(rnf,10)= nf;
344 2571 : rnf = gc_GEN(av, rnf);
345 2571 : if (flag) rnfcomplete(rnf);
346 2571 : return rnf;
347 : }
348 : GEN
349 1099 : rnfinit(GEN nf, GEN T) { return rnfinit0(nf,T,0); }
350 :
351 : GEN
352 44971 : rnfeltup0(GEN rnf, GEN x, long flag)
353 : {
354 44971 : pari_sp av = avma;
355 : GEN zknf, nf, NF, POL;
356 44971 : long tx = typ(x);
357 44971 : checkrnf(rnf);
358 44971 : if (flag) rnfcomplete(rnf);
359 44971 : NF = obj_check(rnf,rnf_NFABS);
360 44971 : POL = rnf_get_polabs(rnf);
361 44971 : if (tx == t_POLMOD && RgX_equal_var(gel(x,1), POL))
362 : {
363 30 : if (flag) x = nf_to_scalar_or_basis(NF,x);
364 30 : return gc_GEN(av, x);
365 : }
366 44941 : nf = rnf_get_nf(rnf);
367 44941 : if (NF && tx == t_COL && lg(x)-1 == degpol(POL) && nf_get_degree(rnf) > 1)
368 : {
369 0 : x = flag? nf_to_scalar_or_basis(NF,x)
370 0 : : mkpolmod(nf_to_scalar_or_alg(NF,x), POL);
371 0 : return gc_GEN(av, x);
372 : }
373 44941 : if (NF)
374 : {
375 : GEN d, proj;
376 44606 : x = nf_to_scalar_or_basis(nf, x);
377 44606 : if (typ(x) != t_COL) return gc_GEN(av, x);
378 43868 : proj = obj_check(rnf,rnf_MAPS);
379 43868 : x = Q_remove_denom(x,&d);
380 43868 : x = ZM_ZC_mul(gel(proj,1), x);
381 43868 : if (d) x = gdiv(x,d);
382 43868 : if (!flag) x = basistoalg(NF,x);
383 : }
384 : else
385 : {
386 335 : zknf = rnf_get_nfzk(rnf);
387 335 : x = nfeltup(nf, x, zknf);
388 140 : if (typ(x) == t_POL) x = mkpolmod(x, POL);
389 : }
390 44008 : return gc_GEN(av, x);
391 : }
392 : GEN
393 20932 : rnfeltup(GEN rnf, GEN x) { return rnfeltup0(rnf,x,0); }
394 :
395 : GEN
396 355 : nfeltup(GEN nf, GEN x, GEN zknf)
397 : {
398 355 : GEN c, dzknf = gel(zknf,1);
399 355 : x = nf_to_scalar_or_basis(nf, x);
400 160 : if (typ(x) != t_COL) return x;
401 60 : x = Q_primitive_part(x, &c);
402 60 : if (!RgV_is_ZV(x)) pari_err_TYPE("rnfeltup", x);
403 60 : if (gequal1(dzknf)) dzknf = NULL;
404 60 : c = div_content(c, dzknf);
405 60 : x = RgV_RgC_mul(zknf, x); if (c) x = RgX_Rg_mul(x, c);
406 60 : return x;
407 : }
408 :
409 : static void
410 36 : fail(const char *f, GEN x)
411 36 : { pari_err_DOMAIN(f,"element","not in", strtoGENstr("the base field"),x); }
412 : /* x t_COL of length degabs */
413 : static GEN
414 0 : eltdown(GEN rnf, GEN x)
415 : {
416 0 : GEN y, d, proj = obj_check(rnf,rnf_MAPS);
417 0 : GEN M = gel(proj,1), iM = gel(proj,2), diM = gel(proj,3), perm = gel(proj,4);
418 0 : x = Q_remove_denom(x,&d);
419 0 : if (!RgV_is_ZV(x)) pari_err_TYPE("rnfeltdown", x);
420 0 : y = ZM_ZC_mul(iM, vecpermute(x, perm));
421 0 : if (!ZV_equal(ZM_ZC_mul(M,y),
422 0 : isint1(diM)? x: ZC_Z_mul(x,diM))) fail("rnfeltdown",x);
423 :
424 0 : d = mul_denom(d, diM);
425 0 : if (d) y = gdiv(y,d);
426 0 : return y;
427 : }
428 : GEN
429 3008 : rnfeltdown0(GEN rnf, GEN x, long flag)
430 : {
431 3008 : const char *f = "rnfeltdown";
432 3008 : pari_sp av = avma;
433 : GEN z, T, NF, nf;
434 : long v;
435 :
436 3008 : checkrnf(rnf);
437 3008 : NF = obj_check(rnf,rnf_NFABS);
438 3008 : nf = rnf_get_nf(rnf);
439 3008 : T = nf_get_pol(nf);
440 3008 : v = varn(T);
441 3008 : switch(typ(x))
442 : { /* directly belonging to base field ? */
443 691 : case t_INT: return icopy(x);
444 85 : case t_FRAC:return gcopy(x);
445 1990 : case t_POLMOD:
446 1990 : if (RgX_equal_var(gel(x,1), rnf_get_polabs(rnf)))
447 : {
448 334 : if (degpol(T) == 1)
449 : {
450 314 : x = simplify_shallow(liftpol_shallow(gel(x,2)));
451 314 : if (typ(x) != t_POL) return gc_GEN(av,x);
452 : }
453 35 : break;
454 : }
455 1656 : x = polmod_nffix(f,rnf,x,0);
456 : /* x was defined mod the relative polynomial & non constant => fail */
457 1596 : if (typ(x) == t_POL) fail(f,x);
458 1591 : if (flag) x = nf_to_scalar_or_basis(nf,x);
459 1591 : return gc_GEN(av, x);
460 :
461 172 : case t_POL:
462 172 : if (varn(x) != v) break;
463 116 : x = Rg_nffix(f,T,x,0);
464 106 : if (flag) x = nf_to_scalar_or_basis(nf,x);
465 106 : return gc_GEN(av, x);
466 70 : case t_COL:
467 : {
468 70 : long n = lg(x)-1;
469 70 : if (n == degpol(T) && RgV_is_QV(x))
470 : {
471 5 : if (RgV_isscalar(x)) return gcopy(gel(x,1));
472 0 : if (!flag) return gcopy(x);
473 0 : return basistoalg(nf,x);
474 : }
475 65 : if (NF) break;
476 : }
477 65 : default: pari_err_TYPE(f, x);
478 : }
479 : /* x defined mod the absolute equation */
480 91 : if (NF)
481 : {
482 0 : x = nf_to_scalar_or_basis(NF, x);
483 0 : if (typ(x) == t_COL)
484 : {
485 0 : x = eltdown(rnf,x);
486 0 : if (!flag) return gc_upto(av, basistoalg(nf, x));
487 : }
488 0 : return gc_GEN(av, x);
489 : }
490 91 : z = rnfeltabstorel(rnf,x);
491 61 : switch(typ(z))
492 : {
493 10 : case t_INT:
494 10 : case t_FRAC: return z;
495 : }
496 : /* typ(z) = t_POLMOD, varn of both components is rnf_get_varn(rnf) */
497 51 : z = gel(z,2);
498 51 : if (typ(z) == t_POL)
499 : {
500 51 : if (lg(z) != 3) fail(f,x);
501 20 : z = gel(z,2);
502 : }
503 20 : return gc_GEN(av, z);
504 : }
505 : GEN
506 2672 : rnfeltdown(GEN rnf, GEN x) { return rnfeltdown0(rnf,x,0); }
507 :
508 : /* vector of rnf elt -> matrix of nf elts */
509 : static GEN
510 345 : rnfV_to_nfM(GEN rnf, GEN x)
511 : {
512 345 : long i, l = lg(x);
513 345 : GEN y = cgetg(l, t_MAT);
514 1045 : for (i = 1; i < l; i++) gel(y,i) = rnfalgtobasis(rnf,gel(x,i));
515 345 : return y;
516 : }
517 :
518 : static GEN
519 550 : rnfprincipaltohnf(GEN rnf,GEN x)
520 : {
521 550 : pari_sp av = avma;
522 550 : GEN bas = rnf_get_zk(rnf), nf = rnf_get_nf(rnf);
523 550 : x = rnfbasistoalg(rnf,x);
524 310 : x = gmul(x, gmodulo(gel(bas,1), rnf_get_pol(rnf)));
525 310 : return gc_upto(av, nfhnf(nf, mkvec2(rnfV_to_nfM(rnf,x), gel(bas,2))));
526 : }
527 :
528 : /* pseudo-basis for the 0 ideal */
529 : static GEN
530 110 : rnfideal0(void) { retmkvec2(cgetg(1,t_MAT),cgetg(1,t_VEC)); }
531 :
532 : GEN
533 950 : rnfidealhnf(GEN rnf, GEN x)
534 : {
535 : GEN z, nf, bas;
536 :
537 950 : checkrnf(rnf); nf = rnf_get_nf(rnf);
538 950 : switch(typ(x))
539 : {
540 130 : case t_INT: case t_FRAC:
541 130 : if (isintzero(x)) return rnfideal0();
542 90 : bas = rnf_get_zk(rnf); z = cgetg(3,t_VEC);
543 90 : gel(z,1) = matid(rnf_get_degree(rnf));
544 90 : gel(z,2) = gmul(x, gel(bas,2)); return z;
545 :
546 190 : case t_VEC:
547 190 : if (lg(x) == 3 && typ(gel(x,1)) == t_MAT) return nfhnf(nf, x);
548 : case t_MAT:
549 180 : return rnfidealabstorel(rnf, x);
550 :
551 550 : case t_POLMOD: case t_POL: case t_COL:
552 550 : return rnfprincipaltohnf(rnf,x);
553 : }
554 0 : pari_err_TYPE("rnfidealhnf",x);
555 : return NULL; /* LCOV_EXCL_LINE */
556 : }
557 :
558 : static GEN
559 75 : prodidnorm(GEN nf, GEN I)
560 : {
561 75 : long i, l = lg(I);
562 : GEN z;
563 75 : if (l == 1) return gen_1;
564 75 : z = idealnorm(nf, gel(I,1));
565 150 : for (i=2; i<l; i++) z = gmul(z, idealnorm(nf, gel(I,i)));
566 75 : return z;
567 : }
568 :
569 : GEN
570 140 : rnfidealnormrel(GEN rnf, GEN id)
571 : {
572 140 : pari_sp av = avma;
573 140 : GEN nf, z = gel(rnfidealhnf(rnf,id), 2);
574 90 : if (lg(z) == 1) return cgetg(1, t_MAT);
575 70 : nf = rnf_get_nf(rnf); z = idealprod(nf, z);
576 70 : return gc_upto(av, idealmul(nf,z, rnf_get_index(rnf)));
577 : }
578 :
579 : GEN
580 145 : rnfidealnormabs(GEN rnf, GEN id)
581 : {
582 145 : pari_sp av = avma;
583 145 : GEN nf, z = gel(rnfidealhnf(rnf,id), 2);
584 95 : if (lg(z) == 1) return gen_0;
585 75 : nf = rnf_get_nf(rnf); z = prodidnorm(nf, z);
586 75 : return gc_upto(av, gmul(z, gel(rnf,9)));
587 : }
588 :
589 : static GEN
590 355 : rnfidealreltoabs_i(GEN rnf, GEN x)
591 : {
592 : long i, l;
593 : GEN w;
594 355 : x = rnfidealhnf(rnf,x);
595 255 : w = gel(x,1); l = lg(w); settyp(w, t_VEC);
596 690 : for (i=1; i<l; i++) gel(w,i) = lift_shallow( rnfbasistoalg(rnf, gel(w,i)) );
597 255 : return modulereltoabs(rnf, x);
598 : }
599 : GEN
600 0 : rnfidealreltoabs(GEN rnf, GEN x)
601 : {
602 0 : pari_sp av = avma;
603 0 : return gc_GEN(av, rnfidealreltoabs_i(rnf,x));
604 : }
605 : GEN
606 170 : rnfidealreltoabs0(GEN rnf, GEN x, long flag)
607 : {
608 170 : pari_sp av = avma;
609 : long i, l;
610 : GEN NF;
611 :
612 170 : x = rnfidealreltoabs_i(rnf, x);
613 120 : if (!flag) return gc_GEN(av,x);
614 25 : rnfcomplete(rnf);
615 25 : NF = obj_check(rnf,rnf_NFABS);
616 25 : l = lg(x); settyp(x, t_MAT);
617 175 : for (i=1; i<l; i++) gel(x,i) = algtobasis(NF, gel(x,i));
618 25 : return gc_upto(av, idealhnf(NF,x));
619 : }
620 :
621 : GEN
622 325 : rnfidealabstorel(GEN rnf, GEN x)
623 : {
624 325 : long n, N, j, tx = typ(x);
625 325 : pari_sp av = avma;
626 : GEN A, I, invbas;
627 :
628 325 : checkrnf(rnf);
629 325 : invbas = rnf_get_invzk(rnf);
630 325 : if (tx != t_VEC && tx != t_MAT) pari_err_TYPE("rnfidealabstorel",x);
631 225 : N = lg(x)-1;
632 225 : if (N != rnf_get_absdegree(rnf))
633 : {
634 140 : if (!N) return rnfideal0();
635 75 : pari_err_DIM("rnfidealabstorel");
636 : }
637 85 : n = rnf_get_degree(rnf);
638 85 : A = cgetg(N+1,t_MAT);
639 85 : I = cgetg(N+1,t_VEC);
640 595 : for (j=1; j<=N; j++)
641 : {
642 510 : GEN t = lift_shallow( rnfeltabstorel(rnf, gel(x,j)) );
643 510 : if (typ(t) == t_POL)
644 425 : t = RgM_RgX_mul(invbas, t);
645 : else
646 85 : t = scalarcol_shallow(t, n);
647 510 : gel(A,j) = t;
648 510 : gel(I,j) = gen_1;
649 : }
650 85 : return gc_upto(av, nfhnf(rnf_get_nf(rnf), mkvec2(A,I)));
651 : }
652 :
653 : GEN
654 155 : rnfidealdown(GEN rnf,GEN x)
655 : {
656 155 : pari_sp av = avma;
657 : GEN I;
658 155 : if (typ(x) == t_MAT)
659 : {
660 : GEN d;
661 20 : x = Q_remove_denom(x,&d);
662 20 : if (RgM_is_ZM(x))
663 : {
664 20 : GEN NF = obj_check(rnf,rnf_NFABS);
665 20 : if (NF)
666 : {
667 20 : GEN z, proj = obj_check(rnf,rnf_MAPS), ZK = gel(proj,1);
668 : long i, lz, l;
669 20 : x = idealhnf_shallow(NF,x);
670 25 : if (lg(x) == 1) retgc_const(av, cgetg(1, t_MAT));
671 10 : z = ZM_lll(shallowconcat(ZK,x), 0.99, LLL_KER);
672 10 : lz = lg(z); l = lg(ZK);
673 40 : for (i = 1; i < lz; i++) setlg(gel(z,i), l);
674 10 : z = ZM_hnfmodid(z, gcoeff(x,1,1));
675 10 : if (d) z = gdiv(z,d);
676 10 : return gc_upto(av, z);
677 : }
678 : }
679 : }
680 135 : x = rnfidealhnf(rnf,x); I = gel(x,2);
681 90 : if (lg(I) == 1) retgc_const(av, cgetg(1, t_MAT));
682 75 : return gc_GEN(av, gel(I,1));
683 : }
684 :
685 : /* lift ideal x to the relative extension, returns a Z-basis */
686 : GEN
687 160 : rnfidealup(GEN rnf,GEN x)
688 : {
689 160 : pari_sp av = avma;
690 : long i, n;
691 : GEN nf, bas, bas2, I, x2, dx;
692 :
693 160 : checkrnf(rnf); nf = rnf_get_nf(rnf);
694 160 : n = rnf_get_degree(rnf);
695 160 : bas = rnf_get_zk(rnf); bas2 = gel(bas,2);
696 :
697 160 : (void)idealtyp(&x, NULL);
698 150 : x = Q_remove_denom(x, &dx);
699 150 : x2 = idealtwoelt(nf,x);
700 75 : I = cgetg(n+1,t_VEC);
701 220 : for (i=1; i<=n; i++)
702 : {
703 145 : GEN c = gel(bas2,i), d;
704 145 : if (typ(c) == t_MAT)
705 : {
706 5 : c = Q_remove_denom(c,&d);
707 5 : d = mul_denom(d, dx);
708 5 : c = idealHNF_mul(nf,c,x2);
709 : }
710 : else
711 : {
712 140 : c = idealmul(nf,c,x);
713 140 : d = dx;
714 : }
715 145 : if (d) c = gdiv(c,d);
716 145 : gel(I,i) = c;
717 : }
718 75 : return gc_GEN(av, modulereltoabs(rnf, mkvec2(gel(bas,1), I)));
719 : }
720 : GEN
721 175 : rnfidealup0(GEN rnf,GEN x, long flag)
722 : {
723 175 : pari_sp av = avma;
724 : GEN NF, nf, proj, d, x2;
725 :
726 175 : if (!flag) return rnfidealup(rnf,x);
727 15 : checkrnf(rnf); nf = rnf_get_nf(rnf);
728 15 : rnfcomplete(rnf);
729 15 : proj = obj_check(rnf,rnf_MAPS);
730 15 : NF = obj_check(rnf,rnf_NFABS);
731 :
732 15 : (void)idealtyp(&x, NULL);
733 15 : x2 = idealtwoelt(nf,x);
734 15 : x2 = Q_remove_denom(x2,&d);
735 15 : if (typ(gel(x2,2)) == t_COL) gel(x2,2) = ZM_ZC_mul(gel(proj,1),gel(x2,2));
736 15 : x2 = idealhnf_two(NF, x2);
737 15 : if (d) x2 = gdiv(x2,d);
738 15 : return gc_upto(av, x2);
739 : }
740 :
741 : /* x a relative HNF => vector of 2 generators (relative polmods) */
742 : GEN
743 185 : rnfidealtwoelement(GEN rnf, GEN x)
744 : {
745 185 : pari_sp av = avma;
746 : GEN y, cy, z, NF;
747 :
748 185 : y = rnfidealreltoabs_i(rnf,x);
749 135 : rnfcomplete(rnf);
750 135 : NF = obj_check(rnf,rnf_NFABS);
751 135 : y = matalgtobasis(NF, y); settyp(y, t_MAT);
752 135 : y = Q_primitive_part(y, &cy);
753 135 : y = ZM_hnf(y);
754 135 : if (lg(y) == 1) { set_avma(av); return mkvec2(gen_0, gen_0); }
755 110 : y = idealtwoelt(NF, y);
756 105 : if (cy) y = RgV_Rg_mul(y, cy);
757 105 : z = gel(y,2);
758 105 : if (typ(z) == t_COL) z = rnfeltabstorel(rnf, nf_to_scalar_or_alg(NF, z));
759 105 : return gc_GEN(av, mkvec2(gel(y,1), z));
760 : }
761 :
762 : GEN
763 40 : rnfidealmul(GEN rnf,GEN x,GEN y)
764 : {
765 40 : pari_sp av = avma;
766 : GEN nf, z, x1, x2, p1, p2, bas;
767 :
768 40 : y = rnfidealtwoelement(rnf,y);
769 40 : if (isintzero(gel(y,1))) { set_avma(av); return rnfideal0(); }
770 35 : nf = rnf_get_nf(rnf);
771 35 : bas = rnf_get_zk(rnf);
772 35 : x = rnfidealhnf(rnf,x);
773 35 : x1 = gmodulo(gmul(gel(bas,1), matbasistoalg(nf,gel(x,1))), rnf_get_pol(rnf));
774 35 : x2 = gel(x,2);
775 35 : p1 = gmul(gel(y,1), gel(x,1));
776 35 : p2 = rnfV_to_nfM(rnf, gmul(gel(y,2), x1));
777 35 : z = mkvec2(shallowconcat(p1, p2), shallowconcat(x2, x2));
778 35 : return gc_upto(av, nfhnf(nf,z));
779 : }
780 :
781 : /* prK wrt NF ~ Q[x]/(polabs) */
782 : static GEN
783 27968 : rnfidealprimedec_1(GEN rnf, GEN SL, GEN prK)
784 : {
785 27968 : GEN v, piL, piK = pr_get_gen(prK);
786 : long i, c, l;
787 27968 : if (pr_is_inert(prK)) return SL;
788 23714 : piL = rnfeltup0(rnf, piK, 1);
789 23714 : v = cgetg_copy(SL, &l);
790 94541 : for (i = c = 1; i < l; i++)
791 : {
792 70827 : GEN P = gel(SL,i);
793 70827 : if (ZC_prdvd(piL, P)) gel(v,c++) = P;
794 : }
795 23714 : setlg(v, c); return v;
796 : }
797 : GEN
798 27968 : rnfidealprimedec(GEN rnf, GEN pr)
799 : {
800 27968 : pari_sp av = avma;
801 : GEN p, z, NF, nf, SL;
802 27968 : checkrnf(rnf);
803 27968 : rnfcomplete(rnf);
804 27968 : NF = obj_check(rnf,rnf_NFABS);
805 27968 : nf = rnf_get_nf(rnf);
806 27968 : if (typ(pr) == t_INT) { p = pr; pr = NULL; }
807 27948 : else { checkprid(pr); p = pr_get_p(pr); }
808 27968 : SL = idealprimedec(NF, p);
809 27968 : if (pr) z = rnfidealprimedec_1(rnf, SL, pr);
810 : else
811 : {
812 20 : GEN vK = idealprimedec(nf, p), vL;
813 20 : long l = lg(vK), i;
814 20 : vL = cgetg(l, t_VEC);
815 40 : for (i = 1; i < l; i++) gel(vL,i) = rnfidealprimedec_1(rnf, SL, gel(vK,i));
816 20 : z = mkvec2(vK, vL);
817 : }
818 27968 : return gc_GEN(av, z);
819 : }
820 :
821 : GEN
822 25 : rnfidealfactor(GEN rnf, GEN x)
823 : {
824 25 : pari_sp av = avma;
825 : GEN NF;
826 25 : checkrnf(rnf);
827 25 : rnfcomplete(rnf);
828 25 : NF = obj_check(rnf,rnf_NFABS);
829 25 : return gc_upto(av, idealfactor(NF, rnfidealreltoabs0(rnf, x, 1)));
830 : }
831 :
832 : GEN
833 41729 : rnfequationall(GEN A, GEN B, long *pk, GEN *pLPRS)
834 : {
835 : long lA, lB;
836 : GEN nf, C;
837 :
838 41729 : A = get_nfpol(A, &nf); lA = lg(A);
839 41729 : if (!nf) {
840 7866 : if (lA<=3) pari_err_CONSTPOL("rnfequation");
841 7866 : RgX_check_ZX(A,"rnfequation");
842 : }
843 41729 : B = RgX_nffix("rnfequation", A,B,1); lB = lg(B);
844 41729 : if (lB<=3) pari_err_CONSTPOL("rnfequation");
845 41729 : B = Q_primpart(B);
846 :
847 41729 : if (!nfissquarefree(A,B))
848 0 : pari_err_DOMAIN("rnfequation","issquarefree(B)","=",gen_0,B);
849 :
850 41729 : *pk = 0; C = ZX_ZXY_resultant_all(A, B, pk, pLPRS);
851 41729 : if (signe(leading_coeff(C)) < 0) C = ZX_neg(C);
852 41729 : *pk = -*pk; return Q_primpart(C);
853 : }
854 :
855 : GEN
856 41412 : rnfequation0(GEN A, GEN B, long flall)
857 : {
858 41412 : pari_sp av = avma;
859 : GEN LPRS, C;
860 : long k;
861 :
862 41412 : C = rnfequationall(A, B, &k, flall? &LPRS: NULL);
863 41412 : if (flall)
864 : { /* a,b,c root of A,B,C = compositum, c = b + k a */
865 9390 : GEN a, mH0 = RgX_neg(gel(LPRS,1)), H1 = gel(LPRS,2);
866 9390 : a = QXQ_div(mH0, H1, C);
867 9390 : C = mkvec3(C, mkpolmod(a, C), stoi(k));
868 : }
869 41412 : return gc_GEN(av, C);
870 : }
871 : GEN
872 29212 : rnfequation(GEN nf, GEN pol) { return rnfequation0(nf,pol,0); }
873 : GEN
874 9309 : rnfequation2(GEN nf, GEN pol) { return rnfequation0(nf,pol,1); }
875 : GEN
876 2621 : nf_rnfeq(GEN nf, GEN R)
877 : {
878 : GEN pol, a, k, junk, eq;
879 2621 : R = liftpol_shallow(R);
880 2621 : eq = rnfequation2(nf, R);
881 2621 : pol = gel(eq,1);
882 2621 : a = gel(eq,2); if (typ(a) == t_POLMOD) a = gel(a,2);
883 2621 : k = gel(eq,3);
884 2621 : return mkvec5(pol,a,k,get_nfpol(nf, &junk),R);
885 : }
886 : /* only allow abstorel */
887 : GEN
888 317 : nf_rnfeqsimple(GEN nf, GEN R)
889 : {
890 : long sa;
891 : GEN junk, pol;
892 317 : R = liftpol_shallow(R);
893 317 : pol = rnfequationall(nf, R, &sa, NULL);
894 317 : return mkvec5(pol,gen_0/*dummy*/,stoi(sa),get_nfpol(nf, &junk),R);
895 : }
896 :
897 : /*******************************************************************/
898 : /* */
899 : /* RELATIVE LLL */
900 : /* */
901 : /*******************************************************************/
902 : static GEN
903 140 : nftau(long r1, GEN x)
904 : {
905 140 : long i, l = lg(x);
906 140 : GEN s = r1? gel(x,1): gmul2n(real_i(gel(x,1)),1);
907 280 : for (i=2; i<=r1; i++) s = gadd(s, gel(x,i));
908 140 : for ( ; i < l; i++) s = gadd(s, gmul2n(real_i(gel(x,i)),1));
909 140 : return s;
910 : }
911 :
912 : static GEN
913 730 : nftocomplex(GEN nf, GEN x)
914 : {
915 730 : GEN M = nf_get_M(nf);
916 730 : x = nf_to_scalar_or_basis(nf,x);
917 730 : if (typ(x) != t_COL) return const_col(nbrows(M), x);
918 115 : return RgM_RgC_mul(M, x);
919 : }
920 : /* assume x a square t_MAT, return a t_VEC of embeddings of its columns */
921 : static GEN
922 10 : mattocomplex(GEN nf, GEN x)
923 : {
924 10 : long i,j, l = lg(x);
925 10 : GEN v = cgetg(l, t_VEC);
926 70 : for (j=1; j<l; j++)
927 : {
928 60 : GEN c = gel(x,j), b = cgetg(l, t_MAT);
929 510 : for (i=1; i<l; i++) gel(b,i) = nftocomplex(nf, gel(c,i));
930 60 : b = shallowtrans(b); settyp(b, t_COL);
931 60 : gel(v,j) = b;
932 : }
933 10 : return v;
934 : }
935 :
936 : /* x and nfX; return v such that v[i] = complex roots of sigma_i(x) */
937 : static GEN
938 10 : nf_all_roots(GEN nf, GEN x, long prec)
939 : {
940 10 : long i, j, l = lg(x), ru = lg(nf_get_roots(nf));
941 10 : GEN y = cgetg(l, t_POL), v, z;
942 :
943 10 : x = RgX_to_nfX(nf, x);
944 10 : y[1] = x[1];
945 80 : for (i=2; i<l; i++) gel(y,i) = nftocomplex(nf, gel(x,i));
946 10 : i = gprecision(y); if (i && i <= 3) return NULL;
947 :
948 10 : v = cgetg(ru, t_VEC);
949 10 : z = cgetg(l, t_POL); z[1] = x[1];
950 30 : for (i=1; i<ru; i++)
951 : {
952 160 : for (j = 2; j < l; j++) gel(z,j) = gmael(y,j,i);
953 20 : gel(v,i) = cleanroots(z, prec);
954 : }
955 10 : return v;
956 : }
957 :
958 : static GEN
959 255 : rnfscal(GEN m, GEN x, GEN y)
960 : {
961 255 : long i, l = lg(m);
962 255 : GEN z = cgetg(l, t_COL);
963 255 : if (x == y)
964 180 : for (i = 1; i < l; i++)
965 120 : gel(z,i) = hqfeval(gel(m,i), gel(x,i));
966 : else
967 585 : for (i = 1; i < l; i++)
968 390 : gel(z,i) = qfevalb(gel(m,i), conj_i(gel(x,i)), gel(y,i));
969 255 : return z;
970 : }
971 :
972 : /* x ideal in HNF */
973 : static GEN
974 260 : findmin(GEN nf, GEN x, GEN muf)
975 : {
976 260 : pari_sp av = avma;
977 : long e;
978 260 : GEN cx, y, m, M = nf_get_M(nf);
979 :
980 260 : x = Q_primitive_part(x, &cx);
981 260 : if (gequal1(gcoeff(x,1,1))) y = M;
982 : else
983 : {
984 150 : GEN G = nf_get_G(nf);
985 150 : m = lllfp(RgM_mul(G,x), 0.75, 0);
986 150 : if (typ(m) != t_MAT)
987 : {
988 0 : x = ZM_lll(x, 0.75, LLL_INPLACE);
989 0 : m = lllfp(RgM_mul(G,x), 0.75, 0);
990 0 : if (typ(m) != t_MAT) pari_err_PREC("rnflllgram");
991 : }
992 150 : x = ZM_mul(x, m);
993 150 : y = RgM_mul(M, x);
994 : }
995 260 : m = RgM_solve_realimag(y, muf);
996 260 : if (!m) return NULL; /* precision problem */
997 260 : if (cx) m = RgC_Rg_div(m, cx);
998 260 : m = grndtoi(m, &e);
999 260 : if (e >= 0) return NULL; /* precision problem */
1000 260 : m = ZM_ZC_mul(x, m);
1001 260 : if (cx) m = ZC_Q_mul(m, cx);
1002 260 : return gc_upto(av, m);
1003 : }
1004 :
1005 : static int
1006 260 : RED(long k, long l, GEN U, GEN mu, GEN MC, GEN nf, GEN ideal)
1007 : {
1008 260 : GEN xc, x = findmin(nf, ideal, gcoeff(mu,k,l));
1009 : long i;
1010 :
1011 260 : if (!x) return 0;
1012 260 : if (gequal0(x)) return 1;
1013 :
1014 210 : xc = nftocomplex(nf,x);
1015 210 : gel(MC,k) = gsub(gel(MC,k), vecmul(xc,gel(MC,l)));
1016 210 : gel(U,k) = gsub(gel(U,k), nfC_nf_mul(nf, gel(U,l), x));
1017 210 : gcoeff(mu,k,l) = gsub(gcoeff(mu,k,l), xc);
1018 735 : for (i=1; i<l; i++)
1019 525 : gcoeff(mu,k,i) = gsub(gcoeff(mu,k,i), vecmul(xc,gcoeff(mu,l,i)));
1020 210 : return 1;
1021 : }
1022 :
1023 : static int
1024 60 : check_0(GEN B)
1025 : {
1026 60 : long i, l = lg(B);
1027 180 : for (i = 1; i < l; i++)
1028 120 : if (gsigne(gel(B,i)) <= 0) return 1;
1029 60 : return 0;
1030 : }
1031 :
1032 : static int
1033 70 : do_SWAP(GEN I, GEN MC, GEN MCS, GEN U, GEN mu, GEN B, long kmax, long k,
1034 : const long alpha, long r1)
1035 : {
1036 : GEN p1, p2, muf, mufc, Bf, temp;
1037 : long i, j;
1038 :
1039 70 : p1 = nftau(r1, gadd(gel(B,k),
1040 70 : gmul(gnorml2(gcoeff(mu,k,k-1)), gel(B,k-1))));
1041 70 : p2 = nftau(r1, gel(B,k-1));
1042 70 : if (gcmp(gmulsg(alpha,p1), gmulsg(alpha-1,p2)) > 0) return 0;
1043 :
1044 10 : swap(gel(MC,k-1),gel(MC,k));
1045 10 : swap(gel(U,k-1), gel(U,k));
1046 10 : swap(gel(I,k-1), gel(I,k));
1047 65 : for (j=1; j<=k-2; j++) swap(gcoeff(mu,k-1,j),gcoeff(mu,k,j));
1048 10 : muf = gcoeff(mu,k,k-1);
1049 10 : mufc = conj_i(muf);
1050 10 : Bf = gadd(gel(B,k), vecmul(real_i(vecmul(muf,mufc)), gel(B,k-1)));
1051 10 : if (check_0(Bf)) return 1; /* precision problem */
1052 :
1053 10 : p1 = vecdiv(gel(B,k-1),Bf);
1054 10 : gcoeff(mu,k,k-1) = vecmul(mufc,p1);
1055 10 : temp = gel(MCS,k-1);
1056 10 : gel(MCS,k-1) = gadd(gel(MCS,k), vecmul(muf,gel(MCS,k-1)));
1057 10 : gel(MCS,k) = gsub(vecmul(vecdiv(gel(B,k),Bf), temp),
1058 10 : vecmul(gcoeff(mu,k,k-1), gel(MCS,k)));
1059 10 : gel(B,k) = vecmul(gel(B,k),p1);
1060 10 : gel(B,k-1) = Bf;
1061 10 : for (i=k+1; i<=kmax; i++)
1062 : {
1063 0 : temp = gcoeff(mu,i,k);
1064 0 : gcoeff(mu,i,k) = gsub(gcoeff(mu,i,k-1), vecmul(muf, gcoeff(mu,i,k)));
1065 0 : gcoeff(mu,i,k-1) = gadd(temp, vecmul(gcoeff(mu,k,k-1),gcoeff(mu,i,k)));
1066 : }
1067 10 : return 1;
1068 : }
1069 :
1070 : static GEN
1071 10 : rnfT2(GEN nf, GEN pol, long prec)
1072 : {
1073 10 : long ru, i, a, b, n = degpol(pol);
1074 10 : GEN T2, ropow, RO = nf_all_roots(nf, pol, prec);
1075 :
1076 10 : if (!RO) return NULL;
1077 10 : ru = lg(RO); T2 = cgetg(ru, t_VEC);
1078 10 : ropow = cgetg(n+1,t_MAT); gel(ropow,1) = const_col(n, gen_1);
1079 30 : for (i = 1; i < ru; i++)
1080 : {
1081 20 : GEN conjropow, ro = gel(RO,i), m = cgetg(n+1, t_MAT);
1082 120 : for (a = 2; a <= n; a++) gel(ropow,a) = vecmul(ro, gel(ropow,a-1));
1083 20 : conjropow = conj_i(ropow);
1084 140 : for (b = 1; b <= n; b++)
1085 : {
1086 120 : gel(m,b) = cgetg(n+1, t_COL);
1087 630 : for (a = 1; a <= b; a++)
1088 : {
1089 510 : GEN s = RgV_dotproduct(gel(conjropow,a), gel(ropow,b));
1090 510 : if (b == a)
1091 120 : gcoeff(m, b, b) = real_i(s);
1092 : else
1093 : {
1094 390 : gcoeff(m, a, b) = s;
1095 390 : gcoeff(m, b, a) = conj_i(s);
1096 : }
1097 : }
1098 : }
1099 20 : gel(T2,i) = m;
1100 : }
1101 10 : return T2;
1102 : }
1103 :
1104 : /* Given a polynomial pol with coefficients in nf and an order as output by
1105 : * rnfpseudobasis, outputs a reduced order. */
1106 : GEN
1107 10 : rnflllgram(GEN nf, GEN pol, GEN order, long prec)
1108 : {
1109 10 : pari_sp av = avma;
1110 10 : long j, k, l, kmax, r1, lx, count = 0;
1111 10 : GEN H = NULL, M, I, U, T2, MC, MCS, B, mu;
1112 10 : const long alpha = 10, MAX_COUNT = 4;
1113 :
1114 10 : nf = checknf(nf); r1 = nf_get_r1(nf);
1115 10 : check_ZKmodule(order, "rnflllgram");
1116 10 : M = gel(order,1);
1117 10 : I = gel(order,2); lx = lg(I);
1118 10 : if (lx < 3) return gcopy(order);
1119 10 : if (lx-1 != degpol(pol)) pari_err_DIM("rnflllgram");
1120 10 : I = leafcopy(I);
1121 10 : MCS = matid(lx-1); /* dummy for GC */
1122 10 : PRECNF:
1123 10 : if (count == MAX_COUNT)
1124 : {
1125 0 : prec = precdbl(prec); count = 0;
1126 0 : if (DEBUGLEVEL) pari_warn(warnprec,"rnflllgram",prec);
1127 0 : nf = nfnewprec_shallow(nf,prec);
1128 : }
1129 10 : T2 = rnfT2(nf, pol, prec);
1130 10 : if (!T2) { count = MAX_COUNT; goto PRECNF; }
1131 10 : U = NULL;
1132 10 : PRECPB:
1133 10 : if (U)
1134 : { /* precision problem, recompute. If no progress, increase nf precision */
1135 0 : if (++count == MAX_COUNT || RgM_isidentity(U)) {count = MAX_COUNT; goto PRECNF;}
1136 0 : H = H? nfM_mul(nf, H, U): U;
1137 0 : M = nfM_mul(nf, M, U);
1138 : }
1139 10 : U = matid(lx-1);
1140 10 : MC = mattocomplex(nf, M);
1141 10 : mu = cgetg(lx,t_MAT);
1142 10 : B = cgetg(lx,t_COL);
1143 70 : for (j=1; j<lx; j++)
1144 : {
1145 60 : gel(mu,j) = zerocol(lx - 1);
1146 60 : gel(B,j) = gen_0;
1147 : }
1148 10 : if (DEBUGLEVEL) err_printf("k = ");
1149 10 : gel(B,1) = rnfscal(T2,gel(MC,1),gel(MC,1));
1150 10 : gel(MCS,1) = gel(MC,1);
1151 10 : kmax = 1; k = 2;
1152 : do
1153 : {
1154 70 : GEN Ik_inv = idealinv(nf, gel(I,k));
1155 70 : if (DEBUGLEVEL) err_printf("%ld ",k);
1156 70 : if (k > kmax)
1157 : { /* Incremental Gram-Schmidt */
1158 50 : kmax = k; gel(MCS,k) = gel(MC,k);
1159 245 : for (j=1; j<k; j++)
1160 : {
1161 195 : gcoeff(mu,k,j) = vecdiv(rnfscal(T2,gel(MCS,j),gel(MC,k)), gel(B,j));
1162 195 : gel(MCS,k) = gsub(gel(MCS,k), vecmul(gcoeff(mu,k,j),gel(MCS,j)));
1163 : }
1164 50 : gel(B,k) = rnfscal(T2,gel(MCS,k),gel(MCS,k));
1165 50 : if (check_0(gel(B,k))) goto PRECPB;
1166 : }
1167 70 : if (!RED(k, k-1, U, mu, MC, nf, idealmul(nf, gel(I,k-1), Ik_inv)))
1168 0 : goto PRECPB;
1169 70 : if (do_SWAP(I,MC,MCS,U,mu,B,kmax,k,alpha, r1))
1170 : {
1171 10 : if (!B[k]) goto PRECPB;
1172 10 : if (k > 2) k--;
1173 : }
1174 : else
1175 : {
1176 250 : for (l=k-2; l; l--)
1177 190 : if (!RED(k, l, U, mu, MC, nf, idealmul(nf, gel(I,l), Ik_inv)))
1178 0 : goto PRECPB;
1179 60 : k++;
1180 : }
1181 70 : if (gc_needed(av,2))
1182 : {
1183 0 : if(DEBUGMEM>1) pari_warn(warnmem,"rnflllgram");
1184 0 : (void)gc_all(av, H?10:9, &nf,&T2,&U,&M,&B,&MC,&MCS,&mu,&I,&H);
1185 : }
1186 : }
1187 70 : while (k < lx);
1188 10 : M = nfM_mul(nf, M, U);
1189 10 : if (H) U = nfM_mul(nf, H, U);
1190 10 : if (DEBUGLEVEL) err_printf("\n");
1191 10 : return gc_GEN(av, mkvec2(mkvec2(M,I), U));
1192 : }
1193 :
1194 : GEN
1195 5 : rnfpolred(GEN nf, GEN pol, long prec)
1196 : {
1197 5 : pari_sp av = avma;
1198 5 : long i, j, n, v = varn(pol);
1199 5 : GEN id, w, I, O, nfpol, bnf = checkbnf_i(nf);
1200 :
1201 5 : if (typ(pol)!=t_POL) pari_err_TYPE("rnfpolred",pol);
1202 5 : nf = bnf? bnf_get_nf(bnf): checknf(nf);
1203 5 : if (degpol(pol) <= 1) { w = cgetg(2, t_VEC); gel(w,1) = pol_x(v); return w; }
1204 5 : nfpol = nf_get_pol(nf);
1205 :
1206 5 : id = rnfpseudobasis(nf,pol);
1207 5 : if (bnf && is_pm1( bnf_get_no(bnf) )) /* if bnf is principal */
1208 : {
1209 : GEN newI, newO;
1210 0 : O = gel(id,1);
1211 0 : I = gel(id,2); n = lg(I)-1;
1212 0 : newI = cgetg(n+1,t_VEC);
1213 0 : newO = cgetg(n+1,t_MAT);
1214 0 : for (j=1; j<=n; j++)
1215 : {
1216 0 : GEN al = gen_if_principal(bnf,gel(I,j));
1217 0 : gel(newI,j) = gen_1;
1218 0 : gel(newO,j) = nfC_nf_mul(nf, gel(O,j), al);
1219 : }
1220 0 : id = mkvec2(newO, newI);
1221 : }
1222 :
1223 5 : id = gel(rnflllgram(nf,pol,id,prec),1);
1224 5 : O = gel(id,1);
1225 5 : I = gel(id,2); n = lg(I)-1;
1226 5 : w = cgetg(n+1,t_VEC);
1227 5 : pol = lift_shallow(pol);
1228 50 : for (j=1; j<=n; j++)
1229 : {
1230 45 : GEN newpol, L, a, Ij = gel(I,j);
1231 45 : a = RgC_Rg_mul(gel(O,j), (typ(Ij) == t_MAT)? gcoeff(Ij,1,1): Ij);
1232 450 : for (i=n; i; i--) gel(a,i) = nf_to_scalar_or_alg(nf, gel(a,i));
1233 45 : a = RgV_to_RgX(a, v);
1234 45 : newpol = RgXQX_red(RgXQ_charpoly(a, pol, v), nfpol);
1235 45 : newpol = Q_primpart(newpol);
1236 :
1237 45 : (void)nfgcd_all(newpol, RgX_deriv(newpol), nfpol, nf_get_index(nf), &newpol);
1238 45 : L = leading_coeff(newpol);
1239 45 : gel(w,j) = (typ(L) == t_POL)? RgXQX_div(newpol, L, nfpol)
1240 45 : : RgX_Rg_div(newpol, L);
1241 : }
1242 5 : return gc_GEN(av,w);
1243 : }
1244 :
1245 : /*******************************************************************/
1246 : /* */
1247 : /* LINEAR ALGEBRA OVER Z_K (HNF,SNF) */
1248 : /* */
1249 : /*******************************************************************/
1250 : /* A torsion-free module M over Z_K is given by [A,I].
1251 : * I=[a_1,...,a_k] is a row vector of k fractional ideals given in HNF.
1252 : * A is an n x k matrix (same k) such that if A_j is the j-th column of A then
1253 : * M=a_1 A_1+...+a_k A_k. We say that [A,I] is a pseudo-basis if k=n */
1254 :
1255 : /* Given an element x and an ideal I in HNF, gives an r such that x-r is in H
1256 : * and r is small */
1257 : GEN
1258 6 : nfreduce(GEN nf, GEN x, GEN I)
1259 : {
1260 6 : pari_sp av = avma;
1261 6 : x = nf_to_scalar_or_basis(checknf(nf), x);
1262 6 : if (idealtyp(&I, NULL) != id_MAT || lg(I)==1) pari_err_TYPE("nfreduce",I);
1263 6 : if (typ(x) != t_COL) x = scalarcol( gmod(x, gcoeff(I,1,1)), lg(I)-1 );
1264 6 : else x = reducemodinvertible(x, I);
1265 6 : return gc_upto(av, x);
1266 : }
1267 : /* Given an element x and an ideal in HNF, gives an a in ideal such that
1268 : * x-a is small. No checks */
1269 : static GEN
1270 18820 : element_close(GEN nf, GEN x, GEN ideal)
1271 : {
1272 18820 : pari_sp av = avma;
1273 18820 : GEN y = gcoeff(ideal,1,1);
1274 18820 : x = nf_to_scalar_or_basis(nf, x);
1275 18820 : if (typ(y) == t_INT && is_pm1(y)) return ground(x);
1276 17003 : if (typ(x) == t_COL)
1277 7117 : x = closemodinvertible(x, ideal);
1278 : else
1279 9886 : x = gmul(y, gdivround(x,y));
1280 17003 : return gc_upto(av, x);
1281 : }
1282 :
1283 : /* A + v B */
1284 : static GEN
1285 63505 : colcomb1(GEN nf, GEN v, GEN A, GEN B)
1286 : {
1287 63505 : if (isintzero(v)) return A;
1288 42268 : return RgC_to_nfC(nf, RgC_add(A, nfC_nf_mul(nf,B,v)));
1289 : }
1290 : /* u A + v B */
1291 : static GEN
1292 50304 : colcomb(GEN nf, GEN u, GEN v, GEN A, GEN B)
1293 : {
1294 50304 : if (isintzero(u)) return nfC_nf_mul(nf,B,v);
1295 44670 : if (u != gen_1) A = nfC_nf_mul(nf,A,u);
1296 44670 : return colcomb1(nf, v, A, B);
1297 : }
1298 :
1299 : /* return m[i,1..lim] * x */
1300 : static GEN
1301 234 : element_mulvecrow(GEN nf, GEN x, GEN m, long i, long lim)
1302 : {
1303 234 : long j, l = minss(lg(m), lim+1);
1304 234 : GEN dx, y = cgetg(l, t_VEC);
1305 234 : x = nf_to_scalar_or_basis(nf, x);
1306 234 : if (typ(x) == t_COL)
1307 : {
1308 68 : x = zk_multable(nf, Q_remove_denom(x, &dx));
1309 261 : for (j=1; j<l; j++)
1310 : {
1311 193 : GEN t = gcoeff(m,i,j);
1312 193 : if (!isintzero(t))
1313 : {
1314 83 : if (typ(t) == t_COL)
1315 20 : t = RgM_RgC_mul(x, t);
1316 : else
1317 63 : t = ZC_Q_mul(gel(x,1), t);
1318 83 : if (dx) t = gdiv(t, dx);
1319 83 : t = nf_to_scalar_or_basis(nf,t);
1320 : }
1321 193 : gel(y,j) = t;
1322 : }
1323 : }
1324 : else
1325 : {
1326 582 : for (j=1; j<l; j++) gel(y,j) = gmul(x, gcoeff(m,i,j));
1327 : }
1328 234 : return y;
1329 : }
1330 :
1331 : /* u Z[s,] + v Z[t,], limitied to the first lim entries */
1332 : static GEN
1333 146 : rowcomb(GEN nf, GEN u, GEN v, long s, long t, GEN Z, long lim)
1334 : {
1335 : GEN z;
1336 146 : if (gequal0(u))
1337 5 : z = element_mulvecrow(nf,v,Z,t, lim);
1338 : else
1339 : {
1340 141 : z = element_mulvecrow(nf,u,Z,s, lim);
1341 141 : if (!gequal0(v)) z = gadd(z, element_mulvecrow(nf,v,Z,t, lim));
1342 : }
1343 146 : return z;
1344 : }
1345 :
1346 : /* nfbezout(0,b,A,B). Either bB = NULL or b*B */
1347 : static GEN
1348 30745 : zero_nfbezout(GEN nf,GEN bB, GEN b, GEN A,GEN B,GEN *u,GEN *v,GEN *w,GEN *di)
1349 : {
1350 : GEN d;
1351 30745 : if (isint1(b))
1352 : {
1353 28832 : *v = gen_1;
1354 28832 : *w = A;
1355 28832 : d = B;
1356 28832 : *di = idealinv(nf,d);
1357 : }
1358 : else
1359 : {
1360 1913 : *v = nfinv(nf,b);
1361 1913 : *w = idealmul(nf,A,*v);
1362 1913 : d = bB? bB: idealmul(nf,b,B);
1363 1913 : *di = idealHNF_inv(nf,d);
1364 : }
1365 30745 : *u = gen_0; return d;
1366 : }
1367 :
1368 : /* Given elements a,b and ideals A, B, outputs d = a.A+b.B and gives
1369 : * di=d^-1, w=A.B.di, u, v such that au+bv=1 and u in A.di, v in B.di.
1370 : * Assume A, B nonzero, but a or b can be zero (not both) */
1371 : static GEN
1372 34428 : nfbezout(GEN nf,GEN a,GEN b, GEN A,GEN B, GEN *pu,GEN *pv,GEN *pw,GEN *pdi,
1373 : int red)
1374 : {
1375 : GEN w, u, v, d, di, aA, bB;
1376 :
1377 34428 : if (isintzero(a)) return zero_nfbezout(nf,NULL,b,A,B,pu,pv,pw,pdi);
1378 34428 : if (isintzero(b)) return zero_nfbezout(nf,NULL,a,B,A,pv,pu,pw,pdi);
1379 :
1380 34428 : if (a != gen_1) /* frequently called with a = gen_1 */
1381 : {
1382 20834 : a = nf_to_scalar_or_basis(nf,a);
1383 20834 : if (isint1(a)) a = gen_1;
1384 : }
1385 34428 : aA = (a == gen_1)? idealhnf_shallow(nf,A): idealmul(nf,a,A);
1386 34428 : bB = idealmul(nf,b,B);
1387 34428 : d = idealadd(nf,aA,bB);
1388 34428 : if (gequal(aA, d)) return zero_nfbezout(nf,d, a,B,A,pv,pu,pw,pdi);
1389 16324 : if (gequal(bB, d)) return zero_nfbezout(nf,d, b,A,B,pu,pv,pw,pdi);
1390 : /* general case is slow */
1391 3683 : di = idealHNF_inv(nf,d);
1392 3683 : aA = idealmul(nf,aA,di); /* integral */
1393 3683 : bB = idealmul(nf,bB,di); /* integral */
1394 :
1395 3683 : u = red? idealaddtoone_i(nf, aA, bB): idealaddtoone_raw(nf, aA, bB);
1396 3683 : w = idealmul(nf,aA,B);
1397 3683 : v = nfdiv(nf, nfsub(nf, gen_1, u), b);
1398 3683 : if (a != gen_1)
1399 : {
1400 1505 : GEN inva = nfinv(nf, a);
1401 1505 : u = nfmul(nf,u,inva);
1402 1505 : w = idealmul(nf, inva, w); /* AB/d */
1403 : }
1404 3683 : *pu = u; *pv = v; *pw = w; *pdi = di; return d;
1405 : }
1406 : /* v a vector of ideals, simplify in place the ones generated by elts of Q */
1407 : static void
1408 4551 : idV_simplify(GEN v)
1409 : {
1410 4551 : long i, l = lg(v);
1411 22165 : for (i = 1; i < l; i++)
1412 : {
1413 17614 : GEN M = gel(v,i);
1414 17614 : if (typ(M)==t_MAT && RgM_isscalar(M,NULL))
1415 6270 : gel(v,i) = Q_abs_shallow(gcoeff(M,1,1));
1416 : }
1417 4551 : }
1418 : /* Given a torsion-free module x outputs a pseudo-basis for x in HNF */
1419 : GEN
1420 2219 : nfhnf0(GEN nf, GEN x, long flag)
1421 : {
1422 : long i, j, def, idef, m, n;
1423 2219 : pari_sp av0 = avma, av;
1424 : GEN y, A, I, J, U;
1425 :
1426 2219 : nf = checknf(nf);
1427 2219 : check_ZKmodule(x, "nfhnf");
1428 2219 : A = gel(x,1); RgM_dimensions(A, &m, &n);
1429 2219 : I = gel(x,2);
1430 2219 : if (!n) {
1431 35 : if (!flag) return gcopy(x);
1432 0 : retmkvec2(gcopy(x), cgetg(1,t_MAT));
1433 : }
1434 2184 : U = flag? matid(n): NULL;
1435 2184 : idef = (n < m)? m-n : 0;
1436 2184 : av = avma;
1437 2184 : A = RgM_to_nfM(nf,A);
1438 2184 : I = leafcopy(I);
1439 2184 : J = zerovec(n); def = n;
1440 10530 : for (i=m; i>idef; i--)
1441 : {
1442 8346 : GEN d, di = NULL;
1443 :
1444 8521 : j=def; while (j>=1 && isintzero(gcoeff(A,i,j))) j--;
1445 8346 : if (!j)
1446 : { /* no pivot on line i */
1447 5 : if (idef) idef--;
1448 5 : continue;
1449 : }
1450 8341 : if (j==def) j--;
1451 : else {
1452 45 : swap(gel(A,j), gel(A,def));
1453 45 : swap(gel(I,j), gel(I,def));
1454 45 : if (U) swap(gel(U,j), gel(U,def));
1455 : }
1456 51409 : for ( ; j; j--)
1457 : {
1458 43068 : GEN a,b, u,v,w, S, T, S0, T0 = gel(A,j);
1459 43068 : b = gel(T0,i); if (isintzero(b)) continue;
1460 :
1461 13686 : S0 = gel(A,def); a = gel(S0,i);
1462 13686 : d = nfbezout(nf, a,b, gel(I,def),gel(I,j), &u,&v,&w,&di,1);
1463 13686 : S = colcomb(nf, u,v, S0,T0);
1464 13686 : T = colcomb(nf, a,gneg(b), T0,S0);
1465 13686 : gel(A,def) = S; gel(A,j) = T;
1466 13686 : gel(I,def) = d; gel(I,j) = w;
1467 13686 : if (U)
1468 : {
1469 30 : S0 = gel(U,def);
1470 30 : T0 = gel(U,j);
1471 30 : gel(U,def) = colcomb(nf, u,v, S0,T0);
1472 30 : gel(U,j) = colcomb(nf, a,gneg(b), T0,S0);
1473 : }
1474 : }
1475 8341 : y = gcoeff(A,i,def);
1476 8341 : if (!isint1(y))
1477 : {
1478 455 : GEN yi = nfinv(nf,y);
1479 455 : gel(A,def) = nfC_nf_mul(nf, gel(A,def), yi);
1480 455 : gel(I,def) = idealmul(nf, y, gel(I,def));
1481 455 : if (U) gel(U,def) = nfC_nf_mul(nf, gel(U,def), yi);
1482 455 : di = NULL;
1483 : }
1484 8341 : if (!di) di = idealinv(nf,gel(I,def));
1485 8341 : d = gel(I,def);
1486 8341 : gel(J,def) = di;
1487 25669 : for (j=def+1; j<=n; j++)
1488 : {
1489 17328 : GEN mc, c = gcoeff(A,i,j); if (isintzero(c)) continue;
1490 8855 : c = element_close(nf, c, idealmul(nf,d,gel(J,j)));
1491 8855 : mc = gneg(c);
1492 8855 : gel(A,j) = colcomb1(nf, mc, gel(A,j),gel(A,def));
1493 8855 : if (U) gel(U,j) = colcomb1(nf, mc, gel(U,j),gel(U,def));
1494 : }
1495 8341 : def--;
1496 8341 : if (gc_needed(av,2))
1497 : {
1498 0 : if(DEBUGMEM>1) pari_warn(warnmem,"nfhnf, i = %ld", i);
1499 0 : (void)gc_all(av,U?4:3, &A,&I,&J,&U);
1500 : }
1501 : }
1502 2184 : n -= def;
1503 2184 : A += def; A[0] = evaltyp(t_MAT)|_evallg(n+1);
1504 2184 : I += def; I[0] = evaltyp(t_VEC)|_evallg(n+1);
1505 2184 : idV_simplify(I);
1506 2184 : x = mkvec2(A,I);
1507 2184 : if (U) x = mkvec2(x,U);
1508 2184 : return gc_GEN(av0, x);
1509 : }
1510 :
1511 : GEN
1512 2208 : nfhnf(GEN nf, GEN x) { return nfhnf0(nf, x, 0); }
1513 :
1514 : static long
1515 10 : RgV_find_denom(GEN x)
1516 : {
1517 10 : long i, l = lg(x);
1518 10 : for (i = 1; i < l; i++)
1519 10 : if (Q_denom(gel(x,i)) != gen_1) return i;
1520 0 : return 0;
1521 : }
1522 : /* A torsion module M over Z_K will be given by a row vector [A,I,J] with
1523 : * three components. I=[b_1,...,b_n] is a row vector of n fractional ideals
1524 : * given in HNF, J=[a_1,...,a_n] is a row vector of n fractional ideals in
1525 : * HNF. A is an nxn matrix (same n) such that if A_j is the j-th column of A
1526 : * and e_n is the canonical basis of K^n, then
1527 : * M=(b_1e_1+...+b_ne_n)/(a_1A_1+...a_nA_n) */
1528 :
1529 : /* x=[A,I,J] a torsion module as above. Output the
1530 : * smith normal form as K=[c_1,...,c_n] such that x = Z_K/c_1+...+Z_K/c_n */
1531 : GEN
1532 36 : nfsnf0(GEN nf, GEN x, long flag)
1533 : {
1534 : long i, j, k, l, n, m;
1535 : pari_sp av;
1536 : GEN z,u,v,w,d,dinv,A,I,J, U,V;
1537 :
1538 36 : nf = checknf(nf);
1539 36 : if (typ(x)!=t_VEC || lg(x)!=4) pari_err_TYPE("nfsnf",x);
1540 36 : A = gel(x,1);
1541 36 : I = gel(x,2);
1542 36 : J = gel(x,3);
1543 36 : if (typ(A)!=t_MAT) pari_err_TYPE("nfsnf",A);
1544 36 : n = lg(A)-1;
1545 36 : if (typ(I)!=t_VEC) pari_err_TYPE("nfsnf",I);
1546 36 : if (typ(J)!=t_VEC) pari_err_TYPE("nfsnf",J);
1547 36 : if (lg(I)!=n+1 || lg(J)!=n+1) pari_err_DIM("nfsnf");
1548 36 : RgM_dimensions(A, &m, &n);
1549 36 : if (!n || n != m) pari_err_IMPL("nfsnf for empty or non square matrices");
1550 :
1551 36 : av = avma;
1552 36 : if (!flag) U = V = NULL;
1553 : else
1554 : {
1555 15 : U = matid(m);
1556 15 : V = matid(n);
1557 : }
1558 36 : A = RgM_to_nfM(nf, A);
1559 36 : I = leafcopy(I);
1560 36 : J = leafcopy(J);
1561 124 : for (i = 1; i <= n; i++) gel(J,i) = idealinv(nf, gel(J,i));
1562 36 : z = zerovec(n);
1563 176 : for (i=n; i>=1; i--)
1564 : {
1565 : GEN Aii, a, b, db;
1566 140 : long c = 0;
1567 281 : for (j=i-1; j>=1; j--)
1568 : {
1569 141 : GEN S, T, S0, T0 = gel(A,j);
1570 141 : b = gel(T0,i); if (gequal0(b)) continue;
1571 :
1572 48 : S0 = gel(A,i); a = gel(S0,i);
1573 48 : d = nfbezout(nf, a,b, gel(J,i),gel(J,j), &u,&v,&w,&dinv,1);
1574 48 : S = colcomb(nf, u,v, S0,T0);
1575 48 : T = colcomb(nf, a,gneg(b), T0,S0);
1576 48 : gel(A,i) = S; gel(A,j) = T;
1577 48 : gel(J,i) = d; gel(J,j) = w;
1578 48 : if (V)
1579 : {
1580 20 : T0 = gel(V,j);
1581 20 : S0 = gel(V,i);
1582 20 : gel(V,i) = colcomb(nf, u,v, S0,T0);
1583 20 : gel(V,j) = colcomb(nf, a,gneg(b), T0,S0);
1584 : }
1585 : }
1586 281 : for (j=i-1; j>=1; j--)
1587 : {
1588 : GEN ri, rj;
1589 141 : b = gcoeff(A,j,i); if (gequal0(b)) continue;
1590 :
1591 53 : a = gcoeff(A,i,i);
1592 53 : d = nfbezout(nf, a,b, gel(I,i),gel(I,j), &u,&v,&w,&dinv,1);
1593 53 : ri = rowcomb(nf, u,v, i,j, A, i);
1594 53 : rj = rowcomb(nf, a,gneg(b), j,i, A, i);
1595 191 : for (k=1; k<=i; k++) {
1596 138 : gcoeff(A,j,k) = gel(rj,k);
1597 138 : gcoeff(A,i,k) = gel(ri,k);
1598 : }
1599 53 : if (U)
1600 : {
1601 20 : ri = rowcomb(nf, u,v, i,j, U, m);
1602 20 : rj = rowcomb(nf, a,gneg(b), j,i, U, m);
1603 75 : for (k=1; k<=m; k++) {
1604 55 : gcoeff(U,j,k) = gel(rj,k);
1605 55 : gcoeff(U,i,k) = gel(ri,k);
1606 : }
1607 : }
1608 53 : gel(I,i) = d; gel(I,j) = w; c = 1;
1609 : }
1610 140 : if (c) { i++; continue; }
1611 :
1612 98 : Aii = gcoeff(A,i,i); if (gequal0(Aii)) continue;
1613 98 : gel(J,i) = idealmul(nf, gel(J,i), Aii);
1614 98 : gcoeff(A,i,i) = gen_1;
1615 98 : if (V) gel(V,i) = nfC_nf_mul(nf, gel(V,i), nfinv(nf,Aii));
1616 98 : gel(z,i) = idealmul(nf,gel(J,i),gel(I,i));
1617 98 : b = Q_remove_denom(gel(z,i), &db);
1618 176 : for (k=1; k<i; k++)
1619 178 : for (l=1; l<i; l++)
1620 : {
1621 110 : GEN d, D, p1, p2, p3, Akl = gcoeff(A,k,l);
1622 : long t;
1623 110 : if (gequal0(Akl)) continue;
1624 :
1625 100 : p1 = idealmul(nf,Akl,gel(J,l));
1626 100 : p3 = idealmul(nf, p1, gel(I,k));
1627 100 : if (db) p3 = RgM_Rg_mul(p3, db);
1628 100 : if (RgM_is_ZM(p3) && hnfdivide(b, p3)) continue;
1629 :
1630 : /* find d in D = I[k]/I[i] not in J[i]/(A[k,l] J[l]) */
1631 10 : D = idealdiv(nf,gel(I,k),gel(I,i));
1632 10 : p2 = idealdiv(nf,gel(J,i), p1);
1633 10 : t = RgV_find_denom(QM_gauss(p2, D));
1634 10 : if (!t) pari_err_BUG("nfsnf");
1635 10 : d = gel(D,t);
1636 10 : p1 = element_mulvecrow(nf,d,A,k,i);
1637 30 : for (t=1; t<=i; t++) gcoeff(A,i,t) = gadd(gcoeff(A,i,t),gel(p1,t));
1638 10 : if (U)
1639 : {
1640 5 : p1 = element_mulvecrow(nf,d,U,k,i);
1641 15 : for (t=1; t<=i; t++) gcoeff(U,i,t) = gadd(gcoeff(U,i,t),gel(p1,t));
1642 : }
1643 :
1644 10 : k = i; c = 1; break;
1645 : }
1646 98 : if (gc_needed(av,1))
1647 : {
1648 0 : if(DEBUGMEM>1) pari_warn(warnmem,"nfsnf");
1649 0 : (void)gc_all(av,U?6:4, &A,&I,&J,&z,&U,&V);
1650 : }
1651 98 : if (c) i++; /* iterate on row/column i */
1652 : }
1653 36 : if (U) z = mkvec3(z,U,V);
1654 36 : return gc_GEN(av, z);
1655 : }
1656 : GEN
1657 0 : nfsnf(GEN nf, GEN x) { return nfsnf0(nf,x,0); }
1658 :
1659 : /* Given a pseudo-basis x, outputs a multiple of its ideal determinant */
1660 : GEN
1661 819 : nfdetint(GEN nf, GEN x)
1662 : {
1663 : GEN pass,c,v,det1,piv,pivprec,vi,p1,A,I,id,idprod;
1664 819 : long i, j, k, rg, n, m, m1, cm=0, N;
1665 819 : pari_sp av = avma, av1;
1666 :
1667 819 : nf = checknf(nf); N = nf_get_degree(nf);
1668 819 : check_ZKmodule(x, "nfdetint");
1669 819 : A = gel(x,1);
1670 819 : I = gel(x,2);
1671 819 : n = lg(A)-1; if (!n) return gen_1;
1672 :
1673 819 : m1 = lgcols(A); m = m1-1;
1674 819 : id = matid(N);
1675 3411 : c = new_chunk(m1); for (k=1; k<=m; k++) c[k] = 0;
1676 819 : piv = pivprec = gen_1;
1677 :
1678 819 : av1 = avma;
1679 819 : det1 = idprod = gen_0; /* dummy for (void)gc_all */
1680 819 : pass = cgetg(m1,t_MAT);
1681 819 : v = cgetg(m1,t_COL);
1682 3411 : for (j=1; j<=m; j++)
1683 : {
1684 2592 : gel(pass,j) = zerocol(m);
1685 2592 : gel(v,j) = gen_0; /* dummy */
1686 : }
1687 4540 : for (rg=0,k=1; k<=n; k++)
1688 : {
1689 3721 : long t = 0;
1690 19923 : for (i=1; i<=m; i++)
1691 16202 : if (!c[i])
1692 : {
1693 8248 : vi=nfmul(nf,piv,gcoeff(A,i,k));
1694 58326 : for (j=1; j<=m; j++)
1695 50078 : if (c[j]) vi=gadd(vi,nfmul(nf,gcoeff(pass,i,j),gcoeff(A,j,k)));
1696 8248 : gel(v,i) = vi; if (!t && !gequal0(vi)) t=i;
1697 : }
1698 3721 : if (t)
1699 : {
1700 3673 : pivprec = piv;
1701 3673 : if (rg == m-1)
1702 : {
1703 1900 : if (!cm)
1704 : {
1705 819 : cm=1; idprod = id;
1706 3411 : for (i=1; i<=m; i++)
1707 2592 : if (i!=t)
1708 1773 : idprod = (idprod==id)? gel(I,c[i])
1709 1773 : : idealmul(nf,idprod,gel(I,c[i]));
1710 : }
1711 1900 : p1 = idealmul(nf,gel(v,t),gel(I,k)); c[t]=0;
1712 1900 : det1 = (typ(det1)==t_INT)? p1: idealadd(nf,p1,det1);
1713 : }
1714 : else
1715 : {
1716 1773 : rg++; piv=gel(v,t); c[t]=k;
1717 10827 : for (i=1; i<=m; i++)
1718 9054 : if (!c[i])
1719 : {
1720 38403 : for (j=1; j<=m; j++)
1721 33876 : if (c[j] && j!=t)
1722 : {
1723 8274 : p1 = gsub(nfmul(nf,piv,gcoeff(pass,i,j)),
1724 8274 : nfmul(nf,gel(v,i),gcoeff(pass,t,j)));
1725 8274 : gcoeff(pass,i,j) = rg>1? nfdiv(nf,p1,pivprec)
1726 8274 : : p1;
1727 : }
1728 4527 : gcoeff(pass,i,t) = gneg(gel(v,i));
1729 : }
1730 : }
1731 : }
1732 3721 : if (gc_needed(av1,1))
1733 : {
1734 0 : if(DEBUGMEM>1) pari_warn(warnmem,"nfdetint");
1735 0 : (void)gc_all(av1,6, &det1,&piv,&pivprec,&pass,&v,&idprod);
1736 : }
1737 : }
1738 819 : if (!cm) retgc_const(av, cgetg(1, t_MAT));
1739 819 : return gc_upto(av, idealmul(nf,idprod,det1));
1740 : }
1741 :
1742 : /* reduce in place components of x[1..lim] mod D (destroy x). D in HNF */
1743 : static void
1744 20255 : nfcleanmod(GEN nf, GEN x, long lim, GEN D)
1745 : {
1746 : GEN DZ, DZ2, dD;
1747 : long i;
1748 20255 : D = Q_remove_denom(D, &dD);
1749 20255 : DZ = gcoeff(D,1,1); DZ2 = shifti(DZ, -1);
1750 95692 : for (i = 1; i <= lim; i++)
1751 : {
1752 75437 : GEN c = nf_to_scalar_or_basis(nf, gel(x,i));
1753 75437 : switch(typ(c)) /* c = centermod(c, D) */
1754 : {
1755 55547 : case t_INT:
1756 55547 : if (!signe(c)) break;
1757 30328 : if (dD) c = mulii(c, dD);
1758 30328 : c = centermodii(c, DZ, DZ2);
1759 30328 : if (dD) c = Qdivii(c,dD);
1760 30328 : break;
1761 139 : case t_FRAC: {
1762 139 : GEN dc = gel(c,2), nc = gel(c,1), N = mulii(DZ, dc);
1763 139 : if (dD) nc = mulii(nc, dD);
1764 139 : c = centermodii(nc, N, shifti(N,-1));
1765 139 : c = Qdivii(c, dD ? mulii(dc,dD): dc);
1766 139 : break;
1767 : }
1768 19751 : case t_COL: {
1769 : GEN dc;
1770 19751 : c = Q_remove_denom(c, &dc);
1771 19751 : if (dD) c = ZC_Z_mul(c, dD);
1772 19751 : c = ZC_hnfrem(c, dc? ZM_Z_mul(D,dc): D);
1773 19751 : dc = mul_content(dc, dD);
1774 19751 : if (ZV_isscalar(c))
1775 : {
1776 563 : c = gel(c,1);
1777 563 : if (dc) c = Qdivii(c,dc);
1778 : }
1779 : else
1780 19188 : if (dc) c = RgC_Rg_div(c, dc);
1781 19751 : break;
1782 : }
1783 : }
1784 75437 : gel(x,i) = c;
1785 : }
1786 20255 : }
1787 :
1788 : GEN
1789 2367 : nfhnfmod(GEN nf, GEN x, GEN D)
1790 : {
1791 : long li, co, i, j, def, ldef;
1792 2367 : pari_sp av0=avma, av;
1793 : GEN dA, dI, d0, w, p1, d, u, v, A, I, J, di;
1794 :
1795 2367 : nf = checknf(nf);
1796 2367 : check_ZKmodule(x, "nfhnfmod");
1797 2367 : A = gel(x,1);
1798 2367 : I = gel(x,2);
1799 2367 : co = lg(A); if (co==1) return cgetg(1,t_MAT);
1800 :
1801 2367 : li = lgcols(A);
1802 2367 : if (typ(D)!=t_MAT) D = idealhnf_shallow(nf, D);
1803 2367 : D = Q_remove_denom(D, NULL);
1804 2367 : RgM_check_ZM(D, "nfhnfmod");
1805 :
1806 2367 : av = avma;
1807 2367 : A = RgM_to_nfM(nf, A);
1808 2367 : A = Q_remove_denom(A, &dA);
1809 2367 : I = Q_remove_denom(leafcopy(I), &dI);
1810 2367 : dA = mul_denom(dA,dI);
1811 2367 : if (dA) D = ZM_Z_mul(D, powiu(dA, minss(li,co)));
1812 :
1813 2367 : def = co; ldef = (li>co)? li-co+1: 1;
1814 11640 : for (i=li-1; i>=ldef; i--)
1815 : {
1816 10207 : def--; j=def; while (j>=1 && isintzero(gcoeff(A,i,j))) j--;
1817 9273 : if (!j) continue;
1818 9273 : if (j==def) j--;
1819 : else {
1820 799 : swap(gel(A,j), gel(A,def));
1821 799 : swap(gel(I,j), gel(I,def));
1822 : }
1823 43284 : for ( ; j; j--)
1824 : {
1825 34011 : GEN a, b, S, T, S0, T0 = gel(A,j);
1826 34011 : b = gel(T0,i); if (isintzero(b)) continue;
1827 :
1828 11368 : S0 = gel(A,def); a = gel(S0,i);
1829 11368 : d = nfbezout(nf, a,b, gel(I,def),gel(I,j), &u,&v,&w,&di,0);
1830 11368 : S = colcomb(nf, u,v, S0,T0);
1831 11368 : T = colcomb(nf, a,gneg(b), T0,S0);
1832 11368 : if (u != gen_0 && v != gen_0) /* already reduced otherwise */
1833 1981 : nfcleanmod(nf, S, i, idealmul(nf,D,di));
1834 11368 : nfcleanmod(nf, T, i, idealdiv(nf,D,w));
1835 11368 : gel(A,def) = S; gel(A,j) = T;
1836 11368 : gel(I,def) = d; gel(I,j) = w;
1837 : }
1838 9273 : if (gc_needed(av,2))
1839 : {
1840 0 : if(DEBUGMEM>1) pari_warn(warnmem,"[1]: nfhnfmod, i = %ld", i);
1841 0 : (void)gc_all(av,dA? 4: 3, &A,&I,&D,&dA);
1842 : }
1843 : }
1844 2367 : def--; d0 = D;
1845 2367 : A += def; A[0] = evaltyp(t_MAT)|_evallg(li);
1846 2367 : I += def; I[0] = evaltyp(t_VEC)|_evallg(li);
1847 2367 : J = cgetg(li,t_VEC);
1848 11640 : for (i=li-1; i>=1; i--)
1849 : {
1850 9273 : GEN b = gcoeff(A,i,i);
1851 9273 : d = nfbezout(nf, gen_1,b, d0,gel(I,i), &u,&v,&w,&di,0);
1852 9273 : p1 = nfC_nf_mul(nf,gel(A,i),v);
1853 9273 : if (i > 1)
1854 : {
1855 6906 : d0 = idealmul(nf,d0,di);
1856 6906 : nfcleanmod(nf, p1, i, d0);
1857 : }
1858 9273 : gel(A,i) = p1; gel(p1,i) = gen_1;
1859 9273 : gel(I,i) = d;
1860 9273 : gel(J,i) = di;
1861 : }
1862 9273 : for (i=li-2; i>=1; i--)
1863 : {
1864 6906 : d = gel(I,i);
1865 27749 : for (j=i+1; j<li; j++)
1866 : {
1867 20843 : GEN c = gcoeff(A,i,j); if (isintzero(c)) continue;
1868 9965 : c = element_close(nf, c, idealmul(nf,d,gel(J,j)));
1869 9965 : gel(A,j) = colcomb1(nf, gneg(c), gel(A,j),gel(A,i));
1870 : }
1871 6906 : if (gc_needed(av,2))
1872 : {
1873 0 : if(DEBUGMEM>1) pari_warn(warnmem,"[2]: nfhnfmod, i = %ld", i);
1874 0 : (void)gc_all(av,dA? 4: 3, &A,&I,&J,&dA);
1875 : }
1876 : }
1877 2367 : idV_simplify(I);
1878 2367 : if (dA) I = gdiv(I,dA);
1879 2367 : return gc_GEN(av0, mkvec2(A, I));
1880 : }
1881 :
1882 : static long
1883 0 : decind(GEN nf, GEN p)
1884 : {
1885 0 : pari_sp av = avma;
1886 0 : GEN dec = idealprimedec(nf, p);
1887 0 : long i, l = lg(dec), s = 0;
1888 0 : GEN v = cgetg(l, t_VECSMALL);
1889 0 : for (i=1; i<l; i++)
1890 : {
1891 0 : GEN pr = gel(dec, i);
1892 0 : v[i] = 10*pr_get_e(pr)+pr_get_f(pr);
1893 : }
1894 0 : vecsmall_sort(v);
1895 0 : for (i = 1; i<l; i++)
1896 0 : s = 100*s + v[i];
1897 0 : return gc_long(av, s);
1898 : };
1899 :
1900 : static GEN
1901 0 : K6_pol(GEN P, GEN D)
1902 : {
1903 0 : GEN t = gel(P,5);
1904 0 : GEN P2 = signe(t) ? ZX_Z_translate(ZX_rescale2n(P,2), gneg(t)): P;
1905 0 : GEN D2 = sqri(D), D3 = mulii(D,D2);
1906 0 : GEN a2 = gel(P2, 4), a1 = gel(P2, 3), a0 = gel(P2, 2);
1907 0 : return mkpoln(7,gen_1, gen_0, mulii(D,shifti(a2,1)), gen_0,
1908 : mulii(D2,subii(sqri(a2),shifti(a0,2))), gen_0,
1909 : negi(mulii(D3,sqri(a1))));
1910 : }
1911 :
1912 : static long
1913 0 : decmat(GEN Q, GEN p)
1914 : {
1915 0 : pari_sp av = avma;
1916 0 : GEN dec = ZpX_primedec(Q,p);
1917 0 : long i, l = lgcols(dec), s = 0;
1918 0 : GEN v = cgetg(l, t_VECSMALL);
1919 0 : for (i=1; i<l; i++)
1920 : {
1921 0 : long e = itos(gcoeff(dec,i,1));
1922 0 : long f = itos(gcoeff(dec,i,2));
1923 0 : v[i] = 10*e+f;
1924 : }
1925 0 : vecsmall_sort(v);
1926 0 : for (i = 1; i<l; i++)
1927 0 : s = 100*s + v[i];
1928 0 : return gc_long(av, s);
1929 : }
1930 :
1931 : static long
1932 0 : K6_invar(GEN nf, GEN p)
1933 : {
1934 0 : pari_sp av = avma;
1935 0 : GEN Q1 = K6_pol(nf_get_pol(nf), nf_get_disc(nf));
1936 0 : long s1 = decmat(Q1, p);
1937 0 : return gc_long(av, s1);
1938 : }
1939 :
1940 : static GEN
1941 0 : condliftpS4(GEN nf, GEN p)
1942 : {
1943 0 : GEN disc = nf_get_disc(nf);
1944 : GEN D, D3;
1945 0 : long val = Z_pvalrem(disc, p, &D);
1946 0 : long dec = decind(nf,p);
1947 0 : GEN nf3 = nfinit(nfresolvent(nf_get_pol(nf), 0), nf_get_prec(nf));
1948 0 : long dec3 = decind(nf3,p);
1949 0 : long val3 = Z_pvalrem(nf_get_disc(nf3), p, &D3);
1950 0 : if (DEBUGLEVEL)
1951 0 : err_printf("p=%Ps dec=%ld val=%ld D=%Ps | dec3=%ld val3=%ld D3=%Ps\n",p,dec,val,D,dec3,val3,D3);
1952 0 : switch(itou_or_0(p))
1953 : {
1954 0 : default:
1955 0 : switch(dec)
1956 : {
1957 0 : case 41: /* C4 or D8 */
1958 0 : if (odd(val))
1959 : {
1960 0 : if (Mod4(p)==1)
1961 0 : return mkvecsmall2(1, 0);
1962 : else
1963 0 : return mkvecsmall2(2, 1);
1964 : }
1965 0 : else if (kronecker(D, p)==1)
1966 0 : return mkvecsmall2(1, 0);
1967 : else
1968 0 : return mkvecsmall2(2, 0);
1969 0 : case 1221: /* C2+C2 */
1970 0 : return mkvecsmall2(2, 3);
1971 0 : case 2121:
1972 0 : if (odd(val))
1973 0 : pari_err_BUG("condliftpS4");
1974 0 : if (kronecker(D, p)==1)
1975 0 : return mkvecsmall2(1, 0); /* V4 */
1976 : else
1977 0 : return mkvecsmall2(2, 2); /* D8 */
1978 0 : case 1131:
1979 0 : if (odd(val))
1980 0 : pari_err_BUG("condliftpS4");
1981 0 : if (kronecker(D, p)==1)
1982 0 : return mkvecsmall2(1, 0); /* C3 */
1983 : else
1984 0 : return mkvecsmall2(2, 0); /* D6 */
1985 0 : case 22:
1986 0 : if (odd(val))
1987 0 : pari_err_BUG("condliftpS4");
1988 0 : if (kronecker(D, p)==1)
1989 0 : return mkvecsmall2(2, 2);
1990 : else
1991 0 : return mkvecsmall2(1, 0);
1992 0 : case 111121: /* C2 */
1993 0 : return mkvecsmall2(1, 0);
1994 0 : default:
1995 0 : pari_err_BUG("condliftpS4");
1996 : }
1997 0 : case 3:
1998 0 : switch(val)
1999 : {
2000 0 : case 1:
2001 0 : switch(dec)
2002 : {
2003 0 : case 1221:
2004 0 : return mkvecsmall2(2, 3);
2005 0 : case 111121:
2006 0 : return mkvecsmall2(1, 0);
2007 0 : default:
2008 0 : pari_err_BUG("condliftpS4");
2009 : }
2010 0 : case 2:
2011 0 : switch(dec)
2012 : {
2013 0 : case 22:
2014 : {
2015 0 : switch(dec3)
2016 : {
2017 0 : case 1112:
2018 0 : return mkvecsmall2(1, 0);
2019 0 : case 111111:
2020 0 : return mkvecsmall2(2, 2);
2021 0 : default:
2022 0 : pari_err_BUG("condliftpS4");
2023 : }
2024 : }
2025 0 : case 2121:
2026 0 : if (odd(val))
2027 0 : pari_err_BUG("condliftpS4");
2028 0 : if (kronecker(D, p)==1)
2029 0 : return mkvecsmall2(1, 0); /* C3 */
2030 : else
2031 0 : return mkvecsmall2(2, 2); /* D6 */
2032 0 : default:
2033 0 : pari_err_BUG("condliftpS4");
2034 : }
2035 0 : case 3:
2036 0 : switch(dec)
2037 : {
2038 0 : case 41:
2039 0 : return mkvecsmall2(2, 1);
2040 0 : case 1131:
2041 0 : return mkvecsmall2(3, 0);
2042 0 : default:
2043 0 : pari_err_BUG("condliftpS4");
2044 : }
2045 0 : case 4:
2046 0 : if (dec!=1131) pari_err_BUG("condliftpS4");
2047 0 : if (odd(val))
2048 0 : pari_err_BUG("condliftpS4");
2049 0 : if (kronecker(D, p)==1)
2050 0 : return mkvecsmall2(2, 0); /* C3 */
2051 : else
2052 0 : return mkvecsmall2(4, 0); /* D6 */
2053 0 : case 5:
2054 0 : if (dec!=1131) pari_err_BUG("condliftpS4");
2055 0 : return mkvecsmall2(5, 0);
2056 0 : default:
2057 0 : pari_err_BUG("condliftpS4");
2058 : }
2059 0 : case 2:
2060 0 : switch(val)
2061 : {
2062 0 : case 2:
2063 0 : switch(dec)
2064 : {
2065 0 : case 1131:
2066 0 : return mkvecsmall2(2, 0);
2067 0 : case 1221:
2068 0 : return mkvecsmall2(4, 6);
2069 0 : case 111121:
2070 0 : return mkvecsmall2(2, 0);
2071 0 : default:
2072 0 : pari_err_BUG("condliftpS4");
2073 : }
2074 0 : case 3:
2075 0 : switch(dec)
2076 : {
2077 0 : case 1221:
2078 0 : return mkvecsmall2(6, 9);
2079 0 : case 111121:
2080 0 : return mkvecsmall2(3, 0);
2081 0 : default:
2082 0 : pari_err_BUG("condliftpS4");
2083 : }
2084 0 : case 4:
2085 0 : switch(dec)
2086 : {
2087 0 : case 22:
2088 0 : switch(Mod8(D))
2089 : {
2090 0 : case 1:
2091 0 : return mkvecsmall2(4, 4);
2092 0 : case 5:
2093 0 : return mkvecsmall2(2, 0);
2094 0 : case 3: case 7:
2095 0 : return mkvecsmall2(5, 6);
2096 0 : default:
2097 0 : pari_err_BUG("condliftpS4");
2098 : }
2099 0 : case 41:
2100 0 : return mkvecsmall2(3, 2);
2101 0 : case 2121:
2102 0 : switch(Mod8(D))
2103 : {
2104 0 : case 1:
2105 0 : return mkvecsmall2(2, 0);
2106 0 : case 5:
2107 0 : return mkvecsmall2(4, 4);
2108 0 : default:
2109 0 : pari_err_BUG("condliftpS4");
2110 : }
2111 0 : default:
2112 0 : pari_err_BUG("condliftpS4");
2113 : }
2114 0 : case 5:
2115 0 : if (dec!=2121) pari_err_BUG("condliftpS4");
2116 0 : return mkvecsmall2(7, 9);
2117 0 : case 6:
2118 0 : switch(dec)
2119 : {
2120 0 : case 2121:
2121 0 : switch(Mod8(D))
2122 : {
2123 0 : case 1:
2124 0 : return mkvecsmall2(3, 0);
2125 0 : case 3:
2126 0 : return mkvecsmall2(7, 8);
2127 0 : case 5:
2128 0 : return mkvecsmall2(6, 6);
2129 0 : case 7:
2130 0 : return mkvecsmall2(7, 8);
2131 0 : default:
2132 0 : pari_err_BUG("condliftpS4");
2133 : }
2134 0 : case 22:
2135 0 : switch(Mod8(D))
2136 : {
2137 0 : case 1:
2138 0 : return mkvecsmall2(6, 6);
2139 0 : case 3:
2140 0 : return mkvecsmall2(7, 8);
2141 0 : case 5:
2142 0 : return mkvecsmall2(3, 0);
2143 0 : case 7:
2144 0 : return mkvecsmall2(7, 8);
2145 0 : default:
2146 0 : pari_err_BUG("condliftpS4");
2147 : }
2148 0 : case 41:
2149 0 : return mkvecsmall2(5, 4);
2150 0 : default:
2151 0 : pari_err_BUG("condliftpS4");
2152 : }
2153 0 : case 8:
2154 0 : if (dec!=41) pari_err_BUG("condliftpS4");
2155 0 : return mkvecsmall2(7, 6);
2156 0 : case 9:
2157 0 : if (dec!=41) pari_err_BUG("condliftpS4");
2158 0 : return mkvecsmall2(9, 9);
2159 0 : case 10:
2160 0 : if (dec!=41) pari_err_BUG("condliftpS4");
2161 0 : return mkvecsmall2(9, 8);
2162 0 : case 11:
2163 : {
2164 0 : long invk6 = K6_invar(nf,p);
2165 0 : if (dec!=41) pari_err_BUG("condliftpS4");
2166 0 : switch(invk6)
2167 : {
2168 0 : case 1214:
2169 0 : return mkvecsmall2(9, 7);
2170 0 : case 1421:
2171 0 : return mkvecsmall2(8, 5);
2172 0 : case 111114:
2173 0 : return mkvecsmall2(4, 0);
2174 0 : default:
2175 0 : pari_err_BUG("condliftpS4");
2176 : }
2177 : }
2178 0 : default:
2179 0 : pari_err_BUG("condliftpS4");
2180 : }
2181 : }
2182 : return NULL; /* LCOV_EXCL_LINE */
2183 : }
2184 :
2185 : GEN
2186 0 : condliftS4(GEN nf)
2187 : {
2188 0 : pari_sp av = avma;
2189 0 : GEN disc = nf_get_disc(nf);
2190 0 : GEN fa = gel(absZ_factor(disc), 1);
2191 0 : long i, l = lg(fa);
2192 0 : GEN V = cgetg(l, t_COL);
2193 0 : GEN W = cgetg(l, t_COL);
2194 0 : for (i = 1; i<l; i++)
2195 : {
2196 0 : GEN p = gel(fa,i);
2197 0 : GEN cnd = condliftpS4(nf, p);
2198 0 : gel(V,i) = powiu(p, uel(cnd,1));
2199 0 : gel(W,i) = powiu(p, uel(cnd,2));
2200 : }
2201 0 : return gc_GEN(av, mkvec2(ZV_prod(V), ZV_prod(W)));
2202 : }
2203 :
2204 : /* output:
2205 : [T,f6,f4,e] where
2206 : - T encodes the type of the local representation: T = [N,g,c] where
2207 : * p^N is the conductor;
2208 : * g is the size of the projective image;
2209 : * c is the conductor exponent of the corresponding character;
2210 : - p^e = gcd(Norm(f6),Norm(f4))
2211 : */
2212 : static GEN
2213 0 : condliftpA4(GEN nf, GEN p)
2214 : {
2215 0 : long val = Z_pval(nf_get_disc(nf), p);
2216 0 : long dec = decind(nf,p);
2217 0 : switch(itou_or_0(p))
2218 : {
2219 0 : default:
2220 0 : if(val!=2) pari_err_BUG("condliftpA4");
2221 0 : switch(dec)
2222 : {
2223 0 : case 2121:
2224 0 : return mkvecsmall4(1,2,1,0); /* type 1+chi2 */
2225 0 : case 1131:
2226 0 : return mkvecsmall4(1,3,1,0); /* type 1+chi3 */
2227 0 : case 22:
2228 0 : return mkvecsmall4(2,4,1,2); /* type ind_{Qq/Qp}psi2 (c=1) */
2229 0 : default:
2230 0 : pari_err_BUG("condliftpA4");
2231 : }
2232 0 : case 3:
2233 0 : switch(val)
2234 : {
2235 0 : case 2:
2236 0 : switch(dec)
2237 : {
2238 0 : case 2121:
2239 0 : return mkvecsmall4(1,2,1,0); /* type 1+chi2 */
2240 0 : case 22:
2241 0 : return mkvecsmall4(2,4,1,2); /* type ind_{Qq/Qp}psi2 (c=1) */
2242 0 : default:
2243 0 : pari_err_BUG("condliftpA4");
2244 : }
2245 0 : case 4:
2246 0 : if (dec!=1131) pari_err_BUG("condliftpA4");
2247 0 : return mkvecsmall4(2,3,2,0); /* type 1+chi3 */
2248 0 : default:
2249 0 : pari_err_BUG("condliftpA4");
2250 : }
2251 0 : case 2:
2252 0 : switch(val)
2253 : {
2254 0 : case 4:
2255 0 : switch(dec)
2256 : {
2257 0 : case 2121:
2258 0 : return mkvecsmall4(2,2,2,0); /* type 1+chi2 */
2259 0 : case 22:
2260 0 : return mkvecsmall4(4,4,2,4); /* type ind_{Q4/Q2}psi2 (c=2) */
2261 0 : default:
2262 0 : pari_err_BUG("condliftpA4");
2263 : }
2264 0 : case 6:
2265 0 : switch(dec)
2266 : {
2267 0 : case 2121:
2268 0 : return mkvecsmall4(3,2,3,0); /* type 1+chi2 */
2269 0 : case 22:
2270 0 : return mkvecsmall4(6,4,3,6); /* type ind_{Q4/Q2}psi2 (c=3) */
2271 0 : case 41:
2272 0 : return mkvecsmall4(5,12,-1,4); /* type exceptional A4 */
2273 0 : default:
2274 0 : pari_err_BUG("condliftpA4");
2275 : }
2276 0 : case 8:
2277 0 : if (dec!=41) pari_err_BUG("condliftpA4");
2278 0 : return mkvecsmall4(7,4,4,6); /* type ind_{Kram/Q2}psi2 (c=4) */
2279 0 : default:
2280 0 : pari_err_BUG("condliftpA4");
2281 : }
2282 : }
2283 : return NULL; /* LCOV_EXCL_LINE */
2284 : }
2285 :
2286 : GEN
2287 0 : condliftA4(GEN nf)
2288 : {
2289 0 : pari_sp av = avma;
2290 0 : GEN disc = nf_get_disc(nf);
2291 0 : GEN fa = gel(absZ_factor(disc), 1);
2292 0 : long i, l = lg(fa);
2293 0 : GEN V = cgetg(l, t_COL);
2294 0 : GEN W = cgetg(l, t_COL);
2295 0 : for (i = 1; i<l; i++)
2296 : {
2297 0 : GEN p = gel(fa,i);
2298 0 : GEN cnd = condliftpA4(nf, p);
2299 0 : gel(V,i) = powiu(p, uel(cnd,1));
2300 0 : gel(W,i) = powiu(p, uel(cnd,4));
2301 : }
2302 0 : return gc_GEN(av, mkvec2(ZV_prod(V), ZV_prod(W)));
2303 : }
2304 : /* output:
2305 : [e,g,c] where
2306 : - p^e the conductor of a minimal lift;
2307 : - g is the size of the projective image:
2308 : 2,3,5 for cyclic image,
2309 : 4,6,10 for dihedral image,
2310 : 12 for exceptional image;
2311 : - c is the conductor exponent of the corresponding character:
2312 : cond(L/Qp) for cyclic image,
2313 : cond(L/K) for dihedral image, where K/Qp is quadratic,
2314 : -1 for exceptional image.
2315 : */
2316 : static GEN
2317 0 : condliftpA5(GEN nf, GEN p)
2318 : {
2319 0 : long val = Z_pval(nf_get_disc(nf), p);
2320 0 : long dec = decind(nf,p);
2321 0 : switch(itou_or_0(p))
2322 : {
2323 0 : default:
2324 0 : switch (val)
2325 : {
2326 0 : case 2:
2327 0 : switch(dec)
2328 : {
2329 0 : case 112121:
2330 0 : return mkvecsmall4(1,2,1,0); /* type 1+chi2 */
2331 0 : case 111131:
2332 0 : return mkvecsmall4(1,3,1,0); /* type 1+chi3 */
2333 0 : case 1122:
2334 0 : return mkvecsmall4(2,4,1,6); /* type ind_{Qq/Qp} psi2 (c=1) */
2335 0 : case 1231:
2336 0 : return mkvecsmall4(2,6,1,0); /* type ind_{Qq/Qp} psi3 (c=1) */
2337 0 : default:
2338 0 : pari_err_BUG("condliftpA5");
2339 : }
2340 0 : case 4:
2341 0 : if (dec!=51) pari_err_BUG("condliftpA5");
2342 0 : switch (umodiu(p,5))
2343 : {
2344 0 : case 1:
2345 0 : return mkvecsmall4(1,5,1,0); /* type 1+chi5 */
2346 0 : case 4:
2347 0 : return mkvecsmall4(2,10,1,0); /* type ind_{Qq/Qp} psi5 (c=1) */
2348 0 : default:
2349 0 : pari_err_BUG("condliftpA5");
2350 : }
2351 0 : default:
2352 0 : pari_err_BUG("condliftpA5");
2353 : }
2354 0 : case 5:
2355 0 : switch(val)
2356 : {
2357 0 : case 2:
2358 0 : switch (dec)
2359 : {
2360 0 : case 112121:
2361 0 : return mkvecsmall4(1,2,1,0); /* type 1+chi2 */
2362 0 : case 1122:
2363 0 : return mkvecsmall4(2,4,1,6); /* type ind_{Q25/Q5} psi2 (c=1) */
2364 0 : case 1231:
2365 0 : return mkvecsmall4(2,6,1,0); /* type ind_{Q25/Q5} psi3 (c=1) */
2366 0 : default:
2367 0 : pari_err_BUG("condliftpA5");
2368 : }
2369 0 : case 6:
2370 0 : if (dec!=51) pari_err_BUG("condliftpA5");
2371 0 : return mkvecsmall4(3,10,2,2); /* type ind_{Kram/Q5} psi5 (c=2) */
2372 0 : case 8:
2373 0 : if (dec!=51) pari_err_BUG("condliftpA5");
2374 : else
2375 : {
2376 0 : GEN pol = nf_get_pol(nf);
2377 : long lambda;
2378 0 : GEN res = ZX_compositum(pol,pol,&lambda);
2379 0 : switch (lg(gel(factorpadic(res,p,1),1))-1)
2380 : {
2381 0 : case 5: /* degrees (1,1,1,1,1) */
2382 0 : return mkvecsmall4(2,5,2,0); /* type 1+chi5 */
2383 0 : case 3: /* degrees (1,2,2) ; (1,1,3) forbidden but not checked */
2384 0 : return mkvecsmall4(4,10,2,0); /* type ind_{Q25/Q5} psi5 (c=2) */
2385 0 : default:
2386 0 : pari_err_BUG("condliftpA5");
2387 : }
2388 : }
2389 : default:
2390 0 : pari_err_BUG("condliftpA5");
2391 : }
2392 0 : case 3:
2393 0 : switch(val)
2394 : {
2395 0 : case 2:
2396 0 : switch (dec)
2397 : {
2398 0 : case 112121:
2399 0 : return mkvecsmall4(1,2,1,0); /* type 1+chi2 */
2400 0 : case 1122:
2401 0 : return mkvecsmall4(2,4,1,6); /* type ind_{Q9/Q3} psi2 (c=1) */
2402 0 : default:
2403 0 : pari_err_BUG("condliftpA5");
2404 : }
2405 0 : case 4:
2406 0 : switch (dec)
2407 : {
2408 0 : case 111131:
2409 0 : return mkvecsmall4(2,3,1,0); /* type 1+chi3 */
2410 0 : case 2131:
2411 0 : return mkvecsmall4(3,6,2,0); /* type ind_{Kram/Q3} psi3 (c=2) */
2412 0 : case 1231:
2413 0 : return mkvecsmall4(4,6,2,0); /* ind_{Q9/Q3} psi3 (c=2) */
2414 0 : default:
2415 0 : pari_err_BUG("condliftpA5");
2416 : }
2417 0 : case 6:
2418 0 : if (dec!=2131) pari_err_BUG("condliftpA5");
2419 0 : return mkvecsmall4(5,6,4,0); /* type ind_{Kram/Q3} psi3 (c=4) */
2420 0 : default:
2421 0 : pari_err_BUG("condliftpA5");
2422 : }
2423 0 : case 2:
2424 0 : switch (val)
2425 : {
2426 0 : case 2:
2427 0 : if (dec!=1231) pari_err_BUG("condliftpA5");
2428 0 : return mkvecsmall4(2,6,1,0); /* type ind_{Q4/Q2} psi3 (c=1) */
2429 0 : case 4:
2430 0 : switch (dec)
2431 : {
2432 0 : case 112121:
2433 0 : return mkvecsmall4(2,2,2,0); /* type 1+chi2 */
2434 0 : case 51:
2435 0 : return mkvecsmall4(2,10,1,0); /* type ind_{Q4/Q2} psi5 (c=1) */
2436 0 : case 1122:
2437 0 : return mkvecsmall4(4,4,2,12); /* type ind_{Q4/Q2} psi2 (c=2) */
2438 0 : default:
2439 0 : pari_err_BUG("condliftpA5");
2440 : }
2441 0 : case 6:
2442 0 : switch (dec)
2443 : {
2444 0 : case 112121:
2445 0 : return mkvecsmall4(3,2,3,0); /* type 1+chi2 */
2446 0 : case 1122:
2447 0 : return mkvecsmall4(6,4,3,18); /* type ind_{Q4/Q2} psi2 (c=3) */
2448 0 : case 1141:
2449 0 : return mkvecsmall4(5,12,-1,12); /* type exceptional A4 */
2450 0 : default:
2451 0 : pari_err_BUG("condliftpA5");
2452 : }
2453 0 : case 8:
2454 0 : if (dec!=1141) pari_err_BUG("condliftpA5");
2455 0 : return mkvecsmall4(7,4,4,18); /* type ind_{K(4)/Q2} psi2 (c=4) */
2456 0 : default:
2457 0 : pari_err_BUG("condliftpA5");
2458 : }
2459 : }
2460 : return NULL; /* LCOV_EXCL_LINE */
2461 : }
2462 :
2463 : GEN
2464 0 : condliftA5(GEN nf)
2465 : {
2466 0 : pari_sp av = avma;
2467 0 : GEN disc = nf_get_disc(nf);
2468 0 : GEN fa = gel(absZ_factor(disc), 1);
2469 0 : long i, l = lg(fa);
2470 0 : GEN V = cgetg(l, t_COL);
2471 0 : GEN W = cgetg(l, t_COL);
2472 0 : for (i = 1; i<l; i++)
2473 : {
2474 0 : GEN p = gel(fa,i);
2475 0 : GEN cnd = condliftpA5(nf, p);
2476 0 : gel(V,i) = powiu(p, uel(cnd,1));
2477 0 : gel(W,i) = powiu(p, uel(cnd,4));
2478 : }
2479 0 : return gc_GEN(av, mkvec2(ZV_prod(V), ZV_prod(W)));
2480 : }
|
