diff --git a/00_testing.R b/00_testing.R index ac80db17adbd983603ed3a276281f8084a219858..0c454db23dcbd2aad5254a6a9a4992d3af1b50e4 100644 --- a/00_testing.R +++ b/00_testing.R @@ -67,117 +67,7 @@ names.env <- unlist(lapply(allcomb.env, paste, collapse="_")) comb.list <- expand.grid(names.t, names.env) colnames(comb.list) <- c("trait", "env") - ### define functions to calculate corXY and corTE -get.corXY <- function(comm, traits, trait.sel="all", stat=c("mantel", "RV", "procrustes")){ - if(identical(trait.sel, "all")) {trait.sel <- 1:ncol(traits)} - ii <- trait.sel - lab.tmp <- paste(ii, collapse="_") - #syn.out.tmp <- syncsa(comm=comm, traits=traits[,ii, drop=F], envir = envir, - # checkdata = TRUE, ro.method = "mantel", method = "pearson", dist = "euclidean", scale = TRUE, - # scale.envir = F, ranks = TRUE, put.together = NULL, na.rm = FALSE, strata = NULL, - # permutations = 1, parallel = NULL, notification = TRUE) - ### delete potential missing species - if(any(colSums(comm)==0)){ - empty <- which(colSums(comm)==0) - traits <- traits[-empty,] - comm <- comm[,-empty] - } - syn.out.tmp <- matrix.x(comm=comm, traits=traits[,ii,drop=F], scale=T)$matrix.X - W.beals <- as.data.frame(beals(comm, include=T, type=2)) - corXY <- NULL - if("mantel" %in% stat){ - W.beals.d <- dist(W.beals) - mantel.tmp <- mantel(W.beals.d, dist(syn.out.tmp[])) - corXY <- rbind(corXY, - data.frame(Trait.comb=lab.tmp, Test="Mantel", Coef=mantel.tmp$statistic, pvalue=mantel.tmp$signif)) - } - if("RV" %in% stat){ - RV.tmp <- RV.rtest(W.beals, as.data.frame(syn.out.tmp)) - corXY <- rbind(corXY, - data.frame(Trait.comb=lab.tmp, Test="RV", Coef=RV.tmp$obs, pvalue=RV.tmp$pvalue)) - } - if("procrustes" %in% stat){ - prot.tmp <- protest(W.beals, syn.out.tmp) - corXY <- rbind(corXY, - data.frame(Trait.comb=lab.tmp, Test="Procrustes", Coef=prot.tmp$t0, pvalue=prot.tmp$signif)) - } - return(corXY) -} - - -get.corTE <- function(comm, traits, envir, trait.sel="all", env.sel="all", stat=c("mantel", "RV")){ - if(identical(trait.sel, "all")) {trait.sel <- 1:ncol(traits)} - if(identical(env.sel, "all" )) {env.sel <- 1:ncol(envir)} - ii <- trait.sel - lab.tmp <- paste(ii, collapse="_") - #syn.out.tmp <- syncsa(comm=comm, traits=traits[,ii, drop=F], envir = envir, - # checkdata = TRUE, ro.method = "mantel", method = "pearson", dist = "euclidean", scale = TRUE, - # scale.envir = F, ranks = TRUE, put.together = NULL, na.rm = FALSE, strata = NULL, - # permutations = 1, parallel = NULL, notification = TRUE) - ## delete potential missing species - if(any(colSums(comm)==0)){ - empty <- which(colSums(comm)==0) - traits <- traits[-empty,] - comm <- comm[,-empty] - } - syn.out.tmp <- matrix.t(comm=comm, traits=traits, scale=T)$matrix.T - ee <- env.sel - lab.env <- paste(ee, collapse="_") - corTE <- NULL - if("mantel" %in% stat){ - mantel.tmp <- mantel(dist(envir[,ee, drop=F]), dist(syn.out.tmp[,ii,drop=F])) - corTE <- rbind(corTE, - data.frame(Trait.comb=lab.tmp, Env.comb=lab.env, Test="Mantel", Coef=mantel.tmp$statistic, pvalue=mantel.tmp$signif)) - } - if("RV" %in% stat){ - RV.tmp <- RV.rtest(as.data.frame(envir[,ee, drop=F]), as.data.frame(syn.out.tmp[,ii,drop=F])) - corTE <- rbind(corTE, - data.frame(Trait.comb=lab.tmp, Env.comb=lab.env, Test="RV", Coef=RV.tmp$obs, pvalue=RV.tmp$pvalue)) - } - if("procrustes" %in% stat){ - prot.tmp <- protest(envir[,ee, drop=F], syn.out.tmp[,ii,drop=F]) - corTE <- rbind(corTE, - data.frame(Trait.comb=lab.tmp, Env.comb=lab.env, Test="Procrustes", Coef=prot.tmp$t0, pvalue=prot.tmp$signif)) - } - return(corTE) -} -get.corXE <- function(comm, traits, envir, trait.sel="all", env.sel="all", stat=c("mantel", "RV", "procrustes")){ - if(identical(trait.sel, "all")) {trait.sel <- 1:ncol(traits)} - if(identical(env.sel, "all" )) {env.sel <- 1:ncol(envir)} - ii <- trait.sel - lab.tmp <- paste(ii, collapse="_") - #syn.out.tmp <- syncsa(comm=comm, traits=traits[,ii, drop=F], envir = envir, - # checkdata = TRUE, ro.method = "mantel", method = "pearson", dist = "euclidean", scale = TRUE, - # scale.envir = F, ranks = TRUE, put.together = NULL, na.rm = FALSE, strata = NULL, - # permutations = 1, parallel = NULL, notification = TRUE) - ### delete potential missing species - if(any(colSums(comm)==0)){ - empty <- which(colSums(comm)==0) - traits <- traits[-empty,] - comm <- comm[,-empty] - } - syn.out.tmp <- matrix.x(comm=comm, traits=traits[,ii,drop=F], scale=T)$matrix.X - ee <- env.sel - lab.env <- paste(ee, collapse="_") - corXE <- NULL - if("mantel" %in% stat){ - mantel.tmp <- mantel(dist(envir[,ee, drop=F]), dist(syn.out.tmp[])) - corXE <- rbind(corXE, - data.frame(Trait.comb=lab.tmp, Env.comb=lab.env, Test="Mantel", Coef=mantel.tmp$statistic, pvalue=mantel.tmp$signif)) - } - if("RV" %in% stat){ - RV.tmp <- RV.rtest(as.data.frame(envir[,ee, drop=F]), as.data.frame(syn.out.tmp)) - corXE <- rbind(corXE, - data.frame(Trait.comb=lab.tmp, Env.comb=lab.env, Test="RV", Coef=RV.tmp$obs, pvalue=RV.tmp$pvalue)) - } - if("procrustes" %in% stat){ - prot.tmp <- protest(envir[,ee, drop=F], syn.out.tmp) - corXE <- rbind(corXE, - data.frame(Trait.comb=lab.tmp, Env.comb=lab.env, Test="Procrustes", Coef=prot.tmp$t0, pvalue=prot.tmp$signif)) - } - return(corXE) -} get.corXE(comm=Wi, envir=Ei, traits=Bi) diff --git a/99_HIDDEN_functions.R b/99_HIDDEN_functions.R new file mode 100644 index 0000000000000000000000000000000000000000..82584f79a25fe5d22144e446e0ed43128d5beeea --- /dev/null +++ b/99_HIDDEN_functions.R @@ -0,0 +1,118 @@ +#Functions to define correlations between Beals, SYNCSA, ENV +# W - Sp. composition +# X - fuzzy weighted +# Y - Beals +# B - traits +# E - Environment + + +library(tidyverse) +library(SYNCSA) +library(vegan) +library(abind) +library(ade4) + + +#### Function 1 - CorXY #### +get.corXY <- function(comm, traits, trait.sel="all", stat=c("mantel", "RV", "procrustes")){ + if(identical(trait.sel, "all")) {trait.sel <- 1:ncol(traits)} + ii <- trait.sel + lab.tmp <- paste(ii, collapse="_") + ### delete potential missing species + if(any(colSums(comm)==0)){ + empty <- which(colSums(comm)==0) + traits <- traits[-empty,] + comm <- comm[,-empty] + } + syn.out.tmp <- matrix.x(comm=comm, traits=traits[,ii,drop=F], scale=T)$matrix.X + W.beals <- as.data.frame(beals(comm, include=T, type=2)) + corXY <- NULL + if("mantel" %in% stat){ + W.beals.d <- dist(W.beals) + mantel.tmp <- mantel(W.beals.d, dist(syn.out.tmp[])) + corXY <- rbind(corXY, + data.frame(Trait.comb=lab.tmp, Test="Mantel", Coef=mantel.tmp$statistic, pvalue=mantel.tmp$signif)) + } + if("RV" %in% stat){ + RV.tmp <- RV.rtest(W.beals, as.data.frame(syn.out.tmp)) + corXY <- rbind(corXY, + data.frame(Trait.comb=lab.tmp, Test="RV", Coef=RV.tmp$obs, pvalue=RV.tmp$pvalue)) + } + if("procrustes" %in% stat){ + prot.tmp <- protest(W.beals, syn.out.tmp) + corXY <- rbind(corXY, + data.frame(Trait.comb=lab.tmp, Test="Procrustes", Coef=prot.tmp$t0, pvalue=prot.tmp$signif)) + } + return(corXY) +} + + + +#### Function 2 - CorTE #### +get.corTE <- function(comm, traits, envir, trait.sel="all", env.sel="all", stat=c("mantel", "RV")){ + if(identical(trait.sel, "all")) {trait.sel <- 1:ncol(traits)} + if(identical(env.sel, "all" )) {env.sel <- 1:ncol(envir)} + ii <- trait.sel + lab.tmp <- paste(ii, collapse="_") + ## delete potential missing species + if(any(colSums(comm)==0)){ + empty <- which(colSums(comm)==0) + traits <- traits[-empty,] + comm <- comm[,-empty] + } + syn.out.tmp <- matrix.t(comm=comm, traits=traits, scale=T)$matrix.T + ee <- env.sel + lab.env <- paste(ee, collapse="_") + corTE <- NULL + if("mantel" %in% stat){ + mantel.tmp <- mantel(dist(envir[,ee, drop=F]), dist(syn.out.tmp[,ii,drop=F])) + corTE <- rbind(corTE, + data.frame(Trait.comb=lab.tmp, Env.comb=lab.env, Test="Mantel", Coef=mantel.tmp$statistic, pvalue=mantel.tmp$signif)) + } + if("RV" %in% stat){ + RV.tmp <- RV.rtest(as.data.frame(envir[,ee, drop=F]), as.data.frame(syn.out.tmp[,ii,drop=F])) + corTE <- rbind(corTE, + data.frame(Trait.comb=lab.tmp, Env.comb=lab.env, Test="RV", Coef=RV.tmp$obs, pvalue=RV.tmp$pvalue)) + } + if("procrustes" %in% stat){ + prot.tmp <- protest(envir[,ee, drop=F], syn.out.tmp[,ii,drop=F]) + corTE <- rbind(corTE, + data.frame(Trait.comb=lab.tmp, Env.comb=lab.env, Test="Procrustes", Coef=prot.tmp$t0, pvalue=prot.tmp$signif)) + } + return(corTE) +} + + +#### Function 3 - CorXE #### +get.corXE <- function(comm, traits, envir, trait.sel="all", env.sel="all", stat=c("mantel", "RV", "procrustes")){ + if(identical(trait.sel, "all")) {trait.sel <- 1:ncol(traits)} + if(identical(env.sel, "all" )) {env.sel <- 1:ncol(envir)} + ii <- trait.sel + lab.tmp <- paste(ii, collapse="_") + ### delete potential missing species + if(any(colSums(comm)==0)){ + empty <- which(colSums(comm)==0) + traits <- traits[-empty,] + comm <- comm[,-empty] + } + syn.out.tmp <- matrix.x(comm=comm, traits=traits[,ii,drop=F], scale=T)$matrix.X + ee <- env.sel + lab.env <- paste(ee, collapse="_") + corXE <- NULL + if("mantel" %in% stat){ + mantel.tmp <- mantel(dist(envir[,ee, drop=F]), dist(syn.out.tmp[])) + corXE <- rbind(corXE, + data.frame(Trait.comb=lab.tmp, Env.comb=lab.env, Test="Mantel", Coef=mantel.tmp$statistic, pvalue=mantel.tmp$signif)) + } + if("RV" %in% stat){ + RV.tmp <- RV.rtest(as.data.frame(envir[,ee, drop=F]), as.data.frame(syn.out.tmp)) + corXE <- rbind(corXE, + data.frame(Trait.comb=lab.tmp, Env.comb=lab.env, Test="RV", Coef=RV.tmp$obs, pvalue=RV.tmp$pvalue)) + } + if("procrustes" %in% stat){ + prot.tmp <- protest(envir[,ee, drop=F], syn.out.tmp) + corXE <- rbind(corXE, + data.frame(Trait.comb=lab.tmp, Env.comb=lab.env, Test="Procrustes", Coef=prot.tmp$t0, pvalue=prot.tmp$signif)) + } + return(corXE) +} \ No newline at end of file