diff options
Diffstat (limited to 'R')
| -rw-r--r-- | R/PEC_sw_drainage_UK.R | 39 | ||||
| -rw-r--r-- | R/PEC_sw_drift.R | 27 |
2 files changed, 54 insertions, 12 deletions
diff --git a/R/PEC_sw_drainage_UK.R b/R/PEC_sw_drainage_UK.R index d5f0bab..40835b2 100644 --- a/R/PEC_sw_drainage_UK.R +++ b/R/PEC_sw_drainage_UK.R @@ -1,7 +1,8 @@ #' 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. Degradation before the start of the drainage period is taken into account if +#' published on the CRC website. Degradation between the end (30 April) and the start (1 October) of +#' the drainage period is taken into account if #' `latest_application` is specified and the degradation parameters are given either as a `soil_DT50` or a `model`. #' #' @param rate Application rate in g/ha or with a compatible unit specified @@ -18,12 +19,12 @@ #' @return The predicted concentration in surface water in µg/L #' @references HSE's Chemicals Regulation Division (CRD) Active substance #' PECsw calculations (for UK specific authorisation requests) -#' \url{https://www.hse.gov.uk/pesticides/topics/pesticide-approvals/pesticides-registration/data-requirements-handbook/fate/active-substance-uk.htm} -#' accessed 2019-09-27 +#' \url{https://www.hse.gov.uk/pesticides/data-requirements-handbook/fate/pecsw-sed-via-drainflow.htm} +#' accessed 2026-02-13 #' -#' Drainage PECs Version 1.0 (2015) Spreadsheet published at -#' \url{https://www.hse.gov.uk/pesticides/topics/pesticide-approvals/pesticides-registration/data-requirements-handbook/fate/pec-tools-2015/PEC\%20sw-sed\%20(drainage).xlsx} -#' accessed 2019-09-27 +#' PECsw/sed spray drift and tier 1 drainflow calculator Version 2.1.1 (2025) Spreadsheet published at +#' \url{https://www.hse.gov.uk/pesticides/assets/docs/PEC%20sw-sed%20(spraydrift).xlsx)} +#' accessed 2026-02-13 #' @export #' @author Johannes Ranke #' @examples @@ -61,12 +62,13 @@ PEC_sw_drainage_UK <- function(rate, latest <- as.Date(paste(latest_application, ref_year), "%d %b %Y") if (is.na(latest)) stop("Please specify the latest application in the format '%d %b', e.g. '01 July'") tmp <- Sys.setlocale("LC_TIME", lct) - degradation_time <- as.numeric(difftime(as.Date(paste0(ref_year,"-10-01")), units = "days", latest)) + + drainage_date <- drainage_date_UK(latest) + degradation_time <- as.numeric(difftime(drainage_date, latest, units = "days")) + if (degradation_time > 0) { if (!missing(soil_DT50)) { k = log(2)/soil_DT50_d - 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") } @@ -82,3 +84,22 @@ PEC_sw_drainage_UK <- function(rate, PEC = set_units(1e6 * (percentage_lost/100) * amount_available / volume, "\u00B5g/L") return(PEC) } + +#' @rdname PEC_sw_drainage_UK +#' @param application_date Application date +#' @export +#' @examples +#' drainage_date_UK("2023-07-10") +#' drainage_date_UK("2020-12-01") +#' drainage_date_UK(as.Date("2022-01-15")) +drainage_date_UK <- function(application_date) { + year <- substr(application_date, 1, 4) + drainage_end <- as.Date(paste0(year, "-04-30")) + drainage_start <- as.Date(paste0(year, "-10-01")) + if (application_date <= drainage_end | application_date >= drainage_start) { + drainage_date <- application_date + } else { + drainage_date <- drainage_start + } + return(drainage_date) +} diff --git a/R/PEC_sw_drift.R b/R/PEC_sw_drift.R index cf2328a..05f90dd 100644 --- a/R/PEC_sw_drift.R +++ b/R/PEC_sw_drift.R @@ -12,6 +12,7 @@ utils::globalVariables(c("A", "B", "C", "D", "H", "hinge", "z1", "z2", "distance #' applications, water depth, crop groups and distances #' #' @inheritParams drift_percentages_rautmann +#' @importFrom testthat capture_output #' @importFrom units as_units set_units #' @seealso [drift_parameters_focus], [drift_percentages_rautmann] #' @param rate Application rate in units specified below, or with units defined via the @@ -38,7 +39,10 @@ utils::globalVariables(c("A", "B", "C", "D", "H", "hinge", "z1", "z2", "distance #' @importFrom tibble as_tibble #' @importFrom dplyr bind_rows #' @importFrom tidyr pivot_longer -#' @return The predicted concentration in surface water +#' @return A numeric vector with the predicted concentration in surface water. +#' In some cases, the vector is named with distances or drift percentages, for +#' backward compatibility with versions before the vectorisation of arguments +#' other than 'distances' was introduced in v0.6.5. #' @export #' @author Johannes Ranke #' @examples @@ -116,10 +120,14 @@ PEC_sw_drift <- function(rate, drift_data <- match.arg(drift_data) unmatched_crop_groups_JKI <- setdiff(crop_group_JKI, colnames(pfm::drift_data_JKI[[1]])) - if (length(unmatched_crop_groups_JKI) > 0) stop("Crop group(s) ", unmatched_crop_groups_JKI, " not supported") + if (length(unmatched_crop_groups_JKI) > 0) { + stop("Crop group(s) ", paste(unmatched_crop_groups_JKI, collapse = ", "), " not supported") + } unmatched_crop_groups_RF <- setdiff(crop_group_RF, unique(pfm::drift_parameters_focus$crop_group)) - if (length(unmatched_crop_groups_RF) > 0) stop("Crop group(s) ", unmatched_crop_groups_RF, " not supported") + if (length(unmatched_crop_groups_RF) > 0) { + stop("Crop group(s) ", paste(unmatched_crop_groups_RF, collapse = ", "), "not supported") + } if (drift_data == "JKI" & crop_group_RF[1] != "arable") { stop("Specifying crop_group_RF only makes sense if 'RF' is used for 'drift_data'") @@ -135,6 +143,19 @@ PEC_sw_drift <- function(rate, else water_width - (water_depth / tanpi(side_angle/180)) if (as.numeric(mean_water_width) < 0) stop("Undefined geometry") relative_mean_water_width <- mean_water_width / water_width # Always <= 1 + + # Check lengths of arguments advertised as vectorised for compatibility + arg_lengths <- sapply( + list(rate = rate, applications = applications, distances = distances, + water_depth = water_depth, crop_group_JKI = crop_group_JKI, + crop_group_RF = crop_group_RF), + length) + + arg_lengths_not_one <- arg_lengths[arg_lengths != 1] + if (length(unique(arg_lengths_not_one)) > 1) { + stop("The following argument lengths do not match:\n", + capture_output(print(arg_lengths_not_one))) + } # Base PEC sw drift for overspray PEC_sw_overspray <- set_units(rate / (relative_mean_water_width * water_depth), PEC_units, mode = "symbolic") |