void mag_sqrt(mag_t y, const mag_t x) { if (mag_is_special(x)) { mag_set(y, x); } else { double t; fmpz e; t = MAG_MAN(x) * ldexp(1.0, -MAG_BITS); e = MAG_EXP(x); if (!COEFF_IS_MPZ(e)) { if (e % 2 != 0) { e = (e - 1) >> 1; t *= 2.0; } else { e >>= 1; } t = sqrt(t) * (1 + 1e-13); mag_set_d_2exp_fmpz(y, t, &e); }
void mag_expinv(mag_t res, const mag_t x) { if (mag_is_zero(x)) { mag_one(res); } else if (mag_is_inf(x)) { mag_zero(res); } else if (fmpz_sgn(MAG_EXPREF(x)) <= 0) { mag_one(res); } else if (fmpz_cmp_ui(MAG_EXPREF(x), 2 * MAG_BITS) > 0) { fmpz_t t; fmpz_init(t); /* If x > 2^60, exp(-x) < 2^(-2^60 / log(2)) */ /* -1/log(2) < -369/256 */ fmpz_set_si(t, -369); fmpz_mul_2exp(t, t, 2 * MAG_BITS - 8); mag_one(res); mag_mul_2exp_fmpz(res, res, t); fmpz_clear(t); } else { fmpz_t t; slong e = MAG_EXP(x); fmpz_init(t); fmpz_set_ui(t, MAG_MAN(x)); if (e >= MAG_BITS) fmpz_mul_2exp(t, t, e - MAG_BITS); else fmpz_tdiv_q_2exp(t, t, MAG_BITS - e); /* upper bound for 1/e */ mag_set_ui_2exp_si(res, 395007543, -30); mag_pow_fmpz(res, res, t); fmpz_clear(t); } }
double mag_get_d(const mag_t z) { if (mag_is_zero(z)) { return 0.0; } else if (mag_is_inf(z)) { return D_INF; } else if (MAG_EXP(z) < -1000 || MAG_EXP(z) > 1000) { if (fmpz_sgn(MAG_EXPREF(z)) < 0) return ldexp(1.0, -1000); else return D_INF; } else { return ldexp(MAG_MAN(z), MAG_EXP(z) - MAG_BITS); } }
static __inline__ long rec_fac_bound_2exp_si(slong n) { if (n < TABSIZE) { return rec_fac_bound_2exp_si_tab[n]; } else { mag_t t; mag_init(t); mag_rfac_ui(t, n); /* todo: check for overflow */ return MAG_EXP(t); } }
void mag_set_d_lower(mag_t z, double c) { if (c < 0.0) c = -c; if (c == 0.0 || (c != c)) { mag_zero(z); } else if (c == D_INF) { mag_inf(z); } else { _fmpz_demote(MAG_EXPREF(z)); MAG_SET_D_2EXP_LOWER(MAG_MAN(z), MAG_EXP(z), c, 0); } }
void mag_rfac_ui(mag_t z, ulong n) { if (n < MAG_FAC_TABLE_NUM) { _fmpz_demote(MAG_EXPREF(z)); MAG_EXP(z) = mag_rfac_tab[n * 2]; MAG_MAN(z) = mag_rfac_tab[n * 2 + 1]; } else { double x = n; x = ceil((((x+0.5)*mag_d_log_lower_bound(x) - x) * 1.4426950408889634074) * -0.9999999); /* x + 1 could round down for huge x, but this doesn't matter as long as the value was perturbed up above */ fmpz_set_d(MAG_EXPREF(z), x + 1); MAG_MAN(z) = MAG_ONE_HALF; } }
slong _arb_mat_exp_choose_N(const mag_t norm, slong prec) { if (mag_is_special(norm) || mag_cmp_2exp_si(norm, 30) > 0 || mag_cmp_2exp_si(norm, -prec) < 0) { return 1; } else if (mag_cmp_2exp_si(norm, -300) < 0) { slong N = -MAG_EXP(norm); return (prec + N - 1) / N; } else { double c, t; c = mag_get_d(norm); t = d_lambertw(prec * LOG2_OVER_E / c); t = c * exp(t + 1.0); return FLINT_MIN((slong) (t + 1.0), 2 * prec); } }
void _arb_sin_cos_generic(arb_t s, arb_t c, const arf_t x, const mag_t xrad, slong prec) { int want_sin, want_cos; slong maglim; want_sin = (s != NULL); want_cos = (c != NULL); if (arf_is_zero(x) && mag_is_zero(xrad)) { if (want_sin) arb_zero(s); if (want_cos) arb_one(c); return; } if (!arf_is_finite(x) || !mag_is_finite(xrad)) { if (arf_is_nan(x)) { if (want_sin) arb_indeterminate(s); if (want_cos) arb_indeterminate(c); } else { if (want_sin) arb_zero_pm_one(s); if (want_cos) arb_zero_pm_one(c); } return; } maglim = FLINT_MAX(65536, 4 * prec); if (mag_cmp_2exp_si(xrad, -16) > 0 || arf_cmpabs_2exp_si(x, maglim) > 0) { _arb_sin_cos_wide(s, c, x, xrad, prec); return; } if (arf_cmpabs_2exp_si(x, -(prec/2) - 2) <= 0) { mag_t t, u, v; mag_init(t); mag_init(u); mag_init(v); arf_get_mag(t, x); mag_add(t, t, xrad); mag_mul(u, t, t); /* |sin(z)-z| <= z^3/6 */ if (want_sin) { arf_set(arb_midref(s), x); mag_set(arb_radref(s), xrad); arb_set_round(s, s, prec); mag_mul(v, u, t); mag_div_ui(v, v, 6); arb_add_error_mag(s, v); } /* |cos(z)-1| <= z^2/2 */ if (want_cos) { arf_one(arb_midref(c)); mag_mul_2exp_si(arb_radref(c), u, -1); } mag_clear(t); mag_clear(u); mag_clear(v); return; } if (mag_is_zero(xrad)) { arb_sin_cos_arf_generic(s, c, x, prec); } else { mag_t t; slong exp, radexp; mag_init_set(t, xrad); exp = arf_abs_bound_lt_2exp_si(x); radexp = MAG_EXP(xrad); if (radexp < MAG_MIN_LAGOM_EXP || radexp > MAG_MAX_LAGOM_EXP) radexp = MAG_MIN_LAGOM_EXP; if (want_cos && exp < -2) prec = FLINT_MIN(prec, 20 - FLINT_MAX(exp, radexp) - radexp); else prec = FLINT_MIN(prec, 20 - radexp); arb_sin_cos_arf_generic(s, c, x, prec); /* todo: could use quadratic bound */ if (want_sin) mag_add(arb_radref(s), arb_radref(s), t); if (want_cos) mag_add(arb_radref(c), arb_radref(c), t); mag_clear(t); } }
void arb_mat_exp(arb_mat_t B, const arb_mat_t A, slong prec) { slong i, j, dim, wp, N, q, r; mag_t norm, err; arb_mat_t T; dim = arb_mat_nrows(A); if (dim != arb_mat_ncols(A)) { flint_printf("arb_mat_exp: a square matrix is required!\n"); abort(); } if (dim == 0) { return; } else if (dim == 1) { arb_exp(arb_mat_entry(B, 0, 0), arb_mat_entry(A, 0, 0), prec); return; } wp = prec + 3 * FLINT_BIT_COUNT(prec); mag_init(norm); mag_init(err); arb_mat_init(T, dim, dim); arb_mat_bound_inf_norm(norm, A); if (mag_is_zero(norm)) { arb_mat_one(B); } else { q = pow(wp, 0.25); /* wanted magnitude */ if (mag_cmp_2exp_si(norm, 2 * wp) > 0) /* too big */ r = 2 * wp; else if (mag_cmp_2exp_si(norm, -q) < 0) /* tiny, no need to reduce */ r = 0; else r = FLINT_MAX(0, q + MAG_EXP(norm)); /* reduce to magnitude 2^(-r) */ arb_mat_scalar_mul_2exp_si(T, A, -r); mag_mul_2exp_si(norm, norm, -r); N = _arb_mat_exp_choose_N(norm, wp); mag_exp_tail(err, norm, N); _arb_mat_exp_taylor(B, T, N, wp); for (i = 0; i < dim; i++) for (j = 0; j < dim; j++) arb_add_error_mag(arb_mat_entry(B, i, j), err); for (i = 0; i < r; i++) { arb_mat_mul(T, B, B, wp); arb_mat_swap(T, B); } for (i = 0; i < dim; i++) for (j = 0; j < dim; j++) arb_set_round(arb_mat_entry(B, i, j), arb_mat_entry(B, i, j), prec); } mag_clear(norm); mag_clear(err); arb_mat_clear(T); }
void acb_hypgeom_u_asymp(acb_t res, const acb_t a, const acb_t b, const acb_t z, slong n, slong prec) { acb_struct aa[3]; acb_t s, t, w, winv; int R, p, q, is_real, is_terminating; slong n_terminating; if (!acb_is_finite(a) || !acb_is_finite(b) || !acb_is_finite(z)) { acb_indeterminate(res); return; } acb_init(aa); acb_init(aa + 1); acb_init(aa + 2); acb_init(s); acb_init(t); acb_init(w); acb_init(winv); is_terminating = 0; n_terminating = WORD_MAX; /* special case, for incomplete gamma [todo: also when they happen to be exact and with difference 1...] */ if (a == b) { acb_set(aa, a); p = 1; q = 0; } else { acb_set(aa, a); acb_sub(aa + 1, a, b, prec); acb_add_ui(aa + 1, aa + 1, 1, prec); acb_one(aa + 2); p = 2; q = 1; } if (acb_is_nonpositive_int(aa)) { is_terminating = 1; if (arf_cmpabs_ui(arb_midref(acb_realref(aa)), prec) < 0) n_terminating = 1 - arf_get_si(arb_midref(acb_realref(aa)), ARF_RND_DOWN); } if (p == 2 && acb_is_nonpositive_int(aa + 1)) { is_terminating = 1; if (arf_cmpabs_ui(arb_midref(acb_realref(aa + 1)), n_terminating) < 0) n_terminating = 1 - arf_get_si(arb_midref(acb_realref(aa + 1)), ARF_RND_DOWN); } acb_neg(w, z); acb_inv(w, w, prec); acb_neg(winv, z); /* low degree polynomial -- no need to try to terminate sooner */ if (is_terminating && n_terminating < 8) { acb_hypgeom_pfq_sum_invz(s, t, aa, p, aa + p, q, w, winv, n_terminating, prec); acb_set(res, s); } else { mag_t C1, Cn, alpha, nu, sigma, rho, zinv, tmp, err; mag_init(C1); mag_init(Cn); mag_init(alpha); mag_init(nu); mag_init(sigma); mag_init(rho); mag_init(zinv); mag_init(tmp); mag_init(err); acb_hypgeom_u_asymp_bound_factors(&R, alpha, nu, sigma, rho, zinv, a, b, z); is_real = acb_is_real(a) && acb_is_real(b) && acb_is_real(z) && (is_terminating || arb_is_positive(acb_realref(z))); if (R == 0) { /* if R == 0, the error bound is infinite unless terminating */ if (is_terminating && n_terminating < prec) { acb_hypgeom_pfq_sum_invz(s, t, aa, p, aa + p, q, w, winv, n_terminating, prec); acb_set(res, s); } else { acb_indeterminate(res); } } else { /* C1 */ acb_hypgeom_mag_Cn(C1, R, nu, sigma, 1); /* err = 2 * alpha * exp(...) */ mag_mul(tmp, C1, rho); mag_mul(tmp, tmp, alpha); mag_mul(tmp, tmp, zinv); mag_mul_2exp_si(tmp, tmp, 1); mag_exp(err, tmp); mag_mul(err, err, alpha); mag_mul_2exp_si(err, err, 1); /* choose n automatically */ if (n < 0) { slong moreprec; /* take err into account when finding truncation point */ /* we should take Cn into account as well, but this depends on n which is to be determined; it's easier to look only at exp(...) which should be larger anyway */ if (mag_cmp_2exp_si(err, 10 * prec) > 0) moreprec = 10 * prec; else if (mag_cmp_2exp_si(err, 0) < 0) moreprec = 0; else moreprec = MAG_EXP(err); n = acb_hypgeom_pfq_choose_n_max(aa, p, aa + p, q, w, prec + moreprec, FLINT_MIN(WORD_MAX / 2, 50 + 10.0 * prec)); } acb_hypgeom_pfq_sum_invz(s, t, aa, p, aa + p, q, w, winv, n, prec); /* add error bound, if not terminating */ if (!(is_terminating && n == n_terminating)) { acb_hypgeom_mag_Cn(Cn, R, nu, sigma, n); mag_mul(err, err, Cn); /* nth term * factor */ acb_get_mag(tmp, t); mag_mul(err, err, tmp); if (is_real) arb_add_error_mag(acb_realref(s), err); else acb_add_error_mag(s, err); } acb_set(res, s); } mag_clear(C1); mag_clear(Cn); mag_clear(alpha); mag_clear(nu); mag_clear(sigma); mag_clear(rho); mag_clear(zinv); mag_clear(tmp); mag_clear(err); } acb_clear(aa); acb_clear(aa + 1); acb_clear(aa + 2); acb_clear(s); acb_clear(t); acb_clear(w); acb_clear(winv); }
/* note: z should be exact here */ void acb_lambertw_main(acb_t res, const acb_t z, const acb_t ez1, const fmpz_t k, int flags, slong prec) { acb_t w, t, oldw, ew; mag_t err; slong i, wp, accuracy, ebits, kbits, mbits, wp_initial, extraprec; int have_ew; acb_init(t); acb_init(w); acb_init(oldw); acb_init(ew); mag_init(err); /* We need higher precision for large k, large exponents, or very close to the branch point at -1/e. todo: we should be recomputing ez1 to higher precision when close... */ acb_get_mag(err, z); if (fmpz_is_zero(k) && mag_cmp_2exp_si(err, 0) < 0) ebits = 0; else ebits = fmpz_bits(MAG_EXPREF(err)); if (fmpz_is_zero(k) || (fmpz_is_one(k) && arb_is_negative(acb_imagref(z))) || (fmpz_equal_si(k, -1) && arb_is_nonnegative(acb_imagref(z)))) { acb_get_mag(err, ez1); mbits = -MAG_EXP(err); mbits = FLINT_MAX(mbits, 0); mbits = FLINT_MIN(mbits, prec); } else { mbits = 0; } kbits = fmpz_bits(k); extraprec = FLINT_MAX(ebits, kbits); extraprec = FLINT_MAX(extraprec, mbits); wp = wp_initial = 40 + extraprec; accuracy = acb_lambertw_initial(w, z, ez1, k, wp_initial); mag_zero(arb_radref(acb_realref(w))); mag_zero(arb_radref(acb_imagref(w))); /* We should be able to compute e^w for the final certification during the Halley iteration. */ have_ew = 0; for (i = 0; i < 5 + FLINT_BIT_COUNT(prec + extraprec); i++) { /* todo: should we restart? */ if (!acb_is_finite(w)) break; wp = FLINT_MIN(3 * accuracy, 1.1 * prec + 10); wp = FLINT_MAX(wp, 40); wp += extraprec; acb_set(oldw, w); acb_lambertw_halley_step(t, ew, z, w, wp); /* estimate the error (conservatively) */ acb_sub(w, w, t, wp); acb_get_mag(err, w); acb_set(w, t); acb_add_error_mag(t, err); accuracy = acb_rel_accuracy_bits(t); if (accuracy > 2 * extraprec) accuracy *= 2.9; /* less conservatively */ accuracy = FLINT_MIN(accuracy, wp); accuracy = FLINT_MAX(accuracy, 0); if (accuracy > prec + extraprec) { /* e^w = e^oldw * e^(w-oldw) */ acb_sub(t, w, oldw, wp); acb_exp(t, t, wp); acb_mul(ew, ew, t, wp); have_ew = 1; break; } mag_zero(arb_radref(acb_realref(w))); mag_zero(arb_radref(acb_imagref(w))); } wp = FLINT_MIN(3 * accuracy, 1.1 * prec + 10); wp = FLINT_MAX(wp, 40); wp += extraprec; if (acb_lambertw_check_branch(w, k, wp)) { acb_t u, r, eu1; mag_t err, rad; acb_init(u); acb_init(r); acb_init(eu1); mag_init(err); mag_init(rad); if (have_ew) acb_set(t, ew); else acb_exp(t, w, wp); /* t = w e^w */ acb_mul(t, t, w, wp); acb_sub(r, t, z, wp); /* Bound W' on the straight line path between t and z */ acb_union(u, t, z, wp); arb_const_e(acb_realref(eu1), wp); arb_zero(acb_imagref(eu1)); acb_mul(eu1, eu1, u, wp); acb_add_ui(eu1, eu1, 1, wp); if (acb_lambertw_branch_crossing(u, eu1, k)) { mag_inf(err); } else { acb_lambertw_bound_deriv(err, u, eu1, k); acb_get_mag(rad, r); mag_mul(err, err, rad); } acb_add_error_mag(w, err); acb_set(res, w); acb_clear(u); acb_clear(r); acb_clear(eu1); mag_clear(err); mag_clear(rad); } else { acb_indeterminate(res); } acb_clear(t); acb_clear(w); acb_clear(oldw); acb_clear(ew); mag_clear(err); }
void mag_log1p(mag_t z, const mag_t x) { if (mag_is_special(x)) { if (mag_is_zero(x)) mag_zero(z); else mag_inf(z); } else { fmpz exp = MAG_EXP(x); if (!COEFF_IS_MPZ(exp)) { /* Quick bound by x */ if (exp < -10) { mag_set(z, x); return; } else if (exp < 1000) { double t; t = ldexp(MAG_MAN(x), exp - MAG_BITS); t = (1.0 + t) * (1 + 1e-14); t = mag_d_log_upper_bound(t); mag_set_d(z, t); return; } } else if (fmpz_sgn(MAG_EXPREF(x)) < 0) { /* Quick bound by x */ mag_set(z, x); return; } /* Now we must have x >= 2^1000 */ /* Use log(2^(exp-1) * (2*v)) = exp*log(2) + log(2*v) */ { double t; fmpz_t b; mag_t u; mag_init(u); fmpz_init(b); /* incrementing the mantissa gives an upper bound for x+1 */ t = ldexp(MAG_MAN(x) + 1, 1 - MAG_BITS); t = mag_d_log_upper_bound(t); mag_set_d(u, t); /* log(2) < 744261118/2^30 */ _fmpz_add_fast(b, MAG_EXPREF(x), -1); fmpz_mul_ui(b, b, 744261118); mag_set_fmpz(z, b); _fmpz_add_fast(MAG_EXPREF(z), MAG_EXPREF(z), -30); mag_add(z, z, u); mag_clear(u); fmpz_clear(b); } } }