R/class.R

In Matteo-Ciciani/rScudo: Signature-based Clustering for Diagnostic Purposes

#' @import methods
NULL

#' Class ScudoResults
#'
#' This is an S4 class that represents the output of the functions
#' \code{\link{scudoTrain}} and \code{\link{scudoTest}}.
#'
#' This class provides a structure to represent the results of \code{scudoTrain}
#' and \code{scudoTest}. It contains the distance matrix and the gene signatures
#' generated by the SCUDO analysis. It is possible, although not recommended, to
#' manually create instances of this class (see Examples below).
#'
#' @slot distMatrix a symmetric matrix with
#'   non-negative numeric elements
#' @slot upSignatures a data.frame with the
#'   same colnames as distMatrix, representing the up-regualted features in each
#'   sample
#' @slot downSignatures a data.frame with the
#'   same colnames as distMatrix, representing the down-regualted
#'   features in each sample
#' @slot groupsAnnotation a factor that represents the groups
#'   used for the computeFC and the feature selection
#' @slot consensusUpSignatures a data.frame that contains the
#'   consensus signatures of up-regulated features for each group
#' @slot consensusDownSignatures a data.frame that contains
#'   the consensus signatures of dowm-regulated features for each group
#' @slot selectedFeatures a character vector of selected
#'   features. If the feature selection was not performed, it contains every
#'   feature present in the input of the scudo functions
#' @slot scudoParams a list of the parameters used to run
#'   the function that created the instance of the class
#'
#' @section Methods:
#' \describe{
#' \item{\code{distMatrix}}{\code{signature(object = "ScudoResults")}:
#' a method for obtaining the distance matrix.}
#' \item{\code{upSignatures}}{\code{signature(object = "ScudoResults")}: a
#' method for obtaining the signature of up-regualted features in each
#' sample.}
#' \item{\code{downSignatures}}{\code{signature(object =
#' "ScudoResults")}: a method for obtaining the signature of down-regulated
#' features in each sample.}
#' \item{\code{groupsAnnotation}}{\code{signature(object = "ScudoResults")}:
#' a method for obtaining the groups used for
#' computeFC and feature selection.}
#' \item{\code{consensusUpSignatures}}{\code{signature(object =
#' "ScudoResults")}: a method for obtaining the consensus signatures of
#' up-regualted features in each group.}
#' \item{\code{consensusDownSignatures}}{\code{signature(object =
#' "ScudoResults")}: a method for obtaining the consensus signatures of
#' down-regulated features in each group.}
#' \item{\code{selectedFeatures}}{\code{signature(object = "ScudoResults")}:
#' a method for obtaining the names of the features seleted. If no feature
#' selection was performed, the names of every feature are returned.}
#' \item{\code{scudoParams}}{\code{signature(object = "ScudoResults")}: a method
#' for obtaining the parameters that were used to generate the result.}
#' }
#'
#' @author Matteo Ciciani \email{matteo.ciciani@@gmail.com}, Thomas Cantore
#' \email{cantorethomas@@gmail.com}
#'
#' @examples
#'
#' # manually generate instance of ScudoResults class
#' m <- matrix(1, ncol = 4, nrow = 4)
#' diag(m) <- 0
#' rownames(m) <- colnames(m) <- letters[1:4]
#' SigUp <- data.frame(a = letters[1:5], b = letters[6:10], c = letters[11:15],
#'     d = letters[16:20], stringsAsFactors = FALSE)
#' SigDown <- data.frame(a = letters[1:10], b = letters[11:20],
#'     c = letters[1:10], d = letters[11:20],
#'     stringsAsFactors = FALSE)
#' groups <- as.factor(c("G1", "G1", "G2", "G2"))
#' ConsUp <- data.frame(G1 = letters[11:15], G2 = letters[21:25],
#'     stringsAsFactors = FALSE)
#' ConsDown <- data.frame(G1 = letters[16:25], G2 = letters[1:10],
#'     stringsAsFactors = FALSE)
#' Feats <- letters[1:20]
#' Pars <- list()
#'
#' scudoR <- ScudoResults(distMatrix = m,
#'     upSignatures = SigUp,
#'     downSignatures = SigDown,
#'     groupsAnnotation = groups,
#'     consensusUpSignatures = ConsUp,
#'     consensusDownSignatures = ConsDown,
#'     selectedFeatures = Feats,
#'     scudoParams = Pars)
#'
#' @name ScudoResults-class
#' @rdname ScudoResults-class
#'
#' @export ScudoResults
#' @exportClass ScudoResults
ScudoResults <- setClass("ScudoResults",
    slots = list(
        distMatrix = "matrix",
        upSignatures = "data.frame",
        downSignatures = "data.frame",
        groupsAnnotation = "factor",
        consensusUpSignatures = "data.frame",
        consensusDownSignatures = "data.frame",
        selectedFeatures = "character",
        scudoParams = "list"))

setValidity("ScudoResults", function(object) {
    valid <- TRUE
    msg <- NULL

    # validity of distMatrix ---------------------------------------------------
    if (dim(object@distMatrix)[1] != dim(object@distMatrix)[2]) {
        valid <- FALSE
        msg <- c(msg, "distMatrix is not a square matrix")
    }
    if (any(is.na(object@distMatrix)) & !any(is.nan(object@distMatrix))) {
        valid <- FALSE
        msg <- c(msg, "distMatrix contains NAs")
    }
    if (any(is.nan(object@distMatrix))) {
        valid <- FALSE
        msg <- c(msg, "distMatrix contains NaNs")
    }
    if (!all(is.numeric(object@distMatrix))) {
        valid <- FALSE
        msg <- c(msg, "distMatrix contains non-numeric values")
    }
    if (any(object@distMatrix[!is.na(object@distMatrix)] < 0)) {
        valid <- FALSE
        msg <- c(msg, "distMatrix contains negative numbers")
    }
    if (!isSymmetric(object@distMatrix)) {
        valid <- FALSE
        msg <- c(msg, "distMatrix is not symmetric")
    }
    if (all(is.numeric(object@distMatrix)) &&
            !all(vapply(diag(object@distMatrix), function(x)
                isTRUE(all.equal(x, 0)), logical(1)))) {

        valid <- FALSE
        msg <- c(msg, "distMatrix contains non-zero elements in the diagonal")
    }
    if (is.null(colnames(object@distMatrix)) |
            is.null(rownames(object@distMatrix))) {
        valid <- FALSE
        msg <- c(msg, "colnames or rownames are not present in distMatrix")
    }
    if (!identical(colnames(object@distMatrix), rownames(object@distMatrix))) {
        valid <- FALSE
        msg <- c(msg, "colnames and rownames are different in distMatrix")
    }

    # validity of upSignatures -------------------------------------------------
    if (any(is.na(object@upSignatures))) {
        valid <- FALSE
        msg <- c(msg, "upSignatures contains NAs")
    }
    if (!all(dim(object@upSignatures)[2] == dim(object@distMatrix))) {
        valid <- FALSE
        msg <- c(msg, paste0("number of columns in upSignatures is different",
            " from the dimension of distMatrix"))
    }
    if (!identical(colnames(object@distMatrix),
        colnames(object@upSignatures))) {
        valid <- FALSE
        msg <- c(msg, paste0("colnames in upSignatures are different from",
            " colnames in distMatrix"))
    }
    if (!all(vapply(object@upSignatures, is.character, logical(1)))) {
        valid <- FALSE
        msg <- c(msg, "upSignatures contains non-character values")
    }

    # validity of downSignatures -----------------------------------------------
    if (any(is.na(object@downSignatures))) {
        valid <- FALSE
        msg <- c(msg, "downSignatures contains NAs")
    }
    if (!all(dim(object@downSignatures)[2] == dim(object@distMatrix))) {
        valid <- FALSE
        msg <- c(msg, paste0("number of columns in downSignatures is different",
            " from the dimension of distMatrix"))
    }
    if (!identical(colnames(object@distMatrix),
        colnames(object@downSignatures))) {
        valid <- FALSE
        msg <- c(msg, paste0("colnames in downSignatures are different from",
            " colnames in distMatrix"))
    }
    if (!all(vapply(object@downSignatures, is.character, logical(1)))) {
        valid <- FALSE
        msg <- c(msg, "downSignatures contains non-character values")
    }

    # validity of groupsAnnotation ---------------------------------------------
    if (any(is.na(object@groupsAnnotation))) {
        valid <- FALSE
        msg <- c(msg, "groupsAnnotation contains NAs")
    }
    if (length(object@groupsAnnotation) != dim(object@distMatrix)[1] &&
            length(object@groupsAnnotation) != 0) {

        valid <- FALSE
        msg <- c(msg, paste0("length of groupsAnnotation different from number",
            " of rows in distMatrix"))
    }

    # validity of consensusUpSignatures ----------------------------------------
    if (!isTRUE(all.equal(dim(object@consensusUpSignatures), c(0, 0)))) {
        if (any(is.na(object@consensusUpSignatures))) {
            valid <- FALSE
            msg <- c(msg, "consensusUpSignatures contains NAs")
        }
        if (dim(object@consensusUpSignatures)[1] != dim(object@upSignatures)[1])
        {
            valid <- FALSE
            msg <- c(msg, paste0("number of rows in consensusUpSignatures ",
                "different from number of rows in upSignatures"))
        }
        if (!all(vapply(object@consensusUpSignatures, is.character,
            logical(1)))) {
            valid <- FALSE
            msg <- c(msg, "consensusUpSignatures contains non-character values")
        }
        if (!all(is.element(colnames(object@consensusUpSignatures),
            as.character(levels(object@groupsAnnotation))))) {
            valid <- FALSE
            msg <- c(msg, paste0("colnames of consensusUpSignatures contains ",
                "elements that are not in groupsAnnotation"))
        }
    }

    # validity of consensusDownSignatures --------------------------------------
    if (!isTRUE(all.equal(dim(object@consensusDownSignatures), c(0, 0)))) {
        if (any(is.na(object@consensusDownSignatures))) {
            valid <- FALSE
            msg <- c(msg, "consensusDownSignatures contains NAs")
        }
        if (dim(object@consensusDownSignatures)[1] !=
                dim(object@downSignatures)[1]) {
            valid <- FALSE
            msg <- c(msg, paste0("number of rows in consensusDownSignatures ",
                "different from number of rows in downSignatures"))
        }
        if (!all(vapply(object@consensusDownSignatures, is.character,
            logical(1)))) {
            valid <- FALSE
            msg <- c(msg, paste0("consensusDownSignatures contains ",
                "non-character values"))
        }
        if (!all(is.element(colnames(object@consensusDownSignatures),
            as.character(levels(object@groupsAnnotation))))) {
            valid <- FALSE
            msg <- c(msg, paste0("colnames of consensusDownSignatures ",
                "contains elements that are not in groupsAnnotation"))
        }
    }

    # validity of selectedFeatures ---------------------------------------------
    if (any(is.na(object@selectedFeatures))) {
        valid <- FALSE
        msg <- c(msg, "selectedFeatures contains NAs")
    }

    # validity of scudoParams --------------------------------------------------

    if (valid) TRUE else msg
})