/**
* Description not yet available.
* \param
*/
double ghk(const dvector& lower,const dvector& upper,const dmatrix& Sigma,
const dmatrix& eps,int _i)
{
int n=lower.indexmax();
dmatrix ch=choleski_decomp(Sigma);
dvector l(1,n);
dvector u(1,n);
ghk_test(eps,_i); // test for valid i range
double weight=1.0;
int k=_i;
{
l=lower;
u=upper;
for (int j=1;j<=n;j++)
{
l(j)/=ch(j,j);
u(j)/=ch(j,j);
double Phiu=cumd_norm(u(j));
double Phil=cumd_norm(l(j));
weight*=Phiu-Phil;
double eta=inv_cumd_norm((Phiu-Phil)*eps(k,j)+Phil);
for (int i=j+1;i<=n;i++)
{
double tmp=ch(i,j)*eta;
l(i)-=tmp;
u(i)-=tmp;
}
}
}
return weight;
}
/**
* Description not yet available.
* \param
*/
dvariable ghk(const dvar_vector& lower,const dvar_vector& upper,
const dvar_matrix& Sigma, const dmatrix& eps,int _i)
{
RETURN_ARRAYS_INCREMENT();
int n=lower.indexmax();
dvar_matrix ch=choleski_decomp(Sigma);
dvar_vector l(1,n);
dvar_vector u(1,n);
ghk_test(eps,_i);
dvariable weight=1.0;
int k=_i;
{
l=lower;
u=upper;
for (int j=1;j<=n;j++)
{
l(j)/=ch(j,j);
u(j)/=ch(j,j);
dvariable Phiu=cumd_norm(u(j));
dvariable Phil=cumd_norm(l(j));
weight*=Phiu-Phil;
dvariable eta=inv_cumd_norm((Phiu-Phil)*eps(k,j)+Phil+1.e-30);
for (int i=j+1;i<=n;i++)
{
dvariable tmp=ch(i,j)*eta;
l(i)-=tmp;
u(i)-=tmp;
}
}
}
RETURN_ARRAYS_DECREMENT();
return weight;
}
/**
* Description not yet available.
* \param
*/
double ghk(const dvector& lower,const dvector& upper,const dmatrix& Sigma,
const dmatrix& eps)
{
int m=eps.indexmax();
int n=lower.indexmax();
double ssum=0.0;
dmatrix ch=choleski_decomp(Sigma);
dvector l(1,n);
dvector u(1,n);
for (int k=1;k<=m;k++)
{
double weight=1.0;
l=lower;
u=upper;
for (int j=1;j<=n;j++)
{
l(j)/=ch(j,j);
u(j)/=ch(j,j);
double Phiu=cumd_norm(u(j));
double Phil=cumd_norm(l(j));
weight*=Phiu-Phil;
double eta=inv_cumd_norm((Phiu-Phil)*eps(k,j)+Phil);
for (int i=j+1;i<=n;i++)
{
double tmp=ch(i,j)*eta;
l(i)-=tmp;
u(i)-=tmp;
}
}
ssum+=weight;
}
return ssum/m;
}
/**
* Description not yet available.
* \param
*/
dvariable ghk_choleski(const dvar_vector& lower,const dvar_vector& upper,
const dvar_matrix& ch, const dmatrix& eps)
{
RETURN_ARRAYS_INCREMENT();
int n=lower.indexmax();
int m=eps.indexmax();
dvariable ssum=0.0;
dvar_vector l(1,n);
dvar_vector u(1,n);
for (int k=1;k<=m;k++)
{
dvariable weight=1.0;
l=lower;
u=upper;
for (int j=1;j<=n;j++)
{
l(j)/=ch(j,j);
u(j)/=ch(j,j);
dvariable Phiu=cumd_norm(u(j));
dvariable Phil=cumd_norm(l(j));
weight*=Phiu-Phil;
dvariable eta=inv_cumd_norm((Phiu-Phil)*eps(k,j)+Phil);
for (int i=j+1;i<=n;i++)
{
dvariable tmp=ch(i,j)*eta;
l(i)-=tmp;
u(i)-=tmp;
}
}
ssum+=weight;
}
RETURN_ARRAYS_DECREMENT();
return ssum/m;
}
/**
* Description not yet available.
* \param
*/
dvariable inv_cumd_norm(const prevariable& x)
{
dvariable y=inv_cumd_norm_inner(x);
if (x>1.e-30)
y+=2.50662827*exp(.5*y*y)*(x-cumd_norm(y));
return y;
}
/**
* Description not yet available.
* \param
*/
dvariable ghk_m(const dvar_vector& upper,const dvar_matrix& Sigma,
const dmatrix& eps)
{
RETURN_ARRAYS_INCREMENT();
int n=upper.indexmax();
int m=eps.indexmax();
dvariable ssum=0.0;
dvar_vector u(1,n);
dvar_matrix ch=choleski_decomp(Sigma);
for (int k=1;k<=m;k++)
{
dvariable weight=1.0;
u=upper;
for (int j=1;j<=n;j++)
{
u(j)/=ch(j,j);
dvariable Phiu=cumd_norm(u(j));
weight*=Phiu;
dvariable eta=inv_cumd_norm(1.e-30+Phiu*eps(k,j));
for (int i=j+1;i<=n;i++)
{
dvariable tmp=ch(i,j)*eta;
u(i)-=tmp;
}
}
ssum+=weight;
}
RETURN_ARRAYS_DECREMENT();
return ssum/m;
}
/**
* Description not yet available.
* \param
*/
dvariable robust_normal_mixture_deviate(const prevariable& x,
double spread)
{
dvariable y=cumd_norm(x);
y = 0.99999999*y + 0.000000005; // To gain numerical stability
dvariable z = inv_cumd_normal_mixture(y,spread);
return z;
}
dvar_vector model_parameters::cnorm(const double& x, const dvar_vector& mu, const dvar_vector& sd)
{
dvar_vector rst(sage,nage);
dvar_vector stx(sage,nage);
for(int a= sage; a<= nage; a++)
{
stx(a) = (x-mu( a ))/sd( a );
rst(a) = cumd_norm(stx( a ));
}
return(rst);
}
/**
* Description not yet available.
* \param
*/
df1b2variable gamma_deviate(const df1b2variable& _x,const df1b2variable& _a)
{
df1b2variable& x= (df1b2variable&)(_x);
df1b2variable& a= (df1b2variable&)(_a);
df1b2variable y=cumd_norm(x);
y=.9999*y+.00005;
//df1b2variable z=inv_cumd_gamma(y,a);
df1b2variable z=inv_cumd_gamma(y,a);
return z;
}
/**
* Description not yet available.
* \param
*/
df1b2variable beta_deviate(const df1b2variable& _a,const df1b2variable& _b,
const df1b2variable& _x,double eps)
{
df1b2variable& x= (df1b2variable&)(_x);
df1b2variable& a= (df1b2variable&)(_a);
df1b2variable& b= (df1b2variable&)(_b);
df1b2variable y=cumd_norm(x);
y=.9999999*y+.00000005;
df1b2variable z=inv_cumd_beta_stable(a,b,y,eps);
return z;
}
/**
* Description not yet available.
* \param
*/
prevariable& cumd_norm_logistic(const prevariable& _x,double p)
{
return (1.0-p)*cumd_norm(_x)+p*cumd_logistic(_x);
}
// Log-link signal strength.
// Order of detpars: b0ss, b1ss, sigmass.
dvariable detfn_logss (double x, const dvar_vector &detpars, dvariable ss_resid)
{
return 1 - cumd_norm(ss_resid/detpars(3));
}
// Log-link threshold.
// Order of detpars: shape1, shape2, scale.
dvariable detfn_logth (double x, const dvar_vector &detpars, dvariable ss_resid)
{
return 0.5 - 0.5*(2*cumd_norm((detpars(1) - mfexp(detpars(2) - detpars(3)*x))*pow(2,0.5)) - 1);
}
// Threshold.
// Order of detpars: shape, scale.
dvariable detfn_th (double x, const dvar_vector &detpars, dvariable ss_resid)
{
dvariable z = (x/detpars(2) - detpars(1))*pow(2,0.5);
return 0.5 - 0.5*(2*cumd_norm(z) - 1);
}
