diff --git a/R/format_output.R b/R/format_output.R index b1e77f10..1bb20516 100644 --- a/R/format_output.R +++ b/R/format_output.R @@ -65,15 +65,15 @@ format_output <- function(func_out, rgcca_args, opt, blocks) { names(func_out$a) <- names(blocks) names(func_out$Y) <- names(blocks) - is_optimal <- any(rgcca_args[[opt$par]] == "optimal") + is_optimal <- any(rgcca_args[[opt$param]] == "optimal") func_out[["optimal"]] <- is_optimal if (is_optimal) { - rgcca_args[[opt$par]] <- func_out$tau + rgcca_args[[opt$param]] <- func_out$tau } - if (NCOL(rgcca_args[[opt$par]]) > 1) { - colnames(rgcca_args[[opt$par]]) <- names(blocks) + if (NCOL(rgcca_args[[opt$param]]) > 1) { + colnames(rgcca_args[[opt$param]]) <- names(blocks) } if (!is.null(func_out$tau)) { diff --git a/R/netsgcca.R b/R/netsgcca.R index a0f987d6..ba2e1466 100644 --- a/R/netsgcca.R +++ b/R/netsgcca.R @@ -38,7 +38,7 @@ netsgcca <- function(blocks, connection = 1 - diag(length(blocks)), sparsity = rep(1, length(blocks)), - lambda = rep(1, length(A)), + lambda = rep(1, length(blocks)), graph_laplacians, ncomp = rep(1, length(blocks)), scheme = "centroid", init = "svd", bias = TRUE, tol = .Machine$double.eps, diff --git a/R/rgcca.R b/R/rgcca.R index 15728ec9..ad04e72a 100644 --- a/R/rgcca.R +++ b/R/rgcca.R @@ -444,7 +444,7 @@ rgcca <- function(blocks, connection = NULL, tau = 1, ncomp = 1, warning("Argument C is deprecated, use connection instead.") connection <- C } - + rgcca_args <- as.list(environment()) ### If specific objects are given for blocks, parameters are imported from # these objects. @@ -453,15 +453,15 @@ rgcca <- function(blocks, connection = NULL, tau = 1, ncomp = 1, rgcca_args <- tmp$rgcca_args rgcca_args$quiet <- quiet rgcca_args$verbose <- verbose - + blocks <- remove_null_sd(rgcca_args$blocks)$list_m - + if (opt$disjunction) { blocks[[rgcca_args$response]] <- as_disjunctive( blocks[[rgcca_args$response]] ) } - + ### Apply strategy to deal with NA, scale and prepare superblock tmp <- handle_NA(blocks, NA_method = rgcca_args$NA_method) na.rm <- tmp$na.rm @@ -477,7 +477,7 @@ rgcca <- function(blocks, connection = NULL, tau = 1, ncomp = 1, "s-", colnames(blocks[["superblock"]]) ) } - + ### Call the gcca function gcca_args <- rgcca_args[c( "connection", "ncomp", "scheme", "init", "bias", "tol", @@ -487,14 +487,12 @@ rgcca <- function(blocks, connection = NULL, tau = 1, ncomp = 1, gcca_args[["blocks"]] <- blocks gcca_args[["disjunction"]] <- opt$disjunction gcca_args[[opt$param]] <- rgcca_args[[opt$param]] - if (method == "netsgcca") { - gcca_args <- modifyList(gcca_args, rgcca_args[c("lambda", "graph_laplacians")]) - } + gcca_args <- modifyList(gcca_args, opt$supplementary_parameters) func_out <- do.call(opt$gcca, gcca_args) - + ### Format the output func_out <- format_output(func_out, rgcca_args, opt, blocks) - + class(func_out) <- "rgcca" invisible(func_out) }