library(knitr) library(kableExtra) library(dplyr) library(stringr) ellipse_table <- function(df, nr = 5, nc = 5, format = "latex") { nrows <- nrow(df) ncols <- ncol(df) # Ellipsis symbols depending on format if (format == "latex") { h_ellipsis <- "$\\dots$" # horizontal (for columns) v_ellipsis <- "$\\vdots$" # vertical (for rows) } else { h_ellipsis <- "..." v_ellipsis <- "..." } # Select top/bottom rows row_idx <- c( seq_len(ceiling(nr / 2)), nrows - floor(nr / 2) + 1:nr - nr ) row_idx <- unique(pmax(pmin(row_idx, nrows), 1)) # clamp # Select left/right cols col_idx <- c( seq_len(ceiling(nc / 2)), ncols - floor(nc / 2) + 1:nc - nc ) col_idx <- unique(pmax(pmin(col_idx, ncols), 1)) # Subset sub_df <- df[row_idx, col_idx, drop = FALSE] # Insert ellipsis row if needed if (nrows > nr) { ellipsis_row <- as.list(rep(h_ellipsis, length(col_idx))) sub_df <- rbind( sub_df[1:ceiling(nr / 2), , drop = FALSE], ellipsis_row, sub_df[(ceiling(nr / 2) + 1):nrow(sub_df), , drop = FALSE] ) rownames(sub_df)[ceiling(nr / 2) + 1] <- v_ellipsis } # Insert ellipsis col if needed if (ncols > nc) { ellipsis_col <- rep(v_ellipsis, nrow(sub_df)) sub_df <- cbind( sub_df[, 1:ceiling(nc / 2), drop = FALSE], "..." = ellipsis_col, sub_df[, (ceiling(nc / 2) + 1):ncol(sub_df), drop = FALSE] ) names(sub_df)[ceiling(nc / 2) + 1] <- h_ellipsis } # 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) }