R/specUnmix.R

In jtheorell/flowSpecs: Tools for processing of high-dimensional cytometry data

#' Spectral unmixing of cytometry files
#'
#'
#' This function performs the central task of spectral unmixing, to convert the
#' raw photon detector input to "biological" proxy-signals.
#' @importFrom BiocGenerics colnames
#' @importFrom flowCore exprs exprs<- parameters parameters<-
#' @importFrom Biobase pData pData<-
#' @param flowObj The fcs object to be filtered. Both flowFrames and flowSets
#' are accepted.
#' @param specMat This is a matrix generated by the secMatCalc function,
#' possibly with edited row names.
#' @return The unmixed data. It will be returned in the format it was imported
#' as.
#'
#' @examples
#' # Load uncompensated data
#' data(fullPanel)
#'
#' # Load the spectral unmixing matrix generated with controls from the same
#' # experiment. These can be generated using the specMatCalc function.
#' data(specMat)
#'
#' # And now, just run the function
#' fullPanelUnmix <- specUnmix(fullPanel, specMat)
#' @export specUnmix
specUnmix <- function(flowObj, specMat) {
    if (inherits(flowObj, "flowSet")) {
        resultObj <- fsApply(flowObj, specUnmixCoFunction,
            specMat = specMat
        )
    } else if (inherits(flowObj, "flowFrame")) {
        resultObj <- specUnmixCoFunction(flowObj, specMat = specMat)
    }
    return(resultObj)
}

specUnmixCoFunction <- function(focusFrame, specMat) {
    fullExprs <- exprs(focusFrame)
    rawData <- fullExprs[, colnames(specMat)]
    # Make the least squares fit based on the raw, uncompensated data.
    ls_corr <- lsfit(x = t(specMat), y = t(rawData), intercept = FALSE)
    # Export the unmixed portion of the least squares result.
    unmixResult <- t(ls_corr$coefficients)
    #Now, insert the columns in their places, if they were there.
    #Otherwise, put the non-compensated ones first, and the compensated
    #ones after.
    if(length(which(row.names(specMat) %in% colnames(fullExprs))) > 1){
        fullExprs[, colnames(specMat)] <- unmixResult
        exprs(focusFrame) <- fullExprs
    } else {
        #In the case that we do spectral unmixing, a few things
        #need to be fiddled with to get the flowFrame right.
        newExprs(focusFrame) <-
            cbind(fullExprs[
                , -which(colnames(fullExprs) %in% colnames(specMat))],
                unmixResult)
        locParamDat <- pData(parameters(focusFrame))
        #Now, we separate the portions that are changed and unchanged.
        locParamDatOld <-
            locParamDat[-which(colnames(fullExprs) %in% colnames(specMat)),]
        locParamDatNew <-
            locParamDat[
                which(colnames(fullExprs) %in% colnames(specMat)),][
                    seq_len(ncol(unmixResult)),]
        locParamDatMerge <- rbind(locParamDatOld, locParamDatNew)
        locParamDatMerge$name <- colnames(exprs(focusFrame))
        locParamDatMerge$desc <- colnames(exprs(focusFrame))
        row.names(locParamDatMerge) <-
            paste0("$P", seq_along(colnames(exprs(focusFrame))))
        pData(parameters(focusFrame)) <- locParamDatMerge

    }

    return(focusFrame)
}