mirror of
https://github.com/vale981/arb
synced 2025-03-05 09:21:38 -05:00
289 lines
7.7 KiB
C
289 lines
7.7 KiB
C
/*
|
|
Copyright (C) 2017 Fredrik Johansson
|
|
|
|
This file is part of Arb.
|
|
|
|
Arb is free software: you can redistribute it and/or modify it under
|
|
the terms of the GNU Lesser General Public License (LGPL) as published
|
|
by the Free Software Foundation; either version 2.1 of the License, or
|
|
(at your option) any later version. See <http://www.gnu.org/licenses/>.
|
|
*/
|
|
|
|
#include "acb_elliptic.h"
|
|
|
|
void
|
|
acb_elliptic_rj(acb_t res, const acb_t x, const acb_t y,
|
|
const acb_t z, const acb_t p, int flags, slong prec)
|
|
{
|
|
acb_t xx, yy, zz, pp, sx, sy, sz, sp, t, d, delta, S;
|
|
acb_t A, AA, X, Y, Z, P, E2, E3, E4, E5;
|
|
mag_t err, err2, prev_err;
|
|
slong k, wp, accx, accy, accz, accp;
|
|
int rd;
|
|
|
|
if (!acb_is_finite(x) || !acb_is_finite(y) || !acb_is_finite(z) ||
|
|
!acb_is_finite(p))
|
|
{
|
|
acb_indeterminate(res);
|
|
return;
|
|
}
|
|
|
|
if ((acb_contains_zero(x) + acb_contains_zero(y) + acb_contains_zero(z) > 1)
|
|
|| acb_contains_zero(p))
|
|
{
|
|
acb_indeterminate(res);
|
|
return;
|
|
}
|
|
|
|
/* Special case computing R_D(x,y,z) */
|
|
rd = (z == p);
|
|
|
|
acb_init(xx); acb_init(yy); acb_init(zz); acb_init(pp);
|
|
acb_init(sx); acb_init(sy); acb_init(sz); acb_init(sp);
|
|
acb_init(S); acb_init(A); acb_init(AA);
|
|
acb_init(X); acb_init(Y); acb_init(Z); acb_init(P);
|
|
acb_init(E2); acb_init(E3); acb_init(E4); acb_init(E5);
|
|
acb_init(t); acb_init(d); acb_init(delta);
|
|
mag_init(err);
|
|
mag_init(err2);
|
|
mag_init(prev_err);
|
|
|
|
acb_set(xx, x);
|
|
acb_set(yy, y);
|
|
acb_set(zz, z);
|
|
acb_set(pp, p);
|
|
acb_zero(S);
|
|
|
|
wp = prec + 20;
|
|
|
|
if (!rd)
|
|
{
|
|
acb_mul_2exp_si(A, p, 1);
|
|
acb_add(A, A, z, wp);
|
|
}
|
|
else
|
|
{
|
|
acb_mul_ui(A, z, 3, wp);
|
|
}
|
|
acb_add(A, A, x, wp);
|
|
acb_add(A, A, y, wp);
|
|
acb_div_ui(A, A, 5, wp);
|
|
acb_set(AA, A);
|
|
|
|
if (!rd)
|
|
{
|
|
acb_sub(delta, p, x, wp);
|
|
acb_sub(t, p, y, wp);
|
|
acb_mul(delta, delta, t, wp);
|
|
acb_sub(t, p, z, wp);
|
|
acb_mul(delta, delta, t, wp);
|
|
}
|
|
|
|
/* must do at least one iteration */
|
|
for (k = 0; k < prec; k++)
|
|
{
|
|
accx = acb_rel_accuracy_bits(xx);
|
|
accy = acb_rel_accuracy_bits(yy);
|
|
accz = acb_rel_accuracy_bits(zz);
|
|
accp = acb_rel_accuracy_bits(pp);
|
|
|
|
wp = FLINT_MAX(accx, accy);
|
|
wp = FLINT_MAX(wp, accz);
|
|
wp = FLINT_MAX(wp, accp);
|
|
wp = FLINT_MAX(wp, 0);
|
|
wp = FLINT_MIN(wp, prec);
|
|
wp += 20;
|
|
|
|
acb_sqrt(sx, xx, wp);
|
|
acb_sqrt(sy, yy, wp);
|
|
acb_sqrt(sz, zz, wp);
|
|
if (!rd) acb_sqrt(sp, pp, wp);
|
|
|
|
acb_add(t, sy, sz, wp);
|
|
acb_mul(t, t, sx, wp);
|
|
acb_addmul(t, sy, sz, wp);
|
|
|
|
acb_add(xx, xx, t, wp);
|
|
acb_add(yy, yy, t, wp);
|
|
acb_add(zz, zz, t, wp);
|
|
if (!rd) acb_add(pp, pp, t, wp);
|
|
acb_add(AA, AA, t, wp);
|
|
|
|
acb_mul_2exp_si(xx, xx, -2);
|
|
acb_mul_2exp_si(yy, yy, -2);
|
|
acb_mul_2exp_si(zz, zz, -2);
|
|
if (!rd) acb_mul_2exp_si(pp, pp, -2);
|
|
acb_mul_2exp_si(AA, AA, -2);
|
|
|
|
if (!rd)
|
|
{
|
|
/* d = (sp+sx)(sp+sy)(sp+sz) */
|
|
/* e = 4^(-3k) delta / d^2 */
|
|
/* S += 4^(-k) RC(1, 1+e) / d */
|
|
acb_add(d, sp, sx, wp);
|
|
acb_add(t, sp, sy, wp);
|
|
acb_mul(d, d, t, wp);
|
|
acb_add(t, sp, sz, wp);
|
|
acb_mul(d, d, t, wp);
|
|
|
|
/* E2 = e */
|
|
acb_mul(E2, d, d, wp);
|
|
acb_div(E2, delta, E2, wp);
|
|
acb_mul_2exp_si(E2, E2, -6 * k);
|
|
|
|
acb_elliptic_rc1(E4, E2, wp);
|
|
acb_div(E4, E4, d, wp);
|
|
acb_mul_2exp_si(E4, E4, -2 * k);
|
|
|
|
acb_add(S, S, E4, wp);
|
|
}
|
|
else
|
|
{
|
|
acb_mul(t, sz, zz, wp);
|
|
acb_mul_2exp_si(t, t, 2);
|
|
acb_inv(t, t, wp);
|
|
acb_mul_2exp_si(t, t, -2 * k);
|
|
acb_mul_2exp_si(t, t, -1);
|
|
|
|
acb_add(S, S, t, wp);
|
|
}
|
|
|
|
/* Close enough? */
|
|
acb_sub(t, xx, yy, wp);
|
|
acb_get_mag(err, t);
|
|
acb_sub(t, xx, zz, wp);
|
|
acb_get_mag(err2, t);
|
|
mag_max(err, err, err2);
|
|
if (!rd)
|
|
{
|
|
acb_sub(t, xx, pp, wp);
|
|
acb_get_mag(err2, t);
|
|
mag_max(err, err, err2);
|
|
}
|
|
acb_get_mag_lower(err2, xx);
|
|
mag_div(err, err, err2);
|
|
|
|
mag_pow_ui(err, err, 8);
|
|
|
|
if (mag_cmp_2exp_si(err, -prec) < 0 ||
|
|
(k > 2 && mag_cmp(err, prev_err) > 0))
|
|
{
|
|
k++;
|
|
break;
|
|
}
|
|
|
|
mag_set(prev_err, err);
|
|
}
|
|
|
|
/* X = (A-x)/(4^k AA) */
|
|
/* Y = (A-y)/(4^k AA) */
|
|
/* Z = (A-z)/(4^k AA) */
|
|
/* P = (-X-Y-Z)/2 */
|
|
acb_mul_2exp_si(t, AA, 2 * k);
|
|
acb_inv(t, t, prec);
|
|
acb_sub(X, A, x, prec);
|
|
acb_mul(X, X, t, prec);
|
|
acb_sub(Y, A, y, prec);
|
|
acb_mul(Y, Y, t, prec);
|
|
acb_sub(Z, A, z, prec);
|
|
acb_mul(Z, Z, t, prec);
|
|
acb_add(P, X, Y, prec);
|
|
acb_add(P, P, Z, prec);
|
|
acb_neg(P, P);
|
|
acb_mul_2exp_si(P, P, -1);
|
|
|
|
/* todo: improve for R_D */
|
|
/* E2 = XY + XZ + YZ - 3 P^2 */
|
|
/* E3 = XYZ + 2 E2 P + 4 P^3 */
|
|
/* E4 = (2 XYZ + E2 P + 3 P^3) P */
|
|
/* E5 = XYZP^2 */
|
|
|
|
acb_mul(t, P, P, prec); /* t = P^2 */
|
|
|
|
acb_mul(E2, X, Y, prec);
|
|
acb_mul(E3, E2, Z, prec);
|
|
acb_mul_2exp_si(E4, E3, 1);
|
|
acb_mul(E5, E3, t, prec);
|
|
|
|
acb_add(sx, X, Y, prec);
|
|
acb_addmul(E2, sx, Z, prec);
|
|
acb_submul_ui(E2, t, 3, prec);
|
|
|
|
acb_mul(sx, E2, P, prec);
|
|
acb_add(E4, E4, sx, prec);
|
|
acb_mul_2exp_si(sx, sx, 1);
|
|
acb_add(E3, E3, sx, prec);
|
|
|
|
acb_mul(t, t, P, prec); /* t = P^3 */
|
|
acb_addmul_ui(E3, t, 4, prec);
|
|
acb_addmul_ui(E4, t, 3, prec);
|
|
acb_mul(E4, E4, P, prec);
|
|
|
|
/* Error bound. */
|
|
acb_get_mag(err, X);
|
|
acb_get_mag(err2, Y);
|
|
mag_max(err, err, err2);
|
|
acb_get_mag(err2, Z);
|
|
mag_max(err, err, err2);
|
|
acb_get_mag(err2, P);
|
|
mag_max(err, err, err2);
|
|
mag_mul_ui(err, err, 9);
|
|
mag_mul_2exp_si(err, err, -3);
|
|
mag_geom_series(err, err, 8);
|
|
mag_mul_2exp_si(err, err, 1);
|
|
|
|
/*
|
|
1 + (-255255*E2**3 + 675675*E2**2*E3 + 417690*E2**2 - 706860*E2*E3
|
|
+ 612612*E2*E4 - 540540*E2*E5 - 875160*E2 + 306306*E3**2 - 540540*E3*E4
|
|
+ 680680*E3 - 556920*E4 + 471240*E5)/4084080
|
|
=
|
|
1 + (E2*(E2*(-255255*E2 + 675675*E3 + 417690) - 706860*E3
|
|
+ 612612*E4 - 540540*E5 - 875160) + E3*(306306*E3 - 540540*E4
|
|
+ 680680) - 556920*E4 + 471240*E5)/4084080
|
|
*/
|
|
acb_set_ui(sx, 417690);
|
|
acb_addmul_ui(sx, E3, 675675, prec);
|
|
acb_submul_ui(sx, E2, 255255, prec);
|
|
acb_mul(sx, sx, E2, prec);
|
|
acb_submul_ui(sx, E3, 706860, prec);
|
|
acb_addmul_ui(sx, E4, 612612, prec);
|
|
acb_submul_ui(sx, E5, 540540, prec);
|
|
acb_sub_ui(sx, sx, 875160, prec);
|
|
acb_mul(sx, sx, E2, prec);
|
|
|
|
acb_set_ui(sy, 680680);
|
|
acb_submul_ui(sy, E4, 540540, prec);
|
|
acb_addmul_ui(sy, E3, 306306, prec);
|
|
acb_addmul(sx, sy, E3, prec);
|
|
|
|
acb_addmul_ui(sx, E5, 471240, prec);
|
|
acb_submul_ui(sx, E4, 556920, prec);
|
|
acb_div_ui(sx, sx, 4084080, prec);
|
|
|
|
acb_add_ui(sx, sx, 1, prec);
|
|
|
|
if (acb_is_real(X) && acb_is_real(Y) && acb_is_real(Z))
|
|
arb_add_error_mag(acb_realref(sx), err);
|
|
else
|
|
acb_add_error_mag(sx, err);
|
|
|
|
acb_rsqrt(t, AA, prec);
|
|
acb_div(t, t, AA, prec);
|
|
acb_mul_2exp_si(t, t, -2 * k);
|
|
acb_mul(t, t, sx, prec);
|
|
|
|
acb_addmul_ui(t, S, 6, prec);
|
|
|
|
acb_set(res, t);
|
|
|
|
acb_clear(xx); acb_clear(yy); acb_clear(zz); acb_clear(pp);
|
|
acb_clear(sx); acb_clear(sy); acb_clear(sz); acb_clear(sp);
|
|
acb_clear(S); acb_clear(A); acb_clear(AA);
|
|
acb_clear(X); acb_clear(Y); acb_clear(Z); acb_clear(P);
|
|
acb_clear(E2); acb_clear(E3); acb_clear(E4); acb_clear(E5);
|
|
acb_clear(t); acb_clear(d); acb_clear(delta);
|
|
mag_clear(err);
|
|
mag_clear(err2);
|
|
mag_clear(prev_err);
|
|
}
|
|
|