From 5f922c1453260ba0950885f804347b40afb356c9 Mon Sep 17 00:00:00 2001 From: Louis Date: Mon, 9 Feb 2026 15:53:01 +0100 Subject: [PATCH] Adding ARI and ICL compute --- analysis_benchmark_lbm_seq.qmd | 60 +++++++++++++++++++++++++++------- 1 file changed, 48 insertions(+), 12 deletions(-) diff --git a/analysis_benchmark_lbm_seq.qmd b/analysis_benchmark_lbm_seq.qmd index b0a039f..fcf63b6 100644 --- a/analysis_benchmark_lbm_seq.qmd +++ b/analysis_benchmark_lbm_seq.qmd @@ -155,22 +155,31 @@ membership_to_df <- function(membership_list, suffix = 1) { }) } -seq_df <- lapply(seq_along(seq_memberships), function(idx) { - membership_to_df(seq_memberships[[idx]], suffix = idx + 1) -}) +dispatch_membership_to_df <- function(memberships) { + mdf <- lapply(seq_along(memberships), function(idx) { + membership_to_df(memberships[[idx]], suffix = idx + 1) + }) -seq_df_otu <- lapply(seq_df, function(df) { - df$Z1 -}) %>% # Below we join by the ranks - reduce(left_join) %>% - select(sort(names(.))) + df_otu <- lapply(mdf, function(df) { + df$Z1 + }) %>% # Below we join by the ranks + reduce(left_join) %>% + select(sort(names(.))) + + df_sample <- lapply(mdf, function(df) { + df$Z2 + }) %>% reduce(left_join, by = "Rank1") + return(list(df_otu = df_otu, df_sample = df_sample)) +} +seq_df_otu_samples <- dispatch_membership_to_df(seq_memberships) +seq_df_otu <- seq_df_otu_samples$df_otu +seq_df_sample <- seq_df_otu_samples$df_sample -seq_df_sample <- lapply(seq_df, function(df) { - df$Z2 -}) %>% reduce(left_join, by = "Rank1") - +notrans_df_otu_samples <- dispatch_membership_to_df(notrans_memberships) +notrans_df_otu <- notrans_df_otu_samples$df_otu +notrans_df_sample <- notrans_df_otu_samples$df_sample seq_df_sample_lodes <- to_lodes_form(seq_df_sample, key = "x", axes = 2:5) seq_df_otu_lodes <- to_lodes_form(seq_df_otu, key = "x", axes = 6:9) @@ -191,4 +200,31 @@ ggplot(seq_df_otu_lodes, aes(x = x, alluvium = alluvium, stratum = stratum, labe geom_alluvium(aes(fill = Rank2)) + geom_stratum() + geom_text(stat = "stratum") +``` + +```{r} +ARI_ranks <- function(df_otu) { +memb_mat <- df_otu |> select(starts_with("Z")) +memb_list <- lapply(seq_len(ncol(memb_mat)), function(i) memb_mat[,i] |> unlist() |> as.vector()) +outer(memb_list,memb_list, FUN = Vectorize(ARI))} +ARI_ranks(seq_df_otu) +ARI_ranks(notrans_df_otu) +``` + +```{r} +# Extract ICL +ICL_per_ranks <- function(model_results) { + model_rank_list <- lapply(model_results, function(model_per_rank) model_per_rank[[1]]) # Extract first rep per rank + return(sapply(model_rank_list, function(model) max(model$ICL, na.rm = TRUE))) +} +ICL_df <- data.frame("No trans" = ICL_per_ranks(notrans_results), "Seq" = +ICL_per_ranks(seq_results)) %>% t() %>% as.data.frame() +``` + +```{r} +library(kableExtra) +ICL_df %>% mutate_all(cell_spec(., bold = ifelse(is..))) + + +kable(ICL_df) ``` \ No newline at end of file