utils: add collapse to merge otu by taxonomy

utils.R

@@ -1,5 +1,7 @@
 library(knitr)
 library(kableExtra)
+library(dplyr)
+library(stringr)
 
 ellipse_table <- function(df, nr = 5, nc = 5, format = "latex") {
     nrows <- nrow(df)
@@ -56,3 +58,29 @@ ellipse_table <- function(df, nr = 5, nc = 5, format = "latex") {
     # Print with kable
     return(sub_df)
 }
+
+collapse_otu_at_taxo <- function(phylo_data, NArm = TRUE) {
+    tax_ranks <- colnames(tax_table(phylo_data))
+    tax_df <- tax_table(phylo_data)
+    otu_tables_by_rank <- lapply(tax_ranks, function(rank) {
+        ps_glom <- tax_glom(the_data, taxrank = rank, NArm = NArm)
+        otu <- as.data.frame(otu_table(ps_glom))
+
+        # Ensure taxa are rows
+        if (!taxa_are_rows(ps_glom)) {
+            otu <- t(otu)
+        }
+        otu_matrix <- as.matrix(otu)
+        id_in_taxo <- match(rownames(otu_matrix), rownames(tax_df))
+        taxo_names <- tax_df[id_in_taxo, seq(which(tax_ranks == rank))] %>%
+            as.data.frame() %>%
+            mutate_if(.predicate = is_character, .funs = partial(str_replace_all, pattern = "-", replacement = ".")) %>%
+            unite(col = "tax_full", sep = "-") %>%
+            unique()
+        rownames(otu_matrix) <- as.vector(taxo_names[, 1])
+
+        return(otu_matrix)
+    })
+    names(otu_tables_by_rank) <- tax_ranks
+    return(otu_tables_by_rank)
+}