Replace deprecated reshape2::melt() with base R and tidyr equivalents

DESCRIPTION

@@ -36,7 +36,6 @@ Imports:
     glue,
     lifecycle,
     posterior,
-    reshape2,
     rlang (>= 1.0.0),
     stats,
     tibble (>= 2.0.0),

NEWS.md

@@ -1,5 +1,7 @@
 # bayesplot (development version)
 
+* Replace deprecated `reshape2::melt()` with base R `as.data.frame.table()` and `tidyr::pivot_longer()` across all internal data-reshaping helpers. `reshape2` has been removed from `Imports`.
+
 * Use `rlang::warn()` and `rlang::inform()` for selected PPC user messages instead of base `warning()` and `message()`.
 * Standardize input validation errors in `ppc_km_overlay()` and interpolation helpers to use `rlang::abort()` for consistent error handling.
 * Fix assignment-in-call bug in `mcmc_rank_ecdf()` (#).

R/bayesplot-extractors.R

@@ -15,12 +15,12 @@
 #' @return
 #' \describe{
 #' \item{`log_posterior()`}{
-#' `log_posterior()` methods return a molten data frame (see [reshape2::melt()]).
+#' `log_posterior()` methods return a long-format data frame.
 #' The data frame should have columns `"Iteration"` (integer), `"Chain"`
 #' (integer), and `"Value"` (numeric). See **Examples**, below.
 #' }
 #' \item{`nuts_params()`}{
-#' `nuts_params()` methods return a molten data frame (see [reshape2::melt()]).
+#' `nuts_params()` methods return a long-format data frame.
 #' The data frame should have columns `"Parameter"` (factor), `"Iteration"`
 #' (integer), `"Chain"` (integer), and `"Value"` (numeric). See **Examples**, below.
 #' }
@@ -85,8 +85,13 @@ log_posterior.stanfit <- function(object, inc_warmup = FALSE, ...) {
   lp <- rstan::get_logposterior(object,
                                 inc_warmup = inc_warmup,
                                 ...)
-  lp <- lapply(lp, as.array)
-  lp <- set_names(reshape2::melt(lp), c("Iteration", "Value", "Chain"))
+  lp <- dplyr::bind_rows(lapply(seq_along(lp), function(i) {
+    data.frame(
+      Iteration = seq_along(lp[[i]]),
+      Value     = as.numeric(lp[[i]]),
+      Chain     = as.integer(i)
+    )
+  }))
   validate_df_classes(lp[, c("Chain", "Iteration", "Value")],
                       c("integer", "integer", "numeric"))
 }
@@ -104,7 +109,10 @@ log_posterior.stanreg <- function(object, inc_warmup = FALSE, ...) {
 #' @method log_posterior CmdStanMCMC
 log_posterior.CmdStanMCMC <- function(object, inc_warmup = FALSE, ...) {
   lp <- object$draws("lp__", inc_warmup = inc_warmup)
-  lp <- reshape2::melt(lp)
+  lp <- as.data.frame.table(unclass(lp), responseName = "value",
+                             stringsAsFactors = FALSE)
+  lp[[1]] <- as.integer(lp[[1]])
+  lp[[2]] <- as.integer(lp[[2]])
   lp$variable <- NULL
   lp <- dplyr::rename_with(lp, capitalize_first)
   validate_df_classes(lp[, c("Chain", "Iteration", "Value")],
@@ -163,8 +171,19 @@ nuts_params.list <- function(object, pars = NULL, ...) {
     object <- lapply(object, function(x) x[, pars, drop = FALSE])
   }
 
-  out <- reshape2::melt(object)
-  out <- set_names(out, c("Iteration", "Parameter", "Value", "Chain"))
+  out <- dplyr::bind_rows(lapply(seq_along(object), function(i) {
+    mat       <- object[[i]]
+    n_iter    <- nrow(mat)
+    par_names <- colnames(mat)
+    data.frame(
+      Iteration = rep(seq_len(n_iter), times = length(par_names)),
+      Parameter = factor(rep(par_names, each = n_iter), levels = par_names),
+      Value     = as.vector(mat),
+      Chain     = as.integer(i),
+      stringsAsFactors = FALSE
+    )
+  }))
+  out <- out[c("Iteration", "Parameter", "Value", "Chain")]
   validate_df_classes(out[, c("Chain", "Iteration", "Parameter", "Value")],
                       c("integer", "integer", "factor", "numeric"))
 }
@@ -177,8 +196,12 @@ nuts_params.CmdStanMCMC <- function(object, pars = NULL, ...) {
   if (!is.null(pars)) {
     arr <- arr[,, pars]
   }
-  out <- reshape2::melt(arr)
-  colnames(out)[colnames(out) == "variable"] <- "parameter"
+  out <- as.data.frame.table(unclass(arr), responseName = "value",
+                             stringsAsFactors = FALSE)
+  out[[1]] <- as.integer(out[[1]])
+  out[[2]] <- as.integer(out[[2]])
+  out[[3]] <- factor(out[[3]])
+  names(out)[names(out) == "variable"] <- "parameter"
   out <- dplyr::rename_with(out, capitalize_first)
   validate_df_classes(out[, c("Chain", "Iteration", "Parameter", "Value")],
                       c("integer", "integer", "factor", "numeric"))

R/helpers-mcmc.R

@@ -120,8 +120,10 @@ select_parameters <-
 #'
 #' @noRd
 #' @param x An mcmc_array (from prepare_mcmc_array).
-#' @param varnames,value.name,... Passed to reshape2::melt (array method).
-#' @return A molten data frame.
+#' @param varnames Character vector of names for the dimension columns.
+#' @param value.name Name for the value column.
+#' @param ... Unused; kept for backward compatibility.
+#' @return A long-format data frame.
 #'
 melt_mcmc <- function(x, ...) UseMethod("melt_mcmc")
 
@@ -130,18 +132,16 @@ melt_mcmc.mcmc_array <- function(x,
                                  varnames =
                                    c("Iteration", "Chain", "Parameter"),
                                  value.name = "Value",
-                                 as.is = TRUE,
                                  ...) {
   stopifnot(is_mcmc_array(x))
 
-  long <- reshape2::melt(
-    data = x,
-    varnames = varnames,
-    value.name = value.name,
-    as.is = FALSE,
-    ...)
+  long <- as.data.frame.table(x, responseName = value.name,
+                              stringsAsFactors = FALSE)
+  colnames(long)[seq_along(varnames)] <- varnames
 
-  long$Parameter <- factor(long$Parameter)
+  long[[varnames[1]]] <- as.integer(long[[varnames[1]]])  # Iteration
+  long[[varnames[2]]] <- as.integer(long[[varnames[2]]])  # Chain
+  long$Parameter      <- factor(long$Parameter)
   long
 }
 
@@ -151,14 +151,12 @@ melt_mcmc.matrix <- function(x,
                              varnames = c("Draw", "Parameter"),
                              value.name = "Value",
                              ...) {
-  long <- reshape2::melt(
-    data = x,
-    varnames = varnames,
-    value.name = value.name,
-    as.is = FALSE,
-    ...)
-
-  long$Parameter <- factor(long$Parameter)
+  long <- as.data.frame.table(x, responseName = value.name,
+                              stringsAsFactors = FALSE)
+  colnames(long)[seq_along(varnames)] <- varnames
+
+  long[[varnames[1]]] <- as.integer(long[[varnames[1]]])  # Draw
+  long$Parameter      <- factor(long$Parameter)
   long
 }
 

R/helpers-ppc.R

@@ -239,9 +239,13 @@ from_grouped <- function(dots) {
 #' @noRd
 melt_predictions <- function(predictions) {
   obs_names <- attr(predictions, "obs_names")
-  out <- predictions %>%
-    reshape2::melt(varnames = c("rep_id", "y_id")) %>%
-    tibble::as_tibble()
+  n_reps <- nrow(predictions)
+  n_obs  <- ncol(predictions)
+  out <- tibble::tibble(
+    rep_id = rep(seq_len(n_reps), times = n_obs),
+    y_id   = rep(seq_len(n_obs),  each  = n_reps),
+    value  = as.vector(predictions)
+  )
 
   rep_labels <- create_rep_ids(out$rep_id)
   y_names <- obs_names[out$y_id] %||% out$y_id

R/ppc-discrete.R

@@ -435,8 +435,10 @@ ppc_bars_data <-
     y = y,
     yrep = t(yrep)
   )
+  var_levels <- setdiff(colnames(tmp_data), "group")
   data <-
-    reshape2::melt(tmp_data, id.vars = "group") %>%
+    tidyr::pivot_longer(tmp_data, cols = -group, names_to = "variable", values_to = "value") %>%
+    dplyr::mutate(variable = factor(.data$variable, levels = var_levels)) %>%
     count(.data$group, .data$value, .data$variable) %>%
     tidyr::complete(.data$group, .data$value, .data$variable, fill = list(n = 0)) %>%
     group_by(.data$variable, .data$group) %>%

R/ppd-test-statistics.R

@@ -291,7 +291,9 @@ ppd_stat_data <- function(ypred, group = NULL, stat) {
     ypred = t(predictions)
   )
   colnames(d) <- gsub(".", "_", colnames(d), fixed = TRUE)
-  molten_d <- reshape2::melt(d, id.vars = "group")
+  var_levels <- setdiff(colnames(d), "group")
+  molten_d <- tidyr::pivot_longer(d, cols = -group, names_to = "variable", values_to = "value") %>%
+    dplyr::mutate(variable = factor(.data$variable, levels = var_levels))
   molten_d <- group_by(molten_d, .data$group, .data$variable)
 
   data <-