diff options
Diffstat (limited to 'pkg/R')
-rw-r--r-- | pkg/R/PEC_sw_drainage_UK.R | 66 | ||||
-rw-r--r-- | pkg/R/PEC_sw_drift.R | 55 | ||||
-rw-r--r-- | pkg/R/PEC_sw_drift_ini.R | 55 | ||||
-rw-r--r-- | pkg/R/PEC_sw_sed.R | 50 | ||||
-rw-r--r-- | pkg/R/SFO_actual_twa.R | 36 | ||||
-rw-r--r-- | pkg/R/SSLRC_mobility_classification.R | 42 | ||||
-rw-r--r-- | pkg/R/drift_data_JKI.R | 42 | ||||
-rw-r--r-- | pkg/R/pfm_degradation.R | 48 |
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) +} |