Batch transformations. #429

[ake123]

Batch transformations. #429

[TuomasBorman]

I think this is too complex, instead you could consider own method for SingleCellExperiment. Something like this

SCE_method <- function(x, altexp = altExpNames(tse), ...){
# Check that specified altexps are found from x
# Check that assay.type are found from specified altexps
lapply(altExps(x)[altexp], .check_assay_present)
# Apply transformation to x
x <- .perform_transformation(x)
# If altexp is not NULL, apply transformation to altexps
altExps(x)[altexp] <- bplapply(altExps(x)[altexp], ...)
}

SE_method <- function(){
# Input checks
# Apply transformation
x <- .perform_transformation(x)
}

[antagomir]

I agree that direct support for SCE is probably the way to go when altExps are supported.

This in the above example mixes concepts: altexp = reducedDimanames(tse)? Should it be altexp = altExpNames(tse)?

[TuomasBorman]

I agree that direct support for SCE is probably the way to go when altExps are supported.

This in the above example mixes concepts: altexp = reducedDimanames(tse)? Should it be altexp = altExpNames(tse)?

Yep, I fixed the comment

[codecov]

Codecov Report

Attention: Patch coverage is 89.23077% with 7 lines in your changes missing coverage. Please review.

Please upload report for BASE (devel@3f3b968). Learn more about missing BASE report.

Files with missing lines	Patch %	Lines
R/transformCounts.R	89.23%	7 Missing ⚠️

Additional details and impacted files

@@           Coverage Diff            @@
##             devel     #618   +/-   ##
========================================
  Coverage         ?   67.77%           
========================================
  Files            ?       44           
  Lines            ?     5366           
  Branches         ?        0           
========================================
  Hits             ?     3637           
  Misses           ?     1729           
  Partials         ?        0           

Flag	Coverage Δ
	67.77% <89.23%> (?)

Flags with carried forward coverage won't be shown. Click here to find out more.

☔ View full report in Codecov by Sentry.
📢 Have feedback on the report? Share it here.

[antagomir]

Status of this one?

[ake123]

rewriting and debugging it as suggested

[TuomasBorman]

Can you revert the already made modifications? Something like this creates a good start point

#' @rdname transformAssay
#' @export
setGeneric("transformAssay", signature = c("x"),
    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", "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)
    }
)

.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
}

#' @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(".", call. = FALSE)
        }
        browser()
        # Transform the main object
        x <- .transform_assay(x, ...)
        altExps(x)[altexp] <- lapply(altExps(x)[altexp], function(y){
            .transform_assay(y, ...)
        })
        return(x)
    }
)

[TuomasBorman]

Can you still add unit tests, that altexp works as expected?