Merge branch 'master' into pfm_chent

Conflicts:
	pkg/DESCRIPTION
	pkg/NAMESPACE

8 files changed, 394 insertions, 0 deletions

diff --git a/pkg/R/PEC_sw_drainage_UK.R b/pkg/R/PEC_sw_drainage_UK.R
new file mode 100644
index 0000000..43c732e
--- /dev/null
+++ b/pkg/R/PEC_sw_drainage_UK.R
@@ -0,0 +1,66 @@
+# 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/>
+
+#' Calculate initial predicted environmental concentrations in surface water due to drainage using the UK method
+#'
+#' This implements the method specified in the UK data requirements handbook and was checked against the spreadsheet
+#' published on the CRC website
+#'
+#' @param rate Application rate in g/ha
+#' @param interception The fraction of the application rate that does not reach the soil
+#' @param Koc The sorption coefficient normalised to organic carbon in L/kg
+#' @param latest_application Latest application date, formatted as e.g. "01 July"
+#' @param soil_DT50 Soil degradation half-life, if SFO kinetics are to be used
+#' @param model The degradation model to be used. Either one of "FOMC", "DFOP", 
+#'   "HS", or "IORE", or an mkinmod object
+#' @param model_parms A named numeric vector containing the model parameters
+#' @return The predicted concentration in surface water in µg/L
+#' @export
+#' @author Johannes Ranke
+#' @examples
+#' PEC_sw_drainage_UK_ini(150, Koc = 100)
+PEC_sw_drainage_UK_ini <- function(rate, interception = 0, Koc,
+                                   latest_application = NULL, soil_DT50 = NULL,
+                                   model = NULL, model_parms = NULL)
+{
+  percentage_lost <- SSLRC_mobility_classification(Koc)[[2]]
+  amount_available <- rate * (1 - interception) # g/ha
+
+  if (!missing(latest_application)) {
+    lct <- Sys.getlocale("LC_TIME")
+    tmp <- Sys.setlocale("LC_TIME", "C")
+    latest <- as.Date(paste(latest_application, "1999"), "%d %b %Y")
+    tmp <- Sys.setlocale("LC_TIME", lct)
+    degradation_time <- as.numeric(difftime(as.Date("1999-10-01"), units = "days", latest))
+    if (!missing(soil_DT50)) {
+      k = log(2)/soil_DT50
+      as.Date(paste(latest_application, "1999"), "%d %B %Y")
+
+      amount_available <- amount_available * exp(-k * degradation_time)
+      if (!missing(model)) stop("You already supplied a soil_DT50 value, implying SFO kinetics")
+    }
+    if (!missing(model)) {
+      fraction_left <- pfm_degradation(model, parms = model_parms, 
+                                       times = degradation_time)[1, "parent"]
+      amount_available <- fraction_left * amount_available
+    }
+  } 
+
+  volume = 130000 # L/ha
+  PEC = 1e6 * (percentage_lost/100) * amount_available / volume
+  return(PEC)
+}
diff --git a/pkg/R/PEC_sw_drift.R b/pkg/R/PEC_sw_drift.R
new file mode 100644
index 0000000..ce57f79
--- /dev/null
+++ b/pkg/R/PEC_sw_drift.R
@@ -0,0 +1,55 @@
+# 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/>
+
+#' Calculate predicted environmental concentrations in surface water due to drift
+#'
+#' This is a basic, vectorised form of a simple calculation of a contaminant
+#' concentration in surface water based on complete, instantaneous mixing
+#' with input via spray drift.
+#'
+#' @param rate Application rate in units specified below
+#' @param applications Number of applications for selection of drift percentile
+#' @param drift_data Source of drift percentage data
+#' @param crop Crop name (use German names for JKI data), defaults to "Ackerbau"
+#' @param distances The distances in m for which to get PEC values
+#' @param water_depth Depth of the water body in cm
+#' @param rate_units Defaults to g/ha
+#' @param PEC_units Requested units for the calculated PEC. Only µg/L currently supported
+#' @return The predicted concentration in surface water
+#' @export
+#' @author Johannes Ranke
+#' @examples
+#' PEC_sw_drift(100)
+PEC_sw_drift <- function(rate, 
+                         applications = 1,
+                         water_depth = 30, 
+                         drift_data = "JKI",
+                         crop = "Ackerbau",
+                         distances = c(1, 5, 10, 20),
+                         rate_units = "g/ha",
+                         PEC_units = "\u00B5g/L")
+{
+  rate_units <- match.arg(rate_units)
+  PEC_units <- match.arg(PEC_units)
+  drift_data <- match.arg(drift_data)
+  water_volume <- 100 * 100 * (water_depth/100) * 1000   # in L (for 1 ha)
+  PEC_sw_overspray <- rate * 1e6 / water_volume          # in µg/L
+  dist_index <- as.character(distances)
+  PEC_sw_drift <- PEC_sw_overspray * pfm::drift_data_JKI[[applications]][dist_index, crop] / 100
+  names(PEC_sw_drift) <- paste(dist_index, "m")
+  return(PEC_sw_drift)
+}
diff --git a/pkg/R/PEC_sw_drift_ini.R b/pkg/R/PEC_sw_drift_ini.R
new file mode 100644
index 0000000..67e00d9
--- /dev/null
+++ b/pkg/R/PEC_sw_drift_ini.R
@@ -0,0 +1,55 @@
+# 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/>
+
+#' Calculate initial predicted environmental concentrations in surface water due to drift
+#'
+#' This is a basic, vectorised form of a simple calculation of a contaminant
+#' concentration in surface water based on complete, instantaneous mixing
+#' with input via spray drift.
+#'
+#' @param rate Application rate in units specified below
+#' @param applications Number of applications for selection of drift percentile
+#' @param drift_data Source of drift percentage data
+#' @param crop Crop name (use German names for JKI data), defaults to "Ackerbau"
+#' @param distances The distances in m for which to get PEC values
+#' @param water_depth Depth of the water body in cm
+#' @param rate_units Defaults to g/ha
+#' @param PEC_units Requested units for the calculated PEC. Only µg/L currently supported
+#' @return The predicted concentration in surface water
+#' @export
+#' @author Johannes Ranke
+#' @examples
+#' PEC_sw_drift_ini(100)
+PEC_sw_drift_ini <- function(rate, 
+                         applications = 1,
+                         water_depth = 30, 
+                         drift_data = "JKI",
+                         crop = "Ackerbau",
+                         distances = c(1, 5, 10, 20),
+                         rate_units = "g/ha",
+                         PEC_units = "\u00B5g/L")
+{
+  rate_units <- match.arg(rate_units)
+  PEC_units <- match.arg(PEC_units)
+  drift_data <- match.arg(drift_data)
+  water_volume <- 100 * 100 * (water_depth/100) * 1000   # in L (for 1 ha)
+  PEC_sw_overspray <- rate * 1e6 / water_volume          # in µg/L
+  dist_index <- as.character(distances)
+  PEC_sw_drift <- PEC_sw_overspray * pfm::drift_data_JKI[[applications]][dist_index, crop] / 100
+  names(PEC_sw_drift) <- paste(dist_index, "m")
+  return(PEC_sw_drift)
+}
diff --git a/pkg/R/PEC_sw_sed.R b/pkg/R/PEC_sw_sed.R
new file mode 100644
index 0000000..56396e8
--- /dev/null
+++ b/pkg/R/PEC_sw_sed.R
@@ -0,0 +1,50 @@
+# 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/>
+
+#' Calculate initial predicted environmental concentrations in sediment from
+#' surface water concentrations
+#'
+#' The method 'percentage' is equivalent to what is used in the CRD spreadsheet
+#' PEC calculator
+#'
+#' @param PEC_sw Numeric vector or matrix of surface water concentrations in µg/L for
+#'   which the corresponding sediment concentration is to be estimated
+#' @param percentage The percentage in sediment, used for the percentage method
+#' @param method The method used for the calculation
+#' @param sediment_depth Depth of the sediment layer
+#' @param water_depth Depth of the water body in cm
+#' @param sediment_density The density of the sediment in L/kg (equivalent to
+#'   g/cm3)
+#' @param PEC_sed_units The units of the estimated sediment PEC value
+#' @return The predicted concentration in sediment
+#' @export
+#' @author Johannes Ranke
+#' @examples
+#' PEC_sw_sed(PEC_sw_drift_ini(100, distances = 1), percentage = 50)
+PEC_sw_sed <- function(PEC_sw, percentage = 100, method = "percentage", 
+                       sediment_depth = 5, water_depth = 30,
+                       sediment_density = 1.3,
+                       PEC_sed_units = c("\u00B5g/kg", "mg/kg"))
+{
+  method = match.arg(method)
+  PEC_sed_units = match.arg(PEC_sed_units)
+  if (method == "percentage") {
+    PEC_sed = PEC_sw * (percentage/100) * (water_depth / sediment_depth) * (1 / sediment_density)
+    if (PEC_sed_units == "mg/kg") PEC_sed <- PEC_sed / 1000
+  }
+  return(PEC_sed)
+}
diff --git a/pkg/R/SFO_actual_twa.R b/pkg/R/SFO_actual_twa.R
new file mode 100644
index 0000000..7facb6a
--- /dev/null
+++ b/pkg/R/SFO_actual_twa.R
@@ -0,0 +1,36 @@
+# 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/>
+
+#' Actual and maximum moving window time average concentrations for SFO kinetics
+#'
+#' @param DT50 The half-life.
+#' @param times The output times, and window sizes for time weighted average concentrations
+#' @export
+#' @author Johannes Ranke
+#' @source FOCUS (2014) Generic Guidance for Estimating Persistence and Degradation
+#'   Kinetics from Environmental Fate Studies on Pesticides in EU Registratin, Version 1.1, 
+#'   18 December 2014, p. 251
+#' @examples
+#' SFO_actual_twa(10)
+SFO_actual_twa <- function(DT50 = 1000, times = c(0, 1, 2, 4, 7, 14, 21, 28, 42, 50, 100))
+{
+  k = log(2)/DT50
+  result <- data.frame(actual = 1 * exp(-k * times),
+                       twa = (1 - exp(-k * times))/(k * times),
+                       row.names = times)
+  return(result)
+}
diff --git a/pkg/R/SSLRC_mobility_classification.R b/pkg/R/SSLRC_mobility_classification.R
new file mode 100644
index 0000000..deda5cf
--- /dev/null
+++ b/pkg/R/SSLRC_mobility_classification.R
@@ -0,0 +1,42 @@
+# 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/>
+
+#' Determine the SSLRC mobility classification for a chemical substance from its Koc
+#'
+#' This implements the method specified in the UK data requirements handbook and was 
+#' checked against the spreadsheet published on the CRC website
+#'
+#' @param Koc The sorption coefficient normalised to organic carbon in L/kg
+#' @return A list containing the classification and the percentage of the
+#'   compound transported per 10 mm drain water
+#' @export
+#' @author Johannes Ranke
+#' @examples
+#' SSLRC_mobility_classification(100)
+SSLRC_mobility_classification <- function(Koc)
+{
+  if (!is.numeric(Koc) | length(Koc) != 1) stop("Please give a single number")
+  result <- list("Non mobile", 0.01)
+  if (Koc < 4000) result <- list("Slightly mobile", 0.02)
+  if (Koc < 1000) result <- list("Slightly mobile", 0.5)
+  if (Koc < 500) result <- list("Moderately mobile", 0.7)
+  if (Koc < 75) result <- list("Mobile", 1.9)
+  if (Koc < 15) result <- list("Very mobile", 1.9)
+  names(result) <- c("Mobility classification", 
+                     "Percentage drained per mm of drain water")
+  return(result)
+}
diff --git a/pkg/R/drift_data_JKI.R b/pkg/R/drift_data_JKI.R
new file mode 100644
index 0000000..44a959b
--- /dev/null
+++ b/pkg/R/drift_data_JKI.R
@@ -0,0 +1,42 @@
+#' Deposition from spray drift expressed as percent of the applied dose as
+#' published by the JKI
+#' 
+#' Deposition from spray drift expressed as percent of the applied dose as
+#' published by the German Julius-Kühn Institute (JKI).
+#' 
+#' The data were extracted from the spreadsheet cited below using the R code
+#' given in the example section. The spreadsheet is not included in the package
+#' as its licence is not clear.
+#' 
+#' 
+#' @name drift_data_JKI
+#' @docType data
+#' @format A list currently containing matrices with spray drift percentage
+#' data for field crops (Ackerbau), and Pome/stone fruit, early and late
+#' (Obstbau früh, spät).
+#' @source JKI (2010) Spreadsheet 'Tabelle der Abdrifteckwerte.xls', retrieved
+#' from
+#' http://www.jki.bund.de/no_cache/de/startseite/institute/anwendungstechnik/abdrift-eckwerte.html
+#' on 2015-06-11
+#' @keywords datasets
+#' @examples
+#' 
+#' \dontrun{
+#'   # This is the code that was used to extract the data
+#'   library(readxl)
+#'   abdrift_path <- "../inst/extdata/Tabelle der Abdrifteckwerte.xls"
+#'   JKI_crops <- c("Ackerbau", "Obstbau früh", "Obstbau spät")
+#'   names(JKI_crops) <- c("Field crops", "Pome/stone fruit, early", "Pome/stone fruit, late")
+#'   drift_data_JKI <- list()
+#' 
+#'   for (n in 1:8) {
+#'     drift_data_raw <- read_excel(abdrift_path, sheet = n + 1, skip = 2)
+#'     drift_data <- as.matrix(drift_data_raw[1:9, 2:4]) 
+#'     dimnames(drift_data) <- list(distance = as.integer(drift_data_raw[1:9, 1]),
+#'                                             crop = JKI_crops)
+#'     drift_data_JKI[[n]] <- drift_data
+#'   }
+#'   save(drift_data_JKI, file = "../data/drift_data_JKI.RData")
+#' }
+#' 
+NULL
diff --git a/pkg/R/pfm_degradation.R b/pkg/R/pfm_degradation.R
new file mode 100644
index 0000000..d1d2f9d
--- /dev/null
+++ b/pkg/R/pfm_degradation.R
@@ -0,0 +1,48 @@
+# 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/>
+
+#' Calculate a time course of relative concentrations based on an mkinmod model
+#'
+#' @import mkin
+#' @param model The degradation model to be used. Either a parent only model like
+#'   'SFO' or 'FOMC', or an mkinmod object
+#' @param DT50 The half-life. This is only used when simple exponential decline
+#'   is calculated (SFO model).
+#' @param parms The parameters used for the degradation model
+#' @param years For how many years should the degradation be predicted?
+#' @param step_days What step size in days should the output have?
+#' @param times The output times
+#' @export
+#' @author Johannes Ranke
+#' @examples
+#' pfm_degradation("SFO", DT50 = 10)
+pfm_degradation <- function(model = "SFO", DT50 = 1000, parms = c(k_parent_sink = log(2)/DT50),
+                            years = 1, step_days = 1,
+                            times = seq(0, years * 365, by = step_days))
+{
+  if (model %in% c("SFO", "FOMC", "DFOP", "HS", "IORE")) {
+    model <- mkinmod(parent = list(type = model))
+  }
+  initial_state = c(1, rep(0, length(model$diffs) - 1))
+  names(initial_state) <- names(model$diffs)
+  time_course <- mkinpredict(model, odeparms = parms, 
+                             odeini = initial_state,
+                             outtimes = times,
+                             solution_type = ifelse(length(model$spec) == 1,
+                                                    "analytical", "deSolve"))
+  invisible(time_course)
+}