remove ggplot2 internals

DESCRIPTION

@@ -23,13 +23,11 @@ Imports:
     htmltools,
     patchwork,
     purrr,
-    ragg,
     rlang,
     scales,
     stringr,
-    svglite,
     tidyr,
-    vdiffr
+    tidyselect
 Depends: 
     R (>= 2.10)
 LazyData: true
@@ -38,6 +36,7 @@ BugReports: https://github.com/jbengler/tidyplots/issues
 Suggests: 
     knitr,
     rmarkdown,
-    testthat (>= 3.0.0)
+    testthat (>= 3.0.0),
+    vdiffr
 VignetteBuilder: knitr
 Config/testthat/edition: 3

NAMESPACE

@@ -134,3 +134,13 @@ export(theme_minimal_y)
 export(theme_tidyplot)
 export(tidyplot)
 export(view_plot)
+importFrom(grDevices,col2rgb)
+importFrom(grDevices,dev.off)
+importFrom(grDevices,pdf)
+importFrom(grDevices,rgb)
+importFrom(rlang,":=")
+importFrom(rlang,.data)
+importFrom(stats,density)
+importFrom(stats,sd)
+importFrom(stats,setNames)
+importFrom(utils,tail)

R/aaa.R

@@ -1,3 +1,13 @@
+#' @importFrom grDevices col2rgb rgb dev.off pdf
+#' @importFrom stats density sd setNames
+#' @importFrom utils tail
+#' @importFrom rlang := .data
+NULL
+
+utils::globalVariables(c(".", ".single_color", "Lower", "Mean", "Upper", "aesthetic",
+                         "col_zscore", "count", "row_zscore", "variable", "x", "y"))
+
+
 color_palettes <- list(
   black_blue_pink_yellow = c(
     "#161523","#171943","#2C2E68","#2E3D88","#3F519D","#48569F","#5F569F",

R/add-heatmap.R

@@ -15,8 +15,8 @@ add_heatmap <- function(plot, scale = c("none", "row", "column"), rotate_labels
     y <- get_variable(plot, "y")
     out <-
       plot$data %>%
-      dplyr::mutate(row_zscore = (.data[[color]] - mean(.data[[color]])) / sd(.data[[color]]), .by = all_of(y)) %>%
-      dplyr::mutate(col_zscore = (.data[[color]] - mean(.data[[color]])) / sd(.data[[color]]), .by = all_of(x))
+      dplyr::mutate(row_zscore = (.data[[color]] - mean(.data[[color]])) / sd(.data[[color]]), .by = tidyselect::all_of(y)) %>%
+      dplyr::mutate(col_zscore = (.data[[color]] - mean(.data[[color]])) / sd(.data[[color]]), .by = tidyselect::all_of(x))
     plot <- plot %+% out
     if (scale == "row")
       mapping <- ggplot2::aes(fill = row_zscore)

R/add-proportional.R

@@ -122,7 +122,7 @@ ff_areastack <- function(.position_fun) {
         vars <- c(get_variable(plot, "x"), get_variable(plot, "colour"))
         plot$data <-
           plot$data %>%
-          dplyr::summarize(count = dplyr::n(), .by = all_of(vars)) %>%
+          dplyr::summarize(count = dplyr::n(), .by = tidyselect::all_of(vars)) %>%
           tidyr::complete(.data[[vars[1]]], .data[[vars[2]]], fill = list(count = 0))
         mapping$y <- ggplot2::aes(y = count)$y
         plot <- plot %>%
@@ -146,7 +146,7 @@ ff_areastack <- function(.position_fun) {
         vars <- c(get_variable(plot, "y"), get_variable(plot, "colour"))
         plot$data <-
           plot$data %>%
-          dplyr::summarize(count = dplyr::n(), .by = all_of(vars)) %>%
+          dplyr::summarize(count = dplyr::n(), .by = tidyselect::all_of(vars)) %>%
           tidyr::complete(.data[[vars[1]]], .data[[vars[2]]], fill = list(count = 0))
         mapping$x <- ggplot2::aes(x = count)$x
         plot <- plot %>%
@@ -180,7 +180,7 @@ ff_areastack <- function(.position_fun) {
         names(zero) <- y_var
         plot$data <-
           plot$data %>%
-          dplyr::summarize("{y_var}" := sum(.data[[y_var]]), .by = all_of(vars)) %>%
+          dplyr::summarize("{y_var}" := sum(.data[[y_var]]), .by = tidyselect::all_of(vars)) %>%
           tidyr::complete(.data[[vars[1]]], .data[[vars[2]]], fill = zero)
         plot <- plot %>%
           remove_plot_area_padding(force_continuous = TRUE) +

R/plot.R

@@ -70,9 +70,6 @@ view_plot <- function(plot, data = all_rows(), title = ggplot2::waiver(), ...) {
   invisible(input)
 }
 
-# plot %>% view_plot(data = filter_rows(sex == "female"), title = "bla")
-# plot %>% view_plot(data = study %>% dplyr::slice_sample(n = 4), title = "bla")
-
 multipage_plots <- function(plot,
                             ncol = NULL,
                             nrow = NULL,
@@ -170,7 +167,7 @@ split_plot <- function(plot,
 #' @inheritParams ggplot2::ggsave
 #'
 #' @export
-save_plot <- function(plot = last_plot(), filename, device = NULL, path = NULL, scale = 1,
+save_plot <- function(plot = ggplot2::last_plot(), filename, device = NULL, path = NULL, scale = 1,
                            width = NA, height = NA, units = c("mm", "cm", "in"), dpi = 300, limitsize = TRUE,
                            multiple_files = FALSE, bg = "transparent", ...) {
   if (!ggplot2::is.ggplot(plot) && !all(purrr::map_lgl(plot, ggplot2::is.ggplot)))
@@ -219,32 +216,20 @@ save_plot <- function(plot = last_plot(), filename, device = NULL, path = NULL,
 
   } else {
 
-    if (length(filename) != 1) {
-      if (length(filename) == 0) {
-        cli::cli_abort("{.arg filename} cannot be empty.")
-      }
-      len <- length(filename)
-      filename <- filename[1]
-      cli::cli_warn(c(
-        "{.arg filename} must have length 1, not length {len}.",
-        "!" = "Only the first, {.file {filename}}, will be used."
-      ))
-    }
-
-    dev <- plot_dev(device, filename, dpi = dpi)
-    dim <- plot_dim(c(width, height), scale = scale, units = units,
-                    limitsize = limitsize, dpi = dpi)
-
-    if (!is.null(path)) {
-      filename <- file.path(path, filename)
-    }
-    old_dev <- grDevices::dev.cur()
-    dev(filename = filename, width = dim[1], height = dim[2], bg = bg, ...)
-    on.exit(utils::capture.output({
-      grDevices::dev.off()
-      if (old_dev > 1) grDevices::dev.set(old_dev) # restore old device unless null device
-    }))
-    purrr::map(plot, ~grid::grid.draw(.x))
+    unit_factor <- switch(
+      units,
+      "mm"= 25.4,
+      "cm"= 2.54,
+      "in"= 1
+    )
+
+    width <- width / unit_factor
+    height <- height / unit_factor
+
+    pdf(file = filename, width = width, height = height)
+    invisible(lapply(plot, print))
+    dev.off()
+
   }
   invisible(input)
 }

data-raw/testing.R

@@ -391,6 +391,29 @@ ggplot(data, aes(x = category, y = value)) +
 ggplot(data, aes(x = category, y = value)) +
   custom_stat_summary2(orientation = "y")
 
+###
 
+gene_expression %>%
+  tidyplot(x = sample_type, y = expression, color = condition) %>%
+  add_mean_dash() %>%
+  add_error_bar() %>%
+  add_data_points() %>%
+  add_stats_asterisks(include_info = FALSE) %>%
+  split_plot(by = external_gene_name, ncol = 3, nrow = 3) %>%
+  save_plot("multipage2.pdf")
 
+gene_expression %>%
+  tidyplot(x = sample_type, y = expression, color = condition) %>%
+  add_mean_dash() %>%
+  add_error_bar() %>%
+  add_data_points() %>%
+  add_stats_asterisks() %>%
+  split_plot(by = external_gene_name, ncol = 3, nrow = 3) %>%
+  save_plot("multipage3.pdf", units = "cm")
 
+gene_expression %>%
+  tidyplot(x = sample_type, y = expression, color = condition) %>%
+  add_mean_dash() %>%
+  add_error_bar() %>%
+  split_plot(by = external_gene_name, ncol = 3, nrow = 3) %>%
+  save_plot("multipage4.pdf", units = "in")