diff --git a/NAMESPACE b/NAMESPACE index 01c7ae0..ac745c8 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/MultiAssayExperiment-helpers.R b/R/MultiAssayExperiment-helpers.R index e5392a4..d619cd0 100644 --- a/R/MultiAssayExperiment-helpers.R +++ b/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(" 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)) diff --git a/man/MultiAssayExperiment-helpers.Rd b/man/MultiAssayExperiment-helpers.Rd index 335f102..56e7954 100644 --- a/man/MultiAssayExperiment-helpers.Rd +++ b/man/MultiAssayExperiment-helpers.Rd @@ -18,6 +18,9 @@ \alias{mergeReplicates,MultiAssayExperiment-method} \alias{mergeReplicates,ANY-method} \alias{longFormat} +\alias{longFormat,ANY-method} +\alias{longFormat,ExperimentList-method} +\alias{longFormat,MultiAssayExperiment-method} \alias{wideFormat} \alias{hasRowRanges} \alias{hasRowRanges,MultiAssayExperiment-method} @@ -67,7 +70,13 @@ mergeReplicates(x, replicates = list(), simplify = BiocGenerics::mean, ...) \S4method{mergeReplicates}{ANY}(x, replicates = list(), simplify = BiocGenerics::mean, ...) -longFormat(object, colDataCols = NULL, i = 1L) +longFormat(object, colDataCols = NULL, i = 1L, ...) + +\S4method{longFormat}{ANY}(object, colDataCols = NULL, i = 1L, ...) + +\S4method{longFormat}{ExperimentList}(object, colDataCols = NULL, i = 1L, ...) + +\S4method{longFormat}{MultiAssayExperiment}(object, colDataCols = NULL, i = 1L, ...) wideFormat( object, @@ -364,7 +373,6 @@ colnames(mae2) sampleMap(mae2) - patts <- list( normals = "TCGA-[A-Z0-9]{2}-[A-Z0-9]{4}-11", tumors = "TCGA-[A-Z0-9]{2}-[A-Z0-9]{4}-01" diff --git a/tests/testthat/test-MultiAssayExperiment-helpers.R b/tests/testthat/test-MultiAssayExperiment-helpers.R index 6fc512f..38de73e 100644 --- a/tests/testthat/test-MultiAssayExperiment-helpers.R +++ b/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"]] diff --git a/tests/testthat/test-saveHDF5MultiAssayExperiment.R b/tests/testthat/test-saveHDF5MultiAssayExperiment.R index d1d3858..939858e 100644 --- a/tests/testthat/test-saveHDF5MultiAssayExperiment.R +++ b/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") ) ) -}) \ No newline at end of file +})