R/run_DAF_analysis.R

In LeoStafu/metaDAF: Metagenomics tools for detecting Differentially Abundant Features

#' Run differentially abundant features analysis.
#'
#' Call a specific processing function depending on the method chosen. Input data
#' are generated by the \code{\link{build_DAF_data}} function.
#'
#' @param data a list. the returned object of the \code{\link{build_DAF_data}} function
#' @param method The name of the method to use for DAF detection. Any unambiguous
#' abbreviation of "deseq2", "mbzinb", "zibseq", "raida", "aldex2", "metagenomeseq",
#' "edger", "voom" or "wilcox". Default is "deseq2".
#' @param verbose logical. Should processing function display all of their messages
#' @param ... additional parameters to be passed to the processing function.
#'
#' @details The function will first assess if the input data is a single dataset
#' or a list of several of them. Then it will check is one or more methods are called.
#' Based on these information, several kind of analysis are performed : a simple one,
#' a repeated one (focus on one method and average results), a compared one (multiple
#' methods called one time) or a compared and repeated one (several methods, several times).
#'
#' @return Data frame containing the pvalue and the adjusted pvalue (BH)
#' of the differential analysis as well as the names of methods and number of runs.
#'
#' @export

run_DAF_analysis <- function(data, method = c("deseq2", "mbzinb", "zibseq",
                                            "raida", "aldex2", "metagenomeseq",
                                            "edger", "voom", "wilcox"),
                             verbose = FALSE,  ...) {

    method <- match.arg(method, several.ok = TRUE)
    # If data is a nested list, then repeated analysis
    repeat_analysis <- all(sapply(data, is.list))

    compare <- length(method) >= 2
    # 4 possibilities of loop in analysis

    # TODO : add later
    #data <- preprocess_DAF_data(data)

    if (repeat_analysis) {
        if(compare) {
            res <- run_DAF_repeat_compare(data, method, verbose, ...)
        } else {
            res <- run_DAF_repeat(data, method, verbose, ...)
        }
    } else {
        if (compare) {
            res <- run_DAF_compare(data, method, verbose, ...)
        } else {
            # simple analysis
            try_res <- try({
                process_fun <- select_process(method)
                if (verbose) {
                    res <- process_fun(data, ...)
                }else{
                    suppressMessages( res <- process_fun(data, ...) )
                }
                colnames(res$curated) <- c("pvalue", "adjusted_pvalue")
                #
                # add the same line in all run types
                res$curated$feat_name <- rownames(res$curated)
                #
                #
                res$curated$true_DAF <- rownames(res$curated) %in% data$true_DAF
                res$curated$method <- method
                res$curated$run <- "run1"
            }, silent = T)
            if (class(try_res) == "try-error"){
                res <- "ERROR"
            }
        }
    }
    # res$curated <- na.omit(res$curated)
    return(res)
}



# -------------------------------------------------------------------

run_DAF_compare <- function(data, method, verbose, ...) {

    res <- NULL

    for (m in method) {
        cat("Run of", m, "analysis")
        try_res <- try({
            process_fun <- select_process(m)
            if (verbose) {
                res_tmp <- process_fun(data, ...)
            }else{
                suppressMessages(invisible(capture.output(
                    res_tmp <- process_fun(data, ...)
                )))
            }
            colnames(res_tmp$curated) <- c("pvalue", "adjusted_pvalue")
            res_tmp$curated$true_DAF <- rownames(res_tmp$curated) %in%
                data$true_DAF
            res_tmp$curated$method <- m
            res_tmp$curated$feat_name <- rownames(res_tmp$curated)
            res <- rbind(res, res_tmp$curated)
        }, silent = T)
        cat(" - Done \n")
    }

    return(res)
}


# -------------------------------------------------------------------

run_DAF_repeat <- function(data, method, verbose, ...) {

    res <- NULL
    process_fun <- select_process(method)
    try_res <- try({
        for (i in 1:length(data)) {
            cat("Run n", i, "of", method, "analysis")
            if (verbose) {
                res_tmp <- process_fun(data[[i]], ...)
            }else{
                suppressMessages(invisible(capture.output(
                    res_tmp <- process_fun(data[[i]], ...)
                )))
            }
            colnames(res_tmp$curated) <- c("pvalue", "adjusted_pvalue")
            res_tmp$curated$true_DAF <- rownames(res_tmp$curated) %in%
                data[[i]]$true_DAF
            res_tmp$curated$run <- paste0("run", as.character(i))
            res_tmp$curated$method <- method
            res_tmp$curated$feat_name <- rownames(res_tmp$curated)
            res <- rbind(res, res_tmp$curated)
            cat(" - Done \n")
        }
    }, silent = T)

    if (class(try_res) == "try-error") {
        return(NULL)
    }
    return(res)
}


# -------------------------------------------------------------------


run_DAF_repeat_compare <- function(data, method, verbose, ...) {

    res <- NULL

    for (m in method) {
        cat("Analysis using method :", m, " \n")
        process_fun <- select_process(m)
        try_res <- try({
            for (i in 1:length(data)) {

                cat("Run n", i)
                if (verbose) {
                    res_tmp <- process_fun(data[[i]], ...)
                } else {
                    suppressMessages(invisible(capture.output(
                        res_tmp <- process_fun(data[[i]], ...)
                    )))
                }
                colnames(res_tmp$curated) <- c("pvalue", "adjusted_pvalue")
                res_tmp$curated$true_DAF <- rownames(res_tmp$curated) %in%
                    data[[i]]$true_DAF
                res_tmp$curated$run <- paste0("run", as.character(i))
                res_tmp$curated$method <- m
                res_tmp$curated$feat_name <- rownames(res_tmp$curated)
                res <- rbind(res, res_tmp$curated)
                cat(" - Done \n")
            }
        }, silent = T)
    }
    return(res)

}