####################################
# Permutation based strategy for #
# determining the best shrinkage #
# parameters (par_type = "tau") #
####################################
data(Russett)
blocks <- list(
agriculture = Russett[, seq(3)],
industry = Russett[, 4:5],
politic = Russett[, 6:11]
)
C <- matrix(c(
0, 0, 1,
0, 0, 1,
1, 1, 0
), 3, 3)
# default value: 10 vectors from rep(0, length(blocks))
# to rep(1, length(blocks)), uniformly distributed.
fit <- rgcca_permutation(blocks,
connection = C,
par_type = "tau",
par_length = 10, n_perms = 2,
n_cores = 1, verbose = TRUE
)
print(fit)
plot(fit)
fit$best_params
if (FALSE) {
# It is possible to define explicitly K combinations of shrinkage
# parameters to be tested and in that case a matrix of dimension KxJ is
# required. Each row of this matrix corresponds to one specific set of
# shrinkage parameters.
par_value <- matrix(c(
0, 0, 0,
1, 1, 0,
0.5, 0.5, 0.5,
sapply(blocks, RGCCA:::tau.estimate),
1, 1, 1
), 5, 3, byrow = TRUE)
perm.out <- rgcca_permutation(blocks,
connection = C,
par_type = "tau",
par_value = par_value,
n_perms = 5, n_cores = 1
)
print(perm.out)
plot(perm.out)
# with superblock
perm.out <- rgcca_permutation(blocks,
par_type = "tau",
superblock = TRUE,
scale = TRUE, scale_block = FALSE,
n_perms = 5, n_cores = 1
)
print(perm.out)
plot(perm.out)
# used a fitted rgcca_permutation object as input of the rgcca function
fit.rgcca <- rgcca(perm.out)
print(fit.rgcca)
######################################
# Permutation based strategy for #
# determining the best sparsity #
# parameters (par_type = "sparsity") #
######################################
# defaut value: 10 vectors from minimum values
# (1/sqrt(ncol(X1)), ..., 1/sqrt(ncol(XJ))
# to rep(1, J), uniformly distributed.
perm.out <- rgcca_permutation(blocks,
par_type = "sparsity",
n_perms = 50, n_cores = 1
)
print(perm.out)
plot(perm.out)
perm.out$best_params
# when par_value is a vector of length J. Each element of the vector
# indicates the maximum value of sparsity to be considered for each block.
# par_length (default value = 10) vectors from minimum values
# (1/sqrt(ncol(X1)), ..., 1/sqrt(ncol(XJ)) to maximum values, uniformly
# distributed, are then considered.
perm.out <- rgcca_permutation(blocks,
connection = C,
par_type = "sparsity",
par_value = c(0.6, 0.75, 0.5),
par_length = 7, n_perms = 20,
n_cores = 1, tol = 1e-3
)
print(perm.out)
plot(perm.out)
perm.out$best_params
# when par_value is a scalar, the same maximum value is applied
# for each block
perm.out <- rgcca_permutation(blocks,
connection = C,
par_type = "sparsity",
par_value = 0.8, par_length = 5,
n_perms = 10, n_cores = 1
)
perm.out$params
######################################
# Speed up the permutation procedure #
######################################
# The rgcca_permutation function can be quite time-consuming. Since
# approximate estimates of the block weight vectors are acceptable in this
# case, it is possible to reduce the value of the tolerance (tol argument)
# of the RGCCA algorithm to speed up the permutation procedure.
#
data("ge_cgh_locIGR", package = "gliomaData")
A <- ge_cgh_locIGR$multiblocks
Loc <- factor(ge_cgh_locIGR$y)
levels(Loc) <- colnames(ge_cgh_locIGR$multiblocks$y)
A[[3]] <- A[[3]][, -3]
C <- matrix(c(0, 0, 1, 0, 0, 1, 1, 1, 0), 3, 3)
# check dimensions of the blocks
sapply(A, dim)
par_value <- matrix(c(
seq(0.1, 1, by = 0.1),
seq(0.1, 1, by = 0.1),
rep(0, 10)
), 10, 3, byrow = FALSE)
fit <- rgcca_permutation(A,
connection = C,
par_type = "tau",
par_value = par_value,
par_length = 10,
n_perms = 10, n_cores = 1, tol = 1e-2
)
print(fit)
plot(fit)
}
Run the code above in your browser using DataLab