int main(void)
{
char txt[MAXSTR];
int i,nval;
float x,val;
FILE *fp;
if ((fp = fopen("fncval.dat","r")) == NULL)
nrerror("Data file fncval.dat not found\n");
fgets(txt,MAXSTR,fp);
while (strncmp(txt,"Error Function",14)) {
fgets(txt,MAXSTR,fp);
if (feof(fp)) nrerror("Data not found in fncval.dat\n");
}
fscanf(fp,"%d %*s",&nval);
printf("\ncomplementary error function\n");
printf("%5s %12s %13s\n","x","actual","erfcc(x)");
for (i=1;i<=nval;i++) {
fscanf(fp,"%f %f",&x,&val);
val=1.0-val;
printf("%6.2f %12.7f %12.7f\n",x,val,erfcc(x));
}
fclose(fp);
return 0;
}
void kendl1(float data1[], float data2[], unsigned long n, float *tau,
float *z, float *prob)
{
float erfcc(float x);
unsigned long n2=0,n1=0,k,j;
long is=0;
float svar,aa,a2,a1;
for (j=1;j<n;j++) {
for (k=(j+1);k<=n;k++) {
a1=data1[j]-data1[k];
a2=data2[j]-data2[k];
aa=a1*a2;
if (aa) {
++n1;
++n2;
aa > 0.0 ? ++is : --is;
} else {
if (a1) ++n1;
if (a2) ++n2;
}
}
}
*tau=is/(sqrt((double) n1)*sqrt((double) n2));
svar=(4.0*n+10.0)/(9.0*n*(n-1.0));
*z=(*tau)/sqrt(svar);
*prob=erfcc(fabs(*z)/1.4142136);
}
void kendl2(float **tab, int i, int j, float *tau, float *z, float *prob)
{
float erfcc(float x);
long nn,mm,m2,m1,lj,li,l,kj,ki,k;
float svar,s=0.0,points,pairs,en2=0.0,en1=0.0;
nn=i*j;
points=tab[i][j];
for (k=0;k<=nn-2;k++) {
ki=(k/j);
kj=k-j*ki;
points += tab[ki+1][kj+1];
for (l=k+1;l<=nn-1;l++) {
li=l/j;
lj=l-j*li;
mm=(m1=li-ki)*(m2=lj-kj);
pairs=tab[ki+1][kj+1]*tab[li+1][lj+1];
if (mm) {
en1 += pairs;
en2 += pairs;
s += (mm > 0 ? pairs : -pairs);
} else {
if (m1) en1 += pairs;
if (m2) en2 += pairs;
}
}
}
*tau=s/sqrt(en1*en2);
svar=(4.0*points+10.0)/(9.0*points*(points-1.0));
*z=(*tau)/sqrt(svar);
*prob=erfcc(fabs(*z)/1.4142136);
}
double cdf(double x)
{
// cumulative distribution function of standard normal
const double eps = 10e-17;
double p=(1+erfcc(x/sqrt((double)2)))/2.0;;
if (p==1.0)
p = p -eps;
else if (p==0)
p = eps;
return p;
}
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 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);
}
/*F:lqp_find_approx*
________________________________________________________________
lqp_find_approx
________________________________________________________________
Name: lqp_find_approx
Syntax:
Description: For given knots, finds approximate function
f_tilde(x) = \sum_k p_k s_k(x)I(x_{k} x<=x_{k+1})
where s_k(x)=s_k^u(x)/\int s_k^u(x)
while s_k^u(x)=p_{k,0}+p_{k,1}x
and interpolates log f(x_k) and log f_{k+1})
Side effects:
Return value:
Global or static variables used:
Example:
Linking:
Bugs:
Author: Geir Storvik, UiO
Date:
Source file: $Id: caa_lqp.c,v 1.1 2009/06/09 10:30:47 mmerzere Exp $
________________________________________________________________
*/
static int lqp_find_approx(int i_n,double *i_knots,double i_fopt,double *i_par,
double (*i_log_f)(double,double *),
double (*i_log_f1)(double,double *),
double **o_coef,double *o_prob,double *o_max_r)
{
int i;
double f_cur,f_prev,f1_cur,f1_prev,f_m;
double w1,w2,w3,k2_cur,k2_prev;
double a,a_u,a_l,b,c,max_r,x_l,x_m,x_h,f1;
max_r = G_ZERO;
/* First intervall from -infinity to knots[0] */
f_cur = i_log_f(i_knots[0],i_par)-i_fopt;
f1_cur = i_log_f1(i_knots[0],i_par);
a = G_ZERO;
b = f1_cur*0.9999; /* Makes f.tilde > f */
c = f_cur - b*i_knots[0];
o_prob[0] = exp(b*i_knots[0]+c)/b;
o_coef[0][0] = a;
o_coef[0][1] = b;
o_coef[0][2] = c;
k2_cur = i_knots[0]*i_knots[0];
/* Intervals between knots[0] and knots[n-1] */
for(i=1;i<i_n;i++)
{
f_prev = f_cur;
f1_prev = f1_cur;
f_cur = i_log_f(i_knots[i],i_par)-i_fopt;
f1_cur = i_log_f1(i_knots[i],i_par);
x_m = G_HALF*(i_knots[i-1]+i_knots[i]);
f_m = i_log_f(x_m,i_par)-i_fopt;
k2_prev = k2_cur;
k2_cur = i_knots[i]*i_knots[i];
/* Find parameters */
a_u = (f_m-G_HALF*(f_prev+f_cur));
a_l = x_m*x_m-G_HALF*(k2_prev+k2_cur);
a = a_u/a_l;
b = (f_cur-f_prev-a*(k2_cur-k2_prev))/
(i_knots[i]-i_knots[i-1]);
c = f_cur-(a*i_knots[i]+b)*i_knots[i];
/* Find maximum between log f and log f.tilde */
f1 = log_f_ratio1(i_knots[i-1],i_log_f1,i_par,a,b);
if(f1<G_ZERO)
{
x_l = G_HALF*(i_knots[i-1]+i_knots[i]);
x_h = i_knots[i];
x_m = G_HALF*(x_l+x_h);
while(fabs(x_h-x_l)>0.001)
{
f1 = log_f_ratio1(x_m,i_log_f1,i_par,a,b);
if(f1>G_ZERO)
{
x_l = x_m;
x_m = G_HALF*(x_l+x_h);
}
else
{
x_h = x_m;
x_m = G_HALF*(x_l+x_h);
}
}
max_r = MAX(max_r,log_f_ratio(x_m,i_fopt,i_log_f,i_par,a,b,c));
}
else
{
x_l = i_knots[i-1];
x_h = G_HALF*(i_knots[i-1]+i_knots[i]);
x_m = G_HALF*(x_l+x_h);
while(fabs(x_h-x_l)>0.001)
{
f1 = log_f_ratio1(x_m,i_log_f1,i_par,a,b);
if(f1>G_ZERO)
{
x_l = x_m;
x_m = G_HALF*(x_l+x_h);
}
else
{
x_h = x_m;
x_m = G_HALF*(x_l+x_h);
}
}
max_r = MAX(max_r,log_f_ratio(x_m,i_fopt,i_log_f,i_par,a,b,c));
}
/* Calculate integral of s_k^u */
w1 = G_HALF*sqrt(-G_PI/a)*exp(c-G_ONE_FOURTH*b*b/a);
w2 = erfcc(sqrt(-a)*(i_knots[i-1]+b/(G_TWO*a)));
w3 = erfcc(sqrt(-a)*(i_knots[i]+b/(G_TWO*a)));
o_prob[i] = w1*(w2-w3);
o_coef[i][0] = a;
o_coef[i][1] = b;
o_coef[i][2] = c;
}
/* Finally intervall from knots[n-1] to infinity */
f_prev = f_cur;
f1_prev = f1_cur;
a = G_ZERO;
b = f1_prev*0.9999;
c = f_prev - b*i_knots[i_n-1];
o_prob[i_n] = -exp(c)*exp(b*i_knots[i_n-1])/b;
o_coef[i_n][0] = a;
o_coef[i_n][1] = b;
o_coef[i_n][2] = c;
*o_max_r = max_r;
return(0);
} /* end of lqp_find_approx */
Fonc_Num unif_noise_4(REAL * pds,INT * sz , INT nb)
{
return erfcc(gauss_noise_4(pds,sz,nb));
}
Fonc_Num unif_noise_4(INT nb)
{
return erfcc(gauss_noise_4(nb));
}
