R/COBRAData.R

In iCOBRA: Comparison and Visualization of Ranking and Assignment Methods

#' Update \code{COBRAData} object to the current version of the class format
#' 
#' Update a \code{COBRAData} object generated by a previous version of the
#' package to the latest version.
#' 
#' @param object A \code{COBRAData} object
#' @param quiet Set to TRUE to disable messages listing the modifications that
#'   are applied to the object
#' 
#' @return An updated \code{COBRAData} object
#' 
#' @export
#' 
#' @author Charlotte Soneson
#' 
#' @examples
#' ## Generate COBRAData object
#' set.seed(123)
#' pval <- data.frame(m1 = runif(100), m2 = runif(100),
#'                    row.names = paste0("F", 1:100))
#' truth <- data.frame(status = round(runif(100)),
#'                     row.names = paste0("F", 1:100))
#' cobradata <- COBRAData(pval = pval, truth = truth)
#' 
#' ## Update object if needed
#' cobradata <- update_cobradata(cobradata)
update_cobradata <- function(object, quiet = FALSE) {
  mod <- FALSE
  if (!(.hasSlot(object, "sval"))) {
    object@sval <- data.frame()
    if (!quiet) message("Adding empty sval slot to object")
    mod <- TRUE
  } 
  if (!mod) {
    if (!quiet) message("Object up to date")
  }
  object
}

#' @rdname COBRAData
#' @export
.COBRAData <- setClass("COBRAData",
                      slots = c(pval = "data.frame", padj = "data.frame",
                                sval = "data.frame", score = "data.frame", 
                                truth = "data.frame"))

#' \code{COBRAData} object and constructor
#'
#' The \code{COBRAData} class contains slots to hold calculated p-values,
#' adjusted p-values and general 'scores' for a set of features, as well as 
#' s-values (see Stephens (2017)). The slots can contain values from multiple
#' methods, and each method can contribute to one or more slots. The class also
#' contains a slot giving the 'truth' (a binary assignment and/or a continuous
#' score) for each feature, as well as additional annotations that can be used
#' to stratify the performance calculations.
#'
#' If adjusted p-values are missing for some methods, for which nominal p-values
#' are available, the adjusted p-values can be calculated using the
#' \code{\link{calculate_adjp}} function.
#'
#' The text files generated by \code{COBRAData_to_text} can be used as input to
#' \code{iCOBRAapp}, when it is called without an input argument.
#'
#' @param pval A data frame with features as rows and methods as columns,
#'   containing nominal p-values. Missing values (\code{NA}s) are allowed. The
#'   row names should be feature names.
#' @param padj A data frame with features as rows and methods as columns,
#'   containing adjusted p-values. Missing values (\code{NA}s) are allowed. The
#'   row names should be feature names.
#' @param score A data frame with features as rows and methods as columns,
#'   containing generic scores. In case of comparison to a binary truth, larger
#'   values of the scores should correspond to 'more significant' features.
#'   Missing values (\code{NA}s) are allowed. The row names should be feature
#'   names.
#' @param sval A data frame with features as rows and methods as columns,
#'   containing s-values (analogous to q-values, but for sign errors, see
#'   Stephens (2017)). Missing values (\code{NA}s) are allowed. The row names
#'   should be feature names.
#' @param truth A data frame with features as rows columns containing feature
#'   annotations such as, e.g., binary and continuous truths and additional
#'   annotations that can be used to stratify the performance calculations. The
#'   row names should be feature names.
#' @param object_to_extend A \code{COBRAData} object to extend with the
#'   provided information.
#'
#' @aliases COBRAData COBRAData-class
#' @return \code{COBRAData} and \code{COBRAData_from_text} return a
#'   \code{COBRAData} object.
#'
#' @docType class
#'
#' @export
#' @rdname COBRAData
#' @author Charlotte Soneson
#' @examples
#' ## Empty COBRAData object:
#' COBRAData()
#'
#' ## COBRAData object from individual data frames
#' set.seed(123)
#' pval <- data.frame(m1 = runif(100), m2 = runif(100),
#'                    row.names = paste0("F", 1:100))
#' truth <- data.frame(status = round(runif(100)),
#'                     row.names = paste0("F", 1:100))
#' cobradata <- COBRAData(pval = pval, truth = truth)
COBRAData <- function(pval = data.frame(), padj = data.frame(),
                      score = data.frame(), sval = data.frame(), 
                      truth = data.frame(), object_to_extend = NULL) {

  if (!(is.null(object_to_extend))) {
    if (!(class(object_to_extend) == "COBRAData")) {
      stop("object_to_extend must be a COBRAData object")
    } else {
      ## Update object if needed
      object_to_extend <- update_cobradata(object_to_extend, quiet = TRUE)
      
      ## Merge provided pval data frame with existing pval data frame
      if (length(object_to_extend@pval) != 0) {
        if (length(pval) != 0) {
          sds <- setdiff(colnames(pval),
                         colnames(object_to_extend@pval))
          if (length(sds) > 0) {
            pval <- pval[, setdiff(colnames(pval),
                                   colnames(object_to_extend@pval)),
                         drop = FALSE]
            object_to_extend@pval$feature_names_tmp <-
              rownames(object_to_extend@pval)
            pval$feature_names_tmp <- rownames(pval)
            pval <- as.data.frame(dplyr::full_join(object_to_extend@pval, pval,
                                                   by = "feature_names_tmp"))
            rownames(pval) <- pval$feature_names_tmp
            pval$feature_names_tmp <- NULL
          } else {
            pval <- object_to_extend@pval
          }
          message(length(setdiff(rownames(pval),
                                 rownames(object_to_extend@pval))),
                  " new features and ",
                  length(sds), " new methods added to pval table")
        } else {
          pval <- object_to_extend@pval
        }
      } else {
        message(nrow(pval), " new features and ",
                ncol(pval), " new methods added to pval table")
      }

      ## Merge provided padj data frame with existing padj data frame
      if (length(object_to_extend@padj) != 0) {
        if (length(padj) != 0) {
          sds <- setdiff(colnames(padj),
                         colnames(object_to_extend@padj))
          if (length(sds) > 0) {
            padj <- padj[, setdiff(colnames(padj),
                                   colnames(object_to_extend@padj)),
                         drop = FALSE]
            object_to_extend@padj$feature_names_tmp <-
              rownames(object_to_extend@padj)
            padj$feature_names_tmp <- rownames(padj)
            padj <- as.data.frame(dplyr::full_join(object_to_extend@padj, padj,
                                                   by = "feature_names_tmp"))
            rownames(padj) <- padj$feature_names_tmp
            padj$feature_names_tmp <- NULL
          } else {
            padj <- object_to_extend@padj
          }
          message(length(setdiff(rownames(padj),
                                 rownames(object_to_extend@padj))),
                  " new features and ",
                  length(sds), " new methods added to padj table")
        } else {
          padj <- object_to_extend@padj
        }
      } else {
        message(nrow(padj), " new features and ",
                ncol(padj), " new methods added to padj table")
      }

      ## Merge provided sval data frame with existing sval data frame
      if (length(object_to_extend@sval) != 0) {
        if (length(sval) != 0) {
          sds <- setdiff(colnames(sval),
                         colnames(object_to_extend@sval))
          if (length(sds) > 0) {
            sval <- sval[, setdiff(colnames(sval),
                                   colnames(object_to_extend@sval)),
                         drop = FALSE]
            object_to_extend@sval$feature_names_tmp <-
              rownames(object_to_extend@sval)
            sval$feature_names_tmp <- rownames(sval)
            sval <- as.data.frame(dplyr::full_join(object_to_extend@sval, sval,
                                                   by = "feature_names_tmp"))
            rownames(sval) <- sval$feature_names_tmp
            sval$feature_names_tmp <- NULL
          } else {
            sval <- object_to_extend@sval
          }
          message(length(setdiff(rownames(sval),
                                 rownames(object_to_extend@sval))),
                  " new features and ",
                  length(sds), " new methods added to sval table")
        } else {
          sval <- object_to_extend@sval
        }
      } else {
        message(nrow(sval), " new features and ",
                ncol(sval), " new methods added to sval table")
      }
      
      ## Merge provided score data frame with existing score data frame
      if (length(object_to_extend@score) != 0) {
        if (length(score) != 0) {
          sds <- setdiff(colnames(score),
                         colnames(object_to_extend@score))
          if (length(sds) > 0) {
            score <- score[, setdiff(colnames(score),
                                     colnames(object_to_extend@score)),
                           drop = FALSE]
            object_to_extend@score$feature_names_tmp <-
              rownames(object_to_extend@score)
            score$feature_names_tmp <- rownames(score)
            score <- as.data.frame(dplyr::full_join(object_to_extend@score,
                                                    score,
                                                    by = "feature_names_tmp"))
            rownames(score) <- score$feature_names_tmp
            score$feature_names_tmp <- NULL
          } else {
            score <- object_to_extend@score
          }
          message(length(setdiff(rownames(score),
                                 rownames(object_to_extend@score))),
                  " new features and ",
                  length(sds), " new methods added to score table")
        } else {
          score <- object_to_extend@score
        }
      } else {
        message(nrow(score), " new features and ",
                ncol(score), " new methods added to score table")
      }

      ## Merge provided truth data frame with existing truth data frame
      if (length(object_to_extend@truth) != 0) {
        if (length(truth) != 0) {
          truth$feature_names_tmp <- rownames(truth)
          object_to_extend@truth$feature_names_tmp <-
            rownames(object_to_extend@truth)
          tm <- as.data.frame(dplyr::full_join(object_to_extend@truth, truth))
          if (any(duplicated(tm$feature_names_tmp)))
            stop("problem merging truth tables, likely due to ",
                 "inconsistent annotations for one or more features")
          truth <- data.frame(tm, stringsAsFactors = FALSE)
          rownames(truth) <- truth$feature_names_tmp
          truth$feature_names_tmp <- NULL
        } else {
          truth <- object_to_extend@truth
        }
        message(length(setdiff(rownames(truth),
                               rownames(object_to_extend@truth))),
                " new features and ",
                length(setdiff(colnames(truth),
                               colnames(object_to_extend@truth))),
                " new annotations added to truth table")
      } else {
        message(nrow(truth), " new features and ",
                ncol(truth), " new annotations added to truth table")
      }
    }
  }
  .COBRAData(pval = pval, padj = padj, score = score, 
             sval = sval, truth = truth)
}

#' @rdname COBRAData
#' @param truth_file A character string giving the path to a file with true
#'   labels and other feature annotations.
#' @param result_files A character vector giving path(s) to file(s) with results
#'   (p-values, adjusted p-values, s-values, scores) for one or more methods.
#'   The column names of these files must be of the form "method:measure", where
#'   measure is one of P, adjP, S or score, depending on what is given in the
#'   column.
#' @param feature_id A character string giving the name of the column in the
#'   truth and result files that encodes the feature identifier.
#' @export
COBRAData_from_text <- function(truth_file, result_files, feature_id) {
  truth <- utils::read.delim(truth_file, header = TRUE, as.is = TRUE)
  rownames(truth) <- truth[, feature_id]
  RF <- lapply(result_files, function(f) {
    f <- utils::read.delim(f, header = TRUE, as.is = TRUE, check.names = FALSE)
    if (any(duplicated(f[, feature_id])))
      stop("Duplicate feature IDs found in result file. Please fix.")
    f
  })
  RF <- Reduce(function(...) merge(..., by = feature_id, all = TRUE), RF)
  pval <- RF[, c(feature_id,
                 grep(":P$", colnames(RF), value = TRUE)), drop = FALSE]
  padj <- RF[, c(feature_id,
                 grep(":adjP$", colnames(RF), value = TRUE)), drop = FALSE]
  sval <- RF[, c(feature_id,
                 grep(":S$", colnames(RF), value = TRUE)), drop = FALSE]
  score <- RF[, c(feature_id,
                  grep(":score$", colnames(RF), value = TRUE)), drop = FALSE]

  if (ncol(pval) == 1) {
    pval <- data.frame()
  } else {
    rownames(pval) <- pval[, feature_id]
    pval <- pval[, grep(":P$", colnames(pval), value = TRUE), drop = FALSE]
    colnames(pval) <- gsub(":P$", "", colnames(pval))
  }

  if (ncol(padj) == 1) {
    padj <- data.frame()
  } else {
    rownames(padj) <- padj[, feature_id]
    padj <- padj[, grep(":adjP$", colnames(padj), value = TRUE), drop = FALSE]
    colnames(padj) <- gsub(":adjP$", "", colnames(padj))
  }

  if (ncol(sval) == 1) {
    sval <- data.frame()
  } else {
    rownames(sval) <- sval[, feature_id]
    sval <- sval[, grep(":S$", colnames(sval), value = TRUE), drop = FALSE]
    colnames(sval) <- gsub(":S$", "", colnames(sval))
  }

  if (ncol(score) == 1) {
    score <- data.frame()
  } else {
    rownames(score) <- score[, feature_id]
    score <- score[, grep(":score$", colnames(score), value = TRUE),
                   drop = FALSE]
    colnames(score) <- gsub(":score$", "", colnames(score))
  }

  COBRAData(pval = pval, padj = padj, sval = sval, score = score, truth = truth)
}

#' @rdname COBRAData
#' @param cobradata A \code{COBRAData} object
#' @export
COBRAData_to_text <- function(cobradata, truth_file, result_files, feature_id) {
  ## Update object if needed
  cobradata <- update_cobradata(cobradata, quiet = TRUE)
  
  ## Write truth to file
  truth <- truth(cobradata)
  truth[, feature_id] <- rownames(truth)
  truth <- truth[, c(feature_id,
                     setdiff(colnames(truth), feature_id)), drop = FALSE]
  utils::write.table(truth, file = truth_file, quote = FALSE,
                     sep = "\t", row.names = FALSE, col.names = TRUE)

  ## Merge results and write to file
  pval <- pval(cobradata)
  if (!(length(pval)) == 0)
    colnames(pval) <- paste0(colnames(pval), ":P")
  pval[, feature_id] <- rownames(pval)

  padj <- padj(cobradata)
  if (!(length(padj)) == 0)
    colnames(padj) <- paste0(colnames(padj), ":adjP")
  padj[, feature_id] <- rownames(padj)

  sval <- sval(cobradata)
  if (!(length(sval)) == 0)
    colnames(sval) <- paste0(colnames(sval), ":S")
  sval[, feature_id] <- rownames(sval)

  score <- score(cobradata)
  if (!(length(score)) == 0)
    colnames(score) <- paste0(colnames(score), ":score")
  score[, feature_id] <- rownames(score)

  results <- Reduce(function(...) merge(..., by = feature_id, all = TRUE),
                    list(pval, padj, sval, score))

  utils::write.table(results, file = result_files, quote = FALSE,
                     sep = "\t", row.names = FALSE, col.names = TRUE)
}

setMethod("show", "COBRAData", function(object) {
  cat("An object of class \"", class(object), "\"\n", sep = "")
  for (sl in slotNames(object)) {
    if (.hasSlot(object, sl)) {
      x <- slot(object, sl)
      cat("@", sl, "\n", sep = "")
      .printHead(x)
      cat("\n")
    }
  }
})

#' Accessor and replacement functions for \code{pval} slot
#'
#' Accessor and replacement functions for the \code{pval} slot in a
#' \code{COBRAData} object.
#'
#' @docType methods
#' @name pval
#' @rdname pval
#' @aliases pval pval,COBRAData-method pval<-,COBRAData,data.frame-method
#' @return The accessor function returns a data frame containing p-values for
#'   each feature and each method.
#' @param x A \code{COBRAData} object.
#' @param ... Additional arguments.
#' @param value A data frame containing p-values for each feature and each
#'   method.
#' @author Charlotte Soneson
#' @export
#' @examples
#' data(cobradata_example)
#' head(pval(cobradata_example))
setMethod("pval", "COBRAData", function(x) x@pval)
#' @name pval
#' @rdname pval
#' @exportMethod "pval<-"
setReplaceMethod("pval", signature(x = "COBRAData", value = "data.frame"),
                 function(x, value) {
                   x <- update_cobradata(x, quiet = FALSE)
                   x@pval <- value
                   if (validObject(x))
                     x
                 })

#' Accessor and replacement functions for \code{padj} slot
#'
#' Accessor and replacement functions for the \code{padj} slot in a
#' \code{COBRAData} object.
#'
#' @docType methods
#' @name padj
#' @rdname padj
#' @aliases padj padj,COBRAData-method padj<-,COBRAData,data.frame-method
#' @return The accessor function returns a data frame containing adjusted
#'   p-values for each feature and each method.
#' @param x A \code{COBRAData} object.
#' @param ... Additional arguments.
#' @param value A data frame containing adjusted p-values for each feature and
#'   each method.
#' @author Charlotte Soneson
#' @export
#' @examples
#' data(cobradata_example)
#' head(padj(cobradata_example))
setMethod("padj", "COBRAData", function(x) x@padj)
#' @name padj
#' @rdname padj
#' @exportMethod "padj<-"
setReplaceMethod("padj", signature(x = "COBRAData", value = "data.frame"),
                 function(x, value) {
                   x <- update_cobradata(x, quiet = FALSE)
                   x@padj <- value
                   if (validObject(x))
                     x
                 })

#' Accessor and replacement functions for \code{sval} slot
#'
#' Accessor and replacement functions for the \code{sval} slot in a
#' \code{COBRAData} object.
#'
#' @docType methods
#' @name sval
#' @rdname sval
#' @aliases sval sval,COBRAData-method sval<-,COBRAData,data.frame-method
#' @return The accessor function returns a data frame containing s-values for 
#'   each feature and each method. 
#' @param x A \code{COBRAData} object.
#' @param ... Additional arguments.
#' @param value A data frame containing s-values for each feature and each 
#'   method. If the object does not have an s-value slot (older versions of the
#'   class did not have this slot), an empty data frame is returned for
#'   simplicity.
#' @author Charlotte Soneson
#' @export
#' @examples
#' data(cobradata_example)
#' head(sval(cobradata_example))
setMethod("sval", "COBRAData", function(x) {
  if (.hasSlot(x, "sval")) x@sval
  else {
    warning(paste0("Object doesn't have a slot sval. Please run ", 
                   "update_cobradata(). For consistency, I will return an " ,
                   "empty data.frame"))
    data.frame()
  }
})
#' @name sval
#' @rdname sval
#' @exportMethod "sval<-"
setReplaceMethod("sval", signature(x = "COBRAData", value = "data.frame"),
                 function(x, value) {
                   x <- update_cobradata(x, quiet = FALSE)
                   x@sval <- value
                   if (validObject(x))
                     x
                 })

#' Accessor and replacement functions for \code{score} slot
#'
#' Accessor and replacement functions for the \code{score} slot in a
#' \code{COBRAData} object.
#'
#' @docType methods
#' @name score
#' @rdname score
#' @aliases score score,COBRAData-method score<-,COBRAData,data.frame-method
#' @return The accessor function regurns a data frame containing scores for each
#'   feature and each method.
#' @param x A \code{COBRAData} object.
#' @param ... Additional arguments.
#' @param value A data frame containing scores for each feature and each method.
#' @author Charlotte Soneson
#' @export
#' @examples
#' data(cobradata_example)
#' head(score(cobradata_example))
setMethod("score", "COBRAData", function(x) x@score)
#' @name score
#' @rdname score
#' @exportMethod "score<-"
setReplaceMethod("score", signature(x = "COBRAData", value = "data.frame"),
                 function(x, value) {
                   x <- update_cobradata(x, quiet = FALSE)
                   x@score <- value
                   if (validObject(x))
                     x
                 })

#' Accessor and replacement functions for \code{truth} slot
#'
#' Accessor and replacement functions for the \code{truth} slot in a
#' \code{COBRAData} object.
#'
#' @docType methods
#' @name truth
#' @rdname truth
#' @aliases truth truth,COBRAData-method truth<-,COBRAData,data.frame-method
#' @return The accessor function returns a data frame containing true
#'   assignments and/or scores for features, together with other feature
#'   annotations to use for stratification of performance calculations.
#' @param x A \code{COBRAData} object.
#' @param ... Additional arguments.
#' @param value A data frame containing true assignments and/or scores for
#'   features, together with other feature annotations to use for stratification
#'   of performance calculations.
#' @author Charlotte Soneson
#' @export
#' @examples
#' data(cobradata_example)
#' head(truth(cobradata_example))
setMethod("truth", "COBRAData", function(x) x@truth)
#' @name truth
#' @rdname truth
#' @exportMethod "truth<-"
setReplaceMethod("truth", signature(x = "COBRAData", value = "data.frame"),
                 function(x, value) {
                   x <- update_cobradata(x, quiet = FALSE)
                   x@truth <- value
                   if (validObject(x))
                     x
                 })

#' Subsetting \code{COBRAData}, \code{COBRAPerformance} or \code{COBRAPlot}
#' objects
#'
#' Functions to subset \code{COBRAData}, \code{COBRAPerformance} or
#' \code{COBRAPlot} objects. \code{COBRAData} objects are subset by features
#' (rows), while \code{COBRAPerformance} and \code{COBRAPlot} objects are subset
#' by methods (columns). Numeric indices are not allowed, since not all slots
#' may be arranged in the same order.
#'
#' @docType methods
#' @name Extract
#' @rdname Extract
#' @aliases \S4method{[}{COBRAData,ANY,ANY} \S4method{[}{COBRAData,ANY,ANY,ANY}
#'   [ [,COBRAData-method
#' @param x A \code{COBRAData}, \code{COBRAPerformance} or \code{COBRAPlot}
#'   object.
#' @param i For \code{COBRAData} objects, a character vector of feature names to
#'   retain.
#' @param j For \code{COBRAPerformance} and \code{COBRAPlot} objects, a
#'   character vector with method names to retain.
#' @param drop not used.
#' @export
setMethod("[", "COBRAData",
          function(x, i, j = "missing", drop = "missing") {
            ## Update object if needed
            x <- update_cobradata(x, quiet = TRUE)
            
            if (length(x@pval) != 0 &&
                length(intersect(rownames(x@pval), i)) == 0)
              stop("none of the provided features found in the pval slot")
            if (length(x@padj) != 0 &&
                length(intersect(rownames(x@padj), i)) == 0)
              stop("none of the provided features found in the padj slot")
            if (length(x@sval) != 0 && 
                length(intersect(rownames(x@sval), i)) == 0)
              stop("none of the provided features found in the sval slot")
            if (length(x@score) != 0 &&
                length(intersect(rownames(x@score), i)) == 0)
              stop("none of the provided features found in the score slot")
            if (length(x@truth) != 0 &&
                length(intersect(rownames(x@truth), i)) == 0)
              stop("none of the provided features found in the truth slot")
            .pval <- x@pval[match(i, rownames(x@pval)), , drop = FALSE]
            .padj <- x@padj[match(i, rownames(x@padj)), , drop = FALSE]
            .sval <- x@sval[match(i, rownames(x@sval)), , drop = FALSE]
            .score <- x@score[match(i, rownames(x@score)), , drop = FALSE]
            .truth <- x@truth[match(i, rownames(x@truth)), , drop = FALSE]
            .COBRAData(pval = .pval, padj = .padj, score = .score,
                      sval = .sval, truth = .truth)
          })

## Validity
setValidity("COBRAData",
            function(object) {
              msg <- NULL
              valid <- TRUE
              if (length(object@pval) != 0 &&
                  !all(sapply(object@pval, is.numeric))) {
                valid <- FALSE
                msg <- c(msg, paste0("pval slot is not numeric"))
              }
              if (length(object@pval) != 0 &&
                  any(object@pval[!is.na(object@pval)] < 0)) {
                valid <- FALSE
                msg <- c(msg, paste0("pval slot contains negative values"))
              }
              if (length(object@pval) != 0 &&
                  any(object@pval[!is.na(object@pval)] > 1)) {
                valid <- FALSE
                msg <- c(msg, paste0("pval slot contains values larger than 1"))
              }
              if (length(object@padj) != 0 &&
                  !all(sapply(object@padj, is.numeric))) {
                valid <- FALSE
                msg <- c(msg, paste0("padj slot is not numeric"))
              }
              if (length(object@padj) != 0 &&
                  any(object@padj[!is.na(object@padj)] < 0)) {
                valid <- FALSE
                msg <- c(msg, paste0("padj slot contains negative values"))
              }
              if (length(object@padj) != 0 &&
                  any(object@padj[!is.na(object@padj)] > 1)) {
                valid <- FALSE
                msg <- c(msg, paste0("padj slot contains values larger than 1"))
              }
              if (.hasSlot(object, "sval") && length(object@sval) != 0 &&
                  !all(sapply(object@sval, is.numeric))) {
                valid <- FALSE
                msg <- c(msg, paste0("sval slot is not numeric"))
              }
              if (length(object@score) != 0 &&
                  !all(sapply(object@score, is.numeric))) {
                valid <- FALSE
                msg <- c(msg, paste0("score slot is not numeric"))
              }
              if (length(object@pval) != 0 && length(object@truth) != 0 &&
                  length(intersect(rownames(object@pval),
                                   rownames(object@truth))) == 0) {
                valid <- FALSE
                msg <- c(msg, paste0("pval slot does not share any features",
                                     " with truth slot"))
              }
              if (length(object@padj) != 0 && length(object@truth) != 0 &&
                  length(intersect(rownames(object@padj),
                                   rownames(object@truth))) == 0) {
                valid <- FALSE
                msg <- c(msg, paste0("padj slot does not share any features",
                                     " with truth slot"))
              }
              if (.hasSlot(object, "sval") && length(object@sval) != 0 && 
                  length(object@truth) != 0 &&
                  length(intersect(rownames(object@sval),
                                   rownames(object@truth))) == 0) {
                valid <- FALSE
                msg <- c(msg, paste0("sval slot does not share any features",
                                     " with truth slot"))
              }
              if (length(object@score) != 0 && length(object@truth) != 0 &&
                  length(intersect(rownames(object@score),
                                   rownames(object@truth))) == 0) {
                valid <- FALSE
                msg <- c(msg, paste0("score slot does not share any features",
                                     " with truth slot"))
              }
              if (valid) TRUE else msg
            })