comparison launcher.R @ 1:4e73ea176c34 draft default tip

"planemo upload for repository https://github.com/galaxyproject/tools-iuc/tree/master/tools/rgcca commit ce05b5eb018ae1c4d580ab5ce1a33896c1aa8c5b"

0:067d45e6caa9

# Author: Etienne CAMENEN
# Date: 2020
# Contact: [e-mail]
# Key-words: omics, RGCCA, multi-block
# EDAM operation: analysis, correlation, visualisation
#
# Abstract: Performs multi-variate analysis (PCA, CCA, PLS, R/SGCCA, etc.)
# and produces textual and graphical outputs (e.g. variables and individuals

        make_option(
            opt_str = "--type",
            type = "character",
            metavar = "character",
            default = opt[2],
            help = "Type of analysis [default: %default] (among: rgcca, pca,
            cca, gcca, cpca-w, hpca, maxbet-b, maxbet, maxdiff-b, maxdiff,
            maxvar-a, maxvar-b, maxvar, niles, r-maxvar, rcon-pca, ridge-gca,
            sabscor, ssqcor, ssqcor, ssqcov-1, ssqcov-2, ssqcov, sum-pca,
            sumcor, sumcov-1, sumcov-2, sumcov)"
        ),
        make_option(
            opt_str = "--ncomp",
            type = "character",
            metavar = "integer list",

        )
    )
    return(optparse::OptionParser(option_list = option_list))
}

char_to_list <- function(x) {
    strsplit(gsub(" ", "", as.character(x)), ",")[[1]]
}

check_arg <- function(opt) {
    # Check the validity of the arguments opt : an optionParser object

    if (is.null(opt$datasets))
        stop_rgcca(paste0("datasets is required."), exit_code = 121)

    for (x in c("compx", "compy"))
        opt[[x]] <- check_compx(x, opt[[x]], rgcca$call$ncomp, opt$block)

    return(opt)
}

check_integer <- function(x, y = x, type = "scalar", float = FALSE, min = 1) {

    if (is.null(y))
        y <- x

    if (type %in% c("matrix", "data.frame"))
        y_temp <- y

    y <- suppressWarnings(as.double(as.matrix(y)))

    if (any(is.na(y)))
        stop_rgcca(paste(x, "should not be NA."))

    if (!is(y, "numeric"))
        stop_rgcca(paste(x, "should be numeric."))

    if (type == "scalar" && length(y) != 1)
        stop_rgcca(paste(x, "should be of length 1."))

    if (!float)
        y <- as.integer(y)

    if (all(y < min))
        stop_rgcca(paste0(x, " should be higher than or equal to ", min, "."))

    if (type %in% c("matrix", "data.frame"))
        y <- matrix(
            y,
            dim(y_temp)[1],
            dim(y_temp)[2],
            dimnames = dimnames(y_temp)
        )

    if (type == "data.frame")
        as.data.frame(y)

    return(y)
}

load_libraries <- function(librairies) {
    for (l in librairies) {
        if (!(l %in% installed.packages()[, "Package"]))
            utils::install.packages(l, repos = "cran.us.r-project.org")
        suppressPackageStartupMessages(
            library(
                l,
                character.only = TRUE,
                warn.conflicts = FALSE,
                quietly = TRUE
        ))
    }
}

stop_rgcca <- function(
    message,
    exit_code = "1",
    call = NULL) {

    base::stop(
        structure(
            class = c(exit_code, "simpleError", "error", "condition"),
            list(message = message, call. = NULL)
    ))
 }

########## Main ##########

# Get arguments : R packaging install, need an opt variable with associated
# arguments

        c("agriculture", "industry", "politic"),
        ".tsv",
        collapse = ",")
)

load_libraries(c("ggplot2", "optparse", "scales", "igraph", "MASS", "rlang", "Deriv"))
try(load_libraries("ggrepel"), silent = TRUE)

tryCatch(
    opt <- check_arg(optparse::parse_args(get_args())),
    error = function(e) {

            stop_rgcca(e[[1]], exit_code = 140)
    }, warning = function(w)
        stop_rgcca(w[[1]], exit_code = 141)
)

# Load functions
all_funcs <- unclass(lsf.str(envir = asNamespace("RGCCA"), all = T))
for (i in all_funcs)
    eval(parse(text = paste0(i, "<-RGCCA:::", i)))

# Set missing parameters by default
opt$header <- !("header" %in% names(opt))
opt$superblock <- !("superblock" %in% names(opt))
opt$scale <- !("scale" %in% names(opt))
opt$text <- !("text" %in% names(opt))

status <- 0
tryCatch({

    blocks <- load_blocks(opt$datasets, opt$names, opt$separator)

            response = opt$response,
            superblock = opt$superblock,
            ncomp = opt$ncomp,
            scheme = opt$scheme,
            scale = opt$scale,
            type = opt$type
        )
    )
    if (tolower(opt$type) %in% c("sgcca", "spca", "spls")) {
        func[["sparsity"]] <- opt$penalty
    }else {

                opt$compx,
                opt$compy,
                opt$block,
                opt$text,
                opt$block_y,
                "Response"
            )
        )
        save_plot(opt$o1, individual_plot)
    }

                rgcca_out,
                opt$compx,
                opt$compy,
                opt$block,
                opt$text,
                n_mark = opt$nmark
            )
        )
        save_plot(opt$o2, corcircle)
    }

    top_variables <- plot_var_1D(
            rgcca_out,
            opt$compx,
            opt$nmark,
            opt$block,
            type = "cor"
        )
    save_plot(opt$o3, top_variables)

    # Average Variance Explained
    (ave <- plot_ave(rgcca_out))
    save_plot(opt$o4, ave)

    # Creates design scheme
    design <- function() plot_network(rgcca_out)
    save_plot(opt$o5, design)

    save_ind(rgcca_out, opt$compx, opt$compy, opt$o6)
    save_var(rgcca_out, opt$compx, opt$compy, opt$o7)
    save(rgcca_out, file = opt$o8)

    }, error = function(e) {
        if (class(e)[1] %in% c("simpleError", "error", "condition"))
            status <<- 1
        else
            status <<- class(e)[1]
        message(e$message)
})
quit(status = status)

1:4e73ea176c34

#!/usr/bin/env Rscript

# Author: Etienne CAMENEN
# Date: 2021
# Contact: [e-mail]
# Key-words: omics, RGCCA, multi-block
# EDAM operation: analysis, correlation, visualisation
#
# Abstract: Performs multi-variate analysis (PCA, CCA, PLS, R/SGCCA, etc.)
# and produces textual and graphical outputs (e.g. variables and individuals

        make_option(
            opt_str = "--type",
            type = "character",
            metavar = "character",
            default = opt[2],
            help = "Type of analysis [default: %default] (among: rgcca, sgcca,
            pca, spca, pls, spls, cca, ifa, ra, gcca, maxvar, maxvar-b,
            maxvar-a, mcoa,cpca-1, cpca-2, cpca-4, hpca, maxbet-b, maxbet,
            maxdiff-b, maxdiff, maxvar-a, sabscor, ssqcor, ssqcov-1, ssqcov-2,
            ssqcov, sumcor, sumcov-1, sumcov-2, sumcov, sabscov, sabscov-1,
            sabscov-2)"
        ),
        make_option(
            opt_str = "--ncomp",
            type = "character",
            metavar = "integer list",

        )
    )
    return(optparse::OptionParser(option_list = option_list))
}

check_arg <- function(opt) {
    # Check the validity of the arguments opt : an optionParser object

    if (is.null(opt$datasets))
        stop_rgcca(paste0("datasets is required."), exit_code = 121)

    for (x in c("compx", "compy"))
        opt[[x]] <- check_compx(x, opt[[x]], rgcca$call$ncomp, opt$block)

    return(opt)
}

########## Main ##########

# Get arguments : R packaging install, need an opt variable with associated
# arguments

        c("agriculture", "industry", "politic"),
        ".tsv",
        collapse = ",")
)

# Load functions
all_funcs <- unclass(lsf.str(envir = asNamespace("RGCCA"), all = TRUE))
for (i in all_funcs)
    eval(parse(text = paste0(i, "<-RGCCA:::", i)))

load_libraries(c("ggplot2", "optparse", "scales", "igraph", "MASS", "Deriv"))
try(load_libraries("ggrepel"), silent = TRUE)

tryCatch(
    opt <- check_arg(optparse::parse_args(get_args())),
    error = function(e) {

            stop_rgcca(e[[1]], exit_code = 140)
    }, warning = function(w)
        stop_rgcca(w[[1]], exit_code = 141)
)

# Set missing parameters by default
opt$header <- !("header" %in% names(opt))
opt$superblock <- !("superblock" %in% names(opt))
opt$scale <- !("scale" %in% names(opt))
opt$text <- !("text" %in% names(opt))
cex_lab <- 20
cex_main <- 25
cex_point <- 3
cex_sub <- 20
cex_axis <- 10
cex <- 1.25

status <- 0
tryCatch({

    blocks <- load_blocks(opt$datasets, opt$names, opt$separator)

            response = opt$response,
            superblock = opt$superblock,
            ncomp = opt$ncomp,
            scheme = opt$scheme,
            scale = opt$scale,
            method = opt$type
        )
    )
    if (tolower(opt$type) %in% c("sgcca", "spca", "spls")) {
        func[["sparsity"]] <- opt$penalty
    }else {

                opt$compx,
                opt$compy,
                opt$block,
                opt$text,
                opt$block_y,
                "Response",
                cex_lab = cex_lab,
                cex_point = cex_point,
                cex_main = cex_main,
                cex = cex
            )
        )
        save_plot(opt$o1, individual_plot)
    }

                rgcca_out,
                opt$compx,
                opt$compy,
                opt$block,
                opt$text,
                n_mark = opt$nmark,
                cex_lab = cex_lab,
                cex_point = cex_point,
                cex_main = cex_main,
                cex = cex
            )
        )
        save_plot(opt$o2, corcircle)
    }

    top_variables <- plot_var_1D(
            rgcca_out,
            opt$compx,
            opt$nmark,
            opt$block,
            type = "loadings",
            title = paste0("Variable correlations", ": ", names(rgcca_out$call$blocks)[opt$block], " with "),
            cex_sub = cex_sub,
            cex_main = cex_main,
            cex_axis = cex_axis,
            cex = cex
        )
    save_plot(opt$o3, top_variables)

    # Average Variance Explained
    (ave <- plot_ave(
        rgcca_out,
        cex_main = cex_main,
        cex_sub = cex_sub,
        cex_axis = cex_axis,
        cex = cex))
    save_plot(opt$o4, ave)

    # Creates design scheme
    design <- function() plot_network(
        rgcca_out,
        cex_main = cex_main,
        cex_point = cex_point,
        cex = cex)
    save_plot(opt$o5, design)

    save_ind(rgcca_out, opt$o6)
    save_var(rgcca_out, opt$o7)
    save(rgcca_out, file = opt$o8)

    }, error = function(e) {
        if (class(e)[1] %in% c("simpleError", "error", "condition"))
            status <<- 1
        else
            status <<- class(e)[1]
        msg <- "The design matrix C"
        if (grepl(msg, e$message)) {
            e$message <- gsub(msg, "The connection file", e$message)
        }
        message(e$message)
})
quit(status = status)