Highlight presence/absence OTU in one heat tree for each sample

39 views
Skip to first unread message

lfca...@gmail.com

unread,
Nov 20, 2019, 10:51:27 AM11/20/19
to metacoder
Hello Zachary,

I would like to produce one heat tree highlighting only the taxon present for a selected sample (nodes and edges colored in red for example)
I tried several lines but it's not working, I'm missing something......
Thank you for help in advance,

Best regards,

Laurent

> head(taxo)
    Cluster         Phylum               Class         Order                   Family                         Genus              species Kingdom
1 Cluster_1  Bacteroidetes         Bacteroidia Bacteroidales Bacteroidales RF16 group                 unknown genus unidentified species kingdom
2 Cluster_2 Proteobacteria Gammaproteobacteria Aeromonadales      Succinivibrionaceae   Succinivibrionaceae UCG-001      unknown species kingdom
3 Cluster_3     Firmicutes          Clostridia Clostridiales          Lachnospiraceae  Lachnospiraceae NK3A20 group      unknown species kingdom
4 Cluster_4     Firmicutes          Clostridia Clostridiales          Ruminococcaceae Ruminococcaceae NK4A214 group      unknown species kingdom
5 Cluster_5     Firmicutes          Clostridia Clostridiales      Christensenellaceae Christensenellaceae R-7 group      unknown species kingdom
6 Cluster_6     Firmicutes          Clostridia Clostridiales          Ruminococcaceae                Ruminococcus 2      unknown species kingdom

>head(abund)
    Cluster A B C
1 Cluster_1 1 1 0
2 Cluster_2 0 0 1
3 Cluster_3 0 1 0
4 Cluster_4 0 0 1
5 Cluster_5 1 1 1
6 Cluster_6 1 1 0

## create taxmap object with taxonomy
obj <- parse_tax_data(taxo,
                      class_cols = c("Kingdom", "Phylum", "Class", "Order", "Family", "Genus", "species"),
                      named_by_rank = TRUE)

## Add abundance table
obj$data$abund <- abund

## put clusters present only in A in red an others in green (trying)
heat_tree(obj,
          edge_size_range = c(0.005, 0.005),
          node_size_range = c(0.02, 0.02),
          edge_color = ifelse("A" == 1, "red", "green"),
          node_color = ifelse("A" == 1, "red", "blue"))

## Another way ?
obj_A <- filter_obs(obj,
                     "abund",
                     A == 1,
                     B != 1,
                     C != 1)

heat_tree(obj_A,
          edge_size_range = c(0.005, 0.005),
          node_size_range = c(0.02, 0.02),
          edge_color = ifelse("A" == 1, "red", "green"),
          node_color = ifelse("A" == 1, "red", "blue"))

 

Zachary Foster

unread,
Nov 20, 2019, 12:05:58 PM11/20/19
to metacoder
Hello Laurent,

Here is an example of how to do that. Your code might not be working because "A" should be just A and you might not be using per-taxon counts (looks like per-"cluster" counts). Let me know if you have questions.

Best,

Zach

library(metacoder)
#> Loading required package: taxa
#> This is metacoder verison 0.3.3 (stable)

# Parse data for example
x <- parse_tax_data(hmp_otus, class_cols = "lineage", class_sep = ";",
                    class_key = c(tax_rank = "taxon_rank", tax_name = "taxon_name"),
                    class_regex = "^(.+)__(.+)$")

# Calculate the taxon abundance for each numeric column (i.e. sample)
x$data$tax_abund <- calc_taxon_abund(x, "tax_data")
#> No `cols` specified, so using all numeric columns:
#>    700035949, 700097855, 700100489 ... 700102367, 700101358
#> Summing per-taxon counts from 50 columns for 174 taxa


# Make function to plot presence/absence for one sample
plot_one_sample <- function(id) {
  heat_tree(x,
            node_label = taxon_names,
            node_size = n_obs,
            node_color = ifelse(x$data$tax_abund[[id]] > 0, 'red', 'grey'),
            title = id)
}

# Plot presence/absence for each sample
sample_plots <- lapply(hmp_samples$sample_id[1:3], plot_one_sample)
sample_plots[[1]]

sample_plots[[2]]

Created on 2019-11-20 by the reprex package (v0.3.0)

lfca...@gmail.com

unread,
Nov 22, 2019, 5:24:59 AM11/22/19
to metacoder
Ok, I understand, now it's clear
Thank you for your quick response,

Best,

Laurent
Reply all
Reply to author
Forward
0 new messages