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