Mercurial > repos > iuc > rgcca
diff launcher.R @ 1:4e73ea176c34 draft default tip
"planemo upload for repository https://github.com/galaxyproject/tools-iuc/tree/master/tools/rgcca commit ce05b5eb018ae1c4d580ab5ce1a33896c1aa8c5b"
author | iuc |
---|---|
date | Sun, 18 Jul 2021 18:03:12 +0000 |
parents | 067d45e6caa9 |
children |
line wrap: on
line diff
--- a/launcher.R Tue Jan 12 10:12:04 2021 +0000 +++ b/launcher.R Sun Jul 18 18:03:12 2021 +0000 @@ -1,6 +1,8 @@ +#!/usr/bin/env Rscript + # Author: Etienne CAMENEN -# Date: 2020 -# Contact: arthur.tenenhaus@centralesupelec.fr +# Date: 2021 +# Contact: etienne.camenen@gmail.com # Key-words: omics, RGCCA, multi-block # EDAM operation: analysis, correlation, visualisation # @@ -74,11 +76,12 @@ 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)" + 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", @@ -245,10 +248,6 @@ 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 @@ -318,71 +317,6 @@ 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 @@ -411,7 +345,12 @@ collapse = ",") ) -load_libraries(c("ggplot2", "optparse", "scales", "igraph", "MASS", "rlang", "Deriv")) +# 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( @@ -423,16 +362,17 @@ 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)) +cex_lab <- 20 +cex_main <- 25 +cex_point <- 3 +cex_sub <- 20 +cex_axis <- 10 +cex <- 1.25 status <- 0 tryCatch({ @@ -450,7 +390,7 @@ ncomp = opt$ncomp, scheme = opt$scheme, scale = opt$scale, - type = opt$type + method = opt$type ) ) if (tolower(opt$type) %in% c("sgcca", "spca", "spls")) { @@ -477,7 +417,11 @@ opt$block, opt$text, opt$block_y, - "Response" + "Response", + cex_lab = cex_lab, + cex_point = cex_point, + cex_main = cex_main, + cex = cex ) ) save_plot(opt$o1, individual_plot) @@ -491,7 +435,11 @@ opt$compy, opt$block, opt$text, - n_mark = opt$nmark + n_mark = opt$nmark, + cex_lab = cex_lab, + cex_point = cex_point, + cex_main = cex_main, + cex = cex ) ) save_plot(opt$o2, corcircle) @@ -502,20 +450,34 @@ opt$compx, opt$nmark, opt$block, - type = "cor" + 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)) + (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) + 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$compx, opt$compy, opt$o6) - save_var(rgcca_out, opt$compx, opt$compy, opt$o7) + save_ind(rgcca_out, opt$o6) + save_var(rgcca_out, opt$o7) save(rgcca_out, file = opt$o8) }, error = function(e) { @@ -523,6 +485,10 @@ 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)