--- title: "Additional file 3: Analysis lark cloacal microbiota biogeography" author: "Pieter van Veelen" date: "5/21/2021" output: html_document --- ```{r setup, include=FALSE} knitr::opts_chunk$set(echo = TRUE) options(scipen = 999) ``` This R Markdown file documents the full downstream analysis of lark microbiota, accompanying the article **Cloacal microbiota are biogeographically structured in larks from desert, tropical and temperate areas** by van Veelen HPJ, Ibáñez-Álamo J-D, Horrocks NPC, Hegemann A, Ndithia NK, Shobrak M, Tieleman BI.
This workflow can be reproduced from Github: All input data is produced from raw *fastq* files using QIIME2 v. 2019.10 with the q2-DADA2 plugin to infer ASVs. See Additional file 2 for the script.
Figures produced in R have been edited with Adobe Illustrator into final formatting styles.
### Set parameters and import data ```{r library install, message=F, echo=T, eval=T, warning=T, include=F, cache=T} # install packages library(devtools) #install.packages("data.table", type = "binary") if (!requireNamespace("devtools", quietly= TRUE)){install.packages("devtools")} devtools::install_github("jbisanz/qiime2R") if (!requireNamespace("devtools", quietly= TRUE)){install.packages("tidyverse")} if (!requireNamespace("devtools", quietly= TRUE)){install.packages("openxlsx")} if (!requireNamespace("lmerTest", quietly= TRUE)){install.packages("lmerTest")} if (!requireNamespace("MuMIn", quietly= TRUE)){install.packages("MuMIn")} if (!requireNamespace("RVAideMemoire", quietly= TRUE)){install.packages("RVAideMemoire")} if (!requireNamespace("ggtext", quietly= TRUE)){install.packages("ggtext")} if (!requireNamespace("geodist", quietly= TRUE)){install.packages("geodist")} if (!requireNamespace("sp", quietly= TRUE)){install.packages("sp")} if (!requireNamespace("geosphere", quietly= TRUE)){install.packages("geosphere")} if (!requireNamespace("adespatial", quietly= TRUE)){install.packages("adespatial")} if (!requireNamespace("mapview", quietly= TRUE)){install.packages("mapview")} if (!requireNamespace("ggdist", quietly= TRUE)){install.packages("ggdist")} if (!requireNamespace("ggforce", quietly= TRUE)){install.packages("ggforce")} if (!requireNamespace("gghalves", quietly= TRUE)){install.packages("gghalves")} if (!requireNamespace("ggbeeswarm", quietly= TRUE)){install.packages("ggbeeswarm")} if (!requireNamespace("AICcmodavg", quietly= TRUE)){install.packages("AICcmodavg")} if (!requireNamespace("ComplexHeatmap", quietly= TRUE)){install_github("jokergoo/ComplexHeatmap")} if (!requireNamespace("BiocManager", quietly = TRUE)){install.packages("BiocManager")} if (!requireNamespace("ANCOMBC", quietly = TRUE)){BiocManager::install("ANCOMBC")} if (!requireNamespace("usedist", quietly = TRUE)){devtools::install_github("kylebittinger/usedist")} if (!requireNamespace("ampvis2", quietly = TRUE)){remotes::install_github("MadsAlbertsen/ampvis2")} if (!requireNamespace("microbiome", quietly= TRUE)){install_github("microbiome/microbiome")} ``` ```{r library loading, message=F, echo=T, eval=T, warning=F, include=T, cache=F} ## load required packages library(phyloseq) library(qiime2R) library(tidyverse) library(magrittr) library(devtools) library(qiime2R) library(here) library(breakaway) library(DivNet) library(openxlsx) library(ape) library(vegan) library(lme4) library(MuMIn) library(lmerTest) library(RVAideMemoire) library(ggtext) library(geodist) library(sp) library(geosphere) library(adespatial) library(ggdist) library(gghalves) library(ggbeeswarm) library(ggforce) library(RColorBrewer) library(reshape2) library(ampvis2) library(data.table) library(cowplot) library(lmerTest) library(emmeans) library(specr) library(RColorBrewer) library(sf) library(mapview) library(usedist) library(ape) library(ggrepel) library(modelr) library(broom) library(AICcmodavg) library(ANCOMBC) library(DT) library(devtools) library(microbiome) library(ComplexHeatmap) ``` A phyloseq object was created from QIIME2 output files: table.qza, taxonomy.qza, rooted-tree.qza with sample data as metadata.txt. These files contained also samples from other projects, and were therefore processed separately. The operations performed on these data were as follows: 1) the phylogeny was resolved using the multi2di function from the ape package before inclusion in the phyloseq object; 2) taxa belonging to mitochondria and chloroplasts were removed; 3) the taxonomic information was cleaned with NA values filled with higher order affiliations; 4) latitude and longitude data were added to sample_data. The resulting phyloseq object was filtered to retain the samples belonging to this project (n=125) and saved as **ps_lark_biogeography_n125.RDS**. ```{r organize project, message=F, echo=F, eval=T, warning=F, include=F, cache=F} # create directories if(!dir.exists("input_data")){dir.create("input_data")} if(!dir.exists("scripts")){dir.create("scripts")} if(!dir.exists("figures")){dir.create("figures")} if(!dir.exists("output_data")){dir.create("output_data")} # load external r scripts source("scripts/amp_rarecurve.r") source("scripts/amp_rankabundance.r") source("scripts/ampvis2_internals.r") source("scripts/phyloseq_to_ampvis.r") source("scripts/ps_venn.r") source("scripts/get_top_taxa.r") ``` ```{r import ps_object, message=F, echo=T, eval=T, warning=F, include=T, cache=F} # import additional metadata # add latitude and longitude positions lark_n125_metadata <- read.xlsx("input_data/metadata_larks_n125_final.xlsx") %>% mutate(SampleID = X.SampleID) %>% select(-X.SampleID) %>% mutate( lon = if_else( Population == "Mahazat as-Sayd", 41.73333, if_else(Population == "Taif", 40.7, if_else(Population == "Kedong", if_else(SpeciesID == "Red-capped Lark", 36.41667, 36.53333), if_else(Population == "Kinangop", 36.48333, 6.3)))), lat = if_else( Population == "Mahazat as-Sayd", 22.33333, if_else(Population == "Taif", 21.25, if_else(Population == "Kedong", if_else(SpeciesID == "Red-capped Lark", -0.85, -0.8), if_else(Population == "Kinangop", -0.5666667, 52.93333))))) %>% mutate(SampleID = as.factor(SampleID)) %>% mutate_if(is.factor, as.character) # summarise samples lark_n125_metadata %>% select(SpeciesID, Population) %>% group_by(SpeciesID, Population) %>% summarise(n = n()) # import phyloseq if needed if(!exists("psdata_larks")){ ps = readRDS("input_data/ps_lark_biogeography_n125.RDS") } # add lark_n125_metadata to ps sam_dat_complete = sample_data(ps) %>% as_tibble() %>% select(SampleID, everything()) %>% inner_join(., lark_n125_metadata, by = "SampleID") %>% select(-ends_with(".x")) %>% rename_all(~str_replace_all(., pattern = ".y", replacement = "")) %>% mutate_if(is.character, as.factor) %>% mutate(samples = SampleID) %>% select(-SampleID) %>% sample_data() sample_names(sam_dat_complete) <- sample_data(sam_dat_complete)$samples sample_data(ps) = sample_data(sam_dat_complete) ps ``` ```{r explore ps_object, message=F, echo=T, eval=T, warning=F, include=T, cache=F} # full dataset ps # relative abundance data ps_rel <- transform_sample_counts(ps, fun = function(x) x/sum(x)) # 6323 taxa (100% abundance) # abundance filter at (0.01%, 0.1% 0.5%) ps_0.01pct <- prune_taxa(taxa_sums(ps_rel) > 0.0001, ps) #6178 ps_0.1pct <- prune_taxa(taxa_sums(ps_rel) > 0.001, ps) #4206 ps_0.5pct <- prune_taxa(taxa_sums(ps_rel) > 0.005, ps) #1621 ps_1pct <- prune_taxa(taxa_sums(ps_rel) > 0.01, ps) #993 total = sum(sample_sums(ps)) # 2118741 reads 100*(sum(sample_sums(ps_0.01pct))/total) #(99.99% abundance) 100*(sum(sample_sums(ps_0.1pct))/total) #(98.91% abundance) 100*(sum(sample_sums(ps_0.5pct))/total) #(94.52% abundance) ### choice to continue downstream analysis with abundance filter that retains ASVs with at least 0.1% of total read abundance. ps_unfiltered <- ps # save unfiltered data ps <- ps_0.1pct # overwrite ps for abundance filtered data ``` The sample coverage range is between `r min(sample_sums(ps))` and `r max(sample_sums(ps))` after filtering ASVs with a relative abundance of 0.01% of the total read abundance of `r sum(sample_sums(ps))` reads per sample. This filtering retains 99.99% of reads. ```{r rarefaction curves, message=F, echo=T, eval=T, warning=F, include=T, cache=F} # alpha rarefaction curve #### calculate rarefaction curves using amp_rarecurve.r # amp_rarecurve(ps_unfiltered, color = "SampleID", legend.position = "bottomright", legend = T) pdf("figures/Fig_S1_Rarefaction_curve_plot_samples.pdf", width = 5, height = 4, useDingbats = F) amp_rarecurve(ps, color = "Population", legend = T, xlim = c(0, 8000)) dev.off() rare_curve <- amp_rarecurve(ps, color = "Population", legend = T, xlim = c(0, 8000)) rare_curve rank_abund_plot <- amp_rankabundance(phyloseq_to_ampvis2(ps), group_by = "Population") + scale_color_manual(values = brewer.pal(8, "Paired")[c(1, 3, 4, 5, 6)]) + scale_fill_manual(values = brewer.pal(8, "Paired")[c(1, 3, 4, 5, 6)]) rank_abund_plot ggsave(plot = rank_abund_plot, filename = "figures/Fig_S3_Rankabundance_plot_locations.pdf", width = 5, height = 4) ``` #### Alpha diversity of cloacal microbiota ```{r alpha diversity , message=F, echo=T, eval=T, warning=T, include=T, cache=T} ## all data (0.01% filtered) ps sample_data(ps)$SampleID = sample_data(ps)$samples ## rarefied to 4000 r/s set.seed(711) ps_1000 <- rarefy_even_depth(ps, 1000, rngseed = 711) # lost 7 samples to 118 left ps_2000 <- rarefy_even_depth(ps, 2000, rngseed = 711) # lost 10 samples to 115 left ps_3000 <- rarefy_even_depth(ps, 3000, rngseed = 711) # lost 19 samples to 106 left ps_4000 <- rarefy_even_depth(ps, 4000, rngseed = 711) # lost 24 samples to 101 left # calculate richness alpha <- estimate_richness(ps_4000, measures = c("Chao1", "Shannon")) alpha$SampleID <- sample_names(ps_4000) metadata <- data.frame(sample_data(ps_4000)) alpha2 <- estimate_richness(ps_4000, measures = c("Observed","Chao1", "Shannon")) alpha2$SampleID <- sample_names(ps_4000) alpha2 = alpha2 %>% mutate(Evenness = (Shannon/log(Observed))) alpha2 <- left_join(metadata, alpha2, by = "SampleID") # plot alpha populations alpha <- left_join(metadata, alpha, by = "SampleID") chao1 <- alpha %>% ggplot(aes(x=Population, y=Chao1, color = Population)) + geom_boxplot(show.legend = F) + scale_color_manual(values = c(brewer.pal(6, "Paired")[2:6])) + geom_jitter(width = 0.2) + theme_classic() + guides(color = guide_legend(nrow=2)) + theme(axis.text.x = element_text(angle = 90, hjust = 1)) shannon <- alpha %>% ggplot(aes(x=Population, y=Shannon, color = Population)) + geom_boxplot(show.legend = F) + geom_jitter(width = 0.2) + scale_color_manual(values = c(brewer.pal(6, "Paired")[2:6])) + theme_classic() + guides(color = guide_legend(nrow=2)) + theme(axis.text.x = element_text(angle = 90, hjust = 1)) prow = plot_grid(chao1 + theme(legend.position = "none"), shannon + theme(legend.position = "none"), align = "vh", labels = c("A", "B"), hjust = -1, nrow = 1) legend_alpha_pop <- get_legend(chao1 + guides(color = guide_legend(ncol = 1)) + theme(legend.position = "right")) alpha_popplot <- plot_grid(prow, legend_alpha_pop, ncol=2, rel_widths = c(3, 0.3)) # plot alpha Species chao1_sp = alpha %>% ggplot(aes(x=SpeciesID, y=Chao1, color = SpeciesID)) + geom_boxplot(show.legend = F) + scale_color_manual(values = c("#EE4025", "#C85E28", "#D53793", "#98509E", "#F47E20", "#65BB47", "#0F9F4A", "#4B84C4", "#2F53A2")) + geom_jitter(width = 0.2) + theme_classic() + guides(color = guide_legend(nrow=3)) + theme(axis.text.x = element_text(angle = 90, hjust = 1)) shannon_sp <- alpha %>% ggplot(aes(x=SpeciesID, y=Shannon, color = SpeciesID)) + geom_boxplot(show.legend = F) + geom_jitter(width = 0.2) + scale_color_manual(values = c("#EE4025", "#C85E28", "#D53793", "#98509E", "#F47E20", "#65BB47", "#0F9F4A", "#4B84C4", "#2F53A2")) + theme_classic() + guides(color = guide_legend(nrow=3)) + theme(axis.text.x = element_text(angle = 90, hjust = 1)) prow_sp = plot_grid(chao1_sp + theme(legend.position = "none"), shannon_sp + theme(legend.position = "none"), align = "vh", labels = c("C", "D"), hjust = -1, nrow = 1) legend_alpha_sp <- get_legend(chao1_sp + guides(color = guide_legend(ncol = 1)) + theme(legend.position = "right")) alpha_spplot <- plot_grid(prow_sp, legend_alpha_sp, ncol = 2, rel_widths = c(2, 0.5)) all_plot <- plot_grid(alpha_popplot, alpha_spplot, nrow = 2, rel_heights = c(5,5)) all_plot ggsave(plot = all_plot, "figures/Fig.1_Alpha_all_AD.pdf", width = 10, height = 10) ``` **Fig. 1**. Alpha diversity of cloacal microbiota of larks from desert, tropical and temperate habitats. (A) Total estimated ASV richness (Chao1) and (B) Shannon diversity at geographical locations. Alpha diversity of cloacal microbiota of nine lark species represented as (C) Total estimated ASV richness (Chao1) and (D) Shannon diversity across nine lark species.
```{r alpha diversity stats, message=F, echo=T, eval=T, warning=T, include=F, cache=F} # test H0=locations do not differ in alpha div, with SpeciesID as random effect chao1_lmer1 <- alpha %>% mutate(chao1_log = log(Chao1)) %>% with(lmer(chao1_log ~ Population + (1|SpeciesID))) anova(chao1_lmer1) #pairs(emmeans(chao1_lmer1, "Population")) # check assumptions qqnorm(resid(chao1_lmer1)) plot(resid(chao1_lmer1)~fitted(chao1_lmer1)) # conditional R2 r.squaredGLMM(chao1_lmer1) ## Species ID chao1_lmer1_sp_null <- alpha %>% mutate(chao1_log = log(Chao1)) %>% with(lmer(chao1_log ~ 1 + (1|SpeciesID))) chao1_lmer1_sp_null %>% summary() icc_specs(chao1_lmer1_sp_null) chao1_lmer1_sp <- alpha %>% mutate(chao1_log = log(Chao1)) %>% with(lmer(Chao1 ~ SpeciesID + (1|Population))) chao1_lmer1_pop_null = alpha %>% mutate(chao1_log = log(Chao1)) %>% with(lmer(Chao1 ~ 1 + (1|Population))) chao1_lmer1_pop_null %>% summary() icc_specs(chao1_lmer1_pop_null) chao1_lmer1_sp %>% anova() pairs(emmeans(chao1_lmer1_sp, "SpeciesID")) chao1_lm_sp <- alpha %>% mutate(chao1_log = log(Chao1)) %>% with(lm(chao1_log ~ SpeciesID)) anova(chao1_lmer1_sp) anova(chao1_lm_sp) pairs(emmeans(chao1_lm_sp, "SpeciesID")) ## Shannon diversity shannon_lmer_null <- alpha %>% with(lmer(Shannon ~ 1 + (1|SpeciesID))) shannon_lmer1 <- alpha %>% with(lmer(Shannon ~ Population + (1|SpeciesID))) anova(shannon_lmer1) qqnorm(resid(shannon_lmer1)) icc_specs(shannon_lmer_null) pairs(emmeans(shannon_lmer1, "Population")) # check assumptions qqnorm(resid(shannon_lmer1)) plot(resid(shannon_lmer1)~fitted(shannon_lmer1)) r.squaredGLMM(shannon_lmer1) # Species ID shannon_lmer_sp <- alpha %>% with(lm(Shannon ~ SpeciesID)) anova(shannon_lmer_sp) #pairs(emmeans(shannon_lmer_sp, "SpeciesID")) ``` #### Beta diversity of cloacal microbiota ```{r run beta diversity, eval=T, echo=T, message=FALSE, warning=TRUE, cache=T, include=F} ### Beta diversity analysis # input is relative abundance table ps2 <- subset_samples(ps, sample_sums(ps) > 1500) set.seed(711) # min sample sums min(sample_sums(ps2)) # n=1548 #rarefied data ps2_rare_1548 <- rarefy_even_depth(ps2, sample.size = min(sample_sums(ps2))) # relative abundance data ps_rel2 <- transform_sample_counts(ps2, fun = function(x) x/sum(x)) # otu tables otu_tab = as.data.frame(t(otu_table(prune_taxa(taxa_sums(ps2)>0, ps2)))) otu_tab_rel = as.data.frame(t(otu_table(prune_taxa(taxa_sums(ps_rel2)>0, ps_rel2)))) dist_avg_bray = avgdist(otu_tab, dmethod = "bray", sample = 1548) vegdist_bray = vegdist(otu_tab, "bray") vegdist_bray_rel = vegdist(otu_tab_rel, "bray") # ordinations #nmds set.seed(711) nmds_avg_BC = metaMDS(dist_avg_bray) #pcoa pcoa_avg_BC = cmdscale(dist_avg_bray) pcoa_BC = cmdscale(vegdist_bray) pcoa_BC_rel = cmdscale(vegdist_bray_rel) colnames(pcoa_avg_BC) = c("pcoa1", "pcoa2") colnames(pcoa_BC) = c("pcoa1", "pcoa2") colnames(pcoa_BC_rel) = c("pcoa1", "pcoa2") # add sample column from rownames pcoa_avg_BC = pcoa_avg_BC %>% as_tibble(rownames = "samples") pcoa_BC = pcoa_BC %>% as_tibble(rownames = "samples") pcoa_BC_rel = pcoa_BC_rel %>% as_tibble(rownames = "samples") # metadata met_pcoa = as.data.frame(sample_data(ps2)) # using phyloseq ordinations # create ordinations PCoA_BC <- ordinate(ps_rel2, method = "PCoA", distance = "bray") PCoA_Jac <- ordinate(ps_rel2, method = "PCoA", distance = "jaccard") PCoA_uu <- ordinate(ps_rel2, method = "PCoA", distance = "uunifrac") PCoA_wu <- ordinate(ps_rel2, method = "PCoA", distance = "wunifrac") test1=inner_join(pcoa_BC, met_pcoa, by = c("samples"="SampleID")) %>% ggplot(aes(x=pcoa1, y=pcoa2)) + geom_point(aes(color = Population)) + theme(legend.position="right") + scale_color_manual(values = c(brewer.pal(6, "Paired")[2:6])) + theme_classic() + ggtitle("vegdist of not-rarefied not normalised counts") test2=inner_join(pcoa_avg_BC, met_pcoa, by = c("samples"="SampleID")) %>% ggplot(aes(x=pcoa1, y=pcoa2)) + geom_point(aes(color = Population)) + theme(legend.position="right") + scale_color_manual(values = c(brewer.pal(6, "Paired")[2:6])) + theme_classic() + ggtitle("rarefied 1548 (average of 100 times)") test3=inner_join(pcoa_BC_rel, met_pcoa, by = c("samples"="SampleID")) %>% ggplot(aes(x=pcoa1, y=pcoa2)) + geom_point(aes(color = Population)) + theme(legend.position="right") + scale_color_manual(values = c(brewer.pal(6, "Paired")[2:6])) + theme_classic() + ggtitle("tss normalized as in paper") test4=plot_ordination(physeq = ps_rel2, ordination = PCoA_BC, type = "samples", axes = c(1,2), color = "Population") + theme(legend.position="right") + scale_color_manual(values = c(brewer.pal(6, "Paired")[2:6])) + theme_classic() + ggtitle("plot_ordination tss-normalised") cowplot::plot_grid(test1, test2, test3,test4, nrow = 2, ncol = 2) ``` Beta diversity patterns are qualitatively robust against normalisation/rarefying choices in our data set. ### Beta diversity ordinations ```{r plot beta diversity, message=F, echo=T, eval=T, warning=T, include=T, cache=T} # plot PCoA # Bray-Curtis ps_rel2 plot_PCoA_BC <- plot_ordination(physeq = ps_rel2, ordination = PCoA_BC, type = "samples", axes = c(1,2), color = "Population") + theme(legend.position="right") + scale_color_manual(values = c(brewer.pal(6, "Paired")[2:6])) + theme_classic() # Unweighted UniFrac plot_PCoA_uu <- plot_ordination(physeq = ps_rel2, ordination = PCoA_uu, type = "samples", axes = c(1,2), color = "Population") + ggtitle("unweighted UniFrac") + theme(legend.position="bottom") + scale_color_manual(values = brewer.pal(6, "Paired")[2:6]) + guides(col = guide_legend(ncol=1)) + theme_classic() ### by species plot_PCoA_BC2 <- plot_ordination(physeq = ps_rel2, ordination = PCoA_BC, type = "samples", axes = c(1,2), color = "SpeciesID") + ggtitle("BC") + scale_color_manual(values = c("#EE4025", "#C85E28", "#D53793", "#98509E", "#F47E20", "#65BB47", "#0F9F4A", "#4B84C4", "#2F53A2")) + theme(legend.position="right") + guides(col = guide_legend(ncol = 1)) + theme_classic() plot_PCoA_uu2 <- plot_ordination(physeq = ps_rel2, ordination = PCoA_uu, type = "samples", axes = c(1,2), color = "SpeciesID") + ggtitle("unweighted UniFrac") + theme(legend.position="bottom") + scale_color_manual(values = c(brewer.pal(8, "Paired"), "grey20")) + guides(col = guide_legend(ncol = 1)) + theme_classic() ggsave(plot = plot_PCoA_uu, "figures/Fig_4A_unw_unifrac_populations.pdf", width = 6, height = 4) ggsave(plot = plot_PCoA_uu2, "figures/Fig_4B_unw_unifrac_SpeciesID.pdf", width = 6, height = 4) ord_pop_sp = plot_grid(plot_PCoA_uu + ggtitle(NULL), plot_PCoA_uu2 + ggtitle(NULL), align = "vh", labels = c("A", "B"), hjust = -1, nrow = 1) ord_bc_pop_sp = plot_grid(plot_PCoA_BC + ggtitle(NULL), plot_PCoA_BC2 + ggtitle(NULL), align = "vh", labels = c("A", "B"), hjust = -1, nrow = 1) ord_pop_sp ggsave(plot = ord_pop_sp, "figures/Fig_4AB_unw_unifrac_populations_speciesID.pdf", width = 12, height = 4) ord_bc_pop_sp ggsave(plot = ord_bc_pop_sp, "figures/Fig_S5_BC_population_speciesID.pdf", width = 12, height = 4) ``` ### Beta diversity statistics ```{r total beta diversity stats, message=F, echo=T, eval=T, warning=T, include=T, cache=T} ## # preliminary: needs to include sqrt transformation and wisconsin double standardisation as in plot metadata2 <- data.frame(sample_data(ps_4000), stringsAsFactors = T) dist_bc_4000 = vegdist(t(otu_table(ps_4000)) , method = "bray") dist_uu_4000 = phyloseq::UniFrac(ps_4000, weighted = F) dist_bc_rel = vegdist(t(otu_table(ps_rel2)) , method = "bray") dist_uu_rel = phyloseq::UniFrac(ps_rel2, weighted = F) # test model assumptions with vegan::betadisper betadisper_bc_4000 <- betadisper(dist_bc_4000, metadata2$Population) permutest(betadisper_bc_4000, pairwise=T) betadisper_uu_4000 <- betadisper(dist_uu_4000,metadata2$Population) permutest(betadisper_uu_4000, pairwise=T) betadisper_bc_rel <- betadisper(dist_bc_rel,met_pcoa$Population) permutest(betadisper_bc_rel, pairwise=T) betadisper_uu_rel <- betadisper(dist_uu_rel,met_pcoa$Population) permutest(betadisper_uu_rel, pairwise=T) ## for all beta diversity metrics significant group differences were found in group dispersions (distance to centroid). met_pcoa = data.frame(met_pcoa) # PERMANOVA (permutational multivariate analysis of variance) with the 'adonis' function adonis_bc <- adonis2(dist_bc_4000 ~ Population, permutations = 999, data = metadata2, by = "margin") adonis_bc adonis_uu <- adonis2(dist_uu_rel ~ Population, permutations = 999, data = met_pcoa, by = "margin") adonis_uu saveRDS(dist_uu_rel, "output_data/dist_uu.rds") saveRDS(dist_bc_4000, "output_data/dist_bc.rds") saveRDS(met_pcoa, "output_data/metadata_permanova.rds") ## Pairwise permanova with RVAideMemoire is not working because of conflicting vegan versions. The following commands were run in a separate R session, outside of this Rmd. # library(RVAideMemoire) # RVAideMemoire::pairwise.perm.manova(dist_bc, fact = met_pcoa$Population) # RVAideMemoire::pairwise.perm.manova(dist_uu, fact = met_pcoa$Population) # Lark species effect adonis_bc_sp <- adonis2(dist_bc_4000 ~ SpeciesID + Population, permutations = 999, data = metadata2, by = "margin") adonis_bc_sp adonis_uu_sp <- adonis2(dist_uu_rel ~ SpeciesID + Population, permutations = 999, data = met_pcoa, by = "margin") adonis_uu_sp ``` ### Summary of species per sites ```{r distance to beta diversity, message=F, echo=T, eval=T, warning=T, include=T, cache=T} # summarize number of samples per geographic location and per lark species data.frame(sample_data(ps_rel2)) %>% as_tibble() %>% group_by(Population) %>% summarize(count = n()) data.frame(sample_data(ps_rel2)) %>% as_tibble() %>% group_by(SpeciesID) %>% summarize(count = n()) data.frame(sample_data(ps_rel2)) %>% as_tibble() %>% group_by(Population, SpeciesID) %>% summarize(count = n()) ``` #### Venn diagramm for co-occurrence and co-exclusion patterns ```{r venn diagram, message=F, echo=T, eval=T, warning=F, include=T, cache=T} # from https://rdrr.io/github/Russel88/MicEco/man/ps_venn.html ps_rel2 ps_4000 ps_4000_genus <- tax_glom(ps_4000, "Genus") # plot venn venn_count_4000 <- ps_venn(ps = ps_4000, group = 'Population', fraction = 0, weight = F, type = "counts", relative = F, plot = T) venn_count_4000 # plot venn Genus venn_count_4000_g <- ps_venn(ps = ps_4000_genus, group = 'Population', fraction = 0, weight = F, type = "counts", relative = F, plot = T) venn_count_4000_g venn_count_4000_g_perc <- ps_venn(ps = ps_4000_genus, group = 'Population', fraction = 0, weight = F, type = "percent", relative = F, plot = T) venn_count_4000_g_perc venn_count <- ps_venn(ps = ps_rel2, group = 'Population', fraction = 0, weight = F, type = "counts", relative = F, plot = T) #ggsave(venn_count, "figures/VennDiagram_per_Population.pdf") venn_perc <- ps_venn(ps = ps_4000, group = 'Population', fraction = 0, weight = F, type = "percent", relative = F, plot = T) venn_perc venn_perc_region <- ps_venn(ps = ps_4000, group = 'Count', fraction = 0, weight = F, type = "percent", relative = F, plot = T) venn_perc_region venn_perc_region_g <- ps_venn(ps = ps_4000_genus, group = 'Population', fraction = 0, weight = F, type = "percent", relative = F, plot = T) venn_perc_region_g ggsave(plot = plot_grid(venn_perc, venn_perc_region_g), "figures/venn_combination2.pdf", width = 10, height = 6) ``` ### create relative abundance plots ```{r rel abund barplot Classes, message=F, echo=T, eval=T, warning=T, include=T, cache=F} colorset <- c("darkblue", "darkgoldenrod1", "darkseagreen", "darkorchid", "darkolivegreen1", "lightskyblue", "darkgreen", "khaki2", "firebrick", "brown1", "darkorange1", "cyan1", "royalblue4", "darksalmon", "darkblue", "royalblue4", "dodgerblue3", "steelblue1", "lightskyblue", "darkseagreen", "darkgoldenrod1", "darkseagreen", "darkorchid", "darkolivegreen1", "brown1", "darkorange1", "cyan1", "darkgrey", "darkblue", "darkgoldenrod1", "darkseagreen", "darkorchid", "darkolivegreen1", "lightskyblue", "darkgreen", "deeppink", "khaki2", "firebrick", "brown1", "darkorange1", "cyan1", "royalblue4", "darksalmon", "darkblue", "royalblue4", "dodgerblue3", "steelblue1", "lightskyblue", "darkseagreen", "darkgoldenrod1", "darkseagreen", "darkorchid", "darkolivegreen1", "brown1", "darkorange1", "cyan1", "darkgrey") ps_Class <- psmelt(transform_sample_counts(tax_glom(ps, "Class"), fun = function(x) x/sum(x))) # count n phyla ps_Class %>% as_tibble() %>% mutate(Class = factor(Class)) %>% pull(Class) %>% levels() Class_abundances <- ps_Class %>% as_tibble() %>% select(Sample, Population, Class, Abundance) %>% mutate(Population = as.character(Population)) %>% group_by(Sample, Population, Class) %>% summarize(rel_abund = sum(Abundance), .groups = "drop") %>% group_by(Population, Class) %>% summarize(mean_rel_abund = 100* mean(rel_abund), .groups = "drop") %>% mutate(Population = factor(Population, levels = c("Aekingerzand", "Mahazat as-Sayd", "Taif", "Kinangop", "Kedong"))) %>% mutate(Class = str_replace(Class, "(.*)_unclassified", "Unclassified *\\1*"), Class = str_replace(Class, "^(\\S*)$", "*\\1*")) Class_pool <- Class_abundances %>% group_by(Class) %>% summarize(pool = max(mean_rel_abund) < 3, mean = mean(mean_rel_abund), .groups = "drop") inner_join(Class_abundances, Class_pool, by="Class") %>% mutate(Class = if_else(pool, "Other", Class)) %>% group_by(Population, Class) %>% summarize(mean_rel_abund = sum(mean_rel_abund), mean = min(mean), .groups = "drop") %>% mutate(Class = factor(Class), Class = fct_reorder(Class, mean, .desc = T), Class = fct_shift(Class, n=1)) %>% ggplot(aes(x=Population, y = mean_rel_abund, fill = Class)) + scale_fill_manual(values = colorset) + geom_col() + scale_fill_manual(name="Class", values = c(brewer.pal(6,"Dark2"), brewer.pal(6, "Paired"))) + # with palette #values = colorset) + scale_y_continuous(expand = c(0,0)) + labs(x=NULL, y="Mean Relative Abundance (%)") + scale_x_discrete(breaks = c("Aekingerzand", "Mahazat as-Sayd", "Taif", "Kinangop", "Kedong"), labels = c("Aekingerzand
*The Netherlands*", "Mahazat as-Sayd
*Saudi Arabia*", "Taif
*Saudi Arabia*", "Kinangop
*Kenya*", "Kedong
*Kenya*")) + theme_classic() + theme(axis.text.x = element_markdown(), legend.text = element_markdown(), legend.key.size = unit(10, "pt")) ggsave("figures/Fig.3A_Population_rel_barplot_Class_remade.pdf", width = 8, height = 6) ``` ### Class abundances per species ID ```{r Class rel abundances SpeciesID, message=F, echo=T, eval=T, warning=T, include=T, cache=F} Class_abundances_sp <- ps_Class %>% as_tibble() %>% select(Sample, SpeciesID, Class, Abundance) %>% mutate(SpeciesID = as.character(SpeciesID)) %>% group_by(Sample, SpeciesID, Class) %>% summarize(rel_abund = sum(Abundance), .groups = "drop") %>% group_by(SpeciesID, Class) %>% summarize(mean_rel_abund = 100* mean(rel_abund), .groups = "drop") %>% mutate(SpeciesID = factor(SpeciesID)) %>% mutate(Phylum = str_replace(Class, "(.*)_unclassified", "Unclassified *\\1*"), Phylum = str_replace(Class, "^(\\S*)$", "*\\1*")) Class_pool_sp <- Class_abundances_sp %>% group_by(Class) %>% summarize(pool = max(mean_rel_abund) < 3, mean = mean(mean_rel_abund), .groups = "drop") inner_join(Class_abundances_sp, Class_pool_sp, by="Class") %>% mutate(Class = if_else(pool, "Other", Class)) %>% group_by(Class) %>% summarize(mean_rel_abund = sum(mean_rel_abund), mean = min(mean), .groups = "drop") %>% mutate(Class = factor(Class), Class = fct_reorder(Class, mean, .desc = T)) inner_join(Class_abundances_sp, Class_pool_sp, by="Class") %>% mutate(Class = if_else(pool, "Other", Class)) %>% group_by(SpeciesID, Class) %>% summarize(mean_rel_abund = sum(mean_rel_abund), mean = min(mean), .groups = "drop") %>% mutate(Class = factor(Class), Class = fct_reorder(Class, mean, .desc = T), Class = fct_shift(Class, n=1)) %>% ggplot(aes(x=SpeciesID, y = mean_rel_abund, fill = Class)) + geom_col() + scale_fill_manual(name="Class", values = c(brewer.pal(6,"Dark2"), brewer.pal(6,"Paired"))) + # with palette #values = colorset) + scale_y_continuous(expand = c(0,0)) + labs(x=NULL, y="Mean Relative Abundance (%)") + coord_flip() + theme_classic() + theme(axis.text.x = element_markdown(), legend.text = element_markdown(), legend.key.size = unit(10, "pt")) ggsave("figures/Fig.S4_Species_rel_barplot_Class_remade.pdf", width = 8, height = 6) ``` ### Get top taxa ASV level ```{r top ASVs, message=F, echo=T, eval=T, warning=F, include=T, cache=F} # https://rdrr.io/github/gmteunisse/Fantaxtic/src/R/get_top_taxa.R top_6_ASVs_ps <- get_top_taxa(ps, n = 6, relative = T, discard_other = F, other_label = "Other") # psmelt(top_6_ASVs_ps) %>% # as_tibble() %>% # group_by(Population, Abundance, Species) %>% # summarise(mean_abund = mean(Abundance), .groups = "drop") %>% # arrange(desc(mean_abund)) %>% # filter(Species != "Other") %>% # ggplot(aes(x=Species, y = Abundance, fill=Population)) + # geom_bar(stat="identity", position = position_dodge(3)) + # scale_fill_manual(name="Class", # values = c(brewer.pal(6,"Dark2"), brewer.pal(6, "Paired"))) + # with palette # #values = colorset) + # coord_flip() + # scale_y_continuous(trans = "log10") + # theme_classic() + # facet_wrap(~Population) + # ggtitle("Six most abundant ASVs across all cloacal microbiota") + # labs(y = "cumulative read count", # x = "Top 6 ASVs") ## ASV level ASV_abundances <- psmelt(ps_rel2) %>% as_tibble() %>% select(Sample, Population, OTU, Abundance) %>% mutate(Population = as.character(Population)) %>% group_by(Sample, Population, OTU) %>% summarize(rel_abund = sum(Abundance), .groups = "drop") %>% group_by(Population, OTU) %>% summarize(mean_rel_abund = 100* mean(rel_abund), .groups = "drop") ASV_pool <- ASV_abundances %>% group_by(OTU) %>% summarize(pool = max(mean_rel_abund) < 3, mean = mean(mean_rel_abund), .groups = "drop") ASV_top <- inner_join(ASV_abundances, ASV_pool, by="OTU") %>% mutate(OTU = if_else(pool, "Other", OTU)) %>% group_by(Population, OTU) %>% summarize(mean_rel_abund = sum(mean_rel_abund), mean = min(mean), .groups = "drop") %>% mutate(OTU = factor(OTU), OTU = fct_reorder(OTU, mean, .desc = T)) %>% filter(OTU != "Other") %>% arrange(desc(mean_rel_abund)) %>% group_by(Population, OTU) %>% summarize(rel_abund = mean(mean_rel_abund), .groups = "drop") OTU_meta <- psmelt(ps_rel2) %>% as_tibble() %>% select(OTU, Class, Genus, Species) %>% mutate(OTU = factor(OTU)) %>% filter(OTU %in% ASV_top$OTU) inner_join(ASV_top, OTU_meta, by = "OTU") %>% distinct %>% ggplot(aes(x = Population, y = Species, color = Class, size = rel_abund)) + geom_point() + scale_color_manual(name="Class", values = c(brewer.pal(6,"Dark2"), brewer.pal(6, "Paired"))) + theme_classic() + theme(legend.position = "right") ggsave("figures/Fig_3B_Bubbleplot_MostDominant_ASVs_2.pdf", width = 12, height = 5) ``` ### Create distance matrix of spatial proximity at species level ```{r spatial distance, message=F, echo=F, eval=T, warning=T, include=F, cache=F} # subset samples in beta diversity analyses ss_n118 <- lark_n125_metadata %>% filter(SampleID %in% sample_names(ps_rel2)) %>% as_tibble() %>% mutate(SampleID = as.factor(SampleID)) # verify Populations on a map locations_sf <- st_as_sf(ss_n118, coords = c("lon", "lat"), crs = 4326) mapview(locations_sf) # create distance matrix of geographic distances df_ll <- as.data.frame(ss_n118) row.names(df_ll) <- df_ll$SampleID df_ll <- df_ll[,c("lon", "lat")] geo_dist <- as.dist(distm(df_ll, fun = distGeo), upper = F, diag = T) geo_dist <- dist_setNames(d = geo_dist, nm = row.names(df_ll)) if(!dir.exists("distances_test")){dir.create("distances_test")} write_csv(as.data.frame(as.matrix(geo_dist)), file = "distances_test/dist_geo.csv") ``` ```{r reshape distance matrices, message=F, echo=T, eval=T, warning=T, include=T, cache=F} ### unweighted unifrac dist long ### pop1 <- dist_uu_rel %>% as.matrix() %>% as_tibble(rownames = "SampleID") %>% pivot_longer(-SampleID) %>% rename(pop1=SampleID, pop2=name, distance = value) %>% mutate_if(is.character, as.factor) %>% inner_join(., ss_n118, by = c("pop1" = "SampleID")) %>% select(pop1, pop2, distance, SpeciesID, Country, Population) %>% rename(SpeciesID_1 = SpeciesID, Country_1 = Country, Population_1 = Population) pop2_meta <- ss_n118 %>% select(SampleID, SpeciesID, Country, Population) %>% rename(SpeciesID_2 = SpeciesID, Country_2 = Country, Population_2 = Population) df_uu_dist <- pop1 %>% inner_join(., pop2_meta, by = c("pop2" = "SampleID")) %>% mutate(Country_Country = paste0(Country_1, "-to-", Country_2), Country_Country = factor(Country_Country), Pop_Pop = paste0(Population_1, "-to-", Population_2), Pop_Pop = factor(Pop_Pop)) ### Geographic dist long ### geo1 <- geo_dist %>% as.matrix() %>% as_tibble(rownames = "SampleID") %>% pivot_longer(-SampleID) %>% rename(pop1=SampleID, pop2=name, distance = value) %>% mutate_if(is.character, as.factor) %>% inner_join(., ss_n118, by = c("pop1" = "SampleID")) %>% select(pop1, pop2, distance, SpeciesID, Country, Population) %>% rename(SpeciesID_1 = SpeciesID, Country_1 = Country, Population_1 = Population) geo2_meta <- pop2_meta df_geo_dist <- geo1 %>% inner_join(., geo2_meta, by = c("pop2" = "SampleID")) %>% mutate(Country_Country = paste0(Country_1, "-to-", Country_2), Country_Country = factor(Country_Country), Pop_Pop = paste0(Population_1, "-to-", Population_2), Pop_Pop = factor(Pop_Pop)) ## combine distance data corr_data <- inner_join(df_uu_dist, df_geo_dist, by = c("pop1", "pop2")) %>% rowwise() %>% mutate(grp = paste(sort(c(pop1, pop2)), collapse = "_")) %>% group_by(grp) %>% slice(1) %>% ungroup() %>% select(-grp) %>% rename(unw.unifrac_distance = distance.x, distance_m = distance.y) %>% mutate(distance_km = distance_m/1000) %>% filter(unw.unifrac_distance != 0, !Country_Country.y %in% c("Netherlands-to-Kenya", "Saudi Arabia-to-Kenya", "Saudi Arabia-to-Netherlands")) %>% group_by(Country_Country.y) %>% summarize(mean_cl_normal(unw.unifrac_distance), .groups = "drop") # now not only means corr_data2 <- inner_join(df_uu_dist, df_geo_dist, by = c("pop1", "pop2")) %>% rowwise() %>% mutate(grp = paste(sort(c(pop1, pop2)), collapse = "_")) %>% group_by(grp) %>% slice(1) %>% ungroup() %>% select(-grp) %>% rename(unw.unifrac_distance = distance.x, distance_m = distance.y) %>% mutate(distance_km = distance_m/1000) %>% filter(unw.unifrac_distance != 0) # define comparisons of interest # populations all_pop_compar <- c("Aekingerzand-to-Aekingerzand", "Aekingerzand-to-Mahazat as-Sayd", "Aekingerzand-to-Taif", "Aekingerzand-to-Kinangop", "Aekingerzand-to-Kedong", "Mahazat as-Sayd-to-Mahazat as-Sayd","Mahazat as-Sayd-to-Taif","Mahazat as-Sayd-to-Kinangop","Mahazat as-Sayd-to-Kedong", "Taif-to-Taif", "Taif-to-Kinangop", "Taif-to-Kedong", "Kinangop-to-Kinangop", "Kinangop-to-Kedong", "Kedong-to-Kedong") short_pop_compar <- c("Aekingerzand-to-Aekingerzand", "Mahazat as-Sayd-to-Mahazat as-Sayd","Mahazat as-Sayd-to-Taif", "Taif-to-Taif", "Kinangop-to-Kinangop", "Kinangop-to-Kedong", "Kedong-to-Kedong") ``` ```{r stats unifrac vs geodist, message=F, echo=T, eval=T, warning=T, include=T, cache=F} # test difference between population combinations lm_pop_pop <- corr_data2 %>% filter(Pop_Pop.y %in% all_pop_compar) %>% mutate(Pop_Pop.y = fct_drop(Pop_Pop.y)) %>% mutate(distance_km_sqrt = sqrt(distance_km)) %>% with(lm(unw.unifrac_distance ~ Country_Country.y)) pairs(emmeans(lm_pop_pop, "Country_Country.y")) # test effect of distance null <- corr_data2 %>% filter(Pop_Pop.y %in% all_pop_compar) %>% mutate(Pop_Pop.y = fct_drop(Pop_Pop.y)) %>% mutate(distance_km_sqrt = sqrt(distance_km)) %>% with(lm(unw.unifrac_distance ~ 1)) lin <- corr_data2 %>% filter(Pop_Pop.y %in% all_pop_compar) %>% mutate(Pop_Pop.y = fct_drop(Pop_Pop.y)) %>% mutate(distance_km_sqrt = sqrt(distance_km)) %>% with(lm(unw.unifrac_distance ~ distance_km_sqrt)) quad <- corr_data2 %>% filter(Pop_Pop.y %in% all_pop_compar) %>% mutate(Pop_Pop.y = fct_drop(Pop_Pop.y)) %>% mutate(distance_km_sqrt = sqrt(distance_km)) %>% with(lm(unw.unifrac_distance ~ I(poly(distance_km_sqrt,2)))) cubic <- corr_data2 %>% filter(Pop_Pop.y %in% all_pop_compar) %>% mutate(Pop_Pop.y = fct_drop(Pop_Pop.y)) %>% mutate(distance_km_sqrt = sqrt(distance_km)) %>% with(lm(unw.unifrac_distance ~ I(poly(distance_km_sqrt,3)))) anova(lin) anova(quad) anova(cubic) anova(null, lin, quad, cubic, test = "LRT") # cubic has lowest residuals sums of squares list(linear = lin, quadratic = quad, cubic = cubic) %>% map(., .f = glance) # cubic has highest R2adj AIC(lin, quad, cubic) # cubic has lowest AIC aictab(list(linear = lin, quadratic = quad, cubic = cubic)) %>% kableExtra::kbl(row.names = F, align = "r", centering = T) %>% kableExtra::kable_minimal() # extract summary summary(lin) summary(quad) summary(cubic) # compile predictions from three models mod_grid_gather <- corr_data2 %>% filter(Pop_Pop.y %in% all_pop_compar) %>% mutate(Pop_Pop.y = fct_drop(Pop_Pop.y)) %>% mutate(distance_km_sqrt = sqrt(distance_km)) %>% data_grid(Pop_Pop.y, Country_Country.y, distance_km_sqrt, unw.unifrac_distance, .model = lin) %>% gather_predictions(cubic) ``` ```{r plot unifrac vs geodist, message=F, echo=T, eval=T, warning=T, include=T, cache=F} # plot unifrac distance versus geographic distance pred_dist = corr_data2 %>% filter(Pop_Pop.y %in% all_pop_compar) %>% mutate(Pop_Pop.y = fct_drop(Pop_Pop.y)) %>% mutate(distance_km_sqrt = sqrt(distance_km)) %>% add_predictions(cubic) %>% mutate(pred_cubic = pred) %>% add_predictions(quad) %>% mutate(pred_quad = pred) uu_by_distance = pred_dist %>% ggplot(aes(x = distance_km+1, y = unw.unifrac_distance, color = Country_Country.y)) + geom_point(pch = 21, size = 2, alpha = 0.75) + stat_summary(fun.data = mean_cl_boot, geom = "point", size = 3, pch = 21, fill = "white") + stat_summary(fun = mean, geom = "line", size = 1, color = "grey50", alpha = 0.7) + # geom_line(aes(y = pred_tetra), size = 1, color = "grey30") + # geom_line(aes(y = pred_quad), color = "red") + coord_trans(x = "sqrt") + #stat_summary(fun.data = median_hilow, size = 1, color = "black", pch = 21) + scale_color_manual(name = "Country comparison", values = c(brewer.pal(9, "Paired"), brewer.pal(6, "Dark2"))) + scale_fill_manual(name = "Country comparison", values = c(brewer.pal(9, "Paired"), brewer.pal(6, "Dark2"))) + scale_x_continuous(breaks = c(0, 100, 1000, 2000, 4000, 6000), labels = c(0, 100, 1000, 2000, 4000, 6000)) + labs(y = "Unweighted UniFrac distance", x = "sqrt-transformed distance (km)") + theme_classic() + theme(legend.position = "right") + ggtitle("UniFrac distance versus geographical distance") uu_by_distance ggsave(plot = uu_by_distance + ggtitle(NULL), "figures/Fig_5_unw_unifrac_by_geogr_distance.pdf", width = 6, height = 4) ```
**Fig. 5. The relationship between similarities of cloacal microbiota membership and geographic distances among locations.** Pairwise unweighted UniFrac distances between cloacal microbiota larks (n=125) are separated by the geographic distance (square-root transformed distance) between individuals of each pair. Pairs are coloured by the unique combination of biogeographic regions of their origin. Mean unweighted UniFrac distances of each among-location comparison are depicted by large circles and connected by a line to highlight the pattern of cloacal microbiota similarity with distance. ### Differential abundance analysis using ANCOM-BC ```{r ANCOM-BC, eval=T, echo=F, include=T, message=F, warning=F} # install and load ANCOM-BC # input data # ps psdata_Phylum <- tax_glom(ps_4000, "Phylum") # run ANCOM-BC on ASV level out = ancombc(phyloseq = ps, formula = "Population", p_adj_method = "holm", zero_cut = 0.90, lib_cut = 1000, group = "Population", struc_zero = TRUE, neg_lb = TRUE, tol = 1e-5, max_iter = 100, conserve = TRUE, alpha = 0.05, global = TRUE) res = out$res res_global = out$res_global # ancom results res_global = res_global %>% mutate(taxon_name = row.names(.)) %>% select(taxon_name, everything()) %>% as_tibble() taxa_list = data.frame(tax_table(ps)) %>% mutate(taxon_name = taxa_names(ps)) %>% select(taxon_name, everything()) # table of significantly different taxa (global) diff_abund <- inner_join(res_global, taxa_list, by = "taxon_name") %>% arrange(desc(W)) # run ANCOM-BC on Phylum level psdata_Phylum <- tax_glom(ps_4000, "Phylum") out_Phylum = ancombc(phyloseq = psdata_Phylum, formula = "Population", p_adj_method = "holm", zero_cut = 0.90, lib_cut = 1000, group = "Population", struc_zero = TRUE, neg_lb = TRUE, tol = 1e-5, max_iter = 100, conserve = TRUE, alpha = 0.05, global = TRUE) res_Phylum = out_Phylum$res res_global_Phylum = out_Phylum$res_global # ancom results res_global_Phylum = res_global_Phylum %>% mutate(taxon_name = row.names(.)) %>% select(taxon_name, everything()) %>% as_tibble() taxa_list_Phylum = data.frame(tax_table(psdata_Phylum)) %>% mutate(taxon_name = taxa_names(psdata_Phylum)) %>% select(taxon_name, everything()) # table of significantly different taxa (global) diff_abund_Phylum <- inner_join(res_global_Phylum, taxa_list_Phylum, by = "taxon_name") %>% arrange(desc(W)) %>% select(-Kingdom, -c(Class:Species)) %>% mutate_if(is.numeric, ~round(., 2)) %>% mutate(p_val = as.character(p_val), p_val = if_else(p_val == "0", "<0.001", p_val), q_val = as.character(q_val), q_val = if_else(q_val == "0", "<0.001", q_val)) %>% select(Phylum, everything()) %>% select(-taxon_name, -diff_abn) diff_abund_Phylum diff_abund_Phylum %>% write_excel_csv(file = "output_data/Table_Sxx_ANCOM-BC_phyla.csv") ``` ```{r heatmap diff abund ANCOM-BC, echo=F, eval=T, warning=F, message=F, include=T} # create centered log ratio transformed OTU table ps_clr <- microbiome::transform(ps, transform = "clr") ### Heatmap differential abundant taxa ANCOM-BC ps_diff_abund <- subset_taxa(ps_clr, taxa_names(ps_clr) %in% diff_abund$taxon_name) # ComplexHeatmap metadata matrix <- as.matrix(data.frame(otu_table(ps_diff_abund))) rownames(matrix) <- as.character(tax_table(ps_diff_abund)[, "Species"]) metadata_sub <- data.frame(sample_data(ps_diff_abund)) # Define the annotation color for columns and rows annotation_col = data.frame( Population = as.factor(metadata_sub$Population), SpeciesID = as.factor(metadata_sub$SpeciesID), check.names = FALSE) rownames(annotation_col) = rownames(metadata_sub) annotation_row = data.frame( Phylum = as.factor(tax_table(ps_diff_abund)[, "Phylum"]) ) rownames(annotation_row) = NULL # ann_color should be named vectors phylum_col = RColorBrewer::brewer.pal(length(levels(annotation_row$Phylum)), "Dark2") names(phylum_col) = levels(annotation_row$Phylum) metadata_sub$Population %>% levels() metadata_sub$SpeciesID %>% levels() ann_colors = list( Population = c(`Aekingerzand` = brewer.pal(6, "Paired")[2], `Kedong` = brewer.pal(6, "Paired")[3], `Kinangop` = brewer.pal(6, "Paired")[4], `Mahazat as-Sayd` = brewer.pal(6, "Paired")[5], `Taif` = brewer.pal(6, "Paired")[6]), SpeciesID = c("Bar-tailed Desert Lark" = brewer.pal(8, "Set1")[1], "Black-crowned Finch Lark" = brewer.pal(8, "Set1")[2], "Crested Lark" = brewer.pal(8, "Set1")[3], "Dunns Lark" = brewer.pal(8, "Set1")[4], "Hoopoe Lark" = brewer.pal(8, "Set1")[5], "Red-Capped Lark" = brewer.pal(8, "Set1")[6], "Rufous-naped Lark" = brewer.pal(8, "Set1")[7], "Skylark" = brewer.pal(8, "Set1")[8], "Woodlark" = brewer.pal(8, "Set2")[1]), Phylum = phylum_col) pdf("figures/Heatmap_differential_abundant_ASVs_ANCOM-BC_Population.pdf", width = 15, height = 8, useDingbats = F) ComplexHeatmap::pheatmap(matrix, scale= "row", annotation_col = annotation_col, annotation_row = annotation_row, annotation_colors = ann_colors) dev.off() ComplexHeatmap::pheatmap(matrix, scale= "row", annotation_col = annotation_col, annotation_row = annotation_row, annotation_colors = ann_colors) ```