double whittleMatern(double *dist, int n, double nugget, double sill, double range, double smooth, double *rho){ //This function computes the whittle-matern covariance function //between each pair of locations. //When ans != 0.0, the whittle-matern parameters are ill-defined. const double cst = sill * R_pow(2, 1 - smooth) / gammafn(smooth), irange = 1 / range; //Some preliminary steps: Valid points? if (smooth < EPS) return (1 - smooth + EPS) * (1 - smooth + EPS) * MINF; else if (smooth > 100) /* Not really required but larger smooth parameters are unlikely to occur */ return (smooth - 99) * (smooth - 99) * MINF; if (range <= 0) return (1 - range) * (1 - range) * MINF; if (sill <= 0) return (1 - sill) * (1 - sill) * MINF; if (nugget < 0) return (1 - nugget) * (1 - nugget) * MINF; #pragma omp parallel for for (int i=0;i<n;i++){ double cst2 = dist[i] * irange; if (cst2 == 0) rho[i] = sill + nugget; else rho[i] = cst * R_pow(cst2, smooth) * bessel_k(cst2, smooth, 1); } return 0.0; }
Real geoRmatern(Real uphi, Real kappa) { /* WARNING: THIS FUNCTION IS COPIED IN geoRglmm NOTIFY OLE ABOUT ANY CHANGE */ Real ans,cte; if (uphi==0) return 1; else{ if (kappa==0.5) ans = exp(-uphi); else { cte = R_pow(2, (-(kappa-1)))/gammafn(kappa); ans = cte * R_pow(uphi, kappa) * bessel_k(uphi, kappa, 1); } } /* Rprintf(" ans=%d ", ans); */ return ans; }
void F77_CALL(fbesselk)(double *x,double *alpha, double *y){ *y=bessel_k(*x, *alpha, 1.0);}
int main() { #include "bessel_k_int_data.ipp" add_data(k0_data); add_data(k1_data); add_data(kn_data); add_data(bessel_k_int_data); unsigned data_total = data.size(); screen_data([](const std::vector<double>& v){ return boost::math::cyl_bessel_k(static_cast<int>(v[0]), v[1]); }, [](const std::vector<double>& v){ return v[2]; }); #if defined(TEST_LIBSTDCXX) && !defined(COMPILER_COMPARISON_TABLES) screen_data([](const std::vector<double>& v){ return std::tr1::cyl_bessel_k(static_cast<int>(v[0]), v[1]); }, [](const std::vector<double>& v){ return v[2]; }); #endif #if defined(TEST_GSL) && !defined(COMPILER_COMPARISON_TABLES) screen_data([](const std::vector<double>& v){ return gsl_sf_bessel_Kn(static_cast<int>(v[0]), v[1]); }, [](const std::vector<double>& v){ return v[2]; }); #endif #if defined(TEST_RMATH) && !defined(COMPILER_COMPARISON_TABLES) screen_data([](const std::vector<double>& v){ return bessel_k(v[1], static_cast<int>(v[0]), 1); }, [](const std::vector<double>& v){ return v[2]; }); #endif unsigned data_used = data.size(); std::string function = "cyl_bessel_k (integer order)[br](" + boost::lexical_cast<std::string>(data_used) + "/" + boost::lexical_cast<std::string>(data_total) + " tests selected)"; std::string function_short = "cyl_bessel_k (integer order)"; double time; time = exec_timed_test([](const std::vector<double>& v){ return boost::math::cyl_bessel_k(static_cast<int>(v[0]), v[1]); }); std::cout << time << std::endl; #if !defined(COMPILER_COMPARISON_TABLES) && (defined(TEST_GSL) || defined(TEST_RMATH) || defined(TEST_LIBSTDCXX)) report_execution_time(time, std::string("Library Comparison with ") + std::string(compiler_name()) + std::string(" on ") + platform_name(), function, boost_name()); #endif report_execution_time(time, std::string("Compiler Comparison on ") + std::string(platform_name()), function_short, compiler_name() + std::string("[br]") + boost_name()); // // Boost again, but with promotion to long double turned off: // #if !defined(COMPILER_COMPARISON_TABLES) if(sizeof(long double) != sizeof(double)) { time = exec_timed_test([](const std::vector<double>& v){ return boost::math::cyl_bessel_k(static_cast<int>(v[0]), v[1], boost::math::policies::make_policy(boost::math::policies::promote_double<false>())); }); std::cout << time << std::endl; #if !defined(COMPILER_COMPARISON_TABLES) && (defined(TEST_GSL) || defined(TEST_RMATH) || defined(TEST_LIBSTDCXX)) report_execution_time(time, std::string("Library Comparison with ") + std::string(compiler_name()) + std::string(" on ") + platform_name(), function, boost_name() + "[br]promote_double<false>"); #endif report_execution_time(time, std::string("Compiler Comparison on ") + std::string(platform_name()), function_short, compiler_name() + std::string("[br]") + boost_name() + "[br]promote_double<false>"); } #endif #if defined(TEST_LIBSTDCXX) && !defined(COMPILER_COMPARISON_TABLES) time = exec_timed_test([](const std::vector<double>& v){ return std::tr1::cyl_bessel_k(static_cast<int>(v[0]), v[1]); }); std::cout << time << std::endl; report_execution_time(time, std::string("Library Comparison with ") + std::string(compiler_name()) + std::string(" on ") + platform_name(), function, "tr1/cmath"); #endif #if defined(TEST_GSL) && !defined(COMPILER_COMPARISON_TABLES) time = exec_timed_test([](const std::vector<double>& v){ return gsl_sf_bessel_Kn(static_cast<int>(v[0]), v[1]); }); std::cout << time << std::endl; report_execution_time(time, std::string("Library Comparison with ") + std::string(compiler_name()) + std::string(" on ") + platform_name(), function, "GSL " GSL_VERSION); #endif #if defined(TEST_RMATH) && !defined(COMPILER_COMPARISON_TABLES) time = exec_timed_test([](const std::vector<double>& v){ return bessel_k(v[1], static_cast<int>(v[0]), 1); }); std::cout << time << std::endl; report_execution_time(time, std::string("Library Comparison with ") + std::string(compiler_name()) + std::string(" on ") + platform_name(), function, "Rmath " R_VERSION_STRING); #endif return 0; }