more work to sync
This commit is contained in:
parent
04c93bf6ec
commit
20db25a3a5
4 changed files with 4164 additions and 4022 deletions
File diff suppressed because one or more lines are too long
|
|
@ -7,12 +7,17 @@ library("knitr")
|
|||
library("kableExtra")
|
||||
library("stringr")
|
||||
library("here")
|
||||
library("tikzDevice")
|
||||
library("network")
|
||||
library("GGally")
|
||||
library("igraph")
|
||||
library("tidygraph")
|
||||
library("ggraph")
|
||||
library("stringr")
|
||||
library("tikzDevice")
|
||||
library("colSBM")
|
||||
library("patchwork")
|
||||
library("ggdendro")
|
||||
options(tikzDocumentDeclaration = "\\documentclass[10pt]{standalone}")
|
||||
|
||||
|
||||
base_data_folder <- file.path(here(), "code", "data", "dore")
|
||||
save_folder <- file.path(
|
||||
|
|
@ -104,7 +109,6 @@ output_tikz_folder <- here(
|
|||
if (!dir.exists(output_tikz_folder)) {
|
||||
dir.create(output_tikz_folder, recursive = TRUE)
|
||||
}
|
||||
options(tikzDocumentDeclaration = "\\documentclass[10pt]{standalone}")
|
||||
lapply(seq_along(plot_list), function(id) {
|
||||
tikz(
|
||||
file = file.path(output_tikz_folder, paste0("graph-", names(plot_list)[[id]], ".tex")),
|
||||
|
|
@ -115,3 +119,186 @@ lapply(seq_along(plot_list), function(id) {
|
|||
print(plot_list[[id]])
|
||||
dev.off()
|
||||
})
|
||||
|
||||
clustering_data_folder <- here(
|
||||
"code", "results",
|
||||
"applications",
|
||||
"sub-dore",
|
||||
"baldock"
|
||||
)
|
||||
source(here("code", "applications", "utils.R"))
|
||||
files_vec <- get_recent_files(clustering_data_folder, n = 16L)
|
||||
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
|
||||
vec_bicl <- sapply(list_clustering, function(clustering) {
|
||||
list_collection <- readRDS(clustering)
|
||||
unlisted_best_partition <- extract_best_partition(list_collection)
|
||||
if (is.list(unlisted_best_partition)) {
|
||||
BICL <- sum(sapply(
|
||||
unlisted_best_partition,
|
||||
function(col) col[["BICL"]]
|
||||
))
|
||||
} else {
|
||||
BICL <- unlisted_best_partition[["BICL"]]
|
||||
}
|
||||
BICL
|
||||
})
|
||||
|
||||
names(vec_bicl) <- names(files_vec)
|
||||
col_order <- order(vec_bicl, decreasing = TRUE)
|
||||
vec_bicl <- sort(vec_bicl, decreasing = TRUE)
|
||||
|
||||
list_clustering_files <- list_clustering[col_order]
|
||||
|
||||
iid_clustering_file <- list_clustering_files[[1]]
|
||||
|
||||
pirho_ids <- names(vec_bicl) |>
|
||||
grep(pattern = "pirho")
|
||||
|
||||
pirho_clustering_file <- list_clustering_files[pirho_ids][which.max(
|
||||
vec_bicl[pirho_ids]
|
||||
)]
|
||||
|
||||
iid_clust <- readRDS(iid_clustering_file)
|
||||
pirho_clust <- readRDS(pirho_clustering_file)
|
||||
|
||||
# iid_tree <- as.hclust(extract_clustering_tree(iid_clust))
|
||||
# pirho_tree <- extract_clustering_tree(pirho_clust)
|
||||
|
||||
iid_bp <- extract_best_partition(iid_clust)
|
||||
iid_bp <- lapply(iid_bp, function(col) {
|
||||
nid <- col$net_id
|
||||
nid <- nid |>
|
||||
stringr::str_remove_all(pattern = "(Baldock2019|Baldock2011)_")
|
||||
col$net_id <- nid
|
||||
col
|
||||
})
|
||||
|
||||
iid_struct_plot <- wrap_plots(
|
||||
lapply(iid_bp, plot,
|
||||
type = "meso",
|
||||
values = TRUE
|
||||
),
|
||||
ncol = 1L,
|
||||
) +
|
||||
plot_layout(guides = "collect") &
|
||||
theme(legend.position = "none", legend.text = element_text(angle = 45))
|
||||
|
||||
pirho_bp <- extract_best_partition(pirho_clust)
|
||||
pirho_bp <- lapply(list(pirho_bp), function(col) {
|
||||
nid <- col$net_id
|
||||
nid <- nid |>
|
||||
stringr::str_remove_all(pattern = "(Baldock2019|Baldock2011)_")
|
||||
col$net_id <- nid
|
||||
col
|
||||
})
|
||||
pirho_struct_plot <- wrap_plots(
|
||||
lapply(pirho_bp, plot,
|
||||
type = "meso",
|
||||
values = TRUE
|
||||
),
|
||||
ncol = 1L
|
||||
) +
|
||||
plot_layout(guides = "collect") &
|
||||
theme(legend.position = "none", legend.text = element_text(angle = 45))
|
||||
|
||||
plot_width <- 2.5
|
||||
plot_height <- 4
|
||||
|
||||
tikz(
|
||||
file = file.path(output_tikz_folder, "iid-clust-struct.tex"),
|
||||
width = plot_width,
|
||||
height = plot_height,
|
||||
standAlone = TRUE
|
||||
)
|
||||
print(iid_struct_plot)
|
||||
dev.off()
|
||||
|
||||
tikz(
|
||||
file = file.path(output_tikz_folder, "pirho-clust-struct.tex"),
|
||||
width = plot_width - 0.5,
|
||||
height = plot_height,
|
||||
standAlone = TRUE
|
||||
)
|
||||
print(pirho_struct_plot)
|
||||
dev.off()
|
||||
|
||||
iid_dendro <- dendro_data(extract_clustering_dendrogram(iid_clust, invalid_char_to_replace_regex = "\\(|\\)|\\_"), type = "rectangle")
|
||||
|
||||
|
||||
tikz(
|
||||
file = file.path(output_tikz_folder, "iid-clust-tree.tex"),
|
||||
width = 2.5,
|
||||
height = 4,
|
||||
standAlone = TRUE
|
||||
)
|
||||
ggdendrogram(iid_dendro, label.size = 8, rotate = TRUE)
|
||||
dev.off()
|
||||
|
||||
pirho_dendro <- dendro_data(extract_clustering_dendrogram(pirho_clust, invalid_char_to_replace_regex = "\\(|\\)|\\_"), type = "rectangle")
|
||||
|
||||
|
||||
tikz(
|
||||
file = file.path(output_tikz_folder, "pirho-clust-tree.tex"),
|
||||
width = 2.5,
|
||||
height = 4,
|
||||
standAlone = TRUE
|
||||
)
|
||||
ggdendrogram(pirho_dendro, label.size = 8, rotate = TRUE)
|
||||
dev.off()
|
||||
|
||||
## Appendix
|
||||
|
||||
iid_clust <- readRDS(iid_clustering_file)
|
||||
pirho_clust <- readRDS(pirho_clustering_file)
|
||||
|
||||
# iid_tree <- as.hclust(extract_clustering_tree(iid_clust))
|
||||
# pirho_tree <- extract_clustering_tree(pirho_clust)
|
||||
|
||||
iid_struct_plot_app <- lapply(iid_bp, plot,
|
||||
type = "meso",
|
||||
values = FALSE,
|
||||
mixture = TRUE
|
||||
)
|
||||
|
||||
pirho_struct_plot_app <- wrap_plots(
|
||||
lapply(pirho_bp, plot,
|
||||
type = "meso",
|
||||
values = FALSE,
|
||||
mixture = TRUE
|
||||
),
|
||||
ncol = 1L
|
||||
) +
|
||||
plot_layout(guides = "collect")
|
||||
|
||||
plot_width <- 6
|
||||
plot_height <- 6
|
||||
|
||||
|
||||
tikz(
|
||||
file = file.path(output_tikz_folder, "app-iid-clust-struct-1.tex"),
|
||||
width = plot_width,
|
||||
height = plot_height,
|
||||
standAlone = TRUE
|
||||
)
|
||||
iid_struct_plot_app[[1]]
|
||||
dev.off()
|
||||
|
||||
tikz(
|
||||
file = file.path(output_tikz_folder, "app-iid-clust-struct-2.tex"),
|
||||
width = plot_width,
|
||||
height = plot_height,
|
||||
standAlone = TRUE
|
||||
)
|
||||
iid_struct_plot_app[[2]]
|
||||
dev.off()
|
||||
|
||||
tikz(
|
||||
file = file.path(output_tikz_folder, "app-pirho-clust-struct.tex"),
|
||||
width = plot_width,
|
||||
height = plot_height,
|
||||
standAlone = TRUE
|
||||
)
|
||||
print(pirho_struct_plot_app)
|
||||
dev.off()
|
||||
|
|
|
|||
|
|
@ -68,7 +68,7 @@ if (!dir.exists(output_tikz_folder)) {
|
|||
|
||||
tikz(
|
||||
file = file.path(output_tikz_folder, "ari-clustering.tex"), width = 5L,
|
||||
height = 3L,
|
||||
height = 2,
|
||||
standAlone = TRUE
|
||||
)
|
||||
print(ari_plot)
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
Subproject commit fae7c807e64a1ffb73b0f3b37ed44f5c4379aa84
|
||||
Subproject commit 8b6e907dca155354894edbbe606e84d37202a6ff
|
||||
Loading…
Add table
Reference in a new issue