From 330ff31a636658763ccc858f3fcdf91c8e49ae32 Mon Sep 17 00:00:00 2001
From: Francesco Sabatini <francesco.sabatini@idiv.de>
Date: Tue, 12 May 2020 17:11:02 +0200
Subject: [PATCH] recoded traits to nominal - other treated as symmetric binary

---
 01_Mesobromion.R      | 82 +++++++++++++++++++++++++++++++++----------
 99_HIDDEN_functions.R |  8 ++---
 session.R             |  8 ++---
 3 files changed, 71 insertions(+), 27 deletions(-)

diff --git a/01_Mesobromion.R b/01_Mesobromion.R
index 0549008..fe812ad 100644
--- a/01_Mesobromion.R
+++ b/01_Mesobromion.R
@@ -150,6 +150,30 @@ traits <- traits %>%
   dplyr::select(species0, everything()) %>% 
   filter(species0 %in% colnames(species))
   
+
+#recode binary traits to nominal
+colnames(traits)[which(colnames(traits)=="LBE_D_plurienn_hapaxanth")] <- "LEB_D_plurienn_hapaxanth"
+traits <- traits %>% 
+  mutate(BLU_KL_NEKTAR_HONIG_INSEKTEN=replace(BLU_KL_NEKTAR_HONIG_INSEKTEN, 
+                                              list=species0 %in% c("Convallaria_majalis", "Maianthemum_bifolium"),
+                                              values=0))
+
+traits <- traits %>% 
+  as.tbl() %>% 
+  dplyr::select(-starts_with("BL_FORM"), -starts_with("REPR_T"), -starts_with("BLU_KL"), -starts_with("STRAT_T")) %>% 
+  left_join(traits %>% 
+              dplyr::select(species0, REPR_T_Samen_Sporen:STRAT_T_SR) %>% 
+              gather(key=Trait, value="value", -species0) %>% 
+              separate(Trait, into = c("Trait", "Organ", "Level"), sep = "_", extra = "merge") %>% 
+              unite(Trait, Trait, Organ) %>% 
+              filter(value==1) %>% 
+              dplyr::select(-value) %>% 
+              spread(Trait, Level) %>% 
+              mutate_at(.vars=vars(BLU_KL:STRAT_T), 
+                        .funs=~as.factor(.)), 
+            by="species0")
+
+
 dim(species) #558 783
 dim(traits) #783 81
 dim(env) #558 8
@@ -195,14 +219,30 @@ species <- read_delim("_data/Mesobromion/species.out.10perc.txt", delim="\t")
 traits <- read_delim("_data/Mesobromion/traits.out.10perc.txt", delim="\t")
 
 traits <- traits %>% 
-  column_to_rownames("species0") # %>% 
+#  filter(species0 %in% colnames(species)) %>% 
+  column_to_rownames("species0")
+  
   #dplyr::select(LeafArea:Disp.unit.leng)
   #dplyr::select(PlantHeight, LeafC.perdrymass, LeafN, StemDens, Stem.cond.dens, Seed.num.rep.unit, SLA)
 
+comm <- species
+traits <- traits 
+trait.sel <- 6
+a <- get.corXY.bootstrap(comm=species, traits=traits, 
+                    trait.sel=6, bootstrap=10)
+
+
+
+
+
+
 
 #### ## Import output #### 
-myfilelist <- list.files(path="_derived/Mesobromion/", pattern="HIDDEN_individual_[0-9]+.RData", full.names = T)
-dataFiles = purrr::map(myfilelist, function(x){get(load(x))}) 
+myfilelist <- list.files(path="_derived/Mesobromion/", pattern="HIDDEN_round_[0-9]+.RData", full.names = T)
+#dataFiles = purrr::map(myfilelist, function(x){get(load(x))})
+load("_derived/Mesobromion/HIDDEN_round_7.RData")
+
+
 corXY = bind_rows(dataFiles) %>% 
   as.tbl()
 rm( dataFiles)
@@ -225,19 +265,21 @@ corXY.ci <- corXY %>%
                         n=n())) %>% 
   #calculate significance using permuted correlations
   mutate(sign_plus=greater.than.perm>0.995) %>% 
-  mutate(sign_minus=greater.than.perm<0.005)  %>% 
-  mutate(Trait.comb2=Trait.comb) %>% 
-  #split strings of trait combinations and add labels
-  separate(Trait.comb2, into=paste0("trait", 1:15)) %>% 
-  mutate_at(.vars=vars(trait1:trait15),
-            .funs=~factor(., levels=trait.labs$Trait.comb, labels=trait.labs$trait.name)) %>% 
+  mutate(sign_minus=greater.than.perm<0.005)   %>% 
   rowwise() %>% 
   mutate(ntraits= length(unlist(strsplit(Trait.comb, "_")))) %>% 
-  ungroup() %>% 
-  arrange(ntraits, Coef.obs) %>% 
-  dplyr::select(Trait.comb, Test, n, ntraits, everything()) %>% 
+  ungroup()  %>% 
   mutate_at(.vars=vars(starts_with("sign")), 
             .funs=~factor(.*1, levels=c(0,1), labels=c("FALSE", "TRUE")))
+
+corXY.ci <- corXY.ci %>% 
+  mutate(Trait.comb2=Trait.comb) %>% 
+  #split strings of trait combinations and add labels
+  separate(Trait.comb2, into=paste0("trait", 1:22)) %>% 
+  mutate_at(.vars=vars(trait1:trait22),
+            .funs=~factor(., levels=trait.labs$Trait.comb, labels=trait.labs$trait.name)) %>% 
+  arrange(ntraits, Coef.obs) %>% 
+  dplyr::select(Trait.comb, Test, n, ntraits, everything())
   
 #corXY.ci %>% 
 #  arrange(ntraits, Trait.comb, Coef.obs) %>% 
@@ -250,7 +292,7 @@ traits.sign.alone <- corXY.ci %>%
 
 ### filter combinations where all traits belong to traits.sign.alone
 mydata <- corXY.ci %>% 
-  filter_at(.vars=vars(trait1:trait15), all_vars(. %in% traits.sign.alone | is.na(.)))%>% 
+  #filter_at(.vars=vars(trait1:trait22), all_vars(. %in% traits.sign.alone | is.na(.)))%>% 
   mutate(seq=1:n())
 
 
@@ -281,12 +323,14 @@ ggsave(filename = "_pics/TopFirstPredictors_CI.png", dpi=400,
 
 allpredictors <- top.first %+% (mydata) +
   scale_y_continuous(breaks=mydata$seq, 
-                     labels=mydata$Trait.comb) + 
+                     labels=NULL) + 
+  #                   labels=mydata$Trait.comb) + 
+  
   theme_classic() + 
   theme(axis.text.y = element_text(size=3)) #+ 
-  #facet_wrap(.~ntraits, scales = "free_y",  nrow=2)
+  #facet_wrap(.~ntraits, scales = "free_y",  nrow=3)
 
-ggsave(filename = "_pics/All_predictors_sign_individually_CI_unfaceted.png", dpi=400, 
+ggsave(filename = "_pics/All_predictors_sign_individually_CI_faceted_0506.png", dpi=400, 
        width=6, height=30, allpredictors)
   
 
@@ -307,7 +351,7 @@ get.best <- function(x, N){
 top.one.by.one <- get.best(mydata, N=1)
 
 
-maxtraits <- 10
+maxtraits <- 7
 for(nn in 1:maxtraits){
   if(nn==1) {
     best.at.1 <- get.best(mydata, N=nn)
@@ -316,8 +360,8 @@ for(nn in 1:maxtraits){
                 .vars_predicate = any_vars(. %in% best.at.1$trait.name | is.na(.))) 
     new.best.row <- newdata %>% 
       filter(Trait.comb==best.at.1$Trait.comb) 
-    upper <- best.row$q975
-    lower <- best.row$q025
+    upper <- new.best.row$q975
+    lower <- new.best.row$q025
     print(paste("new best at nn", nn, best.at.1$trait.name))
   }
   if(nn>1){
diff --git a/99_HIDDEN_functions.R b/99_HIDDEN_functions.R
index 1e01fcb..1f206a1 100644
--- a/99_HIDDEN_functions.R
+++ b/99_HIDDEN_functions.R
@@ -66,14 +66,14 @@ get.corXY.bootstrap <- function(comm, traits, trait.sel="all", bootstrap=199){
   ## caution
   ## ALL columns with only 0-1 values are AUTOMATICALLY considered as asym.bin sensu FD:gowdis
   ##get all columns with binary variables
-  binary.traits <- which(apply(traits[,ii,drop=F], MARGIN=2, function(x)( all(na.omit(x) %in% 0:1) ))==T)
+#  binary.traits <- which(apply(traits[,ii,drop=F], MARGIN=2, function(x)( all(na.omit(x) %in% 0:1) ))==T)
   
-  syn.out.tmp <- matrix.x(comm=comm, traits=traits[,ii,drop=F], scale=T, asym.bin=binary.traits)$matrix.X
+  syn.out.tmp <- matrix.x(comm=comm, traits=traits[,ii,drop=F], scale=T)$matrix.X #, asym.bin=binary.traits
   W.beals <- as.data.frame(beals(comm, include=T, type=2))
   # permtute traits 
   index.traits <- lapply(1:(bootstrap+1), function(x){sample(1:n.species, replace=F)})
   syn.out.perm.tmp <- matrix.x(comm=comm, traits=traits[index.traits[[bootstrap+1]],ii,drop=F], 
-                               scale=T, asym.bin=binary.traits)$matrix.X
+                               scale=T)$matrix.X #, asym.bin=binary.traits
   
   corXY <- NULL
   #RD.tmp <- RV.rtest(W.beals, as.data.frame(syn.out.tmp), nrepet = 0)
@@ -89,7 +89,7 @@ get.corXY.bootstrap <- function(comm, traits, trait.sel="all", bootstrap=199){
     #RV.tmp <- RV.rtest(W.beals[index.bootstr[[b]],], as.data.frame(syn.out.tmp)[index.bootstr[[b]],])
     RD.tmp <- dcor(W.beals[index.bootstr[[b]],], as.data.frame(syn.out.tmp)[index.bootstr[[b]],])^2
     syn.out.perm.tmp <- matrix.x(comm=comm, traits=traits[index.traits[[bootstrap]],ii,drop=F], 
-                                 scale=T, asym.bin=binary.traits)$matrix.X
+                                 scale=T)$matrix.X #, asym.bin=binary.traits
     #RV.perm.tmp <- RV.rtest(W.beals[index.bootstr[[b]],], as.data.frame(syn.out.perm.tmp)[index.bootstr[[b]],])
     RD.perm.tmp <- dcor(W.beals[index.bootstr[[b]],], as.data.frame(syn.out.perm.tmp)[index.bootstr[[b]],])^2
     corXY <- rbind(corXY,
diff --git a/session.R b/session.R
index eaa08cc..f7a2323 100644
--- a/session.R
+++ b/session.R
@@ -5,12 +5,12 @@ output  <- "_derived/Mesobromion/HIDDEN"
 myfunction <- "get.corXY.bootstrap"
 max.inter.t <- 7
 chunk.i <- NA
-nperm <- 2
-ncores <- 1
+nperm <- 99
+ncores <- 8
 chunkn <- 3*ncores
 combinations <- "sequential"
-start.round <- 1
-relax.round <- 3
+start.round <- 2
+relax.round <- 2
 
 source("01b_MesobromionCluster.R")
 #Mesobromion(species.path, traits.path, output, myfunction, max.inter.t, chunkn, chunk.i, nperm)
-- 
GitLab