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; }