R/AllClasses.R

In jdstorey/edge: Extraction of Differential Gene Expression

# Allows to set qvalue to S4 slot
setOldClass("qvalue")

deSetCheck <- function(object) {
  errors <- character()
  epsilon <- 10e-8
  # Allow easy conversion for an ExpressionSet using function 'as'
  if (is.list(object@null.model) && is.list(object@full.model) &&
        length(object@individual) == 0) {
    return(TRUE)
  }
  # Name mismatch
  f.vars <- all.vars(object@full.model)
  n.vars <- all.vars(object@null.model)
  names <- unique(c(f.vars, n.vars))
  if (sum((f.vars %in% c("grp", "bio.var", "time.basis"))) == 0) {
    if (sum(!(names %in% varLabels(object))) != 0) {
      msg <- paste("naming mismatch between phenoData covariates and models.")
      errors <- c(errors, msg)
      return(errors)
    }
  }
  # Singular matrix
  xx0 <- model.matrix(object@null.model, data=object)
  xx1 <- model.matrix(object@full.model, data=object)
  #  sCheck.null <- min(svd(xx0)$d) < epsilon
  sCheck.full <- min(svd(xx1)$d) < epsilon
  #  if (sCheck.null) {
  #   msg <- paste("null model matrix is near singular.")
  #   errors <- c(errors, msg)
  #  }
  if (sCheck.full) {
    msg <- paste("full model matrix is near singular.")
    errors <- c(errors, msg)
  }
  # Dimensionality test- this may be impossible to make in deSet
  dataDim <- dim(exprs(object))
  if (dataDim[2] != nrow(xx1)) {
    msg <- paste( "dimension mismatch between full model and assayData.")
    errors <- c(errors, msg)
  }
  if (dataDim[2] != nrow(xx0)) {
    msg <- paste( "dimension mismatch between null model and assayData.")
    errors <- c(errors, msg)
  }
  # inidividual input size
  if (length(object@individual) != 0) {
    if (length(object@individual) != ncol(exprs(object))) {
      msg <- paste("individual must be the same length as the number of arrays")
      errors <- c(errors, msg)
    }
  }
  if (length(errors) == 0) {
    TRUE
  } else {
    errors
  }
}

deFitCheck <- function(object) {
  errors <- character()
  # Dimensionality test
  if (!(    (ncol(object@fit.full)==ncol(object@fit.null)
             && (ncol(object@res.full) == ncol(object@res.null))
             && (ncol(object@dH.full) == ncol(object@fit.full))
             && (ncol(object@fit.full) == ncol(object@res.null))))) {
    msg <- paste("column length of fitted matrices, dH.full and residuals",
                 "must be the same.")
    errors <- c(errors, msg)
  }
  if (!((nrow(object@fit.full) == nrow(object@fit.null))
        && (nrow(object@res.full) == nrow(object@res.null))
        && (nrow(object@res.full) == nrow(object@fit.full)))) {
    msg <- paste("row length of fitted matrices and residuals",
                 "must be the same.")
    errors <- c(errors, msg)
  }
  # Correct statistic input check
  if (!(object@stat.type %in% c("lrt", "odp"))) {
    msg <- paste("stat.type must be lrt or odp. Inputted stat.type: ",
                 object@stat.type)
    errors <- c(errors, msg)
  }
  if (length(errors) == 0) {
    TRUE
  } else {
    errors
  }
}

#' The differential expression class (deSet)
#'
#' The \code{deSet} class extends the \code{\link{ExpressionSet}} class.
#' While the \code{ExpressionSet} class contains information about the
#' experiment, the \code{deSet} class contains both experimental information and
#' additional information relevant for differential expression analysis, 
#' explained below in Slots.
#'
#' @slot null.model \code{formula}: contains the adjustment variables in the
#' experiment. The null model is used for comparison when fitting the
#' full model.
#' @slot full.model \code{formula}: contains the adjustment variables and the
#' biological variables of interest.
#' @slot null.matrix \code{matrix}: the null model as a matrix.
#' @slot full.matrix \code{matrix}: the full model as a matrix.
#' @slot individual \code{factor}: contains information on which sample
#' is from which individual in the experiment.
#' @slot qvalueObj \code{S3 object}: containing \code{qvalue} object.
#' See \code{\link{qvalue}} for additional details.
#'
#' @section Methods:
#'  \describe{
#'  \item{\code{as(ExpressionSet, "deSet")}}{Coerce objects of
#'  \code{ExpressionSet} to \code{deSet}.}
#'  \item{\code{lrt(deSet, ...)}}{Performs a generalized likelihood ratio test
#'  using the full and null models.}
#'  \item{\code{odp(deSet, ...)}}{Performs the optimal discovery procedure,
#'  which is a new approach for optimally performing many hypothesis tests in
#'  a high-dimensional study.}
#'  \item{\code{kl_clust(deSet, ...)}}{An implementation of mODP that assigns
#'  genes to modules based off of the Kullback-Leibler distance.}
#'  \item{\code{fit_models(deSet, ...)}}{Fits a linear model to each gene by
#'  method of least squares.}
#'  \item{\code{apply_qvalue(deSet, ...)}}{Applies \code{\link{qvalue}}
#'  function.}
#'  \item{\code{apply_snm(deSet, ...)}}{Applies surpervised normalization of
#'   microarrays (\code{\link{snm}}) on gene expression data.}
#'  \item{\code{apply_sva(deSet, ...)}}{Applies surrogate variable analysis
#'  (\code{\link{sva}}).}
#'  \item{\code{fullMatrix(deSet)}}{Access and set full matrix.}
#'  \item{\code{nullMatrix(deSet)}}{Access and set null matrix.}
#'  \item{\code{fullModel(deSet)}}{Access and set full model.}
#'  \item{\code{nullModel(deSet)}}{Access and set null model.}
#'  \item{\code{individual(deSet)}}{Access and set individual slot.}
#'  \item{\code{qvalueObj(deSet)}}{Access \code{qvalue} object.
#'  See \code{\link{qvalue}}.}
#'  \item{\code{validObject(deSet)}}{Check validity of \code{deSet} object.}
#'  }
#'
#' @note
#' See \code{\link{ExpressionSet}} for additional slot information.
#'
#' @author
#' John Storey, Jeffrey Leek, Andrew Bass
#' @inheritParams ExpressionSet
#' @exportClass deSet
setClass("deSet", slots=c(null.model = "formula",
                          full.model = "formula",
                          null.matrix = "matrix",
                          full.matrix = "matrix",
                          individual = "factor",
                          qvalueObj = "qvalue"),
         prototype=prototype(null.model = formula(NULL),
                             full.model = formula(NULL),
                             null.matrix = matrix(),
                             full.matrix = matrix(),
                             individual = as.factor(NULL),
                             qvalueObj = structure(list(),
                                                    class = "qvalue")),
         validity = deSetCheck,
         contains = c("ExpressionSet"))

#' The differential expression class for the model fits
#'
#' Object returned from \code{\link{fit_models}} containing information
#' regarding the model fits for the experiment.
#'
#' @slot fit.full \code{matrix}: containing fitted values for the full model.
#' @slot fit.null \code{matrix}: containing fitted values for the null model.
#' @slot res.full \code{matrix}: the residuals of the full model.
#' @slot res.null \code{matrix}: the residuals of the null model.
#' @slot dH.full \code{vector}: contains diagonal elements in the projection
#' matrix for the full model.
#' @slot beta.coef \code{matrix}: fitted coefficients for the full model.
#' @slot stat.type \code{string}: information on the statistic of interest.
#' Currently, the only options are ``lrt'' and ``odp''.
#'
#' @section Methods:
#'  \describe{
#'  \item{\code{fitNull(deFit)}}{Access fitted data from null model.}
#'  \item{\code{fitFull(deFit)}}{Access fitted data from full model.}
#'  \item{\code{resNull(deFit)}}{Access residuals from null model fit.}
#'  \item{\code{resFull(deFit)}}{Access residuals from full model fit.}
#'  \item{\code{betaCoef(deFit)}}{Access beta coefficients in linear model.}
#'  \item{\code{sType(deFit)}}{Access statistic type of model fitting utilized
#'  in function.}
#'  }
#'
#' @author
#' John Storey, Jeffrey Leek, Andrew Bass
#'
#' @exportClass deFit
setClass("deFit", slots=c(fit.full = "matrix",
                          fit.null = "matrix",
                          res.full = "matrix",
                          res.null = "matrix",
                          dH.full = "matrix",
                          beta.coef = "matrix",
                          stat.type = "character"),
         validity = deFitCheck)