Start of a pfm_chent data object

3 files changed, 337 insertions, 2 deletions

diff --git a/pkg/R/PEC_soil.R b/pkg/R/PEC_soil.R
index 3dbc2eb..26e0883 100644
--- a/pkg/R/PEC_soil.R
+++ b/pkg/R/PEC_soil.R
@@ -43,3 +43,72 @@ PEC_soil <- function(rate, rate_units = "g/ha", interception = 0,
   PEC_soil = rate_to_soil * 1000 / soil_mass     # in mg/kg
   return(PEC_soil)
 }
+
+
+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$degradation_endpoints, destination == "PECsoil")$DT50
+    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$degradation_endpoints, destination == "PECsoil")$DT50
+      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/pfm_chent.R b/pkg/R/pfm_chent.R
new file mode 100644
index 0000000..13a883b
--- /dev/null
+++ b/pkg/R/pfm_chent.R
@@ -0,0 +1,266 @@
+# 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
+#' @importFrom pfm pfm_chent
+#' @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/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