# Appendix E - R script # Script written with R version 4.2.3 ######################################################### ### Install and load packages, functions and dataset: ### install.packages("ade4") install.packages("adiv") install.packages("viridis") install.packages("ClustOfVar") library(ade4) library(adiv) library(viridis) library(ClustOfVar) # Load data from file AppendixC.txt using: DATA <- read.table(file.choose(), header = TRUE, row.names=1, sep="\t") # Source functions available in AppendixD.txt using: source(file.choose()) ########################################### ### Preliminary analyses on the traits: ### # Extract cube-root transformed body mass using: BM3 <- DATA$"BodyMass.g."^(1/3) names(BM3) <- rownames(DATA) # Presentation of the dataset using species classification into orders BM3mean <- sort(tapply(BM3, DATA$Order, mean)) BM3sd <- tapply(BM3, DATA$Order, sd)[order(tapply(BM3, DATA$Order, mean))] BM3sd[is.na(BM3sd)] <- 0 barMID <-barplot(BM3mean, las=3, ylab="Cube-root trans. body mass") arrows(barMID, BM3mean - BM3sd / 2, barMID, BM3mean + BM3sd / 2, lwd = 1.5, angle = 90, code = 3, length = 0.05) # Link between the cube-root transformed body mass and the body length: plot(DATA$"BodyLength.mm.", BM3, xlab="Body length", ylab="Cube-root trans. body mass") # Table of quantitative and ordinal traits tabQ <- cbind.data.frame(BM3, DATA[c("Habitat_breadth.nb", "Activity_cycle")]) # Table of fuzzy traits (diet trait expressed in terms of percentage of use) tabF <- DATA[c("Diet.plant", "Diet.invertebrate", "Diet.vertebrate")] tabF <- prep.fuzzy(tabF, 3) # Table of nominal traits tabN <- cbind.data.frame(DATA["Foraging_stratum"], Freshwater = as.character(DATA[, "Freshwater"])) ################################################### ### Functional dissimilarities between species: ### # Calculation of the list of dissimilarity matrices (one matrix per functional trait) # The function ldist.ktab below will print questions, responses are 2 (to select Orloci chord distance for the diet trait) and another 2 (to select Manathan distance for quantitative and ordinal traits, that are body mass, habitat breadth and activity cycle. LISTdis <- ldist.ktab(ktab.list.df(list(tabQ, tabF, tabN)), type=c("Q","F","N"), scan=TRUE) 2 2 # By default the function ldist.ktab square root transform the dissimilarities. We remove this transformation below. LISTdis2 <- lapply(LISTdis, function(x) x^2) # Dissimilarity-based correlations between traits CORdis <- kdist.cor(ktab.list.df(list(tabQ, tabF, tabN)), type=c("Q","F","N"), scan=TRUE) 2 2 CORdis$paircor range(as.dist(CORdis$paircor)) # [1] -0.1255328 0.2653588 # Calculation of the weights that will be attributed to single-trait dissimilarity in the final averaged dissimilarity between two species (implementation of de Bello et al. 2021 method) smean <- as.vector(unlist(lapply(lapply(LISTdis2, as.vector), mean))) ssq <- sqrt(as.vector(unlist(lapply(1:6, function(i) sum((lapply(LISTdis2, as.vector)[[i]]-smean[i])^2))))) Vdis2 <- cbind.data.frame(lapply(LISTdis2, as.vector)) M1 <- (cor(Vdis2)-rbind.data.frame(cor(Vdis2)[1,], cor(Vdis2)[1,], cor(Vdis2)[1,], cor(Vdis2)[1,], cor(Vdis2)[1,], cor(Vdis2)[1,])) wA <- t(t(M1)* ssq) wA[1,] <- 1 wweights <- solve(wA)[,1] names(wweights) <- NULL # Obtention of the final averaged functional dissimilarities between species DisMean <- wweights[1]*LISTdis2[[1]] + wweights[2]* LISTdis2[[2]] + wweights[3]* LISTdis2[[3]] + wweights[4]* LISTdis2[[4]] + wweights[5]* LISTdis2[[5]] + wweights[6]* LISTdis2[[6]] ####################################################################################### ### Species' extinction probabilities and their link with species functional traits ### ### Anderman et al. model: pextA <- DATA$"Proba.extinction" names(pextA) <- rownames(DATA) # Correlation ratio with nominal traits apply(tabN, 2, function(x) mixedVarSim(as.factor(x), pextA)) # Foraging_stratum Freshwater # 0.03115391 0.01270138 # Squared Pearson correlation with quantitative and fuzzy traits apply(tabQ, 2, function(x) mixedVarSim(x, pextA)) # BM3 Habitat_breadth.nb Activity_cycle # 0.01643821 0.02535012 0.01924489 apply(tabF, 2, function(x) mixedVarSim(x, pextA)) # Diet.plant Diet.invertebrate Diet.vertebrate # 0.0030404751 0.0006024052 0.0061225725 ### Pessimistic model: pextP <- rep(0.2, 101) names(pextP) <- rownames(DATA) pextP[DATA$IUCNcat.=="NT"] <- 0.4 pextP[DATA$IUCNcat.=="VU"] <- 0.8 pextP[DATA$IUCNcat.=="EN"] <- 0.9 pextP[DATA$IUCNcat.=="CR"] <- 0.99 # Correlation ratio with nominal traits apply(tabN, 2, function(x) mixedVarSim(as.factor(x), pextP)) # Foraging_stratum Freshwater # 0.008435392 0.054550208 # Squared Pearson correlation with quantitative and fuzzy traits apply(tabQ, 2, function(x) mixedVarSim(x, pextP)) # BM3 Habitat_breadth.nb Activity_cycle # 0.237667919 0.024233243 0.003715234 apply(tabF, 2, function(x) mixedVarSim(x, pextP)) # Diet.plant Diet.invertebrate Diet.vertebrate # 0.002955185 0.001624085 0.001179862 # Pearson correlation between cube-root transformed body mass and pessimistic extinction probabilities cor(pextP, tabQ[,1]) # [1] 0.487512 ################################################### ### Functional distinctiveness between species: ### ################################################### # Values for paramater alpha: ppa <- c(-(100:1),0,1:100)/10 ppa ################################################### # Species' distinctiveness according to alpha^Deq: # Raw values DISALL <- distinctDis(DisMean, method="Dstar", palpha=ppa) # Ranks (from the 1st to the 101th most distinctive species) DISALLrank <- apply(-DISALL, 2, rank) # List of all species that are classified among the 10 most distinctive species # for at least one value of alpha we considered: top10D <- rownames(DISALLrank)[apply(DISALLrank, 1, min)<=10] top10D # [1] "Bos gaurus" "Bubalus arnee" # [3] "Canis lupus" "Elephas maximus" # [5] "Loris lydekkerianus" "Lutra lutra" # [7] "Martes flavigula" "Mellivora capensis" # [9] "Melursus ursinus" "Moschiola indica" # [11] "Neofelis nebulosa" "Paradoxurus hermaphroditus" # [13] "Pardofelis marmorata" "Prionailurus rubiginosus" # [15] "Prionailurus viverrinus" "Rhinoceros unicornis" # [17] "Rucervus eldii" # List of threatened species that are classified among the 10 most distinctive species # for at least one value of alpha we considered: top10DT <- top10D[DATA[top10D, 2]%in%c("VU","EN","CR")] top10DT [1] "Bos gaurus" "Bubalus arnee" [3] "Elephas maximus" "Melursus ursinus" [5] "Neofelis nebulosa" "Prionailurus viverrinus" [7] "Rhinoceros unicornis" "Rucervus eldii" # List of species that are classified among the 10 most distinctive species # for all value of alpha we considered: max10D <- rownames(DISALLrank)[apply(DISALLrank, 1, max)<=10] max10D # [1] "Bos gaurus" "Elephas maximus" "Neofelis nebulosa" "Rucervus eldii" # List of threatened species that are classified among the 10 most distinctive species # for all value of alpha we considered: max10DT <- max10D[DATA[max10D, 2]%in%c("VU","EN","CR")] max10DT # [1] "Bos gaurus" "Elephas maximus" "Neofelis nebulosa" "Rucervus eldii" ################################################### # Species' distinctiveness according to alpha^f: #### with Anderman et al. model of species extinction probabilities listDisextA <- lapply(ppa, function(a) distinctDis_ext(DisMean, pextA, palpha=a)) listfA <- cbind.data.frame(lapply(listDisextA, function(x) x[, 3])) rownames(listfA) <- rownames(listDisextA[[1]]) colnames(listfA) <- paste("alpha", ppa, sep="") listfArank <- apply(-listfA, 2, rank) # Correlation between alpha^Deq and alpha^f with Anderman et al. model corDeltafA <- sapply(1:201, function(i) cor(DISALL[, i], listfA[, i], method="spearman")) range(corDeltafA) # [1] 0.9928829 0.9994059 plot(ppa, corDeltafA) # With alpha^f, the list of species that are classified among the 10 most distinctive species # for at least one value of alpha we considered is slightly different # from that obtained with alpha^Deq top10fA <- rownames(listfArank)[apply(listfArank, 1, min)<=10] top10fA # [1] "Bos gaurus" "Bubalus arnee" # [3] "Canis lupus" "Elephas maximus" # [5] "Loris lydekkerianus" "Lutra lutra" # [7] "Martes flavigula" "Mellivora capensis" # [9] "Melursus ursinus" "Moschiola indica" # [11] "Neofelis nebulosa" "Panthera pardus" # [13] "Paradoxurus hermaphroditus" "Pardofelis marmorata" # [15] "Prionailurus viverrinus" "Rhinoceros unicornis" # [17] "Rucervus eldii" # List of threatened species that are classified among the 25 most distinctive species # for at least one value of alpha we considered according to alpha^f: top10fAT <- top10fA[DATA[top10fA, 2]%in%c("VU","EN","CR")] top10fAT # [1] "Bos gaurus" "Bubalus arnee" # [3] "Elephas maximus" "Melursus ursinus" # [5] "Neofelis nebulosa" "Panthera pardus" # [7] "Prionailurus viverrinus" "Rhinoceros unicornis" # [9] "Rucervus eldii" # List of all species that are classified among the 10 most distinctive species # for all value of alpha we considered for alpha^f: maxfA <- rownames(listfArank)[apply(listfArank, 1, max)<=10] maxfA # [1] "Bos gaurus" "Elephas maximus" "Neofelis nebulosa" "Rucervus eldii" # The list of threatened species that are classified among the 10 most distinctive species # for all value of alpha we considered for alpha^f: maxfAT <- maxfA[DATA[maxfA, 2]%in%c("VU","EN","CR")] maxfAT # [1] "Bos gaurus" "Elephas maximus" "Neofelis nebulosa" "Rucervus eldii" #### with the pessimistic model of species extinction probabilities listDisextP <- lapply(ppa, function(a) distinctDis_ext(DisMean, pextP, palpha=a)) listfP <- cbind.data.frame(lapply(listDisextP, function(x) x[, 3])) rownames(listfP) <- rownames(listDisextP[[1]]) colnames(listfP) <- paste("alpha", ppa, sep="") listfPrank <- apply(-listfP, 2, rank) # Correlation between alpha^Deq and alpha^f with the pessimistic model corDeltafP <- sapply(1:201, function(i) cor(DISALL[, i], listfP[, i], method="spearman")) range(corDeltafP) # [1] 0.9747816 0.9943856 plot(ppa, corDeltafP) # According to index alpha^f and the pessimistic model of species extinction probabilities, # below is the list of species that are classified among the 10 most distinctive species # for at least one value of alpha we considered: top10fP <- rownames(listfPrank)[apply(listfPrank, 1, min)<=10] top10fP # [1] "Bos gaurus" "Bubalus arnee" # [3] "Canis lupus" "Elephas maximus" # [5] "Hoolock hoolock" "Lutra lutra" # [7] "Martes flavigula" "Melursus ursinus" # [9] "Moschiola indica" "Neofelis nebulosa" # [11] "Panthera pardus" "Paradoxurus hermaphroditus" # [13] "Pardofelis marmorata" "Prionailurus viverrinus" # [15] "Rhinoceros unicornis" "Rucervus eldii" # According to index alpha^f and the pessimistic model, # list of threatened species that are classified among the 10 most distinctive species # for at least one value of alpha we considered: top10fPT <- top10fP[DATA[top10fP, 2]%in%c("VU","EN","CR")] top10fPT # [1] "Bos gaurus" "Bubalus arnee" # [3] "Elephas maximus" "Hoolock hoolock" # [5] "Melursus ursinus" "Neofelis nebulosa" # [7] "Panthera pardus" "Prionailurus viverrinus" # [9] "Rhinoceros unicornis" "Rucervus eldii" # According to index alpha^f and the pessimistic model of species extinction probabilities, # below is the list of species that are classified among the 10 most distinctive species # for all value of alpha we considered: maxfP <- rownames(listfPrank)[apply(listfPrank, 1, max)<=10] maxfP # [1] "Bos gaurus" "Elephas maximus" "Neofelis nebulosa" "Rhinoceros unicornis" "Rucervus eldii" # The list of threatened species that are classified among the 10 most distinctive species # for all value of alpha we considered for alpha^f: maxfPT <- maxfP[DATA[maxfP, 2]%in%c("VU","EN","CR")] maxfPT # [1] "Bos gaurus" "Elephas maximus" "Neofelis nebulosa" "Rhinoceros unicornis" "Rucervus eldii"