Cleaner implementation of benchmark lbm seq

This commit is contained in:
Louis 2026-02-10 11:27:05 +01:00
parent 20d26e8634
commit 40068f8d00

View file

@ -33,132 +33,38 @@ if (!dir.exists(tmp_folder)) {
per_taxa_networks <- collapse_otu_at_taxo(the_data) per_taxa_networks <- collapse_otu_at_taxo(the_data)
prev_model <- NULL
switch(mode, sequential <- FALSE
"seq" = {
message("Will use SEQ")
r2_mbm_seq <- microbenchmark("Rank2seq" = {
r2_model_seq <- BM_poisson(
membership_type = "LBM",
adj = per_taxa_networks[[2]], # Account for the root
verbosity = 6,
plotting = "",
autosave = here(tmp_folder, "r2_seq.Rds"),
ncores = 1L
)
r2_model_seq$estimate()
}, times = 3L)
r3_mbm_seq <- microbenchmark("Rank3seq" = {
r3_model_seq <- bm_propagate_taus_all_models(phyloseq_data = the_data, rank_id_start = 2, target_rank_id = 3, per_taxa_networks = per_taxa_networks, first_model = r2_model_seq, ncores = 1, autosave = here(tmp_folder, "r3_seq.Rds"))
}, times = 3L)
r4_mbm_seq <- microbenchmark("Rank4seq" = {
r4_model_seq <- bm_propagate_taus_all_models(phyloseq_data = the_data, rank_id_start = 3, per_taxa_networks = per_taxa_networks, first_model = r3_model_seq, ncores = 1, autosave = here(tmp_folder, "r4_seq.Rds"))
}, times = 3L)
r5_mbm_seq <- microbenchmark("Rank5seq" = {
r5_model_seq <- bm_propagate_taus_all_models(phyloseq_data = the_data, rank_id_start = 4, per_taxa_networks = per_taxa_networks, first_model = r4_model_seq, ncores = 1, autosave = here(tmp_folder, "r5_seq.Rds"))
}, times = 3L)
mbm_seq <- rbind(r2_mbm_seq, r3_mbm_seq, r4_mbm_seq, r5_mbm_seq)
out_seq <- list( if (mode == "seq" || mode == "para") {
benchmark = mbm_seq, sequential <- TRUE
models = list( }
Rank2 = r2_model_seq,
Rank3 = r3_model_seq, ncores <- ifelse(mode == "para", parallelly::availableCores(), 1L)
Rank4 = r4_model_seq,
Rank5 = r5_model_seq model_list <- list()
) net_ids <- seq_along(per_taxa_networks)[-1]
for (idx in net_ids) {
if (!sequential || is.null(prev_model)) {
current_model <- BM_poisson(
membership_type = "LBM",
adj = per_taxa_networks[[idx]], # Account for the root
verbosity = 6,
plotting = "",
autosave = here(tmp_folder, paste0("r", idx, "_", mode, ".Rds")),
ncores = ncores
) )
current_model$estimate()
} else {
# We transfer
current_model <- bm_propagate_taus_all_models(phyloseq_data = the_data, rank_id_start = idx - 1, target_rank_id = idx, per_taxa_networks = per_taxa_networks, first_model = prev_model, ncores = ncores, autosave = here(tmp_folder, paste0("r", idx, "_", mode, ".Rds")))
}
prev_model <- current_model
model_list <- append(model_list, current_model)
}
saveRDS(out_seq, here(named_data_folder, "seq.Rds")) names(model_list) <- paste0("Rank", net_ids)
}, saveRDS(model_list, here(named_data_folder, paste0(mode, "_", epoch, ".Rds")))
"para" = {
message("Will use PARA")
r2_mbm_para <- microbenchmark("Rank2para" = {
r2_model_para <- BM_poisson(
membership_type = "LBM",
adj = per_taxa_networks[[2]], # Account for the root
verbosity = 6,
plotting = "",
ncores = parallelly::availableCores(), autosave = here(tmp_folder, "r2_para.Rds")
)
r2_model_para$estimate()
}, times = 3L)
r3_mbm_para <- microbenchmark("Rank3para" = {
r3_model_para <- bm_propagate_taus_all_models(phyloseq_data = the_data, rank_id_start = 2, target_rank_id = 3, per_taxa_networks = per_taxa_networks, first_model = r2_model_para, ncores = parallelly::availableCores(), autosave = here(tmp_folder, "r3_para.Rds"))
}, times = 3L)
r4_mbm_para <- microbenchmark("Rank4para" = {
r4_model_para <- bm_propagate_taus_all_models(phyloseq_data = the_data, rank_id_start = 3, per_taxa_networks = per_taxa_networks, first_model = r3_model_para, ncores = parallelly::availableCores(), autosave = here(tmp_folder, "r4_para.Rds"))
}, times = 3L)
r5_mbm_para <- microbenchmark("Rank5para" = {
r5_model_para <- bm_propagate_taus_all_models(phyloseq_data = the_data, rank_id_start = 4, per_taxa_networks = per_taxa_networks, first_model = r4_model_para, ncores = parallelly::availableCores(), autosave = here(tmp_folder, "r5_para.Rds"))
}, times = 3L)
mbm_para <- rbind(r2_mbm_para, r3_mbm_para, r4_mbm_para, r5_mbm_para)
out_para <- list(
benchmark = mbm_para,
models = list(
Rank2 = r2_model_para,
Rank3 = r3_model_para,
Rank4 = r4_model_para,
Rank5 = r5_model_para
)
)
saveRDS(out_para, here(named_data_folder, "para.Rds"))
},
"notrans" = { # No transfer
message("Will use NO TRANSFER")
r2_mbm_notrans <- microbenchmark("Rank2notrans" = {
r2_model_notrans <- BM_poisson(
membership_type = "LBM",
adj = per_taxa_networks[[2]], # Account for the root
verbosity = 6,
ncores = parallelly::availableCores(), autosave = here(tmp_folder, "r2_notrans.Rds")
)
r2_model_notrans$estimate()
}, times = 3L)
r3_mbm_notrans <- microbenchmark("Rank3notrans" = {
r3_model_notrans <- BM_poisson(
membership_type = "LBM",
adj = per_taxa_networks[[3]], # Account for the root
verbosity = 6,
plotting = "",
ncores = parallelly::availableCores(), autosave = here(tmp_folder, "r3_notrans.Rds")
)
r3_model_notrans$estimate()
}, times = 3L)
r4_mbm_notrans <- microbenchmark("Rank4notrans" = {
r4_model_notrans <- BM_poisson(
membership_type = "LBM",
adj = per_taxa_networks[[4]], # Account for the root
verbosity = 6,
plotting = "",
ncores = parallelly::availableCores(), autosave = here(tmp_folder, "r4_notrans.Rds")
)
r4_model_notrans$estimate()
}, times = 3L)
r5_mbm_notrans <- microbenchmark("Rank5notrans" = {
r5_model_notrans <- BM_poisson(
membership_type = "LBM",
adj = per_taxa_networks[[5]], # Account for the root
verbosity = 6,
plotting = "",
ncores = parallelly::availableCores(), autosave = here(tmp_folder, "r5_notrans.Rds")
)
r5_model_notrans$estimate()
}, times = 3L)
mbm_notrans <- rbind(r2_mbm_notrans, r3_mbm_notrans, r4_mbm_notrans, r5_mbm_notrans)
out_notrans <- list(
benchmark = mbm_notrans,
models = list(
Rank2 = r2_model_notrans,
Rank3 = r3_model_notrans,
Rank4 = r4_model_notrans,
Rank5 = r5_model_notrans
)
)
saveRDS(out_notrans, here(named_data_folder, "notrans.Rds"))
},
stop("Nothing selected, exiting")
)