#' Retrieve endpoint information from the chyaml field of a chent object #' #' R6 class objects of class chent represent chemical entities #' and can hold a list of information loaded from a chemical yaml file in their #' chyaml field. Such information is extracted and optionally aggregated by #' this function. #' #' The functions \code{soil_*} are functions to extract soil specific endpoints. #' For the Freundlich exponent, the capital letter \code{N} is used in order to #' facilitate dealing with such data in R. In pesticide fate modelling, this #' exponent is often called 1/n. #' #' @export #' @param chent The chent object to get the information from #' @param medium The medium for which information is sought #' @param type The information type #' @param lab_field If not NA, do we want laboratory or field endpoints #' @param redox If not NA, are we looking for aerobic or anaerobic data #' @param value The name of the value we want. The list given in the #' usage section is not exclusive #' @param aggregator The aggregator function. Can be mean, #' \code{\link{geomean}}, or identity, for example. #' @param raw Should the number(s) be returned as stored in the chent #' object (could be a character value) to retain original information #' about precision? #' @param signif How many significant digits do we want #' @return The result from applying the aggregator function to #' the values converted to a numeric vector, rounded to the #' given number of significant digits, or, if raw = TRUE, #' the values as a character value, retaining any implicit #' information on precision that may be present. #' endpoint <- function(chent, medium = "soil", type = c("degradation", "sorption"), lab_field = c(NA, "laboratory", "field"), redox = c(NA, "aerobic", "anaerobic"), value = c("DT50ref", "Kfoc", "N"), aggregator = geomean, raw = FALSE, signif = 3) { if (!is(chent, "chent")) { stop("Please supply a chent object as created using the package 'chents' available from jrwb.de") } ep_list <- chent$chyaml[[medium]][[type]] if (!is.na(lab_field[1])) { ep_list <- ep_list[[lab_field]] } if (!is.na(redox[1])) { ep_list <- ep_list[[redox]] } values <- ep_list$data[[value]] if (raw) return(values) else return(signif(aggregator(as.numeric(values)), signif)) } #' @rdname endpoint #' @export soil_DT50 <- function(chent, aggregator = geomean, signif = 3, lab_field = "laboratory", value = "DT50ref", redox = "aerobic", raw = FALSE) { ep <- endpoint(chent, medium = "soil", type = "degradation", lab_field = "laboratory", redox = redox, signif = signif, value = value, aggregator = aggregator, raw = raw) return(ep) } #' @rdname endpoint #' @export soil_Kfoc <- function(chent, aggregator = geomean, signif = 3, value = "Kfoc", raw = FALSE) { ep <- endpoint(chent, medium = "soil", type = "sorption", signif = signif, value = value, aggregator = aggregator, raw = raw) return(ep) } #' @rdname endpoint #' @export soil_N <- function(chent, aggregator = mean, signif = 3, raw = FALSE) { ep <- endpoint(chent, medium = "soil", type = "sorption", signif = signif, value = "N", aggregator = aggregator, raw = raw) return(ep) } #' @rdname endpoint #' @param values The values to be returned #' @param aggregators A named vector of aggregator functions to be used #' @export soil_sorption <- function(chent, values = c("Kfoc", "N"), aggregators = c(Kfoc = geomean, Koc = geomean, N = mean), signif = c(Kfoc = 3, N = 3), raw = FALSE) { res <- sapply(values, function(x) { endpoint(chent, medium = "soil", type = "sorption", signif = signif[[x]], value = x, aggregator = aggregators[[x]], raw = raw) } ) return(res) }