コード例 #1
0
ファイル: igami.c プロジェクト: BranYang/scipy
static double find_inverse_s(double p, double q)
{
    /*
     * Computation of the Incomplete Gamma Function Ratios and their Inverse
     * ARMIDO R. DIDONATO and ALFRED H. MORRIS, JR.
     * ACM Transactions on Mathematical Software, Vol. 12, No. 4,
     * December 1986, Pages 377-393.
     *
     * See equation 32.
     */
    double s, t;
    double a[4] = {0.213623493715853, 4.28342155967104,
		   11.6616720288968, 3.31125922108741};
    double b[5] = {0.3611708101884203e-1, 1.27364489782223,
		   6.40691597760039, 6.61053765625462, 1};

    if (p < 0.5) {
        t = sqrt(-2 * log(p));
    }
    else {
        t = sqrt(-2 * log(q));
    }
    s = t - polevl(t, a, 3) / polevl(t, b, 4);
    if(p < 0.5)
        s = -s;
    return s;
}
コード例 #2
0
ファイル: ndtri.cpp プロジェクト: JesseBuesking/trueskill
double ndtri(double y0)
{
    double x, y, z, y2, x0, x1;
    int 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);
    }

    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);
}
コード例 #3
0
ファイル: ndtr.c プロジェクト: SaulAryehKohn/aipy
double erfc(double a)
{
double p,q,x,y,z;

if (isnan(a)) {
  mtherr("erfc", DOMAIN);
  return (NAN);
}

if( a < 0.0 )
	x = -a;
else
	x = a;

if( x < 1.0 )
	return( 1.0 - erf(a) );

z = -a * a;

if( z < -MAXLOG )
	{
under:
	mtherr( "erfc", UNDERFLOW );
	if( a < 0 )
		return( 2.0 );
	else
		return( 0.0 );
	}

z = exp(z);

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);
}
コード例 #4
0
ファイル: fresnl.c プロジェクト: B-Rich/hermes-legacy
void fresnl( double xxa, double *ssa, double *cca )
{
    double f, g, cc, ss, c, s, t, u, x, x2;
    /*debug double t1;*/

    x = xxa;
    x = fabs(x);
    x2 = x * x;
    if( x2 < 2.5625 )
    {
        t = x2 * x2;
        ss = x * x2 * polevl( t, sn, 6);
        cc = x * polevl( t, cn, 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 = PIF * x2;
    u = 1.0/(t * t);
    t = 1.0/t;
    f = 1.0 - u * polevl( u, fn, 7);
    g = t * polevl( u, gn, 7);

    t = PIO2F * x2;
    c = cos(t);
    s = sin(t);
    t = PIF * 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;
    }

    *cca = cc;
    *ssa = ss;
}
コード例 #5
0
ファイル: exp2.c プロジェクト: 7924102/scipy
double exp2(double x)
{
    double px, xx;
    short n;

    if (cephes_isnan(x))
	return (x);
    if (x > MAXL2) {
	return (NPY_INFINITY);
    }

    if (x < MINL2) {
	return (0.0);
    }

    xx = x;			/* save x */
    /* separate into integer and fractional parts */
    px = floor(x + 0.5);
    n = px;
    x = x - px;

    /* rational approximation
     * exp2(x) = 1 +  2xP(xx)/(Q(xx) - P(xx))
     * where xx = x**2
     */
    xx = x * x;
    px = x * polevl(xx, P, 2);
    x = px / (p1evl(xx, Q, 2) - px);
    x = 1.0 + ldexp(x, 1);

    /* scale by power of 2 */
    x = ldexp(x, n);
    return (x);
}
コード例 #6
0
ファイル: asinh.c プロジェクト: Vladimir84/rcc
double asinh(double xx)
{
    double a, z, x;
    int sign;

    if(ISNAN(xx)) return xx;
    if( xx == 0.0 ) return xx;
    if( xx < 0.0 ) {
	sign = -1;
	x = -xx;
    } else {
	sign = 1;
	x = xx;
    }

    if( x > 1.0e8 ) {
	if( x == R_PosInf ) return xx;
	return( sign * (log(x) + LOGE2) );
    }
    z = x * x;
    if( x < 0.5 ) {
	a = ( polevl(z, P, 4)/p1evl(z, Q, 4) ) * z;
	a = a * x + x;
	if( sign < 0 ) a = -a;
	return a;
    }
    a = sqrt( z + 1.0 );
    return sign * log(x + a);
}
コード例 #7
0
ファイル: expn.c プロジェクト: mandrakos/mglib
/* Asymptotic expansion for large n, DLMF 8.20(ii) */
double expn_large_n(int n, double x)
{
    int k;
    double p = n;
    double lambda = x/p;
    double multiplier = 1/p/(lambda + 1)/(lambda + 1);
    double fac = 1;
    double res = 1; /* A[0] = 1 */
    double expfac, term;

    expfac = exp(-lambda*p)/(lambda + 1)/p;
    if (expfac == 0) {
	mtherr("expn", UNDERFLOW);
	return 0;
    }

    /* Do the k = 1 term outside the loop since A[1] = 1 */
    fac *= multiplier;
    res += fac;

    for (k = 2; k < nA; k++) {
	fac *= multiplier;
	term = fac*polevl(lambda, A[k], Adegs[k]);
	res += term;
	if (fabs(term) < MACHEP*fabs(res)) {
	    break;
	}
    }

    return expfac*res;
}
コード例 #8
0
ファイル: atanh.c プロジェクト: rosenbergdm/language-r
double atanh(double x)
#ifdef __cplusplus
	throw ()
#endif
{
    double s, z;

    if(ISNAN(x)) return x;
    if( x == 0.0 ) return x;
    z = fabs(x);
    if( z >= 1.0 ) {
	if( x == 1.0 ) return R_PosInf;
	if( x == -1.0 ) return R_NegInf;
	return NA_REAL;
    }

    if( z < 1.0e-7 ) return x;

    if( z < 0.5 ) {
	z = x * x;
	s = x + x * z * (polevl(z, P, 4) / p1evl(z, Q, 5));
	return s;
    }

    return 0.5 * log((1.0+x)/(1.0-x));
}
コード例 #9
0
ファイル: unity.c プロジェクト: mandrakos/mglib
double cosm1(double x)
{
    double xx;

    if ((x < -CEPHES_PI_4) || (x > CEPHES_PI_4))
	return (cos(x) - 1.0);
    xx = x * x;
    xx = -0.5 * xx + xx * xx * polevl(xx, coscof, 6);
    return xx;
}
コード例 #10
0
ファイル: fresnl.c プロジェクト: MilesCranmer/presto
int fresnl(double xxa, double *ssa, double *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;
    }
    if (x > 36974.0) {
        cc = 0.5;
        ss = 0.5;
        goto done;
    }
    /* 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 = PIBYTWO * 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;
    }
    *cca = cc;
    *ssa = ss;
    return (0);
}
コード例 #11
0
ファイル: unity.c プロジェクト: mandrakos/mglib
double log1p(double x)
{
    double z;

    z = 1.0 + x;
    if ((z < CEPHES_SQRT1_2) || (z > CEPHES_SQRT2))
	return (log(z));
    z = x * x;
    z = -0.5 * z + x * (z * polevl(x, LP, 6) / p1evl(x, LQ, 6));
    return (x + z);
}
コード例 #12
0
ファイル: Gaussian.cpp プロジェクト: srish13/Honeycomb
Real GaussianInv<Real>::calc(Real y0)
{
    if (y0 <= 0)
        return -Real_::max;

    if (y0 >= 1)
        return Real_::max;

    int code = 1;
    Real y = y0;
    if (y > 1 - 0.13533528323661269189) /* 0.135... = exp(-2) */
    {
        y = 1 - y;
        code = 0;
    }

    if (y > 0.13533528323661269189)
    {
        y = y - 0.5;
        Real y2 = y * y;
        Real x = y + y * (y2 * polevl(y2, P0, 4) / p1evl(y2, Q0, 8));
        static const Real sqrtTwoPi = Alge::sqrt(Real_::piTwo);
        x = x * sqrtTwoPi; 
        return x;
    }

    Real x = Alge::sqrt( -2 * Alge::log(y) );
    Real x0 = x - Alge::log(x)/x;

    Real z = 1/x;
    Real x1;
    if(x < 8) /* 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;
}
コード例 #13
0
ファイル: unity.c プロジェクト: mandrakos/mglib
double expm1(double x)
{
    double r, xx;

    if (!cephes_isfinite(x)) {
	if (cephes_isnan(x)) {
	    return x;
	}
	else if (x > 0) {
	    return x;
	}
	else {
	    return -1.0;
	}

    }
    if ((x < -0.5) || (x > 0.5))
	return (exp(x) - 1.0);
    xx = x * x;
    r = x * polevl(xx, EP, 2);
    r = r / (polevl(xx, EQ, 3) - r);
    return (r + r);
}
コード例 #14
0
ファイル: jv.c プロジェクト: Kornfuzion/AskArbie
static double jnt(double n, double x)
{
    double z, zz, z3;
    double cbn, n23, cbtwo;
    double ai, aip, bi, bip;	/* Airy functions */
    double nk, fk, gk, pp, qq;
    double F[5], G[4];
    int k;

    cbn = cbrt(n);
    z = (x - n) / cbn;
    cbtwo = cbrt(2.0);

    /* Airy function */
    zz = -cbtwo * z;
    airy(zz, &ai, &aip, &bi, &bip);

    /* polynomials in expansion */
    zz = z * z;
    z3 = zz * z;
    F[0] = 1.0;
    F[1] = -z / 5.0;
    F[2] = polevl(z3, PF2, 1) * zz;
    F[3] = polevl(z3, PF3, 2);
    F[4] = polevl(z3, PF4, 3) * z;
    G[0] = 0.3 * zz;
    G[1] = polevl(z3, PG1, 1);
    G[2] = polevl(z3, PG2, 2) * z;
    G[3] = polevl(z3, PG3, 2) * zz;
#if CEPHES_DEBUG
    for (k = 0; k <= 4; k++)
        printf("F[%d] = %.5E\n", k, F[k]);
    for (k = 0; k <= 3; k++)
        printf("G[%d] = %.5E\n", k, G[k]);
#endif
    pp = 0.0;
    qq = 0.0;
    nk = 1.0;
    n23 = cbrt(n * n);

    for (k = 0; k <= 4; k++) {
        fk = F[k] * nk;
        pp += fk;
        if (k != 4) {
            gk = G[k] * nk;
            qq += gk;
        }
#if CEPHES_DEBUG
        printf("fk[%d] %.5E, gk[%d] %.5E\n", k, fk, k, gk);
#endif
        nk /= n23;
    }

    fk = cbtwo * ai * pp / cbn + cbrt(4.0) * aip * qq / n;
    return (fk);
}
コード例 #15
0
ファイル: exp10.c プロジェクト: SaulAryehKohn/aipy
double exp10(double x)
{
double px, xx;
short n;

#ifdef NANS
if( isnan(x) )
	return(x);
#endif
if( x > MAXL10 )
	{
#ifdef INFINITIES
	return( INFINITY );
#else
	mtherr( "exp10", OVERFLOW );
	return( MAXNUM );
#endif
	}

if( x < -MAXL10 )	/* Would like to use MINLOG but can't */
	{
	mtherr( "exp10", UNDERFLOW );
	return(0.0);
	}

/* Express 10**x = 10**g 2**n
 *   = 10**g 10**( n log10(2) )
 *   = 10**( g + n log10(2) )
 */
px = floor( LOG210 * x + 0.5 );
n = px;
x -= px * LG102A;
x -= px * LG102B;

/* rational approximation for exponential
 * of the fractional part:
 * 10**x = 1 + 2x P(x**2)/( Q(x**2) - P(x**2) )
 */
xx = x * x;
px = x * polevl( xx, P, 3 );
x =  px/( p1evl( xx, Q, 3 ) - px );
x = 1.0 + ldexp( x, 1 );

/* multiply by power of 2 */
x = ldexp( x, n );

return(x);
}
コード例 #16
0
ファイル: special.cpp プロジェクト: OS2World/APP-MATH-Euler
/* Gamma function computed by Stirling's formula.
 * The polynomial STIR is valid for 33 <= x <= 172.
 */
double stirf (double x)
{	double y, w, v;

	w = 1.0/x;
	w = 1.0 + w * polevl( w, STIR, 4 );
	y = exp(x);
	if( x > MAXSTIR )
	{	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 );
}
コード例 #17
0
ファイル: ndtr.c プロジェクト: SaulAryehKohn/aipy
double erf(double x)
{
double y, z;

if (isnan(x)) {
  mtherr("erf", DOMAIN);
  return (NAN);
}

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 );

}
コード例 #18
0
double GaussianEstimator::errorFunction(double x) {
    double y, z;
    static double T[] = { 9.60497373987051638749E0, 9.00260197203842689217E1,
      2.23200534594684319226E3, 7.00332514112805075473E3,
      5.55923013010394962768E4 };
    static double U[] = {
      // 1.00000000000000000000E0,
      3.35617141647503099647E1, 5.21357949780152679795E2,
      4.59432382970980127987E3, 2.26290000613890934246E4,
      4.92673942608635921086E4 };

    if (fabs(x) > 1.0) {
      return (1.0 - errorFunctionComplemented(x));
    }
    z = x * x;
    y = x * polevl(z, T, 4) / p1evl(z, U, 5);
    return y;
}
コード例 #19
0
ファイル: gamma.c プロジェクト: 317070/scipy
/* Gamma function computed by Stirling's formula.
 * The polynomial STIR is valid for 33 <= x <= 172.
 */
static double stirf(double x)
{
    double y, w, v;

    if (x >= MAXGAM) {
	return (NPY_INFINITY);
    }
    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);
}
コード例 #20
0
ファイル: jv.c プロジェクト: Kornfuzion/AskArbie
static double jnx(double n, double x)
{
    double zeta, sqz, zz, zp, np;
    double cbn, n23, t, z, sz;
    double pp, qq, z32i, zzi;
    double ak, bk, akl, bkl;
    int sign, doa, dob, nflg, k, s, tk, tkp1, m;
    static double u[8];
    static double ai, aip, bi, bip;

    /* Test for x very close to n. Use expansion for transition region if so. */
    cbn = cbrt(n);
    z = (x - n) / cbn;
    if (fabs(z) <= 0.7)
        return (jnt(n, x));

    z = x / n;
    zz = 1.0 - z * z;
    if (zz == 0.0)
        return (0.0);

    if (zz > 0.0) {
        sz = sqrt(zz);
        t = 1.5 * (log((1.0 + sz) / z) - sz);	/* zeta ** 3/2          */
        zeta = cbrt(t * t);
        nflg = 1;
    }
    else {
        sz = sqrt(-zz);
        t = 1.5 * (sz - acos(1.0 / z));
        zeta = -cbrt(t * t);
        nflg = -1;
    }
    z32i = fabs(1.0 / t);
    sqz = cbrt(t);

    /* Airy function */
    n23 = cbrt(n * n);
    t = n23 * zeta;

#if CEPHES_DEBUG
    printf("zeta %.5E, Airy(%.5E)\n", zeta, t);
#endif
    airy(t, &ai, &aip, &bi, &bip);

    /* polynomials in expansion */
    u[0] = 1.0;
    zzi = 1.0 / zz;
    u[1] = polevl(zzi, P1, 1) / sz;
    u[2] = polevl(zzi, P2, 2) / zz;
    u[3] = polevl(zzi, P3, 3) / (sz * zz);
    pp = zz * zz;
    u[4] = polevl(zzi, P4, 4) / pp;
    u[5] = polevl(zzi, P5, 5) / (pp * sz);
    pp *= zz;
    u[6] = polevl(zzi, P6, 6) / pp;
    u[7] = polevl(zzi, P7, 7) / (pp * sz);

#if CEPHES_DEBUG
    for (k = 0; k <= 7; k++)
        printf("u[%d] = %.5E\n", k, u[k]);
#endif

    pp = 0.0;
    qq = 0.0;
    np = 1.0;
    /* flags to stop when terms get larger */
    doa = 1;
    dob = 1;
    akl = NPY_INFINITY;
    bkl = NPY_INFINITY;

    for (k = 0; k <= 3; k++) {
        tk = 2 * k;
        tkp1 = tk + 1;
        zp = 1.0;
        ak = 0.0;
        bk = 0.0;
        for (s = 0; s <= tk; s++) {
            if (doa) {
                if ((s & 3) > 1)
                    sign = nflg;
                else
                    sign = 1;
                ak += sign * mu[s] * zp * u[tk - s];
            }

            if (dob) {
                m = tkp1 - s;
                if (((m + 1) & 3) > 1)
                    sign = nflg;
                else
                    sign = 1;
                bk += sign * lambda[s] * zp * u[m];
            }
            zp *= z32i;
        }

        if (doa) {
            ak *= np;
            t = fabs(ak);
            if (t < akl) {
                akl = t;
                pp += ak;
            }
            else
                doa = 0;
        }

        if (dob) {
            bk += lambda[tkp1] * zp * u[0];
            bk *= -np / sqz;
            t = fabs(bk);
            if (t < bkl) {
                bkl = t;
                qq += bk;
            }
            else
                dob = 0;
        }
#if CEPHES_DEBUG
        printf("a[%d] %.5E, b[%d] %.5E\n", k, ak, k, bk);
#endif
        if (np < MACHEP)
            break;
        np /= n * n;
    }

    /* normalizing factor ( 4*zeta/(1 - z**2) )**1/4    */
    t = 4.0 * zeta / zz;
    t = sqrt(sqrt(t));

    t *= ai * pp / cbrt(n) + aip * qq / (n23 * n);
    return (t);
}
コード例 #21
0
ファイル: gamma.c プロジェクト: DougBurke/sherpa
double Gamma(double x)
{
double p, q, z;
int i;

sgngam = 1;
#ifdef NANS
if( isnan(x) )
	return(x);
#endif
#ifdef INFINITIES
#ifdef NANS
if( x == INFINITY )
	return(x);
if( x == -INFINITY )
	return(x);
#else
if( !isfinite(x) )
	return(x);
#endif
#endif
q = fabs(x);

if( q > 33.0 )
	{
	if( x < 0.0 )
		{
		p = floor(q);
		if( p == q )
			{
#ifdef NANS
gamnan:
			mtherr( "Gamma", OVERFLOW );
			return (MAXNUM);
#else
			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 )
			{
#ifdef INFINITIES
			return( sgngam * INFINITY);
#else
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 );

small:
if( x == 0.0 )
	{
#ifdef INFINITIES
#ifdef NANS
	  goto gamnan;
#else
	  return( INFINITY );
#endif
#else
	mtherr( "Gamma", SING );
	return( MAXNUM );
#endif
	}
else
	return( z/((1.0 + 0.5772156649015329 * x) * x) );
}
コード例 #22
0
ファイル: ni_fourier.c プロジェクト: ElDeveloper/scipy
static double _bessel_j1(double x)
{
    double w, z, p, q, xn;
    const double RP[4] = {
        -8.99971225705559398224E8,
        4.52228297998194034323E11,
        -7.27494245221818276015E13,
        3.68295732863852883286E15,
    };
    const double RQ[8] = {
        6.20836478118054335476E2,
        2.56987256757748830383E5,
        8.35146791431949253037E7,
        2.21511595479792499675E10,
        4.74914122079991414898E12,
        7.84369607876235854894E14,
        8.95222336184627338078E16,
        5.32278620332680085395E18,
    };
    const double PP[7] = {
        7.62125616208173112003E-4,
        7.31397056940917570436E-2,
        1.12719608129684925192E0,
        5.11207951146807644818E0,
        8.42404590141772420927E0,
        5.21451598682361504063E0,
        1.00000000000000000254E0,
    };
    const double PQ[7] = {
        5.71323128072548699714E-4,
        6.88455908754495404082E-2,
        1.10514232634061696926E0,
        5.07386386128601488557E0,
        8.39985554327604159757E0,
        5.20982848682361821619E0,
        9.99999999999999997461E-1,
    };
    const double QP[8] = {
        5.10862594750176621635E-2,
        4.98213872951233449420E0,
        7.58238284132545283818E1,
        3.66779609360150777800E2,
        7.10856304998926107277E2,
        5.97489612400613639965E2,
        2.11688757100572135698E2,
        2.52070205858023719784E1,
    };
    const double QQ[7] = {
        7.42373277035675149943E1,
        1.05644886038262816351E3,
        4.98641058337653607651E3,
        9.56231892404756170795E3,
        7.99704160447350683650E3,
        2.82619278517639096600E3,
        3.36093607810698293419E2,
    };

    w = x;
    if (x < 0)
        w = -x;

    if (w <= 5.0) {
        z = x * x;
        w = polevl(z, RP, 3) / p1evl(z, RQ, 8);
        w = w * x * (z - Z1) * (z - Z2);
        return w ;
    }

    w = 5.0 / x;
    z = w * w;
    p = polevl(z, PP, 6) / polevl(z, PQ, 6);
    q = polevl(z, QP, 7) / p1evl(z, QQ, 7);
    xn = x - THPIO4;
    p = p * cos(xn) - w * q * sin(xn);
    return p * SQ2OPI / sqrt(x);
}
コード例 #23
0
ファイル: psi.c プロジェクト: Eigenstate/msmbuilder
double psi(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 = M_PI/tan(M_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;
    }

    return(y);
}
コード例 #24
0
ファイル: sas_J1.c プロジェクト: bmaranville/sasmodels
double sas_J1(double x)
{

//Cephes double pression function
#if FLOAT_SIZE>4

    double w, z, p, q, xn;

    const double Z1 = 1.46819706421238932572E1;
    const double Z2 = 4.92184563216946036703E1;
    const double THPIO4 =  2.35619449019234492885;
    const double SQ2OPI = 0.79788456080286535588;

    w = x;
    if( x < 0 )
	    w = -x;

    if( w <= 5.0 )
	{
	    z = x * x;
	    w = polevl( z, RPJ1, 3 ) / p1evl( z, RQJ1, 8 );
	    w = w * x * (z - Z1) * (z - Z2);
	    return( w );
	}

    w = 5.0/x;
    z = w * w;

    p = polevl( z, PPJ1, 6)/polevl( z, PQJ1, 6 );
    q = polevl( z, QPJ1, 7)/p1evl( z, QQJ1, 7 );

    xn = x - THPIO4;

    double sn, cn;
    SINCOS(xn, sn, cn);
    p = p * cn - w * q * sn;

    return( p * SQ2OPI / sqrt(x) );


//Single precission version of cephes
#else
    double xx, w, z, p, q, xn;

    const double Z1 = 1.46819706421238932572E1;
    const double THPIO4F =  2.35619449019234492885;    /* 3*pi/4 */


    xx = x;
    if( xx < 0 )
	    xx = -x;

    if( xx <= 2.0 )
	{
	    z = xx * xx;
	    p = (z-Z1) * xx * polevl( z, JPJ1, 4 );
	    return( p );
	}

    q = 1.0/x;
    w = sqrt(q);

    p = w * polevl( q, MO1J1, 7);
    w = q*q;
    xn = q * polevl( w, PH1J1, 7) - THPIO4F;
    p = p * cos(xn + xx);

    return(p);
#endif
}
コード例 #25
0
ファイル: chi2.cpp プロジェクト: BentSm/povray
static DBL ndtri(DBL y0)
{
    DBL 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 (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;

    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);
}
コード例 #26
0
ファイル: chi2.cpp プロジェクト: BentSm/povray
static DBL lgam(DBL x, int *sgngam)
{
    DBL p, q, w, z;
    int i;

    *sgngam = 1;

    if (x < -34.0)
    {
        q = -x;
        w = lgam(q, sgngam);  /* note this modifies sgngam! */
        p = floor(q);

        if (p == q)
        {
            goto loverf;
        }

        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(M_PI * z);

        if (z == 0.0)
        {
            goto loverf;
        }

/*      z = log(M_PI) - log( z ) - w;*/

        z = LOGPI - log(z) - w;

        return (z);
    }

    if (x < 13.0)
    {
        z = 1.0;

        while (x >= 3.0)
        {
            x -= 1.0;

            z *= x;
        }

        while (x < 2.0)
        {
            if (x == 0.0)
            {
                goto loverf;
            }

            z /= x;

            x += 1.0;
        }

        if (z < 0.0)
        {
            *sgngam = -1;

            z = -z;
        }
        else
        {
            *sgngam = 1;
        }

        if (x == 2.0)
        {
            return (log(z));
        }

        x -= 2.0;

        p = x * polevl(x, B, 5) / p1evl(x, C, 6);

        return (log(z) + p);
    }

    if (x > MAXLGM)
    {
        loverf:
/*
        mtherr("lgam", OVERFLOW);
*/
        return (*sgngam * MAXNUM);
    }

    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);
}
コード例 #27
0
ファイル: gamma.c プロジェクト: 317070/scipy
double Gamma(double x)
{
    double p, q, z;
    int i;

    sgngam = 1;
    if (!npy_isfinite(x)) {
	return x;
    }
    q = fabs(x);

    if (q > 33.0) {
	if (x < 0.0) {
	    p = floor(q);
	    if (p == q) {
	      gamnan:
		mtherr("Gamma", OVERFLOW);
		return (NPY_INFINITY);
	    }
	    i = p;
	    if ((i & 1) == 0)
		sgngam = -1;
	    z = q - p;
	    if (z > 0.5) {
		p += 1.0;
		z = q - p;
	    }
	    z = q * sin(NPY_PI * z);
	    if (z == 0.0) {
		return (sgngam * NPY_INFINITY);
	    }
	    z = fabs(z);
	    z = NPY_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) {
	goto gamnan;
    }
    else
	return (z / ((1.0 + 0.5772156649015329 * x) * x));
}
コード例 #28
0
ファイル: special.cpp プロジェクト: OS2World/APP-MATH-Euler
double gammln (double x)
{
	double p, q, w, z;
	int i;

	sgngam = 1;

	if( x < -34.0 )
		{
		q = -x;
		w = gammln(q); /* note this modifies sgngam! */
		p = floor(q);
		if( p == q )
			goto loverf;
		i = (int)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 loverf;
	/*	z = log(PI) - log( z ) - w;*/
		z = LOGPI - log( z ) - w;
		return( z );
		}

	if( x < 13.0 )
		{
		z = 1.0;
		while( x >= 3.0 )
			{
			x -= 1.0;
			z *= x;
			}
		while( x < 2.0 )
			{
			if( x == 0.0 )
				goto loverf;
			z /= x;
			x += 1.0;
			}
		if( z < 0.0 )
			{
			sgngam = -1;
			z = -z;
			}
		else
			sgngam = 1;
		if( x == 2.0 )
			return( log(z) );
		x -= 2.0;
		p = x * polevl( x, B, 5 ) / p1evl( x, C, 6);
		return( log(z) + p );
		}

	if( x > MAXLGM )
		{
	loverf:
		output("Overflow in loggamma\n");
		error=1; return 0;
		}

	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 );
}
コード例 #29
0
ファイル: special.cpp プロジェクト: OS2World/APP-MATH-Euler
double gamm (double x)
{
	double p, q, z;
	int i;

	sgngam = 1;
	q = fabs(x);

	if( q > 33.0 )
	{	if( x < 0.0 )
		{	p = floor(q);
			if( p == q )
				goto goverf;
			i = (int)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 )
				{
	goverf:
				output("Overflow in gamma\n");
				error=1; return 0;
				}
			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) || (x == 3.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 )
		{
		output("Wrong argument for gamma.\n");
		error=1; return 0;
		}
	else
		return( z/((1.0 + 0.5772156649015329 * x) * x) );
}
コード例 #30
0
ファイル: gamma.c プロジェクト: 317070/scipy
double lgam(double x)
{
    double p, q, u, w, z;
    int i;

    sgngam = 1;

    if (!npy_isfinite(x))
	return x;

    if (x < -34.0) {
	q = -x;
	w = lgam(q);		/* note this modifies sgngam! */
	p = floor(q);
	if (p == q) {
	  lgsing:
	    mtherr("lgam", SING);
	    return (NPY_INFINITY);
	}
	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(NPY_PI * z);
	if (z == 0.0)
	    goto lgsing;
	/*     z = log(NPY_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) {
	return (sgngam * NPY_INFINITY);
    }

    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);
}