Batch transformations. #429

R/transformCounts.R

@@ -23,6 +23,11 @@
 #' 
 #' @param name \code{Character scalar}. A name for the column of the 
 #'   \code{colData} where results will be stored. (Default: \code{"method"})
+#'   
+#' @param altexp \code{Character vector} or \code{NULL}. Specifies the names 
+#' of alternative experiments to which the transformation should also be 
+#' applied. If \code{NULL}, the transformation is only applied to the main 
+#' experiment. (Default: \code{NULL}).
 #'
 #' @param ... additional arguments passed on to \code{vegan:decostand}:
 #' \itemize{
@@ -109,97 +114,132 @@
 #' assay(tse, "rank_average", withDimnames = FALSE) <- colRanks(
 #'     assay(tse, "counts"), ties.method = "average", preserveShape = TRUE)  
 #' 
+#' #using altexp parameter
+#' data("GlobalPatterns", package="mia")
+#' tse <- GlobalPatterns
+#' altExp(tse,"species") <- transformAssay(tse, method = "relabundance",rank = "species", na.rm = FALSE)
+#' altExp(tse,"species")
+#' 
 NULL
 
 #' @rdname transformAssay
 #' @export
 setGeneric("transformAssay", signature = c("x"),
-           function(x,
-                    assay.type = "counts", assay_name = NULL,
-                    method = c("alr", "chi.square", "clr", "frequency",
-                               "hellinger", "log", "log10", "log2", "max",
-                               "normalize", "pa", "range", "rank", "rclr",
-                               "relabundance", "rrank", "standardize", "total",
-                               "z"),
-                    MARGIN = "samples",
-                    name = method,
-                    pseudocount = FALSE,		    
-                    ...)
-               standardGeneric("transformAssay"))
+    function(x,  ...)
+    standardGeneric("transformAssay"))
 
 #' @rdname transformAssay
 #' @export
 setMethod("transformAssay", signature = c(x = "SummarizedExperiment"),
     function(x,
-             assay.type = "counts", assay_name = NULL,
-             method = c("alr", "chi.square", "clr", "frequency", "hellinger",
-                        "log", "log10", "log2", "max", "normalize", "pa",
-                        "range", "rank", "rclr", "relabundance", "rrank",
-                        "standardize", "total", "z"),
-             MARGIN = "samples",
-             name = method,
-             pseudocount = FALSE,
-             ...){
-        # Input check
-
-        if (!is.null(assay_name)) {
-            .Deprecated(old="assay_name", new="assay.type", "Now assay_name is deprecated. Use assay.type instead.")
-	    assay.type <- assay_name
-        }
+        assay.type = "counts", assay_name = NULL,
+        method = c("alr", "chi.square", "clr", "css", "css.fast", "frequency", 
+                  "hellinger", "log", "log10", "log2", "max", "normalize", 
+                  "pa", "range", "rank", "rclr", "relabundance", "rrank",
+                  "standardize", "total", "z"),
+        MARGIN = "samples",
+        name = method,
+        pseudocount = FALSE,
+        ...){
+        #
+        x <- .transform_assay(
+            x = x, method = method, name = name, assay.type = assay.type,
+            MARGIN = MARGIN, pseudocount =  pseudocount, ...)
+        return(x)
+    }
+)
 
-        # Check assay.type
-        .check_assay_present(assay.type, x)
+.transform_assay <- function(
+        x, assay.type = "counts", assay_name = NULL,
+        method = c(
+            "alr", "chi.square", "clr", "css", "css.fast", "frequency", 
+            "hellinger", "log", "log10", "log2", "max", "normalize", 
+            "pa", "range", "rank", "rclr", "relabundance", "rrank",
+            "standardize", "total", "z"),
+        MARGIN = "samples",
+        name = method,
+        pseudocount = FALSE,
+        ...){
+    # Input check
+    if (!is.null(assay_name)) {
+        .Deprecated(old="assay_name", new="assay.type", "Now assay_name is 
+                deprecated. Use assay.type instead.")
+        assay.type <- assay_name
+    }
+
+    # Check assay.type
+    .check_assay_present(assay.type, x)
+
+    # Check name
+    if(!.is_non_empty_string(name) ||
+       name == assay.type){
+        stop("'name' must be a non-empty single character value and be ",
+             "different from `assay.type`.",
+             call. = FALSE)
+    }
+    # Check method
+    # If method is not single string, user has not specified transform method,
+    # or has given e.g. a vector
+    if(!.is_non_empty_string(method)){
+        stop("'method' must be a non-empty single character value.",
+             call. = FALSE)
+    }
+    method <- match.arg(method, several.ok = FALSE)
+    # Check that MARGIN is 1 or 2
+    MARGIN <- .check_MARGIN(MARGIN)
+    # Check pseudocount
+    if( !.is_a_bool(pseudocount) && !(is.numeric(pseudocount) && 
+                                      length(pseudocount) == 1 && pseudocount >= 0) ){
+        stop("'pseudocount' must be TRUE, FALSE or a number equal to or 
+                 greater than 0.",
+             call. = FALSE)
+    }
+    # Input check end
+    #
+    # Get the method and abundance table
+    method <- match.arg(method)
+    assay <- assay(x, assay.type)
+
+    # Apply pseudocount, if it is not 0
+    assay <- .apply_pseudocount(assay, pseudocount, ...)
+    # Store pseudocount value and set attr equal to NULL
+    pseudocount <- attr(assay, "pseudocount")
+    attr(assay, "pseudocount") <- NULL
+
+    # Calls help function that does the transformation
+    # Help function is different for mia and vegan transformations
+    if( method %in% c("log10", "log2", "css", "css.fast") ){
+        transformed_table <- .apply_transformation(
+            assay, method, MARGIN, ...)
+    } else {
+        transformed_table <- .apply_transformation_from_vegan(
+            assay, method, MARGIN, ...)
+    }
+
+    # Add pseudocount info to transformed table
+    attr(transformed_table, "parameters")$pseudocount <- pseudocount
+
+    # Assign transformed table to assays
+    assay(x, name, withDimnames=FALSE) <- transformed_table
+    x
+}
 
-        # Check name
-        if(!.is_non_empty_string(name) ||
-           name == assay.type){
-            stop("'name' must be a non-empty single character value and be ",
-                 "different from `assay.type`.",
-                 call. = FALSE)
-        }
-        # Check method
-        # If method is not single string, user has not specified transform method,
-        # or has given e.g. a vector
-        if(!.is_non_empty_string(method)){
-            stop("'method' must be a non-empty single character value.",
-                 call. = FALSE)
-        }
-        method <- match.arg(method, several.ok = FALSE)
-        # Check that MARGIN is 1 or 2
-        MARGIN <- .check_MARGIN(MARGIN)
-        # Check pseudocount
-        if( !.is_a_bool(pseudocount) && !(is.numeric(pseudocount) && length(pseudocount) == 1 && pseudocount >= 0) ){
-            stop("'pseudocount' must be TRUE, FALSE or a number equal to or greater than 0.",
-                 call. = FALSE)
+#' @rdname transformAssay
+#' @export
+setMethod("transformAssay", signature = c(x = "SingleCellExperiment"),
+    function(x, altexp = altExpNames(x), ...){
+        # Check altexp
+        if( !(is.null(altexp) || (!is.null(altexp) && all(altexp %in% altExpNames(x)))) ){
+            stop("Some provided altexp names are not valid.", call. = FALSE)
         }
-        # Input check end
-
-        # Get the method and abundance table
-        method <- match.arg(method)
-        assay <- assay(x, assay.type)
-
-        # Apply pseudocount, if it is not 0
-        assay <- .apply_pseudocount(assay, pseudocount, ...)
-        # Store pseudocount value and set attr equal to NULL
-        pseudocount <- attr(assay, "pseudocount")
-        attr(assay, "pseudocount") <- NULL
-
-        # Calls help function that does the transformation
-        # Help function is different for mia and vegan transformations
-        if( method %in% c("log10", "log2") ){
-            transformed_table <- .apply_transformation(
-                assay, method, MARGIN, ...)
-        } else{
-            transformed_table <- .apply_transformation_from_vegan(
-                assay, method, MARGIN, ...)
+        # Transform the main object
+        x <- .transform_assay(x, ...)
+        if (!is.null(altexp)) {
+            altExps(x)[altexp] <- lapply(altExps(x)[altexp], function(y){
+                .transform_assay(y, ...)
+            })
         }
-
-        # Add pseudocount info to transformed table
-        attr(transformed_table, "parameters")$pseudocount <- pseudocount
-
-        # Assign transformed table to assays
-        assay(x, name, withDimnames=FALSE) <- transformed_table
-        x
+        return(x)
     }
 )
 
@@ -218,7 +258,7 @@ setMethod("transformAssay", signature = c(x = "SummarizedExperiment"),
     # Function is selected based on the "method" variable
     FUN <- switch(method,
                   log10 = .calc_log,
-                   log2 = .calc_log,
+                  log2 = .calc_log,
     )
 
     # Get transformed table
@@ -241,16 +281,15 @@ setMethod("transformAssay", signature = c(x = "SummarizedExperiment"),
 # table as input and returns transformed table. This function utilizes vegan's
 # transformation functions.
 .apply_transformation_from_vegan <- function(mat, method, MARGIN, reference = ref_vals,
-                                            ref_vals = NA, ...){
-    # Input check
-    # Check reference
-    if( length(reference) != 1 ){
-        stop("'reference' must be a single value specifying the ",
-             "values of the reference sample.",
-             call. = FALSE)
+                                            ref_vals = NA, ...) {
+    # Ensure that the matrix has proper dimnames
+    if (is.null(rownames(mat))) {
+        rownames(mat) <- paste0("feature", seq_len(nrow(mat)))
     }
-    # Input check end
-
+    if (is.null(colnames(mat))) {
+        colnames(mat) <- paste0("sample", seq_len(ncol(mat)))
+    }
+
     # Adjust method if mia-specific alias was used
     method <- ifelse(method == "relabundance", "total", method)
 
@@ -268,16 +307,16 @@ setMethod("transformAssay", signature = c(x = "SummarizedExperiment"),
     transformed_table <- vegan::decostand(mat, method = method, MARGIN = MARGIN, ...)
 
     # Add reference sample back if ALR
-    if( method %in% c("alr") ){
+    if (method %in% c("alr")) {
         transformed_table <- .adjust_alr_table(
             mat = transformed_table, orig_dimnames = orig_dimnames,
             reference = reference)
     }
     # If table is transposed (like in chi.square), transpose back
-    if(identical(rownames(transformed_table), colnames(mat)) &&
+    if (identical(rownames(transformed_table), colnames(mat)) &&
        identical(colnames(transformed_table), rownames(mat)) &&
        ncol(transformed_table) != ncol(mat) &&
-       nrow(transformed_table != nrow(mat))){
+       nrow(transformed_table != nrow(mat))) {
         transformed_table <- t(transformed_table)
     }
     return(transformed_table)
@@ -358,6 +397,7 @@ setMethod("transformAssay", signature = c(x = "SummarizedExperiment"),
     return(mat)
 }
 
+
 ###############################.apply_pseudocount###############################
 # This function applies pseudocount to abundance table.
 .apply_pseudocount <- function(mat, pseudocount, na.rm = TRUE, ...){
@@ -372,7 +412,7 @@ setMethod("transformAssay", signature = c(x = "SummarizedExperiment"),
             stop("The assay contains negative values. ",
                  "'pseudocount' must be specified manually.", call. = FALSE)
         }
-        # If pseudocount TRUE, set it to  half of non-zero minimum value
+        # If pseudocount TRUE, set it to half of non-zero minimum value
         # else set it to zero.
         # Get min value
         value <- min(mat[mat > 0], na.rm = na.rm)