Nothing
#' Compute Functional Entities composition based on a Species x Traits matrix
#'
#' @param sp_tr a data frame containing species as rows and traits as columns.
#'
#' @param tr_cat a data frame containing three columns for each trait (rows):
#' \itemize{
#' \item \strong{trait_name}: names of all traits as in \code{sp_tr} data
#' frame;
#' \item \strong{trait_type}: category codes for each trait as followed:
#' \emph{N} for Nominal traits (factor variable),
#' \emph{O} for Ordinal traits (ordered variable),
#' \emph{C} for Circular traits (integer values),
#' \emph{Q} for Quantitative traits (numeric values) that is allowed
#' \strong{only} if there are at least 2 species with the same value, and
#' \emph{F} for fuzzy-coded traits (i.e. described with several
#' 'sub-traits');
#' \item \strong{fuzzy_name} name of fuzzy-coded trait to which 'sub-trait'
#' belongs (if trait is not fuzzy, ignored so could be trait name or NA).
#' }
#'
#' @param fe_nm_type a character string referring to the type of naming
#' functional entities. Two possible values: \emph{"fe_rank"} (FE are named
#' after their decreasing rank in term of number of species \emph{i.e.} fe_1
#' is the one gathering most species) and \emph{"tr_val"} (FE are named after
#' names of traits and of trait values for each FE, if possible, \emph{see
#' details below}). Default: `fe_nm_type = "fe_rank"`.
#'
#' @param check_input a logical value indicating whether key features the
#' inputs are checked (e.g. class and/or mode of objects, names of rows
#' and/or columns, missing values). If an error is detected, a detailed
#' message is returned. Default: `check.input = TRUE`.
#'
#' @details `fe_nm_type = "tr_val"` is allowed \strong{only} if:
#' \itemize{
#' \item there are less than 7 traits;
#' \item none of them is fuzzy-coded (so that names are not too long)
#' \item all trait names and all trait values have different 2 first letters
#' }
#'
#' If these 3 conditions are met, names of Functional Entities are made as a
#' character string of up to 2 letters for trait name in upper case font then
#' up to 2 letters for trait value in lower case font, separated by "_" between
#' traits. Trait names are abbreviated to a single letter whenever possible.
#' \emph{Examples:} ("TAc2_TBxx_TCyy", "TAc3_TBff_TCyy") or
#' ("A2_Bx_Cy", "A3_Bf_Cy")
#'
#' @return A list of objects containing:
#' \itemize{
#' \item \strong{fe_nm}: a vector with names of all FE (following
#' fe_nm_type). FE are ordered according to the decreasing number of
#' species they gather.
#' \item \strong{sp_fe}: a vector containing for each species the name of the
#' FE it belongs to. FE order is done according to decreasing number of
#' species.
#' \item \strong{fe_tr}: a data frame containing traits values (variables in
#' columns) for each FE (rows). FE order is done according to decreasing
#' number of species.
#' \item \strong{fe_nb_sp}: a vector with species number per FE. If all FE
#' have only one species, a warning message is returned. FE are ordered
#' according to the decreasing number of species they gather.
#' \item \strong{details_fe}: a list containing: \emph{fe_codes} a vector
#' containing character referring to traits values (like a barcode) with
#' names as in \code{fe_nm_type} and sorted according to \code{fe_nb_sp};
#' \emph{tr_uval} a list containing for each trait a vector of its unique
#' values or a data frame for fuzzy-coded traits; \emph{fuzzy_E} a list
#' with for each fuzzy-coded trait a data frame with names of entities (E)
#' and names of species (sp); \emph{tr_nb_uval} a vector with number of
#' unique values per trait (or combinations for fuzzy-coded traits);
#' \emph{max_nb_fe} the maximum number of FE possible given number of
#' unique values per trait.
#' }
#'
#' @author Sebastien Villeger, Nicolas Loiseau, and Camille Magneville
#'
#' @export
#'
#' @examples
#' # Load species traits data:
#' data("fruits_traits", package = "mFD")
#'
#' # Transform species traits data:
#' # Only keep the first 4 traits to illustrate FEs:
#' fruits_traits <- fruits_traits[ , c(1:4)]
#'
#' # Load trait types data:
#' data("fruits_traits_cat", package = "mFD")
#'
#' # Transform the trait types data to only keep traits 1 - 4:
#' fruits_traits_cat <- fruits_traits_cat[c(1:4), ]
#'
#' # Gather species into FEs:
#' ## gathering species into FEs (FEs named according to the decreasing...
#' ## ... number of species they gather):
#' sp_FEs <- mFD::sp.to.fe(
#' sp_tr = fruits_traits,
#' tr_cat = fruits_traits_cat,
#' fe_nm_type = "fe_rank")
#'
#' ## display FEs names:
#' sp_FEs$fe_nm
#'
#' ## display for each species the name of the FE it belongs to:
#' sp_FEs$sp_fe
#'
#' ## display trait values for each FE:
#' sp_FEs$fe_tr
#'
#' ## display the number of species per FEs:
#' sp_FEs$fe_nb_sp
sp.to.fe <- function(sp_tr, tr_cat, fe_nm_type = "fe_rank",
check_input = TRUE) {
# define key parameters used in the function:
# define species names:
sp_nm <- row.names(sp_tr)
# define species number
sp_nb <- length(sp_nm)
# retrieve traits information (fuzzy coded traits are modified thereafter):
# get traits names:
tr_nm <- names(sp_tr)
# get traits number:
tr_nb <- length(tr_nm)
# get traits type:
tr_type <- c(tr_cat$trait_type)
names(tr_type) <- tr_nm
## check_inputs:
if (sp_nb < 2) {
stop("There must be at least 2 species in species x traits data frame.")
}
if (length(tr_nm) < 2) {
stop("There must be at least 2 traits in the species x traits data frame.")
}
if (any(is.na(sp_tr))) {
stop("The species x traits data frame contains NA. Please check.")
}
if (! is.data.frame(sp_tr)) {
stop("Your species x traits data must be gathered in a matrix.")
}
if (is.null(colnames(sp_tr))) {
stop("No column names provided in traits table. Analysis will not go ",
"through, please add traits as column names.")
}
if (is.null(rownames(sp_tr))) {
stop("No row names provided in traits table. Analysis will not go ",
"through. Please add species names as row names.")
}
if (any(is.na(tr_cat$trait_type))) {
stop("Trait type in traits x category data frame contains NA. Please ",
"check and specify type of all traits.")
}
if (any(tr_nm != tr_cat$trait_name)) {
stop("Trait names differ between species x traits data frame and traits ",
"x category data.frame. Please check.")
}
if (any(is.na(tr_cat$trait_type))) {
stop("Trait type in traits x category data frame contains NA. Please ",
"check and specify type of all traits.")
}
if (any(!(tr_cat$trait_type %in% c("N", "O", "C", "Q", "F")))) {
stop("Trait type in traits x category should be among 'N', 'O', 'C', ",
"'Q', 'F'. Please check type of all traits.")
}
# check nominal traits:
check.nominal(tr_cat, sp_tr)
# check that ordinal traits have ordered categories:
check.ordinal(tr_cat, sp_tr)
# check that circular traits are coded with integer:
check.circular(tr_cat, sp_tr)
# check that continuous trait have non unique values:
check.continuous(tr_cat, sp_tr)
# check fuzzy coded traits:
if ("F" %in% tr_cat$trait_type) {
# retrieve names of fuzzy-coded traits:
nm_fuzzy <- unique(stats::na.omit(tr_cat$fuzzy_name))
# check that fuzzy traits are described with more than one variable:
for (k in nm_fuzzy) {
# get the names of variables for fuzzy trait k:
var_k <- tr_cat$trait_name[which(tr_cat$fuzzy_name == k)]
# check that there are at least 2 columns per fuzzy coded trait:
if (length(var_k) < 2) {
stop("Fuzzy-coded trait '", k, "' is described with a single ",
"variable, consider changing its type to 'nominal'")
}
# check that variables are continuous:
if (any(apply(sp_tr[, var_k ], 2, is.numeric) == FALSE)) {
stop("Fuzzy-coded trait '", k, "' is not described with 'numeric' ",
"variables.")
}
}
# update names, type and number of traits:
tr_nm <- c(tr_cat$trait_name[tr_cat$trait_type != "F"], nm_fuzzy)
tr_nb <- length(tr_nm)
tr_type <- c(tr_cat$trait_type[tr_cat$trait_type != "F"],
rep("F", length(nm_fuzzy)))
names(tr_type) <- tr_nm
}
## retrieve combination of unique values of traits:
# code a function to paste name of a trait (uppercase) ...
#... to its values (lowercase):
paste.tr.val <- function(tr, x) {
paste0(toupper(x), tolower(as.character(tr[, x])))
}
# create a list to store outputs:
tr_uval <- list()
# create a vector to store functional barcodes of each specis...
# ... (combinations of trait name and values):
sp_fbarcode <- rep("", sp_nb)
# complete the list and the vector for non fuzzy traits:
tr_notfuzzy <- names(tr_type)[tr_type != "F"]
if (length(tr_notfuzzy) > 0) {
for (k in tr_notfuzzy) {
# get traits unique values:
tr_uval[[k]] <- unique(as.character(sp_tr[, k]))
# retrieve traits values:
sp_fbarcode <- paste(sp_fbarcode, paste.tr.val(sp_tr, k) , sep = "_")
}
}
# group species into a nominal-like trait for fuzzy traits:
if ("F" %in% tr_type) {
# create a list to store functional entities names and their species:
fuzzy_E <- list()
# complete fuzzy_E list for all fuzzy traits, output list and vector:
for (k in nm_fuzzy) {
# retrieve variables for fuzzy trait k for each species:
fuzzy_k <- sp_tr[ , tr_cat$trait_name[which(tr_cat$fuzzy_name == k)]]
# create a vector for first variable:
val_k <- rep("", sp_nb)
# loop on other variables:
for (z in colnames(fuzzy_k)) {
val_k <- paste(val_k, paste.tr.val(fuzzy_k, z), sep = "_")
}
# removing useless first "_":
val_k <- substr(val_k, 2, nchar(val_k))
# create a data frame with entities and species:
val_k_df <- data.frame(E = val_k, sp = row.names(fuzzy_k))
fuzzy_E[[k]] <- val_k_df
# get the unique combinations of values for fuzzy trait k:
u_val_k <- as.character(unique(val_k_df$E))
# add code of fuzzy entities to barcode of all traits: ...
# ... get all combinations of traits to draw FEs:
sp_fbarcode <- paste(sp_fbarcode, val_k, sep = "_")
# there are variable values for each fuzzy entity so ...
# ... pick values from first species belonging to the fuzzy entity...
# ... so we can get all combinations of "traits" forming ...
# ... the fuzzy trait k:
E_val_k <- lapply(u_val_k, function(x) {
fuzzy_k[val_k_df$sp[which(val_k_df$E == x)[1]], ]})
# replace names by entities names
names(E_val_k) <- u_val_k
# gather vector as a dataframe to store unique values:
tr_uval[[k]] <- as.data.frame(do.call(rbind, E_val_k))
}
}
# create a vector to store the number of unique values per trait:
tr_nb_uval <- rep(NA, length(tr_nm))
names(tr_nb_uval) <- tr_nm
# store the number of unique value per trait:
for (k in tr_nm) {
if (tr_type[k] != "F"){
tr_nb_uval[k] <- length(tr_uval[[k]])
}
if (tr_type[k] == "F") {
tr_nb_uval[k] <- nrow(tr_uval[[k]])
}
}
# retrieve the maximum number of possible FE given the number of ...
# ... unique values per trait:
max_nb_fe <- prod(tr_nb_uval)
## arrange functional entities:
# remove useless "_" from FEs codes:
sp_fe <- substr(sp_fbarcode, 2, nchar(sp_fbarcode))
# add species names to vector of species functional barcodes:
names(sp_fe) <- sp_nm
# get the codes of unique FE:
fe_codes <- as.character(unique(sp_fe))
# get FE number:
fe_nb <- length(fe_codes)
# retrieve the number of species per FE:
fe_nb_sp <- unlist(lapply(fe_codes, function(x) length(which(sp_fe == x))))
names(fe_nb_sp) <- fe_codes
# return a warning if all species are different (i.e. only 1 sp per FE):
if (max(fe_nb_sp) == 1) {
warning("All Functional Entities have a single species.")
}
# decrease order of FE according to their number of species to order fe...
# ... codes:
# order fe with increasing species number
order_fe <- order(fe_nb_sp, decreasing = TRUE)
# reorder vectors with increasing number of species per FE:
fe_nb_sp_ord <- fe_nb_sp[order_fe]
# reorder fe_codes with increasing number of species per FE:
fe_codes_ord <-fe_codes[order_fe]
# get trait values for FEs:
# pick traits values of the first species (one species) for each FE:
fe_trait_list <- lapply(fe_codes,
function(x) {sp_tr[names(which(sp_fe == x)[1]), ]})
# replace species names by entities names:
names(fe_trait_list) <- fe_codes
# gather vectors as a dataframe to store unique values:
fe_trait <- as.data.frame(do.call(rbind, fe_trait_list))
# reorder rows of fe*traits dataframe according to the number of ...
# ... species per FE:
fe_trait_ord <- fe_trait[fe_codes_ord, ]
## code Functional Entities names:
# write FEs names based on decreasing number of species per FE if asked:
if (fe_nm_type == "fe_rank") {
fe_nm <- paste0("fe_", 1:fe_nb)
}
# write FEs names based on traits and values names if ...
# ... asked (not for fuzzy traits):
if (fe_nm_type == "tr_val") {
# check that there is no fuzzy-coded trait:
if ("F" %in% tr_type) {
stop("Functional entities could not be named according to names of ",
"traits and of trait values when there is a fuzzy-coded trait. ",
"Set 'fe_nm_type' to 'fe_rank'.")
}
# check that there is less than 6 traits:
if (tr_nb > 6) {
stop("Functional entities could not be named according to names of ",
"traits and of trait values becasue there are more than 6 traits. ",
"Set 'fe_nm_type' to 'fe_rank'.")
}
# set traits code default value to one letter:
traits_codes <- substr(names(fe_trait_ord), 1, 1)
names(traits_codes) <- tr_nm
# if some traits have the same 1st letter, up to 2 first letters are kept:
if (length(unique(traits_codes) != tr_nb)) {
traits_codes <- substr(names(sp_tr), 1, 2)
names(traits_codes) <- tr_nm
}
# check that codes for traits are unique so traits can be identified:
if (length(unique(traits_codes)) != tr_nb) {
stop("Two first letters of trait names should be unique. Please change ",
"'fe_nm_type' to 'fe_rank'.")
}
# build FE names after check for each trait...
# ... that levels have unique two first letters:
# create a vector that will contain FEs names:
fe_nm <- rep("", fe_nb)
# for each trait:
for (t in tr_nm) {
# get the levels of trait t:
level_t <- as.character(fe_trait_ord[, t])
# set default code to one letter:
level_t_codes <- substr(level_t, 1, 1)
# if some codes have the same 1st letter, up to 2 first letters are kept:
if (length(unique(level_t_codes)) < length(unique(level_t))) {
level_t_codes <- substr(level_t_codes, 1, 2)
}
# if some codes have the same two 1st letters, error message:
if (length(unique(level_t_codes)) != length(unique(level_t))) {
stop("Two first letters of levels of trait '", t, "' are not unique. ",
"Please change 'fe_nm_type' to 'fe_rank'.")
}
# add trait name and values among FE to the names of FE:
fe_nm <- paste0(fe_nm, "_", toupper(traits_codes[t]),
tolower(level_t_codes))
}
# remove the useless first "_":
fe_nm <- substr(fe_nm, 2, nchar(fe_nm))
}
# replace FEs barcodes by fe_names in fe_codes, fe_nb_sp and fe_trait...
# ... which all had the same order as fe_codes (based on fe_nb_sp):
names(fe_nb_sp_ord) <- fe_nm
names(fe_codes_ord) <- fe_nm
rownames(fe_trait_ord) <- fe_nm
# replace FEs codes in sp_fe by proper FE names:
sp_fe_ord <- sp_fe
# for each FE code:
for (z in names(fe_codes_ord)) {
sp_fe_ord[which(sp_fe_ord == fe_codes_ord[z])] <- z
}
## return results:
return_list <-list("fe_nm" = fe_nm, "sp_fe" = sp_fe_ord,
"fe_tr" = fe_trait_ord, "fe_nb_sp" = fe_nb_sp_ord,
"details_fe" = list("fe_codes" = fe_codes_ord,
"tr_uval" = tr_uval,
"tr_nb_uval" = tr_nb_uval,
"max_nb_fe" = max_nb_fe))
if ("F" %in% tr_type) {
return_list$details_fe$fuzzy_E <- fuzzy_E
}
return(return_list)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.