diff --git a/.git-blame-ignore-revs b/.git-blame-ignore-revs new file mode 100644 index 0000000..92e7692 --- /dev/null +++ b/.git-blame-ignore-revs @@ -0,0 +1,16 @@ +# .git-blame-ignore-revs + +# cephes.cmath: format code: chbevl,polevl +f551e0bea3bcafda44ef4f39dbee52587a26c3d2 +# cephes.polyn: format code +8314238f021ef05d0c02d6471ff142e3288e3e23 +# cephes.misc: format code +f13cba3bd589fe12b625816c8e1788e0ea9e1a68 +# cephes.ellf: format code +6c64cf0ce56e1d5ce9ca6510c5e93a1141ca71ec +# cephes.cprob: format code +c3bfb2e8dc818f5b6fbe8cc4657b8daf6abf4dd8 +# test: format code +b5212eb3312640d15495e8b255f7c25b8d92b530 +# cephes.bessel: format all codes +e9ea29cabec8d0ce0740d8d881d635b29d90e4f8 diff --git a/README.md b/README.md index 896ddc5..09abd90 100644 --- a/README.md +++ b/README.md @@ -26,6 +26,7 @@ Therefore, contributions regarding precision and error-related contributions are - [Bessel functions](doc/markdown/bessel.md) - [Hypergeometric functions](doc/markdown/hyper.md) - [Elliptic functions](doc/markdown/elliptic.md) +- [Probability functions](doc/markdown/prob.md) - [Miscellaneous functions](doc/markdown/misc.md) @@ -34,7 +35,7 @@ Therefore, contributions regarding precision and error-related contributions are ```sh # On Linux cmake -DCMAKE_BUILD_TYPE=Coverage -S . -B build && cmake --build build --parallel 8 -cd build/ && ctest -j8 && make coverage_html +cd build/ && ctest -j8 --rerun-failed --output-on-failure && make coverage_html ``` diff --git a/cephes/cmath/chbevl.c b/cephes/cmath/chbevl.c index 5393881..209dad5 100644 --- a/cephes/cmath/chbevl.c +++ b/cephes/cmath/chbevl.c @@ -49,7 +49,7 @@ * the same degree. * */ - /* chbevl.c */ +/* chbevl.c */ /* Cephes Math Library Release 2.0: April, 1987 @@ -57,26 +57,25 @@ Copyright 1985, 1987 by Stephen L. Moshier Direct inquiries to 30 Frost Street, Cambridge, MA 02140 */ -double chbevl( x, array, n ) +double chbevl(x, array, n) double x; double array[]; int n; { -double b0, b1, b2, *p; -int i; + double b0, b1, b2, *p; + int i; -p = array; -b0 = *p++; -b1 = 0.0; -i = n - 1; + p = array; + b0 = *p++; + b1 = 0.0; + i = n - 1; -do - { - b2 = b1; - b1 = b0; - b0 = x * b1 - b2 + *p++; - } -while( --i ); + do + { + b2 = b1; + b1 = b0; + b0 = x * b1 - b2 + *p++; + } while (--i); -return( 0.5*(b0-b2) ); + return (0.5 * (b0 - b2)); } diff --git a/cephes/cmath/polevl.c b/cephes/cmath/polevl.c index 4d050fb..583af3b 100644 --- a/cephes/cmath/polevl.c +++ b/cephes/cmath/polevl.c @@ -41,7 +41,6 @@ * program in microcode or assembly language. * */ - /* Cephes Math Library Release 2.1: December, 1988 @@ -49,25 +48,24 @@ Copyright 1984, 1987, 1988 by Stephen L. Moshier Direct inquiries to 30 Frost Street, Cambridge, MA 02140 */ - -double polevl( x, coef, N ) +double polevl(x, coef, N) double x; double coef[]; int N; { -double ans; -int i; -double *p; + double ans; + int i; + double *p; -p = coef; -ans = *p++; -i = N; + p = coef; + ans = *p++; + i = N; -do - ans = ans * x + *p++; -while( --i ); + do + ans = ans * x + *p++; + while (--i); -return( ans ); + return (ans); } /* p1evl() */ @@ -76,22 +74,22 @@ return( ans ); * Otherwise same as polevl. */ -double p1evl( x, coef, N ) +double p1evl(x, coef, N) double x; double coef[]; int N; { -double ans; -double *p; -int i; + double ans; + double *p; + int i; -p = coef; -ans = x + *p++; -i = N-1; + p = coef; + ans = x + *p++; + i = N - 1; -do - ans = ans * x + *p++; -while( --i ); + do + ans = ans * x + *p++; + while (--i); -return( ans ); + return (ans); } diff --git a/cephes/cprob/bdtr.c b/cephes/cprob/bdtr.c index 5fa13f6..5085fa9 100644 --- a/cephes/cprob/bdtr.c +++ b/cephes/cprob/bdtr.c @@ -46,7 +46,7 @@ * n < k * x < 0, x > 1 */ - /* bdtrc() +/* bdtrc() * * Complemented binomial distribution * @@ -93,7 +93,7 @@ * message condition value returned * bdtrc domain x<0, x>1, n 1 */ - -/* bdtr() */ +/* bdtr() */ /* Cephes Math Library Release 2.8: June, 2000 @@ -148,116 +147,113 @@ Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier #include "mconf.h" #ifdef ANSIPROT -extern double incbet ( double, double, double ); -extern double incbi ( double, double, double ); -extern double pow ( double, double ); -extern double log1p ( double ); -extern double expm1 ( double ); +extern double incbet(double, double, double); +extern double incbi(double, double, double); +extern double pow(double, double); +extern double log1p(double); +extern double expm1(double); #else double incbet(), incbi(), pow(), log1p(), expm1(); #endif -double bdtrc( k, n, p ) +double bdtrc(k, n, p) int k, n; double p; { -double dk, dn; + double dk, dn; -if( (p < 0.0) || (p > 1.0) ) - goto domerr; -if( k < 0 ) - return( 1.0 ); + if ((p < 0.0) || (p > 1.0)) + goto domerr; + if (k < 0) + return (1.0); -if( n < k ) - { -domerr: - mtherr( "bdtrc", DOMAIN ); - return( 0.0 ); - } + if (n < k) + { + domerr: + mtherr("bdtrc", DOMAIN); + return (0.0); + } -if( k == n ) - return( 0.0 ); -dn = n - k; -if( k == 0 ) - { - if( p < .01 ) - dk = -expm1( dn * log1p(-p) ); - else - dk = 1.0 - pow( 1.0-p, dn ); - } -else - { - dk = k + 1; - dk = incbet( dk, dn, p ); - } -return( dk ); + if (k == n) + return (0.0); + dn = n - k; + if (k == 0) + { + if (p < .01) + dk = -expm1(dn * log1p(-p)); + else + dk = 1.0 - pow(1.0 - p, dn); + } + else + { + dk = k + 1; + dk = incbet(dk, dn, p); + } + return (dk); } - - -double bdtr( k, n, p ) +double bdtr(k, n, p) int k, n; double p; { -double dk, dn; + double dk, dn; -if( (p < 0.0) || (p > 1.0) ) - goto domerr; -if( (k < 0) || (n < k) ) - { -domerr: - mtherr( "bdtr", DOMAIN ); - return( 0.0 ); - } + if ((p < 0.0) || (p > 1.0)) + goto domerr; + if ((k < 0) || (n < k)) + { + domerr: + mtherr("bdtr", DOMAIN); + return (0.0); + } -if( k == n ) - return( 1.0 ); + if (k == n) + return (1.0); -dn = n - k; -if( k == 0 ) - { - dk = pow( 1.0-p, dn ); - } -else - { - dk = k + 1; - dk = incbet( dn, dk, 1.0 - p ); - } -return( dk ); + dn = n - k; + if (k == 0) + { + dk = pow(1.0 - p, dn); + } + else + { + dk = k + 1; + dk = incbet(dn, dk, 1.0 - p); + } + return (dk); } - -double bdtri( k, n, y ) +double bdtri(k, n, y) int k, n; double y; { -double dk, dn, p; + double dk, dn, p; -if( (y < 0.0) || (y > 1.0) ) - goto domerr; -if( (k < 0) || (n <= k) ) - { -domerr: - mtherr( "bdtri", DOMAIN ); - return( 0.0 ); - } + if ((y < 0.0) || (y > 1.0)) + goto domerr; + if ((k < 0) || (n <= k)) + { + domerr: + mtherr("bdtri", DOMAIN); + return (0.0); + } -dn = n - k; -if( k == 0 ) - { - if( y > 0.8 ) - p = -expm1( log1p(y-1.0) / dn ); - else - p = 1.0 - pow( y, 1.0/dn ); - } -else - { - dk = k + 1; - p = incbet( dn, dk, 0.5 ); - if( p > 0.5 ) - p = incbi( dk, dn, 1.0-y ); - else - p = 1.0 - incbi( dn, dk, y ); - } -return( p ); + dn = n - k; + if (k == 0) + { + if (y > 0.8) + p = -expm1(log1p(y - 1.0) / dn); + else + p = 1.0 - pow(y, 1.0 / dn); + } + else + { + dk = k + 1; + p = incbet(dn, dk, 0.5); + if (p > 0.5) + p = incbi(dk, dn, 1.0 - y); + else + p = 1.0 - incbi(dn, dk, y); + } + return (p); } diff --git a/cephes/cprob/btdtr.c b/cephes/cprob/btdtr.c index 59f48f5..9a08878 100644 --- a/cephes/cprob/btdtr.c +++ b/cephes/cprob/btdtr.c @@ -41,9 +41,8 @@ * See incbet.c. * */ - -/* btdtr() */ +/* btdtr() */ /* Cephes Math Library Release 2.8: June, 2000 @@ -51,14 +50,14 @@ Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier */ #include "mconf.h" #ifdef ANSIPROT -extern double incbet ( double, double, double ); +extern double incbet(double, double, double); #else double incbet(); #endif -double btdtr( a, b, x ) +double btdtr(a, b, x) double a, b, x; { -return( incbet( a, b, x ) ); + return (incbet(a, b, x)); } diff --git a/cephes/cprob/chdtr.c b/cephes/cprob/chdtr.c index db44313..2370a87 100644 --- a/cephes/cprob/chdtr.c +++ b/cephes/cprob/chdtr.c @@ -48,7 +48,7 @@ * message condition value returned * chdtr domain x < 0 or v < 1 0.0 */ - /* chdtrc() +/* chdtrc() * * Complemented Chi-square distribution * @@ -98,7 +98,7 @@ * message condition value returned * chdtrc domain x < 0 or v < 1 0.0 */ - /* chdtri() +/* chdtri() * * Inverse of complemented Chi-square distribution * @@ -138,9 +138,8 @@ * v < 1 * */ - -/* chdtr() */ +/* chdtr() */ /* Cephes Math Library Release 2.8: June, 2000 @@ -149,52 +148,48 @@ Copyright 1984, 1987, 2000 by Stephen L. Moshier #include "mconf.h" #ifdef ANSIPROT -extern double igamc ( double, double ); -extern double igam ( double, double ); -extern double igami ( double, double ); +extern double igamc(double, double); +extern double igam(double, double); +extern double igami(double, double); #else double igamc(), igam(), igami(); #endif -double chdtrc(df,x) +double chdtrc(df, x) double df, x; { -if( (x < 0.0) || (df < 1.0) ) - { - mtherr( "chdtrc", DOMAIN ); - return(0.0); - } -return( igamc( df/2.0, x/2.0 ) ); + if ((x < 0.0) || (df < 1.0)) + { + mtherr("chdtrc", DOMAIN); + return (0.0); + } + return (igamc(df / 2.0, x / 2.0)); } - - -double chdtr(df,x) +double chdtr(df, x) double df, x; { -if( (x < 0.0) || (df < 1.0) ) - { - mtherr( "chdtr", DOMAIN ); - return(0.0); - } -return( igam( df/2.0, x/2.0 ) ); + if ((x < 0.0) || (df < 1.0)) + { + mtherr("chdtr", DOMAIN); + return (0.0); + } + return (igam(df / 2.0, x / 2.0)); } - - -double chdtri( df, y ) +double chdtri(df, y) double df, y; { -double x; + double x; -if( (y < 0.0) || (y > 1.0) || (df < 1.0) ) - { - mtherr( "chdtri", DOMAIN ); - return(0.0); - } + if ((y < 0.0) || (y > 1.0) || (df < 1.0)) + { + mtherr("chdtri", DOMAIN); + return (0.0); + } -x = igami( 0.5 * df, y ); -return( 2.0 * x ); + x = igami(0.5 * df, y); + return (2.0 * x); } diff --git a/cephes/cprob/expx2.c b/cephes/cprob/expx2.c index 09a11c0..4927151 100644 --- a/cephes/cprob/expx2.c +++ b/cephes/cprob/expx2.c @@ -20,7 +20,7 @@ * exponential argument x*x. * * If sign < 0, the result is inverted; i.e., y = exp(-x*x) . - * + * * * ACCURACY: * @@ -38,9 +38,9 @@ Copyright 2000 by Stephen L. Moshier #include "mconf.h" #ifdef ANSIPROT -extern double fabs (double); -extern double floor (double); -extern double exp (double); +extern double fabs(double); +extern double floor(double); +extern double exp(double); #else double fabs(); double floor(); @@ -58,36 +58,36 @@ double exp(); extern double MAXLOG; extern double INFINITY; -double expx2 (x, sign) - double x; - int sign; +double expx2(x, sign) +double x; +int sign; { - double u, u1, m, f; + double u, u1, m, f; - x = fabs (x); - if (sign < 0) - x = -x; + x = fabs(x); + if (sign < 0) + x = -x; - /* Represent x as an exact multiple of M plus a residual. - M is a power of 2 chosen so that exp(m * m) does not overflow - or underflow and so that |x - m| is small. */ - m = MINV * floor(M * x + 0.5); - f = x - m; + /* Represent x as an exact multiple of M plus a residual. + M is a power of 2 chosen so that exp(m * m) does not overflow + or underflow and so that |x - m| is small. */ + m = MINV * floor(M * x + 0.5); + f = x - m; - /* x^2 = m^2 + 2mf + f^2 */ - u = m * m; - u1 = 2 * m * f + f * f; + /* x^2 = m^2 + 2mf + f^2 */ + u = m * m; + u1 = 2 * m * f + f * f; - if (sign < 0) + if (sign < 0) { - u = -u; - u1 = -u1; + u = -u; + u1 = -u1; } - if ((u+u1) > MAXLOG) - return (INFINITY); + if ((u + u1) > MAXLOG) + return (INFINITY); - /* u is exact, u1 is small. */ - u = exp(u) * exp(u1); - return(u); + /* u is exact, u1 is small. */ + u = exp(u) * exp(u1); + return (u); } diff --git a/cephes/cprob/fdtr.c b/cephes/cprob/fdtr.c index 29e41f3..1acf0b4 100644 --- a/cephes/cprob/fdtr.c +++ b/cephes/cprob/fdtr.c @@ -48,7 +48,7 @@ * fdtr domain a<0, b<0, x<0 0.0 * */ - /* fdtrc() +/* fdtrc() * * Complemented F distribution * @@ -100,7 +100,7 @@ * fdtrc domain a<0, b<0, x<0 0.0 * */ - /* fdtri() +/* fdtri() * * Inverse of complemented F distribution * @@ -152,86 +152,81 @@ * v < 1 * */ - /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier */ - #include "mconf.h" #ifdef ANSIPROT -extern double incbet ( double, double, double ); -extern double incbi ( double, double, double ); +extern double incbet(double, double, double); +extern double incbi(double, double, double); #else double incbet(), incbi(); #endif -double fdtrc( ia, ib, x ) +double fdtrc(ia, ib, x) int ia, ib; double x; { -double a, b, w; + double a, b, w; -if( (ia < 1) || (ib < 1) || (x < 0.0) ) - { - mtherr( "fdtrc", DOMAIN ); - return( 0.0 ); - } -a = ia; -b = ib; -w = b / (b + a * x); -return( incbet( 0.5*b, 0.5*a, w ) ); + if ((ia < 1) || (ib < 1) || (x < 0.0)) + { + mtherr("fdtrc", DOMAIN); + return (0.0); + } + a = ia; + b = ib; + w = b / (b + a * x); + return (incbet(0.5 * b, 0.5 * a, w)); } - - -double fdtr( ia, ib, x ) +double fdtr(ia, ib, x) int ia, ib; double x; { -double a, b, w; + double a, b, w; -if( (ia < 1) || (ib < 1) || (x < 0.0) ) - { - mtherr( "fdtr", DOMAIN ); - return( 0.0 ); - } -a = ia; -b = ib; -w = a * x; -w = w / (b + w); -return( incbet(0.5*a, 0.5*b, w) ); + if ((ia < 1) || (ib < 1) || (x < 0.0)) + { + mtherr("fdtr", DOMAIN); + return (0.0); + } + a = ia; + b = ib; + w = a * x; + w = w / (b + w); + return (incbet(0.5 * a, 0.5 * b, w)); } - -double fdtri( ia, ib, y ) +double fdtri(ia, ib, y) int ia, ib; double y; { -double a, b, w, x; + double a, b, w, x; -if( (ia < 1) || (ib < 1) || (y <= 0.0) || (y > 1.0) ) - { - mtherr( "fdtri", DOMAIN ); - return( 0.0 ); - } -a = ia; -b = ib; -/* Compute probability for x = 0.5. */ -w = incbet( 0.5*b, 0.5*a, 0.5 ); -/* If that is greater than y, then the solution w < .5. - Otherwise, solve at 1-y to remove cancellation in (b - b*w). */ -if( w > y || y < 0.001) - { - w = incbi( 0.5*b, 0.5*a, y ); - x = (b - b*w)/(a*w); - } -else - { - w = incbi( 0.5*a, 0.5*b, 1.0-y ); - x = b*w/(a*(1.0-w)); - } -return(x); + if ((ia < 1) || (ib < 1) || (y <= 0.0) || (y > 1.0)) + { + mtherr("fdtri", DOMAIN); + return (0.0); + } + a = ia; + b = ib; + /* Compute probability for x = 0.5. */ + w = incbet(0.5 * b, 0.5 * a, 0.5); + /* If that is greater than y, then the solution w < .5. + Otherwise, solve at 1-y to remove cancellation in (b - b*w). */ + if (w > y || y < 0.001) + { + w = incbi(0.5 * b, 0.5 * a, y); + x = (b - b * w) / (a * w); + } + else + { + w = incbi(0.5 * a, 0.5 * b, 1.0 - y); + x = b * w / (a * (1.0 - w)); + } + return (x); } diff --git a/cephes/cprob/gamma.c b/cephes/cprob/gamma.c index 15fbad7..ef34773 100644 --- a/cephes/cprob/gamma.c +++ b/cephes/cprob/gamma.c @@ -25,7 +25,7 @@ * approximated by a rational function of degree 6/7 in the * interval (2,3). Large arguments are handled by Stirling's * formula. Large negative arguments are made positive using - * a reflection formula. + * a reflection formula. * * * ACCURACY: @@ -40,7 +40,7 @@ * Error for arguments outside the test range will be larger * owing to error amplification by the exponential function. * - */ + */ /* lgam() * * Natural logarithm of gamma function @@ -94,7 +94,7 @@ * IEEE -200, -4 10000 4.8e-16 1.3e-16 * */ - + /* gamma.c */ /* gamma function */ @@ -103,9 +103,9 @@ Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 1989, 1992, 2000 by Stephen L. Moshier */ - #include "mconf.h" +/* clang-format off */ #ifdef UNK static double P[] = { 1.60119522476751861407E-4, @@ -265,23 +265,24 @@ static unsigned short SQT[4] = { }; #define SQTPI *(double *)SQT #endif +/* clang-format on */ int sgngam = 0; extern int sgngam; extern double MAXLOG, MAXNUM, PI; #ifdef ANSIPROT -extern double pow ( double, double ); -extern double log ( double ); -extern double exp ( double ); -extern double sin ( double ); -extern double polevl ( double, void *, int ); -extern double p1evl ( double, void *, int ); -extern double floor ( double ); -extern double fabs ( double ); -extern int isnan ( double ); -extern int isfinite ( double ); -static double stirf ( double ); -double lgam ( double ); +extern double pow(double, double); +extern double log(double); +extern double exp(double); +extern double sin(double); +extern double polevl(double, void *, int); +extern double p1evl(double, void *, int); +extern double floor(double); +extern double fabs(double); +extern int isnan(double); +extern int isfinite(double); +static double stirf(double); +double lgam(double); #else double pow(), log(), exp(), sin(), polevl(), p1evl(), floor(), fabs(); int isnan(), isfinite(); @@ -301,146 +302,143 @@ extern double NAN; static double stirf(x) double x; { -double y, w, v; - -w = 1.0/x; -w = 1.0 + w * polevl( w, STIR, 4 ); -y = exp(x); -if( x > MAXSTIR ) - { /* Avoid overflow in pow() */ - v = pow( x, 0.5 * x - 0.25 ); - y = v * (v / y); - } -else - { - y = pow( x, x - 0.5 ) / y; - } -y = SQTPI * y * w; -return( y ); + double y, w, v; + + w = 1.0 / x; + w = 1.0 + w * polevl(w, STIR, 4); + y = exp(x); + if (x > MAXSTIR) + { /* Avoid overflow in pow() */ + v = pow(x, 0.5 * x - 0.25); + y = v * (v / y); + } + else + { + y = pow(x, x - 0.5) / y; + } + y = SQTPI * y * w; + return (y); } - - double gamma(x) double x; { -double p, q, z; -int i; + double p, q, z; + int i; -sgngam = 1; + sgngam = 1; #ifdef NANS -if( isnan(x) ) - return(x); + if (isnan(x)) + return (x); #endif #ifdef INFINITIES #ifdef NANS -if( x == INFINITY ) - return(x); -if( x == -INFINITY ) - return(NAN); + if (x == INFINITY) + return (x); + if (x == -INFINITY) + return (NAN); #else -if( !isfinite(x) ) - return(x); + if (!isfinite(x)) + return (x); #endif #endif -q = fabs(x); - -if( q > 33.0 ) - { - if( x < 0.0 ) - { - p = floor(q); - if( p == q ) - { + q = fabs(x); + + if (q > 33.0) + { + if (x < 0.0) + { + p = floor(q); + if (p == q) + { #ifdef NANS -gamnan: - mtherr( "gamma", DOMAIN ); - return (NAN); + gamnan: + mtherr("gamma", DOMAIN); + return (NAN); #else - goto goverf; + goto goverf; #endif - } - i = p; - if( (i & 1) == 0 ) - sgngam = -1; - z = q - p; - if( z > 0.5 ) - { - p += 1.0; - z = q - p; - } - z = q * sin( PI * z ); - if( z == 0.0 ) - { + } + i = p; + if ((i & 1) == 0) + sgngam = -1; + z = q - p; + if (z > 0.5) + { + p += 1.0; + z = q - p; + } + z = q * sin(PI * z); + if (z == 0.0) + { #ifdef INFINITIES - return( sgngam * INFINITY); + return (sgngam * INFINITY); #else -goverf: - mtherr( "gamma", OVERFLOW ); - return( sgngam * MAXNUM); + goverf: + mtherr("gamma", OVERFLOW); + return (sgngam * MAXNUM); #endif - } - z = fabs(z); - z = PI/(z * stirf(q) ); - } - else - { - z = stirf(x); - } - return( sgngam * z ); - } - -z = 1.0; -while( x >= 3.0 ) - { - x -= 1.0; - z *= x; - } - -while( x < 0.0 ) - { - if( x > -1.E-9 ) - goto small; - z /= x; - x += 1.0; - } - -while( x < 2.0 ) - { - if( x < 1.e-9 ) - goto small; - z /= x; - x += 1.0; - } - -if( x == 2.0 ) - return(z); - -x -= 2.0; -p = polevl( x, P, 6 ); -q = polevl( x, Q, 7 ); -return( z * p / q ); + } + z = fabs(z); + z = PI / (z * stirf(q)); + } + else + { + z = stirf(x); + } + return (sgngam * z); + } + + z = 1.0; + while (x >= 3.0) + { + x -= 1.0; + z *= x; + } + + while (x < 0.0) + { + if (x > -1.E-9) + goto small; + z /= x; + x += 1.0; + } + + while (x < 2.0) + { + if (x < 1.e-9) + goto small; + z /= x; + x += 1.0; + } + + if (x == 2.0) + return (z); + + x -= 2.0; + p = polevl(x, P, 6); + q = polevl(x, Q, 7); + return (z * p / q); small: -if( x == 0.0 ) - { + if (x == 0.0) + { #ifdef INFINITIES #ifdef NANS - goto gamnan; + goto gamnan; #else - return( INFINITY ); + return (INFINITY); #endif #else - mtherr( "gamma", SING ); - return( MAXNUM ); + mtherr("gamma", SING); + return (MAXNUM); #endif - } -else - return( z/((1.0 + 0.5772156649015329 * x) * x) ); + } + else + return (z / ((1.0 + 0.5772156649015329 * x) * x)); } - - +/* clang-format off */ /* A[]: Stirling's formula expansion of log gamma * B[], C[]: log gamma function between 2 and 3 */ @@ -569,117 +567,114 @@ static unsigned short LS2P[] = { #define LS2PI *(double *)LS2P #define MAXLGM 2.556348e305 #endif - +/* clang-format on */ /* Logarithm of gamma function */ - double lgam(x) double x; { -double p, q, u, w, z; -int i; + double p, q, u, w, z; + int i; -sgngam = 1; + sgngam = 1; #ifdef NANS -if( isnan(x) ) - return(x); + if (isnan(x)) + return (x); #endif #ifdef INFINITIES -if( !isfinite(x) ) - return(INFINITY); + if (!isfinite(x)) + return (INFINITY); #endif -if( x < -34.0 ) - { - q = -x; - w = lgam(q); /* note this modifies sgngam! */ - p = floor(q); - if( p == q ) - { -lgsing: + if (x < -34.0) + { + q = -x; + w = lgam(q); /* note this modifies sgngam! */ + p = floor(q); + if (p == q) + { + lgsing: #ifdef INFINITIES - mtherr( "lgam", SING ); - return (INFINITY); + mtherr("lgam", SING); + return (INFINITY); #else - goto loverf; + goto loverf; #endif - } - i = p; - if( (i & 1) == 0 ) - sgngam = -1; - else - sgngam = 1; - z = q - p; - if( z > 0.5 ) - { - p += 1.0; - z = p - q; - } - z = q * sin( PI * z ); - if( z == 0.0 ) - goto lgsing; -/* z = log(PI) - log( z ) - w;*/ - z = LOGPI - log( z ) - w; - return( z ); - } - -if( x < 13.0 ) - { - z = 1.0; - p = 0.0; - u = x; - while( u >= 3.0 ) - { - p -= 1.0; - u = x + p; - z *= u; - } - while( u < 2.0 ) - { - if( u == 0.0 ) - goto lgsing; - z /= u; - p += 1.0; - u = x + p; - } - if( z < 0.0 ) - { - sgngam = -1; - z = -z; - } - else - sgngam = 1; - if( u == 2.0 ) - return( log(z) ); - p -= 2.0; - x = x + p; - p = x * polevl( x, B, 5 ) / p1evl( x, C, 6); - return( log(z) + p ); - } - -if( x > MAXLGM ) - { + } + i = p; + if ((i & 1) == 0) + sgngam = -1; + else + sgngam = 1; + z = q - p; + if (z > 0.5) + { + p += 1.0; + z = p - q; + } + z = q * sin(PI * z); + if (z == 0.0) + goto lgsing; + /* z = log(PI) - log( z ) - w;*/ + z = LOGPI - log(z) - w; + return (z); + } + + if (x < 13.0) + { + z = 1.0; + p = 0.0; + u = x; + while (u >= 3.0) + { + p -= 1.0; + u = x + p; + z *= u; + } + while (u < 2.0) + { + if (u == 0.0) + goto lgsing; + z /= u; + p += 1.0; + u = x + p; + } + if (z < 0.0) + { + sgngam = -1; + z = -z; + } + else + sgngam = 1; + if (u == 2.0) + return (log(z)); + p -= 2.0; + x = x + p; + p = x * polevl(x, B, 5) / p1evl(x, C, 6); + return (log(z) + p); + } + + if (x > MAXLGM) + { #ifdef INFINITIES - return( sgngam * INFINITY ); + return (sgngam * INFINITY); #else -loverf: - mtherr( "lgam", OVERFLOW ); - return( sgngam * MAXNUM ); + loverf: + mtherr("lgam", OVERFLOW); + return (sgngam * MAXNUM); #endif - } - -q = ( x - 0.5 ) * log(x) - x + LS2PI; -if( x > 1.0e8 ) - return( q ); - -p = 1.0/(x*x); -if( x >= 1000.0 ) - q += (( 7.9365079365079365079365e-4 * p - - 2.7777777777777777777778e-3) *p - + 0.0833333333333333333333) / x; -else - q += polevl( p, A, 4 ) / x; -return( q ); + } + + q = (x - 0.5) * log(x) - x + LS2PI; + if (x > 1.0e8) + return (q); + + p = 1.0 / (x * x); + if (x >= 1000.0) + q += ((7.9365079365079365079365e-4 * p - 2.7777777777777777777778e-3) * p + 0.0833333333333333333333) / x; + else + q += polevl(p, A, 4) / x; + return (q); } diff --git a/cephes/cprob/gdtr.c b/cephes/cprob/gdtr.c index bb4dbf7..2d0f584 100644 --- a/cephes/cprob/gdtr.c +++ b/cephes/cprob/gdtr.c @@ -42,7 +42,7 @@ * gdtr domain x < 0 0.0 * */ - /* gdtrc.c +/* gdtrc.c * * Complemented gamma distribution function * @@ -86,9 +86,8 @@ * gdtrc domain x < 0 0.0 * */ - -/* gdtr() */ +/* gdtr() */ /* Cephes Math Library Release 2.8: June, 2000 @@ -97,34 +96,32 @@ Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier #include "mconf.h" #ifdef ANSIPROT -extern double igam ( double, double ); -extern double igamc ( double, double ); +extern double igam(double, double); +extern double igamc(double, double); #else double igam(), igamc(); #endif -double gdtr( a, b, x ) +double gdtr(a, b, x) double a, b, x; { -if( x < 0.0 ) - { - mtherr( "gdtr", DOMAIN ); - return( 0.0 ); - } -return( igam( b, a * x ) ); + if (x < 0.0) + { + mtherr("gdtr", DOMAIN); + return (0.0); + } + return (igam(b, a * x)); } - - -double gdtrc( a, b, x ) +double gdtrc(a, b, x) double a, b, x; { -if( x < 0.0 ) - { - mtherr( "gdtrc", DOMAIN ); - return( 0.0 ); - } -return( igamc( b, a * x ) ); + if (x < 0.0) + { + mtherr("gdtrc", DOMAIN); + return (0.0); + } + return (igamc(b, a * x)); } diff --git a/cephes/cprob/igam.c b/cephes/cprob/igam.c index 582bb3c..e1ee149 100644 --- a/cephes/cprob/igam.c +++ b/cephes/cprob/igam.c @@ -35,7 +35,7 @@ * IEEE 0,30 200000 3.6e-14 2.9e-15 * IEEE 0,100 300000 9.9e-14 1.5e-14 */ - /* igamc() +/* igamc() * * Complemented incomplete gamma integral * @@ -76,7 +76,7 @@ * IEEE 0.5,100 0,100 200000 1.9e-14 1.7e-15 * IEEE 0.01,0.5 0,100 200000 1.4e-13 1.6e-15 */ - + /* Cephes Math Library Release 2.8: June, 2000 Copyright 1985, 1987, 2000 by Stephen L. Moshier @@ -84,87 +84,84 @@ Copyright 1985, 1987, 2000 by Stephen L. Moshier #include "mconf.h" #ifdef ANSIPROT -extern double lgam ( double ); -extern double exp ( double ); -extern double log ( double ); -extern double fabs ( double ); -extern double igam ( double, double ); -extern double igamc ( double, double ); +extern double lgam(double); +extern double exp(double); +extern double log(double); +extern double fabs(double); +extern double igam(double, double); +extern double igamc(double, double); #else double lgam(), exp(), log(), fabs(), igam(), igamc(); #endif extern double MACHEP, MAXLOG, NAN; static double big = 4.503599627370496e15; -static double biginv = 2.22044604925031308085e-16; +static double biginv = 2.22044604925031308085e-16; -double igamc( a, x ) +double igamc(a, x) double a, x; { -double ans, ax, c, yc, r, t, y, z; -double pk, pkm1, pkm2, qk, qkm1, qkm2; + double ans, ax, c, yc, r, t, y, z; + double pk, pkm1, pkm2, qk, qkm1, qkm2; -if( (x < 0) || ( a <= 0) ) + if ((x < 0) || (a <= 0)) { - mtherr("igamc", DOMAIN); - return( NAN ); + mtherr("igamc", DOMAIN); + return (NAN); } -if( (x < 1.0) || (x < a) ) - return( 1.0 - igam(a,x) ); - -ax = a * log(x) - x - lgam(a); -if( ax < -MAXLOG ) - { - mtherr( "igamc", UNDERFLOW ); - return( 0.0 ); - } -ax = exp(ax); - -/* continued fraction */ -y = 1.0 - a; -z = x + y + 1.0; -c = 0.0; -pkm2 = 1.0; -qkm2 = x; -pkm1 = x + 1.0; -qkm1 = z * x; -ans = pkm1/qkm1; - -do - { - c += 1.0; - y += 1.0; - z += 2.0; - yc = y * c; - pk = pkm1 * z - pkm2 * yc; - qk = qkm1 * z - qkm2 * yc; - if( qk != 0 ) - { - r = pk/qk; - t = fabs( (ans - r)/r ); - ans = r; - } - else - t = 1.0; - pkm2 = pkm1; - pkm1 = pk; - qkm2 = qkm1; - qkm1 = qk; - if( fabs(pk) > big ) - { - pkm2 *= biginv; - pkm1 *= biginv; - qkm2 *= biginv; - qkm1 *= biginv; - } - } -while( t > MACHEP ); - -return( ans * ax ); -} - + if ((x < 1.0) || (x < a)) + return (1.0 - igam(a, x)); + ax = a * log(x) - x - lgam(a); + if (ax < -MAXLOG) + { + mtherr("igamc", UNDERFLOW); + return (0.0); + } + ax = exp(ax); + + /* continued fraction */ + y = 1.0 - a; + z = x + y + 1.0; + c = 0.0; + pkm2 = 1.0; + qkm2 = x; + pkm1 = x + 1.0; + qkm1 = z * x; + ans = pkm1 / qkm1; + + do + { + c += 1.0; + y += 1.0; + z += 2.0; + yc = y * c; + pk = pkm1 * z - pkm2 * yc; + qk = qkm1 * z - qkm2 * yc; + if (qk != 0) + { + r = pk / qk; + t = fabs((ans - r) / r); + ans = r; + } + else + t = 1.0; + pkm2 = pkm1; + pkm1 = pk; + qkm2 = qkm1; + qkm1 = qk; + if (fabs(pk) > big) + { + pkm2 *= biginv; + pkm1 *= biginv; + qkm2 *= biginv; + qkm1 *= biginv; + } + } while (t > MACHEP); + + return (ans * ax); +} /* left tail of incomplete gamma function: * @@ -176,45 +173,44 @@ return( ans * ax ); * */ -double igam( a, x ) +double igam(a, x) double a, x; { -double ans, ax, c, r; + double ans, ax, c, r; -/* Check zero integration limit first */ -if( x == 0 ) - return ( 0.0 ); + /* Check zero integration limit first */ + if (x == 0) + return (0.0); -if( (x < 0) || ( a <= 0) ) + if ((x < 0) || (a <= 0)) { - mtherr("igam", DOMAIN); - return( NAN ); + mtherr("igam", DOMAIN); + return (NAN); } -if( (x > 1.0) && (x > a ) ) - return( 1.0 - igamc(a,x) ); - -/* Compute x**a * exp(-x) / gamma(a) */ -ax = a * log(x) - x - lgam(a); -if( ax < -MAXLOG ) - { - mtherr( "igam", UNDERFLOW ); - return( 0.0 ); - } -ax = exp(ax); - -/* power series */ -r = a; -c = 1.0; -ans = 1.0; - -do - { - r += 1.0; - c *= x/r; - ans += c; - } -while( c/ans > MACHEP ); - -return( ans * ax/a ); + if ((x > 1.0) && (x > a)) + return (1.0 - igamc(a, x)); + + /* Compute x**a * exp(-x) / gamma(a) */ + ax = a * log(x) - x - lgam(a); + if (ax < -MAXLOG) + { + mtherr("igam", UNDERFLOW); + return (0.0); + } + ax = exp(ax); + + /* power series */ + r = a; + c = 1.0; + ans = 1.0; + + do + { + r += 1.0; + c *= x / r; + ans += c; + } while (c / ans > MACHEP); + + return (ans * ax / a); } diff --git a/cephes/cprob/igami.c b/cephes/cprob/igami.c index afefb1f..c41f3a7 100644 --- a/cephes/cprob/igami.c +++ b/cephes/cprob/igami.c @@ -24,7 +24,7 @@ * where * * t = 1 - d - ndtri(p) sqrt(d) - * + * * and * * d = 1/9a, @@ -42,7 +42,7 @@ * IEEE 0.01,0.5 0,0.5 100000 9.0e-14 3.4e-15 * IEEE 0.5,10000 0,0.5 20000 2.3e-13 3.8e-14 */ - + /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier @@ -52,136 +52,136 @@ Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier extern double MACHEP, MAXNUM, MAXLOG, MINLOG; #ifdef ANSIPROT -extern double igamc ( double, double ); -extern double ndtri ( double ); -extern double exp ( double ); -extern double fabs ( double ); -extern double log ( double ); -extern double sqrt ( double ); -extern double lgam ( double ); +extern double igamc(double, double); +extern double ndtri(double); +extern double exp(double); +extern double fabs(double); +extern double log(double); +extern double sqrt(double); +extern double lgam(double); #else double igamc(), ndtri(), exp(), fabs(), log(), sqrt(), lgam(); #endif -double igami( a, y0 ) +double igami(a, y0) double a, y0; { -double x0, x1, x, yl, yh, y, d, lgm, dithresh; -int i, dir; + double x0, x1, x, yl, yh, y, d, lgm, dithresh; + int i, dir; -/* bound the solution */ -x0 = MAXNUM; -yl = 0; -x1 = 0; -yh = 1.0; -dithresh = 5.0 * MACHEP; + /* bound the solution */ + x0 = MAXNUM; + yl = 0; + x1 = 0; + yh = 1.0; + dithresh = 5.0 * MACHEP; -/* approximation to inverse function */ -d = 1.0/(9.0*a); -y = ( 1.0 - d - ndtri(y0) * sqrt(d) ); -x = a * y * y * y; + /* approximation to inverse function */ + d = 1.0 / (9.0 * a); + y = (1.0 - d - ndtri(y0) * sqrt(d)); + x = a * y * y * y; -lgm = lgam(a); + lgm = lgam(a); -for( i=0; i<10; i++ ) - { - if( x > x0 || x < x1 ) - goto ihalve; - y = igamc(a,x); - if( y < yl || y > yh ) - goto ihalve; - if( y < y0 ) - { - x0 = x; - yl = y; - } - else - { - x1 = x; - yh = y; - } -/* compute the derivative of the function at this point */ - d = (a - 1.0) * log(x) - x - lgm; - if( d < -MAXLOG ) - goto ihalve; - d = -exp(d); -/* compute the step to the next approximation of x */ - d = (y - y0)/d; - if( fabs(d/x) < MACHEP ) - goto done; - x = x - d; - } + for (i = 0; i < 10; i++) + { + if (x > x0 || x < x1) + goto ihalve; + y = igamc(a, x); + if (y < yl || y > yh) + goto ihalve; + if (y < y0) + { + x0 = x; + yl = y; + } + else + { + x1 = x; + yh = y; + } + /* compute the derivative of the function at this point */ + d = (a - 1.0) * log(x) - x - lgm; + if (d < -MAXLOG) + goto ihalve; + d = -exp(d); + /* compute the step to the next approximation of x */ + d = (y - y0) / d; + if (fabs(d / x) < MACHEP) + goto done; + x = x - d; + } /* Resort to interval halving if Newton iteration did not converge. */ ihalve: -d = 0.0625; -if( x0 == MAXNUM ) - { - if( x <= 0.0 ) - x = 1.0; - while( x0 == MAXNUM ) - { - x = (1.0 + d) * x; - y = igamc( a, x ); - if( y < y0 ) - { - x0 = x; - yl = y; - break; - } - d = d + d; - } - } -d = 0.5; -dir = 0; + d = 0.0625; + if (x0 == MAXNUM) + { + if (x <= 0.0) + x = 1.0; + while (x0 == MAXNUM) + { + x = (1.0 + d) * x; + y = igamc(a, x); + if (y < y0) + { + x0 = x; + yl = y; + break; + } + d = d + d; + } + } + d = 0.5; + dir = 0; -for( i=0; i<400; i++ ) - { - x = x1 + d * (x0 - x1); - y = igamc( a, x ); - lgm = (x0 - x1)/(x1 + x0); - if( fabs(lgm) < dithresh ) - break; - lgm = (y - y0)/y0; - if( fabs(lgm) < dithresh ) - break; - if( x <= 0.0 ) - break; - if( y >= y0 ) - { - x1 = x; - yh = y; - if( dir < 0 ) - { - dir = 0; - d = 0.5; - } - else if( dir > 1 ) - d = 0.5 * d + 0.5; - else - d = (y0 - yl)/(yh - yl); - dir += 1; - } - else - { - x0 = x; - yl = y; - if( dir > 0 ) - { - dir = 0; - d = 0.5; - } - else if( dir < -1 ) - d = 0.5 * d; - else - d = (y0 - yl)/(yh - yl); - dir -= 1; - } - } -if( x == 0.0 ) - mtherr( "igami", UNDERFLOW ); + for (i = 0; i < 400; i++) + { + x = x1 + d * (x0 - x1); + y = igamc(a, x); + lgm = (x0 - x1) / (x1 + x0); + if (fabs(lgm) < dithresh) + break; + lgm = (y - y0) / y0; + if (fabs(lgm) < dithresh) + break; + if (x <= 0.0) + break; + if (y >= y0) + { + x1 = x; + yh = y; + if (dir < 0) + { + dir = 0; + d = 0.5; + } + else if (dir > 1) + d = 0.5 * d + 0.5; + else + d = (y0 - yl) / (yh - yl); + dir += 1; + } + else + { + x0 = x; + yl = y; + if (dir > 0) + { + dir = 0; + d = 0.5; + } + else if (dir < -1) + d = 0.5 * d; + else + d = (y0 - yl) / (yh - yl); + dir -= 1; + } + } + if (x == 0.0) + mtherr("igami", UNDERFLOW); done: -return( x ); + return (x); } diff --git a/cephes/cprob/incbet.c b/cephes/cprob/incbet.c index be209f9..232f1a8 100644 --- a/cephes/cprob/incbet.c +++ b/cephes/cprob/incbet.c @@ -52,7 +52,6 @@ * incbet domain x<0, x>1 0.0 * incbet underflow 0.0 */ - /* Cephes Math Library, Release 2.8: June, 2000 @@ -69,12 +68,12 @@ Copyright 1984, 1995, 2000 by Stephen L. Moshier extern double MACHEP, MINLOG, MAXLOG; #ifdef ANSIPROT -extern double gamma ( double ); -extern double lgam ( double ); -extern double exp ( double ); -extern double log ( double ); -extern double pow ( double, double ); -extern double fabs ( double ); +extern double gamma(double); +extern double lgam(double); +extern double exp(double); +extern double log(double); +extern double pow(double, double); +extern double fabs(double); static double incbcf(double, double, double); static double incbd(double, double, double); static double pseries(double, double, double); @@ -84,326 +83,323 @@ static double incbcf(), incbd(), pseries(); #endif static double big = 4.503599627370496e15; -static double biginv = 2.22044604925031308085e-16; +static double biginv = 2.22044604925031308085e-16; - -double incbet( aa, bb, xx ) +double incbet(aa, bb, xx) double aa, bb, xx; { -double a, b, t, x, xc, w, y; -int flag; - -if( aa <= 0.0 || bb <= 0.0 ) - goto domerr; - -if( (xx <= 0.0) || ( xx >= 1.0) ) - { - if( xx == 0.0 ) - return(0.0); - if( xx == 1.0 ) - return( 1.0 ); -domerr: - mtherr( "incbet", DOMAIN ); - return( 0.0 ); - } - -flag = 0; -if( (bb * xx) <= 1.0 && xx <= 0.95) - { - t = pseries(aa, bb, xx); - goto done; - } - -w = 1.0 - xx; - -/* Reverse a and b if x is greater than the mean. */ -if( xx > (aa/(aa+bb)) ) - { - flag = 1; - a = bb; - b = aa; - xc = xx; - x = w; - } -else - { - a = aa; - b = bb; - xc = w; - x = xx; - } - -if( flag == 1 && (b * x) <= 1.0 && x <= 0.95) - { - t = pseries(a, b, x); - goto done; - } - -/* Choose expansion for better convergence. */ -y = x * (a+b-2.0) - (a-1.0); -if( y < 0.0 ) - w = incbcf( a, b, x ); -else - w = incbd( a, b, x ) / xc; - -/* Multiply w by the factor - a b _ _ _ - x (1-x) | (a+b) / ( a | (a) | (b) ) . */ - -y = a * log(x); -t = b * log(xc); -if( (a+b) < MAXGAM && fabs(y) < MAXLOG && fabs(t) < MAXLOG ) - { - t = pow(xc,b); - t *= pow(x,a); - t /= a; - t *= w; - t *= gamma(a+b) / (gamma(a) * gamma(b)); - goto done; - } -/* Resort to logarithms. */ -y += t + lgam(a+b) - lgam(a) - lgam(b); -y += log(w/a); -if( y < MINLOG ) - t = 0.0; -else - t = exp(y); + double a, b, t, x, xc, w, y; + int flag; + + if (aa <= 0.0 || bb <= 0.0) + goto domerr; + + if ((xx <= 0.0) || (xx >= 1.0)) + { + if (xx == 0.0) + return (0.0); + if (xx == 1.0) + return (1.0); + domerr: + mtherr("incbet", DOMAIN); + return (0.0); + } + + flag = 0; + if ((bb * xx) <= 1.0 && xx <= 0.95) + { + t = pseries(aa, bb, xx); + goto done; + } + + w = 1.0 - xx; + + /* Reverse a and b if x is greater than the mean. */ + if (xx > (aa / (aa + bb))) + { + flag = 1; + a = bb; + b = aa; + xc = xx; + x = w; + } + else + { + a = aa; + b = bb; + xc = w; + x = xx; + } + + if (flag == 1 && (b * x) <= 1.0 && x <= 0.95) + { + t = pseries(a, b, x); + goto done; + } + + /* Choose expansion for better convergence. */ + y = x * (a + b - 2.0) - (a - 1.0); + if (y < 0.0) + w = incbcf(a, b, x); + else + w = incbd(a, b, x) / xc; + + /* Multiply w by the factor + a b _ _ _ + x (1-x) | (a+b) / ( a | (a) | (b) ) . */ + + y = a * log(x); + t = b * log(xc); + if ((a + b) < MAXGAM && fabs(y) < MAXLOG && fabs(t) < MAXLOG) + { + t = pow(xc, b); + t *= pow(x, a); + t /= a; + t *= w; + t *= gamma(a + b) / (gamma(a) * gamma(b)); + goto done; + } + /* Resort to logarithms. */ + y += t + lgam(a + b) - lgam(a) - lgam(b); + y += log(w / a); + if (y < MINLOG) + t = 0.0; + else + t = exp(y); done: -if( flag == 1 ) - { - if( t <= MACHEP ) - t = 1.0 - MACHEP; - else - t = 1.0 - t; - } -return( t ); + if (flag == 1) + { + if (t <= MACHEP) + t = 1.0 - MACHEP; + else + t = 1.0 - t; + } + return (t); } - + /* Continued fraction expansion #1 * for incomplete beta integral */ -static double incbcf( a, b, x ) +static double incbcf(a, b, x) double a, b, x; { -double xk, pk, pkm1, pkm2, qk, qkm1, qkm2; -double k1, k2, k3, k4, k5, k6, k7, k8; -double r, t, ans, thresh; -int n; - -k1 = a; -k2 = a + b; -k3 = a; -k4 = a + 1.0; -k5 = 1.0; -k6 = b - 1.0; -k7 = k4; -k8 = a + 2.0; - -pkm2 = 0.0; -qkm2 = 1.0; -pkm1 = 1.0; -qkm1 = 1.0; -ans = 1.0; -r = 1.0; -n = 0; -thresh = 3.0 * MACHEP; -do - { - - xk = -( x * k1 * k2 )/( k3 * k4 ); - pk = pkm1 + pkm2 * xk; - qk = qkm1 + qkm2 * xk; - pkm2 = pkm1; - pkm1 = pk; - qkm2 = qkm1; - qkm1 = qk; - - xk = ( x * k5 * k6 )/( k7 * k8 ); - pk = pkm1 + pkm2 * xk; - qk = qkm1 + qkm2 * xk; - pkm2 = pkm1; - pkm1 = pk; - qkm2 = qkm1; - qkm1 = qk; - - if( qk != 0 ) - r = pk/qk; - if( r != 0 ) - { - t = fabs( (ans - r)/r ); - ans = r; - } - else - t = 1.0; - - if( t < thresh ) - goto cdone; - - k1 += 1.0; - k2 += 1.0; - k3 += 2.0; - k4 += 2.0; - k5 += 1.0; - k6 -= 1.0; - k7 += 2.0; - k8 += 2.0; - - if( (fabs(qk) + fabs(pk)) > big ) - { - pkm2 *= biginv; - pkm1 *= biginv; - qkm2 *= biginv; - qkm1 *= biginv; - } - if( (fabs(qk) < biginv) || (fabs(pk) < biginv) ) - { - pkm2 *= big; - pkm1 *= big; - qkm2 *= big; - qkm1 *= big; - } - } -while( ++n < 300 ); + double xk, pk, pkm1, pkm2, qk, qkm1, qkm2; + double k1, k2, k3, k4, k5, k6, k7, k8; + double r, t, ans, thresh; + int n; + + k1 = a; + k2 = a + b; + k3 = a; + k4 = a + 1.0; + k5 = 1.0; + k6 = b - 1.0; + k7 = k4; + k8 = a + 2.0; + + pkm2 = 0.0; + qkm2 = 1.0; + pkm1 = 1.0; + qkm1 = 1.0; + ans = 1.0; + r = 1.0; + n = 0; + thresh = 3.0 * MACHEP; + do + { + + xk = -(x * k1 * k2) / (k3 * k4); + pk = pkm1 + pkm2 * xk; + qk = qkm1 + qkm2 * xk; + pkm2 = pkm1; + pkm1 = pk; + qkm2 = qkm1; + qkm1 = qk; + + xk = (x * k5 * k6) / (k7 * k8); + pk = pkm1 + pkm2 * xk; + qk = qkm1 + qkm2 * xk; + pkm2 = pkm1; + pkm1 = pk; + qkm2 = qkm1; + qkm1 = qk; + + if (qk != 0) + r = pk / qk; + if (r != 0) + { + t = fabs((ans - r) / r); + ans = r; + } + else + t = 1.0; + + if (t < thresh) + goto cdone; + + k1 += 1.0; + k2 += 1.0; + k3 += 2.0; + k4 += 2.0; + k5 += 1.0; + k6 -= 1.0; + k7 += 2.0; + k8 += 2.0; + + if ((fabs(qk) + fabs(pk)) > big) + { + pkm2 *= biginv; + pkm1 *= biginv; + qkm2 *= biginv; + qkm1 *= biginv; + } + if ((fabs(qk) < biginv) || (fabs(pk) < biginv)) + { + pkm2 *= big; + pkm1 *= big; + qkm2 *= big; + qkm1 *= big; + } + } while (++n < 300); cdone: -return(ans); + return (ans); } - /* Continued fraction expansion #2 * for incomplete beta integral */ -static double incbd( a, b, x ) +static double incbd(a, b, x) double a, b, x; { -double xk, pk, pkm1, pkm2, qk, qkm1, qkm2; -double k1, k2, k3, k4, k5, k6, k7, k8; -double r, t, ans, z, thresh; -int n; - -k1 = a; -k2 = b - 1.0; -k3 = a; -k4 = a + 1.0; -k5 = 1.0; -k6 = a + b; -k7 = a + 1.0;; -k8 = a + 2.0; - -pkm2 = 0.0; -qkm2 = 1.0; -pkm1 = 1.0; -qkm1 = 1.0; -z = x / (1.0-x); -ans = 1.0; -r = 1.0; -n = 0; -thresh = 3.0 * MACHEP; -do - { - - xk = -( z * k1 * k2 )/( k3 * k4 ); - pk = pkm1 + pkm2 * xk; - qk = qkm1 + qkm2 * xk; - pkm2 = pkm1; - pkm1 = pk; - qkm2 = qkm1; - qkm1 = qk; - - xk = ( z * k5 * k6 )/( k7 * k8 ); - pk = pkm1 + pkm2 * xk; - qk = qkm1 + qkm2 * xk; - pkm2 = pkm1; - pkm1 = pk; - qkm2 = qkm1; - qkm1 = qk; - - if( qk != 0 ) - r = pk/qk; - if( r != 0 ) - { - t = fabs( (ans - r)/r ); - ans = r; - } - else - t = 1.0; - - if( t < thresh ) - goto cdone; - - k1 += 1.0; - k2 -= 1.0; - k3 += 2.0; - k4 += 2.0; - k5 += 1.0; - k6 += 1.0; - k7 += 2.0; - k8 += 2.0; - - if( (fabs(qk) + fabs(pk)) > big ) - { - pkm2 *= biginv; - pkm1 *= biginv; - qkm2 *= biginv; - qkm1 *= biginv; - } - if( (fabs(qk) < biginv) || (fabs(pk) < biginv) ) - { - pkm2 *= big; - pkm1 *= big; - qkm2 *= big; - qkm1 *= big; - } - } -while( ++n < 300 ); + double xk, pk, pkm1, pkm2, qk, qkm1, qkm2; + double k1, k2, k3, k4, k5, k6, k7, k8; + double r, t, ans, z, thresh; + int n; + + k1 = a; + k2 = b - 1.0; + k3 = a; + k4 = a + 1.0; + k5 = 1.0; + k6 = a + b; + k7 = a + 1.0; + ; + k8 = a + 2.0; + + pkm2 = 0.0; + qkm2 = 1.0; + pkm1 = 1.0; + qkm1 = 1.0; + z = x / (1.0 - x); + ans = 1.0; + r = 1.0; + n = 0; + thresh = 3.0 * MACHEP; + do + { + + xk = -(z * k1 * k2) / (k3 * k4); + pk = pkm1 + pkm2 * xk; + qk = qkm1 + qkm2 * xk; + pkm2 = pkm1; + pkm1 = pk; + qkm2 = qkm1; + qkm1 = qk; + + xk = (z * k5 * k6) / (k7 * k8); + pk = pkm1 + pkm2 * xk; + qk = qkm1 + qkm2 * xk; + pkm2 = pkm1; + pkm1 = pk; + qkm2 = qkm1; + qkm1 = qk; + + if (qk != 0) + r = pk / qk; + if (r != 0) + { + t = fabs((ans - r) / r); + ans = r; + } + else + t = 1.0; + + if (t < thresh) + goto cdone; + + k1 += 1.0; + k2 -= 1.0; + k3 += 2.0; + k4 += 2.0; + k5 += 1.0; + k6 += 1.0; + k7 += 2.0; + k8 += 2.0; + + if ((fabs(qk) + fabs(pk)) > big) + { + pkm2 *= biginv; + pkm1 *= biginv; + qkm2 *= biginv; + qkm1 *= biginv; + } + if ((fabs(qk) < biginv) || (fabs(pk) < biginv)) + { + pkm2 *= big; + pkm1 *= big; + qkm2 *= big; + qkm1 *= big; + } + } while (++n < 300); cdone: -return(ans); + return (ans); } - + /* Power series for incomplete beta integral. Use when b*x is small and x not too close to 1. */ -static double pseries( a, b, x ) +static double pseries(a, b, x) double a, b, x; { -double s, t, u, v, n, t1, z, ai; - -ai = 1.0 / a; -u = (1.0 - b) * x; -v = u / (a + 1.0); -t1 = v; -t = u; -n = 2.0; -s = 0.0; -z = MACHEP * ai; -while( fabs(v) > z ) - { - u = (n - b) * x / n; - t *= u; - v = t / (a + n); - s += v; - n += 1.0; - } -s += t1; -s += ai; - -u = a * log(x); -if( (a+b) < MAXGAM && fabs(u) < MAXLOG ) - { - t = gamma(a+b)/(gamma(a)*gamma(b)); - s = s * t * pow(x,a); - } -else - { - t = lgam(a+b) - lgam(a) - lgam(b) + u + log(s); - if( t < MINLOG ) - s = 0.0; - else - s = exp(t); - } -return(s); + double s, t, u, v, n, t1, z, ai; + + ai = 1.0 / a; + u = (1.0 - b) * x; + v = u / (a + 1.0); + t1 = v; + t = u; + n = 2.0; + s = 0.0; + z = MACHEP * ai; + while (fabs(v) > z) + { + u = (n - b) * x / n; + t *= u; + v = t / (a + n); + s += v; + n += 1.0; + } + s += t1; + s += ai; + + u = a * log(x); + if ((a + b) < MAXGAM && fabs(u) < MAXLOG) + { + t = gamma(a + b) / (gamma(a) * gamma(b)); + s = s * t * pow(x, a); + } + else + { + t = lgam(a + b) - lgam(a) - lgam(b) + u + log(s); + if (t < MINLOG) + s = 0.0; + else + s = exp(t); + } + return (s); } diff --git a/cephes/cprob/incbi.c b/cephes/cprob/incbi.c index a4766cf..57d2f47 100644 --- a/cephes/cprob/incbi.c +++ b/cephes/cprob/incbi.c @@ -37,7 +37,6 @@ * With a = .5, b constrained to half-integer or integer values: * IEEE 0,1 .5,10000 10000 8.3e-11 1.0e-11 */ - /* Cephes Math Library Release 2.8: June, 2000 @@ -48,266 +47,263 @@ Copyright 1984, 1996, 2000 by Stephen L. Moshier extern double MACHEP, MAXNUM, MAXLOG, MINLOG; #ifdef ANSIPROT -extern double ndtri ( double ); -extern double exp ( double ); -extern double fabs ( double ); -extern double log ( double ); -extern double sqrt ( double ); -extern double lgam ( double ); -extern double incbet ( double, double, double ); +extern double ndtri(double); +extern double exp(double); +extern double fabs(double); +extern double log(double); +extern double sqrt(double); +extern double lgam(double); +extern double incbet(double, double, double); #else double ndtri(), exp(), fabs(), log(), sqrt(), lgam(), incbet(); #endif -double incbi( aa, bb, yy0 ) +double incbi(aa, bb, yy0) double aa, bb, yy0; { -double a, b, y0, d, y, x, x0, x1, lgm, yp, di, dithresh, yl, yh, xt; -int i, rflg, dir, nflg; + double a, b, y0, d, y, x, x0, x1, lgm, yp, di, dithresh, yl, yh, xt; + int i, rflg, dir, nflg; + i = 0; + if (yy0 <= 0) + return (0.0); + if (yy0 >= 1.0) + return (1.0); + x0 = 0.0; + yl = 0.0; + x1 = 1.0; + yh = 1.0; + nflg = 0; -i = 0; -if( yy0 <= 0 ) - return(0.0); -if( yy0 >= 1.0 ) - return(1.0); -x0 = 0.0; -yl = 0.0; -x1 = 1.0; -yh = 1.0; -nflg = 0; + if (aa <= 1.0 || bb <= 1.0) + { + dithresh = 1.0e-6; + rflg = 0; + a = aa; + b = bb; + y0 = yy0; + x = a / (a + b); + y = incbet(a, b, x); + goto ihalve; + } + else + { + dithresh = 1.0e-4; + } + /* approximation to inverse function */ -if( aa <= 1.0 || bb <= 1.0 ) - { - dithresh = 1.0e-6; - rflg = 0; - a = aa; - b = bb; - y0 = yy0; - x = a/(a+b); - y = incbet( a, b, x ); - goto ihalve; - } -else - { - dithresh = 1.0e-4; - } -/* approximation to inverse function */ + yp = -ndtri(yy0); -yp = -ndtri(yy0); + if (yy0 > 0.5) + { + rflg = 1; + a = bb; + b = aa; + y0 = 1.0 - yy0; + yp = -yp; + } + else + { + rflg = 0; + a = aa; + b = bb; + y0 = yy0; + } -if( yy0 > 0.5 ) - { - rflg = 1; - a = bb; - b = aa; - y0 = 1.0 - yy0; - yp = -yp; - } -else - { - rflg = 0; - a = aa; - b = bb; - y0 = yy0; - } - -lgm = (yp * yp - 3.0)/6.0; -x = 2.0/( 1.0/(2.0*a-1.0) + 1.0/(2.0*b-1.0) ); -d = yp * sqrt( x + lgm ) / x - - ( 1.0/(2.0*b-1.0) - 1.0/(2.0*a-1.0) ) - * (lgm + 5.0/6.0 - 2.0/(3.0*x)); -d = 2.0 * d; -if( d < MINLOG ) - { - x = 1.0; - goto under; - } -x = a/( a + b * exp(d) ); -y = incbet( a, b, x ); -yp = (y - y0)/y0; -if( fabs(yp) < 0.2 ) - goto newt; + lgm = (yp * yp - 3.0) / 6.0; + x = 2.0 / (1.0 / (2.0 * a - 1.0) + 1.0 / (2.0 * b - 1.0)); + d = yp * sqrt(x + lgm) / x - (1.0 / (2.0 * b - 1.0) - 1.0 / (2.0 * a - 1.0)) * (lgm + 5.0 / 6.0 - 2.0 / (3.0 * x)); + d = 2.0 * d; + if (d < MINLOG) + { + x = 1.0; + goto under; + } + x = a / (a + b * exp(d)); + y = incbet(a, b, x); + yp = (y - y0) / y0; + if (fabs(yp) < 0.2) + goto newt; /* Resort to interval halving if not close enough. */ ihalve: -dir = 0; -di = 0.5; -for( i=0; i<100; i++ ) - { - if( i != 0 ) - { - x = x0 + di * (x1 - x0); - if( x == 1.0 ) - x = 1.0 - MACHEP; - if( x == 0.0 ) - { - di = 0.5; - x = x0 + di * (x1 - x0); - if( x == 0.0 ) - goto under; - } - y = incbet( a, b, x ); - yp = (x1 - x0)/(x1 + x0); - if( fabs(yp) < dithresh ) - goto newt; - yp = (y-y0)/y0; - if( fabs(yp) < dithresh ) - goto newt; - } - if( y < y0 ) - { - x0 = x; - yl = y; - if( dir < 0 ) - { - dir = 0; - di = 0.5; - } - else if( dir > 3 ) - di = 1.0 - (1.0 - di) * (1.0 - di); - else if( dir > 1 ) - di = 0.5 * di + 0.5; - else - di = (y0 - y)/(yh - yl); - dir += 1; - if( x0 > 0.75 ) - { - if( rflg == 1 ) - { - rflg = 0; - a = aa; - b = bb; - y0 = yy0; - } - else - { - rflg = 1; - a = bb; - b = aa; - y0 = 1.0 - yy0; - } - x = 1.0 - x; - y = incbet( a, b, x ); - x0 = 0.0; - yl = 0.0; - x1 = 1.0; - yh = 1.0; - goto ihalve; - } - } - else - { - x1 = x; - if( rflg == 1 && x1 < MACHEP ) - { - x = 0.0; - goto done; - } - yh = y; - if( dir > 0 ) - { - dir = 0; - di = 0.5; - } - else if( dir < -3 ) - di = di * di; - else if( dir < -1 ) - di = 0.5 * di; - else - di = (y - y0)/(yh - yl); - dir -= 1; - } - } -mtherr( "incbi", PLOSS ); -if( x0 >= 1.0 ) - { - x = 1.0 - MACHEP; - goto done; - } -if( x <= 0.0 ) - { -under: - mtherr( "incbi", UNDERFLOW ); - x = 0.0; - goto done; - } + dir = 0; + di = 0.5; + for (i = 0; i < 100; i++) + { + if (i != 0) + { + x = x0 + di * (x1 - x0); + if (x == 1.0) + x = 1.0 - MACHEP; + if (x == 0.0) + { + di = 0.5; + x = x0 + di * (x1 - x0); + if (x == 0.0) + goto under; + } + y = incbet(a, b, x); + yp = (x1 - x0) / (x1 + x0); + if (fabs(yp) < dithresh) + goto newt; + yp = (y - y0) / y0; + if (fabs(yp) < dithresh) + goto newt; + } + if (y < y0) + { + x0 = x; + yl = y; + if (dir < 0) + { + dir = 0; + di = 0.5; + } + else if (dir > 3) + di = 1.0 - (1.0 - di) * (1.0 - di); + else if (dir > 1) + di = 0.5 * di + 0.5; + else + di = (y0 - y) / (yh - yl); + dir += 1; + if (x0 > 0.75) + { + if (rflg == 1) + { + rflg = 0; + a = aa; + b = bb; + y0 = yy0; + } + else + { + rflg = 1; + a = bb; + b = aa; + y0 = 1.0 - yy0; + } + x = 1.0 - x; + y = incbet(a, b, x); + x0 = 0.0; + yl = 0.0; + x1 = 1.0; + yh = 1.0; + goto ihalve; + } + } + else + { + x1 = x; + if (rflg == 1 && x1 < MACHEP) + { + x = 0.0; + goto done; + } + yh = y; + if (dir > 0) + { + dir = 0; + di = 0.5; + } + else if (dir < -3) + di = di * di; + else if (dir < -1) + di = 0.5 * di; + else + di = (y - y0) / (yh - yl); + dir -= 1; + } + } + mtherr("incbi", PLOSS); + if (x0 >= 1.0) + { + x = 1.0 - MACHEP; + goto done; + } + if (x <= 0.0) + { + under: + mtherr("incbi", UNDERFLOW); + x = 0.0; + goto done; + } newt: -if( nflg ) - goto done; -nflg = 1; -lgm = lgam(a+b) - lgam(a) - lgam(b); + if (nflg) + goto done; + nflg = 1; + lgm = lgam(a + b) - lgam(a) - lgam(b); -for( i=0; i<8; i++ ) - { - /* Compute the function at this point. */ - if( i != 0 ) - y = incbet(a,b,x); - if( y < yl ) - { - x = x0; - y = yl; - } - else if( y > yh ) - { - x = x1; - y = yh; - } - else if( y < y0 ) - { - x0 = x; - yl = y; - } - else - { - x1 = x; - yh = y; - } - if( x == 1.0 || x == 0.0 ) - break; - /* Compute the derivative of the function at this point. */ - d = (a - 1.0) * log(x) + (b - 1.0) * log(1.0-x) + lgm; - if( d < MINLOG ) - goto done; - if( d > MAXLOG ) - break; - d = exp(d); - /* Compute the step to the next approximation of x. */ - d = (y - y0)/d; - xt = x - d; - if( xt <= x0 ) - { - y = (x - x0) / (x1 - x0); - xt = x0 + 0.5 * y * (x - x0); - if( xt <= 0.0 ) - break; - } - if( xt >= x1 ) - { - y = (x1 - x) / (x1 - x0); - xt = x1 - 0.5 * y * (x1 - x); - if( xt >= 1.0 ) - break; - } - x = xt; - if( fabs(d/x) < 128.0 * MACHEP ) - goto done; - } -/* Did not converge. */ -dithresh = 256.0 * MACHEP; -goto ihalve; + for (i = 0; i < 8; i++) + { + /* Compute the function at this point. */ + if (i != 0) + y = incbet(a, b, x); + if (y < yl) + { + x = x0; + y = yl; + } + else if (y > yh) + { + x = x1; + y = yh; + } + else if (y < y0) + { + x0 = x; + yl = y; + } + else + { + x1 = x; + yh = y; + } + if (x == 1.0 || x == 0.0) + break; + /* Compute the derivative of the function at this point. */ + d = (a - 1.0) * log(x) + (b - 1.0) * log(1.0 - x) + lgm; + if (d < MINLOG) + goto done; + if (d > MAXLOG) + break; + d = exp(d); + /* Compute the step to the next approximation of x. */ + d = (y - y0) / d; + xt = x - d; + if (xt <= x0) + { + y = (x - x0) / (x1 - x0); + xt = x0 + 0.5 * y * (x - x0); + if (xt <= 0.0) + break; + } + if (xt >= x1) + { + y = (x1 - x) / (x1 - x0); + xt = x1 - 0.5 * y * (x1 - x); + if (xt >= 1.0) + break; + } + x = xt; + if (fabs(d / x) < 128.0 * MACHEP) + goto done; + } + /* Did not converge. */ + dithresh = 256.0 * MACHEP; + goto ihalve; done: -if( rflg ) - { - if( x <= MACHEP ) - x = 1.0 - MACHEP; - else - x = 1.0 - x; - } -return( x ); + if (rflg) + { + if (x <= MACHEP) + x = 1.0 - MACHEP; + else + x = 1.0 - x; + } + return (x); } diff --git a/cephes/cprob/kolmogorov.c b/cephes/cprob/kolmogorov.c index c65b544..96b2d5f 100644 --- a/cephes/cprob/kolmogorov.c +++ b/cephes/cprob/kolmogorov.c @@ -18,226 +18,208 @@ [n(1-e)] is the largest integer not exceeding n(1-e). nCv is the number of combinations of n things taken v at a time. */ - #include "mconf.h" #ifdef ANSIPROT -extern double pow ( double, double ); -extern double floor ( double ); -extern double lgam ( double ); -extern double exp ( double ); -extern double sqrt ( double ); -extern double log ( double ); -extern double fabs ( double ); -double smirnov ( int, double ); -double kolmogorov ( double ); +extern double pow(double, double); +extern double floor(double); +extern double lgam(double); +extern double exp(double); +extern double sqrt(double); +extern double log(double); +extern double fabs(double); +double smirnov(int, double); +double kolmogorov(double); #else -double pow (), floor (), lgam (), exp (), sqrt (), log (), fabs (); -double smirnov (), kolmogorov (); +double pow(), floor(), lgam(), exp(), sqrt(), log(), fabs(); +double smirnov(), kolmogorov(); #endif extern double MAXLOG; /* Exact Smirnov statistic, for one-sided test. */ -double -smirnov (n, e) - int n; - double e; +double smirnov(n, e) +int n; +double e; { - int v, nn; - double evn, omevn, p, t, c, lgamnp1; - - if (n <= 0 || e < 0.0 || e > 1.0) - return (-1.0); - nn = floor ((double) n * (1.0 - e)); - p = 0.0; - if (n < 1013) + int v, nn; + double evn, omevn, p, t, c, lgamnp1; + + if (n <= 0 || e < 0.0 || e > 1.0) + return (-1.0); + nn = floor((double)n * (1.0 - e)); + p = 0.0; + if (n < 1013) { - c = 1.0; - for (v = 0; v <= nn; v++) - { - evn = e + ((double) v) / n; - p += c * pow (evn, (double) (v - 1)) - * pow (1.0 - evn, (double) (n - v)); - /* Next combinatorial term; worst case error = 4e-15. */ - c *= ((double) (n - v)) / (v + 1); - } + c = 1.0; + for (v = 0; v <= nn; v++) + { + evn = e + ((double)v) / n; + p += c * pow(evn, (double)(v - 1)) * pow(1.0 - evn, (double)(n - v)); + /* Next combinatorial term; worst case error = 4e-15. */ + c *= ((double)(n - v)) / (v + 1); + } } - else + else { - lgamnp1 = lgam ((double) (n + 1)); - for (v = 0; v <= nn; v++) - { - evn = e + ((double) v) / n; - omevn = 1.0 - evn; - if (fabs (omevn) > 0.0) - { - t = lgamnp1 - - lgam ((double) (v + 1)) - - lgam ((double) (n - v + 1)) - + (v - 1) * log (evn) - + (n - v) * log (omevn); - if (t > -MAXLOG) - p += exp (t); - } - } + lgamnp1 = lgam((double)(n + 1)); + for (v = 0; v <= nn; v++) + { + evn = e + ((double)v) / n; + omevn = 1.0 - evn; + if (fabs(omevn) > 0.0) + { + t = lgamnp1 - lgam((double)(v + 1)) - lgam((double)(n - v + 1)) + (v - 1) * log(evn) + + (n - v) * log(omevn); + if (t > -MAXLOG) + p += exp(t); + } + } } - return (p * e); + return (p * e); } - /* Kolmogorov's limiting distribution of two-sided test, returns probability that sqrt(n) * max deviation > y, or that max deviation > y/sqrt(n). The approximation is useful for the tail of the distribution when n is large. */ -double -kolmogorov (y) - double y; +double kolmogorov(y) +double y; { - double p, t, r, sign, x; + double p, t, r, sign, x; - x = -2.0 * y * y; - sign = 1.0; - p = 0.0; - r = 1.0; - do + x = -2.0 * y * y; + sign = 1.0; + p = 0.0; + r = 1.0; + do { - t = exp (x * r * r); - p += sign * t; - if (t == 0.0) - break; - r += 1.0; - sign = -sign; - } - while ((t / p) > 1.1e-16); - return (p + p); + t = exp(x * r * r); + p += sign * t; + if (t == 0.0) + break; + r += 1.0; + sign = -sign; + } while ((t / p) > 1.1e-16); + return (p + p); } /* Functional inverse of Smirnov distribution finds e such that smirnov(n,e) = p. */ -double -smirnovi (n, p) - int n; - double p; +double smirnovi(n, p) +int n; +double p; { - double e, t, dpde; + double e, t, dpde; - if (p <= 0.0 || p > 1.0) + if (p <= 0.0 || p > 1.0) { - mtherr ("smirnovi", DOMAIN); - return 0.0; + mtherr("smirnovi", DOMAIN); + return 0.0; } - /* Start with approximation p = exp(-2 n e^2). */ - e = sqrt (-log (p) / (2.0 * n)); - do + /* Start with approximation p = exp(-2 n e^2). */ + e = sqrt(-log(p) / (2.0 * n)); + do { - /* Use approximate derivative in Newton iteration. */ - t = -2.0 * n * e; - dpde = 2.0 * t * exp (t * e); - if (fabs (dpde) > 0.0) - t = (p - smirnov (n, e)) / dpde; - else - { - mtherr ("smirnovi", UNDERFLOW); - return 0.0; - } - e = e + t; - if (e >= 1.0 || e <= 0.0) - { - mtherr ("smirnovi", OVERFLOW); - return 0.0; - } - } - while (fabs (t / e) > 1e-10); - return (e); + /* Use approximate derivative in Newton iteration. */ + t = -2.0 * n * e; + dpde = 2.0 * t * exp(t * e); + if (fabs(dpde) > 0.0) + t = (p - smirnov(n, e)) / dpde; + else + { + mtherr("smirnovi", UNDERFLOW); + return 0.0; + } + e = e + t; + if (e >= 1.0 || e <= 0.0) + { + mtherr("smirnovi", OVERFLOW); + return 0.0; + } + } while (fabs(t / e) > 1e-10); + return (e); } - /* Functional inverse of Kolmogorov statistic for two-sided test. Finds y such that kolmogorov(y) = p. If e = smirnovi (n,p), then kolmogi(2 * p) / sqrt(n) should be close to e. */ -double -kolmogi (p) - double p; +double kolmogi(p) +double p; { - double y, t, dpdy; + double y, t, dpdy; - if (p <= 0.0 || p > 1.0) + if (p <= 0.0 || p > 1.0) { - mtherr ("kolmogi", DOMAIN); - return 0.0; + mtherr("kolmogi", DOMAIN); + return 0.0; } - /* Start with approximation p = 2 exp(-2 y^2). */ - y = sqrt (-0.5 * log (0.5 * p)); - do + /* Start with approximation p = 2 exp(-2 y^2). */ + y = sqrt(-0.5 * log(0.5 * p)); + do { - /* Use approximate derivative in Newton iteration. */ - t = -2.0 * y; - dpdy = 4.0 * t * exp (t * y); - if (fabs (dpdy) > 0.0) - t = (p - kolmogorov (y)) / dpdy; - else - { - mtherr ("kolmogi", UNDERFLOW); - return 0.0; - } - y = y + t; - } - while (fabs (t / y) > 1e-10); - return (y); + /* Use approximate derivative in Newton iteration. */ + t = -2.0 * y; + dpdy = 4.0 * t * exp(t * y); + if (fabs(dpdy) > 0.0) + t = (p - kolmogorov(y)) / dpdy; + else + { + mtherr("kolmogi", UNDERFLOW); + return 0.0; + } + y = y + t; + } while (fabs(t / y) > 1e-10); + return (y); } - #ifdef SALONE /* Type in a number. */ -void -getnum (s, px) - char *s; - double *px; +void getnum(s, px) char *s; +double *px; { - char str[30]; - - printf (" %s (%.15e) ? ", s, *px); - gets (str); - if (str[0] == '\0' || str[0] == '\n') - return; - sscanf (str, "%lf", px); - printf ("%.15e\n", *px); + char str[30]; + + printf(" %s (%.15e) ? ", s, *px); + gets(str); + if (str[0] == '\0' || str[0] == '\n') + return; + sscanf(str, "%lf", px); + printf("%.15e\n", *px); } /* Type in values, get answers. */ -void -main () +void main() { - int n; - double e, p, ps, pk, ek, y; + int n; + double e, p, ps, pk, ek, y; - n = 5; - e = 0.0; - p = 0.1; + n = 5; + e = 0.0; + p = 0.1; loop: - ps = n; - getnum ("n", &ps); - n = ps; - if (n <= 0) + ps = n; + getnum("n", &ps); + n = ps; + if (n <= 0) { - printf ("? Operator error.\n"); - goto loop; + printf("? Operator error.\n"); + goto loop; } - /* - getnum ("e", &e); - ps = smirnov (n, e); - y = sqrt ((double) n) * e; - printf ("y = %.4e\n", y); - pk = kolmogorov (y); - printf ("Smirnov = %.15e, Kolmogorov/2 = %.15e\n", ps, pk / 2.0); -*/ - getnum ("p", &p); - e = smirnovi (n, p); - printf ("Smirnov e = %.15e\n", e); - y = kolmogi (2.0 * p); - ek = y / sqrt ((double) n); - printf ("Kolmogorov e = %.15e\n", ek); - goto loop; + /* + getnum ("e", &e); + ps = smirnov (n, e); + y = sqrt ((double) n) * e; + printf ("y = %.4e\n", y); + pk = kolmogorov (y); + printf ("Smirnov = %.15e, Kolmogorov/2 = %.15e\n", ps, pk / 2.0); + */ + getnum("p", &p); + e = smirnovi(n, p); + printf("Smirnov e = %.15e\n", e); + y = kolmogi(2.0 * p); + ek = y / sqrt((double)n); + printf("Kolmogorov e = %.15e\n", ek); + goto loop; } #endif diff --git a/cephes/cprob/nbdtr.c b/cephes/cprob/nbdtr.c index 701f79e..31d7f0b 100644 --- a/cephes/cprob/nbdtr.c +++ b/cephes/cprob/nbdtr.c @@ -42,7 +42,7 @@ * See also incbet.c. * */ - /* nbdtr.c +/* nbdtr.c * * Complemented negative binomial distribution * @@ -82,7 +82,7 @@ * IEEE 0,100 100000 1.7e-13 8.8e-15 * See also incbet.c. */ - /* nbdtr.c +/* nbdtr.c * * Functional inverse of negative binomial distribution * @@ -108,7 +108,7 @@ * IEEE 0,100 100000 1.5e-14 8.5e-16 * See also incbi.c. */ - + /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier @@ -116,71 +116,67 @@ Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier #include "mconf.h" #ifdef ANSIPROT -extern double incbet ( double, double, double ); -extern double incbi ( double, double, double ); +extern double incbet(double, double, double); +extern double incbi(double, double, double); #else double incbet(), incbi(); #endif -double nbdtrc( k, n, p ) +double nbdtrc(k, n, p) int k, n; double p; { -double dk, dn; + double dk, dn; -if( (p < 0.0) || (p > 1.0) ) - goto domerr; -if( k < 0 ) - { -domerr: - mtherr( "nbdtr", DOMAIN ); - return( 0.0 ); - } + if ((p < 0.0) || (p > 1.0)) + goto domerr; + if (k < 0) + { + domerr: + mtherr("nbdtr", DOMAIN); + return (0.0); + } -dk = k+1; -dn = n; -return( incbet( dk, dn, 1.0 - p ) ); + dk = k + 1; + dn = n; + return (incbet(dk, dn, 1.0 - p)); } - - -double nbdtr( k, n, p ) +double nbdtr(k, n, p) int k, n; double p; { -double dk, dn; + double dk, dn; -if( (p < 0.0) || (p > 1.0) ) - goto domerr; -if( k < 0 ) - { -domerr: - mtherr( "nbdtr", DOMAIN ); - return( 0.0 ); - } -dk = k+1; -dn = n; -return( incbet( dn, dk, p ) ); + if ((p < 0.0) || (p > 1.0)) + goto domerr; + if (k < 0) + { + domerr: + mtherr("nbdtr", DOMAIN); + return (0.0); + } + dk = k + 1; + dn = n; + return (incbet(dn, dk, p)); } - - -double nbdtri( k, n, p ) +double nbdtri(k, n, p) int k, n; double p; { -double dk, dn, w; + double dk, dn, w; -if( (p < 0.0) || (p > 1.0) ) - goto domerr; -if( k < 0 ) - { -domerr: - mtherr( "nbdtri", DOMAIN ); - return( 0.0 ); - } -dk = k+1; -dn = n; -w = incbi( dn, dk, p ); -return( w ); + if ((p < 0.0) || (p > 1.0)) + goto domerr; + if (k < 0) + { + domerr: + mtherr("nbdtri", DOMAIN); + return (0.0); + } + dk = k + 1; + dn = n; + w = incbi(dn, dk, p); + return (w); } diff --git a/cephes/cprob/ndtr.c b/cephes/cprob/ndtr.c index 5fe8100..416e0f4 100644 --- a/cephes/cprob/ndtr.c +++ b/cephes/cprob/ndtr.c @@ -45,7 +45,7 @@ * erfc underflow x > 37.519379347 0.0 * */ - /* erf.c +/* erf.c * * Error function * @@ -63,7 +63,7 @@ * * The integral is * - * x + * x * - * 2 | | 2 * erf(x) = -------- | exp( - t ) dt. @@ -87,7 +87,7 @@ * IEEE 0,1 30000 3.7e-16 1.0e-16 * */ - /* erfc.c +/* erfc.c * * Complementary error function * @@ -106,7 +106,7 @@ * * 1 - erf(x) = * - * inf. + * inf. * - * 2 | | 2 * erfc(x) = -------- | exp( - t ) dt @@ -136,14 +136,12 @@ * * */ - /* Cephes Math Library Release 2.9: November, 2000 Copyright 1984, 1987, 1988, 1992, 2000 by Stephen L. Moshier */ - #include "mconf.h" extern double SQRTH; @@ -154,6 +152,7 @@ extern double MAXLOG; generates two calls to the exponential function instead of one. */ #define USE_EXPXSQ 1 +/* clang-format off */ #ifdef UNK static double P[] = { 2.46196981473530512524E-10, @@ -383,18 +382,19 @@ static unsigned short U[] = { }; #define UTHRESH 37.519379347 #endif +/* clang-format on */ #ifdef ANSIPROT -extern double polevl ( double, void *, int ); -extern double p1evl ( double, void *, int ); -extern double exp ( double ); -extern double log ( double ); -extern double fabs ( double ); -extern double sqrt ( double ); -extern double expx2 ( double, int ); -double erf ( double ); -double erfc ( double ); -static double erfce ( double ); +extern double polevl(double, void *, int); +extern double p1evl(double, void *, int); +extern double exp(double); +extern double log(double); +extern double fabs(double); +extern double sqrt(double); +extern double expx2(double, int); +double erf(double); +double erfc(double); +static double erfce(double); #else double polevl(), p1evl(), exp(), log(), fabs(); double erf(), erfc(), expx2(), sqrt(); @@ -404,88 +404,85 @@ static double erfce(); double ndtr(a) double a; { -double x, y, z; + double x, y, z; -x = a * SQRTH; -z = fabs(x); + x = a * SQRTH; + z = fabs(x); -/* if( z < SQRTH ) */ -if( z < 1.0 ) - y = 0.5 + 0.5 * erf(x); + /* if( z < SQRTH ) */ + if (z < 1.0) + y = 0.5 + 0.5 * erf(x); -else - { + else + { #ifdef USE_EXPXSQ - /* See below for erfce. */ - y = 0.5 * erfce(z); - /* Multiply by exp(-x^2 / 2) */ - z = expx2(a, -1); - y = y * sqrt(z); + /* See below for erfce. */ + y = 0.5 * erfce(z); + /* Multiply by exp(-x^2 / 2) */ + z = expx2(a, -1); + y = y * sqrt(z); #else - y = 0.5 * erfc(z); + y = 0.5 * erfc(z); #endif - if( x > 0 ) - y = 1.0 - y; - } + if (x > 0) + y = 1.0 - y; + } -return(y); + return (y); } - double erfc(a) double a; { -double p,q,x,y,z; - + double p, q, x, y, z; -if( a < 0.0 ) - x = -a; -else - x = a; + if (a < 0.0) + x = -a; + else + x = a; -if( x < 1.0 ) - return( 1.0 - erf(a) ); + if (x < 1.0) + return (1.0 - erf(a)); -z = -a * a; + z = -a * a; -if( z < -MAXLOG ) - { -under: - mtherr( "erfc", UNDERFLOW ); - if( a < 0 ) - return( 2.0 ); - else - return( 0.0 ); - } + if (z < -MAXLOG) + { + under: + mtherr("erfc", UNDERFLOW); + if (a < 0) + return (2.0); + else + return (0.0); + } #ifdef USE_EXPXSQ -/* Compute z = exp(z). */ -z = expx2(a, -1); + /* Compute z = exp(z). */ + z = expx2(a, -1); #else -z = exp(z); + z = exp(z); #endif -if( x < 8.0 ) - { - p = polevl( x, P, 8 ); - q = p1evl( x, Q, 8 ); - } -else - { - p = polevl( x, R, 5 ); - q = p1evl( x, S, 6 ); - } -y = (z * p)/q; - -if( a < 0 ) - y = 2.0 - y; - -if( y == 0.0 ) - goto under; - -return(y); + if (x < 8.0) + { + p = polevl(x, P, 8); + q = p1evl(x, Q, 8); + } + else + { + p = polevl(x, R, 5); + q = p1evl(x, S, 6); + } + y = (z * p) / q; + + if (a < 0) + y = 2.0 - y; + + if (y == 0.0) + goto under; + + return (y); } - /* Exponentially scaled erfc function exp(x^2) erfc(x) valid for x > 1. @@ -493,32 +490,29 @@ return(y); static double erfce(x) double x; { -double p,q; - -if( x < 8.0 ) - { - p = polevl( x, P, 8 ); - q = p1evl( x, Q, 8 ); - } -else - { - p = polevl( x, R, 5 ); - q = p1evl( x, S, 6 ); - } -return (p/q); + double p, q; + + if (x < 8.0) + { + p = polevl(x, P, 8); + q = p1evl(x, Q, 8); + } + else + { + p = polevl(x, R, 5); + q = p1evl(x, S, 6); + } + return (p / q); } - - double erf(x) double x; { -double y, z; - -if( fabs(x) > 1.0 ) - return( 1.0 - erfc(x) ); -z = x * x; -y = x * polevl( z, T, 4 ) / p1evl( z, U, 5 ); -return( y ); + double y, z; + if (fabs(x) > 1.0) + return (1.0 - erfc(x)); + z = x * x; + y = x * polevl(z, T, 4) / p1evl(z, U, 5); + return (y); } diff --git a/cephes/cprob/ndtri.c b/cephes/cprob/ndtri.c index 1a788cd..67514d2 100644 --- a/cephes/cprob/ndtri.c +++ b/cephes/cprob/ndtri.c @@ -44,7 +44,6 @@ * ndtri domain x >= 1 MAXNUM * */ - /* Cephes Math Library Release 2.8: June, 2000 @@ -54,6 +53,7 @@ Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier #include "mconf.h" extern double MAXNUM; +/* clang-format off */ #ifdef UNK /* sqrt(2pi) */ static double s2pi = 2.50662827463100050242E0; @@ -359,12 +359,13 @@ static unsigned short Q2[32] = { 0x3e3d,0x29e5,0xb876,0x6b3d, }; #endif +/* clang-format on */ #ifdef ANSIPROT -extern double polevl ( double, void *, int ); -extern double p1evl ( double, void *, int ); -extern double log ( double ); -extern double sqrt ( double ); +extern double polevl(double, void *, int); +extern double p1evl(double, void *, int); +extern double log(double); +extern double sqrt(double); #else double polevl(), p1evl(), log(), sqrt(); #endif @@ -372,46 +373,46 @@ double polevl(), p1evl(), log(), sqrt(); double ndtri(y0) double y0; { -double x, y, z, y2, x0, x1; -int code; + double x, y, z, y2, x0, x1; + int code; -if( y0 <= 0.0 ) - { - mtherr( "ndtri", DOMAIN ); - return( -MAXNUM ); - } -if( y0 >= 1.0 ) - { - mtherr( "ndtri", DOMAIN ); - return( MAXNUM ); - } -code = 1; -y = y0; -if( y > (1.0 - 0.13533528323661269189) ) /* 0.135... = exp(-2) */ - { - y = 1.0 - y; - code = 0; - } + if (y0 <= 0.0) + { + mtherr("ndtri", DOMAIN); + return (-MAXNUM); + } + if (y0 >= 1.0) + { + mtherr("ndtri", DOMAIN); + return (MAXNUM); + } + code = 1; + y = y0; + if (y > (1.0 - 0.13533528323661269189)) /* 0.135... = exp(-2) */ + { + y = 1.0 - y; + code = 0; + } -if( y > 0.13533528323661269189 ) - { - y = y - 0.5; - y2 = y * y; - x = y + y * (y2 * polevl( y2, P0, 4)/p1evl( y2, Q0, 8 )); - x = x * s2pi; - return(x); - } + if (y > 0.13533528323661269189) + { + y = y - 0.5; + y2 = y * y; + x = y + y * (y2 * polevl(y2, P0, 4) / p1evl(y2, Q0, 8)); + x = x * s2pi; + return (x); + } -x = sqrt( -2.0 * log(y) ); -x0 = x - log(x)/x; + x = sqrt(-2.0 * log(y)); + x0 = x - log(x) / x; -z = 1.0/x; -if( x < 8.0 ) /* y > exp(-32) = 1.2664165549e-14 */ - x1 = z * polevl( z, P1, 8 )/p1evl( z, Q1, 8 ); -else - x1 = z * polevl( z, P2, 8 )/p1evl( z, Q2, 8 ); -x = x0 - x1; -if( code != 0 ) - x = -x; -return( x ); + z = 1.0 / x; + if (x < 8.0) /* y > exp(-32) = 1.2664165549e-14 */ + x1 = z * polevl(z, P1, 8) / p1evl(z, Q1, 8); + else + x1 = z * polevl(z, P2, 8) / p1evl(z, Q2, 8); + x = x0 - x1; + if (code != 0) + x = -x; + return (x); } diff --git a/cephes/cprob/pdtr.c b/cephes/cprob/pdtr.c index 7a198fe..a4dc137 100644 --- a/cephes/cprob/pdtr.c +++ b/cephes/cprob/pdtr.c @@ -38,7 +38,7 @@ * See igamc(). * */ - /* pdtrc() +/* pdtrc() * * Complemented poisson distribution * @@ -78,7 +78,7 @@ * See igam.c. * */ - /* pdtri() +/* pdtri() * * Inverse Poisson distribution * @@ -119,7 +119,7 @@ * k < 0 * */ - + /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier @@ -127,58 +127,55 @@ Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier #include "mconf.h" #ifdef ANSIPROT -extern double igam ( double, double ); -extern double igamc ( double, double ); -extern double igami ( double, double ); +extern double igam(double, double); +extern double igamc(double, double); +extern double igami(double, double); #else double igam(), igamc(), igami(); #endif -double pdtrc( k, m ) +double pdtrc(k, m) int k; double m; { -double v; + double v; -if( (k < 0) || (m <= 0.0) ) - { - mtherr( "pdtrc", DOMAIN ); - return( 0.0 ); - } -v = k+1; -return( igam( v, m ) ); + if ((k < 0) || (m <= 0.0)) + { + mtherr("pdtrc", DOMAIN); + return (0.0); + } + v = k + 1; + return (igam(v, m)); } - - -double pdtr( k, m ) +double pdtr(k, m) int k; double m; { -double v; + double v; -if( (k < 0) || (m <= 0.0) ) - { - mtherr( "pdtr", DOMAIN ); - return( 0.0 ); - } -v = k+1; -return( igamc( v, m ) ); + if ((k < 0) || (m <= 0.0)) + { + mtherr("pdtr", DOMAIN); + return (0.0); + } + v = k + 1; + return (igamc(v, m)); } - -double pdtri( k, y ) +double pdtri(k, y) int k; double y; { -double v; + double v; -if( (k < 0) || (y < 0.0) || (y >= 1.0) ) - { - mtherr( "pdtri", DOMAIN ); - return( 0.0 ); - } -v = k+1; -v = igami( v, y ); -return( v ); + if ((k < 0) || (y < 0.0) || (y >= 1.0)) + { + mtherr("pdtri", DOMAIN); + return (0.0); + } + v = k + 1; + v = igami(v, y); + return (v); } diff --git a/cephes/cprob/stdtr.c b/cephes/cprob/stdtr.c index 9e5c833..d8dadfc 100644 --- a/cephes/cprob/stdtr.c +++ b/cephes/cprob/stdtr.c @@ -28,7 +28,7 @@ * | | * - * -inf. - * + * * Relation to incomplete beta integral: * * 1 - stdtr(k,t) = 0.5 * incbet( k/2, 1/2, z ) @@ -40,7 +40,7 @@ * Since the function is symmetric about t=0, the area under the * right tail of the density is found by calling the function * with -t instead of t. - * + * * ACCURACY: * * Tested at random 1 <= k <= 25. The "domain" refers to t. @@ -49,7 +49,7 @@ * IEEE -100,-2 50000 5.9e-15 1.4e-15 * IEEE -2,100 500000 2.7e-15 4.9e-17 */ - + /* stdtri.c * * Functional inverse of Student's t distribution @@ -68,7 +68,7 @@ * * Given probability p, finds the argument t such that stdtr(k,t) * is equal to p. - * + * * ACCURACY: * * Tested at random 1 <= k <= 100. The "domain" refers to p: @@ -77,7 +77,6 @@ * IEEE .001,.999 25000 5.7e-15 8.0e-16 * IEEE 10^-6,.001 25000 2.0e-12 2.9e-14 */ - /* Cephes Math Library Release 2.8: June, 2000 @@ -88,138 +87,136 @@ Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier extern double PI, MACHEP, MAXNUM; #ifdef ANSIPROT -extern double sqrt ( double ); -extern double atan ( double ); -extern double incbet ( double, double, double ); -extern double incbi ( double, double, double ); -extern double fabs ( double ); +extern double sqrt(double); +extern double atan(double); +extern double incbet(double, double, double); +extern double incbi(double, double, double); +extern double fabs(double); #else double sqrt(), atan(), incbet(), incbi(), fabs(); #endif -double stdtr( k, t ) +double stdtr(k, t) int k; double t; { -double x, rk, z, f, tz, p, xsqk; -int j; - -if( k <= 0 ) - { - mtherr( "stdtr", DOMAIN ); - return(0.0); - } - -if( t == 0 ) - return( 0.5 ); - -if( t < -2.0 ) - { - rk = k; - z = rk / (rk + t * t); - p = 0.5 * incbet( 0.5*rk, 0.5, z ); - return( p ); - } - -/* compute integral from -t to + t */ - -if( t < 0 ) - x = -t; -else - x = t; - -rk = k; /* degrees of freedom */ -z = 1.0 + ( x * x )/rk; - -/* test if k is odd or even */ -if( (k & 1) != 0) - { - - /* computation for odd k */ - - xsqk = x/sqrt(rk); - p = atan( xsqk ); - if( k > 1 ) - { - f = 1.0; - tz = 1.0; - j = 3; - while( (j<=(k-2)) && ( (tz/f) > MACHEP ) ) - { - tz *= (j-1)/( z * j ); - f += tz; - j += 2; - } - p += f * xsqk/z; - } - p *= 2.0/PI; - } - - -else - { - - /* computation for even k */ - - f = 1.0; - tz = 1.0; - j = 2; - - while( ( j <= (k-2) ) && ( (tz/f) > MACHEP ) ) - { - tz *= (j - 1)/( z * j ); - f += tz; - j += 2; - } - p = f * x/sqrt(z*rk); - } - -/* common exit */ - - -if( t < 0 ) - p = -p; /* note destruction of relative accuracy */ - - p = 0.5 + 0.5 * p; -return(p); + double x, rk, z, f, tz, p, xsqk; + int j; + + if (k <= 0) + { + mtherr("stdtr", DOMAIN); + return (0.0); + } + + if (t == 0) + return (0.5); + + if (t < -2.0) + { + rk = k; + z = rk / (rk + t * t); + p = 0.5 * incbet(0.5 * rk, 0.5, z); + return (p); + } + + /* compute integral from -t to + t */ + + if (t < 0) + x = -t; + else + x = t; + + rk = k; /* degrees of freedom */ + z = 1.0 + (x * x) / rk; + + /* test if k is odd or even */ + if ((k & 1) != 0) + { + + /* computation for odd k */ + + xsqk = x / sqrt(rk); + p = atan(xsqk); + if (k > 1) + { + f = 1.0; + tz = 1.0; + j = 3; + while ((j <= (k - 2)) && ((tz / f) > MACHEP)) + { + tz *= (j - 1) / (z * j); + f += tz; + j += 2; + } + p += f * xsqk / z; + } + p *= 2.0 / PI; + } + + else + { + + /* computation for even k */ + + f = 1.0; + tz = 1.0; + j = 2; + + while ((j <= (k - 2)) && ((tz / f) > MACHEP)) + { + tz *= (j - 1) / (z * j); + f += tz; + j += 2; + } + p = f * x / sqrt(z * rk); + } + + /* common exit */ + + if (t < 0) + p = -p; /* note destruction of relative accuracy */ + + p = 0.5 + 0.5 * p; + return (p); } -double stdtri( k, p ) +double stdtri(k, p) int k; double p; { -double t, rk, z; -int rflg; - -if( k <= 0 || p <= 0.0 || p >= 1.0 ) - { - mtherr( "stdtri", DOMAIN ); - return(0.0); - } - -rk = k; - -if( p > 0.25 && p < 0.75 ) - { - if( p == 0.5 ) - return( 0.0 ); - z = 1.0 - 2.0 * p; - z = incbi( 0.5, 0.5*rk, fabs(z) ); - t = sqrt( rk*z/(1.0-z) ); - if( p < 0.5 ) - t = -t; - return( t ); - } -rflg = -1; -if( p >= 0.5) - { - p = 1.0 - p; - rflg = 1; - } -z = incbi( 0.5*rk, 0.5, 2.0*p ); - -if( MAXNUM * z < rk ) - return(rflg* MAXNUM); -t = sqrt( rk/z - rk ); -return( rflg * t ); + double t, rk, z; + int rflg; + + if (k <= 0 || p <= 0.0 || p >= 1.0) + { + mtherr("stdtri", DOMAIN); + return (0.0); + } + + rk = k; + + if (p > 0.25 && p < 0.75) + { + if (p == 0.5) + return (0.0); + z = 1.0 - 2.0 * p; + z = incbi(0.5, 0.5 * rk, fabs(z)); + t = sqrt(rk * z / (1.0 - z)); + if (p < 0.5) + t = -t; + return (t); + } + rflg = -1; + if (p >= 0.5) + { + p = 1.0 - p; + rflg = 1; + } + z = incbi(0.5 * rk, 0.5, 2.0 * p); + + if (MAXNUM * z < rk) + return (rflg * MAXNUM); + t = sqrt(rk / z - rk); + return (rflg * t); } diff --git a/cephes/ellf/borland.mak b/cephes/ellf/borland.mak index 8af9161..7254ae3 100644 --- a/cephes/ellf/borland.mak +++ b/cephes/ellf/borland.mak @@ -133,5 +133,3 @@ BccW32.cfg : -WC -A | $@ - - diff --git a/cephes/ellf/ellf.c b/cephes/ellf/ellf.c index 091256f..f83d3c9 100644 --- a/cephes/ellf/ellf.c +++ b/cephes/ellf/ellf.c @@ -1,19 +1,16 @@ /* ellf.c - * + * * Read ellf.doc before attempting to compile this program. */ - #include /* size of arrays: */ #define ARRSIZ 50 - /* System configurations */ #include "mconf.h" - extern double PI, PIO2, MACHEP, MAXNUM; static double aa[ARRSIZ]; @@ -89,544 +86,532 @@ static int nz = 0; static int type = 1; static int kind = 1; -static char wkind[] = -{"Filter kind:\n1 Butterworth\n2 Chebyshev\n3 Elliptic\n"}; +static char wkind[] = {"Filter kind:\n1 Butterworth\n2 Chebyshev\n3 Elliptic\n"}; -static char salut[] = -{"Filter shape:\n1 low pass\n2 band pass\n3 high pass\n4 band stop\n"}; +static char salut[] = {"Filter shape:\n1 low pass\n2 band pass\n3 high pass\n4 band stop\n"}; #ifdef ANSIPROT -extern double exp ( double ); -extern double log ( double ); -extern double cos ( double ); -extern double sin ( double ); -extern double sqrt ( double ); -extern double fabs ( double ); -extern double asin ( double ); -extern double atan ( double ); -extern double atan2 ( double, double ); -extern double pow ( double, double ); -extern double cabs ( cmplx *z ); -extern void cadd ( cmplx *a, cmplx *b, cmplx *c ); -extern void cdiv ( cmplx *a, cmplx *b, cmplx *c ); -extern void cmov ( void *a, void *b ); -extern void cmul ( cmplx *a, cmplx *b, cmplx *c ); -extern void cneg ( cmplx *a ); -extern void csqrt ( cmplx *z, cmplx *w ); -extern void csub ( cmplx *a, cmplx *b, cmplx *c ); -extern double ellie ( double phi, double m ); -extern double ellik ( double phi, double m ); -extern double ellpe ( double x ); -extern int ellpj ( double, double, double *, double *, double *, double * ); -extern double ellpk ( double x ); -int getnum ( char *line, double *val ); -double cay ( double q ); -int lampln ( void ); -int spln ( void ); -int xfun ( void ); -int zplna ( void ); -int zplnb ( void ); -int zplnc ( void ); -int quadf ( double, double, int ); -double response ( double, double ); +extern double exp(double); +extern double log(double); +extern double cos(double); +extern double sin(double); +extern double sqrt(double); +extern double fabs(double); +extern double asin(double); +extern double atan(double); +extern double atan2(double, double); +extern double pow(double, double); +extern double cabs(cmplx *z); +extern void cadd(cmplx *a, cmplx *b, cmplx *c); +extern void cdiv(cmplx *a, cmplx *b, cmplx *c); +extern void cmov(void *a, void *b); +extern void cmul(cmplx *a, cmplx *b, cmplx *c); +extern void cneg(cmplx *a); +extern void csqrt(cmplx *z, cmplx *w); +extern void csub(cmplx *a, cmplx *b, cmplx *c); +extern double ellie(double phi, double m); +extern double ellik(double phi, double m); +extern double ellpe(double x); +extern int ellpj(double, double, double *, double *, double *, double *); +extern double ellpk(double x); +int getnum(char *line, double *val); +double cay(double q); +int lampln(void); +int spln(void); +int xfun(void); +int zplna(void); +int zplnb(void); +int zplnc(void); +int quadf(double, double, int); +double response(double, double); #else double exp(), log(), cos(), sin(), sqrt(); double ellpk(), ellik(), asin(), atan(), atan2(), pow(); double cay(), cabs(); double response(); int lampln(), spln(), xfun(), zplna(), zplnb(), zplnc(), quadf(); -#define fabs(x) ( (x) < 0 ? -(x) : (x) ) +#define fabs(x) ((x) < 0 ? -(x) : (x)) #endif int main() { -char str[80]; + char str[80]; -dbfac = 10.0/log(10.0); + dbfac = 10.0 / log(10.0); top: -printf( "%s ? ", wkind ); /* ask for filter kind */ -gets( str ); -sscanf( str, "%d", &kind ); -printf( "%d\n", kind ); -if( (kind <= 0) || (kind > 3) ) - exit(0); - -printf( "%s ? ", salut ); /* ask for filter type */ -gets( str ); -sscanf( str, "%d", &type ); -printf( "%d\n", type ); -if( (type <= 0) || (type > 4) ) - exit(0); - -getnum( "Order of filter", &rn ); /* see below for getnum() */ -n = rn; -if( n <= 0 ) - { -specerr: - printf( "? Specification error\n" ); - goto top; - } -rn = n; /* ensure it is an integer */ -if( kind > 1 ) /* not Butterworth */ - { - getnum( "Passband ripple, db", &dbr ); - if( dbr <= 0.0 ) - goto specerr; - if( kind == 2 ) - { -/* For Chebyshev filter, ripples go from 1.0 to 1/sqrt(1+eps^2) */ - phi = exp( 0.5*dbr/dbfac ); - - if( (n & 1) == 0 ) - scale = phi; - else - scale = 1.0; - } - else - { /* elliptic */ - eps = exp( dbr/dbfac ); - scale = 1.0; - if( (n & 1) == 0 ) - scale = sqrt( eps ); - eps = sqrt( eps - 1.0 ); - } - } - -getnum( "Sampling frequency", &fs ); -if( fs <= 0.0 ) - goto specerr; - -fnyq = 0.5 * fs; - -getnum( "Passband edge", &f2 ); -if( (f2 <= 0.0) || (f2 >= fnyq) ) - goto specerr; - -if( (type & 1) == 0 ) - { - getnum( "Other passband edge", &f1 ); - if( (f1 <= 0.0) || (f1 >= fnyq) ) - goto specerr; - } -else - { - f1 = 0.0; - } - -if( f2 < f1 ) - { - a = f2; - f2 = f1; - f1 = a; - } -if( type == 3 ) /* high pass */ - { - bw = f2; - a = fnyq; - } -else - { - bw = f2 - f1; - a = f2; - } -/* Frequency correspondence for bilinear transformation - * - * Wanalog = tan( 2 pi Fdigital T / 2 ) - * - * where T = 1/fs - */ -ang = bw * PI / fs; -cang = cos( ang ); -c = sin(ang) / cang; /* Wanalog */ -if( kind != 3 ) - { - wc = c; -/*printf( "cos( 1/2 (Whigh-Wlow) T ) = %.5e, wc = %.5e\n", cang, wc );*/ - } - - -if( kind == 3 ) - { /* elliptic */ - cgam = cos( (a+f1) * PI / fs ) / cang; - getnum( "Stop band edge or -(db down)", &dbd ); - if( dbd > 0.0 ) - f3 = dbd; - else - { /* calculate band edge from db down */ - a = exp( -dbd/dbfac ); - m1 = eps/sqrt( a - 1.0 ); - m1 *= m1; - m1p = 1.0 - m1; - Kk1 = ellpk( m1p ); - Kpk1 = ellpk( m1 ); - q = exp( -PI * Kpk1 / (rn * Kk1) ); - k = cay(q); - if( type >= 3 ) - wr = k; - else - wr = 1.0/k; - if( type & 1 ) - { - f3 = atan( c * wr ) * fs / PI; - } - else - { - a = c * wr; - a *= a; - b = a * (1.0 - cgam * cgam) + a * a; - b = (cgam + sqrt(b))/(1.0 + a); - f3 = (PI/2.0 - asin(b)) * fs / (2.0*PI); - } - } -switch( type ) - { - case 1: - if( f3 <= f2 ) - goto specerr; - break; - - case 2: - if( (f3 > f2) || (f3 < f1) ) - break; - goto specerr; - - case 3: - if( f3 >= f2 ) - goto specerr; - break; - - case 4: - if( (f3 <= f1) || (f3 >= f2) ) - goto specerr; - break; - } -ang = f3 * PI / fs; -cang = cos(ang); -sang = sin(ang); - -if( type & 1 ) - { - wr = sang/(cang*c); - } -else - { - q = cang * cang - sang * sang; - sang = 2.0 * cang * sang; - cang = q; - wr = (cgam - cang)/(sang * c); - } - -if( type >= 3 ) - wr = 1.0/wr; -if( wr < 0.0 ) - wr = -wr; -y[0] = 1.0; -y[1] = wr; -cbp = wr; - -if( type >= 3 ) - y[1] = 1.0/y[1]; - -if( type & 1 ) - { - for( i=1; i<=2; i++ ) - { - aa[i] = atan( c * y[i-1] ) * fs / PI ; - } - printf( "pass band %.9E\n", aa[1] ); - printf( "stop band %.9E\n", aa[2] ); - } -else - { - for( i=1; i<=2; i++ ) - { - a = c * y[i-1]; - b = atan(a); - q = sqrt( 1.0 + a * a - cgam * cgam ); + printf("%s ? ", wkind); /* ask for filter kind */ + gets(str); + sscanf(str, "%d", &kind); + printf("%d\n", kind); + if ((kind <= 0) || (kind > 3)) + exit(0); + + printf("%s ? ", salut); /* ask for filter type */ + gets(str); + sscanf(str, "%d", &type); + printf("%d\n", type); + if ((type <= 0) || (type > 4)) + exit(0); + + getnum("Order of filter", &rn); /* see below for getnum() */ + n = rn; + if (n <= 0) + { + specerr: + printf("? Specification error\n"); + goto top; + } + rn = n; /* ensure it is an integer */ + if (kind > 1) /* not Butterworth */ + { + getnum("Passband ripple, db", &dbr); + if (dbr <= 0.0) + goto specerr; + if (kind == 2) + { + /* For Chebyshev filter, ripples go from 1.0 to 1/sqrt(1+eps^2) */ + phi = exp(0.5 * dbr / dbfac); + + if ((n & 1) == 0) + scale = phi; + else + scale = 1.0; + } + else + { /* elliptic */ + eps = exp(dbr / dbfac); + scale = 1.0; + if ((n & 1) == 0) + scale = sqrt(eps); + eps = sqrt(eps - 1.0); + } + } + + getnum("Sampling frequency", &fs); + if (fs <= 0.0) + goto specerr; + + fnyq = 0.5 * fs; + + getnum("Passband edge", &f2); + if ((f2 <= 0.0) || (f2 >= fnyq)) + goto specerr; + + if ((type & 1) == 0) + { + getnum("Other passband edge", &f1); + if ((f1 <= 0.0) || (f1 >= fnyq)) + goto specerr; + } + else + { + f1 = 0.0; + } + + if (f2 < f1) + { + a = f2; + f2 = f1; + f1 = a; + } + if (type == 3) /* high pass */ + { + bw = f2; + a = fnyq; + } + else + { + bw = f2 - f1; + a = f2; + } + /* Frequency correspondence for bilinear transformation + * + * Wanalog = tan( 2 pi Fdigital T / 2 ) + * + * where T = 1/fs + */ + ang = bw * PI / fs; + cang = cos(ang); + c = sin(ang) / cang; /* Wanalog */ + if (kind != 3) + { + wc = c; + /*printf( "cos( 1/2 (Whigh-Wlow) T ) = %.5e, wc = %.5e\n", cang, wc );*/ + } + + if (kind == 3) + { /* elliptic */ + cgam = cos((a + f1) * PI / fs) / cang; + getnum("Stop band edge or -(db down)", &dbd); + if (dbd > 0.0) + f3 = dbd; + else + { /* calculate band edge from db down */ + a = exp(-dbd / dbfac); + m1 = eps / sqrt(a - 1.0); + m1 *= m1; + m1p = 1.0 - m1; + Kk1 = ellpk(m1p); + Kpk1 = ellpk(m1); + q = exp(-PI * Kpk1 / (rn * Kk1)); + k = cay(q); + if (type >= 3) + wr = k; + else + wr = 1.0 / k; + if (type & 1) + { + f3 = atan(c * wr) * fs / PI; + } + else + { + a = c * wr; + a *= a; + b = a * (1.0 - cgam * cgam) + a * a; + b = (cgam + sqrt(b)) / (1.0 + a); + f3 = (PI / 2.0 - asin(b)) * fs / (2.0 * PI); + } + } + switch (type) + { + case 1: + if (f3 <= f2) + goto specerr; + break; + + case 2: + if ((f3 > f2) || (f3 < f1)) + break; + goto specerr; + + case 3: + if (f3 >= f2) + goto specerr; + break; + + case 4: + if ((f3 <= f1) || (f3 >= f2)) + goto specerr; + break; + } + ang = f3 * PI / fs; + cang = cos(ang); + sang = sin(ang); + + if (type & 1) + { + wr = sang / (cang * c); + } + else + { + q = cang * cang - sang * sang; + sang = 2.0 * cang * sang; + cang = q; + wr = (cgam - cang) / (sang * c); + } + + if (type >= 3) + wr = 1.0 / wr; + if (wr < 0.0) + wr = -wr; + y[0] = 1.0; + y[1] = wr; + cbp = wr; + + if (type >= 3) + y[1] = 1.0 / y[1]; + + if (type & 1) + { + for (i = 1; i <= 2; i++) + { + aa[i] = atan(c * y[i - 1]) * fs / PI; + } + printf("pass band %.9E\n", aa[1]); + printf("stop band %.9E\n", aa[2]); + } + else + { + for (i = 1; i <= 2; i++) + { + a = c * y[i - 1]; + b = atan(a); + q = sqrt(1.0 + a * a - cgam * cgam); #ifdef ANSIC - q = atan2( q, cgam ); + q = atan2(q, cgam); #else - q = atan2( cgam, q ); + q = atan2(cgam, q); #endif - aa[i] = (q + b) * fnyq / PI; - pp[i] = (q - b) * fnyq / PI; - } - printf( "pass band %.9E %.9E\n", pp[1], aa[1] ); - printf( "stop band %.9E %.9E\n", pp[2], aa[2] ); - } -lampln(); /* find locations in lambda plane */ -if( (2*n+2) > ARRSIZ ) - goto toosml; - } - -/* Transformation from low-pass to band-pass critical frequencies - * - * Center frequency - * cos( 1/2 (Whigh+Wlow) T ) - * cos( Wcenter T ) = ---------------------- - * cos( 1/2 (Whigh-Wlow) T ) - * - * - * Band edges - * cos( Wcenter T) - cos( Wdigital T ) - * Wanalog = ----------------------------------- - * sin( Wdigital T ) - */ - -if( kind == 2 ) - { /* Chebyshev */ - a = PI * (a+f1) / fs ; - cgam = cos(a) / cang; - a = 2.0 * PI * f2 / fs; - cbp = (cgam - cos(a))/sin(a); - } -if( kind == 1 ) - { /* Butterworth */ - a = PI * (a+f1) / fs ; - cgam = cos(a) / cang; - a = 2.0 * PI * f2 / fs; - cbp = (cgam - cos(a))/sin(a); - scale = 1.0; - } - -spln(); /* find s plane poles and zeros */ - -if( ((type & 1) == 0) && ((4*n+2) > ARRSIZ) ) - goto toosml; - -zplna(); /* convert s plane to z plane */ -zplnb(); -zplnc(); -xfun(); /* tabulate transfer function */ -goto top; + aa[i] = (q + b) * fnyq / PI; + pp[i] = (q - b) * fnyq / PI; + } + printf("pass band %.9E %.9E\n", pp[1], aa[1]); + printf("stop band %.9E %.9E\n", pp[2], aa[2]); + } + lampln(); /* find locations in lambda plane */ + if ((2 * n + 2) > ARRSIZ) + goto toosml; + } + + /* Transformation from low-pass to band-pass critical frequencies + * + * Center frequency + * cos( 1/2 (Whigh+Wlow) T ) + * cos( Wcenter T ) = ---------------------- + * cos( 1/2 (Whigh-Wlow) T ) + * + * + * Band edges + * cos( Wcenter T) - cos( Wdigital T ) + * Wanalog = ----------------------------------- + * sin( Wdigital T ) + */ + + if (kind == 2) + { /* Chebyshev */ + a = PI * (a + f1) / fs; + cgam = cos(a) / cang; + a = 2.0 * PI * f2 / fs; + cbp = (cgam - cos(a)) / sin(a); + } + if (kind == 1) + { /* Butterworth */ + a = PI * (a + f1) / fs; + cgam = cos(a) / cang; + a = 2.0 * PI * f2 / fs; + cbp = (cgam - cos(a)) / sin(a); + scale = 1.0; + } + + spln(); /* find s plane poles and zeros */ + + if (((type & 1) == 0) && ((4 * n + 2) > ARRSIZ)) + goto toosml; + + zplna(); /* convert s plane to z plane */ + zplnb(); + zplnc(); + xfun(); /* tabulate transfer function */ + goto top; toosml: -printf( "Cannot continue, storage arrays too small\n" ); -goto top; + printf("Cannot continue, storage arrays too small\n"); + goto top; } - int lampln() { -wc = 1.0; -k = wc/wr; -m = k * k; -Kk = ellpk( 1.0 - m ); -Kpk = ellpk( m ); -q = exp( -PI * rn * Kpk / Kk ); /* the nome of k1 */ -m1 = cay(q); /* see below */ -/* Note m1 = eps / sqrt( A*A - 1.0 ) */ -a = eps/m1; -a = a * a + 1; -a = 10.0 * log(a) / log(10.0); -printf( "dbdown %.9E\n", a ); -a = 180.0 * asin( k ) / PI; -b = 1.0/(1.0 + eps*eps); -b = sqrt( 1.0 - b ); -printf( "theta %.9E, rho %.9E\n", a, b ); -m1 *= m1; -m1p = 1.0 - m1; -Kk1 = ellpk( m1p ); -Kpk1 = ellpk( m1 ); -r = Kpk1 * Kk / (Kk1 * Kpk); -printf( "consistency check: n= %.14E\n", r ); -/* -1 - * sn j/eps\m = j ellik( atan(1/eps), m ) - */ -b = 1.0/eps; -phi = atan( b ); -u = ellik( phi, m1p ); -printf( "phi %.7e m %.7e u %.7e\n", phi, m1p, u ); -/* consistency check on inverse sn */ -ellpj( u, m1p, &sn, &cn, &dn, &phi ); -a = sn/cn; -printf( "consistency check: sn/cn = %.9E = %.9E = 1/eps\n", a, b ); -u = u * Kk / (rn * Kk1); /* or, u = u * Kpk / Kpk1 */ -return 0; + wc = 1.0; + k = wc / wr; + m = k * k; + Kk = ellpk(1.0 - m); + Kpk = ellpk(m); + q = exp(-PI * rn * Kpk / Kk); /* the nome of k1 */ + m1 = cay(q); /* see below */ + /* Note m1 = eps / sqrt( A*A - 1.0 ) */ + a = eps / m1; + a = a * a + 1; + a = 10.0 * log(a) / log(10.0); + printf("dbdown %.9E\n", a); + a = 180.0 * asin(k) / PI; + b = 1.0 / (1.0 + eps * eps); + b = sqrt(1.0 - b); + printf("theta %.9E, rho %.9E\n", a, b); + m1 *= m1; + m1p = 1.0 - m1; + Kk1 = ellpk(m1p); + Kpk1 = ellpk(m1); + r = Kpk1 * Kk / (Kk1 * Kpk); + printf("consistency check: n= %.14E\n", r); + /* -1 + * sn j/eps\m = j ellik( atan(1/eps), m ) + */ + b = 1.0 / eps; + phi = atan(b); + u = ellik(phi, m1p); + printf("phi %.7e m %.7e u %.7e\n", phi, m1p, u); + /* consistency check on inverse sn */ + ellpj(u, m1p, &sn, &cn, &dn, &phi); + a = sn / cn; + printf("consistency check: sn/cn = %.9E = %.9E = 1/eps\n", a, b); + u = u * Kk / (rn * Kk1); /* or, u = u * Kpk / Kpk1 */ + return 0; } - - - /* calculate s plane poles and zeros, normalized to wc = 1 */ int spln() { -for( i=0; i= 3 ) - { - /* map s => 1/s - */ - for( j=0; j= 3 ) - { - /* map s => 1/s - */ - for( j=0; j= 3 ) - { - nt = np + nz; - for( j=0; j nz ) - { - ir = ii + 1; - ii = ir + 1; - nz += 1; - zs[ir] = 0.0; - zs[ii] = 0.0; - } - } - } -printf( "s plane poles:\n" ); -j = 0; -for( i=0; i= 3) + { + /* map s => 1/s + */ + for (j = 0; j < np; j++) + { + ir = j + j; + ii = ir + 1; + b = zs[ir] * zs[ir] + zs[ii] * zs[ii]; + zs[ir] = zs[ir] / b; + zs[ii] = zs[ii] / b; + } + /* The zeros at infinity map to the origin. + */ + nz = np; + if (type == 4) + { + nz += n / 2; + } + for (j = 0; j < nz; j++) + { + ir = ii + 1; + ii = ir + 1; + zs[ir] = 0.0; + zs[ii] = 0.0; + } + } + } + if (kind == 2) + { + /* For Chebyshev, find radii of two Butterworth circles + * See Gold & Rader, page 60 + */ + rho = (phi - 1.0) * (phi + 1); /* rho = eps^2 = {sqrt(1+eps^2)}^2 - 1 */ + eps = sqrt(rho); + /* sqrt( 1 + 1/eps^2 ) + 1/eps = {sqrt(1 + eps^2) + 1} / eps + */ + phi = (phi + 1.0) / eps; + phi = pow(phi, 1.0 / rn); /* raise to the 1/n power */ + b = 0.5 * (phi + 1.0 / phi); /* y coordinates are on this circle */ + a = 0.5 * (phi - 1.0 / phi); /* x coordinates are on this circle */ + if (n & 1) + m = 0.0; + else + m = PI / (2.0 * n); + for (i = 0; i < np; i++) + { /* poles */ + lr = i + i; + zs[lr] = -a * cos(m); + zs[lr + 1] = b * sin(m); + m += PI / n; + } + /* high pass or band reject + */ + if (type >= 3) + { + /* map s => 1/s + */ + for (j = 0; j < np; j++) + { + ir = j + j; + ii = ir + 1; + b = zs[ir] * zs[ir] + zs[ii] * zs[ii]; + zs[ir] = zs[ir] / b; + zs[ii] = zs[ii] / b; + } + /* The zeros at infinity map to the origin. + */ + nz = np; + if (type == 4) + { + nz += n / 2; + } + for (j = 0; j < nz; j++) + { + ir = ii + 1; + ii = ir + 1; + zs[ir] = 0.0; + zs[ii] = 0.0; + } + } + } + if (kind == 3) + { + nz = n / 2; + ellpj(u, 1.0 - m, &sn1, &cn1, &dn1, &phi1); + for (i = 0; i < ARRSIZ; i++) + zs[i] = 0.0; + for (i = 0; i < nz; i++) + { /* zeros */ + a = n - 1 - i - i; + b = (Kk * a) / rn; + ellpj(b, m, &sn, &cn, &dn, &phi); + lr = 2 * np + 2 * i; + zs[lr] = 0.0; + a = wc / (k * sn); /* k = sqrt(m) */ + zs[lr + 1] = a; + } + for (i = 0; i < np; i++) + { /* poles */ + a = n - 1 - i - i; + b = a * Kk / rn; + ellpj(b, m, &sn, &cn, &dn, &phi); + r = k * sn * sn1; + b = cn1 * cn1 + r * r; + a = -wc * cn * dn * sn1 * cn1 / b; + lr = i + i; + zs[lr] = a; + b = wc * sn * dn1 / b; + zs[lr + 1] = b; + } + if (type >= 3) + { + nt = np + nz; + for (j = 0; j < nt; j++) + { + ir = j + j; + ii = ir + 1; + b = zs[ir] * zs[ir] + zs[ii] * zs[ii]; + zs[ir] = zs[ir] / b; + zs[ii] = zs[ii] / b; + } + while (np > nz) + { + ir = ii + 1; + ii = ir + 1; + nz += 1; + zs[ir] = 0.0; + zs[ii] = 0.0; + } + } + } + printf("s plane poles:\n"); + j = 0; + for (i = 0; i < np + nz; i++) + { + a = zs[j]; + ++j; + b = zs[j]; + ++j; + printf("%.9E %.9E\n", a, b); + if (i == np - 1) + printf("s plane zeros:\n"); + } + return 0; } - - - - - /* cay() * * Find parameter corresponding to given nome by expansion @@ -652,37 +637,33 @@ return 0; double cay(q) double q; { -double a, b, p, r; -double t1, t2; - -a = 1.0; -b = 1.0; -r = 1.0; -p = q; - -do -{ -r *= p; -a += 2.0 * r; -t1 = fabs( r/a ); - -r *= p; -b += r; -p *= q; -t2 = fabs( r/b ); -if( t2 > t1 ) - t1 = t2; -} -while( t1 > MACHEP ); - -a = b/a; -a = 4.0 * sqrt(q) * a * a; /* see above formulas, solved for m */ -return(a); + double a, b, p, r; + double t1, t2; + + a = 1.0; + b = 1.0; + r = 1.0; + p = q; + + do + { + r *= p; + a += 2.0 * r; + t1 = fabs(r / a); + + r *= p; + b += r; + p *= q; + t2 = fabs(r / b); + if (t2 > t1) + t1 = t2; + } while (t1 > MACHEP); + + a = b / a; + a = 4.0 * sqrt(q) * a * a; /* see above formulas, solved for m */ + return (a); } - - - /* zpln.c * Program to convert s plane poles and zeros to the z plane. */ @@ -691,437 +672,420 @@ extern cmplx cone; int zplna() { -cmplx r, cnum, cden, cwc, ca, cb, b4ac; -double C; - -if( kind == 3 ) - C = c; -else - C = wc; - -for( i=0; i s/wc - r - * - * z^2 - 2 z cgam + 1 - * => ------------------ - r - * (z^2 + 1) wc - * - * 1 - * = ------------ [ (1 - r wc) z^2 - 2 cgam z + 1 + r wc ] - * (z^2 + 1) wc - * - * and solve for the roots in the z plane. - */ - if( kind == 2 ) - cwc.r = cbp; - else - cwc.r = c; - cwc.i = 0.0; - cmul( &r, &cwc, &cnum ); /* r wc */ - csub( &cnum, &cone, &ca ); /* a = 1 - r wc */ - cmul( &cnum, &cnum, &b4ac ); /* 1 - (r wc)^2 */ - csub( &b4ac, &cone, &b4ac ); - b4ac.r *= 4.0; /* 4ac */ - b4ac.i *= 4.0; - cb.r = -2.0 * cgam; /* b */ - cb.i = 0.0; - cmul( &cb, &cb, &cnum ); /* b^2 */ - csub( &b4ac, &cnum, &b4ac ); /* b^2 - 4 ac */ - csqrt( &b4ac, &b4ac ); - cb.r = -cb.r; /* -b */ - cb.i = -cb.i; - ca.r *= 2.0; /* 2a */ - ca.i *= 2.0; - cadd( &b4ac, &cb, &cnum ); /* -b + sqrt( b^2 - 4ac) */ - cdiv( &ca, &cnum, &cnum ); /* ... /2a */ - jt += 1; - cmov( &cnum, &z[jt] ); - if( cnum.i != 0.0 ) - { - jt += 1; - z[jt].r = cnum.r; - z[jt].i = -cnum.i; - } - if( (r.i != 0.0) || (cnum.i == 0) ) - { - csub( &b4ac, &cb, &cnum ); /* -b - sqrt( b^2 - 4ac) */ - cdiv( &ca, &cnum, &cnum ); /* ... /2a */ - jt += 1; - cmov( &cnum, &z[jt] ); - if( cnum.i != 0.0 ) - { - jt += 1; - z[jt].r = cnum.r; - z[jt].i = -cnum.i; - } - } - } /* end switch */ - } - while( --nc > 0 ); - -if( icnt == 0 ) - { - zord = jt+1; - if( nz <= 0 ) - { - if( kind != 3 ) - return(0); - else - break; - } - } -nc = nz; -} /* end for() loop */ -return 0; + cmplx r, cnum, cden, cwc, ca, cb, b4ac; + double C; + + if (kind == 3) + C = c; + else + C = wc; + + for (i = 0; i < ARRSIZ; i++) + { + z[i].r = 0.0; + z[i].i = 0.0; + } + + nc = np; + jt = -1; + ii = -1; + + for (icnt = 0; icnt < 2; icnt++) + { + /* The maps from s plane to z plane */ + do + { + ir = ii + 1; + ii = ir + 1; + r.r = zs[ir]; + r.i = zs[ii]; + + switch (type) + { + case 1: + case 3: + /* Substitute s - r = s/wc - r = (1/wc)(z-1)/(z+1) - r + * + * 1 1 - r wc ( 1 + r wc ) + * = --- -------- ( z - -------- ) + * z+1 wc ( 1 - r wc ) + * + * giving the root in the z plane. + */ + cnum.r = 1 + C * r.r; + cnum.i = C * r.i; + cden.r = 1 - C * r.r; + cden.i = -C * r.i; + jt += 1; + cdiv(&cden, &cnum, &z[jt]); + if (r.i != 0.0) + { + /* fill in complex conjugate root */ + jt += 1; + z[jt].r = z[jt - 1].r; + z[jt].i = -z[jt - 1].i; + } + break; + + case 2: + case 4: + /* Substitute s - r => s/wc - r + * + * z^2 - 2 z cgam + 1 + * => ------------------ - r + * (z^2 + 1) wc + * + * 1 + * = ------------ [ (1 - r wc) z^2 - 2 cgam z + 1 + r wc ] + * (z^2 + 1) wc + * + * and solve for the roots in the z plane. + */ + if (kind == 2) + cwc.r = cbp; + else + cwc.r = c; + cwc.i = 0.0; + cmul(&r, &cwc, &cnum); /* r wc */ + csub(&cnum, &cone, &ca); /* a = 1 - r wc */ + cmul(&cnum, &cnum, &b4ac); /* 1 - (r wc)^2 */ + csub(&b4ac, &cone, &b4ac); + b4ac.r *= 4.0; /* 4ac */ + b4ac.i *= 4.0; + cb.r = -2.0 * cgam; /* b */ + cb.i = 0.0; + cmul(&cb, &cb, &cnum); /* b^2 */ + csub(&b4ac, &cnum, &b4ac); /* b^2 - 4 ac */ + csqrt(&b4ac, &b4ac); + cb.r = -cb.r; /* -b */ + cb.i = -cb.i; + ca.r *= 2.0; /* 2a */ + ca.i *= 2.0; + cadd(&b4ac, &cb, &cnum); /* -b + sqrt( b^2 - 4ac) */ + cdiv(&ca, &cnum, &cnum); /* ... /2a */ + jt += 1; + cmov(&cnum, &z[jt]); + if (cnum.i != 0.0) + { + jt += 1; + z[jt].r = cnum.r; + z[jt].i = -cnum.i; + } + if ((r.i != 0.0) || (cnum.i == 0)) + { + csub(&b4ac, &cb, &cnum); /* -b - sqrt( b^2 - 4ac) */ + cdiv(&ca, &cnum, &cnum); /* ... /2a */ + jt += 1; + cmov(&cnum, &z[jt]); + if (cnum.i != 0.0) + { + jt += 1; + z[jt].r = cnum.r; + z[jt].i = -cnum.i; + } + } + } /* end switch */ + } while (--nc > 0); + + if (icnt == 0) + { + zord = jt + 1; + if (nz <= 0) + { + if (kind != 3) + return (0); + else + break; + } + } + nc = nz; + } /* end for() loop */ + return 0; } - - - int zplnb() { -cmplx lin[2]; - -lin[1].r = 1.0; -lin[1].i = 0.0; - -if( kind != 3 ) - { /* Butterworth or Chebyshev */ -/* generate the remaining zeros */ - while( 2*zord - 1 > jt ) - { - if( type != 3 ) - { - printf( "adding zero at Nyquist frequency\n" ); - jt += 1; - z[jt].r = -1.0; /* zero at Nyquist frequency */ - z[jt].i = 0.0; - } - if( (type == 2) || (type == 3) ) - { - printf( "adding zero at 0 Hz\n" ); - jt += 1; - z[jt].r = 1.0; /* zero at 0 Hz */ - z[jt].i = 0.0; - } - } - } -else - { /* elliptic */ - while( 2*zord - 1 > jt ) - { - jt += 1; - z[jt].r = -1.0; /* zero at Nyquist frequency */ - z[jt].i = 0.0; - if( (type == 2) || (type == 4) ) - { - jt += 1; - z[jt].r = 1.0; /* zero at 0 Hz */ - z[jt].i = 0.0; - } - } - } -printf( "order = %d\n", zord ); - -/* Expand the poles and zeros into numerator and - * denominator polynomials - */ -for( icnt=0; icnt<2; icnt++ ) - { - for( j=0; j ((zord/4)*2) ) - { - ai = 1.0; - pn = 0.0; - an = 0.0; - } - for( j=1; j<=mh; j++ ) - { - a = gam * j - ai * PI / 2.0; - cng = cos(a); - jh = mh + j; - jl = mh - j; - pn = pn + cng * (pp[jh] + (1.0 - 2.0 * ai) * pp[jl]); - an = an + cng * (aa[jh] + (1.0 - 2.0 * ai) * aa[jl]); - } - } -return 0; + cmplx lin[2]; + + lin[1].r = 1.0; + lin[1].i = 0.0; + + if (kind != 3) + { /* Butterworth or Chebyshev */ + /* generate the remaining zeros */ + while (2 * zord - 1 > jt) + { + if (type != 3) + { + printf("adding zero at Nyquist frequency\n"); + jt += 1; + z[jt].r = -1.0; /* zero at Nyquist frequency */ + z[jt].i = 0.0; + } + if ((type == 2) || (type == 3)) + { + printf("adding zero at 0 Hz\n"); + jt += 1; + z[jt].r = 1.0; /* zero at 0 Hz */ + z[jt].i = 0.0; + } + } + } + else + { /* elliptic */ + while (2 * zord - 1 > jt) + { + jt += 1; + z[jt].r = -1.0; /* zero at Nyquist frequency */ + z[jt].i = 0.0; + if ((type == 2) || (type == 4)) + { + jt += 1; + z[jt].r = 1.0; /* zero at 0 Hz */ + z[jt].i = 0.0; + } + } + } + printf("order = %d\n", zord); + + /* Expand the poles and zeros into numerator and + * denominator polynomials + */ + for (icnt = 0; icnt < 2; icnt++) + { + for (j = 0; j < ARRSIZ; j++) + { + pp[j] = 0.0; + y[j] = 0.0; + } + pp[0] = 1.0; + for (j = 0; j < zord; j++) + { + jj = j; + if (icnt) + jj += zord; + a = z[jj].r; + b = z[jj].i; + for (i = 0; i <= j; i++) + { + jh = j - i; + pp[jh + 1] = pp[jh + 1] - a * pp[jh] + b * y[jh]; + y[jh + 1] = y[jh + 1] - b * pp[jh] - a * y[jh]; + } + } + if (icnt == 0) + { + for (j = 0; j <= zord; j++) + aa[j] = pp[j]; + } + } + /* Scale factors of the pole and zero polynomials */ + a = 1.0; + switch (type) + { + case 3: + a = -1.0; + + case 1: + case 4: + + pn = 1.0; + an = 1.0; + for (j = 1; j <= zord; j++) + { + pn = a * pn + pp[j]; + an = a * an + aa[j]; + } + break; + + case 2: + gam = PI / 2.0 - asin(cgam); /* = acos( cgam ) */ + mh = zord / 2; + pn = pp[mh]; + an = aa[mh]; + ai = 0.0; + if (mh > ((zord / 4) * 2)) + { + ai = 1.0; + pn = 0.0; + an = 0.0; + } + for (j = 1; j <= mh; j++) + { + a = gam * j - ai * PI / 2.0; + cng = cos(a); + jh = mh + j; + jl = mh - j; + pn = pn + cng * (pp[jh] + (1.0 - 2.0 * ai) * pp[jl]); + an = an + cng * (aa[jh] + (1.0 - 2.0 * ai) * aa[jl]); + } + } + return 0; } - - - int zplnc() { -gain = an/(pn*scale); -if( (kind != 3) && (pn == 0) ) - gain = 1.0; -printf( "constant gain factor %23.13E\n", gain ); -for( j=0; j<=zord; j++ ) - pp[j] = gain * pp[j]; - -printf( "z plane Denominator Numerator\n" ); -for( j=0; j<=zord; j++ ) - { - printf( "%2d %17.9E %17.9E\n", j, aa[j], pp[j] ); - } -printf( "poles and zeros with corresponding quadratic factors\n" ); -for( j=0; j= 0.0 ) - { - printf( "pole %23.13E %23.13E\n", a, b ); - quadf( a, b, 1 ); - } - jj = j + zord; - a = z[jj].r; - b = z[jj].i; - if( b >= 0.0 ) - { - printf( "zero %23.13E %23.13E\n", a, b ); - quadf( a, b, 0 ); - } - } -return 0; + gain = an / (pn * scale); + if ((kind != 3) && (pn == 0)) + gain = 1.0; + printf("constant gain factor %23.13E\n", gain); + for (j = 0; j <= zord; j++) + pp[j] = gain * pp[j]; + + printf("z plane Denominator Numerator\n"); + for (j = 0; j <= zord; j++) + { + printf("%2d %17.9E %17.9E\n", j, aa[j], pp[j]); + } + printf("poles and zeros with corresponding quadratic factors\n"); + for (j = 0; j < zord; j++) + { + a = z[j].r; + b = z[j].i; + if (b >= 0.0) + { + printf("pole %23.13E %23.13E\n", a, b); + quadf(a, b, 1); + } + jj = j + zord; + a = z[jj].r; + b = z[jj].i; + if (b >= 0.0) + { + printf("zero %23.13E %23.13E\n", a, b); + quadf(a, b, 0); + } + } + return 0; } - - - /* display quadratic factors */ -int quadf( x, y, pzflg ) +int quadf(x, y, pzflg) double x, y; -int pzflg; /* 1 if poles, 0 if zeros */ +int pzflg; /* 1 if poles, 0 if zeros */ { -double a, b, r, f, g, g0; - -if( y > 1.0e-16 ) - { - a = -2.0 * x; - b = x*x + y*y; - } -else - { - a = -x; - b = 0.0; - } -printf( "q. f.\nz**2 %23.13E\nz**1 %23.13E\n", b, a ); -if( b != 0.0 ) - { -/* resonant frequency */ - r = sqrt(b); - f = PI/2.0 - asin( -a/(2.0*r) ); - f = f * fs / (2.0 * PI ); -/* gain at resonance */ - g = 1.0 + r; - g = g*g - (a*a/r); - g = (1.0 - r) * sqrt(g); - g0 = 1.0 + a + b; /* gain at d.c. */ - } -else - { -/* It is really a first-order network. - * Give the gain at fnyq and D.C. - */ - f = fnyq; - g = 1.0 - a; - g0 = 1.0 + a; - } - -if( pzflg ) - { - if( g != 0.0 ) - g = 1.0/g; - else - g = MAXNUM; - if( g0 != 0.0 ) - g0 = 1.0/g0; - else - g = MAXNUM; - } -printf( "f0 %16.8E gain %12.4E DC gain %12.4E\n\n", f, g, g0 ); -return 0; + double a, b, r, f, g, g0; + + if (y > 1.0e-16) + { + a = -2.0 * x; + b = x * x + y * y; + } + else + { + a = -x; + b = 0.0; + } + printf("q. f.\nz**2 %23.13E\nz**1 %23.13E\n", b, a); + if (b != 0.0) + { + /* resonant frequency */ + r = sqrt(b); + f = PI / 2.0 - asin(-a / (2.0 * r)); + f = f * fs / (2.0 * PI); + /* gain at resonance */ + g = 1.0 + r; + g = g * g - (a * a / r); + g = (1.0 - r) * sqrt(g); + g0 = 1.0 + a + b; /* gain at d.c. */ + } + else + { + /* It is really a first-order network. + * Give the gain at fnyq and D.C. + */ + f = fnyq; + g = 1.0 - a; + g0 = 1.0 + a; + } + + if (pzflg) + { + if (g != 0.0) + g = 1.0 / g; + else + g = MAXNUM; + if (g0 != 0.0) + g0 = 1.0 / g0; + else + g = MAXNUM; + } + printf("f0 %16.8E gain %12.4E DC gain %12.4E\n\n", f, g, g0); + return 0; } - - /* Print table of filter frequency response */ int xfun() { -double f, r; -int i; - -f = 0.0; - -for( i=0; i<=20; i++ ) - { - r = response( f, gain ); - if( r <= 0.0 ) - r = -999.99; - else - r = 2.0 * dbfac * log( r ); - printf( "%10.1f %10.2f\n", f, r ); - f = f + 0.05 * fnyq; - } -return 0; + double f, r; + int i; + + f = 0.0; + + for (i = 0; i <= 20; i++) + { + r = response(f, gain); + if (r <= 0.0) + r = -999.99; + else + r = 2.0 * dbfac * log(r); + printf("%10.1f %10.2f\n", f, r); + f = f + 0.05 * fnyq; + } + return 0; } - /* Calculate frequency response at f Hz * mulitplied by amp */ -double response( f, amp ) +double response(f, amp) double f, amp; { -cmplx x, num, den, w; -double u; -int j; - -/* exp( j omega T ) */ -u = 2.0 * PI * f /fs; -x.r = cos(u); -x.i = sin(u); - -num.r = 1.0; -num.i = 0.0; -den.r = 1.0; -den.i = 0.0; -for( j=0; j. */ -int getnum( line, val ) +int getnum(line, val) char *line; double *val; { -char s[40]; - -printf( "%s = %.9E ? ", line, *val ); -gets( s ); -if( s[0] != '\0' ) - { - sscanf( s, "%lf", val ); - printf( "%.9E\n", *val ); - } -return 0; + char s[40]; + + printf("%s = %.9E ? ", line, *val); + gets(s); + if (s[0] != '\0') + { + sscanf(s, "%lf", val); + printf("%.9E\n", *val); + } + return 0; } - diff --git a/cephes/ellf/ellf.que b/cephes/ellf/ellf.que index 596e5d5..4ebcd43 100644 --- a/cephes/ellf/ellf.que +++ b/cephes/ellf/ellf.que @@ -43,4 +43,3 @@ ; ellf temp.ans ; and verify that temp.ans is substantially the same as ; ellf.ans. - diff --git a/cephes/ellf/ellie.c b/cephes/ellf/ellie.c index 406c589..746699b 100644 --- a/cephes/ellf/ellie.c +++ b/cephes/ellf/ellie.c @@ -23,7 +23,7 @@ * | 2 * E(phi_\m) = | sqrt( 1 - m sin t ) dt * | - * | | + * | | * - * 0 * @@ -43,7 +43,6 @@ * * */ - /* Cephes Math Library Release 2.8: June, 2000 @@ -54,95 +53,95 @@ Copyright 1984, 1987, 1993, 2000 by Stephen L. Moshier #include "mconf.h" extern double PI, PIO2, MACHEP; #ifdef ANSIPROT -extern double sqrt ( double ); -extern double fabs ( double ); -extern double log ( double ); -extern double sin ( double x ); -extern double tan ( double x ); -extern double atan ( double ); -extern double floor ( double ); -extern double ellpe ( double ); -extern double ellpk ( double ); -double ellie ( double, double ); +extern double sqrt(double); +extern double fabs(double); +extern double log(double); +extern double sin(double x); +extern double tan(double x); +extern double atan(double); +extern double floor(double); +extern double ellpe(double); +extern double ellpk(double); +double ellie(double, double); #else double sqrt(), fabs(), log(), sin(), tan(), atan(), floor(); double ellpe(), ellpk(), ellie(); #endif -double ellie( phi, m ) +double ellie(phi, m) double phi, m; { -double a, b, c, e, temp; -double lphi, t, E; -int d, mod, npio2, sign; + double a, b, c, e, temp; + double lphi, t, E; + int d, mod, npio2, sign; -if( m == 0.0 ) - return( phi ); -lphi = phi; -npio2 = floor( lphi/PIO2 ); -if( npio2 & 1 ) - npio2 += 1; -lphi = lphi - npio2 * PIO2; -if( lphi < 0.0 ) - { - lphi = -lphi; - sign = -1; - } -else - { - sign = 1; - } -a = 1.0 - m; -E = ellpe( a ); -if( a == 0.0 ) - { - temp = sin( lphi ); - goto done; - } -t = tan( lphi ); -b = sqrt(a); -/* Thanks to Brian Fitzgerald - for pointing out an instability near odd multiples of pi/2. */ -if( fabs(t) > 10.0 ) - { - /* Transform the amplitude */ - e = 1.0/(b*t); - /* ... but avoid multiple recursions. */ - if( fabs(e) < 10.0 ) - { - e = atan(e); - temp = E + m * sin( lphi ) * sin( e ) - ellie( e, m ); - goto done; - } - } -c = sqrt(m); -a = 1.0; -d = 1; -e = 0.0; -mod = 0; + if (m == 0.0) + return (phi); + lphi = phi; + npio2 = floor(lphi / PIO2); + if (npio2 & 1) + npio2 += 1; + lphi = lphi - npio2 * PIO2; + if (lphi < 0.0) + { + lphi = -lphi; + sign = -1; + } + else + { + sign = 1; + } + a = 1.0 - m; + E = ellpe(a); + if (a == 0.0) + { + temp = sin(lphi); + goto done; + } + t = tan(lphi); + b = sqrt(a); + /* Thanks to Brian Fitzgerald + for pointing out an instability near odd multiples of pi/2. */ + if (fabs(t) > 10.0) + { + /* Transform the amplitude */ + e = 1.0 / (b * t); + /* ... but avoid multiple recursions. */ + if (fabs(e) < 10.0) + { + e = atan(e); + temp = E + m * sin(lphi) * sin(e) - ellie(e, m); + goto done; + } + } + c = sqrt(m); + a = 1.0; + d = 1; + e = 0.0; + mod = 0; -while( fabs(c/a) > MACHEP ) - { - temp = b/a; - lphi = lphi + atan(t*temp) + mod * PI; - mod = (lphi + PIO2)/PI; - t = t * ( 1.0 + temp )/( 1.0 - temp * t * t ); - c = ( a - b )/2.0; - temp = sqrt( a * b ); - a = ( a + b )/2.0; - b = temp; - d += d; - e += c * sin(lphi); - } + while (fabs(c / a) > MACHEP) + { + temp = b / a; + lphi = lphi + atan(t * temp) + mod * PI; + mod = (lphi + PIO2) / PI; + t = t * (1.0 + temp) / (1.0 - temp * t * t); + c = (a - b) / 2.0; + temp = sqrt(a * b); + a = (a + b) / 2.0; + b = temp; + d += d; + e += c * sin(lphi); + } -temp = E / ellpk( 1.0 - m ); -temp *= (atan(t) + mod * PI)/(d * a); -temp += e; + temp = E / ellpk(1.0 - m); + temp *= (atan(t) + mod * PI) / (d * a); + temp += e; done: -if( sign < 0 ) - temp = -temp; -temp += npio2 * E; -return( temp ); + if (sign < 0) + temp = -temp; + temp += npio2 * E; + return (temp); } diff --git a/cephes/ellf/ellik.c b/cephes/ellf/ellik.c index e8ca070..1c3bc8e 100644 --- a/cephes/ellf/ellik.c +++ b/cephes/ellf/ellik.c @@ -44,7 +44,6 @@ * * */ - /* Cephes Math Library Release 2.8: June, 2000 @@ -55,94 +54,94 @@ Copyright 1984, 1987, 2000 by Stephen L. Moshier #include "mconf.h" #ifdef ANSIPROT -extern double sqrt ( double ); -extern double fabs ( double ); -extern double log ( double ); -extern double tan ( double ); -extern double atan ( double ); -extern double floor ( double ); -extern double ellpk ( double ); -double ellik ( double, double ); +extern double sqrt(double); +extern double fabs(double); +extern double log(double); +extern double tan(double); +extern double atan(double); +extern double floor(double); +extern double ellpk(double); +double ellik(double, double); #else double sqrt(), fabs(), log(), tan(), atan(), floor(), ellpk(); double ellik(); #endif extern double PI, PIO2, MACHEP, MAXNUM; -double ellik( phi, m ) +double ellik(phi, m) double phi, m; { -double a, b, c, e, temp, t, K; -int d, mod, sign, npio2; + double a, b, c, e, temp, t, K; + int d, mod, sign, npio2; -if( m == 0.0 ) - return( phi ); -a = 1.0 - m; -if( a == 0.0 ) - { - if( fabs(phi) >= PIO2 ) - { - mtherr( "ellik", SING ); - return( MAXNUM ); - } - return( log( tan( (PIO2 + phi)/2.0 ) ) ); - } -npio2 = floor( phi/PIO2 ); -if( npio2 & 1 ) - npio2 += 1; -if( npio2 ) - { - K = ellpk( a ); - phi = phi - npio2 * PIO2; - } -else - K = 0.0; -if( phi < 0.0 ) - { - phi = -phi; - sign = -1; - } -else - sign = 0; -b = sqrt(a); -t = tan( phi ); -if( fabs(t) > 10.0 ) - { - /* Transform the amplitude */ - e = 1.0/(b*t); - /* ... but avoid multiple recursions. */ - if( fabs(e) < 10.0 ) - { - e = atan(e); - if( npio2 == 0 ) - K = ellpk( a ); - temp = K - ellik( e, m ); - goto done; - } - } -a = 1.0; -c = sqrt(m); -d = 1; -mod = 0; + if (m == 0.0) + return (phi); + a = 1.0 - m; + if (a == 0.0) + { + if (fabs(phi) >= PIO2) + { + mtherr("ellik", SING); + return (MAXNUM); + } + return (log(tan((PIO2 + phi) / 2.0))); + } + npio2 = floor(phi / PIO2); + if (npio2 & 1) + npio2 += 1; + if (npio2) + { + K = ellpk(a); + phi = phi - npio2 * PIO2; + } + else + K = 0.0; + if (phi < 0.0) + { + phi = -phi; + sign = -1; + } + else + sign = 0; + b = sqrt(a); + t = tan(phi); + if (fabs(t) > 10.0) + { + /* Transform the amplitude */ + e = 1.0 / (b * t); + /* ... but avoid multiple recursions. */ + if (fabs(e) < 10.0) + { + e = atan(e); + if (npio2 == 0) + K = ellpk(a); + temp = K - ellik(e, m); + goto done; + } + } + a = 1.0; + c = sqrt(m); + d = 1; + mod = 0; -while( fabs(c/a) > MACHEP ) - { - temp = b/a; - phi = phi + atan(t*temp) + mod * PI; - mod = (phi + PIO2)/PI; - t = t * ( 1.0 + temp )/( 1.0 - temp * t * t ); - c = ( a - b )/2.0; - temp = sqrt( a * b ); - a = ( a + b )/2.0; - b = temp; - d += d; - } + while (fabs(c / a) > MACHEP) + { + temp = b / a; + phi = phi + atan(t * temp) + mod * PI; + mod = (phi + PIO2) / PI; + t = t * (1.0 + temp) / (1.0 - temp * t * t); + c = (a - b) / 2.0; + temp = sqrt(a * b); + a = (a + b) / 2.0; + b = temp; + d += d; + } -temp = (atan(t) + mod * PI)/(d * a); + temp = (atan(t) + mod * PI) / (d * a); done: -if( sign < 0 ) - temp = -temp; -temp += npio2 * K; -return( temp ); + if (sign < 0) + temp = -temp; + temp += npio2 * K; + return (temp); } diff --git a/cephes/ellf/ellpe.c b/cephes/ellf/ellpe.c index 592b8be..1ff321d 100644 --- a/cephes/ellf/ellpe.c +++ b/cephes/ellf/ellpe.c @@ -21,7 +21,7 @@ * - * | | 2 * E(m) = | sqrt( 1 - m sin t ) dt - * | | + * | | * - * 0 * @@ -49,7 +49,7 @@ * ellpe domain x<0, x>1 0.0 * */ - + /* ellpe.c */ /* Elliptic integral of second kind */ @@ -61,6 +61,7 @@ Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier #include "mconf.h" +/* clang-format off */ #ifdef UNK static double P[] = { 1.53552577301013293365E-4, @@ -172,10 +173,11 @@ static unsigned short Q[] = { 0x3fcf,0xffff,0xffff,0xf048 }; #endif +/* clang-format on */ #ifdef ANSIPROT -extern double polevl ( double, void *, int ); -extern double log ( double ); +extern double polevl(double, void *, int); +extern double log(double); #else double polevl(), log(); #endif @@ -184,12 +186,12 @@ double ellpe(x) double x; { -if( (x <= 0.0) || (x > 1.0) ) - { - if( x == 0.0 ) - return( 1.0 ); - mtherr( "ellpe", DOMAIN ); - return( 0.0 ); - } -return( polevl(x,P,10) - log(x) * (x * polevl(x,Q,9)) ); + if ((x <= 0.0) || (x > 1.0)) + { + if (x == 0.0) + return (1.0); + mtherr("ellpe", DOMAIN); + return (0.0); + } + return (polevl(x, P, 10) - log(x) * (x * polevl(x, Q, 9))); } diff --git a/cephes/ellf/ellpj.c b/cephes/ellf/ellpj.c index 597f116..d9fec3a 100644 --- a/cephes/ellf/ellpj.c +++ b/cephes/ellf/ellpj.c @@ -52,9 +52,8 @@ * Accuracy deteriorates when u is large. * */ - -/* ellpj.c */ +/* ellpj.c */ /* Cephes Math Library Release 2.8: June, 2000 @@ -63,109 +62,106 @@ Copyright 1984, 1987, 2000 by Stephen L. Moshier #include "mconf.h" #ifdef ANSIPROT -extern double sqrt ( double ); -extern double fabs ( double ); -extern double sin ( double ); -extern double cos ( double ); -extern double asin ( double ); -extern double tanh ( double ); -extern double sinh ( double ); -extern double cosh ( double ); -extern double atan ( double ); -extern double exp ( double ); +extern double sqrt(double); +extern double fabs(double); +extern double sin(double); +extern double cos(double); +extern double asin(double); +extern double tanh(double); +extern double sinh(double); +extern double cosh(double); +extern double atan(double); +extern double exp(double); #else double sqrt(), fabs(), sin(), cos(), asin(), tanh(); double sinh(), cosh(), atan(), exp(); #endif extern double PIO2, MACHEP; -int ellpj( u, m, sn, cn, dn, ph ) +int ellpj(u, m, sn, cn, dn, ph) double u, m; double *sn, *cn, *dn, *ph; { -double ai, b, phi, t, twon; -double a[9], c[9]; -int i; - - -/* Check for special cases */ + double ai, b, phi, t, twon; + double a[9], c[9]; + int i; -if( m < 0.0 || m > 1.0 ) - { - mtherr( "ellpj", DOMAIN ); - *sn = 0.0; - *cn = 0.0; - *ph = 0.0; - *dn = 0.0; - return(-1); - } -if( m < 1.0e-9 ) - { - t = sin(u); - b = cos(u); - ai = 0.25 * m * (u - t*b); - *sn = t - ai*b; - *cn = b + ai*t; - *ph = u - ai; - *dn = 1.0 - 0.5*m*t*t; - return(0); - } + /* Check for special cases */ -if( m >= 0.9999999999 ) - { - ai = 0.25 * (1.0-m); - b = cosh(u); - t = tanh(u); - phi = 1.0/b; - twon = b * sinh(u); - *sn = t + ai * (twon - u)/(b*b); - *ph = 2.0*atan(exp(u)) - PIO2 + ai*(twon - u)/b; - ai *= t * phi; - *cn = phi - ai * (twon - u); - *dn = phi + ai * (twon + u); - return(0); - } + if (m < 0.0 || m > 1.0) + { + mtherr("ellpj", DOMAIN); + *sn = 0.0; + *cn = 0.0; + *ph = 0.0; + *dn = 0.0; + return (-1); + } + if (m < 1.0e-9) + { + t = sin(u); + b = cos(u); + ai = 0.25 * m * (u - t * b); + *sn = t - ai * b; + *cn = b + ai * t; + *ph = u - ai; + *dn = 1.0 - 0.5 * m * t * t; + return (0); + } + if (m >= 0.9999999999) + { + ai = 0.25 * (1.0 - m); + b = cosh(u); + t = tanh(u); + phi = 1.0 / b; + twon = b * sinh(u); + *sn = t + ai * (twon - u) / (b * b); + *ph = 2.0 * atan(exp(u)) - PIO2 + ai * (twon - u) / b; + ai *= t * phi; + *cn = phi - ai * (twon - u); + *dn = phi + ai * (twon + u); + return (0); + } -/* A. G. M. scale */ -a[0] = 1.0; -b = sqrt(1.0 - m); -c[0] = sqrt(m); -twon = 1.0; -i = 0; + /* A. G. M. scale */ + a[0] = 1.0; + b = sqrt(1.0 - m); + c[0] = sqrt(m); + twon = 1.0; + i = 0; -while( fabs(c[i]/a[i]) > MACHEP ) - { - if( i > 7 ) - { - mtherr( "ellpj", OVERFLOW ); - goto done; - } - ai = a[i]; - ++i; - c[i] = ( ai - b )/2.0; - t = sqrt( ai * b ); - a[i] = ( ai + b )/2.0; - b = t; - twon *= 2.0; - } + while (fabs(c[i] / a[i]) > MACHEP) + { + if (i > 7) + { + mtherr("ellpj", OVERFLOW); + goto done; + } + ai = a[i]; + ++i; + c[i] = (ai - b) / 2.0; + t = sqrt(ai * b); + a[i] = (ai + b) / 2.0; + b = t; + twon *= 2.0; + } done: -/* backward recurrence */ -phi = twon * a[i] * u; -do - { - t = c[i] * sin(phi) / a[i]; - b = phi; - phi = (asin(t) + phi)/2.0; - } -while( --i ); + /* backward recurrence */ + phi = twon * a[i] * u; + do + { + t = c[i] * sin(phi) / a[i]; + b = phi; + phi = (asin(t) + phi) / 2.0; + } while (--i); -*sn = sin(phi); -t = cos(phi); -*cn = t; -*dn = t/cos(phi-b); -*ph = phi; -return(0); + *sn = sin(phi); + t = cos(phi); + *cn = t; + *dn = t / cos(phi - b); + *ph = phi; + return (0); } diff --git a/cephes/ellf/ellpk.c b/cephes/ellf/ellpk.c index cbe6524..390baf7 100644 --- a/cephes/ellf/ellpk.c +++ b/cephes/ellf/ellpk.c @@ -51,9 +51,8 @@ * ellpk domain x<0, x>1 0.0 * */ - -/* ellpk.c */ +/* ellpk.c */ /* Cephes Math Library, Release 2.8: June, 2000 @@ -62,6 +61,7 @@ Copyright 1984, 1987, 2000 by Stephen L. Moshier #include "mconf.h" +/* clang-format off */ #ifdef DEC static unsigned short P[] = { @@ -195,11 +195,12 @@ static double Q[] = }; static double C1 = 1.3862943611198906188E0; /* log(4) */ #endif +/* clang-format on */ #ifdef ANSIPROT -extern double polevl ( double, void *, int ); -extern double p1evl ( double, void *, int ); -extern double log ( double ); +extern double polevl(double, void *, int); +extern double p1evl(double, void *, int); +extern double log(double); #else double polevl(), p1evl(), log(); #endif @@ -209,26 +210,26 @@ double ellpk(x) double x; { -if( (x < 0.0) || (x > 1.0) ) - { - mtherr( "ellpk", DOMAIN ); - return( 0.0 ); - } + if ((x < 0.0) || (x > 1.0)) + { + mtherr("ellpk", DOMAIN); + return (0.0); + } -if( x > MACHEP ) - { - return( polevl(x,P,10) - log(x) * polevl(x,Q,10) ); - } -else - { - if( x == 0.0 ) - { - mtherr( "ellpk", SING ); - return( MAXNUM ); - } - else - { - return( C1 - 0.5 * log(x) ); - } - } + if (x > MACHEP) + { + return (polevl(x, P, 10) - log(x) * polevl(x, Q, 10)); + } + else + { + if (x == 0.0) + { + mtherr("ellpk", SING); + return (MAXNUM); + } + else + { + return (C1 - 0.5 * log(x)); + } + } } diff --git a/cephes/ellf/protos.h b/cephes/ellf/protos.h index bf904f7..46791dc 100644 --- a/cephes/ellf/protos.h +++ b/cephes/ellf/protos.h @@ -7,63 +7,63 @@ #ifndef __CEXTRACT__ #if __STDC__ -extern double cabs ( cmplx *z ); -extern void cadd ( cmplx *a, cmplx *b, cmplx *c ); -extern double cay ( double q ); -extern void cdiv ( cmplx *a, cmplx *b, cmplx *c ); -extern void cmov ( short *a, short *b ); -extern void cmul ( cmplx *a, cmplx *b, cmplx *c ); -extern void cneg ( cmplx *a ); -extern void csqrt ( cmplx *z, cmplx *w ); -extern void csub ( cmplx *a, cmplx *b, cmplx *c ); -extern double ellie ( double phi, double m ); -extern double ellik ( double phi, double m ); -extern double ellpe ( double x ); -extern int ellpj ( double u, double m, double *sn, double *cn, double *dn, double *ph ); -extern double ellpk ( double x ); -extern int getnum ( char *line, double *val ); -extern int lampln ( void ); -extern int main ( void ); -extern void mtherr ( char *name, int code ); -extern double p1evl ( double x, double coef[], int N ); -extern double polevl ( double x, double coef[], int N ); -extern int quadf ( double x, double y, int pzflg ); -extern double response ( double f, double amp ); -extern int spln ( void ); -extern int xfun ( void ); -extern int zplna ( void ); -extern int zplnb ( void ); -extern int zplnc ( void ); +extern double cabs(cmplx *z); +extern void cadd(cmplx *a, cmplx *b, cmplx *c); +extern double cay(double q); +extern void cdiv(cmplx *a, cmplx *b, cmplx *c); +extern void cmov(short *a, short *b); +extern void cmul(cmplx *a, cmplx *b, cmplx *c); +extern void cneg(cmplx *a); +extern void csqrt(cmplx *z, cmplx *w); +extern void csub(cmplx *a, cmplx *b, cmplx *c); +extern double ellie(double phi, double m); +extern double ellik(double phi, double m); +extern double ellpe(double x); +extern int ellpj(double u, double m, double *sn, double *cn, double *dn, double *ph); +extern double ellpk(double x); +extern int getnum(char *line, double *val); +extern int lampln(void); +extern int main(void); +extern void mtherr(char *name, int code); +extern double p1evl(double x, double coef[], int N); +extern double polevl(double x, double coef[], int N); +extern int quadf(double x, double y, int pzflg); +extern double response(double f, double amp); +extern int spln(void); +extern int xfun(void); +extern int zplna(void); +extern int zplnb(void); +extern int zplnc(void); #else /* __STDC__ */ -extern double cabs (/* cmplx *z */); -extern void cadd (/* cmplx *a, cmplx *b, cmplx *c */); -extern double cay (/* double q */); -extern void cdiv (/* cmplx *a, cmplx *b, cmplx *c */); -extern void cmov (/* short *a, short *b */); -extern void cmul (/* cmplx *a, cmplx *b, cmplx *c */); -extern void cneg (/* cmplx *a */); -extern void csqrt (/* cmplx *z, cmplx *w */); -extern void csub (/* cmplx *a, cmplx *b, cmplx *c */); -extern double ellie (/* double phi, double m */); -extern double ellik (/* double phi, double m */); -extern double ellpe (/* double x */); -extern int ellpj (/* double u, double m, double *sn, double *cn, double *dn, double *ph */); -extern double ellpk (/* double x */); -extern int getnum (/* char *line, double *val */); -extern int lampln (/* void */); -extern int main (/* void */); -extern void mtherr (/* char *name, int code */); -extern double p1evl (/* double x, double coef[], int N */); -extern double polevl (/* double x, double coef[], int N */); -extern int quadf (/* double x, double y, int pzflg */); -extern double response (/* double f, double amp */); -extern int spln (/* void */); -extern int xfun (/* void */); -extern int zplna (/* void */); -extern int zplnb (/* void */); -extern int zplnc (/* void */); +extern double cabs(/* cmplx *z */); +extern void cadd(/* cmplx *a, cmplx *b, cmplx *c */); +extern double cay(/* double q */); +extern void cdiv(/* cmplx *a, cmplx *b, cmplx *c */); +extern void cmov(/* short *a, short *b */); +extern void cmul(/* cmplx *a, cmplx *b, cmplx *c */); +extern void cneg(/* cmplx *a */); +extern void csqrt(/* cmplx *z, cmplx *w */); +extern void csub(/* cmplx *a, cmplx *b, cmplx *c */); +extern double ellie(/* double phi, double m */); +extern double ellik(/* double phi, double m */); +extern double ellpe(/* double x */); +extern int ellpj(/* double u, double m, double *sn, double *cn, double *dn, double *ph */); +extern double ellpk(/* double x */); +extern int getnum(/* char *line, double *val */); +extern int lampln(/* void */); +extern int main(/* void */); +extern void mtherr(/* char *name, int code */); +extern double p1evl(/* double x, double coef[], int N */); +extern double polevl(/* double x, double coef[], int N */); +extern int quadf(/* double x, double y, int pzflg */); +extern double response(/* double f, double amp */); +extern int spln(/* void */); +extern int xfun(/* void */); +extern int zplna(/* void */); +extern int zplnb(/* void */); +extern int zplnc(/* void */); #endif /* __STDC__ */ #endif /* __CEXTRACT__ */ diff --git a/cephes/misc/beta.c b/cephes/misc/beta.c index dcbb7f8..fc4fc0c 100644 --- a/cephes/misc/beta.c +++ b/cephes/misc/beta.c @@ -39,9 +39,8 @@ * a or b <0 integer 0.0 * */ - -/* beta.c */ +/* beta.c */ /* Cephes Math Library Release 2.0: April, 1987 @@ -65,137 +64,133 @@ Direct inquiries to 30 Frost Street, Cambridge, MA 02140 #endif #ifdef ANSIPROT -extern double fabs ( double ); -extern double gamma ( double ); -extern double lgam ( double ); -extern double exp ( double ); -extern double log ( double ); -extern double floor ( double ); +extern double fabs(double); +extern double gamma(double); +extern double lgam(double); +extern double exp(double); +extern double log(double); +extern double floor(double); #else double fabs(), gamma(), lgam(), exp(), log(), floor(); #endif extern double MAXLOG, MAXNUM; extern int sgngam; -double beta( a, b ) +double beta(a, b) double a, b; { -double y; -int sign; - -sign = 1; - -if( a <= 0.0 ) - { - if( a == floor(a) ) - goto over; - } -if( b <= 0.0 ) - { - if( b == floor(b) ) - goto over; - } - - -y = a + b; -if( fabs(y) > MAXGAM ) - { - y = lgam(y); - sign *= sgngam; /* keep track of the sign */ - y = lgam(b) - y; - sign *= sgngam; - y = lgam(a) + y; - sign *= sgngam; - if( y > MAXLOG ) - { -over: - mtherr( "beta", OVERFLOW ); - return( sign * MAXNUM ); - } - return( sign * exp(y) ); - } - -y = gamma(y); -if( y == 0.0 ) - goto over; - -if( a > b ) - { - y = gamma(a)/y; - y *= gamma(b); - } -else - { - y = gamma(b)/y; - y *= gamma(a); - } - -return(y); + double y; + int sign; + + sign = 1; + + if (a <= 0.0) + { + if (a == floor(a)) + goto over; + } + if (b <= 0.0) + { + if (b == floor(b)) + goto over; + } + + y = a + b; + if (fabs(y) > MAXGAM) + { + y = lgam(y); + sign *= sgngam; /* keep track of the sign */ + y = lgam(b) - y; + sign *= sgngam; + y = lgam(a) + y; + sign *= sgngam; + if (y > MAXLOG) + { + over: + mtherr("beta", OVERFLOW); + return (sign * MAXNUM); + } + return (sign * exp(y)); + } + + y = gamma(y); + if (y == 0.0) + goto over; + + if (a > b) + { + y = gamma(a) / y; + y *= gamma(b); + } + else + { + y = gamma(b) / y; + y *= gamma(a); + } + + return (y); } - - /* Natural log of |beta|. Return the sign of beta in sgngam. */ -double lbeta( a, b ) +double lbeta(a, b) double a, b; { -double y; -int sign; - -sign = 1; - -if( a <= 0.0 ) - { - if( a == floor(a) ) - goto over; - } -if( b <= 0.0 ) - { - if( b == floor(b) ) - goto over; - } - - -y = a + b; -if( fabs(y) > MAXGAM ) - { - y = lgam(y); - sign *= sgngam; /* keep track of the sign */ - y = lgam(b) - y; - sign *= sgngam; - y = lgam(a) + y; - sign *= sgngam; - sgngam = sign; - return( y ); - } - -y = gamma(y); -if( y == 0.0 ) - { -over: - mtherr( "lbeta", OVERFLOW ); - return( sign * MAXNUM ); - } - -if( a > b ) - { - y = gamma(a)/y; - y *= gamma(b); - } -else - { - y = gamma(b)/y; - y *= gamma(a); - } - -if( y < 0 ) - { - sgngam = -1; - y = -y; - } -else - sgngam = 1; - -return( log(y) ); + double y; + int sign; + + sign = 1; + + if (a <= 0.0) + { + if (a == floor(a)) + goto over; + } + if (b <= 0.0) + { + if (b == floor(b)) + goto over; + } + + y = a + b; + if (fabs(y) > MAXGAM) + { + y = lgam(y); + sign *= sgngam; /* keep track of the sign */ + y = lgam(b) - y; + sign *= sgngam; + y = lgam(a) + y; + sign *= sgngam; + sgngam = sign; + return (y); + } + + y = gamma(y); + if (y == 0.0) + { + over: + mtherr("lbeta", OVERFLOW); + return (sign * MAXNUM); + } + + if (a > b) + { + y = gamma(a) / y; + y *= gamma(b); + } + else + { + y = gamma(b) / y; + y *= gamma(a); + } + + if (y < 0) + { + sgngam = -1; + y = -y; + } + else + sgngam = 1; + + return (log(y)); } diff --git a/cephes/misc/dawsn.c b/cephes/misc/dawsn.c index 0038ea6..202d679 100644 --- a/cephes/misc/dawsn.c +++ b/cephes/misc/dawsn.c @@ -37,9 +37,8 @@ * * */ - -/* dawsn.c */ +/* dawsn.c */ /* Cephes Math Library Release 2.8: June, 2000 @@ -47,6 +46,8 @@ Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier */ #include "mconf.h" + +/* clang-format off */ /* Dawson's integral, interval 0 to 3.25 */ #ifdef UNK static double AN[10] = { @@ -340,53 +341,51 @@ static unsigned short CD[20] = { 0xbf4f,0xe79c,0xad3d,0x0a8d, }; #endif +/* clang-format on */ #ifdef ANSIPROT -extern double chbevl ( double, void *, int ); -extern double sqrt ( double ); -extern double fabs ( double ); -extern double polevl ( double, void *, int ); -extern double p1evl ( double, void *, int ); +extern double chbevl(double, void *, int); +extern double sqrt(double); +extern double fabs(double); +extern double polevl(double, void *, int); +extern double p1evl(double, void *, int); #else double chbevl(), sqrt(), fabs(), polevl(), p1evl(); #endif extern double PI, MACHEP; -double dawsn( xx ) +double dawsn(xx) double xx; { -double x, y; -int sign; + double x, y; + int sign; + sign = 1; + if (xx < 0.0) + { + sign = -1; + xx = -xx; + } -sign = 1; -if( xx < 0.0 ) - { - sign = -1; - xx = -xx; - } + if (xx < 3.25) + { + x = xx * xx; + y = xx * polevl(x, AN, 9) / polevl(x, AD, 10); + return (sign * y); + } -if( xx < 3.25 ) -{ -x = xx*xx; -y = xx * polevl( x, AN, 9 )/polevl( x, AD, 10 ); -return( sign * y ); -} + x = 1.0 / (xx * xx); + if (xx < 6.25) + { + y = 1.0 / xx + x * polevl(x, BN, 10) / (p1evl(x, BD, 10) * xx); + return (sign * 0.5 * y); + } -x = 1.0/(xx*xx); + if (xx > 1.0e9) + return ((sign * 0.5) / xx); -if( xx < 6.25 ) - { - y = 1.0/xx + x * polevl( x, BN, 10) / (p1evl( x, BD, 10) * xx); - return( sign * 0.5 * y ); - } - - -if( xx > 1.0e9 ) - return( (sign * 0.5)/xx ); - -/* 6.25 to infinity */ -y = 1.0/xx + x * polevl( x, CN, 4) / (p1evl( x, CD, 5) * xx); -return( sign * 0.5 * y ); + /* 6.25 to infinity */ + y = 1.0 / xx + x * polevl(x, CN, 4) / (p1evl(x, CD, 5) * xx); + return (sign * 0.5 * y); } diff --git a/cephes/misc/ei.c b/cephes/misc/ei.c index 51e9164..1e513c1 100644 --- a/cephes/misc/ei.c +++ b/cephes/misc/ei.c @@ -20,7 +20,7 @@ * | | t * - * -inf - * + * * Not defined for x <= 0. * See also expn.c. * @@ -41,16 +41,17 @@ Copyright 1999 by Stephen L. Moshier #include "mconf.h" #ifdef ANSIPROT -extern double log ( double ); -extern double exp ( double ); -extern double polevl ( double, void *, int ); -extern double p1evl ( double, void *, int ); +extern double log(double); +extern double exp(double); +extern double polevl(double, void *, int); +extern double p1evl(double, void *, int); #else extern double log(), exp(), polevl(), p1evl(); #endif #define EUL 5.772156649015328606065e-1 +/* clang-format off */ /* 0 < x <= 2 Ei(x) - EUL - ln(x) = x A(x)/B(x) Theoretical peak relative error 9.73e-18 */ @@ -992,71 +993,72 @@ static short B7[20] = { 0xbefa,0x74fe,0x9ba9,0x8fe2, }; #endif +/* clang-format on */ -double ei (x) +double ei(x) double x; { - double f, w; + double f, w; - if (x <= 0.0) + if (x <= 0.0) { - mtherr("ei", DOMAIN); - return 0.0; + mtherr("ei", DOMAIN); + return 0.0; } - else if (x < 2.0) + else if (x < 2.0) { - /* Power series. - inf n - - x - Ei(x) = EUL + ln x + > ---- - - n n! - n=1 - */ - f = polevl(x,A,5) / p1evl(x,B,6); - /* f = polevl(x,A,6) / p1evl(x,B,7); */ - /* f = polevl(x,A,8) / p1evl(x,B,9); */ - return (EUL + log(x) + x * f); + /* Power series. + inf n + - x + Ei(x) = EUL + ln x + > ---- + - n n! + n=1 + */ + f = polevl(x, A, 5) / p1evl(x, B, 6); + /* f = polevl(x,A,6) / p1evl(x,B,7); */ + /* f = polevl(x,A,8) / p1evl(x,B,9); */ + return (EUL + log(x) + x * f); } - else if (x < 4.0) + else if (x < 4.0) { - /* Asymptotic expansion. - 1 2 6 - x exp(-x) Ei(x) = 1 + --- + --- + ---- + ... - x 2 3 - x x - */ - w = 1.0/x; - f = polevl(w,A6,7) / p1evl(w,B6,7); - return (exp(x) * w * (1.0 + w * f)); + /* Asymptotic expansion. + 1 2 6 + x exp(-x) Ei(x) = 1 + --- + --- + ---- + ... + x 2 3 + x x + */ + w = 1.0 / x; + f = polevl(w, A6, 7) / p1evl(w, B6, 7); + return (exp(x) * w * (1.0 + w * f)); } - else if (x < 8.0) + else if (x < 8.0) { - w = 1.0/x; - f = polevl(w,A5,7) / p1evl(w,B5,8); - return (exp(x) * w * (1.0 + w * f)); + w = 1.0 / x; + f = polevl(w, A5, 7) / p1evl(w, B5, 8); + return (exp(x) * w * (1.0 + w * f)); } - else if (x < 16.0) + else if (x < 16.0) { - w = 1.0/x; - f = polevl(w,A2,9) / p1evl(w,B2,9); - return (exp(x) * w * (1.0 + w * f)); + w = 1.0 / x; + f = polevl(w, A2, 9) / p1evl(w, B2, 9); + return (exp(x) * w * (1.0 + w * f)); } - else if (x < 32.0) + else if (x < 32.0) { - w = 1.0/x; - f = polevl(w,A4,7) / p1evl(w,B4,8); - return (exp(x) * w * (1.0 + w * f)); + w = 1.0 / x; + f = polevl(w, A4, 7) / p1evl(w, B4, 8); + return (exp(x) * w * (1.0 + w * f)); } - else if (x < 64.0) + else if (x < 64.0) { - w = 1.0/x; - f = polevl(w,A7,5) / p1evl(w,B7,5); - return (exp(x) * w * (1.0 + w * f)); + w = 1.0 / x; + f = polevl(w, A7, 5) / p1evl(w, B7, 5); + return (exp(x) * w * (1.0 + w * f)); } - else + else { - w = 1.0/x; - f = polevl(w,A3,8) / p1evl(w,B3,9); - return (exp(x) * w * (1.0 + w * f)); + w = 1.0 / x; + f = polevl(w, A3, 8) / p1evl(w, B3, 9); + return (exp(x) * w * (1.0 + w * f)); } } diff --git a/cephes/misc/expn.c b/cephes/misc/expn.c index 01c9aea..89de5fb 100644 --- a/cephes/misc/expn.c +++ b/cephes/misc/expn.c @@ -42,7 +42,7 @@ * IEEE 0, 30 10000 1.7e-15 3.6e-16 * */ - + /* expn.c */ /* Cephes Math Library Release 2.8: June, 2000 @@ -50,159 +50,157 @@ #include "mconf.h" #ifdef ANSIPROT -extern double pow ( double, double ); -extern double gamma ( double ); -extern double log ( double ); -extern double exp ( double ); -extern double fabs ( double ); +extern double pow(double, double); +extern double gamma(double); +extern double log(double); +extern double exp(double); +extern double fabs(double); #else double pow(), gamma(), log(), exp(), fabs(); #endif #define EUL 0.57721566490153286060 -#define BIG 1.44115188075855872E+17 +#define BIG 1.44115188075855872E+17 extern double MAXNUM, MACHEP, MAXLOG; -double expn( n, x ) +double expn(n, x) int n; double x; { -double ans, r, t, yk, xk; -double pk, pkm1, pkm2, qk, qkm1, qkm2; -double psi, z; -int i, k; -static double big = BIG; - -if( n < 0 ) - goto domerr; - -if( x < 0 ) - { -domerr: mtherr( "expn", DOMAIN ); - return( MAXNUM ); - } - -if( x > MAXLOG ) - return( 0.0 ); - -if( x == 0.0 ) - { - if( n < 2 ) - { - mtherr( "expn", SING ); - return( MAXNUM ); - } - else - return( 1.0/(n-1.0) ); - } - -if( n == 0 ) - return( exp(-x)/x ); - -/* expn.c */ -/* Expansion for large n */ - -if( n > 5000 ) - { - xk = x + n; - yk = 1.0 / (xk * xk); - t = n; - ans = yk * t * (6.0 * x * x - 8.0 * t * x + t * t); - ans = yk * (ans + t * (t - 2.0 * x)); - ans = yk * (ans + t); - ans = (ans + 1.0) * exp( -x ) / xk; - goto done; - } - -if( x > 1.0 ) - goto cfrac; - -/* expn.c */ + double ans, r, t, yk, xk; + double pk, pkm1, pkm2, qk, qkm1, qkm2; + double psi, z; + int i, k; + static double big = BIG; + + if (n < 0) + goto domerr; + + if (x < 0) + { + domerr: + mtherr("expn", DOMAIN); + return (MAXNUM); + } + + if (x > MAXLOG) + return (0.0); + + if (x == 0.0) + { + if (n < 2) + { + mtherr("expn", SING); + return (MAXNUM); + } + else + return (1.0 / (n - 1.0)); + } + + if (n == 0) + return (exp(-x) / x); + + /* expn.c */ + /* Expansion for large n */ + + if (n > 5000) + { + xk = x + n; + yk = 1.0 / (xk * xk); + t = n; + ans = yk * t * (6.0 * x * x - 8.0 * t * x + t * t); + ans = yk * (ans + t * (t - 2.0 * x)); + ans = yk * (ans + t); + ans = (ans + 1.0) * exp(-x) / xk; + goto done; + } + + if (x > 1.0) + goto cfrac; + + /* expn.c */ + + /* Power series expansion */ + + psi = -EUL - log(x); + for (i = 1; i < n; i++) + psi = psi + 1.0 / i; + + z = -x; + xk = 0.0; + yk = 1.0; + pk = 1.0 - n; + if (n == 1) + ans = 0.0; + else + ans = 1.0 / pk; + do + { + xk += 1.0; + yk *= z / xk; + pk += 1.0; + if (pk != 0.0) + { + ans += yk / pk; + } + if (ans != 0.0) + t = fabs(yk / ans); + else + t = 1.0; + } while (t > MACHEP); + k = xk; + t = n; + r = n - 1; + ans = (pow(z, r) * psi / gamma(t)) - ans; + goto done; -/* Power series expansion */ - -psi = -EUL - log(x); -for( i=1; i MACHEP ); -k = xk; -t = n; -r = n - 1; -ans = (pow(z, r) * psi / gamma(t)) - ans; -goto done; - /* expn.c */ /* continued fraction */ cfrac: -k = 1; -pkm2 = 1.0; -qkm2 = x; -pkm1 = 1.0; -qkm1 = x + n; -ans = pkm1/qkm1; - -do - { - k += 1; - if( k & 1 ) - { - yk = 1.0; - xk = n + (k-1)/2; - } - else - { - yk = x; - xk = k/2; - } - pk = pkm1 * yk + pkm2 * xk; - qk = qkm1 * yk + qkm2 * xk; - if( qk != 0 ) - { - r = pk/qk; - t = fabs( (ans - r)/r ); - ans = r; - } - else - t = 1.0; - pkm2 = pkm1; - pkm1 = pk; - qkm2 = qkm1; - qkm1 = qk; -if( fabs(pk) > big ) - { - pkm2 /= big; - pkm1 /= big; - qkm2 /= big; - qkm1 /= big; - } - } -while( t > MACHEP ); - -ans *= exp( -x ); + k = 1; + pkm2 = 1.0; + qkm2 = x; + pkm1 = 1.0; + qkm1 = x + n; + ans = pkm1 / qkm1; + + do + { + k += 1; + if (k & 1) + { + yk = 1.0; + xk = n + (k - 1) / 2; + } + else + { + yk = x; + xk = k / 2; + } + pk = pkm1 * yk + pkm2 * xk; + qk = qkm1 * yk + qkm2 * xk; + if (qk != 0) + { + r = pk / qk; + t = fabs((ans - r) / r); + ans = r; + } + else + t = 1.0; + pkm2 = pkm1; + pkm1 = pk; + qkm2 = qkm1; + qkm1 = qk; + if (fabs(pk) > big) + { + pkm2 /= big; + pkm1 /= big; + qkm2 /= big; + qkm1 /= big; + } + } while (t > MACHEP); + + ans *= exp(-x); done: -return( ans ); + return (ans); } - diff --git a/cephes/misc/fac.c b/cephes/misc/fac.c index 8b34f33..a2bcb34 100644 --- a/cephes/misc/fac.c +++ b/cephes/misc/fac.c @@ -37,7 +37,7 @@ * DEC 0, 33 1.4e-17 * */ - + /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 2000 by Stephen L. Moshier @@ -45,6 +45,7 @@ Copyright 1984, 1987, 2000 by Stephen L. Moshier #include "mconf.h" +/* clang-format off */ /* Factorials of integers from 0 through 33 */ #ifdef UNK static double factbl[] = { @@ -205,9 +206,10 @@ static unsigned short factbl[] = { }; #define MAXFAC 170 #endif +/* clang-format on */ #ifdef ANSIPROT -double gamma ( double ); +double gamma(double); #else double gamma(); #endif @@ -216,48 +218,48 @@ extern double MAXNUM; double fac(i) int i; { -double x, f, n; -int j; + double x, f, n; + int j; -if( i < 0 ) - { - mtherr( "fac", SING ); - return( MAXNUM ); - } + if (i < 0) + { + mtherr("fac", SING); + return (MAXNUM); + } -if( i > MAXFAC ) - { - mtherr( "fac", OVERFLOW ); - return( MAXNUM ); - } + if (i > MAXFAC) + { + mtherr("fac", OVERFLOW); + return (MAXNUM); + } -/* Get answer from table for small i. */ -if( i < 34 ) - { + /* Get answer from table for small i. */ + if (i < 34) + { #ifdef UNK - return( factbl[i] ); + return (factbl[i]); #else - return( *(double *)(&factbl[4*i]) ); + return (*(double *)(&factbl[4 * i])); #endif - } -/* Use gamma function for large i. */ -if( i > 55 ) - { - x = i + 1; - return( gamma(x) ); - } -/* Compute directly for intermediate i. */ -n = 34.0; -f = 34.0; -for( j=35; j<=i; j++ ) - { - n += 1.0; - f *= n; - } + } + /* Use gamma function for large i. */ + if (i > 55) + { + x = i + 1; + return (gamma(x)); + } + /* Compute directly for intermediate i. */ + n = 34.0; + f = 34.0; + for (j = 35; j <= i; j++) + { + n += 1.0; + f *= n; + } #ifdef UNK - f *= factbl[33]; + f *= factbl[33]; #else - f *= *(double *)(&factbl[4*33]); + f *= *(double *)(&factbl[4 * 33]); #endif -return( f ); + return (f); } diff --git a/cephes/misc/fresnl.c b/cephes/misc/fresnl.c index 0d98cf8..9371258 100644 --- a/cephes/misc/fresnl.c +++ b/cephes/misc/fresnl.c @@ -52,7 +52,7 @@ * DEC S(x) 0, 10 6000 2.2e-16 3.9e-17 * DEC C(x) 0, 10 5000 2.3e-16 3.9e-17 */ - + /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier @@ -60,6 +60,7 @@ Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier #include "mconf.h" +/* clang-format off */ /* S(x) for small x */ #ifdef UNK static double sn[6] = { @@ -444,72 +445,67 @@ static unsigned short gd[44] = { 0x3b6c,0x409d,0x624f,0xbe2b, }; #endif +/* clang-format on */ #ifdef ANSIPROT -extern double fabs ( double ); -extern double cos ( double ); -extern double sin ( double ); -extern double polevl ( double, void *, int ); -extern double p1evl ( double, void *, int ); +extern double fabs(double); +extern double cos(double); +extern double sin(double); +extern double polevl(double, void *, int); +extern double p1evl(double, void *, int); #else double fabs(), cos(), sin(), polevl(), p1evl(); #endif extern double PI, PIO2, MACHEP; -int fresnl( xxa, ssa, cca ) +int fresnl(xxa, ssa, cca) double xxa, *ssa, *cca; { -double f, g, cc, ss, c, s, t, u; -double x, x2; - -x = fabs(xxa); -x2 = x * x; -if( x2 < 2.5625 ) - { - t = x2 * x2; - ss = x * x2 * polevl( t, sn, 5)/p1evl( t, sd, 6 ); - cc = x * polevl( t, cn, 5)/polevl(t, cd, 6 ); - goto done; - } - - + double f, g, cc, ss, c, s, t, u; + double x, x2; + x = fabs(xxa); + x2 = x * x; + if (x2 < 2.5625) + { + t = x2 * x2; + ss = x * x2 * polevl(t, sn, 5) / p1evl(t, sd, 6); + cc = x * polevl(t, cn, 5) / polevl(t, cd, 6); + goto done; + } + if (x > 36974.0) + { + cc = 0.5; + ss = 0.5; + goto done; + } + /* Asymptotic power series auxiliary functions + * for large argument + */ + x2 = x * x; + t = PI * x2; + u = 1.0 / (t * t); + t = 1.0 / t; + f = 1.0 - u * polevl(u, fn, 9) / p1evl(u, fd, 10); + g = t * polevl(u, gn, 10) / p1evl(u, gd, 11); -if( x > 36974.0 ) - { - cc = 0.5; - ss = 0.5; - goto done; - } - - -/* Asymptotic power series auxiliary functions - * for large argument - */ - x2 = x * x; - t = PI * x2; - u = 1.0/(t * t); - t = 1.0/t; - f = 1.0 - u * polevl( u, fn, 9)/p1evl(u, fd, 10); - g = t * polevl( u, gn, 10)/p1evl(u, gd, 11); - - t = PIO2 * x2; - c = cos(t); - s = sin(t); - t = PI * x; - cc = 0.5 + (f * s - g * c)/t; - ss = 0.5 - (f * c + g * s)/t; + t = PIO2 * x2; + c = cos(t); + s = sin(t); + t = PI * x; + cc = 0.5 + (f * s - g * c) / t; + ss = 0.5 - (f * c + g * s) / t; done: -if( xxa < 0.0 ) - { - cc = -cc; - ss = -ss; - } + if (xxa < 0.0) + { + cc = -cc; + ss = -ss; + } -*cca = cc; -*ssa = ss; -return(0); + *cca = cc; + *ssa = ss; + return (0); } diff --git a/cephes/misc/planck.c b/cephes/misc/planck.c index e9aae09..6658dd5 100644 --- a/cephes/misc/planck.c +++ b/cephes/misc/planck.c @@ -50,7 +50,6 @@ * */ - /* Cephes Math Library Release 2.8: July, 1999 Copyright 1999 by Stephen L. Moshier @@ -58,10 +57,10 @@ Copyright 1999 by Stephen L. Moshier #include "mconf.h" #ifdef ANSIPROT -extern double polylog (int, double); -extern double exp (double); -extern double log1p (double); /* log(1+x) */ -extern double expm1 (double); /* exp(x) - 1 */ +extern double polylog(int, double); +extern double exp(double); +extern double log1p(double); /* log(1+x) */ +extern double expm1(double); /* exp(x) - 1 */ double planckc(double, double); double plancki(double, double); #else @@ -69,41 +68,39 @@ double polylog(), exp(), log1p(), expm1(); double planckc(), plancki(); #endif -/* NIST value (1999): 2 pi h c^2 = 3.741 7749(22) × 10-16 W m2 */ +/* NIST value (1999): 2 pi h c^2 = 3.741 7749(22) × 10-16 W m2 */ double planck_c1 = 3.7417749e-16; /* NIST value (1999): h c / k = 0.014 387 69 m K */ double planck_c2 = 0.01438769; - -double -plancki(w, T) - double w, T; +double plancki(w, T) +double w, T; { - double b, h, y, bw; + double b, h, y, bw; - b = T / planck_c2; - bw = b * w; + b = T / planck_c2; + bw = b * w; - if (bw > 0.59375) + if (bw > 0.59375) { - y = b * b; - h = y * y; - /* Right tail. */ - y = planckc (w, T); - /* pi^4 / 15 */ - y = 6.493939402266829149096 * planck_c1 * h - y; - return y; + y = b * b; + h = y * y; + /* Right tail. */ + y = planckc(w, T); + /* pi^4 / 15 */ + y = 6.493939402266829149096 * planck_c1 * h - y; + return y; } - h = exp(-planck_c2/(w*T)); - y = 6. * polylog (4, h) * bw; - y = (y + 6. * polylog (3, h)) * bw; - y = (y + 3. * polylog (2, h)) * bw; - y = (y - log1p (-h)) * bw; - h = w * w; - h = h * h; - y = y * (planck_c1 / h); - return y; + h = exp(-planck_c2 / (w * T)); + y = 6. * polylog(4, h) * bw; + y = (y + 6. * polylog(3, h)) * bw; + y = (y + 3. * polylog(2, h)) * bw; + y = (y - log1p(-h)) * bw; + h = w * w; + h = h * h; + y = y * (planck_c1 / h); + return y; } /* planckc @@ -137,22 +134,21 @@ plancki(w, T) * */ -double -planckc (w, T) - double w; - double T; +double planckc(w, T) +double w; +double T; { - double b, d, p, u, y; + double b, d, p, u, y; - b = T / planck_c2; - d = b*w; - if (d <= 0.59375) + b = T / planck_c2; + d = b * w; + if (d <= 0.59375) { - y = 6.493939402266829149096 * planck_c1 * b*b*b*b; - return (y - plancki(w,T)); + y = 6.493939402266829149096 * planck_c1 * b * b * b * b; + return (y - plancki(w, T)); } - u = 1.0/d; - p = u * u; + u = 1.0 / d; + p = u * u; #if 0 y = 236364091.*p/365866013534056632601804800000.; y = (y - 15458917./475677107995483570176000000.)*p; @@ -164,20 +160,19 @@ planckc (w, T) y = y + log(d * expm1(u)); y = y - 5.*u/8. + 1./3.; #else - y = -236364091.*p/45733251691757079075225600000.; - y = (y + 77683./352527500984795136000000.)*p; - y = (y - 174611./18465726242060697600000.)*p; - y = (y + 43867./107290978560589824000.)*p; - y = ((y - 3617./202741834014720000.)*p + 1./1270312243200.)*p; - y = ((y - 691./19615115520000.)*p + 1./622702080.)*p; - y = ((((y - 1./13305600.)*p + 1./272160.)*p - 1./5040.)*p + 1./60.)*p; - y = y - 0.125*u + 1./3.; + y = -236364091. * p / 45733251691757079075225600000.; + y = (y + 77683. / 352527500984795136000000.) * p; + y = (y - 174611. / 18465726242060697600000.) * p; + y = (y + 43867. / 107290978560589824000.) * p; + y = ((y - 3617. / 202741834014720000.) * p + 1. / 1270312243200.) * p; + y = ((y - 691. / 19615115520000.) * p + 1. / 622702080.) * p; + y = ((((y - 1. / 13305600.) * p + 1. / 272160.) * p - 1. / 5040.) * p + 1. / 60.) * p; + y = y - 0.125 * u + 1. / 3.; #endif - y = y * planck_c1 * b / (w*w*w); - return y; + y = y * planck_c1 * b / (w * w * w); + return y; } - /* planckd * * Planck's black body radiation formula @@ -203,21 +198,18 @@ planckc (w, T) * */ -double -planckd(w, T) - double w, T; +double planckd(w, T) +double w, T; { - return (planck_c2 / ((w*w*w*w*w) * (exp(planck_c2/(w*T)) - 1.0))); + return (planck_c2 / ((w * w * w * w * w) * (exp(planck_c2 / (w * T)) - 1.0))); } - /* Wavelength, w, of maximum radiation at given temperature T. c2/wT = constant Wein displacement law. */ -double -planckw(T) - double T; +double planckw(T) +double T; { - return (planck_c2 / (4.96511423174427630 * T)); + return (planck_c2 / (4.96511423174427630 * T)); } diff --git a/cephes/misc/polylog.c b/cephes/misc/polylog.c index 36d0d54..d27cb3d 100644 --- a/cephes/misc/polylog.c +++ b/cephes/misc/polylog.c @@ -73,6 +73,7 @@ Copyright 1999 by Stephen L. Moshier #include "mconf.h" extern double PI; +/* clang-format off */ /* polylog(4, 1-x) = zeta(4) - x zeta(3) + x^2 A4(x)/B4(x) 0 <= x <= 0.125 Theoretical peak absolute error 4.5e-18 */ @@ -204,18 +205,19 @@ static short B4[48] = { 0x3ae2,0x81e1,0x5f6f,0xbc13, }; #endif +/* clang-format on */ #ifdef ANSIPROT -extern double spence ( double ); -extern double polevl ( double, void *, int ); -extern double p1evl ( double, void *, int ); -extern double zetac ( double ); -extern double pow ( double, double ); -extern double powi ( double, int ); -extern double log ( double ); -extern double fac ( int i ); -extern double fabs (double); -double polylog (int, double); +extern double spence(double); +extern double polevl(double, void *, int); +extern double p1evl(double, void *, int); +extern double zetac(double); +extern double pow(double, double); +extern double powi(double, int); +extern double log(double); +extern double fac(int i); +extern double fabs(double); +double polylog(int, double); #else extern double spence(), polevl(), p1evl(), zetac(); extern double pow(), powi(), log(); @@ -225,244 +227,236 @@ double polylog(); #endif extern double MACHEP; -double -polylog (n, x) - int n; - double x; +double polylog(n, x) +int n; +double x; { - double h, k, p, s, t, u, xc, z; - int i, j; + double h, k, p, s, t, u, xc, z; + int i, j; -/* This recurrence provides formulas for n < 2. + /* This recurrence provides formulas for n < 2. - d 1 - -- Li (x) = --- Li (x) . - dx n x n-1 + d 1 + -- Li (x) = --- Li (x) . + dx n x n-1 -*/ + */ - if (n == -1) + if (n == -1) { - p = 1.0 - x; - u = x / p; - s = u * u + u; - return s; + p = 1.0 - x; + u = x / p; + s = u * u + u; + return s; } - if (n == 0) + if (n == 0) { - s = x / (1.0 - x); - return s; + s = x / (1.0 - x); + return s; } - /* Not implemented for n < -1. - Not defined for x > 1. Use cpolylog if you need that. */ - if (x > 1.0 || n < -1) + /* Not implemented for n < -1. + Not defined for x > 1. Use cpolylog if you need that. */ + if (x > 1.0 || n < -1) { - mtherr("polylog", DOMAIN); - return 0.0; + mtherr("polylog", DOMAIN); + return 0.0; } - if (n == 1) + if (n == 1) { - s = -log (1.0 - x); - return s; + s = -log(1.0 - x); + return s; } - /* Argument +1 */ - if (x == 1.0 && n > 1) + /* Argument +1 */ + if (x == 1.0 && n > 1) { - s = zetac ((double) n) + 1.0; - return s; + s = zetac((double)n) + 1.0; + return s; } - /* Argument -1. - 1-n - Li (-z) = - (1 - 2 ) Li (z) - n n - */ - if (x == -1.0 && n > 1) + /* Argument -1. + 1-n + Li (-z) = - (1 - 2 ) Li (z) + n n + */ + if (x == -1.0 && n > 1) { - /* Li_n(1) = zeta(n) */ - s = zetac ((double) n) + 1.0; - s = s * (powi (2.0, 1 - n) - 1.0); - return s; + /* Li_n(1) = zeta(n) */ + s = zetac((double)n) + 1.0; + s = s * (powi(2.0, 1 - n) - 1.0); + return s; } -/* Inversion formula: - * [n/2] n-2r - * n 1 n - log (z) - * Li (-z) + (-1) Li (-1/z) = - --- log (z) + 2 > ----------- Li (-1) - * n n n! - (n - 2r)! 2r - * r=1 - */ - if (x < -1.0 && n > 1) + /* Inversion formula: + * [n/2] n-2r + * n 1 n - log (z) + * Li (-z) + (-1) Li (-1/z) = - --- log (z) + 2 > ----------- Li (-1) + * n n n! - (n - 2r)! 2r + * r=1 + */ + if (x < -1.0 && n > 1) { - double q, w; - int r; - - w = log (-x); - s = 0.0; - for (r = 1; r <= n / 2; r++) - { - j = 2 * r; - p = polylog (j, -1.0); - j = n - j; - if (j == 0) - { - s = s + p; - break; - } - q = (double) j; - q = pow (w, q) * p / fac (j); - s = s + q; - } - s = 2.0 * s; - q = polylog (n, 1.0 / x); - if (n & 1) - q = -q; - s = s - q; - s = s - pow (w, (double) n) / fac (n); - return s; + double q, w; + int r; + + w = log(-x); + s = 0.0; + for (r = 1; r <= n / 2; r++) + { + j = 2 * r; + p = polylog(j, -1.0); + j = n - j; + if (j == 0) + { + s = s + p; + break; + } + q = (double)j; + q = pow(w, q) * p / fac(j); + s = s + q; + } + s = 2.0 * s; + q = polylog(n, 1.0 / x); + if (n & 1) + q = -q; + s = s - q; + s = s - pow(w, (double)n) / fac(n); + return s; } - if (n == 2) + if (n == 2) { - if (x < 0.0 || x > 1.0) - return (spence (1.0 - x)); + if (x < 0.0 || x > 1.0) + return (spence(1.0 - x)); } + /* The power series converges slowly when x is near 1. For n = 3, this + identity helps: + Li (-x/(1-x)) + Li (1-x) + Li (x) + 3 3 3 + 2 2 3 + = Li (1) + (pi /6) log(1-x) - (1/2) log(x) log (1-x) + (1/6) log (1-x) + 3 + */ - /* The power series converges slowly when x is near 1. For n = 3, this - identity helps: - - Li (-x/(1-x)) + Li (1-x) + Li (x) - 3 3 3 - 2 2 3 - = Li (1) + (pi /6) log(1-x) - (1/2) log(x) log (1-x) + (1/6) log (1-x) - 3 - */ - - if (n == 3) + if (n == 3) { - p = x * x * x; - if (x > 0.8) - { - /* Thanks to Oscar van Vlijmen for detecting an error here. */ - u = log(x); - s = u * u * u / 6.0; - xc = 1.0 - x; - s = s - 0.5 * u * u * log(xc); - s = s + PI * PI * u / 6.0; - s = s - polylog (3, -xc/x); - s = s - polylog (3, xc); - s = s + zetac(3.0); - s = s + 1.0; - return s; - } - /* Power series */ - t = p / 27.0; - t = t + .125 * x * x; - t = t + x; - - s = 0.0; - k = 4.0; - do - { - p = p * x; - h = p / (k * k * k); - s = s + h; - k += 1.0; - } - while (fabs(h/s) > 1.1e-16); - return (s + t); + p = x * x * x; + if (x > 0.8) + { + /* Thanks to Oscar van Vlijmen for detecting an error here. */ + u = log(x); + s = u * u * u / 6.0; + xc = 1.0 - x; + s = s - 0.5 * u * u * log(xc); + s = s + PI * PI * u / 6.0; + s = s - polylog(3, -xc / x); + s = s - polylog(3, xc); + s = s + zetac(3.0); + s = s + 1.0; + return s; + } + /* Power series */ + t = p / 27.0; + t = t + .125 * x * x; + t = t + x; + + s = 0.0; + k = 4.0; + do + { + p = p * x; + h = p / (k * k * k); + s = s + h; + k += 1.0; + } while (fabs(h / s) > 1.1e-16); + return (s + t); } -if (n == 4) - { - if (x >= 0.875) - { - u = 1.0 - x; - s = polevl(u, A4, 12) / p1evl(u, B4, 12); - s = s * u * u - 1.202056903159594285400 * u; - s += 1.0823232337111381915160; - return s; - } - goto pseries; - } - - - if (x < 0.75) - goto pseries; - - -/* This expansion in powers of log(x) is especially useful when - x is near 1. - - See also the pari gp calculator. - - inf j - - z(n-j) (log(x)) - polylog(n,x) = > ----------------- - - j! - j=0 - - where - - z(j) = Riemann zeta function (j), j != 1 - - n-1 - - - z(1) = -log(-log(x)) + > 1/k - - - k=1 - */ - - z = log(x); - h = -log(-z); - for (i = 1; i < n; i++) - h = h + 1.0/i; - p = 1.0; - s = zetac((double)n) + 1.0; - for (j=1; j<=n+1; j++) - { - p = p * z / j; - if (j == n-1) - s = s + h * p; - else - s = s + (zetac((double)(n-j)) + 1.0) * p; - } - j = n + 3; - z = z * z; - for(;;) + if (n == 4) { - p = p * z / ((j-1)*j); - h = (zetac((double)(n-j)) + 1.0); - h = h * p; - s = s + h; - if (fabs(h/s) < MACHEP) - break; - j += 2; + if (x >= 0.875) + { + u = 1.0 - x; + s = polevl(u, A4, 12) / p1evl(u, B4, 12); + s = s * u * u - 1.202056903159594285400 * u; + s += 1.0823232337111381915160; + return s; + } + goto pseries; } - return s; + if (x < 0.75) + goto pseries; -pseries: + /* This expansion in powers of log(x) is especially useful when + x is near 1. + + See also the pari gp calculator. + + inf j + - z(n-j) (log(x)) + polylog(n,x) = > ----------------- + - j! + j=0 + + where - p = x * x * x; - k = 3.0; - s = 0.0; - do + z(j) = Riemann zeta function (j), j != 1 + + n-1 + - + z(1) = -log(-log(x)) + > 1/k + - + k=1 + */ + + z = log(x); + h = -log(-z); + for (i = 1; i < n; i++) + h = h + 1.0 / i; + p = 1.0; + s = zetac((double)n) + 1.0; + for (j = 1; j <= n + 1; j++) + { + p = p * z / j; + if (j == n - 1) + s = s + h * p; + else + s = s + (zetac((double)(n - j)) + 1.0) * p; + } + j = n + 3; + z = z * z; + for (;;) { - p = p * x; - k += 1.0; - h = p / powi(k, n); - s = s + h; + p = p * z / ((j - 1) * j); + h = (zetac((double)(n - j)) + 1.0); + h = h * p; + s = s + h; + if (fabs(h / s) < MACHEP) + break; + j += 2; } - while (fabs(h/s) > MACHEP); - s += x * x * x / powi(3.0,n); - s += x * x / powi(2.0,n); - s += x; - return s; + return s; + +pseries: + + p = x * x * x; + k = 3.0; + s = 0.0; + do + { + p = p * x; + k += 1.0; + h = p / powi(k, n); + s = s + h; + } while (fabs(h / s) > MACHEP); + s += x * x * x / powi(3.0, n); + s += x * x / powi(2.0, n); + s += x; + return s; } diff --git a/cephes/misc/psi.c b/cephes/misc/psi.c index 503a1d8..83cdcb1 100644 --- a/cephes/misc/psi.c +++ b/cephes/misc/psi.c @@ -50,7 +50,7 @@ * message condition value returned * psi singularity x integer <=0 MAXNUM */ - + /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 1992, 2000 by Stephen L. Moshier @@ -58,6 +58,7 @@ Copyright 1984, 1987, 1992, 2000 by Stephen L. Moshier #include "mconf.h" +/* clang-format off */ #ifdef UNK static double A[] = { 8.33333333333333333333E-2, @@ -105,97 +106,97 @@ static unsigned short A[] = { 0x3fb5,0x5555,0x5555,0x5555 }; #endif +/* clang-format on */ #define EUL 0.57721566490153286061 #ifdef ANSIPROT -extern double floor ( double ); -extern double log ( double ); -extern double tan ( double ); -extern double polevl ( double, void *, int ); +extern double floor(double); +extern double log(double); +extern double tan(double); +extern double polevl(double, void *, int); #else double floor(), log(), tan(), polevl(); #endif extern double PI, MAXNUM; - double psi(x) double x; { -double p, q, nz, s, w, y, z; -int i, n, negative; - -negative = 0; -nz = 0.0; - -if( x <= 0.0 ) - { - negative = 1; - q = x; - p = floor(q); - if( p == q ) - { - mtherr( "psi", SING ); - return( MAXNUM ); - } -/* Remove the zeros of tan(PI x) - * by subtracting the nearest integer from x - */ - nz = q - p; - if( nz != 0.5 ) - { - if( nz > 0.5 ) - { - p += 1.0; - nz = q - p; - } - nz = PI/tan(PI*nz); - } - else - { - nz = 0.0; - } - x = 1.0 - x; - } - -/* check for positive integer up to 10 */ -if( (x <= 10.0) && (x == floor(x)) ) - { - y = 0.0; - n = x; - for( i=1; i 0.5) + { + p += 1.0; + nz = q - p; + } + nz = PI / tan(PI * nz); + } + else + { + nz = 0.0; + } + x = 1.0 - x; + } + + /* check for positive integer up to 10 */ + if ((x <= 10.0) && (x == floor(x))) + { + y = 0.0; + n = x; + for (i = 1; i < n; i++) + { + w = i; + y += 1.0 / w; + } + y -= EUL; + goto done; + } + + s = x; + w = 0.0; + while (s < 10.0) + { + w += 1.0 / s; + s += 1.0; + } + + if (s < 1.0e17) + { + z = 1.0 / (s * s); + y = z * polevl(z, A, 6); + } + else + y = 0.0; + + y = log(s) - (0.5 / s) - y - w; done: -if( negative ) - { - y -= nz; - } + if (negative) + { + y -= nz; + } -return(y); + return (y); } diff --git a/cephes/misc/rgamma.c b/cephes/misc/rgamma.c index 2bf978f..922ec3c 100644 --- a/cephes/misc/rgamma.c +++ b/cephes/misc/rgamma.c @@ -38,7 +38,7 @@ * For arguments less than -34.034 the peak error is on the * order of 5e-15 (DEC), excepting overflow or underflow. */ - + /* Cephes Math Library Release 2.8: June, 2000 Copyright 1985, 1987, 2000 by Stephen L. Moshier @@ -46,6 +46,7 @@ Copyright 1985, 1987, 2000 by Stephen L. Moshier #include "mconf.h" +/* clang-format off */ /* Chebyshev coefficients for reciprocal gamma function * in interval 0 to 1. Function is 1/(x gamma(x)) - 1 */ @@ -133,77 +134,77 @@ static unsigned short R[] = { 0x3fc0,0x536d,0x86e4,0x2299 }; #endif +/* clang-format on */ static char name[] = "rgamma"; #ifdef ANSIPROT -extern double chbevl ( double, void *, int ); -extern double exp ( double ); -extern double log ( double ); -extern double sin ( double ); -extern double lgam ( double ); +extern double chbevl(double, void *, int); +extern double exp(double); +extern double log(double); +extern double sin(double); +extern double lgam(double); #else double chbevl(), exp(), log(), sin(), lgam(); #endif extern double PI, MAXLOG, MAXNUM; - double rgamma(x) double x; { -double w, y, z; -int sign; + double w, y, z; + int sign; -if( x > 34.84425627277176174) - { - mtherr( name, UNDERFLOW ); - return(1.0/MAXNUM); - } -if( x < -34.034 ) - { - w = -x; - z = sin( PI*w ); - if( z == 0.0 ) - return(0.0); - if( z < 0.0 ) - { - sign = 1; - z = -z; - } - else - sign = -1; + if (x > 34.84425627277176174) + { + mtherr(name, UNDERFLOW); + return (1.0 / MAXNUM); + } + if (x < -34.034) + { + w = -x; + z = sin(PI * w); + if (z == 0.0) + return (0.0); + if (z < 0.0) + { + sign = 1; + z = -z; + } + else + sign = -1; - y = log( w * z ) - log(PI) + lgam(w); - if( y < -MAXLOG ) - { - mtherr( name, UNDERFLOW ); - return( sign * 1.0 / MAXNUM ); - } - if( y > MAXLOG ) - { - mtherr( name, OVERFLOW ); - return( sign * MAXNUM ); - } - return( sign * exp(y)); - } -z = 1.0; -w = x; + y = log(w * z) - log(PI) + lgam(w); + if (y < -MAXLOG) + { + mtherr(name, UNDERFLOW); + return (sign * 1.0 / MAXNUM); + } + if (y > MAXLOG) + { + mtherr(name, OVERFLOW); + return (sign * MAXNUM); + } + return (sign * exp(y)); + } + z = 1.0; + w = x; -while( w > 1.0 ) /* Downward recurrence */ - { - w -= 1.0; - z *= w; - } -while( w < 0.0 ) /* Upward recurrence */ - { - z /= w; - w += 1.0; - } -if( w == 0.0 ) /* Nonpositive integer */ - return(0.0); -if( w == 1.0 ) /* Other integer */ - return( 1.0/z ); + while (w > 1.0) /* Downward recurrence */ + { + w -= 1.0; + z *= w; + } + while (w < 0.0) /* Upward recurrence */ + { + z /= w; + w += 1.0; + } + if (w == 0.0) /* Nonpositive integer */ + return (0.0); + if (w == 1.0) /* Other integer */ + return (1.0 / z); -y = w * ( 1.0 + chbevl( 4.0*w-2.0, R, 16 ) ) / z; -return(y); + y = w * (1.0 + chbevl(4.0 * w - 2.0, R, 16)) / z; + return (y); } diff --git a/cephes/misc/shichi.c b/cephes/misc/shichi.c index 3855759..db86b63 100644 --- a/cephes/misc/shichi.c +++ b/cephes/misc/shichi.c @@ -49,15 +49,15 @@ * DEC Chi 2500 9.3e-17 * IEEE Chi 30000 8.4e-16 1.4e-16 */ - + /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 2000 by Stephen L. Moshier */ - #include "mconf.h" +/* clang-format off */ #ifdef UNK /* x exp(-x) shi(x), inverted interval 8 to 18 */ static double S1[] = { @@ -494,106 +494,102 @@ static unsigned short C2[] = { 0x3ff0,0x9625,0x962f,0x25d7 }; #endif - - +/* clang-format on */ /* Sine and cosine integrals */ #ifdef ANSIPROT -extern double log ( double ); -extern double exp ( double ); -extern double fabs ( double ); -extern double chbevl ( double, void *, int ); +extern double log(double); +extern double exp(double); +extern double fabs(double); +extern double chbevl(double, void *, int); #else double log(), exp(), fabs(), chbevl(); #endif #define EUL 0.57721566490153286061 extern double MACHEP, MAXNUM, PIO2; -int shichi( x, si, ci ) +int shichi(x, si, ci) double x; double *si, *ci; { -double k, z, c, s, a; -short sign; - -if( x < 0.0 ) - { - sign = -1; - x = -x; - } -else - sign = 0; - - -if( x == 0.0 ) - { - *si = 0.0; - *ci = -MAXNUM; - return( 0 ); - } - -if( x >= 8.0 ) - goto chb; - -z = x * x; - -/* Direct power series expansion */ - -a = 1.0; -s = 1.0; -c = 0.0; -k = 2.0; - -do - { - a *= z/k; - c += a/k; - k += 1.0; - a /= k; - s += a/k; - k += 1.0; - } -while( fabs(a/s) > MACHEP ); - -s *= x; -goto done; - + double k, z, c, s, a; + short sign; + + if (x < 0.0) + { + sign = -1; + x = -x; + } + else + sign = 0; + + if (x == 0.0) + { + *si = 0.0; + *ci = -MAXNUM; + return (0); + } + + if (x >= 8.0) + goto chb; + + z = x * x; + + /* Direct power series expansion */ + + a = 1.0; + s = 1.0; + c = 0.0; + k = 2.0; + + do + { + a *= z / k; + c += a / k; + k += 1.0; + a /= k; + s += a / k; + k += 1.0; + } while (fabs(a / s) > MACHEP); + + s *= x; + goto done; chb: -if( x < 18.0 ) - { - a = (576.0/x - 52.0)/10.0; - k = exp(x) / x; - s = k * chbevl( a, S1, 22 ); - c = k * chbevl( a, C1, 23 ); - goto done; - } - -if( x <= 88.0 ) - { - a = (6336.0/x - 212.0)/70.0; - k = exp(x) / x; - s = k * chbevl( a, S2, 23 ); - c = k * chbevl( a, C2, 24 ); - goto done; - } -else - { - if( sign ) - *si = -MAXNUM; - else - *si = MAXNUM; - *ci = MAXNUM; - return(0); - } + if (x < 18.0) + { + a = (576.0 / x - 52.0) / 10.0; + k = exp(x) / x; + s = k * chbevl(a, S1, 22); + c = k * chbevl(a, C1, 23); + goto done; + } + + if (x <= 88.0) + { + a = (6336.0 / x - 212.0) / 70.0; + k = exp(x) / x; + s = k * chbevl(a, S2, 23); + c = k * chbevl(a, C2, 24); + goto done; + } + else + { + if (sign) + *si = -MAXNUM; + else + *si = MAXNUM; + *ci = MAXNUM; + return (0); + } done: -if( sign ) - s = -s; + if (sign) + s = -s; -*si = s; + *si = s; -*ci = EUL + log(x) + c; -return(0); + *ci = EUL + log(x) + c; + return (0); } diff --git a/cephes/misc/sici.c b/cephes/misc/sici.c index 6914e2b..d4a71ce 100644 --- a/cephes/misc/sici.c +++ b/cephes/misc/sici.c @@ -48,7 +48,7 @@ * DEC Si 5000 4.4e-17 9.0e-18 * DEC Ci 5300 7.9e-17 5.2e-18 */ - + /* Cephes Math Library Release 2.1: January, 1989 Copyright 1984, 1987, 1989 by Stephen L. Moshier @@ -57,6 +57,7 @@ Direct inquiries to 30 Frost Street, Cambridge, MA 02140 #include "mconf.h" +/* clang-format off */ #ifdef UNK static double SN[] = { -8.39167827910303881427E-11, @@ -574,102 +575,95 @@ static unsigned short GD8[] = { 0x3cec,0x4945,0x8c03,0x63a9, }; #endif +/* clang-format on */ #ifdef ANSIPROT -extern double log ( double ); -extern double sin ( double ); -extern double cos ( double ); -extern double polevl ( double, void *, int ); -extern double p1evl ( double, void *, int ); +extern double log(double); +extern double sin(double); +extern double cos(double); +extern double polevl(double, void *, int); +extern double p1evl(double, void *, int); #else double log(), sin(), cos(), polevl(), p1evl(); #endif #define EUL 0.57721566490153286061 extern double MAXNUM, PIO2, MACHEP; - -int sici( x, si, ci ) +int sici(x, si, ci) double x; double *si, *ci; { -double z, c, s, f, g; -short sign; - -if( x < 0.0 ) - { - sign = -1; - x = -x; - } -else - sign = 0; - - -if( x == 0.0 ) - { - *si = 0.0; - *ci = -MAXNUM; - return( 0 ); - } - - -if( x > 1.0e9 ) - { - *si = PIO2 - cos(x)/x; - *ci = sin(x)/x; - return( 0 ); - } + double z, c, s, f, g; + short sign; + if (x < 0.0) + { + sign = -1; + x = -x; + } + else + sign = 0; + if (x == 0.0) + { + *si = 0.0; + *ci = -MAXNUM; + return (0); + } -if( x > 4.0 ) - goto asympt; + if (x > 1.0e9) + { + *si = PIO2 - cos(x) / x; + *ci = sin(x) / x; + return (0); + } -z = x * x; -s = x * polevl( z, SN, 5 ) / polevl( z, SD, 5 ); -c = z * polevl( z, CN, 5 ) / polevl( z, CD, 5 ); + if (x > 4.0) + goto asympt; -if( sign ) - s = -s; -*si = s; -*ci = EUL + log(x) + c; /* real part if x < 0 */ -return(0); + z = x * x; + s = x * polevl(z, SN, 5) / polevl(z, SD, 5); + c = z * polevl(z, CN, 5) / polevl(z, CD, 5); + if (sign) + s = -s; + *si = s; + *ci = EUL + log(x) + c; /* real part if x < 0 */ + return (0); - -/* The auxiliary functions are: - * - * - * *si = *si - PIO2; - * c = cos(x); - * s = sin(x); - * - * t = *ci * s - *si * c; - * a = *ci * c + *si * s; - * - * *si = t; - * *ci = -a; - */ - + /* The auxiliary functions are: + * + * + * *si = *si - PIO2; + * c = cos(x); + * s = sin(x); + * + * t = *ci * s - *si * c; + * a = *ci * c + *si * s; + * + * *si = t; + * *ci = -a; + */ asympt: -s = sin(x); -c = cos(x); -z = 1.0/(x*x); -if( x < 8.0 ) - { - f = polevl( z, FN4, 6 ) / (x * p1evl( z, FD4, 7 )); - g = z * polevl( z, GN4, 7 ) / p1evl( z, GD4, 7 ); - } -else - { - f = polevl( z, FN8, 8 ) / (x * p1evl( z, FD8, 8 )); - g = z * polevl( z, GN8, 8 ) / p1evl( z, GD8, 9 ); - } -*si = PIO2 - f * c - g * s; -if( sign ) - *si = -( *si ); -*ci = f * s - g * c; + s = sin(x); + c = cos(x); + z = 1.0 / (x * x); + if (x < 8.0) + { + f = polevl(z, FN4, 6) / (x * p1evl(z, FD4, 7)); + g = z * polevl(z, GN4, 7) / p1evl(z, GD4, 7); + } + else + { + f = polevl(z, FN8, 8) / (x * p1evl(z, FD8, 8)); + g = z * polevl(z, GN8, 8) / p1evl(z, GD8, 9); + } + *si = PIO2 - f * c - g * s; + if (sign) + *si = -(*si); + *ci = f * s - g * c; -return(0); + return (0); } diff --git a/cephes/misc/simpsn.c b/cephes/misc/simpsn.c index 4eb1946..5a54ac6 100644 --- a/cephes/misc/simpsn.c +++ b/cephes/misc/simpsn.c @@ -4,6 +4,7 @@ * at equally spaced arguments */ +/* clang-format off */ /* Coefficients for Cote integration formulas */ /* Note: these numbers were computed using 40-decimal precision. */ @@ -62,20 +63,20 @@ static double simcon[] = -9.0005367135242894657916E+1, }; */ - +/* clang-format on */ + /* simpsn.c 3 */ -double simpsn( f, delta ) -double f[]; /* tabulated function */ -double delta; /* spacing of arguments */ +double simpsn(f, delta) +double f[]; /* tabulated function */ +double delta; /* spacing of arguments */ { -extern double simcon[]; -double ans; -int i; - + extern double simcon[]; + double ans; + int i; -ans = simcon[NCOTE/2] * f[NCOTE/2]; -for( i=0; i < NCOTE/2; i++ ) - ans += simcon[i] * ( f[i] + f[NCOTE-i] ); + ans = simcon[NCOTE / 2] * f[NCOTE / 2]; + for (i = 0; i < NCOTE / 2; i++) + ans += simcon[i] * (f[i] + f[NCOTE - i]); -return( ans * delta * NCOTE ); + return (ans * delta * NCOTE); } diff --git a/cephes/misc/spence.c b/cephes/misc/spence.c index 7a6078f..dd8fc25 100644 --- a/cephes/misc/spence.c +++ b/cephes/misc/spence.c @@ -39,9 +39,8 @@ * * */ - -/* spence.c */ +/* spence.c */ /* Cephes Math Library Release 2.8: June, 2000 @@ -50,6 +49,7 @@ Copyright 1985, 1987, 1989, 2000 by Stephen L. Moshier #include "mconf.h" +/* clang-format off */ #ifdef UNK static double A[8] = { 4.65128586073990045278E-5, @@ -138,11 +138,12 @@ static unsigned short B[32] = { 0x3ff0,0x0000,0x0000,0x0000, }; #endif +/* clang-format on */ #ifdef ANSIPROT -extern double fabs ( double ); -extern double log ( double ); -extern double polevl ( double, void *, int ); +extern double fabs(double); +extern double log(double); +extern double polevl(double, void *, int); #else double fabs(), log(), polevl(); #endif @@ -151,55 +152,54 @@ extern double PI, MACHEP; double spence(x) double x; { -double w, y, z; -int flag; - -if( x < 0.0 ) - { - mtherr( "spence", DOMAIN ); - return(0.0); - } + double w, y, z; + int flag; -if( x == 1.0 ) - return( 0.0 ); + if (x < 0.0) + { + mtherr("spence", DOMAIN); + return (0.0); + } -if( x == 0.0 ) - return( PI*PI/6.0 ); + if (x == 1.0) + return (0.0); -flag = 0; + if (x == 0.0) + return (PI * PI / 6.0); -if( x > 2.0 ) - { - x = 1.0/x; - flag |= 2; - } + flag = 0; -if( x > 1.5 ) - { - w = (1.0/x) - 1.0; - flag |= 2; - } + if (x > 2.0) + { + x = 1.0 / x; + flag |= 2; + } -else if( x < 0.5 ) - { - w = -x; - flag |= 1; - } + if (x > 1.5) + { + w = (1.0 / x) - 1.0; + flag |= 2; + } -else - w = x - 1.0; + else if (x < 0.5) + { + w = -x; + flag |= 1; + } + else + w = x - 1.0; -y = -w * polevl( w, A, 7) / polevl( w, B, 7 ); + y = -w * polevl(w, A, 7) / polevl(w, B, 7); -if( flag & 1 ) - y = (PI * PI)/6.0 - log(x) * log(1.0-x) - y; + if (flag & 1) + y = (PI * PI) / 6.0 - log(x) * log(1.0 - x) - y; -if( flag & 2 ) - { - z = log(x); - y = -0.5 * z * z - y; - } + if (flag & 2) + { + z = log(x); + y = -0.5 * z * z - y; + } -return( y ); + return (y); } diff --git a/cephes/misc/zeta.c b/cephes/misc/zeta.c index 87886a3..d184790 100644 --- a/cephes/misc/zeta.c +++ b/cephes/misc/zeta.c @@ -18,7 +18,7 @@ * * inf. * - -x - * zeta(x,q) = > (k+q) + * zeta(x,q) = > (k+q) * - * k=0 * @@ -26,11 +26,11 @@ * The Euler-Maclaurin summation formula is used to obtain * the expansion * - * n + * n * - -x - * zeta(x,q) = > (k+q) - * - - * k=1 + * zeta(x,q) = > (k+q) + * - + * k=1 * * 1-x inf. B x(x+1)...(x+2j) * (n+q) 1 - 2j @@ -53,7 +53,7 @@ * Series, and Products, p. 1073; Academic Press, 1980. * */ - + /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 2000 by Stephen L. Moshier @@ -61,9 +61,9 @@ Copyright 1984, 1987, 2000 by Stephen L. Moshier #include "mconf.h" #ifdef ANSIPROT -extern double fabs ( double ); -extern double pow ( double, double ); -extern double floor ( double ); +extern double fabs(double); +extern double pow(double, double); +extern double floor(double); #else double fabs(), pow(), floor(); #endif @@ -75,115 +75,112 @@ extern double MAXNUM, MACHEP; * where B2k are Bernoulli numbers */ static double A[] = { -12.0, --720.0, -30240.0, --1209600.0, -47900160.0, --1.8924375803183791606e9, /*1.307674368e12/691*/ -7.47242496e10, --2.950130727918164224e12, /*1.067062284288e16/3617*/ -1.1646782814350067249e14, /*5.109094217170944e18/43867*/ --4.5979787224074726105e15, /*8.028576626982912e20/174611*/ -1.8152105401943546773e17, /*1.5511210043330985984e23/854513*/ --7.1661652561756670113e18 /*1.6938241367317436694528e27/236364091*/ + 12.0, + -720.0, + 30240.0, + -1209600.0, + 47900160.0, + -1.8924375803183791606e9, /*1.307674368e12/691*/ + 7.47242496e10, + -2.950130727918164224e12, /*1.067062284288e16/3617*/ + 1.1646782814350067249e14, /*5.109094217170944e18/43867*/ + -4.5979787224074726105e15, /*8.028576626982912e20/174611*/ + 1.8152105401943546773e17, /*1.5511210043330985984e23/854513*/ + -7.1661652561756670113e18 /*1.6938241367317436694528e27/236364091*/ }; /* 30 Nov 86 -- error in third coefficient fixed */ - -double zeta(x,q) -double x,q; +double zeta(x, q) +double x, q; { -int i; -double a, b, k, s, t, w; + int i; + double a, b, k, s, t, w; -if( x == 1.0 ) - goto retinf; + if (x == 1.0) + goto retinf; -if( x < 1.0 ) - { -domerr: - mtherr( "zeta", DOMAIN ); - return(0.0); - } + if (x < 1.0) + { + domerr: + mtherr("zeta", DOMAIN); + return (0.0); + } -if( q <= 0.0 ) - { - if(q == floor(q)) - { - mtherr( "zeta", SING ); -retinf: - return( MAXNUM ); - } - if( x != floor(x) ) - goto domerr; /* because q^-x not defined */ - } + if (q <= 0.0) + { + if (q == floor(q)) + { + mtherr("zeta", SING); + retinf: + return (MAXNUM); + } + if (x != floor(x)) + goto domerr; /* because q^-x not defined */ + } -/* Euler-Maclaurin summation formula */ -/* -if( x < 25.0 ) -*/ -{ -/* Permit negative q but continue sum until n+q > +9 . - * This case should be handled by a reflection formula. - * If q<0 and x is an integer, there is a relation to - * the polygamma function. - */ -s = pow( q, -x ); -a = q; -i = 0; -b = 0.0; -while( (i < 9) || (a <= 9.0) ) - { - i += 1; - a += 1.0; - b = pow( a, -x ); - s += b; - if( fabs(b/s) < MACHEP ) - goto done; - } - -w = a; -s += b*w/(x-1.0); -s -= 0.5 * b; -a = 1.0; -k = 0.0; -for( i=0; i<12; i++ ) - { - a *= x + k; - b /= w; - t = a*b/A[i]; - s = s + t; - t = fabs(t/s); - if( t < MACHEP ) - goto done; - k += 1.0; - a *= x + k; - b /= w; - k += 1.0; - } -done: -return(s); -} + /* Euler-Maclaurin summation formula */ + /* + if( x < 25.0 ) + */ + { + /* Permit negative q but continue sum until n+q > +9 . + * This case should be handled by a reflection formula. + * If q<0 and x is an integer, there is a relation to + * the polygamma function. + */ + s = pow(q, -x); + a = q; + i = 0; + b = 0.0; + while ((i < 9) || (a <= 9.0)) + { + i += 1; + a += 1.0; + b = pow(a, -x); + s += b; + if (fabs(b / s) < MACHEP) + goto done; + } + w = a; + s += b * w / (x - 1.0); + s -= 0.5 * b; + a = 1.0; + k = 0.0; + for (i = 0; i < 12; i++) + { + a *= x + k; + b /= w; + t = a * b / A[i]; + s = s + t; + t = fabs(t / s); + if (t < MACHEP) + goto done; + k += 1.0; + a *= x + k; + b /= w; + k += 1.0; + } + done: + return (s); + } + /* Basic sum of inverse powers */ + /* + pseres: -/* Basic sum of inverse powers */ -/* -pseres: + s = pow( q, -x ); + a = q; + do + { + a += 2.0; + b = pow( a, -x ); + s += b; + } + while( b/s > MACHEP ); -s = pow( q, -x ); -a = q; -do - { - a += 2.0; - b = pow( a, -x ); - s += b; - } -while( b/s > MACHEP ); - -b = pow( 2.0, -x ); -s = (s + b)/(1.0-b); -return(s); -*/ + b = pow( 2.0, -x ); + s = (s + b)/(1.0-b); + return(s); + */ } diff --git a/cephes/misc/zetac.c b/cephes/misc/zetac.c index 3da4ac7..be003d8 100644 --- a/cephes/misc/zetac.c +++ b/cephes/misc/zetac.c @@ -1,4 +1,4 @@ - /* zetac.c +/* zetac.c * * Riemann zeta function * @@ -43,7 +43,7 @@ * * */ - + /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier @@ -53,6 +53,7 @@ Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier extern double MAXNUM, PI; +/* clang-format off */ /* Riemann zeta(x) - 1 * for integer arguments between 0 and 30. */ @@ -487,6 +488,7 @@ static unsigned short S[20] = { 0x40f2,0x2916,0x581e,0xb9a3, }; #endif +/* clang-format on */ #define MAXL2 127 @@ -494,14 +496,14 @@ static unsigned short S[20] = { * Riemann zeta function, minus one */ #ifdef ANSIPROT -extern double sin ( double ); -extern double floor ( double ); -extern double gamma ( double ); -extern double pow ( double, double ); -extern double exp ( double ); -extern double polevl ( double, void *, int ); -extern double p1evl ( double, void *, int ); -double zetac ( double ); +extern double sin(double); +extern double floor(double); +extern double gamma(double); +extern double pow(double, double); +extern double exp(double); +extern double polevl(double, void *, int); +extern double p1evl(double, void *, int); +double zetac(double); #else double sin(), floor(), gamma(), pow(), exp(); double polevl(), p1evl(), zetac(); @@ -511,89 +513,85 @@ extern double MACHEP; double zetac(x) double x; { -int i; -double a, b, s, w; + int i; + double a, b, s, w; -if( x < 0.0 ) - { + if (x < 0.0) + { #ifdef DEC - if( x < -30.8148 ) + if (x < -30.8148) #else - if( x < -170.6243 ) + if (x < -170.6243) #endif - { - mtherr( "zetac", OVERFLOW ); - return(0.0); - } - s = 1.0 - x; - w = zetac( s ); - b = sin(0.5*PI*x) * pow(2.0*PI, x) * gamma(s) * (1.0 + w) / PI; - return(b - 1.0); - } + { + mtherr("zetac", OVERFLOW); + return (0.0); + } + s = 1.0 - x; + w = zetac(s); + b = sin(0.5 * PI * x) * pow(2.0 * PI, x) * gamma(s) * (1.0 + w) / PI; + return (b - 1.0); + } -if( x >= MAXL2 ) - return(0.0); /* because first term is 2**-x */ + if (x >= MAXL2) + return (0.0); /* because first term is 2**-x */ -/* Tabulated values for integer argument */ -w = floor(x); -if( w == x ) - { - i = x; - if( i < 31 ) - { + /* Tabulated values for integer argument */ + w = floor(x); + if (w == x) + { + i = x; + if (i < 31) + { #ifdef UNK - return( azetac[i] ); + return (azetac[i]); #else - return( *(double *)&azetac[4*i] ); + return (*(double *)&azetac[4 * i]); #endif - } - } - - -if( x < 1.0 ) - { - w = 1.0 - x; - a = polevl( x, R, 5 ) / ( w * p1evl( x, S, 5 )); - return( a ); - } - -if( x == 1.0 ) - { - mtherr( "zetac", SING ); - return( MAXNUM ); - } + } + } -if( x <= 10.0 ) - { - b = pow( 2.0, x ) * (x - 1.0); - w = 1.0/x; - s = (x * polevl( w, P, 8 )) / (b * p1evl( w, Q, 8 )); - return( s ); - } + if (x < 1.0) + { + w = 1.0 - x; + a = polevl(x, R, 5) / (w * p1evl(x, S, 5)); + return (a); + } -if( x <= 50.0 ) - { - b = pow( 2.0, -x ); - w = polevl( x, A, 10 ) / p1evl( x, B, 10 ); - w = exp(w) + b; - return(w); - } + if (x == 1.0) + { + mtherr("zetac", SING); + return (MAXNUM); + } + if (x <= 10.0) + { + b = pow(2.0, x) * (x - 1.0); + w = 1.0 / x; + s = (x * polevl(w, P, 8)) / (b * p1evl(w, Q, 8)); + return (s); + } -/* Basic sum of inverse powers */ + if (x <= 50.0) + { + b = pow(2.0, -x); + w = polevl(x, A, 10) / p1evl(x, B, 10); + w = exp(w) + b; + return (w); + } + /* Basic sum of inverse powers */ -s = 0.0; -a = 1.0; -do - { - a += 2.0; - b = pow( a, -x ); - s += b; - } -while( b/s > MACHEP ); + s = 0.0; + a = 1.0; + do + { + a += 2.0; + b = pow(a, -x); + s += b; + } while (b / s > MACHEP); -b = pow( 2.0, -x ); -s = (s + b)/(1.0-b); -return(s); + b = pow(2.0, -x); + s = (s + b) / (1.0 - b); + return (s); } diff --git a/cephes/polyn/euclid.c b/cephes/polyn/euclid.c index fc57e8d..08445d9 100644 --- a/cephes/polyn/euclid.c +++ b/cephes/polyn/euclid.c @@ -6,7 +6,7 @@ * * SYNOPSIS: * - * + * * typedef struct * { * double n; numerator @@ -24,228 +24,211 @@ * The double precision numbers are assumed, without checking, * to be integer valued. Overflow conditions are reported. */ - #include "mconf.h" #ifdef ANSIPROT -extern double fabs ( double ); -extern double floor ( double ); -double euclid( double *, double * ); +extern double fabs(double); +extern double floor(double); +double euclid(double *, double *); #else double fabs(), floor(), euclid(); #endif extern double MACHEP; -#define BIG (1.0/MACHEP) +#define BIG (1.0 / MACHEP) typedef struct - { - double n; /* numerator */ - double d; /* denominator */ - }fract; +{ + double n; /* numerator */ + double d; /* denominator */ +} fract; /* Add fractions. */ -void radd( f1, f2, f3 ) -fract *f1, *f2, *f3; +void radd(f1, f2, f3) fract *f1, *f2, *f3; { -double gcd, d1, d2, gcn, n1, n2; - -n1 = f1->n; -d1 = f1->d; -n2 = f2->n; -d2 = f2->d; -if( n1 == 0.0 ) - { - f3->n = n2; - f3->d = d2; - return; - } -if( n2 == 0.0 ) - { - f3->n = n1; - f3->d = d1; - return; - } - -gcd = euclid( &d1, &d2 ); /* common divisors of denominators */ -gcn = euclid( &n1, &n2 ); /* common divisors of numerators */ -/* Note, factoring the numerators - * makes overflow slightly less likely. - */ -f3->n = ( n1 * d2 + n2 * d1) * gcn; -f3->d = d1 * d2 * gcd; -euclid( &f3->n, &f3->d ); + double gcd, d1, d2, gcn, n1, n2; + + n1 = f1->n; + d1 = f1->d; + n2 = f2->n; + d2 = f2->d; + if (n1 == 0.0) + { + f3->n = n2; + f3->d = d2; + return; + } + if (n2 == 0.0) + { + f3->n = n1; + f3->d = d1; + return; + } + + gcd = euclid(&d1, &d2); /* common divisors of denominators */ + gcn = euclid(&n1, &n2); /* common divisors of numerators */ + /* Note, factoring the numerators + * makes overflow slightly less likely. + */ + f3->n = (n1 * d2 + n2 * d1) * gcn; + f3->d = d1 * d2 * gcd; + euclid(&f3->n, &f3->d); } - /* Subtract fractions. */ -void rsub( f1, f2, f3 ) -fract *f1, *f2, *f3; +void rsub(f1, f2, f3) fract *f1, *f2, *f3; { -double gcd, d1, d2, gcn, n1, n2; - -n1 = f1->n; -d1 = f1->d; -n2 = f2->n; -d2 = f2->d; -if( n1 == 0.0 ) - { - f3->n = n2; - f3->d = d2; - return; - } -if( n2 == 0.0 ) - { - f3->n = -n1; - f3->d = d1; - return; - } - -gcd = euclid( &d1, &d2 ); -gcn = euclid( &n1, &n2 ); -f3->n = (n2 * d1 - n1 * d2) * gcn; -f3->d = d1 * d2 * gcd; -euclid( &f3->n, &f3->d ); + double gcd, d1, d2, gcn, n1, n2; + + n1 = f1->n; + d1 = f1->d; + n2 = f2->n; + d2 = f2->d; + if (n1 == 0.0) + { + f3->n = n2; + f3->d = d2; + return; + } + if (n2 == 0.0) + { + f3->n = -n1; + f3->d = d1; + return; + } + + gcd = euclid(&d1, &d2); + gcn = euclid(&n1, &n2); + f3->n = (n2 * d1 - n1 * d2) * gcn; + f3->d = d1 * d2 * gcd; + euclid(&f3->n, &f3->d); } - - - /* Multiply fractions. */ -void rmul( ff1, ff2, ff3 ) -fract *ff1, *ff2, *ff3; +void rmul(ff1, ff2, ff3) fract *ff1, *ff2, *ff3; { -double d1, d2, n1, n2; - -n1 = ff1->n; -d1 = ff1->d; -n2 = ff2->n; -d2 = ff2->d; - -if( (n1 == 0.0) || (n2 == 0.0) ) - { - ff3->n = 0.0; - ff3->d = 1.0; - return; - } -euclid( &n1, &d2 ); /* cross cancel common divisors */ -euclid( &n2, &d1 ); -ff3->n = n1 * n2; -ff3->d = d1 * d2; -/* Report overflow. */ -if( (fabs(ff3->n) >= BIG) || (fabs(ff3->d) >= BIG) ) - { - mtherr( "rmul", OVERFLOW ); - return; - } -/* euclid( &ff3->n, &ff3->d );*/ + double d1, d2, n1, n2; + + n1 = ff1->n; + d1 = ff1->d; + n2 = ff2->n; + d2 = ff2->d; + + if ((n1 == 0.0) || (n2 == 0.0)) + { + ff3->n = 0.0; + ff3->d = 1.0; + return; + } + euclid(&n1, &d2); /* cross cancel common divisors */ + euclid(&n2, &d1); + ff3->n = n1 * n2; + ff3->d = d1 * d2; + /* Report overflow. */ + if ((fabs(ff3->n) >= BIG) || (fabs(ff3->d) >= BIG)) + { + mtherr("rmul", OVERFLOW); + return; + } + /* euclid( &ff3->n, &ff3->d );*/ } - - /* Divide fractions. */ -void rdiv( ff1, ff2, ff3 ) -fract *ff1, *ff2, *ff3; +void rdiv(ff1, ff2, ff3) fract *ff1, *ff2, *ff3; { -double d1, d2, n1, n2; - -n1 = ff1->d; /* Invert ff1, then multiply */ -d1 = ff1->n; -if( d1 < 0.0 ) - { /* keep denominator positive */ - n1 = -n1; - d1 = -d1; - } -n2 = ff2->n; -d2 = ff2->d; -if( (n1 == 0.0) || (n2 == 0.0) ) - { - ff3->n = 0.0; - ff3->d = 1.0; - return; - } - -euclid( &n1, &d2 ); /* cross cancel any common divisors */ -euclid( &n2, &d1 ); -ff3->n = n1 * n2; -ff3->d = d1 * d2; -/* Report overflow. */ -if( (fabs(ff3->n) >= BIG) || (fabs(ff3->d) >= BIG) ) - { - mtherr( "rdiv", OVERFLOW ); - return; - } -/* euclid( &ff3->n, &ff3->d );*/ + double d1, d2, n1, n2; + + n1 = ff1->d; /* Invert ff1, then multiply */ + d1 = ff1->n; + if (d1 < 0.0) + { /* keep denominator positive */ + n1 = -n1; + d1 = -d1; + } + n2 = ff2->n; + d2 = ff2->d; + if ((n1 == 0.0) || (n2 == 0.0)) + { + ff3->n = 0.0; + ff3->d = 1.0; + return; + } + + euclid(&n1, &d2); /* cross cancel any common divisors */ + euclid(&n2, &d1); + ff3->n = n1 * n2; + ff3->d = d1 * d2; + /* Report overflow. */ + if ((fabs(ff3->n) >= BIG) || (fabs(ff3->d) >= BIG)) + { + mtherr("rdiv", OVERFLOW); + return; + } + /* euclid( &ff3->n, &ff3->d );*/ } - - - - /* Euclidean algorithm * reduces fraction to lowest terms, * returns greatest common divisor. */ - -double euclid( num, den ) +double euclid(num, den) double *num, *den; { -double n, d, q, r; - -n = *num; /* Numerator. */ -d = *den; /* Denominator. */ - -/* Make numbers positive, locally. */ -if( n < 0.0 ) - n = -n; -if( d < 0.0 ) - d = -d; - -/* Abort if numbers are too big for integer arithmetic. */ -if( (n >= BIG) || (d >= BIG) ) - { - mtherr( "euclid", OVERFLOW ); - return(1.0); - } - -/* Divide by zero, gcd = 1. */ -if(d == 0.0) - return( 1.0 ); - -/* Zero. Return 0/1, gcd = denominator. */ -if(n == 0.0) - { -/* - if( *den < 0.0 ) - *den = -1.0; - else - *den = 1.0; -*/ - *den = 1.0; - return( d ); - } - -while( d > 0.5 ) - { -/* Find integer part of n divided by d. */ - q = floor( n/d ); -/* Find remainder after dividing n by d. */ - r = n - d * q; -/* The next fraction is d/r. */ - n = d; - d = r; - } - -if( n < 0.0 ) - mtherr( "euclid", UNDERFLOW ); - -*num /= n; -*den /= n; -return( n ); + double n, d, q, r; + + n = *num; /* Numerator. */ + d = *den; /* Denominator. */ + + /* Make numbers positive, locally. */ + if (n < 0.0) + n = -n; + if (d < 0.0) + d = -d; + + /* Abort if numbers are too big for integer arithmetic. */ + if ((n >= BIG) || (d >= BIG)) + { + mtherr("euclid", OVERFLOW); + return (1.0); + } + + /* Divide by zero, gcd = 1. */ + if (d == 0.0) + return (1.0); + + /* Zero. Return 0/1, gcd = denominator. */ + if (n == 0.0) + { + /* + if( *den < 0.0 ) + *den = -1.0; + else + *den = 1.0; + */ + *den = 1.0; + return (d); + } + + while (d > 0.5) + { + /* Find integer part of n divided by d. */ + q = floor(n / d); + /* Find remainder after dividing n by d. */ + r = n - d * q; + /* The next fraction is d/r. */ + n = d; + d = r; + } + + if (n < 0.0) + mtherr("euclid", UNDERFLOW); + + *num /= n; + *den /= n; + return (n); } - diff --git a/cephes/polyn/polmisc.c b/cephes/polyn/polmisc.c index 2e6b99d..5bafc8e 100644 --- a/cephes/polyn/polmisc.c +++ b/cephes/polyn/polmisc.c @@ -34,6 +34,7 @@ void free (); /* Highest degree actually initialized at runtime. */ extern int MAXPOL; +/* clang-format off */ /* Taylor series coefficients for various functions */ double patan[N+1] = { @@ -44,7 +45,8 @@ double patan[N+1] = { double psin[N+1] = { 0.0, 1.0, 0.0, -1.0/6.0, 0.0, 1.0/120.0, 0.0, -1.0/5040.0, 0.0, 1.0/362880.0, 0.0, -1.0/39916800.0, - 0.0, 1.0/6227020800.0, 0.0, -1.0/1.307674368e12, 0.0}; + 0.0, 1.0/6227020800.0, 0.0, -1.0/1.307674368e12, 0.0 + }; double pcos[N+1] = { 1.0, 0.0, -1.0/2.0, 0.0, 1.0/24.0, 0.0, @@ -63,6 +65,7 @@ double psqrt[N+1] = { -429./32768., 715./65536., -2431./262144., 4199./524288., -29393./4194304., 52003./8388608., -185725./33554432., 334305./67108864., -9694845./2147483648.}; +/* clang-format on */ /* Arctangent of the ratio num/den of two polynomials. */ diff --git a/cephes/polyn/polrt.c b/cephes/polyn/polrt.c index fdf20d5..be4e2d3 100644 --- a/cephes/polyn/polrt.c +++ b/cephes/polyn/polrt.c @@ -40,7 +40,7 @@ * found. * */ - + /* polrt */ /* Complex roots of real polynomial */ /* number of coefficients is m + 1 ( i.e., m is degree of polynomial) */ @@ -48,180 +48,180 @@ #include "mconf.h" /* typedef struct - { - double r; - double i; - }cmplx; + { + double r; + double i; + }cmplx; */ #ifdef ANSIPROT -extern double fabs ( double ); +extern double fabs(double); #else double fabs(); #endif -int polrt( xcof, cof, m, root ) +int polrt(xcof, cof, m, root) double xcof[], cof[]; int m; cmplx root[]; { -register double *p, *q; -int i, j, nsav, n, n1, n2, nroot, iter, retry; -int final; -double mag, cofj; -cmplx x0, x, xsav, dx, t, t1, u, ud; - -final = 0; -n = m; -if( n <= 0 ) - return(1); -if( n > 36 ) - return(2); -if( xcof[m] == 0.0 ) - return(4); - -n1 = n; -n2 = n; -nroot = 0; -nsav = n; -q = &xcof[0]; -p = &cof[n]; -for( j=0; j<=nsav; j++ ) - *p-- = *q++; /* cof[ n-j ] = xcof[j];*/ -xsav.r = 0.0; -xsav.i = 0.0; + register double *p, *q; + int i, j, nsav, n, n1, n2, nroot, iter, retry; + int final; + double mag, cofj; + cmplx x0, x, xsav, dx, t, t1, u, ud; + + final = 0; + n = m; + if (n <= 0) + return (1); + if (n > 36) + return (2); + if (xcof[m] == 0.0) + return (4); + + n1 = n; + n2 = n; + nroot = 0; + nsav = n; + q = &xcof[0]; + p = &cof[n]; + for (j = 0; j <= nsav; j++) + *p-- = *q++; /* cof[ n-j ] = xcof[j];*/ + xsav.r = 0.0; + xsav.i = 0.0; nxtrut: -x0.r = 0.00500101; -x0.i = 0.01000101; -retry = 0; + x0.r = 0.00500101; + x0.i = 0.01000101; + retry = 0; tryagn: -retry += 1; -x.r = x0.r; + retry += 1; + x.r = x0.r; -x0.r = -10.0 * x0.i; -x0.i = -10.0 * x.r; + x0.r = -10.0 * x0.i; + x0.i = -10.0 * x.r; -x.r = x0.r; -x.i = x0.i; + x.r = x0.r; + x.i = x0.i; finitr: -iter = 0; - -while( iter < 500 ) -{ -u.r = cof[n]; -if( u.r == 0.0 ) - { /* this root is zero */ - x.r = 0; - n1 -= 1; - n2 -= 1; - goto zerrut; - } -u.i = 0; -ud.r = 0; -ud.i = 0; -t.r = 1.0; -t.i = 0; -p = &cof[n-1]; -for( i=0; i= 1.0e-5 ) - { - cofj = x.r + x.r; - mag = x.r * x.r + x.i * x.i; - n -= 2; - } -else - { /* root is real */ -zerrut: - x.i = 0; - cofj = x.r; - mag = 0; - n -= 1; - } -/* divide working polynomial cof(z) by z - x */ -p = &cof[1]; -*p += cofj * *(p-1); -for( j=1; j= 1.0e-5) + { + cofj = x.r + x.r; + mag = x.r * x.r + x.i * x.i; + n -= 2; + } + else + { /* root is real */ + zerrut: + x.i = 0; + cofj = x.r; + mag = 0; + n -= 1; + } + /* divide working polynomial cof(z) by z - x */ + p = &cof[1]; + *p += cofj * *(p - 1); + for (j = 1; j < n; j++) + { + *(p + 1) += cofj * *p - mag * *(p - 1); + p++; + } setrut: -root[nroot].r = x.r; -root[nroot].i = x.i; -nroot += 1; -if( mag != 0.0 ) - { - x.i = -x.i; - mag = 0; - goto setrut; /* fill in the complex conjugate root */ - } -if( n > 0 ) - goto nxtrut; -return(0); + root[nroot].r = x.r; + root[nroot].i = x.i; + nroot += 1; + if (mag != 0.0) + { + x.i = -x.i; + mag = 0; + goto setrut; /* fill in the complex conjugate root */ + } + if (n > 0) + goto nxtrut; + return (0); } diff --git a/cephes/polyn/polyn.c b/cephes/polyn/polyn.c index 1dd2684..9644739 100644 --- a/cephes/polyn/polyn.c +++ b/cephes/polyn/polyn.c @@ -59,20 +59,20 @@ * */ -#include #include "mconf.h" +#include #if ANSIPROT -void exit (int); -extern void * malloc ( long ); -extern void free ( void * ); -void polclr ( double *, int ); -void polmov ( double *, int, double * ); -void polmul ( double *, int, double *, int, double * ); -int poldiv ( double *, int, double *, int, double * ); +void exit(int); +extern void *malloc(long); +extern void free(void *); +void polclr(double *, int); +void polmov(double *, int, double *); +void polmul(double *, int, double *, int, double *); +int poldiv(double *, int, double *, int, double *); #else void exit(); -void * malloc(); -void free (); +void *malloc(); +void free(); void polclr(), polmov(), poldiv(), polmul(); #endif #ifndef NULL @@ -99,373 +99,342 @@ extern int MAXPOL; /* Number of bytes (chars) in maximum size polynomial. */ static int psize = 0; - /* Initialize max degree of polynomials * and allocate temporary storage. */ -void polini( maxdeg ) -int maxdeg; +void polini(maxdeg) int maxdeg; { -MAXPOL = maxdeg; -psize = (maxdeg + 1) * sizeof(double); - -/* Release previously allocated memory, if any. */ -if( pt3 ) - free(pt3); -if( pt2 ) - free(pt2); -if( pt1 ) - free(pt1); - -/* Allocate new arrays */ -pt1 = (double * )malloc(psize); /* used by polsbt */ -pt2 = (double * )malloc(psize); /* used by polsbt */ -pt3 = (double * )malloc(psize); /* used by polmul */ - -/* Report if failure */ -if( (pt1 == NULL) || (pt2 == NULL) || (pt3 == NULL) ) - { - mtherr( "polini", ERANGE ); - exit(1); - } + MAXPOL = maxdeg; + psize = (maxdeg + 1) * sizeof(double); + + /* Release previously allocated memory, if any. */ + if (pt3) + free(pt3); + if (pt2) + free(pt2); + if (pt1) + free(pt1); + + /* Allocate new arrays */ + pt1 = (double *)malloc(psize); /* used by polsbt */ + pt2 = (double *)malloc(psize); /* used by polsbt */ + pt3 = (double *)malloc(psize); /* used by polmul */ + + /* Report if failure */ + if ((pt1 == NULL) || (pt2 == NULL) || (pt3 == NULL)) + { + mtherr("polini", ERANGE); + exit(1); + } } - - /* Print the coefficients of a, with d decimal precision. */ static char form[] = "abcdefghijk"; -void polprt( a, na, d ) -double a[]; +void polprt(a, na, d) double a[]; int na, d; { -int i, j, d1; -char *p; - -/* Create format descriptor string for the printout. - * Do this partly by hand, since sprintf() may be too - * bug-ridden to accomplish this feat by itself. - */ -p = form; -*p++ = '%'; -d1 = d + 8; -sprintf( p, "%d ", d1 ); -p += 1; -if( d1 >= 10 ) - p += 1; -*p++ = '.'; -sprintf( p, "%d ", d ); -p += 1; -if( d >= 10 ) - p += 1; -*p++ = 'e'; -*p++ = ' '; -*p++ = '\0'; - - -/* Now do the printing. - */ -d1 += 1; -j = 0; -for( i=0; i<=na; i++ ) - { -/* Detect end of available line */ - j += d1; - if( j >= 78 ) - { - printf( "\n" ); - j = d1; - } - printf( form, a[i] ); - } -printf( "\n" ); + int i, j, d1; + char *p; + + /* Create format descriptor string for the printout. + * Do this partly by hand, since sprintf() may be too + * bug-ridden to accomplish this feat by itself. + */ + p = form; + *p++ = '%'; + d1 = d + 8; + sprintf(p, "%d ", d1); + p += 1; + if (d1 >= 10) + p += 1; + *p++ = '.'; + sprintf(p, "%d ", d); + p += 1; + if (d >= 10) + p += 1; + *p++ = 'e'; + *p++ = ' '; + *p++ = '\0'; + + /* Now do the printing. + */ + d1 += 1; + j = 0; + for (i = 0; i <= na; i++) + { + /* Detect end of available line */ + j += d1; + if (j >= 78) + { + printf("\n"); + j = d1; + } + printf(form, a[i]); + } + printf("\n"); } - - /* Set a = 0. */ -void polclr( a, n ) -register double *a; +void polclr(a, n) register double *a; int n; { -int i; + int i; -if( n > MAXPOL ) - n = MAXPOL; -for( i=0; i<=n; i++ ) - *a++ = 0.0; + if (n > MAXPOL) + n = MAXPOL; + for (i = 0; i <= n; i++) + *a++ = 0.0; } - - /* Set b = a. */ -void polmov( a, na, b ) -register double *a, *b; +void polmov(a, na, b) register double *a, *b; int na; { -int i; + int i; -if( na > MAXPOL ) - na = MAXPOL; + if (na > MAXPOL) + na = MAXPOL; -for( i=0; i<= na; i++ ) - { - *b++ = *a++; - } + for (i = 0; i <= na; i++) + { + *b++ = *a++; + } } - /* c = b * a. */ -void polmul( a, na, b, nb, c ) -double a[], b[], c[]; +void polmul(a, na, b, nb, c) double a[], b[], c[]; int na, nb; { -int i, j, k, nc; -double x; - -nc = na + nb; -polclr( pt3, MAXPOL ); - -for( i=0; i<=na; i++ ) - { - x = a[i]; - for( j=0; j<=nb; j++ ) - { - k = i + j; - if( k > MAXPOL ) - break; - pt3[k] += x * b[j]; - } - } - -if( nc > MAXPOL ) - nc = MAXPOL; -for( i=0; i<=nc; i++ ) - c[i] = pt3[i]; + int i, j, k, nc; + double x; + + nc = na + nb; + polclr(pt3, MAXPOL); + + for (i = 0; i <= na; i++) + { + x = a[i]; + for (j = 0; j <= nb; j++) + { + k = i + j; + if (k > MAXPOL) + break; + pt3[k] += x * b[j]; + } + } + + if (nc > MAXPOL) + nc = MAXPOL; + for (i = 0; i <= nc; i++) + c[i] = pt3[i]; } - - - /* c = b + a. */ -void poladd( a, na, b, nb, c ) -double a[], b[], c[]; +void poladd(a, na, b, nb, c) double a[], b[], c[]; int na, nb; { -int i, n; - - -if( na > nb ) - n = na; -else - n = nb; - -if( n > MAXPOL ) - n = MAXPOL; - -for( i=0; i<=n; i++ ) - { - if( i > na ) - c[i] = b[i]; - else if( i > nb ) - c[i] = a[i]; - else - c[i] = b[i] + a[i]; - } + int i, n; + + if (na > nb) + n = na; + else + n = nb; + + if (n > MAXPOL) + n = MAXPOL; + + for (i = 0; i <= n; i++) + { + if (i > na) + c[i] = b[i]; + else if (i > nb) + c[i] = a[i]; + else + c[i] = b[i] + a[i]; + } } /* c = b - a. */ -void polsub( a, na, b, nb, c ) -double a[], b[], c[]; +void polsub(a, na, b, nb, c) double a[], b[], c[]; int na, nb; { -int i, n; - - -if( na > nb ) - n = na; -else - n = nb; - -if( n > MAXPOL ) - n = MAXPOL; - -for( i=0; i<=n; i++ ) - { - if( i > na ) - c[i] = b[i]; - else if( i > nb ) - c[i] = -a[i]; - else - c[i] = b[i] - a[i]; - } + int i, n; + + if (na > nb) + n = na; + else + n = nb; + + if (n > MAXPOL) + n = MAXPOL; + + for (i = 0; i <= n; i++) + { + if (i > na) + c[i] = b[i]; + else if (i > nb) + c[i] = -a[i]; + else + c[i] = b[i] - a[i]; + } } - - /* c = b/a */ -int poldiv( a, na, b, nb, c ) +int poldiv(a, na, b, nb, c) double a[], b[], c[]; int na, nb; { -double quot; -double *ta, *tb, *tq; -int i, j, k, sing; - -sing = 0; - -/* Allocate temporary arrays. This would be quicker - * if done automatically on the stack, but stack space - * may be hard to obtain on a small computer. - */ -ta = (double * )malloc( psize ); -polclr( ta, MAXPOL ); -polmov( a, na, ta ); - -tb = (double * )malloc( psize ); -polclr( tb, MAXPOL ); -polmov( b, nb, tb ); - -tq = (double * )malloc( psize ); -polclr( tq, MAXPOL ); - -/* What to do if leading (constant) coefficient - * of denominator is zero. - */ -if( a[0] == 0.0 ) - { - for( i=0; i<=na; i++ ) - { - if( ta[i] != 0.0 ) - goto nzero; - } - mtherr( "poldiv", SING ); - goto done; - -nzero: -/* Reduce the degree of the denominator. */ - for( i=0; i MAXPOL ) - break; - tb[k] -= quot * ta[j]; - } - tq[i] = quot; - } -/* Send quotient to output array. */ -polmov( tq, MAXPOL, c ); + double quot; + double *ta, *tb, *tq; + int i, j, k, sing; + + sing = 0; + + /* Allocate temporary arrays. This would be quicker + * if done automatically on the stack, but stack space + * may be hard to obtain on a small computer. + */ + ta = (double *)malloc(psize); + polclr(ta, MAXPOL); + polmov(a, na, ta); + + tb = (double *)malloc(psize); + polclr(tb, MAXPOL); + polmov(b, nb, tb); + + tq = (double *)malloc(psize); + polclr(tq, MAXPOL); + + /* What to do if leading (constant) coefficient + * of denominator is zero. + */ + if (a[0] == 0.0) + { + for (i = 0; i <= na; i++) + { + if (ta[i] != 0.0) + goto nzero; + } + mtherr("poldiv", SING); + goto done; + + nzero: + /* Reduce the degree of the denominator. */ + for (i = 0; i < na; i++) + ta[i] = ta[i + 1]; + ta[na] = 0.0; + + if (b[0] != 0.0) + { + /* Optional message: + printf( "poldiv singularity, divide quotient by x\n" ); + */ + sing += 1; + } + else + { + /* Reduce degree of numerator. */ + for (i = 0; i < nb; i++) + tb[i] = tb[i + 1]; + tb[nb] = 0.0; + } + /* Call self, using reduced polynomials. */ + sing += poldiv(ta, na, tb, nb, c); + goto done; + } + + /* Long division algorithm. ta[0] is nonzero. + */ + for (i = 0; i <= MAXPOL; i++) + { + quot = tb[i] / ta[0]; + for (j = 0; j <= MAXPOL; j++) + { + k = j + i; + if (k > MAXPOL) + break; + tb[k] -= quot * ta[j]; + } + tq[i] = quot; + } + /* Send quotient to output array. */ + polmov(tq, MAXPOL, c); done: -/* Restore allocated memory. */ -free(tq); -free(tb); -free(ta); -return( sing ); + /* Restore allocated memory. */ + free(tq); + free(tb); + free(ta); + return (sing); } - - - /* Change of variables * Substitute a(y) for the variable x in b(x). * x = a(y) * c(x) = b(x) = b(a(y)). */ -void polsbt( a, na, b, nb, c ) -double a[], b[], c[]; +void polsbt(a, na, b, nb, c) double a[], b[], c[]; int na, nb; { -int i, j, k, n2; -double x; - -/* 0th degree term: - */ -polclr( pt1, MAXPOL ); -pt1[0] = b[0]; - -polclr( pt2, MAXPOL ); -pt2[0] = 1.0; -n2 = 0; - -for( i=1; i<=nb; i++ ) - { -/* Form ith power of a. */ - polmul( a, na, pt2, n2, pt2 ); - n2 += na; - x = b[i]; -/* Add the ith coefficient of b times the ith power of a. */ - for( j=0; j<=n2; j++ ) - { - if( j > MAXPOL ) - break; - pt1[j] += x * pt2[j]; - } - } - -k = n2 + nb; -if( k > MAXPOL ) - k = MAXPOL; -for( i=0; i<=k; i++ ) - c[i] = pt1[i]; + int i, j, k, n2; + double x; + + /* 0th degree term: + */ + polclr(pt1, MAXPOL); + pt1[0] = b[0]; + + polclr(pt2, MAXPOL); + pt2[0] = 1.0; + n2 = 0; + + for (i = 1; i <= nb; i++) + { + /* Form ith power of a. */ + polmul(a, na, pt2, n2, pt2); + n2 += na; + x = b[i]; + /* Add the ith coefficient of b times the ith power of a. */ + for (j = 0; j <= n2; j++) + { + if (j > MAXPOL) + break; + pt1[j] += x * pt2[j]; + } + } + + k = n2 + nb; + if (k > MAXPOL) + k = MAXPOL; + for (i = 0; i <= k; i++) + c[i] = pt1[i]; } - - - /* Evaluate polynomial a(t) at t = x. */ -double poleva( a, na, x ) +double poleva(a, na, x) double a[]; int na; double x; { -double s; -int i; - -s = a[na]; -for( i=na-1; i>=0; i-- ) - { - s = s * x + a[i]; - } -return(s); + double s; + int i; + + s = a[na]; + for (i = na - 1; i >= 0; i--) + { + s = s * x + a[i]; + } + return (s); } - diff --git a/cephes/polyn/polyr.c b/cephes/polyn/polyr.c index 1f1cf98..11df9a0 100644 --- a/cephes/polyn/polyr.c +++ b/cephes/polyn/polyr.c @@ -59,32 +59,33 @@ * */ -#include #include "mconf.h" +#include #ifndef NULL #define NULL 0 #endif -typedef struct{ - double n; - double d; - }fract; +typedef struct +{ + double n; + double d; +} fract; #ifdef ANSIPROT -extern void radd ( fract *, fract *, fract * ); -extern void rsub ( fract *, fract *, fract * ); -extern void rmul ( fract *, fract *, fract * ); -extern void rdiv ( fract *, fract *, fract * ); -void polmov ( fract *, int, fract * ); -void polmul ( fract *, int, fract *, int, fract * ); -int poldiv ( fract *, int, fract *, int, fract * ); -void * malloc ( long ); -void free ( void * ); +extern void radd(fract *, fract *, fract *); +extern void rsub(fract *, fract *, fract *); +extern void rmul(fract *, fract *, fract *); +extern void rdiv(fract *, fract *, fract *); +void polmov(fract *, int, fract *); +void polmul(fract *, int, fract *, int, fract *); +int poldiv(fract *, int, fract *, int, fract *); +void *malloc(long); +void free(void *); #else void radd(), rsub(), rmul(), rdiv(); void polmov(), polmul(); int poldiv(); -void * malloc(); -void free (); +void *malloc(); +void free(); #endif /* near pointer version of malloc() */ @@ -106,428 +107,396 @@ extern int MAXPOL; /* Number of bytes (chars) in maximum size polynomial. */ static int psize = 0; - /* Initialize max degree of polynomials * and allocate temporary storage. */ -void polini( maxdeg ) -int maxdeg; +void polini(maxdeg) int maxdeg; { -MAXPOL = maxdeg; -psize = (maxdeg + 1) * sizeof(fract); - -/* Release previously allocated memory, if any. */ -if( pt3 ) - free(pt3); -if( pt2 ) - free(pt2); -if( pt1 ) - free(pt1); - -/* Allocate new arrays */ -pt1 = (fract * )malloc(psize); /* used by polsbt */ -pt2 = (fract * )malloc(psize); /* used by polsbt */ -pt3 = (fract * )malloc(psize); /* used by polmul */ - -/* Report if failure */ -if( (pt1 == NULL) || (pt2 == NULL) || (pt3 == NULL) ) - { - mtherr( "polini", ERANGE ); - exit(1); - } + MAXPOL = maxdeg; + psize = (maxdeg + 1) * sizeof(fract); + + /* Release previously allocated memory, if any. */ + if (pt3) + free(pt3); + if (pt2) + free(pt2); + if (pt1) + free(pt1); + + /* Allocate new arrays */ + pt1 = (fract *)malloc(psize); /* used by polsbt */ + pt2 = (fract *)malloc(psize); /* used by polsbt */ + pt3 = (fract *)malloc(psize); /* used by polmul */ + + /* Report if failure */ + if ((pt1 == NULL) || (pt2 == NULL) || (pt3 == NULL)) + { + mtherr("polini", ERANGE); + exit(1); + } } - - /* Print the coefficients of a, with d decimal precision. */ static char *form = "abcdefghijk"; -void polprt( a, na, d ) -fract a[]; +void polprt(a, na, d) fract a[]; int na, d; { -int i, j, d1; -char *p; - -/* Create format descriptor string for the printout. - * Do this partly by hand, since sprintf() may be too - * bug-ridden to accomplish this feat by itself. - */ -p = form; -*p++ = '%'; -d1 = d + 8; -sprintf( p, "%d ", d1 ); -p += 1; -if( d1 >= 10 ) - p += 1; -*p++ = '.'; -sprintf( p, "%d ", d ); -p += 1; -if( d >= 10 ) - p += 1; -*p++ = 'e'; -*p++ = ' '; -*p++ = '\0'; - - -/* Now do the printing. - */ -d1 += 1; -j = 0; -for( i=0; i<=na; i++ ) - { -/* Detect end of available line */ - j += d1; - if( j >= 78 ) - { - printf( "\n" ); - j = d1; - } - printf( form, a[i].n ); - j += d1; - if( j >= 78 ) - { - printf( "\n" ); - j = d1; - } - printf( form, a[i].d ); - } -printf( "\n" ); + int i, j, d1; + char *p; + + /* Create format descriptor string for the printout. + * Do this partly by hand, since sprintf() may be too + * bug-ridden to accomplish this feat by itself. + */ + p = form; + *p++ = '%'; + d1 = d + 8; + sprintf(p, "%d ", d1); + p += 1; + if (d1 >= 10) + p += 1; + *p++ = '.'; + sprintf(p, "%d ", d); + p += 1; + if (d >= 10) + p += 1; + *p++ = 'e'; + *p++ = ' '; + *p++ = '\0'; + + /* Now do the printing. + */ + d1 += 1; + j = 0; + for (i = 0; i <= na; i++) + { + /* Detect end of available line */ + j += d1; + if (j >= 78) + { + printf("\n"); + j = d1; + } + printf(form, a[i].n); + j += d1; + if (j >= 78) + { + printf("\n"); + j = d1; + } + printf(form, a[i].d); + } + printf("\n"); } - - /* Set a = 0. */ -void polclr( a, n ) -fract a[]; +void polclr(a, n) fract a[]; int n; { -int i; - -if( n > MAXPOL ) - n = MAXPOL; -for( i=0; i<=n; i++ ) - { - a[i].n = 0.0; - a[i].d = 1.0; - } + int i; + + if (n > MAXPOL) + n = MAXPOL; + for (i = 0; i <= n; i++) + { + a[i].n = 0.0; + a[i].d = 1.0; + } } - - /* Set b = a. */ -void polmov( a, na, b ) -fract a[], b[]; +void polmov(a, na, b) fract a[], b[]; int na; { -int i; + int i; -if( na > MAXPOL ) - na = MAXPOL; + if (na > MAXPOL) + na = MAXPOL; -for( i=0; i<= na; i++ ) - { - b[i].n = a[i].n; - b[i].d = a[i].d; - } + for (i = 0; i <= na; i++) + { + b[i].n = a[i].n; + b[i].d = a[i].d; + } } - /* c = b * a. */ -void polmul( a, na, b, nb, c ) -fract a[], b[], c[]; +void polmul(a, na, b, nb, c) fract a[], b[], c[]; int na, nb; { -int i, j, k, nc; -fract temp; -fract *p; - -nc = na + nb; -polclr( pt3, MAXPOL ); - -p = &a[0]; -for( i=0; i<=na; i++ ) - { - for( j=0; j<=nb; j++ ) - { - k = i + j; - if( k > MAXPOL ) - break; - rmul( p, &b[j], &temp ); /*pt3[k] += a[i] * b[j];*/ - radd( &temp, &pt3[k], &pt3[k] ); - } - ++p; - } - -if( nc > MAXPOL ) - nc = MAXPOL; -for( i=0; i<=nc; i++ ) - { - c[i].n = pt3[i].n; - c[i].d = pt3[i].d; - } + int i, j, k, nc; + fract temp; + fract *p; + + nc = na + nb; + polclr(pt3, MAXPOL); + + p = &a[0]; + for (i = 0; i <= na; i++) + { + for (j = 0; j <= nb; j++) + { + k = i + j; + if (k > MAXPOL) + break; + rmul(p, &b[j], &temp); /*pt3[k] += a[i] * b[j];*/ + radd(&temp, &pt3[k], &pt3[k]); + } + ++p; + } + + if (nc > MAXPOL) + nc = MAXPOL; + for (i = 0; i <= nc; i++) + { + c[i].n = pt3[i].n; + c[i].d = pt3[i].d; + } } - - - /* c = b + a. */ -void poladd( a, na, b, nb, c ) -fract a[], b[], c[]; +void poladd(a, na, b, nb, c) fract a[], b[], c[]; int na, nb; { -int i, n; - - -if( na > nb ) - n = na; -else - n = nb; - -if( n > MAXPOL ) - n = MAXPOL; - -for( i=0; i<=n; i++ ) - { - if( i > na ) - { - c[i].n = b[i].n; - c[i].d = b[i].d; - } - else if( i > nb ) - { - c[i].n = a[i].n; - c[i].d = a[i].d; - } - else - { - radd( &a[i], &b[i], &c[i] ); /*c[i] = b[i] + a[i];*/ - } - } + int i, n; + + if (na > nb) + n = na; + else + n = nb; + + if (n > MAXPOL) + n = MAXPOL; + + for (i = 0; i <= n; i++) + { + if (i > na) + { + c[i].n = b[i].n; + c[i].d = b[i].d; + } + else if (i > nb) + { + c[i].n = a[i].n; + c[i].d = a[i].d; + } + else + { + radd(&a[i], &b[i], &c[i]); /*c[i] = b[i] + a[i];*/ + } + } } /* c = b - a. */ -void polsub( a, na, b, nb, c ) -fract a[], b[], c[]; +void polsub(a, na, b, nb, c) fract a[], b[], c[]; int na, nb; { -int i, n; - - -if( na > nb ) - n = na; -else - n = nb; - -if( n > MAXPOL ) - n = MAXPOL; - -for( i=0; i<=n; i++ ) - { - if( i > na ) - { - c[i].n = b[i].n; - c[i].d = b[i].d; - } - else if( i > nb ) - { - c[i].n = -a[i].n; - c[i].d = a[i].d; - } - else - { - rsub( &a[i], &b[i], &c[i] ); /*c[i] = b[i] - a[i];*/ - } - } + int i, n; + + if (na > nb) + n = na; + else + n = nb; + + if (n > MAXPOL) + n = MAXPOL; + + for (i = 0; i <= n; i++) + { + if (i > na) + { + c[i].n = b[i].n; + c[i].d = b[i].d; + } + else if (i > nb) + { + c[i].n = -a[i].n; + c[i].d = a[i].d; + } + else + { + rsub(&a[i], &b[i], &c[i]); /*c[i] = b[i] - a[i];*/ + } + } } - - /* c = b/a */ -int poldiv( a, na, b, nb, c ) +int poldiv(a, na, b, nb, c) fract a[], b[], c[]; int na, nb; { -fract *ta, *tb, *tq; -fract quot; -fract temp; -int i, j, k, sing; - -sing = 0; - -/* Allocate temporary arrays. This would be quicker - * if done automatically on the stack, but stack space - * may be hard to obtain on a small computer. - */ -ta = (fract * )malloc( psize ); -polclr( ta, MAXPOL ); -polmov( a, na, ta ); - -tb = (fract * )malloc( psize ); -polclr( tb, MAXPOL ); -polmov( b, nb, tb ); - -tq = (fract * )malloc( psize ); -polclr( tq, MAXPOL ); - -/* What to do if leading (constant) coefficient - * of denominator is zero. - */ -if( a[0].n == 0.0 ) - { - for( i=0; i<=na; i++ ) - { - if( ta[i].n != 0.0 ) - goto nzero; - } - mtherr( "poldiv", SING ); - goto done; - -nzero: -/* Reduce the degree of the denominator. */ - for( i=0; i MAXPOL ) - break; - - rmul( &ta[j], ", &temp ); /*tb[k] -= quot * ta[j];*/ - rsub( &temp, &tb[k], &tb[k] ); - } - tq[i].n = quot.n; - tq[i].d = quot.d; - } -/* Send quotient to output array. */ -polmov( tq, MAXPOL, c ); + fract *ta, *tb, *tq; + fract quot; + fract temp; + int i, j, k, sing; + + sing = 0; + + /* Allocate temporary arrays. This would be quicker + * if done automatically on the stack, but stack space + * may be hard to obtain on a small computer. + */ + ta = (fract *)malloc(psize); + polclr(ta, MAXPOL); + polmov(a, na, ta); + + tb = (fract *)malloc(psize); + polclr(tb, MAXPOL); + polmov(b, nb, tb); + + tq = (fract *)malloc(psize); + polclr(tq, MAXPOL); + + /* What to do if leading (constant) coefficient + * of denominator is zero. + */ + if (a[0].n == 0.0) + { + for (i = 0; i <= na; i++) + { + if (ta[i].n != 0.0) + goto nzero; + } + mtherr("poldiv", SING); + goto done; + + nzero: + /* Reduce the degree of the denominator. */ + for (i = 0; i < na; i++) + { + ta[i].n = ta[i + 1].n; + ta[i].d = ta[i + 1].d; + } + ta[na].n = 0.0; + ta[na].d = 1.0; + + if (b[0].n != 0.0) + { + /* Optional message: + printf( "poldiv singularity, divide quotient by x\n" ); + */ + sing += 1; + } + else + { + /* Reduce degree of numerator. */ + for (i = 0; i < nb; i++) + { + tb[i].n = tb[i + 1].n; + tb[i].d = tb[i + 1].d; + } + tb[nb].n = 0.0; + tb[nb].d = 1.0; + } + /* Call self, using reduced polynomials. */ + sing += poldiv(ta, na, tb, nb, c); + goto done; + } + + /* Long division algorithm. ta[0] is nonzero. + */ + for (i = 0; i <= MAXPOL; i++) + { + rdiv(&ta[0], &tb[i], "); /*quot = tb[i]/ta[0];*/ + for (j = 0; j <= MAXPOL; j++) + { + k = j + i; + if (k > MAXPOL) + break; + + rmul(&ta[j], ", &temp); /*tb[k] -= quot * ta[j];*/ + rsub(&temp, &tb[k], &tb[k]); + } + tq[i].n = quot.n; + tq[i].d = quot.d; + } + /* Send quotient to output array. */ + polmov(tq, MAXPOL, c); done: -/* Restore allocated memory. */ -free(tq); -free(tb); -free(ta); -return( sing ); + /* Restore allocated memory. */ + free(tq); + free(tb); + free(ta); + return (sing); } - - - /* Change of variables * Substitute a(y) for the variable x in b(x). * x = a(y) * c(x) = b(x) = b(a(y)). */ -void polsbt( a, na, b, nb, c ) -fract a[], b[], c[]; +void polsbt(a, na, b, nb, c) fract a[], b[], c[]; int na, nb; { -int i, j, k, n2; -fract temp; -fract *p; - -/* 0th degree term: - */ -polclr( pt1, MAXPOL ); -pt1[0].n = b[0].n; -pt1[0].d = b[0].d; - -polclr( pt2, MAXPOL ); -pt2[0].n = 1.0; -pt2[0].d = 1.0; -n2 = 0; -p = &b[1]; - -for( i=1; i<=nb; i++ ) - { -/* Form ith power of a. */ - polmul( a, na, pt2, n2, pt2 ); - n2 += na; -/* Add the ith coefficient of b times the ith power of a. */ - for( j=0; j<=n2; j++ ) - { - if( j > MAXPOL ) - break; - rmul( &pt2[j], p, &temp ); /*pt1[j] += b[i] * pt2[j];*/ - radd( &temp, &pt1[j], &pt1[j] ); - } - ++p; - } - -k = n2 + nb; -if( k > MAXPOL ) - k = MAXPOL; -for( i=0; i<=k; i++ ) - { - c[i].n = pt1[i].n; - c[i].d = pt1[i].d; - } + int i, j, k, n2; + fract temp; + fract *p; + + /* 0th degree term: + */ + polclr(pt1, MAXPOL); + pt1[0].n = b[0].n; + pt1[0].d = b[0].d; + + polclr(pt2, MAXPOL); + pt2[0].n = 1.0; + pt2[0].d = 1.0; + n2 = 0; + p = &b[1]; + + for (i = 1; i <= nb; i++) + { + /* Form ith power of a. */ + polmul(a, na, pt2, n2, pt2); + n2 += na; + /* Add the ith coefficient of b times the ith power of a. */ + for (j = 0; j <= n2; j++) + { + if (j > MAXPOL) + break; + rmul(&pt2[j], p, &temp); /*pt1[j] += b[i] * pt2[j];*/ + radd(&temp, &pt1[j], &pt1[j]); + } + ++p; + } + + k = n2 + nb; + if (k > MAXPOL) + k = MAXPOL; + for (i = 0; i <= k; i++) + { + c[i].n = pt1[i].n; + c[i].d = pt1[i].d; + } } - - - /* Evaluate polynomial a(t) at t = x. */ -void poleva( a, na, x, s ) -fract a[]; +void poleva(a, na, x, s) fract a[]; int na; fract *x; fract *s; { -int i; -fract temp; - -s->n = a[na].n; -s->d = a[na].d; -for( i=na-1; i>=0; i-- ) - { - rmul( s, x, &temp ); /*s = s * x + a[i];*/ - radd( &a[i], &temp, s ); - } + int i; + fract temp; + + s->n = a[na].n; + s->d = a[na].d; + for (i = na - 1; i >= 0; i--) + { + rmul(s, x, &temp); /*s = s * x + a[i];*/ + radd(&a[i], &temp, s); + } } - diff --git a/cephes/polyn/revers.c b/cephes/polyn/revers.c index b05a977..8bf8801 100644 --- a/cephes/polyn/revers.c +++ b/cephes/polyn/revers.c @@ -59,7 +59,7 @@ * y[0] must be zero, and y[1] must be nonzero. * */ - + /* Cephes Math Library Release 2.8: June, 2000 Copyright 1984, 1987, 1989, 1992, 2000 by Stephen L. Moshier @@ -71,54 +71,52 @@ extern int MAXPOL; /* initialized by polini() */ #ifdef ANSIPROT /* See polyn.c. */ -void polmov ( double *, int, double * ); -void polclr ( double *, int ); -void poladd ( double *, int, double *, int, double * ); -void polmul ( double *, int, double *, int, double * ); -void * malloc ( long ); -void free ( void * ); +void polmov(double *, int, double *); +void polclr(double *, int); +void poladd(double *, int, double *, int, double *); +void polmul(double *, int, double *, int, double *); +void *malloc(long); +void free(void *); #else void polmov(), polclr(), poladd(), polmul(); -void * malloc(); -void free (); +void *malloc(); +void free(); #endif -void revers( y, x, n) -double y[], x[]; +void revers(y, x, n) double y[], x[]; int n; { -double *yn, *yp, *ysum; -int j; + double *yn, *yp, *ysum; + int j; -if( y[1] == 0.0 ) - mtherr( "revers", DOMAIN ); -/* printf( "revers: y[1] = 0\n" );*/ -j = (MAXPOL + 1) * sizeof(double); -yn = (double *)malloc(j); -yp = (double *)malloc(j); -ysum = (double *)malloc(j); + if (y[1] == 0.0) + mtherr("revers", DOMAIN); + /* printf( "revers: y[1] = 0\n" );*/ + j = (MAXPOL + 1) * sizeof(double); + yn = (double *)malloc(j); + yp = (double *)malloc(j); + ysum = (double *)malloc(j); -polmov( y, n, yn ); -polclr( ysum, n ); -x[0] = 0.0; -x[1] = 1.0/y[1]; -for( j=2; j<=n; j++ ) - { -/* A_(j-1) times the expansion of y^(j-1) */ - polmul( &x[j-1], 0, yn, n, yp ); -/* The expansion of the sum of A_k y^k up to k=j-1 */ - poladd( yp, n, ysum, n, ysum ); -/* The expansion of y^j */ - polmul( yn, n, y, n, yn ); -/* The coefficient A_j to make the sum up to k=j equal to zero */ - x[j] = -ysum[j]/yn[j]; - } -free(yn); -free(yp); -free(ysum); + polmov(y, n, yn); + polclr(ysum, n); + x[0] = 0.0; + x[1] = 1.0 / y[1]; + for (j = 2; j <= n; j++) + { + /* A_(j-1) times the expansion of y^(j-1) */ + polmul(&x[j - 1], 0, yn, n, yp); + /* The expansion of the sum of A_k y^k up to k=j-1 */ + poladd(yp, n, ysum, n, ysum); + /* The expansion of y^j */ + polmul(yn, n, y, n, yn); + /* The coefficient A_j to make the sum up to k=j equal to zero */ + x[j] = -ysum[j] / yn[j]; + } + free(yn); + free(yp); + free(ysum); } - #if 0 /* Demonstration program */ diff --git a/doc/markdown/bessel.md b/doc/markdown/bessel.md index 671827e..271ed48 100644 --- a/doc/markdown/bessel.md +++ b/doc/markdown/bessel.md @@ -29,6 +29,7 @@ * **y0**, [Bessel function of the second kind, order zero](doubldoc.md#y0) * **y1**, [Bessel function of the second kind, order one](doubldoc.md#y1) * **yn**, [Bessel function of second kind of integer order](doubldoc.md#yn) +* **yv**, Bessel function of noninteger order ## Modified Bessel functions - third kind diff --git a/doc/markdown/prob.md b/doc/markdown/prob.md new file mode 100644 index 0000000..e18d8d5 --- /dev/null +++ b/doc/markdown/prob.md @@ -0,0 +1,31 @@ +# Probability Functions + +* **bdtr**, [Binomial distribution](doubldoc.md#bdtr) +* **bdtrc**, [Complemented binomial distribution](doubldoc.md#bdtrc) +* **bdtri**, [Inverse binomial distribution](doubldoc.md#bdtri) + +* **btdtr**, [Beta distribution](doubldoc.md#btdtr) + +* **chdtr**, [Chi-square distribution](doubldoc.md#chdtr) +* **chdtrc**, [Complemented Chi-square distribution](doubldoc.md#chdtrc) +* **chdtri**, [Inverse of complemented Chi-square distribution](doubldoc.md#chdtri) + +* **fdtr**, [F distribution](doubldoc.md#fdtr) +* **fdtrc**, [Complemented F distribution](doubldoc.md#fdtrc) +* **fdtri**, [Inverse of complemented F distribution](doubldoc.md#fdtri) + +* **gdtr**, [Gamma distribution function](doubldoc.md#gdtr) +* **gdtrc**, [Complemented gamma distribution function](doubldoc.md#gdtrc) + +* **nbdtr**, [Negative binomial distribution](doubldoc.md#nbdtr) +* **nbdtrc**, [Complemented negative binomial distribution](doubldoc.md#nbdtrc) +* **nbdtri**, [Functional inverse of negative binomial distribution](doubldoc.md#nbdtri) +* **ndtr**, [Normal distribution function](doubldoc.md#ndtr) +* **ndtri**, [Inverse of normal distribution function](doubldoc.md#ndtri) + +* **pdtr**, [Poisson distribution function](doubldoc.md#pdtr) +* **pdtrc**, [Complemented Poisson distribution function](doubldoc.md#pdtrc) +* **pdtri**, [Inverse of Poisson distribution function](doubldoc.md#pdtri) + +* **stdtr**, [Student's t distribution](doubldoc.md#stdtr) +* **stdtri**, [Functional inverse of Student's t distribution](doubldoc.md#stdtri) diff --git a/include/cephes/bessel.h b/include/cephes/bessel.h index 2cb403d..d1f81c3 100644 --- a/include/cephes/bessel.h +++ b/include/cephes/bessel.h @@ -30,6 +30,7 @@ double iv(double v, double x); double y0(double x); double y1(double x); double yn(int n, double x); +double yv(double v, double x); /** Modified Bessel functions - third kind */ double k0(double x); diff --git a/include/cephes/error.h b/include/cephes/error.h index dcda38f..cb9ceeb 100644 --- a/include/cephes/error.h +++ b/include/cephes/error.h @@ -14,7 +14,6 @@ extern "C" { /* cephes/ndtr.c */ double erf(double x); double erfc(double a); -double ndtr(double a); /* cephes/dawsn.c */ double dawsn(double xx); diff --git a/include/cephes/prob.h b/include/cephes/prob.h new file mode 100644 index 0000000..869ff16 --- /dev/null +++ b/include/cephes/prob.h @@ -0,0 +1,59 @@ +#ifndef CEPHES_PROB_H +/** Cephes double precision special functions suite + * + * probability + */ +#define CEPHES_PROB_H + +namespace cephes { +#if defined(__cplusplus) +extern "C" { +#endif + +/* cprob/bdtr.c */ +double bdtr(int k, int n, double p); +double bdtrc(int k, int n, double p); +double bdtri(int k, int n, double y); + +/* cprob/btdtr.c */ +double btdtr(double a, double b, double x); + +/* cprob/chdtr.c */ +double chdtr(double df, double x); +double chdtrc(double df, double x); +double chdtri(double df, double y); + +/* cprob/fdtr.c */ +double fdtr(int ia, int ib, double x); +double fdtrc(int ia, int ib, double x); +double fdtri(int ia, int ib, double y); + +/* cprob/gdtr.c */ +double gdtr(double a, double b, double x); +double gdtrc(double a, double b, double x); + +/* cprob/nbdtr.c */ +double nbdtr(int k, int n, double p); +double nbdtrc(int k, int n, double p); +double nbdtri(int k, int n, double p); + +/* cprob/ndtr.c */ +double ndtr(double a); +/* cprob/ndtri.c */ +double ndtri(double y0_); + +/* cprob/pdtr.c */ +double pdtr(int k, double m); +double pdtrc(int k, double m); +double pdtri(int k, double y); + +/* cprob/stdtr.c */ +double stdtr(int k, double t); +double stdtri(int k, double p); + +#if defined(__cplusplus) +} // extern "C" +#endif +}; // ::cephes + +#endif // CEPHES_PROB_H \ No newline at end of file diff --git a/tests/CMakeLists.txt b/tests/CMakeLists.txt index 038b115..63a9b2e 100644 --- a/tests/CMakeLists.txt +++ b/tests/CMakeLists.txt @@ -28,4 +28,5 @@ add_subdirectory(error) add_subdirectory(bessel) add_subdirectory(hyper) add_subdirectory(elliptic) +add_subdirectory(prob) add_subdirectory(misc) diff --git a/tests/Coverage.cmake b/tests/Coverage.cmake index 3d58f3c..0dc5615 100644 --- a/tests/Coverage.cmake +++ b/tests/Coverage.cmake @@ -1,29 +1,28 @@ if(CMAKE_BUILD_TYPE STREQUAL "Coverage") + # Enable coverage compilation option + if(CMAKE_CXX_COMPILER_ID MATCHES "Clang|GNU") + set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} --coverage") + set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} --coverage") + endif() -# Enable coverage compilation option -if(CMAKE_CXX_COMPILER_ID MATCHES "Clang|GNU") - set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} --coverage") - set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} --coverage") -endif() -if(MSVC) - set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} /coverage") - set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} /coverage") -endif() + if(MSVC) + set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} /coverage") + set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} /coverage") + endif() -# Add custom targets for generating coverage reports -add_custom_target(coverage - COMMAND lcov --capture --directory cephes --output-file coverage.info - COMMAND lcov --list coverage.info - WORKING_DIRECTORY ${CMAKE_BINARY_DIR} - COMMENT "Generating coverage report" -) - -# Generate coverage reports in HTML format -add_custom_target(coverage_html - COMMAND genhtml --demangle-cpp --legend coverage.info --output-directory coverage_report - WORKING_DIRECTORY ${CMAKE_BINARY_DIR} - COMMENT "Generating HTML coverage report" -) -add_dependencies(coverage_html coverage) + # Add custom targets for generating coverage reports + add_custom_target(coverage + COMMAND lcov --capture --directory cephes --output-file coverage.info + COMMAND lcov --list coverage.info + WORKING_DIRECTORY ${CMAKE_BINARY_DIR} + COMMENT "Generating coverage report" + ) + # Generate coverage reports in HTML format + add_custom_target(coverage_html + COMMAND genhtml --demangle-cpp --legend coverage.info --output-directory coverage_report + WORKING_DIRECTORY ${CMAKE_BINARY_DIR} + COMMENT "Generating HTML coverage report" + ) + add_dependencies(coverage_html coverage) endif() # CMAKE_BUILD_TYPE=Coverage \ No newline at end of file diff --git a/tests/bessel/airy.cpp b/tests/bessel/airy.cpp index 2653188..e66e762 100644 --- a/tests/bessel/airy.cpp +++ b/tests/bessel/airy.cpp @@ -1,8 +1,8 @@ -#include #include +#include - -TEST(Airy, BasicAssertions) { +TEST(Airy, BasicAssertions) +{ const double nan64 = std::numeric_limits::quiet_NaN(); int ret; double x, ai, aip, bi, bip; @@ -16,7 +16,8 @@ TEST(Airy, BasicAssertions) { EXPECT_TRUE(bip > 1e308); } -TEST(Airy, Branches) { +TEST(Airy, Branches) +{ int ret; double x, ai, aip, bi, bip, ref; double ai_ref, aip_ref, bi_ref, bip_ref; @@ -30,9 +31,9 @@ TEST(Airy, Branches) { {NumberForm[AiryAi[x], 16], NumberForm[AiryAiPrime[x], 16], NumberForm[AiryBi[x], 16], NumberForm[AiryBiPrime[x], 16]} */ - ai_ref = -0.378814293677658; - aip_ref = 0.3145837692165989; - bi_ref = -0.1982896263749266; + ai_ref = -0.378814293677658; + aip_ref = 0.3145837692165989; + bi_ref = -0.1982896263749266; bip_ref = -0.6756112226852585; XTEST_ISAPPROX_F64(ai); XTEST_ISAPPROX_F64(aip); @@ -48,10 +49,10 @@ TEST(Airy, Branches) { {NumberForm[AiryAi[x], 16], NumberForm[AiryAiPrime[x], 16], NumberForm[AiryBi[x], 16], NumberForm[AiryBiPrime[x], 16]} */ - ai_ref = 0.0001083444281360744; - aip_ref = -0.0002474138908684624; - bi_ref = 657.7920441711713; - bip_ref = 1435.81908021797; + ai_ref = 0.0001083444281360744; + aip_ref = -0.0002474138908684624; + bi_ref = 657.7920441711713; + bip_ref = 1435.81908021797; XTEST_ISAPPROX_F64(ai); XTEST_ISAPPROX_F64(aip); XTEST_ISAPPROX_F64(bi); @@ -66,10 +67,10 @@ TEST(Airy, Branches) { {NumberForm[AiryAi[x], 16], NumberForm[AiryAiPrime[x], 16], NumberForm[AiryBi[x], 16], NumberForm[AiryBiPrime[x], 16]} */ - ai_ref = 1.099700975519552e-8; - aip_ref = -3.237725440447604e-8; - bi_ref = 4.965319541471301e6; - bip_ref = 1.432630103066198e7; + ai_ref = 1.099700975519552e-8; + aip_ref = -3.237725440447604e-8; + bi_ref = 4.965319541471301e6; + bip_ref = 1.432630103066198e7; XTEST_ISAPPROX_F64(ai); XTEST_ISAPPROX_F64(aip); XTEST_ISAPPROX_F64(bi); diff --git a/tests/bessel/i0.cpp b/tests/bessel/i0.cpp index 457d2fe..67bc1fd 100644 --- a/tests/bessel/i0.cpp +++ b/tests/bessel/i0.cpp @@ -1,8 +1,8 @@ -#include #include +#include - -TEST(BesselI0, Branches) { +TEST(BesselI0, Branches) +{ EXPECT_REL_NEAR_F64(cephes::i0(0.0), 1.0); // x < 0 @@ -14,7 +14,7 @@ TEST(BesselI0, Branches) { EXPECT_REL_NEAR_F64(cephes::i0(8.0), 427.5641157218048); // x > 8.0 - EXPECT_REL_NEAR_F64(cephes::i0(9.0), 1093.588354511374); + EXPECT_REL_NEAR_F64(cephes::i0(9.0), 1093.588354511374); EXPECT_REL_NEAR_F64(cephes::i0(10.0), 2815.716628466253); EXPECT_REL_NEAR_F64(cephes::i0(100.0), 1.073751707131074e42); } diff --git a/tests/bessel/i0e.cpp b/tests/bessel/i0e.cpp index f49456f..b64efe4 100644 --- a/tests/bessel/i0e.cpp +++ b/tests/bessel/i0e.cpp @@ -1,11 +1,12 @@ -#include #include +#include /** Table[NumberForm[Exp[-Abs[x]]*BesselI[nv, x], 16], {x, {0.0, -10., 1.0, 8.0, 9.0, 10.0, 100.}}, {nv, {0}}] */ -TEST(BesselI0Exp, Branches) { +TEST(BesselI0Exp, Branches) +{ EXPECT_REL_NEAR_F64(cephes::i0e(0.0), 1.0); // x < 0 @@ -17,7 +18,7 @@ TEST(BesselI0Exp, Branches) { EXPECT_REL_NEAR_F64(cephes::i0e(8.0), 0.1434317818568503); // x > 8.0 - EXPECT_REL_NEAR_F64(cephes::i0e(9.0), 0.134959524581723); + EXPECT_REL_NEAR_F64(cephes::i0e(9.0), 0.134959524581723); EXPECT_REL_NEAR_F64(cephes::i0e(10.0), 0.1278333371634286); EXPECT_REL_NEAR_F64(cephes::i0e(100.0), 0.03994437929909669); } diff --git a/tests/bessel/i1.cpp b/tests/bessel/i1.cpp index b8ce566..3214dd5 100644 --- a/tests/bessel/i1.cpp +++ b/tests/bessel/i1.cpp @@ -1,11 +1,12 @@ -#include #include +#include /* Table[NumberForm[BesselI[1, x], 16], {x, {0.0, -10., 1.0, 8.0, 9.0, 10.0, 100.}}] */ -TEST(BesselI1, Branches) { +TEST(BesselI1, Branches) +{ EXPECT_REL_NEAR_F64(cephes::i1(0.0), 0.0); // x < 0 @@ -17,7 +18,7 @@ TEST(BesselI1, Branches) { EXPECT_REL_NEAR_F64(cephes::i1(8.0), 399.8731367825601); // x > 8.0 - EXPECT_REL_NEAR_F64(cephes::i1(9.0), 1030.914722516956); + EXPECT_REL_NEAR_F64(cephes::i1(9.0), 1030.914722516956); EXPECT_REL_NEAR_F64(cephes::i1(10.0), 2670.988303701254); EXPECT_REL_NEAR_F64(cephes::i1(100.0), 1.068369390338163e+42); } diff --git a/tests/bessel/i1e.cpp b/tests/bessel/i1e.cpp index 0a3ef46..486e63b 100644 --- a/tests/bessel/i1e.cpp +++ b/tests/bessel/i1e.cpp @@ -1,11 +1,12 @@ -#include #include +#include /** Table[NumberForm[Exp[-Abs[x]]*BesselI[1, x], 16], {x, {0.0, -10., 1.0, 8.0, 9.0, 10.0, 100.}}] */ -TEST(BesselI1Exp, Branches) { +TEST(BesselI1Exp, Branches) +{ EXPECT_REL_NEAR_F64(cephes::i1e(0.0), 0.0); // x < 0 diff --git a/tests/bessel/iv.cpp b/tests/bessel/iv.cpp index a83f8e3..7af9331 100644 --- a/tests/bessel/iv.cpp +++ b/tests/bessel/iv.cpp @@ -1,12 +1,13 @@ -#include #include +#include /** Table[NumberForm[Exp[-Abs[x]]*BesselI[nv, x], 16], {nv, {0, 1}}, {x, {0.0, 1.0, 8.0, 9.0, 1.0, 100.}}] */ -TEST(BesselIv, Branches) { +TEST(BesselIv, Branches) +{ EXPECT_REL_NEAR_F64(cephes::iv(0, 0.0), 1.0); EXPECT_REL_NEAR_F64(cephes::iv(1, 0.0), 0.0); EXPECT_REL_NEAR_F64(cephes::iv(-1, 0.0), 0.0); diff --git a/tests/bessel/j0.cpp b/tests/bessel/j0.cpp index 58975b7..6fbae52 100644 --- a/tests/bessel/j0.cpp +++ b/tests/bessel/j0.cpp @@ -1,11 +1,12 @@ -#include #include +#include - -TEST(BesselJ0, BasicAssertions) { +TEST(BesselJ0, BasicAssertions) +{ double x, y, y_ref; } -TEST(BesselJ0, Branches) { +TEST(BesselJ0, Branches) +{ double x, y, y_ref; // x <= 5.0 && x < 1.0e-5 diff --git a/tests/bessel/j1.cpp b/tests/bessel/j1.cpp index 50081fd..7b44b5f 100644 --- a/tests/bessel/j1.cpp +++ b/tests/bessel/j1.cpp @@ -1,12 +1,13 @@ -#include #include +#include - -TEST(BesselJ1, BasicAssertions) { +TEST(BesselJ1, BasicAssertions) +{ EXPECT_EQ(cephes::j1(0.0), 0.0); EXPECT_EQ(cephes::j1(-0.0), 0.0); } -TEST(BesselJ1, Branches) { +TEST(BesselJ1, Branches) +{ double x, y, y_ref; // x <= 5.0 diff --git a/tests/bessel/jn.cpp b/tests/bessel/jn.cpp index 5c07f21..3f2cc0c 100644 --- a/tests/bessel/jn.cpp +++ b/tests/bessel/jn.cpp @@ -1,14 +1,15 @@ -#include #include +#include - -TEST(BesselJn, BasicAssertions) { +TEST(BesselJn, BasicAssertions) +{ EXPECT_REL_NEAR_F64(cephes::jn(5, 1.0), 0.0002497577302112345); EXPECT_REL_NEAR_F64(cephes::jn(10, 1.0), 2.630615123687453e-10); EXPECT_REL_NEAR_F64(cephes::jn(50, 1.0), 2.906004948173273e-80); EXPECT_REL_NEAR_F64(cephes::jn(100, 1.0), 8.43182878962688e-189); } -TEST(BesselJ1, Branches) { +TEST(BesselJ1, Branches) +{ // n < 0 EXPECT_REL_NEAR_F64(cephes::jn(-1, 0.0), 0.0); EXPECT_TRUE(std::isnan(cephes::jn(-2, 0.0))); diff --git a/tests/bessel/jv.cpp b/tests/bessel/jv.cpp index 5088e2d..2e12015 100644 --- a/tests/bessel/jv.cpp +++ b/tests/bessel/jv.cpp @@ -1,16 +1,16 @@ -#include #include - +#include /** Wolframe Table[NumberForm[BesselJ[nv + 1/4., x], 16], {nv, {0, 5, 10, 50, 100}}, {x, {1, 50}}] */ -TEST(BesselJv, CoSF_Table_5p13) { +TEST(BesselJv, CoSF_Table_5p13) +{ double nv, x; - nv = 1/4; + nv = 1 / 4; x = 1.0; // TODO: large error // EXPECT_REL_NEAR_F64(cephes::jv(0+nv, x), 0.7522313333407901); @@ -32,10 +32,11 @@ TEST(BesselJv, CoSF_Table_5p13) { {nv, {0, 5, 10, 50, 100}}, {x, {1, 50}}] */ -TEST(BesselJv, CoSF_Table_5p17) { +TEST(BesselJv, CoSF_Table_5p17) +{ double nv, x; - nv = 3/4; + nv = 3 / 4; x = 1.0; // TODO: large error // EXPECT_REL_NEAR_F64(cephes::jv(0+nv, x), 0.5586524932048919); @@ -52,7 +53,8 @@ TEST(BesselJv, CoSF_Table_5p17) { // EXPECT_REL_NEAR_F64(cephes::jv(50+nv, x), 0.0988291994940441); // EXPECT_REL_NEAR_F64(cephes::jv(100+nv, x), 4.122166908740485e-22); } -TEST(BesselJv, Branches) { +TEST(BesselJv, Branches) +{ // (x < 0.0) && (y != an) EXPECT_REL_NEAR_F64(cephes::jv(1.1, -1.0), 0.0); } diff --git a/tests/bessel/k0.cpp b/tests/bessel/k0.cpp index aed4e0c..0bc872b 100644 --- a/tests/bessel/k0.cpp +++ b/tests/bessel/k0.cpp @@ -1,12 +1,13 @@ -#include #include +#include /* Table[NumberForm[BesselK[0, x], 16], {x, {0.0, -10., 1.0, 8.0, 9.0, 10.0, 100.}}] */ -TEST(BesselK0, Branches) { - EXPECT_GT(cephes::k0(0.0), 1.0e308); // +Inf +TEST(BesselK0, Branches) +{ + EXPECT_GT(cephes::k0(0.0), 1.0e308); // +Inf // x < 0 // EXPECT_REL_NEAR_F64(cephes::k0(-10.0), ); diff --git a/tests/bessel/k0e.cpp b/tests/bessel/k0e.cpp index dd8e837..51c3ede 100644 --- a/tests/bessel/k0e.cpp +++ b/tests/bessel/k0e.cpp @@ -1,12 +1,13 @@ -#include #include +#include /* Table[NumberForm[Exp[-Abs[x]]*BesselK[0, x], 16], {x, {0.0, -10., 1.0, 8.0, 9.0, 10.0, 100.}}] */ -TEST(BesselK0Exp, Branches) { - EXPECT_GT(cephes::k0e(0.0), 1.0e308); // +Inf +TEST(BesselK0Exp, Branches) +{ + EXPECT_GT(cephes::k0e(0.0), 1.0e308); // +Inf // x < 0 // EXPECT_REL_NEAR_F64(cephes::k0e(-10.0), ); diff --git a/tests/bessel/k1.cpp b/tests/bessel/k1.cpp index 1b88f7f..e581c4a 100644 --- a/tests/bessel/k1.cpp +++ b/tests/bessel/k1.cpp @@ -1,12 +1,13 @@ -#include #include +#include /* Table[NumberForm[BesselK[1, x], 16], {x, {0.0, -10., 1.0, 8.0, 9.0, 10.0, 100.}}] */ -TEST(BesselK1, Branches) { - EXPECT_GT(cephes::k1(0.0), 1.0e308); // +Inf +TEST(BesselK1, Branches) +{ + EXPECT_GT(cephes::k1(0.0), 1.0e308); // +Inf // x < 0 // EXPECT_REL_NEAR_F64(cephes::k1(-10.0), ); diff --git a/tests/bessel/k1e.cpp b/tests/bessel/k1e.cpp index b325f63..7945f0f 100644 --- a/tests/bessel/k1e.cpp +++ b/tests/bessel/k1e.cpp @@ -1,12 +1,13 @@ -#include #include +#include /* Table[NumberForm[Exp[-Abs[x]]*BesselK[1, x], 16], {x, {0.0, -10., 1.0, 8.0, 9.0, 10.0, 100.}}] */ -TEST(BesselK1Exp, Branches) { - EXPECT_GT(cephes::k1e(0.0), 1.0e308); // +Inf +TEST(BesselK1Exp, Branches) +{ + EXPECT_GT(cephes::k1e(0.0), 1.0e308); // +Inf // x < 0 // EXPECT_REL_NEAR_F64(cephes::k1e(-10.0), ); diff --git a/tests/bessel/kn.cpp b/tests/bessel/kn.cpp index 6854897..74af32f 100644 --- a/tests/bessel/kn.cpp +++ b/tests/bessel/kn.cpp @@ -1,15 +1,16 @@ -#include #include +#include /* Table[NumberForm[BesselK[nv, x], 16], {nv, {0, 1, 10}}, {x, {0.0, 1.0, 8.0, 9.0, 1.0, 100.}}] */ -TEST(BesselYn, Branches) { +TEST(BesselYn, Branches) +{ EXPECT_GT(cephes::kn(0, 0.0), 1.0e308); // +Inf EXPECT_GT(cephes::kn(1, 0.0), 1.0e308); // +Inf - EXPECT_GT(cephes::kn(10, 0.0), 1.0e308); // +Inf + EXPECT_GT(cephes::kn(10, 0.0), 1.0e308); // +Inf // x < 0 // EXPECT_REL_NEAR_F64(cephes::kn(-10.0), ); diff --git a/tests/bessel/y0.cpp b/tests/bessel/y0.cpp index dc5f267..38b6e04 100644 --- a/tests/bessel/y0.cpp +++ b/tests/bessel/y0.cpp @@ -1,12 +1,13 @@ -#include #include +#include /* Table[NumberForm[BesselY[0, x], 16], {x, {0.0, -10., 1.0, 8.0, 9.0, 10.0, 100.}}] */ -TEST(BesselY0, Branches) { - EXPECT_LE(cephes::y0(0.0), -1.0e308); // -Inf +TEST(BesselY0, Branches) +{ + EXPECT_LE(cephes::y0(0.0), -1.0e308); // -Inf // x < 0 // EXPECT_REL_NEAR_F64(cephes::y0(-10.0), ); diff --git a/tests/bessel/y1.cpp b/tests/bessel/y1.cpp index 8764f3c..15d6893 100644 --- a/tests/bessel/y1.cpp +++ b/tests/bessel/y1.cpp @@ -1,12 +1,13 @@ -#include #include +#include /* Table[NumberForm[BesselY[1, x], 16], {x, {0.0, -10., 1.0, 8.0, 9.0, 10.0, 100.}}] */ -TEST(BesselY1, Branches) { - EXPECT_LE(cephes::y1(0.0), -1.0e308); // -Inf +TEST(BesselY1, Branches) +{ + EXPECT_LE(cephes::y1(0.0), -1.0e308); // -Inf // x < 0 // EXPECT_REL_NEAR_F64(cephes::y1(-10.0), ); diff --git a/tests/bessel/yn.cpp b/tests/bessel/yn.cpp index ed27d12..747ba58 100644 --- a/tests/bessel/yn.cpp +++ b/tests/bessel/yn.cpp @@ -1,15 +1,16 @@ -#include #include +#include /* Table[NumberForm[Exp[-Abs[x]]*BesselY[nv, x], 16], {nv, {0, 1, 10}}, {x, {0.0, 1.0, 8.0, 9.0, 1.0, 100.}}] */ -TEST(BesselYn, Branches) { +TEST(BesselYn, Branches) +{ EXPECT_LE(cephes::yn(0, 0.0), -1.0e308); // -Inf EXPECT_LE(cephes::yn(1, 0.0), -1.0e308); // -Inf - EXPECT_LE(cephes::yn(10, 0.0), -1.0e308); // -Inf + EXPECT_LE(cephes::yn(10, 0.0), -1.0e308); // -Inf // x < 0 // EXPECT_REL_NEAR_F64(cephes::yn(-10.0), ); diff --git a/tests/elliptic/ellie.cpp b/tests/elliptic/ellie.cpp index 82dc202..04c5881 100644 --- a/tests/elliptic/ellie.cpp +++ b/tests/elliptic/ellie.cpp @@ -1,8 +1,8 @@ -#include #include +#include - -TEST(EllipticEInc, Branches) { +TEST(EllipticEInc, Branches) +{ // m == 0.0 EXPECT_REL_NEAR_F64(cephes::ellie(3.0, 0.0), 3.0); } diff --git a/tests/elliptic/ellik.cpp b/tests/elliptic/ellik.cpp index 0deedca..b67cdad 100644 --- a/tests/elliptic/ellik.cpp +++ b/tests/elliptic/ellik.cpp @@ -1,8 +1,8 @@ -#include #include +#include - -TEST(EllipticKInc, Branches) { +TEST(EllipticKInc, Branches) +{ // m == 0.0 EXPECT_REL_NEAR_F64(cephes::ellik(3.0, 0.0), 3.0); } diff --git a/tests/elliptic/ellpe.cpp b/tests/elliptic/ellpe.cpp index d2157bb..7227ecb 100644 --- a/tests/elliptic/ellpe.cpp +++ b/tests/elliptic/ellpe.cpp @@ -1,8 +1,8 @@ -#include #include +#include - -TEST(EllipticE, Branches) { +TEST(EllipticE, Branches) +{ // x == 0.0 EXPECT_REL_NEAR_F64(cephes::ellpe(0.0), 1.0); } diff --git a/tests/elliptic/ellpj.cpp b/tests/elliptic/ellpj.cpp index 497c23d..e324252 100644 --- a/tests/elliptic/ellpj.cpp +++ b/tests/elliptic/ellpj.cpp @@ -1,8 +1,8 @@ -#include #include +#include - -TEST(EllipticJaco, Branches) { +TEST(EllipticJaco, Branches) +{ double u, m, sn, cn, dn, ph; // m < 0.0 || m > 1.0 u = 1.0; diff --git a/tests/elliptic/ellpk.cpp b/tests/elliptic/ellpk.cpp index 3a569b8..53e16dd 100644 --- a/tests/elliptic/ellpk.cpp +++ b/tests/elliptic/ellpk.cpp @@ -1,8 +1,8 @@ -#include #include +#include - -TEST(EllipticK, Branches) { +TEST(EllipticK, Branches) +{ // (x < 0.0) || (x > 1.0) EXPECT_REL_NEAR_F64(cephes::ellpk(-1.0), 0.0); EXPECT_REL_NEAR_F64(cephes::ellpk(2.0), 0.0); diff --git a/tests/error/CMakeLists.txt b/tests/error/CMakeLists.txt index 4a5bc86..c0cfa3a 100644 --- a/tests/error/CMakeLists.txt +++ b/tests/error/CMakeLists.txt @@ -1,7 +1,6 @@ add_gtest(erf) add_gtest(erfc) -add_gtest(ndtr) add_gtest(dawsn) add_gtest(fresnl) diff --git a/tests/error/dawsn.cpp b/tests/error/dawsn.cpp index ce14dc5..2cc61bd 100644 --- a/tests/error/dawsn.cpp +++ b/tests/error/dawsn.cpp @@ -1,7 +1,7 @@ -#include #include +#include - -TEST(Dawson, Branches) { +TEST(Dawson, Branches) +{ EXPECT_GT(cephes::dawsn(1.0), 0.0); } diff --git a/tests/error/erf.cpp b/tests/error/erf.cpp index 1982b3f..f2a36eb 100644 --- a/tests/error/erf.cpp +++ b/tests/error/erf.cpp @@ -1,8 +1,8 @@ -#include #include +#include - -TEST(Erf, Branches) { +TEST(Erf, Branches) +{ // fabs(x) > 1.0 EXPECT_REL_NEAR_F64(cephes::erf(20.0), 1.0); } diff --git a/tests/error/erfc.cpp b/tests/error/erfc.cpp index ff50e35..442fe58 100644 --- a/tests/error/erfc.cpp +++ b/tests/error/erfc.cpp @@ -1,8 +1,8 @@ -#include #include +#include - -TEST(ErfC, Branches) { +TEST(ErfC, Branches) +{ // z < -MAXLOG && a < 0 EXPECT_REL_NEAR_F64(cephes::erfc(-20.0), 2.0); } diff --git a/tests/error/fresnl.cpp b/tests/error/fresnl.cpp index 4193b96..3a8179b 100644 --- a/tests/error/fresnl.cpp +++ b/tests/error/fresnl.cpp @@ -1,8 +1,8 @@ -#include #include +#include - -TEST(Fresnel, Branches) { +TEST(Fresnel, Branches) +{ double x, s, c; EXPECT_REL_NEAR_F64(cephes::fresnl(1.0, &s, &c), 0.0); diff --git a/tests/exp_int/expn.cpp b/tests/exp_int/expn.cpp index 4fa840f..e224ae6 100644 --- a/tests/exp_int/expn.cpp +++ b/tests/exp_int/expn.cpp @@ -1,8 +1,8 @@ -#include #include +#include - -TEST(ExpN, Errors) { +TEST(ExpN, Errors) +{ // n < 0 EXPECT_TRUE(cephes::expn(-1, 10.0) > 1e308); // x < 0 @@ -13,7 +13,8 @@ TEST(ExpN, Errors) { EXPECT_TRUE(cephes::expn(1, 0.0) > 1e308); EXPECT_TRUE(cephes::expn(0, 0.0) > 1e308); } -TEST(ExpN, CodecovTodo) { +TEST(ExpN, CodecovTodo) +{ const double nan64 = std::numeric_limits::quiet_NaN(); // x==0.0 && n >= 2 diff --git a/tests/exp_int/shichi.cpp b/tests/exp_int/shichi.cpp index 2dd7dbc..bbca6a7 100644 --- a/tests/exp_int/shichi.cpp +++ b/tests/exp_int/shichi.cpp @@ -1,8 +1,8 @@ -#include #include +#include - -TEST(ShiChi, Errors) { +TEST(ShiChi, Errors) +{ int ret; double x, si, ci; @@ -12,7 +12,8 @@ TEST(ShiChi, Errors) { EXPECT_EQ(si, 0.0); EXPECT_LT(ci, -1e308); } -TEST(ShiChi, CodecovTodo) { +TEST(ShiChi, CodecovTodo) +{ const double nan64 = std::numeric_limits::quiet_NaN(); int ret; double x, si, ci; @@ -48,7 +49,7 @@ TEST(ShiChi, CodecovTodo) { EXPECT_EQ(ret, 0); EXPECT_NE(si, nan64); EXPECT_NE(ci, nan64); - + // x < 8.0 // power series expansion ret = cephes::shichi(3.0, &si, &ci); diff --git a/tests/exp_int/sici.cpp b/tests/exp_int/sici.cpp index 76924a8..0004fba 100644 --- a/tests/exp_int/sici.cpp +++ b/tests/exp_int/sici.cpp @@ -1,8 +1,8 @@ -#include #include +#include - -TEST(SiCi, Errors) { +TEST(SiCi, Errors) +{ int ret; double x, si, ci; @@ -12,7 +12,8 @@ TEST(SiCi, Errors) { EXPECT_EQ(si, 0.0); EXPECT_LT(ci, -1e308); } -TEST(SiCi, CodecovTodo) { +TEST(SiCi, CodecovTodo) +{ const double nan64 = std::numeric_limits::quiet_NaN(); int ret; double x, si, ci; diff --git a/tests/gamma/beta.cpp b/tests/gamma/beta.cpp index e59b0df..845af5f 100644 --- a/tests/gamma/beta.cpp +++ b/tests/gamma/beta.cpp @@ -1,9 +1,10 @@ -#include #include +#include - -TEST(Beta, BasicAssertions) { +TEST(Beta, BasicAssertions) +{ } -TEST(Beta, Branches) { - EXPECT_GT(cephes::beta(0.0, 0.0), 1.0e308); // +Inf +TEST(Beta, Branches) +{ + EXPECT_GT(cephes::beta(0.0, 0.0), 1.0e308); // +Inf } diff --git a/tests/gamma/fac.cpp b/tests/gamma/fac.cpp index 0bdc40f..6429ba4 100644 --- a/tests/gamma/fac.cpp +++ b/tests/gamma/fac.cpp @@ -1,8 +1,8 @@ -#include #include +#include - -TEST(Fac, BasicAssertions) { +TEST(Fac, BasicAssertions) +{ EXPECT_REL_NEAR_F64(cephes::fac(0.0), 1.0); EXPECT_REL_NEAR_F64(cephes::fac(1.0), 1.0); EXPECT_REL_NEAR_F64(cephes::fac(2.0), 2.0); diff --git a/tests/gamma/gamma.cpp b/tests/gamma/gamma.cpp index ed21d31..fb8a491 100644 --- a/tests/gamma/gamma.cpp +++ b/tests/gamma/gamma.cpp @@ -1,9 +1,12 @@ -#include #include +#include - -TEST(Gamma, BasicAssertions) { +TEST(Gamma, BasicAssertions) +{ EXPECT_TRUE(std::isnan(cephes::gamma(xtest::NaN64))); + EXPECT_TRUE(std::isnan(cephes::gamma(-xtest::NaN64))); + EXPECT_TRUE(std::isinf(cephes::gamma(xtest::Inf64))); + EXPECT_TRUE(std::isnan(cephes::gamma(-xtest::Inf64))); // gamma(-Inf) == NaN EXPECT_TRUE(std::isnan(cephes::gamma(0.0))); EXPECT_REL_NEAR_F64(cephes::gamma(1.0), 1.0); @@ -11,3 +14,221 @@ TEST(Gamma, BasicAssertions) { EXPECT_REL_NEAR_F64(cephes::gamma(3.0), 2.0); EXPECT_REL_NEAR_F64(cephes::gamma(10.0), 362880.0); } + +TEST(Gamma, BranchCov) +{ + // fabs(x) > 33.0 && x < 0.0 + EXPECT_REL_NEAR_F64(cephes::gamma(-33.1), 8.23969199675675e-37); + + // while (x < 0.0) + EXPECT_REL_NEAR_F64(cephes::gamma(-0.5), -3.544907701811032); + // while (x < 0.0) && x > -1.E-9 + EXPECT_REL_NEAR_F64(cephes::gamma(-1.0e-100), -1.0e100); + EXPECT_REL_NEAR_F64(cephes::gamma(-1.0e-300), -1.0e300); + // small: x < 1.e-9 && x != 0.0 + EXPECT_REL_NEAR_F64(cephes::gamma(1.0e-10), 9.999999999422785e9); + EXPECT_REL_NEAR_F64(cephes::gamma(1.0e-100), 1.0e100); + EXPECT_REL_NEAR_F64(cephes::gamma(1.0e-300), 1.0e300); +} + +/* Julia + SpecialFunctions (MPFR 4.2.0) +```jl +using SpecialFunctions +for i in 1:50 + gam = gamma(BigInt(i)/10) + f64 = Float64(gam) + println("EXPECT_REL_NEAR_F64(cephes::gamma($i/10.0), $f64);") +end +``` +*/ +// TABLE 3.11 Gamma Function +TEST(Gamma, CoSF_Table_3p1) { + EXPECT_REL_NEAR_F64(cephes::gamma(1/10.0), 9.513507698668732); + EXPECT_REL_NEAR_F64(cephes::gamma(2/10.0), 4.5908437119988035); + EXPECT_REL_NEAR_F64(cephes::gamma(3/10.0), 2.991568987687591); + EXPECT_REL_NEAR_F64(cephes::gamma(4/10.0), 2.218159543757688); + EXPECT_REL_NEAR_F64(cephes::gamma(5/10.0), 1.772453850905516); + EXPECT_REL_NEAR_F64(cephes::gamma(6/10.0), 1.489192248812817); + EXPECT_REL_NEAR_F64(cephes::gamma(7/10.0), 1.2980553326475577); + EXPECT_REL_NEAR_F64(cephes::gamma(8/10.0), 1.1642297137253035); + EXPECT_REL_NEAR_F64(cephes::gamma(9/10.0), 1.0686287021193193); + EXPECT_REL_NEAR_F64(cephes::gamma(10/10.0), 1.0); + EXPECT_REL_NEAR_F64(cephes::gamma(11/10.0), 0.9513507698668732); + EXPECT_REL_NEAR_F64(cephes::gamma(12/10.0), 0.9181687423997607); + EXPECT_REL_NEAR_F64(cephes::gamma(13/10.0), 0.8974706963062772); + EXPECT_REL_NEAR_F64(cephes::gamma(14/10.0), 0.8872638175030753); + EXPECT_REL_NEAR_F64(cephes::gamma(15/10.0), 0.886226925452758); + EXPECT_REL_NEAR_F64(cephes::gamma(16/10.0), 0.8935153492876903); + EXPECT_REL_NEAR_F64(cephes::gamma(17/10.0), 0.9086387328532904); + EXPECT_REL_NEAR_F64(cephes::gamma(18/10.0), 0.9313837709802427); + EXPECT_REL_NEAR_F64(cephes::gamma(19/10.0), 0.9617658319073874); + EXPECT_REL_NEAR_F64(cephes::gamma(20/10.0), 1.0); + EXPECT_REL_NEAR_F64(cephes::gamma(21/10.0), 1.0464858468535605); + EXPECT_REL_NEAR_F64(cephes::gamma(22/10.0), 1.1018024908797128); + EXPECT_REL_NEAR_F64(cephes::gamma(23/10.0), 1.1667119051981603); + EXPECT_REL_NEAR_F64(cephes::gamma(24/10.0), 1.2421693445043054); + EXPECT_REL_NEAR_F64(cephes::gamma(25/10.0), 1.329340388179137); + EXPECT_REL_NEAR_F64(cephes::gamma(26/10.0), 1.4296245588603045); + EXPECT_REL_NEAR_F64(cephes::gamma(27/10.0), 1.5446858458505939); + EXPECT_REL_NEAR_F64(cephes::gamma(28/10.0), 1.6764907877644368); + EXPECT_REL_NEAR_F64(cephes::gamma(29/10.0), 1.8273550806240362); + EXPECT_REL_NEAR_F64(cephes::gamma(30/10.0), 2.0); + EXPECT_REL_NEAR_F64(cephes::gamma(31/10.0), 2.197620278392477); + EXPECT_REL_NEAR_F64(cephes::gamma(32/10.0), 2.423965479935368); + EXPECT_REL_NEAR_F64(cephes::gamma(33/10.0), 2.683437381955769); + EXPECT_REL_NEAR_F64(cephes::gamma(34/10.0), 2.981206426810333); + EXPECT_REL_NEAR_F64(cephes::gamma(35/10.0), 3.3233509704478426); + EXPECT_REL_NEAR_F64(cephes::gamma(36/10.0), 3.7170238530367916); + EXPECT_REL_NEAR_F64(cephes::gamma(37/10.0), 4.170651783796603); + EXPECT_REL_NEAR_F64(cephes::gamma(38/10.0), 4.694174205740423); + EXPECT_REL_NEAR_F64(cephes::gamma(39/10.0), 5.299329733809705); + EXPECT_REL_NEAR_F64(cephes::gamma(40/10.0), 6.0); + EXPECT_REL_NEAR_F64(cephes::gamma(41/10.0), 6.812622863016679); + EXPECT_REL_NEAR_F64(cephes::gamma(42/10.0), 7.7566895357931775); + EXPECT_REL_NEAR_F64(cephes::gamma(43/10.0), 8.855343360454038); + EXPECT_REL_NEAR_F64(cephes::gamma(44/10.0), 10.136101851155132); + EXPECT_REL_NEAR_F64(cephes::gamma(45/10.0), 11.631728396567448); + EXPECT_REL_NEAR_F64(cephes::gamma(46/10.0), 13.38128587093245); + EXPECT_REL_NEAR_F64(cephes::gamma(47/10.0), 15.431411600047431); + EXPECT_REL_NEAR_F64(cephes::gamma(48/10.0), 17.837861981813607); + EXPECT_REL_NEAR_F64(cephes::gamma(49/10.0), 20.66738596185785); + EXPECT_REL_NEAR_F64(cephes::gamma(50/10.0), 24.0); +} + +/* Julia + SpecialFunctions (MPFR 4.2.0) +```jl +using SpecialFunctions +for i in 0:100 + gam = gamma(BigInt(i+1)) + f64 = Float64(gam) + println("EXPECT_REL_NEAR_F64(cephes::gamma($i+1), $f64);") +end +``` +*/ +// TABLE 3.2 Gamma Function for Integers +TEST(Gamma, CoSF_Table_3p2) { + EXPECT_REL_NEAR_F64(cephes::gamma(0+1), 1.0); + EXPECT_REL_NEAR_F64(cephes::gamma(1+1), 1.0); + EXPECT_REL_NEAR_F64(cephes::gamma(2+1), 2.0); + EXPECT_REL_NEAR_F64(cephes::gamma(3+1), 6.0); + EXPECT_REL_NEAR_F64(cephes::gamma(4+1), 24.0); + EXPECT_REL_NEAR_F64(cephes::gamma(5+1), 120.0); + EXPECT_REL_NEAR_F64(cephes::gamma(6+1), 720.0); + EXPECT_REL_NEAR_F64(cephes::gamma(7+1), 5040.0); + EXPECT_REL_NEAR_F64(cephes::gamma(8+1), 40320.0); + EXPECT_REL_NEAR_F64(cephes::gamma(9+1), 362880.0); + EXPECT_REL_NEAR_F64(cephes::gamma(10+1), 3.6288e6); + EXPECT_REL_NEAR_F64(cephes::gamma(11+1), 3.99168e7); + EXPECT_REL_NEAR_F64(cephes::gamma(12+1), 4.790016e8); + EXPECT_REL_NEAR_F64(cephes::gamma(13+1), 6.2270208e9); + EXPECT_REL_NEAR_F64(cephes::gamma(14+1), 8.71782912e10); + EXPECT_REL_NEAR_F64(cephes::gamma(15+1), 1.307674368e12); + EXPECT_REL_NEAR_F64(cephes::gamma(16+1), 2.0922789888e13); + EXPECT_REL_NEAR_F64(cephes::gamma(17+1), 3.55687428096e14); + EXPECT_REL_NEAR_F64(cephes::gamma(18+1), 6.402373705728e15); + EXPECT_REL_NEAR_F64(cephes::gamma(19+1), 1.21645100408832e17); + EXPECT_REL_NEAR_F64(cephes::gamma(20+1), 2.43290200817664e18); + EXPECT_REL_NEAR_F64(cephes::gamma(21+1), 5.109094217170944e19); + EXPECT_REL_NEAR_F64(cephes::gamma(22+1), 1.1240007277776077e21); + EXPECT_REL_NEAR_F64(cephes::gamma(23+1), 2.585201673888498e22); + EXPECT_REL_NEAR_F64(cephes::gamma(24+1), 6.204484017332394e23); + EXPECT_REL_NEAR_F64(cephes::gamma(25+1), 1.5511210043330986e25); + EXPECT_REL_NEAR_F64(cephes::gamma(26+1), 4.0329146112660565e26); + EXPECT_REL_NEAR_F64(cephes::gamma(27+1), 1.0888869450418352e28); + EXPECT_REL_NEAR_F64(cephes::gamma(28+1), 3.0488834461171387e29); + EXPECT_REL_NEAR_F64(cephes::gamma(29+1), 8.841761993739702e30); + EXPECT_REL_NEAR_F64(cephes::gamma(30+1), 2.6525285981219107e32); + EXPECT_REL_NEAR_F64(cephes::gamma(31+1), 8.222838654177922e33); + EXPECT_REL_NEAR_F64(cephes::gamma(32+1), 2.631308369336935e35); + EXPECT_REL_NEAR_F64(cephes::gamma(33+1), 8.683317618811886e36); + EXPECT_REL_NEAR_F64(cephes::gamma(34+1), 2.9523279903960416e38); + EXPECT_REL_NEAR_F64(cephes::gamma(35+1), 1.0333147966386145e40); + EXPECT_REL_NEAR_F64(cephes::gamma(36+1), 3.7199332678990125e41); + EXPECT_REL_NEAR_F64(cephes::gamma(37+1), 1.3763753091226346e43); + EXPECT_REL_NEAR_F64(cephes::gamma(38+1), 5.230226174666011e44); + EXPECT_REL_NEAR_F64(cephes::gamma(39+1), 2.0397882081197444e46); + EXPECT_REL_NEAR_F64(cephes::gamma(40+1), 8.159152832478977e47); + EXPECT_REL_NEAR_F64(cephes::gamma(41+1), 3.345252661316381e49); + EXPECT_REL_NEAR_F64(cephes::gamma(42+1), 1.40500611775288e51); + EXPECT_REL_NEAR_F64(cephes::gamma(43+1), 6.041526306337383e52); + EXPECT_REL_NEAR_F64(cephes::gamma(44+1), 2.658271574788449e54); + EXPECT_REL_NEAR_F64(cephes::gamma(45+1), 1.1962222086548019e56); + EXPECT_REL_NEAR_F64(cephes::gamma(46+1), 5.502622159812089e57); + EXPECT_REL_NEAR_F64(cephes::gamma(47+1), 2.5862324151116818e59); + EXPECT_REL_NEAR_F64(cephes::gamma(48+1), 1.2413915592536073e61); + EXPECT_REL_NEAR_F64(cephes::gamma(49+1), 6.082818640342675e62); + EXPECT_REL_NEAR_F64(cephes::gamma(50+1), 3.0414093201713376e64); + EXPECT_REL_NEAR_F64(cephes::gamma(51+1), 1.5511187532873822e66); + EXPECT_REL_NEAR_F64(cephes::gamma(52+1), 8.065817517094388e67); + EXPECT_REL_NEAR_F64(cephes::gamma(53+1), 4.2748832840600255e69); + EXPECT_REL_NEAR_F64(cephes::gamma(54+1), 2.308436973392414e71); + EXPECT_REL_NEAR_F64(cephes::gamma(55+1), 1.2696403353658276e73); + EXPECT_REL_NEAR_F64(cephes::gamma(56+1), 7.109985878048635e74); + EXPECT_REL_NEAR_F64(cephes::gamma(57+1), 4.0526919504877214e76); + EXPECT_REL_NEAR_F64(cephes::gamma(58+1), 2.3505613312828785e78); + EXPECT_REL_NEAR_F64(cephes::gamma(59+1), 1.3868311854568984e80); + EXPECT_REL_NEAR_F64(cephes::gamma(60+1), 8.32098711274139e81); + EXPECT_REL_NEAR_F64(cephes::gamma(61+1), 5.075802138772248e83); + EXPECT_REL_NEAR_F64(cephes::gamma(62+1), 3.146997326038794e85); + EXPECT_REL_NEAR_F64(cephes::gamma(63+1), 1.98260831540444e87); + EXPECT_REL_NEAR_F64(cephes::gamma(64+1), 1.2688693218588417e89); + EXPECT_REL_NEAR_F64(cephes::gamma(65+1), 8.247650592082472e90); + EXPECT_REL_NEAR_F64(cephes::gamma(66+1), 5.443449390774431e92); + EXPECT_REL_NEAR_F64(cephes::gamma(67+1), 3.647111091818868e94); + EXPECT_REL_NEAR_F64(cephes::gamma(68+1), 2.4800355424368305e96); + EXPECT_REL_NEAR_F64(cephes::gamma(69+1), 1.711224524281413e98); + EXPECT_REL_NEAR_F64(cephes::gamma(70+1), 1.1978571669969892e100); + EXPECT_REL_NEAR_F64(cephes::gamma(71+1), 8.504785885678623e101); + EXPECT_REL_NEAR_F64(cephes::gamma(72+1), 6.1234458376886085e103); + EXPECT_REL_NEAR_F64(cephes::gamma(73+1), 4.4701154615126844e105); + EXPECT_REL_NEAR_F64(cephes::gamma(74+1), 3.307885441519386e107); + EXPECT_REL_NEAR_F64(cephes::gamma(75+1), 2.48091408113954e109); + EXPECT_REL_NEAR_F64(cephes::gamma(76+1), 1.8854947016660504e111); + EXPECT_REL_NEAR_F64(cephes::gamma(77+1), 1.4518309202828587e113); + EXPECT_REL_NEAR_F64(cephes::gamma(78+1), 1.1324281178206297e115); + EXPECT_REL_NEAR_F64(cephes::gamma(79+1), 8.946182130782976e116); + EXPECT_REL_NEAR_F64(cephes::gamma(80+1), 7.156945704626381e118); + EXPECT_REL_NEAR_F64(cephes::gamma(81+1), 5.797126020747368e120); + EXPECT_REL_NEAR_F64(cephes::gamma(82+1), 4.753643337012842e122); + EXPECT_REL_NEAR_F64(cephes::gamma(83+1), 3.945523969720659e124); + EXPECT_REL_NEAR_F64(cephes::gamma(84+1), 3.314240134565353e126); + EXPECT_REL_NEAR_F64(cephes::gamma(85+1), 2.81710411438055e128); + EXPECT_REL_NEAR_F64(cephes::gamma(86+1), 2.4227095383672734e130); + EXPECT_REL_NEAR_F64(cephes::gamma(87+1), 2.107757298379528e132); + EXPECT_REL_NEAR_F64(cephes::gamma(88+1), 1.8548264225739844e134); + EXPECT_REL_NEAR_F64(cephes::gamma(89+1), 1.650795516090846e136); + EXPECT_REL_NEAR_F64(cephes::gamma(90+1), 1.4857159644817615e138); + EXPECT_REL_NEAR_F64(cephes::gamma(91+1), 1.352001527678403e140); + EXPECT_REL_NEAR_F64(cephes::gamma(92+1), 1.2438414054641308e142); + EXPECT_REL_NEAR_F64(cephes::gamma(93+1), 1.1567725070816416e144); + EXPECT_REL_NEAR_F64(cephes::gamma(94+1), 1.087366156656743e146); + EXPECT_REL_NEAR_F64(cephes::gamma(95+1), 1.032997848823906e148); + EXPECT_REL_NEAR_F64(cephes::gamma(96+1), 9.916779348709496e149); + EXPECT_REL_NEAR_F64(cephes::gamma(97+1), 9.619275968248212e151); + EXPECT_REL_NEAR_F64(cephes::gamma(98+1), 9.426890448883248e153); + EXPECT_REL_NEAR_F64(cephes::gamma(99+1), 9.332621544394415e155); + EXPECT_REL_NEAR_F64(cephes::gamma(100+1), 9.332621544394415e157); +} + +/* Julia + SpecialFunctions (MPFR 4.2.0) +```jl +using SpecialFunctions +for i in 100:10:200 + gam = gamma(BigInt(i+1)) + f64 = Float64(gam) + println("EXPECT_REL_NEAR_F64(cephes::gamma($i+1), $f64);") +end +``` +*/ +// TABLE 3.3 Gamma Function for Large Integers +TEST(Gamma, CoSF_Table_3p3) { + EXPECT_REL_NEAR_F64(cephes::gamma(100+1), 9.332621544394415e157); + EXPECT_REL_NEAR_F64(cephes::gamma(110+1), 1.588245541522743e178); + EXPECT_REL_NEAR_F64(cephes::gamma(120+1), 6.689502913449127e198); + EXPECT_REL_NEAR_F64(cephes::gamma(130+1), 6.466855489220474e219); + EXPECT_REL_NEAR_F64(cephes::gamma(140+1), 1.3462012475717526e241); + EXPECT_REL_NEAR_F64(cephes::gamma(150+1), 5.713383956445855e262); + EXPECT_REL_NEAR_F64(cephes::gamma(160+1), 4.7147236359920616e284); + EXPECT_REL_NEAR_F64(cephes::gamma(170+1), 7.257415615307999e306); + // EXPECT_REL_NEAR_F64(cephes::gamma(180+1), Inf); +} diff --git a/tests/gamma/igam.cpp b/tests/gamma/igam.cpp index a40ec0f..63fc8e5 100644 --- a/tests/gamma/igam.cpp +++ b/tests/gamma/igam.cpp @@ -1,11 +1,11 @@ -#include #include +#include - -TEST(GammaInc, BasicAssertions) { - +TEST(GammaInc, BasicAssertions) +{ } -TEST(GammaInc, Branches) { +TEST(GammaInc, Branches) +{ // x == 0 EXPECT_REL_NEAR_F64(cephes::igam(1.0, 0.0), 0.0); // x < 0 diff --git a/tests/gamma/igamc.cpp b/tests/gamma/igamc.cpp index 988ed40..1a56743 100644 --- a/tests/gamma/igamc.cpp +++ b/tests/gamma/igamc.cpp @@ -1,11 +1,11 @@ -#include #include +#include - -TEST(GammaIncc, BasicAssertions) { - +TEST(GammaIncc, BasicAssertions) +{ } -TEST(GammaIncc, Branches) { +TEST(GammaIncc, Branches) +{ // x < 0 EXPECT_TRUE(std::isnan(cephes::igamc(1.0, -1.0))); // a <= 0 diff --git a/tests/gamma/igami.cpp b/tests/gamma/igami.cpp index ad918f6..857e8d2 100644 --- a/tests/gamma/igami.cpp +++ b/tests/gamma/igami.cpp @@ -1,9 +1,10 @@ -#include #include +#include - -TEST(GammaInccInv, BasicAssertions) { +TEST(GammaInccInv, BasicAssertions) +{ EXPECT_REL_NEAR_F64(cephes::igami(0.5, 1.0), 0.0); } -TEST(GammaInccInv, Branches) { +TEST(GammaInccInv, Branches) +{ } diff --git a/tests/gamma/incbet.cpp b/tests/gamma/incbet.cpp index f1ff242..affce57 100644 --- a/tests/gamma/incbet.cpp +++ b/tests/gamma/incbet.cpp @@ -1,11 +1,11 @@ -#include #include +#include - -TEST(BetaInc, BasicAssertions) { - +TEST(BetaInc, BasicAssertions) +{ } -TEST(BetaInc, Branches) { +TEST(BetaInc, Branches) +{ // aa <= 0.0 || bb <= 0.0 EXPECT_REL_NEAR_F64(cephes::incbet(0.0, 1.0, 1.0), 0.0); EXPECT_REL_NEAR_F64(cephes::incbet(1.0, 0.0, 1.0), 0.0); diff --git a/tests/gamma/incbi.cpp b/tests/gamma/incbi.cpp index 5f28aa3..773587d 100644 --- a/tests/gamma/incbi.cpp +++ b/tests/gamma/incbi.cpp @@ -1,11 +1,11 @@ -#include #include +#include - -TEST(BetaIncInv, BasicAssertions) { - +TEST(BetaIncInv, BasicAssertions) +{ } -TEST(BetaIncInv, Branches) { +TEST(BetaIncInv, Branches) +{ // yy0 <= 0 EXPECT_REL_NEAR_F64(cephes::incbi(1.0, 1.0, -1.0), 0.0); } diff --git a/tests/gamma/lgam.cpp b/tests/gamma/lgam.cpp index a1e0d4d..7cf9b1e 100644 --- a/tests/gamma/lgam.cpp +++ b/tests/gamma/lgam.cpp @@ -1,11 +1,94 @@ -#include #include +#include - -TEST(LnGamma, BasicAssertions) { +TEST(LogGamma, BasicAssertions) +{ EXPECT_TRUE(std::isnan(cephes::lgam(xtest::NaN64))); EXPECT_TRUE(std::isinf(cephes::lgam(xtest::Inf64))); EXPECT_TRUE(std::isinf(cephes::lgam(0.0))); EXPECT_REL_NEAR_F64(cephes::lgam(1.0), 0.0); } + +TEST(LogGamma, BranchCov) +{ + // if (x < -34.0) + EXPECT_TRUE(std::isinf(cephes::lgam(-35.0))); + EXPECT_REL_NEAR_F64(cephes::lgam(-35.1), -90.17418399135259); + + // if (x < 13.0) && if (z < 0.0) + + // if (x > MAXLGM) + EXPECT_TRUE(std::isinf(cephes::lgam(2.6e305))); + EXPECT_TRUE(std::isinf(cephes::lgam(xtest::Inf64))); + // (x <= MAXLGM) && (x > 1.0e8) + EXPECT_REL_NEAR_F64(cephes::lgam(2.0e8), 3.622765576264487e9); + // (x <= MAXLGM) && (x <= 1.0e8) && (x >= 1000.0) + EXPECT_REL_NEAR_F64(cephes::lgam(1.0e8), 1.7420680661038346e9); +} + +/* Julia + SpecialFunctions (MPFR 4.2.0) +```jl +using SpecialFunctions +for i in 0:50 + gam = loggamma(BigInt(i)/10) + f64 = Float64(gam) + println("EXPECT_REL_NEAR_F64(cephes::lgam($i/10.0), $f64);") +end +``` +*/ +// TABLE 3.11 Gamma Function +TEST(LogGamma, CoSF_Table_3p1) +{ + // EXPECT_REL_NEAR_F64(cephes::lgam(0/10.0), Inf); + EXPECT_REL_NEAR_F64(cephes::lgam(1/10.0), 2.252712651734206); + EXPECT_REL_NEAR_F64(cephes::lgam(2/10.0), 1.5240638224307845); + EXPECT_REL_NEAR_F64(cephes::lgam(3/10.0), 1.0957979948180756); + EXPECT_REL_NEAR_F64(cephes::lgam(4/10.0), 0.7966778177017838); + EXPECT_REL_NEAR_F64(cephes::lgam(5/10.0), 0.5723649429247001); + EXPECT_REL_NEAR_F64(cephes::lgam(6/10.0), 0.3982338580692349); + EXPECT_REL_NEAR_F64(cephes::lgam(7/10.0), 0.26086724653166654); + EXPECT_REL_NEAR_F64(cephes::lgam(8/10.0), 0.15205967839983758); + EXPECT_REL_NEAR_F64(cephes::lgam(9/10.0), 0.06637623973474296); + EXPECT_REL_NEAR_F64(cephes::lgam(10/10.0), 0.0); + EXPECT_REL_NEAR_F64(cephes::lgam(11/10.0), -0.04987244125983972); + EXPECT_REL_NEAR_F64(cephes::lgam(12/10.0), -0.08537409000331585); + EXPECT_REL_NEAR_F64(cephes::lgam(13/10.0), -0.10817480950786047); + EXPECT_REL_NEAR_F64(cephes::lgam(14/10.0), -0.1196129141723713); + EXPECT_REL_NEAR_F64(cephes::lgam(15/10.0), -0.12078223763524522); + EXPECT_REL_NEAR_F64(cephes::lgam(16/10.0), -0.11259176569675579); + EXPECT_REL_NEAR_F64(cephes::lgam(17/10.0), -0.09580769740706586); + EXPECT_REL_NEAR_F64(cephes::lgam(18/10.0), -0.07108387291437217); + EXPECT_REL_NEAR_F64(cephes::lgam(19/10.0), -0.03898427592308333); + EXPECT_REL_NEAR_F64(cephes::lgam(20/10.0), 0.0); + EXPECT_REL_NEAR_F64(cephes::lgam(21/10.0), 0.045437738544485136); + EXPECT_REL_NEAR_F64(cephes::lgam(22/10.0), 0.09694746679063877); + EXPECT_REL_NEAR_F64(cephes::lgam(23/10.0), 0.15418945495963057); + EXPECT_REL_NEAR_F64(cephes::lgam(24/10.0), 0.21685932244884162); + EXPECT_REL_NEAR_F64(cephes::lgam(25/10.0), 0.2846828704729192); + EXPECT_REL_NEAR_F64(cephes::lgam(26/10.0), 0.35741186354897975); + EXPECT_REL_NEAR_F64(cephes::lgam(27/10.0), 0.4348205536551045); + EXPECT_REL_NEAR_F64(cephes::lgam(28/10.0), 0.5167027919877468); + EXPECT_REL_NEAR_F64(cephes::lgam(29/10.0), 0.6028696102493114); + EXPECT_REL_NEAR_F64(cephes::lgam(30/10.0), 0.6931471805599453); + EXPECT_REL_NEAR_F64(cephes::lgam(31/10.0), 0.7873750832738624); + EXPECT_REL_NEAR_F64(cephes::lgam(32/10.0), 0.885404827154909); + EXPECT_REL_NEAR_F64(cephes::lgam(33/10.0), 0.9870985778947345); + EXPECT_REL_NEAR_F64(cephes::lgam(34/10.0), 1.0923280598027416); + EXPECT_REL_NEAR_F64(cephes::lgam(35/10.0), 1.2009736023470743); + EXPECT_REL_NEAR_F64(cephes::lgam(36/10.0), 1.312923308576416); + EXPECT_REL_NEAR_F64(cephes::lgam(37/10.0), 1.4280723266653879); + EXPECT_REL_NEAR_F64(cephes::lgam(38/10.0), 1.546322209168905); + EXPECT_REL_NEAR_F64(cephes::lgam(39/10.0), 1.6675803472417399); + EXPECT_REL_NEAR_F64(cephes::lgam(40/10.0), 1.791759469228055); + EXPECT_REL_NEAR_F64(cephes::lgam(41/10.0), 1.918777194764963); + EXPECT_REL_NEAR_F64(cephes::lgam(42/10.0), 2.04855563696059); + EXPECT_REL_NEAR_F64(cephes::lgam(43/10.0), 2.181021046367169); + EXPECT_REL_NEAR_F64(cephes::lgam(44/10.0), 2.3161034914248573); + EXPECT_REL_NEAR_F64(cephes::lgam(45/10.0), 2.4537365708424423); + EXPECT_REL_NEAR_F64(cephes::lgam(46/10.0), 2.5938571540384805); + EXPECT_REL_NEAR_F64(cephes::lgam(47/10.0), 2.7364051463155667); + EXPECT_REL_NEAR_F64(cephes::lgam(48/10.0), 2.881323275901245); + EXPECT_REL_NEAR_F64(cephes::lgam(49/10.0), 3.0285569003773407); + EXPECT_REL_NEAR_F64(cephes::lgam(50/10.0), 3.1780538303479458); +} diff --git a/tests/gamma/psi.cpp b/tests/gamma/psi.cpp index 775a346..6a88ecf 100644 --- a/tests/gamma/psi.cpp +++ b/tests/gamma/psi.cpp @@ -1,11 +1,11 @@ -#include #include +#include /* Table[NumberForm[PolyGamma[0, x], 16], {x, {0.0, -10., 1.0, 8.0, 9.0, 10.0, 100.}}] */ -TEST(DiGammaPsi, Branches) { - EXPECT_GT(cephes::psi(0.0), 1.0e308); // +Inf - +TEST(DiGammaPsi, Branches) +{ + EXPECT_GT(cephes::psi(0.0), 1.0e308); // +Inf } diff --git a/tests/gamma/rgamma.cpp b/tests/gamma/rgamma.cpp index 48135a4..7348901 100644 --- a/tests/gamma/rgamma.cpp +++ b/tests/gamma/rgamma.cpp @@ -1,11 +1,78 @@ -#include #include +#include - -TEST(RGamma, BasicAssertions) { +TEST(RGamma, BasicAssertions) +{ EXPECT_REL_NEAR_F64(cephes::rgamma(0.0), 0.0); EXPECT_REL_NEAR_F64(cephes::rgamma(1.0), 1.0); EXPECT_REL_NEAR_F64(cephes::rgamma(2.0), 1.0); } -TEST(RGamma, Branches) { +TEST(RGamma, Branches) +{ +} + +/* Julia + SpecialFunctions (MPFR 4.2.0) +```jl +using SpecialFunctions +for i in 0:50 + rgam = big"1" / gamma(BigInt(i)/10) + f64 = Float64(rgam) + println(" EXPECT_REL_NEAR_F64(cephes::rgamma($i/10.0), $f64);") +end +``` +*/ +// TABLE 3.11 Gamma Function +TEST(RGamma, CoSF_Table_3p1) +{ + EXPECT_REL_NEAR_F64(cephes::rgamma(0/10.0), 0.0); + EXPECT_REL_NEAR_F64(cephes::rgamma(1/10.0), 0.10511370061117778); + EXPECT_REL_NEAR_F64(cephes::rgamma(2/10.0), 0.21782488421166726); + EXPECT_REL_NEAR_F64(cephes::rgamma(3/10.0), 0.33427275256419053); + EXPECT_REL_NEAR_F64(cephes::rgamma(4/10.0), 0.4508241991944111); + EXPECT_REL_NEAR_F64(cephes::rgamma(5/10.0), 0.5641895835477563); + EXPECT_REL_NEAR_F64(cephes::rgamma(6/10.0), 0.6715049724420734); + EXPECT_REL_NEAR_F64(cephes::rgamma(7/10.0), 0.770383183866566); + EXPECT_REL_NEAR_F64(cephes::rgamma(8/10.0), 0.8589370192246675); + EXPECT_REL_NEAR_F64(cephes::rgamma(9/10.0), 0.9357787209128727); + EXPECT_REL_NEAR_F64(cephes::rgamma(10/10.0), 1.0); + EXPECT_REL_NEAR_F64(cephes::rgamma(11/10.0), 1.0511370061117777); + EXPECT_REL_NEAR_F64(cephes::rgamma(12/10.0), 1.0891244210583364); + EXPECT_REL_NEAR_F64(cephes::rgamma(13/10.0), 1.1142425085473018); + EXPECT_REL_NEAR_F64(cephes::rgamma(14/10.0), 1.1270604979860277); + EXPECT_REL_NEAR_F64(cephes::rgamma(15/10.0), 1.1283791670955126); + EXPECT_REL_NEAR_F64(cephes::rgamma(16/10.0), 1.1191749540701224); + EXPECT_REL_NEAR_F64(cephes::rgamma(17/10.0), 1.1005474055236657); + EXPECT_REL_NEAR_F64(cephes::rgamma(18/10.0), 1.0736712740308343); + EXPECT_REL_NEAR_F64(cephes::rgamma(19/10.0), 1.0397541343476364); + EXPECT_REL_NEAR_F64(cephes::rgamma(20/10.0), 1.0); + EXPECT_REL_NEAR_F64(cephes::rgamma(21/10.0), 0.9555790964652525); + EXPECT_REL_NEAR_F64(cephes::rgamma(22/10.0), 0.9076036842152803); + EXPECT_REL_NEAR_F64(cephes::rgamma(23/10.0), 0.8571096219594629); + EXPECT_REL_NEAR_F64(cephes::rgamma(24/10.0), 0.8050432128471626); + EXPECT_REL_NEAR_F64(cephes::rgamma(25/10.0), 0.7522527780636751); + EXPECT_REL_NEAR_F64(cephes::rgamma(26/10.0), 0.6994843462938264); + EXPECT_REL_NEAR_F64(cephes::rgamma(27/10.0), 0.6473808267786268); + EXPECT_REL_NEAR_F64(cephes::rgamma(28/10.0), 0.5964840411282413); + EXPECT_REL_NEAR_F64(cephes::rgamma(29/10.0), 0.5472390180777034); + EXPECT_REL_NEAR_F64(cephes::rgamma(30/10.0), 0.5); + EXPECT_REL_NEAR_F64(cephes::rgamma(31/10.0), 0.4550376649834536); + EXPECT_REL_NEAR_F64(cephes::rgamma(32/10.0), 0.41254712918876374); + EXPECT_REL_NEAR_F64(cephes::rgamma(33/10.0), 0.3726563573736795); + EXPECT_REL_NEAR_F64(cephes::rgamma(34/10.0), 0.3354346720196511); + EXPECT_REL_NEAR_F64(cephes::rgamma(35/10.0), 0.30090111122547003); + EXPECT_REL_NEAR_F64(cephes::rgamma(36/10.0), 0.26903244088224093); + EXPECT_REL_NEAR_F64(cephes::rgamma(37/10.0), 0.23977067658467663); + EXPECT_REL_NEAR_F64(cephes::rgamma(38/10.0), 0.2130300146886576); + EXPECT_REL_NEAR_F64(cephes::rgamma(39/10.0), 0.18870310968196669); + EXPECT_REL_NEAR_F64(cephes::rgamma(40/10.0), 0.16666666666666666); + EXPECT_REL_NEAR_F64(cephes::rgamma(41/10.0), 0.14678634354304954); + EXPECT_REL_NEAR_F64(cephes::rgamma(42/10.0), 0.12892097787148868); + EXPECT_REL_NEAR_F64(cephes::rgamma(43/10.0), 0.11292616890111501); + EXPECT_REL_NEAR_F64(cephes::rgamma(44/10.0), 0.09865725647636797); + EXPECT_REL_NEAR_F64(cephes::rgamma(45/10.0), 0.08597174606442); + EXPECT_REL_NEAR_F64(cephes::rgamma(46/10.0), 0.07473123357840025); + EXPECT_REL_NEAR_F64(cephes::rgamma(47/10.0), 0.06480288556342612); + EXPECT_REL_NEAR_F64(cephes::rgamma(48/10.0), 0.056060530181225685); + EXPECT_REL_NEAR_F64(cephes::rgamma(49/10.0), 0.048385412738965815); + EXPECT_REL_NEAR_F64(cephes::rgamma(50/10.0), 0.041666666666666664); } diff --git a/tests/hyper/hyp2f1.cpp b/tests/hyper/hyp2f1.cpp index 37261a0..be2c2b4 100644 --- a/tests/hyper/hyp2f1.cpp +++ b/tests/hyper/hyp2f1.cpp @@ -1,8 +1,8 @@ -#include #include +#include - -TEST(Hyp2f1, Errors) { +TEST(Hyp2f1, Errors) +{ double a, b, c, x, y, y_ref; // c is a negative integer @@ -12,6 +12,7 @@ TEST(Hyp2f1, Errors) { EXPECT_GT(cephes::hyp2f1(2.0, 3.0, 4.0, 2.0), 1e308); } -TEST(Hyp2f1, Branches) { +TEST(Hyp2f1, Branches) +{ double a, b, c, x, y, y_ref; } diff --git a/tests/hyper/hyperg.cpp b/tests/hyper/hyperg.cpp index e19a09c..c76117f 100644 --- a/tests/hyper/hyperg.cpp +++ b/tests/hyper/hyperg.cpp @@ -1,7 +1,7 @@ -#include #include +#include - -TEST(Hyp2f1, Branches) { +TEST(Hyp2f1, Branches) +{ EXPECT_GT(cephes::hyperg(1.0, 2.0, 3.0), 0.0); } diff --git a/tests/include/xtest.hpp b/tests/include/xtest.hpp index 1926d49..7838d8c 100644 --- a/tests/include/xtest.hpp +++ b/tests/include/xtest.hpp @@ -1,42 +1,40 @@ #pragma once -#include #include -#include #include +#include +#include /** * @param _y_expr Your `expr` to be evalute * @param _ref_expr Reference value * @param _rel_tol Rel Tolence - * + * * - When `_ref_expr == 0`, `abs_tol = _rel_tol` * - else: `abs_tol = _rel_tol * abs(_ref_expr)` */ -#define EXPECT_REL_NEAR_F64_(_y_expr, _ref_expr, _rel_tol) \ - do { \ - double __xtest_y_ref__ = (_ref_expr); \ - double __xtest_y_level = (__xtest_y_ref__==0) ? 1.0 : std::abs(__xtest_y_ref__); \ - double __xtest_abs_tol = (_rel_tol) * __xtest_y_level; \ - EXPECT_NEAR((_y_expr), __xtest_y_ref__, __xtest_abs_tol) \ - << "rel_tol = " << _rel_tol; \ +#define EXPECT_REL_NEAR_F64_(_y_expr, _ref_expr, _rel_tol) \ + do \ + { \ + double __xtest_y_ref__ = (_ref_expr); \ + double __xtest_y_level = (__xtest_y_ref__ == 0) ? 1.0 : std::abs(__xtest_y_ref__); \ + double __xtest_abs_tol = (_rel_tol) * __xtest_y_level; \ + EXPECT_NEAR((_y_expr), __xtest_y_ref__, __xtest_abs_tol) << "rel_tol = " << _rel_tol; \ } while (0); -#define EXPECT_REL_NEAR_F64(_y_expr, _ref_expr) \ - EXPECT_REL_NEAR_F64_(_y_expr, _ref_expr, xtest::RelTolF64) +#define EXPECT_REL_NEAR_F64(_y_expr, _ref_expr) EXPECT_REL_NEAR_F64_(_y_expr, _ref_expr, xtest::RelTolF64) /** * Need local var: `x`, `VAR`, `VAR_ref` */ -#define XTEST_ISAPPROX_F64(_var_name) \ - do { \ - EXPECT_TRUE(xtest::isapprox(_var_name ## _ref, _var_name)) \ - << "x = " << x \ - << "\n Want ref = " << _var_name ## _ref \ - << "\n Got y = " << _var_name; \ +#define XTEST_ISAPPROX_F64(_var_name) \ + do \ + { \ + EXPECT_TRUE(xtest::isapprox(_var_name##_ref, _var_name)) \ + << "x = " << x << "\n Want ref = " << _var_name##_ref << "\n Got y = " << _var_name; \ } while (0); // END define XTEST_ISAPPROX - -namespace xtest { +namespace xtest +{ // Constant constexpr float Inf32 = std::numeric_limits::infinity(); @@ -50,27 +48,29 @@ copy form: julia's isapprox: */ // Floating-point types -template , int> = 0> -constexpr T rel_tol_default() { +template , int> = 0> constexpr T rel_tol_default() +{ return std::sqrt(std::numeric_limits::epsilon()); }; // Real (non-floating-point) types -template , int> = 0> -constexpr T rel_tol_default() { return 0; }; +template , int> = 0> constexpr T rel_tol_default() +{ + return 0; +}; /** Default relative tolerance for `float` type */ const double RelTolF32 = rel_tol_default(); /** Default relative tolerance for `double` type */ const double RelTolF64 = rel_tol_default(); -template -bool isapprox(T x, T y, T rel_tol=rel_tol_default()) { +template bool isapprox(T x, T y, T rel_tol = rel_tol_default()) +{ assert(rel_tol >= 0); return (x == y) - // rel_error <= rel_tol - || std::abs(x - y) <= (rel_tol * std::max(std::abs(x), std::abs(y))) - // NaN == x == y - || std::isnan(x) && std::isnan(y); + // rel_error <= rel_tol + || std::abs(x - y) <= (rel_tol * std::max(std::abs(x), std::abs(y))) + // NaN == x == y + || std::isnan(x) && std::isnan(y); } -} // xtest \ No newline at end of file +} // namespace xtest \ No newline at end of file diff --git a/tests/misc/ei.cpp b/tests/misc/ei.cpp index 75d4891..43554b3 100644 --- a/tests/misc/ei.cpp +++ b/tests/misc/ei.cpp @@ -1,10 +1,11 @@ -#include #include +#include /* */ -TEST(Ei, Branches) { +TEST(Ei, Branches) +{ // x <= 0.0 EXPECT_REL_NEAR_F64(cephes::ei(0.0), 0.0); } diff --git a/tests/misc/polylog.cpp b/tests/misc/polylog.cpp index 7e9d951..0cb779a 100644 --- a/tests/misc/polylog.cpp +++ b/tests/misc/polylog.cpp @@ -1,10 +1,11 @@ -#include #include +#include /* */ -TEST(PloyLog, Branches) { +TEST(PloyLog, Branches) +{ // x > 1.0 || n < -1 EXPECT_REL_NEAR_F64(cephes::polylog(1, 2.0), 0.0); EXPECT_REL_NEAR_F64(cephes::polylog(-2, 0.0), 0.0); diff --git a/tests/misc/spence.cpp b/tests/misc/spence.cpp index 7ce210e..358ea01 100644 --- a/tests/misc/spence.cpp +++ b/tests/misc/spence.cpp @@ -1,10 +1,11 @@ -#include #include +#include /* */ -TEST(Spence, Branches) { +TEST(Spence, Branches) +{ // x < 0 EXPECT_REL_NEAR_F64(cephes::spence(-1.0), 0.0); // x == 1.0 diff --git a/tests/misc/struve.cpp b/tests/misc/struve.cpp index da60e19..49c7e83 100644 --- a/tests/misc/struve.cpp +++ b/tests/misc/struve.cpp @@ -1,11 +1,12 @@ -#include #include +#include /* Table[NumberForm[PolyGamma[0, x], 16], {x, {0.0, -10., 1.0, 8.0, 9.0, 10.0, 100.}}] */ -TEST(StruveH, Branches) { +TEST(StruveH, Branches) +{ // EXPECT_REL_NEAR_F64(cephes::struve(0.0, 0.0), 0.0); EXPECT_REL_NEAR_F64(cephes::struve(1.0, 0.0), 0.0); } diff --git a/tests/misc/zeta.cpp b/tests/misc/zeta.cpp index e769a19..5cb87c6 100644 --- a/tests/misc/zeta.cpp +++ b/tests/misc/zeta.cpp @@ -1,10 +1,11 @@ -#include #include +#include /* */ -TEST(Zeta, Branches) { +TEST(Zeta, Branches) +{ // x == 1.0 EXPECT_GT(cephes::zeta(1.0, 1.0), 1e308); } diff --git a/tests/misc/zetac.cpp b/tests/misc/zetac.cpp index f6093cc..dbe0efa 100644 --- a/tests/misc/zetac.cpp +++ b/tests/misc/zetac.cpp @@ -1,10 +1,11 @@ -#include #include +#include /* */ -TEST(ZetaC, Branches) { +TEST(ZetaC, Branches) +{ // x < -170.6243 EXPECT_REL_NEAR_F64(cephes::zetac(-175.0), 0.0); } diff --git a/tests/prob/CMakeLists.txt b/tests/prob/CMakeLists.txt new file mode 100644 index 0000000..9aee44d --- /dev/null +++ b/tests/prob/CMakeLists.txt @@ -0,0 +1,2 @@ + +add_gtest(ndtr) diff --git a/tests/error/ndtr.cpp b/tests/prob/ndtr.cpp similarity index 55% rename from tests/error/ndtr.cpp rename to tests/prob/ndtr.cpp index d8be250..f0e5db2 100644 --- a/tests/error/ndtr.cpp +++ b/tests/prob/ndtr.cpp @@ -1,7 +1,7 @@ +#include #include -#include - -TEST(ndtr, Branches) { +TEST(ndtr, Branches) +{ EXPECT_GT(cephes::ndtr(0.1), 0.0); }