diff options
| -rw-r--r-- | pkg/R/PEC_soil.R | 11 | ||||
| -rw-r--r-- | pkg/R/pfm_chent.R | 266 |
2 files changed, 6 insertions, 271 deletions
diff --git a/pkg/R/PEC_soil.R b/pkg/R/PEC_soil.R index 73c7e42..3c3ae15 100644 --- a/pkg/R/PEC_soil.R +++ b/pkg/R/PEC_soil.R @@ -67,18 +67,19 @@ PEC_soil_product <- function(product, rate, rate_units = "L/ha", interception = 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, "compound"] <- ai$identifier 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) > 1) stop("More than one PECsoil DT50 for", ai_name) if (length(DT50) > 0) { if (!is.na(DT50)) { k <- log(2) / DT50 @@ -94,16 +95,16 @@ PEC_soil_product <- function(product, rate, rate_units = "L/ha", interception = TP <- ai$TPs[[TP_name]] max_occurrence = max(subset(ai$transformations, grepl("soil", study_type) & - acronym == TP$acronym, max_occurrence)) + TP_identifier == TP$identifier, 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, "compound"] <- TP$identifier 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) > 1) stop("More than one PECsoil DT50 for", TP_name) if (length(DT50) > 0) { if (!is.na(DT50)) { k <- log(2) / DT50 diff --git a/pkg/R/pfm_chent.R b/pkg/R/pfm_chent.R deleted file mode 100644 index 67037cb..0000000 --- a/pkg/R/pfm_chent.R +++ /dev/null @@ -1,266 +0,0 @@ -# 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 that is useful -#' for fate modelling -#' -#' @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") - } - ) -) - |