🚧Impact VEM

This commit is contained in:
Louis Lacoste 2024-06-12 11:00:09 +02:00
parent 871dc734b8
commit db40ee87e5

View file

@ -7,6 +7,7 @@ library(here)
## ----constants-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------
base_folder <- here("code", "results", "investigating", "vem_steps")
if (!dir.exists(base_folder)) {
dir.create(base_folder, recursive = TRUE)
}
@ -98,6 +99,9 @@ true_clustering <- c(rep(1, M), rep(2, M), rep(3, M))
## ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
begin_time <- format(Sys.time(), "%s")
tmp_folder <- file.path(base_folder, paste0("tmp", begin_time))
results <- lapply(seq_len(nrow(conditions)), function(idx) {
current_seed <- conditions[["seeds"]][idx]
eps <- conditions[["epsilons"]][idx]
@ -111,7 +115,7 @@ results <- lapply(seq_len(nrow(conditions)), function(idx) {
netlist = collection, net_id = names(collection),
colsbm_model = "iid", fit_opts = list(max_vem_steps = max_vem_steps),
global_opts = list(
verbosity = 2L,
verbosity = 1L,
nb_cores = parallelly::availableCores(omit = 1L)
)
)
@ -133,9 +137,34 @@ results <- lapply(seq_len(nrow(conditions)), function(idx) {
cluster_membership <- as.numeric(names(clustering_vec))
ari <- ARI(cluster_membership, true_clustering)
ari <- try(ARI(cluster_membership, true_clustering))
data.frame(eps = eps, seed = current_seed, max_vem_steps = max_vem_steps, ari = ari, elapsed_time = elapsed_time, start_time = start_time, stop_time = stop_time, clustering = matrix(cluster_membership, nrow = 1L))
if (!inherits(ari, "try-error")) {
ari <- NA
}
out <- data.frame(
eps = eps, seed = current_seed,
max_vem_steps = max_vem_steps,
ari = ari,
elapsed_time = elapsed_time,
start_time = start_time,
stop_time = stop_time,
clustering = matrix(
cluster_membership,
nrow = 1L
)
)
saveRDS(out,
file = file.path(
tmp_folder,
paste0("c_", idx, "_on_", nrow(conditions), ".Rds")
)
)
out
})
to_save <- do.call(rbind, results)
filename_to_save <- paste0("impact_vem_", begin_time, ".Rds")
saveRDS(to_save, file = file.path(base_folder, filename_to_save))