Add support for ... to some plot_ functions

DESCRIPTION

@@ -19,7 +19,8 @@ Imports:
     stats,
     utils,
     tools,
-    parallel
+    parallel,
+    rlang
 Suggests:
     testthat,
     covr,
@@ -31,6 +32,6 @@ License: MIT + file LICENSE
 Language: en-US
 URL: http://boxuancui.github.io/DataExplorer/
 BugReports: https://github.com/boxuancui/DataExplorer/issues
-RoxygenNote: 7.3.0
+RoxygenNote: 7.3.2
 Encoding: UTF-8
 VignetteBuilder: knitr

NAMESPACE

@@ -33,6 +33,10 @@ importFrom(networkD3,diagonalNetwork)
 importFrom(networkD3,radialNetwork)
 importFrom(parallel,detectCores)
 importFrom(parallel,mclapply)
+importFrom(rlang,enquos)
+importFrom(rlang,eval_tidy)
+importFrom(rlang,expr)
+importFrom(rlang,quo_is_symbolic)
 importFrom(scales,comma)
 importFrom(scales,percent)
 importFrom(stats,complete.cases)
@@ -43,5 +47,6 @@ importFrom(stats,setNames)
 importFrom(tools,toTitleCase)
 importFrom(utils,browseURL)
 importFrom(utils,capture.output)
+importFrom(utils,modifyList)
 importFrom(utils,object.size)
 importFrom(utils,str)

R/plot_bar.r

@@ -14,13 +14,16 @@
 #' @param nrow number of rows per page. Default is 3.
 #' @param ncol number of columns per page. Default is 3.
 #' @param parallel enable parallel? Default is \code{FALSE}.
+#' @param ... aesthetic mappings (e.g., fill = Species, alpha = 0.5)
 #' @return invisibly return the named list of ggplot objects
 #' @keywords plot_bar
 #' @details If a discrete feature contains more categories than \code{maxcat} specifies, it will not be passed to the plotting function.
 #' @import data.table
 #' @import ggplot2
+#' @importFrom rlang enquos quo_is_symbolic eval_tidy expr
 #' @importFrom stats reorder
 #' @importFrom tools toTitleCase
+#' @importFrom utils modifyList
 #' @export
 #' @examples
 #' # Plot bar charts for diamonds dataset
@@ -41,7 +44,12 @@ plot_bar <- function(data, with = NULL,
                      title = NULL,
                      ggtheme = theme_gray(), theme_config = list(),
                      nrow = 3L, ncol = 3L,
-                     parallel = FALSE) {
+                     parallel = FALSE,
+                     ...) {
+  # Ensure this works when data is a vector, like the vignette
+  if (!is.data.frame(data)) {
+    data <- data.frame(value = data)
+  }
   ## Declare variable first to pass R CMD check
   frequency <- measure <- variable <- value <- facet_value <- NULL
   ## Check if input is data.table
@@ -75,6 +83,8 @@ plot_bar <- function(data, with = NULL,
     tmp_dt <- data.table(discrete, "measure" = measure_var)
     dt <- tmp_dt[, list(frequency = sum(measure, na.rm = TRUE)), by = feature_names]
   }
+
+  ## Reshape for plotting
   if (is.null(by)) {
     dt_tmp <- suppressWarnings(melt.data.table(dt, measure.vars = feature_names))
     dt2 <- dt_tmp[, list(frequency = sum(frequency)), by = list(variable, value)]
@@ -83,35 +93,49 @@ plot_bar <- function(data, with = NULL,
     dt_tmp <- suppressWarnings(melt.data.table(dt, measure.vars = setdiff(feature_names, by)))
     dt2 <- dt_tmp[, list(frequency = sum(frequency)), by = c("variable", "value", by)]
   }
+
   dt2[, facet_value := paste0(value, "___", variable)]
   ## Calculate number of pages
+  other_vars <- setdiff(names(data), names(dt2))
+  if (length(other_vars) > 0) {
+    dt2 <- cbind(
+      dt2,
+      data[rep(seq_len(nrow(data)), times = length(feature_names)), ..other_vars]
+    )
+  }
+  ## Calculate number of pages
   layout <- .getPageLayout(nrow, ncol, ncol(discrete))
   ## Create list of ggplot objects
   plot_list <- .lapply(
     parallel = parallel,
     X = layout,
     FUN = function(x) {
-      if (order_bar) {
-        base_plot <- ggplot(dt2[variable %in% feature_names[x]],
-                            aes(x = reorder(facet_value, frequency), y = frequency))
-      } else {
-        base_plot <- ggplot(dt2[variable %in% feature_names[x]], aes(x = value, y = frequency))
-      }
-      if (is.null(by)) {
-        base_plot2 <- base_plot +
-          geom_bar(stat = "identity") +
-          ylab(ifelse(is.null(with), "Frequency", toTitleCase(with)))
+      df <- dt2[variable %in% feature_names[x]]
+
+      # Capture extra parameters using ...
+      dots_list <- enquos(...)
+      flags <- vapply(dots_list, rlang::quo_is_symbolic, logical(1))
+      mapped_aes <- dots_list[flags]
+      constant_aes <- dots_list[!flags]
+      aes_base <- if (order_bar) {
+        aes(x = reorder(facet_value, frequency), y = frequency)
       } else {
-        base_plot2 <- base_plot +
-          geom_bar(stat = "identity", aes_string(fill = by), position = by_position) +
-          ylab("")
+        aes(x = value, y = frequency)
       }
-      base_plot2 +
+      aes_all <- modifyList(aes_base, eval_tidy(expr(aes(!!!mapped_aes))))
+      layer_args <- c(
+        list(stat = "identity", position = by_position),
+        lapply(constant_aes, eval_tidy)
+      )
+      ggplot(df, aes_all) +
+        do.call("geom_bar", layer_args) +
+        ylab(ifelse(is.null(with), "Frequency", tools::toTitleCase(with))) +
         scale_x_discrete(labels = function(x) tstrsplit(x, "___")[[1]]) +
         coord_flip() +
         xlab("")
     }
   )
+
   ## Plot objects
   class(plot_list) <- c("multiple", class(plot_list))
   plotDataExplorer(

R/plot_boxplot.r

@@ -13,10 +13,12 @@
 #' @param nrow number of rows per page
 #' @param ncol number of columns per page
 #' @param parallel enable parallel? Default is \code{FALSE}.
+#' @param ... aesthetic mappings (e.g., fill = Species, alpha = 0.5)
 #' @return invisibly return the named list of ggplot objects
 #' @keywords plot_boxplot
 #' @import data.table
 #' @import ggplot2
+#' @importFrom utils modifyList
 #' @export
 #' @seealso \link{geom_boxplot}
 #' @examples
@@ -41,7 +43,12 @@ plot_boxplot <- function(data, by,
                          title = NULL,
                          ggtheme = theme_gray(), theme_config = list(),
                          nrow = 3L, ncol = 4L,
-                         parallel = FALSE) {
+                         parallel = FALSE,
+                         ...) {
+  # Ensure this works when data is a vector, like the vignette
+  if (!is.data.frame(data)) {
+    data <- data.frame(value = data)
+  }
   ## Declare variable first to pass R CMD check
   variable <- by_f <- value <- NULL
   ## Check if input is data.table
@@ -60,6 +67,16 @@ plot_boxplot <- function(data, by,
     dt <- suppressWarnings(melt.data.table(data.table(continuous, "by_f" = by_feature), id.vars = "by_f", variable.factor = FALSE))
   }
   dt2 <- dt[variable != by]
+
+  ## Replicate other columns for use in ...
+  other_vars <- setdiff(names(data), names(dt2))
+  if (length(other_vars) > 0) {
+    dt2 <- cbind(
+      dt2,
+      data[rep(seq_len(nrow(data)), times = ncol(continuous)), ..other_vars]
+    )
+  }
+
   feature_names <- unique(dt2[["variable"]])
   ## Calculate number of pages
   layout <- .getPageLayout(nrow, ncol, length(feature_names))
@@ -68,8 +85,18 @@ plot_boxplot <- function(data, by,
     parallel = parallel,
     X = layout,
     FUN = function(x) {
-      base_plot <- ggplot(dt2[variable %in% feature_names[x]], aes(x = by_f, y = value)) +
-        do.call("geom_boxplot", geom_boxplot_args) +
+      dots_list <- rlang::enquos(...)
+      flags <- vapply(dots_list, rlang::quo_is_symbolic, logical(1))
+      mapped_aes <- dots_list[flags]
+      constant_aes <- dots_list[!flags]
+
+      aes_base <- aes(x = by_f, y = value)
+      aes_combined <- modifyList(aes_base, rlang::eval_tidy(rlang::expr(aes(!!!mapped_aes))))
+
+      layer_args <- c(geom_boxplot_args, lapply(constant_aes, rlang::eval_tidy))
+
+      base_plot <- ggplot(dt2[variable %in% feature_names[x]], mapping = aes_combined) +
+        do.call("geom_boxplot", layer_args) +
         do.call(paste0("scale_y_", scale_y), list()) +
         coord_flip() +
         xlab(by)
@@ -93,3 +120,4 @@ plot_boxplot <- function(data, by,
     )
   )
 }
+

R/plot_density.r

@@ -11,10 +11,12 @@
 #' @param nrow number of rows per page. Default is 4.
 #' @param ncol number of columns per page. Default is 4.
 #' @param parallel enable parallel? Default is \code{FALSE}.
+#' @param ... aesthetic mappings (e.g., fill = Species, alpha = 0.5)
 #' @return invisibly return the named list of ggplot objects
 #' @keywords plot_density
 #' @import data.table
 #' @import ggplot2
+#' @importFrom utils modifyList
 #' @export
 #' @seealso \link{geom_density} \link{plot_histogram}
 #' @examples
@@ -36,7 +38,12 @@ plot_density <- function(data, binary_as_factor = TRUE,
                          title = NULL,
                          ggtheme = theme_gray(), theme_config = list(),
                          nrow = 4L, ncol = 4L,
-                         parallel = FALSE) {
+                         parallel = FALSE,
+                         ...) {
+  # Ensure this works when data is a vector, like the vignette
+  if (!is.data.frame(data)) {
+    data <- data.frame(value = data)
+  }
   ## Declare variable first to pass R CMD check
   variable <- value <- NULL
   ## Check if input is data.table
@@ -48,15 +55,33 @@ plot_density <- function(data, binary_as_factor = TRUE,
   continuous <- split_data$continuous
   feature_names <- names(continuous)
   dt <- suppressWarnings(melt.data.table(continuous, measure.vars = feature_names, variable.factor = FALSE))
+
+  ## Replicate other columns so mapped aesthetics work
+  other_vars <- setdiff(names(data), names(dt))
+  if (length(other_vars) > 0) {
+    dt <- cbind(
+      dt,
+      data[rep(seq_len(nrow(data)), times = length(feature_names)), ..other_vars]
+    )
+  }
+
   ## Calculate number of pages
   layout <- .getPageLayout(nrow, ncol, ncol(continuous))
   ## Create ggplot object
   plot_list <- .lapply(
     parallel = parallel,
     X = layout,
     FUN = function(x) {
-      ggplot(dt[variable %in% feature_names[x]], aes(x = value)) +
-        do.call("geom_density", c("na.rm" = TRUE, geom_density_args)) +
+      dots_list <- rlang::enquos(...)
+      flags <- vapply(dots_list, rlang::quo_is_symbolic, logical(1))
+      mapped_aes <- dots_list[flags]
+      constant_aes <- dots_list[!flags]
+
+      aes_combined <- modifyList(aes(x = value), rlang::eval_tidy(rlang::expr(aes(!!!mapped_aes))))
+      layer_args <- c(list(na.rm = TRUE), geom_density_args, lapply(constant_aes, rlang::eval_tidy))
+
+      ggplot(dt[variable %in% feature_names[x]], mapping = aes_combined) +
+        do.call("geom_density", layer_args) +
         do.call(paste0("scale_x_", scale_x), list()) +
         ylab("Density")
     }

R/plot_histogram.r

@@ -11,13 +11,17 @@
 #' @param nrow number of rows per page. Default is 4.
 #' @param ncol number of columns per page. Default is 4.
 #' @param parallel enable parallel? Default is \code{FALSE}.
+#' @param ... aesthetic mappings passed to \link{aes}, such as \code{fill = group}, or constants like \code{alpha = 0.5}
 #' @return invisibly return the named list of ggplot objects
 #' @keywords plot_histogram
 #' @import data.table
 #' @import ggplot2
+#' @importFrom utils modifyList
+#' @importFrom rlang enquos quo_is_symbolic eval_tidy expr
 #' @export
 #' @seealso \link{geom_histogram} \link{plot_density}
 #' @examples
+#' plot_histogram(iris, fill = Species, alpha = 0.5, ncol = 2L)
 #' # Plot iris data
 #' plot_histogram(iris, ncol = 2L)
 #'
@@ -26,14 +30,18 @@
 #' skew <- data.frame(replicate(4L, rbeta(1000, 1, 5000)))
 #' plot_histogram(skew, ncol = 2L)
 #' plot_histogram(skew, scale_x = "log10", ncol = 2L)
-
 plot_histogram <- function(data, binary_as_factor = TRUE,
                            geom_histogram_args = list("bins" = 30L),
                            scale_x = "continuous",
                            title = NULL,
                            ggtheme = theme_gray(), theme_config = list(),
                            nrow = 4L, ncol = 4L,
-                           parallel = FALSE) {
+                           parallel = FALSE,
+                           ...) {
+  # Ensure this works when data is a vector, like the vignette
+  if (!is.data.frame(data)) {
+    data <- data.frame(value = data)
+  }
   ## Declare variable first to pass R CMD check
   variable <- value <- NULL
   ## Check if input is data.table
@@ -45,15 +53,39 @@ plot_histogram <- function(data, binary_as_factor = TRUE,
   continuous <- split_data$continuous
   feature_names <- names(continuous)
   dt <- suppressWarnings(melt.data.table(continuous, measure.vars = feature_names, variable.factor = FALSE))
+  # Copy over non-measured columns (e.g., grouping vars like 'Species')
+  other_vars <- setdiff(names(data), names(dt))
+  if (length(other_vars) > 0) {
+    dt <- cbind(
+      dt,
+      data[rep(seq_len(nrow(data)), times = length(feature_names)), ..other_vars]
+    )
+  }
+
+  # Capture and split mapped vs constant aesthetics
+  dots_list <- enquos(...)
+  flags <- vapply(dots_list, rlang::quo_is_symbolic, logical(1))
+  mapped_aes <- dots_list[flags]
+  constant_aes <- dots_list[!flags]
+
+  # Combine x aesthetic with any mapped ones
+  aes_combined <- modifyList(aes(x = value), eval_tidy(expr(aes(!!!mapped_aes))))
+
   ## Calculate number of pages
   layout <- .getPageLayout(nrow, ncol, ncol(continuous))
   ## Create ggplot object
   plot_list <- .lapply(
     parallel = parallel,
     X = layout,
     FUN = function(x) {
-      ggplot(dt[variable %in% feature_names[x]], aes(x = value)) +
-        do.call("geom_histogram", c("na.rm" = TRUE, geom_histogram_args)) +
+      layer_args <- c(
+        list(na.rm = TRUE),
+        geom_histogram_args,
+        lapply(constant_aes, eval_tidy)
+      )
+
+      ggplot(dt[variable %in% feature_names[x]], mapping = aes_combined) +
+        do.call("geom_histogram", layer_args) +
         do.call(paste0("scale_x_", scale_x), list()) +
         ylab("Frequency")
     }