double loghyperg1F1(double a, double b, double x, int laplace) { double y; if (laplace == 0) { if (x <0) { /* Since Linux system tends to report error for negative x, we use the following fomular to convert it to positive value 1F1(a, b, x) = 1F1(b - a, b, -x) * exp(x) */ y = log(hyperg(b-a, b, -x)) + x; } else { y = log( hyperg(a, b, x)); } } else { /* Laplace approximation assumes -x for x positive if ( x <= 0.0 ){y = loghyperg1F1_laplace(a, b, -x); } else { y = loghyperg1F1_laplace(b - a, b, x) + x;} */ y = loghyperg1F1_laplace(a, b, x); } // Rprintf("LOG Cephes 1F1(%lf, %lf, %lf) = %lf (%lf)\n", a,b,x,log(y), y); // ly = hyperg1F1_laplace(a,b,x); // Rprintf("called from hyperg1F1: LOG Pos 1F1(%lf, %lf, %lf) = %lf (%lf)\n", a,b,x,ly, exp(ly)); if (!R_FINITE(y) && laplace == 0) { warning("Cephes 1F1 function returned NA, using Laplace approximation"); y = loghyperg1F1_laplace(a, b, x); // try Laplace approximation } return(y); }
double hyperg(double a, double b, double x) { double asum, psum, acanc, pcanc = 0, temp; /* See if a Kummer transformation will help */ temp = b - a; if (fabs(temp) < 0.001 * fabs(a)) return(exp(x) * hyperg(temp, b, -x)); psum = hy1f1p(a, b, x, &pcanc); if (pcanc < 1.0e-15) goto done; /* try asymptotic series */ asum = hy1f1a(a, b, x, &acanc); /* Pick the result with less estimated error */ if (acanc < pcanc) { pcanc = acanc; psum = asum; } done: if (pcanc > 1.0e-12) { it_warning("hyperg(): partial loss of precision"); } return(psum); }
double hyperg (double a, double b, double x) { double asum, psum, acanc, temp, pcanc = 0; /* See if a Kummer transformation will help */ temp = b - a; if (fabs(temp) < 0.001 * fabs(a)) return exp(x) * hyperg(temp, b, -x); psum = hy1f1p(a, b, x, &pcanc); if (pcanc < 1.0e-15) goto done; /* try asymptotic series */ asum = hy1f1a(a, b, x, &acanc); /* Pick the result with less estimated error */ if (acanc < pcanc) { pcanc = acanc; psum = asum; } done: if (pcanc > 1.0e-12) mtherr("hyperg", CEPHES_PLOSS); return psum; }
double cephes_bessel_Iv (double v, double x) { double ax, t = floor(v); int sign; /* If v is a negative integer, invoke symmetry */ if (v < 0.0 && t == v) { t = v = -v; } /* If x is negative, require v to be an integer */ sign = 1; if (x < 0.0) { if (t != v) { mtherr("iv", DOMAIN); return 0.0; } if (v != 2.0 * floor(v/2.0)) sign = -1; } /* Avoid logarithm singularity */ if (x == 0.0) { if (v == 0.0) return 1.0; if (v < 0.0) { mtherr("iv", CEPHES_OVERFLOW); return MAXNUM; } else return 0.0; } ax = fabs(x); t = v * log(0.5 * ax) - x; t = sign * exp(t) / cephes_gamma(v + 1.0); ax = v + 0.5; return t * hyperg(ax, 2*ax, 2*x); }