R/checkAndRetrievePlotInput.r

In igordot/copynumber: Segmentation of single- and multi-track copy number data by penalized least squares regression (with hg38 and mm10).

####################################################################
## Author: Gro Nilsen, Knut Liestøl and Ole Christian Lingjærde.
## Maintainer: Gro Nilsen <gronilse@ifi.uio.no>
## License: Artistic 2.0
## Part of the copynumber package
## Reference: Nilsen and Liestøl et al. (2012), BMC Genomics
####################################################################

### Function that checks plot input; and retrieves and returns necessary information

### Input:
### data: data.frame or matrix with observed copy numbers; chrom in col 1, pos in col 2 and copy numbers in remaining columns
### segments: segmentation results on either uniseg or multiseg format
### winsoutliers: outlier statuses from winsorization; same number of columns and rows as data
### type: type of plot; "sample","genome" or "chromosome"
### xaxis: "index" eller "pos"
### pos.unit: "bp","kbp", "mbp"
### sample: the sample numbers to be plotted
### chrom: chromosomes to be plotted  (NB: if type=genome -> chrom=NULL)


### Output:
### data: checked data with numeric chromosomes in column 1
### segments: checked and modified segments according to checkSegments
### sampleID: a character vector with picked out sampleIDs to be plotted
### chrom: a vector with checked and picked out chromosomes to be plotted


## Required by:
### plotAllele
### plotChrom
### plotGenome
### plotSample

## Requires:
### checkChrom
### checkSegments
### checkWinsoutliers
### numericChrom
### pullOutContent

checkAndRetrievePlotInput <- function(data, segments, winsoutliers, type, xaxis, pos.unit, sample, chrom = NULL) {
  if (type == "aspcf") {
    logR <- data$logR
    BAF <- data$BAF
    # Check that at least one of of logR, BAF and segments has been specified
    if (all(sapply(list(logR, BAF, segments), is.null))) {
      stop("Arguments 'logR' and 'BAF', or 'segments', must be specified!", call. = FALSE)
    }
    if ((is.null(logR) && !is.null(BAF)) || (is.null(BAF) && !is.null(logR))) {
      stop("'BAF' must be specified if 'logR' is specified, and vice versa", call. = FALSE)
    }
    if (!is.null(logR)) {
      # logR and BAF could possibly have been winsorized: make sure it is a data frame:
      logR <- pullOutContent(logR, what = "wins.data")
      BAF <- pullOutContent(BAF, what = "wins.data")
      # Check dimensions of logR and BAF:
      stopifnot(ncol(logR) >= 3)
      stopifnot(ncol(logR) == ncol(BAF), nrow(logR) == nrow(BAF))
    }
    data <- logR
  } else {
    # Check that at least of of data and segments has been specified
    if (is.null(data) && is.null(segments)) {
      stop("One of the arguments 'data' and 'segments' must be specified!", call. = FALSE)
    }
  }

  # Check and retrieve data input:
  if (!is.null(data)) {
    # data could possibly come from winsorize, make sure to pull out wins.data data frame
    data <- pullOutContent(data, what = "wins.data")
    stopifnot(ncol(data) >= 3) # something is missing in input data
    # Make sure chromosomes are numeric:
    data[, 1] <- numericChrom(data[, 1])

    # Check winsoutliers
    if (!is.null(winsoutliers)) {
      winsoutliers <- checkWinsoutliers(winsoutliers, data)
    }
  } # endif

  # Check, modify and retrieve segments input:
  if (!is.null(segments)) {
    segments <- checkSegments(segments, type)
  } # endif


  # Check sampleIDs to be plotted (only plot sampleIDs found in both data and segments)
  sampleID <- checkSampleID(data, segments, sample)

  # Check and if necessary modify chrom to be plotted:
  if (type != "genome") {
    chrom <- checkChrom(data, segments, chrom)
  }
  # Check xaxis input:
  if (!xaxis %in% c("pos", "index")) {
    stop("xaxis must be one of 'pos' and 'index'", call. = FALSE)
  }


  # Check that pos.unit has been specified if xaxis="pos"
  if (xaxis == "pos") {
    # Check pos.unit input:
    if (!pos.unit %in% c("bp", "kbp", "mbp")) {
      stop("pos.unit must be one of bp, kbp and mbp", call. = FALSE)
    }
  }

  if (type == "aspcf") {
    # Return data as list
    data <- list(logR = data, BAF = BAF)
  }

  return(list(data = data, segments = segments, sampleID = sampleID, chrom = chrom, winsoutliers = winsoutliers))
}