Merge multiple FCS files into a single fcs file

merge_fcs.R

# premessa::concatenate_fcs_files
# modified based on the following code:
# https://rdrr.io/github/ParkerICI/premessa/src/R/fcs_io.R

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

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

concatenate_fcs_files <- function(files.list, output.file = NULL) {
    m <- lapply(
        files.list,
        function(x) flowCore::read.FCS(filename = x, truncate_max_range = 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_flowFrame <- function(flowFrame, path) {
    f.name <- basename(path)
    flowCore::keyword(flowFrame)[["$FIL"]] <- f.name
    flowCore::write.FCS(flowFrame, path)
    return(invisible(NULL))
}