####################
# Example 1: RGCCA #
####################
# Create the dataset
data(Russett)
blocks <- list(
agriculture = Russett[, seq(3)],
industry = Russett[, 4:5],
politic = Russett[, 6:11]
)
politic <- as.factor(apply(Russett[, 9:11], 1, which.max))
# RGCCA with default values : Blocks are fully connected, factorial scheme
# tau = 1 for all blocks, one component per block.
fit_rgcca <- rgcca(blocks = blocks)
print(fit_rgcca)
plot(fit_rgcca, type = "weight", block = 1:3)
plot(fit_rgcca,
type = "sample", block = 1:2,
comp = rep(1, 2), resp = politic
)
############################################
# Example 2: RGCCA and multiple components #
############################################
# By default rgcca() returns orthogonal block components.
fit_rgcca <- rgcca(blocks,
method = "rgcca",
connection = 1 - diag(3),
superblock = FALSE,
tau = rep(1, 3),
ncomp = c(2, 2, 2),
scheme = "factorial",
comp_orth = TRUE,
verbose = TRUE
)
print(fit_rgcca)
plot(fit_rgcca,
type = "sample", block = 1,
comp = 1:2, resp = politic
)
plot(fit_rgcca, type = "weight",
block = 1:3, display_order = FALSE)
##############################
# Example 3: MCOA with RGCCA #
##############################
fit_rgcca <- rgcca(blocks, method = "mcoa", ncomp = 2)
print(fit_rgcca)
# biplot representation
plot(fit_rgcca, type = "biplot", block = 4, resp = politic)
if (FALSE) {
####################################
# Example 4: RGCCA and permutation #
####################################
# Tune the model to find the best set of tau parameters.
# By default, blocks are fully connected.
set.seed(27) #favorite number
perm_out <- rgcca_permutation(blocks,
n_cores = 1,
par_type = "tau",
n_perms = 50
)
print(perm_out)
plot(perm_out)
# all the parameters were imported from a fitted permutation object
fit_rgcca <- rgcca(perm_out)
print(fit_rgcca)
#######################################
# Example 5: RGCCA and dual algorithm #
#######################################
# Download the dataset's package at http://biodev.cea.fr/sgcca/ and install
# it from the package archive file.
# You can do it with the following R commands:
if (!("gliomaData" %in% rownames(installed.packages()))) {
destfile <- tempfile()
download.file(
"http://biodev.cea.fr/sgcca/gliomaData_0.4.tar.gz", destfile
)
install.packages(destfile, repos = NULL, type = "source")
}
data("ge_cgh_locIGR", package = "gliomaData")
blocks <- ge_cgh_locIGR$multiblocks
Loc <- factor(ge_cgh_locIGR$y)
levels(Loc) <- colnames(ge_cgh_locIGR$multiblocks$y)
blocks[[3]] <- Loc
sapply(blocks, NCOL)
# rgcca algorithm using the dual formulation for X1 and X2
# and the dual formulation for X3. X3 is the group coding matrix associated
# with the qualitative variable Loc. This block is considered
# as response block and specified using the argument response.
fit_rgcca <- rgcca(
blocks = blocks,
response = 3,
method = "rgcca",
tau = c(1, 1, 0),
ncomp = 1,
scheme = function(x) x^2, #factorial scheme,
verbose = TRUE,
)
fit_rgcca$primal_dual
print(fit_rgcca)
###########################################
# Example 6: RGCCA and variable selection #
###########################################
# Variable selection and RGCCA : the sgcca algorithm
fit_sgcca <- rgcca(
blocks = blocks,
method = "sgcca",
response = 3,
sparsity = c(.071, .2, 1), ncomp = 1,
scheme = "factorial", verbose = TRUE,
)
print(fit_sgcca)
############################################
# Example 7: RGCCA, multiple components #
# and different penalties per component #
############################################
# S/RGCCA algorithm with multiple components and different
# penalties for each components (-> sparsity is a matrix)
fit_rgcca <- rgcca(blocks, response = 3,
tau = matrix(c(.5, .5, 0, 1, 1, 0), nrow = 2, byrow = TRUE),
ncomp = c(2, 2, 1), scheme = "factorial")
print(fit_rgcca)
# the same applies for SGCCA
fit_sgcca <- rgcca(blocks, response = 3,
sparsity = matrix(c(.071, 0.2, 1,
0.06, 0.15, 1), nrow = 2, byrow = TRUE),
ncomp = c(2, 2, 1), scheme = "factorial")
print(fit_sgcca)
##################################################
# Example 8: Supervised mode en cross validation #
##################################################
# Prediction of the location from GE and CGH
# Tune sparsity values based on the cross-validated accuracy.
set.seed(27) #favorite number
cv_out <- rgcca_cv(blocks, response = 3,
par_type = "sparsity",
par_length = 10,
ncomp = 1,
prediction_model = "lda",
metric = "Accuracy",
k = 3, n_run = 5,
n_cores = 2)
print(cv_out)
plot(cv_out, display_order = TRUE)
# all the parameters were imported from the fitted cval object.
fit_rgcca <- rgcca(cv_out)
print(fit_rgcca)
}
Run the code above in your browser using DataLab