void mbetai (header *hd)
{ header *result,*st=hd,*hda,*hdb;
double x;
hda=nextof(hd);
hdb=nextof(hda);
hd=getvalue(hd); if (error) return;
hda=getvalue(hda); if (error) return;
hdb=getvalue(hdb); if (error) return;
if (hd->type!=s_real || hda->type!=s_real ||
hdb->type!=s_real)
wrong_arg_in("betai");
x=betai(*realof(hd),*realof(hda),*realof(hdb));
if (error) return;
result=new_real(x,""); if (error) return;
moveresult(st,result);
}
int main(int argc, char *argv[])
{
/* Get all inputs */
optionInit(&argc, argv, options);
if (argc != 4) usage();
double alpha, beta, x;
alpha = atof(argv[1]);
beta = atof(argv[2]);
x = atof(argv[3]);
printf("%f\n", betai(alpha, beta, x));
optionFree();
return 0;
}
void tptest(float data1[], float data2[], unsigned long n, float *t,
float *prob)
{
void avevar(float data[], unsigned long n, float *ave, float *var);
float betai(float a, float b, float x);
unsigned long j;
float var1,var2,ave1,ave2,sd,df,cov=0.0;
avevar(data1,n,&ave1,&var1);
avevar(data2,n,&ave2,&var2);
for (j=1; j<=n; j++)
cov += (data1[j]-ave1)*(data2[j]-ave2);
cov /= df=n-1;
sd=sqrt((var1+var2-2.0*cov)/n);
*t=(ave1-ave2)/sd;
*prob=betai(0.5*df,0.5,df/(df+(*t)*(*t)));
}
void Spearman(Vector & v1, Vector & v2,
double & rankD, double & zD, double & probD,
double & spearmanR, double & probSR)
{
double varD, sg, sf, fac, en3n, en, df, aveD, t;
Vector wksp1, wksp2;
wksp1.Copy(v1);
wksp2.Copy(v2);
wksp1.Sort(wksp2);
sf = crank(wksp1);
wksp2.Sort(wksp1);
sg = crank(wksp2);
rankD = 0;
for (int j = 0; j < v1.dim; j++)
// sum the square difference of ranks
{
double temp = wksp1[j] - wksp2[j];
rankD += temp * temp;
}
en = v1.dim;
en3n = en*en*en - en;
aveD = en3n / 6.0 - (sf + sg) / 12.0;
fac = (1.0 - sf/en3n) * (1.0 - sg/en3n);
varD = ((en - 1.0)*en*en*(en + 1.0)*(en + 1.0)/36.0)*fac;
zD = (rankD - aveD) / sqrt(varD);
probD = erfcc(fabs(zD)/1.4142136);
spearmanR = (1.0 - (6.0/en3n)*(rankD+(sf+sg)/12.0))/sqrt(fac);
fac = (spearmanR + 1.0) * (1.0 - spearmanR);
if (fac)
{
t = (spearmanR) * sqrt((en - 2.0)/fac);
df = en - 2.0;
probSR = betai(0.5 * df, 0.5, df/(df + t*t));
}
else
probSR = 0.0;
}
void NR::ftest(Vec_I_DP &data1, Vec_I_DP &data2, DP &f, DP &prob)
{
DP var1,var2,ave1,ave2,df1,df2;
int n1=data1.size();
int n2=data2.size();
avevar(data1,ave1,var1);
avevar(data2,ave2,var2);
if (var1 > var2) {
f=var1/var2;
df1=n1-1;
df2=n2-1;
} else {
f=var2/var1;
df1=n2-1;
df2=n1-1;
}
prob = 2.0*betai(0.5*df2,0.5*df1,df2/(df2+df1*f));
if (prob > 1.0) prob=2.0-prob;
}
void spear(float data1[], float data2[], unsigned long n, float *d, float *zd,
float *probd, float *rs, float *probrs)
{
float betai(float a, float b, float x);
void crank(unsigned long n, float w[], float *s);
float erfcc(float x);
void sort2(unsigned long n, float arr[], float brr[]);
unsigned long j;
float vard,t,sg,sf,fac,en3n,en,df,aved,*wksp1,*wksp2;
wksp1=vector(1,n);
wksp2=vector(1,n);
for (j=1;j<=n;j++) {
wksp1[j]=data1[j];
wksp2[j]=data2[j];
}
sort2(n,wksp1,wksp2);
crank(n,wksp1,&sf);
sort2(n,wksp2,wksp1);
crank(n,wksp2,&sg);
*d=0.0;
for (j=1;j<=n;j++)
*d += SQR(wksp1[j]-wksp2[j]);
en=n;
en3n=en*en*en-en;
aved=en3n/6.0-(sf+sg)/12.0;
fac=(1.0-sf/en3n)*(1.0-sg/en3n);
vard=((en-1.0)*en*en*SQR(en+1.0)/36.0)*fac;
*zd=(*d-aved)/sqrt(vard);
*probd=erfcc(fabs(*zd)/1.4142136);
*rs=(1.0-(6.0/en3n)*(*d+(sf+sg)/12.0))/sqrt(fac);
fac=(*rs+1.0)*(1.0-(*rs));
if (fac > 0.0) {
t=(*rs)*sqrt((en-2.0)/fac);
df=en-2.0;
*probrs=betai(0.5*df,0.5,df/(df+t*t));
} else
*probrs=0.0;
free_vector(wksp2,1,n);
free_vector(wksp1,1,n);
}
void ftest(float data1[], unsigned long n1, float data2[], unsigned long n2,
float *f, float *prob)
{
void avevar(float data[], unsigned long n, float *ave, float *var);
float beta1(float a, float b, float x);
float var1, var2, ave1, ave2, df1, df2;
avevar(data1, n1, &ave1, &var1);
avevar(data2, n2, &ave2, &var2);
if (var1 > var2) {
*f = var1 / var2;
df1 = n1 - 1;
df2 = n2 - 1;
}
else {
*f = var2 / var1;
df1 = n2 - 1;
df2 = n1 - 1;
}
*prob = 2.0*betai(0.5*df2, 0.5*df1, df2 / (df2 + df1*(*f)));
if (*prob > 1.0) *prob = 2.0 - *prob;
}
/* Given d1 and d2, this routine returns Student's t in *t, and
\ its significance as the result, small values indicating that the arrays have significantly differ-
\ ent means. The data arrays are allowed to be drawn from populations with unequal variances.
*/
double SS_TTest_uneq( SimpleStats *d1, SimpleStats *d2, double *t )
{ double var1, var2, df, lt;
int n1= d1->count, n2= d2->count;
if( !t ){
t= <
}
if( !d1->curV || !d2->curV || n1< 2 || n2< 2 ){
*t= -1;
return( 2 );
}
if( !d1->stdved ){
SS_St_Dev(d1);
}
var1= d1->stdv * d1->stdv;
if( !d2->stdved ){
SS_St_Dev(d2);
}
var2= d2->stdv * d2->stdv;
*t= ( d1->mean - d2->mean )/ sqrt( var1/n1 + var2/n2 );
df= SQR( var1/n1 + var2/n2 )/ ( SQR(var1/n1)/(n1-1) + SQR(var2/n2)/(n2-1) );
return( betai( 0.5* df, 0.5, df/(df+ (*t)*(*t)) ) );
}
/* Given the arrays data1[1..n1] and data2[1..n2], this routine returns the value of f, and
\its significance as prob. Small values of prob indicate that the two arrays have significantly
\different variances.
*/
double SS_FTest( SimpleStats *d1, SimpleStats *d2, double *f )
{ double var1, var2, lf, df1, df2, prob;
int n1= d1->count, n2= d2->count;
if( !f ){
f= &lf;
}
if( !d1->curV || !d2->curV || n1< 2 || n2< 2 ){
*f= -1;
return( 2 );
}
if( !d1->stdved ){
SS_St_Dev(d1);
}
var1= d1->stdv * d1->stdv;
if( !d2->stdved ){
SS_St_Dev(d2);
}
var2= d2->stdv * d2->stdv;
if( var1 > var2 ){
/* Make F the ratio of the larger variance to the smaller one. */
*f= var1/var2;
df1= n1-1;
df2= n2-1;
}
else{
*f= var2/var1;
df1= n2-1;
df2= n1-1;
}
prob = 2.0* betai( 0.5* df2, 0.5* df1, df2/(df2 + df1*(*f)) );
if( prob > 1.0){
prob= 2.0- prob;
}
return( prob );
}
/** beta distribution function for df1b2variable objects (alias of betai).
\param x \f$x\f$
\param a \f$a\f$
\param b \f$b\f$
\param maxit Maximum number of iterations for the continued fraction approximation in betacf.
\return Incomplete beta function \f$I_x(a,b)\f$
\n\n The implementation of this algorithm was inspired by
"Numerical Recipes in C", 2nd edition,
Press, Teukolsky, Vetterling, Flannery, chapter 2
*/
df1b2variable pbeta(double x, const df1b2variable & a,const df1b2variable & b, int maxit){
return betai(a,b,x,maxit);
}
/** beta distribution function for constant objects (alias of ibeta function with same arguments order as in R).
\param x \f$x\f$
\param a \f$a\f$
\param b \f$b\f$
\param maxit Maximum number of iterations for the continued fraction approximation in betacf.
\return Incomplete beta function \f$I_x(a,b)\f$
\n\n The implementation of this algorithm was inspired by
"Numerical Recipes in C", 2nd edition,
Press, Teukolsky, Vetterling, Flannery, chapter 2
*/
double pbeta(const double x, const double a, const double b, int maxit){
return betai(a,b,x,maxit);
}
// The student's T-distribution
double tdist(double x, double df)
{
return betai(df * 0.5, 0.5, df/(df + x*x));
}
double fdist(double x, double v1, double v2)
{
return betai(v2/2, v1/2, v2/(v2+v1*x));
}
double getBinomPval(int n, int k, double p)
{
if (k == 0) return 1;
else return betai(k, n-k+1, p);
}
double cumulative_binomial_prob(int success, int trials, double p)
{
return betai(success, trials, p);
}
