wip: updating MbioDataset methods and constructors

R/class-MbioDataset.R

@@ -111,9 +111,11 @@ check_mbio_dataset <- function(object) {
 
     # check that at least some ancestorIdColumns are shared between collections and sampleMetadata
     sampleMetadataAncestorIds <- object@metadata@ancestorIdColumns
-    if (!all(lapply(object@collections, function(x) any(x@ancestorIdColumns %in% sampleMetadataAncestorIds)))) {
-        msg <- "at least one ancestorIdColumn must be shared between collections and sampleMetadata"
-        errors <- c(errors, msg)
+    if (!!length(sampleMetadataAncestorIds)) {
+        if (!all(lapply(object@collections, function(x) any(x@ancestorIdColumns %in% sampleMetadataAncestorIds)))) {
+            msg <- "at least one ancestorIdColumn must be shared between collections and sampleMetadata"
+            errors <- c(errors, msg)
+        }
     }
 
     if (length(errors) == 0) {

R/constructors-MbioDataset.R

@@ -223,12 +223,12 @@ sampleMetadataBuilder <- function(dataSource) {
     dt <- getDataFromSource(dataSource, keepIdsAndNumbersOnly=FALSE)
     dataColNames <- names(dt)
     recordIdColumn <- findRecordIdColumn(dataColNames)
-    findAncestorIdColumns <- findAncestorIdColumns(dataColNames)
+    ancestorIdColumns <- findAncestorIdColumns(dataColNames)
 
     sampleMetadata <- new("SampleMetadata",
         data=dt,
         recordIdColumn = recordIdColumn,
-        findAncestorIdColumns = findAncestorIdColumns
+        ancestorIdColumns = findAncestorIdColumns
     )
 
     return(sampleMetadata)
@@ -237,14 +237,14 @@ sampleMetadataBuilder <- function(dataSource) {
 # TODO turn this into a proper S4 method of SampleMetadata and put it in a different package?
 # this will not work for metadata across different branches of the tree. IDK if we have that case in mbio?
 mergeSampleMetadata <- function(x, y) {
-    uniqueAncestorIdColumns <- unique(x@findAncestorIdColumns, y@findAncestorIdColumns)
+    uniqueAncestorIdColumns <- unique(x@ancestorIdColumns, y@ancestorIdColumns)
     recordIdColumn <- ifelse(x@recordIdColumn %in% uniqueAncestorIdColumns, y@recordIdColumn, x@recordIdColumn)
     data <- merge(x@data, y@data, by = uniqueAncestorIdColumns, all = TRUE)
 
     sampleMetadata <- new("SampleMetadata",
         data = data,
         recordIdColumn = recordIdColumn,
-        findAncestorIdColumns = uniqueAncestorIdColumns
+        ancestorIdColumns = uniqueAncestorIdColumns
     )
 
     return(sampleMetadata)
@@ -273,21 +273,61 @@ setMethod("MbioDataset", signature("missing", "missing"), function(collections,
     new("MbioDataset")
 })
 
+#' @export 
+setMethod("MbioDataset", signature("Collections", "SampleMetadata"), function(collections, metadata) {
+    new("MbioDataset", collections = collections, metadata = metadata)
+})
+
 #' @export
 setMethod("MbioDataset", signature("Collections", "data.frame"), function(collections, metadata) {
     new("MbioDataset", collections = collections, metadata = sampleMetadataBuilder(metadata))
 })
 
+#' @export 
+setMethod("MbioDataset", signature("Collections", "list"), function(collections, metadata) {
+    new("MbioDataset", collections = collections, metadata = sampleMetadataFromDataSources(metadata))
+})
+
 #' @export
 setMethod("MbioDataset", signature("Collections", "missing"), function(collections, metadata) {
     new("MbioDataset", collections = collections)
 })
 
+#' @export
+setMethod("MbioDataset", signature("Collections", "character"), function(collections, metadata) {
+    new("MbioDataset", collections = collections, metadata = sampleMetadataFromDataSources(list(metadata)))
+})
+
+#' @export 
+setMethod("MbioDataset", signature("Collection", "SampleMetadata"), function(collections, metadata) {
+    new("MbioDataset", collections = Collections(collections), metadata = metadata)
+})
+
 #' @export
 setMethod("MbioDataset", signature("Collection", "data.frame"), function(collections, metadata) {
     new("MbioDataset", collections = Collections(collections), metadata = sampleMetadataBuilder(metadata))
 })
 
+#' @export 
+setMethod("MbioDataset", signature("Collection", "list"), function(collections, metadata) {
+    new("MbioDataset", collections = Collections(collections), metadata = sampleMetadataFromDataSources(metadata))
+})
+
+#' @export 
+setMethod("MbioDataset", signature("Collection", "missing"), function(collections, metadata) {
+    new("MbioDataset", collections = Collections(collections))
+})
+
+#' @export
+setMethod("MbioDataset", signature("Collection", "character"), function(collections, metadata) {
+    new("MbioDataset", collections = Collections(collections), metadata = sampleMetadataFromDataSources(list(metadata)))
+})
+
+#' @export 
+setMethod("MbioDataset", signature("list", "SampleMetadata"), function(collections, metadata) {
+    new("MbioDataset", collections = Collections(collections), metadata = metadata)
+})
+
 #' @export
 setMethod("MbioDataset", signature("list", "data.frame"), function(collections, metadata) {
     new("MbioDataset", collections = Collections(collections), metadata = sampleMetadataBuilder(metadata))
@@ -303,6 +343,21 @@ setMethod("MbioDataset", signature("list", "list"), function(collections, metada
     new("MbioDataset", collections = Collections(collections), metadata = sampleMetadataFromDataSources(metadata))
 })
 
+#' @export
+setMethod("MbioDataset", signature("list", "character"), function(collections, metadata) {
+    new("MbioDataset", collections = Collections(collections), metadata = sampleMetadataFromDataSources(list(metadata)))
+})
+
+#' @export 
+setMethod("MbioDataset", signature("data.frame", "SampleMetadata"), function(collections, metadata) {
+    new("MbioDataset", collections = Collections(collections), metadata = metadata)
+})
+
+#' @export
+setMethod("MbioDataset", signature("data.frame", "list"), function(collections, metadata) {
+    new("MbioDataset", collections = Collections(collections), metadata = sampleMetadataFromDataSources(metadata))
+})
+
 #' @export
 setMethod("MbioDataset", signature("data.frame", "missing"), function(collections, metadata) {
     new("MbioDataset", collections = Collections(collections))
@@ -311,4 +366,34 @@ setMethod("MbioDataset", signature("data.frame", "missing"), function(collection
 #' @export
 setMethod("MbioDataset", signature("data.frame", "data.frame"), function(collections, metadata) {
     new("MbioDataset", collections = Collections(collections), metadata = sampleMetadataBuilder(metadata))
+})
+
+#' export
+setMethod("MbioDataset", signature("data.frame", "character"), function(collections, metadata) {
+    new("MbioDataset", collections = Collections(collections), metadata = sampleMetadataFromDataSources(list(metadata)))
+})
+
+#' @export 
+setMethod("MbioDataset", signature("character", "character"), function(collections, metadata) {
+    new("MbioDataset", collections = Collections(collections), metadata = sampleMetadataFromDataSources(list(metadata)))
+})
+
+#' @export 
+setMethod("MbioDataset", signature("character", "list"), function(collections, metadata) {
+    new("MbioDataset", collections = Collections(collections), metadata = sampleMetadataFromDataSources(metadata))
+})
+
+#' @export 
+setMethod("MbioDataset", signature("character", "missing"), function(collections, metadata) {
+    new("MbioDataset", collections = Collections(collections))
+})
+
+#' @export 
+setMethod("MbioDataset", signature("character", "data.frame"), function(collections, metadata) {
+    new("MbioDataset", collections = Collections(collections), metadata = sampleMetadataBuilder(metadata))
+})
+
+#' @export
+setMethod("MbioDataset", signature("character", "SampleMetadata"), function(collections, metadata) {
+    new("MbioDataset", collections = Collections(collections), metadata = metadata)
 })

R/methods-MbioDataset.R

@@ -24,7 +24,7 @@ setMethod("getCollectionNames", "MbioDataset", function(object) return(names(obj
 #' @export
 setGeneric("updateCollectionName", function(object, oldName, newName) standardGeneric("updateCollectionName"))
 setMethod("updateCollectionName", "MbioDataset", function(object, oldName, newName) {
-    object@collections[[oldName]]@name <- newName
+    object@collections[oldName][[1]]@name <- newName
     return(object)
 })
 
@@ -43,8 +43,18 @@ setMethod("getCollection", "MbioDataset", function(object, collectionName = char
         stop("Must specify a collection name")
     }
 
-    # TODO check if collection exists, turn into an AbundanceData object
-
+    if (!collectionName %in% getCollectionNames(object)) {
+        stop(sprintf("Collection '%s' does not exist", collectionName))
+    }
+
+    abundanceData <- microbiomeComputations::AbundanceData(
+        data = object@collections[[collectionName]][[1]]@data, 
+        sampleMetadata = sampleMetadataBuilder(object@metadata), 
+        recordIdColumn = object@collections[[collectionName]][[1]]@recordIdColumn,
+        ancestorIdColumns = object@collections[[collectionName]][[1]]@ancestorIdColumns
+    )
+
+    return(abundanceData)
 })
 
 #' Get Microbiome Dataset Compute Result
@@ -56,7 +66,7 @@ setMethod("getCollection", "MbioDataset", function(object, collectionName = char
 #' @return The compute result in the specified format
 #' @importFrom microbiomeComputations ComputeResult
 #' @export
-setGeneric("getComputeResult", function(object, format = c("data.table", "igraph")) standardGeneric("getComputeResult"))
+setGeneric("getComputeResult", function(object, format = c("data.table")) standardGeneric("getComputeResult"))
 
 #' @export
 setMethod("getComputeResult", "ComputeResult", function(object, format = c("data.table", "igraph")) {
@@ -83,12 +93,7 @@ setMethod("getComputeResult", "CorrelationResult", function(object, format = c("
 
 #' @importFrom microbiomeComputations DifferentialAbundanceResult
 #' @export
-setMethod("getComputeResult", "DifferentialAbundanceResult", function(object, format = c("data.table", "igraph")) {
+setMethod("getComputeResult", "DifferentialAbundanceResult", function(object, format = c("data.table")) {
     format <- veupathUtils::matchArg(format)
-
-    if (format == "igraph") {
-        stop("igraph not supported for DifferentialAbundanceComputeResult")
-    }
-
     return(object@statistics)
 })

tests/testthat/test-MbioDataset.R

@@ -5,14 +5,14 @@ test_that("we can create a new MbioDataset", {
 
     # a manually populated one
     mbioDataset <- MbioDataset(
-        Collections(list(Collection("my collection", data.frame(entity.id = 1, entity.collection_x = 1, entity.collection_y = 2), "entity.id", "ancestor.y"))), 
+        Collections(list(Collection("my collection", data.frame(entity.id = 1, entity.collection_x = 1, entity.collection_y = 2, ancestor.y = 1), "entity.id", "ancestor.y"))), 
         SampleMetadata()
     )
     expect_s4_class(mbioDataset, "MbioDataset")   
 
     # from a Collection object and SampleMetadata
     mbioDataset <- MbioDataset(
-        Collection("my collection", data.frame(entity.id = 1, entity.collection_x = 1, entity.collection_y = 2), "entity.id", "ancestor.y"), 
+        Collection("my collection", data.frame(entity.id = 1, entity.collection_x = 1, entity.collection_y = 2, ancestor.y = 1), "entity.id", "ancestor.y"), 
         SampleMetadata()
     )
     expect_s4_class(mbioDataset, "MbioDataset")
@@ -50,7 +50,7 @@ test_that("we can create a new MbioDataset", {
 
 test_that("we can update collection names and get collections", {
     mbioDataset <- MbioDataset(
-        Collections("my collection", data.frame(entity.id = 1, entity.collection_x = 1, entity.collection_y = 2), "entity.id"), 
+        Collection("my collection", data.frame(entity.id = 1, entity.collection_x = 1, entity.collection_y = 2, ancestor.y = 1), "entity.id", "ancestor.y"), 
         SampleMetadata()
     )