01b_MesobromionCluster.R

#Functions to define correlations between Beals, SYNCSA, ENV
# W - Sp. composition
# X - fuzzy weighted
# Y - Beals
# B - traits
# E - Environment


require(tidyverse)
require(SYNCSA)
require(vegan)
require(abind)
require(ade4)
require(parallel)
require(doParallel)


source("99_HIDDEN_functions.R")


get.ci <- function(corXY){
  corXY %>% 
  filter(bootstr.n==0) %>% 
  dplyr::select(-bootstr.n) %>% 
  group_by(Trait.comb) %>% 
  slice(1) %>% 
  left_join(corXY %>% 
              filter(bootstr.n!=0) %>% 
              group_by(Trait.comb) %>% 
              summarize(q025=quantile(Coef.obs, 0.025),
                        q975=quantile(Coef.obs, 0.975),
                        greater.than.perm=mean(Coef.obs>Coef.perm), 
                        n=n())) %>% 
  #calculate significance using permuted correlations
  mutate(sign_plus=greater.than.perm>0.995) %>% 
  mutate(sign_minus=greater.than.perm<0.005) %>% 
  ungroup() %>% 
  mutate(Trait.comb=as.character(Trait.comb)) %>% 
  rowwise() %>% 
  mutate(ntraits= length(unlist(strsplit(Trait.comb, split = "_")))) %>% 
  ungroup() %>% 
  arrange(ntraits, Coef.obs)
}

get.best <- function(x, N){
  out <- x %>% 
    filter(ntraits==N) %>% 
    filter(sign_plus==TRUE) %>% 
    arrange(desc(Coef.obs)) %>% 
    slice(1) %>% 
    pull(Trait.comb)
  return(out)
}



Mesobromion <- function(species.path, traits.path, output, myfunction="get.corXY.bootstrap", 
                        combinations=c("all", "sequential"), max.inter.t, chunkn, chunk.i, nperm=199, ncores=1){
  
  if(ncores>1){
    require(parallel)
    require(doParallel)
    cl <- makeForkCluster(ncores, outfile="" )
    registerDoParallel(cl)
    `%myinfix%` <- `%dopar%`
  } else {
    `%myinfix%` <- `%do%`
  }
  
  myfunction <- get(myfunction)
  ## calculate corr between species composition matrix and traits
  species <- read_delim(species.path, delim="\t") %>%
		as.data.frame()
  traits <- read_delim(traits.path, delim="\t") %>%
		as.data.frame() %>% 
### TEMPORARY FOR TESTING!
    dplyr::select(1:11)
  
  
  traits <- traits %>% 
    column_to_rownames("species0") %>% 
    rename_all(.funs=~gsub(pattern=".mean$", replacement="", x=.))  #%>% 
#temporary    ### Use only a subset of traits
    #dplyr::select(LeafArea:Disp.unit.leng)
  
  if(combinations=="all") {
    ## create list of indices for each combination of traits up to a max number of interactions
    n.traits <- ncol(traits)
    allcomb.t <- NULL
    for(n.inter in 1:max.inter.t){
      allcomb.t <- c(allcomb.t, combn(1:n.traits, n.inter, simplify=F))
    }
    nall <- length(allcomb.t)
    
    ## Divide in chunks if requested
    if(chunkn>1 & !is.na(chunk.i)){
      print(paste("Test all Combo - divide in", chunkn, "chunks and run on chunk n.", chunk.i))
      indices <- 1:length(allcomb.t)
      chunks <- split(indices, sort(indices%%chunkn))
      allcomb.t <- allcomb.t[chunks[[chunk.i]]]
    } 
    print(paste("Running on", length(allcomb.t),"out of", nall, "combinations"))
    #names.t <- unlist(lapply(allcomb.t, paste, collapse="_"))
    
    print("Start main loop")
    corXY.output <- NULL
    corXY.output <- foreach(i=1:length(allcomb.t), .combine=rbind) %myinfix% {
      tt <- unlist(allcomb.t[i])
      corXY.output <- rbind(corXY.output, 
                            get.corXY.bootstrap(comm=species, trait=traits, 
                                                trait.sel=tt, bootstrap=nperm))
    }
    save(corXY.output, file = paste(output, "_.RData", sep=""))
  }
  
  
  if(combinations=="sequential"){
    corXY.output <- NULL
    for(nround in 1:max.inter.t){
      ## select combination of traits based on best
      if(nround==1) {
        allcomb.t <- lapply(1:ncol(traits), function(x){return(x)})
        nall <- length(allcomb.t)
        }  else {
          best.split <- as.numeric(unlist(strsplit(best, "_")))
          max.inter.t <- nround-1
          #n.traits <- ncol(traits)
          list.traits <- as.numeric(traits.sign.alone)
          list.traits <- list.traits[-which(list.traits %in% best.split)] ## list of remaining traits without best
          if(length(list.traits) < max.inter.t) {
            save(corXY.output, file = paste(output, ".RData", sep=""))
            if(ncores>1) {stopCluster(cl)}
            stop("Tested all combo of significant traits")
          }
          allcomb.t <- NULL
          #for(n.inter in 1:max.inter.t){
          allcomb.t <- c(allcomb.t, combn(list.traits, max.inter.t, simplify=F))
          #}
          #add best to all combo
          allcomb.t <- lapply(allcomb.t, function(x){return(c(best.split, x))})
          nall <- length(allcomb.t)
        }
      
      ## Divide in chunks if requested
      if(chunkn>1){
        print(paste("nround", nround, "--- divide in", chunkn, "chunks"))
        indices <- 1:length(allcomb.t)
        chunks <- split(indices, sort(indices%%chunkn))
      }  else {chunks <- list(1:length(allcomb.t))}
      #names.t <- unlist(lapply(allcomb.t, paste, collapse="_"))
      
      ## start main foreach loop
      print(paste("Start main loop - round", nround))
      corXY.output <- foreach(ch=chunks, .combine=rbind) %myinfix% {
        allcomb.i <- allcomb.t[unlist(ch)]
        print(paste("Running on", length(allcomb.i),"out of", nall, "combinations"))
        
        for(i in 1:length(allcomb.i)){
          tt <- unlist(allcomb.i[i])
          corXY.output <- rbind(corXY.output, 
                              get.corXY.bootstrap(comm=species, trait=traits, 
                                                  trait.sel=tt, bootstrap=nperm))
        }
        return(corXY.output)
      }
      #Intermediate save
      #save(corXY.output, file = paste(output, "_", nround, ".RData", sep=""))
      
      print(paste("Summarize after round", nround, "and find best, significant trait combos"))
      corXY.ci <- get.ci(corXY.output)
      ##get best or new best
      if(nround==1) {
        traits.sign.alone <- corXY.ci %>% 
          filter(ntraits==1) %>% 
          filter(sign_plus==T) %>% 
          pull(Trait.comb)
        if(length(traits.sign.alone)==0) {
          stop("No trait is significant taken singularly")}
        print(paste("Traits significant taken singularly:", paste(traits.sign.alone, collapse=" ")))
        best <- get.best(corXY.ci, N=1)
        best.row <- corXY.ci %>% 
          filter(Trait.comb==best) 
        upper <- best.row$q975
        lower <- best.row$q025
        print(paste("new best at nround=", nround, "is trait combination", best))
      }
      
      if(nround>1){
       better <- corXY.ci %>% 
          filter(ntraits==nround) %>% 
          filter(q025>upper) %>% 
          arrange(desc(Coef.obs)) %>% 
          slice(1) %>% 
          pull(Trait.comb)
        
        if(length(better>0)){
          new.best.row <- corXY.ci %>% 
            #rowwise() %>% 
            #mutate(nmatching= sum(unlist(strsplit(Trait.comb, "_")) %in% 
            #                        unlist(strsplit(better, "_")),
            #                      na.rm=T)) %>% 
            #ungroup() %>% 
            #filter(nmatching==nround) %>% 
            filter(Trait.comb==better) 
          upper <- new.best.row$q975
          lower <- new.best.row$q025
          best <- better
          print(paste("new best at round=", nround, "is trait combination", best))
        } else {print(paste("no new best at round=", nround))}
      }
    }
    save(corXY.output, file = paste(output, ".RData", sep=""))
    
  }
  if(ncores>1){stopCluster(cl)} 
}