polarolouis/mia-stage-2024
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Switching to parallely and can't store the seed

Browse source
This commit is contained in:
Louis Lacoste 2024-04-24 17:14:18 +02:00
parent 61b72f14f4
commit c4f6d1fb07
1 changed files with 40 additions and 46 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

86
code/simulations/simulations_inference_bernoulli.R
View file

@ -12,42 +12,6 @@ suppressPackageStartupMessages(library(colSBM))
set.seed(1234)
#  Functions
compute_mean_ARI <- function(model) {
# We compute the mean amongst the two networks and return values for
# rows and columns in a vector
# sapply ives a matrix with in row the axis ARIs
# and in columns the networks
# 1 2
# ax row1 row2
# ay col1 col2
rowMeans(sapply(seq.int(model$M), function(m) {
matrix(c(
aricode::ARI(model$Z[[m]][[1]], row_clusterings[[m]]),
aricode::ARI(model$Z[[m]][[2]], col_clusterings[[m]])
), nrow = 2, ncol = 1)
}))
}
compute_double_ARI <- function(model) {
model_row_Z <- as.vector(sapply(
seq.int(model$M),
function(m) model$Z[[m]][[1]]
))
model_col_Z <- as.vector(sapply(
seq.int(model$M),
function(m) model$Z[[m]][[2]]
))
return(list(
aricode::ARI(model_row_Z, full_row_clustering),
aricode::ARI(model_col_Z, full_col_clustering)
))
}
# Network param
nr <- 120
nc <- 120
@ -148,8 +112,6 @@ results <- parallel::mclapply(conditions_rows, function(s) {
Cpi1 <- matrix(c(current_pi1, pi2), byrow = TRUE, nrow = M) > 0
Cpi2 <- matrix(c(rho1, current_rho2), byrow = TRUE, nrow = M) > 0
current_seed <- .Random.seed
netlist_generated <- list(
generate_bipartite_collection(
nr, nc, conditions[s, ]$pi1, rho1,
@ -194,7 +156,7 @@ results <- parallel::mclapply(conditions_rows, function(s) {
global_opts = list(
verbosity = 0,
plot_details = 0,
nb_cores = parallel::detectCores() - 1
nb_cores = parallelly::availableCores(omit = 1)
)
)
@ -210,7 +172,7 @@ results <- parallel::mclapply(conditions_rows, function(s) {
global_opts = list(
verbosity = 0,
plot_details = 0,
nb_cores = parallel::detectCores() - 1
nb_cores = parallelly::availableCores(omit = 1)
),
sep_BiSBM = sep_BiSBM
)
@ -223,7 +185,7 @@ results <- parallel::mclapply(conditions_rows, function(s) {
global_opts = list(
verbosity = 0,
plot_details = 0,
nb_cores = parallel::detectCores() - 1
nb_cores = parallelly::availableCores(omit = 1)
),
sep_BiSBM = sep_BiSBM
)
@ -236,7 +198,7 @@ results <- parallel::mclapply(conditions_rows, function(s) {
global_opts = list(
verbosity = 0,
plot_details = 0,
nb_cores = parallel::detectCores() - 1
nb_cores = parallelly::availableCores(omit = 1)
),
sep_BiSBM = sep_BiSBM
)
@ -253,6 +215,40 @@ results <- parallel::mclapply(conditions_rows, function(s) {
BICLs <- c(sep_BICL, iid_BICL, pi_BICL, rho_BICL, pirho_BICL)
# ARIs
#  Functions
compute_mean_ARI <- function(model) {
# We compute the mean amongst the two networks and return values for
# rows and columns in a vector
# sapply ives a matrix with in row the axis ARIs
# and in columns the networks
# 1 2
# ax row1 row2
# ay col1 col2
rowMeans(sapply(seq.int(model$M), function(m) {
matrix(c(
aricode::ARI(model$Z[[m]][[1]], row_clusterings[[m]]),
aricode::ARI(model$Z[[m]][[2]], col_clusterings[[m]])
), nrow = 2, ncol = 1)
}))
}
compute_double_ARI <- function(model) {
model_row_Z <- as.vector(sapply(
seq.int(model$M),
function(m) model$Z[[m]][[1]]
))
model_col_Z <- as.vector(sapply(
seq.int(model$M),
function(m) model$Z[[m]][[2]]
))
return(list(
aricode::ARI(model_row_Z, full_row_clustering),
aricode::ARI(model_col_Z, full_col_clustering)
))
}
sep_mean_ARIs <- compute_mean_ARI(sep_BiSBM)
iid_mean_ARIs <- compute_mean_ARI(fitted_bisbmpop_iid$best_fit)
@ -345,15 +341,13 @@ results <- parallel::mclapply(conditions_rows, function(s) {
alpha = current_alpha,
pirho_double_row_ARI = pirho_double_ARIs[[1]],
pirho_double_col_ARI = pirho_double_ARIs[[2]],
netlist = netlist_generated,
seed = current_seed
netlist = netlist_generated
)
saveRDS(object = inc_data, file = incorrect_filepath)
}
return(data_frame_output)
},
mc.cores = parallel::detectCores() - 1L
}, mc.cores = parallelly::availableCores(omit = 1)
)