From 1250b805f3600e5ff6e9b23499efd30c575fa33f Mon Sep 17 00:00:00 2001 From: swpease Date: Fri, 10 Jan 2025 11:28:21 -0800 Subject: [PATCH] `tidy.mvgam()` implemented `tidy.mvgam()` snapshot value tests The snapshots (note: not snapshot values) record what's printed, and the `check()` call led to a different truncation compared to `test_active_file()`, so I'll just use `expect_snapshot_value()` instead, even though it's harder to read. `tidy.mvgam()` snapshots tests covers the majority of main use cases, but is missing a random effects test and a heirarchical correlation test. `tidy.mvgam()` docs; term name Wrote documentation for method. Also settled on names for the "term" column contents. `tidy.mvgam()` trend formula w/o trend model These models have error terms (sigmas) which were not being included. `tidy.mvgam()` random effect specific betas Decided it would be better to include these than not; can be easily filtered out if undesired. --- NAMESPACE | 3 + R/tidier_methods.R | 281 ++++++++++++++++++++++ man/augment.mvgam.Rd | 4 + man/reexports.Rd | 3 +- man/tidy.mvgam.Rd | 90 +++++++ tests/testthat/_snaps/tidier_methods.md | 300 ++++++++++++++++++++++++ tests/testthat/test-tidier_methods.R | 28 +++ 7 files changed, 708 insertions(+), 1 deletion(-) create mode 100644 man/tidy.mvgam.Rd create mode 100644 tests/testthat/_snaps/tidier_methods.md diff --git a/NAMESPACE b/NAMESPACE index cb8df574..281890ba 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -72,6 +72,7 @@ S3method(stancode,mvgam_prefit) S3method(standata,mvgam_prefit) S3method(summary,mvgam) S3method(summary,mvgam_prefit) +S3method(tidy,mvgam) S3method(update,jsdgam) S3method(update,mvgam) S3method(variables,mvgam) @@ -166,6 +167,7 @@ export(student_t) export(t2) export(te) export(ti) +export(tidy) export(tweedie) export(variables) importFrom(Rcpp,evalCpp) @@ -203,6 +205,7 @@ importFrom(brms,stancode) importFrom(brms,standata) importFrom(brms,student) importFrom(generics,augment) +importFrom(generics,tidy) importFrom(ggplot2,aes) importFrom(ggplot2,facet_wrap) importFrom(ggplot2,geom_bar) diff --git a/R/tidier_methods.R b/R/tidier_methods.R index 23657a17..f983c1c0 100644 --- a/R/tidier_methods.R +++ b/R/tidier_methods.R @@ -1,7 +1,286 @@ +#' @importFrom generics tidy +#' @export +generics::tidy + #' @importFrom generics augment #' @export generics::augment + +#' Tidy an mvgam object's parameter posteriors +#' +#' Get parameters' posterior statistics, implementing the generic `tidy` from +#' the package \pkg{broom}. +#' +#' The parameters are categorized by the column "type". For instance, the +#' intercept of the observation model (i.e. the "formula" arg to `mvgam()`) has +#' the "type" "observation_beta". The possible "type"s are: +#' * observation_family_extra_param: any extra parameters for your observation +#' model, e.g. sigma for a gaussian observation model. These parameters are +#' not directly derived from the latent trend components (continuing the +#' gaussian example, contrast to mu). +#' * observation_beta: betas from your observation model, excluding any smooths. +#' If your formula was `y ~ x1 + s(x2, bs='cr')`, then your intercept and +#' `x1`'s beta would be categorized as this. +#' * random_effect_group_level: Group-level random effects parameters, i.e. +#' the mean and sd of the distribution from which the specific random +#' intercepts/slopes are considered to be drawn from. +#' * random_effect_beta: betas for the individual random intercepts/slopes. +#' * trend_model_param: parameters from your `trend_model`. +#' * trend_beta: analog of "observation_beta", but for any `trend_formula`. +#' * trend_random_effect_group_level: analog of "random_effect_group_level", +#' but for any `trend_formula`. +#' * trend_random_effect_beta: analog of "random_effect_beta", +#' but for any `trend_formula`. +#' +#' Additionally, GP terms can be incorporated in several ways, leading to +#' different "type"s (or absence!): +#' * `s(bs = "gp")`: No parameters returned. +#' * `gp()` in `formula`: "type" of "observation_param". +#' * `gp()` in `trend_formula`: "type" of "trend_formula_param". +#' * `GP()` in `trend_model`: "type" of "trend_model_param". +#' +#' +#' @param x An object of class `mvgam`. +#' @param probs The desired probability levels of the parameters' posteriors. +#' Defaults to `c(0.025, 0.5, 0.975)`, i.e. 2.5%, 50%, and 97.5%. +#' @param ... Unused, included for generic consistency only. +#' @returns A `tibble` containing: +#' * "parameter": The parameter in question. +#' * "type": The component of the model that the parameter belongs to (see details). +#' * "mean": The posterior mean. +#' * "sd": The posterior standard deviation. +#' * percentile(s): Any percentiles of interest from these posteriors. +#' +#' @family tidiers +#' +#' @examples +#' \dontrun{ +#' set.seed(0) +#' simdat <- sim_mvgam(T = 100, +#' n_series = 3, +#' trend_model = AR(), +#' prop_trend = 0.75, +#' family = gaussian()) +#' simdat$data_train$x = rnorm(nrow(simdat$data_train)) +#' simdat$data_train$year_fac = factor(simdat$data_train$year) +#' +#' mod <- mvgam(y ~ - 1 + s(time, by = series, bs = 'cr', k = 20) + x, +#' trend_formula = ~ s(year_fac, bs = 're') - 1, +#' trend_model = AR(cor = TRUE), +#' family = gaussian(), +#' data = simdat$data_train, +#' silent = 2) +#' +#' tidy(mod, probs = c(0.2, 0.5, 0.8)) +#' } +#' +#' @export +tidy.mvgam <- function(x, probs = c(0.025, 0.5, 0.975), ...) { + object <- x + obj_vars <- variables(object) + digits <- 2 # TODO: Let user change? + partialized_mcmc_summary <- purrr::partial(mcmc_summary, + object$model_output, + ... =, + ISB = FALSE, # Matches `x[i]`'s rather than `x`. + probs = probs, + digits = digits, + Rhat = FALSE, + n.eff = FALSE) + out <- tibble::tibble() + + # Observation family extra parameters -------- + xp_names_all <- obj_vars$observation_pars$orig_name + # no matches -> length(xp_names) == 0, even if xp_names_all is NULL + xp_names <- grep("vec", xp_names_all, value = TRUE, invert = TRUE) + if (length(xp_names) > 0) { + extra_params_out <- partialized_mcmc_summary(params = xp_names) + extra_params_out <- tibble::add_column(extra_params_out, + type = "observation_family_extra_param", + .before = 1) + out <- dplyr::bind_rows(out, extra_params_out) + } + # END Observation family extra parameters + + # obs non-smoother betas -------- + if (object$mgcv_model$nsdf > 0) { + obs_beta_name_map <- dplyr::slice_head(obj_vars$observation_betas, n = object$mgcv_model$nsdf) # df("orig_name", "alias") + obs_betas_out <- partialized_mcmc_summary(params = obs_beta_name_map$orig_name) + row.names(obs_betas_out) <- obs_beta_name_map$alias + obs_betas_out <- tibble::add_column(obs_betas_out, + type = "observation_beta", + .before = 1) + out <- dplyr::bind_rows(out, obs_betas_out) + } + # END obs non-smoother betas + + # random effects -------- + # TODO: names for random slopes + re_param_name_map <- obj_vars$observation_re_params + if (!is.null(re_param_name_map)) { + re_params_out <- partialized_mcmc_summary(params = re_param_name_map$orig_name) + row.names(re_params_out) <- re_param_name_map$alias + re_params_out <- tibble::add_column(re_params_out, + type = "random_effect_group_level", + .before = 1) + out <- dplyr::bind_rows(out, re_params_out) + + # specific betas + for (sp in object$mgcv_model$smooth) { + if (inherits(sp, "random.effect")) { + re_label <- sp$label + betas_all <- obj_vars$observation_betas + re_beta_idxs <- grep(re_label, betas_all$alias, fixed = TRUE) + re_beta_name_map <- dplyr::slice(betas_all, re_beta_idxs) + re_betas_out <- partialized_mcmc_summary(params = re_beta_name_map$orig_name) + row.names(re_betas_out) <- re_beta_name_map$alias + re_betas_out <- tibble::add_column(re_betas_out, + type = "random_effect_beta", + .before = 1) + out <- dplyr::bind_rows(out, re_betas_out) + } + } + } + # END random effects + + # GPs -------- + if (!is.null(obj_vars$trend_pars)) { + tm_param_names_all <- obj_vars$trend_pars$orig_name + gp_param_names <- grep("^alpha_gp|^rho_gp", tm_param_names_all, value = TRUE) + if (length(gp_param_names) > 0) { + gp_params_out <- partialized_mcmc_summary(params = gp_param_names) + # where is GP? can be in formula, trend_formula, or trend_model + if (grepl("^(alpha|rho)_gp_trend", gp_param_names[[1]])) { + param_type <- "trend_formula_param" + } else if (grepl("^(alpha|rho)_gp_", gp_param_names[[1]])) { # hmph. + param_type <- "observation_param" + } else { + param_type <- "trend_model_param" + } + gp_params_out <- tibble::add_column(gp_params_out, + type = param_type, + .before = 1) + out <- dplyr::bind_rows(out, gp_params_out) + } + } + # END GPs + + # RW, AR, CAR, VAR, ZMVN -------- + # TODO: split out Sigma for heircor? + trend_model_name <- ifelse(inherits(object$trend_model, "mvgam_trend"), + object$trend_model$trend_model, + object$trend_model) # str vs called obj as arg to mvgam + if (grepl("^VAR|^CAR|^AR|^RW|^ZMVN", trend_model_name)) { + # theta = MA terms + # alpha_cor = heirarchical corr term + # A = VAR auto-regressive matrix + # Sigma = correlated errors matrix + # sigma = errors + + # setting up the params to extract + if (trend_model_name == "VAR") { + trend_model_params <- c("^A\\[", "^alpha_cor", "^theta", "^Sigma") + } else if (grepl("^CAR|^AR|^RW", trend_model_name)) { + cor <- inherits(object$trend_model, "mvgam_trend") && object$trend_model$cor + sigma_name <- ifelse(cor, "^Sigma", "^sigma") + trend_model_params <- c("^ar", "^alpha_cor", "^theta", sigma_name) + } else if (grepl("^ZMVN", trend_model_name)) { + trend_model_params <- c("^alpha_cor", "^Sigma") + } + + # extracting the params + trend_model_params <- paste(trend_model_params, collapse = "|") + tm_param_names_all <- obj_vars$trend_pars$orig_name + tm_param_names <- grep(trend_model_params, tm_param_names_all, value = TRUE) + tm_params_out <- partialized_mcmc_summary(params = tm_param_names) + tm_params_out <- tibble::add_column(tm_params_out, + type = "trend_model_param", + .before = 1) + out <- dplyr::bind_rows(out, tm_params_out) + } + # END RW, AR, CAR, VAR + + # 'None' trend_model with a trend_formula -------- + if (trend_model_name == "None" && !is.null(object$trend_call)) { + trend_pars_names_all <- obj_vars$trend_pars$orig_name + trend_pars_names <- grep("sigma", trend_pars_names_all, value = TRUE) + if (length(trend_pars_names) > 0) { + trend_params_out <- partialized_mcmc_summary(params = trend_pars_names) + trend_params_out <- tibble::add_column(trend_params_out, + type = "trend_model_param", + .before = 1) + out <- dplyr::bind_rows(out, trend_params_out) + } + } + # END 'None' trend_model with a trend_formula + + # Piecewise -------- + # TODO: potentially lump into AR section, above; how to handle change points? + # to lump in, just add an + # `else if (grepl("^PW", trend_model_name)`, then + # `trend_model_params <- c("^k_trend", "^m_trend", "^delta_trend")` + # and change initial grep(ar car var) call + if (grepl("^PW", trend_model_name)) { + trend_model_params <- "^k_trend|^m_trend|^delta_trend" + tm_param_names_all <- obj_vars$trend_pars$orig_name + tm_param_names <- grep(trend_model_params, tm_param_names_all, value = TRUE) + tm_params_out <- partialized_mcmc_summary(params = tm_param_names) + tm_params_out <- tibble::add_column(tm_params_out, + type = "trend_model_param", + .before = 1) + out <- dplyr::bind_rows(out, tm_params_out) + } + # END Piecewise + + # Trend formula betas -------- + if (!is.null(object$trend_call) && object$trend_mgcv_model$nsdf > 0) { + trend_beta_name_map <- dplyr::slice_head(obj_vars$trend_betas, + n = object$trend_mgcv_model$nsdf) # df("orig_name", "alias") + trend_betas_out <- partialized_mcmc_summary(params = trend_beta_name_map$orig_name) + row.names(trend_betas_out) <- trend_beta_name_map$alias + trend_betas_out <- tibble::add_column(trend_betas_out, + type = "trend_beta", + .before = 1) + out <- dplyr::bind_rows(out, trend_betas_out) + } + # END Trend formula betas + + # trend random effects -------- + trend_re_param_name_map <- obj_vars$trend_re_params + if (!is.null(trend_re_param_name_map)) { + trend_re_params_out <- partialized_mcmc_summary(params = trend_re_param_name_map$orig_name) + row.names(trend_re_params_out) <- trend_re_param_name_map$alias + trend_re_params_out <- tibble::add_column(trend_re_params_out, + type = "trend_random_effect_group_level", + .before = 1) + out <- dplyr::bind_rows(out, trend_re_params_out) + + # specific betas + for (sp in object$trend_mgcv_model$smooth) { + if (inherits(sp, "random.effect")) { + trend_re_label <- sp$label + trend_betas_all <- obj_vars$trend_betas + trend_re_beta_idxs <- grep(trend_re_label, trend_betas_all$alias, fixed = TRUE) + trend_re_beta_name_map <- dplyr::slice(trend_betas_all, trend_re_beta_idxs) + trend_re_betas_out <- partialized_mcmc_summary(params = trend_re_beta_name_map$orig_name) + row.names(trend_re_betas_out) <- trend_re_beta_name_map$alias + trend_re_betas_out <- tibble::add_column(trend_re_betas_out, + type = "trend_random_effect_beta", + .before = 1) + out <- dplyr::bind_rows(out, trend_re_betas_out) + } + } + } + # END trend random effects + + # OUTPUT -------- + # TODO: might need to put this prior to every bind_rows to avoid rowname dups. + out <- tibble::rownames_to_column(out, "parameter") + out +} + + #' Augment an mvgam object's data #' #' Add fits and residuals to the data, implementing the generic `augment` from @@ -27,6 +306,8 @@ generics::augment #' * The residuals, along with their variability and credible bounds. #' #' @seealso \code{\link{residuals.mvgam}}, \code{\link{fitted.mvgam}} +#' @family tidiers +#' #' @examples #' \dontrun{ #' set.seed(0) diff --git a/man/augment.mvgam.Rd b/man/augment.mvgam.Rd index 52a36440..d9b8fd43 100644 --- a/man/augment.mvgam.Rd +++ b/man/augment.mvgam.Rd @@ -62,4 +62,8 @@ augment(mod1, robust = TRUE, probs = c(0.25, 0.75)) } \seealso{ \code{\link{residuals.mvgam}}, \code{\link{fitted.mvgam}} + +Other tidiers: +\code{\link{tidy.mvgam}()} } +\concept{tidiers} diff --git a/man/reexports.Rd b/man/reexports.Rd index da19e2d5..6885fb7a 100644 --- a/man/reexports.Rd +++ b/man/reexports.Rd @@ -40,6 +40,7 @@ \alias{posterior_linpred} \alias{stancode} \alias{standata} +\alias{tidy} \alias{augment} \title{Objects exported from other packages} \keyword{internal} @@ -50,7 +51,7 @@ below to see their documentation. \describe{ \item{brms}{\code{\link[brms:conditional_effects.brmsfit]{conditional_effects}}, \code{\link[brms]{gp}}, \code{\link[brms:mcmc_plot.brmsfit]{mcmc_plot}}, \code{\link[brms:set_prior]{prior}}, \code{\link[brms:set_prior]{prior_}}, \code{\link[brms:set_prior]{prior_string}}, \code{\link[brms]{set_prior}}, \code{\link[brms]{stancode}}, \code{\link[brms]{standata}}} - \item{generics}{\code{\link[generics]{augment}}} + \item{generics}{\code{\link[generics]{augment}}, \code{\link[generics]{tidy}}} \item{insight}{\code{\link[insight]{get_data}}} diff --git a/man/tidy.mvgam.Rd b/man/tidy.mvgam.Rd new file mode 100644 index 00000000..e0c5a969 --- /dev/null +++ b/man/tidy.mvgam.Rd @@ -0,0 +1,90 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tidier_methods.R +\name{tidy.mvgam} +\alias{tidy.mvgam} +\title{Tidy an mvgam object's parameter posteriors} +\usage{ +\method{tidy}{mvgam}(x, probs = c(0.025, 0.5, 0.975), ...) +} +\arguments{ +\item{x}{An object of class \code{mvgam}.} + +\item{probs}{The desired probability levels of the parameters' posteriors. +Defaults to \code{c(0.025, 0.5, 0.975)}, i.e. 2.5\%, 50\%, and 97.5\%.} + +\item{...}{Unused, included for generic consistency only.} +} +\value{ +A \code{tibble} containing: +\itemize{ +\item "parameter": The parameter in question. +\item "type": The component of the model that the parameter belongs to (see details). +\item "mean": The posterior mean. +\item "sd": The posterior standard deviation. +\item percentile(s): Any percentiles of interest from these posteriors. +} +} +\description{ +Get parameters' posterior statistics, implementing the generic \code{tidy} from +the package \pkg{broom}. +} +\details{ +The parameters are categorized by the column "type". For instance, the +intercept of the observation model (i.e. the "formula" arg to \code{mvgam()}) has +the "type" "observation_beta". The possible "type"s are: +\itemize{ +\item observation_family_extra_param: any extra parameters for your observation +model, e.g. sigma for a gaussian observation model. These parameters are +not directly derived from the latent trend components (continuing the +gaussian example, contrast to mu). +\item observation_beta: betas from your observation model, excluding any smooths. +If your formula was \code{y ~ x1 + s(x2, bs='cr')}, then your intercept and +\code{x1}'s beta would be categorized as this. +\item random_effect_group_level: Group-level random effects parameters, i.e. +the mean and sd of the distribution from which the specific random +intercepts/slopes are considered to be drawn from. +\item random_effect_beta: betas for the individual random intercepts/slopes. +\item trend_model_param: parameters from your \code{trend_model}. +\item trend_beta: analog of "observation_beta", but for any \code{trend_formula}. +\item trend_random_effect_group_level: analog of "random_effect_group_level", +but for any \code{trend_formula}. +\item trend_random_effect_beta: analog of "random_effect_beta", +but for any \code{trend_formula}. +} + +Additionally, GP terms can be incorporated in several ways, leading to +different "type"s (or absence!): +\itemize{ +\item \code{s(bs = "gp")}: No parameters returned. +\item \code{gp()} in \code{formula}: "type" of "observation_param". +\item \code{gp()} in \code{trend_formula}: "type" of "trend_formula_param". +\item \code{GP()} in \code{trend_model}: "type" of "trend_model_param". +} +} +\examples{ +\dontrun{ +set.seed(0) +simdat <- sim_mvgam(T = 100, + n_series = 3, + trend_model = AR(), + prop_trend = 0.75, + family = gaussian()) +simdat$data_train$x = rnorm(nrow(simdat$data_train)) +simdat$data_train$year_fac = factor(simdat$data_train$year) + +mod <- mvgam(y ~ - 1 + s(time, by = series, bs = 'cr', k = 20) + x, + trend_formula = ~ s(year_fac, bs = 're') - 1, + trend_model = AR(cor = TRUE), + family = gaussian(), + data = simdat$data_train, + silent = 2) + +tidy(mod, probs = c(0.2, 0.5, 0.8)) +} + +} +\seealso{ +Other tidiers: +\code{\link{augment.mvgam}()} +} +\concept{tidiers} diff --git a/tests/testthat/_snaps/tidier_methods.md b/tests/testthat/_snaps/tidier_methods.md new file mode 100644 index 00000000..9a3aa69f --- /dev/null +++ b/tests/testthat/_snaps/tidier_methods.md @@ -0,0 +1,300 @@ +# `tidy()` snapshot value of `mvgam_example1` + + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["parameter", "type", "mean", "sd", "2.5%", "50%", "97.5%"] + }, + "row.names": { + "type": "integer", + "attributes": {}, + "value": [1, 2, 3, 4, 5, 6, 7] + }, + "class": { + "type": "character", + "attributes": {}, + "value": ["tbl_df", "tbl", "data.frame"] + } + }, + "value": [ + { + "type": "character", + "attributes": {}, + "value": ["sigma_obs[1]", "sigma_obs[2]", "sigma_obs[3]", "(Intercept)", "sigma[1]", "sigma[2]", "sigma[3]"] + }, + { + "type": "character", + "attributes": {}, + "value": ["observation_family_extra_param", "observation_family_extra_param", "observation_family_extra_param", "observation_beta", "trend_model_param", "trend_model_param", "trend_model_param"] + }, + { + "type": "double", + "attributes": {}, + "value": [0.49, 0.47, 0.37, 0.48, 0.016, 0.097, 0.44] + }, + { + "type": "double", + "attributes": {}, + "value": [0.087, 0.1, 0.22, 0.099, 0.0068, 0.058, 0.27] + }, + { + "type": "double", + "attributes": {}, + "value": [0.34, 0.32, 0.097, 0.3, 0.0083, 0.039, 0.11] + }, + { + "type": "double", + "attributes": {}, + "value": [0.49, 0.48, 0.44, 0.48, 0.013, 0.071, 0.36] + }, + { + "type": "double", + "attributes": {}, + "value": [0.63, 0.69, 0.65, 0.63, 0.027, 0.21, 0.84] + } + ] + } + +# `tidy()` snapshot value of `mvgam_example2` + + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["parameter", "type", "mean", "sd", "2.5%", "50%", "97.5%"] + }, + "row.names": { + "type": "integer", + "attributes": {}, + "value": [1, 2, 3, 4, 5, 6, 7, 8, 9] + }, + "class": { + "type": "character", + "attributes": {}, + "value": ["tbl_df", "tbl", "data.frame"] + } + }, + "value": [ + { + "type": "character", + "attributes": {}, + "value": ["sigma_obs[1]", "sigma_obs[2]", "sigma_obs[3]", "(Intercept)", "Sigma[1,1]", "Sigma[2,1]", "Sigma[1,2]", "Sigma[2,2]", "(Intercept)_trend"] + }, + { + "type": "character", + "attributes": {}, + "value": ["observation_family_extra_param", "observation_family_extra_param", "observation_family_extra_param", "observation_beta", "trend_model_param", "trend_model_param", "trend_model_param", "trend_model_param", "trend_beta"] + }, + { + "type": "double", + "attributes": {}, + "value": [0.52, 0.47, 0.7, 1.2, 0.065, -0.0032, -0.0032, 0.0044, -0.84] + }, + { + "type": "double", + "attributes": {}, + "value": [0.11, 0.066, 0.065, 2.3, 0.042, 0.0081, 0.0081, 0.0047, 2.2] + }, + { + "type": "double", + "attributes": {}, + "value": [0.36, 0.35, 0.6, -3.9, 0.0063, -0.017, -0.017, 0.00053, -3.5] + }, + { + "type": "double", + "attributes": {}, + "value": [0.51, 0.47, 0.71, 1.7, 0.058, -0.0021, -0.0021, 0.002, -1.3] + }, + { + "type": "double", + "attributes": {}, + "value": [0.78, 0.59, 0.85, 4, 0.14, 0.011, 0.011, 0.015, 4.3] + } + ] + } + +# `tidy()` snapshot value of `mvgam_example3` + + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["parameter", "type", "mean", "sd", "2.5%", "50%", "97.5%"] + }, + "row.names": { + "type": "integer", + "attributes": {}, + "value": [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22] + }, + "class": { + "type": "character", + "attributes": {}, + "value": ["tbl_df", "tbl", "data.frame"] + } + }, + "value": [ + { + "type": "character", + "attributes": {}, + "value": ["sigma_obs[1]", "sigma_obs[2]", "sigma_obs[3]", "(Intercept)", "A[1,1]", "A[2,1]", "A[3,1]", "A[1,2]", "A[2,2]", "A[3,2]", "A[1,3]", "A[2,3]", "A[3,3]", "Sigma[1,1]", "Sigma[2,1]", "Sigma[3,1]", "Sigma[1,2]", "Sigma[2,2]", "Sigma[3,2]", "Sigma[1,3]", "Sigma[2,3]", "Sigma[3,3]"] + }, + { + "type": "character", + "attributes": {}, + "value": ["observation_family_extra_param", "observation_family_extra_param", "observation_family_extra_param", "observation_beta", "trend_model_param", "trend_model_param", "trend_model_param", "trend_model_param", "trend_model_param", "trend_model_param", "trend_model_param", "trend_model_param", "trend_model_param", "trend_model_param", "trend_model_param", "trend_model_param", "trend_model_param", "trend_model_param", "trend_model_param", "trend_model_param", "trend_model_param", "trend_model_param"] + }, + { + "type": "double", + "attributes": {}, + "value": [0.49, 0.52, 0.37, 0.46, -0.14, -0.15, 0.59, 0.063, -0.18, 0.63, 0.019, -0.039, -0.082, 0.016, 0.012, -0.0063, 0.012, 0.065, 0.028, -0.0063, 0.028, 0.27] + }, + { + "type": "double", + "attributes": {}, + "value": [0.075, 0.087, 0.23, 0.072, 0.51, 0.56, 1.2, 0.42, 0.49, 1.7, 0.14, 0.16, 0.39, 0.024, 0.031, 0.035, 0.031, 0.13, 0.061, 0.035, 0.061, 0.22] + }, + { + "type": "double", + "attributes": {}, + "value": [0.39, 0.38, 0.093, 0.36, -0.94, -1.3, -1.3, -0.65, -1.1, -2.7, -0.16, -0.31, -0.84, 0.0019, -0.011, -0.1, -0.011, 0.0016, -0.021, -0.1, -0.021, 0.0071] + }, + { + "type": "double", + "attributes": {}, + "value": [0.48, 0.53, 0.3, 0.44, -0.32, -0.057, 0.38, 0.038, -0.085, 0.32, -0.0038, -0.031, -0.085, 0.0059, 0.0014, 0.00031, 0.0014, 0.018, 0.0029, 0.00031, 0.0029, 0.25] + }, + { + "type": "double", + "attributes": {}, + "value": [0.66, 0.69, 0.79, 0.61, 0.63, 0.52, 3.2, 0.87, 0.6, 4.2, 0.33, 0.32, 0.41, 0.087, 0.11, 0.045, 0.11, 0.44, 0.2, 0.045, 0.2, 0.69] + } + ] + } + +# `tidy()` snapshot value of `mvgam_example4` + + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["parameter", "type", "mean", "sd", "2.5%", "50%", "97.5%"] + }, + "row.names": { + "type": "integer", + "attributes": {}, + "value": [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34] + }, + "class": { + "type": "character", + "attributes": {}, + "value": ["tbl_df", "tbl", "data.frame"] + } + }, + "value": [ + { + "type": "character", + "attributes": {}, + "value": ["sigma_obs[1]", "sigma_obs[2]", "sigma_obs[3]", "(Intercept)", "seriesseries_2", "seriesseries_3", "A[1,1]", "A[2,1]", "A[3,1]", "A[1,2]", "A[2,2]", "A[3,2]", "A[1,3]", "A[2,3]", "A[3,3]", "theta[1,1]", "theta[2,1]", "theta[3,1]", "theta[1,2]", "theta[2,2]", "theta[3,2]", "theta[1,3]", "theta[2,3]", "theta[3,3]", "Sigma[1,1]", "Sigma[2,1]", "Sigma[3,1]", "Sigma[1,2]", "Sigma[2,2]", "Sigma[3,2]", "Sigma[1,3]", "Sigma[2,3]", "Sigma[3,3]", "(Intercept)_trend"] + }, + { + "type": "character", + "attributes": {}, + "value": ["observation_family_extra_param", "observation_family_extra_param", "observation_family_extra_param", "observation_beta", "observation_beta", "observation_beta", "trend_model_param", "trend_model_param", "trend_model_param", "trend_model_param", "trend_model_param", "trend_model_param", "trend_model_param", "trend_model_param", "trend_model_param", "trend_model_param", "trend_model_param", "trend_model_param", "trend_model_param", "trend_model_param", "trend_model_param", "trend_model_param", "trend_model_param", "trend_model_param", "trend_model_param", "trend_model_param", "trend_model_param", "trend_model_param", "trend_model_param", "trend_model_param", "trend_model_param", "trend_model_param", "trend_model_param", "trend_beta"] + }, + { + "type": "double", + "attributes": {}, + "value": [0.45, 0.39, 0.62, 0.29, -0.13, -0.13, 0.21, 0.51, 0.21, 0.11, 0.28, 0.12, 0.058, 0.27, 0.25, -0.12, -0.26, 0.055, 0.06, -0.021, 0.11, -0.0053, 0.23, 0.19, 0.062, 0.017, 0.011, 0.017, 0.11, 0.028, 0.011, 0.028, 0.059, 0.21] + }, + { + "type": "double", + "attributes": {}, + "value": [0.1, 0.11, 0.14, 1.6, 0.16, 0.13, 0.41, 0.7, 0.41, 0.35, 0.48, 0.42, 0.42, 0.62, 0.39, 0.67, 1.1, 0.71, 0.64, 0.59, 0.45, 0.94, 0.98, 0.62, 0.052, 0.035, 0.036, 0.035, 0.088, 0.048, 0.036, 0.048, 0.047, 1.6] + }, + { + "type": "double", + "attributes": {}, + "value": [0.28, 0.17, 0.38, -4.1, -0.46, -0.36, -0.6, -0.3, -0.46, -0.56, -0.55, -0.45, -0.77, -0.84, -0.47, -1.1, -2.5, -1.4, -1.1, -0.94, -0.78, -1.6, -1.9, -0.94, 0.012, -0.013, -0.041, -0.013, 0.021, -0.029, -0.041, -0.029, 0.011, -2] + }, + { + "type": "double", + "attributes": {}, + "value": [0.45, 0.42, 0.62, 0.4, -0.16, -0.13, 0.31, 0.38, 0.19, 0.062, 0.33, 0.056, 0.22, 0.25, 0.32, -0.085, -0.11, 0.0078, 0.043, -0.079, 0.22, -0.0072, 0.13, 0.2, 0.043, 0.0042, 0.0023, 0.0042, 0.083, 0.022, 0.0023, 0.022, 0.045, 0.14] + }, + { + "type": "double", + "attributes": {}, + "value": [0.6, 0.55, 0.89, 2.6, 0.21, 0.073, 0.77, 2.1, 1.1, 0.93, 1.2, 1.2, 0.57, 1.4, 0.89, 1, 1.7, 1.4, 1.2, 0.88, 0.73, 1.7, 1.8, 1.2, 0.17, 0.12, 0.1, 0.12, 0.31, 0.16, 0.1, 0.16, 0.17, 4.6] + } + ] + } + +# `tidy()` snapshot value of `mvgam_example5` + + { + "type": "list", + "attributes": { + "names": { + "type": "character", + "attributes": {}, + "value": ["parameter", "type", "mean", "sd", "2.5%", "50%", "97.5%"] + }, + "row.names": { + "type": "integer", + "attributes": {}, + "value": [1, 2, 3, 4, 5, 6, 7, 8, 9, 10] + }, + "class": { + "type": "character", + "attributes": {}, + "value": ["tbl_df", "tbl", "data.frame"] + } + }, + "value": [ + { + "type": "character", + "attributes": {}, + "value": ["sigma_obs[1]", "sigma_obs[2]", "sigma_obs[3]", "(Intercept)", "seriesseries_2", "seriesseries_3", "rho_gp[1]", "rho_gp[2]", "alpha_gp[1]", "alpha_gp[2]"] + }, + { + "type": "character", + "attributes": {}, + "value": ["observation_family_extra_param", "observation_family_extra_param", "observation_family_extra_param", "observation_beta", "observation_beta", "observation_beta", "trend_model_param", "trend_model_param", "trend_model_param", "trend_model_param"] + }, + { + "type": "double", + "attributes": {}, + "value": [0.53, 0.5, 0.63, 0.53, -0.15, -0.061, 6.2, 6.8, 0.25, 0.25] + }, + { + "type": "double", + "attributes": {}, + "value": [0.07, 0.082, 0.092, 0.13, 0.29, 0.41, 4.5, 5.6, 0, 0] + }, + { + "type": "double", + "attributes": {}, + "value": [0.41, 0.37, 0.48, 0.32, -0.65, -0.52, 1.4, 1.4, 0.25, 0.25] + }, + { + "type": "double", + "attributes": {}, + "value": [0.53, 0.5, 0.64, 0.5, -0.15, -0.15, 4.4, 5.3, 0.25, 0.25] + }, + { + "type": "double", + "attributes": {}, + "value": [0.64, 0.62, 0.76, 0.78, 0.43, 1.2, 15, 21, 0.25, 0.25] + } + ] + } + diff --git a/tests/testthat/test-tidier_methods.R b/tests/testthat/test-tidier_methods.R index 3aa6810c..d490b45e 100644 --- a/tests/testthat/test-tidier_methods.R +++ b/tests/testthat/test-tidier_methods.R @@ -1,5 +1,33 @@ context("tidier methods") +# `tidy()` tests +test_that("`tidy()` snapshot value of `mvgam_example1`", { + local_edition(3) + expect_snapshot_value(tidy.mvgam(mvgam_example1), style = "json2") +}) + +test_that("`tidy()` snapshot value of `mvgam_example2`", { + local_edition(3) + expect_snapshot_value(tidy.mvgam(mvgam_example2), style = "json2") +}) + +test_that("`tidy()` snapshot value of `mvgam_example3`", { + local_edition(3) + expect_snapshot_value(tidy.mvgam(mvgam_example3), style = "json2") +}) + +test_that("`tidy()` snapshot value of `mvgam_example4`", { + local_edition(3) + expect_snapshot_value(tidy.mvgam(mvgam_example4), style = "json2") +}) + +test_that("`tidy()` snapshot value of `mvgam_example5`", { + local_edition(3) + expect_snapshot_value(tidy.mvgam(mvgam_example5), style = "json2") +}) + + +# `augment()` tests test_that("augment doesn't error", { expect_no_error(augment(mvgam:::mvgam_example1)) expect_no_error(augment(mvgam:::mvgam_example5))