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;
}
int main() {
double x, a, b, param;
double nu1[1+ 9];
double nu2[1+26];
int i, j;
printf("\nProgram for calculating minimal detectable differences ");
printf("for general ANOVA models\n");
printf("Copyright (C) 2008, Ali Baharev, All rights reserved.\n");
printf("This program comes with ABSOLUTELY NO WARRANTY.\n");
printf("This is free software, and you are welcome to redistribute it\n");
printf("under certain conditions (GNU GPL).\n\n");
printf("The output of this program is the corrected table of \n");
printf("Lorenzen and Anderson (1993) Appendix 12, p. 374\n\n");
for (i=1; i<=6; ++i)
nu1[i] = i;
nu1[7] = 10;
nu1[8] = 20;
nu1[9] = 50;
for (i=1; i<=8; ++i)
nu2[i] = i;
for (i=9; i<=19; ++i)
nu2[i] = 2*i-8;
for (i=20; i<=23; ++i)
nu2[i] = 20*(i-18);
nu2[24] = 200;
nu2[25] = 500;
nu2[26] = 1000;
for (j=1; j<=26; ++j) {
for (i=1; i<=9; ++i) {
a = nu1[i]/2.0;
b = nu2[j]/2.0;
/* Type I error probability 0.05
Type II error probability 0.10 */
x = qbeta(0.95, a, b, 1, 0);
param = sqrt( ncbeta( 0.10, x, a, b)/nu1[i]);
printf("%f\t", param);
}
printf("\n");
}
return 0;
}
Type objective_function<Type>::operator() ()
{
DATA_VECTOR(y);
PARAMETER(phi);
PARAMETER(shape1);
PARAMETER(shape2);
PARAMETER(sd);
PARAMETER_VECTOR(u);
Type res = 0;
res += density::AR1(phi)(u);
vector<Type> unif = pnorm(u, Type(0), Type(1));
vector<Type> x = qbeta(unif, shape1, shape2);
res -= dnorm(y, x, sd, true).sum();
return res;
}
double F77_SUB(invcdfbetas)(double *p, double *a, double *b, int *lower_tail, int *log_p)
{
return qbeta(*p, *a, *b, *lower_tail, *log_p);
}
