char binetasymptotic(floatnum x, int digits) { floatstruct recsqr; floatstruct sum; floatstruct smd; floatstruct pwr; int i, workprec; if (float_getexponent(x) >= digits) { /* if x is very big, ln(gamma(x)) is dominated by x*ln x and the Binet function does not contribute anything substantial to the final result */ float_setzero(x); return 1; } float_create(&recsqr); float_create(&sum); float_create(&smd); float_create(&pwr); float_copy(&pwr, &c1, EXACT); float_setzero(&sum); float_div(&smd, &c1, &c12, digits+1); workprec = digits - 2*float_getexponent(x)+3; i = 1; if (workprec > 0) { float_mul(&recsqr, x, x, workprec); float_reciprocal(&recsqr, workprec); while (float_getexponent(&smd) > -digits-1 && ++i <= MAXBERNOULLIIDX) { workprec = digits + float_getexponent(&smd) + 3; float_add(&sum, &sum, &smd, digits+1); float_mul(&pwr, &recsqr, &pwr, workprec); float_muli(&smd, &cBernoulliDen[i-1], 2*i*(2*i-1), workprec); float_div(&smd, &pwr, &smd, workprec); float_mul(&smd, &smd, &cBernoulliNum[i-1], workprec); } } else /* sum reduces to the first summand*/ float_move(&sum, &smd); if (i > MAXBERNOULLIIDX) /* x was not big enough for the asymptotic series to converge sufficiently */ float_setnan(x); else float_div(x, &sum, x, digits); float_free(&pwr); float_free(&smd); float_free(&sum); float_free(&recsqr); return i <= MAXBERNOULLIIDX; }
static char _lngamma_prim( floatnum x, floatnum revfactor, int* infinity, int digits) { floatstruct tmp; char result; char odd; *infinity = 0; if (float_getsign(x) > 0) return _lngamma_prim_xgt0(x, revfactor, digits); float_copy(revfactor, x, digits + 2); float_sub(x, &c1, x, digits+2); float_create(&tmp); result = _lngamma_prim_xgt0(x, &tmp, digits); if (result) { float_neg(x); odd = float_isodd(revfactor); _sinpix(revfactor, digits); if (float_iszero(revfactor)) { *infinity = 1; float_setinteger(revfactor, odd? -1 : 1); } else float_mul(&tmp, &tmp, &cPi, digits+2); float_div(revfactor, revfactor, &tmp, digits+2); } float_free(&tmp); return result; }
char _gamma( floatnum x, int digits) { floatstruct tmp; int infinity; char result; if (float_cmp(&cMinus20, x) > 0) { float_create(&tmp); result = _lngamma_prim(x, &tmp, &infinity, digits) && infinity == 0 && _exp(x, digits) && float_div(x, x, &tmp, digits + 1); float_free(&tmp); if (infinity != 0) return _seterror(x, ZeroDivide); if (!result) float_setnan(x); return result; } return _gammagtminus20(x, digits); }
char _gamma0_5( floatnum x, int digits) { floatstruct tmp; int ofs; if (float_getexponent(x) >= 2) return _gamma(x, digits); float_create(&tmp); float_sub(&tmp, x, &c1Div2, EXACT); ofs = float_asinteger(&tmp); float_free(&tmp); if (ofs >= 0) { float_copy(x, &c1Div2, EXACT); if(!_pochhammer_su(x, ofs, digits)) return 0; return float_mul(x, x, &cSqrtPi, digits); } if(!_pochhammer_su(x, -ofs, digits)) return 0; return float_div(x, &cSqrtPi, x, digits); }
/* evaluates arctan x for |x| <= 1 relative error for a 100 digit result is 6e-100 */ void _arctanlt1( floatnum x, int digits) { floatstruct tmp; int reductions; if (float_iszero(x)) return; float_create(&tmp); reductions = 0; while(float_getexponent(x) >= -2) { float_mul(&tmp, x, x, digits); float_add(&tmp, &tmp, &c1, digits+2); float_sqrt(&tmp, digits); float_add(&tmp, &tmp, &c1, digits+1); float_div(x, x, &tmp, digits); ++reductions; } arctannear0(x, digits); for (;reductions-- > 0;) float_add(x, x, x, digits+1); float_free(&tmp); }
static Error _pack2frac( floatnum x, p_ext_seq_desc n, int digits) { floatstruct tmp; int exp; Error result; n->seq.digits -= n->seq.trailing0; n->seq.trailing0 = 0; switch(n->seq.base) { case IO_BASE_NAN: float_setnan(x); break; case IO_BASE_ZERO: float_setzero(x); break; default: if ((result = _pack2int(x, n)) != Success) return result; float_create(&tmp); float_setinteger(&tmp, n->seq.base); _raiseposi(&tmp, &exp, n->seq.digits, digits+2); float_div(x, x, &tmp, digits + 2); float_setexponent(x, float_getexponent(x) - exp); float_free(&tmp); } n->seq.digits += n->seq.trailing0; return Success; }
char float_lb( floatnum x, int digits) { if (!chckmathparam(x, digits)) return 0; if (float_getsign(x) <= 0) return _seterror(x, OutOfDomain); _ln(x, digits); float_div(x, x, &cLn2, digits); return 1; }
Error pack2floatnum( floatnum x, p_number_desc n) { floatstruct tmp; int digits; int saveerr; int saverange; Error result; signed char base; if ((result = _pack2int(x, &n->intpart)) != Success) return result; if (float_isnan(x)) return Success; saveerr = float_geterror(); saverange = float_setrange(MAXEXP); float_create(&tmp); float_move(&tmp, x); float_setzero(x); digits = DECPRECISION - float_getexponent(&tmp); if (digits <= 0 || (result = _pack2frac(x, &n->fracpart, digits)) == Success) float_add(x, x, &tmp, DECPRECISION); if (result != Success) return result; if ((!float_getlength(x)) == 0) /* no zero, no NaN? */ { base = n->prefix.base; float_setinteger(&tmp, base); if (n->exp >= 0) { _raiseposi_(&tmp, n->exp, DECPRECISION + 2); float_mul(x, x, &tmp, DECPRECISION + 2); } else { _raiseposi_(&tmp, -n->exp, DECPRECISION + 2); float_div(x, x, &tmp, DECPRECISION + 2); } } float_free(&tmp); float_setsign(x, n->prefix.sign == IO_SIGN_COMPLEMENT? -1 : n->prefix.sign); float_geterror(); float_seterror(saveerr); float_setrange(saverange); if (!float_isvalidexp(float_getexponent(x))) float_setnan(x); return float_isnan(x)? IOExpOverflow : Success; }
/* evaluates arccos(1+x) for -0.5 <= x <= 0 arccos(1+x) = arctan(sqrt(-x*(2+x))/(1+x)) the relative error of a 100 digit result is < 5e-100 */ void _arccosxplus1lt0_5( floatnum x, int digits) { floatstruct tmp; float_create(&tmp); float_add(&tmp, x, &c2, digits+1); float_mul(x, x, &tmp, digits+1); float_setsign(x, 1); float_sqrt(x, digits); float_sub(&tmp, &tmp, &c1, digits); float_div(x, x, &tmp, digits+1); _arctan(x, digits); float_free(&tmp); }
/* evaluates arcsin x for -0.5 <= x <= 0.5 arcsin x = arctan(x/sqrt(1-x*x)) the relative error of a 100 digit result is < 5e-100 */ void _arcsinlt0_5( floatnum x, int digits) { floatstruct tmp; if (2*float_getexponent(x) < -digits) return; float_create(&tmp); float_mul(&tmp, x, x, digits); float_sub(&tmp, &c1, &tmp, digits); float_sqrt(&tmp, digits); float_div(x, x, &tmp, digits+1); _arctanlt1(x, digits); float_free(&tmp); }
static int _extractexp( floatnum x, int scale, signed char base) { floatstruct pwr; floatstruct fbase; int decprec; int pwrexp; int exp; int logbase; (void)scale; logbase = lgbase(base); decprec = DECPRECISION + 3; exp = (int)(aprxlog10fn(x) * 3.321928095f); if (float_getexponent(x) < 0) exp -= 3; exp /= logbase; if (exp != 0) { float_create(&fbase); float_setinteger(&fbase, base); float_create(&pwr); float_copy(&pwr, &fbase, EXACT); _raiseposi(&pwr, &pwrexp, exp < 0? -exp : exp, decprec); if (float_getexponent(x) < 0) { float_addexp(x, pwrexp); float_mul(x, x, &pwr, decprec); } else { float_addexp(x, -pwrexp); float_div(x, x, &pwr, decprec); } float_free(&pwr); float_free(&fbase); } exp += _checkbounds(x, decprec, base); return exp; }
char float_lg( floatnum x, int digits) { floatstruct tmp; int expx; if (!chckmathparam(x, digits)) return 0; if (float_getsign(x) <= 0) return _seterror(x, OutOfDomain); float_create(&tmp); expx = float_getexponent(x); float_setexponent(x, 0); _ln(x, digits); float_div(x, x, &cLn10, digits); float_setinteger(&tmp, expx); float_add(x, x, &tmp, digits); float_free(&tmp); return 1; }
char _gammagtminus20( floatnum x, int digits) { floatstruct factor; int ofs; char result; float_create(&factor); ofs = _ofs(x, digits+1); float_copy(&factor, x, digits+1); _pochhammer_su(&factor, ofs, digits); float_addi(x, x, ofs, digits+2); result = _lngammabigx(x, digits) && _exp(x, digits) && float_div(x, x, &factor, digits+1); float_free(&factor); if (!result) float_setnan(x); return result; }
void _tanltPiDiv4( floatnum x, int digits) { floatstruct tmp; signed char sgn; if (2*float_getexponent(x)+2 < -digits) /* for small x: tan x approx.== x */ return; float_create(&tmp); sgn = float_getsign(x); _cosminus1ltPiDiv4(x, digits); float_add(&tmp, x, &c2, digits+1); float_mul(x, x, &tmp, digits+1); float_abs(x); float_sqrt(x, digits); float_sub(&tmp, &tmp, &c1, digits); float_div(x, x, &tmp, digits+1); float_setsign(x, sgn); float_free(&tmp); }
char erfcasymptotic( floatnum x, int digits) { floatstruct smd, fct; int i, workprec, newprec; float_create(&smd); float_create(&fct); workprec = digits - 2 * float_getexponent(x) + 1; if (workprec <= 0) { float_copy(x, &c1, EXACT); return 1; } float_mul(&fct, x, x, digits + 1); float_div(&fct, &c1Div2, &fct, digits); float_neg(&fct); float_copy(&smd, &c1, EXACT); float_setzero(x); newprec = digits; workprec = newprec; i = 1; while (newprec > 0 && newprec <= workprec) { workprec = newprec; float_add(x, x, &smd, digits + 4); float_muli(&smd, &smd, i, workprec + 1); float_mul(&smd, &smd, &fct, workprec + 2); newprec = digits + float_getexponent(&smd) + 1; i += 2; } float_free(&fct); float_free(&smd); return newprec <= workprec; }
static char _pochhammer_g( floatnum x, cfloatnum n, int digits) { /* this generalizes the rising Pochhammer symbol using the formula pochhammer(x,n) = Gamma(x+1)/Gamma(x-n+1) */ floatstruct tmp, factor1, factor2; int inf1, inf2; char result; float_create(&tmp); float_create(&factor1); float_create(&factor2); inf2 = 0; float_add(&tmp, x, n, digits+1); result = _lngamma_prim(x, &factor1, &inf1, digits) && _lngamma_prim(&tmp, &factor2, &inf2, digits) && (inf2 -= inf1) <= 0; if (inf2 > 0) float_seterror(ZeroDivide); if (result && inf2 < 0) float_setzero(x); if (result && inf2 == 0) result = float_div(&factor1, &factor1, &factor2, digits+1) && float_sub(x, &tmp, x, digits+1) && _exp(x, digits) && float_mul(x, x, &factor1, digits+1); float_free(&tmp); float_free(&factor2); float_free(&factor1); if (!result) float_setnan(x); return result; }
char erfcsum( floatnum x, /* should be the square of the parameter to erfc */ int digits) { int i, workprec; floatstruct sum, smd; floatnum Ei; if (digits > erfcdigits) { /* cannot re-use last evaluation's intermediate results */ for (i = MAXERFCIDX; --i >= 0;) /* clear all exp(-k*k*alpha*alpha) to indicate their absence */ float_free(&erfccoeff[i]); /* current precision */ erfcdigits = digits; /* create new alpha appropriate for the desired precision This alpha need not be high precision, any alpha near the one evaluated here would do */ float_muli(&erfcalpha, &cLn10, digits + 4, 3); float_sqrt(&erfcalpha, 3); float_div(&erfcalpha, &cPi, &erfcalpha, 3); float_mul(&erfcalphasqr, &erfcalpha, &erfcalpha, EXACT); /* the exp(-k*k*alpha*alpha) are later evaluated iteratively. Initiate the iteration here */ float_copy(&erfct2, &erfcalphasqr, EXACT); float_neg(&erfct2); _exp(&erfct2, digits + 3); /* exp(-alpha*alpha) */ float_copy(erfccoeff, &erfct2, EXACT); /* start value */ float_mul(&erfct3, &erfct2, &erfct2, digits + 3); /* exp(-2*alpha*alpha) */ } float_create(&sum); float_create(&smd); float_setzero(&sum); for (i = 0; ++i < MAXERFCIDX;) { Ei = &erfccoeff[i-1]; if (float_isnan(Ei)) { /* if exp(-i*i*alpha*alpha) is not available, evaluate it from the coefficient of the last summand */ float_mul(&erfct2, &erfct2, &erfct3, workprec + 3); float_mul(Ei, &erfct2, &erfccoeff[i-2], workprec + 3); } /* Ei finally decays rapidly. save some time by adjusting the working precision */ workprec = digits + float_getexponent(Ei) + 1; if (workprec <= 0) break; /* evaluate the summand exp(-i*i*alpha*alpha)/(i*i*alpha*alpha+x) */ float_muli(&smd, &erfcalphasqr, i*i, workprec); float_add(&smd, x, &smd, workprec + 2); float_div(&smd, Ei, &smd, workprec + 1); /* add summand to the series */ float_add(&sum, &sum, &smd, digits + 3); } float_move(x, &sum); float_free(&smd); return 1; }