diff options
Diffstat (limited to 'pkg/R')
| -rw-r--r-- | pkg/R/GUS.R | 74 | ||||
| -rw-r--r-- | pkg/R/endpoint.R | 102 |
2 files changed, 176 insertions, 0 deletions
diff --git a/pkg/R/GUS.R b/pkg/R/GUS.R new file mode 100644 index 0000000..2690f50 --- /dev/null +++ b/pkg/R/GUS.R @@ -0,0 +1,74 @@ +#' Groundwater ubiquity score based on Gustafson (1989) +#' +#' The groundwater ubiquity score GUS is calculated according to +#' the following equation +#' \deqn{GUS = \log_10 DT50_{soil} (4 - \log_10 K_{oc}}{GUS = log10 DT50soil * (4 - log10 Koc)} +#' +#' @references Gustafson, David I. (1989) Groundwater ubiquity score: a simple +#' method for assessing pesticide leachability. _Environmental +#' toxicology and chemistry_ *8*(4) 339–57. +#' @inheritParams endpoint +#' @param chent If a chent is given with appropriate information present in its +#' chyaml field, this information is used, with defaults specified below. +#' @param DT50 Half-life of the chemical in soil. Should be a field +#' half-life according to Gustafson (1989). However, leaching to the sub-soil +#' can not completely be excluded in field dissipation experiments and Gustafson +#' did not refer to any normalisation procedure, but says the field study should +#' be conducted under use conditions. +#' @param Koc The sorption constant normalised to organic carbon. Gustafson +#' does not mention the nonlinearity of the sorption constant commonly +#' found and usually described by Freundlich sorption, therefore it is +#' unclear at which reference concentration the Koc should be observed +#' (and if the reference concentration would be in soil or in porewater). +#' @param lab_field Should laboratory or field half-lives be used? This +#' defaults to lab in this implementation, in order to avoid +#' double-accounting for mobility. If comparability with the original GUS +#' values given by Gustafson (1989) is desired, non-normalised first-order +#' field half-lives obtained under actual use conditions should be used. +#' @param degradation_value Which of the available degradation values should +#' be used? +#' @param sorption_value Which of the available sorption values should be used? +#' Defaults to Kfoc as this is what is generally available from the European +#' pesticide peer review process. These values generally use a reference +#' concentration of 1 mg/L in porewater, that means they would be expected to +#' be Koc values at a concentration of 1 mg/L in the water phase. +#' @param degradation_aggregator Function for aggregating half-lives +#' @param sorption_aggregator Function for aggregation Koc values +#' @return A list with the DT50 and Koc used as well as the resulting score +#' of class GUS_result +#' @author Johannes Ranke +#' @export +GUS <- function(...) UseMethod("GUS") + +#' @rdname GUS +#' @export +GUS.numeric <- function(DT50, Koc) { + score <- log10(DT50) * (4 - log10(Koc)) + res <- list(DT50 = DT50, Koc = Koc, score = score) + class(res) <- "GUS_result" + return(res) +} + +#' @rdname GUS +#' @export +GUS.chent <- function(chent, lab_field = "laboratory", + aerobic = TRUE, + degradation_value = "DT50ref", + sorption_value = "Kfoc", + degradation_aggregator = geomean, + sorption_aggregator = geomean, + digits = 1) +{ + DT50 = soil_DT50(chent, lab_field = lab_field, redox = aerobic, + value = degradation_value, + aggregator = degradation_aggregator, signif = 5) + Koc = soil_Kfoc(chent, value = sorption_value, + aggregator = sorption_aggregator, signif = 5) + GUS.numeric(DT50, Koc) +} + +#' @export +print.GUS_result = function(x, ..., digits = 1) { + cat("GUS: ", round(x$score, digits = 1), "\n") + cat("calculated from DT50 ", x$DT50, " and Koc ", x$Koc, "\n") +} diff --git a/pkg/R/endpoint.R b/pkg/R/endpoint.R new file mode 100644 index 0000000..f9b9102 --- /dev/null +++ b/pkg/R/endpoint.R @@ -0,0 +1,102 @@ +#' Retrieve endpoint information from the chyaml field of a chent object +#' +#' R6 class objects of class \code{\link{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. +#' +#' @import chents +#' @export +#' @param chent The \code{\link{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 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) +{ + 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)) +} + +#' Obtain soil DT50 +#' +#' @inheritParams 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, + value = value, aggregator = aggregator, raw = raw) + return(ep) +} + +#' Obtain soil Kfoc +#' +#' @inheritParams endpoint +#' @export +soil_Kfoc <- function(chent, aggregator = geomean, signif = 3, + value = "Kfoc", raw = FALSE) { + ep <- endpoint(chent, medium = "soil", type = "sorption", + value = value, aggregator = aggregator, raw = raw) + return(ep) +} + +#' Obtain soil Freundlich exponent +#' +#' In pesticide fate modelling, this exponent is often called 1/n. Here, in +#' order to facilitate dealing with such data in R, it is called N. +#' +#' @inheritParams endpoint +#' @export +soil_N <- function(chent, aggregator = mean, signif = 3, raw = FALSE) { + ep <- endpoint(chent, medium = "soil", type = "sorption", + value = "N", aggregator = aggregator, raw = raw) + return(ep) +} + +#' Obtain soil sorption data +#' +#' @inheritParams 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 = rep(3, length(values)), + raw = FALSE) { + res <- sapply(values, + function(x) { + endpoint(chent, medium = "soil", type = "sorption", + value = x, aggregator = aggregators[[x]], raw = raw) + } + ) + return(res) +} |