add intersectByRowData

Author: LiNk-NY

NAMESPACE

@@ -17,6 +17,7 @@ export(getWithColData)
 export(hasAssay)
 export(hasRowData)
 export(hasRowRanges)
+export(intersectByRowData)
 export(intersectColumns)
 export(intersectRows)
 export(listToMap)
@@ -68,6 +69,7 @@ exportMethods(experiments)
 exportMethods(exportClass)
 exportMethods(hasRowData)
 exportMethods(hasRowRanges)
+exportMethods(intersectByRowData)
 exportMethods(isEmpty)
 exportMethods(length)
 exportMethods(longForm)

R/subsetBy-methods.R

@@ -105,6 +105,28 @@ NULL
 #' * `subsetByColumn`: Select observations by assay or for each assay
 #' * `subsetByRow`: Select rows by assay or for each assay
 #' * `subsetByAssay`: Select experiments
+#' * `subsetByRowData`: Select rows by values in the rowData
+#' * `intersectByRowData`: Intersect with values in the rowData
+#'
+#' @section rowData:
+#'
+#' Some assays may have additional metadata associated with the rows.
+#' This metadata is stored in the `rowData` slot of the object, typically a
+#' `SummarizedExperiment` or `RangedSummarizedExperiment`.
+#'
+#' `subsetByRowData` allows the user to subset the rows of the assays
+#' based on the values in the `rowData`.
+#'
+#' `intersectByRowData` is a special case of `subsetByRowData` where
+#' the `rowData` values are intersected with the `y` values. Naturally,
+#' the `y` values are expected to be of type `character`.
+#'
+#' Note that `rowDataCols` allows the user to specify a particular
+#' column from which to extract the values for subsetting. This column
+#' name must be consistent across assays. If the column is not present
+#' in an assay, the assay will be skipped and considered a no-op. Assays
+#' are also skipped when there are no values in the `rowData` that match
+#' the `y` values.
 #'
 #' @return `subsetBy*`: operations are endomorphic and return either
 #' `MultiAssayExperiment` or `ExperimentList` depending on the
@@ -160,6 +182,23 @@ NULL
 #' subsetByRowData(
 #'     mae, "ENST00000355076", "rownames", i = "Affy"
 #' )
+#'
+#' ## use miniACC as example MAE
+#' data("miniACC")
+#'
+#' ## intersect values of y with rownames in rowData
+#' intersectByRowData(
+#'     x = miniACC,
+#'     y = c("G6PD", "PETN"),
+#'     rowDataCol = "rownames",
+#'     i = c("RNASeq2GeneNorm", "gistict")
+#' )
+#'
+#' ## no-op when rowDataCol is not present or there is no data
+#' intersectByRowData(
+#'     x = miniACC, y = c("G6PD", "PETN"), rowDataCol = "Genes",
+#'     i = c("RNASeq2GeneNorm", "gistict")
+#' )
 NULL
 
 # subsetBy Generics -------------------------------------------------------
@@ -434,3 +473,56 @@ setMethod(
         subsetByRow(x = x, y = y, i = i)
     }
 )
+
+
+# intersectByRowData,MultiAssayExperiment-method --------------------------
+
+#' @rdname subsetBy
+#'
+#' @aliases intersectByRowData
+#'
+#' @export
+setGeneric(
+    "intersectByRowData",
+    function(x, y, rowDataCol, i, ...)
+        standardGeneric("intersectByRowData")
+)
+
+#' @rdname subsetBy
+#' @exportMethod intersectByRowData
+setMethod(
+    "intersectByRowData", 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'")
+        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"))
+                    intersect(rownames(rd), y)
+                else if (rowDataCol %in% colnames(rd))
+                    intersect(rd[[rowDataCol]], y)
+                else
+                    NULL
+            }
+        )
+        noRowData <-
+            vapply(y, function(z) is.null(z) || !length(z), logical(1))
+        if (any(noRowData)) {
+            noRDnames <- paste(shQuote(names(y)[noRowData]), collapse = ", ")
+            warning(
+                "No 'rowData' intersected for assays:\n  ", noRDnames,
+                call. = FALSE
+            )
+        }
+        subsetByRow(x = x, y = y, i = i)
+    }
+)