6 files changed, 186 insertions, 0 deletions
diff --git a/pkg/NAMESPACE b/pkg/NAMESPACE
index 2d95da4..771739a 100644
--- a/pkg/NAMESPACE
+++ b/pkg/NAMESPACE
@@ -2,9 +2,11 @@
 
 S3method(plot,TOXSWA_cwa)
 export(PEC_soil)
+export(PEC_sw_drainage_UK_ini)
 export(PEC_sw_drift)
 export(PEC_sw_drift_ini)
 export(SFO_actual_twa)
+export(SSLRC_mobility_classification)
 export(TOXSWA_cwa)
 export(geomean)
 export(pfm_degradation)
diff --git a/pkg/R/PEC_sw_drainage_UK.R b/pkg/R/PEC_sw_drainage_UK.R
new file mode 100644
index 0000000..03c56c0
--- /dev/null
+++ b/pkg/R/PEC_sw_drainage_UK.R
@@ -0,0 +1,53 @@
+# 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
+#' @return The predicted concentration in surface water in µg/L
+#' @export
+#' @author Johannes Ranke
+#' @examples
+#' PEC_sw_drainage_UK_ini(100)
+PEC_sw_drainage_UK_ini <- function(rate, interception = 0, Koc,
+                                   latest_application = NULL, soil_DT50 = NULL)
+{
+  percentage_lost <- SSLRC_mobility_classification(Koc)[[2]]
+  amount_available <- rate * (1 - interception) # g/ha
+
+  if (!missing(latest_application)) {
+    if (missing(soil_DT50)) stop("You need to supply a soil DT50 value")
+    k = log(2)/soil_DT50
+    as.Date(paste(latest_application, "1999"), "%d %B %Y")
+
+    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))
+    amount_available <- amount_available * exp(-k * degradation_time)
+  } 
+
+  volume = 130000 # L/ha
+  PEC = 1e6 * (percentage_lost/100) * amount_available / volume
+  return(PEC)
+}
diff --git a/pkg/R/SSLRC_mobility_classification.R b/pkg/R/SSLRC_mobility_classification.R
new file mode 100644
index 0000000..e04d472
--- /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(Koc)
+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/man/PEC_sw_drainage_UK_ini.Rd b/pkg/man/PEC_sw_drainage_UK_ini.Rd
new file mode 100644
index 0000000..c39a5c9
--- /dev/null
+++ b/pkg/man/PEC_sw_drainage_UK_ini.Rd
@@ -0,0 +1,30 @@
+% Generated by roxygen2 (4.1.0.9001): do not edit by hand
+% Please edit documentation in R/PEC_sw_drainage_UK.R
+\name{PEC_sw_drainage_UK_ini}
+\alias{PEC_sw_drainage_UK_ini}
+\title{Calculate initial predicted environmental concentrations in surface water due to drainage using the UK method}
+\usage{
+PEC_sw_drainage_UK_ini(rate, interception = 0, Koc,
+  latest_application = NULL, soil_DT50 = NULL)
+}
+\arguments{
+\item{rate}{Application rate in g/ha}
+
+\item{interception}{The fraction of the application rate that does not reach the soil}
+
+\item{Koc}{The sorption coefficient normalised to organic carbon in L/kg}
+}
+\value{
+The predicted concentration in surface water in µg/L
+}
+\description{
+This implements the method specified in the UK data requirements handbook and was checked against the spreadsheet
+published on the CRC website
+}
+\examples{
+PEC_sw_drainage_UK_ini(100)
+}
+\author{
+Johannes Ranke
+}
+
diff --git a/pkg/man/SSLRC_mobility_classification.Rd b/pkg/man/SSLRC_mobility_classification.Rd
new file mode 100644
index 0000000..a1bb413
--- /dev/null
+++ b/pkg/man/SSLRC_mobility_classification.Rd
@@ -0,0 +1,26 @@
+% Generated by roxygen2 (4.1.0.9001): do not edit by hand
+% Please edit documentation in R/SSLRC_mobility_classification.R
+\name{SSLRC_mobility_classification}
+\alias{SSLRC_mobility_classification}
+\title{Determine the SSLRC mobility classification for a chemical substance from its Koc}
+\usage{
+SSLRC_mobility_classification(Koc)
+}
+\arguments{
+\item{Koc}{The sorption coefficient normalised to organic carbon in L/kg}
+}
+\value{
+A list containing the classification and the percentage of the
+  compound transported per 10 mm drain water
+}
+\description{
+This implements the method specified in the UK data requirements handbook and was
+checked against the spreadsheet published on the CRC website
+}
+\examples{
+SSLRC_mobility_classification(Koc)
+}
+\author{
+Johannes Ranke
+}
+
diff --git a/pkg/tests/testthat/test_UK_drainage.R b/pkg/tests/testthat/test_UK_drainage.R
new file mode 100644
index 0000000..3a57db8
--- /dev/null
+++ b/pkg/tests/testthat/test_UK_drainage.R
@@ -0,0 +1,33 @@
+library(pfm)
+context("UK drainage PEC calculations")
+
+test_that("The mobility classification and the drained percentage are correct", {
+  # Expected results are from the CRD drainage calculator, retrieved 2015-06-11
+  
+  expect_equivalent(SSLRC_mobility_classification(1), list("Very mobile", 1.9))
+  expect_equivalent(SSLRC_mobility_classification(15), list("Mobile", 1.9))
+  expect_equivalent(SSLRC_mobility_classification(30), list("Mobile", 1.9))
+  expect_equivalent(SSLRC_mobility_classification(74.9), list("Mobile", 1.9))
+  expect_equivalent(SSLRC_mobility_classification(75), list("Moderately mobile", 0.7))
+  expect_equivalent(SSLRC_mobility_classification(100), list("Moderately mobile", 0.7))
+  expect_equivalent(SSLRC_mobility_classification(800), list("Slightly mobile", 0.5))
+  expect_equivalent(SSLRC_mobility_classification(2000), list("Slightly mobile", 0.02))
+  expect_equivalent(SSLRC_mobility_classification(5000), list("Non mobile", 0.01))
+})
+
+test_that("UK drainflow PECs are correct", {
+  # Expected results are from the CRD drainage calculator, retrieved 2015-06-11, except
+  # for the third example from the data requirements handbook
+
+  # This is the first example calculation from the data requirements handbook, where they give
+  # 8.07 µg/L as the result (obviously a rounding error).
+  expect_equal(round(PEC_sw_drainage_UK_ini(150, interception = 0, Koc = 100), 4), 8.0769)
+
+  # This is the second example calculation from the data requirements handbook
+  expect_equal(round(PEC_sw_drainage_UK_ini(90, interception = 0, Koc = 10), 4), 13.1538)
+
+  # This is the third example calculation from the data requirements handbook, 
+  expect_equal(round(PEC_sw_drainage_UK_ini(60, interception = 0.5, Koc = 550,
+                                            latest_application = "01 July",
+                                            soil_DT50 = 200), 2), 0.84)
+})