R/simLBG.R

In LewisAJones/LBGSim: Latitudinal biodiversity gradient simulator

#' Simulates species distributions according to a defined probability grid (e.g. LBGtype())
#'
#' @param n Integer. Number of species to simulate distributions for. Defaults to 10.
#' @param layers RasterLayer. Landscape (study area) the user wishes to populate. Typically, raster should be masked to suitable environmental conditions (e.g. <200 m depth)
#' @param LBG RasterLayer. Probability grid generated via the LBGtype function. The user can also input their own probability grids here.
#' @param reps Integer. Number of simulation repliactions. Defaults to 1.
#' @param parallel Logical. Implement parallel processing. Defaults to FALSE. Parallel processing is currently only supported for "unix" operating systems.
#' @param write Logical. Save data to working directory. Defaults to FALSE.
#' @return A dataframe of species occurrences (rep, species, x, y).  
#' @importFrom raster resample mask
#' @importFrom spatialEco raster.invert
#' @importFrom dplyr bind_rows
#' @importFrom pbmcapply pbmclapply
#' @importFrom NLMR nlm_distancegradient
#' @export

simLBG <- function(n = 10, layers, LBG, reps = 1, parallel = FALSE, write = FALSE){
  nme <- names(layers) #extract name of layer for folder creation

  if(write == TRUE){
    suppressWarnings(dir.create(paste("./Simulation/", nme, sep = "")))
  } #create folder for saving
  
  circ_div_grad <- spatialEco::raster.invert(NLMR::nlm_distancegradient(ncol = 200, nrow = 200, #higher resolution for more occurrences
                                                                  origin = c(100, 100, 100, 100), resolution = res(LBG)[1])) #adjust origin for nrow + ncol
  circ_div_grad <- circ_div_grad + 1
  tmplayer <- raster::resample(layers, LBG) #change resolution of layer to match desired by LBG
  tmplayer <- raster::mask(LBG, tmplayer) #mask LBG probability raster with shallow water mask

  if(parallel == TRUE & reps > 1){
  datsim <- pbmcapply::pbmclapply(1:reps, function(x) {
    simDat <- LBGSim:::simDist(n = n, tmplayer = tmplayer, circ_div_grad = circ_div_grad, parallel = parallel)
    names(simDat) <- 1:n
    simDat <- dplyr::bind_rows(simDat, .id = "species")
    simDat
  }, mc.cores = 1, mc.preschedule = TRUE, mc.cleanup = TRUE)
  names(datsim) <- 1:reps
  simDat <- dplyr::bind_rows(datsim, .id = "rep")
  } else if (reps == 1){
    simDat <- LBGSim:::simDist(n = n, tmplayer = tmplayer, circ_div_grad = circ_div_grad, parallel = parallel)
    names(simDat) <- 1:n
    simDat <- dplyr::bind_rows(simDat, .id = "species")
  } else {
    datsim <- lapply(1:reps, function(x) {
    simDat <- LBGSim:::simDist(n = n, tmplayer = tmplayer, circ_div_grad = circ_div_grad, parallel = parallel)
    names(simDat) <- 1:n
    simDat <- dplyr::bind_rows(simDat, .id = "species")
    simDat
  })
  names(datsim) <- 1:reps
  simDat <- dplyr::bind_rows(datsim, .id = "rep")
  }
  
  if(write == TRUE){
    write.csv(simDat, paste("./Simulation/", nme, "/simLBG.csv", sep = ""), row.names=FALSE)
    }
  
  return(simDat)
}