char
float_raisei(
floatnum power,
cfloatnum base,
int exponent,
int digits)
{
if (digits <= 0 || digits > maxdigits)
return _seterror(power, InvalidPrecision);
if (float_isnan(base))
return _seterror(power, NoOperand);
if (float_iszero(base))
{
if (exponent == 0)
return _seterror(power, OutOfDomain);
if (exponent < 0)
return _seterror(power, ZeroDivide);
return _setzero(power);
}
digits += 14;
if (digits > maxdigits)
digits = maxdigits;
float_copy(power, base, digits);
if (!_raisei(power, exponent, digits)
|| !float_isvalidexp(float_getexponent(power)))
{
if (float_getexponent(base) < 0)
return _seterror(power, Underflow);
return _seterror(power, Overflow);
}
return 1;
}
char
erfseries(
floatnum x,
int digits)
{
floatstruct xsqr, smd, pwr;
int i, workprec, expx;
expx = float_getexponent(x);
workprec = digits + 2*expx + 2;
if (workprec <= 0 || float_iszero(x))
/* for tiny arguments approx. == x */
return 1;
float_create(&xsqr);
float_create(&smd);
float_create(&pwr);
float_mul(&xsqr, x, x, workprec + 1);
workprec = digits + float_getexponent(&xsqr) + 1;
float_copy(&pwr, x, workprec + 1);
i = 1;
while (workprec > 0)
{
float_mul(&pwr, &pwr, &xsqr, workprec + 1);
float_divi(&pwr, &pwr, -i, workprec + 1);
float_divi(&smd, &pwr, 2 * i++ + 1, workprec);
float_add(x, x, &smd, digits + 3);
workprec = digits + float_getexponent(&smd) + expx + 2;
}
float_free(&pwr);
float_free(&smd);
float_free(&xsqr);
return 1;
}
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;
}
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;
}
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);
}
char
_trigreduce(
floatnum x,
int digits)
{
floatstruct tmp;
int expx, save;
signed char sgn;
char odd;
if (float_abscmp(x, &cPi) <= 0)
return 1;
expx = float_getexponent(x);
if (expx > float_getlength(&cPi) - digits)
return 0;
save = float_setprecision(MAXDIGITS);
float_create(&tmp);
sgn = float_getsign(x);
float_abs(x);
float_divmod(&tmp, x, x, &cPi, INTQUOT);
float_setprecision(save);
odd = float_isodd(&tmp);
if (odd)
float_sub(x, x, &cPi, digits+1);
if (sgn < 0)
float_neg(x);
float_free(&tmp);
return 1;
}
/* evaluates tan x for |x| <= pi.
A return value of 0 indicates
that x = +/- pi/2 within
small tolerances, so that tan x
cannot be reliable computed */
char
_tan(
floatnum x,
int digits)
{
signed char sgn;
sgn = float_getsign(x);
float_abs(x);
if (float_cmp(x, &cPiDiv2) > 0)
{
float_sub(x, &cPi, x, digits+1);
sgn = -sgn;
}
if (float_cmp(x, &cPiDiv4) <= 0)
_tanltPiDiv4(x, digits);
else
{
float_sub(x, &cPiDiv2, x, digits+1);
if (float_iszero(x) || float_getexponent(x) < -digits)
return 0;
_tanltPiDiv4(x, digits);
float_reciprocal(x, digits);
}
float_setsign(x, sgn);
return 1;
}
void
_cos(
floatnum x,
int digits)
{
signed char sgn;
float_abs(x);
sgn = 1;
if (float_cmp(x, &cPiDiv2) > 0)
{
sgn = -1;
float_sub(x, &cPi, x, digits+1);
}
if (float_cmp(x, &cPiDiv4) <= 0)
{
if (2*float_getexponent(x)+2 < - digits)
float_setzero(x);
else
_cosminus1ltPiDiv4(x, digits);
float_add(x, x, &c1, digits);
}
else
{
float_sub(x, &cPiDiv2, x, digits+1);
_sinltPiDiv4(x, digits);
}
float_setsign(x, sgn);
}
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_gamma(
floatnum x,
int digits)
{
signed char sign;
char result;
if (!chckmathparam(x, digits))
return 0;
sign = float_getsign(x);
if (float_isinteger(x))
{
if (sign <= 0)
return _seterror(x, ZeroDivide);
result = _gammaint(x, digits);
}
else if (float_getlength(x) - float_getexponent(x) == 2
&& float_getdigit(x, float_getlength(x) - 1) == 5)
result = _gamma0_5(x, digits);
else
result = _gamma(x, digits);
if (!result)
{
if (sign < 0)
float_seterror(Underflow);
else
float_seterror(Overflow);
float_setnan(x);
}
return result;
}
char
_cosminus1ltPiDiv4(
floatnum x,
int digits)
{
floatstruct tmp;
int reductions;
if (float_iszero(x))
return 1;
float_abs(x);
reductions = 0;
while(float_getexponent(x) >= -2)
{
float_mul(x, x, &c1Div2, digits+1);
++reductions;
}
if (!cosminus1near0(x, digits) && reductions == 0)
return !float_iszero(x);
float_create(&tmp);
for(; reductions-- > 0;)
{
float_mul(&tmp, x, x, digits);
float_add(x, x, x, digits+2);
float_add(x, x, &tmp, digits+2);
float_add(x, x, x, digits+2);
}
float_free(&tmp);
return 1;
}
char
_floatnum2logic(
t_longint* longint,
cfloatnum x)
{
floatstruct tmp;
int digits;
digits = float_getexponent(x)+1;
if (float_iszero(x) || digits <= 0)
{
longint->length = 1;
longint->value[0] = 0;
}
else
{
if (digits > MATHPRECISION)
return 0;
float_create(&tmp);
/* floatnum2longint rounds, we have to truncate first */
float_copy(&tmp, x, digits);
if (float_getsign(x) < 0)
float_add(&tmp, &tmp, &c1, EXACT);
_floatnum2longint(longint, &tmp);
float_free(&tmp);
if (_bitlength(longint) > LOGICRANGE)
return 0;
}
_zeroextend(longint);
if (float_getsign(x) < 0)
_not(longint);
return 1;
}
Error
_floatnum2longint(
t_longint* longint,
floatnum f)
{
int digits;
int i;
unsigned factor;
longint->length = 0;
digits = float_getexponent(f) + 1;
i = digits % 9;
_longintadd(longint, _digitblock(f, 0, i));
factor = 1000000000;
while (i < digits)
{
if (_longintmul(longint, factor)
|| _longintadd(longint, _digitblock(f, i, 9)))
return IOConversionOverflow;
i += 9;
}
/* extra element for floatlong operations */
*(longint->value+longint->length) = 0;
return Success;
}
/* series expansion of cos/cosh - 1 used for small x,
|x| <= 0.01.
The function returns 0, if an underflow occurs.
The relative error seems to be less than 5e-100 for
a 100-digit calculation with |x| < 0.01 */
char
cosminus1series(
floatnum x,
int digits,
char alternating)
{
floatstruct sum, smd;
int expsqrx, pwrsz, addsz, i;
expsqrx = 2 * float_getexponent(x);
float_setexponent(x, 0);
float_mul(x, x, x, digits+1);
float_mul(x, x, &c1Div2, digits+1);
float_setsign(x, alternating? -1 : 1);
expsqrx += float_getexponent(x);
if (float_iszero(x) || expsqrx < EXPMIN)
{
/* underflow */
float_setzero(x);
return expsqrx == 0;
}
float_setexponent(x, expsqrx);
pwrsz = digits + expsqrx + 2;
if (pwrsz <= 0)
/* for very small x, cos/cosh(x) - 1 = (-/+)0.5*x*x */
return 1;
addsz = pwrsz;
float_create(&sum);
float_create(&smd);
float_copy(&smd, x, pwrsz);
float_setzero(&sum);
i = 2;
while (pwrsz > 0)
{
float_mul(&smd, &smd, x, pwrsz+1);
float_divi(&smd, &smd, i*(2*i-1), pwrsz);
float_add(&sum, &sum, &smd, addsz);
++i;
pwrsz = digits + float_getexponent(&smd);
}
float_add(x, x, &sum, digits+1);
float_free(&sum);
float_free(&smd);
return 1;
}
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_raise(
floatnum power,
cfloatnum base,
cfloatnum exponent,
int digits)
{
signed char sgn;
if (float_isnan(exponent) || float_isnan(base))
return _seterror(power, NoOperand);
if (digits <= 0 || digits > MATHPRECISION)
return _seterror(power, InvalidPrecision);
if (float_iszero(base))
{
switch(float_getsign(exponent))
{
case 0:
return _seterror(power, OutOfDomain);
case -1:
return _seterror(power, ZeroDivide);
}
return _setzero(power);
}
sgn = float_getsign(base);
if (sgn < 0)
{
if (!float_isinteger(exponent))
return _seterror(power, OutOfDomain);
if ((float_getdigit(exponent, float_getexponent(exponent)) & 1) == 0)
sgn = 1;
}
float_copy(power, base, digits+1);
float_abs(power);
if (!_raise(power, exponent, digits))
{
float_seterror(Overflow);
if (float_getexponent(base) * float_getsign(exponent) < 0)
float_seterror(Underflow);
return _setnan(power);
}
float_setsign(power, sgn);
return 1;
}
static void
_setfndesc(
p_number_desc n,
floatnum x)
{
int digits;
n->intpart.seq.base = 10;
digits = _max(float_getexponent(x) + 1, 0);
n->intpart.seq.digits = digits;
n->intpart.seq.trailing0 = _max(digits - float_getlength(x), 0);
n->intpart.seq.param = x;
n->intpart.getdigit = _getfnintdigit;
n->fracpart.seq.base = 10;
n->fracpart.seq.leadingSignDigits = _max(-float_getexponent(x) - 1, 0);
n->fracpart.seq.digits = float_getlength(x) - digits
+ n->fracpart.seq.leadingSignDigits;
n->fracpart.seq.param = x;
n->fracpart.getdigit = _getfnfracdigit;
}
char
float_tan(
floatnum x,
int digits)
{
if (!chckmathparam(x, digits))
return 0;
return float_getexponent(x) >= DECPRECISION - 1
|| !_trigreduce(x, digits)
|| !_tan(x, digits)? _seterror(x, EvalUnstable) : 1;
}
char
float_cos(
floatnum x,
int digits)
{
if (!chckmathparam(x, digits))
return 0;
if (float_getexponent(x) >= DECPRECISION - 1 || !_trigreduce(x, digits))
return _seterror(x, EvalUnstable);
_cos(x, digits);
return 1;
}
char
float_artanh(
floatnum x,
int digits)
{
if (!chckmathparam(x, digits))
return 0;
if (float_getexponent(x) >= 0)
return _seterror(x, OutOfDomain);
_artanh(x, digits);
return 1;
}
char
float_lnxplus1(
floatnum x,
int digits)
{
if (!chckmathparam(x, digits))
return 0;
if (float_getsign(x) < 0 && float_getexponent(x) >= 0)
return _seterror(x, OutOfDomain);
_lnxplus1(x, digits);
return 1;
}
/* returns how much x has to be increased to let the
asymptotic series converge to <digits> places */
static int
_ofs(
floatnum x,
int digits)
{
int result;
if (float_getexponent(x) >= 8)
return 0;
result = _minx(digits) - float_asinteger(x);
return result <= 0? 0 : result;
}
char
_gammaint(
floatnum integer,
int digits)
{
int ofs;
if (float_getexponent(integer) >=2)
return _gammagtminus20(integer, digits);
ofs = float_asinteger(integer);
float_copy(integer, &c1, EXACT);
return _pochhammer_su(integer, ofs-1, digits);
}
static Error
_outscidec(
p_otokens tokens,
floatnum x,
p_number_desc n,
int scale)
{
float_checkedround(x, scale + 1);
n->exp = float_getexponent(x);
float_setexponent(x, 0);
_setfndesc(n, x);
return desc2str(tokens, n, scale);
}
static char
_getfnfracdigit(
int ofs,
p_seq_desc n)
{
floatnum x;
int exp;
x = (floatnum)(n->param);
exp = float_getexponent(x);
if (ofs >= 0)
return float_getdigit(x, ofs + exp + 1);
return 0;
}
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;
}
char
float_coshminus1(
floatnum x,
int digits)
{
int expx;
if (!chckmathparam(x, digits))
return 0;
expx = float_getexponent(x);
if (_coshminus1(x, digits))
return 1;
if (expx < 0)
return _seterror(x, Underflow);
return _seterror(x, Overflow);
}
/* 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
_checkbounds(
floatnum x,
int digits,
signed char base)
{
if (float_getexponent(x) < 0)
{
float_muli(x, x, base, digits);
return -1;
}
else if (float_asinteger(x) >= base)
{
float_divi(x, x, base, digits);
return 1;
}
return 0;
}
