---
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)
```