void
acb_modular_lambda(acb_t r, const acb_t tau, long prec)
{
psl2z_t g;
arf_t one_minus_eps;
acb_t tau_prime, q;
acb_struct thetas[4];
int R[4], S[4], C;
int Rsum, qpower;
psl2z_init(g);
arf_init(one_minus_eps);
acb_init(tau_prime);
acb_init(q);
acb_init(thetas + 0);
acb_init(thetas + 1);
acb_init(thetas + 2);
acb_init(thetas + 3);
arf_set_ui_2exp_si(one_minus_eps, 63, -6);
acb_modular_fundamental_domain_approx(tau_prime, g, tau,
one_minus_eps, prec);
acb_modular_theta_transform(R, S, &C, g);
acb_exp_pi_i(q, tau_prime, prec);
acb_modular_theta_const_sum(thetas + 1, thetas + 2, thetas + 3, q, prec);
acb_zero(thetas + 0);
/* divide the transformation factors */
Rsum = 4 * (R[1] - R[2]);
/* possible factor [q^(+/- 1/4)]^4 needed for theta_1^4 or theta_2^4 */
qpower = (S[1] == 0 || S[1] == 1) - (S[2] == 0 || S[2] == 1);
acb_div(r, thetas + S[1], thetas + S[2], prec);
acb_mul(r, r, r, prec);
acb_mul(r, r, r, prec);
if ((Rsum & 7) == 4)
acb_neg(r, r);
if (qpower == 1)
acb_mul(r, r, q, prec);
else if (qpower == -1)
acb_div(r, r, q, prec);
psl2z_clear(g);
arf_clear(one_minus_eps);
acb_clear(tau_prime);
acb_clear(q);
acb_clear(thetas + 0);
acb_clear(thetas + 1);
acb_clear(thetas + 2);
acb_clear(thetas + 3);
}
void
acb_modular_delta(acb_t z, const acb_t tau, long prec)
{
psl2z_t g;
arf_t one_minus_eps;
acb_t tau_prime, t1, t2, t3, t4, q;
psl2z_init(g);
arf_init(one_minus_eps);
acb_init(tau_prime);
acb_init(t1);
acb_init(t2);
acb_init(t3);
acb_init(t4);
acb_init(q);
arf_set_ui_2exp_si(one_minus_eps, 63, -6);
acb_modular_fundamental_domain_approx(tau_prime, g, tau,
one_minus_eps, prec);
acb_exp_pi_i(q, tau_prime, prec);
acb_modular_theta_const_sum(t2, t3, t4, q, prec);
/* (t2 t3 t4) ^ 8 * q^2 */
acb_mul(t1, t2, t3, prec);
acb_mul(t1, t1, t4, prec);
acb_mul(t1, t1, t1, prec);
acb_mul(t1, t1, t1, prec);
acb_mul(t1, t1, q, prec);
acb_mul(t1, t1, t1, prec);
acb_mul_2exp_si(t1, t1, -8);
if (!fmpz_is_zero(&g->c))
{
acb_mul_fmpz(t2, tau, &g->c, prec);
acb_add_fmpz(t2, t2, &g->d, prec);
acb_pow_ui(t2, t2, 12, prec);
acb_div(t1, t1, t2, prec);
}
acb_set(z, t1);
psl2z_clear(g);
arf_clear(one_minus_eps);
acb_clear(tau_prime);
acb_clear(t1);
acb_clear(t2);
acb_clear(t3);
acb_clear(t4);
acb_clear(q);
}
void
acb_modular_eisenstein(acb_ptr r, const acb_t tau, slong len, slong prec)
{
psl2z_t g;
arf_t one_minus_eps;
acb_t tau_prime, t1, t2, t3, t4, q;
slong m, n;
if (len < 1)
return;
psl2z_init(g);
arf_init(one_minus_eps);
acb_init(tau_prime);
acb_init(t1);
acb_init(t2);
acb_init(t3);
acb_init(t4);
acb_init(q);
arf_set_ui_2exp_si(one_minus_eps, 63, -6);
acb_modular_fundamental_domain_approx(tau_prime, g, tau,
one_minus_eps, prec);
acb_exp_pi_i(q, tau_prime, prec);
acb_modular_theta_const_sum(t2, t3, t4, q, prec);
/* fourth powers of the theta functions (a, b, c) */
acb_mul(t2, t2, t2, prec);
acb_mul(t2, t2, t2, prec);
acb_mul(t2, t2, q, prec);
acb_mul(t3, t3, t3, prec);
acb_mul(t3, t3, t3, prec);
acb_mul(t4, t4, t4, prec);
acb_mul(t4, t4, t4, prec);
/* c2 = pi^4 * (a^8 + b^8 + c^8) / 30 */
/* c3 = pi^6 * (b^12 + c^12 - 3a^8 * (b^4+c^4)) / 180 */
/* r = a^8 */
acb_mul(r, t2, t2, prec);
if (len > 1)
{
/* r[1] = -3 a^8 * (b^4 + c^4) */
acb_add(r + 1, t3, t4, prec);
acb_mul(r + 1, r + 1, r, prec);
acb_mul_si(r + 1, r + 1, -3, prec);
}
/* b^8 */
acb_mul(t1, t3, t3, prec);
acb_add(r, r, t1, prec);
/* b^12 */
if (len > 1)
acb_addmul(r + 1, t1, t3, prec);
/* c^8 */
acb_mul(t1, t4, t4, prec);
acb_add(r, r, t1, prec);
/* c^12 */
if (len > 1)
acb_addmul(r + 1, t1, t4, prec);
acb_const_pi(t1, prec);
acb_mul(t1, t1, t1, prec);
acb_mul(t2, t1, t1, prec);
acb_mul(r, r, t2, prec);
acb_div_ui(r, r, 30, prec);
if (len > 1)
{
acb_mul(t2, t2, t1, prec);
acb_mul(r + 1, r + 1, t2, prec);
acb_div_ui(r + 1, r + 1, 189, prec);
}
/* apply modular transformation */
if (!fmpz_is_zero(&g->c))
{
acb_mul_fmpz(t1, tau, &g->c, prec);
acb_add_fmpz(t1, t1, &g->d, prec);
acb_inv(t1, t1, prec);
acb_mul(t1, t1, t1, prec);
acb_mul(t2, t1, t1, prec);
acb_mul(r, r, t2, prec);
if (len > 1)
{
acb_mul(t2, t1, t2, prec);
acb_mul(r + 1, r + 1, t2, prec);
}
}
/* compute more coefficients using recurrence */
for (n = 4; n < len + 2; n++)
{
acb_zero(r + n - 2);
m = 2;
for (m = 2; m * 2 < n; m++)
acb_addmul(r + n - 2, r + m - 2, r + n - m - 2, prec);
acb_mul_2exp_si(r + n - 2, r + n - 2, 1);
if (n % 2 == 0)
acb_addmul(r + n - 2, r + n / 2 - 2, r + n / 2 - 2, prec);
acb_mul_ui(r + n - 2, r + n - 2, 3, prec);
acb_div_ui(r + n - 2, r + n - 2, (2 * n + 1) * (n - 3), prec);
}
/* convert c's to G's */
for (n = 0; n < len; n++)
acb_div_ui(r + n, r + n, 2 * n + 3, prec);
psl2z_clear(g);
arf_clear(one_minus_eps);
acb_clear(tau_prime);
acb_clear(t1);
acb_clear(t2);
acb_clear(t3);
acb_clear(t4);
acb_clear(q);
}
int main()
{
slong iter;
flint_rand_t state;
flint_printf("fundamental_domain_approx....");
fflush(stdout);
flint_randinit(state);
for (iter = 0; iter < 10000 * arb_test_multiplier(); iter++)
{
fmpq_t x, y;
psl2z_t g;
arf_t one_minus_eps, tol;
acb_t z, w, w2;
arb_t t;
slong prec;
fmpq_init(x);
fmpq_init(y);
psl2z_init(g);
acb_init(z);
acb_init(w);
acb_init(w2);
arf_init(one_minus_eps);
arf_init(tol);
arb_init(t);
/* pick an exact point in the upper half plane */
fmpq_randtest(x, state, 1 + n_randint(state, 500));
do {
fmpq_randtest(y, state, 1 + n_randint(state, 500));
} while (fmpz_sgn(fmpq_numref(y)) <= 0);
/* pick a tolerance */
arf_set_ui_2exp_si(tol, 1, -(slong) n_randint(state, 500));
/* now increase the precision until convergence */
for (prec = 32; ; prec *= 2)
{
if (prec > 16384)
{
flint_printf("FAIL (no convergence)\n");
flint_printf("x = "); fmpq_print(x); flint_printf("\n\n");
flint_printf("y = "); fmpq_print(y); flint_printf("\n\n");
flint_printf("z = "); acb_printd(z, 50); flint_printf("\n\n");
flint_printf("w = "); acb_printd(w, 50); flint_printf("\n\n");
flint_printf("w2 = "); acb_printd(w2, 50); flint_printf("\n\n");
flint_printf("g = "); psl2z_print(g); flint_printf("\n\n");
abort();
}
arb_set_fmpq(acb_realref(z), x, prec);
arb_set_fmpq(acb_imagref(z), y, prec);
arf_set_ui_2exp_si(one_minus_eps, 1, -prec / 4);
arf_sub_ui(one_minus_eps, one_minus_eps, 1, prec, ARF_RND_DOWN);
arf_neg(one_minus_eps, one_minus_eps);
acb_modular_fundamental_domain_approx(w, g, z, one_minus_eps, prec);
acb_modular_transform(w2, g, z, prec);
if (!psl2z_is_correct(g) || !acb_overlaps(w, w2))
{
flint_printf("FAIL (incorrect transformation)\n");
flint_printf("x = "); fmpq_print(x); flint_printf("\n\n");
flint_printf("y = "); fmpq_print(y); flint_printf("\n\n");
flint_printf("z = "); acb_printd(z, 50); flint_printf("\n\n");
flint_printf("w = "); acb_printd(w, 50); flint_printf("\n\n");
flint_printf("w2 = "); acb_printd(w2, 50); flint_printf("\n\n");
flint_printf("g = "); psl2z_print(g); flint_printf("\n\n");
abort();
}
/* success */
if (acb_modular_is_in_fundamental_domain(w, tol, prec))
break;
}
/* check that g^(-1) * w contains x+yi */
psl2z_inv(g, g);
acb_modular_transform(w2, g, w, 2 + n_randint(state, 1000));
if (!arb_contains_fmpq(acb_realref(w2), x) ||
!arb_contains_fmpq(acb_imagref(w2), y))
{
flint_printf("FAIL (inverse containment)\n");
flint_printf("x = "); fmpq_print(x); flint_printf("\n\n");
flint_printf("y = "); fmpq_print(y); flint_printf("\n\n");
flint_printf("z = "); acb_printd(z, 50); flint_printf("\n\n");
flint_printf("w = "); acb_printd(w, 50); flint_printf("\n\n");
flint_printf("w2 = "); acb_printd(w2, 50); flint_printf("\n\n");
flint_printf("g = "); psl2z_print(g); flint_printf("\n\n");
abort();
}
fmpq_clear(x);
fmpq_clear(y);
psl2z_clear(g);
acb_clear(z);
acb_clear(w);
acb_clear(w2);
arf_clear(one_minus_eps);
arf_clear(tol);
arb_clear(t);
}
flint_randclear(state);
flint_cleanup();
flint_printf("PASS\n");
return EXIT_SUCCESS;
}
