From cb5b56a5eda18d7fa59f1d859639b2b500a3eacd Mon Sep 17 00:00:00 2001 From: David Rach Date: Sun, 30 Nov 2025 23:58:55 -0500 Subject: [PATCH 01/16] Hi Andrew/Harvey, just testing whether I can get rid of the @import in favor of @importFrom and still have everything work. Will pull request any useful changes (and some additional unit test). Best- David. Change Log: Bunch importFroms; a landing page for ?flowGate, some updates Description, the GitHub branch is behind the Bioconductor, not sure if anything different, or just the rolling release updating the version, some minor roxygen for internals. Passing all CRAN and Bioc Checks with just notes --- DESCRIPTION | 13 +++++-- NAMESPACE | 48 +++++++++++++++++++++-- R/applyGateClose.R | 3 ++ R/flowGate-package.R | 9 +++++ R/gateHandlers.R | 24 ++++++++++++ R/gs_apply_gating_strategy.R | 4 +- R/gs_gate_interactive.R | 9 +++-- R/gs_gate_transform_interactive.R | 58 +++++++++++++++++++++++++--- R/preparePlot.R | 16 +++++++- R/ui.R | 27 +++++++++++++ R/uiTransform.R | 7 ++++ man/flowGate-package.Rd | 28 ++++++++++++++ man/gs_gate_transform_interactive.Rd | 2 +- 13 files changed, 228 insertions(+), 20 deletions(-) create mode 100644 R/flowGate-package.R create mode 100644 man/flowGate-package.Rd diff --git a/DESCRIPTION b/DESCRIPTION index d0b59d2..b2ef800 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -5,11 +5,13 @@ Version: 0.99.2 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,8 +38,8 @@ Imports: Depends: flowWorkspace (>= 4.0.6), ggcyto (>= 1.16.0), - R (>= 4.2) -RoxygenNote: 7.2.3 + R (>= 4.5) +RoxygenNote: 7.3.3 Suggests: knitr, rmarkdown, @@ -50,3 +54,4 @@ biocViews: Preprocessing, ImmunoOncology, DataImport + diff --git a/NAMESPACE b/NAMESPACE index d6d1641..c0a23e5 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -3,22 +3,64 @@ export(gs_apply_gating_strategy) export(gs_gate_interactive) export(gs_gate_transform_interactive) -import(BiocManager) -import(flowWorkspace) -import(ggcyto) +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_pop_add) +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(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(tibble,tribble) diff --git a/R/applyGateClose.R b/R/applyGateClose.R index 9d47097..bee1e9f 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. #' 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_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_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/preparePlot.R b/R/preparePlot.R index 63a6f1f..9f678e1 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 @@ -73,7 +80,12 @@ preparePlot <- function(gs, sample, dims, subset, bins, useCoords, coords, overl 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/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_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 } From 09d2ba11147da58df846486317d68911f949b3ed Mon Sep 17 00:00:00 2001 From: David Rach Date: Sat, 21 Feb 2026 09:13:10 -0500 Subject: [PATCH 02/16] With ggplot2 switching to v4, and ggcyto shifts, flowGate is failing on shiny launch. Creating unit test systematically as I go (as likely will need to refer some of this up to ggcyto as well). --- DESCRIPTION | 1 + tests/testthat.R | 1 + .../_snaps/preparePlot/1d-fsc-h-coords.svg | 75 +++++++++++++++++++ .../testthat/_snaps/preparePlot/1d-fsc-h.svg | 70 +++++++++++++++++ tests/testthat/helper-lib.R | 15 ++++ tests/testthat/test-gs_gate_interactive.R | 0 tests/testthat/test-preparePlot.R | 42 +++++++++++ 7 files changed, 204 insertions(+) create mode 100644 tests/testthat/_snaps/preparePlot/1d-fsc-h-coords.svg create mode 100644 tests/testthat/_snaps/preparePlot/1d-fsc-h.svg create mode 100644 tests/testthat/helper-lib.R create mode 100644 tests/testthat/test-gs_gate_interactive.R create mode 100644 tests/testthat/test-preparePlot.R diff --git a/DESCRIPTION b/DESCRIPTION index b2ef800..7a6110c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -46,6 +46,7 @@ Suggests: stringr, tidyverse, testthat + vdiffr VignetteBuilder: knitr biocViews: Software, 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/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/helper-lib.R b/tests/testthat/helper-lib.R new file mode 100644 index 0000000..daee8fc --- /dev/null +++ b/tests/testthat/helper-lib.R @@ -0,0 +1,15 @@ +# 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") + + + diff --git a/tests/testthat/test-gs_gate_interactive.R b/tests/testthat/test-gs_gate_interactive.R new file mode 100644 index 0000000..e69de29 diff --git a/tests/testthat/test-preparePlot.R b/tests/testthat/test-preparePlot.R new file mode 100644 index 0000000..6687fc2 --- /dev/null +++ b/tests/testthat/test-preparePlot.R @@ -0,0 +1,42 @@ +test_that("Data is retrieved correctly", { + sample <- 1 + sample.gs <- gs[[sample]] + 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" + gg <- 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(gg, "ggplot")) + vdiffr::expect_doppelganger("1D_FSC-H", gg) + + coords <- list(250, 750) + gg2 <- gg + coord_cartesian(xlim = c(coords[[1]], coords[[2]])) + vdiffr::expect_doppelganger("1D_FSC-H_coords", gg2) +}) + +#> Test passed 🎉 + +test_that("2D plots are working", { + dims <- list("FSC-H") + subset <- "root" + gg <- 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(gg, "ggplot")) + vdiffr::expect_doppelganger("1D_FSC-H", gg) + + coords <- list(250, 750) + gg2 <- gg + coord_cartesian(xlim = c(coords[[1]], coords[[2]])) + vdiffr::expect_doppelganger("1D_FSC-H_coords", gg2) +}) + +#> Test passed 🎉 From db5d8c82857d329003a5c27477cc217da93d5452 Mon Sep 17 00:00:00 2001 From: David Rach Date: Sat, 21 Feb 2026 10:58:06 -0500 Subject: [PATCH 03/16] as.ggplot clashing with residual ggcyto_GatingSet class, on stripping returns a ggplot2 object. Gates are still not recording correctly. --- R/preparePlot.R | 3 + .../_snaps/preparePlot/1d-fsc-h-coords-gg.svg | 70 + .../_snaps/preparePlot/2d-fsc-h-coords-gg.svg | 1875 ++++++++++++++++ .../_snaps/preparePlot/2d-fsc-h-coords.svg | 1887 +++++++++++++++++ .../testthat/_snaps/preparePlot/2d-fsc-h.svg | 1875 ++++++++++++++++ tests/testthat/helper-lib.R | 2 + tests/testthat/test-gs_gate_interactive.R | 7 + tests/testthat/test-preparePlot.R | 62 +- 8 files changed, 5764 insertions(+), 17 deletions(-) create mode 100644 tests/testthat/_snaps/preparePlot/1d-fsc-h-coords-gg.svg create mode 100644 tests/testthat/_snaps/preparePlot/2d-fsc-h-coords-gg.svg create mode 100644 tests/testthat/_snaps/preparePlot/2d-fsc-h-coords.svg create mode 100644 tests/testthat/_snaps/preparePlot/2d-fsc-h.svg diff --git a/R/preparePlot.R b/R/preparePlot.R index 9f678e1..7c1ea03 100644 --- a/R/preparePlot.R +++ b/R/preparePlot.R @@ -76,6 +76,9 @@ 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) } 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/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 index daee8fc..9a7d570 100644 --- a/tests/testthat/helper-lib.R +++ b/tests/testthat/helper-lib.R @@ -11,5 +11,7 @@ gs <- GatingSet(fs) 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 index e69de29..34d524f 100644 --- a/tests/testthat/test-gs_gate_interactive.R +++ b/tests/testthat/test-gs_gate_interactive.R @@ -0,0 +1,7 @@ +test_that("gs_gate_interactive is functional", { + +gs_gate_interactive(gs,filterId = "Lymphocytes", dims = list("FSC-H", "SSC-H"), regate=FALSE) + + A <- 2 + 2 + expect_equal(A, 4)# +}) \ No newline at end of file diff --git a/tests/testthat/test-preparePlot.R b/tests/testthat/test-preparePlot.R index 6687fc2..abe5d64 100644 --- a/tests/testthat/test-preparePlot.R +++ b/tests/testthat/test-preparePlot.R @@ -1,6 +1,4 @@ test_that("Data is retrieved correctly", { - sample <- 1 - sample.gs <- gs[[sample]] expect_length(sample.gs, 1) expect_s4_class(sample.gs, "GatingHierarchy") }) @@ -10,33 +8,63 @@ test_that("Data is retrieved correctly", { test_that("1D plots are working", { dims <- list("FSC-H") subset <- "root" - gg <- ggcyto::ggcyto(sample.gs, aes(!!dims[[1]]), subset = subset) + + 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(gg, "ggplot")) - vdiffr::expect_doppelganger("1D_FSC-H", gg) + expect_true(inherits(gg1D, "ggplot")) + vdiffr::expect_doppelganger("1D_FSC-H", gg1D) coords <- list(250, 750) - gg2 <- gg + coord_cartesian(xlim = c(coords[[1]], coords[[2]])) - vdiffr::expect_doppelganger("1D_FSC-H_coords", gg2) + 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") + dims <- list("FSC-H", "SSC-H") + bins <- 120 subset <- "root" - gg <- 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(gg, "ggplot")) - vdiffr::expect_doppelganger("1D_FSC-H", gg) - coords <- list(250, 750) - gg2 <- gg + coord_cartesian(xlim = c(coords[[1]], coords[[2]])) - vdiffr::expect_doppelganger("1D_FSC-H_coords", gg2) + 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) +#}) + + From 2fb489762daf177d31e673a9ced20ddfe9e6ff04 Mon Sep 17 00:00:00 2001 From: David Rach Date: Sat, 21 Feb 2026 14:12:36 -0500 Subject: [PATCH 04/16] Worked through Shiny capture options, gate is being created, but returning a colname not found on recompute from flowWorkspace. --- .../gs_gate_interactive/shiny-biexp.svg | 2202 +++++++++++++++++ tests/testthat/test-gs_gate_interactive.R | 74 +- 2 files changed, 2272 insertions(+), 4 deletions(-) create mode 100644 tests/testthat/_snaps/gs_gate_interactive/shiny-biexp.svg 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/test-gs_gate_interactive.R b/tests/testthat/test-gs_gate_interactive.R index 34d524f..4431bd1 100644 --- a/tests/testthat/test-gs_gate_interactive.R +++ b/tests/testthat/test-gs_gate_interactive.R @@ -1,7 +1,73 @@ test_that("gs_gate_interactive is functional", { -gs_gate_interactive(gs,filterId = "Lymphocytes", dims = list("FSC-H", "SSC-H"), regate=FALSE) - - A <- 2 + 2 - expect_equal(A, 4)# +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) + +#gs_gate_interactive(gs,filterId = "Lymphocytes4", dims = list("FSC-H", "SSC-H"), regate=FALSE) + +filterID <- "Test" +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) + }) \ No newline at end of file From 890bb6409bf2559f54a9817a0bb8f28065178066 Mon Sep 17 00:00:00 2001 From: David Rach Date: Sat, 21 Feb 2026 14:40:09 -0500 Subject: [PATCH 05/16] Fixed! The two major changes are the linguering GatingSet class that broke as.ggplot. The second was a ggplot2 v4 change that resulted in no column names getting pulled from data of the ggplot. With those two elements fixed, gate gets added correctly to the GatingSet. --- R/applyGateClose.R | 8 ++++---- tests/testthat/test-gs_gate_interactive.R | 16 ++++++++-------- 2 files changed, 12 insertions(+), 12 deletions(-) diff --git a/R/applyGateClose.R b/R/applyGateClose.R index bee1e9f..3df6e4e 100644 --- a/R/applyGateClose.R +++ b/R/applyGateClose.R @@ -16,17 +16,17 @@ applyGateClose <- function( gs, subset, coords, gateType, filterId, gg, useBiex, bins, xMax, xWidth, xPos, xNeg, yMax, yWidth, yPos, yNeg){ if(gateType == "polygonGate"){ - names(coords) <- c(names(gg[[1]])[[3]], names(gg[[1]])[[4]]) + names(coords) <- c(names(gg$data)[[3]], names(gg$data)[[4]]) coords <- as.matrix(coords) gate <- flowCore::polygonGate(coords, filterId = filterId) } else if(gateType == "spanGate"){ - names(coords) <- c(names(gg[[1]])[[3]]) + names(coords) <- c(names(gg$data))[[3]] gate <- flowCore::rectangleGate(coords, filterId = filterId) } else if(gateType == "quadGate"){ - names(coords) <- c(names(gg[[1]])[[3]], names(gg[[1]])[[4]]) + names(coords) <- c(names(gg$data)[[3]], names(gg$data)[[4]]) gate <- flowCore::quadGate(coords, filterId = filterId) } else if(gateType == "rectangleGate"){ - names(coords) <- c(names(gg[[1]])[[3]], names(gg[[1]])[[4]]) + names(coords) <- c(names(gg$data)[[3]], names(gg$data)[[4]]) gate <- flowCore::rectangleGate(coords, filterId = filterId) } gs_pop_add(gs, gate, parent = subset) diff --git a/tests/testthat/test-gs_gate_interactive.R b/tests/testthat/test-gs_gate_interactive.R index 4431bd1..7bb6d29 100644 --- a/tests/testthat/test-gs_gate_interactive.R +++ b/tests/testthat/test-gs_gate_interactive.R @@ -58,16 +58,16 @@ FPlot <- preparePlot(gs, sample, dims, subset, input$bins, input$useCoords, expect_true(inherits(FPlot, "ggplot")) vdiffr::expect_doppelganger("Shiny_Biexp", FPlot) -#gs_gate_interactive(gs,filterId = "Lymphocytes4", dims = list("FSC-H", "SSC-H"), regate=FALSE) +#gs_gate_interactive(gs,filterId = "Lymphocytes6", dims = list("FSC-H", "SSC-H"), regate=FALSE) -filterID <- "Test" -GateType <- "spanGate" -Coords <- list(X=c(250, 500)) +#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) +#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) }) \ No newline at end of file From 34aa109f57a7f7c0c3f1a31a192c4c678577af51 Mon Sep 17 00:00:00 2001 From: David Rach Date: Sat, 21 Feb 2026 15:52:26 -0500 Subject: [PATCH 06/16] Unit test for all four interactive plot types. Need to check ggplot2 v3 next to see if back-compatible or not. --- .../gs_gate_interactive/polygonplot.svg | 1595 ++++++++++++++++ .../_snaps/gs_gate_interactive/quadplot.svg | 1595 ++++++++++++++++ .../gs_gate_interactive/rectangleplot.svg | 1595 ++++++++++++++++ .../_snaps/gs_gate_interactive/spanplot.svg | 1596 +++++++++++++++++ tests/testthat/test-gs_gate_interactive.R | 86 +- 5 files changed, 6457 insertions(+), 10 deletions(-) create mode 100644 tests/testthat/_snaps/gs_gate_interactive/polygonplot.svg create mode 100644 tests/testthat/_snaps/gs_gate_interactive/quadplot.svg create mode 100644 tests/testthat/_snaps/gs_gate_interactive/rectangleplot.svg create mode 100644 tests/testthat/_snaps/gs_gate_interactive/spanplot.svg 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/spanplot.svg b/tests/testthat/_snaps/gs_gate_interactive/spanplot.svg new file mode 100644 index 0000000..52c4da2 --- /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/test-gs_gate_interactive.R b/tests/testthat/test-gs_gate_interactive.R index 7bb6d29..2426953 100644 --- a/tests/testthat/test-gs_gate_interactive.R +++ b/tests/testthat/test-gs_gate_interactive.R @@ -1,4 +1,6 @@ -test_that("gs_gate_interactive is functional", { +test_that("gs_gate_interactive adds gates to the GatingSet", { + +# Base Plot sample <- 1 dims <- list("FSC-H", "SSC-H") @@ -57,17 +59,81 @@ FPlot <- preparePlot(gs, sample, dims, subset, input$bins, input$useCoords, expect_true(inherits(FPlot, "ggplot")) vdiffr::expect_doppelganger("Shiny_Biexp", FPlot) - -#gs_gate_interactive(gs,filterId = "Lymphocytes6", dims = list("FSC-H", "SSC-H"), regate=FALSE) -#filterId <- "Test2" -#GateType <- "spanGate" -#coords <- list(X=c(250, 500)) +# 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) -#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 From d84ac975141aa21d4922670a98ba4b89c407024f Mon Sep 17 00:00:00 2001 From: David Rach Date: Sat, 4 Apr 2026 14:44:19 -0400 Subject: [PATCH 07/16] Missing description file comma --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 7a6110c..62934d7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -45,7 +45,7 @@ Suggests: rmarkdown, stringr, tidyverse, - testthat + testthat, vdiffr VignetteBuilder: knitr biocViews: From 37b6ce15c270824087a2cef51c429816c7bde650 Mon Sep 17 00:00:00 2001 From: David Rach Date: Wed, 15 Apr 2026 20:47:46 -0400 Subject: [PATCH 08/16] Rollback requirement to R >= 4.4 for Cytometry in R class --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 62934d7..139414d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -38,7 +38,7 @@ Imports: Depends: flowWorkspace (>= 4.0.6), ggcyto (>= 1.16.0), - R (>= 4.5) + R (>= 4.4) RoxygenNote: 7.3.3 Suggests: knitr, From d56d7d37a2fe9dc00f27723039dd1d569b529f0d Mon Sep 17 00:00:00 2001 From: David Rach Date: Sat, 20 Jun 2026 13:16:34 -0400 Subject: [PATCH 09/16] Initial work on gs_gate_interactive_adjust, which will iterate through a specific gate allowing adjustments. Currently, the existing gate is not shown, so everything ends up being redrawn, so need to modify that --- NAMESPACE | 2 + R/applyGateCloseSwap.R | 49 +++++++++ R/gs_apply_gate_check.R | 70 ++++++++++++ R/gs_gate_interactive_adjust.R | 173 ++++++++++++++++++++++++++++++ man/gs_apply_gate_check.Rd | 54 ++++++++++ man/gs_gate_interactive_adjust.Rd | 108 +++++++++++++++++++ 6 files changed, 456 insertions(+) create mode 100644 R/applyGateCloseSwap.R create mode 100644 R/gs_apply_gate_check.R create mode 100644 R/gs_gate_interactive_adjust.R create mode 100644 man/gs_apply_gate_check.Rd create mode 100644 man/gs_gate_interactive_adjust.Rd diff --git a/NAMESPACE b/NAMESPACE index c0a23e5..6bb8bcd 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,7 +1,9 @@ # 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) importFrom(BiocManager,install) importFrom(dplyr,bind_rows) diff --git a/R/applyGateCloseSwap.R b/R/applyGateCloseSwap.R new file mode 100644 index 0000000..a269534 --- /dev/null +++ b/R/applyGateCloseSwap.R @@ -0,0 +1,49 @@ +#' 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. +#' +#' @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){ + if(gateType == "polygonGate"){ + names(coords) <- c(names(gg$data)[[3]], names(gg$data)[[4]]) + coords <- as.matrix(coords) + gate <- flowCore::polygonGate(coords, filterId = filterId) + } else if(gateType == "spanGate"){ + names(coords) <- c(names(gg$data))[[3]] + gate <- flowCore::rectangleGate(coords, filterId = filterId) + } else if(gateType == "quadGate"){ + names(coords) <- c(names(gg$data)[[3]], names(gg$data)[[4]]) + gate <- flowCore::quadGate(coords, filterId = filterId) + } else if(gateType == "rectangleGate"){ + names(coords) <- c(names(gg$data)[[3]], names(gg$data)[[4]]) + gate <- flowCore::rectangleGate(coords, filterId = filterId) + } + + # gs_pop_add(gs, gate, parent = subset) + TheList <- list(gate) + names(TheList) <- sampleNames(gs[sample]) + gs_pop_set_gate(gs[sample], filterId, TheList) + recompute(gs[sample]) + + 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/gs_apply_gate_check.R b/R/gs_apply_gate_check.R new file mode 100644 index 0000000..46dfa8f --- /dev/null +++ b/R/gs_apply_gate_check.R @@ -0,0 +1,70 @@ +#' 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 ... 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, ...){ + 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, + ... + ) + } + ) + + } else { + stop("'gs' must be a GatingSet") + } +} \ No newline at end of file diff --git a/R/gs_gate_interactive_adjust.R b/R/gs_gate_interactive_adjust.R new file mode 100644 index 0000000..927c874 --- /dev/null +++ b/R/gs_gate_interactive_adjust.R @@ -0,0 +1,173 @@ +#' 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). +#' +#' @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, 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]] + + if (!is.null(overlayGates)){ + #overlayGates <- AllGates@boundaries + } + + + # 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())) + # 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, { + output <- list( + 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) + #print(output) + 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) + shiny::stopApp(output) + }) + } + shiny::runApp(shiny::shinyApp(ui, server)) +} \ No newline at end of file diff --git a/man/gs_apply_gate_check.Rd b/man/gs_apply_gate_check.Rd new file mode 100644 index 0000000..659a5e7 --- /dev/null +++ b/man/gs_apply_gate_check.Rd @@ -0,0 +1,54 @@ +% 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, ...) +} +\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{...}{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..3f117c8 --- /dev/null +++ b/man/gs_gate_interactive_adjust.Rd @@ -0,0 +1,108 @@ +% 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, 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{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. + +} From 1d5f81d754cb5a4661ced95300b080cd53e4f41f Mon Sep 17 00:00:00 2001 From: David Rach Date: Sat, 20 Jun 2026 13:53:23 -0400 Subject: [PATCH 10/16] Modified gs_gate_interactive_adjust to show existing gate, and if done is clicked directly exit out without any adjustments being conducted. Seems to be recalculating correctly, as the downstream plots are showing the appearance of singlets subsequently, and when viewing gate coordinates the vertices are specimen specific. So one object off the list, wooh! Updating to 0.99.3 for internal tracking. --- DESCRIPTION | 2 +- R/gs_gate_interactive_adjust.R | 18 +++++++----------- 2 files changed, 8 insertions(+), 12 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 139414d..f12d0d9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: flowGate Type: Package Title: Interactive Cytometry Gating in R -Version: 0.99.2 +Version: 0.99.3 Authors@R: c(person("Andrew", "Wight", email = "andrew.wight10@gmail.com", diff --git a/R/gs_gate_interactive_adjust.R b/R/gs_gate_interactive_adjust.R index 927c874..0c738c2 100644 --- a/R/gs_gate_interactive_adjust.R +++ b/R/gs_gate_interactive_adjust.R @@ -109,10 +109,8 @@ gs_gate_interactive_adjust <- function(gs, gate, sample, overlayGates = NULL){ filterId <- gate dims <- sapply(AllGates@parameters, function(x) x@parameters) |> unname() subset <- gs_pop_get_parent(gs[sample], gate)[[1]] - - if (!is.null(overlayGates)){ - #overlayGates <- AllGates@boundaries - } + #overlayGates <- polygonGate(filterId = AllGates@filterId, .gate = AllGates@boundaries) + overlayGates <- AllGates # if(regate == TRUE){gs_pop_remove(gs, filterId)} @@ -155,19 +153,17 @@ gs_gate_interactive_adjust <- function(gs, gate, sample, overlayGates = NULL){ vals$gateCoords <- data.frame("x" = numeric(), "y" = numeric())}) # Apply gate and close ------------------------------------------------- shiny::observeEvent(input$done, { - output <- list( - 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) - #print(output) - output <- applyGateCloseSwap( + if (nrow(vals$gateCoords) == 0) { + 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) shiny::stopApp(output) + } }) + } shiny::runApp(shiny::shinyApp(ui, server)) } \ No newline at end of file From d1c628da1edc4650a6f10ea72ac94c9f25eee307 Mon Sep 17 00:00:00 2001 From: David Rach Date: Sat, 20 Jun 2026 15:59:31 -0400 Subject: [PATCH 11/16] Added a GatingSet to openCyto template function, everything being written out as a polygon (and registering the new method via openCyto). Will see whether works for other gate types. --- NAMESPACE | 8 ++++ R/gs_to_openCyto.R | 92 +++++++++++++++++++++++++++++++++++++++++++ man/gs_to_openCyto.Rd | 29 ++++++++++++++ 3 files changed, 129 insertions(+) create mode 100644 R/gs_to_openCyto.R create mode 100644 man/gs_to_openCyto.Rd diff --git a/NAMESPACE b/NAMESPACE index 6bb8bcd..7ea9513 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -5,6 +5,7 @@ export(gs_apply_gating_strategy) export(gs_gate_interactive) export(gs_gate_interactive_adjust) export(gs_gate_transform_interactive) +export(gs_to_openCyto) importFrom(BiocManager,install) importFrom(dplyr,bind_rows) importFrom(flowCore,polygonGate) @@ -14,7 +15,10 @@ 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) @@ -37,6 +41,8 @@ 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,"!!") @@ -65,4 +71,6 @@ 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/R/gs_to_openCyto.R b/R/gs_to_openCyto.R new file mode 100644 index 0000000..b27f6b9 --- /dev/null +++ b/R/gs_to_openCyto.R @@ -0,0 +1,92 @@ + +#' 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)] + 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]] + TheVector <- TheGate@boundaries + coords <- paste(c(TheVector[,1], TheVector[,2]), collapse = ",") + TheMethod <- "polygon_gate" + TheDims <- colnames(TheVector) + if(length(TheDims) > 1){TheDims <- paste(TheDims, collapse = ",")} + ThefilterId <- TheGate@filterId + TheParent <- gs_pop_get_parent(gs[sample], x) + +Data <- data.frame( + alias=ThefilterId, + pop="+", + parent=TheParent, + dims=TheDims, + gating_method=TheMethod, + 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) +} + +#' Ensures polygon_gate is available to openCyto +#' +#' @importFrom openCyto register_plugins +#' +#' @noRd +.onLoad <- function(libname, pkgname) { + openCyto::register_plugins( + fun = .my_polygon, + methodName = "polygon_gate" + ) +} \ No newline at end of file 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 + +} From 36d85762bffa4ba11dfea61832af65ea2f5943bf Mon Sep 17 00:00:00 2001 From: David Rach Date: Sun, 21 Jun 2026 11:37:11 -0400 Subject: [PATCH 12/16] SpanGate adjustments and openCyto template exports are operational --- R/applyGateCloseSwap.R | 1 + R/gs_gate_interactive_adjust.R | 5 +- R/gs_to_openCyto.R | 92 +++++++++++++++++++++++----------- 3 files changed, 68 insertions(+), 30 deletions(-) diff --git a/R/applyGateCloseSwap.R b/R/applyGateCloseSwap.R index a269534..8b4b263 100644 --- a/R/applyGateCloseSwap.R +++ b/R/applyGateCloseSwap.R @@ -15,6 +15,7 @@ applyGateCloseSwap <- function( gs, subset, coords, gateType, filterId, gg, useBiex, bins, xMax, xWidth, xPos, xNeg, yMax, yWidth, yPos, yNeg, sample){ + if(gateType == "polygonGate"){ names(coords) <- c(names(gg$data)[[3]], names(gg$data)[[4]]) coords <- as.matrix(coords) diff --git a/R/gs_gate_interactive_adjust.R b/R/gs_gate_interactive_adjust.R index 0c738c2..19a1a31 100644 --- a/R/gs_gate_interactive_adjust.R +++ b/R/gs_gate_interactive_adjust.R @@ -153,9 +153,10 @@ gs_gate_interactive_adjust <- function(gs, gate, sample, overlayGates = NULL){ vals$gateCoords <- data.frame("x" = numeric(), "y" = numeric())}) # Apply gate and close ------------------------------------------------- shiny::observeEvent(input$done, { - if (nrow(vals$gateCoords) == 0) { + if (is.data.frame(vals$gateCoords) && nrow(vals$gateCoords) == 0 && is.null(input$X)) { shiny::stopApp(overlayGates) - } else { output <- applyGateCloseSwap( + } 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, diff --git a/R/gs_to_openCyto.R b/R/gs_to_openCyto.R index b27f6b9..852ac1a 100644 --- a/R/gs_to_openCyto.R +++ b/R/gs_to_openCyto.R @@ -23,6 +23,8 @@ 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()} @@ -43,29 +45,55 @@ gs_to_openCyto <- function(gs, sample=1, outpath=NULL, filename="openCytoTemplat #' @return A data.frame row #' #' @noRd -#' +#' gate_detallitos <- function(x, gs, sample){ + TheGate <- gs_pop_get_gate(gs[sample], x)[[1]] - TheVector <- TheGate@boundaries - coords <- paste(c(TheVector[,1], TheVector[,2]), collapse = ",") - TheMethod <- "polygon_gate" - TheDims <- colnames(TheVector) - if(length(TheDims) > 1){TheDims <- paste(TheDims, collapse = ",")} - ThefilterId <- TheGate@filterId - TheParent <- gs_pop_get_parent(gs[sample], x) - -Data <- data.frame( - alias=ThefilterId, - pop="+", - parent=TheParent, - dims=TheDims, - gating_method=TheMethod, - gating_args= sprintf('matrix(c(%s),ncol=2)', coords), - collapseDataForGating="FALSE", - groupBy="NA", - preprocessing_method="NA", - preprocessing_args="NA" -) + + 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) } @@ -79,14 +107,22 @@ Data <- data.frame( flowCore::polygonGate(.gate = boundaries) } -#' Ensures polygon_gate is available to openCyto -#' +#' 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_polygon, methodName = "polygon_gate") + openCyto::register_plugins(fun = .my_span, methodName = "span_gate") } \ No newline at end of file From 082aff72707ad9888914461771700d8d2550ed6a Mon Sep 17 00:00:00 2001 From: David Rach Date: Sat, 27 Jun 2026 12:18:41 -0400 Subject: [PATCH 13/16] Incorporation of additional metadata columns to pData was causing gateClose to break. Reason is they were ending up within gg$data, which threw off the fix instituted following ggcyto break in the spring. Ended up using tail argument to identify the last one or two last items according to gate type. Appears working for both initial and regating attempts so far, need to verify different metadata or fluor names still work, and not just alphabetical in nature. --- R/applyGateClose.R | 16 +++++++++++----- R/applyGateCloseSwap.R | 12 ++++++++---- 2 files changed, 19 insertions(+), 9 deletions(-) diff --git a/R/applyGateClose.R b/R/applyGateClose.R index 3df6e4e..d16b25e 100644 --- a/R/applyGateClose.R +++ b/R/applyGateClose.R @@ -15,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$data)[[3]], names(gg$data)[[4]]) + names(coords) <- LastTwo coords <- as.matrix(coords) gate <- flowCore::polygonGate(coords, filterId = filterId) } else if(gateType == "spanGate"){ - names(coords) <- c(names(gg$data))[[3]] + names(coords) <- FinalOne gate <- flowCore::rectangleGate(coords, filterId = filterId) } else if(gateType == "quadGate"){ - names(coords) <- c(names(gg$data)[[3]], names(gg$data)[[4]]) + names(coords) <- LastTwo gate <- flowCore::quadGate(coords, filterId = filterId) } else if(gateType == "rectangleGate"){ - names(coords) <- c(names(gg$data)[[3]], names(gg$data)[[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 index 8b4b263..c4eb10e 100644 --- a/R/applyGateCloseSwap.R +++ b/R/applyGateCloseSwap.R @@ -16,18 +16,22 @@ applyGateCloseSwap <- function( gs, subset, coords, gateType, filterId, gg, useBiex, bins, xMax, xWidth, xPos, xNeg, yMax, yWidth, yPos, yNeg, sample){ + TheNames <- names(gg$data) + LastTwo <- tail(TheNames, 2) + FinalOne <- tail(TheNames, 1) + if(gateType == "polygonGate"){ - names(coords) <- c(names(gg$data)[[3]], names(gg$data)[[4]]) + names(coords) <- LastTwo coords <- as.matrix(coords) gate <- flowCore::polygonGate(coords, filterId = filterId) } else if(gateType == "spanGate"){ - names(coords) <- c(names(gg$data))[[3]] + names(coords) <- FinalOne gate <- flowCore::rectangleGate(coords, filterId = filterId) } else if(gateType == "quadGate"){ - names(coords) <- c(names(gg$data)[[3]], names(gg$data)[[4]]) + names(coords) <- LastTwo gate <- flowCore::quadGate(coords, filterId = filterId) } else if(gateType == "rectangleGate"){ - names(coords) <- c(names(gg$data)[[3]], names(gg$data)[[4]]) + names(coords) <- LastTwo gate <- flowCore::rectangleGate(coords, filterId = filterId) } From ec1f1b9e00637d5bd9e071f81f48633f6cee5e62 Mon Sep 17 00:00:00 2001 From: David Rach Date: Sat, 27 Jun 2026 12:41:21 -0400 Subject: [PATCH 14/16] AdjustAll argument for applyGateCloseSwap to adjust all specimens within a GatingSet in one go if so desired --- R/applyGateCloseSwap.R | 13 +++++++++++-- R/gs_apply_gate_check.R | 4 +++- R/gs_gate_interactive_adjust.R | 7 ++++--- man/gs_apply_gate_check.Rd | 4 +++- man/gs_gate_interactive_adjust.Rd | 10 +++++++++- 5 files changed, 30 insertions(+), 8 deletions(-) diff --git a/R/applyGateCloseSwap.R b/R/applyGateCloseSwap.R index c4eb10e..448309a 100644 --- a/R/applyGateCloseSwap.R +++ b/R/applyGateCloseSwap.R @@ -4,6 +4,7 @@ #' @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 @@ -14,7 +15,7 @@ #' applyGateCloseSwap <- function( gs, subset, coords, gateType, filterId, gg, useBiex, bins, xMax, xWidth, - xPos, xNeg, yMax, yWidth, yPos, yNeg, sample){ + xPos, xNeg, yMax, yWidth, yPos, yNeg, sample, AdjustAll=FALSE){ TheNames <- names(gg$data) LastTwo <- tail(TheNames, 2) @@ -37,9 +38,17 @@ applyGateCloseSwap <- function( # 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( @@ -51,4 +60,4 @@ applyGateCloseSwap <- function( } output <- list("Gate" = gate, "Bins" = bins, "Scaling" = varsBiex) return(output) -} + } diff --git a/R/gs_apply_gate_check.R b/R/gs_apply_gate_check.R index 46dfa8f..3f9c090 100644 --- a/R/gs_apply_gate_check.R +++ b/R/gs_apply_gate_check.R @@ -9,6 +9,7 @@ #' @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. @@ -45,7 +46,7 @@ #' } #' @export #' -gs_apply_gate_check <- function(gs, gate, sample=NULL, ...){ +gs_apply_gate_check <- function(gs, gate, sample=NULL, AdjustAll=FALSE, ...){ if(methods::is(gs, "GatingSet")){ if(is.null(sample)){ @@ -59,6 +60,7 @@ gs_apply_gate_check <- function(gs, gate, sample=NULL, ...){ gs = gs, gate = gate, sample = sample, + AdjustAll = AdjustAll, ... ) } diff --git a/R/gs_gate_interactive_adjust.R b/R/gs_gate_interactive_adjust.R index 19a1a31..aea6d85 100644 --- a/R/gs_gate_interactive_adjust.R +++ b/R/gs_gate_interactive_adjust.R @@ -32,7 +32,8 @@ #' 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") @@ -101,7 +102,7 @@ #' renderPlot renderText stopApp runApp shinyApp #' #' @export -gs_gate_interactive_adjust <- function(gs, gate, sample, overlayGates = NULL){ +gs_gate_interactive_adjust <- function(gs, gate, sample, AdjustAll=FALSE, overlayGates = NULL){ # Retrieve existing gate information ======================================= @@ -160,7 +161,7 @@ gs_gate_interactive_adjust <- function(gs, gate, sample, overlayGates = NULL){ 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) + input$yNeg, sample, AdjustAll=AdjustAll) shiny::stopApp(output) } }) diff --git a/man/gs_apply_gate_check.Rd b/man/gs_apply_gate_check.Rd index 659a5e7..9784de9 100644 --- a/man/gs_apply_gate_check.Rd +++ b/man/gs_apply_gate_check.Rd @@ -6,7 +6,7 @@ individual specimen via the Shiny app, quickly iterating through every specimen present in the GatingSet.} \usage{ -gs_apply_gate_check(gs, gate, sample = NULL, ...) +gs_apply_gate_check(gs, gate, sample = NULL, AdjustAll = FALSE, ...) } \arguments{ \item{gs}{A GatingSet or list of GatingSets.} @@ -16,6 +16,8 @@ gs_apply_gate_check(gs, gate, sample = NULL, ...) \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.} diff --git a/man/gs_gate_interactive_adjust.Rd b/man/gs_gate_interactive_adjust.Rd index 3f117c8..6f73370 100644 --- a/man/gs_gate_interactive_adjust.Rd +++ b/man/gs_gate_interactive_adjust.Rd @@ -4,7 +4,13 @@ \alias{gs_gate_interactive_adjust} \title{Interactive Manual Gating} \usage{ -gs_gate_interactive_adjust(gs, gate, sample, overlayGates = NULL) +gs_gate_interactive_adjust( + gs, + gate, + sample, + AdjustAll = FALSE, + overlayGates = NULL +) } \arguments{ \item{gs}{The GateSet that will be gated on.} @@ -15,6 +21,8 @@ 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 From 2c582bca2c7c11937db64239831afa1389bc504b Mon Sep 17 00:00:00 2001 From: David Rach Date: Sat, 27 Jun 2026 23:25:33 -0400 Subject: [PATCH 15/16] Quality of life change for the Shiny, when only one-dimension provided, updates Radio Button to select spanGate --- R/gs_gate_interactive_adjust.R | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/R/gs_gate_interactive_adjust.R b/R/gs_gate_interactive_adjust.R index aea6d85..ea580b1 100644 --- a/R/gs_gate_interactive_adjust.R +++ b/R/gs_gate_interactive_adjust.R @@ -120,6 +120,13 @@ gs_gate_interactive_adjust <- function(gs, gate, sample, AdjustAll=FALSE, overla 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){ @@ -166,6 +173,8 @@ gs_gate_interactive_adjust <- function(gs, gate, sample, AdjustAll=FALSE, overla } }) - } + } shiny::runApp(shiny::shinyApp(ui, server)) -} \ No newline at end of file +} + + From 5cca8ddcc1c0c7da898467e487de889c64a8b2b1 Mon Sep 17 00:00:00 2001 From: David Rach Date: Thu, 2 Jul 2026 10:06:53 -0400 Subject: [PATCH 16/16] Brough over Bioconductor flowGate version 1.13.1 differences to bring both GitHub and Bioconductor brances to being equivalent (except for preparePlot, which still double checking with unit tests for the Bioconductor version vs the ggcyto changes). --- DESCRIPTION | 2 +- NEWS.md | 11 ++++++-- README.md | 1 + .../_snaps/gs_gate_interactive/spanplot.svg | 4 +-- .../test-gs_gate_transform_interactive.R | 28 +++++++++++++++++++ 5 files changed, 41 insertions(+), 5 deletions(-) create mode 100644 tests/testthat/test-gs_gate_transform_interactive.R diff --git a/DESCRIPTION b/DESCRIPTION index f12d0d9..2ae6472 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: flowGate Type: Package Title: Interactive Cytometry Gating in R -Version: 0.99.3 +Version: 1.13.1 Authors@R: c(person("Andrew", "Wight", email = "andrew.wight10@gmail.com", 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/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/tests/testthat/_snaps/gs_gate_interactive/spanplot.svg b/tests/testthat/_snaps/gs_gate_interactive/spanplot.svg index 52c4da2..f41c70b 100644 --- a/tests/testthat/_snaps/gs_gate_interactive/spanplot.svg +++ b/tests/testthat/_snaps/gs_gate_interactive/spanplot.svg @@ -1556,8 +1556,8 @@ - - + + 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