static int fill_spougecache(size_t A, int accuracy, long eps)
{
int err, n;
mp_float factrl, e, t1, t2, t3, pi;
size_t start;
if ((err =
mpf_init_multi(eps, &factrl, &e, &t1, &t2, &t3, NULL)) != MP_OKAY) {
return err;
}
err = MP_OKAY;
if (spougecache_len < A || spougecache_eps < accuracy) {
//puts("filling spougecache");
if ((err = mpf_const_d(&factrl, 1)) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_const_e(&e)) != MP_OKAY) {
goto _ERR;
}
if (spougecache_len != 0) {
spougecache = realloc(spougecache, (A + 1) * sizeof(mp_float));
if (spougecache == NULL) {
return MP_MEM;
}
start = spougecache_len;
} else {
spougecache = malloc((A + 1) * sizeof(mp_float));
if (spougecache == NULL) {
return MP_MEM;
}
start = 1;
if ((err = mpf_init(&pi, eps)) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_const_pi(&pi)) != MP_OKAY) {
goto _ERR;
}
pi.exp += 1;
if ((err = mpf_init(&(spougecache[0]), eps)) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_sqrt(&pi, &(spougecache[0]))) != MP_OKAY) {
goto _ERR;
}
mpf_clear(&pi);
}
for (n = start; n < (int) A; n++) {
// to avoid the more expensive exp(log(a-n)*(n-0.5))
// TODO: check if exp() is fast enough now
if ((err = mpf_set_int(&t1, (int) (A - n))) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_pow_d(&t1, (int) (n - 1), &t2)) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_sqrt(&t1, &t1)) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_mul(&t2, &t1, &t2)) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_pow_d(&e, (int) (A - n), &t3)) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_mul(&t2, &t3, &t2)) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_init(&(spougecache[n]), eps)) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_div(&t2, &factrl, &(spougecache[n]))) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_set_int(&t1, -n)) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_mul(&factrl, &t1, &factrl)) != MP_OKAY) {
goto _ERR;
}
}
spougecache_eps = accuracy;
spougecache_len = A;
}
_ERR:
mpf_clear_multi(&factrl, &e, &t1, &t2, &t3, NULL);
return err;
}
int mpf_trig_arg_reduct(mp_float * a, mp_float * b, int *k)
{
int err, sign;
mp_float pi, pihalf, piquart, r, x, three, one, K;
long size, oldeps, eps, oldprec, newprec;
if (mpf_iszero(a)) {
*k = 0;
return mpf_copy(a, b);
}
oldeps = a->radix;
eps = oldeps + 10;
err = MP_OKAY;
if ((err =
mpf_init_multi(eps, &pi, &pihalf, &piquart, &r, &x, &three, &one, &K,
NULL)) != MP_OKAY) {
return err;
}
if ((err = mpf_abs(a, &x)) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_normalize_to(&x, eps)) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_const_d(&three, 3)) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_const_pi(&pi)) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_const_pi(&pihalf)) != MP_OKAY) {
goto _ERR;
}
pihalf.exp -= 1;
if ((err = mpf_const_pi(&piquart)) != MP_OKAY) {
goto _ERR;
}
piquart.exp -= 1;
// nothing to do if it is already small enough
if (mpf_cmp(&x, &piquart) != MP_GT) {
if ((err = mpf_copy(a, b)) != MP_OKAY) {
goto _ERR;
}
*k = 0;
goto _ERR;
}
// it starts to get tricky for x < 3pi/4 especially around pi/2
// but not for the reduction part
if ((err = mpf_mul(&three, &piquart, &three)) != MP_OKAY) {
goto _ERR;
}
if (mpf_cmp(&x, &three) == MP_LT) {
if ((err = mpf_sub(&x, &pihalf, &x)) != MP_OKAY) {
goto _ERR;
}
x.mantissa.sign = a->mantissa.sign;
if ((err = mpf_copy(&x, b)) != MP_OKAY) {
goto _ERR;
}
*k = 1;
goto _ERR;
}
sign = a->mantissa.sign;
// size of integer part in bits
size = a->radix + a->exp;
if (size < 0) {
size = 0;
}
// Reduction must be done in precision
// work_precision_(base 2) + log_2(x)
// if we have an integer part
// But the main problem with such large numbers lies in the loss of accuracy
// in the original number. That needs to get caught in the calling function.
oldprec = eps;
if (size > 0) {
newprec = oldprec + size + 3;
} else {
newprec = oldprec + 3;
}
// we need as many digits of pi as there are digits in the integer part of the
// number, so for e.g.: 1e308 we need 308 decimal digits of pi.
// Computing that much may take a while.
// Compute remainder of x/Pi/2
if ((err = mpf_normalize_to(&pi, newprec)) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_const_pi(&pi)) != MP_OKAY) {
goto _ERR;
}
// k = round(x * 2/Pi)
if ((err = mpf_normalize_to(&x, newprec)) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_normalize_to(&K, newprec)) != MP_OKAY) {
goto _ERR;
}
// multiply by two
x.exp += 1;
if ((err = mpf_div(&x, &pi, &K)) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_round(&K, &K)) != MP_OKAY) {
goto _ERR;
}
// undo multiplying by two
x.exp -= 1;
// r = x - k * Pi/2
if ((err = mpf_normalize_to(&r, newprec)) != MP_OKAY) {
goto _ERR;
}
pi.exp -= 1;
if ((err = mpf_mul(&K, &pi, &pi)) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_sub(&x, &pi, &r)) != MP_OKAY) {
goto _ERR;
}
// TODO: check for size of "size" and don't delete pi if "size" is moderate
// mpf_const_pi(NULL);
if ((err =
mp_div_2d(&K.mantissa, abs(K.exp), &K.mantissa, NULL)) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_normalize_to(&r, oldprec)) != MP_OKAY) {
goto _ERR;
}
// we need the last two bits only
*k = K.mantissa.dp[0];
r.mantissa.sign = a->mantissa.sign;
mpf_copy(&r, b);
err = MP_OKAY;
_ERR:
mpf_clear_multi(&pi, &pihalf, &piquart, &r, &x, &three, &one, &K, NULL);
return err;
}
// only (exp(log(gamma(a)))) for now
int mpf_lngamma(mp_float * a, mp_float * b)
{
int oldeps, eps, err, n, accuracy;
size_t A;
mp_float z, ONE, factrl, e, pi, t1, t2, t3, sum;
err = MP_OKAY;
if (mpf_iszero(a)) {
// raise singularity error
return MP_VAL;
}
// Check is expensive and inexact.
// if(mpf_isint(a){...}
// very near zero
if (a->exp + a->radix < -(a->radix)) {
if ((err = mpf_ln(a, b)) != MP_OKAY) {
return err;
}
return err;
}
oldeps = a->radix;
if (reflection == 1) {
// angst-allowance seemed not necessary
// TODO: check if that is really true
eps = oldeps;
} else {
accuracy = oldeps + MP_DIGIT_BIT;
A = (size_t) ceil(0.37714556279552730250018797240191093794 * accuracy);
// We need to compute the coefficients as exact as possible, so
// increase the working precision acccording to the largest coefficient
// TODO: probably too much
eps = ((accuracy * 116) / 100);
if ((err = fill_spougecache(A, accuracy, eps)) != MP_OKAY) {
return err;
}
}
if ((err =
mpf_init_multi(eps, &z, &ONE, &factrl, &e, &t1, &t2, &t3, &sum,
NULL)) != MP_OKAY) {
return err;
}
if ((err = mpf_copy(a, &z)) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_normalize_to(&z, eps)) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_set_int(&ONE, 1)) != MP_OKAY) {
goto _ERR;
}
// printf("splen = %u, A = %u, seps = %ld, acc = %d\n",
// spougecache_len , A , spougecache_eps , accuracy);
if (a->mantissa.sign == MP_NEG) {
// eps = oldeps + 10;
if ((err = mpf_copy(a, &z)) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_normalize_to(&z, eps)) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_init(&pi, eps)) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_const_pi(&pi)) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_normalize_to(&ONE, eps)) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_sub(&ONE, &z, &t1)) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_mul(&pi, &z, &t2)) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_sin(&t2, &t2)) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_div(&pi, &t2, &t2)) != MP_OKAY) {
goto _ERR;
}
t2.mantissa.sign = MP_ZPOS;
if ((err = mpf_ln(&t2, &t2)) != MP_OKAY) {
goto _ERR;
}
reflection = 1;
if ((err = mpf_lngamma(&t1, &t1)) != MP_OKAY) {
goto _ERR;
}
reflection = 0;
if ((err = mpf_sub(&t2, &t1, &t1)) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_normalize_to(&t1, oldeps)) != MP_OKAY) {
goto _ERR;
}
mpf_exch(&t1, b);
goto _ERR;
}
if ((err = mpf_copy(&(spougecache[0]), &sum)) != MP_OKAY) {
goto _ERR;
}
for (n = 1; n < (int) spougecache_len; n++) {
if ((err = mpf_const_d(&t1, n)) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_add(&z, &t1, &t1)) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_div(&(spougecache[n]), &t1, &t1)) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_add(&sum, &t1, &sum)) != MP_OKAY) {
goto _ERR;
}
}
if ((err = mpf_const_d(&t1, (int) spougecache_len)) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_add(&z, &t1, &t1)) != MP_OKAY) {
goto _ERR;
}
// 1/2
ONE.exp -= 1;
//ret = log(sum) + (-(t1)) + log(t1) * (z + 1/2);
// = log(sum) + t2 + log(t1) * (z + 1/2);
// = log(sum) + t2 + log(t1) * t3
if ((err = mpf_neg(&t1, &t2)) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_add(&z, &ONE, &t3)) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_ln(&sum, &sum)) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_ln(&t1, &t1)) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_mul(&t1, &t3, &t3)) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_add(&sum, &t2, &sum)) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_add(&sum, &t3, &sum)) != MP_OKAY) {
goto _ERR;
}
// ret = ret - log(z)
if ((err = mpf_ln(&z, &t1)) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_sub(&sum, &t1, &t1)) != MP_OKAY) {
goto _ERR;
}
if ((err = mpf_normalize_to(&t1, oldeps)) != MP_OKAY) {
goto _ERR;
}
mpf_exch(&t1, b);
_ERR:
mpf_clear_multi(&z, &ONE, &factrl, &e, &t1, &t2, &t3, &sum, NULL);
return err;
}
/* using sin x == \sum_{n=0}^{\infty} ((-1)^n/(2n+1)!) * x^(2n+1) */
int mpf_sin(mp_float *a, mp_float *b)
{
mp_float oldval, tmpovern, tmp, tmpx, res, sqr;
int oddeven, err, itts;
long n;
/* initialize temps */
if ((err = mpf_init_multi(b->radix, &oldval, &tmpx, &tmpovern, &tmp, &res, &sqr, NULL)) != MP_OKAY) {
return err;
}
/* initlialize temps */
/* this is the 1/n! which starts at 1 */
if ((err = mpf_const_d(&tmpovern, 1)) != MP_OKAY) { goto __ERR; }
/* the square of the input, used to save multiplications later */
if ((err = mpf_sqr(a, &sqr)) != MP_OKAY) { goto __ERR; }
/* tmpx starts at the input, so we copy and normalize */
if ((err = mpf_copy(a, &tmpx)) != MP_OKAY) { goto __ERR; }
tmpx.radix = b->radix;
if ((err = mpf_normalize(&tmpx)) != MP_OKAY) { goto __ERR; }
/* the result starts off at a as we skip a term in the series */
if ((err = mpf_copy(&tmpx, &res)) != MP_OKAY) { goto __ERR; }
/* this is the denom counter. Goes up by two per pass */
n = 1;
/* we alternate between adding and subtracting */
oddeven = 1;
/* get number of iterations */
itts = mpf_iterations(b);
while (itts-- > 0) {
if ((err = mpf_copy(&res, &oldval)) != MP_OKAY) { goto __ERR; }
/* compute 1/(2n)! from 1/(2(n-1))! by multiplying by (1/n)(1/(n+1)) */
if ((err = mpf_const_d(&tmp, ++n)) != MP_OKAY) { goto __ERR; }
if ((err = mpf_inv(&tmp, &tmp)) != MP_OKAY) { goto __ERR; }
if ((err = mpf_mul(&tmpovern, &tmp, &tmpovern)) != MP_OKAY) { goto __ERR; }
/* we do this twice */
if ((err = mpf_const_d(&tmp, ++n)) != MP_OKAY) { goto __ERR; }
if ((err = mpf_inv(&tmp, &tmp)) != MP_OKAY) { goto __ERR; }
if ((err = mpf_mul(&tmpovern, &tmp, &tmpovern)) != MP_OKAY) { goto __ERR; }
/* now multiply sqr into tmpx */
if ((err = mpf_mul(&tmpx, &sqr, &tmpx)) != MP_OKAY) { goto __ERR; }
/* now multiply the two */
if ((err = mpf_mul(&tmpx, &tmpovern, &tmp)) != MP_OKAY) { goto __ERR; }
/* now depending on if this is even or odd we add/sub */
oddeven ^= 1;
if (oddeven == 1) {
if ((err = mpf_add(&res, &tmp, &res)) != MP_OKAY) { goto __ERR; }
} else {
if ((err = mpf_sub(&res, &tmp, &res)) != MP_OKAY) { goto __ERR; }
}
if (mpf_cmp(&res, &oldval) == MP_EQ) {
break;
}
}
mpf_exch(&res, b);
__ERR: mpf_clear_multi(&oldval, &tmpx, &tmpovern, &tmp, &res, &sqr, NULL);
return err;
}
