R/get_voltage_settings.R

In benvallin/banban: Analyse biological data

#' Get voltage settings of flow cytometry parameters
#'
#' get_voltage_settings() extracts the voltage settings of parameters in each flowFrame of a flowSet. If requested, it also checks that all voltage settings of a parameter are identical across the flowFrames.
#'
#' @param fs a flowSet to analyse.
#' @param check_identical a logical indicating if the equality of voltage settings should be checked.
#'
#' @return a data frame summarizing the voltage settings of parameters included in the flowSet. If check_identical = TRUE, get_voltage_settings() returns a list composed of the voltage_table and the voltage_check.
#'
#' @export
#'
# @importFrom flowCore fsApply
# @importFrom flowCore keyword
# @importFrom tidyr nest
#'
#' @examples
#'
get_voltage_settings <- function(fs, check_identical = FALSE) {

  if (!requireNamespace("flowCore", quietly = TRUE) | !requireNamespace("flowWorkspace", quietly = TRUE)) {
    warning("The flowCore and or flowWorkspace package(s) must be installed to use this function")
    return(NULL)
  }

  output <- fsApply(x = fs,
                    FUN = function(ff) {
                      param.table <- data.frame(par_number = as.character(seq(as.integer(keyword(ff, c("$PAR"))[[1]]))))
                      param.table$par_name <- vapply(X = param.table$par_number,
                                                     FUN = function(x) { keyword(ff, paste0("$P", x, "N"))[[1]] },
                                                     FUN.VALUE = vector(mode = "character", length = 1))
                      param.table$par_voltage <- vapply(X = param.table$par_number,
                                                        FUN = function(x) { if (is.null(keyword(ff, paste0("$P", x, "V"))[[1]])) {
                                                          NA_real_
                                                        } else {
                                                          as.double(keyword(ff, paste0("$P", x, "V"))[[1]])
                                                        }},
                                                        FUN.VALUE = vector(mode = "double", length = 1))
                      param.table$sample_id <- keyword(ff, "$FIL")[[1]]
                      param.table[!is.na(param.table$par_voltage), c("sample_id", "par_number", "par_name", "par_voltage")]
                    })

  output <- do.call(rbind, c(output, make.row.names = F))

  if (isFALSE(check_identical)) {
    output
  } else {
    voltage_check <- nest(.data = output, data = -par_name)
    voltage_check$identical_voltage <- vapply(X = voltage_check$data,
                                              FUN = function(x) {ifelse(length(unique(x$par_voltage)) == 1L, T, F)},
                                              FUN.VALUE = vector(mode = "logical", length = 1))
    output <- list(voltage_table = output,
                   voltage_check = voltage_check)
  }
}