Nothing
#' Mutate traits within a traitdata object.
#'
#' This function allows to transform, factorize, or combine trait measurements
#' into compound measurements or update factor levels into binaries.
#'
#' @param .data the traitdata object to transform
#' @param ... named parameters giving definitions of new columns.
#' @param traits (NOT TESTED) the column name to be kept for parsing into
#' wide-table (default is `verbatimTraitName`). Note that any duplicate column that
#' contains trait names, e.g. `traitName` will be omitted.
#' @param units (NOT TESTED) the column name containing the units of numerical
#' values (default is `verbatimTraitUnit`).
#' @param values (NOT TESTED) the column name containing the trait values to be
#' used to fill the matrix (default is `verbatimTraitValue`). Duplicate columns (e.g.
#' `traitValue`) will be omitted. See notes.
#'
#' @return an updated traitdata object with the new trait measures or facts
#' appended to the original table. If the given trait name has been refined,
#' it will be replaced.
#'
#' @details The function handles units for numerical traits and returns the new
#' unit of the computed value in column `verbatimTraitUnit`, if units of input
#' variables were specified according to the units package. Handling of other
#' columns than `verbatimTraitName` and `verbatimTraitValue` is not advised at present.
#'
#' It is advised to mutate traits before applying `standardize.traits()`! If
#' the mutate function is applied to a standardised dataset, the new trait
#' will not be mapped automatically to the provided thesaurus. (automated
#' re-mapping might be added in later versions of the package.)
#'
#' @export mutate.traitdata
#' @importFrom reshape2 melt
#' @importFrom plyr rbind.fill
#'
#' @examples
#'
#' \dontrun{
#' pulldata("arthropodtraits")
#' dataset3 <- as.traitdata(arthropodtraits,
#' taxa = "SpeciesID",
#' traits = c("Body_Size", "Dispersal_ability",
#' "Feeding_guild","Feeding_guild_short",
#' "Feeding_mode", "Feeding_specialization",
#' "Feeding_tissue", "Feeding_plant_part",
#' "Endophagous_lifestyle", "Stratum_use",
#' "Stratum_use_short"),
#' units = c(Body_Size = "mm", Dispersal_ability = "unitless"),
#' keep = c(measurementRemark = "Remark"),
#' metadata = list(
#' license = "http://creativecommons.org/publicdomain/zero/1.0/"
#' )
#' )
#' head(dataset3)
#'
#' updated <- mutate.traitdata(dataset3, predator = Feeding_guild == "c" )
#'
#' head(updated[updated$verbatimTraitName == "predator",])
#'
#' levels(updated$verbatimTraitName)
#'
#' ##
#'
#' pulldata("heteroptera_raw")
#' dataset2 <- as.traitdata(heteroptera_raw,
#' traits = c("Body_length", "Body_width", "Body_height", "Thorax_length",
#' "Thorax_width", "Head_width", "Eye_width", "Antenna_Seg1",
#' "Antenna_Seg2", "Antenna_Seg3", "Antenna_Seg4", "Antenna_Seg5",
#' "Front.Tibia_length", "Mid.Tibia_length", "Hind.Tibia_length",
#' "Front.Femur_length", "Hind.Femur_length", "Front.Femur_width",
#' "Hind.Femur_width", "Rostrum_length", "Rostrum_width",
#' "Wing_length", "Wing_width"),
#' taxa = "SpeciesID",
#' occurrences = "ID"
#' )
#' updated <- mutate.traitdata(dataset2,
#' Body_shape = Body_length/Body_width,
#' Body_volume = Body_length*Body_width*Body_height,
#' Wingload = Wing_length*Wing_width/Body_volume)
#'
#' head(updated[updated$verbatimTraitName %in% c( "Body_volume"),])
#' }
mutate.traitdata <- function(.data,
...,
values = "verbatimTraitValue",
traits = "verbatimTraitName",
units = "verbatimTraitUnit"
) {
verbatimTraitName = NULL
stopifnot(is.data.frame(.data) || is.list(.data) || is.environment(.data))
in_traits <- levels(.data[,traits])
temp <- cast.traitdata(.data, traits = traits, values = values, units = units )
# extract mutations to apply into list
out_traits <- as.list(substitute(list(...))[-1])
out_traits <- out_traits[names(out_traits) != ""]
# apply each list entry to matrix
for (col in names(out_traits)) {
temp[[col]] <- eval(out_traits[[col]], temp, parent.frame())
}
out_units <- data.frame(verbatimTraitName = c(in_traits, names(out_traits)) )
out_units$verbatimTraitUnit <- sapply(as.character(out_units$verbatimTraitName), function(t) {
if("units" %in% class(temp[[t]])) {
as.character(units(temp[[t]]))
} else { return(NA) }
} )
class(temp) <- "data.frame"
out <- suppressWarnings(reshape2::melt(temp,
measure.vars = names(out_traits),
id.vars = names(temp[,
which(!names(temp) %in% c(in_traits, names(out_traits)))]),
variable_name = "verbatimTraitName",
na.rm = TRUE
) )
names(out)[names(out) == "variable"] <- "verbatimTraitName"
names(out)[names(out) == "value"] <- "verbatimTraitValue"
out <- merge(out, out_units, by = "verbatimTraitName" )
out <- plyr::rbind.fill(subset(.data, !verbatimTraitName %in% names(out_traits)), subset(out, verbatimTraitName %in% names(out_traits)))
out$verbatimTraitUnit <- as.factor(out$verbatimTraitUnit)
# sort columns according to glossary of terms
out <- out[, order(match(names(out), glossary$columnName) )]
attribs <- attributes(.data)
attribs$names <- attributes(out)$names
attribs$row.names <- seq_along(out[,1])
attributes(out) <- attribs
return(out)
}
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.