// return the culmulative function of standard normal distribution;
//=========distribution of standard normal distribution
// return the probability of P(N(0,1)<x);
double pnormal( double x )
{
if(x>=0)
return 0.5+0.5*gammp(0.5,x*x/2.0);
else
return 0.5-0.5*gammp(0.5,x*x/2.0);
}
// **************************************************************
fdouble erff(fdouble x)
/**
* Returns the error function erf(x).
* See "Numerical Recipes in C", 2nd edition, page 220
*/
{
return x < 0.0 ? -gammp(0.5,x*x) : gammp(0.5,x*x);
}
double* JarqueBera(double* e, long n, long k)
{
double sigma2 = norm(e,n);
if (n <=30)
sigma2 = sigma2 / (n-1); // # unbiased estimator of population sig sq.
else
sigma2 = sigma2 / n; // # mean square of sample residuals
double* m2e = vproduct(e,e,n);
double skewness = product(m2e,e,n) / n / pow(sigma2,1.5);
skewness *= skewness;
double kurtosis = product(m2e,m2e,n) /n / geoda_sqr(sigma2);
double jb = n * (skewness/6.0 + (geoda_sqr(kurtosis-3.0) / 24.0));
double* rslt = new double [3];
rslt[0] = jb;
rslt[1] = 2.0;
rslt[2] = gammp( 1.0, jb/2.0 );
// rslt[2] = chicdf(jb,2.0);
/*
rslt[3] = skewness;
rslt[4] = 1.0;
rslt[5] = chicdf(skewness,1);
rslt[6] = kurtosis;
rslt[7] = 1.0;
rslt[8] = chicdf(kurtosis,1);
*/
return rslt;
//local JB = (r(N)/6)*((r(skewness)^2)+[(1/4)*(r(kurtosis)-3)^2])
}
float erffc(float x)
{
float gammp(float a, float x);
float gammq(float a, float x);
return x < 0.0 ? 1.0+gammp(0.5,x*x) : gammq(0.5,x*x);
}
double pchisq( double x, int df )
{
// df = degrees of freedom
// x = chi square value
return( gammp( df/2.0, x/2.0 ) );
// return the culmulative function of chi-square distribuition
// with df freedom;
}
double gauss (double z)
{ double res,a=0.5;
double x=z*z/2;
gammp(&a,&x,&res);
res/=gamm(0.5)*2;
if (z<0)
return 0.5-res;
else
return 0.5+res;
}
//Returns the complementary error function erfc(x).
double erffc(double x)
{
double retval;
if ( x < 0.0 ) {
retval = gammp(0.5,x*x);
return 1+ retval;
} else {
gammq(0.5,x*x, & retval);
return retval;
}
}
double getchi2(double dof, double alpha)
{
double tol = 1.0E-3;
double ac, lm, rm, eps, chi2, za, x;
int i, itmax = 100;
if (dof > 30.0) {
/* approximate a value if degrees of freedom are > 30 based on eqn 1. Sachs, 1984 */
za = -getz(alpha); /* NB: Eq. requires change of sign for percentile */
x = 2.0 / 9.0 / dof;
chi2 = pow((dof * (1.0 - x + za * sqrt(x))), 3.0);
} else{
lm = 0.0;
rm = 1000.0;
if (alpha > 0.5)
eps = (1.0 - alpha) * tol;
else
eps = alpha * tol;
for (i = 1; i <= itmax; i++) {
chi2 = 0.5 * (lm + rm);
ac = 1.0 - gammp(0.5 * dof, 0.5 * chi2);
if (fabs(ac - alpha) <= eps)
return (chi2);
if (ac > alpha){
lm = chi2;
}else {
rm = chi2;
}
}
}
return (chi2);
}
float erff(float x) {
return x < 0.0 ? -gammp(0.5,x*x) : gammp(0.5,x*x);
}
DP NR::erffc(const DP x)
{
return x < 0.0 ? 1.0+gammp(0.5,x*x) : gammq(0.5,x*x);
}
double *BP_Test(double *resid, int obs, double** X, int nvar, bool InclConst)
{
DenseVector e(resid, obs, false), g(obs), sqvar(obs);
DenseVector *x = new DenseVector [nvar];
int i = 0, j = 0;
double ns = 0;
// Assign x = X * X
x[0].alloc(obs);
for (j = 0; j < obs; j++) {
x[0].setAt(j, 1.0);
}
for (i = 1; i < nvar; i++) {
if (InclConst) {
x[i].absorb(X[i], obs);
} else {
x[i].absorb(X[i - 1], obs);
}
ns = x[i].norm();
for (j = 0; j < obs; j++) {
x[i].setAt(j, geoda_sqr(x[i].getValue(j) / sqrt(ns)));
}
}
double **cov = new double * [nvar];
for (i = 0; i < nvar; i++)
alloc(cov[i], nvar);
// use SVD to compute inverse(Z'Z)
// use dgesvd_
char jobu = 'S', jobvt = 'S';
long int m = obs, n = nvar;
long int lda = obs, ldu = obs, ldvt = nvar, lwork = 5 * obs, info = 0;
double *a = new double [obs * nvar];
double *s = new double [nvar];
double *u = new double [ldu * nvar];
double *vt = new double [ldvt * nvar];
double *work = new double [lwork];
for (i = 0; i < obs; i++) {
for (j = 0; j < nvar; j++) {
a[i + obs * j] = x[j].getValue(i);
}
}
// use __WXMAC__ to call vecLib
//#ifdef WORDS_BIGENDIAN
#ifdef __WXMAC__MMM
dgesvd_(&jobu, &jobvt, &m, &n, a, &lda, s, u, &ldu, vt, &ldvt, work, &lwork, &info);
#else
dgesvd_(&jobu, &jobvt, (integer*)&m, (integer*)&n, (doublereal*)a, (integer*)&lda, (doublereal*)s, (doublereal*)u, (integer*)&ldu, (doublereal*)vt, (integer*)&ldvt, (doublereal*)work, (integer*)&lwork, (integer*)&info);
#endif
if (!info) {
// (z'z)^(-1) = VW^(-2)V'
for (i = 0; i < nvar; i++) {
for (j = 0; j < nvar; j++) {
for (m = 0; m < nvar; m++) {
cov[i][j] += (vt[i * nvar + m] * vt[m + j * nvar]) / (s[m] * s[m]);
}
}
}
} else {
// do nothing
}
double mse = e.norm() / obs;
// compute gi
for (j = 0; j < obs; j++) {
double e2 = geoda_sqr(e.getValue(j));
g.setAt(j, e2 - mse);
sqvar.setAt(j, geoda_sqr(e2 - mse));
}
double mean = sqvar.sum() / obs;
DenseVector gz(nvar), gzizz(nvar);
for (i = 0; i < nvar; i++)
gz.setAt(i, g.product(x[i])); // gz = g'z (1 x expl)
gz.squareTimesColumn(gzizz, cov); // gzizz = g'z * inv(cov)
double bp = gz.product(gzizz); // bp = g'z[(z'z)^-1]z'g
double *rslt = new double [6];
rslt[0] = 1. / (2 * geoda_sqr(mse)) * bp; // Breusch-Pagan
rslt[1] = InclConst ? nvar - 1 : nvar;
rslt[2] = gammp(rslt[1] / 2.0, rslt[0] / 2.0);
rslt[3] = (1.0 / mean) * bp; // Koenker-Basset
rslt[4] = rslt[1];
rslt[5] = gammp(rslt[1] / 2.0, rslt[3] / 2.0);
release(&x);
release(&cov);
return rslt;
}
double* WhiteTest(int obs, int nvar, double* resid, double** X, bool InclConstant)
{
double *r2 = new double[obs];
int i = 0, jj = 0;
// if (!InclConstant)
// DevFromMean(obs,resid);
// (1) r2 = Compute e2
double r2_bar = 0;
for (i=0;i<obs;i++)
{
r2[i] = geoda_sqr(resid[i]);
r2_bar += r2[i];
}
r2_bar /= obs;
// (2) define (n*n + 3n)/2 memory location for w
const int df = InclConstant? (geoda_sqr(nvar-1)+3*(nvar-1))/2 : (geoda_sqr(nvar)+3*nvar)/2;
DoublePtr *w = new DoublePtr[df+1];
for (i=0;i<=df;i++)
w[i] = new double[obs];
// (3) keep original X into w[1 .. nvar][]
int ix = InclConstant? 0 : 1;
int k = nvar+ix;
for (jj=0;jj<obs;jj++)
w[0][jj] = 1.0;
if (InclConstant)
{
for (i=1;i<nvar;i++)
{
for (jj=0;jj<obs;jj++)
w[i][jj] = X[i][jj];
}
}
else
{
for (i=0;i<nvar;i++)
for (jj=0;jj<obs;jj++)
w[i+1][jj] = X[i][jj];
}
// (4) Create cross product of Xs and store them into w[nvar ... df][]
for (i=1-ix;i<nvar;i++)
{
for (int j=i; j<nvar;j++)
{
for (jj=0;jj<obs;jj++)
w[k][jj] = X[i][jj] * X[j][jj];
k++;
}
}
// (5) Compute OLS, r2 on w
DenseVector yw(r2, obs, false), olsw(k);
DenseVector *xw = new DenseVector[k];
for (int cnt = 0; cnt < k; ++cnt)
{
xw[cnt].absorb(w[cnt], obs, false);
}
double ** cov = new double * [k];
double *u = new double[obs];
for (i = 0; i < k; i++) {
cov[i] = new double [k];
for (jj = 0; jj < k; jj++) {
cov[i][jj] = 0;
}
}
double *rsl = new double[3];
rsl[0] = df;
rsl[1] = -99999;
rsl[2] = -99999;
if (!ordinaryLS(yw, xw, cov, u, olsw))
{
return rsl;
}
double s_u = 0.0;
for (i=0;i<obs;i++)
s_u += geoda_sqr(r2[i] - r2_bar);
rsl[1]= obs * ( 1 - (norm(u,obs) / s_u));
// rsl[1]= chicdf(rsl[0],df);
rsl[2]= gammp( double (df) / 2.0, rsl[1]/2.0 );
return rsl;
}
double gamm_inc(const double a, const double x) {
double gammap = gammp(a,x);
double gln = gammln(a);
return exp(gln) * gammap;
}
double
vpRobust::erf(double x)
{
return x < 0.0 ? -gammp(0.5,x*x) : gammp(0.5,x*x);
}
double erffc(double x)
{
return x < 0.0 ? 1.0 + gammp(0.5, x*x) : gammq(0.5, x*x);
}
REAL_TYPE erff(REAL_TYPE x)
{
return x<0.0?1.0+gammp(0.5,x*x):gammq(0.5,x*x);
}
float erff(float x)
{
float gammp(float a, float x);
return x < 0.0 ? -gammp(0.5,x*x) : gammp(0.5,x*x);
}
Scalar erf(Scalar x)
{
// Scalar gammp();
return x < 0.0 ? -gammp(0.5,x*x) : gammp(0.5,x*x);
}
Scalar erfc(Scalar x)
{
// Scalar gammp(),gammq();
return x < 0.0 ? 1.0+gammp(0.5,x*x) : gammq(0.5,x*x);
}
// The error function
//
double erff(double x)
{
return x < 0.0 ? -gammp(0.5, x*x) : gammp(0.5, x*x);
}
const MDOUBLE generalGammaDistribution::getCumulativeProb(const MDOUBLE x) const
{//
//since r~gamma(alpha, beta) then beta*r~ gamma(alpha,1)=gammp
//here we assume alpha=beta
return gammp(_alpha, x*_beta);
}
