Book a Demo!
CoCalc Logo Icon
StoreFeaturesDocsShareSupportNewsAboutPoliciesSign UpSign In
Download

Testing latest pari + WASM + node.js... and it works?! Wow.

28485 views
License: GPL3
ubuntu2004
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
#include "pari.h"
16
#include "paripriv.h"
17
18
#define DEBUGLEVEL DEBUGLEVEL_thue
19
20
/********************************************************************/
21
/** **/
22
/** THUE EQUATION SOLVER (G. Hanrot) **/
23
/** **/
24
/********************************************************************/
25
/* In all the forthcoming remarks, "paper" designs the paper "Thue Equations of
26
* High Degree", by Yu. Bilu and G. Hanrot, J. Number Theory (1996). The
27
* numbering of the constants corresponds to Hanrot's thesis rather than to the
28
* paper. See also
29
* "Solving Thue equations without the full unit group", Math. Comp. (2000) */
30
31
/* Check whether tnf is a valid structure */
32
static int
33
checktnf(GEN tnf)
34
{
35
long l = lg(tnf);
36
GEN v;
37
if (typ(tnf)!=t_VEC || (l!=8 && l!=4)) return 0;
38
v = gel(tnf,1);
39
if (typ(v) != t_VEC || lg(v) != 4) return 0;
40
if (l == 4) return 1; /* s=0 */
41
42
(void)checkbnf(gel(tnf,2));
43
return (typ(gel(tnf,3)) == t_COL
44
&& typ(gel(tnf,4)) == t_COL
45
&& typ(gel(tnf,5)) == t_MAT
46
&& typ(gel(tnf,6)) == t_MAT
47
&& typ(gel(tnf,7)) == t_VEC);
48
}
49
50
/* Compensates rounding errors for computation/display of the constants.
51
* Round up if dir > 0, down otherwise */
52
static GEN
53
myround(GEN x, long dir)
54
{
55
GEN eps = powis(stoi(dir > 0? 10: -10), -10);
56
return gmul(x, gadd(gen_1, eps));
57
}
58
59
/* v a t_VEC/t_VEC */
60
static GEN
61
vecmax_shallow(GEN v) { return gel(v, vecindexmax(v)); }
62
63
static GEN
64
tnf_get_roots(GEN poly, long prec, long S, long T)
65
{
66
GEN R0 = QX_complex_roots(poly, prec), R = cgetg(lg(R0), t_COL);
67
long k;
68
69
for (k=1; k<=S; k++) gel(R,k) = gel(R0,k);
70
/* swap roots to get the usual order */
71
for (k=1; k<=T; k++)
72
{
73
gel(R,k+S) = gel(R0,2*k+S-1);
74
gel(R,k+S+T)= gel(R0,2*k+S);
75
}
76
return R;
77
}
78
79
/* Computation of the logarithmic height of x (given by embeddings) */
80
static GEN
81
LogHeight(GEN x, long prec)
82
{
83
pari_sp av = avma;
84
long i, n = lg(x)-1;
85
GEN LH = gen_1;
86
for (i=1; i<=n; i++)
87
{
88
GEN t = gabs(gel(x,i), prec);
89
if (gcmpgs(t,1) > 0) LH = gmul(LH, t);
90
}
91
return gerepileupto(av, gdivgs(glog(LH,prec), n));
92
}
93
94
/* |x|^(1/n), x t_INT */
95
static GEN
96
absisqrtn(GEN x, long n, long prec)
97
{ GEN r = itor(x,prec); setabssign(r); return sqrtnr(r, n); }
98
99
static GEN
100
get_emb(GEN x, GEN r)
101
{
102
long l = lg(r), i;
103
GEN y;
104
105
if (typ(x) == t_INT) return const_col(l-1, x);
106
y = cgetg(l, t_COL);
107
for (i=1; i<l; i++)
108
{
109
GEN e = poleval(x, gel(r,i));
110
if (gequal0(e) || (typ(e) != t_INT && precision(e) <= LOWDEFAULTPREC ))
111
return NULL;
112
gel(y,i) = e;
113
}
114
return y;
115
}
116
117
/* Computation of the conjugates (sigma_i(v_j)), and log. heights, of elts of v */
118
static GEN
119
Conj_LH(GEN v, GEN *H, GEN r, long prec)
120
{
121
long j, l = lg(v);
122
GEN e, M = cgetg(l,t_MAT);
123
124
(*H) = cgetg(l,t_COL);
125
for (j = 1; j < l; j++)
126
{
127
if (! (e = get_emb(gel(v,j), r)) ) return NULL; /* FAIL */
128
gel(M,j) = e;
129
gel(*H,j) = LogHeight(e, prec);
130
}
131
return M;
132
}
133
134
/* Computation of M, its inverse A and precision check (see paper) */
135
static GEN
136
T_A_Matrices(GEN MatFU, long r, GEN *eps5, long prec)
137
{
138
GEN A, p1, m1, IntM, nia, eps3, eps2;
139
long e = prec2nbits(prec);
140
141
m1 = matslice(MatFU, 1,r, 1,r); /* minor order r */
142
m1 = glog(gabs(m1, prec), prec); /* HIGH accuracy */
143
A = RgM_inv(m1); if (!A) pari_err_PREC("thue");
144
IntM = RgM_Rg_add(RgM_mul(A,m1), gen_m1);
145
IntM = gabs(IntM, 0);
146
147
eps2 = gadd(vecmax(IntM), real2n(-e, LOWDEFAULTPREC)); /* t_REAL */
148
nia = vecmax(gabs(A, 0));
149
150
/* Check for the precision in matrix inversion. See paper, Lemma 2.4.2. */
151
p1 = addrr(mulsr(r, gmul2n(nia, e)), eps2); /* t_REAL */
152
if (expo(p1) < -2*r) pari_err_PREC("thue");
153
154
p1 = addrr(mulsr(r, gmul2n(nia,-e)), eps2);
155
eps3 = mulrr(mulsr(2*r*r,nia), p1);
156
if (!signe(eps3))
157
eps3 = real2n(expo(eps3), LOWDEFAULTPREC);
158
else
159
eps3 = myround(eps3, 1);
160
161
if (DEBUGLEVEL>1) err_printf("epsilon_3 -> %Ps\n",eps3);
162
*eps5 = mulur(r, eps3); return A;
163
}
164
165
/* find a few large primes such that p Z_K = P1 P2 P3 Q, whith f(Pi/p) = 1
166
* From x - \alpha y = \prod u_i^b_i we will deduce 3 equations in F_p
167
* in check_prinfo. Eliminating x,y we get a stringent condition on (b_i). */
168
static GEN
169
get_prime_info(GEN bnf)
170
{
171
long n = 1, e = gexpo(bnf_get_reg(bnf)), nbp = e < 20? 1: 2;
172
GEN L = cgetg(nbp+1, t_VEC), nf = checknf(bnf), fu = bnf_get_fu(bnf);
173
GEN X = pol_x(nf_get_varn(nf));
174
ulong p;
175
for(p = 2147483659UL; n <= nbp; p = unextprime(p+1))
176
{
177
GEN PR, A, U, LP = idealprimedec_limit_f(bnf, utoipos(p), 1);
178
long i;
179
if (lg(LP) < 4) continue;
180
A = cgetg(5, t_VECSMALL);
181
U = cgetg(4, t_VEC);
182
PR = cgetg(4, t_VEC);
183
for (i = 1; i <= 3; i++)
184
{
185
GEN modpr = zkmodprinit(nf, gel(LP,i));
186
GEN a = nf_to_Fq(nf, X, modpr);
187
GEN u = nfV_to_FqV(fu, nf, modpr);
188
A[i] = itou(a);
189
gel(U,i) = ZV_to_Flv(u,p);
190
gel(PR,i) = modpr;
191
}
192
A[4] = p;
193
gel(L,n++) = mkvec3(A,U,PR);
194
}
195
return L;
196
}
197
198
/* Performs basic computations concerning the equation.
199
* Returns a "tnf" structure containing
200
* 1) the polynomial
201
* 2) the bnf (used to solve the norm equation)
202
* 3) roots, with presumably enough precision
203
* 4) The logarithmic heights of units
204
* 5) The matrix of conjugates of units
205
* 6) its inverse
206
* 7) a few technical constants */
207
static GEN
208
inithue(GEN P, GEN bnf, long flag, long prec)
209
{
210
GEN MatFU, x0, tnf, tmp, gpmin, dP, csts, ALH, eps5, ro, c1, c2, Ind = gen_1;
211
long k,j, n = degpol(P);
212
long s,t, prec_roots;
213
214
if (!bnf)
215
{
216
bnf = Buchall(P, nf_FORCE, maxss(prec, DEFAULTPREC));
217
if (flag) (void)bnfcertify(bnf);
218
else
219
Ind = floorr(mulru(bnf_get_reg(bnf), 5));
220
}
221
222
nf_get_sign(bnf_get_nf(bnf), &s, &t);
223
prec_roots = prec;
224
for(;;)
225
{
226
ro = tnf_get_roots(P, prec_roots, s, t);
227
MatFU = Conj_LH(bnf_get_fu(bnf), &ALH, ro, prec);
228
if (MatFU) break;
229
prec_roots = precdbl(prec_roots);
230
if (DEBUGLEVEL>1) pari_warn(warnprec, "inithue", prec_roots);
231
}
232
233
dP = ZX_deriv(P);
234
c1 = NULL; /* min |P'(r_i)|, i <= s */
235
for (k=1; k<=s; k++)
236
{
237
tmp = gabs(poleval(dP,gel(ro,k)),prec);
238
if (!c1 || gcmp(tmp,c1) < 0) c1 = tmp;
239
}
240
c1 = gdiv(int2n(n-1), c1);
241
c1 = gprec_w(myround(c1, 1), DEFAULTPREC);
242
243
c2 = NULL; /* max |r_i - r_j|, i!=j */
244
for (k=1; k<=n; k++)
245
for (j=k+1; j<=n; j++)
246
{
247
tmp = gabs(gsub(gel(ro,j),gel(ro,k)), prec);
248
if (!c2 || gcmp(c2,tmp) > 0) c2 = tmp;
249
}
250
c2 = gprec_w(myround(c2, -1), DEFAULTPREC);
251
252
if (t==0)
253
x0 = real_1(DEFAULTPREC);
254
else
255
{
256
gpmin = NULL; /* min |P'(r_i)|, i > s */
257
for (k=1; k<=t; k++)
258
{
259
tmp = gabs(poleval(dP,gel(ro,s+k)), prec);
260
if (!gpmin || gcmp(tmp,gpmin) < 0) gpmin = tmp;
261
}
262
gpmin = gprec_w(gpmin, DEFAULTPREC);
263
264
/* Compute x0. See paper, Prop. 2.2.1 */
265
x0 = gmul(gpmin, vecmax_shallow(gabs(imag_i(ro), prec)));
266
x0 = sqrtnr(gdiv(int2n(n-1), x0), n);
267
}
268
if (DEBUGLEVEL>1)
269
err_printf("c1 = %Ps\nc2 = %Ps\nIndice <= %Ps\n", c1, c2, Ind);
270
271
ALH = gmul2n(ALH, 1);
272
tnf = cgetg(8,t_VEC); csts = cgetg(9,t_VEC);
273
gel(tnf,1) = P;
274
gel(tnf,2) = bnf;
275
gel(tnf,3) = ro;
276
gel(tnf,4) = ALH;
277
gel(tnf,5) = MatFU;
278
gel(tnf,6) = T_A_Matrices(MatFU, s+t-1, &eps5, prec);
279
gel(tnf,7) = csts;
280
gel(csts,1) = c1; gel(csts,2) = c2; gel(csts,3) = LogHeight(ro, prec);
281
gel(csts,4) = x0; gel(csts,5) = eps5; gel(csts,6) = utoipos(prec);
282
gel(csts,7) = Ind;
283
gel(csts,8) = get_prime_info(bnf);
284
return tnf;
285
}
286
287
typedef struct {
288
GEN c10, c11, c13, c15, c91, bak, NE, Ind, hal, MatFU, divro, Hmu;
289
GEN delta, lambda, inverrdelta, ro, Pi, Pi2;
290
long r, iroot, deg;
291
} baker_s;
292
293
static void
294
other_roots(long iroot, long *i1, long *i2)
295
{
296
switch (iroot) {
297
case 1: *i1=2; *i2=3; break;
298
case 2: *i1=1; *i2=3; break;
299
default: *i1=1; *i2=2; break;
300
}
301
}
302
/* low precision */
303
static GEN abslog(GEN x) { return gabs(glog(gtofp(x,DEFAULTPREC),0), 0); }
304
305
/* Compute Baker's bound c9 and B_0, the bound for the b_i's. See Thm 2.3.1 */
306
static GEN
307
Baker(baker_s *BS)
308
{
309
GEN tmp, B0, hb0, c9, Indc11;
310
long i1, i2;
311
312
other_roots(BS->iroot, &i1,&i2);
313
/* Compute a bound for the h_0 */
314
hb0 = gadd(gmul2n(BS->hal,2), gmul2n(gadd(BS->Hmu,mplog2(DEFAULTPREC)), 1));
315
tmp = gmul(BS->divro, gdiv(gel(BS->NE,i1), gel(BS->NE,i2)));
316
tmp = gmax_shallow(gen_1, abslog(tmp));
317
hb0 = gmax_shallow(hb0, gdiv(tmp, BS->bak));
318
c9 = gmul(BS->c91,hb0);
319
c9 = gprec_w(myround(c9, 1), DEFAULTPREC);
320
Indc11 = rtor(mulir(BS->Ind,BS->c11), DEFAULTPREC);
321
/* Compute B0 according to Lemma 2.3.3 */
322
B0 = mulir(shifti(BS->Ind,1),
323
divrr(addrr(mulrr(c9,mplog(divrr(mulir(BS->Ind, c9),BS->c10))),
324
mplog(Indc11)), BS->c10));
325
B0 = gmax_shallow(B0, dbltor(2.71828183));
326
B0 = gmax_shallow(B0, mulrr(divir(BS->Ind, BS->c10),
327
mplog(divrr(Indc11, BS->Pi2))));
328
if (DEBUGLEVEL>1) {
329
err_printf(" B0 = %Ps\n",B0);
330
err_printf(" Baker = %Ps\n",c9);
331
}
332
return B0;
333
}
334
335
/* || x d ||, x t_REAL, d t_INT */
336
static GEN
337
errnum(GEN x, GEN d)
338
{
339
GEN dx = mulir(d, x), D = subri(dx, roundr(dx));
340
setabssign(D); return D;
341
}
342
343
/* Try to reduce the bound through continued fractions; see paper. */
344
static int
345
CF_1stPass(GEN *B0, GEN kappa, baker_s *BS)
346
{
347
GEN a, b, q, ql, qd, l0, denbound = mulri(*B0, kappa);
348
349
if (cmprr(mulrr(dbltor(0.1),sqrr(denbound)), BS->inverrdelta) > 0)
350
return -1;
351
352
q = denom_i( bestappr(BS->delta, denbound) );
353
qd = errnum(BS->delta, q);
354
ql = errnum(BS->lambda,q);
355
356
l0 = subrr(ql, addrr(mulrr(qd, *B0), divri(dbltor(0.1),kappa)));
357
if (signe(l0) <= 0) return 0;
358
359
if (BS->r > 1) {
360
a = BS->c15; b = BS->c13;
361
}
362
else {
363
a = BS->c11; b = BS->c10;
364
l0 = mulrr(l0, Pi2n(1, DEFAULTPREC));
365
}
366
*B0 = divrr(mplog(divrr(mulir(q,a), l0)), b);
367
if (DEBUGLEVEL>1) err_printf(" B0 -> %Ps\n",*B0);
368
return 1;
369
}
370
371
static void
372
get_B0Bx(baker_s *BS, GEN l0, GEN *B0, GEN *Bx)
373
{
374
GEN t = divrr(mulir(BS->Ind, BS->c15), l0);
375
*B0 = divrr(mulir(BS->Ind, mplog(t)), BS->c13);
376
*Bx = sqrtnr(shiftr(t,1), BS->deg);
377
}
378
379
static int
380
LLL_1stPass(GEN *pB0, GEN kappa, baker_s *BS, GEN *pBx)
381
{
382
GEN B0 = *pB0, Bx = *pBx, lllmat, C, l0, l1, triv;
383
long e;
384
385
C = grndtoi(mulir(mulii(BS->Ind, kappa),
386
gpow(B0, dbltor(2.2), DEFAULTPREC)), &e);
387
388
if (DEBUGLEVEL > 1) err_printf("C (bitsize) : %d\n", expi(C));
389
lllmat = matid(3);
390
if (cmpri(B0, BS->Ind) > 0)
391
{
392
gcoeff(lllmat, 1, 1) = grndtoi(divri(B0, BS->Ind), &e);
393
triv = shiftr(sqrr(B0), 1);
394
}
395
else
396
triv = addir(sqri(BS->Ind), sqrr(B0));
397
398
gcoeff(lllmat, 3, 1) = grndtoi(negr(mulir(C, BS->lambda)), &e);
399
if (e >= 0) return -1;
400
gcoeff(lllmat, 3, 2) = grndtoi(negr(mulir(C, BS->delta)), &e);
401
if (e >= 0) return -1;
402
gcoeff(lllmat, 3, 3) = C;
403
lllmat = ZM_lll(lllmat, 0.99, LLL_IM|LLL_INPLACE);
404
405
l0 = gnorml2(gel(lllmat,1));
406
l0 = subrr(divir(l0, dbltor(1.8262)), triv); /* delta = 0.99 */
407
if (signe(l0) <= 0) return 0;
408
409
l1 = shiftr(addri(shiftr(B0,1), BS->Ind), -1);
410
l0 = divri(subrr(sqrtr(l0), l1), C);
411
412
if (signe(l0) <= 0) return 0;
413
414
get_B0Bx(BS, l0, &B0, &Bx);
415
if (DEBUGLEVEL>=2)
416
{
417
err_printf("LLL_First_Pass successful\n");
418
err_printf("B0 -> %Ps\n", B0);
419
err_printf("x <= %Ps\n", Bx);
420
}
421
*pB0 = B0; *pBx = Bx; return 1;
422
}
423
424
/* add solution (x,y) if not already known */
425
static void
426
add_sol(GEN *pS, GEN x, GEN y) { *pS = vec_append(*pS, mkvec2(x,y)); }
427
/* z = P(p,q), d = deg P, |z| = |rhs|. Check signs and (possibly)
428
* add solutions (p,q), (-p,-q) */
429
static void
430
add_pm(GEN *pS, GEN p, GEN q, GEN z, long d, GEN rhs)
431
{
432
if (signe(z) == signe(rhs))
433
{
434
add_sol(pS, p, q);
435
if (!odd(d)) add_sol(pS, negi(p), negi(q));
436
}
437
else
438
if (odd(d)) add_sol(pS, negi(p), negi(q));
439
}
440
441
/* Check whether a potential solution is a true solution. Return 0 if
442
* truncation error (increase precision) */
443
static int
444
CheckSol(GEN *pS, GEN z1, GEN z2, GEN P, GEN rhs, GEN ro)
445
{
446
GEN x, y, ro1 = gel(ro,1), ro2 = gel(ro,2);
447
long e;
448
449
y = grndtoi(real_i(gdiv(gsub(z2,z1), gsub(ro1,ro2))), &e);
450
if (e > 0) return 0;
451
if (!signe(y)) return 1; /* y = 0 taken care of in SmallSols */
452
x = gadd(z1, gmul(ro1, y));
453
x = grndtoi(real_i(x), &e);
454
if (e > 0) return 0;
455
if (e <= -13)
456
{ /* y != 0 and rhs != 0; check whether P(x,y) = rhs or P(-x,-y) = rhs */
457
GEN z = ZX_Z_eval(ZX_rescale(P,y),x);
458
if (absequalii(z, rhs)) add_pm(pS, x,y, z, degpol(P), rhs);
459
}
460
return 1;
461
}
462
463
static const long EXPO1 = 7;
464
static int
465
round_to_b(GEN v, long B, long b, GEN Delta2, long i1, GEN L)
466
{
467
long i, l = lg(v);
468
if (!b)
469
{
470
for (i = 1; i < l; i++)
471
{
472
long c;
473
if (i == i1)
474
c = 0;
475
else
476
{
477
GEN d = gneg(gel(L,i));
478
long e;
479
d = grndtoi(d,&e);
480
if (e > -EXPO1 || is_bigint(d)) return 0;
481
c = itos(d); if (labs(c) > B) return 0;
482
}
483
v[i] = c;
484
}
485
}
486
else
487
{
488
for (i = 1; i < l; i++)
489
{
490
long c;
491
if (i == i1)
492
c = b;
493
else
494
{
495
GEN d = gsub(gmulgs(gel(Delta2,i), b), gel(L,i));
496
long e;
497
d = grndtoi(d,&e);
498
if (e > -EXPO1 || is_bigint(d)) return 0;
499
c = itos(d); if (labs(c) > B) return 0;
500
}
501
v[i] = c;
502
}
503
}
504
return 1;
505
}
506
507
/* mu \prod U[i]^b[i] */
508
static ulong
509
Fl_factorback(ulong mu, GEN U, GEN b, ulong p)
510
{
511
long i, l = lg(U);
512
ulong r = mu;
513
for (i = 1; i < l; i++)
514
{
515
long c = b[i];
516
ulong u = U[i];
517
if (!c) continue;
518
if (c < 0) { u = Fl_inv(u,p); c = -c; }
519
r = Fl_mul(r, Fl_powu(u,c,p), p);
520
}
521
return r;
522
}
523
524
/* x - alpha y = \pm mu \prod \mu_i^{b_i}. Reduce mod 3 distinct primes of
525
* degree 1 above the same p, and eliminate x,y => drastic conditions on b_i */
526
static int
527
check_pr(GEN bi, GEN Lmu, GEN L)
528
{
529
GEN A = gel(L,1), U = gel(L,2);
530
ulong a = A[1], b = A[2], c = A[3], p = A[4];
531
ulong r = Fl_mul(Fl_sub(c,b,p), Fl_factorback(Lmu[1],gel(U,1),bi, p), p);
532
ulong s = Fl_mul(Fl_sub(a,c,p), Fl_factorback(Lmu[2],gel(U,2),bi, p), p);
533
ulong t = Fl_mul(Fl_sub(b,a,p), Fl_factorback(Lmu[3],gel(U,3),bi, p), p);
534
return Fl_add(Fl_add(r,s,p),t,p) == 0;
535
}
536
static int
537
check_prinfo(GEN b, GEN Lmu, GEN prinfo)
538
{
539
long i;
540
for (i = 1; i < lg(prinfo); i++)
541
if (!check_pr(b, gel(Lmu,i), gel(prinfo,i))) return 0;
542
return 1;
543
}
544
/* For each possible value of b_i1, compute the b_i's
545
* and 2 conjugates of z = x - alpha y. Then check. */
546
static int
547
TrySol(GEN *pS, GEN B0, long i1, GEN Delta2, GEN Lambda, GEN ro,
548
GEN Lmu, GEN NE, GEN MatFU, GEN prinfo, GEN P, GEN rhs)
549
{
550
long bi1, i, B = itos(gceil(B0)), l = lg(Delta2);
551
GEN b = cgetg(l,t_VECSMALL), L = cgetg(l,t_VEC);
552
553
for (i = 1; i < l; i++)
554
{
555
if (i == i1)
556
gel(L,i) = gen_0;
557
else
558
{
559
GEN delta = gel(Delta2,i);
560
gel(L, i) = gsub(gmul(delta,gel(Lambda,i1)), gel(Lambda,i));
561
}
562
}
563
for (bi1 = -B; bi1 <= B; bi1++)
564
{
565
GEN z1, z2;
566
if (!round_to_b(b, B, bi1, Delta2, i1, L)) continue;
567
if (!check_prinfo(b, Lmu, prinfo)) continue;
568
z1 = gel(NE,1);
569
z2 = gel(NE,2);
570
for (i = 1; i < l; i++)
571
{
572
z1 = gmul(z1, gpowgs(gcoeff(MatFU,1,i), b[i]));
573
z2 = gmul(z2, gpowgs(gcoeff(MatFU,2,i), b[i]));
574
}
575
if (!CheckSol(pS, z1,z2,P,rhs,ro)) return 0;
576
}
577
return 1;
578
}
579
580
/* find q1,q2,q3 st q1 b + q2 c + q3 ~ 0 */
581
static GEN
582
GuessQi(GEN b, GEN c, GEN *eps)
583
{
584
const long shift = 65;
585
GEN Q, Lat;
586
587
Lat = matid(3);
588
gcoeff(Lat,3,1) = ground(gmul2n(b, shift));
589
gcoeff(Lat,3,2) = ground(gmul2n(c, shift));
590
gcoeff(Lat,3,3) = int2n(shift);
591
592
Q = gel(lllint(Lat),1);
593
if (gequal0(gel(Q,2))) return NULL; /* FAIL */
594
595
*eps = mpadd(mpadd(gel(Q,3), mpmul(gel(Q,1),b)), mpmul(gel(Q,2),c));
596
*eps = mpabs_shallow(*eps); return Q;
597
}
598
599
/* x a t_REAL */
600
static GEN
601
myfloor(GEN x) { return expo(x) > 30 ? ceil_safe(x): floorr(x); }
602
603
/* Check for not-so-small solutions. Return a t_REAL or NULL */
604
static GEN
605
MiddleSols(GEN *pS, GEN bound, GEN roo, GEN P, GEN rhs, long s, GEN c1)
606
{
607
long j, k, nmax, d;
608
GEN bndcf;
609
610
if (expo(bound) < 0) return bound;
611
d = degpol(P);
612
bndcf = sqrtnr(shiftr(c1,1), d - 2);
613
if (cmprr(bound, bndcf) < 0) return bound;
614
/* divide by log2((1+sqrt(5))/2)
615
* 1 + ==> ceil
616
* 2 + ==> continued fraction is normalized if last entry is 1
617
* 3 + ==> start at a0, not a1 */
618
nmax = 3 + (long)(dbllog2(bound) * 1.44042009041256);
619
bound = myfloor(bound);
620
621
for (k = 1; k <= s; k++)
622
{
623
GEN ro = real_i(gel(roo,k)), t = gboundcf(ro, nmax);
624
GEN pm1, qm1, p0, q0;
625
626
pm1 = gen_0; p0 = gen_1;
627
qm1 = gen_1; q0 = gen_0;
628
629
for (j = 1; j < lg(t); j++)
630
{
631
GEN p, q, z, Q, R;
632
pari_sp av;
633
p = addii(mulii(p0, gel(t,j)), pm1); pm1 = p0; p0 = p;
634
q = addii(mulii(q0, gel(t,j)), qm1); qm1 = q0; q0 = q;
635
if (cmpii(q, bound) > 0) break;
636
if (DEBUGLEVEL >= 2) err_printf("Checking (+/- %Ps, +/- %Ps)\n",p, q);
637
av = avma;
638
z = ZX_Z_eval(ZX_rescale(P,q), p); /* = P(p/q) q^dep(P) */
639
Q = dvmdii(rhs, z, &R);
640
if (R != gen_0) { set_avma(av); continue; }
641
setabssign(Q);
642
if (Z_ispowerall(Q, d, &Q))
643
{
644
if (!is_pm1(Q)) { p = mulii(p, Q); q = mulii(q, Q); }
645
add_pm(pS, p, q, z, d, rhs);
646
}
647
}
648
if (j == lg(t))
649
{
650
long prec;
651
if (j > nmax) pari_err_BUG("thue [short continued fraction]");
652
/* the theoretical value is bit_prec = gexpo(ro)+1+log2(bound) */
653
prec = precdbl(precision(ro));
654
if (DEBUGLEVEL>1) pari_warn(warnprec,"thue",prec);
655
roo = ZX_realroots_irred(P, prec);
656
if (lg(roo)-1 != s) pari_err_BUG("thue [realroots]");
657
k--;
658
}
659
}
660
return bndcf;
661
}
662
663
static void
664
check_y_root(GEN *pS, GEN P, GEN Y)
665
{
666
GEN r = nfrootsQ(P);
667
long j;
668
for (j = 1; j < lg(r); j++)
669
if (typ(gel(r,j)) == t_INT) add_sol(pS, gel(r,j), Y);
670
}
671
672
static void
673
check_y(GEN *pS, GEN P, GEN poly, GEN Y, GEN rhs)
674
{
675
long j, l = lg(poly);
676
GEN Yn = Y;
677
gel(P, l-1) = gel(poly, l-1);
678
for (j = l-2; j >= 2; j--)
679
{
680
gel(P,j) = mulii(Yn, gel(poly,j));
681
if (j > 2) Yn = mulii(Yn, Y);
682
}
683
gel(P,2) = subii(gel(P,2), rhs); /* P = poly(Y/y)*y^deg(poly) - rhs */
684
check_y_root(pS, P, Y);
685
}
686
687
/* Check for solutions under a small bound (see paper) */
688
static GEN
689
SmallSols(GEN S, GEN x3, GEN poly, GEN rhs)
690
{
691
pari_sp av = avma;
692
GEN X, P, rhs2;
693
long j, l = lg(poly), n = degpol(poly);
694
ulong y, By;
695
696
x3 = myfloor(x3);
697
698
if (DEBUGLEVEL>1) err_printf("* Checking for small solutions <= %Ps\n", x3);
699
if (lgefint(x3) > 3)
700
pari_err_OVERFLOW(stack_sprintf("thue (SmallSols): y <= %Ps", x3));
701
By = itou(x3);
702
/* y = 0 first: solve X^n = rhs */
703
if (odd(n))
704
{
705
if (Z_ispowerall(absi_shallow(rhs), n, &X))
706
add_sol(&S, signe(rhs) > 0? X: negi(X), gen_0);
707
}
708
else if (signe(rhs) > 0 && Z_ispowerall(rhs, n, &X))
709
{
710
add_sol(&S, X, gen_0);
711
add_sol(&S, negi(X), gen_0);
712
}
713
rhs2 = shifti(rhs,1);
714
/* y != 0 */
715
P = cgetg(l, t_POL); P[1] = poly[1];
716
for (y = 1; y <= By; y++)
717
{
718
pari_sp av2 = avma;
719
long lS = lg(S);
720
GEN Y = utoipos(y);
721
/* try y */
722
check_y(&S, P, poly, Y, rhs);
723
/* try -y */
724
for (j = l-2; j >= 2; j -= 2) togglesign( gel(P,j) );
725
if (j == 0) gel(P,2) = subii(gel(P,2), rhs2);
726
check_y_root(&S, P, utoineg(y));
727
if (lS == lg(S)) { set_avma(av2); continue; } /* no solution found */
728
729
if (gc_needed(av,1))
730
{
731
if(DEBUGMEM>1) pari_warn(warnmem,"SmallSols");
732
gerepileall(av, 2, &S, &rhs2);
733
P = cgetg(l, t_POL); P[1] = poly[1];
734
}
735
}
736
return S;
737
}
738
739
/* Computes [x]! */
740
static double
741
fact(double x)
742
{
743
double ft = 1.0;
744
x = floor(x); while (x>1) { ft *= x; x--; }
745
return ft ;
746
}
747
748
static GEN
749
RgX_homogenize(GEN P, long v)
750
{
751
GEN Q = leafcopy(P);
752
long i, l = lg(P), d = degpol(P);
753
for (i = 2; i < l; i++) gel(Q,i) = monomial(gel(Q,i), d--, v);
754
return Q;
755
}
756
757
/* Compute all relevant constants needed to solve the equation P(x,y)=a given
758
* the solutions of N_{K/Q}(x)=a (see inithue). */
759
GEN
760
thueinit(GEN pol, long flag, long prec)
761
{
762
GEN POL, C, L, fa, tnf, bnf = NULL;
763
pari_sp av = avma;
764
long s, lfa, dpol;
765
766
if (checktnf(pol)) { bnf = checkbnf(gel(pol,2)); pol = gel(pol,1); }
767
if (typ(pol)!=t_POL) pari_err_TYPE("thueinit",pol);
768
dpol = degpol(pol);
769
if (dpol <= 0) pari_err_CONSTPOL("thueinit");
770
RgX_check_ZX(pol, "thueinit");
771
if (varn(pol)) { pol = leafcopy(pol); setvarn(pol, 0); }
772
773
POL = Q_primitive_part(pol, &C);
774
L = gen_1;
775
fa = ZX_factor(POL); lfa = lgcols(fa);
776
if (lfa > 2 || itos(gcoeff(fa,1,2)) > 1)
777
{ /* reducible polynomial, no need to reduce to the monic case */
778
GEN P, Q, R, g, f = gcoeff(fa,1,1), E = gcoeff(fa,1,2);
779
long e = itos(E);
780
long vy = fetch_var();
781
long va = fetch_var();
782
long vb = fetch_var();
783
C = C? ginv(C): gen_1;
784
if (e != 1)
785
{
786
if (lfa == 2) {
787
tnf = mkvec3(mkvec3(POL,C,L), thueinit(f, flag, prec), E);
788
delete_var(); delete_var(); delete_var();
789
return gerepilecopy(av, tnf);
790
}
791
P = gpowgs(f,e);
792
}
793
else
794
P = f;
795
g = RgX_div(POL, P);
796
P = RgX_Rg_sub(RgX_homogenize(f, vy), pol_x(va));
797
Q = RgX_Rg_sub(RgX_homogenize(g, vy), pol_x(vb));
798
R = polresultant0(P, Q, -1, 0);
799
tnf = mkvec3(mkvec3(POL,C,L), mkvecsmall4(degpol(f), e, va,vb), R);
800
delete_var(); delete_var(); delete_var();
801
return gerepilecopy(av, tnf);
802
}
803
/* POL monic irreducible: POL(x) = C pol(x/L), L integer */
804
POL = ZX_primitive_to_monic(POL, &L);
805
C = gdiv(powiu(L, dpol), gel(pol, dpol+2));
806
pol = POL;
807
808
s = ZX_sturm_irred(pol);
809
if (s)
810
{
811
long PREC, n = degpol(pol);
812
double d, dr, dn = (double)n;
813
814
if (dpol <= 2) pari_err_DOMAIN("thueinit", "P","=",pol,pol);
815
dr = (double)((s+n-2)>>1); /* s+t-1 */
816
d = dn*(dn-1)*(dn-2);
817
/* Guess precision by approximating Baker's bound. The guess is most of
818
* the time not sharp, ie 10 to 30 decimal digits above what is _really_
819
* necessary. Note that the limiting step is the reduction. See paper. */
820
PREC = nbits2prec((long)((5.83 + (dr+4)*5 + log(fact(dr+3)) + (dr+3)*log(dr+2) +
821
(dr+3)*log(d) + log(log(2*d*(dr+2))) + (dr+1))
822
/10.)*32+32);
823
824
if (flag == 0) PREC = (long)(2.2 * PREC); /* Lazy, to be improved */
825
if (PREC < prec) PREC = prec;
826
if (DEBUGLEVEL >=2) err_printf("prec = %d\n", PREC);
827
828
for (;;)
829
{
830
if (( tnf = inithue(pol, bnf, flag, PREC) )) break;
831
PREC = precdbl(PREC);
832
if (DEBUGLEVEL>1) pari_warn(warnprec,"thueinit",PREC);
833
bnf = NULL; set_avma(av);
834
}
835
}
836
else
837
{
838
GEN ro, c0;
839
long k,l;
840
if (!bnf)
841
{
842
bnf = gen_0;
843
if (expi(ZX_disc(pol)) <= 50)
844
{
845
bnf = Buchall(pol, nf_FORCE, DEFAULTPREC);
846
if (flag) (void)bnfcertify(bnf);
847
}
848
}
849
ro = typ(bnf)==t_VEC? nf_get_roots(bnf_get_nf(bnf))
850
: QX_complex_roots(pol, DEFAULTPREC);
851
l = lg(ro); c0 = imag_i(gel(ro,1));
852
for (k = 2; k < l; k++) c0 = mulrr(c0, imag_i(gel(ro,k)));
853
setsigne(c0,1); c0 = invr(c0); tnf = mkvec3(pol, bnf, c0);
854
}
855
gel(tnf,1) = mkvec3(gel(tnf,1), C, L);
856
return gerepilecopy(av,tnf);
857
}
858
859
/* arg(t^2) / 2Pi; arg(t^2) = arg(t/conj(t)) */
860
static GEN
861
argsqr(GEN t, GEN Pi)
862
{
863
GEN v, u = divrr(garg(t,0), Pi); /* in -1 < u <= 1 */
864
/* reduce mod Z to -1/2 < u <= 1/2 */
865
if (signe(u) > 0)
866
{
867
v = subrs(u,1); /* ]-1,0] */
868
if (abscmprr(v,u) < 0) u = v;
869
}
870
else
871
{
872
v = addrs(u,1);/* ]0,1] */
873
if (abscmprr(v,u) <= 0) u = v;
874
}
875
return u;
876
}
877
/* i1 != i2 */
878
static void
879
init_get_B(long i1, long i2, GEN Delta2, GEN Lambda, GEN Deps5, baker_s *BS,
880
long prec)
881
{
882
GEN delta, lambda;
883
if (BS->r > 1)
884
{
885
delta = gel(Delta2,i2);
886
lambda = gsub(gmul(delta,gel(Lambda,i1)), gel(Lambda,i2));
887
if (Deps5) BS->inverrdelta = divrr(Deps5, addsr(1,delta));
888
}
889
else
890
{ /* r == 1: i1 = s = t = 1; i2 = 2 */
891
GEN fu = gel(BS->MatFU,1), ro = BS->ro, t;
892
893
t = gel(fu,2);
894
delta = argsqr(t, BS->Pi);
895
if (Deps5) BS->inverrdelta = shiftr(gabs(t,prec), prec2nbits(prec)-1);
896
897
t = gmul(gsub(gel(ro,1), gel(ro,2)), gel(BS->NE,3));
898
lambda = argsqr(t, BS->Pi);
899
}
900
BS->delta = delta;
901
BS->lambda = lambda;
902
}
903
904
static GEN
905
get_B0(long i1, GEN Delta2, GEN Lambda, GEN Deps5, long prec, baker_s *BS)
906
{
907
GEN B0 = Baker(BS);
908
long step = 0, i2 = (i1 == 1)? 2: 1;
909
for(;;) /* i2 from 1 to r unless r = 1 [then i2 = 2] */
910
{
911
init_get_B(i1,i2, Delta2,Lambda,Deps5, BS, prec);
912
/* Reduce B0 as long as we make progress: newB0 < oldB0 - 0.1 */
913
for (;;)
914
{
915
GEN oldB0 = B0, kappa = utoipos(10);
916
long cf;
917
918
for (cf = 0; cf < 10; cf++, kappa = muliu(kappa,10))
919
{
920
int res = CF_1stPass(&B0, kappa, BS);
921
if (res < 0) return NULL; /* prec problem */
922
if (res) break;
923
if (DEBUGLEVEL>1) err_printf("CF failed. Increasing kappa\n");
924
}
925
if (!step && cf == 10)
926
{ /* Semirational or totally rational case */
927
GEN Q, ep, q, l0, denbound;
928
929
if (! (Q = GuessQi(BS->delta, BS->lambda, &ep)) ) break;
930
931
denbound = mpadd(B0, absi_shallow(gel(Q,1)));
932
q = denom_i( bestappr(BS->delta, denbound) );
933
l0 = subrr(errnum(BS->delta, q), ep);
934
if (signe(l0) <= 0) break;
935
936
B0 = divrr(mplog(divrr(mulir(gel(Q,2), BS->c15), l0)), BS->c13);
937
if (DEBUGLEVEL>1) err_printf("Semirat. reduction: B0 -> %Ps\n",B0);
938
}
939
/* if no progress, stop */
940
if (gcmp(oldB0, gadd(B0,dbltor(0.1))) <= 0)
941
return gmin_shallow(oldB0, B0);
942
else step++;
943
}
944
i2++; if (i2 == i1) i2++;
945
if (i2 > BS->r) break;
946
}
947
pari_err_BUG("thue (totally rational case)");
948
return NULL; /* LCOV_EXCL_LINE */
949
}
950
951
static GEN
952
get_Bx_LLL(long i1, GEN Delta2, GEN Lambda, long prec, baker_s *BS)
953
{
954
GEN B0 = Baker(BS), Bx = NULL;
955
long step = 0, i2 = (i1 == 1)? 2: 1;
956
for(;;) /* i2 from 1 to r unless r = 1 [then i2 = 2] */
957
{
958
init_get_B(i1,i2, Delta2,Lambda,NULL, BS, prec);
959
if (DEBUGLEVEL>1) err_printf(" Entering LLL...\n");
960
/* Reduce B0 as long as we make progress: newB0 < oldB0 - 0.1 */
961
for (;;)
962
{
963
GEN oldBx = Bx, kappa = utoipos(10);
964
const long cfMAX = 10;
965
long cf;
966
967
for (cf = 0; cf < cfMAX; cf++, kappa = muliu(kappa,10))
968
{
969
int res = LLL_1stPass(&B0, kappa, BS, &Bx);
970
if (res < 0) return NULL;
971
if (res) break;
972
if (DEBUGLEVEL>1) err_printf("LLL failed. Increasing kappa\n");
973
}
974
975
/* FIXME: TO BE COMPLETED */
976
if (!step && cf == cfMAX)
977
{ /* Semirational or totally rational case */
978
GEN Q, Q1, Q2, ep, q, l0, denbound;
979
980
if (! (Q = GuessQi(BS->delta, BS->lambda, &ep)) ) break;
981
982
/* Q[2] != 0 */
983
Q1 = absi_shallow(gel(Q,1));
984
Q2 = absi_shallow(gel(Q,2));
985
denbound = gadd(mulri(B0, Q1), mulii(BS->Ind, Q2));
986
q = denom_i( bestappr(BS->delta, denbound) );
987
l0 = divri(subrr(errnum(BS->delta, q), ep), Q2);
988
if (signe(l0) <= 0) break;
989
990
get_B0Bx(BS, l0, &B0, &Bx);
991
if (DEBUGLEVEL>1)
992
err_printf("Semirat. reduction: B0 -> %Ps x <= %Ps\n",B0, Bx);
993
}
994
/* if no progress, stop */
995
if (oldBx && gcmp(oldBx, Bx) <= 0) return oldBx; else step++;
996
}
997
i2++; if (i2 == i1) i2++;
998
if (i2 > BS->r) break;
999
}
1000
pari_err_BUG("thue (totally rational case)");
1001
return NULL; /* LCOV_EXCL_LINE */
1002
}
1003
1004
static GEN
1005
LargeSols(GEN P, GEN tnf, GEN rhs, GEN ne)
1006
{
1007
GEN S = NULL, Delta0, ro, ALH, bnf, nf, MatFU, A, csts, dP, Bx;
1008
GEN c1,c2,c3,c4,c90,c91,c14, x0, x1, x2, x3, tmp, eps5, prinfo;
1009
long iroot, ine, n, r, Prec, prec, s,t;
1010
baker_s BS;
1011
pari_sp av = avma;
1012
1013
prec = 0; /*-Wall*/
1014
bnf = NULL; /*-Wall*/
1015
iroot = 1;
1016
ine = 1;
1017
1018
START:
1019
if (S) /* restart from precision problems */
1020
{
1021
S = gerepilecopy(av, S);
1022
prec = precdbl(prec);
1023
if (DEBUGLEVEL) pari_warn(warnprec,"thue",prec);
1024
tnf = inithue(P, bnf, 0, prec);
1025
}
1026
else
1027
S = cgetg(1, t_VEC);
1028
bnf= gel(tnf,2);
1029
nf = bnf_get_nf(bnf);
1030
csts = gel(tnf,7);
1031
nf_get_sign(nf, &s, &t);
1032
BS.r = r = s+t-1; n = degpol(P);
1033
ro = gel(tnf,3);
1034
ALH = gel(tnf,4);
1035
MatFU = gel(tnf,5);
1036
A = gel(tnf,6);
1037
c1 = mpmul(absi_shallow(rhs), gel(csts,1));
1038
c2 = gel(csts,2);
1039
BS.hal = gel(csts,3);
1040
x0 = gel(csts,4);
1041
eps5 = gel(csts,5);
1042
Prec = itos(gel(csts,6));
1043
BS.Ind = gel(csts,7);
1044
BS.MatFU = MatFU;
1045
BS.bak = muluu(n, (n-1)*(n-2)); /* safe */
1046
BS.deg = n;
1047
prinfo = gel(csts,8);
1048
1049
if (t) x0 = gmul(x0, absisqrtn(rhs, n, Prec));
1050
tmp = divrr(c1,c2);
1051
c3 = mulrr(dbltor(1.39), tmp);
1052
c4 = mulur(n-1, c3);
1053
c14 = mulrr(c4, vecmax_shallow(RgM_sumcol(gabs(A,DEFAULTPREC))));
1054
1055
x1 = gmax_shallow(x0, sqrtnr(shiftr(tmp,1),n));
1056
x2 = gmax_shallow(x1, sqrtnr(mulur(10,c14), n));
1057
x3 = gmax_shallow(x2, sqrtnr(shiftr(c14, EXPO1+1),n));
1058
c90 = gmul(shiftr(mulur(18,mppi(DEFAULTPREC)), 5*(4+r)),
1059
gmul(gmul(mpfact(r+3), powiu(muliu(BS.bak,r+2), r+3)),
1060
glog(muliu(BS.bak,2*(r+2)),DEFAULTPREC)));
1061
1062
dP = ZX_deriv(P);
1063
Delta0 = RgM_sumcol(A);
1064
1065
for (; iroot<=s; iroot++)
1066
{
1067
GEN Delta = Delta0, Delta2, D, Deps5, MatNE, Hmu, diffRo, c5, c7, ro0;
1068
long i1, iroot1, iroot2, k;
1069
1070
if (iroot <= r) Delta = RgC_add(Delta, RgC_Rg_mul(gel(A,iroot), stoi(-n)));
1071
D = gabs(Delta,Prec); i1 = vecindexmax(D);
1072
c5 = gel(D, i1);
1073
Delta2 = RgC_Rg_div(Delta, gel(Delta, i1));
1074
c5 = myround(gprec_w(c5,DEFAULTPREC), 1);
1075
Deps5 = divrr(subrr(c5,eps5), eps5);
1076
c7 = mulur(r,c5);
1077
BS.c10 = divur(n,c7);
1078
BS.c13 = divur(n,c5);
1079
if (DEBUGLEVEL>1) {
1080
err_printf("* real root no %ld/%ld\n", iroot,s);
1081
err_printf(" c10 = %Ps\n",BS.c10);
1082
err_printf(" c13 = %Ps\n",BS.c13);
1083
}
1084
1085
prec = Prec;
1086
for (;;)
1087
{
1088
if (( MatNE = Conj_LH(ne, &Hmu, ro, prec) )) break;
1089
prec = precdbl(prec);
1090
if (DEBUGLEVEL>1) pari_warn(warnprec,"thue",prec);
1091
ro = tnf_get_roots(P, prec, s, t);
1092
}
1093
ro0 = gel(ro,iroot);
1094
BS.ro = ro;
1095
BS.iroot = iroot;
1096
BS.Pi = mppi(prec);
1097
BS.Pi2 = Pi2n(1,prec);
1098
diffRo = cgetg(r+1, t_VEC);
1099
for (k=1; k<=r; k++)
1100
{
1101
GEN z = gel(ro,k);
1102
z = (k == iroot)? gdiv(rhs, poleval(dP, z)): gsub(ro0, z);
1103
gel(diffRo,k) = gabs(z, prec);
1104
}
1105
other_roots(iroot, &iroot1,&iroot2);
1106
BS.divro = gdiv(gsub(ro0, gel(ro,iroot2)), gsub(ro0, gel(ro,iroot1)));
1107
/* Compute h_1....h_r */
1108
c91 = c90;
1109
for (k=1; k<=r; k++)
1110
{
1111
GEN z = gdiv(gcoeff(MatFU,iroot1,k), gcoeff(MatFU,iroot2,k));
1112
z = gmax_shallow(gen_1, abslog(z));
1113
c91 = gmul(c91, gmax_shallow(gel(ALH,k), gdiv(z, BS.bak)));
1114
}
1115
BS.c91 = c91;
1116
1117
for (; ine<lg(ne); ine++)
1118
{
1119
pari_sp av2 = avma;
1120
long lS = lg(S);
1121
GEN Lambda, B0, c6, c8;
1122
GEN NE = gel(MatNE,ine), v = cgetg(r+1,t_COL);
1123
1124
if (DEBUGLEVEL>1) err_printf(" - norm sol. no %ld/%ld\n",ine,lg(ne)-1);
1125
for (k=1; k<=r; k++)
1126
{
1127
GEN z = gdiv(gel(diffRo,k), gabs(gel(NE,k), prec));
1128
gel(v,k) = glog(z, prec);
1129
}
1130
Lambda = RgM_RgC_mul(A,v);
1131
1132
c6 = addrr(dbltor(0.1), vecmax_shallow(gabs(Lambda,DEFAULTPREC)));
1133
c6 = myround(c6, 1);
1134
c8 = addrr(dbltor(1.23), mulur(r,c6));
1135
BS.c11= mulrr(shiftr(c3,1) , mpexp(divrr(mulur(n,c8),c7)));
1136
BS.c15= mulrr(shiftr(c14,1), mpexp(divrr(mulur(n,c6),c5)));
1137
BS.NE = NE;
1138
BS.Hmu = gel(Hmu,ine);
1139
if (is_pm1(BS.Ind))
1140
{
1141
GEN mu = gel(ne,ine), Lmu = cgetg(lg(prinfo),t_VEC);
1142
long i, j;
1143
1144
for (i = 1; i < lg(prinfo); i++)
1145
{
1146
GEN v = gel(prinfo,i), PR = gel(v,3), L = cgetg(4, t_VECSMALL);
1147
for (j = 1; j <= 3; j++) L[j] = itou(nf_to_Fq(nf, mu, gel(PR,j)));
1148
gel(Lmu, i) = L;
1149
}
1150
if (! (B0 = get_B0(i1, Delta2, Lambda, Deps5, prec, &BS)) ||
1151
!TrySol(&S, B0, i1, Delta2, Lambda, ro, Lmu, NE,MatFU,prinfo,
1152
P,rhs))
1153
goto START;
1154
if (lg(S) == lS) set_avma(av2);
1155
}
1156
else
1157
{
1158
if (! (Bx = get_Bx_LLL(i1, Delta2, Lambda, prec, &BS)) )
1159
goto START;
1160
x3 = gerepileupto(av2, gmax_shallow(Bx, x3));
1161
}
1162
}
1163
ine = 1;
1164
}
1165
x3 = gmax_shallow(x0, MiddleSols(&S, x3, ro, P, rhs, s, c1));
1166
return SmallSols(S, x3, P, rhs);
1167
}
1168
1169
/* restrict to solutions (x,y) with L | x, replacing each by (x/L, y) */
1170
static GEN
1171
filter_sol_x(GEN S, GEN L)
1172
{
1173
long i, k, l;
1174
if (is_pm1(L)) return S;
1175
l = lg(S); k = 1;
1176
for (i = 1; i < l; i++)
1177
{
1178
GEN s = gel(S,i), r;
1179
gel(s,1) = dvmdii(gel(s,1), L, &r);
1180
if (r == gen_0) gel(S, k++) = s;
1181
}
1182
setlg(S, k); return S;
1183
}
1184
static GEN
1185
filter_sol_Z(GEN S)
1186
{
1187
long i, k = 1, l = lg(S);
1188
for (i = 1; i < l; i++)
1189
{
1190
GEN s = gel(S,i);
1191
if (RgV_is_ZV(s)) gel(S, k++) = s;
1192
}
1193
setlg(S, k); return S;
1194
}
1195
1196
static GEN bnfisintnorm_i(GEN bnf, GEN a, long s, GEN z);
1197
static GEN
1198
tnf_get_Ind(GEN tnf) { return gmael(tnf,7,7); }
1199
static GEN
1200
tnf_get_bnf(GEN tnf) { return gel(tnf,2); }
1201
1202
static void
1203
maybe_warn(GEN bnf, GEN a, GEN Ind)
1204
{
1205
if (!is_pm1(Ind) && !is_pm1(bnf_get_no(bnf)) && !is_pm1(a))
1206
pari_warn(warner, "The result returned by 'thue' is conditional on the GRH");
1207
}
1208
static GEN bnfisintnorm_fa(GEN bnf, GEN a, GEN fa, long sa);
1209
/* return solutions of Norm(x) = a mod U(K)^+ */
1210
static GEN
1211
get_ne(GEN bnf, GEN a, GEN fa, GEN Ind)
1212
{
1213
if (DEBUGLEVEL) maybe_warn(bnf,a,Ind);
1214
return bnfisintnorm_fa(bnf, a, fa, signe(a));
1215
}
1216
/* return solutions of |Norm(x)| = |a| mod U(K) */
1217
static GEN
1218
get_neabs(GEN bnf, GEN a, GEN Ind)
1219
{
1220
if (DEBUGLEVEL) maybe_warn(bnf,a,Ind);
1221
return bnfisintnormabs(bnf, a);
1222
}
1223
1224
/* Let P(z)=z^2+Bz+C, convert t=u+v*z (mod P) solution of norm equation N(t)=A
1225
* to [x,y] = [u,-v] form: y^2P(x/y) = A */
1226
static GEN
1227
ne2_to_xy(GEN t)
1228
{
1229
GEN u,v;
1230
if (typ(t) != t_POL) { u = t; v = gen_0; }
1231
else switch(degpol(t))
1232
{
1233
case -1: u = v = gen_0; break;
1234
case 0: u = gel(t,2); v = gen_0; break;
1235
default: u = gel(t,2); v = gneg(gel(t,3));
1236
}
1237
return mkvec2(u, v);
1238
}
1239
static GEN
1240
ne2V_to_xyV(GEN v)
1241
{
1242
long i, l;
1243
GEN w = cgetg_copy(v,&l);
1244
for (i=1; i<l; i++) gel(w,i) = ne2_to_xy(gel(v,i));
1245
return w;
1246
}
1247
1248
static GEN
1249
sol_0(void) { retmkvec( mkvec2(gen_0,gen_0) ); }
1250
static void
1251
sols_from_R(GEN Rab, GEN *pS, GEN P, GEN POL, GEN rhs)
1252
{
1253
GEN ry = nfrootsQ(Rab);
1254
long k, l = lg(ry);
1255
for (k = 1; k < l; k++)
1256
if (typ(gel(ry,k)) == t_INT) check_y(pS, P, POL, gel(ry,k), rhs);
1257
}
1258
static GEN
1259
absZ_factor_if_easy(GEN rhs, GEN x3)
1260
{
1261
GEN F, U;
1262
if (expi(rhs) < 150 || expo(x3) >= BITS_IN_LONG) return absZ_factor(rhs);
1263
F = absZ_factor_limit_strict(rhs, 500000, &U);
1264
return U? NULL: F;
1265
}
1266
/* Given a tnf structure as returned by thueinit, a RHS and
1267
* optionally the solutions to the norm equation, returns the solutions to
1268
* the Thue equation F(x,y)=a */
1269
GEN
1270
thue(GEN tnf, GEN rhs, GEN ne)
1271
{
1272
pari_sp av = avma;
1273
GEN POL, C, L, x3, S;
1274
1275
if (typ(tnf) == t_POL) tnf = thueinit(tnf, 0, DEFAULTPREC);
1276
if (!checktnf(tnf)) pari_err_TYPE("thue [please apply thueinit()]", tnf);
1277
if (typ(rhs) != t_INT) pari_err_TYPE("thue",rhs);
1278
if (ne && typ(ne) != t_VEC) pari_err_TYPE("thue",ne);
1279
1280
/* solve P(x,y) = rhs <=> POL(L x, y) = C rhs, with POL monic in Z[X] */
1281
POL = gel(tnf,1);
1282
C = gel(POL,2); rhs = gmul(C, rhs);
1283
if (typ(rhs) != t_INT) { set_avma(av); return cgetg(1, t_VEC); }
1284
if (!signe(rhs))
1285
{
1286
GEN v = gel(tnf,2);
1287
set_avma(av);
1288
/* at least 2 irreducible factors, one of which has degree 1 */
1289
if (typ(v) == t_VECSMALL && v[1] ==1)
1290
pari_err_DOMAIN("thue","#sols","=",strtoGENstr("oo"),rhs);
1291
return sol_0();
1292
}
1293
L = gel(POL,3);
1294
POL = gel(POL,1);
1295
if (lg(tnf) == 8)
1296
{
1297
if (!ne)
1298
{
1299
GEN F = absZ_factor(rhs);
1300
ne = get_ne(tnf_get_bnf(tnf), rhs, F, tnf_get_Ind(tnf));
1301
}
1302
if (lg(ne) == 1) { set_avma(av); return cgetg(1, t_VEC); }
1303
S = LargeSols(POL, tnf, rhs, ne);
1304
}
1305
else if (typ(gel(tnf,3)) == t_REAL)
1306
{ /* Case s=0. All solutions are "small". */
1307
GEN bnf = tnf_get_bnf(tnf);
1308
GEN c0 = gel(tnf,3), F;
1309
x3 = sqrtnr(mulir(absi_shallow(rhs),c0), degpol(POL));
1310
x3 = addrr(x3, dbltor(0.1)); /* guard from round-off errors */
1311
S = cgetg(1,t_VEC);
1312
if (!ne && typ(bnf) == t_VEC && expo(x3) > 10)
1313
{
1314
F = absZ_factor_if_easy(rhs, x3);
1315
if (F) ne = get_ne(bnf, rhs, F, gen_1);
1316
}
1317
if (ne)
1318
{
1319
if (lg(ne) == 1) { set_avma(av); return cgetg(1,t_VEC); }
1320
if (degpol(POL) == 2) /* quadratic imaginary */
1321
{
1322
GEN u = NULL;
1323
long w = 2;
1324
if (typ(bnf) == t_VEC)
1325
{
1326
u = bnf_get_tuU(bnf);
1327
w = bnf_get_tuN(bnf);
1328
}
1329
else
1330
{
1331
GEN D = coredisc(ZX_disc(POL));
1332
if (cmpis(D, -4) >= 0)
1333
{
1334
GEN F, T = quadpoly(D);
1335
w = equalis(D, -4)? 4: 6;
1336
setvarn(T, fetch_var_higher());
1337
F = gcoeff(nffactor(POL, T), 1, 1);
1338
u = gneg(lift_shallow(gel(F,2))); delete_var();
1339
}
1340
}
1341
if (w == 4) /* u = I */
1342
ne = shallowconcat(ne, RgXQV_RgXQ_mul(ne,u,POL));
1343
else if (w == 6) /* u = j */
1344
{
1345
GEN u2 = RgXQ_sqr(u,POL);
1346
ne = shallowconcat1(mkvec3(ne, RgXQV_RgXQ_mul(ne,u,POL),
1347
RgXQV_RgXQ_mul(ne,u2,POL)));
1348
}
1349
S = ne2V_to_xyV(ne);
1350
S = filter_sol_Z(S);
1351
S = shallowconcat(S, RgV_neg(S));
1352
}
1353
}
1354
if (lg(S) == 1) S = SmallSols(S, x3, POL, rhs);
1355
}
1356
else if (typ(gel(tnf,3)) == t_INT) /* reducible case, pure power*/
1357
{
1358
GEN bnf, ne1 = NULL, ne2 = NULL;
1359
long e = itos( gel(tnf,3) );
1360
if (!Z_ispowerall(rhs, e, &rhs)) { set_avma(av); return cgetg(1, t_VEC); }
1361
tnf = gel(tnf,2);
1362
bnf = tnf_get_bnf(tnf);
1363
ne = get_neabs(bnf, rhs, lg(tnf)==8?tnf_get_Ind(tnf): gen_1);
1364
ne1= bnfisintnorm_i(bnf,rhs,1,ne);
1365
S = thue(tnf, rhs, ne1);
1366
if (!odd(e) && lg(tnf)==8) /* if s=0, norms are positive */
1367
{
1368
ne2 = bnfisintnorm_i(bnf,rhs,-1,ne);
1369
S = shallowconcat(S, thue(tnf, negi(rhs), ne2));
1370
}
1371
}
1372
else /* other reducible cases */
1373
{ /* solve f^e * g = rhs, f irreducible factor of smallest degree */
1374
GEN P, D, v = gel(tnf, 2), R = gel(tnf, 3);
1375
long i, l, e = v[2], va = v[3], vb = v[4];
1376
P = cgetg(lg(POL), t_POL); P[1] = POL[1];
1377
D = divisors(rhs); l = lg(D);
1378
S = cgetg(1,t_VEC);
1379
for (i = 1; i < l; i++)
1380
{
1381
GEN Rab, df = gel(D,i), dg = gel(D,l-i); /* df*dg=|rhs| */
1382
if (e > 1 && !Z_ispowerall(df, e, &df)) continue;
1383
/* Rab: univariate polynomial in Z[Y], whose roots are the possible y. */
1384
/* Here and below, Rab != 0 */
1385
if (signe(rhs) < 0) dg = negi(dg); /* df*dg=rhs */
1386
Rab = gsubst(gsubst(R, va, df), vb, dg);
1387
sols_from_R(Rab, &S,P,POL,rhs);
1388
Rab = gsubst(gsubst(R, va, negi(df)), vb, odd(e)? negi(dg): dg);
1389
sols_from_R(Rab, &S,P,POL,rhs);
1390
}
1391
}
1392
S = filter_sol_x(S, L);
1393
S = gen_sort_uniq(S, (void*)lexcmp, cmp_nodata);
1394
return gerepileupto(av, S);
1395
}
1396
1397
/********************************************************************/
1398
/** **/
1399
/** BNFISINTNORM (K. Belabas) **/
1400
/** **/
1401
/********************************************************************/
1402
struct sol_abs
1403
{
1404
GEN rel; /* Primes PR[i] above a, expressed on generators of Cl(K) */
1405
GEN partrel; /* list of vectors, partrel[i] = rel[1..i] * u[1..i] */
1406
GEN cyc; /* orders of generators of Cl(K) given in bnf */
1407
1408
long *f; /* f[i] = f(PR[i]/p), inertia degree */
1409
long *n; /* a = prod p^{ n_p }. n[i]=n_p if PR[i] divides p */
1410
long *next; /* index of first P above next p, 0 if p is last */
1411
long *S; /* S[i] = n[i] - sum_{ 1<=k<=i } f[k]*u[k] */
1412
long *u; /* We want principal ideals I = prod PR[i]^u[i] */
1413
GEN normsol;/* lists of copies of the u[] which are solutions */
1414
1415
long nPR; /* length(T->rel) = #PR */
1416
long sindex, smax; /* current index in T->normsol; max. index */
1417
};
1418
1419
/* u[1..i] has been filled. Norm(u) is correct.
1420
* Check relations in class group then save it. */
1421
static void
1422
test_sol(struct sol_abs *T, long i)
1423
{
1424
long k, l;
1425
GEN s;
1426
1427
if (T->partrel && !ZV_dvd(gel(T->partrel, i), T->cyc)) return;
1428
if (T->sindex == T->smax)
1429
{ /* no more room in solution list: enlarge */
1430
long new_smax = T->smax << 1;
1431
GEN new_normsol = new_chunk(new_smax+1);
1432
1433
for (k=1; k<=T->smax; k++) gel(new_normsol,k) = gel(T->normsol,k);
1434
T->normsol = new_normsol; T->smax = new_smax;
1435
}
1436
gel(T->normsol, ++T->sindex) = s = cgetg_copy(T->u, &l);
1437
for (k=1; k <= i; k++) s[k] = T->u[k];
1438
for ( ; k < l; k++) s[k] = 0;
1439
if (DEBUGLEVEL>2)
1440
{
1441
err_printf("sol = %Ps\n",s);
1442
if (T->partrel) err_printf("T->partrel = %Ps\n",T->partrel);
1443
}
1444
}
1445
/* partrel[i] <-- partrel[i-1] + u[i] * rel[i] */
1446
static void
1447
fix_partrel(struct sol_abs *T, long i)
1448
{
1449
pari_sp av = avma;
1450
GEN part1 = gel(T->partrel,i);
1451
GEN part0 = gel(T->partrel,i-1);
1452
GEN rel = gel(T->rel, i);
1453
ulong u = T->u[i];
1454
long k, l = lg(part1);
1455
for (k=1; k < l; k++)
1456
affii(addii(gel(part0,k), muliu(gel(rel,k), u)), gel(part1,k));
1457
set_avma(av);
1458
}
1459
1460
/* Recursive loop. Suppose u[1..i] has been filled
1461
* Find possible solutions u such that, Norm(prod PR[i]^u[i]) = a, taking
1462
* into account:
1463
* 1) the relations in the class group if need be.
1464
* 2) the factorization of a. */
1465
static void
1466
isintnorm_loop(struct sol_abs *T, long i)
1467
{
1468
if (T->S[i] == 0) /* sum u[i].f[i] = n[i], do another prime */
1469
{
1470
long k, next = T->next[i];
1471
if (next == 0) { test_sol(T, i); return; } /* no primes left */
1472
1473
/* some primes left */
1474
if (T->partrel) gaffect(gel(T->partrel,i), gel(T->partrel, next-1));
1475
for (k=i+1; k < next; k++) T->u[k] = 0;
1476
i = next-1;
1477
}
1478
else if (i == T->next[i]-2 || i == T->nPR-1)
1479
{ /* only one Prime left above prime; change prime, fix u[i+1] */
1480
long q;
1481
if (T->S[i] % T->f[i+1]) return;
1482
q = T->S[i] / T->f[i+1];
1483
i++; T->u[i] = q;
1484
if (T->partrel) fix_partrel(T,i);
1485
if (T->next[i] == 0) { test_sol(T,i); return; }
1486
}
1487
1488
i++; T->u[i] = 0;
1489
if (T->partrel) gaffect(gel(T->partrel,i-1), gel(T->partrel,i));
1490
if (i == T->next[i-1])
1491
{ /* change prime */
1492
if (T->next[i] == i+1 || i == T->nPR) /* only one Prime above p */
1493
{
1494
T->S[i] = 0;
1495
T->u[i] = T->n[i] / T->f[i]; /* we already know this is exact */
1496
if (T->partrel) fix_partrel(T, i);
1497
}
1498
else T->S[i] = T->n[i];
1499
}
1500
else T->S[i] = T->S[i-1]; /* same prime, different Prime */
1501
for(;;)
1502
{
1503
isintnorm_loop(T, i);
1504
T->S[i] -= T->f[i]; if (T->S[i] < 0) break;
1505
T->u[i]++;
1506
if (T->partrel) {
1507
pari_sp av = avma;
1508
gaffect(ZC_add(gel(T->partrel,i), gel(T->rel,i)), gel(T->partrel,i));
1509
set_avma(av);
1510
}
1511
}
1512
}
1513
1514
static int
1515
get_sol_abs(struct sol_abs *T, GEN bnf, GEN nf, GEN fact, GEN *ptPR)
1516
{
1517
GEN P = gel(fact,1), E = gel(fact,2), PR;
1518
long N = nf_get_degree(nf), nP = lg(P)-1, Ngen, max, nPR, i, j;
1519
1520
max = nP*N; /* upper bound for T->nPR */
1521
T->f = new_chunk(max+1);
1522
T->n = new_chunk(max+1);
1523
T->next = new_chunk(max+1);
1524
*ptPR = PR = cgetg(max+1, t_COL); /* length to be fixed later */
1525
1526
nPR = 0;
1527
for (i = 1; i <= nP; i++)
1528
{
1529
GEN L = idealprimedec(nf, gel(P,i));
1530
long lL = lg(L), gcd, k, v;
1531
ulong vn = itou(gel(E,i));
1532
1533
/* check that gcd_{P | p} f_P divides n_p */
1534
gcd = pr_get_f(gel(L,1));
1535
for (j=2; gcd > 1 && j < lL; j++) gcd = ugcd(gcd, pr_get_f(gel(L,j)));
1536
if (gcd > 1 && vn % gcd)
1537
{
1538
if (DEBUGLEVEL>2) err_printf("gcd f_P does not divide n_p\n");
1539
return 0;
1540
}
1541
v = (i==nP)? 0: nPR + lL;
1542
for (k = 1; k < lL; k++)
1543
{
1544
GEN pr = gel(L,k);
1545
gel(PR, ++nPR) = pr;
1546
T->f[nPR] = pr_get_f(pr) / gcd;
1547
T->n[nPR] = vn / gcd;
1548
T->next[nPR] = v;
1549
}
1550
}
1551
T->nPR = nPR;
1552
setlg(PR, nPR + 1);
1553
1554
T->u = cgetg(nPR+1, t_VECSMALL);
1555
T->S = new_chunk(nPR+1);
1556
if (bnf) { T->cyc = bnf_get_cyc(bnf); Ngen = lg(T->cyc)-1; }
1557
else { T->cyc = NULL; Ngen = 0; }
1558
if (Ngen == 0)
1559
T->rel = T->partrel = NULL; /* trivial Cl(K), no relations to check */
1560
else
1561
{
1562
int triv = 1;
1563
T->partrel = new_chunk(nPR+1);
1564
T->rel = new_chunk(nPR+1);
1565
for (i=1; i <= nPR; i++)
1566
{
1567
GEN c = isprincipal(bnf, gel(PR,i));
1568
gel(T->rel,i) = c;
1569
if (triv && !ZV_equal0(c)) triv = 0; /* non trivial relations in Cl(K)*/
1570
}
1571
/* triv = 1: all ideals dividing a are principal */
1572
if (triv) T->rel = T->partrel = NULL;
1573
}
1574
if (T->partrel)
1575
{
1576
long B = ZV_max_lg(T->cyc) + 3;
1577
for (i = 0; i <= nPR; i++)
1578
{ /* T->partrel[0] also needs to be initialized */
1579
GEN c = cgetg(Ngen+1, t_COL); gel(T->partrel,i) = c;
1580
for (j=1; j<=Ngen; j++)
1581
{
1582
GEN z = cgeti(B); gel(c,j) = z;
1583
z[1] = evalsigne(0)|evallgefint(B);
1584
}
1585
}
1586
}
1587
T->smax = 511;
1588
T->normsol = new_chunk(T->smax+1);
1589
T->S[0] = T->n[1];
1590
T->next[0] = 1;
1591
T->sindex = 0;
1592
isintnorm_loop(T, 0); return 1;
1593
}
1594
1595
/* Look for unit of norm -1. Return 1 if it exists and set *unit, 0 otherwise */
1596
static long
1597
get_unit_1(GEN bnf, GEN *unit)
1598
{
1599
GEN v, nf = bnf_get_nf(bnf);
1600
long i, n = nf_get_degree(nf);
1601
1602
if (DEBUGLEVEL > 2) err_printf("looking for a fundamental unit of norm -1\n");
1603
if (odd(n)) { *unit = gen_m1; return 1; }
1604
v = nfsign_fu(bnf, NULL);
1605
for (i = 1; i < lg(v); i++)
1606
if ( Flv_sum( gel(v,i), 2) ) { *unit = gel(bnf_get_fu(bnf), i); return 1; }
1607
return 0;
1608
}
1609
1610
GEN
1611
bnfisintnormabs(GEN bnf, GEN a)
1612
{
1613
struct sol_abs T;
1614
GEN nf, res, PR, F;
1615
long i;
1616
1617
if ((F = check_arith_all(a,"bnfisintnormabs")))
1618
{
1619
a = typ(a) == t_VEC? gel(a,1): factorback(F);
1620
if (signe(a) < 0) F = clean_Z_factor(F);
1621
}
1622
bnf = checkbnf(bnf); nf = bnf_get_nf(bnf);
1623
if (!signe(a)) return mkvec(gen_0);
1624
if (is_pm1(a)) return mkvec(gen_1);
1625
if (!F) F = absZ_factor(a);
1626
if (!get_sol_abs(&T, bnf, nf, F, &PR)) return cgetg(1, t_VEC);
1627
/* |a| > 1 => T.nPR > 0 */
1628
res = cgetg(T.sindex+1, t_VEC);
1629
for (i=1; i<=T.sindex; i++)
1630
{
1631
GEN x = vecsmall_to_col( gel(T.normsol,i) );
1632
x = isprincipalfact(bnf, NULL, PR, x, nf_FORCE | nf_GEN_IF_PRINCIPAL);
1633
gel(res,i) = nf_to_scalar_or_alg(nf, x); /* x solution, up to sign */
1634
}
1635
return res;
1636
}
1637
1638
GEN
1639
ideals_by_norm(GEN nf, GEN a)
1640
{
1641
struct sol_abs T;
1642
GEN res, PR, F;
1643
long i;
1644
1645
if ((F = check_arith_pos(a,"ideals_by_norm")))
1646
a = typ(a) == t_VEC? gel(a,1): factorback(F);
1647
nf = checknf(nf);
1648
if (is_pm1(a)) return mkvec(trivial_fact());
1649
if (!F) F = absZ_factor(a);
1650
if (!get_sol_abs(&T, NULL, nf, F, &PR)) return cgetg(1, t_VEC);
1651
res = cgetg(T.sindex+1, t_VEC);
1652
for (i=1; i<=T.sindex; i++)
1653
{
1654
GEN x = vecsmall_to_col( gel(T.normsol,i) );
1655
gel(res,i) = famat_remove_trivial(mkmat2(PR, x));
1656
}
1657
return res;
1658
}
1659
1660
/* z = bnfisintnormabs(bnf,a), sa = 1 or -1, return bnfisintnorm(bnf,sa*|a|) */
1661
static GEN
1662
bnfisintnorm_i(GEN bnf, GEN a, long sa, GEN z)
1663
{
1664
GEN nf = checknf(bnf), T = nf_get_pol(nf), f = nf_get_index(nf), unit = NULL;
1665
GEN Tp, A = signe(a) == sa? a: negi(a);
1666
long sNx, i, j, N = degpol(T), l = lg(z);
1667
long norm_1 = 0; /* gcc -Wall */
1668
ulong p, Ap = 0; /* gcc -Wall */
1669
forprime_t S;
1670
if (!signe(a)) return z;
1671
u_forprime_init(&S,3,ULONG_MAX);
1672
while((p = u_forprime_next(&S)))
1673
if (umodiu(f,p)) { Ap = umodiu(A,p); if (Ap) break; }
1674
Tp = ZX_to_Flx(T,p);
1675
/* p > 2 doesn't divide A nor Q_denom(z in Z_K)*/
1676
1677
/* update z in place to get correct signs: multiply by unit of norm -1 if
1678
* it exists, otherwise delete solution with wrong sign */
1679
for (i = j = 1; i < l; i++)
1680
{
1681
GEN x = gel(z,i);
1682
int xpol = (typ(x) == t_POL);
1683
1684
if (xpol)
1685
{
1686
GEN dx, y = Q_remove_denom(x,&dx);
1687
ulong Np = Flx_resultant(Tp, ZX_to_Flx(y,p), p);
1688
ulong dA = dx? Fl_mul(Ap, Fl_powu(umodiu(dx,p), N, p), p): Ap;
1689
/* Nx = Res(T,y) / dx^N = A or -A. Check mod p */
1690
sNx = dA == Np? sa: -sa;
1691
}
1692
else
1693
sNx = gsigne(x) < 0 && odd(N) ? -1 : 1;
1694
if (sNx != sa)
1695
{
1696
if (! unit) norm_1 = get_unit_1(bnf, &unit);
1697
if (!norm_1)
1698
{
1699
if (DEBUGLEVEL > 2) err_printf("%Ps eliminated because of sign\n",x);
1700
continue;
1701
}
1702
if (xpol) x = (unit == gen_m1)? RgX_neg(x): RgXQ_mul(unit,x,T);
1703
else x = (unit == gen_m1)? gneg(x): RgX_Rg_mul(unit,x);
1704
}
1705
gel(z,j++) = x;
1706
}
1707
setlg(z, j); return z;
1708
}
1709
/* bnfisintnorm sa * |a|, fa = factor(|a|) */
1710
static GEN
1711
bnfisintnorm_fa(GEN bnf, GEN a, GEN fa, long sa)
1712
{ return bnfisintnorm_i(bnf, a, sa, bnfisintnormabs(bnf, mkvec2(a, fa)));
1713
}
1714
GEN
1715
bnfisintnorm(GEN bnf, GEN a)
1716
{
1717
pari_sp av = avma;
1718
GEN ne = bnfisintnormabs(bnf,a);
1719
switch(typ(a))
1720
{
1721
case t_VEC: a = gel(a,1); break;
1722
case t_MAT: a = factorback(a); break;
1723
}
1724
return gerepilecopy(av, bnfisintnorm_i(bnf, a, signe(a), ne));
1725
}
1726
1727