new plotting functionality

ropensci · May 2, 2024 · 7191774 · 7191774
1 parent e698014
commit 7191774
Show file tree

Hide file tree

Showing 20 changed files with 428 additions and 558 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: dynamite
 Title: Bayesian Modeling and Causal Inference for Multivariate
     Longitudinal Data
-Version: 1.5.0
+Version: 1.5.1
 Authors@R: c(
     person("Santtu", "Tikka", email = "[email protected]", 
            role = c("aut", "cre"), comment = c(ORCID = "0000-0003-4039-4342")),

diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,11 @@
+# dynamite 1.5.1
+
+  * The `type` argument of `coef()` and `plot()` has been replaced by `types` accepting multiple types simultaneously, similar to `as.data.table()` and `as.data.frame()`.
+  * The functions `plot_betas()`, `plot_deltas()`, `plot_nus()`, `plot_lambdas()` and `plot_psis()` have been deprecated and are now provided via the default plot method by selecting the appropriate `types`.
+  * A new argument `plot_type` has been added to control what type of plot will be drawn by the `plot()` method. The default value `"default"` draws the posterior means and posterior intervals of all parameters. The old functionality of drawing posterior densities and traceplots is provided by the option `"trace"`.
+  * The `plot()` method has gained the argument `n_params` to limit the amount of parameters drawn at once (per parameter type).
+  * Both time-varying and time-invariant parameters can now be plotted simultaneously.
+
 # dynamite 1.5.0
 
   * Estimation of dynamic multivariate panel models with multiple imputation is now available via the function `dynamice()` which uses the `mice` package.
@@ -8,7 +16,6 @@
   * Added a vignette on `get_code()` and `get_data()` functions and how they can be used to modify the generated Stan code and perform variational Bayes inference.
   * Contemporaneous dependencies are now allowed between different components of multivariate distributions, e.g., `obs(c(y, x) ~ x | 1, family = "mvgaussian")`.
   * Ordered probit and logit regressions are now available via `obs(., family = "cumulative", link = "probit")` and `obs(., family = "cumulative", link = "logit")`, respectively.
-  * The functions `plot_betas()`, `plot_deltas()`, `plot_nus()`, `plot_lambdas()` and `plot_psis()` have been deprecated and are now provided via the default plot method via the argument `plot_type` instead.
 
 # dynamite 1.4.11
 

diff --git a/R/as_data_frame.R b/R/as_data_frame.R
@@ -44,19 +44,19 @@
 #' @param x \[`dynamitefit`]\cr The model fit object.
 #' @param row.names Ignored.
 #' @param optional Ignored.
+#' @param types \[`character()`]\cr Type(s) of the parameters for which the
+#'   samples should be extracted. See details of possible values. Default is
+#'   all values listed in details except spline coefficients `omega`.
+#'   This argument is mutually exclusive with `parameters`.
 #' @param parameters \[`character()`]\cr Parameter(s) for which the samples
 #'   should be extracted. Possible options can be found with function
-#'   `get_parameter_names()`. Default is all parameters of specific type for all
-#'   responses.
+#'   `get_parameter_names()`. Default is all parameters of specific type for
+#'   all responses. This argument is mutually exclusive with `types`.
 #' @param responses \[`character()`]\cr Response(s) for which the samples
 #'   should be extracted. Possible options are elements of
 #'   `unique(x$priors$response)`, and the default is this entire vector.
 #'    Ignored if the argument `parameters` is supplied.
-#' @param types \[`character()`]\cr Type(s) of the parameters for which the
-#'   samples should be extracted. See details of possible values. Default is
-#'   all values listed in details except spline coefficients `omega`,
 #'   `omega_alpha`, and `omega_psi`. See also [dynamite::get_parameter_types()].
-#'    Ignored if the argument `parameters` is supplied.
 #' @param times \[`double()`]\cr Time point(s) to keep. If `NULL`
 #'   (the default), all time points are kept.
 #' @param groups \[`character()`] Group name(s) to keep. If `NULL`
@@ -107,23 +107,24 @@
 #' )
 #'
 as.data.frame.dynamitefit <- function(x, row.names = NULL, optional = FALSE,
-                                      parameters = NULL, responses = NULL,
-                                      types = NULL, times = NULL, groups = NULL,
+                                      types = NULL, parameters = NULL,
+                                      responses = NULL,
+                                      times = NULL, groups = NULL,
                                       summary = FALSE, probs = c(0.05, 0.95),
                                       include_fixed = TRUE, ...) {
   out <- as.data.table.dynamitefit(
-    x,
+    x = x,
     keep.rownames = FALSE,
-    row.names,
-    optional,
-    parameters,
-    responses,
-    types,
-    times,
-    groups,
-    summary,
-    probs,
-    include_fixed,
+    row.names = row.names,
+    optional = optional,
+    parameters = parameters,
+    responses = responses,
+    types = types,
+    times = times,
+    groups = groups,
+    summary = summary,
+    probs = probs,
+    include_fixed = include_fixed,
     ...
   )
   tibble::tibble(data.table::setDF(out))

diff --git a/R/as_data_table.R b/R/as_data_table.R
@@ -23,8 +23,8 @@
 #'
 as.data.table.dynamitefit <- function(x, keep.rownames = FALSE,
                                       row.names = NULL, optional = FALSE,
-                                      parameters = NULL,
-                                      responses = NULL, types = NULL,
+                                      types = NULL, parameters = NULL,
+                                      responses = NULL,
                                       times = NULL, groups = NULL,
                                       summary = FALSE, probs = c(0.05, 0.95),
                                       include_fixed = TRUE, ...) {
@@ -115,12 +115,6 @@ as.data.table.dynamitefit <- function(x, keep.rownames = FALSE,
       "Model does not contain response variable{?s} {.var {responses[!z]}}."
     )
   }
-  all_types <- c(
-    "alpha", "beta", "delta", "tau", "tau_alpha", "xi",
-    "sigma_nu", "sigma", "phi", "nu", "lambda", "sigma_lambda",
-    "psi", "tau_psi", "corr", "corr_psi", "corr_nu",
-    "omega", "omega_alpha", "omega_psi", "cutpoints"
-  )
   if (is.null(types)) {
     types <- ifelse_(
       is.null(parameters),
@@ -534,14 +528,19 @@ as_data_table_omega <- function(x, draws, n_draws, response, category, ...) {
     names(get_channel(x, response)$J_varying)
   )
   k <- length(var_names)
-  data.table::data.table(
+  params_ord <- rep(
+    paste0(rep(var_names, each = D), "_d", rep(seq_len(D), k)),
+    each = n_draws
+  )
+  tmp <- data.table::data.table(
     parameter = rep(
       paste0(var_names, "_d", rep(seq_len(D), each = k)),
       each = n_draws
     ),
     value = c(draws),
     category = category
   )
+  tmp[order(match(parameter, params_ord))]
 }
 
 #' @describeIn as_data_table_default Data Table for a "omega_alpha" Parameter
@@ -722,3 +721,67 @@ as_data_table_cutpoints <- function(x, draws, response,
   }
 }
 
+# Parameter types ---------------------------------------------------------
+
+all_types <- c(
+  "alpha",
+  "beta",
+  "corr",
+  "corr_nu",
+  "corr_psi",
+  "cutpoints",
+  "delta",
+  "lambda",
+  "nu",
+  "omega",
+  "omega_alpha",
+  "omega_psi",
+  "phi",
+  "psi",
+  "sigma_nu",
+  "sigma",
+  "sigma_lambda",
+  "tau",
+  "tau_alpha",
+  "tau_psi",
+  "xi"
+)
+
+fixed_types <- c(
+  "alpha",
+  "beta",
+  "corr",
+  "corr_nu",
+  "corr_psi",
+  "cutpoints",
+  "lambda",
+  "nu",
+  "omega",
+  "omega_alpha",
+  "omega_psi",
+  "phi",
+  "sigma",
+  "sigma_lambda",
+  "sigma_nu",
+  "tau",
+  "tau_alpha",
+  "tau_psi",
+  "xi"
+)
+
+varying_types <- c(
+  "alpha",
+  "cutpoints",
+  "delta",
+  "psi"
+)
+
+default_types <- c(
+  "alpha",
+  "beta",
+  "cutpoints",
+  "delta",
+  "lambda",
+  "nu",
+  "psi"
+)
diff --git a/R/coef.R b/R/coef.R
@@ -5,17 +5,6 @@
 #' @export
 #' @family output
 #' @param object \[`dynamitefit`]\cr The model fit object.
-#' @param type  \[`character(1)`]\cr Either `beta` (the default) for
-#'   time-invariant coefficients, `delta` for time-varying coefficients,
-#'   `nu` for random effects, `lambda` for factor loadings, or `psi` for
-#'   latent factor. Ignored if the argument `parameters` is supplied.
-#' @param include_alpha \[`logical(1)`]\cr If `TRUE` (default), extracts also
-#'   time-invariant intercept term alpha if time-invariant parameters beta are
-#'   extracted, and time-varying alpha if time-varying delta are extracted.
-#'   Ignored if the argument `parameters` is supplied.
-#' @param include_cutpoints \[`logical(1)`]\cr If `TRUE` (default), plots also
-#'   the cutpoints if such parameters exists in the model (either time-varying
-#'   or time-invariant).
 #' @param summary \[`logical(1)`]\cr If `TRUE` (default), returns posterior
 #'   mean, standard deviation, and posterior quantiles (as defined by the
 #'   `probs` argument) for all parameters. If `FALSE`, returns the
@@ -31,12 +20,9 @@
 #' deltas <- coef(gaussian_example_fit, type = "delta")
 #'
 coef.dynamitefit <- function(object,
-                             parameters = NULL,
-                             type = c("beta", "delta", "nu", "lambda", "psi"),
+                             types = NULL, parameters = NULL,
                              responses = NULL, times = NULL, groups = NULL,
-                             summary = TRUE, probs = c(0.05, 0.95),
-                             include_alpha = TRUE,
-                             include_cutpoints = TRUE, ...) {
+                             summary = TRUE, probs = c(0.05, 0.95), ...) {
   stopifnot_(
     !missing(object),
     "Argument {.arg object} is missing."
@@ -46,58 +32,24 @@ coef.dynamitefit <- function(object,
     "Argument {.arg object} must be a {.cls dynamitefit} object."
   )
   if (is.null(parameters)) {
-    type <- onlyif(is.character(type), tolower(type))
-    type <- try(
-      match.arg(type, c("beta", "delta", "nu", "lambda", "psi")),
-      silent = TRUE
-    )
-    stopifnot_(
-      !inherits(type, "try-error"),
-      "Argument {.arg type} must be either {.val beta}, {.val delta},
-      {.val nu}, {.val lambda}, or {.val psi}."
-    )
-    stopifnot_(
-      checkmate::test_flag(x = include_alpha),
-      "Argument {.arg include_alpha} must be single {.cls logical} value."
-    )
+    types <- onlyif(is.character(types), tolower(types))
+    invalid_types <- types[!types %in% all_types]
     stopifnot_(
-      checkmate::test_flag(x = include_cutpoints),
-      "Argument {.arg include_cutpoints} must be a single {.cls logical} value."
+      length(invalid_types) == 0L,
+      c(
+        "Argument {.arg types} must contain only valid types.",
+        `x` = "Invalid types found: {invalid_types}"
+      )
     )
   }
-  if (is.null(parameters) && type %in% c("beta", "delta")) {
-    types <- c(
-      type,
-      onlyif(include_alpha, "alpha"),
-      onlyif(include_cutpoints, "cutpoints")
-    )
-    out <- as.data.frame.dynamitefit(
-      object,
-      parameters = parameters,
-      responses = responses,
-      types = types,
-      times = times,
-      groups = groups,
-      summary = summary,
-      probs = probs
-    )
-    # remove extra alphas
-    if (identical(type, "delta")) {
-      out <- out[!is.na(out$time), ]
-    } else {
-      out <- out[is.na(out$time), ]
-    }
-  } else {
-    out <- as.data.frame.dynamitefit(
-      object,
-      parameters = parameters,
-      responses = responses,
-      types = type,
-      times = times,
-      groups = groups,
-      summary = summary,
-      probs = probs
-    )
-  }
-  out
+  as.data.frame.dynamitefit(
+    x = object,
+    types = types,
+    parameters = parameters,
+    responses = responses,
+    times = times,
+    groups = groups,
+    summary = summary,
+    probs = probs
+  )
 }
diff --git a/R/deprecated.R b/R/deprecated.R
@@ -19,29 +19,29 @@
 #' @param ... Not used.
 #' @section Details:
 #'
-#'   * `plot_betas` is now called via `plot(., plot_type = "beta")`
-#'   * `plot_deltas` is now called via `plot(., plot_type = "delta")`
-#'   * `plot_nus` is now called via `plot(., plot_type = "nu")`
-#'   * `plot_lambdas` is now called via `plot(., plot_type = "lambda")`
-#'   * `plot_psis` is now called via `plot(., plot_type = "psi")`
+#'   * `plot_betas` is now called via `plot(., types = "beta")`
+#'   * `plot_deltas` is now called via `plot(., types = "delta")`
+#'   * `plot_nus` is now called via `plot(., types = "nu")`
+#'   * `plot_lambdas` is now called via `plot(., types = "lambda")`
+#'   * `plot_psis` is now called via `plot(., types = "psi")`
 #'
 plot_betas <- function(x, ...) {
   .Deprecated("plot")
-  plot(x, plot_type = "beta", ...)
+  plot(x, types = "beta", ...)
 }
 plot_deltas <- function(x, ...) {
   .Deprecated("plot")
-  plot(x, plot_type = "delta", ...)
+  plot(x, types = "delta", ...)
 }
 plot_nus <- function(x, ...) {
   .Deprecated("plot")
-  plot(x, plot_type = "nu", ...)
+  plot(x, types = "nu", ...)
 }
 plot_lambdas <- function(x, ...) {
   .Deprecated("plot")
-  plot(x, plot_type = "lambda", ...)
+  plot(x, types = "lambda", ...)
 }
 plot_psis <- function(x, ...) {
   .Deprecated("plot")
-  plot(x, plot_type = "psi", ...)
+  plot(x, types = "psi", ...)
 }