knitr::opts_chunk$set(echo = TRUE)
Function that calls all libraries needed for analysis
source("./R/load_libraries.R") load_libraries()
Community matrix for ordination
load(file = "./data/spp_matrix.RData")
load(file = "./data/spp_matrix_pooled.RData")
load(file = "./data/community_dat.RData")
load(file = "./data/community_dat_pooled.RData")
spp_matrix_pooled$site spp_matrix_pooledPA <- spp_matrix_pooled spp_matrix_pooledPA[,-c(1:2)] <- decostand(spp_matrix_pooled[,-c(1:2)], method = "pa") #dis-sim? vegdist(spp_matrix_pooledPA[,-c(1:2)],method="jaccard")
https://stats.stackexchange.com/questions/176613/jaccard-similarity-in-r
jaccard <- function(df, margin) { if (margin == 1 | margin == 2) { M_00 <- apply(df, margin, sum) == 0 M_11 <- apply(df, margin, sum) == 2 if (margin == 1) { df <- df[!M_00, ] JSim <- sum(M_11) / nrow(df) } else { df <- df[, !M_00] JSim <- sum(M_11) / length(df) } JDist <- 1 - JSim return(c(JSim = JSim, JDist = JDist)) } else break } j.mat <- matrix(data = NA,nrow = 5,ncol = 5) rownames(j.mat) <- spp_matrix_pooledPA$site colnames(j.mat) <- spp_matrix_pooledPA$site ## j.mat[2,1] <- jaccard(spp_matrix_pooledPA[c(1,2),-c(1:2)],2)["JSim"] j.mat[3,1] <- jaccard(spp_matrix_pooledPA[c(1,3),-c(1:2)],2)["JSim"] j.mat[4,1] <- jaccard(spp_matrix_pooledPA[c(1,4),-c(1:2)],2)["JSim"] j.mat[5,1] <- jaccard(spp_matrix_pooledPA[c(1,5),-c(1:2)],2)["JSim"] ##2 j.mat[3,2] <- jaccard(spp_matrix_pooledPA[c(2,3),-c(1:2)],2)["JSim"] j.mat[4,2] <- jaccard(spp_matrix_pooledPA[c(2,4),-c(1:2)],2)["JSim"] j.mat[5,2] <- jaccard(spp_matrix_pooledPA[c(2,5),-c(1:2)],2)["JSim"] ##3 j.mat[4,3] <- jaccard(spp_matrix_pooledPA[c(3,4),-c(1:2)],2)["JSim"] j.mat[5,3] <- jaccard(spp_matrix_pooledPA[c(3,5),-c(1:2)],2)["JSim"] ##4 j.mat[5,4] <- jaccard(spp_matrix_pooledPA[c(4,5),-c(1:2)],2)["JSim"] #same as 1-disim 1-vegdist(spp_matrix_pooledPA[,-c(1:2)],method="jaccard")
$C02 C02 (q=0, Sorensen) $U02 U02 (q=0, Jaccard)
library(SpadeR) #not: don't use PA presence absence data sp <- SimilarityMult(X = t(spp_matrix_pooled[,-c(1:2)]), datatype = "abundance", q = 0, goal = "relative", nboot = n.boot) n.boot <- 200 #column 1 sp12 <- SimilarityPair(X = t(spp_matrix_pooled[c(1,2),-c(1:2)]), datatype = "abundance",nboot = n.boot) sp13 <- SimilarityPair(X = t(spp_matrix_pooled[c(1,3),-c(1:2)]), datatype = "abundance",nboot = n.boot) sp14 <- SimilarityPair(X = t(spp_matrix_pooled[c(1,4),-c(1:2)]), datatype = "abundance",nboot = n.boot) sp15 <- SimilarityPair(X = t(spp_matrix_pooled[c(1,5),-c(1:2)]), datatype = "abundance",nboot = n.boot) #column 2 sp23 <- SimilarityPair(X = t(spp_matrix_pooled[c(2,3),-c(1:2)]), datatype = "abundance",nboot = n.boot) sp24 <- SimilarityPair(X = t(spp_matrix_pooled[c(2,4),-c(1:2)]), datatype = "abundance",nboot = n.boot) sp25 <- SimilarityPair(X = t(spp_matrix_pooled[c(2,5),-c(1:2)]), datatype = "abundance",nboot = n.boot) #column 3 sp34 <- SimilarityPair(X = t(spp_matrix_pooled[c(3,4),-c(1:2)]), datatype = "abundance",nboot = n.boot) sp35 <- SimilarityPair(X = t(spp_matrix_pooled[c(3,5),-c(1:2)]), datatype = "abundance",nboot = n.boot) #column 4 sp45 <- SimilarityPair(X = t(spp_matrix_pooled[c(4,5),-c(1:2)]), datatype = "abundance",nboot = n.boot) sp$similarity.matrix
jac.ind <- matrix(data =c( NA, NA, NA, NA, NA, sp12$Empirical_richness[2,1], NA, NA, NA, NA, sp13$Empirical_richness[2,1],sp23$Empirical_richness[2,1], NA, NA, NA, sp14$Empirical_richness[2,1],sp24$Empirical_richness[2,1],sp34$Empirical_richness[2,1], NA, NA, sp15$Empirical_richness[2,1],sp25$Empirical_richness[2,1],sp35$Empirical_richness[2,1],sp45$Empirical_richness[2,1], NA), byrow = TRUE, nrow = 5 ) jac.CI.lo <- matrix(data =c( NA, NA, NA, NA, NA, sp12$Empirical_richness[2,3], NA, NA, NA, NA, sp13$Empirical_richness[2,3],sp23$Empirical_richness[2,3], NA, NA, NA, sp14$Empirical_richness[2,3],sp24$Empirical_richness[2,3],sp34$Empirical_richness[2,3], NA, NA, sp15$Empirical_richness[2,3],sp25$Empirical_richness[2,3],sp35$Empirical_richness[2,3],sp45$Empirical_richness[2,3], NA), byrow = TRUE, nrow = 5 ) jac.CI.hi <- matrix(data =c( NA, NA, NA, NA, NA, sp12$Empirical_richness[2,4], NA, NA, NA, NA, sp13$Empirical_richness[2,4],sp23$Empirical_richness[2,4], NA, NA, NA, sp14$Empirical_richness[2,4],sp24$Empirical_richness[2,4],sp34$Empirical_richness[2,4], NA, NA, sp15$Empirical_richness[2,4],sp25$Empirical_richness[2,4],sp35$Empirical_richness[2,4],sp45$Empirical_richness[2,4], NA), byrow = TRUE, nrow = 5 )
sor.ind <- matrix(data =c( NA, NA, NA, NA, NA, sp12$Empirical_richness[1,1], NA, NA, NA, NA, sp13$Empirical_richness[1,1],sp23$Empirical_richness[1,1], NA, NA, NA, sp14$Empirical_richness[1,1],sp24$Empirical_richness[1,1],sp34$Empirical_richness[1,1], NA, NA, sp15$Empirical_richness[1,1],sp25$Empirical_richness[1,1],sp35$Empirical_richness[1,1],sp45$Empirical_richness[1,1], NA), byrow = TRUE, nrow = 5 ) sor.CI.lo <- matrix(data =c( NA, NA, NA, NA, NA, sp12$Empirical_richness[1,3], NA, NA, NA, NA, sp13$Empirical_richness[1,3],sp23$Empirical_richness[1,3], NA, NA, NA, sp14$Empirical_richness[1,3],sp24$Empirical_richness[1,3],sp34$Empirical_richness[1,3], NA, NA, sp15$Empirical_richness[1,3],sp25$Empirical_richness[1,3],sp35$Empirical_richness[1,3],sp45$Empirical_richness[1,3], NA), byrow = TRUE, nrow = 5 ) sor.CI.hi <- matrix(data =c( NA, NA, NA, NA, NA, sp12$Empirical_richness[1,4], NA, NA, NA, NA, sp13$Empirical_richness[1,4],sp23$Empirical_richness[1,4], NA, NA, NA, sp14$Empirical_richness[1,4],sp24$Empirical_richness[1,4],sp34$Empirical_richness[1,4], NA, NA, sp15$Empirical_richness[1,4],sp25$Empirical_richness[1,4],sp35$Empirical_richness[1,4],sp45$Empirical_richness[1,4], NA), byrow = TRUE, nrow = 5 )
jac.ind <- round(jac.ind,2) jac.CI.lo <- round(jac.CI.lo,2) jac.CI.hi <- round(jac.CI.hi,2) jac.vect <- c(paste(jac.ind[,]," (",jac.CI.lo[,],"-",jac.CI.hi[,],")", sep = "")) jac.mat <- matrix(data = jac.vect, nrow = 5, byrow = F) sor.ind <- round(sor.ind,2) sor.CI.lo <- round(sor.CI.lo,2) sor.CI.hi <- round(sor.CI.hi,2) sor.mat <- matrix(data = c(paste(sor.ind[,]," (",sor.CI.lo[,],"-",sor.CI.hi[,],")", sep = "")), nrow = 5, byrow = F) both.mat <- rbind(jac.mat, sor.mat) write.csv(both.mat, file = "./tables/jaccard_sor.csv")
Run NMDS. note convergence warning
bird.comm.NMDS <- metaMDS(spp.matrix[,i.spp.names], distance = "bray", try = 500)
ordiplot(bird.comm.NMDS, display = "sites") ordihull(bird.comm.NMDS, groups=spp.matrix$site, draw="polygon", col=c(2:6), label=T)
data.scores <- as.data.frame(scores(bird.comm.NMDS)) #Using the scores function from vegan to extract the site scores and convert to a data.frame data.scores$site <- rownames(data.scores) # create a column of site names, from the rownames of data.scores data.scores$grp <- spp.matrix$site # add the grp variable created earlier head(data.scores) #look at the data
species.scores <- as.data.frame(scores(bird.comm.NMDS, "species")) #Using the scores function from vegan to extract the species scores and convert to a data.frame species.scores$species <- rownames(species.scores) # create a column of species, from the rownames of species.scores head(species.scores) #look at the data
ggplot() + geom_text(data=species.scores, aes(x=NMDS1,y=NMDS2, label=species),alpha=0.5) + # add the species labels geom_point(data=data.scores, aes(x=NMDS1,y=NMDS2,shape=grp,colour=grp),size=1) + # add the point markers #geom_text(data=data.scores,aes(x=NMDS1,y=NMDS2,label=site),size=6,vjust=0) + # add the site labels #scale_colour_manual(values=c("A" = "red", "B" = "blue")) + coord_equal() + theme_bw()
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.