From d76f8926929dec44ba5cddb0f085547e842d668b Mon Sep 17 00:00:00 2001 From: Dillon Hammill Date: Tue, 4 Jun 2024 13:07:23 +1000 Subject: [PATCH] Add close button to cyto_spillover_edit(). --- NEWS.md | 1 + R/cyto_spillover_edit.R | 127 +++++++++++++++++++++++----------------- 2 files changed, 74 insertions(+), 54 deletions(-) diff --git a/NEWS.md b/NEWS.md index 02daf5e7..2031f266 100644 --- a/NEWS.md +++ b/NEWS.md @@ -5,6 +5,7 @@ # CytoExploreR 2.0.7 * Bug fixes to handling of `page_fill` and `page_fill_alpha` within the `cyto_plot()` family of functions. +* Add `close` button to `cyto_spillove_edit()` which saves the spillover matrix and then kills the application. # CytoExploreR 2.0.6 diff --git a/R/cyto_spillover_edit.R b/R/cyto_spillover_edit.R index 1c8554e4..c57f0658 100644 --- a/R/cyto_spillover_edit.R +++ b/R/cyto_spillover_edit.R @@ -128,6 +128,9 @@ cyto_spillover_edit <- function(x, viewer = FALSE, ...) { + # NOTE: We can't run the app in a loop as it listens to previous port and + # uses spillover matrix from previous run as pData input for next run. + # PREPARE DATA --------------------------------------------------------------- # CYTOSET/GATINGSET @@ -158,7 +161,7 @@ cyto_spillover_edit <- function(x, } else { channels <- cyto_channels_extract(x, channels) } - + # SAMPLE NAMES nms <- cyto_names(x) @@ -177,7 +180,7 @@ cyto_spillover_edit <- function(x, } ) pd <- pd[match(rownames(cyto_details(x)), rownames(pd)), , drop = FALSE] - # BYPASS CHANNEL_MATCH + # BYPASS CHANNEL_MATCH } else { # BYPASS CYTO_CHANNEL_MATCH TO ALLOW FULL STAINED SAMPLES lapply( @@ -193,7 +196,7 @@ cyto_spillover_edit <- function(x, } ) } - + # UPDATE EXPERIMENT DETAILS cyto_details(x) <- pd @@ -245,7 +248,7 @@ cyto_spillover_edit <- function(x, # NO SPILLOVER MATRIX FOUND if(!is.null(spillover)) { spillover <- spillover[!LAPPLY(spillover, "is.null")][[1]] - # TEMPLATE SPILLOVER MATRIX + # TEMPLATE SPILLOVER MATRIX } else { spillover <- matrix( 0, @@ -258,7 +261,7 @@ cyto_spillover_edit <- function(x, ) diag(spillover) <- 1 } - # PREPARE SUPPLIED SPILLOVER MATRIX + # PREPARE SUPPLIED SPILLOVER MATRIX } else { spillover <- .cyto_spillover_prepare( x, @@ -317,7 +320,7 @@ cyto_spillover_edit <- function(x, # AVOID UNSTAINED CONTROL if (any(grepl("Unstained", pd$channel))) { ID_select <- pd$name[!grepl("Unstained",pd$channel,ignore.case = TRUE)][1] - # USE FIRST SAMPLE + # USE FIRST SAMPLE } else { ID_select <- pd$name[1] } @@ -406,7 +409,11 @@ cyto_spillover_edit <- function(x, "line", "tracker" )), - spillSaveUI("editor_save") + spillSaveUI("editor_save"), + actionButton( + "close", + "Close" + ) ), mainPanel( width = 9, @@ -443,18 +450,18 @@ cyto_spillover_edit <- function(x, ), optionsUI( "plots_options", - label = NULL, - selected = plots_opts_select, - choiceNames = list( - "Overlay unstained control", - "Overlay compensated data", - "Fit robust linear models" - ), - choiceValues = list( - "unstained", - "compensated", - "models" - ) + label = NULL, + selected = plots_opts_select, + choiceNames = list( + "Overlay unstained control", + "Overlay compensated data", + "Fit robust linear models" + ), + choiceValues = list( + "unstained", + "compensated", + "models" + ) ) ), mainPanel( @@ -563,7 +570,7 @@ cyto_spillover_edit <- function(x, quiet = TRUE ) } - # NO UNSTAINED CONTROL SELECTED + # NO UNSTAINED CONTROL SELECTED } else { values$NIL_comp_trans <- NULL } @@ -626,7 +633,7 @@ cyto_spillover_edit <- function(x, quiet = TRUE ) } - # NO SAMPLE SELECTED + # NO SAMPLE SELECTED } else { values$ID_comp_trans <- NULL } @@ -812,6 +819,18 @@ cyto_spillover_edit <- function(x, save_as = save_as ) + # CLOSE + observeEvent( + input$close, + { + write_to_csv( + reactive(values$spill)(), + save_as + ) + stopApp(read_from_csv(save_as)) + } + ) + # RETURN onStop(function() { stopApp(read_from_csv(save_as)) @@ -1068,33 +1087,33 @@ nodeSelectServer <- function(id, moduleServer( id, function(input, output, session) { - - # NAMESPACE - ns <- session$ns - - # VALUES - values <- reactiveValues( - select = NULL - ) - - # UPDATE UI OPTIONS - observe({ - if(cyto_class(data(), "GatingSet")) { - updateSelectInput( - session, - "select", - choices = cyto_nodes(data(), path = "auto"), - selected = selected() - ) - } - }) - - observeEvent(input$select, { - values$select <- input$select + + # NAMESPACE + ns <- session$ns + + # VALUES + values <- reactiveValues( + select = NULL + ) + + # UPDATE UI OPTIONS + observe({ + if(cyto_class(data(), "GatingSet")) { + updateSelectInput( + session, + "select", + choices = cyto_nodes(data(), path = "auto"), + selected = selected() + ) + } + }) + + observeEvent(input$select, { + values$select <- input$select + }) + + return(reactive({values$select})) }) - - return(reactive({values$select})) - }) } @@ -1158,7 +1177,7 @@ spillEditServer <- function(id, data.table = FALSE ) } - # SPILLOVER MATRIX SUPPLIED + # SPILLOVER MATRIX SUPPLIED } else { sp <- spill() } @@ -1378,7 +1397,7 @@ editPlotServer <- function(id, moduleServer(id, function(input, output, session){ - + # PLOTS output$plot <- renderPlot({ # BYPASS PLOTS FOR MISSING DATA @@ -1470,7 +1489,7 @@ editPlotServer <- function(id, channel = chan, inverse = TRUE ) - # NO TRANSFORMERS - LINEAR SCALE + # NO TRANSFORMERS - LINEAR SCALE } else { label_text_x <- min(lims) + 0.90 * diff(lims) @@ -1644,7 +1663,7 @@ compPlotServer <- function(id, cs <- cytoset( cf_list ) - # STAINED ONLY + # STAINED ONLY } else { cs <- ID_comp_trans() } @@ -1750,10 +1769,10 @@ compPlotServer <- function(id, function(z) { if (z < n - 1) { raw_data[raw_data[, channels[1]] >= chunks[z] & - raw_data[, channels[1]] < chunks[z + 1], ] + raw_data[, channels[1]] < chunks[z + 1], ] } else { raw_data[raw_data[, channels[1]] >= chunks[z] & - raw_data[, channels[1]] <= chunks[z + 1], ] + raw_data[, channels[1]] <= chunks[z + 1], ] } } ) @@ -1807,4 +1826,4 @@ compPlotServer <- function(id, ) } -} +} \ No newline at end of file