Separated functions from analysis of simulated data

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)
 

99_HIDDEN_functions.R

+#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