diff --git a/benchmark_lbm_seq.R b/benchmark_lbm_seq.R index 4d3bd8f..6d4c696 100644 --- a/benchmark_lbm_seq.R +++ b/benchmark_lbm_seq.R @@ -33,132 +33,38 @@ if (!dir.exists(tmp_folder)) { per_taxa_networks <- collapse_otu_at_taxo(the_data) +prev_model <- NULL -switch(mode, - "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) +sequential <- FALSE - out_seq <- list( - benchmark = mbm_seq, - models = list( - Rank2 = r2_model_seq, - Rank3 = r3_model_seq, - Rank4 = r4_model_seq, - Rank5 = r5_model_seq - ) +if (mode == "seq" || mode == "para") { + sequential <- TRUE +} + +ncores <- ifelse(mode == "para", parallelly::availableCores(), 1L) + +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")) - }, - "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") -) +names(model_list) <- paste0("Rank", net_ids) +saveRDS(model_list, here(named_data_folder, paste0(mode, "_", epoch, ".Rds")))