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

Fixing non-optimal functions placement and prog errors

Browse source
This commit is contained in:
Louis Lacoste 2024-04-24 15:55:08 +02:00
parent 92e1c18cc1
commit 653cbc107c
1 changed files with 38 additions and 33 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

71
code/simulations/simulations_inference_bernoulli.R
View file

@ -12,6 +12,42 @@ 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
@ -217,44 +253,13 @@ results <- parallel::mclapply(conditions_rows, function(s) {
BICLs <- c(sep_BICL, iid_BICL, pi_BICL, rho_BICL, pirho_BICL)
# ARIs
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)
}))
}
sep_mean_ARIs <- compute_mean_ARI(sep_BiSBM)
iid_mean_ARIs <- compute_mean_ARI(fitted_bisbmpop_iid$best_fit)
pi_mean_ARIs <- compute_mean_ARI(fitted_bisbmpop_pi$best_fit)
rho_mean_ARIs <- compute_mean_ARI(fitted_bisbmpop_rho$best_fit)
pirho_mean_ARIs <- compute_mean_ARI(fitted_bisbmpop_pirho$best_fit)
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_double_ARIs <- compute_double_ARI(fitted_bisbmpop_iid$sep_BiSBM)
iid_double_ARIs <- compute_double_ARI(fitted_bisbmpop_iid$best_fit)
pi_double_ARIs <- compute_double_ARI(fitted_bisbmpop_pi$best_fit)
@ -326,7 +331,7 @@ results <- parallel::mclapply(conditions_rows, function(s) {
saveRDS(object = data_frame_output, file = temp_file_save)
#  Saving inhabitual data
if (all(pirho_mean_ARIs == 1L) & any(pirho_double_ARIs) < 1L) {
if (all(pirho_mean_ARIs == 1L) & any(pirho_double_ARIs < 1L)) {
warning("Incorrect result encountered, saving.")
incorrect_filepath <- file.path(temp_dir, paste0(
"incorrect_conditions_", s, "_on_",