document drops generic, method, and replacement

- remove from metadata
- access with drops function
- update unit tests

NAMESPACE

@@ -48,6 +48,7 @@ exportMethods("[[")
 exportMethods("[[<-")
 exportMethods("colData<-")
 exportMethods("colnames<-")
+exportMethods("drops<-")
 exportMethods("experiments<-")
 exportMethods("names<-")
 exportMethods("sampleMap<-")

R/MultiAssayExperiment-class.R

@@ -512,6 +512,7 @@ setMethod("show", "MultiAssayExperiment", function(object) {
 #'    \item experiments: Access the \link{ExperimentList} slot
 #'    \item `[[`: Access the \link{ExperimentList} slot
 #'    \item `$`: Access a column in \code{colData}
+#'    \item `drops`: Get a vector of dropped \link{ExperimentList} names
 #' }
 #'
 #' @section Setters:
@@ -527,6 +528,8 @@ setMethod("show", "MultiAssayExperiment", function(object) {
 #'     \item `[[<-`: Equivalent to the \code{experiments<-} setter method for
 #'     convenience
 #'     \item `$<-`: A vector to replace the indicated column in \code{colData}
+#'     \item `drops<-`: Trace \link{ExperimentList} names that have been
+#'     removed
 #' }
 #'
 #' @param object,x A \code{MultiAssayExperiment} object
@@ -543,7 +546,7 @@ setMethod("show", "MultiAssayExperiment", function(object) {
 #'
 #' @example inst/scripts/MultiAssayExperiment-methods-Ex.R
 #'
-#' @aliases experiments sampleMap experiments<- sampleMap<-
+#' @aliases experiments sampleMap experiments<- sampleMap<- drops drops<-
 NULL
 
 ### - - - - - - - - - - - - - - - - - - - - - - -
@@ -573,6 +576,15 @@ setMethod("colData", "MultiAssayExperiment", function(x, ...) {
     getElement(x, "colData")
 })
 
+#' @export
+setGeneric("drops", function(x) standardGeneric("drops"))
+
+#' @exportMethod drops
+#' @rdname MultiAssayExperiment-methods
+setMethod("drops", "MultiAssayExperiment", function(x) {
+    getElement(x, "drops")
+})
+
 ### - - - - - - - - - - - - - - - - - - - - - - - -
 ### Getters
 ###
@@ -589,15 +601,6 @@ setMethod("names", "MultiAssayExperiment", function(x)
     names(experiments(x))
 )
 
-#' @export
-setGeneric("drops", function(x) standardGeneric("drops"))
-
-#' @exportMethod drops
-#' @describeIn MultiAssayExperiment Get information about dropped experiments
-setMethod("drops", "MultiAssayExperiment", function(x) {
-    getElement(x, "drops")
-})
-
 ### - - - - - - - - - - - - - - - - - - - - - - - -
 ### Replacers
 ###
@@ -640,14 +643,15 @@ setGeneric("experiments<-", function(object, value)
     standardGeneric("experiments<-"))
 
 #' @export
+#' @rdname MultiAssayExperiment-methods
 setGeneric("drops<-", function(x, ..., value) standardGeneric("drops<-"))
 
 #' @exportMethod experiments<-
 #' @rdname MultiAssayExperiment-methods
 setReplaceMethod("experiments", c("MultiAssayExperiment", "ExperimentList"),
     function(object, value) {
         if (!any(names(object) %in% names(value)) && !isEmpty(object)) {
-            if (isEmpty(drops(x)))
+            if (isEmpty(drops(object)))
                 warning("'experiments' dropped; see 'drops()'", call. = FALSE)
             drops(object) <-
                 list(experiments = setdiff(names(object), names(value)))
@@ -737,7 +741,8 @@ setReplaceMethod("colData", c("MultiAssayExperiment", "ANY"),
     }
 )
 
-
+#' @exportMethod drops<-
+#' @rdname MultiAssayExperiment-methods
 setReplaceMethod("drops", c("MultiAssayExperiment", "ANY"),
     function(x, ..., value) {
         anydrops <- getElement(x, "drops")[["experiments"]]

R/MultiAssayExperiment-subset.R

@@ -17,13 +17,15 @@ NULL
     isEmptyAssay <- .emptyAssays(experiments(object))
     if (all(isEmptyAssay)) {
         drops(object) <- list(experiments = names(object))
+        if (warn)
+            warning("'experiments' dropped; see 'drops()'", call. = FALSE)
         experiments(object) <- ExperimentList()
     } else if (any(isEmptyAssay)) {
         empties <- vapply(isEmptyAssay, isTRUE, logical(1L))
         keeps <- names(isEmptyAssay)[!empties]
         drops(object) <- list(experiments = names(isEmptyAssay)[empties])
         if (warn)
-            warning("'experiments' dropped; see 'metadata'", call. = FALSE)
+            warning("'experiments' dropped; see 'drops()'", call. = FALSE)
         FUN <- if (warn) force else suppressWarnings
         object <- FUN(subsetByAssay(object, keeps))
     }
@@ -47,7 +49,7 @@ NULL
         x <- subsetByRow(x, i, ...)
     }
     if (drop) {
-        x <- .dropEmpty(x)
+        x <- .dropEmpty(x, warn = TRUE)
     }
     return(x)
 }

tests/testthat/test-MultiAssayExperiment.R

@@ -124,23 +124,23 @@ test_that("dropping experiments is noisy and traced", {
     mae <- MultiAssayExperiment(list(m=m, m2=m2, m3=m3))
     ## check warning about experiments
     expect_warning( dp <- mae[, list(m = 1:3, m2 = 0, m3 = 1), , drop = TRUE] )
-    ## check drops in metadata
-    expect_identical(metadata(dp)[["drops.experiments"]], "m2")
+    ## check drops in mae
+    expect_identical(drops(dp)[["experiments"]], "m2")
 
     ## check warning about experiments
     expect_warning( dp <- mae[character(0L), , drop = TRUE] )
     ## check drops in metadata
-    expect_identical(metadata(dp)[["drops.experiments"]], names(mae))
+    expect_identical(drops(dp)[["experiments"]], names(mae))
 
     ## check warning about experiments
     expect_warning( dp <- mae[, , 0, drop = TRUE] )
     ## check drops in metadata
-    expect_identical(metadata(dp)[["drops.experiments"]], names(mae))
+    expect_identical(drops(dp)[["experiments"]], names(mae))
 
     ## check warning about experiments
     expect_warning( dp <- mae[, , c(TRUE, FALSE), drop = TRUE] )
     ## check drops in metadata
-    expect_identical(metadata(dp)[["drops.experiments"]], "m2")
+    expect_identical(drops(dp)[["experiments"]], "m2")
 })
 
 test_that("MultiAssayExperiment replacements work", {