polarolouis/human-microbiome-compendium
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Extracting folder

Browse source
This commit is contained in:
Louis 2026-02-24 14:51:46 +01:00
parent 9995e60b20
commit a382f61233
1 changed files with 15 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

23
analysis_benchmark_lbm_seq.qmd
View file

@ -19,8 +19,9 @@ otu_df <- sapply(per_taxa_networks, nrow) %>%
rownames_to_column() %>%
rename(Nb_OTU = ".", Rank = "rowname")
result_folder <- here("results", "lbm-seq", "chaillou")
flist <- list.files(here("results", "lbm-seq", "chaillou"), full.names = TRUE, pattern = ".Rds")
flist <- list.files(result_folder, full.names = TRUE, pattern = ".Rds")
para_flist <- grepv(pattern = "para.Rds", flist)
seq_flist <- grepv(pattern = "seq.Rds", flist)
@ -118,7 +119,7 @@ extract_memberships <- function(model) {
rownames(memberships[["Z1"]]) <- rownames(model$adj)
rownames(memberships[["Z2"]]) <- colnames(model$adj)
memberships
map_memberships <- list(Z1 = apply(memberships[["Z1"]], 1, which.max), Z2 = apply(memberships[["Z2"]], 1, which.max))
map_memberships <- list(Z1 = apply(memberships[["Z1"]], 1, which.max), Z2 = apply(memberships[["Z2"]], 1, which.max))
map_memberships
}
```
@ -132,13 +133,15 @@ notrans_memberships <- lapply(notrans_model, extract_memberships)
```
```{r}
tibble("Para v No transfer" = map2_dbl(purrr::transpose(para_memberships)[["Z1"]], purrr::transpose(notrans_memberships)[["Z1"]], .f = ARI), "Sequential v No transfer" = map2_dbl(purrr::transpose(seq_memberships)[["Z1"]], purrr::transpose(notrans_memberships)[["Z1"]], .f = ARI), "Para v Sequential" = map2_dbl(purrr::transpose(para_memberships)[["Z1"]], purrr::transpose(seq_memberships)[["Z1"]], .f = ARI)) %>% t() %>%
knitr::kable(col.names = paste0("Rank", seq(2,5)), caption = "ARI for the methods for OTU memberships")
tibble("Para v No transfer" = map2_dbl(purrr::transpose(para_memberships)[["Z1"]], purrr::transpose(notrans_memberships)[["Z1"]], .f = ARI), "Sequential v No transfer" = map2_dbl(purrr::transpose(seq_memberships)[["Z1"]], purrr::transpose(notrans_memberships)[["Z1"]], .f = ARI), "Para v Sequential" = map2_dbl(purrr::transpose(para_memberships)[["Z1"]], purrr::transpose(seq_memberships)[["Z1"]], .f = ARI)) %>%
t() %>%
knitr::kable(col.names = paste0("Rank", seq(2, 5)), caption = "ARI for the methods for OTU memberships")
```
```{r}
tibble("Para v No transfer" = map2_dbl(purrr::transpose(para_memberships)[["Z2"]], purrr::transpose(notrans_memberships)[["Z2"]], .f = ARI), "Sequential v No transfer" = map2_dbl(purrr::transpose(seq_memberships)[["Z2"]], purrr::transpose(notrans_memberships)[["Z2"]], .f = ARI), "Para v Sequential" = map2_dbl(purrr::transpose(para_memberships)[["Z2"]], purrr::transpose(seq_memberships)[["Z2"]], .f = ARI)) %>% t() %>%
knitr::kable(col.names = paste0("Rank", seq(2,5)), caption = "ARI for the methods for sample memberships")
tibble("Para v No transfer" = map2_dbl(purrr::transpose(para_memberships)[["Z2"]], purrr::transpose(notrans_memberships)[["Z2"]], .f = ARI), "Sequential v No transfer" = map2_dbl(purrr::transpose(seq_memberships)[["Z2"]], purrr::transpose(notrans_memberships)[["Z2"]], .f = ARI), "Para v Sequential" = map2_dbl(purrr::transpose(para_memberships)[["Z2"]], purrr::transpose(seq_memberships)[["Z2"]], .f = ARI)) %>%
t() %>%
knitr::kable(col.names = paste0("Rank", seq(2, 5)), caption = "ARI for the methods for sample memberships")
```
```{r}
@ -245,8 +248,12 @@ 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()
ICL_df <- data.frame(
"No trans" = ICL_per_ranks(notrans_results), "Seq" =
ICL_per_ranks(seq_results)
) %>%
t() %>%
as.data.frame()
```
```{r}