diff --git a/NAMESPACE b/NAMESPACE index ad14874..27b9c75 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -25,6 +25,7 @@ export(POST_FATE.graphic_validationStatistics) export(POST_FATE.graphics) export(POST_FATE.relativeAbund) export(POST_FATE.temporalEvolution) +export(POST_FATE.validation) export(PRE_FATE.abundBraunBlanquet) export(PRE_FATE.params_PFGdispersal) export(PRE_FATE.params_PFGdisturbance) @@ -71,6 +72,7 @@ importFrom(adehabitatHR,kernelUD) importFrom(adehabitatMA,ascgen) importFrom(ape,as.phylo) importFrom(ape,plot.phylo) +importFrom(caret,confusionMatrix) importFrom(cluster,silhouette) importFrom(colorspace,heat_hcl) importFrom(colorspace,sequential_hcl) @@ -107,6 +109,9 @@ importFrom(ggplot2,geom_smooth) importFrom(ggplot2,geom_vline) importFrom(ggplot2,ggplot) importFrom(ggplot2,ggsave) +importFrom(ggplot2,ggtitle) +importFrom(ggplot2,guide_legend) +importFrom(ggplot2,guides) importFrom(ggplot2,labs) importFrom(ggplot2,scale_alpha) importFrom(ggplot2,scale_color_continuous) @@ -142,28 +147,38 @@ importFrom(huge,huge.npn) importFrom(methods,as) importFrom(parallel,mclapply) importFrom(phyloclim,niche.overlap) +importFrom(prettyR,Mode) +importFrom(randomForest,randomForest) +importFrom(randomForest,tuneRF) importFrom(raster,as.data.frame) importFrom(raster,as.matrix) importFrom(raster,cellFromXY) importFrom(raster,cellStats) importFrom(raster,coordinates) importFrom(raster,crop) +importFrom(raster,crs) importFrom(raster,extension) importFrom(raster,extent) importFrom(raster,extract) +importFrom(raster,levels) importFrom(raster,mask) importFrom(raster,nlayers) importFrom(raster,projectRaster) importFrom(raster,projection) importFrom(raster,raster) importFrom(raster,rasterToPoints) +importFrom(raster,ratify) importFrom(raster,res) importFrom(raster,stack) importFrom(raster,writeRaster) importFrom(raster,xyFromCell) +importFrom(readr,write_rds) +importFrom(reshape2,dcast) importFrom(reshape2,melt) importFrom(sp,SpatialPoints) +importFrom(stats,aggregate) importFrom(stats,as.dist) +importFrom(stats,complete.cases) importFrom(stats,cophenetic) importFrom(stats,cor) importFrom(stats,cutree) @@ -182,6 +197,7 @@ importFrom(utils,combn) importFrom(utils,download.file) importFrom(utils,install.packages) importFrom(utils,packageDescription) +importFrom(utils,read.csv) importFrom(utils,read.delim) importFrom(utils,setTxtProgressBar) importFrom(utils,tail) diff --git a/R/POST_FATE.validation.R b/R/POST_FATE.validation.R new file mode 100644 index 0000000..ccf2b59 --- /dev/null +++ b/R/POST_FATE.validation.R @@ -0,0 +1,939 @@ +### HEADER ########################################################################## +##' +##' @title Compute validation data for habitat, PFG richness and composition for a +##' \code{FATE} simulation. +##' +##' @name POST_FATE.validation +##' +##' @author Matthieu Combaud, Maxime Delprat, Maya Guéguen +##' +##' @description This script is designed to compare observed and simulated PFG +##' distribution for one specific \code{FATE} simulation year by computing +##' a) difference in PFG richness ; +##' b) similarity between distribution quantiles ; +##' c) a random forest model to predict habitat classes. +##' +##' +##' @param name.simulation a \code{string} corresponding to the main directory +##' or simulation name of the \code{FATE} simulation +##' @param file.simulParam default \code{NULL}. \cr A \code{string} +##' corresponding to the name of a parameter file that will be contained into +##' the \code{PARAM_SIMUL} folder of the \code{FATE} simulation +##' @param year an \code{integer} corresponding to the simulation year that will +##' be used to extract PFG abundance table +##' @param mat.obs a \code{data.frame} with at least 5 columns : \cr +##' \code{site}, \code{x}, \code{y}, \code{PFG}, \code{abund} +##' \cr (\emph{and optionally, \code{strata}, \code{code.habitat}}) +##' (see \href{POST_FATE.validation#details}{\code{Details}}) +##' @param mat.hab a \code{data.frame} with 2 columns : \code{code.habitat}, +##' \code{habitat} +##' @param ras.habitat a \code{string} corresponding to the file name of a +##' raster mask, with an \code{integer} value within each pixel, corresponding +##' to a specific habitat +##' @param doRichness (\code{logical}) default \code{TRUE}. \cr If \code{TRUE}, +##' difference in observed and simulated PFG richness will be run. +##' @param doComposition (\code{logical}) default \code{TRUE}. \cr If \code{TRUE}, +##' difference in observed and simulated PFG distribution over habitat will be run. +##' @param doHabitat (\code{logical}) default \code{TRUE}. \cr If \code{TRUE}, +##' a random forest model to predict habitat from PFG abundances will be run. +##' @param RF.seed default \code{123}. \cr An \code{integer} to be given to +##' \code{\link[base]{set.seed}} function, in order to fix the produced results +##' if needed, as dataset will be divided randomly into training and testing +##' datasets for the random forest model +##' @param RF.training default \code{0.7}. \cr A \code{numeric} between \code{0} +##' and \code{1} corresponding to the percentage of data that will be used as +##' training dataset in the random forest model +##' @param doHabitat.allMap (\code{logical}) default \code{TRUE}. \cr If +##' \code{TRUE}, habitat prediction over the whole simulation map will be run. +##' @param opt.ras_validation (\emph{optional}) default \code{NULL}. \cr +##' A \code{string} corresponding to the file name of a raster mask, with either +##' \code{0} or \code{1} within each pixel, \code{1} corresponding to the cells +##' of the studied area in which the validation will take place +##' @param opt.keep_PFG (\emph{optional}) default \code{NULL}. \cr +##' A \code{vector} of \code{character} corresponding to the names of the PFG to +##' keep for the validation +##' @param opt.keep_strata (\emph{optional}) default \code{NULL}. \cr +##' A \code{list} with names corresponding to the strata to keep for the +##' validation, and each element containing correspondence with \code{FATE} +##' strata definition +##' +##' +##' @details +##' +##' This function allows to obtain, for a specific \code{FATE} simulation and +##' a specific parameter file within this simulation, \strong{PFG validation +##' habitat model and predictions} and one preanalytical graphic. \cr \cr +##' +##' \describe{ +##' \item{PFG richness}{ +##' check if all simulated PFG abundances are superior to 0 within the +##' simulated area (\emph{only a subset of PFG can be examined with the +##' \code{opt.keep_PFG} parameter}). +##' } +##' +##' \item{PFG composition}{ +##' for each PFG and each habitat / stratum combination, abundances for each +##' quartiles (\code{25}, \code{50}, \code{75} and \code{100} \%) is +##' calculated for both observed and simulated distributions. \cr +##' (\emph{Only a subset of PFG and strata can be examined with the +##' \code{opt.keep_PFG} and \code{opt.keep_strata} parameters.}) \cr +##' +##' Then, a composition similarity between each PFG / habitat / strata +##' combination is calculated as a pseudo-distance between observed and +##' simulated quartiles \code{Q} : +##' \deqn{S_{\text{ Habitat}_j \text{, }\text{Stratum}_k} = +##' \sum S_{\text{ PFG}_i \text{, }\text{Habitat}_j \text{, }\text{Stratum}_k}} +##' with +##' \deqn{S_{\text{ PFG}_i \text{, }\text{Habitat}_j \text{, }\text{Stratum}_k} +##' = 1 - \frac{\text{1}}{4} * \sum abs(Q_{\text{ q} \text{, }sim} - Q_{\text{ q} \text{, }obs})} +##' with \code{q} varying from 1 to 4. +##' } +##' +##' \item{Habitat validation}{ +##' a \code{\link[randomForest]{randomForest}} model is built to predict +##' habitat (provided through \code{ras.habitat}) in function of observed PFG +##' abundances. Only habitat code in \code{mat.hab} are effectively used and +##' predicted. TSS (True Skill Statistic) is computed between observed and +##' simulated habitat, and averaged over each habitat. TSS can also be +##' weighted by the share of each habitat in the observed habitat distribution. +##' } +##' } +##' +##' @return A \code{list} containing two to ten elements depending on the +##' options selected : +##' \describe{ +##' \item{PFG richness}{three \code{vector} objects : +##' \describe{ +##' \item{\code{rich.obs}}{\code{vector} containing names of PFG in observed +##' data} +##' \item{\code{rich.sim}}{\code{vector} containing names of PFG in +##' simulated data} +##' \item{\code{rich.diff}}{\code{vector} containing names of PFG in +##' observed but not in simulated data} +##' } +##' } +##' \item{PFG composition}{ +##' \describe{ +##' \item{\code{compo.distrib}}{\code{data.frame} object with the following +##' columns : +##' \describe{ +##' \item{\code{PFG}}{concerned plant functional group} +##' \item{\code{code.habitat}}{concerned habitat code} +##' \item{\code{strata}}{concerned height stratum} +##' \item{\code{quantile.perc}}{concerned quantile} +##' \item{\code{quantile.obs}}{corresponding observed abundance} +##' \item{\code{quantile.sim}}{corresponding simulated abundance} +##' } +##' } +##' \item{\code{compo.proximity}}{\code{data.frame} object with the +##' following columns : +##' \describe{ +##' \item{\code{PFG}}{concerned plant functional group} +##' \item{\code{code.habitat}}{concerned habitat code} +##' \item{\code{strata}}{concerned height stratum} +##' \item{\code{proximity}}{composition similarity between each +##' habitat/strata combination} +##' } +##' } +##' } +##' } +##' \item{Habitat}{ +##' \describe{ +##' \item{\code{hab.RF.model}}{\code{randomForest} object obtained from +##' \code{\link[randomForest]{randomForest}} function} +##' \item{\code{hab.RF.perf}}{\code{data.frame} object with the following +##' columns : +##' \describe{ +##' \item{\code{dataset}}{\code{train}, \code{test} or \code{valid}} +##' \item{\code{habitat}}{concerned habitat code} +##' \item{\code{sensitivity}}{true positive rate} +##' \item{\code{specificity}}{true negative rate} +##' \item{\code{weight}}{share of each habitat in the observed habitat +##' distribution} +##' \item{\code{TSS}}{mean True Skill Statistic} +##' \item{\code{TSSw}}{mean weighted True Skill Statistic} +##' } +##' } +##' \item{\code{hab.tab.pred}}{\code{data.frame} object with the following columns : +##' \describe{ +##' \item{\code{pixel}}{concerned pixel} +##' \item{\code{x}}{corresponding x-coordinate} +##' \item{\code{y}}{corresponding y-coordinate} +##' \item{\code{code.habitat}}{concerned habitat code} +##' \item{\code{habitat.obs}}{observed habitat} +##' \item{\code{habitat.sim}}{simulated habitat through random forest model} +##' \item{\code{habitat.final}}{simulated habitat through random forest +##' model, with wrong predictions indicated as \code{failure}} +##' \item{\code{fail_succ}}{wether or not the simulated habitat is the +##' same as the observed} +##' \item{\code{color}}{corresponding color code} +##' } +##' } +##' \item{\code{hab.ras.pred}}{\code{raster} object containing habitat +##' predictions} +##' \item{\code{hab.plot}}{\code{ggplot2} object, representing +##' \code{hab.ras.pred} raster} +##' } +##' } +##' } +##' +##' +##' One to four \file{POST_FATE_TABLE_[...].csv} files are created : +##' \describe{ +##' \item{\file{HAB_validation_compo_distribution_}}{\emph{if composition +##' module was activated}, containing \code{compo.distrib}} +##' \item{\file{HAB_validation_compo_proximity_}}{\emph{if composition module +##' was activated}, containing \code{compo.proximity}} +##' \item{\file{HAB_validation_RF_performance_}}{\emph{if habitat module was +##' activated}, containing \code{hab.RF.perf}} +##' \item{\file{PIXEL_validation_RF_prediction_}}{\emph{if habitat module was +##' activated}, containing \code{hab.tab.pred}} +##' } +##' +##' \file{HabitatPrediction_YEAR_[...].tif} and +##' \file{POST_FATE_GRAPHIC_D_map_habitat_[...].pdf} files are created +##' containing random forest predicted habitat raster and plot respectively. +##' +##' +##' @examples +##' +##' library(raster) +##' +##' ## Create a simulation folder +##' PRE_FATE.skeletonDirectory(name.simulation = "FATE_Champsaur") +##' +##' ## Load example data +##' Champsaur_params = .loadData("Champsaur_params", "RData") +##' .loadData("Champsaur_results_V1", "7z") +##' +##' ## Please extract results files in the 'FATE_Champsaur/RESULTS' folder +##' +##' ## Define a vector to choose habitats taken into account +##' mat.hab = data.frame(ID = c(6, 5, 7, 8) +##' , habitat = c("coniferous.forest" +##' , "deciduous.forest" +##' , "natural.grassland" +##' , "woody.heatland")) +##' +##' ## Habitat & validation maps +##' ras_simulation = Champsaur_params$stk.mask$Champsaur +##' ras.habitat = Champsaur_params$stk.mask$habitat +##' ras.habitat = projectRaster(from = ras.habitat, to = ras_simulation, method = "ngb") +##' # writeRaster(ras_simulation, filename = "FATE_Champsaur/DATA/MASK/MASK_Champsaur.tif") +##' +##' ## Observed data +##' mat.obs = Champsaur_params$tab.releves +##' +##' ## Transform observed PFG abundances into relative abundances +##' mat.obs$abund = PRE_FATE.abundBraunBlanquet(mat.obs$abund) / 100 +##' mat.obs = aggregate(abund ~ site + PFG + strata + x + y +##' , data = mat.obs, FUN = "sum") +##' +##' ## Create Global and Simulation parameters +##' PRE_FATE.params_globalParameters(name.simulation = "FATE_Champsaur" +##' , opt.saving_abund_PFG_stratum = TRUE +##' , opt.saving_abund_PFG = TRUE +##' , opt.saving_abund_stratum = FALSE +##' , required.no_PFG = 15 +##' , required.no_strata = 7 +##' , required.simul_duration = 2000 +##' , required.seeding_duration = 1000 +##' , required.seeding_timestep = 1 +##' , required.seeding_input = 100 +##' , required.potential_fecundity = 1 +##' , required.max_abund_low = 1000 +##' , required.max_abund_medium = 2000 +##' , required.max_abund_high = 3000 +##' , doDispersal = TRUE +##' , DISPERSAL.mode = 1 +##' , DISPERSAL.saving = FALSE +##' , doHabSuitability = TRUE +##' , HABSUIT.mode = 1) +##' +##' PRE_FATE.params_simulParameters(name.simulation = "FATE_Champsaur" +##' , name.MASK = "MASK_Champsaur.tif") +##' +##' simul.param = "Simul_parameters_V1.txt" +##' # simul.param = paste0("FATE_Champsaur/PARAM_SIMUL/", simul.param) +##' +##' POST_FATE.validation(name.simulation = "FATE_Champsaur" +##' , file.simulParam = simul.param +##' , year = 2000 +##' , mat.obs = mat.obs +##' , mat.hab = mat.hab +##' , ras.habitat = ras.habitat +##' , doHabitat = TRUE +##' , doHabitat.allMap = TRUE +##' , doComposition = TRUE +##' , doRichness = TRUE) +##' +##' +##' @export +##' +##' +##' @importFrom stats aggregate +##' @importFrom utils write.csv +##' @importFrom foreach foreach %do% +##' @importFrom reshape2 melt +##' @importFrom data.table fread +##' @importFrom dplyr group_by +##' @importFrom randomForest tuneRF +##' @importFrom caret confusionMatrix +##' @importFrom raster ratify levels writeRaster +##' +### END OF HEADER ################################################################### + + +POST_FATE.validation = function(name.simulation + , file.simulParam + , year + , mat.obs + , mat.hab + , ras.habitat + , doRichness = TRUE + , doComposition = TRUE + , doHabitat = TRUE + , RF.seed = 123 + , RF.training = 0.7 + , doHabitat.allMap = FALSE + , opt.ras_validation = NULL + , opt.keep_PFG = NULL + , opt.keep_strata = NULL) +{ + ############################################################################# + + ## CHECK parameter name.simulation + .testParam_existFolder(name.simulation, "PARAM_SIMUL/") + .testParam_existFolder(name.simulation, "RESULTS/") + .testParam_existFolder(name.simulation, "DATA/") + .testParam_existFolder(name.simulation, "VALIDATION/") + name.simulation = sub("/", "", name.simulation) + ## CHECK parameter file.simulParam + abs.simulParams = .getParam_abs.simulParams(file.simulParam, name.simulation) + ## CHECK parameter year + .testParam_notInteger.m("year", year) + ## CHECK parameter mat.obs + if (.testParam_notDf(mat.obs)) + { + .stopMessage_beDataframe("mat.obs") + } else + { + if (nrow(mat.obs) == 0 || !(ncol(mat.obs) %in% c(5, 6, 7))) + { + .stopMessage_numRowCol("mat.obs", c("site", "x", "y", "PFG", "abund", "(strata)", "(code.habitat)")) + } else + { + notCorrect = switch(as.character(ncol(mat.obs)) + , "5" = .testParam_notColnames(mat.obs, c("site", "x", "y", "PFG", "abund")) + , "6" = (.testParam_notColnames(mat.obs, c("site", "x", "y", "PFG", "abund", "strata")) && + .testParam_notColnames(mat.obs, c("site", "x", "y", "PFG", "abund", "code.habitat"))) + , "7" = .testParam_notColnames(mat.obs, c("site", "x", "y", "PFG", "abund", "strata", "code.habitat")) + , TRUE) + if (notCorrect){ + .stopMessage_columnNames("mat.obs", c("site", "x", "y", "PFG", "abund", "(strata)", "(code.habitat)")) + } + mat.obs$site = as.character(mat.obs$site) + .testParam_notChar.m("mat.obs$site", mat.obs$site) + .testParam_notNum.m("mat.obs$abund", mat.obs$abund) + .testParam_NAvalues.m("mat.obs$abund", mat.obs$abund) + .testParam_notBetween.m("mat.obs$abund", mat.obs$abund, 0, 1) + if (sum(colnames(mat.obs) == "strata") == 1) + { + if(.testParam_notNum(mat.obs$strata) && .testParam_notChar(mat.obs$strata)) + { + stop("Wrong type of data!\n 'mat.obs$strata' must contain numeric or character values") + } + } else { + mat.obs$strata = "all" + } + if (sum(colnames(mat.obs) == "code.habitat") == 1) + { + .testParam_notNum.m("mat.obs$code.habitat", mat.obs$code.habitat) + } + } + } + ## CHECK parameter mat.hab + if (doHabitat || doComposition) + { + if (.testParam_notDf(mat.hab)) + { + .stopMessage_beDataframe("mat.hab") + } else + { + if (nrow(mat.hab) == 0 || ncol(mat.hab) != 2) + { + .stopMessage_numRowCol("mat.hab", c("code.habitat", "habitat")) + } + mat.hab$habitat = as.character(mat.hab$habitat) + .testParam_notNum.m("mat.hab$code.habitat", mat.hab$code.habitat) + .testParam_notChar.m("mat.hab$habitat", mat.hab$habitat) + } + } + ## CHECK parameter ras.habitat + .testParam_notChar.m("ras.habitat", ras.habitat) + .testParam_existFile(ras.habitat) + ras.habitat = raster(ras.habitat) + ## CHECK parameter opt.keep_PFG + GLOB_SIM = .getGraphics_PFG(name.simulation = name.simulation + , abs.simulParam = abs.simulParams[1]) + + list.PFG = GLOB_SIM$PFG + if (!is.null(opt.keep_PFG)) { + .testParam_notChar.m("opt.keep_PFG", opt.keep_PFG) + .testParam_notInValues.m("opt.keep_PFG", opt.keep_PFG, list.PFG) + list.PFG = opt.keep_PFG + } + ## CHECK parameter opt.keep_strata + list.strata = as.character(unique(mat.obs$strata)) + if (!is.null(opt.keep_strata)) { + .testParam_notInValues.m("names(opt.keep_strata)", names(opt.keep_strata), as.character(unique(mat.obs$strata))) + list.strata.obs = names(opt.keep_strata) + list.strata.sim = unique(unlist(opt.keep_strata)) + } + + + cat("\n\n #------------------------------------------------------------#") + cat("\n # POST_FATE.validation") + cat("\n #------------------------------------------------------------# \n") + + ############################################################################# + ### Preliminary checks + ############################################################################# + + infos.simul = foreach (abs.simulParam = abs.simulParams) %do% + { + GLOB_DIR = .getGraphics_results(name.simulation = name.simulation + , abs.simulParam = abs.simulParam) + file.abund = paste0(name.simulation + , "/RESULTS/POST_FATE_TABLE_PIXEL_evolution_abundance_" + , ifelse(length(list.strata) == 1 && list.strata == "all", "", "perStrata_") + , basename(GLOB_DIR$dir.save) + , ".csv") + if (!file.exists(file.abund)) { + warning(paste0("File `perStrata` (", file.abund, ") does not exist. Validation per stratum has been desactivated.")) + file.abund = paste0(name.simulation + , "/RESULTS/POST_FATE_TABLE_PIXEL_evolution_abundance_" + , basename(GLOB_DIR$dir.save) + , ".csv") + mat.obs$strata = "all" + list.strata = "all" + } + .testParam_existFile(file.abund) + return(list(dir.save = basename(GLOB_DIR$dir.save) + , file.abund = file.abund)) + } + names(infos.simul) = abs.simulParams + + ## Get raster mask ---------------------------------------------------------- + GLOB_MASK = .getGraphics_mask(name.simulation = name.simulation + , abs.simulParam = abs.simulParams[1]) + ras_simulation = GLOB_MASK$ras.mask + + .testParam_notSameRaster.m("ras.habitat", ras.habitat, "ras_simulation", ras_simulation) + if (.testParam_notInValues("code.habitat", colnames(mat.obs))) { + mat.obs$code.habitat = extract(x = ras.habitat, y = mat.obs[, c("x", "y")]) + mat.obs = mat.obs[which(!is.na(mat.obs$code.habitat)), ] + if (nrow(mat.obs) == 0) { + stop("Wrong type of data!\n Extracted values from `ras.habitat` are NA. Please check.") + } + } + + if (!is.null(opt.ras_validation)) { + .testParam_notSameRaster.m("opt.ras_validation", opt.ras_validation, "ras_simulation", ras_simulation) + } + + # ## Keep only releves in specific area + # if (!is.null(external.training.mask)) { + # inMask = extract(x = external.training.mask, y = mat.obs[, c("x", "y")]) + # mat.obs = mat.obs[which(!is.na(inMask)), ] + # # cat("\n 'releve' map has been cropped to match 'external.training.mask'. \n") TODO + # if (nrow(mat.obs) == 0) { + # # stop("Code habitat vector is empty. Please verify values of your ras.habitat map") + # # stop("Make sure to provide habitat values") TODO + # } + # } + + # 3. Keep only releve on interesting habitat, strata and PFG + mat.obs = mat.obs[which(mat.obs$code.habitat %in% mat.hab$code.habitat & + mat.obs$strata %in% list.strata & + mat.obs$PFG %in% list.PFG), ] + if (nrow(mat.obs) == 0) { + stop("Wrong type of data!\n Values in `mat.obs` do not match required levels (code.habitat, strata, PFG). Please check.") + } + + + ############################################################################# + ### A. EXTRACT INFORMATION FROM OBSERVED DATA + ############################################################################# + + cat("\n ---------- OBSERVED DATA \n") + + if (doHabitat | doComposition) { + + cat("\n> Get information table on site / habitat (mat.obs)...") + sites.obs = unique(mat.obs[, which(colnames(mat.obs) %in% c("site", "x", "y", "code.habitat"))]) + sites.obs = merge(sites.obs, mat.hab, by = "code.habitat") + sites.obs = sites.obs[, c("site", "x", "y", "code.habitat", "habitat")] + + perc = sapply(unique(sites.obs$habitat), function(x) { + ind = which(sites.obs$habitat == x) + return(100 * length(ind) / nrow(sites.obs)) + }) + names(perc) = unique(sites.obs$habitat) + + if (length(which(perc <= 1)) > 0) { + toRemove.name = names(perc)[which(perc <= 1)] + toRemove.code = mat.hab$code.habitat[which(mat.hab$habitat %in% toRemove.name)] + mat.obs = mat.obs[-which(mat.obs$code.habitat %in% toRemove.code), ] + mat.hab = mat.hab[-which(mat.hab$code.habitat %in% toRemove.code),] + cat("\n (", paste0(toRemove.name, collapse = " / ") + , ") represent 1% or less of the habitats in the whole area, they will be deleted for the next steps. \n") + } + + cat("\n> Get information table on site / habitat (simul)...") + sites.sim = as.data.frame(rasterToPoints(ras.habitat)) + colnames(sites.sim) = c("x", "y", "code.habitat") + sites.sim$pixel = cellFromXY(ras_simulation, sites.sim[, c("x", "y")]) + if (!is.null(opt.ras_validation)) { + toKeep = opt.ras_validation[cellFromXY(opt.ras_validation, sites.sim[, c("x", "y")])] + } else { + toKeep = ras_simulation[cellFromXY(ras_simulation, sites.sim[, c("x", "y")])] + } + sites.sim = sites.sim[which(toKeep == 1), ] + if (nrow(sites.sim) == 0) { + stop("Wrong type of data!\n Extracted values from `ras_simulation` (or `ras_validation`) are NA. Please check.") + } + sites.sim <- merge(sites.sim, mat.hab, by = "code.habitat") + sites.sim = sites.sim[, c("pixel", "x", "y", "code.habitat", "habitat")] + + ############################################################################# + ## Reorganize mat.obs by aggregating PFG abundances + + OBS = .valid_organizeData(mat = mat.obs + , fac.agg = c("site", "code.habitat", "strata", "PFG") + , fac.rel = c("site", "strata") + , fac.cast = "site" + , mat.sites = sites.obs) + + ############################################################################# + ## Obtain quantiles of PFG abundances + + if (doComposition) { + cat("\n> Get observed distribution...") + distrib.obs = .valid_getDistrib(mat.agg = OBS$mat.agg + , list.PFG = list.PFG + , list.habitat = mat.hab$code.habitat + , list.strata = list.strata) + colnames(distrib.obs)[which(colnames(distrib.obs) == "quantile.val")] = "quantile.obs" + } + + ############################################################################# + ## Train a Random Forest model on observed data + + if (doHabitat) { + cat("\n> Split observations into training / testing...") + set.seed(RF.seed) + + mat.cast = OBS$mat.cast + mat.cast$habitat = as.factor(mat.cast$habitat) + freq = table(mat.cast$code.habitat) / nrow(mat.cast) + no.hab = sample(names(freq), size = RF.training * nrow(mat.cast), prob = freq, replace = TRUE) + no.hab = table(no.hab) ## Is it possible that length(no.hab) != length(freq) ? + + training.site = foreach(hab = 1:length(no.hab), .combine = "c") %do% + { + sample(mat.cast$site[which(mat.cast$code.habitat == names(no.hab)[hab])] + , size = no.hab[hab], replace = FALSE) + } + tab.train = mat.cast[which(mat.cast$site %in% training.site), ] + tab.test = mat.cast[-which(mat.cast$site %in% training.site), ] + + cat("\n Training part of the data :") + print(table(tab.train$habitat)) + cat("\n Testing part of the data :") + print(table(tab.test$habitat)) + + cat("\n> Calibrate Random Forest model...") + ## Train the RF model (with correction for unbalanced sampling) + mtry.perf = tuneRF(x = tab.train[, -which(colnames(tab.train) %in% c("site", "x", "y", "code.habitat", "habitat"))], + y = tab.train$habitat, + strata = tab.train$habitat, + sampsize = nrow(tab.train), + ntreeTry = 500, + stepFactor = 2, + improve = 0.05, + doBest = FALSE, + plot = FALSE, + trace = FALSE) + + ## Select model (lowest n achieving minimum OOB) + mtry.perf = as.data.frame(mtry.perf) + mtry = mtry.perf$mtry[which.min(mtry.perf$OOBError)] + + ## Run selected model on testing data + RF.model = randomForest(x = tab.train[, -which(colnames(tab.train) %in% c("site", "x", "y", "code.habitat", "habitat"))], + y = tab.train$habitat, + xtest = tab.test[, -which(colnames(tab.train) %in% c("site", "x", "y", "code.habitat", "habitat"))], + ytest = tab.test$habitat, + strata = tab.train$habitat, + sampsize = nrow(tab.train), + ntree = 500, + mtry = mtry, + norm.votes = TRUE, + keep.forest = TRUE) + + ## Analyse model performance + RF.perf.train = .valid_getModelPerf(dataset = "train" + , mod.pred = RF.model$predicted + , mod.ref = tab.train$habitat) + + RF.perf.test = .valid_getModelPerf(dataset = "test" + , mod.pred = RF.model$test$predicted + , mod.ref = tab.test$habitat) + cat("\n") + } + } + + + ############################################################################# + ### B. EXTRACT INFORMATION FROM SIMULATED DATA + ############################################################################# + + cat("\n ---------- SIMULATED DATA") + + res = foreach (abs.simulParam = abs.simulParams) %do% + { + + cat("\n+++++++\n") + cat("\n Simulation name : ", name.simulation) + cat("\n Simulation file : ", abs.simulParam) + cat("\n") + + simul = infos.simul[[abs.simulParam]] + + ## Get the abundance table ------------------------------------------------ + .testParam_existFile(simul$file.abund) + mat.sim = fread(simul$file.abund, data.table = FALSE) + if (.testParam_notInValues("strata", colnames(mat.sim))) { + mat.sim$strata = "all" + } + mat.sim = mat.sim[, c("ID.pixel", "X", "Y", "strata", "PFG", year)] + colnames(mat.sim) = c("pixel", "x", "y", "strata", "PFG", "abund") + if (!is.null(opt.keep_strata)) { + new.strata <- rep("all", nrow(mat.sim)) + for (i in 1:length(opt.keep_strata)) { + ind = which(mat.sim$strata %in% opt.keep_strata[[i]]) + new.strata[ind] = names(opt.keep_strata)[i] + } + mat.sim$strata = new.strata + } + + mat.sim = mat.sim[which(mat.sim$strata %in% list.strata & + mat.sim$PFG %in% list.PFG), ] + + ## Get the abundance table ------------------------------------------------ + if (doRichness == TRUE) { + rich.sim = unique(mat.sim$PFG) + rich.sim = rich.sim[which(rich.sim %in% list.PFG)] + } + + ############################################################################# + ## Reorganize mat.sim by aggregating PFG abundances + + SIM = .valid_organizeData(mat = mat.sim + , fac.agg = c("pixel", "strata", "PFG") + , fac.rel = c("pixel", "strata") + , fac.cast = "pixel" + , mat.sites = sites.sim) + + ############################################################################# + + if (doComposition) { + + ## Obtain quantiles of PFG abundances --------------------------------- + cat("\n> Get simulated distribution...") + distrib.sim = .valid_getDistrib(mat.agg = SIM$mat.agg + , list.PFG = list.PFG + , list.habitat = mat.hab$code.habitat + , list.strata = list.strata) + colnames(distrib.sim)[which(colnames(distrib.sim) == "quantile.val")] = "quantile.sim" + + ## Merge observed and simulated distributions + distrib.ALL <- merge(distrib.obs, distrib.sim, by = c("PFG", "code.habitat", "strata", "quantile.perc"), all = TRUE) + + write.csv(distrib.ALL + , file = paste0(name.simulation + , "/RESULTS/POST_FATE_TABLE_HAB_validation_compo_distribution_" + , simul$dir.save + , ".csv") + , row.names = FALSE) + + message(paste0("\n The output file POST_FATE_TABLE_HAB_validation_compo_distribution_" + , simul$dir.save + , ".csv has been successfully created !\n")) + + ## Compute proximity -------------------------------------------------- + cat("\n> Compute proximity...") + + ## Distance, computed as the sum of absolute gap between obs and sim quantile + ## (on a 0 to 1 scale, 1 meaning quantile equality) + compute.proximity <- function(qt.obs, qt.sim) { + return(1 - sum(abs(qt.sim - qt.obs)) / 4) + } + + proximity = split(distrib.ALL, list(distrib.ALL$PFG, distrib.ALL$code.habitat, distrib.ALL$strata), drop = TRUE) + proximity = foreach(tmp = proximity, .combine = "rbind") %do% + { + qt = compute.proximity(qt.obs = tmp$quantile.obs, qt.sim = tmp$quantile.sim) + return(data.frame(PFG = unique(tmp$PFG) + , code.habitat = unique(tmp$code.habitat) + , strata = unique(tmp$strata) + , proximity = qt)) + } + + write.csv(proximity + , file = paste0(name.simulation + , "/RESULTS/POST_FATE_TABLE_HAB_validation_compo_proximity_" + , simul$dir.save + , ".csv") + , row.names = FALSE) + + message(paste0("\n The output file POST_FATE_TABLE_HAB_validation_compo_proximity_" + , simul$dir.save + , ".csv has been successfully created !\n")) + + # # 10. Aggregate results for the different PFG + # aggregated.proximity = split(proximity, list(proximity$code.habitat, proximity$strata), drop = TRUE) + # aggregated.proximity = foreach(tmp = aggregated.proximity, .combine = "rbind") %do% + # { + # return(data.frame(simul = simul$dir.save + # , code.habitat = unique(tmp$code.habitat) + # , strata = unique(tmp$strata) + # , aggregated.proximity = mean(tmp$proximity))) + # } + # performance.composition <- list(aggregated.proximity = aggregated.proximity) + } + + ############################################################################# + ## Run selected Random Forest model on simulated data + + if (doHabitat) { + cat("\n> Run and evaluate Random Forest model on simulated data...") + + mat.cast.sim = SIM$mat.cast + mat.cast.sim$habitat <- factor(mat.cast.sim$habitat, levels = RF.model$classes) + RF.predictors <- rownames(RF.model$importance) + if (length(setdiff(RF.predictors, colnames(mat.cast.sim))) > 0) { + stop(paste0("Missing data!\n Some PFG used within the random forest model are not found within the simulated dataset (" + , paste0(setdiff(RF.predictors, colnames(mat.cast.sim)), collapse = " / "), ")")) + } + + ## Use selected RF to predict habitat onto simulated data + RF.pred <- predict(object = RF.model, newdata = mat.cast.sim[, RF.predictors], type = "response", norm.votes = TRUE) + + ## Analyse model performance + RF.perf.valid = .valid_getModelPerf(dataset = "valid" + , mod.pred = RF.pred + , mod.ref = factor(mat.cast.sim$habitat, RF.model$classes)) + + ## Merge all model performances + RF.perf = do.call(rbind, list(RF.perf.train, RF.perf.test, RF.perf.valid)) + rownames(RF.perf) = NULL + + write.csv(RF.perf + , file = paste0(name.simulation + , "/RESULTS/POST_FATE_TABLE_HAB_validation_RF_performance_" + , simul$dir.save + , ".csv") + , row.names = FALSE) + + message(paste0("\n The output file POST_FATE_TABLE_HAB_validation_RF_performance_" + , simul$dir.save + , ".csv has been successfully created !\n")) + + + ## Predict / plot habitat for whole simulation map -------------------- + if (doHabitat.allMap) { + cat("\n> Predict habitat on simulated data...") + + ## Create a correspondance table between predicted habitat / colors + col.df = data.frame(habitat.obs = RF.model$classes, + failure = hcl.colors(n = length(RF.model$classes), palette = "Roma", alpha = 0.5), + success = hcl.colors(n = length(RF.model$classes), palette = "Roma", alpha = 1)) + col.df = melt(col.df, id.vars = c("habitat.obs"), variable.name = "fail_succ", value.name = "color") + + col_label = paste0(col.df$habitat.obs, " - ", col.df$fail_succ) + names(col_label) = col.df$color + + ## Create the whole map prediction table + pred.allMap = data.frame(pixel = mat.cast.sim$pixel + , habitat.obs = as.character(mat.cast.sim$habitat) + , habitat.sim = as.character(RF.pred)) + pred.allMap$habitat.final = pred.allMap$habitat.sim + pred.allMap$habitat.final[which(pred.allMap$habitat.obs != pred.allMap$habitat.sim)] = "failure" + pred.allMap$fail_succ = ifelse(pred.allMap$habitat.final == "failure", "failure", "success") + pred.allMap = merge(pred.allMap, col.df, by.x = c("habitat.obs", "fail_succ")) + pred.allMap = merge(pred.allMap, sites.sim, by.x = c("pixel", "habitat.obs"), by.y = c("pixel", "habitat"), all.x = TRUE) + pred.allMap$code.habitat[which(pred.allMap$habitat.final == "failure")] = -1 + + write.csv(pred.allMap + , file = paste0(name.simulation + , "/RESULTS/POST_FATE_TABLE_PIXEL_validation_RF_prediction_" + , simul$dir.save + , ".csv") + , row.names = FALSE) + + message(paste0("\n The output file POST_FATE_TABLE_PIXEL_validation_RF_prediction_" + , simul$dir.save + , ".csv has been successfully created !\n")) + + ## Transform into a categorical raster map + ras.allMap = ras_simulation + ras.allMap[] = -1 + ras.allMap[pred.allMap$pixel] = pred.allMap$code.habitat + ras.allMap = ratify(ras.allMap) + map.rat = unique(pred.allMap[, c("code.habitat", "habitat.final")]) + colnames(map.rat) = c("ID", "habitat") + levels(ras.allMap) = map.rat[order(map.rat$ID), ] + + new_name = paste0(name.simulation, "/RESULTS/", simul$dir.save, "/HabitatPrediction_YEAR_", year, ".tif") + writeRaster(ras.allMap, filename = new_name, overwrite = TRUE) + + message(paste0("\n The output files \n" + , paste0(" > ", basename(new_name), " \n" + , collapse = "") + , "have been successfully created !\n")) + + ## Create a ggplot + pp = ggplot(pred.allMap, aes(x = x, y = y, fill = factor(color, levels(factor(col.df$color))))) + + geom_raster() + + coord_equal() + + scale_fill_identity(guide = "legend", labels = col_label, drop = FALSE) + + guides(fill = guide_legend(nrow = 4, byrow = FALSE)) + + theme(plot.title = element_text(size = 8), + legend.text = element_text(size = 8, colour = "black"), + legend.title = element_blank(), + legend.position = "bottom", + axis.title = element_blank(), + axis.text = element_blank(), + axis.ticks = element_blank()) + + pdf(file = paste0(name.simulation + , "/RESULTS/POST_FATE_GRAPHIC_D_map_habitat_" + , simul$dir.save, "_YEAR_", year, ".pdf") + , width = 10, height = 8) + plot(pp) + dev.off() + } + } + + ############################################################################# + + cat("\n> Done!\n") + + results = list() + if (doRichness) { + results$rich.obs = sort(list.PFG) + results$rich.sim = sort(rich.sim) + results$rich.diff = setdiff(list.PFG, rich.sim) + } + if (doComposition) { + results$compo.distrib = distrib.ALL + results$compo.proximity = proximity + } + if (doHabitat) { + results$hab.RF.model = RF.model + results$hab.RF.perf = RF.perf + if (doHabitat.allMap) { + results$hab.tab.pred = pred.allMap + results$hab.ras.pred = ras.allMap + results$hab.plot = pp + } + } + + return(results) + } ## END loop on abs.simulParams + names(res) = abs.simulParams + + return(res) +} + + +################################################################################################### + +.valid_organizeData = function(mat, fac.agg, fac.rel, fac.cast, mat.sites) +{ + mat <- mat[, c(fac.agg, "abund")] + + ## Compute sum of abundance per fac.agg ------------------------------------- + txt.command = paste0(fac.agg, collapse = " + ") + eval(parse(text = paste0('mat.agg = aggregate(abund ~ ', txt.command, ', data = mat, FUN = "sum")'))) + + ## Compute relative abundance per fac.rel + eval(parse(text = paste0('tmp = mat.agg %>% group_by(', paste0(fac.rel, collapse = ", "), ')'))) + mat.agg = as.data.frame( + tmp %>% mutate(relative.metric = round(prop.table(abund), digits = 2)) + ) + + ## Remove NA and abund column + if (length(which(is.na(mat.agg$relative.metric)))) { + mat.agg$relative.metric[which(is.na(mat.agg$relative.metric))] = 0 + } + mat.agg$abund = NULL + mat.agg = merge(mat.sites, mat.agg, by = intersect(colnames(mat.sites), colnames(mat.agg))) + # cat("\n> Releves data have been transformed into a relative metric") + + ## -------------------------------------------------------------------------- + mat.cast = mat.agg + mat.cast$PFG = as.factor(mat.cast$PFG) + mat.cast$strata = as.factor(mat.cast$strata) + eval(parse(text = paste0('mat.cast = reshape2::dcast(mat.cast, ', fac.cast + , ' ~ PFG * strata, value.var = "relative.metric", fill = 0, drop = FALSE)'))) + mat.cast = merge(mat.sites, mat.cast, by = fac.cast) + + ## -------------------------------------------------------------------------- + return(list(mat.agg = mat.agg, mat.cast = mat.cast)) +} + + +.valid_getDistrib = function(mat.agg, list.PFG, list.habitat, list.strata) #, fac.agg) +{ + fac.agg = c("PFG", "code.habitat", "strata") + txt.command = paste0('mat.agg$', fac.agg, collapse = ", ") + eval(parse(text = paste0('distrib = split(mat.agg, list(', txt.command, '), drop = TRUE)'))) + # distrib = split(mat.agg, list(mat.agg$PFG, mat.agg$code.habitat, mat.agg$strata), drop = TRUE) + distrib = foreach(tmp = distrib, .combine = "rbind") %do% + { + qt = quantile(tmp$relative.metric, probs = seq(0.25, 1, 0.25)) + return(data.frame(PFG = unique(tmp$PFG) + , code.habitat = unique(tmp$code.habitat) + , strata = unique(tmp$strata) + , quantile.perc = seq(0.25, 1, 0.25) + , quantile.val = as.vector(qt))) + } + + all.distrib <- expand.grid(PFG = list.PFG + , code.habitat = list.habitat + , strata = list.strata + , quantile.perc = seq(0.25, 1, 0.25) + , stringsAsFactors = FALSE) + all.distrib <- merge(all.distrib[, c(fac.agg, "quantile.perc")], distrib, by = c(fac.agg, "quantile.perc"), all.x = TRUE) + all.distrib$quantile.val[is.na(all.distrib$quantile.val)] <- 0 + + return(all.distrib) +} + + +.valid_getModelPerf = function(dataset, mod.pred, mod.ref) +{ + mat.conf = confusionMatrix(data = mod.pred, reference = mod.ref) + mat.synth = data.frame(dataset = dataset + , habitat = colnames(mat.conf$table) + , sensitivity = mat.conf$byClass[, "Sensitivity"] + , specificity = mat.conf$byClass[, "Specificity"] + , weight = colSums(mat.conf$table) / sum(colSums(mat.conf$table))) + #warning: prevalence is the weight of predicted habitat, not of observed habitat + mat.synth$TSS = round(mat.synth$sensitivity + mat.synth$specificity - 1, digits = 2) + mat.synth$TSSw = round(sum(mat.synth$weight * mat.synth$TSS), digits = 2) + return(mat.synth) +} diff --git a/R/PRE_FATE.skeletonDirectory.R b/R/PRE_FATE.skeletonDirectory.R index 6201040..9439f2e 100644 --- a/R/PRE_FATE.skeletonDirectory.R +++ b/R/PRE_FATE.skeletonDirectory.R @@ -70,6 +70,14 @@ ##' \code{\link{PRE_FATE.params_simulParameters}})} ##' \item{\code{RESULTS}}{this folder will collect all the results produced by the ##' software with a folder for each simulation} +##' \item{\code{VALIDATION}}{this folder will collect all the validation files produced +##' by the \code{\link{POST_FATE.validation}} function +##' \describe{ +##' \item{\code{HABITAT}}{files containing outputs from habitat validation} +##' \item{\code{PFG_RICHNESS}}{files containing outputs from PFG richness validation} +##' \item{\code{PFG_COMPOSITION}}{files containing outputs from PFG composition validation} +##' } +##' } ##' } ##' ##' \strong{NB :} \cr @@ -136,6 +144,11 @@ PRE_FATE.skeletonDirectory = function(name.simulation = "FATE_simulation") dir.create(file.path(name.simulation, "PARAM_SIMUL"), showWarnings = FALSE) ## the RESULTS dir dir.create(file.path(name.simulation, "RESULTS"), showWarnings = FALSE) + ## the VALIDATION dir + dir.create(file.path(name.simulation, "VALIDATION"), showWarnings = FALSE) + dir.create(file.path(name.simulation, "VALIDATION", "HABITAT"), showWarnings = FALSE) + dir.create(file.path(name.simulation, "VALIDATION", "PFG_RICHNESS"), showWarnings = FALSE) + dir.create(file.path(name.simulation, "VALIDATION", "PFG_COMPOSITION"), showWarnings = FALSE) message("\n Your directory tree for your FATE simulation (" , name.simulation, ") is ready!\n") diff --git a/R/UTILS.messages.R b/R/UTILS.messages.R index 8c10967..a06ab98 100644 --- a/R/UTILS.messages.R +++ b/R/UTILS.messages.R @@ -102,3 +102,11 @@ stop(paste0("Wrong type of data!\n `", param1, "` must be either `", end_message, "`")) } +################################################################################################# + +.stopMessage_raster = function(param1, param2) +{ + stop(paste0("Wrong dimension(s) of data!\n `", param1 + , "` must have the same projection, resolution, origin and extent as `", param2, "`")) +} + diff --git a/R/UTILS.plot_predicted_habitat.R b/R/UTILS.plot_predicted_habitat.R new file mode 100644 index 0000000..e42eb4b --- /dev/null +++ b/R/UTILS.plot_predicted_habitat.R @@ -0,0 +1,113 @@ +############################################################################# +##' @importFrom dplyr all_of rename select +##' @importFrom utils write.csv +##' @importFrom raster raster crs extent res ratify writeRaster levels +##' @importFrom stats complete.cases +##' @importFrom ggplot2 ggplot geom_raster coord_equal scale_fill_manual +##' ggtitle guides theme ggsave guide_legend +##' @importFrom reshape2 melt +##' @importFrom prettyR Mode +############################################################################# + +plot_predicted_habitat = function(predicted.habitat + , col.df + , simulation.map + , output.path + , sim.version) +{ + + #auxiliary function to compute the proportion of simulations lead to the modal prediction + count.habitat = function(df){ + index = which(names(df) == "modal.predicted.habitat") + prop.simu = sum(df[-index] == as.character(df[index]))/(length(names(df))-1) + return(prop.simu) + } + + #compute modal predicted habitat and the proportion of simulations predicting this habitat (for each pixel) + predicted.habitat$modal.predicted.habitat = apply(dplyr::select(predicted.habitat, c(all_of(sim.version))), 1, Mode) + predicted.habitat$modal.predicted.habitat[predicted.habitat$modal.predicted.habitat == ">1 mode"] = "ambiguous" + predicted.habitat$confidence <- apply(dplyr::select(predicted.habitat, c(all_of(sim.version), modal.predicted.habitat)), 1 , FUN = function(x) count.habitat(x)) + + + #true/false prediction + predicted.habitat$prediction.code = "failure" + predicted.habitat$prediction.code[predicted.habitat$modal.predicted.habitat == predicted.habitat$true.habitat] = "success" + + #prepare a df containing color & habitat code (to facilitate conversion into raster) + col.df.long = data.table::melt(data = setDT(col.df), id.vars = "habitat", variable.name = "prediction.code", value.name = "color") + + habitat.code.df = unique(dplyr::select(predicted.habitat, c(modal.predicted.habitat, prediction.code))) + habitat.code.df$habitat.code = seq(from = 1, to = dim(habitat.code.df)[1], by = 1) + habitat.code.df = rename(habitat.code.df, "habitat" = "modal.predicted.habitat") + + habitat.code.df = merge(habitat.code.df, col.df.long, by = c("habitat", "prediction.code")) + habitat.code.df$label = paste0(habitat.code.df$habitat, " (", habitat.code.df$prediction.code, ")") + + #deal with out of scope habitat + out.of.scope = data.frame(habitat = "out.of.scope", prediction.code = "", habitat.code = 0, color = "white", label = "out of scope") + habitat.code.df = rbind(habitat.code.df, out.of.scope) + + habitat.code.df$label = as.factor(habitat.code.df$label) + + #order the df + habitat.code.df = habitat.code.df[order(habitat.code.df$label),] #to be sure it's in te right order (useful to ensure the correspondance between label and color in the ggplot function) + + + #merge the prediction df with the df containing color and habitat code + predicted.habitat = merge(predicted.habitat, habitat.code.df, by.x = c("modal.predicted.habitat", "prediction.code"), by.y = c("habitat", "prediction.code")) + write.csv(x = predicted.habitat, file = paste0(output.path, "/HABITAT/hab.pred.csv")) + + + #plot + + #prepare raster + prediction.map = raster(nrows = nrow(simulation.map), ncols = ncol(simulation.map), crs = crs(simulation.map), ext = extent(simulation.map), resolution = res(simulation.map)) + + prediction.map[] = 0 #initialization of the raster, corresponding to "out of scope habitats" + prediction.map[predicted.habitat$pixel] = predicted.habitat$habitat.code + + #ratify + prediction.map = ratify(prediction.map) + prediction.map.rat = levels(prediction.map)[[1]] + prediction.map.rat = merge(prediction.map.rat, habitat.code.df, by.x = "ID", by.y = "habitat.code") + levels(prediction.map) = prediction.map.rat + + #save the raster + writeRaster(prediction.map, filename = paste0(output.path, "/HABITAT/synthetic.prediction.grd"), overwrite = T) + + + #plot on R + #convert into xy + xy.prediction = as.data.frame(prediction.map, xy = T) + names(xy.prediction) = c("x", "y", "habitat", "prediction.code", "color", "label") + xy.prediction = xy.prediction[complete.cases(xy.prediction),] + + #plot + prediction.plot = + ggplot(xy.prediction, aes(x = x, y = y, fill = factor(label))) + + geom_raster(show.legend = T) + + coord_equal() + + scale_fill_manual(values = as.character(habitat.code.df$color)) + #ok only if habitat.code.df has been ordered according to "label" + ggtitle(paste0("Modal prediction over ", length(sim.version), " simulations")) + + guides(fill = guide_legend(nrow = 4, byrow = F)) + + theme( + plot.title = element_text(size = 8), + legend.text = element_text(size = 8, colour = "black"), + legend.title = element_blank(), + legend.position = "bottom", + axis.title.x = element_blank(), + axis.text.x = element_blank(), + axis.ticks.x = element_blank(), + axis.title.y = element_blank(), + axis.text.y = element_blank(), + axis.ticks.y = element_blank() + ) + + #save the map + ggsave(filename = "synthetic.prediction.png", plot = prediction.plot, path = paste0(output.path, "/HABITAT"), scale = 1, dpi = 300, limitsize = F, width = 15, height = 15, units ="cm") + + #return the map + return(prediction.plot) + +} + diff --git a/R/UTILS.testParam.R b/R/UTILS.testParam.R index 95d80f9..eaac27a 100644 --- a/R/UTILS.testParam.R +++ b/R/UTILS.testParam.R @@ -220,6 +220,29 @@ } } +############################################################################### +.testParam_notSameRaster = function(param1, param2) +{ + if (!compareCRS(param1, param2) || + !all(res(param1) == res(param2)) || + extent(param1) != extent(param2) || + !all(origin(param1) == origin(param2))) + { + return(TRUE) + } else + { + return(FALSE) + } +} +.testParam_notSameRaster.m = function(param1.n, param1, param2.n, param2) +{ + if (.testParam_notSameRaster(param1, param2)) + { + .stopMessage_raster(param1.n, param2.n) + } +} + + ############################################################################### .getParam_opt.folder.name = function(param, folder.path, create.dir = TRUE) { diff --git a/R/UTILS.train_RF_habitat.R b/R/UTILS.train_RF_habitat.R new file mode 100644 index 0000000..38c17d7 --- /dev/null +++ b/R/UTILS.train_RF_habitat.R @@ -0,0 +1,87 @@ +################################################################ +##' @importFrom dplyr %>% group_by +##' @importFrom stats aggregate +##' @importFrom reshape2 dcast +##' @importFrom randomForest randomForest tuneRF +##' @importFrom caret confusionMatrix +##' @importFrom readr write_rds +##' @importFrom utils read.csv write.csv +################################################################# + + +train_RF_habitat = function(mat.cast + , hab.obs.RF = NULL + , external.training.mask = NULL + , mat.hab + , RF.param + , output.path + # , perStrata = FALSE + , seed) +{ + #separate the database into a training and a test part + cat("\n > Separate the database into a training and a test part \n") + set.seed(seed) + + mat.cast$habitat = as.factor(mat.cast$habitat) + freq = table(mat.cast$code.habitat) / nrow(mat.cast) + no.hab = sample(names(freq), size = 0.4 * nrow(mat.cast), prob = freq, replace = TRUE) + no.hab = table(no.hab) + if (length(no.hab) != length(freq)) { + stop("PROBLEM") ## TODO + } + training.site = foreach(hab = 1:length(no.hab), .combine = "c") %do% + { + sample(mat.cast$site[which(mat.cast$code.habitat == names(no.hab)[hab])] + , size = no.hab[hab], replace = FALSE) + } + # training.site = sample(mat.cast$site, size = RF.param$share.training * length(mat.cast$site), replace = FALSE) + + + tab.train = mat.cast[which(mat.cast$site %in% training.site), ] + tab.test = mat.cast[-which(mat.cast$site %in% training.site), ] + + cat("\n Training part of the data :") + print(table(tab.train$habitat)) + cat("\n Testing part of the data :") + print(table(tab.test$habitat)) + + #train the model (with correction for imbalances in sampling) + #run optimization algo (careful : optimization over OOB...) + mtry.perf = tuneRF(x = tab.train[, -which(colnames(tab.train) %in% c("site", "x", "y", "code.habitat", "habitat"))], + y = tab.train$habitat, + strata = tab.train$habitat, + sampsize = nrow(tab.train), + ntreeTry = RF.param$ntree, + stepFactor = 2, + improve = 0.05, + doBest = FALSE, + plot = FALSE, + trace = FALSE) + #select mtry + mtry.perf = as.data.frame(mtry.perf) + mtry = mtry.perf$mtry[which.min(mtry.perf$OOBError)] #the lowest n achieving minimum OOB + + #run real model + model = randomForest(x = tab.train[, -which(colnames(tab.train) %in% c("site", "x", "y", "code.habitat", "habitat"))], + y = tab.train$habitat, + xtest = tab.test[, -which(colnames(tab.train) %in% c("site", "x", "y", "code.habitat", "habitat"))], + ytest = tab.test$habitat, + strata = tab.train$habitat, + sampsize = nrow(tab.train), + ntree = RF.param$ntree, + mtry = mtry, + norm.votes = TRUE, + keep.forest = TRUE) + + #analyse model performance + aggregate.TSS.training = .valid_getModelPerf(dataset = "train" + , mod.pred = model$predicted + , mod.ref = tab.train$habitat) + + aggregate.TSS.testing = .valid_getModelPerf(dataset = "test" + , mod.pred = model$test$predicted + , mod.ref = tab.test$habitat) + + return(list(RF = model, habitat = mat.hab)) +} + diff --git a/_pkgdown.yml b/_pkgdown.yml index 0b32e09..725c024 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -129,6 +129,7 @@ reference: - "POST_FATE.binaryMaps" - "POST_FATE.graphic_mapPFGvsHS" - "POST_FATE.graphic_mapPFG" + - "POST_FATE.validation" - title: Save FATE simulation contents: - "SAVE_FATE.step1_PFG" diff --git a/docs/reference/FATE.html b/docs/reference/FATE.html deleted file mode 100644 index 829a5d8..0000000 --- a/docs/reference/FATE.html +++ /dev/null @@ -1,231 +0,0 @@ - -
This function runs a FATE dynamical landscape vegetation simulation.
FATE(simulParam, no_CPU = 1L, verboseLevel = 0L)a string corresponding to the name of a
-parameter file that will be contained into the PARAM_SIMUL folder
-of the FATE simulation
(optional) default 1.
The number of
-resources that can be used to parallelize the simulation
(optional) default 0.
The logger
-verbose level : a FATE simulation can render different levels of
-information (from 0 to 4, see
-Details).
None
-This function allows to run a vegetation simulation with the
-FATE model, based on a simulation folder and a species simulation
-parameter file.
A FATE simulation can be parallelized, using the no_CPU
-parameter, given that the user machine is multi-core !
Quantity of informations are rendered by the software into the R
-console, and the verboseLevel parameter allows to filter which
-level of information is printed :
shows any message
shows any message, except debug
shows only warning and error messages
shows only error messages
mute
if (FALSE) FATE()
-FATE simulationR/POST_FATE.binaryMaps.R
- POST_FATE.binaryMaps.RdThis script is designed to produce raster maps of PFG presence
-/ absence for one (or several) specific FATE simulation year.
POST_FATE.binaryMaps(
- name.simulation,
- file.simulParam = NULL,
- years,
- method,
- method1.threshold = 0.05,
- method2.cutoff = NULL,
- opt.no_CPU = 1
-)a string corresponding to the main directory
-or simulation name of the FATE simulation
default NULL.
A string
-corresponding to the name of a parameter file that will be contained into
-the PARAM_SIMUL folder of the FATE simulation
an integer, or a vector of integer,
-corresponding to the simulation year(s) that will be used to extract PFG
-abundance maps
an integer to choose the transformation method : 1 (relative abundance) or 2 (optimizing TSS) (see
-Details)
default 0.05.
If method = 1,
-minimum relative abundance required for each PFG to be considered as present
-in the concerned pixel
default NULL.
If method = 2, a
-data.frame with 3 columns : year, PFG, cutoff
-(see Details)
(optional) default 1.
The number of
-resources that can be used to parallelize the unzip/zip of raster
-files
Two folders are created :
BIN_perPFG
_allStratacontaining presence / absence - raster maps for each PFG across all strata
BIN_perPFG
_perStratacontaining presence / absence
- raster maps for each PFG for each stratum
(if pixel abundances per PFG
- per stratum were saved (see PRE_FATE.params_globalParameters))
This function allows to obtain, for a specific FATE simulation and
-a specific parameter file within this simulation, raster maps of PFG
-presence / absence.
For each PFG and each selected simulation year, raster maps are retrieved
-from the results folder ABUND_REL_perPFG_allStrata and lead to the
-production of as many maps as those found :
1 fixed thresholdrelative abundance maps are transformed
- into binary maps according to the threshold given by
- method1.threshold :
- $$abund\_rel_{\text{ PFG}_i} > \text{method1.threshold} \;\;
- \Leftrightarrow \;\; 1$$
2 optimizing TSSrelative abundance maps are transformed
- into binary maps according to the cutoff found
- with the POST_FATE.graphic_validationStatistics function :
- $$abund\_rel_{\text{ PFG}_i} > \text{method2.cutoff}_{\text{ PFG}_i} \;\;
- \Leftrightarrow \;\; 1$$
It requires that the POST_FATE.relativeAbund
-function has been run and that the folder ABUND_REL_perPFG_allStrata
-exists.
If method = 2, it requires that the
-POST_FATE.graphic_validationStatistics function has been run.
-
If pixel abundances per PFG per stratum were saved (see
-PRE_FATE.params_globalParameters), binary maps per stratum are
-obtained by multiplying raster maps from ABUND_perPFG_perStrata folder
-by corresponding raster maps from BIN_perPFG_allStrata folder.
These binary raster files can then be used by other
-functions :
to produce graphics of PFG modelled presence vs
- PFG Habitat Suitability maps
(see
- POST_FATE.graphic_mapPFGvsHS)
FATE simulationR/POST_FATE.graphic_evolutionCoverage.R
- POST_FATE.graphic_evolutionCoverage.RdThis script is designed to produce two graphical
-representations for a FATE simulation : 1) the evolution through
-time of the space occupation of each PFG ; 2) the evolution through time
-of the abundance of each PFG. These graphics represent both the evolution
-over the whole area.
POST_FATE.graphic_evolutionCoverage(
- name.simulation,
- file.simulParam = NULL,
- opt.fixedScale = TRUE,
- opt.doPlot = TRUE
-)a string corresponding to the main directory
-or simulation name of the FATE simulation
default NULL.
A string
-corresponding to the name of a parameter file that will be contained into
-the PARAM_SIMUL folder of the FATE simulation
(optional) default TRUE.
If
-FALSE, the ordinate scale will be adapted for each PFG for the
-graphical representation of the evolution of abundances through time
(optional) default TRUE.
If TRUE,
-plot(s) will be processed, otherwise only the calculation and reorganization
-of outputs will occur, be saved and returned
A list containing two data.frame objects with the
-following columns, and two ggplot2 objects :
PFGconcerned plant functional group (for abundance)
HABconcerned habitat
concerned simulation year
spaceOccupancynumber of occupied pixels divided by the - total number of pixels within the studied area
PFGconcerned plant functional group (for abundance)
HABconcerned habitat
concerned simulation year
totalAbundancetotal abundance over all the pixels - within the studied area
ggplot2 object, representing the
- evolution of each PFG space occupancy
ggplot2 object, representing the
- evolution of each PFG total abundance
Two POST_FATE_TABLE_ZONE_evolution_[...].csv files are created :
spaceOccupancyalways, containing tab.spaceOccupancy
totalAbundancealways, containing tab.totalAbundance
One POST_FATE_GRAPHIC_A_evolution_coverage_[...].pdf file is created
-containing two types of graphics :
to visualize for each PFG the evolution of its - occupation of the studied area through simulation time
to visualize for each PFG the evolution of its - abundance within the whole studied area through simulation time
This function allows to obtain, for a specific FATE simulation and
-a specific parameter file within this simulation, two preanalytical
-graphics :
the evolution of space occupancy of each plant functional
- group through simulation time,
with space occupancy
- representing the percentage of pixels within the mask of studied area
- where the PFG is present
the evolution of total abundance of each plant functional
- group through simulation time,
with total abundance being the
- sum over the whole studied area of the PFG abundances (FATE
- arbitrary unit)
If the information has been provided (see
-POST_FATE.temporalEvolution), the graphics will be also done
-per habitat.
It requires that the POST_FATE.temporalEvolution
-function has been run and that the file
-POST_FATE_TABLE_PIXEL_evolution_abundance.csv exists.
FATE simulationR/POST_FATE.graphic_evolutionPixels.R
- POST_FATE.graphic_evolutionPixels.RdThis script is designed to produce one graphical representation
-for a FATE simulation : the evolution through time of the
-abundance of each PFG for 5 (or more) randomly selected cells of the studied
-area.
POST_FATE.graphic_evolutionPixels(
- name.simulation,
- file.simulParam = NULL,
- opt.cells_ID = NULL,
- opt.doPlot = TRUE
-)a string corresponding to the main directory
-or simulation name of the FATE simulation
default NULL.
A string
-corresponding to the name of a parameter file that will be contained into
-the PARAM_SIMUL folder of the FATE simulation
(optional) default NULL.
The cells ID
-of the studied area for which PFG abundances will be extracted
(optional) default TRUE.
If TRUE,
-plot(s) will be processed, otherwise only the calculation and reorganization
-of outputs will occur, be saved and returned
A list containing one data.frame object with the
-following columns, and one ggplot2 object :
TYPEconcerned information (either 'light',
- 'abundance' or 'soil')
GROUPconcerned entity (either
- 'STRATUM_[...]', PFG name or 'soil')
ID.pixelnumber of the concerned pixel
HABhabitat of the concerned pixel
YEARconcerned simulation year
valueconcerned value extracted from .csv files
- produced by POST_FATE.temporalEvolution
ggplot2 object, representing the evolution of each PFG
- abundance, and light and soil resources if those modules were
- activated
One POST_FATE_TABLE_PIXEL_evolution_pixels_[...].csv file is created :
always, containing the data.frame detailed
- above
One POST_FATE_[...].pdf file is created :
GRAPHIC_A
pixelsto visualize for each PFG the evolution - of its abundance within each selected pixel through simulation time
This function allows to obtain, for a specific FATE simulation and
-a specific parameter file within this simulation, one preanalytical graphic :
the evolution of abundance of each Plant Functional Group
- through simulation time, within 5 (or more) randomly selected pixels of
- the studied area (FATE arbitrary unit)
if light was activated (see
- PRE_FATE.params_globalParameters),
evolution of
- light resources within the selected pixels is also represented
- (1: Low, 2: Medium, 3: High)
if soil was activated (see
- PRE_FATE.params_globalParameters),
evolution of
- soil resources within the selected pixels is also represented
- (user-defined scale)
It requires that the POST_FATE.temporalEvolution
-function has been run and that the file
-POST_FATE_TABLE_PIXEL_evolution_abundance.csv exists (as well as the
-POST_FATE_TABLE_PIXEL_evolution_light.csv and
-POST_FATE_TABLE_PIXEL_evolution_soil.csv files if those modules were
-activated).
FATE simulationR/POST_FATE.graphic_evolutionStability.R
- POST_FATE.graphic_evolutionStability.RdThis script is designed to produce one graphical representation
-for a FATE simulation : the evolution through time of the total
-abundance and evenness of each habitat.
POST_FATE.graphic_evolutionStability(
- name.simulation,
- file.simulParam = NULL,
- movingWindow_size = 3,
- movingWindow_step = 1,
- opt.doPlot = TRUE
-)a string corresponding to the main directory
-or simulation name of the FATE simulation
default NULL.
A string
-corresponding to the name of a parameter file that will be contained into
-the PARAM_SIMUL folder of the FATE simulation
default 3.
An integer
-corresponding to the size (in years) of the moving window that will
-be used to calculate metrics of habitat stability
default 1.
An integer
-corresponding to the step (in years) between the years of the moving
-window
(optional) default TRUE.
If TRUE,
-plot(s) will be processed, otherwise only the calculation and reorganization
-of outputs will occur, be saved and returned
A list containing two data.frame objects with the
-following columns, and one ggplot2 object :
HABconcerned habitat
yearconcerned simulation year
totalAbundancetotal abundance over all the pixels - within the concerned habitat
no.PFGnumber of PFG over all the pixels within the - concerned habitat
evennessevenness over all the pixels within the - concerned habitat
HABconcerned habitat
no.yearsnumber of simulation years used (moving - window size)
yearStepstep between each simulation year of the moving - window
yearStartfirst simulation year of the moving window
yearEndlast simulation year of the moving window
metricconcerned metric (either totalAbundance or
- evenness)
meanmean value of the concerned metric over the years - of the concerned moving window
sdvalue of standard deviation of the concerned metric - over the years of the concerned moving window
cvvalue of coefficient of variation of the concerned - metric over the years of the concerned moving window
ggplot2 object, representing the evolution of
- total abundance and evenness of each habitat
Two POST_FATE_TABLE_HAB_evolution_[...].csv files are created :
stability1always, containing tab.hab
stability2if successive years available, containing
- tab.stab
One POST_FATE_[...].pdf files is created :
GRAPHIC_A
stabilityto visualize for each habitat the - evolution of its total abundance and its evenness through simulation time
This function allows to obtain, for a specific FATE simulation and
-a specific parameter file within this simulation, one preanalytical graphic :
the evolution of total abundance (FATE
- arbitrary unit) and evenness (between 0 and
- 1) of each habitat through simulation time, with evenness
- representing the uniformity of the species composition of the habitat
- (similar to Shannon entropy) :
- $$
- \text{evenness} = - \frac{\Sigma(\text{proportion}_{\text{ PFG}_i} *
- log(\text{proportion}_{\text{ PFG}_i}))}{log(\text{no.PFG})}
- $$
- with $$
- \text{proportion}_{\text{ PFG}_i} = \frac{abund_{\text{ PFG}_i
- \text{, }\text{Habitat}_j}}{abund_{\text{ PFG}_{all}\text{, }
- \text{Habitat}_j}}
- $$
If the information has been provided (see
-POST_FATE.temporalEvolution), the graphics will be also done
-per habitat.
It requires that the POST_FATE.temporalEvolution
-function has been run and that the file
-POST_FATE_TABLE_PIXEL_evolution_abundance.csv exists.
FATE simulationR/POST_FATE.graphic_mapPFG.R
- POST_FATE.graphic_mapPFG.RdThis script is designed to produce one (or several) raster map
-related to plant functional group results (richness, relative cover, light
-or soil CWM) for one (or several) specific FATE simulation year.
POST_FATE.graphic_mapPFG(
- name.simulation,
- file.simulParam = NULL,
- years,
- opt.stratum_min = 0,
- opt.stratum_max = 10,
- opt.doBinary = TRUE,
- opt.no_CPU = 1,
- opt.doPlot = TRUE
-)a string corresponding to the main directory
-or simulation name of the FATE simulation
default NULL.
A string
-corresponding to the name of a parameter file that will be contained into
-the PARAM_SIMUL folder of the FATE simulation
an integer, or a vector of integer,
-corresponding to the simulation year(s) that will be used to extract PFG
-abundance and binary maps
(optional) default 1.
An
-integer corresponding to the lowest stratum from which PFG
-abundances will be summed up
(optional) default 10.
An
-integer corresponding to the highest stratum from which PFG
-abundances will be summed up
(optional) default TRUE.
If
-TRUE, abundance maps (absolute or relative) are systematically
-multiplied by binary maps (see
-Details)
(optional) default 1.
The number of
-resources that can be used to parallelize the unzip/zip of raster
-files
(optional) default TRUE.
If TRUE,
-plot(s) will be processed, otherwise only the calculation and reorganization
-of outputs will occur, be saved and returned
A list containing one or several (one for each simulation
-year) list of raster and ggplot2 objects :
coverraster of relative coverage
DIV.0raster of species richness
DIV.1raster of Shannon entropy
DIV.2raster of Simpson concentration
CWM.lightraster of light community weighted mean
CWM.soilraster of soil community weighted mean
coverggplot2 object, representing cover
- raster
richnessggplot2 object, representing
- DIV.0 raster
CWM.lightggplot2 object, representing
- CWM.light raster
CWM.soilggplot2 object, representing
- CWM.soil raster
POST_FATE_GRAPHIC_C_map_PFG_[...].pdf file is created containing up
-to four graphics :
map_PFGcoverto visualize the PFG cover within the studied - area
map_PFGrichnessto visualize the PFG richness within the - studied area
PFGlightto visualize the light CWM within the studied area
PFGsoilto visualize the soil CWM within the studied area
Three PFGrichness_YEAR_[...]_STRATA_all_q[...].tif files are created
-into the simulation results folder :
q0PFG richness
q1PFG Shannon entropy
q2PFG Simpson concentration
Raster files are also created for cover, and light and soil CWM if those
-modules were selected (see PRE_FATE.params_globalParameters).
This function allows to obtain, for a specific FATE simulation and
-a specific parameter file within this simulation, up to six raster
-maps and preanalytical graphics.
For each PFG and each selected simulation year, raster maps are retrieved
-from the results folders ABUND_perPFG_perStrata and
-BIN_perPFG_perStrata and unzipped.
-Informations extracted lead to the production of up to six graphics before
-the maps are compressed again :
map of PFG richness within each pixel, representing the sum
- of binary maps
Richness is calculated with the
- Leinster & Cobbold
- 2012 Ecology framework which allows to give more or less importance to
- the commun species through the q parameter :
-
q = 0species richness
q = 1Shannon entropy
q = 2Simpson concentration
map of PFG relative cover, representing the sum of relative
- abundance maps of all PFG
(potentially above a height threshold
- defined by opt.stratum_min)
if light was activated (see
- PRE_FATE.params_globalParameters), community
- weighted mean of PFG light preferences (extracted from LIGHT
- parameter within LIGHT files, see
- PRE_FATE.params_PFGlight)
if soil was activated (see
- PRE_FATE.params_globalParameters), community
- weighted mean of PFG soil preferences (extracted from SOIL_CONTRIB
- parameter within SOIL files, see
- PRE_FATE.params_PFGsoil)
It requires that the POST_FATE.relativeAbund,
-(POST_FATE.graphic_validationStatistics) and
-POST_FATE.binaryMaps functions have been run and that the
-folders BIN_perPFG_allStrata and BIN_perPFG_perStrata exist.
-
If opt.doBinary = TRUE, abundance maps (absolute or relative) are
-systematically multiplied by binary maps extracted from
-BIN_perPFG_allStrata and BIN_perPFG_perStrata folders and
-produced by POST_FATE.binaryMaps function.
-This way, produced raster maps reflect the validated/refined predictions.
-opt.doBinary can be set to FALSE to reflect pure
-simulation results.
-if (FALSE) {
-POST_FATE.graphic_mapPFG(name.simulation = "FATE_simulation"
- , file.simulParam = "Simul_parameters_V1.txt"
- , years = 850
- , opt.stratum_min = 3
- , opt.no_CPU = 1)
-
-POST_FATE.graphic_mapPFG(name.simulation = "FATE_simulation"
- , file.simulParam = "Simul_parameters_V1.txt"
- , year = c(850, 950)
- , opt.doBinary = FALSE)
-}
-
-
-FATE simulationR/POST_FATE.graphic_mapPFGvsHS.R
- POST_FATE.graphic_mapPFGvsHS.RdThis script is designed to produce raster maps of PFG habitat
-suitability and simulated occurrences for one (or several) specific
-FATE simulation year.
POST_FATE.graphic_mapPFGvsHS(
- name.simulation,
- file.simulParam = NULL,
- years,
- opt.stratum = "all"
-)a string corresponding to the main directory
-or simulation name of the FATE simulation
default NULL.
A string
-corresponding to the name of a parameter file that will be contained into
-the PARAM_SIMUL folder of the FATE simulation
an integer, or a vector of integer,
-corresponding to the simulation year(s) that will be used to extract PFG
-binary maps
(optional) default all.
The stratum
-number from which to extract PFG binary maps
A list containing one or several (one for each simulation
-year) list of ggplot2 objects, representing for each plant
-functional group its map of modelled presence / absence vs its
-habitat suitability map.
One POST_FATE_[...].pdf file is created :
GRAPHIC_B
map_PFGvsHSto visualize the PFG presence - within the studied area (probability and simulated occurrence)
This function allows to obtain, for a specific FATE simulation and
-a specific parameter file within this simulation, one preanalytical graphic.
-
For each PFG and each selected simulation year, raster maps are retrieved
-from the results folder BIN_perPFG_allStrata (unless the
-opt.stratum is used, then it will be from the folder
-BIN_perPFG_perStrata) and unzipped.
-Informations extracted lead to the production of one graphic before the
-maps are compressed again :
the comparison between each PFG habitat suitability map and
- its simulated map of presence
It requires that the POST_FATE.relativeAbund and the
-POST_FATE.binaryMaps function have been run
-and that the folders BIN_perPFG_allStrata and
-BIN_perPFG_perStrata exist.
-if (FALSE) {
-POST_FATE.graphic_mapPFGvsHS(name.simulation = "FATE_simulation"
- , file.simulParam = "Simul_parameters_V1.txt"
- , years = 850)
-
-POST_FATE.graphic_mapPFGvsHS(name.simulation = "FATE_simulation"
- , file.simulParam = "Simul_parameters_V1.txt"
- , years = c(850, 950))
-
-POST_FATE.graphic_mapPFGvsHS(name.simulation = "FATE_simulation"
- , file.simulParam = "Simul_parameters_V1.txt"
- , years = 850
- , opt.stratum = 2)
-}
-
-
-FATE simulationR/POST_FATE.graphic_validationStatistics.R
- POST_FATE.graphic_validationStatistics.RdThis script is designed to produce a graphical representation
-of several statistics (sensitivity, specificity, TSS, AUC) for quality
-assessment for one (or several) specific FATE simulation year.
POST_FATE.graphic_validationStatistics(
- name.simulation,
- file.simulParam = NULL,
- years,
- mat.PFG.obs,
- opt.ras_habitat = NULL,
- opt.doPlot = TRUE,
- opt.no_CPU = 1
-)a string corresponding to the main directory
-or simulation name of the FATE simulation
default NULL.
A string
-corresponding to the name of a parameter file that will be contained into
-the PARAM_SIMUL folder of the FATE simulation
an integer, or a vector of integer,
-corresponding to the simulation year(s) that will be used to extract PFG
-relative abundance maps
a data.frame with 4 columns : PFG,
-X, Y, obs
(optional) default NULL.
-A string corresponding to the file name of a raster mask, with an
-integer value within each pixel, corresponding to a specific habitat
(optional) default TRUE.
If TRUE,
-plot(s) will be processed, otherwise only the calculation and reorganization
-of outputs will occur, be saved and returned
(optional) default 1.
The number of
-resources that can be used to parallelize the unzip/zip of raster
-files
A list containing one data.frame object with the
-following columns, and one ggplot2 object :
PFGconcerned plant functional group
AUC.sdstandard deviation of the AUC values
sensitivity.sdstandard deviation of the sensitivity - values
specificity.sdstandard deviation of the specificity - values
variablename of the calculated statistic among
- sensitivity, specificity, TSS and AUC
valuevalue of the corresponding statistic
ggplot2 object, representing the values for each PFG
- of these four validation statistics (sensitivity, specificity, TSS, AUC)
-
One POST_FATE_TABLE_YEAR_[...].csv file is created :
validationStatisticscontaining the data.frame
- detailed above
One POST_FATE_[...].pdf file is created :
GRAPHIC_B
validationStatisticsto assess the modeling - quality of each PFG based on given observations within the studied area
This function allows to obtain, for a specific FATE simulation and
-a specific parameter file within this simulation, PFG validation
-statistic values and one preanalytical graphic.
Observation records (presences and absences) are required for each PFG
-within the mat.PFG.obs object :
PFGthe concerned plant functional group
X, Ythe coordinates of each observation, matching with the
- projection of the mask of name.simulation
obseither 0 or 1 to indicate presence or
- absence
For each PFG and each selected simulation year, raster maps are retrieved
-from the results folder ABUND_REL_perPFG_allStrata and lead to the
-production of one table :
the value of several statistics to evaluate the predictive
- quality of the model for each plant functional group
- (sensitivity,
- specificity,
- auc,
- TSS = sensitivity + specificity - 1)
If a raster mask for habitat has been provided, the values and
-graphics will be also calculated per habitat.
It requires that the POST_FATE.relativeAbund
-function has been run and that the folder ABUND_REL_perPFG_allStrata
-exists.
This .csv file can then be used by other functions :
to produce maps of PFG presence / absence from modelled
- abundances
(see POST_FATE.binaryMaps)
FATE
-simulationR/POST_FATE.graphics.R
- POST_FATE.graphics.RdThis script is designed to produce a set of graphical
-representations for a FATE simulation. Graphics can be of three
-types : 1) representing an evolution through time (of abundance, light,
-soil) ; 2) visualizing the goodness of the modelisation (presence/absence,
-validation statistics) : 3) or representing a spatial distribution for a
-specific year (richness, abundance, light, soil).
POST_FATE.graphics(
- name.simulation,
- file.simulParam = NULL,
- years,
- no_years,
- opt.ras_habitat = NULL,
- doFunc.evolCov = TRUE,
- doFunc.evolPix = TRUE,
- doFunc.evolStab = TRUE,
- evolPix.cells_ID = NULL,
- evolStab.mw_size = 3,
- evolStab.mw_step = 1,
- evol.fixedScale = TRUE,
- doFunc.valid = TRUE,
- valid.mat.PFG.obs,
- doFunc.mapPFGvsHS = TRUE,
- doFunc.mapPFG = TRUE,
- mapPFGvsHS.stratum = "all",
- binMap.method,
- binMap.method1.threshold = 0.05,
- binMap.method2.cutoff = NULL,
- mapPFG.stratum_min = 1,
- mapPFG.stratum_max = 10,
- mapPFG.doBinary = TRUE,
- opt.doPlot = TRUE,
- opt.no_CPU = 1
-)a string corresponding to the main directory
-or simulation name of the FATE simulation
default NULL.
A string
-corresponding to the name of a parameter file that will be contained into
-the PARAM_SIMUL folder of the FATE simulation
an integer, or a vector of integer,
-corresponding to the simulation year(s) that will be used to extract PFG
-abundance maps (see POST_FATE.relativeAbund,
-POST_FATE.graphic_validationStatistics,
-POST_FATE.graphic_mapPFGvsHS)
an integer corresponding to the number of simulation
-years that will be used to extract PFG abundance / light / soil maps (see
-POST_FATE.temporalEvolution)
(optional) default NULL.
-A string corresponding to the file name of a raster mask, with an
-integer value within each pixel, corresponding to a specific habitat
-(see POST_FATE.temporalEvolution,
-POST_FATE.graphic_validationStatistics)
default TRUE.
If TRUE,
-POST_FATE.graphic_evolutionCoverage function will be run.
default TRUE.
If TRUE,
-POST_FATE.graphic_evolutionPixels function will be run.
default TRUE.
If TRUE,
-POST_FATE.graphic_evolutionStability function will be run.
(optional) default NULL.
The
-cells ID of the studied area for which PFG abundances will be extracted
-(see POST_FATE.graphic_evolutionPixels)
(optional) default NULL.
An
-integer corresponding to the size (in years) of the moving
-window that will be used to calculate metrics of habitat stability (see
-POST_FATE.graphic_evolutionStability)
(optional) default NULL.
An
-integer corresponding to the step (in years) of the moving
-window that will be used to calculate metrics of habitat stability (see
-POST_FATE.graphic_evolutionStability)
(optional) default TRUE.
If
-FALSE, the ordinate scale will be adapted for each PFG for the
-graphical representation of the evolution of abundances through time (see
-POST_FATE.graphic_evolutionCoverage)
default TRUE.
If TRUE,
-POST_FATE.graphic_validationStatistics function will be run.
a data.frame with 4 columns : PFG,
-X, Y, obs (see
-POST_FATE.graphic_validationStatistics)
default TRUE.
If TRUE,
-POST_FATE.graphic_mapPFGvsHS function will be run.
default TRUE.
If TRUE,
-POST_FATE.graphic_mapPFG function will be run.
(optional) default all.
The
-stratum number from which to extract PFG binary maps (see
-POST_FATE.graphic_mapPFGvsHS)
an integer to choose the transformation method :
-1 (relative abundance) or 2 (optimizing TSS) (see
-POST_FATE.binaryMaps)
default 0.05.
If method = 1,
-minimum relative abundance required for each PFG to be considered as present
-in the concerned pixel (see POST_FATE.binaryMaps)
default NULL.
If method = 2, a
-data.frame with 3 columns : year, PFG, cutoff
-(see POST_FATE.binaryMaps)
(optional) default 1.
An
-integer corresponding to the lowest stratum from which PFG
-abundances will be summed up (see POST_FATE.graphic_mapPFG)
(optional) default 10.
An
-integer corresponding to the highest stratum from which PFG
-abundances will be summed up (see POST_FATE.graphic_mapPFG)
(optional) default TRUE.
If
-TRUE, abundance maps (absolute or relative) are systematically
-multiplied by binary maps (see POST_FATE.graphic_mapPFG)
(optional) default TRUE.
If TRUE,
-plot(s) will be processed, otherwise only the calculation and reorganization
-of outputs will occur, be saved and returned
(optional) default 1.
The number of
-resources that can be used to parallelize the unzip/zip of raster
-files, as well as the extraction of values from raster files
The following POST_FATE_GRAPHIC_[...].pdf files are created :
A_evolution_coveragespaceOccupancyto visualize for each PFG the evolution of - its occupation of the studied area through simulation time
abundanceto visualize for each PFG the evolution of its - abundance within the whole studied area through simulation time
A_evolution_pixelsto visualize for each PFG the evolution - of its abundance within each selected pixel through simulation time, as - well as the evolution of light and soil resources
A_evolution_stabilityto visualize for each habitat the - evolution of its total abundance and its evenness through simulation time
B_validationStatisticsto assess the modeling quality of - each PFG based on given observations within the studied area
B_map_PFGvsHSto visualize the PFG presence within the - studied area (probability and simulated occurrence)
C_map_PFGPFGcoverto visualize the PFG cover within the studied - area
PFGrichnessto visualize the PFG richness within the - studied area
PFGlightto visualize the light CWM within the studied - area
PFGsoilto visualize the soil CWM within the studied area
Three folders are created :
ABUND_REL_perPFG
_allStratacontaining relative
- abundance raster maps for each PFG across all strata (see
- POST_FATE.relativeAbund)
BIN_perPFG
_allStratacontaining presence / absence
- raster maps for each PFG across all strata (see
- POST_FATE.binaryMaps)
BIN_perPFG
_perStratacontaining presence / absence
- raster maps for each PFG for each stratum (see
- POST_FATE.binaryMaps)
This function allows to obtain, for a specific FATE simulation and a
-specific parameter file within this simulation, up to eleven
-preanalytical graphics.
For each PFG and each selected simulation year, raster maps are retrieved
-from the results folders (ABUND_perPFG_perStrata,
-ABUND_perPFG_allStrata, ABUND_REL_perPFG_allStrata,
-BIN_perPFG_perStrata, BIN_perPFG_allStrata, LIGHT or
-SOIL) and unzipped. Informations extracted lead to the production of
-the following graphics before the maps are compressed again :
the evolution of space occupancy of each plant functional
- group through simulation time,
with space occupancy
- representing the percentage of pixels within the mask of studied area
- where the PFG is present
(see
- POST_FATE.graphic_evolutionCoverage)
the evolution of total abundance of each plant functional
- group through simulation time,
with total abundance being the
- sum over the whole studied area of the PFG abundances (FATE
- arbitrary unit)
(see
- POST_FATE.graphic_evolutionCoverage)
the evolution of abundance of each Plant Functional Group
- through simulation time, within 5 (or more) randomly selected pixels of
- the studied area (FATE arbitrary unit), as well as
- light resources within each height stratum (1: Low,
- 2: Medium, 3: High) and soil resources
- (user-defined scale) if these modules were selected (see
- POST_FATE.graphic_evolutionPixels)
the evolution of total abundance (FATE
- arbitrary unit) and evenness (between 0 and
- 1) of each habitat through simulation time, with evenness
- representing the uniformity of the species composition of the habitat
- (similar to Shannon entropy) (see
- POST_FATE.graphic_evolutionStability)
the value of several statistics to evaluate the predictive
- quality of the model for each plant functional group
- (sensitivity,
- specificity,
- auc,
- TSS = sensitivity + specificity - 1) (see
- POST_FATE.graphic_validationStatistics)
the comparison between each PFG habitat suitability map and
- its simulated map of presence
(see
- POST_FATE.graphic_mapPFGvsHS)
the map of PFG richness within each pixel, representing the
- sum of binary maps (see POST_FATE.graphic_mapPFG)
the map of PFG relative cover, representing the sum of
- relative abundance maps of all PFG
(potentially above a height threshold
- defined by opt.stratum_min) (see
- POST_FATE.graphic_mapPFG)
the map of light Community Weighted Mean
(potentially above
- a height threshold defined by opt.stratum_min) (see
- POST_FATE.graphic_mapPFG)
the map of soil Community Weighted Mean
(potentially above
- a height threshold defined by opt.stratum_min) (see
- POST_FATE.graphic_mapPFG)
FATE simulationR/POST_FATE.relativeAbund.R
- POST_FATE.relativeAbund.RdThis script is designed to produce raster maps of PFG
-simulated relative abundances for one (or several) specific FATE
-simulation year.
POST_FATE.relativeAbund(
- name.simulation,
- file.simulParam = NULL,
- years,
- opt.no_CPU = 1
-)a string corresponding to the main directory
-or simulation name of the FATE simulation
default NULL.
A string
-corresponding to the name of a parameter file that will be contained into
-the PARAM_SIMUL folder of the FATE simulation
an integer, or a vector of integer,
-corresponding to the simulation year(s) that will be used to extract PFG
-abundance maps
(optional) default 1.
The number of
-resources that can be used to parallelize the unzip/zip of raster
-files
One result folder is created :
ABUND_REL_perPFG
_allStratacontaining relative - abundance raster maps for each PFG across all strata
This function allows to obtain, for a specific FATE simulation and
-a specific parameter file within this simulation, raster maps of PFG
-relative abundance.
For each PFG and each selected simulation year, raster maps are retrieved
-from the results folder ABUND_perPFG_allStrata and unzipped.
-Informations extracted lead to the production of the same number of raster
-before the maps are compressed again :
for each selected simulation year(s), relative abundances
- for all strata combined are calculated :
- $$\frac{abund_{\text{ PFG}_i\text{, }\text{Stratum}_{all}}}
- {abund_{\text{ PFG}_{all}\text{, }\text{Stratum}_{all}}}$$
These raster files can then be used by other functions :
to produce presence/absence maps and validation
- statistics, and associated graphics
(see
- POST_FATE.graphic_validationStatistics)
-if (FALSE) {
-POST_FATE.relativeAbund(name.simulation = "FATE_simulation"
- , file.simulParam = "Simul_parameters_V1.txt"
- , years = 850
- , opt.no_CPU = 1)
-
-POST_FATE.relativeAbund(name.simulation = "FATE_simulation"
- , file.simulParam = "Simul_parameters_V1.txt"
- , years = c(850, 950)
- , opt.no_CPU = 1)
-}
-
-
-FATE simulationR/POST_FATE.temporalEvolution.R
- POST_FATE.temporalEvolution.RdThis script is designed to produce from 1 to 3 tables
-containing pixel temporal evolution of PFG abundances, as well as light and
-soil resources if those modules were activated, in a FATE
-simulation.
POST_FATE.temporalEvolution(
- name.simulation,
- file.simulParam = NULL,
- no_years,
- opt.ras_habitat = NULL,
- opt.no_CPU = 1
-)a string corresponding to the main directory
-or simulation name of the FATE simulation
default NULL.
A string
-corresponding to the name of a parameter file that will be contained into
-the PARAM_SIMUL folder of the FATE simulation
an integer corresponding to the number of simulation
-years that will be used to extract PFG abundance / light / soil maps
(optional) default NULL.
-A string corresponding to the file name of a raster mask, with an
-integer value within each pixel, corresponding to a specific habitat
(optional) default 1.
The number of
-resources that can be used to parallelize the unzip/zip of raster
-files, as well as the extraction of values from raster files
A list containing three data.frame objects with the
-following columns :
PFGconcerned plant functional group (for abundance)
STRATUMconcerned height stratum (for LIGHT)
ID.pixelnumber of the concerned pixel
X, Ycoordinates of the concerned pixel
HABhabitat of the concerned pixel
values of the corresponding object (abundance / LIGHT
- / SOIL) for each selected simulation year(s)
One to three POST_FATE_TABLE_PIXEL_evolution_[...].csv files are created :
abundancealways
lightif light module was activated
soilif soil module was activated
This function allows to obtain, for a specific FATE simulation and
-a specific parameter file within this simulation, one to three
-preanalytical tables that can then be used to create graphics.
For each PFG and each selected simulation year, raster maps are retrieved
-from the results folder ABUND_perPFG_allStrata and unzipped.
-Informations extracted lead to the production of one table before the maps
-are compressed again :
the value of abundance for each Plant Functional Group
- for each selected simulation year(s) in every pixel in which the PFG is
- present for at least one of the selected simulation year(s)
If the light module was activated (see
-PRE_FATE.params_globalParameters), for each height stratum
-and each selected simulation year, raster maps are retrieved from the
-results folder LIGHT and unzipped.
-Informations extracted lead to the production of one table before the maps
-are compressed again :
the value of light resources for each height stratum for
- each selected simulation year(s) in every pixel
If the soil module was activated (see
-PRE_FATE.params_globalParameters), for each selected
-simulation year, raster maps are retrieved from the results folder
-SOIL and unzipped.
-Informations extracted lead to the production of one table before the maps
-are compressed again :
the value of soil resources for each selected simulation
- year(s) in every pixel
If a raster mask for habitat has been provided, the tables will
-also contain information about the pixel habitat.
These .csv files can then be used by other functions :
to produce graphics of temporal evolution of modelled abundances
- and space occupancy at the whole area level
(see
- POST_FATE.graphic_evolutionCoverage)
to produce graphics of temporal evolution of modelled abundances
- and / or resources at the pixel level
(see
- POST_FATE.graphic_evolutionPixels)
to produce graphics of temporal evolution of community composition
- at the habitat level
(see
- POST_FATE.graphic_evolutionStability)
R/PRE_FATE.abundBraunBlanquet.R
- PRE_FATE.abundBraunBlanquet.RdThis script is designed to transform Braun-Blanquet abundance -information into relative abundances or average recovery values -(between 0 and 100).
-PRE_FATE.abundBraunBlanquet(abund)a vector with abundance values from Braun-Blanquet
-(+, r, 1, 2, 3, 4, 5), and with NA when no information
A vector with numerical values between 0 and
-100 corresponding to the median of each recovery class.
Braun-Blanquet values allow to estimate the abundance-dominance of a -species based on an estimation of the number of individuals and the -covering surface. A correspondence has been defined between this index and -average recovery values :
-| Braun-Blanquet | Recovery class (%) | Average recovery (%) |
-____________________________________________________________ | + ............ | ............... <1 | ................ 0.5 | | 1 ............ | .............. 1-5 | .................. 3 | | 2 ............ | ............. 5-25 | ................. 15 | | 3 ............ | ............ 25-50 | ............... 37.5 | | 4 ............ | ............ 50-75 | ............... 62.5 | | 5 ............ | ........... 75-100 | ............... 87.5 |
-##' ____________________________________________________________ | 0 ............ | .................. | .................. 0 | | NA ........... | .................. | ................. NA |
-Braun-Blanquet J., Roussine N. & Nègre R., 1952. Les groupements végétaux de
-la France méditerranéenne. Dir. Carte Group. Vég. Afr. Nord , CNRS, 292 p.
Baudière A. & Serve L., 1975. Les groupements végétaux du Plade -Gorra-Blanc (massif du Puigmal, Pyrénées Orientales). Essai d'interprétation -phytosociologique et phytogéographique. Nat. Monsp., sér. Bot., 25, 5-21.
-Foucault B. (de), 1980. Les prairies du bocage virois (Basse-Normandie, -France). Typologie phytosociologique et essai de reconstitution des séries -évolutives herbagères. Doc. Phytosoc., N.S., 5, 1-109.
-FATE
-simulationR/PRE_FATE.params_PFGdispersal.R
- PRE_FATE.params_PFGdispersal.RdThis script is designed to create parameter files containing
-dispersal distances for each PFG (one file for each of them) used in the
-dispersal module of FATE.
PRE_FATE.params_PFGdispersal(
- name.simulation,
- mat.PFG.disp,
- opt.folder.name = NULL
-)a string corresponding to the main directory
-or simulation name of the FATE simulation
a data.frame with 4 columns : PFG,
-d50, d99, ldd
(optional)
a string corresponding
-to the name of the folder that will be created into the
-name.simulation/DATA/PFGS/DISP/ directory to store the results
A .txt file per PFG into the
-name.simulation/DATA/PFGS/DISP/ directory with the following
-parameters :
dispersal distances (3 values) (in meters)
-
A DISP_COMPLETE_TABLE.csv file summarizing information for all
-groups into the name.simulation/DATA/PFGS/ directory.
If the opt.folder.name has been used, the files will be into the
-folder name.simulation/DATA/PFGS/DISP/opt.folder.name/.
A dispersal module is available to make the FATE model
-spatially explicit by dispersing seeds of each PFG with a kernel (see
-PRE_FATE.params_globalParameters).
Dispersal distances are needed for each PFG to quantify the amount of seeds -dispersed into 3 different concentric circles :
-the distance at which 50% of seeds are dispersed
the distance at which 99% of seeds are dispersed
the long dispersal distance at which 100% of seeds are dispersed
-## Create a skeleton folder with the default name ('FATE_simulation')
-PRE_FATE.skeletonDirectory()
-
-mat.disp = data.frame(PFG = paste0('PFG', 1:6)
- , d50 = c(10, 25, 100, 100, 500, 1000)
- , d99 = c(500, 600, 300, 300, 1250, 1200)
- , ldd = c(1500, 1500, 900, 900, 1500, 2000))
-
-## Create PFG dispersal parameter files -----------------------------------------------------
-PRE_FATE.params_PFGdispersal(name.simulation = 'FATE_simulation'
- , mat.PFG.disp = mat.disp)
-
-
-## -------------------------------------------------------------------------------------------
-
-# ## Load example data
-# Champsaur_PFG = .loadData('Champsaur_PFG', 'RData')
-#
-# ## Build PFG traits for dispersal
-# tab.traits = Champsaur_PFG$PFG.traits
-# ## Dispersal values
-# ## = Short: 0.1-2m; Medium: 40-100m; Long: 400-500m
-# ## = Vittoz correspondance : 1-3: Short; 4-5: Medium; 6-7:Long
-# corres = data.frame(dispersal = 1:7
-# , d50 = c(0.1, 0.5, 2, 40, 100, 400, 500)
-# , d99 = c(1, 5, 15, 150, 500, 1500, 5000)
-# , ldd = c(1000, 1000, 1000, 5000, 5000, 10000, 10000))
-# tab.traits$d50 = corres$d50[tab.traits$dispersal]
-# tab.traits$d99 = corres$d99[tab.traits$dispersal]
-# tab.traits$ldd = corres$ldd[tab.traits$dispersal]
-# str(tab.traits)
-
-
-## Load example data
-Champsaur_params = .loadData('Champsaur_params', 'RData')
-
-## Create a skeleton folder
-PRE_FATE.skeletonDirectory(name.simulation = 'FATE_Champsaur')
-
-
-## PFG traits for dispersal
-tab.disp = Champsaur_params$tab.DISP
-str(tab.disp)
-
-## Create PFG dispersal parameter files ------------------------------------------------------
-PRE_FATE.params_PFGdispersal(name.simulation = 'FATE_Champsaur'
- , mat.PFG.disp = Champsaur_params$tab.DISP)
-
-
-FATE
-simulationR/PRE_FATE.params_PFGdisturbance.R
- PRE_FATE.params_PFGdisturbance.RdThis script is designed to create parameter files containing
-response to disturbance parameters for each PFG (one file for each of them)
-used in the disturbance module of FATE.
PRE_FATE.params_PFGdisturbance(
- name.simulation,
- mat.PFG.dist = NULL,
- mat.PFG.tol,
- opt.folder.name = NULL
-)a string corresponding to the main directory
-or simulation name of the FATE simulation
(optional)
-a data.frame with 5 columns : PFG, type, maturity, longevity,
-age_above_150cm (see
-Details)
a data.frame with 3 to 7 columns :
nameDist,
PFG,
(responseStage, breakAge, resproutAge),
responseStage, killedIndiv, resproutIndiv
- (or strategy_tol)
(see Details)
(optional)
a string corresponding
-to the name of the folder that will be created into the
-name.simulation/DATA/PFGS/DIST/ directory to store the results
A .txt file per PFG into the
-name.simulation/DATA/PFGS/DIST/ directory with the following
-parameters :
ages at which the PFG changes of response stage - (in years)
resprouting age table (in a single row)
- This is a vector of no.DIST * no.responseStages numbers
- corresponding
to the age at which the PFG can be rejuvenated
- (younger than the actual one) :
at different response stages (RS)
for each disturbance (DI).
These parameters should be given in this order (e.g. with 3 response
- stages) : DI1_RS1, DI1_RS2, DI1_RS3, DI2_RS1... (in
- years).
disturbance response table (in a single row)
- This is a vector of no.DIST * no.responseStages * 2 numbers
- corresponding
to the proportion of individuals :
that will be killed (Ki) or resprout
- (Re)
at different response stages (RS)
for each disturbance (DI).
These parameters should be given in this order (e.g. with 3 response
- stages) : DI1_RS1_Ki, DI1_RS1_Re, DI1_RS2_Ki, DI1_RS2_Re,
- DI1_RS3_Ki, DI1_RS3_Re, DI2_RS1_Ki...
-
(integer between 0 and 100%).
proportion of propagules killed by each disturbance
(integer between 0 and 100%)
proportion of seeds activated by each disturbance
(integer between 0 and 100%)
A DIST_COMPLETE_TABLE.csv file summarizing information for all
-groups into the name.simulation/DATA/PFGS/ directory.
If the opt.folder.name has been used, the files will be into the
-folder name.simulation/DATA/PFGS/DIST/opt.folder.name/.
The disturbance module allows the user to simulate spatial
-perturbation(s) that will impact each PFG in terms of resprouting and
-mortality at different response stages.
Several parameters, given within mat.PFG.dist or mat.PFG.tol,
-are required for each PFG in order to set up these responses :
the concerned plant functional group
or life-form, based on Raunkier.
It should be
- either H (herbaceous), C (chamaephyte) or P
- (phanerophyte) for now
the age from which the PFG can reproduce
the maximum or average lifespan of the PFG
the age from which the PFG reaches 150 cm
- (1000 otherwise)
the name of each perturbation (several can be defined at
- the same time)
an integer corresponding to the
- concerned response class
the age from which the PFG is associated with - this response class
the age at which the plants will grow back,
- if they grow back
an integer corresponding to the concerned
- response class
an integer between 0 and 100
- corresponding to the proportion of killed individuals
an integer between 0 and 100
- corresponding to the proportion of resprouting individuals
a string to choose the response to
- disturbance strategy : indifferent, mowing_herbs,
- mowing_trees, grazing_herbs_1, grazing_herbs_2,
- grazing_herbs_3, grazing_trees_1, grazing_trees_2,
- grazing_trees_3
These values will allow to calculate or define a set of characteristics for -each PFG :
-= each PFG can respond to a disturbance in several
- different ways that depend on the PFG age
- = ages at which each PFG changes of response stage
- Two methods to define these ages are available :
from predefined rules (using type,
- maturity, longevity, age_above_150cm) :
- 4 classes are defined that can be labelled as :
JustBorn
- (1), Juveniles (2), Matures (3),
- Senescents (4)
H (herbaceous) | C
- (chamaephyte) or P (phanerophyte) | |
from class 1 to 2 | maturity - 2 | 1 |
from class 2 to 3 | maturity | min(maturity - 2 , age_above_150cm) |
from class 3 to 4 | longevity - 2 | min(longevity - 2 , age_above_150cm) |
Some corrections are made for short-living plants (annuals and - biennials) :
as they die after 1 or 2 years, they are not affected - differently according to life stages
break ages from class 1 to 3 are set to 1,
- and break age from 3 to 4 is set to their longevity
- (1 or 2)
from user data :
with the values contained within the breakAge column,
- if provided
= when subject to a perturbation, each PFG can either
- stay undisturbed, be killed, or resprout at a particular age
- (in years)
- = ages at which each PFG will be rejuvenated by a disturbance
- Two methods to define these ages are available :
from predefined rules (using maturity,
- longevity, age_above_150cm) :
classes 1 and 2 : too young to resprout
class 3 :
- min(maturity - 2 , age_above_150cm)
class 4 : longevity - 2
short-living plants (annuals and biennials) always start back
- at 0
from user data :
with the values contained within the resproutAge column,
- if provided
= proportion of killed and resprouting individuals
- = for each disturbance and for each response stage
- Two methods to define these tolerances are available :
from predefined scenarios (using
- strategy_tol) :
the values give the percentage of killed or resprouting - individuals
with 1, 2, 3, 4: response classes
with K: killed individuals, R: resprouting
- individuals
| ___1___ | ___2___ | ___3___ | ___4___ | | _K_ _R_ | _K_ _R_ | _K_ _R_ | _K_ _R_ | _________________________________________ | _0_ _0_ | _0_ _0_ | _0_ _0_ | _0_ _0_ | indifferent _________________________________________ | _0_ _0_ | _0_ _0_ | 50% 50% | 100% 0_ | mowing_herbs | _0_ _0_ | 100% 0_ | 100% 0_ | 100% 0_ | mowing_trees _________________________________________ | _0_ _0_ | 10% _0_ | _0_ 50% | _0_ 10% | grazing_herbs_1 | _0_ _0_ | 50% _0_ | _0_ 80% | 10% 50% | grazing_herbs_2 | _0_ _0_ | 90% _0_ | 10% 90% | 50% 50% | grazing_herbs_3 _________________________________________ | 40% _0_ | _0_ _0_ | _0_ _0_ | _0_ _0_ | grazing_trees_1 | 80% _0_ | _0_ _0_ | _0_ _0_ | _0_ _0_ | grazing_trees_2 | 100% 0_ | 40% _0_ | _0_ _0_ | _0_ _0_ | grazing_trees_3
from user data :
with the values contained within the responseStage,
- killedIndiv and resproutIndiv columns, if provided
- The PFG column can contain either the life form (H,
- C or P) or the PFG name. Both methods can be combined
- (but are applied in the order given by the PFG column).
= the proportion of propagules killed by each
- disturbance
- (currently set to 0% for all PFG and disturbances)
= the proportion of seeds activated by each
- disturbance
- (currently set to 0% for all PFG and disturbances)
-## Create a skeleton folder with the default name ('FATE_simulation')
-PRE_FATE.skeletonDirectory()
-
-
-mat.char = data.frame(PFG = paste0('PFG', 1:6)
- , type = c('C', 'C', 'H', 'H', 'P', 'P')
- , maturity = c(5, 5, 3, 3, 8, 9)
- , longevity = c(12, 200, 25, 4, 110, 70)
- , age_above_150cm = c(1000, 100, 1000, 1000, 10, 12))
-
-mat.tol = data.frame(nameDist = 'grazing'
- , PFG = paste0('PFG', 1:6)
- , strategy_tol = c('indifferent', 'grazing_herbs_1'
- , 'grazing_herbs_1', 'grazing_herbs_2'
- , 'indifferent', 'grazing_trees_2'))
-
-## Create PFG response to disturbance parameter files (with PFG characteristics) -------------
-PRE_FATE.params_PFGdisturbance(name.simulation = 'FATE_simulation'
- , mat.PFG.dist = mat.char
- , mat.PFG.tol = mat.tol)
-
-
-## Create PFG response to disturbance parameter files (with all values) ----------------------
-mat.tol = expand.grid(responseStage = 1:3
- , PFG = paste0('PFG', 1:6)
- , nameDist = 'Mowing')
-mat.tol$breakAge = c(1, 4, 10
- , 1, 4, 10
- , 1, 2, 50
- , 1, 2, 20
- , 2, 6, 95
- , 3, 8, 55)
-mat.tol$resproutAge = c(0, 0, 4
- , 0, 0, 4
- , 0, 0, 2
- , 0, 0, 2
- , 0, 2, 5
- , 0, 4, 7)
-mat.tol$killedIndiv = c(100, 100, 50
- , 100, 100, 50
- , 100, 100, 50
- , 100, 100, 50
- , 100, 70, 40
- , 100, 60, 30)
-mat.tol$resproutIndiv = c(0, 0, 50
- , 0, 0, 50
- , 0, 0, 30
- , 0, 0, 30
- , 0, 10, 40
- , 0, 20, 50)
-str(mat.tol)
-
-PRE_FATE.params_PFGdisturbance(name.simulation = 'FATE_simulation'
- , mat.PFG.tol = mat.tol)
-
-
-## -------------------------------------------------------------------------------------------
-
-## Load example data
-Champsaur_params = .loadData('Champsaur_params', 'RData')
-
-## Create a skeleton folder
-PRE_FATE.skeletonDirectory(name.simulation = 'FATE_Champsaur')
-
-
-## PFG traits for succession
-tab.succ = Champsaur_params$tab.SUCC
-str(tab.succ)
-
-## Create PFG succession parameter files (fixing strata limits) --------------
-PRE_FATE.params_PFGsuccession(name.simulation = 'FATE_Champsaur'
- , mat.PFG.succ = tab.succ
- , strata.limits = c(0, 20, 50, 150, 400, 1000, 2000)
- , strata.limits_reduce = FALSE)
-
-require(data.table)
-tmp = fread('FATE_Champsaur/DATA/PFGS/SUCC_COMPLETE_TABLE.csv')
-tab.succ = Champsaur_params$tab.SUCC
-tab.succ$age_above_150cm = tmp$CHANG_STR_AGES_to_str_4_150
-tab.succ = tab.succ[, c('PFG', 'type', 'maturity', 'longevity', 'age_above_150cm')]
-str(tab.succ)
-
-## PFG traits for disturbance
-tab.dist = Champsaur_params$tab.DIST
-str(tab.dist)
-
-## Create PFG response to disturbance parameter files (give warnings) ------------------------
-PRE_FATE.params_PFGdisturbance(name.simulation = 'FATE_Champsaur'
- , mat.PFG.dist = tab.succ
- , mat.PFG.tol = tab.dist)
-
-FATE
-simulationR/PRE_FATE.params_PFGdrought.R
- PRE_FATE.params_PFGdrought.RdThis script is designed to create parameter files containing
-response to drought disturbance parameters for each PFG (one file for each
-of them) used in the drought disturbance module of FATE.
PRE_FATE.params_PFGdrought(
- name.simulation,
- mat.PFG.dist = NULL,
- mat.PFG.tol,
- mat.PFG.drought,
- opt.folder.name = NULL
-)a string corresponding to the main directory
-or simulation name of the FATE simulation
(optional)
-a data.frame with 5 columns : PFG, type, maturity, longevity,
-age_above_150cm (see
-Details)
a data.frame with 3 to 7 columns :
nameDist,
PFG,
(responseStage, breakAge, resproutAge),
responseStage, killedIndiv, resproutIndiv
- (or strategy_tol)
(see Details)
a data.frame with 4 or 6 columns :
PFG,
threshold_moderate, threshold_severe,
counter_recovery, counter_sens, counter_cum
- (or strategy_drou)
(optional)
a string corresponding
-to the name of the folder that will be created into the
-name.simulation/DATA/PFGS/DROUGHT/ directory to store the results
A .txt file per PFG into the
-name.simulation/DATA/PFGS/DROUGHT/ directory with the following
-parameters :
ages at which the PFG changes of response stage - (in years)
resprouting age table (in a single row)
- This is a vector of no.DIST (=2) * no.responseStages numbers
- corresponding
to the age at which the PFG can be rejuvenated
- (younger than the actual one) :
at different response stages (RS)
for each disturbance (DI).
These parameters should be given in this order (e.g. with 3 response
- stages) : DI1_RS1, DI1_RS2, DI1_RS3, DI2_RS1... (in
- years).
disturbance response table (in a single row)
- This is a vector of no.DIST (=2) * no.responseStages * 2 numbers
- corresponding
to the proportion of individuals :
that will be killed (Ki) or resprout
- (Re)
at different response stages (RS)
for each disturbance (DI).
These parameters should be given in this order (e.g. with 3 response
- stages) : DI1_RS1_Ki, DI1_RS1_Re, DI1_RS2_Ki, DI1_RS2_Re,
- DI1_RS3_Ki, DI1_RS3_Re, DI2_RS1_Ki...
-
(from 0 to 10, corresponding to 0 to 100%).
proportion of propagules killed by each disturbance
(from 0 to 10, corresponding to 0 to 100%)
proportion of seeds activated by each disturbance
(from 0 to 10, corresponding to 0 to 100%)
threshold below which the PFG will experience
- moderate drought
(same unit as that of the map given with the
- DROUGHT_MASK flag in
- PRE_FATE.params_globalParameters)
threshold below which the PFG will experience
- severe drought
(same unit as that of the map given with the
- DROUGHT_MASK flag in
- PRE_FATE.params_globalParameters)
number of years removed from the PFG counter of - cumulated consecutive years of drought events, during non-drought years
number of consecutive years of drought the PFG must
- experience before suffering severe effects due to a severe drought
- (sensitivity to severe drought)
number of consecutive years of drought the PFG must
- experience before any subsequent drought event start having severe effects
-
(cumulative drought response)
A DROUGHT_COMPLETE_TABLE.csv file summarizing information for all
-groups into the name.simulation/DATA/PFGS/ directory.
If the opt.folder.name has been used, the files will be into the
-folder name.simulation/DATA/PFGS/DROUGHT/opt.folder.name/.
The drought disturbance module is a specific case of the
-disturbance module. It also allows the user to simulate spatial
-perturbation(s) that will impact each PFG in terms of resprouting and
-mortality at different response stages, but with specific rules to
-determine when the PFG is affected (see
-PRE_FATE.params_globalParameters).
Several parameters, given within mat.PFG.dist or mat.PFG.tol,
-are required for each PFG in order to set up these responses. The
-explanations are the same than those that can be found in
-PRE_FATE.params_PFGdisturbance function. Therefore,
-only parameters whose values or descriptions change are detailed
-below :
a string to choose the concerned drought
- disturbance : immediate or delayed
a string to choose the response to
- drought strategy : herbs_cham_1, herbs_cham_2,
- herbs_cham_3, trees_1, trees_2, trees_3
-
These values will allow to calculate or define a set of characteristics for -each PFG :
-= proportion of killed and resprouting individuals
- = for each disturbance and for each response stage
- Two methods to define these tolerances are available :
from predefined scenarios (using
- strategy_tol) :
the values give the percentage of killed or resprouting - individuals
with 1, 2, 3, 4: response classes
with K: killed individuals, R: resprouting
- individuals
| ___1___ | ___2___ | ___3___ | ___4___ | | _K_ _R_ | _K_ _R_ | _K_ _R_ | _K_ _R_ | ________________IMMEDIATE________________ | 10% _0_ | _0_ _0_ | _0_ _0_ | _0_ _0_ | herbs_cham_1 | 20% _0_ | _0_ _0_ | _0_ _0_ | 10% _0_ | herbs_cham_2 | 40% _0_ | 10% _0_ | 10% _0_ | 20% _0_ | herbs_cham_3 | 10% _0_ | _0_ _0_ | _0_ 40% | _0_ 40% | trees_1 | 20% _0_ | _0_ 10% | _0_ 50% | 10% 50% | trees_2 | 40% _0_ | 10% 40% | 10% 80% | 20% 80% | trees_3 _________________DELAYED_________________ | _0_ _0_ | _0_ 10% | _0_ 10% | _0_ 10% | herbs_cham_1 | _0_ _0_ | _0_ 10% | _0_ 10% | _0_ 10% | herbs_cham_2 | _0_ _0_ | _0_ 10% | _0_ 10% | _0_ 10% | herbs_cham_3 | _0_ _0_ | _0_ 10% | _0_ 40% | _0_ 40% | trees_1 | 10% _0_ | _0_ 40% | _0_ 40% | _0_ 40% | trees_2 | 20% _0_ | 10% 40% | 10% 50% | 10% 50% | trees_3
from user data :
with the values contained within the responseStage,
- killedIndiv and resproutIndiv columns, if provided
- The PFG column can contain either the life form (H,
- C or P) or the PFG name. Both methods can be combined
- (but are applied in the order given by the PFG column).
Supplementary parameters related to drought, given within
-mat.PFG.drought, are required for each PFG :
a value corresponding to the threshold below
- which the PFG will experience moderate drought (on the same scale than
- threshold_severe and the map given with the DROUGHT_MASK
- flag in PRE_FATE.params_globalParameters)
a value corresponding to the threshold below
- which the PFG will experience severe drought (on the same scale than
- threshold_moderate and the map given with the DROUGHT_MASK
- flag in PRE_FATE.params_globalParameters). It should be
- inferior or equal to threshold_moderate.
an integer corresponding to the number of
- years removed from the PFG counter of cumulated consecutive years of
- drought events, during non-drought years
an integer corresponding to the number of
- consecutive years of drought the PFG must experience before suffering
- severe effects due to a severe drought (sensitivity to severe
- drought)
an integer corresponding to the number of
- consecutive years of drought the PFG must experience before any subsequent
- drought event start having severe effects (cumulative drought
- response). It should be superior or equal to counter_sens.
a string to choose the "counter"
- strategy : herbs, chamaephytes, trees_shrubs
-
These values will allow to define a set of characteristics for each PFG :
with the THRESHOLD_MODERATE and - THRESHOLD_SEVERE parameters
with the COUNTER_RECOVERY, - COUNTER_SENS and COUNTER_CUM parameters
-## Create a skeleton folder with the default name ('FATE_simulation')
-PRE_FATE.skeletonDirectory()
-
-
-mat.char = data.frame(PFG = paste0('PFG', 1:6)
- , type = c('C', 'C', 'H', 'H', 'P', 'P')
- , maturity = c(5, 5, 3, 3, 8, 9)
- , longevity = c(12, 200, 25, 4, 110, 70)
- , age_above_150cm = c(1000, 100, 1000, 1000, 10, 12))
-
-mat.tol = data.frame(nameDist = 'immediate'
- , PFG = paste0('PFG', 1:6)
- , strategy_tol = c('herbs_cham_1', 'herbs_cham_2'
- , 'herbs_cham_2', 'herbs_cham_3'
- , 'trees_1', 'trees_3'))
-
-mat.drought = data.frame(PFG = paste0('PFG', 1:6)
- , threshold_moderate = c(0.5, 0.2, 1, 1, 0.8, 0.5)
- , threshold_severe = c(0.1, 0.1, 0.8, 0.9, 0.4, 0.2)
- , strategy_drou = c('chamaephytes', 'trees_shrubs', 'herbs'
- , 'herbs', 'trees_shrubs', 'trees_shrubs'))
-
-## Create PFG response to drought parameter files (with PFG characteristics) -----------------
-PRE_FATE.params_PFGdrought(name.simulation = 'FATE_simulation'
- , mat.PFG.dist = mat.char
- , mat.PFG.tol = mat.tol
- , mat.PFG.drought = mat.drought)
-
-
-## Create PFG response to drought parameter files (with all values) --------------------------
-mat.tol = expand.grid(responseStage = 1:3
- , PFG = paste0('PFG', 1:6)
- , nameDist = 'delayed')
-mat.tol$breakAge = c(1, 4, 10
- , 1, 4, 10
- , 1, 2, 50
- , 1, 2, 20
- , 2, 6, 95
- , 3, 8, 55)
-mat.tol$resproutAge = c(0, 0, 4
- , 0, 0, 4
- , 0, 0, 2
- , 0, 0, 2
- , 0, 2, 5
- , 0, 4, 7)
-mat.tol$killedIndiv = c(10, 10, 5
- , 10, 10, 5
- , 10, 10, 5
- , 10, 10, 5
- , 10, 7, 4
- , 10, 6, 3)
-mat.tol$resproutIndiv = c(0, 0, 5
- , 0, 0, 5
- , 0, 0, 3
- , 0, 0, 3
- , 0, 1, 4
- , 0, 2, 5)
-str(mat.tol)
-
-PRE_FATE.params_PFGdrought(name.simulation = 'FATE_simulation'
- , mat.PFG.tol = mat.tol
- , mat.PFG.drought = mat.drought)
-
-
-FATE simulationR/PRE_FATE.params_PFGlight.R
- PRE_FATE.params_PFGlight.RdThis script is designed to create parameter files containing
-light-related parameters for each PFG (one file for each of them) used in
-the light module of FATE.
PRE_FATE.params_PFGlight(
- name.simulation,
- mat.PFG.light,
- mat.PFG.tol = NULL,
- opt.folder.name = NULL
-)a string corresponding to the main directory
-or simulation name of the FATE simulation
a data.frame with 2 to 6 columns :
PFG,
type (or shade_factor)
type, (or active_germ_low,
- active_germ_medium, active_germ_high) (or
- strategy_ag)
type, light_need
(see Details)
(optional)
-a data.frame with 2 to 4 columns :
PFG,
lifeStage, resources, tolerance
- (or strategy_tol)
(see Details)
(optional)
a string corresponding
-to the name of the folder that will be created into the
-name.simulation/DATA/PFGS/LIGHT/ directory to store the results
A .txt file per PFG into the
-name.simulation/DATA/PFGS/LIGHT/ directory with the following
-parameters :
name of the PFG
light value or strategy of the PFG
index of shade quantity to weight PFG abundance and - transform it into light resources
germination rates depending on light conditions
-
(integer between 0 and 100%)
light tolerance table (in a single row).
- This is a vector of 9 numbers corresponding to the ability of the PFG to
- survive or not :
at different life stages (Germinant (Ge), Immature
- (Im), Mature (Ma))
under different light conditions (Low (L), Medium
- (M) or High (H)).
These parameters should be given in this order : GeL, GeM, GeH, ImL,
- ImM, ImH, MaL, MaM, MaH
-
(integer between 0 and 100%).
-
A LIGHT_COMPLETE_TABLE.csv file summarizing information for all
-groups into the name.simulation/DATA/PFGS/ directory.
If the opt.folder.name has been used, the files will be into the
-folder name.simulation/DATA/PFGS/LIGHT/opt.folder.name/.
The light module allows the user to add the effect of
-light interaction within a primary vegetation succession.
Several parameters, given within mat.PFG.light or mat.PFG.tol,
-are required for each PFG in order to set up this light interaction :
the concerned plant functional group
or life-form, based on Raunkier.
It should be either
- H (herbaceous), C (chamaephyte) or P (phanerophyte)
- for now
an integer between 1 and
- Inf corresponding to an index of shade quantity to weight PFG
- abundance and transform it into light resources (e.g. if two PFG
- have shade factors of 1 and 5 respectively, for the same
- abundances, the second PFG will produce 5 times more shade than the first
- one)
an integer between 0 and
- 100 corresponding to the proportion of seeds that will germinate for
- Low light condition
an integer between 0 and
- 100 corresponding to the proportion of seeds that will germinate for
- Medium light condition
an integer between 0 and
- 100 corresponding to the proportion of seeds that will germinate for
- High light condition
a string to choose the germination
- strategy : light_lover, indifferent, shade_lover
-
an integer between 0 and 5
- corresponding to the light preference of the PFG (e.g. from Flora
- Indicativa)
the concerned life stage (Germinant,
- Immature, Mature)
the concerned light condition (Low,
- Medium, High)
an integer between 0 and 100
- corresponding to the proportion of surviving individuals
a string to choose the tolerance
- strategy : full_light, pioneer, ubiquist,
- semi_shade, undergrowth
These values will allow to calculate or define a set of characteristics for -each PFG :
-index of shade quantity to weight PFG abundance and
- transform it into light resources
- Two methods to define these proportions are available :
from predefined rules (using type) :
for H (herbaceous) : 1
for C (chamaephyte) : 5
for P (phanerophyte) : 100
from user data :
with the values contained within the shade_factor column,
- if provided
proportion of seeds that will germinate for each light
- condition (Low, Medium, High)
- Three methods to define these proportions are available :
from predefined scenarios (using strategy_ag) : | _L_ _M_ _H_ | _______________ | 50% 80% 90% | light_lover | 90% 90% 90% | indifferent | 90% 80% 50% | shade_lover
from predefined rules (using type) :
for H (herbaceous) : 50%, 80%, 90%
for C (chamaephyte) or P (phanerophyte):
- 90%, 90%, 90%
from user data :
with the values contained within the active_germ_low,
- active_germ_medium and active_germ_high columns, if
- provided
defined for each life stage (Germinant,
- Immature, Mature)
and each soil condition (Low,
- Medium, High)
- Three methods to define these tolerances are available :
from predefined scenarios (using
- strategy_tol) :
. means Not tolerant, 1 means
- Tolerant (100%)
with g: Germinant, i: Immature, m: Mature
with L: low light, M: medium light, H:
- high light
| _ g _ | _ i _ | _ m _ | | L M H | L M H | L M H | _________________________ | 1 1 1 | . . 1 | . . 1 | full_light | 1 1 1 | . 1 1 | . 1 1 | pioneer | 1 1 1 | 1 1 1 | 1 1 1 | ubiquist | 1 1 . | 1 1 . | 1 1 1 | semi_shade | 1 1 . | 1 1 . | 1 1 . | undergrowth
from predefined rules (using type and
- light_need):
PFG are tolerant to Low light if light <= 2
PFG are tolerant to Medium light if
- 2 <= light <= 4
PFG are tolerant to High light if
- light >= 3
all germinants are assumed to be tolerant to Low
- light
all mature trees or chamaephytes are assumed to be
- tolerant to Medium and High light conditions
all immature trees that grow in the
- penultimate stratum are assumed to be tolerant to High light
- !! desactivated !!
. means Not tolerant
A, B, C, D mean Tolerant (100%) according
- to one of the rule defined above
with g: Germinant, i: Immature, m: Mature
with L: low light, M: medium light, H:
- high light
| _ g _ | _ i _ | _ m _ | | L M H | L M H | L M H | _________________________ | A . . | A . D | A C C | 1 | A A . | A A D | A A C | 2 | B A . | . A D | . A C | 3 | B A A | . A A | . A A | 4 | B . A | . . A | . C A | 5
from user data :
with the values contained within the lifeStage,
- resources and tolerance columns, if provided
-## Create a skeleton folder with the default name ('FATE_simulation')
-PRE_FATE.skeletonDirectory()
-
-
-## Create PFG light parameter files (with strategies) ----------------------------------------
-mat.ag = data.frame(PFG = paste0('PFG', 1:6)
- , type = c('C', 'C', 'H', 'H', 'P', 'P')
- , strategy_ag = c('shade_lover', 'indifferent'
- , 'indifferent', 'shade_lover'
- , 'light_lover', 'light_lover'))
-
-mat.tol = data.frame(PFG = paste0('PFG', 1:6)
- , strategy_tol = c('undergrowth', 'ubiquist'
- , 'ubiquist', 'semi_shade'
- , 'pioneer', 'full_light'))
-
-PRE_FATE.params_PFGlight(name.simulation = 'FATE_simulation'
- , mat.PFG.light = mat.ag
- , mat.PFG.tol = mat.tol)
-
-
-## Create PFG light parameter files (with all values) ----------------------------------------
-mat.ag = data.frame(PFG = paste0('PFG', 1:6)
- , shade_factor = c(5, 3, 1, 1, 12, 18)
- , active_germ_low = c(90, 80, 80, 80, 50, 50)
- , active_germ_medium = rep(80, 6)
- , active_germ_high = c(40, 80, 80, 50, 90, 90))
-
-mat.tol = expand.grid(resources = c('Low', 'Medium', 'High')
- , lifeStage = c('Germinant', 'Immature', 'Mature')
- , PFG = paste0('PFG', 1:6))
-mat.tol$tolerance = c(100, 100, 0, 100, 0, 0, 100, 0, 0
- , rep(100, 9)
- , rep(100, 9)
- , 100, 100, 100, 100, 100, 100, 100, 0, 0
- , 100, 100, 100, 0, 100, 100, 0, 0, 100
- , 100, 100, 100, 0, 0, 100, 0, 0, 100)
-
-PRE_FATE.params_PFGlight(name.simulation = 'FATE_simulation'
- , mat.PFG.light = mat.ag
- , mat.PFG.tol = mat.tol)
-
-
-## -------------------------------------------------------------------------------------------
-
-## Load example data
-Champsaur_params = .loadData('Champsaur_params', 'RData')
-
-## Create a skeleton folder
-PRE_FATE.skeletonDirectory(name.simulation = 'FATE_Champsaur')
-
-
-## PFG traits for light
-tab.light = Champsaur_params$tab.LIGHT
-str(tab.light)
-
-## Create PFG light parameter files ----------------------------------------------------------
-PRE_FATE.params_PFGlight(name.simulation = 'FATE_Champsaur'
- , mat.PFG.light = tab.light[, c('PFG', 'type')]
- , mat.PFG.tol = tab.light[, c('PFG', 'strategy_tol')])
-
-FATE simulationR/PRE_FATE.params_PFGsoil.R
- PRE_FATE.params_PFGsoil.RdThis script is designed to create parameter files containing
-soil contribution and tolerance for each PFG (one file for each of them)
-used in the soil module of FATE.
PRE_FATE.params_PFGsoil(
- name.simulation,
- mat.PFG.soil,
- mat.PFG.tol = NULL,
- opt.folder.name = NULL
-)a string corresponding to the main directory
-or simulation name of the FATE simulation
a data.frame with 3 to 7 columns :
PFG,
type, (or active_germ_low,
- active_germ_medium, active_germ_high) (or
- strategy_ag)
soil_contrib, soil_tol_min, soil_tol_max
- (or strategy_contrib)
(see Details)
(optional)
-a data.frame with 2 to 4 columns :
PFG,
lifeStage, resources, tolerance
- (or strategy_tol)
(see Details)
(optional)
a string corresponding
-to the name of the folder that will be created into the
-name.simulation/DATA/PFGS/SOIL/ directory to store the results
A .txt file per PFG into the
-name.simulation/DATA/PFGS/SOIL/ directory with the following
-parameters :
name of the PFG
germination rates depending on soil conditions
-
(integer between 0 and 100%)
contribution to the soil value of the pixel
lower value of soil supported by the PFG,
- defining the limit between Low and Medium soil resources
- for this PFG
upper value of soil supported by the PFG,
- defining the limit between Medium and High soil resources
- for this PFG
soil tolerance table (in a single row).
- This is a vector of 9 numbers corresponding to the ability of the PFG to
- survive or not :
at different life stages (Germinant (Ge), Immature
- (Im), Mature (Ma))
under different soil conditions (Low (L), Medium
- (M) or High (H)).
These parameters should be given in this order : GeL, GeM, GeH, ImL,
- ImM, ImH, MaL, MaM, MaH
-
(integer between 0 and 100%).
-
A SOIL_COMPLETE_TABLE.csv file summarizing information for all
-groups into the name.simulation/DATA/PFGS/ directory.
If the opt.folder.name has been used, the files will be into the
-folder name.simulation/DATA/PFGS/SOIL/opt.folder.name/.
The soil module allows the user to add the effect of
-soil interaction within a primary vegetation succession.
Several parameters, given within mat.PFG.soil or mat.PFG.tol,
-are required for each PFG in order to set up the soil interaction :
the concerned plant functional group
or life-form, based on Raunkier.
It should be either
- H (herbaceous), C (chamaephyte) or P (phanerophyte)
- for now
an integer between 0 and
- 100 corresponding to the proportion of seeds that will germinate for
- Low soil condition
an integer between 0 and
- 100 corresponding to the proportion of seeds that will germinate for
- Medium soil condition
an integer between 0 and
- 100 corresponding to the proportion of seeds that will germinate for
- High soil condition
a string to choose the germination
- strategy : poor_lover, indifferent, rich_lover
-
a value corresponding to the PFG preference for soil
- fertility
(e.g. nitrogen value from Ellenberg or Flora Indicativa)
the minimum soil value tolerated by the PFG (on the
- same scale than soil_contrib)
the maximum soil value tolerated by the PFG (on the
- same scale than soil_contrib)
a string to choose the
- contribution strategy : oligotrophic, mesotrophic,
- eutrophic
the concerned life stage (Germinant,
- Immature, Mature)
the concerned soil condition (Low,
- Medium, High)
an integer between 0 and 100
- corresponding to the proportion of surviving individuals
a string to choose the tolerance
- strategy : poor_lover, ubiquist, rich_lover
-
These values will allow to calculate or define a set of characteristics for -each PFG :
-proportion of seeds that will germinate for each soil
- condition (Low, Medium, High)
- Three methods to define these proportions are available :
from predefined scenarios (using strategy_ag) : | _L_ _M_ _H_ | _______________ | 80% 90% 50% | poor_lover | 90% 90% 90% | indifferent | 50% 90% 80% | rich_lover
from predefined rules (using type) :
for H (herbaceous) : 80%, 100%, 50%
for C (chamaephyte) or P (phanerophyte) :
- 90%, 100%, 90%
from user data :
with the values contained within the active_germ_low,
- active_germ_medium and active_germ_high columns, if
- provided
Two methods to define these values are available :
from predefined scenarios (using
- strategy_contrib) :
the values give the soil_tol_min, soil_contrib
- and soil_tol_max
with L: low soil, M: medium soil, H:
- high soil
| ___ L ___ | ___ M ___ | ___ H ___ | _____________________________________ __________ 1 ___ 1.5 ___ 2 __________ oligotrophic __________ 1.5 _ 2.5 _ 4.5 __________ mesotrophic __________ 3 ____ 4 ____ 5 __________ eutrophic
from user data :
with the values contained within the soil_contrib,
- soil_tol_min and soil_tol_max columns, if provided
defined for each life stage (Germinant,
- Immature, Mature)
and each soil condition (Low,
- Medium, High)
- Three methods to define these tolerances are available :
from predefined scenarios (using
- strategy_tol) :
the values give the percentage of surviving individuals to the - concerned conditions
with g: Germinant, i: Immature, m: Mature
with L: low soil, M: medium soil, H:
- high soil
| _____ g ____ | _____ i ____ | _____ m ____ | | _L__ _M_ _H_ | _L__ _M_ _H_ | _L__ _M_ _H_ | ______________________________________________ | 30% 100% 10% | 60% 100% 40% | 90% 100% 70% | poor_lover | 90% 100% 80% | 90% 100% 80% | 90% 100% 80% | ubiquist | 10% 100% 30% | 40% 100% 60% | 70% 100% 90% | rich_lover
from predefined rules (corresponding to the
- poor_lover strategy) :
germinants are severely impacted by wrong soil conditions
immatures are half impacted by wrong soil conditions
matures are little impacted by wrong soil conditions
for all life stages, not enough is better than too much
the values give the percentage of surviving individuals to the - concerned conditions
with g: Germinant, i: Immature, m: Mature
with L: low soil, M: medium soil, H:
- high soil
| _____ g ____ | _____ i ____ | _____ m ____ | | _L__ _M_ _H_ | _L__ _M_ _H_ | _L__ _M_ _H_ | ______________________________________________ | 30% 100% 10% | 60% 100% 40% | 90% 100% 70% |
from user data :
with the values contained within the lifeStage,
- resources and tolerance columns, if provided
-
-## Create a skeleton folder with the default name ('FATE_simulation')
-PRE_FATE.skeletonDirectory()
-
-## Create PFG soil parameter files (with strategies) -----------------------------------------
-tab.soil = data.frame(PFG = paste0('PFG', 1:6)
- , strategy_ag = c('rich_lover', 'indifferent' , 'indifferent'
- , 'rich_lover', 'indifferent', 'poor_lover')
- , strategy_contrib = c('eutrophic', 'mesotrophic', 'mesotrophic'
- , 'mesotrophic', 'mesotrophic', 'oligotrophic'))
-tab.tol = data.frame(PFG = paste0('PFG', 1:6)
- , strategy_tol = c('rich_lover', 'ubiquist', 'poor_lover'
- , 'ubiquist', 'poor_lover', 'poor_lover'))
-
-PRE_FATE.params_PFGsoil(name.simulation = 'FATE_simulation'
- , mat.PFG.soil = tab.soil
- , mat.PFG.tol = tab.tol)
-
-
-## Create PFG soil parameter files (with all values) -----------------------------------------
-tab.soil = data.frame(PFG = paste0('PFG', 1:6)
- , active_germ_low = c(50, 80, 80, 60, 80, 80)
- , active_germ_medium = rep(90, 6)
- , active_germ_high = c(90, 80, 80, 90, 80, 40)
- , strategy_contrib = c('eutrophic', 'mesotrophic', 'mesotrophic'
- , 'mesotrophic', 'mesotrophic', 'oligotrophic'))
-tab.tol = expand.grid(resources = c('Low', 'Medium', 'High')
- , lifeStage = c('Germinant', 'Immature', 'Mature')
- , PFG = paste0('PFG', 1:6))
-tab.tol$tolerance = c(80, 80, 40, 80, 50, 40, 90, 40, 40
- , rep(90, 9)
- , rep(90, 9)
- , 80, 80, 60, 80, 60, 60, 90, 50, 50
- , 80, 80, 80, 50, 60, 90, 30, 40, 90
- , 80, 80, 80, 50, 50, 90, 50, 50, 90)
-
-PRE_FATE.params_PFGsoil(name.simulation = 'FATE_simulation'
- , mat.PFG.soil = tab.soil
- , mat.PFG.tol = tab.tol)
-
-
-## -------------------------------------------------------------------------------------------
-
-## Load example data
-Champsaur_params = .loadData('Champsaur_params', 'RData')
-
-## Create a skeleton folder
-PRE_FATE.skeletonDirectory(name.simulation = 'FATE_Champsaur')
-
-
-## PFG traits for light
-tab.soil = Champsaur_params$tab.SOIL
-str(tab.soil)
-
-## Create PFG soil parameter files -----------------------------------------------------------
-PRE_FATE.params_PFGsoil(name.simulation = 'FATE_Champsaur'
- , mat.PFG.soil = tab.soil)
-FATE simulationR/PRE_FATE.params_PFGsuccession.R
- PRE_FATE.params_PFGsuccession.RdThis script is designed to create parameter files containing
-succession parameters for each PFG (one file for each of them) used in the
-core module of FATE.
PRE_FATE.params_PFGsuccession(
- name.simulation,
- mat.PFG.succ,
- strata.limits = c(0, 20, 50, 150, 400, 1000, 2000, 5000, 10000),
- strata.limits_reduce = TRUE,
- opt.folder.name = NULL
-)a string corresponding to the main directory
-or simulation name of the FATE simulation
a data.frame with at least 5 columns : PFG, type, height, maturity, longevity
-
(and optionally, max_abundance, potential_fecundity,
-immature_size, is_alien, flammability)
-
(see Details)
a vector of integer containing values
-among which height strata limits will be chosen
default TRUE.
If TRUE, stratum
-height limits are checked to try and bring several PFGs together in a same
-stratum
(optional)
a string corresponding
-to the name of the folder that will be created into the
-name.simulation/DATA/PFGS/SUCC/ directory to store the results
A .txt file per PFG into the
-name.simulation/DATA/PFGS/SUCC/ directory with the following
-parameters :
name of the PFG
PFG life-form (H: herbaceous C:
- chamaephyte P: phanerophyte)
PFG maximum height (in cm)
PFG maturity age (in years)
PFG life span (in years)
maximum height stratum that the PFG can reach
maximum abundance / space (quantitative) that the
- PFG is able to produce / occupy
(1: Low 2:
- Medium 3: High)
PFG immature relative size (integer between 0
- and 100%)
ages at which the PFG goes in the upper stratum
-
(in years, put a value higher than the PFG life span if it is
- not supposed to rise a stratum)
maximum number of years seeds are able to survive - (for active and dormant pool)
are the seeds dormant or not (0: No
- 1: Yes)
maximum number of seeds produced by the - PFG
is the PFG an alien or not (0: No 1:
- Yes)
how easily the PFG burns (numeric)
-
A SUCC_COMPLETE_TABLE.csv file summarizing information for all
-groups into the name.simulation/DATA/PFGS/ directory.
This file can be used to parameterize the disturbance files (see
-PRE_FATE.params_PFGdisturbance).
If the opt.folder.name has been used, the files will be into the
-folder name.simulation/DATA/PFGS/SUCC/opt.folder.name/.
The core module of FATE allows the user to simulate a
-primary vegetation succession based on a demography model.
Several parameters, given within mat.PFG.succ, are required for
-each PFG in order to set up this life cycle :
or life-form, based on Raunkier.
It should be either
- H (herbaceous), C (chamaephyte) or P (phanerophyte)
- for now
the maximum or average height that reach the PFG
the age from which the PFG can reproduce
the maximum or average lifespan of the PFG
the maximum abundance of mature PFG
the maximum number of seeds produced
- by the PFG
(otherwise the value is given within the global parameter
- file, see PRE_FATE.params_globalParameters)
the relative size of immature versus mature - plants
if the PFG is to be considered as an alien
- (1) or not (0)
how easily the PFG burns
These values will allow to calculate or define a set of characteristics for -all PFG :
-= height values that define each stratum.
- Two methods to define these limits are available :
from predefined rules (using strata.limits_reduce
- = TRUE, strata.limits, height) :
limits should go exponentially and are selected among
- strata.limits
PFG are separated according to these strata.limits and
- then grouped making sure to have
- $$\text{number of PFG per stratum} \geq \sqrt{\text{total number
- of PFG}} - 2$$
- to try to homogenize the number of PFG within each stratum.
from user data : (using strata.limits_reduce =
- FALSE)
with the values contained within the strata.limits
- column, if provided
and a set of characteristics for each PFG :
-= maximum stratum that each PFG can reach
= maximum abundance of mature PFG
- = It can be seen as a proxy of maximum carrying capacity for mature
- individuals
(and therefore as a broad proxy of the amount
- of space a PFG can occupy within a pixel (herbaceous should be more
- numerous than phanerophytes).
- Two methods to define these abundances are available :
from predefined rules (using type,
- MAX_STRATUM) :
| MAX_STRATUM | 1 | 2 | 3 | + |
H (herbaceous) | 3 | 3 | 2 | 2 |
C (chamaephyte) | 3 | 2 | 2 | 1 |
P (phanerophyte) | 3 | 2 | 1 | 1 |
from user data :
with the values contained within the max_abundance
- column, if provided
= relative size of immature versus mature plants
- = for example, immature herbaceous take as much space as mature
- herbaceous, while immature phanerophytes take less space (and
- contribute to shade half less) than mature individuals
- Two methods to define these sizes are available :
from predefined rules (using type, MAX_STRATUM)
- :
| MAX_STRATUM | 1 | 2 | 3 | + |
H (herbaceous) | 100% | 80% | 50% | 50% |
C (chamaephyte) | 100% | 50% | 50% | 50% |
P (phanerophyte) | 50% | 50% | 50% | 10% |
from user data :
with the values contained within the immature_size
- column, if provided
= at what age each PFG goes into the upper stratum
-
It is defined using a logistic growth curve with 2 points to
- parameterize it :
at \(age = \text{maturity}/2\), \(height = \text{IMM_SIZE} * \text{height}\)
at \(age = \text{longevity}\), \(height = \text{height}\)
= maximum number of seeds produced by the PFG
-
- Two methods to define this number are available :
from predefined rules : same value for all PFG, given
- within the global parameter file
(see
- PRE_FATE.params_globalParameters)
from user data :
with the values contained within the potential_fecundity
- column, if provided
= if the PFG is to be considered as an alien (1) or
- not (0)
= how easily the PFG burns
-## Create a skeleton folder with the default name ('FATE_simulation')
-PRE_FATE.skeletonDirectory()
-
-## Create PFG succession parameter files -----------------------------------------------------
-tab.succ = data.frame(PFG = paste0('PFG', 1:6)
- , type = c('C', 'C', 'H', 'H', 'P', 'P')
- , height = c(10, 250, 36, 68, 1250, 550)
- , maturity = c(5, 5, 3, 3, 8, 9)
- , longevity = c(12, 200, 25, 4, 110, 70))
-PRE_FATE.params_PFGsuccession(name.simulation = 'FATE_simulation'
- , mat.PFG.succ = tab.succ)
-
-
-## Create PFG succession parameter files (with immature_size) --------------------------------
-tab.succ = data.frame(PFG = paste0('PFG', 1:6)
- , type = c('C', 'C', 'H', 'H', 'P', 'P')
- , height = c(10, 250, 36, 68, 1250, 550)
- , maturity = c(5, 5, 3, 3, 8, 9)
- , longevity = c(12, 200, 25, 4, 110, 70)
- , immature_size = c(100, 80, 100, 100, 10, 50))
-PRE_FATE.params_PFGsuccession(name.simulation = 'FATE_simulation'
- , mat.PFG.succ = tab.succ)
-
-
-## -------------------------------------------------------------------------------------------
-
-
-## Load example data
-Champsaur_params = .loadData('Champsaur_params', 'RData')
-
-## Create a skeleton folder
-PRE_FATE.skeletonDirectory(name.simulation = 'FATE_Champsaur')
-
-
-
-## PFG traits for succession
-tab.succ = Champsaur_params$tab.SUCC
-str(tab.succ)
-
-## Create PFG succession parameter files -----------------------------------------------------
-PRE_FATE.params_PFGsuccession(name.simulation = 'FATE_Champsaur'
- , mat.PFG.succ = tab.succ)
-
-## Create PFG succession parameter files (fixing strata limits) ------------------------------
-PRE_FATE.params_PFGsuccession(name.simulation = 'FATE_Champsaur'
- , mat.PFG.succ = tab.succ
- , strata.limits = c(0, 20, 50, 150, 400, 1000, 2000)
- , strata.limits_reduce = FALSE)
-
-FATE
-simulationR/PRE_FATE.params_changingYears.R
- PRE_FATE.params_changingYears.RdThis script is designed to create several parameter files to -manage the update of simulation maps : 1) simulation years at which the -maps should be changed ; 2) filenames corresponding to the new simulation -maps to be used.
-PRE_FATE.params_changingYears(
- name.simulation,
- type.changing,
- mat.changing,
- opt.folder.name = NULL
-)a string corresponding to the main directory
-or simulation name of the FATE simulation
a string to choose the concerned module :
MASK (succession),
HABSUIT (habitat suitability),
DIST (disturbances),
DROUGHT (drought disturbance),
ALIENS or ALIENS_F (aliens introduction, masks or
- frequencies)
FIRE or FIRE_F (fire disturbance, masks or
- frequencies)
a data.frame with 3 columns : year,
-order, new.value
(optional)
a string corresponding
-to the name of the folder that will be created into the
-name.simulation/DATA/SCENARIO/ directory to store the results
Several .txt files into the
-name.simulation/DATA/SCENARIO/ :
..type.changing...changingmask_years.txt : one line for each
- simulation year
..type.changing...changingmask_files_t..year...txt :
- one line for each new raster file
OR
..type.changing...changingfreq_years.txt : one line for each
- simulation year
..type.changing...changingfreq_files_t..year...txt :
- one line for each new frequency
If the opt.folder.name has been used, the files will be into the folder
-name.simulation/DATA/SCENARIO/opt.folder.name/.
Several modules of the FATE software allow the user to simulate
-changes over time :
the core module is based on a raster mask given
- within the Simul_parameters file with the MASK flag (see
- PRE_FATE.params_simulParameters), with either
- 0 or 1 within each pixel, 1 corresponding to the
- cells in which the PFG can try to colonize. The available pixels can
- change through time, to simulate habitat loss (e.g. urbanization) or gain
- (e.g. glacial retreat).
if this module is activated (see
- PRE_FATE.params_globalParameters), PFG colonization depends
- on maps given for each PFG within the Simul_parameters file with
- the PFG_HAB_MASK flag (see
- PRE_FATE.params_simulParameters).
These maps must
- contain values between 0 and 1 corresponding to the
- probability of presence of the PFG in each pixel. These probabilities
- can change through time, as they often come from Species Distribution
- Models (SDM) that can be based for example on climatic variables (e.g.
- simulating regional warming).
if this module is activated (see
- PRE_FATE.params_globalParameters), each disturbance relies
- on a raster given within the Simul_parameters file with the
- DIST_MASK flag (see PRE_FATE.params_simulParameters).
-
As for succession, this mask is filled with either 0
- or 1 to define where the perturbation occurs. The impacted pixels
- can also change through time (e.g. change in forestry practices, expansion
- of grazing areas, etc).
if this module is activated (see
- PRE_FATE.params_globalParameters), drought disturbance
- relies on a raster given within the Simul_parameters file with the
- DROUGHT_MASK flag (see
- PRE_FATE.params_simulParameters).
-
This map contains values defining the drought intensity experienced by
- the area. This intensity can change through time and space (e.g. regional
- warming, extreme years, change in agriculture practices that can leave a
- place more exposed, etc).
if this module is activated (see
- PRE_FATE.params_globalParameters), aliens introduction
- depends on maps given for each alien within the Simul_parameters
- file with the PFG_ALIENS_MASK flag (see
- PRE_FATE.params_simulParameters).
-
As for succession, these masks are filled with either 0
- or 1 to define where the introductions occur. The impacted pixels
- can also change through time (e.g. colonization, eradication campaign,
- etc), as well as the frequencies of introduction (see ALIENS_FREQ
- flag in PRE_FATE.params_globalParameters).
if this module is activated (see
- PRE_FATE.params_globalParameters), fire disturbance
- can rely on a raster given within the Simul_parameters file with
- the FIRE_MASK flag (see
- PRE_FATE.params_simulParameters).
- As for succession, this mask is filled with either 0
- or 1 to define where the perturbation occurs. The impacted pixels
- can also change through time (e.g. change in forestry practices, expansion
- of drought events, etc), as well as the frequencies of perturbations (see
- FIRE_FREQ flag in PRE_FATE.params_globalParameters).
-
Several parameters, given within mat.changing, are required to set up
-these temporal changes :
all simulation years at which the raster files of a specific
- module (succession MASK, habitat suitability HABSUIT,
- disturbance DIST, drought DROUGHT, aliens introduction
- ALIENS or ALIENS_F, fire FIRE or FIRE_F) will
- be changed
the names of the new raster files for each year of
- change. It can be either .img or .tif.
- There is an exception if ALIENS_F or FIRE_F is selected :
- the values should be integer representing the frequencies of aliens
- introduction or fire perturbations.
an integer associated to each new map in order to
- always give the raster maps in the same order throughout the years
-## Create a skeleton folder with the default name ('FATE_simulation') ------------------------
-PRE_FATE.skeletonDirectory()
-
-tab.changing = data.frame(year = c(50,50,80,80)
- , order = c(1,2,1,2)
- , new.value = c('FATE_simulation/DATA/MASK/MASK_DIST1_50.tif'
- , 'FATE_simulation/DATA/MASK/MASK_DIST2_50.tif'
- , 'FATE_simulation/DATA/MASK/MASK_DIST1_80.tif'
- , 'FATE_simulation/DATA/MASK/MASK_DIST2_80.tif'))
-
-## Create a Changing_times parameter file ----------------------------------------------------
-PRE_FATE.params_changingYears(name.simulation = 'FATE_simulation'
- , type.changing = 'DIST'
- , mat.changing = tab.changing)
-FATE
-simulationR/PRE_FATE.params_globalParameters.R
- PRE_FATE.params_globalParameters.RdThis script is designed to create parameter file(s)
-containing GLOBAL PARAMETERS used in FATE model.
PRE_FATE.params_globalParameters(
- name.simulation,
- opt.global.name = NULL,
- opt.no_CPU = 1,
- opt.replacePrevious = FALSE,
- opt.saving_abund_PFG_stratum = TRUE,
- opt.saving_abund_PFG = TRUE,
- opt.saving_abund_stratum = FALSE,
- required.no_PFG,
- required.no_strata,
- required.simul_duration = 1000,
- required.seeding_duration = 300,
- required.seeding_timestep = 1,
- required.seeding_input = 100,
- required.potential_fecundity = 100,
- required.max_abund_low,
- required.max_abund_medium,
- required.max_abund_high,
- doLight = FALSE,
- LIGHT.thresh_medium,
- LIGHT.thresh_low,
- LIGHT.recruit = TRUE,
- LIGHT.saving = TRUE,
- doSoil = FALSE,
- SOIL.fill_map = TRUE,
- SOIL.init,
- SOIL.retention,
- SOIL.recruit = TRUE,
- SOIL.saving = TRUE,
- doDispersal = FALSE,
- DISPERSAL.mode = 1,
- DISPERSAL.saving = FALSE,
- doHabSuitability = FALSE,
- HABSUIT.mode = 1,
- doDisturbances = FALSE,
- DIST.no,
- DIST.no_sub = 4,
- DIST.freq = 1,
- doDrought = FALSE,
- DROUGHT.no_sub = 4,
- doAliens = FALSE,
- ALIEN.freq = 1,
- doFire = FALSE,
- FIRE.no,
- FIRE.no_sub = 4,
- FIRE.freq = 1,
- FIRE.ignit_mode = 1,
- FIRE.ignit_no,
- FIRE.ignit_noHist,
- FIRE.ignit_logis = c(0.6, 2.5, 0.05),
- FIRE.ignit_flammMax,
- FIRE.neigh_mode = 1,
- FIRE.neigh_CC = c(2, 2, 2, 2),
- FIRE.prop_mode = 1,
- FIRE.prop_intensity,
- FIRE.prop_logis = c(0.6, 2.5, 0.05),
- FIRE.quota_mode = 4,
- FIRE.quota_max
-)a string corresponding to the main directory
-or simulation name of the FATE simulation
(optional) default NULL
-a string corresponding to the name of the global parameter file to
-be created
(optional) default 1.
an integer
-corresponding to the number of resources that can be used to parallelize
-the FATE simulation
(optional) default FALSE.
-If TRUE, pre-existing files inside
-name.simulation/DATA/GLOBAL_PARAMETERS folder will be replaced
(optional) default TRUE.
-
If TRUE, and saving years have been defined within the
-Simul_parameters file with the SAVING_YEARS_MAPS flag,
-pixel abundances per PFG per stratum are saved
(optional) default TRUE.
-
If TRUE, and saving years have been defined within the
-Simul_parameters file with the SAVING_YEARS_MAPS flag,
-pixel abundances per PFG are saved
(optional) default TRUE.
-
If TRUE, and saving years have been defined within the
-Simul_parameters file with the SAVING_YEARS_MAPS flag,
-pixel abundances per stratum are saved
an integer corresponding to the number of PFG
an integer corresponding to the number of
-height strata
an integer corresponding to the
-duration of simulation (in years)
an integer corresponding to the
-duration of seeding (in years)
an integer corresponding to the
-time interval at which occurs the seeding, and until the seeding duration
-is not over (in years)
an integer corresponding to the number
-of seeds attributed to each PFG at each time step, and until the seeding
-duration is not over
an integer corresponding to the
-maximum number of seeds produced each year by a PFG (it can also be
-specified within PFG succession files (see
-PRE_FATE.params_PFGsuccession)
-otherwise this value will be used)
an integer in the order of
-1 000 to rescale abundance values of tall PFG
an integer in the order of
-1 000 to rescale abundance values of intermediate PFG
an integer in the order of
-1 000 to rescale abundance values of small PFG
default FALSE.
If TRUE, light interaction
-is activated in the FATE simulation, and associated parameters are
-required
(optional)
an integer in the
-order of 1 000 to convert PFG abundances in each stratum into light
-resources. It corresponds to the limit of abundances above which light
-resources are medium. PFG abundances lower than this threshold imply
-high amount of light. It is consequently lower than
-LIGHT.thresh_low.
(optional)
an integer in the order
-of 1 000 to convert PFG abundances in each strata into light
-resources. It corresponds to the limit of abundances above which light
-resources are low. PFG abundances higher than
-LIGHT.thresh_medium and lower than this threshold imply
-medium amount of light.
(optional) default TRUE.
-
If TRUE, recruitment is depending on the tolerance of the PFG to
-the pixel light resources within the stratum 0
(optional) default TRUE.
-
If TRUE, and saving years have been defined within the
-Simul_parameters file with the SAVING_YEARS_MAPS flag,
-pixel light resources are saved
default FALSE.
If TRUE, soil interaction is
-activated in the FATE simulation, and associated parameters
-are required
(optional) default TRUE.
-
If TRUE, soil initialization map is filled with SOIL.init
-value ; if FALSE, soil initialization map is defined within the
-Simul_parameters file with the SOIL_MASK flag
(optional)
a double corresponding to the
-soil value to initialize all pixels when starting the FATE
-simulation
(optional)
a double corresponding
-to the percentage of soil value of the previous simulation year that will
-be kept in the calculation of the soil value of the current simulation year
(optional) default TRUE.
-
If TRUE, recruitment is depending on the tolerance of the PFG to
-the pixel soil resources
(optional) default TRUE.
-
If TRUE, and saving years have been defined within the
-Simul_parameters file with the SAVING_YEARS_MAPS flag,
-pixel soil resources are saved
default FALSE.
If TRUE, seed dispersal
-is activated in the FATE simulation, and associated parameters are
-required
(optional)
an integer corresponding
-to the way of simulating the seed dispersal for each PFG, either packets
-kernel (1), exponential kernel (2) or exponential kernel with
-probability (3)
(optional) default TRUE.
-
If TRUE, and saving years have been defined within the
-Simul_parameters file with the SAVING_YEARS_MAPS flag,
-pixel dispersed seeds per PFG are saved
default FALSE.
If TRUE, habitat
-suitability is activated in the FATE simulation, and associated
-parameters are required
(optional)
an integer
-corresponding to the way of simulating the habitat suitability variation
-between years for each PFG, either random (1) or PFG specific
-(2)
default FALSE.
If TRUE, disturbances
-are applied in the FATE simulation, and associated parameters are
-required
(optional)
an integer corresponding to the
-number of disturbances
(optional)
an integer corresponding to
-the number of way a PFG could react to a disturbance
(optional)
a vector of integer
-corresponding to the frequency of each disturbance (in years)
default FALSE.
If TRUE, drought
-disturbances are applied in the FATE simulation, and associated
-parameters are required
(optional)
an integer corresponding
-to the number of way a PFG could react to a drought disturbance
default FALSE.
If TRUE, invasive plant
-introduction is activated in the FATE simulation, and associated
-parameters are required
(optional)
a vector of integer
-corresponding to the frequency of each introduction (in years)
default FALSE.
If TRUE, fire
-disturbances are applied in the FATE simulation, and associated
-parameters are required
(optional)
an integer corresponding to the
-number of fire disturbances
(optional)
an integer corresponding to
-the number of way a PFG could react to a fire disturbance
(optional)
a vector of integer
-corresponding to the frequency of each fire disturbance (in years)
(optional)
an integer
-corresponding to the way of simulating the fire(s) ignition each year,
-either random (1, 2 or 3), according to cell conditions
-(4) or through a map (5)
(optional) (required if
-FIRE.ignit_mode = 1 or 2)
an integer corresponding to the
-number of fires starting each year
(optional) (required if
-FIRE.ignit_mode = 3)
a vector of integer
-corresponding to historical number of fires
(optional) (required if
-FIRE.ignit_mode = 4)
a vector of 3 values to parameterize
-the logistic probability function :
asymptote of the function curve
time where the slope starts to increase
speed of slope increase
(optional) (required if
-FIRE.ignit_mode = 4)
an integer corresponding to the
-maximum flammmability of PFG
(optional)
an integer
-corresponding to the way of finding neighboring cells each year,
-either 8 adjacent (1) or with cookie cutter (2 or 3)
(optional) (required if
-FIRE.neigh_mode = 2 or 3)
a vector of 4 values
-corresponding to the extent of cookie cutter :
number of cells towards north
number of cells towards east
number of cells towards south
number of cells towards west
(optional)
an integer
-corresponding to the way of simulating the fire(s) propagation each year,
-either fire intensity (1), % of plants consumed (2), maximum
-amount of resources (3 or 4), or according to cell conditions
-(5)
(optional) (required if
-FIRE.prop_mode = 1)
a vector of double
-corresponding to the intensity or probability of dispersal of each fire
-disturbance (between 0 and 1)
(optional) (required if
-FIRE.prop_mode = 5)
a vector of 3 values to parameterize
-the logistic probability function :
asymptote of the function curve
time where the slope starts to increase
speed of slope increase
(optional)
an integer
-corresponding to the way of ending the fire(s) spread each year,
-either maximum steps (1), maximum amount of resources (2),
-maximum cells (3), or keep going (4)
(optional) (required if
-FIRE.quota_mode = 1, 2 or 3)
an integer corresponding to
-the maximum quantity limit (either steps, resources, cells)
A .txt file into the
-name.simulation/DATA/GLOBAL_PARAMETERS directory with the following
-parameters :
NO_CPU
SAVING_ABUND_PFG_STRATUM
SAVING_ABUND_PFG
SAVING_ABUND_STRATUM
NO_PFG
NO_STRATA
SIMULATION_DURATION
SEEDING_DURATION
SEEDING_TIMESTEP
SEEDING_INPUT
POTENTIAL_FECUNDITY
MAX_ABUND_LOW
MAX_ABUND_MEDIUM
MAX_ABUND_HIGH
If the simulation includes light interaction :
- - -DO_LIGHT_INTERACTION
LIGHT_THRESH_MEDIUM
LIGHT_THRESH_LOW
LIGHT_RECRUITMENT
LIGHT_SAVING
If the simulation includes soil interaction :
- - -DO_SOIL_INTERACTION
SOIL_FILL_MAP
SOIL_INIT
SOIL_RETENTION
SOIL_RECRUITMENT
SOIL_SAVING
If the simulation includes dispersal :
- - -DO_DISPERSAL
DISPERSAL_MODE
DISPERSAL_SAVING
If the simulation includes habitat suitability :
- - -DO_HAB_SUITABILITY
HABSUIT_MODE
If the simulation includes disturbances :
- - -DO_DISTURBANCES
DIST_NO
DIST_NOSUB
DIST_FREQ
If the simulation includes drought disturbance :
- - -DO_DROUGHT_DISTURBANCE
DROUGHT_NOSUB
If the simulation includes aliens introduction :
- - -DO_ALIENS_INTRODUCTION
ALIENS_FREQ
If the simulation includes fire disturbance :
- - -DO_FIRE_DISTURBANCE
FIRE_NO
FIRE_NOSUB
FIRE_FREQ
FIRE_IGNIT_MODE
FIRE_IGNIT_NO
FIRE_IGNIT_NOHIST
FIRE_IGNIT_LOGIS
FIRE_IGNIT_FLAMMMAX
FIRE_NEIGH_MODE
FIRE_NEIGH_CC
FIRE_PROP_MODE
FIRE_PROP_INTENSITY
FIRE_PROP_LOGIS
FIRE_QUOTA_MODE
FIRE_QUOTA_MAX
The core module of FATE requires several parameters to
-define general characteristics of the simulation :
the number of plant functional groups that will be
- included into the simulation.
This number should match with the
- number of files that will be given to parameterize the different
- activated modules with the characteristics of each group (SUCC,
- DISP, ...).
the number of height strata that will be used into the
- succession module.
This number should match with the maximum number
- of strata possible defined into the PFG SUCC files.
the number of seeds produced each year by
- each mature individual.
Maximal number of seeds produced per pixel
- is limited by PFG maximum abundance, meaning that maximum fecundity
- per PFG per pixel is equal to
- \(MaxAbund * \text{required.potential_fecundity}\)
abundance regulation thresholds for
- tall / intermediate / small PFG within a pixel (in `FATE` arbitrary
- abundance units).
- Each PFG is assigned with one of these 3 values (see
- PRE_FATE.params_PFGsuccession) to be a broad proxy of the
- amount of space it can occupy within a pixel (herbaceous should be more
- numerous than phanerophytes). These thresholds help regulate the PFG
- fecundity :
- $$fecundity = min(matAbund, MaxAbund) * \text{required.potential_fecundity}$$
- and recruitment happens only if :
- $$totAbund < MaxAbund * (1 + ImmSize)$$
the duration of simulation (in years)
the duration of seeding (in years)
the time interval at which occurs the seeding, - and until the seeding duration is not over (in years)
the number of seeds dispersed for each PFG at each
- time step, and until the seeding duration is not over
The other modules of FATE can be activated within this
-file, and if so, some additional parameters will be required :
= to influence seed recruitment and plant mortality according
- to PFG preferences for light conditions
(see
- PRE_FATE.params_PFGlight)
- = light resources are calculated as a proxy of PFG abundances within each
- height stratum
- To transform PFG abundances into light resources :
- $$abund_{\text{ PFG}_{all}\text{, }\text{Stratum}_k} <
- \text{LIGHT.thresh_medium} \;\; \Leftrightarrow \;\;
- light_{\text{ Stratum}_k} = \text{High}$$
$$\text{LIGHT.thresh_medium } < - abund_{\text{ PFG}_{all}\text{, }\text{Stratum}_k} < - \text{LIGHT.thresh_low} \\ \Leftrightarrow \;\; - light_{\text{ Stratum}_k} = \text{Medium}$$
-$$abund_{\text{ PFG}_{all}\text{, }\text{Stratum}_k} >
- \text{LIGHT.thresh_low} \;\; \Leftrightarrow \;\;
- light_{\text{ Stratum}_k} = \text{Low}$$
- As light resources are directly obtained from PFG abundances,
- LIGHT.thresh_medium and LIGHT.thresh_low parameters should
- be on the same scale than required.max_abund_low,
- required.max_abund_medium and required.max_abund_high
- parameters from the core module.
= to influence seed recruitment and plant mortality
- according to PFG preferences for soil conditions
(see
- PRE_FATE.params_PFGsoil)
- = soil composition is calculated as the weighted mean of each PFG's
- contribution with a possible retention of the soil value of the previous
- simulation year
- $$Soil_y + \text{SOIL.retention} * (Soil_{y-1} - Soil_y)$$
- with
- $$Soil_y = \sum abund_{\text{ PFG}_i\text{, }y} *
- \text{contrib}_{\text{ PFG}_i}$$
-
= to allow plants to disperse seeds according to 3
- user-defined distances
(see PRE_FATE.params_PFGdispersal)
-
Three modes of dispersal (DISPERSAL.mode) are available :
packets kernel :
homogeneous dispersal of 50% of the seeds within the
- d50 circle
dispersal of 49% of the seeds within the d99 - d50
- ring with the same concentration as in the first circle but by pairs
- of pixel (see Boulangeat et al, 2014)
dispersal of 1% of the seeds within the ldd - d99 ring
- into one random pixel
exponential kernel : seeds are dispersed within each
- concentric circle (d50, d99 and ldd) according to
- a decreasing exponential density law (lambda = 1)
exponential kernel with probability : seeds are dispersed
- within each concentric circle (d50, d99 and ldd)
- according to a decreasing exponential density law (lambda = 1) and a
- continuous decreasing probability with distance
= to influence plants fecundity and seed
- recruitment according to PFG preferences for habitat conditions
- = filter based on maps given for each PFG within the
- Simul_parameters file with the PFG_HAB_MASK flag
(see
- PRE_FATE.params_simulParameters)
- These maps must contain values between 0 and 1 corresponding
- to the probability of presence of the PFG in each pixel. Each year
- (timestep), this value will be compared to a reference value, and if
- superior, the PFG will be able to grow and survive.
- Two methods to define this habitat suitability reference value are
- available (HABSUIT.mode) :
random : for each pixel, the reference value is drawn - from a uniform distribution, and the same value is used for each PFG - within this pixel.
PFG specific : for each PFG, a mean value and a
- standard deviation value are drawn from a uniform distribution. For
- each pixel and for each PFG, the reference value is drawn from a
- normal distribution of parameters the mean and standard deviation of
- the PFG.
= to influence plant mortality and / or resprouting
- according to PFG tolerances to these events
(see
- PRE_FATE.params_PFGdisturbance)
- = defined for events such as mowing, grazing, but also urbanization,
- crops, etc
- = filter based on maps given for each disturbance within the
- Simul_parameters file with the DIST_MASK flag
(see
- PRE_FATE.params_simulParameters)
- These maps, containing either 0 or 1, define the impact zone
- of each perturbation, and the user will have to define how each PFG will
- be impacted depending on age and life stage.
the number of different disturbances
the number of way a PFG could react to a - perturbation
the frequency of each disturbance
- (in years)
= to experience extreme events with a direct and a
- delayed response on PFG
- = based on a map given within the Simul_parameters file with the
- DROUGHT_MASK flag
(see
- PRE_FATE.params_simulParameters)
- This map must contain values representing proxies for drought intensity,
- like moisture values, in the sense that the lower the values, the higher
- the chance of experiencing a drought event. Developed canopy closure helps
- to reduce these values. The intensity of the drought event (moderate or
- severe) is determined based on thresholds defined for each PFG according
- to, for example, their moisture preference, as well as the number of
- cumulated consecutive years during which the PFG experienced a drought
- (see PRE_FATE.params_PFGdrought).
if \(di_y > \text{threshold.MOD}_{\text{ PFG}_i}\), - the counter of cumulated consecutive years of drought experienced by the - PFG will decrease : $$\text{counter}_{\text{ PFG}_i} = - \text{counter}_{\text{ PFG}_i} - - \text{counter.RECOVERY}_{\text{ PFG}_i}$$
if \(\text{threshold.SEV}_{\text{ PFG}_i} < di_y < - \text{threshold.MOD}_{\text{ PFG}_i}\)
if \(di_y < \text{threshold.SEV}_{\text{ PFG}_i} \;\; - \text{ & } \;\; \text{counter}_{\text{ PFG}_i} = 0\)
then fecundity and recruitment are set to 0 for this year, and
- counter is incremented : \(\text{counter}_{\text{ PFG}_i} ++\)
if \(di_y < \text{threshold.SEV}_{\text{ PFG}_i} \;\; - \text{ & } \;\; \text{counter.SENS}_{\text{ PFG}_i} \leq - \text{counter}_{\text{ PFG}_i} < \text{counter.CUM}_{\text{ PFG}_i}\)
if \(\text{counter}_{\text{ PFG}_i} \geq - \text{counter.CUM}_{\text{ PFG}_i}\)
then PFG experiences immediate drought-related mortality ;
- and the year after, fecundity and recruitment will be set to 0
- and PFG will experience delayed drought-related mortality.
As for the disturbances module, the user will have to define how each PFG - will be impacted depending on age and life stage.
!not required!
= 2, the
- immediate and delayed responses
the number of way a PFG could react to each of - these two perturbations
!not required!
the map of
- drought intensity proxy defined within the Simul_parameters file
- with the DROUGHT_MASK flag, as well as the
- DROUGHT_CHANGEMASK_YEARS and DROUGHT_CHANGEMASK_FILES
- flags, make it possible to manage the frequency and the variation of
- drought values (see PRE_FATE.params_simulParameters)
-
= to add new PFG during the simulation
- = defined for events such as invasive introduction, colonization, but also
- new crops development, reintroduction, etc
- = filter based on maps given for each PFG within the
- Simul_parameters file with the PFG_MASK_ALIENS flag
(see
- PRE_FATE.params_simulParameters)
- These maps, containing either 0 or 1, define the
- introduction areas.
If the habitat suitability filter is on,
- suitability maps will also be needed for these new groups.
the frequency of each introduction (in years)
= to influence plant mortality and / or resprouting according
- to PFG tolerances to these events (see
- PRE_FATE.params_PFGdisturbance)
- Fire extreme events are broken down into 4 steps representing their
- life cycle, so to speak. Each of these steps can be parameterized
- according to different available options :
Five methods to define the cells that are going to burn
- first, and from which the fire will potentially spread, are available
- (FIRE.ignit_mode) :
Random (fixed) : FIRE.ignit_no positions are
- drawn randomly over the area
Random (normal distribution) : ignit_no positions
- are drawn randomly over the area, with
- $$\text{ignit_no} \sim N(\text{FIRE.ignit_no}, 1 +
- \frac{\text{FIRE.ignit_no}}{10})$$
Random (historic distribution) : ignit_no positions
- are drawn randomly over the area, with
- $$\text{ignit_no} \sim \text{FIRE.ignit_noHist}
- [\;\; U(1, length(\text{FIRE.ignit_noHist})) \;\;]$$
Probability
-(Li et al. 1997 Ecology Modelling)
- : each cell can be a fire start with a probability (probLi)
- taking into account a baseline probability (BL), the PFG
- composition and abundances (fuel), and a drought index
- (DI, only if values between 0 and 1, given within
- the Simul_parameters file with the DROUGHT_MASK flag
- (see PRE_FATE.params_simulParameters)) :
- $$probLi_y = \text{BL}_y * \text{fuel}_y * (-DI)$$ with
- $$\text{BL}_y = \frac{\text{FIRE.ignit_logis}[1]}{1 +
- e^{\text{FIRE.ignit_logis}[2] - \text{FIRE.ignit_logis}[3] * TSLF_y}}$$
- $$\text{fuel}_y = \sum \frac{\text{FLAMM}_{\text{ PFG}_i}}
- {\text{FIRE.ignit_flammMax}} * \frac{abund_{\text{ PFG}_i\text{, }y}}
- {abund_{\text{ PFG}_{all}\text{, }y}}$$
Map !no neighbours, propagation, quota steps!
- Each cell specified by the map given within the
- Simul_parameters file with the FIRE_MASK flag and
- containing either 0 or 1 to define the starting
- positions (see PRE_FATE.params_simulParameters)
Three methods to define the
- neighboring cells of the cell currently burning, and to which the fire
- will potentially spread, are available (FIRE.neigh_mode) :
8 neighbours : all the 8 adjacent cells can potentially - be impacted by fire, and propagation will determine which ones are - effectively affected.
Extent (fixed) !no propagation step!
All
- cells contained within the rectangle defined by the cookie
- cutter extent (FIRE.neigh_CC) are impacted by fire
Extent (random) !no propagation step!
All
- cells contained within the rectangle defined by the cookie
- cutter extent (neigh_CC) are impacted by fire, with
- $$neigh\_CC_y \in \sum U(1, \text{FIRE.neigh_CC}_i)$$
Five methods to define which cells among the
- neighboring cells will actually burn are available
- (FIRE.prop_mode) :
Probability (fire intensity) : a probability is
- assigned to the cell currently burning corresponding to the
- concerned fire intensity (FIRE.prop_intensity) and compared to a
- number drawn randomly for each neighbor cell
Probability (% of plants consumed) : a probability is
- assigned to the cell currently burning linked to the percentage
- of PFG killed by the concerned fire (prob) and compared to a
- number drawn randomly for each neighbor cell
- $$\text{prob}_y = \sum \text{KilledIndiv}_{\text{ PFG}_i} *
- \frac{abund_{\text{ PFG}_i\text{, }y}}
- {abund_{\text{ PFG}_{all}\text{, }y}}$$
Maximum amount (PFG) : the cell(s) with the maximum
- amount of plants weighted by their flammability (fuel) will
- burn
- $$\text{fuel}_y = \sum \text{FLAMM}_{\text{ PFG}_i} *
- abund_{\text{ PFG}_i\text{, }y}$$
Maximum amount (soil) : if the soil module was - activated, the cell(s) with the maximum amount of soil will burn
Probability
-(Li et al. 1997 Ecology Modelling)
- : a probability is assigned to the cell currently burning
- taking into account a baseline probability (BL), the PFG
- composition and abundances (fuel), the elevation and slope
- (given within the Simul_parameters file with the
- ELEVATION_MASK and SLOPE_MASK flags (see
- PRE_FATE.params_simulParameters)), and a drought index
- (DI, only if values between 0 and 1, given within
- the Simul_parameters file with the DROUGHT_MASK flag
- (see PRE_FATE.params_simulParameters)) :
- $$probLi_y = \text{BL}_y * \text{fuel}_y * (-DI) * probSlope$$ with
- $$\text{BL}_y = \frac{\text{FIRE.prop_logis}[1]}{1 +
- e^{\text{FIRE.prop_logis}[2] - \text{FIRE.prop_logis}[3] * TSLF_y}}$$
- $$\text{fuel}_y = \sum \frac{\text{FLAMM}_{\text{ PFG}_i}}
- {\text{FIRE.ignit_flammMax}} * \frac{abund_{\text{ PFG}_i\text{, }y}}
- {abund_{\text{ PFG}_{all}\text{, }y}}$$
- $$\text{if going up, } probSlope = 1 + 0.001 * \text{SLOPE}$$
- $$\text{if going down, } probSlope = 1 + 0.001 *
- max(-30.0,-\text{SLOPE})$$
Four methods to define when the fire will stop
- spreading are available (FIRE.quota_mode) :
Maximum step : after a fixed number of steps
- (FIRE.quota_max)
Maximum amount : when a fixed amount of PFG is consumed
- (FIRE.quota_max)
Maximum cells : when a fixed amount of cells is
- consumed (FIRE.quota_max)
Keep going : as long as it remains a fire that manages - to spread
As for the disturbances module, the user will have to define how each PFG - will be impacted depending on age and life stage.
the number of different fire disturbances
the number of way a PFG could react to a - perturbation
the frequency of each fire disturbance
- (in years)
-## Create a skeleton folder with the default name ('FATE_simulation') ------------------------
-PRE_FATE.skeletonDirectory()
-
-## Create a Global_parameters file------------------------------------------------------------
-PRE_FATE.params_globalParameters(name.simulation = "FATE_simulation"
- , required.no_PFG = 3
- , required.no_strata = 5
- , required.simul_duration = 500
- , required.seeding_duration = 50
- , required.seeding_timestep = 1
- , required.seeding_input = 100
- , required.potential_fecundity = 100
- , required.max_abund_low = 3000
- , required.max_abund_medium = 5000
- , required.max_abund_high = 9000
- , doLight = TRUE
- , LIGHT.thresh_medium = 4000
- , LIGHT.thresh_low = 7000
- , doDispersal = TRUE
- , DISPERSAL.mode = 1
- , doHabSuitability = TRUE
- , HABSUIT.mode = 1)
-
-## Create SEVERAL Global_parameters files ----------------------------------------------------
-PRE_FATE.params_globalParameters(name.simulation = "FATE_simulation"
- , required.no_PFG = 3
- , required.no_strata = 5
- , required.simul_duration = 500
- , required.seeding_duration = 50
- , required.seeding_timestep = 1
- , required.seeding_input = 100
- , required.potential_fecundity = 100
- , required.max_abund_low = 3000
- , required.max_abund_medium = 5000
- , required.max_abund_high = 9000
- , doLight = TRUE
- , LIGHT.thresh_medium = 4000
- , LIGHT.thresh_low = 7000
- , doDispersal = TRUE
- , DISPERSAL.mode = 1
- , doHabSuitability = TRUE
- , HABSUIT.mode = c(1,2))
-
-
-FATE
-simulationR/PRE_FATE.params_multipleSet.R
- PRE_FATE.params_multipleSet.RdThis script is designed to create multiple sets of parameters
-using Latin Hypercube Sampling to help find best combination of parameters
-(see Details)
PRE_FATE.params_multipleSet(
- name.simulation.1,
- name.simulation.2 = NULL,
- file.simulParam.1,
- file.simulParam.2 = NULL,
- no_simulations,
- opt.folder.name = "FATE_simulation_MULTIPLE_SET",
- opt.seed = NULL,
- opt.percent_maxAbund = 0.5,
- opt.percent_seeding = 0.5,
- opt.percent_light = 0.5,
- opt.percent_soil = 0.5,
- do.max_abund_low = TRUE,
- do.max_abund_medium = TRUE,
- do.max_abund_high = TRUE,
- do.seeding_duration = TRUE,
- do.seeding_timestep = TRUE,
- do.seeding_input = TRUE,
- do.potential_fecundity = TRUE,
- do.no_strata = TRUE,
- do.LIGHT.thresh_medium = TRUE,
- do.LIGHT.thresh_low = TRUE,
- do.SOIL.init = TRUE,
- do.SOIL.retention = TRUE,
- do.DISPERSAL.mode = TRUE,
- do.HABSUIT.mode = TRUE
-)a string corresponding to the main directory
-or simulation name of the FATE simulation from which to
-retrieve the first parameter simulation file (file.simulParam.1),
-and the second if given (file.simulParam.2) and no other directory
-provided (name.simulation.2 = NULL)
(optional) default NULL.
-A string corresponding to the main directory or simulation name of
-the FATE simulation from which to retrieve the second parameter
-simulation file (file.simulParam.2)
a string corresponding to the name of the
-simulation parameter file from which to retrieve parameter values that will
-be used to build the multiple set of new parameters
(optional) default NULL.
-A string corresponding to the name of the second simulation parameter
-file from which to retrieve parameter values that will be used to build
-parameter ranges in comparison with values from file.simulParam.1
an integer corresponding to the number of set
-of parameters that will be produced according to Latin Hypercube Sampling
-(LHS)
(optional) default
-FATE_simulation_MULTIPLE_SET.
A string corresponding
-to the name of the folder that will be created to store the results
(optional) default NULL.
-An integer to be given to set.seed function, in
-order to fix the produced results if needed, as
-designLHD is also a random value generator
default 0.5. Amount of variation
-(between 0 and 1) around the original value of
-MAX_ABUND_LOW, MAX_ABUND_MEDIUM, MAX_ABUND_HIGH if
-selected
default 0.5. Amount of variation (between
-0 and 1) around the original value of SEEDING_DURATION,
-SEEDING_TIMESTEP, SEEDING_INPUT, POTENTIAL_FECUNDITY
-if selected
default 0.5. Amount of variation (between
-0 and 1) around the original value of
-LIGHT_THRESH_MEDIUM, LIGHT_THRESH_LOW if selected
default 0.5. Amount of variation (between
-0 and 1) around the original value of SOIL_INIT,
-SOIL_RETENTION if selected
default TRUE. If TRUE,
-MAX_ABUND_LOW parameter within Global_parameters file will be
-declined into a range of values
default TRUE. If TRUE,
-MAX_ABUND_MEDIUM parameter within Global_parameters file will
-be declined into a range of values
default TRUE. If TRUE,
-MAX_ABUND_HIGH parameter within Global_parameters file will
-be declined into a range of values
default TRUE. If TRUE,
-SEEDING_DURATION parameter within Global_parameters file will
-be declined into a range of values
default TRUE. If TRUE,
-SEEDING_TIMESTEP parameter within Global_parameters file will
-be declined into a range of values
default TRUE. If TRUE,
-SEEDING_INPUT parameter within Global_parameters file will be
-declined into a range of values
default TRUE. If TRUE,
-POTENTIAL_FECUNDITY parameter within Global_parameters file
-will be declined into a range of values
default TRUE. If TRUE, NO_STRATA
-parameter within Global_parameters file will be declined into a range
-of values, with potential impact on some parameters within PFG succession
-(and light) files (parameters STRATA, MAX_ABUNDANCE,
-IMM_SIZE, CHANG_STR_AGES (and LIGHT_TOL), see
-PRE_FATE.params_PFGsuccession (and
-PRE_FATE.params_PFGlight))
default TRUE. If TRUE,
-LIGHT_THRESH_MEDIUM parameter within Global_parameters file
-will be declined into a range of values
default TRUE. If TRUE,
-LIGHT_THRESH_LOW parameter within Global_parameters file
-will be declined into a range of values
default TRUE. If TRUE, SOIL_INIT
-parameter within Global_parameters file will be declined into a range
-of values
default TRUE. If TRUE,
-SOIL_RETENTION parameter within Global_parameters file will be
-declined into a range of values
default TRUE. If TRUE,
-DISPERSAL_MODE parameter within Global_parameters file will be
-declined into its three possible values (either either packets kernel
-(1), exponential kernel (2) or exponential kernel with
-probability (3), see PRE_FATE.params_globalParameters)
default TRUE. If TRUE,
-HABSUIT_MODE parameter within Global_parameters file will be
-declined into its two possible values (either random (1) or PFG
-specific (2), see PRE_FATE.params_globalParameters)
A new folder containing the different sets of parameters asked.
- - -Depending on what elements have been asked to be varied, three types of -files can have been modified :
the global parameter file
the PFG succession files
the PFG light succession files
Below are listed the parameters that can change (if selected) within each -file :
- - -Into the name.simulation/DATA/GLOBAL_PARAMETERS folder :
NO_STRATA
SEEDING_DURATION
SEEDING_TIMESTEP
SEEDING_INPUT
POTENTIAL_FECUNDITY
MAX_ABUND_LOW
MAX_ABUND_MEDIUM
MAX_ABUND_HIGH
If the simulation includes light interaction :
LIGHT_THRESH_MEDIUM
LIGHT_THRESH_LOW
If the simulation includes soil interaction :
SOIL_INIT
SOIL_RETENTION
If the simulation includes dispersal :
DISPERSAL_MODE
If the simulation includes habitat suitability :
HABSUIT_MODE
Into the name.simulation/DATA/PFGS/SUCC folder :
STRATA
MAX_ABUNDANCE
IMM_SIZE
CHANG_STR_AGES
Into the name.simulation/DATA/PFGS/LIGHT folder :
LIGHT_TOL
A FATE simulation requires several parameters to define general
-characteristics of the simulation : they are saved within a
-Global_parameters file (see
-PRE_FATE.params_globalParameters). To fit the model to a
-particular area and set of Plant Functional Groups (PFG), these are the
-parameters that should be optimized, since they are not data-dependant,
-unlike, for example, parameters related to PFG (height, maturity, dispersal
-distances, soil tolerance, etc).
(Note : this is true, except when varying the number of strata, which -will have an impact on some parameters within SUCC and LIGHT PFG parameter -files.)
-The main idea is to start from a complete simulation folder, to
-select the parameters that should vary, and to create new parameter files
-with new parameter values based on pre-existing values.
Three possible scenarios are available :
requested parameter values are extracted from the given - simulation file
ranges are assigned to each parameter according to the specified
- value
e.g. : if opt.percent_seeding = 0.5, and
- do.seeding_duration is asked, values will be generated for this
- parameter between :
- $$\text{SEEDING_DURATION} \pm \text{SEEDING_DURATION} *
- \frac{50}{100}$$
according to the required number of parameter sets to be produced
- (no_simulations), Latin Hypercube Sampling is applied to select
- each new parameter values
parameter files are created for these new parameter values
same as 1st scenario
ranges assigned to each parameter correspond to the extracted
- values (e.g. : if do.seeding_duration is asked, values will be
- generated for this parameter between : SEEDING_DURATION
- (file_simulation.1) and SEEDING_DURATION (file_simulation.2)
-
same as 2nd scenario, except that the two given simulation files
- come from two different simulation folders
Latin Hypercube Sampling is a statistical method to generate a -sampling of parameter values from a multidimensional space, while ensuring -a good representation of the real variability. The range of each parameter -is known, and depending on the number of set of parameters asked to be -obtained at the end, each range is more or less finely cut and values are -drawn in order to explore the whole space of combinations.
-FATE simulationR/PRE_FATE.params_savingYears.R
- PRE_FATE.params_savingYears.RdThis script is designed to create a parameter file containing
-simulation years at which the FATE software must save rasters of
-PFG abundances (as well as light and soil resources if these modules are
-activated) and/or simulation objects.
PRE_FATE.params_savingYears(
- name.simulation,
- years.maps = NULL,
- years.objects = NULL,
- opt.folder.name = NULL
-)a string corresponding to the main directory
-or simulation name of the FATE simulation
(optional)
a vector of simulation years
-at which PFG abundance maps will be saved
(as well as maps of
-light and soil resources if these modules are activated)
(optional)
a vector of simulation
-years at which FATE simulation state will be saved
(optional)
a string corresponding
-to the name of the folder that will be created into the
-name.simulation/DATA/SAVE/ directory to store the results
Two .txt files into the name.simulation/DATA/SAVE/
directory :
- -SAVE_YEARS_maps.txt : one line for each simulation year for
- which the raster maps are to be saved
SAVE_YEARS_objects.txt : one line for each simulation year
- for which the FATE objects are to be saved
If the opt.folder.name has been used, the files will be into the
-folder name.simulation/DATA/SAVE/opt.folder.name/.
FATE software allows the user to save two different types of
-outputs :
PFG abundance maps can be saved for all specified
- simulation years.
It includes maps per PFG per strata
- (ABUND_perPFG_perStrata folder) and summary maps
- per PFG for all height strata combined (ABUND_perPFG_allStrata
- folder).
If the light and / or soil modules are activated (see
- PRE_FATE.params_globalParameters), maps for light and / or
- soil resources are also saved.
Raster format used is depending on
- input data format. It can be either .img or .tif.
using BOOST library and its serialization
- functions, FATE is able to save a simulation at a specific
- time. This object allows the user to restart a simulation from this
- precise state by specifying its name within the Simul_parameters
- file with the SAVED_STATE flag (see
- PRE_FATE.params_simulParameters).
-## Create a skeleton folder with the default name ('FATE_simulation') ------------------------
-PRE_FATE.skeletonDirectory()
-
-## Create a SAVE_year_maps or/and SAVE_year_objects parameter file ---------------------------
-PRE_FATE.params_savingYears(name.simulation = 'FATE_simulation'
- , years.maps = c(100, 150, 200)
- , years.objects = 200)
-FATE
-simulationR/PRE_FATE.params_simulParameters.R
- PRE_FATE.params_simulParameters.RdThis script is designed to create one (or several) parameter
-file containing PARAMETER FILENAMES used in FATE model.
PRE_FATE.params_simulParameters(
- name.simulation,
- name.MASK,
- name.SAVED_STATE = NULL,
- name.SOIL = NULL,
- name.DIST = NULL,
- name.DROUGHT = NULL,
- name.ALIENS = NULL,
- name.FIRE = NULL,
- name.ELEVATION = NULL,
- name.SLOPE = NULL,
- opt.global.name = NULL,
- opt.folder.name = NULL
-)a string corresponding to the main directory
-or simulation name of the FATE simulation
a string corresponding to the file name of a raster
-mask, with either 0 or 1 within each pixel, 1
-corresponding to the cells of the studied area in which the succession
-(core) module of the FATE simulation will take place (see
-PRE_FATE.params_globalParameters)
(optional)
a string corresponding
-to the file name of a FATE object, obtained from a previous
-simulation and from which to restart this new simulation
(optional)
a string corresponding to
-the name of a raster file, with a numeric value within each pixel
-corresponding to the initial soil resources of this pixel for the soil
-interaction module of the FATE simulation (see
-PRE_FATE.params_globalParameters)
(optional)
a string corresponding to the
-file name of a raster mask, with either 0 or 1 within each
-pixel, 1 corresponding to the cells of the studied area in which the
-disturbance module of the FATE simulation will take place (see
-PRE_FATE.params_globalParameters)
(optional)
a string corresponding to
-the name of a raster file, with a numeric value within each pixel
-corresponding to the drought intensity experienced by this pixel through
-the drought (or fire) disturbance module of the FATE simulation (see
-PRE_FATE.params_globalParameters)
(optional)
a string corresponding to the
-file name of a raster mask, with either 0 or 1 within each
-pixel, 1 corresponding to the cells of the studied area in which the
-aliens introduction module of the FATE simulation will take place (see
-PRE_FATE.params_globalParameters)
(optional)
a string corresponding to the
-file name of a raster mask, with either 0 or 1 within each
-pixel, 1 corresponding to the cells of the studied area in which the
-fire disturbance module of the FATE simulation will take place (see
-PRE_FATE.params_globalParameters)
(optional)
a string corresponding to
-the name of a raster file, with a numeric value within each pixel
-corresponding to the elevation of this pixel and used by the fire
-disturbance module of the FATE simulation (see
-PRE_FATE.params_globalParameters)
(optional)
a string corresponding to
-the name of a raster file, with a numeric value within each pixel
-corresponding to the slope of this pixel and used by the fire
-disturbance module of the FATE simulation (see
-PRE_FATE.params_globalParameters)
(optional)
a string corresponding
-to the name of the global parameter file in the folder
-name.simulation/DATA/GLOBAL_PARAMETERS/ that will be used to build
-the simulation parameter file
(optional)
a string corresponding
-to the name of the folder in each name.simulation/DATA/PFGS/module/
-from which PFG file names will be extracted to build the simulation
-parameter file
A .txt file into the name.simulation/PARAM_SIMUL/
directory with the following parameters :
- - ---GLOBAL_PARAMS--
--SAVING_DIR--
--SAVED_STATE-- (optional)
--SAVING_YEARS_MAPS-- (optional)
--SAVING_YEARS_OBJECTS-- (optional)
--MASK--
--MASK_CHANGEMASK_YEARS-- (optional)
--MASK_CHANGEMASK_FILES-- (optional)
--PFG_PARAMS_LIFE_HISTORY--
--PFG_PARAMS_LIGHT-- (optional)
--PFG_PARAMS_SOIL-- (optional)
--SOIL_MASK-- (optional)
--PFG_PARAMS_DISPERSAL-- (optional)
--PFG_MASK_HABSUIT-- (optional)
--HABSUIT_CHANGEMASK_YEARS-- (optional)
--HABSUIT_CHANGEMASK_FILES-- (optional)
--PFG_PARAMS_DISTURBANCES-- (optional)
--DIST_MASK-- (optional)
--DIST_CHANGEMASK_YEARS-- (optional)
--DIST_CHANGEMASK_FILES-- (optional)
--PFG_PARAMS_DROUGHT-- (optional)
--DROUGHT_MASK-- (optional)
--DROUGHT_CHANGEMASK_YEARS-- (optional)
--DROUGHT_CHANGEMASK_FILES-- (optional)
--PFG_MASK_ALIENS-- (optional)
--ALIENS_CHANGEMASK_YEARS-- (optional)
--ALIENS_CHANGEMASK_FILES-- (optional)
--ALIENS_CHANGEFREQ_YEARS-- (optional)
--ALIENS_CHANGEFREQ_FILES-- (optional)
--PFG_PARAMS_FIRE-- (optional)
--FIRE_MASK-- (optional)
--FIRE_CHANGEMASK_YEARS-- (optional)
--FIRE_CHANGEMASK_FILES-- (optional)
--FIRE_CHANGEFREQ_YEARS-- (optional)
--FIRE_CHANGEFREQ_FILES-- (optional)
--ELEVATION_MASK-- (optional)
--SLOPE_MASK-- (optional)
--END_OF_FILE--
The FATE software takes only one input parameter : a file
-containing links to other files containing all the parameters and data
-needed by the program to run.
file where parameters related to the simulation
- definition are referred (e.g. number of PFG involved, number of height
- strata, simulation duration, computer resources, modules loaded, etc)
- (see PRE_FATE.params_globalParameters)
directory where simulation outputs will be stored
file containing the results of a
- previous FATE simulation from which to restart this new simulation
-
file containing the
- years for which simulation maps will be saved
- (see PRE_FATE.params_savingYears)
file containing the
- years for which simulation outputs will be saved
- (see PRE_FATE.params_savingYears)
raster mask that will define the study area
file containing the years
- to change rasters for the succession module
- (see PRE_FATE.params_changingYears)
file containing the files
- to change rasters for the succession module
- (see PRE_FATE.params_changingYears)
PFG life history related parameters
- (one by PFG)
- (see PRE_FATE.params_PFGsuccession)
PFG light preferences and
- tolerance related parameters (one by PFG)
- (see PRE_FATE.params_PFGlight)
PFG soil contribution and
- tolerance related parameters (one by PFG)
- (see PRE_FATE.params_PFGsoil)
raster mask that will define the - initialization soil resources values
PFG dispersal
- capacity related parameters (one by PFG)
- (see PRE_FATE.params_PFGdispersal)
raster masks (one by PFG) - containing PFG habitat suitability for the study area
file containing the years
- to change rasters for the habitat suitability module
- (see PRE_FATE.params_changingYears)
file containing the files
- to change rasters for the habitat suitability module
- (see PRE_FATE.params_changingYears)
PFG disturbance
- related parameters in terms of resprouting and mortality (one by PFG)
- (see PRE_FATE.params_PFGdisturbance)
raster masks that will define the - disturbance areas
file containing the years
- to change rasters for the disturbance module
- (see PRE_FATE.params_changingYears)
file containing the files
- to change rasters for the disturbance module
- (see PRE_FATE.params_changingYears)
PFG drought disturbance
- related parameters in terms of resprouting and mortality (one by PFG)
- (see PRE_FATE.params_PFGdrought)
raster mask that will define the - drought intensity of the area
file containing the
- years to change rasters for the drought disturbances module
- (see PRE_FATE.params_changingYears)
file containing the
- files to change rasters for the drought disturbances module
- (see PRE_FATE.params_changingYears)
raster masks (one by alien) - containing alien introduction zones for the study area
file containing the
- years to change rasters for the aliens introduction module
- (see PRE_FATE.params_changingYears)
file containing the
- files to change rasters for the aliens introduction module
- (see PRE_FATE.params_changingYears)
file containing the
- years to change frequencies for the aliens introduction module
- (see PRE_FATE.params_changingYears)
file containing the
- files to change frequencies for the aliens introduction module
- (see PRE_FATE.params_changingYears)
PFG fire disturbance
- related parameters in terms of resprouting and mortality (one by PFG)
- (see PRE_FATE.params_PFGdisturbance)
raster mask that will define the - fire disturbance areas
file containing the
- years to change rasters for the fire disturbances module
- (see PRE_FATE.params_changingYears)
file containing the
- files to change rasters for the fire disturbances module
- (see PRE_FATE.params_changingYears)
file containing the
- years to change frequencies for the fire disturbances module
- (see PRE_FATE.params_changingYears)
file containing the
- files to change frequencies for the fire disturbances module
- (see PRE_FATE.params_changingYears)
raster mask that will define - the elevation of the area
raster mask that will define the - slope of the area
The function produces links to files that are NOT absolute
- paths BUT relative ones.
When relative paths are used, the user should be careful of the
- folder from which the simulation is launched.
A function allows to transform these relative paths into absolute
- ones. (see examples of .setPattern).
The order of files matters!
- For instance the first link below --PFG_PARAMS_LIFE_HISTORY-- flag
- (e.g. PFG Albert) has to match with the first item below the
- --PFG_PARAMS_DISPERSAL-- flag (must be PFG Albert too).
PRE_FATE.skeletonDirectory,
-PRE_FATE.params_globalParameters,
-PRE_FATE.params_PFGsuccession,
-PRE_FATE.params_PFGlight,
-PRE_FATE.params_PFGsoil,
-PRE_FATE.params_PFGdispersal,
-PRE_FATE.params_PFGdisturbance,
-PRE_FATE.params_PFGdrought,
-PRE_FATE.params_savingYears,
-PRE_FATE.params_changingYears,
-.setPattern
R/PRE_FATE.selectDominant.R
- PRE_FATE.selectDominant.RdThis script is designed to select dominant species from -abundance records, and habitat if the information is available.
-PRE_FATE.selectDominant(
- mat.observations,
- doRuleA = TRUE,
- rule.A1 = 10,
- rule.A2_quantile = 0.9,
- doRuleB = TRUE,
- rule.B1_percentage = 0.25,
- rule.B1_number = 5,
- rule.B2 = 0.5,
- doRuleC = FALSE,
- opt.doRobustness = FALSE,
- opt.robustness_percent = seq(0.1, 0.9, 0.1),
- opt.robustness_rep = 10,
- opt.doSitesSpecies = TRUE,
- opt.doPlot = TRUE
-)a data.frame with at least 3 columns : sites, species, abund
-
(and optionally, habitat)
-
(see Details)
default TRUE.
If TRUE, selection
-is done including constraints on number of occurrences
default 10.
If doRuleA = TRUE or
-doRuleC = TRUE, minimum number of releves required for each species
default 0.9.
If doRuleA = TRUE
-or doRuleC = TRUE, quantile corresponding to the minimum number of
-total occurrences required for each species (between 0 and 1)
default FALSE.
If TRUE, selection is done
-including constraints on relative abundances
default 0.25.
If doRuleB = TRUE,
-minimum relative abundance required for each species in at least
-rule.B1_number sites (between 0 and 1)
default 5.
If doRuleB = TRUE,
-minimum number of sites in which each species has relative abundance
->= rule.B1_percentage
default 0.5.
If doRuleB = TRUE, minimum
-average relative abundance required for each species (between 0 and
-1)
default FALSE.
If TRUE, selection is done
-including constraints on number of occurrences at the habitat level (with
-the values of rule.A1 and rule.A2_quantile)
(optional) default FALSE.
-If TRUE, selection is also done on subsets of
-mat.observations, keeping only a percentage of releves or sites, to
-visualize the robustness of the selection
(optional) default c(0.1, 0.2,
-0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9).
If opt.doRobustness = TRUE,
-vector containing values between 0 and 1 corresponding
-to the percentages with which to build subsets to evaluate robustness
(optional) default 10.
If
-opt.doRobustness = TRUE, number of repetitions for each percentage
-value defined by opt.robustness_percent to evaluate robustness
(optional) default TRUE.
-If TRUE, building of abundances / occurrences tables for selected
-species will be processed, saved and returned.
(optional) default TRUE.
If TRUE,
-plot(s) will be processed, otherwise only the calculation and reorganization
-of outputs will occur, be saved and returned.
A list containing one vector, four or five
-data.frame objects with the following columns, and up to five
-ggplot2 objects :
the names of the selected species
A1,A2,B1,B2, habif the rule has been used, if the - species fullfills this condition or not
speciesthe concerned species
SELECTIONthe summary of rules with which the species - was selected, or not
SELECTEDTRUE if the species fullfills A1
- and at least one other condition, FALSE otherwise
...same as tab.rules
typethe type of subset (either releves or
- sites)
percentthe concerned percentage of values extraction
repthe repetition ID
table containing sums of abundances for all selected - species (sites in rows, species in columns)
table containing counts of presences for all selected - species (sites in rows, species in columns)
ggplot2 object, representing the selection of
- species according to rules A1 and A2
ggplot2 object, representing the selection of
- species according to rules B
ggplot2 object, representing the selection of
- species according to rules C (A1 and A2 per habitat)
ggplot2 object, representing selected species with
- Principal Coordinates Analysis (see dudi.pco)
ggplot2 object, representing the robustness
- of the selection of species for each rule
The information is written in
-PRE_FATE_DOMINANT_[...].csv files :
TABLE_completethe complete table of all species and the
- selection rules described above (tab.rules)
TABLE_speciesonly the names / ID of the species selected
TABLE_sitesXspecies_ABabundances table of selected species
TABLE_sitesXspecies_PApresence/absence table of selected - species
Up to six PRE_FATE_DOMINANT_[...].pdf files are also created :
STEP_1_rule_ASTEP_2_selectedSpecies_PHYLO
STEP_1_rule_BSTEP_2_selectedSpecies_PCO
STEP_1_rule_CSTEP_2_selectedSpecies_robustness
This function provides a way to select dominant species based on
-presence/abundance sampling information.
Three rules can be applied to make the species selection :
-both conditions must be fullfilled
the species should be found a minimum
- number of times (rule.A1)
-
This should ensure that the species has been given sufficient
- minimum sampling effort. This criterion MUST ALWAYS be fullfilled.
the species should be found in a certain
- number of sites, which corresponds to the quantile
- rule.A2_quantile of the total number of records per species
-
This should ensure that the species is covering all the
- studied area (or at least a determining part of it, assuming that
- the releves are well distributed throughout the area).
at least one of the two conditions is - required
the species should be dominant (i.e. represent at
- least rule.B1_percentage % of the coverage of the site) in at
- least rule.B1_number sites
-
This should ensure the selection of species frequently
- abundant.
the species should have a mean relative
- abundance superior or equal to rule.B2
-
This should ensure the selection of species not frequent but
- representative of the sites in which it is found.
If habitat information is
- available (e.g. type of environment : urban, desert, grassland... ; type
- of vegetation : shrubs, forest, alpine grasslands... ; etc), the same
- rules than A can be applied but for each habitat.
-
This should help to keep species that are not dominant at the
- large scale but could be representative of a specific habitat.
A table is created containing for each species whether or not it fullfills
-the conditions selected, for example :
| ___A1 ___A2 ___B1 ___B2 grass lands | _______________________________________ | _TRUE FALSE FALSE _TRUE _TRUE FALSE | species a | _TRUE _TRUE _TRUE FALSE FALSE FALSE | species b | FALSE FALSE FALSE FALSE FALSE _TRUE | species c
This table is transformed into Euclidean distance matrix (with
-gowdis and quasieuclid functions)
-to cluster and represent species (see
-.pdf output files) :
through phylogenetic tree (with hclust and
- as.phylo functions)
through Principal Component Analysis (with
- dudi.pco)
according to their selection rules :
A2 : spatial dominancy (widespread but poorly - abundant)
B1 : local dominancy (relatively abundant or - dominant in a certain number of sites)
B2 : local dominancy (not widespread but dominant in - few sites)
C : habitat dominancy (not widespread but dominant in - a specific habitat)
A2 & B1 : (widespread and relatively abundant)
A2 & B2 : (widespread and dominant in few sites)
A2 & B1 & B2 : (widespread and dominant)
B1 & B2 : (relatively widespread but dominant)
-
NB :
-Species not meeting any criteria or only A1 are considered as
-"Not selected".
Priority is set to A2, B1 and B2 rules, rather
-than C. Hence, species selected according to A2, B1 and/or B2 can also meet
-criterion C while species selected according to C do not meet any of the
-three criteria.
Species selected according to one (or more) criterion
-but not meeting criterion A1 are also considered as "Not selected".
-## Load example data
-Champsaur_PFG = .loadData('Champsaur_PFG', 'RData')
-
-## Species observations
-tab = Champsaur_PFG$sp.observations
-
-## No habitat, no robustness -------------------------------------------------
-tab.occ = tab[, c('sites', 'species', 'abund')]
-sp.SELECT = PRE_FATE.selectDominant(mat.observations = tab.occ)
-names(sp.SELECT)
-str(sp.SELECT$tab.rules)
-str(sp.SELECT$tab.dom.PA)
-plot(sp.SELECT$plot.A)
-plot(sp.SELECT$plot.B$abs)
-plot(sp.SELECT$plot.B$rel)
-
-## Habitat, change parameters, no robustness (!quite long!) --------------------
-if (FALSE) {
-tab.occ = tab[, c('sites', 'species', 'abund', 'habitat')]
-sp.SELECT = PRE_FATE.selectDominant(mat.observations = tab.occ
- , doRuleA = TRUE
- , rule.A1 = 10
- , rule.A2_quantile = 0.9
- , doRuleB = TRUE
- , rule.B1_percentage = 0.2
- , rule.B1_number = 10
- , rule.B2 = 0.4
- , doRuleC = TRUE)
-names(sp.SELECT)
-str(sp.SELECT$tab.rules)
-plot(sp.SELECT$plot.C)
-plot(sp.SELECT$plot.pco$Axis1_Axis2)
-plot(sp.SELECT$plot.pco$Axis1_Axis3)
-}
-
-## No habitat, robustness (!quite long!) --------------------
-if (FALSE) {
-tab.occ = tab[, c('sites', 'species', 'abund')]
-sp.SELECT = PRE_FATE.selectDominant(mat.observations = tab.occ
- , opt.doSitesSpecies = FALSE
- , opt.doRobustness = TRUE
- , opt.robustness_percent = seq(0.1,0.9,0.1)
- , opt.robustness_rep = 10)
-names(sp.SELECT)
-str(sp.SELECT$tab.robustness)
-names(sp.SELECT$plot.robustness)
-plot(sp.SELECT$plot.robustness$`All dataset`)
-}
-
-FATE simulationR/PRE_FATE.skeletonDirectory.R
- PRE_FATE.skeletonDirectory.RdThis script is designed to create a user-friendly directory
-tree to run a FATE simulation.
PRE_FATE.skeletonDirectory(name.simulation = "FATE_simulation")a string that will be used as the main
-directory and simulation name
A directory tree with folders to contain the parameter files, the -simulation files and the results.
-FATE requires only one input parameter (see
-PRE_FATE.params_simulParameters),
which is a file containing the names of parameter files,
which may themselves contain
parameters (e.g. succession, dispersal files...)
or other file names (e.g. disturbance or environmental change - masks).
The user could give names of files stored everywhere on a machine, and does
-not have to put them all in one same place.
-But as this is more practical, this function proposes a way to
-organize all those files or parameter files that will or could be
-used by a FATE simulation.
The tree structure is detailed below :
-DATAthis folder will contain all the data or parameters - that are needed by the model
GLOBAL_PARAMETERSfiles containing global parameters for
- the simulation
(see PRE_FATE.params_globalParameters)
MASKraster maps used in the model
SCENARIOfiles containing information about changes in
- raster maps input
(see PRE_FATE.params_changingYears)
SAVEfiles containing information about simulation times
- to save outputs
(see PRE_FATE.params_savingYears)
PFGSSUCClife history parameter files
- (see PRE_FATE.params_PFGsuccession)
LIGHTresponse to light interaction parameter files
- (see PRE_FATE.params_PFGlight)
SOILresponse to soil interaction parameter files
- (see PRE_FATE.params_PFGsoil)
DISPdispersal parameter files
- (see PRE_FATE.params_PFGdispersal)
HABSUIThabitat suitability maps
DISTresponse to disturbances parameter files
- (see PRE_FATE.params_PFGdisturbance)
DROUGHTresponse to drought disturbance parameter files
-
(see PRE_FATE.params_PFGdrought)
ALIENSaliens introduction maps
PARAM_SIMULthis folder will contain simulation files that can be
- given as input to the software
(see
- PRE_FATE.params_simulParameters)
RESULTSthis folder will collect all the results produced by the - software with a folder for each simulation
NB :
-All the functions of the RFate package are based on this folder
-structure.
PRE_FATE.params_globalParameters,
-PRE_FATE.params_PFGsuccession,
-PRE_FATE.params_PFGlight,
-PRE_FATE.params_PFGsoil,
-PRE_FATE.params_PFGdispersal,
-PRE_FATE.params_PFGdisturbance,
-PRE_FATE.params_PFGdrought,
-PRE_FATE.params_changingYears,
-PRE_FATE.params_savingYears,
-PRE_FATE.params_simulParameters
-## Create a skeleton folder with the default name ('FATE_simulation') ------------------------
-PRE_FATE.skeletonDirectory()
-
-## Create a skeleton folder with a specific name ---------------------------------------------
-PRE_FATE.skeletonDirectory(name.simulation = 'FATE_AlpineForest')
-R/PRE_FATE.speciesClustering_step1.R
- PRE_FATE.speciesClustering_step1.RdThis script is designed to create clusters of species based -on a distance matrix between those species. Several metrics are computed -to evaluate these clusters and a graphic is produced to help the user to -choose the best number of clusters..
-PRE_FATE.speciesClustering_step1(mat.species.DIST, opt.no_clust_max = 15)a dist object, or a list of
-dist objects (one for each GROUP value), corresponding to the
-dissimilarity distance between each pair of species.
Such an object can
-be obtained with the PRE_FATE.speciesDistance function.
(optional) default 15.
an
-integer corresponding to the maximum number of clusters to be tested
-for each distance matrix
A list containing one list, one data.frame with
-the following columns, and two ggplot2 objects :
a list with as many objects of
- class hclust as data subsets
GROUPname of data subset
no.clustersnumber of clusters used for the clustering
variableevaluation metrics' name
valuevalue of evaluation metric
ggplot2 object, representing the different
- values of metrics to choose the clustering method
ggplot2 object, representing the different
- values of metrics to choose the number of clusters
One PRE_FATE_CLUSTERING_STEP1_numberOfClusters.pdf file is created
-containing two types of graphics :
to account for the chosen clustering method
for decision support, to help the user to choose
- the adequate number of clusters to be given to the
- PRE_FATE.speciesClustering_step2 function
This function allows to obtain dendrograms based on a dissimilarity -distance matrix between species.
-As for the PRE_FATE.speciesDistance method, clustering can be
-run for data subsets, conditioning that mat.species.DIST is given as
-a list of dist objects (instead of a dist object alone).
-
The process is as follows :
-hierarchical clustering on the dissimilarity matrix is realized with the
- hclust.
Several methods are available for the agglomeration : - complete, ward.D, ward.D2, single, - average (UPGMA), mcquitty (WPGMA), median (WPGMC) - and centroid (UPGMC).
Mouchet et al. (2008) proposed a similarity measure between - the input distance and the one obtained with the clustering which must - be minimized to help finding the best clustering method : - $$ 1 - cor( \text{mat.species.DIST}, \text{clustering.DIST} ) ^ 2$$
For each agglomeration method, this measure is calculated. The
- method that minimizes it is kept and used for further analyses (see
- .pdf output file).
once the hierarchical
- clustering is done, the number of clusters to keep should be chosen.
- To do that, several metrics are computed :
Dunn index (mdunn) : ratio of the smallest
- distance between observations not in the same cluster to the largest
- intra-cluster distance. Value between 0 and \(\infty\), and
- should be maximized.
Meila's Variation of Information index (mVI) :
- measures the amount of information lost and gained in changing
- between two clusterings. Should be minimized.
Coefficient of determination (R2) : value
- between 0 and 1. Should be maximized.
Calinski and Harabasz index (ch) : the higher
- the value, the "better" is the solution.
Corrected rand index (Rand) : measures the
- similarity between two data clusterings. Value between 0 and
- 1, with 0 indicating that the two data clusters do not
- agree on any pair of points and 1 indicating that the data
- clusters are exactly the same.
Average silhouette width (av.sil) : Observations
- with a large s(i) (almost 1) are very well clustered, a
- small s(i) (around 0) means that the observation lies
- between two clusters, and observations with a negative s(i) are
- probably placed in the wrong cluster. Should be maximized.
A graphic is produced, giving the values of these metrics in
- function of the number of clusters used. Number of clusters are
- highlighted in function of evaluation metrics' values to help the
- user to make his/her optimal choice : the brighter (yellow-ish) the
- better (see .pdf output file).
-Mouchet M., Guilhaumon f., Villeger S., Mason N.W.H., Tomasini J.A. &
-Mouillot D., 2008. Towards a consensus for calculating dendrogam-based
-functional diversity indices. Oikos, 117, 794-800.
The function does not return ONE dendrogram (or as many as
-given dissimilarity structures) but a LIST with all tested numbers
-of clusters. One final dendrogram can then be obtained using this result
-as a parameter in the PRE_FATE.speciesClustering_step2
-function.
hclust,
-cutree,
-cluster.stats,
-dunn,
-PRE_FATE.speciesDistance,
-PRE_FATE.speciesClustering_step2
-## Load example data
-Champsaur_PFG = .loadData('Champsaur_PFG', 'RData')
-
-## Species dissimilarity distances (niche overlap + traits distance)
-tab.dist = list('Phanerophyte' = Champsaur_PFG$sp.DIST.P$mat.ALL
- , 'Chamaephyte' = Champsaur_PFG$sp.DIST.C$mat.ALL
- , 'Herbaceous' = Champsaur_PFG$sp.DIST.H$mat.ALL)
-str(tab.dist)
-as.matrix(tab.dist[[1]])[1:5, 1:5]
-
-## Build dendrograms ---------------------------------------------------------
-sp.CLUST = PRE_FATE.speciesClustering_step1(mat.species.DIST = tab.dist)
-names(sp.CLUST)
-str(sp.CLUST$clust.evaluation)
-plot(sp.CLUST$plot.clustMethod)
-plot(sp.CLUST$plot.clustNo)
-
-if (FALSE) {
-require(foreach)
-require(ggplot2)
-require(ggdendro)
-pp = foreach(x = names(sp.CLUST$clust.dendrograms)) %do%
-{
- hc = sp.CLUST$clust.dendrograms[[x]]
- pp = ggdendrogram(hc, rotate = TRUE) +
- labs(title = paste0('Hierarchical clustering based on species distance '
- , ifelse(length(names(sp.CLUST$clust.dendrograms)) > 1
- , paste0('(group ', x, ')')
- , '')))
- return(pp)
-}
-plot(pp[[1]])
-plot(pp[[2]])
-plot(pp[[3]])
-}
-
-
-R/PRE_FATE.speciesClustering_step2.R
- PRE_FATE.speciesClustering_step2.RdThis script is designed to obtain functional groups by : 1)
-selecting the number of clusters to be kept from an object obtained with
-the PRE_FATE.speciesClustering_step1 function ; 2) refining
-these groups by identifying determinant species in each of them.
PRE_FATE.speciesClustering_step2(
- clust.dendrograms,
- no.clusters,
- mat.species.DIST
-)a dendrogram, or a list of dendrograms (one
-for each GROUP value).
Such an object can be obtained
-with the PRE_FATE.speciesClustering_step1 function.
an integer, or a vector of integer
-(one for each GROUP value), with the number of clusters to be kept
a dist object, or a list of
-dist objects (one for each GROUP value), corresponding to the
-distance between each pair of species.
Such an object can be obtained
-with the PRE_FATE.speciesDistance function.
A list containing one vector, one data.frame
with the following columns, and two ggplot2 objects :
the names of all determinant species
(determinant and non-determinant species)
PFGID of the plant functional group
- (GROUP + ID.cluster)
GROUPname of data subset
ID.clustercluster number
speciesname of species
ID.speciesspecies number in each PFG
sp.mean.distspecies mean distance to other species of - the same PFG
allSp.mean\(mean(\text{sp.mean.dist})\) within the PFG
allSp.min\(mean(\text{sp.mean.dist}) - 1.64 * - sd(\text{sp.mean.dist})\) within the PFG
allSp.max\(mean(\text{sp.mean.dist}) + 1.64 * - sd(\text{sp.mean.dist})\) within the PFG
DETERMINANTTRUE if determinant species, FALSE
- otherwise
ggplot2 object, representing the distribution
- of mean distances between species for each functional group
list of ggplot2 objects, representing the
- PFG within the functional space
One PRE_FATE_CLUSTERING_STEP_2_distantSpecies_PCO.pdf file is created
-containing two types of graphics :
to visualize in each PFG the distribution of mean - distance of each species to other species, and non-determinant species - which are outside the distribution
to visualize in each PFG the distribution of species, with and - without non-determinant species
This function allows to obtain a classification of dominant
-species into Plant Functional Groups (PFG), and the determinant
-species based on these PFG.
What is the difference between dominant and
-determinant species ?
Dominant species are species representative of an
- environment or a studied area, in terms of number of releves or
- abundance values. They can be found with the
- PRE_FATE.selectDominant function of this package. These
- dominant species are used to build PFG with the
- PRE_FATE.speciesClustering_step1 function.
Once PFG are built, determinant species are defined as
- refined subsets of dominant species within each PFG.
The process is
- detailed below :
-
each dominant species is assigned to a PFG
within each PFG :
for each species, compute its mean distance to the other
- species within the PFG (sp.mean.dist)
calculate the mean value of all these mean distances
- (allSp.mean)
calculate the deviation values around this mean value
- (allSp.min and allSp.max)
determinant species are the ones that are included between - those deviation values
-## Load example data
-Champsaur_PFG = .loadData('Champsaur_PFG', 'RData')
-
-## Species dissimilarity distances (niche overlap + traits distance)
-tab.dist = list("Phanerophyte" = Champsaur_PFG$sp.DIST.P$mat.ALL
- , "Chamaephyte" = Champsaur_PFG$sp.DIST.C$mat.ALL
- , "Herbaceous" = Champsaur_PFG$sp.DIST.H$mat.ALL)
-str(tab.dist)
-as.matrix(tab.dist[[1]])[1:5, 1:5]
-
-## Build dendrograms ---------------------------------------------------------
-sp.CLUST = PRE_FATE.speciesClustering_step1(mat.species.DIST = tab.dist)
-names(sp.CLUST)
-
-
-## Number of clusters per group
-plot(sp.CLUST$plot.clustNo)
-no.clusters = c(4, 3, 8) ## Phanerophyte, Chamaephyte, Herbaceous
-
-
-
-## Find determinant species ------------------------------------------------------------------
-sp.DETERM = PRE_FATE.speciesClustering_step2(clust.dendrograms = sp.CLUST$clust.dendrograms
- , no.clusters = no.clusters
- , mat.species.DIST = tab.dist)
-names(sp.DETERM)
-str(sp.DETERM$determ.sp)
-str(sp.DETERM$determ.all)
-plot(sp.DETERM$plot.distance)
-plot(sp.DETERM$plot.PCO$Chamaephyte)
-plot(sp.DETERM$plot.PCO$Herbaceous)
-plot(sp.DETERM$plot.PCO$Phanerophyte)
-
-R/PRE_FATE.speciesClustering_step3.R
- PRE_FATE.speciesClustering_step3.RdThis script is designed to calculate PFG traits values based -on determinant species traits values. Either the mean or the -median is used depending on the trait class (i.e. numeric or -categorical).
-PRE_FATE.speciesClustering_step3(mat.traits, opt.mat.PA = NULL)a data.frame with at least 3 columns :
speciesthe ID of each determinant species (see
- PRE_FATE.speciesClustering_step2)
PFGthe corresponding Plant Functional Group (see
- PRE_FATE.speciesClustering_step2)
...one column for each functional trait (see
- Details)
(optional) default NULL.
-a data.frame with sites in rows and species in columns,
-containing either NA, 0 or 1 (see
-PRE_FATE.selectDominant)
A list containing one or two data.frame with the
-following columns, and one list with as many ggplot2 objects
-as functional traits given in mat.traits :
PFGthe concerned plant functional group
no.speciesthe number of species contained in this PFG
...one column for each functional trait, computed as the
- mean (for numeric traits) or the median (for categorical
- traits) of the values of the determinant species of this PFG
table containing counts of presences for all PFG - (sites in rows, PFG in columns)
...one for each functional trait, 'specific' cases
- excepted (see
- Details)
The information is written in PRE_FATE_PFG_TABLE_traits.csv,
-PRE_FATE_PFG_TABLE_sitesXPFG_PA.csv and
-PRE_FATE_CLUSTERING_STEP_3_PFGtraitsValues.pdf files.
This .csv file can be used to build parameter files to run a
-FATE simulation (e.g. PRE_FATE.params_PFGsuccession).
This function allows to obtain 'average' functional trait
-values for each Plant Functional Group, based on values at the determinant
-species level.
A graphic is automatically produced for each functional
-trait given, with boxplot representing the values of determinant species,
-and colored points the values calculated for each PFG.
-However, some traits can have 'specific' representation, as long as their
-names within mat.traits match one of the configuration detailed
-below :
maturity, longevityto visualize the difference
- between these two values, for the maturity time has an impact on the
- fecundity of the PFG within FATE (see
- CORE module)
-
If there is NO values for longevity within one PFG, and some
- maturity values are available, some values might be inferred as
- \(\text{maturity} * 2\). If there is NO values for maturity within
- one PFG, and some longevity values are available, some values might be
- inferred as \(\text{longevity} / 2\).
height, lightto visualize the PFG light
- preference, and help decide and understand the choice of the height
- limits of strata in FATE (see
- LIGHT
- interaction module)
soil_contrib, soil_tol_min, soil_tol_maxto visualize the PFG soil preference, and help
- parameterize the global parameters of the soil interaction module
- within FATE (see
- SOIL
- interaction module)
soil_contrib, soil_tolerancesame as the
- previous one, but soil_tol_min and soil_tol_max values
- are obtained by adding or removing soil_tolerance to
- soil_contrib
If a sites x species table is provided (opt.mat.PA), a sites x PFG
-table (containing NA, 0 or 1) is also returned.
-## Load example data
-Champsaur_PFG = .loadData('Champsaur_PFG', 'RData')
-
-## Species traits
-tab.traits = Champsaur_PFG$sp.traits
-str(tab.traits)
-
-## Determinant species
-tab.PFG = Champsaur_PFG$PFG.species
-str(tab.PFG)
-
-## Merge traits and PFG informations
-mat.traits = merge(tab.PFG[which(tab.PFG$DETERMINANT==TRUE), c('species','PFG')]
- , tab.traits
- , by = 'species', all.x = TRUE)
-str(mat.traits)
-
-## Keep only traits of interest
-mat.traits = mat.traits[, c('PFG', 'species', 'MATURITY', 'LONGEVITY'
- , 'HEIGHT', 'LIGHT', 'DISPERSAL'
- , 'NITROGEN', 'NITROGEN_TOLERANCE', 'LDMC', 'LNC')]
-colnames(mat.traits) = c('PFG', 'species', 'maturity', 'longevity'
- , 'height', 'light', 'dispersal'
- , 'soil_contrib', 'soil_tolerance', 'LDMC', 'LNC')
-mat.traits$soil_contrib = as.numeric(mat.traits$soil_contrib)
-mat.traits$soil_tolerance = ifelse(mat.traits$soil_tolerance == 1, 0.5, 1)
-
-## Compute traits per PFG : with one specific graphic ------------------------
-PFG.traits = PRE_FATE.speciesClustering_step3(mat.traits = mat.traits)
-
-names(PFG.traits)
-str(PFG.traits$tab.PFG.traits)
-str(PFG.traits$tab.PFG.PA)
-names(PFG.traits$plot)
-plot(PFG.traits$plot$maturity_longevity)
-plot(PFG.traits$plot$height_light)
-plot(PFG.traits$plot$soil)
-
-
-
-
-R/PRE_FATE.speciesDistance.R
- PRE_FATE.speciesDistance.RdThis script is designed to create a distance matrix between -species, combining functional distances (based on functional trait values) -and niche overlap (based on co-occurrence of species).
-PRE_FATE.speciesDistance(
- mat.traits,
- mat.overlap.option,
- mat.overlap.object,
- opt.weights = NULL,
- opt.maxPercent.NA = 0,
- opt.maxPercent.similarSpecies = 0.25,
- opt.min.sd = 0.3
-)a data.frame with at least 3 columns :
speciesthe ID of each studied species
GROUPa factor variable containing grouping information to
-divide the species into data subsets (see
-Details)
...one column for each functional trait
a string corresponding to the way to
-calculate the distance between species based on niche overlap (either
-PCA, raster or dist, see
-Details)
three options, depending on the value of
-mat.overlap.option :
(PCA option) a list with 2 elements :
tab.dom.PAa matrix or data.frame with
- sites in rows and species in columns, containing either NA,
- 0 or 1 (see PRE_FATE.selectDominant)
tab.enva matrix or data.frame with
- sites in rows and environmental variables in columns
(raster option) a data.frame with 2 columns :
speciesthe ID of each studied species
rasterpath to raster file with species distribution
(dist option) a similarity structure representing the
- niche overlap between each pair of species. It can be a dist
- object, a niolap object, or simply a matrix.
(optional) default NULL.
-A vector of two double (between 0 and 1)
-corresponding to the weights for traits and overlap distances
-respectively. They must sum up to 1.
(optional) default 0.
Maximum
-percentage of missing values (NA) allowed for each trait (between
-0 and 1)
(optional) default 0.25.
-
Maximum percentage of similar species (same value)
-allowed for each trait (between 0 and 1)
(optional) default 0.5.
Minimum
-standard deviation allowed for each trait (trait unit)
A list of 3 dist objects (functional distances,
-overlap distances, and combination of both according to the weights given
-(or not) by the opt.weights parameter), each of them corresponding
-to : the distance between each pair of species, or a list of
-dist objects, one for each GROUP value.
The information for the combination of both distances is written in
-PRE_FATE_DOMINANT_speciesDistance.csv file (or if necessary, one
-file is created for each group).
This function allows to obtain a distance matrix between species, -based on two types of distance information :
-Functional traits : -
The GROUP column is required if species must be separated
- to have one final distance matrix per GROUP value.
If the
- column is missing, all species will be considered as part of a unique
- dataset.
The traits can be qualitative or quantitative, but previously
- identified as such
(i.e. with the use of functions such as
- as.numeric, as.factor and ordered).
Functional distance matrix is calculated with Gower dissimilarity,
- using the gowdis function.
This function allows NA values.
However, too many
- missing values lead to misleading results. Hence, 3 parameters allow the
- user to play with the place given to missing values, and therefore the
- selection of traits that will be used for the distance computation :
traits with too many missing values are - removed
traits with too many - similar values are removed
traits with too little variability are removed
Niche overlap : -
If PCA option is selected, the degree of niche overlap will
- be computed using the ecospat.niche.overlap.
If raster option is selected, the degree of niche overlap will
- be computed using the niche.overlap.
Functional distances and niche overlap informations are then -combined according to the following formula :
-$$\text{mat.DIST}_{sub-group} = \frac{[\text{wei.FUNC} * -\text{mat.FUNCTIONAL}_{sub-group} + \text{wei.OVER} * -\text{mat.OVERLAP}_{sub-group}]}{[ \text{wei.FUNC} + \text{wei.OVER} ]}$$
-with :
-$$\text{wei.FUNC} = \text{opt.weights}[1]$$ -$$\text{wei.OVER} = \text{opt.weights}[2]$$
-if opt.weights is given, otherwise :
$$\text{wei.FUNC} = n_{traits}$$ -$$\text{wei.OVER} = 1$$
-meaning that distance matrix obtained from functional information -is weighted by the number of traits used.
-gowdis,
-ecospat.niche.overlap
-niche.overlap
-## Load example data
-Champsaur_PFG = .loadData('Champsaur_PFG', 'RData')
-
-## Species traits
-tab.traits = Champsaur_PFG$sp.traits
-tab.traits = tab.traits[, c('species', 'GROUP', 'MATURITY', 'LONGEVITY'
- , 'HEIGHT', 'DISPERSAL', 'LIGHT', 'NITROGEN')]
-str(tab.traits)
-
-## Species niche overlap (dissimilarity distances)
-tab.overlap = 1 - Champsaur_PFG$mat.overlap ## transform into similarity
-tab.overlap[1:5, 1:5]
-
-## Give warnings -------------------------------------------------------------
-sp.DIST = PRE_FATE.speciesDistance(mat.traits = tab.traits
- , mat.overlap.option = 'dist'
- , mat.overlap.object = tab.overlap)
-str(sp.DIST)
-
-## Change parameters to allow more NAs (and change traits used) --------------
-sp.DIST = PRE_FATE.speciesDistance(mat.traits = tab.traits
- , mat.overlap.option = 'dist'
- , mat.overlap.object = tab.overlap
- , opt.maxPercent.NA = 0.05
- , opt.maxPercent.similarSpecies = 0.3
- , opt.min.sd = 0.3)
-str(sp.DIST)
-
-if (FALSE) {
-require(foreach); require(ggplot2); require(ggdendro)
-pp = foreach(x = names(sp.DIST$mat.ALL)) %do%
- {
- hc = hclust(sp.DIST$mat.ALL[[x]])
- pp = ggdendrogram(hc, rotate = TRUE) +
- labs(title = paste0('Hierarchical clustering based on species distance '
- , ifelse(length(names(sp.DIST$mat.ALL)) > 1
- , paste0('(group ', x, ')')
- , '')))
- return(pp)
- }
-plot(pp[[1]])
-plot(pp[[2]])
-plot(pp[[3]])
-}
-
-R/PRE_FATE.speciesDistanceCombine.R
- PRE_FATE.speciesDistanceCombine.RdThis script is designed to create a distance matrix between -species, combining several dissimilarity distance matrices.
-PRE_FATE.speciesDistanceCombine(
- list.mat.dist,
- opt.min.noMat = length(list.mat.dist),
- opt.normal = TRUE,
- opt.weights = NULL
-)a list of matrices containing dissimilarity
-distance values between each pair of species.
(optional) default length(list.mat.dist).
-An integer corresponding to the minimal number of distance matrices for
-which each species should have values
(optional) default TRUE.
-If TRUE, all given distance matrices will be normalized
-(see Details)
(optional) default NULL.
-A vector of double (between 0 and 1)
-corresponding to the weights for each distance matrix provided in
-list.mat.dist. They must sum up to 1.
A matrix containing the weighted (or not) combination of
-the different transformed (or not) distance matrices given.
The information for the combination of all distances is written in
-PRE_FATE_DOMINANT_speciesDistance.csv file.
This function allows to obtain a distance matrix between species, -based on several dissimilarity distance matrices combined -according to the following formula :
-$$\text{mat.DIST} = \Sigma (\text{wei.i} * \text{mat.DIST}_{i})$$
-If opt.normal = TRUE, two normalization steps are applied
-to each distance matrix before combining them :
a non-paranormal (npn) transformation
- (huge.npn function) to obtain Gaussian distributions
- for all dissimilarity matrices used
a range normalization to bring the values back between
- 0 and 1 :
$$\text{mat.DIST}_{i} = \frac{\text{mat.DIST}_{i} - - min(\text{mat.DIST}_{i})}{max(\text{mat.DIST}_{i}) - - min(\text{mat.DIST}_{i})}$$
-## Load example data
-Champsaur_PFG = .loadData('Champsaur_PFG', 'RData')
-
-## Species traits
-tab.traits = Champsaur_PFG$sp.traits
-tab.traits = tab.traits[, c('species', 'GROUP', 'MATURITY', 'LONGEVITY'
- , 'HEIGHT', 'DISPERSAL', 'LIGHT', 'NITROGEN')]
-str(tab.traits)
-
-## Species niche overlap (dissimilarity distances)
-DIST.overlap = Champsaur_PFG$mat.overlap
-DIST.overlap[1:5, 1:5]
-
-## Species functional distances (dissimilarity)
-DIST.traits = PRE_FATE.speciesDistanceTraits(mat.traits = tab.traits
- , opt.maxPercent.NA = 0.05
- , opt.maxPercent.similarSpecies = 0.3
- , opt.min.sd = 0.3)
-DIST.traits$Chamaephyte[1:5, 1:5]
-
-## Combine distances ---------------------------------------------------------
-list.DIST = list(DIST.overlap, DIST.traits$Chamaephyte)
-sp.DIST.n = PRE_FATE.speciesDistanceCombine(list.mat.dist = list.DIST
- , opt.weights = c(0.2, 0.8))
-sp.DIST.un = PRE_FATE.speciesDistanceCombine(list.mat.dist = list.DIST
- , opt.norm = FALSE
- , opt.weights = c(0.2, 0.8))
-str(sp.DIST.n)
-
-
-
-if (FALSE) {
-require(corrplot)
-list.DIST = list(DIST.overlap, DIST.traits$Chamaephyte
- , sp.DIST.un, sp.DIST.n)
-names(list.DIST) = c('overlap', 'traits', 'un-normed', 'normed')
-
-par(mfrow = c(2, 2))
-for (li in 1:length(list.DIST))
-{
- tmp = list.DIST[[li]]
- tmp = tmp[colnames(sp.DIST.n), colnames(sp.DIST.n)]
- corrplot(tmp, method = 'shade'
- , type = 'lower', cl.lim = c(0, 1)
- , is.corr = FALSE, title = names(list.DIST)[li])
-}
-
-require(foreach); require(ggplot2); require(ggdendro)
-hc = hclust(as.dist(sp.DIST.n))
-pp = ggdendrogram(hc, rotate = TRUE) +
- labs(title = 'Hierarchical clustering based on species distances')
-plot(pp)
-}
-
-R/PRE_FATE.speciesDistanceOverlap.R
- PRE_FATE.speciesDistanceOverlap.RdThis script is designed to create a distance matrix between -species, based on co-occurrence of species.
-PRE_FATE.speciesDistanceOverlap(mat.overlap.option, mat.overlap.object)a string corresponding to the way to
-calculate the distance between species based on niche overlap (either
-PCA or raster, see
-Details)
two options, depending on the value of
-mat.overlap.option :
(PCA option) a list with 2 elements :
tab.dom.PAa matrix or data.frame with
- sites in rows and species in columns, containing either NA,
- 0 or 1 (see PRE_FATE.selectDominant)
tab.enva matrix or data.frame with
- sites in rows and environmental variables in columns
(raster option) a data.frame with 2 columns :
speciesthe ID of each studied species
rasterpath to raster file with species distribution
A matrix containing overlap distances between each pair
-of species, calculated as 1 - Schoeners D.
This function allows to obtain a distance matrix between species -(1 - Schoeners D), based on niche overlap information :
-If PCA option is selected, the degree of niche overlap will
- be computed using the ecospat.niche.overlap.
If raster option is selected, the degree of niche overlap will
- be computed using the niche.overlap.
ecospat.niche.overlap,
-niche.overlap
-## Load example data
-Champsaur_PFG = .loadData('Champsaur_PFG', 'RData')
-
-## Prepare sites x species table
-## Add absences in community sites
-sites = Champsaur_PFG$sp.observations
-tab.dom.PA = Champsaur_PFG$tab.dom.PA
-for (si in sites$sites[which(sites$TYPE == "COMMUNITY")])
-{
- ind = which(rownames(tab.dom.PA) == si)
- tab.dom.PA[ind, which(is.na(tab.dom.PA[ind, ]))] = 0
-}
-
-## Prepare environmental table
-tab.env = Champsaur_PFG$tab.env
-
-## Calculate niche overlap distances -----------------------------------------
-list.over = list(tab.dom.PA[, 1:10], tab.env)
-DIST.overlap = PRE_FATE.speciesDistanceOverlap(mat.overlap.option = "PCA"
- , mat.overlap.object = list.over)
-(DIST.overlap[1:5, 1:5])
-R/PRE_FATE.speciesDistanceTraits.R
- PRE_FATE.speciesDistanceTraits.RdThis script is designed to create a distance matrix between -species, based on functional trait values.
-PRE_FATE.speciesDistanceTraits(
- mat.traits,
- opt.maxPercent.NA = 0,
- opt.maxPercent.similarSpecies = 0.25,
- opt.min.sd = 0.3
-)a data.frame with at least 3 columns :
speciesthe ID of each studied species
GROUPa factor variable containing grouping information to
-divide the species into data subsets (see
-Details)
...one column for each functional trait
(optional) default 0.
Maximum
-percentage of missing values (NA) allowed for each trait (between
-0 and 1)
(optional) default 0.25.
-
Maximum percentage of similar species (same value)
-allowed for each trait (between 0 and 1)
(optional) default 0.5.
Minimum
-standard deviation allowed for each trait (trait unit)
A matrix containing functional distances between each pair
-of species, calculated as 1 - Schoeners D.
This function allows to obtain a distance matrix between species -(1 - Schoeners D), based on functional traits information :
-The GROUP column is required if species must be separated
- to have one final distance matrix per GROUP value.
If the
- column is missing, all species will be considered as part of a unique
- dataset.
The traits can be qualitative or quantitative, but previously
- identified as such
(i.e. with the use of functions such as
- as.numeric, as.factor and ordered).
Functional distance matrix is calculated with Gower dissimilarity,
- using the gowdis function.
This function allows NA values.
However, too many
- missing values lead to misleading results. Hence, 3 parameters allow the
- user to play with the place given to missing values, and therefore the
- selection of traits that will be used for the distance computation :
traits with too many missing values are - removed
traits with too many - similar values are removed
traits with too little variability are removed
-## Load example data
-Champsaur_PFG = .loadData('Champsaur_PFG', 'RData')
-
-## Species traits
-tab.traits = Champsaur_PFG$sp.traits
-tab.traits = tab.traits[, c('species', 'GROUP', 'MATURITY', 'LONGEVITY'
- , 'HEIGHT', 'DISPERSAL', 'LIGHT', 'NITROGEN')]
-str(tab.traits)
-
-## Give warnings -------------------------------------------------------------
-DIST.traits = PRE_FATE.speciesDistanceTraits(mat.traits = tab.traits)
-str(DIST.traits)
-
-## Change parameters to allow more NAs (and change traits used) --------------
-DIST.traits = PRE_FATE.speciesDistanceTraits(mat.traits = tab.traits
- , opt.maxPercent.NA = 0.05
- , opt.maxPercent.similarSpecies = 0.3
- , opt.min.sd = 0.3)
-str(DIST.traits)
-
-if (FALSE) {
-require(foreach); require(ggplot2); require(ggdendro)
-pp = foreach(x = names(DIST.traits)) %do%
- {
- hc = hclust(as.dist(DIST.traits[[x]]))
- pp = ggdendrogram(hc, rotate = TRUE) +
- labs(title = paste0('Hierarchical clustering based on species distance '
- , ifelse(length(names(DIST.traits)) > 1
- , paste0('(group ', x, ')')
- , '')))
- return(pp)
- }
-plot(pp[[1]])
-plot(pp[[2]])
-plot(pp[[3]])
-}
-
-RFate functions and run
-FATE simulationR/RFATE.R
- RFATE.RdThis shiny application allows to use all
-the RFate functions (PRE_FATE, FATE and
-POST_FATE), from the building of PFG to the treatment of FATE
-output files.
RFATE()R/SAVE_FATE.step1_PFG.R
- SAVE_FATE.step1_PFG.RdThis script is designed to gather all data and parameters -used to build a set of Plant Functional Groups.
-SAVE_FATE.step1_PFG(
- name.dataset,
- mat.observations,
- rules.selectDominant = c(doRuleA = NA, rule.A1 = NA, rule.A2_quantile = NA, doRuleB =
- NA, rule.B1_percentage = NA, rule.B1_number = NA, rule.B2 = NA, doRuleC = NA),
- mat.traits,
- mat.overlap = NA,
- rules.speciesDistance = c(opt.maxPercent.NA = NA, opt.maxPercent.similarSpecies = NA,
- opt.min.sd = NA),
- mat.species.DIST,
- clust.evaluation = NA,
- no.clusters,
- determ.all,
- mat.traits.PFG
-)a string corresponding to the name to give to
-archive folder
a data.frame with at least 3 columns : sites, species, abund (and optionally,
-habitat) (see PRE_FATE.selectDominant)
(optional) default NA.
A
-vector containing all the parameter values given to the
-PRE_FATE.selectDominant function, if used
-(doRuleA, rule.A1, rule.A2_quantile, doRuleB,
-rule.B1_percentage, rule.B1_number, rule.B2,
-doRuleC).
a data.frame with at least 3 columns :
-species, GROUP, ... (one column for each functional
-trait)
(see PRE_FATE.speciesDistance)
(optional) default NA.
-Otherwise, two options :
a data.frame with 2 columns : species, raster
a dissimilarity structure representing the niche overlap between
- each pair of species.
It can be a dist object, a
- niolap object, or simply a matrix.
(see PRE_FATE.speciesDistance)
(optional) default NA.
A
-vector containing all the parameter values given to the
-PRE_FATE.speciesDistance function, if used
(
-opt.maxPercent.NA, opt.maxPercent.similarSpecies,
-opt.min.sd).
a dist object, or a list of
-dist objects (one for each GROUP value), corresponding to the
-distance between each pair of species.
Such an object can be obtained
-with the PRE_FATE.speciesDistance function.
(optional) default NA.
A
-data.frame with 4 columns : GROUP, no.clusters, variable, value.
Such an
-object can be obtained with the
-PRE_FATE.speciesClustering_step1 function.
an integer, or a vector of integer
-(one for each GROUP value), with the number of clusters to be kept
-(see PRE_FATE.speciesClustering_step2)
a data.frame with 6 or 10 columns : PFG, GROUP, ID.cluster, species,
-ID.species, DETERMINANT
(and optionally,
-sp.mean.dist, allSp.mean, allSp.min,
-allSp.max).
Such an object can be obtained
-with the PRE_FATE.speciesClustering_step2 function.
a data.frame with at least 3 columns :
-PFG, no.species, ... (one column for each functional
-trait, computed as the mean (for numeric traits) or the median
-(for categorical traits) of the values of the determinant species of this
-PFG).
Such an object can be obtained with the
-PRE_FATE.speciesClustering_step3 function.
A list containing all the elements given to the function and
-checked :
name of the dataset
(see PRE_FATE.selectDominant)
sitesname of sampling site
(x, y)coordinates of sampling site
speciesname of the concerned species
abundabundance of the concerned species
(habitat)habitat of sampling site
a vector containing values for the
- parameters doRuleA, rule.A1, rule.A2_quantile,
- doRuleB, rule.B1_percentage, rule.B1_number,
- rule.B2, doRuleC (see PRE_FATE.selectDominant)
(see PRE_FATE.speciesDistance)
speciesname of the concerned species
GROUPname of the concerned data subset
...one column for each functional trait
a dist object corresponding to the distance
- between each pair of species in terms of niche overlap (see
- PRE_FATE.speciesDistance)
a vector containing values for the
- parameters opt.maxPercent.NA, opt.maxPercent.similarSpecies,
- opt.min.sd (see PRE_FATE.speciesDistance)
a dist object corresponding to the distance
- between each pair of species, or a list of dist objects, one
- for each GROUP value (see PRE_FATE.speciesDistance)
(see PRE_FATE.speciesClustering_step1)
GROUPname of data subset
no.clustersnumber of clusters used for the clustering
variableevaluation metrics' name
valuevalue of evaluation metric
number of clusters to be kept for each data subset
(see PRE_FATE.speciesClustering_step2)
PFGID of the plant functional group
- (GROUP + ID.cluster)
GROUPname of data subset
ID.clustercluster number
speciesname of species
ID.speciesspecies number in each PFG
DETERMINANTTRUE if determinant species, FALSE
- otherwise
(sp.mean.dist)species mean distance to other species of - the same PFG
(allSp.mean)\(mean(\text{sp.mean.dist})\) within the PFG
(allSp.min)\(mean(\text{sp.mean.dist}) - 1.64 * - sd(\text{sp.mean.dist})\) within the PFG
(allSp.max)\(mean(\text{sp.mean.dist}) + 1.64 * - sd(\text{sp.mean.dist})\) within the PFG
(see PRE_FATE.speciesClustering_step3)
PFGname of the concerned functional group
no.speciesnumber of species in the concerned PFG
...one column for each functional trait
The information is written in FATE_dataset_[name.dataset]_step1_PFG.RData file.
-## Load example data
-R/SAVE_FATE.step2_parameters.R
- SAVE_FATE.step2_parameters.RdThis script is designed to gather all data and parameters
-used to build a FATE simulation folder.
SAVE_FATE.step2_parameters(
- name.dataset,
- name.simulation = NA,
- strata.limits,
- mat.PFG.succ,
- mat.PFG.light = NULL,
- mat.PFG.light.tol = NULL,
- mat.PFG.soil = NULL,
- mat.PFG.soil.tol = NULL,
- mat.PFG.disp = NULL,
- mat.PFG.dist = NULL,
- mat.PFG.dist.tol = NULL,
- mat.PFG.drought = NULL,
- mat.PFG.drought.tol = NULL,
- rasters = list(name.MASK = NA, name.DIST = NA, name.DROUGHT = NA, name.FIRE = NA,
- name.ELEVATION = NA, name.SLOPE = NA),
- multipleSet = list(name.simulation.1 = NA, name.simulation.2 = NA, file.simulParam.1 =
- NA, file.simulParam.2 = NA, no_simulations = NA, opt.percent_maxAbund = NA,
- opt.percent_seeding = NA, opt.percent_light = NA, opt.percent_soil = NA,
- do.max_abund_low = NA, do.max_abund_medium = NA, do.max_abund_high = NA,
- do.seeding_duration = NA, do.seeding_timestep = NA, do.seeding_input = NA,
- do.no_strata = NA, do.LIGHT.thresh_medium = NA, do.LIGHT.thresh_low = NA,
- do.SOIL.init = NA, do.SOIL.retention = NA, do.DISPERSAL.mode = NA,
-
- do.HABSUIT.mode = NA)
-)a string corresponding to the name to give to
-archive folder
(optional) default NA.
-A string corresponding to the name of the simulation folder
a vector of integer containing height
-strata limits
a data.frame with at least 5 columns : PFG, type, height, maturity, longevity
-
(and optionally, max_abundance, potential_fecundity,
-immature_size, is_alien, flammability)
-
(see PRE_FATE.params_PFGsuccession)
(optional) default NA.
-A data.frame with 2 to 6 columns :
PFG,
type, (or active_germ_low,
- active_germ_medium, active_germ_high) (or
- strategy_ag)
type, light_need
(see PRE_FATE.params_PFGlight)
(optional) default NA.
-A data.frame with 2 to 4 columns :
PFG,
lifeStage, resources, tolerance
- (or strategy_tol)
(see PRE_FATE.params_PFGlight)
(optional) default NA.
-A data.frame with 3 to 7 columns :
PFG,
type, (or active_germ_low,
- active_germ_medium, active_germ_high) (or
- strategy_ag)
soil_contrib, soil_tol_min, soil_tol_max
- (or strategy_contrib)
(see PRE_FATE.params_PFGsoil)
(optional) default NA.
-A data.frame with 2 to 4 columns :
PFG,
lifeStage, resources, tolerance
- (or strategy_tol)
(see PRE_FATE.params_PFGsoil)
(optional) default NA.
-A data.frame with 4 columns : PFG, d50, d99,
-ldd (see PRE_FATE.params_PFGdispersal)
(optional) default NA.
-A data.frame with 5 columns : PFG, type, maturity, longevity,
-age_above_150cm (see PRE_FATE.params_PFGdisturbance)
(optional) default NA.
-A data.frame with 3 to 7 columns :
nameDist,
PFG,
(responseStage, breakAge, resproutAge),
responseStage, killedIndiv, resproutIndiv
- (or strategy_tol)
(optional) default NA.
-A data.frame with 4 or 6 columns :
PFG,
threshold_moderate, threshold_severe,
counter_recovery, counter_sens, counter_cum
- (or strategy_drou)
(optional) default NA.
-A data.frame with 3 to 7 columns :
nameDist,
PFG,
(responseStage, breakAge, resproutAge),
responseStage, killedIndiv, resproutIndiv
- (or strategy_tol)
a list containing all the rasters given to the
-PRE_FATE.params_simulParameters function, if used
-(name.MASK, name.DIST, name.DROUGHT, name.FIRE,
-name.ELEVATION, name.SLOPE)
a list containing all the parameter values given
-to the PRE_FATE.params_multipleSet function, if used
-(name.simulation.1, name.simulation.2,
-file.simulParam.1, file.simulParam.2,
-no_simulations, opt.percent_maxAbund,
-opt.percent_seeding, opt.percent_light,
-opt.percent_soil, do.max_abund_low,
-do.max_abund_medium, do.max_abund_high,
-do.seeding_duration, do.seeding_timestep,
-do.seeding_input, do.no_strata,
-do.LIGHT.thresh_medium, do.LIGHT.thresh_low,
-do.SOIL.init, do.SOIL.retention,
-do.DISPERSAL.mode, do.HABSUIT.mode)
A list containing all the elements given to the function and
-checked, and two archive files :
name of the dataset
height strata limits
raster files of all simulation masks
name of the simulation folder
DATA folder)contained in name.simulation folder
- and archived
PARAM_SIMUL folder)contained in name.simulation
- folder and archived
The information is written in FATE_dataset_[name.dataset]_step2_parameters.RData file.
PRE_FATE.skeletonDirectory,
-PRE_FATE.params_PFGsuccession,
-PRE_FATE.params_PFGlight,
-PRE_FATE.params_PFGsoil,
-PRE_FATE.params_PFGdispersal,
-PRE_FATE.params_PFGdisturbance,
-PRE_FATE.params_PFGdrought,
-PRE_FATE.params_changingYears,
-PRE_FATE.params_savingYears,
-PRE_FATE.params_globalParameters,
-PRE_FATE.params_simulParameters,
-PRE_FATE.params_multipleSet
-## Load example data
-R/UTILS.package_betapart.R
- beta.pair.RdFrom betapart package 1.5.4 : beta.pair and betapart.core functions
-betapart.core(x)
-beta.pair(x, index.family = "sorensen")data frame, where rows are sites and columns are species. -Alternatively x can be a betapart object derived from the betapart.core -function
family of dissimilarity indices, partial match of -"sorensen" or "jaccard".
beta.pair
R/UTILS.package_fpc.R
- cluster.stats.RdFrom fpc package 2.2-9 : cluster.stats function
-cluster.stats(
- d = NULL,
- clustering,
- alt.clustering = NULL,
- noisecluster = FALSE,
- silhouette = TRUE,
- G2 = FALSE,
- G3 = FALSE,
- wgap = TRUE,
- sepindex = TRUE,
- sepprob = 0.1,
- sepwithnoise = TRUE,
- compareonly = FALSE,
- aggregateonly = FALSE
-)a distance object (as generated by dist) or a distance matrix -between cases.
an integer vector of length of the number of cases, -which indicates a clustering. The clusters have to be numbered from 1 to -the number of clusters.
an integer vector such as for clustering, indicating -an alternative clustering. If provided, the corrected Rand index and -Meila's VI for clustering vs. alt.clustering are computed.
logical. If TRUE, it is assumed that the largest -cluster number in clustering denotes a 'noise class', i.e. points that do -not belong to any cluster. These points are not taken into account for the -computation of all functions of within and between cluster distances -including the validation indexes.
logical. If TRUE, the silhouette statistics are computed, -which requires package cluster.
logical. If TRUE, Goodman and Kruskal's index G2 (cf. Gordon -(1999), p. 62) is computed. This executes lots of sorting algorithms and -can be very slow (it has been improved by R. Francois - thanks!)
logical. If TRUE, the index G3 (cf. Gordon (1999), p. 62) is -computed. This executes sort on all distances and can be extremely slow.
logical. If TRUE, the widest within-cluster gaps (largest -link in within-cluster minimum spanning tree) are computed. This is used -for finding a good number of clusters in Hennig (2013).
logical. If TRUE, a separation index is computed, defined -based on the distances for every point to the closest point not in the -same cluster. The separation index is then the mean of the smallest -proportion sepprob of these. This allows to formalise separation less -sensitive to a single or a few ambiguous points. The output component -corresponding to this is sindex, not separation! This is used for finding -a good number of clusters in Hennig (2013).
numerical between 0 and 1, see sepindex.
logical. If TRUE and sepindex and noisecluster are -both TRUE, the noise points are incorporated as cluster in the separation -index (sepindex) computation. Also they are taken into account for the -computation for the minimum cluster separation.
logical. If TRUE, only the corrected Rand index and -Meila's VI are computed and given out (this requires alt.clustering to -be specified).
logical. If TRUE (and not compareonly), no -clusterwise but only aggregated information is given out (this cuts -the size of the output down a bit).
cluster.stats
R/UTILS.package_SPOT.R
- designLHD.RdFrom SPOT package 2.5.0 : designLHD and designLHDNorm functions
-designLHDNorm(dim, size, calcMinDistance = FALSE, nested = NULL,
-inequalityConstraint = NULL)
-designLHD(x = NULL, lower, upper, control = list())number, dimension of the problem (will be no. of columns of -the result matrix)
number of points with that dimension needed. (will be no. -of rows of the result matrix).
Boolean to indicate whether a minimal distance -should be calculated.
nested design to be considered during distance calculation.
inequality constraint function, smaller zero -for infeasible points. Used to replace infeasible points with random -points. Has to evaluate points in interval [0;1].
optional matrix x, rows for points, columns for dimensions. This -can contain one or more points which are part of the design, but specified -by the user. These points are added to the design, and are taken into -account when calculating the pair-wise distances. They do not count for -the design size. E.g., if x has two rows, control$replicates is one and -control$size is ten, the returned design will have 12 points (12 rows). -The first two rows will be identical to x. Only the remaining ten rows are -guaranteed to be a valid LHD.
vector with lower boundary of the design variables (in case -of categorical parameters, please map the respective factor to a set of -contiguous integers, e.g., with lower = 1 and upper = number of levels)
vector with upper boundary of the design variables (in case -of categorical parameters, please map the respective factor to a set of -contiguous integers, e.g., with lower = 1 and upper = number of levels)
list of controls: see designLHD
R/UTILS.abgFunctions.R
- divLeinster.RdThis function calculates the diversity of each site of a site -by species matrix according to the q parameter according to -Leinster & Cobbold 2012 Ecology.
-divLeinster(spxp, Z = NULL, q = 2, check = TRUE)a site (row) by species (cols) matrix with or without
-rownames and colnames
default NULL.
A species by species similarity
-matrix
default 2.
An integer corresponding to the
-importance attributed to relative abundances
(optional) default TRUE.
If TRUE, the
-given arguments will be checked
FATE simulation folder (change NA
-to 0, and save as .tif)R/UTILS.adaptMaps.R
- dot-adaptMaps.RdThis function scan all the raster files within a FATE
-simulation folder, change all NA values to 0, potentially reproject onto
-a raster mask and save them with the specified extension.
.adaptMaps(
- name.simulation,
- opt.name.file = NULL,
- extension.old,
- extension.new = NULL,
- opt.name.MASK = NULL
-)a string corresponding to the main directory
-or simulation name of the FATE simulation
(optional)
a string corresponding
-to the complete or partial name of the file in which to search and change
-the pattern
a string corresponding to the extension of
-raster files to be found
(optional)
a string (either
-tif or img) corresponding to the new extension to save all
-the maps
(optional) default NULL.
-A string corresponding to the file name of a raster
-mask, with either 0 or 1 within each pixel, 1
-corresponding to the cells of the studied area in which the succession
-(core) module of the FATE simulation will take place (see
-PRE_FATE.params_globalParameters)
Create a text file containing value(s) for one or several -parameters and separated by a same character value.
-.createParams(params.file, params.list, separator = " ")a string corresponding to the name of the file
-that will be created
a list containing all the parameters that will be
-included into params.file, and whose names correspond to the
-parameter names
a string to separate each parameter values within
-the parameter file
R/UTILS.getCutoff.R
- dot-getCutoff.RdThis function finds the best cutoff to transform abundance -values into binary values while optimising sensitivity and specificity -values based on observations
-.getCutoff(Obs, Fit)a vector containing binary observed values (0 or
-1)
a vector containing relative abundance values (between
-0 and 1)
R/UTILS.getELLIPSE.R
- dot-getELLIPSE.RdObtain ellipse coordinates from (PCO) X,Y and a factor value
-util.ELLIPSE2(mx, my, vx, cxy, vy, coeff)
-util.ELLIPSE1(x, y, z)
-.getELLIPSE(xy, fac)\(\Sigma x * \frac{z}{\Sigma z}\)
\(\Sigma y * \frac{z}{\Sigma z}\)
\(\Sigma (x - mx) * (x - mx) * \frac{z}{\Sigma z}\)
\(\Sigma (x - mx) * (y - my) * \frac{z}{\Sigma z}\)
\(\Sigma (y - my) * (y - my) * \frac{z}{\Sigma z}\)
default 1
a data.frame or matrix with 2 columns corresponding
-to individuals coordinates, extracted from example from
-dudi.pco analysis
a vector containing group labels for individuals (with
-length(fac) = nrow(xy))
a vector corresponding to abscissa coordinates of
-individuals (column 1 of xy)
a vector corresponding to ordinate coordinates of
-individuals (column 2 of xy)
a data.frame with one column for each level represented in
-fac and nrow(z) = length(fac) = nrow(xy). Values are
-corresponding to the relative representation of each level (for level
-i : \(\frac{1}{N_i}\))
This functions finds on which operating sytem the user is
-currently using RFate. It notably allows to set the use of
-parallelisation.
.getOS()This function extracts from a text file the value(s) of a -given parameter.
-.getParam(params.lines, flag, flag.split, is.num = TRUE)a string corresponding to the name of the file
-from which to extract the parameter value
a string corresponding to the parameter name to be
-extracted and that must be present into the param.lines file
a string to choose the concerned type of parameter
-(either " " or "^--.*--$"), depending on the type of parameter
-file (containing values or filenames)
default TRUE.
If TRUE, the extracted
-parameter is considered to be numeric and will be processed as such
A vector containing one or more values of type string
(if is.num = FALSE) or numeric (if is.num = TRUE).
-## Create a skeleton folder with the default name ('FATE_simulation')
-if (dir.exists("FATE_simulation")) unlink("FATE_simulation", recursive = TRUE)
-PRE_FATE.skeletonDirectory()
-
-## Create a Global_parameters file
-PRE_FATE.params_globalParameters(name.simulation = "FATE_simulation"
- , required.no_PFG = 6
- , required.no_strata = 5
- , required.simul_duration = 100
- , required.seeding_duration = c(10,50)
- , required.seeding_timestep = 1
- , required.seeding_input = 100
- , required.max_abund_low = 30000
- , required.max_abund_medium = 50000
- , required.max_abund_high = 90000)
-
-## Extract number of PFG
-.getParam(params.lines = "FATE_simulation/DATA/GLOBAL_PARAMETERS/Global_parameters_V1.txt"
- , flag = "NO_PFG"
- , flag.split = " "
- , is.num = TRUE)
-
-
-## ----------------------------------------------------------------------------------------- ##
-
-## Load example data
-
-This function loads one of the available datasets :
-elements to create Plant Functional Groups (PFG)
- over Champsaur valley, in Ecrins National Park (PNE)
all necessary files to build the FATE
- simulation folder as well as the parameter files
simulation folder and outputs obtained
- from FATE simulation
results obtained from outputs and
- POST_FATE functions
.loadData(data.name, format.name)a string corresponding to the name of the dataset
-that will be loaded
a string corresponding to the downloading format way
-(either RData or 7z)
Note :
- -references to habitat refer to habitat map and classes from -CESBIO2018. -Some class gathering has been made, as follow :
- - - -0 - Other : 0, 21, 22, 23
1 - Urban : 1, 2, 3, 4
2 - Crops : 5, 6, 7, 8, 9, 10, 11, 12
3 - Prairies : 13
4 - Orchards, vineyards : 14, 15
5 - Deciduous forests : 16
6 - Coniferous forests : 17
7 - Natural grasslands : 18
8 - Woody heathlands : 19
9 - Mineral surfaces : 20
#########################################################
>>> Champsaur_PFG
- - -
#########################################################
A list object with 18 elements to help building the Plant Functional
-Group :
Champsaur
a data.frame of dimension
- 127257 x 6
- containing releves data about plant species in Champsaur
- to be used with the PRE_FATE.selectDominant function
sites : sites ID
species : species ID
abundBB : Braun-Blanquet abundance
abund : relative abundance obtained from the
- abund_BB column with the
- PRE_FATE.abundBraunBlanquet function
habitat : habitat classes (gathered) from CESBIO2018
TYPE : type of records, exhaustive (COMMUNITY)
- or single occurrences (OCCURRENCE)
a vector containing parameters to be
- given to the PRE_FATE.selectDominant function
- (doRuleA, rule.A1, rule.A2_quantile, doRuleB,
- rule.B1_percentage, rule.B1_number, rule.B2,
- doRuleC)
a list obtained from the
- PRE_FATE.selectDominant function run with
- sp.observations and rules.selectDominant
a data.frame of dimension 250 x 23
- containing traits for dominant species
- to be used with the PRE_FATE.speciesDistance function
species : species ID
GROUP : rough generalization of Raunkier life-forms - (Phanerophyte, Chamaephyte, Herbaceous)
MATURITY / LONGEVITY / HEIGHT / LDMC / LNC / SEEDM / - SLA : numerical values
LONGEVITY_log / HEIGHT_log / LDMC_log / LNC_log / - SEEDM_log / SLA_log : log-transformed numerical values
DISPERSAL / LIGHT / NITROGEN / NITROGEN_TOLERANCE / - MOISTURE / GRAZ_MOW_TOLERANCE / HABITAT / STRATEGY : categorical - values
a data.frame of dimension 20 x 9
- a subset of sp.traits (LONGEVITY_log / HEIGHT_log / SEEDM_log
- / SLA_log / DISPERSAL / LIGHT / NITROGEN) for Phanerophyte dominant
- species
- to be used with the PRE_FATE.speciesDistance function
a data.frame of dimension 38 x 6
- a subset of sp.traits (HEIGHT_log / SEEDM_log / LIGHT /
- NITROGEN) for Chamaephyte dominant species
- to be used with the PRE_FATE.speciesDistance function
a data.frame of dimension 192 x 7
- a subset of sp.traits (HEIGHT_log / LDMC_log /
- LNC_log / SLA_log / LIGHT) for Herbaceous dominant species
- to be used with the PRE_FATE.speciesDistance function
matrix of dimension 240 x 240
- containing habitat dissimilarity distance (1 - Schoeners' D, obtained
- with gowdis) for dominant species
- to be used with the PRE_FATE.speciesDistance function
matrix of dimension 13654 x 264
- containing dominant species occurrences and absences (obtained from
- sp.SELECT object and absences corrected with the TYPE
- information of sp.observations), to build mat.overlap
matrix of dimension 13590 x 5
- containing environmental values (bio1, bio12, slope, dem, CESBIO2018)
- for sites, to build mat.overlap
matrix of dimension 244 x 244
- containing niche overlap distance (1 - Schoeners' D, obtained with
- ecospat.niche.overlap) for dominant species
- to be used with the PRE_FATE.speciesDistance function
a list obtained from the
- PRE_FATE.speciesDistance function run for Phanerophyte
- dominant species with mat.habitat, mat.overlap and
- sp.traits.P parameters
a list obtained from the
- PRE_FATE.speciesDistance function run for Chamaephyte
- dominant species with mat.habitat, mat.overlap and
- sp.traits.C parameters
a list obtained from the
- PRE_FATE.speciesDistance function run for Herbaceous
- dominant species with mat.habitat, mat.overlap and
- sp.traits.H parameters
data.frame of dimension 224 x 5
- containing dominant species information relative to PFG
- obtained from the PRE_FATE.speciesClustering_step2
- function
PFG : name of assigned Plant Functional Group
DETERMINANT : is the species kept as determinant
- species within the PFG ?
(see
- PRE_FATE.speciesClustering_step2 function for details)
species : species ID
species_name : species name (taxonomic)
species_genus : species genus (taxonomic)
data.frame of dimension 15 x 12
- containing traits for plant functional groups
- obtained from the PRE_FATE.speciesClustering_step3
- function
PFG : Plant Functional Group short name
no.species : number of species within each group
maturity : MEAN age of maturity
longevity : MEAN age of lifespan
height : MEAN height (cm)
light : MEDIAN Landolt indicator value for light - preference (from 1 to 5)
dispersal : MEDIAN classes (from 1 to 7) based on - dispersal distances and types (Vittoz & Engler)
soil_contrib : MEAN Landolt indicator value for - nitrogen preference (from 1 to 5)
soil_tol_min : MIN tolerance value for nitrogen - preference (based on Landolt indicators, from 1 to 5)
soil_tol_max : MAX tolerance value for nitrogen - preference (based on Landolt indicators, from 1 to 5)
LDMC : MEAN LDMC
LNC : MEAN LNC
data.frame of dimension 13654 x 15
- containing PFG occurrences and absences obtained from
- tab.dom.PA object and the
- PRE_FATE.speciesClustering_step3 function
#########################################################
>>> Champsaur_params
- - -
#########################################################
A list object with 12 elements to help building the simulation
-files and folders to run a FATE simulation :
Champsaur
a data.frame of dimension 13590 x 15
- containing presence / absence (NA, 0 or 1) values
- per site for each PFG
a data.frame of dimension 13590 x 5
- containing environmental values (bio1, bio12, slope, dem, CESBIO2018)
- for each site
a data.frame of dimension 13590 x 2
- containing coordinates for each site
a stack object of dimension
- 358 x 427 with a resolution of 100m and ETRS89
- projection, containing 3 layers with environmental values (bio1,
- slope, CESBIO2018) and to be used to produce PFG SDM
a data.frame of dimension 15 x 5
- containing PFG characteristics (type, height, maturity, longevity)
- to be used with the PRE_FATE.params_PFGsuccession
- function
a data.frame of dimension 15 x 4
- containing PFG characteristics (d50, d99, ldd)
- to be used with the PRE_FATE.params_PFGdispersal
- function
a data.frame of dimension 15 x 3
- containing PFG characteristics (nameDist, strategy_tol)
- to be used with the PRE_FATE.params_PFGdisturbance
- function
a data.frame of dimension 15 x 3
- containing PFG characteristics (type, strategy_tol)
- to be used with the PRE_FATE.params_PFGlight
- function
a data.frame of dimension 15 x 5
- containing PFG characteristics (type, soil_contrib, soil_tol_min,
- soil_tol_max)
- to be used with the PRE_FATE.params_PFGsoil
- function
a stack object of dimension
- 358 x 427 with a resolution of 100m and ETRS89
- projection, containing 15 layers with habitat suitability values
- (between 0 and 1) for each PFG
a stack object of dimension
- 358 x 427 with a resolution of 100m and ETRS89
- projection, containing 4 mask layers with binary values (0 or 1) or
- categorical values (habitat) to be used in a FATE simulation :
Champsaur : simulation map, where occurs succession
noDisturb : perturbation map, when there is none
mowing : perturbation map, where occurs mowing
habitat : habitat map, from CESBIO2018 (gathered)
#########################################################
>>> Champsaur_simul_[...]
- - -
#########################################################
A 7z file containing one FATE simulation result folder.
4 simulations are available :
- - -a simulation with only basic modules activated :
CORE
- (succession) module, dispersal module, and habitat
- suitability module
the same as V1 + the light module
the same as V1 + the soil module
the same as V1 + the light and soil - modules
#########################################################
>>> Champsaur_results_[...]
- - -
#########################################################
A 7z file containing .csv and .pdf files
obtained from the corresponding FATE simulation result folder
-(4 simulations available) with the help of
-POST_FATE functions.
R package and install it if necessaryR/UTILS.loadPackage.R
- dot-loadPackage.RdThis function loads a R package and install it if
-necessary.
.loadPackage(package.name)a string corresponding to the name of the package
-that will be loaded or installed
FATE
-simulation folderR/UTILS.scaleMaps.R
- dot-scaleMaps.RdThese functions scan all the raster files within a
-FATE simulation folder and upscale / downscale / crop them
-to the specified resolution / extent.
.scaleMaps(name.simulation, resolution)
-.cropMaps(name.simulation, extent)a string corresponding to the main directory
-or simulation name of the FATE simulation
an integer corresponding to the new resolution to
-upscale/downscale all the maps
a vector of 4 numeric values corresponding to
-the new extent to crop all the maps
This function finds in a text file the value(s) of a given -parameter, and replace it with new value(s).
-.setParam(params.lines, flag, flag.split, value)a string corresponding to the name of the file
-from which to replace the parameter value
a string corresponding to the parameter name to be
-extracted and that must be present into the param.lines file
a string to choose the concerned type of parameter
-(either " " or "^--.*--$"), depending on the type of parameter
-file (containing values or filenames)
a string or a numeric value (it can also be a
-vector) containing the new value of the parameter to be changed
-## Create a skeleton folder with the default name ('FATE_simulation')
-if (dir.exists("FATE_simulation")) unlink("FATE_simulation", recursive = TRUE)
-PRE_FATE.skeletonDirectory()
-
-## Create a Global_parameters file
-PRE_FATE.params_globalParameters(name.simulation = "FATE_simulation"
- , required.no_PFG = 6
- , required.no_strata = 5
- , required.simul_duration = 100
- , required.seeding_duration = c(10,50)
- , required.seeding_timestep = 1
- , required.seeding_input = 100
- , required.max_abund_low = 30000
- , required.max_abund_medium = 50000
- , required.max_abund_high = 90000)
-
-readLines("FATE_simulation/DATA/GLOBAL_PARAMETERS/Global_parameters_V1.txt")
-
-## Change number of PFG
-.setParam(params.lines = "FATE_simulation/DATA/GLOBAL_PARAMETERS/Global_parameters_V1.txt"
- , flag = "NO_PFG"
- , flag.split = " "
- , value = 14)
-
-readLines("FATE_simulation/DATA/GLOBAL_PARAMETERS/Global_parameters_V1.txt")
-
-
-## ----------------------------------------------------------------------------------------- ##
-
-## Load example data
-
-FATE simulation folderR/UTILS.setPattern.R
- dot-setPattern.RdThis function scans all the files within a FATE
-simulation folder to find a specific pattern and replace it with a new one
.setPattern(
- name.simulation,
- opt.name.file = NULL,
- pattern.tofind,
- pattern.toreplace
-)a string corresponding to the main directory
-or simulation name of the FATE simulation
(optional)
a string corresponding
-to the complete or partial name of the file in which to search and change
-the pattern
a string corresponding to the pattern to find
a string corresponding to the pattern to
-replace
-## Create a skeleton folder with the default name ('FATE_simulation')
-if (dir.exists("FATE_simulation")) unlink("FATE_simulation", recursive = TRUE)
-PRE_FATE.skeletonDirectory()
-
-## Create a Global_parameters file
-PRE_FATE.params_globalParameters(name.simulation = "FATE_simulation"
- , required.no_PFG = 6
- , required.no_strata = 5
- , required.simul_duration = 100
- , required.seeding_duration = c(10,50)
- , required.seeding_timestep = 1
- , required.seeding_input = 100
- , required.max_abund_low = 30000
- , required.max_abund_medium = 50000
- , required.max_abund_high = 90000)
-
-
-## Change number of PFG
-readLines("FATE_simulation/DATA/GLOBAL_PARAMETERS/Global_parameters_V1.txt")
-
-.setPattern(name.simul = "FATE_simulation"
- , opt.name.file = "Global_parameters_V1.txt"
- , pattern.tofind = "NO_PFG 6"
- , pattern.toreplace = "NO_PFG 14")
-
-readLines("FATE_simulation/DATA/GLOBAL_PARAMETERS/Global_parameters_V1.txt")
-
-
-## ----------------------------------------------------------------------------------------- ##
-
-## Load example data
-
-.tif, .img) or decompress (.gz) files
-contained in results folderR/UTILS.zipUnzip.R
- dot-unzip_ALL.RdThese functions compress (.tif, .img) or
-decompress (.gz) files contained in a given folder.
.unzip_ALL(folder_name, no_cores)
-.unzip(folder_name, list_files, no_cores)
-.zip_ALL(folder_name, no_cores)
-.zip(folder_name, list_files, no_cores)a string corresponding to the directory to be
-scanned
a vector containing filenames to be compress or
-decompress, in order not to scan the whole given directory
default 1.
an integer corresponding to the
-number of computing resources that can be used to parallelize the
-(de)compression
From clValid package O.7 : dunn function
-dunn(distance = NULL, clusters)The distance matrix (as a matrix object) of the clustered -observations. Required if Data is NULL.
An integer vector indicating the cluster partitioning
dunn
R/UTILS.package_ecospat.R
- ecospat.niche.overlap.RdFrom ecospat package 3.2 : ecospat.kd, ecospat.grid.clim.dyn and -ecospat.niche.overlap functions (and sp 1.4-5, adehabitatMA 0.3.14, -adehabitatHR 0.4.19 packages
-two-column dataframe (or a vector)
c(xmin, xmax)
The resolution of the grid.
quantile
mask
kernel.method
A two-column dataframe (or a vector) of the environmental -values (in column) for background pixels of the whole study area (in row).
A two-column dataframe (or a vector) of the environmental -values (in column) for the background pixels of the species (in row).
A two-column dataframe (or a vector) of the environmental -values (in column) for the occurrences of the species (in row).
The quantile used to delimit a threshold to exclude low -species density values.
The quantile used to delimit a threshold to exclude low -environmental density values of the study area.
A geographical mask to delimit the background extent if the -analysis takes place in the geographical space.It can be a SpatialPolygon -or a raster object. Note that the CRS should be the same as the one used -for the points.
Method used to estimate the the kernel density. -Currently, there are two methods: by default, it is the methode from -'adehabitat'. Method from the library 'ks' is also available.
Vector with extention values of the window size -(see details).
Species 1 occurrence density grid created by ecospat.grid.clim.
Species 2 occurrence density grid created by ecospat.grid.clim.
Correct the occurrence densities of each species by the -prevalence of the environments in their range (TRUE = yes, FALSE = no).
ecospat.grid.clim.dyn,
-ecospat.niche.overlap
- Datasets-Used in the examples. - |
- |
|---|---|
| - - | -Load a dataset |
-
- Interface-Graphical User Interface (shiny application) - |
- |
| - - | -Shiny application to apply |
-
- Build Plant Functional Groups-Functions to select dominant species, compute functional distance between species and build clusters. - |
- |
| - - | -Transform Braun-Blanquet values into relative abundances |
-
| - - | -Selection of dominant species from abundance releves |
-
| - - | -Computation of distances between species based on traits and niche -overlap |
-
| - - | -Computation of niche overlap distances between species |
-
| - - | -Computation of traits distances between species |
-
| - - | -Combine several dissimilarity distance matrices |
-
| - - | -Create clusters based on dissimilarity matrix |
-
| - - | -Choose clusters and select determinant species |
-
| - - | -Calculate PFG traits values based on determinant species traits -values |
-
- Create FATE parameter files-Create user-friendly directory tree, parameter and simulation files for FATE simulation. - |
- |
| - - | -Create the skeleton folder for a |
-
| - - | -Create SUCCESSION parameter files for a |
-
| - - | -Create LIGHT parameter files for a |
-
| - - | -Create SOIL parameter files for a |
-
| - - | -Create DISPERSAL parameter files for a |
-
| - - | -Create DISTURBANCE parameter files for a |
-
| - - | -Create DROUGHT parameter files for a |
-
| - - | -Create SCENARIO parameter files for a |
-
| - - | -Create SAVE parameter files for a |
-
| - - | -Create Global_parameters parameter file for a |
-
| - - | -Create Simul_parameters parameter file for a |
-
| - - | -Create multiple set(s) of parameter files for a |
-
- Run FATE simulation- - |
- |
| - - | -FATE Wrapper |
-
- Analyze FATE outputs-Evalute predicted maps, produce summary and dynamic graphics. - |
- |
| - - | -Create all possible graphical representations for a |
-
| - - | -Create tables of pixel temporal evolution of PFG abundances (and
-light and soil resources if activated) for a |
-
| - - | -Create a graphical representation of the evolution of PFG coverage
-and abundance through time for a |
-
| - - | -Create a graphical representation of the evolution of PFG abundance
-through time for 5 (or more) pixels of a |
-
| - - | -Create a graphical representation of the evolution of habitat
-composition through time for a |
-
| - - | -Create relative abundance maps for each Plant Functional Group for
-one (or several) specific year of a |
-
| - - | -Create a graphical representation of several statistics for each PFG
-to asses the quality of the model for one (or several) specific year of a
- |
-
| - - | -Create binary maps for each Plant Functional Group for one (or
-several) specific year of a |
-
| - - | -Create maps of both habitat suitability and simulated occurrences of
-each Plant Functional Group for one (or several) specific year of a
- |
-
| - - | -Create a map related to plant functional group results (richness,
-relative cover, light or soil CWM) for one (or several) specific year of a
- |
-
- Save FATE simulation- - |
- |
| - - | -Save data to reproduce building of Plant Functional Groups |
-
| - - | -Save data to reproduce building of parameter files |
-
- Tool box-Utility functions. - |
- |
| - - | -Find operating system of your computer |
-
| - - | -Extract parameter value(s) from a parameter file |
-
| - - | -Replace parameter value(s) from a parameter file |
-
| - - | -Replace a pattern with a new within all parameter files of a
- |
-
| - - | -Adapt all raster maps of a |
-
| - - | -Upscale / downscale / crop all raster maps of a |
-
| - - | -Find cutoff to transform abundance values into binary values |
-
| - - | -Compress ( |
-