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() %>% rownames_to_column() %>%
rename(Nb_OTU = ".", Rank = "rowname") 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) para_flist <- grepv(pattern = "para.Rds", flist)
seq_flist <- grepv(pattern = "seq.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[["Z1"]]) <- rownames(model$adj)
rownames(memberships[["Z2"]]) <- colnames(model$adj) rownames(memberships[["Z2"]]) <- colnames(model$adj)
memberships 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 map_memberships
} }
``` ```
@ -132,13 +133,15 @@ notrans_memberships <- lapply(notrans_model, extract_memberships)
``` ```
```{r} ```{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() %>% 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)) %>%
knitr::kable(col.names = paste0("Rank", seq(2,5)), caption = "ARI for the methods for OTU memberships") t() %>%
knitr::kable(col.names = paste0("Rank", seq(2, 5)), caption = "ARI for the methods for OTU memberships")
``` ```
```{r} ```{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() %>% 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)) %>%
knitr::kable(col.names = paste0("Rank", seq(2,5)), caption = "ARI for the methods for sample memberships") t() %>%
knitr::kable(col.names = paste0("Rank", seq(2, 5)), caption = "ARI for the methods for sample memberships")
``` ```
```{r} ```{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 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))) 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_df <- data.frame(
ICL_per_ranks(seq_results)) %>% t() %>% as.data.frame() "No trans" = ICL_per_ranks(notrans_results), "Seq" =
ICL_per_ranks(seq_results)
) %>%
t() %>%
as.data.frame()
``` ```
```{r} ```{r}