double gsl_hypot (const double x, const double y) { double xabs = fabs(x) ; double yabs = fabs(y) ; double min, max; /* Follow the optional behavior of the ISO C standard and return +Inf when any of the argument is +-Inf, even if the other is NaN. http://pubs.opengroup.org/onlinepubs/009695399/functions/hypot.html */ if (gsl_isinf(x) || gsl_isinf(y)) { return GSL_POSINF; } if (xabs < yabs) { min = xabs ; max = yabs ; } else { min = yabs ; max = xabs ; } if (min == 0) { return max ; } { double u = min / max ; return max * sqrt (1 + u * u) ; } }
double MyParser::EvalRemoveSingularity(double *xvar) { try { double result = Eval(); if ( gsl_isinf(result) || gsl_isnan(result) ) throw Singularity(); return result; } catch (Singularity) { try { if (isinf(Eval())) throw Pole(); int n; frexp (*xvar, &n); double xp = *xvar + ldexp(DBL_EPSILON,n); double xm = *xvar - ldexp(DBL_EPSILON,n); *xvar = xp; double yp = Eval(); if (gsl_isinf(yp) || gsl_isnan(yp)) throw Pole(); *xvar = xm; double ym = Eval(); if (gsl_isinf(ym) || gsl_isnan(ym)) throw Pole(); return (yp + ym)/2; } catch (Pole) { SingularityErrorMessage(*xvar); return GSL_ESING; } } }
/** *************************************************************************************************************************/ double compute_mlik_pois_marg_brent(double finitestepsize, void *params) { struct fnparams *gparams = ((struct fnparams *) params); gsl_vector *myBeta=gparams->betastatic; int n=gparams->nDim; int m=gparams->mDim; gsl_permutation *perm=gparams->perm; gsl_matrix *hessgvalues=gparams->mattmp2; gsl_matrix *hessgvalues3pt=gparams->mattmp3; double gvalue=gparams->gvalue; int status,sss; double mydet; double logscore,logscore3pt; double error_val=0.0; /** ***/ /*double finitestepsize=gsl_vector_get(finitestepsize_vec,0);*/ /** ***/ /*Rprintf("got h=%e n=%d m=%d gvalue=%e\n",finitestepsize,n,m,gvalue);*/ /*for(i=0;i<myBeta->size;i++){Rprintf("beta= %f ",gsl_vector_get(myBeta,i));}Rprintf("\n");*/ rv_hessg_pois_outer_marg(myBeta,gparams, hessgvalues,finitestepsize,hessgvalues3pt);/** start with LARGEST STEPSIZE **/ /*for(i=0;i<hessgvalues3pt->size1;i++){for(j=0;j<hessgvalues3pt->size2;j++){Rprintf("%e ",gsl_matrix_get(hessgvalues3pt,i,j));}Rprintf("\n");}*/ status=gsl_linalg_LU_decomp(hessgvalues,perm,&sss); mydet=gsl_linalg_LU_lndet(hessgvalues);/** compute determinant but this might be a nan - overflow? gsl_linalg_LU_lndet*/ logscore= -n*gvalue-0.5*mydet+(m/2.0)*log((2.0*M_PI)/n);/** this is the final value */ status=gsl_linalg_LU_decomp(hessgvalues3pt,perm,&sss); mydet=gsl_linalg_LU_lndet(hessgvalues3pt);/** compute determinant but this might be a nan - overflow? gsl_linalg_LU_lndet*/ logscore3pt= -n*gvalue-0.5*mydet+(m/2.0)*log((2.0*M_PI)/n);/** this is the final value */ error_val=fabs(logscore-logscore3pt); /*Rprintf("error_val=%e\n",error_val);*/ /*gparams->logscore=logscore; gparams->logscore3pt=logscore3pt;*/ /*Rprintf("logscore=%e logscore3pt=%e\n",logscore,logscore3pt);*/ if(gsl_isnan(error_val) || gsl_isinf(error_val)){return(DBL_MAX);/*error("Non-finite value in mlik error estimation");*/} return(error_val); }
int main (void) { double y, y_expected; int e, e_expected; gsl_ieee_env_setup (); /* Test for expm1 */ y = gsl_expm1 (0.0); y_expected = 0.0; gsl_test_rel (y, y_expected, 1e-15, "gsl_expm1(0.0)"); y = gsl_expm1 (1e-10); y_expected = 1.000000000050000000002e-10; gsl_test_rel (y, y_expected, 1e-15, "gsl_expm1(1e-10)"); y = gsl_expm1 (-1e-10); y_expected = -9.999999999500000000017e-11; gsl_test_rel (y, y_expected, 1e-15, "gsl_expm1(-1e-10)"); y = gsl_expm1 (0.1); y_expected = 0.1051709180756476248117078264902; gsl_test_rel (y, y_expected, 1e-15, "gsl_expm1(0.1)"); y = gsl_expm1 (-0.1); y_expected = -0.09516258196404042683575094055356; gsl_test_rel (y, y_expected, 1e-15, "gsl_expm1(-0.1)"); y = gsl_expm1 (10.0); y_expected = 22025.465794806716516957900645284; gsl_test_rel (y, y_expected, 1e-15, "gsl_expm1(10.0)"); y = gsl_expm1 (-10.0); y_expected = -0.99995460007023751514846440848444; gsl_test_rel (y, y_expected, 1e-15, "gsl_expm1(-10.0)"); /* Test for log1p */ y = gsl_log1p (0.0); y_expected = 0.0; gsl_test_rel (y, y_expected, 1e-15, "gsl_log1p(0.0)"); y = gsl_log1p (1e-10); y_expected = 9.9999999995000000000333333333308e-11; gsl_test_rel (y, y_expected, 1e-15, "gsl_log1p(1e-10)"); y = gsl_log1p (0.1); y_expected = 0.095310179804324860043952123280765; gsl_test_rel (y, y_expected, 1e-15, "gsl_log1p(0.1)"); y = gsl_log1p (10.0); y_expected = 2.3978952727983705440619435779651; gsl_test_rel (y, y_expected, 1e-15, "gsl_log1p(10.0)"); /* Test for gsl_hypot */ y = gsl_hypot (0.0, 0.0); y_expected = 0.0; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(0.0, 0.0)"); y = gsl_hypot (1e-10, 1e-10); y_expected = 1.414213562373095048801688e-10; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1e-10, 1e-10)"); y = gsl_hypot (1e-38, 1e-38); y_expected = 1.414213562373095048801688e-38; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1e-38, 1e-38)"); y = gsl_hypot (1e-10, -1.0); y_expected = 1.000000000000000000005; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1e-10, -1)"); y = gsl_hypot (-1.0, 1e-10); y_expected = 1.000000000000000000005; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(-1, 1e-10)"); y = gsl_hypot (1e307, 1e301); y_expected = 1.000000000000499999999999e307; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1e307, 1e301)"); y = gsl_hypot (1e301, 1e307); y_expected = 1.000000000000499999999999e307; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1e301, 1e307)"); y = gsl_hypot (1e307, 1e307); y_expected = 1.414213562373095048801688e307; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1e307, 1e307)"); /* Test +-Inf, finite */ y = gsl_hypot (GSL_POSINF, 1.2); y_expected = GSL_POSINF; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(GSL_POSINF, 1.2)"); y = gsl_hypot (GSL_NEGINF, 1.2); y_expected = GSL_POSINF; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(GSL_NEGINF, 1.2)"); y = gsl_hypot (1.2, GSL_POSINF); y_expected = GSL_POSINF; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1.2, GSL_POSINF)"); y = gsl_hypot (1.2, GSL_NEGINF); y_expected = GSL_POSINF; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1.2, GSL_NEGINF)"); /* Test NaN, finite */ y = gsl_hypot (GSL_NAN, 1.2); y_expected = GSL_NAN; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(GSL_NAN, 1.2)"); y = gsl_hypot (1.2, GSL_NAN); y_expected = GSL_NAN; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1.2, GSL_NAN)"); /* Test NaN, NaN */ y = gsl_hypot (GSL_NAN, GSL_NAN); y_expected = GSL_NAN; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(GSL_NAN, GSL_NAN)"); /* Test +Inf, NaN */ y = gsl_hypot (GSL_POSINF, GSL_NAN); y_expected = GSL_POSINF; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(GSL_POSINF, GSL_NAN)"); /* Test -Inf, NaN */ y = gsl_hypot (GSL_NEGINF, GSL_NAN); y_expected = GSL_POSINF; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(GSL_NEGINF, GSL_NAN)"); /* Test NaN, +Inf */ y = gsl_hypot (GSL_NAN, GSL_POSINF); y_expected = GSL_POSINF; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(GSL_NAN, GSL_POSINF)"); /* Test NaN, -Inf */ y = gsl_hypot (GSL_NAN, GSL_NEGINF); y_expected = GSL_POSINF; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(GSL_NAN, GSL_NEGINF)"); /* Test for gsl_hypot3 */ y = gsl_hypot3 (0.0, 0.0, 0.0); y_expected = 0.0; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot3(0.0, 0.0, 0.0)"); y = gsl_hypot3 (1e-10, 1e-10, 1e-10); y_expected = 1.732050807568877293527446e-10; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot3(1e-10, 1e-10, 1e-10)"); y = gsl_hypot3 (1e-38, 1e-38, 1e-38); y_expected = 1.732050807568877293527446e-38; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot3(1e-38, 1e-38, 1e-38)"); y = gsl_hypot3 (1e-10, 1e-10, -1.0); y_expected = 1.000000000000000000099; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot3(1e-10, 1e-10, -1)"); y = gsl_hypot3 (1e-10, -1.0, 1e-10); y_expected = 1.000000000000000000099; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot3(1e-10, -1, 1e-10)"); y = gsl_hypot3 (-1.0, 1e-10, 1e-10); y_expected = 1.000000000000000000099; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot3(-1, 1e-10, 1e-10)"); y = gsl_hypot3 (1e307, 1e301, 1e301); y_expected = 1.0000000000009999999999995e307; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot3(1e307, 1e301, 1e301)"); y = gsl_hypot3 (1e307, 1e307, 1e307); y_expected = 1.732050807568877293527446e307; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot3(1e307, 1e307, 1e307)"); y = gsl_hypot3 (1e307, 1e-307, 1e-307); y_expected = 1.0e307; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot3(1e307, 1e-307, 1e-307)"); /* Test for acosh */ y = gsl_acosh (1.0); y_expected = 0.0; gsl_test_rel (y, y_expected, 1e-15, "gsl_acosh(1.0)"); y = gsl_acosh (1.1); y_expected = 4.435682543851151891329110663525e-1; gsl_test_rel (y, y_expected, 1e-15, "gsl_acosh(1.1)"); y = gsl_acosh (10.0); y_expected = 2.9932228461263808979126677137742e0; gsl_test_rel (y, y_expected, 1e-15, "gsl_acosh(10.0)"); y = gsl_acosh (1e10); y_expected = 2.3718998110500402149594646668302e1; gsl_test_rel (y, y_expected, 1e-15, "gsl_acosh(1e10)"); /* Test for asinh */ y = gsl_asinh (0.0); y_expected = 0.0; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(0.0)"); y = gsl_asinh (1e-10); y_expected = 9.9999999999999999999833333333346e-11; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(1e-10)"); y = gsl_asinh (-1e-10); y_expected = -9.9999999999999999999833333333346e-11; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(1e-10)"); y = gsl_asinh (0.1); y_expected = 9.983407889920756332730312470477e-2; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(0.1)"); y = gsl_asinh (-0.1); y_expected = -9.983407889920756332730312470477e-2; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(-0.1)"); y = gsl_asinh (1.0); y_expected = 8.8137358701954302523260932497979e-1; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(1.0)"); y = gsl_asinh (-1.0); y_expected = -8.8137358701954302523260932497979e-1; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(-1.0)"); y = gsl_asinh (10.0); y_expected = 2.9982229502979697388465955375965e0; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(10)"); y = gsl_asinh (-10.0); y_expected = -2.9982229502979697388465955375965e0; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(-10)"); y = gsl_asinh (1e10); y_expected = 2.3718998110500402149599646668302e1; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(1e10)"); y = gsl_asinh (-1e10); y_expected = -2.3718998110500402149599646668302e1; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(-1e10)"); /* Test for atanh */ y = gsl_atanh (0.0); y_expected = 0.0; gsl_test_rel (y, y_expected, 1e-15, "gsl_atanh(0.0)"); y = gsl_atanh (1e-20); y_expected = 1e-20; gsl_test_rel (y, y_expected, 1e-15, "gsl_atanh(1e-20)"); y = gsl_atanh (-1e-20); y_expected = -1e-20; gsl_test_rel (y, y_expected, 1e-15, "gsl_atanh(-1e-20)"); y = gsl_atanh (0.1); y_expected = 1.0033534773107558063572655206004e-1; gsl_test_rel (y, y_expected, 1e-15, "gsl_atanh(0.1)"); y = gsl_atanh (-0.1); y_expected = -1.0033534773107558063572655206004e-1; gsl_test_rel (y, y_expected, 1e-15, "gsl_atanh(-0.1)"); y = gsl_atanh (0.9); y_expected = 1.4722194895832202300045137159439e0; gsl_test_rel (y, y_expected, 1e-15, "gsl_atanh(0.9)"); y = gsl_atanh (-0.9); y_expected = -1.4722194895832202300045137159439e0; gsl_test_rel (y, y_expected, 1e-15, "gsl_atanh(0.9)"); /* Test for pow_int */ y = gsl_pow_2 (-3.14); y_expected = pow (-3.14, 2.0); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_2(-3.14)"); y = gsl_pow_3 (-3.14); y_expected = pow (-3.14, 3.0); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_3(-3.14)"); y = gsl_pow_4 (-3.14); y_expected = pow (-3.14, 4.0); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_4(-3.14)"); y = gsl_pow_5 (-3.14); y_expected = pow (-3.14, 5.0); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_5(-3.14)"); y = gsl_pow_6 (-3.14); y_expected = pow (-3.14, 6.0); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_6(-3.14)"); y = gsl_pow_7 (-3.14); y_expected = pow (-3.14, 7.0); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_7(-3.14)"); y = gsl_pow_8 (-3.14); y_expected = pow (-3.14, 8.0); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_8(-3.14)"); y = gsl_pow_9 (-3.14); y_expected = pow (-3.14, 9.0); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_9(-3.14)"); { int n; for (n = -9; n < 10; n++) { y = gsl_pow_int (-3.14, n); y_expected = pow (-3.14, n); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_int(-3.14,%d)", n); } } { unsigned int n; for (n = 0; n < 10; n++) { y = gsl_pow_uint (-3.14, n); y_expected = pow (-3.14, n); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_uint(-3.14,%d)", n); } } /* Test case for n at INT_MAX, INT_MIN */ { double u = 1.0000001; int n = INT_MAX; y = gsl_pow_int (u, n); y_expected = pow (u, n); gsl_test_rel (y, y_expected, 1e-6, "gsl_pow_int(%.7f,%d)", u, n); n = INT_MIN; y = gsl_pow_int (u, n); y_expected = pow (u, n); gsl_test_rel (y, y_expected, 1e-6, "gsl_pow_int(%.7f,%d)", u, n); } /* Test for ldexp */ y = gsl_ldexp (M_PI, -2); y_expected = M_PI_4; gsl_test_rel (y, y_expected, 1e-15, "gsl_ldexp(pi,-2)"); y = gsl_ldexp (1.0, 2); y_expected = 4.000000; gsl_test_rel (y, y_expected, 1e-15, "gsl_ldexp(1.0,2)"); y = gsl_ldexp (0.0, 2); y_expected = 0.0; gsl_test_rel (y, y_expected, 1e-15, "gsl_ldexp(0.0,2)"); y = gsl_ldexp (9.999999999999998890e-01, 1024); y_expected = GSL_DBL_MAX; gsl_test_rel (y, y_expected, 1e-15, "gsl_ldexp DBL_MAX"); y = gsl_ldexp (1e308, -2000); y_expected = 8.7098098162172166755761e-295; gsl_test_rel (y, y_expected, 1e-15, "gsl_ldexp(1e308,-2000)"); y = gsl_ldexp (GSL_DBL_MIN, 2000); y_expected = 2.554675596204441378334779940e294; gsl_test_rel (y, y_expected, 1e-15, "gsl_ldexp(DBL_MIN,2000)"); /* Test subnormals */ { int i = 0; volatile double x = GSL_DBL_MIN; y_expected = 2.554675596204441378334779940e294; x /= 2; while (x > 0) { i++ ; y = gsl_ldexp (x, 2000 + i); gsl_test_rel (y, y_expected, 1e-15, "gsl_ldexp(DBL_MIN/2**%d,%d)",i,2000+i); x /= 2; } } /* Test for frexp */ y = gsl_frexp (0.0, &e); y_expected = 0; e_expected = 0; gsl_test_rel (y, y_expected, 1e-15, "gsl_frexp(0) fraction"); gsl_test_int (e, e_expected, "gsl_frexp(0) exponent"); y = gsl_frexp (M_PI, &e); y_expected = M_PI_4; e_expected = 2; gsl_test_rel (y, y_expected, 1e-15, "gsl_frexp(pi) fraction"); gsl_test_int (e, e_expected, "gsl_frexp(pi) exponent"); y = gsl_frexp (2.0, &e); y_expected = 0.5; e_expected = 2; gsl_test_rel (y, y_expected, 1e-15, "gsl_frexp(2.0) fraction"); gsl_test_int (e, e_expected, "gsl_frexp(2.0) exponent"); y = gsl_frexp (1.0 / 4.0, &e); y_expected = 0.5; e_expected = -1; gsl_test_rel (y, y_expected, 1e-15, "gsl_frexp(0.25) fraction"); gsl_test_int (e, e_expected, "gsl_frexp(0.25) exponent"); y = gsl_frexp (1.0 / 4.0 - 4.0 * GSL_DBL_EPSILON, &e); y_expected = 0.999999999999996447; e_expected = -2; gsl_test_rel (y, y_expected, 1e-15, "gsl_frexp(0.25-eps) fraction"); gsl_test_int (e, e_expected, "gsl_frexp(0.25-eps) exponent"); y = gsl_frexp (GSL_DBL_MAX, &e); y_expected = 9.999999999999998890e-01; e_expected = 1024; gsl_test_rel (y, y_expected, 1e-15, "gsl_frexp(DBL_MAX) fraction"); gsl_test_int (e, e_expected, "gsl_frexp(DBL_MAX) exponent"); y = gsl_frexp (-GSL_DBL_MAX, &e); y_expected = -9.999999999999998890e-01; e_expected = 1024; gsl_test_rel (y, y_expected, 1e-15, "gsl_frexp(-DBL_MAX) fraction"); gsl_test_int (e, e_expected, "gsl_frexp(-DBL_MAX) exponent"); y = gsl_frexp (GSL_DBL_MIN, &e); y_expected = 0.5; e_expected = -1021; gsl_test_rel (y, y_expected, 1e-15, "gsl_frexp(DBL_MIN) fraction"); gsl_test_int (e, e_expected, "gsl_frexp(DBL_MIN) exponent"); y = gsl_frexp (-GSL_DBL_MIN, &e); y_expected = -0.5; e_expected = -1021; gsl_test_rel (y, y_expected, 1e-15, "gsl_frexp(-DBL_MIN) fraction"); gsl_test_int (e, e_expected, "gsl_frexp(-DBL_MIN) exponent"); /* Test subnormals */ { int i = 0; volatile double x = GSL_DBL_MIN; y_expected = 0.5; e_expected = -1021; x /= 2; while (x > 0) { e_expected--; i++ ; y = gsl_frexp (x, &e); gsl_test_rel (y, y_expected, 1e-15, "gsl_frexp(DBL_MIN/2**%d) fraction",i); gsl_test_int (e, e_expected, "gsl_frexp(DBL_MIN/2**%d) exponent", i); x /= 2; } } /* Test for approximate floating point comparison */ { double x, y; int i; x = M_PI; y = 22.0 / 7.0; /* test the basic function */ for (i = 0; i < 10; i++) { double tol = pow (10, -i); int res = gsl_fcmp (x, y, tol); gsl_test_int (res, -(i >= 4), "gsl_fcmp(%.5f,%.5f,%g)", x, y, tol); } for (i = 0; i < 10; i++) { double tol = pow (10, -i); int res = gsl_fcmp (y, x, tol); gsl_test_int (res, (i >= 4), "gsl_fcmp(%.5f,%.5f,%g)", y, x, tol); } } #if HAVE_IEEE_COMPARISONS /* Test for isinf, isnan, finite */ { double zero, one, inf, nan; int s; zero = 0.0; one = 1.0; inf = exp (1.0e10); nan = inf / inf; s = gsl_isinf (zero); gsl_test_int (s, 0, "gsl_isinf(0)"); s = gsl_isinf (one); gsl_test_int (s, 0, "gsl_isinf(1)"); s = gsl_isinf (inf); gsl_test_int (s, 1, "gsl_isinf(inf)"); s = gsl_isinf (-inf); gsl_test_int (s, -1, "gsl_isinf(-inf)"); s = gsl_isinf (nan); gsl_test_int (s, 0, "gsl_isinf(nan)"); s = gsl_isnan (zero); gsl_test_int (s, 0, "gsl_isnan(0)"); s = gsl_isnan (one); gsl_test_int (s, 0, "gsl_isnan(1)"); s = gsl_isnan (inf); gsl_test_int (s, 0, "gsl_isnan(inf)"); s = gsl_isnan (-inf); gsl_test_int (s, 0, "gsl_isnan(-inf)"); s = gsl_isnan (nan); gsl_test_int (s, 1, "gsl_isnan(nan)"); s = gsl_finite (zero); gsl_test_int (s, 1, "gsl_finite(0)"); s = gsl_finite (one); gsl_test_int (s, 1, "gsl_finite(1)"); s = gsl_finite (inf); gsl_test_int (s, 0, "gsl_finite(inf)"); s = gsl_finite (-inf); gsl_test_int (s, 0, "gsl_finite(-inf)"); s = gsl_finite (nan); gsl_test_int (s, 0, "gsl_finite(nan)"); } #endif { double x = gsl_fdiv (2.0, 3.0); gsl_test_rel (x, 2.0 / 3.0, 4 * GSL_DBL_EPSILON, "gsl_fdiv(2,3)"); } /* Test constants in gsl_math.h */ { double x = log(M_E); gsl_test_rel (x, 1.0, 4 * GSL_DBL_EPSILON, "ln(M_E)"); } { double x=pow(2.0,M_LOG2E); gsl_test_rel (x, exp(1.0), 4 * GSL_DBL_EPSILON, "2^M_LOG2E"); } { double x=pow(10.0,M_LOG10E); gsl_test_rel (x, exp(1.0), 4 * GSL_DBL_EPSILON, "10^M_LOG10E"); } { double x=pow(M_SQRT2, 2.0); gsl_test_rel (x, 2.0, 4 * GSL_DBL_EPSILON, "M_SQRT2^2"); } { double x=pow(M_SQRT1_2, 2.0); gsl_test_rel (x, 1.0/2.0, 4 * GSL_DBL_EPSILON, "M_SQRT1_2"); } { double x=pow(M_SQRT3, 2.0); gsl_test_rel (x, 3.0, 4 * GSL_DBL_EPSILON, "M_SQRT3^2"); } { double x = M_PI; gsl_test_rel (x, 3.1415926535897932384626433832795, 4 * GSL_DBL_EPSILON, "M_PI"); } { double x = 2 * M_PI_2; gsl_test_rel (x, M_PI, 4 * GSL_DBL_EPSILON, "2*M_PI_2"); } { double x = 4 * M_PI_4; gsl_test_rel (x, M_PI, 4 * GSL_DBL_EPSILON, "4*M_PI_4"); } { double x = pow(M_SQRTPI, 2.0); gsl_test_rel (x, M_PI, 4 * GSL_DBL_EPSILON, "M_SQRTPI^2"); } { double x = pow(M_2_SQRTPI, 2.0); gsl_test_rel (x, 4/M_PI, 4 * GSL_DBL_EPSILON, "M_SQRTPI^2"); } { double x = M_1_PI; gsl_test_rel (x, 1/M_PI, 4 * GSL_DBL_EPSILON, "M_1_SQRTPI"); } { double x = M_2_PI; gsl_test_rel (x, 2.0/M_PI, 4 * GSL_DBL_EPSILON, "M_2_PI"); } { double x = exp(M_LN10); gsl_test_rel (x, 10, 4 * GSL_DBL_EPSILON, "exp(M_LN10)"); } { double x = exp(M_LN2); gsl_test_rel (x, 2, 4 * GSL_DBL_EPSILON, "exp(M_LN2)"); } { double x = exp(M_LNPI); gsl_test_rel (x, M_PI, 4 * GSL_DBL_EPSILON, "exp(M_LNPI)"); } { double x = M_EULER; gsl_test_rel (x, 0.5772156649015328606065120900824, 4 * GSL_DBL_EPSILON, "M_EULER"); } exit (gsl_test_summary ()); }
static VALUE rb_gsl_isinf2(VALUE obj, VALUE x) { // Need_Float(x); if (gsl_isinf(NUM2DBL(x))) return Qtrue; else return Qfalse; }
static VALUE rb_gsl_isinf(VALUE obj, VALUE x) { Need_Float(x); return INT2FIX(gsl_isinf(NUM2DBL(x))); }
int main (void) { double y, y_expected; gsl_ieee_env_setup (); /* Test for expm1 */ y = gsl_expm1 (0.0); y_expected = 0.0; gsl_test_rel (y, y_expected, 1e-15, "gsl_expm1(0.0)"); y = gsl_expm1 (1e-10); y_expected = 1.000000000050000000002e-10; gsl_test_rel (y, y_expected, 1e-15, "gsl_expm1(1e-10)"); y = gsl_expm1 (-1e-10); y_expected = -9.999999999500000000017e-11; gsl_test_rel (y, y_expected, 1e-15, "gsl_expm1(-1e-10)"); y = gsl_expm1 (0.1); y_expected = 0.1051709180756476248117078264902; gsl_test_rel (y, y_expected, 1e-15, "gsl_expm1(0.1)"); y = gsl_expm1 (-0.1); y_expected = -0.09516258196404042683575094055356; gsl_test_rel (y, y_expected, 1e-15, "gsl_expm1(-0.1)"); y = gsl_expm1 (10.0); y_expected = 22025.465794806716516957900645284; gsl_test_rel (y, y_expected, 1e-15, "gsl_expm1(10.0)"); y = gsl_expm1 (-10.0); y_expected = -0.99995460007023751514846440848444; gsl_test_rel (y, y_expected, 1e-15, "gsl_expm1(-10.0)"); /* Test for log1p */ y = gsl_log1p (0.0); y_expected = 0.0; gsl_test_rel (y, y_expected, 1e-15, "gsl_log1p(0.0)"); y = gsl_log1p (1e-10); y_expected = 9.9999999995000000000333333333308e-11; gsl_test_rel (y, y_expected, 1e-15, "gsl_log1p(1e-10)"); y = gsl_log1p (0.1); y_expected = 0.095310179804324860043952123280765; gsl_test_rel (y, y_expected, 1e-15, "gsl_log1p(0.1)"); y = gsl_log1p (10.0); y_expected = 2.3978952727983705440619435779651; gsl_test_rel (y, y_expected, 1e-15, "gsl_log1p(10.0)"); /* Test for gsl_hypot */ y = gsl_hypot (0.0, 0.0) ; y_expected = 0.0; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(0.0, 0.0)"); y = gsl_hypot (1e-10, 1e-10) ; y_expected = 1.414213562373095048801688e-10; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1e-10, 1e-10)"); y = gsl_hypot (1e-38, 1e-38) ; y_expected = 1.414213562373095048801688e-38; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1e-38, 1e-38)"); y = gsl_hypot (1e-10, -1.0) ; y_expected = 1.000000000000000000005; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1e-10, -1)"); y = gsl_hypot (-1.0, 1e-10) ; y_expected = 1.000000000000000000005; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(-1, 1e-10)"); y = gsl_hypot (1e307, 1e301) ; y_expected = 1.000000000000499999999999e307; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1e307, 1e301)"); y = gsl_hypot (1e301, 1e307) ; y_expected = 1.000000000000499999999999e307; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1e301, 1e307)"); y = gsl_hypot (1e307, 1e307) ; y_expected = 1.414213562373095048801688e307; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1e307, 1e307)"); /* Test for acosh */ y = gsl_acosh (1.0); y_expected = 0.0; gsl_test_rel (y, y_expected, 1e-15, "gsl_acosh(1.0)"); y = gsl_acosh (1.1); y_expected = 4.435682543851151891329110663525e-1; gsl_test_rel (y, y_expected, 1e-15, "gsl_acosh(1.1)"); y = gsl_acosh (10.0); y_expected = 2.9932228461263808979126677137742e0; gsl_test_rel (y, y_expected, 1e-15, "gsl_acosh(10.0)"); y = gsl_acosh (1e10); y_expected = 2.3718998110500402149594646668302e1; gsl_test_rel (y, y_expected, 1e-15, "gsl_acosh(1e10)"); /* Test for asinh */ y = gsl_asinh (0.0); y_expected = 0.0; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(0.0)"); y = gsl_asinh (1e-10); y_expected = 9.9999999999999999999833333333346e-11; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(1e-10)"); y = gsl_asinh (-1e-10); y_expected = -9.9999999999999999999833333333346e-11; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(1e-10)"); y = gsl_asinh (0.1); y_expected = 9.983407889920756332730312470477e-2; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(0.1)"); y = gsl_asinh (-0.1); y_expected = -9.983407889920756332730312470477e-2; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(-0.1)"); y = gsl_asinh (1.0); y_expected = 8.8137358701954302523260932497979e-1; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(1.0)"); y = gsl_asinh (-1.0); y_expected = -8.8137358701954302523260932497979e-1; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(-1.0)"); y = gsl_asinh (10.0); y_expected = 2.9982229502979697388465955375965e0; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(10)"); y = gsl_asinh (-10.0); y_expected = -2.9982229502979697388465955375965e0; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(-10)"); y = gsl_asinh (1e10); y_expected = 2.3718998110500402149599646668302e1; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(1e10)"); y = gsl_asinh (-1e10); y_expected = -2.3718998110500402149599646668302e1; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(-1e10)"); /* Test for atanh */ y = gsl_atanh (0.0); y_expected = 0.0; gsl_test_rel (y, y_expected, 1e-15, "gsl_atanh(0.0)"); y = gsl_atanh (1e-20); y_expected = 1e-20; gsl_test_rel (y, y_expected, 1e-15, "gsl_atanh(1e-20)"); y = gsl_atanh (-1e-20); y_expected = -1e-20; gsl_test_rel (y, y_expected, 1e-15, "gsl_atanh(-1e-20)"); y = gsl_atanh (0.1); y_expected = 1.0033534773107558063572655206004e-1; gsl_test_rel (y, y_expected, 1e-15, "gsl_atanh(0.1)"); y = gsl_atanh (-0.1); y_expected = -1.0033534773107558063572655206004e-1; gsl_test_rel (y, y_expected, 1e-15, "gsl_atanh(-0.1)"); y = gsl_atanh (0.9); y_expected = 1.4722194895832202300045137159439e0; gsl_test_rel (y, y_expected, 1e-15, "gsl_atanh(0.9)"); y = gsl_atanh (-0.9); y_expected = -1.4722194895832202300045137159439e0; gsl_test_rel (y, y_expected, 1e-15, "gsl_atanh(0.9)"); /* Test for pow_int */ y = gsl_pow_2 (-3.14); y_expected = pow(-3.14, 2.0); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_2(-3.14)"); y = gsl_pow_3 (-3.14); y_expected = pow(-3.14, 3.0); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_3(-3.14)"); y = gsl_pow_4 (-3.14); y_expected = pow(-3.14, 4.0); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_4(-3.14)"); y = gsl_pow_5 (-3.14); y_expected = pow(-3.14, 5.0); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_5(-3.14)"); y = gsl_pow_6 (-3.14); y_expected = pow(-3.14, 6.0); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_6(-3.14)"); y = gsl_pow_7 (-3.14); y_expected = pow(-3.14, 7.0); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_7(-3.14)"); y = gsl_pow_8 (-3.14); y_expected = pow(-3.14, 8.0); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_8(-3.14)"); y = gsl_pow_9 (-3.14); y_expected = pow(-3.14, 9.0); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_9(-3.14)"); { int n; for (n = -9; n < 10; n++) { y = gsl_pow_int (-3.14, n); y_expected = pow(-3.14, n); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_n(-3.14,%d)", n); } } /* Test for isinf, isnan, finite*/ { double zero, one, inf, nan; int s; zero = 0.0; one = 1.0; inf = exp(1.0e10); nan = inf / inf; s = gsl_isinf(zero); gsl_test_int (s, 0, "gsl_isinf(0)"); s = gsl_isinf(one); gsl_test_int (s, 0, "gsl_isinf(1)"); s = gsl_isinf(inf); gsl_test_int (s, 1, "gsl_isinf(inf)"); s = gsl_isinf(-inf); gsl_test_int (s, -1, "gsl_isinf(-inf)"); s = gsl_isinf(nan); gsl_test_int (s, 0, "gsl_isinf(nan)"); s = gsl_isnan(zero); gsl_test_int (s, 0, "gsl_isnan(0)"); s = gsl_isnan(one); gsl_test_int (s, 0, "gsl_isnan(1)"); s = gsl_isnan(inf); gsl_test_int (s, 0, "gsl_isnan(inf)"); s = gsl_isnan(nan); gsl_test_int (s, 1, "gsl_isnan(nan)"); s = gsl_finite(zero); gsl_test_int (s, 1, "gsl_finite(0)"); s = gsl_finite(one); gsl_test_int (s, 1, "gsl_finite(1)"); s = gsl_finite(inf); gsl_test_int (s, 0, "gsl_finite(inf)"); s = gsl_finite(nan); gsl_test_int (s, 0, "gsl_finite(nan)"); } { double x = gsl_fdiv (2.0, 3.0); gsl_test_rel (x, 2.0/3.0, 4*GSL_DBL_EPSILON, "gsl_fdiv(2,3)"); } exit (gsl_test_summary ()); }
/** * C++ version of gsl_isinf(). * @param x A double. * @return 1 for infinite; 0 otherwise. */ inline int is_inf( double const x ){ return gsl_isinf( x ); }
void gsl_test_rel (double result, double expected, double relative_error, const char *test_description,...) { int status ; /* Check for NaN vs inf vs number */ if (gsl_isnan(result) || gsl_isnan(expected)) { status = gsl_isnan(result) != gsl_isnan(expected); } else if (gsl_isinf(result) || gsl_isinf(expected)) { status = gsl_isinf(result) != gsl_isinf(expected); } else if (expected != 0 ) { status = (fabs(result-expected)/fabs(expected) > relative_error) ; } else { status = (fabs(result) > relative_error) ; } tests++; if (status == 0) { passed++; if (verbose) printf ("PASS: "******"FAIL: "); } if (verbose) { #if HAVE_VPRINTF va_list ap; #ifdef STDC_HEADERS va_start (ap, test_description); #else va_start (ap); #endif vprintf (test_description, ap); va_end (ap); #endif if (status == 0) { if (strlen(test_description) < 45) { printf(" (%g observed vs %g expected)", result, expected) ; } else { printf(" (%g obs vs %g exp)", result, expected) ; } } else { printf(" (%.18g observed vs %.18g expected)", result, expected) ; } printf ("\n") ; fflush (stdout); } }
int main (void) { double y, y_expected; int e, e_expected; gsl_ieee_env_setup (); /* Test for expm1 */ y = gsl_expm1 (0.0); y_expected = 0.0; gsl_test_rel (y, y_expected, 1e-15, "gsl_expm1(0.0)"); y = gsl_expm1 (1e-10); y_expected = 1.000000000050000000002e-10; gsl_test_rel (y, y_expected, 1e-15, "gsl_expm1(1e-10)"); y = gsl_expm1 (-1e-10); y_expected = -9.999999999500000000017e-11; gsl_test_rel (y, y_expected, 1e-15, "gsl_expm1(-1e-10)"); y = gsl_expm1 (0.1); y_expected = 0.1051709180756476248117078264902; gsl_test_rel (y, y_expected, 1e-15, "gsl_expm1(0.1)"); y = gsl_expm1 (-0.1); y_expected = -0.09516258196404042683575094055356; gsl_test_rel (y, y_expected, 1e-15, "gsl_expm1(-0.1)"); y = gsl_expm1 (10.0); y_expected = 22025.465794806716516957900645284; gsl_test_rel (y, y_expected, 1e-15, "gsl_expm1(10.0)"); y = gsl_expm1 (-10.0); y_expected = -0.99995460007023751514846440848444; gsl_test_rel (y, y_expected, 1e-15, "gsl_expm1(-10.0)"); /* Test for log1p */ y = gsl_log1p (0.0); y_expected = 0.0; gsl_test_rel (y, y_expected, 1e-15, "gsl_log1p(0.0)"); y = gsl_log1p (1e-10); y_expected = 9.9999999995000000000333333333308e-11; gsl_test_rel (y, y_expected, 1e-15, "gsl_log1p(1e-10)"); y = gsl_log1p (0.1); y_expected = 0.095310179804324860043952123280765; gsl_test_rel (y, y_expected, 1e-15, "gsl_log1p(0.1)"); y = gsl_log1p (10.0); y_expected = 2.3978952727983705440619435779651; gsl_test_rel (y, y_expected, 1e-15, "gsl_log1p(10.0)"); /* Test for gsl_hypot */ y = gsl_hypot (0.0, 0.0); y_expected = 0.0; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(0.0, 0.0)"); y = gsl_hypot (1e-10, 1e-10); y_expected = 1.414213562373095048801688e-10; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1e-10, 1e-10)"); y = gsl_hypot (1e-38, 1e-38); y_expected = 1.414213562373095048801688e-38; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1e-38, 1e-38)"); y = gsl_hypot (1e-10, -1.0); y_expected = 1.000000000000000000005; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1e-10, -1)"); y = gsl_hypot (-1.0, 1e-10); y_expected = 1.000000000000000000005; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(-1, 1e-10)"); y = gsl_hypot (1e307, 1e301); y_expected = 1.000000000000499999999999e307; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1e307, 1e301)"); y = gsl_hypot (1e301, 1e307); y_expected = 1.000000000000499999999999e307; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1e301, 1e307)"); y = gsl_hypot (1e307, 1e307); y_expected = 1.414213562373095048801688e307; gsl_test_rel (y, y_expected, 1e-15, "gsl_hypot(1e307, 1e307)"); /* Test for acosh */ y = gsl_acosh (1.0); y_expected = 0.0; gsl_test_rel (y, y_expected, 1e-15, "gsl_acosh(1.0)"); y = gsl_acosh (1.1); y_expected = 4.435682543851151891329110663525e-1; gsl_test_rel (y, y_expected, 1e-15, "gsl_acosh(1.1)"); y = gsl_acosh (10.0); y_expected = 2.9932228461263808979126677137742e0; gsl_test_rel (y, y_expected, 1e-15, "gsl_acosh(10.0)"); y = gsl_acosh (1e10); y_expected = 2.3718998110500402149594646668302e1; gsl_test_rel (y, y_expected, 1e-15, "gsl_acosh(1e10)"); /* Test for asinh */ y = gsl_asinh (0.0); y_expected = 0.0; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(0.0)"); y = gsl_asinh (1e-10); y_expected = 9.9999999999999999999833333333346e-11; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(1e-10)"); y = gsl_asinh (-1e-10); y_expected = -9.9999999999999999999833333333346e-11; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(1e-10)"); y = gsl_asinh (0.1); y_expected = 9.983407889920756332730312470477e-2; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(0.1)"); y = gsl_asinh (-0.1); y_expected = -9.983407889920756332730312470477e-2; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(-0.1)"); y = gsl_asinh (1.0); y_expected = 8.8137358701954302523260932497979e-1; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(1.0)"); y = gsl_asinh (-1.0); y_expected = -8.8137358701954302523260932497979e-1; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(-1.0)"); y = gsl_asinh (10.0); y_expected = 2.9982229502979697388465955375965e0; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(10)"); y = gsl_asinh (-10.0); y_expected = -2.9982229502979697388465955375965e0; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(-10)"); y = gsl_asinh (1e10); y_expected = 2.3718998110500402149599646668302e1; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(1e10)"); y = gsl_asinh (-1e10); y_expected = -2.3718998110500402149599646668302e1; gsl_test_rel (y, y_expected, 1e-15, "gsl_asinh(-1e10)"); /* Test for atanh */ y = gsl_atanh (0.0); y_expected = 0.0; gsl_test_rel (y, y_expected, 1e-15, "gsl_atanh(0.0)"); y = gsl_atanh (1e-20); y_expected = 1e-20; gsl_test_rel (y, y_expected, 1e-15, "gsl_atanh(1e-20)"); y = gsl_atanh (-1e-20); y_expected = -1e-20; gsl_test_rel (y, y_expected, 1e-15, "gsl_atanh(-1e-20)"); y = gsl_atanh (0.1); y_expected = 1.0033534773107558063572655206004e-1; gsl_test_rel (y, y_expected, 1e-15, "gsl_atanh(0.1)"); y = gsl_atanh (-0.1); y_expected = -1.0033534773107558063572655206004e-1; gsl_test_rel (y, y_expected, 1e-15, "gsl_atanh(-0.1)"); y = gsl_atanh (0.9); y_expected = 1.4722194895832202300045137159439e0; gsl_test_rel (y, y_expected, 1e-15, "gsl_atanh(0.9)"); y = gsl_atanh (-0.9); y_expected = -1.4722194895832202300045137159439e0; gsl_test_rel (y, y_expected, 1e-15, "gsl_atanh(0.9)"); /* Test for pow_int */ y = gsl_pow_2 (-3.14); y_expected = pow (-3.14, 2.0); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_2(-3.14)"); y = gsl_pow_3 (-3.14); y_expected = pow (-3.14, 3.0); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_3(-3.14)"); y = gsl_pow_4 (-3.14); y_expected = pow (-3.14, 4.0); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_4(-3.14)"); y = gsl_pow_5 (-3.14); y_expected = pow (-3.14, 5.0); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_5(-3.14)"); y = gsl_pow_6 (-3.14); y_expected = pow (-3.14, 6.0); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_6(-3.14)"); y = gsl_pow_7 (-3.14); y_expected = pow (-3.14, 7.0); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_7(-3.14)"); y = gsl_pow_8 (-3.14); y_expected = pow (-3.14, 8.0); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_8(-3.14)"); y = gsl_pow_9 (-3.14); y_expected = pow (-3.14, 9.0); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_9(-3.14)"); { int n; for (n = -9; n < 10; n++) { y = gsl_pow_int (-3.14, n); y_expected = pow (-3.14, n); gsl_test_rel (y, y_expected, 1e-15, "gsl_pow_n(-3.14,%d)", n); } } /* Test for ldexp */ y = gsl_ldexp (M_PI, -2); y_expected = M_PI_4; gsl_test_rel (y, y_expected, 1e-15, "gsl_ldexp(pi,-2)"); y = gsl_ldexp (1.0, 2); y_expected = 4.000000; gsl_test_rel (y, y_expected, 1e-15, "gsl_ldexp(1.0,2)"); y = gsl_ldexp (0.0, 2); y_expected = 0.0; gsl_test_rel (y, y_expected, 1e-15, "gsl_ldexp(0.0,2)"); /* Test for frexp */ y = gsl_frexp (M_PI, &e); y_expected = M_PI_4; e_expected = 2; gsl_test_rel (y, y_expected, 1e-15, "gsl_frexp(pi) fraction"); gsl_test_int (e, e_expected, "gsl_frexp(pi) exponent"); y = gsl_frexp (2.0, &e); y_expected = 0.5; e_expected = 2; gsl_test_rel (y, y_expected, 1e-15, "gsl_frexp(2.0) fraction"); gsl_test_int (e, e_expected, "gsl_frexp(2.0) exponent"); y = gsl_frexp (1.0 / 4.0, &e); y_expected = 0.5; e_expected = -1; gsl_test_rel (y, y_expected, 1e-15, "gsl_frexp(0.25) fraction"); gsl_test_int (e, e_expected, "gsl_frexp(0.25) exponent"); y = gsl_frexp (1.0 / 4.0 - 4.0 * GSL_DBL_EPSILON, &e); y_expected = 0.999999999999996447; e_expected = -2; gsl_test_rel (y, y_expected, 1e-15, "gsl_frexp(0.25-eps) fraction"); gsl_test_int (e, e_expected, "gsl_frexp(0.25-eps) exponent"); /* Test for approximate floating point comparison */ { double x, y; int i; x = M_PI; y = 22.0 / 7.0; /* test the basic function */ for (i = 0; i < 10; i++) { double tol = pow (10, -i); int res = gsl_fcmp (x, y, tol); gsl_test_int (res, -(i >= 4), "gsl_fcmp(%.5f,%.5f,%g)", x, y, tol); } for (i = 0; i < 10; i++) { double tol = pow (10, -i); int res = gsl_fcmp (y, x, tol); gsl_test_int (res, (i >= 4), "gsl_fcmp(%.5f,%.5f,%g)", y, x, tol); } } #if HAVE_IEEE_COMPARISONS /* Test for isinf, isnan, finite */ { double zero, one, inf, nan; int s; zero = 0.0; one = 1.0; inf = exp (1.0e10); nan = inf / inf; s = gsl_isinf (zero); gsl_test_int (s, 0, "gsl_isinf(0)"); s = gsl_isinf (one); gsl_test_int (s, 0, "gsl_isinf(1)"); s = gsl_isinf (inf); gsl_test_int (s, 1, "gsl_isinf(inf)"); s = gsl_isinf (-inf); gsl_test_int (s, -1, "gsl_isinf(-inf)"); s = gsl_isinf (nan); gsl_test_int (s, 0, "gsl_isinf(nan)"); s = gsl_isnan (zero); gsl_test_int (s, 0, "gsl_isnan(0)"); s = gsl_isnan (one); gsl_test_int (s, 0, "gsl_isnan(1)"); s = gsl_isnan (inf); gsl_test_int (s, 0, "gsl_isnan(inf)"); s = gsl_isnan (nan); gsl_test_int (s, 1, "gsl_isnan(nan)"); s = gsl_finite (zero); gsl_test_int (s, 1, "gsl_finite(0)"); s = gsl_finite (one); gsl_test_int (s, 1, "gsl_finite(1)"); s = gsl_finite (inf); gsl_test_int (s, 0, "gsl_finite(inf)"); s = gsl_finite (nan); gsl_test_int (s, 0, "gsl_finite(nan)"); } #endif { double x = gsl_fdiv (2.0, 3.0); gsl_test_rel (x, 2.0 / 3.0, 4 * GSL_DBL_EPSILON, "gsl_fdiv(2,3)"); } exit (gsl_test_summary ()); }
int main( int argc, char * argv[] ) { Libnucnet *p_my_nucnet; Libnuceq *p_equil; Libnuceq__Cluster *p_cluster; nnt::Zone work_zone; gsl_vector * p_abundances, * p_z_wse = NULL, * p_z_nse, *p_z_qse, * p_z_net; size_t i; double d_ye_root, d_ye, d_yh, d_yh_nse, d_yh_wse; user::coul_corr_data my_coul_corr_data; //============================================================================ // Check input. //============================================================================ check_input( argc, argv ); //============================================================================ // Read input data. //============================================================================ p_my_nucnet = Libnucnet__new_from_xml( argv[1], NULL, NULL, argv[2] ); //============================================================================ // Check zones. //============================================================================ if( Libnucnet__getNumberOfZones( p_my_nucnet ) == 0 ) { std::cerr << "No zones." << std::endl; return EXIT_FAILURE; } //============================================================================ // Set weak views in zones. //============================================================================ user::set_weak_views_in_zones( p_my_nucnet ); //============================================================================ // Create a zone to store abundances temporarily. Get a net view for // copying to other zones. //============================================================================ work_zone.setNucnetZone( Libnucnet__Zone__new( Libnucnet__getNet( p_my_nucnet ), "work", NULL, NULL ) ); work_zone.getNetView( S_XPATH, "" ); //============================================================================ // Create an equilibrium. //============================================================================ p_equil = Libnuceq__new( Libnucnet__Net__getNuc( Libnucnet__getNet( p_my_nucnet ) ) ); //============================================================================ // Output largest Z. //============================================================================ fprintf( stdout, "Largest Z = %d\n", Libnucnet__Nuc__getLargestNucleonNumber( Libnucnet__Net__getNuc( Libnucnet__getNet( p_my_nucnet ) ), "z" ) ); //============================================================================ // Iterate zones. //============================================================================ Libnucnet__setZoneCompareFunction( p_my_nucnet, (Libnucnet__Zone__compare_function) nnt::zone_compare_by_first_label ); BOOST_FOREACH( nnt::Zone zone, nnt::make_zone_list( p_my_nucnet ) ) { Libnucnet__Zone__copy_net_views( zone.getNucnetZone(), work_zone.getNucnetZone() ); p_z_net = Libnucnet__Zone__getSummedAbundances( zone.getNucnetZone(), "z" ); d_ye = Libnucnet__Zone__computeZMoment( zone.getNucnetZone(), 1 ); d_yh = user::compute_cluster_abundance_moment( zone, S_XPATH, "a", 0 ); //========================================================================== // Add Coulomb correction if present. Otherwise clear it. //========================================================================== if( zone.hasProperty( nnt::s_USE_SCREENING) ) { my_coul_corr_data = user::get_coulomb_corr_data(); Libnuceq__setNseCorrectionFactorFunction( p_equil, (Libnucnet__Species__nseCorrectionFactorFunction) user::my_coulomb_correction, &my_coul_corr_data ); } else { Libnuceq__clearNseCorrectionFactorFunction( p_equil ); } //========================================================================== // Compute NSE. //========================================================================== Libnuceq__setYe( p_equil, Libnucnet__Zone__computeZMoment( zone.getNucnetZone(), 1 ) ); Libnuceq__computeEquilibrium( p_equil, boost::lexical_cast<double>( zone.getProperty( nnt::s_T9 ) ), boost::lexical_cast<double>( zone.getProperty( nnt::s_RHO ) ) ); p_abundances = Libnuceq__getAbundances( p_equil ); Libnucnet__Zone__updateAbundances( work_zone.getNucnetZone(), p_abundances ); p_z_nse = Libnucnet__Zone__getSummedAbundances( work_zone.getNucnetZone(), "z" ); gsl_vector_free( p_abundances ); d_yh_nse = user::compute_cluster_abundance_moment( work_zone, S_XPATH, "a", 0 ); //========================================================================== // Compute QSE. //========================================================================== p_cluster = Libnuceq__newCluster( p_equil, S_XPATH ); Libnuceq__Cluster__updateConstraint( p_cluster, user::compute_cluster_abundance_moment( zone, S_XPATH, "a", 0 ) ); Libnuceq__computeEquilibrium( p_equil, boost::lexical_cast<double>( zone.getProperty( nnt::s_T9 ) ), boost::lexical_cast<double>( zone.getProperty( nnt::s_RHO ) ) ); p_abundances = Libnuceq__getAbundances( p_equil ); Libnucnet__Zone__updateAbundances( work_zone.getNucnetZone(), p_abundances ); p_z_qse = Libnucnet__Zone__getSummedAbundances( work_zone.getNucnetZone(), "z" ); gsl_vector_free( p_abundances ); Libnuceq__removeCluster( p_equil, p_cluster ); //========================================================================== // Compute WSE. Do it last for a zone because it modifies Ye. //========================================================================== if( argc == 4 ) { if( zone.hasProperty( nnt::s_USE_SCREENING) ) { zone.updateNseCorrectionFactorFunction( (Libnucnet__Species__nseCorrectionFactorFunction) user::my_coulomb_correction, &my_coul_corr_data ); } if( gsl_isinf( zone.getElectronNeutrinoChemicalPotential() ) != -1 ) { Libnuceq__clearYe( p_equil ); Libnuceq__computeEquilibrium( p_equil, boost::lexical_cast<double>( zone.getProperty( nnt::s_T9 ) ), boost::lexical_cast<double>( zone.getProperty( nnt::s_RHO ) ) ); p_abundances = Libnuceq__getAbundances( p_equil ); d_ye_root = Libnuceq__computeZMoment( p_equil, 1 ); Libnucnet__Zone__updateAbundances( zone.getNucnetZone(), p_abundances ); d_yh_wse = user::compute_cluster_abundance_moment( zone, S_XPATH, "a", 0 ); p_z_wse = Libnucnet__Zone__getSummedAbundances( zone.getNucnetZone(), "z" ); gsl_vector_free( p_abundances ); } else { user::register_my_rate_functions( Libnucnet__Net__getReac( Libnucnet__Zone__getNet( zone.getNucnetZone() ) ) ); user::update_my_rate_functions_data( zone ); d_ye_root = zone.computeRootFromQuantity( (nnt::quantityFunction) user::my_yedot_root, &zone ); d_yh_wse = user::compute_cluster_abundance_moment( zone, S_XPATH, "a", 0 ); p_z_wse = Libnucnet__Zone__getSummedAbundances( zone.getNucnetZone(), "z" ); } } //========================================================================== // Print out. //========================================================================== if( zone.hasProperty( nnt::s_TIME ) ) std::cout << "time = " << zone.getProperty( nnt::s_TIME ) << std::endl; std::cout << "t9 = " << zone.getProperty( nnt::s_T9 ) << std::endl; std::cout << "rho = " << zone.getProperty( nnt::s_RHO ) << std::endl; std::cout << "Ye = " << d_ye << std::endl; if( argc == 4 ) std::cout << "Ye_wse = " << d_ye_root << std::endl; std::cout << "Yh = " << d_yh << std::endl; std::cout << "Yh_nse = " << d_yh_nse << std::endl; if( argc == 4 ) std::cout << "Yh_wse = " << d_yh_wse << std::endl; for( i = 0; i <= Libnucnet__Nuc__getLargestNucleonNumber( Libnucnet__Net__getNuc( Libnucnet__getNet( p_my_nucnet ) ), "z" ); i++ ) { if( argc == 4 ) { fprintf( stdout, "%lu %e %e %e %e\n", (unsigned long) i, gsl_vector_get( p_z_net, i ), gsl_vector_get( p_z_nse, i ), gsl_vector_get( p_z_qse, i ), gsl_vector_get( p_z_wse, i ) ); } else { fprintf( stdout, "%lu %e %e %e\n", (unsigned long) i, gsl_vector_get( p_z_net, i ), gsl_vector_get( p_z_nse, i ), gsl_vector_get( p_z_qse, i ) ); } } gsl_vector_free( p_z_net ); gsl_vector_free( p_z_nse ); gsl_vector_free( p_z_qse ); gsl_vector_free( p_z_wse ); std::cout << std::endl; }
/* * Computes node and edge betweenness for a weighted graph. */ MATRIX_T* BCT_NAMESPACE::edge_betweenness_wei(const MATRIX_T* G, VECTOR_T** BC) { if (safe_mode) check_status(G, SQUARE | WEIGHTED, "edge_betweenness_wei"); // n=length(G); int n = length(G); // BC=zeros(n,1); if (BC != NULL) { *BC = zeros_vector(n); } // EBC=zeros(n); MATRIX_T* EBC = zeros(n); // for u=1:n for (int u = 0; u < n; u++) { // D=inf(1,n); D(u) = 0; VECTOR_T* D = VECTOR_ID(alloc)(n); VECTOR_ID(set_all)(D, GSL_POSINF); VECTOR_ID(set)(D, u, 0.0); // NP=zeros(1,n); NP(u)=1; VECTOR_T* NP = zeros_vector(n); VECTOR_ID(set)(NP, u, 1.0); // S=true(1,n); VECTOR_T* S = VECTOR_ID(alloc)(n); VECTOR_ID(set_all)(S, 1.0); // P=false(n); MATRIX_T* P = MATRIX_ID(calloc)(n, n); // Q=zeros(1,n); q=n; VECTOR_T* Q = zeros_vector(n); int q = n - 1; // G1=G; MATRIX_T* G1 = copy(G); // V=u; VECTOR_T* V = VECTOR_ID(alloc)(1); VECTOR_ID(set)(V, 0, (FP_T)u); // while 1 while (true) { // S(V)=0; ordinal_index_assign(S, V, 0.0); // G1(:,V)=0; VECTOR_T* G1_rows = sequence(0, G1->size1 - 1); ordinal_index_assign(G1, G1_rows, V, 0.0); VECTOR_ID(free)(G1_rows); // for v=V for (int i_V = 0; i_V < (int)V->size; i_V++) { int v = (int)VECTOR_ID(get)(V, i_V); // Q(q)=v; q=q-1; VECTOR_ID(set)(Q, q--, (FP_T)v); // W=find(G1(v,:)); VECTOR_ID(view) G1_row_v = MATRIX_ID(row)(G1, v); VECTOR_T* W = find(&G1_row_v.vector); if (W != NULL) { // for w=W for (int i_W = 0; i_W < (int)W->size; i_W++) { int w = (int)VECTOR_ID(get)(W, i_W); // Duw=D(v)+G1(v,w); FP_T Duw = VECTOR_ID(get)(D, v) + MATRIX_ID(get)(G1, v, w); // if Duw<D(w) if (Duw < VECTOR_ID(get)(D, w)) { // D(w)=Duw; VECTOR_ID(set)(D, w, Duw); // NP(w)=NP(v); VECTOR_ID(set)(NP, w, VECTOR_ID(get)(NP, v)); // P(w,:)=0; VECTOR_ID(view) P_row_w = MATRIX_ID(row)(P, w); VECTOR_ID(set_zero)(&P_row_w.vector); // P(w,v)=1; MATRIX_ID(set)(P, w, v, 1.0); // elseif Duw==D(w) } else if (fp_equal(Duw, VECTOR_ID(get)(D, w))) { // NP(w)=NP(w)+NP(v); VECTOR_ID(set)(NP, w, VECTOR_ID(get)(NP, w) + VECTOR_ID(get)(NP, v)); // P(w,v)=1; MATRIX_ID(set)(P, w, v, 1.0); } } VECTOR_ID(free)(W); } } // if isempty(minD), break if (nnz(S) == 0) { break; } else { // minD=min(D(S)) VECTOR_T* D_S = logical_index(D, S); FP_T minD = VECTOR_ID(min)(D_S); VECTOR_ID(free)(D_S); // elseif isinf(minD), if (gsl_isinf(minD) == 1) { // Q(1:q)=find(isinf(D)); break VECTOR_T* isinf_D = compare_elements(D, fp_equal, GSL_POSINF); VECTOR_T* find_isinf_D = find(isinf_D); VECTOR_ID(free)(isinf_D); VECTOR_ID(view) Q_subv = VECTOR_ID(subvector)(Q, 0, q + 1); VECTOR_ID(memcpy)(&Q_subv.vector, find_isinf_D); VECTOR_ID(free)(find_isinf_D); break; } // V=find(D==minD); VECTOR_ID(free)(V); VECTOR_T* D_eq_minD = compare_elements(D, fp_equal, minD); V = find(D_eq_minD); VECTOR_ID(free)(D_eq_minD); } } VECTOR_ID(free)(D); VECTOR_ID(free)(S); MATRIX_ID(free)(G1); VECTOR_ID(free)(V); // DP=zeros(n,1); VECTOR_T* DP = zeros_vector(n); // for w=Q(1:n-1); for (int i_Q = 0; i_Q < n - 1; i_Q++) { int w = (int)VECTOR_ID(get)(Q, i_Q); // BC(w)=BC(w)+DP(w) if (BC != NULL) { VECTOR_ID(set)(*BC, w, VECTOR_ID(get)(*BC, w) + VECTOR_ID(get)(DP, w)); } // for v=find(P(w,:)) VECTOR_ID(view) P_row_w = MATRIX_ID(row)(P, w); VECTOR_T* find_P_row_w = find(&P_row_w.vector); if (find_P_row_w != NULL) { for (int i_find_P_row_w = 0; i_find_P_row_w < (int)find_P_row_w->size; i_find_P_row_w++) { int v = (int)VECTOR_ID(get)(find_P_row_w, i_find_P_row_w); // DPvw=(1+DP(w)).*NP(v)./NP(w); FP_T DP_w = VECTOR_ID(get)(DP, w); FP_T NP_v = VECTOR_ID(get)(NP, v); FP_T NP_w = VECTOR_ID(get)(NP, w); FP_T DPvw = (1 + DP_w) * NP_v / NP_w; // DP(v)=DP(v)+DPvw; VECTOR_ID(set)(DP, v, VECTOR_ID(get)(DP, v) + DPvw); // EBC(v,w)=EBC(v,w)+DPvw; MATRIX_ID(set)(EBC, v, w, MATRIX_ID(get)(EBC, v, w) + DPvw); } VECTOR_ID(free)(find_P_row_w); } } VECTOR_ID(free)(NP); MATRIX_ID(free)(P); VECTOR_ID(free)(Q); VECTOR_ID(free)(DP); } return EBC; }