double df(double x, double m, double n, int give_log)
{
double p, q, f, dens;
#ifdef IEEE_754
if (ISNAN(x) || ISNAN(m) || ISNAN(n))
return x + m + n;
#endif
if (m <= 0 || n <= 0) ML_ERR_return_NAN;
if (x <= 0.) return(R_D__0);
if (!R_FINITE(m) && !R_FINITE(n)) { /* both +Inf */
if(x == 1.) return ML_POSINF;
/* else */ return R_D__0;
}
if (!R_FINITE(n)) /* must be +Inf by now */
return(dgamma(x, m/2, 2./m, give_log));
if (m > 1e14) {/* includes +Inf: code below is inaccurate there */
dens = dgamma(1./x, n/2, 2./n, give_log);
return give_log ? dens - 2*log(x): dens/(x*x);
}
f = 1./(n+x*m);
q = n*f;
p = x*m*f;
if (m >= 2) {
f = m*q/2;
dens = dbinom_raw((m-2)/2, (m+n-2)/2, p, q, give_log);
}
else {
f = m*m*q / (2*p*(m+n));
dens = dbinom_raw(m/2, (m+n)/2, p, q, give_log);
}
return(give_log ? log(f)+dens : f*dens);
}
Type objective_function<Type>::operator() () {
DATA_VECTOR(E);
DATA_VECTOR(deaths);
DATA_SPARSE_MATRIX(P); // precision matrix
PARAMETER(alpha);
PARAMETER(log_sigma2_V);
PARAMETER_VECTOR(V);
PARAMETER(log_sigma2_U);
PARAMETER_VECTOR(W);
int N = E.size();
vector<Type> log_deaths_pred(N);
vector<Type> mu(N);
Type nll = 0;
Type tau_V = 1 / exp(log_sigma2_V);
Type tau_U = 1 / exp(log_sigma2_U);
nll -= dnorm(alpha, Type(0), Type(10), 1);
nll -= dgamma(tau_V, Type(0.5), Type(2000), 1);
nll -= dgamma(tau_U, Type(0.5), Type(2000), 1);
nll -= dnorm(V, Type(0), exp(0.5 * log_sigma2_V), 1).sum();
vector<Type> tmp = P * W;
nll -= -0.5 * (W * tmp).sum();
vector<Type> U = W * exp(0.5 * log_sigma2_U);
nll -= dnorm(U.sum(), Type(0), Type(0.00001), 1);
for (size_t i = 0; i < N; i++) log_deaths_pred(i) = log(E(i)) + alpha + V(i) + U(i);
for (size_t i = 0; i < N; i++) nll -= dpois(deaths(i), exp(log_deaths_pred(i)), 1);
for (size_t i = 0; i < N; i++) mu(i) = exp(alpha + V(i) + U(i));
vector<Type> deaths_pred = exp(log_deaths_pred);
ADREPORT(U);
ADREPORT(deaths_pred);
ADREPORT(mu);
return nll;
}
Type objective_function<Type>::operator() () {
// data:
DATA_MATRIX(age);
DATA_VECTOR(len);
DATA_SCALAR(CV_e);
DATA_INTEGER(num_reads);
// parameters:
PARAMETER(r0); // reference value
PARAMETER(b); // growth displacement
PARAMETER(k); // growth rate
PARAMETER(m); // slope of growth
PARAMETER(CV_Lt);
PARAMETER(gam_shape);
PARAMETER(gam_scale);
PARAMETER_VECTOR(age_re);
// procedures:
Type n = len.size();
Type nll = 0.0; // Initialize negative log-likelihood
Type eps = 1e-5;
CV_e = CV_e < 0.05 ? 0.05 : CV_e;
for (int i = 0; i < n; i++) {
Type x = age_re(i);
if (!isNA(x) && isFinite(x)) {
Type len_pred = pow(r0 + b * exp(k * x), m);
Type sigma_e = CV_e * x + eps;
Type sigma_Lt = CV_Lt * (len_pred + eps);
nll -= dnorm(len(i), len_pred, sigma_Lt, true);
nll -= dgamma(x + eps, gam_shape, gam_scale, true);
for (int j = 0; j < num_reads; j++) {
if (!isNA(age(j, i)) && isFinite(age(j, i)) && age(j, i) >= 0) {
nll -= dnorm(age(j, i), x, sigma_e, true);
}
}
}
}
return nll;
}
double ZGS::log_prior(double sigsq, double *d1, double *d2) const {
if (sigsq <= 0.0) {
return negative_infinity();
}
double a = precision_prior_->alpha();
double b = precision_prior_->beta();
// The log prior is the gamma density plus a jacobian term:
// log(abs(d(siginv) / d(sigsq))).
if (d1) {
double sig4 = sigsq * sigsq;
*d1 += -(a + 1) / sigsq + b / sig4;
if (d2) {
double sig6 = sigsq * sig4;
*d2 += (a + 1) / sig4 - 2 * b / sig6;
}
}
return dgamma(1 / sigsq, a, b, true) - 2 * log(sigsq);
}
double dnf(double x, double df1, double df2, double ncp, int give_log)
{
double y, z, f;
#ifdef IEEE_754
if (ISNAN(x) || ISNAN(df1) || ISNAN(df2) || ISNAN(ncp))
return x + df2 + df1 + ncp;
#endif
/* want to compare dnf(ncp=0) behavior with df() one, hence *NOT* :
* if (ncp == 0)
* return df(x, df1, df2, give_log); */
if (df1 <= 0. || df2 <= 0. || ncp < 0) ML_ERR_return_NAN;
if (x < 0.) return(R_D__0);
if (!R_FINITE(ncp)) /* ncp = +Inf -- FIXME?: in some cases, limit exists */
ML_ERR_return_NAN;
/* This is not correct for df1 == 2, ncp > 0 - and seems unneeded:
* if (x == 0.) return(df1 > 2 ? R_D__0 : (df1 == 2 ? R_D__1 : ML_POSINF));
*/
if (!R_FINITE(df1) && !R_FINITE(df2)) { /* both +Inf */
/* PR: not sure about this (taken from ncp==0) -- FIXME ? */
if(x == 1.) return ML_POSINF;
/* else */ return R_D__0;
}
if (!R_FINITE(df2)) /* i.e. = +Inf */
return df1* dnchisq(x*df1, df1, ncp, give_log);
/* == dngamma(x, df1/2, 2./df1, ncp, give_log) -- but that does not exist */
if (df1 > 1e14 && ncp < 1e7) {
/* includes df1 == +Inf: code below is inaccurate there */
f = 1 + ncp/df1; /* assumes ncp << df1 [ignores 2*ncp^(1/2)/df1*x term] */
z = dgamma(1./x/f, df2/2, 2./df2, give_log);
return give_log ? z - 2*log(x) - log(f) : z / (x*x) / f;
}
y = (df1 / df2) * x;
z = dnbeta(y/(1 + y), df1 / 2., df2 / 2., ncp, give_log);
return give_log ?
z + log(df1) - log(df2) - 2 * log1p(y) :
z * (df1 / df2) /(1 + y) / (1 + y);
}
double F77_SUB(dgammac)(double *x, double *shape, double *scale, int *give_log) {
return(dgamma(*x, *shape, *scale, *give_log)); }
template <typename float_t> float_t dchisq(float_t x, float_t nu=1)
{
return dgamma(x, nu/2, 0.5);
}
Type objective_function<Type>::operator() ()
{
// Data
DATA_INTEGER( like ); // define likelihood type, 1==delta lognormal, 2==delta gamma
DATA_VECTOR( y_i ); // observations
DATA_MATRIX( X_ij ); // covariate design matrix
DATA_VECTOR( include ); //0== include in NLL, 1== exclude from NLL
// Parameters
PARAMETER_VECTOR( b_j ); // betas to generate expected values
PARAMETER_VECTOR( theta_z ); // variances
// Transformations
Type zero_prob = 1 / (1 + exp(-theta_z(0)));
Type sd = exp(theta_z(1)); //standard deviation (lognormal), scale parameter theta (gamma)
int n_data = y_i.size();
Type jnll = 0;
Type pred_jnll = 0;
vector<Type> jnll_i(n_data);
// linear predictor
vector<Type> logpred_i( n_data );
logpred_i = X_ij * b_j;
// Delta lognormal
if(like==1){
for( int i=0; i<n_data; i++){
if(y_i(i)==0) jnll_i(i) -= log( zero_prob );
if(y_i(i)!=0) jnll_i(i) -= log( 1-zero_prob ) + dlognorm( y_i(i), logpred_i(i), sd, true );
// Running counter
if( include(i)==0 ) jnll += jnll_i(i);
if( include(i)==1 ) pred_jnll += jnll_i(i);
}
}
// Delta gamma
if(like==2){
for(int i=0; i<n_data; i++){
if(y_i(i)==0) jnll_i(i) -= log( zero_prob );
if(y_i(i)!=0) jnll_i(i) -= log( 1-zero_prob ) + dgamma( y_i(i), pow(sd,-2), exp(logpred_i(i))*pow(sd,2), true );
// Running counter
if( include(i)==0 ) jnll += jnll_i(i);
if( include(i)==1 ) pred_jnll += jnll_i(i);
}
}
// Reporting
REPORT( zero_prob );
REPORT( sd );
REPORT( logpred_i );
REPORT( b_j );
REPORT( pred_jnll );
REPORT( jnll_i );
return jnll;
}
//--------------------Plasticity-------------------------------------
//plasticity integration routine
void DruckerPrager:: plastic_integrator( )
{
bool okay; // boolean variable to ensure satisfaction of multisurface kuhn tucker conditions
double f1;
double f2;
double norm_eta;
double Invariant_1;
double Invariant_ep;
double norm_ep;
double norm_dev_ep;
Vector epsilon_e(6);
Vector s(6);
Vector eta(6);
Vector dev_ep(6);
Vector Jact(2);
double fTOL;
double gTOL;
fTOL = 0.0;
gTOL = -1.0e-10;
double NormCep;
double alpha1; // hardening parameter for DP surface
double alpha2; // hardening parameter for tension cut-off
Vector n(6); // normal to the yield surface in strain space
Vector R(2); // residual vector
Vector gamma(2); // vector of consistency parameters
Vector dgamma(2); // incremental vector of consistency parameters
Matrix g(2,2); // jacobian of the corner region (return map)
Matrix g_contra(2,2); // inverse of jacobian of the corner region
// set trial state:
// epsilon_n1_p_trial = ..._n1_p = ..._n_p
mEpsilon_n1_p = mEpsilon_n_p;
// alpha1_n+1_trial
mAlpha1_n1 = mAlpha1_n;
// alpha2_n+1_trial
mAlpha2_n1 = mAlpha2_n;
// beta_n+1_trial
mBeta_n1 = mBeta_n;
// epsilon_elastic = epsilon_n+1 - epsilon_n_p
epsilon_e = mEpsilon - mEpsilon_n1_p;
// trial stress
mSigma = mCe*epsilon_e;
// deviator stress tensor: s = 2G * IIdev * epsilon_e
//I1_trial
Invariant_1 = ( mSigma(0) + mSigma(1) + mSigma(2) );
// s_n+1_trial
s = mSigma - (Invariant_1/3.0)*mI1;
//eta_trial = s_n+1_trial - beta_n;
eta = s - mBeta_n;
// compute yield function value (contravariant norm)
norm_eta = sqrt(eta(0)*eta(0) + eta(1)*eta(1) + eta(2)*eta(2) + 2*(eta(3)*eta(3) + eta(4)*eta(4) + eta(5)*eta(5)));
// f1_n+1_trial
f1 = norm_eta + mrho*Invariant_1 - root23*Kiso(mAlpha1_n1);
// f2_n+1_trial
f2 = Invariant_1 - T(mAlpha2_n1);
// update elastic bulk and shear moduli
this->updateElasticParam();
// check trial state
int count = 1;
if ((f1<=fTOL) && (f2<=fTOL) || mElastFlag < 2) {
okay = true;
// trial state = elastic state - don't need to do any updates.
mCep = mCe;
count = 0;
// set state variables for recorders
Invariant_ep = mEpsilon_n1_p(0)+mEpsilon_n1_p(1)+mEpsilon_n1_p(2);
norm_ep = sqrt(mEpsilon_n1_p(0)*mEpsilon_n1_p(0) + mEpsilon_n1_p(1)*mEpsilon_n1_p(1) + mEpsilon_n1_p(2)*mEpsilon_n1_p(2)
+ 0.5*(mEpsilon_n1_p(3)*mEpsilon_n1_p(3) + mEpsilon_n1_p(4)*mEpsilon_n1_p(4) + mEpsilon_n1_p(5)*mEpsilon_n1_p(5)));
dev_ep = mEpsilon_n1_p - one3*Invariant_ep*mI1;
norm_dev_ep = sqrt(dev_ep(0)*dev_ep(0) + dev_ep(1)*dev_ep(1) + dev_ep(2)*dev_ep(2)
+ 0.5*(dev_ep(3)*dev_ep(3) + dev_ep(4)*dev_ep(4) + dev_ep(5)*dev_ep(5)));
mState(0) = Invariant_1;
mState(1) = norm_eta;
mState(2) = Invariant_ep;
mState(3) = norm_dev_ep;
mState(4) = norm_ep;
return;
}
else {
// plastic correction required
okay = false;
// determine number of active surfaces. size & fill Jact
if ( (f1 > fTOL ) && (f2 <= fTOL) ) {
// f1 surface only
Jact(0) = 1;
Jact(1) = 0;
}
else if ( (f1 <= fTOL ) && (f2 > fTOL) ) {
// f2 surface only
Jact(0) = 0;
Jact(1) = 1;
}
else if ( (f1 > fTOL ) && (f2 > fTOL) ) {
// both surfaces active
Jact(0) = 1;
Jact(1) = 1;
}
}
//-----------------MultiSurface Placity Return Map--------------------------------------
while (!okay) {
alpha1 = mAlpha1_n;
alpha2 = mAlpha2_n;
// n = eta / norm_eta; (contravaraint)
if (norm_eta < 1.0e-13) {
n.Zero();
} else {
n = eta/norm_eta;
}
// initialize R, gamma1, gamma2, dgamma1, dgamma2 = 0
R.Zero();
gamma.Zero();
dgamma.Zero();
// initialize g such that det(g) = 1
g(0,0) = 1;
g(1,1) = 1;
g(1,0) = 0;
g(0,1) = 0;
// Newton procedure to compute nonlinear gamma1 and gamma2
//initialize terms
for (int i = 0; i < 2; i++) {
if (Jact(i) == 1) {
R(0) = norm_eta - (2*mG + two3*mHprime)*gamma(0) + mrho*Invariant_1
- 9*mK*mrho*mrho_bar*gamma(0) - 9*mK*mrho*gamma(1) - root23*Kiso(alpha1);
g(0,0) = -2*mG - two3*(mHprime + Kisoprime(alpha1)) - 9*mK*mrho*mrho_bar;
} else if (Jact(i) == 2) {
R(1) = Invariant_1 - 9*mK*mrho_bar*gamma(0) - 9*mK*gamma(1) - T(alpha2);
g(1,1) = -9*mK + mdelta2*T(alpha2);
}
}
if (Jact(0) == 1 && Jact(1) == 1) {
g(0,1) = -9*mK*mrho;
g(1,0) = mrho_bar*(-9*mK + mdelta2*T(alpha2));
}
g.Invert(g_contra);
// iteration counter
int m = 0;
//iterate
while ((fabs(R.Norm()) > 1e-10) && (m < 10)) {
dgamma = -1*g_contra * R;
gamma += dgamma;
//update alpha1 and alpha2
alpha1 = mAlpha1_n + root23*gamma(0);
alpha2 = mAlpha2_n + mrho_bar*gamma(0) + gamma(1);
// reset g & R matrices
g(0,0) = 1;
g(1,1) = 1;
g(1,0) = 0;
g(0,1) = 0;
R.Zero();
for (int i = 0; i < 2; i++) {
if (Jact(i) == 1) {
R(0) = norm_eta - (2*mG + two3*mHprime)*gamma(0) + mrho*Invariant_1
- 9*mK*mrho*mrho_bar*gamma(0) - 9*mK*mrho*gamma(1) - root23*Kiso(alpha1);
g(0,0) = -2*mG - two3*(mHprime + Kisoprime(alpha1)) - 9*mK*mrho*mrho_bar;
} else if (Jact(i) == 2) {
R(1) = Invariant_1 - 9*mK*mrho_bar*gamma(0) - 9*mK*gamma(1) - T(alpha2);
g(1,1) = -9*mK + mdelta2*T(alpha2);
}
}
if (Jact(0) == 1 && Jact(1) == 1) {
g(0,1) = -9*mK*mrho;
g(1,0) = mrho_bar*(-9*mK + mdelta2*T(alpha2));
}
g.Invert(g_contra);
m++;
}
// check maintain Kuhn-Tucker conditions
f1 = norm_eta - (2*mG + two3*mHprime)*gamma(0) + mrho*Invariant_1
-9*mK*mrho*mrho_bar*gamma(0) - 9*mK*mrho*gamma(1) - root23*Kiso(alpha1);
f2 = Invariant_1 - 9*mK*mrho_bar*gamma(0) - 9*mK*gamma(1) - T(alpha2);
if ( count > 100 ) {
okay = true;
break;
}
// check active surfaces
if ((Jact(0) == 1) && (Jact(1) == 0)) {
// f2 may be > or < f2_tr because of softening of f2 related to alpha1
if (f2 >= fTOL) {
// okay = false;
Jact(0) = 1;
Jact(1) = 1;
count += 1;
} else {
okay = true;
}
} else if ((Jact(0) == 0) && (Jact(1) == 1)) {
// f1 will always be less than f1_tr
okay = true;
} else if ((Jact(0) == 1) && (Jact(1) == 1)) {
if ((gamma(0) <= gTOL) && (gamma(1) > gTOL)){
// okay = false;
Jact(0) = 0;
Jact(1) = 1;
count += 1;
} else if ((gamma(0) > gTOL) && (gamma(1) <= gTOL)){
// okay = false;
Jact(0) = 1;
Jact(1) = 0;
count += 1;
} else if ((gamma(0) > gTOL) && (gamma(1) > gTOL)) {
okay = true;
}
}
if ( (count > 3) && (!okay) ) {
Jact(0) = 1;
Jact(1) = 1;
count += 100;
}
if ( count > 3 ) {
opserr << "Jact = " << Jact;
opserr << "count = " << count << endln;
}
} // end of while(!okay) loop
//update everything and exit!
Vector b1(6);
Vector b2(6);
Vector n_covar(6);
Vector temp1(6);
Vector temp2(6);
// update alpha1 and alpha2
mAlpha1_n1 = alpha1;
mAlpha2_n1 = alpha2;
//update epsilon_n1_p
//first calculate n_covar
// n_a = G_ab * n^b = covariant
n_covar(0) = n(0);
n_covar(1) = n(1);
n_covar(2) = n(2);
n_covar(3) = 2*n(3);
n_covar(4) = 2*n(4);
n_covar(5) = 2*n(5);
mEpsilon_n1_p = mEpsilon_n_p + (mrho_bar*gamma(0) + gamma(1))*mI1 + gamma(0)*n_covar;
Invariant_ep = mEpsilon_n1_p(0)+mEpsilon_n1_p(1)+mEpsilon_n1_p(2);
norm_ep = sqrt(mEpsilon_n1_p(0)*mEpsilon_n1_p(0) + mEpsilon_n1_p(1)*mEpsilon_n1_p(1) + mEpsilon_n1_p(2)*mEpsilon_n1_p(2)
+ 0.5*(mEpsilon_n1_p(3)*mEpsilon_n1_p(3) + mEpsilon_n1_p(4)*mEpsilon_n1_p(4) + mEpsilon_n1_p(5)*mEpsilon_n1_p(5)));
dev_ep = mEpsilon_n1_p - one3*Invariant_ep*mI1;
norm_dev_ep = sqrt(dev_ep(0)*dev_ep(0) + dev_ep(1)*dev_ep(1) + dev_ep(2)*dev_ep(2)
+ 0.5*(dev_ep(3)*dev_ep(3) + dev_ep(4)*dev_ep(4) + dev_ep(5)*dev_ep(5)));
// update sigma
mSigma -= (3*mK*mrho_bar*gamma(0) + 3*mK*gamma(1))*mI1 + 2*mG*gamma(0)*n;
s -= 2*mG*gamma(0) * n;
Invariant_1 -= 9*mK*mrho_bar*gamma(0) + 9*mK*gamma(1);
//mSigma = s + Invariant_1/3.0 * mI1;
//update beta_n1
mBeta_n1 = mBeta_n - (two3*mHprime*gamma(0))*n;
//eta_n+1 = s_n+1 - beta_n+1;
eta = s - mBeta_n1;
norm_eta = sqrt(eta(0)*eta(0) + eta(1)*eta(1) + eta(2)*eta(2) + 2*(eta(3)*eta(3) + eta(4)*eta(4) + eta(5)*eta(5)));
// update Cep
// note: Cep is contravariant
if ((Jact(0) == 1) && (Jact(1) == 0)) {
b1 = 2*mG*n + 3*mK*mrho*mI1;
b2.Zero();
} else if ((Jact(0) == 0) && (Jact(1) == 1)){
b1.Zero();
b2 = 3*mK*mI1;
} else if ((Jact(0) == 1) && (Jact(1) == 1)){
b1 = 2*mG*n + 3*mK*mrho*mI1;
b2 = 3*mK*mI1;
}
temp1 = g_contra(0,0)*b1 + g_contra(0,1)*b2;
temp2 = mrho_bar*temp1 + g_contra(1,0)*b1 + g_contra(1,1)*b2;
NormCep = 0.0;
for (int i = 0; i < 6; i++){
for (int j = 0; j < 6; j++) {
mCep(i,j) = mCe(i,j)
+ 3*mK * mI1(i)*temp2(j)
+ 2*mG * n(i)*temp1(j)
- 4*mG*mG/norm_eta*gamma(0) * (mIIdev(i,j) - n(i)*n(j));
NormCep += mCep(i,j)*mCep(i,j);
}
}
if ( NormCep < 1e-10){
mCep = 1.0e-3 * mCe;
opserr << "NormCep = " << NormCep << endln;
}
mState(0) = Invariant_1;
mState(1) = norm_eta;
mState(2) = Invariant_ep;
mState(3) = norm_dev_ep;
mState(4) = norm_ep;
return;
}
Type objective_function<Type>::operator() ()
{
DATA_STRING(distr);
DATA_INTEGER(n);
Type ans = 0;
if (distr == "norm") {
PARAMETER(mu);
PARAMETER(sd);
vector<Type> x = rnorm(n, mu, sd);
ans -= dnorm(x, mu, sd, true).sum();
}
else if (distr == "gamma") {
PARAMETER(shape);
PARAMETER(scale);
vector<Type> x = rgamma(n, shape, scale);
ans -= dgamma(x, shape, scale, true).sum();
}
else if (distr == "pois") {
PARAMETER(lambda);
vector<Type> x = rpois(n, lambda);
ans -= dpois(x, lambda, true).sum();
}
else if (distr == "compois") {
PARAMETER(mode);
PARAMETER(nu);
vector<Type> x = rcompois(n, mode, nu);
ans -= dcompois(x, mode, nu, true).sum();
}
else if (distr == "compois2") {
PARAMETER(mean);
PARAMETER(nu);
vector<Type> x = rcompois2(n, mean, nu);
ans -= dcompois2(x, mean, nu, true).sum();
}
else if (distr == "nbinom") {
PARAMETER(size);
PARAMETER(prob);
vector<Type> x = rnbinom(n, size, prob);
ans -= dnbinom(x, size, prob, true).sum();
}
else if (distr == "nbinom2") {
PARAMETER(mu);
PARAMETER(var);
vector<Type> x = rnbinom2(n, mu, var);
ans -= dnbinom2(x, mu, var, true).sum();
}
else if (distr == "exp") {
PARAMETER(rate);
vector<Type> x = rexp(n, rate);
ans -= dexp(x, rate, true).sum();
}
else if (distr == "beta") {
PARAMETER(shape1);
PARAMETER(shape2);
vector<Type> x = rbeta(n, shape1, shape2);
ans -= dbeta(x, shape1, shape2, true).sum();
}
else if (distr == "f") {
PARAMETER(df1);
PARAMETER(df2);
vector<Type> x = rf(n, df1, df2);
ans -= df(x, df1, df2, true).sum();
}
else if (distr == "logis") {
PARAMETER(location);
PARAMETER(scale);
vector<Type> x = rlogis(n, location, scale);
ans -= dlogis(x, location, scale, true).sum();
}
else if (distr == "t") {
PARAMETER(df);
vector<Type> x = rt(n, df);
ans -= dt(x, df, true).sum();
}
else if (distr == "weibull") {
PARAMETER(shape);
PARAMETER(scale);
vector<Type> x = rweibull(n, shape, scale);
ans -= dweibull(x, shape, scale, true).sum();
}
else if (distr == "AR1") {
PARAMETER(phi);
vector<Type> x(n);
density::AR1(phi).simulate(x);
ans += density::AR1(phi)(x);
}
else if (distr == "ARk") {
PARAMETER_VECTOR(phi);
vector<Type> x(n);
density::ARk(phi).simulate(x);
ans += density::ARk(phi)(x);
}
else if (distr == "MVNORM") {
PARAMETER(phi);
matrix<Type> Sigma(5,5);
for(int i=0; i<Sigma.rows(); i++)
for(int j=0; j<Sigma.rows(); j++)
Sigma(i,j) = exp( -phi * abs(i - j) );
density::MVNORM_t<Type> nldens = density::MVNORM(Sigma);
for(int i = 0; i<n; i++) {
vector<Type> x = nldens.simulate();
ans += nldens(x);
}
}
else if (distr == "SEPARABLE") {
PARAMETER(phi1);
PARAMETER_VECTOR(phi2);
array<Type> x(100, 200);
SEPARABLE( density::ARk(phi2), density::AR1(phi1) ).simulate(x);
ans += SEPARABLE( density::ARk(phi2), density::AR1(phi1) )(x);
}
else if (distr == "GMRF") {
PARAMETER(delta);
matrix<Type> Q0(5, 5);
Q0 <<
1,-1, 0, 0, 0,
-1, 2,-1, 0, 0,
0,-1, 2,-1, 0,
0, 0,-1, 2,-1,
0, 0, 0,-1, 1;
Q0.diagonal().array() += delta;
Eigen::SparseMatrix<Type> Q = asSparseMatrix(Q0);
vector<Type> x(5);
for(int i = 0; i<n; i++) {
density::GMRF(Q).simulate(x);
ans += density::GMRF(Q)(x);
}
}
else if (distr == "SEPARABLE_NESTED") {
PARAMETER(phi1);
PARAMETER(phi2);
PARAMETER(delta);
matrix<Type> Q0(5, 5);
Q0 <<
1,-1, 0, 0, 0,
-1, 2,-1, 0, 0,
0,-1, 2,-1, 0,
0, 0,-1, 2,-1,
0, 0, 0,-1, 1;
Q0.diagonal().array() += delta;
Eigen::SparseMatrix<Type> Q = asSparseMatrix(Q0);
array<Type> x(5, 6, 7);
for(int i = 0; i<n; i++) {
SEPARABLE(density::AR1(phi2),
SEPARABLE(density::AR1(phi1),
density::GMRF(Q) ) ).simulate(x);
ans += SEPARABLE(density::AR1(phi2),
SEPARABLE(density::AR1(phi1),
density::GMRF(Q) ) )(x);
}
}
else error( ("Invalid distribution '" + distr + "'").c_str() );
return ans;
}
double dchisq(NMATH_STATE *state, double x, double df, int give_log)
{
return dgamma(state, x, df / 2., 2., give_log);
}
double dchisq(double x, double df, int give_log)
{
return dgamma(x, df / 2., 2., give_log);
}
