addMDS and getMDS (#689)

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: mia
 Type: Package
-Version: 1.15.21
+Version: 1.15.22
 Authors@R:
     c(person(given = "Tuomas", family = "Borman", role = c("aut", "cre"),
              email = "[email protected]",

NAMESPACE

@@ -14,6 +14,7 @@ export(addDivergence)
 export(addDominant)
 export(addHierarchyTree)
 export(addLDA)
+export(addMDS)
 export(addMediation)
 export(addNMDS)
 export(addNMF)
@@ -70,6 +71,7 @@ export(getExperimentCrossCorrelation)
 export(getHierarchyTree)
 export(getLDA)
 export(getLowAbundant)
+export(getMDS)
 export(getMediation)
 export(getNMDS)
 export(getNMF)
@@ -177,6 +179,7 @@ exportMethods(addDivergence)
 exportMethods(addDominant)
 exportMethods(addHierarchyTree)
 exportMethods(addLDA)
+exportMethods(addMDS)
 exportMethods(addMediation)
 exportMethods(addNMF)
 exportMethods(addNotContaminantQC)
@@ -226,6 +229,7 @@ exportMethods(getExperimentCrossCorrelation)
 exportMethods(getHierarchyTree)
 exportMethods(getLDA)
 exportMethods(getLowAbundant)
+exportMethods(getMDS)
 exportMethods(getMediation)
 exportMethods(getNMDS)
 exportMethods(getNMF)
@@ -407,6 +411,7 @@ importFrom(dplyr,tally)
 importFrom(rbiom,unifrac)
 importFrom(rlang,":=")
 importFrom(rlang,sym)
+importFrom(scater,calculateMDS)
 importFrom(scuttle,sumCountsAcrossFeatures)
 importFrom(stats,TukeyHSD)
 importFrom(stats,anova)

NEWS

@@ -167,3 +167,4 @@ Changes in version 1.15.x
 + Added support for dimred to getCrossAssociation
 + Add wrapper for PhILR transformation
 + Support rarefaction when applying unifrac
++ Added getMDS and addMDS: wrappers for scater::calculateMDS and scater::runMDS

R/AllGenerics.R

@@ -381,3 +381,13 @@ setGeneric("addAbundanceClass", signature = "x", function(x, ...)
 #' @export
 setGeneric("addPrevalence", signature = "x", function(x, ...)
     standardGeneric("addPrevalence"))
+
+#' @rdname addMDS
+#' @export
+setGeneric("getMDS", signature = "x", function(x, ...)
+    standardGeneric("getMDS"))
+
+#' @rdname addMDS
+#' @export
+setGeneric("addMDS", signature = "x", function(x, ...)
+    standardGeneric("addMDS"))

R/addDissimilarity.R

@@ -154,8 +154,7 @@
 #' metadata(tse)[["jsd"]][1:6, 1:6]
 #'
 #' # Multi Dimensional Scaling applied to JSD dissimilarity matrix
-#' tse <- runMDS(
-#'     tse, FUN = getDissimilarity, method = "overlap", assay.type = "counts")
+#' tse <- addMDS(tse, method = "overlap", assay.type = "counts")
 #' reducedDim(tse, "MDS") |> head()
 #'
 #' ### Unifrac dissimilarity

R/getCrossAssociation.R

@@ -254,8 +254,7 @@
 #' # To calculate correlation of features to principal coordinates, you have to
 #' # first calculate PCoA...
 #' library(scater)
-#' tse <- runMDS(
-#'     tse, assay.type = "rclr", FUN = getDissimilarity, method = "euclidean")
+#' tse <- addMDS(tse, assay.type = "rclr", method = "euclidean")
 #' # ...then calculate the correlation.
 #' res <- getCrossAssociation(tse, assay.type1 = "rclr", dimred2 = "MDS")
 #' head(res)

R/getMDS.R

@@ -0,0 +1,143 @@
+#' @name
+#' addMDS
+#'
+#' @title
+#' Perform multi-dimensional scaling (MDS)
+#'
+#' @description
+#' Perform multi-dimensional scaling (MDS) also know as Principal Coordinate
+#' Analysis (PCoA). These functions are wrappers for
+#' \code{\link[scater:runMDS]{scater::calculateMDS}}.
+#'
+#' @details
+#' These functions are wrappers for
+#' \code{\link[scater:runMDS]{scater::calculateMDS}} and
+#' \code{\link[scater:runMDS]{scater::runMDS}}. While \code{getMDS}
+#' returns the results, \code{addMDS} adds them to \code{reducedDim(x)}. The
+#' difference is that these functions apply microbiome-specific options such
+#' as \code{getDissimilarity} function by default.
+#'
+#' See \code{\link[scater:runMDS]{scater::calculateMDS}} for details.
+#'
+#' @return
+#' \code{getMDS} returns a MDS results.
+#' \code{addMDS} returns a \code{x} with MDS results added to its
+#' \code{reducedDim(x, name)}.
+#'
+#' @inheritParams addAlpha
+#'
+#' @param assay.type \code{Character scalar}. Specifies the name of assay
+#' used in calculation. (Default: \code{"counts"})
+#'
+#' @param name \code{Character scalar}. A name for the \code{reducedDim()}
+#' where results will be stored. (Default: \code{"MDS"})
+#'
+#' @param ... additional arguments.
+#' \itemize{
+#'     \item \code{FUN}: \code{Function}. A function that is applied to
+#'     calculate dissimilarity. (Default: \code{getDissimilarity})
+#'
+#'     \item \code{subset.result}: \code{Logical result}. Specifies whether to
+#'     subset \code{x} to match the result if some samples were removed during
+#'     calculation. (Default: \code{TRUE})
+#' }
+#'
+#' @examples
+#' library(mia)
+#' library(scater)
+#' library(patchwork)
+#'
+#' data(GlobalPatterns)
+#' tse <- GlobalPatterns
+#'
+#' # Calculate PCoA with Bray-Curtis dissimilarity
+#' tse <- transformAssay(tse, method = "relabundance")
+#' tse <- addMDS(tse, assay.type = "relabundance", method = "bray")
+#'
+#' # Calculate PCoA with Unifrac and rarefaction. (Note: increase iterations)
+#' tse <- addMDS(tse, method = "unifrac", name = "unifrac")
+#'
+#' # Calculate PCoA with Unifrac and rarefaction. (Note: increase iterations)
+#' tse <- addMDS(tse, method = "unifrac", name = "unifrac_rare", niter = 2L)
+#'
+#' # Visualize results
+#' p1 <- plotReducedDim(tse, "unifrac", colour_by = "SampleType") +
+#'     labs(title = "Not rarefied")
+#' p2 <- plotReducedDim(tse, "unifrac_rare", colour_by = "SampleType") +
+#'     labs(title = "Rarefied")
+#' p1 + p2
+#'
+#' @seealso
+#' \code{\link[scater:runMDS]{scater::calculateMDS}} and
+#' \code{\link[=getDissimilarity]{getDissimilarity}}
+#'
+#'
+NULL
+
+#' @rdname addMDS
+#' @export
+setMethod("addMDS", signature = c(x = "SingleCellExperiment"),
+    function(x, name = "MDS", ...){
+        if( !.is_a_string(name) ){
+            stop("'name' must be a single character value.", call. = FALSE)
+        }
+        # Hiddenly support altExp
+        x <- .check_and_get_altExp(x, ...)
+        # Calculate indices
+        args <- c(list(x = x), list(...))
+        args <- args[ !names(args) %in% c("altexp") ]
+        res <- do.call(getMDS, args)
+        # Add object to reducedDim
+        x <- .add_object_to_reduceddim(x, res, name = name, ...)
+        return(x)
+    }
+)
+
+#' @rdname addMDS
+#' @export
+#' @importFrom scater calculateMDS
+setMethod("getMDS", signature = c(x = "SingleCellExperiment"),
+    function(x, assay.type = "counts", ...){
+        .check_assay_present(assay.type, x)
+        args <- .get_mds_args(x, assay.type = assay.type, ...)
+        res <- do.call(calculateMDS, args)
+        return(res)
+    }
+)
+
+#' @rdname addMDS
+#' @export
+#' @importFrom scater calculateMDS
+setMethod("getMDS", signature = c(x = "TreeSummarizedExperiment"),
+    function(x, assay.type = "counts", ...){
+        .check_assay_present(assay.type, x)
+        args <- .get_mds_args_treese(x, assay.type = assay.type, ...)
+        res <- do.call(calculateMDS, args)
+        return(res)
+    }
+)
+
+################################ HELP FUNCTIONS ################################
+
+# This function is used to set default options for SCE
+.get_mds_args <- function(x, assay.type, FUN = getDissimilarity, ...){
+    args <- c(list(x = x, assay.type = assay.type, FUN = FUN), list(...))
+    return(args)
+}
+
+# For TreeSE, we also feed rowTree and node.labels as default
+.get_mds_args_treese <- function(
+        x, tree.name = "phylo", tree = NULL, node.label = NULL, ...){
+    # Get tree and corresponding node.labels
+    if( is.null(tree) ){
+        tree <- rowTree(x, tree.name)
+    }
+    if( is.null(node.label) ){
+        node.labels <- rowLinks(x)
+        node.labels <- node.labels[
+            node.labels[["whichTree"]] %in% tree.name, "nodeLab"]
+    }
+    #
+    args <- c(.get_mds_args(x, ...), list(tree = tree, node.label = node.label))
+    return(args)
+}

R/mediate.R

@@ -142,9 +142,9 @@
 #' head(metadata(tse)$assay_mediation, 5)
 #'
 #' # Perform ordination
-#' tse <- runMDS(
-#'     tse, name = "MDS", method = "euclidean",
-#'     assay.type = "clr", ncomponents = 3)
+#' tse <- addMDS(
+#'     tse, name = "MDS", method = "euclidean", assay.type = "clr",
+#'     ncomponents = 3)
 #'
 #' # Analyse mediated effect of nationality on BMI via NMDS components
 #' # 100 permutations were done to speed up execution, but ~1000 are recommended