aboutsummaryrefslogtreecommitdiff
path: root/R
diff options
context:
space:
mode:
Diffstat (limited to 'R')
-rw-r--r--R/PEC_sw_drift.R27
-rw-r--r--R/PEC_sw_exposit.R (renamed from R/PEC_sw_exposit_runoff.R)52
-rw-r--r--R/PEC_sw_sed.R22
3 files changed, 70 insertions, 31 deletions
diff --git a/R/PEC_sw_drift.R b/R/PEC_sw_drift.R
index c1b24d3..7028101 100644
--- a/R/PEC_sw_drift.R
+++ b/R/PEC_sw_drift.R
@@ -4,9 +4,16 @@
#' concentration in surface water based on complete, instantaneous mixing
#' with input via spray drift.
#'
+#' It is recommened to specify the arguments `rate`, `water_depth` and
+#' `water_width` using [units::units] from the `units` package.
+#'
#' @inheritParams drift_percentages_rautmann
+#' @importFrom units as_units set_units
#' @seealso [drift_parameters_focus], [drift_percentages_rautmann]
-#' @param rate Application rate in units specified below
+#' @param rate Application rate in units specified below, or with units defined via the
+#' `units` package.
+#' @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.
#' @param drift_data Source of drift percentage data. If 'JKI', the [drift_data_JKI]
@@ -16,7 +23,6 @@
#' @param crop_group_JKI When using the 'JKI' drift data, one of the German names
#' as used in [drift_parameters_focus]. Will only be used if drift_data is 'JKI'.
#' @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
#' @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
@@ -49,7 +55,7 @@
#' PEC_sw_drift(100, drift_data = "RF", formula = "FOCUS", side_angle = 45, water_width = 200)
PEC_sw_drift <- function(rate,
applications = 1,
- water_depth = 30,
+ water_depth = as_units("30 cm"),
drift_percentages = NULL,
drift_data = c("JKI", "RF"),
crop_group_JKI = c("Ackerbau",
@@ -59,13 +65,17 @@ PEC_sw_drift <- function(rate,
"fruit, late", "fruit, early", "aerial"),
distances = c(1, 5, 10, 20),
formula = c("Rautmann", "FOCUS"),
- water_width = 100,
+ water_width = as_units("100 cm"),
side_angle = 90,
rate_units = "g/ha",
PEC_units = "\u00B5g/L")
{
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)
@@ -77,10 +87,11 @@ PEC_sw_drift <- function(rate,
}
formula <- match.arg(formula)
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 <- if (side_angle == 90) water_width # Mean water width over waterbody depth
else water_width - (water_depth / tanpi(side_angle/180))
- water_volume <- 100 * mean_water_width * (water_depth/100) * 1000 # in L (for 1 ha)
- PEC_sw_overspray <- rate * 1e6 / water_volume # in µg/L
+ if (as.numeric(mean_water_width) < 0) stop("Undefined geometry")
+ relative_mean_water_width <- mean_water_width / water_width # Always <= 1
+ 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)) {
@@ -88,7 +99,7 @@ PEC_sw_drift <- function(rate,
JKI = pfm::drift_data_JKI[[applications]][dist_index, crop_group_JKI],
RF = drift_percentages_rautmann(distances, applications,
formula = formula,
- crop_group_RF, widths = water_width/100)
+ crop_group_RF, widths = as.numeric(set_units(water_width, "m")))
)
names(drift_percentages) <- paste(dist_index, "m")
} else {
diff --git a/R/PEC_sw_exposit_runoff.R b/R/PEC_sw_exposit.R
index 877dd92..fe23284 100644
--- a/R/PEC_sw_exposit_runoff.R
+++ b/R/PEC_sw_exposit.R
@@ -47,6 +47,11 @@
#' This is a reimplementation of the calculation described in the Exposit 3.02 spreadsheet file,
#' in the worksheet "Konzept Runoff".
#'
+#' It is recommened to specify the arguments `rate`, `Koc`, `DT50`, `t_runoff`, `V_ditch` and `V_event`
+#' using [units::units] from the `units` package.
+#'
+#' @importFrom units as_units set_units drop_units
+#' @importFrom dplyr across mutate
#' @param rate The application rate in g/ha
#' @param interception The fraction intercepted by the crop
#' @param Koc The sorption coefficient to soil organic carbon
@@ -74,43 +79,60 @@
#' @examples
#' PEC_sw_exposit_runoff(500, Koc = 150)
#' PEC_sw_exposit_runoff(600, Koc = 10000, DT50 = 195, exposit = "3.01a")
-PEC_sw_exposit_runoff <- function(rate, interception = 0, Koc, DT50 = Inf, t_runoff = 3,
+PEC_sw_exposit_runoff <- function(rate, interception = 0, Koc, DT50 = set_units(Inf, "d"),
+ t_runoff = set_units(3, "days"),
exposit_reduction_version = c("3.02", "3.01a", "3.01a2", "2.0"),
- V_ditch = 30, V_event = 100, dilution = 2)
+ V_ditch = set_units(30, "m3"), V_event = set_units(100, "m3"), dilution = 2)
{
+ # Set default units if not specified
+ if (!inherits(rate, "units")) rate <- set_units(rate, "g/ha")
+ if (!inherits(Koc, "units")) Koc <- set_units(Koc, "L/kg")
+ if (!inherits(DT50, "units")) DT50 <- set_units(DT50, "d")
+ if (!inherits(t_runoff, "units")) t_runoff <- set_units(t_runoff, "d")
+ if (!inherits(V_ditch, "units")) V_ditch <- set_units(V_ditch, "m3")
+ if (!inherits(V_event, "units")) V_event <- set_units(V_event, "m3")
+
k_deg <- log(2)/DT50
- input <- rate * (1 - interception) * 1 * exp(-k_deg * t_runoff) # assumes 1 ha treated area
+
+ # The input is calculated for an area of 1 ha
+ input <- rate * as_units(1, "ha") * (1 - interception) * exp(as.numeric(-k_deg * t_runoff))
+ input_units <- units(input)
+ input_numeric <- drop_units(input)
if (length(Koc) > 1) stop("Only one compound at a time supported")
exposit_reduction_version <- match.arg(exposit_reduction_version)
- red_water <- pfm::perc_runoff_reduction_exposit[[exposit_reduction_version]]["dissolved"] / 100
- red_bound <- pfm::perc_runoff_reduction_exposit[[exposit_reduction_version]]["bound"] / 100
reduction_runoff <- pfm::perc_runoff_reduction_exposit[[exposit_reduction_version]] / 100
+
transfer_runoff <- 1 - reduction_runoff
- V_runoff <- V_event * (1 - reduction_runoff[["dissolved"]]) # m3
+ V_runoff <- V_event * (1 - reduction_runoff[["dissolved"]])
V_flowing_ditch_runoff <- dilution * (V_ditch + V_runoff)
-
+
f_runoff_exposit <- function(Koc) {
- Koc_breaks <- c(pfm::perc_runoff_exposit$Koc_lower_bound, Inf)
+ Koc_breaks <- c(pfm::perc_runoff_exposit$Koc_lower_bound, set_units(Inf, "L/kg"))
Koc_classes <- as.character(cut(Koc, Koc_breaks, labels = rownames(pfm::perc_runoff_exposit)))
perc_runoff <- pfm::perc_runoff_exposit[Koc_classes, c("dissolved", "bound")]
if (identical(Koc, 0)) perc_runoff <- c(dissolved = 0, bound = 0)
return(unlist(perc_runoff) / 100)
}
f_runoff <- f_runoff_exposit(Koc)
- runoff_dissolved <- input * f_runoff["dissolved"] * transfer_runoff["dissolved"]
- runoff_bound <- input * f_runoff["bound"] * transfer_runoff["bound"]
- runoff_input <- cbind(runoff_dissolved, runoff_bound)
- runoff_input$total <- runoff_input$dissolved + runoff_input$bound
- PEC_sw_runoff <- 1000 * runoff_input / V_flowing_ditch_runoff
+ runoff_dissolved <- input_numeric * f_runoff["dissolved"] * transfer_runoff[, "dissolved"]
+ runoff_bound <- input_numeric * f_runoff["bound"] * transfer_runoff[, "bound"]
+ runoff_input <- cbind(dissolved = runoff_dissolved, bound = runoff_bound,
+ total = runoff_dissolved + runoff_bound)
+ rownames(runoff_input) <- rownames(reduction_runoff)
+ units(runoff_input) <- input_units
+
+ dn <- dimnames(runoff_input)
+ PEC_sw_runoff <- set_units(runoff_input / V_flowing_ditch_runoff, "\u00B5g/L")
+ dimnames(PEC_sw_runoff) <- dn
result <- list(
perc_runoff = 100 * f_runoff,
- runoff = runoff_input,
- PEC_sw_runoff = PEC_sw_runoff)
+ runoff = as.data.frame(runoff_input),
+ PEC_sw_runoff = as.data.frame(PEC_sw_runoff))
return(result)
}
diff --git a/R/PEC_sw_sed.R b/R/PEC_sw_sed.R
index 2865ab7..28e12d8 100644
--- a/R/PEC_sw_sed.R
+++ b/R/PEC_sw_sed.R
@@ -10,24 +10,30 @@
#' @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
+#' @param sediment_density The density of the sediment in kg/L (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
+#' library(pfm)
+#' library(units)
#' PEC_sw_sed(PEC_sw_drift(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,
+ sediment_depth = set_units(5, "cm"),
+ water_depth = set_units(30, "cm"),
+ sediment_density = set_units(1.3, "kg/L"),
PEC_sed_units = c("\u00B5g/kg", "mg/kg"))
{
- method = match.arg(method)
- PEC_sed_units = match.arg(PEC_sed_units)
+ if (!inherits(PEC_sw, "units")) PEC_sw <- set_units(PEC_sw, "\u00B5g/L")
+ if (!inherits(sediment_depth, "units")) PEC_sw <- set_units(sediment_depth, "cm")
+ if (!inherits(water_depth, "units")) PEC_sw <- set_units(water_depth, "cm")
+ if (!inherits(sediment_density, "units")) PEC_sw <- set_units(sediment_density, "cm")
+ 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
+ PEC_sed <- PEC_sw * (percentage/100) * as.numeric((water_depth / sediment_depth)) * (1 / sediment_density)
}
- return(PEC_sed)
+ return(set_units(PEC_sed, PEC_sed_units, mode = "symbolic"))
}

Contact - Imprint