From 2d5f30849a53f05c442876bb55337b3d26a7f765 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Llu=C3=ADs?= Date: Sat, 15 Apr 2023 14:00:22 +0200 Subject: [PATCH] Add goodcellsID checks Closes #16 --- R/auto-qc.R | 4 +- R/flow-rate.R | 3 +- R/margins.R | 3 +- R/signal.R | 3 +- R/utils.R | 12 + inst/shiny/server.R | 676 ++++++++++++++++++++++---------------------- 6 files changed, 360 insertions(+), 341 deletions(-) create mode 100644 R/utils.R diff --git a/R/auto-qc.R b/R/auto-qc.R index 2d612cf..e7ba1ae 100755 --- a/R/auto-qc.R +++ b/R/auto-qc.R @@ -310,7 +310,9 @@ flow_auto_qc <- function(fcsfiles, remove_from = "all", output = 1, params <- parameters(ordFCS) keyval <- keyword(ordFCS) if (fcs_highQ != FALSE || output == 1) { - goodfcs <- flowFrame(exprs = sub_exprs[goodCellIDs, ], parameters = params, description = keyval) + check_goodcellsID(goodCellIDs) + goodfcs <- flowFrame(exprs = sub_exprs[goodCellIDs, , drop = FALSE], + parameters = params, description = keyval) if (fcs_highQ != FALSE) {suppressWarnings(write.FCS(goodfcs, good.fcs.file)) } } if (fcs_QC != FALSE || output == 2 ){ diff --git a/R/flow-rate.R b/R/flow-rate.R index 47a294b..2ebfa82 100755 --- a/R/flow-rate.R +++ b/R/flow-rate.R @@ -63,7 +63,8 @@ flow_rate_check <- function(x, FlowRateData, alpha = alpha, use_decomp = use_dec params <- parameters(x) keyval <- keyword(x) sub_exprs <- exprs(x) - sub_exprs <- sub_exprs[goodCellIDs, ] + check_goodcellsID(goodCellIDs) + sub_exprs <- sub_exprs[goodCellIDs, , drop = FALSE] newx <- flowFrame(exprs = sub_exprs, parameters = params, description = keyval) } cat(paste0(100 * badPerc, "% of anomalous cells detected in the flow rate check. \n")) diff --git a/R/margins.R b/R/margins.R index 8142b2f..98d4db8 100755 --- a/R/margins.R +++ b/R/margins.R @@ -111,7 +111,8 @@ flow_margin_check <- function(x, ChannelExclude = NULL, params <- parameters(x) keyval <- keyword(x) sub_exprs <- exprs(x) - sub_exprs <- sub_exprs[goodCellIDs, ] + check_goodcellsID(goodCellIDs) + sub_exprs <- sub_exprs[goodCellIDs, , drop = FALSE] newx <- flowFrame(exprs = sub_exprs, parameters = params, description = keyval) diff --git a/R/signal.R b/R/signal.R index 4e3fdeb..97acc4f 100755 --- a/R/signal.R +++ b/R/signal.R @@ -162,7 +162,8 @@ flow_signal_check <- function(x, FlowSignalData, ChannelExclude = NULL, params <- parameters(x) keyval <- keyword(x) sub_exprs <- exprs(x) - sub_exprs <- sub_exprs[goodCellIDs, ] ## check if the Id Correspond! + check_goodcellsID(goodCellIDs) + sub_exprs <- sub_exprs[goodCellIDs, , drop = FALSE] ## check if the Id Correspond! newx <- flowFrame(exprs = sub_exprs, parameters = params, description = keyval) return(list(FSnewFCS = newx, exprsBin = FlowSignalData$exprsBin, Perc_bad_cells = data.frame(badPerc_tot,badPerc_out), diff --git a/R/utils.R b/R/utils.R new file mode 100644 index 0000000..ce1b648 --- /dev/null +++ b/R/utils.R @@ -0,0 +1,12 @@ +check_goodcellsID <- function(x) { + if (length(x) == 0) { + warning("There are not good events", call. = FALSE) + } +} + + +check_badCellIDs <- function(x) { + if (length(x) == 0) { + warning("There are not bad events", call. = FALSE) + } +} diff --git a/inst/shiny/server.R b/inst/shiny/server.R index 6017952..95027ac 100755 --- a/inst/shiny/server.R +++ b/inst/shiny/server.R @@ -1,337 +1,339 @@ -## max data size -options(shiny.maxRequestSize=1024^3) - -shinyServer(function(input, output, session) { - - ##------------------------------------------------------------------------- - - ## load flowset data - set <- reactive({ - if (input$goButton == 0) - return() - isolate({fcsFiles <- input$fcsFiles - if (is.null(fcsFiles)) - return(NULL) - set <- read.FCS(fcsFiles$datapath) - set@description$FILENAME <- fcsFiles$name}) - return(set) - }) - - ## time channel name - timeChannel <- reactive({ - if(is.null(set())) - return(NULL) - x <- set() - time <- findTimeChannel(x) - return(time) - }) - - ## time step - timeStep <- reactive({ - if(is.null(set())) - return(NULL) - word <- which(grepl("TIMESTEP", names(set()@description), - ignore.case = TRUE)) - timestep <- as.numeric(set()@description[[word[1]]]) - if( !length(timestep) ){ - warning("The timestep keyword was not found in the FCS file and it was set to 0.01. Graphs labels indicating time might not be correct", call. =FALSE) - timestep <- 0.01 - } - return(timestep) - }) - - - TimeChCheck <- reactive({ - if (!is.null(timeChannel())) { - if (length(unique(exprs(set())[, timeChannel()])) == 1){ - TimeChCheck <- "single_value" - }else{ - TimeChCheck <- NULL - } - }else{ - TimeChCheck <- "NoTime" - } - return(TimeChCheck) - }) - - - ## order fcs expression according acquisition time - ordFCS <- reactive({ - if(is.null(set())) - return(NULL) - if(is.null(TimeChCheck())){ - ordFCS <- ord_fcs_time(set(), timeChannel()) - }else{ - ordFCS <- set() - } - return(ordFCS) - }) - - - ## signal bin size UI - output$signalBinSize <- renderUI({ - if(is.null(set())){ - optSize <- NULL - maxSize <- Inf - }else{ - maxSize <- nrow(ordFCS()) - optSize <- min(max(1, floor(maxSize/100)), 500) - } - numericInput("signalBinSize", label = h5("Number of events per bin:"), - value = optSize, min = 1, max = maxSize) - }) - - - ## cell quality check - cellCheck <- reactive({ - if(is.null(ordFCS())) - return(NULL) - if(is.null(TimeChCheck())){ - flowRateData <- flow_rate_bin(ordFCS(), second_fraction = input$timeLenth, - timeCh = timeChannel(), timestep = timeStep()) - }else{ - flowRateData <- list() - } - flowSignalData <- flow_signal_bin(ordFCS(), channels = NULL, - binSize = input$signalBinSize, timeCh = timeChannel(), - timestep = timeStep(), TimeChCheck = TimeChCheck() ) - - flowMarginData <- flow_margin_check(ordFCS()) - - res <- list(flowRateData, flowSignalData, flowMarginData) - return(res) - }) - - - ## flow rate time slider UI and check sliders. if they are null, a default value is returned for the QC - sliders <- reactive({ - flowRateData <- cellCheck()[[1]] - flowSignalData <- cellCheck()[[2]] - return(c( - min(flowRateData$frequencies[,3]) - 0.1, - max(flowRateData$frequencies[,3]) + 0.1, - min(flowRateData$frequencies[,4]) - 10, - max(flowRateData$frequencies[,4]) + 10, - 0, - nrow(flowSignalData$exprsBin) + 1) - ) - }) - - output$timeSlider <- renderUI({ - if(is.null(set()) || is.null(cellCheck()) || !is.null(TimeChCheck())) - return(NULL) - sliderInput("timeSlider", strong("Time cut:"), - min = sliders()[1], max = sliders()[2], - value = c(sliders()[1], sliders()[2]), step = 0.1) - }) - timeSlider <- reactive({ - if(is.null(input$timeSlider)){ - return(c(sliders()[1], sliders()[2])) - }else{ - return(c(input$timeSlider[1], input$timeSlider[2])) - } - - }) - - output$rateSlider <- renderUI({ - if(is.null(set()) || is.null(cellCheck()) || !is.null(TimeChCheck())) - return(NULL) - sliderInput("rateSlider", strong("Flow rate cut:"), - min = sliders()[3], max = sliders()[4], - value = c(sliders()[3], sliders()[4]), step = 0.1) - }) - rateSlider <- reactive({ - if(is.null(input$rateSlider)){ - flowRateData <- cellCheck()[[1]] - return(c(sliders()[3], sliders()[4])) - }else{ - return(c(input$rateSlider[1], input$rateSlider[2])) - } - - }) - - output$signalBinSlider <- renderUI({ - if(is.null(set()) || is.null(cellCheck())) - return(NULL) - sliderInput("signalBinSlider", strong("Signal acquisition cut:"), width = "90%", - min = sliders()[5], max = sliders()[6], - value = c(sliders()[5], sliders()[6]), step = 1) - }) - signalSlider <- reactive({ - if(is.null(input$signalBinSlider)){ - return(c(sliders()[5], sliders()[6])) - }else{ - return(c(input$signalBinSlider[1], input$signalBinSlider[2])) - } - }) - - - ## plot - output$flowRatePlot <- renderPlot({ - if(is.null(ordFCS()) || is.null(cellCheck()) || !is.null(TimeChCheck())) - return(NULL) - flowRateData <- cellCheck()[[1]] - frp <- flow_rate_plot(flowRateData, input$rateSlider[1], input$rateSlider[2], - input$timeSlider[1], input$timeSlider[2]) - print(frp) - }) - - output$flowSignalPlot <- renderPlot({ - if(is.null(set()) || is.null(cellCheck())) - return(NULL) - flowSignalData <- cellCheck()[[2]] - fsp <- flow_signal_plot(flowSignalData, input$signalBinSlider[1], input$signalBinSlider[2]) - print(fsp) - }) - - output$flowMarginPlot <- renderPlot({ - if(is.null(set()) || is.null(cellCheck())) - return(NULL) - flowMarginData <- cellCheck()[[3]] - fmp <- flow_margin_plot(flowMarginData, input$signalBinSize) - print(fmp) - }) - - - - ## check results - checkRes <- reactive({ - if(is.null(set()) || is.null(cellCheck())) - return(NULL) - - ordFCS <- ordFCS() - totalCellNum <- nrow(ordFCS) - origin_cellIDs <- 1:totalCellNum - if(is.null(TimeChCheck())){ - FlowRateQC <- flow_rate_check(cellCheck()[[1]], rateSlider()[1], rateSlider()[2], - timeSlider()[1], timeSlider()[2]) - }else{ - FlowRateQC <- origin_cellIDs - } - FlowSignalQC <- flow_signal_check(cellCheck()[[2]], signalSlider()[1], signalSlider()[2]) - - if(input$checkbox[1] == TRUE){ - FlowMarginQC <- cellCheck()[[3]]$goodCellIDs - }else{ - FlowMarginQC <- origin_cellIDs - } - - goodCellIDs <- intersect(FlowRateQC, intersect(FlowSignalQC, FlowMarginQC)) - badCellIDs <- setdiff(origin_cellIDs, goodCellIDs) - - flowRatePerc <- 1 - length(FlowRateQC)/length(origin_cellIDs) - flowSignalPerc <- 1 - length(FlowSignalQC)/length(origin_cellIDs) - flowMarginPerc <- 1 - length(FlowMarginQC)/length(origin_cellIDs) - totalBadPerc <- length(badCellIDs)/length(origin_cellIDs) - - params <- parameters(ordFCS) - keyval <- keyword(ordFCS) - sub_exprs <- exprs(ordFCS) - - good_sub_exprs <- sub_exprs[goodCellIDs, ] - goodfcs <- flowFrame(exprs = good_sub_exprs, parameters = params, description = keyval) - - bad_sub_exprs <- sub_exprs[badCellIDs, ] - badfcs <- flowFrame(exprs = bad_sub_exprs, parameters = params,description = keyval) - - tempQCvector <- cellCheck()[[2]] - QCvector <- tempQCvector$cellBinID[,"binID"] - QCvector[badCellIDs] <- runif(length(badCellIDs), min=10000, max=20000) - QCfcs <- addQC(QCvector, sub_exprs, params, keyval) - - return(list(totalCellNum, totalBadPerc, goodfcs, badfcs, - flowRatePerc, flowSignalPerc, flowMarginPerc, QCfcs)) - }) - - ## summary text - output$summaryText1 <- renderText({ - if(is.null(checkRes())) - return(NULL) - paste0("Total number of events: ", checkRes()[[1]]) - }) - - output$summaryText2 <- renderText({ - if(is.null(checkRes())) - return(NULL) - paste0("Percentage of low-Q events: ", round(checkRes()[[2]]*100,2), "%") - }) - - output$flowRateSummary <- renderText({ - if(is.null(checkRes())) - return(NULL) - if(is.null(TimeChCheck())){ - paste0("Percentage of low-Q events in flow rate check: ", round(checkRes()[[5]]*100,2), "%") - }else if(!is.null(TimeChCheck()) && TimeChCheck() == "NoTime"){ - "It is not possible to recreate the flow rate because the time channel is missing." - }else if(!is.null(TimeChCheck()) && TimeChCheck() == "single_value"){ - "It is not possible to recreate the flow rate because the time channel contains a single value." - } - }) - - output$flowSignalSummary <- renderText({ - if(is.null(checkRes())) - return(NULL) - paste0("Percentage of low-Q events in signal acquisition check: ", round(checkRes()[[6]]*100,2), "%") - }) - - output$flowMarginSummary <- renderText({ - if(is.null(checkRes())) - return(NULL) - paste0("Percentage of low-Q events in dynamic range check: ", round(checkRes()[[7]]*100,2), "%") - }) - - file_base <- reactive({ - file_ext <- description(ordFCS())$FILENAME - file_base <- sub("^([^.]*).*", "\\1", file_ext) - return(file_base) - }) - - ## download processed FCS files - output$downloadGoodFCS <- downloadHandler( - filename = function(){ - paste0(file_base(), "_HighQ.fcs") - }, - - content = function(file){ - data <- checkRes()[[3]] - if(is.null(data)){ - return(NULL) - } - write.FCS(data, file) - #tar(tarfile = file, files = tempdir) - } - ) - - output$downloadBadFCS <- downloadHandler( - filename = function(){ - paste0(file_base(), "_LowQ.fcs") - }, - - content = function(file){ - data <- checkRes()[[4]] - if(is.null(data)){ - return(NULL) - } - write.FCS(data, file) - #tar(tarfile = file, files = tempdir) - } - ) - - ## download processed FCS files - output$downloadQCFCS <- downloadHandler( - filename = function(){ - paste(file_base(), "_QC.fcs", sep='') - }, - - content = function(file){ - data <- checkRes()[[8]] - if(is.null(data)){ - return(NULL) - } - write.FCS(data, file) - #tar(tarfile = file, files = tempdir) - } - ) - -}) - +## max data size +options(shiny.maxRequestSize=1024^3) + +shinyServer(function(input, output, session) { + + ##------------------------------------------------------------------------- + + ## load flowset data + set <- reactive({ + if (input$goButton == 0) + return() + isolate({fcsFiles <- input$fcsFiles + if (is.null(fcsFiles)) + return(NULL) + set <- read.FCS(fcsFiles$datapath) + set@description$FILENAME <- fcsFiles$name}) + return(set) + }) + + ## time channel name + timeChannel <- reactive({ + if(is.null(set())) + return(NULL) + x <- set() + time <- findTimeChannel(x) + return(time) + }) + + ## time step + timeStep <- reactive({ + if(is.null(set())) + return(NULL) + word <- which(grepl("TIMESTEP", names(set()@description), + ignore.case = TRUE)) + timestep <- as.numeric(set()@description[[word[1]]]) + if( !length(timestep) ){ + warning("The timestep keyword was not found in the FCS file and it was set to 0.01. Graphs labels indicating time might not be correct", call. =FALSE) + timestep <- 0.01 + } + return(timestep) + }) + + + TimeChCheck <- reactive({ + if (!is.null(timeChannel())) { + if (length(unique(exprs(set())[, timeChannel()])) == 1){ + TimeChCheck <- "single_value" + }else{ + TimeChCheck <- NULL + } + }else{ + TimeChCheck <- "NoTime" + } + return(TimeChCheck) + }) + + + ## order fcs expression according acquisition time + ordFCS <- reactive({ + if(is.null(set())) + return(NULL) + if(is.null(TimeChCheck())){ + ordFCS <- ord_fcs_time(set(), timeChannel()) + }else{ + ordFCS <- set() + } + return(ordFCS) + }) + + + ## signal bin size UI + output$signalBinSize <- renderUI({ + if(is.null(set())){ + optSize <- NULL + maxSize <- Inf + }else{ + maxSize <- nrow(ordFCS()) + optSize <- min(max(1, floor(maxSize/100)), 500) + } + numericInput("signalBinSize", label = h5("Number of events per bin:"), + value = optSize, min = 1, max = maxSize) + }) + + + ## cell quality check + cellCheck <- reactive({ + if(is.null(ordFCS())) + return(NULL) + if(is.null(TimeChCheck())){ + flowRateData <- flow_rate_bin(ordFCS(), second_fraction = input$timeLenth, + timeCh = timeChannel(), timestep = timeStep()) + }else{ + flowRateData <- list() + } + flowSignalData <- flow_signal_bin(ordFCS(), channels = NULL, + binSize = input$signalBinSize, timeCh = timeChannel(), + timestep = timeStep(), TimeChCheck = TimeChCheck() ) + + flowMarginData <- flow_margin_check(ordFCS()) + + res <- list(flowRateData, flowSignalData, flowMarginData) + return(res) + }) + + + ## flow rate time slider UI and check sliders. if they are null, a default value is returned for the QC + sliders <- reactive({ + flowRateData <- cellCheck()[[1]] + flowSignalData <- cellCheck()[[2]] + return(c( + min(flowRateData$frequencies[,3]) - 0.1, + max(flowRateData$frequencies[,3]) + 0.1, + min(flowRateData$frequencies[,4]) - 10, + max(flowRateData$frequencies[,4]) + 10, + 0, + nrow(flowSignalData$exprsBin) + 1) + ) + }) + + output$timeSlider <- renderUI({ + if(is.null(set()) || is.null(cellCheck()) || !is.null(TimeChCheck())) + return(NULL) + sliderInput("timeSlider", strong("Time cut:"), + min = sliders()[1], max = sliders()[2], + value = c(sliders()[1], sliders()[2]), step = 0.1) + }) + timeSlider <- reactive({ + if(is.null(input$timeSlider)){ + return(c(sliders()[1], sliders()[2])) + }else{ + return(c(input$timeSlider[1], input$timeSlider[2])) + } + + }) + + output$rateSlider <- renderUI({ + if(is.null(set()) || is.null(cellCheck()) || !is.null(TimeChCheck())) + return(NULL) + sliderInput("rateSlider", strong("Flow rate cut:"), + min = sliders()[3], max = sliders()[4], + value = c(sliders()[3], sliders()[4]), step = 0.1) + }) + rateSlider <- reactive({ + if(is.null(input$rateSlider)){ + flowRateData <- cellCheck()[[1]] + return(c(sliders()[3], sliders()[4])) + }else{ + return(c(input$rateSlider[1], input$rateSlider[2])) + } + + }) + + output$signalBinSlider <- renderUI({ + if(is.null(set()) || is.null(cellCheck())) + return(NULL) + sliderInput("signalBinSlider", strong("Signal acquisition cut:"), width = "90%", + min = sliders()[5], max = sliders()[6], + value = c(sliders()[5], sliders()[6]), step = 1) + }) + signalSlider <- reactive({ + if(is.null(input$signalBinSlider)){ + return(c(sliders()[5], sliders()[6])) + }else{ + return(c(input$signalBinSlider[1], input$signalBinSlider[2])) + } + }) + + + ## plot + output$flowRatePlot <- renderPlot({ + if(is.null(ordFCS()) || is.null(cellCheck()) || !is.null(TimeChCheck())) + return(NULL) + flowRateData <- cellCheck()[[1]] + frp <- flow_rate_plot(flowRateData, input$rateSlider[1], input$rateSlider[2], + input$timeSlider[1], input$timeSlider[2]) + print(frp) + }) + + output$flowSignalPlot <- renderPlot({ + if(is.null(set()) || is.null(cellCheck())) + return(NULL) + flowSignalData <- cellCheck()[[2]] + fsp <- flow_signal_plot(flowSignalData, input$signalBinSlider[1], input$signalBinSlider[2]) + print(fsp) + }) + + output$flowMarginPlot <- renderPlot({ + if(is.null(set()) || is.null(cellCheck())) + return(NULL) + flowMarginData <- cellCheck()[[3]] + fmp <- flow_margin_plot(flowMarginData, input$signalBinSize) + print(fmp) + }) + + + + ## check results + checkRes <- reactive({ + if(is.null(set()) || is.null(cellCheck())) + return(NULL) + + ordFCS <- ordFCS() + totalCellNum <- nrow(ordFCS) + origin_cellIDs <- 1:totalCellNum + if(is.null(TimeChCheck())){ + FlowRateQC <- flow_rate_check(cellCheck()[[1]], rateSlider()[1], rateSlider()[2], + timeSlider()[1], timeSlider()[2]) + }else{ + FlowRateQC <- origin_cellIDs + } + FlowSignalQC <- flow_signal_check(cellCheck()[[2]], signalSlider()[1], signalSlider()[2]) + + if(input$checkbox[1] == TRUE){ + FlowMarginQC <- cellCheck()[[3]]$goodCellIDs + }else{ + FlowMarginQC <- origin_cellIDs + } + + goodCellIDs <- intersect(FlowRateQC, intersect(FlowSignalQC, FlowMarginQC)) + badCellIDs <- setdiff(origin_cellIDs, goodCellIDs) + + flowRatePerc <- 1 - length(FlowRateQC)/length(origin_cellIDs) + flowSignalPerc <- 1 - length(FlowSignalQC)/length(origin_cellIDs) + flowMarginPerc <- 1 - length(FlowMarginQC)/length(origin_cellIDs) + totalBadPerc <- length(badCellIDs)/length(origin_cellIDs) + + params <- parameters(ordFCS) + keyval <- keyword(ordFCS) + sub_exprs <- exprs(ordFCS) + + check_goodcellsID(goodCellIDs) + good_sub_exprs <- sub_exprs[goodCellIDs, , drop = FALSE] + goodfcs <- flowFrame(exprs = good_sub_exprs, parameters = params, description = keyval) + + check_badCellIDs(badCellIDs) + bad_sub_exprs <- sub_exprs[badCellIDs, , drop = FALSE] + badfcs <- flowFrame(exprs = bad_sub_exprs, parameters = params,description = keyval) + + tempQCvector <- cellCheck()[[2]] + QCvector <- tempQCvector$cellBinID[,"binID"] + QCvector[badCellIDs] <- runif(length(badCellIDs), min=10000, max=20000) + QCfcs <- addQC(QCvector, sub_exprs, params, keyval) + + return(list(totalCellNum, totalBadPerc, goodfcs, badfcs, + flowRatePerc, flowSignalPerc, flowMarginPerc, QCfcs)) + }) + + ## summary text + output$summaryText1 <- renderText({ + if(is.null(checkRes())) + return(NULL) + paste0("Total number of events: ", checkRes()[[1]]) + }) + + output$summaryText2 <- renderText({ + if(is.null(checkRes())) + return(NULL) + paste0("Percentage of low-Q events: ", round(checkRes()[[2]]*100,2), "%") + }) + + output$flowRateSummary <- renderText({ + if(is.null(checkRes())) + return(NULL) + if(is.null(TimeChCheck())){ + paste0("Percentage of low-Q events in flow rate check: ", round(checkRes()[[5]]*100,2), "%") + }else if(!is.null(TimeChCheck()) && TimeChCheck() == "NoTime"){ + "It is not possible to recreate the flow rate because the time channel is missing." + }else if(!is.null(TimeChCheck()) && TimeChCheck() == "single_value"){ + "It is not possible to recreate the flow rate because the time channel contains a single value." + } + }) + + output$flowSignalSummary <- renderText({ + if(is.null(checkRes())) + return(NULL) + paste0("Percentage of low-Q events in signal acquisition check: ", round(checkRes()[[6]]*100,2), "%") + }) + + output$flowMarginSummary <- renderText({ + if(is.null(checkRes())) + return(NULL) + paste0("Percentage of low-Q events in dynamic range check: ", round(checkRes()[[7]]*100,2), "%") + }) + + file_base <- reactive({ + file_ext <- description(ordFCS())$FILENAME + file_base <- sub("^([^.]*).*", "\\1", file_ext) + return(file_base) + }) + + ## download processed FCS files + output$downloadGoodFCS <- downloadHandler( + filename = function(){ + paste0(file_base(), "_HighQ.fcs") + }, + + content = function(file){ + data <- checkRes()[[3]] + if(is.null(data)){ + return(NULL) + } + write.FCS(data, file) + #tar(tarfile = file, files = tempdir) + } + ) + + output$downloadBadFCS <- downloadHandler( + filename = function(){ + paste0(file_base(), "_LowQ.fcs") + }, + + content = function(file){ + data <- checkRes()[[4]] + if(is.null(data)){ + return(NULL) + } + write.FCS(data, file) + #tar(tarfile = file, files = tempdir) + } + ) + + ## download processed FCS files + output$downloadQCFCS <- downloadHandler( + filename = function(){ + paste(file_base(), "_QC.fcs", sep='') + }, + + content = function(file){ + data <- checkRes()[[8]] + if(is.null(data)){ + return(NULL) + } + write.FCS(data, file) + #tar(tarfile = file, files = tempdir) + } + ) + +}) +