diff --git a/.github/CODE_OF_CONDUCT.md b/.github/CODE_OF_CONDUCT.md
new file mode 100644
index 00000000..3ac34c82
--- /dev/null
+++ b/.github/CODE_OF_CONDUCT.md
@@ -0,0 +1,126 @@
+# Contributor Covenant Code of Conduct
+
+## Our Pledge
+
+We as members, contributors, and leaders pledge to make participation in our
+community a harassment-free experience for everyone, regardless of age, body
+size, visible or invisible disability, ethnicity, sex characteristics, gender
+identity and expression, level of experience, education, socio-economic status,
+nationality, personal appearance, race, caste, color, religion, or sexual
+identity and orientation.
+
+We pledge to act and interact in ways that contribute to an open, welcoming,
+diverse, inclusive, and healthy community.
+
+## Our Standards
+
+Examples of behavior that contributes to a positive environment for our
+community include:
+
+* Demonstrating empathy and kindness toward other people
+* Being respectful of differing opinions, viewpoints, and experiences
+* Giving and gracefully accepting constructive feedback
+* Accepting responsibility and apologizing to those affected by our mistakes,
+ and learning from the experience
+* Focusing on what is best not just for us as individuals, but for the overall
+ community
+
+Examples of unacceptable behavior include:
+
+* The use of sexualized language or imagery, and sexual attention or advances of
+ any kind
+* Trolling, insulting or derogatory comments, and personal or political attacks
+* Public or private harassment
+* Publishing others' private information, such as a physical or email address,
+ without their explicit permission
+* Other conduct which could reasonably be considered inappropriate in a
+ professional setting
+
+## Enforcement Responsibilities
+
+Community leaders are responsible for clarifying and enforcing our standards of
+acceptable behavior and will take appropriate and fair corrective action in
+response to any behavior that they deem inappropriate, threatening, offensive,
+or harmful.
+
+Community leaders have the right and responsibility to remove, edit, or reject
+comments, commits, code, wiki edits, issues, and other contributions that are
+not aligned to this Code of Conduct, and will communicate reasons for moderation
+decisions when appropriate.
+
+## Scope
+
+This Code of Conduct applies within all community spaces, and also applies when
+an individual is officially representing the community in public spaces.
+Examples of representing our community include using an official e-mail address,
+posting via an official social media account, or acting as an appointed
+representative at an online or offline event.
+
+## Enforcement
+
+Instances of abusive, harassing, or otherwise unacceptable behavior may be
+reported to the community leaders responsible for enforcement at codeofconduct@posit.co.
+All complaints will be reviewed and investigated promptly and fairly.
+
+All community leaders are obligated to respect the privacy and security of the
+reporter of any incident.
+
+## Enforcement Guidelines
+
+Community leaders will follow these Community Impact Guidelines in determining
+the consequences for any action they deem in violation of this Code of Conduct:
+
+### 1. Correction
+
+**Community Impact**: Use of inappropriate language or other behavior deemed
+unprofessional or unwelcome in the community.
+
+**Consequence**: A private, written warning from community leaders, providing
+clarity around the nature of the violation and an explanation of why the
+behavior was inappropriate. A public apology may be requested.
+
+### 2. Warning
+
+**Community Impact**: A violation through a single incident or series of
+actions.
+
+**Consequence**: A warning with consequences for continued behavior. No
+interaction with the people involved, including unsolicited interaction with
+those enforcing the Code of Conduct, for a specified period of time. This
+includes avoiding interactions in community spaces as well as external channels
+like social media. Violating these terms may lead to a temporary or permanent
+ban.
+
+### 3. Temporary Ban
+
+**Community Impact**: A serious violation of community standards, including
+sustained inappropriate behavior.
+
+**Consequence**: A temporary ban from any sort of interaction or public
+communication with the community for a specified period of time. No public or
+private interaction with the people involved, including unsolicited interaction
+with those enforcing the Code of Conduct, is allowed during this period.
+Violating these terms may lead to a permanent ban.
+
+### 4. Permanent Ban
+
+**Community Impact**: Demonstrating a pattern of violation of community
+standards, including sustained inappropriate behavior, harassment of an
+individual, or aggression toward or disparagement of classes of individuals.
+
+**Consequence**: A permanent ban from any sort of public interaction within the
+community.
+
+## Attribution
+
+This Code of Conduct is adapted from the [Contributor Covenant][homepage],
+version 2.1, available at
+<https://www.contributor-covenant.org/version/2/1/code_of_conduct.html>.
+
+Community Impact Guidelines were inspired by
+[Mozilla's code of conduct enforcement ladder][https://github.com/mozilla/inclusion].
+
+For answers to common questions about this code of conduct, see the FAQ at
+<https://www.contributor-covenant.org/faq>. Translations are available at <https://www.contributor-covenant.org/translations>.
+
+[homepage]: https://www.contributor-covenant.org
diff --git a/.github/CONTRIBUTING.md b/.github/CONTRIBUTING.md
new file mode 100644
index 00000000..55c28489
--- /dev/null
+++ b/.github/CONTRIBUTING.md
@@ -0,0 +1,51 @@
+# Contributing to mvgam
+
+This document outlines how to propose a change to mvgam.
+For a detailed discussion on contributing to this and other open source R packages, please see the [development contributing guide](https://rstd.io/tidy-contrib) and our [code review principles](https://code-review.tidyverse.org/).
+
+## Fixing typos
+
+You can fix typos, spelling mistakes, or grammatical errors in the documentation directly using the GitHub web interface, as long as the changes are made in the _source_ file.
+This generally means you'll need to edit [roxygen2 comments](https://roxygen2.r-lib.org/articles/roxygen2.html) in an `.R`, not a `.Rd` file.
+You can find the `.R` file that generates the `.Rd` by reading the comment in the first line.
+
+## Bigger changes
+
+If you want to make a bigger change, it's a good idea to first file an issue and make sure someone from the team agrees that it’s needed.
+If you’ve found a bug, please file an issue that illustrates the bug with a minimal
+[reprex](https://www.tidyverse.org/help/#reprex) (this will also help you write a unit test, if needed).
+See the tidyverse guide on [how to create a great issue](https://code-review.tidyverse.org/issues/) for more advice.
+
+### Pull request process
+
+* Fork the package and clone onto your computer. If you haven't done this before, we recommend using `usethis::create_from_github("nicholasjclark/mvgam", fork = TRUE)`.
+
+* Install all development dependencies with `devtools::install_dev_deps()`, and then make sure the package passes R CMD check by running `devtools::check()`.
+ If R CMD check doesn't pass cleanly, it's a good idea to ask for help before continuing.
+* Create a Git branch for your pull request (PR). We recommend using `usethis::pr_init("brief-description-of-change")`.
+
+* Make your changes, commit to git, and then create a PR by running `usethis::pr_push()`, and following the prompts in your browser.
+ The title of your PR should briefly describe the change.
+ The body of your PR should contain `Fixes #issue-number`.
+
+* For user-facing changes, add a bullet to the top of `NEWS.md` (i.e. just below the first header). Follow the style described in <https://style.tidyverse.org/news.html>.
+
+### Code style
+
+* New code should follow the tidyverse [style guide](https://style.tidyverse.org) where possible.
+ You can use the [styler](https://CRAN.R-project.org/package=styler) package to apply these styles, but please don't restyle code that has nothing to do with your PR.
+
+* We use [roxygen2](https://cran.r-project.org/package=roxygen2), with [Markdown syntax](https://cran.r-project.org/web/packages/roxygen2/vignettes/rd-formatting.html), for documentation.
+
+* We use [testthat](https://cran.r-project.org/package=testthat) for unit tests.
+ Contributions with test cases included are easier to accept.
+
+## Code of Conduct
+
+Please note that the mvgam project is released with a
+[Contributor Code of Conduct](CODE_OF_CONDUCT.md). By contributing to this
+project you agree to abide by its terms.
+
+## Roadmap
+
+The mvgam package is in a stable state of development, with some degree of active subsequent development as envisioned by the primary authors.
diff --git a/NAMESPACE b/NAMESPACE
index 52213c42..b2b5fbad 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -173,6 +173,8 @@ importFrom(bayesplot,nuts_params)
importFrom(bayesplot,pp_check)
importFrom(brms,bernoulli)
importFrom(brms,beta_binomial)
+importFrom(brms,brm)
+importFrom(brms,brmsterms)
importFrom(brms,conditional_effects)
importFrom(brms,dbeta_binomial)
importFrom(brms,do_call)
diff --git a/NEWS.md b/NEWS.md
index a327a559..827df4f8 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,6 @@
# mvgam 1.1.4 (development version; not yet on CRAN)
## New functionalities
+* Added support for approximate `gp()` effects with more than one covariate and with different kernel functions (#79)
* Added function `jsdgam()` to estimate Joint Species Distribution Models in which both the latent factors and the observation model components can include any of mvgam's complex linear predictor effects. Also added a function `residual_cor()` to compute residual correlation, covariance and precision matrices from `jsdgam` models. See `?mvgam::jsdgam` and `?mvgam::residual_cor` for details
* Added a `stability.mvgam()` method to compute stability metrics from models fit with Vector Autoregressive dynamics (#21 and #76)
* Added functionality to estimate hierarchical error correlations when using multivariate latent process models and when the data are nested among levels of a relevant grouping factor (#75); see `?mvgam::AR` for an example
diff --git a/R/conditional_effects.R b/R/conditional_effects.R
index d0e15cc9..eb81522c 100644
--- a/R/conditional_effects.R
+++ b/R/conditional_effects.R
@@ -98,8 +98,8 @@
conditional_effects.mvgam = function(x,
effects = NULL,
type = 'response',
- points = TRUE,
- rug = TRUE,
+ points = FALSE,
+ rug = FALSE,
...){
use_def_effects <- is.null(effects)
diff --git a/R/get_linear_predictors.R b/R/get_linear_predictors.R
index 86cc5860..5d2c1212 100644
--- a/R/get_linear_predictors.R
+++ b/R/get_linear_predictors.R
@@ -1,4 +1,5 @@
#' Function to prepare observation model linear predictor matrix
+#' @importFrom brms brmsterms
#' @noRd
obs_Xp_matrix = function(newdata, mgcv_model){
suppressWarnings(Xp <- try(predict(mgcv_model,
@@ -32,41 +33,41 @@ obs_Xp_matrix = function(newdata, mgcv_model){
# Check for any gp() terms and update the design matrix
# accordingly
if(!is.null(attr(mgcv_model, 'gp_att_table'))){
- # Compute the eigenfunctions from the supplied attribute table,
- # and add them to the Xp matrix
+
+ # Compute the gp() eigenfunctions for newdata using the supplied brms_mock object
+ # Requires a dataframe of all relevant variables for the gp effects
+ mock_terms <- brms::brmsterms(attr(mgcv_model, 'brms_mock')$formula)
+ terms_needed <- unique(all.vars(mock_terms$formula)[-1])
+ newdata_mock <- data.frame(newdata[[terms_needed[1]]])
+ if(length(terms_needed) > 1L){
+ for(i in 2:length(terms_needed)){
+ newdata_mock <- cbind(newdata_mock,
+ data.frame(newdata[[terms_needed[i]]]))
+ }
+ }
+ colnames(newdata_mock) <- terms_needed
+ newdata_mock$.fake_gp_y <- rnorm(NROW(newdata_mock))
+ brms_mock_data <- brms::standata(attr(mgcv_model, 'brms_mock'),
+ newdata = newdata_mock,
+ internal = TRUE)
# Extract GP attributes
gp_att_table <- attr(mgcv_model, 'gp_att_table')
- gp_covariates <- unlist(purrr::map(gp_att_table, 'covariate'))
- by <- unlist(purrr::map(gp_att_table, 'by'))
- level <- unlist(purrr::map(gp_att_table, 'level'))
- k <- unlist(purrr::map(gp_att_table, 'k'))
- scale <- unlist(purrr::map(gp_att_table, 'scale'))
- mean <- unlist(purrr::map(gp_att_table, 'mean'))
- max_dist <- unlist(purrr::map(gp_att_table, 'max_dist'))
- boundary <- unlist(purrr::map(gp_att_table, 'boundary'))
- L <- unlist(purrr::map(gp_att_table, 'L'))
-
- # Compute eigenfunctions
- test_eigenfunctions <- lapply(seq_along(gp_covariates), function(x){
- prep_eigenfunctions(data = newdata,
- covariate = gp_covariates[x],
- by = by[x],
- level = level[x],
- k = k[x],
- boundary = boundary[x],
- L = L[x],
- mean = mean[x],
- scale = scale[x],
- max_dist = max_dist[x])
- })
+ bys <- unlist(purrr::map(gp_att_table, 'by'), use.names = FALSE)
+ lvls <- unlist(purrr::map(gp_att_table, 'level'), use.names = FALSE)
+
+ # Extract eigenfunctions for each gp effect
+ eigenfuncs <- eigenfunc_list(stan_data = brms_mock_data,
+ mock_df = newdata_mock,
+ by = bys,
+ level = lvls)
# Find indices to replace in the design matrix and replace with
# the computed eigenfunctions
starts <- purrr::map(gp_att_table, 'first_coef')
ends <- purrr::map(gp_att_table, 'last_coef')
for(i in seq_along(starts)){
- Xp[,c(starts[[i]]:ends[[i]])] <- test_eigenfunctions[[i]]
+ Xp[,c(starts[[i]]:ends[[i]])] <- eigenfuncs[[i]]
}
}
@@ -127,7 +128,7 @@ trend_Xp_matrix = function(newdata, trend_map, series = 'all',
trend_map,
forecast = forecast)
- suppressWarnings(Xp_trend <- try(predict(mgcv_model,
+ suppressWarnings(Xp_trend <- try(predict(mgcv_model,
newdata = trend_test,
type = 'lpmatrix'),
silent = TRUE))
@@ -158,41 +159,41 @@ trend_Xp_matrix = function(newdata, trend_map, series = 'all',
# Check for any gp() terms and update the design matrix
# accordingly
if(!is.null(attr(mgcv_model, 'gp_att_table'))){
- # Compute the eigenfunctions from the supplied attribute table,
- # and add them to the Xp matrix
+
+ # Compute the gp() eigenfunctions for newdata using the supplied brms_mock object
+ # Requires a dataframe of all relevant variables for the gp effects
+ mock_terms <- brms::brmsterms(attr(mgcv_model, 'brms_mock')$formula)
+ terms_needed <- unique(all.vars(mock_terms$formula)[-1])
+ newdata_mock <- data.frame(trend_test[[terms_needed[1]]])
+ if(length(terms_needed) > 1L){
+ for(i in 2:length(terms_needed)){
+ newdata_mock <- cbind(newdata_mock,
+ data.frame(trend_test[[terms_needed[i]]]))
+ }
+ }
+ colnames(newdata_mock) <- terms_needed
+ newdata_mock$.fake_gp_y <- rnorm(NROW(newdata_mock))
+ brms_mock_data <- brms::standata(attr(mgcv_model, 'brms_mock'),
+ newdata = newdata_mock,
+ internal = TRUE)
# Extract GP attributes
gp_att_table <- attr(mgcv_model, 'gp_att_table')
- gp_covariates <- unlist(purrr::map(gp_att_table, 'covariate'))
- by <- unlist(purrr::map(gp_att_table, 'by'))
- level <- unlist(purrr::map(gp_att_table, 'level'))
- k <- unlist(purrr::map(gp_att_table, 'k'))
- scale <- unlist(purrr::map(gp_att_table, 'scale'))
- mean <- unlist(purrr::map(gp_att_table, 'mean'))
- max_dist <- unlist(purrr::map(gp_att_table, 'max_dist'))
- boundary <- unlist(purrr::map(gp_att_table, 'boundary'))
- L <- unlist(purrr::map(gp_att_table, 'L'))
-
- # Compute eigenfunctions
- test_eigenfunctions <- lapply(seq_along(gp_covariates), function(x){
- prep_eigenfunctions(data = trend_test,
- covariate = gp_covariates[x],
- by = by[x],
- level = level[x],
- k = k[x],
- boundary = boundary[x],
- L = L[x],
- mean = mean[x],
- scale = scale[x],
- max_dist = max_dist[x])
- })
+ bys <- unlist(purrr::map(gp_att_table, 'by'), use.names = FALSE)
+ lvls <- unlist(purrr::map(gp_att_table, 'level'), use.names = FALSE)
+
+ # Extract eigenfunctions for each gp effect
+ eigenfuncs <- eigenfunc_list(stan_data = brms_mock_data,
+ mock_df = newdata_mock,
+ by = bys,
+ level = lvls)
# Find indices to replace in the design matrix and replace with
# the computed eigenfunctions
starts <- purrr::map(gp_att_table, 'first_coef')
ends <- purrr::map(gp_att_table, 'last_coef')
for(i in seq_along(starts)){
- Xp_trend[,c(starts[[i]]:ends[[i]])] <- test_eigenfunctions[[i]]
+ Xp_trend[,c(starts[[i]]:ends[[i]])] <- eigenfuncs[[i]]
}
}
diff --git a/R/get_mvgam_priors.R b/R/get_mvgam_priors.R
index 7929f135..13a4e950 100644
--- a/R/get_mvgam_priors.R
+++ b/R/get_mvgam_priors.R
@@ -4,6 +4,7 @@
#'changed for a given `mvgam` model, as well listing their default distributions
#'
#'@inheritParams mvgam
+#'@inheritParams jsdgam
#'@param factor_formula Can be supplied instead `trend_formula` to match syntax from
#'[jsdgam]
#'@details Users can supply a model formula, prior to fitting the model, so that default priors can be inspected and
@@ -156,7 +157,9 @@ get_mvgam_priors = function(formula,
factor_formula,
data,
data_train,
- family = 'poisson',
+ family = poisson(),
+ unit = time,
+ species = series,
knots,
trend_knots,
use_lv = FALSE,
@@ -177,6 +180,19 @@ get_mvgam_priors = function(formula,
# Set trend_formula
if(!missing(factor_formula)){
+ if(missing(n_lv)){
+ n_lv <- 2
+ }
+ validate_pos_integer(n_lv)
+ unit <- deparse0(substitute(unit))
+ subgr <- deparse0(substitute(species))
+ prepped_trend <- prep_jsdgam_trend(unit = unit,
+ subgr = subgr,
+ data = data)
+ trend_model <- 'None'
+ data_train <- validate_series_time(data = data,
+ trend_model = prepped_trend)
+ trend_map <- prep_jsdgam_trendmap(data_train, n_lv)
if(!missing(trend_formula)){
warning('Both "trend_formula" and "factor_formula" supplied\nUsing "factor_formula" as default')
}
@@ -247,8 +263,8 @@ get_mvgam_priors = function(formula,
if(trend_model == 'None') trend_model <- 'RW'
validate_trend_formula(trend_formula)
prior_df <- get_mvgam_priors(formula = orig_formula,
- data = data,
- data_train = data_train,
+ data = data_train,
+ #data_train = data_train,
family = family,
use_lv = FALSE,
use_stan = TRUE,
@@ -534,17 +550,55 @@ get_mvgam_priors = function(formula,
# Check for gp() terms
if(!is.null(gp_terms)){
gp_additions <- make_gp_additions(gp_details = gp_details,
+ orig_formula = orig_formula,
data = data_train,
newdata = NULL,
model_data = list(X = t(predict(ss_gam, type = 'lpmatrix'))),
mgcv_model = ss_gam,
gp_terms = gp_terms,
family = family)
- gp_names <- unlist(purrr::map(gp_additions$gp_att_table, 'name'))
+ gp_names <- unlist(purrr::map(gp_additions$gp_att_table, 'name'),
+ use.names = FALSE)
+ gp_isos <- unlist(purrr::map(gp_additions$gp_att_table, 'iso'),
+ use.names = FALSE)
+ abbv_names <- vector(mode = 'list', length = length(gp_names))
+ full_names <- vector(mode = 'list', length = length(gp_names))
+ for(i in seq_len(length(gp_names))){
+ if(gp_isos[i]){
+ abbv_names[[i]] <- gp_names[i]
+ full_names[[i]] <- paste0(gp_names[i],
+ '[1]')
+ } else {
+ abbv_names[[i]] <- paste0(gp_names[i],
+ '[1][',
+ 1:2,
+ ']')
+ full_names[[i]] <- paste0(gp_names[i],
+ '[1][',
+ 1:2,
+ ']')
+ }
+ }
+ full_names <- unlist(full_names, use.names = FALSE)
+ abbv_names <- unlist(abbv_names, use.names = FALSE)
alpha_priors <- unlist(purrr::map(gp_additions$gp_att_table,
- 'def_alpha'))
+ 'def_alpha'),
+ use.names = FALSE)
rho_priors <- unlist(purrr::map(gp_additions$gp_att_table,
- 'def_rho'))
+ 'def_rho'),
+ use.names = FALSE)
+ rho_2_priors <- unlist(purrr::map(gp_additions$gp_att_table,
+ 'def_rho_2'),
+ use.names = FALSE)
+ full_priors <- vector(mode = 'list', length = length(gp_names))
+ for(i in seq_len(length(gp_names))){
+ if(gp_isos[i]){
+ full_priors[[i]] <- rho_priors[i]
+ } else {
+ full_priors[[i]] <- c(rho_priors[i], rho_2_priors[i])
+ }
+ }
+ full_priors <- unlist(full_priors, use.names = FALSE)
smooth_labs <- smooth_labs %>%
dplyr::filter(!label %in%
gsub('gp(', 's(', gp_names, fixed = TRUE))
@@ -560,14 +614,14 @@ get_mvgam_priors = function(formula,
round(runif(length(gp_names), 0.5, 1), 2),
');'))
rho_df <- data.frame(param_name = paste0('real<lower=0> rho_',
- gp_names, ';'),
- param_length = 1,
- param_info = paste(gp_names,
+ abbv_names, ';'),
+ param_length = 1,
+ param_info = paste(abbv_names,
'length scale'),
- prior = paste0('rho_', gp_names, ' ~ ', rho_priors, ';'),
- example_change = paste0('rho_', gp_names, ' ~ ',
+ prior = paste0('rho_', full_names, ' ~ ', full_priors, ';'),
+ example_change = paste0('rho_', full_names, ' ~ ',
'normal(0, ',
- round(runif(length(gp_names), 1, 10), 2),
+ round(runif(length(full_names), 0.5, 1), 2),
');'))
gp_df <- rbind(alpha_df, rho_df)
} else {
diff --git a/R/globals.R b/R/globals.R
index 7c47f8b3..12c1cfa5 100644
--- a/R/globals.R
+++ b/R/globals.R
@@ -20,4 +20,5 @@ utils::globalVariables(c("y", "year", "smooth_vals", "smooth_num",
"matches", "time.", "file_name", ".data",
"horizon", "target", "Series", "evd", "mean_evd",
"total_evd", "smooth_label", "by_variable",
- "gr", "tot_subgrs", "subgr"))
+ "gr", "tot_subgrs", "subgr", "lambda",
+ "level", "sim_hilbert_gp", "trend_model"))
diff --git a/R/gp.R b/R/gp.R
index bbe2e4ad..90479cce 100644
--- a/R/gp.R
+++ b/R/gp.R
@@ -1,12 +1,40 @@
+#' Re-label gp terms inside an mgcv gam object for nicer plotting
+#' @noRd
+relabel_gps = function(mgcv_model){
+ if(length(mgcv_model$smooth) > 0L){
+ # Get classes of all smooths
+ smooth_classes <- purrr::map(mgcv_model$smooth,
+ class)
+
+ # Check for gp() terms
+ for(x in seq_along(smooth_classes)){
+ if(any(smooth_classes[[x]] %in% 'hilbert.smooth')){
+ mgcv_model$smooth[[x]]$label <-
+ gsub('s\\(|ti\\(', 'gp(',
+ mgcv_model$smooth[[x]]$label)
+ }
+ }
+ }
+ return(mgcv_model)
+}
+
+#' @noRd
+seq_cols <- function(x) {
+ seq_len(NCOL(x))
+}
+
#' Make gp() attributes table and necessary stan lines
+#' @importFrom brms brm standata
#' @noRd
-make_gp_additions = function(gp_details, data,
+make_gp_additions = function(gp_details,
+ orig_formula,
+ data,
newdata,
- model_data, mgcv_model,
+ model_data,
+ mgcv_model,
gp_terms,
- family = gaussian()){
- # Need to expand combination of GPs if any of the by variables
- # is a factor; mvgam will drop unused levels automatically
+ family = gaussian(),
+ rho_names){
by <- gp_details$by
gp_details$row_id <- 1:NROW(gp_details)
gp_covariates <- gp_details$gp_covariates
@@ -36,46 +64,119 @@ make_gp_additions = function(gp_details, data,
dplyr::arrange(row_id, level) %>%
dplyr::select(-row_id) -> gp_details
- # Prepare the GP objects and Stan data lines
- gp_covariates <- gp_details$gp_covariates
- scale <- gp_details$scale
- boundary <- gp_details$boundary
- by <- gp_details$by
- level <- gp_details$level
-
- # Prep the covariates for GP modelling
- gp_data <- lapply(seq_along(gp_covariates), function(x){
-
- # Find the correct k to ensure that the total number of coefficients
- # when using gp(k = k) is the same as when using s(k = k + 1)
- smooth_terms <- unlist(paste0(purrr::map(mgcv_model$smooth, 'term')))
- smooth_bys <- unlist(purrr::map(mgcv_model$smooth, 'by'))
- if(any(smooth_bys == 'NA')){
- smooth_bys[smooth_bys == 'NA'] <- NA
+ # Initiate a brms GP model using the 'mock' backend so it doesn't actually fit;
+ terms_needed <- unique(c(unlist(strsplit(gp_details$gp_covariates, ", |\\n")),
+ unlist(strsplit(gp_details$by, ", |\\n"))))
+ terms_needed <- terms_needed[!is.na(terms_needed)]
+ terms_needed <- terms_needed[!terms_needed %in% c('series', 'time')]
+ brms_fake_df <- data.frame(.fake_gp_y = rnorm(length(data[[1]])),
+ series = data$series,
+ time = data$index..time..index)
+ for(i in seq_along(terms_needed)){
+ brms_fake_df <- cbind(brms_fake_df, data[[terms_needed[i]]])
+ }
+ colnames(brms_fake_df) <- c('.fake_gp_y',
+ 'series',
+ 'time',
+ terms_needed)
+ if(!is.null(newdata)){
+ brms_fake_df_new <- data.frame(.fake_gp_y = rnorm(length(newdata[[1]])),
+ series = newdata$series,
+ time = newdata$index..time..index)
+ for(i in seq_along(terms_needed)){
+ brms_fake_df_new <- cbind(brms_fake_df_new, newdata[[terms_needed[i]]])
}
- term_k <- mgcv_model$smooth[[min(which(smooth_bys %in% by[x] &
- smooth_terms == gp_covariates[x]))]]$df
-
- # Check that response terms use the cbind() syntax
- resp_terms <- rlang::f_lhs(formula(mgcv_model))
- if(length(resp_terms) == 1){
- response <- resp_terms
+ colnames(brms_fake_df_new) <- c('.fake_gp_y',
+ 'series',
+ 'time',
+ terms_needed)
+ brms_fake_df <- rbind(brms_fake_df,
+ brms_fake_df_new)
+ }
+ brms_fake_df <- brms_fake_df %>%
+ dplyr::arrange(time, series)
+
+ # Build the gp formula to pass to the mock brms
+ gp_formula <- reformulate(attr(terms(attr(gp_details, 'gp_formula')),
+ 'term.labels'),
+ '.fake_gp_y')
+ brms_mock <- brms::brm(gp_formula,
+ data = brms_fake_df,
+ mock_fit = 1,
+ backend = "mock",
+ rename = FALSE)
+ brms_mock <- trim_mockbrms(brms_mock)
+
+ # Eigenfunction design matrices (to be inserted into Xp matrices)
+ brms_mock_data <- brms::standata(brms_mock)
+ eigenfuncs <- eigenfunc_list(stan_data = brms_mock_data,
+ mock_df = brms_fake_df,
+ by = gp_details$by,
+ level = gp_details$level)
+
+ # Eigenvalues (l_gp in mvgam stancode)
+ eigenvals <- eigenval_list(brms_mock_data)
+
+ # Numbers of basis functions (k_gp in mvgam stancode)
+ k_gps <- lapply(eigenvals, function(x) NROW(x))
+
+ # Put all relevant data into a list
+ gp_data <- lapply(seq_along(eigenvals), function(x){
+ byname <- ifelse(is.na(gp_details$by[x]), '', paste0(':', gp_details$by[x]))
+ covariate_name <- paste0('gp(', gp_details$gp_covariates[x], ')', byname)
+ if(!is.na(gp_details$level[x])){
+ covariate_name <- paste0(covariate_name, gp_details$level[x])
+ }
+ orig_name <- if(gp_details$dim[x] > 1L){
+ paste0('ti(', gp_details$gp_covariates[x], ')', byname)
} else {
- if(any(grepl('cbind', resp_terms))){
- resp_terms <- resp_terms[-grepl('cbind', resp_terms)]
- response <- resp_terms[1]
- }
+ paste0('s(', gp_details$gp_covariates[x], ')', byname)
}
-
- prep_gp_covariate(data = data,
- response = response,
- covariate = gp_covariates[x],
- by = by[x],
- level = level[x],
- scale = scale[x],
- k = term_k,
- boundary = boundary[x],
- family = family_to_brmsfam(family))
+ if(!is.na(gp_details$level[x])){
+ orig_name <- paste0(orig_name, gp_details$level[x])
+ }
+ att_table <- list(effect = 'gp',
+ name = covariate_name,
+ orig_name = orig_name,
+ dim = gp_details$dim[x],
+ iso = gp_details$iso[x],
+ kernel = gp_details$kernel[x],
+ covariate = gp_details$gp_covariates[x],
+ by = gp_details$b[x],
+ level = gp_details$level[x],
+ k = k_gps[[x]],
+ def_rho = gp_details$def_rho[x],
+ def_rho_2 = gp_details$def_rho_2[x],
+ def_alpha = gp_details$def_alpha[x],
+ eigenvalues = eigenvals[[x]])
+
+ # Items to add to Stan data
+ # Number of basis functions
+ covariate_name <- clean_gpnames(covariate_name)
+ data_lines <- paste0('int<lower=1> k_', covariate_name,
+ '; // basis functions for approximate gp\n')
+ append_dat <- list(k = k_gps[[x]])
+ names(append_dat) <- paste0('k_', covariate_name, '')
+
+ # Approximate GP eigenvalues
+ data_lines <- paste0(data_lines, paste0(
+ 'array[',
+ 'k_', covariate_name,
+ '] vector[',
+ gp_details$dim[x],
+ '] l_',
+ covariate_name, '; // approximate gp eigenvalues\n'),
+ collapse = '\n')
+
+ append_dat2 <- list(slambda = eigenvals[[x]])
+ names(append_dat2) <- paste0('l_', covariate_name, '')
+ append_dat <- append(append_dat, append_dat2)
+
+ # Return necessary objects in a list
+ list(att_table = att_table,
+ data_lines = data_lines,
+ data_append = append_dat,
+ eigenfunctions = eigenfuncs[[x]])
})
# Consolidate Stan data objects and add to model_data
@@ -88,56 +189,44 @@ make_gp_additions = function(gp_details, data,
# Create updated design matrix by replacing the s() basis functions with
# the gp() eigenfunctions
coefs_replace <- list()
- for(x in gp_terms){
- label <- attr(terms(formula(mgcv_model)), 'term.labels')[x]
- s_attributes <- eval(rlang::parse_expr(label))
- if(s_attributes$by != 'NA'){
+ for(x in gp_terms){
+ label <- attr(terms(formula(mgcv_model)), 'term.labels')[x]
+ s_attributes <- eval(rlang::parse_expr(label))
+ if(s_attributes$by != 'NA'){
+ if(grepl('ti(', label, fixed = TRUE)){
+ coef_name <- paste0('ti(', paste(s_attributes$term,
+ collapse = ','),
+ '):', s_attributes$by)
+ } else {
coef_name <- paste0('s(', s_attributes$term, '):', s_attributes$by)
+ }
+
+ } else {
+ if(grepl('ti(', label, fixed = TRUE)){
+ coef_name <- paste0('ti(', paste(s_attributes$term,
+ collapse = ','),
+ ')')
} else {
coef_name <- paste0('s(', s_attributes$term, ')')
}
- which_replace <- grep(coef_name, names(coef(mgcv_model)), fixed = TRUE)
- names(mgcv_model$coefficients)[which_replace] <-
+ }
+ which_replace <- grep(coef_name, names(coef(mgcv_model)), fixed = TRUE)
+ names(mgcv_model$coefficients)[which_replace] <-
+ if(grepl('ti(', label, fixed = TRUE)){
+ gsub('ti(', 'gp(', names(mgcv_model$coefficients)[which_replace],
+ fixed = TRUE)
+ } else {
gsub('s(', 'gp(', names(mgcv_model$coefficients)[which_replace],
fixed = TRUE)
- coefs_replace[[x]] <- which_replace
- }
+ }
+ coefs_replace[[x]] <- which_replace
+ }
# Replace basis functions with gp() eigenfunctions
newX <- model_data$X
- # Training data eigenfunctions
+ # Add eigenfunctions to the GAM design matrix
eigenfuncs <- do.call(cbind, purrr::map(gp_data, 'eigenfunctions'))
-
- # Testing data eigenfunctions
- if(!is.null(newdata)){
- gp_covariates <- unlist(purrr::map(gp_att_table, 'covariate'))
- by <- unlist(purrr::map(gp_att_table, 'by'))
- level <- unlist(purrr::map(gp_att_table, 'level'))
- k <- unlist(purrr::map(gp_att_table, 'k'))
- scale <- unlist(purrr::map(gp_att_table, 'scale'))
- mean <- unlist(purrr::map(gp_att_table, 'mean'))
- max_dist <- unlist(purrr::map(gp_att_table, 'max_dist'))
- boundary <- unlist(purrr::map(gp_att_table, 'boundary'))
- L <- unlist(purrr::map(gp_att_table, 'L'))
- test_eigenfunctions <- lapply(seq_along(gp_covariates), function(x){
- prep_eigenfunctions(data = newdata,
- covariate = gp_covariates[x],
- by = by[x],
- level = level[x],
- k = k[x],
- boundary = boundary[x],
- L = L[x],
- mean = mean[x],
- scale = scale[x],
- max_dist = max_dist[x],
- initial_setup = TRUE)
- })
-
- eigenfuncs <- rbind(eigenfuncs,
- do.call(cbind, test_eigenfunctions))
- }
-
newX[unlist(coefs_replace), ] <- t(eigenfuncs)
model_data$X <- newX
@@ -146,9 +235,10 @@ make_gp_additions = function(gp_details, data,
# Add coefficient indices to attribute table and to Stan data
for(covariate in seq_along(gp_att_table)){
- coef_indices <- which(grepl(paste0(gsub("([()])","\\\\\\1",
- gp_att_table[[covariate]]$name),
- '\\.+[0-9]'),
+ coef_indices <- which(grepl(paste0(gsub(' ' , '',
+ gsub("([()])","\\\\\\1",
+ gp_att_table[[covariate]]$name),
+ '\\.+[0-9]')),
names(coef(mgcv_model)), fixed = FALSE) &
!grepl(paste0(gp_att_table[[covariate]]$name,':'),
names(coef(mgcv_model)), fixed = TRUE) == TRUE)
@@ -168,8 +258,9 @@ make_gp_additions = function(gp_details, data,
model_data <- append(model_data, gp_idx_data)
}
- # Add the GP attribute table to the mgcv_model
+ # Add the GP attribute table and mock brmsfit object to the mgcv_model
attr(mgcv_model, 'gp_att_table') <- gp_att_table
+ attr(mgcv_model, 'brms_mock') <- brms_mock
# Assign GP labels to smooths
gp_assign <- data.frame(label = unlist(purrr::map(gp_att_table, 'name')),
@@ -178,20 +269,102 @@ make_gp_additions = function(gp_details, data,
by = unlist(purrr::map(gp_att_table, 'by')))
for(i in seq_along(mgcv_model$smooth)){
if(mgcv_model$smooth[[i]]$label %in%
- gsub('gp(', 's(', gp_assign$label, fixed = TRUE) &
+ gsub('gp(', 's(', gsub(' ', '', gp_assign$label[i]), fixed = TRUE) ||
+ mgcv_model$smooth[[i]]$label %in%
+ gsub('gp(', 'ti(', gsub(' ', '', gp_assign$label[i]), fixed = TRUE) &
mgcv_model$smooth[[i]]$first.para %in% gp_assign$first.para){
mgcv_model$smooth[[i]]$gp_term <- TRUE
- class(mgcv_model$smooth[[i]]) <- c('tprs.smooth', 'hilbert.smooth', 'mgcv.smooth')
+ class(mgcv_model$smooth[[i]]) <- c(class(mgcv_model$smooth[[i]])[1],
+ 'hilbert.smooth', 'mgcv.smooth')
} else {
mgcv_model$smooth[[i]]$gp_term <- FALSE
}
}
+ # Update smoothing parameter names and return
+ if(!missing(rho_names)){
+ gp_names <- unlist(purrr::map(gp_att_table, 'name'))
+ gp_names_new <- vector()
+ for(i in seq_along(gp_names)){
+ if(any(grepl(',', gp_names[i]))){
+ gp_names_new[i] <- gsub(' ', '', gsub('gp(', 'ti(', gp_names[i], fixed = TRUE))
+ } else {
+ gp_names_new[i] <- gsub('gp(', 's(', gp_names[i], fixed = TRUE)
+ }
+ }
+
+ rhos_change <- list()
+ for(i in seq_along(gp_names_new)){
+ rhos_change[[i]] <- grep(gp_names_new[i], rho_names, fixed = TRUE)
+ }
+ rho_names[c(unique(unlist(rhos_change)))] <- gsub('s\\(|ti\\(', 'gp(',
+ rho_names[c(unique(unlist(rhos_change)))])
+ } else {
+ rho_names <- NULL
+ }
+
# Return
return(list(model_data = model_data,
mgcv_model = mgcv_model,
gp_stan_lines = gp_stan_lines,
- gp_att_table = gp_att_table))
+ gp_att_table = gp_att_table,
+ rho_names))
+}
+
+#' Reduce the size of the brmsfit object
+#' @noRd
+trim_mockbrms = function(brms_mock){
+ brms_mock$opencl <- NULL
+ brms_mock$data.name <- NULL
+ brms_mock$algorithm <- NULL
+ brms_mock$backend <- NULL
+ brms_mock$stan_args <- NULL
+ brms_mock$model <- NULL
+ brms_mock$stan_funs <- NULL
+ brms_mock$threads <- NULL
+ brms_mock$prior <- NULL
+ brms_mock$family <- NULL
+ brms_mock$save_pars <- NULL
+ brms_mock
+}
+
+#' Extract eigenfunctions for gp() terms and pad with zeros if necessary
+#' @noRd
+eigenfunc_list = function(stan_data,
+ mock_df,
+ by = NA,
+ level = NA){
+ eigenfuncs <- stan_data[which(grepl('Xgp_', names(stan_data), fixed = TRUE) &
+ !grepl('_old', names(stan_data), fixed = TRUE) &
+ !grepl('_prior', names(stan_data), fixed = TRUE))]
+ # We need to pad the eigenfunctions with zeros
+ # for the observations where the by is a different level;
+ padded_eigenfuncs <- lapply(seq_along(eigenfuncs), function(x){
+ if(!is.na(by[x])){
+ if(!is.na(level[x])){
+ sorted_by <- mock_df[[by[x]]]
+ full_eigens <- matrix(0, nrow = length(sorted_by),
+ ncol = NCOL(eigenfuncs[[x]]))
+ full_eigens[(seq_along(sorted_by))[
+ sorted_by == level[x]],] <- eigenfuncs[[x]]
+ } else {
+ # Numeric by variables should be multiplied by the
+ # spectral eigenfunctions
+ full_eigens <- eigenfuncs[[x]] * mock_df[[by[x]]]
+ }
+ } else {
+ full_eigens <- eigenfuncs[[x]]
+ }
+ full_eigens
+ })
+ padded_eigenfuncs
+}
+
+#' Extract eigenvalues for gp() terms
+#' @noRd
+eigenval_list = function(stan_data){
+ stan_data[which(grepl('slambda_', names(stan_data), fixed = TRUE) &
+ !grepl('_old', names(stan_data), fixed = TRUE))]
}
#' Which terms are gp() terms?
@@ -204,10 +377,10 @@ which_are_gp = function(formula){
#' Convert gp() terms to s() terms for initial model construction
#' @importFrom stats drop.terms
#' @noRd
-gp_to_s <- function(formula){
+gp_to_s <- function(formula, data, family){
# Extract details of gp() terms
- gp_details <- get_gp_attributes(formula)
+ gp_details <- get_gp_attributes(formula, data, family)
termlabs <- attr(terms(formula, keep.order = TRUE), 'term.labels')
# Replace the gp() terms with s() for constructing the initial model
@@ -216,17 +389,60 @@ gp_to_s <- function(formula){
s_terms <- vector()
for(i in 1:NROW(gp_details)){
if(!is.na(gp_details$by[i])){
- s_terms[i] <- paste0('s(',
- gp_details$gp_covariates[i],
- ', by = ',
- gp_details$by[i],
- ', k = ',
- gp_details$k[i] + 1, ')')
+ if(is.factor(data[[gp_details$by[i]]])){
+ # For terms with factor by variables, constraints are in place
+ # we either need one additional
+ # value for k (for unidimensionsal terms) or must use mc = 0 for all
+ # marginals in a ti call (for multidimensional terms)
+ s_terms[i] <- paste0(
+ if(gp_details$dim[i] < 2L){
+ 's('} else {
+ 'ti('
+ },
+ gp_details$gp_covariates[i],
+ ', by = ',
+ gp_details$by[i],
+ ', k = ',
+ if(gp_details$dim[i] > 1L){
+ paste0(gp_details$k[i],
+ ', mc = c(',
+ paste(rep(0, gp_details$dim[i]), collapse = ', '),
+ ')')} else {
+ gp_details$k[i] + 1
+ },')')
+ } else {
+ # No constraints are used when numeric by variables are in smooths,
+ # so number of coefficients will match those from the brms gp
+ s_terms[i] <- paste0(
+ if(gp_details$dim[i] < 2L){
+ 's('} else {
+ 'ti('
+ },
+ gp_details$gp_covariates[i],
+ ', by = ',
+ gp_details$by[i],
+ ', k = ',
+ gp_details$k[i], ')')
+ }
+
} else {
- s_terms[i] <- paste0('s(',
- gp_details$gp_covariates[i],
- ', k = ',
- gp_details$k[i] + 1, ')')
+ # For terms with no by-variable, we either need one additional
+ # value for k (for unidimensionsal terms) or must use mc = 0 for all
+ # marginals in a ti call (for multidimensional terms)
+ s_terms[i] <- paste0(
+ if(gp_details$dim[i] < 2L){
+ 's('} else {
+ 'ti('
+ },
+ gp_details$gp_covariates[i],
+ ', k = ',
+ if(gp_details$dim[i] > 1L){
+ paste0(gp_details$k[i],
+ ', mc = c(',
+ paste(rep(0, gp_details$dim[i]), collapse = ', '),
+ ')')} else {
+ gp_details$k[i] + 1
+ },')')
}
termlabs[which_gp[i]] <- s_terms[i]
@@ -237,388 +453,134 @@ gp_to_s <- function(formula){
return(newformula)
}
-
#' Store attributes of the gp terms
#' @importFrom rlang parse_expr
#' @noRd
-get_gp_attributes = function(formula){
+get_gp_attributes = function(formula, data, family = gaussian()){
gp_terms <- rownames(attr(terms(formula), 'factors'))[
grep('gp(', rownames(attr(terms(formula), 'factors')), fixed = TRUE)]
+
+ # Term details and default priors
gp_attributes <- lapply(seq_along(gp_terms), function(x){
eval(rlang::parse_expr(gp_terms[x]))
})
- # Extract information necessary to construct the GP terms
- gp_covariates <- unlist(purrr::map(gp_attributes, 'term'))
- k <- unlist(purrr::map(gp_attributes, 'k'))
- if(any(is.na(k))){
- k[is.na(k)] <- 10
- }
- scale <- unlist(purrr::map(gp_attributes, 'scale'))
- boundary <- unlist(purrr::map(gp_attributes, 'c'))
- if(any(is.na(boundary))){
- boundary[is.na(boundary)] <- 5.0/4
- }
- by <- unlist(purrr::map(gp_attributes, 'by'))
- if(any(by == 'NA')){
- by[by == 'NA'] <- NA
- }
-
- # Return as a data.frame
- return(data.frame(gp_covariates,
- k,
- scale,
- boundary,
- by,
- level = NA))
-}
-
-
-#' Evaluate Laplacian eigenfunction for a given GP basis function
-#' @noRd
-phi = function(boundary, m, centred_covariate) {
- 1 / sqrt(boundary) * sin((m * pi)/(2 * boundary) *
- (centred_covariate + boundary))
-}
-
-#' Evaluate eigenvalues for a given GP basis function
-#' @noRd
-lambda = function(boundary, m) {
- ((m * pi)/(2 * boundary))^2
-}
-
-#' Spectral density squared exponential Gaussian Process kernel
-#' @noRd
-spd = function(alpha_gp, rho_gp, eigenvalues) {
- (alpha_gp^2) * sqrt(2 * pi) * rho_gp *
- exp(-0.5 * (rho_gp^2) * (eigenvalues^2))
-}
-
-#' @noRd
-sim_hilbert_gp = function(alpha_gp,
- rho_gp,
- b_gp,
- last_trends,
- fc_times,
- train_times,
- mean_train_times){
-
- num_gp_basis <- length(b_gp)
-
- # Get vector of eigenvalues of covariance matrix
- eigenvalues <- vector()
- for(m in 1:num_gp_basis){
- eigenvalues[m] <- lambda(boundary = (5.0/4) *
- (max(train_times) - min(train_times)),
- m = m)
- }
-
- # Get vector of eigenfunctions
- eigenfunctions <- matrix(NA, nrow = length(fc_times),
- ncol = num_gp_basis)
- for(m in 1:num_gp_basis){
- eigenfunctions[, m] <- phi(boundary = (5.0/4) *
- (max(train_times) - min(train_times)),
- m = m,
- centred_covariate = fc_times - mean_train_times)
- }
-
- # Compute diagonal of covariance matrix
- diag_SPD <- sqrt(spd(alpha_gp = alpha_gp,
- rho_gp = rho_gp,
- sqrt(eigenvalues)))
-
- # Compute GP trend forecast
- as.vector((diag_SPD * b_gp) %*% t(eigenfunctions))
-}
-
-#' @noRd
-seq_cols <- function(x) {
- seq_len(NCOL(x))
-}
-
-#' Compute the mth eigen function of an approximate GP
-#' Credit to Paul Burkner from brms: https://github.com/paul-buerkner/brms/R/formula-gp.R#L289
-#' @noRd
-eigen_fun_cov_exp_quad <- function(x, m, L) {
- x <- as.matrix(x)
- D <- ncol(x)
- stopifnot(length(m) == D, length(L) == D)
- out <- vector("list", D)
- for (i in seq_cols(x)) {
- out[[i]] <- 1 / sqrt(L[i]) *
- sin((m[i] * pi) / (2 * L[i]) * (x[, i] + L[i]))
- }
- Reduce("*", out)
-}
-
-#' Compute squared differences
-#' Credit to Paul Burkner from brms: https://github.com/paul-buerkner/brms/R/formula-gp.R#L241
-#' @param x vector or matrix
-#' @param x_new optional vector of matrix with the same ncol as x
-#' @return an nrow(x) times nrow(x_new) matrix
-#' @details if matrices are passed results are summed over the columns
-#' @noRd
-diff_quad <- function(x, x_new = NULL) {
- x <- as.matrix(x)
- if (is.null(x_new)) {
- x_new <- x
- } else {
- x_new <- as.matrix(x_new)
- }
- .diff_quad <- function(x1, x2) (x1 - x2)^2
- out <- 0
- for (i in seq_cols(x)) {
- out <- out + outer(x[, i], x_new[, i], .diff_quad)
- }
- out
-}
-
-#' Extended range of input data for which predictions should be made
-#' Credit to Paul Burkner from brms: https://github.com/paul-buerkner/brms/R/formula-gp.R#L301
-#' @noRd
-choose_L <- function(x, c) {
- if (!length(x)) {
- range <- 1
- } else {
- range <- max(1, max(x, na.rm = TRUE) - min(x, na.rm = TRUE))
- }
- c * range
-}
-
-#' Mean-center and scale the particular covariate of interest
-#' so that the maximum Euclidean distance between any two points is 1
-#' @noRd
-scale_cov <- function(data, covariate, by, level,
- mean, max_dist){
- Xgp <- data[[covariate]]
- if(!is.na(by) &
- !is.na(level)){
- Xgp <- data[[covariate]][data[[by]] == level]
- }
-
- # Compute max Euclidean distance if not supplied
- if(is.na(max_dist)){
- Xgp_max_dist <- sqrt(max(diff_quad(Xgp)))
- } else {
- Xgp_max_dist <- max_dist
- }
-
- # Scale
- Xgp <- Xgp / Xgp_max_dist
-
- # Compute mean if not supplied (after scaling)
- if(is.na(mean)){
- Xgp_mean <- mean(Xgp, na.rm = TRUE)
- } else {
- Xgp_mean <- mean
- }
-
- # Center
- Xgp <- Xgp - Xgp_mean
-
- return(list(Xgp = Xgp,
- Xgp_mean = Xgp_mean,
- Xgp_max_dist = Xgp_max_dist))
-}
-
-#' Prep GP eigenfunctions
-#' @noRd
-prep_eigenfunctions = function(data,
- covariate,
- by = NA,
- level = NA,
- k,
- boundary,
- mean = NA,
- max_dist = NA,
- scale = TRUE,
- L,
- initial_setup = FALSE){
-
- # Extract and scale covariate (scale set to FALSE if this is a prediction
- # step so that we can scale by the original training covariate values supplied
- # in mean and max_dist)
- covariate_cent <- scale_cov(data = data,
- covariate = covariate,
- by = by,
- level = level,
- mean = mean,
- max_dist = max_dist)$Xgp
-
- # Construct matrix of eigenfunctions
- eigenfunctions <- matrix(NA, nrow = length(covariate_cent),
- ncol = k)
- if(missing(L)){
- L <- choose_L(covariate_cent, boundary)
+ gp_isos <- unlist(purrr::map(gp_attributes, 'iso'),
+ use.names = FALSE)
+ gp_kernels <- unlist(purrr::map(gp_attributes, 'cov'),
+ use.names = FALSE)
+ gp_cmcs <- unlist(purrr::map(gp_attributes, 'cmc'),
+ use.names = FALSE)
+ if(any(gp_cmcs == FALSE)){
+ rlang::warn(paste0("gp effects in mvgam cannot yet handle contrast coding\n",
+ "resetting all instances of 'cmc = FALSE' to 'cmc = TRUE'"),
+ .frequency = "once",
+ .frequency_id = 'gp_cmcs')
}
-
- for(m in 1:k){
- eigenfunctions[, m] <- eigen_fun_cov_exp_quad(x = matrix(covariate_cent),
- m = m,
- L = L)
+ gp_grs <- unlist(purrr::map(gp_attributes, 'gr'),
+ use.names = FALSE)
+ if(any(gp_grs == TRUE)){
+ rlang::warn(paste0("gp effects in mvgam cannot yet handle autogrouping\n",
+ "resetting all instances of 'gr = TRUE' to 'gr = FALSE'"),
+ .frequency = "once",
+ .frequency_id = 'gp_grs')
}
- # Multiply eigenfunctions by the 'by' variable if one is supplied
- if(!is.na(by)){
- if(!is.na(level)){
- # no multiplying needed as this is a factor by variable,
- # but we need to pad the eigenfunctions with zeros
- # for the observations where the by is a different level;
- # the design matrix is always sorted by time and then by series
- # in mvgam
- if(initial_setup){
- sorted_by <- data.frame(time = data$time,
- series = data$series,
- byvar = data[[by]]) %>%
- dplyr::arrange(time, series) %>%
- dplyr::pull(byvar)
- } else {
- sorted_by <- data[[by]]
- }
-
- full_eigens <- matrix(0, nrow = length(data[[by]]),
- ncol = NCOL(eigenfunctions))
- full_eigens[(1:length(data[[by]]))[
- sorted_by == level],] <- eigenfunctions
- eigenfunctions <- full_eigens
+ newgp_terms <- unlist(lapply(seq_along(gp_terms), function(x){
+ lbl <- paste0('gp(',
+ paste(gp_attributes[[x]]$term, collapse = ', '),
+ if(gp_attributes[[x]]$by != 'NA'){
+ paste0(', by = ',
+ gp_attributes[[x]]$by)
+ } else {
+ NULL
+ },
+ ', k = ',
+ gp_attributes[[x]]$k,
+ ', cov = "',
+ gp_attributes[[x]]$cov,
+ '", iso = ',
+ gp_attributes[[x]]$iso,
+ ', scale = ',
+ gp_attributes[[x]]$scale,
+ ', c = ',
+ gp_attributes[[x]]$c[1],
+ ', gr = FALSE, cmc = TRUE)')
+
+ }), use.names = FALSE)
+
+ gp_formula <- reformulate(newgp_terms,
+ rlang::f_lhs(formula))
+
+ gp_def_priors <- do.call(rbind, lapply(seq_along(gp_terms), function(x){
+ def_gp_prior <- suppressWarnings(brms::get_prior(
+ reformulate(newgp_terms[x],
+ rlang::f_lhs(formula)),
+ family = family_to_brmsfam(family),
+ data = data))
+ def_gp_prior <- def_gp_prior[def_gp_prior$prior != '',]
+ def_rho <- def_gp_prior$prior[which(def_gp_prior$class == 'lscale')]
+ def_alpha <- def_gp_prior$prior[min(which(def_gp_prior$class == 'sdgp'))]
+ if(def_alpha == ''){
+ def_alpha <- 'student_t(3, 0, 2.5);'
+ }
+ if(length(def_rho) > 1L){
+ def_rho_2 <- def_rho[2]
+ def_rho <- def_rho[1]
+ out <- data.frame(def_rho = def_rho,
+ def_rho_2 = def_rho_2,
+ def_alpha = def_alpha)
} else {
- eigenfunctions <- eigenfunctions * data[[by]]
+ out <- data.frame(def_rho = def_rho,
+ def_rho_2 = NA,
+ def_alpha = def_alpha)
}
- }
- eigenfunctions
-}
+ out
+ }))
-#' Prep Hilbert Basis GP covariates
-#' @noRd
-prep_gp_covariate = function(data,
- response,
- covariate,
- by = NA,
- level = NA,
- scale = TRUE,
- boundary = 5.0/4,
- k = 20,
- family = gaussian()){
-
- # Get default gp param priors from a call to brms::get_prior()
- def_gp_prior <- suppressWarnings(brms::get_prior(formula(paste0(response,
- ' ~ gp(', covariate,
- ifelse(is.na(by), ', ',
- paste0(', by = ', by, ', ')),
- 'k = ', k,
- ', scale = ',
- scale,
- ', c = ',
- boundary,
- ')')), data = data,
- family = family))
- def_gp_prior <- def_gp_prior[def_gp_prior$prior != '',]
- def_rho <- def_gp_prior$prior[min(which(def_gp_prior$class == 'lscale'))]
- if(def_rho == ''){
- def_rho <- 'inv_gamma(1.5, 5);'
- }
- def_alpha <- def_gp_prior$prior[min(which(def_gp_prior$class == 'sdgp'))]
- if(def_alpha == ''){
- def_alpha<- 'student_t(3, 0, 2.5);'
+ # Extract information necessary to construct the GP terms
+ gp_terms <- purrr::map(gp_attributes, 'term')
+ gp_dims <- unlist(lapply(gp_terms, length), use.names = FALSE)
+ gp_covariates <- unlist(lapply(gp_terms, function(x){
+ paste(x, collapse = ', ')
+ }), use.names = FALSE)
+ k <- unlist(purrr::map(gp_attributes, 'k'))
+ if(any(is.na(k))){
+ stop('argument "k" must be supplied for any gp() terms',
+ call. = FALSE)
}
- # Prepare the covariate
- if(scale){
- max_dist <- NA
- } else {
- max_dist <- 1
+ # No longer will need boundary or scale information as
+ # brms will handle this internally
+ by <- unlist(purrr::map(gp_attributes, 'by'), use.names = FALSE)
+ if(any(by == 'NA')){
+ by[by == 'NA'] <- NA
}
- covariate_cent <- scale_cov(data = data,
- covariate = covariate,
- by = by,
- mean = NA,
- max_dist = max_dist,
- level = level)
-
- covariate_mean <- covariate_cent$Xgp_mean
- covariate_max_dist <- covariate_cent$Xgp_max_dist
- covariate_cent <- covariate_cent$Xgp
-
- # Construct vector of eigenvalues for GP covariance matrix; the
- # same eigenvalues are always used in prediction, so we only need to
- # create them when prepping the data. They will need to be included in
- # the Stan data list
- L <- choose_L(covariate_cent, boundary)
- eigenvalues <- vector()
- for(m in 1:k){
- eigenvalues[m] <- sqrt(lambda(boundary = L,
- m = m))
- }
+ ret_dat <- data.frame(gp_covariates,
+ dim = gp_dims,
+ kernel = gp_kernels,
+ iso = gp_isos,
+ k = k,
+ by,
+ level = NA,
+ def_alpha = gp_def_priors$def_alpha,
+ def_rho = gp_def_priors$def_rho,
+ def_rho_2 = gp_def_priors$def_rho_2)
+ attr(ret_dat, 'gp_formula') <- gp_formula
- # Construct matrix of eigenfunctions; this will change depending on the values
- # of the covariate, so it needs to be computed and included as data but also needs
- # to be computed to make predictions
- eigenfunctions <- prep_eigenfunctions(data = data,
- covariate = covariate,
- by = by,
- level = level,
- L = L,
- k = k,
- boundary = boundary,
- mean = covariate_mean,
- max_dist = covariate_max_dist,
- scale = scale,
- initial_setup = TRUE)
-
- # Make attributes table using a cleaned version of the covariate
- # name to ensure there are no illegal characters in the Stan code
- byname <- ifelse(is.na(by), '', paste0(':', by))
- covariate_name <- paste0('gp(', covariate, ')', byname)
- if(!is.na(level)){
- covariate_name <- paste0(covariate_name, level)
- }
- att_table <- list(effect = 'gp',
- name = covariate_name,
- covariate = covariate,
- by = by,
- level = level,
- k = k,
- boundary = boundary,
- L = L,
- scale = scale,
- def_rho = def_rho,
- def_alpha = def_alpha,
- mean = covariate_mean,
- max_dist = covariate_max_dist,
- eigenvalues = eigenvalues)
-
- # Items to add to Stan data
- # Number of basis functions
- covariate_name <- clean_gpnames(covariate_name)
- data_lines <- paste0('int<lower=1> k_', covariate_name, '; // basis functions for approximate gp\n')
- append_dat <- list(k = k)
- names(append_dat) <- paste0('k_', covariate_name, '')
-
- # Approximate GP eigenvalues
- data_lines <- paste0(data_lines, paste0(
- 'vector[',
- 'k_', covariate_name,
- '] l_', covariate_name, '; // approximate gp eigenvalues\n'),
- collapse = '\n')
- append_dat2 <- list(slambda = eigenvalues)
- names(append_dat2) <- paste0('l_', covariate_name, '')
- append_dat <- append(append_dat, append_dat2)
-
- # Return necessary objects in a list
- list(att_table = att_table,
- data_lines = data_lines,
- data_append = append_dat,
- eigenfunctions = eigenfunctions)
+ # Return as a data.frame
+ return(ret_dat)
}
+
#' Clean GP names so no illegal characters are used in Stan code
#' @noRd
clean_gpnames = function(gp_names){
gp_names_clean <- gsub(' ', '_', gp_names, fixed = TRUE)
gp_names_clean <- gsub('(', '_', gp_names_clean, fixed = TRUE)
gp_names_clean <- gsub(')', '_', gp_names_clean, fixed = TRUE)
+ gp_names_clean <- gsub(',', 'by', gp_names_clean, fixed = TRUE)
gp_names_clean <- gsub(':', 'by', gp_names_clean, fixed = TRUE)
gp_names_clean <- gsub('.', '_', gp_names_clean, fixed = TRUE)
gp_names_clean <- gsub(']', '_', gp_names_clean, fixed = TRUE)
@@ -636,10 +598,15 @@ clean_gpnames = function(gp_names){
#' Update a Stan file with GP information
#' @noRd
-add_gp_model_file = function(model_file, model_data, mgcv_model, gp_additions){
+add_gp_model_file = function(model_file, model_data,
+ mgcv_model, gp_additions){
- rho_priors <- unlist(purrr::map(gp_additions$gp_att_table, 'def_rho'))
- alpha_priors <- unlist(purrr::map(gp_additions$gp_att_table, 'def_alpha'))
+ rho_priors <- unlist(purrr::map(gp_additions$gp_att_table, 'def_rho'),
+ use.names = FALSE)
+ rho_2_priors <- unlist(purrr::map(gp_additions$gp_att_table, 'def_rho_2'),
+ use.names = FALSE)
+ alpha_priors <- unlist(purrr::map(gp_additions$gp_att_table, 'def_alpha'),
+ use.names = FALSE)
# Add data lines
model_file[grep('int<lower=0> ytimes[n, n_series];',
@@ -650,12 +617,21 @@ add_gp_model_file = function(model_file, model_data, mgcv_model, gp_additions){
gp_additions$gp_stan_lines)
model_file <- readLines(textConnection(model_file), n = -1)
- # Replace the multi_normal_prec lines with spd_cov_exp_quad
- gp_names <- unlist(purrr::map(attr(mgcv_model, 'gp_att_table'), 'name'))
+ # Replace the multi_normal_prec lines with the relevant spd function
+ gp_kernels <- unlist(purrr::map(attr(mgcv_model, 'gp_att_table'), 'kernel'),
+ use.names = FALSE)
+ gp_names <- unlist(purrr::map(attr(mgcv_model, 'gp_att_table'), 'name'),
+ use.names = FALSE)
+ gp_isos <- unlist(purrr::map(attr(mgcv_model, 'gp_att_table'), 'iso'),
+ use.names = FALSE)
+ gp_dims <- unlist(purrr::map(attr(mgcv_model, 'gp_att_table'), 'dim'),
+ use.names = FALSE)
+ orig_names <- unlist(purrr::map(attr(mgcv_model, 'gp_att_table'), 'orig_name'),
+ use.names = FALSE)
gp_names_clean <- clean_gpnames(gp_names)
s_to_remove <- list()
for(i in seq_along(gp_names)){
- s_name <- gsub('gp(', 's(', gp_names[i], fixed = TRUE)
+ s_name <- gsub(' ', '', orig_names[i])
to_replace <- grep(paste0('// prior for ', s_name, '...'),
model_file, fixed = TRUE) + 1
pattern <- "S\\s*(.*?)\\s*\\["
@@ -666,8 +642,33 @@ add_gp_model_file = function(model_file, model_data, mgcv_model, gp_additions){
model_file[grep(paste0('// prior for ', s_name, '...'),
model_file, fixed = TRUE)] <-
- gsub('s(', 'gp(', model_file[grep(paste0('// prior for ', s_name, '...'),
- model_file, fixed = TRUE)], fixed = TRUE)
+ gsub('s\\(|ti\\(', 'gp(', model_file[grep(paste0('// prior for ', s_name, '...'),
+ model_file, fixed = TRUE)])
+
+ rho_prior_lines <- paste(
+ paste0('rho_',
+ gp_names_clean[i],
+ if(!gp_isos[i]){
+ '[1]'
+ } else {
+ NULL
+ },
+ '[',
+ if(gp_isos[i]){
+ 1
+ } else {
+ seq(1:gp_dims[i])
+ },
+ ']',
+ ' ~ ',
+ if(gp_isos[i]){
+ rho_priors[i]
+ } else {
+ c(rho_priors[i], rho_2_priors[i])
+ },
+ ';\n'),
+ collapse = '\n'
+ )
model_file[to_replace] <-
paste0('z_',
@@ -678,25 +679,22 @@ add_gp_model_file = function(model_file, model_data, mgcv_model, gp_additions){
' ~ ',
alpha_priors[i],
';\n',
- 'rho_',
- gp_names_clean[i],
- ' ~ ',
- rho_priors[i],
- ';\n',
+ rho_prior_lines,
'b_raw[b_idx_',
gp_names_clean[i],
'] ~ std_normal();\n')
}
- b_line <- max(grep('b[', model_file, fixed = TRUE))
+ b_line <- max(which(grepl('b[', model_file, fixed = TRUE) &
+ grepl('] =', model_file, fixed = TRUE)))
b_edits <- paste0('b[b_idx_',
gp_names_clean,
- '] = sqrt(spd_cov_exp_quad(l_',
+ add_gp_spd_calls(gp_kernels),
gp_names_clean,
', alpha_',
gp_names_clean,
', rho_',
gp_names_clean,
- ')) .* z_',
+ '[1])) .* z_',
gp_names_clean,
';',
collapse = '\n')
@@ -717,12 +715,17 @@ add_gp_model_file = function(model_file, model_data, mgcv_model, gp_additions){
}
# Add alpha, rho and z lines in parameters and model blocks
- alpha_names <- paste(paste0('real<lower=0> alpha_', gp_names_clean,
- ';'),
- collapse = '\n')
- rho_names <- paste(paste0('real<lower=0> rho_', gp_names_clean,
+ alpha_names <- paste(paste0('real<lower=0> alpha_',
+ gp_names_clean,
';'),
collapse = '\n')
+
+ rho_names <- paste(paste0('array[1] vector<lower=0>[',
+ ifelse(gp_isos, 1, gp_dims),
+ '] rho_', gp_names_clean,
+ ';'),
+ collapse = '\n')
+
z_names <- paste(paste0('vector[k_',
gp_names_clean,
'] z_',
@@ -740,58 +743,555 @@ add_gp_model_file = function(model_file, model_data, mgcv_model, gp_additions){
'\n')
model_file <- readLines(textConnection(model_file), n = -1)
- # Add spd_cov_exp_quad function from brms code
- if(!any(grepl('/* Spectral density function of a Gaussian process',
- model_file, fixed = TRUE))){
- if(any(grepl('functions {', model_file, fixed = TRUE))){
- model_file[grep('functions {', model_file, fixed = TRUE)] <-
- paste0('functions {\n',
- '/* Spectral density function of a Gaussian process\n',
- '* with squared exponential covariance kernel\n',
- '* Args:\n',
- '* l_gp: numeric eigenvalues of an SPD GP\n',
- '* alpha_gp: marginal SD parameter\n',
- '* rho_gp: length-scale parameter\n',
- '* Returns:\n',
- '* numeric values of the GP function evaluated at l_gp\n',
- '*/\n',
- 'vector spd_cov_exp_quad(data vector l_gp, real alpha_gp, real rho_gp) {\n',
- 'int NB = size(l_gp);\n',
- 'vector[NB] out;\n',
- 'real constant = square(alpha_gp) * (sqrt(2 * pi()) * rho_gp);\n',
- 'real neg_half_lscale2 = -0.5 * square(rho_gp);\n',
- 'for (m in 1:NB) {\n',
- 'out[m] = constant * exp(neg_half_lscale2 * square(l_gp[m]));\n',
- '}\n',
- 'return out;\n',
- '}\n')
- } else {
- model_file[grep('Stan model code', model_file)] <-
- paste0('// Stan model code generated by package mvgam\n',
- 'functions {\n',
- '/* Spectral density function of a Gaussian process\n',
- '* with squared exponential covariance kernel\n',
- '* Args:\n',
- '* l_gp: numeric eigenvalues of an SPD GP\n',
- '* alpha_gp: marginal SD parameter\n',
- '* rho_gp: length-scale parameter\n',
- '* Returns:\n',
- '* numeric values of the GP function evaluated at l_gp\n',
- '*/\n',
- 'vector spd_cov_exp_quad(data vector l_gp, real alpha_gp, real rho_gp) {\n',
- 'int NB = size(l_gp);\n',
- 'vector[NB] out;\n',
- 'real constant = square(alpha_gp) * (sqrt(2 * pi()) * rho_gp);\n',
- 'real neg_half_lscale2 = -0.5 * square(rho_gp);\n',
- 'for (m in 1:NB) {\n',
- 'out[m] = constant * exp(neg_half_lscale2 * square(l_gp[m]));\n',
- '}\n',
- 'return out;\n',
- '}\n}\n')
- }
+ # Add spd_ functions from brms code
+ kerns_add <- rev(gp_kernels)
+ for(i in seq_along(kerns_add)){
+ model_file <- add_gp_spd_funs(model_file, kerns_add[i])
}
- model_file <- readLines(textConnection(model_file), n = -1)
return(list(model_file = model_file,
model_data = model_data))
}
+
+#' Add GP SPD functions to a stan model file
+#' @noRd
+add_gp_spd_calls = function(kernels){
+ kern_calls <- vector(length = length(kernels))
+ for(i in seq_along(kern_calls)){
+ if(kernels[i] == 'exp_quad'){
+ kern_calls[i] <- '] = sqrt(spd_gp_exp_quad(l_'
+ }
+ if(kernels[i] == 'exponential'){
+ kern_calls[i] <- '] = sqrt(spd_gp_exponential(l_'
+ }
+ if(kernels[i] == 'matern32'){
+ kern_calls[i] <- '] = sqrt(spd_gp_matern32(l_'
+ }
+ if(kernels[i] == 'matern52'){
+ kern_calls[i] <- '] = sqrt(spd_gp_matern52(l_'
+ }
+ }
+ return(kern_calls)
+}
+
+#' @noRd
+add_gp_spd_funs = function(model_file, kernel){
+ if(kernel == 'exp_quad'){
+ if(!any(grepl('/* Spectral density of a squared exponential Gaussian process',
+ model_file, fixed = TRUE))){
+ fun_lines <- paste0('/* Spectral density of a squared exponential Gaussian process\n',
+ '* Args:\n',
+ '* x: array of numeric values of dimension NB x D\n',
+ '* sdgp: marginal SD parameter\n',
+ '* lscale: vector of length-scale parameters\n',
+ '* Returns:\n',
+ "* numeric vector of length NB of the SPD evaluated at 'x'\n",
+ '*/\n',
+ 'vector spd_gp_exp_quad(data array[] vector x, real sdgp, vector lscale) {\n',
+ 'int NB = dims(x)[1];\n',
+ 'int D = dims(x)[2];\n',
+ 'int Dls = rows(lscale);\n',
+ 'real constant = square(sdgp) * sqrt(2 * pi())^D;\n',
+ 'vector[NB] out;\n',
+ 'if (Dls == 1) {\n',
+ '// one dimensional or isotropic GP\n',
+ 'real neg_half_lscale2 = -0.5 * square(lscale[1]);\n',
+ 'constant = constant * lscale[1]^D;\n',
+ 'for (m in 1:NB) {\n',
+ 'out[m] = constant * exp(neg_half_lscale2 * dot_self(x[m]));\n',
+ '}\n',
+ '} else {\n',
+ '// multi-dimensional non-isotropic GP\n',
+ 'vector[Dls] neg_half_lscale2 = -0.5 * square(lscale);\n',
+ 'constant = constant * prod(lscale);\n',
+ 'for (m in 1:NB) {\n',
+ 'out[m] = constant * exp(dot_product(neg_half_lscale2, square(x[m])));\n',
+ '}\n',
+ '}\n',
+ 'return out;\n',
+ '}')
+ } else {
+ fun_lines <- NULL
+ }
+ }
+
+ if(kernel %in% c('exponential', 'matern12')){
+ if(!any(grepl('/* Spectral density of an exponential Gaussian process',
+ model_file, fixed = TRUE))){
+ fun_lines <- paste0('/* Spectral density of an exponential Gaussian process\n',
+ '* also known as the Matern 1/2 kernel\n',
+ '* Args:\n',
+ '* x: array of numeric values of dimension NB x D\n',
+ '* sdgp: marginal SD parameter\n',
+ '* lscale: vector of length-scale parameters\n',
+ '* Returns:\n',
+ "* numeric vector of length NB of the SPD evaluated at 'x'\n",
+ '*/\n',
+ 'vector spd_gp_exponential(data array[] vector x, real sdgp, vector lscale) {\n',
+ 'int NB = dims(x)[1];\n',
+ 'int D = dims(x)[2];\n',
+ 'int Dls = rows(lscale);\n',
+ 'real constant = square(sdgp) *\n',
+ '(2^D * pi()^(D / 2.0) * tgamma((D + 1.0) / 2)) / sqrt(pi());\n',
+ 'real expo = -(D + 1.0) / 2;\n',
+ 'vector[NB] out;\n',
+ 'if (Dls == 1) {\n',
+ '// one dimensional or isotropic GP\n',
+ 'real lscale2 = square(lscale[1]);\n',
+ 'constant = constant * lscale[1]^D;\n',
+ 'for (m in 1:NB) {\n',
+ 'out[m] = constant * (1 + lscale2 * dot_self(x[m]))^expo;\n',
+ '}\n',
+ '} else {\n',
+ '// multi-dimensional non-isotropic GP\n',
+ 'vector[Dls] lscale2 = square(lscale);\n',
+ 'constant = constant * prod(lscale);\n',
+ 'for (m in 1:NB) {\n',
+ 'out[m] = constant * (1 + dot_product(lscale2, square(x[m])))^expo;\n',
+ '}\n',
+ '}\n',
+ 'return out;\n',
+ '}')
+ } else {
+ fun_lines <- NULL
+ }
+ }
+
+ if(kernel == 'matern32'){
+ if(!any(grepl('/* Spectral density of a Matern 3/2 Gaussian process',
+ model_file, fixed = TRUE))){
+ fun_lines <- paste0('/* Spectral density of a Matern 3/2 Gaussian process\n',
+ '* Args:\n',
+ '* x: array of numeric values of dimension NB x D\n',
+ '* sdgp: marginal SD parameter\n',
+ '* lscale: vector of length-scale parameters\n',
+ '* Returns:\n',
+ "* numeric vector of length NB of the SPD evaluated at 'x'\n",
+ '*/\n',
+ 'vector spd_gp_matern32(data array[] vector x, real sdgp, vector lscale) {\n',
+ 'int NB = dims(x)[1];\n',
+ 'int D = dims(x)[2];\n',
+ 'int Dls = rows(lscale);\n',
+ 'real constant = square(sdgp) *\n',
+ '(2^D * pi()^(D / 2.0) * tgamma((D + 3.0) / 2) * 3^(3.0 / 2)) /\n',
+ '(0.5 * sqrt(pi()));\n',
+ 'real expo = -(D + 3.0) / 2;\n',
+ 'vector[NB] out;\n',
+ 'if (Dls == 1) {\n',
+ '// one dimensional or isotropic GP\n',
+ 'real lscale2 = square(lscale[1]);\n',
+ 'constant = constant * lscale[1]^D;\n',
+ 'for (m in 1:NB) {\n',
+ 'out[m] = constant * (3 + lscale2 * dot_self(x[m]))^expo;\n',
+ '}\n',
+ '} else {\n',
+ '// multi-dimensional non-isotropic GP\n',
+ 'vector[Dls] lscale2 = square(lscale);\n',
+ 'constant = constant * prod(lscale);\n',
+ 'for (m in 1:NB) {\n',
+ 'out[m] = constant * (3 + dot_product(lscale2, square(x[m])))^expo;\n',
+ '}\n',
+ '}\n',
+ 'return out;\n',
+ '}')
+ } else {
+ fun_lines <- NULL
+ }
+ }
+
+ if(kernel == 'matern52'){
+ if(!any(grepl('/* Spectral density of a Matern 5/2 Gaussian process',
+ model_file, fixed = TRUE))){
+ fun_lines <- paste0('/* Spectral density of a Matern 5/2 Gaussian process\n',
+ '* Args:\n',
+ '* x: array of numeric values of dimension NB x D\n',
+ '* sdgp: marginal SD parameter\n',
+ '* lscale: vector of length-scale parameters\n',
+ '* Returns:\n',
+ "* numeric vector of length NB of the SPD evaluated at 'x'\n",
+ '*/\n',
+ 'vector spd_gp_matern52(data array[] vector x, real sdgp, vector lscale) {\n',
+ 'int NB = dims(x)[1];\n',
+ 'int D = dims(x)[2];\n',
+ 'int Dls = rows(lscale);\n',
+ 'real constant = square(sdgp) *\n',
+ '(2^D * pi()^(D / 2.0) * tgamma((D + 5.0) / 2) * 5^(5.0 / 2)) /\n',
+ '(0.75 * sqrt(pi()));\n',
+ 'real expo = -(D + 5.0) / 2;\n',
+ 'vector[NB] out;\n',
+ 'if (Dls == 1) {\n',
+ '// one dimensional or isotropic GP\n',
+ 'real lscale2 = square(lscale[1]);\n',
+ 'constant = constant * lscale[1]^D;\n',
+ 'for (m in 1:NB) {\n',
+ 'out[m] = constant * (5 + lscale2 * dot_self(x[m]))^expo;\n',
+ '}\n',
+ '} else {\n',
+ '// multi-dimensional non-isotropic GP\n',
+ 'vector[Dls] lscale2 = square(lscale);\n',
+ 'constant = constant * prod(lscale);\n',
+ 'for (m in 1:NB) {\n',
+ 'out[m] = constant * (5 + dot_product(lscale2, square(x[m])))^expo;\n',
+ '}\n',
+ '}\n',
+ 'return out;\n',
+ '}')
+ } else {
+ fun_lines <- NULL
+ }
+ }
+
+ if(any(grepl('functions {', model_file, fixed = TRUE))){
+ model_file[grep('functions {', model_file, fixed = TRUE)] <-
+ paste0('functions {\n',
+ fun_lines)
+ } else {
+ model_file[grep('Stan model code', model_file)] <-
+ paste0('// Stan model code generated by package mvgam\n',
+ 'functions {\n',
+ fun_lines,
+ '\n}\n')
+ }
+
+ model_file <- readLines(textConnection(model_file), n = -1)
+}
+
+#### Old gp() prepping functions; these are now redundant because
+# brms is used to evaluate gp() effects and produce the relevant
+# eigenfunctions / eigenvalues, but keeping the functions here for
+# now in case they are needed for later work ####
+
+#' #' Evaluate Laplacian eigenfunction for a given GP basis function
+#' #' @noRd
+#' phi = function(boundary, m, centred_covariate) {
+#' 1 / sqrt(boundary) * sin((m * pi)/(2 * boundary) *
+#' (centred_covariate + boundary))
+#' }
+#'
+#' #' Evaluate eigenvalues for a given GP basis function
+#' #' @noRd
+#' lambda = function(boundary, m) {
+#' ((m * pi)/(2 * boundary))^2
+#' }
+#'
+#' #' Spectral density squared exponential Gaussian Process kernel
+#' #' @noRd
+#' spd = function(alpha_gp, rho_gp, eigenvalues) {
+#' (alpha_gp^2) * sqrt(2 * pi) * rho_gp *
+#' exp(-0.5 * (rho_gp^2) * (eigenvalues^2))
+#' }
+#'
+#' #' @noRd
+#' sim_hilbert_gp = function(alpha_gp,
+#' rho_gp,
+#' b_gp,
+#' last_trends,
+#' fc_times,
+#' train_times,
+#' mean_train_times){
+#'
+#' num_gp_basis <- length(b_gp)
+#'
+#' # Get vector of eigenvalues of covariance matrix
+#' eigenvalues <- vector()
+#' for(m in 1:num_gp_basis){
+#' eigenvalues[m] <- lambda(boundary = (5.0/4) *
+#' (max(train_times) - min(train_times)),
+#' m = m)
+#' }
+#'
+#' # Get vector of eigenfunctions
+#' eigenfunctions <- matrix(NA, nrow = length(fc_times),
+#' ncol = num_gp_basis)
+#' for(m in 1:num_gp_basis){
+#' eigenfunctions[, m] <- phi(boundary = (5.0/4) *
+#' (max(train_times) - min(train_times)),
+#' m = m,
+#' centred_covariate = fc_times - mean_train_times)
+#' }
+#'
+#' # Compute diagonal of covariance matrix
+#' diag_SPD <- sqrt(spd(alpha_gp = alpha_gp,
+#' rho_gp = rho_gp,
+#' sqrt(eigenvalues)))
+#'
+#' # Compute GP trend forecast
+#' as.vector((diag_SPD * b_gp) %*% t(eigenfunctions))
+#' }
+
+#' #' Compute the mth eigen function of an approximate GP
+#' #' Credit to Paul Burkner from brms: https://github.com/paul-buerkner/brms/R/formula-gp.R#L289
+#' #' @noRd
+#' eigen_fun_cov_exp_quad <- function(x, m, L) {
+#' x <- as.matrix(x)
+#' D <- ncol(x)
+#' stopifnot(length(m) == D, length(L) == D)
+#' out <- vector("list", D)
+#' for (i in seq_cols(x)) {
+#' out[[i]] <- 1 / sqrt(L[i]) *
+#' sin((m[i] * pi) / (2 * L[i]) * (x[, i] + L[i]))
+#' }
+#' Reduce("*", out)
+#' }
+
+#' #' Compute squared differences
+#' #' Credit to Paul Burkner from brms: https://github.com/paul-buerkner/brms/R/formula-gp.R#L241
+#' #' @param x vector or matrix
+#' #' @param x_new optional vector of matrix with the same ncol as x
+#' #' @return an nrow(x) times nrow(x_new) matrix
+#' #' @details if matrices are passed results are summed over the columns
+#' #' @noRd
+#' diff_quad <- function(x, x_new = NULL) {
+#' x <- as.matrix(x)
+#' if (is.null(x_new)) {
+#' x_new <- x
+#' } else {
+#' x_new <- as.matrix(x_new)
+#' }
+#' .diff_quad <- function(x1, x2) (x1 - x2)^2
+#' out <- 0
+#' for (i in seq_cols(x)) {
+#' out <- out + outer(x[, i], x_new[, i], .diff_quad)
+#' }
+#' out
+#' }
+
+#' #' Extended range of input data for which predictions should be made
+#' #' Credit to Paul Burkner from brms: https://github.com/paul-buerkner/brms/R/formula-gp.R#L301
+#' #' @noRd
+#' choose_L <- function(x, c) {
+#' if (!length(x)) {
+#' range <- 1
+#' } else {
+#' range <- max(1, max(x, na.rm = TRUE) - min(x, na.rm = TRUE))
+#' }
+#' c * range
+#' }
+
+#' #' Mean-center and scale the particular covariate of interest
+#' #' so that the maximum Euclidean distance between any two points is 1
+#' #' @noRd
+#' scale_cov <- function(data, covariate, by, level,
+#' mean, max_dist){
+#' Xgp <- data[[covariate]]
+#' if(!is.na(by) &
+#' !is.na(level)){
+#' Xgp <- data[[covariate]][data[[by]] == level]
+#' }
+#'
+#' # Compute max Euclidean distance if not supplied
+#' if(is.na(max_dist)){
+#' Xgp_max_dist <- sqrt(max(diff_quad(Xgp)))
+#' } else {
+#' Xgp_max_dist <- max_dist
+#' }
+#'
+#' # Scale
+#' Xgp <- Xgp / Xgp_max_dist
+#'
+#' # Compute mean if not supplied (after scaling)
+#' if(is.na(mean)){
+#' Xgp_mean <- mean(Xgp, na.rm = TRUE)
+#' } else {
+#' Xgp_mean <- mean
+#' }
+#'
+#' # Center
+#' Xgp <- Xgp - Xgp_mean
+#'
+#' return(list(Xgp = Xgp,
+#' Xgp_mean = Xgp_mean,
+#' Xgp_max_dist = Xgp_max_dist))
+#' }
+#'
+#' #' Prep GP eigenfunctions
+#' #' @noRd
+#' prep_eigenfunctions = function(data,
+#' covariate,
+#' by = NA,
+#' level = NA,
+#' k,
+#' boundary,
+#' mean = NA,
+#' max_dist = NA,
+#' scale = TRUE,
+#' L,
+#' initial_setup = FALSE){
+#'
+#' # Extract and scale covariate (scale set to FALSE if this is a prediction
+#' # step so that we can scale by the original training covariate values supplied
+#' # in mean and max_dist)
+#' covariate_cent <- scale_cov(data = data,
+#' covariate = covariate,
+#' by = by,
+#' level = level,
+#' mean = mean,
+#' max_dist = max_dist)$Xgp
+#'
+#' # Construct matrix of eigenfunctions
+#' eigenfunctions <- matrix(NA, nrow = length(covariate_cent),
+#' ncol = k)
+#' if(missing(L)){
+#' L <- choose_L(covariate_cent, boundary)
+#' }
+#'
+#' for(m in 1:k){
+#' eigenfunctions[, m] <- eigen_fun_cov_exp_quad(x = matrix(covariate_cent),
+#' m = m,
+#' L = L)
+#' }
+#'
+#' # Multiply eigenfunctions by the 'by' variable if one is supplied
+#' if(!is.na(by)){
+#' if(!is.na(level)){
+#' # no multiplying needed as this is a factor by variable,
+#' # but we need to pad the eigenfunctions with zeros
+#' # for the observations where the by is a different level;
+#' # the design matrix is always sorted by time and then by series
+#' # in mvgam
+#' if(initial_setup){
+#' sorted_by <- data.frame(time = data$time,
+#' series = data$series,
+#' byvar = data[[by]]) %>%
+#' dplyr::arrange(time, series) %>%
+#' dplyr::pull(byvar)
+#' } else {
+#' sorted_by <- data[[by]]
+#' }
+#'
+#' full_eigens <- matrix(0, nrow = length(data[[by]]),
+#' ncol = NCOL(eigenfunctions))
+#' full_eigens[(1:length(data[[by]]))[
+#' sorted_by == level],] <- eigenfunctions
+#' eigenfunctions <- full_eigens
+#' } else {
+#' eigenfunctions <- eigenfunctions * data[[by]]
+#' }
+#' }
+#' eigenfunctions
+#' }
+#'
+#' #' Prep Hilbert Basis GP covariates
+#' #' @noRd
+#' prep_gp_covariate = function(data,
+#' response,
+#' covariate,
+#' by = NA,
+#' level = NA,
+#' scale = TRUE,
+#' boundary = 5.0/4,
+#' k = 20,
+#' family = gaussian()){
+#'
+#' # Get default gp param priors from a call to brms::get_prior()
+#' def_gp_prior <- suppressWarnings(brms::get_prior(formula(paste0(response,
+#' ' ~ gp(', covariate,
+#' ifelse(is.na(by), ', ',
+#' paste0(', by = ', by, ', ')),
+#' 'k = ', k,
+#' ', scale = ',
+#' scale,
+#' ', c = ',
+#' boundary,
+#' ')')), data = data,
+#' family = family))
+#' def_gp_prior <- def_gp_prior[def_gp_prior$prior != '',]
+#' def_rho <- def_gp_prior$prior[min(which(def_gp_prior$class == 'lscale'))]
+#' if(def_rho == ''){
+#' def_rho <- 'inv_gamma(1.5, 5);'
+#' }
+#' def_alpha <- def_gp_prior$prior[min(which(def_gp_prior$class == 'sdgp'))]
+#' if(def_alpha == ''){
+#' def_alpha<- 'student_t(3, 0, 2.5);'
+#' }
+#'
+#' # Prepare the covariate
+#' if(scale){
+#' max_dist <- NA
+#' } else {
+#' max_dist <- 1
+#' }
+#'
+#' covariate_cent <- scale_cov(data = data,
+#' covariate = covariate,
+#' by = by,
+#' mean = NA,
+#' max_dist = max_dist,
+#' level = level)
+#'
+#' covariate_mean <- covariate_cent$Xgp_mean
+#' covariate_max_dist <- covariate_cent$Xgp_max_dist
+#' covariate_cent <- covariate_cent$Xgp
+#'
+#' # Construct vector of eigenvalues for GP covariance matrix; the
+#' # same eigenvalues are always used in prediction, so we only need to
+#' # create them when prepping the data. They will need to be included in
+#' # the Stan data list
+#' L <- choose_L(covariate_cent, boundary)
+#' eigenvalues <- vector()
+#' for(m in 1:k){
+#' eigenvalues[m] <- sqrt(lambda(boundary = L,
+#' m = m))
+#' }
+#'
+#' # Construct matrix of eigenfunctions; this will change depending on the values
+#' # of the covariate, so it needs to be computed and included as data but also needs
+#' # to be computed to make predictions
+#' eigenfunctions <- prep_eigenfunctions(data = data,
+#' covariate = covariate,
+#' by = by,
+#' level = level,
+#' L = L,
+#' k = k,
+#' boundary = boundary,
+#' mean = covariate_mean,
+#' max_dist = covariate_max_dist,
+#' scale = scale,
+#' initial_setup = TRUE)
+#'
+#' # Make attributes table using a cleaned version of the covariate
+#' # name to ensure there are no illegal characters in the Stan code
+#' byname <- ifelse(is.na(by), '', paste0(':', by))
+#' covariate_name <- paste0('gp(', covariate, ')', byname)
+#' if(!is.na(level)){
+#' covariate_name <- paste0(covariate_name, level)
+#' }
+#' att_table <- list(effect = 'gp',
+#' name = covariate_name,
+#' covariate = covariate,
+#' by = by,
+#' level = level,
+#' k = k,
+#' boundary = boundary,
+#' L = L,
+#' scale = scale,
+#' def_rho = def_rho,
+#' def_alpha = def_alpha,
+#' mean = covariate_mean,
+#' max_dist = covariate_max_dist,
+#' eigenvalues = eigenvalues)
+#'
+#' # Items to add to Stan data
+#' # Number of basis functions
+#' covariate_name <- clean_gpnames(covariate_name)
+#' data_lines <- paste0('int<lower=1> k_', covariate_name,
+#' '; // basis functions for approximate gp\n')
+#' append_dat <- list(k = k)
+#' names(append_dat) <- paste0('k_', covariate_name, '')
+#'
+#' # Approximate GP eigenvalues
+#' data_lines <- paste0(data_lines, paste0(
+#' 'vector[',
+#' 'k_', covariate_name,
+#' '] l_', covariate_name, '; // approximate gp eigenvalues\n'),
+#' collapse = '\n')
+#' append_dat2 <- list(slambda = eigenvalues)
+#' names(append_dat2) <- paste0('l_', covariate_name, '')
+#' append_dat <- append(append_dat, append_dat2)
+#'
+#' # Return necessary objects in a list
+#' list(att_table = att_table,
+#' data_lines = data_lines,
+#' data_append = append_dat,
+#' eigenfunctions = eigenfunctions)
+#' }
diff --git a/R/gratia_methods.R b/R/gratia_methods.R
index 19973cc7..2722c550 100644
--- a/R/gratia_methods.R
+++ b/R/gratia_methods.R
@@ -221,6 +221,7 @@ NULL
stop('no trend_formula exists so there are no trend-level terms to plot')
}
+ object$trend_mgcv_model <- relabel_gps(object$trend_mgcv_model)
object$trend_mgcv_model$call$data <- NULL
object$trend_mgcv_model$cmX <- object$trend_mgcv_model$coefficients
sm_plots <- gratia::draw(object = object$trend_mgcv_model,
@@ -267,6 +268,7 @@ NULL
envir = envir,
...)
} else {
+ object$mgcv_model <- relabel_gps(object$mgcv_model)
object$mgcv_model$call$data <- NULL
object$mgcv_model$cmX <- object$mgcv_model$coefficients
sm_plots <- gratia::draw(object = object$mgcv_model,
@@ -332,56 +334,83 @@ eval_smoothDothilbertDotsmooth = function(smooth,
insight::check_if_installed("gratia")
model$cmX <- model$coefficients
+
# deal with data if supplied
data <- process_user_data_for_eval(
data = data, model = model,
n = n, n_3d = n_3d, n_4d = n_4d,
id = which_smooth(
model,
- smooth_label(smooth)
+ gratia::smooth_label(smooth)
)
)
# by variables
- by_var <- by_variable(smooth)
+ by_var <- gratia::by_variable(smooth)
if (by_var == "NA") {
by_var <- NA_character_
}
+ # Compute the gp() eigenfunctions for newdata using the supplied brms_mock object
+ # Requires a dataframe of all relevant variables for the gp effects
+ mock_terms <- brms::brmsterms(attr(model, 'brms_mock')$formula)
+ terms_needed <- unique(all.vars(mock_terms$formula)[-1])
+
+ # Only use actual values of those covariates needed for this smooth
+ terms_smooth <- intersect(terms_needed, colnames(data))
+ newdata_mock <- data.frame(data[[terms_smooth[1]]])
+ if(length(terms_smooth) > 1L){
+ for(i in 2:length(terms_smooth)){
+ newdata_mock <- cbind(newdata_mock,
+ data.frame(data[[terms_smooth[i]]]))
+ }
+ }
+ colnames(newdata_mock) <- terms_smooth
+ newdata_mock$.fake_gp_y <- rnorm(NROW(newdata_mock))
+
+ # Fill in other covariates as fixed values from the original data
+ other_terms <- setdiff(terms_needed, colnames(data))
+ if(length(other_terms) > 0){
+ newdata_mock <- cbind(newdata_mock,
+ do.call(cbind, lapply(seq_along(other_terms), function(x){
+ df <- data.frame(var = rep(model$model[[other_terms[x]]][1],
+ NROW(newdata_mock)))
+ colnames(df) <- other_terms[x]
+ df
+ })))
+ }
+
+ brms_mock_data <- brms::standata(attr(model, 'brms_mock'),
+ newdata = newdata_mock,
+ internal = TRUE)
+
# Extract GP attributes
gp_att_table <- attr(model, 'gp_att_table')
- by <- unlist(purrr::map(gp_att_table, 'by'))
- level <- unlist(purrr::map(gp_att_table, 'level'))
- gp_covariate <- smooth$term
- level <- ifelse(is.null(smooth$by.level), NA, smooth$by.level)
- k <- unlist(purrr::map(gp_att_table, 'k'))
- scale <- unlist(purrr::map(gp_att_table, 'scale'))
- mean <- unlist(purrr::map(gp_att_table, 'mean'))
- max_dist <- unlist(purrr::map(gp_att_table, 'max_dist'))
- boundary <- unlist(purrr::map(gp_att_table, 'boundary'))
- L <- unlist(purrr::map(gp_att_table, 'L'))
+ bys <- unlist(purrr::map(gp_att_table, 'by'),
+ use.names = FALSE)
+ lvls <- unlist(purrr::map(gp_att_table, 'level'),
+ use.names = FALSE)
+
+ # Extract eigenfunctions for each gp effect
+ eigenfuncs <- eigenfunc_list(stan_data = brms_mock_data,
+ mock_df = newdata_mock,
+ by = bys,
+ level = lvls)
# Which GP term are we plotting?
+ gp_covariate <- smooth$term
+ level <- ifelse(is.null(smooth$by.level), NA, smooth$by.level)
+ gp_names <- gsub(' ', '', unlist(purrr::map(gp_att_table, 'name')))
if(!is.na(level)){
- gp_select <- which(unlist(purrr::map(gp_att_table, 'covariate')) == gp_covariate &
- which(by %in% by_var) &
+ gp_select <- which(gp_names == smooth$label &
unlist(purrr::map(gp_att_table, 'level')) == level)
} else {
- gp_select <- which(unlist(purrr::map(gp_att_table, 'covariate')) == gp_covariate &
- which(by %in% by_var))
+ gp_select <- which(gp_names == smooth$label &
+ which(bys %in% by_var))
}
# Compute eigenfunctions for this GP term
- X <- prep_eigenfunctions(data = data,
- covariate = gp_covariate,
- by = by_var,
- level = level,
- k = k[gp_select],
- boundary = boundary[gp_select],
- L = L[gp_select],
- mean = mean[gp_select],
- scale = scale[gp_select],
- max_dist = max_dist[gp_select])
+ X <- eigenfuncs[[gp_select]]
# Extract mean coefficients
start <- purrr::map(gp_att_table, 'first_coef')[[gp_select]]
diff --git a/R/interpret_mvgam.R b/R/interpret_mvgam.R
index 26ea0b16..79e3580b 100644
--- a/R/interpret_mvgam.R
+++ b/R/interpret_mvgam.R
@@ -76,8 +76,7 @@ interpret_mvgam = function(formula, N, family){
attr(newformula, '.Environment') <- attr(formula, '.Environment')
- # Check if any terms use the gp wrapper, as mvgam cannot handle
- # multivariate GPs yet
+ # Check if any terms use the gp wrapper
response <- terms.formula(newformula)[[2]]
tf <- terms.formula(newformula, specials = c("gp"))
which_gp <- attr(tf,"specials")$gp
@@ -88,10 +87,6 @@ interpret_mvgam = function(formula, N, family){
gp_details[[i]] <- eval(parse(text = rownames(attr(tf,
"factors"))[which_gp[i]]))
}
- if(any(unlist(lapply(purrr::map(gp_details, 'term'), length)) > 1)){
- stop('mvgam cannot yet handle multidimensional gps',
- call. = FALSE)
- }
}
# Check if any terms use the dynamic wrapper
@@ -178,3 +173,4 @@ interpret_mvgam = function(formula, N, family){
return(updated_formula)
}
+
diff --git a/R/jsdgam.R b/R/jsdgam.R
index 36702dae..3f0b283e 100644
--- a/R/jsdgam.R
+++ b/R/jsdgam.R
@@ -47,7 +47,7 @@
#' Defaults to `series` to be consistent with other `mvgam` models
#'@param n_lv \code{integer} the number of latent factors to use for modelling
#'residual associations.
-#'Cannot be `< n_species`. Defaults arbitrarily to `1`
+#'Cannot be `> n_species`. Defaults arbitrarily to `2`
#'@param threads \code{integer} Experimental option to use multithreading for within-chain
#'parallelisation in \code{Stan}. We recommend its use only if you are experienced with
#'\code{Stan}'s `reduce_sum` function and have a slow running model that cannot be sped
@@ -198,6 +198,7 @@
#' ggplot(dat, aes(x = lat, y = lon, col = log(count + 1))) +
#' geom_point(size = 2.25) +
#' facet_wrap(~ species, scales = 'free') +
+#' scale_color_viridis_c() +
#' theme_classic()
#'
#' # Inspect default priors for a joint species model with spatial factors
@@ -209,10 +210,13 @@
#'
#' # Each factor estimates a different nonlinear spatial process, using
#' # 'by = trend' as in other mvgam State-Space models
-#' factor_formula = ~ te(lat, lon, k = 5, by = trend) - 1,
+#' factor_formula = ~ gp(lat, lon, k = 6, by = trend) - 1,
+#' n_lv = 4,
#'
-#' # The data
+#' # The data and grouping variables
#' data = dat,
+#' unit = site,
+#' species = species,
#'
#' # Poisson observations
#' family = poisson())
@@ -228,7 +232,7 @@
#'
#' # Each factor estimates a different nonlinear spatial process, using
#' # 'by = trend' as in other mvgam State-Space models
-#' factor_formula = ~ te(lat, lon, k = 5, by = trend) - 1,
+#' factor_formula = ~ gp(lat, lon, k = 6, by = trend) - 1,
#' n_lv = 4,
#'
#' # Change default priors for fixed effect betas to standard normal
@@ -274,7 +278,7 @@
#' image(post_cors$cor)
#'
#' # Posterior predictive checks and ELPD-LOO can ascertain model fit
-#' pp_check(mod, type = "ecdf_overlay_grouped",
+#' pp_check(mod, type = "pit_ecdf_grouped",
#' group = "species", ndraws = 100)
#' loo(mod)
#'
@@ -296,6 +300,7 @@
#' ggplot(newdata, aes(x = lat, y = lon, col = log_count)) +
#' geom_point(size = 1.5) +
#' facet_wrap(~ species, scales = 'free') +
+#' scale_color_viridis_c() +
#' theme_classic()
#'}
#'@export
@@ -310,7 +315,7 @@ jsdgam = function(formula,
species = series,
share_obs_params = FALSE,
priors,
- n_lv = 1,
+ n_lv = 2,
chains = 4,
burnin = 500,
samples = 500,
diff --git a/R/mvgam.R b/R/mvgam.R
index 22942fbf..fd0378e4 100644
--- a/R/mvgam.R
+++ b/R/mvgam.R
@@ -1441,24 +1441,17 @@ mvgam = function(formula,
# Include any GP term updates
if(!is.null(gp_terms)){
gp_additions <- make_gp_additions(gp_details = gp_details,
+ orig_formula = orig_formula,
data = data_train,
newdata = data_test,
model_data = stan_objects$model_data,
mgcv_model = ss_gam,
gp_terms = gp_terms,
- family = family)
+ family = family,
+ rho_names = rho_names)
stan_objects$model_data <- gp_additions$model_data
ss_gam <- gp_additions$mgcv_model
-
- gp_names <- unlist(purrr::map(gp_additions$gp_att_table, 'name'))
- gp_names <- gsub('gp(', 's(', gp_names, fixed = TRUE)
- rhos_change <- list()
- for(i in seq_along(gp_names)){
- rhos_change[[i]] <- grep(gp_names[i], rho_names, fixed = TRUE)
- }
- rho_names[c(unique(unlist(rhos_change)))] <- gsub('s(', 'gp(',
- rho_names[c(unique(unlist(rhos_change)))],
- fixed = TRUE)
+ rho_names <- gp_additions$rho_names
}
# Vectorise likelihoods
diff --git a/R/plot_mvgam_smooth.R b/R/plot_mvgam_smooth.R
index afc9bd1e..fb19a961 100644
--- a/R/plot_mvgam_smooth.R
+++ b/R/plot_mvgam_smooth.R
@@ -317,9 +317,8 @@ plot_mvgam_smooth = function(object,
if(gp_term){
object2$mgcv_model$smooth[[smooth_int]]$label <-
- gsub('s(', 'gp(',
- object2$mgcv_model$smooth[[smooth_int]]$label,
- fixed = TRUE)
+ gsub('s\\(|ti\\(', 'gp(',
+ object2$mgcv_model$smooth[[smooth_int]]$label)
# Check if this is a factor by variable
is_fac <- is.factor(object2$obs_data[[object2$mgcv_model$smooth[[smooth_int]]$by]])
diff --git a/R/residual_cor.R b/R/residual_cor.R
index 41b05fc7..8cba5512 100644
--- a/R/residual_cor.R
+++ b/R/residual_cor.R
@@ -10,31 +10,29 @@
#' If `TRUE`, the median is used instead. Only used if `summary` is `TRUE`
#' @param ... ignored
#' @return If `summary = TRUE`, a `list` with the following components:
-#' \itemize{
-#' \item{cor, cor_lower, cor_upper}{: A set of \eqn{p \times p} correlation matrices,
+#' \item{cor, cor_lower, cor_upper}{A set of \eqn{p \times p} correlation matrices,
#' containing either the posterior median or mean estimate, plus lower and upper limits
#' of the corresponding credible intervals supplied to `probs`}
-#' \item{sig_cor}{: A \eqn{p \times p} correlation matrix containing only those correlations whose credible
+#' \item{sig_cor}{A \eqn{p \times p} correlation matrix containing only those correlations whose credible
#' interval does not contain zero. All other correlations are set to zero}
-#' \item{prec, prec_lower, prec_upper}{: A set of \eqn{p \times p} precision matrices,
+#' \item{prec, prec_lower, prec_upper}{A set of \eqn{p \times p} precision matrices,
#' containing either the posterior median or mean estimate, plus lower and upper limits
#' of the corresponding credible intervals supplied to `probs`}
-#' \item{sig_prec}{: A \eqn{p \times p} precision matrix containing only those precisions whose credible
+#' \item{sig_prec}{A \eqn{p \times p} precision matrix containing only those precisions whose credible
#' interval does not contain zero. All other precisions are set to zero}
-#' \item{cov}{: A \eqn{p \times p} posterior median or mean covariance matrix}
-#' \item{trace}{: The median/mean point estimator of the trace (sum of the diagonal elements)
+#' \item{cov}{A \eqn{p \times p} posterior median or mean covariance matrix}
+#' \item{trace}{The median/mean point estimator of the trace (sum of the diagonal elements)
#' of the residual covariance matrix `cov`}
-#' }
+#'
#' If `summary = FALSE`, this function returns a `list` containing the following components:
-#' \itemize{
-#' \item{all_cormat}{: A \eqn{n_{draws} \times p \times p} `array` of posterior
+#' \item{all_cormat}{A \eqn{n_{draws} \times p \times p} `array` of posterior
#' residual correlation matrix draws}
-#' \item{all_covmat}{: A \eqn{n_{draws} \times p \times p} `array` of posterior
+#' \item{all_covmat}{A \eqn{n_{draws} \times p \times p} `array` of posterior
#' residual covariance matrix draws}
-#' \item{all_presmat}{: A \eqn{n_{draws} \times p \times p} `array` of posterior
+#' \item{all_presmat}{A \eqn{n_{draws} \times p \times p} `array` of posterior
#' residual precision matrix draws}
-#' \item{all_trace}{: A \eqn{n_{draws}} `vector` of posterior covariance trace draws}
-#' }
+#' \item{all_trace}{A \eqn{n_{draws}} `vector` of posterior covariance trace draws}
+#'
#' @details
#' Hui (2016) provides an excellent description of the quantities that this function calculates, so this passage
#' is heavily paraphrased from his associated `boral` package.
diff --git a/R/stan_utils.R b/R/stan_utils.R
index 0fc64b8e..9de82887 100644
--- a/R/stan_utils.R
+++ b/R/stan_utils.R
@@ -2660,55 +2660,29 @@ add_trend_predictors = function(trend_formula,
any(grepl('k_gp', trend_model_file)) &
any(grepl('z_gp', trend_model_file))){
- # Add spd_cov_exp_quad function from brms code
- if(any(grepl('functions {', model_file, fixed = TRUE))){
- model_file[grep('functions {', model_file, fixed = TRUE)] <-
- paste0('functions {\n',
- '/* Spectral density function of a Gaussian process\n',
- '* with squared exponential covariance kernel\n',
- '* Args:\n',
- '* l_gp: numeric eigenvalues of an SPD GP\n',
- '* alpha_gp: marginal SD parameter\n',
- '* rho_gp: length-scale parameter\n',
- '* Returns:\n',
- '* numeric values of the GP function evaluated at l_gp\n',
- '*/\n',
- 'vector spd_cov_exp_quad(data vector l_gp, real alpha_gp, real rho_gp) {\n',
- 'int NB = size(l_gp);\n',
- 'vector[NB] out;\n',
- 'real constant = square(alpha_gp) * (sqrt(2 * pi()) * rho_gp);\n',
- 'real neg_half_lscale2 = -0.5 * square(rho_gp);\n',
- 'for (m in 1:NB) {\n',
- 'out[m] = constant * exp(neg_half_lscale2 * square(l_gp[m]));\n',
- '}\n',
- 'return out;\n',
- '}\n')
- } else {
- model_file[grep('Stan model code', model_file)] <-
- paste0('// Stan model code generated by package mvgam\n',
- 'functions {\n',
- '/* Spectral density function of a Gaussian process\n',
- '* with squared exponential covariance kernel\n',
- '* Args:\n',
- '* l_gp: numeric eigenvalues of an SPD GP\n',
- '* alpha_gp: marginal SD parameter\n',
- '* rho_gp: length-scale parameter\n',
- '* Returns:\n',
- '* numeric values of the GP function evaluated at l_gp\n',
- '*/\n',
- 'vector spd_cov_exp_quad(data vector l_gp, real alpha_gp, real rho_gp) {\n',
- 'int NB = size(l_gp);\n',
- 'vector[NB] out;\n',
- 'real constant = square(alpha_gp) * (sqrt(2 * pi()) * rho_gp);\n',
- 'real neg_half_lscale2 = -0.5 * square(rho_gp);\n',
- 'for (m in 1:NB) {\n',
- 'out[m] = constant * exp(neg_half_lscale2 * square(l_gp[m]));\n',
- '}\n',
- 'return out;\n',
- '}\n}\n')
+ # Add spd_cov functions
+ if(any(grepl('spd_gp_exp_quad',
+ trend_model_file,
+ fixed = TRUE))){
+ model_file <- add_gp_spd_funs(model_file, kernel = 'exp_quad')
+ }
+ if(any(grepl('spd_gp_exponential',
+ trend_model_file,
+ fixed = TRUE))){
+ model_file <- add_gp_spd_funs(model_file, kernel = 'exponential')
+ }
+ if(any(grepl('spd_gp_matern32',
+ trend_model_file,
+ fixed = TRUE))){
+ model_file <- add_gp_spd_funs(model_file, kernel = 'matern32')
+ }
+ if(any(grepl('spd_gp_matern52',
+ trend_model_file,
+ fixed = TRUE))){
+ model_file <- add_gp_spd_funs(model_file, kernel = 'matern52')
}
- model_file <- readLines(textConnection(model_file), n = -1)
+ # Update gp param names to include 'trend'
trend_model_file <- gsub('l_gp', 'l_gp_trend', trend_model_file)
trend_model_file <- gsub('k_gp', 'k_gp_trend', trend_model_file)
trend_model_file <- gsub('alpha_gp', 'alpha_gp_trend', trend_model_file)
diff --git a/R/summary.mvgam.R b/R/summary.mvgam.R
index 408814c7..9173f4f1 100644
--- a/R/summary.mvgam.R
+++ b/R/summary.mvgam.R
@@ -36,13 +36,15 @@
summary.mvgam = function(object,
include_betas = TRUE,
smooth_test = TRUE,
- digits = 2, ...){
+ digits = 2,
+ ...){
-#### Some adjustments for cleaner summaries ####
+ #### Some adjustments for cleaner summaries ####
if(attr(object$model_data, 'trend_model') == 'None' &
object$use_lv & object$family != 'nmix') attr(object$model_data, 'trend_model') <- 'RW'
+ variational <- object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder')
-#### Smooth tests ####
+ #### Smooth tests ####
if(smooth_test){
if(inherits(object$trend_model, 'mvgam_trend')){
trend_model <- object$trend_model$label
@@ -63,7 +65,7 @@ summary.mvgam = function(object,
}
}
-#### Standard summary of formula and model arguments ####
+ #### Standard summary of formula and model arguments ####
if(!is.null(object$trend_call)){
cat("GAM observation formula:\n")
print(object$call)
@@ -75,122 +77,122 @@ summary.mvgam = function(object,
print(object$call)
}
-cat("\nFamily:\n")
-cat(paste0(object$family, '\n'))
+ cat("\nFamily:\n")
+ cat(paste0(object$family, '\n'))
-cat("\nLink function:\n")
-cat(paste0(family_links(object$family), '\n'))
+ cat("\nLink function:\n")
+ cat(paste0(family_links(object$family), '\n'))
-if(!inherits(object, 'jsdgam')){
- cat("\nTrend model:\n")
- if(inherits(object$trend_model, 'mvgam_trend')){
- print(object$trend_model$label)
- cat('\n')
- } else {
- cat(paste0(object$trend_model, '\n'))
+ if(!inherits(object, 'jsdgam')){
+ cat("\nTrend model:\n")
+ if(inherits(object$trend_model, 'mvgam_trend')){
+ print(object$trend_model$label)
+ cat('\n')
+ } else {
+ cat(paste0(object$trend_model, '\n'))
+ }
}
-}
-if(object$use_lv){
- if(!is.null(object$trend_call)){
- cat("\nN process models:\n")
- cat(object$n_lv, '\n')
- } else {
- cat("\nN latent factors:\n")
- cat(object$n_lv, '\n')
+ if(object$use_lv){
+ if(!is.null(object$trend_call)){
+ cat("\nN process models:\n")
+ cat(object$n_lv, '\n')
+ } else {
+ cat("\nN latent factors:\n")
+ cat(object$n_lv, '\n')
+ }
}
-}
-if(inherits(object, 'jsdgam')){
- cat('\nN species:\n')
- cat(NCOL(object$ytimes), '\n')
-} else {
- cat('\nN series:\n')
- cat(NCOL(object$ytimes), '\n')
-}
+ if(inherits(object, 'jsdgam')){
+ cat('\nN species:\n')
+ cat(NCOL(object$ytimes), '\n')
+ } else {
+ cat('\nN series:\n')
+ cat(NCOL(object$ytimes), '\n')
+ }
-if(!is.null(object$upper_bounds)){
- cat('\nUpper bounds:\n')
- cat(object$upper_bounds, '\n')
-}
+ if(!is.null(object$upper_bounds)){
+ cat('\nUpper bounds:\n')
+ cat(object$upper_bounds, '\n')
+ }
-if(inherits(object, 'jsdgam')){
- cat('\nN sites:\n')
- cat(NROW(object$ytimes), '\n')
-} else {
- cat('\nN timepoints:\n')
- cat(NROW(object$ytimes), '\n')
-}
+ if(inherits(object, 'jsdgam')){
+ cat('\nN sites:\n')
+ cat(NROW(object$ytimes), '\n')
+ } else {
+ cat('\nN timepoints:\n')
+ cat(NROW(object$ytimes), '\n')
+ }
-if(object$fit_engine == 'jags'){
- cat('\nStatus:\n')
- cat('Fitted using JAGS', '\n')
-}
+ if(object$fit_engine == 'jags'){
+ cat('\nStatus:\n')
+ cat('Fitted using JAGS', '\n')
+ }
-if(object$fit_engine == 'stan'){
- cat('\nStatus:\n')
- cat('Fitted using Stan', '\n')
+ if(object$fit_engine == 'stan'){
+ cat('\nStatus:\n')
+ cat('Fitted using Stan', '\n')
- n_kept <- object$model_output@sim$n_save - object$model_output@sim$warmup2
- cat(object$model_output@sim$chains, " chains, each with iter = ",
- object$model_output@sim$iter,
- "; warmup = ", object$model_output@sim$warmup, "; thin = ",
- object$model_output@sim$thin, " \n",
- "Total post-warmup draws = ", sum(n_kept), "\n\n", sep = '')
+ n_kept <- object$model_output@sim$n_save - object$model_output@sim$warmup2
+ cat(object$model_output@sim$chains, " chains, each with iter = ",
+ object$model_output@sim$iter,
+ "; warmup = ", object$model_output@sim$warmup, "; thin = ",
+ object$model_output@sim$thin, " \n",
+ "Total post-warmup draws = ", sum(n_kept), "\n\n", sep = '')
-}
+ }
-if(object$family == 'negative binomial'){
- cat("\nObservation dispersion parameter estimates:\n")
- print(mcmc_summary(object$model_output, 'phi', digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder'))[,c(3:7)])
-}
+ if(object$family == 'negative binomial'){
+ cat("\nObservation dispersion parameter estimates:\n")
+ print(mcmc_summary(object$model_output, 'phi', digits = digits,
+ variational = variational)[,c(3:7)])
+ }
-if(object$family == 'beta_binomial'){
- cat("\nObservation dispersion parameter estimates:\n")
- print(mcmc_summary(object$model_output, 'phi', digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder'))[,c(3:7)])
-}
+ if(object$family == 'beta_binomial'){
+ cat("\nObservation dispersion parameter estimates:\n")
+ print(mcmc_summary(object$model_output, 'phi', digits = digits,
+ variational = variational)[,c(3:7)])
+ }
-if(object$family == 'beta'){
- cat("\nObservation precision parameter estimates:\n")
- print(mcmc_summary(object$model_output, 'phi', digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder'))[,c(3:7)])
-}
+ if(object$family == 'beta'){
+ cat("\nObservation precision parameter estimates:\n")
+ print(mcmc_summary(object$model_output, 'phi', digits = digits,
+ variational = variational)[,c(3:7)])
+ }
-if(object$family == 'tweedie'){
- cat("\nObservation dispersion parameter estimates:\n")
- print(mcmc_summary(object$model_output, 'phi', digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder'))[,c(3:7)])
-}
+ if(object$family == 'tweedie'){
+ cat("\nObservation dispersion parameter estimates:\n")
+ print(mcmc_summary(object$model_output, 'phi', digits = digits,
+ variational = variational)[,c(3:7)])
+ }
-if(object$family == 'gaussian'){
- cat("\nObservation error parameter estimates:\n")
- print(mcmc_summary(object$model_output, 'sigma_obs', digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder'))[,c(3:7)])
-}
+ if(object$family == 'gaussian'){
+ cat("\nObservation error parameter estimates:\n")
+ print(mcmc_summary(object$model_output, 'sigma_obs', digits = digits,
+ variational = variational)[,c(3:7)])
+ }
-if(object$family == 'student'){
- cat("\nObservation error parameter estimates:\n")
- print(mcmc_summary(object$model_output, 'sigma_obs', digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder'))[,c(3:7)])
+ if(object$family == 'student'){
+ cat("\nObservation error parameter estimates:\n")
+ print(mcmc_summary(object$model_output, 'sigma_obs', digits = digits,
+ variational = variational)[,c(3:7)])
- cat("\nObservation df parameter estimates:\n")
- print(mcmc_summary(object$model_output, 'nu', digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder'))[,c(3:7)])
-}
+ cat("\nObservation df parameter estimates:\n")
+ print(mcmc_summary(object$model_output, 'nu', digits = digits,
+ variational = variational)[,c(3:7)])
+ }
-if(object$family == 'lognormal'){
- cat("\nlog(observation error) parameter estimates:\n")
- print(mcmc_summary(object$model_output, 'sigma_obs', digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder'))[,c(3:7)])
-}
+ if(object$family == 'lognormal'){
+ cat("\nlog(observation error) parameter estimates:\n")
+ print(mcmc_summary(object$model_output, 'sigma_obs', digits = digits,
+ variational = variational)[,c(3:7)])
+ }
-if(object$family == 'Gamma'){
- cat("\nObservation shape parameter estimates:\n")
- print(mcmc_summary(object$model_output, 'shape', digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder'))[,c(3:7)])
-}
+ if(object$family == 'Gamma'){
+ cat("\nObservation shape parameter estimates:\n")
+ print(mcmc_summary(object$model_output, 'shape', digits = digits,
+ variational = variational)[,c(3:7)])
+ }
if(!is.null(object$trend_call)){
if(include_betas){
@@ -198,8 +200,7 @@ if(object$family == 'Gamma'){
coef_names <- names(object$mgcv_model$coefficients)
mvgam_coefs <- mcmc_summary(object$model_output, 'b',
digits = digits,
- variational = object$algorithm %in% c('fullrank',
- 'meanfield'))[,c(3:7)]
+ variational = variational)[,c(3:7)]
rownames(mvgam_coefs) <- coef_names
print(mvgam_coefs)
@@ -211,8 +212,7 @@ if(object$family == 'Gamma'){
coef_names <- names(object$mgcv_model$coefficients)[coefs_keep]
mvgam_coefs <- mcmc_summary(object$model_output, 'b',
digits = digits,
- variational = object$algorithm %in% c('fullrank',
- 'meanfield'))[coefs_keep,c(3:7)]
+ variational = variational)[coefs_keep,c(3:7)]
rownames(mvgam_coefs) <- coef_names
print(mvgam_coefs)
}
@@ -224,8 +224,7 @@ if(object$family == 'Gamma'){
coef_names <- names(object$mgcv_model$coefficients)
mvgam_coefs <- mcmc_summary(object$model_output, 'b',
digits = digits,
- variational = object$algorithm %in% c('fullrank',
- 'meanfield'))[,c(3:7)]
+ variational = variational)[,c(3:7)]
rownames(mvgam_coefs) <- coef_names
print(mvgam_coefs)
} else {
@@ -235,84 +234,86 @@ if(object$family == 'Gamma'){
coef_names <- names(object$mgcv_model$coefficients)[coefs_keep]
mvgam_coefs <- mcmc_summary(object$model_output, 'b',
digits = digits,
- variational = object$algorithm %in% c('fullrank',
- 'meanfield'))[coefs_keep,c(3:7)]
+ variational = variational)[coefs_keep,c(3:7)]
rownames(mvgam_coefs) <- coef_names
print(mvgam_coefs)
}
}
}
-if(all(is.na(object$sp_names))){
+ if(all(is.na(object$sp_names))){
-} else {
- if(any(unlist(purrr::map(object$mgcv_model$smooth, inherits, 'random.effect')))){
- re_labs <- unlist(lapply(purrr::map(object$mgcv_model$smooth, 'label'),
- paste, collapse = ','))[
- unlist(purrr::map(object$mgcv_model$smooth, inherits, 'random.effect'))]
- re_sds <- mcmc_summary(object$model_output, 'sigma_raw',
- ISB = TRUE, digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder'))[,c(3:7)]
+ } else {
+ if(any(unlist(purrr::map(object$mgcv_model$smooth, inherits, 'random.effect')))){
+ re_labs <- unlist(lapply(purrr::map(object$mgcv_model$smooth, 'label'),
+ paste, collapse = ','))[
+ unlist(purrr::map(object$mgcv_model$smooth, inherits, 'random.effect'))]
+ re_sds <- mcmc_summary(object$model_output, 'sigma_raw',
+ ISB = TRUE, digits = digits,
+ variational = variational)[,c(3:7)]
- re_mus <- mcmc_summary(object$model_output, 'mu_raw',
- ISB = TRUE, digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder'))[,c(3:7)]
+ re_mus <- mcmc_summary(object$model_output, 'mu_raw',
+ ISB = TRUE, digits = digits,
+ variational = variational)[,c(3:7)]
- rownames(re_sds) <- paste0('sd(',re_labs,')')
- rownames(re_mus) <- paste0('mean(',re_labs,')')
+ rownames(re_sds) <- paste0('sd(',re_labs,')')
+ rownames(re_mus) <- paste0('mean(',re_labs,')')
- if(!is.null(object$trend_call)){
- cat("\nGAM observation model group-level estimates:\n")
- } else {
- cat("\nGAM group-level estimates:\n")
+ if(!is.null(object$trend_call)){
+ cat("\nGAM observation model group-level estimates:\n")
+ } else {
+ cat("\nGAM group-level estimates:\n")
+ }
+ print(rbind(re_mus, re_sds))
}
- print(rbind(re_mus, re_sds))
}
-}
-
-if(!is.null(attr(object$mgcv_model, 'gp_att_table'))){
- gp_names <- unlist(purrr::map(attr(object$mgcv_model, 'gp_att_table'), 'name'))
- alpha_params <- gsub(':', 'by', gsub(')', '_',
- gsub('(', '_', paste0('alpha_', gp_names),
- fixed = TRUE), fixed = TRUE))
- alpha_summary <- mcmc_summary(object$model_output, alpha_params,
- ISB = TRUE, digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder'))[,c(3:7)]
-
- rownames(alpha_summary) <- paste0('alpha_', gp_names)
- rho_params <- gsub(':', 'by', gsub(')', '_',
- gsub('(', '_', paste0('rho_', gp_names),
- fixed = TRUE), fixed = TRUE))
- rho_summary <- mcmc_summary(object$model_output, rho_params,
- ISB = TRUE, digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder'))[,c(3:7)]
- rownames(rho_summary) <- paste0('rho_', gp_names)
+ if(!is.null(attr(object$mgcv_model, 'gp_att_table'))){
+ gp_summaries <- gp_param_summary(object = object,
+ mgcv_model = object$mgcv_model,
+ digits = digits,
+ variational = variational)
- if(!is.null(object$trend_call)){
- cat("\nGAM observation model gp term marginal deviation (alpha) and length scale (rho) estimates:\n")
- } else {
- cat("\nGAM gp term marginal deviation (alpha) and length scale (rho) estimates:\n")
+ if(!is.null(object$trend_call)){
+ cat("\nGAM observation model gp term marginal deviation (alpha) and length scale (rho) estimates:\n")
+ } else {
+ cat("\nGAM gp term marginal deviation (alpha) and length scale (rho) estimates:\n")
+ }
+ print(rbind(gp_summaries$alpha_summary, gp_summaries$rho_summary))
}
- print(rbind(alpha_summary, rho_summary))
-}
-if(any(!is.na(object$sp_names)) & smooth_test){
- gam_sig_table <- try(suppressWarnings(summary(object$mgcv_model)$s.table[, c(1,2,3,4), drop = FALSE]), silent = TRUE)
- if(inherits(gam_sig_table, 'try-error')){
- object$mgcv_model$R <- NULL
- gam_sig_table <- suppressWarnings(summary(object$mgcv_model)$s.table[, c(1,2,3,4), drop = FALSE])
- gam_sig_table[,2] <- unlist(purrr::map(object$mgcv_model$smooth, 'df'), use.names = FALSE)
- }
- if(!is.null(attr(object$mgcv_model, 'gp_att_table'))){
- gp_names <- unlist(purrr::map(attr(object$mgcv_model,
- 'gp_att_table'), 'name'))
- if(all(rownames(gam_sig_table) %in% gsub('gp(', 's(', gp_names, fixed = TRUE))){
+ if(any(!is.na(object$sp_names)) & smooth_test){
+ gam_sig_table <- try(suppressWarnings(summary(object$mgcv_model)$s.table[, c(1,2,3,4),
+ drop = FALSE]),
+ silent = TRUE)
+ if(inherits(gam_sig_table, 'try-error')){
+ object$mgcv_model$R <- NULL
+ gam_sig_table <- suppressWarnings(summary(object$mgcv_model)$s.table[, c(1,2,3,4),
+ drop = FALSE])
+ gam_sig_table[,2] <- unlist(purrr::map(object$mgcv_model$smooth, 'df'),
+ use.names = FALSE)
+ }
+ if(!is.null(attr(object$mgcv_model, 'gp_att_table'))){
+ gp_names <- unlist(purrr::map(attr(object$mgcv_model,
+ 'gp_att_table'), 'name'))
+ if(all(rownames(gam_sig_table) %in% gsub('gp(', 's(', gp_names, fixed = TRUE))){
- } else {
- gam_sig_table <- gam_sig_table[!rownames(gam_sig_table) %in%
- gsub('gp(', 's(', gp_names, fixed = TRUE),,drop = FALSE]
+ } else {
+ gam_sig_table <- gam_sig_table[!rownames(gam_sig_table) %in%
+ gsub('gp(', 's(', gp_names, fixed = TRUE),,drop = FALSE]
+ if(!is.null(object$trend_call)){
+ cat("\nApproximate significance of GAM observation smooths:\n")
+ } else {
+ cat("\nApproximate significance of GAM smooths:\n")
+ }
+ suppressWarnings(printCoefmat(gam_sig_table,
+ digits = min(3, digits + 1),
+ signif.stars = getOption("show.signif.stars"),
+ has.Pvalue = TRUE, na.print = "NA",
+ cs.ind = 1))
+ }
+ } else {
if(!is.null(object$trend_call)){
cat("\nApproximate significance of GAM observation smooths:\n")
} else {
@@ -323,438 +324,414 @@ if(any(!is.na(object$sp_names)) & smooth_test){
signif.stars = getOption("show.signif.stars"),
has.Pvalue = TRUE, na.print = "NA",
cs.ind = 1))
- }
- } else {
- if(!is.null(object$trend_call)){
- cat("\nApproximate significance of GAM observation smooths:\n")
- } else {
- cat("\nApproximate significance of GAM smooths:\n")
}
- suppressWarnings(printCoefmat(gam_sig_table,
- digits = min(3, digits + 1),
- signif.stars = getOption("show.signif.stars"),
- has.Pvalue = TRUE, na.print = "NA",
- cs.ind = 1))
}
-}
-if(object$use_lv){
- if(attr(object$model_data, 'trend_model') != 'None'){
- if(attr(object$model_data, 'trend_model') == 'RW'){
- if(object$drift){
- if(!is.null(object$trend_call)){
- cat("\nProcess model drift estimates:\n")
+ if(object$use_lv){
+ if(attr(object$model_data, 'trend_model') != 'None'){
+ if(attr(object$model_data, 'trend_model') == 'RW'){
+ if(object$drift){
+ if(!is.null(object$trend_call)){
+ cat("\nProcess model drift estimates:\n")
+ } else {
+ cat("\nLatent trend drift estimates:\n")
+ }
+ print(suppressWarnings(mcmc_summary(object$model_output, c('drift', 'theta'),
+ digits = digits,
+ variational = variational))[,c(3:7)])
} else {
- cat("\nLatent trend drift estimates:\n")
+ if(!is.null(object$trend_call)){
+ if(inherits(object$trend_model, 'mvgam_trend')){
+ trend_model <- object$trend_model$trend_model
+ } else {
+ trend_model <- object$trend_model
+ }
+ if(trend_model == 'None' & object$family == 'nmix' | inherits(object, 'jsdgam')){
+
+ } else {
+ cat("\nProcess error parameter estimates:\n")
+ print(suppressWarnings(mcmc_summary(object$model_output, c('sigma', 'theta'),
+ digits = digits,
+ variational = variational))[,c(3:7)])
+
+ }
+ }
}
- print(suppressWarnings(mcmc_summary(object$model_output, c('drift', 'theta'),
+ }
+
+ if(attr(object$model_data, 'trend_model') == 'GP'){
+ cat("\nLatent trend length scale (rho) estimates:\n")
+ print(mcmc_summary(object$model_output, c('rho_gp'),
digits = digits,
- variational = object$algorithm %in% c('fullrank',
- 'meanfield',
- 'laplace',
- 'pathfinder')))[,c(3:7)])
- } else {
- if(!is.null(object$trend_call)){
- if(inherits(object$trend_model, 'mvgam_trend')){
- trend_model <- object$trend_model$trend_model
+ variational = variational)[,c(3:7)])
+ }
+
+ if(attr(object$model_data, 'trend_model') %in% c('AR1', 'CAR1')){
+ if(object$drift){
+ if(!is.null(object$trend_call)){
+ cat("\nProcess model drift and AR parameter estimates:\n")
+ print(mcmc_summary(object$model_output, c('drift', 'ar1'),
+ digits = digits,
+ variational = variational)[,c(3:7)])
} else {
- trend_model <- object$trend_model
+ cat("\nLatent trend drift and AR parameter estimates:\n")
+ print(mcmc_summary(object$model_output, c('drift', 'ar1'),
+ digits = digits,
+ variational = variational)[,c(3:7)])
}
- if(trend_model == 'None' & object$family == 'nmix' | inherits(object, 'jsdgam')){
+ } else {
+ if(!is.null(object$trend_call)){
+ cat("\nProcess model AR parameter estimates:\n")
+ print(mcmc_summary(object$model_output, c('ar1'),
+ digits = digits,
+ variational = variational)[,c(3:7)])
} else {
- cat("\nProcess error parameter estimates:\n")
- print(suppressWarnings(mcmc_summary(object$model_output, c('sigma', 'theta'),
- digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder')))[,c(3:7)])
-
+ cat("\nLatent trend AR parameter estimates:\n")
+ print(mcmc_summary(object$model_output, c('ar1'),
+ digits = digits,
+ variational = variational)[,c(3:7)])
}
- }
- }
- }
-
- if(attr(object$model_data, 'trend_model') == 'GP'){
- cat("\nLatent trend length scale (rho) estimates:\n")
- print(mcmc_summary(object$model_output, c('rho_gp'),
- digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder'))[,c(3:7)])
- }
- if(attr(object$model_data, 'trend_model') %in% c('AR1', 'CAR1')){
- if(object$drift){
- if(!is.null(object$trend_call)){
- cat("\nProcess model drift and AR parameter estimates:\n")
- print(mcmc_summary(object$model_output, c('drift', 'ar1'),
- digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder'))[,c(3:7)])
- } else {
- cat("\nLatent trend drift and AR parameter estimates:\n")
- print(mcmc_summary(object$model_output, c('drift', 'ar1'),
- digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder'))[,c(3:7)])
}
- } else {
if(!is.null(object$trend_call)){
- cat("\nProcess model AR parameter estimates:\n")
- print(mcmc_summary(object$model_output, c('ar1'),
- digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder'))[,c(3:7)])
- } else {
- cat("\nLatent trend AR parameter estimates:\n")
- print(mcmc_summary(object$model_output, c('ar1'),
- digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder'))[,c(3:7)])
- }
+ cat("\nProcess error parameter estimates:\n")
+ print(suppressWarnings(mcmc_summary(object$model_output, c('sigma', 'theta'),
+ digits = digits,
+ variational = variational))[,c(3:7)])
+ }
}
- if(!is.null(object$trend_call)){
- cat("\nProcess error parameter estimates:\n")
- print(suppressWarnings(mcmc_summary(object$model_output, c('sigma', 'theta'),
- digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder')))[,c(3:7)])
+ if(attr(object$model_data, 'trend_model') == 'AR2'){
+ if(object$drift){
+ if(!is.null(object$trend_call)){
+ cat("\nProcess model drift and AR parameter estimates:\n")
+ print(mcmc_summary(object$model_output, c('drift', 'ar1', 'ar2'),
+ digits = digits,
+ variational = variational)[,c(3:7)])
- }
- }
+ } else {
+ cat("\nLatent trend drift and AR parameter estimates:\n")
+ print(mcmc_summary(object$model_output, c('drift', 'ar1', 'ar2'),
+ digits = digits,
+ variational = variational)[,c(3:7)])
- if(attr(object$model_data, 'trend_model') == 'AR2'){
- if(object$drift){
- if(!is.null(object$trend_call)){
- cat("\nProcess model drift and AR parameter estimates:\n")
- print(mcmc_summary(object$model_output, c('drift', 'ar1', 'ar2'),
- digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder'))[,c(3:7)])
+ }
} else {
- cat("\nLatent trend drift and AR parameter estimates:\n")
- print(mcmc_summary(object$model_output, c('drift', 'ar1', 'ar2'),
- digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder'))[,c(3:7)])
+ if(!is.null(object$trend_call)){
+ cat("\nProcess model AR parameter estimates:\n")
+ print(mcmc_summary(object$model_output, c('ar1', 'ar2'),
+ digits = digits,
+ variational = variational)[,c(3:7)])
+
+ } else {
+ cat("\nLatent trend AR parameter estimates:\n")
+ print(mcmc_summary(object$model_output, c('ar1', 'ar2'),
+ digits = digits,
+ variational = variational)[,c(3:7)])
+
+ }
}
- } else {
if(!is.null(object$trend_call)){
- cat("\nProcess model AR parameter estimates:\n")
- print(mcmc_summary(object$model_output, c('ar1', 'ar2'),
- digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder'))[,c(3:7)])
-
- } else {
- cat("\nLatent trend AR parameter estimates:\n")
- print(mcmc_summary(object$model_output, c('ar1', 'ar2'),
- digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder'))[,c(3:7)])
+ cat("\nProcess error parameter estimates:\n")
+ print(suppressWarnings(mcmc_summary(object$model_output, c('sigma', 'theta'),
+ digits = digits,
+ variational = variational))[,c(3:7)])
}
-
}
- if(!is.null(object$trend_call)){
- cat("\nProcess error parameter estimates:\n")
- print(suppressWarnings(mcmc_summary(object$model_output, c('sigma', 'theta'),
- digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder')))[,c(3:7)])
+ if(attr(object$model_data, 'trend_model') == 'AR3'){
+ if(object$drift){
+ if(!is.null(object$trend_call)){
+ cat("\nProcess model drift and AR parameter estimates:\n")
+ print(mcmc_summary(object$model_output, c('drift', 'ar1', 'ar2', 'ar3'),
+ digits = digits,
+ variational = variational)[,c(3:7)])
- }
- }
+ } else {
+ cat("\nLatent trend drift and AR parameter estimates:\n")
+ print(mcmc_summary(object$model_output, c('drift', 'ar1', 'ar2', 'ar3'),
+ digits = digits,
+ variational = variational)[,c(3:7)])
- if(attr(object$model_data, 'trend_model') == 'AR3'){
- if(object$drift){
- if(!is.null(object$trend_call)){
- cat("\nProcess model drift and AR parameter estimates:\n")
- print(mcmc_summary(object$model_output, c('drift', 'ar1', 'ar2', 'ar3'),
- digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder'))[,c(3:7)])
+ }
} else {
- cat("\nLatent trend drift and AR parameter estimates:\n")
- print(mcmc_summary(object$model_output, c('drift', 'ar1', 'ar2', 'ar3'),
- digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder'))[,c(3:7)])
+ if(!is.null(object$trend_call)){
+ cat("\nProcess model AR parameter estimates:\n")
+ print(mcmc_summary(object$model_output, c('ar1', 'ar2', 'ar3'),
+ digits = digits,
+ variational = variational)[,c(3:7)])
+
+ } else {
+ cat("\nLatent trend AR parameter estimates:\n")
+ print(mcmc_summary(object$model_output, c('ar1', 'ar2', 'ar3'),
+ digits = digits,
+ variational = variational)[,c(3:7)])
+
+ }
}
- } else {
if(!is.null(object$trend_call)){
- cat("\nProcess model AR parameter estimates:\n")
- print(mcmc_summary(object$model_output, c('ar1', 'ar2', 'ar3'),
- digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder'))[,c(3:7)])
-
- } else {
- cat("\nLatent trend AR parameter estimates:\n")
- print(mcmc_summary(object$model_output, c('ar1', 'ar2', 'ar3'),
- digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder'))[,c(3:7)])
+ cat("\nProcess error parameter estimates:\n")
+ print(suppressWarnings(mcmc_summary(object$model_output, c('sigma', 'theta'),
+ digits = digits,
+ variational = variational))[,c(3:7)])
}
-
}
- if(!is.null(object$trend_call)){
- cat("\nProcess error parameter estimates:\n")
- print(suppressWarnings(mcmc_summary(object$model_output, c('sigma', 'theta'),
- digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder')))[,c(3:7)])
+ if(attr(object$model_data, 'trend_model') == 'VAR1'){
+ if(object$drift){
+ if(!is.null(object$trend_call)){
+ cat("\nProcess model drift and VAR parameter estimates:\n")
+ print(mcmc_summary(object$model_output, c('drift', 'A'),
+ digits = digits,
+ variational = variational)[,c(3:7)])
- }
- }
+ } else {
+ cat("\nLatent trend drift and VAR parameter estimates:\n")
+ print(mcmc_summary(object$model_output, c('drift', 'A'),
+ digits = digits,
+ variational = variational)[,c(3:7)])
- if(attr(object$model_data, 'trend_model') == 'VAR1'){
- if(object$drift){
- if(!is.null(object$trend_call)){
- cat("\nProcess model drift and VAR parameter estimates:\n")
- print(mcmc_summary(object$model_output, c('drift', 'A'),
- digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder'))[,c(3:7)])
+ }
} else {
- cat("\nLatent trend drift and VAR parameter estimates:\n")
- print(mcmc_summary(object$model_output, c('drift', 'A'),
- digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder'))[,c(3:7)])
+ if(!is.null(object$trend_call)){
+ cat("\nProcess model VAR parameter estimates:\n")
+ print(mcmc_summary(object$model_output, c('A'),
+ digits = digits,
+ variational = variational)[,c(3:7)])
+
+ } else {
+ cat("\nLatent trend VAR parameter estimates:\n")
+ print(mcmc_summary(object$model_output, c('A'),
+ digits = digits,
+ variational = variational)[,c(3:7)])
+
+ }
}
- } else {
if(!is.null(object$trend_call)){
- cat("\nProcess model VAR parameter estimates:\n")
- print(mcmc_summary(object$model_output, c('A'),
- digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder'))[,c(3:7)])
-
- } else {
- cat("\nLatent trend VAR parameter estimates:\n")
- print(mcmc_summary(object$model_output, c('A'),
- digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder'))[,c(3:7)])
+ cat("\nProcess error parameter estimates:\n")
+ print(suppressWarnings(mcmc_summary(object$model_output, c('Sigma', 'theta'),
+ digits = digits,
+ variational = variational))[,c(3:7)])
}
-
}
+ }
+ }
- if(!is.null(object$trend_call)){
- cat("\nProcess error parameter estimates:\n")
- print(suppressWarnings(mcmc_summary(object$model_output, c('Sigma', 'theta'),
+ if(!object$use_lv){
+ if(attr(object$model_data, 'trend_model') != 'None'){
+ if(attr(object$model_data, 'trend_model') %in% c('PWlinear', 'PWlogistic')){
+ cat("\nLatent trend growth rate estimates:\n")
+ print(suppressWarnings(mcmc_summary(object$model_output, c('k_trend'),
digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder')))[,c(3:7)])
+ variational = variational))[,c(3:7)])
+ cat("\nLatent trend offset estimates:\n")
+ print(suppressWarnings(mcmc_summary(object$model_output, c('m_trend'),
+ digits = digits,
+ variational = variational))[,c(3:7)])
}
- }
- }
-}
-if(!object$use_lv){
- if(attr(object$model_data, 'trend_model') != 'None'){
- if(attr(object$model_data, 'trend_model') %in% c('PWlinear', 'PWlogistic')){
- cat("\nLatent trend growth rate estimates:\n")
- print(suppressWarnings(mcmc_summary(object$model_output, c('k_trend'),
- digits = digits,
- variational = object$algorithm %in%
- c('fullrank', 'meanfield')))[,c(3:7)])
-
- cat("\nLatent trend offset estimates:\n")
- print(suppressWarnings(mcmc_summary(object$model_output, c('m_trend'),
- digits = digits,
- variational = object$algorithm %in%
- c('fullrank', 'meanfield')))[,c(3:7)])
- }
-
- if(attr(object$model_data, 'trend_model') == 'RW'){
- if(object$drift){
- cat("\nLatent trend drift and sigma estimates:\n")
- print(suppressWarnings(mcmc_summary(object$model_output, c('drift', 'sigma', 'theta'),
- digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder')))[,c(3:7)])
+ if(attr(object$model_data, 'trend_model') == 'RW'){
+ if(object$drift){
+ cat("\nLatent trend drift and sigma estimates:\n")
+ print(suppressWarnings(mcmc_summary(object$model_output, c('drift', 'sigma', 'theta'),
+ digits = digits,
+ variational = variational))[,c(3:7)])
- } else {
- cat("\nLatent trend variance estimates:\n")
- print(suppressWarnings(mcmc_summary(object$model_output, c('sigma', 'theta'),
- digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder')))[,c(3:7)])
+ } else {
+ cat("\nLatent trend variance estimates:\n")
+ print(suppressWarnings(mcmc_summary(object$model_output, c('sigma', 'theta'),
+ digits = digits,
+ variational = variational))[,c(3:7)])
+ }
}
- }
- if(attr(object$model_data, 'trend_model') == 'VAR1'){
- if(object$drift){
- cat("\nLatent trend drift and VAR parameter estimates:\n")
- print(suppressWarnings(mcmc_summary(object$model_output, c('drift', 'A', 'Sigma', 'theta'),
- digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder')))[,c(3:7)])
+ if(attr(object$model_data, 'trend_model') == 'VAR1'){
+ if(object$drift){
+ cat("\nLatent trend drift and VAR parameter estimates:\n")
+ print(suppressWarnings(mcmc_summary(object$model_output, c('drift', 'A', 'Sigma', 'theta'),
+ digits = digits,
+ variational = variational))[,c(3:7)])
- } else {
- cat("\nLatent trend VAR parameter estimates:\n")
- print(suppressWarnings(mcmc_summary(object$model_output, c('A', 'Sigma', 'theta'),
- digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder')))[,c(3:7)])
+ } else {
+ cat("\nLatent trend VAR parameter estimates:\n")
+ print(suppressWarnings(mcmc_summary(object$model_output, c('A', 'Sigma', 'theta'),
+ digits = digits,
+ variational = variational))[,c(3:7)])
+ }
}
- }
- if(attr(object$model_data, 'trend_model') %in% c('AR1', 'CAR1')){
- if(object$drift){
- cat("\nLatent trend drift and AR parameter estimates:\n")
- print(suppressWarnings(mcmc_summary(object$model_output, c('drift', 'ar1', 'sigma', 'theta'),
- digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder')))[,c(3:7)])
+ if(attr(object$model_data, 'trend_model') %in% c('AR1', 'CAR1')){
+ if(object$drift){
+ cat("\nLatent trend drift and AR parameter estimates:\n")
+ print(suppressWarnings(mcmc_summary(object$model_output, c('drift', 'ar1', 'sigma', 'theta'),
+ digits = digits,
+ variational = variational))[,c(3:7)])
- } else {
- cat("\nLatent trend parameter AR estimates:\n")
- print(suppressWarnings(mcmc_summary(object$model_output, c('ar1', 'sigma', 'theta'),
- digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder')))[,c(3:7)])
+ } else {
+ cat("\nLatent trend parameter AR estimates:\n")
+ print(suppressWarnings(mcmc_summary(object$model_output, c('ar1', 'sigma', 'theta'),
+ digits = digits,
+ variational = variational))[,c(3:7)])
+ }
}
- }
- if(attr(object$model_data, 'trend_model') == 'AR2'){
- if(object$drift){
- cat("\nLatent trend drift and AR parameter estimates:\n")
- print(suppressWarnings(mcmc_summary(object$model_output, c('drift', 'ar1', 'ar2', 'sigma', 'theta'),
- digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder')))[,c(3:7)])
+ if(attr(object$model_data, 'trend_model') == 'AR2'){
+ if(object$drift){
+ cat("\nLatent trend drift and AR parameter estimates:\n")
+ print(suppressWarnings(mcmc_summary(object$model_output, c('drift', 'ar1', 'ar2', 'sigma', 'theta'),
+ digits = digits,
+ variational = variational))[,c(3:7)])
- } else {
- cat("\nLatent trend AR parameter estimates:\n")
- print(suppressWarnings(mcmc_summary(object$model_output, c('ar1', 'ar2', 'sigma', 'theta'),
- digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder')))[,c(3:7)])
+ } else {
+ cat("\nLatent trend AR parameter estimates:\n")
+ print(suppressWarnings(mcmc_summary(object$model_output, c('ar1', 'ar2', 'sigma', 'theta'),
+ digits = digits,
+ variational = variational))[,c(3:7)])
+ }
}
- }
- if(attr(object$model_data, 'trend_model') == 'AR3'){
- if(object$drift){
- cat("\nLatent trend drift and AR parameter estimates:\n")
- print(suppressWarnings(mcmc_summary(object$model_output, c('drift', 'ar1',
- 'ar2', 'ar3', 'sigma', 'theta'),
- digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder')))[,c(3:7)])
+ if(attr(object$model_data, 'trend_model') == 'AR3'){
+ if(object$drift){
+ cat("\nLatent trend drift and AR parameter estimates:\n")
+ print(suppressWarnings(mcmc_summary(object$model_output, c('drift', 'ar1',
+ 'ar2', 'ar3', 'sigma', 'theta'),
+ digits = digits,
+ variational = variational))[,c(3:7)])
- } else {
- cat("\nLatent trend AR parameter estimates:\n")
- print(suppressWarnings(mcmc_summary(object$model_output, c('ar1', 'ar2',
- 'ar3', 'sigma', 'theta'),
- digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder')))[,c(3:7)])
+ } else {
+ cat("\nLatent trend AR parameter estimates:\n")
+ print(suppressWarnings(mcmc_summary(object$model_output, c('ar1', 'ar2',
+ 'ar3', 'sigma', 'theta'),
+ digits = digits,
+ variational = variational))[,c(3:7)])
+ }
}
- }
- if(attr(object$model_data, 'trend_model') == 'GP'){
+ if(attr(object$model_data, 'trend_model') == 'GP'){
cat("\nLatent trend marginal deviation (alpha) and length scale (rho) estimates:\n")
print(suppressWarnings(mcmc_summary(object$model_output, c('alpha_gp', 'rho_gp'),
- digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder')))[,c(3:7)])
+ digits = digits,
+ variational = variational))[,c(3:7)])
+ }
}
}
-}
-if(grepl('hiercor', validate_trend_model(object$trend_model))){
- cat("\nHierarchical correlation weighting parameter (alpha_cor) estimates:\n")
- print(suppressWarnings(mcmc_summary(object$model_output, 'alpha_cor',
- digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder')))[,c(3:7)])
+ if(grepl('hiercor', validate_trend_model(object$trend_model))){
+ cat("\nHierarchical correlation weighting parameter (alpha_cor) estimates:\n")
+ print(suppressWarnings(mcmc_summary(object$model_output, 'alpha_cor',
+ digits = digits,
+ variational = variational))[,c(3:7)])
-}
+ }
-if(!is.null(object$trend_call) & !inherits(object, 'jsdgam')){
- if(include_betas){
- cat("\nGAM process model coefficient (beta) estimates:\n")
- coef_names <- paste0(names(object$trend_mgcv_model$coefficients), '_trend')
- mvgam_coefs <- mcmc_summary(object$model_output, 'b_trend',
- digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder'))[,c(3:7)]
- rownames(mvgam_coefs) <- gsub('series', 'trend',
- coef_names, fixed = TRUE)
- print(mvgam_coefs)
- } else {
- if(object$trend_mgcv_model$nsdf > 0){
- coefs_include <- 1:object$trend_mgcv_model$nsdf
+ if(!is.null(object$trend_call) & !inherits(object, 'jsdgam')){
+ if(include_betas){
cat("\nGAM process model coefficient (beta) estimates:\n")
- coef_names <- paste0(names(object$trend_mgcv_model$coefficients), '_trend')[coefs_include]
+ coef_names <- paste0(names(object$trend_mgcv_model$coefficients), '_trend')
mvgam_coefs <- mcmc_summary(object$model_output, 'b_trend',
digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder'))[coefs_include,c(3:7)]
+ variational = variational)[,c(3:7)]
rownames(mvgam_coefs) <- gsub('series', 'trend',
coef_names, fixed = TRUE)
print(mvgam_coefs)
+ } else {
+ if(object$trend_mgcv_model$nsdf > 0){
+ coefs_include <- 1:object$trend_mgcv_model$nsdf
+ cat("\nGAM process model coefficient (beta) estimates:\n")
+ coef_names <- paste0(names(object$trend_mgcv_model$coefficients), '_trend')[coefs_include]
+ mvgam_coefs <- mcmc_summary(object$model_output, 'b_trend',
+ digits = digits,
+ variational = variational)[coefs_include,c(3:7)]
+ rownames(mvgam_coefs) <- gsub('series', 'trend',
+ coef_names, fixed = TRUE)
+ print(mvgam_coefs)
+ }
}
- }
-
- if(all(is.na(object$trend_sp_names))){
-
- } else {
- if(any(unlist(purrr::map(object$trend_mgcv_model$smooth, inherits, 'random.effect')))){
- re_labs <- unlist(lapply(purrr::map(object$trend_mgcv_model$smooth, 'label'),
- paste, collapse = ','))[
- unlist(purrr::map(object$trend_mgcv_model$smooth, inherits, 'random.effect'))]
- re_labs <- gsub('series', 'trend', re_labs)
- re_sds <- mcmc_summary(object$model_output, 'sigma_raw_trend',
- ISB = TRUE, digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder'))[,c(3:7)]
- re_mus <- mcmc_summary(object$model_output, 'mu_raw_trend',
- ISB = TRUE, digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder'))[,c(3:7)]
-
- rownames(re_sds) <- paste0('sd(',re_labs,')_trend')
- rownames(re_mus) <- paste0('mean(',re_labs,')_trend')
+ if(all(is.na(object$trend_sp_names))){
- cat("\nGAM process model group-level estimates:\n")
- print(rbind(re_mus, re_sds))
+ } else {
+ if(any(unlist(purrr::map(object$trend_mgcv_model$smooth, inherits, 'random.effect')))){
+ re_labs <- unlist(lapply(purrr::map(object$trend_mgcv_model$smooth, 'label'),
+ paste, collapse = ','))[
+ unlist(purrr::map(object$trend_mgcv_model$smooth, inherits, 'random.effect'))]
+ re_labs <- gsub('series', 'trend', re_labs)
+ re_sds <- mcmc_summary(object$model_output, 'sigma_raw_trend',
+ ISB = TRUE, digits = digits,
+ variational = variational)[,c(3:7)]
+
+ re_mus <- mcmc_summary(object$model_output, 'mu_raw_trend',
+ ISB = TRUE, digits = digits,
+ variational = variational)[,c(3:7)]
+
+ rownames(re_sds) <- paste0('sd(',re_labs,')_trend')
+ rownames(re_mus) <- paste0('mean(',re_labs,')_trend')
+
+ cat("\nGAM process model group-level estimates:\n")
+ print(rbind(re_mus, re_sds))
+ }
}
- }
-
- if(!is.null(attr(object$trend_mgcv_model, 'gp_att_table'))){
- gp_names <- clean_gpnames(unlist(purrr::map(attr(object$trend_mgcv_model,
- 'gp_att_table'), 'name')))
- alpha_params <- gsub('series', 'trend', gsub('gp_', 'gp_trend_', gsub(':', 'by', gsub(')', '_',
- gsub('(', '_', paste0('alpha_', gp_names),
- fixed = TRUE), fixed = TRUE))))
- alpha_summary <- mcmc_summary(object$model_output, alpha_params,
- ISB = TRUE, digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder'))[,c(3:7)]
-
- rownames(alpha_summary) <- paste0(gsub('series', 'trend', paste0('alpha_', gp_names)),
- '_trend')
- rho_params <- gsub('series', 'trend', gsub('gp_', 'gp_trend_', gsub(':', 'by', gsub(')', '_',
- gsub('(', '_', paste0('rho_', gp_names),
- fixed = TRUE), fixed = TRUE))))
- rho_summary <- mcmc_summary(object$model_output, rho_params,
- ISB = TRUE, digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder'))[,c(3:7)]
- rownames(rho_summary) <- paste0(gsub('series', 'trend', paste0('rho_', gp_names)),
- '_trend')
-
- cat("\nGAM process model gp term marginal deviation (alpha) and length scale (rho) estimates:\n")
- print(rbind(alpha_summary, rho_summary))
- }
+ if(!is.null(attr(object$trend_mgcv_model, 'gp_att_table'))){
+ gp_summaries <- gp_param_summary(object = object,
+ mgcv_model = object$trend_mgcv_model,
+ trend_effects = TRUE,
+ digits = digits,
+ variational = variational)
+
+ cat("\nGAM process model gp term marginal deviation (alpha) and length scale (rho) estimates:\n")
+ print(rbind(gp_summaries$alpha_summary, gp_summaries$rho_summary))
+ }
- if(any(!is.na(object$trend_sp_names)) & smooth_test){
+ if(any(!is.na(object$trend_sp_names)) & smooth_test){
- gam_sig_table <- try(suppressWarnings(summary(object$trend_mgcv_model)$s.table[, c(1,2,3,4), drop = FALSE]), silent = TRUE)
- if(inherits(gam_sig_table, 'try-error')){
- object$trend_mgcv_model$R <- NULL
- gam_sig_table <- suppressWarnings(summary(object$trend_mgcv_model)$s.table[, c(1,2,3,4), drop = FALSE])
- gam_sig_table[,2] <- unlist(purrr::map(object$trend_mgcv_model$smooth, 'df'), use.names = FALSE)
- }
- if(!is.null(attr(object$trend_mgcv_model, 'gp_att_table'))){
- gp_names <- unlist(purrr::map(attr(object$trend_mgcv_model, 'gp_att_table'), 'name'))
- if(all(rownames(gam_sig_table) %in% gsub('gp(', 's(', gp_names, fixed = TRUE))){
+ gam_sig_table <- try(suppressWarnings(summary(object$trend_mgcv_model)$s.table[, c(1,2,3,4), drop = FALSE]), silent = TRUE)
+ if(inherits(gam_sig_table, 'try-error')){
+ object$trend_mgcv_model$R <- NULL
+ gam_sig_table <- suppressWarnings(summary(object$trend_mgcv_model)$s.table[, c(1,2,3,4), drop = FALSE])
+ gam_sig_table[,2] <- unlist(purrr::map(object$trend_mgcv_model$smooth, 'df'), use.names = FALSE)
+ }
+ if(!is.null(attr(object$trend_mgcv_model, 'gp_att_table'))){
+ gp_names <- unlist(purrr::map(attr(object$trend_mgcv_model, 'gp_att_table'), 'name'))
+ if(all(rownames(gam_sig_table) %in% gsub('gp(', 's(', gp_names, fixed = TRUE))){
+ } else {
+ gam_sig_table <- gam_sig_table[!rownames(gam_sig_table) %in%
+ gsub('gp(', 's(', gp_names, fixed = TRUE),,
+ drop = FALSE]
+
+ cat("\nApproximate significance of GAM process smooths:\n")
+ suppressWarnings(printCoefmat(gam_sig_table,
+ digits = min(3, digits + 1),
+ signif.stars = getOption("show.signif.stars"),
+ has.Pvalue = TRUE, na.print = "NA",
+ cs.ind = 1))
+ }
} else {
- gam_sig_table <- gam_sig_table[!rownames(gam_sig_table) %in%
- gsub('gp(', 's(', gp_names, fixed = TRUE),,
- drop = FALSE]
-
cat("\nApproximate significance of GAM process smooths:\n")
suppressWarnings(printCoefmat(gam_sig_table,
digits = min(3, digits + 1),
@@ -762,52 +739,44 @@ if(!is.null(object$trend_call) & !inherits(object, 'jsdgam')){
has.Pvalue = TRUE, na.print = "NA",
cs.ind = 1))
}
- } else {
- cat("\nApproximate significance of GAM process smooths:\n")
- suppressWarnings(printCoefmat(gam_sig_table,
- digits = min(3, digits + 1),
- signif.stars = getOption("show.signif.stars"),
- has.Pvalue = TRUE, na.print = "NA",
- cs.ind = 1))
}
}
-}
-if(object$fit_engine == 'stan' & object$algorithm == 'sampling'){
- cat('\nStan MCMC diagnostics:\n')
- if(inherits(object, 'jsdgam')){
- ignore_b_trend <- TRUE
- } else {
- ignore_b_trend <- FALSE
- }
- check_all_diagnostics(object$model_output,
- max_treedepth = object$max_treedepth,
- ignore_b_trend = ignore_b_trend)
+ if(object$fit_engine == 'stan' & object$algorithm == 'sampling'){
+ cat('\nStan MCMC diagnostics:\n')
+ if(inherits(object, 'jsdgam')){
+ ignore_b_trend <- TRUE
+ } else {
+ ignore_b_trend <- FALSE
+ }
+ check_all_diagnostics(object$model_output,
+ max_treedepth = object$max_treedepth,
+ ignore_b_trend = ignore_b_trend)
- sampler <- attr(object$model_output@sim$samples[[1]], "args")$sampler_t
- cat("\nSamples were drawn using ", sampler, " at ", object$model_output@date, ".\n",
- "For each parameter, n_eff is a crude measure of effective sample size,\n",
- "and Rhat is the potential scale reduction factor on split MCMC chains\n",
- "(at convergence, Rhat = 1)\n", sep = '')
+ sampler <- attr(object$model_output@sim$samples[[1]], "args")$sampler_t
+ cat("\nSamples were drawn using ", sampler, " at ", object$model_output@date, ".\n",
+ "For each parameter, n_eff is a crude measure of effective sample size,\n",
+ "and Rhat is the potential scale reduction factor on split MCMC chains\n",
+ "(at convergence, Rhat = 1)\n", sep = '')
-}
+ }
-if(object$algorithm != 'sampling'){
- cat('\nPosterior approximation used: no diagnostics to compute\n')
-}
+ if(object$algorithm != 'sampling'){
+ cat('\nPosterior approximation used: no diagnostics to compute\n')
+ }
-if(object$fit_engine == 'jags'){
- cat('\nJAGS MCMC diagnostics:\n')
- rhats <- mcmc_summary(object$model_output, digits = digits,
- variational = object$algorithm %in% c('fullrank', 'meanfield', 'laplace', 'pathfinder'))[,6]
- if(any(rhats > 1.05)){
- cat('\nRhats above 1.05 found for',
- length(which(rhats > 1.05)),
- 'parameters\n*Diagnose further to investigate why the chains have not mixed\n')
- } else {
- cat('\nRhat looks reasonable for all parameters\n')
+ if(object$fit_engine == 'jags'){
+ cat('\nJAGS MCMC diagnostics:\n')
+ rhats <- mcmc_summary(object$model_output, digits = digits,
+ variational = variational)[,6]
+ if(any(rhats > 1.05)){
+ cat('\nRhats above 1.05 found for',
+ length(which(rhats > 1.05)),
+ 'parameters\n*Diagnose further to investigate why the chains have not mixed\n')
+ } else {
+ cat('\nRhat looks reasonable for all parameters\n')
+ }
}
-}
}
@@ -905,3 +874,117 @@ coef.mvgam = function(object, summarise = TRUE, ...){
return(mvgam_coefs)
}
+
+#' Extract a clean mcmc_summary table of params
+#' @param object An `mvgam` or `jsdgam` object
+#' @param params A string of parameters to extract
+#' @param digits The number of significant digits for printing out the summary
+#' @param variational Logical indicating whether a variational approximation was used
+#' @noRd
+clean_summary_table = function(object,
+ params,
+ digits = 2,
+ variational = FALSE){
+
+ mcmc_summary(object$model_output,
+ params,
+ ISB = TRUE,
+ digits = digits,
+ variational = variational)[,c(3:7)]
+
+}
+
+#' Calculate and return summary table for GP parameters
+#' @param object An `mvgam` or `jsdgam` object
+#' @param mgcv_model A `gam` object containing GP effects
+#' @param trend_effects Logical indicating whether this is a trend_mgcv_model
+#' @param digits The number of significant digits for printing out the summary
+#' @param variational Logical indicating whether a variational approximation was used
+#' @noRd
+gp_param_summary = function(object,
+ mgcv_model,
+ trend_effects = FALSE,
+ digits = 2,
+ variational = FALSE){
+
+ # Extract GP name and isotropic information
+ gp_names <- unlist(purrr::map(attr(mgcv_model, 'gp_att_table'), 'name'),
+ use.names = FALSE)
+ gp_isos <- unlist(purrr::map(attr(mgcv_model, 'gp_att_table'), 'iso'),
+ use.names = FALSE)
+
+ # Create full list of rho parameter names
+ full_names <- vector(mode = 'list', length = length(gp_names))
+ for(i in seq_len(length(gp_names))){
+ if(gp_isos[i]){
+ full_names[[i]] <- gp_names[i]
+ } else {
+ full_names[[i]] <- paste0(gp_names[i],
+ '[',
+ 1:2,
+ ']')
+ }
+ }
+ full_names <- unlist(full_names, use.names = FALSE)
+
+ # Determine which parameters to extract
+ if(trend_effects){
+ alpha_params <- gsub('series',
+ 'trend',
+ gsub('gp_',
+ 'gp_trend_',
+ gsub(':',
+ 'by',
+ gsub(')',
+ '_',
+ gsub('(', '_', paste0('alpha_', gp_names),
+ fixed = TRUE),
+ fixed = TRUE))))
+ rho_params <- gsub('series',
+ 'trend',
+ gsub('gp_',
+ 'gp_trend_',
+ gsub(':', 'by',
+ gsub(')',
+ '_',
+ gsub('(', '_', paste0('rho_', gp_names),
+ fixed = TRUE), fixed = TRUE))))
+ } else {
+ alpha_params <- gsub(':',
+ 'by', gsub(')',
+ '_',
+ gsub('(',
+ '_',
+ paste0('alpha_',
+ clean_gpnames(gp_names)),
+ fixed = TRUE),
+ fixed = TRUE))
+ rho_params <- gsub(':',
+ 'by', gsub(')',
+ '_',
+ gsub('(',
+ '_',
+ paste0('rho_',
+ clean_gpnames(gp_names)),
+ fixed = TRUE),
+ fixed = TRUE))
+ }
+
+ # Create summary tables
+ alpha_summary <- clean_summary_table(object = object,
+ params = alpha_params,
+ digits = digits,
+ variational = variational)
+ rownames(alpha_summary) <- paste0('alpha_', gp_names)
+
+
+ rho_summary <- clean_summary_table(object = object,
+ params = rho_params,
+ digits = digits,
+ variational = variational)
+ rownames(rho_summary) <- paste0('rho_', full_names)
+
+ # Return as a list
+ return(list(alpha_summary = alpha_summary,
+ rho_summary = rho_summary))
+}
diff --git a/R/update_priors.R b/R/update_priors.R
index ea8ea560..1bfdfeaf 100644
--- a/R/update_priors.R
+++ b/R/update_priors.R
@@ -41,12 +41,9 @@ update_priors = function(model_file,
# can be correctly updated
if(grepl('gp(', priors$prior[i], fixed = TRUE) |
grepl('gp_trend', priors$prior[i], fixed = TRUE)){
- lhs <- trimws(strsplit(priors$prior[i], "[~]")[[1]][1])
- rhs <- trimws(strsplit(priors$prior[i], "[~]")[[1]][2])
- lhs <- gsub('(', '_', lhs, fixed = TRUE)
- lhs <- gsub(')', '_', lhs, fixed = TRUE)
- lhs <- gsub(':', 'by', lhs, fixed = TRUE)
- priors$prior[i] <- paste(lhs, '~', rhs)
+ priors$prior[i] <- paste(clean_gp_priorname(trimws(strsplit(priors$prior[i], "[~]")[[1]][1])),
+ '~',
+ trimws(strsplit(priors$prior[i], "[~]")[[1]][2]))
}
if(!any(grepl(paste(trimws(strsplit(priors$prior[i], "[~]")[[1]][1]), '~'),
@@ -301,16 +298,29 @@ adapt_brms_priors = function(priors,
drift = drift,
knots = knots)
+ if(any(grepl('_gp', priors$class, fixed = TRUE) &
+ (!is.na(priors$ub) | !is.na(priors$lb)))){
+ warning('bounds cannot currently be changed for gp parameters',
+ call. = FALSE)
+ }
+
# Update using priors from the brmsprior object
for(i in 1:NROW(priors)){
+ newclass <- ifelse(grepl('_gp(', priors$class[i], fixed = TRUE),
+ clean_gp_priorname(priors$class[i]),
+ priors$class[i])
+ newcoef <- ifelse(grepl('_gp(', priors$coef[i], fixed = TRUE),
+ clean_gp_priorname(priors$coef[i]),
+ priors$coef[i])
+
if(any(grepl(paste0(priors$class[i], ' ~ '),
priors_df$prior, fixed = TRUE))){
# Update the prior distribution
priors_df$prior[grepl(paste0(priors$class[i], ' ~ '),
priors_df$prior, fixed = TRUE)] <-
- paste0(priors$class[i], ' ~ ', priors$prior[i], ';')
+ paste0(newclass, ' ~ ', priors$prior[i], ';')
# Now update bounds
priors_df$new_lowerbound[grepl(paste0(priors$class[i], ' ~ '),
@@ -326,9 +336,9 @@ adapt_brms_priors = function(priors,
priors_df$prior, fixed = TRUE))){
# Update the prior distribution
- priors_df$prior[grepl(paste0(priors$class[i], ' ~ '),
+ priors_df$prior[grepl(paste0(priors$coef[i], ' ~ '),
priors_df$prior, fixed = TRUE)] <-
- paste0(priors$coef[i], ' ~ ', priors$prior[i], ';')
+ paste0(newcoef, ' ~ ', priors$prior[i], ';')
# Now update bounds
priors_df$new_lowerbound[grepl(paste0(priors$coef[i], ' ~ '),
@@ -365,3 +375,20 @@ adapt_brms_priors = function(priors,
return(priors_df)
}
+
+#'@noRd
+clean_gp_priorname = function(prior){
+ if(grepl('[', prior, fixed = TRUE)){
+ newlhs <- trimws(strsplit(prior, "\\[")[[1]][1])
+ if(grepl('[1][', prior, fixed = TRUE)){
+ index <- paste0('[1][', trimws(strsplit(prior, "\\[")[[1]][3]))
+ } else {
+ index <- '[1]'
+ }
+
+ out <- paste0(clean_gpnames(newlhs), index)
+ } else {
+ out <- clean_gpnames(prior)
+ }
+ out
+}
diff --git a/R/validations.R b/R/validations.R
index 7f130a6b..b68b3316 100644
--- a/R/validations.R
+++ b/R/validations.R
@@ -864,11 +864,43 @@ check_priorsim = function(prior_simulation, data_train, orig_y, formula){
#'@noRd
check_gp_terms = function(formula, data_train, family){
+
+ # Check for proper binomial specification
+ if(!missing(family)){
+ if(is.character(family)){
+ if(family == 'beta')
+ family <- betar()
+
+ family <- try(eval(parse(text = family)), silent = TRUE)
+
+ if(inherits(family, 'try-error'))
+ stop("family not recognized",
+ call. = FALSE)
+ }
+
+ if(is.function(family))
+ family <- family()
+
+ if(family$family %in% c('binomial', 'beta_binomial')){
+ # Check that response terms use the cbind() syntax
+ resp_terms <- as.character(terms(formula(formula))[[2]])
+ if(length(resp_terms) == 1){
+ stop('Binomial family requires cbind() syntax in the formula left-hand side',
+ call. = FALSE)
+ } else {
+ if(any(grepl('cbind', resp_terms))){
+ } else {
+ stop('Binomial family requires cbind() syntax in the formula left-hand side',
+ call. = FALSE)
+ }
+ }
+ }
+ }
+
# Check for gp terms in the validated formula
orig_formula <- gp_terms <- gp_details <- NULL
if(any(grepl('gp(', attr(terms(formula), 'term.labels'), fixed = TRUE))){
- # Check that there are no multidimensional gp terms
formula <- interpret_mvgam(formula, N = max(data_train$time),
family = family)
orig_formula <- formula
@@ -880,11 +912,11 @@ check_gp_terms = function(formula, data_train, family){
gp_terms <- which_are_gp(formula)
# Extract attributes
- gp_details <- get_gp_attributes(formula)
+ gp_details <- get_gp_attributes(formula, data_train, family)
# Replace with s() terms so the correct terms are included
# in the model.frame
- formula <- gp_to_s(formula)
+ formula <- gp_to_s(formula, data_train, family)
if(!keep_intercept) formula <- update(formula, . ~ . - 1)
}
diff --git a/README.Rmd b/README.Rmd
index 1043332c..066a7b72 100644
--- a/README.Rmd
+++ b/README.Rmd
@@ -289,4 +289,5 @@ There are many more extended uses of `mvgam`, including the ability to fit hiera
This project is licensed under an `MIT` open source license
## Interested in contributing?
-I'm actively seeking PhD students and other researchers to work in the areas of ecological forecasting, multivariate model evaluation and development of `mvgam`. Please reach out if you are interested (n.clark'at'uq.edu.au)
+I'm actively seeking PhD students and other researchers to work in the areas of ecological forecasting, multivariate model evaluation and development of `mvgam`. Please reach out if you are interested (n.clark'at'uq.edu.au). Other contributions are also very welcome, but please see [The Contributor Instructions](https://github.com/nicholasjclark/mvgam/blob/main/.github/CONTRIBUTING.md) for general guidelines. Note that
+by participating in this project you agree to abide by the terms of its [Contributor Code of Conduct](https://dplyr.tidyverse.org/CODE_OF_CONDUCT).
diff --git a/README.md b/README.md
index 86c4025d..af0e1924 100644
--- a/README.md
+++ b/README.md
@@ -223,6 +223,7 @@ summary(lynx_mvgam)
#> Trend model:
#> AR(p = 1)
#>
+#>
#> N series:
#> 1
#>
@@ -237,28 +238,28 @@ summary(lynx_mvgam)
#>
#> GAM coefficient (beta) estimates:
#> 2.5% 50% 97.5% Rhat n_eff
-#> (Intercept) 6.400 6.60 6.900 1 660
-#> s(season).1 -0.640 -0.12 0.390 1 1035
-#> s(season).2 0.690 1.30 1.900 1 893
-#> s(season).3 1.200 1.90 2.500 1 842
-#> s(season).4 -0.079 0.53 1.100 1 830
-#> s(season).5 -1.300 -0.71 -0.058 1 849
-#> s(season).6 -1.200 -0.56 0.110 1 1168
-#> s(season).7 0.058 0.72 1.400 1 997
-#> s(season).8 0.660 1.40 2.100 1 1019
-#> s(season).9 -0.350 0.24 0.840 1 906
-#> s(season).10 -1.400 -0.85 -0.370 1 1124
+#> (Intercept) 6.400 6.60 6.900 1.00 796
+#> s(season).1 -0.650 -0.13 0.380 1.00 855
+#> s(season).2 0.740 1.30 1.900 1.00 933
+#> s(season).3 1.200 1.90 2.500 1.01 633
+#> s(season).4 -0.046 0.55 1.100 1.00 834
+#> s(season).5 -1.300 -0.69 -0.062 1.00 995
+#> s(season).6 -1.300 -0.55 0.110 1.01 1006
+#> s(season).7 0.021 0.72 1.400 1.00 757
+#> s(season).8 0.620 1.40 2.100 1.00 763
+#> s(season).9 -0.330 0.23 0.820 1.00 772
+#> s(season).10 -1.300 -0.86 -0.400 1.00 1174
#>
#> Approximate significance of GAM smooths:
#> edf Ref.df Chi.sq p-value
-#> s(season) 9.99 10 45.6 <2e-16 ***
+#> s(season) 9.99 10 46.5 <2e-16 ***
#> ---
#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#>
#> Latent trend parameter AR estimates:
#> 2.5% 50% 97.5% Rhat n_eff
-#> ar1[1] 0.59 0.82 0.98 1.00 660
-#> sigma[1] 0.39 0.48 0.61 1.01 628
+#> ar1[1] 0.60 0.83 0.98 1 608
+#> sigma[1] 0.38 0.48 0.61 1 636
#>
#> Stan MCMC diagnostics:
#> n_eff / iter looks reasonable for all parameters
@@ -267,7 +268,7 @@ summary(lynx_mvgam)
#> 0 of 2000 iterations saturated the maximum tree depth of 12 (0%)
#> E-FMI indicated no pathological behavior
#>
-#> Samples were drawn using NUTS(diag_e) at Thu Oct 31 9:16:35 AM 2024.
+#> Samples were drawn using NUTS(diag_e) at Tue Nov 12 8:48:44 AM 2024.
#> For each parameter, n_eff is a crude measure of effective sample size,
#> and Rhat is the potential scale reduction factor on split MCMC chains
#> (at convergence, Rhat = 1)
@@ -403,12 +404,13 @@ series (testing and training)
``` r
plot(lynx_mvgam, type = 'forecast', newdata = lynx_test)
-#> Out of sample DRPS:
-#> 2380.3470865
```
<img src="man/figures/README-unnamed-chunk-21-1.png" alt="Plotting forecast distributions using mvgam in R" width="60%" style="display: block; margin: auto;" />
+ #> Out of sample DRPS:
+ #> 2380.298498
+
And the estimated latent trend component, again using the more flexible
`plot_mvgam_...()` option to show first derivatives of the estimated
trend
@@ -517,6 +519,7 @@ summary(mod, include_betas = FALSE)
#> Trend model:
#> GP()
#>
+#>
#> N series:
#> 3
#>
@@ -565,7 +568,7 @@ summary(mod, include_betas = FALSE)
#> 0 of 2000 iterations saturated the maximum tree depth of 12 (0%)
#> E-FMI indicated no pathological behavior
#>
-#> Samples were drawn using NUTS(diag_e) at Thu Oct 31 9:17:20 AM 2024.
+#> Samples were drawn using NUTS(diag_e) at Tue Nov 12 8:49:29 AM 2024.
#> For each parameter, n_eff is a crude measure of effective sample size,
#> and Rhat is the potential scale reduction factor on split MCMC chains
#> (at convergence, Rhat = 1)
@@ -603,4 +606,9 @@ This project is licensed under an `MIT` open source license
I’m actively seeking PhD students and other researchers to work in the
areas of ecological forecasting, multivariate model evaluation and
development of `mvgam`. Please reach out if you are interested
-(n.clark’at’uq.edu.au)
+(n.clark’at’uq.edu.au). Other contributions are also very welcome, but
+please see [The Contributor
+Instructions](https://github.com/nicholasjclark/mvgam/blob/main/.github/CONTRIBUTING.md)
+for general guidelines. Note that by participating in this project you
+agree to abide by the terms of its [Contributor Code of
+Conduct](https://dplyr.tidyverse.org/CODE_OF_CONDUCT).
diff --git a/docs/news/index.html b/docs/news/index.html
index 6b907c80..85388faf 100644
--- a/docs/news/index.html
+++ b/docs/news/index.html
@@ -60,7 +60,8 @@
<h2 class="pkg-version" data-toc-text="1.1.4" id="mvgam-114-development-version-not-yet-on-cran">mvgam 1.1.4 (development version; not yet on CRAN)<a class="anchor" aria-label="anchor" href="#mvgam-114-development-version-not-yet-on-cran"></a></h2>
<div class="section level3">
<h3 id="new-functionalities-1-1-4">New functionalities<a class="anchor" aria-label="anchor" href="#new-functionalities-1-1-4"></a></h3>
-<ul><li>Added function <code><a href="../reference/jsdgam.html">jsdgam()</a></code> to estimate Joint Species Distribution Models in which both the latent factors and the observation model components can include any of mvgam’s complex linear predictor effects. Also added a function <code><a href="../reference/residual_cor.jsdgam.html">residual_cor()</a></code> to compute residual correlation, covariance and precision matrices from <code>jsdgam</code> models. See <code><a href="../reference/jsdgam.html">?mvgam::jsdgam</a></code> and <code><a href="../reference/residual_cor.jsdgam.html">?mvgam::residual_cor</a></code> for details</li>
+<ul><li>Added support for approximate <code><a href="https://paulbuerkner.com/brms/reference/gp.html" class="external-link">gp()</a></code> effects with more than one covariate and with different kernel functions (<a href="https://github.com/nicholasjclark/mvgam/issues/79" class="external-link">#79</a>)</li>
+<li>Added function <code><a href="../reference/jsdgam.html">jsdgam()</a></code> to estimate Joint Species Distribution Models in which both the latent factors and the observation model components can include any of mvgam’s complex linear predictor effects. Also added a function <code><a href="../reference/residual_cor.jsdgam.html">residual_cor()</a></code> to compute residual correlation, covariance and precision matrices from <code>jsdgam</code> models. See <code><a href="../reference/jsdgam.html">?mvgam::jsdgam</a></code> and <code><a href="../reference/residual_cor.jsdgam.html">?mvgam::residual_cor</a></code> for details</li>
<li>Added a <code><a href="../reference/stability.mvgam.html">stability.mvgam()</a></code> method to compute stability metrics from models fit with Vector Autoregressive dynamics (<a href="https://github.com/nicholasjclark/mvgam/issues/21" class="external-link">#21</a> and <a href="https://github.com/nicholasjclark/mvgam/issues/76" class="external-link">#76</a>)</li>
<li>Added functionality to estimate hierarchical error correlations when using multivariate latent process models and when the data are nested among levels of a relevant grouping factor (<a href="https://github.com/nicholasjclark/mvgam/issues/75" class="external-link">#75</a>); see <code><a href="../reference/RW.html">?mvgam::AR</a></code> for an example</li>
<li>Added <code><a href="../reference/ZMVN.html">ZMVN()</a></code> error models for estimating Zero-Mean Multivariate Normal errors; convenient for working with non time-series data where latent residuals are expected to be correlated (such as when fitting Joint Species Distribution Models); see <code><a href="../reference/ZMVN.html">?mvgam::ZMVN</a></code> for examples</li>
diff --git a/docs/reference/Rplot001.png b/docs/reference/Rplot001.png
index ed1dc5a7..17a35806 100644
Binary files a/docs/reference/Rplot001.png and b/docs/reference/Rplot001.png differ
diff --git a/docs/reference/Rplot002.png b/docs/reference/Rplot002.png
index 4ccb8d1d..c75d4e2e 100644
Binary files a/docs/reference/Rplot002.png and b/docs/reference/Rplot002.png differ
diff --git a/docs/reference/Rplot003.png b/docs/reference/Rplot003.png
index 25b725cc..86c28580 100644
Binary files a/docs/reference/Rplot003.png and b/docs/reference/Rplot003.png differ
diff --git a/docs/reference/Rplot004.png b/docs/reference/Rplot004.png
index 74561f52..20b8a969 100644
Binary files a/docs/reference/Rplot004.png and b/docs/reference/Rplot004.png differ
diff --git a/docs/reference/Rplot005.png b/docs/reference/Rplot005.png
index 102c4abc..5a91a972 100644
Binary files a/docs/reference/Rplot005.png and b/docs/reference/Rplot005.png differ
diff --git a/docs/reference/Rplot006.png b/docs/reference/Rplot006.png
index af5b8da6..b25f273f 100644
Binary files a/docs/reference/Rplot006.png and b/docs/reference/Rplot006.png differ
diff --git a/docs/reference/Rplot007.png b/docs/reference/Rplot007.png
index 25a6bb1d..1858e4b9 100644
Binary files a/docs/reference/Rplot007.png and b/docs/reference/Rplot007.png differ
diff --git a/docs/reference/Rplot008.png b/docs/reference/Rplot008.png
index b9f04a08..2e095d37 100644
Binary files a/docs/reference/Rplot008.png and b/docs/reference/Rplot008.png differ
diff --git a/docs/reference/Rplot009.png b/docs/reference/Rplot009.png
index fe7c1b9c..23ea0650 100644
Binary files a/docs/reference/Rplot009.png and b/docs/reference/Rplot009.png differ
diff --git a/docs/reference/Rplot010.png b/docs/reference/Rplot010.png
index bcbb7016..0d4c06b7 100644
Binary files a/docs/reference/Rplot010.png and b/docs/reference/Rplot010.png differ
diff --git a/docs/reference/Rplot011.png b/docs/reference/Rplot011.png
index daec4e3b..09e3ae50 100644
Binary files a/docs/reference/Rplot011.png and b/docs/reference/Rplot011.png differ
diff --git a/docs/reference/Rplot012.png b/docs/reference/Rplot012.png
index f3fc4b72..a77fe094 100644
Binary files a/docs/reference/Rplot012.png and b/docs/reference/Rplot012.png differ
diff --git a/docs/reference/conditional_effects.mvgam-1.png b/docs/reference/conditional_effects.mvgam-1.png
index 71289b90..b0944ae9 100644
Binary files a/docs/reference/conditional_effects.mvgam-1.png and b/docs/reference/conditional_effects.mvgam-1.png differ
diff --git a/docs/reference/conditional_effects.mvgam-2.png b/docs/reference/conditional_effects.mvgam-2.png
index 8510f99d..c6fdab29 100644
Binary files a/docs/reference/conditional_effects.mvgam-2.png and b/docs/reference/conditional_effects.mvgam-2.png differ
diff --git a/docs/reference/conditional_effects.mvgam-3.png b/docs/reference/conditional_effects.mvgam-3.png
index 55eb898b..af3e4784 100644
Binary files a/docs/reference/conditional_effects.mvgam-3.png and b/docs/reference/conditional_effects.mvgam-3.png differ
diff --git a/docs/reference/conditional_effects.mvgam-4.png b/docs/reference/conditional_effects.mvgam-4.png
index 4b91ad64..3d929bd6 100644
Binary files a/docs/reference/conditional_effects.mvgam-4.png and b/docs/reference/conditional_effects.mvgam-4.png differ
diff --git a/docs/reference/conditional_effects.mvgam-5.png b/docs/reference/conditional_effects.mvgam-5.png
index f1c95ea1..985a6297 100644
Binary files a/docs/reference/conditional_effects.mvgam-5.png and b/docs/reference/conditional_effects.mvgam-5.png differ
diff --git a/docs/reference/conditional_effects.mvgam-6.png b/docs/reference/conditional_effects.mvgam-6.png
index b6fd66dd..f380f124 100644
Binary files a/docs/reference/conditional_effects.mvgam-6.png and b/docs/reference/conditional_effects.mvgam-6.png differ
diff --git a/docs/reference/conditional_effects.mvgam-7.png b/docs/reference/conditional_effects.mvgam-7.png
index 2285d91e..e5fac19c 100644
Binary files a/docs/reference/conditional_effects.mvgam-7.png and b/docs/reference/conditional_effects.mvgam-7.png differ
diff --git a/docs/reference/conditional_effects.mvgam-8.png b/docs/reference/conditional_effects.mvgam-8.png
index 6319f049..46c46d1c 100644
Binary files a/docs/reference/conditional_effects.mvgam-8.png and b/docs/reference/conditional_effects.mvgam-8.png differ
diff --git a/docs/reference/conditional_effects.mvgam-9.png b/docs/reference/conditional_effects.mvgam-9.png
index 53a1079d..c90b8ced 100644
Binary files a/docs/reference/conditional_effects.mvgam-9.png and b/docs/reference/conditional_effects.mvgam-9.png differ
diff --git a/docs/reference/conditional_effects.mvgam.html b/docs/reference/conditional_effects.mvgam.html
index f646cb2d..ec78a44e 100644
--- a/docs/reference/conditional_effects.mvgam.html
+++ b/docs/reference/conditional_effects.mvgam.html
@@ -1,7 +1,7 @@
<!DOCTYPE html>
<!-- Generated by pkgdown: do not edit by hand --><html lang="en"><head><meta http-equiv="Content-Type" content="text/html; charset=UTF-8"><meta charset="utf-8"><meta http-equiv="X-UA-Compatible" content="IE=edge"><meta name="viewport" content="width=device-width, initial-scale=1, shrink-to-fit=no"><meta name="description" content="Display conditional effects of one or more numeric and/or categorical
predictors in mvgam models, including two-way interaction effects."><title>Display Conditional Effects of Predictors — conditional_effects.mvgam • mvgam</title><script src="../deps/jquery-3.6.0/jquery-3.6.0.min.js"></script><meta name="viewport" content="width=device-width, initial-scale=1, shrink-to-fit=no"><link href="../deps/bootstrap-5.3.1/bootstrap.min.css" rel="stylesheet"><script src="../deps/bootstrap-5.3.1/bootstrap.bundle.min.js"></script><!-- Font Awesome icons --><link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/5.12.1/css/all.min.css" integrity="sha256-mmgLkCYLUQbXn0B1SRqzHar6dCnv9oZFPEC1g1cwlkk=" crossorigin="anonymous"><link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/5.12.1/css/v4-shims.min.css" integrity="sha256-wZjR52fzng1pJHwx4aV2AO3yyTOXrcDW7jBpJtTwVxw=" crossorigin="anonymous"><!-- bootstrap-toc --><script src="https://cdn.jsdelivr.net/gh/afeld/bootstrap-toc@v1.0.1/dist/bootstrap-toc.min.js" integrity="sha256-4veVQbu7//Lk5TSmc7YV48MxtMy98e26cf5MrgZYnwo=" crossorigin="anonymous"></script><!-- headroom.js --><script src="https://cdnjs.cloudflare.com/ajax/libs/headroom/0.11.0/headroom.min.js" integrity="sha256-AsUX4SJE1+yuDu5+mAVzJbuYNPHj/WroHuZ8Ir/CkE0=" crossorigin="anonymous"></script><script src="https://cdnjs.cloudflare.com/ajax/libs/headroom/0.11.0/jQuery.headroom.min.js" integrity="sha256-ZX/yNShbjqsohH1k95liqY9Gd8uOiE1S4vZc+9KQ1K4=" crossorigin="anonymous"></script><!-- clipboard.js --><script src="https://cdnjs.cloudflare.com/ajax/libs/clipboard.js/2.0.6/clipboard.min.js" integrity="sha256-inc5kl9MA1hkeYUt+EC3BhlIgyp/2jDIyBLS6k3UxPI=" crossorigin="anonymous"></script><!-- search --><script src="https://cdnjs.cloudflare.com/ajax/libs/fuse.js/6.4.6/fuse.js" integrity="sha512-zv6Ywkjyktsohkbp9bb45V6tEMoWhzFzXis+LrMehmJZZSys19Yxf1dopHx7WzIKxr5tK2dVcYmaCk2uqdjF4A==" crossorigin="anonymous"></script><script src="https://cdnjs.cloudflare.com/ajax/libs/autocomplete.js/0.38.0/autocomplete.jquery.min.js" integrity="sha512-GU9ayf+66Xx2TmpxqJpliWbT5PiGYxpaG8rfnBEk1LL8l1KGkRShhngwdXK1UgqhAzWpZHSiYPc09/NwDQIGyg==" crossorigin="anonymous"></script><script src="https://cdnjs.cloudflare.com/ajax/libs/mark.js/8.11.1/mark.min.js" integrity="sha512-5CYOlHXGh6QpOFA/TeTylKLWfB3ftPsde7AnmhuitiTX4K5SqCLBeKro6sPS8ilsz1Q4NRx3v8Ko2IBiszzdww==" crossorigin="anonymous"></script><!-- pkgdown --><script src="../pkgdown.js"></script><meta property="og:title" content="Display Conditional Effects of Predictors — conditional_effects.mvgam"><meta property="og:description" content="Display conditional effects of one or more numeric and/or categorical
-predictors in mvgam models, including two-way interaction effects."><!-- mathjax --><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js" integrity="sha256-nvJJv9wWKEm88qvoQl9ekL2J+k/RWIsaSScxxlsrv8k=" crossorigin="anonymous"></script><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/config/TeX-AMS-MML_HTMLorMML.js" integrity="sha256-84DKXVJXs0/F8OTMzX4UR909+jtl4G7SPypPavF+GfA=" crossorigin="anonymous"></script><!--[if lt IE 9]>
+predictors in mvgam models, including two-way interaction effects."><meta property="og:image" content="https://nicholasjclark.github.io/mvgam/logo.png"><!-- mathjax --><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js" integrity="sha256-nvJJv9wWKEm88qvoQl9ekL2J+k/RWIsaSScxxlsrv8k=" crossorigin="anonymous"></script><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/config/TeX-AMS-MML_HTMLorMML.js" integrity="sha256-84DKXVJXs0/F8OTMzX4UR909+jtl4G7SPypPavF+GfA=" crossorigin="anonymous"></script><!--[if lt IE 9]>
<script src="https://oss.maxcdn.com/html5shiv/3.7.3/html5shiv.min.js"></script>
<script src="https://oss.maxcdn.com/respond/1.4.2/respond.min.js"></script>
<![endif]--></head><body>
@@ -12,7 +12,7 @@
<a class="navbar-brand me-2" href="../index.html">mvgam</a>
- <small class="nav-text text-muted me-auto" data-bs-toggle="tooltip" data-bs-placement="bottom" title="">1.1.3</small>
+ <small class="nav-text text-muted me-auto" data-bs-toggle="tooltip" data-bs-placement="bottom" title="">1.1.4</small>
<button class="navbar-toggler" type="button" data-bs-toggle="collapse" data-bs-target="#navbar" aria-controls="navbar" aria-expanded="false" aria-label="Toggle navigation">
@@ -54,7 +54,7 @@
</nav><div class="container template-reference-topic">
<div class="row">
<main id="main" class="col-md-9"><div class="page-header">
- <img src="" class="logo" alt=""><h1>Display Conditional Effects of Predictors</h1>
+ <img src="../logo.png" class="logo" alt=""><h1>Display Conditional Effects of Predictors</h1>
<small class="dont-index">Source: <a href="https://github.com/nicholasjclark/mvgam/blob/HEAD/R/conditional_effects.R" class="external-link"><code>R/conditional_effects.R</code></a></small>
<div class="d-none name"><code>conditional_effects.mvgam.Rd</code></div>
</div>
@@ -67,12 +67,12 @@
<div class="section level2">
<h2 id="ref-usage">Usage<a class="anchor" aria-label="anchor" href="#ref-usage"></a></h2>
<div class="sourceCode"><pre class="sourceCode r"><code><span><span class="co"># S3 method for mvgam</span></span>
-<span><span class="fu">conditional_effects</span><span class="op">(</span></span>
+<span><span class="fu"><a href="https://paulbuerkner.com/brms/reference/conditional_effects.brmsfit.html" class="external-link">conditional_effects</a></span><span class="op">(</span></span>
<span> <span class="va">x</span>,</span>
<span> effects <span class="op">=</span> <span class="cn">NULL</span>,</span>
<span> type <span class="op">=</span> <span class="st">"response"</span>,</span>
-<span> points <span class="op">=</span> <span class="cn">TRUE</span>,</span>
-<span> rug <span class="op">=</span> <span class="cn">TRUE</span>,</span>
+<span> points <span class="op">=</span> <span class="cn">FALSE</span>,</span>
+<span> rug <span class="op">=</span> <span class="cn">FALSE</span>,</span>
<span> <span class="va">...</span></span>
<span><span class="op">)</span></span>
<span></span>
@@ -174,7 +174,7 @@ <h2 id="ref-examples">Examples<a class="anchor" aria-label="anchor" href="#ref-e
<span class="r-in"><span> seasonality <span class="op">=</span> <span class="st">'hierarchical'</span><span class="op">)</span></span></span>
<span class="r-in"><span></span></span>
<span class="r-in"><span><span class="co"># Fit a model</span></span></span>
-<span class="r-in"><span><span class="va">mod</span> <span class="op"><-</span> <span class="fu"><a href="mvgam.html">mvgam</a></span><span class="op">(</span><span class="va">y</span> <span class="op">~</span> <span class="fu">s</span><span class="op">(</span><span class="va">season</span>, by <span class="op">=</span> <span class="va">series</span>, k <span class="op">=</span> <span class="fl">5</span><span class="op">)</span> <span class="op">+</span> <span class="va">year</span><span class="op">:</span><span class="va">series</span>,</span></span>
+<span class="r-in"><span><span class="va">mod</span> <span class="op"><-</span> <span class="fu"><a href="mvgam.html">mvgam</a></span><span class="op">(</span><span class="va">y</span> <span class="op">~</span> <span class="fu"><a href="https://rdrr.io/pkg/mgcv/man/s.html" class="external-link">s</a></span><span class="op">(</span><span class="va">season</span>, by <span class="op">=</span> <span class="va">series</span>, k <span class="op">=</span> <span class="fl">5</span><span class="op">)</span> <span class="op">+</span> <span class="va">year</span><span class="op">:</span><span class="va">series</span>,</span></span>
<span class="r-in"><span> family <span class="op">=</span> <span class="fu"><a href="https://rdrr.io/r/stats/family.html" class="external-link">poisson</a></span><span class="op">(</span><span class="op">)</span>,</span></span>
<span class="r-in"><span> data <span class="op">=</span> <span class="va">simdat</span><span class="op">$</span><span class="va">data_train</span>,</span></span>
<span class="r-in"><span> chains <span class="op">=</span> <span class="fl">2</span><span class="op">)</span></span></span>
@@ -187,47 +187,47 @@ <h2 id="ref-examples">Examples<a class="anchor" aria-label="anchor" href="#ref-e
<span class="r-out co"><span class="r-pr">#></span> Chain 2 Iteration: 1 / 1000 [ 0%] (Warmup) </span>
<span class="r-out co"><span class="r-pr">#></span> Chain 1 Iteration: 100 / 1000 [ 10%] (Warmup) </span>
<span class="r-out co"><span class="r-pr">#></span> Chain 2 Iteration: 100 / 1000 [ 10%] (Warmup) </span>
-<span class="r-out co"><span class="r-pr">#></span> Chain 2 Iteration: 200 / 1000 [ 20%] (Warmup) </span>
<span class="r-out co"><span class="r-pr">#></span> Chain 1 Iteration: 200 / 1000 [ 20%] (Warmup) </span>
-<span class="r-out co"><span class="r-pr">#></span> Chain 2 Iteration: 300 / 1000 [ 30%] (Warmup) </span>
+<span class="r-out co"><span class="r-pr">#></span> Chain 2 Iteration: 200 / 1000 [ 20%] (Warmup) </span>
<span class="r-out co"><span class="r-pr">#></span> Chain 1 Iteration: 300 / 1000 [ 30%] (Warmup) </span>
-<span class="r-out co"><span class="r-pr">#></span> Chain 2 Iteration: 400 / 1000 [ 40%] (Warmup) </span>
+<span class="r-out co"><span class="r-pr">#></span> Chain 2 Iteration: 300 / 1000 [ 30%] (Warmup) </span>
<span class="r-out co"><span class="r-pr">#></span> Chain 1 Iteration: 400 / 1000 [ 40%] (Warmup) </span>
-<span class="r-out co"><span class="r-pr">#></span> Chain 2 Iteration: 500 / 1000 [ 50%] (Warmup) </span>
+<span class="r-out co"><span class="r-pr">#></span> Chain 2 Iteration: 400 / 1000 [ 40%] (Warmup) </span>
<span class="r-out co"><span class="r-pr">#></span> Chain 1 Iteration: 500 / 1000 [ 50%] (Warmup) </span>
-<span class="r-out co"><span class="r-pr">#></span> Chain 2 Iteration: 501 / 1000 [ 50%] (Sampling) </span>
<span class="r-out co"><span class="r-pr">#></span> Chain 1 Iteration: 501 / 1000 [ 50%] (Sampling) </span>
-<span class="r-out co"><span class="r-pr">#></span> Chain 2 Iteration: 600 / 1000 [ 60%] (Sampling) </span>
+<span class="r-out co"><span class="r-pr">#></span> Chain 2 Iteration: 500 / 1000 [ 50%] (Warmup) </span>
<span class="r-out co"><span class="r-pr">#></span> Chain 1 Iteration: 600 / 1000 [ 60%] (Sampling) </span>
-<span class="r-out co"><span class="r-pr">#></span> Chain 2 Iteration: 700 / 1000 [ 70%] (Sampling) </span>
+<span class="r-out co"><span class="r-pr">#></span> Chain 2 Iteration: 501 / 1000 [ 50%] (Sampling) </span>
<span class="r-out co"><span class="r-pr">#></span> Chain 1 Iteration: 700 / 1000 [ 70%] (Sampling) </span>
-<span class="r-out co"><span class="r-pr">#></span> Chain 2 Iteration: 800 / 1000 [ 80%] (Sampling) </span>
+<span class="r-out co"><span class="r-pr">#></span> Chain 2 Iteration: 600 / 1000 [ 60%] (Sampling) </span>
<span class="r-out co"><span class="r-pr">#></span> Chain 1 Iteration: 800 / 1000 [ 80%] (Sampling) </span>
-<span class="r-out co"><span class="r-pr">#></span> Chain 2 Iteration: 900 / 1000 [ 90%] (Sampling) </span>
+<span class="r-out co"><span class="r-pr">#></span> Chain 2 Iteration: 700 / 1000 [ 70%] (Sampling) </span>
<span class="r-out co"><span class="r-pr">#></span> Chain 1 Iteration: 900 / 1000 [ 90%] (Sampling) </span>
-<span class="r-out co"><span class="r-pr">#></span> Chain 2 Iteration: 1000 / 1000 [100%] (Sampling) </span>
-<span class="r-out co"><span class="r-pr">#></span> Chain 2 finished in 2.8 seconds.</span>
+<span class="r-out co"><span class="r-pr">#></span> Chain 2 Iteration: 800 / 1000 [ 80%] (Sampling) </span>
<span class="r-out co"><span class="r-pr">#></span> Chain 1 Iteration: 1000 / 1000 [100%] (Sampling) </span>
-<span class="r-out co"><span class="r-pr">#></span> Chain 1 finished in 2.9 seconds.</span>
+<span class="r-out co"><span class="r-pr">#></span> Chain 2 Iteration: 900 / 1000 [ 90%] (Sampling) </span>
+<span class="r-out co"><span class="r-pr">#></span> Chain 1 finished in 2.1 seconds.</span>
+<span class="r-out co"><span class="r-pr">#></span> Chain 2 Iteration: 1000 / 1000 [100%] (Sampling) </span>
+<span class="r-out co"><span class="r-pr">#></span> Chain 2 finished in 2.3 seconds.</span>
<span class="r-out co"><span class="r-pr">#></span> </span>
<span class="r-out co"><span class="r-pr">#></span> Both chains finished successfully.</span>
-<span class="r-out co"><span class="r-pr">#></span> Mean chain execution time: 2.8 seconds.</span>
-<span class="r-out co"><span class="r-pr">#></span> Total execution time: 3.0 seconds.</span>
+<span class="r-out co"><span class="r-pr">#></span> Mean chain execution time: 2.2 seconds.</span>
+<span class="r-out co"><span class="r-pr">#></span> Total execution time: 2.6 seconds.</span>
<span class="r-out co"><span class="r-pr">#></span> </span>
<span class="r-in"><span></span></span>
<span class="r-in"><span><span class="co"># Plot all main effects on the response scale</span></span></span>
-<span class="r-in"><span><span class="fu">conditional_effects</span><span class="op">(</span><span class="va">mod</span><span class="op">)</span></span></span>
+<span class="r-in"><span><span class="fu"><a href="https://paulbuerkner.com/brms/reference/conditional_effects.brmsfit.html" class="external-link">conditional_effects</a></span><span class="op">(</span><span class="va">mod</span><span class="op">)</span></span></span>
<span class="r-plt img"><img src="conditional_effects.mvgam-1.png" alt="" width="700" height="433"></span>
<span class="r-plt img"><img src="conditional_effects.mvgam-2.png" alt="" width="700" height="433"></span>
<span class="r-in"><span></span></span>
<span class="r-in"><span><span class="co"># Change the prediction interval to 70% using plot_predictions() argument</span></span></span>
<span class="r-in"><span><span class="co"># 'conf_level'</span></span></span>
-<span class="r-in"><span><span class="fu">conditional_effects</span><span class="op">(</span><span class="va">mod</span>, conf_level <span class="op">=</span> <span class="fl">0.7</span><span class="op">)</span></span></span>
+<span class="r-in"><span><span class="fu"><a href="https://paulbuerkner.com/brms/reference/conditional_effects.brmsfit.html" class="external-link">conditional_effects</a></span><span class="op">(</span><span class="va">mod</span>, conf_level <span class="op">=</span> <span class="fl">0.7</span><span class="op">)</span></span></span>
<span class="r-plt img"><img src="conditional_effects.mvgam-3.png" alt="" width="700" height="433"></span>
<span class="r-plt img"><img src="conditional_effects.mvgam-4.png" alt="" width="700" height="433"></span>
<span class="r-in"><span></span></span>
<span class="r-in"><span><span class="co"># Plot all main effects on the link scale</span></span></span>
-<span class="r-in"><span><span class="fu">conditional_effects</span><span class="op">(</span><span class="va">mod</span>, type <span class="op">=</span> <span class="st">'link'</span><span class="op">)</span></span></span>
+<span class="r-in"><span><span class="fu"><a href="https://paulbuerkner.com/brms/reference/conditional_effects.brmsfit.html" class="external-link">conditional_effects</a></span><span class="op">(</span><span class="va">mod</span>, type <span class="op">=</span> <span class="st">'link'</span><span class="op">)</span></span></span>
<span class="r-plt img"><img src="conditional_effects.mvgam-5.png" alt="" width="700" height="433"></span>
<span class="r-plt img"><img src="conditional_effects.mvgam-6.png" alt="" width="700" height="433"></span>
<span class="r-in"><span></span></span>
@@ -235,7 +235,7 @@ <h2 id="ref-examples">Examples<a class="anchor" aria-label="anchor" href="#ref-e
<span class="r-in"><span><span class="fu"><a href="https://rdrr.io/r/base/Random.html" class="external-link">set.seed</a></span><span class="op">(</span><span class="fl">0</span><span class="op">)</span></span></span>
<span class="r-in"><span><span class="va">dat</span> <span class="op"><-</span> <span class="fu">mgcv</span><span class="fu">::</span><span class="fu"><a href="https://rdrr.io/pkg/mgcv/man/gamSim.html" class="external-link">gamSim</a></span><span class="op">(</span><span class="fl">1</span>, n <span class="op">=</span> <span class="fl">200</span>, scale <span class="op">=</span> <span class="fl">2</span><span class="op">)</span></span></span>
<span class="r-out co"><span class="r-pr">#></span> Gu & Wahba 4 term additive model</span>
-<span class="r-in"><span><span class="va">mod</span> <span class="op"><-</span> <span class="fu"><a href="mvgam.html">mvgam</a></span><span class="op">(</span><span class="va">y</span> <span class="op">~</span> <span class="fu"><a href="ti.html">te</a></span><span class="op">(</span><span class="va">x0</span>, <span class="va">x1</span>, k <span class="op">=</span> <span class="fl">5</span><span class="op">)</span> <span class="op">+</span> <span class="fu">s</span><span class="op">(</span><span class="va">x2</span>, k <span class="op">=</span> <span class="fl">6</span><span class="op">)</span> <span class="op">+</span> <span class="fu">s</span><span class="op">(</span><span class="va">x3</span>, k <span class="op">=</span> <span class="fl">6</span><span class="op">)</span>,</span></span>
+<span class="r-in"><span><span class="va">mod</span> <span class="op"><-</span> <span class="fu"><a href="mvgam.html">mvgam</a></span><span class="op">(</span><span class="va">y</span> <span class="op">~</span> <span class="fu"><a href="https://rdrr.io/pkg/mgcv/man/te.html" class="external-link">te</a></span><span class="op">(</span><span class="va">x0</span>, <span class="va">x1</span>, k <span class="op">=</span> <span class="fl">5</span><span class="op">)</span> <span class="op">+</span> <span class="fu"><a href="https://rdrr.io/pkg/mgcv/man/s.html" class="external-link">s</a></span><span class="op">(</span><span class="va">x2</span>, k <span class="op">=</span> <span class="fl">6</span><span class="op">)</span> <span class="op">+</span> <span class="fu"><a href="https://rdrr.io/pkg/mgcv/man/s.html" class="external-link">s</a></span><span class="op">(</span><span class="va">x3</span>, k <span class="op">=</span> <span class="fl">6</span><span class="op">)</span>,</span></span>
<span class="r-in"><span> data <span class="op">=</span> <span class="va">dat</span>,</span></span>
<span class="r-in"><span> family <span class="op">=</span> <span class="fu"><a href="https://rdrr.io/r/stats/family.html" class="external-link">gaussian</a></span><span class="op">(</span><span class="op">)</span>,</span></span>
<span class="r-in"><span> chains <span class="op">=</span> <span class="fl">2</span><span class="op">)</span></span></span>
@@ -249,37 +249,37 @@ <h2 id="ref-examples">Examples<a class="anchor" aria-label="anchor" href="#ref-e
<span class="r-out co"><span class="r-pr">#></span> Chain 2 Iteration: 100 / 1000 [ 10%] (Warmup) </span>
<span class="r-out co"><span class="r-pr">#></span> Chain 1 Iteration: 100 / 1000 [ 10%] (Warmup) </span>
<span class="r-out co"><span class="r-pr">#></span> Chain 2 Iteration: 200 / 1000 [ 20%] (Warmup) </span>
-<span class="r-out co"><span class="r-pr">#></span> Chain 2 Iteration: 300 / 1000 [ 30%] (Warmup) </span>
<span class="r-out co"><span class="r-pr">#></span> Chain 1 Iteration: 200 / 1000 [ 20%] (Warmup) </span>
-<span class="r-out co"><span class="r-pr">#></span> Chain 2 Iteration: 400 / 1000 [ 40%] (Warmup) </span>
+<span class="r-out co"><span class="r-pr">#></span> Chain 2 Iteration: 300 / 1000 [ 30%] (Warmup) </span>
<span class="r-out co"><span class="r-pr">#></span> Chain 1 Iteration: 300 / 1000 [ 30%] (Warmup) </span>
-<span class="r-out co"><span class="r-pr">#></span> Chain 2 Iteration: 500 / 1000 [ 50%] (Warmup) </span>
+<span class="r-out co"><span class="r-pr">#></span> Chain 2 Iteration: 400 / 1000 [ 40%] (Warmup) </span>
<span class="r-out co"><span class="r-pr">#></span> Chain 1 Iteration: 400 / 1000 [ 40%] (Warmup) </span>
+<span class="r-out co"><span class="r-pr">#></span> Chain 2 Iteration: 500 / 1000 [ 50%] (Warmup) </span>
<span class="r-out co"><span class="r-pr">#></span> Chain 2 Iteration: 501 / 1000 [ 50%] (Sampling) </span>
<span class="r-out co"><span class="r-pr">#></span> Chain 1 Iteration: 500 / 1000 [ 50%] (Warmup) </span>
-<span class="r-out co"><span class="r-pr">#></span> Chain 2 Iteration: 600 / 1000 [ 60%] (Sampling) </span>
<span class="r-out co"><span class="r-pr">#></span> Chain 1 Iteration: 501 / 1000 [ 50%] (Sampling) </span>
-<span class="r-out co"><span class="r-pr">#></span> Chain 2 Iteration: 700 / 1000 [ 70%] (Sampling) </span>
+<span class="r-out co"><span class="r-pr">#></span> Chain 2 Iteration: 600 / 1000 [ 60%] (Sampling) </span>
<span class="r-out co"><span class="r-pr">#></span> Chain 1 Iteration: 600 / 1000 [ 60%] (Sampling) </span>
-<span class="r-out co"><span class="r-pr">#></span> Chain 2 Iteration: 800 / 1000 [ 80%] (Sampling) </span>
+<span class="r-out co"><span class="r-pr">#></span> Chain 2 Iteration: 700 / 1000 [ 70%] (Sampling) </span>
<span class="r-out co"><span class="r-pr">#></span> Chain 1 Iteration: 700 / 1000 [ 70%] (Sampling) </span>
+<span class="r-out co"><span class="r-pr">#></span> Chain 2 Iteration: 800 / 1000 [ 80%] (Sampling) </span>
<span class="r-out co"><span class="r-pr">#></span> Chain 2 Iteration: 900 / 1000 [ 90%] (Sampling) </span>
<span class="r-out co"><span class="r-pr">#></span> Chain 1 Iteration: 800 / 1000 [ 80%] (Sampling) </span>
<span class="r-out co"><span class="r-pr">#></span> Chain 2 Iteration: 1000 / 1000 [100%] (Sampling) </span>
-<span class="r-out co"><span class="r-pr">#></span> Chain 2 finished in 5.1 seconds.</span>
+<span class="r-out co"><span class="r-pr">#></span> Chain 2 finished in 4.6 seconds.</span>
<span class="r-out co"><span class="r-pr">#></span> Chain 1 Iteration: 900 / 1000 [ 90%] (Sampling) </span>
<span class="r-out co"><span class="r-pr">#></span> Chain 1 Iteration: 1000 / 1000 [100%] (Sampling) </span>
-<span class="r-out co"><span class="r-pr">#></span> Chain 1 finished in 6.1 seconds.</span>
+<span class="r-out co"><span class="r-pr">#></span> Chain 1 finished in 5.4 seconds.</span>
<span class="r-out co"><span class="r-pr">#></span> </span>
<span class="r-out co"><span class="r-pr">#></span> Both chains finished successfully.</span>
-<span class="r-out co"><span class="r-pr">#></span> Mean chain execution time: 5.6 seconds.</span>
-<span class="r-out co"><span class="r-pr">#></span> Total execution time: 6.2 seconds.</span>
+<span class="r-out co"><span class="r-pr">#></span> Mean chain execution time: 5.0 seconds.</span>
+<span class="r-out co"><span class="r-pr">#></span> Total execution time: 5.7 seconds.</span>
<span class="r-out co"><span class="r-pr">#></span> </span>
-<span class="r-in"><span><span class="fu">conditional_effects</span><span class="op">(</span><span class="va">mod</span><span class="op">)</span></span></span>
+<span class="r-in"><span><span class="fu"><a href="https://paulbuerkner.com/brms/reference/conditional_effects.brmsfit.html" class="external-link">conditional_effects</a></span><span class="op">(</span><span class="va">mod</span><span class="op">)</span></span></span>
<span class="r-plt img"><img src="conditional_effects.mvgam-7.png" alt="" width="700" height="433"></span>
<span class="r-plt img"><img src="conditional_effects.mvgam-8.png" alt="" width="700" height="433"></span>
<span class="r-plt img"><img src="conditional_effects.mvgam-9.png" alt="" width="700" height="433"></span>
-<span class="r-in"><span><span class="fu">conditional_effects</span><span class="op">(</span><span class="va">mod</span>, conf_level <span class="op">=</span> <span class="fl">0.5</span>, type <span class="op">=</span> <span class="st">'link'</span><span class="op">)</span></span></span>
+<span class="r-in"><span><span class="fu"><a href="https://paulbuerkner.com/brms/reference/conditional_effects.brmsfit.html" class="external-link">conditional_effects</a></span><span class="op">(</span><span class="va">mod</span>, conf_level <span class="op">=</span> <span class="fl">0.5</span>, type <span class="op">=</span> <span class="st">'link'</span><span class="op">)</span></span></span>
<span class="r-plt img"><img src="conditional_effects.mvgam-10.png" alt="" width="700" height="433"></span>
<span class="r-plt img"><img src="conditional_effects.mvgam-11.png" alt="" width="700" height="433"></span>
<span class="r-plt img"><img src="conditional_effects.mvgam-12.png" alt="" width="700" height="433"></span>
@@ -290,13 +290,13 @@ <h2 id="ref-examples">Examples<a class="anchor" aria-label="anchor" href="#ref-e
<span class="r-in"><span></span></span>
<span class="r-in"><span><span class="co"># Simulate some nonlinear data</span></span></span>
<span class="r-in"><span><span class="va">dat</span> <span class="op"><-</span> <span class="fu">mgcv</span><span class="fu">::</span><span class="fu"><a href="https://rdrr.io/pkg/mgcv/man/gamSim.html" class="external-link">gamSim</a></span><span class="op">(</span><span class="fl">1</span>, n <span class="op">=</span> <span class="fl">200</span>, scale <span class="op">=</span> <span class="fl">2</span><span class="op">)</span></span></span>
-<span class="r-in"><span><span class="va">mod</span> <span class="op"><-</span> <span class="fu"><a href="mvgam.html">mvgam</a></span><span class="op">(</span><span class="va">y</span> <span class="op">~</span> <span class="fu">s</span><span class="op">(</span><span class="va">x1</span>, bs <span class="op">=</span> <span class="st">'moi'</span><span class="op">)</span> <span class="op">+</span></span></span>
-<span class="r-in"><span> <span class="fu"><a href="ti.html">te</a></span><span class="op">(</span><span class="va">x0</span>, <span class="va">x2</span><span class="op">)</span>,</span></span>
+<span class="r-in"><span><span class="va">mod</span> <span class="op"><-</span> <span class="fu"><a href="mvgam.html">mvgam</a></span><span class="op">(</span><span class="va">y</span> <span class="op">~</span> <span class="fu"><a href="https://rdrr.io/pkg/mgcv/man/s.html" class="external-link">s</a></span><span class="op">(</span><span class="va">x1</span>, bs <span class="op">=</span> <span class="st">'moi'</span><span class="op">)</span> <span class="op">+</span></span></span>
+<span class="r-in"><span> <span class="fu"><a href="https://rdrr.io/pkg/mgcv/man/te.html" class="external-link">te</a></span><span class="op">(</span><span class="va">x0</span>, <span class="va">x2</span><span class="op">)</span>,</span></span>
<span class="r-in"><span> data <span class="op">=</span> <span class="va">dat</span>,</span></span>
<span class="r-in"><span> family <span class="op">=</span> <span class="fu"><a href="https://rdrr.io/r/stats/family.html" class="external-link">gaussian</a></span><span class="op">(</span><span class="op">)</span><span class="op">)</span></span></span>
<span class="r-in"><span></span></span>
<span class="r-in"><span><span class="co"># Extract the list of ggplot conditional_effect plots</span></span></span>
-<span class="r-in"><span><span class="va">m</span> <span class="op"><-</span> <span class="fu"><a href="https://rdrr.io/r/graphics/plot.default.html" class="external-link">plot</a></span><span class="op">(</span><span class="fu">conditional_effects</span><span class="op">(</span><span class="va">mod</span><span class="op">)</span>, plot <span class="op">=</span> <span class="cn">FALSE</span><span class="op">)</span></span></span>
+<span class="r-in"><span><span class="va">m</span> <span class="op"><-</span> <span class="fu"><a href="https://rdrr.io/r/graphics/plot.default.html" class="external-link">plot</a></span><span class="op">(</span><span class="fu"><a href="https://paulbuerkner.com/brms/reference/conditional_effects.brmsfit.html" class="external-link">conditional_effects</a></span><span class="op">(</span><span class="va">mod</span><span class="op">)</span>, plot <span class="op">=</span> <span class="cn">FALSE</span><span class="op">)</span></span></span>
<span class="r-in"><span></span></span>
<span class="r-in"><span><span class="co"># Add custom labels and arrange plots together using patchwork::wrap_plots()</span></span></span>
<span class="r-in"><span><span class="kw"><a href="https://rdrr.io/r/base/library.html" class="external-link">library</a></span><span class="op">(</span><span class="va"><a href="https://patchwork.data-imaginist.com" class="external-link">patchwork</a></span><span class="op">)</span></span></span>
diff --git a/docs/reference/get_mvgam_priors.html b/docs/reference/get_mvgam_priors.html
index 4d60cda9..fd0f09a7 100644
--- a/docs/reference/get_mvgam_priors.html
+++ b/docs/reference/get_mvgam_priors.html
@@ -72,7 +72,9 @@ <h2 id="ref-usage">Usage<a class="anchor" aria-label="anchor" href="#ref-usage">
<span> <span class="va">factor_formula</span>,</span>
<span> <span class="va">data</span>,</span>
<span> <span class="va">data_train</span>,</span>
-<span> family <span class="op">=</span> <span class="st">"poisson"</span>,</span>
+<span> family <span class="op">=</span> <span class="fu"><a href="https://rdrr.io/r/stats/family.html" class="external-link">poisson</a></span><span class="op">(</span><span class="op">)</span>,</span>
+<span> unit <span class="op">=</span> <span class="va">time</span>,</span>
+<span> species <span class="op">=</span> <span class="va">series</span>,</span>
<span> <span class="va">knots</span>,</span>
<span> <span class="va">trend_knots</span>,</span>
<span> use_lv <span class="op">=</span> <span class="cn">FALSE</span>,</span>
@@ -89,7 +91,7 @@ <h2 id="arguments">Arguments<a class="anchor" aria-label="anchor" href="#argumen
<dl><dt>formula</dt>
<dd><p>A <code>character</code> string specifying the GAM observation model formula. These are exactly like the formula
for a GLM except that smooth terms, <code><a href="https://rdrr.io/pkg/mgcv/man/s.html" class="external-link">s()</a></code>, <code><a href="https://rdrr.io/pkg/mgcv/man/te.html" class="external-link">te()</a></code>, <code><a href="https://rdrr.io/pkg/mgcv/man/te.html" class="external-link">ti()</a></code>, <code><a href="https://rdrr.io/pkg/mgcv/man/t2.html" class="external-link">t2()</a></code>, as well as time-varying
-<code><a href="dynamic.html">dynamic()</a></code> terms and nonparametric <code><a href="https://paul-buerkner.github.io/brms/reference/gp.html" class="external-link">gp()</a></code> terms, can be added to the right hand side
+<code><a href="dynamic.html">dynamic()</a></code> terms and nonparametric <code><a href="https://paulbuerkner.com/brms/reference/gp.html" class="external-link">gp()</a></code> terms, can be added to the right hand side
to specify that the linear predictor depends on smooth functions of predictors
(or linear functionals of these). In <code><a href="mvgam_families.html">nmix()</a></code> family models, the <code>formula</code> is used to
set up a linear predictor for the detection probability. Details of the formula syntax used by <span class="pkg">mvgam</span>
@@ -165,6 +167,21 @@ <h2 id="arguments">Arguments<a class="anchor" aria-label="anchor" href="#argumen
See <code><a href="mvgam_families.html">mvgam_families</a></code> for more details</p></dd>
+<dt>unit</dt>
+<dd><p>The unquoted name of the variable that represents the unit of analysis in <code>data</code> over
+which latent residuals should be correlated. This variable should be either a
+<code>numeric</code> or <code>integer</code> variable in the supplied <code>data</code>.
+Defaults to <code>time</code> to be consistent with other functionalities
+in <span class="pkg">mvgam</span>, though note that the data need not be time series in this case. See examples below
+for further details and explanations</p></dd>
+
+
+<dt>species</dt>
+<dd><p>The unquoted name of the <code>factor</code> variable that indexes
+the different response units in <code>data</code> (usually <code>'species'</code> in a JSDM).
+Defaults to <code>series</code> to be consistent with other <code>mvgam</code> models</p></dd>
+
+
<dt>knots</dt>
<dd><p>An optional <code>list</code> containing user specified knot values to be used for basis construction.
For most bases the user simply supplies the knots to be used, which must match up with the <code>k</code> value supplied
@@ -249,7 +266,7 @@ <h2 id="details">Details<a class="anchor" aria-label="anchor" href="#details"></
This will be necessary if using restrictive distributions on some parameters, such as a Beta distribution
for the trend sd parameters for example (Beta only has support on <code>(0,1)</code>), so the upperbound cannot
be above <code>1</code>. Another option is to make use of the prior modification functions in <code>brms</code>
-(i.e. <code><a href="https://paul-buerkner.github.io/brms/reference/set_prior.html" class="external-link">prior</a></code>) to change prior distributions and bounds (just use the name of the parameter that
+(i.e. <code><a href="https://paulbuerkner.com/brms/reference/set_prior.html" class="external-link">prior</a></code>) to change prior distributions and bounds (just use the name of the parameter that
you'd like to change as the <code>class</code> argument; see examples below)</p>
</div>
<div class="section level2">
@@ -262,7 +279,7 @@ <h2 id="note">Note<a class="anchor" aria-label="anchor" href="#note"></a></h2>
</div>
<div class="section level2">
<h2 id="see-also">See also<a class="anchor" aria-label="anchor" href="#see-also"></a></h2>
- <div class="dont-index"><p><code><a href="mvgam.html">mvgam</a></code>, <code><a href="mvgam_formulae.html">mvgam_formulae</a></code>, <code><a href="https://paul-buerkner.github.io/brms/reference/set_prior.html" class="external-link">prior</a></code></p></div>
+ <div class="dont-index"><p><code><a href="mvgam.html">mvgam</a></code>, <code><a href="mvgam_formulae.html">mvgam_formulae</a></code>, <code><a href="https://paulbuerkner.com/brms/reference/set_prior.html" class="external-link">prior</a></code></p></div>
</div>
<div class="section level2">
<h2 id="author">Author<a class="anchor" aria-label="anchor" href="#author"></a></h2>
@@ -447,13 +464,13 @@ <h2 id="ref-examples">Examples<a class="anchor" aria-label="anchor" href="#ref-e
<span class="r-out co"><span class="r-pr">#></span> 6 trend sd sigma ~ student_t(3, 0, 2.5);</span>
<span class="r-out co"><span class="r-pr">#></span> 7 inverse of NB dispsersion phi_inv ~ student_t(3, 0, 0.1);</span>
<span class="r-out co"><span class="r-pr">#></span> example_change new_lowerbound new_upperbound</span>
-<span class="r-out co"><span class="r-pr">#></span> 1 lambda ~ exponential(0.65); NA NA</span>
-<span class="r-out co"><span class="r-pr">#></span> 2 mu_raw ~ normal(0.92, 1); NA NA</span>
-<span class="r-out co"><span class="r-pr">#></span> 3 sigma_raw ~ exponential(0.57); NA NA</span>
-<span class="r-out co"><span class="r-pr">#></span> 4 ar1 ~ normal(-0.96, 0.9); NA NA</span>
-<span class="r-out co"><span class="r-pr">#></span> 5 ar2 ~ normal(0.5, 0.48); NA NA</span>
-<span class="r-out co"><span class="r-pr">#></span> 6 sigma ~ exponential(0.45); NA NA</span>
-<span class="r-out co"><span class="r-pr">#></span> 7 phi_inv ~ normal(0.71, 0.14); NA NA</span>
+<span class="r-out co"><span class="r-pr">#></span> 1 lambda ~ exponential(0.55); NA NA</span>
+<span class="r-out co"><span class="r-pr">#></span> 2 mu_raw ~ normal(-0.64, 0.64); NA NA</span>
+<span class="r-out co"><span class="r-pr">#></span> 3 sigma_raw ~ exponential(0.45); NA NA</span>
+<span class="r-out co"><span class="r-pr">#></span> 4 ar1 ~ normal(-0.76, 0.29); NA NA</span>
+<span class="r-out co"><span class="r-pr">#></span> 5 ar2 ~ normal(-0.19, 0.8); NA NA</span>
+<span class="r-out co"><span class="r-pr">#></span> 6 sigma ~ exponential(0.93); NA NA</span>
+<span class="r-out co"><span class="r-pr">#></span> 7 phi_inv ~ normal(0.89, 0.89); NA NA</span>
<span class="r-in"><span></span></span>
<span class="r-in"><span><span class="co"># Make a few changes; first, change the population mean for the series-level</span></span></span>
<span class="r-in"><span><span class="co"># random intercepts</span></span></span>
@@ -614,9 +631,9 @@ <h2 id="ref-examples">Examples<a class="anchor" aria-label="anchor" href="#ref-e
<span class="r-in"><span><span class="co"># The same can be done using 'brms' functions; here we will also change the ar1 prior</span></span></span>
<span class="r-in"><span><span class="co"># and put some bounds on the ar coefficients to enforce stationarity; we set the</span></span></span>
<span class="r-in"><span><span class="co"># prior using the 'class' argument in all brms prior functions</span></span></span>
-<span class="r-in"><span><span class="va">brmsprior</span> <span class="op"><-</span> <span class="fu"><a href="https://rdrr.io/r/base/c.html" class="external-link">c</a></span><span class="op">(</span><span class="fu"><a href="https://paul-buerkner.github.io/brms/reference/set_prior.html" class="external-link">prior</a></span><span class="op">(</span><span class="fu">normal</span><span class="op">(</span><span class="fl">0.2</span>, <span class="fl">0.5</span><span class="op">)</span>, class <span class="op">=</span> <span class="va">mu_raw</span><span class="op">)</span>,</span></span>
-<span class="r-in"><span> <span class="fu"><a href="https://paul-buerkner.github.io/brms/reference/set_prior.html" class="external-link">prior</a></span><span class="op">(</span><span class="fu">normal</span><span class="op">(</span><span class="fl">0</span>, <span class="fl">0.25</span><span class="op">)</span>, class <span class="op">=</span> <span class="va">ar1</span>, lb <span class="op">=</span> <span class="op">-</span><span class="fl">1</span>, ub <span class="op">=</span> <span class="fl">1</span><span class="op">)</span>,</span></span>
-<span class="r-in"><span> <span class="fu"><a href="https://paul-buerkner.github.io/brms/reference/set_prior.html" class="external-link">prior</a></span><span class="op">(</span><span class="fu">normal</span><span class="op">(</span><span class="fl">0</span>, <span class="fl">0.25</span><span class="op">)</span>, class <span class="op">=</span> <span class="va">ar2</span>, lb <span class="op">=</span> <span class="op">-</span><span class="fl">1</span>, ub <span class="op">=</span> <span class="fl">1</span><span class="op">)</span><span class="op">)</span></span></span>
+<span class="r-in"><span><span class="va">brmsprior</span> <span class="op"><-</span> <span class="fu"><a href="https://rdrr.io/r/base/c.html" class="external-link">c</a></span><span class="op">(</span><span class="fu"><a href="https://paulbuerkner.com/brms/reference/set_prior.html" class="external-link">prior</a></span><span class="op">(</span><span class="fu">normal</span><span class="op">(</span><span class="fl">0.2</span>, <span class="fl">0.5</span><span class="op">)</span>, class <span class="op">=</span> <span class="va">mu_raw</span><span class="op">)</span>,</span></span>
+<span class="r-in"><span> <span class="fu"><a href="https://paulbuerkner.com/brms/reference/set_prior.html" class="external-link">prior</a></span><span class="op">(</span><span class="fu">normal</span><span class="op">(</span><span class="fl">0</span>, <span class="fl">0.25</span><span class="op">)</span>, class <span class="op">=</span> <span class="va">ar1</span>, lb <span class="op">=</span> <span class="op">-</span><span class="fl">1</span>, ub <span class="op">=</span> <span class="fl">1</span><span class="op">)</span>,</span></span>
+<span class="r-in"><span> <span class="fu"><a href="https://paulbuerkner.com/brms/reference/set_prior.html" class="external-link">prior</a></span><span class="op">(</span><span class="fu">normal</span><span class="op">(</span><span class="fl">0</span>, <span class="fl">0.25</span><span class="op">)</span>, class <span class="op">=</span> <span class="va">ar2</span>, lb <span class="op">=</span> <span class="op">-</span><span class="fl">1</span>, ub <span class="op">=</span> <span class="fl">1</span><span class="op">)</span><span class="op">)</span></span></span>
<span class="r-in"><span><span class="va">brmsprior</span></span></span>
<span class="r-out co"><span class="r-pr">#></span> prior class coef group resp dpar nlpar lb ub source</span>
<span class="r-out co"><span class="r-pr">#></span> normal(0.2, 0.5) mu_raw <NA> <NA> user</span>
@@ -1031,8 +1048,8 @@ <h2 id="ref-examples">Examples<a class="anchor" aria-label="anchor" href="#ref-e
<span class="r-in"><span></span></span>
<span class="r-in"><span><span class="co"># Likewise using 'brms' utilities (note that you can use</span></span></span>
<span class="r-in"><span><span class="co"># Intercept rather than `(Intercept)`) to change priors on the intercept</span></span></span>
-<span class="r-in"><span><span class="va">brmsprior</span> <span class="op"><-</span> <span class="fu"><a href="https://rdrr.io/r/base/c.html" class="external-link">c</a></span><span class="op">(</span><span class="fu"><a href="https://paul-buerkner.github.io/brms/reference/set_prior.html" class="external-link">prior</a></span><span class="op">(</span><span class="fu">normal</span><span class="op">(</span><span class="fl">0.2</span>, <span class="fl">0.5</span><span class="op">)</span>, class <span class="op">=</span> <span class="va">cov</span><span class="op">)</span>,</span></span>
-<span class="r-in"><span> <span class="fu"><a href="https://paul-buerkner.github.io/brms/reference/set_prior.html" class="external-link">prior</a></span><span class="op">(</span><span class="fu">normal</span><span class="op">(</span><span class="fl">0</span>, <span class="fl">0.25</span><span class="op">)</span>, class <span class="op">=</span> <span class="va">Intercept</span><span class="op">)</span><span class="op">)</span></span></span>
+<span class="r-in"><span><span class="va">brmsprior</span> <span class="op"><-</span> <span class="fu"><a href="https://rdrr.io/r/base/c.html" class="external-link">c</a></span><span class="op">(</span><span class="fu"><a href="https://paulbuerkner.com/brms/reference/set_prior.html" class="external-link">prior</a></span><span class="op">(</span><span class="fu">normal</span><span class="op">(</span><span class="fl">0.2</span>, <span class="fl">0.5</span><span class="op">)</span>, class <span class="op">=</span> <span class="va">cov</span><span class="op">)</span>,</span></span>
+<span class="r-in"><span> <span class="fu"><a href="https://paulbuerkner.com/brms/reference/set_prior.html" class="external-link">prior</a></span><span class="op">(</span><span class="fu">normal</span><span class="op">(</span><span class="fl">0</span>, <span class="fl">0.25</span><span class="op">)</span>, class <span class="op">=</span> <span class="va">Intercept</span><span class="op">)</span><span class="op">)</span></span></span>
<span class="r-in"><span><span class="va">brmsprior</span></span></span>
<span class="r-out co"><span class="r-pr">#></span> prior class coef group resp dpar nlpar lb ub source</span>
<span class="r-out co"><span class="r-pr">#></span> normal(0.2, 0.5) cov <NA> <NA> user</span>
@@ -1145,7 +1162,7 @@ <h2 id="ref-examples">Examples<a class="anchor" aria-label="anchor" href="#ref-e
<span class="r-out co"><span class="r-pr">#></span> Gu & Wahba 4 term additive model</span>
<span class="r-in"><span><span class="va">dat</span><span class="op">$</span><span class="va">time</span> <span class="op"><-</span> <span class="fl">1</span><span class="op">:</span><span class="fu"><a href="https://rdrr.io/r/base/nrow.html" class="external-link">NROW</a></span><span class="op">(</span><span class="va">dat</span><span class="op">)</span></span></span>
<span class="r-in"><span><span class="va">mod</span> <span class="op"><-</span> <span class="fu"><a href="mvgam.html">mvgam</a></span><span class="op">(</span><span class="va">y</span> <span class="op">~</span> <span class="va">x0</span> <span class="op">+</span> <span class="va">x1</span> <span class="op">+</span> <span class="fu"><a href="https://rdrr.io/pkg/mgcv/man/s.html" class="external-link">s</a></span><span class="op">(</span><span class="va">x2</span><span class="op">)</span> <span class="op">+</span> <span class="fu"><a href="https://rdrr.io/pkg/mgcv/man/s.html" class="external-link">s</a></span><span class="op">(</span><span class="va">x3</span><span class="op">)</span>,</span></span>
-<span class="r-in"><span> priors <span class="op">=</span> <span class="fu"><a href="https://paul-buerkner.github.io/brms/reference/set_prior.html" class="external-link">prior</a></span><span class="op">(</span><span class="fu">normal</span><span class="op">(</span><span class="fl">0</span>, <span class="fl">0.75</span><span class="op">)</span>, class <span class="op">=</span> <span class="st">'b'</span><span class="op">)</span>,</span></span>
+<span class="r-in"><span> priors <span class="op">=</span> <span class="fu"><a href="https://paulbuerkner.com/brms/reference/set_prior.html" class="external-link">prior</a></span><span class="op">(</span><span class="fu">normal</span><span class="op">(</span><span class="fl">0</span>, <span class="fl">0.75</span><span class="op">)</span>, class <span class="op">=</span> <span class="st">'b'</span><span class="op">)</span>,</span></span>
<span class="r-in"><span> data <span class="op">=</span> <span class="va">dat</span>,</span></span>
<span class="r-in"><span> family <span class="op">=</span> <span class="fu"><a href="https://rdrr.io/r/stats/family.html" class="external-link">gaussian</a></span><span class="op">(</span><span class="op">)</span>,</span></span>
<span class="r-in"><span> run_model <span class="op">=</span> <span class="cn">FALSE</span><span class="op">)</span></span></span>
diff --git a/docs/reference/jsdgam-2.png b/docs/reference/jsdgam-2.png
index efc6dc7d..d1d188ea 100644
Binary files a/docs/reference/jsdgam-2.png and b/docs/reference/jsdgam-2.png differ
diff --git a/docs/reference/jsdgam-3.png b/docs/reference/jsdgam-3.png
index 412a10e0..3ef1fd71 100644
Binary files a/docs/reference/jsdgam-3.png and b/docs/reference/jsdgam-3.png differ
diff --git a/docs/reference/jsdgam-4.png b/docs/reference/jsdgam-4.png
index 324e4867..91d14d7c 100644
Binary files a/docs/reference/jsdgam-4.png and b/docs/reference/jsdgam-4.png differ
diff --git a/docs/reference/jsdgam-5.png b/docs/reference/jsdgam-5.png
index 81a1dace..7d302c4b 100644
Binary files a/docs/reference/jsdgam-5.png and b/docs/reference/jsdgam-5.png differ
diff --git a/docs/reference/jsdgam-6.png b/docs/reference/jsdgam-6.png
index 0fcb184c..b9be5b8d 100644
Binary files a/docs/reference/jsdgam-6.png and b/docs/reference/jsdgam-6.png differ
diff --git a/docs/reference/jsdgam-7.png b/docs/reference/jsdgam-7.png
index 8dffaced..f43fe1b9 100644
Binary files a/docs/reference/jsdgam-7.png and b/docs/reference/jsdgam-7.png differ
diff --git a/docs/reference/jsdgam-8.png b/docs/reference/jsdgam-8.png
index f5d4595f..0cdf6c3f 100644
Binary files a/docs/reference/jsdgam-8.png and b/docs/reference/jsdgam-8.png differ
diff --git a/docs/reference/jsdgam-9.png b/docs/reference/jsdgam-9.png
index 992a60b6..c0c2751c 100644
Binary files a/docs/reference/jsdgam-9.png and b/docs/reference/jsdgam-9.png differ
diff --git a/docs/reference/jsdgam.html b/docs/reference/jsdgam.html
index d619575f..8544be07 100644
--- a/docs/reference/jsdgam.html
+++ b/docs/reference/jsdgam.html
@@ -90,7 +90,7 @@ <h2 id="ref-usage">Usage<a class="anchor" aria-label="anchor" href="#ref-usage">
<span> species <span class="op">=</span> <span class="va">series</span>,</span>
<span> share_obs_params <span class="op">=</span> <span class="cn">FALSE</span>,</span>
<span> <span class="va">priors</span>,</span>
-<span> n_lv <span class="op">=</span> <span class="fl">1</span>,</span>
+<span> n_lv <span class="op">=</span> <span class="fl">2</span>,</span>
<span> chains <span class="op">=</span> <span class="fl">4</span>,</span>
<span> burnin <span class="op">=</span> <span class="fl">500</span>,</span>
<span> samples <span class="op">=</span> <span class="fl">500</span>,</span>
@@ -113,7 +113,7 @@ <h2 id="arguments">Arguments<a class="anchor" aria-label="anchor" href="#argumen
<dl><dt>formula</dt>
<dd><p>A <code>character</code> string specifying the GAM observation model formula. These are exactly like the formula
for a GLM except that smooth terms, <code><a href="https://rdrr.io/pkg/mgcv/man/s.html" class="external-link">s()</a></code>, <code><a href="https://rdrr.io/pkg/mgcv/man/te.html" class="external-link">te()</a></code>, <code><a href="https://rdrr.io/pkg/mgcv/man/te.html" class="external-link">ti()</a></code>, <code><a href="https://rdrr.io/pkg/mgcv/man/t2.html" class="external-link">t2()</a></code>, as well as time-varying
-<code><a href="dynamic.html">dynamic()</a></code> terms and nonparametric <code><a href="https://paul-buerkner.github.io/brms/reference/gp.html" class="external-link">gp()</a></code> terms, can be added to the right hand side
+<code><a href="dynamic.html">dynamic()</a></code> terms and nonparametric <code><a href="https://paulbuerkner.com/brms/reference/gp.html" class="external-link">gp()</a></code> terms, can be added to the right hand side
to specify that the linear predictor depends on smooth functions of predictors
(or linear functionals of these). Details of the formula syntax used by <span class="pkg">mvgam</span>
can be found in <code><a href="mvgam_formulae.html">mvgam_formulae</a></code></p></dd>
@@ -122,7 +122,7 @@ <h2 id="arguments">Arguments<a class="anchor" aria-label="anchor" href="#argumen
<dt>factor_formula</dt>
<dd><p>A <code>character</code> string specifying the linear predictor
effects for the latent factors. Use <code>by = trend</code> within calls to functional terms
-(i.e. <code><a href="https://rdrr.io/pkg/mgcv/man/s.html" class="external-link">s()</a></code>, <code><a href="https://rdrr.io/pkg/mgcv/man/te.html" class="external-link">te()</a></code>, <code><a href="https://rdrr.io/pkg/mgcv/man/te.html" class="external-link">ti()</a></code>, <code><a href="https://rdrr.io/pkg/mgcv/man/t2.html" class="external-link">t2()</a></code>, <code><a href="dynamic.html">dynamic()</a></code>, or <code><a href="https://paul-buerkner.github.io/brms/reference/gp.html" class="external-link">gp()</a></code>) to ensure that each factor
+(i.e. <code><a href="https://rdrr.io/pkg/mgcv/man/s.html" class="external-link">s()</a></code>, <code><a href="https://rdrr.io/pkg/mgcv/man/te.html" class="external-link">te()</a></code>, <code><a href="https://rdrr.io/pkg/mgcv/man/te.html" class="external-link">ti()</a></code>, <code><a href="https://rdrr.io/pkg/mgcv/man/t2.html" class="external-link">t2()</a></code>, <code><a href="dynamic.html">dynamic()</a></code>, or <code><a href="https://paulbuerkner.com/brms/reference/gp.html" class="external-link">gp()</a></code>) to ensure that each factor
captures a different axis of variation. See the example below as an illustration</p></dd>
@@ -197,14 +197,14 @@ <h2 id="arguments">Arguments<a class="anchor" aria-label="anchor" href="#argumen
<dt>priors</dt>
<dd><p>An optional <code>data.frame</code> with prior
definitions (in Stan syntax) or, preferentially, a vector containing
-objects of class <code>brmsprior</code> (see. <code><a href="https://paul-buerkner.github.io/brms/reference/set_prior.html" class="external-link">prior</a></code> for details).
+objects of class <code>brmsprior</code> (see. <code><a href="https://paulbuerkner.com/brms/reference/set_prior.html" class="external-link">prior</a></code> for details).
See <a href="get_mvgam_priors.html">get_mvgam_priors</a> and for more information on changing default prior distributions</p></dd>
<dt>n_lv</dt>
<dd><p><code>integer</code> the number of latent factors to use for modelling
residual associations.
-Cannot be <code>< n_species</code>. Defaults arbitrarily to <code>1</code></p></dd>
+Cannot be <code>> n_species</code>. Defaults arbitrarily to <code>2</code></p></dd>
<dt>chains</dt>
@@ -466,6 +466,7 @@ <h2 id="ref-examples">Examples<a class="anchor" aria-label="anchor" href="#ref-e
<span class="r-in"><span><span class="fu"><a href="https://ggplot2.tidyverse.org/reference/ggplot.html" class="external-link">ggplot</a></span><span class="op">(</span><span class="va">dat</span>, <span class="fu"><a href="https://ggplot2.tidyverse.org/reference/aes.html" class="external-link">aes</a></span><span class="op">(</span>x <span class="op">=</span> <span class="va">lat</span>, y <span class="op">=</span> <span class="va">lon</span>, col <span class="op">=</span> <span class="fu"><a href="https://rdrr.io/r/base/Log.html" class="external-link">log</a></span><span class="op">(</span><span class="va">count</span> <span class="op">+</span> <span class="fl">1</span><span class="op">)</span><span class="op">)</span><span class="op">)</span> <span class="op">+</span></span></span>
<span class="r-in"><span> <span class="fu"><a href="https://ggplot2.tidyverse.org/reference/geom_point.html" class="external-link">geom_point</a></span><span class="op">(</span>size <span class="op">=</span> <span class="fl">2.25</span><span class="op">)</span> <span class="op">+</span></span></span>
<span class="r-in"><span> <span class="fu"><a href="https://ggplot2.tidyverse.org/reference/facet_wrap.html" class="external-link">facet_wrap</a></span><span class="op">(</span><span class="op">~</span> <span class="va">species</span>, scales <span class="op">=</span> <span class="st">'free'</span><span class="op">)</span> <span class="op">+</span></span></span>
+<span class="r-in"><span> <span class="fu"><a href="https://ggplot2.tidyverse.org/reference/scale_viridis.html" class="external-link">scale_color_viridis_c</a></span><span class="op">(</span><span class="op">)</span> <span class="op">+</span></span></span>
<span class="r-in"><span> <span class="fu"><a href="https://ggplot2.tidyverse.org/reference/ggtheme.html" class="external-link">theme_classic</a></span><span class="op">(</span><span class="op">)</span></span></span>
<span class="r-plt img"><img src="jsdgam-2.png" alt="" width="700" height="433"></span>
<span class="r-in"><span></span></span>
@@ -478,13 +479,19 @@ <h2 id="ref-examples">Examples<a class="anchor" aria-label="anchor" href="#ref-e
<span class="r-in"><span></span></span>
<span class="r-in"><span> <span class="co"># Each factor estimates a different nonlinear spatial process, using</span></span></span>
<span class="r-in"><span> <span class="co"># 'by = trend' as in other mvgam State-Space models</span></span></span>
-<span class="r-in"><span> factor_formula <span class="op">=</span> <span class="op">~</span> <span class="fu"><a href="https://rdrr.io/pkg/mgcv/man/te.html" class="external-link">te</a></span><span class="op">(</span><span class="va">lat</span>, <span class="va">lon</span>, k <span class="op">=</span> <span class="fl">5</span>, by <span class="op">=</span> <span class="va">trend</span><span class="op">)</span> <span class="op">-</span> <span class="fl">1</span>,</span></span>
+<span class="r-in"><span> factor_formula <span class="op">=</span> <span class="op">~</span> <span class="fu"><a href="https://paulbuerkner.com/brms/reference/gp.html" class="external-link">gp</a></span><span class="op">(</span><span class="va">lat</span>, <span class="va">lon</span>, k <span class="op">=</span> <span class="fl">6</span>, by <span class="op">=</span> <span class="va">trend</span><span class="op">)</span> <span class="op">-</span> <span class="fl">1</span>,</span></span>
+<span class="r-in"><span> n_lv <span class="op">=</span> <span class="fl">4</span>,</span></span>
<span class="r-in"><span></span></span>
-<span class="r-in"><span> <span class="co"># The data</span></span></span>
+<span class="r-in"><span> <span class="co"># The data and grouping variables</span></span></span>
<span class="r-in"><span> data <span class="op">=</span> <span class="va">dat</span>,</span></span>
+<span class="r-in"><span> unit <span class="op">=</span> <span class="va">site</span>,</span></span>
+<span class="r-in"><span> species <span class="op">=</span> <span class="va">species</span>,</span></span>
<span class="r-in"><span></span></span>
<span class="r-in"><span> <span class="co"># Poisson observations</span></span></span>
<span class="r-in"><span> family <span class="op">=</span> <span class="fu"><a href="https://rdrr.io/r/stats/family.html" class="external-link">poisson</a></span><span class="op">(</span><span class="op">)</span><span class="op">)</span></span></span>
+<span class="r-wrn co"><span class="r-pr">#></span> <span class="warning">Warning: </span>gp effects in mvgam cannot yet handle autogrouping</span>
+<span class="r-wrn co"><span class="r-pr">#></span> resetting all instances of 'gr = TRUE' to 'gr = FALSE'</span>
+<span class="r-wrn co"><span class="r-pr">#></span> <span style="color: #555555;">This warning is displayed once per session.</span></span>
<span class="r-in"><span><span class="fu"><a href="https://rdrr.io/r/utils/head.html" class="external-link">head</a></span><span class="op">(</span><span class="va">priors</span><span class="op">)</span></span></span>
<span class="r-out co"><span class="r-pr">#></span> param_name param_length param_info</span>
<span class="r-out co"><span class="r-pr">#></span> 1 (Intercept) 1 (Intercept)</span>
@@ -518,11 +525,11 @@ <h2 id="ref-examples">Examples<a class="anchor" aria-label="anchor" href="#ref-e
<span class="r-in"><span></span></span>
<span class="r-in"><span> <span class="co"># Each factor estimates a different nonlinear spatial process, using</span></span></span>
<span class="r-in"><span> <span class="co"># 'by = trend' as in other mvgam State-Space models</span></span></span>
-<span class="r-in"><span> factor_formula <span class="op">=</span> <span class="op">~</span> <span class="fu"><a href="https://rdrr.io/pkg/mgcv/man/te.html" class="external-link">te</a></span><span class="op">(</span><span class="va">lat</span>, <span class="va">lon</span>, k <span class="op">=</span> <span class="fl">5</span>, by <span class="op">=</span> <span class="va">trend</span><span class="op">)</span> <span class="op">-</span> <span class="fl">1</span>,</span></span>
+<span class="r-in"><span> factor_formula <span class="op">=</span> <span class="op">~</span> <span class="fu"><a href="https://paulbuerkner.com/brms/reference/gp.html" class="external-link">gp</a></span><span class="op">(</span><span class="va">lat</span>, <span class="va">lon</span>, k <span class="op">=</span> <span class="fl">6</span>, by <span class="op">=</span> <span class="va">trend</span><span class="op">)</span> <span class="op">-</span> <span class="fl">1</span>,</span></span>
<span class="r-in"><span> n_lv <span class="op">=</span> <span class="fl">4</span>,</span></span>
<span class="r-in"><span></span></span>
<span class="r-in"><span> <span class="co"># Change default priors for fixed effect betas to standard normal</span></span></span>
-<span class="r-in"><span> priors <span class="op">=</span> <span class="fu"><a href="https://paul-buerkner.github.io/brms/reference/set_prior.html" class="external-link">prior</a></span><span class="op">(</span><span class="fu">std_normal</span><span class="op">(</span><span class="op">)</span>, class <span class="op">=</span> <span class="va">b</span><span class="op">)</span>,</span></span>
+<span class="r-in"><span> priors <span class="op">=</span> <span class="fu"><a href="https://paulbuerkner.com/brms/reference/set_prior.html" class="external-link">prior</a></span><span class="op">(</span><span class="fu">std_normal</span><span class="op">(</span><span class="op">)</span>, class <span class="op">=</span> <span class="va">b</span><span class="op">)</span>,</span></span>
<span class="r-in"><span></span></span>
<span class="r-in"><span> <span class="co"># The data and the grouping variables</span></span></span>
<span class="r-in"><span> data <span class="op">=</span> <span class="va">dat</span>,</span></span>
@@ -562,52 +569,52 @@ <h2 id="ref-examples">Examples<a class="anchor" aria-label="anchor" href="#ref-e
<span class="r-in"><span><span class="co"># Look at lower and upper credible interval estimates for</span></span></span>
<span class="r-in"><span><span class="co"># some of the estimated correlations</span></span></span>
<span class="r-in"><span><span class="va">post_cors</span><span class="op">$</span><span class="va">cor</span><span class="op">[</span><span class="fl">1</span><span class="op">:</span><span class="fl">5</span>, <span class="fl">1</span><span class="op">:</span><span class="fl">5</span><span class="op">]</span></span></span>
-<span class="r-out co"><span class="r-pr">#></span> species_1 species_2 species_3 species_4 species_5</span>
-<span class="r-out co"><span class="r-pr">#></span> species_1 1.00000000 0.09346475 0.6393271 0.547931 0.1366726</span>
-<span class="r-out co"><span class="r-pr">#></span> species_2 0.09346475 1.00000000 -0.3318063 -0.413929 -0.2074599</span>
-<span class="r-out co"><span class="r-pr">#></span> species_3 0.63932709 -0.33180627 1.0000000 0.682426 0.1883235</span>
-<span class="r-out co"><span class="r-pr">#></span> species_4 0.54793102 -0.41392901 0.6824260 1.000000 -0.3718930</span>
-<span class="r-out co"><span class="r-pr">#></span> species_5 0.13667259 -0.20745989 0.1883235 -0.371893 1.0000000</span>
+<span class="r-out co"><span class="r-pr">#></span> species_1 species_2 species_3 species_4 species_5</span>
+<span class="r-out co"><span class="r-pr">#></span> species_1 1.00000000 0.1176211 0.20284021 0.7149115 0.02147807</span>
+<span class="r-out co"><span class="r-pr">#></span> species_2 0.11762108 1.0000000 0.28705757 0.1398566 -0.36262821</span>
+<span class="r-out co"><span class="r-pr">#></span> species_3 0.20284021 0.2870576 1.00000000 0.5902001 0.06460894</span>
+<span class="r-out co"><span class="r-pr">#></span> species_4 0.71491147 0.1398566 0.59020011 1.0000000 -0.33000602</span>
+<span class="r-out co"><span class="r-pr">#></span> species_5 0.02147807 -0.3626282 0.06460894 -0.3300060 1.00000000</span>
<span class="r-in"><span><span class="va">post_cors</span><span class="op">$</span><span class="va">cor_upper</span><span class="op">[</span><span class="fl">1</span><span class="op">:</span><span class="fl">5</span>, <span class="fl">1</span><span class="op">:</span><span class="fl">5</span><span class="op">]</span></span></span>
-<span class="r-out co"><span class="r-pr">#></span> species_1 species_2 species_3 species_4 species_5</span>
-<span class="r-out co"><span class="r-pr">#></span> species_1 1.0000000 0.525394676 0.9352867 0.893813412 0.6375748</span>
-<span class="r-out co"><span class="r-pr">#></span> species_2 0.5253947 1.000000000 0.2078931 0.004141424 0.1750635</span>
-<span class="r-out co"><span class="r-pr">#></span> species_3 0.9352867 0.207893140 1.0000000 0.908985880 0.6385363</span>
-<span class="r-out co"><span class="r-pr">#></span> species_4 0.8938134 0.004141424 0.9089859 1.000000000 0.1948296</span>
-<span class="r-out co"><span class="r-pr">#></span> species_5 0.6375748 0.175063548 0.6385363 0.194829567 1.0000000</span>
+<span class="r-out co"><span class="r-pr">#></span> species_1 species_2 species_3 species_4 species_5</span>
+<span class="r-out co"><span class="r-pr">#></span> species_1 1.0000000 0.583245184 0.7113219 0.93294467 0.395601978</span>
+<span class="r-out co"><span class="r-pr">#></span> species_2 0.5832452 1.000000000 0.5798091 0.54516480 -0.001248962</span>
+<span class="r-out co"><span class="r-pr">#></span> species_3 0.7113219 0.579809129 1.0000000 0.86106945 0.419129821</span>
+<span class="r-out co"><span class="r-pr">#></span> species_4 0.9329447 0.545164798 0.8610695 1.00000000 0.059537415</span>
+<span class="r-out co"><span class="r-pr">#></span> species_5 0.3956020 -0.001248962 0.4191298 0.05953742 1.000000000</span>
<span class="r-in"><span><span class="va">post_cors</span><span class="op">$</span><span class="va">cor_lower</span><span class="op">[</span><span class="fl">1</span><span class="op">:</span><span class="fl">5</span>, <span class="fl">1</span><span class="op">:</span><span class="fl">5</span><span class="op">]</span></span></span>
<span class="r-out co"><span class="r-pr">#></span> species_1 species_2 species_3 species_4 species_5</span>
-<span class="r-out co"><span class="r-pr">#></span> species_1 1.0000000 -0.4361362 0.2168760 0.1650564 -0.2549159</span>
-<span class="r-out co"><span class="r-pr">#></span> species_2 -0.4361362 1.0000000 -0.7445722 -0.7369653 -0.6293579</span>
-<span class="r-out co"><span class="r-pr">#></span> species_3 0.2168760 -0.7445722 1.0000000 0.2784607 -0.2226831</span>
-<span class="r-out co"><span class="r-pr">#></span> species_4 0.1650564 -0.7369653 0.2784607 1.0000000 -0.7276900</span>
-<span class="r-out co"><span class="r-pr">#></span> species_5 -0.2549159 -0.6293579 -0.2226831 -0.7276900 1.0000000</span>
+<span class="r-out co"><span class="r-pr">#></span> species_1 1.0000000 -0.3118981 -0.1611200 0.3505333 -0.3518977</span>
+<span class="r-out co"><span class="r-pr">#></span> species_2 -0.3118981 1.0000000 -0.2880498 -0.3795321 -0.6485370</span>
+<span class="r-out co"><span class="r-pr">#></span> species_3 -0.1611200 -0.2880498 1.0000000 0.2220808 -0.2949083</span>
+<span class="r-out co"><span class="r-pr">#></span> species_4 0.3505333 -0.3795321 0.2220808 1.0000000 -0.6537141</span>
+<span class="r-out co"><span class="r-pr">#></span> species_5 -0.3518977 -0.6485370 -0.2949083 -0.6537141 1.0000000</span>
<span class="r-in"><span><span class="co"># A quick and dirty plot of the posterior median correlations</span></span></span>
<span class="r-in"><span><span class="fu"><a href="https://rdrr.io/r/graphics/image.html" class="external-link">image</a></span><span class="op">(</span><span class="va">post_cors</span><span class="op">$</span><span class="va">cor</span><span class="op">)</span></span></span>
<span class="r-plt img"><img src="jsdgam-7.png" alt="" width="700" height="433"></span>
<span class="r-in"><span></span></span>
<span class="r-in"><span><span class="co"># Posterior predictive checks and ELPD-LOO can ascertain model fit</span></span></span>
-<span class="r-in"><span><span class="fu"><a href="pp_check.mvgam.html">pp_check</a></span><span class="op">(</span><span class="va">mod</span>, type <span class="op">=</span> <span class="st">"ecdf_overlay_grouped"</span>,</span></span>
+<span class="r-in"><span><span class="fu"><a href="pp_check.mvgam.html">pp_check</a></span><span class="op">(</span><span class="va">mod</span>, type <span class="op">=</span> <span class="st">"pit_ecdf_grouped"</span>,</span></span>
<span class="r-in"><span> group <span class="op">=</span> <span class="st">"species"</span>, ndraws <span class="op">=</span> <span class="fl">100</span><span class="op">)</span></span></span>
<span class="r-plt img"><img src="jsdgam-8.png" alt="" width="700" height="433"></span>
<span class="r-in"><span><span class="fu"><a href="https://mc-stan.org/loo/reference/loo.html" class="external-link">loo</a></span><span class="op">(</span><span class="va">mod</span><span class="op">)</span></span></span>
<span class="r-wrn co"><span class="r-pr">#></span> <span class="warning">Warning: </span>Some Pareto k diagnostic values are too high. See help('pareto-k-diagnostic') for details.</span>
<span class="r-out co"><span class="r-pr">#></span> </span>
-<span class="r-out co"><span class="r-pr">#></span> Computed from 1000 by 600 log-likelihood matrix</span>
+<span class="r-out co"><span class="r-pr">#></span> Computed from 1000 by 600 log-likelihood matrix.</span>
<span class="r-out co"><span class="r-pr">#></span> </span>
<span class="r-out co"><span class="r-pr">#></span> Estimate SE</span>
-<span class="r-out co"><span class="r-pr">#></span> elpd_loo -1953.6 42.3</span>
-<span class="r-out co"><span class="r-pr">#></span> p_loo 367.6 25.2</span>
-<span class="r-out co"><span class="r-pr">#></span> looic 3907.1 84.5</span>
+<span class="r-out co"><span class="r-pr">#></span> elpd_loo -2047.3 43.9</span>
+<span class="r-out co"><span class="r-pr">#></span> p_loo 471.7 29.7</span>
+<span class="r-out co"><span class="r-pr">#></span> looic 4094.6 87.8</span>
<span class="r-out co"><span class="r-pr">#></span> ------</span>
-<span class="r-out co"><span class="r-pr">#></span> Monte Carlo SE of elpd_loo is NA.</span>
+<span class="r-out co"><span class="r-pr">#></span> MCSE of elpd_loo is NA.</span>
+<span class="r-out co"><span class="r-pr">#></span> MCSE and ESS estimates assume MCMC draws (r_eff in [0.0, 1.5]).</span>
<span class="r-out co"><span class="r-pr">#></span> </span>
<span class="r-out co"><span class="r-pr">#></span> Pareto k diagnostic values:</span>
-<span class="r-out co"><span class="r-pr">#></span> Count Pct. Min. n_eff</span>
-<span class="r-out co"><span class="r-pr">#></span> (-Inf, 0.5] (good) 279 46.5% 10 </span>
-<span class="r-out co"><span class="r-pr">#></span> (0.5, 0.7] (ok) 174 29.0% 2 </span>
-<span class="r-out co"><span class="r-pr">#></span> (0.7, 1] (bad) 118 19.7% 1 </span>
-<span class="r-out co"><span class="r-pr">#></span> (1, Inf) (very bad) 29 4.8% 1 </span>
+<span class="r-out co"><span class="r-pr">#></span> Count Pct. Min. ESS</span>
+<span class="r-out co"><span class="r-pr">#></span> (-Inf, 0.67] (good) 371 61.8% 3 </span>
+<span class="r-out co"><span class="r-pr">#></span> (0.67, 1] (bad) 181 30.2% <NA> </span>
+<span class="r-out co"><span class="r-pr">#></span> (1, Inf) (very bad) 48 8.0% <NA> </span>
<span class="r-out co"><span class="r-pr">#></span> See help('pareto-k-diagnostic') for details.</span>
<span class="r-in"><span></span></span>
<span class="r-in"><span><span class="co"># Forecast log(counts) for entire region (site value doesn't matter as long</span></span></span>
@@ -628,6 +635,7 @@ <h2 id="ref-examples">Examples<a class="anchor" aria-label="anchor" href="#ref-e
<span class="r-in"><span><span class="fu"><a href="https://ggplot2.tidyverse.org/reference/ggplot.html" class="external-link">ggplot</a></span><span class="op">(</span><span class="va">newdata</span>, <span class="fu"><a href="https://ggplot2.tidyverse.org/reference/aes.html" class="external-link">aes</a></span><span class="op">(</span>x <span class="op">=</span> <span class="va">lat</span>, y <span class="op">=</span> <span class="va">lon</span>, col <span class="op">=</span> <span class="va">log_count</span><span class="op">)</span><span class="op">)</span> <span class="op">+</span></span></span>
<span class="r-in"><span> <span class="fu"><a href="https://ggplot2.tidyverse.org/reference/geom_point.html" class="external-link">geom_point</a></span><span class="op">(</span>size <span class="op">=</span> <span class="fl">1.5</span><span class="op">)</span> <span class="op">+</span></span></span>
<span class="r-in"><span> <span class="fu"><a href="https://ggplot2.tidyverse.org/reference/facet_wrap.html" class="external-link">facet_wrap</a></span><span class="op">(</span><span class="op">~</span> <span class="va">species</span>, scales <span class="op">=</span> <span class="st">'free'</span><span class="op">)</span> <span class="op">+</span></span></span>
+<span class="r-in"><span> <span class="fu"><a href="https://ggplot2.tidyverse.org/reference/scale_viridis.html" class="external-link">scale_color_viridis_c</a></span><span class="op">(</span><span class="op">)</span> <span class="op">+</span></span></span>
<span class="r-in"><span> <span class="fu"><a href="https://ggplot2.tidyverse.org/reference/ggtheme.html" class="external-link">theme_classic</a></span><span class="op">(</span><span class="op">)</span></span></span>
<span class="r-plt img"><img src="jsdgam-9.png" alt="" width="700" height="433"></span>
<span class="r-in"><span><span class="co"># }</span></span></span>
diff --git a/docs/reference/mvgam_formulae.html b/docs/reference/mvgam_formulae.html
index 715d572c..87de1fd1 100644
--- a/docs/reference/mvgam_formulae.html
+++ b/docs/reference/mvgam_formulae.html
@@ -1,5 +1,5 @@
<!DOCTYPE html>
-<!-- Generated by pkgdown: do not edit by hand --><html lang="en"><head><meta http-equiv="Content-Type" content="text/html; charset=UTF-8"><meta charset="utf-8"><meta http-equiv="X-UA-Compatible" content="IE=edge"><meta name="viewport" content="width=device-width, initial-scale=1, shrink-to-fit=no"><meta name="description" content="Details of formula specifications in mvgam"><title>Details of formula specifications in mvgam — mvgam_formulae • mvgam</title><script src="../deps/jquery-3.6.0/jquery-3.6.0.min.js"></script><meta name="viewport" content="width=device-width, initial-scale=1, shrink-to-fit=no"><link href="../deps/bootstrap-5.3.1/bootstrap.min.css" rel="stylesheet"><script src="../deps/bootstrap-5.3.1/bootstrap.bundle.min.js"></script><!-- Font Awesome icons --><link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/5.12.1/css/all.min.css" integrity="sha256-mmgLkCYLUQbXn0B1SRqzHar6dCnv9oZFPEC1g1cwlkk=" crossorigin="anonymous"><link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/5.12.1/css/v4-shims.min.css" integrity="sha256-wZjR52fzng1pJHwx4aV2AO3yyTOXrcDW7jBpJtTwVxw=" crossorigin="anonymous"><!-- bootstrap-toc --><script src="https://cdn.jsdelivr.net/gh/afeld/bootstrap-toc@v1.0.1/dist/bootstrap-toc.min.js" integrity="sha256-4veVQbu7//Lk5TSmc7YV48MxtMy98e26cf5MrgZYnwo=" crossorigin="anonymous"></script><!-- headroom.js --><script src="https://cdnjs.cloudflare.com/ajax/libs/headroom/0.11.0/headroom.min.js" integrity="sha256-AsUX4SJE1+yuDu5+mAVzJbuYNPHj/WroHuZ8Ir/CkE0=" crossorigin="anonymous"></script><script src="https://cdnjs.cloudflare.com/ajax/libs/headroom/0.11.0/jQuery.headroom.min.js" integrity="sha256-ZX/yNShbjqsohH1k95liqY9Gd8uOiE1S4vZc+9KQ1K4=" crossorigin="anonymous"></script><!-- clipboard.js --><script src="https://cdnjs.cloudflare.com/ajax/libs/clipboard.js/2.0.6/clipboard.min.js" integrity="sha256-inc5kl9MA1hkeYUt+EC3BhlIgyp/2jDIyBLS6k3UxPI=" crossorigin="anonymous"></script><!-- search --><script src="https://cdnjs.cloudflare.com/ajax/libs/fuse.js/6.4.6/fuse.js" integrity="sha512-zv6Ywkjyktsohkbp9bb45V6tEMoWhzFzXis+LrMehmJZZSys19Yxf1dopHx7WzIKxr5tK2dVcYmaCk2uqdjF4A==" crossorigin="anonymous"></script><script src="https://cdnjs.cloudflare.com/ajax/libs/autocomplete.js/0.38.0/autocomplete.jquery.min.js" integrity="sha512-GU9ayf+66Xx2TmpxqJpliWbT5PiGYxpaG8rfnBEk1LL8l1KGkRShhngwdXK1UgqhAzWpZHSiYPc09/NwDQIGyg==" crossorigin="anonymous"></script><script src="https://cdnjs.cloudflare.com/ajax/libs/mark.js/8.11.1/mark.min.js" integrity="sha512-5CYOlHXGh6QpOFA/TeTylKLWfB3ftPsde7AnmhuitiTX4K5SqCLBeKro6sPS8ilsz1Q4NRx3v8Ko2IBiszzdww==" crossorigin="anonymous"></script><!-- pkgdown --><script src="../pkgdown.js"></script><meta property="og:title" content="Details of formula specifications in mvgam — mvgam_formulae"><meta property="og:description" content="Details of formula specifications in mvgam"><!-- mathjax --><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js" integrity="sha256-nvJJv9wWKEm88qvoQl9ekL2J+k/RWIsaSScxxlsrv8k=" crossorigin="anonymous"></script><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/config/TeX-AMS-MML_HTMLorMML.js" integrity="sha256-84DKXVJXs0/F8OTMzX4UR909+jtl4G7SPypPavF+GfA=" crossorigin="anonymous"></script><!--[if lt IE 9]>
+<!-- Generated by pkgdown: do not edit by hand --><html lang="en"><head><meta http-equiv="Content-Type" content="text/html; charset=UTF-8"><meta charset="utf-8"><meta http-equiv="X-UA-Compatible" content="IE=edge"><meta name="viewport" content="width=device-width, initial-scale=1, shrink-to-fit=no"><meta name="description" content="Details of formula specifications in mvgam"><title>Details of formula specifications in mvgam — mvgam_formulae • mvgam</title><script src="../deps/jquery-3.6.0/jquery-3.6.0.min.js"></script><meta name="viewport" content="width=device-width, initial-scale=1, shrink-to-fit=no"><link href="../deps/bootstrap-5.3.1/bootstrap.min.css" rel="stylesheet"><script src="../deps/bootstrap-5.3.1/bootstrap.bundle.min.js"></script><!-- Font Awesome icons --><link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/5.12.1/css/all.min.css" integrity="sha256-mmgLkCYLUQbXn0B1SRqzHar6dCnv9oZFPEC1g1cwlkk=" crossorigin="anonymous"><link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/5.12.1/css/v4-shims.min.css" integrity="sha256-wZjR52fzng1pJHwx4aV2AO3yyTOXrcDW7jBpJtTwVxw=" crossorigin="anonymous"><!-- bootstrap-toc --><script src="https://cdn.jsdelivr.net/gh/afeld/bootstrap-toc@v1.0.1/dist/bootstrap-toc.min.js" integrity="sha256-4veVQbu7//Lk5TSmc7YV48MxtMy98e26cf5MrgZYnwo=" crossorigin="anonymous"></script><!-- headroom.js --><script src="https://cdnjs.cloudflare.com/ajax/libs/headroom/0.11.0/headroom.min.js" integrity="sha256-AsUX4SJE1+yuDu5+mAVzJbuYNPHj/WroHuZ8Ir/CkE0=" crossorigin="anonymous"></script><script src="https://cdnjs.cloudflare.com/ajax/libs/headroom/0.11.0/jQuery.headroom.min.js" integrity="sha256-ZX/yNShbjqsohH1k95liqY9Gd8uOiE1S4vZc+9KQ1K4=" crossorigin="anonymous"></script><!-- clipboard.js --><script src="https://cdnjs.cloudflare.com/ajax/libs/clipboard.js/2.0.6/clipboard.min.js" integrity="sha256-inc5kl9MA1hkeYUt+EC3BhlIgyp/2jDIyBLS6k3UxPI=" crossorigin="anonymous"></script><!-- search --><script src="https://cdnjs.cloudflare.com/ajax/libs/fuse.js/6.4.6/fuse.js" integrity="sha512-zv6Ywkjyktsohkbp9bb45V6tEMoWhzFzXis+LrMehmJZZSys19Yxf1dopHx7WzIKxr5tK2dVcYmaCk2uqdjF4A==" crossorigin="anonymous"></script><script src="https://cdnjs.cloudflare.com/ajax/libs/autocomplete.js/0.38.0/autocomplete.jquery.min.js" integrity="sha512-GU9ayf+66Xx2TmpxqJpliWbT5PiGYxpaG8rfnBEk1LL8l1KGkRShhngwdXK1UgqhAzWpZHSiYPc09/NwDQIGyg==" crossorigin="anonymous"></script><script src="https://cdnjs.cloudflare.com/ajax/libs/mark.js/8.11.1/mark.min.js" integrity="sha512-5CYOlHXGh6QpOFA/TeTylKLWfB3ftPsde7AnmhuitiTX4K5SqCLBeKro6sPS8ilsz1Q4NRx3v8Ko2IBiszzdww==" crossorigin="anonymous"></script><!-- pkgdown --><script src="../pkgdown.js"></script><meta property="og:title" content="Details of formula specifications in mvgam — mvgam_formulae"><meta property="og:description" content="Details of formula specifications in mvgam"><meta property="og:image" content="https://nicholasjclark.github.io/mvgam/logo.png"><!-- mathjax --><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js" integrity="sha256-nvJJv9wWKEm88qvoQl9ekL2J+k/RWIsaSScxxlsrv8k=" crossorigin="anonymous"></script><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/config/TeX-AMS-MML_HTMLorMML.js" integrity="sha256-84DKXVJXs0/F8OTMzX4UR909+jtl4G7SPypPavF+GfA=" crossorigin="anonymous"></script><!--[if lt IE 9]>
<script src="https://oss.maxcdn.com/html5shiv/3.7.3/html5shiv.min.js"></script>
<script src="https://oss.maxcdn.com/respond/1.4.2/respond.min.js"></script>
<![endif]--></head><body>
@@ -10,7 +10,7 @@
<a class="navbar-brand me-2" href="../index.html">mvgam</a>
- <small class="nav-text text-muted me-auto" data-bs-toggle="tooltip" data-bs-placement="bottom" title="">1.1.3</small>
+ <small class="nav-text text-muted me-auto" data-bs-toggle="tooltip" data-bs-placement="bottom" title="">1.1.4</small>
<button class="navbar-toggler" type="button" data-bs-toggle="collapse" data-bs-target="#navbar" aria-controls="navbar" aria-expanded="false" aria-label="Toggle navigation">
@@ -52,7 +52,7 @@
</nav><div class="container template-reference-topic">
<div class="row">
<main id="main" class="col-md-9"><div class="page-header">
- <img src="" class="logo" alt=""><h1>Details of formula specifications in <code>mvgam</code></h1>
+ <img src="../logo.png" class="logo" alt=""><h1>Details of formula specifications in <code>mvgam</code></h1>
<small class="dont-index">Source: <a href="https://github.com/nicholasjclark/mvgam/blob/HEAD/R/mvgam_formulae.R" class="external-link"><code>R/mvgam_formulae.R</code></a></small>
<div class="d-none name"><code>mvgam_formulae.Rd</code></div>
</div>
@@ -77,16 +77,16 @@ <h2 id="details">Details<a class="anchor" aria-label="anchor" href="#details"></
<br><br>
The formulae supplied to <code><a href="mvgam.html">mvgam</a></code> are exactly like those supplied to
<code><a href="https://rdrr.io/r/stats/glm.html" class="external-link">glm</a></code> except that smooth terms,
-<code><a href="https://rdrr.io/pkg/mgcv/man/s.html" class="external-link">s</a></code>,
-<code><a href="https://rdrr.io/pkg/mgcv/man/te.html" class="external-link">te</a></code>,
-<code><a href="https://rdrr.io/pkg/mgcv/man/te.html" class="external-link">ti</a></code> and
-<code><a href="https://rdrr.io/pkg/mgcv/man/t2.html" class="external-link">t2</a></code>,
-time-varying effects using <code><a href="dynamic.html">dynamic</a></code>,
+<code><a href="https://rdrr.io/pkg/mgcv/man/s.html" class="external-link">s()</a></code>,
+<code><a href="https://rdrr.io/pkg/mgcv/man/te.html" class="external-link">te()</a></code>,
+<code><a href="https://rdrr.io/pkg/mgcv/man/te.html" class="external-link">ti()</a></code> and
+<code><a href="https://rdrr.io/pkg/mgcv/man/t2.html" class="external-link">t2()</a></code>,
+time-varying effects using <code><a href="dynamic.html">dynamic()</a></code>,
monotonically increasing (using <code>s(x, bs = 'moi')</code>)
or decreasing splines (using <code>s(x, bs = 'mod')</code>;
see <code><a href="monotonic.html">smooth.construct.moi.smooth.spec</a></code> for
details), as well as
-Gaussian Process functions using <code><a href="https://paul-buerkner.github.io/brms/reference/gp.html" class="external-link">gp</a></code>,
+Gaussian Process functions using <code><a href="https://paulbuerkner.com/brms/reference/gp.html" class="external-link">gp()</a></code>,
can be added to the right hand side (and <code>.</code> is not supported in <code>mvgam</code> formulae).
<br><br>
Further details on specifying different kinds of smooth functions, and how to control their behaviours
@@ -101,7 +101,7 @@ <h2 id="see-also">See also<a class="anchor" aria-label="anchor" href="#see-also"
<code><a href="https://rdrr.io/pkg/mgcv/man/jagam.html" class="external-link">jagam</a></code>,
<code><a href="https://rdrr.io/pkg/mgcv/man/gam.html" class="external-link">gam</a></code>,
<code><a href="https://rdrr.io/pkg/mgcv/man/s.html" class="external-link">s</a></code>,
-<code><a href="https://paul-buerkner.github.io/brms/reference/gp.html" class="external-link">gp</a></code>,
+<code><a href="https://paulbuerkner.com/brms/reference/gp.html" class="external-link">gp</a></code>,
<code><a href="https://rdrr.io/r/stats/formula.html" class="external-link">formula</a></code></p></div>
</div>
<div class="section level2">
diff --git a/docs/reference/mvgam_marginaleffects.html b/docs/reference/mvgam_marginaleffects.html
index 9a53c822..318c8f05 100644
--- a/docs/reference/mvgam_marginaleffects.html
+++ b/docs/reference/mvgam_marginaleffects.html
@@ -70,13 +70,13 @@
<div class="section level2">
<h2 id="ref-usage">Usage<a class="anchor" aria-label="anchor" href="#ref-usage"></a></h2>
<div class="sourceCode"><pre class="sourceCode r"><code><span><span class="co"># S3 method for mvgam</span></span>
-<span><span class="fu"><a href="https://rdrr.io/pkg/marginaleffects/man/get_coef.html" class="external-link">get_coef</a></span><span class="op">(</span><span class="va">model</span>, trend_effects <span class="op">=</span> <span class="cn">FALSE</span>, <span class="va">...</span><span class="op">)</span></span>
+<span><span class="fu">get_coef</span><span class="op">(</span><span class="va">model</span>, trend_effects <span class="op">=</span> <span class="cn">FALSE</span>, <span class="va">...</span><span class="op">)</span></span>
<span></span>
<span><span class="co"># S3 method for mvgam</span></span>
-<span><span class="fu"><a href="https://rdrr.io/pkg/marginaleffects/man/set_coef.html" class="external-link">set_coef</a></span><span class="op">(</span><span class="va">model</span>, <span class="va">coefs</span>, trend_effects <span class="op">=</span> <span class="cn">FALSE</span>, <span class="va">...</span><span class="op">)</span></span>
+<span><span class="fu">set_coef</span><span class="op">(</span><span class="va">model</span>, <span class="va">coefs</span>, trend_effects <span class="op">=</span> <span class="cn">FALSE</span>, <span class="va">...</span><span class="op">)</span></span>
<span></span>
<span><span class="co"># S3 method for mvgam</span></span>
-<span><span class="fu"><a href="https://rdrr.io/pkg/marginaleffects/man/get_vcov.html" class="external-link">get_vcov</a></span><span class="op">(</span><span class="va">model</span>, vcov <span class="op">=</span> <span class="cn">NULL</span>, <span class="va">...</span><span class="op">)</span></span>
+<span><span class="fu">get_vcov</span><span class="op">(</span><span class="va">model</span>, vcov <span class="op">=</span> <span class="cn">NULL</span>, <span class="va">...</span><span class="op">)</span></span>
<span></span>
<span><span class="co"># S3 method for mvgam</span></span>
<span><span class="fu"><a href="https://rdrr.io/pkg/marginaleffects/man/get_predict.html" class="external-link">get_predict</a></span><span class="op">(</span><span class="va">model</span>, <span class="va">newdata</span>, type <span class="op">=</span> <span class="st">"response"</span>, process_error <span class="op">=</span> <span class="cn">FALSE</span>, <span class="va">...</span><span class="op">)</span></span>
diff --git a/docs/reference/pp_check.mvgam.html b/docs/reference/pp_check.mvgam.html
index 79bdb33b..4d44ec86 100644
--- a/docs/reference/pp_check.mvgam.html
+++ b/docs/reference/pp_check.mvgam.html
@@ -1,7 +1,7 @@
<!DOCTYPE html>
<!-- Generated by pkgdown: do not edit by hand --><html lang="en"><head><meta http-equiv="Content-Type" content="text/html; charset=UTF-8"><meta charset="utf-8"><meta http-equiv="X-UA-Compatible" content="IE=edge"><meta name="viewport" content="width=device-width, initial-scale=1, shrink-to-fit=no"><meta name="description" content="Perform unconditional posterior predictive checks with the help
of the bayesplot package."><title>Posterior Predictive Checks for mvgam Objects — pp_check.mvgam • mvgam</title><script src="../deps/jquery-3.6.0/jquery-3.6.0.min.js"></script><meta name="viewport" content="width=device-width, initial-scale=1, shrink-to-fit=no"><link href="../deps/bootstrap-5.3.1/bootstrap.min.css" rel="stylesheet"><script src="../deps/bootstrap-5.3.1/bootstrap.bundle.min.js"></script><!-- Font Awesome icons --><link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/5.12.1/css/all.min.css" integrity="sha256-mmgLkCYLUQbXn0B1SRqzHar6dCnv9oZFPEC1g1cwlkk=" crossorigin="anonymous"><link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/5.12.1/css/v4-shims.min.css" integrity="sha256-wZjR52fzng1pJHwx4aV2AO3yyTOXrcDW7jBpJtTwVxw=" crossorigin="anonymous"><!-- bootstrap-toc --><script src="https://cdn.jsdelivr.net/gh/afeld/bootstrap-toc@v1.0.1/dist/bootstrap-toc.min.js" integrity="sha256-4veVQbu7//Lk5TSmc7YV48MxtMy98e26cf5MrgZYnwo=" crossorigin="anonymous"></script><!-- headroom.js --><script src="https://cdnjs.cloudflare.com/ajax/libs/headroom/0.11.0/headroom.min.js" integrity="sha256-AsUX4SJE1+yuDu5+mAVzJbuYNPHj/WroHuZ8Ir/CkE0=" crossorigin="anonymous"></script><script src="https://cdnjs.cloudflare.com/ajax/libs/headroom/0.11.0/jQuery.headroom.min.js" integrity="sha256-ZX/yNShbjqsohH1k95liqY9Gd8uOiE1S4vZc+9KQ1K4=" crossorigin="anonymous"></script><!-- clipboard.js --><script src="https://cdnjs.cloudflare.com/ajax/libs/clipboard.js/2.0.6/clipboard.min.js" integrity="sha256-inc5kl9MA1hkeYUt+EC3BhlIgyp/2jDIyBLS6k3UxPI=" crossorigin="anonymous"></script><!-- search --><script src="https://cdnjs.cloudflare.com/ajax/libs/fuse.js/6.4.6/fuse.js" integrity="sha512-zv6Ywkjyktsohkbp9bb45V6tEMoWhzFzXis+LrMehmJZZSys19Yxf1dopHx7WzIKxr5tK2dVcYmaCk2uqdjF4A==" crossorigin="anonymous"></script><script src="https://cdnjs.cloudflare.com/ajax/libs/autocomplete.js/0.38.0/autocomplete.jquery.min.js" integrity="sha512-GU9ayf+66Xx2TmpxqJpliWbT5PiGYxpaG8rfnBEk1LL8l1KGkRShhngwdXK1UgqhAzWpZHSiYPc09/NwDQIGyg==" crossorigin="anonymous"></script><script src="https://cdnjs.cloudflare.com/ajax/libs/mark.js/8.11.1/mark.min.js" integrity="sha512-5CYOlHXGh6QpOFA/TeTylKLWfB3ftPsde7AnmhuitiTX4K5SqCLBeKro6sPS8ilsz1Q4NRx3v8Ko2IBiszzdww==" crossorigin="anonymous"></script><!-- pkgdown --><script src="../pkgdown.js"></script><meta property="og:title" content="Posterior Predictive Checks for mvgam Objects — pp_check.mvgam"><meta property="og:description" content="Perform unconditional posterior predictive checks with the help
-of the bayesplot package."><!-- mathjax --><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js" integrity="sha256-nvJJv9wWKEm88qvoQl9ekL2J+k/RWIsaSScxxlsrv8k=" crossorigin="anonymous"></script><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/config/TeX-AMS-MML_HTMLorMML.js" integrity="sha256-84DKXVJXs0/F8OTMzX4UR909+jtl4G7SPypPavF+GfA=" crossorigin="anonymous"></script><!--[if lt IE 9]>
+of the bayesplot package."><meta property="og:image" content="https://nicholasjclark.github.io/mvgam/logo.png"><!-- mathjax --><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js" integrity="sha256-nvJJv9wWKEm88qvoQl9ekL2J+k/RWIsaSScxxlsrv8k=" crossorigin="anonymous"></script><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/config/TeX-AMS-MML_HTMLorMML.js" integrity="sha256-84DKXVJXs0/F8OTMzX4UR909+jtl4G7SPypPavF+GfA=" crossorigin="anonymous"></script><!--[if lt IE 9]>
<script src="https://oss.maxcdn.com/html5shiv/3.7.3/html5shiv.min.js"></script>
<script src="https://oss.maxcdn.com/respond/1.4.2/respond.min.js"></script>
<![endif]--></head><body>
@@ -12,7 +12,7 @@
<a class="navbar-brand me-2" href="../index.html">mvgam</a>
- <small class="nav-text text-muted me-auto" data-bs-toggle="tooltip" data-bs-placement="bottom" title="">1.1.3</small>
+ <small class="nav-text text-muted me-auto" data-bs-toggle="tooltip" data-bs-placement="bottom" title="">1.1.4</small>
<button class="navbar-toggler" type="button" data-bs-toggle="collapse" data-bs-target="#navbar" aria-controls="navbar" aria-expanded="false" aria-label="Toggle navigation">
@@ -54,7 +54,7 @@
</nav><div class="container template-reference-topic">
<div class="row">
<main id="main" class="col-md-9"><div class="page-header">
- <img src="" class="logo" alt=""><h1>Posterior Predictive Checks for <code>mvgam</code> Objects</h1>
+ <img src="../logo.png" class="logo" alt=""><h1>Posterior Predictive Checks for <code>mvgam</code> Objects</h1>
<small class="dont-index">Source: <a href="https://github.com/nicholasjclark/mvgam/blob/HEAD/R/ppc.mvgam.R" class="external-link"><code>R/ppc.mvgam.R</code></a></small>
<div class="d-none name"><code>pp_check.mvgam.Rd</code></div>
</div>
@@ -102,7 +102,7 @@ <h2 id="arguments">Arguments<a class="anchor" aria-label="anchor" href="#argumen
<dt>prefix</dt>
-<dd><p>The prefix of the <span class="pkg">bayesplot</span> function to be applied.
+<dd><p>The prefix of the <span class="pkg">bayesplot</span> function to be applied.
Either `"ppc"` (posterior predictive check; the default)
or `"ppd"` (posterior predictive distribution), the latter being the same
as the former except that the observed data is not shown for `"ppd"`.</p></dd>
diff --git a/man/conditional_effects.mvgam.Rd b/man/conditional_effects.mvgam.Rd
index 9e06fce9..033ce644 100644
--- a/man/conditional_effects.mvgam.Rd
+++ b/man/conditional_effects.mvgam.Rd
@@ -10,8 +10,8 @@
x,
effects = NULL,
type = "response",
- points = TRUE,
- rug = TRUE,
+ points = FALSE,
+ rug = FALSE,
...
)
diff --git a/man/figures/README-unnamed-chunk-12-1.png b/man/figures/README-unnamed-chunk-12-1.png
index e0eee0be..b5e3e961 100644
Binary files a/man/figures/README-unnamed-chunk-12-1.png and b/man/figures/README-unnamed-chunk-12-1.png differ
diff --git a/man/figures/README-unnamed-chunk-13-1.png b/man/figures/README-unnamed-chunk-13-1.png
index 1df164e6..e325041e 100644
Binary files a/man/figures/README-unnamed-chunk-13-1.png and b/man/figures/README-unnamed-chunk-13-1.png differ
diff --git a/man/figures/README-unnamed-chunk-14-1.png b/man/figures/README-unnamed-chunk-14-1.png
index 7db3e62e..91033d46 100644
Binary files a/man/figures/README-unnamed-chunk-14-1.png and b/man/figures/README-unnamed-chunk-14-1.png differ
diff --git a/man/figures/README-unnamed-chunk-15-1.png b/man/figures/README-unnamed-chunk-15-1.png
index 169cd0c0..9f83f458 100644
Binary files a/man/figures/README-unnamed-chunk-15-1.png and b/man/figures/README-unnamed-chunk-15-1.png differ
diff --git a/man/figures/README-unnamed-chunk-16-1.png b/man/figures/README-unnamed-chunk-16-1.png
index 990b42ad..8231119b 100644
Binary files a/man/figures/README-unnamed-chunk-16-1.png and b/man/figures/README-unnamed-chunk-16-1.png differ
diff --git a/man/figures/README-unnamed-chunk-17-1.png b/man/figures/README-unnamed-chunk-17-1.png
index 28deb72c..4a971903 100644
Binary files a/man/figures/README-unnamed-chunk-17-1.png and b/man/figures/README-unnamed-chunk-17-1.png differ
diff --git a/man/figures/README-unnamed-chunk-18-1.png b/man/figures/README-unnamed-chunk-18-1.png
index 2a08d25f..a2b1e711 100644
Binary files a/man/figures/README-unnamed-chunk-18-1.png and b/man/figures/README-unnamed-chunk-18-1.png differ
diff --git a/man/figures/README-unnamed-chunk-19-1.png b/man/figures/README-unnamed-chunk-19-1.png
index cd916723..e5883cbe 100644
Binary files a/man/figures/README-unnamed-chunk-19-1.png and b/man/figures/README-unnamed-chunk-19-1.png differ
diff --git a/man/figures/README-unnamed-chunk-20-1.png b/man/figures/README-unnamed-chunk-20-1.png
index d4df7d24..5e58ff12 100644
Binary files a/man/figures/README-unnamed-chunk-20-1.png and b/man/figures/README-unnamed-chunk-20-1.png differ
diff --git a/man/figures/README-unnamed-chunk-21-1.png b/man/figures/README-unnamed-chunk-21-1.png
index 6941b175..b251373b 100644
Binary files a/man/figures/README-unnamed-chunk-21-1.png and b/man/figures/README-unnamed-chunk-21-1.png differ
diff --git a/man/figures/README-unnamed-chunk-22-1.png b/man/figures/README-unnamed-chunk-22-1.png
index 65bfd5d8..39a45f84 100644
Binary files a/man/figures/README-unnamed-chunk-22-1.png and b/man/figures/README-unnamed-chunk-22-1.png differ
diff --git a/man/figures/README-unnamed-chunk-23-1.png b/man/figures/README-unnamed-chunk-23-1.png
index 93bd98c2..45f29500 100644
Binary files a/man/figures/README-unnamed-chunk-23-1.png and b/man/figures/README-unnamed-chunk-23-1.png differ
diff --git a/man/figures/README-unnamed-chunk-24-1.png b/man/figures/README-unnamed-chunk-24-1.png
index 5084c5d1..3f3e38ae 100644
Binary files a/man/figures/README-unnamed-chunk-24-1.png and b/man/figures/README-unnamed-chunk-24-1.png differ
diff --git a/man/get_mvgam_priors.Rd b/man/get_mvgam_priors.Rd
index 800e1dde..59c280cd 100644
--- a/man/get_mvgam_priors.Rd
+++ b/man/get_mvgam_priors.Rd
@@ -10,7 +10,9 @@ get_mvgam_priors(
factor_formula,
data,
data_train,
- family = "poisson",
+ family = poisson(),
+ unit = time,
+ species = series,
knots,
trend_knots,
use_lv = FALSE,
@@ -94,6 +96,17 @@ Note that only \code{nb()} and \code{poisson()} are available if using \code{JAG
Default is \code{poisson()}.
See \code{\link{mvgam_families}} for more details}
+\item{unit}{The unquoted name of the variable that represents the unit of analysis in \code{data} over
+which latent residuals should be correlated. This variable should be either a
+\code{numeric} or \code{integer} variable in the supplied \code{data}.
+Defaults to \code{time} to be consistent with other functionalities
+in \pkg{mvgam}, though note that the data need not be time series in this case. See examples below
+for further details and explanations}
+
+\item{species}{The unquoted name of the \code{factor} variable that indexes
+the different response units in \code{data} (usually \code{'species'} in a JSDM).
+Defaults to \code{series} to be consistent with other \code{mvgam} models}
+
\item{knots}{An optional \code{list} containing user specified knot values to be used for basis construction.
For most bases the user simply supplies the knots to be used, which must match up with the \code{k} value supplied
(note that the number of knots is not always just \code{k}). Different terms can use different numbers of knots,
diff --git a/man/jsdgam.Rd b/man/jsdgam.Rd
index 066d71a3..742e719d 100644
--- a/man/jsdgam.Rd
+++ b/man/jsdgam.Rd
@@ -16,7 +16,7 @@ jsdgam(
species = series,
share_obs_params = FALSE,
priors,
- n_lv = 1,
+ n_lv = 2,
chains = 4,
burnin = 500,
samples = 500,
@@ -107,7 +107,7 @@ See \link{get_mvgam_priors} and for more information on changing default prior d
\item{n_lv}{\code{integer} the number of latent factors to use for modelling
residual associations.
-Cannot be \verb{< n_species}. Defaults arbitrarily to \code{1}}
+Cannot be \verb{> n_species}. Defaults arbitrarily to \code{2}}
\item{chains}{\code{integer} specifying the number of parallel chains for the model. Ignored
if \code{algorithm \%in\% c('meanfield', 'fullrank', 'pathfinder', 'laplace')}}
@@ -325,6 +325,7 @@ ggplot(dat, aes(x = count)) +
ggplot(dat, aes(x = lat, y = lon, col = log(count + 1))) +
geom_point(size = 2.25) +
facet_wrap(~ species, scales = 'free') +
+ scale_color_viridis_c() +
theme_classic()
# Inspect default priors for a joint species model with spatial factors
@@ -336,10 +337,13 @@ priors <- get_mvgam_priors(formula = count ~
# Each factor estimates a different nonlinear spatial process, using
# 'by = trend' as in other mvgam State-Space models
- factor_formula = ~ te(lat, lon, k = 5, by = trend) - 1,
+ factor_formula = ~ gp(lat, lon, k = 6, by = trend) - 1,
+ n_lv = 4,
- # The data
+ # The data and grouping variables
data = dat,
+ unit = site,
+ species = species,
# Poisson observations
family = poisson())
@@ -355,7 +359,7 @@ mod <- jsdgam(formula = count ~
# Each factor estimates a different nonlinear spatial process, using
# 'by = trend' as in other mvgam State-Space models
- factor_formula = ~ te(lat, lon, k = 5, by = trend) - 1,
+ factor_formula = ~ gp(lat, lon, k = 6, by = trend) - 1,
n_lv = 4,
# Change default priors for fixed effect betas to standard normal
@@ -399,7 +403,7 @@ post_cors$cor_lower[1:5, 1:5]
image(post_cors$cor)
# Posterior predictive checks and ELPD-LOO can ascertain model fit
-pp_check(mod, type = "ecdf_overlay_grouped",
+pp_check(mod, type = "pit_ecdf_grouped",
group = "species", ndraws = 100)
loo(mod)
@@ -421,6 +425,7 @@ newdata$log_count <- preds[,1]
ggplot(newdata, aes(x = lat, y = lon, col = log_count)) +
geom_point(size = 1.5) +
facet_wrap(~ species, scales = 'free') +
+ scale_color_viridis_c() +
theme_classic()
}
}
diff --git a/man/mvgam_marginaleffects.Rd b/man/mvgam_marginaleffects.Rd
index 16e6648e..5564cfdb 100644
--- a/man/mvgam_marginaleffects.Rd
+++ b/man/mvgam_marginaleffects.Rd
@@ -86,8 +86,6 @@ arguments.}
\item \code{newdata = datagrid(cyl = c(4, 6))}: \code{cyl} variable equal to 4 and 6 and other regressors fixed at their means or modes.
\item See the Examples section and the \code{\link[marginaleffects:datagrid]{datagrid()}} documentation.
}
-\item \code{\link[=subset]{subset()}} call with a single argument to select a subset of the dataset used to fit the model, ex: \code{newdata = subset(treatment == 1)}
-\item \code{\link[dplyr:filter]{dplyr::filter()}} call with a single argument to select a subset of the dataset used to fit the model, ex: \code{newdata = filter(treatment == 1)}
\item string:
\itemize{
\item "mean": Marginal Effects at the Mean. Slopes when each predictor is held at its mean or mode.
diff --git a/man/pp_check.mvgam.Rd b/man/pp_check.mvgam.Rd
index 49c76d28..b2488384 100644
--- a/man/pp_check.mvgam.Rd
+++ b/man/pp_check.mvgam.Rd
@@ -31,7 +31,7 @@ If \code{NULL} all draws are used. If not specified,
the number of posterior draws is chosen automatically.
Ignored if \code{draw_ids} is not \code{NULL}.}
-\item{prefix}{The prefix of the \pkg{bayesplot} function to be applied.
+\item{prefix}{The prefix of the \pkg{bayesplot} function to be applied.
Either `"ppc"` (posterior predictive check; the default)
or `"ppd"` (posterior predictive distribution), the latter being the same
as the former except that the observed data is not shown for `"ppd"`.}
diff --git a/man/residual_cor.jsdgam.Rd b/man/residual_cor.jsdgam.Rd
index e01dbeb4..d5a3b138 100644
--- a/man/residual_cor.jsdgam.Rd
+++ b/man/residual_cor.jsdgam.Rd
@@ -31,31 +31,28 @@ function. Only used if \code{summary} is \code{TRUE}.}
}
\value{
If \code{summary = TRUE}, a \code{list} with the following components:
-\itemize{
-\item{cor, cor_lower, cor_upper}{: A set of \eqn{p \times p} correlation matrices,
+\item{cor, cor_lower, cor_upper}{A set of \eqn{p \times p} correlation matrices,
containing either the posterior median or mean estimate, plus lower and upper limits
of the corresponding credible intervals supplied to \code{probs}}
-\item{sig_cor}{: A \eqn{p \times p} correlation matrix containing only those correlations whose credible
+\item{sig_cor}{A \eqn{p \times p} correlation matrix containing only those correlations whose credible
interval does not contain zero. All other correlations are set to zero}
-\item{prec, prec_lower, prec_upper}{: A set of \eqn{p \times p} precision matrices,
+\item{prec, prec_lower, prec_upper}{A set of \eqn{p \times p} precision matrices,
containing either the posterior median or mean estimate, plus lower and upper limits
of the corresponding credible intervals supplied to \code{probs}}
-\item{sig_prec}{: A \eqn{p \times p} precision matrix containing only those precisions whose credible
+\item{sig_prec}{A \eqn{p \times p} precision matrix containing only those precisions whose credible
interval does not contain zero. All other precisions are set to zero}
-\item{cov}{: A \eqn{p \times p} posterior median or mean covariance matrix}
-\item{trace}{: The median/mean point estimator of the trace (sum of the diagonal elements)
+\item{cov}{A \eqn{p \times p} posterior median or mean covariance matrix}
+\item{trace}{The median/mean point estimator of the trace (sum of the diagonal elements)
of the residual covariance matrix \code{cov}}
-}
+
If \code{summary = FALSE}, this function returns a \code{list} containing the following components:
-\itemize{
-\item{all_cormat}{: A \eqn{n_{draws} \times p \times p} \code{array} of posterior
+\item{all_cormat}{A \eqn{n_{draws} \times p \times p} \code{array} of posterior
residual correlation matrix draws}
-\item{all_covmat}{: A \eqn{n_{draws} \times p \times p} \code{array} of posterior
+\item{all_covmat}{A \eqn{n_{draws} \times p \times p} \code{array} of posterior
residual covariance matrix draws}
-\item{all_presmat}{: A \eqn{n_{draws} \times p \times p} \code{array} of posterior
+\item{all_presmat}{A \eqn{n_{draws} \times p \times p} \code{array} of posterior
residual precision matrix draws}
-\item{all_trace}{: A \eqn{n_{draws}} \code{vector} of posterior covariance trace draws}
-}
+\item{all_trace}{A \eqn{n_{draws}} \code{vector} of posterior covariance trace draws}
}
\description{
Compute residual correlation estimates from Joint Species Distribution
diff --git a/src/RcppExports.o b/src/RcppExports.o
index 03b01119..5cf5ae21 100644
Binary files a/src/RcppExports.o and b/src/RcppExports.o differ
diff --git a/src/trend_funs.o b/src/trend_funs.o
index 1c0d5a8f..e09f58e3 100644
Binary files a/src/trend_funs.o and b/src/trend_funs.o differ
diff --git a/tests/testthat/Rplots.pdf b/tests/testthat/Rplots.pdf
index e89b3ba5..f765162d 100644
Binary files a/tests/testthat/Rplots.pdf and b/tests/testthat/Rplots.pdf differ
diff --git a/tests/testthat/test-RW.R b/tests/testthat/test-RW.R
index c1cf8340..98925bf2 100644
--- a/tests/testthat/test-RW.R
+++ b/tests/testthat/test-RW.R
@@ -77,7 +77,7 @@ test_that("VARMAs are set up correctly", {
varma$model_file, fixed = TRUE)))
varma <- mvgam(y ~ s(series, bs = 're'),
- trend_formula = ~ gp(time, by = trend, c = 5/4),
+ trend_formula = ~ gp(time, by = trend, c = 5/4, k = 15),
trend_model = VAR(ma = TRUE),
data = gaus_data$data_train,
family = gaussian(),
diff --git a/tests/testthat/test-binomial.R b/tests/testthat/test-binomial.R
index 9d3ef5ef..a32dcfdf 100644
--- a/tests/testthat/test-binomial.R
+++ b/tests/testthat/test-binomial.R
@@ -34,7 +34,7 @@ dat_test <- dat %>%
test_that("cbind() syntax required for binomial()", {
# Initial warning should be issued when calling binomial or beta-binomial
- expect_warning(mvgam(cbind(y, ntrials) ~ s(series, bs = 're') +
+ expect_warning(mvgam(formula = cbind(y, ntrials) ~ s(series, bs = 're') +
gp(x, by = series, c = 5/4, k = 5),
family = binomial(),
data = dat_train,
@@ -266,7 +266,7 @@ test_that("bernoulli() behaves appropriately", {
# Also with a trend_formula
mod <- mvgam(y ~ series,
- trend_formula = ~ gp(x, by = trend, c = 5/4),
+ trend_formula = ~ gp(x, by = trend, c = 5/4, k = 5),
trend_model = AR(),
family = bernoulli(),
data = dat_train,
diff --git a/tests/testthat/test-dynamic.R b/tests/testthat/test-dynamic.R
index f6a44201..c89c354a 100644
--- a/tests/testthat/test-dynamic.R
+++ b/tests/testthat/test-dynamic.R
@@ -108,13 +108,13 @@ test_that("dynamic to Hilbert works for trend_formulas", {
# Model file should have prior lines for observationgp terms
expect_true(any(grepl('// prior for gp(time):random...',
mod$model_file, fixed = TRUE)))
- expect_true(any(grepl("b[b_idx_gp_time_byrandom] = sqrt(spd_cov_exp_quad(",
+ expect_true(any(grepl("b[b_idx_gp_time_byrandom] = sqrt(spd_gp_exp_quad(",
mod$model_file, fixed = TRUE)))
# Model file should have prior lines for trend gp terms
expect_true(any(grepl('// prior for gp(time):random_trend...',
mod$model_file, fixed = TRUE)))
- expect_true(any(grepl("b_trend[b_trend_idx_gp_time_byrandom] = sqrt(spd_cov_exp_quad(",
+ expect_true(any(grepl("b_trend[b_trend_idx_gp_time_byrandom] = sqrt(spd_gp_exp_quad(",
mod$model_file, fixed = TRUE)))
# Observation-level Gp data structures should be in the model_data
diff --git a/tests/testthat/test-gp.R b/tests/testthat/test-gp.R
index 3a5c6673..0329cb68 100644
--- a/tests/testthat/test-gp.R
+++ b/tests/testthat/test-gp.R
@@ -2,37 +2,107 @@ context("gp")
skip_on_cran()
-test_that("gp_to_s is working properly", {
+test_that("gp_to_s is working properly for unidimensional gps", {
# All true gp() terms should be changed to s() with k = k+1
- formula <- y ~ s(series) + gp(banana) +
- infect:you + gp(hardcourt)
+ formula <- y ~ s(series) + gp(banana, k = 3, scale = FALSE) +
+ infect:you + gp(hardcourt, k = 3)
+ dat <- data.frame(y = rnorm(10),
+ series = rnorm(10),
+ banana = rnorm(10),
+ infect = rnorm(10),
+ you = rnorm(10),
+ hardcourt = rnorm(10),
+ gp = rnorm(10))
- expect_equal(attr(terms(mvgam:::gp_to_s(formula), keep.order = TRUE),
+ # Check that the brms_mock formula is correctly remade
+ gp_atts <- mvgam:::get_gp_attributes(formula,
+ data = dat,
+ family = gaussian())
+
+ # scale should be passed; gr is always false and cmc is always true
+ expect_true(identical(
+ attr(terms(attr(gp_atts, 'gp_formula')),
+ 'term.labels')[1],
+ "gp(banana, k = 3, cov = \"exp_quad\", iso = TRUE, scale = FALSE, c = 1.25, gr = FALSE, cmc = TRUE)")
+ )
+
+ expect_true(identical(
+ attr(terms(attr(gp_atts, 'gp_formula')),
+ 'term.labels')[2],
+ "gp(hardcourt, k = 3, cov = \"exp_quad\", iso = TRUE, scale = TRUE, c = 1.25, gr = FALSE, cmc = TRUE)")
+ )
+
+ expect_equal(attr(terms(mvgam:::gp_to_s(formula,
+ data = dat,
+ family = gaussian()),
+ keep.order = TRUE),
'term.labels'),
attr(terms(formula(y ~ s(series) +
- s(banana, k = 11) +
+ s(banana, k = 4) +
infect:you +
- s(hardcourt, k = 11)),
+ s(hardcourt, k = 4)),
keep.order = TRUE),
'term.labels'))
# Characters that match to 'gp' should not be changed
- formula <- y ~ gp(starwars) + s(gp)
- expect_equal(attr(terms(mvgam:::gp_to_s(formula), keep.order = TRUE),
+ formula <- y ~ gp(hardcourt, k = 3) + s(gp, k = 3)
+ expect_equal(attr(terms(mvgam:::gp_to_s(formula,
+ data = dat,
+ family = gaussian()), keep.order = TRUE),
'term.labels'),
- attr(terms(formula(y ~ s(starwars, k = 11) + s(gp)),
+ attr(terms(formula(y ~ s(hardcourt, k = 4) + s(gp, k = 3)),
keep.order = TRUE),
'term.labels'))
})
-test_that("gp for observation models working properly", {
- mod <- mvgam(y ~ s(series, bs = 're') +
- gp(time, by = series) +
+test_that("gp_to_s is working properly for multidimensional gps", {
+ # All true gp() terms should be changed to s() with k = k+1
+ formula <- y ~ s(series) + gp(banana, hardcourt, k = 3, iso = FALSE,
+ c = 1.33, cov = 'matern52') +
+ infect:you
+ dat <- data.frame(y = rnorm(10),
+ series = rnorm(10),
+ banana = rnorm(10),
+ infect = rnorm(10),
+ you = rnorm(10),
+ hardcourt = rnorm(10),
+ gp = rnorm(10))
+ gp_atts <- mvgam:::get_gp_attributes(formula,
+ data = dat,
+ family = gaussian())
+
+ expect_true(identical(
+ attr(terms(attr(gp_atts, 'gp_formula')),
+ 'term.labels')[1],
+ "gp(banana, hardcourt, k = 3, cov = \"matern52\", iso = FALSE, scale = TRUE, c = 1.33, gr = FALSE, cmc = TRUE)")
+ )
+
+ expect_equal(attr(terms(mvgam:::gp_to_s(formula,
+ data = dat,
+ family = gaussian()),
+ keep.order = TRUE),
+ 'term.labels'),
+ attr(terms(formula(y ~ s(series) +
+ ti(banana, hardcourt, k = 3, mc = c(0,0)) +
+ infect:you),
+ keep.order = TRUE),
+ 'term.labels'))
+})
+
+test_that("unidimensional gp for observation models working properly", {
+ gaus_data$data_train$y[is.na(gaus_data$data_train$y)] <- 0
+ mod <- mvgam(formula = y ~ s(series, bs = 're') +
+ gp(time, by = series, k = 10, c = 5/4) +
year:season,
data = gaus_data$data_train,
family = gaussian(),
run_model = FALSE)
+ expect_true(
+ any(grepl('b[b_idx_gp_time_byseriesseries_3] = sqrt(spd_gp_exp_quad(l_gp_time_byseriesseries_3',
+ mod$model_file, fixed = TRUE))
+ )
+
# Gp data structures should be in the model_data
expect_true("l_gp_time_byseriesseries_1" %in% names(mod$model_data))
expect_true("b_idx_gp_time_byseriesseries_1" %in% names(mod$model_data))
@@ -47,8 +117,8 @@ test_that("gp for observation models working properly", {
data = gaus_data$data_train,
family = gaussian()))
# Eigenvalues should be identical
- all.equal(as.vector(brms_dat$slambda_1_1),
- mod$model_data$l_gp_time_byseriesseries_1)
+ expect_true(all.equal(as.vector(brms_dat$slambda_1_1),
+ as.vector(mod$model_data$l_gp_time_byseriesseries_1)))
# Eigenfunctions will be nearly identical
row_s1 <- which(gaus_data$data_train$series == 'series_1' &
@@ -59,8 +129,9 @@ test_that("gp for observation models working properly", {
expect_true(identical(dim(brms_dat$Xgp_1_1),
dim(mod$model_data$X[row_s1,col_s1])))
- expect_true(max(abs(brms_dat$Xgp_1_1 -
- mod$model_data$X[row_s1,col_s1])) < 0.5)
+ expect_true(all(unlist(lapply(seq_len(NCOL(brms_dat$Xgp_1_1)), function(x){
+ cor(brms_dat$Xgp_1_1[,x], mod$model_data$X[row_s1,col_s1][,x])
+ }), use.names = FALSE) > 0.99))
# The mgcv model formula should contain s() in place of gp()
expect_equal(attr(terms(mod$mgcv_model$formula, keep.order = TRUE),
@@ -72,12 +143,62 @@ test_that("gp for observation models working properly", {
'term.labels'))
})
+test_that("multidimensional gp for observation models working properly", {
+ gaus_data$data_train$y[is.na(gaus_data$data_train$y)] <- 0
+ mod <- mvgam(y ~ s(series, bs = 're') +
+ gp(time, year, k = 4, cov = 'matern32'),
+ data = gaus_data$data_train,
+ family = gaussian(),
+ run_model = FALSE)
+
+ expect_true(
+ any(grepl('b[b_idx_gp_timeby_year_] = sqrt(spd_gp_matern32(l_gp_timeby_year_',
+ mod$model_file, fixed = TRUE))
+ )
+
+ # Gp data structures should be in the model_data
+ expect_true("l_gp_timeby_year_" %in% names(mod$model_data))
+ expect_true("b_idx_gp_timeby_year_" %in% names(mod$model_data))
+ expect_true("k_gp_timeby_year_" %in% names(mod$model_data))
+
+ # These should match to the eigenvalues and eigenfunctions created by
+ # a similar brms call
+ brms_dat <- suppressWarnings(brms::make_standata(
+ y ~ s(series, bs = 're') +
+ gp(time, year, k = 4, gr = FALSE),
+ data = gaus_data$data_train,
+ family = gaussian())
+ )
+
+ # Eigenvalues should be identical
+ expect_true(all.equal(brms_dat$slambda_1,
+ mod$model_data$l_gp_timeby_year_))
+
+ # Eigenfunctions will be nearly identical
+ col_s1 <- grep('gp(time,year)', names(coef(mod$mgcv_model)),
+ fixed = TRUE)
+
+ expect_true(identical(dim(brms_dat$Xgp_1),
+ dim(mod$model_data$X[,col_s1])))
+
+ expect_true(all(unlist(lapply(seq_len(NCOL(brms_dat$Xgp_1)), function(x){
+ cor(brms_dat$Xgp_1[,x], mod$model_data$X[,col_s1][,x])
+ }), use.names = FALSE) > 0.99))
+
+ # The mgcv model formula should contain s() in place of gp()
+ expect_equal(attr(terms(mod$mgcv_model$formula, keep.order = TRUE),
+ 'term.labels'),
+ attr(terms(formula(y ~ ti(time, year, k = 4, mc = c(0, 0)) +
+ s(series, bs = "re")),
+ keep.order = TRUE),
+ 'term.labels'))
+})
+
test_that("noncentring with gp terms working properly", {
mod <- mvgam(y ~ s(series, bs = 're') +
s(season, bs = 'cc', k = 8) +
- gp(time, by = series),
+ gp(time, by = series, k = 10),
trend_model = RW(),
- drift = TRUE,
data = gaus_data$data_train,
newdata = gaus_data$data_test,
family = gaussian(),
@@ -103,10 +224,10 @@ test_that("noncentring with gp terms working properly", {
expect_true("k_gp_time_byseriesseries_1" %in% names(mod$model_data))
})
-test_that("gp for process models working properly", {
+test_that("unidimensional gp for process models working properly", {
mod <- mvgam(y ~ s(series, bs = 're'),
trend_formula = ~
- gp(time, by = trend) +
+ gp(time, by = trend, k = 10) +
year:season,
data = beta_data$data_train,
family = betar(),
@@ -117,7 +238,7 @@ test_that("gp for process models working properly", {
expect_true(any(grepl('// prior for gp(time):trendtrend1_trend...',
mod$model_file, fixed = TRUE)))
- expect_true(any(grepl("b_trend[b_trend_idx_gp_time_bytrendtrend1] = sqrt(spd_cov_exp_quad(",
+ expect_true(any(grepl("b_trend[b_trend_idx_gp_time_bytrendtrend1] = sqrt(spd_gp_exp_quad(",
mod$model_file, fixed = TRUE)))
# Gp data structures should be in the model_data
@@ -133,7 +254,7 @@ test_that("gp for process models working properly", {
family = gaussian()))
# Eigenvalues should be identical
expect_true(all.equal(as.vector(brms_dat$slambda_1_1),
- mod$model_data$l_gp_trend_time_bytrendtrend1))
+ as.vector(mod$model_data$l_gp_trend_time_bytrendtrend1)))
# Eigenfunctions will be nearly identical
row_s1 <- mod$model_data$ytimes_trend[,1]
@@ -154,3 +275,54 @@ test_that("gp for process models working properly", {
keep.order = TRUE),
'term.labels'))
})
+
+test_that("multidimensional gp for process models working properly", {
+ mod <- mvgam(y ~ s(series, bs = 're'),
+ trend_formula = ~
+ gp(time, season, k = 10),
+ data = beta_data$data_train,
+ family = betar(),
+ trend_model = AR(),
+ run_model = FALSE)
+
+ # Model file should have prior lines for gp terms
+ expect_true(any(grepl('// prior for gp(time,season)_trend...',
+ mod$model_file, fixed = TRUE)))
+
+ expect_true(any(grepl("b_trend[b_trend_idx_gp_timeby_season_] = sqrt(spd_gp_exp_quad(",
+ mod$model_file, fixed = TRUE)))
+
+ # Gp data structures should be in the model_data
+ expect_true("l_gp_trend_timeby_season_" %in% names(mod$model_data))
+ expect_true("b_trend_idx_gp_timeby_season_" %in% names(mod$model_data))
+ expect_true("k_gp_trend_timeby_season_" %in% names(mod$model_data))
+
+ # These should match to the eigenvalues and eigenfunctions created by
+ # a similar brms call
+ brms_dat <- suppressWarnings(brms::make_standata(y ~ gp(time, season, k = 10,
+ c = 5/4, cmc = TRUE,
+ gr = FALSE),
+ data = beta_data$data_train,
+ family = gaussian()))
+ # Eigenvalues should be identical
+ expect_true(all.equal(brms_dat$slambda_1,
+ mod$model_data$l_gp_trend_timeby_season_))
+
+ # Eigenfunctions will be nearly identical
+ col_s1 <- grep('gp(time,season)', names(coef(mod$trend_mgcv_model)),
+ fixed = TRUE)
+
+ expect_true(identical(dim(brms_dat$Xgp_1),
+ dim(mod$model_data$X_trend[,col_s1])))
+
+ expect_true(all(unlist(lapply(seq_len(NCOL(brms_dat$Xgp_1)), function(x){
+ cor(brms_dat$Xgp_1[,x], mod$model_data$X_trend[,col_s1][,x])
+ }), use.names = FALSE) > 0.99))
+
+ # The mgcv model formula should contain s() in place of gp()
+ expect_equal(attr(terms(mod$trend_mgcv_model$formula, keep.order = TRUE),
+ 'term.labels'),
+ attr(terms(formula(y ~ ti(time, season, k = 10, mc = c(0, 0))),
+ keep.order = TRUE),
+ 'term.labels'))
+})
diff --git a/tests/testthat/test-jsdgam.R b/tests/testthat/test-jsdgam.R
index bf4744fe..8dcd0382 100644
--- a/tests/testthat/test-jsdgam.R
+++ b/tests/testthat/test-jsdgam.R
@@ -471,14 +471,17 @@ test_that("errors about knot lengths should be propagated from mgcv", {
test_that("get_mvgam_priors accepts factor_formula", {
expect_no_error(get_mvgam_priors(formula = abundance ~
- # Environmental model includes species-level intercepts
- # and random slopes for a linear effect of reflection
- s(taxon, bs = 're') +
- s(taxon, bs = 're', by = reflection),
- # Each factor estimates a different, possibly nonlinear effect of soil.dry
- factor_formula = ~ s(soil.dry, k = 5, by = trend, bs = 'cr') - 1,
- data = spiderdat,
- trend_model = 'None'))
+ # Environmental model includes species-level intercepts
+ # and random slopes for a linear effect of reflection
+ s(taxon, bs = 're') +
+ s(taxon, bs = 're', by = reflection),
+ # Each factor estimates a different, possibly nonlinear effect of soil.dry
+ factor_formula = ~ s(soil.dry, k = 5, by = trend, bs = 'cr') - 1,
+ data = spiderdat,
+ unit = site,
+ species = taxon,
+ n_lv = 3,
+ trend_model = 'None'))
})
# Skip the next test as it should actually initiate the model, and may take a few seconds
diff --git a/tests/testthat/test-mvgam_priors.R b/tests/testthat/test-mvgam_priors.R
index 2f18350f..a2d31ed0 100644
--- a/tests/testthat/test-mvgam_priors.R
+++ b/tests/testthat/test-mvgam_priors.R
@@ -163,8 +163,8 @@ test_that("specified priors appear in the Stan code", {
expect_true(expect_match2(gsub(' ', '', stancode),
'alpha_gp~normal(-1,0.75);'))
- # Now the same using brms functionality; this time use a bound as well
- priors <- prior(normal(-1, 0.75), class = alpha_gp, ub = 1)
+ # Now the same using brms functionality
+ priors <- prior(normal(-1, 0.75), class = alpha_gp)
stancode <- mvgam(y ~ s(season, bs = 'cc'),
trend_model = GP(),
data = beta_data$data_train,
@@ -174,7 +174,7 @@ test_that("specified priors appear in the Stan code", {
expect_true(expect_match2(stancode,
'alpha_gp ~ normal(-1, 0.75);'))
expect_true(expect_match2(gsub(' ', '', stancode),
- 'vector<lower=0,upper=1>[n_series]alpha_gp;'))
+ 'vector<lower=0>[n_series]alpha_gp;'))
})
test_that("specified trend_formula priors appear in the Stan code", {
@@ -245,11 +245,24 @@ test_that("priors on gp() effects work properly", {
class = `alpha_gp(time):seriesseries_1`,
ub = 1),
prior(normal(5, 1.3),
- class = `rho_gp_trend(season)`,
+ class = `rho_gp_trend(season)[1]`,
ub = 50))
- mod <- mvgam(formula = y ~ gp(time, by = series, scale = FALSE),
- trend_formula = ~ gp(season, scale = FALSE),
+ expect_warning(mvgam(formula = y ~ gp(time, by = series, scale = FALSE, k = 10),
+ trend_formula = ~ gp(season, scale = FALSE, k = 10),
+ trend_model = AR(),
+ data = dat$data_train,
+ run_model = FALSE,
+ priors = priors),
+ 'bounds cannot currently be changed for gp parameters')
+
+ priors <- c(prior(normal(0, 0.5),
+ class = `alpha_gp(time):seriesseries_1`),
+ prior(normal(5, 1.3),
+ class = `rho_gp_trend(season)[1]`))
+
+ mod <- mvgam(formula = y ~ gp(time, by = series, scale = FALSE, k = 10),
+ trend_formula = ~ gp(season, scale = FALSE, k = 10),
trend_model = AR(),
data = dat$data_train,
run_model = FALSE,
@@ -258,12 +271,33 @@ test_that("priors on gp() effects work properly", {
# Observation model priors working
expect_true(any(grepl('alpha_gp_time_byseriesseries_1~normal(0,0.5);',
gsub(' ', '', mod$model_file), fixed = TRUE)))
- expect_true(any(grepl('real<lower=0,upper=1>alpha_gp_time_byseriesseries_1;',
- gsub(' ', '', mod$model_file), fixed = TRUE)))
# Process model priors working
- expect_true(any(grepl('rho_gp_trend_season_~normal(5,1.3);',
+ expect_true(any(grepl('rho_gp_trend_season_[1]~normal(5,1.3);',
+ gsub(' ', '', mod$model_file), fixed = TRUE)))
+
+ # A quick test of multidimensional gp priors
+ dat <- mgcv::gamSim(1, n = 30, scale = 2)
+
+ mod <- mvgam(y ~ gp(x1, x2,
+ cov = "matern32",
+ k = 10,
+ iso = FALSE,
+ scale = FALSE),
+ data = dat,
+ family = gaussian(),
+ priors = c(prior(exponential(2.5),
+ class = `alpha_gp(x1, x2)`),
+ prior(normal(0.5, 1),
+ class = `rho_gp(x1, x2)[1][1]`),
+ prior(normal(0.75, 2),
+ class = `rho_gp(x1, x2)[1][2]`)),
+ run_model = FALSE)
+
+ expect_true(any(grepl('alpha_gp_x1by_x2_~exponential(2.5);',
+ gsub(' ', '', mod$model_file), fixed = TRUE)))
+ expect_true(any(grepl('rho_gp_x1by_x2_[1][1]~normal(0.5,1);',
gsub(' ', '', mod$model_file), fixed = TRUE)))
- expect_true(any(grepl('real<lower=0,upper=50>rho_gp_trend_season_;',
+ expect_true(any(grepl('rho_gp_x1by_x2_[1][2]~normal(0.75,2);',
gsub(' ', '', mod$model_file), fixed = TRUE)))
})