Type objective_function<Type>::operator() ()
{
DATA_MATRIX(obs);
DATA_MATRIX(coord);
DATA_VECTOR(covObs);
DATA_INTEGER(p);
DATA_VECTOR(h);
PARAMETER(logObsSd);
PARAMETER(logObsTSd);
PARAMETER(logStatSd);
PARAMETER_MATRIX(x);
Type nll = 0.0;
covafill<Type> cf(coord,covObs,h,p);
// Contribution from states
for(int i = 1; i < x.cols(); ++i) {
nll -= dnorm(x(0,i), x(0,i-1), exp(logStatSd),true);
nll -= dnorm(x(1,i), x(1,i-1), exp(logStatSd),true);
}
// contribution from observations
for(int i = 0; i < obs.cols(); ++i) {
nll -= dnorm(obs(0,i), x(0,i), exp(logObsSd),true);
nll -= dnorm(obs(1,i), x(1,i), exp(logObsSd),true);
vector<Type> tmp = x.col(i);
Type val = evalFill((CppAD::vector<Type>)tmp, cf)[0];
nll -= dnorm(obs(2,i), val, exp(logObsTSd),true);
}
return nll;
}
Type objective_function<Type>::operator() ()
{
DATA_FACTOR(y); //categorical response vector
DATA_INTEGER(S); //number of response categories
DATA_MATRIX(X); // Fixed effects design matrix
DATA_FACTOR(group);
PARAMETER_VECTOR(b); // Fixed effects
PARAMETER(logsigma);
PARAMETER_VECTOR(tmpk); // kappa ( category thresholds)
PARAMETER_VECTOR(u); // Random effects
Type sigma = exp(logsigma);
vector<Type> alpha = tmpk;
for(int s=1;s<tmpk.size();s++)
alpha(s) = alpha(s-1) + exp(tmpk(s));
Type ans=0;
ans -= sum(dnorm(u,Type(0),Type(1),true));
vector<Type> eta = X*b;
for(int i=0; i<y.size(); i++){
eta(i) += sigma*u(group(i));
Type P;
if(y(i)==(S-1)) P = 1.0; else P = Type(1)/(Type(1)+exp(-(alpha(y(i))-eta(i))));
if(y(i)>0) P -= Type(1)/(Type(1)+exp(-(alpha(y(i)-1)-eta(i))));
ans -= log(1.e-20+P);
}
return ans;
}
Type objective_function<Type>::operator() ()
{
// Data
DATA_VECTOR( y_i );
DATA_MATRIX( X_ij );
// Parameters
PARAMETER_VECTOR( b_j );
PARAMETER_VECTOR( theta_z );
// Objective funcction
Type zero_prob = 1 / (1 + exp(-theta_z(0)));
Type logsd = exp(theta_z(1));
Type jnll = 0;
int n_data = y_i.size();
// Linear predictor
vector<Type> linpred_i( n_data );
linpred_i = X_ij * b_j;
// Probability of data conditional on fixed effect values
for( int i=0; i<n_data; i++){
if(y_i(i)==0) jnll -= log( zero_prob );
if(y_i(i)!=0) jnll -= log( 1-zero_prob ) + dlognorm( y_i(i), linpred_i(i), logsd, true );
}
// Reporting
REPORT( zero_prob );
REPORT( logsd );
REPORT( linpred_i );
return jnll;
}
Type objective_function<Type>::operator()()
{
DATA_FACTOR(group);
DATA_MATRIX(covariates); // #obs x #par
DATA_MATRIX(predCovariates);
PARAMETER_MATRIX(beta); // #par x #group-1
Type nll;
matrix<Type> probtmp = covariates * beta; // #obs x #group-1
matrix<Type> prob(probtmp.rows(),probtmp.cols()+1); // #obs x #group
prob.block(0,0,probtmp.rows(),probtmp.cols()) = probtmp;
prob.col(prob.cols()-1) = prob.col(0)*Type(0);
prob = exp(prob.array()).matrix();
for(int i = 0; i < prob.rows(); ++i){
prob.row(i) = prob.row(i)/prob.row(i).sum();
}
for(int i = 0; i < group.size(); i++){
nll -= log(prob(i,group(i)));
}
REPORT(prob);
ADREPORT(prob);
matrix<Type> probtmpP = predCovariates * beta; // #obs x #group-1
matrix<Type> probPred(probtmpP.rows(),probtmpP.cols()+1); // #obs x #group
probPred.block(0,0,probtmpP.rows(),probtmpP.cols()) = probtmpP;
probPred.col(probPred.cols()-1) = probPred.col(0)*Type(0);
probPred = exp(prob.array()).matrix();//exp(probPred);
for(int i = 0; i < probPred.rows(); ++i){
probPred.row(i) = probPred.row(i)/probPred.row(i).sum();
}
REPORT(probPred);
ADREPORT(probPred);
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;
}
Type objective_function<Type>::operator() ()
{
DATA_VECTOR(y);
DATA_MATRIX(X)
DATA_MATRIX(dd)
PARAMETER_VECTOR(b);
PARAMETER(a);
PARAMETER(log_sigma);
int n = dd.rows();
// Construct joint negative log-likelihood
joint_nll<Type> jnll(y, X, dd, b, a, log_sigma);
// Random effect initial guess
vector<Type> u(n);
u.setZero();
// Calculate Laplace approx (updates u)
DATA_INTEGER(niter);
Type res = laplace(jnll, u, niter);
ADREPORT(u)
return res;
}
Type objective_function<Type>::operator() () {
// data:
DATA_MATRIX(age);
DATA_VECTOR(len);
DATA_SCALAR(CV_e);
DATA_INTEGER(num_reads);
// parameters:
PARAMETER(a); // upper asymptote
PARAMETER(b); // growth range
PARAMETER(k); // growth rate
PARAMETER(CV_Lt);
PARAMETER(beta);
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 = a / (1 + b * exp(-k * x));
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 -= dexp(x, beta, 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;
}
Type objective_function<Type>::operator() ()
{
DATA_VECTOR(x);
DATA_MATRIX(D);
PARAMETER(phi);
PARAMETER(kappa);
matrix<Type> C(D);
for(int i=0; i<C.rows(); i++)
for(int j=0; j<C.cols(); j++)
C(i,j) = matern(D(i,j), phi, kappa);
Type nll = density::MVNORM_t<Type>(C)(x);
return nll;
}
Type objective_function<Type>::operator() ()
{
DATA_VECTOR (a);
DATA_ARRAY (b);
DATA_MATRIX (c);
DATA_SPARSE_MATRIX (d);
PARAMETER (p);
REPORT(a);
REPORT(b);
REPORT(c);
REPORT(d);
REPORT(p);
//// Vector of anything:
vector<matrix<Type> > voa(2);
voa[0] = c;
voa[1] = c;
REPORT(voa);
return 0;
}
Type objective_function<Type>::operator() () {
// data:
DATA_MATRIX(x_ij);
DATA_VECTOR(y_i);
DATA_IVECTOR(k_i); // vector of IDs
DATA_INTEGER(n_k); // number of IDs
// parameters:
PARAMETER_VECTOR(b_j)
PARAMETER_VECTOR(sigma_j);
PARAMETER(log_b0_sigma);
PARAMETER_VECTOR(b0_k);
int n_data = y_i.size(); // get number of data points to loop over
// Linear predictor
vector<Type> linear_predictor_i(n_data);
vector<Type> linear_predictor_sigma_i(n_data);
linear_predictor_i = x_ij*b_j;
linear_predictor_sigma_i = sqrt(exp(x_ij*sigma_j));
Type nll = 0.0; // initialize negative log likelihood
for(int i = 0; i < n_data; i++){
nll -= dnorm(y_i(i), b0_k(k_i(i)) + linear_predictor_i(i) , linear_predictor_sigma_i(i), true);
}
for(int k = 0; k < n_k; k++){
nll -= dnorm(b0_k(k), Type(0.0), exp(log_b0_sigma), true);
}
REPORT( b0_k );
REPORT(b_j );
ADREPORT( b0_k );
ADREPORT( b_j );
return nll;
}
Type objective_function<Type>::operator() () {
// data:
DATA_MATRIX(x_ij); // fixed effect model matrix
DATA_MATRIX(x_sigma_ij); // fixed effect model matrix
DATA_VECTOR(y_i); // response vector
DATA_IVECTOR(pholder_i); // vector of IDs for strategy
DATA_IVECTOR(strategy_i); // vector of IDs for permit holder
DATA_INTEGER(n_pholder); // number of IDs for pholder
DATA_INTEGER(n_strategy); // number of IDs for strategy
DATA_INTEGER(diversity_column); // fixed effect column position of diversity
DATA_VECTOR(b1_cov_re_i); // predictor data for random slope
DATA_VECTOR(b2_cov_re_i); // predictor data for random slope
/* DATA_VECTOR(b3_cov_re_i); // predictor data for random slope */
DATA_VECTOR(g1_cov_re_i); // predictor data for random slope
DATA_IVECTOR(spec_div_all_1); // indicator for if there is variability in diversity
// parameters:
PARAMETER_VECTOR(b_j);
PARAMETER_VECTOR(sigma_j);
PARAMETER(log_b0_pholder_tau);
// PARAMETER(log_b1_pholder_tau);
PARAMETER(log_b0_strategy_tau);
PARAMETER(log_b1_strategy_tau);
PARAMETER(log_b2_strategy_tau);
/* PARAMETER(log_b3_strategy_tau); */
PARAMETER_VECTOR(b0_pholder);
// PARAMETER_VECTOR(b1_pholder);
PARAMETER_VECTOR(b0_strategy);
PARAMETER_VECTOR(b1_strategy);
PARAMETER_VECTOR(b2_strategy);
/* PARAMETER_VECTOR(b3_strategy); */
//PARAMETER(log_g0_pholder_tau);
PARAMETER(log_g0_strategy_tau);
PARAMETER(log_g1_strategy_tau);
// PARAMETER_VECTOR(g0_pholder);
PARAMETER_VECTOR(g0_strategy);
PARAMETER_VECTOR(g1_strategy);
int n_data = y_i.size();
// Linear predictor
vector<Type> linear_predictor_i(n_data);
vector<Type> linear_predictor_sigma_i(n_data);
vector<Type> eta(n_data);
vector<Type> eta_sigma(n_data);
linear_predictor_i = x_ij*b_j;
linear_predictor_sigma_i = x_sigma_ij*sigma_j;
/* // set slope deviations that we can't estimate to 0: */
/* for(int i = 0; i < n_data; i++){ */
/* if(spec_div_all_1(strategy_i(i)) == 1) { */
/* b1_strategy(strategy_i(i)) = 0; */
/* g1_strategy(strategy_i(i)) = 0; */
/* } */
/* } */
Type nll = 0.0; // initialize negative log likelihood
for(int i = 0; i < n_data; i++){
eta(i) = b0_pholder(pholder_i(i)) +
// b1_pholder(pholder_i(i)) * b1_cov_re_i(i) +
b0_strategy(strategy_i(i)) +
b1_strategy(strategy_i(i)) * b1_cov_re_i(i) +
b2_strategy(strategy_i(i)) * b2_cov_re_i(i) +
/* b3_strategy(strategy_i(i)) * b3_cov_re_i(i) + */
linear_predictor_i(i);
eta_sigma(i) = sqrt(exp(
// g0_pholder(pholder_i(i)) +
g0_strategy(strategy_i(i)) +
g1_strategy(strategy_i(i)) * g1_cov_re_i(i) +
linear_predictor_sigma_i(i)));
nll -= dnorm(y_i(i), eta(i), eta_sigma(i), true);
}
for(int k = 0; k < n_pholder; k++){
nll -= dnorm(b0_pholder(k), Type(0.0), exp(log_b0_pholder_tau), true);
// nll -= dnorm(g0_pholder(k), Type(0.0), exp(log_g0_pholder_tau), true);
// nll -= dnorm(b1_pholder(k), Type(0.0), exp(log_b1_pholder_tau), true);
}
for(int k = 0; k < n_strategy; k++){
nll -= dnorm(b0_strategy(k), Type(0.0), exp(log_b0_strategy_tau), true);
nll -= dnorm(g0_strategy(k), Type(0.0), exp(log_g0_strategy_tau), true);
// only include these species diversity slope deviations
// if there was sufficient variation in species diversity
// to estimate them:
if(spec_div_all_1(k) == 0) {
nll -= dnorm(b1_strategy(k), Type(0.0), exp(log_b1_strategy_tau), true);
nll -= dnorm(g1_strategy(k), Type(0.0), exp(log_g1_strategy_tau), true);
}
nll -= dnorm(b2_strategy(k), Type(0.0), exp(log_b2_strategy_tau), true);
/* nll -= dnorm(b3_strategy(k), Type(0.0), exp(log_b3_strategy_tau), true); */
}
// Reporting
/* Type b0_pholder_tau = exp(log_b0_pholder_tau); */
/* Type b0_strategy_tau = exp(log_b0_strategy_tau); */
// Type b1_tau = exp(log_b1_tau);
/* Type g0_pholder_tau = exp(log_g0_pholder_tau); */
/* Type g0_strategy_tau = exp(log_g0_strategy_tau); */
// Type g1_tau = exp(log_g1_tau);
vector<Type> combined_b1_strategy(n_strategy);
vector<Type> combined_g1_strategy(n_strategy);
for(int k = 0; k < n_strategy; k++){
// these are fixed-effect slopes + random-effect slopes
combined_b1_strategy(k) = b_j(diversity_column) + b1_strategy(k);
combined_g1_strategy(k) = sigma_j(diversity_column) + g1_strategy(k);
}
/* REPORT(b0_pholder); */
REPORT(b0_strategy);
REPORT(eta);
REPORT(b1_strategy);
REPORT(b_j);
/* REPORT(g0_pholder); */
REPORT(g0_strategy);
REPORT(g1_strategy);
/* REPORT(b0_tau); */
// REPORT(b1_tau);
/* REPORT(g0_tau); */
// REPORT(g1_tau);
REPORT(combined_b1_strategy);
REPORT(combined_g1_strategy);
// /* ADREPORT(b0_pholder); */
// ADREPORT(b0_strategy);
// ADREPORT(b1_strategy);
// ADREPORT(b_j);
// /* ADREPORT(g0_pholder); */
// ADREPORT(g0_strategy);
// ADREPORT(g1_strategy);
// /* ADREPORT(b0_tau); */
// ADREPORT(b1_tau);
// /* ADREPORT(g0_tau); */
// ADREPORT(g1_tau);
ADREPORT(combined_b1_strategy);
ADREPORT(combined_g1_strategy);
return nll;
}
Type objective_function<Type>::operator() ()
{
// Data objects
DATA_VECTOR(v1);
DATA_MATRIX(m1);
DATA_ARRAY(a1);
// Parameter objects
PARAMETER(p) // Not used in this example
// Obtaining dimensions of objects
REPORT(a1.dim);
vector<int> d2(2);
d2(0) = m1.rows();
d2(1) = m1.cols();
REPORT(d2);
int d3 = v1.size();
REPORT(d3);
// Matrix multiplication versus elementwise multiplication (similar for addition, subtraction,...)
matrix<Type> m1m1 = m1*m1; // Matrix multiplication of matrices
REPORT(m1m1);
array<Type> a1a1 = a1*a1; // Element-wise multiplication of arrays
REPORT(a1a1);
matrix<Type> m1m1_by_element = (m1.array()*m1.array()).matrix(); // Elementwise multiplication of matrices
REPORT(m1m1_by_element);
array<Type> a1a1_matrix_mult(2,2);
a1a1_matrix_mult = (a1.matrix()*a1.matrix()).array(); // Matrix multiplication of arrays
REPORT(a1a1_matrix_mult);
// Matrix-vector multiplication
REPORT(m1*v1); // matrix-vector product (linear algebra style)
Type v1_norm2 = (v1*v1).sum(); // Inner product v1*v1
REPORT(v1_norm2);
// Indexing objects
m1(1,1); // Element (1,1) of matrix m1
m1.row(1); // 2nd row of matrix m1
m1.col(1); // 2nd col of matrix m1
a1(1,1); // Element (1,1) of array a1
a1.transpose().col(1); // 2nd row of array a1
a1.col(1); //2nd col of array a1
v1(1); // 2nd element of vector v1
// Subsetting matrices and vectors
v1.head(1); // First element of v1
v1.tail(1); // Last element of v1
m1.block(0,0,1,1); // Block of m1 consisting of m1(1,1)
// Subsetting arrays
// See R help pages for "template", i.e. "help(template)" in R
// Generic matrix operations that we must ensure compiles
m1.transpose();
m1.diagonal();
m1.asDiagonal();
Type ans;
return ans;
}
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;
}
Type objective_function<Type>::operator() () {
// data:
DATA_MATRIX(x_ij);
DATA_VECTOR(y_i);
DATA_IVECTOR(k_i); // vector of IDs
DATA_INTEGER(n_k); // number of IDs
DATA_INTEGER(n_j); // number of IDs
DATA_VECTOR(b1_cov_re_i); // predictor data for random slope
DATA_VECTOR(sigma1_cov_re_i); // predictor data for random slope
//DATA_VECTOR(sigma2_cov_re_i); // predictor data for random slope
// parameters:
PARAMETER_VECTOR(b_j)
PARAMETER_VECTOR(sigma_j);
PARAMETER(log_b0_sigma);
PARAMETER_VECTOR(b0_k);
PARAMETER(log_b1_sigma);
PARAMETER_VECTOR(b1_k);
PARAMETER(log_sigma0_sigma);
PARAMETER(log_sigma1_sigma);
PARAMETER_VECTOR(sigma0_k);
PARAMETER_VECTOR(sigma1_k);
int n_data = y_i.size(); // get number of data points to loop over
// Linear predictor
vector<Type> linear_predictor_i(n_data);
vector<Type> linear_predictor_sigma_i(n_data);
linear_predictor_i = x_ij*b_j;
linear_predictor_sigma_i = x_ij*sigma_j;
Type nll = 0.0; // initialize negative log likelihood
for(int i = 0; i < n_data; i++){
nll -= dnorm(
y_i(i),
b0_k(k_i(i)) + b1_k(k_i(i)) * b1_cov_re_i(i) +
linear_predictor_i(i),
sqrt(exp(
sigma0_k(k_i(i)) +
sigma1_k(k_i(i)) * sigma1_cov_re_i(i) +
linear_predictor_sigma_i(i))),
true);
}
for(int k = 0; k < n_k; k++){
nll -= dnorm(b0_k(k), Type(0.0), exp(log_b0_sigma), true);
nll -= dnorm(b1_k(k), Type(0.0), exp(log_b1_sigma), true);
nll -= dnorm(sigma0_k(k), Type(0.0), exp(log_sigma0_sigma), true);
nll -= dnorm(sigma1_k(k), Type(0.0), exp(log_sigma1_sigma), true);
//nll -= dnorm(sigma2_k(k), Type(0.0), exp(log_sigma2_sigma), true);
}
// Reporting
Type b0_sigma = exp(log_b0_sigma);
Type b1_sigma = exp(log_b1_sigma);
Type sigma0_sigma = exp(log_sigma0_sigma);
Type sigma1_sigma = exp(log_sigma1_sigma);
//Type sigma2_sigma = exp(log_sigma2_sigma);
vector<Type> b1_b1_k(n_k);
vector<Type> sigma1_sigma1_k(n_k);
for(int k = 0; k < n_k; k++){
// these are fixed-effect slopes + random-effect slopes
b1_b1_k(k) = b_j(n_j) + b1_k(k);
sigma1_sigma1_k(k) = sigma_j(n_j) + sigma1_k(k);
}
REPORT( b0_k );
REPORT( b1_k );
REPORT( b_j );
REPORT( sigma0_k );
REPORT( sigma1_k );
//REPORT( sigma2_k );
REPORT(b0_sigma);
REPORT(b1_sigma);
REPORT(sigma0_sigma);
REPORT(sigma1_sigma);
//REPORT(sigma2_sigma);
REPORT(b1_b1_k);
REPORT(sigma1_sigma1_k);
//ADREPORT( b0_k );
//ADREPORT( b1_k );
//ADREPORT( b_j );
//ADREPORT( sigma0_k );
//ADREPORT( sigma1_k );
//ADREPORT( sigma2_k );
//ADREPORT(b0_sigma);
//ADREPORT(b1_sigma);
//ADREPORT(sigma0_sigma);
//ADREPORT(sigma1_sigma);
//ADREPORT(sigma2_sigma);
//ADREPORT(b1_b1_k);
//ADREPORT(sigma1_sigma1_k);
return nll;
}
