#Modified from https://github.com/nolanlab/cytofCore
#Fixes the parameters in the flowFrame, based on information
#from the corresponding exprs matrix
#if desc is different from NULL, also sets the parmeter description
#(i.e. $PnS)
#Set the range from the data or from a fixed value
update_flowFrame_keywords <- function(flowFrame, exprs.m, desc = NULL, data.range = "data") {
params <- flowCore::parameters(flowFrame)
pdata <- flowCore::pData(params)
if(is.null(desc))
desc <- colnames(exprs.m)
for (i in 1:ncol(flowFrame)) {
s <- paste("$P",i,"S",sep="")
n <- paste("$P",i,"N",sep="")
r <- paste("$P",i,"R",sep="")
b <- paste("$P",i,"B",sep="")
e <- paste("$P",i,"E",sep="")
keyval <- list()
if(!is.na(desc[i]))
keyval[[s]] <- desc[i]
keyval[[n]] <- colnames(exprs.m)[i]
if(data.range == "data")
keyval[[r]] <- ceiling(max(exprs.m[,i], na.rm = TRUE))
else if(is.numeric(data.range))
keyval[[r]] <- data.range
else
stop("Invalid data.range parameter")
keyval[[b]] <- 32
keyval[[e]] <- "0,0"
flowCore::keyword(flowFrame) <- keyval
pdata[i,"minRange"] <- min(exprs.m[,i], na.rm = TRUE)
pdata[i,"maxRange"] <- max(exprs.m[,i], na.rm = TRUE)
}
flowCore::pData(params) <- pdata
flowCore::parameters(flowFrame) <- params
# keyval[["$DATATYPE"]] <- "F"
return(flowFrame)
}
#' Copy FCS keywords from a source to a target flowFrame object
#'
#' @param source.frame The source \code{flowFrame} object
#' @param target.frame The target \code{flowFrame} object
#' @param kw.list The list of keywords to copy. The keywords in this list that
#' are not present in the \code{source.frame} are ignored
#'
#' @return Returns a \code{flowFrame} object
#'
copy_keywords <- function(source.frame, target.frame, kw.list) {
source.keywords <- flowCore::keyword(source.frame)
for(kw in kw.list)
if(!is.null(source.keywords[[kw]]))
flowCore::keyword(target.frame) <- source.keywords[kw]
return(target.frame)
}
#' Convert a matrix to a flowFrame object
#'
#' This function converts a matrix to a \code{flowFrame} object, taking care of properly setting
#' parameters and keywords in the resulting object
#'
#' @param exprs.m The data matrix. Parameter names will be taken from \code{colnames(exprs.m)},
#' but see also the description of the \code{source.flowFrame} parameter
#' @param source.flowFrame If a flowFrame object is supplied, the function will copy matching names and descriptions
#' keywords from it (e.g. $P1S in the \code{source.flowFrame} is copied to $P1S of the new flowFrame etc.). Extra columns present
#' in exprs.m are preserved (i.e. if source.flowFrame doesn't contain $P1S the original version is preserved). Note that this
#' in general only useful in simple cases where both the data matrix and the \code{flowFrame} represent the same
#' data, and have the same column ordering, and you are interested in copy things like parameter names and descriptions.
#' You will probably introduce errors and inconsistencies in the resulting \code{flowFrame} object if that is not the case.
#' A number of extra optional columns (such as \code{$CYT}) will also be copied if present
#'
#' @return Returns a \code{flowFrame} object
#'
#' @export
as_flowFrame <- function(exprs.m, source.frame = NULL) {
flow.frame <- flowCore::flowFrame(exprs.m)
flow.frame <- update_flowFrame_keywords(flow.frame, exprs.m)
if(!is.null(source.frame)) {
num.cols <- ncol(flow.frame)
kw.list <- paste("$P", 1:num.cols, "S", sep = "")
kw.list <- c(kw.list, paste("$P", 1:num.cols, "N", sep = ""))
kw.list <- c(kw.list, "$CYT", "$CYTSN", "$DATE", "$FIL", "$BTIM", "$ETIM")
flow.frame <- copy_keywords(source.frame, flow.frame, kw.list)
marker.names <- as.character(flowCore::parameters(source.frame)$desc)
names(marker.names) <- as.character(flowCore::parameters(source.frame)$name)
# Use the channel name for channels where the description is missing
w <- is.na(marker.names)
marker.names[w] <- names(marker.names)[w]
flowCore::markernames(flow.frame) <- marker.names
}
return(flow.frame)
}
#' Concatente multiple FCS files into a single one
#'
#' This function concatenates multilpe FCS files into a single one. It assumes that the files are all identical
#' panel-wise (i.e. parameters names and descriptions, $PxN and $PxS FCS keywords)
#'
#' @param files.list Character vector of FCS file paths to concatenate
#' @param output.file The path the concatenated file will be written to. If this is \code{NULL} the data
#' is returned as a \code{flowFrame} instead, which you can write with \code{\link{write_flowFrame}}
#'
#' @return If an \code{output.file} is provided, this function returns \code{NULL}, otherwise the data is returned
#' as a \code{flowFrame}
#'
#' @export
concatenate_fcs_files <- function(files.list, output.file = NULL) {
m <- lapply(files.list, flowCore::read.FCS, emptyValue = FALSE)
# Use the first flowFrame as reference
flow.frame <- m[[1]]
m <- lapply(m, function(x) {flowCore::exprs(x)})
m <- do.call(rbind, m)
ret <- as_flowFrame(m, flow.frame)
if(!is.null(output.file))
write_flowFrame(ret, output.file)
else
return(ret)
}
#' Write a flowFrame as FCS file
#'
#' This function writes a flowFrame as an FCS file, taking care of updating the \code{$FILENAME} keyword
#'
#' @param flowFrame the \code{flowFrame} to write
#' @param path destination path
#' @export
write_flowFrame <- function(flowFrame, path) {
f.name <- basename(path)
flowCore::keyword(flowFrame)[["$FIL"]] <- f.name
flowCore::write.FCS(flowFrame, path)
return(invisible(NULL))
}
read_fcs <- function(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)
colnames(ret$m) <- p.names
ret$desc <- as.character(flowCore::parameters(fcs)$desc)
names(ret$desc) <- p.names
ret$keywords <- flowCore::keyword(fcs)
return(ret)
}
write_fcs <- function(fcs, out.name) {
# Drop parameter keywords
keys <- fcs$keywords
keys <- keys[grep("\\$P[0-9]+.", names(keys), invert = T)]
# Exclude keywords that will be written with the new file
excl.keywords <- c("FCSversion", "$BEGINANALYSIS", "$BEGINSTEXT", "$BYTEORD", "$DATATYPE", "$ENDANALYSIS",
"$ENDSTEXT", "$MODE", "$NEXTDATA", "$TOT", "$PAR", "$BEGINDATA", "$ENDDATA")
keys <- keys[!(names(keys) %in% excl.keywords)]
flow.frame <- flowCore::flowFrame(fcs$m)
flow.frame <- update_flowFrame_keywords(flow.frame, fcs$m, fcs$desc, data.range = 262144)
flowCore::keyword(flow.frame) <- keys
marker.names <- fcs$desc
names(marker.names) <- colnames(fcs$m)
flowCore::markernames(flow.frame) <- marker.names
write_flowFrame(flow.frame, out.name)
}
#to.remove = names of parameters to remove
remove_parameters <- function(fcs, to.remove) {
ret <- fcs
ret$m <- ret$m[, !(colnames(ret$m) %in% to.remove)]
ret$desc <- ret$desc[colnames(ret$m)]
return(ret)
}
add_parameter <- function(fcs, v, name, desc) {
ret <- fcs
ret$m <- cbind(ret$m, v)
colnames(ret$m)[ncol(ret$m)] <- name
ret$desc <- c(ret$desc, desc)
names(ret$desc)[length(ret$desc)] <- name
return(ret)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.