diff --git a/.github/workflows/R-CMD-check.yml b/.github/workflows/R-CMD-check.yml index 1144b85..133052b 100644 --- a/.github/workflows/R-CMD-check.yml +++ b/.github/workflows/R-CMD-check.yml @@ -23,6 +23,7 @@ jobs: env: R_REMOTES_NO_ERRORS_FROM_WARNINGS: true RSPM: ${{ matrix.config.rspm }} + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} steps: - uses: actions/checkout@v2 @@ -64,8 +65,6 @@ jobs: run: | remotes::install_deps(dependencies=TRUE) remotes::install_cran("rcmdcheck") - remove.packages('FishStatsUtils') - remotes::install_github('James-Thorson-NOAA/FishStatsUtils') shell: Rscript {0} - name: Check Ubuntu diff --git a/DESCRIPTION b/DESCRIPTION index ada239e..3b12abb 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Package: VAST Type: Package Title: Vector-Autoregressive Spatio-Temporal (VAST) Model -Version: 3.9.1 -Date: 2022-07-07 +Version: 3.10.0 +Date: 2022-11-18 Authors@R: c(person(given = "James", family = "Thorson", @@ -20,35 +20,34 @@ Description: VAST is an R package for conducting spatio-temporal analysis factor-analysis or autoregressive correlations among categories, with derived calculation of abundance indices, center-of-gravity, and area-occupied. Imports: - deldir, - stats, - devtools, abind, - MatrixModels, - ThorsonUtilities, effects, INLA, - SpatialDeltaGLMM + stats, + ThorsonUtilities, + utils, + remotes, + devtools Depends: - TMB, - R (>= 3.5.0), + TMB (>= 1.8.0), + FishStatsUtils, + R (>= 3.5.0) Suggests: testthat, knitr, rmarkdown, - FishStatsUtils, pscl, tweedie, mgcv, lme4 Remotes: james-thorson-NOAA/FishStatsUtils, - james-thorson/utilities, - nwfsc-assess/geostatistical_delta-GLMM + james-thorson/utilities +Additional_repositories: https://inla.r-inla-download.org/R/stable License: file LICENSE LazyData: true Encoding: UTF-8 -RoxygenNote: 7.2.0 +RoxygenNote: 7.2.2 ByteCompile: true URL: http://github.com/James-Thorson-NOAA/VAST BugReports: http://github.com/James-Thorson-NOAA/VAST/issues diff --git a/NAMESPACE b/NAMESPACE index a93aed0..7925a85 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -10,11 +10,14 @@ export(Param_Fn) export(Plot_Overdispersion) export(Plot_factors) export(Summarize_Covariance) +export(apply_epsilon) export(check_fit) export(make_data) export(make_map) export(make_model) export(make_parameters) +export(project_model) +export(reload_model) importFrom(INLA,inla.as.dgTMatrix) importFrom(grDevices,colorRampPalette) importFrom(grDevices,dev.off) diff --git a/R/VAST.R b/R/VAST.R index 2f1bae4..eef128f 100644 --- a/R/VAST.R +++ b/R/VAST.R @@ -13,9 +13,10 @@ #' Features are built to be compatible among model types, e.g., by allowing catchability and density covariates to be included in EOF analysis. #' #' See \code{\link[FishStatsUtils]{fit_model}} for a simple example of high-level wrapper functions for using VAST. -#' Also see the wiki \url{https://github.com/James-Thorson-NOAA/VAST/wiki} for examples documenting many different use-cases and features. #' #' @seealso \code{\link[VAST]{VAST}} for general documentation, \code{\link[FishStatsUtils]{make_settings}} for generic settings, \code{\link[FishStatsUtils]{fit_model}} for model fitting, and \code{\link[FishStatsUtils]{plot_results}} for generic plots +#' @seealso VAST wiki \url{https://github.com/James-Thorson-NOAA/VAST/wiki} for examples documenting many different use-cases and features. +#' @seealso GitHub mainpage \url{https://github.com/James-Thorson-NOAA/VAST#description} for a list of user resources and publications documenting features #' @docType package #' @name VAST #' @importFrom utils packageVersion packageDescription diff --git a/R/apply_epsilon.R b/R/apply_epsilon.R new file mode 100644 index 0000000..d401acb --- /dev/null +++ b/R/apply_epsilon.R @@ -0,0 +1,83 @@ + +#' Custom epsilon-correct method +#' +#' \code{apply_epsilon} uses updates to TMB to implement a faster calculation for epsilon-correction +#' +#' @inheritParams TMB::MakeADFun +#' @param fit output from \code{\link[FishStatsUtils]{fit_model}}, specifically using +#' slotes \code{tmb_list}, \code{input_args}, \code{parameter_estimates$SD} +#' @param ADREPORT_name string indicating name of ADREPORT'ed variable +#' @param eps_name string indicating name of PARAMETER used internally by TMB +#' for calculating desired gradient +#' +#' @return Standard output from \code{\link[TMB]{sdreport}}, but with slot +#' \code{x$unbiased} added if needed, and adding or replacing values for +#' \code{x$unbiased$value} corresponding to \code{ADREPORT_name} +#' +#' @export +apply_epsilon <- +function( fit, + ADREPORT_name = "Index_ctl", + eps_name = "eps_Index_ctl", + inner.control = list(sparse=TRUE, lowrank=TRUE, trace=FALSE) ){ + + # Extract stuff + Obj = fit$tmb_list$Obj + if(is.null(fit$Report)) fit$Report = Obj$report() + if(is.null(fit$ParHat)) fit$ParHat = Obj$env$parList() + + # Error checks + if( !all(c("tmb_list","input_args","parameter_estimates") %in% names(fit)) ) stop("Check `fit` in `apply_epsilon`: function is only designed to work with output from VAST using `fit_model`") + if( !(ADREPORT_name %in% names(fit$Report)) ) stop("Check `ADREPORT_name` in `apply_epsilon`") + if( fit$input_args$model_args_input$framework!="TMBad" ) stop("`apply_epsilon` requires that the CPP be compiled using framework=`TMBad`") + if( is.null(fit$parameter_estimates$SD) ) stop("Please re-run with `getsd=TRUE`") + + # Simple extractions + Data = Obj$env$data + Map = Obj$env$map + Random = fit$tmb_list$Random + + # Extract and modify parameters + New_params = fit$ParHat + New_params[[eps_name]] = array(0, dim=dim(fit$Report[[ADREPORT_name]]) ) + + # Change MLE + fixed = fit$parameter_estimates$par + new_values = rep( 0, prod(dim(New_params[[eps_name]])) ) + names(new_values) = rep( eps_name, length(new_values)) + fixed = c( fixed, new_values ) + + # detect sparse + lowrank hessian ... appears to freeze with lowrank=FALSE + obj = MakeADFun( data = Data, + parameters = New_params, + map = Map, + random = Random, + intern = TRUE, + inner.control = inner.control ) + obj$env$beSilent() + gradient = obj$gr(fixed) + + # Expand SD + SD = fit$parameter_estimates$SD + if( is.null(SD$unbiased) ){ + SD$unbiased = list( "value"=SD$value, "sd"=NA, "cov"=array(NA,c(1,1)) ) + SD$unbiased$value[] = NA + }else{ + if( any(!is.na(SD$unbiased$value[ADREPORT_name])) ){ + warning( paste0("it appears that `", ADREPORT_name,"` is already bias-corrected; using `apply_epsilon` seems inefficient and will replace existing values") ) + } + } + + # Merge gradient into SD + i = which( names(SD$value) == ADREPORT_name ) + j = which( names(obj$par) == eps_name ) + if( length(i)==length(j) ){ + SD$unbiased$value[i] = gradient[j] + }else{ + warning("Check `apply_epsilon` for bugs") + } + + # return SD + class(SD) = "sdreport" + return(SD) +} diff --git a/R/check_fit.R b/R/check_fit.R index 08b5dce..2367d30 100644 --- a/R/check_fit.R +++ b/R/check_fit.R @@ -32,7 +32,8 @@ #' @export #' @md # Using https://cran.r-project.org/web/packages/roxygen2/vignettes/rd-formatting.html for guidance on markdown-enabled documentation -check_fit = function( parameter_estimates, +check_fit <- +function( parameter_estimates, check_gradients=FALSE, quiet=FALSE ){ diff --git a/R/effects.R b/R/effects.R index 8145d05..4ef8375 100644 --- a/R/effects.R +++ b/R/effects.R @@ -7,16 +7,24 @@ #' @param which_formula which formula to use e.g., \code{"X1"} #' @param category_number which category code{c_i} to use when plotting density covariates #' +#' If getting the error \code{non-conformable arguments}, consider exploring \code{pad_values} +#' The error arises in when constructing the linear predictor without an intercept, +#' and the default \code{pad_values = 1} attempts to insert a dummy intercept with estimate and SE +#' equal to zero. +#' #' @rawNamespace S3method(effects::Effect, fit_model) #' @export Effect.fit_model <- function( focal.predictors, mod, which_formula = "X1", - pad_values = c(), + pad_values = c(1), category_number = NULL, ...) { + # + message("please read `?Effect.fit_model` for details") + # Error checks #if( mod$data_list$n_c>1 & which_formula%in%c("X1","X2") ){ # stop("`Effect.fit_model` is not currently designed for multivariate models using density covariates") @@ -65,7 +73,7 @@ function( focal.predictors, # Identify which parameters to extract from par and cov whichnum = which( names(mod$parameter_estimates$par) == parname ) map_indices = mod$tmb_list$Parameters[[parname]] - if( "parname" %in% names(mod$tmb_list$Obj$env$map) ){ + if( parname %in% names(mod$tmb_list$Obj$env$map) ){ map_indices[] = mod$tmb_list$Obj$env$map[[parname]] if( any(table(map_indices)>1) ) stop("`Effects.fit_model` not designed to work with mapping of duplicate values") }else{ @@ -110,12 +118,18 @@ function( focal.predictors, #rownames(mod$covhat) = colnames(mod$covhat) = names(mod$parhat) # Augment stuff - formula_full = stats::update.formula(formula_orig, linear_predictor~.+0) + formula_full = stats::update.formula(formula_orig, linear_predictor~.+1) mod$coefficients = mod$parhat mod$vcov = mod$covhat mod$formula = formula_full mod$family = stats::gaussian(link = "identity") + # + if( FALSE ){ + formula_full = update.formula(mod$formula, linear_predictor~.+0) + mod$call = lm( formula_full, data=catchability_data_full)$call + } + if( FALSE ){ Tmp = model.matrix( formula_full, data=fit$effects$catchability_data ) } @@ -142,15 +156,15 @@ function( focal.predictors, } # Bundle arguments - args = list(call = mod$call, + args = list( call = mod$call, coefficients = mod$coefficients, vcov = mod$vcov, family = fam, formula = formula_full) # Do call - effects::Effect.default(focal.predictors, + tmp = effects::Effect.default(focal.predictors, mod, - ..., + #..., sources = args) } diff --git a/R/make_data.R b/R/make_data.R index fe666a9..3253133 100644 --- a/R/make_data.R +++ b/R/make_data.R @@ -65,7 +65,9 @@ #' distributions for subsets of samples, or various other applications. #' @param v_i Vector of integers ranging from 0 to the number of vessels minus 1, #' providing sampling category (e.g., vessel or tow) associated with overdispersed variation for each observation i -#' (by default \code{v_i=0} for all samples, which will not affect things given the default values for \code{OverdispersionConfig}) +#' (by default \code{v_i=0} for all samples, which will not affect things given the default values for \code{OverdispersionConfig}). +#' In some cases a portion of observations have a overdispersion-effect, but not others, and in this case the observations without +#' are specified as \code{v_i=NA} #' @param Version Which CPP version to use. If missing, defaults to latest version #' using \code{\link[FishStatsUtils]{get_latest_version}}. #' Can be used to specify using an older CPP, to maintain backwards compatibility. @@ -125,11 +127,14 @@ #' which is then estimated independently for each model category \code{c_i}, e.g., #' use \code{X1_formula=~BOT_DEPTH+BOT_DEPTH^2} for a quadratic effect of variable \code{BOT_DEPTH} #' that is estimated independently for each category. -#' The effect of an estimated effect also used upon when predicting the value for each location +#' The effect of an estimated effect is also used when predicting the value for each location #' in the extrapolation-grid. Therefore, \code{X1_formula} is interepreted as affecting the "true" #' underlying value of each variable, and it affects both samples and extrapolated values. #' It is allowed to include \code{Year} in the formula, although please check whether it is #' interpreted as numeric or factor-valued. +#' Note that \code{X1_formula} is internally updated (and resulting design-matrices are modified) to avoid +#' any intercept from arising in \code{X1_ip} and \code{X1_gctp}, to avoid identifiability issues between covariates and +#' intercepts for each category. #' @param X2_formula same as \code{X1_formula} but affecting the 2nd linear predictor. #' @param covariate_data data-frame of covariates that is used when constructing density covariates. #' any variable referenced in \code{X1_formula} and \code{X2_formula} must be in \code{covariate_data} @@ -153,12 +158,18 @@ #' However, the effect of \code{Q1_formula} is not used when predicting values at extrapolation-grid locations. #' Therefore, the \code{Q1_formula} is interpreted as affecting "catchability" (a.k.a. "detectabiility"), and it represents #' processes that affect the outcome of sampling but not the "true" underlying value of a variable being sampled. -#' For example, a factor representing gear-type might be included to estimate the relative performacne of each gear type -#' (relative to the base level of that factor). +#' For example, to estimate the relative performance of differeng gear types, include \code{catchability_data = data.frame(gear=gear_factor)} +#' where \code{gear_factor} is a factor-valued indicator for different gear types and \code{Q1_formula = ... + gear}, +#' and this will estimate the catchability for each level relative to the base level of that factor. #' Note that \code{Q1_formula} defines a relationship that is applied to all samples (regardless of category \code{c_i}), #' whereas \code{X1_formula} defines a relationship that is estimated independently for each category. -#' For a catchability covariate that varies by category, please include the category as factor in \code{catchability_data} -#' and then include an interaction with category in \code{Q1_formula} for any variable which has an effect that varies among categories. +#' Also note that \code{\link{make_data}} includes \code{c_iz[,1]} as a column labeled \code{category} in \code{catchability_data}, +#' and that \code{Q1_formula} is internally updated (and resulting design-matrices are modified) to avoid +#' any category-specific intercept from arising in \code{Q1_ik}, to avoid identifiability issues between category-specific +#' covariates and intercepts. +#' For example, for a catchability covariate that varies by category, include an interaction with category in \code{Q1_formula}, +#' e.g., \code{Q1_formula = ... + category:gear} where \code{gear} is a factor to estimate category-specific catchability ratio for +#' different levels of \code{gear}. #' @param Q2_formula same as \code{Q2_formula} but affecting the 2nd linear predictor. #' @param catchability_data data-frame of covariates for use when specifying \code{Q1_formula} and \code{Q2_formula} #' @param Q1config_k Same as argument \code{X1config_cp} but affecting affecting the 1st linear predictor for catchability, @@ -174,9 +185,12 @@ #' The first column specifies whether to calculate annual index for category \code{c} as the weighted-sum across density estimates, #' where density is weighted by area ("area-weighted expansion", \code{Expansion[c,1]=0}, the default), #' where density is weighted by the expanded value for another category ("abundance weighted expansion" \code{Expansion[c1,1]=1}), -#' or the index is calculated as the weighted average of density weighted by the expanded value for another category -#' ("abundance weighted-average expansion" \code{Expansion[c1,1]=2}). The 2nd column is only used when \code{Expansion[c1,1]=1} or \code{Expansion[c1,1]=2}, -#' and specifies the category to use for abundance-weighted expansion, where \code{Expansion[c1,2]=c2} and \code{c2} must be lower than \code{c1}. +#' the index is calculated as the weighted average of density weighted by the expanded value for another category +#' ("abundance weighted-average expansion" \code{Expansion[c1,1]=2}), or the area-weighted abundance is added to the expanded +#' abundance for a prior category \code{Expansion[c1,1]=3}). +#' The 2nd column is used when \code{Expansion[c1,1]=1} or \code{Expansion[c1,1]=2} or \code{Expansion[c1,1]=3}, +#' and specifies the category to use for abundance-weighted expansion/average/summation, +#' where \code{Expansion[c1,2]=c2} and \code{c2} must be lower than \code{c1}. #' @param F_ct matrix of instantanous fishing mortality for each category c and year t. Only feasible when using a Poisson-link delta model #' and specifying temporal structure on intercepts, when the temporal autocorrelation is equivalent to a Spawning Potential #' Ratio (SPR) proxy for fishing mortality targets given the implied Gompertz density dependence. @@ -189,8 +203,8 @@ #' \item{\code{Options["Calculate_proportion"]=TRUE}}{Turns on internal calculation and SE for proportion of response within each category (e.g., for calculating proportion-at-age or species turnover)} #' \item{\code{Options["Calculate_Synchrony"]=TRUE}}{Turns on internal calculation and SE for Loreau metric of synchrony (a.k.a. portfolio effects)} #' \item{\code{Options["report_additional_variables"]=TRUE}}{Export additional variables to \code{Report} object, to use for diagnostics or additional exploration} -#' \item{\code{Options["range_fraction"]}}{The decorrelation range when passing over land relative to over water; the default value \code{Options["range_fraction"]=0.2} indicates that the range is shorter over land, i.e., that correlations are strongest via water, while changing to \code{Options["range_fraction"]=5} would represent correlations transfer via land more than water} -#' } +#' \item{\code{Options["basin_method"]}}{Controls how the density-dependent index is generated from model variables. Default \code{Options["basin_method"]=2}) uses annual mean of betas and epsilons as index. Alternative \code{Options["basin_method"]=4}) uses a Lagrange multiplier to penalize index towards total abundance} +#' \item{\code{Options["range_fraction"]}}{The decorrelation range when passing over land relative to over water; the default value \code{Options["range_fraction"]=0.2} indicates that the range is shorter over land, i.e., that correlations are strongest via water, while changing to \code{Options["range_fraction"]=5} would represent correlations transfer via land more than water}#' } #' @param yearbounds_zz matrix with two columns, giving first and last years for defining one or more periods (rows) used to #' calculate changes in synchrony over time (only used if \code{Options['Calculate_Synchrony']=1}) #' @param CheckForErrors whether to check for errors in input (NOTE: when \code{CheckForErrors=TRUE}, the function will throw an error if @@ -288,7 +302,7 @@ function( b_i, 'report_additional_variables' = FALSE, 'zerosum_penalty' = 0, 'EOF_unity_trace' = 0, - 'basin_method' = 0, + 'basin_method' = 2, 'lagrange_multiplier' = 50, 'range_fraction' = 0.2 ) @@ -331,7 +345,7 @@ function( b_i, n_t = max(tprime_i,na.rm=TRUE) + 1 n_c = max(c_iz,na.rm=TRUE) + 1 n_e = max(e_i) + 1 - n_v = length(unique(v_i)) # If n_v=1, then turn off overdispersion later + n_v = length(unique(na.omit(v_i))) # If n_v=1, then turn off overdispersion later n_i = length(b_i) n_x = nrow(a_gl) n_l = ncol(a_gl) @@ -400,7 +414,6 @@ function( b_i, # X1_ip , X2_ip (where X_itp = X1_itp for backwards compatibility) # X1_gctp , X2_gctp (where X_gctp = X1_gctp for backwards compatibility) # X1config_cp , X2config_cp - # X_xtp (for backwards compatibility, which hasn't yet been entirely deprecated) #################### # Inputs that are deprecated or avoid user-interface @@ -437,18 +450,11 @@ function( b_i, } # Check for backwards-compatibility issues - if( FishStatsUtils::convert_version_name(Version) >= FishStatsUtils::convert_version_name("VAST_v8_0_0") ){ - if( !is.null(X_xtp) ){ - stop("`X_xtp` is not used in version >= 8.0.0. If you'd like to specify covariates using input `X_xtp` please use `Version='VAST_v7_0_0'`") - } - } - if( FishStatsUtils::convert_version_name(Version) <= FishStatsUtils::convert_version_name("VAST_v7_0_0") ){ - if( !is.null(X_gctp) | !is.null(X_ip) ){ - stop("`X_gctp` and `X_ip` are not used in version <= 7.0.0. If you'd like to specify covariates using input `X_gctp` and `X_ip` please use `Version='VAST_v8_0_0'` or higher") - } + if( !is.null(X_xtp) ){ + stop("`X_xtp` is deprecated") } if( FishStatsUtils::convert_version_name(Version) <= FishStatsUtils::convert_version_name("VAST_v11_0_0") ){ - if( X1_formula != ~0 | X2_formula != ~0 ){ + if( (X1_formula != ~0) | (X2_formula != ~0) ){ stop("`X1_formula` and `X2_formula`; to use these please use `Version='VAST_v12_0_0'` or higher") } } @@ -565,7 +571,7 @@ function( b_i, # Check for backwards-compatibility issues if( FishStatsUtils::convert_version_name(Version) <= FishStatsUtils::convert_version_name("VAST_v11_0_0") ){ - if( Q1_formula != ~0 | Q1_formula != ~0 ){ + if( (Q1_formula != ~0) | (Q2_formula != ~0) ){ stop("`Q1_formula` and `Q1_formula`; to use these please use `Version='VAST_v12_0_0'` or higher") } } @@ -581,15 +587,35 @@ function( b_i, if( Catchability_created==FALSE ){ if( !is.null(catchability_data) ){ if( nrow(catchability_data)!=n_i ) stop("`catchability_data` has the wrong number of rows; please supply one row for each observation `i`") + if( !("category" %in% names(catchability_data)) ){ + catchability_data = cbind( catchability_data, "category"=factor(c_iz[,1]) ) + }else{ + #catchability_data$category = factor(catchability_data$category) + if(!is.factor(catchability_data$category)) warning("`catchability_data$category` is not a factor, so catchability formulae might not function as intended") + } Catchability_created = TRUE # First predictor - Model_matrix1 = stats::model.matrix( stats::update.formula(Q1_formula, ~.+1), data=catchability_data ) - Columns_to_keep = which( attr(Model_matrix1,"assign") != 0 ) + if( nlevels(catchability_data$category)>1 ){ + Q1_formula_updated = stats::update.formula( Q1_formula, ~ . + 1 + category + factor(category) ) + }else{ + Q1_formula_updated = stats::update.formula( Q1_formula, ~ . + 1 ) + } + Model_matrix1 = stats::model.matrix( Q1_formula_updated, data=catchability_data ) + Terms1 = attr( terms(Q1_formula_updated), "term.labels" ) + #Columns_to_keep = which( !(attr(Model_matrix1,"assign") %in% c(0,which(Terms1=="category"))) ) + Columns_to_keep = which( !(attr(Model_matrix1,"assign") %in% c( 0, which(Terms1 %in% c("category","factor(category)")))) ) coefficient_names_Q1 = attr(Model_matrix1,"dimnames")[[2]][Columns_to_keep] Q1_ik = Model_matrix1[,Columns_to_keep,drop=FALSE] - # First predictor - Model_matrix2 = stats::model.matrix( stats::update.formula(Q2_formula, ~.+1), data=catchability_data ) - Columns_to_keep = which( attr(Model_matrix2,"assign") != 0 ) + # Second predictor + if( nlevels(catchability_data$category)>1 ){ + Q2_formula_updated = stats::update.formula( Q2_formula, ~ . + 1 + category + factor(category) ) + }else{ + Q2_formula_updated = stats::update.formula( Q2_formula, ~ . + 1 ) + } + Model_matrix2 = stats::model.matrix( Q2_formula_updated, data=catchability_data ) + Terms2 = attr( terms(Q2_formula_updated), "term.labels" ) + #Columns_to_keep = which( !(attr(Model_matrix2,"assign") %in% c(0,which(Terms2=="category"))) ) + Columns_to_keep = which( !(attr(Model_matrix2,"assign") %in% c( 0, which(Terms2 %in% c("category","factor(category)")))) ) coefficient_names_Q2 = attr(Model_matrix2,"dimnames")[[2]][Columns_to_keep] Q2_ik = Model_matrix2[,Columns_to_keep,drop=FALSE] } @@ -644,6 +670,12 @@ function( b_i, if( !is.array(Expansion_cz) || !(all(dim(Expansion_cz)==c(n_c,2))) ){ stop("`Expansion_cz` has wrong dimensions") } + if( any(Expansion_cz[,2] >= 1:n_c) ){ + stop("`Expansion_cz[c,2]` must be less than c for each row") + } + if( !all(Expansion_cz[,1] %in% c(0,1,2,3)) ){ + stop("`Expansion_cz[c,1]` must be one of the available options: {0,1,2,3}") + } } # Translate FieldConfig from input formatting to CPP formatting @@ -735,7 +767,7 @@ function( b_i, if( n_c!=length(unique(na.omit(as.vector(c_iz)))) ) stop("n_c doesn't equal the number of levels in c_i") #if( any(ObsModel_ez[,1]==9) & !all(b_i%in%0:3) ) stop("If using 'ObsModel_ez[e,1]=9', all 'b_i' must be in {0,1,2,3}") if( length(unique(ObsModel_ez[,2]))>1 ) stop("All `ObsModel_ez[,2]` must have the same value") - if( any(OverdispersionConfig>0) & length(unique(v_i))==1 ) stop("It doesn't make sense to use use `OverdispersionConfig` when using only one level of `v_i`") + if( any(OverdispersionConfig>0) & length(unique(na.omit(v_i)))==1 ) stop("It doesn't make sense to use use `OverdispersionConfig` when using only one level of `v_i`") if( any(ObsModel_ez[,1] %in% c(12,13,14)) ){ if( any(ObsModel_ez[,2] != 1) ) stop("If using `ObsModel_ez[e,1]` in {12,13,14} then must use `ObsModel_ez[e,2]=1`") if( !any(ObsModel_ez[,1] %in% c(0,1,2,3,4,9)) ) stop("Using `ObsModel_ez[e,1]` in {12,13,14} is only intended when combining data with biomass-sampling data") @@ -743,43 +775,35 @@ function( b_i, if( all(b_i>as_units(0,b_units)) & all(ObsModel_ez[,1]==0) & !all(FieldConfig_input[1:2,1]==-1) ) stop("All data are positive and using a conventional delta-model, so please turn off `Omega1` and `Epsilon1` terms") if( !(all(ObsModel_ez[,1] %in% c(0,1,2,4,5,7,9,10,11,12,13,14))) ) stop("Please check `ObsModel_ez[,1]` input") if( !(all(ObsModel_ez[,2] %in% c(0,1,2,3,4))) ) stop("Please check `ObsModel_ez[,2]` input") - if( !all(RhoConfig[1]%in%c(0,1,2,3,4)) | !all(RhoConfig[2]%in%c(0,1,2,3,4,6)) | !all(RhoConfig[3]%in%c(0,1,2,4,5)) | !all(RhoConfig[4]%in%c(0,1,2,4,5,6)) ) stop("Check `RhoConfig` inputs") - if( any(is.na(X_xtp)) ) stop("Some `X_xtp` is NA, and this is not allowed") + if( !all(RhoConfig[1]%in%c(0,1,2,3,4,5)) | !all(RhoConfig[2]%in%c(0,1,2,3,4,5,6)) | !all(RhoConfig[3]%in%c(0,1,2,4,5)) | !all(RhoConfig[4]%in%c(0,1,2,4,5,6)) ) stop("Check `RhoConfig` inputs") if( any(is.na(X1_gctp)) ) stop("Some `X1_gctp` is NA, and this is not allowed") if( any(is.na(X1_ip)) ) stop("Some `X1_ip` is NA, and this is not allowed") if( n_c==1 && !all(FieldConfig_input[1:3,] %in% c(-3,-2,-1,1)) ) stop("If using a univariate model, `FieldConfig` must be 0, 1, or `IID` for all entries") + if( any(sapply( catchability_data, FUN=function(x){any(is.infinite(x)|is.na(x)|is.nan(x))} )) ) stop("Please remove NA, NaN, and Inf values from `catchability_data`") } # Check for wrong dimensions if( CheckForErrors==TRUE ){ if( any(c(length(b_i),length(a_i),nrow(c_iz),length(tprime_i),length(v_i),length(PredTF_i))!=n_i) ) stop("b_i, a_i, c_i, s_i, v_i, or tprime_i doesn't have length n_i") if( nrow(a_gl)!=n_x | ncol(a_gl)!=n_l ) stop("a_xl has wrong dimensions") - if( FishStatsUtils::convert_version_name(Version) >= FishStatsUtils::convert_version_name("VAST_v8_0_0") ){ - if( any(dim(X1_gctp)[1:3] != c(n_g,n_c,n_t)) ) stop("X1_gctp has wrong dimensions") - if( nrow(X1_ip) != n_i ) stop("X1_ip has wrong dimensions") - }else{ - if( any(dim(X_xtp)[1:2] != c(n_x,n_t)) ) stop("X_xtp has wrong dimensions") - } + if( any(dim(X1_gctp)[1:3] != c(n_g,n_c,n_t)) ) stop("X1_gctp has wrong dimensions") + if( nrow(X1_ip) != n_i ) stop("X1_ip has wrong dimensions") if( ncol(c_iz)>1 & any(ObsModel_ez[,2]!=1) ) stop("Using multiple columnns in `c_iz` only makes sense using a Poisson-link delta model via `ObsModel[2]=1`") if( nrow(F_ct)!=n_c | ncol(F_ct)!=n_t ) stop("F_ct has wrong dimensions") if( ncol(overlap_zz) != 7 ) stop("Input `overlap_zz` must contain 7 columns but doesn't") if( any(overlap_zz[,c(1,3)] >= n_c) ) stop("Check `overlap_zz[,c(1,3)]` entries") if( any(overlap_zz[,c(2,4)] >= n_t) ) stop("Check `overlap_zz[,c(2,4)]` entries") + if( nrow(Q1_ik)!= n_i | nrow(Q2_ik)!= n_i ) stop("Please check number of rows for `Q1_ik` and `Q2_ik`") } ################### # Check for incompatibilities amongst versions ################### - if( FishStatsUtils::convert_version_name(Version) < FishStatsUtils::convert_version_name("VAST_v5_5_0") ){ - stop("Versions prior to `Version='VAST_v5_5_0'` are no longer allowed") - } if( FishStatsUtils::convert_version_name(Version) >= FishStatsUtils::convert_version_name("VAST_v9_4_0") ){ if(VamConfig[1]==3) stop("`VamConfig[1]=3` feature causes compile issues on macOS, and has been removed from the CPP; please contact package author if interested in using it.") } - if( FishStatsUtils::convert_version_name(Version) >= FishStatsUtils::convert_version_name("VAST_v8_0_0") ){ - if( is.null(spatial_list) ) stop("Must provide `spatial_list` for Version >= 8.0.0") - } + if( is.null(spatial_list) ) stop("Must provide `spatial_list` for Version >= 8.0.0") if( any(ObsModel_ez[,1]==3) ){ if( FishStatsUtils::convert_version_name(Version) <= FishStatsUtils::convert_version_name("VAST_v8_2_0") ){ stop("Inverse-gaussian distribution only available for CPP version >= 8_3_0") @@ -814,6 +838,7 @@ function( b_i, # Interactions if( VamConfig[1]!=0 ){ + stop("`VamConfig` has been disabled, but could be re-added if helpful; please contact package author if interested in exploring") if( any(ObsModel_ez[,2]!=1) ){ stop("Must use Poisson-link delta model when estimating interactions") } @@ -956,10 +981,6 @@ function( b_i, if( n_c>1 & any(FieldConfig_input==1)){ warning( "Using 1 factor for more than one category: Please note that this is non-standard, and it is more common to use multiple factors (often as many as the number of categories)" ) } - #SD_p = apply( X_xtp, MARGIN=3, FUN=sd ) - #if( any(SD_p>3) ){ - # warning( "I highly recommend that you standardize each density covariate `X_xtp` to have a low standard deviation, to avoid numerical under/over-flow" ) - #} # Tweedie bug if( any(ObsModel_ez[,1]==10) ){ @@ -975,38 +996,29 @@ function( b_i, # CMP_xmax should be >100 and CMP_breakpoint should be 1 for Tweedie model Options_vec = c("Aniso"=Aniso, "R2_interpretation"=0, "Rho_beta1_TF"=ifelse(RhoConfig[1]%in%c(1,2,4),1,0), "Rho_beta2_TF"=ifelse(RhoConfig[2]%in%c(1,2,4),1,0), "AreaAbundanceCurveTF"=0, "CMP_xmax"=200, "CMP_breakpoint"=1, "Method"=switch(Method,"Mesh"=0,"Grid"=1,"Spherical_mesh"=0,"Stream_network"=2,"Barrier"=3), "Include_F"=ifelse(all(F_ct==0),0,F_init) ) Return = NULL - if(Version%in%c("VAST_v5_5_0")){ - Return = list( "n_i"=n_i, "n_s"=c(MeshList$anisotropic_spde$n.spde,n_x,n_x)[Options_vec['Method']+1], "n_x"=n_x, "n_t"=n_t, "n_c"=n_c, "n_e"=n_e, "n_p"=dim(X_xtp)[3], "n_v"=n_v, "n_l"=n_l, "n_m"=ncol(Z_xm), "Options_list"=list("Options_vec"=Options_vec,"Options"=Options2use,"yearbounds_zz"=yearbounds_zz,"Expansion_cz"=Expansion_cz,"metadata_ctz"=metadata_ctz), "FieldConfig"=as.vector(FieldConfig_input[1:2,]), "RhoConfig"=RhoConfig, "OverdispersionConfig"=OverdispersionConfig_input, "ObsModel_ez"=ObsModel_ez, "VamConfig"=VamConfig, "include_data"=TRUE, "b_i"=b_i, "a_i"=a_i, "c_iz"=c_iz, "e_i"=e_i, "s_i"=s_i, "t_iz"=matrix(tprime_i,ncol=1), "v_i"=match(v_i,sort(unique(v_i)))-1, "PredTF_i"=PredTF_i, "a_xl"=a_gl, "X_xj"=matrix(0,nrow=n_x,ncol=1), "X_xtp"=X_xtp, "Q_ik"=Q1_ik, "t_yz"=t_yz, "Z_xm"=Z_xm, "F_ct"=F_ct, "parent_s"=Network_sz[,'parent_s']-1, "child_s"=Network_sz[,'child_s']-1, "dist_s"=Network_sz[,'dist_s'], "spde"=list(), "spde_aniso"=list(), "M0"=GridList$M0, "M1"=GridList$M1, "M2"=GridList$M2 ) - } - if(Version%in%c("VAST_v6_0_0")){ - Return = list( "n_i"=n_i, "n_s"=c(MeshList$anisotropic_spde$n.spde,n_x,n_x)[Options_vec['Method']+1], "n_x"=n_x, "n_t"=n_t, "n_c"=n_c, "n_e"=n_e, "n_p"=dim(X_xtp)[3], "n_v"=n_v, "n_l"=n_l, "n_m"=ncol(Z_xm), "Options_list"=list("Options_vec"=Options_vec,"Options"=Options2use,"yearbounds_zz"=yearbounds_zz,"Expansion_cz"=Expansion_cz,"metadata_ctz"=metadata_ctz), "FieldConfig"=as.vector(FieldConfig_input[1:2,]), "RhoConfig"=RhoConfig, "OverdispersionConfig"=OverdispersionConfig_input, "ObsModel_ez"=ObsModel_ez, "VamConfig"=VamConfig, "Xconfig_zcp"=abind::abind(X1config_cp,X2config_cp,along=3), "include_data"=TRUE, "b_i"=b_i, "a_i"=a_i, "c_iz"=c_iz, "e_i"=e_i, "s_i"=s_i, "t_iz"=matrix(tprime_i,ncol=1), "v_i"=match(v_i,sort(unique(v_i)))-1, "PredTF_i"=PredTF_i, "a_xl"=a_gl, "X_xtp"=X_xtp, "Q_ik"=Q1_ik, "t_yz"=t_yz, "Z_xm"=Z_xm, "F_ct"=F_ct, "parent_s"=Network_sz[,'parent_s']-1, "child_s"=Network_sz[,'child_s']-1, "dist_s"=Network_sz[,'dist_s'], "spde"=list(), "spde_aniso"=list(), "M0"=GridList$M0, "M1"=GridList$M1, "M2"=GridList$M2 ) - } - if(Version%in%c("VAST_v7_0_0")){ - Return = list( "n_i"=n_i, "n_s"=c(MeshList$anisotropic_spde$n.spde,n_x,n_x)[Options_vec['Method']+1], "n_x"=n_x, "n_t"=n_t, "n_c"=n_c, "n_e"=n_e, "n_p"=dim(X_xtp)[3], "n_v"=n_v, "n_l"=n_l, "n_m"=ncol(Z_xm), "Options_list"=list("Options_vec"=Options_vec,"Options"=Options2use,"yearbounds_zz"=yearbounds_zz,"Expansion_cz"=Expansion_cz,"metadata_ctz"=metadata_ctz), "FieldConfig"=FieldConfig_input, "RhoConfig"=RhoConfig, "OverdispersionConfig"=OverdispersionConfig_input, "ObsModel_ez"=ObsModel_ez, "VamConfig"=VamConfig, "Xconfig_zcp"=abind::abind(X1config_cp,X2config_cp,along=3), "include_data"=TRUE, "b_i"=b_i, "a_i"=a_i, "c_iz"=c_iz, "e_i"=e_i, "s_i"=s_i, "t_iz"=matrix(tprime_i,ncol=1), "v_i"=match(v_i,sort(unique(v_i)))-1, "PredTF_i"=PredTF_i, "a_xl"=a_gl, "X_xtp"=X_xtp, "Q_ik"=Q1_ik, "t_yz"=t_yz, "Z_xm"=Z_xm, "F_ct"=F_ct, "parent_s"=Network_sz[,'parent_s']-1, "child_s"=Network_sz[,'child_s']-1, "dist_s"=Network_sz[,'dist_s'], "spde"=list(), "spde_aniso"=list(), "M0"=GridList$M0, "M1"=GridList$M1, "M2"=GridList$M2 ) - } if(Version%in%c("VAST_v9_1_0","VAST_v9_0_0","VAST_v8_6_0","VAST_v8_5_0","VAST_v8_4_0","VAST_v8_3_0","VAST_v8_2_0","VAST_v8_1_0","VAST_v8_0_0")){ - Return = list( "n_i"=n_i, "n_s"=c(MeshList$anisotropic_spde$n.spde,n_x,n_x)[Options_vec['Method']+1], "n_g"=n_g, "n_t"=n_t, "n_c"=n_c, "n_e"=n_e, "n_p"=ncol(X1_ip), "n_v"=n_v, "n_l"=n_l, "n_m"=ncol(Z_gm), "Options_list"=list("Options_vec"=Options_vec,"Options"=Options2use,"yearbounds_zz"=yearbounds_zz,"Expansion_cz"=Expansion_cz,"metadata_ctz"=metadata_ctz), "FieldConfig"=FieldConfig_input, "RhoConfig"=RhoConfig, "OverdispersionConfig"=OverdispersionConfig_input, "ObsModel_ez"=ObsModel_ez, "VamConfig"=VamConfig, "Xconfig_zcp"=abind::abind(X1config_cp,X2config_cp,along=3), "include_data"=TRUE, "b_i"=b_i, "a_i"=a_i, "c_iz"=c_iz, "e_i"=e_i, "t_iz"=matrix(tprime_i,ncol=1), "v_i"=match(v_i,sort(unique(v_i)))-1, "PredTF_i"=PredTF_i, "a_gl"=a_gl, "X_itp"=aperm(X1_ip%o%rep(1,n_t),c(1,3,2)), "X_gtp"=array(X1_gctp[,1,,],dim(X1_gctp)[c(1,3,4)]), "Q_ik"=Q1_ik, "t_yz"=t_yz, "Z_gm"=Z_gm, "F_ct"=F_ct, "parent_s"=Network_sz[,'parent_s']-1, "child_s"=Network_sz[,'child_s']-1, "dist_s"=Network_sz[,'dist_s'], "spde"=list(), "spde_aniso"=list(), "M0"=GridList$M0, "M1"=GridList$M1, "M2"=GridList$M2, "Ais_ij"=cbind(spatial_list$A_is@i,spatial_list$A_is@j), "Ais_x"=spatial_list$A_is@x, "Ags_ij"=cbind(spatial_list$A_gs@i,spatial_list$A_gs@j), "Ags_x"=spatial_list$A_gs@x ) + Return = list( "n_i"=n_i, "n_s"=c(MeshList$anisotropic_spde$n.spde,n_x,n_x)[Options_vec['Method']+1], "n_g"=n_g, "n_t"=n_t, "n_c"=n_c, "n_e"=n_e, "n_p"=ncol(X1_ip), "n_v"=n_v, "n_l"=n_l, "n_m"=ncol(Z_gm), "Options_list"=list("Options_vec"=Options_vec,"Options"=Options2use,"yearbounds_zz"=yearbounds_zz,"Expansion_cz"=Expansion_cz,"metadata_ctz"=metadata_ctz), "FieldConfig"=FieldConfig_input, "RhoConfig"=RhoConfig, "OverdispersionConfig"=OverdispersionConfig_input, "ObsModel_ez"=ObsModel_ez, "VamConfig"=VamConfig, "Xconfig_zcp"=aperm(abind::abind(X1config_cp,X2config_cp,along=3),c(3,1,2)), "include_data"=TRUE, "b_i"=b_i, "a_i"=a_i, "c_iz"=c_iz, "e_i"=e_i, "t_iz"=matrix(tprime_i,ncol=1), "v_i"=match(v_i,sort(unique(na.omit(v_i))))-1, "PredTF_i"=PredTF_i, "a_gl"=a_gl, "X_itp"=aperm(X1_ip%o%rep(1,n_t),c(1,3,2)), "X_gtp"=array(X1_gctp[,1,,],dim(X1_gctp)[c(1,3,4)]), "Q_ik"=Q1_ik, "t_yz"=t_yz, "Z_gm"=Z_gm, "F_ct"=F_ct, "parent_s"=Network_sz[,'parent_s']-1, "child_s"=Network_sz[,'child_s']-1, "dist_s"=Network_sz[,'dist_s'], "spde"=list(), "spde_aniso"=list(), "M0"=GridList$M0, "M1"=GridList$M1, "M2"=GridList$M2, "Ais_ij"=cbind(spatial_list$A_is@i,spatial_list$A_is@j), "Ais_x"=spatial_list$A_is@x, "Ags_ij"=cbind(spatial_list$A_gs@i,spatial_list$A_gs@j), "Ags_x"=spatial_list$A_gs@x ) } if(Version%in%c("VAST_v9_2_0")){ - Return = list( "n_i"=n_i, "n_s"=c(MeshList$anisotropic_spde$n.spde,n_x,n_x)[Options_vec['Method']+1], "n_g"=n_g, "n_t"=n_t, "n_c"=n_c, "n_e"=n_e, "n_p"=ncol(X1_ip), "n_v"=n_v, "n_l"=n_l, "n_m"=ncol(Z_gm), "Options_list"=list("Options_vec"=Options_vec,"Options"=Options2use,"yearbounds_zz"=yearbounds_zz,"Expansion_cz"=Expansion_cz,"overlap_zz"=overlap_zz,"metadata_ctz"=metadata_ctz), "FieldConfig"=FieldConfig_input, "RhoConfig"=RhoConfig, "OverdispersionConfig"=OverdispersionConfig_input, "ObsModel_ez"=ObsModel_ez, "VamConfig"=VamConfig, "Xconfig_zcp"=abind::abind(X1config_cp,X2config_cp,along=3), "include_data"=TRUE, "b_i"=b_i, "a_i"=a_i, "c_iz"=c_iz, "e_i"=e_i, "t_iz"=matrix(tprime_i,ncol=1), "v_i"=match(v_i,sort(unique(v_i)))-1, "PredTF_i"=PredTF_i, "a_gl"=a_gl, "X_itp"=aperm(X1_ip%o%rep(1,n_t),c(1,3,2)), "X_gtp"=array(X1_gctp[,1,,],dim(X1_gctp)[c(1,3,4)]), "Q_ik"=Q1_ik, "t_yz"=t_yz, "Z_gm"=Z_gm, "F_ct"=F_ct, "parent_s"=Network_sz[,'parent_s']-1, "child_s"=Network_sz[,'child_s']-1, "dist_s"=Network_sz[,'dist_s'], "spde"=list(), "spde_aniso"=list(), "M0"=GridList$M0, "M1"=GridList$M1, "M2"=GridList$M2, "Ais_ij"=cbind(spatial_list$A_is@i,spatial_list$A_is@j), "Ais_x"=spatial_list$A_is@x, "Ags_ij"=cbind(spatial_list$A_gs@i,spatial_list$A_gs@j), "Ags_x"=spatial_list$A_gs@x ) + Return = list( "n_i"=n_i, "n_s"=c(MeshList$anisotropic_spde$n.spde,n_x,n_x)[Options_vec['Method']+1], "n_g"=n_g, "n_t"=n_t, "n_c"=n_c, "n_e"=n_e, "n_p"=ncol(X1_ip), "n_v"=n_v, "n_l"=n_l, "n_m"=ncol(Z_gm), "Options_list"=list("Options_vec"=Options_vec,"Options"=Options2use,"yearbounds_zz"=yearbounds_zz,"Expansion_cz"=Expansion_cz,"overlap_zz"=overlap_zz,"metadata_ctz"=metadata_ctz), "FieldConfig"=FieldConfig_input, "RhoConfig"=RhoConfig, "OverdispersionConfig"=OverdispersionConfig_input, "ObsModel_ez"=ObsModel_ez, "VamConfig"=VamConfig, "Xconfig_zcp"=aperm(abind::abind(X1config_cp,X2config_cp,along=3),c(3,1,2)), "include_data"=TRUE, "b_i"=b_i, "a_i"=a_i, "c_iz"=c_iz, "e_i"=e_i, "t_iz"=matrix(tprime_i,ncol=1), "v_i"=match(v_i,sort(unique(na.omit(v_i))))-1, "PredTF_i"=PredTF_i, "a_gl"=a_gl, "X_itp"=aperm(X1_ip%o%rep(1,n_t),c(1,3,2)), "X_gtp"=array(X1_gctp[,1,,],dim(X1_gctp)[c(1,3,4)]), "Q_ik"=Q1_ik, "t_yz"=t_yz, "Z_gm"=Z_gm, "F_ct"=F_ct, "parent_s"=Network_sz[,'parent_s']-1, "child_s"=Network_sz[,'child_s']-1, "dist_s"=Network_sz[,'dist_s'], "spde"=list(), "spde_aniso"=list(), "M0"=GridList$M0, "M1"=GridList$M1, "M2"=GridList$M2, "Ais_ij"=cbind(spatial_list$A_is@i,spatial_list$A_is@j), "Ais_x"=spatial_list$A_is@x, "Ags_ij"=cbind(spatial_list$A_gs@i,spatial_list$A_gs@j), "Ags_x"=spatial_list$A_gs@x ) } if(Version%in%c("VAST_v9_3_0")){ - Return = list( "n_i"=n_i, "n_s"=c(MeshList$anisotropic_spde$n.spde,n_x,n_x,MeshList$anisotropic_spde$n.spde)[Options_vec['Method']+1], "n_g"=n_g, "n_t"=n_t, "n_c"=n_c, "n_e"=n_e, "n_p"=ncol(X1_ip), "n_v"=n_v, "n_l"=n_l, "n_m"=ncol(Z_gm), "Options_list"=list("Options_vec"=Options_vec,"Options"=Options2use,"yearbounds_zz"=yearbounds_zz,"Expansion_cz"=Expansion_cz,"overlap_zz"=overlap_zz,"metadata_ctz"=metadata_ctz), "FieldConfig"=FieldConfig_input, "RhoConfig"=RhoConfig, "OverdispersionConfig"=OverdispersionConfig_input, "ObsModel_ez"=ObsModel_ez, "VamConfig"=VamConfig, "Xconfig_zcp"=abind::abind(X1config_cp,X2config_cp,along=3), "include_data"=TRUE, "b_i"=b_i, "a_i"=a_i, "c_iz"=c_iz, "e_i"=e_i, "t_iz"=matrix(tprime_i,ncol=1), "v_i"=match(v_i,sort(unique(v_i)))-1, "PredTF_i"=PredTF_i, "a_gl"=a_gl, "X_itp"=aperm(X1_ip%o%rep(1,n_t),c(1,3,2)), "X_gtp"=array(X1_gctp[,1,,],dim(X1_gctp)[c(1,3,4)]), "Q_ik"=Q1_ik, "t_yz"=t_yz, "Z_gm"=Z_gm, "F_ct"=F_ct, "parent_s"=Network_sz[,'parent_s']-1, "child_s"=Network_sz[,'child_s']-1, "dist_s"=Network_sz[,'dist_s'], "spde"=list(), "spde_aniso"=list(), "spdeMatricesBarrier"=list(), "Barrier_scaling"=NA, "M0"=GridList$M0, "M1"=GridList$M1, "M2"=GridList$M2, "Ais_ij"=cbind(spatial_list$A_is@i,spatial_list$A_is@j), "Ais_x"=spatial_list$A_is@x, "Ags_ij"=cbind(spatial_list$A_gs@i,spatial_list$A_gs@j), "Ags_x"=spatial_list$A_gs@x ) + Return = list( "n_i"=n_i, "n_s"=c(MeshList$anisotropic_spde$n.spde,n_x,n_x,MeshList$anisotropic_spde$n.spde)[Options_vec['Method']+1], "n_g"=n_g, "n_t"=n_t, "n_c"=n_c, "n_e"=n_e, "n_p"=ncol(X1_ip), "n_v"=n_v, "n_l"=n_l, "n_m"=ncol(Z_gm), "Options_list"=list("Options_vec"=Options_vec,"Options"=Options2use,"yearbounds_zz"=yearbounds_zz,"Expansion_cz"=Expansion_cz,"overlap_zz"=overlap_zz,"metadata_ctz"=metadata_ctz), "FieldConfig"=FieldConfig_input, "RhoConfig"=RhoConfig, "OverdispersionConfig"=OverdispersionConfig_input, "ObsModel_ez"=ObsModel_ez, "VamConfig"=VamConfig, "Xconfig_zcp"=aperm(abind::abind(X1config_cp,X2config_cp,along=3),c(3,1,2)), "include_data"=TRUE, "b_i"=b_i, "a_i"=a_i, "c_iz"=c_iz, "e_i"=e_i, "t_iz"=matrix(tprime_i,ncol=1), "v_i"=match(v_i,sort(unique(na.omit(v_i))))-1, "PredTF_i"=PredTF_i, "a_gl"=a_gl, "X_itp"=aperm(X1_ip%o%rep(1,n_t),c(1,3,2)), "X_gtp"=array(X1_gctp[,1,,],dim(X1_gctp)[c(1,3,4)]), "Q_ik"=Q1_ik, "t_yz"=t_yz, "Z_gm"=Z_gm, "F_ct"=F_ct, "parent_s"=Network_sz[,'parent_s']-1, "child_s"=Network_sz[,'child_s']-1, "dist_s"=Network_sz[,'dist_s'], "spde"=list(), "spde_aniso"=list(), "spdeMatricesBarrier"=list(), "Barrier_scaling"=NA, "M0"=GridList$M0, "M1"=GridList$M1, "M2"=GridList$M2, "Ais_ij"=cbind(spatial_list$A_is@i,spatial_list$A_is@j), "Ais_x"=spatial_list$A_is@x, "Ags_ij"=cbind(spatial_list$A_gs@i,spatial_list$A_gs@j), "Ags_x"=spatial_list$A_gs@x ) } if(Version%in%c("VAST_v9_4_0")){ - Return = list( "n_i"=n_i, "n_s"=c(MeshList$anisotropic_spde$n.spde,n_x,n_x,MeshList$anisotropic_spde$n.spde)[Options_vec['Method']+1], "n_g"=n_g, "n_t"=n_t, "n_c"=n_c, "n_e"=n_e, "n_p"=ncol(X1_ip), "n_v"=n_v, "n_l"=n_l, "n_m"=ncol(Z_gm), "Options_list"=list("Options_vec"=Options_vec,"Options"=Options2use,"yearbounds_zz"=yearbounds_zz,"Expansion_cz"=Expansion_cz,"overlap_zz"=overlap_zz,"metadata_ctz"=metadata_ctz), "FieldConfig"=FieldConfig_input, "RhoConfig"=RhoConfig, "OverdispersionConfig"=OverdispersionConfig_input, "ObsModel_ez"=ObsModel_ez, "VamConfig"=VamConfig, "Xconfig_zcp"=abind::abind(X1config_cp,X2config_cp,along=3), "include_data"=TRUE, "b_i"=b_i, "a_i"=a_i, "c_iz"=c_iz, "e_i"=e_i, "t_i"=tprime_i, "v_i"=match(v_i,sort(unique(v_i)))-1, "PredTF_i"=PredTF_i, "a_gl"=a_gl, "X_ip"=X1_ip, "X_gctp"=X1_gctp, "Q_ik"=Q1_ik, "Z_gm"=Z_gm, "F_ct"=F_ct, "parent_s"=Network_sz[,'parent_s']-1, "child_s"=Network_sz[,'child_s']-1, "dist_s"=Network_sz[,'dist_s'], "spde"=list(), "spde_aniso"=list(), "spdeMatricesBarrier"=list(), "Barrier_scaling"=NA, "M0"=GridList$M0, "M1"=GridList$M1, "M2"=GridList$M2, "Ais_ij"=cbind(spatial_list$A_is@i,spatial_list$A_is@j), "Ais_x"=spatial_list$A_is@x, "Ags_ij"=cbind(spatial_list$A_gs@i,spatial_list$A_gs@j), "Ags_x"=spatial_list$A_gs@x ) + Return = list( "n_i"=n_i, "n_s"=c(MeshList$anisotropic_spde$n.spde,n_x,n_x,MeshList$anisotropic_spde$n.spde)[Options_vec['Method']+1], "n_g"=n_g, "n_t"=n_t, "n_c"=n_c, "n_e"=n_e, "n_p"=ncol(X1_ip), "n_v"=n_v, "n_l"=n_l, "n_m"=ncol(Z_gm), "Options_list"=list("Options_vec"=Options_vec,"Options"=Options2use,"yearbounds_zz"=yearbounds_zz,"Expansion_cz"=Expansion_cz,"overlap_zz"=overlap_zz,"metadata_ctz"=metadata_ctz), "FieldConfig"=FieldConfig_input, "RhoConfig"=RhoConfig, "OverdispersionConfig"=OverdispersionConfig_input, "ObsModel_ez"=ObsModel_ez, "VamConfig"=VamConfig, "Xconfig_zcp"=aperm(abind::abind(X1config_cp,X2config_cp,along=3),c(3,1,2)), "include_data"=TRUE, "b_i"=b_i, "a_i"=a_i, "c_iz"=c_iz, "e_i"=e_i, "t_i"=tprime_i, "v_i"=match(v_i,sort(unique(na.omit(v_i))))-1, "PredTF_i"=PredTF_i, "a_gl"=a_gl, "X_ip"=X1_ip, "X_gctp"=X1_gctp, "Q_ik"=Q1_ik, "Z_gm"=Z_gm, "F_ct"=F_ct, "parent_s"=Network_sz[,'parent_s']-1, "child_s"=Network_sz[,'child_s']-1, "dist_s"=Network_sz[,'dist_s'], "spde"=list(), "spde_aniso"=list(), "spdeMatricesBarrier"=list(), "Barrier_scaling"=NA, "M0"=GridList$M0, "M1"=GridList$M1, "M2"=GridList$M2, "Ais_ij"=cbind(spatial_list$A_is@i,spatial_list$A_is@j), "Ais_x"=spatial_list$A_is@x, "Ags_ij"=cbind(spatial_list$A_gs@i,spatial_list$A_gs@j), "Ags_x"=spatial_list$A_gs@x ) } if(Version%in%c("VAST_v10_0_0")){ - Return = list( "n_i"=n_i, "n_s"=c(MeshList$anisotropic_spde$n.spde,n_x,n_x,MeshList$anisotropic_spde$n.spde)[Options_vec['Method']+1], "n_g"=n_g, "n_t"=n_t, "n_c"=n_c, "n_e"=n_e, "n_p1"=ncol(X1_ip), "n_p2"=ncol(X2_ip), "n_v"=n_v, "n_l"=n_l, "n_m"=ncol(Z_gm), "Options_list"=list("Options_vec"=Options_vec,"Options"=Options2use,"yearbounds_zz"=yearbounds_zz,"Expansion_cz"=Expansion_cz,"overlap_zz"=overlap_zz,"metadata_ctz"=metadata_ctz), "FieldConfig"=FieldConfig_input, "RhoConfig"=RhoConfig, "OverdispersionConfig"=OverdispersionConfig_input, "ObsModel_ez"=ObsModel_ez, "VamConfig"=VamConfig, "X1config_cp"=X1config_cp, "X2config_cp"=X2config_cp, "include_data"=TRUE, "b_i"=b_i, "a_i"=a_i, "c_iz"=c_iz, "e_i"=e_i, "t_i"=tprime_i, "v_i"=match(v_i,sort(unique(v_i)))-1, "PredTF_i"=PredTF_i, "a_gl"=a_gl, "X1_ip"=X1_ip, "X1_gctp"=X1_gctp, "X2_ip"=X2_ip, "X2_gctp"=X2_gctp, "Q_ik"=Q1_ik, "Z_gm"=Z_gm, "F_ct"=F_ct, "parent_s"=Network_sz[,'parent_s']-1, "child_s"=Network_sz[,'child_s']-1, "dist_s"=Network_sz[,'dist_s'], "spde"=list(), "spde_aniso"=list(), "spdeMatricesBarrier"=list(), "Barrier_scaling"=NA, "M0"=GridList$M0, "M1"=GridList$M1, "M2"=GridList$M2, "Ais_ij"=cbind(spatial_list$A_is@i,spatial_list$A_is@j), "Ais_x"=spatial_list$A_is@x, "Ags_ij"=cbind(spatial_list$A_gs@i,spatial_list$A_gs@j), "Ags_x"=spatial_list$A_gs@x ) + Return = list( "n_i"=n_i, "n_s"=c(MeshList$anisotropic_spde$n.spde,n_x,n_x,MeshList$anisotropic_spde$n.spde)[Options_vec['Method']+1], "n_g"=n_g, "n_t"=n_t, "n_c"=n_c, "n_e"=n_e, "n_p1"=ncol(X1_ip), "n_p2"=ncol(X2_ip), "n_v"=n_v, "n_l"=n_l, "n_m"=ncol(Z_gm), "Options_list"=list("Options_vec"=Options_vec,"Options"=Options2use,"yearbounds_zz"=yearbounds_zz,"Expansion_cz"=Expansion_cz,"overlap_zz"=overlap_zz,"metadata_ctz"=metadata_ctz), "FieldConfig"=FieldConfig_input, "RhoConfig"=RhoConfig, "OverdispersionConfig"=OverdispersionConfig_input, "ObsModel_ez"=ObsModel_ez, "VamConfig"=VamConfig, "X1config_cp"=X1config_cp, "X2config_cp"=X2config_cp, "include_data"=TRUE, "b_i"=b_i, "a_i"=a_i, "c_iz"=c_iz, "e_i"=e_i, "t_i"=tprime_i, "v_i"=match(v_i,sort(unique(na.omit(v_i))))-1, "PredTF_i"=PredTF_i, "a_gl"=a_gl, "X1_ip"=X1_ip, "X1_gctp"=X1_gctp, "X2_ip"=X2_ip, "X2_gctp"=X2_gctp, "Q_ik"=Q1_ik, "Z_gm"=Z_gm, "F_ct"=F_ct, "parent_s"=Network_sz[,'parent_s']-1, "child_s"=Network_sz[,'child_s']-1, "dist_s"=Network_sz[,'dist_s'], "spde"=list(), "spde_aniso"=list(), "spdeMatricesBarrier"=list(), "Barrier_scaling"=NA, "M0"=GridList$M0, "M1"=GridList$M1, "M2"=GridList$M2, "Ais_ij"=cbind(spatial_list$A_is@i,spatial_list$A_is@j), "Ais_x"=spatial_list$A_is@x, "Ags_ij"=cbind(spatial_list$A_gs@i,spatial_list$A_gs@j), "Ags_x"=spatial_list$A_gs@x ) } if(Version%in%c("VAST_v11_0_0")){ - Return = list( "n_i"=n_i, "n_s"=c(MeshList$anisotropic_spde$n.spde,n_x,n_x,MeshList$anisotropic_spde$n.spde)[Options_vec['Method']+1], "n_g"=n_g, "n_t"=n_t, "n_c"=n_c, "n_e"=n_e, "n_p1"=ncol(X1_ip), "n_p2"=ncol(X2_ip), "n_v"=n_v, "n_l"=n_l, "n_m"=ncol(Z_gm), "Options_list"=list("Options_vec"=Options_vec,"Options"=Options2use,"yearbounds_zz"=yearbounds_zz,"Expansion_cz"=Expansion_cz,"overlap_zz"=overlap_zz,"metadata_ctz"=metadata_ctz), "FieldConfig"=FieldConfig_input, "RhoConfig"=RhoConfig, "OverdispersionConfig"=OverdispersionConfig_input, "ObsModel_ez"=ObsModel_ez, "VamConfig"=VamConfig, "X1config_cp"=X1config_cp, "X2config_cp"=X2config_cp, "include_data"=TRUE, "b_i"=b_i, "a_i"=a_i, "c_iz"=c_iz, "e_i"=e_i, "t_i"=tprime_i, "v_i"=match(v_i,sort(unique(v_i)))-1, "PredTF_i"=PredTF_i, "a_gl"=a_gl, "X1_ip"=X1_ip, "X1_gctp"=X1_gctp, "X2_ip"=X2_ip, "X2_gctp"=X2_gctp, "Q1_ik"=Q1_ik, "Q2_ik"=Q2_ik, "Z_gm"=Z_gm, "F_ct"=F_ct, "parent_s"=Network_sz[,'parent_s']-1, "child_s"=Network_sz[,'child_s']-1, "dist_s"=Network_sz[,'dist_s'], "spde"=list(), "spde_aniso"=list(), "spdeMatricesBarrier"=list(), "Barrier_scaling"=NA, "M0"=GridList$M0, "M1"=GridList$M1, "M2"=GridList$M2, "Ais_ij"=cbind(spatial_list$A_is@i,spatial_list$A_is@j), "Ais_x"=spatial_list$A_is@x, "Ags_ij"=cbind(spatial_list$A_gs@i,spatial_list$A_gs@j), "Ags_x"=spatial_list$A_gs@x ) + Return = list( "n_i"=n_i, "n_s"=c(MeshList$anisotropic_spde$n.spde,n_x,n_x,MeshList$anisotropic_spde$n.spde)[Options_vec['Method']+1], "n_g"=n_g, "n_t"=n_t, "n_c"=n_c, "n_e"=n_e, "n_p1"=ncol(X1_ip), "n_p2"=ncol(X2_ip), "n_v"=n_v, "n_l"=n_l, "n_m"=ncol(Z_gm), "Options_list"=list("Options_vec"=Options_vec,"Options"=Options2use,"yearbounds_zz"=yearbounds_zz,"Expansion_cz"=Expansion_cz,"overlap_zz"=overlap_zz,"metadata_ctz"=metadata_ctz), "FieldConfig"=FieldConfig_input, "RhoConfig"=RhoConfig, "OverdispersionConfig"=OverdispersionConfig_input, "ObsModel_ez"=ObsModel_ez, "VamConfig"=VamConfig, "X1config_cp"=X1config_cp, "X2config_cp"=X2config_cp, "include_data"=TRUE, "b_i"=b_i, "a_i"=a_i, "c_iz"=c_iz, "e_i"=e_i, "t_i"=tprime_i, "v_i"=match(v_i,sort(unique(na.omit(v_i))))-1, "PredTF_i"=PredTF_i, "a_gl"=a_gl, "X1_ip"=X1_ip, "X1_gctp"=X1_gctp, "X2_ip"=X2_ip, "X2_gctp"=X2_gctp, "Q1_ik"=Q1_ik, "Q2_ik"=Q2_ik, "Z_gm"=Z_gm, "F_ct"=F_ct, "parent_s"=Network_sz[,'parent_s']-1, "child_s"=Network_sz[,'child_s']-1, "dist_s"=Network_sz[,'dist_s'], "spde"=list(), "spde_aniso"=list(), "spdeMatricesBarrier"=list(), "Barrier_scaling"=NA, "M0"=GridList$M0, "M1"=GridList$M1, "M2"=GridList$M2, "Ais_ij"=cbind(spatial_list$A_is@i,spatial_list$A_is@j), "Ais_x"=spatial_list$A_is@x, "Ags_ij"=cbind(spatial_list$A_gs@i,spatial_list$A_gs@j), "Ags_x"=spatial_list$A_gs@x ) } if(Version%in%c("VAST_v13_0_0","VAST_v12_0_0")){ - Return = list( "n_i"=n_i, "n_s"=c(MeshList$anisotropic_spde$n.spde,n_x,n_x,MeshList$anisotropic_spde$n.spde)[Options_vec['Method']+1], "n_g"=n_g, "n_t"=n_t, "n_c"=n_c, "n_e"=n_e, "n_p1"=ncol(X1_ip), "n_p2"=ncol(X2_ip), "n_v"=n_v, "n_l"=n_l, "n_m"=ncol(Z_gm), "Options_list"=list("Options_vec"=Options_vec,"Options"=Options2use,"yearbounds_zz"=yearbounds_zz,"Expansion_cz"=Expansion_cz,"overlap_zz"=overlap_zz,"zerosum_penalty"=matrix(Options2use['zerosum_penalty'],1,1),"metadata_ctz"=metadata_ctz), "FieldConfig"=FieldConfig_input, "RhoConfig"=RhoConfig, "OverdispersionConfig"=OverdispersionConfig_input, "ObsModel_ez"=ObsModel_ez, "VamConfig"=VamConfig, "X1config_cp"=X1config_cp, "X2config_cp"=X2config_cp, "Q1config_k"=Q1config_k, "Q2config_k"=Q2config_k, "include_data"=TRUE, "b_i"=b_i, "a_i"=a_i, "c_iz"=c_iz, "e_i"=e_i, "t_i"=tprime_i, "v_i"=match(v_i,sort(unique(v_i)))-1, "PredTF_i"=PredTF_i, "a_gl"=a_gl, "X1_ip"=X1_ip, "X1_gctp"=X1_gctp, "X2_ip"=X2_ip, "X2_gctp"=X2_gctp, "Q1_ik"=Q1_ik, "Q2_ik"=Q2_ik, "Z_gm"=Z_gm, "F_ct"=F_ct, "parent_s"=Network_sz[,'parent_s']-1, "child_s"=Network_sz[,'child_s']-1, "dist_s"=Network_sz[,'dist_s'], "spde"=list(), "spde_aniso"=list(), "spdeMatricesBarrier"=list(), "Barrier_scaling"=NA, "M0"=GridList$M0, "M1"=GridList$M1, "M2"=GridList$M2, "Ais_ij"=cbind(spatial_list$A_is@i,spatial_list$A_is@j), "Ais_x"=spatial_list$A_is@x, "Ags_ij"=cbind(spatial_list$A_gs@i,spatial_list$A_gs@j), "Ags_x"=spatial_list$A_gs@x ) + Return = list( "n_i"=n_i, "n_s"=c(MeshList$anisotropic_spde$n.spde,n_x,n_x,MeshList$anisotropic_spde$n.spde)[Options_vec['Method']+1], "n_g"=n_g, "n_t"=n_t, "n_c"=n_c, "n_e"=n_e, "n_p1"=ncol(X1_ip), "n_p2"=ncol(X2_ip), "n_v"=n_v, "n_l"=n_l, "n_m"=ncol(Z_gm), "Options_list"=list("Options_vec"=Options_vec,"Options"=Options2use,"yearbounds_zz"=yearbounds_zz,"Expansion_cz"=Expansion_cz,"overlap_zz"=overlap_zz,"zerosum_penalty"=matrix(Options2use['zerosum_penalty'],1,1),"metadata_ctz"=metadata_ctz), "FieldConfig"=FieldConfig_input, "RhoConfig"=RhoConfig, "OverdispersionConfig"=OverdispersionConfig_input, "ObsModel_ez"=ObsModel_ez, "VamConfig"=VamConfig, "X1config_cp"=X1config_cp, "X2config_cp"=X2config_cp, "Q1config_k"=Q1config_k, "Q2config_k"=Q2config_k, "include_data"=TRUE, "b_i"=b_i, "a_i"=a_i, "c_iz"=c_iz, "e_i"=e_i, "t_i"=tprime_i, "v_i"=match(v_i,sort(unique(na.omit(v_i))))-1, "PredTF_i"=PredTF_i, "a_gl"=a_gl, "X1_ip"=X1_ip, "X1_gctp"=X1_gctp, "X2_ip"=X2_ip, "X2_gctp"=X2_gctp, "Q1_ik"=Q1_ik, "Q2_ik"=Q2_ik, "Z_gm"=Z_gm, "F_ct"=F_ct, "parent_s"=Network_sz[,'parent_s']-1, "child_s"=Network_sz[,'child_s']-1, "dist_s"=Network_sz[,'dist_s'], "spde"=list(), "spde_aniso"=list(), "spdeMatricesBarrier"=list(), "Barrier_scaling"=NA, "M0"=GridList$M0, "M1"=GridList$M1, "M2"=GridList$M2, "Ais_ij"=cbind(spatial_list$A_is@i,spatial_list$A_is@j), "Ais_x"=spatial_list$A_is@x, "Ags_ij"=cbind(spatial_list$A_gs@i,spatial_list$A_gs@j), "Ags_x"=spatial_list$A_gs@x ) } - if(Version%in%c("VAST_v13_1_0")){ - Return = list( "n_i"=n_i, "n_s"=c(MeshList$anisotropic_spde$n.spde,n_x,n_x,MeshList$anisotropic_spde$n.spde)[Options_vec['Method']+1], "n_g"=n_g, "n_t"=n_t, "n_c"=n_c, "n_e"=n_e, "n_p1"=ncol(X1_ip), "n_p2"=ncol(X2_ip), "n_v"=n_v, "n_l"=n_l, "n_m"=ncol(Z_gm), "Options_list"=list("Options_vec"=Options_vec,"Options"=Options2use,"yearbounds_zz"=yearbounds_zz,"Expansion_cz"=Expansion_cz,"overlap_zz"=overlap_zz,"zerosum_penalty"=matrix(Options2use['zerosum_penalty'],1,1),"trace_sum_penalty"=Options2use['EOF_unity_trace'],"metadata_ctz"=metadata_ctz), "FieldConfig"=FieldConfig_input, "RhoConfig"=RhoConfig, "OverdispersionConfig"=OverdispersionConfig_input, "ObsModel_ez"=ObsModel_ez, "VamConfig"=VamConfig, "X1config_cp"=X1config_cp, "X2config_cp"=X2config_cp, "Q1config_k"=Q1config_k, "Q2config_k"=Q2config_k, "include_data"=TRUE, "b_i"=b_i, "a_i"=a_i, "c_iz"=c_iz, "e_i"=e_i, "t_i"=tprime_i, "v_i"=match(v_i,sort(unique(v_i)))-1, "PredTF_i"=PredTF_i, "a_gl"=a_gl, "X1_ip"=X1_ip, "X1_gctp"=X1_gctp, "X2_ip"=X2_ip, "X2_gctp"=X2_gctp, "Q1_ik"=Q1_ik, "Q2_ik"=Q2_ik, "Z_gm"=Z_gm, "F_ct"=F_ct, "parent_s"=Network_sz[,'parent_s']-1, "child_s"=Network_sz[,'child_s']-1, "dist_s"=Network_sz[,'dist_s'], "spde"=list(), "spde_aniso"=list(), "spdeMatricesBarrier"=list(), "Barrier_scaling"=NA, "M0"=GridList$M0, "M1"=GridList$M1, "M2"=GridList$M2, "Ais_ij"=cbind(spatial_list$A_is@i,spatial_list$A_is@j), "Ais_x"=spatial_list$A_is@x, "Ags_ij"=cbind(spatial_list$A_gs@i,spatial_list$A_gs@j), "Ags_x"=spatial_list$A_gs@x ) + if(Version%in%c("VAST_v14_0_1","VAST_v14_0_0","VAST_v13_1_0")){ + Return = list( "n_i"=n_i, "n_s"=c(MeshList$anisotropic_spde$n.spde,n_x,n_x,MeshList$anisotropic_spde$n.spde)[Options_vec['Method']+1], "n_g"=n_g, "n_t"=n_t, "n_c"=n_c, "n_e"=n_e, "n_p1"=ncol(X1_ip), "n_p2"=ncol(X2_ip), "n_v"=n_v, "n_l"=n_l, "n_m"=ncol(Z_gm), "Options_list"=list("Options_vec"=Options_vec,"Options"=Options2use,"yearbounds_zz"=yearbounds_zz,"Expansion_cz"=Expansion_cz,"overlap_zz"=overlap_zz,"zerosum_penalty"=matrix(Options2use['zerosum_penalty'],1,1),"trace_sum_penalty"=Options2use['EOF_unity_trace'],"metadata_ctz"=metadata_ctz,"simulate_t"=rep(0,n_t)), "FieldConfig"=FieldConfig_input, "RhoConfig"=RhoConfig, "OverdispersionConfig"=OverdispersionConfig_input, "ObsModel_ez"=ObsModel_ez, "VamConfig"=VamConfig, "X1config_cp"=X1config_cp, "X2config_cp"=X2config_cp, "Q1config_k"=Q1config_k, "Q2config_k"=Q2config_k, "include_data"=TRUE, "b_i"=b_i, "a_i"=a_i, "c_iz"=c_iz, "e_i"=e_i, "t_i"=tprime_i, "v_i"=match(v_i,sort(unique(na.omit(v_i))))-1, "PredTF_i"=PredTF_i, "a_gl"=a_gl, "X1_ip"=X1_ip, "X1_gctp"=X1_gctp, "X2_ip"=X2_ip, "X2_gctp"=X2_gctp, "Q1_ik"=Q1_ik, "Q2_ik"=Q2_ik, "Z_gm"=Z_gm, "F_ct"=F_ct, "parent_s"=Network_sz[,'parent_s']-1, "child_s"=Network_sz[,'child_s']-1, "dist_s"=Network_sz[,'dist_s'], "spde"=list(), "spde_aniso"=list(), "spdeMatricesBarrier"=list(), "Barrier_scaling"=NA, "M0"=GridList$M0, "M1"=GridList$M1, "M2"=GridList$M2, "Ais_ij"=cbind(spatial_list$A_is@i,spatial_list$A_is@j), "Ais_x"=spatial_list$A_is@x, "Ags_ij"=cbind(spatial_list$A_gs@i,spatial_list$A_gs@j), "Ags_x"=spatial_list$A_gs@x ) } if( is.null(Return) ) stop("`Version` provided does not match the list of possible values") if( "spde" %in% names(Return) ) Return[['spde']] = MeshList$isotropic_spde$param.inla[c("M0","M1","M2")] @@ -1021,7 +1033,7 @@ function( b_i, # Check for NAs if( CheckForErrors==TRUE ){ - NoNAs = setdiff( names(Return), c("t_iz","t_yz","c_iz","Network_sz","b_i") ) + NoNAs = setdiff( names(Return), c("t_iz","t_yz","c_iz","Network_sz","b_i","v_i") ) if( any(sapply(Return[NoNAs], FUN=function(Array){any(is.na(Array))})==TRUE) ) stop("Please find and eliminate the NA from your inputs") } diff --git a/R/make_map.R b/R/make_map.R index 1b331ec..a19b002 100644 --- a/R/make_map.R +++ b/R/make_map.R @@ -16,8 +16,8 @@ make_map <- function( DataList, TmbParams, - RhoConfig=c("Beta1"=0,"Beta2"=0,"Epsilon1"=0,"Epsilon2"=0), - Npool=0 ){ + RhoConfig = c("Beta1"=0,"Beta2"=0,"Epsilon1"=0,"Epsilon2"=0), + Npool = 0 ){ # Local functions fix_value <- function( fixvalTF ){ @@ -69,8 +69,8 @@ function( DataList, # Fill in X1config_cp / X2config_cp for CPP versions < 10ish if( !all(c("X1config_cp","X2config_cp") %in% names(DataList)) ){ if( "Xconfig_zcp" %in% names(DataList) ){ - DataList$X1config_cp = array( DataList$Xconfig_zcp[1,,], dim=dim(DataList$X1config_zcp)[2:3] ) - DataList$X2config_cp = array( DataList$Xconfig_zcp[2,,], dim=dim(DataList$X1config_zcp)[2:3] ) + DataList$X1config_cp = array( DataList$Xconfig_zcp[1,,], dim=dim(DataList$Xconfig_zcp)[2:3] ) + DataList$X2config_cp = array( DataList$Xconfig_zcp[2,,], dim=dim(DataList$Xconfig_zcp)[2:3] ) }else{ DataList$X1config_cp = DataList$X2config_cp = array( 1, dim=c(DataList$n_c,DataList$n_p) ) } @@ -294,6 +294,9 @@ function( DataList, # Change Epsilons Map[["L_epsilon1_z"]] = factor(pool(EncNum_c= 2 ){ warnings( "This version of VAST has different hyperparameters for each category. Default behavior for CPP version <=5.3.0 was to have the same hyperparameters for the intercepts of all categories." ) diff --git a/R/make_model.R b/R/make_model.R index 03b80df..84e9b21 100644 --- a/R/make_model.R +++ b/R/make_model.R @@ -5,6 +5,8 @@ #' #' @inheritParams make_data #' @inheritParams make_map +#' @inheritParams TMB::MakeADFun +#' @inheritParams TMB::compile #' @param TmbData a tagged list of data inputs generated by \code{Data_Fn} #' @param Method Spatial method used for estimation (determines bounds for logkappa) #' @param ConvergeTol Integer specifying override for TMB convergence criteria (OPTIONAL) @@ -41,20 +43,24 @@ make_model <- function( TmbData, Version, - RhoConfig=c("Beta1"=0,"Beta2"=0,"Epsilon1"=0,"Epsilon2"=0), - Method="Mesh", - Npool=0, - ConvergeTol=1, - Use_REML=FALSE, - loc_x=NULL, - Parameters="generate", - Random="generate", - Map="generate", - DiagnosticDir=NULL, - TmbDir=system.file("executables",package="VAST"), - RunDir=getwd(), - CompileDir=TmbDir, - build_model=TRUE ){ + RhoConfig = c("Beta1" = 0,"Beta2" = 0,"Epsilon1" = 0,"Epsilon2" = 0), + Method = "Mesh", + Npool = 0, + ConvergeTol = 1, + Use_REML = FALSE, + loc_x = NULL, + Parameters = "generate", + Random = "generate", + Map = "generate", + DiagnosticDir = NULL, + TmbDir = system.file("executables",package = "VAST"), + RunDir = getwd(), + CompileDir = TmbDir, + build_model = TRUE, + framework = "TMBad", + intern = FALSE, + inner.control = list(sparse=TRUE, lowrank=TRUE, trace=FALSE), + supernodal = FALSE ){ # Extract Options and Options_vec (depends upon version) if( all(c("Options","Options_vec") %in% names(TmbData)) ){ @@ -89,11 +95,18 @@ function( TmbData, # Parameters # TmbData=TmbData - if( length(Parameters)==1 && Parameters=="generate" ) Parameters = make_parameters( Version=Version, DataList=TmbData, RhoConfig=RhoConfig ) + if( length(Parameters)==1 && Parameters=="generate" ){ + Parameters = make_parameters( Version = Version, + DataList = TmbData, + RhoConfig = RhoConfig ) + } # Which parameters are turned off if( length(Map)==1 && Map=="generate" ){ - Map = make_map( DataList=TmbData, TmbParams=Parameters, RhoConfig=RhoConfig, Npool=Npool ) + Map = make_map( DataList = TmbData, + TmbParams = Parameters, + RhoConfig = RhoConfig, + Npool = Npool ) }else{ warning( "Please carefully check starting values for all parameters to ensure that mapping off parameters will work as expected.") } @@ -129,26 +142,47 @@ function( TmbData, # Compile TMB software #dyn.unload( paste0(RunDir,"/",dynlib(TMB:::getUserDLL())) ) # random=Random, + Version_framework = paste0( Version, "_", framework ) file.copy( from=paste0(TmbDir,"/",Version,".cpp"), - to=paste0(CompileDir,"/",Version,".cpp"), + to=paste0(CompileDir,"/",Version_framework,".cpp"), overwrite=FALSE) origwd = getwd() on.exit(setwd(origwd),add=TRUE) setwd( CompileDir ) # SEE https://github.com/kaskr/adcomp/issues/321 for flags argument - TMB::compile( paste0(Version,".cpp"), flags="-Wno-ignored-attributes -O2 -mfpmath=sse -msse2 -mstackrealign" ) + if( "framework" %in% formalArgs(TMB::compile)){ + TMB::compile( file = paste0(Version_framework,".cpp"), + framework = framework, + flags = "-Wno-ignored-attributes -O2 -mfpmath=sse -msse2 -mstackrealign", + supernodal = supernodal ) + }else{ + TMB::compile( file = paste0(Version_framework,".cpp"), + flags = "-Wno-ignored-attributes -O2 -mfpmath=sse -msse2 -mstackrealign" ) + } # Build object - dyn.load( paste0(CompileDir,"/",TMB::dynlib(Version)) ) # random=Random, - Obj <- TMB::MakeADFun( - data = lapply(TmbData,strip_units), - #data = Data, - parameters = Parameters, - hessian = FALSE, - map = Map, - random = Random, - inner.method = "newton", - DLL = Version) # + dyn.load( paste0(CompileDir,"/",TMB::dynlib(Version_framework)) ) # random=Random, + if( ("framework" %in% formalArgs(TMB::compile)) && !is.null(framework) && (framework=="TMBad") ){ + Obj <- TMB::MakeADFun( + data = lapply(TmbData,strip_units), + parameters = Parameters, + hessian = FALSE, + map = Map, + random = Random, + inner.method = "newton", + DLL = Version_framework, + intern = intern, + inner.control = inner.control ) # + }else{ + Obj <- TMB::MakeADFun( + data = lapply(TmbData,strip_units), + parameters = Parameters, + hessian = FALSE, + map = Map, + random = Random, + inner.method = "newton", + DLL = Version_framework ) # + } Obj$control <- list(parscale=1, REPORT=1, reltol=1e-12, maxit=100) # Add normalization in diff --git a/R/make_parameters.R b/R/make_parameters.R index a853220..95f6c36 100644 --- a/R/make_parameters.R +++ b/R/make_parameters.R @@ -103,13 +103,7 @@ function( Version, # Make Parameters for each version ####################### - if(Version%in%c("VAST_v5_5_0","VAST_v5_4_0")){ - Return = list("ln_H_input"=c(0,0), "Chi_fr"=rarray(dim=c(max(DataList$FieldConfig[2,1],1),DataList$VamConfig[2])), "Psi_fr"=rarray(dim=c(max(DataList$FieldConfig[2,1],1),DataList$VamConfig[2])), "beta1_ct"=NA, "gamma1_j"=rep(0,ncol(DataList$X_xj)), "gamma1_ctp"=array(0,dim=c(DataList$n_c,DataList$n_t,DataList$n_p)), "lambda1_k"=rep(0,ncol(DataList$Q_ik)), "L1_z"=NA, "L_omega1_z"=NA, "L_epsilon1_z"=NA, "logkappa1"=log(0.9), "Beta_mean1_c"=rep(0,DataList$n_c), "logsigmaB1_c"=rep(log(1),DataList$n_c), "Beta_rho1_c"=rep(0,DataList$n_c), "Epsilon_rho1_f"=NA, "log_sigmaratio1_z"=0, "eta1_vf"=NA, "Omegainput1_sf"=NA, "Epsiloninput1_sft"=NA, "beta2_ct"=NA, "gamma2_j"=rep(0,ncol(DataList$X_xj)), "gamma2_ctp"=array(0,dim=c(DataList$n_c,DataList$n_t,DataList$n_p)), "lambda2_k"=rep(0,ncol(DataList$Q_ik)), "L2_z"=NA, "L_omega2_z"=NA, "L_epsilon2_z"=NA, "logkappa2"=log(0.9), "Beta_mean2_c"=rep(0,DataList$n_c), "logsigmaB2_c"=rep(log(1),DataList$n_c), "Beta_rho2_c"=rep(0,DataList$n_c), "Epsilon_rho2_f"=NA, "log_sigmaratio2_z"=0, "logSigmaM"=rep(1,DataList$n_e)%o%c(log(5),log(2),log(1)), "delta_i"=rnorm(n=ifelse(any(DataList$ObsModel_ez[,1]%in%c(11,14)),DataList$n_i,0),sd=0.1), "eta2_vf"=NA, "Omegainput2_sf"=NA, "Epsiloninput2_sft"=NA ) - } - if(Version%in%c("VAST_v6_0_0")){ - Return = list("ln_H_input"=c(0,0), "Chi_fr"=rarray(dim=c(max(DataList$FieldConfig[2,1],1),DataList$VamConfig[2])), "Psi_fr"=rarray(dim=c(max(DataList$FieldConfig[2,1],1),DataList$VamConfig[2])), "beta1_ct"=NA, "gamma1_ctp"=array(0,dim=c(DataList$n_c,DataList$n_t,DataList$n_p)), "lambda1_k"=rep(0,ncol(DataList$Q_ik)), "L1_z"=NA, "L_omega1_z"=NA, "L_epsilon1_z"=NA, "logkappa1"=log(0.9), "Beta_mean1_c"=rep(0,DataList$n_c), "logsigmaB1_c"=rep(log(1),DataList$n_c), "Beta_rho1_c"=rep(0,DataList$n_c), "Epsilon_rho1_f"=NA, "log_sigmaXi1_cp"=array(0,dim=c(DataList$n_c,DataList$n_p)), "log_sigmaratio1_z"=0, "eta1_vf"=NA, "Xiinput1_scp"=array(0,dim=c(DataList$n_s,DataList$n_c,DataList$n_p)), "Omegainput1_sf"=NA, "Epsiloninput1_sft"=NA, "beta2_ct"=NA, "gamma2_ctp"=array(0,dim=c(DataList$n_c,DataList$n_t,DataList$n_p)), "lambda2_k"=rep(0,ncol(DataList$Q_ik)), "L2_z"=NA, "L_omega2_z"=NA, "L_epsilon2_z"=NA, "logkappa2"=log(0.9), "Beta_mean2_c"=rep(0,DataList$n_c), "logsigmaB2_c"=rep(log(1),DataList$n_c), "Beta_rho2_c"=rep(0,DataList$n_c), "Epsilon_rho2_f"=NA, "log_sigmaXi2_cp"=array(0,dim=c(DataList$n_c,DataList$n_p)), "log_sigmaratio2_z"=0, "logSigmaM"=rep(1,DataList$n_e)%o%c(log(5),log(2),log(1)), "delta_i"=rnorm(n=ifelse(any(DataList$ObsModel_ez[,1]%in%c(11,14)),DataList$n_i,0),sd=0.1), "eta2_vf"=NA, "Xiinput2_scp"=rarray(0,dim=c(DataList$n_s,DataList$n_c,DataList$n_p)), "Omegainput2_sf"=NA, "Epsiloninput2_sft"=NA ) - } - if(Version%in%c("VAST_v8_4_0","VAST_v8_3_0","VAST_v8_2_0","VAST_v8_1_0","VAST_v8_0_0","VAST_v7_0_0")){ + if(Version%in%c("VAST_v8_4_0","VAST_v8_3_0","VAST_v8_2_0","VAST_v8_1_0","VAST_v8_0_0")){ Return = list("ln_H_input"=c(0,0), "Chi_fr"=rarray(dim=c(max(DataList$FieldConfig[2,1],1),DataList$VamConfig[2])), "Psi_fr"=rarray(dim=c(max(DataList$FieldConfig[2,1],1),DataList$VamConfig[2])), "beta1_ft"=NA, "gamma1_ctp"=array(0,dim=c(DataList$n_c,DataList$n_t,DataList$n_p)), "lambda1_k"=rep(0,ncol(DataList$Q_ik)), "L1_z"=NA, "L_omega1_z"=NA, "L_epsilon1_z"=NA, "L_beta1_z"=NA, "logkappa1"=log(0.9), "Beta_mean1_c"=rep(0,DataList$n_c), "Beta_rho1_f"=NA, "Epsilon_rho1_f"=NA, "log_sigmaXi1_cp"=array(0,dim=c(DataList$n_c,DataList$n_p)), "log_sigmaratio1_z"=0, "eta1_vf"=NA, "Xiinput1_scp"=array(0,dim=c(DataList$n_s,DataList$n_c,DataList$n_p)), "Omegainput1_sf"=NA, "Epsiloninput1_sft"=NA, "beta2_ft"=NA, "gamma2_ctp"=array(0,dim=c(DataList$n_c,DataList$n_t,DataList$n_p)), "lambda2_k"=rep(0,ncol(DataList$Q_ik)), "L2_z"=NA, "L_omega2_z"=NA, "L_epsilon2_z"=NA, "L_beta2_z"=NA, "logkappa2"=log(0.9), "Beta_mean2_c"=rep(0,DataList$n_c), "Beta_rho2_f"=NA, "Epsilon_rho2_f"=NA, "log_sigmaXi2_cp"=array(0,dim=c(DataList$n_c,DataList$n_p)), "log_sigmaratio2_z"=0, "logSigmaM"=rep(1,DataList$n_e)%o%c(log(5),log(2),log(1)), "delta_i"=rnorm(n=ifelse(any(DataList$ObsModel_ez[,1]%in%c(11,14)),DataList$n_i,0),sd=0.1), "eta2_vf"=NA, "Xiinput2_scp"=rarray(0,dim=c(DataList$n_s,DataList$n_c,DataList$n_p)), "Omegainput2_sf"=NA, "Epsiloninput2_sft"=NA ) } if(Version%in%c("VAST_v8_6_0","VAST_v8_5_0")){ @@ -136,6 +130,9 @@ function( Version, if(Version%in%c("VAST_v13_1_0")){ Return = list("ln_H_input"=c(0,0), "Chi_fr"=rarray(dim=c(max(DataList$FieldConfig[2,1],1),DataList$VamConfig[2])), "Psi_fr"=rarray(dim=c(max(DataList$FieldConfig[2,1],1),DataList$VamConfig[2])), "beta1_ft"=NA, "gamma1_cp"=array(0,dim=c(DataList$n_c,DataList$n_p1),dimnames=dimnames(DataList$X1_gctp)[c(2,4)]), "lambda1_k"=rep(0,ncol(DataList$Q1_ik)), "L_eta1_z"=NA, "L_omega1_z"=NA, "L_epsilon1_z"=NA, "L_beta1_z"=NA, "Ltime_epsilon1_z"=NA, "logkappa1"=log(0.9), "Beta_mean1_c"=rep(0,DataList$n_c), "Beta_mean1_t"=rep(0,DataList$n_t), "Beta_rho1_f"=NA, "Epsilon_rho1_f"=NA, "log_sigmaXi1_cp"=array(0,dim=c(DataList$n_c,DataList$n_p1)), "log_sigmaPhi1_k"=rep(0,ncol(DataList$Q1_ik)), "eta1_vf"=NA, "Xiinput1_scp"=array(0,dim=c(DataList$n_s,DataList$n_c,DataList$n_p1)), "Phiinput1_sk"=array(0,dim=c(DataList$n_s,ncol(DataList$Q1_ik))), "Omegainput1_sf"=NA, "Epsiloninput1_sff"=NA, "beta2_ft"=NA, "gamma2_cp"=array(0,dim=c(DataList$n_c,DataList$n_p2),dimnames=dimnames(DataList$X2_gctp)[c(2,4)]), "lambda2_k"=rep(0,ncol(DataList$Q2_ik)), "L_eta2_z"=NA, "L_omega2_z"=NA, "L_epsilon2_z"=NA, "L_beta2_z"=NA, "Ltime_epsilon2_z"=NA, "logkappa2"=log(0.9), "Beta_mean2_c"=rep(0,DataList$n_c), "Beta_mean2_t"=rep(0,DataList$n_t), "Beta_rho2_f"=NA, "Epsilon_rho2_f"=NA, "log_sigmaXi2_cp"=array(0,dim=c(DataList$n_c,DataList$n_p2)), "log_sigmaPhi2_k"=rep(0,ncol(DataList$Q2_ik)), "logSigmaM"=rep(1,DataList$n_e)%o%c(log(5),log(2),log(1)), "lagrange_tc"=rarray(0,dim=c(DataList$n_t,DataList$n_c)), "delta_i"=rnorm(n=ifelse(any(DataList$ObsModel_ez[,1]%in%c(11,14)),DataList$n_i,0),sd=0.1), "eta2_vf"=NA, "Xiinput2_scp"=rarray(0,dim=c(DataList$n_s,DataList$n_c,DataList$n_p2)), "Phiinput2_sk"=array(0,dim=c(DataList$n_s,ncol(DataList$Q2_ik))), "Omegainput2_sf"=NA, "Epsiloninput2_sff"=NA ) } + if(Version%in%c("VAST_v14_0_1","VAST_v14_0_0")){ + Return = list("ln_H_input"=c(0,0), "Chi_fr"=rarray(dim=c(max(DataList$FieldConfig[2,1],1),DataList$VamConfig[2])), "Psi_fr"=rarray(dim=c(max(DataList$FieldConfig[2,1],1),DataList$VamConfig[2])), "beta1_ft"=NA, "gamma1_cp"=array(0,dim=c(DataList$n_c,DataList$n_p1),dimnames=dimnames(DataList$X1_gctp)[c(2,4)]), "lambda1_k"=rep(0,ncol(DataList$Q1_ik)), "L_eta1_z"=NA, "L_omega1_z"=NA, "L_epsilon1_z"=NA, "L_beta1_z"=NA, "Ltime_epsilon1_z"=NA, "logkappa1"=log(0.9), "Beta_mean1_c"=rep(0,DataList$n_c), "Beta_mean1_t"=rep(0,DataList$n_t), "Beta_rho1_f"=NA, "Epsilon_rho1_f"=NA, "log_sigmaXi1_cp"=array(0,dim=c(DataList$n_c,DataList$n_p1)), "log_sigmaPhi1_k"=rep(0,ncol(DataList$Q1_ik)), "eta1_vf"=NA, "Xiinput1_scp"=array(0,dim=c(DataList$n_s,DataList$n_c,DataList$n_p1)), "Phiinput1_sk"=array(0,dim=c(DataList$n_s,ncol(DataList$Q1_ik))), "Omegainput1_sf"=NA, "Epsiloninput1_sff"=NA, "beta2_ft"=NA, "gamma2_cp"=array(0,dim=c(DataList$n_c,DataList$n_p2),dimnames=dimnames(DataList$X2_gctp)[c(2,4)]), "lambda2_k"=rep(0,ncol(DataList$Q2_ik)), "L_eta2_z"=NA, "L_omega2_z"=NA, "L_epsilon2_z"=NA, "L_beta2_z"=NA, "Ltime_epsilon2_z"=NA, "logkappa2"=log(0.9), "Beta_mean2_c"=rep(0,DataList$n_c), "Beta_mean2_t"=rep(0,DataList$n_t), "Beta_rho2_f"=NA, "Epsilon_rho2_f"=NA, "log_sigmaXi2_cp"=array(0,dim=c(DataList$n_c,DataList$n_p2)), "log_sigmaPhi2_k"=rep(0,ncol(DataList$Q2_ik)), "logSigmaM"=rep(1,DataList$n_e)%o%c(log(5),log(2),log(1)), "lagrange_tc"=rarray(0,dim=c(DataList$n_t,DataList$n_c)), "delta_i"=rnorm(n=ifelse(any(DataList$ObsModel_ez[,1]%in%c(11,14)),DataList$n_i,0),sd=0.1), "eta2_vf"=NA, "Xiinput2_scp"=rarray(0,dim=c(DataList$n_s,DataList$n_c,DataList$n_p2)), "Phiinput2_sk"=array(0,dim=c(DataList$n_s,ncol(DataList$Q2_ik))), "Omegainput2_sf"=NA, "Epsiloninput2_sff"=NA, "eps_Index_ctl"=array(0,dim=c(0,0,0)) ) + } ####################### # Fill in values that are shared across versions diff --git a/R/project_model.R b/R/project_model.R new file mode 100644 index 0000000..feaa5df --- /dev/null +++ b/R/project_model.R @@ -0,0 +1,247 @@ +#' Project a fitted VAST model forward in time +#' +#' \code{project_model} simulates random effects forward in time, for use to +#' generate a predictive interval without actually re-fitting the model. +#' This is useful e.g., to generate end-of-century projections. +#' +#' The function specifically simulates new values for random effects occurring +#' during forecasted years. This includes some combination of intercepts +#' {beta1/beta2} and spatio-temporal terms {epsilon1/epsilon2} depending on which +#' are treated as random during estimation. It does *not* generate new values of +#' covariates or random-effects that are not indexed by time {omega1/omega2} +#' +#' Note that the model may behave poorly when \code{historical_uncertainty="both"} +#' and the estimation model includes an AR1 process for any component. +#' Given this combination of features, some samples may have a `rho` value >1 +#' or <1, which will result in exponential growth for any such sampled value. +#' This behavior could be improved in future code updates by using \code{tmbstan} +#' instead of the normal approximation to generate parametric uncertainty +#' during the historical period. +#' +#' Similarly, estimating a RW process for epsilon will result in an exponential increase +#' in forecasted total abundance over time. This occurs because the variance across locations +#' of epsilon increases progressively during the forecast period, such that +#' the index is again dominated by the forecasted density at a few sites. +#' +#' +#' @param x Output from \code{\link{fit_model}} +#' @param n_proj Number of time-steps to include in projection +#' @param n_samples Number of samples to include. If \code{n_samples=1} then \code{project_model} +#' just returns the list of REPORTed variables. If \code{n_samples>1} then \code{project_model} +#' returns a list of lists, where each element is the list of REPORTed variables. +#' @param new_covariate_data New covariates to include for future intervals +#' @param historical_uncertainty Whether to incorporate uncertainty about fitted interval +#' \describe{ +#' \item{\code{historical_uncertainty="both"}}{Include uncertainty in fixed and random effects using joint precision matrix} +#' \item{\code{historical_uncertainty="random"}}{Include uncertainty in random effects using inner Hessian matrix} +#' \item{\code{historical_uncertainty="none"}}{Condition upon MLE for fixed and Empirical Bayes for random effects} +#' } +#' +#' @return All \code{obj$report()} output for a single simulation of historical period +#' as well as \code{n_proj} forecast intervals +#' +#' @examples +#' \dontrun{ +#' # Run model +#' fit = fit_model( ... ) +#' +#' # Add projection +#' project_model( x = fit, +#' n_proj = 80, +#' new_covariate_data = NULL, +#' historical_uncertainty = "both", +#' seed = NULL ) +#' } +#' +#' @export +project_model <- +function( x, + n_proj, + n_samples = 1, + new_covariate_data = NULL, + historical_uncertainty = "both", + seed = 123456, + working_dir = paste0(getwd(),"/"), + what = NULL ){ + + # Unpack + Obj = x$tmb_list$Obj + Sdreport = x$parameter_estimates$SD + + # Warnings + # REVISE: remove historical years from new_covariate_data to avoid new data changing fit in earlier years + if( is.null(new_covariate_data) ){ + new_covariate_data = x$covariate_data + }else{ + # Confirm all columns are available + if( !all(colnames(x$covariate_data) %in% colnames(new_covariate_data)) ){ + stop("Please ensure that all columns of `x$covariate_data` are present in `new_covariate_data`") + } + # Eliminate unnecessary columns + new_covariate_data = new_covariate_data[,match(colnames(x$covariate_data),colnames(new_covariate_data))] + # Eliminate old-covariates that are also present in new_covariate_data + NN = RANN::nn2( query=x$covariate_data[,c('Lat','Lon','Year')], data=new_covariate_data[,c('Lat','Lon','Year')], k=1 ) + if( any(NN$nn.dist==0) ){ + x$covariate_data = x$covariate_data[-which(NN$nn.dist==0),,drop=FALSE] + } + } + + ############## + # Step 1: Generate uncertainty in historical period + ############## + + # Sample from GMRF using sparse precision + rmvnorm_prec <- function(mu, prec, n.sims, seed) { + set.seed(seed) + z <- matrix(rnorm(length(mu) * n.sims), ncol=n.sims) + L <- Matrix::Cholesky(prec, super=TRUE) + z <- Matrix::solve(L, z, system = "Lt") ## z = Lt^-1 %*% z + z <- Matrix::solve(L, z, system = "Pt") ## z = Pt %*% z + z <- as.matrix(z) + return(mu + z) + } + + # Sample from joint distribution + if( historical_uncertainty == "both" ){ + u_zr = rmvnorm_prec( mu=Obj$env$last.par.best, prec=Sdreport$jointPrecision, n.sims=n_samples, seed=seed) + }else if( historical_uncertainty == "random" ){ + # Retape and call once to get last.par.best to work + Obj$retape() + Obj$fn(x$parameter_estimates$par) + u_zr = Obj$env$last.par.best %o% rep(1, n_samples) + # Simulate random effects + set.seed(seed) + MC = Obj$env$MC( keep=TRUE, n=n_samples, antithetic=FALSE ) + u_zr[Obj$env$random,] = attr(MC, "samples") + #Hess = Obj$env$spHess(par=u_z, random=TRUE) + #u_z[-Obj$env$lfixed()] = rmvnorm_prec( mu=u_z[-Obj$env$lfixed()], prec=Hess, n.sims=1, seed=seed)[,1] + }else if( historical_uncertainty == "none" ){ + u_zr = Obj$env$last.par.best %o% rep(1, n_samples) + }else{ + stop("Check `historical_uncertainty` argument") + } + + ############## + # Step 2: Generate uncertainty in historical period + ############## + + t_i = c( x$data_frame$t_i, max(x$data_frame$t_i)+rep(1:n_proj,each=2) ) + b_i = c( x$data_list$b_i, as_units(rep(c(0,mean(x$data_frame$b_i)),n_proj), units(x$data_list$b_i)) ) + v_i = c( x$data_frame$v_i, rep(0,2*n_proj) ) + Lon_i = c( x$data_frame$Lon_i, rep(mean(x$data_frame$Lon_i),2*n_proj) ) + Lat_i = c( x$data_frame$Lat_i, rep(mean(x$data_frame$Lat_i),2*n_proj) ) + a_i = c( x$data_list$a_i, as_units(rep(mean(x$data_frame$a_i),2*n_proj), units(x$data_list$a_i)) ) + PredTF_i = c( x$data_list$PredTF_i, rep(1,2*n_proj) ) + c_iz = rbind( x$data_list$c_iz, x$data_list$c_iz[rep(1:n_proj,each=2),,drop=FALSE] ) + new_catchability_data = rbind( x$catchability_data, x$catchability_data[rep(1:n_proj,each=2),,drop=FALSE] ) + + ############## + # Step 3: Build object with padded bounds + ############## + + x1 = fit_model( settings = x$settings, + Lat_i = Lat_i, + Lon_i = Lon_i, + t_i = t_i, + b_i = b_i, + a_i = a_i, + v_i = v_i, + c_iz = c_iz, + PredTF_i = PredTF_i, + covariate_data = new_covariate_data, + X1_formula = x$X1_formula, + X2_formula = x$X2_formula, + X1config_cp = x$X1config_cp, + X2config_cp = x$X2config_cp, + catchability_data = new_catchability_data, + Q1config_k = x$Q1config_k, + Q2config_k = x$Q2config_k, + Q1_formula = x$Q1_formula, + Q2_formula = x$Q2_formula, + build_model = FALSE, + working_dir = working_dir ) + + # Object to keep output + out = vector("list", length=n_samples) + + # Loop through 1:n_samples + for( sampleI in seq_len(n_samples) ){ + ############## + # Step 4: Merge ParList and ParList1 + ############## + + # Get full size + #ParList1 = x1$tmb_list$Obj$env$parList() + ParList1 = x1$tmb_list$Parameters + + # Get ParList + ParList = Obj$env$parList( par = u_zr[,sampleI] ) + + for( i in seq_along(ParList) ){ + dim = function(x) if(is.vector(x)){return(length(x))}else{return(base::dim(x))} + dim_match = ( dim(ParList[[i]]) == dim(ParList1[[i]]) ) + if( sum(dim_match==FALSE)==0 ){ + ParList1[[i]] = ParList[[i]] + }else if( sum(dim_match==FALSE)==1 ){ + dim_list = lapply( dim(ParList[[i]]), FUN=function(x){seq_len(x)} ) + ParList1[[i]][as.matrix(expand.grid(dim_list))] = ParList[[i]][as.matrix(expand.grid(dim_list))] + }else if( sum(dim_match==FALSE)>=2 ){ + stop("Check matching") + } + } + + ############## + # Step 5: Re-build model + ############## + + x2 = fit_model( settings = x$settings, + Lat_i = Lat_i, + Lon_i = Lon_i, + t_i = t_i, + b_i = b_i, + a_i = a_i, + v_i = v_i, + c_iz = c_iz, + PredTF_i = PredTF_i, + covariate_data = new_covariate_data, + X1_formula = x$X1_formula, + X2_formula = x$X2_formula, + X1config_cp = x$X1config_cp, + X2config_cp = x$X2config_cp, + catchability_data = new_catchability_data, + Q1config_k = x$Q1config_k, + Q2config_k = x$Q2config_k, + Q1_formula = x$Q1_formula, + Q2_formula = x$Q2_formula, + run_model = FALSE, + Parameters = ParList1, + working_dir = working_dir ) + + ############## + # Step 5: Simulate random effects + ############## + + # Simulate Epsiloninput / Betainput for projection years + x2$tmb_list$Obj$env$data$Options_list$simulate_t[] = c( rep(0,x$data_list$n_t), rep(1,n_proj) ) + + # Simulate type=1 so Omegas and other random effects are held fixed + out[[sampleI]] = simulate_data( fit = x2, + type = 1, + random_seed = NULL ) + + # Amend labels + x2$Report = out[[sampleI]] + out[[sampleI]] = amend_output(x2) + + # Subset to values specified in "what" + if( !is.null(what) ){ + out[[sampleI]] = out[[sampleI]][which(names(out[[sampleI]]) %in% what)] + } + } + + if( n_samples==1 ){ + out = out[[1]] + } + return(out) +} + diff --git a/R/reload_model.R b/R/reload_model.R new file mode 100644 index 0000000..f0ea80f --- /dev/null +++ b/R/reload_model.R @@ -0,0 +1,63 @@ +#' Reload a VAST model +#' +#' \code{reload_model} allows a user to save a fitted model, reload it in a new +#' R terminal, and then relink the DLLs so that it functions as expected. +#' +#' @inheritParams make_model +#' @param x Output from \code{\link{fit_model}}, potentially with DLLs not linked +#' @param check_gradient Whether to check the gradients of the reloaded model +#' +#' @return Output from \code{\link{fit_model}} with DLLs relinked +#' +#' @examples +#' \dontrun{ +#' # Run model +#' fit = fit_model( ... ) +#' saveRDS( object=fit, file="path_and_name.rds" ) +#' +#' # Reload and relink +#' fit_new = readRDS( file="path_and_name.rds" ) +#' fit_new = reload_model( x = fit_new ) +#' } +#' +#' @export +reload_model <- +function( x, + check_gradient = TRUE, + CompileDir = system.file("executables",package = "VAST"), + Version = x$settings$Version, + framework = x$input_args$model_args_input$framework, + Obj = x$tmb_list$Obj ){ + + # Load old one + if( is.null(framework) ){ + Version_framework = Version + }else{ + Version_framework = paste0( Version, "_", framework ) + } + origwd = getwd() + on.exit( setwd(origwd), add=TRUE ) + setwd(CompileDir) + dyn.load( TMB::dynlib(Version_framework) ) # random=Random, + + # Retape + Obj$retape() + + # Ensure that last.par and last.par.best are right + Obj$fn(x$parameter_estimates$par) + + # Check gradient + if( check_gradient==TRUE ){ + Gr = Obj$gr(x$parameter_estimates$par) + if(max(abs(Gr))>1){ + warning("Maximum absolute gradient of ", signif(max(abs(Gr)),3), ": does not seem converged") + }else if(max(abs(Gr))>0.01){ + warning("Maximum absolute gradient of ", signif(max(abs(Gr)),3), ": might not be converged") + }else{ + message("Maximum absolute gradient of ", signif(max(abs(Gr)),3), ": No evidence of non-convergence") + } + } + + return(x) +} + diff --git a/R/zzz.R b/R/zzz.R index a69cf2b..b67a948 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -7,34 +7,30 @@ packageStartupMessage("Loading package VAST version ", packageVersion("VAST") ) packageStartupMessage("For information and examples, please see http://github.com/james-thorson/VAST/") packageStartupMessage("###########################################################################################") - if( getOption("repos")["CRAN"] == "@CRAN@" ){ - options(repos = c("CRAN" = "http://cran.us.r-project.org")) - } - - if( !"INLA" %in% utils::installed.packages()[,1] ){ - packageStartupMessage("Installing package: INLA...") - #utils::install.packages("INLA", repos="https://www.math.ntnu.no/inla/R/stable") - - # Over-ride default install for R 3.5.0 through R 3.5.3 - Rvers = numeric_version(paste0(R.version[6:7],collapse=".")) - if( Rversnumeric_version("3.5.0") ){ - utils::install.packages( "https://inla.r-inla-download.org/R/stable/bin/windows/contrib/3.5/INLA_18.07.12.zip" ) - }else{ - utils::install.packages("INLA", repos=c(getOption("repos"), INLA="https://inla.r-inla-download.org/R/stable"), dep=NA) - } - } - - # Load `FishStatsUtils` via .onAttach because importFrom wasn't working - # Also requries moving FishStatsUtils to SUGGESTS, so that it - # doesn't isntall main branch - - if( !"FishStatsUtils" %in% utils::installed.packages()[,1] || utils::packageVersion("FishStatsUtils") < numeric_version("2.11.0") ){ - packageStartupMessage("Updating package FishStatsUtils because previously using version < 2.11.0") - devtools::install_github("james-thorson/FishStatsUtils", ref="2.11.0") - ## devtools::install_github("james-thorson/FishStatsUtils", ref='development', INSTALL_opts="--no-staged-install") - } - packageStartupMessage( "Loading package `FishStatsUtils` version ", packageVersion("FishStatsUtils") ) - library(FishStatsUtils) + #if( getOption("repos")["CRAN"] == "@CRAN@" ){ + # options(repos = c("CRAN" = "http://cran.us.r-project.org")) + #} + # + # URL for ZIP files to download and install locally: https://inla.r-inla-download.org/R/stable/src/contrib/ + #if( !"INLA" %in% utils::installed.packages()[,1] ){ + # packageStartupMessage("Installing package: INLA...") + # + # # Over-ride default install for R 3.5.0 through R 3.5.3 + # Rvers = numeric_version(paste0(R.version[6:7],collapse=".")) + # if( Rversnumeric_version("3.5.0") ){ + # utils::install.packages( "https://inla.r-inla-download.org/R/stable/bin/windows/contrib/3.5/INLA_18.07.12.zip" ) + # }else{ + # utils::install.packages("INLA", repos=c(getOption("repos"), INLA="https://inla.r-inla-download.org/R/stable"), dep=TRUE) + # } + #} + # + ## Load `FishStatsUtils` via .onAttach because Remotes doessn't enforce branch properly + #if( !"FishStatsUtils" %in% utils::installed.packages()[,1] || utils::packageVersion("FishStatsUtils") < numeric_version("2.11.0") ){ + # packageStartupMessage("Updating package FishStatsUtils because previously using version < 2.11.0") + # remotes::install_github("james-thorson-NOAA/FishStatsUtils", ref="dev") + #} + #packageStartupMessage( "Loading package `FishStatsUtils` version ", packageVersion("FishStatsUtils") ) + #library(FishStatsUtils) } #' Copy of VAST::make_model diff --git a/inst/executables/VAST_v13_1_0.cpp b/inst/executables/VAST_v13_1_0.cpp index aa9d711..345db93 100644 --- a/inst/executables/VAST_v13_1_0.cpp +++ b/inst/executables/VAST_v13_1_0.cpp @@ -190,12 +190,22 @@ Type rgengamma(Type mean, Type sigma, Type lambda){ // Adapted from tweedie::rtweedie function in R template Type rTweedie( Type mu, Type phi, Type power){ - Type lambda = pow(mu, Type(2.0) - power) / (phi * (Type(2.0) - power)); - Type alpha = (Type(2.0) - power) / (Type(1.0) - power); - Type gam = phi * (power - Type(1.0)) * pow(mu, power - Type(1.0)); - Type N = rpois(lambda); - Type B = rgamma(-N * alpha, gam); /// Using Shape-Scale parameterization - return B; + Type lambda = pow(mu, Type(2.0) - power) / (phi * (Type(2.0) - power)); + Type alpha = (Type(2.0) - power) / (Type(1.0) - power); + Type gam = phi * (power - Type(1.0)) * pow(mu, power - Type(1.0)); + Type N = rpois(lambda); + Type B = rgamma(-N * alpha, gam); /// Using Shape-Scale parameterization + return B; +} + +// Deviance for the Tweedie +// https://en.wikipedia.org/wiki/Tweedie_distribution#Properties +template +Type deviance_tweedie( Type y, Type mu, Type p ){ + Type c1 = pow( y, 2.0-p ) / (1.0-p) / (2.0-p); + Type c2 = y * pow( mu, 1.0-p ) / (1.0-p); + Type c3 = pow( mu, 2.0-p ) / (2.0-p); + return 2 * (c1 - c2 + c3 ); } // Generate loadings matrix for covariance @@ -1485,7 +1495,7 @@ Type objective_function::operator() () for( t=0; t::operator() () for( t=0; t::operator() () // dtweedie( Type y, Type mu, Type phi, Type p, int give_log=0 ) // R1*R2 = mean LogProb2_i(i) = dtweedie( b_i(i), R1_i(i)*R2_i(i), R1_i(i), invlogit(logSigmaM(e_i(i),0))+Type(1.0), true ); - deviance2_i(i) = NAN; + deviance2_i(i) = deviance_tweedie( b_i(i), R1_i(i)*R2_i(i), invlogit(logSigmaM(e_i(i),0))+Type(1.0) ); // Simulate new values when using obj.simulate() SIMULATE{ b_i(i) = rTweedie( R1_i(i)*R2_i(i), R1_i(i), invlogit(logSigmaM(e_i(i),0))+Type(1.0) ); // Defined above @@ -2074,7 +2084,6 @@ Type objective_function::operator() () Index_ctl.setZero(); for(t=0; t +#include + +// Function to implement barrier-SPDE code +// Reused with permission from Olav Nikolai Breivik and Hans Skaug +template +struct spde_barrier_t{ + vector C0; + vector C1; + Eigen::SparseMatrix D0; + Eigen::SparseMatrix D1; + Eigen::SparseMatrix I; + spde_barrier_t(SEXP x){ /* x = List passed from R */ + C0 = asVector(getListElement(x,"C0")); + C1 = asVector(getListElement(x,"C1")); + D0 = tmbutils::asSparseMatrix(getListElement(x,"D0")); + D1 = tmbutils::asSparseMatrix(getListElement(x,"D1")); + I = tmbutils::asSparseMatrix(getListElement(x,"I")); + } +}; + +// Function to calculate Q (precision) matrix using barrier-SPDE +// Reused with permission from Olav Nikolai Breivik and Hans Skaug +template +Eigen::SparseMatrix Q_spde(spde_barrier_t spde, Type kappa, vector c){ + //using namespace Eigen; + vector range(2); + range(0) = sqrt(8.0)/kappa*c(0); + range(1) = range(0)*c(1); + + int dimLatent = spde.D0.row(0).size(); + vector Cdiag(dimLatent); + Eigen::SparseMatrix Cinv(dimLatent,dimLatent); + + Cdiag = spde.C0*pow(range(0),2) + spde.C1*pow(range(1),2); + for(int i =0; iA = spde.I; + A = A + (pow(range(0),2.0)/8.0) * spde.D0 + (pow(range(1),2.0)/8.0) * spde.D1; + + Eigen::SparseMatrix Q = A.transpose() * Cinv * A/M_PI *2 * 3; + + return Q; +} + +// Function to import R list for user-defined Options_vec and Options, packaged as list Options_list in TmbData +template +struct options_list { + vector Options_vec; + vector Options; + matrix yearbounds_zz; + matrix Expansion_cz; + matrix overlap_zz; + matrix zerosum_penalty; + vector trace_sum_penalty; + vector simulate_t; + options_list(SEXP x){ // Constructor + Options_vec = asVector(getListElement(x,"Options_vec")); + Options = asVector(getListElement(x,"Options")); + yearbounds_zz = asMatrix(getListElement(x,"yearbounds_zz")); + Expansion_cz = asMatrix(getListElement(x,"Expansion_cz")); + overlap_zz = asMatrix(getListElement(x,"overlap_zz")); + zerosum_penalty = asMatrix(getListElement(x,"zerosum_penalty")); + trace_sum_penalty = asVector(getListElement(x,"trace_sum_penalty")); + simulate_t = asVector(getListElement(x,"simulate_t")); + } +}; + +// Needed for returning SparseMatrix for Ornstein-Uhlenbeck network correlations +template +Eigen::SparseMatrix Q_network( Type log_theta, int n_s, vector parent_s, vector child_s, vector dist_s ){ + Eigen::SparseMatrix Q( n_s, n_s ); + Type theta = exp( log_theta ); + for(int s=0; s +bool isNA(Type x){ + return R_IsNA(asDouble(x)); +} + +// Posfun +template +Type posfun(Type x, Type lowerlimit, Type &pen){ + // Version 1: https://github.com/kaskr/adcomp/issues/7#issuecomment-67519437 + pen += CppAD::CondExpLt(x, lowerlimit, Type(0.01)*pow(x-lowerlimit,2.0), Type(0.0) ); + return CppAD::CondExpGe(x, lowerlimit, x, lowerlimit/(Type(2.0)-x/lowerlimit) ); + + // Version 2: https://github.com/kaskr/adcomp/issues/7#issuecomment-644839660 + //pen += CppAD::CondExpLt(x, lowerlimit, Type(0.01)*pow(lowerlimit-eps,2), Type(0)); + //return CppAD::CondExpGe(x, lowerlimit, x, eps*logspace_add(lowerlimit/eps, Type(0))); +} + +// mean +template +Type mean( vector vec ){ + return vec.sum() / vec.size(); +} + +// Variance +template +Type var( array vec ){ + Type vec_mod = vec - mean(vec); + Type res = pow(vec_mod, 2.0).sum() / vec.size(); + return res; +} + +// square +template +Type square(Type x){ + return pow(x,2); +} + +// sqrt +template +Type sqrt(Type x){ + return pow(x,0.5); +} + +// dlnorm +template +Type dlnorm(Type x, Type meanlog, Type sdlog, int give_log=0){ + //return 1/(sqrt(2*M_PI)*sd) * exp(-.5*pow((x-mean)/sd,2)); + Type logres = dnorm( log(x), meanlog, sdlog, true) - log(x); + if(give_log) return logres; else return exp(logres); +} + +// dinverse_gaussian +template +Type dinverse_gaussian(Type x, Type mean, Type cv, int give_log=0){ + //return sqrt(lambda/(2*M_PI*pow(x,3))) * exp( -1.0 * lambda*pow(x-mean,2) / (2*pow(mean,2)*x) ); + Type sd = cv * mean; + Type lambda = pow(mean,3.0) / pow(sd,2.0); + Type logres = 0.5*(log(lambda) - 3.0*log(x) - log(2.0*M_PI)) - ( lambda*pow(x-mean,2.0) / (2.0*pow(mean,2.0)*x) ); + if(give_log) return logres; else return exp(logres); +} + +// dgengamma +// using Prentice-1974 parameterization for lambda instead of k, so that lognormal occurs as lambda -> 0 +// using mean parameterization to back out theta +// CV is a function of sigma and lambda and NOT mean (i.e., CV is fixed for all values of mean) +// See: C:\Users\James.Thorson\Desktop\Work files\AFSC\2021-10 -- Generalized gamma-lognormal\Explore gengamma.R +template +Type dgengamma(Type x, Type mean, Type sigma, Type lambda, int give_log=0){ + Type k = pow( lambda, -2 ); + Type Shape = pow( sigma, -1 ) * lambda; + // Numerically unstable + // Type Scale = mean / exp(lgamma( (k*Shape+1)/Shape )) * exp(lgamma( k )); + // Type logres = log(Shape) - lgamma(k) + (Shape * k - 1) * log(x) - Shape * k * log(Scale) - pow( x/Scale, Shape ); + // Numerically stable + Type log_Scale = log(mean) - lgamma( (k*Shape+1)/Shape ) + lgamma( k ); + Type mu = log_Scale + log(k) / Shape; + // Type Sigma = 1 / sqrt(k) / Shape; abs(Sigma) := sigma + // Type Q = sqrt( 1/k ); Q := lambda + Type y = log(x); + Type w = (y - mu) / sigma; + Type q_square = square(lambda); // = abs(Q); + Type qi = 1/square(lambda); + Type qw = lambda * w; + Type logres = -log(sigma*x) + 0.5*log(q_square) * (1 - 2 * qi) + qi * (qw - exp(qw)) - lgamma(qi); + // return stuff + if(give_log) return logres; else return exp(logres); +} +// rgengamma +template +Type rgengamma(Type mean, Type sigma, Type lambda){ + // See: C:\Users\James.Thorson\Desktop\Work files\AFSC\2021-10 -- Generalized gamma-lognormal\Explore gengamma.R + Type k = pow( lambda, -2 ); + Type Shape = pow( sigma, -1 ) * lambda; + Type Scale = mean / exp(lgamma( (k*Shape+1)/Shape )) * exp(lgamma( k )); + Type w = log(rgamma(k, Type(1.0))); + Type y = w/Shape + log(Scale); + return exp(y); +} + +// Simulate from tweedie +// Adapted from tweedie::rtweedie function in R +template +Type rTweedie( Type mu, Type phi, Type power){ + Type lambda = pow(mu, Type(2.0) - power) / (phi * (Type(2.0) - power)); + Type alpha = (Type(2.0) - power) / (Type(1.0) - power); + Type gam = phi * (power - Type(1.0)) * pow(mu, power - Type(1.0)); + Type N = rpois(lambda); + Type B = rgamma(-N * alpha, gam); /// Using Shape-Scale parameterization + return B; +} + +// Deviance for the Tweedie +// https://en.wikipedia.org/wiki/Tweedie_distribution#Properties +template +Type deviance_tweedie( Type y, Type mu, Type p ){ + Type c1 = pow( y, 2.0-p ) / (1.0-p) / (2.0-p); + Type c2 = y * pow( mu, 1.0-p ) / (1.0-p); + Type c3 = pow( mu, 2.0-p ) / (2.0-p); + return 2 * (c1 - c2 + c3 ); +} + +// Generate loadings matrix for covariance +// zerosum_penalty -- used for EOF indices when also estimating Omega (such that EOF is zero-centered index) +// trace_sum_penalty -- used for sum of squared elements, +template +matrix create_loadings_covariance( vector L_val, int n_rows, int n_cols, Type zerosum_penalty, Type trace_sum_penalty, Type &jnll_pointer ){ + matrix L_rc(n_rows, n_cols); + int Count = 0; + for(int r=0; r=c){ + L_rc(r,c) = L_val(Count); + Count++; + }else{ + L_rc(r,c) = 0.0; + } + }} + // Zero-sum constraint + if( zerosum_penalty > 0 ){ + vector colsum( n_cols ); + colsum.setZero(); + for(int c=0; c 0 ){ + Type Cov_trace = 0; + for(int c=0; c +matrix create_loadings_correlation( vector L_val, int n_rows, int n_cols ){ + matrix L_rc(n_rows, n_cols); + matrix Z_rc(n_rows, n_cols); + int Count = 0; + Type sum_squares; + for(int r=0; rc){ + Z_rc(r,c) = 2.0*invlogit(L_val(Count)) - 1.0; // tanh(L_val(Count)); // + Count++; + } + if(r +matrix create_loadings_AR1( Type rhoinput, Type ln_margsd, int n_rows ){ + Type rho = 2.0*invlogit(rhoinput) - 1; + Type margsd = exp( ln_margsd ); + matrix L_rc(n_rows, n_rows); + L_rc.setZero(); + for( int c=0; c= 1 ){ + L_rc(r,c) = L_rc(r,c) * sqrt(1 - square(rho)); + } + }} + return L_rc; +} + +// Create loadings matrix for general case, +template +matrix create_loadings_general( vector L_val, int n_rows, int n_f, Type zerosum_penalty, Type trace_sum_penalty, Type &jnll_pointer ){ + if( n_f == -2 ){ + // IID + matrix L_rc(n_rows, n_rows); + L_rc.setZero(); + for( int r=0; r L_rc(n_rows, 1); + matrix L_rc(n_rows, 0); + L_rc.setZero(); + return L_rc; + }else if( n_f == -3 ){ + // Identity matrix + matrix L_rc(n_rows, n_rows); + L_rc.setIdentity(); + return L_rc; + }else if( n_f == 0 ){ + // AR1 + matrix L_rc = create_loadings_AR1( L_val(0), L_val(1), n_rows ); + return L_rc; + }else{ + // Factor + //if(use_covariance==false){ + // matrix L_rc = create_loadings_correlation( L_val, n_rows, n_f ); + // return L_rc; + //}else{ + matrix L_rc = create_loadings_covariance( L_val, n_rows, n_f, zerosum_penalty, trace_sum_penalty, jnll_pointer ); + return L_rc; + //} + } +} + +// IN: eta1_vf; L1_z +// OUT: jnll_comp; eta1_vc +// eta_jf could be either eta_vf (for overdispersion) or eta_tf (for year effects) +template +matrix covariation_by_category_nll( int n_f, + int n_j, + int n_c, + matrix eta_jf, + matrix eta_mean_jf, + matrix L_cf, + vector simulate_j, + Type &jnll_pointer, + objective_function* of){ + + // Book-keeping + using namespace density; + matrix eta_jc(n_j, n_c); + + // Calculate probability and/or simulate + if( (n_f != -1) & (n_f != -3) ){ + for( int j=0; j= 1 + if( ((simulate_j.size()==1) && (simulate_j(0)>=1)) | ((simulate_j.size()==n_j) && (simulate_j(j)>=1)) ){ + if(isDouble::value && of->do_simulate){ + eta_jf(j,f) = rnorm( eta_mean_jf(j,f), Type(1.0) ); + } + } + }} + } + + // Project using loadings matrix + eta_jc = eta_jf * L_cf.transpose(); + + return eta_jc; +} + +template // +matrix convert_upper_cov_to_cor( matrix cov ){ + int nrow = cov.rows(); + for( int i=0; i // +array project_knots( int n_g, int n_f, int n_t, int is_epsilon, array Mat_sft, matrix A_ij, vector A_x ){ + array Mat_gf(n_g, n_f); + array Mat_gft(n_g, n_f, n_t); + if( is_epsilon!=1 ) Mat_gf.setZero(); + if( is_epsilon==1 ) Mat_gft.setZero(); + for( int t=0; t // +matrix gmrf_by_category_nll( int n_f, bool include_probability, int method, int timing, + int n_s, int n_c, Type logkappa, array gmrf_input_sf, array gmrf_mean_sf, matrix L_cf, + density::GMRF_t gmrf_Q, int simulate_random_effects, Type &jnll_pointer, objective_function* of){ + + // Book-keeping + using namespace density; + matrix gmrf_sc(n_s, n_c); + vector gmrf_s(n_s); + matrix Cov_cc(n_c,n_c); + array diff_gmrf_sc(n_s, n_c); // Requires an array + + // Deal with different treatments of tau + Type logtau; + if(method==0) logtau = log( 1.0 / (exp(logkappa) * sqrt(4.0*M_PI)) ); + if(method==1) logtau = log( 1.0 / sqrt(1-exp(logkappa*2.0)) ); + if( (method!=0) & (method!=1) ) logtau = Type(0.0); + + // PDF if density-dependence/interactions occurs prior to correlated dynamics + if( timing==0 ){ + + // Calculate probability and/or simulate + if( (include_probability == true) & (n_f != -1) & (n_f != -3) ){ + for( int f=0; f=1 ){ + if(isDouble::value && of->do_simulate) { + for( int f=0; f 0 ){ + gmrf_sc = (gmrf_input_sf.matrix() * L_cf.transpose()) / exp(logtau); + }else{ + gmrf_sc.setZero(); + } + } + + // PDF if density-dependence/interactions occurs after correlated dynamics (Only makes sense if n_f == n_c) + // Note: this won't easily work with spatially varying L_cf + if( timing==1 ){ + + // Calculate difference without rescaling + gmrf_sc = gmrf_input_sf.matrix(); + for( int s=0; s=1 ){ + if(isDouble::value && of->do_simulate) { + SEPARABLE(MVNORM(Cov_cc), gmrf_Q).simulate( diff_gmrf_sc ); + gmrf_sc = gmrf_mean_sf + diff_gmrf_sc * exp(-logtau); + } + } + } + } + + return gmrf_sc; +} + +// Used to calculate GMRF PDF for initial condition given covariance Cov_cc +// Only makes sense given: +// 1. full-rank factor model +// 2. Spatial Gompertz model conditions +// 3. Timing = 1 +template +matrix gmrf_stationary_nll( int method, int n_s, int n_c, Type logkappa, array gmrf_input_sc, matrix Cov_cc, density::GMRF_t gmrf_Q, int simulate_random_effects, Type &jnll_pointer, objective_function* of){ + using namespace density; + array gmrf_sc(n_s, n_c); + Type logtau; + if(method==0) logtau = log( 1.0 / (exp(logkappa) * sqrt(4.0*M_PI)) ); + if(method==1) logtau = log( 1.0 / sqrt(1-exp(logkappa*2.0)) ); + if( (method!=0) & (method!=1) ) logtau = Type(0.0); + // PDF if density-dependence/interactions occurs after correlated dynamics (Only makes sense if n_f == n_c) + gmrf_sc = gmrf_input_sc.matrix(); + // Calculate likelihood + jnll_pointer += SCALE(SEPARABLE(MVNORM(Cov_cc), gmrf_Q), exp(-logtau))( gmrf_sc ); + // Simulate new values when using obj.simulate() + if( simulate_random_effects>=1 ){ + if(isDouble::value && of->do_simulate) { + SEPARABLE(MVNORM(Cov_cc), gmrf_Q).simulate( gmrf_sc ); + gmrf_sc = gmrf_sc / exp(logtau); + } + } + return gmrf_sc.matrix(); +} + +// Calculate B_cc +template +matrix calculate_B( int method, int n_f, int n_r, matrix Chi_fr, matrix Psi_fr, Type &jnll_pointer ){ + matrix B_ff( n_f, n_f ); + matrix BplusI_ff( n_f, n_f ); + matrix Chi_rf = Chi_fr.transpose(); + matrix Psi_rf = Psi_fr.transpose(); + matrix Identity_ff( n_f, n_f ); + Identity_ff.setIdentity(); + + // No interactions (default) + if( method==0 ){ + B_ff.setZero(); + } + // Simple co-integration -- complex unbounded eigenvalues + if( method==1 ){ + B_ff = Chi_fr * Psi_rf; + } + // Real eigenvalues + if( method==2 ){ + matrix Chi_ff( n_f, n_f ); + Chi_ff = Identity_ff; + // Make Chi_ff + vector colnorm_r( n_r ); + colnorm_r.setZero(); + for(int f=0; f Psi_ff( n_f, n_f ); + Psi_ff = Identity_ff; + for(int f=n_r; f L_ff(n_f, n_f); + L_ff.setZero(); + for(int r=0; r invChi_ff = atomic::matinv( Chi_ff ); + matrix trans_Psi_ff = Psi_ff.transpose(); + matrix trans_invPsi_ff = atomic::matinv( Psi_ff ).transpose(); + B_ff = Chi_ff * trans_Psi_ff; + B_ff = B_ff * L_ff; + B_ff = B_ff * trans_invPsi_ff; + B_ff = B_ff * invChi_ff; + // Penalize colnorm_r + jnll_pointer += ( log(colnorm_r)*log(colnorm_r) ).sum(); + } + // Complex bounded eigenvalues + // Commenting out, because macOS throws errors with CPP dependency "complex" + // If anyone needs to use these features, please remove comments from local copy + // and then proceed. + if( method==3 ){ + //BplusI_ff = Chi_fr * Psi_rf + Identity_ff; + //// Extract eigenvalues + //vector< std::complex > eigenvalues_B_ff = B_ff.eigenvalues(); + //vector real_eigenvalues_B_ff = eigenvalues_B_ff.real(); + //vector imag_eigenvalues_B_ff = eigenvalues_B_ff.imag(); + //vector mod_eigenvalues_B_ff( n_f ); + //// Calculate maximum eigenvalues + //Type MaxEigen = 1; + //for(int f=0; f +matrix stationary_variance( int n_c, matrix B_cc, matrix Cov_cc ){ + int n2_c = n_c*n_c; + matrix Kronecker_c2c2(n2_c,n2_c); + matrix InvDiff_c2c2(n2_c, n2_c); + matrix Vinf_cc(n_c, n_c); + Kronecker_c2c2 = kronecker( B_cc, B_cc ); + InvDiff_c2c2.setIdentity(); + InvDiff_c2c2 = InvDiff_c2c2 - Kronecker_c2c2; + InvDiff_c2c2 = atomic::matinv( InvDiff_c2c2 ); + Vinf_cc.setZero(); + for(int i=0; i +array extract_2D_from_3D_array( array input_zzz, int along, int index ){ + int n_z1 = input_zzz.rows(); + int n_z3 = input_zzz.cols(); + int n_z2 = input_zzz.size() / (n_z1 * n_z3); + if( along==1 ){ + array output_zz(n_z2,n_z3); + for( int z2=0; z2 output_zz(n_z1,n_z3); + for( int z1=0; z1 output_zz(n_z1,n_z2); + for( int z1=0; z1 +Type objective_function::operator() () +{ + using namespace R_inla; + using namespace Eigen; + using namespace density; + + // Dimensions + DATA_INTEGER(n_i); // Number of observations (stacked across all years) + DATA_INTEGER(n_s); // Number of "strata" (i.e., vectices in SPDE mesh) + DATA_INTEGER(n_g); // Number of extrapolation-grid cells + DATA_INTEGER(n_t); // Number of time-indices + DATA_INTEGER(n_c); // Number of categories (e.g., length bins) + DATA_INTEGER(n_e); // Number of error distributions + DATA_INTEGER(n_p1); // Number of dynamic covariates for first linear predictor + DATA_INTEGER(n_p2); // Number of dynamic covariates for first linear predictor + DATA_INTEGER(n_v); // Number of tows/vessels (i.e., levels for the factor explaining overdispersion) + DATA_INTEGER(n_l); // Number of indices to post-process + DATA_INTEGER(n_m); // Number of range metrics to use (probably 2 for Eastings-Northings) + + // Config + DATA_STRUCT( Options_list, options_list ); + // Options_list.Options_vec + // Slot 0 -- Aniso: 0=No, 1=Yes + // Slot 1 -- DEPRECATED + // Slot 2 -- DEPRECATED + // Slot 3 -- DEPRECATED + // Slot 4 -- DEPRECATED + // Slot 5 -- DEPRECATED + // Slot 6 -- DEPRECATED + // Slot 7 -- Whether to use SPDE or 2D-AR1 hyper-distribution for spatial process: 0=SPDE; 1=2D-AR1; 2=Stream-network + // Slot 8 -- Whether to use F_ct or ignore it for speedup + // Options_list.Options + // Slot 0: Calculate SE for Index_xctl + // Slot 1: Calculate SE for log(Index_xctl) + // Slot 2: Calculate mean_Z_ctm (i.e., center-of-gravity) + // Slot 3: Calculate SE for D_i (expected density for every observation) + // Slot 4: Calculate mean_D_tl and effective_area_tl + // Slot 5: Calculate standard errors for Covariance and Correlation among categories using factor-analysis parameterization + // Slot 6: Calculate synchrony for different periods specified via yearbounds_zz + // Slot 7: Calculate coherence and variance for Epsilon1_sct and Epsilon2_sct + // Slot 8: Calculate proportions and SE + // Slot 9: Include normalization in GMRF PDF + // Slot 10: Calculate Fratio as F_ct divided by F achieving 40% of B0 + // Slot 11: Calculate B0 and Bratio + // Slot 12: Calculate Omegainput1_gf, Omegainput2_gf, Epsiloninput1_gft, Epsiloninput1_gft + // Slot 13: Calculate Treat year-category combinations with 0% encounters as 0 abundance (used for pre-processing, and doesn't affect CPP) + // Slot 14: Does bootstrap simulator simulate new realizations of random effects (default) or condition on estimated values for random effects + // Slot 15: Use CV for observation errors (default) or SD + // Slot 16: Report additional variables or skip to simplified output (default = FALSE) + // Slot 17: REDUNDANT + // Slot 18: REDUNDANT + // Slot 19: Complexity for calculation of lagrange_tc + // Slot 20: Value for lagrange_multiplier + // Options_list.yearbounds_zz + // Two columns, and 1+ rows, specifying first and last t for each period used in calculating synchrony + // Options_list.Expansion_cz + // Two columns and n_c rows. 1st column: Type of expansion (0=area-expansion; 1=biomass-expansion); 2nd column: Category used for biomass-expansion + // Options_list.overlap_zz + // Five columns and n_z rows. Columns: category and year for 1st variable, category and year for 2nd variable, type of overlap metric (0=Density of 2nd variable weighted by density of 1st) + // Options_list.zerosum_penalty + // Scalar (for now) indicating whether loadings matrices are not zero centered (value=0) or zero-centered, where the value is a penalty on squared-sum of loadings + // Options_list.trace_sum_penalty + // Scalar (for now) indicating whether loadings matrices have unconstrained magnitude (value=0) or have a sum-of-squares of 1.0 (value>0), where the value is a penalty on natural-log of sum-of-squared loadings values (i.e., trace of resulting covariance) + // Options_list.simulate_t + // Vector of length n_t indicating whether to include year in simulation ... useful for projecting forward conditional upon a fit + DATA_IMATRIX(FieldConfig); // Input settings (vector, length 4) + DATA_IVECTOR(RhoConfig); + DATA_IVECTOR(OverdispersionConfig); // Input settings (vector, length 2) + DATA_IMATRIX(ObsModel_ez); // Observation model + // Column 0: Probability distribution for data for each level of e_i + // 0: Normal + // 1: Lognormal + // 2: Gamma + // 3: Inverse-Gaussian (DEPRECATED IN INTERFACE, STILL BELOW FOR TESTING) + // 4: Lognormal using mean-CV + // 5: Zero-inflated negative binomial + // 7: Zero-inflated Poisson + // 9: Generalized Gamma-Lognormal + // 10: Tweedie + // 11: Zero-inflated lognormal Poisson + // 12: Poisson for combined data + // 13: Bernoulli for combined data + // 14: Lognormal-Poisson for combined data + // Column 1: Link function for linear predictors for each level of c_i + // NOTE: nlevels(c_i) must be <= nlevels(e_i) + DATA_IVECTOR(VamConfig); + // Slot 0 -- method for calculating n_c-by-n_c interaction matrix, B_ff + // Slot 1 -- rank of interaction matrix B_ff + // Slot 2 -- Timing of interactions; 0=Before correlated dynamics; 1=After correlated dynamics + // Current implementation only makes sense when (1) intercepts are constant among years; (2) using a Poisson-link delta model; (3) n_f=n_c for spatio-temporal variation; (4) starts near equilibrium manifold + DATA_IARRAY(X1config_cp); + // Methods for 1st component for each covariate in X_xtp (0=Off; 1=Estimate; 2=Estimate with zero-centered spatially varying coefficient; 3=Estimate with spatially varying coefficient; 4=Zero-centered spatially varying coefficient but replacing value with beta1_ct+beta2_ct + DATA_IARRAY(X2config_cp); + // Methods for 2nd component for each covariate in X_xtp (0=Off; 1=Estimate; 2=Estimate with zero-centered spatially varying coefficient; 3=Estimate with spatially varying coefficient; 4=Zero-centered spatially varying coefficient but replacing value with beta1_ct+beta2_ct) + DATA_IVECTOR(Q1config_k); + // Methods for 1st component for each covariate in Q1_ik (0=Off; 1=Estimate; 2=Estimate with zero-centered spatially varying coefficient; 3=Estimate with spatially varying coefficient) + DATA_IVECTOR(Q2config_k); + // Methods for 2nd component for each covariate in Q2_ik (0=Off; 1=Estimate; 2=Estimate with zero-centered spatially varying coefficient; 3=Estimate with spatially varying coefficient) + DATA_INTEGER(include_data); // Always use TRUE except for internal usage to extract GRMF normalization when turn off GMRF normalization in CPP + + // Data vectors + DATA_VECTOR(b_i); // Response (biomass) for each observation + DATA_VECTOR(a_i); // Area swept for each observation (km^2) + DATA_IMATRIX(c_iz); // Category for each observation + DATA_IVECTOR(e_i); // Error distribution for each observation + DATA_IVECTOR(t_i); // Time-index (year, season, etc.) for each observation + DATA_IVECTOR(v_i); // tows/vessels for each observation (level of factor representing overdispersion) + DATA_VECTOR(PredTF_i); // vector indicating whether an observatino is predictive (1=used for model evaluation) or fitted (0=used for parameter estimation) + DATA_MATRIX(a_gl); // Area for each "real" stratum(km^2) in each stratum + DATA_ARRAY(X1_ip); // Covariate design matrix (strata x covariate) + DATA_ARRAY(X1_gctp); // Covariate design matrix (strata x covariate) + DATA_ARRAY(X2_ip); // Covariate design matrix (strata x covariate) + DATA_ARRAY(X2_gctp); // Covariate design matrix (strata x covariate) + DATA_MATRIX(Q1_ik); // Catchability matrix (observations x variable) + DATA_MATRIX(Q2_ik); // Catchability matrix (observations x variable) + DATA_MATRIX(Z_gm); // Derived quantity matrix + DATA_MATRIX(F_ct); // Matrix of annual fishing mortality for each category + + // Spatial network inputs + DATA_IVECTOR(parent_s); // Columns: 0=Parent index, 1=Child index, 2=Distance from parent to child + DATA_IVECTOR(child_s); // Columns: 0=Parent index, 1=Child index, 2=Distance from parent to child + DATA_VECTOR(dist_s); // Columns: 0=Parent index, 1=Child index, 2=Distance from parent to child + + // SPDE objects + DATA_STRUCT(spde,spde_t); + + // Aniso objects + DATA_STRUCT(spde_aniso,spde_aniso_t); + + // Barrier object + DATA_STRUCT(spdeMatricesBarrier,spde_barrier_t); //Structure needed for the barrier procedure + DATA_VECTOR(Barrier_scaling); // Scaling of range + + // Sparse matrices for precision matrix of 2D AR1 process + // Q = M0*(1+rho^2)^2 + M1*(1+rho^2)*(-rho) + M2*rho^2 + DATA_SPARSE_MATRIX(M0); + DATA_SPARSE_MATRIX(M1); + DATA_SPARSE_MATRIX(M2); + + // Projection matrices from knots s to data i or extrapolation-grid cells x + DATA_IMATRIX( Ais_ij ); + DATA_VECTOR( Ais_x ); + DATA_IMATRIX( Ags_ij ); + DATA_VECTOR( Ags_x ); + + // Object used by TMBhelper::oneStepPredict_deltaMethod(.) + DATA_VECTOR_INDICATOR(keep, b_i); + + // Parameters + PARAMETER_VECTOR(ln_H_input); // Anisotropy parameters + PARAMETER_MATRIX(Chi_fr); // error correction responses + PARAMETER_MATRIX(Psi_fr); // error correction loadings, B_ff = Chi_fr %*% t(Psi_fr) + + // -- presence/absence fixed effects + PARAMETER_MATRIX(beta1_ft); // Year effect + PARAMETER_ARRAY(gamma1_cp); // Covariate effect + PARAMETER_VECTOR(lambda1_k); // Catchability coefficients + PARAMETER_VECTOR(L_eta1_z); // Overdispersion parameters + PARAMETER_VECTOR(L_omega1_z); + PARAMETER_VECTOR(L_epsilon1_z); + PARAMETER_VECTOR(L_beta1_z); + PARAMETER_VECTOR(Ltime_epsilon1_z); + PARAMETER(logkappa1); + PARAMETER_VECTOR(Beta_mean1_c); // mean-reversion for beta1_ft + PARAMETER_VECTOR(Beta_mean1_t); // mean-reversion for beta1_ft -- backdoor to allow crossed mean effects via manual mapping + PARAMETER_VECTOR(Beta_rho1_f); // AR1 for presence/absence Beta component, Default=0 + PARAMETER_VECTOR(Epsilon_rho1_f); // AR1 for presence/absence Epsilon component, Default=0 + PARAMETER_ARRAY(log_sigmaXi1_cp); // log-SD of Xi1_scp + PARAMETER_VECTOR(log_sigmaPhi1_k); // log-SD of Phi1_sk + + // -- presence/absence random effects + PARAMETER_MATRIX(eta1_vf); + PARAMETER_ARRAY(Xiinput1_scp); // spatially varying coefficient for density + PARAMETER_ARRAY(Phiinput1_sk); // spatially varying coefficient for catchability + PARAMETER_ARRAY(Omegainput1_sf); // Expectation + PARAMETER_ARRAY(Epsiloninput1_sff); // Annual variation + + // -- positive catch rates fixed effects + PARAMETER_MATRIX(beta2_ft); // Year effect + PARAMETER_ARRAY(gamma2_cp); // Covariate effect + PARAMETER_VECTOR(lambda2_k); // Catchability coefficients + PARAMETER_VECTOR(L_eta2_z); // Overdispersion parameters + PARAMETER_VECTOR(L_omega2_z); + PARAMETER_VECTOR(L_epsilon2_z); + PARAMETER_VECTOR(L_beta2_z); + PARAMETER_VECTOR(Ltime_epsilon2_z); + PARAMETER(logkappa2); + PARAMETER_VECTOR(Beta_mean2_c); // mean-reversion for beta2_ft + PARAMETER_VECTOR(Beta_mean2_t); // mean-reversion for beta2_ft -- backdoor to allow crossed mean effects via manual mapping + PARAMETER_VECTOR(Beta_rho2_f); // AR1 for positive catch Beta component, Default=0 + PARAMETER_VECTOR(Epsilon_rho2_f); // AR1 for positive catch Epsilon component, Default=0 + PARAMETER_ARRAY(log_sigmaXi2_cp); // log-SD of Xi2_scp + PARAMETER_VECTOR(log_sigmaPhi2_k); // log-SD of Phi2_sk + + // Error distribution parameters + PARAMETER_ARRAY(logSigmaM); + // Columns: 0=CV, 1=[usually not used], 2=[usually not used] + // Rows: Each level of e_i and/or c_i + // SigmaM[,0] indexed by e_i, e.g., SigmaM(e_i(i),0) + // SigmaM[,1] and SigmaM[,2] indexed by c_i, e.g., SigmaM(c_i(i),2) + + // Lagrange multipliers + PARAMETER_ARRAY(lagrange_tc); + + // -- positive catch rates random effects + PARAMETER_VECTOR(delta_i); + PARAMETER_MATRIX(eta2_vf); + PARAMETER_ARRAY(Xiinput2_scp); // spatially varying coefficient for density + PARAMETER_ARRAY(Phiinput2_sk); // spatially varying coefficient for catchability + PARAMETER_ARRAY(Omegainput2_sf); // Expectation + PARAMETER_ARRAY(Epsiloninput2_sff); // Annual variation + + //////////////////////// + // Preparatory bookkeeping + //////////////////////// + + // Indices -- i=Observation; t=Year; c=Category; p=Dynamic-covariate + int i,t,c,p,s,g,k; + + // Objective function + vector jnll_comp(22); + // Slot 0 -- spatial, encounter + // Slot 1 -- spatio-temporal, encounter + // Slot 2 -- spatial, positive catch + // Slot 3 -- spatio-temporal, positive catch + // Slot 4 -- tow/vessel overdispersion, encounter + // Slot 5 -- tow/vessel overdispersion, positive catch + // Slot 6 -- Deprecated + // Slot 7 -- Deprecated + // Slot 8 -- penalty on beta, encounter + // Slot 9 -- penalty on beta, positive catch + // Slot 10 -- likelihood of data, encounter + // Slot 11 -- likelihood of data, positive catch + // Slot 12 -- Likelihood of Lognormal-Poisson overdispersion delta_i + // Slot 13 -- penalty on estimate_B structure + // Slot 14 -- Spatially varying coefficient for density, encounter + // Slot 15 -- Spatially varying coefficient for density, positive catch + // Slot 16 -- Spatially varying coefficient for catchability, encounter + // Slot 17 -- Spatially varying coefficient for catchability, positive catch + // Slot 18 -- cdf aggregator for oneStepPredict_deltaModel + // Slot 19 -- Penalty for loadings-matrix zero-centering + // Slot 20 -- Penalty for Lagrange multipliers + // Slot 21 -- Epsilon method + jnll_comp.setZero(); + Type jnll = 0; + Type discard_nll = 0; + + // Unpack Options_list + vector Options_vec( Options_list.Options_vec.size() ); + Options_vec = Options_list.Options_vec; + vector Options( Options_list.Options.size() ); + Options = Options_list.Options; + matrix yearbounds_zz( Options_list.yearbounds_zz.rows(), 2 ); + yearbounds_zz = Options_list.yearbounds_zz; + matrix Expansion_cz( n_c, 2 ); + Expansion_cz = Options_list.Expansion_cz; + matrix overlap_zz( Options_list.overlap_zz.rows(), 5 ); + overlap_zz = Options_list.overlap_zz; + matrix zerosum_penalty( 1, 1 ); + zerosum_penalty = Options_list.zerosum_penalty; + vector trace_sum_penalty( 1 ); + trace_sum_penalty = Options_list.trace_sum_penalty; + vector simulate_t( n_t ); + simulate_t = Options_list.simulate_t; + + // Derived parameters + Type Range_raw1, Range_raw2; + if( Options_vec(7)==0 ){ + Range_raw1 = sqrt(8.0) / exp( logkappa1 ); // Range = approx. distance @ 10% correlation; use 8.0 to avoid ambiguity about type + Range_raw2 = sqrt(8.0) / exp( logkappa2 ); // Range = approx. distance @ 10% correlation; use 8.0 to avoid ambiguity about type + } + if( (Options_vec(7)==1) | (Options_vec(7)==2) ){ + Range_raw1 = log(0.1) / logkappa1; // Range = approx. distance @ 10% correlation + Range_raw2 = log(0.1) / logkappa2; // Range = approx. distance @ 10% correlation + } + array SigmaM( n_e, 3 ); + array sigmaXi1_cp( n_c, n_p1 ); + array sigmaXi2_cp( n_c, n_p2 ); + vector sigmaPhi1_k( Q1_ik.cols() ); + vector sigmaPhi2_k( Q2_ik.cols() ); + SigmaM = exp( logSigmaM ); + sigmaXi1_cp = exp( log_sigmaXi1_cp ); + sigmaXi2_cp = exp( log_sigmaXi2_cp ); + sigmaPhi1_k = exp( log_sigmaPhi1_k ); + sigmaPhi2_k = exp( log_sigmaPhi2_k ); + + // Anisotropy elements + matrix H(2,2); + H(0,0) = exp(ln_H_input(0)); + H(1,0) = ln_H_input(1); + H(0,1) = ln_H_input(1); + H(1,1) = (1+ln_H_input(1)*ln_H_input(1)) / exp(ln_H_input(0)); + + // Dimensionality + // Do not use Epsiloninput1_sff.col(0).cols() because .cols() does not return a matrix when middle dimension has length-0 + int n_f1; + n_f1 = Epsiloninput1_sff.size() / (n_s * Epsiloninput1_sff.cols()); + int n_f2; + n_f2 = Epsiloninput2_sff.size() / (n_s * Epsiloninput2_sff.cols()); + + // Overwrite parameters when mirroring them + if( RhoConfig(1)==6 ){ + Beta_rho2_f = Beta_rho1_f; + } + if( RhoConfig(3)==6 ){ + Epsilon_rho2_f = Epsilon_rho1_f; + } + + // Form loadings matrices + matrix L_omega1_cf = create_loadings_general( L_omega1_z, n_c, FieldConfig(0,0), Type(0.0), Type(0.0), jnll_comp(19) ); + matrix L_omega2_cf = create_loadings_general( L_omega2_z, n_c, FieldConfig(0,1), Type(0.0), Type(0.0), jnll_comp(19) ); + matrix L_epsilon1_cf = create_loadings_general( L_epsilon1_z, n_c, FieldConfig(1,0), Type(0.0), Type(0.0), jnll_comp(19) ); + matrix L_epsilon2_cf = create_loadings_general( L_epsilon2_z, n_c, FieldConfig(1,1), Type(0.0), Type(0.0), jnll_comp(19) ); + matrix L_beta1_cf = create_loadings_general( L_beta1_z, n_c, FieldConfig(2,0), Type(0.0), Type(0.0), jnll_comp(19) ); + matrix L_beta2_cf = create_loadings_general( L_beta2_z, n_c, FieldConfig(2,1), Type(0.0), Type(0.0), jnll_comp(19) ); + matrix Ltime_epsilon1_tf = create_loadings_general( Ltime_epsilon1_z, n_t, FieldConfig(3,0), zerosum_penalty(0,0), trace_sum_penalty(0), jnll_comp(19) ); + matrix Ltime_epsilon2_tf = create_loadings_general( Ltime_epsilon2_z, n_t, FieldConfig(3,1), zerosum_penalty(0,0), trace_sum_penalty(0), jnll_comp(19) ); + matrix L_eta1_cf = create_loadings_general( L_eta1_z, n_c, OverdispersionConfig(0), Type(0.0), Type(0.0), jnll_comp(19) ); + matrix L_eta2_cf = create_loadings_general( L_eta2_z, n_c, OverdispersionConfig(1), Type(0.0), Type(0.0), jnll_comp(19) ); + + //////////////////////// + // Interactions and fishing mortality + //////////////////////// + + // Define interaction matrix for Epsilon1, and also the impact of F_ct on intercepts + matrix B_ff( n_f1, n_f1 ); // Interactions among factors + B_ff = calculate_B( VamConfig(0), n_f1, VamConfig(1), Chi_fr, Psi_fr, jnll_comp(13) ); + matrix iota_ct( n_c, n_t ); // Cumulative impact of fishing mortality F_ct in years <= current year t + matrix B1_cc( n_c, n_c ); // Interactions among categories + matrix covE1_cc( n_c, n_c ); + matrix B2_cc( n_c, n_c ); // Interactions among categories + matrix covE2_cc( n_c, n_c ); + matrix I_cc( n_c, n_c ); + matrix IminusB_cc( n_c, n_c ); + I_cc.setIdentity(); + B1_cc.setZero(); + B2_cc.setZero(); + covE1_cc.setZero(); + covE2_cc.setZero(); + // Calculate interaction matrix B_cc for categories if feasible + if( (n_c==n_f1) & (n_c==n_f2) & (FieldConfig(1,0)>0) & (FieldConfig(1,1)>0) ){ + matrix Cov_epsilon1_cc = L_epsilon1_cf * L_epsilon1_cf.transpose(); + matrix Cov_epsilon2_cc = L_epsilon2_cf * L_epsilon2_cf.transpose(); + matrix Btemp_cc( n_c, n_c ); + // Assemble interaction matrix + B1_cc = B_ff; + for( c=0; c Btarg_c( n_c ); + vector Ftarg_c( n_c ); + matrix Fratio_ct( n_c, n_t ); + IminusB_cc = I_cc - B1_cc; + Btarg_c = log( 0.4 ); // 40% target, transformed for log-link + Ftarg_c = -1 * ( IminusB_cc * Btarg_c ); + for( t=0; t sumB1_cc( n_c, n_c ); + IminusB_cc = I_cc - B1_cc; + sumB1_cc = IminusB_cc.inverse(); + iota_ct.col(0) -= sumB1_cc * F_ct.col(0); + } + if( (Options_vec(8)==1) | (Options_vec(8)==2) ){ + // Project forward effect of F_ct from initial year through current year + for( t=1; t Q1( n_s, n_s ); + Eigen::SparseMatrix Q2( n_s, n_s ); + GMRF_t gmrf_Q; + if( Options_vec(7)==0 ){ + if( Options_vec(0)==0 ){ + Q1 = Q_spde(spde, exp(logkappa1)); + Q2 = Q_spde(spde, exp(logkappa2)); + } + if( Options_vec(0)==1 ){ + Q1 = Q_spde(spde_aniso, exp(logkappa1), H); + Q2 = Q_spde(spde_aniso, exp(logkappa2), H); + } + } + if( Options_vec(7)==1 ){ + Q1 = M0*pow(1.0+exp(logkappa1*2.0),2.0) + M1*(1.0+exp(logkappa1*2.0))*(-exp(logkappa1)) + M2*exp(logkappa1*2.0); + Q2 = M0*pow(1.0+exp(logkappa2*2.0),2.0) + M1*(1.0+exp(logkappa2*2.0))*(-exp(logkappa2)) + M2*exp(logkappa2*2.0); + } + if( Options_vec(7)==2 ){ + Q1 = Q_network( logkappa1, n_s, parent_s, child_s, dist_s ); + Q2 = Q_network( logkappa2, n_s, parent_s, child_s, dist_s ); + } + if( Options_vec(7)==3 ){ + Q1 = Q_spde(spdeMatricesBarrier, exp(logkappa1), Barrier_scaling); + Q2 = Q_spde(spdeMatricesBarrier, exp(logkappa2), Barrier_scaling); + } + + array Zeros_s1(n_s, 1); + Zeros_s1.setZero(); + matrix Sigma_11(1,1); + array Tmp_s1(n_s, 1); + + ///// + // 1st component + ///// + gmrf_Q = GMRF( Q1, bool(Options(9)) ); + int simulate_var; + + // Omega1 + array Omegamean1_sf(n_s, Omegainput1_sf.cols() ); + Omegamean1_sf.setZero(); + array Omega1_sc(n_s, n_c); + Omega1_sc = gmrf_by_category_nll(FieldConfig(0,0), true, Options_vec(7), VamConfig(2), n_s, n_c, logkappa1, Omegainput1_sf, Omegamean1_sf, L_omega1_cf, gmrf_Q, Options(14), jnll_comp(0), this); + + // Projection for Omega1 + array Omega1_iz(n_i, c_iz.cols()); + Omega1_iz.setZero(); + for( int Arow=0; Arow=0) & (c_iz(i,zc) Tmp_st( n_s, n_t ); + array Epsiloninput1_sft( n_s, n_f1, n_t ); + bool include_epsilon_prob_1; + if( FieldConfig(3,0) > 0 ){ + include_epsilon_prob_1 = false; + int n_t1 = Epsiloninput1_sff.cols(); + array Tmp1_sf( n_s, n_t1 ); + array Zeros1_sf( n_s, n_t1 ); + Zeros1_sf.setZero(); + for( int f1=0; f1 Epsilonmean1_sf(n_s, n_f1 ); + // PDF for Epsilon1 + array Epsilon1_sct(n_s, n_c, n_t); + array Temp1_sf( n_s, n_f1 ); + for(t=0; t=(Options(11)+1) ){ + // Prediction for spatio-temporal component + // Default, and also necessary whenever VamConfig(2)==1 & n_f1!=n_c + if( (VamConfig(0)==0) | ((n_f1!=n_c) & (VamConfig(2)==1)) ){ + // If no interactions, then just autoregressive for factors + for(s=0; s Epsilon1_iz(n_i, c_iz.cols()); + Epsilon1_iz.setZero(); + for( int Arow=0; Arow=0) & (c_iz(i,zc) Xi1_scp(n_s, n_c, n_p1); + Xi1_scp.setZero(); + for(p=0; p Xi1_izp(n_i, c_iz.cols(), n_p1); + Xi1_izp.setZero(); + for( int Arow=0; Arow=0) & (c_iz(i,zc) Phi1_sk(n_s, Q1_ik.cols()); + Phi1_sk.setZero(); + for(k=0; k Phi1_ik(n_i, Q1_ik.cols()); + Phi1_ik.setZero(); + for( int Arow=0; Arow Omegamean2_sf(n_s, Omegainput2_sf.cols() ); + Omegamean2_sf.setZero(); + array Omega2_sc(n_s, n_c); + Omega2_sc = gmrf_by_category_nll(FieldConfig(0,1), true, Options_vec(7), VamConfig(2), n_s, n_c, logkappa2, Omegainput2_sf, Omegamean2_sf, L_omega2_cf, gmrf_Q, Options(14), jnll_comp(2), this); + + // Projection for Omega2 + array Omega2_iz(n_i, c_iz.cols()); + Omega2_iz.setZero(); + for( int Arow=0; Arow=0) & (c_iz(i,zc) Epsiloninput2_sft( n_s, n_f2, n_t ); + bool include_epsilon_prob_2; + if( FieldConfig(3,1) > 0 ){ + include_epsilon_prob_2 = false; + int n_t2 = Epsiloninput2_sff.cols(); + array Tmp2_sf( n_s, n_t2 ); + array Zeros2_sf( n_s, n_t2 ); + Zeros2_sf.setZero(); + for( int f1=0; f1 Epsilonmean2_sf(n_s, n_f2); + // PDF for Epsilon2 + array Epsilon2_sct(n_s, n_c, n_t); + array Temp2_sf( n_s, n_f2 ); + for(t=0; t=(Options(11)+1) ){ + // Prediction for spatio-temporal component + // Default, and also necessary whenever VamConfig(2)==1 & n_f2!=n_c + if( (VamConfig(0)==0) | ((n_f2!=n_c) & (VamConfig(2)==1)) ){ + // If no interactions, then just autoregressive for factors + for(s=0; s Epsilon2_iz(n_i, c_iz.cols()); + Epsilon2_iz.setZero(); + for( int Arow=0; Arow=0) & (c_iz(i,zc) Ximean2_sc(n_s, 1); + array Xi2_scp(n_s, n_c, n_p2); + matrix Sigma2_cf(1,1); + array Tmp2_sc(n_s, 1); + Ximean2_sc.setZero(); + Xi2_scp.setZero(); + for(p=0; p Xi2_izp(n_i, c_iz.cols(), n_p2); + Xi2_izp.setZero(); + for( int Arow=0; Arow=0) & (c_iz(i,zc) Phi2_sk(n_s, Q2_ik.cols()); + Phi2_sk.setZero(); + for(k=0; k Phi2_ik(n_i, Q2_ik.cols()); + Phi2_ik.setZero(); + for( int Arow=0; Arow eta1_mean_vf(n_v, n_eta_f1); + eta1_mean_vf.setZero(); + matrix eta1_vc(n_v, n_c); + eta1_vc = covariation_by_category_nll( OverdispersionConfig(0), n_v, n_c, eta1_vf, eta1_mean_vf, L_eta1_cf, Options(14), jnll_comp(4), this ); + // 1st component + int n_eta_f2; + n_eta_f2 = eta2_vf.cols(); + matrix eta2_mean_vf(n_v, n_eta_f2); + eta2_mean_vf.setZero(); + matrix eta2_vc(n_v, n_c); + eta2_vc = covariation_by_category_nll( OverdispersionConfig(1), n_v, n_c, eta2_vf, eta2_mean_vf, L_eta2_cf, Options(14), jnll_comp(5), this ); + + ////// Probability of correlated innovations on intercepts + // 1st component + Type jnll_beta1 = 0; + int n_beta_f1; + n_beta_f1 = beta1_ft.rows(); + matrix beta1_mean_tf(n_t, n_beta_f1); + matrix beta1_tf( n_t, n_beta_f1 ); + beta1_tf = beta1_ft.transpose(); + for( int f=0; f beta1_tc(n_t, n_c); + vector simulate_vec( n_t ); + simulate_vec = Options(14) + simulate_t; // + beta1_tc = covariation_by_category_nll( FieldConfig(2,0), n_t, n_c, beta1_tf, beta1_mean_tf, L_beta1_cf, simulate_vec, jnll_beta1, this ); + for( c=0; c beta2_mean_tf(n_t, n_beta_f2); + matrix beta2_tf( n_t, n_beta_f2 ); + beta2_tf = beta2_ft.transpose(); + for( int f=0; f beta2_tc(n_t, n_c); + //simulate_var = Options(14); // + simulate_t(t); // + beta2_tc = covariation_by_category_nll( FieldConfig(2,1), n_t, n_c, beta2_tf, beta2_mean_tf, L_beta2_cf, simulate_vec, jnll_beta2, this ); + for( c=0; c lagrangeprime_tc( n_t, n_c ); + if( (Options(19)==1) | (Options(19)==2) | (Options(19)==3) | (Options(19)==4) ){ + // Overload input values + lagrangeprime_tc.setZero(); + for(c=0; c zeta1_i(n_i); + zeta1_i.setZero(); + for( i=0; i zeta2_i(n_i); + zeta2_i.setZero(); + for( i=0; i eta1_iz(n_i, c_iz.cols()); + eta1_iz.setZero(); + for( p=0; p eta2_iz(n_i, c_iz.cols()); + eta2_iz.setZero(); + for( p=0; p var_i(n_i); + Type pred_jnll = 0; + Type cdf_for_single_obs; + Type tmp_calc1; + Type tmp_calc2; + Type log_tmp_calc2; + // Linear predictor (pre-link) for presence/absence component + matrix P1_iz(n_i,c_iz.cols()); + // Response predictor (post-link) + // ObsModel_ez(e,0) = 0:3 -- probability ("phi") that data is greater than zero + vector R1_i(n_i); + vector log_one_minus_R1_i(n_i); + vector log_R1_i(n_i); + vector LogProb1_i(n_i); + // Linear predictor (pre-link) for positive component + matrix P2_iz(n_i,c_iz.cols()); + // Response predictor (post-link) + // ObsModel_ez(e,0) = 0:3 -- expected value of data, given that data is greater than zero -> E[D] = mu*phi + vector R2_i(n_i); + vector log_R2_i(n_i); + vector LogProb2_i(n_i); + vector maxJ_i(n_i); + vector diag_z(4); + matrix diag_iz(n_i,4); + diag_iz.setZero(); // Used to track diagnostics for Tweedie distribution (columns: 0=maxJ; 1=maxW; 2=lowerW; 3=upperW) + P1_iz.setZero(); + P2_iz.setZero(); + LogProb1_i.setZero(); + LogProb2_i.setZero(); + + // Calculate deviance relative to saturated model, where: + // percent_deviance_explained = 1 - deviance_fit / deviance_null + // deviance_fit = sum(deviance1_i) + sum(deviance2_i) + // deviance_null = deviance_fit when using only single intercepts for both linear predictors + // Calculations: + // Gamma -- https://stats.stackexchange.com/questions/474326/deviance-for-gamma-glm + // Bernoulli -- https://stats.stackexchange.com/questions/208331/how-to-derive-bernoulli-deviance + // Normal -- https://en.wikipedia.org/wiki/Deviance_(statistics)#Examples + vector deviance1_i(n_i); + vector deviance2_i(n_i); + deviance1_i.setZero(); + deviance2_i.setZero(); + + // Likelihood contribution from observations + Type logsd; + for(i=0; i=0) & (c_iz(i,zc)=0) & (c_iz(i,zc)=1 ) log_tmp_calc2 = logspace_add( log_tmp_calc2, P1_iz(i,zc) + P2_iz(i,zc) ); + } + } + R1_i(i) = Type(1.0) - exp( -1*a_i(i)*tmp_calc1 ); + R2_i(i) = a_i(i) * tmp_calc2 / R1_i(i); + // Calulate in logspace to prevent numerical over/under-flow + log_R1_i(i) = logspace_sub( Type(0.0), -1*a_i(i)*tmp_calc1 ); + log_one_minus_R1_i(i) = -1*a_i(i)*tmp_calc1; + log_R2_i(i) = log(a_i(i)) + log_tmp_calc2 - log_R1_i(i); + } + if( ObsModel_ez(e_i(i),1)==2 ){ + // Tweedie link, where area-swept affects numbers density exp(P1_i(i)) + // P1_i: Log-numbers density; R1_i: Expected numbers + // P2_i: Log-average weight; R2_i: Expected average weight + R1_i(i) = a_i(i) * exp( P1_iz(i,0) ); + R2_i(i) = exp( P2_iz(i,0) ); + // Calulate in logspace to prevent numerical over/under-flow + log_R1_i(i) = log(a_i(i)) + P1_iz(i,0); + log_one_minus_R1_i(i) = logspace_sub(Type(0.0), log(a_i(i)) + P1_iz(i,0) ); + log_R2_i(i) = P2_iz(i,0); + } + // Likelihood for delta-models with continuous positive support + if( (ObsModel_ez(e_i(i),0)==0) | (ObsModel_ez(e_i(i),0)==1) | (ObsModel_ez(e_i(i),0)==2) | (ObsModel_ez(e_i(i),0)==3) | (ObsModel_ez(e_i(i),0)==4) | (ObsModel_ez(e_i(i),0)==9) ){ + // Presence-absence likelihood + // deviance1_fit = -2 * sum( y*log(mu) + (1-y)*log(1-mu) ) + if( b_i(i) > 0 ){ + LogProb1_i(i) = log_R1_i(i); + deviance1_i(i) = -2 * log_R1_i(i); + }else{ + LogProb1_i(i) = log_one_minus_R1_i(i); + deviance1_i(i) = -2 * log_one_minus_R1_i(i); + } + // CDF + cdf_for_single_obs = squeeze(1.0 - R1_i(i)); + // Simulate new values when using obj.simulate() + SIMULATE{ + b_i(i) = rbinom( Type(1), R1_i(i) ); + } + // Positive density likelihood -- models with continuous positive support + if( b_i(i) > 0 ){ // 1e-500 causes overflow on laptop + // Normal distribution + // deviance2_fit = sum( (y-mu)^2 ) + if(ObsModel_ez(e_i(i),0)==0){ + LogProb2_i(i) = dnorm(b_i(i), R2_i(i), SigmaM(e_i(i),0), true); + deviance2_i(i) = square( b_i(i) - R2_i(i) ); + // Simulate new values when using obj.simulate() + SIMULATE{ + b_i(i) = rnorm( R2_i(i), SigmaM(e_i(i),0) ); + } + } + // Lognormal; mean, sd (in log-space) parameterization + // deviance2_fit = sum( (log(y)-log(mu))^2 ) + if(ObsModel_ez(e_i(i),0)==1){ + LogProb2_i(i) = dlnorm(b_i(i), log_R2_i(i)-square(SigmaM(e_i(i),0))/2, SigmaM(e_i(i),0), true); // log-space + deviance2_i(i) = square( log(b_i(i)) - (log_R2_i(i)-square(SigmaM(e_i(i),0))/2) ); + // CDF for oneStepPredict_deltaModel + //cdf += (1.0-R1_i(i))*pnorm(log(b_i), log_R2_i(i)-square(SigmaM(e_i(i),0))/2, SigmaM(e_i(i),0)); + cdf_for_single_obs += squeeze(R1_i(i)) * pnorm(log(b_i(i)), log_R2_i(i)-square(SigmaM(e_i(i),0))/2, SigmaM(e_i(i),0)); + // Simulate new values when using obj.simulate() + SIMULATE{ + b_i(i) = exp(rnorm( log_R2_i(i)-square(SigmaM(e_i(i),0))/2, SigmaM(e_i(i),0) )); + } + } + // Gamma; mean, CV parameterization (converting to shape, scale) + // deviance2_fit = 2 * sum( (y-mu)/mu - log(y/mu) ) + if(ObsModel_ez(e_i(i),0)==2){ + if( Options(15)==1 ){ + // shape = 1/CV^2; scale = mean*CV^2 + LogProb2_i(i) = dgamma(b_i(i), 1/square(SigmaM(e_i(i),0)), R2_i(i)*square(SigmaM(e_i(i),0)), true); + deviance2_i(i) = 2 * ( (b_i(i)-R2_i(i))/R2_i(i) - log(b_i(i)/R2_i(i)) ); + // CDF for oneStepPredict_deltaModel + cdf_for_single_obs += squeeze(R1_i(i)) * pgamma(b_i(i), 1/square(SigmaM(e_i(i),0)), R2_i(i)*square(SigmaM(e_i(i),0))); + // Simulate new values when using obj.simulate() + SIMULATE{ + b_i(i) = rgamma( 1/square(SigmaM(e_i(i),0)), R2_i(i)*square(SigmaM(e_i(i),0)) ); + } + }else{ + // shape = mean^2 / sd^2; scale = sd^2 / mean + LogProb2_i(i) = dgamma(b_i(i), square(R2_i(i))/square(SigmaM(e_i(i),0)), square(SigmaM(e_i(i),0))/R2_i(i), true); + deviance2_i(i) = NAN; + // CDF for oneStepPredict_deltaModel + cdf_for_single_obs += squeeze(R1_i(i)) * pgamma(b_i(i), square(R2_i(i))/square(SigmaM(e_i(i),0)), square(SigmaM(e_i(i),0))/R2_i(i)); + // Simulate new values when using obj.simulate() + SIMULATE{ + b_i(i) = rgamma( square(R2_i(i))/square(SigmaM(e_i(i),0)), square(SigmaM(e_i(i),0))/R2_i(i) ); + } + } + } + // Inverse-Gaussian; mean, CV parameterization + if(ObsModel_ez(e_i(i),0)==3){ + if( Options(15)==1 ){ + LogProb2_i(i) = dinverse_gaussian(b_i(i), R2_i(i), SigmaM(e_i(i),0), true); + }else{ + LogProb2_i(i) = dinverse_gaussian(b_i(i), R2_i(i), SigmaM(e_i(i),0)/R2_i(i), true); + } + deviance2_i(i) = NAN; + // Simulate new values when using obj.simulate() + SIMULATE{ + b_i(i) = Type(1.0); // Simulate as 1.0 so b_i distinguishes between simulated encounter/non-encounters + } + } + // Lognormal; mean, CV (in logspace) parameterization + if(ObsModel_ez(e_i(i),0)==4){ + if( Options(15)==1 ){ + // CV = sqrt( exp(logsd^2)-1 ), therefore + // logSD = sqrt( log(CV^2 + 1) ) = sqrt(log(square(SigmaM(e_i(i),0))+1)) + logsd = sqrt( log(square(SigmaM(e_i(i),0))+1) ); + }else{ + // CV = sd / mean, therefore + logsd = sqrt( log(square( SigmaM(e_i(i),0) / R2_i(i) )+1) ); + } + LogProb2_i(i) = dlnorm(b_i(i), log_R2_i(i)-square(logsd)/2, logsd, true); // log-space + deviance2_i(i) = square( log(b_i(i)) - (log_R2_i(i)-square(logsd)/2) ); + // Simulate new values when using obj.simulate() + SIMULATE{ + b_i(i) = exp(rnorm( log_R2_i(i)-square(logsd)/2, logsd )); + } + } + // Generalized-gamma; mean, sigma, lambda parameterization + if(ObsModel_ez(e_i(i),0)==9){ + LogProb2_i(i) = dgengamma(b_i(i), R2_i(i), SigmaM(e_i(i),0), logSigmaM(e_i(i),1), true); + deviance2_i(i) = NAN; + // Simulate new values when using obj.simulate() + // Could be updated, available as rgengamma.orig + SIMULATE{ + b_i(i) = rgengamma(R2_i(i), SigmaM(e_i(i),0), SigmaM(e_i(i),1)); + } + } + }else{ + LogProb2_i(i) = 0; + } + } + // Likelihood #2 for Tweedie model with continuous positive support + if(ObsModel_ez(e_i(i),0)==10){ + // Packaged code + LogProb1_i(i) = 0; + // dtweedie( Type y, Type mu, Type phi, Type p, int give_log=0 ) + // R1*R2 = mean + LogProb2_i(i) = dtweedie( b_i(i), R1_i(i)*R2_i(i), R1_i(i), invlogit(logSigmaM(e_i(i),0))+Type(1.0), true ); + deviance2_i(i) = deviance_tweedie( b_i(i), R1_i(i)*R2_i(i), invlogit(logSigmaM(e_i(i),0))+Type(1.0) ); + // Simulate new values when using obj.simulate() + SIMULATE{ + b_i(i) = rTweedie( R1_i(i)*R2_i(i), R1_i(i), invlogit(logSigmaM(e_i(i),0))+Type(1.0) ); // Defined above + } + } + ///// Likelihood for models with discrete support + // Zero-inflated negative binomial (not numerically stable!) + if(ObsModel_ez(e_i(i),0)==5){ + var_i(i) = R2_i(i)*(1.0+SigmaM(e_i(i),0)) + pow(R2_i(i),2.0)*SigmaM(c_iz(i,0),1); + if( b_i(i)==0 ){ + //LogProb2_i(i) = log( (1-R1_i(i)) + dnbinom2(Type(0.0), R2_i(i), var_i(i), false)*R1_i(i) ); // Pr[X=0] = 1-phi + NB(X=0)*phi + LogProb2_i(i) = logspace_add( log(1.0-R1_i(i)), dnbinom2(Type(0.0),R2_i(i),var_i(i),true)+log(R1_i(i)) ); // Pr[X=0] = 1-phi + NB(X=0)*phi + }else{ + LogProb2_i(i) = dnbinom2(b_i(i), R2_i(i), var_i(i), true) + log(R1_i(i)); // Pr[X=x] = NB(X=x)*phi + } + deviance2_i(i) = NAN; + // Simulate new values when using obj.simulate() + SIMULATE{ + b_i(i) = rbinom( Type(1), R1_i(i) ); + if( b_i(i)>0 ){ + b_i(i) = rnbinom2( R2_i(i), var_i(i) ); + } + } + } + // Zero-inflated Poisson + if(ObsModel_ez(e_i(i),0)==7){ + if( b_i(i)==0 ){ + //LogProb2_i(i) = log( (1-R1_i(i)) + dpois(Type(0.0), R2_i(i), false)*R1_i(i) ); // Pr[X=0] = 1-phi + Pois(X=0)*phi + LogProb2_i(i) = logspace_add( log(1-R1_i(i)), dpois(Type(0.0),R2_i(i),true)+log(R1_i(i)) ); // Pr[X=0] = 1-phi + Pois(X=0)*phi + }else{ + LogProb2_i(i) = dpois(b_i(i), R2_i(i), true) + log(R1_i(i)); // Pr[X=x] = Pois(X=x)*phi + } + deviance2_i(i) = NAN; + // Simulate new values when using obj.simulate() + SIMULATE{ + b_i(i) = rbinom( Type(1), R1_i(i) ); + if( b_i(i)>0 ){ + b_i(i) = rpois( R2_i(i) ); + } + } + } + // Zero-inflated Lognormal Poisson + if(ObsModel_ez(e_i(i),0)==11){ + if( b_i(i)==0 ){ + //LogProb2_i(i) = log( (1-R1_i(i)) + dpois(Type(0.0), R2_i(i), false)*R1_i(i) ); // Pr[X=0] = 1-phi + Pois(X=0)*phi + LogProb2_i(i) = logspace_add( log(1.0-R1_i(i)), dpois(Type(0.0),R2_i(i)*exp(SigmaM(e_i(i),0)*delta_i(i)-0.5*pow(SigmaM(e_i(i),0),2)),true)+log(R1_i(i)) ); // Pr[X=0] = 1-phi + Pois(X=0)*phi + }else{ + LogProb2_i(i) = dpois(b_i(i), R2_i(i)*exp(SigmaM(e_i(i),0)*delta_i(i)-0.5*pow(SigmaM(e_i(i),0),2.0)), true) + log(R1_i(i)); // Pr[X=x] = Pois(X=x)*phi + } + deviance2_i(i) = NAN; + // Simulate new values when using obj.simulate() + SIMULATE{ + b_i(i) = rbinom( Type(1), R1_i(i) ); + if( b_i(i)>0 ){ + b_i(i) = rpois( R2_i(i)*exp(SigmaM(e_i(i),0)*delta_i(i)-0.5*pow(SigmaM(e_i(i),0),2.0)) ); + } + } + } + // Non-zero-inflated Poisson using log link from 1st linear predictor + if(ObsModel_ez(e_i(i),0)==12){ + LogProb2_i(i) = dpois(b_i(i), R1_i(i), true); + // Simulate new values when using obj.simulate() + deviance2_i(i) = NAN; + SIMULATE{ + b_i(i) = rpois( R1_i(i) ); + } + } + // Non-zero-inflated Bernoulli using cloglog link from 1st lilnear predict + if(ObsModel_ez(e_i(i),0)==13){ + if( b_i(i)==0 ){ + LogProb2_i(i) = dpois(Type(0), R1_i(i), true); + }else{ + LogProb2_i(i) = logspace_sub( log(Type(1.0)), dpois(Type(0), R1_i(i), true) ); + } + deviance2_i(i) = NAN; + // Simulate new values when using obj.simulate() + SIMULATE{ + b_i(i) = rpois( R1_i(i) ); + if( b_i(i)>0 ){ + b_i(i) = 1; + } + } + } + // Non-zero-inflated Lognormal-Poisson using log link from 1st linear predictor + if(ObsModel_ez(e_i(i),0)==14){ + LogProb2_i(i) = dpois(b_i(i), R1_i(i)*exp(SigmaM(e_i(i),0)*delta_i(i)-0.5*pow(SigmaM(e_i(i),0),2.0)), true); + deviance2_i(i) = NAN; + // Simulate new values when using obj.simulate() + SIMULATE{ + b_i(i) = rpois( R1_i(i)*exp(SigmaM(e_i(i),0)*delta_i(i)-0.5*pow(SigmaM(e_i(i),0),2.0)) ); + } + } + + // Aggregate + jnll_comp(10) -= keep(i) * LogProb1_i(i) * (Type(1.0)-PredTF_i(i)); + jnll_comp(11) -= keep(i) * LogProb2_i(i) * (Type(1.0)-PredTF_i(i)); + // CDF aggregator + jnll_comp(18) -= keep.cdf_lower(i) * log( squeeze(cdf_for_single_obs) ); + jnll_comp(18) -= keep.cdf_upper(i) * log( 1.0 - squeeze(cdf_for_single_obs) ); + // Predictive jnll aggregator + pred_jnll -= (LogProb1_i(i) + LogProb2_i(i)) * PredTF_i(i); + } + } + REPORT( diag_iz ); + + //////////////////////// + // Calculate index of abundance and density + //////////////////////// + + if( n_g > 0 ){ + + // Projection for Omega1 + array Omega1_gc(n_g, n_c); + Omega1_gc.setZero(); + Omega1_gc = project_knots( n_g, n_c, int(1), int(0), Omega1_sc, Ags_ij, Ags_x ); + + // Projection for Epsilon1 + array Epsilon1_gct(n_g, n_c, n_t); + Epsilon1_gct.setZero(); + Epsilon1_gct = project_knots( n_g, n_c, n_t, int(1), Epsilon1_sct, Ags_ij, Ags_x ); + + // Projection for Xi1 + array Xi1_gcp(n_g, n_c, n_p1); + Xi1_gcp.setZero(); + Xi1_gcp = project_knots( n_g, n_c, n_p1, int(1), Xi1_scp, Ags_ij, Ags_x ); + + // Projection for Phi1 + array Phi1_gk(n_g, Q1_ik.cols()); + Phi1_gk.setZero(); + Phi1_gk = project_knots( n_g, Q1_ik.cols(), int(1), int(0), Phi1_sk, Ags_ij, Ags_x ); + + // Projection for Omega2 + array Omega2_gc(n_g, n_c); + Omega2_gc.setZero(); + Omega2_gc = project_knots( n_g, n_c, int(1), int(0), Omega2_sc, Ags_ij, Ags_x ); + + // Projection for Epsilon2 + array Epsilon2_gct(n_g, n_c, n_t); + Epsilon2_gct.setZero(); + Epsilon2_gct = project_knots( n_g, n_c, n_t, int(1), Epsilon2_sct, Ags_ij, Ags_x ); + + // Projection for Xi2 + array Xi2_gcp(n_g, n_c, n_p2); + Xi2_gcp.setZero(); + Xi2_gcp = project_knots( n_g, n_c, n_p2, int(1), Xi2_scp, Ags_ij, Ags_x ); + + // Projection for Phi2 + array Phi2_gk(n_g, Q2_ik.cols()); + Phi2_gk.setZero(); + Phi2_gk = project_knots( n_g, Q2_ik.cols(), int(1), int(0), Phi2_sk, Ags_ij, Ags_x ); + + //////////////////////// + // Covariate effects + //////////////////////// + + // If using spatially varying response to intercepts, replace covariate values + for(c=0; c eta1_gct(n_g, n_c, n_t); + eta1_gct.setZero(); + for(p=0; p eta2_gct(n_g, n_c, n_t); + eta2_gct.setZero(); + for(p=0; p P1_gct(n_g, n_c, n_t); + array R1_gct(n_g, n_c, n_t); + array P2_gct(n_g, n_c, n_t); + array R2_gct(n_g, n_c, n_t); + array D_gct(n_g, n_c, n_t); + for(c=0; c Index_gctl(n_g, n_c, n_t, n_l); + array Index_ctl(n_c, n_t, n_l); + array ln_Index_ctl(n_c, n_t, n_l); + Index_ctl.setZero(); + for(t=0; t 0) { + Type S; + for(c=0; c jnll_lagrange_ct(c,t); + jnll_lagrange_ct.setZero(); + for( c=0; c Bratio_ctl(n_c, n_t, n_l); + array ln_Bratio_ctl(n_c, n_t, n_l); + for(c=0; c mean_Z_ctm(n_c, n_t, n_m); + if( Options(2)==1 ){ + mean_Z_ctm.setZero(); + int report_summary_TF = false; + for(c=0; c mean_D_ctl(n_c, n_t, n_l); + array log_mean_D_ctl(n_c, n_t, n_l); + mean_D_ctl.setZero(); + for(c=0; c effective_area_ctl(n_c, n_t, n_l); + array log_effective_area_ctl(n_c, n_t, n_l); + effective_area_ctl = Index_ctl / mean_D_ctl; // Correct for different units of Index and density + log_effective_area_ctl = log( effective_area_ctl ); + REPORT( effective_area_ctl ); + ADREPORT( effective_area_ctl ); + ADREPORT( log_effective_area_ctl ); + } + + // Reporting and standard-errors for covariance and correlation matrices + if( Options(5)==1 ){ + if( FieldConfig(0,0)>0 ){ + matrix lowercov_uppercor_omega1 = L_omega1_cf * L_omega1_cf.transpose(); + lowercov_uppercor_omega1 = convert_upper_cov_to_cor( lowercov_uppercor_omega1 ); + REPORT( lowercov_uppercor_omega1 ); + ADREPORT( lowercov_uppercor_omega1 ); + } + if( FieldConfig(1,0)>0 ){ + matrix lowercov_uppercor_epsilon1 = L_epsilon1_cf * L_epsilon1_cf.transpose(); + lowercov_uppercor_epsilon1 = convert_upper_cov_to_cor( lowercov_uppercor_epsilon1 ); + REPORT( lowercov_uppercor_epsilon1 ); + ADREPORT( lowercov_uppercor_epsilon1 ); + } + if( FieldConfig(2,0)>0 ){ + matrix lowercov_uppercor_beta1 = L_beta1_cf * L_beta1_cf.transpose(); + lowercov_uppercor_beta1 = convert_upper_cov_to_cor( lowercov_uppercor_beta1 ); + REPORT( lowercov_uppercor_beta1 ); + ADREPORT( lowercov_uppercor_beta1 ); + } + if( FieldConfig(0,1)>0 ){ + matrix lowercov_uppercor_omega2 = L_omega2_cf * L_omega2_cf.transpose(); + lowercov_uppercor_omega2 = convert_upper_cov_to_cor( lowercov_uppercor_omega2 ); + REPORT( lowercov_uppercor_omega2 ); + ADREPORT( lowercov_uppercor_omega2 ); + } + if( FieldConfig(1,1)>0 ){ + matrix lowercov_uppercor_epsilon2 = L_epsilon2_cf * L_epsilon2_cf.transpose(); + lowercov_uppercor_epsilon2 = convert_upper_cov_to_cor( lowercov_uppercor_epsilon2 ); + REPORT( lowercov_uppercor_epsilon2 ); + ADREPORT( lowercov_uppercor_epsilon2 ); + } + if( FieldConfig(2,1)>0 ){ + matrix lowercov_uppercor_beta2 = L_beta2_cf * L_beta2_cf.transpose(); + lowercov_uppercor_beta2 = convert_upper_cov_to_cor( lowercov_uppercor_beta2 ); + REPORT( lowercov_uppercor_beta2 ); + ADREPORT( lowercov_uppercor_beta2 ); + } + } + + // Synchrony + if( Options(6)==1 ){ + int n_z = yearbounds_zz.rows(); + // Density ("D") or area-expanded total biomass ("B") for each category (use B when summing across sites) + matrix D_gt( n_g, n_t ); + matrix B_ct( n_c, n_t ); + vector B_t( n_t ); + D_gt.setZero(); + B_ct.setZero(); + B_t.setZero(); + // Sample variance in category-specific density ("D") and biomass ("B") + array varD_gcz( n_g, n_c, n_z ); + array varD_gz( n_g, n_z ); + array varB_cz( n_c, n_z ); + vector varB_z( n_z ); + vector varB_gbar_z( n_z ); + vector varB_cbar_z( n_z ); + vector ln_varB_z( n_z ); + vector ln_varB_gbar_z( n_z ); + vector ln_varB_cbar_z( n_z ); + array maxsdD_gz( n_g, n_z ); + array maxsdB_cz( n_c, n_z ); + vector maxsdB_z( n_z ); + varD_gcz.setZero(); + varD_gz.setZero(); + varB_cz.setZero(); + varB_z.setZero(); + varB_gbar_z.setZero(); + varB_cbar_z.setZero(); + maxsdD_gz.setZero(); + maxsdB_cz.setZero(); + maxsdB_z.setZero(); + // Proportion of total biomass ("P") for each location or each category + matrix propB_gz( n_g, n_z ); + matrix propB_cz( n_c, n_z ); + propB_gz.setZero(); + propB_cz.setZero(); + // Synchrony indices + matrix phi_gz( n_g, n_z ); + matrix phi_cz( n_c, n_z ); + vector phi_gbar_z( n_z ); + vector phi_cbar_z( n_z ); + vector phi_z( n_z ); + phi_gbar_z.setZero(); + phi_cbar_z.setZero(); + phi_z.setZero(); + // Calculate total biomass for different categories + for( t=0; t CovHat( n_c, n_c ); + CovHat.setIdentity(); + CovHat *= pow(0.0001, 2.0); + if( FieldConfig(1,0)>0 ) CovHat += L_epsilon1_cf * L_epsilon1_cf.transpose(); + if( FieldConfig(1,1)>0 ) CovHat += L_epsilon2_cf * L_epsilon2_cf.transpose(); + // Coherence ranges from 0 (all factors are equal) to 1 (first factor explains all variance) + SelfAdjointEigenSolver > es(CovHat); + vector eigenvalues_c = es.eigenvalues(); // Ranked from lowest to highest for some reason + Type psi = 0; + for(c=0; c diag_CovHat( n_c ); + vector log_diag_CovHat( n_c ); + for(c=0; c PropIndex_ctl(n_c, n_t, n_l); + array ln_PropIndex_ctl(n_c, n_t, n_l); + Type sumtemp; + for(int t=0; t Omegainput1_gf( n_g, Omegainput1_sf.cols() ); + array Epsiloninput1_gft( n_g, n_f1, n_t ); + array Epsiloninput1_gff( n_g, n_f1, Epsiloninput1_sff.cols() ); + array Omegainput2_gf( n_g, Omegainput2_sf.cols() ); + array Epsiloninput2_gft( n_g, n_f2, n_t ); + array Epsiloninput2_gff( n_g, n_f2, Epsiloninput2_sff.cols() ); + // Project + Omegainput1_gf = project_knots( n_g, Omegainput1_sf.cols(), int(1), int(0), Omegainput1_sf, Ags_ij, Ags_x ); + Epsiloninput1_gft = project_knots( n_g, n_f1, n_t, int(1), Epsiloninput1_sft, Ags_ij, Ags_x ); + Epsiloninput1_gff = project_knots( n_g, n_f1, Epsiloninput1_sff.cols(), int(1), Epsiloninput1_sff, Ags_ij, Ags_x ); + Omegainput2_gf = project_knots( n_g, Omegainput2_sf.cols(), int(1), int(0), Omegainput2_sf, Ags_ij, Ags_x ); + Epsiloninput2_gft = project_knots( n_g, n_f2, n_t, int(1), Epsiloninput2_sft, Ags_ij, Ags_x ); + Epsiloninput2_gff = project_knots( n_g, n_f2, Epsiloninput2_sff.cols(), int(1), Epsiloninput2_sff, Ags_ij, Ags_x ); + // Return + REPORT( Omegainput1_gf ); + REPORT( Epsiloninput1_gft ); + REPORT( Epsiloninput1_gff ); + REPORT( Omegainput2_gf ); + REPORT( Epsiloninput2_gft ); + REPORT( Epsiloninput2_gff ); + } + + // Overlap metrics + if( overlap_zz.rows() > 0 ){ + vector overlap_z( overlap_zz.rows() ); + //matrix overlap_gz( n_g, overlap_zz.rows() ); + for( int z=0; z D_i( n_i ); + D_i = R1_i * R2_i; // Used in DHARMa residual plotting + Type deviance = sum(deviance1_i) + sum(deviance2_i); + + // Joint likelihood + jnll = jnll_comp.sum(); + + /// Important outputs + //REPORT( B_ff ); + REPORT( SigmaM ); + REPORT( jnll ); + REPORT( jnll_comp ); + REPORT( pred_jnll ); + REPORT( deviance ); + + // Quantities derived from random effects and used for plotting + REPORT( eta1_vc ); + REPORT( eta2_vc ); + REPORT( iota_ct ); + REPORT( sigmaXi1_cp ); + REPORT( sigmaXi2_cp ); + REPORT( sigmaPhi1_k ); + REPORT( sigmaPhi2_k ); + REPORT( Xi1_scp ); + REPORT( Xi2_scp ); + REPORT( Omega1_sc ); + REPORT( Omega2_sc ); + REPORT( Epsilon1_sct ); + REPORT( Epsilon2_sct ); + REPORT( beta1_tc ); + REPORT( beta2_tc ); + REPORT( Omegainput1_sf ); + REPORT( Omegainput2_sf ); + REPORT( Epsiloninput1_sft ); + REPORT( Epsiloninput2_sft ); + + // Predictors + REPORT( D_i ); + REPORT( P1_iz ); + REPORT( P2_iz ); + REPORT( R1_i ); + REPORT( R2_i ); + + // Loadings matrices + REPORT( L_omega1_cf ); + REPORT( L_omega2_cf ); + REPORT( L_epsilon1_cf ); + REPORT( L_epsilon2_cf ); + REPORT( L_beta1_cf ); + REPORT( L_beta2_cf ); + REPORT( Ltime_epsilon1_tf ); + REPORT( Ltime_epsilon2_tf ); + + // Decorrelation distances + REPORT( H ); + REPORT( Range_raw1 ); + REPORT( Range_raw2 ); + ADREPORT( Range_raw1 ); + ADREPORT( Range_raw2 ); + + /// Optional diagnostic outputs + if( Options(16) == true ){ + REPORT( Q1 ); + REPORT( Q2 ); + REPORT( var_i ); + REPORT( LogProb1_i ); + REPORT( LogProb2_i ); + REPORT( deviance1_i ); + REPORT( deviance2_i ); + REPORT( eta1_vf ); + REPORT( eta2_vf ); + REPORT( beta1_mean_tf ); + REPORT( beta2_mean_tf ); + REPORT( Options ); + REPORT( Options_vec ); + REPORT( yearbounds_zz ); + REPORT( Expansion_cz ); + REPORT( Beta_mean1_c ); + REPORT( Beta_mean2_c ); + REPORT( Beta_mean1_t ); + REPORT( Beta_mean2_t ); + REPORT( Beta_rho1_f ); + REPORT( Beta_rho2_f ); + REPORT( Epsilon_rho1_f ); + REPORT( Epsilon_rho2_f ); + REPORT( Omega1_iz ); + REPORT( Omega2_iz ); + REPORT( Epsilon1_iz ); + REPORT( Epsilon2_iz ); + REPORT( eta1_iz ); + REPORT( eta2_iz ); + REPORT( Phi1_ik ); + REPORT( Phi2_ik ); + REPORT( zeta1_i ); + REPORT( zeta2_i ); + REPORT( iota_ct ); + } + + if( Options(3)==1 ){ + ADREPORT( D_i ); + } + + SIMULATE{ + REPORT( b_i ); + } + + return jnll; +} diff --git a/inst/executables/VAST_v14_0_1.cpp b/inst/executables/VAST_v14_0_1.cpp new file mode 100644 index 0000000..a4f18b4 --- /dev/null +++ b/inst/executables/VAST_v14_0_1.cpp @@ -0,0 +1,2885 @@ + +#include +#include + +// Function to implement barrier-SPDE code +// Reused with permission from Olav Nikolai Breivik and Hans Skaug +template +struct spde_barrier_t{ + vector C0; + vector C1; + Eigen::SparseMatrix D0; + Eigen::SparseMatrix D1; + Eigen::SparseMatrix I; + spde_barrier_t(SEXP x){ /* x = List passed from R */ + C0 = asVector(getListElement(x,"C0")); + C1 = asVector(getListElement(x,"C1")); + D0 = tmbutils::asSparseMatrix(getListElement(x,"D0")); + D1 = tmbutils::asSparseMatrix(getListElement(x,"D1")); + I = tmbutils::asSparseMatrix(getListElement(x,"I")); + } +}; + +// Function to calculate Q (precision) matrix using barrier-SPDE +// Reused with permission from Olav Nikolai Breivik and Hans Skaug +template +Eigen::SparseMatrix Q_spde( spde_barrier_t spde, + Type kappa, + vector c){ + + //using namespace Eigen; + vector range(2); + range(0) = sqrt(8.0)/kappa*c(0); + range(1) = range(0)*c(1); + + int dimLatent = spde.D0.row(0).size(); + vector Cdiag(dimLatent); + Eigen::SparseMatrix Cinv(dimLatent,dimLatent); + + Cdiag = spde.C0*pow(range(0),2) + spde.C1*pow(range(1),2); + for(int i =0; iA = spde.I; + A = A + (pow(range(0),2.0)/8.0) * spde.D0 + (pow(range(1),2.0)/8.0) * spde.D1; + + Eigen::SparseMatrix Q = A.transpose() * Cinv * A/M_PI *2 * 3; + + return Q; +} + +// Function to import R list for user-defined Options_vec and Options, packaged as list Options_list in TmbData +template +struct options_list { + vector Options_vec; + vector Options; + matrix yearbounds_zz; + matrix Expansion_cz; + matrix overlap_zz; + matrix zerosum_penalty; + vector trace_sum_penalty; + vector simulate_t; + options_list(SEXP x){ // Constructor + Options_vec = asVector(getListElement(x,"Options_vec")); + Options = asVector(getListElement(x,"Options")); + yearbounds_zz = asMatrix(getListElement(x,"yearbounds_zz")); + Expansion_cz = asMatrix(getListElement(x,"Expansion_cz")); + overlap_zz = asMatrix(getListElement(x,"overlap_zz")); + zerosum_penalty = asMatrix(getListElement(x,"zerosum_penalty")); + trace_sum_penalty = asVector(getListElement(x,"trace_sum_penalty")); + simulate_t = asVector(getListElement(x,"simulate_t")); + } +}; + +// Needed for returning SparseMatrix for Ornstein-Uhlenbeck network correlations +template +Eigen::SparseMatrix Q_network( Type log_theta, + int n_s, + vector parent_s, + vector child_s, + vector dist_s ){ + + Eigen::SparseMatrix Q( n_s, n_s ); + Type theta = exp( log_theta ); + for(int s=0; s +bool isNA(Type x){ + return R_IsNA(asDouble(x)); +} + +// Posfun +template +Type posfun( Type x, + Type lowerlimit, + Type &pen){ + + // Version 1: https://github.com/kaskr/adcomp/issues/7#issuecomment-67519437 + pen += CppAD::CondExpLt(x, lowerlimit, Type(0.01)*pow(x-lowerlimit,2.0), Type(0.0) ); + return CppAD::CondExpGe(x, lowerlimit, x, lowerlimit/(Type(2.0)-x/lowerlimit) ); + + // Version 2: https://github.com/kaskr/adcomp/issues/7#issuecomment-644839660 + //pen += CppAD::CondExpLt(x, lowerlimit, Type(0.01)*pow(lowerlimit-eps,2), Type(0)); + //return CppAD::CondExpGe(x, lowerlimit, x, eps*logspace_add(lowerlimit/eps, Type(0))); +} + +// mean +template +Type mean( vector vec ){ + return vec.sum() / vec.size(); +} + +// Variance +template +Type var( array vec ){ + Type vec_mod = vec - mean(vec); + Type res = pow(vec_mod, 2.0).sum() / vec.size(); + return res; +} + +// square +template +Type square(Type x){ + return pow(x,2); +} + +// sqrt +template +Type sqrt(Type x){ + return pow(x,0.5); +} + +// dlnorm +template +Type dlnorm( Type x, + Type meanlog, + Type sdlog, + int give_log=0){ + + //return 1/(sqrt(2*M_PI)*sd) * exp(-.5*pow((x-mean)/sd,2)); + Type logres = dnorm( log(x), meanlog, sdlog, true) - log(x); + if(give_log) return logres; else return exp(logres); +} + +// dinverse_gaussian +template +Type dinverse_gaussian( Type x, + Type mean, + Type cv, + int give_log=0){ + + //return sqrt(lambda/(2*M_PI*pow(x,3))) * exp( -1.0 * lambda*pow(x-mean,2) / (2*pow(mean,2)*x) ); + Type sd = cv * mean; + Type lambda = pow(mean,3.0) / pow(sd,2.0); + Type logres = 0.5*(log(lambda) - 3.0*log(x) - log(2.0*M_PI)) - ( lambda*pow(x-mean,2.0) / (2.0*pow(mean,2.0)*x) ); + if(give_log) return logres; else return exp(logres); +} + +// dgengamma +// using Prentice-1974 parameterization for lambda instead of k, so that lognormal occurs as lambda -> 0 +// using mean parameterization to back out theta +// CV is a function of sigma and lambda and NOT mean (i.e., CV is fixed for all values of mean) +// See: C:\Users\James.Thorson\Desktop\Work files\AFSC\2021-10 -- Generalized gamma-lognormal\Explore gengamma.R +template +Type dgengamma( Type x, + Type mean, + Type sigma, + Type lambda, + int give_log=0){ + + Type k = pow( lambda, -2 ); + Type Shape = pow( sigma, -1 ) * lambda; + // Numerically unstable + // Type Scale = mean / exp(lgamma( (k*Shape+1)/Shape )) * exp(lgamma( k )); + // Type logres = log(Shape) - lgamma(k) + (Shape * k - 1) * log(x) - Shape * k * log(Scale) - pow( x/Scale, Shape ); + // Numerically stable + Type log_Scale = log(mean) - lgamma( (k*Shape+1)/Shape ) + lgamma( k ); + Type mu = log_Scale + log(k) / Shape; + // Type Sigma = 1 / sqrt(k) / Shape; abs(Sigma) := sigma + // Type Q = sqrt( 1/k ); Q := lambda + Type y = log(x); + Type w = (y - mu) / sigma; + Type q_square = square(lambda); // = abs(Q); + Type qi = 1/square(lambda); + Type qw = lambda * w; + Type logres = -log(sigma*x) + 0.5*log(q_square) * (1 - 2 * qi) + qi * (qw - exp(qw)) - lgamma(qi); + // return stuff + if(give_log) return logres; else return exp(logres); +} + +// rgengamma +template +Type rgengamma( Type mean, + Type sigma, + Type lambda){ + + // See: C:\Users\James.Thorson\Desktop\Work files\AFSC\2021-10 -- Generalized gamma-lognormal\Explore gengamma.R + Type k = pow( lambda, -2 ); + Type Shape = pow( sigma, -1 ) * lambda; + Type Scale = mean / exp(lgamma( (k*Shape+1)/Shape )) * exp(lgamma( k )); + Type w = log(rgamma(k, Type(1.0))); + Type y = w/Shape + log(Scale); + return exp(y); +} + +// Simulate from tweedie +// Adapted from tweedie::rtweedie function in R +template +Type rTweedie( Type mu, + Type phi, + Type power){ + + Type lambda = pow(mu, Type(2.0) - power) / (phi * (Type(2.0) - power)); + Type alpha = (Type(2.0) - power) / (Type(1.0) - power); + Type gam = phi * (power - Type(1.0)) * pow(mu, power - Type(1.0)); + Type N = rpois(lambda); + Type B = rgamma(-N * alpha, gam); /// Using Shape-Scale parameterization + return B; +} + +// Deviance for the Tweedie +// https://en.wikipedia.org/wiki/Tweedie_distribution#Properties +template +Type deviance_tweedie( Type y, + Type mu, + Type p ){ + + Type c1 = pow( y, 2.0-p ) / (1.0-p) / (2.0-p); + Type c2 = y * pow( mu, 1.0-p ) / (1.0-p); + Type c3 = pow( mu, 2.0-p ) / (2.0-p); + return 2 * (c1 - c2 + c3 ); +} + +// Generate loadings matrix for covariance +// zerosum_penalty -- used for EOF indices when also estimating Omega (such that EOF is zero-centered index) +// trace_sum_penalty -- used for sum of squared elements, +template +matrix create_loadings_covariance( vector L_val, + int n_rows, + int n_cols, + Type zerosum_penalty, + Type trace_sum_penalty, + Type &jnll_pointer ){ + + matrix L_rc(n_rows, n_cols); + int Count = 0; + for(int r=0; r=c){ + L_rc(r,c) = L_val(Count); + Count++; + }else{ + L_rc(r,c) = 0.0; + } + }} + // Zero-sum constraint + if( zerosum_penalty > 0 ){ + vector colsum( n_cols ); + colsum.setZero(); + for(int c=0; c 0 ){ + Type Cov_trace = 0; + for(int c=0; c +matrix create_loadings_correlation( vector L_val, + int n_rows, + int n_cols ){ + + matrix L_rc(n_rows, n_cols); + matrix Z_rc(n_rows, n_cols); + int Count = 0; + Type sum_squares; + for(int r=0; rc){ + Z_rc(r,c) = 2.0*invlogit(L_val(Count)) - 1.0; // tanh(L_val(Count)); // + Count++; + } + if(r +matrix create_loadings_AR1( Type rhoinput, + Type ln_margsd, + int n_rows ){ + + Type rho = 2.0*invlogit(rhoinput) - 1; + Type margsd = exp( ln_margsd ); + matrix L_rc(n_rows, n_rows); + L_rc.setZero(); + for( int c=0; c= 1 ){ + L_rc(r,c) = L_rc(r,c) * sqrt(1 - square(rho)); + } + }} + return L_rc; +} + +// Create loadings matrix for general case, +template +matrix create_loadings_general( vector L_val, + int n_rows, + int n_f, + Type zerosum_penalty, + Type trace_sum_penalty, + Type &jnll_pointer ){ + + if( n_f == -2 ){ + // IID + matrix L_rc(n_rows, n_rows); + L_rc.setZero(); + for( int r=0; r L_rc(n_rows, 1); + matrix L_rc(n_rows, 0); + L_rc.setZero(); + return L_rc; + }else if( n_f == -3 ){ + // Identity matrix + matrix L_rc(n_rows, n_rows); + L_rc.setIdentity(); + return L_rc; + }else if( n_f == 0 ){ + // AR1 + matrix L_rc = create_loadings_AR1( L_val(0), L_val(1), n_rows ); + return L_rc; + }else{ + // Factor + //if(use_covariance==false){ + // matrix L_rc = create_loadings_correlation( L_val, n_rows, n_f ); + // return L_rc; + //}else{ + matrix L_rc = create_loadings_covariance( L_val, n_rows, n_f, zerosum_penalty, trace_sum_penalty, jnll_pointer ); + return L_rc; + //} + } +} + +// IN: eta1_vf; L1_z +// OUT: jnll_comp; eta1_vc +// eta_jf could be either eta_vf (for overdispersion) or eta_tf (for year effects) +//template +//matrix covariation_by_category_nll( int n_f, +// int n_j, +// int n_c, +// matrix eta_jf, +// matrix eta_mean_jf, +// matrix L_cf, +// vector simulate_j, +// Type &jnll_pointer, +// objective_function* of){ +// +// // Book-keeping +// using namespace density; +// matrix eta_jc(n_j, n_c); +// +// // Calculate probability and/or simulate +// if( (n_f != -1) & (n_f != -3) ){ +// for( int j=0; j= 1 +// if( ((simulate_j.size()==1) && (simulate_j(0)>=1)) | ((simulate_j.size()==n_j) && (simulate_j(j)>=1)) ){ +// if(isDouble::value && of->do_simulate){ +// eta_jf(j,f) = rnorm( eta_mean_jf(j,f), Type(1.0) ); +// } +// } +// }} +// } +// +// // Project using loadings matrix +// eta_jc = eta_jf * L_cf.transpose(); +// +// return eta_jc; +//} + +template // +matrix convert_upper_cov_to_cor( matrix cov ){ + int nrow = cov.rows(); + for( int i=0; i // +array project_knots( int n_g, + int n_f, + int n_t, + int is_epsilon, + array Mat_sft, + matrix A_ij, + vector A_x ){ + + array Mat_gf(n_g, n_f); + array Mat_gft(n_g, n_f, n_t); + if( is_epsilon!=1 ) Mat_gf.setZero(); + if( is_epsilon==1 ) Mat_gft.setZero(); + for( int t=0; t // +matrix gmrf_by_category_nll( int n_f, + bool include_probability, + Type logtau, + int timing, + int n_s, + int n_c, + Type logkappa, + array gmrf_input_sf, + array gmrf_mean_sf, + matrix L_cf, + density::GMRF_t gmrf_Q, + int simulate_random_effects, + Type &jnll_pointer, + objective_function* of){ + + // Book-keeping + using namespace density; + //matrix gmrf_sc(n_s, n_c); + vector gmrf_s(n_s); + //matrix Cov_cc(n_c,n_c); + //array diff_gmrf_sc(n_s, n_c); // Requires an array + + // Deal with different treatments of tau + //Type logtau; + //if(method==0) logtau = log( 1.0 / (exp(logkappa) * sqrt(4.0*M_PI)) ); + //if(method==1) logtau = log( 1.0 / sqrt(1-exp(logkappa*2.0)) ); + //if( (method!=0) & (method!=1) ) logtau = Type(0.0); + + // PDF if density-dependence/interactions occurs prior to correlated dynamics + if( timing==0 ){ + + // Calculate probability and/or simulate + if( (include_probability == true) & (n_f != -1) & (n_f != -3) ){ + for( int f=0; f=1 ){ + if(isDouble::value && of->do_simulate) { + for( int f=0; f 0 ){ + // gmrf_sc = (gmrf_input_sf.matrix() * L_cf.transpose()) / exp(logtau); + //}else{ + // gmrf_sc.setZero(); + //} + } + + // PDF if density-dependence/interactions occurs after correlated dynamics (Only makes sense if n_f == n_c) + // Note: this won't easily work with spatially varying L_cf + //if( timing==1 ){ + // + // // Calculate difference without rescaling + // gmrf_sc = gmrf_input_sf.matrix(); + // for( int s=0; s=1 ){ + // if(isDouble::value && of->do_simulate) { + // SEPARABLE(MVNORM(Cov_cc), gmrf_Q).simulate( diff_gmrf_sc ); + // gmrf_sc = gmrf_mean_sf + diff_gmrf_sc * exp(-logtau); + // } + // } + // } + //} + + return gmrf_input_sf; +} + +// Used to calculate GMRF PDF for initial condition given covariance Cov_cc +// Only makes sense given: +// 1. full-rank factor model +// 2. Spatial Gompertz model conditions +// 3. Timing = 1 +template +matrix gmrf_stationary_nll( Type logtau, + int n_s, + int n_c, + Type logkappa, + array + gmrf_input_sc, + matrix Cov_cc, + density::GMRF_t gmrf_Q, + int simulate_random_effects, + Type &jnll_pointer, + objective_function* of){ + + using namespace density; + array gmrf_sc(n_s, n_c); + //Type logtau; + //if(method==0) logtau = log( 1.0 / (exp(logkappa) * sqrt(4.0*M_PI)) ); + //if(method==1) logtau = log( 1.0 / sqrt(1-exp(logkappa*2.0)) ); + //if( (method!=0) & (method!=1) ) logtau = Type(0.0); + // PDF if density-dependence/interactions occurs after correlated dynamics (Only makes sense if n_f == n_c) + gmrf_sc = gmrf_input_sc.matrix(); + // Calculate likelihood + jnll_pointer += SCALE(SEPARABLE(MVNORM(Cov_cc), gmrf_Q), exp(-logtau))( gmrf_sc ); + // Simulate new values when using obj.simulate() + if( simulate_random_effects>=1 ){ + if(isDouble::value && of->do_simulate) { + SEPARABLE(MVNORM(Cov_cc), gmrf_Q).simulate( gmrf_sc ); + gmrf_sc = gmrf_sc / exp(logtau); + } + } + return gmrf_sc.matrix(); +} + +// Calculate B_cc +template +matrix calculate_B( int method, + int n_f, + int n_r, + matrix + Chi_fr, + matrix Psi_fr, + Type &jnll_pointer ){ + + matrix B_ff( n_f, n_f ); + matrix BplusI_ff( n_f, n_f ); + matrix Chi_rf = Chi_fr.transpose(); + matrix Psi_rf = Psi_fr.transpose(); + matrix Identity_ff( n_f, n_f ); + Identity_ff.setIdentity(); + + // No interactions (default) + if( method==0 ){ + B_ff.setZero(); + } + // Simple co-integration -- complex unbounded eigenvalues + if( method==1 ){ + B_ff = Chi_fr * Psi_rf; + } + // Real eigenvalues + if( method==2 ){ + matrix Chi_ff( n_f, n_f ); + Chi_ff = Identity_ff; + // Make Chi_ff + vector colnorm_r( n_r ); + colnorm_r.setZero(); + for(int f=0; f Psi_ff( n_f, n_f ); + Psi_ff = Identity_ff; + for(int f=n_r; f L_ff(n_f, n_f); + L_ff.setZero(); + for(int r=0; r invChi_ff = atomic::matinv( Chi_ff ); + matrix trans_Psi_ff = Psi_ff.transpose(); + matrix trans_invPsi_ff = atomic::matinv( Psi_ff ).transpose(); + B_ff = Chi_ff * trans_Psi_ff; + B_ff = B_ff * L_ff; + B_ff = B_ff * trans_invPsi_ff; + B_ff = B_ff * invChi_ff; + // Penalize colnorm_r + jnll_pointer += ( log(colnorm_r)*log(colnorm_r) ).sum(); + } + // Complex bounded eigenvalues + // Commenting out, because macOS throws errors with CPP dependency "complex" + // If anyone needs to use these features, please remove comments from local copy + // and then proceed. + if( method==3 ){ + //BplusI_ff = Chi_fr * Psi_rf + Identity_ff; + //// Extract eigenvalues + //vector< std::complex > eigenvalues_B_ff = B_ff.eigenvalues(); + //vector real_eigenvalues_B_ff = eigenvalues_B_ff.real(); + //vector imag_eigenvalues_B_ff = eigenvalues_B_ff.imag(); + //vector mod_eigenvalues_B_ff( n_f ); + //// Calculate maximum eigenvalues + //Type MaxEigen = 1; + //for(int f=0; f +matrix stationary_variance( int n_c, + matrix B_cc, + matrix Cov_cc ){ + + int n2_c = n_c*n_c; + matrix Kronecker_c2c2(n2_c,n2_c); + matrix InvDiff_c2c2(n2_c, n2_c); + matrix Vinf_cc(n_c, n_c); + Kronecker_c2c2 = kronecker( B_cc, B_cc ); + InvDiff_c2c2.setIdentity(); + InvDiff_c2c2 = InvDiff_c2c2 - Kronecker_c2c2; + InvDiff_c2c2 = atomic::matinv( InvDiff_c2c2 ); + Vinf_cc.setZero(); + for(int i=0; i +array extract_2D_from_3D_array( array input_zzz, + int along, + int index ){ + + int n_z1 = input_zzz.rows(); + int n_z3 = input_zzz.cols(); + int n_z2 = input_zzz.size() / (n_z1 * n_z3); + if( along==1 ){ + array output_zz(n_z2,n_z3); + for( int z2=0; z2 output_zz(n_z1,n_z3); + for( int z1=0; z1 output_zz(n_z1,n_z2); + for( int z1=0; z1 +Type objective_function::operator() () +{ + using namespace R_inla; + using namespace Eigen; + using namespace density; + + // Dimensions + DATA_INTEGER(n_i); // Number of observations (stacked across all years) + DATA_INTEGER(n_s); // Number of "strata" (i.e., vectices in SPDE mesh) + DATA_INTEGER(n_g); // Number of extrapolation-grid cells + DATA_INTEGER(n_t); // Number of time-indices + DATA_INTEGER(n_c); // Number of categories (e.g., length bins) + DATA_INTEGER(n_e); // Number of error distributions + DATA_INTEGER(n_p1); // Number of dynamic covariates for first linear predictor + DATA_INTEGER(n_p2); // Number of dynamic covariates for first linear predictor + DATA_INTEGER(n_v); // Number of tows/vessels (i.e., levels for the factor explaining overdispersion) + DATA_INTEGER(n_l); // Number of indices to post-process + DATA_INTEGER(n_m); // Number of range metrics to use (probably 2 for Eastings-Northings) + + // Config + DATA_STRUCT( Options_list, options_list ); + // Options_list.Options_vec + // Slot 0 -- Aniso: 0=No, 1=Yes + // Slot 1 -- DEPRECATED + // Slot 2 -- DEPRECATED + // Slot 3 -- DEPRECATED + // Slot 4 -- DEPRECATED + // Slot 5 -- DEPRECATED + // Slot 6 -- DEPRECATED + // Slot 7 -- Whether to use SPDE or 2D-AR1 hyper-distribution for spatial process: 0=SPDE; 1=2D-AR1; 2=Stream-network + // Slot 8 -- Whether to use F_ct or ignore it for speedup + // Options_list.Options + // Slot 0: Calculate SE for Index_xctl + // Slot 1: Calculate SE for log(Index_xctl) + // Slot 2: Calculate mean_Z_ctm (i.e., center-of-gravity) + // Slot 3: Calculate SE for D_i (expected density for every observation) + // Slot 4: Calculate mean_D_tl and effective_area_tl + // Slot 5: Calculate standard errors for Covariance and Correlation among categories using factor-analysis parameterization + // Slot 6: Calculate synchrony for different periods specified via yearbounds_zz + // Slot 7: Calculate coherence and variance for Epsilon1_sct and Epsilon2_sct + // Slot 8: Calculate proportions and SE + // Slot 9: Include normalization in GMRF PDF + // Slot 10: Calculate Fratio as F_ct divided by F achieving 40% of B0 + // Slot 11: Calculate B0 and Bratio + // Slot 12: Calculate Omegainput1_gf, Omegainput2_gf, Epsiloninput1_gft, Epsiloninput1_gft + // Slot 13: Calculate Treat year-category combinations with 0% encounters as 0 abundance (used for pre-processing, and doesn't affect CPP) + // Slot 14: Does bootstrap simulator simulate new realizations of random effects (default) or condition on estimated values for random effects + // Slot 15: Use CV for observation errors (default) or SD + // Slot 16: Report additional variables or skip to simplified output (default = FALSE) + // Slot 17: REDUNDANT + // Slot 18: REDUNDANT + // Slot 19: Complexity for calculation of lagrange_tc + // Slot 20: Value for lagrange_multiplier + // Options_list.yearbounds_zz + // Two columns, and 1+ rows, specifying first and last t for each period used in calculating synchrony + // Options_list.Expansion_cz + // Two columns and n_c rows. 1st column: Type of expansion (0=area-expansion; 1=biomass-expansion); 2nd column: Category used for biomass-expansion + // Options_list.overlap_zz + // Five columns and n_z rows. Columns: category and year for 1st variable, category and year for 2nd variable, type of overlap metric (0=Density of 2nd variable weighted by density of 1st) + // Options_list.zerosum_penalty + // Scalar (for now) indicating whether loadings matrices are not zero centered (value=0) or zero-centered, where the value is a penalty on squared-sum of loadings + // Options_list.trace_sum_penalty + // Scalar (for now) indicating whether loadings matrices have unconstrained magnitude (value=0) or have a sum-of-squares of 1.0 (value>0), where the value is a penalty on natural-log of sum-of-squared loadings values (i.e., trace of resulting covariance) + // Options_list.simulate_t + // Vector of length n_t indicating whether to include year in simulation ... useful for projecting forward conditional upon a fit + DATA_IMATRIX(FieldConfig); // Input settings (vector, length 4) + DATA_IVECTOR(RhoConfig); + DATA_IVECTOR(OverdispersionConfig); // Input settings (vector, length 2) + DATA_IMATRIX(ObsModel_ez); // Observation model + // Column 0: Probability distribution for data for each level of e_i + // 0: Normal + // 1: Lognormal + // 2: Gamma + // 3: Inverse-Gaussian (DEPRECATED IN INTERFACE, STILL BELOW FOR TESTING) + // 4: Lognormal using mean-CV + // 5: Zero-inflated negative binomial + // 7: Zero-inflated Poisson + // 9: Generalized Gamma-Lognormal + // 10: Tweedie + // 11: Zero-inflated lognormal Poisson + // 12: Poisson for combined data + // 13: Bernoulli for combined data + // 14: Lognormal-Poisson for combined data + // Column 1: Link function for linear predictors for each level of c_i + // NOTE: nlevels(c_i) must be <= nlevels(e_i) + DATA_IVECTOR(VamConfig); + // Slot 0 -- method for calculating n_c-by-n_c interaction matrix, B_ff + // Slot 1 -- rank of interaction matrix B_ff + // Slot 2 -- Timing of interactions; 0=Before correlated dynamics; 1=After correlated dynamics + // Current implementation only makes sense when (1) intercepts are constant among years; (2) using a Poisson-link delta model; (3) n_f=n_c for spatio-temporal variation; (4) starts near equilibrium manifold + DATA_IARRAY(X1config_cp); + // Methods for 1st component for each covariate in X_xtp (0=Off; 1=Estimate; 2=Estimate with zero-centered spatially varying coefficient; 3=Estimate with spatially varying coefficient; 4=Zero-centered spatially varying coefficient but replacing value with beta1_ct+beta2_ct + DATA_IARRAY(X2config_cp); + // Methods for 2nd component for each covariate in X_xtp (0=Off; 1=Estimate; 2=Estimate with zero-centered spatially varying coefficient; 3=Estimate with spatially varying coefficient; 4=Zero-centered spatially varying coefficient but replacing value with beta1_ct+beta2_ct) + DATA_IVECTOR(Q1config_k); + // Methods for 1st component for each covariate in Q1_ik (0=Off; 1=Estimate; 2=Estimate with zero-centered spatially varying coefficient; 3=Estimate with spatially varying coefficient) + DATA_IVECTOR(Q2config_k); + // Methods for 2nd component for each covariate in Q2_ik (0=Off; 1=Estimate; 2=Estimate with zero-centered spatially varying coefficient; 3=Estimate with spatially varying coefficient) + DATA_INTEGER(include_data); // Always use TRUE except for internal usage to extract GRMF normalization when turn off GMRF normalization in CPP + + // Data vectors + DATA_VECTOR(b_i); // Response (biomass) for each observation + DATA_VECTOR(a_i); // Area swept for each observation (km^2) + DATA_IMATRIX(c_iz); // Category for each observation + DATA_IVECTOR(e_i); // Error distribution for each observation + DATA_IVECTOR(t_i); // Time-index (year, season, etc.) for each observation + DATA_IVECTOR(v_i); // tows/vessels for each observation (level of factor representing overdispersion) + DATA_VECTOR(PredTF_i); // vector indicating whether an observatino is predictive (1=used for model evaluation) or fitted (0=used for parameter estimation) + DATA_MATRIX(a_gl); // Area for each "real" stratum(km^2) in each stratum + DATA_ARRAY(X1_ip); // Covariate design matrix (strata x covariate) + DATA_ARRAY(X1_gctp); // Covariate design matrix (strata x covariate) + DATA_ARRAY(X2_ip); // Covariate design matrix (strata x covariate) + DATA_ARRAY(X2_gctp); // Covariate design matrix (strata x covariate) + DATA_MATRIX(Q1_ik); // Catchability matrix (observations x variable) + DATA_MATRIX(Q2_ik); // Catchability matrix (observations x variable) + DATA_MATRIX(Z_gm); // Derived quantity matrix + DATA_MATRIX(F_ct); // Matrix of annual fishing mortality for each category + + // Spatial network inputs + DATA_IVECTOR(parent_s); // Columns: 0=Parent index, 1=Child index, 2=Distance from parent to child + DATA_IVECTOR(child_s); // Columns: 0=Parent index, 1=Child index, 2=Distance from parent to child + DATA_VECTOR(dist_s); // Columns: 0=Parent index, 1=Child index, 2=Distance from parent to child + + // SPDE objects + DATA_STRUCT(spde,spde_t); + + // Aniso objects + DATA_STRUCT(spde_aniso,spde_aniso_t); + + // Barrier object + DATA_STRUCT(spdeMatricesBarrier,spde_barrier_t); //Structure needed for the barrier procedure + DATA_VECTOR(Barrier_scaling); // Scaling of range + + // Sparse matrices for precision matrix of 2D AR1 process + // Q = M0*(1+rho^2)^2 + M1*(1+rho^2)*(-rho) + M2*rho^2 + DATA_SPARSE_MATRIX(M0); + DATA_SPARSE_MATRIX(M1); + DATA_SPARSE_MATRIX(M2); + + // Projection matrices from knots s to data i or extrapolation-grid cells x + DATA_IMATRIX( Ais_ij ); + DATA_VECTOR( Ais_x ); + DATA_IMATRIX( Ags_ij ); + DATA_VECTOR( Ags_x ); + + // Object used by TMBhelper::oneStepPredict_deltaMethod(.) + DATA_VECTOR_INDICATOR(keep, b_i); + + // Parameters + PARAMETER_VECTOR(ln_H_input); // Anisotropy parameters + PARAMETER_MATRIX(Chi_fr); // error correction responses + PARAMETER_MATRIX(Psi_fr); // error correction loadings, B_ff = Chi_fr %*% t(Psi_fr) + + // -- presence/absence fixed effects + PARAMETER_MATRIX(beta1_ft); // Year effect + PARAMETER_ARRAY(gamma1_cp); // Covariate effect + PARAMETER_VECTOR(lambda1_k); // Catchability coefficients + PARAMETER_VECTOR(L_eta1_z); // Overdispersion parameters + PARAMETER_VECTOR(L_omega1_z); + PARAMETER_VECTOR(L_epsilon1_z); + PARAMETER_VECTOR(L_beta1_z); + PARAMETER_VECTOR(Ltime_epsilon1_z); + PARAMETER(logkappa1); + PARAMETER_VECTOR(Beta_mean1_c); // mean-reversion for beta1_ft + PARAMETER_VECTOR(Beta_mean1_t); // mean-reversion for beta1_ft -- backdoor to allow crossed mean effects via manual mapping + PARAMETER_VECTOR(Beta_rho1_f); // AR1 for presence/absence Beta component, Default=0 + PARAMETER_VECTOR(Epsilon_rho1_f); // AR1 for presence/absence Epsilon component, Default=0 + PARAMETER_ARRAY(log_sigmaXi1_cp); // log-SD of Xi1_scp + PARAMETER_VECTOR(log_sigmaPhi1_k); // log-SD of Phi1_sk + + // -- presence/absence random effects + PARAMETER_MATRIX(eta1_vf); + PARAMETER_ARRAY(Xiinput1_scp); // spatially varying coefficient for density + PARAMETER_ARRAY(Phiinput1_sk); // spatially varying coefficient for catchability + PARAMETER_ARRAY(Omegainput1_sf); // Expectation + PARAMETER_ARRAY(Epsiloninput1_sff); // Annual variation + + // -- positive catch rates fixed effects + PARAMETER_MATRIX(beta2_ft); // Year effect + PARAMETER_ARRAY(gamma2_cp); // Covariate effect + PARAMETER_VECTOR(lambda2_k); // Catchability coefficients + PARAMETER_VECTOR(L_eta2_z); // Overdispersion parameters + PARAMETER_VECTOR(L_omega2_z); + PARAMETER_VECTOR(L_epsilon2_z); + PARAMETER_VECTOR(L_beta2_z); + PARAMETER_VECTOR(Ltime_epsilon2_z); + PARAMETER(logkappa2); + PARAMETER_VECTOR(Beta_mean2_c); // mean-reversion for beta2_ft + PARAMETER_VECTOR(Beta_mean2_t); // mean-reversion for beta2_ft -- backdoor to allow crossed mean effects via manual mapping + PARAMETER_VECTOR(Beta_rho2_f); // AR1 for positive catch Beta component, Default=0 + PARAMETER_VECTOR(Epsilon_rho2_f); // AR1 for positive catch Epsilon component, Default=0 + PARAMETER_ARRAY(log_sigmaXi2_cp); // log-SD of Xi2_scp + PARAMETER_VECTOR(log_sigmaPhi2_k); // log-SD of Phi2_sk + + // Error distribution parameters + PARAMETER_ARRAY(logSigmaM); + // Columns: 0=CV, 1=[usually not used], 2=[usually not used] + // Rows: Each level of e_i and/or c_i + // SigmaM[,0] indexed by e_i, e.g., SigmaM(e_i(i),0) + // SigmaM[,1] and SigmaM[,2] indexed by c_i, e.g., SigmaM(c_i(i),2) + + // Lagrange multipliers + PARAMETER_ARRAY(lagrange_tc); + + // -- positive catch rates random effects + PARAMETER_VECTOR(delta_i); + PARAMETER_MATRIX(eta2_vf); + PARAMETER_ARRAY(Xiinput2_scp); // spatially varying coefficient for density + PARAMETER_ARRAY(Phiinput2_sk); // spatially varying coefficient for catchability + PARAMETER_ARRAY(Omegainput2_sf); // Expectation + PARAMETER_ARRAY(Epsiloninput2_sff); // Annual variation + + //////////////////////// + // Preparatory bookkeeping + //////////////////////// + + // Indices -- i=Observation; t=Year; c=Category; p=Dynamic-covariate + int i,t,c,p,s,g,k; + + // Objective function + vector jnll_comp(22); + // Slot 0 -- spatial, encounter + // Slot 1 -- spatio-temporal, encounter + // Slot 2 -- spatial, positive catch + // Slot 3 -- spatio-temporal, positive catch + // Slot 4 -- tow/vessel overdispersion, encounter + // Slot 5 -- tow/vessel overdispersion, positive catch + // Slot 6 -- Deprecated + // Slot 7 -- Deprecated + // Slot 8 -- penalty on beta, encounter + // Slot 9 -- penalty on beta, positive catch + // Slot 10 -- likelihood of data, encounter + // Slot 11 -- likelihood of data, positive catch + // Slot 12 -- Likelihood of Lognormal-Poisson overdispersion delta_i + // Slot 13 -- penalty on estimate_B structure + // Slot 14 -- Spatially varying coefficient for density, encounter + // Slot 15 -- Spatially varying coefficient for density, positive catch + // Slot 16 -- Spatially varying coefficient for catchability, encounter + // Slot 17 -- Spatially varying coefficient for catchability, positive catch + // Slot 18 -- cdf aggregator for oneStepPredict_deltaModel + // Slot 19 -- Penalty for loadings-matrix zero-centering + // Slot 20 -- Penalty for Lagrange multipliers + // Slot 21 -- Epsilon method + jnll_comp.setZero(); + Type jnll = 0; + Type discard_nll = 0; + + // Unpack Options_list + vector Options_vec( Options_list.Options_vec.size() ); + Options_vec = Options_list.Options_vec; + vector Options( Options_list.Options.size() ); + Options = Options_list.Options; + matrix yearbounds_zz( Options_list.yearbounds_zz.rows(), 2 ); + yearbounds_zz = Options_list.yearbounds_zz; + matrix Expansion_cz( n_c, 2 ); + Expansion_cz = Options_list.Expansion_cz; + matrix overlap_zz( Options_list.overlap_zz.rows(), 5 ); + overlap_zz = Options_list.overlap_zz; + matrix zerosum_penalty( 1, 1 ); + zerosum_penalty = Options_list.zerosum_penalty; + vector trace_sum_penalty( 1 ); + trace_sum_penalty = Options_list.trace_sum_penalty; + vector simulate_t( n_t ); + simulate_t = Options_list.simulate_t; + + // Derived parameters + Type Range_raw1, Range_raw2; + if( Options_vec(7)==0 ){ + Range_raw1 = sqrt(8.0) / exp( logkappa1 ); // Range = approx. distance @ 10% correlation; use 8.0 to avoid ambiguity about type + Range_raw2 = sqrt(8.0) / exp( logkappa2 ); // Range = approx. distance @ 10% correlation; use 8.0 to avoid ambiguity about type + }else if( (Options_vec(7)==1) | (Options_vec(7)==2) ){ + Range_raw1 = log(0.1) / logkappa1; // Range = approx. distance @ 10% correlation + Range_raw2 = log(0.1) / logkappa2; // Range = approx. distance @ 10% correlation + }else{ + Range_raw1 = NAN; + Range_raw2 = NAN; + } + array SigmaM( n_e, 3 ); + array sigmaXi1_cp( n_c, n_p1 ); + array sigmaXi2_cp( n_c, n_p2 ); + vector sigmaPhi1_k( Q1_ik.cols() ); + vector sigmaPhi2_k( Q2_ik.cols() ); + SigmaM = exp( logSigmaM ); + sigmaXi1_cp = exp( log_sigmaXi1_cp ); + sigmaXi2_cp = exp( log_sigmaXi2_cp ); + sigmaPhi1_k = exp( log_sigmaPhi1_k ); + sigmaPhi2_k = exp( log_sigmaPhi2_k ); + + // Anisotropy elements + matrix H(2,2); + H(0,0) = exp(ln_H_input(0)); + H(1,0) = ln_H_input(1); + H(0,1) = ln_H_input(1); + H(1,1) = (1+ln_H_input(1)*ln_H_input(1)) / exp(ln_H_input(0)); + + // Deal with different treatments of tau + Type logtau1 = 0; + Type logtau2 = 0; + if( Options_vec(7)==0 ){ + logtau1 = log( 1.0 / (exp(logkappa1) * sqrt(4.0*M_PI)) ); + logtau2 = log( 1.0 / (exp(logkappa2) * sqrt(4.0*M_PI)) ); + } + if( Options_vec(7)==1 ){ + logtau1 = log( 1.0 / sqrt(1-exp(logkappa1*2.0)) ); + logtau2 = log( 1.0 / sqrt(1-exp(logkappa2*2.0)) ); + } + + // Dimensionality + // Do not use Epsiloninput1_sff.col(0).cols() because .cols() does not return a matrix when middle dimension has length-0 + int n_f1; + n_f1 = Epsiloninput1_sff.size() / (n_s * Epsiloninput1_sff.cols()); + int n_f2; + n_f2 = Epsiloninput2_sff.size() / (n_s * Epsiloninput2_sff.cols()); + + // Overwrite parameters when mirroring them + if( RhoConfig(1)==6 ){ + Beta_rho2_f = Beta_rho1_f; + } + if( RhoConfig(3)==6 ){ + Epsilon_rho2_f = Epsilon_rho1_f; + } + + // Form loadings matrices + matrix L_omega1_cf = create_loadings_general( L_omega1_z, n_c, FieldConfig(0,0), Type(0.0), Type(0.0), jnll_comp(19) ); + matrix L_omega2_cf = create_loadings_general( L_omega2_z, n_c, FieldConfig(0,1), Type(0.0), Type(0.0), jnll_comp(19) ); + matrix L_epsilon1_cf = create_loadings_general( L_epsilon1_z, n_c, FieldConfig(1,0), Type(0.0), Type(0.0), jnll_comp(19) ); + matrix L_epsilon2_cf = create_loadings_general( L_epsilon2_z, n_c, FieldConfig(1,1), Type(0.0), Type(0.0), jnll_comp(19) ); + matrix L_beta1_cf = create_loadings_general( L_beta1_z, n_c, FieldConfig(2,0), Type(0.0), Type(0.0), jnll_comp(19) ); + matrix L_beta2_cf = create_loadings_general( L_beta2_z, n_c, FieldConfig(2,1), Type(0.0), Type(0.0), jnll_comp(19) ); + matrix Ltime_epsilon1_tf = create_loadings_general( Ltime_epsilon1_z, n_t, FieldConfig(3,0), zerosum_penalty(0,0), trace_sum_penalty(0), jnll_comp(19) ); + matrix Ltime_epsilon2_tf = create_loadings_general( Ltime_epsilon2_z, n_t, FieldConfig(3,1), zerosum_penalty(0,0), trace_sum_penalty(0), jnll_comp(19) ); + matrix L_eta1_cf = create_loadings_general( L_eta1_z, n_c, OverdispersionConfig(0), Type(0.0), Type(0.0), jnll_comp(19) ); + matrix L_eta2_cf = create_loadings_general( L_eta2_z, n_c, OverdispersionConfig(1), Type(0.0), Type(0.0), jnll_comp(19) ); + + //////////////////////// + // Interactions and fishing mortality + //////////////////////// + + // Define interaction matrix for Epsilon1, and also the impact of F_ct on intercepts + matrix B_ff( n_f1, n_f1 ); // Interactions among factors + B_ff = calculate_B( VamConfig(0), n_f1, VamConfig(1), Chi_fr, Psi_fr, jnll_comp(13) ); + matrix iota_ct( n_c, n_t ); // Cumulative impact of fishing mortality F_ct in years <= current year t + matrix B1_cc( n_c, n_c ); // Interactions among categories + matrix covE1_cc( n_c, n_c ); + matrix B2_cc( n_c, n_c ); // Interactions among categories + matrix covE2_cc( n_c, n_c ); + matrix I_cc( n_c, n_c ); + matrix IminusB_cc( n_c, n_c ); + I_cc.setIdentity(); + B1_cc.setZero(); + B2_cc.setZero(); + covE1_cc.setZero(); + covE2_cc.setZero(); + // Calculate interaction matrix B_cc for categories if feasible + if( (n_c==n_f1) & (n_c==n_f2) & (FieldConfig(1,0)>0) & (FieldConfig(1,1)>0) ){ + matrix Cov_epsilon1_cc = L_epsilon1_cf * L_epsilon1_cf.transpose(); + matrix Cov_epsilon2_cc = L_epsilon2_cf * L_epsilon2_cf.transpose(); + matrix Btemp_cc( n_c, n_c ); + // Assemble interaction matrix + B1_cc = B_ff; + for( c=0; c Btarg_c( n_c ); + vector Ftarg_c( n_c ); + matrix Fratio_ct( n_c, n_t ); + IminusB_cc = I_cc - B1_cc; + Btarg_c = log( 0.4 ); // 40% target, transformed for log-link + Ftarg_c = -1 * ( IminusB_cc * Btarg_c ); + for( t=0; t sumB1_cc( n_c, n_c ); + IminusB_cc = I_cc - B1_cc; + sumB1_cc = IminusB_cc.inverse(); + iota_ct.col(0) -= sumB1_cc * F_ct.col(0); + } + if( (Options_vec(8)==1) | (Options_vec(8)==2) ){ + // Project forward effect of F_ct from initial year through current year + for( t=1; t Q1( n_s, n_s ); + Eigen::SparseMatrix Q2( n_s, n_s ); + GMRF_t gmrf_Q; + if( Options_vec(7)==0 ){ + if( Options_vec(0)==0 ){ + Q1 = Q_spde(spde, exp(logkappa1)); + Q2 = Q_spde(spde, exp(logkappa2)); + } + if( Options_vec(0)==1 ){ + Q1 = Q_spde(spde_aniso, exp(logkappa1), H); + Q2 = Q_spde(spde_aniso, exp(logkappa2), H); + } + } + if( Options_vec(7)==1 ){ + Q1 = M0*pow(1.0+exp(logkappa1*2.0),2.0) + M1*(1.0+exp(logkappa1*2.0))*(-exp(logkappa1)) + M2*exp(logkappa1*2.0); + Q2 = M0*pow(1.0+exp(logkappa2*2.0),2.0) + M1*(1.0+exp(logkappa2*2.0))*(-exp(logkappa2)) + M2*exp(logkappa2*2.0); + } + if( Options_vec(7)==2 ){ + Q1 = Q_network( logkappa1, n_s, parent_s, child_s, dist_s ); + Q2 = Q_network( logkappa2, n_s, parent_s, child_s, dist_s ); + } + if( Options_vec(7)==3 ){ + Q1 = Q_spde(spdeMatricesBarrier, exp(logkappa1), Barrier_scaling); + Q2 = Q_spde(spdeMatricesBarrier, exp(logkappa2), Barrier_scaling); + } + + array Zeros_s1(n_s, 1); + Zeros_s1.setZero(); + matrix Sigma_11(1,1); + array Tmp_s1(n_s, 1); + + ///// + // 1st component + ///// + gmrf_Q = GMRF( Q1, bool(Options(9)) ); + int simulate_var; + + // Omega1 + array Omegamean1_sf(n_s, Omegainput1_sf.cols() ); + Omegamean1_sf.setZero(); + array Omega1_sc(n_s, n_c); + Omegainput1_sf = gmrf_by_category_nll(FieldConfig(0,0), true, logtau1, VamConfig(2), n_s, n_c, logkappa1, Omegainput1_sf, Omegamean1_sf, L_omega1_cf, gmrf_Q, Options(14), jnll_comp(0), this); + Omega1_sc = (Omegainput1_sf.matrix() * L_omega1_cf.transpose()) / exp(logtau1); + + // Projection for Omega1 + array Omega1_iz(n_i, c_iz.cols()); + Omega1_iz.setZero(); + for( int Arow=0; Arow=0) & (c_iz(i,zc) Tmp_st( n_s, n_t ); + array Epsiloninput1_sft( n_s, n_f1, n_t ); + Epsiloninput1_sft.setZero(); + bool include_epsilon_prob_1; + if( FieldConfig(3,0) > 0 ){ + include_epsilon_prob_1 = false; + int n_t1 = Epsiloninput1_sff.cols(); + array Tmp1_sf( n_s, n_t1 ); + array Zeros1_sf( n_s, n_t1 ); + Zeros1_sf.setZero(); + for( int f1=0; f1 Epsilonmean1_sf(n_s, n_f1 ); + // PDF for Epsilon1 + array Epsilon1_sct(n_s, n_c, n_t); + array Temp1_sf( n_s, n_f1 ); + for(t=0; t 0 ){ + Epsiloninput1_sft.col(t) = gmrf_by_category_nll(FieldConfig(1,0), include_epsilon_prob_1, logtau1, VamConfig(2), n_s, n_c, logkappa1, Temp1_sf, Epsilonmean1_sf, L_epsilon1_cf, gmrf_Q, simulate_var, jnll_comp(1), this); + Epsilon1_sct.col(t) = (Epsiloninput1_sft.col(t).matrix() * L_epsilon1_cf.transpose()) / exp(logtau1); + } + } + // PDF for subsequent years of autoregression + if( t>=(Options(11)+1) ){ + // Prediction for spatio-temporal component + // Default, and also necessary whenever VamConfig(2)==1 & n_f1!=n_c + if( (VamConfig(0)==0) | ((n_f1!=n_c) & (VamConfig(2)==1)) ){ + // If no interactions, then just autoregressive for factors + for(s=0; s 0 ){ + Epsiloninput1_sft.col(t) = gmrf_by_category_nll(FieldConfig(1,0), include_epsilon_prob_1, logtau1, VamConfig(2), n_s, n_c, logkappa1, Temp1_sf, Epsilonmean1_sf, L_epsilon1_cf, gmrf_Q, simulate_var, jnll_comp(1), this); + Epsilon1_sct.col(t) = (Epsiloninput1_sft.col(t).matrix() * L_epsilon1_cf.transpose()) / exp(logtau1); + } + }else{ + //// Impact of interactions, B_ff + //Epsilonmean1_sf.setZero(); + //for(s=0; s Epsilon1_iz(n_i, c_iz.cols()); + Epsilon1_iz.setZero(); + for( int Arow=0; Arow=0) & (c_iz(i,zc) Xi1_scp(n_s, n_c, n_p1); + Xi1_scp.setZero(); + for(p=0; p Xi1_izp(n_i, c_iz.cols(), n_p1); + Xi1_izp.setZero(); + for( int Arow=0; Arow=0) & (c_iz(i,zc) Phi1_sk(n_s, Q1_ik.cols()); + Phi1_sk.setZero(); + for(k=0; k Phi1_ik(n_i, Q1_ik.cols()); + Phi1_ik.setZero(); + for( int Arow=0; Arow Omegamean2_sf(n_s, Omegainput2_sf.cols() ); + Omegamean2_sf.setZero(); + array Omega2_sc(n_s, n_c); + Omegainput2_sf = gmrf_by_category_nll(FieldConfig(0,1), true, logtau2, VamConfig(2), n_s, n_c, logkappa2, Omegainput2_sf, Omegamean2_sf, L_omega2_cf, gmrf_Q, Options(14), jnll_comp(2), this); + Omega2_sc = (Omegainput2_sf.matrix() * L_omega2_cf.transpose()) / exp(logtau2); + + // Projection for Omega2 + array Omega2_iz(n_i, c_iz.cols()); + Omega2_iz.setZero(); + for( int Arow=0; Arow=0) & (c_iz(i,zc) Epsiloninput2_sft( n_s, n_f2, n_t ); + Epsiloninput2_sft.setZero(); + bool include_epsilon_prob_2; + if( FieldConfig(3,1) > 0 ){ + include_epsilon_prob_2 = false; + int n_t2 = Epsiloninput2_sff.cols(); + array Tmp2_sf( n_s, n_t2 ); + array Zeros2_sf( n_s, n_t2 ); + Zeros2_sf.setZero(); + for( int f1=0; f1 Epsilonmean2_sf(n_s, n_f2); + // PDF for Epsilon2 + array Epsilon2_sct(n_s, n_c, n_t); + array Temp2_sf( n_s, n_f2 ); + for(t=0; t 0 ){ + Epsiloninput2_sft.col(t) = gmrf_by_category_nll(FieldConfig(1,1), include_epsilon_prob_2, logtau2, VamConfig(2), n_s, n_c, logkappa2, Temp2_sf, Epsilonmean2_sf, L_epsilon2_cf, gmrf_Q, simulate_var, jnll_comp(3), this); + Epsilon2_sct.col(t) = (Epsiloninput2_sft.col(t).matrix() * L_epsilon2_cf.transpose()) / exp(logtau2); + } + } + // PDF for subsequent years of autoregression + if( t>=(Options(11)+1) ){ + // Prediction for spatio-temporal component + // Default, and also necessary whenever VamConfig(2)==1 & n_f2!=n_c + if( (VamConfig(0)==0) | ((n_f2!=n_c) & (VamConfig(2)==1)) ){ + // If no interactions, then just autoregressive for factors + for(s=0; s 0 ){ + Epsiloninput2_sft.col(t) = gmrf_by_category_nll(FieldConfig(1,1), include_epsilon_prob_2, logtau2, VamConfig(2), n_s, n_c, logkappa2, Temp2_sf, Epsilonmean2_sf, L_epsilon2_cf, gmrf_Q, simulate_var, jnll_comp(3), this); + Epsilon2_sct.col(t) = (Epsiloninput2_sft.col(t).matrix() * L_epsilon2_cf.transpose()) / exp(logtau2); + } + }else{ + //// Impact of interactions, B_ff + //Epsilonmean2_sf.setZero(); + //for(s=0; s Epsilon2_iz(n_i, c_iz.cols()); + Epsilon2_iz.setZero(); + for( int Arow=0; Arow=0) & (c_iz(i,zc) Ximean2_sc(n_s, 1); + array Xi2_scp(n_s, n_c, n_p2); + matrix Sigma2_cf(1,1); + array Tmp2_sc(n_s, 1); + Ximean2_sc.setZero(); + Xi2_scp.setZero(); + for(p=0; p Xi2_izp(n_i, c_iz.cols(), n_p2); + Xi2_izp.setZero(); + for( int Arow=0; Arow=0) & (c_iz(i,zc) Phi2_sk(n_s, Q2_ik.cols()); + Phi2_sk.setZero(); + for(k=0; k Phi2_ik(n_i, Q2_ik.cols()); + Phi2_ik.setZero(); + for( int Arow=0; Arow eta1_mean_vf(n_v, n_eta_f1); +// eta1_mean_vf.setZero(); + matrix eta1_vc(n_v, n_c); + //eta1_vc = covariation_by_category_nll( OverdispersionConfig(0), n_v, n_c, eta1_vf, eta1_mean_vf, L_eta1_cf, Options(14), jnll_comp(4), this ); + if( (OverdispersionConfig(0) != -1) & (OverdispersionConfig(0) != -3) ){ + for( int v=0; v eta2_mean_vf(n_v, n_eta_f2); +// eta2_mean_vf.setZero(); + matrix eta2_vc(n_v, n_c); + //eta2_vc = covariation_by_category_nll( OverdispersionConfig(1), n_v, n_c, eta2_vf, eta2_mean_vf, L_eta2_cf, Options(14), jnll_comp(5), this ); + if( (OverdispersionConfig(1) != -1) & (OverdispersionConfig(1) != -3) ){ + for( int v=0; v beta1_mean_tf(n_t, n_beta_f1); + beta1_mean_tf.setZero(); + matrix beta1_tf( n_t, n_beta_f1 ); + beta1_tf = beta1_ft.transpose(); + //for( int f=0; f=1){ + beta1_mean_tf(t,f) = beta1_tf(t-1,f) * Beta_rho1_f(f); + } + jnll_beta1 -= dnorm( beta1_tf(t,f), beta1_mean_tf(t,f), Type(1.0), true ); + // Simulate new values when using obj.simulate() + if( (Options(14) == 1) | (simulate_t(t) == 1) ){ + SIMULATE{ + beta1_tf(t,f) = rnorm( beta1_mean_tf(t,f), Type(1.0) ); + } + } + }} + } + matrix beta1_tc(n_t, n_c); + //vector simulate_vec( n_t ); + //simulate_vec = Options(14) + simulate_t; // + //beta1_tc = covariation_by_category_nll( FieldConfig(2,0), n_t, n_c, beta1_tf, beta1_mean_tf, L_beta1_cf, simulate_vec, jnll_beta1, this ); + beta1_tc = beta1_tf * L_beta1_cf.transpose(); + for( c=0; c beta2_mean_tf(n_t, n_beta_f2); + beta2_mean_tf.setZero(); + matrix beta2_tf( n_t, n_beta_f2 ); + beta2_tf = beta2_ft.transpose(); + //for( int f=0; f=1){ + beta2_mean_tf(t,f) = beta2_tf(t-1,f) * Beta_rho2_f(f); + } + jnll_beta2 -= dnorm( beta2_tf(t,f), beta2_mean_tf(t,f), Type(1.0), true ); + // Simulate new values when using obj.simulate() + if( (Options(14) == 1) | (simulate_t(t) == 1) ){ + SIMULATE{ + beta2_tf(t,f) = rnorm( beta2_mean_tf(t,f), Type(1.0) ); + } + } + }} + } + matrix beta2_tc(n_t, n_c); + //beta2_tc = covariation_by_category_nll( FieldConfig(2,1), n_t, n_c, beta2_tf, beta2_mean_tf, L_beta2_cf, simulate_vec, jnll_beta2, this ); + beta2_tc = beta2_tf * L_beta2_cf.transpose(); + for( c=0; c lagrangeprime_tc( n_t, n_c ); + if( (Options(19)==1) | (Options(19)==2) | (Options(19)==3) | (Options(19)==4) ){ + // Overload input values + lagrangeprime_tc.setZero(); + for(c=0; c zeta1_i(n_i); + zeta1_i.setZero(); + for( i=0; i zeta2_i(n_i); + zeta2_i.setZero(); + for( i=0; i eta1_iz(n_i, c_iz.cols()); + eta1_iz.setZero(); + for( p=0; p eta2_iz(n_i, c_iz.cols()); + eta2_iz.setZero(); + for( p=0; p var_i(n_i); + Type pred_jnll = 0; + Type cdf_for_single_obs; + Type tmp_calc1; + Type tmp_calc2; + Type log_tmp_calc2; + // Linear predictor (pre-link) for presence/absence component + matrix P1_iz(n_i,c_iz.cols()); + // Response predictor (post-link) + // ObsModel_ez(e,0) = 0:3 -- probability ("phi") that data is greater than zero + vector R1_i(n_i); + vector log_one_minus_R1_i(n_i); + vector log_R1_i(n_i); + vector LogProb1_i(n_i); + // Linear predictor (pre-link) for positive component + matrix P2_iz(n_i,c_iz.cols()); + // Response predictor (post-link) + // ObsModel_ez(e,0) = 0:3 -- expected value of data, given that data is greater than zero -> E[D] = mu*phi + vector R2_i(n_i); + vector log_R2_i(n_i); + vector LogProb2_i(n_i); + vector maxJ_i(n_i); + vector diag_z(4); + matrix diag_iz(n_i,4); + diag_iz.setZero(); // Used to track diagnostics for Tweedie distribution (columns: 0=maxJ; 1=maxW; 2=lowerW; 3=upperW) + P1_iz.setZero(); + P2_iz.setZero(); + LogProb1_i.setZero(); + LogProb2_i.setZero(); + + // Calculate deviance relative to saturated model, where: + // percent_deviance_explained = 1 - deviance_fit / deviance_null + // deviance_fit = sum(deviance1_i) + sum(deviance2_i) + // deviance_null = deviance_fit when using only single intercepts for both linear predictors + // Calculations: + // Gamma -- https://stats.stackexchange.com/questions/474326/deviance-for-gamma-glm + // Bernoulli -- https://stats.stackexchange.com/questions/208331/how-to-derive-bernoulli-deviance + // Normal -- https://en.wikipedia.org/wiki/Deviance_(statistics)#Examples + vector deviance1_i(n_i); + vector deviance2_i(n_i); + deviance1_i.setZero(); + deviance2_i.setZero(); + + // Likelihood contribution from observations + Type logsd; + for(i=0; i=0) & (c_iz(i,zc)=0) & (v_i(i)=0) & (c_iz(i,zc)=1 ) log_tmp_calc2 = logspace_add( log_tmp_calc2, P1_iz(i,zc) + P2_iz(i,zc) ); + } + } + R1_i(i) = Type(1.0) - exp( -1*a_i(i)*tmp_calc1 ); + R2_i(i) = a_i(i) * tmp_calc2 / R1_i(i); + // Calulate in logspace to prevent numerical over/under-flow + log_R1_i(i) = logspace_sub( Type(0.0), -1*a_i(i)*tmp_calc1 ); + log_one_minus_R1_i(i) = -1*a_i(i)*tmp_calc1; + log_R2_i(i) = log(a_i(i)) + log_tmp_calc2 - log_R1_i(i); + } + if( ObsModel_ez(e_i(i),1)==2 ){ + // Tweedie link, where area-swept affects numbers density exp(P1_i(i)) + // P1_i: Log-numbers density; R1_i: Expected numbers + // P2_i: Log-average weight; R2_i: Expected average weight + R1_i(i) = a_i(i) * exp( P1_iz(i,0) ); + R2_i(i) = exp( P2_iz(i,0) ); + // Calulate in logspace to prevent numerical over/under-flow + log_R1_i(i) = log(a_i(i)) + P1_iz(i,0); + log_one_minus_R1_i(i) = logspace_sub(Type(0.0), log(a_i(i)) + P1_iz(i,0) ); + log_R2_i(i) = P2_iz(i,0); + } + // Likelihood for delta-models with continuous positive support + if( (ObsModel_ez(e_i(i),0)==0) | (ObsModel_ez(e_i(i),0)==1) | (ObsModel_ez(e_i(i),0)==2) | (ObsModel_ez(e_i(i),0)==3) | (ObsModel_ez(e_i(i),0)==4) | (ObsModel_ez(e_i(i),0)==9) ){ + // Presence-absence likelihood + // deviance1_fit = -2 * sum( y*log(mu) + (1-y)*log(1-mu) ) + if( b_i(i) > 0 ){ + LogProb1_i(i) = log_R1_i(i); + deviance1_i(i) = -2 * log_R1_i(i); + }else{ + LogProb1_i(i) = log_one_minus_R1_i(i); + deviance1_i(i) = -2 * log_one_minus_R1_i(i); + } + // CDF + cdf_for_single_obs = squeeze(1.0 - R1_i(i)); + // Simulate new values when using obj.simulate() + SIMULATE{ + b_i(i) = rbinom( Type(1), R1_i(i) ); + } + // Positive density likelihood -- models with continuous positive support + if( b_i(i) > 0 ){ // 1e-500 causes overflow on laptop + // Normal distribution + // deviance2_fit = sum( (y-mu)^2 ) + if(ObsModel_ez(e_i(i),0)==0){ + LogProb2_i(i) = dnorm(b_i(i), R2_i(i), SigmaM(e_i(i),0), true); + deviance2_i(i) = square( b_i(i) - R2_i(i) ); + // Simulate new values when using obj.simulate() + SIMULATE{ + b_i(i) = rnorm( R2_i(i), SigmaM(e_i(i),0) ); + } + } + // Lognormal; mean, sd (in log-space) parameterization + // deviance2_fit = sum( (log(y)-log(mu))^2 ) + if(ObsModel_ez(e_i(i),0)==1){ + LogProb2_i(i) = dlnorm(b_i(i), log_R2_i(i)-square(SigmaM(e_i(i),0))/2, SigmaM(e_i(i),0), true); // log-space + deviance2_i(i) = square( log(b_i(i)) - (log_R2_i(i)-square(SigmaM(e_i(i),0))/2) ); + // CDF for oneStepPredict_deltaModel + //cdf += (1.0-R1_i(i))*pnorm(log(b_i), log_R2_i(i)-square(SigmaM(e_i(i),0))/2, SigmaM(e_i(i),0)); + cdf_for_single_obs += squeeze(R1_i(i)) * pnorm(log(b_i(i)), log_R2_i(i)-square(SigmaM(e_i(i),0))/2, SigmaM(e_i(i),0)); + // Simulate new values when using obj.simulate() + SIMULATE{ + b_i(i) = exp(rnorm( log_R2_i(i)-square(SigmaM(e_i(i),0))/2, SigmaM(e_i(i),0) )); + } + } + // Gamma; mean, CV parameterization (converting to shape, scale) + // deviance2_fit = 2 * sum( (y-mu)/mu - log(y/mu) ) + if(ObsModel_ez(e_i(i),0)==2){ + if( Options(15)==1 ){ + // shape = 1/CV^2; scale = mean*CV^2 + LogProb2_i(i) = dgamma(b_i(i), 1/square(SigmaM(e_i(i),0)), R2_i(i)*square(SigmaM(e_i(i),0)), true); + deviance2_i(i) = 2 * ( (b_i(i)-R2_i(i))/R2_i(i) - log(b_i(i)/R2_i(i)) ); + // CDF for oneStepPredict_deltaModel + cdf_for_single_obs += squeeze(R1_i(i)) * pgamma(b_i(i), 1/square(SigmaM(e_i(i),0)), R2_i(i)*square(SigmaM(e_i(i),0))); + // Simulate new values when using obj.simulate() + SIMULATE{ + b_i(i) = rgamma( 1/square(SigmaM(e_i(i),0)), R2_i(i)*square(SigmaM(e_i(i),0)) ); + } + }else{ + // shape = mean^2 / sd^2; scale = sd^2 / mean + LogProb2_i(i) = dgamma(b_i(i), square(R2_i(i))/square(SigmaM(e_i(i),0)), square(SigmaM(e_i(i),0))/R2_i(i), true); + deviance2_i(i) = NAN; + // CDF for oneStepPredict_deltaModel + cdf_for_single_obs += squeeze(R1_i(i)) * pgamma(b_i(i), square(R2_i(i))/square(SigmaM(e_i(i),0)), square(SigmaM(e_i(i),0))/R2_i(i)); + // Simulate new values when using obj.simulate() + SIMULATE{ + b_i(i) = rgamma( square(R2_i(i))/square(SigmaM(e_i(i),0)), square(SigmaM(e_i(i),0))/R2_i(i) ); + } + } + } + // Inverse-Gaussian; mean, CV parameterization + if(ObsModel_ez(e_i(i),0)==3){ + if( Options(15)==1 ){ + LogProb2_i(i) = dinverse_gaussian(b_i(i), R2_i(i), SigmaM(e_i(i),0), true); + }else{ + LogProb2_i(i) = dinverse_gaussian(b_i(i), R2_i(i), SigmaM(e_i(i),0)/R2_i(i), true); + } + deviance2_i(i) = NAN; + // Simulate new values when using obj.simulate() + SIMULATE{ + b_i(i) = Type(1.0); // Simulate as 1.0 so b_i distinguishes between simulated encounter/non-encounters + } + } + // Lognormal; mean, CV (in logspace) parameterization + if(ObsModel_ez(e_i(i),0)==4){ + if( Options(15)==1 ){ + // CV = sqrt( exp(logsd^2)-1 ), therefore + // logSD = sqrt( log(CV^2 + 1) ) = sqrt(log(square(SigmaM(e_i(i),0))+1)) + logsd = sqrt( log(square(SigmaM(e_i(i),0))+1) ); + }else{ + // CV = sd / mean, therefore + logsd = sqrt( log(square( SigmaM(e_i(i),0) / R2_i(i) )+1) ); + } + LogProb2_i(i) = dlnorm(b_i(i), log_R2_i(i)-square(logsd)/2, logsd, true); // log-space + deviance2_i(i) = square( log(b_i(i)) - (log_R2_i(i)-square(logsd)/2) ); + // Simulate new values when using obj.simulate() + SIMULATE{ + b_i(i) = exp(rnorm( log_R2_i(i)-square(logsd)/2, logsd )); + } + } + // Generalized-gamma; mean, sigma, lambda parameterization + if(ObsModel_ez(e_i(i),0)==9){ + LogProb2_i(i) = dgengamma(b_i(i), R2_i(i), SigmaM(e_i(i),0), logSigmaM(e_i(i),1), true); + deviance2_i(i) = NAN; + // Simulate new values when using obj.simulate() + // Could be updated, available as rgengamma.orig + SIMULATE{ + b_i(i) = rgengamma(R2_i(i), SigmaM(e_i(i),0), SigmaM(e_i(i),1)); + } + } + }else{ + LogProb2_i(i) = 0; + } + } + // Likelihood #2 for Tweedie model with continuous positive support + if(ObsModel_ez(e_i(i),0)==10){ + // Packaged code + LogProb1_i(i) = 0; + // dtweedie( Type y, Type mu, Type phi, Type p, int give_log=0 ) + // R1*R2 = mean + LogProb2_i(i) = dtweedie( b_i(i), R1_i(i)*R2_i(i), R1_i(i), invlogit(logSigmaM(e_i(i),0))+Type(1.0), true ); + deviance2_i(i) = deviance_tweedie( b_i(i), R1_i(i)*R2_i(i), invlogit(logSigmaM(e_i(i),0))+Type(1.0) ); + // Simulate new values when using obj.simulate() + SIMULATE{ + b_i(i) = rTweedie( R1_i(i)*R2_i(i), R1_i(i), invlogit(logSigmaM(e_i(i),0))+Type(1.0) ); // Defined above + } + } + ///// Likelihood for models with discrete support + // Zero-inflated negative binomial (not numerically stable!) + if(ObsModel_ez(e_i(i),0)==5){ + var_i(i) = R2_i(i)*(1.0+SigmaM(e_i(i),0)) + pow(R2_i(i),2.0)*SigmaM(c_iz(i,0),1); + if( b_i(i)==0 ){ + //LogProb2_i(i) = log( (1-R1_i(i)) + dnbinom2(Type(0.0), R2_i(i), var_i(i), false)*R1_i(i) ); // Pr[X=0] = 1-phi + NB(X=0)*phi + LogProb2_i(i) = logspace_add( log(1.0-R1_i(i)), dnbinom2(Type(0.0),R2_i(i),var_i(i),true)+log(R1_i(i)) ); // Pr[X=0] = 1-phi + NB(X=0)*phi + }else{ + LogProb2_i(i) = dnbinom2(b_i(i), R2_i(i), var_i(i), true) + log(R1_i(i)); // Pr[X=x] = NB(X=x)*phi + } + deviance2_i(i) = NAN; + // Simulate new values when using obj.simulate() + SIMULATE{ + b_i(i) = rbinom( Type(1), R1_i(i) ); + if( b_i(i)>0 ){ + b_i(i) = rnbinom2( R2_i(i), var_i(i) ); + } + } + } + // Zero-inflated Poisson + if(ObsModel_ez(e_i(i),0)==7){ + if( b_i(i)==0 ){ + //LogProb2_i(i) = log( (1-R1_i(i)) + dpois(Type(0.0), R2_i(i), false)*R1_i(i) ); // Pr[X=0] = 1-phi + Pois(X=0)*phi + LogProb2_i(i) = logspace_add( log(1-R1_i(i)), dpois(Type(0.0),R2_i(i),true)+log(R1_i(i)) ); // Pr[X=0] = 1-phi + Pois(X=0)*phi + }else{ + LogProb2_i(i) = dpois(b_i(i), R2_i(i), true) + log(R1_i(i)); // Pr[X=x] = Pois(X=x)*phi + } + deviance2_i(i) = NAN; + // Simulate new values when using obj.simulate() + SIMULATE{ + b_i(i) = rbinom( Type(1), R1_i(i) ); + if( b_i(i)>0 ){ + b_i(i) = rpois( R2_i(i) ); + } + } + } + // Zero-inflated Lognormal Poisson + if(ObsModel_ez(e_i(i),0)==11){ + if( b_i(i)==0 ){ + //LogProb2_i(i) = log( (1-R1_i(i)) + dpois(Type(0.0), R2_i(i), false)*R1_i(i) ); // Pr[X=0] = 1-phi + Pois(X=0)*phi + LogProb2_i(i) = logspace_add( log(1.0-R1_i(i)), dpois(Type(0.0),R2_i(i)*exp(SigmaM(e_i(i),0)*delta_i(i)-0.5*pow(SigmaM(e_i(i),0),2)),true)+log(R1_i(i)) ); // Pr[X=0] = 1-phi + Pois(X=0)*phi + }else{ + LogProb2_i(i) = dpois(b_i(i), R2_i(i)*exp(SigmaM(e_i(i),0)*delta_i(i)-0.5*pow(SigmaM(e_i(i),0),2.0)), true) + log(R1_i(i)); // Pr[X=x] = Pois(X=x)*phi + } + deviance2_i(i) = NAN; + // Simulate new values when using obj.simulate() + SIMULATE{ + b_i(i) = rbinom( Type(1), R1_i(i) ); + if( b_i(i)>0 ){ + b_i(i) = rpois( R2_i(i)*exp(SigmaM(e_i(i),0)*delta_i(i)-0.5*pow(SigmaM(e_i(i),0),2.0)) ); + } + } + } + // Non-zero-inflated Poisson using log link from 1st linear predictor + if(ObsModel_ez(e_i(i),0)==12){ + LogProb2_i(i) = dpois(b_i(i), R1_i(i), true); + // Simulate new values when using obj.simulate() + deviance2_i(i) = NAN; + SIMULATE{ + b_i(i) = rpois( R1_i(i) ); + } + } + // Non-zero-inflated Bernoulli using cloglog link from 1st lilnear predict + if(ObsModel_ez(e_i(i),0)==13){ + if( b_i(i)==0 ){ + LogProb2_i(i) = dpois(Type(0), R1_i(i), true); + }else{ + LogProb2_i(i) = logspace_sub( log(Type(1.0)), dpois(Type(0), R1_i(i), true) ); + } + deviance2_i(i) = NAN; + // Simulate new values when using obj.simulate() + SIMULATE{ + b_i(i) = rpois( R1_i(i) ); + if( b_i(i)>0 ){ + b_i(i) = 1; + } + } + } + // Non-zero-inflated Lognormal-Poisson using log link from 1st linear predictor + if(ObsModel_ez(e_i(i),0)==14){ + LogProb2_i(i) = dpois(b_i(i), R1_i(i)*exp(SigmaM(e_i(i),0)*delta_i(i)-0.5*pow(SigmaM(e_i(i),0),2.0)), true); + deviance2_i(i) = NAN; + // Simulate new values when using obj.simulate() + SIMULATE{ + b_i(i) = rpois( R1_i(i)*exp(SigmaM(e_i(i),0)*delta_i(i)-0.5*pow(SigmaM(e_i(i),0),2.0)) ); + } + } + + // Aggregate + jnll_comp(10) -= keep(i) * LogProb1_i(i) * (Type(1.0)-PredTF_i(i)); + jnll_comp(11) -= keep(i) * LogProb2_i(i) * (Type(1.0)-PredTF_i(i)); + // CDF aggregator + jnll_comp(18) -= keep.cdf_lower(i) * log( squeeze(cdf_for_single_obs) ); + jnll_comp(18) -= keep.cdf_upper(i) * log( 1.0 - squeeze(cdf_for_single_obs) ); + // Predictive jnll aggregator + pred_jnll -= (LogProb1_i(i) + LogProb2_i(i)) * PredTF_i(i); + } + } + REPORT( diag_iz ); + + //////////////////////// + // Calculate index of abundance and density + //////////////////////// + + if( n_g > 0 ){ + + // Projection for Omega1 + array Omega1_gc(n_g, n_c); + Omega1_gc.setZero(); + Omega1_gc = project_knots( n_g, n_c, int(1), int(0), Omega1_sc, Ags_ij, Ags_x ); + + // Projection for Epsilon1 + array Epsilon1_gct(n_g, n_c, n_t); + Epsilon1_gct.setZero(); + Epsilon1_gct = project_knots( n_g, n_c, n_t, int(1), Epsilon1_sct, Ags_ij, Ags_x ); + + // Projection for Xi1 + array Xi1_gcp(n_g, n_c, n_p1); + Xi1_gcp.setZero(); + Xi1_gcp = project_knots( n_g, n_c, n_p1, int(1), Xi1_scp, Ags_ij, Ags_x ); + + // Projection for Phi1 + array Phi1_gk(n_g, Q1_ik.cols()); + Phi1_gk.setZero(); + Phi1_gk = project_knots( n_g, Q1_ik.cols(), int(1), int(0), Phi1_sk, Ags_ij, Ags_x ); + + // Projection for Omega2 + array Omega2_gc(n_g, n_c); + Omega2_gc.setZero(); + Omega2_gc = project_knots( n_g, n_c, int(1), int(0), Omega2_sc, Ags_ij, Ags_x ); + + // Projection for Epsilon2 + array Epsilon2_gct(n_g, n_c, n_t); + Epsilon2_gct.setZero(); + Epsilon2_gct = project_knots( n_g, n_c, n_t, int(1), Epsilon2_sct, Ags_ij, Ags_x ); + + // Projection for Xi2 + array Xi2_gcp(n_g, n_c, n_p2); + Xi2_gcp.setZero(); + Xi2_gcp = project_knots( n_g, n_c, n_p2, int(1), Xi2_scp, Ags_ij, Ags_x ); + + // Projection for Phi2 + array Phi2_gk(n_g, Q2_ik.cols()); + Phi2_gk.setZero(); + Phi2_gk = project_knots( n_g, Q2_ik.cols(), int(1), int(0), Phi2_sk, Ags_ij, Ags_x ); + + //////////////////////// + // Covariate effects + //////////////////////// + + // If using spatially varying response to intercepts, replace covariate values + for(c=0; c eta1_gct(n_g, n_c, n_t); + eta1_gct.setZero(); + for(p=0; p eta2_gct(n_g, n_c, n_t); + eta2_gct.setZero(); + for(p=0; p P1_gct(n_g, n_c, n_t); + array R1_gct(n_g, n_c, n_t); + array P2_gct(n_g, n_c, n_t); + array R2_gct(n_g, n_c, n_t); + array D_gct(n_g, n_c, n_t); + for(c=0; c Index_gctl(n_g, n_c, n_t, n_l); + array Index_ctl(n_c, n_t, n_l); + array ln_Index_ctl(n_c, n_t, n_l); + Index_ctl.setZero(); + for(t=0; t 0) { + Type S; + for(c=0; c jnll_lagrange_ct(c,t); + jnll_lagrange_ct.setZero(); + for( c=0; c Bratio_ctl(n_c, n_t, n_l); + array ln_Bratio_ctl(n_c, n_t, n_l); + for(c=0; c mean_Z_ctm(n_c, n_t, n_m); + if( Options(2)==1 ){ + mean_Z_ctm.setZero(); + int report_summary_TF = false; + for(c=0; c mean_D_ctl(n_c, n_t, n_l); + array log_mean_D_ctl(n_c, n_t, n_l); + mean_D_ctl.setZero(); + for(c=0; c effective_area_ctl(n_c, n_t, n_l); + array log_effective_area_ctl(n_c, n_t, n_l); + effective_area_ctl = Index_ctl / mean_D_ctl; // Correct for different units of Index and density + log_effective_area_ctl = log( effective_area_ctl ); + REPORT( effective_area_ctl ); + ADREPORT( effective_area_ctl ); + ADREPORT( log_effective_area_ctl ); + } + + // Reporting and standard-errors for covariance and correlation matrices + if( Options(5)==1 ){ + if( FieldConfig(0,0)>0 ){ + matrix lowercov_uppercor_omega1 = L_omega1_cf * L_omega1_cf.transpose(); + lowercov_uppercor_omega1 = convert_upper_cov_to_cor( lowercov_uppercor_omega1 ); + REPORT( lowercov_uppercor_omega1 ); + ADREPORT( lowercov_uppercor_omega1 ); + } + if( FieldConfig(1,0)>0 ){ + matrix lowercov_uppercor_epsilon1 = L_epsilon1_cf * L_epsilon1_cf.transpose(); + lowercov_uppercor_epsilon1 = convert_upper_cov_to_cor( lowercov_uppercor_epsilon1 ); + REPORT( lowercov_uppercor_epsilon1 ); + ADREPORT( lowercov_uppercor_epsilon1 ); + } + if( FieldConfig(2,0)>0 ){ + matrix lowercov_uppercor_beta1 = L_beta1_cf * L_beta1_cf.transpose(); + lowercov_uppercor_beta1 = convert_upper_cov_to_cor( lowercov_uppercor_beta1 ); + REPORT( lowercov_uppercor_beta1 ); + ADREPORT( lowercov_uppercor_beta1 ); + } + if( FieldConfig(0,1)>0 ){ + matrix lowercov_uppercor_omega2 = L_omega2_cf * L_omega2_cf.transpose(); + lowercov_uppercor_omega2 = convert_upper_cov_to_cor( lowercov_uppercor_omega2 ); + REPORT( lowercov_uppercor_omega2 ); + ADREPORT( lowercov_uppercor_omega2 ); + } + if( FieldConfig(1,1)>0 ){ + matrix lowercov_uppercor_epsilon2 = L_epsilon2_cf * L_epsilon2_cf.transpose(); + lowercov_uppercor_epsilon2 = convert_upper_cov_to_cor( lowercov_uppercor_epsilon2 ); + REPORT( lowercov_uppercor_epsilon2 ); + ADREPORT( lowercov_uppercor_epsilon2 ); + } + if( FieldConfig(2,1)>0 ){ + matrix lowercov_uppercor_beta2 = L_beta2_cf * L_beta2_cf.transpose(); + lowercov_uppercor_beta2 = convert_upper_cov_to_cor( lowercov_uppercor_beta2 ); + REPORT( lowercov_uppercor_beta2 ); + ADREPORT( lowercov_uppercor_beta2 ); + } + } + + // Synchrony + if( Options(6)==1 ){ + int n_z = yearbounds_zz.rows(); + // Density ("D") or area-expanded total biomass ("B") for each category (use B when summing across sites) + matrix D_gt( n_g, n_t ); + matrix B_ct( n_c, n_t ); + vector B_t( n_t ); + D_gt.setZero(); + B_ct.setZero(); + B_t.setZero(); + // Sample variance in category-specific density ("D") and biomass ("B") + array varD_gcz( n_g, n_c, n_z ); + array varD_gz( n_g, n_z ); + array varB_cz( n_c, n_z ); + vector varB_z( n_z ); + vector varB_gbar_z( n_z ); + vector varB_cbar_z( n_z ); + vector ln_varB_z( n_z ); + vector ln_varB_gbar_z( n_z ); + vector ln_varB_cbar_z( n_z ); + array maxsdD_gz( n_g, n_z ); + array maxsdB_cz( n_c, n_z ); + vector maxsdB_z( n_z ); + varD_gcz.setZero(); + varD_gz.setZero(); + varB_cz.setZero(); + varB_z.setZero(); + varB_gbar_z.setZero(); + varB_cbar_z.setZero(); + maxsdD_gz.setZero(); + maxsdB_cz.setZero(); + maxsdB_z.setZero(); + // Proportion of total biomass ("P") for each location or each category + matrix propB_gz( n_g, n_z ); + matrix propB_cz( n_c, n_z ); + propB_gz.setZero(); + propB_cz.setZero(); + // Synchrony indices + matrix phi_gz( n_g, n_z ); + matrix phi_cz( n_c, n_z ); + vector phi_gbar_z( n_z ); + vector phi_cbar_z( n_z ); + vector phi_z( n_z ); + phi_gbar_z.setZero(); + phi_cbar_z.setZero(); + phi_z.setZero(); + // Calculate total biomass for different categories + for( t=0; t CovHat( n_c, n_c ); + CovHat.setIdentity(); + CovHat *= pow(0.0001, 2.0); + if( FieldConfig(1,0)>0 ) CovHat += L_epsilon1_cf * L_epsilon1_cf.transpose(); + if( FieldConfig(1,1)>0 ) CovHat += L_epsilon2_cf * L_epsilon2_cf.transpose(); + // Coherence ranges from 0 (all factors are equal) to 1 (first factor explains all variance) + SelfAdjointEigenSolver > es(CovHat); + vector eigenvalues_c = es.eigenvalues(); // Ranked from lowest to highest for some reason + Type psi = 0; + for(c=0; c diag_CovHat( n_c ); + vector log_diag_CovHat( n_c ); + for(c=0; c PropIndex_ctl(n_c, n_t, n_l); + array ln_PropIndex_ctl(n_c, n_t, n_l); + Type sumtemp; + for(int t=0; t Omegainput1_gf( n_g, Omegainput1_sf.cols() ); + array Epsiloninput1_gft( n_g, n_f1, n_t ); + array Epsiloninput1_gff( n_g, n_f1, Epsiloninput1_sff.cols() ); + array Omegainput2_gf( n_g, Omegainput2_sf.cols() ); + array Epsiloninput2_gft( n_g, n_f2, n_t ); + array Epsiloninput2_gff( n_g, n_f2, Epsiloninput2_sff.cols() ); + // Project + Omegainput1_gf = project_knots( n_g, Omegainput1_sf.cols(), int(1), int(0), Omegainput1_sf, Ags_ij, Ags_x ); + Epsiloninput1_gft = project_knots( n_g, n_f1, n_t, int(1), Epsiloninput1_sft, Ags_ij, Ags_x ); + Epsiloninput1_gff = project_knots( n_g, n_f1, Epsiloninput1_sff.cols(), int(1), Epsiloninput1_sff, Ags_ij, Ags_x ); + Omegainput2_gf = project_knots( n_g, Omegainput2_sf.cols(), int(1), int(0), Omegainput2_sf, Ags_ij, Ags_x ); + Epsiloninput2_gft = project_knots( n_g, n_f2, n_t, int(1), Epsiloninput2_sft, Ags_ij, Ags_x ); + Epsiloninput2_gff = project_knots( n_g, n_f2, Epsiloninput2_sff.cols(), int(1), Epsiloninput2_sff, Ags_ij, Ags_x ); + // Return + REPORT( Omegainput1_gf ); + REPORT( Epsiloninput1_gft ); + REPORT( Epsiloninput1_gff ); + REPORT( Omegainput2_gf ); + REPORT( Epsiloninput2_gft ); + REPORT( Epsiloninput2_gff ); + } + + // Overlap metrics + if( overlap_zz.rows() > 0 ){ + vector overlap_z( overlap_zz.rows() ); + //matrix overlap_gz( n_g, overlap_zz.rows() ); + for( int z=0; z D_i( n_i ); + D_i = R1_i * R2_i; // used in DHARMa residual plotting + REPORT( D_i ); + REPORT( P1_iz ); + REPORT( P2_iz ); + REPORT( R1_i ); + REPORT( R2_i ); + if( Options(3)==1 ){ + ADREPORT( D_i ); + } + + // Loadings matrices + REPORT( L_omega1_cf ); + REPORT( L_omega2_cf ); + REPORT( L_epsilon1_cf ); + REPORT( L_epsilon2_cf ); + REPORT( L_beta1_cf ); + REPORT( L_beta2_cf ); + REPORT( Ltime_epsilon1_tf ); + REPORT( Ltime_epsilon2_tf ); + + // Decorrelation distances + REPORT( H ); + REPORT( Range_raw1 ); + REPORT( Range_raw2 ); + + /// Optional diagnostic outputs + if( Options(16) == true ){ + REPORT( Q1 ); + REPORT( Q2 ); + REPORT( logtau1 ); + REPORT( logtau2 ); + REPORT( var_i ); + REPORT( LogProb1_i ); + REPORT( LogProb2_i ); + REPORT( deviance1_i ); + REPORT( deviance2_i ); + REPORT( eta1_vf ); + REPORT( eta2_vf ); + REPORT( beta1_mean_tf ); + REPORT( beta2_mean_tf ); + REPORT( Options ); + REPORT( Options_vec ); + REPORT( yearbounds_zz ); + REPORT( Expansion_cz ); + REPORT( Beta_mean1_c ); + REPORT( Beta_mean2_c ); + REPORT( Beta_mean1_t ); + REPORT( Beta_mean2_t ); + REPORT( Beta_rho1_f ); + REPORT( Beta_rho2_f ); + REPORT( Epsilon_rho1_f ); + REPORT( Epsilon_rho2_f ); + REPORT( Omega1_iz ); + REPORT( Omega2_iz ); + REPORT( Epsilon1_iz ); + REPORT( Epsilon2_iz ); + REPORT( eta1_iz ); + REPORT( eta2_iz ); + REPORT( Phi1_ik ); + REPORT( Phi2_ik ); + REPORT( zeta1_i ); + REPORT( zeta2_i ); + REPORT( iota_ct ); + } + + SIMULATE{ + REPORT( b_i ); + } + + return jnll; +} diff --git a/inst/executables/VAST_v5_5_0.cpp b/inst/executables/VAST_v5_5_0.cpp deleted file mode 100644 index efda5fe..0000000 --- a/inst/executables/VAST_v5_5_0.cpp +++ /dev/null @@ -1,1650 +0,0 @@ -#include -#include - -// Function to import R list for user-defined Options_vec and Options, packaged as list Options_list in TmbData -template -struct options_list { - vector Options_vec; - vector Options; - matrix yearbounds_zz; - matrix Expansion_cz; - options_list(SEXP x){ // Constructor - Options_vec = asVector(getListElement(x,"Options_vec")); - Options = asVector(getListElement(x,"Options")); - yearbounds_zz = asMatrix(getListElement(x,"yearbounds_zz")); - Expansion_cz = asMatrix(getListElement(x,"Expansion_cz")); - } -}; - -// Needed for returning SparseMatrix -template -Eigen::SparseMatrix Q_network( Type log_theta, int n_s, vector parent_s, vector child_s, vector dist_s ){ - Eigen::SparseMatrix Q( n_s, n_s ); - Type theta = exp( log_theta ); - for(int s=0; s -bool isNA(Type x){ - return R_IsNA(asDouble(x)); -} - -// Posfun -template -Type posfun(Type x, Type lowerlimit, Type &pen){ - pen += CppAD::CondExpLt(x,lowerlimit,Type(0.01)*pow(x-lowerlimit,2),Type(0)); - return CppAD::CondExpGe(x,lowerlimit,x,lowerlimit/(Type(2)-x/lowerlimit)); -} - -// Variance -template -Type var( array vec ){ - Type vec_mod = vec - (vec.sum()/vec.size()); - Type res = pow(vec_mod, 2).sum() / vec.size(); - return res; -} - -// dlnorm -template -Type dlnorm(Type x, Type meanlog, Type sdlog, int give_log=0){ - //return 1/(sqrt(2*M_PI)*sd)*exp(-.5*pow((x-mean)/sd,2)); - Type logres = dnorm( log(x), meanlog, sdlog, true) - log(x); - if(give_log) return logres; else return exp(logres); -} - -// Generate loadings matrix -template -matrix loadings_matrix( vector L_val, int n_rows, int n_cols ){ - matrix L_rc(n_rows, n_cols); - int Count = 0; - for(int r=0; r=c){ - L_rc(r,c) = L_val(Count); - Count++; - }else{ - L_rc(r,c) = 0.0; - } - }} - return L_rc; -} - -// IN: eta1_vf; L1_z -// OUT: jnll_comp; eta1_vc -template -matrix overdispersion_by_category_nll( int n_f, int n_v, int n_c, matrix eta_vf, vector L_z, Type &jnll_pointer, objective_function* of){ - using namespace density; - matrix eta_vc(n_v, n_c); - vector Tmp_c; - // Turn off - if(n_f<0){ - eta_vc.setZero(); - } - // AR1 structure - if( n_f==0 ){ - for(int v=0; v::value && of->do_simulate){ - SCALE( AR1(L_z(1)), exp(L_z(0)) ).simulate(Tmp_c); - eta_vf.row(v) = Tmp_c; - } - } - eta_vc = eta_vf; - } - // Factor analysis structure - if( n_f>0 ){ - // Assemble the loadings matrix - matrix L_cf = loadings_matrix( L_z, n_c, n_f ); - // Probability of overdispersion - for(int v=0; v::value && of->do_simulate){ - eta_vf(v,f) = rnorm( Type(0.0), Type(1.0) ); - } - }} - // Multiply out overdispersion - eta_vc = eta_vf * L_cf.transpose(); - } - return eta_vc; -} - -template // -matrix convert_upper_cov_to_cor( matrix cov ){ - int nrow = cov.row(0).size(); - for( int i=0; i // -matrix gmrf_by_category_nll( int n_f, int method, int timing, int n_s, int n_c, Type logkappa, array gmrf_input_sf, array gmrf_mean_sf, vector L_z, density::GMRF_t gmrf_Q, Type &jnll_pointer, objective_function* of){ - using namespace density; - matrix gmrf_sc(n_s, n_c); - vector gmrf_s(n_s); - matrix Cov_cc(n_c,n_c); - array diff_gmrf_sc(n_s, n_c); // Requires an array - Type logtau; - if(method==0) logtau = log( 1 / (exp(logkappa) * sqrt(4*M_PI)) ); - if(method==1) logtau = log( 1 / sqrt(1-exp(logkappa*2)) ); - if( (method!=0) & (method!=1) ) logtau = Type(0.0); - // IID - if(n_f == -2){ - for( int c=0; c::value && of->do_simulate) { - gmrf_Q.simulate(gmrf_s); - gmrf_input_sf.col(c) = gmrf_s + gmrf_mean_sf.col(c); - } - // Rescale - gmrf_sc.col(c) = gmrf_input_sf.col(c) / exp(logtau) * L_z(c); // Rescaling from comp_index_v1d.cpp - } - } - // Turn off - if(n_f == -1){ - gmrf_sc.setZero(); - } - // AR1 structure - if(n_f==0){ - jnll_pointer += SEPARABLE( AR1(L_z(1)), gmrf_Q )(gmrf_input_sf - gmrf_mean_sf); - // Simulate new values when using obj.simulate() - if(isDouble::value && of->do_simulate) { - SEPARABLE( AR1(L_z(1)), gmrf_Q ).simulate(gmrf_input_sf); - gmrf_input_sf += gmrf_input_sf; - } - // Rescale - logtau = L_z(0) - logkappa; // - gmrf_sc = gmrf_input_sf / exp(logtau); // Rescaling from comp_index_v1d.cpp - } - // Factor analysis structure - if(n_f>0){ - // PDF if density-dependence/interactions occurs prior to correlated dynamics - if( timing==0 ){ - for( int f=0; f::value && of->do_simulate) { - gmrf_Q.simulate(gmrf_s); - gmrf_input_sf.col(f) = gmrf_s + gmrf_mean_sf.col(f); - } - } - // Rescale - matrix L_cf = loadings_matrix( L_z, n_c, n_f ); - gmrf_sc = (gmrf_input_sf.matrix() * L_cf.transpose()) / exp(logtau); - } - // PDF if density-dependence/interactions occurs after correlated dynamics (Only makes sense if n_f == n_c) - if( timing==1 ){ - // Calculate difference without rescaling - gmrf_sc = gmrf_input_sf.matrix(); - for( int s=0; s L_cf = loadings_matrix( L_z, n_c, n_f ); - Cov_cc = L_cf * L_cf.transpose(); - jnll_pointer += SCALE(SEPARABLE(MVNORM(Cov_cc), gmrf_Q), exp(-logtau))( diff_gmrf_sc ); - //gmrf_sc = gmrf_sc / exp(logtau); - // Simulate new values when using obj.simulate() - if(isDouble::value && of->do_simulate) { - SEPARABLE(MVNORM(Cov_cc), gmrf_Q).simulate( diff_gmrf_sc ); - gmrf_sc = gmrf_mean_sf + diff_gmrf_sc/exp(logtau); - } - } - } - return gmrf_sc; -} - -// Used to calculate GMRF PDF for initial condition given covariance Cov_cc -// Only makes sense given: -// 1. full-rank factor model -// 2. Spatial Gompertz model conditions -// 3. Timing = 1 -template -matrix gmrf_stationary_nll( int method, int n_s, int n_c, Type logkappa, array gmrf_input_sc, matrix Cov_cc, density::GMRF_t gmrf_Q, Type &jnll_pointer, objective_function* of){ - using namespace density; - array gmrf_sc(n_s, n_c); - Type logtau; - if(method==0) logtau = log( 1 / (exp(logkappa) * sqrt(4*M_PI)) ); - if(method==1) logtau = log( 1 / sqrt(1-exp(logkappa*2)) ); - if( (method!=0) & (method!=1) ) logtau = Type(0.0); - // PDF if density-dependence/interactions occurs after correlated dynamics (Only makes sense if n_f == n_c) - gmrf_sc = gmrf_input_sc.matrix(); - // Calculate likelihood - jnll_pointer += SCALE(SEPARABLE(MVNORM(Cov_cc), gmrf_Q), exp(-logtau))( gmrf_sc ); - // Simulate new values when using obj.simulate() - if(isDouble::value && of->do_simulate) { - SEPARABLE(MVNORM(Cov_cc), gmrf_Q).simulate( gmrf_sc ); - gmrf_sc = gmrf_sc / exp(logtau); - } - return gmrf_sc.matrix(); -} - -// CMP distribution -template -Type dCMP(Type x, Type mu, Type nu, int give_log=0, int iter_max=30, int break_point=10){ - // Explicit - Type ln_S_1 = nu*mu - ((nu-1)/2)*log(mu) - ((nu-1)/2)*log(2*M_PI) - 0.5*log(nu); - // Recursive - vector S_i(iter_max); - S_i(0) = 1; - for(int i=1; i -Type dPoisGam( Type x, Type shape, Type scale, Type intensity, vector &diag_z, int maxsum=50, int minsum=1, int give_log=0 ){ - // Maximum integration constant to prevent numerical overflow, but capped at value for maxsum to prevent numerical underflow when subtracting by a higher limit than is seen in the sequence - Type max_log_wJ, z1, maxJ_bounded; - if( x==0 ){ - diag_z(0) = 1; - max_log_wJ = 0; - diag_z(1) = 0; - }else{ - z1 = log(intensity) + shape*log(x/scale) - shape*log(shape) + 1; - diag_z(0) = exp( (z1 - 1) / (1 + shape) ); - maxJ_bounded = CppAD::CondExpGe(diag_z(0), Type(maxsum), Type(maxsum), diag_z(0)); - max_log_wJ = maxJ_bounded*log(intensity) + (maxJ_bounded*shape)*log(x/scale) - lgamma(maxJ_bounded+1) - lgamma(maxJ_bounded*shape); - diag_z(1) = diag_z(0)*log(intensity) + (diag_z(0)*shape)*log(x/scale) - lgamma(diag_z(0)+1) - lgamma(diag_z(0)*shape); - } - // Integration constant - Type W = 0; - Type log_w_j; - //Type pos_penalty; - for( int j=minsum; j<=maxsum; j++ ){ - Type j2 = j; - //W += pow(intensity,j) * pow(x/scale, j2*shape) / exp(lgamma(j2+1)) / exp(lgamma(j2*shape)) / exp(max_log_w_j); - log_w_j = j2*log(intensity) + (j2*shape)*log(x/scale) - lgamma(j2+1) - lgamma(j2*shape); - //W += exp( posfun(log_w_j, Type(-30), pos_penalty) ); - W += exp( log_w_j - max_log_wJ ); - if(j==minsum) diag_z(2) = log_w_j; - if(j==maxsum) diag_z(3) = log_w_j; - } - // Loglikelihood calculation - Type loglike = 0; - if( x==0 ){ - loglike = -intensity; - }else{ - loglike = -x/scale - intensity - log(x) + log(W) + max_log_wJ; - } - // Return - if(give_log) return loglike; else return exp(loglike); -} - -// Calculate B_cc -template -matrix calculate_B( int method, int n_f, int n_r, matrix Chi_fr, matrix Psi_fr, Type &jnll_pointer ){ - matrix B_ff( n_f, n_f ); - matrix BplusI_ff( n_f, n_f ); - matrix Chi_rf = Chi_fr.transpose(); - matrix Psi_rf = Psi_fr.transpose(); - matrix Identity_ff( n_f, n_f ); - Identity_ff.setIdentity(); - - // No interactions (default) - if( method==0 ){ - B_ff.setZero(); - } - // Simple co-integration -- complex unbounded eigenvalues - if( method==1 ){ - B_ff = Chi_fr * Psi_rf; - } - // Real eigenvalues - if( method==2 ){ - matrix Chi_ff( n_f, n_f ); - Chi_ff = Identity_ff; - // Make Chi_ff - vector colnorm_r( n_r ); - colnorm_r.setZero(); - for(int f=0; f Psi_ff( n_f, n_f ); - Psi_ff = Identity_ff; - for(int f=n_r; f L_ff(n_f, n_f); - L_ff.setZero(); - for(int r=0; r invChi_ff = atomic::matinv( Chi_ff ); - matrix trans_Psi_ff = Psi_ff.transpose(); - matrix trans_invPsi_ff = atomic::matinv( Psi_ff ).transpose(); - B_ff = Chi_ff * trans_Psi_ff; - B_ff = B_ff * L_ff; - B_ff = B_ff * trans_invPsi_ff; - B_ff = B_ff * invChi_ff; - // Penalize colnorm_r - jnll_pointer += ( log(colnorm_r)*log(colnorm_r) ).sum(); - } - // Complex bounded eigenvalues - if( method==3 ){ - BplusI_ff = Chi_fr * Psi_rf + Identity_ff; - // Extract eigenvalues - vector< std::complex > eigenvalues_B_ff = B_ff.eigenvalues(); - vector real_eigenvalues_B_ff = eigenvalues_B_ff.real(); - vector imag_eigenvalues_B_ff = eigenvalues_B_ff.imag(); - vector mod_eigenvalues_B_ff( n_f ); - // Calculate maximum eigenvalues - Type MaxEigen = 1; - for(int f=0; f -matrix stationary_variance( int n_c, matrix B_cc, matrix Cov_cc ){ - int n2_c = n_c*n_c; - matrix Kronecker_c2c2(n2_c,n2_c); - matrix InvDiff_c2c2(n2_c, n2_c); - matrix Vinf_cc(n_c, n_c); - Kronecker_c2c2 = kronecker( B_cc, B_cc ); - InvDiff_c2c2.setIdentity(); - InvDiff_c2c2 = InvDiff_c2c2 - Kronecker_c2c2; - InvDiff_c2c2 = atomic::matinv( InvDiff_c2c2 ); - Vinf_cc.setZero(); - for(int i=0; i -Type objective_function::operator() () -{ - using namespace R_inla; - using namespace Eigen; - using namespace density; - - // Dimensions - DATA_INTEGER(n_i); // Number of observations (stacked across all years) - DATA_INTEGER(n_s); // Number of "strata" (i.e., vectices in SPDE mesh) - DATA_INTEGER(n_x); // Number of real "strata" (i.e., k-means locations) - DATA_INTEGER(n_t); // Number of time-indices - DATA_INTEGER(n_c); // Number of categories (e.g., length bins) - DATA_INTEGER(n_e); // Number of error distributions - DATA_INTEGER(n_p); // Number of dynamic covariates - DATA_INTEGER(n_v); // Number of tows/vessels (i.e., levels for the factor explaining overdispersion) - DATA_INTEGER(n_l); // Number of indices to post-process - DATA_INTEGER(n_m); // Number of range metrics to use (probably 2 for Eastings-Northings) - - // Config - DATA_STRUCT( Options_list, options_list ); - // Options_list.Options_vec - // Slot 0 -- Aniso: 0=No, 1=Yes - // Slot 1 -- DEPRECATED - // Slot 2 -- AR1 on beta1 (year intercepts for 1st linear predictor) to deal with missing years: 0=No, 1=Yes - // Slot 3 -- AR1 on beta2 (year intercepts for 2nd linear predictor) to deal with missing years: 0=No, 1=Yes - // Slot 4 -- DEPRECATED - // Slot 5 -- Upper limit constant of integration calculation for infinite-series density functions (Conway-Maxwell-Poisson and Tweedie) - // Slot 6 -- Breakpoint in CMP density function - // Slot 7 -- Whether to use SPDE or 2D-AR1 hyper-distribution for spatial process: 0=SPDE; 1=2D-AR1; 2=Stream-network - // Slot 8 -- Whether to use F_ct or ignore it for speedup - // Options_list.Options - // Slot 0: Calculate SE for Index_xctl - // Slot 1: Calculate SE for log(Index_xctl) - // Slot 2: Calculate mean_Z_ctm (i.e., center-of-gravity) - // Slot 3: Calculate SE for D_i (expected density for every observation) - // Slot 4: Calculate mean_D_tl and effective_area_tl - // Slot 5: Calculate standard errors for Covariance and Correlation among categories using factor-analysis parameterization - // Slot 6: Calculate synchrony for different periods specified via yearbounds_zz - // Slot 7: Calculate coherence and variance for Epsilon1_sct and Epsilon2_sct - // Slot 8: Calculate proportions and SE - // Slot 9: Include normalization in GMRF PDF - // Slot 10: Calculate Fratio as F_ct divided by F achieving 40% of B0 - // Slot 11: Calculate B0 and Bratio - // Options_list.yearbounds_zz - // Two columns, and 1+ rows, specifying first and last t for each period used in calculating synchrony - // Options_list.Expansion_cz - // Two columns and n_c rows. 1st column: Type of expansion (0=area-expansion; 1=biomass-expansion); 2nd column: Category used for biomass-expansion - DATA_IVECTOR(FieldConfig); // Input settings (vector, length 4) - DATA_IVECTOR(RhoConfig); - DATA_IVECTOR(OverdispersionConfig); // Input settings (vector, length 2) - DATA_IMATRIX(ObsModel_ez); // Observation model - // Column 0: Probability distribution for data for each level of e_i - // Column 1: Link function for linear predictors for each level of c_i - // NOTE: nlevels(c_i) must be <= nlevels(e_i) - DATA_IVECTOR(VamConfig); - // Slot 0 -- method for calculating n_c-by-n_c interaction matrix, B_ff - // Slot 1 -- rank of interaction matrix B_ff - // Current implementation only makes sense when (1) intercepts are constant among years; (2) using a Poisson-link delta model; (3) n_f=n_c for spatio-temporal variation; (4) starts near equilibrium manifold - DATA_INTEGER(include_data); // Always use TRUE except for internal usage to extract GRMF normalization when turn off GMRF normalization in CPP - - // Data vectors - DATA_VECTOR(b_i); // Response (biomass) for each observation - DATA_VECTOR(a_i); // Area swept for each observation (km^2) - DATA_IMATRIX(c_iz); // Category for each observation - DATA_IVECTOR(e_i); // Error distribution for each observation - DATA_IVECTOR(s_i); // Station for each observation - DATA_IMATRIX(t_iz); // Time-indices (year, season, etc.) for each observation - DATA_IVECTOR(v_i); // tows/vessels for each observation (level of factor representing overdispersion) - DATA_VECTOR(PredTF_i); // vector indicating whether an observatino is predictive (1=used for model evaluation) or fitted (0=used for parameter estimation) - DATA_MATRIX(a_xl); // Area for each "real" stratum(km^2) in each stratum - DATA_MATRIX(X_xj); // Covariate design matrix (strata x covariate) - DATA_ARRAY(X_xtp); // Covariate design matrix (strata x covariate) - DATA_MATRIX(Q_ik); // Catchability matrix (observations x variable) - DATA_IMATRIX(t_yz); // Matrix for time-indices of calculating outputs (abundance index and "derived-quantity") - DATA_MATRIX(Z_xm); // Derived quantity matrix - DATA_MATRIX(F_ct); // Matrix of annual fishing mortality for each category - - // Spatial network inputs - DATA_IVECTOR(parent_s); // Columns: 0=Parent index, 1=Child index, 2=Distance from parent to child - DATA_IVECTOR(child_s); // Columns: 0=Parent index, 1=Child index, 2=Distance from parent to child - DATA_VECTOR(dist_s); // Columns: 0=Parent index, 1=Child index, 2=Distance from parent to child - - // SPDE objects - DATA_STRUCT(spde,spde_t); - - // Aniso objects - DATA_STRUCT(spde_aniso,spde_aniso_t); - - // Sparse matrices for precision matrix of 2D AR1 process - // Q = M0*(1+rho^2)^2 + M1*(1+rho^2)*(-rho) + M2*rho^2 - DATA_SPARSE_MATRIX(M0); - DATA_SPARSE_MATRIX(M1); - DATA_SPARSE_MATRIX(M2); - - // Parameters - PARAMETER_VECTOR(ln_H_input); // Anisotropy parameters - PARAMETER_MATRIX(Chi_fr); // error correction responses - PARAMETER_MATRIX(Psi_fr); // error correction loadings, B_ff = Chi_fr %*% t(Psi_fr) - - // -- presence/absence fixed effects - PARAMETER_MATRIX(beta1_ct); // Year effect - PARAMETER_VECTOR(gamma1_j); // Static covariate effect - PARAMETER_ARRAY(gamma1_ctp); // Dynamic covariate effect - PARAMETER_VECTOR(lambda1_k); // Catchability coefficients - PARAMETER_VECTOR(L1_z); // Overdispersion parameters - PARAMETER_VECTOR(L_omega1_z); - PARAMETER_VECTOR(L_epsilon1_z); - PARAMETER(logkappa1); - PARAMETER_VECTOR(Beta_mean1_c); // mean-reversion for beta1_t - PARAMETER_VECTOR(logsigmaB1_c); // SD of beta1_t (default: not included in objective function) - PARAMETER_VECTOR(Beta_rho1_c); // AR1 for positive catch Epsilon component, Default=0 - PARAMETER_VECTOR(Epsilon_rho1_f); // AR1 for presence/absence Epsilon component, Default=0 - PARAMETER_VECTOR(log_sigmaratio1_z); // Ratio of variance for columns of t_iz - - // -- presence/absence random effects - PARAMETER_MATRIX(eta1_vf); - PARAMETER_ARRAY(Omegainput1_sf); // Expectation - PARAMETER_ARRAY(Epsiloninput1_sft); // Annual variation - - // -- positive catch rates fixed effects - PARAMETER_MATRIX(beta2_ct); // Year effect - PARAMETER_VECTOR(gamma2_j); // Covariate effect - PARAMETER_ARRAY(gamma2_ctp); // Dynamic covariate effect - PARAMETER_VECTOR(lambda2_k); // Catchability coefficients - PARAMETER_VECTOR(L2_z); // Overdispersion parameters - PARAMETER_VECTOR(L_omega2_z); - PARAMETER_VECTOR(L_epsilon2_z); - PARAMETER(logkappa2); - PARAMETER_VECTOR(Beta_mean2_c); // mean-reversion for beta2_t - PARAMETER_VECTOR(logsigmaB2_c); // SD of beta2_t (default: not included in objective function) - PARAMETER_VECTOR(Beta_rho2_c); // AR1 for positive catch Epsilon component, Default=0 - PARAMETER_VECTOR(Epsilon_rho2_f); // AR1 for positive catch Epsilon component, Default=0 - PARAMETER_VECTOR(log_sigmaratio2_z); // Ratio of variance for columns of t_iz - - // Error distribution parameters - PARAMETER_ARRAY(logSigmaM); - // Columns: 0=CV, 1=[usually not used], 2=[usually not used] - // Rows: Each level of e_i and/or c_i - // SigmaM[,0] indexed by e_i, e.g., SigmaM(e_i(i),0) - // SigmaM[,1] and SigmaM[,2] indexed by c_i, e.g., SigmaM(c_i(i),2) - - // -- positive catch rates random effects - PARAMETER_VECTOR(delta_i); - PARAMETER_MATRIX(eta2_vf); - PARAMETER_ARRAY(Omegainput2_sf); // Expectation - PARAMETER_ARRAY(Epsiloninput2_sft); // Annual variation - - // Indices -- i=Observation; j=Covariate; v=Vessel; t=Year; s=Stratum - int i,t,c; - - // Objective function - vector jnll_comp(14); - // Slot 0 -- spatial, encounter - // Slot 1 -- spatio-temporal, encounter - // Slot 2 -- spatial, positive catch - // Slot 3 -- spatio-temporal, positive catch - // Slot 4 -- tow/vessel overdispersion, encounter - // Slot 5 -- tow/vessel overdispersion, positive catch - // Slot 8 -- penalty on beta, encounter - // Slot 9 -- penalty on beta, positive catch - // Slot 10 -- likelihood of data, encounter - // Slot 11 -- likelihood of data, positive catch - // Slot 12 -- Likelihood of Lognormal-Poisson overdispersion delta_i - // Slot 13 -- penalty on estimate_B structure - jnll_comp.setZero(); - Type jnll = 0; - - // Unpack Options_list - vector Options_vec( Options_list.Options_vec.size() ); - Options_vec = Options_list.Options_vec; - vector Options( Options_list.Options.size() ); - Options = Options_list.Options; - matrix yearbounds_zz( Options_list.yearbounds_zz.col(0).size(), 2 ); - yearbounds_zz = Options_list.yearbounds_zz; - matrix Expansion_cz( n_c, 2 ); - Expansion_cz = Options_list.Expansion_cz; - - // Derived parameters - Type Range_raw1, Range_raw2; - if( Options_vec(7)==0 ){ - Range_raw1 = sqrt(8) / exp( logkappa1 ); // Range = approx. distance @ 10% correlation - Range_raw2 = sqrt(8) / exp( logkappa2 ); // Range = approx. distance @ 10% correlation - } - if( (Options_vec(7)==1) | (Options_vec(7)==2) ){ - Range_raw1 = log(0.1) / logkappa1; // Range = approx. distance @ 10% correlation - Range_raw2 = log(0.1) / logkappa2; // Range = approx. distance @ 10% correlation - } - array SigmaM( n_e, 3 ); - SigmaM = exp( logSigmaM ); - - // Anisotropy elements - matrix H(2,2); - H(0,0) = exp(ln_H_input(0)); - H(1,0) = ln_H_input(1); - H(0,1) = ln_H_input(1); - H(1,1) = (1+ln_H_input(1)*ln_H_input(1)) / exp(ln_H_input(0)); - - // Overwrite parameters when mirroring them - if( RhoConfig(1)==6 ){ - Beta_rho2_c = Beta_rho1_c; - } - if( RhoConfig(3)==6 ){ - Epsilon_rho2_f = Epsilon_rho1_f; - } - - //////////////////////// - // Calculate joint likelihood - //////////////////////// - - // Define interaction matrix for Epsilon1, and also the imapct of F_ct on intercepts - int n_f1; - n_f1 = Epsiloninput1_sft.col(0).cols(); - int n_f2; - n_f2 = Epsiloninput2_sft.col(0).cols(); - matrix B_ff( n_f1, n_f1 ); // Interactions among factors - B_ff = calculate_B( VamConfig(0), n_f1, VamConfig(1), Chi_fr, Psi_fr, jnll_comp(13) ); - matrix iota_ct( n_c, n_t ); // Cumulative impact of fishing mortality F_ct in years <= current year t - matrix B1_cc( n_c, n_c ); // Interactions among categories - matrix covE1_cc( n_c, n_c ); - matrix B2_cc( n_c, n_c ); // Interactions among categories - matrix covE2_cc( n_c, n_c ); - matrix I_cc( n_c, n_c ); - matrix IminusB_cc( n_c, n_c ); - I_cc.setIdentity(); - B1_cc.setZero(); - B2_cc.setZero(); - covE1_cc.setZero(); - covE2_cc.setZero(); - // Calculate interaction matrix B_cc for categories if feasible - if( (n_c==n_f1) & (n_c==n_f2) & (FieldConfig(1)>0) & (FieldConfig(3)>0) ){ - matrix L_epsilon1_cf = loadings_matrix( L_epsilon1_z, n_c, n_f1 ); - matrix Cov_epsilon1_cc = L_epsilon1_cf * L_epsilon1_cf.transpose(); - matrix L_epsilon2_cf = loadings_matrix( L_epsilon2_z, n_c, n_f2 ); - matrix Cov_epsilon2_cc = L_epsilon2_cf * L_epsilon2_cf.transpose(); - matrix Btemp_cc( n_c, n_c ); - // Assemble interaction matrix - B1_cc = B_ff; - for( int c=0; c Btarg_c( n_c ); - vector Ftarg_c( n_c ); - matrix Fratio_ct( n_c, n_t ); - IminusB_cc = I_cc - B1_cc; - Btarg_c = log( 0.4 ); // 40% target, transformed for log-link - Ftarg_c = -1 * ( IminusB_cc * Btarg_c ); - for( int t=0; t sumB1_cc( n_c, n_c ); - IminusB_cc = I_cc - B1_cc; - sumB1_cc = IminusB_cc.inverse(); - iota_ct.col(0) -= sumB1_cc * F_ct.col(0); - } - if( (Options_vec(8)==1) | (Options_vec(8)==2) ){ - // Project forward effect of F_ct from initial year through current year - for( int t=1; t Q1( n_s, n_s ); - Eigen::SparseMatrix Q2( n_s, n_s ); - GMRF_t gmrf_Q; - if( (Options_vec(7)==0) & (Options_vec(0)==0) ){ - Q1 = Q_spde(spde, exp(logkappa1)); - Q2 = Q_spde(spde, exp(logkappa2)); - } - if( (Options_vec(7)==0) & (Options_vec(0)==1) ){ - Q1 = Q_spde(spde_aniso, exp(logkappa1), H); - Q2 = Q_spde(spde_aniso, exp(logkappa2), H); - } - if( Options_vec(7)==1 ){ - Q1 = M0*pow(1+exp(logkappa1*2),2) + M1*(1+exp(logkappa1*2))*(-exp(logkappa1)) + M2*exp(logkappa1*2); - Q2 = M0*pow(1+exp(logkappa2*2),2) + M1*(1+exp(logkappa2*2))*(-exp(logkappa2)) + M2*exp(logkappa2*2); - } - if( Options_vec(7)==2 ){ - Q1 = Q_network( logkappa1, n_s, parent_s, child_s, dist_s ); - Q2 = Q_network( logkappa2, n_s, parent_s, child_s, dist_s ); - } - - // Probability of encounter - gmrf_Q = GMRF( Q1, bool(Options(9)) ); - // Omega1 - array Omegamean1_sf(n_s, Omegainput1_sf.cols() ); - Omegamean1_sf.setZero(); - array Omega1_sc(n_s, n_c); - Omega1_sc = gmrf_by_category_nll(FieldConfig(0), Options_vec(7), VamConfig(2), n_s, n_c, logkappa1, Omegainput1_sf, Omegamean1_sf, L_omega1_z, gmrf_Q, jnll_comp(0), this); - // Epsilon1 - array Epsilonmean1_sf(n_s, n_f1 ); - // PDF for Epsilon1 - array Epsilon1_sct(n_s, n_c, n_t); - for(t=0; t=(Options(11)+1) ){ - // Prediction for spatio-temporal component - // Default, and also necessary whenever VamConfig(2)==1 & n_f1!=n_c - if( (VamConfig(0)==0) | ((n_f1!=n_c) & (VamConfig(2)==1)) ){ - // If no interactions, then just autoregressive for factors - for(int s=0; s Omegamean2_sf(n_s, Omegainput2_sf.cols() ); - Omegamean2_sf.setZero(); - array Omega2_sc(n_s, n_c); - Omega2_sc = gmrf_by_category_nll(FieldConfig(2), Options_vec(7), VamConfig(2), n_s, n_c, logkappa2, Omegainput2_sf, Omegamean2_sf, L_omega2_z, gmrf_Q, jnll_comp(2), this); - // Epsilon2 - array Epsilonmean2_sf(n_s, n_f2); - // PDF for Epsilon1 - array Epsilon2_sct(n_s, n_c, n_t); - for(t=0; t=(Options(11)+1) ){ - // Prediction for spatio-temporal component - // Default, and also necessary whenever VamConfig(2)==1 & n_f2!=n_c - if( (VamConfig(0)==0) | ((n_f2!=n_c) & (VamConfig(2)==1)) ){ - // If no interactions, then just autoregressive for factors - for(int s=0; s eta1_vc(n_v, n_c); - eta1_vc = overdispersion_by_category_nll( OverdispersionConfig(0), n_v, n_c, eta1_vf, L1_z, jnll_comp(4), this ); - matrix eta2_vc(n_v, n_c); - eta2_vc = overdispersion_by_category_nll( OverdispersionConfig(1), n_v, n_c, eta2_vf, L2_z, jnll_comp(5), this ); - - // Possible structure on betas - if( (RhoConfig(0)==1) | (RhoConfig(0)==2) | (RhoConfig(0)==4) ){ - for(c=0; c eta1_x = X_xj * gamma1_j.matrix(); - vector zeta1_i = Q_ik * lambda1_k.matrix(); - vector eta2_x = X_xj * gamma2_j.matrix(); - vector zeta2_i = Q_ik * lambda2_k.matrix(); - array eta1_xct(n_x, n_c, n_t); - array eta2_xct(n_x, n_c, n_t); - eta1_xct.setZero(); - eta2_xct.setZero(); - for(int x=0; x var_i(n_i); - Type tmp_calc1; - Type tmp_calc2; - // Linear predictor (pre-link) for presence/absence component - matrix P1_iz(n_i,c_iz.row(0).size()); - // Response predictor (post-link) - // ObsModel_ez(e,0) = 0:4 or 11:12: probability ("phi") that data is greater than zero - // ObsModel_ez(e,0) = 5 (ZINB): phi = 1-ZeroInflation_prob -> Pr[D=0] = NB(0|mu,var)*phi + (1-phi) -> Pr[D>0] = phi - NB(0|mu,var)*phi - vector R1_i(n_i); - vector log_one_minus_R1_i(n_i); - vector log_R1_i(n_i); - vector LogProb1_i(n_i); - // Linear predictor (pre-link) for positive component - matrix P2_iz(n_i,c_iz.row(0).size()); - // Response predictor (post-link) - // ObsModel_ez(e,0) = 0:3, 11:12: expected value of data, given that data is greater than zero -> E[D] = mu*phi - // ObsModel_ez(e,0) = 4 (ZANB): expected value ("mu") of neg-bin PRIOR to truncating Pr[D=0] -> E[D] = mu/(1-NB(0|mu,var))*phi ALSO Pr[D] = NB(D|mu,var)/(1-NB(0|mu,var))*phi - // ObsModel_ez(e,0) = 5 (ZINB): expected value of data for non-zero-inflation component -> E[D] = mu*phi - vector R2_i(n_i); - vector LogProb2_i(n_i); - vector maxJ_i(n_i); - vector diag_z(4); - matrix diag_iz(n_i,4); - diag_iz.setZero(); // Used to track diagnostics for Tweedie distribution (columns: 0=maxJ; 1=maxW; 2=lowerW; 3=upperW) - P1_iz.setZero(); - P2_iz.setZero(); - - // Likelihood contribution from observations - LogProb1_i.setZero(); - LogProb2_i.setZero(); - for(int i=0; i=0) & (c_iz(i,zc)=0) & (t_iz(i,zt)=0) & (c_iz(i,zc) 0 ){ - LogProb1_i(i) = log_R1_i(i); - }else{ - LogProb1_i(i) = log_one_minus_R1_i(i); - } - }else{ - if( b_i(i) > 0 ){ - LogProb1_i(i) = log( R1_i(i) ); - }else{ - LogProb1_i(i) = log( 1-R1_i(i) ); - } - } - // Simulate new values when using obj.simulate() - SIMULATE{ - b_i(i) = rbinom( Type(1), R1_i(i) ); - } - // Positive density likelihood -- models with continuous positive support - if( b_i(i) > 0 ){ // 1e-500 causes overflow on laptop - if(ObsModel_ez(e_i(i),0)==0){ - LogProb2_i(i) = dnorm(b_i(i), R2_i(i), SigmaM(e_i(i),0), true); - // Simulate new values when using obj.simulate() - SIMULATE{ - b_i(i) = rnorm( R2_i(i), SigmaM(e_i(i),0) ); - } - } - if(ObsModel_ez(e_i(i),0)==1){ - LogProb2_i(i) = dlnorm(b_i(i), log(R2_i(i))-pow(SigmaM(e_i(i),0),2)/2, SigmaM(e_i(i),0), true); // log-space - // Simulate new values when using obj.simulate() - SIMULATE{ - b_i(i) = exp(rnorm( log(R2_i(i))-pow(SigmaM(e_i(i),0),2)/2, SigmaM(e_i(i),0) )); - } - } - if(ObsModel_ez(e_i(i),0)==2){ - LogProb2_i(i) = dgamma(b_i(i), 1/pow(SigmaM(e_i(i),0),2), R2_i(i)*pow(SigmaM(e_i(i),0),2), true); // shape = 1/CV^2, scale = mean*CV^2 - // Simulate new values when using obj.simulate() - SIMULATE{ - b_i(i) = rgamma( 1/pow(SigmaM(e_i(i),0),2), R2_i(i)*pow(SigmaM(e_i(i),0),2) ); - } - } - }else{ - LogProb2_i(i) = 0; - } - } - // Likelihood for Tweedie model with continuous positive support - if(ObsModel_ez(e_i(i),0)==8){ - LogProb1_i(i) = 0; - //dPoisGam( Type x, Type shape, Type scale, Type intensity, Type &max_log_w_j, int maxsum=50, int minsum=1, int give_log=0 ) - LogProb2_i(i) = dPoisGam( b_i(i), SigmaM(e_i(i),0), R2_i(i), R1_i(i), diag_z, Options_vec(5), Options_vec(6), true ); - diag_iz.row(i) = diag_z; - // Simulate new values when using obj.simulate() - SIMULATE{ - b_i(i) = 0; // Option not available - } - } - // Likelihood #2 for Tweedie model with continuous positive support - if(ObsModel_ez(e_i(i),0)==10){ - // Packaged code - LogProb1_i(i) = 0; - // dtweedie( Type y, Type mu, Type phi, Type p, int give_log=0 ) - // R1*R2 = mean - LogProb2_i(i) = dtweedie( b_i(i), R1_i(i)*R2_i(i), R1_i(i), invlogit(SigmaM(e_i(i),0))+1.0, true ); - // Simulate new values when using obj.simulate() - SIMULATE{ - b_i(i) = 0; // Option not available - } - } - ///// Likelihood for models with discrete support - // Zero-inflated negative binomial (not numerically stable!) - if(ObsModel_ez(e_i(i),0)==5){ - var_i(i) = R2_i(i)*(1.0+SigmaM(e_i(i),0)) + pow(R2_i(i),2.0)*SigmaM(c_iz(i,0),1); - if( b_i(i)==0 ){ - //LogProb2_i(i) = log( (1-R1_i(i)) + dnbinom2(Type(0.0), R2_i(i), var_i(i), false)*R1_i(i) ); // Pr[X=0] = 1-phi + NB(X=0)*phi - LogProb2_i(i) = logspace_add( log(1-R1_i(i)), dnbinom2(Type(0.0),R2_i(i),var_i(i),true)+log(R1_i(i)) ); // Pr[X=0] = 1-phi + NB(X=0)*phi - }else{ - LogProb2_i(i) = dnbinom2(b_i(i), R2_i(i), var_i(i), true) + log(R1_i(i)); // Pr[X=x] = NB(X=x)*phi - } - // Simulate new values when using obj.simulate() - SIMULATE{ - b_i(i) = rbinom( Type(1), R1_i(i) ); - if( b_i(i)>0 ){ - b_i(i) = rnbinom2( R2_i(i), var_i(i) ); - } - } - } - // Conway-Maxwell-Poisson - if(ObsModel_ez(e_i(i),0)==6){ - LogProb2_i(i) = dCMP(b_i(i), R2_i(i), exp(P1_iz(i,0)), true, Options_vec(5)); - // Simulate new values when using obj.simulate() - SIMULATE{ - b_i(i) = 0; // Option not available - } - } - // Zero-inflated Poisson - if(ObsModel_ez(e_i(i),0)==7){ - if( b_i(i)==0 ){ - //LogProb2_i(i) = log( (1-R1_i(i)) + dpois(Type(0.0), R2_i(i), false)*R1_i(i) ); // Pr[X=0] = 1-phi + Pois(X=0)*phi - LogProb2_i(i) = logspace_add( log(1-R1_i(i)), dpois(Type(0.0),R2_i(i),true)+log(R1_i(i)) ); // Pr[X=0] = 1-phi + Pois(X=0)*phi - }else{ - LogProb2_i(i) = dpois(b_i(i), R2_i(i), true) + log(R1_i(i)); // Pr[X=x] = Pois(X=x)*phi - } - // Simulate new values when using obj.simulate() - SIMULATE{ - b_i(i) = rbinom( Type(1), R1_i(i) ); - if( b_i(i)>0 ){ - b_i(i) = rpois( R2_i(i) ); - } - } - } - // Binned Poisson (for REEF data: 0=none; 1=1; 2=2-10; 3=>11) - /// Doesn't appear stable given spatial or spatio-temporal variation - if(ObsModel_ez(e_i(i),0)==9){ - vector logdBinPois(4); - logdBinPois(0) = logspace_add( log(1-R1_i(i)), dpois(Type(0.0), R2_i(i), true) + log(R1_i(i)) ); // Pr[X=0] = 1-phi + Pois(X=0)*phi - logdBinPois(1) = dpois(Type(1.0), R2_i(i), true) + log(R1_i(i)); // Pr[X | X>0] = Pois(X)*phi - logdBinPois(2) = dpois(Type(2.0), R2_i(i), true) + log(R1_i(i)); // SUM_J( Pr[X|X>0] ) = phi * SUM_J( Pois(J) ) - for(int j=3; j<=10; j++){ - logdBinPois(2) += logspace_add( logdBinPois(2), dpois(Type(j), R2_i(i), true) + log(R1_i(i)) ); - } - logdBinPois(3) = logspace_sub( log(Type(1.0)), logdBinPois(0) ); - logdBinPois(3) = logspace_sub( logdBinPois(3), logdBinPois(1) ); - logdBinPois(3) = logspace_sub( logdBinPois(3), logdBinPois(2) ); - if( b_i(i)==0 ) LogProb2_i(i) = logdBinPois(0); - if( b_i(i)==1 ) LogProb2_i(i) = logdBinPois(1); - if( b_i(i)==2 ) LogProb2_i(i) = logdBinPois(2); - if( b_i(i)==3 ) LogProb2_i(i) = logdBinPois(3); - // Simulate new values when using obj.simulate() - SIMULATE{ - b_i(i) = 0; // Option not available - } - } - // Zero-inflated Lognormal Poisson - if(ObsModel_ez(e_i(i),0)==11){ - if( b_i(i)==0 ){ - //LogProb2_i(i) = log( (1-R1_i(i)) + dpois(Type(0.0), R2_i(i), false)*R1_i(i) ); // Pr[X=0] = 1-phi + Pois(X=0)*phi - LogProb2_i(i) = logspace_add( log(1-R1_i(i)), dpois(Type(0.0),R2_i(i)*exp(SigmaM(e_i(i),0)*delta_i(i)-0.5*pow(SigmaM(e_i(i),0),2)),true)+log(R1_i(i)) ); // Pr[X=0] = 1-phi + Pois(X=0)*phi - }else{ - LogProb2_i(i) = dpois(b_i(i), R2_i(i)*exp(SigmaM(e_i(i),0)*delta_i(i)-0.5*pow(SigmaM(e_i(i),0),2)), true) + log(R1_i(i)); // Pr[X=x] = Pois(X=x)*phi - } - // Simulate new values when using obj.simulate() - SIMULATE{ - b_i(i) = rbinom( Type(1), R1_i(i) ); - if( b_i(i)>0 ){ - b_i(i) = rpois( R2_i(i)*exp(SigmaM(e_i(i),0)*delta_i(i)-0.5*pow(SigmaM(e_i(i),0),2)) ); - } - } - } - // Non-zero-inflated Poisson using log link from 1st linear predictor - if(ObsModel_ez(e_i(i),0)==12){ - LogProb2_i(i) = dpois(b_i(i), R1_i(i), true); - // Simulate new values when using obj.simulate() - SIMULATE{ - b_i(i) = rpois( R1_i(i) ); - } - } - // Non-zero-inflated Bernoulli using cloglog link from 1st lilnear predict - if(ObsModel_ez(e_i(i),0)==13){ - if( b_i(i)==0 ){ - LogProb2_i(i) = dpois(Type(0), R1_i(i), true); - }else{ - LogProb2_i(i) = logspace_sub( log(Type(1.0)), dpois(Type(0), R1_i(i), true) ); - } - // Simulate new values when using obj.simulate() - SIMULATE{ - b_i(i) = rpois( R1_i(i) ); - if( b_i(i)>0 ){ - b_i(i) = 1; - } - } - } - // Non-zero-inflated Lognormal-Poisson using log link from 1st linear predictor - if(ObsModel_ez(e_i(i),0)==14){ - LogProb2_i(i) = dpois(b_i(i), R1_i(i)*exp(SigmaM(e_i(i),0)*delta_i(i)-0.5*pow(SigmaM(e_i(i),0),2)), true); - // Simulate new values when using obj.simulate() - SIMULATE{ - b_i(i) = rpois( R1_i(i)*exp(SigmaM(e_i(i),0)*delta_i(i)-0.5*pow(SigmaM(e_i(i),0),2)) ); - } - } - } - } - REPORT( diag_iz ); - - // Joint likelihood - jnll_comp(10) = -1 * (LogProb1_i * (Type(1.0)-PredTF_i)).sum(); - jnll_comp(11) = -1 * (LogProb2_i * (Type(1.0)-PredTF_i)).sum(); - jnll = jnll_comp.sum(); - Type pred_jnll = -1 * ( LogProb1_i*PredTF_i + LogProb2_i*PredTF_i ).sum(); - REPORT( pred_jnll ); - REPORT( tmp_calc1 ); - REPORT( tmp_calc2 ); - - //////////////////////// - // Calculate outputs - //////////////////////// - - // Number of output-years - int n_y = t_yz.col(0).size(); - - // Predictive distribution -- ObsModel_ez(e,0)==4 isn't implemented (it had a bug previously) - Type a_average = a_i.sum()/a_i.size(); - array P1_xcy(n_x, n_c, n_y); - array R1_xcy(n_x, n_c, n_y); - array P2_xcy(n_x, n_c, n_y); - array R2_xcy(n_x, n_c, n_y); - array D_xcy(n_x, n_c, n_y); - for(int c=0; c=0) & (t_yz(y,z) Index_xcyl(n_x, n_c, n_y, n_l); - array Index_cyl(n_c, n_y, n_l); - array ln_Index_cyl(n_c, n_y, n_l); - Index_cyl.setZero(); - for(int y=0; y Bratio_cyl(n_c, n_y, n_l); - array ln_Bratio_cyl(n_c, n_y, n_l); - for(int c=0; c mean_Z_cym(n_c, n_y, n_m); - if( Options(2)==1 ){ - mean_Z_cym.setZero(); - int report_summary_TF = false; - for(int c=0; c mean_D_cyl(n_c, n_y, n_l); - array log_mean_D_cyl(n_c, n_y, n_l); - mean_D_cyl.setZero(); - for(int c=0; c effective_area_cyl(n_c, n_y, n_l); - array log_effective_area_cyl(n_c, n_y, n_l); - effective_area_cyl = Index_cyl / (mean_D_cyl/1000); // Correct for different units of Index and density - log_effective_area_cyl = log( effective_area_cyl ); - REPORT( effective_area_cyl ); - ADREPORT( effective_area_cyl ); - ADREPORT( log_effective_area_cyl ); - } - - // Reporting and standard-errors for covariance and correlation matrices - if( Options(5)==1 ){ - if( FieldConfig(0)>0 ){ - matrix L1_omega_cf = loadings_matrix( L_omega1_z, n_c, FieldConfig(0) ); - matrix lowercov_uppercor_omega1 = L1_omega_cf * L1_omega_cf.transpose(); - lowercov_uppercor_omega1 = convert_upper_cov_to_cor( lowercov_uppercor_omega1 ); - REPORT( lowercov_uppercor_omega1 ); - ADREPORT( lowercov_uppercor_omega1 ); - } - if( FieldConfig(1)>0 ){ - matrix L1_epsilon_cf = loadings_matrix( L_epsilon1_z, n_c, FieldConfig(1) ); - matrix lowercov_uppercor_epsilon1 = L1_epsilon_cf * L1_epsilon_cf.transpose(); - lowercov_uppercor_epsilon1 = convert_upper_cov_to_cor( lowercov_uppercor_epsilon1 ); - REPORT( lowercov_uppercor_epsilon1 ); - ADREPORT( lowercov_uppercor_epsilon1 ); - } - if( FieldConfig(2)>0 ){ - matrix L2_omega_cf = loadings_matrix( L_omega2_z, n_c, FieldConfig(2) ); - matrix lowercov_uppercor_omega2 = L2_omega_cf * L2_omega_cf.transpose(); - lowercov_uppercor_omega2 = convert_upper_cov_to_cor( lowercov_uppercor_omega2 ); - REPORT( lowercov_uppercor_omega2 ); - ADREPORT( lowercov_uppercor_omega2 ); - } - if( FieldConfig(3)>0 ){ - matrix L2_epsilon_cf = loadings_matrix( L_epsilon2_z, n_c, FieldConfig(3) ); - matrix lowercov_uppercor_epsilon2 = L2_epsilon_cf * L2_epsilon_cf.transpose(); - lowercov_uppercor_epsilon2 = convert_upper_cov_to_cor( lowercov_uppercor_epsilon2 ); - REPORT( lowercov_uppercor_epsilon2 ); - ADREPORT( lowercov_uppercor_epsilon2 ); - } - } - - // Synchrony - if( Options(6)==1 ){ - int n_z = yearbounds_zz.col(0).size(); - // Density ("D") or area-expanded total biomass ("B") for each category (use B when summing across sites) - matrix D_xy( n_x, n_y ); - matrix B_cy( n_c, n_y ); - vector B_y( n_y ); - D_xy.setZero(); - B_cy.setZero(); - B_y.setZero(); - // Sample variance in category-specific density ("D") and biomass ("B") - array varD_xcz( n_x, n_c, n_z ); - array varD_xz( n_x, n_z ); - array varB_cz( n_c, n_z ); - vector varB_z( n_z ); - vector varB_xbar_z( n_z ); - vector varB_cbar_z( n_z ); - vector ln_varB_z( n_z ); - vector ln_varB_xbar_z( n_z ); - vector ln_varB_cbar_z( n_z ); - array maxsdD_xz( n_x, n_z ); - array maxsdB_cz( n_c, n_z ); - vector maxsdB_z( n_z ); - varD_xcz.setZero(); - varD_xz.setZero(); - varB_cz.setZero(); - varB_z.setZero(); - varB_xbar_z.setZero(); - varB_cbar_z.setZero(); - maxsdD_xz.setZero(); - maxsdB_cz.setZero(); - maxsdB_z.setZero(); - // Proportion of total biomass ("P") for each location or each category - matrix propB_xz( n_x, n_z ); - matrix propB_cz( n_c, n_z ); - propB_xz.setZero(); - propB_cz.setZero(); - // Synchrony indices - matrix phi_xz( n_x, n_z ); - matrix phi_cz( n_c, n_z ); - vector phi_xbar_z( n_z ); - vector phi_cbar_z( n_z ); - vector phi_z( n_z ); - phi_xbar_z.setZero(); - phi_cbar_z.setZero(); - phi_z.setZero(); - // Calculate total biomass for different categories - for( int y=0; y CovHat( n_c, n_c ); - matrix CovHat( n_c, n_c ); - CovHat.setIdentity(); - CovHat *= pow(0.0001, 2); - if( FieldConfig(1)>0 ) CovHat += loadings_matrix(L_epsilon1_z, n_c, FieldConfig(1)) * loadings_matrix(L_epsilon1_z, n_c, FieldConfig(1)).transpose(); - if( FieldConfig(3)>0 ) CovHat += loadings_matrix(L_epsilon2_z, n_c, FieldConfig(3)) * loadings_matrix(L_epsilon2_z, n_c, FieldConfig(3)).transpose(); - // Coherence ranges from 0 (all factors are equal) to 1 (first factor explains all variance) - SelfAdjointEigenSolver > es(CovHat); - vector eigenvalues_c = es.eigenvalues(); // Ranked from lowest to highest for some reason - Type psi = 0; - for(int c=0; c diag_CovHat( n_c ); - vector log_diag_CovHat( n_c ); - for(int c=0; c PropIndex_cyl(n_c, n_y, n_l); - array ln_PropIndex_cyl(n_c, n_y, n_l); - Type sumtemp; - for(int y=0; y D_i( n_i ); - D_i = R1_i * R2_i; - ADREPORT( D_i ); - } - - return jnll; - -} diff --git a/inst/executables/VAST_v6_0_0.cpp b/inst/executables/VAST_v6_0_0.cpp deleted file mode 100644 index c41713f..0000000 --- a/inst/executables/VAST_v6_0_0.cpp +++ /dev/null @@ -1,1732 +0,0 @@ -#include -#include - -// Function to import R list for user-defined Options_vec and Options, packaged as list Options_list in TmbData -template -struct options_list { - vector Options_vec; - vector Options; - matrix yearbounds_zz; - matrix Expansion_cz; - options_list(SEXP x){ // Constructor - Options_vec = asVector(getListElement(x,"Options_vec")); - Options = asVector(getListElement(x,"Options")); - yearbounds_zz = asMatrix(getListElement(x,"yearbounds_zz")); - Expansion_cz = asMatrix(getListElement(x,"Expansion_cz")); - } -}; - -// Needed for returning SparseMatrix -template -Eigen::SparseMatrix Q_network( Type log_theta, int n_s, vector parent_s, vector child_s, vector dist_s ){ - Eigen::SparseMatrix Q( n_s, n_s ); - Type theta = exp( log_theta ); - for(int s=0; s -bool isNA(Type x){ - return R_IsNA(asDouble(x)); -} - -// Posfun -template -Type posfun(Type x, Type lowerlimit, Type &pen){ - pen += CppAD::CondExpLt(x,lowerlimit,Type(0.01)*pow(x-lowerlimit,2),Type(0)); - return CppAD::CondExpGe(x,lowerlimit,x,lowerlimit/(Type(2)-x/lowerlimit)); -} - -// Variance -template -Type var( array vec ){ - Type vec_mod = vec - (vec.sum()/vec.size()); - Type res = pow(vec_mod, 2).sum() / vec.size(); - return res; -} - -// dlnorm -template -Type dlnorm(Type x, Type meanlog, Type sdlog, int give_log=0){ - //return 1/(sqrt(2*M_PI)*sd)*exp(-.5*pow((x-mean)/sd,2)); - Type logres = dnorm( log(x), meanlog, sdlog, true) - log(x); - if(give_log) return logres; else return exp(logres); -} - -// Generate loadings matrix -template -matrix loadings_matrix( vector L_val, int n_rows, int n_cols ){ - matrix L_rc(n_rows, n_cols); - int Count = 0; - for(int r=0; r=c){ - L_rc(r,c) = L_val(Count); - Count++; - }else{ - L_rc(r,c) = 0.0; - } - }} - return L_rc; -} - -// IN: eta1_vf; L1_z -// OUT: jnll_comp; eta1_vc -template -matrix overdispersion_by_category_nll( int n_f, int n_v, int n_c, matrix eta_vf, vector L_z, Type &jnll_pointer, objective_function* of){ - using namespace density; - matrix eta_vc(n_v, n_c); - vector Tmp_c; - // Turn off - if(n_f<0){ - eta_vc.setZero(); - } - // AR1 structure - if( n_f==0 ){ - for(int v=0; v::value && of->do_simulate){ - SCALE( AR1(L_z(1)), exp(L_z(0)) ).simulate(Tmp_c); - eta_vf.row(v) = Tmp_c; - } - } - eta_vc = eta_vf; - } - // Factor analysis structure - if( n_f>0 ){ - // Assemble the loadings matrix - matrix L_cf = loadings_matrix( L_z, n_c, n_f ); - // Probability of overdispersion - for(int v=0; v::value && of->do_simulate){ - eta_vf(v,f) = rnorm( Type(0.0), Type(1.0) ); - } - }} - // Multiply out overdispersion - eta_vc = eta_vf * L_cf.transpose(); - } - return eta_vc; -} - -template // -matrix convert_upper_cov_to_cor( matrix cov ){ - int nrow = cov.row(0).size(); - for( int i=0; i // -matrix gmrf_by_category_nll( int n_f, int method, int timing, int n_s, int n_c, Type logkappa, array gmrf_input_sf, array gmrf_mean_sf, vector L_z, density::GMRF_t gmrf_Q, Type &jnll_pointer, objective_function* of){ - using namespace density; - matrix gmrf_sc(n_s, n_c); - vector gmrf_s(n_s); - matrix Cov_cc(n_c,n_c); - array diff_gmrf_sc(n_s, n_c); // Requires an array - Type logtau; - if(method==0) logtau = log( 1 / (exp(logkappa) * sqrt(4*M_PI)) ); - if(method==1) logtau = log( 1 / sqrt(1-exp(logkappa*2)) ); - if( (method!=0) & (method!=1) ) logtau = Type(0.0); - // IID - if(n_f == -2){ - for( int c=0; c::value && of->do_simulate) { - gmrf_Q.simulate(gmrf_s); - gmrf_input_sf.col(c) = gmrf_s + gmrf_mean_sf.col(c); - } - // Rescale - gmrf_sc.col(c) = gmrf_input_sf.col(c) / exp(logtau) * L_z(c); // Rescaling from comp_index_v1d.cpp - } - } - // Turn off - if(n_f == -1){ - gmrf_sc.setZero(); - } - // AR1 structure - if(n_f==0){ - jnll_pointer += SEPARABLE( AR1(L_z(1)), gmrf_Q )(gmrf_input_sf - gmrf_mean_sf); - // Simulate new values when using obj.simulate() - if(isDouble::value && of->do_simulate) { - SEPARABLE( AR1(L_z(1)), gmrf_Q ).simulate(gmrf_input_sf); - gmrf_input_sf += gmrf_input_sf; - } - // Rescale - logtau = L_z(0) - logkappa; // - gmrf_sc = gmrf_input_sf / exp(logtau); // Rescaling from comp_index_v1d.cpp - } - // Factor analysis structure - if(n_f>0){ - // PDF if density-dependence/interactions occurs prior to correlated dynamics - if( timing==0 ){ - for( int f=0; f::value && of->do_simulate) { - gmrf_Q.simulate(gmrf_s); - gmrf_input_sf.col(f) = gmrf_s + gmrf_mean_sf.col(f); - } - } - // Rescale - matrix L_cf = loadings_matrix( L_z, n_c, n_f ); - gmrf_sc = (gmrf_input_sf.matrix() * L_cf.transpose()) / exp(logtau); - } - // PDF if density-dependence/interactions occurs after correlated dynamics (Only makes sense if n_f == n_c) - if( timing==1 ){ - // Calculate difference without rescaling - gmrf_sc = gmrf_input_sf.matrix(); - for( int s=0; s L_cf = loadings_matrix( L_z, n_c, n_f ); - Cov_cc = L_cf * L_cf.transpose(); - jnll_pointer += SCALE(SEPARABLE(MVNORM(Cov_cc), gmrf_Q), exp(-logtau))( diff_gmrf_sc ); - //gmrf_sc = gmrf_sc / exp(logtau); - // Simulate new values when using obj.simulate() - if(isDouble::value && of->do_simulate) { - SEPARABLE(MVNORM(Cov_cc), gmrf_Q).simulate( diff_gmrf_sc ); - gmrf_sc = gmrf_mean_sf + diff_gmrf_sc/exp(logtau); - } - } - } - return gmrf_sc; -} - -// Used to calculate GMRF PDF for initial condition given covariance Cov_cc -// Only makes sense given: -// 1. full-rank factor model -// 2. Spatial Gompertz model conditions -// 3. Timing = 1 -template -matrix gmrf_stationary_nll( int method, int n_s, int n_c, Type logkappa, array gmrf_input_sc, matrix Cov_cc, density::GMRF_t gmrf_Q, Type &jnll_pointer, objective_function* of){ - using namespace density; - array gmrf_sc(n_s, n_c); - Type logtau; - if(method==0) logtau = log( 1 / (exp(logkappa) * sqrt(4*M_PI)) ); - if(method==1) logtau = log( 1 / sqrt(1-exp(logkappa*2)) ); - if( (method!=0) & (method!=1) ) logtau = Type(0.0); - // PDF if density-dependence/interactions occurs after correlated dynamics (Only makes sense if n_f == n_c) - gmrf_sc = gmrf_input_sc.matrix(); - // Calculate likelihood - jnll_pointer += SCALE(SEPARABLE(MVNORM(Cov_cc), gmrf_Q), exp(-logtau))( gmrf_sc ); - // Simulate new values when using obj.simulate() - if(isDouble::value && of->do_simulate) { - SEPARABLE(MVNORM(Cov_cc), gmrf_Q).simulate( gmrf_sc ); - gmrf_sc = gmrf_sc / exp(logtau); - } - return gmrf_sc.matrix(); -} - -// CMP distribution -template -Type dCMP(Type x, Type mu, Type nu, int give_log=0, int iter_max=30, int break_point=10){ - // Explicit - Type ln_S_1 = nu*mu - ((nu-1)/2)*log(mu) - ((nu-1)/2)*log(2*M_PI) - 0.5*log(nu); - // Recursive - vector S_i(iter_max); - S_i(0) = 1; - for(int i=1; i -Type dPoisGam( Type x, Type shape, Type scale, Type intensity, vector &diag_z, int maxsum=50, int minsum=1, int give_log=0 ){ - // Maximum integration constant to prevent numerical overflow, but capped at value for maxsum to prevent numerical underflow when subtracting by a higher limit than is seen in the sequence - Type max_log_wJ, z1, maxJ_bounded; - if( x==0 ){ - diag_z(0) = 1; - max_log_wJ = 0; - diag_z(1) = 0; - }else{ - z1 = log(intensity) + shape*log(x/scale) - shape*log(shape) + 1; - diag_z(0) = exp( (z1 - 1) / (1 + shape) ); - maxJ_bounded = CppAD::CondExpGe(diag_z(0), Type(maxsum), Type(maxsum), diag_z(0)); - max_log_wJ = maxJ_bounded*log(intensity) + (maxJ_bounded*shape)*log(x/scale) - lgamma(maxJ_bounded+1) - lgamma(maxJ_bounded*shape); - diag_z(1) = diag_z(0)*log(intensity) + (diag_z(0)*shape)*log(x/scale) - lgamma(diag_z(0)+1) - lgamma(diag_z(0)*shape); - } - // Integration constant - Type W = 0; - Type log_w_j; - //Type pos_penalty; - for( int j=minsum; j<=maxsum; j++ ){ - Type j2 = j; - //W += pow(intensity,j) * pow(x/scale, j2*shape) / exp(lgamma(j2+1)) / exp(lgamma(j2*shape)) / exp(max_log_w_j); - log_w_j = j2*log(intensity) + (j2*shape)*log(x/scale) - lgamma(j2+1) - lgamma(j2*shape); - //W += exp( posfun(log_w_j, Type(-30), pos_penalty) ); - W += exp( log_w_j - max_log_wJ ); - if(j==minsum) diag_z(2) = log_w_j; - if(j==maxsum) diag_z(3) = log_w_j; - } - // Loglikelihood calculation - Type loglike = 0; - if( x==0 ){ - loglike = -intensity; - }else{ - loglike = -x/scale - intensity - log(x) + log(W) + max_log_wJ; - } - // Return - if(give_log) return loglike; else return exp(loglike); -} - -// Calculate B_cc -template -matrix calculate_B( int method, int n_f, int n_r, matrix Chi_fr, matrix Psi_fr, Type &jnll_pointer ){ - matrix B_ff( n_f, n_f ); - matrix BplusI_ff( n_f, n_f ); - matrix Chi_rf = Chi_fr.transpose(); - matrix Psi_rf = Psi_fr.transpose(); - matrix Identity_ff( n_f, n_f ); - Identity_ff.setIdentity(); - - // No interactions (default) - if( method==0 ){ - B_ff.setZero(); - } - // Simple co-integration -- complex unbounded eigenvalues - if( method==1 ){ - B_ff = Chi_fr * Psi_rf; - } - // Real eigenvalues - if( method==2 ){ - matrix Chi_ff( n_f, n_f ); - Chi_ff = Identity_ff; - // Make Chi_ff - vector colnorm_r( n_r ); - colnorm_r.setZero(); - for(int f=0; f Psi_ff( n_f, n_f ); - Psi_ff = Identity_ff; - for(int f=n_r; f L_ff(n_f, n_f); - L_ff.setZero(); - for(int r=0; r invChi_ff = atomic::matinv( Chi_ff ); - matrix trans_Psi_ff = Psi_ff.transpose(); - matrix trans_invPsi_ff = atomic::matinv( Psi_ff ).transpose(); - B_ff = Chi_ff * trans_Psi_ff; - B_ff = B_ff * L_ff; - B_ff = B_ff * trans_invPsi_ff; - B_ff = B_ff * invChi_ff; - // Penalize colnorm_r - jnll_pointer += ( log(colnorm_r)*log(colnorm_r) ).sum(); - } - // Complex bounded eigenvalues - if( method==3 ){ - BplusI_ff = Chi_fr * Psi_rf + Identity_ff; - // Extract eigenvalues - vector< std::complex > eigenvalues_B_ff = B_ff.eigenvalues(); - vector real_eigenvalues_B_ff = eigenvalues_B_ff.real(); - vector imag_eigenvalues_B_ff = eigenvalues_B_ff.imag(); - vector mod_eigenvalues_B_ff( n_f ); - // Calculate maximum eigenvalues - Type MaxEigen = 1; - for(int f=0; f -matrix stationary_variance( int n_c, matrix B_cc, matrix Cov_cc ){ - int n2_c = n_c*n_c; - matrix Kronecker_c2c2(n2_c,n2_c); - matrix InvDiff_c2c2(n2_c, n2_c); - matrix Vinf_cc(n_c, n_c); - Kronecker_c2c2 = kronecker( B_cc, B_cc ); - InvDiff_c2c2.setIdentity(); - InvDiff_c2c2 = InvDiff_c2c2 - Kronecker_c2c2; - InvDiff_c2c2 = atomic::matinv( InvDiff_c2c2 ); - Vinf_cc.setZero(); - for(int i=0; i -Type objective_function::operator() () -{ - using namespace R_inla; - using namespace Eigen; - using namespace density; - - // Dimensions - DATA_INTEGER(n_i); // Number of observations (stacked across all years) - DATA_INTEGER(n_s); // Number of "strata" (i.e., vectices in SPDE mesh) - DATA_INTEGER(n_x); // Number of real "strata" (i.e., k-means locations) - DATA_INTEGER(n_t); // Number of time-indices - DATA_INTEGER(n_c); // Number of categories (e.g., length bins) - DATA_INTEGER(n_e); // Number of error distributions - DATA_INTEGER(n_p); // Number of dynamic covariates - DATA_INTEGER(n_v); // Number of tows/vessels (i.e., levels for the factor explaining overdispersion) - DATA_INTEGER(n_l); // Number of indices to post-process - DATA_INTEGER(n_m); // Number of range metrics to use (probably 2 for Eastings-Northings) - - // Config - DATA_STRUCT( Options_list, options_list ); - // Options_list.Options_vec - // Slot 0 -- Aniso: 0=No, 1=Yes - // Slot 1 -- DEPRECATED - // Slot 2 -- AR1 on beta1 (year intercepts for 1st linear predictor) to deal with missing years: 0=No, 1=Yes - // Slot 3 -- AR1 on beta2 (year intercepts for 2nd linear predictor) to deal with missing years: 0=No, 1=Yes - // Slot 4 -- DEPRECATED - // Slot 5 -- Upper limit constant of integration calculation for infinite-series density functions (Conway-Maxwell-Poisson and Tweedie) - // Slot 6 -- Breakpoint in CMP density function - // Slot 7 -- Whether to use SPDE or 2D-AR1 hyper-distribution for spatial process: 0=SPDE; 1=2D-AR1; 2=Stream-network - // Slot 8 -- Whether to use F_ct or ignore it for speedup - // Options_list.Options - // Slot 0: Calculate SE for Index_xctl - // Slot 1: Calculate SE for log(Index_xctl) - // Slot 2: Calculate mean_Z_ctm (i.e., center-of-gravity) - // Slot 3: Calculate SE for D_i (expected density for every observation) - // Slot 4: Calculate mean_D_tl and effective_area_tl - // Slot 5: Calculate standard errors for Covariance and Correlation among categories using factor-analysis parameterization - // Slot 6: Calculate synchrony for different periods specified via yearbounds_zz - // Slot 7: Calculate coherence and variance for Epsilon1_sct and Epsilon2_sct - // Slot 8: Calculate proportions and SE - // Slot 9: Include normalization in GMRF PDF - // Slot 10: Calculate Fratio as F_ct divided by F achieving 40% of B0 - // Slot 11: Calculate B0 and Bratio - // Options_list.yearbounds_zz - // Two columns, and 1+ rows, specifying first and last t for each period used in calculating synchrony - // Options_list.Expansion_cz - // Two columns and n_c rows. 1st column: Type of expansion (0=area-expansion; 1=biomass-expansion); 2nd column: Category used for biomass-expansion - DATA_IVECTOR(FieldConfig); // Input settings (vector, length 4) - DATA_IVECTOR(RhoConfig); - DATA_IVECTOR(OverdispersionConfig); // Input settings (vector, length 2) - DATA_IMATRIX(ObsModel_ez); // Observation model - // Column 0: Probability distribution for data for each level of e_i - // Column 1: Link function for linear predictors for each level of c_i - // NOTE: nlevels(c_i) must be <= nlevels(e_i) - DATA_IVECTOR(VamConfig); - // Slot 0 -- method for calculating n_c-by-n_c interaction matrix, B_ff - // Slot 1 -- rank of interaction matrix B_ff - // Current implementation only makes sense when (1) intercepts are constant among years; (2) using a Poisson-link delta model; (3) n_f=n_c for spatio-temporal variation; (4) starts near equilibrium manifold - DATA_IARRAY(Xconfig_zcp); - // Row 0 -- Methods for 1st component for each covariate in X_xtp (0=Off; 1=Estimate; 2=Estimate with spatially varying coefficient) - // Row 1 -- Methods for 2nd component for each covariate in X_xtp (0=Off; 1=Estimate; 2=Estimate with spatially varying coefficient) - DATA_INTEGER(include_data); // Always use TRUE except for internal usage to extract GRMF normalization when turn off GMRF normalization in CPP - - // Data vectors - DATA_VECTOR(b_i); // Response (biomass) for each observation - DATA_VECTOR(a_i); // Area swept for each observation (km^2) - DATA_IMATRIX(c_iz); // Category for each observation - DATA_IVECTOR(e_i); // Error distribution for each observation - DATA_IVECTOR(s_i); // Station for each observation - DATA_IMATRIX(t_iz); // Time-indices (year, season, etc.) for each observation - DATA_IVECTOR(v_i); // tows/vessels for each observation (level of factor representing overdispersion) - DATA_VECTOR(PredTF_i); // vector indicating whether an observatino is predictive (1=used for model evaluation) or fitted (0=used for parameter estimation) - DATA_MATRIX(a_xl); // Area for each "real" stratum(km^2) in each stratum - DATA_ARRAY(X_xtp); // Covariate design matrix (strata x covariate) - DATA_MATRIX(Q_ik); // Catchability matrix (observations x variable) - DATA_IMATRIX(t_yz); // Matrix for time-indices of calculating outputs (abundance index and "derived-quantity") - DATA_MATRIX(Z_xm); // Derived quantity matrix - DATA_MATRIX(F_ct); // Matrix of annual fishing mortality for each category - - // Spatial network inputs - DATA_IVECTOR(parent_s); // Columns: 0=Parent index, 1=Child index, 2=Distance from parent to child - DATA_IVECTOR(child_s); // Columns: 0=Parent index, 1=Child index, 2=Distance from parent to child - DATA_VECTOR(dist_s); // Columns: 0=Parent index, 1=Child index, 2=Distance from parent to child - - // SPDE objects - DATA_STRUCT(spde,spde_t); - - // Aniso objects - DATA_STRUCT(spde_aniso,spde_aniso_t); - - // Sparse matrices for precision matrix of 2D AR1 process - // Q = M0*(1+rho^2)^2 + M1*(1+rho^2)*(-rho) + M2*rho^2 - DATA_SPARSE_MATRIX(M0); - DATA_SPARSE_MATRIX(M1); - DATA_SPARSE_MATRIX(M2); - - // Parameters - PARAMETER_VECTOR(ln_H_input); // Anisotropy parameters - PARAMETER_MATRIX(Chi_fr); // error correction responses - PARAMETER_MATRIX(Psi_fr); // error correction loadings, B_ff = Chi_fr %*% t(Psi_fr) - - // -- presence/absence fixed effects - PARAMETER_MATRIX(beta1_ct); // Year effect - PARAMETER_ARRAY(gamma1_ctp); // Dynamic covariate effect - PARAMETER_VECTOR(lambda1_k); // Catchability coefficients - PARAMETER_VECTOR(L1_z); // Overdispersion parameters - PARAMETER_VECTOR(L_omega1_z); - PARAMETER_VECTOR(L_epsilon1_z); - PARAMETER(logkappa1); - PARAMETER_VECTOR(Beta_mean1_c); // mean-reversion for beta1_t - PARAMETER_VECTOR(logsigmaB1_c); // SD of beta1_t (default: not included in objective function) - PARAMETER_VECTOR(Beta_rho1_c); // AR1 for positive catch Epsilon component, Default=0 - PARAMETER_VECTOR(Epsilon_rho1_f); // AR1 for presence/absence Epsilon component, Default=0 - PARAMETER_ARRAY(log_sigmaXi1_cp); // log-SD of Xi1_scp - PARAMETER_VECTOR(log_sigmaratio1_z); // Ratio of variance for columns of t_iz - - // -- presence/absence random effects - PARAMETER_MATRIX(eta1_vf); - PARAMETER_ARRAY(Xiinput1_scp); // spatially varying coefficient - PARAMETER_ARRAY(Omegainput1_sf); // Expectation - PARAMETER_ARRAY(Epsiloninput1_sft); // Annual variation - - // -- positive catch rates fixed effects - PARAMETER_MATRIX(beta2_ct); // Year effect - PARAMETER_ARRAY(gamma2_ctp); // Dynamic covariate effect - PARAMETER_VECTOR(lambda2_k); // Catchability coefficients - PARAMETER_VECTOR(L2_z); // Overdispersion parameters - PARAMETER_VECTOR(L_omega2_z); - PARAMETER_VECTOR(L_epsilon2_z); - PARAMETER(logkappa2); - PARAMETER_VECTOR(Beta_mean2_c); // mean-reversion for beta2_t - PARAMETER_VECTOR(logsigmaB2_c); // SD of beta2_t (default: not included in objective function) - PARAMETER_VECTOR(Beta_rho2_c); // AR1 for positive catch Epsilon component, Default=0 - PARAMETER_VECTOR(Epsilon_rho2_f); // AR1 for positive catch Epsilon component, Default=0 - PARAMETER_ARRAY(log_sigmaXi2_cp); // log-SD of Xi2_scp - PARAMETER_VECTOR(log_sigmaratio2_z); // Ratio of variance for columns of t_iz - - // Error distribution parameters - PARAMETER_ARRAY(logSigmaM); - // Columns: 0=CV, 1=[usually not used], 2=[usually not used] - // Rows: Each level of e_i and/or c_i - // SigmaM[,0] indexed by e_i, e.g., SigmaM(e_i(i),0) - // SigmaM[,1] and SigmaM[,2] indexed by c_i, e.g., SigmaM(c_i(i),2) - - // -- positive catch rates random effects - PARAMETER_VECTOR(delta_i); - PARAMETER_MATRIX(eta2_vf); - PARAMETER_ARRAY(Xiinput2_scp); // spatially varying coefficient - PARAMETER_ARRAY(Omegainput2_sf); // Expectation - PARAMETER_ARRAY(Epsiloninput2_sft); // Annual variation - - //////////////////////// - // Preparatory bookkeeping - //////////////////////// - - // Indices -- i=Observation; t=Year; c=Category; p=Dynamic-covariate - int i,t,c,p; - - // Objective function - vector jnll_comp(16); - // Slot 0 -- spatial, encounter - // Slot 1 -- spatio-temporal, encounter - // Slot 2 -- spatial, positive catch - // Slot 3 -- spatio-temporal, positive catch - // Slot 4 -- tow/vessel overdispersion, encounter - // Slot 5 -- tow/vessel overdispersion, positive catch - // Slot 8 -- penalty on beta, encounter - // Slot 9 -- penalty on beta, positive catch - // Slot 10 -- likelihood of data, encounter - // Slot 11 -- likelihood of data, positive catch - // Slot 12 -- Likelihood of Lognormal-Poisson overdispersion delta_i - // Slot 13 -- penalty on estimate_B structure - // Slot 14 -- Spatially varying coefficient, encounter - // Slot 15 -- Spatially varying coefficient, positive catch - jnll_comp.setZero(); - Type jnll = 0; - - // Unpack Options_list - vector Options_vec( Options_list.Options_vec.size() ); - Options_vec = Options_list.Options_vec; - vector Options( Options_list.Options.size() ); - Options = Options_list.Options; - matrix yearbounds_zz( Options_list.yearbounds_zz.col(0).size(), 2 ); - yearbounds_zz = Options_list.yearbounds_zz; - matrix Expansion_cz( n_c, 2 ); - Expansion_cz = Options_list.Expansion_cz; - - // Derived parameters - Type Range_raw1, Range_raw2; - if( Options_vec(7)==0 ){ - Range_raw1 = sqrt(8) / exp( logkappa1 ); // Range = approx. distance @ 10% correlation - Range_raw2 = sqrt(8) / exp( logkappa2 ); // Range = approx. distance @ 10% correlation - } - if( (Options_vec(7)==1) | (Options_vec(7)==2) ){ - Range_raw1 = log(0.1) / logkappa1; // Range = approx. distance @ 10% correlation - Range_raw2 = log(0.1) / logkappa2; // Range = approx. distance @ 10% correlation - } - array SigmaM( n_e, 3 ); - array sigmaXi1_cp( n_c, n_p ); - array sigmaXi2_cp( n_c, n_p ); - SigmaM = exp( logSigmaM ); - sigmaXi1_cp = exp( log_sigmaXi1_cp ); - sigmaXi2_cp = exp( log_sigmaXi2_cp ); - - // Anisotropy elements - matrix H(2,2); - H(0,0) = exp(ln_H_input(0)); - H(1,0) = ln_H_input(1); - H(0,1) = ln_H_input(1); - H(1,1) = (1+ln_H_input(1)*ln_H_input(1)) / exp(ln_H_input(0)); - - // Overwrite parameters when mirroring them - if( RhoConfig(1)==6 ){ - Beta_rho2_c = Beta_rho1_c; - } - if( RhoConfig(3)==6 ){ - Epsilon_rho2_f = Epsilon_rho1_f; - } - - //////////////////////// - // Interactions and fishing mortality - //////////////////////// - - // Define interaction matrix for Epsilon1, and also the impact of F_ct on intercepts - int n_f1; - n_f1 = Epsiloninput1_sft.col(0).cols(); - int n_f2; - n_f2 = Epsiloninput2_sft.col(0).cols(); - matrix B_ff( n_f1, n_f1 ); // Interactions among factors - B_ff = calculate_B( VamConfig(0), n_f1, VamConfig(1), Chi_fr, Psi_fr, jnll_comp(13) ); - matrix iota_ct( n_c, n_t ); // Cumulative impact of fishing mortality F_ct in years <= current year t - matrix B1_cc( n_c, n_c ); // Interactions among categories - matrix covE1_cc( n_c, n_c ); - matrix B2_cc( n_c, n_c ); // Interactions among categories - matrix covE2_cc( n_c, n_c ); - matrix I_cc( n_c, n_c ); - matrix IminusB_cc( n_c, n_c ); - I_cc.setIdentity(); - B1_cc.setZero(); - B2_cc.setZero(); - covE1_cc.setZero(); - covE2_cc.setZero(); - // Calculate interaction matrix B_cc for categories if feasible - if( (n_c==n_f1) & (n_c==n_f2) & (FieldConfig(1)>0) & (FieldConfig(3)>0) ){ - matrix L_epsilon1_cf = loadings_matrix( L_epsilon1_z, n_c, n_f1 ); - matrix Cov_epsilon1_cc = L_epsilon1_cf * L_epsilon1_cf.transpose(); - matrix L_epsilon2_cf = loadings_matrix( L_epsilon2_z, n_c, n_f2 ); - matrix Cov_epsilon2_cc = L_epsilon2_cf * L_epsilon2_cf.transpose(); - matrix Btemp_cc( n_c, n_c ); - // Assemble interaction matrix - B1_cc = B_ff; - for( int c=0; c Btarg_c( n_c ); - vector Ftarg_c( n_c ); - matrix Fratio_ct( n_c, n_t ); - IminusB_cc = I_cc - B1_cc; - Btarg_c = log( 0.4 ); // 40% target, transformed for log-link - Ftarg_c = -1 * ( IminusB_cc * Btarg_c ); - for( int t=0; t sumB1_cc( n_c, n_c ); - IminusB_cc = I_cc - B1_cc; - sumB1_cc = IminusB_cc.inverse(); - iota_ct.col(0) -= sumB1_cc * F_ct.col(0); - } - if( (Options_vec(8)==1) | (Options_vec(8)==2) ){ - // Project forward effect of F_ct from initial year through current year - for( int t=1; t Q1( n_s, n_s ); - Eigen::SparseMatrix Q2( n_s, n_s ); - GMRF_t gmrf_Q; - if( (Options_vec(7)==0) & (Options_vec(0)==0) ){ - Q1 = Q_spde(spde, exp(logkappa1)); - Q2 = Q_spde(spde, exp(logkappa2)); - } - if( (Options_vec(7)==0) & (Options_vec(0)==1) ){ - Q1 = Q_spde(spde_aniso, exp(logkappa1), H); - Q2 = Q_spde(spde_aniso, exp(logkappa2), H); - } - if( Options_vec(7)==1 ){ - Q1 = M0*pow(1+exp(logkappa1*2),2) + M1*(1+exp(logkappa1*2))*(-exp(logkappa1)) + M2*exp(logkappa1*2); - Q2 = M0*pow(1+exp(logkappa2*2),2) + M1*(1+exp(logkappa2*2))*(-exp(logkappa2)) + M2*exp(logkappa2*2); - } - if( Options_vec(7)==2 ){ - Q1 = Q_network( logkappa1, n_s, parent_s, child_s, dist_s ); - Q2 = Q_network( logkappa2, n_s, parent_s, child_s, dist_s ); - } - - ///// - // 1st component - ///// - gmrf_Q = GMRF( Q1, bool(Options(9)) ); - - // Omega1 - array Omegamean1_sf(n_s, Omegainput1_sf.cols() ); - Omegamean1_sf.setZero(); - array Omega1_sc(n_s, n_c); - Omega1_sc = gmrf_by_category_nll(FieldConfig(0), Options_vec(7), VamConfig(2), n_s, n_c, logkappa1, Omegainput1_sf, Omegamean1_sf, L_omega1_z, gmrf_Q, jnll_comp(0), this); - - // Epsilon1 - array Epsilonmean1_sf(n_s, n_f1 ); - // PDF for Epsilon1 - array Epsilon1_sct(n_s, n_c, n_t); - for(t=0; t=(Options(11)+1) ){ - // Prediction for spatio-temporal component - // Default, and also necessary whenever VamConfig(2)==1 & n_f1!=n_c - if( (VamConfig(0)==0) | ((n_f1!=n_c) & (VamConfig(2)==1)) ){ - // If no interactions, then just autoregressive for factors - for(int s=0; s Ximean1_sc(n_s, 1); - array Xi1_scp(n_s, n_c, n_p); - vector Sigma1(1); - array Tmp1_sc(n_s, 1); - Ximean1_sc.setZero(); - Xi1_scp.setZero(); - for(p=0; p Omegamean2_sf(n_s, Omegainput2_sf.cols() ); - Omegamean2_sf.setZero(); - array Omega2_sc(n_s, n_c); - Omega2_sc = gmrf_by_category_nll(FieldConfig(2), Options_vec(7), VamConfig(2), n_s, n_c, logkappa2, Omegainput2_sf, Omegamean2_sf, L_omega2_z, gmrf_Q, jnll_comp(2), this); - - // Epsilon2 - array Epsilonmean2_sf(n_s, n_f2); - // PDF for Epsilon2 - array Epsilon2_sct(n_s, n_c, n_t); - for(t=0; t=(Options(11)+1) ){ - // Prediction for spatio-temporal component - // Default, and also necessary whenever VamConfig(2)==1 & n_f2!=n_c - if( (VamConfig(0)==0) | ((n_f2!=n_c) & (VamConfig(2)==1)) ){ - // If no interactions, then just autoregressive for factors - for(int s=0; s Ximean2_sc(n_s, 1); - array Xi2_scp(n_s, n_c, n_p); - vector Sigma2(1); - array Tmp2_sc(n_s, 1); - Ximean2_sc.setZero(); - Xi2_scp.setZero(); - for(p=0; p eta1_vc(n_v, n_c); - eta1_vc = overdispersion_by_category_nll( OverdispersionConfig(0), n_v, n_c, eta1_vf, L1_z, jnll_comp(4), this ); - matrix eta2_vc(n_v, n_c); - eta2_vc = overdispersion_by_category_nll( OverdispersionConfig(1), n_v, n_c, eta2_vf, L2_z, jnll_comp(5), this ); - - // Possible structure on betas - if( (RhoConfig(0)==1) | (RhoConfig(0)==2) | (RhoConfig(0)==4) ){ - for(c=0; c zeta1_i = Q_ik * lambda1_k.matrix(); - vector zeta2_i = Q_ik * lambda2_k.matrix(); - array eta1_xct(n_x, n_c, n_t); - array eta2_xct(n_x, n_c, n_t); - eta1_xct.setZero(); - eta2_xct.setZero(); - for(int x=0; x var_i(n_i); - Type tmp_calc1; - Type tmp_calc2; - // Linear predictor (pre-link) for presence/absence component - matrix P1_iz(n_i,c_iz.row(0).size()); - // Response predictor (post-link) - // ObsModel_ez(e,0) = 0:4 or 11:12: probability ("phi") that data is greater than zero - // ObsModel_ez(e,0) = 5 (ZINB): phi = 1-ZeroInflation_prob -> Pr[D=0] = NB(0|mu,var)*phi + (1-phi) -> Pr[D>0] = phi - NB(0|mu,var)*phi - vector R1_i(n_i); - vector log_one_minus_R1_i(n_i); - vector log_R1_i(n_i); - vector LogProb1_i(n_i); - // Linear predictor (pre-link) for positive component - matrix P2_iz(n_i,c_iz.row(0).size()); - // Response predictor (post-link) - // ObsModel_ez(e,0) = 0:3, 11:12: expected value of data, given that data is greater than zero -> E[D] = mu*phi - // ObsModel_ez(e,0) = 4 (ZANB): expected value ("mu") of neg-bin PRIOR to truncating Pr[D=0] -> E[D] = mu/(1-NB(0|mu,var))*phi ALSO Pr[D] = NB(D|mu,var)/(1-NB(0|mu,var))*phi - // ObsModel_ez(e,0) = 5 (ZINB): expected value of data for non-zero-inflation component -> E[D] = mu*phi - vector R2_i(n_i); - vector LogProb2_i(n_i); - vector maxJ_i(n_i); - vector diag_z(4); - matrix diag_iz(n_i,4); - diag_iz.setZero(); // Used to track diagnostics for Tweedie distribution (columns: 0=maxJ; 1=maxW; 2=lowerW; 3=upperW) - P1_iz.setZero(); - P2_iz.setZero(); - - // Likelihood contribution from observations - LogProb1_i.setZero(); - LogProb2_i.setZero(); - for(int i=0; i=0) & (c_iz(i,zc)=0) & (t_iz(i,zt)=0) & (c_iz(i,zc) 0 ){ - LogProb1_i(i) = log_R1_i(i); - }else{ - LogProb1_i(i) = log_one_minus_R1_i(i); - } - }else{ - if( b_i(i) > 0 ){ - LogProb1_i(i) = log( R1_i(i) ); - }else{ - LogProb1_i(i) = log( 1-R1_i(i) ); - } - } - // Simulate new values when using obj.simulate() - SIMULATE{ - b_i(i) = rbinom( Type(1), R1_i(i) ); - } - // Positive density likelihood -- models with continuous positive support - if( b_i(i) > 0 ){ // 1e-500 causes overflow on laptop - if(ObsModel_ez(e_i(i),0)==0){ - LogProb2_i(i) = dnorm(b_i(i), R2_i(i), SigmaM(e_i(i),0), true); - // Simulate new values when using obj.simulate() - SIMULATE{ - b_i(i) = rnorm( R2_i(i), SigmaM(e_i(i),0) ); - } - } - if(ObsModel_ez(e_i(i),0)==1){ - LogProb2_i(i) = dlnorm(b_i(i), log(R2_i(i))-pow(SigmaM(e_i(i),0),2)/2, SigmaM(e_i(i),0), true); // log-space - // Simulate new values when using obj.simulate() - SIMULATE{ - b_i(i) = exp(rnorm( log(R2_i(i))-pow(SigmaM(e_i(i),0),2)/2, SigmaM(e_i(i),0) )); - } - } - if(ObsModel_ez(e_i(i),0)==2){ - LogProb2_i(i) = dgamma(b_i(i), 1/pow(SigmaM(e_i(i),0),2), R2_i(i)*pow(SigmaM(e_i(i),0),2), true); // shape = 1/CV^2, scale = mean*CV^2 - // Simulate new values when using obj.simulate() - SIMULATE{ - b_i(i) = rgamma( 1/pow(SigmaM(e_i(i),0),2), R2_i(i)*pow(SigmaM(e_i(i),0),2) ); - } - } - }else{ - LogProb2_i(i) = 0; - } - } - // Likelihood for Tweedie model with continuous positive support - if(ObsModel_ez(e_i(i),0)==8){ - LogProb1_i(i) = 0; - //dPoisGam( Type x, Type shape, Type scale, Type intensity, Type &max_log_w_j, int maxsum=50, int minsum=1, int give_log=0 ) - LogProb2_i(i) = dPoisGam( b_i(i), SigmaM(e_i(i),0), R2_i(i), R1_i(i), diag_z, Options_vec(5), Options_vec(6), true ); - diag_iz.row(i) = diag_z; - // Simulate new values when using obj.simulate() - SIMULATE{ - b_i(i) = 0; // Option not available - } - } - // Likelihood #2 for Tweedie model with continuous positive support - if(ObsModel_ez(e_i(i),0)==10){ - // Packaged code - LogProb1_i(i) = 0; - // dtweedie( Type y, Type mu, Type phi, Type p, int give_log=0 ) - // R1*R2 = mean - LogProb2_i(i) = dtweedie( b_i(i), R1_i(i)*R2_i(i), R1_i(i), invlogit(SigmaM(e_i(i),0))+1.0, true ); - // Simulate new values when using obj.simulate() - SIMULATE{ - b_i(i) = 0; // Option not available - } - } - ///// Likelihood for models with discrete support - // Zero-inflated negative binomial (not numerically stable!) - if(ObsModel_ez(e_i(i),0)==5){ - var_i(i) = R2_i(i)*(1.0+SigmaM(e_i(i),0)) + pow(R2_i(i),2.0)*SigmaM(c_iz(i,0),1); - if( b_i(i)==0 ){ - //LogProb2_i(i) = log( (1-R1_i(i)) + dnbinom2(Type(0.0), R2_i(i), var_i(i), false)*R1_i(i) ); // Pr[X=0] = 1-phi + NB(X=0)*phi - LogProb2_i(i) = logspace_add( log(1-R1_i(i)), dnbinom2(Type(0.0),R2_i(i),var_i(i),true)+log(R1_i(i)) ); // Pr[X=0] = 1-phi + NB(X=0)*phi - }else{ - LogProb2_i(i) = dnbinom2(b_i(i), R2_i(i), var_i(i), true) + log(R1_i(i)); // Pr[X=x] = NB(X=x)*phi - } - // Simulate new values when using obj.simulate() - SIMULATE{ - b_i(i) = rbinom( Type(1), R1_i(i) ); - if( b_i(i)>0 ){ - b_i(i) = rnbinom2( R2_i(i), var_i(i) ); - } - } - } - // Conway-Maxwell-Poisson - if(ObsModel_ez(e_i(i),0)==6){ - LogProb2_i(i) = dCMP(b_i(i), R2_i(i), exp(P1_iz(i,0)), true, Options_vec(5)); - // Simulate new values when using obj.simulate() - SIMULATE{ - b_i(i) = 0; // Option not available - } - } - // Zero-inflated Poisson - if(ObsModel_ez(e_i(i),0)==7){ - if( b_i(i)==0 ){ - //LogProb2_i(i) = log( (1-R1_i(i)) + dpois(Type(0.0), R2_i(i), false)*R1_i(i) ); // Pr[X=0] = 1-phi + Pois(X=0)*phi - LogProb2_i(i) = logspace_add( log(1-R1_i(i)), dpois(Type(0.0),R2_i(i),true)+log(R1_i(i)) ); // Pr[X=0] = 1-phi + Pois(X=0)*phi - }else{ - LogProb2_i(i) = dpois(b_i(i), R2_i(i), true) + log(R1_i(i)); // Pr[X=x] = Pois(X=x)*phi - } - // Simulate new values when using obj.simulate() - SIMULATE{ - b_i(i) = rbinom( Type(1), R1_i(i) ); - if( b_i(i)>0 ){ - b_i(i) = rpois( R2_i(i) ); - } - } - } - // Binned Poisson (for REEF data: 0=none; 1=1; 2=2-10; 3=>11) - /// Doesn't appear stable given spatial or spatio-temporal variation - if(ObsModel_ez(e_i(i),0)==9){ - vector logdBinPois(4); - logdBinPois(0) = logspace_add( log(1-R1_i(i)), dpois(Type(0.0), R2_i(i), true) + log(R1_i(i)) ); // Pr[X=0] = 1-phi + Pois(X=0)*phi - logdBinPois(1) = dpois(Type(1.0), R2_i(i), true) + log(R1_i(i)); // Pr[X | X>0] = Pois(X)*phi - logdBinPois(2) = dpois(Type(2.0), R2_i(i), true) + log(R1_i(i)); // SUM_J( Pr[X|X>0] ) = phi * SUM_J( Pois(J) ) - for(int j=3; j<=10; j++){ - logdBinPois(2) += logspace_add( logdBinPois(2), dpois(Type(j), R2_i(i), true) + log(R1_i(i)) ); - } - logdBinPois(3) = logspace_sub( log(Type(1.0)), logdBinPois(0) ); - logdBinPois(3) = logspace_sub( logdBinPois(3), logdBinPois(1) ); - logdBinPois(3) = logspace_sub( logdBinPois(3), logdBinPois(2) ); - if( b_i(i)==0 ) LogProb2_i(i) = logdBinPois(0); - if( b_i(i)==1 ) LogProb2_i(i) = logdBinPois(1); - if( b_i(i)==2 ) LogProb2_i(i) = logdBinPois(2); - if( b_i(i)==3 ) LogProb2_i(i) = logdBinPois(3); - // Simulate new values when using obj.simulate() - SIMULATE{ - b_i(i) = 0; // Option not available - } - } - // Zero-inflated Lognormal Poisson - if(ObsModel_ez(e_i(i),0)==11){ - if( b_i(i)==0 ){ - //LogProb2_i(i) = log( (1-R1_i(i)) + dpois(Type(0.0), R2_i(i), false)*R1_i(i) ); // Pr[X=0] = 1-phi + Pois(X=0)*phi - LogProb2_i(i) = logspace_add( log(1-R1_i(i)), dpois(Type(0.0),R2_i(i)*exp(SigmaM(e_i(i),0)*delta_i(i)-0.5*pow(SigmaM(e_i(i),0),2)),true)+log(R1_i(i)) ); // Pr[X=0] = 1-phi + Pois(X=0)*phi - }else{ - LogProb2_i(i) = dpois(b_i(i), R2_i(i)*exp(SigmaM(e_i(i),0)*delta_i(i)-0.5*pow(SigmaM(e_i(i),0),2)), true) + log(R1_i(i)); // Pr[X=x] = Pois(X=x)*phi - } - // Simulate new values when using obj.simulate() - SIMULATE{ - b_i(i) = rbinom( Type(1), R1_i(i) ); - if( b_i(i)>0 ){ - b_i(i) = rpois( R2_i(i)*exp(SigmaM(e_i(i),0)*delta_i(i)-0.5*pow(SigmaM(e_i(i),0),2)) ); - } - } - } - // Non-zero-inflated Poisson using log link from 1st linear predictor - if(ObsModel_ez(e_i(i),0)==12){ - LogProb2_i(i) = dpois(b_i(i), R1_i(i), true); - // Simulate new values when using obj.simulate() - SIMULATE{ - b_i(i) = rpois( R1_i(i) ); - } - } - // Non-zero-inflated Bernoulli using cloglog link from 1st lilnear predict - if(ObsModel_ez(e_i(i),0)==13){ - if( b_i(i)==0 ){ - LogProb2_i(i) = dpois(Type(0), R1_i(i), true); - }else{ - LogProb2_i(i) = logspace_sub( log(Type(1.0)), dpois(Type(0), R1_i(i), true) ); - } - // Simulate new values when using obj.simulate() - SIMULATE{ - b_i(i) = rpois( R1_i(i) ); - if( b_i(i)>0 ){ - b_i(i) = 1; - } - } - } - // Non-zero-inflated Lognormal-Poisson using log link from 1st linear predictor - if(ObsModel_ez(e_i(i),0)==14){ - LogProb2_i(i) = dpois(b_i(i), R1_i(i)*exp(SigmaM(e_i(i),0)*delta_i(i)-0.5*pow(SigmaM(e_i(i),0),2)), true); - // Simulate new values when using obj.simulate() - SIMULATE{ - b_i(i) = rpois( R1_i(i)*exp(SigmaM(e_i(i),0)*delta_i(i)-0.5*pow(SigmaM(e_i(i),0),2)) ); - } - } - } - } - REPORT( diag_iz ); - - // Joint likelihood - jnll_comp(10) = -1 * (LogProb1_i * (Type(1.0)-PredTF_i)).sum(); - jnll_comp(11) = -1 * (LogProb2_i * (Type(1.0)-PredTF_i)).sum(); - jnll = jnll_comp.sum(); - Type pred_jnll = -1 * ( LogProb1_i*PredTF_i + LogProb2_i*PredTF_i ).sum(); - REPORT( pred_jnll ); - REPORT( tmp_calc1 ); - REPORT( tmp_calc2 ); - - //////////////////////// - // Calculate index of abundance and density - //////////////////////// - - // Number of output-years - int n_y = t_yz.col(0).size(); - - // Predictive distribution -- ObsModel_ez(e,0)==4 isn't implemented (it had a bug previously) - Type a_average = a_i.sum()/a_i.size(); - array P1_xcy(n_x, n_c, n_y); - array R1_xcy(n_x, n_c, n_y); - array P2_xcy(n_x, n_c, n_y); - array R2_xcy(n_x, n_c, n_y); - array D_xcy(n_x, n_c, n_y); - for(int c=0; c=0) & (t_yz(y,z) Index_xcyl(n_x, n_c, n_y, n_l); - array Index_cyl(n_c, n_y, n_l); - array ln_Index_cyl(n_c, n_y, n_l); - Index_cyl.setZero(); - for(int y=0; y Bratio_cyl(n_c, n_y, n_l); - array ln_Bratio_cyl(n_c, n_y, n_l); - for(int c=0; c mean_Z_cym(n_c, n_y, n_m); - if( Options(2)==1 ){ - mean_Z_cym.setZero(); - int report_summary_TF = false; - for(int c=0; c mean_D_cyl(n_c, n_y, n_l); - array log_mean_D_cyl(n_c, n_y, n_l); - mean_D_cyl.setZero(); - for(int c=0; c effective_area_cyl(n_c, n_y, n_l); - array log_effective_area_cyl(n_c, n_y, n_l); - effective_area_cyl = Index_cyl / (mean_D_cyl/1000); // Correct for different units of Index and density - log_effective_area_cyl = log( effective_area_cyl ); - REPORT( effective_area_cyl ); - ADREPORT( effective_area_cyl ); - ADREPORT( log_effective_area_cyl ); - } - - // Reporting and standard-errors for covariance and correlation matrices - if( Options(5)==1 ){ - if( FieldConfig(0)>0 ){ - matrix L1_omega_cf = loadings_matrix( L_omega1_z, n_c, FieldConfig(0) ); - matrix lowercov_uppercor_omega1 = L1_omega_cf * L1_omega_cf.transpose(); - lowercov_uppercor_omega1 = convert_upper_cov_to_cor( lowercov_uppercor_omega1 ); - REPORT( lowercov_uppercor_omega1 ); - ADREPORT( lowercov_uppercor_omega1 ); - } - if( FieldConfig(1)>0 ){ - matrix L1_epsilon_cf = loadings_matrix( L_epsilon1_z, n_c, FieldConfig(1) ); - matrix lowercov_uppercor_epsilon1 = L1_epsilon_cf * L1_epsilon_cf.transpose(); - lowercov_uppercor_epsilon1 = convert_upper_cov_to_cor( lowercov_uppercor_epsilon1 ); - REPORT( lowercov_uppercor_epsilon1 ); - ADREPORT( lowercov_uppercor_epsilon1 ); - } - if( FieldConfig(2)>0 ){ - matrix L2_omega_cf = loadings_matrix( L_omega2_z, n_c, FieldConfig(2) ); - matrix lowercov_uppercor_omega2 = L2_omega_cf * L2_omega_cf.transpose(); - lowercov_uppercor_omega2 = convert_upper_cov_to_cor( lowercov_uppercor_omega2 ); - REPORT( lowercov_uppercor_omega2 ); - ADREPORT( lowercov_uppercor_omega2 ); - } - if( FieldConfig(3)>0 ){ - matrix L2_epsilon_cf = loadings_matrix( L_epsilon2_z, n_c, FieldConfig(3) ); - matrix lowercov_uppercor_epsilon2 = L2_epsilon_cf * L2_epsilon_cf.transpose(); - lowercov_uppercor_epsilon2 = convert_upper_cov_to_cor( lowercov_uppercor_epsilon2 ); - REPORT( lowercov_uppercor_epsilon2 ); - ADREPORT( lowercov_uppercor_epsilon2 ); - } - } - - // Synchrony - if( Options(6)==1 ){ - int n_z = yearbounds_zz.col(0).size(); - // Density ("D") or area-expanded total biomass ("B") for each category (use B when summing across sites) - matrix D_xy( n_x, n_y ); - matrix B_cy( n_c, n_y ); - vector B_y( n_y ); - D_xy.setZero(); - B_cy.setZero(); - B_y.setZero(); - // Sample variance in category-specific density ("D") and biomass ("B") - array varD_xcz( n_x, n_c, n_z ); - array varD_xz( n_x, n_z ); - array varB_cz( n_c, n_z ); - vector varB_z( n_z ); - vector varB_xbar_z( n_z ); - vector varB_cbar_z( n_z ); - vector ln_varB_z( n_z ); - vector ln_varB_xbar_z( n_z ); - vector ln_varB_cbar_z( n_z ); - array maxsdD_xz( n_x, n_z ); - array maxsdB_cz( n_c, n_z ); - vector maxsdB_z( n_z ); - varD_xcz.setZero(); - varD_xz.setZero(); - varB_cz.setZero(); - varB_z.setZero(); - varB_xbar_z.setZero(); - varB_cbar_z.setZero(); - maxsdD_xz.setZero(); - maxsdB_cz.setZero(); - maxsdB_z.setZero(); - // Proportion of total biomass ("P") for each location or each category - matrix propB_xz( n_x, n_z ); - matrix propB_cz( n_c, n_z ); - propB_xz.setZero(); - propB_cz.setZero(); - // Synchrony indices - matrix phi_xz( n_x, n_z ); - matrix phi_cz( n_c, n_z ); - vector phi_xbar_z( n_z ); - vector phi_cbar_z( n_z ); - vector phi_z( n_z ); - phi_xbar_z.setZero(); - phi_cbar_z.setZero(); - phi_z.setZero(); - // Calculate total biomass for different categories - for( int y=0; y CovHat( n_c, n_c ); - matrix CovHat( n_c, n_c ); - CovHat.setIdentity(); - CovHat *= pow(0.0001, 2); - if( FieldConfig(1)>0 ) CovHat += loadings_matrix(L_epsilon1_z, n_c, FieldConfig(1)) * loadings_matrix(L_epsilon1_z, n_c, FieldConfig(1)).transpose(); - if( FieldConfig(3)>0 ) CovHat += loadings_matrix(L_epsilon2_z, n_c, FieldConfig(3)) * loadings_matrix(L_epsilon2_z, n_c, FieldConfig(3)).transpose(); - // Coherence ranges from 0 (all factors are equal) to 1 (first factor explains all variance) - SelfAdjointEigenSolver > es(CovHat); - vector eigenvalues_c = es.eigenvalues(); // Ranked from lowest to highest for some reason - Type psi = 0; - for(int c=0; c diag_CovHat( n_c ); - vector log_diag_CovHat( n_c ); - for(int c=0; c PropIndex_cyl(n_c, n_y, n_l); - array ln_PropIndex_cyl(n_c, n_y, n_l); - Type sumtemp; - for(int y=0; y D_i( n_i ); - D_i = R1_i * R2_i; - ADREPORT( D_i ); - } - - return jnll; - -} diff --git a/inst/executables/VAST_v7_0_0.cpp b/inst/executables/VAST_v7_0_0.cpp deleted file mode 100644 index 5a45c5c..0000000 --- a/inst/executables/VAST_v7_0_0.cpp +++ /dev/null @@ -1,1801 +0,0 @@ -#include -#include - -// Function to import R list for user-defined Options_vec and Options, packaged as list Options_list in TmbData -template -struct options_list { - vector Options_vec; - vector Options; - matrix yearbounds_zz; - matrix Expansion_cz; - options_list(SEXP x){ // Constructor - Options_vec = asVector(getListElement(x,"Options_vec")); - Options = asVector(getListElement(x,"Options")); - yearbounds_zz = asMatrix(getListElement(x,"yearbounds_zz")); - Expansion_cz = asMatrix(getListElement(x,"Expansion_cz")); - } -}; - -// Needed for returning SparseMatrix -template -Eigen::SparseMatrix Q_network( Type log_theta, int n_s, vector parent_s, vector child_s, vector dist_s ){ - Eigen::SparseMatrix Q( n_s, n_s ); - Type theta = exp( log_theta ); - for(int s=0; s -bool isNA(Type x){ - return R_IsNA(asDouble(x)); -} - -// Posfun -template -Type posfun(Type x, Type lowerlimit, Type &pen){ - pen += CppAD::CondExpLt(x,lowerlimit,Type(0.01)*pow(x-lowerlimit,2),Type(0)); - return CppAD::CondExpGe(x,lowerlimit,x,lowerlimit/(Type(2)-x/lowerlimit)); -} - -// Variance -template -Type var( array vec ){ - Type vec_mod = vec - (vec.sum()/vec.size()); - Type res = pow(vec_mod, 2).sum() / vec.size(); - return res; -} - -// dlnorm -template -Type dlnorm(Type x, Type meanlog, Type sdlog, int give_log=0){ - //return 1/(sqrt(2*M_PI)*sd)*exp(-.5*pow((x-mean)/sd,2)); - Type logres = dnorm( log(x), meanlog, sdlog, true) - log(x); - if(give_log) return logres; else return exp(logres); -} - -// Generate loadings matrix -template -matrix loadings_matrix( vector L_val, int n_rows, int n_cols ){ - matrix L_rc(n_rows, n_cols); - int Count = 0; - for(int r=0; r=c){ - L_rc(r,c) = L_val(Count); - Count++; - }else{ - L_rc(r,c) = 0.0; - } - }} - return L_rc; -} - -// IN: eta1_vf; L1_z -// OUT: jnll_comp; eta1_vc -// eta_jf could be either eta_vf (for overdispersion) or eta_tf (for year effects) -template -matrix covariation_by_category_nll( int n_f, int n_j, int n_c, matrix eta_jf, matrix eta_mean_jf, vector L_z, Type &jnll_pointer, objective_function* of){ - using namespace density; - matrix eta_jc(n_j, n_c); - vector Tmp_c; - // IID - if( n_f == -2 ){ - for( int j=0; j::value && of->do_simulate) { - eta_jf(j,f) = rnorm( eta_mean_jf(j,f), Type(1.0) ); - } - // Rescale - eta_jc(j,c) = eta_jf(j,f) * L_z(f); - }} - } - // Turn off - if( n_f == -1 ){ - eta_jc.setZero(); - } - // AR1 structure - if( n_f==0 ){ - for( int j=0; j::value && of->do_simulate){ - SCALE( AR1(L_z(1)), exp(L_z(0)) ).simulate(Tmp_c); - eta_jf.row(j) = Tmp_c; - } - } - eta_jc = eta_jf; - } - // Factor analysis structure - if( n_f>0 ){ - // Assemble the loadings matrix - matrix L_cf = loadings_matrix( L_z, n_c, n_f ); - // Probability of overdispersion - for( int j=0; j::value && of->do_simulate){ - eta_jf(j,f) = rnorm( eta_mean_jf(j,f), Type(1.0) ); - } - }} - // Multiply out overdispersion - eta_jc = eta_jf * L_cf.transpose(); - } - return eta_jc; -} - -template // -matrix convert_upper_cov_to_cor( matrix cov ){ - int nrow = cov.row(0).size(); - for( int i=0; i // -matrix gmrf_by_category_nll( int n_f, int method, int timing, int n_s, int n_c, Type logkappa, array gmrf_input_sf, array gmrf_mean_sf, vector L_z, density::GMRF_t gmrf_Q, Type &jnll_pointer, objective_function* of){ - using namespace density; - matrix gmrf_sc(n_s, n_c); - vector gmrf_s(n_s); - matrix Cov_cc(n_c,n_c); - array diff_gmrf_sc(n_s, n_c); // Requires an array - Type logtau; - if(method==0) logtau = log( 1 / (exp(logkappa) * sqrt(4*M_PI)) ); - if(method==1) logtau = log( 1 / sqrt(1-exp(logkappa*2)) ); - if( (method!=0) & (method!=1) ) logtau = Type(0.0); - // IID - if(n_f == -2){ - for( int c=0; c::value && of->do_simulate) { - gmrf_Q.simulate(gmrf_s); - gmrf_input_sf.col(f) = gmrf_s + gmrf_mean_sf.col(f); - } - // Rescale - gmrf_sc.col(c) = gmrf_input_sf.col(f) / exp(logtau) * L_z(f); // Rescaling from comp_index_v1d.cpp - } - } - // Turn off - if(n_f == -1){ - gmrf_sc.setZero(); - } - // AR1 structure - if(n_f==0){ - jnll_pointer += SEPARABLE( AR1(L_z(1)), gmrf_Q )(gmrf_input_sf - gmrf_mean_sf); - // Simulate new values when using obj.simulate() - if(isDouble::value && of->do_simulate) { - SEPARABLE( AR1(L_z(1)), gmrf_Q ).simulate(gmrf_input_sf); - gmrf_input_sf += gmrf_input_sf; - } - // Rescale - logtau = L_z(0) - logkappa; // - gmrf_sc = gmrf_input_sf / exp(logtau); // Rescaling from comp_index_v1d.cpp - } - // Factor analysis structure - if(n_f>0){ - // PDF if density-dependence/interactions occurs prior to correlated dynamics - if( timing==0 ){ - for( int f=0; f::value && of->do_simulate) { - gmrf_Q.simulate(gmrf_s); - gmrf_input_sf.col(f) = gmrf_s + gmrf_mean_sf.col(f); - } - } - // Rescale - matrix L_cf = loadings_matrix( L_z, n_c, n_f ); - gmrf_sc = (gmrf_input_sf.matrix() * L_cf.transpose()) / exp(logtau); - } - // PDF if density-dependence/interactions occurs after correlated dynamics (Only makes sense if n_f == n_c) - if( timing==1 ){ - // Calculate difference without rescaling - gmrf_sc = gmrf_input_sf.matrix(); - for( int s=0; s L_cf = loadings_matrix( L_z, n_c, n_f ); - Cov_cc = L_cf * L_cf.transpose(); - jnll_pointer += SCALE(SEPARABLE(MVNORM(Cov_cc), gmrf_Q), exp(-logtau))( diff_gmrf_sc ); - //gmrf_sc = gmrf_sc / exp(logtau); - // Simulate new values when using obj.simulate() - if(isDouble::value && of->do_simulate) { - SEPARABLE(MVNORM(Cov_cc), gmrf_Q).simulate( diff_gmrf_sc ); - gmrf_sc = gmrf_mean_sf + diff_gmrf_sc/exp(logtau); - } - } - } - return gmrf_sc; -} - -// Used to calculate GMRF PDF for initial condition given covariance Cov_cc -// Only makes sense given: -// 1. full-rank factor model -// 2. Spatial Gompertz model conditions -// 3. Timing = 1 -template -matrix gmrf_stationary_nll( int method, int n_s, int n_c, Type logkappa, array gmrf_input_sc, matrix Cov_cc, density::GMRF_t gmrf_Q, Type &jnll_pointer, objective_function* of){ - using namespace density; - array gmrf_sc(n_s, n_c); - Type logtau; - if(method==0) logtau = log( 1 / (exp(logkappa) * sqrt(4*M_PI)) ); - if(method==1) logtau = log( 1 / sqrt(1-exp(logkappa*2)) ); - if( (method!=0) & (method!=1) ) logtau = Type(0.0); - // PDF if density-dependence/interactions occurs after correlated dynamics (Only makes sense if n_f == n_c) - gmrf_sc = gmrf_input_sc.matrix(); - // Calculate likelihood - jnll_pointer += SCALE(SEPARABLE(MVNORM(Cov_cc), gmrf_Q), exp(-logtau))( gmrf_sc ); - // Simulate new values when using obj.simulate() - if(isDouble::value && of->do_simulate) { - SEPARABLE(MVNORM(Cov_cc), gmrf_Q).simulate( gmrf_sc ); - gmrf_sc = gmrf_sc / exp(logtau); - } - return gmrf_sc.matrix(); -} - -// CMP distribution -template -Type dCMP(Type x, Type mu, Type nu, int give_log=0, int iter_max=30, int break_point=10){ - // Explicit - Type ln_S_1 = nu*mu - ((nu-1)/2)*log(mu) - ((nu-1)/2)*log(2*M_PI) - 0.5*log(nu); - // Recursive - vector S_i(iter_max); - S_i(0) = 1; - for(int i=1; i -Type dPoisGam( Type x, Type shape, Type scale, Type intensity, vector &diag_z, int maxsum=50, int minsum=1, int give_log=0 ){ - // Maximum integration constant to prevent numerical overflow, but capped at value for maxsum to prevent numerical underflow when subtracting by a higher limit than is seen in the sequence - Type max_log_wJ, z1, maxJ_bounded; - if( x==0 ){ - diag_z(0) = 1; - max_log_wJ = 0; - diag_z(1) = 0; - }else{ - z1 = log(intensity) + shape*log(x/scale) - shape*log(shape) + 1; - diag_z(0) = exp( (z1 - 1) / (1 + shape) ); - maxJ_bounded = CppAD::CondExpGe(diag_z(0), Type(maxsum), Type(maxsum), diag_z(0)); - max_log_wJ = maxJ_bounded*log(intensity) + (maxJ_bounded*shape)*log(x/scale) - lgamma(maxJ_bounded+1) - lgamma(maxJ_bounded*shape); - diag_z(1) = diag_z(0)*log(intensity) + (diag_z(0)*shape)*log(x/scale) - lgamma(diag_z(0)+1) - lgamma(diag_z(0)*shape); - } - // Integration constant - Type W = 0; - Type log_w_j; - //Type pos_penalty; - for( int j=minsum; j<=maxsum; j++ ){ - Type j2 = j; - //W += pow(intensity,j) * pow(x/scale, j2*shape) / exp(lgamma(j2+1)) / exp(lgamma(j2*shape)) / exp(max_log_w_j); - log_w_j = j2*log(intensity) + (j2*shape)*log(x/scale) - lgamma(j2+1) - lgamma(j2*shape); - //W += exp( posfun(log_w_j, Type(-30), pos_penalty) ); - W += exp( log_w_j - max_log_wJ ); - if(j==minsum) diag_z(2) = log_w_j; - if(j==maxsum) diag_z(3) = log_w_j; - } - // Loglikelihood calculation - Type loglike = 0; - if( x==0 ){ - loglike = -intensity; - }else{ - loglike = -x/scale - intensity - log(x) + log(W) + max_log_wJ; - } - // Return - if(give_log) return loglike; else return exp(loglike); -} - -// Calculate B_cc -template -matrix calculate_B( int method, int n_f, int n_r, matrix Chi_fr, matrix Psi_fr, Type &jnll_pointer ){ - matrix B_ff( n_f, n_f ); - matrix BplusI_ff( n_f, n_f ); - matrix Chi_rf = Chi_fr.transpose(); - matrix Psi_rf = Psi_fr.transpose(); - matrix Identity_ff( n_f, n_f ); - Identity_ff.setIdentity(); - - // No interactions (default) - if( method==0 ){ - B_ff.setZero(); - } - // Simple co-integration -- complex unbounded eigenvalues - if( method==1 ){ - B_ff = Chi_fr * Psi_rf; - } - // Real eigenvalues - if( method==2 ){ - matrix Chi_ff( n_f, n_f ); - Chi_ff = Identity_ff; - // Make Chi_ff - vector colnorm_r( n_r ); - colnorm_r.setZero(); - for(int f=0; f Psi_ff( n_f, n_f ); - Psi_ff = Identity_ff; - for(int f=n_r; f L_ff(n_f, n_f); - L_ff.setZero(); - for(int r=0; r invChi_ff = atomic::matinv( Chi_ff ); - matrix trans_Psi_ff = Psi_ff.transpose(); - matrix trans_invPsi_ff = atomic::matinv( Psi_ff ).transpose(); - B_ff = Chi_ff * trans_Psi_ff; - B_ff = B_ff * L_ff; - B_ff = B_ff * trans_invPsi_ff; - B_ff = B_ff * invChi_ff; - // Penalize colnorm_r - jnll_pointer += ( log(colnorm_r)*log(colnorm_r) ).sum(); - } - // Complex bounded eigenvalues - if( method==3 ){ - BplusI_ff = Chi_fr * Psi_rf + Identity_ff; - // Extract eigenvalues - vector< std::complex > eigenvalues_B_ff = B_ff.eigenvalues(); - vector real_eigenvalues_B_ff = eigenvalues_B_ff.real(); - vector imag_eigenvalues_B_ff = eigenvalues_B_ff.imag(); - vector mod_eigenvalues_B_ff( n_f ); - // Calculate maximum eigenvalues - Type MaxEigen = 1; - for(int f=0; f -matrix stationary_variance( int n_c, matrix B_cc, matrix Cov_cc ){ - int n2_c = n_c*n_c; - matrix Kronecker_c2c2(n2_c,n2_c); - matrix InvDiff_c2c2(n2_c, n2_c); - matrix Vinf_cc(n_c, n_c); - Kronecker_c2c2 = kronecker( B_cc, B_cc ); - InvDiff_c2c2.setIdentity(); - InvDiff_c2c2 = InvDiff_c2c2 - Kronecker_c2c2; - InvDiff_c2c2 = atomic::matinv( InvDiff_c2c2 ); - Vinf_cc.setZero(); - for(int i=0; i -Type objective_function::operator() () -{ - using namespace R_inla; - using namespace Eigen; - using namespace density; - - // Dimensions - DATA_INTEGER(n_i); // Number of observations (stacked across all years) - DATA_INTEGER(n_s); // Number of "strata" (i.e., vectices in SPDE mesh) - DATA_INTEGER(n_x); // Number of real "strata" (i.e., k-means locations) - DATA_INTEGER(n_t); // Number of time-indices - DATA_INTEGER(n_c); // Number of categories (e.g., length bins) - DATA_INTEGER(n_e); // Number of error distributions - DATA_INTEGER(n_p); // Number of dynamic covariates - DATA_INTEGER(n_v); // Number of tows/vessels (i.e., levels for the factor explaining overdispersion) - DATA_INTEGER(n_l); // Number of indices to post-process - DATA_INTEGER(n_m); // Number of range metrics to use (probably 2 for Eastings-Northings) - - // Config - DATA_STRUCT( Options_list, options_list ); - // Options_list.Options_vec - // Slot 0 -- Aniso: 0=No, 1=Yes - // Slot 1 -- DEPRECATED - // Slot 2 -- AR1 on beta1 (year intercepts for 1st linear predictor) to deal with missing years: 0=No, 1=Yes - // Slot 3 -- AR1 on beta2 (year intercepts for 2nd linear predictor) to deal with missing years: 0=No, 1=Yes - // Slot 4 -- DEPRECATED - // Slot 5 -- Upper limit constant of integration calculation for infinite-series density functions (Conway-Maxwell-Poisson and Tweedie) - // Slot 6 -- Breakpoint in CMP density function - // Slot 7 -- Whether to use SPDE or 2D-AR1 hyper-distribution for spatial process: 0=SPDE; 1=2D-AR1; 2=Stream-network - // Slot 8 -- Whether to use F_ct or ignore it for speedup - // Options_list.Options - // Slot 0: Calculate SE for Index_xctl - // Slot 1: Calculate SE for log(Index_xctl) - // Slot 2: Calculate mean_Z_ctm (i.e., center-of-gravity) - // Slot 3: Calculate SE for D_i (expected density for every observation) - // Slot 4: Calculate mean_D_tl and effective_area_tl - // Slot 5: Calculate standard errors for Covariance and Correlation among categories using factor-analysis parameterization - // Slot 6: Calculate synchrony for different periods specified via yearbounds_zz - // Slot 7: Calculate coherence and variance for Epsilon1_sct and Epsilon2_sct - // Slot 8: Calculate proportions and SE - // Slot 9: Include normalization in GMRF PDF - // Slot 10: Calculate Fratio as F_ct divided by F achieving 40% of B0 - // Slot 11: Calculate B0 and Bratio - // Options_list.yearbounds_zz - // Two columns, and 1+ rows, specifying first and last t for each period used in calculating synchrony - // Options_list.Expansion_cz - // Two columns and n_c rows. 1st column: Type of expansion (0=area-expansion; 1=biomass-expansion); 2nd column: Category used for biomass-expansion - DATA_IMATRIX(FieldConfig); // Input settings (vector, length 4) - DATA_IVECTOR(RhoConfig); - DATA_IVECTOR(OverdispersionConfig); // Input settings (vector, length 2) - DATA_IMATRIX(ObsModel_ez); // Observation model - // Column 0: Probability distribution for data for each level of e_i - // Column 1: Link function for linear predictors for each level of c_i - // NOTE: nlevels(c_i) must be <= nlevels(e_i) - DATA_IVECTOR(VamConfig); - // Slot 0 -- method for calculating n_c-by-n_c interaction matrix, B_ff - // Slot 1 -- rank of interaction matrix B_ff - // Current implementation only makes sense when (1) intercepts are constant among years; (2) using a Poisson-link delta model; (3) n_f=n_c for spatio-temporal variation; (4) starts near equilibrium manifold - DATA_IARRAY(Xconfig_zcp); - // Row 0 -- Methods for 1st component for each covariate in X_xtp (0=Off; 1=Estimate; 2=Estimate with spatially varying coefficient) - // Row 1 -- Methods for 2nd component for each covariate in X_xtp (0=Off; 1=Estimate; 2=Estimate with spatially varying coefficient) - DATA_INTEGER(include_data); // Always use TRUE except for internal usage to extract GRMF normalization when turn off GMRF normalization in CPP - - // Data vectors - DATA_VECTOR(b_i); // Response (biomass) for each observation - DATA_VECTOR(a_i); // Area swept for each observation (km^2) - DATA_IMATRIX(c_iz); // Category for each observation - DATA_IVECTOR(e_i); // Error distribution for each observation - DATA_IVECTOR(s_i); // Station for each observation - DATA_IMATRIX(t_iz); // Time-indices (year, season, etc.) for each observation - DATA_IVECTOR(v_i); // tows/vessels for each observation (level of factor representing overdispersion) - DATA_VECTOR(PredTF_i); // vector indicating whether an observatino is predictive (1=used for model evaluation) or fitted (0=used for parameter estimation) - DATA_MATRIX(a_xl); // Area for each "real" stratum(km^2) in each stratum - DATA_ARRAY(X_xtp); // Covariate design matrix (strata x covariate) - DATA_MATRIX(Q_ik); // Catchability matrix (observations x variable) - DATA_IMATRIX(t_yz); // Matrix for time-indices of calculating outputs (abundance index and "derived-quantity") - DATA_MATRIX(Z_xm); // Derived quantity matrix - DATA_MATRIX(F_ct); // Matrix of annual fishing mortality for each category - - // Spatial network inputs - DATA_IVECTOR(parent_s); // Columns: 0=Parent index, 1=Child index, 2=Distance from parent to child - DATA_IVECTOR(child_s); // Columns: 0=Parent index, 1=Child index, 2=Distance from parent to child - DATA_VECTOR(dist_s); // Columns: 0=Parent index, 1=Child index, 2=Distance from parent to child - - // SPDE objects - DATA_STRUCT(spde,spde_t); - - // Aniso objects - DATA_STRUCT(spde_aniso,spde_aniso_t); - - // Sparse matrices for precision matrix of 2D AR1 process - // Q = M0*(1+rho^2)^2 + M1*(1+rho^2)*(-rho) + M2*rho^2 - DATA_SPARSE_MATRIX(M0); - DATA_SPARSE_MATRIX(M1); - DATA_SPARSE_MATRIX(M2); - - // Parameters - PARAMETER_VECTOR(ln_H_input); // Anisotropy parameters - PARAMETER_MATRIX(Chi_fr); // error correction responses - PARAMETER_MATRIX(Psi_fr); // error correction loadings, B_ff = Chi_fr %*% t(Psi_fr) - - // -- presence/absence fixed effects - PARAMETER_MATRIX(beta1_ft); // Year effect - PARAMETER_ARRAY(gamma1_ctp); // Dynamic covariate effect - PARAMETER_VECTOR(lambda1_k); // Catchability coefficients - PARAMETER_VECTOR(L1_z); // Overdispersion parameters - PARAMETER_VECTOR(L_omega1_z); - PARAMETER_VECTOR(L_epsilon1_z); - PARAMETER_VECTOR(L_beta1_z); - PARAMETER(logkappa1); - PARAMETER_VECTOR(Beta_mean1_c); // mean-reversion for beta1_ft - PARAMETER_VECTOR(Beta_rho1_f); // AR1 for presence/absence Beta component, Default=0 - PARAMETER_VECTOR(Epsilon_rho1_f); // AR1 for presence/absence Epsilon component, Default=0 - PARAMETER_ARRAY(log_sigmaXi1_cp); // log-SD of Xi1_scp - PARAMETER_VECTOR(log_sigmaratio1_z); // Ratio of variance for columns of t_iz - - // -- presence/absence random effects - PARAMETER_MATRIX(eta1_vf); - PARAMETER_ARRAY(Xiinput1_scp); // spatially varying coefficient - PARAMETER_ARRAY(Omegainput1_sf); // Expectation - PARAMETER_ARRAY(Epsiloninput1_sft); // Annual variation - - // -- positive catch rates fixed effects - PARAMETER_MATRIX(beta2_ft); // Year effect - PARAMETER_ARRAY(gamma2_ctp); // Dynamic covariate effect - PARAMETER_VECTOR(lambda2_k); // Catchability coefficients - PARAMETER_VECTOR(L2_z); // Overdispersion parameters - PARAMETER_VECTOR(L_omega2_z); - PARAMETER_VECTOR(L_epsilon2_z); - PARAMETER_VECTOR(L_beta2_z); - PARAMETER(logkappa2); - PARAMETER_VECTOR(Beta_mean2_c); // mean-reversion for beta2_t - PARAMETER_VECTOR(Beta_rho2_f); // AR1 for positive catch Beta component, Default=0 - PARAMETER_VECTOR(Epsilon_rho2_f); // AR1 for positive catch Epsilon component, Default=0 - PARAMETER_ARRAY(log_sigmaXi2_cp); // log-SD of Xi2_scp - PARAMETER_VECTOR(log_sigmaratio2_z); // Ratio of variance for columns of t_iz - - // Error distribution parameters - PARAMETER_ARRAY(logSigmaM); - // Columns: 0=CV, 1=[usually not used], 2=[usually not used] - // Rows: Each level of e_i and/or c_i - // SigmaM[,0] indexed by e_i, e.g., SigmaM(e_i(i),0) - // SigmaM[,1] and SigmaM[,2] indexed by c_i, e.g., SigmaM(c_i(i),2) - - // -- positive catch rates random effects - PARAMETER_VECTOR(delta_i); - PARAMETER_MATRIX(eta2_vf); - PARAMETER_ARRAY(Xiinput2_scp); // spatially varying coefficient - PARAMETER_ARRAY(Omegainput2_sf); // Expectation - PARAMETER_ARRAY(Epsiloninput2_sft); // Annual variation - - //////////////////////// - // Preparatory bookkeeping - //////////////////////// - - // Indices -- i=Observation; t=Year; c=Category; p=Dynamic-covariate - int i,t,c,p; - - // Objective function - vector jnll_comp(16); - // Slot 0 -- spatial, encounter - // Slot 1 -- spatio-temporal, encounter - // Slot 2 -- spatial, positive catch - // Slot 3 -- spatio-temporal, positive catch - // Slot 4 -- tow/vessel overdispersion, encounter - // Slot 5 -- tow/vessel overdispersion, positive catch - // Slot 8 -- penalty on beta, encounter - // Slot 9 -- penalty on beta, positive catch - // Slot 10 -- likelihood of data, encounter - // Slot 11 -- likelihood of data, positive catch - // Slot 12 -- Likelihood of Lognormal-Poisson overdispersion delta_i - // Slot 13 -- penalty on estimate_B structure - // Slot 14 -- Spatially varying coefficient, encounter - // Slot 15 -- Spatially varying coefficient, positive catch - jnll_comp.setZero(); - Type jnll = 0; - - // Unpack Options_list - vector Options_vec( Options_list.Options_vec.size() ); - Options_vec = Options_list.Options_vec; - vector Options( Options_list.Options.size() ); - Options = Options_list.Options; - matrix yearbounds_zz( Options_list.yearbounds_zz.col(0).size(), 2 ); - yearbounds_zz = Options_list.yearbounds_zz; - matrix Expansion_cz( n_c, 2 ); - Expansion_cz = Options_list.Expansion_cz; - - // Derived parameters - Type Range_raw1, Range_raw2; - if( Options_vec(7)==0 ){ - Range_raw1 = sqrt(8) / exp( logkappa1 ); // Range = approx. distance @ 10% correlation - Range_raw2 = sqrt(8) / exp( logkappa2 ); // Range = approx. distance @ 10% correlation - } - if( (Options_vec(7)==1) | (Options_vec(7)==2) ){ - Range_raw1 = log(0.1) / logkappa1; // Range = approx. distance @ 10% correlation - Range_raw2 = log(0.1) / logkappa2; // Range = approx. distance @ 10% correlation - } - array SigmaM( n_e, 3 ); - array sigmaXi1_cp( n_c, n_p ); - array sigmaXi2_cp( n_c, n_p ); - SigmaM = exp( logSigmaM ); - sigmaXi1_cp = exp( log_sigmaXi1_cp ); - sigmaXi2_cp = exp( log_sigmaXi2_cp ); - - // Anisotropy elements - matrix H(2,2); - H(0,0) = exp(ln_H_input(0)); - H(1,0) = ln_H_input(1); - H(0,1) = ln_H_input(1); - H(1,1) = (1+ln_H_input(1)*ln_H_input(1)) / exp(ln_H_input(0)); - - // Overwrite parameters when mirroring them - if( RhoConfig(1)==6 ){ - Beta_rho2_f = Beta_rho1_f; - } - if( RhoConfig(3)==6 ){ - Epsilon_rho2_f = Epsilon_rho1_f; - } - - //////////////////////// - // Interactions and fishing mortality - //////////////////////// - - // Define interaction matrix for Epsilon1, and also the impact of F_ct on intercepts - int n_f1; - n_f1 = Epsiloninput1_sft.col(0).cols(); - int n_f2; - n_f2 = Epsiloninput2_sft.col(0).cols(); - matrix B_ff( n_f1, n_f1 ); // Interactions among factors - B_ff = calculate_B( VamConfig(0), n_f1, VamConfig(1), Chi_fr, Psi_fr, jnll_comp(13) ); - matrix iota_ct( n_c, n_t ); // Cumulative impact of fishing mortality F_ct in years <= current year t - matrix B1_cc( n_c, n_c ); // Interactions among categories - matrix covE1_cc( n_c, n_c ); - matrix B2_cc( n_c, n_c ); // Interactions among categories - matrix covE2_cc( n_c, n_c ); - matrix I_cc( n_c, n_c ); - matrix IminusB_cc( n_c, n_c ); - I_cc.setIdentity(); - B1_cc.setZero(); - B2_cc.setZero(); - covE1_cc.setZero(); - covE2_cc.setZero(); - // Calculate interaction matrix B_cc for categories if feasible - if( (n_c==n_f1) & (n_c==n_f2) & (FieldConfig(1,0)>0) & (FieldConfig(1,1)>0) ){ - matrix L_epsilon1_cf = loadings_matrix( L_epsilon1_z, n_c, n_f1 ); - matrix Cov_epsilon1_cc = L_epsilon1_cf * L_epsilon1_cf.transpose(); - matrix L_epsilon2_cf = loadings_matrix( L_epsilon2_z, n_c, n_f2 ); - matrix Cov_epsilon2_cc = L_epsilon2_cf * L_epsilon2_cf.transpose(); - matrix Btemp_cc( n_c, n_c ); - // Assemble interaction matrix - B1_cc = B_ff; - for( int c=0; c Btarg_c( n_c ); - vector Ftarg_c( n_c ); - matrix Fratio_ct( n_c, n_t ); - IminusB_cc = I_cc - B1_cc; - Btarg_c = log( 0.4 ); // 40% target, transformed for log-link - Ftarg_c = -1 * ( IminusB_cc * Btarg_c ); - for( int t=0; t sumB1_cc( n_c, n_c ); - IminusB_cc = I_cc - B1_cc; - sumB1_cc = IminusB_cc.inverse(); - iota_ct.col(0) -= sumB1_cc * F_ct.col(0); - } - if( (Options_vec(8)==1) | (Options_vec(8)==2) ){ - // Project forward effect of F_ct from initial year through current year - for( int t=1; t Q1( n_s, n_s ); - Eigen::SparseMatrix Q2( n_s, n_s ); - GMRF_t gmrf_Q; - if( (Options_vec(7)==0) & (Options_vec(0)==0) ){ - Q1 = Q_spde(spde, exp(logkappa1)); - Q2 = Q_spde(spde, exp(logkappa2)); - } - if( (Options_vec(7)==0) & (Options_vec(0)==1) ){ - Q1 = Q_spde(spde_aniso, exp(logkappa1), H); - Q2 = Q_spde(spde_aniso, exp(logkappa2), H); - } - if( Options_vec(7)==1 ){ - Q1 = M0*pow(1+exp(logkappa1*2),2) + M1*(1+exp(logkappa1*2))*(-exp(logkappa1)) + M2*exp(logkappa1*2); - Q2 = M0*pow(1+exp(logkappa2*2),2) + M1*(1+exp(logkappa2*2))*(-exp(logkappa2)) + M2*exp(logkappa2*2); - } - if( Options_vec(7)==2 ){ - Q1 = Q_network( logkappa1, n_s, parent_s, child_s, dist_s ); - Q2 = Q_network( logkappa2, n_s, parent_s, child_s, dist_s ); - } - - ///// - // 1st component - ///// - gmrf_Q = GMRF( Q1, bool(Options(9)) ); - - // Omega1 - array Omegamean1_sf(n_s, Omegainput1_sf.cols() ); - Omegamean1_sf.setZero(); - array Omega1_sc(n_s, n_c); - Omega1_sc = gmrf_by_category_nll(FieldConfig(0,0), Options_vec(7), VamConfig(2), n_s, n_c, logkappa1, Omegainput1_sf, Omegamean1_sf, L_omega1_z, gmrf_Q, jnll_comp(0), this); - - // Epsilon1 - array Epsilonmean1_sf(n_s, n_f1 ); - // PDF for Epsilon1 - array Epsilon1_sct(n_s, n_c, n_t); - for(t=0; t=(Options(11)+1) ){ - // Prediction for spatio-temporal component - // Default, and also necessary whenever VamConfig(2)==1 & n_f1!=n_c - if( (VamConfig(0)==0) | ((n_f1!=n_c) & (VamConfig(2)==1)) ){ - // If no interactions, then just autoregressive for factors - for(int s=0; s Ximean1_sc(n_s, 1); - array Xi1_scp(n_s, n_c, n_p); - vector Sigma1(1); - array Tmp1_sc(n_s, 1); - Ximean1_sc.setZero(); - Xi1_scp.setZero(); - for(p=0; p Omegamean2_sf(n_s, Omegainput2_sf.cols() ); - Omegamean2_sf.setZero(); - array Omega2_sc(n_s, n_c); - Omega2_sc = gmrf_by_category_nll(FieldConfig(0,1), Options_vec(7), VamConfig(2), n_s, n_c, logkappa2, Omegainput2_sf, Omegamean2_sf, L_omega2_z, gmrf_Q, jnll_comp(2), this); - - // Epsilon2 - array Epsilonmean2_sf(n_s, n_f2); - // PDF for Epsilon2 - array Epsilon2_sct(n_s, n_c, n_t); - for(t=0; t=(Options(11)+1) ){ - // Prediction for spatio-temporal component - // Default, and also necessary whenever VamConfig(2)==1 & n_f2!=n_c - if( (VamConfig(0)==0) | ((n_f2!=n_c) & (VamConfig(2)==1)) ){ - // If no interactions, then just autoregressive for factors - for(int s=0; s Ximean2_sc(n_s, 1); - array Xi2_scp(n_s, n_c, n_p); - vector Sigma2(1); - array Tmp2_sc(n_s, 1); - Ximean2_sc.setZero(); - Xi2_scp.setZero(); - for(p=0; p eta1_mean_vf(n_v, n_eta_f1); - eta1_mean_vf.setZero(); - matrix eta1_vc(n_v, n_c); - eta1_vc = covariation_by_category_nll( OverdispersionConfig(0), n_v, n_c, eta1_vf, eta1_mean_vf, L1_z, jnll_comp(4), this ); - // 1st component - int n_eta_f2; - n_eta_f2 = eta2_vf.cols(); - matrix eta2_mean_vf(n_v, n_eta_f2); - eta2_mean_vf.setZero(); - matrix eta2_vc(n_v, n_c); - eta2_vc = covariation_by_category_nll( OverdispersionConfig(1), n_v, n_c, eta2_vf, eta2_mean_vf, L2_z, jnll_comp(5), this ); - - ////// Probability of correlated innovations on intercepts - // 1st component - Type jnll_beta1 = 0; - int n_beta_f1; - n_beta_f1 = beta1_ft.rows(); - matrix beta1_mean_tf(n_t, n_beta_f1); - matrix beta1_tf( n_t, n_beta_f1 ); - beta1_tf = beta1_ft.transpose(); - for( int f=0; f beta1_tc(n_t, n_c); - beta1_tc = covariation_by_category_nll( FieldConfig(2,0), n_t, n_c, beta1_tf, beta1_mean_tf, L_beta1_z, jnll_beta1, this ); - for( c=0; c beta2_mean_tf(n_t, n_beta_f2); - matrix beta2_tf( n_t, n_beta_f2 ); - beta2_tf = beta2_ft.transpose(); - for( int f=0; f beta2_tc(n_t, n_c); - beta2_tc = covariation_by_category_nll( FieldConfig(2,1), n_t, n_c, beta2_tf, beta2_mean_tf, L_beta2_z, jnll_beta2, this ); - for( c=0; c zeta1_i = Q_ik * lambda1_k.matrix(); - vector zeta2_i = Q_ik * lambda2_k.matrix(); - array eta1_xct(n_x, n_c, n_t); - array eta2_xct(n_x, n_c, n_t); - eta1_xct.setZero(); - eta2_xct.setZero(); - for(int x=0; x var_i(n_i); - Type tmp_calc1; - Type tmp_calc2; - // Linear predictor (pre-link) for presence/absence component - matrix P1_iz(n_i,c_iz.row(0).size()); - // Response predictor (post-link) - // ObsModel_ez(e,0) = 0:4 or 11:12: probability ("phi") that data is greater than zero - // ObsModel_ez(e,0) = 5 (ZINB): phi = 1-ZeroInflation_prob -> Pr[D=0] = NB(0|mu,var)*phi + (1-phi) -> Pr[D>0] = phi - NB(0|mu,var)*phi - vector R1_i(n_i); - vector log_one_minus_R1_i(n_i); - vector log_R1_i(n_i); - vector LogProb1_i(n_i); - // Linear predictor (pre-link) for positive component - matrix P2_iz(n_i,c_iz.row(0).size()); - // Response predictor (post-link) - // ObsModel_ez(e,0) = 0:3, 11:12: expected value of data, given that data is greater than zero -> E[D] = mu*phi - // ObsModel_ez(e,0) = 4 (ZANB): expected value ("mu") of neg-bin PRIOR to truncating Pr[D=0] -> E[D] = mu/(1-NB(0|mu,var))*phi ALSO Pr[D] = NB(D|mu,var)/(1-NB(0|mu,var))*phi - // ObsModel_ez(e,0) = 5 (ZINB): expected value of data for non-zero-inflation component -> E[D] = mu*phi - vector R2_i(n_i); - vector LogProb2_i(n_i); - vector maxJ_i(n_i); - vector diag_z(4); - matrix diag_iz(n_i,4); - diag_iz.setZero(); // Used to track diagnostics for Tweedie distribution (columns: 0=maxJ; 1=maxW; 2=lowerW; 3=upperW) - P1_iz.setZero(); - P2_iz.setZero(); - - // Likelihood contribution from observations - LogProb1_i.setZero(); - LogProb2_i.setZero(); - for(int i=0; i=0) & (c_iz(i,zc)=0) & (t_iz(i,zt)=0) & (c_iz(i,zc) 0 ){ - LogProb1_i(i) = log_R1_i(i); - }else{ - LogProb1_i(i) = log_one_minus_R1_i(i); - } - }else{ - if( b_i(i) > 0 ){ - LogProb1_i(i) = log( R1_i(i) ); - }else{ - LogProb1_i(i) = log( 1-R1_i(i) ); - } - } - // Simulate new values when using obj.simulate() - SIMULATE{ - b_i(i) = rbinom( Type(1), R1_i(i) ); - } - // Positive density likelihood -- models with continuous positive support - if( b_i(i) > 0 ){ // 1e-500 causes overflow on laptop - if(ObsModel_ez(e_i(i),0)==0){ - LogProb2_i(i) = dnorm(b_i(i), R2_i(i), SigmaM(e_i(i),0), true); - // Simulate new values when using obj.simulate() - SIMULATE{ - b_i(i) = rnorm( R2_i(i), SigmaM(e_i(i),0) ); - } - } - if(ObsModel_ez(e_i(i),0)==1){ - LogProb2_i(i) = dlnorm(b_i(i), log(R2_i(i))-pow(SigmaM(e_i(i),0),2)/2, SigmaM(e_i(i),0), true); // log-space - // Simulate new values when using obj.simulate() - SIMULATE{ - b_i(i) = exp(rnorm( log(R2_i(i))-pow(SigmaM(e_i(i),0),2)/2, SigmaM(e_i(i),0) )); - } - } - if(ObsModel_ez(e_i(i),0)==2){ - LogProb2_i(i) = dgamma(b_i(i), 1/pow(SigmaM(e_i(i),0),2), R2_i(i)*pow(SigmaM(e_i(i),0),2), true); // shape = 1/CV^2, scale = mean*CV^2 - // Simulate new values when using obj.simulate() - SIMULATE{ - b_i(i) = rgamma( 1/pow(SigmaM(e_i(i),0),2), R2_i(i)*pow(SigmaM(e_i(i),0),2) ); - } - } - }else{ - LogProb2_i(i) = 0; - } - } - // Likelihood for Tweedie model with continuous positive support - if(ObsModel_ez(e_i(i),0)==8){ - LogProb1_i(i) = 0; - //dPoisGam( Type x, Type shape, Type scale, Type intensity, Type &max_log_w_j, int maxsum=50, int minsum=1, int give_log=0 ) - LogProb2_i(i) = dPoisGam( b_i(i), SigmaM(e_i(i),0), R2_i(i), R1_i(i), diag_z, Options_vec(5), Options_vec(6), true ); - diag_iz.row(i) = diag_z; - // Simulate new values when using obj.simulate() - SIMULATE{ - b_i(i) = 0; // Option not available - } - } - // Likelihood #2 for Tweedie model with continuous positive support - if(ObsModel_ez(e_i(i),0)==10){ - // Packaged code - LogProb1_i(i) = 0; - // dtweedie( Type y, Type mu, Type phi, Type p, int give_log=0 ) - // R1*R2 = mean - LogProb2_i(i) = dtweedie( b_i(i), R1_i(i)*R2_i(i), R1_i(i), invlogit(SigmaM(e_i(i),0))+1.0, true ); - // Simulate new values when using obj.simulate() - SIMULATE{ - b_i(i) = 0; // Option not available - } - } - ///// Likelihood for models with discrete support - // Zero-inflated negative binomial (not numerically stable!) - if(ObsModel_ez(e_i(i),0)==5){ - var_i(i) = R2_i(i)*(1.0+SigmaM(e_i(i),0)) + pow(R2_i(i),2.0)*SigmaM(c_iz(i,0),1); - if( b_i(i)==0 ){ - //LogProb2_i(i) = log( (1-R1_i(i)) + dnbinom2(Type(0.0), R2_i(i), var_i(i), false)*R1_i(i) ); // Pr[X=0] = 1-phi + NB(X=0)*phi - LogProb2_i(i) = logspace_add( log(1-R1_i(i)), dnbinom2(Type(0.0),R2_i(i),var_i(i),true)+log(R1_i(i)) ); // Pr[X=0] = 1-phi + NB(X=0)*phi - }else{ - LogProb2_i(i) = dnbinom2(b_i(i), R2_i(i), var_i(i), true) + log(R1_i(i)); // Pr[X=x] = NB(X=x)*phi - } - // Simulate new values when using obj.simulate() - SIMULATE{ - b_i(i) = rbinom( Type(1), R1_i(i) ); - if( b_i(i)>0 ){ - b_i(i) = rnbinom2( R2_i(i), var_i(i) ); - } - } - } - // Conway-Maxwell-Poisson - if(ObsModel_ez(e_i(i),0)==6){ - LogProb2_i(i) = dCMP(b_i(i), R2_i(i), exp(P1_iz(i,0)), true, Options_vec(5)); - // Simulate new values when using obj.simulate() - SIMULATE{ - b_i(i) = 0; // Option not available - } - } - // Zero-inflated Poisson - if(ObsModel_ez(e_i(i),0)==7){ - if( b_i(i)==0 ){ - //LogProb2_i(i) = log( (1-R1_i(i)) + dpois(Type(0.0), R2_i(i), false)*R1_i(i) ); // Pr[X=0] = 1-phi + Pois(X=0)*phi - LogProb2_i(i) = logspace_add( log(1-R1_i(i)), dpois(Type(0.0),R2_i(i),true)+log(R1_i(i)) ); // Pr[X=0] = 1-phi + Pois(X=0)*phi - }else{ - LogProb2_i(i) = dpois(b_i(i), R2_i(i), true) + log(R1_i(i)); // Pr[X=x] = Pois(X=x)*phi - } - // Simulate new values when using obj.simulate() - SIMULATE{ - b_i(i) = rbinom( Type(1), R1_i(i) ); - if( b_i(i)>0 ){ - b_i(i) = rpois( R2_i(i) ); - } - } - } - // Binned Poisson (for REEF data: 0=none; 1=1; 2=2-10; 3=>11) - /// Doesn't appear stable given spatial or spatio-temporal variation - if(ObsModel_ez(e_i(i),0)==9){ - vector logdBinPois(4); - logdBinPois(0) = logspace_add( log(1-R1_i(i)), dpois(Type(0.0), R2_i(i), true) + log(R1_i(i)) ); // Pr[X=0] = 1-phi + Pois(X=0)*phi - logdBinPois(1) = dpois(Type(1.0), R2_i(i), true) + log(R1_i(i)); // Pr[X | X>0] = Pois(X)*phi - logdBinPois(2) = dpois(Type(2.0), R2_i(i), true) + log(R1_i(i)); // SUM_J( Pr[X|X>0] ) = phi * SUM_J( Pois(J) ) - for(int j=3; j<=10; j++){ - logdBinPois(2) += logspace_add( logdBinPois(2), dpois(Type(j), R2_i(i), true) + log(R1_i(i)) ); - } - logdBinPois(3) = logspace_sub( log(Type(1.0)), logdBinPois(0) ); - logdBinPois(3) = logspace_sub( logdBinPois(3), logdBinPois(1) ); - logdBinPois(3) = logspace_sub( logdBinPois(3), logdBinPois(2) ); - if( b_i(i)==0 ) LogProb2_i(i) = logdBinPois(0); - if( b_i(i)==1 ) LogProb2_i(i) = logdBinPois(1); - if( b_i(i)==2 ) LogProb2_i(i) = logdBinPois(2); - if( b_i(i)==3 ) LogProb2_i(i) = logdBinPois(3); - // Simulate new values when using obj.simulate() - SIMULATE{ - b_i(i) = 0; // Option not available - } - } - // Zero-inflated Lognormal Poisson - if(ObsModel_ez(e_i(i),0)==11){ - if( b_i(i)==0 ){ - //LogProb2_i(i) = log( (1-R1_i(i)) + dpois(Type(0.0), R2_i(i), false)*R1_i(i) ); // Pr[X=0] = 1-phi + Pois(X=0)*phi - LogProb2_i(i) = logspace_add( log(1-R1_i(i)), dpois(Type(0.0),R2_i(i)*exp(SigmaM(e_i(i),0)*delta_i(i)-0.5*pow(SigmaM(e_i(i),0),2)),true)+log(R1_i(i)) ); // Pr[X=0] = 1-phi + Pois(X=0)*phi - }else{ - LogProb2_i(i) = dpois(b_i(i), R2_i(i)*exp(SigmaM(e_i(i),0)*delta_i(i)-0.5*pow(SigmaM(e_i(i),0),2)), true) + log(R1_i(i)); // Pr[X=x] = Pois(X=x)*phi - } - // Simulate new values when using obj.simulate() - SIMULATE{ - b_i(i) = rbinom( Type(1), R1_i(i) ); - if( b_i(i)>0 ){ - b_i(i) = rpois( R2_i(i)*exp(SigmaM(e_i(i),0)*delta_i(i)-0.5*pow(SigmaM(e_i(i),0),2)) ); - } - } - } - // Non-zero-inflated Poisson using log link from 1st linear predictor - if(ObsModel_ez(e_i(i),0)==12){ - LogProb2_i(i) = dpois(b_i(i), R1_i(i), true); - // Simulate new values when using obj.simulate() - SIMULATE{ - b_i(i) = rpois( R1_i(i) ); - } - } - // Non-zero-inflated Bernoulli using cloglog link from 1st lilnear predict - if(ObsModel_ez(e_i(i),0)==13){ - if( b_i(i)==0 ){ - LogProb2_i(i) = dpois(Type(0), R1_i(i), true); - }else{ - LogProb2_i(i) = logspace_sub( log(Type(1.0)), dpois(Type(0), R1_i(i), true) ); - } - // Simulate new values when using obj.simulate() - SIMULATE{ - b_i(i) = rpois( R1_i(i) ); - if( b_i(i)>0 ){ - b_i(i) = 1; - } - } - } - // Non-zero-inflated Lognormal-Poisson using log link from 1st linear predictor - if(ObsModel_ez(e_i(i),0)==14){ - LogProb2_i(i) = dpois(b_i(i), R1_i(i)*exp(SigmaM(e_i(i),0)*delta_i(i)-0.5*pow(SigmaM(e_i(i),0),2)), true); - // Simulate new values when using obj.simulate() - SIMULATE{ - b_i(i) = rpois( R1_i(i)*exp(SigmaM(e_i(i),0)*delta_i(i)-0.5*pow(SigmaM(e_i(i),0),2)) ); - } - } - } - } - REPORT( diag_iz ); - - // Joint likelihood - jnll_comp(10) = -1 * (LogProb1_i * (Type(1.0)-PredTF_i)).sum(); - jnll_comp(11) = -1 * (LogProb2_i * (Type(1.0)-PredTF_i)).sum(); - jnll = jnll_comp.sum(); - Type pred_jnll = -1 * ( LogProb1_i*PredTF_i + LogProb2_i*PredTF_i ).sum(); - REPORT( pred_jnll ); - REPORT( tmp_calc1 ); - REPORT( tmp_calc2 ); - - //////////////////////// - // Calculate index of abundance and density - //////////////////////// - - // Number of output-years - int n_y = t_yz.col(0).size(); - - // Predictive distribution -- ObsModel_ez(e,0)==4 isn't implemented (it had a bug previously) - Type a_average = a_i.sum()/a_i.size(); - array P1_xcy(n_x, n_c, n_y); - array R1_xcy(n_x, n_c, n_y); - array P2_xcy(n_x, n_c, n_y); - array R2_xcy(n_x, n_c, n_y); - array D_xcy(n_x, n_c, n_y); - for(int c=0; c=0) & (t_yz(y,z) Index_xcyl(n_x, n_c, n_y, n_l); - array Index_cyl(n_c, n_y, n_l); - array ln_Index_cyl(n_c, n_y, n_l); - Index_cyl.setZero(); - for(int y=0; y Bratio_cyl(n_c, n_y, n_l); - array ln_Bratio_cyl(n_c, n_y, n_l); - for(int c=0; c mean_Z_cym(n_c, n_y, n_m); - if( Options(2)==1 ){ - mean_Z_cym.setZero(); - int report_summary_TF = false; - for(int c=0; c mean_D_cyl(n_c, n_y, n_l); - array log_mean_D_cyl(n_c, n_y, n_l); - mean_D_cyl.setZero(); - for(int c=0; c effective_area_cyl(n_c, n_y, n_l); - array log_effective_area_cyl(n_c, n_y, n_l); - effective_area_cyl = Index_cyl / (mean_D_cyl/1000); // Correct for different units of Index and density - log_effective_area_cyl = log( effective_area_cyl ); - REPORT( effective_area_cyl ); - ADREPORT( effective_area_cyl ); - ADREPORT( log_effective_area_cyl ); - } - - // Reporting and standard-errors for covariance and correlation matrices - if( Options(5)==1 ){ - if( FieldConfig(0,0)>0 ){ - matrix L1_omega_cf = loadings_matrix( L_omega1_z, n_c, FieldConfig(0,0) ); - matrix lowercov_uppercor_omega1 = L1_omega_cf * L1_omega_cf.transpose(); - lowercov_uppercor_omega1 = convert_upper_cov_to_cor( lowercov_uppercor_omega1 ); - REPORT( lowercov_uppercor_omega1 ); - ADREPORT( lowercov_uppercor_omega1 ); - } - if( FieldConfig(1,0)>0 ){ - matrix L1_epsilon_cf = loadings_matrix( L_epsilon1_z, n_c, FieldConfig(1,0) ); - matrix lowercov_uppercor_epsilon1 = L1_epsilon_cf * L1_epsilon_cf.transpose(); - lowercov_uppercor_epsilon1 = convert_upper_cov_to_cor( lowercov_uppercor_epsilon1 ); - REPORT( lowercov_uppercor_epsilon1 ); - ADREPORT( lowercov_uppercor_epsilon1 ); - } - if( FieldConfig(2,0)>0 ){ - matrix L1_beta_cf = loadings_matrix( L_beta1_z, n_c, FieldConfig(2,0) ); - matrix lowercov_uppercor_beta1 = L1_beta_cf * L1_beta_cf.transpose(); - lowercov_uppercor_beta1 = convert_upper_cov_to_cor( lowercov_uppercor_beta1 ); - REPORT( lowercov_uppercor_beta1 ); - ADREPORT( lowercov_uppercor_beta1 ); - } - if( FieldConfig(0,1)>0 ){ - matrix L2_omega_cf = loadings_matrix( L_omega2_z, n_c, FieldConfig(0,1) ); - matrix lowercov_uppercor_omega2 = L2_omega_cf * L2_omega_cf.transpose(); - lowercov_uppercor_omega2 = convert_upper_cov_to_cor( lowercov_uppercor_omega2 ); - REPORT( lowercov_uppercor_omega2 ); - ADREPORT( lowercov_uppercor_omega2 ); - } - if( FieldConfig(1,1)>0 ){ - matrix L2_epsilon_cf = loadings_matrix( L_epsilon2_z, n_c, FieldConfig(1,1) ); - matrix lowercov_uppercor_epsilon2 = L2_epsilon_cf * L2_epsilon_cf.transpose(); - lowercov_uppercor_epsilon2 = convert_upper_cov_to_cor( lowercov_uppercor_epsilon2 ); - REPORT( lowercov_uppercor_epsilon2 ); - ADREPORT( lowercov_uppercor_epsilon2 ); - } - if( FieldConfig(2,1)>0 ){ - matrix L1_beta_cf = loadings_matrix( L_beta2_z, n_c, FieldConfig(2,1) ); - matrix lowercov_uppercor_beta2 = L2_beta_cf * L2_beta_cf.transpose(); - lowercov_uppercor_beta2 = convert_upper_cov_to_cor( lowercov_uppercor_beta2 ); - REPORT( lowercov_uppercor_beta2 ); - ADREPORT( lowercov_uppercor_beta2 ); - } - } - - // Synchrony - if( Options(6)==1 ){ - int n_z = yearbounds_zz.col(0).size(); - // Density ("D") or area-expanded total biomass ("B") for each category (use B when summing across sites) - matrix D_xy( n_x, n_y ); - matrix B_cy( n_c, n_y ); - vector B_y( n_y ); - D_xy.setZero(); - B_cy.setZero(); - B_y.setZero(); - // Sample variance in category-specific density ("D") and biomass ("B") - array varD_xcz( n_x, n_c, n_z ); - array varD_xz( n_x, n_z ); - array varB_cz( n_c, n_z ); - vector varB_z( n_z ); - vector varB_xbar_z( n_z ); - vector varB_cbar_z( n_z ); - vector ln_varB_z( n_z ); - vector ln_varB_xbar_z( n_z ); - vector ln_varB_cbar_z( n_z ); - array maxsdD_xz( n_x, n_z ); - array maxsdB_cz( n_c, n_z ); - vector maxsdB_z( n_z ); - varD_xcz.setZero(); - varD_xz.setZero(); - varB_cz.setZero(); - varB_z.setZero(); - varB_xbar_z.setZero(); - varB_cbar_z.setZero(); - maxsdD_xz.setZero(); - maxsdB_cz.setZero(); - maxsdB_z.setZero(); - // Proportion of total biomass ("P") for each location or each category - matrix propB_xz( n_x, n_z ); - matrix propB_cz( n_c, n_z ); - propB_xz.setZero(); - propB_cz.setZero(); - // Synchrony indices - matrix phi_xz( n_x, n_z ); - matrix phi_cz( n_c, n_z ); - vector phi_xbar_z( n_z ); - vector phi_cbar_z( n_z ); - vector phi_z( n_z ); - phi_xbar_z.setZero(); - phi_cbar_z.setZero(); - phi_z.setZero(); - // Calculate total biomass for different categories - for( int y=0; y CovHat( n_c, n_c ); - matrix CovHat( n_c, n_c ); - CovHat.setIdentity(); - CovHat *= pow(0.0001, 2); - if( FieldConfig(1,0)>0 ) CovHat += loadings_matrix(L_epsilon1_z, n_c, FieldConfig(1,0)) * loadings_matrix(L_epsilon1_z, n_c, FieldConfig(1,0)).transpose(); - if( FieldConfig(1,1)>0 ) CovHat += loadings_matrix(L_epsilon2_z, n_c, FieldConfig(1,1)) * loadings_matrix(L_epsilon2_z, n_c, FieldConfig(1,1)).transpose(); - // Coherence ranges from 0 (all factors are equal) to 1 (first factor explains all variance) - SelfAdjointEigenSolver > es(CovHat); - vector eigenvalues_c = es.eigenvalues(); // Ranked from lowest to highest for some reason - Type psi = 0; - for(int c=0; c diag_CovHat( n_c ); - vector log_diag_CovHat( n_c ); - for(int c=0; c PropIndex_cyl(n_c, n_y, n_l); - array ln_PropIndex_cyl(n_c, n_y, n_l); - Type sumtemp; - for(int y=0; y D_i( n_i ); - D_i = R1_i * R2_i; - ADREPORT( D_i ); - } - - return jnll; -} diff --git a/inst/executables/VAST_v8_0_0.cpp b/inst/executables/VAST_v8_0_0.cpp index d8f660e..f011e72 100644 --- a/inst/executables/VAST_v8_0_0.cpp +++ b/inst/executables/VAST_v8_0_0.cpp @@ -1632,7 +1632,7 @@ Type objective_function::operator() () ADREPORT( lowercov_uppercor_epsilon2 ); } if( FieldConfig(2,1)>0 ){ - matrix L1_beta_cf = loadings_matrix( L_beta2_z, n_c, FieldConfig(2,1) ); + matrix L2_beta_cf = loadings_matrix( L_beta2_z, n_c, FieldConfig(2,1) ); matrix lowercov_uppercor_beta2 = L2_beta_cf * L2_beta_cf.transpose(); lowercov_uppercor_beta2 = convert_upper_cov_to_cor( lowercov_uppercor_beta2 ); REPORT( lowercov_uppercor_beta2 ); diff --git a/inst/executables/VAST_v8_1_0.cpp b/inst/executables/VAST_v8_1_0.cpp index 886b5bc..5bc8b0a 100644 --- a/inst/executables/VAST_v8_1_0.cpp +++ b/inst/executables/VAST_v8_1_0.cpp @@ -1650,7 +1650,7 @@ Type objective_function::operator() () ADREPORT( lowercov_uppercor_epsilon2 ); } if( FieldConfig(2,1)>0 ){ - matrix L1_beta_cf = loadings_matrix( L_beta2_z, n_c, FieldConfig(2,1) ); + matrix L2_beta_cf = loadings_matrix( L_beta2_z, n_c, FieldConfig(2,1) ); matrix lowercov_uppercor_beta2 = L2_beta_cf * L2_beta_cf.transpose(); lowercov_uppercor_beta2 = convert_upper_cov_to_cor( lowercov_uppercor_beta2 ); REPORT( lowercov_uppercor_beta2 ); diff --git a/inst/executables/VAST_v8_2_0.cpp b/inst/executables/VAST_v8_2_0.cpp index f531294..50235ca 100644 --- a/inst/executables/VAST_v8_2_0.cpp +++ b/inst/executables/VAST_v8_2_0.cpp @@ -1671,7 +1671,7 @@ Type objective_function::operator() () ADREPORT( lowercov_uppercor_epsilon2 ); } if( FieldConfig(2,1)>0 ){ - matrix L1_beta_cf = loadings_matrix( L_beta2_z, n_c, FieldConfig(2,1) ); + matrix L2_beta_cf = loadings_matrix( L_beta2_z, n_c, FieldConfig(2,1) ); matrix lowercov_uppercor_beta2 = L2_beta_cf * L2_beta_cf.transpose(); lowercov_uppercor_beta2 = convert_upper_cov_to_cor( lowercov_uppercor_beta2 ); REPORT( lowercov_uppercor_beta2 ); diff --git a/inst/executables/VAST_v8_3_0.cpp b/inst/executables/VAST_v8_3_0.cpp index af99e90..8f62da4 100644 --- a/inst/executables/VAST_v8_3_0.cpp +++ b/inst/executables/VAST_v8_3_0.cpp @@ -1684,7 +1684,7 @@ Type objective_function::operator() () ADREPORT( lowercov_uppercor_epsilon2 ); } if( FieldConfig(2,1)>0 ){ - matrix L1_beta_cf = loadings_matrix( L_beta2_z, n_c, FieldConfig(2,1) ); + matrix L2_beta_cf = loadings_matrix( L_beta2_z, n_c, FieldConfig(2,1) ); matrix lowercov_uppercor_beta2 = L2_beta_cf * L2_beta_cf.transpose(); lowercov_uppercor_beta2 = convert_upper_cov_to_cor( lowercov_uppercor_beta2 ); REPORT( lowercov_uppercor_beta2 ); diff --git a/inst/executables/VAST_v8_4_0.cpp b/inst/executables/VAST_v8_4_0.cpp index 0e7e937..51d0d9e 100644 --- a/inst/executables/VAST_v8_4_0.cpp +++ b/inst/executables/VAST_v8_4_0.cpp @@ -1731,7 +1731,7 @@ Type objective_function::operator() () ADREPORT( lowercov_uppercor_epsilon2 ); } if( FieldConfig(2,1)>0 ){ - matrix L1_beta_cf = loadings_matrix( L_beta2_z, n_c, FieldConfig(2,1) ); + matrix L2_beta_cf = loadings_matrix( L_beta2_z, n_c, FieldConfig(2,1) ); matrix lowercov_uppercor_beta2 = L2_beta_cf * L2_beta_cf.transpose(); lowercov_uppercor_beta2 = convert_upper_cov_to_cor( lowercov_uppercor_beta2 ); REPORT( lowercov_uppercor_beta2 ); diff --git a/inst/executables/VAST_v8_5_0.cpp b/inst/executables/VAST_v8_5_0.cpp index 1ed9b06..975d9bd 100644 --- a/inst/executables/VAST_v8_5_0.cpp +++ b/inst/executables/VAST_v8_5_0.cpp @@ -1733,7 +1733,7 @@ Type objective_function::operator() () ADREPORT( lowercov_uppercor_epsilon2 ); } if( FieldConfig(2,1)>0 ){ - matrix L1_beta_cf = loadings_matrix( L_beta2_z, n_c, FieldConfig(2,1) ); + matrix L2_beta_cf = loadings_matrix( L_beta2_z, n_c, FieldConfig(2,1) ); matrix lowercov_uppercor_beta2 = L2_beta_cf * L2_beta_cf.transpose(); lowercov_uppercor_beta2 = convert_upper_cov_to_cor( lowercov_uppercor_beta2 ); REPORT( lowercov_uppercor_beta2 ); diff --git a/inst/executables/VAST_v8_6_0.cpp b/inst/executables/VAST_v8_6_0.cpp index b0a7abf..c9b47d3 100644 --- a/inst/executables/VAST_v8_6_0.cpp +++ b/inst/executables/VAST_v8_6_0.cpp @@ -1793,7 +1793,7 @@ Type objective_function::operator() () ADREPORT( lowercov_uppercor_epsilon2 ); } if( FieldConfig(2,1)>0 ){ - matrix L1_beta_cf = create_loadings_covariance( L_beta2_z, n_c, FieldConfig(2,1) ); + matrix L2_beta_cf = create_loadings_covariance( L_beta2_z, n_c, FieldConfig(2,1) ); matrix lowercov_uppercor_beta2 = L2_beta_cf * L2_beta_cf.transpose(); lowercov_uppercor_beta2 = convert_upper_cov_to_cor( lowercov_uppercor_beta2 ); REPORT( lowercov_uppercor_beta2 ); diff --git a/inst/executables/VAST_v9_0_0.cpp b/inst/executables/VAST_v9_0_0.cpp index 7ef43f5..88f95e6 100644 --- a/inst/executables/VAST_v9_0_0.cpp +++ b/inst/executables/VAST_v9_0_0.cpp @@ -1859,7 +1859,7 @@ Type objective_function::operator() () ADREPORT( lowercov_uppercor_epsilon2 ); } if( FieldConfig(2,1)>0 ){ - matrix L1_beta_cf = create_loadings_covariance( L_beta2_z, n_c, FieldConfig(2,1) ); + matrix L2_beta_cf = create_loadings_covariance( L_beta2_z, n_c, FieldConfig(2,1) ); matrix lowercov_uppercor_beta2 = L2_beta_cf * L2_beta_cf.transpose(); lowercov_uppercor_beta2 = convert_upper_cov_to_cor( lowercov_uppercor_beta2 ); REPORT( lowercov_uppercor_beta2 ); diff --git a/inst/extdata/EOF/Kmeans_extrapolation-2000.RData b/inst/extdata/EOF/Kmeans_extrapolation-2000.RData new file mode 100644 index 0000000..a1b4b2d Binary files /dev/null and b/inst/extdata/EOF/Kmeans_extrapolation-2000.RData differ diff --git a/inst/extdata/EOF/Kmeans_knots-50.RData b/inst/extdata/EOF/Kmeans_knots-50.RData new file mode 100644 index 0000000..59e3102 Binary files /dev/null and b/inst/extdata/EOF/Kmeans_knots-50.RData differ diff --git a/inst/extdata/EOF/parameter_estimates.RData b/inst/extdata/EOF/parameter_estimates.RData new file mode 100644 index 0000000..6ac109a Binary files /dev/null and b/inst/extdata/EOF/parameter_estimates.RData differ diff --git a/man/Effect.fit_model.Rd b/man/Effect.fit_model.Rd index d347aee..f27e978 100644 --- a/man/Effect.fit_model.Rd +++ b/man/Effect.fit_model.Rd @@ -8,7 +8,7 @@ Effect.fit_model( focal.predictors, mod, which_formula = "X1", - pad_values = c(), + pad_values = c(1), category_number = NULL, ... ) @@ -16,11 +16,16 @@ Effect.fit_model( \arguments{ \item{focal.predictors}{a character vector of one or more predictors in the model in any order.} -\item{mod}{an object of the appropriate class. If no method exists for that class, \code{Effect.default} will be called. } +\item{mod}{a regression model object. If no specific method exists for the class of \code{mod}, \code{Effect.default} will be called.} \item{which_formula}{which formula to use e.g., \code{"X1"}} -\item{category_number}{which category code{c_i} to use when plotting density covariates} +\item{category_number}{which category code{c_i} to use when plotting density covariates + +If getting the error \code{non-conformable arguments}, consider exploring \code{pad_values} + The error arises in when constructing the linear predictor without an intercept, + and the default \code{pad_values = 1} attempts to insert a dummy intercept with estimate and SE + equal to zero.} \item{...}{arguments to be passed down.} } diff --git a/man/VAST.Rd b/man/VAST.Rd index 31e1f6f..e26d64c 100644 --- a/man/VAST.Rd +++ b/man/VAST.Rd @@ -19,8 +19,11 @@ Features are built to be compatible among model types, e.g., by allowing catchab } \details{ See \code{\link[FishStatsUtils]{fit_model}} for a simple example of high-level wrapper functions for using VAST. -Also see the wiki \url{https://github.com/James-Thorson-NOAA/VAST/wiki} for examples documenting many different use-cases and features. } \seealso{ \code{\link[VAST]{VAST}} for general documentation, \code{\link[FishStatsUtils]{make_settings}} for generic settings, \code{\link[FishStatsUtils]{fit_model}} for model fitting, and \code{\link[FishStatsUtils]{plot_results}} for generic plots + +VAST wiki \url{https://github.com/James-Thorson-NOAA/VAST/wiki} for examples documenting many different use-cases and features. + +GitHub mainpage \url{https://github.com/James-Thorson-NOAA/VAST#description} for a list of user resources and publications documenting features } diff --git a/man/apply_epsilon.Rd b/man/apply_epsilon.Rd new file mode 100644 index 0000000..c5ff515 --- /dev/null +++ b/man/apply_epsilon.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/apply_epsilon.R +\name{apply_epsilon} +\alias{apply_epsilon} +\title{Custom epsilon-correct method} +\usage{ +apply_epsilon( + fit, + ADREPORT_name = "Index_ctl", + eps_name = "eps_Index_ctl", + inner.control = list(sparse = TRUE, lowrank = TRUE, trace = FALSE) +) +} +\arguments{ +\item{fit}{output from \code{\link[FishStatsUtils]{fit_model}}, specifically using +slotes \code{tmb_list}, \code{input_args}, \code{parameter_estimates$SD}} + +\item{ADREPORT_name}{string indicating name of ADREPORT'ed variable} + +\item{eps_name}{string indicating name of PARAMETER used internally by TMB +for calculating desired gradient} + +\item{inner.control}{List controlling inner optimization.} +} +\value{ +Standard output from \code{\link[TMB]{sdreport}}, but with slot + \code{x$unbiased} added if needed, and adding or replacing values for + \code{x$unbiased$value} corresponding to \code{ADREPORT_name} +} +\description{ +\code{apply_epsilon} uses updates to TMB to implement a faster calculation for epsilon-correction +} diff --git a/man/make_data.Rd b/man/make_data.Rd index 0338b32..31a9e4a 100644 --- a/man/make_data.Rd +++ b/man/make_data.Rd @@ -146,11 +146,14 @@ any variable referenced in \code{X1_formula} and \code{X2_formula} must be in \c which is then estimated independently for each model category \code{c_i}, e.g., use \code{X1_formula=~BOT_DEPTH+BOT_DEPTH^2} for a quadratic effect of variable \code{BOT_DEPTH} that is estimated independently for each category. -The effect of an estimated effect also used upon when predicting the value for each location +The effect of an estimated effect is also used when predicting the value for each location in the extrapolation-grid. Therefore, \code{X1_formula} is interepreted as affecting the "true" underlying value of each variable, and it affects both samples and extrapolated values. It is allowed to include \code{Year} in the formula, although please check whether it is -interpreted as numeric or factor-valued.} +interpreted as numeric or factor-valued. +Note that \code{X1_formula} is internally updated (and resulting design-matrices are modified) to avoid +any intercept from arising in \code{X1_ip} and \code{X1_gctp}, to avoid identifiability issues between covariates and +intercepts for each category.} \item{X2_formula}{same as \code{X1_formula} but affecting the 2nd linear predictor.} @@ -179,12 +182,18 @@ By default uses \code{X1_contrasts = NULL}, which will set the first level of ea However, the effect of \code{Q1_formula} is not used when predicting values at extrapolation-grid locations. Therefore, the \code{Q1_formula} is interpreted as affecting "catchability" (a.k.a. "detectabiility"), and it represents processes that affect the outcome of sampling but not the "true" underlying value of a variable being sampled. -For example, a factor representing gear-type might be included to estimate the relative performacne of each gear type -(relative to the base level of that factor). +For example, to estimate the relative performance of differeng gear types, include \code{catchability_data = data.frame(gear=gear_factor)} +where \code{gear_factor} is a factor-valued indicator for different gear types and \code{Q1_formula = ... + gear}, +and this will estimate the catchability for each level relative to the base level of that factor. Note that \code{Q1_formula} defines a relationship that is applied to all samples (regardless of category \code{c_i}), whereas \code{X1_formula} defines a relationship that is estimated independently for each category. -For a catchability covariate that varies by category, please include the category as factor in \code{catchability_data} -and then include an interaction with category in \code{Q1_formula} for any variable which has an effect that varies among categories.} +Also note that \code{\link{make_data}} includes \code{c_iz[,1]} as a column labeled \code{category} in \code{catchability_data}, +and that \code{Q1_formula} is internally updated (and resulting design-matrices are modified) to avoid +any category-specific intercept from arising in \code{Q1_ik}, to avoid identifiability issues between category-specific +covariates and intercepts. +For example, for a catchability covariate that varies by category, include an interaction with category in \code{Q1_formula}, +e.g., \code{Q1_formula = ... + category:gear} where \code{gear} is a factor to estimate category-specific catchability ratio for +different levels of \code{gear}.} \item{Q2_formula}{same as \code{Q2_formula} but affecting the 2nd linear predictor.} @@ -221,16 +230,19 @@ calculate changes in synchrony over time (only used if \code{Options['Calculate_ \item{\code{Options["Calculate_proportion"]=TRUE}}{Turns on internal calculation and SE for proportion of response within each category (e.g., for calculating proportion-at-age or species turnover)} \item{\code{Options["Calculate_Synchrony"]=TRUE}}{Turns on internal calculation and SE for Loreau metric of synchrony (a.k.a. portfolio effects)} \item{\code{Options["report_additional_variables"]=TRUE}}{Export additional variables to \code{Report} object, to use for diagnostics or additional exploration} - \item{\code{Options["range_fraction"]}}{The decorrelation range when passing over land relative to over water; the default value \code{Options["range_fraction"]=0.2} indicates that the range is shorter over land, i.e., that correlations are strongest via water, while changing to \code{Options["range_fraction"]=5} would represent correlations transfer via land more than water} -}} + \item{\code{Options["basin_method"]}}{Controls how the density-dependent index is generated from model variables. Default \code{Options["basin_method"]=2}) uses annual mean of betas and epsilons as index. Alternative \code{Options["basin_method"]=4}) uses a Lagrange multiplier to penalize index towards total abundance} + \item{\code{Options["range_fraction"]}}{The decorrelation range when passing over land relative to over water; the default value \code{Options["range_fraction"]=0.2} indicates that the range is shorter over land, i.e., that correlations are strongest via water, while changing to \code{Options["range_fraction"]=5} would represent correlations transfer via land more than water}#' }} \item{Expansion_cz}{matrix specifying how densities are expanded when calculating annual indices, with a row for each category \code{c} and two columns. The first column specifies whether to calculate annual index for category \code{c} as the weighted-sum across density estimates, where density is weighted by area ("area-weighted expansion", \code{Expansion[c,1]=0}, the default), where density is weighted by the expanded value for another category ("abundance weighted expansion" \code{Expansion[c1,1]=1}), -or the index is calculated as the weighted average of density weighted by the expanded value for another category -("abundance weighted-average expansion" \code{Expansion[c1,1]=2}). The 2nd column is only used when \code{Expansion[c1,1]=1} or \code{Expansion[c1,1]=2}, -and specifies the category to use for abundance-weighted expansion, where \code{Expansion[c1,2]=c2} and \code{c2} must be lower than \code{c1}.} +the index is calculated as the weighted average of density weighted by the expanded value for another category +("abundance weighted-average expansion" \code{Expansion[c1,1]=2}), or the area-weighted abundance is added to the expanded +abundance for a prior category \code{Expansion[c1,1]=3}). +The 2nd column is used when \code{Expansion[c1,1]=1} or \code{Expansion[c1,1]=2} or \code{Expansion[c1,1]=3}, +and specifies the category to use for abundance-weighted expansion/average/summation, +where \code{Expansion[c1,2]=c2} and \code{c2} must be lower than \code{c1}.} \item{Z_gm}{matrix specifying coordinates to use when calculating center-of-gravity and range-edge statistics. Defaults to eastings and northings for each knots or extrapolation-grid cell.} diff --git a/man/make_model.Rd b/man/make_model.Rd index 0069ee7..4e0867e 100644 --- a/man/make_model.Rd +++ b/man/make_model.Rd @@ -20,7 +20,11 @@ make_model( TmbDir = system.file("executables", package = "VAST"), RunDir = getwd(), CompileDir = TmbDir, - build_model = TRUE + build_model = TRUE, + framework = "TMBad", + intern = FALSE, + inner.control = list(sparse = TRUE, lowrank = TRUE, trace = FALSE), + supernodal = FALSE ) } \arguments{ @@ -76,6 +80,14 @@ from the list of outputs, modifying it manually, and then passing it explicitly, (must have write privileges or else the function will crash); by default uses \code{TmbDir} (OPTIONAL)} \item{build_model}{Boolean indicating whether to build the model, \code{build_model=TRUE}, or simply build the inputs, \code{build_model=FALSE}} + +\item{framework}{Which AD framework to use ('TMBad' or 'CppAD')} + +\item{intern}{Do Laplace approximation on C++ side ? See details (Experimental - may change without notice)} + +\item{inner.control}{List controlling inner optimization.} + +\item{supernodal}{Turn on preprocessor flag to use supernodal sparse Cholesky/Inverse from system wide suitesparse library} } \value{ Object of class \code{make_model}, containing objects for running a VAST model diff --git a/man/project_model.Rd b/man/project_model.Rd new file mode 100644 index 0000000..da11512 --- /dev/null +++ b/man/project_model.Rd @@ -0,0 +1,78 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/project_model.R +\name{project_model} +\alias{project_model} +\title{Project a fitted VAST model forward in time} +\usage{ +project_model( + x, + n_proj, + n_samples = 1, + new_covariate_data = NULL, + historical_uncertainty = "both", + seed = 123456, + working_dir = paste0(getwd(), "/"), + what = NULL +) +} +\arguments{ +\item{x}{Output from \code{\link{fit_model}}} + +\item{n_proj}{Number of time-steps to include in projection} + +\item{n_samples}{Number of samples to include. If \code{n_samples=1} then \code{project_model} +just returns the list of REPORTed variables. If \code{n_samples>1} then \code{project_model} +returns a list of lists, where each element is the list of REPORTed variables.} + +\item{new_covariate_data}{New covariates to include for future intervals} + +\item{historical_uncertainty}{Whether to incorporate uncertainty about fitted interval +\describe{ + \item{\code{historical_uncertainty="both"}}{Include uncertainty in fixed and random effects using joint precision matrix} + \item{\code{historical_uncertainty="random"}}{Include uncertainty in random effects using inner Hessian matrix} + \item{\code{historical_uncertainty="none"}}{Condition upon MLE for fixed and Empirical Bayes for random effects} +}} +} +\value{ +All \code{obj$report()} output for a single simulation of historical period + as well as \code{n_proj} forecast intervals +} +\description{ +\code{project_model} simulates random effects forward in time, for use to + generate a predictive interval without actually re-fitting the model. + This is useful e.g., to generate end-of-century projections. +} +\details{ +The function specifically simulates new values for random effects occurring + during forecasted years. This includes some combination of intercepts + {beta1/beta2} and spatio-temporal terms {epsilon1/epsilon2} depending on which + are treated as random during estimation. It does *not* generate new values of + covariates or random-effects that are not indexed by time {omega1/omega2} + +Note that the model may behave poorly when \code{historical_uncertainty="both"} + and the estimation model includes an AR1 process for any component. + Given this combination of features, some samples may have a `rho` value >1 + or <1, which will result in exponential growth for any such sampled value. + This behavior could be improved in future code updates by using \code{tmbstan} + instead of the normal approximation to generate parametric uncertainty + during the historical period. + +Similarly, estimating a RW process for epsilon will result in an exponential increase + in forecasted total abundance over time. This occurs because the variance across locations + of epsilon increases progressively during the forecast period, such that + the index is again dominated by the forecasted density at a few sites. +} +\examples{ +\dontrun{ +# Run model +fit = fit_model( ... ) + +# Add projection +project_model( x = fit, + n_proj = 80, + new_covariate_data = NULL, + historical_uncertainty = "both", + seed = NULL ) +} + +} diff --git a/man/reload_model.Rd b/man/reload_model.Rd new file mode 100644 index 0000000..1b440ec --- /dev/null +++ b/man/reload_model.Rd @@ -0,0 +1,48 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/reload_model.R +\name{reload_model} +\alias{reload_model} +\title{Reload a VAST model} +\usage{ +reload_model( + x, + check_gradient = TRUE, + CompileDir = system.file("executables", package = "VAST"), + Version = x$settings$Version, + framework = x$input_args$model_args_input$framework, + Obj = x$tmb_list$Obj +) +} +\arguments{ +\item{x}{Output from \code{\link{fit_model}}, potentially with DLLs not linked} + +\item{check_gradient}{Whether to check the gradients of the reloaded model} + +\item{CompileDir}{a directory where the CPP file is copied, copiled, and run +(must have write privileges or else the function will crash); by default uses \code{TmbDir} (OPTIONAL)} + +\item{Version}{Which CPP version to use. If missing, defaults to latest version +using \code{\link[FishStatsUtils]{get_latest_version}}. +Can be used to specify using an older CPP, to maintain backwards compatibility.} + +\item{framework}{Which AD framework to use ('TMBad' or 'CppAD')} +} +\value{ +Output from \code{\link{fit_model}} with DLLs relinked +} +\description{ +\code{reload_model} allows a user to save a fitted model, reload it in a new + R terminal, and then relink the DLLs so that it functions as expected. +} +\examples{ +\dontrun{ +# Run model +fit = fit_model( ... ) +saveRDS( object=fit, file="path_and_name.rds" ) + +# Reload and relink +fit_new = readRDS( file="path_and_name.rds" ) +fit_new = reload_model( x = fit_new ) +} + +} diff --git a/manual/VAST_model_structure.docx b/manual/VAST_model_structure.docx index c665c12..b4f541d 100644 Binary files a/manual/VAST_model_structure.docx and b/manual/VAST_model_structure.docx differ diff --git a/manual/VAST_model_structure.pdf b/manual/VAST_model_structure.pdf index 2866900..dd38eeb 100644 Binary files a/manual/VAST_model_structure.pdf and b/manual/VAST_model_structure.pdf differ diff --git a/tests/testthat.R b/tests/testthat.R index 20fb517..1343156 100644 --- a/tests/testthat.R +++ b/tests/testthat.R @@ -1,12 +1,12 @@ -# devtools::install_github("james-thorson/FishStatsUtils", ref="development") -# devtools::install_github("james-thorson/VAST", ref="development") -# devtools::install_local("C:/Users/James.Thorson/Desktop/Git/TMB_contrib_R/TMBhelper", force=TRUE, dep=FALSE) +# remotes::install_github("james-thorson-NOAA/FishStatsUtils", ref="dev") +# remotes::install_github("james-thorson-NOAA/VAST", ref="dev") +# remotes::install_local("C:/Users/James.Thorson/Desktop/Git/TMB_contrib_R/TMBhelper", force=TRUE, dep=FALSE) # devtools::document("C:/Users/James.Thorson/Desktop/Git/FishStatsUtils") -# devtools::install_local("C:/Users/James.Thorson/Desktop/Git/FishStatsUtils", force=TRUE, dep=FALSE) +# remotes::install_local("C:/Users/James.Thorson/Desktop/Git/FishStatsUtils", force=TRUE, dep=TRUE) # devtools::document("C:/Users/James.Thorson/Desktop/Git/VAST") -# devtools::install_local("C:/Users/James.Thorson/Desktop/Git/VAST", force=TRUE, dep=FALSE) +# remotes::install_local("C:/Users/James.Thorson/Desktop/Git/VAST", force=TRUE, dep=FALSE) # devtools::document("C:/Users/James.Thorson/Desktop/Git/FishStatsUtils") @@ -34,7 +34,6 @@ testthat::test_check("VAST") ################ # Use local path -# singlespecies_example_path="C:/Users/James.Thorson/Desktop/Git/geostatistical_delta-GLMM/inst/extdata/"; multispecies_example_path="C:/Users/James.Thorson/Desktop/Git/VAST/inst/extdata/" # source( "C:/Users/James.Thorson/Desktop/Git/VAST/tests/testthat/setup.R" ) # Run from local directory diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R index 599ec86..9f7fe53 100644 --- a/tests/testthat/setup.R +++ b/tests/testthat/setup.R @@ -3,7 +3,7 @@ library(FishStatsUtils) ## skip the main tests? caught with skip_if(skip_local) in all ## tests except platform skip_local <- FALSE -singlespecies_example_path <- system.file("extdata", package="SpatialDeltaGLMM") +singlespecies_example_path <- system.file("extdata", package="FishStatsUtils") multispecies_example_path <- system.file("extdata", package="VAST") ## working directory is VAST/tests/testthat when running test() ## Version_VAST <- FishStatsUtils::get_latest_version() diff --git a/tests/testthat/test-EOF.R b/tests/testthat/test-EOF.R new file mode 100644 index 0000000..b031481 --- /dev/null +++ b/tests/testthat/test-EOF.R @@ -0,0 +1,58 @@ + + +# Tutorial: http://r-pkgs.had.co.nz/tests.html +# And example see: https://github.com/ss3sim/ss3sim/tree/master/tests/testthat +context("Testing examples") + +# Eastern Bering Sea pollcok +test_that("EOF is working ", { + # Previously worked with CI, but not anymore + #skip_on_ci() + skip_if(skip_local) + + test_path = file.path(multispecies_example_path,"EOF") + load( file.path(test_path,"parameter_estimates.RData") ) + #file.copy( from=paste0(test_path,"/Kmeans_extrapolation-2000.RData"), to=paste0(test_path,"/Kmeans_extrapolation-2000.RData") ) + #file.copy( from=paste0(test_path,"/Kmeans_knots-50.RData"), to=paste0(test_path,"/Kmeans_knots-50.RData") ) + + # load data set + example = load_example( data_set="five_species_ordination" ) + which_rows = which( example$sampling_data[,'species_number'] %in% c(1,2) & + example$sampling_data[,'Year'] %in% 2006:2015 ) + + # Make settings: + # including modifications from default settings to match + # analysis in original paper + settings = make_settings( n_x = 50, + Region = example$Region, + purpose = "EOF3", + Version = Version_VAST, + n_categories = 2, + ObsModel = c(1,1), + RhoConfig = c("Beta1"=0,"Beta2"=0,"Epsilon1"=0,"Epsilon2"=0) ) + #settings$Version = "VAST_v14_0_0" + + # Run model (including settings to speed up run) + #dyn.unload( paste0(TmbDir = system.file("executables", package = "VAST"), "/", settings$Version) ) + fit = fit_model( settings = settings, + Lat_i = example$sampling_data[which_rows,'Lat'], + Lon_i = example$sampling_data[which_rows,'Lon'], + t_i = example$sampling_data[which_rows,'Year'], + c_i = example$sampling_data[which_rows,'species_number']-1, + b_i = example$sampling_data[which_rows,'Catch_KG'], + a_i = example$sampling_data[which_rows,'AreaSwept_km2'], + #Parameters = fit$ParHat, + #run_model = TRUE, + newtonsteps = 0, + getsd = FALSE, + Use_REML = TRUE, + working_dir = test_path ) + + # Comparisons -- Use abs(.) to avoid label switching + Par1 = fit$parameter_estimates$par[names(fit$parameter_estimates$par)%in%c("ln_H_input","L_omega1_z","Ltime_epsilon1_z","logkappa1","logSigmaM")] + Par2 = parameter_estimates$par[names(parameter_estimates$par)%in%c("ln_H_input","L_omega1_z","Ltime_epsilon1_z","logkappa1","logSigmaM")] + expect_equal( abs(as.vector(Par1)), abs(as.vector(Par2)), tolerance=1e-3 ) + expect_equal( as.numeric(parameter_estimates$objective), as.numeric(fit$parameter_estimates$objective), tolerance=1e-3 ) + +}) + diff --git a/tests/testthat/test-Tweedie-against-mgcv.R b/tests/testthat/test-Tweedie-against-mgcv.R index 4390afa..476915a 100644 --- a/tests/testthat/test-Tweedie-against-mgcv.R +++ b/tests/testthat/test-Tweedie-against-mgcv.R @@ -6,7 +6,7 @@ context("Testing examples") # Tweedie distribution test_that("Tweedie gives identical results to mgcv::gam(.) ", { # Previously worked with CI, but not anymore - skip_on_ci() + #skip_on_ci() skip_if(skip_local) library(mgcv) @@ -162,7 +162,47 @@ test_that("Covariate effects when using a smoother gives identical results to mg family=gaussian, offset=log(Area_km2), data=Data[which(Data$catch>0),], method="ML" ) # slopes - expect_equal( as.numeric(fit$ParHat$gamma1_cp), as.numeric(summary(gam1)$p.coeff[c('Temp_i','I(Temp_i^2)')]), tolerance=0.1 ) - expect_equal( as.numeric(fit$ParHat$gamma2_cp), as.numeric(summary(gam2)$p.coeff[c('Temp_i','I(Temp_i^2)')]), tolerance=0.1 ) + match1 = match( c('Temp_i','I(Temp_i^2)'), names(summary(gam1)$p.coeff) ) + expect_equal( as.numeric(fit$ParHat$gamma1_cp), as.numeric(summary(gam1)$p.coeff[match1]), tolerance=0.1 ) + #expect_equal( as.numeric(fit$ParHat$beta1_ft), as.numeric(summary(gam1)$p.coeff[-match1]), tolerance=0.1 ) + match2 = match( c('Temp_i','I(Temp_i^2)'), names(summary(gam2)$p.coeff) ) + expect_equal( as.numeric(fit$ParHat$gamma2_cp), as.numeric(summary(gam2)$p.coeff[match2]), tolerance=0.1 ) + #expect_equal( as.numeric(fit$ParHat$beta2_ft), as.numeric(summary(gam2)$p.coeff[-match2]), tolerance=0.1 ) + + ################## + # Try predict ... I haven't gotten this to work yet + ################## + + if( FALSE ){ + # Randomize new data + newdata = Data + for(cI in 1:ncol(Data)) newdata[,cI] = sample( newdata[,cI], replace=FALSE ) + #covariate_new = data.frame( "Lat"=newdata$lat, "Lon"=newdata$long, "Year"=newdata$year, "Temp"=newdata$waterTmpC) + + # predict.fit_model test -- Component 1 + pred1_gam = predict( gam1, newdata=newdata, type="response" ) + pred1_vast = predict( fit, + Lat_i = newdata[,'lat'], + Lon_i = newdata[,'long'], + t_i = newdata[,'year'], + a_i = newdata[,'Area_km2'], + what = "R1_i", + new_covariate_data = covariate_data, + working_dir = multispecies_example_path, + do_checks = FALSE ) + expect_equal( as.numeric(pred1_gam), pred1_vast, tolerance=0.001 ) + + pred2_gam = predict( gam2, newdata=newdata, type="response" ) + pred2_vast = predict( fit, + Lat_i = newdata[,'lat'], + Lon_i = newdata[,'long'], + t_i = newdata[,'year'], + a_i = newdata[,'Area_km2'], + what = "R2_i", + new_covariate_data = covariate_data, + working_dir = multispecies_example_path, + do_checks = FALSE ) + expect_equal( exp(as.numeric(pred2_gam)), pred2_vast, tolerance=0.001 ) + } }) diff --git a/tests/testthat/test-catchability_against_glm.R b/tests/testthat/test-catchability_against_glm.R index dd138e1..2fae170 100644 --- a/tests/testthat/test-catchability_against_glm.R +++ b/tests/testthat/test-catchability_against_glm.R @@ -18,7 +18,7 @@ context("Testing examples") # Eastern Bering Sea pollcok test_that("Catchability covariates give identical results to glm(.) ", { # Previously worked with CI, but not anymore - skip_on_ci() + #skip_on_ci() skip_if(skip_local) # load data set diff --git a/tests/testthat/test-combining-categories.R b/tests/testthat/test-combining-categories.R index 697c421..e21118f 100644 --- a/tests/testthat/test-combining-categories.R +++ b/tests/testthat/test-combining-categories.R @@ -9,6 +9,9 @@ test_that("Combining categories example is working ", { skip_on_ci() skip_if(skip_local) + # Disabled because it's using hte old EBS grid + skip_if(TRUE) + ## Read in prepared data which comes from a simulated example ## loosely conditioned on EBS pollock. diff --git a/tests/testthat/test-comp-expansion.R b/tests/testthat/test-comp-expansion.R index d047aa1..2c2ebda 100644 --- a/tests/testthat/test-comp-expansion.R +++ b/tests/testthat/test-comp-expansion.R @@ -6,6 +6,11 @@ test_that("Male lingcod compositional expansion is working ", { skip_on_ci() skip_if(skip_local) + # MakeADFun crashes for TMBad .. see: + # C:\Users\James.Thorson\Desktop\Work files\AFSC\2022-08 -- testthat fix for comp-expansion + # https://github.com/kaskr/adcomp/issues/365 + # skip_if(TRUE) + # Prepping test_path = file.path(multispecies_example_path,"Lingcod_comp_expansion") load( file=file.path(test_path,"Data_Geostat.RData") ) @@ -38,8 +43,10 @@ test_that("Male lingcod compositional expansion is working ", { "getsd" = FALSE, "savedir" = NULL, #run_model = FALSE, + #build_model = FALSE, "newtonsteps" = 1, "test_fit" = FALSE, + #framework = "TMBad", "working_dir" = test_path ) # Comparisons diff --git a/tests/testthat/test-condition-and-density.R b/tests/testthat/test-condition-and-density.R index 697f095..758061e 100644 --- a/tests/testthat/test-condition-and-density.R +++ b/tests/testthat/test-condition-and-density.R @@ -61,6 +61,7 @@ test_that("Condition-and-density example is working ", { Expansion_cz = Expansion_cz, Map = Map, # END CODE BLOCK FROM WIKI + #framework = "CppAD", getsd=FALSE, #newtonsteps=0, backwards_compatible_kmeans=TRUE ) diff --git a/tests/testthat/test-covariates_against_glm.R b/tests/testthat/test-covariates_against_glm.R index 007f7f6..bafe65f 100644 --- a/tests/testthat/test-covariates_against_glm.R +++ b/tests/testthat/test-covariates_against_glm.R @@ -18,7 +18,7 @@ context("Testing examples") # Eastern Bering Sea pollcok test_that("Density covariates give identical results to glm(.) ", { # Previously worked with CI, but not anymore - skip_on_ci() + #skip_on_ci() skip_if(skip_local) # load data set diff --git a/tests/testthat/test-goa-mice-example.R b/tests/testthat/test-goa-mice-example.R index c70719f..23eb704 100644 --- a/tests/testthat/test-goa-mice-example.R +++ b/tests/testthat/test-goa-mice-example.R @@ -7,6 +7,9 @@ test_that("Gulf of Alaska MICE-in-space example is working ", { skip_on_ci() skip_if(skip_local) + # VAM is disabled for now + skip_if(TRUE) + # Prepping test_path = file.path(multispecies_example_path,"goa_mice_example") example = load_example( "GOA_MICE_example" ) diff --git a/tests/testthat/test-past-versions.R b/tests/testthat/test-past-versions.R new file mode 100644 index 0000000..0cc0474 --- /dev/null +++ b/tests/testthat/test-past-versions.R @@ -0,0 +1,68 @@ + +############################ +# Modifications from SpatialDeltaGLMM version +# 1. Change Version to Version_VAST +# 2. Change Data_Fn and Build_TMB_Fn to call VAST instead of SpatialDeltaGLMM +# 3. Change VesselConfig to OverdispersionConfig, and move to Data_Fn +# 4. Add c_i to Data_Fn +# 5. Change ObsModel to c(ObsModel,0) +# 6. Change expect_equal +# 7. Change v_i from Vessel to VesselxYear, because SpatialDeltaGLMM did this automatically for VesselConfig=c(0,1) +# 8. Change tolerance on Chatham Rise example (because SpatialDeltaGLMM hit bound and isn't *quite* converged +############################ + +# Tutorial: http://r-pkgs.had.co.nz/tests.html +# And example see: https://github.com/ss3sim/ss3sim/tree/master/tests/testthat +context("Testing examples") + +# Eastern Bering Sea pollcok +test_that("Eastern Bering Sea pollock is working ", { + skip_on_ci() + skip_if(skip_local) + + # Prepping + test_path = file.path(singlespecies_example_path,"EBS_pollock") + + # load data set + example = load_example( data_set="EBS_pollock" ) + + # Make settings + settings = make_settings( n_x=50, + Region=example$Region, + purpose="index2" ) + settings$FieldConfig[c("Omega","Epsilon"),"Component_2"] = 0 + + # Add + #version_set = list.files(system.file("executables", package = "VAST")) + # version_set = sapply( version_set, FUN=function(char){strsplit(char,".",fixed=TRUE)[[1]][1]} ) + version_set = c( + paste0("VAST_v8_",0:6,"_0"), + paste0("VAST_v9_",0:4,"_0"), + "VAST_v10_0_0", + "VAST_v11_0_0", + "VAST_v12_0_0", + paste0("VAST_v13_",0:1,"_0"), + "VAST_v14_0_0", + "VAST_v14_0_1" ) + version_set = setdiff( version_set, get_latest_version() ) + + #cpp_exists = paste0(version_set,".cpp") %in% list.files(system.file("executables", package = "VAST")) + #expect_equal( all(cpp_exists), TRUE ) + + for( vI in seq_along(version_set) ){ + # Run model + settings$Version = version_set[vI] + fit = fit_model( "settings"=settings, + "Lat_i"=example$sampling_data[,'Lat'], + "Lon_i"=example$sampling_data[,'Lon'], + "t_i"=example$sampling_data[,'Year'], + "b_i"=example$sampling_data[,'Catch_KG'], + "a_i"=example$sampling_data[,'AreaSwept_km2'], + "newtonsteps" = 0, + "test_fit" = FALSE, + "getsd" = FALSE, + "working_dir" = test_path ) + expect_equal( fit$parameter_estimates$objective, 58883.63, tol=1 ) + } +}) + diff --git a/tests/testthat/test-platform.R b/tests/testthat/test-platform.R index 162862c..1d7d93f 100644 --- a/tests/testthat/test-platform.R +++ b/tests/testthat/test-platform.R @@ -4,6 +4,8 @@ context("Testing cross platform and R version compatibility") # Eastern Bering Sea pollcok test_that("Eastern Bering Sea pollock is working ", { + #skip_on_ci() + ## Prep really simple example using built-in data set, adapted ## from simple example on wiki example <- load_example( data_set="EBS_pollock" ) diff --git a/tests/testthat/test-random_beta_against_glmer.R b/tests/testthat/test-random_beta_against_glmer.R index d340a3c..c4f9321 100644 --- a/tests/testthat/test-random_beta_against_glmer.R +++ b/tests/testthat/test-random_beta_against_glmer.R @@ -6,7 +6,7 @@ context("Testing examples") # Eastern Bering Sea pollcok test_that("Density covariates give identical results to glmer(.) ", { # Previously worked with CI, but not anymore - skip_on_ci() + #skip_on_ci() skip_if(skip_local) library(lme4) @@ -56,10 +56,10 @@ test_that("Density covariates give identical results to glmer(.) ", { data=Data[which(Data$pres==1),], offset=log(AreaSwept_km2) ) # Comparison with Glm0 - expect_equal( fit$Report$beta1_tc[,1], coef(Glm0)$year_factor[,'(Intercept)'], tolerance=0.001 ) + expect_equal( as.numeric(fit$Report$beta1_tc[,1]), coef(Glm0)$year_factor[,'(Intercept)'], tolerance=0.001 ) # Comparison with Glm1 - expect_equal( fit$Report$beta2_tc[,1] - exp(2*fit$parameter_estimates$par['logSigmaM'])/2, coef(Glm1)$year_factor[,'(Intercept)'], tolerance=0.001 ) + expect_equal( as.numeric(fit$Report$beta2_tc[,1]) - exp(2*fit$parameter_estimates$par['logSigmaM'])/2, coef(Glm1)$year_factor[,'(Intercept)'], tolerance=0.001 ) }) diff --git a/tests/testthat/test-single-species-examples.R b/tests/testthat/test-single-species-examples.R index ba0be89..5e46b0f 100644 --- a/tests/testthat/test-single-species-examples.R +++ b/tests/testthat/test-single-species-examples.R @@ -18,7 +18,7 @@ context("Testing examples") # Eastern Bering Sea pollcok test_that("Eastern Bering Sea pollock is working ", { # Previously worked with CI, but not anymore - skip_on_ci() + #skip_on_ci() skip_if(skip_local) # Prepping @@ -43,86 +43,3 @@ test_that("Eastern Bering Sea pollock is working ", { expect_equal( as.vector(Par1), as.vector(Par2), tolerance=1e-3 ) }) -# Chatham rise -test_that("Chatham Rise hake is working ", { - skip_on_ci() - skip_if(skip_local) - - # Prepping - test_path = file.path(singlespecies_example_path,"chatham_rise_hake") - load( file.path(test_path,"opt.RData") ) - load( file.path(test_path,"Record.RData") ) - attach(Record) - on.exit( detach(Record) ) - # Run model - data( chatham_rise_hake, package="FishStatsUtils" ) - Data_Geostat = data.frame( "Catch_KG"=chatham_rise_hake[,'Hake_kg_per_km2'], "Year"=chatham_rise_hake[,'Year'], "Vessel"=1, "AreaSwept_km2"=1, "Lat"=chatham_rise_hake[,'Lat'], "Lon"=chatham_rise_hake[,'Lon']) - Extrapolation_List = make_extrapolation_info( Region=Region, strata.limits=strata.limits ) - Spatial_List = make_spatial_info( backwards_compatible_kmeans=TRUE, grid_size_km=grid_size_km, n_x=n_x, Method=Method, Lon=Data_Geostat[,'Lon'], Lat=Data_Geostat[,'Lat'], Extrapolation_List=Extrapolation_List, randomseed=Kmeans_Config[["randomseed"]], nstart=Kmeans_Config[["nstart"]], iter.max=Kmeans_Config[["iter.max"]], DirPath=test_path ) - TmbData = make_data("Version"=Version_VAST, "OverdispersionConfig"=rep(VesselConfig[2],2), "FieldConfig"=FieldConfig, "RhoConfig"=RhoConfig, "ObsModel"=c(ObsModel,0), "c_i"=rep(0,nrow(Data_Geostat)), "b_i"=Data_Geostat[,'Catch_KG'], "a_i"=Data_Geostat[,'AreaSwept_km2'], "v_i"=as.numeric(factor(paste(Data_Geostat[,'Vessel'],Data_Geostat[,'Year'])))-1, "t_i"=Data_Geostat[,'Year'], "spatial_list"=Spatial_List ) - TmbList = make_model("TmbData"=TmbData, "RunDir"=test_path, "Version"=Version_VAST, "RhoConfig"=RhoConfig, "loc_x"=Spatial_List$loc_x) - #on.exit( dyn.unload(paste0(system.file("executables", package = "VAST"),"/",TMB::dynlib(Version_VAST))), add=TRUE ) - Opt = TMBhelper::fit_tmb( obj=TmbList[["Obj"]], getsd=FALSE, lower=TmbList[["Lower"]], upper=TmbList[["Upper"]] ) # , rel.tol=1e-20 - # Comparisons - Par1 = Opt$par[names(Opt$par)%in%c("ln_H_input","beta1_ct","beta1_ft","logkappa1","beta2_ct","beta2_ft","logkappa1","logSigmaM")] - Par2 = opt$par[names(opt$par)%in%c("ln_H_input","beta1_t","logkappa1","beta2_t","logkappa1","logSigmaM")] - expect_equal( as.vector(Par1), as.vector(Par2), tolerance=1e-2 ) -}) - -# California Current -test_that("West Coast groundfish bottom trawl survey, canary rockfish is working ", { - skip_on_ci() - skip_if(skip_local) - - # Prepping - test_path = file.path(singlespecies_example_path,"WCGBTS_canary") - load( file.path(test_path,"opt.RData") ) - load( file.path(test_path,"Record.RData") ) - attach(Record) - on.exit( detach(Record) ) - file.copy( from=paste0(test_path,"/Kmeans-100.RData"), to=paste0(test_path,"/Kmeans_knots-100.RData") ) - - # Run model - data( WCGBTS_Canary_example, package="FishStatsUtils" ) - Data_Geostat = data.frame( "Catch_KG"=WCGBTS_Canary_example[,'HAUL_WT_KG'], "Year"=as.numeric(sapply(WCGBTS_Canary_example[,'PROJECT_CYCLE'],FUN=function(Char){strsplit(as.character(Char)," ")[[1]][2]})), "Vessel"=WCGBTS_Canary_example[,"VESSEL"], "AreaSwept_km2"=WCGBTS_Canary_example[,"AREA_SWEPT_HA"]/1e2, "Lat"=WCGBTS_Canary_example[,'BEST_LAT_DD'], "Lon"=WCGBTS_Canary_example[,'BEST_LON_DD'], "Pass"=WCGBTS_Canary_example[,'PASS']-1.5) - Extrapolation_List = make_extrapolation_info( Region=Region, strata.limits=strata.limits ) - Spatial_List = make_spatial_info( backwards_compatible_kmeans=TRUE, grid_size_km=grid_size_km, n_x=n_x, Method=Method, Lon=Data_Geostat[,'Lon'], Lat=Data_Geostat[,'Lat'], Extrapolation_List=Extrapolation_List, randomseed=Kmeans_Config[["randomseed"]], nstart=Kmeans_Config[["nstart"]], iter.max=Kmeans_Config[["iter.max"]], DirPath=test_path ) - TmbData = make_data("Version"=Version_VAST, "OverdispersionConfig"=rep(VesselConfig[2],2), "FieldConfig"=FieldConfig, "RhoConfig"=RhoConfig, "ObsModel"=c(ObsModel,0), "c_i"=rep(0,nrow(Data_Geostat)), "b_i"=Data_Geostat[,'Catch_KG'], "a_i"=Data_Geostat[,'AreaSwept_km2'], "v_i"=as.numeric(factor(paste(Data_Geostat[,'Vessel'],Data_Geostat[,'Year'])))-1, "t_i"=Data_Geostat[,'Year'], "spatial_list"=Spatial_List ) - TmbList = make_model("TmbData"=TmbData, "RunDir"=test_path, "Version"=Version_VAST, "RhoConfig"=RhoConfig, "loc_x"=Spatial_List$loc_x) - #on.exit( dyn.unload(paste0(system.file("executables", package = "VAST"),"/",TMB::dynlib(Version_VAST))), add=TRUE ) - Opt = TMBhelper::fit_tmb( obj=TmbList[["Obj"]], getsd=FALSE, lower=TmbList[["Lower"]], upper=TmbList[["Upper"]] ) # , rel.tol=1e-20 - # Comparisons - Par1 = Opt$par[names(Opt$par)%in%c("ln_H_input","beta1_ct","beta1_ft","logkappa1","beta2_ct","beta2_ft","logkappa1","logSigmaM")] - Par2 = opt$par[names(opt$par)%in%c("ln_H_input","beta1_t","logkappa1","beta2_t","logkappa1","logSigmaM")] - expect_equal( as.vector(Par1), as.vector(Par2), tolerance=1e-3 ) -}) - -# Aleutian Islands -# Test default + Random-walk on spatio-temporal variation -test_that("Aleutian Islands groundfish bottom trawl survey, POP is working ", { - skip_on_ci() - skip_if(skip_local) - # Prepping - test_path = file.path(singlespecies_example_path,"AI_POP") - load( file.path(test_path,"opt.RData") ) - load( file.path(test_path,"Record.RData") ) - attach(Record) - on.exit( detach(Record) ) - file.copy( from=paste0(test_path,"/Kmeans-250.RData"), to=paste0(test_path,"/Kmeans_knots-250.RData") ) - # Run model - data( AI_pacific_ocean_perch, package="FishStatsUtils" ) - Data_Geostat = data.frame( "Catch_KG"=AI_pacific_ocean_perch[,'cpue..kg.km.2.'], "Year"=AI_pacific_ocean_perch[,'year'], "Vessel"="missing", "AreaSwept_km2"=1, "Lat"=AI_pacific_ocean_perch[,'start.latitude'], "Lon"=AI_pacific_ocean_perch[,'start.longitude'], "Pass"=0) - Extrapolation_List = make_extrapolation_info( Region=Region, strata.limits=strata.limits ) - Spatial_List = make_spatial_info( backwards_compatible_kmeans=TRUE, grid_size_km=grid_size_km, n_x=n_x, Method=Method, Lon=Data_Geostat[,'Lon'], Lat=Data_Geostat[,'Lat'], Extrapolation_List=Extrapolation_List, randomseed=Kmeans_Config[["randomseed"]], nstart=Kmeans_Config[["nstart"]], iter.max=Kmeans_Config[["iter.max"]], DirPath=test_path ) - # grid_size_km=grid_size_km; n_x=n_x; Method=Method; Lon=Data_Geostat[,'Lon']; Lat=Data_Geostat[,'Lat']; Extrapolation_List=Extrapolation_List; randomseed=Kmeans_Config[["randomseed"]]; nstart=Kmeans_Config[["nstart"]]; iter.max=Kmeans_Config[["iter.max"]]; DirPath=test_path - # Lon_i=Lon; Lat_i=Lat; anisotropic_mesh=NULL; knot_method=NULL; Method="Mesh"; grid_size_km=50; grid_size_LL=1; Kmeans=NULL; fine_scale=FALSE; Network_sz_LL=NULL; Save_Results=FALSE; LON_intensity=Lon_i; LAT_intensity=Lat_i; backwards_compatible_kmeans=FALSE - TmbData = make_data("Version"=Version_VAST, "OverdispersionConfig"=rep(VesselConfig[2],2), "FieldConfig"=FieldConfig, "RhoConfig"=RhoConfig, "ObsModel"=c(ObsModel,0), "c_i"=rep(0,nrow(Data_Geostat)), "b_i"=Data_Geostat[,'Catch_KG'], "a_i"=Data_Geostat[,'AreaSwept_km2'], "v_i"=as.numeric(factor(paste(Data_Geostat[,'Vessel'],Data_Geostat[,'Year'])))-1, "t_i"=Data_Geostat[,'Year'], "spatial_list"=Spatial_List ) - TmbList = make_model("TmbData"=TmbData, "RunDir"=test_path, "Version"=Version_VAST, "RhoConfig"=RhoConfig, "loc_x"=Spatial_List$loc_x) - #on.exit( dyn.unload(paste0(system.file("executables", package = "VAST"),"/",TMB::dynlib(Version_VAST))), add=TRUE ) - Opt = TMBhelper::fit_tmb( obj=TmbList[["Obj"]], getsd=FALSE, lower=TmbList[["Lower"]], upper=TmbList[["Upper"]] ) # , rel.tol=1e-20 - # Comparisons - Par1 = Opt$par[names(Opt$par)%in%c("ln_H_input","beta1_ct","beta1_ft","logkappa1","beta2_ct","beta2_ft","logkappa1","logSigmaM")] - Par2 = opt$par[names(opt$par)%in%c("ln_H_input","beta1_t","logkappa1","beta2_t","logkappa1","logSigmaM")] - expect_equal( as.vector(Par1), as.vector(Par2), tolerance=1e-3 ) -}) - diff --git a/tests/testthat/test-zeroinfl-against-pscl.R b/tests/testthat/test-zeroinfl-against-pscl.R index e0c9f62..4dc3b76 100644 --- a/tests/testthat/test-zeroinfl-against-pscl.R +++ b/tests/testthat/test-zeroinfl-against-pscl.R @@ -5,7 +5,7 @@ context("Testing examples") # Eastern Bering Sea pollcok test_that("Zero-inflated Poisson gives identical results to pscl::zeroinfl(.) ", { - skip_on_ci() + #skip_on_ci() skip_if(skip_local) ## Simulate @@ -23,7 +23,8 @@ test_that("Zero-inflated Poisson gives identical results to pscl::zeroinfl(.) ", Region = "other", ObsModel = c(7, 0), purpose = "index", - Version = Version_VAST ) + Version = Version_VAST, + bias.correct = FALSE ) ## Run zero-inflated Poisson fit0 <- fit_model(settings = settings, @@ -36,6 +37,8 @@ test_that("Zero-inflated Poisson gives identical results to pscl::zeroinfl(.) ", observations_LL = xyz[,c('Lat','Lon')], ObsModel = c(7, 0), Aniso = FALSE, + #run_model = TRUE, + #getsd = FALSE, working_dir = multispecies_example_path, FieldConfig = c(Omega1 = 0, Epsilon1 = 0, Omega2 = 0, Epsilon2 = 0) )