add subsetByRow and subsetByRowData

waldronlab · Jan 23, 2025 · 7597ee3 · 7597ee3
1 parent a8ad498
commit 7597ee3
Show file tree

Hide file tree

Showing 4 changed files with 137 additions and 6 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -37,6 +37,7 @@ export(subsetByAssay)
 export(subsetByColData)
 export(subsetByColumn)
 export(subsetByRow)
+export(subsetByRowData)
 export(upsetSamples)
 export(wideFormat)
 exportClasses(ExperimentList)
@@ -81,6 +82,7 @@ exportMethods(sampleMap)
 exportMethods(show)
 exportMethods(showReplicated)
 exportMethods(splitAssays)
+exportMethods(subsetByRow)
 exportMethods(updateObject)
 import(BiocGenerics)
 import(GenomicRanges)

diff --git a/R/subsetBy-methods.R b/R/subsetBy-methods.R
@@ -67,8 +67,8 @@ NULL
 #' @param y Either a `character`, `integer`, `logical`, `list`, `List`,
 #' or `GRanges` object for subsetting by rows _within the experiments_
 #'
-#' @param i For the `subsetByRow` `MultiAssayExperiment` method,
-#' either a `character`, `logical`, or `numeric` vector to selectively
+#' @param i For the `subsetByRow` and `subsetByRowData` `MultiAssayExperiment`
+#' methods, either a `character`, `logical`, or `numeric` vector to selectively
 #' subset experiments with `y` (default is `TRUE`). For **bracket** (`[`)
 #' methods, see `y` input.
 #'
@@ -83,6 +83,11 @@ NULL
 #' @param drop logical (default FALSE) whether to drop all empty assay elements
 #' in the `ExperimentList`
 #'
+#' @param rowDataCol `character(1)` The name of the column in the `rowData`.
+#' If the column is not present, the experiment will be skipped. When
+#' `rowDataCol` is `"rownames"` or `"row.names"`, the values of `y` will
+#' be matched with the row names in the `rowData` of the experiment.
+#'
 #' @aliases [,MultiAssayExperiment,ANY-method subsetByColData subsetByRow
 #' subsetByColumn subsetByAssay subset subsetBy
 #'
@@ -145,6 +150,13 @@ NULL
 #' ## Use a character vector
 #' subsetByRow(mae, "ENST00000355076")
 #'
+#' ## Use i index to selectively subsetByRow
+#' subsetByRow(mae, "ENST00000355076", i = c(TRUE, TRUE, FALSE, FALSE))
+#'
+#' ## Use i index to selectively subsetByRowData
+#' subsetByRowData(
+#'     mae, "ENST00000355076", "rownames", i = "Affy"
+#' )
 NULL
 
 # subsetBy Generics -------------------------------------------------------
@@ -153,6 +165,13 @@ NULL
 #' @export subsetByRow
 setGeneric("subsetByRow", function(x, y, ...) standardGeneric("subsetByRow"))
 
+#' @rdname subsetBy
+#' @export subsetByRowData
+setGeneric(
+    "subsetByRowData",
+    function(x, y, rowDataCol, ...) standardGeneric("subsetByRowData")
+)
+
 #' @rdname subsetBy
 #' @export subsetByColData
 setGeneric("subsetByColData", function(x, y) standardGeneric("subsetByColData"))
@@ -258,7 +277,7 @@ setMethod("subsetByAssay", c("ExperimentList", "ANY"), function(x, y) {
     x[y]
 })
 
-# subsetByColData,MultiAssayExperiment-methods -----------------------------------------
+# subsetByColData,MultiAssayExperiment-methods ----------------------------
 
 #' @rdname subsetBy
 setMethod("subsetByColData", c("MultiAssayExperiment", "ANY"), function(x, y) {
@@ -315,18 +334,37 @@ setMethod("subsetByColData", c("MultiAssayExperiment", "character"),
 # subsetByRow,MultiAssayExperiment-method ---------------------------------
 
 #' @rdname subsetBy
+#' @exportMethod subsetByRow
 setMethod(
     "subsetByRow", c("MultiAssayExperiment", "ANY"),
     function(x, y, i = TRUE, ...) {
         stopifnot(
-            !is.na(i) &&
+            !anyNA(i) &&
                 (is.logical(i) || is.character(i) || is.numeric(i))
         )
         experiments(x)[i] <- subsetByRow(experiments(x)[i], y)
         return(x)
     }
 )
 
+#' @rdname subsetBy
+setMethod(
+    "subsetByRow", c("MultiAssayExperiment", "list"),
+    function(x, y, ...) {
+        experiments(x) <- subsetByRow(experiments(x), y)
+        return(x)
+    }
+)
+
+#' @rdname subsetBy
+setMethod(
+    "subsetByRow", c("MultiAssayExperiment", "List"),
+    function(x, y, ...) {
+        y <- as.list(y)
+        subsetByRow(x, y)
+    }
+)
+
 # subsetByColumn,MultiAssayExperiment-method ------------------------------
 
 #' @rdname subsetBy
@@ -353,3 +391,41 @@ setMethod("subsetByAssay", c("MultiAssayExperiment", "ANY"), function(x, y) {
     experiments(x) <- subexp
     return(x)
 })
+
+# subsetByRowData,MultiAssayExperiment-method -----------------------------
+
+#' @rdname subsetBy
+setMethod(
+    "subsetByRowData", c("MultiAssayExperiment", "character", "character"),
+    function(x, y, rowDataCol, i = TRUE, ...) {
+        if (is.character(i))
+            logi <- names(x) %in% i
+        else if (is.logical(i) || is.numeric(i))
+            logi <- names(x) %in% names(x)[i]
+        else
+            stop("Invalid experiment subscript type for 'i'")
+        valids <- hasRowData(x)[which(logi)]
+        if (any(!valids)) {
+            notValids <- paste(
+                names(valids[!valids]), collapse = ", "
+            )
+            stop("Selected experiments have no 'rowData': ", notValids)
+        }
+        i <- hasRowData(x) & logi
+        if (!any(i))
+            stop("No 'rowData' available for subsetting")
+        y <- lapply(
+            experiments(x)[i],
+            function(exper) {
+                rd <- rowData(exper)
+                if (rowDataCol %in% c("rownames", "row.names"))
+                    rownames(rd) %in% y
+                else if (rowDataCol %in% colnames(rd))
+                    rd[[rowDataCol]] %in% y
+                else
+                    TRUE
+            }
+        )
+        subsetByRow(x = x, y = y, i = i)
+    }
+)
diff --git a/man/subsetBy.Rd b/man/subsetBy.Rd
diff --git a/tests/testthat/test-subset.R b/tests/testthat/test-subset.R
@@ -32,6 +32,35 @@ test_that("subsetByRow keeps assay order in MultiAssayExperiment", {
     expect_identical(names(mae), names(mae[rows, ]))
 })
 
+test_that("subsetByRow works with i index", {
+    expect_identical(
+        vapply(
+            experiments(
+                subsetByRow(
+                    mae, "ENST00000355076", i = c(TRUE, TRUE, FALSE, FALSE)
+                )
+            )[1:2],
+            nrow,
+            integer(1L)
+        ),
+        c(Affy = 1L, Methyl450k = 1L)
+    )
+    expect_identical(
+        list(
+            Affy = 1L, Methyl450k = 5L, RNASeqGene = 5L, GISTIC = 5L
+        ),
+        lapply(
+            experiments(
+                subsetByRowData(
+                    mae, "ENST00000355076", "rownames", i = "Affy"
+                )
+            ),
+            nrow
+        )
+    )
+})
+
+
 test_that("assay subsets work", {
     noAffy <- list(noAffy = 1:5)
     expect_error(experiments(mae)[noAffy])