Catch problems with enrichments early

* termIDs must be unique
* extra columns are removed

Author: jdblischak

R/add.R

@@ -360,7 +360,9 @@ addResults <- function(study, results, reset = FALSE) {
 #'   of these elements should be a data frame with enrichment results. Each
 #'   table must contain the following columns: "termID", "description",
 #'   "nominal" (the nominal statistics), and "adjusted" (the statistics after
-#'   adjusting for multiple testing). Any additional columns are ignored.
+#'   adjusting for multiple testing). Any additional columns are ignored and
+#'   removed. The first column should be "termID", and it should only contain
+#'   unique values.
 #' @inherit shared-add
 #'
 #' @seealso \code{\link{getEnrichments}}

R/check.R

@@ -396,8 +396,7 @@ checkEnrichments <- function(enrichments) {
         if ("adjusted" %in% colnames(test) && !is.numeric(test$adjusted)) {
           stop("Column 'adjusted' from enrichments must be numeric")
         }
-        enrichments[[i]][[j]][[k]] <-
-          test[, c("termID", "description", "nominal", "adjusted")]
+        hasUniqueIdColumn(test)
       }
     }
   }

R/sanitize.R

@@ -52,7 +52,19 @@ sanitizeEnrichments <- function(enrichments) {
   for (i in seq_along(enrichments)) {
     for (j in seq_along(enrichments[[i]])) {
       for (k in seq_along(enrichments[[i]][[j]])) {
-        enrichments[[i]][[j]][[k]] <- as.data.frame(enrichments[[i]][[j]][[k]])
+        theTable <- enrichments[[i]][[j]][[k]]
+        theTable <- as.data.frame(theTable)
+        columnsCurrent <- names(theTable)
+        columnsToKeep <- c("termID", "description", "nominal", "adjusted")
+        columnsToRemove <- !columnsCurrent %in% columnsToKeep
+        if (any(columnsToRemove)) {
+          warning(
+            "The following columns were removed from the enrichments table: ",
+            paste(columnsCurrent[columnsToRemove], collapse = ", ")
+          )
+        }
+        theTable <- theTable[, columnsToKeep]
+        enrichments[[i]][[j]][[k]] <- theTable
       }
     }
   }

inst/tinytest/testApp.R

@@ -231,14 +231,20 @@ expect_identical_xl(
 
 # getEnrichmentsTable ----------------------------------------------------------
 
-enrichmentsTable <- getEnrichmentsTable(testStudyName, testModelName, testAnnotationName)
+enrichmentsTable <- getEnrichmentsTable(
+  study = testStudyName,
+  modelID = testModelName,
+  annotationID = testAnnotationName
+)
 
 expect_identical_xl(
   class(enrichmentsTable),
   "data.frame"
 )
 
-expect_true_xl(all(names(getTests(testStudyName, testModelName)) %in% colnames(enrichmentsTable)))
+expect_true_xl(
+  all(names(getTests(testStudyName, testModelName)) %in% colnames(enrichmentsTable))
+)
 
 expect_error_xl(
   getEnrichmentsTable(1),
@@ -250,6 +256,30 @@ expect_equal_xl(
   getEnrichmentsTable(testStudyObj, testModelName, testAnnotationName)
 )
 
+perTestenrichments <- getEnrichments(
+  study = testStudyObj,
+  modelID = testModelName,
+  annotationID = testAnnotationName,
+  testID = testTestName
+)
+
+expect_equal_xl(
+  enrichmentsTable[[testTestName]],
+  perTestenrichments[["nominal"]]
+)
+
+enrichmentsTableAdj <- getEnrichmentsTable(
+  study = testStudyName,
+  modelID = testModelName,
+  annotationID = testAnnotationName,
+  type = "adjusted"
+)
+
+expect_equal_xl(
+  enrichmentsTableAdj[[testTestName]],
+  perTestenrichments[["adjusted"]]
+)
+
 # getEnrichmentsNetwork --------------------------------------------------------
 
 enrichmentsNetwork <- getEnrichmentsNetwork(

inst/tinytest/testCheck.R

@@ -527,6 +527,45 @@ expect_error_xl(
   "Column 'adjusted' from enrichments must be numeric"
 )
 
+# Results for each annotationID/termID/testID must be unique
+enrichmentswithDups <- OmicNavigator:::testEnrichments(
+  nModels = 1,
+  nAnnotations = 1,
+  nTests = 1
+)
+enrichmentswithDups[["model_01"]][["annotation_01"]][["test_01"]] <- rbind(
+  enrichmentswithDups[["model_01"]][["annotation_01"]][["test_01"]],
+  enrichmentswithDups[["model_01"]][["annotation_01"]][["test_01"]][1, ]
+)
+
+expect_error_xl(
+  addEnrichments(study, enrichments = enrichmentswithDups),
+  "The first column, \"termID\", must contain unique values"
+)
+
+# Duplicate columns are removed with warning to user
+enrichmentswithExtraCols <- OmicNavigator:::testEnrichments(
+  nModels = 1,
+  nAnnotations = 1,
+  nTests = 1
+)
+
+enrichmentswithExtraCols[["model_01"]][["annotation_01"]][["test_01"]] <- cbind(
+  enrichmentswithExtraCols[["model_01"]][["annotation_01"]][["test_01"]],
+  extra1 = "remove me",
+  extra2 = "remove me too"
+)
+
+expect_warning_xl(
+  studyExtraCols <- addEnrichments(study, enrichments = enrichmentswithExtraCols),
+  "The following columns were removed from the enrichments table: extra1, extra2"
+)
+
+expect_identical_xl(
+  colnames(studyExtraCols[["enrichments"]][["model_01"]][["annotation_01"]][["test_01"]]),
+  c("termID", "description", "nominal", "adjusted")
+)
+
 # checkMetaFeatures ------------------------------------------------------------
 
 expect_error_xl(