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