diff --git a/DESCRIPTION b/DESCRIPTION index 125bca4..8c091f0 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: premessa Type: Package Title: R package for pre-processing of flow and mass cytometry data -Version: 0.3.2 +Version: 0.3.4 Author: "Pier Federico Gherardini [aut, cre]" Description: This package includes panel editing/renaming for FCS files, bead-based normalization and debarcoding. Imports: shiny (>= 0.14), flowCore, reshape, ggplot2, hexbin, gridExtra, rhandsontable, jsonlite, data.table, shinyjqui diff --git a/R/fcs_io.R b/R/fcs_io.R index b8ee97b..bcdb8c2 100644 --- a/R/fcs_io.R +++ b/R/fcs_io.R @@ -127,7 +127,7 @@ as_flowFrame <- function(exprs.m, source.frame = NULL) { #' #' @export concatenate_fcs_files <- function(files.list, output.file = NULL) { - m <- lapply(files.list, flowCore::read.FCS) + m <- lapply(files.list, flowCore::read.FCS, emptyValue = FALSE) # Use the first flowFrame as reference flow.frame <- m[[1]] @@ -159,7 +159,7 @@ write_flowFrame <- function(flowFrame, path) { } read_fcs <- function(f.name) { - fcs <- flowCore::read.FCS(f.name) + fcs <- flowCore::read.FCS(f.name, emptyValue = FALSE) ret <- list() ret$m <- flowCore::exprs(fcs) p.names <- as.character(flowCore::parameters(fcs)$name) diff --git a/R/normalize_cytof.R b/R/normalize_cytof.R index a151a46..82f4ff5 100644 --- a/R/normalize_cytof.R +++ b/R/normalize_cytof.R @@ -106,7 +106,7 @@ calculate_baseline <- function(wd, beads.type, files.type = c("data", "beads"), ) ret <- lapply(files.list, function(f.name) { - fcs <- flowCore::read.FCS(file.path(wd, f.name)) + fcs <- flowCore::read.FCS(file.path(wd, f.name), emptyValue = FALSE) beads.cols.names <- find_beads_channels_names(fcs, beads.type) dna.col <- find_dna_channel(fcs) @@ -193,7 +193,7 @@ remove_beads_from_fcs <- function(fcs, dist.threshold) { #' #' @export remove_beads_from_file <- function(input.fname, dist.threshold, out.dir) { - fcs <- flowCore::read.FCS(input.fname) + fcs <- flowCore::read.FCS(input.fname, emptyValue = FALSE) beads.dir <- file.path(out.dir, "removed_events") dir.create(beads.dir, recursive = T) base.fname <- tools::file_path_sans_ext(basename(input.fname)) @@ -230,7 +230,7 @@ remove_beads_from_file <- function(input.fname, dist.threshold, out.dir) { #' \code{list(file_name = list(channel_name = list(x = [xMin, xMax], y = [yMin, yMax]), ...), ...)}. #' Note that only files in \code{names(beads.gates)} will be processed. Also note that the data structure #' may contain gates for extra channels, but which channels will be used depends on the \code{beads.type} parameter -#' @param beads.type Type of beads. Must be on of \code{"Fluidigm"}, \code{"Beta"} +#' @param beads.type Type of beads. Must be one of \code{"Fluidigm"}, \code{"Beta"}, \code{"XT"} #' @param baseline If \code{NULL} the median beads intensities of the current files will be used as baseline #' for normalization. Alternatively this can be a character string with the path of a directory containing #' FCS files of beads events, whose median intensities will be used as baseline. @@ -255,7 +255,7 @@ normalize_folder <- function(wd, output.dir.name, beads.gates, beads.type, basel cat(jsonlite::toJSON(beads.gates, pretty = T), file = file.path(out.dir.path, "beads_gates.json")) ll <- lapply(names(beads.gates), function(f.name) { - fcs <- flowCore::read.FCS(file.path(wd, f.name)) + fcs <- flowCore::read.FCS(file.path(wd, f.name), emptyValue = FALSE) beads.cols <- find_bead_channels(fcs, beads.type) beads.cols.names <- get_parameter_name(fcs, beads.cols) dna.col <- find_dna_channel(fcs) @@ -267,7 +267,7 @@ normalize_folder <- function(wd, output.dir.name, beads.gates, beads.type, basel norm.res <- correct_data_channels(m, beads.data, baseline.data, beads.cols.names) # Do some cleanup to save memory - fcs <- flowCore::read.FCS(file.path(wd, f.name), which.lines = 1) # We only need the keywords + fcs <- flowCore::read.FCS(file.path(wd, f.name), emptyValue = FALSE, which.lines = 1) # We only need the keywords m <- NULL gc() diff --git a/R/paneleditor_helpers.R b/R/paneleditor_helpers.R index 78be396..4f7f7a2 100644 --- a/R/paneleditor_helpers.R +++ b/R/paneleditor_helpers.R @@ -16,7 +16,7 @@ #' @export read_parameters <- function(files.list) { ret <- lapply(files.list, function(f) { - fcs <- flowCore::read.FCS(f, which.lines = 1) + fcs <- flowCore::read.FCS(f, emptyValue = FALSE, which.lines = 1) df <- data.frame(name = as.character(flowCore::parameters(fcs)$name), desc = as.character(flowCore::parameters(fcs)$desc), check.names = F, stringsAsFactors = F) diff --git a/R/shiny_helpers.R b/R/shiny_helpers.R index 8734986..cdc7266 100644 --- a/R/shiny_helpers.R +++ b/R/shiny_helpers.R @@ -2,11 +2,12 @@ find_dna_channel <- function(fcs) { return(grep("Ir193", flowCore::parameters(fcs)$name)) } -find_bead_channels <- function(fcs, bead.type = c("Fluidigm", "Beta")) { +find_bead_channels <- function(fcs, bead.type = c("Fluidigm", "Beta","XT")) { bead.type <- match.arg(bead.type) grep.string <- switch(bead.type, Fluidigm = "Ce140|Eu151|Eu153|Ho165|Lu175", - Beta = "La139|Pr141|Tb159|Tm169|Lu175" + Beta = "La139|Pr141|Tb159|Tm169|Lu175", + XT = "Y89|In115|Ce140|Tb159|Lu175|Bi209" ) return(grep(grep.string, flowCore::parameters(fcs)$name)) @@ -16,13 +17,13 @@ get_parameter_name <- function(fcs, i) { return(as.vector(unname(flowCore::parameters(fcs)$name[i]))) } -find_beads_channels_names <- function(fcs, bead.type = c("Fluidigm", "Beta")) { +find_beads_channels_names <- function(fcs, bead.type = c("Fluidigm", "Beta","XT")) { beads.cols <- find_bead_channels(fcs, bead.type) return(get_parameter_name(fcs, beads.cols)) } get_beads_type_from_description <- function(s) { - ret <- unlist(regmatches(s, regexec("Fluidigm|Beta", s))) + ret <- unlist(regmatches(s, regexec("Fluidigm|Beta|XT", s))) return(ret) } @@ -30,7 +31,9 @@ get_beads_type_from_description <- function(s) { get_initial_beads_gates <- function(fcs) { beta.beads <- find_bead_channels(fcs, "Beta") fluidigm.beads <- find_bead_channels(fcs, "Fluidigm") + xt.beads <- find_bead_channels(fcs,'XT') beads.cols <- union(beta.beads, fluidigm.beads) + beads.cols <- union(beads.cols,xt.beads) ret <- list() diff --git a/inst/debarcoder_shinyGUI/server.R b/inst/debarcoder_shinyGUI/server.R index 671bad5..f0f4f3d 100644 --- a/inst/debarcoder_shinyGUI/server.R +++ b/inst/debarcoder_shinyGUI/server.R @@ -68,7 +68,7 @@ shinyServer(function(input, output, session) { debarcoderui_get_fcs <- reactive({ ret <- NULL if(!is.null(debarcoderui.reactive.values$fcs.fname) && debarcoderui.reactive.values$fcs.fname != "") - ret <- flowCore::read.FCS(debarcoderui.reactive.values$fcs.fname) + ret <- flowCore::read.FCS(debarcoderui.reactive.values$fcs.fname, emptyValue = FALSE) return(ret) }) diff --git a/inst/normalizer_shinyGUI/server.R b/inst/normalizer_shinyGUI/server.R index c883f95..b295da2 100644 --- a/inst/normalizer_shinyGUI/server.R +++ b/inst/normalizer_shinyGUI/server.R @@ -28,7 +28,7 @@ render_beadremoval_ui <- function(working.directory, ...) {renderUI({ fluidRow( column(12, selectizeInput("beadremovalui_beads_type", "Select beads type", multiple = FALSE, width = "100%", - choices = c("Fluidigm Beads (140,151,153,165,175)", "Beta Beads (139,141,159,169,175)")), + choices = c("Fluidigm Beads (140,151,153,165,175)", "Beta Beads (139,141,159,169,175)","XT Beads (89,115,140,159,175,209)")), selectizeInput("beadremovalui_selected_fcs", "Select FCS file", choices = c("", list.files(file.path(working.directory, "normed"), pattern = "*.fcs$", ignore.case = T)), multiple = FALSE, width = "100%"), numericInput("beadremovalui_cutoff", "Cutoff for bead removal", value = 0, min = 0, max = 20), @@ -48,7 +48,7 @@ render_normalizer_ui <- function(working.directory, ...){renderUI({ fluidRow( column(12, selectizeInput("normalizerui_beads_type", "Select beads type", multiple = FALSE, width = "100%", - choices = c("Fluidigm Beads (140,151,153,165,175)", "Beta Beads (139,141,159,169,175)")), + choices = c("Fluidigm Beads (140,151,153,165,175)", "Beta Beads (139,141,159,169,175)","XT Beads (89,115,140,159,175,209)")), selectizeInput("normalizerui_selected_fcs", "Select FCS file", choices = c("", list.files(working.directory, pattern = "*.fcs$", ignore.case = T)), multiple = FALSE, width = "100%"), fluidRow( @@ -101,7 +101,7 @@ shinyServer(function(input, output, session) { output$concatenateUI <- render_concatenate_ui(working.directory) output$normalizerUI <- render_normalizer_ui(working.directory, input, output, session) - output$normalizerUI_plot_outputs <- generate_normalizerui_plot_outputs(5) + output$beadremovalUI <- render_beadremoval_ui(working.directory, input, output, session) output$beadremovalUI_plot_outputs <- generate_beadremovalui_plot_outputs(beadremovalui.plots.number) @@ -134,7 +134,7 @@ shinyServer(function(input, output, session) { ret <- NULL if(!is.null(input$beadremovalui_selected_fcs) && input$beadremovalui_selected_fcs != "") - ret <- flowCore::read.FCS(file.path(normed.dir, input$beadremovalui_selected_fcs)) + ret <- flowCore::read.FCS(file.path(normed.dir, input$beadremovalui_selected_fcs), emptyValue = FALSE) return(ret) }) @@ -165,7 +165,7 @@ shinyServer(function(input, output, session) { "Bead removal started, please wait..." )) files.list <- lapply(files.list, function(f.name) { - fcs <- flowCore::read.FCS(file.path(normed.dir, f.name)) + fcs <- flowCore::read.FCS(file.path(normed.dir, f.name), emptyValue = FALSE) premessa::remove_beads_from_file(file.path(normed.dir, f.name), input$beadremovalui_cutoff, beads.removed.dir) return(f.name) }) @@ -181,7 +181,7 @@ shinyServer(function(input, output, session) { observe({ if(!is.null(input$beadremovalui_selected_fcs) && input$beadremovalui_selected_fcs != "") { - fcs <- flowCore::read.FCS(file.path(normed.dir, input$beadremovalui_selected_fcs)) + fcs <- flowCore::read.FCS(file.path(normed.dir, input$beadremovalui_selected_fcs), emptyValue = FALSE) beads.type <- premessa:::get_beads_type_from_description(input$beadremovalui_beads_type) beads.cols.names <- premessa:::find_beads_channels_names(fcs, beads.type) @@ -240,7 +240,7 @@ shinyServer(function(input, output, session) { ret <- NULL if(!is.null(input$normalizerui_selected_fcs) && input$normalizerui_selected_fcs != "") - ret <- flowCore::read.FCS(file.path(working.directory, input$normalizerui_selected_fcs)) + ret <- flowCore::read.FCS(file.path(working.directory, input$normalizerui_selected_fcs), emptyValue = FALSE) return(ret) }) @@ -275,6 +275,8 @@ shinyServer(function(input, output, session) { if(!is.null(sel.beads)) colors[sel.beads] <- "red" + output$normalizerUI_plot_outputs <- generate_normalizerui_plot_outputs(length(beads.cols)) + #Needs to be in lapply to work #see https://github.com/rstudio/shiny/issues/532 lapply(1:length(beads.cols), function(i) {