R/output.R

In davnovak/qctoy: Synthetic QC data generator

#' Make flowFrame from synthetic signal data
#'
#' Creates a flowFrame with given signal in named channels.
#'
#' @param ... signals, as generated by function \code{sim.baseline}, possibly perturbed by other functions from \code{qctoy}.
#' @param channel_names vector of channel names, of length equal to number of signal data objects.
#' @param marker_names vector of marker names, of length equal to number of signal data objects. If \code{NULL}, set to \code{channel_names}.
#' @param guid GUID descriptor of \code{flowFrame}.
#'
#' @return \code{flowFrame} object.
#'
#' @seealso See functions beginning with \code{sim.sample.} for examples of usage.
#'
#' @export
sim.make_flowFrame <- function(...,                         # fluorescence signal data per channel
                               channel_names,
                               marker_names = NULL,
                               guid = "qc_toy") {
  signals <- list(...)
  if (length(channel_names) != length(signals)) {
    stop("Vector 'channel_names' must have length equal to number of channels")
  }
  if (is.null(marker_names)) {
    marker_names <- channel_names
  } else if (length(marker_names) != length(signals)) {
    stop("Vector 'channel_names' must be null or have length equal to number of channels")
  }
  signals <- lapply(signals, function(s) {
    if (class(s) == "list") {
      return(s$df)
    } else {
      return(s)
    }
  })
  times <- lapply(signals, function(s) s$time)
  if (!all(sapply(times[-1], FUN = identical, times[[1]]))) {
    stop("Time parameter different across channels")
  }
  tt <- times[[1]]
  vals <- lapply(signals, function(s) s$value)
  rm(times)
  rm(signals)

  efcs <- do.call(cbind, list(do.call(cbind, vals), tt)); colnames(efcs) <- c(channel_names, "Time")

  desc <- list(GUID = guid,
               TOT = nrow(efcs))

  channel_names.idcs <- paste0("P", 1:(ncol(efcs) - 1), "N")
  marker_names.idcs <- paste0("P", 1:(ncol(efcs) - 1), "S")
  for (i in 1:length(channel_names.idcs)) {
    desc[channel_names.idcs[i]] <- channel_names[i]
    desc[marker_names.idcs[i]] <- marker_names[i]
  }

  ff <- flowFrame(exprs = efcs, description = desc)
}