Skip to content

Commit

Permalink
Merge pull request #45 from ParkerICI/connor-xt-fix
Browse files Browse the repository at this point in the history
Support for XT
  • Loading branch information
pfgherardini authored Sep 6, 2022
2 parents e05eb53 + bf5083c commit 68b42bb
Show file tree
Hide file tree
Showing 7 changed files with 26 additions and 21 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
@@ -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 <[email protected]> [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
Expand Down
4 changes: 2 additions & 2 deletions R/fcs_io.R
Original file line number Diff line number Diff line change
Expand Up @@ -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]]
Expand Down Expand Up @@ -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)
Expand Down
10 changes: 5 additions & 5 deletions R/normalize_cytof.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Expand Down Expand Up @@ -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))
Expand Down Expand Up @@ -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.
Expand All @@ -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)
Expand All @@ -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()

Expand Down
2 changes: 1 addition & 1 deletion R/paneleditor_helpers.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
11 changes: 7 additions & 4 deletions R/shiny_helpers.R
Original file line number Diff line number Diff line change
Expand Up @@ -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))
Expand All @@ -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()

Expand Down
2 changes: 1 addition & 1 deletion inst/debarcoder_shinyGUI/server.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)
})

Expand Down
16 changes: 9 additions & 7 deletions inst/normalizer_shinyGUI/server.R
Original file line number Diff line number Diff line change
Expand Up @@ -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),
Expand All @@ -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(
Expand Down Expand Up @@ -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)

Expand Down Expand Up @@ -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)
})
Expand Down Expand Up @@ -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)
})
Expand All @@ -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)
Expand Down Expand Up @@ -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)
})
Expand Down Expand Up @@ -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) {
Expand Down

0 comments on commit 68b42bb

Please sign in to comment.