Updating plots.R for multi_mapping

R/add.R

@@ -412,16 +412,28 @@ addPlots <- function(study, plots, reset = FALSE) {
 #' Add mapping object
 #'
 #' @param mapping Feature IDs from models. The input object is a list of named
-#' data frames. Column names indicate model names (modelID), and rows indicate
-#' featureIDs per model. Features with same index position across columns are
-#' treated as mapped across models. For each model, feature IDs must match
-#' feature IDs available in the results object of the respective model.
-#' The name of each list element should be set to either a modelID or "default".
+#' data frames. For each data frame, column names indicate model names while
+#' rows indicate featureIDs per model. Features with same index position across
+#' columns are treated as mapped across models. For each model, feature IDs must
+#' match feature IDs available in the results object of the respective model.
+#' 1:N relationships are allowed.
+#'
+#' Mapping list elements are required to be named as 'default' or after a model
+#' name as provided in addModels(). If a single data frame is provided, this
+#' list element is recommended to be named 'default'. For multiple list
+#' elements, each with its own data frame, list elements should be named after
+#' model name(s) (a single element may still be  named 'default'). In that case,
+#' when navigating in ON front-end (FE), mapping element related to the selected
+#' model in the FE will be used in multimodel plots. If a selected model in FE
+#' does not have a corresponding mapping list element, it may still use the
+#' mapping list element called 'default' if this is available.
+#'
 #' E.g., if in a study there are models "transcriptomics" and "proteomics" and
-#' the user wants to create a plot based on data from both, a mapping object
-#' with column names "transcriptomics" and "proteomics" should be created, where
-#' feature IDs of both models that relate to each other are located in the same
-#' row across columns.
+#' the user wants to create a plot based on data from both, a mapping list
+#' should be provided with addMapping(). In this case, the mapping list element
+#' may be named 'default'. This should contain a data frame with column names
+#' 'transcriptomics' and 'proteomics', where feature IDs that map across models
+#' are found in the same row.
 #' @inherit shared-add
 #'
 #' @seealso \code{\link{getPlottingData}}, \code{\link{plotStudy}}

R/check.R

@@ -298,8 +298,8 @@ checkAnnotations <- function(annotations) {
 checkResults <- function(results) {
   checkList(results)
 
-  if ("defaults" %in% names(results)) {
-    stop("The results cannot be shared using the modelID \"defaults\"")
+  if ("default" %in% names(results)) {
+    stop("The results cannot be shared using the modelID \"default\"")
   }
 
   for (i in seq_along(results)) {
@@ -321,8 +321,8 @@ checkResults <- function(results) {
 checkEnrichments <- function(enrichments) {
   checkList(enrichments)
 
-  if ("defaults" %in% names(enrichments)) {
-    stop("The enrichments cannot be shared using the modelID \"defaults\"")
+  if ("default" %in% names(enrichments)) {
+    stop("The enrichments cannot be shared using the modelID \"default\"")
   }
 
   for (i in seq_along(enrichments)) {

R/plots.R

@@ -205,21 +205,20 @@ resetSearch <- function(pkgNamespaces) {
 
 # check mapping data requirements and extract relevant features per featureID
 getMappingPlottingData <- function(study = study, modelID = modelID, featureID = featureID, testID = testID, libraries = NULL) {
-  mapping <- getMapping(study, libraries = libraries)
+  mapping <- getMapping(study, modelID = modelID[1], quiet = TRUE, libraries = libraries)
+  model_features <- mapping[modelID[1]][!is.na(mapping[modelID[1]])]
 
-  # Checking requirements for mapping
-  model_features <- mapping[["defaults"]][modelID[1]] [!is.na(mapping[["defaults"]][modelID[1]])]
   if (!any(featureID %in% model_features)) {
     stop(
-      sprintf("The provided features list does not contain any feature present in the model %s from mapping object.",
+      sprintf("The provided features list does not contain any feature present in model '%s' from mapping object.",
               modelID[1]
       )
     )
   }
   if (!all(featureID %in% model_features)) {
     message(
       sprintf(
-        "The provided features list contains at least one feature not present in the model %s from mapping object.",
+        "The provided features list contains at least one feature not present in model '%s' from mapping object.",
         modelID[1]
       ),
       sprintf(
@@ -238,7 +237,7 @@ getMappingPlottingData <- function(study = study, modelID = modelID, featureID =
   }
 
   # Structuring data for mapping
-  mappingdf <- as.data.frame(mapping[["defaults"]], stringsAsFactors = FALSE)
+  mappingdf <- as.data.frame(mapping, stringsAsFactors = FALSE)
   column_order <- unique(c(modelID[1], colnames(mappingdf)))
   mappingdf <- mappingdf[, column_order]
 

R/tests.R

@@ -399,7 +399,7 @@ testMapping <- function(seed = 12345L, nFeatures = 100,
       stringsAsFactors = FALSE
     )
   )
-  names(mapping) <- "defaults"
+  names(mapping) <- "default"
 
   return(mapping)
 }

R/validate.R

@@ -324,10 +324,11 @@ validateMapping <- function(study) {
   models  <- names(study[["results"]])
   for (i in seq_along(mapping)) {
     for (ii in seq_along(mapping[[i]])) {
-      # Check whether mapping names match model names from results table
-      mappingID       <- names(mapping[[i]][ii])
-      if (!mappingID %in% models) {
-        stop("At least one mapping name does not match any model name from results table\n",
+      # Check whether mapping names match model names from results table or 'default'
+      mappingID <- names(mapping[[i]][ii])
+      if (!mappingID %in% c(models, "default")) {
+        stop("At least one mapping name is not named as 'default' nor does match any model name from results table.\n",
+             "Shared mapping is required to be named as 'default'.",
              sprintf("mappingID: %s", mappingID))
       }
       # Check whether mapping features match results features

inst/tinytest/testCheck.R

@@ -360,12 +360,38 @@ expect_error_xl(
   info = "A single missing value would still be unique. Error if it is found"
 )
 
+resultsDefault <- list(
+  default = list(
+    t1 = data.frame(
+      x = c("a", "b", "c"),
+      y = rnorm(3),
+      stringsAsFactors = FALSE
+    )
+  )
+)
+
+expect_error_xl(
+  addResults(study, results = resultsDefault),
+  'The results cannot be shared using the modelID \"default\"'
+)
+
 # checkEnrichments -------------------------------------------------------------
 
 expect_error_xl(
   addEnrichments(study, enrichments = NULL)
 )
 
+enrichmentDefault <- list(
+  default = list(
+    t1 = NULL
+  )
+)
+
+expect_error_xl(
+  addEnrichments(study, enrichments = enrichmentDefault),
+  "The enrichments cannot be shared using the modelID \"default\""
+)
+
 # checkMetaFeatures ------------------------------------------------------------
 
 expect_error_xl(
@@ -456,15 +482,15 @@ expect_error_xl(
 tempMapping <- list(data.frame(model_01 = c("feature_01", "feature_02"),
                                model_02 = c("feature_01", "feature_02"),
                                stringsAsFactors = FALSE))
-names(tempMapping) <- "defaults"
+names(tempMapping) <- "default"
 expect_silent_xl(
   addMapping(study, mapping = tempMapping)
 )
 
 tempMapping <- list(data.frame(model_01 = c("feature_01", "feature_02"),
                                model_02 = c("feature_01", NA),
                                stringsAsFactors = FALSE))
-names(tempMapping) <- "defaults"
+names(tempMapping) <- "default"
 expect_silent_xl(
   addMapping(study, mapping = tempMapping)
 )
@@ -478,12 +504,11 @@ expect_error_xl(
   "The elements of list \"mapping\" must be named"
 )
 
-
 # check mapping with one model having only NAs
 tempMapping <- list(data.frame(model_01 = c("feature_01", "feature_02"),
                                model_02 = c(NA, NA),
                                stringsAsFactors = FALSE))
-names(tempMapping) <- "defaults"
+names(tempMapping) <- "default"
 expect_error_xl(
   addMapping(study, mapping = tempMapping),
   "mapping object requires at least one feature per model"
@@ -492,7 +517,7 @@ expect_error_xl(
 # check mapping with one single element
 tempMapping <- list(data.frame(model_01 = c("feature_01", "feature_02"),
                                stringsAsFactors = FALSE))
-names(tempMapping) <- "defaults"
+names(tempMapping) <- "default"
 expect_error_xl(
   addMapping(study, mapping = tempMapping),
   "mapping object requires at least two models and one feature"
@@ -502,7 +527,7 @@ expect_error_xl(
 tempMapping <- list(data.frame(model_01 = c("feature_01", "feature_02", NA, NA),
                                model_02 = c(NA, NA, "feature_05", "feature_06"),
                                stringsAsFactors = FALSE))
-names(tempMapping) <- "defaults"
+names(tempMapping) <- "default"
 expect_error_xl(
   addMapping(study, mapping = tempMapping),
   "does not present any feature mapped to another model"

inst/tinytest/testGet.R

@@ -605,7 +605,6 @@ expect_identical_xl(
   testStudyObj[["mapping"]]
 )
 
-## Crashing !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 expect_identical_xl(
   getMapping(testStudyName),
   testStudyObj[["mapping"]]

inst/tinytest/testGetNumeric.R

@@ -153,7 +153,6 @@ expect_identical_xl(
   testStudyObj[["mapping"]]
 )
 
-# Crashing !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 expect_identical_xl(
   getMapping(testStudyName),
   testStudyObj[["mapping"]]
@@ -165,7 +164,6 @@ expect_true_xl(
   )
 )
 
-# Crashing !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 expect_true_xl(
   is.character(
     unlist(getMapping(testStudyName))

inst/tinytest/testPlot.R

@@ -212,7 +212,6 @@ expect_error_xl(
 mmodel <- names(testStudyObj[["models"]])[1:2]
 mmtestID <- c("test_01", "test_02")
 
-# Crashing !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 expect_silent_xl(
   plotStudy(
     testStudyName,
@@ -234,7 +233,6 @@ expect_error_xl(
   "Plot type \"multiModel\" requires testID to be either NULL \\(default\\) or a vector containing at least 2 testIDs"
 )
 
-# Crashing !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 expect_message_xl(
   plotStudy(
     testStudyName,
@@ -243,10 +241,9 @@ expect_message_xl(
     plotID = "multiModel_scatterplot",
     testID = c("test_01", "test_02")
   ),
-  "The provided features list contains at least one feature not present in the model"
+  "The provided features list contains at least one feature not present in model"
 )
 
-# Crashing !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 expect_error_xl(
   plotStudy(
     testStudyName,
@@ -255,10 +252,9 @@ expect_error_xl(
     plotID = "multiModel_barplot_sf",
     testID = c("test_01", "test_02")
   ),
-  "The provided features list does not contain any feature present in the model"
+  "The provided features list does not contain any feature present in model"
 )
 
-# Crashing !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 expect_error_xl(
   plotStudy(
     testStudyName,

inst/tinytest/testValidate.R

@@ -242,11 +242,11 @@ expect_true_xl(
 
 # Check if model names from mapping are not matching model names from results
 invalidMapping <- testStudyObj
-names(invalidMapping[["mapping"]][[1]]) <- c("model_01", "model")
+names(invalidMapping[["mapping"]][[1]]) <- c("model_01", "invalid_mapping_name")
 
 expect_error_xl(
   validateStudy(invalidMapping),
-  "At least one mapping name does not match any model name from results table\n"
+  "At least one mapping name is not named as 'default' nor does match any model name from results table."
 )
 
 # Check if features from mapping are not matching features from results