Multitest

OmicNavigator.Rproj

@@ -16,6 +16,7 @@ AutoAppendNewline: Yes
 StripTrailingWhitespace: Yes
 
 BuildType: Package
+PackageUseDevtools: Yes
 PackageInstallArgs: --no-multiarch --with-keep.source
 PackageCheckArgs: --no-manual
 PackageRoxygenize: rd,collate,namespace

R/add.R

@@ -362,9 +362,10 @@ addMetaFeatures <- function(study, metaFeatures, reset = FALSE) {
 #' the user.
 #'
 #' Custom plotting functions are passed a list of data frames: \code{assays}
-#' with the measurements, \code{features} with the feature data, and
-#' \code{samples} with the sample data. Both \code{assays} and \code{features}
-#' are subset to only include data for the specified featureID(s) (and
+#' with the measurements, \code{features} with the feature data,
+#' \code{samples} with the sample data, and \code{results} with test results
+#' data. Note that \code{assays}, \code{features} and \code{results}
+#' only include data for the specified featureID(s) (and
 #' re-ordered so their rows match). Thus your custom plotting function must have
 #' at least one argument. It can have additional arguments if you wish, but
 #' these must be provided with default values, because \code{plotStudy} only
@@ -385,7 +386,10 @@ addMetaFeatures <- function(study, metaFeatures, reset = FALSE) {
 #'   session. The third list provides metadata to describe each plot. The only
 #'   required metadata element is \code{displayName}, which controls how the
 #'   plot will be named in the app. You are encouraged to also specify the
-#'   \code{plotType}, e.g. \code{"singleFeature"}, \code{"multiFeature"}. If you
+#'   \code{plotType}, e.g. \code{"singleFeature"}, \code{"multiFeature"},
+#'   \code{"multiTest"}. Note that PlotType accepts a vector of entries,
+#'   whenever applicable, e.g., plotType = c(\code{"multiFeature"},
+#'   \code{"multiTest"}). If you
 #'   do not specify the \code{plotType}, the plot will be assumed to be
 #'   \code{"singleFeature"}. Optionally, if the plotting function requires
 #'   external packages, these can be defined in the element \code{packages}. To

R/plots.R

@@ -33,21 +33,48 @@ plotStudy <- function(study, modelID, featureID, plotID, testID = NULL, librarie
     f <- getPlotFunction(plotID, study = study)
   }
 
-  # Throw error is mismatch between number of features and plot type
+  # Throw error is mismatch between number of features / tests and plot type
   nFeatures <- length(featureID)
-  plotType <- p[["plotType"]]
+  nTests    <- length(testID)
+  plotType  <- p[["plotType"]]
+
   if (isEmpty(plotType)) plotType <- "singleFeature"
-  if (plotType == "singleFeature" && nFeatures != 1) {
-    stop(
-      "Plot type \"singleFeature\" requires 1 featureID\n",
-      sprintf("Received %d featureID(s)", nFeatures)
-    )
-  }
-  if (plotType == "multiFeature" && nFeatures < 2) {
-    stop(
-      "Plot type \"multiFeature\" requires at least 2 featureIDs\n",
-      sprintf("Received %d featureID(s)", nFeatures)
-    )
+  if (length(plotType) == 1 && plotType == "multiTest") plotType <- c("singleFeature", "multiTest")
+  nPlotType <- length(plotType)
+
+  for (ind in 1:nPlotType) {
+    if (plotType[ind] == "singleFeature") {
+      if (nFeatures != 1) {
+        stop(
+          "Plot type \"singleFeature\" requires 1 featureID\n",
+          sprintf("Received %d featureID(s)", nFeatures)
+        )
+      } else if (nTests > 1 && !any(which(plotType == "multiTest"))) {
+        stop(
+          "Plot type \"singleFeature\" requires 1 testID or be associated with multiTest, e.g. plot type = c(\"singleFeature\", \"multiTest\")\n",
+          sprintf("Received %d testID(s)", nTests)
+        )
+      }
+    }
+    if (plotType[ind] == "multiFeature") {
+      if (nFeatures < 2) {
+        stop(
+          "Plot type \"multiFeature\" requires at least 2 featureIDs\n",
+          sprintf("Received %d featureID(s)", nFeatures)
+        )
+      } else if (nTests > 1 && !any(which(plotType == "multiTest"))) {
+        stop(
+          "Plot type \"multiFeature\" requires 1 testID or be associated with multiTest, e.g. plot type = c(\"multiFeature\", \"multiTest\")\n",
+          sprintf("Received %d testID(s)", nTests)
+        )
+      }
+    }
+    if (plotType[ind] == "multiTest" && nTests < 2) {
+      stop(
+        "Plot type \"multiTest\" requires at least 2 testIDs\n",
+        sprintf("Received %d testID(s)", nTests)
+      )
+    }
   }
 
   plottingData <- getPlottingData(study, modelID, featureID, testID = testID,
@@ -140,7 +167,8 @@ resetSearch <- function(pkgNamespaces) {
 #' \item{\code{results}}{A data frame that contains the test results,
 #' filtered to only include the row(s) corresponding to the input featureID(s).
 #' If multiple featureIDs are requested, the rows are reordered to match the
-#' order of this input. The column order is unchanged.}
+#' order of this input. The column order is unchanged. If multiple testIDs are
+#' provided, they are stored in a list object.}
 #'
 #' @seealso \code{\link{addPlots}}, \code{\link{plotStudy}}
 #'
@@ -194,25 +222,30 @@ getPlottingData <- function(study, modelID, featureID, testID = NULL, libraries
   }
 
   if (!isEmpty(testID)) {
-    results <- getResults(study, modelID = modelID, testID = testID, quiet = TRUE,
-                          libraries = libraries)
-    if (isEmpty(results)) {
-      stop(sprintf("The test result (testID) \"%s\" is not available for modelID \"%s\" ", testID, modelID))
-    }
-    featureIDAvailable_results <- featureID %in% results[,1]
-    if (any(!featureIDAvailable_results)) {
-      stop(sprintf("The feature \"%s\" is not available for testID \"%s\"",
-                   featureID[!featureIDAvailable][1], testID))
+    resultsPlotting <- vector("list", length(testID))
+    for (i in seq_along(testID)) {
+      results <- getResults(study, modelID = modelID, testID = testID[i], quiet = TRUE,
+                            libraries = libraries)
+      if (isEmpty(results)) {
+        stop(sprintf("The test result (testID) \"%s\" is not available for modelID \"%s\" ", testID[i], modelID))
+      }
+      featureIDAvailable_results <- featureID %in% results[,1]
+      if (any(!featureIDAvailable_results)) {
+        stop(sprintf("The feature \"%s\" is not available for testID \"%s\"",
+                     featureID[!featureIDAvailable][1], testID[i]))
+      }
+      resultsPlotting[[i]] <- results[match(featureID, results[,1], nomatch = 0), , drop = FALSE]
+      names(resultsPlotting)[[i]] <- testID[i]
     }
-    resultsPlotting <- results[match(featureID, results[,1], nomatch = 0), , drop = FALSE]
+    if (length(resultsPlotting) == 1) resultsPlotting <- resultsPlotting[[1]]
   }
 
   plottingData <- list(
     assays = assaysPlotting,
     samples = samplesPlotting,
     features = featuresPlotting
   )
-  if (!isEmpty(testID))  plottingData <- c(plottingData, list(results = resultsPlotting))
+  if (!isEmpty(testID)) plottingData <- c(plottingData, list(results = resultsPlotting))
 
   return(plottingData)
 }

R/tests.R

@@ -259,6 +259,39 @@ testPlots <- function() {
                    xlab = "PC 1", ylab = "PC 2", main = "PCA")
   }
   assign("plotMultiFeature", plotMultiFeature, envir = parent.frame())
+  plotMultiTest_sf <- function(x) {
+    var_x <- data.frame(lapply(x$results, `[`, 2))
+    colnames(var_x)<- names(x$results)
+    var_x <- data.table::data.table(features = rownames(var_x), var_x)
+    var_x <- data.table::melt(var_x, measure.vars = c(2,3))
+
+    var_y <- data.frame(lapply(x$results, `[`, 3))
+    colnames(var_y) <- names(x$results)
+    var_y <- data.table::data.table(features = rownames(var_y), var_y)
+    var_y <- data.table::melt(var_y, measure.vars = c(2,3))
+
+    df <- merge(var_x, var_y, by=c("variable", "features"))
+
+    plot(df$value.x ~ df$value.y, col = factor(df$variable))
+  }
+  assign("plotMultiTest_sf", plotMultiTest_sf, envir = parent.frame())
+  plotMultiTest_mf <- function(x) {
+    var_x <- data.frame(lapply(x$results, `[`, 2))
+    colnames(var_x)<- names(x$results)
+    var_x <- data.table::data.table(features = rownames(var_x), var_x)
+    var_x <- data.table::melt(var_x, measure.vars = c(2,3))
+
+    var_y <- data.frame(lapply(x$results, `[`, 3))
+    colnames(var_y) <- names(x$results)
+    var_y <- data.table::data.table(features = rownames(var_y), var_y)
+    var_y <- data.table::melt(var_y, measure.vars = c(2,3))
+
+    df <- merge(var_x, var_y, by=c("variable", "features"))
+
+    plot(df$value.x ~ df$value.y, col = factor(df$variable))
+  }
+  assign("plotMultiTest_mf", plotMultiTest_mf, envir = parent.frame())
+
   plots <- list(
     default = list(
       plotBase = list(
@@ -269,6 +302,17 @@ testPlots <- function() {
         displayName = "PCA",
         plotType = "multiFeature",
         packages = "stats"
+      ),
+      plotMultiTest_sf = list(
+        displayName = "scatterplot_singlefeat",
+        plotType = "multiTest",
+        # default should set plotType to c("singleFeature", "multiTest")
+        packages = "data.table"
+      ),
+      plotMultiTest_mf = list(
+        displayName = "scatterplot_multifeat",
+        plotType = c("multiFeature", "multiTest"),
+        packages = "data.table"
       )
     ),
     model_03 = list(

inst/tinytest/testApp.R

@@ -91,9 +91,23 @@ expect_identical_xl(
 )
 
 expect_identical_xl(
-  vapply(studies[[1]][["plots"]][[1]][["plots"]],
-         function(x) x[["plotType"]], character(1)),
-  c("singleFeature", "multiFeature")
+  studies[[1]][["plots"]][[1]][["plots"]][[1]][["plotType"]],
+  "singleFeature"
+)
+
+expect_identical_xl(
+  studies[[1]][["plots"]][[1]][["plots"]][[2]][["plotType"]],
+  "multiFeature"
+)
+
+expect_identical_xl(
+  studies[[1]][["plots"]][[1]][["plots"]][[3]][["plotType"]],
+  "multiTest"
+)
+
+expect_identical_xl(
+  studies[[1]][["plots"]][[1]][["plots"]][[4]][["plotType"]],
+  list("multiFeature", "multiTest")
 )
 
 # If there are no OmicNavigator study packages installed, return an empty list.

inst/tinytest/testPlot.R

@@ -30,7 +30,7 @@ pkgDependencies <- utils::packageDescription(
 
 expect_identical_xl(
   pkgDependencies,
-  "ggplot2, graphics, rlang, stats"
+  "data.table, ggplot2, graphics, rlang, stats"
 )
 
 pkgExports <- sort(getNamespaceExports(testPkgName))
@@ -185,6 +185,44 @@ expect_error_xl(
   "non-existent"
 )
 
+
+# plotStudy (multitest) --------------------------------------------------------
+## check plotStudy calls without checking getPlottingData outputs
+
+expect_silent_xl(
+  plotStudy(testStudyName, modelID = "model_01", featureID = "feature_0001",
+            plotID = "plotMultiTest_sf", testID = c("test_01", "test_02"))
+)
+
+expect_error_xl(
+  plotStudy(testStudyName, modelID = "model_01", featureID = "non-existent",
+            plotID = "plotMultiTest_sf", testID = c("test_01", "test_02")),
+  "non-existent"
+)
+
+expect_error_xl(
+  plotStudy(testStudyName, modelID = "model_01", featureID = "feature_0001",
+            plotID = "plotMultiTest_sf", testID = "test_01")
+)
+
+expect_silent_xl(
+  plotStudy(testStudyName, modelID = "model_01",
+            featureID = c("feature_0001", "feature_0002"),
+            plotID = "plotMultiTest_mf", testID = c("test_01", "test_02"))
+)
+
+expect_error_xl(
+  plotStudy(testStudyName, modelID = "model_01",
+            featureID = "non-existent",
+            plotID = "plotMultiTest_mf", testID = c("test_01", "test_02"))
+)
+
+expect_error_xl(
+  plotStudy(testStudyName, modelID = "model_01",
+            featureID = c("feature_0001", "feature_0002"),
+            plotID = "plotMultiTest_mf", testID = "test_01")
+)
+
 # getPlottingData (object) -----------------------------------------------------
 
 plottingData <- getPlottingData(
@@ -565,6 +603,69 @@ expect_equal_xl(
   results[results[[1]] == "feature_0001", ]
 )
 
+# getPlottingData (package, multitest) -----------------------------------------
+
+plottingData <- getPlottingData(
+  testStudyName,
+  modelID = testModelName,
+  featureID = c("feature_0001", "feature_0002"),
+  testID = c("test_01", "test_02")
+)
+
+expect_true_xl(
+  inherits(plottingData, "list")
+)
+
+expect_identical_xl(
+  names(plottingData),
+  c("assays", "samples", "features", "results")
+)
+
+expect_true_xl(
+  inherits(plottingData[["assays"]], "data.frame")
+)
+
+expect_equal_xl(
+  plottingData[["assays"]],
+  assays[c("feature_0001", "feature_0002"), ]
+)
+
+expect_true_xl(
+  inherits(plottingData[["samples"]], "data.frame")
+)
+
+expect_equal_xl(
+  plottingData[["samples"]],
+  samples
+)
+
+expect_true_xl(
+  inherits(plottingData[["features"]], "data.frame")
+)
+
+expect_equal_xl(
+  plottingData[["features"]],
+  features[features[[1]] == c("feature_0001", "feature_0002"), ]
+)
+
+expect_true_xl(
+  inherits(plottingData[["results"]], "list")
+)
+
+result_test01 <- testStudyObj$results[[testModelName]]$test_01
+result_test01 <- result_test01[order(result_test01$customID),]
+expect_equal_xl(
+  plottingData[["results"]][["test_01"]],
+  result_test01[result_test01$customID %in% c("feature_0001", "feature_0002"),]
+)
+
+result_test02 <- testStudyObj$results[[testModelName]]$test_02
+result_test02 <- result_test02[order(result_test02$customID),]
+expect_equal_xl(
+  plottingData[["results"]][["test_02"]],
+  result_test02[result_test02$customID %in% c("feature_0001", "feature_0002"),]
+)
+
 # getPlottingData (package, multiFeature, testID) ------------------------------
 
 plottingData <- getPlottingData(