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 : static hashtable *
75 196 : hash_create_INT(ulong s)
76 196 : { return hash_create(s, (ulong(*)(void*))&hash_GEN,
77 : (int(*)(void*,void*))&equalii, 1); }
78 : GEN
79 56 : rnfisnorminit(GEN T, GEN R, long galois)
80 : {
81 56 : pari_sp av = avma;
82 : long i, l, dR;
83 : GEN S, gen, cyc, bnf, nf, nfabs, rnfeq, bnfabs, k, polabs;
84 56 : GEN y = cgetg(9, t_VEC);
85 56 : hashtable *H = hash_create_INT(100UL);
86 :
87 56 : if (galois < 0 || galois > 2) pari_err_FLAG("rnfisnorminit");
88 56 : T = get_bnfpol(T, &bnf, &nf);
89 56 : if (!bnf) bnf = Buchall(nf? nf: T, nf_FORCE, DEFAULTPREC);
90 56 : if (!nf) nf = bnf_get_nf(bnf);
91 :
92 56 : R = get_bnfpol(R, &bnfabs, &nfabs);
93 56 : if (!gequal1(leading_coeff(R))) pari_err_IMPL("non monic relative equation");
94 56 : dR = degpol(R);
95 56 : if (dR <= 2) galois = 1;
96 :
97 56 : R = RgX_nffix("rnfisnorminit", T, R, 1);
98 56 : if (nf_get_degree(nf) == 1) /* over Q */
99 35 : rnfeq = mkvec5(R,gen_0,gen_0,T,R);
100 21 : else if (galois == 2) /* needs eltup+abstorel */
101 7 : rnfeq = nf_rnfeq(nf, R);
102 : else /* needs abstorel */
103 14 : rnfeq = nf_rnfeqsimple(nf, R);
104 56 : polabs = gel(rnfeq,1);
105 56 : k = gel(rnfeq,3);
106 56 : if (!bnfabs || !gequal0(k))
107 28 : bnfabs = Buchall(polabs, nf_FORCE, nf_get_prec(nf));
108 56 : if (!nfabs) nfabs = bnf_get_nf(bnfabs);
109 :
110 56 : if (galois == 2)
111 : {
112 21 : GEN P = polabs==R? leafcopy(R): nfX_eltup(nf, rnfeq, R);
113 21 : setvarn(P, fetch_var_higher());
114 21 : galois = !!nfroots_if_split(&nfabs, P);
115 21 : (void)delete_var();
116 : }
117 :
118 56 : cyc = bnf_get_cyc(bnfabs);
119 56 : gen = bnf_get_gen(bnfabs); l = lg(cyc);
120 84 : for(i=1; i<l; i++)
121 : {
122 35 : GEN g = gel(gen,i);
123 35 : if (ugcdiu(gel(cyc,i), dR) == 1) break;
124 28 : Zfa_append(gcoeff(g,1,1), H, NULL);
125 : }
126 56 : if (!galois)
127 : {
128 21 : GEN Ndiscrel = diviiexact(nf_get_disc(nfabs), powiu(nf_get_disc(nf), dR));
129 21 : Zfa_append(Ndiscrel, H, NULL);
130 : }
131 56 : S = hash_keys_GEN(H);
132 56 : gel(y,1) = bnf;
133 56 : gel(y,2) = bnfabs;
134 56 : gel(y,3) = R;
135 56 : gel(y,4) = rnfeq;
136 56 : gel(y,5) = S;
137 56 : gel(y,6) = nf_pV_to_prV(nf, S);
138 56 : gel(y,7) = nf_pV_to_prV(nfabs, S);
139 56 : gel(y,8) = stoi(galois); return gerepilecopy(av, y);
140 : }
141 :
142 : /* T as output by rnfisnorminit
143 : * if flag=0 assume extension is Galois (==> answer is unconditional)
144 : * if flag>0 add to S all primes dividing p <= flag
145 : * if flag<0 add to S all primes dividing abs(flag)
146 :
147 : * answer is a vector v = [a,b] such that
148 : * x = N(a)*b and x is a norm iff b = 1 [assuming S large enough] */
149 : GEN
150 70 : rnfisnorm(GEN T, GEN x, long flag)
151 : {
152 70 : pari_sp av = avma;
153 : GEN bnf, rel, R, rnfeq, nfpol;
154 : GEN nf, aux, H, U, Y, M, A, bnfS, sunitrel, futu, S, S1, S2, Sx;
155 : long L, i, itu;
156 : hashtable *H0, *H2;
157 70 : if (typ(T) != t_VEC || lg(T) != 9)
158 0 : pari_err_TYPE("rnfisnorm [please apply rnfisnorminit()]", T);
159 70 : bnf = gel(T,1);
160 70 : rel = gel(T,2);
161 70 : bnf = checkbnf(bnf);
162 70 : rel = checkbnf(rel);
163 70 : nf = bnf_get_nf(bnf);
164 70 : x = nf_to_scalar_or_alg(nf,x);
165 70 : if (gequal0(x)) { set_avma(av); return mkvec2(gen_0, gen_1); }
166 70 : if (gequal1(x)) { set_avma(av); return mkvec2(gen_1, gen_1); }
167 70 : R = gel(T,3);
168 70 : rnfeq = gel(T,4);
169 70 : if (gequalm1(x) && odd(degpol(R)))
170 0 : { set_avma(av); return mkvec2(gen_m1, gen_1); }
171 :
172 : /* build set T of ideals involved in the solutions */
173 70 : nfpol = nf_get_pol(nf);
174 70 : S = gel(T,5);
175 70 : H0 = hash_create_INT(100UL);
176 70 : H2 = hash_create_INT(100UL);
177 70 : L = lg(S);
178 147 : for (i = 1; i < L; i++) p_append(gel(S,i),H0,NULL);
179 70 : S1 = gel(T,6);
180 70 : S2 = gel(T,7);
181 70 : if (flag > 0)
182 : {
183 : forprime_t T;
184 : ulong p;
185 14 : u_forprime_init(&T, 2, flag);
186 364 : while ((p = u_forprime_next(&T))) p_append(utoipos(p), H0,H2);
187 : }
188 56 : else if (flag < 0)
189 7 : Zfa_append(utoipos(-flag),H0,H2);
190 : /* overkill: prime ideals dividing x would be enough */
191 70 : A = idealnumden(nf, x);
192 70 : fa_append(gel(A,1), H0,H2);
193 70 : fa_append(gel(A,2), H0,H2);
194 70 : Sx = hash_keys_GEN(H2); L = lg(Sx);
195 70 : if (L > 1)
196 : { /* new primes */
197 49 : S1 = shallowconcat(S1, nf_pV_to_prV(nf, Sx));
198 49 : S2 = shallowconcat(S2, nf_pV_to_prV(rel, Sx));
199 : }
200 :
201 : /* computation on T-units */
202 70 : futu = shallowconcat(bnf_get_fu(rel), bnf_get_tuU(rel));
203 70 : bnfS = bnfsunit(bnf,S1,LOWDEFAULTPREC);
204 70 : sunitrel = shallowconcat(futu, gel(bnfsunit(rel,S2,LOWDEFAULTPREC), 1));
205 :
206 70 : A = lift_shallow(bnfissunit(bnf,bnfS,x));
207 70 : L = lg(sunitrel);
208 70 : itu = lg(nf_get_roots(nf))-1; /* index of torsion unit in bnfsunit(nf) output */
209 70 : M = cgetg(L+1,t_MAT);
210 1449 : for (i=1; i<L; i++)
211 : {
212 1379 : GEN u = eltabstorel(rnfeq, gel(sunitrel,i));
213 1379 : gel(sunitrel,i) = u;
214 1379 : u = bnfissunit(bnf,bnfS, gnorm(u));
215 1379 : if (lg(u) == 1) pari_err_BUG("rnfisnorm");
216 1379 : gel(u,itu) = lift_shallow(gel(u,itu)); /* lift root of 1 part */
217 1379 : gel(M,i) = u;
218 : }
219 70 : aux = zerocol(lg(A)-1); gel(aux,itu) = utoipos( bnf_get_tuN(rel) );
220 70 : gel(M,L) = aux;
221 70 : H = ZM_hnfall(M, &U, 2);
222 70 : Y = RgM_RgC_mul(U, inverseimage(H,A));
223 : /* Y: sols of MY = A over Q */
224 70 : setlg(Y, L);
225 70 : aux = factorback2(sunitrel, gfloor(Y));
226 70 : x = mkpolmod(x,nfpol);
227 70 : if (!gequal1(aux)) x = gdiv(x, gnorm(aux));
228 70 : x = lift_if_rational(x);
229 70 : if (typ(aux) == t_POLMOD && degpol(nfpol) == 1)
230 28 : gel(aux,2) = lift_if_rational(gel(aux,2));
231 70 : return gerepilecopy(av, mkvec2(aux, x));
232 : }
233 :
234 : GEN
235 28 : bnfisnorm(GEN bnf, GEN x, long flag)
236 : {
237 28 : pari_sp av = avma;
238 28 : GEN T = rnfisnorminit(pol_x(fetch_var()), bnf, flag == 0? 1: 2);
239 28 : GEN r = rnfisnorm(T, x, flag == 1? 0: flag);
240 28 : (void)delete_var();
241 28 : return gerepileupto(av,r);
242 : }
|