add longFormat generic and methods

- re-split longFormat output in wideFormat

NAMESPACE

@@ -20,7 +20,6 @@ export(intersectColumns)
 export(intersectRows)
 export(listToMap)
 export(loadHDF5MultiAssayExperiment)
-export(longFormat)
 export(makeHitList)
 export(mapToList)
 export(mergeReplicates)
@@ -67,6 +66,7 @@ exportMethods(exportClass)
 exportMethods(hasRowRanges)
 exportMethods(isEmpty)
 exportMethods(length)
+exportMethods(longFormat)
 exportMethods(mergeReplicates)
 exportMethods(metadata)
 exportMethods(names)

R/MultiAssayExperiment-helpers.R

@@ -340,9 +340,20 @@ setMethod("mergeReplicates", "ANY",
         return(object)
 })
 
-# longFormat function -----------------------------------------------------
 
-.longFormatANY <- function(object, i) {
+# longFormat generic and methods ------------------------------------------
+
+#' @rdname MultiAssayExperiment-helpers
+#' @aliases longFormat
+setGeneric(
+    "longFormat",
+    function(object, colDataCols = NULL, i = 1L, ...)
+    standardGeneric("longFormat")
+)
+
+#' @rdname MultiAssayExperiment-helpers
+#' @exportMethod longFormat
+setMethod("longFormat", "ANY", function(object, colDataCols, i = 1L, ...) {
     rowNAMES <- rownames(object)
     if (is.null(rowNAMES))
         rowNames <- as.character(seq_len(nrow(object)))
@@ -360,19 +371,32 @@ setMethod("mergeReplicates", "ANY",
     if (!is.character(res[["rowname"]]))
         res[["rowname"]] <- as.character(res[["rowname"]])
     res
-}
+})
 
-.longFormatElist <- function(object, i) {
-    if (!is(object, "ExperimentList"))
-        stop("<internal> Not an 'ExperimentList' input")
-    samelength <- identical(length(object), length(i))
-    if (!samelength && identical(length(i), 1L))
-        i <- rep(i, length(object))
-    mapply(function(obj, obname, idx) {
-        data.frame(assay = obname, .longFormatANY(obj, i = idx),
-            stringsAsFactors = FALSE)
-        }, obj = object, obname = names(object), idx = i, SIMPLIFY = FALSE)
-}
+#' @rdname MultiAssayExperiment-helpers
+#' @exportMethod longFormat
+setMethod(
+    "longFormat", "ExperimentList",
+    function(object, colDataCols, i = 1L, ...) {
+        samelength <- identical(length(object), length(i))
+        if (!samelength && identical(length(i), 1L))
+            i <- rep(i, length(object))
+        res <- mapply(
+            function(obj, obname, idx) {
+                data.frame(
+                    assay = obname,
+                    longFormat(obj, i = idx),
+                    stringsAsFactors = FALSE
+                )
+            }, obj = object, obname = names(object), idx = i, SIMPLIFY = FALSE
+        )
+
+        do.call(
+            function(...) rbind(..., make.row.names = FALSE),
+            res
+        )
+    }
+)
 
 .matchAddColData <- function(reshaped, colData, colDataCols) {
     extraColumns <- as.data.frame(colData[, colDataCols, drop = FALSE])
@@ -395,8 +419,6 @@ setMethod("mergeReplicates", "ANY",
 
 #' @rdname MultiAssayExperiment-helpers
 #'
-#' @aliases longFormat
-#'
 #' @details The `longFormat` "ANY" class method, works with classes such as
 #' [`ExpressionSet`][Biobase::ExpressionSet] and
 #' [`SummarizedExperiment`][SummarizedExperiment::SummarizedExperiment-class] as
@@ -425,31 +447,24 @@ setMethod("mergeReplicates", "ANY",
 #'     renameColname: Either a `numeric` or `character` index
 #'     indicating the assay whose colnames are to be renamed
 #'
-#' @param mode String indicating how `MultiAssayExperiment`
-#'     column-level metadata should be added to the
-#'     `SummarizedExperiment` `colData`.
-#'
-#' @export longFormat
-longFormat <- function(object, colDataCols = NULL, i = 1L) {
-    if (is(object, "ExperimentList"))
-        return(do.call(rbind, .longFormatElist(object, i = i)))
-    else if (!is(object, "MultiAssayExperiment"))
-        return(.longFormatANY(object, i = i))
-
-    if (any(.emptyAssays(experiments(object))))
-        object <- .dropEmpty(object, warn = FALSE)
+#' @exportMethod longFormat
+setMethod(
+    "longFormat", "MultiAssayExperiment",
+    function(object, colDataCols = NULL, i = 1L, ...) {
+        if (any(.emptyAssays(experiments(object))))
+            object <- .dropEmpty(object, warn = FALSE)
 
-    longDataFrame <- do.call(function(...) rbind(..., make.row.names = FALSE),
-        .longFormatElist(experiments(object), i = i))
+        longDataFrame <- longFormat(experiments(object), i = i)
 
-    longDataFrame <- .mapOrderPrimary(longDataFrame, sampleMap(object))
+        longDataFrame <- .mapOrderPrimary(longDataFrame, sampleMap(object))
 
-    if (!is.null(colDataCols))
-        longDataFrame <-
-            .matchAddColData(longDataFrame, colData(object), colDataCols)
+        if (!is.null(colDataCols))
+            longDataFrame <-
+                .matchAddColData(longDataFrame, colData(object), colDataCols)
 
-    as(longDataFrame, "DataFrame")
-}
+        as(longDataFrame, "DataFrame")
+    }
+)
 
 # wideformat function -----------------------------------------------------
 
@@ -535,7 +550,8 @@ wideFormat <- function(object, colDataCols = NULL, check.names = TRUE,
     if (is.null(colDataCols)) colDataCols <- character(0L)
     nameFUN <- if (check.names) make.names else I
     cnames <- colnames(object)
-    longList <- .longFormatElist(experiments(object), i = i)
+    longDataFrame <- longFormat(experiments(object), i = i)
+    longList <- split(longDataFrame, longDataFrame[["assay"]])
     longList <- lapply(longList, .mapOrderPrimary, sampleMap(object))
     colsofinterest <- c("assay", "rowname")
 
@@ -630,6 +646,10 @@ setMethod("hasRowRanges", "ExperimentList", function(x) {
 
 #' @rdname MultiAssayExperiment-helpers
 #'
+#' @param mode String indicating how `MultiAssayExperiment`
+#'     column-level metadata should be added to the
+#'     `SummarizedExperiment` `colData`.
+#'
 #' @param verbose `logical(1)` Whether to `suppressMessages` on subsetting
 #'     operations in `getWithColData` (default FALSE)
 #'
@@ -758,7 +778,6 @@ renamePrimary <- function(x, value) {
 #' colnames(mae2)
 #' sampleMap(mae2)
 #'
-#'
 #' @export renameColname
 renameColname <- function(x, i, value) {
     stopifnot(length(i) == 1L, !is.na(i), !missing(i))

tests/testthat/test-MultiAssayExperiment-helpers.R

@@ -240,7 +240,7 @@ test_that("renaming helpers work", {
 })
 
 
-test_that(".longFormatANY works", {
+test_that("longFormat,ANY-method works", {
     denv <- new.env(parent = emptyenv())
     data("miniACC", package="MultiAssayExperiment", envir = denv)
     miniACC <- denv[["miniACC"]]

tests/testthat/test-saveHDF5MultiAssayExperiment.R

@@ -29,6 +29,10 @@ test_that("saveHDF5MultiAssayExperiment is working", {
 })
 
 test_that("prefix argument works as intended", {
+    env <- new.env(parent = emptyenv())
+    data("miniACC",  envir = env)
+    miniACC <- env[["miniACC"]]
+
     testDir <- file.path(tempdir(), "test_mae")
     saveHDF5MultiAssayExperiment(
         miniACC, dir = testDir, prefix = "", replace = TRUE
@@ -85,7 +89,7 @@ test_that("loadHDF5MultiAssayExperiment is working", {
 
     testDir <- file.path(tempdir(), "test_mae")
     on.exit(unlink(testDir, recursive = TRUE))
-    
+
     saveHDF5MultiAssayExperiment(
         miniACC, prefix = "", dir = testDir, replace = TRUE
     )
@@ -105,7 +109,7 @@ test_that("loadHDF5MultiAssayExperiment prefix input is consistent", {
 
     testDir <- file.path(tempdir(), "test_mae")
     on.exit(unlink(testDir, recursive = TRUE))
-    
+
     saveHDF5MultiAssayExperiment(
         miniACC, prefix = "test", dir = testDir, replace = TRUE
     )
@@ -125,4 +129,4 @@ test_that("loadHDF5MultiAssayExperiment prefix input is consistent", {
             loadHDF5MultiAssayExperiment(dir = testDir, prefix = "error")
         )
     )
-})
+})