diff options
| -rw-r--r-- | pkg/NAMESPACE | 6 | ||||
| -rw-r--r-- | pkg/R/PEC_soil.R | 77 | ||||
| -rw-r--r-- | pkg/R/TOXSWA_cwa.R | 2 | ||||
| -rw-r--r-- | pkg/R/pfm_chent.R | 265 | ||||
| -rw-r--r-- | pkg/man/PEC_soil_product.Rd | 17 | ||||
| -rw-r--r-- | pkg/man/pfm_ai.Rd | 24 | ||||
| -rw-r--r-- | pkg/man/pfm_chent.Rd | 34 | ||||
| -rw-r--r-- | pkg/man/pfm_product.Rd | 26 | ||||
| -rw-r--r-- | pkg/tests/testthat/test_PEC_soil.R | 4 |
9 files changed, 452 insertions, 3 deletions
diff --git a/pkg/NAMESPACE b/pkg/NAMESPACE index cd2f08b..1c879d1 100644 --- a/pkg/NAMESPACE +++ b/pkg/NAMESPACE @@ -3,6 +3,12 @@ S3method(plot,TOXSWA_cwa) export(PEC_pw) export(PEC_soil) +export(PEC_soil_product) +export(TOXSWA_cwa) +export(geomean) +export(pfm_ai) +export(pfm_chent) +export(pfm_product) export(PEC_sw_drainage_UK_ini) export(PEC_sw_drift) export(PEC_sw_drift_ini) diff --git a/pkg/R/PEC_soil.R b/pkg/R/PEC_soil.R index 3dbc2eb..73c7e42 100644 --- a/pkg/R/PEC_soil.R +++ b/pkg/R/PEC_soil.R @@ -43,3 +43,80 @@ PEC_soil <- function(rate, rate_units = "g/ha", interception = 0, PEC_soil = rate_to_soil * 1000 / soil_mass # in mg/kg return(PEC_soil) } + + +#' Calculate predicted environmental concentrations in soil for a product +#' +#' Calculates long term accumulation PEC values +#' +#' @export +#' @author Johannes Ranke +PEC_soil_product <- function(product, rate, rate_units = "L/ha", interception = 0, + mixing_depth = 5, tillage_depth = 20, + interval = 365, + bulk_density = 1.5, + PEC_units = "mg/kg") { + rate_units = match.arg(rate_units) + PEC_units = match.arg(PEC_units) + if (product$density_units != "g/L") stop("Product density other than g/L not supported") + if (product$concentration_units != "g/L") { + stop("Active ingredient concentration units other than g/L not supported") + } + + results <- data.frame(compound = character(0), initial = numeric(0), + plateau_max = numeric(0), plateau_min = numeric(0), + long_term_max = numeric(0), + stringsAsFactors = FALSE) + for (ai_name in names(product$ais)) { + ai <- product$ais[[ai_name]] + ai_rate <- rate * product$concentrations[ai_name] + ini <- PEC_soil(ai_rate, + interception = interception, mixing_depth = mixing_depth, + bulk_density = bulk_density) + results[ai_name, "compound"] <- ai$acronym + results[ai_name, "initial"] <- ini + + ini_tillage <- ini * mixing_depth / tillage_depth + DT50 <- subset(ai$soil_degradation_endpoints, destination == "PECsoil")$DT50 + if (length(DT50) > 1) stop("More than one PECsoil DT50 for", ai$acronym) + if (length(DT50) > 0) { + if (!is.na(DT50)) { + k <- log(2) / DT50 + plateau_max <- ini_tillage / (1 - exp( - k * interval)) + plateau_min <- plateau_max * exp( - k * interval) + long_term_max <- plateau_min + ini + results[ai_name, c("plateau_max", "plateau_min", "long_term_max")] <- + c(plateau_max, plateau_min, long_term_max) + } + } + + for (TP_name in names(ai$TPs)) { + TP <- ai$TPs[[TP_name]] + max_occurrence = max(subset(ai$transformations, + grepl("soil", study_type) & + acronym == TP$acronym, max_occurrence)) + TP_rate <- ai_rate * TP$mw / ai$mw * max_occurrence + ini <- PEC_soil(TP_rate, interception = interception, mixing_depth = mixing_depth, + bulk_density = bulk_density) + results[TP_name, "compound"] <- TP$acronym + results[TP_name, "initial"] <- ini + + ini_tillage <- ini * mixing_depth / tillage_depth + DT50 <- subset(TP$soil_degradation_endpoints, destination == "PECsoil")$DT50 + if (length(DT50) > 1) stop("More than one PECsoil DT50 for", TP$acronym) + if (length(DT50) > 0) { + if (!is.na(DT50)) { + k <- log(2) / DT50 + plateau_max <- ini_tillage / (1 - exp( - k * interval)) + plateau_min <- plateau_max * exp( - k * interval) + results[TP_name, c("plateau_max", "plateau_min")] <- c(plateau_max, plateau_min) + long_term_max <- plateau_min + ini + results[TP_name, c("plateau_max", "plateau_min", "long_term_max")] <- + c(plateau_max, plateau_min, long_term_max) + } + } + } + } + return(results) +} + diff --git a/pkg/R/TOXSWA_cwa.R b/pkg/R/TOXSWA_cwa.R index 9f729e5..9e23284 100644 --- a/pkg/R/TOXSWA_cwa.R +++ b/pkg/R/TOXSWA_cwa.R @@ -38,7 +38,7 @@ #' H_sw_D4_pond <- read.TOXSWA_cwa("00001p_pa.cwa", #' basedir = "SwashProjects/project_H_sw/TOXSWA", #' zipfile = system.file("testdata/SwashProjects.zip", -#' package = "pfm")) +#' package = "pfm")) read.TOXSWA_cwa <- function(filename, basedir = ".", zipfile = NULL, segment = "last", windows = NULL, thresholds = NULL) diff --git a/pkg/R/pfm_chent.R b/pkg/R/pfm_chent.R new file mode 100644 index 0000000..3c950ec --- /dev/null +++ b/pkg/R/pfm_chent.R @@ -0,0 +1,265 @@ +# Copyright (C) 2015 Johannes Ranke +# Contact: jranke@uni-bremen.de +# This file is part of the R package pfm + +# This program is free software: you can redistribute it and/or modify it under +# the terms of the GNU General Public License as published by the Free Software +# Foundation, either version 3 of the License, or (at your option) any later +# version. + +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +# details. + +# You should have received a copy of the GNU General Public License along with +# this program. If not, see <http://www.gnu.org/licenses/> + +#' R6 class for holding a chemical entity +#' +#' An R6 class for holding information about a chemical entity +#' +#' @docType class +#' @importFrom R6 R6Class +#' @export +#' @format An \code{\link{R6Class}} generator object. +#' @field acronym Acronym for local use +#' @field smiles SMILES code +#' @field mw Molecular weight +#' @field main_source Main source of information +#' @field transformations +#' @field sorption_endpoints +#' @examples +#' atrazine <- pfm_chent("atrazine", smiles = "Clc1nc(nc(n1)NC(C)C)NCC", mw = 215.68) +#' print(atrazine) +#' @keywords data + +pfm_chent <- R6Class("pfm_chent", + public <- list( + acronym = NULL, + smiles = NULL, + mw = NULL, + main_source = NULL, + initialize = function(acronym, smiles = NULL, mw = NULL, main_source = NULL) { + self$acronym <- acronym + self$smiles <- smiles + self$mw <- mw + self$main_source <- main_source + }, + p0 = data.frame(p0 = numeric(0), T = numeric(0), + comment = character(0), + source = character(0), pages = character(0), + stringsAsFactors = FALSE), + add_p0 = function(p0, T = 25, comment = "", source, pages = NA) { + i <- nrow(self$p0) + 1 + self$p0[i, c("p0", "T")] <- c(p0, T) + self$p0[i, c("comment", "pages")] <- c(comment, pages) + if (!missing(source)) self$p0[i, "source"] <- source + }, + cwsat = data.frame(cwsat = numeric(0), T = numeric(0), + pH = numeric(0), comment = character(0), + source = character(0), pages = character(0), + stringsAsFactors = FALSE), + add_cwsat = function(cwsat, T = NA, pH = NA, comment = "", source, pages = NA) { + i <- nrow(self$cwsat) + 1 + self$cwsat[i, c("cwsat", "T", "pH")] <- c(cwsat, T, pH) + self$cwsat[i, c("comment", "pages")] <- c(comment, pages) + if (!missing(source)) self$cwsat[i, "source"] <- source + }, + TPs = list(), + add_TP = function(x, smiles = NULL, mw = NULL, main_source = NULL) { + if (inherits(x, "pfm_chent")) { + chent_name <- deparse(substitute(x)) + chent <- x + } else { + chent_name <- make.names(x) + chent <- pfm_chent$new(x, smiles, mw, main_source) + } + self$TPs[[chent_name]] <- chent + }, + transformations = data.frame(study_type = character(0), + acronym = character(0), + max_occurrence = numeric(0), + source = character(0), + pages = character(0), + stringsAsFactors = FALSE), + add_transformations = function(study_type, TPs, max_occurrence, + comment = "", source, pages = NA) { + TP_names = make.names(TPs) + TP_is_chent = sapply(self$TPs[TP_names], function(x) inherits(x, "pfm_chent")) + if (!all(TP_is_chent)) { + stop(paste("Please add all TPs using pfm_chent$add_TP()", print(TP_is_chent))) + } + chents <- self$TPs[TP_names] + if (missing(source)) source <- self$main_source + if (is.numeric(pages)) pages <- paste(pages, collapse = ", ") + transformations <- data.frame(study_type = study_type, + acronym = sapply(chents, function(x) x$acronym), + max_occurrence = max_occurrence, + comment = comment, + source = source, + pages = pages, + row.names = NULL, + stringsAsFactors = FALSE) + self$transformations <- rbind(self$transformations, transformations) + }, + soil_degradation_endpoints = data.frame(destination = character(0), + DT50 = numeric(0), + comment = character(0), + pages = character(0), + stringsAsFactors = FALSE), + add_soil_degradation_endpoints = function(destination, DT50 = NA, + comment = "", pages = NA) { + i <- nrow(self$soil_degradation_endpoints) + 1 + self$soil_degradation_endpoints[i, c("destination", "comment", "pages")] <- + c(destination, comment, pages) + self$soil_degradation_endpoints[i, "DT50"] <- DT50 + }, + ws_degradation_endpoints = data.frame(destination = character(0), + DT50 = numeric(0), + comment = character(0), + tier = character(0), + pages = character(0), + stringsAsFactors = FALSE), + add_ws_degradation_endpoints = function(destination, DT50 = NA, tier = NA, + comment = "", pages = NA) { + i <- nrow(self$ws_degradation_endpoints) + 1 + self$ws_degradation_endpoints[i, c("destination", "tier", "comment", "pages")] <- + c(destination, tier, comment, pages) + self$ws_degradation_endpoints[i, "DT50"] <- DT50 + }, + water_degradation_endpoints = data.frame(destination = character(0), + DT50 = numeric(0), + tier = character(0), + comment = character(0), + pages = character(0), + stringsAsFactors = FALSE), + add_water_degradation_endpoints = function(destination, DT50 = NA, tier = NA, + comment = "", pages = NA) { + i <- nrow(self$water_degradation_endpoints) + 1 + self$water_degradation_endpoints[i, c("destination", "tier", "comment", "pages")] <- + c(destination, tier, comment, pages) + self$water_degradation_endpoints[i, "DT50"] <- DT50 + }, + sediment_degradation_endpoints = data.frame(destination = character(0), + DT50 = numeric(0), + tier = character(0), + comment = character(0), + pages = character(0), + stringsAsFactors = FALSE), + add_sediment_degradation_endpoints = function(destination, DT50 = NA, tier = NA, + comment = "", pages = NA) { + i <- nrow(self$sediment_degradation_endpoints) + 1 + self$sediment_degradation_endpoints[i, c("destination", "tier", "comment", "pages")] <- + c(destination, tier, comment, pages) + self$sediment_degradation_endpoints[i, "DT50"] <- DT50 + }, + sorption_endpoints = data.frame(Kfoc = numeric(0), f1.n = numeric(0), + type = character(0), + comment = character(0), + pages = character(0), + stringsAsFactors = FALSE), + add_sorption_endpoints = function(Kfoc, f1.n = 1, type = "arithmetic mean", + comment = "", pages = NA) { + i <- nrow(self$sorption_endpoints) + 1 + self$sorption_endpoints[i, c("Kfoc", "f1.n")] <- c(Kfoc, f1.n) + self$sorption_endpoints[i, c("type", "comment", "pages")] <- c(type, comment, pages) + }, + print = function(TPs = TRUE) { + cat("<pfm_chent> with acronym", self$acronym, "\n") + if (!is.null(self$smiles)) cat ("SMILES:", self$smiles, "\n") + if (!is.null(self$mw)) cat ("Molecular weight:", round(self$mw, 1), "\n") + if (!is.null(self$main_source)) cat ("Main source of information:", self$main_source, "\n") + if (TPs) { + if (length(self$TPs) > 0) { + cat("\nTransformation products:\n") + print(self$TPs) + } + if (nrow(self$transformations) > 0) { + cat("\nTransformations:\n") + print(self$transformations[order(self$transformations$study_type), ], row.names = FALSE) + } + } + } + ) +) + +#' R6 class for holding active ingredients +#' +#' An R6 class for holding information about active ingredients +#' +#' @docType class +#' @importFrom R6 R6Class +#' @export +#' @format An \code{\link{R6Class}} generator object. +#' @field iso ISO common name +#' @examples +#' atrazine <- pfm_ai("atrazine", smiles = "Clc1nc(nc(n1)NC(C)C)NCC", mw = 215.68) +#' print(atrazine) +#' @keywords data + +pfm_ai <- R6Class("pfm_ai", + inherit = pfm_chent, + public <- list( + iso = NULL, + initialize = function(iso, acronym = iso, smiles = NULL, mw = NULL, main_source = NULL) { + super$initialize(acronym = acronym, smiles = smiles, mw = mw, main_source = main_source) + self$iso <- iso + }, + ff = data.frame(from = character(0), to = character(0), ff = numeric(0), + comment = character(0), pages = character(0), + stringsAsFactors = FALSE), + add_ff = function(from = "parent", to, ff = 1, comment = "", pages = NA) { + i <- nrow(self$ff) + 1 + if (from != "parent") { + if (!exists(from, self$TPs)) stop(from, " was not found in TPs") + } + if (!exists(to, self$TPs)) stop(to, " was not found in TPs") + self$ff[i, ] <- c(from, to, ff, comment, pages) + }, + print = function() { + if (is.null(self$iso)) cat("<pfm_ai> with acronym", self$acronym, "\n") + else cat("<pfm_ai> with ISO common name", self$iso, "\n") + super$print() + } + ) +) + +#' R6 class for holding a product with at least one active ingredient +#' +#' An R6 class for holding information about a product with at least one active ingredient +#' +#' @docType class +#' @importFrom R6 R6Class +#' @export +#' @format An \code{\link{R6Class}} generator object. +#' @field name The name of the product +#' @field ais A list of active ingredients +#' @field concentrations The concentration of the ais +#' @field concentration_units Defaults to g/L +#' @keywords data + +pfm_product <- R6Class("pfm_product", + public <- list( + name = NULL, + ais = list(), + concentrations = NULL, + concentration_units = NULL, + density = NULL, + density_units = "g/L", + initialize = function(name, ..., concentrations, concentration_units = "g/L", + density = 1000, density_units = "g/L") { + self$name <- name + self$ais <- list(...) + self$concentrations <- concentrations + self$density <- density + self$density_units <- density_units + names(self$concentrations) <- names(self$ais) + self$concentration_units <- concentration_units + }, + print = function() { + cat("<pfm_product> named", self$name, "\n") + } + ) +) + diff --git a/pkg/man/PEC_soil_product.Rd b/pkg/man/PEC_soil_product.Rd new file mode 100644 index 0000000..b4ea95e --- /dev/null +++ b/pkg/man/PEC_soil_product.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2 (4.1.0.9001): do not edit by hand +% Please edit documentation in R/PEC_soil.R +\name{PEC_soil_product} +\alias{PEC_soil_product} +\title{Calculate predicted environmental concentrations in soil for a product} +\usage{ +PEC_soil_product(product, rate, rate_units = "L/ha", interception = 0, + mixing_depth = 5, tillage_depth = 20, interval = 365, + bulk_density = 1.5, PEC_units = "mg/kg") +} +\description{ +Calculates long term accumulation PEC values +} +\author{ +Johannes Ranke +} + diff --git a/pkg/man/pfm_ai.Rd b/pkg/man/pfm_ai.Rd new file mode 100644 index 0000000..794a55e --- /dev/null +++ b/pkg/man/pfm_ai.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2 (4.1.0.9001): do not edit by hand +% Please edit documentation in R/pfm_chent.R +\docType{class} +\name{pfm_ai} +\alias{pfm_ai} +\title{R6 class for holding active ingredients} +\format{An \code{\link{R6Class}} generator object.} +\usage{ +pfm_ai +} +\description{ +An R6 class for holding information about active ingredients +} +\section{Fields}{ + +\describe{ +\item{\code{iso}}{ISO common name} +}} +\examples{ +atrazine <- pfm_ai("atrazine", smiles = "Clc1nc(nc(n1)NC(C)C)NCC", mw = 215.68) +print(atrazine) +} +\keyword{data} + diff --git a/pkg/man/pfm_chent.Rd b/pkg/man/pfm_chent.Rd new file mode 100644 index 0000000..c62e8cf --- /dev/null +++ b/pkg/man/pfm_chent.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2 (4.1.0.9001): do not edit by hand +% Please edit documentation in R/pfm_chent.R +\docType{class} +\name{pfm_chent} +\alias{pfm_chent} +\title{R6 class for holding a chemical entity} +\format{An \code{\link{R6Class}} generator object.} +\usage{ +pfm_chent +} +\description{ +An R6 class for holding information about a chemical entity +} +\section{Fields}{ + +\describe{ +\item{\code{acronym}}{Acronym for local use} + +\item{\code{smiles}}{SMILES code} + +\item{\code{mw}}{Molecular weight} + +\item{\code{main_source}}{Main source of information} + +\item{\code{transformations}}{} + +\item{\code{sorption_endpoints}}{} +}} +\examples{ +atrazine <- pfm_chent("atrazine", smiles = "Clc1nc(nc(n1)NC(C)C)NCC", mw = 215.68) +print(atrazine) +} +\keyword{data} + diff --git a/pkg/man/pfm_product.Rd b/pkg/man/pfm_product.Rd new file mode 100644 index 0000000..862ce3c --- /dev/null +++ b/pkg/man/pfm_product.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2 (4.1.0.9001): do not edit by hand +% Please edit documentation in R/pfm_chent.R +\docType{class} +\name{pfm_product} +\alias{pfm_product} +\title{R6 class for holding a product with at least one active ingredient} +\format{An \code{\link{R6Class}} generator object.} +\usage{ +pfm_product +} +\description{ +An R6 class for holding information about a product with at least one active ingredient +} +\section{Fields}{ + +\describe{ +\item{\code{name}}{The name of the product} + +\item{\code{ais}}{A list of active ingredients} + +\item{\code{concentrations}}{The concentration of the ais} + +\item{\code{concentration_units}}{Defaults to g/L} +}} +\keyword{data} + diff --git a/pkg/tests/testthat/test_PEC_soil.R b/pkg/tests/testthat/test_PEC_soil.R index 27b2eb7..7901b69 100644 --- a/pkg/tests/testthat/test_PEC_soil.R +++ b/pkg/tests/testthat/test_PEC_soil.R @@ -1,5 +1,5 @@ -library(pfm) -context("Simple PEC soil calculations") +library(mkin) +context("Setting up kinetic degradation models") test_that("PEC_soil calculates correctly", { # Application of 100 g/ha gives 0.133 mg/kg under default assumptions |