Line data Source code
1 : /* Copyright (C) 2000 The PARI group.
2 :
3 : This file is part of the PARI/GP package.
4 :
5 : PARI/GP is free software; you can redistribute it and/or modify it under the
6 : terms of the GNU General Public License as published by the Free Software
7 : Foundation. It is distributed in the hope that it will be useful, but WITHOUT
8 : ANY WARRANTY WHATSOEVER.
9 :
10 : Check the License for details. You should have received a copy of it, along
11 : with the package; see the file 'COPYING'. If not, write to the Free Software
12 : Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
13 :
14 : /*******************************************************************/
15 : /* */
16 : /* ROOTS OF COMPLEX POLYNOMIALS */
17 : /* (original code contributed by Xavier Gourdon, INRIA RR 1852) */
18 : /* */
19 : /*******************************************************************/
20 : #include "pari.h"
21 : #include "paripriv.h"
22 :
23 : static const double pariINFINITY = 1./0.;
24 :
25 : static long
26 101168 : isvalidcoeff(GEN x)
27 : {
28 101168 : switch (typ(x))
29 : {
30 86249 : case t_INT: case t_REAL: case t_FRAC: return 1;
31 14905 : case t_COMPLEX: return isvalidcoeff(gel(x,1)) && isvalidcoeff(gel(x,2));
32 : }
33 14 : return 0;
34 : }
35 :
36 : static void
37 14017 : checkvalidpol(GEN p, const char *f)
38 : {
39 14017 : long i,n = lg(p);
40 85354 : for (i=2; i<n; i++)
41 71344 : if (!isvalidcoeff(gel(p,i))) pari_err_TYPE(f, gel(p,i));
42 14010 : }
43 :
44 : /********************************************************************/
45 : /** **/
46 : /** FAST ARITHMETIC over Z[i] **/
47 : /** **/
48 : /********************************************************************/
49 : static THREAD long KARASQUARE_LIMIT, COOKSQUARE_LIMIT;
50 :
51 : /* fast sum of x,y: t_INT or t_COMPLEX(t_INT) */
52 : static GEN
53 14276802 : addCC(GEN x, GEN y)
54 : {
55 : GEN z;
56 :
57 14276802 : if (typ(x) == t_INT)
58 : {
59 12166342 : if (typ(y) == t_INT) return addii(x,y);
60 : /* ty == t_COMPLEX */
61 2257 : z = cgetg(3,t_COMPLEX);
62 2257 : gel(z,1) = addii(x, gel(y,1));
63 2257 : gel(z,2) = icopy(gel(y,2)); return z;
64 : }
65 : /* tx == t_COMPLEX */
66 2110460 : z = cgetg(3,t_COMPLEX);
67 2110460 : if (typ(y) == t_INT)
68 : {
69 26260 : gel(z,1) = addii(gel(x,1),y);
70 26260 : gel(z,2) = icopy(gel(x,2)); return z;
71 : }
72 : /* ty == t_COMPLEX */
73 2084200 : gel(z,1) = addii(gel(x,1),gel(y,1));
74 2084200 : gel(z,2) = addii(gel(x,2),gel(y,2)); return z;
75 : }
76 : /* fast product of x,y: t_INT or t_COMPLEX(t_INT) */
77 : static GEN
78 27935253 : mulCC(GEN x, GEN y)
79 : {
80 : GEN z;
81 :
82 27935253 : if (typ(x) == t_INT)
83 : {
84 22668000 : if (typ(y) == t_INT) return mulii(x,y);
85 : /* ty == t_COMPLEX */
86 18191 : z = cgetg(3,t_COMPLEX);
87 18191 : gel(z,1) = mulii(x, gel(y,1));
88 18191 : gel(z,2) = mulii(x, gel(y,2)); return z;
89 : }
90 : /* tx == t_COMPLEX */
91 5267253 : z = cgetg(3,t_COMPLEX);
92 5267253 : if (typ(y) == t_INT)
93 : {
94 1552967 : gel(z,1) = mulii(gel(x,1),y);
95 1552967 : gel(z,2) = mulii(gel(x,2),y); return z;
96 : }
97 : /* ty == t_COMPLEX */
98 : {
99 3714286 : pari_sp av = avma, tetpil;
100 : GEN p1, p2;
101 :
102 3714286 : p1 = mulii(gel(x,1),gel(y,1));
103 3714286 : p2 = mulii(gel(x,2),gel(y,2));
104 7428572 : y = mulii(addii(gel(x,1),gel(x,2)),
105 7428572 : addii(gel(y,1),gel(y,2)));
106 3714286 : x = addii(p1,p2); tetpil = avma;
107 3714286 : gel(z,1) = subii(p1,p2);
108 3714286 : gel(z,2) = subii(y,x); gerepilecoeffssp(av,tetpil,z+1,2);
109 3714286 : return z;
110 : }
111 : }
112 : /* fast squaring x: t_INT or t_COMPLEX(t_INT) */
113 : static GEN
114 25056959 : sqrCC(GEN x)
115 : {
116 : GEN z;
117 :
118 25056959 : if (typ(x) == t_INT) return sqri(x);
119 : /* tx == t_COMPLEX */
120 5405435 : z = cgetg(3,t_COMPLEX);
121 : {
122 5405435 : pari_sp av = avma, tetpil;
123 : GEN y, p1, p2;
124 :
125 5405435 : p1 = sqri(gel(x,1));
126 5405435 : p2 = sqri(gel(x,2));
127 5405435 : y = sqri(addii(gel(x,1),gel(x,2)));
128 5405435 : x = addii(p1,p2); tetpil = avma;
129 5405435 : gel(z,1) = subii(p1,p2);
130 5405435 : gel(z,2) = subii(y,x); gerepilecoeffssp(av,tetpil,z+1,2);
131 5405435 : return z;
132 : }
133 : }
134 :
135 : static void
136 4416043 : set_karasquare_limit(long bit)
137 : {
138 4416043 : if (bit<600) { KARASQUARE_LIMIT=8; COOKSQUARE_LIMIT=400; }
139 1204 : else if (bit<2000) { KARASQUARE_LIMIT=4; COOKSQUARE_LIMIT=200; }
140 0 : else if (bit<3000) { KARASQUARE_LIMIT=4; COOKSQUARE_LIMIT=125; }
141 0 : else if (bit<5000) { KARASQUARE_LIMIT=2; COOKSQUARE_LIMIT= 75; }
142 0 : else { KARASQUARE_LIMIT=1; COOKSQUARE_LIMIT= 50; }
143 4416043 : }
144 :
145 : /* assume lP > 0, lP = lgpol(P) */
146 : static GEN
147 9119086 : CX_square_spec(GEN P, long lP)
148 : {
149 : GEN s, t;
150 9119086 : long i, j, l, nn, n = lP - 1;
151 : pari_sp av;
152 :
153 9119086 : nn = n<<1; s = cgetg(nn+3,t_POL); s[1] = evalsigne(1)|evalvarn(0);
154 9119086 : gel(s,2) = sqrCC(gel(P,0)); /* i = 0 */
155 22777537 : for (i=1; i<=n; i++)
156 : {
157 13658451 : av = avma; l = (i+1)>>1;
158 13658451 : t = mulCC(gel(P,0), gel(P,i)); /* j = 0 */
159 13658451 : for (j=1; j<l; j++) t = addCC(t, mulCC(gel(P,j), gel(P,i-j)));
160 13658451 : t = gmul2n(t,1);
161 13658451 : if ((i & 1) == 0) t = addCC(t, sqrCC(gel(P,i>>1)));
162 13658451 : gel(s,i+2) = gerepileupto(av, t);
163 : }
164 9119086 : gel(s,nn+2) = sqrCC(gel(P,n)); /* i = nn */
165 15937873 : for ( ; i<nn; i++)
166 : {
167 6818787 : av = avma; l = (i+1)>>1;
168 6818787 : t = mulCC(gel(P,i-n),gel(P,n)); /* j = i-n */
169 6818787 : for (j=i-n+1; j<l; j++) t = addCC(t, mulCC(gel(P,j),gel(P,i-j)));
170 6818787 : t = gmul2n(t,1);
171 6818787 : if ((i & 1) == 0) t = addCC(t, sqrCC(gel(P,i>>1)));
172 6818787 : gel(s,i+2) = gerepileupto(av, t);
173 : }
174 9119086 : return normalizepol_lg(s, nn+3);
175 : }
176 : /* nx = lgpol(x) */
177 : static GEN
178 0 : RgX_s_mulspec(GEN x, long nx, long s)
179 : {
180 : GEN z, t;
181 : long i;
182 0 : if (!s || !nx) return pol_0(0);
183 0 : z = cgetg(nx+2, t_POL); z[1] = evalsigne(1)|evalvarn(0); t = z + 2;
184 0 : for (i=0; i < nx; i++) gel(t,i) = gmulgs(gel(x,i), s);
185 0 : return z;
186 : }
187 : /* nx = lgpol(x), return x << s. Inefficient if s = 0... */
188 : static GEN
189 0 : RgX_shiftspec(GEN x, long nx, long s)
190 : {
191 : GEN z, t;
192 : long i;
193 0 : if (!nx) return pol_0(0);
194 0 : z = cgetg(nx+2, t_POL); z[1] = evalsigne(1)|evalvarn(0); t = z + 2;
195 0 : for (i=0; i < nx; i++) gel(t,i) = gmul2n(gel(x,i), s);
196 0 : return z;
197 : }
198 :
199 : /* spec function. nP = lgpol(P) */
200 : static GEN
201 9264035 : karasquare(GEN P, long nP)
202 : {
203 : GEN Q, s0, s1, s2, a, t;
204 9264035 : long n0, n1, i, l, N, N0, N1, n = nP - 1; /* degree(P) */
205 : pari_sp av;
206 :
207 9264035 : if (n <= KARASQUARE_LIMIT) return nP? CX_square_spec(P, nP): pol_0(0);
208 143983 : av = avma;
209 143983 : n0 = (n>>1) + 1; n1 = nP - n0;
210 143983 : s0 = karasquare(P, n0); Q = P + n0;
211 143983 : s2 = karasquare(Q, n1);
212 143983 : s1 = RgX_addspec_shallow(P, Q, n0, n1);
213 143983 : s1 = RgX_sub(karasquare(s1+2, lgpol(s1)), RgX_add(s0,s2));
214 143983 : N = (n<<1) + 1;
215 143983 : a = cgetg(N + 2, t_POL); a[1] = evalsigne(1)|evalvarn(0);
216 143983 : t = a+2; l = lgpol(s0); s0 += 2; N0 = n0<<1;
217 143983 : for (i=0; i < l; i++) gel(t,i) = gel(s0,i);
218 143983 : for ( ; i < N0; i++) gel(t,i) = gen_0;
219 143983 : t = a+2 + N0; l = lgpol(s2); s2 += 2; N1 = N - N0;
220 143983 : for (i=0; i < l; i++) gel(t,i) = gel(s2,i);
221 143983 : for ( ; i < N1; i++) gel(t,i) = gen_0;
222 143983 : t = a+2 + n0; l = lgpol(s1); s1 += 2;
223 143983 : for (i=0; i < l; i++) gel(t,i) = gadd(gel(t,i), gel(s1,i));
224 143983 : return gerepilecopy(av, normalizepol_lg(a, N+2));
225 : }
226 : /* spec function. nP = lgpol(P) */
227 : static GEN
228 8832086 : cook_square(GEN P, long nP)
229 : {
230 : GEN Q, p0, p1, p2, p3, q, r, t, vp, vm;
231 8832086 : long n0, n3, i, j, n = nP - 1;
232 : pari_sp av;
233 :
234 8832086 : if (n <= COOKSQUARE_LIMIT) return nP? karasquare(P, nP): pol_0(0);
235 0 : av = avma;
236 :
237 0 : n0 = (n+1) >> 2; n3 = n+1 - 3*n0;
238 0 : p0 = P;
239 0 : p1 = p0+n0;
240 0 : p2 = p1+n0;
241 0 : p3 = p2+n0; /* lgpol(p0,p1,p2) = n0, lgpol(p3) = n3 */
242 :
243 0 : q = cgetg(8,t_VEC) + 4;
244 0 : Q = cook_square(p0, n0);
245 0 : r = RgX_addspec_shallow(p0,p2, n0,n0);
246 0 : t = RgX_addspec_shallow(p1,p3, n0,n3);
247 0 : gel(q,-1) = RgX_sub(r,t);
248 0 : gel(q,1) = RgX_add(r,t);
249 0 : r = RgX_addspec_shallow(p0,RgX_shiftspec(p2,n0, 2)+2, n0,n0);
250 0 : t = gmul2n(RgX_addspec_shallow(p1,RgX_shiftspec(p3,n3, 2)+2, n0,n3), 1);
251 0 : gel(q,-2) = RgX_sub(r,t);
252 0 : gel(q,2) = RgX_add(r,t);
253 0 : r = RgX_addspec_shallow(p0,RgX_s_mulspec(p2,n0, 9)+2, n0,n0);
254 0 : t = gmulsg(3, RgX_addspec_shallow(p1,RgX_s_mulspec(p3,n3, 9)+2, n0,n3));
255 0 : gel(q,-3) = RgX_sub(r,t);
256 0 : gel(q,3) = RgX_add(r,t);
257 :
258 0 : r = new_chunk(7);
259 0 : vp = cgetg(4,t_VEC);
260 0 : vm = cgetg(4,t_VEC);
261 0 : for (i=1; i<=3; i++)
262 : {
263 0 : GEN a = gel(q,i), b = gel(q,-i);
264 0 : a = cook_square(a+2, lgpol(a));
265 0 : b = cook_square(b+2, lgpol(b));
266 0 : gel(vp,i) = RgX_add(b, a);
267 0 : gel(vm,i) = RgX_sub(b, a);
268 : }
269 0 : gel(r,0) = Q;
270 0 : gel(r,1) = gdivgs(gsub(gsub(gmulgs(gel(vm,2),9),gel(vm,3)),
271 0 : gmulgs(gel(vm,1),45)),
272 : 60);
273 0 : gel(r,2) = gdivgs(gadd(gadd(gmulgs(gel(vp,1),270),gmulgs(Q,-490)),
274 0 : gadd(gmulgs(gel(vp,2),-27),gmulgs(gel(vp,3),2))),
275 : 360);
276 0 : gel(r,3) = gdivgs(gadd(gadd(gmulgs(gel(vm,1),13),gmulgs(gel(vm,2),-8)),
277 0 : gel(vm,3)),
278 : 48);
279 0 : gel(r,4) = gdivgs(gadd(gadd(gmulgs(Q,56),gmulgs(gel(vp,1),-39)),
280 0 : gsub(gmulgs(gel(vp,2),12),gel(vp,3))),
281 : 144);
282 0 : gel(r,5) = gdivgs(gsub(gadd(gmulgs(gel(vm,1),-5),gmulgs(gel(vm,2),4)),
283 0 : gel(vm,3)),
284 : 240);
285 0 : gel(r,6) = gdivgs(gadd(gadd(gmulgs(Q,-20),gmulgs(gel(vp,1),15)),
286 0 : gadd(gmulgs(gel(vp,2),-6),gel(vp,3))),
287 : 720);
288 0 : q = cgetg(2*n+3,t_POL); q[1] = evalsigne(1)|evalvarn(0);
289 0 : t = q+2;
290 0 : for (i=0; i<=2*n; i++) gel(t,i) = gen_0;
291 0 : for (i=0; i<=6; i++,t += n0)
292 : {
293 0 : GEN h = gel(r,i);
294 0 : long d = lgpol(h);
295 0 : h += 2;
296 0 : for (j=0; j<d; j++) gel(t,j) = gadd(gel(t,j), gel(h,j));
297 : }
298 0 : return gerepilecopy(av, normalizepol_lg(q, 2*n+3));
299 : }
300 :
301 : static GEN
302 4416043 : graeffe(GEN p)
303 : {
304 : GEN p0, p1, s0, s1;
305 4416043 : long n = degpol(p), n0, n1, i;
306 :
307 4416043 : if (!n) return gcopy(p);
308 4416043 : n0 = (n>>1)+1; n1 = n+1 - n0; /* n1 <= n0 <= n1+1 */
309 4416043 : p0 = new_chunk(n0);
310 4416043 : p1 = new_chunk(n1);
311 14313287 : for (i=0; i<n1; i++)
312 : {
313 9897244 : p0[i] = p[2+(i<<1)];
314 9897244 : p1[i] = p[3+(i<<1)];
315 : }
316 4416043 : if (n1 != n0)
317 2041244 : p0[i] = p[2+(i<<1)];
318 4416043 : s0 = cook_square(p0, n0);
319 4416043 : s1 = cook_square(p1, n1);
320 4416043 : return RgX_sub(s0, RgX_shift_shallow(s1,1));
321 : }
322 : GEN
323 7462 : ZX_graeffe(GEN p)
324 : {
325 7462 : pari_sp av = avma;
326 : GEN p0, p1, s0, s1;
327 7462 : long n = degpol(p);
328 :
329 7462 : if (!n) return ZX_copy(p);
330 7462 : RgX_even_odd(p, &p0, &p1);
331 : /* p = p0(x^2) + x p1(x^2) */
332 7462 : s0 = ZX_sqr(p0);
333 7462 : s1 = ZX_sqr(p1);
334 7462 : return gerepileupto(av, ZX_sub(s0, RgX_shift_shallow(s1,1)));
335 : }
336 : GEN
337 14 : polgraeffe(GEN p)
338 : {
339 14 : pari_sp av = avma;
340 : GEN p0, p1, s0, s1;
341 14 : long n = degpol(p);
342 :
343 14 : if (typ(p) != t_POL) pari_err_TYPE("polgraeffe",p);
344 14 : n = degpol(p);
345 14 : if (!n) return gcopy(p);
346 14 : RgX_even_odd(p, &p0, &p1);
347 : /* p = p0(x^2) + x p1(x^2) */
348 14 : s0 = RgX_sqr(p0);
349 14 : s1 = RgX_sqr(p1);
350 14 : return gerepileupto(av, RgX_sub(s0, RgX_shift_shallow(s1,1)));
351 : }
352 :
353 : /********************************************************************/
354 : /** **/
355 : /** MODULUS OF ROOTS **/
356 : /** **/
357 : /********************************************************************/
358 :
359 : /* Quick approximation to log2(|x|); first define y s.t. |y-x| < 2^-32 then
360 : * return y rounded to 2 ulp. In particular, if result < 2^21, absolute error
361 : * is bounded by 2^-31. If result > 2^21, it is correct to 2 ulp */
362 : static double
363 23538069 : mydbllog2i(GEN x)
364 : {
365 : #ifdef LONG_IS_64BIT
366 20213592 : const double W = 1/(4294967296. * 4294967296.); /* 2^-64 */
367 : #else
368 3324477 : const double W = 1/4294967296.; /*2^-32*/
369 : #endif
370 : GEN m;
371 23538069 : long lx = lgefint(x);
372 : double l;
373 23538069 : if (lx == 2) return -pariINFINITY;
374 23374460 : m = int_MSW(x);
375 23374460 : l = (double)(ulong)*m;
376 23374460 : if (lx == 3) return log2(l);
377 10318487 : l += ((double)(ulong)*int_precW(m)) * W;
378 : /* at least m = min(53,BIL) bits are correct in the mantissa, thus log2
379 : * is correct with error < log(1 + 2^-m) ~ 2^-m. Adding the correct
380 : * exponent BIL(lx-3) causes 1ulp further round-off error */
381 10318487 : return log2(l) + (double)(BITS_IN_LONG*(lx-3));
382 : }
383 :
384 : /* return log(|x|) or -pariINFINITY */
385 : static double
386 1247027 : mydbllogr(GEN x) {
387 1247027 : if (!signe(x)) return -pariINFINITY;
388 1247027 : return M_LN2*dbllog2r(x);
389 : }
390 :
391 : /* return log2(|x|) or -pariINFINITY */
392 : static double
393 13925977 : mydbllog2r(GEN x) {
394 13925977 : if (!signe(x)) return -pariINFINITY;
395 13841408 : return dbllog2r(x);
396 : }
397 : static double
398 8585758 : dbllog2mp(GEN x) { return typ(x) == t_INT? mydbllog2i(x): mydbllog2r(x); }
399 : double
400 32586953 : dbllog2(GEN z)
401 : {
402 : double x, y;
403 32586953 : switch(typ(z))
404 : {
405 16312587 : case t_INT: return mydbllog2i(z);
406 791 : case t_FRAC: return mydbllog2i(gel(z,1))-mydbllog2i(gel(z,2));
407 11980696 : case t_REAL: return mydbllog2r(z);
408 : default: /*t_COMPLEX*/
409 4292879 : x = dbllog2mp(gel(z,1));
410 4292879 : y = dbllog2mp(gel(z,2));
411 4292879 : if (x == -pariINFINITY) return y;
412 4257516 : if (y == -pariINFINITY) return x;
413 4133259 : if (fabs(x-y) > 10) return maxdd(x,y);
414 4030898 : return x + 0.5*log2(1 + exp2(2*(y-x)));
415 : }
416 : }
417 : static GEN /* beware overflow */
418 639520 : dblexp(double x) { return fabs(x) < 100.? dbltor(exp(x)): mpexp(dbltor(x)); }
419 :
420 : /* find s such that A_h <= 2^s <= 2 A_i for one h and all i < n = deg(p),
421 : * with A_i := (binom(n,i) lc(p) / p_i) ^ 1/(n-i), and p = sum p_i X^i */
422 : static long
423 3479592 : findpower(GEN p)
424 : {
425 3479592 : double x, L, mins = pariINFINITY;
426 3479592 : long n = degpol(p),i;
427 :
428 3479592 : L = dbllog2(gel(p,n+2)); /* log2(lc * binom(n,i)) */
429 16748246 : for (i=n-1; i>=0; i--)
430 : {
431 13268654 : L += log2((double)(i+1) / (double)(n-i));
432 13268654 : x = dbllog2(gel(p,i+2));
433 13268654 : if (x != -pariINFINITY)
434 : {
435 13183404 : double s = (L - x) / (double)(n-i);
436 13183404 : if (s < mins) mins = s;
437 : }
438 : }
439 3479592 : i = (long)ceil(mins);
440 3479592 : if (i - mins > 1 - 1e-12) i--;
441 3479592 : return i;
442 : }
443 :
444 : /* returns the exponent for logmodulus(), from the Newton diagram */
445 : static long
446 556010 : newton_polygon(GEN p, long k)
447 : {
448 556010 : pari_sp av = avma;
449 : double *logcoef, slope;
450 556010 : long n = degpol(p), i, j, h, l, *vertex;
451 :
452 556010 : logcoef = (double*)stack_malloc_align((n+1)*sizeof(double), sizeof(double));
453 556010 : vertex = (long*)new_chunk(n+1);
454 :
455 : /* vertex[i] = 1 if i a vertex of convex hull, 0 otherwise */
456 556010 : for (i=0; i<=n; i++) { logcoef[i] = dbllog2(gel(p,2+i)); vertex[i] = 0; }
457 556010 : vertex[0] = 1; /* sentinel */
458 2287241 : for (i=0; i < n; i=h)
459 : {
460 1731231 : slope = logcoef[i+1]-logcoef[i];
461 7990049 : for (j = h = i+1; j<=n; j++)
462 : {
463 6258818 : double pij = (logcoef[j]-logcoef[i])/(double)(j-i);
464 6258818 : if (slope < pij) { slope = pij; h = j; }
465 : }
466 1731231 : vertex[h] = 1;
467 : }
468 556010 : h = k; while (!vertex[h]) h++;
469 556010 : l = k-1; while (!vertex[l]) l--;
470 556010 : avma = av;
471 556010 : return (long)floor((logcoef[h]-logcoef[l])/(double)(h-l) + 0.5);
472 : }
473 :
474 : /* change z into z*2^e, where z is real or complex of real */
475 : static void
476 3775319 : myshiftrc(GEN z, long e)
477 : {
478 3775319 : if (typ(z)==t_COMPLEX)
479 : {
480 976973 : if (signe(gel(z,1))) shiftr_inplace(gel(z,1), e);
481 976973 : if (signe(gel(z,2))) shiftr_inplace(gel(z,2), e);
482 : }
483 : else
484 2798346 : if (signe(z)) shiftr_inplace(z, e);
485 3775319 : }
486 :
487 : /* return z*2^e, where z is integer or complex of integer (destroy z) */
488 : static GEN
489 14289267 : myshiftic(GEN z, long e)
490 : {
491 14289267 : if (typ(z)==t_COMPLEX)
492 : {
493 2857613 : gel(z,1) = signe(gel(z,1))? mpshift(gel(z,1),e): gen_0;
494 2857613 : gel(z,2) = mpshift(gel(z,2),e);
495 2857613 : return z;
496 : }
497 11431654 : return signe(z)? mpshift(z,e): gen_0;
498 : }
499 :
500 : static GEN
501 716984 : RgX_gtofp_bit(GEN q, long bit)
502 : {
503 716984 : if (bit < 0) bit = 0;
504 716984 : return RgX_gtofp(q, nbits2prec(bit));
505 : }
506 :
507 : static GEN
508 28241617 : mygprecrc(GEN x, long prec, long e)
509 : {
510 : GEN y;
511 28241617 : switch(typ(x))
512 : {
513 20962087 : case t_REAL: return signe(x)? rtor(x, prec): real_0_bit(e);
514 : case t_COMPLEX:
515 5648959 : y = cgetg(3,t_COMPLEX);
516 5648959 : gel(y,1) = mygprecrc(gel(x,1),prec,e);
517 5648959 : gel(y,2) = mygprecrc(gel(x,2),prec,e);
518 5648959 : return y;
519 1630571 : default: return gcopy(x);
520 : }
521 : }
522 :
523 : /* gprec behaves badly with the zero for polynomials.
524 : The second parameter in mygprec is the precision in base 2 */
525 : static GEN
526 6990397 : mygprec(GEN x, long bit)
527 : {
528 : long lx, i, e, prec;
529 : GEN y;
530 :
531 6990397 : if (bit < 0) bit = 0; /* should rarely happen */
532 6990397 : e = gexpo(x) - bit;
533 6990397 : prec = nbits2prec(bit);
534 6990397 : switch(typ(x))
535 : {
536 : case t_POL:
537 4409160 : y = cgetg_copy(x, &lx); y[1] = x[1];
538 4409160 : for (i=2; i<lx; i++) gel(y,i) = mygprecrc(gel(x,i),prec,e);
539 4409160 : break;
540 :
541 2581237 : default: y = mygprecrc(x,prec,e);
542 : }
543 6990397 : return y;
544 : }
545 :
546 : /* normalize a polynomial p, that is change it with coefficients in Z[i],
547 : after making product by 2^shift */
548 : static GEN
549 1698256 : pol_to_gaussint(GEN p, long shift)
550 : {
551 1698256 : long i, l = lg(p);
552 1698256 : GEN q = cgetg(l, t_POL); q[1] = p[1];
553 1698256 : for (i=2; i<l; i++) gel(q,i) = gtrunc2n(gel(p,i), shift);
554 1698256 : return q;
555 : }
556 :
557 : /* returns a polynomial q in Z[i][x] keeping bit bits of p */
558 : static GEN
559 1324947 : eval_rel_pol(GEN p, long bit)
560 : {
561 : long i;
562 9034813 : for (i = 2; i < lg(p); i++)
563 7709866 : if (gequal0(gel(p,i))) gel(p,i) = gen_0; /* bad behavior of gexpo */
564 1324947 : return pol_to_gaussint(p, bit-gexpo(p)+1);
565 : }
566 :
567 : /* returns p(R*x)/R^n (in R or R[i]), R = exp(lrho), bit bits of precision */
568 : static GEN
569 150546 : homothetie(GEN p, double lrho, long bit)
570 : {
571 : GEN q, r, t, iR;
572 150546 : long n = degpol(p), i;
573 :
574 150546 : iR = mygprec(dblexp(-lrho),bit);
575 150546 : q = mygprec(p, bit);
576 150546 : r = cgetg(n+3,t_POL); r[1] = p[1];
577 150546 : t = iR; r[n+2] = q[n+2];
578 882974 : for (i=n-1; i>0; i--)
579 : {
580 732428 : gel(r,i+2) = gmul(t, gel(q,i+2));
581 732428 : t = mulrr(t, iR);
582 : }
583 150546 : gel(r,2) = gmul(t, gel(q,2)); return r;
584 : }
585 :
586 : /* change q in 2^(n*e) p(x*2^(-e)), n=deg(q) [ ~as above with R = 2^-e ]*/
587 : static void
588 929319 : homothetie2n(GEN p, long e)
589 : {
590 929319 : if (e)
591 : {
592 707734 : long i,n = lg(p)-1;
593 707734 : for (i=2; i<=n; i++) myshiftrc(gel(p,i), (n-i)*e);
594 : }
595 929319 : }
596 :
597 : /* return 2^f * 2^(n*e) p(x*2^(-e)), n=deg(q) */
598 : static void
599 3106283 : homothetie_gauss(GEN p, long e, long f)
600 : {
601 3106283 : if (e || f)
602 : {
603 2822509 : long i, n = lg(p)-1;
604 2822509 : for (i=2; i<=n; i++) gel(p,i) = myshiftic(gel(p,i), f+(n-i)*e);
605 : }
606 3106283 : }
607 :
608 : /* Lower bound on the modulus of the largest root z_0
609 : * k is set to an upper bound for #{z roots, |z-z_0| < eps} */
610 : static double
611 3479592 : lower_bound(GEN p, long *k, double eps)
612 : {
613 3479592 : long n = degpol(p), i, j;
614 3479592 : pari_sp ltop = avma;
615 : GEN a, s, S, ilc;
616 : double r, R, rho;
617 :
618 3479592 : if (n < 4) { *k = n; return 0.; }
619 1327119 : S = cgetg(5,t_VEC);
620 1327119 : a = cgetg(5,t_VEC); ilc = gdiv(real_1(DEFAULTPREC), gel(p,n+2));
621 1327119 : for (i=1; i<=4; i++) gel(a,i) = gmul(ilc,gel(p,n+2-i));
622 : /* i = 1 split out from next loop for efficiency and initialization */
623 1327119 : s = gel(a,1);
624 1327119 : gel(S,1) = gneg(s); /* Newton sum S_i */
625 1327119 : rho = r = gtodouble(gabs(s,3));
626 1327119 : R = r / n;
627 5308476 : for (i=2; i<=4; i++)
628 : {
629 3981357 : s = gmulsg(i,gel(a,i));
630 3981357 : for (j=1; j<i; j++) s = gadd(s, gmul(gel(S,j),gel(a,i-j)));
631 3981357 : gel(S,i) = gneg(s); /* Newton sum S_i */
632 3981357 : r = gtodouble(gabs(s,3));
633 3981357 : if (r > 0.)
634 : {
635 3973045 : r = exp(log(r/n) / (double)i);
636 3973045 : if (r > R) R = r;
637 : }
638 : }
639 1327119 : if (R > 0. && eps < 1.2)
640 1325879 : *k = (long)floor((rho/R + n) / (1 + exp(-eps)*cos(eps)));
641 : else
642 1240 : *k = n;
643 1327119 : avma = ltop; return R;
644 : }
645 :
646 : /* return R such that exp(R - tau) <= rho_n(P) <= exp(R + tau)
647 : * P(0) != 0 and P non constant */
648 : static double
649 373309 : logmax_modulus(GEN p, double tau)
650 : {
651 : GEN r, q, aux, gunr;
652 373309 : pari_sp av, ltop = avma;
653 373309 : long i,k,n=degpol(p),nn,bit,M,e;
654 373309 : double rho,eps, tau2 = (tau > 3.0)? 0.5: tau/6.;
655 :
656 373309 : r = cgeti(BIGDEFAULTPREC);
657 373309 : av = avma;
658 :
659 373309 : eps = - 1/log(1.5*tau2); /* > 0 */
660 373309 : bit = (long) ((double) n*log2(1./tau2)+3*log2((double) n))+1;
661 373309 : gunr = real_1_bit(bit+2*n);
662 373309 : aux = gdiv(gunr, gel(p,2+n));
663 373309 : q = RgX_Rg_mul(p, aux); gel(q,2+n) = gunr;
664 373309 : e = findpower(q);
665 373309 : homothetie2n(q,e);
666 373309 : affsi(e, r);
667 373309 : q = pol_to_gaussint(q, bit);
668 373309 : M = (long) (log2( log(4.*n) / (2*tau2) )) + 2;
669 373309 : nn = n;
670 373309 : for (i=0,e=0;;)
671 : { /* nn = deg(q) */
672 6585875 : rho = lower_bound(q, &k, eps);
673 3479592 : if (rho > exp2(-(double)e)) e = (long)-floor(log2(rho));
674 3479592 : affii(shifti(addis(r,e), 1), r);
675 3479592 : if (++i == M) break;
676 :
677 9318849 : bit = (long) ((double)k * log2(1./tau2) +
678 6212566 : (double)(nn-k)*log2(1./eps) + 3*log2((double)nn)) + 1;
679 3106283 : homothetie_gauss(q, e, bit-(long)floor(dbllog2(gel(q,2+nn))+0.5));
680 3106283 : nn -= RgX_valrem(q, &q);
681 3106283 : set_karasquare_limit(gexpo(q));
682 3106283 : q = gerepileupto(av, graeffe(q));
683 3106283 : tau2 *= 1.5; if (tau2 > 0.9) tau2 = 0.5;
684 3106283 : eps = -1/log(tau2); /* > 0 */
685 3106283 : e = findpower(q);
686 : }
687 373309 : if (!signe(r)) { avma = ltop; return 0.; }
688 350424 : r = itor(r, DEFAULTPREC); shiftr_inplace(r, -M);
689 350424 : avma = ltop; return -rtodbl(r) * M_LN2; /* -log(2) sum e_i 2^-i */
690 : }
691 :
692 : static GEN
693 12917 : RgX_normalize1(GEN x)
694 : {
695 12917 : long i, n = lg(x)-1;
696 : GEN y;
697 12945 : for (i = n; i > 1; i--)
698 12938 : if (!gequal0( gel(x,i) )) break;
699 12917 : if (i == n) return x;
700 28 : pari_warn(warner,"normalizing a polynomial with 0 leading term");
701 28 : if (i == 1) pari_err_ROOTS0("roots");
702 28 : y = cgetg(i+1, t_POL); y[1] = x[1];
703 28 : for (; i > 1; i--) gel(y,i) = gel(x,i);
704 28 : return y;
705 : }
706 :
707 : static GEN
708 5671 : polrootsbound_i(GEN P, double TAU)
709 : {
710 5671 : pari_sp av = avma;
711 : double d;
712 5671 : (void)RgX_valrem_inexact(P,&P);
713 5671 : P = RgX_normalize1(P);
714 5671 : switch(degpol(P))
715 : {
716 7 : case -1: pari_err_ROOTS0("roots");
717 63 : case 0: avma = av; return gen_0;
718 : }
719 5601 : d = logmax_modulus(P, TAU) + TAU;
720 : /* not dblexp: result differs on ARM emulator */
721 5601 : return gerepileuptoleaf(av, mpexp(dbltor(d)));
722 : }
723 : GEN
724 5678 : polrootsbound(GEN P, GEN tau)
725 : {
726 5678 : if (typ(P) != t_POL) pari_err_TYPE("polrootsbound",P);
727 5671 : checkvalidpol(P, "polrootsbound");
728 5671 : return polrootsbound_i(P, tau? gtodouble(tau): 0.01);
729 : }
730 :
731 : /* log of modulus of the smallest root of p, with relative error tau */
732 : static double
733 132134 : logmin_modulus(GEN p, double tau)
734 : {
735 132134 : pari_sp av = avma;
736 : double r;
737 :
738 132134 : if (gequal0(gel(p,2))) return -pariINFINITY;
739 132134 : r = - logmax_modulus(RgX_recip_shallow(p),tau);
740 132134 : avma = av; return r;
741 : }
742 :
743 : /* return the log of the k-th modulus (ascending order) of p, rel. error tau*/
744 : static double
745 60956 : logmodulus(GEN p, long k, double tau)
746 : {
747 : GEN q;
748 60956 : long i, kk = k, imax, n = degpol(p), nn, bit, e;
749 60956 : pari_sp av, ltop=avma;
750 60956 : double r, tau2 = tau/6;
751 :
752 60956 : bit = (long)(n * (2. + log2(3.*n/tau2)));
753 60956 : av = avma;
754 60956 : q = gprec_w(p, nbits2prec(bit));
755 60956 : q = RgX_gtofp_bit(q, bit);
756 60956 : e = newton_polygon(q,k);
757 60956 : r = (double)e;
758 60956 : homothetie2n(q,e);
759 60956 : imax = (long)(log2(3./tau) + log2(log(4.*n)))+1;
760 556010 : for (i=1; i<imax; i++)
761 : {
762 495054 : q = eval_rel_pol(q,bit);
763 495054 : kk -= RgX_valrem(q, &q);
764 495054 : nn = degpol(q);
765 :
766 495054 : set_karasquare_limit(bit);
767 495054 : q = gerepileupto(av, graeffe(q));
768 495054 : e = newton_polygon(q,kk);
769 495054 : r += e / exp2((double)i);
770 495054 : q = RgX_gtofp_bit(q, bit);
771 495054 : homothetie2n(q,e);
772 :
773 495054 : tau2 *= 1.5; if (tau2 > 1.) tau2 = 1.;
774 495054 : bit = 1 + (long)(nn*(2. + log2(3.*nn/tau2)));
775 : }
776 60956 : avma = ltop; return -r * M_LN2;
777 : }
778 :
779 : /* return the log of the k-th modulus r_k of p, rel. error tau, knowing that
780 : * rmin < r_k < rmax. This information helps because we may reduce precision
781 : * quicker */
782 : static double
783 60956 : logpre_modulus(GEN p, long k, double tau, double lrmin, double lrmax)
784 : {
785 : GEN q;
786 60956 : long n = degpol(p), i, imax, imax2, bit;
787 60956 : pari_sp ltop = avma, av;
788 60956 : double lrho, aux, tau2 = tau/6.;
789 :
790 60956 : aux = (lrmax - lrmin) / 2. + 4*tau2;
791 60956 : imax = (long) log2(log((double)n)/ aux);
792 60956 : if (imax <= 0) return logmodulus(p,k,tau);
793 :
794 59825 : lrho = (lrmin + lrmax) / 2;
795 59825 : av = avma;
796 59825 : bit = (long)(n*(2. + aux / M_LN2 - log2(tau2)));
797 59825 : q = homothetie(p, lrho, bit);
798 59825 : imax2 = (long)(log2(3./tau * log(4.*n))) + 1;
799 59825 : if (imax > imax2) imax = imax2;
800 :
801 182351 : for (i=0; i<imax; i++)
802 : {
803 122526 : q = eval_rel_pol(q,bit);
804 122526 : set_karasquare_limit(bit);
805 122526 : q = gerepileupto(av, graeffe(q));
806 122526 : aux = 2*aux + 2*tau2;
807 122526 : tau2 *= 1.5;
808 122526 : bit = (long)(n*(2. + aux / M_LN2 - log2(1-exp(-tau2))));
809 122526 : q = RgX_gtofp_bit(q, bit);
810 : }
811 59825 : aux = exp2((double)imax);
812 59825 : aux = logmodulus(q,k, aux*tau/3.) / aux;
813 59825 : avma = ltop; return lrho + aux;
814 : }
815 :
816 : static double
817 75534 : ind_maxlog2(GEN q)
818 : {
819 75534 : long i, k = -1;
820 75534 : double L = - pariINFINITY;
821 203920 : for (i=0; i<=degpol(q); i++)
822 : {
823 128386 : double d = dbllog2(gel(q,2+i));
824 128386 : if (d > L) { L = d; k = i; }
825 : }
826 75534 : return k;
827 : }
828 :
829 : /* Returns k such that r_k e^(-tau) < R < r_{k+1} e^tau.
830 : * Assume that l <= k <= n-l */
831 : static long
832 90721 : dual_modulus(GEN p, double lrho, double tau, long l)
833 : {
834 90721 : long i, imax, delta_k = 0, n = degpol(p), nn, v2, v, bit, ll = l;
835 90721 : double tau2 = tau * 7./8.;
836 90721 : pari_sp av = avma;
837 : GEN q;
838 :
839 90721 : bit = 6*n - 5*l + (long)(n*(-log2(tau2) + tau2 * 8./7.));
840 90721 : q = homothetie(p, lrho, bit);
841 90721 : imax = (long)(log(log(2.*n)/tau2)/log(7./4.)+1);
842 :
843 782901 : for (i=0; i<imax; i++)
844 : {
845 707367 : q = eval_rel_pol(q,bit); v2 = n - degpol(q);
846 707367 : v = RgX_valrem(q, &q);
847 707367 : ll -= maxss(v, v2); if (ll < 0) ll = 0;
848 :
849 707367 : nn = degpol(q); delta_k += v;
850 707367 : if (!nn) return delta_k;
851 :
852 692180 : set_karasquare_limit(bit);
853 692180 : q = gerepileupto(av, graeffe(q));
854 692180 : tau2 *= 7./4.;
855 692180 : bit = 6*nn - 5*ll + (long)(nn*(-log2(tau2) + tau2 * 8./7.));
856 : }
857 75534 : avma = av; return delta_k + (long)ind_maxlog2(q);
858 : }
859 :
860 : /********************************************************************/
861 : /** **/
862 : /** FACTORS THROUGH CIRCLE INTEGRATION **/
863 : /** **/
864 : /********************************************************************/
865 : /* l power of 2 */
866 : static void
867 2335032 : fft(GEN Omega, GEN p, GEN f, long step, long l)
868 : {
869 : pari_sp ltop;
870 : long i, l1, l2, l3, rapi, step4;
871 : GEN f1, f2, f3, f02, f13, g02, g13, ff;
872 :
873 2335032 : if (l == 2)
874 : {
875 1275800 : gel(f,0) = gadd(gel(p,0),gel(p,step));
876 1275800 : gel(f,1) = gsub(gel(p,0),gel(p,step)); return;
877 : }
878 1059232 : if (l == 4)
879 : {
880 602061 : f1 = gadd(gel(p,0), gel(p,step<<1));
881 602061 : f2 = gsub(gel(p,0), gel(p,step<<1));
882 602061 : f3 = gadd(gel(p,step),gel(p,3*step));
883 602061 : f02= gsub(gel(p,step),gel(p,3*step));
884 602061 : f02 = mulcxI(f02);
885 602061 : gel(f,0) = gadd(f1, f3);
886 602061 : gel(f,1) = gadd(f2, f02);
887 602061 : gel(f,2) = gsub(f1, f3);
888 602061 : gel(f,3) = gsub(f2, f02); return;
889 : }
890 :
891 457171 : ltop = avma;
892 457171 : l1 = l>>2; l2 = 2*l1; l3 = l1+l2; step4 = step<<2;
893 457171 : fft(Omega,p, f, step4,l1);
894 457171 : fft(Omega,p+step, f+l1,step4,l1);
895 457171 : fft(Omega,p+(step<<1),f+l2,step4,l1);
896 457171 : fft(Omega,p+3*step, f+l3,step4,l1);
897 :
898 457171 : ff = cgetg(l+1,t_VEC);
899 1845287 : for (i=0; i<l1; i++)
900 : {
901 1388116 : rapi = step*i;
902 1388116 : f1 = gmul(gel(Omega,rapi), gel(f,i+l1));
903 1388116 : f2 = gmul(gel(Omega,rapi<<1), gel(f,i+l2));
904 1388116 : f3 = gmul(gel(Omega,3*rapi), gel(f,i+l3));
905 :
906 1388116 : f02 = gadd(gel(f,i),f2);
907 1388116 : g02 = gsub(gel(f,i),f2);
908 1388116 : f13 = gadd(f1,f3);
909 1388116 : g13 = mulcxI(gsub(f1,f3));
910 :
911 1388116 : gel(ff,i+1) = gadd(f02, f13);
912 1388116 : gel(ff,i+l1+1) = gadd(g02, g13);
913 1388116 : gel(ff,i+l2+1) = gsub(f02, f13);
914 1388116 : gel(ff,i+l3+1) = gsub(g02, g13);
915 : }
916 457171 : ff = gerepilecopy(ltop,ff);
917 457171 : for (i=0; i<l; i++) f[i] = ff[i+1];
918 : }
919 :
920 : GEN
921 0 : FFTinit(long k, long prec)
922 : {
923 0 : if (k <= 0) pari_err_DOMAIN("FFTinit", "k", "<=", gen_0, stoi(k));
924 0 : return grootsof1(1L << k, prec);
925 : }
926 :
927 : GEN
928 0 : FFT(GEN x, GEN Omega)
929 : {
930 0 : long i, l = lg(Omega), n = lg(x);
931 : GEN y, z;
932 0 : if (!is_vec_t(typ(x))) pari_err_TYPE("FFT",x);
933 0 : if (typ(Omega) != t_VEC) pari_err_TYPE("FFT",Omega);
934 0 : if (n > l) pari_err_DIM("FFT");
935 :
936 0 : if (n < l) {
937 0 : z = cgetg(l, t_VECSMALL); /* cf stackdummy */
938 0 : for (i = 1; i < n; i++) z[i] = x[i];
939 0 : for ( ; i < l; i++) gel(z,i) = gen_0;
940 : }
941 0 : else z = x;
942 0 : y = cgetg(l, t_VEC);
943 0 : fft(Omega+1, z+1, y+1, 1, l-1);
944 0 : return y;
945 : }
946 :
947 : /* returns 1 if p has only real coefficients, 0 else */
948 : static int
949 81068 : isreal(GEN p)
950 : {
951 : long i;
952 450454 : for (i = lg(p)-1; i > 1; i--)
953 396991 : if (typ(gel(p,i)) == t_COMPLEX) return 0;
954 53463 : return 1;
955 : }
956 :
957 : /* x non complex */
958 : static GEN
959 54812 : abs_update_r(GEN x, double *mu) {
960 54812 : GEN y = gtofp(x, DEFAULTPREC);
961 54812 : double ly = mydbllogr(y); if (ly < *mu) *mu = ly;
962 54812 : setabssign(y); return y;
963 : }
964 : /* return |x|, low accuracy. Set *mu = min(log(y), *mu) */
965 : static GEN
966 1106500 : abs_update(GEN x, double *mu) {
967 : GEN y, xr, yr;
968 : double ly;
969 1106500 : if (typ(x) != t_COMPLEX) return abs_update_r(x, mu);
970 1055438 : xr = gel(x,1);
971 1055438 : yr = gel(x,2);
972 1055438 : if (gequal0(xr)) return abs_update_r(yr,mu);
973 1055312 : if (gequal0(yr)) return abs_update_r(xr,mu);
974 : /* have to treat 0 specially: 0E-10 + 1e-20 = 0E-10 */
975 1051688 : xr = gtofp(xr, DEFAULTPREC);
976 1051688 : yr = gtofp(yr, DEFAULTPREC);
977 1051688 : y = sqrtr(addrr(sqrr(xr), sqrr(yr)));
978 1051688 : ly = mydbllogr(y); if (ly < *mu) *mu = ly;
979 1051688 : return y;
980 : }
981 :
982 : static void
983 86775 : initdft(GEN *Omega, GEN *prim, long N, long Lmax, long bit)
984 : {
985 86775 : long prec = nbits2prec(bit);
986 86775 : *Omega = grootsof1(Lmax, prec) + 1;
987 86775 : *prim = rootsof1u_cx(N, prec);
988 86775 : }
989 :
990 : static void
991 42186 : parameters(GEN p, long *LMAX, double *mu, double *gamma,
992 : int polreal, double param, double param2)
993 : {
994 : GEN q, pc, Omega, A, RU, prim, g, TWO;
995 42186 : long n = degpol(p), bit, NN, K, i, j, Lmax;
996 42186 : pari_sp av2, av = avma;
997 :
998 42186 : bit = gexpo(p) + (long)param2+8;
999 42186 : Lmax = 4; while (Lmax <= n) Lmax <<= 1;
1000 42186 : NN = (long)(param*3.14)+1; if (NN < Lmax) NN = Lmax;
1001 42186 : K = NN/Lmax; if (K & 1) K++;
1002 42186 : NN = Lmax*K;
1003 42186 : if (polreal) K = K/2+1;
1004 :
1005 42186 : initdft(&Omega, &prim, NN, Lmax, bit);
1006 42186 : q = mygprec(p,bit) + 2;
1007 42186 : A = cgetg(Lmax+1,t_VEC); A++;
1008 42186 : pc= cgetg(Lmax+1,t_VEC); pc++;
1009 42186 : for (i=0; i <= n; i++) gel(pc,i)= gel(q,i);
1010 42186 : for ( ; i<Lmax; i++) gel(pc,i) = gen_0;
1011 :
1012 42186 : *mu = pariINFINITY;
1013 42186 : g = real_0_bit(-bit);
1014 42186 : TWO = real2n(1, DEFAULTPREC);
1015 42186 : av2 = avma;
1016 42186 : RU = gen_1;
1017 163442 : for (i=0; i<K; i++)
1018 : {
1019 121256 : if (i) {
1020 79070 : GEN z = RU;
1021 503266 : for (j=1; j<n; j++)
1022 : {
1023 424196 : gel(pc,j) = gmul(gel(q,j),z);
1024 424196 : z = gmul(z,RU); /* RU = prim^i, z=prim^(ij) */
1025 : }
1026 79070 : gel(pc,n) = gmul(gel(q,n),z);
1027 : }
1028 :
1029 121256 : fft(Omega,pc,A,1,Lmax);
1030 136738 : if (polreal && i>0 && i<K-1)
1031 15482 : for (j=0; j<Lmax; j++) g = addrr(g, divrr(TWO, abs_update(gel(A,j),mu)));
1032 : else
1033 105774 : for (j=0; j<Lmax; j++) g = addrr(g, invr(abs_update(gel(A,j),mu)));
1034 121256 : RU = gmul(RU, prim);
1035 121256 : if (gc_needed(av,1))
1036 : {
1037 0 : if(DEBUGMEM>1) pari_warn(warnmem,"parameters");
1038 0 : gerepileall(av2,2, &g,&RU);
1039 : }
1040 : }
1041 42186 : *gamma = mydbllog2r(divru(g,NN));
1042 42186 : *LMAX = Lmax; avma = av;
1043 42186 : }
1044 :
1045 : /* NN is a multiple of Lmax */
1046 : static void
1047 44589 : dft(GEN p, long k, long NN, long Lmax, long bit, GEN F, GEN H, long polreal)
1048 : {
1049 : GEN Omega, q, qd, pc, pd, A, B, C, RU, aux, U, W, prim, prim2;
1050 44589 : long n = degpol(p), i, j, K;
1051 : pari_sp ltop;
1052 :
1053 44589 : initdft(&Omega, &prim, NN, Lmax, bit);
1054 44589 : RU = cgetg(n+2,t_VEC) + 1;
1055 :
1056 44589 : K = NN/Lmax; if (polreal) K = K/2+1;
1057 44589 : q = mygprec(p,bit);
1058 44589 : qd = RgX_deriv(q);
1059 :
1060 44589 : A = cgetg(Lmax+1,t_VEC); A++;
1061 44589 : B = cgetg(Lmax+1,t_VEC); B++;
1062 44589 : C = cgetg(Lmax+1,t_VEC); C++;
1063 44589 : pc = cgetg(Lmax+1,t_VEC); pc++;
1064 44589 : pd = cgetg(Lmax+1,t_VEC); pd++;
1065 44589 : pc[0] = q[2]; for (i=n+1; i<Lmax; i++) gel(pc,i) = gen_0;
1066 44589 : pd[0] = qd[2]; for (i=n; i<Lmax; i++) gel(pd,i) = gen_0;
1067 :
1068 44589 : ltop = avma;
1069 44589 : W = cgetg(k+1,t_VEC);
1070 44589 : U = cgetg(k+1,t_VEC);
1071 44589 : for (i=1; i<=k; i++) gel(W,i) = gel(U,i) = gen_0;
1072 :
1073 44589 : gel(RU,0) = gen_1;
1074 44589 : prim2 = gen_1;
1075 140862 : for (i=0; i<K; i++)
1076 : {
1077 96273 : gel(RU,1) = prim2;
1078 96273 : for (j=1; j<n; j++) gel(RU,j+1) = gmul(gel(RU,j),prim2);
1079 : /* RU[j] = prim^(ij)= prim2^j */
1080 :
1081 96273 : for (j=1; j<n; j++) gel(pd,j) = gmul(gel(qd,j+2),gel(RU,j));
1082 96273 : fft(Omega,pd,A,1,Lmax);
1083 96273 : for (j=1; j<=n; j++) gel(pc,j) = gmul(gel(q,j+2),gel(RU,j));
1084 96273 : fft(Omega,pc,B,1,Lmax);
1085 96273 : for (j=0; j<Lmax; j++) gel(C,j) = ginv(gel(B,j));
1086 96273 : for (j=0; j<Lmax; j++) gel(B,j) = gmul(gel(A,j),gel(C,j));
1087 96273 : fft(Omega,B,A,1,Lmax);
1088 96273 : fft(Omega,C,B,1,Lmax);
1089 :
1090 96273 : if (polreal) /* p has real coefficients */
1091 : {
1092 67306 : if (i>0 && i<K-1)
1093 : {
1094 34517 : for (j=1; j<=k; j++)
1095 : {
1096 28624 : gel(W,j) = gadd(gel(W,j), gshift(mulreal(gel(A,j+1),gel(RU,j+1)),1));
1097 28624 : gel(U,j) = gadd(gel(U,j), gshift(mulreal(gel(B,j),gel(RU,j)),1));
1098 : }
1099 : }
1100 : else
1101 : {
1102 171562 : for (j=1; j<=k; j++)
1103 : {
1104 116042 : gel(W,j) = gadd(gel(W,j), mulreal(gel(A,j+1),gel(RU,j+1)));
1105 116042 : gel(U,j) = gadd(gel(U,j), mulreal(gel(B,j),gel(RU,j)));
1106 : }
1107 : }
1108 : }
1109 : else
1110 : {
1111 92771 : for (j=1; j<=k; j++)
1112 : {
1113 57911 : gel(W,j) = gadd(gel(W,j), gmul(gel(A,j+1),gel(RU,j+1)));
1114 57911 : gel(U,j) = gadd(gel(U,j), gmul(gel(B,j),gel(RU,j)));
1115 : }
1116 : }
1117 96273 : prim2 = gmul(prim2,prim);
1118 96273 : gerepileall(ltop,3, &W,&U,&prim2);
1119 : }
1120 :
1121 128579 : for (i=1; i<=k; i++)
1122 : {
1123 83990 : aux=gel(W,i);
1124 83990 : for (j=1; j<i; j++) aux = gadd(aux, gmul(gel(W,i-j),gel(F,k+2-j)));
1125 83990 : gel(F,k+2-i) = gdivgs(aux,-i*NN);
1126 : }
1127 128579 : for (i=0; i<k; i++)
1128 : {
1129 83990 : aux=gel(U,k-i);
1130 83990 : for (j=1+i; j<k; j++) aux = gadd(aux,gmul(gel(F,2+j),gel(U,j-i)));
1131 83990 : gel(H,i+2) = gdivgs(aux,NN);
1132 : }
1133 44589 : }
1134 :
1135 : #define NEWTON_MAX 10
1136 : static GEN
1137 237796 : refine_H(GEN F, GEN G, GEN HH, long bit, long Sbit)
1138 : {
1139 237796 : GEN H = HH, D, aux;
1140 237796 : pari_sp ltop = avma;
1141 : long error, i, bit1, bit2;
1142 :
1143 237796 : D = Rg_RgX_sub(gen_1, RgX_rem(RgX_mul(H,G),F)); error = gexpo(D);
1144 237796 : bit2 = bit + Sbit;
1145 445766 : for (i=0; error>-bit && i<NEWTON_MAX && error<=0; i++)
1146 : {
1147 207970 : if (gc_needed(ltop,1))
1148 : {
1149 0 : if(DEBUGMEM>1) pari_warn(warnmem,"refine_H");
1150 0 : gerepileall(ltop,2, &D,&H);
1151 : }
1152 207970 : bit1 = -error + Sbit;
1153 207970 : aux = RgX_mul(mygprec(H,bit1), mygprec(D,bit1));
1154 207970 : aux = RgX_rem(mygprec(aux,bit1), mygprec(F,bit1));
1155 :
1156 207970 : bit1 = -error*2 + Sbit; if (bit1 > bit2) bit1 = bit2;
1157 207970 : H = RgX_add(mygprec(H,bit1), aux);
1158 207970 : D = Rg_RgX_sub(gen_1, RgX_rem(RgX_mul(H,G),F));
1159 207970 : error = gexpo(D); if (error < -bit1) error = -bit1;
1160 : }
1161 237796 : if (error > -bit/2) return NULL; /* FAIL */
1162 237641 : return gerepilecopy(ltop,H);
1163 : }
1164 :
1165 : /* return 0 if fails, 1 else */
1166 : static long
1167 44589 : refine_F(GEN p, GEN *F, GEN *G, GEN H, long bit, double gamma)
1168 : {
1169 44589 : GEN f0, FF, GG, r, HH = H;
1170 44589 : long error, i, bit1 = 0, bit2, Sbit, Sbit2, enh, normF, normG, n = degpol(p);
1171 44589 : pari_sp av = avma;
1172 :
1173 44589 : FF = *F; GG = RgX_divrem(p, FF, &r);
1174 44589 : error = gexpo(r); if (error <= -bit) error = 1-bit;
1175 44589 : normF = gexpo(FF);
1176 44589 : normG = gexpo(GG);
1177 44589 : enh = gexpo(H); if (enh < 0) enh = 0;
1178 44589 : Sbit = normF + 2*normG + enh + (long)(4.*log2((double)n)+gamma) + 1;
1179 44589 : Sbit2 = enh + 2*(normF+normG) + (long)(2.*gamma+5.*log2((double)n)) + 1;
1180 44589 : bit2 = bit + Sbit;
1181 282230 : for (i=0; error>-bit && i<NEWTON_MAX && error<=0; i++)
1182 : {
1183 237796 : if (bit1 == bit2 && i >= 2) { Sbit += n; Sbit2 += n; bit2 += n; }
1184 237796 : if (gc_needed(av,1))
1185 : {
1186 0 : if(DEBUGMEM>1) pari_warn(warnmem,"refine_F");
1187 0 : gerepileall(av,4, &FF,&GG,&r,&HH);
1188 : }
1189 :
1190 237796 : bit1 = -error + Sbit2;
1191 237796 : HH = refine_H(mygprec(FF,bit1), mygprec(GG,bit1), mygprec(HH,bit1),
1192 : 1-error, Sbit2);
1193 237796 : if (!HH) return 0; /* FAIL */
1194 :
1195 237641 : bit1 = -error + Sbit;
1196 237641 : r = RgX_mul(mygprec(HH,bit1), mygprec(r,bit1));
1197 237641 : f0 = RgX_rem(mygprec(r,bit1), mygprec(FF,bit1));
1198 :
1199 237641 : bit1 = -2*error + Sbit; if (bit1 > bit2) bit1 = bit2;
1200 237641 : FF = gadd(mygprec(FF,bit1),f0);
1201 :
1202 237641 : bit1 = -3*error + Sbit; if (bit1 > bit2) bit1 = bit2;
1203 237641 : GG = RgX_divrem(mygprec(p,bit1), mygprec(FF,bit1), &r);
1204 237641 : error = gexpo(r); if (error < -bit1) error = -bit1;
1205 : }
1206 44434 : if (error>-bit) return 0; /* FAIL */
1207 42186 : *F = FF; *G = GG; return 1;
1208 : }
1209 :
1210 : /* returns F and G from the unit circle U such that |p-FG|<2^(-bit) |cd|,
1211 : where cd is the leading coefficient of p */
1212 : static void
1213 42186 : split_fromU(GEN p, long k, double delta, long bit,
1214 : GEN *F, GEN *G, double param, double param2)
1215 : {
1216 : GEN pp, FF, GG, H;
1217 42186 : long n = degpol(p), NN, bit2, Lmax;
1218 42186 : int polreal = isreal(p);
1219 : pari_sp ltop;
1220 : double mu, gamma;
1221 :
1222 42186 : pp = gdiv(p, gel(p,2+n));
1223 42186 : parameters(pp, &Lmax,&mu,&gamma, polreal,param,param2);
1224 :
1225 42186 : H = cgetg(k+2,t_POL); H[1] = p[1];
1226 42186 : FF = cgetg(k+3,t_POL); FF[1]= p[1];
1227 42186 : gel(FF,k+2) = gen_1;
1228 :
1229 42186 : NN = (long)(0.5/delta); NN |= 1; if (NN < 2) NN = 2;
1230 42186 : NN *= Lmax; ltop = avma;
1231 : for(;;)
1232 : {
1233 46992 : bit2 = (long)(((double)NN*delta-mu)/M_LN2) + gexpo(pp) + 8;
1234 44589 : dft(pp, k, NN, Lmax, bit2, FF, H, polreal);
1235 44589 : if (refine_F(pp,&FF,&GG,H,bit,gamma)) break;
1236 2403 : NN <<= 1; avma = ltop;
1237 : }
1238 42186 : *G = gmul(GG,gel(p,2+n)); *F = FF;
1239 42186 : }
1240 :
1241 : static void
1242 42186 : optimize_split(GEN p, long k, double delta, long bit,
1243 : GEN *F, GEN *G, double param, double param2)
1244 : {
1245 42186 : long n = degpol(p);
1246 : GEN FF, GG;
1247 :
1248 42186 : if (k <= n/2)
1249 31307 : split_fromU(p,k,delta,bit,F,G,param,param2);
1250 : else
1251 : {
1252 10879 : split_fromU(RgX_recip_shallow(p),n-k,delta,bit,&FF,&GG,param,param2);
1253 10879 : *F = RgX_recip_shallow(GG);
1254 10879 : *G = RgX_recip_shallow(FF);
1255 : }
1256 42186 : }
1257 :
1258 : /********************************************************************/
1259 : /** **/
1260 : /** SEARCH FOR SEPARATING CIRCLE **/
1261 : /** **/
1262 : /********************************************************************/
1263 :
1264 : /* return p(2^e*x) *2^(-n*e) */
1265 : static void
1266 0 : scalepol2n(GEN p, long e)
1267 : {
1268 0 : long i,n=lg(p)-1;
1269 0 : for (i=2; i<=n; i++) gel(p,i) = gmul2n(gel(p,i),(i-n)*e);
1270 0 : }
1271 :
1272 : /* returns p(x/R)*R^n */
1273 : static GEN
1274 359850 : scalepol(GEN p, GEN R, long bit)
1275 : {
1276 : GEN q,aux,gR;
1277 : long i;
1278 :
1279 359850 : aux = gR = mygprec(R,bit); q = mygprec(p,bit);
1280 1608012 : for (i=lg(p)-2; i>=2; i--)
1281 : {
1282 1248162 : gel(q,i) = gmul(aux,gel(q,i));
1283 1248162 : aux = gmul(aux,gR);
1284 : }
1285 359850 : return q;
1286 : }
1287 :
1288 : /* return (conj(a)X-1)^n * p[ (X-a) / (conj(a)X-1) ] */
1289 : static GEN
1290 116646 : conformal_pol(GEN p, GEN a)
1291 : {
1292 116646 : GEN z, r, ma = gneg(a), ca = conj_i(a);
1293 116646 : long n = degpol(p), i;
1294 116646 : pari_sp av = avma;
1295 :
1296 116646 : z = mkpoln(2, ca, gen_m1);
1297 116646 : r = scalarpol(gel(p,2+n), 0);
1298 395584 : for (i=n-1; ; i--)
1299 : {
1300 674522 : r = RgX_addmulXn_shallow(r, gmul(ma,r), 1); /* r *= (X - a) */
1301 395584 : r = gadd(r, gmul(z, gel(p,2+i)));
1302 512230 : if (i == 0) return gerepileupto(av, r);
1303 278938 : z = RgX_addmulXn_shallow(gmul(z,ca), gneg(z), 1); /* z *= conj(a)X - 1 */
1304 278938 : if (gc_needed(av,2))
1305 : {
1306 0 : if(DEBUGMEM>1) pari_warn(warnmem,"conformal_pol");
1307 0 : gerepileall(av,2, &r,&z);
1308 : }
1309 : }
1310 : }
1311 :
1312 : static const double UNDEF = -100000.;
1313 :
1314 : static double
1315 42186 : logradius(double *radii, GEN p, long k, double aux, double *delta)
1316 : {
1317 42186 : long i, n = degpol(p);
1318 : double lrho, lrmin, lrmax;
1319 42186 : if (k > 1)
1320 : {
1321 26455 : i = k-1; while (i>0 && radii[i] == UNDEF) i--;
1322 26455 : lrmin = logpre_modulus(p,k,aux, radii[i], radii[k]);
1323 : }
1324 : else /* k=1 */
1325 15731 : lrmin = logmin_modulus(p,aux);
1326 42186 : radii[k] = lrmin;
1327 :
1328 42186 : if (k+1<n)
1329 : {
1330 34501 : i = k+2; while (i<=n && radii[i] == UNDEF) i++;
1331 34501 : lrmax = logpre_modulus(p,k+1,aux, radii[k+1], radii[i]);
1332 : }
1333 : else /* k+1=n */
1334 7685 : lrmax = logmax_modulus(p,aux);
1335 42186 : radii[k+1] = lrmax;
1336 :
1337 42186 : lrho = radii[k];
1338 94657 : for (i=k-1; i>=1; i--)
1339 : {
1340 52471 : if (radii[i] == UNDEF || radii[i] > lrho)
1341 36488 : radii[i] = lrho;
1342 : else
1343 15983 : lrho = radii[i];
1344 : }
1345 42186 : lrho = radii[k+1];
1346 176026 : for (i=k+1; i<=n; i++)
1347 : {
1348 133840 : if (radii[i] == UNDEF || radii[i] < lrho)
1349 78263 : radii[i] = lrho;
1350 : else
1351 55577 : lrho = radii[i];
1352 : }
1353 42186 : *delta = (lrmax - lrmin) / 2;
1354 42186 : if (*delta > 1.) *delta = 1.;
1355 42186 : return (lrmin + lrmax) / 2;
1356 : }
1357 :
1358 : static void
1359 42186 : update_radius(long n, double *radii, double lrho, double *par, double *par2)
1360 : {
1361 42186 : double t, param = 0., param2 = 0.;
1362 : long i;
1363 270683 : for (i=1; i<=n; i++)
1364 : {
1365 228497 : radii[i] -= lrho;
1366 228497 : t = fabs(rtodbl( invr(subsr(1, dblexp(radii[i]))) ));
1367 228497 : param += t; if (t > 1.) param2 += log2(t);
1368 : }
1369 42186 : *par = param; *par2 = param2;
1370 42186 : }
1371 :
1372 : /* apply the conformal mapping then split from U */
1373 : static void
1374 38882 : conformal_mapping(double *radii, GEN ctr, GEN p, long k, long bit,
1375 : double aux, GEN *F,GEN *G)
1376 : {
1377 38882 : long bit2, n = degpol(p), i;
1378 38882 : pari_sp ltop = avma, av;
1379 : GEN q, FF, GG, a, R;
1380 : double lrho, delta, param, param2;
1381 : /* n * (2.*log2(2.732)+log2(1.5)) + 1 */
1382 38882 : bit2 = bit + (long)(n*3.4848775) + 1;
1383 38882 : a = sqrtr_abs( stor(3, 2*MEDDEFAULTPREC - 2) );
1384 38882 : a = divrs(a, -6);
1385 38882 : a = gmul(mygprec(a,bit2), mygprec(ctr,bit2)); /* a = -ctr/2sqrt(3) */
1386 :
1387 38882 : av = avma;
1388 38882 : q = conformal_pol(mygprec(p,bit2), a);
1389 236674 : for (i=1; i<=n; i++)
1390 197792 : if (radii[i] != UNDEF) /* update array radii */
1391 : {
1392 140527 : pari_sp av2 = avma;
1393 140527 : GEN t, r = dblexp(radii[i]), r2 = sqrr(r);
1394 : /* 2(r^2 - 1) / (r^2 - 3(r-1)) */
1395 140527 : t = divrr(shiftr((subrs(r2,1)),1), subrr(r2, mulur(3,subrs(r,1))));
1396 140527 : radii[i] = mydbllogr(addsr(1,t)) / 2;
1397 140527 : avma = av2;
1398 : }
1399 38882 : lrho = logradius(radii, q,k,aux/10., &delta);
1400 38882 : update_radius(n, radii, lrho, ¶m, ¶m2);
1401 :
1402 38882 : bit2 += (long)(n * fabs(lrho)/M_LN2 + 1.);
1403 38882 : R = mygprec(dblexp(-lrho), bit2);
1404 38882 : q = scalepol(q,R,bit2);
1405 38882 : gerepileall(av,2, &q,&R);
1406 :
1407 38882 : optimize_split(q,k,delta,bit2,&FF,&GG,param,param2);
1408 38882 : bit2 += n; R = invr(R);
1409 38882 : FF = scalepol(FF,R,bit2);
1410 38882 : GG = scalepol(GG,R,bit2);
1411 :
1412 38882 : a = mygprec(a,bit2);
1413 38882 : FF = conformal_pol(FF,a);
1414 38882 : GG = conformal_pol(GG,a);
1415 :
1416 38882 : a = invr(subsr(1, gnorm(a)));
1417 38882 : FF = RgX_Rg_mul(FF, powru(a,k));
1418 38882 : GG = RgX_Rg_mul(GG, powru(a,n-k));
1419 :
1420 38882 : *F = mygprec(FF,bit+n);
1421 38882 : *G = mygprec(GG,bit+n); gerepileall(ltop,2, F,G);
1422 38882 : }
1423 :
1424 : /* split p, this time without scaling. returns in F and G two polynomials
1425 : * such that |p-FG|< 2^(-bit)|p| */
1426 : static void
1427 42186 : split_2(GEN p, long bit, GEN ctr, double thickness, GEN *F, GEN *G)
1428 : {
1429 : GEN q, FF, GG, R;
1430 : double aux, delta, param, param2;
1431 42186 : long n = degpol(p), i, j, k, bit2;
1432 : double lrmin, lrmax, lrho, *radii;
1433 :
1434 42186 : radii = (double*) stack_malloc_align((n+1) * sizeof(double), sizeof(double));
1435 :
1436 42186 : for (i=2; i<n; i++) radii[i] = UNDEF;
1437 42186 : aux = thickness/(double)(4 * n);
1438 42186 : lrmin = logmin_modulus(p, aux);
1439 42186 : lrmax = logmax_modulus(p, aux);
1440 42186 : radii[1] = lrmin;
1441 42186 : radii[n] = lrmax;
1442 42186 : i = 1; j = n;
1443 42186 : lrho = (lrmin + lrmax) / 2;
1444 42186 : k = dual_modulus(p, lrho, aux, 1);
1445 42186 : if (5*k < n || (n < 2*k && 5*k < 4*n))
1446 8742 : { lrmax = lrho; j=k+1; radii[j] = lrho; }
1447 : else
1448 33444 : { lrmin = lrho; i=k; radii[i] = lrho; }
1449 132907 : while (j > i+1)
1450 : {
1451 48535 : if (i+j == n+1)
1452 22163 : lrho = (lrmin + lrmax) / 2;
1453 : else
1454 : {
1455 26372 : double kappa = 2. - log(1. + minss(i,n-j)) / log(1. + minss(j,n-i));
1456 26372 : if (i+j < n+1) lrho = lrmax * kappa + lrmin;
1457 19631 : else lrho = lrmin * kappa + lrmax;
1458 26372 : lrho /= 1+kappa;
1459 : }
1460 48535 : aux = (lrmax - lrmin) / (4*(j-i));
1461 48535 : k = dual_modulus(p, lrho, aux, minss(i,n+1-j));
1462 48535 : if (k-i < j-k-1 || (k-i == j-k-1 && 2*k > n))
1463 33211 : { lrmax = lrho; j=k+1; radii[j] = lrho - aux; }
1464 : else
1465 15324 : { lrmin = lrho; i=k; radii[i] = lrho + aux; }
1466 : }
1467 42186 : aux = lrmax - lrmin;
1468 :
1469 42186 : if (ctr)
1470 : {
1471 38882 : lrho = (lrmax + lrmin) / 2;
1472 236674 : for (i=1; i<=n; i++)
1473 197792 : if (radii[i] != UNDEF) radii[i] -= lrho;
1474 :
1475 38882 : bit2 = bit + (long)(n * fabs(lrho)/M_LN2 + 1.);
1476 38882 : R = mygprec(dblexp(-lrho), bit2);
1477 38882 : q = scalepol(p,R,bit2);
1478 38882 : conformal_mapping(radii, ctr, q, k, bit2, aux, &FF, &GG);
1479 : }
1480 : else
1481 : {
1482 3304 : lrho = logradius(radii, p, k, aux/10., &delta);
1483 3304 : update_radius(n, radii, lrho, ¶m, ¶m2);
1484 :
1485 3304 : bit2 = bit + (long)(n * fabs(lrho)/M_LN2 + 1.);
1486 3304 : R = mygprec(dblexp(-lrho), bit2);
1487 3304 : q = scalepol(p,R,bit2);
1488 3304 : optimize_split(q, k, delta, bit2, &FF, &GG, param, param2);
1489 : }
1490 42186 : bit += n;
1491 42186 : bit2 += n; R = invr(mygprec(R,bit2));
1492 42186 : *F = mygprec(scalepol(FF,R,bit2), bit);
1493 42186 : *G = mygprec(scalepol(GG,R,bit2), bit);
1494 42186 : }
1495 :
1496 : /* procedure corresponding to steps 5,6,.. page 44 in RR n. 1852 */
1497 : /* put in F and G two polynomial such that |p-FG|<2^(-bit)|p|
1498 : * where the maximum modulus of the roots of p is <=1.
1499 : * Assume sum of roots is 0. */
1500 : static void
1501 38882 : split_1(GEN p, long bit, GEN *F, GEN *G)
1502 : {
1503 38882 : long i, imax, n = degpol(p), polreal = isreal(p), ep = gexpo(p), bit2 = bit+n;
1504 : GEN ctr, q, qq, FF, GG, v, gr, r, newq;
1505 : double lrmin, lrmax, lthick;
1506 38882 : const double LOG3 = 1.098613;
1507 :
1508 38882 : lrmax = logmax_modulus(p, 0.01);
1509 38882 : gr = mygprec(dblexp(-lrmax), bit2);
1510 38882 : q = scalepol(p,gr,bit2);
1511 :
1512 38882 : bit2 = bit + gexpo(q) - ep + (long)((double)n*2.*log2(3.)+1);
1513 38882 : v = cgetg(5,t_VEC);
1514 38882 : gel(v,1) = gen_2;
1515 38882 : gel(v,2) = gen_m2;
1516 38882 : gel(v,3) = mkcomplex(gen_0, gel(v,1));
1517 38882 : gel(v,4) = mkcomplex(gen_0, gel(v,2));
1518 38882 : q = mygprec(q,bit2); lthick = 0;
1519 38882 : newq = ctr = NULL; /* -Wall */
1520 38882 : imax = polreal? 3: 4;
1521 75589 : for (i=1; i<=imax; i++)
1522 : {
1523 74217 : qq = RgX_translate(q, gel(v,i));
1524 74217 : lrmin = logmin_modulus(qq,0.05);
1525 74217 : if (LOG3 > lrmin + lthick)
1526 : {
1527 72134 : double lquo = logmax_modulus(qq,0.05) - lrmin;
1528 72134 : if (lquo > lthick) { lthick = lquo; newq = qq; ctr = gel(v,i); }
1529 : }
1530 74217 : if (lthick > M_LN2) break;
1531 41830 : if (polreal && i==2 && lthick > LOG3 - M_LN2) break;
1532 : }
1533 38882 : bit2 = bit + gexpo(newq) - ep + (long)(n*LOG3/M_LN2 + 1);
1534 38882 : split_2(newq, bit2, ctr, lthick, &FF, &GG);
1535 38882 : r = gneg(mygprec(ctr,bit2));
1536 38882 : FF = RgX_translate(FF,r);
1537 38882 : GG = RgX_translate(GG,r);
1538 :
1539 38882 : gr = invr(gr); bit2 = bit - ep + gexpo(FF)+gexpo(GG);
1540 38882 : *F = scalepol(FF,gr,bit2);
1541 38882 : *G = scalepol(GG,gr,bit2);
1542 38882 : }
1543 :
1544 : /* put in F and G two polynomials such that |P-FG|<2^(-bit)|P|,
1545 : where the maximum modulus of the roots of p is < 0.5 */
1546 : static int
1547 39017 : split_0_2(GEN p, long bit, GEN *F, GEN *G)
1548 : {
1549 : GEN q, b;
1550 39017 : long n = degpol(p), k, bit2, eq;
1551 39017 : double aux0 = dbllog2(gel(p,n+2)); /* != -oo */
1552 39017 : double aux1 = dbllog2(gel(p,n+1)), aux;
1553 :
1554 39017 : if (aux1 == -pariINFINITY) /* p1 = 0 */
1555 1048 : aux = 0;
1556 : else
1557 : {
1558 37969 : aux = aux1 - aux0; /* log2(p1/p0) */
1559 : /* beware double overflow */
1560 37969 : if (aux >= 0 && (aux > 1e4 || exp2(aux) > 2.5*n)) return 0;
1561 37969 : aux = (aux < -300)? 0.: n*log2(1 + exp2(aux)/(double)n);
1562 : }
1563 39017 : bit2 = bit+1 + (long)(log2((double)n) + aux);
1564 39017 : q = mygprec(p,bit2);
1565 39017 : if (aux1 == -pariINFINITY) b = NULL;
1566 : else
1567 : {
1568 37969 : b = gdivgs(gdiv(gel(q,n+1),gel(q,n+2)),-n);
1569 37969 : q = RgX_translate(q,b);
1570 : }
1571 39017 : gel(q,n+1) = gen_0; eq = gexpo(q);
1572 39017 : k = 0;
1573 78399 : while (k <= n/2 && (- gexpo(gel(q,k+2)) > bit2 + 2*(n-k) + eq
1574 39260 : || gequal0(gel(q,k+2)))) k++;
1575 39017 : if (k > 0)
1576 : {
1577 135 : if (k > n/2) k = n/2;
1578 135 : bit2 += k<<1;
1579 135 : *F = pol_xn(k, 0);
1580 135 : *G = RgX_shift_shallow(q, -k);
1581 : }
1582 : else
1583 : {
1584 38882 : split_1(q,bit2,F,G);
1585 38882 : bit2 = bit + gexpo(*F) + gexpo(*G) - gexpo(p) + (long)aux+1;
1586 38882 : *F = mygprec(*F,bit2);
1587 : }
1588 39017 : *G = mygprec(*G,bit2);
1589 39017 : if (b)
1590 : {
1591 37969 : GEN mb = mygprec(gneg(b), bit2);
1592 37969 : *F = RgX_translate(*F, mb);
1593 37969 : *G = RgX_translate(*G, mb);
1594 : }
1595 39017 : return 1;
1596 : }
1597 :
1598 : /* put in F and G two polynomials such that |P-FG|<2^(-bit)|P|.
1599 : * Assume max_modulus(p) < 2 */
1600 : static void
1601 39017 : split_0_1(GEN p, long bit, GEN *F, GEN *G)
1602 : {
1603 : GEN FF, GG;
1604 : long n, bit2, normp;
1605 :
1606 39017 : if (split_0_2(p,bit,F,G)) return;
1607 :
1608 0 : normp = gexpo(p);
1609 0 : scalepol2n(p,2); /* p := 4^(-n) p(4*x) */
1610 0 : n = degpol(p); bit2 = bit + 2*n + gexpo(p) - normp;
1611 0 : split_1(mygprec(p,bit2), bit2,&FF,&GG);
1612 0 : scalepol2n(FF,-2);
1613 0 : scalepol2n(GG,-2); bit2 = bit + gexpo(FF) + gexpo(GG) - normp;
1614 0 : *F = mygprec(FF,bit2);
1615 0 : *G = mygprec(GG,bit2);
1616 : }
1617 :
1618 : /* put in F and G two polynomials such that |P-FG|<2^(-bit)|P| */
1619 : static void
1620 42321 : split_0(GEN p, long bit, GEN *F, GEN *G)
1621 : {
1622 42321 : const double LOG1_9 = 0.6418539;
1623 42321 : long n = degpol(p), k = 0;
1624 : GEN q;
1625 :
1626 42321 : while (gexpo(gel(p,k+2)) < -bit && k <= n/2) k++;
1627 42321 : if (k > 0)
1628 : {
1629 0 : if (k > n/2) k = n/2;
1630 0 : *F = pol_xn(k, 0);
1631 0 : *G = RgX_shift_shallow(p, -k);
1632 : }
1633 : else
1634 : {
1635 42321 : double lr = logmax_modulus(p, 0.05);
1636 42321 : if (lr < LOG1_9) split_0_1(p, bit, F, G);
1637 : else
1638 : {
1639 32366 : q = RgX_recip_shallow(p);
1640 32366 : lr = logmax_modulus(q,0.05);
1641 32366 : if (lr < LOG1_9)
1642 : {
1643 29062 : split_0_1(q, bit, F, G);
1644 29062 : *F = RgX_recip_shallow(*F);
1645 29062 : *G = RgX_recip_shallow(*G);
1646 : }
1647 : else
1648 3304 : split_2(p,bit,NULL, 1.2837,F,G);
1649 : }
1650 : }
1651 42321 : }
1652 :
1653 : /********************************************************************/
1654 : /** **/
1655 : /** ERROR ESTIMATE FOR THE ROOTS **/
1656 : /** **/
1657 : /********************************************************************/
1658 :
1659 : static GEN
1660 162244 : root_error(long n, long k, GEN roots_pol, long err, GEN shatzle)
1661 : {
1662 162244 : GEN rho, d, eps, epsbis, eps2, aux, rap = NULL;
1663 : long i, j;
1664 :
1665 162244 : d = cgetg(n+1,t_VEC);
1666 1779926 : for (i=1; i<=n; i++)
1667 : {
1668 1617682 : if (i!=k)
1669 : {
1670 1455438 : aux = gsub(gel(roots_pol,i), gel(roots_pol,k));
1671 1455438 : gel(d,i) = gabs(mygprec(aux,31), DEFAULTPREC);
1672 : }
1673 : }
1674 162244 : rho = gabs(mygprec(gel(roots_pol,k),31), DEFAULTPREC);
1675 162244 : if (expo(rho) < 0) rho = real_1(DEFAULTPREC);
1676 162244 : eps = mulrr(rho, shatzle);
1677 162244 : aux = shiftr(powru(rho,n), err);
1678 :
1679 503763 : for (j=1; j<=2 || (j<=5 && cmprr(rap, dbltor(1.2)) > 0); j++)
1680 : {
1681 341519 : GEN prod = NULL; /* 1. */
1682 341519 : long m = n;
1683 341519 : epsbis = mulrr(eps, dbltor(1.25));
1684 4257651 : for (i=1; i<=n; i++)
1685 : {
1686 3916132 : if (i != k && cmprr(gel(d,i),epsbis) > 0)
1687 : {
1688 3543579 : GEN dif = subrr(gel(d,i),eps);
1689 3543579 : prod = prod? mulrr(prod, dif): dif;
1690 3543579 : m--;
1691 : }
1692 : }
1693 341519 : eps2 = prod? divrr(aux, prod): aux;
1694 341519 : if (m > 1) eps2 = sqrtnr(shiftr(eps2, 2*m-2), m);
1695 341519 : rap = divrr(eps,eps2); eps = eps2;
1696 : }
1697 162244 : return eps;
1698 : }
1699 :
1700 : /* round a complex or real number x to an absolute value of 2^(-bit) */
1701 : static GEN
1702 392004 : mygprec_absolute(GEN x, long bit)
1703 : {
1704 : long e;
1705 : GEN y;
1706 :
1707 392004 : switch(typ(x))
1708 : {
1709 : case t_REAL:
1710 258182 : e = expo(x) + bit;
1711 258182 : return (e <= 0 || !signe(x))? real_0_bit(-bit): rtor(x, nbits2prec(e));
1712 : case t_COMPLEX:
1713 116694 : if (gexpo(gel(x,2)) < -bit) return mygprec_absolute(gel(x,1),bit);
1714 113066 : y = cgetg(3,t_COMPLEX);
1715 113066 : gel(y,1) = mygprec_absolute(gel(x,1),bit);
1716 113066 : gel(y,2) = mygprec_absolute(gel(x,2),bit);
1717 113066 : return y;
1718 17128 : default: return x;
1719 : }
1720 : }
1721 :
1722 : static long
1723 38448 : a_posteriori_errors(GEN p, GEN roots_pol, long err)
1724 : {
1725 38448 : long i, n = degpol(p), e_max = -(long)EXPOBITS;
1726 : GEN sigma, shatzle;
1727 :
1728 38448 : err += (long)log2((double)n) + 1;
1729 38448 : if (err > -2) return 0;
1730 38448 : sigma = real2n(-err, LOWDEFAULTPREC);
1731 : /* 2 / ((s - 1)^(1/n) - 1) */
1732 38448 : shatzle = divur(2, subrs(sqrtnr(subrs(sigma,1),n), 1));
1733 200692 : for (i=1; i<=n; i++)
1734 : {
1735 162244 : pari_sp av = avma;
1736 162244 : GEN x = root_error(n,i,roots_pol,err,shatzle);
1737 162244 : long e = gexpo(x);
1738 162244 : avma = av; if (e > e_max) e_max = e;
1739 162244 : gel(roots_pol,i) = mygprec_absolute(gel(roots_pol,i), -e);
1740 : }
1741 38448 : return e_max;
1742 : }
1743 :
1744 : /********************************************************************/
1745 : /** **/
1746 : /** MAIN **/
1747 : /** **/
1748 : /********************************************************************/
1749 : static GEN
1750 129532 : append_clone(GEN r, GEN a) { a = gclone(a); vectrunc_append(r, a); return a; }
1751 :
1752 : /* put roots in placeholder roots_pol so that |P - L_1...L_n| < 2^(-bit)|P|
1753 : * returns prod (x-roots_pol[i]) */
1754 : static GEN
1755 123090 : split_complete(GEN p, long bit, GEN roots_pol)
1756 : {
1757 123090 : long n = degpol(p);
1758 : pari_sp ltop;
1759 : GEN p1, F, G, a, b, m1, m2;
1760 :
1761 123090 : if (n == 1)
1762 : {
1763 32006 : a = gneg_i(gdiv(gel(p,2), gel(p,3)));
1764 32006 : (void)append_clone(roots_pol,a); return p;
1765 : }
1766 91084 : ltop = avma;
1767 91084 : if (n == 2)
1768 : {
1769 48763 : F = gsub(gsqr(gel(p,3)), gmul2n(gmul(gel(p,2),gel(p,4)), 2));
1770 48763 : F = gsqrt(F, nbits2prec(bit));
1771 48763 : p1 = ginv(gmul2n(gel(p,4),1));
1772 48763 : a = gneg_i(gmul(gadd(F,gel(p,3)), p1));
1773 48763 : b = gmul(gsub(F,gel(p,3)), p1);
1774 48763 : a = append_clone(roots_pol,a);
1775 48763 : b = append_clone(roots_pol,b); avma = ltop;
1776 48763 : a = mygprec(a, 3*bit);
1777 48763 : b = mygprec(b, 3*bit);
1778 48763 : return gmul(gel(p,4), mkpoln(3, gen_1, gneg(gadd(a,b)), gmul(a,b)));
1779 : }
1780 42321 : split_0(p,bit,&F,&G);
1781 42321 : m1 = split_complete(F,bit,roots_pol);
1782 42321 : m2 = split_complete(G,bit,roots_pol);
1783 42321 : return gerepileupto(ltop, gmul(m1,m2));
1784 : }
1785 :
1786 : static GEN
1787 541237 : quicktofp(GEN x)
1788 : {
1789 541237 : const long prec = DEFAULTPREC;
1790 541237 : switch(typ(x))
1791 : {
1792 522963 : case t_INT: return itor(x, prec);
1793 7156 : case t_REAL: return rtor(x, prec);
1794 0 : case t_FRAC: return fractor(x, prec);
1795 : case t_COMPLEX: {
1796 11118 : GEN a = gel(x,1), b = gel(x,2);
1797 : /* avoid problem with 0, e.g. x = 0 + I*1e-100. We don't want |x| = 0. */
1798 11118 : if (isintzero(a)) return cxcompotor(b, prec);
1799 11076 : if (isintzero(b)) return cxcompotor(a, prec);
1800 11076 : a = cxcompotor(a, prec);
1801 11076 : b = cxcompotor(b, prec); return sqrtr(addrr(sqrr(a), sqrr(b)));
1802 : }
1803 0 : default: pari_err_TYPE("quicktofp",x);
1804 : return NULL;/*LCOV_EXCL_LINE*/
1805 : }
1806 :
1807 : }
1808 :
1809 : /* bound log_2 |largest root of p| (Fujiwara's bound) */
1810 : double
1811 130731 : fujiwara_bound(GEN p)
1812 : {
1813 130731 : pari_sp av = avma;
1814 130731 : long i, n = degpol(p);
1815 : GEN cc;
1816 : double loglc, Lmax;
1817 :
1818 130731 : if (n <= 0) pari_err_CONSTPOL("fujiwara_bound");
1819 130731 : loglc = mydbllog2r( quicktofp(gel(p,n+2)) ); /* log_2 |lc(p)| */
1820 130731 : cc = gel(p, 2);
1821 130731 : if (gequal0(cc))
1822 17857 : Lmax = -pariINFINITY-1;
1823 : else
1824 112874 : Lmax = (mydbllog2r(quicktofp(cc)) - loglc - 1) / n;
1825 518027 : for (i = 1; i < n; i++)
1826 : {
1827 387296 : GEN y = gel(p,i+2);
1828 : double L;
1829 387296 : if (gequal0(y)) continue;
1830 297632 : L = (mydbllog2r(quicktofp(y)) - loglc) / (n-i);
1831 297632 : if (L > Lmax) Lmax = L;
1832 : }
1833 130731 : avma = av; return Lmax + 1;
1834 : }
1835 :
1836 : /* Fujiwara's bound, real roots. Based on the following remark: if
1837 : * p = x^n + sum a_i x^i and q = x^n + sum min(a_i,0)x^i
1838 : * then for all x >= 0, p(x) >= q(x). Thus any bound for the (positive) roots
1839 : * of q is a bound for the positive roots of p. */
1840 : double
1841 25666 : fujiwara_bound_real(GEN p, long sign)
1842 : {
1843 25666 : pari_sp av = avma;
1844 : GEN x;
1845 25666 : long n = degpol(p), i, signodd, signeven;
1846 : double fb;
1847 25666 : if (n <= 0) pari_err_CONSTPOL("fujiwara_bound");
1848 25666 : x = shallowcopy(p);
1849 25666 : if (gsigne(gel(x, n+2)) > 0)
1850 : {
1851 25666 : signeven = 1;
1852 25666 : signodd = sign;
1853 : }
1854 : else
1855 : {
1856 0 : signeven = -1;
1857 0 : signodd = -sign;
1858 : }
1859 124855 : for (i = 0; i < n; i++)
1860 : {
1861 99189 : if ((n - i) % 2)
1862 : {
1863 51963 : if (gsigne(gel(x, i+2)) == signodd ) gel(x, i+2) = gen_0;
1864 : }
1865 : else
1866 : {
1867 47226 : if (gsigne(gel(x, i+2)) == signeven) gel(x, i+2) = gen_0;
1868 : }
1869 : }
1870 25666 : fb = fujiwara_bound(x);
1871 25666 : avma = av; return fb;
1872 : }
1873 :
1874 : static GEN
1875 224322 : mygprecrc_special(GEN x, long prec, long e)
1876 : {
1877 : GEN y;
1878 224322 : switch(typ(x))
1879 : {
1880 : case t_REAL:
1881 31329 : if (!signe(x)) return real_0_bit(minss(e, expo(x)));
1882 28844 : return (prec > realprec(x))? rtor(x, prec): x;
1883 : case t_COMPLEX:
1884 11815 : y = cgetg(3,t_COMPLEX);
1885 11815 : gel(y,1) = mygprecrc_special(gel(x,1),prec,e);
1886 11815 : gel(y,2) = mygprecrc_special(gel(x,2),prec,e);
1887 11815 : return y;
1888 181178 : default: return x;
1889 : }
1890 : }
1891 :
1892 : /* like mygprec but keep at least the same precision as before */
1893 : static GEN
1894 38448 : mygprec_special(GEN x, long bit)
1895 : {
1896 : long lx, i, e, prec;
1897 : GEN y;
1898 :
1899 38448 : if (bit < 0) bit = 0; /* should not happen */
1900 38448 : e = gexpo(x) - bit;
1901 38448 : prec = nbits2prec(bit);
1902 38448 : switch(typ(x))
1903 : {
1904 : case t_POL:
1905 38448 : y = cgetg_copy(x, &lx); y[1] = x[1];
1906 38448 : for (i=2; i<lx; i++) gel(y,i) = mygprecrc_special(gel(x,i),prec,e);
1907 38448 : break;
1908 :
1909 0 : default: y = mygprecrc_special(x,prec,e);
1910 : }
1911 38448 : return y;
1912 : }
1913 :
1914 : static GEN
1915 25841 : fix_roots1(GEN r)
1916 : {
1917 25841 : long i, l = lg(r);
1918 25841 : GEN allr = cgetg(l, t_VEC);
1919 130435 : for (i=1; i<l; i++)
1920 : {
1921 104594 : GEN t = gel(r,i);
1922 104594 : gel(allr,i) = gcopy(t); gunclone(t);
1923 : }
1924 25841 : return allr;
1925 : }
1926 : static GEN
1927 38448 : fix_roots(GEN r, GEN *m, long h, long bit)
1928 : {
1929 : long i, j, k, l, prec;
1930 : GEN allr, ro1;
1931 38448 : if (h == 1) return fix_roots1(r);
1932 12607 : prec = nbits2prec(bit);
1933 12607 : ro1 = grootsof1(h, prec) + 1;
1934 12607 : l = lg(r)-1;
1935 12607 : allr = cgetg(h*l+1, t_VEC);
1936 37545 : for (k=1,i=1; i<=l; i++)
1937 : {
1938 24938 : GEN p2, p1 = gel(r,i);
1939 24938 : p2 = (h == 2)? gsqrt(p1, prec): gsqrtn(p1, utoipos(h), NULL, prec);
1940 24938 : for (j=0; j<h; j++) gel(allr,k++) = gmul(p2, gel(ro1,j));
1941 24938 : gunclone(p1);
1942 : }
1943 12607 : *m = roots_to_pol(allr, 0);
1944 12607 : return allr;
1945 : }
1946 :
1947 : static GEN
1948 37910 : all_roots(GEN p, long bit)
1949 : {
1950 : GEN lc, pd, q, roots_pol, m;
1951 37910 : long bit0, bit2, i, e, h, n = degpol(p);
1952 : double fb;
1953 : pari_sp av;
1954 :
1955 37910 : pd = RgX_deflate_max(p, &h); lc = leading_coeff(pd);
1956 37910 : fb = fujiwara_bound(pd);
1957 37910 : e = (fb < 0)? 0: (long)(2 * fb);
1958 37910 : bit0 = bit + gexpo(pd) - gexpo(lc) + (long)log2(n/h)+1+e;
1959 37910 : bit2 = bit0; e = 0;
1960 38448 : for (av=avma,i=1;; i++,avma=av)
1961 : {
1962 38986 : roots_pol = vectrunc_init(n+1);
1963 38448 : bit2 += e + (n << i);
1964 38448 : q = RgX_gtofp_bit(mygprec(pd,bit2), bit2);
1965 38448 : q[1] = evalsigne(1)|evalvarn(0);
1966 38448 : m = split_complete(q,bit2,roots_pol);
1967 38448 : roots_pol = fix_roots(roots_pol, &m, h, bit2);
1968 38448 : q = mygprec_special(p,bit2); lc = leading_coeff(q);
1969 38448 : q[1] = evalsigne(1)|evalvarn(0);
1970 38448 : if (h > 1) m = gmul(m,lc);
1971 :
1972 38448 : e = gexpo(gsub(q, m)) - gexpo(lc) + (long)log2((double)n) + 1;
1973 38448 : if (e < -2*bit2) e = -2*bit2; /* avoid e = -pariINFINITY */
1974 38448 : if (e < 0)
1975 : {
1976 38448 : e = bit + a_posteriori_errors(p,roots_pol,e);
1977 76358 : if (e < 0) return roots_pol;
1978 : }
1979 538 : if (DEBUGLEVEL > 7)
1980 0 : err_printf("all_roots: restarting, i = %ld, e = %ld\n", i,e);
1981 : }
1982 : }
1983 :
1984 : INLINE int
1985 12185 : isexactscalar(GEN x) { long tx = typ(x); return is_rational_t(tx); }
1986 :
1987 : static int
1988 8332 : isexactpol(GEN p)
1989 : {
1990 8332 : long i,n = degpol(p);
1991 13271 : for (i=0; i<=n; i++)
1992 12185 : if (!isexactscalar(gel(p,i+2))) return 0;
1993 1086 : return 1;
1994 : }
1995 :
1996 : static GEN
1997 1086 : solve_exact_pol(GEN p, long bit)
1998 : {
1999 1086 : long i, j, k, m, n = degpol(p), iroots = 0;
2000 1086 : GEN ex, factors, v = zerovec(n);
2001 :
2002 1086 : factors = ZX_squff(Q_primpart(p), &ex);
2003 2172 : for (i=1; i<lg(factors); i++)
2004 : {
2005 1086 : GEN roots_fact = all_roots(gel(factors,i), bit);
2006 1086 : n = degpol(gel(factors,i));
2007 1086 : m = ex[i];
2008 4309 : for (j=1; j<=n; j++)
2009 3223 : for (k=1; k<=m; k++) v[++iroots] = roots_fact[j];
2010 : }
2011 1086 : return v;
2012 : }
2013 :
2014 : /* return the roots of p with absolute error bit */
2015 : static GEN
2016 8332 : roots_com(GEN q, long bit)
2017 : {
2018 : GEN L, p;
2019 8332 : long v = RgX_valrem_inexact(q, &p);
2020 8332 : int ex = isexactpol(p);
2021 8332 : if (!ex) p = RgX_normalize1(p);
2022 8332 : if (lg(p) == 3)
2023 7 : L = cgetg(1,t_VEC); /* constant polynomial */
2024 : else
2025 8325 : L = ex? solve_exact_pol(p,bit): all_roots(p,bit);
2026 8332 : if (v)
2027 : {
2028 154 : GEN M, z, t = gel(q,2);
2029 : long i, x, y, l, n;
2030 :
2031 154 : if (isrationalzero(t)) x = -bit;
2032 : else
2033 : {
2034 14 : n = gexpo(t);
2035 14 : x = n / v; l = degpol(q);
2036 56 : for (i = v; i <= l; i++)
2037 : {
2038 42 : t = gel(q,i+2);
2039 42 : if (isrationalzero(t)) continue;
2040 42 : y = (n - gexpo(t)) / i;
2041 42 : if (y < x) x = y;
2042 : }
2043 : }
2044 154 : z = real_0_bit(x); l = v + lg(L);
2045 154 : M = cgetg(l, t_VEC); L -= v;
2046 154 : for (i = 1; i <= v; i++) gel(M,i) = z;
2047 154 : for ( ; i < l; i++) gel(M,i) = gel(L,i);
2048 154 : L = M;
2049 : }
2050 8332 : return L;
2051 : }
2052 :
2053 : static GEN
2054 120802 : tocomplex(GEN x, long l, long bit)
2055 : {
2056 : GEN y;
2057 120802 : if (typ(x) == t_COMPLEX)
2058 : {
2059 111543 : if (signe(gel(x,1))) return mygprecrc(x, l, -bit);
2060 17113 : x = gel(x,2);
2061 17113 : y = cgetg(3,t_COMPLEX);
2062 17113 : gel(y,1) = real_0_bit(-bit);
2063 17113 : gel(y,2) = mygprecrc(x, l, -bit);
2064 : }
2065 : else
2066 : {
2067 9259 : y = cgetg(3,t_COMPLEX);
2068 9259 : gel(y,1) = mygprecrc(x, l, -bit);
2069 9259 : gel(y,2) = real_0_bit(-bit);
2070 : }
2071 26372 : return y;
2072 : }
2073 :
2074 : /* x,y are t_COMPLEX of t_REALs or t_REAL, compare lexicographically,
2075 : * up to 2^-e absolute error */
2076 : static int
2077 252959 : cmp_complex_appr(void *E, GEN x, GEN y)
2078 : {
2079 252959 : long e = (long)E;
2080 : GEN z, xi, yi, xr, yr;
2081 : long sxi, syi;
2082 252959 : if (typ(x) == t_COMPLEX) { xr = gel(x,1); xi = gel(x,2); sxi = signe(xi); }
2083 83718 : else { xr = x; xi = NULL; sxi = 0; }
2084 252959 : if (typ(y) == t_COMPLEX) { yr = gel(y,1); yi = gel(y,2); syi = signe(yi); }
2085 75609 : else { yr = y; yi = NULL; syi = 0; }
2086 : /* Compare absolute values of imaginary parts */
2087 252959 : if (!sxi)
2088 : {
2089 93213 : if (syi && expo(yi) >= e) return -1;
2090 : /* |Im x| ~ |Im y| ~ 0 */
2091 : }
2092 159746 : else if (!syi)
2093 : {
2094 4184 : if (sxi && expo(xi) >= e) return 1;
2095 : /* |Im x| ~ |Im y| ~ 0 */
2096 : }
2097 : else
2098 : {
2099 : long sz;
2100 155562 : z = addrr_sign(xi, 1, yi, -1);
2101 155562 : sz = signe(z);
2102 155562 : if (sz && expo(z) >= e) return (int)sz;
2103 : }
2104 : /* |Im x| ~ |Im y|, sort according to real parts */
2105 145926 : z = subrr(xr, yr);
2106 145926 : if (expo(z) >= e) return (int)signe(z);
2107 : /* Re x ~ Re y. Place negative absolute value before positive */
2108 45799 : return (int) (sxi - syi);
2109 : }
2110 :
2111 : static GEN
2112 37945 : clean_roots(GEN L, long l, long bit, long clean)
2113 : {
2114 37945 : long i, n = lg(L), ex = 5 - bit;
2115 37945 : GEN res = cgetg(n,t_COL);
2116 197431 : for (i=1; i<n; i++)
2117 : {
2118 159486 : GEN c = gel(L,i);
2119 159486 : if (clean && isrealappr(c,ex))
2120 : {
2121 38684 : if (typ(c) == t_COMPLEX) c = gel(c,1);
2122 38684 : c = mygprecrc(c, l, -bit);
2123 : }
2124 : else
2125 120802 : c = tocomplex(c, l, bit);
2126 159486 : gel(res,i) = c;
2127 : }
2128 37945 : gen_sort_inplace(res, (void*)ex, &cmp_complex_appr, NULL);
2129 37945 : return res;
2130 : }
2131 :
2132 : /* the vector of roots of p, with absolute error 2^(- prec2nbits(l)) */
2133 : static GEN
2134 8360 : roots_aux(GEN p, long l, long clean)
2135 : {
2136 8360 : pari_sp av = avma;
2137 : long bit;
2138 : GEN L;
2139 :
2140 8360 : if (typ(p) != t_POL)
2141 : {
2142 21 : if (gequal0(p)) pari_err_ROOTS0("roots");
2143 14 : if (!isvalidcoeff(p)) pari_err_TYPE("roots",p);
2144 7 : return cgetg(1,t_COL); /* constant polynomial */
2145 : }
2146 8339 : if (!signe(p)) pari_err_ROOTS0("roots");
2147 8339 : checkvalidpol(p,"roots");
2148 8332 : if (lg(p) == 3) return cgetg(1,t_COL); /* constant polynomial */
2149 8332 : if (l < LOWDEFAULTPREC) l = LOWDEFAULTPREC;
2150 8332 : bit = prec2nbits(l);
2151 8332 : L = roots_com(p, bit);
2152 8332 : return gerepileupto(av, clean_roots(L, l, bit, clean));
2153 : }
2154 : GEN
2155 8157 : roots(GEN p, long l) { return roots_aux(p,l, 0); }
2156 : /* clean up roots. If root is real replace it by its real part */
2157 : GEN
2158 203 : cleanroots(GEN p, long l) { return roots_aux(p,l, 1); }
2159 :
2160 : /* private variant of conjvec. Allow non rational coefficients, shallow
2161 : * function. */
2162 : GEN
2163 84 : polmod_to_embed(GEN x, long prec)
2164 : {
2165 84 : GEN v, T = gel(x,1), A = gel(x,2);
2166 : long i, l;
2167 84 : if (typ(A) != t_POL || varn(A) != varn(T))
2168 : {
2169 7 : checkvalidpol(T,"polmod_to_embed");
2170 7 : return const_col(degpol(T), A);
2171 : }
2172 77 : v = cleanroots(T,prec); l = lg(v);
2173 77 : for (i=1; i<l; i++) gel(v,i) = poleval(A,gel(v,i));
2174 77 : return v;
2175 : }
2176 :
2177 : GEN
2178 29613 : QX_complex_roots(GEN p, long l)
2179 : {
2180 29613 : pari_sp av = avma;
2181 : long bit, v;
2182 : GEN L;
2183 :
2184 29613 : if (!signe(p)) pari_err_ROOTS0("QX_complex_roots");
2185 29613 : if (lg(p) == 3) return cgetg(1,t_COL); /* constant polynomial */
2186 29613 : if (l < LOWDEFAULTPREC) l = LOWDEFAULTPREC;
2187 29613 : bit = prec2nbits(l);
2188 29613 : v = RgX_valrem(p, &p);
2189 29613 : L = lg(p) > 3? all_roots(Q_primpart(p), bit): cgetg(1,t_COL);
2190 29613 : if (v) L = shallowconcat(const_vec(v, real_0_bit(-bit)), L);
2191 29613 : return gerepileupto(av, clean_roots(L, l, bit, 1));
2192 : }
2193 :
2194 : /********************************************************************/
2195 : /** **/
2196 : /** REAL ROOTS OF INTEGER POLYNOMIAL **/
2197 : /** **/
2198 : /********************************************************************/
2199 :
2200 : /* Count sign changes in the coefficients of (x+1)^deg(P)*P(1/(x+1))
2201 : * The inversion is implicit (we take coefficients backwards). Roots of P
2202 : * at 0 and 1 (mapped to oo and 0) are ignored here and must be dealt with
2203 : * by the caller */
2204 : static long
2205 450293 : X2XP1(GEN P, long deg, int *root1, GEN *Premapped)
2206 : {
2207 450293 : const pari_sp av = avma;
2208 450293 : GEN v = shallowcopy(P);
2209 : long i, j, vlim, nb, s;
2210 :
2211 450293 : for (i = 0, vlim = deg+2;;)
2212 : {
2213 450447 : for (j = 2; j < vlim; j++) gel(v, j+1) = addii(gel(v, j), gel(v, j+1));
2214 450370 : s = -signe(gel(v, vlim));
2215 450370 : vlim--; i++; if (s) break;
2216 : }
2217 450293 : if (vlim == deg+1) *root1 = 0;
2218 : else
2219 : {
2220 77 : *root1 = 1;
2221 77 : if (Premapped) setlg(v, vlim + 2);
2222 : }
2223 :
2224 450293 : nb = 0;
2225 1666835 : for (; i < deg; i++)
2226 : {
2227 1594946 : long s2 = -signe(gel(v, 2));
2228 1594946 : int flag = (s2 == s);
2229 20667081 : for (j = 2; j < vlim; j++)
2230 : {
2231 19072135 : gel(v, j+1) = addii(gel(v, j), gel(v, j+1));
2232 19072135 : if (flag) flag = (s2 != signe(gel(v, j+1)));
2233 : }
2234 1594946 : if (s == signe(gel(v, vlim)))
2235 : {
2236 424749 : if (++nb >= 2) { avma = av; return 2; }
2237 247400 : s = -s;
2238 : }
2239 : /* if flag is set there will be no further sign changes */
2240 1417597 : if (flag && (!Premapped || !nb)) goto END;
2241 1216542 : vlim--;
2242 1216542 : if (gc_needed(av, 3))
2243 : {
2244 0 : if (!Premapped) setlg(v, vlim + 2);
2245 0 : v = gerepileupto(av, v);
2246 0 : if (DEBUGMEM > 1) pari_warn(warnmem, "X2XP1");
2247 : }
2248 : }
2249 71889 : if (vlim >= 2 && s == signe(gel(v, vlim))) nb++;
2250 : END:
2251 272944 : if (Premapped && nb == 1) *Premapped = v; else avma = av;
2252 272944 : return nb;
2253 : }
2254 :
2255 : static long
2256 0 : _intervalcmp(GEN x, GEN y)
2257 : {
2258 0 : if (typ(x) == t_VEC) x = gel(x, 1);
2259 0 : if (typ(y) == t_VEC) y = gel(y, 1);
2260 0 : return gcmp(x, y);
2261 : }
2262 :
2263 : static GEN
2264 2376399 : _gen_nored(void *E, GEN x) { (void)E; return x; }
2265 : static GEN
2266 13321785 : _mp_add(void *E, GEN x, GEN y) { (void)E; return mpadd(x, y); }
2267 : static GEN
2268 0 : _mp_sub(void *E, GEN x, GEN y) { (void)E; return mpsub(x, y); }
2269 : static GEN
2270 2973997 : _mp_mul(void *E, GEN x, GEN y) { (void)E; return mpmul(x, y); }
2271 : static GEN
2272 2848212 : _mp_sqr(void *E, GEN x) { (void)E; return mpsqr(x); }
2273 : static GEN
2274 2723251 : _gen_one(void *E) { (void)E; return gen_1; }
2275 : static GEN
2276 31362 : _gen_zero(void *E) { (void)E; return gen_0; }
2277 :
2278 : static struct bb_algebra mp_algebra = { _gen_nored, _mp_add, _mp_sub,
2279 : _mp_mul, _mp_sqr, _gen_one, _gen_zero };
2280 :
2281 : static GEN
2282 14997839 : _mp_cmul(void *E, GEN P, long a, GEN x) {(void)E; return mpmul(gel(P,a+2), x);}
2283 :
2284 : /* Split the polynom P in two parts, whose coeffs have constant sign:
2285 : * P(X) = X^D*Pp + Pm. Also compute the two parts of the derivative of P,
2286 : * Pprimem = Pm', Pprimep = X*Pp'+ D*Pp => P' = X^(D-1)*Pprimep + Pprimem;
2287 : * Pprimep[i] = (i+D) Pp[i]. Return D */
2288 : static long
2289 29322 : split_pols(GEN P, GEN *pPp, GEN *pPm, GEN *pPprimep, GEN *pPprimem)
2290 : {
2291 29322 : long i, D, dP = degpol(P), s0 = signe(gel(P,2));
2292 : GEN Pp, Pm, Pprimep, Pprimem;
2293 196513 : for(i=1; i <= dP; i++)
2294 196513 : if (signe(gel(P, i+2)) == -s0) break;
2295 29322 : D = i;
2296 29322 : Pm = cgetg(D + 2, t_POL);
2297 29322 : Pprimem = cgetg(D + 1, t_POL);
2298 29322 : Pp = cgetg(dP-D + 3, t_POL);
2299 29322 : Pprimep = cgetg(dP-D + 3, t_POL);
2300 29322 : Pm[1] = Pp[1] = Pprimem[1] = Pprimep[1] = P[1];
2301 225835 : for(i=0; i < D; i++)
2302 : {
2303 196513 : GEN c = gel(P, i+2);
2304 196513 : gel(Pm, i+2) = c;
2305 196513 : if (i) gel(Pprimem, i+1) = mului(i, c);
2306 : }
2307 238117 : for(; i <= dP; i++)
2308 : {
2309 208795 : GEN c = gel(P, i+2);
2310 208795 : gel(Pp, i+2-D) = c;
2311 208795 : gel(Pprimep, i+2-D) = mului(i, c);
2312 : }
2313 29322 : *pPm = normalizepol_lg(Pm, D+2);
2314 29322 : *pPprimem = normalizepol_lg(Pprimem, D+1);
2315 29322 : *pPp = normalizepol_lg(Pp, dP-D+3);
2316 29322 : *pPprimep = normalizepol_lg(Pprimep, dP-D+3);
2317 29322 : return dP - degpol(*pPp);
2318 : }
2319 :
2320 : static GEN
2321 853708 : bkeval_single_power(long d, GEN V)
2322 : {
2323 853708 : long mp = lg(V) - 2;
2324 853708 : if (d > mp) return gmul(gpowgs(gel(V, mp+1), d/mp), gel(V, (d%mp)+1));
2325 853708 : return gel(V, d+1);
2326 : }
2327 :
2328 : static GEN
2329 853708 : splitpoleval(GEN Pp, GEN Pm, GEN pows, long D, long bitprec)
2330 : {
2331 853708 : GEN vp = gen_bkeval_powers(Pp, degpol(Pp), pows, NULL, &mp_algebra, _mp_cmul);
2332 853708 : GEN vm = gen_bkeval_powers(Pm, degpol(Pm), pows, NULL, &mp_algebra, _mp_cmul);
2333 853708 : GEN xa = bkeval_single_power(D, pows);
2334 : GEN r;
2335 853708 : if (!signe(vp)) return vm;
2336 853708 : vp = gmul(vp, xa);
2337 853708 : r = gadd(vp, vm);
2338 853708 : if (gexpo(vp) - (signe(r)? gexpo(r): 0) > prec2nbits(realprec(vp)) - bitprec)
2339 43656 : return NULL;
2340 810052 : return r;
2341 : }
2342 :
2343 : /* optimized Cauchy bound for P = X^D*Pp + Pm, D > deg(Pm) */
2344 : static GEN
2345 29322 : splitcauchy(GEN Pp, GEN Pm, long prec)
2346 : {
2347 29322 : GEN S = gel(Pp,2), A = gel(Pm,2);
2348 29322 : long i, lPm = lg(Pm), lPp = lg(Pp);
2349 29322 : for (i=3; i < lPm; i++) { GEN c = gel(Pm,i); if (abscmpii(A, c) < 0) A = c; }
2350 29322 : for (i=3; i < lPp; i++) S = addii(S, gel(Pp, i));
2351 29322 : return subsr(1, rdivii(A, S, prec)); /* 1 + |Pm|_oo / |Pp|_1 */
2352 : }
2353 :
2354 : /* Newton for polynom P, P(0)!=0, with unique sign change => one root in ]0,oo[
2355 : * P' has also at most one zero there */
2356 : static GEN
2357 29322 : polsolve(GEN P, long bitprec)
2358 : {
2359 29322 : pari_sp av = avma, av2;
2360 : GEN Pp, Pm, Pprimep, Pprimem, Pprime, Pprime2, ra, rb, rc, Pc;
2361 29322 : long deg = degpol(P);
2362 29322 : long expoold = LONG_MAX, cprec = DEFAULTPREC, prec = nbits2prec(bitprec);
2363 : long iter, D, rt, s0, bitaddprec, addprec;
2364 29322 : if (deg == 1)
2365 0 : return gerepileuptoleaf(av, rdivii(negi(gel(P,2)), gel(P,3), prec));
2366 29322 : Pprime = ZX_deriv(P);
2367 29322 : Pprime2 = ZX_deriv(Pprime);
2368 29322 : bitaddprec = 1 + 2*expu(deg); addprec = nbits2prec(bitaddprec);
2369 29322 : D = split_pols(P, &Pp, &Pm, &Pprimep, &Pprimem); /* P = X^D*Pp + Pm */
2370 29322 : s0 = signe(gel(P, 2));
2371 29322 : rt = maxss(D, brent_kung_optpow(maxss(degpol(Pp), degpol(Pm)), 2, 1));
2372 29322 : rb = splitcauchy(Pp, Pm, DEFAULTPREC);
2373 : for(;;)
2374 0 : {
2375 29322 : GEN pows = gen_powers(rb, rt, 1, NULL, _mp_sqr, _mp_mul, _gen_one);
2376 29322 : Pc = splitpoleval(Pp, Pm, pows, D, bitaddprec);
2377 29322 : if (!Pc) { cprec++; rb = rtor(rb, cprec); continue; }
2378 29322 : if (signe(Pc) != s0) break;
2379 0 : shiftr_inplace(rb,1);
2380 : }
2381 29322 : ra = NULL;
2382 29322 : iter = 0;
2383 : for(;;)
2384 303542 : {
2385 : GEN wdth;
2386 332864 : iter++;
2387 332864 : if (ra)
2388 183058 : rc = shiftr(addrr(ra, rb), -1);
2389 : else
2390 149806 : rc = shiftr(rb, -1);
2391 : do
2392 0 : {
2393 332864 : GEN pows = gen_powers(rc, rt, 1, NULL, _mp_sqr, _mp_mul, _gen_one);
2394 332864 : Pc = splitpoleval(Pp, Pm, pows, D, bitaddprec+2);
2395 332864 : if (Pc) break;
2396 0 : cprec++; rc = rtor(rc, cprec);
2397 : } while (1);
2398 332864 : if (signe(Pc) == s0)
2399 116887 : ra = rc;
2400 : else
2401 215977 : rb = rc;
2402 332864 : if (!ra) continue;
2403 212380 : wdth = subrr(rb, ra);
2404 212380 : if (!(iter % 8))
2405 : {
2406 32612 : GEN m1 = poleval(Pprime, ra), M2;
2407 32612 : if (signe(m1) == s0) continue;
2408 31786 : M2 = poleval(Pprime2, rb);
2409 31786 : if (abscmprr(gmul(M2, wdth), shiftr(m1, 1)) > 0) continue;
2410 29322 : break;
2411 : }
2412 179768 : else if (gexpo(wdth) <= -bitprec)
2413 0 : break;
2414 : }
2415 29322 : rc = rb;
2416 29322 : av2 = avma;
2417 216439 : for(;; rc = gerepileuptoleaf(av2, rc))
2418 216439 : {
2419 : long exponew;
2420 245761 : GEN Ppc, dist, rcold = rc;
2421 245761 : GEN pows = gen_powers(rc, rt, 1, NULL, _mp_sqr, _mp_mul, _gen_one);
2422 245761 : Ppc = splitpoleval(Pprimep, Pprimem, pows, D-1, bitaddprec+4);
2423 245761 : if (Ppc)
2424 245761 : Pc = splitpoleval(Pp, Pm, pows, D, bitaddprec+4);
2425 245761 : if (!Ppc || !Pc)
2426 : {
2427 43656 : if (cprec >= prec+addprec)
2428 3452 : cprec += EXTRAPRECWORD;
2429 : else
2430 40204 : cprec = minss(2*cprec, prec+addprec);
2431 43656 : rc = rtor(rc, cprec); continue; /* backtrack one step */
2432 : }
2433 202105 : dist = typ(Ppc) == t_REAL? divrr(Pc, Ppc): divri(Pc, Ppc);
2434 202105 : rc = subrr(rc, dist);
2435 202105 : if (cmprr(ra, rc) > 0 || cmprr(rb, rc) < 0)
2436 : {
2437 0 : if (cprec >= prec+addprec) break;
2438 0 : cprec = minss(2*cprec, prec+addprec);
2439 0 : rc = rtor(rcold, cprec); continue; /* backtrack one step */
2440 : }
2441 202105 : if (expoold == LONG_MAX) { expoold = expo(dist); continue; }
2442 169657 : exponew = expo(dist);
2443 169657 : if (exponew < -bitprec - 1)
2444 : {
2445 39077 : if (cprec >= prec+addprec) break;
2446 9755 : cprec = minss(2*cprec, prec+addprec);
2447 9755 : rc = rtor(rc, cprec); continue;
2448 : }
2449 130580 : if (exponew > expoold - 2)
2450 : {
2451 3126 : if (cprec >= prec+addprec) break;
2452 3126 : expoold = LONG_MAX;
2453 3126 : cprec = minss(2*cprec, prec+addprec);
2454 3126 : rc = rtor(rc, cprec); continue;
2455 : }
2456 127454 : expoold = exponew;
2457 : }
2458 29322 : return gerepileuptoleaf(av, rtor(rc, prec));
2459 : }
2460 :
2461 : static GEN
2462 26951 : usp(GEN Q0, long deg, long flag, long bitprec)
2463 : {
2464 26951 : const pari_sp av = avma;
2465 : GEN Q, sol, c, Lc, Lk;
2466 26951 : long listsize = 64, nbr = 0, nb_todo, ind, deg0, indf, i, k, nb;
2467 :
2468 :
2469 26951 : sol = zerocol(deg);
2470 26951 : deg0 = deg;
2471 26951 : Lc = zerovec(listsize);
2472 26951 : Lk = cgetg(listsize+1, t_VECSMALL);
2473 26951 : c = gen_0;
2474 26951 : k = Lk[1] = 0;
2475 26951 : ind = 1; indf = 2;
2476 26951 : Q = leafcopy(Q0);
2477 :
2478 26951 : nb_todo = 1;
2479 504195 : while (nb_todo)
2480 : {
2481 450293 : GEN nc = gel(Lc, ind), Qremapped;
2482 : pari_sp av2;
2483 : int root1;
2484 450293 : if (Lk[ind] == k + 1)
2485 : {
2486 142364 : deg0 = deg;
2487 142364 : setlg(Q0, deg + 3);
2488 142364 : Q0 = ZX_rescale2n(Q0, 1);
2489 142364 : Q = Q_primpart(Q0);
2490 142364 : c = gen_0;
2491 : }
2492 :
2493 450293 : if (!equalii(nc, c)) Q = ZX_translate(Q, subii(nc, c));
2494 :
2495 450293 : k = Lk[ind];
2496 450293 : c = nc;
2497 450293 : ind++;
2498 450293 : nb_todo--;
2499 :
2500 450293 : if (equalii(gel(Q, 2), gen_0))
2501 : { /* Q(0) = 0 */
2502 168 : GEN s = gmul2n(c, -k);
2503 : long j;
2504 210 : for (j = 1; j <= nbr; j++)
2505 126 : if (gequal(gel(sol, j), s)) break;
2506 168 : if (j > nbr) gel(sol, ++nbr) = s;
2507 :
2508 168 : deg0--;
2509 168 : for (j = 2; j <= deg0 + 2; j++) gel(Q, j) = gel(Q, j+1);
2510 168 : setlg(Q, j);
2511 : }
2512 :
2513 450293 : av2 = avma;
2514 450293 : nb = X2XP1(Q, deg0, &root1, flag == 1 ? &Qremapped : NULL);
2515 :
2516 450293 : if (nb == 0) /* no root in this open interval */;
2517 255272 : else if (nb == 1) /* exactly one root */
2518 : {
2519 43601 : GEN s = gen_0;
2520 43601 : if (flag == 0)
2521 0 : s = mkvec2(gmul2n(c,-k), gmul2n(addiu(c,1),-k));
2522 43601 : else if (flag == 1) /* Caveat: Qremapped is the reciprocal polynomial */
2523 : {
2524 29322 : s = polsolve(Qremapped, bitprec+1);
2525 29322 : s = divrr(s, addsr(1, s));
2526 29322 : s = gmul2n(addir(c, s), -k);
2527 29322 : s = rtor(s, nbits2prec(bitprec));
2528 : }
2529 43601 : gel(sol, ++nbr) = gerepileupto(av2, s);
2530 : }
2531 : else
2532 : { /* unknown, add two nodes to refine */
2533 211671 : if (indf + 2 > listsize)
2534 : {
2535 413 : if (ind>1)
2536 : {
2537 2940 : for (i = ind; i < indf; i++)
2538 : {
2539 2527 : gel(Lc, i-ind+1) = gel(Lc, i);
2540 2527 : Lk[i-ind+1] = Lk[i];
2541 : }
2542 413 : indf -= ind-1;
2543 413 : ind = 1;
2544 : }
2545 413 : if (indf + 2 > listsize)
2546 : {
2547 0 : listsize *= 2;
2548 0 : Lc = vec_lengthen(Lc, listsize);
2549 0 : Lk = vecsmall_lengthen(Lk, listsize);
2550 : }
2551 413 : for (i = indf; i <= listsize; i++) gel(Lc, i) = gen_0;
2552 : }
2553 211671 : nc = shifti(c, 1);
2554 211671 : gel(Lc, indf) = nc;
2555 211671 : gel(Lc, indf + 1) = addiu(nc, 1);
2556 211671 : Lk[indf] = Lk[indf + 1] = k + 1;
2557 211671 : indf += 2;
2558 211671 : nb_todo += 2;
2559 : }
2560 450293 : if (root1)
2561 : { /* Q(1) = 0 */
2562 77 : GEN s = gmul2n(addiu(c,1), -k);
2563 : long j;
2564 119 : for (j = 1; j <= nbr; j++)
2565 49 : if (gequal(gel(sol, j), s)) break;
2566 77 : if (j > nbr) gel(sol, ++nbr) = s;
2567 : }
2568 :
2569 450293 : if (gc_needed(av, 2))
2570 : {
2571 0 : gerepileall(av, 6, &Q0, &Q, &c, &Lc, &Lk, &sol);
2572 0 : if (DEBUGMEM > 1) pari_warn(warnmem, "ZX_Uspensky", avma);
2573 : }
2574 : }
2575 :
2576 26951 : setlg(sol, nbr+1);
2577 26951 : return gerepilecopy(av, sol);
2578 : }
2579 :
2580 : static GEN
2581 4172 : ZX_Uspensky_cst_pol(long nbz, long flag, long bitprec)
2582 : {
2583 4172 : switch(flag)
2584 : {
2585 0 : case 0: return zerocol(nbz);
2586 0 : case 1: retconst_col(nbz, real_0_bit(-bitprec));
2587 4172 : default: return utoi(nbz);
2588 : }
2589 : }
2590 :
2591 : /* ZX_Uspensky(P, [a,a], flag) */
2592 : static GEN
2593 28 : ZX_Uspensky_equal(GEN P, GEN a, long flag)
2594 : {
2595 28 : if (typ(a) != t_INFINITY && gequal0(poleval(P, a)))
2596 21 : return flag <= 1 ? mkcol(a): gen_1;
2597 : else
2598 7 : return flag <= 1 ? cgetg(1, t_COL) : gen_0;
2599 : }
2600 :
2601 : GEN
2602 30365 : ZX_Uspensky(GEN P, GEN ab, long flag, long bitprec)
2603 : {
2604 30365 : pari_sp av = avma;
2605 30365 : GEN a, b, sol = NULL, Pcur;
2606 : double fb;
2607 : long nbz, deg;
2608 :
2609 30365 : deg = degpol(P);
2610 30365 : if (deg == 0) return flag <= 1 ? cgetg(1, t_COL) : gen_0;
2611 30365 : if (ab)
2612 : {
2613 17408 : if (typ(ab) == t_VEC)
2614 : {
2615 9321 : if (lg(ab) != 3) pari_err_DIM("ZX_Uspensky");
2616 9321 : a = gel(ab, 1);
2617 9321 : b = gel(ab, 2);
2618 : }
2619 : else
2620 : {
2621 8087 : a = ab;
2622 8087 : b = mkoo();
2623 : }
2624 : }
2625 : else
2626 : {
2627 12957 : a = mkmoo();
2628 12957 : b = mkoo();
2629 : }
2630 30365 : switch (gcmp(a, b))
2631 : {
2632 7 : case 1: avma = av; return flag <= 1 ? cgetg(1, t_COL) : gen_0;
2633 21 : case 0: return gerepilecopy(av, ZX_Uspensky_equal(P, a, flag));
2634 : }
2635 30337 : nbz = ZX_valrem(P, &Pcur);
2636 30337 : deg -= nbz;
2637 30337 : if (!nbz) Pcur = P;
2638 30337 : if (nbz && (gsigne(a) > 0 || gsigne(b) < 0)) nbz = 0;
2639 30337 : if (deg == 0) { avma = av; return ZX_Uspensky_cst_pol(nbz, flag, bitprec); }
2640 29000 : if (deg == 1)
2641 : {
2642 7086 : sol = gdiv(gneg(gel(Pcur, 2)), pollead(Pcur, -1));
2643 7086 : if (gcmp(a, sol) > 0 || gcmp(sol, b) > 0)
2644 : {
2645 2835 : avma = av;
2646 2835 : return ZX_Uspensky_cst_pol(nbz, flag, bitprec);
2647 : }
2648 4251 : if (flag >= 2) { avma = av; return utoi(nbz+1); }
2649 1962 : sol = gconcat(zerocol(nbz), mkcol(sol));
2650 1962 : if (flag == 1) sol = RgC_gtofp(sol, nbits2prec(bitprec));
2651 1962 : return gerepilecopy(av, sol);
2652 : }
2653 21914 : switch(flag)
2654 : {
2655 : case 0:
2656 0 : sol = zerocol(nbz);
2657 0 : break;
2658 : case 1:
2659 10416 : sol = const_col(nbz, real_0_bit(-bitprec));
2660 10416 : break;
2661 : /* case 2: nothing */
2662 : }
2663 :
2664 21914 : if (typ(a) == t_INFINITY && typ(b) != t_INFINITY && gsigne(b))
2665 : {
2666 35 : fb = fujiwara_bound_real(Pcur, -1);
2667 35 : if (fb > -pariINFINITY) a = negi(int2n((long)ceil(fb))); else a = gen_0;
2668 : }
2669 21914 : if (typ(b) == t_INFINITY && typ(a) != t_INFINITY && gsigne(a))
2670 : {
2671 21 : fb = fujiwara_bound_real(Pcur, 1);
2672 21 : if (fb > -pariINFINITY) b = int2n((long)ceil(fb)); else b = gen_0;
2673 : }
2674 :
2675 21914 : if (typ(a) != t_INFINITY && typ(b) != t_INFINITY)
2676 : {
2677 : GEN den, diff, unscaledres, co, Pdiv, ascaled;
2678 : pari_sp av1;
2679 : long i;
2680 7287 : if (gequal(a,b)) /* can occur if one of a,b was initially a t_INFINITY */
2681 7 : return gerepilecopy(av, ZX_Uspensky_equal(P, a, flag));
2682 7280 : den = lcmii(Q_denom(a), Q_denom(b));
2683 7280 : if (!is_pm1(den))
2684 : {
2685 42 : Pcur = ZX_rescale(Pcur, den);
2686 42 : ascaled = gmul(a, den);
2687 : }
2688 : else
2689 : {
2690 7238 : den = NULL;
2691 7238 : ascaled = a;
2692 : }
2693 7280 : diff = subii(den ? gmul(b,den) : b, ascaled);
2694 7280 : Pcur = ZX_unscale(ZX_translate(Pcur, ascaled), diff);
2695 7280 : av1 = avma;
2696 7280 : Pdiv = cgetg(deg+2, t_POL);
2697 7280 : Pdiv[1] = Pcur[1];
2698 7280 : co = gel(Pcur, deg+2);
2699 56959 : for (i = deg; --i >= 0; )
2700 : {
2701 42399 : gel(Pdiv, i+2) = co;
2702 42399 : co = addii(co, gel(Pcur, i+2));
2703 : }
2704 7280 : if (!signe(co))
2705 : {
2706 77 : Pcur = Pdiv;
2707 77 : deg--;
2708 77 : if (flag <= 1)
2709 21 : sol = gconcat(sol, b);
2710 : else
2711 56 : nbz++;
2712 : }
2713 : else
2714 7203 : avma = av1;
2715 7280 : unscaledres = usp(Pcur, deg, flag, bitprec);
2716 7280 : if (flag <= 1)
2717 : {
2718 19719 : for (i = 1; i < lg(unscaledres); i++)
2719 : {
2720 12565 : GEN z = gmul(diff, gel(unscaledres, i));
2721 12565 : if (typ(z) == t_VEC)
2722 : {
2723 0 : gel(z, 1) = gadd(ascaled, gel(z, 1));
2724 0 : gel(z, 2) = gadd(ascaled, gel(z, 2));
2725 : }
2726 : else
2727 12565 : z = gadd(ascaled, z);
2728 12565 : if (den) z = gdiv(z, den);
2729 12565 : gel(unscaledres, i) = z;
2730 : }
2731 7154 : sol = gconcat(sol, unscaledres);
2732 : }
2733 : else
2734 126 : nbz += lg(unscaledres) - 1;
2735 : }
2736 21907 : if (typ(b) == t_INFINITY && (fb=fujiwara_bound_real(Pcur, 1)) > -pariINFINITY)
2737 : {
2738 : GEN Pcurp, unscaledres;
2739 13126 : long bp = (long)ceil(fb);
2740 13126 : if (bp < 0) bp = 0;
2741 13126 : Pcurp = ZX_unscale2n(Pcur, bp);
2742 13126 : unscaledres = usp(Pcurp, deg, flag, bitprec);
2743 13126 : if (flag <= 1)
2744 3255 : sol = shallowconcat(sol, gmul2n(unscaledres, bp));
2745 : else
2746 9871 : nbz += lg(unscaledres)-1;
2747 : }
2748 21907 : if (typ(a) == t_INFINITY && (fb=fujiwara_bound_real(Pcur,-1)) > -pariINFINITY)
2749 : {
2750 : GEN Pcurm, unscaledres;
2751 6545 : long i, bm = (long)ceil(fb);
2752 6545 : if (bm < 0) bm = 0;
2753 6545 : Pcurm = ZX_unscale2n(ZX_z_unscale(Pcur, -1), bm);
2754 6545 : unscaledres = usp(Pcurm, deg, flag, bitprec);
2755 6545 : if (flag <= 1)
2756 : {
2757 7140 : for (i = 1; i < lg(unscaledres); i++)
2758 : {
2759 4564 : GEN z = gneg(gmul2n(gel(unscaledres, i), bm));
2760 4564 : if (typ(z) == t_VEC) swap(gel(z, 1), gel(z, 2));
2761 4564 : gel(unscaledres, i) = z;
2762 : }
2763 2576 : sol = shallowconcat(unscaledres, sol);
2764 : }
2765 : else
2766 3969 : nbz += lg(unscaledres)-1;
2767 : }
2768 21907 : if (flag >= 2) return utoi(nbz);
2769 10416 : if (flag)
2770 10416 : sol = sort(sol);
2771 : else
2772 0 : sol = gen_sort(sol, (void *)_intervalcmp, cmp_nodata);
2773 10416 : return gerepileupto(av, sol);
2774 : }
2775 :
2776 : /* x a scalar */
2777 : static GEN
2778 35 : rootsdeg0(GEN x)
2779 : {
2780 35 : if (!is_real_t(typ(x))) pari_err_TYPE("realroots",x);
2781 28 : if (gequal0(x)) pari_err_ROOTS0("realroots");
2782 14 : return cgetg(1,t_COL); /* constant polynomial */
2783 : }
2784 : static void
2785 4922 : checkbound(GEN a)
2786 : {
2787 4922 : switch(typ(a))
2788 : {
2789 4922 : case t_INT: case t_FRAC: case t_INFINITY: break;
2790 0 : default: pari_err_TYPE("polrealroots", a);
2791 : }
2792 4922 : }
2793 : static GEN
2794 8952 : check_ab(GEN ab)
2795 : {
2796 : GEN a, b;
2797 8952 : if (!ab) return NULL;
2798 2461 : if (typ(ab) != t_VEC || lg(ab) != 3) pari_err_TYPE("polrootsreal",ab);
2799 2461 : a = gel(ab,1); checkbound(a);
2800 2461 : b = gel(ab,2); checkbound(b);
2801 2734 : if (typ(a) == t_INFINITY && inf_get_sign(a) < 0 &&
2802 511 : typ(b) == t_INFINITY && inf_get_sign(b) > 0) ab = NULL;
2803 2461 : return ab;
2804 : }
2805 : GEN
2806 6505 : realroots(GEN P, GEN ab, long prec)
2807 : {
2808 6505 : pari_sp av = avma;
2809 6505 : long nrr = 0;
2810 6505 : GEN sol = NULL, fa, ex;
2811 : long i, j, v;
2812 :
2813 6505 : ab = check_ab(ab);
2814 6505 : if (typ(P) != t_POL) return rootsdeg0(P);
2815 6484 : switch(degpol(P))
2816 : {
2817 7 : case -1: return rootsdeg0(gen_0);
2818 7 : case 0: return rootsdeg0(gel(P,2));
2819 : }
2820 6470 : if (!RgX_is_ZX(P)) P = RgX_rescale_to_int(P);
2821 6470 : P = Q_primpart(P);
2822 6470 : v = ZX_valrem(P,&P);
2823 6470 : if (v && (!ab || (gsigne(gel(ab,1)) <= 0 && gsigne(gel(ab,2)) >= 0)))
2824 1253 : sol = const_col(v, real_0(prec));
2825 6470 : fa = ZX_squff(P, &ex);
2826 11708 : for (i = 1; i < lg(fa); i++)
2827 : {
2828 5238 : GEN Pi = gel(fa, i), soli, soli2 = NULL;
2829 5238 : long n, nrri = 0, h;
2830 5238 : if (ab)
2831 49 : h = 1;
2832 : else
2833 5189 : Pi = ZX_deflate_max(Pi, &h);
2834 5238 : soli = ZX_Uspensky(Pi, h%2 ? ab: gen_0, 1, prec2nbits(prec));
2835 5238 : n = lg(soli);
2836 5238 : if (!(h % 2)) soli2 = cgetg(n, t_COL);
2837 23145 : for (j = 1; j < n; j++)
2838 : {
2839 17907 : GEN elt = gel(soli, j); /* != 0 */
2840 17907 : if (typ(elt) != t_REAL)
2841 : {
2842 84 : nrri++; if (h > 1 && !(h % 2)) nrri++;
2843 84 : elt = gtofp(elt, prec);
2844 84 : gel(soli, j) = elt;
2845 : }
2846 17907 : if (h > 1)
2847 : {
2848 : GEN r;
2849 2886 : if (h == 2)
2850 2872 : r = sqrtr(elt);
2851 : else
2852 : {
2853 14 : if (signe(elt) < 0)
2854 7 : r = negr(sqrtnr(negr(elt), h));
2855 : else
2856 7 : r = sqrtnr(elt, h);
2857 : }
2858 2886 : gel(soli, j) = r;
2859 2886 : if (!(h % 2)) gel(soli2, j) = negr(r);
2860 : }
2861 : }
2862 5238 : if (!(h % 2)) soli = shallowconcat(soli, soli2);
2863 5238 : if (ex[i] > 1) soli = shallowconcat1( const_vec(ex[i], soli) );
2864 5238 : sol = sol? shallowconcat(sol, soli): soli;
2865 5238 : nrr += ex[i]*nrri;
2866 : }
2867 6470 : if (!sol) { avma = av; return cgetg(1,t_COL); }
2868 :
2869 6456 : if (DEBUGLEVEL > 4)
2870 : {
2871 0 : err_printf("Number of real roots: %d\n", lg(sol)-1);
2872 0 : err_printf(" -- of which 2-integral: %ld\n", nrr);
2873 : }
2874 6456 : return gerepileupto(av, sort(sol));
2875 : }
2876 :
2877 : /* P non-constant, squarefree ZX */
2878 : long
2879 15820 : ZX_sturm(GEN P)
2880 : {
2881 15820 : pari_sp av = avma;
2882 : long h, r;
2883 15820 : P = ZX_deflate_max(P, &h);
2884 15820 : if (odd(h))
2885 9842 : r = itos(ZX_Uspensky(P, NULL, 2, 0));
2886 : else
2887 5978 : r = 2*itos(ZX_Uspensky(P, gen_0, 2, 0));
2888 15820 : avma = av; return r;
2889 : }
2890 : /* P non-constant, squarefree ZX */
2891 : long
2892 2447 : ZX_sturmpart(GEN P, GEN ab)
2893 : {
2894 2447 : pari_sp av = avma;
2895 : long r;
2896 2447 : if (!check_ab(ab)) return ZX_sturm(P);
2897 2153 : r = itos(ZX_Uspensky(P, ab, 2, 0));
2898 2153 : avma = av; return r;
2899 : }
|
