diff options
| -rw-r--r-- | DESCRIPTION | 21 | ||||
| -rw-r--r-- | NAMESPACE | 7 | ||||
| -rw-r--r-- | NEWS.md | 4 | ||||
| -rw-r--r-- | R/PEC_sw_drift.R | 161 | ||||
| -rw-r--r-- | log/build.log | 5 | ||||
| -rw-r--r-- | log/check.log | 9 | ||||
| -rw-r--r-- | log/test.log | 8 | ||||
| -rw-r--r-- | man/PEC_sw_drift.Rd | 49 | ||||
| -rw-r--r-- | man/drift_percentages_rautmann.Rd | 17 | ||||
| -rw-r--r-- | tests/testthat/test_PEC_sw_drift.R | 29 |
10 files changed, 228 insertions, 82 deletions
diff --git a/DESCRIPTION b/DESCRIPTION index 16f04c2..dc4d69d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Package: pfm Type: Package Title: Utilities for Pesticide Fate Modelling -Version: 0.6.4 -Date: 2026-02-06 +Version: 0.6.5 +Date: 2026-02-13 Authors@R: c( person("Johannes Ranke", email = "johannes.ranke@agroscope.admin.ch", role = c("aut", "cre"), @@ -13,24 +13,13 @@ Description: Utilities for simple calculations of predicted environmental concentrations ('PEC' values) and for dealing with data from some FOCUS pesticide fate modelling software packages. Depends: - R (>= 3.5.0), + R (>= 4.1.0), R6, mkin (>= 1.2) Imports: - graphics, - readr, - methods, - units, - dplyr + graphics, readr, methods, units, dplyr, tibble, tidyr Suggests: - testthat, - chents, - grImport, - magrittr, - covr, - here, - waldo, - docxtractr + testthat, chents, grImport, magrittr, covr, here, waldo, docxtractr License: GPL LazyLoad: true LazyData: true @@ -47,7 +47,11 @@ import(graphics) import(mkin) importFrom(R6,R6Class) importFrom(dplyr,across) +importFrom(dplyr,bind_rows) +importFrom(dplyr,if_else) +importFrom(dplyr,left_join) importFrom(dplyr,mutate) +importFrom(dplyr,pull) importFrom(grDevices,dev.cur) importFrom(methods,is) importFrom(mkin,mkinpredict) @@ -62,6 +66,9 @@ importFrom(stats,plot.ts) importFrom(stats,start) importFrom(stats,time) importFrom(stats,ts) +importFrom(tibble,as_tibble) +importFrom(tibble,tibble) +importFrom(tidyr,pivot_longer) importFrom(units,as_units) importFrom(units,drop_units) importFrom(units,set_units) @@ -1,5 +1,9 @@ ## version 0.6.4 +- R/PEC_sw_drift.R: Vectorise the function not only with respect to distances, rates and water depths, but also with respect to crop groups. Closes issue #2 reported by Julian Klein (@juklei). + +## version 0.6.4 + - R/PEC_sw_drainage_uk.R: Fix a bug preventing the function to work of `latest_application` is set to 29 February. Also, make this function correctly deal with units. - R/twa.R: Fix a bug in plotting one-box models of class `one_box` that affected plots that displayed a time weighted average. diff --git a/R/PEC_sw_drift.R b/R/PEC_sw_drift.R index 5c7fff4..cf2328a 100644 --- a/R/PEC_sw_drift.R +++ b/R/PEC_sw_drift.R @@ -1,3 +1,4 @@ +utils::globalVariables(c("A", "B", "C", "D", "H", "hinge", "z1", "z2", "distance", "pctg", "width")) #' Calculate predicted environmental concentrations in surface water due to drift #' #' This is a basic, vectorised form of a simple calculation of a contaminant @@ -7,6 +8,9 @@ #' It is recommened to specify the arguments `rate`, `water_depth` and #' `water_width` using [units::units] from the `units` package. #' +#' Since pfm version 0.6.5, the function is vectorised with respect to rates, +#' applications, water depth, crop groups and distances +#' #' @inheritParams drift_percentages_rautmann #' @importFrom units as_units set_units #' @seealso [drift_parameters_focus], [drift_percentages_rautmann] @@ -15,18 +19,25 @@ #' @param rate_units Defaults to g/ha. For backwards compatibility, only used #' if the specified rate does not have [units::units]]. #' @param drift_percentages Percentage drift values for which to calculate PECsw. -#' Overrides 'drift_data' and 'distances' if not NULL. +#' Overrides 'drift_data', 'distances', 'applications', crop group and +#' formula arguments if not NULL. #' @param drift_data Source of drift percentage data. If 'JKI', the [drift_data_JKI] #' included in the package is used. If 'RF', the Rautmann drift data are calculated #' either in the original form or integrated over the width of the water body, depending #' on the 'formula' argument. #' @param crop_group_JKI When using the 'JKI' drift data, one of the German names -#' as used in [drift_data_JKI]. Will only be used if drift_data is 'JKI'. +#' as used in [drift_data_JKI]. Will only be used if drift_data is 'JKI'. Available +#' crop groups are "Ackerbau", "Obstbau frueh", "Obstbau spaet", +#' "Weinbau frueh", "Weinbau spaet", "Hopfenbau", "Flaechenkulturen > 900 l/ha" and +#' "Gleisanlagen". #' @param water_depth Depth of the water body in cm #' @param PEC_units Requested units for the calculated PEC. Only µg/L currently supported #' @param water_width Width of the water body in cm #' @param side_angle The angle of the side of the water relative to the bottom which #' is assumed to be horizontal, in degrees. The SYNOPS model assumes 45 degrees here. +#' @importFrom tibble as_tibble +#' @importFrom dplyr bind_rows +#' @importFrom tidyr pivot_longer #' @return The predicted concentration in surface water #' @export #' @author Johannes Ranke @@ -53,16 +64,41 @@ #' PEC_sw_drift(100, drift_data = "RF", formula = "FOCUS") #' PEC_sw_drift(100, drift_data = "RF", formula = "FOCUS", side_angle = 45) #' PEC_sw_drift(100, drift_data = "RF", formula = "FOCUS", side_angle = 45, water_width = 200) +#' +#' # The function is vectorised with respect to rates, applications, water depth, +#' # crop groups and distances +#' PEC_sw_drift( +#' rate = rep(100, 6), +#' applications = c(1, 2, rep(1, 4)), +#' water_depth = c(30, 30, 30, 60, 30, 30), +#' crop_group_JKI = c(rep("Ackerbau", 4), rep("Obstbau frueh", 2)), +#' distances = c(rep(5, 4), 10, 5)) +#' +#' # Try the same with the Rautmann formula +#' PEC_sw_drift( +#' rate = rep(100, 6), +#' applications = c(1, 2, rep(1, 4)), +#' water_depth = c(30, 30, 30, 60, 30, 30), +#' drift_data = "RF", +#' crop_group_RF = c(rep("arable", 4), rep("fruit, early", 2)), +#' distances = c(rep(5, 4), 10, 5)) +#' +#' # And with the FOCUS variant +#' PEC_sw_drift( +#' rate = rep(100, 6), +#' applications = c(1, 2, rep(1, 4)), +#' water_depth = c(30, 30, 30, 60, 30, 30), +#' drift_data = "RF", +#' formula = "FOCUS", +#' crop_group_RF = c(rep("arable", 4), rep("fruit, early", 2)), +#' distances = c(rep(5, 4), 10, 5)) PEC_sw_drift <- function(rate, applications = 1, water_depth = as_units("30 cm"), drift_percentages = NULL, drift_data = c("JKI", "RF"), - crop_group_JKI = c("Ackerbau", - "Obstbau frueh", "Obstbau spaet", "Weinbau frueh", "Weinbau spaet", - "Hopfenbau", "Flaechenkulturen > 900 l/ha", "Gleisanlagen"), - crop_group_RF = c("arable", "hops", "vines, late", "vines, early", - "fruit, late", "fruit, early", "aerial"), + crop_group_JKI = "Ackerbau", + crop_group_RF = "arable", distances = c(1, 5, 10, 20), formula = c("Rautmann", "FOCUS"), water_width = as_units("100 cm"), @@ -70,38 +106,60 @@ PEC_sw_drift <- function(rate, rate_units = "g/ha", PEC_units = "\u00B5g/L") { + + # Check arguments and set default units if not specified rate_units <- match.arg(rate_units) PEC_units <- match.arg(PEC_units) - # Set default units if not specified if (!inherits(rate, "units")) rate <- set_units(rate, rate_units, mode = "symbolic") if (!inherits(water_width, "units")) water_width <- set_units(water_width, "cm") if (!inherits(water_depth, "units")) water_depth <- set_units(water_depth, "cm") drift_data <- match.arg(drift_data) - crop_group_JKI <- match.arg(crop_group_JKI) - crop_group_RF <- match.arg(crop_group_RF) - if (drift_data == "JKI" & crop_group_RF != "arable") { + + 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") + + 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 (drift_data == "JKI" & crop_group_RF[1] != "arable") { stop("Specifying crop_group_RF only makes sense if 'RF' is used for 'drift_data'") } - if (drift_data == "RF" & crop_group_JKI != "Ackerbau") { + if (drift_data == "RF" & crop_group_JKI[1] != "Ackerbau") { stop("Specifying crop_group_JKI only makes sense if 'JKI' is used for 'drift_data'") } formula <- match.arg(formula) + + # Check waterbody arguments and calculate mean water width (absolute and relative to water width) if (side_angle < 0 | side_angle > 90) stop("The side anglemust be between 0 and 90 degrees") mean_water_width <- if (side_angle == 90) water_width # Mean water width over waterbody depth 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 + + # Base PEC sw drift for overspray PEC_sw_overspray <- set_units(rate / (relative_mean_water_width * water_depth), PEC_units, mode = "symbolic") - dist_index <- as.character(distances) if (is.null(drift_percentages)) { - drift_percentages <- switch(drift_data, - JKI = pfm::drift_data_JKI[[applications]][dist_index, crop_group_JKI], - RF = drift_percentages_rautmann(distances, applications, + if (drift_data == "JKI") { + drift_data_JKI_long <- pfm::drift_data_JKI |> + lapply(as_tibble, rownames = "distance") |> + bind_rows(.id = "applications") |> + pivot_longer(3:10, names_to = "crop_group_JKI", values_to = "pctg") + + drift_percentages <- tibble( + applications = as.character(applications), + distance = as.character(distances), crop_group_JKI + ) |> + left_join(drift_data_JKI_long, by = c("applications", "distance", "crop_group_JKI")) |> + pull(pctg) + names(drift_percentages) <- paste(distances, "m") + } + if (drift_data == "RF") { + drift_percentages <- drift_percentages_rautmann(distances, applications, formula = formula, crop_group_RF, widths = as.numeric(set_units(water_width, "m"))) - ) - names(drift_percentages) <- paste(dist_index, "m") + names(drift_percentages) <- paste(distances, "m") + } } else { names(drift_percentages) <- paste(drift_percentages, "%") } @@ -118,7 +176,11 @@ PEC_sw_drift <- function(rate, #' @param distances The distances in m for which to get PEC values #' @param widths The widths of the water bodies (only used in the FOCUS formula) #' @param applications Number of applications for selection of drift percentile -#' @param crop_group_RF One of the crop groups as used in [drift_parameters_focus] +#' @param crop_group_RF Crop group(s) as used in [drift_parameters_focus], i.e. +#' "arable", "hops", "vines, late", "vines, early", "fruit, late", "fruit, early" +#' or "aerial". +#' @importFrom tibble tibble +#' @importFrom dplyr if_else left_join mutate pull #' @seealso [drift_parameters_focus], [PEC_sw_drift] #' @references FOCUS (2014) Generic guidance for Surface Water Scenarios (version 1.4). #' FOrum for the Co-ordination of pesticde fate models and their USe. @@ -131,6 +193,16 @@ PEC_sw_drift <- function(rate, #' drift_percentages_rautmann(c(1, 3, 5)) #' drift_percentages_rautmann(c(1, 3, 5), formula = "FOCUS") #' +#' # Since pfm 0.6.5, the function can also take a vector of crop groups +#' drift_percentages_rautmann( +#' distances = c(1, 5, 5), +#' crop_group_RF = c("fruit, early", "fruit, early", "fruit, late")) +#' +#' # Two applications, all else equal +#' drift_data_JKI[[2]][as.character(c(1, 3, 5)), "Ackerbau"] +#' drift_percentages_rautmann(c(1, 3, 5), applications = 2) +#' drift_percentages_rautmann(c(1, 3, 5), formula = "FOCUS", app = 2) +#' #' # One application to early or late fruit crops #' drift_data_JKI[[1]][as.character(c(3, 5, 20, 50)), "Obstbau frueh"] #' drift_percentages_rautmann(c(3, 5, 20, 50), crop_group_RF = "fruit, early") @@ -151,41 +223,46 @@ PEC_sw_drift <- function(rate, #' main = "One application to fruit, early") #' abline(v = 11.4, lty = 2) drift_percentages_rautmann <- function(distances, applications = 1, - crop_group_RF = c("arable", "hops", "vines, late", "vines, early", "fruit, late", - "fruit, early", "aerial"), + crop_group_RF = "arable", formula = c("Rautmann", "FOCUS"), widths = 1 ) { - cg <- match.arg(crop_group_RF) - if (!applications %in% 1:8) stop("Only 1 to 8 applications are supported") + unmatched_crop_groups <- setdiff(crop_group_RF, unique(pfm::drift_parameters_focus$crop_group)) + if (length(unmatched_crop_groups) > 0) stop("Crop group(s) ", unmatched_crop_groups, " not supported") + if (!all(applications %in% 1:8)) stop("Only 1 to 8 applications are supported") formula <- match.arg(formula) - parms <- pfm::drift_parameters_focus[pfm::drift_parameters_focus$crop_group == cg & - pfm::drift_parameters_focus$n_apps == applications, c("A", "B", "C", "D", "hinge")] + # To avoid recycling of components with length != 1 but smaller than the longest argument, + # which would likely be unintended, we use tibble here + parms <- tibble(distance = distances, width = widths, n_apps = applications, crop_group = crop_group_RF) |> + left_join(pfm::drift_parameters_focus, by = c("n_apps", "crop_group")) if (formula[1] == "Rautmann") { - drift_percentages = with(as.list(parms), { - A <- ifelse(distances < hinge, A, C) - B <- ifelse(distances < hinge, B, D) - A * distances^B - }) + drift_percentages <- parms |> + mutate( + A = if_else(distance < hinge, A, C), + B = if_else(distance < hinge, B, D)) |> + mutate( + pctg = A * distances^B) |> + pull(pctg) } else { - drift_percentages = with(as.list(parms), { - z1 = distances - z2 = distances + widths - H = hinge - ifelse(z2 < hinge, + drift_percentages <- parms |> + mutate( + z1 = distance, + z2 = distance + width, + H = hinge) |> + mutate( + pctg = if_else(z2 < hinge, # farther edge closer than hinge distance - A/(widths * (B + 1)) * (z2^(B + 1) - z1^(B + 1)), - ifelse(z1 < hinge, + A/(width * (B + 1)) * (z2^(B + 1) - z1^(B + 1)), + if_else(z1 < hinge, # hinge distance in waterbody (between z1 and z2) - (A/(B + 1) * (H^(B + 1) - z1^(B + 1)) + C/(D + 1) * (z2^(D + 1) - H^(D + 1)))/widths, + (A/(B + 1) * (H^(B + 1) - z1^(B + 1)) + C/(D + 1) * (z2^(D + 1) - H^(D + 1)))/width, # z1 >= hinge, i.e. near edge farther than hinge distance - C/(widths * (D + 1)) * (z2^(D + 1) - z1^(D + 1)) - ) - ) - }) + C/(width * (D + 1)) * (z2^(D + 1) - z1^(D + 1))) + )) |> + pull(pctg) } return(drift_percentages) diff --git a/log/build.log b/log/build.log index 5b3f7ee..fb1f5c2 100644 --- a/log/build.log +++ b/log/build.log @@ -3,9 +3,6 @@ * checking DESCRIPTION meta-information ... OK * checking for LF line-endings in source and make files and shell scripts * checking for empty or unneeded directories -Removed empty directory ‘pfm/inst/testdata/SwashProjects/Project_1/MACRO’ -Removed empty directory ‘pfm/inst/testdata/SwashProjects/Project_1’ -Removed empty directory ‘pfm/inst/testdata/SwashProjects’ * re-saving image files -* building ‘pfm_0.6.4.tar.gz’ +* building ‘pfm_0.6.5.tar.gz’ diff --git a/log/check.log b/log/check.log index 5deae11..7b1b369 100644 --- a/log/check.log +++ b/log/check.log @@ -9,12 +9,12 @@ * using options ‘--no-tests --as-cran’ * checking for file ‘pfm/DESCRIPTION’ ... OK * checking extension type ... Package -* this is package ‘pfm’ version ‘0.6.4’ +* this is package ‘pfm’ version ‘0.6.5’ * package encoding: UTF-8 * checking CRAN incoming feasibility ... NOTE Maintainer: ‘Johannes Ranke <johannes.ranke@agroscope.admin.ch>’ -Size of tarball: 8533512 bytes +Size of tarball: 8534968 bytes * checking package namespace information ... OK * checking package dependencies ... OK * checking if this is a source package ... OK @@ -29,7 +29,8 @@ Size of tarball: 8533512 bytes sub-directories of 1Mb or more: testdata 9.9Mb * checking package directory ... OK -* checking for future file timestamps ... OK +* checking for future file timestamps ... NOTE +unable to verify current time * checking DESCRIPTION meta-information ... OK * checking top-level files ... OK * checking for left-over files ... OK @@ -71,7 +72,7 @@ Size of tarball: 8533512 bytes * checking for detritus in the temp directory ... OK * DONE -Status: 1 NOTE +Status: 2 NOTEs See ‘/home/jranke/git/pfm/pfm.Rcheck/00check.log’ for details. diff --git a/log/test.log b/log/test.log index 7204076..ff352bd 100644 --- a/log/test.log +++ b/log/test.log @@ -5,14 +5,14 @@ ✔ | 1 | Check max_twa for parent mkinfit models against analytical solutions ✔ | 1 | Simple PEC sediment calculations ✔ | 17 | Simple PEC soil calculations -✔ | 8 | Simple PEC surface water calculations with drift entry +✔ | 10 | Simple PEC surface water calculations with drift entry ✔ | 1 | Actual and time weighted average concentrations for SFO kinetics ✔ | 9 | FOCUS Step 1 calculations ✔ | 8 | FOCUS Steps 12 input files -✔ | 7 | Read and analyse TOXSWA cwa files [2.6s] +✔ | 7 | Read and analyse TOXSWA cwa files [4.2s] ✔ | 17 | UK drainage PEC calculations ══ Results ═════════════════════════════════════════════════════════════════════════════════════════ -Duration: 3.8 s +Duration: 6.0 s -[ FAIL 0 | WARN 0 | SKIP 0 | PASS 82 ] +[ FAIL 0 | WARN 0 | SKIP 0 | PASS 84 ] diff --git a/man/PEC_sw_drift.Rd b/man/PEC_sw_drift.Rd index 5f3049a..1cc7d4e 100644 --- a/man/PEC_sw_drift.Rd +++ b/man/PEC_sw_drift.Rd @@ -10,10 +10,8 @@ PEC_sw_drift( water_depth = as_units("30 cm"), drift_percentages = NULL, drift_data = c("JKI", "RF"), - crop_group_JKI = c("Ackerbau", "Obstbau frueh", "Obstbau spaet", "Weinbau frueh", - "Weinbau spaet", "Hopfenbau", "Flaechenkulturen > 900 l/ha", "Gleisanlagen"), - crop_group_RF = c("arable", "hops", "vines, late", "vines, early", "fruit, late", - "fruit, early", "aerial"), + crop_group_JKI = "Ackerbau", + crop_group_RF = "arable", distances = c(1, 5, 10, 20), formula = c("Rautmann", "FOCUS"), water_width = as_units("100 cm"), @@ -31,7 +29,8 @@ PEC_sw_drift( \item{water_depth}{Depth of the water body in cm} \item{drift_percentages}{Percentage drift values for which to calculate PECsw. -Overrides 'drift_data' and 'distances' if not NULL.} +Overrides 'drift_data', 'distances', 'applications', crop group and +formula arguments if not NULL.} \item{drift_data}{Source of drift percentage data. If 'JKI', the \link{drift_data_JKI} included in the package is used. If 'RF', the Rautmann drift data are calculated @@ -39,9 +38,14 @@ either in the original form or integrated over the width of the water body, depe on the 'formula' argument.} \item{crop_group_JKI}{When using the 'JKI' drift data, one of the German names -as used in \link{drift_data_JKI}. Will only be used if drift_data is 'JKI'.} +as used in \link{drift_data_JKI}. Will only be used if drift_data is 'JKI'. Available +crop groups are "Ackerbau", "Obstbau frueh", "Obstbau spaet", +"Weinbau frueh", "Weinbau spaet", "Hopfenbau", "Flaechenkulturen > 900 l/ha" and +"Gleisanlagen".} -\item{crop_group_RF}{One of the crop groups as used in \link{drift_parameters_focus}} +\item{crop_group_RF}{Crop group(s) as used in \link{drift_parameters_focus}, i.e. +"arable", "hops", "vines, late", "vines, early", "fruit, late", "fruit, early" +or "aerial".} \item{distances}{The distances in m for which to get PEC values} @@ -70,6 +74,9 @@ with input via spray drift. \details{ It is recommened to specify the arguments \code{rate}, \code{water_depth} and \code{water_width} using \link[units:units]{units::units} from the \code{units} package. + +Since pfm version 0.6.5, the function is vectorised with respect to rates, +applications, water depth, crop groups and distances } \examples{ PEC_sw_drift(100) @@ -94,6 +101,34 @@ PEC_sw_drift(100, drift_data = "RF") PEC_sw_drift(100, drift_data = "RF", formula = "FOCUS") PEC_sw_drift(100, drift_data = "RF", formula = "FOCUS", side_angle = 45) PEC_sw_drift(100, drift_data = "RF", formula = "FOCUS", side_angle = 45, water_width = 200) + +# The function is vectorised with respect to rates, applications, water depth, +# crop groups and distances +PEC_sw_drift( + rate = rep(100, 6), + applications = c(1, 2, rep(1, 4)), + water_depth = c(30, 30, 30, 60, 30, 30), + crop_group_JKI = c(rep("Ackerbau", 4), rep("Obstbau frueh", 2)), + distances = c(rep(5, 4), 10, 5)) + +# Try the same with the Rautmann formula +PEC_sw_drift( + rate = rep(100, 6), + applications = c(1, 2, rep(1, 4)), + water_depth = c(30, 30, 30, 60, 30, 30), + drift_data = "RF", + crop_group_RF = c(rep("arable", 4), rep("fruit, early", 2)), + distances = c(rep(5, 4), 10, 5)) + +# And with the FOCUS variant +PEC_sw_drift( + rate = rep(100, 6), + applications = c(1, 2, rep(1, 4)), + water_depth = c(30, 30, 30, 60, 30, 30), + drift_data = "RF", + formula = "FOCUS", + crop_group_RF = c(rep("arable", 4), rep("fruit, early", 2)), + distances = c(rep(5, 4), 10, 5)) } \seealso{ \link{drift_parameters_focus}, \link{drift_percentages_rautmann} diff --git a/man/drift_percentages_rautmann.Rd b/man/drift_percentages_rautmann.Rd index e2a50d1..ff84854 100644 --- a/man/drift_percentages_rautmann.Rd +++ b/man/drift_percentages_rautmann.Rd @@ -7,8 +7,7 @@ drift_percentages_rautmann( distances, applications = 1, - crop_group_RF = c("arable", "hops", "vines, late", "vines, early", "fruit, late", - "fruit, early", "aerial"), + crop_group_RF = "arable", formula = c("Rautmann", "FOCUS"), widths = 1 ) @@ -18,7 +17,9 @@ drift_percentages_rautmann( \item{applications}{Number of applications for selection of drift percentile} -\item{crop_group_RF}{One of the crop groups as used in \link{drift_parameters_focus}} +\item{crop_group_RF}{Crop group(s) as used in \link{drift_parameters_focus}, i.e. +"arable", "hops", "vines, late", "vines, early", "fruit, late", "fruit, early" +or "aerial".} \item{formula}{By default, the original Rautmann formula is used. If you specify "FOCUS", mean drift input over the width of the water body is @@ -36,6 +37,16 @@ drift_data_JKI[[1]][as.character(c(1, 3, 5)), "Ackerbau"] drift_percentages_rautmann(c(1, 3, 5)) drift_percentages_rautmann(c(1, 3, 5), formula = "FOCUS") +# Since pfm 0.6.5, the function can also take a vector of crop groups +drift_percentages_rautmann( + distances = c(1, 5, 5), + crop_group_RF = c("fruit, early", "fruit, early", "fruit, late")) + +# Two applications, all else equal +drift_data_JKI[[2]][as.character(c(1, 3, 5)), "Ackerbau"] +drift_percentages_rautmann(c(1, 3, 5), applications = 2) +drift_percentages_rautmann(c(1, 3, 5), formula = "FOCUS", app = 2) + # One application to early or late fruit crops drift_data_JKI[[1]][as.character(c(3, 5, 20, 50)), "Obstbau frueh"] drift_percentages_rautmann(c(3, 5, 20, 50), crop_group_RF = "fruit, early") diff --git a/tests/testthat/test_PEC_sw_drift.R b/tests/testthat/test_PEC_sw_drift.R index 1bcb3d4..5d343d0 100644 --- a/tests/testthat/test_PEC_sw_drift.R +++ b/tests/testthat/test_PEC_sw_drift.R @@ -35,7 +35,32 @@ test_that("The Rautmann formula is correctly implemented", { expect_equal(pfm_jki, pfm_rf, tolerance = 0.01) expect_error(PEC_sw_drift(100, drift_data = "RF", applications = 10), "Only 1 to 8 applications") - expect_error(PEC_sw_drift(100, drift_data = "RF", applications = 1, crop_group_RF = "Obstbau spaet"), - "should be one of") + + expect_error(PEC_sw_drift(100, drift_data = "RF", applications = 1, crop_group_RF = "Obstbau spaet")) expect_silent(PEC_sw_drift(100, drift_data = "RF", applications = 1, crop_group_RF = "fruit, late")) }) + +test_that("The function is vectorised also with respect to crop groups", { + res_vec_1 <- PEC_sw_drift( + rate = rep(100, 6), + applications = c(1, 2, rep(1, 4)), + water_depth = c(30, 30, 30, 60, 30, 30), + crop_group_JKI = c(rep("Ackerbau", 4), rep("Obstbau frueh", 2)), + distances = c(rep(5, 4), 10, 5)) + expect_equal( + round(res_vec_1, 3), + set_units(c('5 m' = 0.190, '5 m' = 0.157, '5 m' = 0.190, '5 m' = 0.095, '10 m' = 3.937, '5 m' = 6.630), "\u00B5g/L")) + + # Try the same with the Rautmann formula, results are slightly different + res_vec_2 <- PEC_sw_drift( + rate = rep(100, 6), + applications = c(1, 2, rep(1, 4)), + water_depth = c(30, 30, 30, 60, 30, 30), + drift_data = "RF", + crop_group_RF = c(rep("arable", 4), rep("fruit, early", 2)), + distances = c(rep(5, 4), 10, 5)) + expect_equal( + round(res_vec_2, 3), + set_units(c('5 m' = 0.191, '5 m' = 0.160, '5 m' = 0.191, '5 m' = 0.095, '10 m' = 3.936, '5 m' = 6.628), "\u00B5g/L")) + +}) |