#' Convert a flowFrame to data.frame
#'
#' This function converts a \code{flowFrame} object to an R data.frame, taking care of data
#' transformation and compensation.
#'
#' The column names of the resulting data.frame will be derived from the channel descriptions (i.e. $PxS FCS keyword)
#' when possible, and the cannel names otherwise ($PxN)
#'
#' @param f The \code{flowFrame} to convert
#' @param asinh.cofactor Cofactor for \code{asinh} transformation. If this is \code{NULL} no transformation is performed
#' @param compensate Wether to compensate the data using the compensation matrix embedded in the \code{flowFrame} (if any)
#' @param negative.values How to deal with negative values in the data. If this is \code{NULL} negative values
#' are left as is. Otherwise two options are possible:
#' \itemize{
#' \item{\code{truncate}}: Negative values will be truncated (i.e. replaced with 0)
#' \item{\code{shift}}: The data will be shifted so that only \code{quantile.prob} of the values for each channel will
#' be truncated to 0. This option is useful in cases where the range of data significantly extends
#' in the negatives, for instance due to compensation.
#' }
#' @param quantile.prob Only used if \code{negative.value} is set to \code{shift}. The quantile of measurements
#' that are going to be truncated to 0. For instance if this is 0.05, the data will be shifted so that
#' only 5 percent of the values are negative and will be truncated to 0
#' @return Returns a \code{data.frame} corresponding to the data in \code{flowCore::exprs(f)} after compensation
#' and transformation
#' @export
convert_fcs <- function(f, asinh.cofactor = NULL, compensate = T, negative.values = "truncate", quantile.prob = 0.05) {
comp <- grep("SPILL", names(flowCore::description(f)), value = T)
if(compensate && (length(comp) > 0)) {
message("Found compensation matrix, applying...")
comp <- flowCore::description(f)[comp][[1]]
if(is.character(comp)) {
comp <- strsplit(comp, ",")[[1]]
num.channels <- as.numeric(comp[1])
m <- matrix(nrow = num.channels, byrow = T, data = as.numeric(comp[(num.channels + 2):length(comp)]))
colnames(m) <- comp[2:(1 + num.channels)]
comp <- m
}
f <- flowCore::compensate(f, spillover = comp)
}
tab <- flowCore::exprs(f)
m <- as.matrix(tab)
if(!is.null(asinh.cofactor))
m <- asinh(m / asinh.cofactor)
if(!is.null(negative.values)) {
negative.values <- match.arg(negative.values, choices = c("truncate", "shift"))
if(negative.values == "truncate")
m[m < 0] <- 0
else if(negative.values == "shift")
m <- shift_negative_values(m, quantile.prob)
}
tab <- data.frame(m, check.names = F, stringsAsFactors = F)
colnames(tab) <- flowCore::pData(flowCore::parameters(f))$desc
if(any(is.na(colnames(tab)))) {
w <- is.na(colnames(tab))
colnames(tab)[w] <- flowCore::pData(flowCore::parameters(f))$name[w]
}
return(tab)
}
#' Shift negative values in a matrix
#'
#' This function shifts negative values in a data matrix. For each column vector
#' the procedure is as follows:
#' \enumerate{
#' \item A specific quantile is calculated from the vector
#' \item If the quantile is negative then its absolute value is added to the vector
#' \item Values that are still negative are truncated at 0
#' }
#'
#' @param m The data matrix
#' @param quantile.prob The quantile probability to use
#' @return Return the transformed data matrix
#'
shift_negative_values <- function(m, quantile.prob) {
apply(m, 2, function(x) {
qq <- quantile(x, quantile.prob)
ret <- NULL
if(qq < 0)
ret <- x + abs(qq)
else
ret <- x
ret[ret < 0] <- 0
return(ret)
})
}
#' Get the columns that are common to a set of input tabular files
#'
#' @param files.list A vector of input file names. If these are text files, each file should be a tab-separated table,
#' with the first row representing column headers
#' @param file.type The type of the files
#' @return Returns a vector of column names that are present in all the files in \code{files.list}
#' @export
get_common_columns <- function(files.list, file.type = c("txt", "fcs")) {
l <- list()
file.type <- match.arg(file.type)
for(f in files.list) {
temp <- NULL
if(file.type == "txt")
temp <- read.table(f, header = T, sep = "\t", check.names = F, quote = "", nrows = 1)
else if(file.type == "fcs") {
fcs <- flowCore::read.FCS(f, which.lines = 1)
temp <- convert_fcs(fcs, compensate = F)
}
l <- c(l, list(names(temp)))
}
return(Reduce(intersect, l))
}
#' Remove empty FCS files
#'
#' This is an utility function to remove empty FCS files, which can cause problems with downstream analysis
#'
#' @param files.list The list of FCS files to check, files with number of events \code{<= events.threshold}
#' will be removed
#' @param events.threshold A number. FCS files with number of events \code{<=} than this threshold will be removed
#'
#' @export
remove_empty_fcs_files <- function(files.list, events.threshold = 0) {
for(f in files.list) {
fcs <- tryCatch(
flowCore::read.FCS(f),
error = function(e) {
message(sprintf("Error reading %s", f))
return(NULL)
}
)
if(!is.null(fcs) && (dim(fcs)["events"] <= events.threshold)) {
message(sprintf("Removing %s", f))
file.remove(f)
}
}
return(invisible(NULL))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.