inline Type dzinbinom(const Type &x, const Type &size, const Type &p, const Type & zip,
int give_log=0)
{
Type logres;
if (x==Type(0)) logres=log(zip + (Type(1)-zip)*dnbinom(x, size, p, false));
else logres=log(Type(1)-zip) + dnbinom(x, size, p, true);
if (give_log) return logres; else return exp(logres);
}
double do_dnegbin_convolution(double x, double nu0, double nu1, double p0, double p1, int add_carefully){
double out = 0;
if(p0==p1){
return(dnbinom(x,nu0+nu1,p0,0));
}
double u = 0, phold = 0;
double parray[21] = {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0};
for(u=0;u<=x;u++){
phold = exp(dnbinom(x-u,nu1,p1,1L)+dnbinom(u,nu0,p0,1L));
carefulprobsum(phold, parray, add_carefully);
}
out = carefulprobsum_fin(parray,add_carefully);
return(out);
}
void _blowfly_dmeasure (double *lik, double *y, double *x, double *p, int give_log,
int *obsindex, int *stateindex, int *parindex, int *covindex,
int ncovars, double *covars, double t) {
double size = 1.0/SIGMAY/SIGMAY;
double prob = size/(size+N[0]);
*lik = dnbinom(Y,size,prob,give_log);
}
inline Type dnbinom2(const Type &x, const Type &mu, const Type &var,
int give_log=0)
{
Type p=mu/var;
Type n=mu*p/(Type(1)-p);
return dnbinom(x,n,p,give_log);
}
double dnegbin(int Y, /* sample */
double mu, /* mean */
double theta, /* dispersion parameter */
int give_log
) {
return(dnbinom((double)Y, theta, theta/(mu+theta), give_log));
}
double
dnbinom_mu (unsigned int x, double size, double mu)
{
double p;
if (size <= 0) return 0;
if (mu <= 0) return 0;
p = mu / (size + mu);
return dnbinom (x, size, p);
}
//Function to compute bivariate negbin PMF for one pair (x,y):
double do_dbinegbin(double x, double y, double nu0, double nu1, double nu2, double p0, double p1,
double p2, int give_log, int add_carefully){
double out, phold;
if(nu0==0){
out = dnbinom(x,nu1,p1,1) + dnbinom(y,nu2,p2,1);
return( give_log==1 ? out : exp(out) );
}
out = phold = 0;
double u;
double umax = fmin2(x,y);
double parray[21] = {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0};
for(u=0;u<=umax;u++){
phold = exp(dnbinom(x-u,nu1,p1,1)+dnbinom(y-u,nu2,p2,1)+dnbinom(u,nu0,p0,1));
carefulprobsum(phold, parray, add_carefully);
R_CheckUserInterrupt();
}
out = carefulprobsum_fin(parray,add_carefully);
out = ((give_log==1) ? log(out) : out);
return(out);
}
void zysum(
double *prw,
double *pz,
double *eps,
double *eta,
double *omdp,
int *w,
int *wp,
int *n,
int *T,
int *ka,
int *ko,
int *ndat,
/* result */
int *zy,
/* workspace */
double *etaomdp,
double *workT
){
// //* Refer to Section \ref{sec:zdist}
for (int idat=0;idat<*ndat;idat++){
double biglog=R_NegInf;
for (int t=0;t<*T;t++){
int one=1L;
// //* Factor Equation \ref{eq:prw.z5} as multinomial times negative binomial
// Negative Binomial Part
// Note: eps==0 is limiting case
// Note: prob parm needs to be 1-nbparm given R convention
double x = (eps[0]==0) ? 0.0 :
dnbinom(wp[idat],eps[0],1-prw[t]/(eps[1]+prw[t]),one);
for (int k=0;k<*ko;k++) x+= log(etaomdp[t+k**T]/prw[t]) *
w[idat+k**ndat];
if (biglog<x) biglog=x;
workT[t]=x;
}
double prTot=0.0;
for (int t=0;t<*T;t++){
workT[t]=exp(workT[t]-biglog)*pz[t];
prTot+=workT[t];
}
// //* Multinomial part of Equation \ref{eq:prw.z5}:
for (int t=0;t<*T;t++) workT[t]/=prTot;
rmultinom((int) n[idat],workT,(int) T[0], zy+idat**T);
}
}
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;
}
