Dore analysis

code/applications/base_analysis.qmd

@@ -40,6 +40,19 @@ summarized_graph_size_df <- graph_size_df %>%
 ```
 
 :::{.panel-tabset}
+#### Réseaux par cluster
+```{r}
+#| output: asis
+for (i in seq_len(length(unlisted_best_partition))) {
+    print(knitr::kable(
+        x = unlisted_best_partition[[i]][["net_id"]],
+        col.names = "Réseaux",
+        caption = paste0("Réseaux membre du ", i, "e cluster")
+    ))
+    cat("\n")
+}
+```
+
 #### Analyse des tailles de cluster
 
 ```{r}
@@ -121,7 +134,7 @@ ggplot(filtered_graph_size) +
 ```{r}
 #| output: asis
 for (i in seq_len(length(unlisted_best_partition))) {
-    cat("\n##### Structure collection ", i, "\n")
+    cat("\n\n##### Structure collection ", i, "\n")
     current_col <- unlisted_best_partition[[i]]$clone()
     current_col$net_id <- current_col$net_id %>%
         stringr::str_trunc(width = 20L)
@@ -134,6 +147,7 @@ for (i in seq_len(length(unlisted_best_partition))) {
             ggtitle(paste0("Structure\ncollection ", i))
         print(p)
     })
+    cat("\n")
 }
 
 ```

code/applications/dore/02_dore_analysis.qmd

@@ -18,15 +18,15 @@ library(aricode)
 library(reshape2)
 
 library(ggplot2)
-library(ggalluvial)
 ```
 
 ```{r}
 root_app_folder <- file.path(here(), "code", "applications")
 source(file.path(root_app_folder, "utils.R"))
 data_folder <- file.path(here(), "code", "results", "applications", "dore")
-files_vec <- get_recent_files(data_folder, n = 16L)
-files_vec <- identify_models(files_vec)
+files_vec <- get_recent_files(data_folder, n = 16L, "*iid*")
+files_vec <- identify_models(files_vec, pattern = "(iid|pirho|pi|rho)_seed_[0-9]{1,4}")
+names(files_vec) <- names(files_vec) %>% str_replace_all(pattern = "_", "~")
 list_clustering <- files_vec
 # list_collection <- readRDS(file.path(data_folder, "dore_collection_iid_24-05-24_18-07-50.Rds"))
 ```
@@ -43,6 +43,8 @@ vec_bicl <- sapply(list_clustering, function(clustering) {
     BICL <- sum(sapply(unlisted_best_partition, function(col) col$BICL))
     BICL
 })
+
+names(vec_bicl) <- names(files_vec)
 knitr::kable(vec_bicl,
     caption = "BICL par modèle", col.names = "$BICL$",
     row.names = TRUE
@@ -106,11 +108,13 @@ ari_dist_matrix <- outer(
         ARI(f_clust, s_clust)
     })
 )
-ggplot(ari_dist_matrix %>% melt()) +
+ari_plot_data <- ari_dist_matrix %>%
+    melt() %>%
+    mutate(Var1 = names(files_vec)[Var1], Var2 = names(files_vec)[Var2])
+ggplot(ari_plot_data) +
     aes(x = Var1, y = Var2) +
     geom_raster(aes(fill = value)) +
     scale_fill_gradient(low = "white", high = "red", limits = c(0, 1)) +
-    scale_x_reverse() +
     geom_text(aes(label = round(value, digits = 4))) +
     labs(
         x = "id clusterings",
@@ -154,9 +158,9 @@ plot_table <- function(data, f = NULL, s = NULL) {
 #| output: asis
 
 for (id in seq_len(length(list_tables_coocc))) {
-    print(plot_table(list_tables_coocc,
-        f = clust_to_compare_order[[id, 1]],
-        s = clust_to_compare_order[[id, 2]]
+    print(plot_table(list_tables_coocc[[id]],
+        f = names(files_vec)[clust_to_compare_order[[id, 1]]],
+        s = names(files_vec)[clust_to_compare_order[[id, 2]]]
     ))
 }
 ```

code/applications/utils.R

@@ -26,10 +26,10 @@ get_recent_files <- function(data_folder, n = 4, pattern = NULL) {
 }
 
 #' Identify models
-identify_models <- function(files_vec) {
+identify_models <- function(files_vec, pattern = "(iid|pirho|pi|rho)") {
     names(files_vec) <- stringr::str_extract(
         string = files_vec,
-        pattern = "(iid|pirho|pi|rho)"
+        pattern = pattern
     )
     return(files_vec)
 }