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 : /* RNFISNORM */
17 : /* (Adapted from Denis Simon's original implementation) */
18 : /*******************************************************************/
19 : #include "pari.h"
20 : #include "paripriv.h"
21 :
22 : static void
23 609 : p_append(GEN p, hashtable *H, hashtable *H2)
24 : {
25 609 : ulong h = H->hash(p);
26 609 : hashentry *e = hash_search2(H, (void*)p, h);
27 609 : if (!e)
28 : {
29 539 : hash_insert2(H, (void*)p, NULL, h);
30 539 : if (H2) hash_insert2(H2, (void*)p, NULL, h);
31 : }
32 609 : }
33 :
34 : /* N a t_INT */
35 : static void
36 196 : Zfa_append(GEN N, hashtable *H, hashtable *H2)
37 : {
38 196 : if (!is_pm1(N))
39 : {
40 126 : GEN v = gel(absZ_factor(N),1);
41 126 : long i, l = lg(v);
42 308 : for (i=1; i<l; i++) p_append(gel(v,i), H, H2);
43 : }
44 196 : }
45 : /* N a t_INT or t_FRAC or ideal in HNF*/
46 : static void
47 140 : fa_append(GEN N, hashtable *H, hashtable *H2)
48 : {
49 140 : switch(typ(N))
50 : {
51 112 : case t_INT:
52 112 : Zfa_append(N,H,H2);
53 112 : break;
54 0 : case t_FRAC:
55 0 : Zfa_append(gel(N,1),H,H2);
56 0 : Zfa_append(gel(N,2),H,H2);
57 0 : break;
58 28 : default: /*t_MAT*/
59 28 : Zfa_append(gcoeff(N,1,1),H,H2);
60 28 : break;
61 : }
62 140 : }
63 :
64 : /* apply lift(rnfeltup) to all coeffs, without rnf structure */
65 : static GEN
66 7 : nfX_eltup(GEN nf, GEN rnfeq, GEN x)
67 : {
68 : long i, l;
69 7 : GEN y = cgetg_copy(x, &l), zknf = nf_nfzk(nf, rnfeq);
70 35 : for (i=2; i<l; i++) gel(y,i) = nfeltup(nf, gel(x,i), zknf);
71 7 : y[1] = x[1]; return y;
72 : }
73 :
74 : GEN
75 56 : rnfisnorminit(GEN T, GEN R, long galois)
76 : {
77 56 : pari_sp av = avma;
78 : long i, l, dR;
79 : GEN S, gen, cyc, bnf, nf, nfabs, rnfeq, bnfabs, k, polabs;
80 56 : GEN y = cgetg(9, t_VEC);
81 56 : hashtable *H = hash_create_INT(100UL, 1);
82 :
83 56 : if (galois < 0 || galois > 2) pari_err_FLAG("rnfisnorminit");
84 56 : T = get_bnfpol(T, &bnf, &nf);
85 56 : if (!bnf) bnf = Buchall(nf? nf: T, nf_FORCE, DEFAULTPREC);
86 56 : if (!nf) nf = bnf_get_nf(bnf);
87 :
88 56 : R = get_bnfpol(R, &bnfabs, &nfabs);
89 56 : if (!gequal1(leading_coeff(R))) pari_err_IMPL("non monic relative equation");
90 56 : dR = degpol(R);
91 56 : if (dR <= 2) galois = 1;
92 :
93 56 : R = RgX_nffix("rnfisnorminit", T, R, 1);
94 56 : if (nf_get_degree(nf) == 1) /* over Q */
95 35 : rnfeq = mkvec5(R,gen_0,gen_0,T,R);
96 21 : else if (galois == 2) /* needs eltup+abstorel */
97 7 : rnfeq = nf_rnfeq(nf, R);
98 : else /* needs abstorel */
99 14 : rnfeq = nf_rnfeqsimple(nf, R);
100 56 : polabs = gel(rnfeq,1);
101 56 : k = gel(rnfeq,3);
102 56 : if (!bnfabs || !gequal0(k))
103 28 : bnfabs = Buchall(polabs, nf_FORCE, nf_get_prec(nf));
104 56 : if (!nfabs) nfabs = bnf_get_nf(bnfabs);
105 :
106 56 : if (galois == 2)
107 : {
108 21 : GEN P = polabs==R? leafcopy(R): nfX_eltup(nf, rnfeq, R);
109 21 : setvarn(P, fetch_var_higher());
110 21 : galois = !!nfroots_if_split(&nfabs, P);
111 21 : (void)delete_var();
112 : }
113 :
114 56 : cyc = bnf_get_cyc(bnfabs);
115 56 : gen = bnf_get_gen(bnfabs); l = lg(cyc);
116 84 : for(i=1; i<l; i++)
117 : {
118 35 : GEN g = gel(gen,i);
119 35 : if (ugcdiu(gel(cyc,i), dR) == 1) break;
120 28 : Zfa_append(gcoeff(g,1,1), H, NULL);
121 : }
122 56 : if (!galois)
123 : {
124 21 : GEN Ndiscrel = diviiexact(nf_get_disc(nfabs), powiu(nf_get_disc(nf), dR));
125 21 : Zfa_append(Ndiscrel, H, NULL);
126 : }
127 56 : S = hash_keys_GEN(H);
128 56 : gel(y,1) = bnf;
129 56 : gel(y,2) = bnfabs;
130 56 : gel(y,3) = R;
131 56 : gel(y,4) = rnfeq;
132 56 : gel(y,5) = S;
133 56 : gel(y,6) = nf_pV_to_prV(nf, S);
134 56 : gel(y,7) = nf_pV_to_prV(nfabs, S);
135 56 : gel(y,8) = stoi(galois); return gc_GEN(av, y);
136 : }
137 :
138 : /* T as output by rnfisnorminit
139 : * if flag=0 assume extension is Galois (==> answer is unconditional)
140 : * if flag>0 add to S all primes dividing p <= flag
141 : * if flag<0 add to S all primes dividing abs(flag)
142 :
143 : * answer is a vector v = [a,b] such that
144 : * x = N(a)*b and x is a norm iff b = 1 [assuming S large enough] */
145 : GEN
146 70 : rnfisnorm(GEN T, GEN x, long flag)
147 : {
148 70 : pari_sp av = avma;
149 : GEN bnf, rel, R, rnfeq, nfpol;
150 : GEN nf, aux, H, U, Y, M, A, bnfS, sunitrel, futu, S, S1, S2, Sx;
151 : long L, i, itu;
152 : hashtable *H0, *H2;
153 70 : if (typ(T) != t_VEC || lg(T) != 9)
154 0 : pari_err_TYPE("rnfisnorm [please apply rnfisnorminit()]", T);
155 70 : bnf = gel(T,1);
156 70 : rel = gel(T,2);
157 70 : bnf = checkbnf(bnf);
158 70 : rel = checkbnf(rel);
159 70 : nf = bnf_get_nf(bnf);
160 70 : x = nf_to_scalar_or_alg(nf,x);
161 70 : if (gequal0(x)) { set_avma(av); return mkvec2(gen_0, gen_1); }
162 70 : if (gequal1(x)) { set_avma(av); return mkvec2(gen_1, gen_1); }
163 70 : R = gel(T,3);
164 70 : rnfeq = gel(T,4);
165 70 : if (gequalm1(x) && odd(degpol(R)))
166 0 : { set_avma(av); return mkvec2(gen_m1, gen_1); }
167 :
168 : /* build set T of ideals involved in the solutions */
169 70 : nfpol = nf_get_pol(nf);
170 70 : S = gel(T,5);
171 70 : H0 = hash_create_INT(100UL, 1);
172 70 : H2 = hash_create_INT(100UL, 1);
173 70 : L = lg(S);
174 147 : for (i = 1; i < L; i++) p_append(gel(S,i),H0,NULL);
175 70 : S1 = gel(T,6);
176 70 : S2 = gel(T,7);
177 70 : if (flag > 0)
178 : {
179 : forprime_t T;
180 : ulong p;
181 14 : u_forprime_init(&T, 2, flag);
182 364 : while ((p = u_forprime_next(&T))) p_append(utoipos(p), H0,H2);
183 : }
184 56 : else if (flag < 0)
185 7 : Zfa_append(utoipos(-flag),H0,H2);
186 : /* overkill: prime ideals dividing x would be enough */
187 70 : A = idealnumden(nf, x);
188 70 : fa_append(gel(A,1), H0,H2);
189 70 : fa_append(gel(A,2), H0,H2);
190 70 : Sx = hash_keys_GEN(H2); L = lg(Sx);
191 70 : if (L > 1)
192 : { /* new primes */
193 49 : S1 = shallowconcat(S1, nf_pV_to_prV(nf, Sx));
194 49 : S2 = shallowconcat(S2, nf_pV_to_prV(rel, Sx));
195 : }
196 :
197 : /* computation on T-units */
198 70 : futu = shallowconcat(bnf_get_fu(rel), bnf_get_tuU(rel));
199 70 : bnfS = bnfsunit(bnf,S1,LOWDEFAULTPREC);
200 70 : sunitrel = shallowconcat(futu, gel(bnfsunit(rel,S2,LOWDEFAULTPREC), 1));
201 :
202 70 : A = lift_shallow(bnfissunit(bnf,bnfS,x));
203 70 : L = lg(sunitrel);
204 70 : itu = lg(nf_get_roots(nf))-1; /* index of torsion unit in bnfsunit(nf) output */
205 70 : M = cgetg(L+1,t_MAT);
206 1449 : for (i=1; i<L; i++)
207 : {
208 1379 : GEN u = eltabstorel(rnfeq, gel(sunitrel,i));
209 1379 : gel(sunitrel,i) = u;
210 1379 : u = bnfissunit(bnf,bnfS, gnorm(u));
211 1379 : if (lg(u) == 1) pari_err_BUG("rnfisnorm");
212 1379 : gel(u,itu) = lift_shallow(gel(u,itu)); /* lift root of 1 part */
213 1379 : gel(M,i) = u;
214 : }
215 70 : aux = zerocol(lg(A)-1); gel(aux,itu) = utoipos( bnf_get_tuN(rel) );
216 70 : gel(M,L) = aux;
217 70 : H = ZM_hnfall(M, &U, 2);
218 70 : Y = RgM_RgC_mul(U, inverseimage(H,A));
219 : /* Y: sols of MY = A over Q */
220 70 : setlg(Y, L);
221 70 : aux = factorback2(sunitrel, gfloor(Y));
222 70 : x = mkpolmod(x,nfpol);
223 70 : if (!gequal1(aux)) x = gdiv(x, gnorm(aux));
224 70 : x = lift_if_rational(x);
225 70 : if (typ(aux) == t_POLMOD && degpol(nfpol) == 1)
226 28 : gel(aux,2) = lift_if_rational(gel(aux,2));
227 70 : return gc_GEN(av, mkvec2(aux, x));
228 : }
229 :
230 : GEN
231 28 : bnfisnorm(GEN bnf, GEN x, long flag)
232 : {
233 28 : pari_sp av = avma;
234 28 : GEN T = rnfisnorminit(pol_x(fetch_var()), bnf, flag == 0? 1: 2);
235 28 : GEN r = rnfisnorm(T, x, flag == 1? 0: flag);
236 28 : (void)delete_var();
237 28 : return gc_upto(av,r);
238 : }
|