Merge pull request #24 from william-hutchison/upgrade-gating

Upgrade gating

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: tidygate
 Type: Package
 Title: Add Gate Information to Your Tibble
-Version: 0.4.9
+Version: 0.5.2
 Authors@R: 
     c(person(given = "Stefano",
            family = "Mangiola",
@@ -20,7 +20,7 @@ Depends:
     R (>= 3.6.0)
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.1.1
+RoxygenNote: 7.3.1
 Imports: 
     utils,
     graphics,
@@ -35,7 +35,10 @@ Imports:
     viridis,
     grDevices,
     RColorBrewer,
-    stringr
+    stringr,
+    shiny,
+    plotly,
+    ggplot2
 RdMacros: lifecycle
 Suggests: 
     testthat,

NAMESPACE

@@ -7,11 +7,23 @@ S3method(gate_int,numeric)
 export(fhs)
 export(gate)
 export(gate_chr)
+export(gate_custom)
 export(gate_int)
+export(gate_simple)
+export(server)
+export(ui)
 import(dplyr)
 import(tibble)
 import(tidyr)
 importFrom(RColorBrewer,brewer.pal)
+importFrom(dplyr,mutate)
+importFrom(dplyr,rename)
+importFrom(dplyr,select)
+importFrom(ggplot2,aes)
+importFrom(ggplot2,geom_point)
+importFrom(ggplot2,ggplot)
+importFrom(ggplot2,ggplot_build)
+importFrom(ggplot2,theme_bw)
 importFrom(grDevices,colorRampPalette)
 importFrom(graphics,axis)
 importFrom(graphics,legend)
@@ -24,19 +36,34 @@ importFrom(lifecycle,deprecate_warn)
 importFrom(magrittr,"%>%")
 importFrom(magrittr,equals)
 importFrom(magrittr,set_rownames)
+importFrom(plotly,event_data)
+importFrom(plotly,ggplotly)
+importFrom(plotly,plotlyOutput)
+importFrom(plotly,renderPlotly)
 importFrom(purrr,imap)
 importFrom(purrr,map)
+importFrom(purrr,map_lgl)
+importFrom(purrr,pluck)
 importFrom(purrr,reduce)
 importFrom(purrr,when)
 importFrom(rlang,":=")
 importFrom(rlang,enquo)
+importFrom(rlang,env)
 importFrom(rlang,quo_is_null)
 importFrom(rlang,quo_is_symbol)
 importFrom(rlang,quo_is_symbolic)
 importFrom(rlang,quo_name)
 importFrom(rlang,quo_squash)
 importFrom(scales,alpha)
 importFrom(scales,rescale)
+importFrom(shiny,actionButton)
+importFrom(shiny,fluidPage)
+importFrom(shiny,observe)
+importFrom(shiny,runApp)
+importFrom(shiny,shinyApp)
+importFrom(shiny,stopApp)
 importFrom(stringr,str_pad)
+importFrom(tibble,as_tibble)
+importFrom(tibble,tibble)
 importFrom(utils,head)
 importFrom(viridis,viridis)

R/gate_app.R

@@ -0,0 +1,81 @@
+#' Create Shiny App UI
+#' 
+#' @importFrom shiny fluidPage
+#' @importFrom shiny actionButton
+#' @importFrom plotly plotlyOutput
+#' @return Fluid UI container
+#' @export
+ui <- 
+  shiny::fluidPage(
+    shiny::actionButton("continue_button", "Continue"),
+    # shiny::actionButton("deselect_button", "Deselect all"),
+    plotly::plotlyOutput("plot")
+  )
+
+#' Run Shiny App for interactive gating 
+#' 
+#' @importFrom plotly renderPlotly
+#' @importFrom plotly event_data
+#' @importFrom plotly ggplotly
+#' @importFrom ggplot2 ggplot
+#' @importFrom ggplot2 aes
+#' @importFrom ggplot2 geom_point
+#' @importFrom ggplot2 theme_bw
+#' @importFrom purrr map_lgl
+#' @importFrom shiny observe
+#' @importFrom shiny stopApp
+#' @param input Server input parameter
+#' @param output Server output parameter
+#' @param session Server session parameter
+#' @return NA
+#' @export
+server <- 
+  function(input, output, session) {
+
+    output$plot <- plotly::renderPlotly({
+
+      # Begin recording selection and brush information
+      select_data <- plotly::event_data("plotly_selected")
+      brush_data <- plotly::event_data("plotly_brushed")
+
+      # Save selection and brush information
+      assign("select_data", tidygate_env$input_data, envir = tidygate_env)
+      assign("brush_data", brush_data, envir = tidygate_env)
+
+      # Set selected points to TRUE
+      if (!is.null(select_data)) {
+        tidygate_env$input_data <-
+          tidygate_env$input_data |>
+          mutate(.selected = ifelse(.key %in% as.numeric(select_data$key), TRUE, .selected))
+      }
+
+      # Create plot
+      if (is.null(tidygate_env$custom_plot)) {
+        plot <-
+          tidygate_env$input_data |>
+          ggplot2::ggplot(ggplot2::aes(x = dimension_x, y = dimension_y, colour = .selected, key = .key)) +
+          ggplot2::geom_point(alpha = tidygate_env$input_data$.alpha[[1]], size = tidygate_env$input_data$.size[[1]]) +
+          ggplot2::theme_bw()
+
+      # Or load supplied plot
+      } else {
+        plot <-
+          tidygate_env$custom_plot
+      }
+
+      # Draw plot
+      plot |>
+        plotly::ggplotly() |>
+        plotly::layout(dragmode = "lasso") 
+    })
+
+    # Close Shiny App with button press
+    shiny::observe({
+      if(input$continue_button > 0){
+        shiny::stopApp()
+      }
+      # if(input$deselect_button > 0){
+      #   tidygate_env$input_data$.selected <- FALSE
+      # }
+    })
+  }

R/methods.R

@@ -180,9 +180,121 @@ gate_int.numeric = 	function(  .dim1,
 
 }
 
+#' Interactively gate data with a simple scatter plot
+#' 
+#' Launch an interactive scatter plot, based on the input X and Y coordinates. Points on this plot 
+#' can then be gated.
+#' 
+#' @importFrom tibble tibble
+#' @importFrom dplyr mutate
+#' @importFrom rlang env
+#' @importFrom shiny shinyApp
+#' @importFrom shiny runApp
+#' @param dimension_x A column symbol representing the X dimension. 
+#' @param dimension_y A column symbol representing the Y dimension.
+#' @param alpha The opacity of points, with 1 being completely opaque and 0 being completely
+#' transparent.
+#' @param size The size of points.
+#' @return A vector with TRUE for elements inside gate points and FALSE for elements outside gate 
+#' points. A record of the selected points is stored in `tidygate_env$select_data` and a record of 
+#' the gates is stored in `tidygate_env$brush_data`.
+#' @examples
+#' \dontrun{
+#' library(dplyr)
+#' library(ggplot2)
+#' 
+#' mtcars |>
+#'   dplyr::mutate(selected = gate_simple(dimension_x = mpg, dimension_y = wt)) |>
+#'   print()
+#'}
+#' @export
+gate_simple <-
+
+  function(dimension_x, dimension_y, alpha = 1, size = 1) {
+
+    message("tidygate says: this feature is in early development and may undergo changes or contain bugs.")
+
+    # Add needed columns to input data
+    data <- 
+      tibble::tibble(dimension_x, dimension_y) |>
+      dplyr::mutate(.key = dplyr::row_number()) |>
+      dplyr::mutate(.selected = FALSE) |>
+      dplyr::mutate(.alpha = alpha) |>
+      dplyr::mutate(.size = size)
+
+    # Create environment and save input variables
+    tidygate_env <<- rlang::env()
+    tidygate_env$input_data <- data
+    tidygate_env$custom_plot <- NULL
+
+    # Launch Shiny App
+    app <- shiny::shinyApp(ui, server)
+    shiny::runApp(app, port = 1234) # Specify a port if needed
+
+    return(tidygate_env$input_data$.selected)
+  }
 
-
-
-
-
+#' Interactively gate data with a custom plot
+#' 
+#' Launch an interactive scatter plot, based on a user-defined `ggplot2`. Points on this plot can
+#' then be gated.
+#' 
+#' @importFrom tibble as_tibble
+#' @importFrom dplyr mutate
+#' @importFrom dplyr select
+#' @importFrom dplyr rename
+#' @importFrom rlang env
+#' @importFrom purrr pluck
+#' @importFrom ggplot2 ggplot_build
+#' @importFrom shiny shinyApp
+#' @importFrom shiny runApp
+#' @param custom_plot A ggplot object. Must contain a row index in the `.key` column set as key.
+#' @return A vector with TRUE for elements inside gate points and FALSE for elements outside gate 
+#' points. A record of the selected points is stored in `tidygate_env$select_data` and a 
+#' record of the gates is stored in `tidygate_env$brush_data`.
+#' @examples
+#' \dontrun{
+#' library(dplyr)
+#' library(ggplot2)
+#' 
+#' scaled_plot <- 
+#'   mtcars |> 
+#'   mutate(.key = row_number()) |>
+#'   ggplot(aes(x = mpg, y = wt, key = .key)) + 
+#'   scale_y_log10() +
+#'   geom_point() +
+#'   theme_dark()
+#'   
+#' mtcars |>
+#'   mutate(selected = gate_custom(custom_plot = scaled_plot)) |>
+#'   print()
+#' }
+#' @export
+gate_custom <-
+
+  function(custom_plot) {
+
+    message("tidygate says: this feature is in early development and may undergo changes or contain bugs.")
+
+    # Create tibble with .key column
+    data <- 
+      custom_plot |>
+      ggplot2::ggplot_build() |>
+      purrr::pluck(1, 1) |>
+      tibble::as_tibble() |>
+      dplyr::select(key) |>
+      dplyr::rename(.key = "key") |>
+      dplyr::mutate(.selected = FALSE)
+
+    # Create environment and save input variables
+    tidygate_env <<- rlang::env()
+    tidygate_env$input_data <- data
+    tidygate_env$custom_plot <- custom_plot
+
+    # Launch Shiny App
+    app <- shiny::shinyApp(ui, server)
+    shiny::runApp(app, port = 1234)
+
+    return(tidygate_env$input_data$.selected)
+  }