Testing latest pari + WASM + node.js... and it works?! Wow.
License: GPL3
ubuntu2004
/* Copyright (C) 2000 The PARI group.12This file is part of the PARI/GP package.34PARI/GP is free software; you can redistribute it and/or modify it under the5terms of the GNU General Public License as published by the Free Software6Foundation; either version 2 of the License, or (at your option) any later7version. It is distributed in the hope that it will be useful, but WITHOUT8ANY WARRANTY WHATSOEVER.910Check the License for details. You should have received a copy of it, along11with the package; see the file 'COPYING'. If not, write to the Free Software12Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */1314#include "pari.h"15#include "paripriv.h"1617#define DEBUGLEVEL DEBUGLEVEL_thue1819/********************************************************************/20/** **/21/** THUE EQUATION SOLVER (G. Hanrot) **/22/** **/23/********************************************************************/24/* In all the forthcoming remarks, "paper" designs the paper "Thue Equations of25* High Degree", by Yu. Bilu and G. Hanrot, J. Number Theory (1996). The26* numbering of the constants corresponds to Hanrot's thesis rather than to the27* paper. See also28* "Solving Thue equations without the full unit group", Math. Comp. (2000) */2930/* Check whether tnf is a valid structure */31static int32checktnf(GEN tnf)33{34long l = lg(tnf);35GEN v;36if (typ(tnf)!=t_VEC || (l!=8 && l!=4)) return 0;37v = gel(tnf,1);38if (typ(v) != t_VEC || lg(v) != 4) return 0;39if (l == 4) return 1; /* s=0 */4041(void)checkbnf(gel(tnf,2));42return (typ(gel(tnf,3)) == t_COL43&& typ(gel(tnf,4)) == t_COL44&& typ(gel(tnf,5)) == t_MAT45&& typ(gel(tnf,6)) == t_MAT46&& typ(gel(tnf,7)) == t_VEC);47}4849/* Compensates rounding errors for computation/display of the constants.50* Round up if dir > 0, down otherwise */51static GEN52myround(GEN x, long dir)53{54GEN eps = powis(stoi(dir > 0? 10: -10), -10);55return gmul(x, gadd(gen_1, eps));56}5758/* v a t_VEC/t_VEC */59static GEN60vecmax_shallow(GEN v) { return gel(v, vecindexmax(v)); }6162static GEN63tnf_get_roots(GEN poly, long prec, long S, long T)64{65GEN R0 = QX_complex_roots(poly, prec), R = cgetg(lg(R0), t_COL);66long k;6768for (k=1; k<=S; k++) gel(R,k) = gel(R0,k);69/* swap roots to get the usual order */70for (k=1; k<=T; k++)71{72gel(R,k+S) = gel(R0,2*k+S-1);73gel(R,k+S+T)= gel(R0,2*k+S);74}75return R;76}7778/* Computation of the logarithmic height of x (given by embeddings) */79static GEN80LogHeight(GEN x, long prec)81{82pari_sp av = avma;83long i, n = lg(x)-1;84GEN LH = gen_1;85for (i=1; i<=n; i++)86{87GEN t = gabs(gel(x,i), prec);88if (gcmpgs(t,1) > 0) LH = gmul(LH, t);89}90return gerepileupto(av, gdivgs(glog(LH,prec), n));91}9293/* |x|^(1/n), x t_INT */94static GEN95absisqrtn(GEN x, long n, long prec)96{ GEN r = itor(x,prec); setabssign(r); return sqrtnr(r, n); }9798static GEN99get_emb(GEN x, GEN r)100{101long l = lg(r), i;102GEN y;103104if (typ(x) == t_INT) return const_col(l-1, x);105y = cgetg(l, t_COL);106for (i=1; i<l; i++)107{108GEN e = poleval(x, gel(r,i));109if (gequal0(e) || (typ(e) != t_INT && precision(e) <= LOWDEFAULTPREC ))110return NULL;111gel(y,i) = e;112}113return y;114}115116/* Computation of the conjugates (sigma_i(v_j)), and log. heights, of elts of v */117static GEN118Conj_LH(GEN v, GEN *H, GEN r, long prec)119{120long j, l = lg(v);121GEN e, M = cgetg(l,t_MAT);122123(*H) = cgetg(l,t_COL);124for (j = 1; j < l; j++)125{126if (! (e = get_emb(gel(v,j), r)) ) return NULL; /* FAIL */127gel(M,j) = e;128gel(*H,j) = LogHeight(e, prec);129}130return M;131}132133/* Computation of M, its inverse A and precision check (see paper) */134static GEN135T_A_Matrices(GEN MatFU, long r, GEN *eps5, long prec)136{137GEN A, p1, m1, IntM, nia, eps3, eps2;138long e = prec2nbits(prec);139140m1 = matslice(MatFU, 1,r, 1,r); /* minor order r */141m1 = glog(gabs(m1, prec), prec); /* HIGH accuracy */142A = RgM_inv(m1); if (!A) pari_err_PREC("thue");143IntM = RgM_Rg_add(RgM_mul(A,m1), gen_m1);144IntM = gabs(IntM, 0);145146eps2 = gadd(vecmax(IntM), real2n(-e, LOWDEFAULTPREC)); /* t_REAL */147nia = vecmax(gabs(A, 0));148149/* Check for the precision in matrix inversion. See paper, Lemma 2.4.2. */150p1 = addrr(mulsr(r, gmul2n(nia, e)), eps2); /* t_REAL */151if (expo(p1) < -2*r) pari_err_PREC("thue");152153p1 = addrr(mulsr(r, gmul2n(nia,-e)), eps2);154eps3 = mulrr(mulsr(2*r*r,nia), p1);155if (!signe(eps3))156eps3 = real2n(expo(eps3), LOWDEFAULTPREC);157else158eps3 = myround(eps3, 1);159160if (DEBUGLEVEL>1) err_printf("epsilon_3 -> %Ps\n",eps3);161*eps5 = mulur(r, eps3); return A;162}163164/* find a few large primes such that p Z_K = P1 P2 P3 Q, whith f(Pi/p) = 1165* From x - \alpha y = \prod u_i^b_i we will deduce 3 equations in F_p166* in check_prinfo. Eliminating x,y we get a stringent condition on (b_i). */167static GEN168get_prime_info(GEN bnf)169{170long n = 1, e = gexpo(bnf_get_reg(bnf)), nbp = e < 20? 1: 2;171GEN L = cgetg(nbp+1, t_VEC), nf = checknf(bnf), fu = bnf_get_fu(bnf);172GEN X = pol_x(nf_get_varn(nf));173ulong p;174for(p = 2147483659UL; n <= nbp; p = unextprime(p+1))175{176GEN PR, A, U, LP = idealprimedec_limit_f(bnf, utoipos(p), 1);177long i;178if (lg(LP) < 4) continue;179A = cgetg(5, t_VECSMALL);180U = cgetg(4, t_VEC);181PR = cgetg(4, t_VEC);182for (i = 1; i <= 3; i++)183{184GEN modpr = zkmodprinit(nf, gel(LP,i));185GEN a = nf_to_Fq(nf, X, modpr);186GEN u = nfV_to_FqV(fu, nf, modpr);187A[i] = itou(a);188gel(U,i) = ZV_to_Flv(u,p);189gel(PR,i) = modpr;190}191A[4] = p;192gel(L,n++) = mkvec3(A,U,PR);193}194return L;195}196197/* Performs basic computations concerning the equation.198* Returns a "tnf" structure containing199* 1) the polynomial200* 2) the bnf (used to solve the norm equation)201* 3) roots, with presumably enough precision202* 4) The logarithmic heights of units203* 5) The matrix of conjugates of units204* 6) its inverse205* 7) a few technical constants */206static GEN207inithue(GEN P, GEN bnf, long flag, long prec)208{209GEN MatFU, x0, tnf, tmp, gpmin, dP, csts, ALH, eps5, ro, c1, c2, Ind = gen_1;210long k,j, n = degpol(P);211long s,t, prec_roots;212213if (!bnf)214{215bnf = Buchall(P, nf_FORCE, maxss(prec, DEFAULTPREC));216if (flag) (void)bnfcertify(bnf);217else218Ind = floorr(mulru(bnf_get_reg(bnf), 5));219}220221nf_get_sign(bnf_get_nf(bnf), &s, &t);222prec_roots = prec;223for(;;)224{225ro = tnf_get_roots(P, prec_roots, s, t);226MatFU = Conj_LH(bnf_get_fu(bnf), &ALH, ro, prec);227if (MatFU) break;228prec_roots = precdbl(prec_roots);229if (DEBUGLEVEL>1) pari_warn(warnprec, "inithue", prec_roots);230}231232dP = ZX_deriv(P);233c1 = NULL; /* min |P'(r_i)|, i <= s */234for (k=1; k<=s; k++)235{236tmp = gabs(poleval(dP,gel(ro,k)),prec);237if (!c1 || gcmp(tmp,c1) < 0) c1 = tmp;238}239c1 = gdiv(int2n(n-1), c1);240c1 = gprec_w(myround(c1, 1), DEFAULTPREC);241242c2 = NULL; /* max |r_i - r_j|, i!=j */243for (k=1; k<=n; k++)244for (j=k+1; j<=n; j++)245{246tmp = gabs(gsub(gel(ro,j),gel(ro,k)), prec);247if (!c2 || gcmp(c2,tmp) > 0) c2 = tmp;248}249c2 = gprec_w(myround(c2, -1), DEFAULTPREC);250251if (t==0)252x0 = real_1(DEFAULTPREC);253else254{255gpmin = NULL; /* min |P'(r_i)|, i > s */256for (k=1; k<=t; k++)257{258tmp = gabs(poleval(dP,gel(ro,s+k)), prec);259if (!gpmin || gcmp(tmp,gpmin) < 0) gpmin = tmp;260}261gpmin = gprec_w(gpmin, DEFAULTPREC);262263/* Compute x0. See paper, Prop. 2.2.1 */264x0 = gmul(gpmin, vecmax_shallow(gabs(imag_i(ro), prec)));265x0 = sqrtnr(gdiv(int2n(n-1), x0), n);266}267if (DEBUGLEVEL>1)268err_printf("c1 = %Ps\nc2 = %Ps\nIndice <= %Ps\n", c1, c2, Ind);269270ALH = gmul2n(ALH, 1);271tnf = cgetg(8,t_VEC); csts = cgetg(9,t_VEC);272gel(tnf,1) = P;273gel(tnf,2) = bnf;274gel(tnf,3) = ro;275gel(tnf,4) = ALH;276gel(tnf,5) = MatFU;277gel(tnf,6) = T_A_Matrices(MatFU, s+t-1, &eps5, prec);278gel(tnf,7) = csts;279gel(csts,1) = c1; gel(csts,2) = c2; gel(csts,3) = LogHeight(ro, prec);280gel(csts,4) = x0; gel(csts,5) = eps5; gel(csts,6) = utoipos(prec);281gel(csts,7) = Ind;282gel(csts,8) = get_prime_info(bnf);283return tnf;284}285286typedef struct {287GEN c10, c11, c13, c15, c91, bak, NE, Ind, hal, MatFU, divro, Hmu;288GEN delta, lambda, inverrdelta, ro, Pi, Pi2;289long r, iroot, deg;290} baker_s;291292static void293other_roots(long iroot, long *i1, long *i2)294{295switch (iroot) {296case 1: *i1=2; *i2=3; break;297case 2: *i1=1; *i2=3; break;298default: *i1=1; *i2=2; break;299}300}301/* low precision */302static GEN abslog(GEN x) { return gabs(glog(gtofp(x,DEFAULTPREC),0), 0); }303304/* Compute Baker's bound c9 and B_0, the bound for the b_i's. See Thm 2.3.1 */305static GEN306Baker(baker_s *BS)307{308GEN tmp, B0, hb0, c9, Indc11;309long i1, i2;310311other_roots(BS->iroot, &i1,&i2);312/* Compute a bound for the h_0 */313hb0 = gadd(gmul2n(BS->hal,2), gmul2n(gadd(BS->Hmu,mplog2(DEFAULTPREC)), 1));314tmp = gmul(BS->divro, gdiv(gel(BS->NE,i1), gel(BS->NE,i2)));315tmp = gmax_shallow(gen_1, abslog(tmp));316hb0 = gmax_shallow(hb0, gdiv(tmp, BS->bak));317c9 = gmul(BS->c91,hb0);318c9 = gprec_w(myround(c9, 1), DEFAULTPREC);319Indc11 = rtor(mulir(BS->Ind,BS->c11), DEFAULTPREC);320/* Compute B0 according to Lemma 2.3.3 */321B0 = mulir(shifti(BS->Ind,1),322divrr(addrr(mulrr(c9,mplog(divrr(mulir(BS->Ind, c9),BS->c10))),323mplog(Indc11)), BS->c10));324B0 = gmax_shallow(B0, dbltor(2.71828183));325B0 = gmax_shallow(B0, mulrr(divir(BS->Ind, BS->c10),326mplog(divrr(Indc11, BS->Pi2))));327if (DEBUGLEVEL>1) {328err_printf(" B0 = %Ps\n",B0);329err_printf(" Baker = %Ps\n",c9);330}331return B0;332}333334/* || x d ||, x t_REAL, d t_INT */335static GEN336errnum(GEN x, GEN d)337{338GEN dx = mulir(d, x), D = subri(dx, roundr(dx));339setabssign(D); return D;340}341342/* Try to reduce the bound through continued fractions; see paper. */343static int344CF_1stPass(GEN *B0, GEN kappa, baker_s *BS)345{346GEN a, b, q, ql, qd, l0, denbound = mulri(*B0, kappa);347348if (cmprr(mulrr(dbltor(0.1),sqrr(denbound)), BS->inverrdelta) > 0)349return -1;350351q = denom_i( bestappr(BS->delta, denbound) );352qd = errnum(BS->delta, q);353ql = errnum(BS->lambda,q);354355l0 = subrr(ql, addrr(mulrr(qd, *B0), divri(dbltor(0.1),kappa)));356if (signe(l0) <= 0) return 0;357358if (BS->r > 1) {359a = BS->c15; b = BS->c13;360}361else {362a = BS->c11; b = BS->c10;363l0 = mulrr(l0, Pi2n(1, DEFAULTPREC));364}365*B0 = divrr(mplog(divrr(mulir(q,a), l0)), b);366if (DEBUGLEVEL>1) err_printf(" B0 -> %Ps\n",*B0);367return 1;368}369370static void371get_B0Bx(baker_s *BS, GEN l0, GEN *B0, GEN *Bx)372{373GEN t = divrr(mulir(BS->Ind, BS->c15), l0);374*B0 = divrr(mulir(BS->Ind, mplog(t)), BS->c13);375*Bx = sqrtnr(shiftr(t,1), BS->deg);376}377378static int379LLL_1stPass(GEN *pB0, GEN kappa, baker_s *BS, GEN *pBx)380{381GEN B0 = *pB0, Bx = *pBx, lllmat, C, l0, l1, triv;382long e;383384C = grndtoi(mulir(mulii(BS->Ind, kappa),385gpow(B0, dbltor(2.2), DEFAULTPREC)), &e);386387if (DEBUGLEVEL > 1) err_printf("C (bitsize) : %d\n", expi(C));388lllmat = matid(3);389if (cmpri(B0, BS->Ind) > 0)390{391gcoeff(lllmat, 1, 1) = grndtoi(divri(B0, BS->Ind), &e);392triv = shiftr(sqrr(B0), 1);393}394else395triv = addir(sqri(BS->Ind), sqrr(B0));396397gcoeff(lllmat, 3, 1) = grndtoi(negr(mulir(C, BS->lambda)), &e);398if (e >= 0) return -1;399gcoeff(lllmat, 3, 2) = grndtoi(negr(mulir(C, BS->delta)), &e);400if (e >= 0) return -1;401gcoeff(lllmat, 3, 3) = C;402lllmat = ZM_lll(lllmat, 0.99, LLL_IM|LLL_INPLACE);403404l0 = gnorml2(gel(lllmat,1));405l0 = subrr(divir(l0, dbltor(1.8262)), triv); /* delta = 0.99 */406if (signe(l0) <= 0) return 0;407408l1 = shiftr(addri(shiftr(B0,1), BS->Ind), -1);409l0 = divri(subrr(sqrtr(l0), l1), C);410411if (signe(l0) <= 0) return 0;412413get_B0Bx(BS, l0, &B0, &Bx);414if (DEBUGLEVEL>=2)415{416err_printf("LLL_First_Pass successful\n");417err_printf("B0 -> %Ps\n", B0);418err_printf("x <= %Ps\n", Bx);419}420*pB0 = B0; *pBx = Bx; return 1;421}422423/* add solution (x,y) if not already known */424static void425add_sol(GEN *pS, GEN x, GEN y) { *pS = vec_append(*pS, mkvec2(x,y)); }426/* z = P(p,q), d = deg P, |z| = |rhs|. Check signs and (possibly)427* add solutions (p,q), (-p,-q) */428static void429add_pm(GEN *pS, GEN p, GEN q, GEN z, long d, GEN rhs)430{431if (signe(z) == signe(rhs))432{433add_sol(pS, p, q);434if (!odd(d)) add_sol(pS, negi(p), negi(q));435}436else437if (odd(d)) add_sol(pS, negi(p), negi(q));438}439440/* Check whether a potential solution is a true solution. Return 0 if441* truncation error (increase precision) */442static int443CheckSol(GEN *pS, GEN z1, GEN z2, GEN P, GEN rhs, GEN ro)444{445GEN x, y, ro1 = gel(ro,1), ro2 = gel(ro,2);446long e;447448y = grndtoi(real_i(gdiv(gsub(z2,z1), gsub(ro1,ro2))), &e);449if (e > 0) return 0;450if (!signe(y)) return 1; /* y = 0 taken care of in SmallSols */451x = gadd(z1, gmul(ro1, y));452x = grndtoi(real_i(x), &e);453if (e > 0) return 0;454if (e <= -13)455{ /* y != 0 and rhs != 0; check whether P(x,y) = rhs or P(-x,-y) = rhs */456GEN z = ZX_Z_eval(ZX_rescale(P,y),x);457if (absequalii(z, rhs)) add_pm(pS, x,y, z, degpol(P), rhs);458}459return 1;460}461462static const long EXPO1 = 7;463static int464round_to_b(GEN v, long B, long b, GEN Delta2, long i1, GEN L)465{466long i, l = lg(v);467if (!b)468{469for (i = 1; i < l; i++)470{471long c;472if (i == i1)473c = 0;474else475{476GEN d = gneg(gel(L,i));477long e;478d = grndtoi(d,&e);479if (e > -EXPO1 || is_bigint(d)) return 0;480c = itos(d); if (labs(c) > B) return 0;481}482v[i] = c;483}484}485else486{487for (i = 1; i < l; i++)488{489long c;490if (i == i1)491c = b;492else493{494GEN d = gsub(gmulgs(gel(Delta2,i), b), gel(L,i));495long e;496d = grndtoi(d,&e);497if (e > -EXPO1 || is_bigint(d)) return 0;498c = itos(d); if (labs(c) > B) return 0;499}500v[i] = c;501}502}503return 1;504}505506/* mu \prod U[i]^b[i] */507static ulong508Fl_factorback(ulong mu, GEN U, GEN b, ulong p)509{510long i, l = lg(U);511ulong r = mu;512for (i = 1; i < l; i++)513{514long c = b[i];515ulong u = U[i];516if (!c) continue;517if (c < 0) { u = Fl_inv(u,p); c = -c; }518r = Fl_mul(r, Fl_powu(u,c,p), p);519}520return r;521}522523/* x - alpha y = \pm mu \prod \mu_i^{b_i}. Reduce mod 3 distinct primes of524* degree 1 above the same p, and eliminate x,y => drastic conditions on b_i */525static int526check_pr(GEN bi, GEN Lmu, GEN L)527{528GEN A = gel(L,1), U = gel(L,2);529ulong a = A[1], b = A[2], c = A[3], p = A[4];530ulong r = Fl_mul(Fl_sub(c,b,p), Fl_factorback(Lmu[1],gel(U,1),bi, p), p);531ulong s = Fl_mul(Fl_sub(a,c,p), Fl_factorback(Lmu[2],gel(U,2),bi, p), p);532ulong t = Fl_mul(Fl_sub(b,a,p), Fl_factorback(Lmu[3],gel(U,3),bi, p), p);533return Fl_add(Fl_add(r,s,p),t,p) == 0;534}535static int536check_prinfo(GEN b, GEN Lmu, GEN prinfo)537{538long i;539for (i = 1; i < lg(prinfo); i++)540if (!check_pr(b, gel(Lmu,i), gel(prinfo,i))) return 0;541return 1;542}543/* For each possible value of b_i1, compute the b_i's544* and 2 conjugates of z = x - alpha y. Then check. */545static int546TrySol(GEN *pS, GEN B0, long i1, GEN Delta2, GEN Lambda, GEN ro,547GEN Lmu, GEN NE, GEN MatFU, GEN prinfo, GEN P, GEN rhs)548{549long bi1, i, B = itos(gceil(B0)), l = lg(Delta2);550GEN b = cgetg(l,t_VECSMALL), L = cgetg(l,t_VEC);551552for (i = 1; i < l; i++)553{554if (i == i1)555gel(L,i) = gen_0;556else557{558GEN delta = gel(Delta2,i);559gel(L, i) = gsub(gmul(delta,gel(Lambda,i1)), gel(Lambda,i));560}561}562for (bi1 = -B; bi1 <= B; bi1++)563{564GEN z1, z2;565if (!round_to_b(b, B, bi1, Delta2, i1, L)) continue;566if (!check_prinfo(b, Lmu, prinfo)) continue;567z1 = gel(NE,1);568z2 = gel(NE,2);569for (i = 1; i < l; i++)570{571z1 = gmul(z1, gpowgs(gcoeff(MatFU,1,i), b[i]));572z2 = gmul(z2, gpowgs(gcoeff(MatFU,2,i), b[i]));573}574if (!CheckSol(pS, z1,z2,P,rhs,ro)) return 0;575}576return 1;577}578579/* find q1,q2,q3 st q1 b + q2 c + q3 ~ 0 */580static GEN581GuessQi(GEN b, GEN c, GEN *eps)582{583const long shift = 65;584GEN Q, Lat;585586Lat = matid(3);587gcoeff(Lat,3,1) = ground(gmul2n(b, shift));588gcoeff(Lat,3,2) = ground(gmul2n(c, shift));589gcoeff(Lat,3,3) = int2n(shift);590591Q = gel(lllint(Lat),1);592if (gequal0(gel(Q,2))) return NULL; /* FAIL */593594*eps = mpadd(mpadd(gel(Q,3), mpmul(gel(Q,1),b)), mpmul(gel(Q,2),c));595*eps = mpabs_shallow(*eps); return Q;596}597598/* x a t_REAL */599static GEN600myfloor(GEN x) { return expo(x) > 30 ? ceil_safe(x): floorr(x); }601602/* Check for not-so-small solutions. Return a t_REAL or NULL */603static GEN604MiddleSols(GEN *pS, GEN bound, GEN roo, GEN P, GEN rhs, long s, GEN c1)605{606long j, k, nmax, d;607GEN bndcf;608609if (expo(bound) < 0) return bound;610d = degpol(P);611bndcf = sqrtnr(shiftr(c1,1), d - 2);612if (cmprr(bound, bndcf) < 0) return bound;613/* divide by log2((1+sqrt(5))/2)614* 1 + ==> ceil615* 2 + ==> continued fraction is normalized if last entry is 1616* 3 + ==> start at a0, not a1 */617nmax = 3 + (long)(dbllog2(bound) * 1.44042009041256);618bound = myfloor(bound);619620for (k = 1; k <= s; k++)621{622GEN ro = real_i(gel(roo,k)), t = gboundcf(ro, nmax);623GEN pm1, qm1, p0, q0;624625pm1 = gen_0; p0 = gen_1;626qm1 = gen_1; q0 = gen_0;627628for (j = 1; j < lg(t); j++)629{630GEN p, q, z, Q, R;631pari_sp av;632p = addii(mulii(p0, gel(t,j)), pm1); pm1 = p0; p0 = p;633q = addii(mulii(q0, gel(t,j)), qm1); qm1 = q0; q0 = q;634if (cmpii(q, bound) > 0) break;635if (DEBUGLEVEL >= 2) err_printf("Checking (+/- %Ps, +/- %Ps)\n",p, q);636av = avma;637z = ZX_Z_eval(ZX_rescale(P,q), p); /* = P(p/q) q^dep(P) */638Q = dvmdii(rhs, z, &R);639if (R != gen_0) { set_avma(av); continue; }640setabssign(Q);641if (Z_ispowerall(Q, d, &Q))642{643if (!is_pm1(Q)) { p = mulii(p, Q); q = mulii(q, Q); }644add_pm(pS, p, q, z, d, rhs);645}646}647if (j == lg(t))648{649long prec;650if (j > nmax) pari_err_BUG("thue [short continued fraction]");651/* the theoretical value is bit_prec = gexpo(ro)+1+log2(bound) */652prec = precdbl(precision(ro));653if (DEBUGLEVEL>1) pari_warn(warnprec,"thue",prec);654roo = ZX_realroots_irred(P, prec);655if (lg(roo)-1 != s) pari_err_BUG("thue [realroots]");656k--;657}658}659return bndcf;660}661662static void663check_y_root(GEN *pS, GEN P, GEN Y)664{665GEN r = nfrootsQ(P);666long j;667for (j = 1; j < lg(r); j++)668if (typ(gel(r,j)) == t_INT) add_sol(pS, gel(r,j), Y);669}670671static void672check_y(GEN *pS, GEN P, GEN poly, GEN Y, GEN rhs)673{674long j, l = lg(poly);675GEN Yn = Y;676gel(P, l-1) = gel(poly, l-1);677for (j = l-2; j >= 2; j--)678{679gel(P,j) = mulii(Yn, gel(poly,j));680if (j > 2) Yn = mulii(Yn, Y);681}682gel(P,2) = subii(gel(P,2), rhs); /* P = poly(Y/y)*y^deg(poly) - rhs */683check_y_root(pS, P, Y);684}685686/* Check for solutions under a small bound (see paper) */687static GEN688SmallSols(GEN S, GEN x3, GEN poly, GEN rhs)689{690pari_sp av = avma;691GEN X, P, rhs2;692long j, l = lg(poly), n = degpol(poly);693ulong y, By;694695x3 = myfloor(x3);696697if (DEBUGLEVEL>1) err_printf("* Checking for small solutions <= %Ps\n", x3);698if (lgefint(x3) > 3)699pari_err_OVERFLOW(stack_sprintf("thue (SmallSols): y <= %Ps", x3));700By = itou(x3);701/* y = 0 first: solve X^n = rhs */702if (odd(n))703{704if (Z_ispowerall(absi_shallow(rhs), n, &X))705add_sol(&S, signe(rhs) > 0? X: negi(X), gen_0);706}707else if (signe(rhs) > 0 && Z_ispowerall(rhs, n, &X))708{709add_sol(&S, X, gen_0);710add_sol(&S, negi(X), gen_0);711}712rhs2 = shifti(rhs,1);713/* y != 0 */714P = cgetg(l, t_POL); P[1] = poly[1];715for (y = 1; y <= By; y++)716{717pari_sp av2 = avma;718long lS = lg(S);719GEN Y = utoipos(y);720/* try y */721check_y(&S, P, poly, Y, rhs);722/* try -y */723for (j = l-2; j >= 2; j -= 2) togglesign( gel(P,j) );724if (j == 0) gel(P,2) = subii(gel(P,2), rhs2);725check_y_root(&S, P, utoineg(y));726if (lS == lg(S)) { set_avma(av2); continue; } /* no solution found */727728if (gc_needed(av,1))729{730if(DEBUGMEM>1) pari_warn(warnmem,"SmallSols");731gerepileall(av, 2, &S, &rhs2);732P = cgetg(l, t_POL); P[1] = poly[1];733}734}735return S;736}737738/* Computes [x]! */739static double740fact(double x)741{742double ft = 1.0;743x = floor(x); while (x>1) { ft *= x; x--; }744return ft ;745}746747static GEN748RgX_homogenize(GEN P, long v)749{750GEN Q = leafcopy(P);751long i, l = lg(P), d = degpol(P);752for (i = 2; i < l; i++) gel(Q,i) = monomial(gel(Q,i), d--, v);753return Q;754}755756/* Compute all relevant constants needed to solve the equation P(x,y)=a given757* the solutions of N_{K/Q}(x)=a (see inithue). */758GEN759thueinit(GEN pol, long flag, long prec)760{761GEN POL, C, L, fa, tnf, bnf = NULL;762pari_sp av = avma;763long s, lfa, dpol;764765if (checktnf(pol)) { bnf = checkbnf(gel(pol,2)); pol = gel(pol,1); }766if (typ(pol)!=t_POL) pari_err_TYPE("thueinit",pol);767dpol = degpol(pol);768if (dpol <= 0) pari_err_CONSTPOL("thueinit");769RgX_check_ZX(pol, "thueinit");770if (varn(pol)) { pol = leafcopy(pol); setvarn(pol, 0); }771772POL = Q_primitive_part(pol, &C);773L = gen_1;774fa = ZX_factor(POL); lfa = lgcols(fa);775if (lfa > 2 || itos(gcoeff(fa,1,2)) > 1)776{ /* reducible polynomial, no need to reduce to the monic case */777GEN P, Q, R, g, f = gcoeff(fa,1,1), E = gcoeff(fa,1,2);778long e = itos(E);779long vy = fetch_var();780long va = fetch_var();781long vb = fetch_var();782C = C? ginv(C): gen_1;783if (e != 1)784{785if (lfa == 2) {786tnf = mkvec3(mkvec3(POL,C,L), thueinit(f, flag, prec), E);787delete_var(); delete_var(); delete_var();788return gerepilecopy(av, tnf);789}790P = gpowgs(f,e);791}792else793P = f;794g = RgX_div(POL, P);795P = RgX_Rg_sub(RgX_homogenize(f, vy), pol_x(va));796Q = RgX_Rg_sub(RgX_homogenize(g, vy), pol_x(vb));797R = polresultant0(P, Q, -1, 0);798tnf = mkvec3(mkvec3(POL,C,L), mkvecsmall4(degpol(f), e, va,vb), R);799delete_var(); delete_var(); delete_var();800return gerepilecopy(av, tnf);801}802/* POL monic irreducible: POL(x) = C pol(x/L), L integer */803POL = ZX_primitive_to_monic(POL, &L);804C = gdiv(powiu(L, dpol), gel(pol, dpol+2));805pol = POL;806807s = ZX_sturm_irred(pol);808if (s)809{810long PREC, n = degpol(pol);811double d, dr, dn = (double)n;812813if (dpol <= 2) pari_err_DOMAIN("thueinit", "P","=",pol,pol);814dr = (double)((s+n-2)>>1); /* s+t-1 */815d = dn*(dn-1)*(dn-2);816/* Guess precision by approximating Baker's bound. The guess is most of817* the time not sharp, ie 10 to 30 decimal digits above what is _really_818* necessary. Note that the limiting step is the reduction. See paper. */819PREC = nbits2prec((long)((5.83 + (dr+4)*5 + log(fact(dr+3)) + (dr+3)*log(dr+2) +820(dr+3)*log(d) + log(log(2*d*(dr+2))) + (dr+1))821/10.)*32+32);822823if (flag == 0) PREC = (long)(2.2 * PREC); /* Lazy, to be improved */824if (PREC < prec) PREC = prec;825if (DEBUGLEVEL >=2) err_printf("prec = %d\n", PREC);826827for (;;)828{829if (( tnf = inithue(pol, bnf, flag, PREC) )) break;830PREC = precdbl(PREC);831if (DEBUGLEVEL>1) pari_warn(warnprec,"thueinit",PREC);832bnf = NULL; set_avma(av);833}834}835else836{837GEN ro, c0;838long k,l;839if (!bnf)840{841bnf = gen_0;842if (expi(ZX_disc(pol)) <= 50)843{844bnf = Buchall(pol, nf_FORCE, DEFAULTPREC);845if (flag) (void)bnfcertify(bnf);846}847}848ro = typ(bnf)==t_VEC? nf_get_roots(bnf_get_nf(bnf))849: QX_complex_roots(pol, DEFAULTPREC);850l = lg(ro); c0 = imag_i(gel(ro,1));851for (k = 2; k < l; k++) c0 = mulrr(c0, imag_i(gel(ro,k)));852setsigne(c0,1); c0 = invr(c0); tnf = mkvec3(pol, bnf, c0);853}854gel(tnf,1) = mkvec3(gel(tnf,1), C, L);855return gerepilecopy(av,tnf);856}857858/* arg(t^2) / 2Pi; arg(t^2) = arg(t/conj(t)) */859static GEN860argsqr(GEN t, GEN Pi)861{862GEN v, u = divrr(garg(t,0), Pi); /* in -1 < u <= 1 */863/* reduce mod Z to -1/2 < u <= 1/2 */864if (signe(u) > 0)865{866v = subrs(u,1); /* ]-1,0] */867if (abscmprr(v,u) < 0) u = v;868}869else870{871v = addrs(u,1);/* ]0,1] */872if (abscmprr(v,u) <= 0) u = v;873}874return u;875}876/* i1 != i2 */877static void878init_get_B(long i1, long i2, GEN Delta2, GEN Lambda, GEN Deps5, baker_s *BS,879long prec)880{881GEN delta, lambda;882if (BS->r > 1)883{884delta = gel(Delta2,i2);885lambda = gsub(gmul(delta,gel(Lambda,i1)), gel(Lambda,i2));886if (Deps5) BS->inverrdelta = divrr(Deps5, addsr(1,delta));887}888else889{ /* r == 1: i1 = s = t = 1; i2 = 2 */890GEN fu = gel(BS->MatFU,1), ro = BS->ro, t;891892t = gel(fu,2);893delta = argsqr(t, BS->Pi);894if (Deps5) BS->inverrdelta = shiftr(gabs(t,prec), prec2nbits(prec)-1);895896t = gmul(gsub(gel(ro,1), gel(ro,2)), gel(BS->NE,3));897lambda = argsqr(t, BS->Pi);898}899BS->delta = delta;900BS->lambda = lambda;901}902903static GEN904get_B0(long i1, GEN Delta2, GEN Lambda, GEN Deps5, long prec, baker_s *BS)905{906GEN B0 = Baker(BS);907long step = 0, i2 = (i1 == 1)? 2: 1;908for(;;) /* i2 from 1 to r unless r = 1 [then i2 = 2] */909{910init_get_B(i1,i2, Delta2,Lambda,Deps5, BS, prec);911/* Reduce B0 as long as we make progress: newB0 < oldB0 - 0.1 */912for (;;)913{914GEN oldB0 = B0, kappa = utoipos(10);915long cf;916917for (cf = 0; cf < 10; cf++, kappa = muliu(kappa,10))918{919int res = CF_1stPass(&B0, kappa, BS);920if (res < 0) return NULL; /* prec problem */921if (res) break;922if (DEBUGLEVEL>1) err_printf("CF failed. Increasing kappa\n");923}924if (!step && cf == 10)925{ /* Semirational or totally rational case */926GEN Q, ep, q, l0, denbound;927928if (! (Q = GuessQi(BS->delta, BS->lambda, &ep)) ) break;929930denbound = mpadd(B0, absi_shallow(gel(Q,1)));931q = denom_i( bestappr(BS->delta, denbound) );932l0 = subrr(errnum(BS->delta, q), ep);933if (signe(l0) <= 0) break;934935B0 = divrr(mplog(divrr(mulir(gel(Q,2), BS->c15), l0)), BS->c13);936if (DEBUGLEVEL>1) err_printf("Semirat. reduction: B0 -> %Ps\n",B0);937}938/* if no progress, stop */939if (gcmp(oldB0, gadd(B0,dbltor(0.1))) <= 0)940return gmin_shallow(oldB0, B0);941else step++;942}943i2++; if (i2 == i1) i2++;944if (i2 > BS->r) break;945}946pari_err_BUG("thue (totally rational case)");947return NULL; /* LCOV_EXCL_LINE */948}949950static GEN951get_Bx_LLL(long i1, GEN Delta2, GEN Lambda, long prec, baker_s *BS)952{953GEN B0 = Baker(BS), Bx = NULL;954long step = 0, i2 = (i1 == 1)? 2: 1;955for(;;) /* i2 from 1 to r unless r = 1 [then i2 = 2] */956{957init_get_B(i1,i2, Delta2,Lambda,NULL, BS, prec);958if (DEBUGLEVEL>1) err_printf(" Entering LLL...\n");959/* Reduce B0 as long as we make progress: newB0 < oldB0 - 0.1 */960for (;;)961{962GEN oldBx = Bx, kappa = utoipos(10);963const long cfMAX = 10;964long cf;965966for (cf = 0; cf < cfMAX; cf++, kappa = muliu(kappa,10))967{968int res = LLL_1stPass(&B0, kappa, BS, &Bx);969if (res < 0) return NULL;970if (res) break;971if (DEBUGLEVEL>1) err_printf("LLL failed. Increasing kappa\n");972}973974/* FIXME: TO BE COMPLETED */975if (!step && cf == cfMAX)976{ /* Semirational or totally rational case */977GEN Q, Q1, Q2, ep, q, l0, denbound;978979if (! (Q = GuessQi(BS->delta, BS->lambda, &ep)) ) break;980981/* Q[2] != 0 */982Q1 = absi_shallow(gel(Q,1));983Q2 = absi_shallow(gel(Q,2));984denbound = gadd(mulri(B0, Q1), mulii(BS->Ind, Q2));985q = denom_i( bestappr(BS->delta, denbound) );986l0 = divri(subrr(errnum(BS->delta, q), ep), Q2);987if (signe(l0) <= 0) break;988989get_B0Bx(BS, l0, &B0, &Bx);990if (DEBUGLEVEL>1)991err_printf("Semirat. reduction: B0 -> %Ps x <= %Ps\n",B0, Bx);992}993/* if no progress, stop */994if (oldBx && gcmp(oldBx, Bx) <= 0) return oldBx; else step++;995}996i2++; if (i2 == i1) i2++;997if (i2 > BS->r) break;998}999pari_err_BUG("thue (totally rational case)");1000return NULL; /* LCOV_EXCL_LINE */1001}10021003static GEN1004LargeSols(GEN P, GEN tnf, GEN rhs, GEN ne)1005{1006GEN S = NULL, Delta0, ro, ALH, bnf, nf, MatFU, A, csts, dP, Bx;1007GEN c1,c2,c3,c4,c90,c91,c14, x0, x1, x2, x3, tmp, eps5, prinfo;1008long iroot, ine, n, r, Prec, prec, s,t;1009baker_s BS;1010pari_sp av = avma;10111012prec = 0; /*-Wall*/1013bnf = NULL; /*-Wall*/1014iroot = 1;1015ine = 1;10161017START:1018if (S) /* restart from precision problems */1019{1020S = gerepilecopy(av, S);1021prec = precdbl(prec);1022if (DEBUGLEVEL) pari_warn(warnprec,"thue",prec);1023tnf = inithue(P, bnf, 0, prec);1024}1025else1026S = cgetg(1, t_VEC);1027bnf= gel(tnf,2);1028nf = bnf_get_nf(bnf);1029csts = gel(tnf,7);1030nf_get_sign(nf, &s, &t);1031BS.r = r = s+t-1; n = degpol(P);1032ro = gel(tnf,3);1033ALH = gel(tnf,4);1034MatFU = gel(tnf,5);1035A = gel(tnf,6);1036c1 = mpmul(absi_shallow(rhs), gel(csts,1));1037c2 = gel(csts,2);1038BS.hal = gel(csts,3);1039x0 = gel(csts,4);1040eps5 = gel(csts,5);1041Prec = itos(gel(csts,6));1042BS.Ind = gel(csts,7);1043BS.MatFU = MatFU;1044BS.bak = muluu(n, (n-1)*(n-2)); /* safe */1045BS.deg = n;1046prinfo = gel(csts,8);10471048if (t) x0 = gmul(x0, absisqrtn(rhs, n, Prec));1049tmp = divrr(c1,c2);1050c3 = mulrr(dbltor(1.39), tmp);1051c4 = mulur(n-1, c3);1052c14 = mulrr(c4, vecmax_shallow(RgM_sumcol(gabs(A,DEFAULTPREC))));10531054x1 = gmax_shallow(x0, sqrtnr(shiftr(tmp,1),n));1055x2 = gmax_shallow(x1, sqrtnr(mulur(10,c14), n));1056x3 = gmax_shallow(x2, sqrtnr(shiftr(c14, EXPO1+1),n));1057c90 = gmul(shiftr(mulur(18,mppi(DEFAULTPREC)), 5*(4+r)),1058gmul(gmul(mpfact(r+3), powiu(muliu(BS.bak,r+2), r+3)),1059glog(muliu(BS.bak,2*(r+2)),DEFAULTPREC)));10601061dP = ZX_deriv(P);1062Delta0 = RgM_sumcol(A);10631064for (; iroot<=s; iroot++)1065{1066GEN Delta = Delta0, Delta2, D, Deps5, MatNE, Hmu, diffRo, c5, c7, ro0;1067long i1, iroot1, iroot2, k;10681069if (iroot <= r) Delta = RgC_add(Delta, RgC_Rg_mul(gel(A,iroot), stoi(-n)));1070D = gabs(Delta,Prec); i1 = vecindexmax(D);1071c5 = gel(D, i1);1072Delta2 = RgC_Rg_div(Delta, gel(Delta, i1));1073c5 = myround(gprec_w(c5,DEFAULTPREC), 1);1074Deps5 = divrr(subrr(c5,eps5), eps5);1075c7 = mulur(r,c5);1076BS.c10 = divur(n,c7);1077BS.c13 = divur(n,c5);1078if (DEBUGLEVEL>1) {1079err_printf("* real root no %ld/%ld\n", iroot,s);1080err_printf(" c10 = %Ps\n",BS.c10);1081err_printf(" c13 = %Ps\n",BS.c13);1082}10831084prec = Prec;1085for (;;)1086{1087if (( MatNE = Conj_LH(ne, &Hmu, ro, prec) )) break;1088prec = precdbl(prec);1089if (DEBUGLEVEL>1) pari_warn(warnprec,"thue",prec);1090ro = tnf_get_roots(P, prec, s, t);1091}1092ro0 = gel(ro,iroot);1093BS.ro = ro;1094BS.iroot = iroot;1095BS.Pi = mppi(prec);1096BS.Pi2 = Pi2n(1,prec);1097diffRo = cgetg(r+1, t_VEC);1098for (k=1; k<=r; k++)1099{1100GEN z = gel(ro,k);1101z = (k == iroot)? gdiv(rhs, poleval(dP, z)): gsub(ro0, z);1102gel(diffRo,k) = gabs(z, prec);1103}1104other_roots(iroot, &iroot1,&iroot2);1105BS.divro = gdiv(gsub(ro0, gel(ro,iroot2)), gsub(ro0, gel(ro,iroot1)));1106/* Compute h_1....h_r */1107c91 = c90;1108for (k=1; k<=r; k++)1109{1110GEN z = gdiv(gcoeff(MatFU,iroot1,k), gcoeff(MatFU,iroot2,k));1111z = gmax_shallow(gen_1, abslog(z));1112c91 = gmul(c91, gmax_shallow(gel(ALH,k), gdiv(z, BS.bak)));1113}1114BS.c91 = c91;11151116for (; ine<lg(ne); ine++)1117{1118pari_sp av2 = avma;1119long lS = lg(S);1120GEN Lambda, B0, c6, c8;1121GEN NE = gel(MatNE,ine), v = cgetg(r+1,t_COL);11221123if (DEBUGLEVEL>1) err_printf(" - norm sol. no %ld/%ld\n",ine,lg(ne)-1);1124for (k=1; k<=r; k++)1125{1126GEN z = gdiv(gel(diffRo,k), gabs(gel(NE,k), prec));1127gel(v,k) = glog(z, prec);1128}1129Lambda = RgM_RgC_mul(A,v);11301131c6 = addrr(dbltor(0.1), vecmax_shallow(gabs(Lambda,DEFAULTPREC)));1132c6 = myround(c6, 1);1133c8 = addrr(dbltor(1.23), mulur(r,c6));1134BS.c11= mulrr(shiftr(c3,1) , mpexp(divrr(mulur(n,c8),c7)));1135BS.c15= mulrr(shiftr(c14,1), mpexp(divrr(mulur(n,c6),c5)));1136BS.NE = NE;1137BS.Hmu = gel(Hmu,ine);1138if (is_pm1(BS.Ind))1139{1140GEN mu = gel(ne,ine), Lmu = cgetg(lg(prinfo),t_VEC);1141long i, j;11421143for (i = 1; i < lg(prinfo); i++)1144{1145GEN v = gel(prinfo,i), PR = gel(v,3), L = cgetg(4, t_VECSMALL);1146for (j = 1; j <= 3; j++) L[j] = itou(nf_to_Fq(nf, mu, gel(PR,j)));1147gel(Lmu, i) = L;1148}1149if (! (B0 = get_B0(i1, Delta2, Lambda, Deps5, prec, &BS)) ||1150!TrySol(&S, B0, i1, Delta2, Lambda, ro, Lmu, NE,MatFU,prinfo,1151P,rhs))1152goto START;1153if (lg(S) == lS) set_avma(av2);1154}1155else1156{1157if (! (Bx = get_Bx_LLL(i1, Delta2, Lambda, prec, &BS)) )1158goto START;1159x3 = gerepileupto(av2, gmax_shallow(Bx, x3));1160}1161}1162ine = 1;1163}1164x3 = gmax_shallow(x0, MiddleSols(&S, x3, ro, P, rhs, s, c1));1165return SmallSols(S, x3, P, rhs);1166}11671168/* restrict to solutions (x,y) with L | x, replacing each by (x/L, y) */1169static GEN1170filter_sol_x(GEN S, GEN L)1171{1172long i, k, l;1173if (is_pm1(L)) return S;1174l = lg(S); k = 1;1175for (i = 1; i < l; i++)1176{1177GEN s = gel(S,i), r;1178gel(s,1) = dvmdii(gel(s,1), L, &r);1179if (r == gen_0) gel(S, k++) = s;1180}1181setlg(S, k); return S;1182}1183static GEN1184filter_sol_Z(GEN S)1185{1186long i, k = 1, l = lg(S);1187for (i = 1; i < l; i++)1188{1189GEN s = gel(S,i);1190if (RgV_is_ZV(s)) gel(S, k++) = s;1191}1192setlg(S, k); return S;1193}11941195static GEN bnfisintnorm_i(GEN bnf, GEN a, long s, GEN z);1196static GEN1197tnf_get_Ind(GEN tnf) { return gmael(tnf,7,7); }1198static GEN1199tnf_get_bnf(GEN tnf) { return gel(tnf,2); }12001201static void1202maybe_warn(GEN bnf, GEN a, GEN Ind)1203{1204if (!is_pm1(Ind) && !is_pm1(bnf_get_no(bnf)) && !is_pm1(a))1205pari_warn(warner, "The result returned by 'thue' is conditional on the GRH");1206}1207static GEN bnfisintnorm_fa(GEN bnf, GEN a, GEN fa, long sa);1208/* return solutions of Norm(x) = a mod U(K)^+ */1209static GEN1210get_ne(GEN bnf, GEN a, GEN fa, GEN Ind)1211{1212if (DEBUGLEVEL) maybe_warn(bnf,a,Ind);1213return bnfisintnorm_fa(bnf, a, fa, signe(a));1214}1215/* return solutions of |Norm(x)| = |a| mod U(K) */1216static GEN1217get_neabs(GEN bnf, GEN a, GEN Ind)1218{1219if (DEBUGLEVEL) maybe_warn(bnf,a,Ind);1220return bnfisintnormabs(bnf, a);1221}12221223/* Let P(z)=z^2+Bz+C, convert t=u+v*z (mod P) solution of norm equation N(t)=A1224* to [x,y] = [u,-v] form: y^2P(x/y) = A */1225static GEN1226ne2_to_xy(GEN t)1227{1228GEN u,v;1229if (typ(t) != t_POL) { u = t; v = gen_0; }1230else switch(degpol(t))1231{1232case -1: u = v = gen_0; break;1233case 0: u = gel(t,2); v = gen_0; break;1234default: u = gel(t,2); v = gneg(gel(t,3));1235}1236return mkvec2(u, v);1237}1238static GEN1239ne2V_to_xyV(GEN v)1240{1241long i, l;1242GEN w = cgetg_copy(v,&l);1243for (i=1; i<l; i++) gel(w,i) = ne2_to_xy(gel(v,i));1244return w;1245}12461247static GEN1248sol_0(void) { retmkvec( mkvec2(gen_0,gen_0) ); }1249static void1250sols_from_R(GEN Rab, GEN *pS, GEN P, GEN POL, GEN rhs)1251{1252GEN ry = nfrootsQ(Rab);1253long k, l = lg(ry);1254for (k = 1; k < l; k++)1255if (typ(gel(ry,k)) == t_INT) check_y(pS, P, POL, gel(ry,k), rhs);1256}1257static GEN1258absZ_factor_if_easy(GEN rhs, GEN x3)1259{1260GEN F, U;1261if (expi(rhs) < 150 || expo(x3) >= BITS_IN_LONG) return absZ_factor(rhs);1262F = absZ_factor_limit_strict(rhs, 500000, &U);1263return U? NULL: F;1264}1265/* Given a tnf structure as returned by thueinit, a RHS and1266* optionally the solutions to the norm equation, returns the solutions to1267* the Thue equation F(x,y)=a */1268GEN1269thue(GEN tnf, GEN rhs, GEN ne)1270{1271pari_sp av = avma;1272GEN POL, C, L, x3, S;12731274if (typ(tnf) == t_POL) tnf = thueinit(tnf, 0, DEFAULTPREC);1275if (!checktnf(tnf)) pari_err_TYPE("thue [please apply thueinit()]", tnf);1276if (typ(rhs) != t_INT) pari_err_TYPE("thue",rhs);1277if (ne && typ(ne) != t_VEC) pari_err_TYPE("thue",ne);12781279/* solve P(x,y) = rhs <=> POL(L x, y) = C rhs, with POL monic in Z[X] */1280POL = gel(tnf,1);1281C = gel(POL,2); rhs = gmul(C, rhs);1282if (typ(rhs) != t_INT) { set_avma(av); return cgetg(1, t_VEC); }1283if (!signe(rhs))1284{1285GEN v = gel(tnf,2);1286set_avma(av);1287/* at least 2 irreducible factors, one of which has degree 1 */1288if (typ(v) == t_VECSMALL && v[1] ==1)1289pari_err_DOMAIN("thue","#sols","=",strtoGENstr("oo"),rhs);1290return sol_0();1291}1292L = gel(POL,3);1293POL = gel(POL,1);1294if (lg(tnf) == 8)1295{1296if (!ne)1297{1298GEN F = absZ_factor(rhs);1299ne = get_ne(tnf_get_bnf(tnf), rhs, F, tnf_get_Ind(tnf));1300}1301if (lg(ne) == 1) { set_avma(av); return cgetg(1, t_VEC); }1302S = LargeSols(POL, tnf, rhs, ne);1303}1304else if (typ(gel(tnf,3)) == t_REAL)1305{ /* Case s=0. All solutions are "small". */1306GEN bnf = tnf_get_bnf(tnf);1307GEN c0 = gel(tnf,3), F;1308x3 = sqrtnr(mulir(absi_shallow(rhs),c0), degpol(POL));1309x3 = addrr(x3, dbltor(0.1)); /* guard from round-off errors */1310S = cgetg(1,t_VEC);1311if (!ne && typ(bnf) == t_VEC && expo(x3) > 10)1312{1313F = absZ_factor_if_easy(rhs, x3);1314if (F) ne = get_ne(bnf, rhs, F, gen_1);1315}1316if (ne)1317{1318if (lg(ne) == 1) { set_avma(av); return cgetg(1,t_VEC); }1319if (degpol(POL) == 2) /* quadratic imaginary */1320{1321GEN u = NULL;1322long w = 2;1323if (typ(bnf) == t_VEC)1324{1325u = bnf_get_tuU(bnf);1326w = bnf_get_tuN(bnf);1327}1328else1329{1330GEN D = coredisc(ZX_disc(POL));1331if (cmpis(D, -4) >= 0)1332{1333GEN F, T = quadpoly(D);1334w = equalis(D, -4)? 4: 6;1335setvarn(T, fetch_var_higher());1336F = gcoeff(nffactor(POL, T), 1, 1);1337u = gneg(lift_shallow(gel(F,2))); delete_var();1338}1339}1340if (w == 4) /* u = I */1341ne = shallowconcat(ne, RgXQV_RgXQ_mul(ne,u,POL));1342else if (w == 6) /* u = j */1343{1344GEN u2 = RgXQ_sqr(u,POL);1345ne = shallowconcat1(mkvec3(ne, RgXQV_RgXQ_mul(ne,u,POL),1346RgXQV_RgXQ_mul(ne,u2,POL)));1347}1348S = ne2V_to_xyV(ne);1349S = filter_sol_Z(S);1350S = shallowconcat(S, RgV_neg(S));1351}1352}1353if (lg(S) == 1) S = SmallSols(S, x3, POL, rhs);1354}1355else if (typ(gel(tnf,3)) == t_INT) /* reducible case, pure power*/1356{1357GEN bnf, ne1 = NULL, ne2 = NULL;1358long e = itos( gel(tnf,3) );1359if (!Z_ispowerall(rhs, e, &rhs)) { set_avma(av); return cgetg(1, t_VEC); }1360tnf = gel(tnf,2);1361bnf = tnf_get_bnf(tnf);1362ne = get_neabs(bnf, rhs, lg(tnf)==8?tnf_get_Ind(tnf): gen_1);1363ne1= bnfisintnorm_i(bnf,rhs,1,ne);1364S = thue(tnf, rhs, ne1);1365if (!odd(e) && lg(tnf)==8) /* if s=0, norms are positive */1366{1367ne2 = bnfisintnorm_i(bnf,rhs,-1,ne);1368S = shallowconcat(S, thue(tnf, negi(rhs), ne2));1369}1370}1371else /* other reducible cases */1372{ /* solve f^e * g = rhs, f irreducible factor of smallest degree */1373GEN P, D, v = gel(tnf, 2), R = gel(tnf, 3);1374long i, l, e = v[2], va = v[3], vb = v[4];1375P = cgetg(lg(POL), t_POL); P[1] = POL[1];1376D = divisors(rhs); l = lg(D);1377S = cgetg(1,t_VEC);1378for (i = 1; i < l; i++)1379{1380GEN Rab, df = gel(D,i), dg = gel(D,l-i); /* df*dg=|rhs| */1381if (e > 1 && !Z_ispowerall(df, e, &df)) continue;1382/* Rab: univariate polynomial in Z[Y], whose roots are the possible y. */1383/* Here and below, Rab != 0 */1384if (signe(rhs) < 0) dg = negi(dg); /* df*dg=rhs */1385Rab = gsubst(gsubst(R, va, df), vb, dg);1386sols_from_R(Rab, &S,P,POL,rhs);1387Rab = gsubst(gsubst(R, va, negi(df)), vb, odd(e)? negi(dg): dg);1388sols_from_R(Rab, &S,P,POL,rhs);1389}1390}1391S = filter_sol_x(S, L);1392S = gen_sort_uniq(S, (void*)lexcmp, cmp_nodata);1393return gerepileupto(av, S);1394}13951396/********************************************************************/1397/** **/1398/** BNFISINTNORM (K. Belabas) **/1399/** **/1400/********************************************************************/1401struct sol_abs1402{1403GEN rel; /* Primes PR[i] above a, expressed on generators of Cl(K) */1404GEN partrel; /* list of vectors, partrel[i] = rel[1..i] * u[1..i] */1405GEN cyc; /* orders of generators of Cl(K) given in bnf */14061407long *f; /* f[i] = f(PR[i]/p), inertia degree */1408long *n; /* a = prod p^{ n_p }. n[i]=n_p if PR[i] divides p */1409long *next; /* index of first P above next p, 0 if p is last */1410long *S; /* S[i] = n[i] - sum_{ 1<=k<=i } f[k]*u[k] */1411long *u; /* We want principal ideals I = prod PR[i]^u[i] */1412GEN normsol;/* lists of copies of the u[] which are solutions */14131414long nPR; /* length(T->rel) = #PR */1415long sindex, smax; /* current index in T->normsol; max. index */1416};14171418/* u[1..i] has been filled. Norm(u) is correct.1419* Check relations in class group then save it. */1420static void1421test_sol(struct sol_abs *T, long i)1422{1423long k, l;1424GEN s;14251426if (T->partrel && !ZV_dvd(gel(T->partrel, i), T->cyc)) return;1427if (T->sindex == T->smax)1428{ /* no more room in solution list: enlarge */1429long new_smax = T->smax << 1;1430GEN new_normsol = new_chunk(new_smax+1);14311432for (k=1; k<=T->smax; k++) gel(new_normsol,k) = gel(T->normsol,k);1433T->normsol = new_normsol; T->smax = new_smax;1434}1435gel(T->normsol, ++T->sindex) = s = cgetg_copy(T->u, &l);1436for (k=1; k <= i; k++) s[k] = T->u[k];1437for ( ; k < l; k++) s[k] = 0;1438if (DEBUGLEVEL>2)1439{1440err_printf("sol = %Ps\n",s);1441if (T->partrel) err_printf("T->partrel = %Ps\n",T->partrel);1442}1443}1444/* partrel[i] <-- partrel[i-1] + u[i] * rel[i] */1445static void1446fix_partrel(struct sol_abs *T, long i)1447{1448pari_sp av = avma;1449GEN part1 = gel(T->partrel,i);1450GEN part0 = gel(T->partrel,i-1);1451GEN rel = gel(T->rel, i);1452ulong u = T->u[i];1453long k, l = lg(part1);1454for (k=1; k < l; k++)1455affii(addii(gel(part0,k), muliu(gel(rel,k), u)), gel(part1,k));1456set_avma(av);1457}14581459/* Recursive loop. Suppose u[1..i] has been filled1460* Find possible solutions u such that, Norm(prod PR[i]^u[i]) = a, taking1461* into account:1462* 1) the relations in the class group if need be.1463* 2) the factorization of a. */1464static void1465isintnorm_loop(struct sol_abs *T, long i)1466{1467if (T->S[i] == 0) /* sum u[i].f[i] = n[i], do another prime */1468{1469long k, next = T->next[i];1470if (next == 0) { test_sol(T, i); return; } /* no primes left */14711472/* some primes left */1473if (T->partrel) gaffect(gel(T->partrel,i), gel(T->partrel, next-1));1474for (k=i+1; k < next; k++) T->u[k] = 0;1475i = next-1;1476}1477else if (i == T->next[i]-2 || i == T->nPR-1)1478{ /* only one Prime left above prime; change prime, fix u[i+1] */1479long q;1480if (T->S[i] % T->f[i+1]) return;1481q = T->S[i] / T->f[i+1];1482i++; T->u[i] = q;1483if (T->partrel) fix_partrel(T,i);1484if (T->next[i] == 0) { test_sol(T,i); return; }1485}14861487i++; T->u[i] = 0;1488if (T->partrel) gaffect(gel(T->partrel,i-1), gel(T->partrel,i));1489if (i == T->next[i-1])1490{ /* change prime */1491if (T->next[i] == i+1 || i == T->nPR) /* only one Prime above p */1492{1493T->S[i] = 0;1494T->u[i] = T->n[i] / T->f[i]; /* we already know this is exact */1495if (T->partrel) fix_partrel(T, i);1496}1497else T->S[i] = T->n[i];1498}1499else T->S[i] = T->S[i-1]; /* same prime, different Prime */1500for(;;)1501{1502isintnorm_loop(T, i);1503T->S[i] -= T->f[i]; if (T->S[i] < 0) break;1504T->u[i]++;1505if (T->partrel) {1506pari_sp av = avma;1507gaffect(ZC_add(gel(T->partrel,i), gel(T->rel,i)), gel(T->partrel,i));1508set_avma(av);1509}1510}1511}15121513static int1514get_sol_abs(struct sol_abs *T, GEN bnf, GEN nf, GEN fact, GEN *ptPR)1515{1516GEN P = gel(fact,1), E = gel(fact,2), PR;1517long N = nf_get_degree(nf), nP = lg(P)-1, Ngen, max, nPR, i, j;15181519max = nP*N; /* upper bound for T->nPR */1520T->f = new_chunk(max+1);1521T->n = new_chunk(max+1);1522T->next = new_chunk(max+1);1523*ptPR = PR = cgetg(max+1, t_COL); /* length to be fixed later */15241525nPR = 0;1526for (i = 1; i <= nP; i++)1527{1528GEN L = idealprimedec(nf, gel(P,i));1529long lL = lg(L), gcd, k, v;1530ulong vn = itou(gel(E,i));15311532/* check that gcd_{P | p} f_P divides n_p */1533gcd = pr_get_f(gel(L,1));1534for (j=2; gcd > 1 && j < lL; j++) gcd = ugcd(gcd, pr_get_f(gel(L,j)));1535if (gcd > 1 && vn % gcd)1536{1537if (DEBUGLEVEL>2) err_printf("gcd f_P does not divide n_p\n");1538return 0;1539}1540v = (i==nP)? 0: nPR + lL;1541for (k = 1; k < lL; k++)1542{1543GEN pr = gel(L,k);1544gel(PR, ++nPR) = pr;1545T->f[nPR] = pr_get_f(pr) / gcd;1546T->n[nPR] = vn / gcd;1547T->next[nPR] = v;1548}1549}1550T->nPR = nPR;1551setlg(PR, nPR + 1);15521553T->u = cgetg(nPR+1, t_VECSMALL);1554T->S = new_chunk(nPR+1);1555if (bnf) { T->cyc = bnf_get_cyc(bnf); Ngen = lg(T->cyc)-1; }1556else { T->cyc = NULL; Ngen = 0; }1557if (Ngen == 0)1558T->rel = T->partrel = NULL; /* trivial Cl(K), no relations to check */1559else1560{1561int triv = 1;1562T->partrel = new_chunk(nPR+1);1563T->rel = new_chunk(nPR+1);1564for (i=1; i <= nPR; i++)1565{1566GEN c = isprincipal(bnf, gel(PR,i));1567gel(T->rel,i) = c;1568if (triv && !ZV_equal0(c)) triv = 0; /* non trivial relations in Cl(K)*/1569}1570/* triv = 1: all ideals dividing a are principal */1571if (triv) T->rel = T->partrel = NULL;1572}1573if (T->partrel)1574{1575long B = ZV_max_lg(T->cyc) + 3;1576for (i = 0; i <= nPR; i++)1577{ /* T->partrel[0] also needs to be initialized */1578GEN c = cgetg(Ngen+1, t_COL); gel(T->partrel,i) = c;1579for (j=1; j<=Ngen; j++)1580{1581GEN z = cgeti(B); gel(c,j) = z;1582z[1] = evalsigne(0)|evallgefint(B);1583}1584}1585}1586T->smax = 511;1587T->normsol = new_chunk(T->smax+1);1588T->S[0] = T->n[1];1589T->next[0] = 1;1590T->sindex = 0;1591isintnorm_loop(T, 0); return 1;1592}15931594/* Look for unit of norm -1. Return 1 if it exists and set *unit, 0 otherwise */1595static long1596get_unit_1(GEN bnf, GEN *unit)1597{1598GEN v, nf = bnf_get_nf(bnf);1599long i, n = nf_get_degree(nf);16001601if (DEBUGLEVEL > 2) err_printf("looking for a fundamental unit of norm -1\n");1602if (odd(n)) { *unit = gen_m1; return 1; }1603v = nfsign_fu(bnf, NULL);1604for (i = 1; i < lg(v); i++)1605if ( Flv_sum( gel(v,i), 2) ) { *unit = gel(bnf_get_fu(bnf), i); return 1; }1606return 0;1607}16081609GEN1610bnfisintnormabs(GEN bnf, GEN a)1611{1612struct sol_abs T;1613GEN nf, res, PR, F;1614long i;16151616if ((F = check_arith_all(a,"bnfisintnormabs")))1617{1618a = typ(a) == t_VEC? gel(a,1): factorback(F);1619if (signe(a) < 0) F = clean_Z_factor(F);1620}1621bnf = checkbnf(bnf); nf = bnf_get_nf(bnf);1622if (!signe(a)) return mkvec(gen_0);1623if (is_pm1(a)) return mkvec(gen_1);1624if (!F) F = absZ_factor(a);1625if (!get_sol_abs(&T, bnf, nf, F, &PR)) return cgetg(1, t_VEC);1626/* |a| > 1 => T.nPR > 0 */1627res = cgetg(T.sindex+1, t_VEC);1628for (i=1; i<=T.sindex; i++)1629{1630GEN x = vecsmall_to_col( gel(T.normsol,i) );1631x = isprincipalfact(bnf, NULL, PR, x, nf_FORCE | nf_GEN_IF_PRINCIPAL);1632gel(res,i) = nf_to_scalar_or_alg(nf, x); /* x solution, up to sign */1633}1634return res;1635}16361637GEN1638ideals_by_norm(GEN nf, GEN a)1639{1640struct sol_abs T;1641GEN res, PR, F;1642long i;16431644if ((F = check_arith_pos(a,"ideals_by_norm")))1645a = typ(a) == t_VEC? gel(a,1): factorback(F);1646nf = checknf(nf);1647if (is_pm1(a)) return mkvec(trivial_fact());1648if (!F) F = absZ_factor(a);1649if (!get_sol_abs(&T, NULL, nf, F, &PR)) return cgetg(1, t_VEC);1650res = cgetg(T.sindex+1, t_VEC);1651for (i=1; i<=T.sindex; i++)1652{1653GEN x = vecsmall_to_col( gel(T.normsol,i) );1654gel(res,i) = famat_remove_trivial(mkmat2(PR, x));1655}1656return res;1657}16581659/* z = bnfisintnormabs(bnf,a), sa = 1 or -1, return bnfisintnorm(bnf,sa*|a|) */1660static GEN1661bnfisintnorm_i(GEN bnf, GEN a, long sa, GEN z)1662{1663GEN nf = checknf(bnf), T = nf_get_pol(nf), f = nf_get_index(nf), unit = NULL;1664GEN Tp, A = signe(a) == sa? a: negi(a);1665long sNx, i, j, N = degpol(T), l = lg(z);1666long norm_1 = 0; /* gcc -Wall */1667ulong p, Ap = 0; /* gcc -Wall */1668forprime_t S;1669if (!signe(a)) return z;1670u_forprime_init(&S,3,ULONG_MAX);1671while((p = u_forprime_next(&S)))1672if (umodiu(f,p)) { Ap = umodiu(A,p); if (Ap) break; }1673Tp = ZX_to_Flx(T,p);1674/* p > 2 doesn't divide A nor Q_denom(z in Z_K)*/16751676/* update z in place to get correct signs: multiply by unit of norm -1 if1677* it exists, otherwise delete solution with wrong sign */1678for (i = j = 1; i < l; i++)1679{1680GEN x = gel(z,i);1681int xpol = (typ(x) == t_POL);16821683if (xpol)1684{1685GEN dx, y = Q_remove_denom(x,&dx);1686ulong Np = Flx_resultant(Tp, ZX_to_Flx(y,p), p);1687ulong dA = dx? Fl_mul(Ap, Fl_powu(umodiu(dx,p), N, p), p): Ap;1688/* Nx = Res(T,y) / dx^N = A or -A. Check mod p */1689sNx = dA == Np? sa: -sa;1690}1691else1692sNx = gsigne(x) < 0 && odd(N) ? -1 : 1;1693if (sNx != sa)1694{1695if (! unit) norm_1 = get_unit_1(bnf, &unit);1696if (!norm_1)1697{1698if (DEBUGLEVEL > 2) err_printf("%Ps eliminated because of sign\n",x);1699continue;1700}1701if (xpol) x = (unit == gen_m1)? RgX_neg(x): RgXQ_mul(unit,x,T);1702else x = (unit == gen_m1)? gneg(x): RgX_Rg_mul(unit,x);1703}1704gel(z,j++) = x;1705}1706setlg(z, j); return z;1707}1708/* bnfisintnorm sa * |a|, fa = factor(|a|) */1709static GEN1710bnfisintnorm_fa(GEN bnf, GEN a, GEN fa, long sa)1711{ return bnfisintnorm_i(bnf, a, sa, bnfisintnormabs(bnf, mkvec2(a, fa)));1712}1713GEN1714bnfisintnorm(GEN bnf, GEN a)1715{1716pari_sp av = avma;1717GEN ne = bnfisintnormabs(bnf,a);1718switch(typ(a))1719{1720case t_VEC: a = gel(a,1); break;1721case t_MAT: a = factorback(a); break;1722}1723return gerepilecopy(av, bnfisintnorm_i(bnf, a, signe(a), ne));1724}172517261727