double pf(double x, double df1, double df2, int lower_tail, int log_p)
{
#ifdef IEEE_754
if (ISNAN(x) || ISNAN(df1) || ISNAN(df2))
return x + df2 + df1;
#endif
if (df1 <= 0. || df2 <= 0.) ML_ERR_return_NAN;
R_P_bounds_01(x, 0., ML_POSINF);
/* move to pchisq for very large values - was 'df1 > 4e5' in 2.0.x,
now only needed for df1 = Inf or df2 = Inf {since pbeta(0,*)=0} : */
if (df2 == ML_POSINF) {
if (df1 == ML_POSINF) {
if(x < 1.) return R_DT_0;
if(x == 1.) return (log_p ? -M_LN2 : 0.5);
if(x > 1.) return R_DT_1;
}
return pchisq(x * df1, df1, lower_tail, log_p);
}
if (df1 == ML_POSINF)/* was "fudge" 'df1 > 4e5' in 2.0.x */
return pchisq(df2 / x , df2, !lower_tail, log_p);
/* Avoid squeezing pbeta's first parameter against 1 : */
if (df1 * x > df2)
x = pbeta(df2 / (df2 + df1 * x), df2 / 2., df1 / 2.,
!lower_tail, log_p);
else
x = pbeta(df1 * x / (df2 + df1 * x), df1 / 2., df2 / 2.,
lower_tail, log_p);
return ML_VALID(x) ? x : ML_NAN;
}
double qf(double p, double df1, double df2, int lower_tail, int log_p)
{
#ifdef IEEE_754
if (ISNAN(p) || ISNAN(df1) || ISNAN(df2))
return p + df1 + df2;
#endif
if (df1 <= 0. || df2 <= 0.) ML_ERR_return_NAN;
R_Q_P01_boundaries(p, 0, ML_POSINF);
/* fudge the extreme DF cases -- qbeta doesn't do this well.
But we still need to fudge the infinite ones.
*/
if (df1 <= df2 && df2 > 4e5) {
if(!R_FINITE(df1)) /* df1 == df2 == Inf : */
return 1.;
/* else */
return qchisq(p, df1, lower_tail, log_p) / df1;
}
if (df1 > 4e5) { /* and so df2 < df1 */
return df2 / qchisq(p, df2, !lower_tail, log_p);
}
p = (1. / qbeta(p, df2/2, df1/2, !lower_tail, log_p) - 1.) * (df2 / df1);
return ML_VALID(p) ? p : ML_NAN;
}
double pf(double x, double n1, double n2, int lower_tail, int log_p)
{
#ifdef IEEE_754
if (ISNAN(x) || ISNAN(n1) || ISNAN(n2))
return x + n2 + n1;
#endif
if (n1 <= 0. || n2 <= 0.) ML_ERR_return_NAN;
if (x <= 0.)
return R_DT_0;
/* fudge the extreme DF cases -- pbeta doesn't do this well */
if (n2 > 4e5)
return pchisq(x * n1, n1, lower_tail, log_p);
if (n1 > 4e5)
return pchisq(n2 / x , n2, !lower_tail, log_p);
x = pbeta(n2 / (n2 + n1 * x), n2 / 2.0, n1 / 2.0,
!lower_tail, log_p);
return ML_VALID(x) ? x : numeric_limits<double>::quiet_NaN();
}
