Merge pull request #45 from ParkerICI/connor-xt-fix

Support for XT

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 <federico.gherardini@gmail.com> [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

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)

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()
 

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)

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,21 +17,23 @@ 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)
 }
 
 
 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()
 

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)
     })
 

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) {