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))
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.