From 1c748c8751d28896dae7df1c5c7d6975154bfb6d Mon Sep 17 00:00:00 2001 From: William Hutchison Date: Wed, 12 Mar 2025 14:07:38 +1100 Subject: [PATCH 1/6] Add basic point rasterisation ability --- R/methods.R | 61 ++++++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 58 insertions(+), 3 deletions(-) diff --git a/R/methods.R b/R/methods.R index 631affa..375feaf 100755 --- a/R/methods.R +++ b/R/methods.R @@ -206,10 +206,16 @@ gate_int.numeric = function( .dim1, #' @importFrom ggplot2 scale_alpha_manual #' @importFrom ggplot2 scale_shape_manual #' @importFrom ggplot2 guides +#' @importFrom ggplot2 margin #' @importFrom ggplot2 theme_bw +#' @importFrom ggplot2 theme_void #' @importFrom ggplot2 theme +#' @importFrom plotly ggplotly +#' @importFrom plotly layout +#' @importFrom plotly config #' @importFrom shiny shinyApp #' @importFrom shiny runApp +#' @importFrom xfun base64_uri #' #' @param x A vector representing the X dimension. #' @param y A vector representing the Y dimension. @@ -224,7 +230,7 @@ gate_int.numeric = function( .dim1, #' @return A vector of strings, of the gates each X and Y coordinate pair is within. If gates are #' drawn interactively, they are temporarily saved to `tidygate_env$gates` gate_interactive <- - function(x, y, colour = NULL, shape = NULL, alpha = 1, size = 2) { + function(x, y, colour = NULL, shape = NULL, alpha = 1, size = 2, rasterise_points = FALSE) { # Check input values are valid if (!rlang::quo_is_null(shape)) { @@ -291,6 +297,7 @@ gate_interactive <- plot <- data |> ggplot2::ggplot(ggplot2::aes(x = x, y = y, key = .key)) + + # ggrastr::rasterise(ggplot2::geom_point(), dpi = 5) + ggplot2::geom_point() + ggplot2::labs(x = rlang::quo_name(x), y = rlang::quo_name(y)) + theme_bw() @@ -362,6 +369,48 @@ gate_interactive <- ggplot2::guides(size = "none") } } + + # # Rasterise plot + if (rasterise_points == TRUE) { + + # Create version of plot with no borders, axis or margins + plot <- + plot + + ggplot2::theme_void() + # Remove background, axes, etc. + theme( + plot.margin = ggplot2::margin(0, 0, 0, 0), # Remove any plot margins + legend.position = "none" + ) + + # Save plot as image + temp_file <- + tempfile(fileext = ".png") + + temp_file |> + ggsave(plot = plot, width = 8, height = 8, dpi = 300) + + # Create plot with only borders, axis and margins + plot_empty <- + data |> + ggplot2::ggplot(ggplot2::aes(x = x, y = y, key = .key)) + + ggplot2::theme_minimal() + + # Combine plots + plot <- + plot_empty |> + plotly::ggplotly(tooltip = NULL) |> + plotly::layout(images = list( + list( + source = xfun::base64_uri(temp_file), + x = 0, y = 1, xref = "paper", yref = "paper", # Positioning + sizex = 1, sizey = 1, + xanchor = "left", yanchor = "top", + sizing = "stretch" + )), + dragmode = "lasso" + ) |> + plotly::config(modeBarButtonsToRemove = c("zoomIn2d", "zoomOut2d", "select2d", "pan2d")) + } # Create environment and save input variables tidygate_env <<- rlang::env() @@ -380,6 +429,12 @@ gate_interactive <- shiny::runApp(app, port = 1234) |> purrr::map_chr(~ .x |> paste(collapse = ",")) |> purrr::map_chr(~ ifelse(.x == "", NA, .x)) + + # Gate point programmatically now if using rasterisation + if (rasterise_points == TRUE) { + gate_vector <- + gate_programmatic(x = data$x, y = data$y, programmatic_gates = tidygate_env$gates) + } message("tidygate says: interactively drawn gates are temporarily saved to tidygate_env$gates") return(gate_vector) @@ -473,11 +528,11 @@ gate_programmatic <- #' mutate(gated = gate(x = mpg, y = wt, programmatic_gates = demo_gate_data)) #' @export gate <- - function(x, y, colour = NULL, shape = NULL, alpha = 1, size = 2, programmatic_gates = NULL) { + function(x, y, colour = NULL, shape = NULL, alpha = 1, size = 2, rasterise_points = FALSE, programmatic_gates = NULL) { if (is.null(programmatic_gates)) { gate_interactive(x = enquo(x), y = enquo(y), colour = enquo(colour), shape = enquo(shape), - alpha = enquo(alpha), size = enquo(size)) + alpha = enquo(alpha), size = enquo(size), rasterise_points = rasterise_points) } else { gate_programmatic(x = x, y = y, programmatic_gates = programmatic_gates) } From 7567d4564d35e81b8bf2ec5c36b4b2fae1b666b2 Mon Sep 17 00:00:00 2001 From: William Hutchison Date: Wed, 12 Mar 2025 14:33:15 +1100 Subject: [PATCH 2/6] Add colour legend to rasterised gating --- R/methods.R | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/R/methods.R b/R/methods.R index 375feaf..b38292d 100755 --- a/R/methods.R +++ b/R/methods.R @@ -204,12 +204,13 @@ gate_int.numeric = function( .dim1, #' @importFrom ggplot2 scale_colour_manual #' @importFrom ggplot2 scale_shape_manual #' @importFrom ggplot2 scale_alpha_manual -#' @importFrom ggplot2 scale_shape_manual +#' @importFrom ggplot2 scale_colour_distiller #' @importFrom ggplot2 guides #' @importFrom ggplot2 margin #' @importFrom ggplot2 theme_bw #' @importFrom ggplot2 theme_void #' @importFrom ggplot2 theme +#' @importFrom ggplot2 ggsave #' @importFrom plotly ggplotly #' @importFrom plotly layout #' @importFrom plotly config @@ -310,7 +311,7 @@ gate_interactive <- plot <- plot + ggplot2::aes(colour = !!colour) + - ggplot2::scale_colour_distiller(palette="Spectral") + ggplot2::scale_colour_distiller(palette = "Spectral") # Set to equal constant if not a column symbol and remove legend } else { @@ -383,17 +384,19 @@ gate_interactive <- ) # Save plot as image - temp_file <- + temp_file <- tempfile(fileext = ".png") temp_file |> - ggsave(plot = plot, width = 8, height = 8, dpi = 300) + ggplot2::ggsave(plot = plot, width = 8, height = 8, dpi = 300) # Create plot with only borders, axis and margins plot_empty <- data |> - ggplot2::ggplot(ggplot2::aes(x = x, y = y, key = .key)) + - ggplot2::theme_minimal() + ggplot2::ggplot(ggplot2::aes(x = x, y = y, key = .key, colour = !!colour, shape = !!shape, alpha = !!alpha, size = !!size)) + + ggplot2::geom_point(alpha = 0) + + ggplot2::scale_colour_distiller(palette = "Spectral") + + ggplot2::theme_bw() # Combine plots plot <- From 78ca44cf930656abc6ecf25a7efd43abddcdc7a3 Mon Sep 17 00:00:00 2001 From: William Hutchison Date: Thu, 13 Mar 2025 12:22:30 +1100 Subject: [PATCH 3/6] Polish rasterised gating --- DESCRIPTION | 5 +++-- NAMESPACE | 7 ++++++ R/gate_app.R | 7 +----- R/methods.R | 48 ++++++++++++++++++++++++----------------- README.Rmd | 2 +- man/gate.Rd | 5 +++++ man/gate_interactive.Rd | 6 +++++- 7 files changed, 50 insertions(+), 30 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 6993dc0..449d6eb 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -24,7 +24,7 @@ Description: License: GPL-3 Encoding: UTF-8 LazyData: true -RoxygenNote: 7.3.1 +RoxygenNote: 7.3.2 Depends: R (>= 3.6.0) Imports: @@ -44,7 +44,8 @@ Imports: stringr, shiny, plotly, - ggplot2 + ggplot2, + xfun RdMacros: lifecycle Suggests: testthat, diff --git a/NAMESPACE b/NAMESPACE index 368ae90..e8833f7 100755 --- a/NAMESPACE +++ b/NAMESPACE @@ -20,12 +20,16 @@ importFrom(dplyr,summarise) importFrom(ggplot2,aes) importFrom(ggplot2,geom_point) importFrom(ggplot2,ggplot) +importFrom(ggplot2,ggsave) importFrom(ggplot2,guides) +importFrom(ggplot2,margin) importFrom(ggplot2,scale_alpha_manual) +importFrom(ggplot2,scale_colour_distiller) importFrom(ggplot2,scale_colour_manual) importFrom(ggplot2,scale_shape_manual) importFrom(ggplot2,theme) importFrom(ggplot2,theme_bw) +importFrom(ggplot2,theme_void) importFrom(grDevices,colorRampPalette) importFrom(graphics,axis) importFrom(graphics,legend) @@ -38,8 +42,10 @@ importFrom(lifecycle,deprecate_warn) importFrom(magrittr,"%>%") importFrom(magrittr,equals) importFrom(magrittr,set_rownames) +importFrom(plotly,config) importFrom(plotly,event_data) importFrom(plotly,ggplotly) +importFrom(plotly,layout) importFrom(plotly,plotlyOutput) importFrom(plotly,renderPlotly) importFrom(purrr,imap) @@ -77,3 +83,4 @@ importFrom(tibble,tibble) importFrom(utils,globalVariables) importFrom(utils,head) importFrom(viridis,viridis) +importFrom(xfun,base64_uri) diff --git a/R/gate_app.R b/R/gate_app.R index e8dfffe..1d6e254 100644 --- a/R/gate_app.R +++ b/R/gate_app.R @@ -73,12 +73,7 @@ server <- function(input, output, session) { brush_data <- tibble() # Draw plot - output$plot <- plotly::renderPlotly({ - tidygate_env$input_plot |> - plotly::ggplotly(tooltip = NULL) |> - plotly::layout(dragmode = "lasso") |> - plotly::config(modeBarButtonsToRemove = c("zoomIn2d", "zoomOut2d", "select2d")) - }) + output$plot <- plotly::renderPlotly({tidygate_env$input_plot}) # Get selection information output$select <- diff --git a/R/methods.R b/R/methods.R index b38292d..e33a826 100755 --- a/R/methods.R +++ b/R/methods.R @@ -228,10 +228,13 @@ gate_int.numeric = function( .dim1, #' point alpha, either a numeric or factor of 6 or less levels. #' @param size A single ggplot2 size numeric ranging from 0 to 20. Or, a vector representing the #' point size, either a numeric or factor of 6 or less levels. +#' @param rasterise_points A logical. If TRUE, points are rasterised to an image before interactive +#' gating is launched, improving performance for large datasets. Some interactive features are +#' unavailable with rasterisation enabled. #' @return A vector of strings, of the gates each X and Y coordinate pair is within. If gates are #' drawn interactively, they are temporarily saved to `tidygate_env$gates` gate_interactive <- - function(x, y, colour = NULL, shape = NULL, alpha = 1, size = 2, rasterise_points = FALSE) { + function(x, y, colour, shape, alpha, size, rasterise_points) { # Check input values are valid if (!rlang::quo_is_null(shape)) { @@ -310,8 +313,7 @@ gate_interactive <- if (rlang::quo_is_symbol(colour)) { plot <- plot + - ggplot2::aes(colour = !!colour) + - ggplot2::scale_colour_distiller(palette = "Spectral") + ggplot2::aes(colour = !!colour) # Set to equal constant if not a column symbol and remove legend } else { @@ -371,15 +373,15 @@ gate_interactive <- } } - # # Rasterise plot + # Create rasterised plot and convert to plotly if (rasterise_points == TRUE) { - # Create version of plot with no borders, axis or margins + # Create version of plot with no borders, axis, margins or legends plot <- plot + - ggplot2::theme_void() + # Remove background, axes, etc. - theme( - plot.margin = ggplot2::margin(0, 0, 0, 0), # Remove any plot margins + ggplot2::theme_void() + + ggplot2::theme( + plot.margin = ggplot2::margin(0, 0, 0, 0), legend.position = "none" ) @@ -388,15 +390,14 @@ gate_interactive <- tempfile(fileext = ".png") temp_file |> - ggplot2::ggsave(plot = plot, width = 8, height = 8, dpi = 300) + ggplot2::ggsave(plot = plot, width = 5, height = 5, dpi = 300) - # Create plot with only borders, axis and margins + # Create plot with only borders, axis, margins and legends plot_empty <- data |> ggplot2::ggplot(ggplot2::aes(x = x, y = y, key = .key, colour = !!colour, shape = !!shape, alpha = !!alpha, size = !!size)) + ggplot2::geom_point(alpha = 0) + - ggplot2::scale_colour_distiller(palette = "Spectral") + - ggplot2::theme_bw() + ggplot2::theme_bw() # Combine plots plot <- @@ -405,14 +406,24 @@ gate_interactive <- plotly::layout(images = list( list( source = xfun::base64_uri(temp_file), - x = 0, y = 1, xref = "paper", yref = "paper", # Positioning + x = 0, y = 1, xref = "paper", yref = "paper", sizex = 1, sizey = 1, xanchor = "left", yanchor = "top", sizing = "stretch" )), dragmode = "lasso" ) |> - plotly::config(modeBarButtonsToRemove = c("zoomIn2d", "zoomOut2d", "select2d", "pan2d")) + + # Prevent any actions which could disalign points and plot + plotly::config(modeBarButtonsToRemove = c("zoom2d", "zoomIn2d", "zoomOut2d", "pan2d", "autoScale2d", "resetScale2d", "hoverClosestCartesian", "hoverCompareCartesian", "select2d")) + + # Convert ggplot directly to plotly + } else { + plot <- + plot |> + plotly::ggplotly(tooltip = NULL) |> + plotly::layout(dragmode = "lasso") |> + plotly::config(modeBarButtonsToRemove = c("select2d", "hoverClosestCartesian", "hoverCompareCartesian")) } # Create environment and save input variables @@ -433,12 +444,6 @@ gate_interactive <- purrr::map_chr(~ .x |> paste(collapse = ",")) |> purrr::map_chr(~ ifelse(.x == "", NA, .x)) - # Gate point programmatically now if using rasterisation - if (rasterise_points == TRUE) { - gate_vector <- - gate_programmatic(x = data$x, y = data$y, programmatic_gates = tidygate_env$gates) - } - message("tidygate says: interactively drawn gates are temporarily saved to tidygate_env$gates") return(gate_vector) } @@ -511,6 +516,9 @@ gate_programmatic <- #' point alpha, either a numeric or factor of 6 or less levels. #' @param size A single ggplot2 size numeric ranging from 0 to 20. Or, a vector representing the #' point size, either a numeric or factor of 6 or less levels. +#' @param rasterise_points A logical. If TRUE, points are rasterised to an image before interactive +#' gating is launched, improving performance for large datasets. Some interactive features are +#' unavailable with rasterisation enabled. #' @param programmatic_gates A `data.frame` of the gate brush data, as saved in #' `tidygate_env$gates`. The column `x` records X coordinates, the column `y` records Y coordinates and the column `.gate` #' records the gate number. When this argument is supplied, gates will be drawn programmatically. diff --git a/README.Rmd b/README.Rmd index 258121a..a0e73e2 100755 --- a/README.Rmd +++ b/README.Rmd @@ -61,7 +61,7 @@ By default, `gate` creates an interactive scatter plot based on user-defined X a Once the plot has been created, multiple gates can be drawn with the mouse. When you have finished, click continue. `gate` will then return a vector of strings, recording the gates each X and Y coordinate pair is within. ```{r eval=FALSE} -mtcars_gated <- +mtcars_gated <- mtcars |> mutate(gated = gate(x = mpg, y = wt, colour = disp)) ``` diff --git a/man/gate.Rd b/man/gate.Rd index 6063f5b..6173db5 100644 --- a/man/gate.Rd +++ b/man/gate.Rd @@ -11,6 +11,7 @@ gate( shape = NULL, alpha = 1, size = 2, + rasterise_points = FALSE, programmatic_gates = NULL ) } @@ -31,6 +32,10 @@ point alpha, either a numeric or factor of 6 or less levels.} \item{size}{A single ggplot2 size numeric ranging from 0 to 20. Or, a vector representing the point size, either a numeric or factor of 6 or less levels.} +\item{rasterise_points}{A logical. If TRUE, points are rasterised to an image before interactive +gating is launched, improving performance for large datasets. Some interactive features are +unavailable with rasterisation enabled.} + \item{programmatic_gates}{A `data.frame` of the gate brush data, as saved in `tidygate_env$gates`. The column `x` records X coordinates, the column `y` records Y coordinates and the column `.gate` records the gate number. When this argument is supplied, gates will be drawn programmatically.} diff --git a/man/gate_interactive.Rd b/man/gate_interactive.Rd index f497925..5d7c7bb 100644 --- a/man/gate_interactive.Rd +++ b/man/gate_interactive.Rd @@ -4,7 +4,7 @@ \alias{gate_interactive} \title{Interactively gate data with a simple scatter plot} \usage{ -gate_interactive(x, y, colour = NULL, shape = NULL, alpha = 1, size = 2) +gate_interactive(x, y, colour, shape, alpha, size, rasterise_points) } \arguments{ \item{x}{A vector representing the X dimension.} @@ -22,6 +22,10 @@ point alpha, either a numeric or factor of 6 or less levels.} \item{size}{A single ggplot2 size numeric ranging from 0 to 20. Or, a vector representing the point size, either a numeric or factor of 6 or less levels.} + +\item{rasterise_points}{A logical. If TRUE, points are rasterised to an image before interactive +gating is launched, improving performance for large datasets. Some interactive features are +unavailable with rasterisation enabled.} } \value{ A vector of strings, of the gates each X and Y coordinate pair is within. If gates are From 8443cdb39abce6c7f68a6be87eb2cfa710cf9121 Mon Sep 17 00:00:00 2001 From: William Hutchison Date: Thu, 13 Mar 2025 12:22:50 +1100 Subject: [PATCH 4/6] Version up --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 449d6eb..d84f6cf 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: tidygate Type: Package Title: Interactively Gate Points -Version: 1.0.14 +Version: 1.0.15 Authors@R: c(person(given = "Stefano", family = "Mangiola", From 32a6ef3f14c6c5162359f2cea27039c3f19ef829 Mon Sep 17 00:00:00 2001 From: William Hutchison Date: Thu, 13 Mar 2025 13:20:55 +1100 Subject: [PATCH 5/6] Update Github action workflow --- .github/workflows/R-CMD-check.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 2420e65..5326c0d 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -49,7 +49,7 @@ jobs: - name: Cache R packages if: runner.os != 'Windows' - uses: actions/cache@v2 + uses: actions/cache@v4 with: path: ${{ env.R_LIBS_USER }} key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }} From 1f7fb980d636381c21437d506755a0b29711dcf4 Mon Sep 17 00:00:00 2001 From: William Hutchison Date: Thu, 13 Mar 2025 13:21:13 +1100 Subject: [PATCH 6/6] Version up --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index d84f6cf..5ae5fd6 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: tidygate Type: Package Title: Interactively Gate Points -Version: 1.0.15 +Version: 1.0.16 Authors@R: c(person(given = "Stefano", family = "Mangiola",