aboutsummaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorRanke Johannes <johannes.ranke@agroscope.admin.ch>2024-08-13 10:58:16 +0200
committerRanke Johannes <johannes.ranke@agroscope.admin.ch>2024-08-13 11:00:17 +0200
commit396ba6c42252426a132be56b9f417786a1f276e3 (patch)
treedacbad92ab168e0dfc1b70c6f8c7a3af29243d96 /tests
parent870c7f6315e2656fceea28449bdeb5b2a57adf10 (diff)
Support units in drift, runoff und sediment PECs
Diffstat (limited to 'tests')
-rw-r--r--tests/testthat/test_PEC_sed.R4
-rw-r--r--tests/testthat/test_PEC_sw_drift.R20
-rw-r--r--tests/testthat/test_exposit.R27
3 files changed, 36 insertions, 15 deletions
diff --git a/tests/testthat/test_PEC_sed.R b/tests/testthat/test_PEC_sed.R
index 443f789..0681adc 100644
--- a/tests/testthat/test_PEC_sed.R
+++ b/tests/testthat/test_PEC_sed.R
@@ -5,5 +5,7 @@ test_that("PEC_sw_sed calculates correctly using the percentage method", {
# default assumptions of CRD spreadsheet (5 cm sediment depth, 1.3 kg/L sediment density)
# Reference value calculated with CRD spreadsheet
PEC_sw_100_1_m <- PEC_sw_drift(100, distances = 1)
- expect_equivalent(round(PEC_sw_sed(PEC_sw_100_1_m, percentage = 50), 3), 2.131)
+ expect_equivalent(
+ round(PEC_sw_sed(PEC_sw_100_1_m, percentage = 50), 3),
+ set_units(2.131, "µg/kg"))
})
diff --git a/tests/testthat/test_PEC_sw_drift.R b/tests/testthat/test_PEC_sw_drift.R
index a0972eb..6177aef 100644
--- a/tests/testthat/test_PEC_sw_drift.R
+++ b/tests/testthat/test_PEC_sw_drift.R
@@ -1,22 +1,32 @@
library(pfm)
+library(testthat)
+library(units)
context("Simple PEC surface water calculations with drift entry")
test_that("PEC_sw_drift gives the same results as the CRD PEC calculator", {
# One application of 30 g/ha to field crops calculated with UK PEC calculator published by CRD
- expect_equal(round(PEC_sw_drift(30), 3),
- c('1 m' = 0.277, '5 m' = 0.057, '10 m' = 0.029, '20 m' = 0.015))
+ expect_equal(
+ round(PEC_sw_drift(30), 3),
+ set_units(c('1 m' = 0.277, '5 m' = 0.057, '10 m' = 0.029, '20 m' = 0.015), "\u00B5g/L"))
# 7 applications of 30 g/ha to field crops calculated with UK PEC calculator, initial PEC
- expect_equal(round(PEC_sw_drift(30, 7), 3),
- c('1 m' = 0.161, '5 m' = 0.033, '10 m' = 0.017, '20 m' = 0.008))
+ expect_equal(
+ round(PEC_sw_drift(30, 7), 3),
+ set_units(c('1 m' = 0.161, '5 m' = 0.033, '10 m' = 0.017, '20 m' = 0.008), "\u00B5g/L"))
# 4 applications of 30 g/ha to late fruit crops calculated with UK PEC
# calculator published by CRD. CRD uses different drift values from SANCO aquatic
# guidance), except for 50 m
pfm_30_4_obst_spaet <- round(PEC_sw_drift(30, 4, crop_group_JKI = "Obstbau spaet",
distances = c(3, 20, 50)), 3)
- crd_30_4_obst_spaet <- c('3 m' = 1.101, '20 m' = 0.080, '50 m' = 0.013)
+ crd_30_4_obst_spaet <- set_units(c('3 m' = 1.101, '20 m' = 0.080, '50 m' = 0.013), "µg/L")
expect_equal(pfm_30_4_obst_spaet[3], crd_30_4_obst_spaet[3])
+
+ # Synops scenario with 45 m angle. Mean width is 100 cm - (2 * 15 cm).
+ expect_equal(
+ PEC_sw_drift(100) * 100/70,
+ PEC_sw_drift(100, side_angle = 45)
+ )
})
test_that("The Rautmann formula is correctly implemented", {
diff --git a/tests/testthat/test_exposit.R b/tests/testthat/test_exposit.R
index 13371a6..44337bd 100644
--- a/tests/testthat/test_exposit.R
+++ b/tests/testthat/test_exposit.R
@@ -1,4 +1,7 @@
library(pfm)
+library(units)
+library(dplyr)
+
context("Exposit calculations")
# Expected results are from the Exposit 3.02, downloaded 2019-02-15
@@ -8,12 +11,14 @@ test_that("Runoff PECsw are as in Exposit 3.02", {
runoff = c(183.62, 110.17, 73.45, 36.72),
erosion = c(19.96, 11.98, 2.99, 1.00),
PEC_dissolved = c(0.71, 0.61, 0.52, 0.37),
- PEC_total = c(0.78, 0.68, 0.55, 0.38))
+ PEC_total = c(0.78, 0.68, 0.55, 0.38)) |>
+ mutate(across(c(runoff, erosion), ~ set_units(., "mg"))) |>
+ mutate(across(starts_with("PEC_"), ~ set_units(., "\u00B5g/L")))
res_1 <- PEC_sw_exposit_runoff(100, Koc = 1000, DT50 = 1000)
res_pfm_1 <- data.frame(
- runoff = round(1000 * res_1$runoff["dissolved"], 2),
- erosion = round(1000 * res_1$runoff["bound"], 2),
+ runoff = round(set_units(res_1$runoff[["dissolved"]], "mg"), 2),
+ erosion = round(set_units(res_1$runoff[["bound"]], "mg"), 2),
PEC_dissolved = round(res_1$PEC_sw_runoff, 2)["dissolved"],
PEC_total = round(res_1$PEC_sw_runoff["dissolved"] + res_1$PEC_sw_runoff["bound"], 2))
expect_equivalent(res_exposit_1, res_pfm_1)
@@ -23,12 +28,14 @@ test_that("Runoff PECsw are as in Exposit 3.02", {
runoff = c(0.08, 0.05, 0.03, 0.02),
erosion = c(36.63, 21.98, 5.49, 1.83),
PEC_dissolved = c(0, 0, 0, 0),
- PEC_total = c(0.14, 0.12, 0.04, 0.02))
+ PEC_total = c(0.14, 0.12, 0.04, 0.02)) |>
+ mutate(across(c(runoff, erosion), ~ set_units(., "mg"))) |>
+ mutate(across(starts_with("PEC_"), ~ set_units(., "\u00B5g/L")))
res_2 <- PEC_sw_exposit_runoff(10, Koc = 300000, DT50 = 10)
res_pfm_2 <- data.frame(
- runoff = round(1000 * res_2$runoff["dissolved"], 2),
- erosion = round(1000 * res_2$runoff["bound"], 2),
+ runoff = round(set_units(res_2$runoff[["dissolved"]], "mg"), 2),
+ erosion = round(set_units(res_2$runoff[["bound"]], "mg"), 2),
PEC_dissolved = round(res_2$PEC_sw_runoff, 2)["dissolved"],
PEC_total = round(res_2$PEC_sw_runoff["dissolved"] + res_2$PEC_sw_runoff["bound"], 2))
@@ -39,12 +46,14 @@ test_that("Runoff PECsw are as in Exposit 3.02", {
runoff = c(295.78, 177.47, 118.31, 59.16),
erosion = rep(0.00, 4),
PEC_dissolved = c(1.14, 0.99, 0.85, 0.59),
- PEC_total = c(1.14, 0.99, 0.85, 0.59))
+ PEC_total = c(1.14, 0.99, 0.85, 0.59)) |>
+ mutate(across(c(runoff, erosion), ~ set_units(., "mg"))) |>
+ mutate(across(starts_with("PEC_"), ~ set_units(., "\u00B5g/L")))
res_3 <- PEC_sw_exposit_runoff(200, Koc = 30, DT50 = 100)
res_pfm_3 <- data.frame(
- runoff = round(1000 * res_3$runoff["dissolved"], 2),
- erosion = round(1000 * res_3$runoff["bound"], 2),
+ runoff = round(set_units(res_3$runoff[["dissolved"]], "mg"), 2),
+ erosion = round(set_units(res_3$runoff[["bound"]], "mg"), 2),
PEC_dissolved = round(res_3$PEC_sw_runoff, 2)["dissolved"],
PEC_total = round(res_3$PEC_sw_runoff["dissolved"] + res_3$PEC_sw_runoff["bound"], 2))

Contact - Imprint