diff --git a/DESCRIPTION b/DESCRIPTION index d0b59d2..2ae6472 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,15 +1,17 @@ Package: flowGate Type: Package Title: Interactive Cytometry Gating in R -Version: 0.99.2 +Version: 1.13.1 Authors@R: c(person("Andrew", "Wight", email = "andrew.wight10@gmail.com", - role = c("aut", "cre")), + role = c("aut", "cre"), + comment = c(ORCID = "0000-0003-3116-8722")), person("Harvey", "Cantor", email = "Harvey_Cantor@dfci.harvard.edu", - role = c("aut", "ldr"))) + role = c("aut", "ldr"), + comment = c(ORCID = "0000-0002-3313-2478"))) Description: flowGate adds an interactive Shiny app to allow manual GUI-based gating of flow cytometry data in R. Using flowGate, you can draw 1D and 2D span/rectangle gates, quadrant gates, @@ -19,6 +21,8 @@ Description: flowGate adds an interactive Shiny app to allow manual cytometerists looking to take advantage of R for cytometry analysis, without necessarily having a lot of R experience. License: MIT + file LICENSE +URL: https://www.bioconductor.org/packages/release/bioc/html/flowGate.html +BugReports: https://github.com/NKInstinct/flowGate/issues Encoding: UTF-8 LazyData: false Imports: @@ -34,14 +38,15 @@ Imports: Depends: flowWorkspace (>= 4.0.6), ggcyto (>= 1.16.0), - R (>= 4.2) -RoxygenNote: 7.2.3 + R (>= 4.4) +RoxygenNote: 7.3.3 Suggests: knitr, rmarkdown, stringr, tidyverse, - testthat + testthat, + vdiffr VignetteBuilder: knitr biocViews: Software, @@ -50,3 +55,4 @@ biocViews: Preprocessing, ImmunoOncology, DataImport + diff --git a/NAMESPACE b/NAMESPACE index d6d1641..7ea9513 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,24 +1,76 @@ # Generated by roxygen2: do not edit by hand +export(gs_apply_gate_check) export(gs_apply_gating_strategy) export(gs_gate_interactive) +export(gs_gate_interactive_adjust) export(gs_gate_transform_interactive) -import(BiocManager) -import(flowWorkspace) -import(ggcyto) +export(gs_to_openCyto) +importFrom(BiocManager,install) +importFrom(dplyr,bind_rows) +importFrom(flowCore,polygonGate) +importFrom(flowCore,quadGate) +importFrom(flowCore,rectangleGate) +importFrom(flowCore,transform_gate) +importFrom(flowWorkspace,GatingSet) +importFrom(flowWorkspace,flowjo_biexp) +importFrom(flowWorkspace,gh_pop_get_gate) +importFrom(flowWorkspace,gs_get_pop_paths) +importFrom(flowWorkspace,gs_pop_add) +importFrom(flowWorkspace,gs_pop_get_gate) +importFrom(flowWorkspace,gs_pop_get_parent) +importFrom(flowWorkspace,gs_pop_remove) +importFrom(flowWorkspace,recompute) +importFrom(ggcyto,as.ggplot) +importFrom(ggcyto,geom_gate) +importFrom(ggcyto,ggcyto) +importFrom(ggcyto,scale_x_flowjo_biexp) +importFrom(ggcyto,scale_y_flowjo_biexp) importFrom(ggplot2,aes) importFrom(ggplot2,aes_) importFrom(ggplot2,coord_cartesian) importFrom(ggplot2,element_blank) +importFrom(ggplot2,element_text) importFrom(ggplot2,geom_density) importFrom(ggplot2,geom_hex) +importFrom(ggplot2,geom_hline) importFrom(ggplot2,geom_path) importFrom(ggplot2,geom_vline) importFrom(ggplot2,scale_x_continuous) importFrom(ggplot2,scale_y_continuous) importFrom(ggplot2,theme) +importFrom(ggplot2,theme_gray) importFrom(methods,is) +importFrom(openCyto,register_plugins) +importFrom(purrr,map) +importFrom(purrr,pluck) +importFrom(purrr,pmap) +importFrom(rlang,"!!") importFrom(rlang,.data) +importFrom(shiny,actionButton) +importFrom(shiny,brushOpts) +importFrom(shiny,checkboxInput) +importFrom(shiny,fluidPage) +importFrom(shiny,mainPanel) +importFrom(shiny,numericInput) +importFrom(shiny,observeEvent) +importFrom(shiny,plotOutput) +importFrom(shiny,radioButtons) importFrom(shiny,reactive) +importFrom(shiny,reactiveValues) +importFrom(shiny,renderPlot) +importFrom(shiny,renderText) +importFrom(shiny,runApp) +importFrom(shiny,shinyApp) +importFrom(shiny,sidebarLayout) +importFrom(shiny,sidebarPanel) +importFrom(shiny,sliderInput) +importFrom(shiny,stopApp) +importFrom(shiny,tabPanel) +importFrom(shiny,tabsetPanel) +importFrom(shiny,textOutput) +importFrom(shiny,titlePanel) importFrom(shiny,updateTabsetPanel) +importFrom(stringr,str_equal) importFrom(tibble,tribble) +importFrom(utils,write.csv) diff --git a/NEWS.md b/NEWS.md index b33aa37..ad20a42 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,2 +1,9 @@ -# Changes in version 0.99.2 (2023-03-15) - - Package cleanup after initial Bioconductor submission +# Changes in version 0.99.3 (2023-03-15) + - Document cleanup as part of bioconductor review + +# Changes in version 1.13.1 (2026-07-02) + - Implemented fixes due to the ggplot2 version 4 changes, with + the update ggcyto syntax changes + - Where appropiate, switched from import to importFrom tags + - Implemented gs_apply_gate_check to allow adjustment existing gates + - Additional unit tests to test suite diff --git a/R/applyGateClose.R b/R/applyGateClose.R index 9d47097..d16b25e 100644 --- a/R/applyGateClose.R +++ b/R/applyGateClose.R @@ -4,6 +4,9 @@ #' @param gateType The selected type of gate (from UI). #' @param filterId The gate name specified by the user. #' @param gg The plot object from vars$plot. +#' +#' @importFrom flowCore polygonGate rectangleGate quadGate +#' @importFrom flowWorkspace gs_pop_add recompute #' #' @return The original GatingSet with the newly drawn gate applied. #' @@ -12,21 +15,27 @@ applyGateClose <- function( gs, subset, coords, gateType, filterId, gg, useBiex, bins, xMax, xWidth, xPos, xNeg, yMax, yWidth, yPos, yNeg){ + + TheNames <- names(gg$data) + LastTwo <- tail(TheNames, 2) + FinalOne <- tail(TheNames, 1) + if(gateType == "polygonGate"){ - names(coords) <- c(names(gg[[1]])[[3]], names(gg[[1]])[[4]]) + names(coords) <- LastTwo coords <- as.matrix(coords) gate <- flowCore::polygonGate(coords, filterId = filterId) } else if(gateType == "spanGate"){ - names(coords) <- c(names(gg[[1]])[[3]]) + names(coords) <- FinalOne gate <- flowCore::rectangleGate(coords, filterId = filterId) } else if(gateType == "quadGate"){ - names(coords) <- c(names(gg[[1]])[[3]], names(gg[[1]])[[4]]) + names(coords) <- LastTwo gate <- flowCore::quadGate(coords, filterId = filterId) } else if(gateType == "rectangleGate"){ - names(coords) <- c(names(gg[[1]])[[3]], names(gg[[1]])[[4]]) + names(coords) <- LastTwo gate <- flowCore::rectangleGate(coords, filterId = filterId) } - gs_pop_add(gs, gate, parent = subset) + + gs_pop_add(gs=gs, gate=gate, parent = subset) recompute(gs) if(useBiex){ diff --git a/R/applyGateCloseSwap.R b/R/applyGateCloseSwap.R new file mode 100644 index 0000000..448309a --- /dev/null +++ b/R/applyGateCloseSwap.R @@ -0,0 +1,63 @@ +#' Apply gate from gs_gate_interactive +#' +#' @param coords The coordinates of the interactively drawn gate. +#' @param gateType The selected type of gate (from UI). +#' @param filterId The gate name specified by the user. +#' @param gg The plot object from vars$plot. +#' @param AdjustAll Default FALSE, applies the gate correction to the entire gating set. +#' +#' @importFrom flowCore polygonGate rectangleGate quadGate +#' @importFrom flowWorkspace gs_pop_add recompute +#' +#' @return The original GatingSet with the newly drawn gate applied. +#' +#' @noRd +#' +applyGateCloseSwap <- function( + gs, subset, coords, gateType, filterId, gg, useBiex, bins, xMax, xWidth, + xPos, xNeg, yMax, yWidth, yPos, yNeg, sample, AdjustAll=FALSE){ + + TheNames <- names(gg$data) + LastTwo <- tail(TheNames, 2) + FinalOne <- tail(TheNames, 1) + + if(gateType == "polygonGate"){ + names(coords) <- LastTwo + coords <- as.matrix(coords) + gate <- flowCore::polygonGate(coords, filterId = filterId) + } else if(gateType == "spanGate"){ + names(coords) <- FinalOne + gate <- flowCore::rectangleGate(coords, filterId = filterId) + } else if(gateType == "quadGate"){ + names(coords) <- LastTwo + gate <- flowCore::quadGate(coords, filterId = filterId) + } else if(gateType == "rectangleGate"){ + names(coords) <- LastTwo + gate <- flowCore::rectangleGate(coords, filterId = filterId) + } + + # gs_pop_add(gs, gate, parent = subset) + TheList <- list(gate) + + if (AdjustAll==FALSE){ + names(TheList) <- sampleNames(gs[sample]) + gs_pop_set_gate(gs[sample], filterId, TheList) + recompute(gs[sample]) + } else { + TheList <- rep(TheList, length(sampleNames(gs))) + names(TheList) <- sampleNames(gs) + gs_pop_set_gate(gs, filterId, TheList) + recompute(gs) + } + + if(useBiex){ + varsBiex <- list(X = list( + maxValue = xMax, widthBasis = xWidth, pos = xPos, neg = xNeg), + Y = list( + maxValue = yMax, widthBasis = yWidth, pos = yPos, neg = yNeg)) + } else{ + varsBiex <- "unused" + } + output <- list("Gate" = gate, "Bins" = bins, "Scaling" = varsBiex) + return(output) + } diff --git a/R/flowGate-package.R b/R/flowGate-package.R new file mode 100644 index 0000000..3b01a22 --- /dev/null +++ b/R/flowGate-package.R @@ -0,0 +1,9 @@ +#' @description +#' To learn more about how to use flowGate, please start by browsing the vignettes: +#' +#' @keywords internal +"_PACKAGE" + +## usethis namespace: start +## usethis namespace: end +NULL diff --git a/R/gateHandlers.R b/R/gateHandlers.R index f6923a7..6c9ce89 100644 --- a/R/gateHandlers.R +++ b/R/gateHandlers.R @@ -31,6 +31,16 @@ coordBrush <- function(brush, gateType, useBiex, transX, transY){ return(res) } +#' Internal for Unknown +#' +#' @param click TODOLIST +#' @param gateType TODOLIST +#' @param useBiex TODOLIST +#' @param transX TODOLIST +#' @param transY TODOLIST +#' +#' @noRd +#' coordClick <- function(click, gateType, useBiex, transX, transY){ if(useBiex){ click$x <- transX(click$x) @@ -44,6 +54,20 @@ coordClick <- function(click, gateType, useBiex, transX, transY){ return(res) } +#' Internal for Unknown +#' +#' @param gateType TODOLIST +#' @param brush TODOLIST +#' @param click TODOLIST +#' @param biex TODOLIST +#' @param tX TODOLIST +#' @param tY TOODOLIST +#' @param append TODOLIST +#' +#' @importFrom dplyr bind_rows +#' +#' @noRd +#' gateHandler <- function(gateType, brush, click, biex, tX, tY, append){ switch(gateType, rectangleGate = , diff --git a/R/gs_apply_gate_check.R b/R/gs_apply_gate_check.R new file mode 100644 index 0000000..3f9c090 --- /dev/null +++ b/R/gs_apply_gate_check.R @@ -0,0 +1,72 @@ +#' The purpose of this function is to allow the readjustment of a gate on an +#' individual specimen via the Shiny app, quickly iterating through every +#' specimen present in the GatingSet. +#' +#' This allows for fine-tuning of the gate placement for non-representative +#' specimens, or when automated gating methods fail. +#' +#' @param gs A GatingSet or list of GatingSets. +#' @param gate A tibble-formatted gating strategy (see examples below) +#' @param sample Sample index in the GatingSet, default NULL will iterate through +#' all specimens in the GatingSet. +#' @param AdjustAll Default FALSE, applies the gate correction to the entire gating set. +#' @param ... Other parameters to pass to gs_gate_interactive(). Note that only +#' constant parameters should be supplied here---anything that varies should +#' be included in the gating_strategy tibble. +#' +#' @return the GatingSet or list of GatingSets with the gates in gating_strategy +#' applied as specified. +#' +#' @importFrom tibble tribble +#' @importFrom methods is +#' @importFrom purrr pmap +#' +#' @examples +#' +#' fs <- flowCore::read.flowSet( +#' path = system.file("extdata", package = "flowGate"), pattern = ".FCS$") +#' +#' gs <- flowWorkspace::GatingSet(fs) +#' +#' # Note - this is a very rudamentary GatingSet for example purposes only. +#' # Please see the vignette accompanying this package or the flowWorkspace +#' # documentation # for a complete look at creating a GatingSet. +#' +#' gating_strategy <- tibble::tribble( +#' ~filterId, ~dims, ~subset, ~coords, +#' "Lymphocytes", list("FSC-H", "SSC-H"), "root", list(c(0, 3e5), c(0, 3e5)), +#' "CD45 CD15", list("CD45 PE", "CD15 FITC"), "Lymphocytes", list(c(0, 3e5), c(0, 2e5)), +#' ) +#' +#' +#' if(interactive()){ +#' gs_apply_gating_strategy(gs, +#' gating_strategy = gating_strategy, +#' bins = 512) # note that extra args for gs_gate_interactive can be supplied. +#' } +#' @export +#' +gs_apply_gate_check <- function(gs, gate, sample=NULL, AdjustAll=FALSE, ...){ + if(methods::is(gs, "GatingSet")){ + + if(is.null(sample)){ + Samples <- seq_along(gs) + } else {Samples <- sample} + + purrr::walk( + .x = Samples, + .f = function(sample) { + gs_gate_interactive_adjust( + gs = gs, + gate = gate, + sample = sample, + AdjustAll = AdjustAll, + ... + ) + } + ) + + } else { + stop("'gs' must be a GatingSet") + } +} \ No newline at end of file diff --git a/R/gs_apply_gating_strategy.R b/R/gs_apply_gating_strategy.R index afd5d73..dfd9235 100644 --- a/R/gs_apply_gating_strategy.R +++ b/R/gs_apply_gating_strategy.R @@ -27,6 +27,7 @@ #' #' @importFrom tibble tribble #' @importFrom methods is +#' @importFrom purrr pmap #' #' @examples #' @@ -52,10 +53,11 @@ #' bins = 512) # note that extra args for gs_gate_interactive can be supplied. #' } #' @export +#' gs_apply_gating_strategy <- function(gs, gating_strategy, ...){ if(methods::is(gs, "GatingSet")){ purrr::pmap(gating_strategy, - flowGate::gs_gate_interactive, gs = gs, ...) + gs_gate_interactive, gs = gs, ...) } else { stop("'gs' must be a GatingSet") } diff --git a/R/gs_gate_interactive.R b/R/gs_gate_interactive.R index 33bcfcc..929599c 100644 --- a/R/gs_gate_interactive.R +++ b/R/gs_gate_interactive.R @@ -90,14 +90,15 @@ #' gate's coordinates, plot bins, and any flowjo biex coefs used to calculate #' those transforms. #' -#' @import flowWorkspace -#' @import ggcyto -#' @import BiocManager +#' @importFrom flowWorkspace gs_pop_remove flowjo_biexp +#' @importFrom ggcyto ggcyto +#' @importFrom BiocManager install #' @importFrom ggplot2 aes_ aes geom_density scale_x_continuous #' @importFrom ggplot2 scale_y_continuous geom_path geom_hex #' @importFrom ggplot2 theme element_blank coord_cartesian #' @importFrom rlang .data -#' @importFrom shiny updateTabsetPanel reactive +#' @importFrom shiny reactiveValues observeEvent reactive updateTabsetPanel +#' @importFrom shiny renderPlot renderText stopApp runApp shinyApp #' #' @export gs_gate_interactive <- function( diff --git a/R/gs_gate_interactive_adjust.R b/R/gs_gate_interactive_adjust.R new file mode 100644 index 0000000..ea580b1 --- /dev/null +++ b/R/gs_gate_interactive_adjust.R @@ -0,0 +1,180 @@ +#' Interactive Manual Gating +#' +#' \code{gs_gate_interactive} opens a new graphical window where you can draw +#' rectangle, polygon, 1-D span, or 2-D quadrant gates that will be applied to +#' an entire GateSet (see the flowWorkspace package for complete information +#' about GateSets). +#' +#' @param gs The GateSet that will be gated on. +#' @param filterId String that gives the name of the new gate. Must be unique +#' (can specify parent gates to aid in this). +#' @param sample Numeric specifying which of the GatingHierarchy objects (i.e. +#' which FCS file/flow sample) that make up the GateSet do you want to use to +#' draw the gate? Note that the gate you draw will be applied to all +#' GatingHierarchy objects in the GateSet. Defaults to the first +#' GatingHierarchy object in the GateSet. +#' @param dims A list of strings, length-1 or length-2, that specifies the x- +#' and y- parameters that you will be gating on. Giving a length-1 list will +#' result in a histogram, while a length-2 list will result in a dot-plot. +#' Giving a length-3 or longer list will result in only the first two +#' dimensions being used, and will generate a warning to say as much. Defaults +#' to forward scatter ("FSC-A") and side scatter ("SSC-A"). +#' @param subset String that gives the name of the parent gate that you want to +#' sample from. For example, if you wanted to gate all live cells out of a +#' previously drawn "lymphocytes" gate, you would specify "lymphocytes" here. +#' Defaults to "root" (ungated). +#' @param regate A boolean specifying whether all gates with a name matching +#' \code{filterId} should first be deleted before being re-drawn. Attempting +#' to draw a gate with a non-unique \code{filterId} without specifying +#' \code{regate = TRUE} will result in an error. Defaults to \code{FALSE} +#' @param overlayGates List of strings giving the \code{filterId}s of other +#' gates to draw on the example plot when gating. Useful for drawing multiple +#' gates on the same population (for example, after specifying a marker-low +#' population, you can overlay the marker-low gate to aid in drawing a +#' marker-high gate). Defaults to \code{NULL} (no overlaid gates). +#' @param AdjustAll Default FALSE, applies the gate correction to the entire gating set. +#' +#' @examples +#' +#' path_to_fcs <- system.file("extdata", package = "flowGate") +#' fs <- read.flowSet(path = path_to_fcs, +#' pattern = ".FCS$", +#' full.names = TRUE) +#' gs <- GatingSet(fs) +#' +#' if(interactive()) { # only run in interactive sessions +#' gs_gate_interactive(gs, +#' filterId = "Lymphocytes", +#' dims = list("FSC-H", "SSC-H")) +#' } +#' +#' # returns gs with the same "Lymphocytes" gate on FSC-H and SSC-H applied to +#' # the root node (all events) of each sample in the GateSet. +#' +#' if(interactive()) { +#' gs_gate_interactive(gs, +#' filterId = "Live cells", +#' dims = "Viability", +#' subset = "Lymphocytes") +#' } +#' +#' # returns gs with a "Live cells" gate drawn on all cells included in the +#' # parent "Lymphocytes" gate. This gate would be based on a histogram of a +#' # marker called Viability, using the first GatingHierarchy sample as an +#' # example. +#' +#' if(interactive()){ +#' gs_gate_interactive(gs, +#' filterId = "Live cells", +#' dims = list("Viability", "SSC-A"), +#' subset = "Lymphocytes", +#' regate = TRUE) +#' } +#' +#' # first deletes the "Live cells" gate drawn above, then adds a new "Live +#' # cells" gate to the set, this time based on a dot plot of Viability by +#' # side-scatter. +#' +#' if(interactive()){ +#' gs_gate_interactive(gs, +#' filterId = "Dead cells", +#' dims = list("Viability", "SSC-A"), +#' subset = "Lymphocytes", +#' overlayGates = "Live cells") +#' } +#' +#' # returns gs with a "Dead cells" gate drawn on the same example graph that +#' # was used to draw the "Live cells" gate above. Overlays the "Live cells" +#' # gate on top of this graph to aid in drawing the "Dead cells" gate. +#' +#' @return A list of the interactively-specified parameters, including the drawn +#' gate's coordinates, plot bins, and any flowjo biex coefs used to calculate +#' those transforms. +#' +#' @importFrom flowWorkspace gs_pop_remove flowjo_biexp +#' @importFrom ggcyto ggcyto +#' @importFrom BiocManager install +#' @importFrom ggplot2 aes_ aes geom_density scale_x_continuous +#' scale_y_continuous geom_path geom_hex theme element_blank +#' coord_cartesian +#' @importFrom rlang .data +#' @importFrom shiny reactiveValues observeEvent reactive updateTabsetPanel +#' renderPlot renderText stopApp runApp shinyApp +#' +#' @export +gs_gate_interactive_adjust <- function(gs, gate, sample, AdjustAll=FALSE, overlayGates = NULL){ + + # Retrieve existing gate information ======================================= + + AllGates <- gs_pop_get_gate(gs[sample], gate)[[1]] + filterId <- gate + dims <- sapply(AllGates@parameters, function(x) x@parameters) |> unname() + subset <- gs_pop_get_parent(gs[sample], gate)[[1]] + #overlayGates <- polygonGate(filterId = AllGates@filterId, .gate = AllGates@boundaries) + overlayGates <- AllGates + + + # if(regate == TRUE){gs_pop_remove(gs, filterId)} + + # Server Function ========================================================== + server <- function(input, output, session) { + vals <- shiny::reactiveValues(gateCoords = data.frame( + "x" = numeric(), "y" = numeric())) + + if(length(dims) == 1){ + shiny::observe({ + updateRadioButtons(session, "gateType", selected = "spanGate") + }) |> shiny::bindEvent(session$clientData, once = TRUE) + } + + # Biex Handling -------------------------------------------------------- + shiny::observeEvent(input$useBiex, { + if(input$useBiex){ + updateTabsetPanel(inputId = "biexTab", selected = "biexPanel") + }else{ + updateTabsetPanel(inputId = "biexTab", selected = "blankPanel") + }}) + transX <- reactive(flowjo_biexp( + maxValue = input$xMaxVal, pos = input$xPos, neg = input$xNeg, + widthBasis = input$xWidth, inverse = TRUE)) + transY <- reactive(flowjo_biexp( + maxValue = input$yMaxVal, pos = input$yPos, neg = input$yNeg, + widthBasis = input$yWidth, inverse = TRUE)) + # Prepare main panel plot ---------------------------------------------- + FPlot <- reactive(preparePlot( + gs, sample, dims, subset, input$bins, input$useCoords, + c(input$XMin, input$XMax, input$YMin, input$YMax), overlayGates, + input$gateType, vals$gateCoords, input$useBiex, input$xMaxVal, + input$xWidth, input$xPos, input$xNeg, input$yMaxVal, input$yWidth, + input$yPos, input$yNeg)) + output$plot1 <- shiny::renderPlot(FPlot(), height = function() { + session$clientData$output_plot1_width}) + output$filterId <- shiny::renderText({paste0("Gate Name: ", filterId)}) + output$subset <- shiny::renderText({paste0("subset of: ", subset)}) + # Gate Handling -------------------------------------------------------- + gateH <- reactive(gateHandler( + input$gateType, input$plot1_brush, input$plot1_click, input$useBiex, + transX(), transY(), vals$gateCoords)) + shiny::observeEvent(input$plot1_brush, {vals$gateCoords <- gateH()}) + shiny::observeEvent(input$plot1_click, {vals$gateCoords <- gateH()}) + shiny::observeEvent(input$reset, { + vals$gateCoords <- data.frame("x" = numeric(), "y" = numeric())}) + # Apply gate and close ------------------------------------------------- + shiny::observeEvent(input$done, { + if (is.data.frame(vals$gateCoords) && nrow(vals$gateCoords) == 0 && is.null(input$X)) { + shiny::stopApp(overlayGates) + } else { + output <- applyGateCloseSwap( + gs, subset, vals$gateCoords, input$gateType, filterId, FPlot(), + input$useBiex, input$bins, input$xMaxVal, input$xWidth, + input$xPos, input$xNeg, input$yMaxVal, input$yWidth, input$yPos, + input$yNeg, sample, AdjustAll=AdjustAll) + shiny::stopApp(output) + } + }) + + } + shiny::runApp(shiny::shinyApp(ui, server)) +} + + diff --git a/R/gs_gate_transform_interactive.R b/R/gs_gate_transform_interactive.R index f606f82..131943b 100644 --- a/R/gs_gate_transform_interactive.R +++ b/R/gs_gate_transform_interactive.R @@ -40,16 +40,16 @@ #' dims = list("FSC-H", "SSC-H")) #' } #' -#' # Opens a window to adjust the gate manually +#' #Opens a window to adjust the gate manually #' -#' @import flowWorkspace -#' @import ggcyto -#' @import BiocManager +#' @importFrom flowWorkspace GatingSet +#' @importFrom ggcyto ggcyto +#' @importFrom BiocManager install #' @importFrom ggplot2 aes_ aes geom_density scale_x_continuous #' @importFrom ggplot2 scale_y_continuous geom_path geom_hex #' @importFrom ggplot2 theme element_blank coord_cartesian geom_vline #' @importFrom rlang .data -#' @importFrom shiny reactive +#' @importFrom shiny reactive renderPlot observeEvent stopApp runApp shinyApp #' #' @export gs_gate_transform_interactive <- function( @@ -85,6 +85,13 @@ gs_gate_transform_interactive <- function( # Helpers ---------------------------------------------------------------------- +#' Internal for +#' +#' @importFrom flowCore transform_gate +#' @importFrom flowWorkspace gh_pop_get_gate recompute +#' @importFrom purrr pluck +#' +#' @noRd updateGate <- function(gs, node, scaleDims, scale, deg, dx, dy){ gate <- flowWorkspace::gh_pop_get_gate(gs[[1]], node) if(is(gate, "rectangleGate")){ @@ -104,6 +111,31 @@ updateGate <- function(gs, node, scaleDims, scale, deg, dx, dy){ } +#' Internal for +#' +#' @param gs TODOLIST +#' @param sample TODOLIST +#' @param dims TODOLIST +#' @param node TODOLIST +#' @param bins TODOLIST +#' @param useCoords TODOLIST +#' @param coords TODOLIST +#' @param useBiex TODOLIST +#' @param overlayGates TODOLIST +#' @param scaleMode TODOLIST +#' @param scale TODOLIST +#' @param deg TODOLIST +#' @param dx TODOLIST +#' @param dy TODOLIST +#' +#' @importFrom ggcyto geom_gate as.ggplot +#' @importFrom flowWorkspace gh_pop_get_gate +#' @importFrom flowCore transform_gate +#' @importFrom purrr pluck +#' @importFrom ggplot2 geom_vline geom_path +#' @importFrom methods is +#' +#' @noRd prepareTransPlot <- function(gs, sample, dims, node, bins, useCoords, coords, useBiex, overlayGates, scaleMode, scale, deg, dx, dy){ @@ -148,6 +180,22 @@ prepareTransPlot <- function(gs, sample, dims, node, bins, useCoords, coords, return(gg) } +#' Internal for +#' +#' @param sample.gs TODOLIST +#' @param dims TODOLIST +#' @param node TODOLIST +#' @param bins TODOLIST +#' @param useCoords TODOLIST +#' @param coords TODOLIST +#' @param useBiex TODOLIST +#' +#' @importFrom ggcyto ggcyto geom_gate scale_x_flowjo_biexp scale_y_flowjo_biexp +#' @importFrom ggplot2 aes geom_density geom_hex +#' @importFrom ggplot2 scale_x_continuous scale_y_continuous coord_cartesian +#' @importFrom rlang !! +#' +#' @noRd prepTransPlot <- function(sample.gs, dims, node, bins, useCoords, coords, useBiex){ if(length(dims) > 2){ warning("The first two dims will be used, the others discarded.") diff --git a/R/gs_to_openCyto.R b/R/gs_to_openCyto.R new file mode 100644 index 0000000..852ac1a --- /dev/null +++ b/R/gs_to_openCyto.R @@ -0,0 +1,128 @@ + +#' Converts an existing GatingSet object into an openCyto template, +#' based off gates existing for given sample. Experimental +#' +#' @param gs A GatingSet object +#' @param sample The sample index to use, default is 1 +#' @param outpath The file.path to the storage location. Default NULL will +#' result in creation within the current working directory +#' +#' @importFrom flowWorkspace gs_get_pop_paths +#' @importFrom stringr str_equal +#' @importFrom purrr map +#' @importFrom dplyr bind_rows +#' @importFrom utils write.csv +#' +#' @return A .csv file containing an openCyto style template for +#' subsequent re-gating attempts +#' +#' @export +#' +#' @examples A <- 2 + 2 +#' +gs_to_openCyto <- function(gs, sample=1, outpath=NULL, filename="openCytoTemplate"){ + pops <- gs_get_pop_paths(gs) + pops <- pops[!str_equal("root", pops)] + + # x <- pops[1] + CSV <- map(.x=pops, .f=gate_detallitos, gs=gs, sample=sample) |> bind_rows() + + if (is.null(outpath)){outpath <- getwd()} + + TheFilename <- paste0(filename, ".csv") + StorageLocation <- file.path(outpath, TheFilename) + write.csv(CSV, StorageLocation, row.names=FALSE) +} + +#' Internal for gs_to_openCyto, retrieves details for individual gates +#' +#' @param x The iterated in gate +#' @param gs The GatingSet object +#' @param sample The sample index being used for the openCyto template values +#' +#' @importFrom flowWorkspace gs_pop_get_gate gs_pop_get_parent +#' +#' @return A data.frame row +#' +#' @noRd +#' +gate_detallitos <- function(x, gs, sample){ + + TheGate <- gs_pop_get_gate(gs[sample], x)[[1]] + + if (is(TheGate, "rectangleGate")){ + + # span_gate + TheMin <- TheGate@min + TheMax <- TheGate@max + TheDims <- names(TheGate@min) + TheMethod <- "span_gate" + coords <- paste(c(TheMin, TheMax), collapse = ",") + + Data <- data.frame( + alias = TheGate@filterId, + pop = "+", + parent = gs_pop_get_parent(gs[sample], x), + dims = TheDims, + gating_method = TheMethod, + gating_args = sprintf('min=c(%s),max=c(%s)', TheMin, TheMax), + collapseDataForGating = "FALSE", + groupBy = "NA", + preprocessing_method = "NA", + preprocessing_args = "NA" + ) + + } else if (is(TheGate, "polygonGate")){ + + # polygon_gate + TheVector <- TheGate@boundaries + TheDims <- colnames(TheVector) + if(length(TheDims) > 1){TheDims <- paste(TheDims, collapse = ",")} + coords <- paste(c(TheVector[,1], TheVector[,2]), collapse = ",") + + Data <- data.frame( + alias = TheGate@filterId, + pop = "+", + parent = gs_pop_get_parent(gs[sample], x), + dims = TheDims, + gating_method = "polygon_gate", + gating_args = sprintf('matrix(c(%s),ncol=2)', coords), + collapseDataForGating = "FALSE", + groupBy = "NA", + preprocessing_method = "NA", + preprocessing_args = "NA" + ) + } + + return(Data) +} + +#' Defines polygon_gate for openCyto +#' +#' @importFrom flowCore polygonGate +#' +#' @noRd +.my_polygon <- function(fr, pp_res, channels, boundaries, ...) { + colnames(boundaries) <- channels + flowCore::polygonGate(.gate = boundaries) +} + +#' Defines span_gate for openCyto +#' +#' @importFrom flowCore rectangleGate +#' +#' @noRd +.my_span <- function(fr, pp_res, channels, min, max, ...) { + gate_range <- matrix(c(min, max), nrow = 2, dimnames = list(c("min", "max"), channels)) + flowCore::rectangleGate(.gate = gate_range) +} + +#' Ensures span_gate and polygon_gate are available to openCyto +#' +#' @importFrom openCyto register_plugins +#' +#' @noRd +.onLoad <- function(libname, pkgname) { + openCyto::register_plugins(fun = .my_polygon, methodName = "polygon_gate") + openCyto::register_plugins(fun = .my_span, methodName = "span_gate") +} \ No newline at end of file diff --git a/R/preparePlot.R b/R/preparePlot.R index 63a6f1f..7c1ea03 100644 --- a/R/preparePlot.R +++ b/R/preparePlot.R @@ -16,6 +16,13 @@ #' @param regate Boolean; should the gs first be stripped of gates matching the #' filterId? #' @param overlayGates List of filterIds to plot on top of the current plot. +#' +#' @importFrom ggcyto ggcyto geom_gate scale_x_flowjo_biexp scale_y_flowjo_biexp as.ggplot +#' @importFrom ggplot2 aes geom_density geom_hex +#' @importFrom ggplot2 scale_x_continuous scale_y_continuous coord_cartesian +#' @importFrom ggplot2 geom_path geom_vline geom_hline +#' @importFrom rlang !! +#' @importFrom rlang .data #' #' @return A ggplot object ready to pass into the shiny app. #' @noRd @@ -69,11 +76,19 @@ preparePlot <- function(gs, sample, dims, subset, bins, useCoords, coords, overl maxValue = y_max, widthBasis = y_wide, pos = y_pos, neg = y_neg) }) } + + if ("ggcyto_GatingSet" %in% class(gg)){class(gg) <- class(gg)[class(gg) != "ggcyto_GatingSet"]} + gg <- ggcyto::as.ggplot(gg) return(gg) } - +#' Internal for +#' +#' @importFrom ggplot2 theme_gray theme element_blank element_text +#' +#' @noRd theme_flowGate <- theme_gray() + theme( strip.background = element_blank(), - strip.text = element_blank()) + strip.text = element_blank(), + legend.text = ggplot2::element_text(hjust = 0.5)) diff --git a/R/ui.R b/R/ui.R index a1f19d5..4d83457 100644 --- a/R/ui.R +++ b/R/ui.R @@ -1,19 +1,46 @@ +#' Internal +#' +#' @importFrom shiny sliderInput +#' +#' @noRd sliderInput_MaxVal <- function(id, tag){ shiny::sliderInput(id, tag, min = -1000, max = 300000, value = 250000) } +#' Internal +#' +#' @importFrom shiny sliderInput +#' +#' @noRd sliderInput_Width <- function(id, tag){ shiny::sliderInput(id, tag, min = -1000, max = -1, value = -10) } +#' Internal +#' +#' @importFrom shiny sliderInput +#' +#' @noRd sliderInput_Neg <- function(id, tag){ shiny::sliderInput(id, tag, min = 0, max = 1, value = 0) } +#' Internal +#' +#' @importFrom shiny sliderInput +#' +#' @noRd sliderInput_Pos <- function(id, tag){ shiny::sliderInput(id, tag, min = 2, max = 7, value = 4, step = 0.1) } +#' The Shiny UI +#' +#' @importFrom shiny fluidPage titlePanel sidebarLayout sidebarPanel +#' @importFrom shiny actionButton sliderInput radioButtons checkboxInput numericInput +#' @importFrom shiny tabsetPanel tabPanel mainPanel textOutput plotOutput brushOpts +#' +#' @noRd ui <- shiny::fluidPage( shiny::titlePanel("Draw your gate"), shiny::sidebarLayout( diff --git a/R/uiTransform.R b/R/uiTransform.R index a75c6b1..0d9d6ab 100644 --- a/R/uiTransform.R +++ b/R/uiTransform.R @@ -1,3 +1,10 @@ +#' Shiny UI for ... +#' +#' @importFrom shiny fluidPage titlePanel sidebarLayout sidebarPanel +#' @importFrom shiny actionButton radioButtons numericInput sliderInput checkboxInput +#' @importFrom shiny mainPanel plotOutput +#' +#' @noRd uiTransform <- shiny::fluidPage( shiny::titlePanel("Update a Gate"), shiny::sidebarLayout( diff --git a/README.md b/README.md index 6be8621..dbc86e0 100644 --- a/README.md +++ b/README.md @@ -46,3 +46,4 @@ request when finished and we'll see about incorporating your changes. Please note that flowGate is intended to be approachable to cytometerists regardless of R coding ability, so contributions and suggestions with an eye to making it easier to use or understand are especially welcome! + diff --git a/man/flowGate-package.Rd b/man/flowGate-package.Rd new file mode 100644 index 0000000..6b04c8e --- /dev/null +++ b/man/flowGate-package.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/flowGate-package.R +\docType{package} +\name{flowGate-package} +\alias{flowGate} +\alias{flowGate-package} +\title{flowGate: Interactive Cytometry Gating in R} +\description{ +To learn more about how to use flowGate, please start by browsing the vignettes: +} +\seealso{ +Useful links: +\itemize{ + \item \url{https://www.bioconductor.org/packages/release/bioc/html/flowGate.html} + \item Report bugs at \url{https://github.com/NKInstinct/flowGate/issues} +} + +} +\author{ +\strong{Maintainer}: Andrew Wight \email{andrew.wight10@gmail.com} (\href{https://orcid.org/0000-0003-3116-8722}{ORCID}) + +Authors: +\itemize{ + \item Harvey Cantor \email{Harvey_Cantor@dfci.harvard.edu} (\href{https://orcid.org/0000-0002-3313-2478}{ORCID}) [laboratory director] +} + +} +\keyword{internal} diff --git a/man/gs_apply_gate_check.Rd b/man/gs_apply_gate_check.Rd new file mode 100644 index 0000000..9784de9 --- /dev/null +++ b/man/gs_apply_gate_check.Rd @@ -0,0 +1,56 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gs_apply_gate_check.R +\name{gs_apply_gate_check} +\alias{gs_apply_gate_check} +\title{The purpose of this function is to allow the readjustment of a gate on an +individual specimen via the Shiny app, quickly iterating through every +specimen present in the GatingSet.} +\usage{ +gs_apply_gate_check(gs, gate, sample = NULL, AdjustAll = FALSE, ...) +} +\arguments{ +\item{gs}{A GatingSet or list of GatingSets.} + +\item{gate}{A tibble-formatted gating strategy (see examples below)} + +\item{sample}{Sample index in the GatingSet, default NULL will iterate through +all specimens in the GatingSet.} + +\item{AdjustAll}{Default FALSE, applies the gate correction to the entire gating set.} + +\item{...}{Other parameters to pass to gs_gate_interactive(). Note that only +constant parameters should be supplied here---anything that varies should +be included in the gating_strategy tibble.} +} +\value{ +the GatingSet or list of GatingSets with the gates in gating_strategy + applied as specified. +} +\description{ +This allows for fine-tuning of the gate placement for non-representative +specimens, or when automated gating methods fail. +} +\examples{ + +fs <- flowCore::read.flowSet( + path = system.file("extdata", package = "flowGate"), pattern = ".FCS$") + +gs <- flowWorkspace::GatingSet(fs) + +# Note - this is a very rudamentary GatingSet for example purposes only. +# Please see the vignette accompanying this package or the flowWorkspace +# documentation # for a complete look at creating a GatingSet. + +gating_strategy <- tibble::tribble( +~filterId, ~dims, ~subset, ~coords, +"Lymphocytes", list("FSC-H", "SSC-H"), "root", list(c(0, 3e5), c(0, 3e5)), +"CD45 CD15", list("CD45 PE", "CD15 FITC"), "Lymphocytes", list(c(0, 3e5), c(0, 2e5)), +) + + +if(interactive()){ +gs_apply_gating_strategy(gs, +gating_strategy = gating_strategy, +bins = 512) # note that extra args for gs_gate_interactive can be supplied. +} +} diff --git a/man/gs_gate_interactive_adjust.Rd b/man/gs_gate_interactive_adjust.Rd new file mode 100644 index 0000000..6f73370 --- /dev/null +++ b/man/gs_gate_interactive_adjust.Rd @@ -0,0 +1,116 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gs_gate_interactive_adjust.R +\name{gs_gate_interactive_adjust} +\alias{gs_gate_interactive_adjust} +\title{Interactive Manual Gating} +\usage{ +gs_gate_interactive_adjust( + gs, + gate, + sample, + AdjustAll = FALSE, + overlayGates = NULL +) +} +\arguments{ +\item{gs}{The GateSet that will be gated on.} + +\item{sample}{Numeric specifying which of the GatingHierarchy objects (i.e. +which FCS file/flow sample) that make up the GateSet do you want to use to +draw the gate? Note that the gate you draw will be applied to all +GatingHierarchy objects in the GateSet. Defaults to the first +GatingHierarchy object in the GateSet.} + +\item{AdjustAll}{Default FALSE, applies the gate correction to the entire gating set.} + +\item{overlayGates}{List of strings giving the \code{filterId}s of other +gates to draw on the example plot when gating. Useful for drawing multiple +gates on the same population (for example, after specifying a marker-low +population, you can overlay the marker-low gate to aid in drawing a +marker-high gate). Defaults to \code{NULL} (no overlaid gates).} + +\item{filterId}{String that gives the name of the new gate. Must be unique +(can specify parent gates to aid in this).} + +\item{dims}{A list of strings, length-1 or length-2, that specifies the x- +and y- parameters that you will be gating on. Giving a length-1 list will +result in a histogram, while a length-2 list will result in a dot-plot. +Giving a length-3 or longer list will result in only the first two +dimensions being used, and will generate a warning to say as much. Defaults +to forward scatter ("FSC-A") and side scatter ("SSC-A").} + +\item{subset}{String that gives the name of the parent gate that you want to +sample from. For example, if you wanted to gate all live cells out of a +previously drawn "lymphocytes" gate, you would specify "lymphocytes" here. +Defaults to "root" (ungated).} + +\item{regate}{A boolean specifying whether all gates with a name matching +\code{filterId} should first be deleted before being re-drawn. Attempting +to draw a gate with a non-unique \code{filterId} without specifying +\code{regate = TRUE} will result in an error. Defaults to \code{FALSE}} +} +\value{ +A list of the interactively-specified parameters, including the drawn + gate's coordinates, plot bins, and any flowjo biex coefs used to calculate + those transforms. +} +\description{ +\code{gs_gate_interactive} opens a new graphical window where you can draw +rectangle, polygon, 1-D span, or 2-D quadrant gates that will be applied to +an entire GateSet (see the flowWorkspace package for complete information +about GateSets). +} +\examples{ + +path_to_fcs <- system.file("extdata", package = "flowGate") +fs <- read.flowSet(path = path_to_fcs, + pattern = ".FCS$", + full.names = TRUE) +gs <- GatingSet(fs) + +if(interactive()) { # only run in interactive sessions +gs_gate_interactive(gs, + filterId = "Lymphocytes", + dims = list("FSC-H", "SSC-H")) +} + +# returns gs with the same "Lymphocytes" gate on FSC-H and SSC-H applied to +# the root node (all events) of each sample in the GateSet. + +if(interactive()) { +gs_gate_interactive(gs, + filterId = "Live cells", + dims = "Viability", + subset = "Lymphocytes") +} + +# returns gs with a "Live cells" gate drawn on all cells included in the +# parent "Lymphocytes" gate. This gate would be based on a histogram of a +# marker called Viability, using the first GatingHierarchy sample as an +# example. + +if(interactive()){ +gs_gate_interactive(gs, + filterId = "Live cells", + dims = list("Viability", "SSC-A"), + subset = "Lymphocytes", + regate = TRUE) +} + +# first deletes the "Live cells" gate drawn above, then adds a new "Live +# cells" gate to the set, this time based on a dot plot of Viability by +# side-scatter. + +if(interactive()){ +gs_gate_interactive(gs, + filterId = "Dead cells", + dims = list("Viability", "SSC-A"), + subset = "Lymphocytes", + overlayGates = "Live cells") +} + +# returns gs with a "Dead cells" gate drawn on the same example graph that +# was used to draw the "Live cells" gate above. Overlays the "Live cells" +# gate on top of this graph to aid in drawing the "Dead cells" gate. + +} diff --git a/man/gs_gate_transform_interactive.Rd b/man/gs_gate_transform_interactive.Rd index 68d4d61..763fce5 100644 --- a/man/gs_gate_transform_interactive.Rd +++ b/man/gs_gate_transform_interactive.Rd @@ -60,6 +60,6 @@ gs_gate_transform_interactive(gs, dims = list("FSC-H", "SSC-H")) } -# Opens a window to adjust the gate manually +#Opens a window to adjust the gate manually } diff --git a/man/gs_to_openCyto.Rd b/man/gs_to_openCyto.Rd new file mode 100644 index 0000000..b96d500 --- /dev/null +++ b/man/gs_to_openCyto.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gs_to_openCyto.R +\name{gs_to_openCyto} +\alias{gs_to_openCyto} +\title{Converts an existing GatingSet object into an openCyto template, +based off gates existing for given sample. Experimental} +\usage{ +gs_to_openCyto(gs, sample = 1, outpath = NULL, filename = "openCytoTemplate") +} +\arguments{ +\item{gs}{A GatingSet object} + +\item{sample}{The sample index to use, default is 1} + +\item{outpath}{The file.path to the storage location. Default NULL will +result in creation within the current working directory} +} +\value{ +A .csv file containing an openCyto style template for +subsequent re-gating attempts +} +\description{ +Converts an existing GatingSet object into an openCyto template, +based off gates existing for given sample. Experimental +} +\examples{ +A <- 2 + 2 + +} diff --git a/tests/testthat.R b/tests/testthat.R index 17e4d0e..eb380d5 100644 --- a/tests/testthat.R +++ b/tests/testthat.R @@ -1,4 +1,5 @@ library(testthat) library(flowGate) +library(vdiffr) test_check("flowGate") diff --git a/tests/testthat/_snaps/gs_gate_interactive/polygonplot.svg b/tests/testthat/_snaps/gs_gate_interactive/polygonplot.svg new file mode 100644 index 0000000..8dc829c --- /dev/null +++ b/tests/testthat/_snaps/gs_gate_interactive/polygonplot.svg @@ -0,0 +1,1595 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +s10a01.FCS + + + + + + +250 +500 +750 +1000 +0 +250 +500 +750 +1000 + + + + + +FSC-H FSC-Height +SSC-H SSC-Height +root + + diff --git a/tests/testthat/_snaps/gs_gate_interactive/quadplot.svg b/tests/testthat/_snaps/gs_gate_interactive/quadplot.svg new file mode 100644 index 0000000..92af5f1 --- /dev/null +++ b/tests/testthat/_snaps/gs_gate_interactive/quadplot.svg @@ -0,0 +1,1595 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +s10a01.FCS + + + + + + +250 +500 +750 +1000 +0 +250 +500 +750 +1000 + + + + + +FSC-H FSC-Height +SSC-H SSC-Height +root + + diff --git a/tests/testthat/_snaps/gs_gate_interactive/rectangleplot.svg b/tests/testthat/_snaps/gs_gate_interactive/rectangleplot.svg new file mode 100644 index 0000000..92af5f1 --- /dev/null +++ b/tests/testthat/_snaps/gs_gate_interactive/rectangleplot.svg @@ -0,0 +1,1595 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +s10a01.FCS + + + + + + +250 +500 +750 +1000 +0 +250 +500 +750 +1000 + + + + + +FSC-H FSC-Height +SSC-H SSC-Height +root + + diff --git a/tests/testthat/_snaps/gs_gate_interactive/shiny-biexp.svg b/tests/testthat/_snaps/gs_gate_interactive/shiny-biexp.svg new file mode 100644 index 0000000..c5ee8a1 --- /dev/null +++ b/tests/testthat/_snaps/gs_gate_interactive/shiny-biexp.svg @@ -0,0 +1,2202 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +10 +2 +10 +3 +0 +10 +2 +10 +3 + + + +FSC-H FSC-Height +SSC-H SSC-Height + +count + + + + + + + + + +3 +6 +9 +12 +root + + diff --git a/tests/testthat/_snaps/gs_gate_interactive/spanplot.svg b/tests/testthat/_snaps/gs_gate_interactive/spanplot.svg new file mode 100644 index 0000000..f41c70b --- /dev/null +++ b/tests/testthat/_snaps/gs_gate_interactive/spanplot.svg @@ -0,0 +1,1596 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +s10a01.FCS + + + + + + +250 +500 +750 +1000 +0 +250 +500 +750 +1000 + + + + + +FSC-H FSC-Height +SSC-H SSC-Height +root + + diff --git a/tests/testthat/_snaps/preparePlot/1d-fsc-h-coords-gg.svg b/tests/testthat/_snaps/preparePlot/1d-fsc-h-coords-gg.svg new file mode 100644 index 0000000..11ae53e --- /dev/null +++ b/tests/testthat/_snaps/preparePlot/1d-fsc-h-coords-gg.svg @@ -0,0 +1,70 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +250 +500 +750 +1000 +0.000 +0.001 +0.002 +0.003 + + + + +FSC-H FSC-Height +density +root + + diff --git a/tests/testthat/_snaps/preparePlot/1d-fsc-h-coords.svg b/tests/testthat/_snaps/preparePlot/1d-fsc-h-coords.svg new file mode 100644 index 0000000..fc1bc3e --- /dev/null +++ b/tests/testthat/_snaps/preparePlot/1d-fsc-h-coords.svg @@ -0,0 +1,75 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +300 +400 +500 +600 +700 +0.000 +0.001 +0.002 +0.003 + + + + +FSC-H FSC-Height +density +root + + diff --git a/tests/testthat/_snaps/preparePlot/1d-fsc-h.svg b/tests/testthat/_snaps/preparePlot/1d-fsc-h.svg new file mode 100644 index 0000000..11ae53e --- /dev/null +++ b/tests/testthat/_snaps/preparePlot/1d-fsc-h.svg @@ -0,0 +1,70 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +250 +500 +750 +1000 +0.000 +0.001 +0.002 +0.003 + + + + +FSC-H FSC-Height +density +root + + diff --git a/tests/testthat/_snaps/preparePlot/2d-fsc-h-coords-gg.svg b/tests/testthat/_snaps/preparePlot/2d-fsc-h-coords-gg.svg new file mode 100644 index 0000000..8d662b1 --- /dev/null +++ b/tests/testthat/_snaps/preparePlot/2d-fsc-h-coords-gg.svg @@ -0,0 +1,1875 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +250 +500 +750 +1000 +250 +500 +750 +1000 + + + + +FSC-H FSC-Height +SSC-H SSC-Height + +count + + + + + + + + + +3 +6 +9 +12 +root + + diff --git a/tests/testthat/_snaps/preparePlot/2d-fsc-h-coords.svg b/tests/testthat/_snaps/preparePlot/2d-fsc-h-coords.svg new file mode 100644 index 0000000..b5c5d19 --- /dev/null +++ b/tests/testthat/_snaps/preparePlot/2d-fsc-h-coords.svg @@ -0,0 +1,1887 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +300 +400 +500 +600 +700 +0 +100 +200 +300 +400 +500 + + + + + + +FSC-H FSC-Height +SSC-H SSC-Height + +count + + + + + + + + + +3 +6 +9 +12 +root + + diff --git a/tests/testthat/_snaps/preparePlot/2d-fsc-h.svg b/tests/testthat/_snaps/preparePlot/2d-fsc-h.svg new file mode 100644 index 0000000..8d662b1 --- /dev/null +++ b/tests/testthat/_snaps/preparePlot/2d-fsc-h.svg @@ -0,0 +1,1875 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +250 +500 +750 +1000 +250 +500 +750 +1000 + + + + +FSC-H FSC-Height +SSC-H SSC-Height + +count + + + + + + + + + +3 +6 +9 +12 +root + + diff --git a/tests/testthat/helper-lib.R b/tests/testthat/helper-lib.R new file mode 100644 index 0000000..9a7d570 --- /dev/null +++ b/tests/testthat/helper-lib.R @@ -0,0 +1,17 @@ +# helper-lib.R file to create variables once, +# avoiding repeatedly recreating objects during testing + +# Loading internal .fcs files +path_to_fcs <- system.file("extdata", package = "flowGate") +fs <- read.flowSet(path = path_to_fcs, + pattern = ".FCS$", full.names = TRUE) +gs <- GatingSet(fs) + +# ggplot2 and ggcyto versions (for troubleshooting) +ggcytoVersion <- packageVersion("ggcyto") +ggplot2Version <- packageVersion("ggplot2") + +sample <- 1 +sample.gs <- gs[[sample]] + + diff --git a/tests/testthat/test-gs_gate_interactive.R b/tests/testthat/test-gs_gate_interactive.R new file mode 100644 index 0000000..2426953 --- /dev/null +++ b/tests/testthat/test-gs_gate_interactive.R @@ -0,0 +1,139 @@ +test_that("gs_gate_interactive adds gates to the GatingSet", { + +# Base Plot + +sample <- 1 +dims <- list("FSC-H", "SSC-H") +subset <- "root" +overlayGates <- NULL + +input <- list( + bins = 100, + useCoords = FALSE, + XMin=-1000, + XMax=300000, + Ymin=-1000, + YMax=300000, + gateType="polygonGate", + useBiex = TRUE, + xMaxVal = 250000, + xWidth = -10, + xPos = 4, + xNeg = 0, + yMaxVal = 250000, + yWidth = -10, + yPos = 4, + yNeg = 0 +) + +# ----- Simulate reactiveValues ----- +vals <- list( + gateCoords = data.frame(x = numeric(), y = numeric()) +) + +# ----- Simulate Biex handling ----- +biexTabSelected <- if (input$useBiex) "biexPanel" else "blankPanel" + +# ----- Simulate transX and transY reactives ----- +transX <- flowjo_biexp( + maxValue = input$xMaxVal, + pos = input$xPos, + neg = input$xNeg, + widthBasis = input$xWidth, + inverse = TRUE +) + +transY <- flowjo_biexp( + maxValue = input$yMaxVal, + pos = input$yPos, + neg = input$yNeg, + widthBasis = input$yWidth, + inverse = TRUE +) + +FPlot <- preparePlot(gs, sample, dims, subset, input$bins, input$useCoords, + c(input$XMin, input$XMax, input$YMin, input$YMax), overlayGates, + input$gateType, vals$gateCoords, input$useBiex, input$xMaxVal, + input$xWidth, input$xPos, input$xNeg, input$yMaxVal, input$yWidth, + input$yPos, input$yNeg) + +expect_true(inherits(FPlot, "ggplot")) +vdiffr::expect_doppelganger("Shiny_Biexp", FPlot) + +# span Plot + +filterId <- "Test2" +GateType <- "spanGate" +coords <- list(X=c(250, 500)) +applyGateClose(gs, subset, coords, GateType, filterId, FPlot, + input$useBiex, input$bins, input$xMaxVal, input$xWidth, + input$xPos, input$xNeg, input$yMaxVal, input$yWidth, input$yPos, + input$yNeg) + +spanPlot <- ggcyto(gs[[1]], subset="root", aes(x = "FSC-H", y = "SSC-H")) + + geom_hex(bins=100) + geom_gate("Test2") + +expect_true("Test2" %in% gs_get_pop_paths(gs, path=1)) + +vdiffr::expect_doppelganger("spanPlot", spanPlot) + +# polygon Plot + +filterId <- "Test3" +GateType <- "polygonGate" +coords <- data.frame(X=c(50, 100, 150, 200), Y=c(100, 150, 150, 100)) +applyGateClose(gs, subset, coords, GateType, filterId, FPlot, + input$useBiex, input$bins, input$xMaxVal, input$xWidth, + input$xPos, input$xNeg, input$yMaxVal, input$yWidth, input$yPos, + input$yNeg) + +polygonPlot <- ggcyto(gs[[1]], subset="root", aes(x = "FSC-H", y = "SSC-H")) + + geom_hex(bins=100) + geom_gate("Test3") + +expect_true("Test3" %in% gs_get_pop_paths(gs, path=1)) + +vdiffr::expect_doppelganger("polygonPlot", polygonPlot) + +# rectanglePlot + +filterId <- "Test4" +GateType <- "rectangleGate" +coords <- list(X=c(250, 500), Y=c(250, 500)) +applyGateClose(gs, subset, coords, GateType, filterId, FPlot, + input$useBiex, input$bins, input$xMaxVal, input$xWidth, + input$xPos, input$xNeg, input$yMaxVal, input$yWidth, input$yPos, + input$yNeg) + +rectanglePlot <- ggcyto(gs[[1]], subset="root", aes(x = "FSC-H", y = "SSC-H")) + + geom_hex(bins=100) + geom_gate("Test4") + +expect_true("Test4" %in% gs_get_pop_paths(gs, path=1)) + +vdiffr::expect_doppelganger("rectanglePlot", rectanglePlot) + +# Quadrant Plot + +dims <- list("FL1-H", "FL2-H") + +FPlot <- preparePlot(gs, sample, dims, subset, input$bins, input$useCoords, + c(input$XMin, input$XMax, input$YMin, input$YMax), overlayGates, + input$gateType, vals$gateCoords, input$useBiex, input$xMaxVal, + input$xWidth, input$xPos, input$xNeg, input$yMaxVal, input$yWidth, + input$yPos, input$yNeg) + +filterId <- "Test1" +GateType <- "quadGate" +coords <- list(X=c(5000), Y=c(5000)) +applyGateClose(gs, subset, coords, GateType, filterId, FPlot, + input$useBiex, input$bins, input$xMaxVal, input$xWidth, + input$xPos, input$xNeg, input$yMaxVal, input$yWidth, input$yPos, + input$yNeg) + +quadPlot <- ggcyto(gs[[1]], subset="root", aes(x = "FL1-H", y = "FL2-H")) + + geom_hex(bins=100) + geom_gate("CD15 FITC-CD45 PE+") + +expect_true("CD15 FITC-CD45 PE+" %in% gs_get_pop_paths(gs, path=1)) + +vdiffr::expect_doppelganger("quadPlot", rectanglePlot) + +}) \ No newline at end of file diff --git a/tests/testthat/test-gs_gate_transform_interactive.R b/tests/testthat/test-gs_gate_transform_interactive.R new file mode 100644 index 0000000..5aa91e1 --- /dev/null +++ b/tests/testthat/test-gs_gate_transform_interactive.R @@ -0,0 +1,28 @@ +# Tests for the unexported packages from ggcyto that I need to use - should show +# an early red flag if these get changed at all + +test_that("ggcyto:::fortify.rectangleGate is behaving expectedly", { + rect <- flowCore::rectangleGate(filterId = "TestRect", + list("FSC-H" = c(200, 600), + "SSC-H" = c(0, 400))) + fortRect <- ggcyto:::fortify.rectangleGate(rect) + + expect_s3_class(fortRect, "data.frame") + expect_length(fortRect, 2) + expect_length(fortRect$`FSC-H`, 5) + expect_equal(fortRect[[3,2]], 400) + expect_equal(colnames(fortRect), c("FSC-H", "SSC-H")) +}) + +test_that("ggcyto:::fortify.polygonGate is behaving expectedly", { + bound <- matrix(c(300, 300, 600, 600, 50, 300, 300, 50), ncol = 2, nrow = 4) + colnames(bound) <- c("FSC-H", "SSC-H") + poly <- flowCore::polygonGate(filterId = "nonDebris", .gate = bound) + fortPoly <- ggcyto:::fortify.polygonGate(poly) + + expect_s3_class(fortPoly, "data.frame") + expect_length(fortPoly, 2) + expect_length(fortPoly$`FSC-H`, 5) + expect_equal(fortPoly[[3,2]], 300) + expect_equal(colnames(fortPoly), c("FSC-H", "SSC-H")) +}) \ No newline at end of file diff --git a/tests/testthat/test-preparePlot.R b/tests/testthat/test-preparePlot.R new file mode 100644 index 0000000..abe5d64 --- /dev/null +++ b/tests/testthat/test-preparePlot.R @@ -0,0 +1,70 @@ +test_that("Data is retrieved correctly", { + expect_length(sample.gs, 1) + expect_s4_class(sample.gs, "GatingHierarchy") +}) + +#> Test passed 🎉 + +test_that("1D plots are working", { + dims <- list("FSC-H") + subset <- "root" + gg1D <- ggcyto::ggcyto(sample.gs, aes(!!dims[[1]]), subset = subset) + + geom_density() + scale_x_continuous(expand = c(0,0)) + + scale_y_continuous(expand = c(0,0)) + theme_flowGate + + expect_true(inherits(gg1D, "ggplot")) + vdiffr::expect_doppelganger("1D_FSC-H", gg1D) + + coords <- list(250, 750) + gg1D_coord <- gg1D + coord_cartesian(xlim = c(coords[[1]], coords[[2]])) + vdiffr::expect_doppelganger("1D_FSC-H_coords", gg1D_coord) + + if ("ggcyto_GatingSet" %in% class(gg1D)){ + class(gg1D) <- class(gg1D)[class(gg1D) != "ggcyto_GatingSet"] + } + + gg1D_ggplot <- as.ggplot(gg1D) + expect_false(inherits(gg1D_ggplot, "ggcyto")) + vdiffr::expect_doppelganger("1D_FSC-H_coords_gg", gg1D_ggplot) +}) + +#> Test passed 🎉 + +test_that("2D plots are working", { + dims <- list("FSC-H", "SSC-H") + bins <- 120 + subset <- "root" + + gg2d <- ggcyto::ggcyto( + sample.gs, aes(!!dims[[1]], !!dims[[2]]), subset = subset) + + geom_hex(bins = bins) + scale_x_continuous(expand = c(0,0)) + + scale_y_continuous(expand = c(0,0)) + theme_flowGate + + expect_true(inherits(gg2d, "ggplot")) + vdiffr::expect_doppelganger("2D_FSC-H", gg2d) + + coords <- list(250, 750, 0, 500) + + gg2d_coord <- gg2d + coord_cartesian(xlim = c(coords[[1]], coords[[2]]), + ylim = c(coords[[3]], coords[[4]])) + + vdiffr::expect_doppelganger("2D_FSC-H_coords", gg2d_coord) + + if ("ggcyto_GatingSet" %in% class(gg2d)){ + class(gg2d) <- class(gg2d)[class(gg2d) != "ggcyto_GatingSet"] + } + + gg2d_ggplot <- as.ggplot(gg2d) + expect_false(inherits(gg2d_ggplot, "ggcyto")) + vdiffr::expect_doppelganger("2D_FSC-H_coords_gg", gg2d_ggplot) +}) + +#> Test passed 🎉 + +#test_that("as.ggplot is working", { +# gg <- ggcyto::as.ggplot(gg) +# +# vdiffr::expect_doppelganger("2D_FSC-H_coords", gg2) +#}) + +