#Example pBC analysis script #Install phytools, Claddis and dispeRse library(devtools) devtools::install_github("liamrevell/phytools") devtools::install_github("graemetlloyd/Claddis") devtools::install_github("laurasoul/dispeRse") #Required libraries library(ape) library(paleotree) library(phytools) library(Claddis) library(dispeRse) library(cluster) #Input source tree complete.tree<-read.nexus("SD1.nexus") #Read in taxa and ages taxon.occs <- as.matrix(read.table("Taxon_occs.txt", header = TRUE, row.names=1, sep = "\t")) #Generate time-calibrated supertree (warning: for illustrative purposes only: should not interpret results from a single dated tree) dated.tree <- timePaleoPhy(complete.tree, taxon.ages, "mbl", vartime=1) #Read in taxon-region matrices for each time bin lopingian<-as.matrix(read.table("lopingian.txt", header=TRUE, row.names=1, sep="\t")) latePermian<-as.matrix(read.table("latePermian.txt", header=TRUE, row.names=1, sep="\t")) earlyTriassic<-as.matrix(read.table("earlyTriassic.txt", header=TRUE, row.names=1, sep="\t")) anisian<-as.matrix(read.table("anisian.txt", header=TRUE, row.names=1, sep="\t")) ladinian<-as.matrix(read.table("ladinian.txt", header=TRUE, row.names=1, sep="\t")) earlyLateTriassic<-as.matrix(read.table("earlyLateTriassic.txt", header=TRUE, row.names=1, sep="\t")) lateLateTriassic<-as.matrix(read.table("lateLateTriassic.txt", header=TRUE, row.names=1, sep="\t")) earlyEarlyJurassic<-as.matrix(read.table("earlyEarlyJurassic.txt", header=TRUE, row.names=1, sep="\t")) lateEarlyJurassic<-as.matrix(read.table("lateEarlyJurassic.txt", header=TRUE, row.names=1, sep="\t")) earlyJurassic<-as.matrix(read.table("earlyJurassic.txt", header=TRUE, row.names=1, sep="\t")) #Produce trees isolating the taxa present in each time bin lopingian.tree <- drop.tip(dated.tree, setdiff(dated.tree$tip.label, rownames(lopingian))) latePermian.tree <- drop.tip(dated.tree, setdiff(dated.tree$tip.label, rownames(latePermian))) earlyTriassic.tree <- drop.tip(dated.tree, setdiff(dated.tree$tip.label, rownames(earlyTriassic))) anisian.tree <- drop.tip(dated.tree, setdiff(dated.tree$tip.label, rownames(anisian))) ladinian.tree <- drop.tip(dated.tree, setdiff(dated.tree$tip.label, rownames(ladinian))) earlyLateTriassic.tree <- drop.tip(dated.tree, setdiff(dated.tree$tip.label, rownames(earlyLateTriassic))) lateLateTriassic.tree <- drop.tip(dated.tree, setdiff(dated.tree$tip.label, rownames(lateLateTriassic))) earlyEarlyJurassic.tree <- drop.tip(dated.tree, setdiff(dated.tree$tip.label, rownames(earlyEarlyJurassic))) lateEarlyJurassic.tree <- drop.tip(dated.tree, setdiff(dated.tree$tip.label, rownames(lateEarlyJurassic))) #Calculating phylogenetic biogeographical connectedness from these trees requires that each be ultrametric. Here is a function to ultrametricise trees (author: Graeme Lloyd): ultrametricise <- function(tree) { # Get maximum path length: max.path.length <- max(diag(vcv(tree))) # Add extra branch length to all tips in order to reach maximum path length: tree$edge.length[match(1:Ntip(tree), tree$edge[, 2])] <- tree$edge.length[match(1:Ntip(tree), tree$edge[, 2])] + (max.path.length - diag(vcv(tree))[tree$tip.label]) # Return re-scaled tree: return(tree) } #Ultrametricise the trees lopingian.tree <- ultrametricise(lopingian.tree) latePermian.tree <- ultrametricise(latePermian.tree) earlyTriassic.tree <- ultrametricise(earlyTriassic.tree) anisian.tree <- ultrametricise(anisian.tree) ladinian.tree <- ultrametricise(ladinian.tree) earlyLateTriassic.tree <- ultrametricise(earlyLateTriassic.tree) lateLateTriassic.tree <- ultrametricise(lateLateTriassic.tree) earlyEarlyJurassic.tree <- ultrametricise(earlyEarlyJurassic.tree) lateEarlyJurassic.tree <- ultrametricise(lateEarlyJurassic.tree) #These are the input data required to calculate bioegraphical connectedness for each time bin. #This is the function used to calculate aphylogenetic and phylogenetic biogeographical connectedness. Authors: Graeme T. Lloyd, Richard J. Butler. See: http://127.0.0.1:23099/library/dispeRse/html/BC.html Available within the dispeRse package. BC<-function (taxon_locality_matrix, tree = NULL, count.nodes = FALSE, permute.tree = TRUE, bootstrap = FALSE, jackknife = FALSE, resample.replicates = 1000, tree.replicates = 1000, u = 1000) #Arguments: #taxon_locality_matrix - Presence-absence (1-0) matrix of taxa (rows) in localities (columns). #tree - Optional time-scaled phylogenetic tree of taxa in presence-absence matrix. If ommitted, performs an aphylogenetic network biogeography analysis equivalent to the method used by Sidor et al. (2013) #count.nodes - Option to count nodes rather than use branch-lengths. #permute.tree - Option to permute random trees by shuffling tips. #bootstrap - Option to bootstrap occurrences. #jackknife - Option to jacknife occurrences. #resample.replicates - Number of replicates to use for bootstrapping or jacknifing. #tree.replicates - Number of replicates to use if permuting trees. #u - Value to use to shorten tree and avoid increasing phylogenetic diversity artefact { BC_single <- function(taxon_locality_matrix) { L <- ncol(taxon_locality_matrix) O <- sum(taxon_locality_matrix) N <- nrow(taxon_locality_matrix) BC <- (O - N)/((L * N) - N) return(BC) } PhyloTLMatrix <- function(taxon_locality_matrix, phylo_dist_matrix) { pa_matrix <- taxon_locality_matrix if (!(ncol(taxon_locality_matrix) * nrow(taxon_locality_matrix)) == sum(taxon_locality_matrix)) { for (i in 1:ncol(pa_matrix)) { taxa_not_at_locality <- rownames(pa_matrix)[grep(TRUE, pa_matrix[, i] == 0)] if (!is.null(taxa_not_at_locality)) { for (j in taxa_not_at_locality) { taxa_at_locality <- rownames(pa_matrix)[grep(TRUE, pa_matrix[, i] == 1)] taxon_locality_matrix[j, i] <- max(phylo_dist_matrix[j, taxa_at_locality]) } } } } return(taxon_locality_matrix) } RescaledPhylogeneticSimilarity <- function(tree, K = u) { tree$root.time <- max(diag(vcv(tree))) node.ages <- GetNodeAges(tree) too.old.nodes <- as.numeric(names(which(node.ages > K))) if (length(too.old.nodes) > 0) { edges.to.change <- apply(cbind(node.ages[tree$edge[, 1]], node.ages[tree$edge[, 2]]) > K, 1, sum) ZLBs <- which(edges.to.change == 2) if (length(ZLBs > 0)) tree$edge.length[ZLBs] <- 0 shorten <- which(edges.to.change == 1) tree$edge.length[shorten] <- K - node.ages[tree$edge[shorten, 2]] } phylo_dist <- cophenetic.phylo(tree) phylo_dist <- phylo_dist/max(phylo_dist) phylo_dist <- 1 - phylo_dist return(phylo_dist) } if (count.nodes && !is.null(tree)) { tree$edge.length <- rep(1, nrow(tree$edge)) tree$edge.length[match(1:Ntip(tree), tree$edge[, 2])] <- 0.5 } if (!is.null(tree)) { taxon_locality_matrix <- taxon_locality_matrix[intersect(tree$tip.label, rownames(taxon_locality_matrix)), ] path.lengths <- unique(diag(vcv(tree))) if (length(path.lengths) > 1) { for (i in 1:(length(path.lengths) - 1)) { for (j in (i + 1):length(path.lengths)) { if (all.equal(path.lengths[i], path.lengths[j]) != TRUE) stop("Tree must be ultrametric.") } } } } taxon_locality_matrix <- taxon_locality_matrix[which(apply(taxon_locality_matrix, 1, sum) > 0), which(apply(taxon_locality_matrix, 2, sum) > 0)] phyloBC.distribution <- NULL if (!is.null(tree)) { if (length(setdiff(tree$tip.label, rownames(taxon_locality_matrix))) > 0) tree <- drop.tip(tree, setdiff(tree$tip.label, rownames(taxon_locality_matrix))) if (permute.tree) { rand.trees <- list() for (i in 1:tree.replicates) { rand.trees[[i]] <- tree rand.trees[[i]]$tip.label <- sample(rand.trees[[i]]$tip.label) } class(rand.trees) <- "multiPhylo" rand.distances <- lapply(rand.trees, RescaledPhylogeneticSimilarity) tl.matrices <- list() for (i in 1:tree.replicates) tl.matrices[[i]] <- PhyloTLMatrix(taxon_locality_matrix, rand.distances[[i]]) phyloBC.distribution <- unlist(lapply(tl.matrices, BC_single)) } phylo_dist <- RescaledPhylogeneticSimilarity(tree) taxon_locality_matrix <- PhyloTLMatrix(taxon_locality_matrix, phylo_dist) } if (bootstrap && jackknife) { cat("WARNING: Can't perform both boostrapping and jacknifing (can lead to empty presence-absence matrix) so just doing latter.\n") bootstrap <- FALSE } if (bootstrap || jackknife) { BC_outs <- Ns <- Os <- Ls <- Mean_occurrences <- N_endemics <- BC_values <- rep(NA, resample.replicates) for (i in 1:resample.replicates) { taxon_locality_matrix2 <- taxon_locality_matrix if (bootstrap) { taxon_locality_matrix2 <- taxon_locality_matrix2[, sample(ncol(taxon_locality_matrix2), replace = TRUE)] taxon_locality_matrix2 <- taxon_locality_matrix2[which(apply(taxon_locality_matrix2, 1, sum) > 0), which(apply(taxon_locality_matrix2, 2, sum) > 0)] } if (jackknife) { taxon_locality_matrix2 <- taxon_locality_matrix2[sample(nrow(taxon_locality_matrix2), replace = TRUE), ] taxon_locality_matrix2 <- taxon_locality_matrix2[which(apply(taxon_locality_matrix2, 1, sum) > 0), which(apply(taxon_locality_matrix2, 2, sum) > 0)] } if (is.matrix(taxon_locality_matrix2) && length(taxon_locality_matrix2) > 0) { BC_values[i] <- BC_single(taxon_locality_matrix2) N_endemics[i] <- sum(apply(taxon_locality_matrix2, 1, sum) == 1) Mean_occurrences[i] <- mean(apply(taxon_locality_matrix2, 2, sum)) Ls[i] <- ncol(taxon_locality_matrix2) Os[i] <- sum(taxon_locality_matrix2) Ns[i] <- nrow(taxon_locality_matrix2) } } BC_outs <- round(cbind(c(1:resample.replicates), Ls, Ns, Os, N_endemics, Mean_occurrences, BC_values), 2) colnames(BC_outs) <- c("Replicate_number", "N_localities", "N_taxa", "N_links", "N_endemics", "Mean_occurrences_per_locality", "Biogeographic_connectedness") } else { BC_outs <- NULL } L <- ncol(taxon_locality_matrix) O <- sum(taxon_locality_matrix) N <- nrow(taxon_locality_matrix) N_endemic <- sum(apply(taxon_locality_matrix, 1, sum) == 1) Mean_occurrence <- mean(apply(taxon_locality_matrix, 2, sum)) BC <- BC_single(taxon_locality_matrix) BC_out <- round(c(L, N, O, N_endemic, Mean_occurrence, BC), 2) names(BC_out) <- c("N_localities", "N_taxa", "N_links", "N_endemics", "Mean_occurrences_per_locality", "Biogeographic_connectedness") out <- list(BC_out, BC_outs, phyloBC.distribution) names(out) <- c("BC_observed", "BC_resampled", "BC_permuted") return(out) } #Aphylogenetic biogeographic connectedness analyses, including jackknifing wth 1000 replicates aphyloBC.lopingian <- BC(lopingian, jackknife = TRUE) aphyloBC.latePermian <- BC(latePermian, jackknife = TRUE) aphyloBC.earlyTriassic <- BC(earlyTriassic, jackknife = TRUE) aphyloBC.anisian <- BC(anisian, jackknife = TRUE) aphyloBC.ladinian <- BC(ladinian, jackknife = TRUE) aphyloBC.earlyLateTriassic <- BC(earlyLateTriassic, jackknife = TRUE) aphyloBC.lateLateTriassic <- BC(lateLateTriassic, jackknife = TRUE) aphyloBC.earlyEarlyJurassic <- BC(earlyEarlyJurassic, jackknife = TRUE) aphyloBC.lateEarlyJurassic <- BC(lateEarlyJurassic, jackknife = TRUE) #Phylogenetic biogeographic connectedness analyses, including jackknifing wth 1000 replicates phyloBC.lopingian1 <- BC(lopingian, lopingian.tree, jackknife = TRUE) phyloBC.latePermian1 <- BC(latePermian, latePermian.tree, jackknife = TRUE) phyloBC.earlyTriassic1 <- BC(earlyTriassic, earlyTriassic.tree, jackknife = TRUE) phyloBC.anisian1 <- BC(anisian, anisian.tree, jackknife = TRUE) phyloBC.ladinian1 <- BC(ladinian, ladinian.tree, jackknife = TRUE) phyloBC.lateTriassic1 <- BC(lateTriassic, lateTriassic.tree, jackknife = TRUE) phyloBC.earlyEarlyJurassic1 <- BC(earlyEarlyJurassic, earlyEarlyJurassic.tree, jackknife = TRUE) phyloBC.lateEarlyJurassic1 <- BC(lateEarlyJurassic, lateEarlyJurassic.tree, jackknife = TRUE) #The above but including a cutoff of 15Ma (u=15) phyloBC.lopingian <- BC(lopingian, lopingian.tree, jackknife = TRUE, u=15) phyloBC.earlyTriassic <- BC(earlyTriassic, earlyTriassic.tree, jackknife = TRUE, u=15) phyloBC.anisian <- BC(anisian, anisian.tree, jackknife = TRUE, u=15) phyloBC.ladinian <- BC(ladinian, ladinian.tree, jackknife = TRUE, u=15) phyloBC.earlyLateTriassic <- BC(earlyLateTriassic, earlyLateTriassic.tree, jackknife = TRUE, u=15) phyloBC.lateLateTriassic <- BC(lateLateTriassic, lateLateTriassic.tree, jackknife = TRUE, u=15) phyloBC.earlyEarlyJurassic <- BC(earlyEarlyJurassic, earlyEarlyJurassic.tree, jackknife = TRUE, u=15) phyloBC.lateEarlyJurassic <- BC(lateEarlyJurassic, lateEarlyJurassic.tree, jackknife = TRUE, u=15)