library(metacoder)
hmp_otus$lineage <- sub(hmp_otus$lineage, 
                        pattern = "^r__Root;",
                        replacement = "r__Bacteria;")
hmp_otus$lineage <- paste0("r__Life;", hmp_otus$lineage)
x = parse_tax_data(hmp_otus, class_cols = "lineage", class_sep = ";",
                   class_key = c(tax_rank = "info", tax_name = "taxon_name"),
                   class_regex = "^(.+)__(.+)$")
x = filter_taxa(x, taxon_names == "Proteobacteria", subtaxa = TRUE, supertaxa = TRUE, reassign_obs = F)
plot_one <- function(...) {
  set.seed(2)
  x %>%
    heat_tree(
      node_label = ifelse(is_root, "Root", ""),
      node_size = n_obs,
      # edge_color = "grey",
      layout = "da",
      initial_layout = "re",
      make_node_legend = FALSE,
      title_size = 0.07,
      ...)

}
selected = "red"
unselected = "grey"
target = "black"

my_color <- ifelse(x$taxon_indexes() %in% subtaxa(x, subset = taxon_names == "Betaproteobacteria", simplify = T),
                   selected, unselected)
my_color[x$taxon_names() == "Betaproteobacteria"] <- target
subtaxa_recursive <- plot_one(title = "Subtaxa (recursive = T)", node_color = my_color)

my_color <- ifelse(x$taxon_indexes() %in% subtaxa(x, subset = taxon_names == "Betaproteobacteria", simplify = T, recursive = FALSE), selected, unselected)
my_color[x$taxon_names() == "Betaproteobacteria"] <- target
subtaxa_immediate <- plot_one(title = "Subtaxa (recursive = F) ", node_color = my_color)

my_color <- ifelse(x$taxon_indexes() %in% supertaxa(x, subset = taxon_names == "Betaproteobacteria", simplify = T), selected, unselected)
my_color[x$taxon_names() == "Betaproteobacteria"] <- target
supertaxa_recursive <- plot_one(title = "Supertaxa (recursive = T)", node_color = my_color)

my_color <- ifelse(x$taxon_indexes() %in% supertaxa(x, subset = taxon_names == "Betaproteobacteria", simplify = T, recursive = FALSE), selected, unselected)
my_color[x$taxon_names() == "Betaproteobacteria"] <- target
supertaxa_immediate <- plot_one(title = "Supertaxa (recursive = F)", node_color = my_color)

leaf_plot <- plot_one(title = "Leaves", node_color = ifelse(is_leaf, selected, unselected))

root_plot <- plot_one(title = "Roots", node_color = ifelse(is_root, selected, unselected))

stem_plot <- plot_one(title = "Stems", node_color = ifelse(is_stem, selected, unselected))

internode_plot <- plot_one(title = "Internodes", node_color = ifelse(is_internode, selected, unselected))

branch_plot <- plot_one(title = "Branches", node_color = ifelse(is_branch, selected, unselected))
library(cowplot)
cowplot::plot_grid(plotlist = list(subtaxa_recursive, subtaxa_immediate, supertaxa_recursive, supertaxa_immediate,
                                   leaf_plot, root_plot, stem_plot, internode_plot, branch_plot))


ropenscilabs/taxa documentation built on Feb. 23, 2024, 6:31 p.m.