diff options
Diffstat (limited to 'R')
-rw-r--r-- | R/EFSA_GW_interception_2014.R | 30 | ||||
-rw-r--r-- | R/EFSA_washoff_2017.R | 30 | ||||
-rw-r--r-- | R/PEC_sw_exposit_runoff.R | 52 | ||||
-rw-r--r-- | R/PEC_sw_focus.R | 71 | ||||
-rw-r--r-- | R/drift_data_JKI.R | 49 | ||||
-rw-r--r-- | R/soil_scenario_data_EFSA_2015.R | 24 | ||||
-rw-r--r-- | R/soil_scenario_data_EFSA_2017.R | 6 |
7 files changed, 59 insertions, 203 deletions
diff --git a/R/EFSA_GW_interception_2014.R b/R/EFSA_GW_interception_2014.R index 15d7835..386fddf 100644 --- a/R/EFSA_GW_interception_2014.R +++ b/R/EFSA_GW_interception_2014.R @@ -9,33 +9,5 @@ #' \bold{12}(5):3662, 37 pp., doi:10.2903/j.efsa.2014.3662 #' @format A matrix containing interception values, currently only for some selected crops #' @examples -#' \dontrun{ -#' # This is the code that was used to define the data -#' bbch <- paste0(0:9, "x") -#' crops <- c( -#' "Beans (field + vegetable)", -#' "Peas", -#' "Summer oilseed rape", "Winter oilseed rape", -#' "Tomatoes", -#' "Spring cereals", "Winter cereals") -#' EFSA_GW_interception_2014 <- matrix(NA, length(crops), length(bbch), -#' dimnames = list(Crop = crops, BBCH = bbch)) -#' EFSA_GW_interception_2014["Beans (field + vegetable)", ] <- -#' c(0, 0.25, rep(0.4, 2), rep(0.7, 5), 0.8) -#' EFSA_GW_interception_2014["Peas", ] <- -#' c(0, 0.35, rep(0.55, 2), rep(0.85, 5), 0.85) -#' EFSA_GW_interception_2014["Summer oilseed rape", ] <- -#' c(0, 0.4, rep(0.8, 2), rep(0.8, 5), 0.9) -#' EFSA_GW_interception_2014["Winter oilseed rape", ] <- -#' c(0, 0.4, rep(0.8, 2), rep(0.8, 5), 0.9) -#' EFSA_GW_interception_2014["Tomatoes", ] <- -#' c(0, 0.5, rep(0.7, 2), rep(0.8, 5), 0.5) -#' EFSA_GW_interception_2014["Spring cereals", ] <- -#' c(0, 0, 0.2, 0.8, rep(0.9, 3), rep(0.8, 2), 0.8) -#' EFSA_GW_interception_2014["Winter cereals", ] <- -#' c(0, 0, 0.2, 0.8, rep(0.9, 3), rep(0.8, 2), 0.8) -#' save(EFSA_GW_interception_2014, -#' file = "../data/EFSA_GW_interception_2014.RData") -#' } #' EFSA_GW_interception_2014 -NULL +"EFSA_GW_interception_2014" diff --git a/R/EFSA_washoff_2017.R b/R/EFSA_washoff_2017.R index 450c12e..59e299c 100644 --- a/R/EFSA_washoff_2017.R +++ b/R/EFSA_washoff_2017.R @@ -10,33 +10,5 @@ #' doi:10.2903/j.efsa.2017.4982 #' @format A matrix containing wash-off factors, currently only for some selected crops #' @examples -#' \dontrun{ -#' # This is the code that was used to define the data -#' bbch <- paste0(0:9, "x") -#' crops <- c( -#' "Beans (field + vegetable)", -#' "Peas", -#' "Summer oilseed rape", "Winter oilseed rape", -#' "Tomatoes", -#' "Spring cereals", "Winter cereals") -#' EFSA_washoff_2017 <- matrix(NA, length(crops), length(bbch), -#' dimnames = list(Crop = crops, BBCH = bbch)) -#' EFSA_washoff_2017["Beans (field + vegetable)", ] <- -#' c(NA, 0.6, rep(0.75, 2), rep(0.8, 5), 0.35) -#' EFSA_washoff_2017["Peas", ] <- -#' c(NA, 0.4, rep(0.6, 2), rep(0.65, 5), 0.35) -#' EFSA_washoff_2017["Summer oilseed rape", ] <- -#' c(NA, 0.4, rep(0.5, 2), rep(0.6, 5), 0.5) -#' EFSA_washoff_2017["Winter oilseed rape", ] <- -#' c(NA, 0.1, rep(0.4, 2), rep(0.55, 5), 0.3) -#' EFSA_washoff_2017["Tomatoes", ] <- -#' c(NA, 0.55, rep(0.75, 2), rep(0.7, 5), 0.35) -#' EFSA_washoff_2017["Spring cereals", ] <- -#' c(NA, 0.4, 0.5, 0.5, rep(0.65, 3), rep(0.65, 2), 0.55) -#' EFSA_washoff_2017["Winter cereals", ] <- -#' c(NA, 0.1, 0.4, 0.6, rep(0.55, 3), rep(0.6, 2), 0.4) -#' save(EFSA_washoff_2017, -#' file = "../data/EFSA_washoff_2017.RData") -#' } #' EFSA_washoff_2017 -NULL +"EFSA_washoff_2017" diff --git a/R/PEC_sw_exposit_runoff.R b/R/PEC_sw_exposit_runoff.R index d68a521..8b89cd9 100644 --- a/R/PEC_sw_exposit_runoff.R +++ b/R/PEC_sw_exposit_runoff.R @@ -13,18 +13,11 @@ #' adjacent water body bound to eroding particles} #' } #' @source Excel 3.02 spreadsheet available from -#' \url{https://www.bvl.bund.de/EN/04_PlantProtectionProducts/03_Applicants/04_AuthorisationProcedure/08_Environment/ppp_environment_node.html} -#' @export perc_runoff_exposit +#' \url{https://www.bvl.bund.de/SharedDocs/Downloads/04_Pflanzenschutzmittel/zul_umwelt_exposit.html} +#' @docType data #' @examples #' print(perc_runoff_exposit) -{Koc_breaks <- c(0, 20, 50, 100, 200, 500, 1000, 2000, 5000, 10000, 20000, 50000, Inf) -tmp <- paste(Koc_breaks[1:11], Koc_breaks[2:12], sep = "-") -Koc_classes <- c(tmp[1], paste0(">", tmp[2:11]), ">50000")} -perc_runoff_exposit <- data.frame( - Koc_lower_bound = Koc_breaks[1:12], - dissolved = c(0.11, 0.151, 0.197, 0.248, 0.224, 0.184, 0.133, 0.084, 0.037, 0.031, 0.014, 0.001), - bound = c(0, 0, 0, 0.001, 0.004, 0.020, 0.042, 0.091, 0.159, 0.192, 0.291, 0.451)) -rownames(perc_runoff_exposit) <- Koc_classes +"perc_runoff_exposit" #' Runoff reduction percentages as used in Exposit #' @@ -40,31 +33,14 @@ rownames(perc_runoff_exposit) <- Koc_classes #' \item{bound}{The reduction percentage for the particulate phase} #' } #' @source Excel 3.02 spreadsheet available from -#' \url{https://www.bvl.bund.de/EN/04_PlantProtectionProducts/03_Applicants/04_AuthorisationProcedure/08_Environment/ppp_environment_node.html} +#' \url{https://www.bvl.bund.de/SharedDocs/Downloads/04_Pflanzenschutzmittel/zul_umwelt_exposit.html} #' #' Agroscope version 3.01a with additional runoff factors for 3 m and 6 m buffer zones received from Muris Korkaric (not published). #' The variant 3.01a2 was introduced for consistency with previous calculations performed by Agroscope for a 3 m buffer zone. -#' @export +#' @docType data #' @examples #' print(perc_runoff_reduction_exposit) -perc_runoff_reduction_exposit <- list( - "3.02" = data.frame( - dissolved = c(0, 40, 60, 80), - bound = c(0, 40, 85, 95), - row.names = c("No buffer", paste(c(5, 10, 20), "m"))), - "3.01a" = data.frame( - dissolved = c(0, 25, 40, 45, 60, 80), - bound = c(0, 30, 40, 55, 85, 95), - row.names = c("No buffer", paste(c(3, 5, 6, 10, 20), "m"))), - "3.01a2" = data.frame( - dissolved = c(0, 25), - bound = c(0, 25), - row.names = c("No buffer", paste(c(3), "m"))), - "2.0" = data.frame( - dissolved = c(0, 97.5), - bound = c(0, 97.5), - row.names = c("No buffer", "20 m")) -) +"perc_runoff_reduction_exposit" #' Calculate PEC surface water due to runoff and erosion as in Exposit 3 #' @@ -93,7 +69,7 @@ perc_runoff_reduction_exposit <- list( #' } #' @export #' @source Excel 3.02 spreadsheet available from -#' \url{https://www.bvl.bund.de/DE/04_Pflanzenschutzmittel/03_Antragsteller/04_Zulassungsverfahren/07_Naturhaushalt/psm_naturhaush_node.html#doc1400590bodyText3} +#' \url{https://www.bvl.bund.de/SharedDocs/Downloads/04_Pflanzenschutzmittel/zul_umwelt_exposit.html} #' @seealso \code{\link{perc_runoff_exposit}} for runoff loss percentages and \code{\link{perc_runoff_reduction_exposit}} for runoff reduction percentages used #' @examples #' PEC_sw_exposit_runoff(500, Koc = 150) @@ -108,18 +84,18 @@ PEC_sw_exposit_runoff <- function(rate, interception = 0, Koc, DT50 = Inf, t_run if (length(Koc) > 1) stop("Only one compound at a time supported") exposit_reduction_version <- match.arg(exposit_reduction_version) - red_water <- perc_runoff_reduction_exposit[[exposit_reduction_version]]["dissolved"] / 100 - red_bound <- perc_runoff_reduction_exposit[[exposit_reduction_version]]["bound"] / 100 - reduction_runoff <- perc_runoff_reduction_exposit[[exposit_reduction_version]] / 100 + 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_flowing_ditch_runoff <- dilution * (V_ditch + V_runoff) f_runoff_exposit <- function(Koc) { - Koc_breaks <- c(perc_runoff_exposit$Koc_lower_bound, Inf) - Koc_classes <- as.character(cut(Koc, Koc_breaks, labels = rownames(perc_runoff_exposit))) - perc_runoff <- perc_runoff_exposit[Koc_classes, c("dissolved", "bound")] + Koc_breaks <- c(pfm::perc_runoff_exposit$Koc_lower_bound, Inf) + 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) } @@ -168,7 +144,7 @@ PEC_sw_exposit_runoff <- function(rate, interception = 0, Koc, DT50 = Inf, t_run #' } #' @export #' @source Excel 3.02 spreadsheet available from -#' \url{https://www.bvl.bund.de/DE/04_Pflanzenschutzmittel/03_Antragsteller/04_Zulassungsverfahren/07_Naturhaushalt/psm_naturhaush_node.html#doc1400590bodyText3} +#' \url{https://www.bvl.bund.de/SharedDocs/Downloads/04_Pflanzenschutzmittel/zul_umwelt_exposit.html} #' @seealso \code{\link{perc_runoff_exposit}} for runoff loss percentages and \code{\link{perc_runoff_reduction_exposit}} for runoff reduction percentages used #' @examples #' PEC_sw_exposit_drainage(500, Koc = 150) diff --git a/R/PEC_sw_focus.R b/R/PEC_sw_focus.R index 4d5139e..7bf5094 100644 --- a/R/PEC_sw_focus.R +++ b/R/PEC_sw_focus.R @@ -5,8 +5,8 @@ #' applications should be compared to the corresponding results for a #' single application. At current, this is not done automatically in #' this implementation. Only Step 1 PECs are calculated. However, -#' input files are generated that are suitable as input also for Step 2 -#' to be used with the FOCUS calculator. +#' input files can be generated that are suitable as input for +#' the FOCUS calculator. #' #' @importFrom utils read.table #' @references FOCUS (2014) Generic guidance for Surface Water Scenarios (version 1.4). @@ -56,11 +56,11 @@ #' should be written #' @param overwrite Should an existing file a the location specified in #' \code{txt_file} be overwritten? Only takes effect if append is FALSE. -#' @param append Should the input text file be appended? +#' @param append Should the input text file be appended, if it exists? #' @examples #' # Parent only #' dummy_1 <- chent_focus_sw("Dummy 1", cwsat = 6000, DT50_ws = 6, Koc = 344.8) -#' PEC_sw_focus(dummy_1, 3000, f_drift = 0, overwrite = TRUE, append = FALSE) +#' PEC_sw_focus(dummy_1, 3000, f_drift = 0) #' #' # Metabolite #' new_dummy <- chent_focus_sw("New Dummy", mw = 250, Koc = 100) @@ -77,7 +77,7 @@ PEC_sw_focus <- function(parent, rate, n = 1, i = NA, interception = c("no interception", "minimal crop cover", "average crop cover", "full canopy"), met_form_water = TRUE, - txt_file = "pesticide.txt", overwrite = FALSE, append = TRUE) + txt_file = "pesticide.txt", overwrite = FALSE, append = FALSE) { if (n > 1 & is.na(i)) stop("Please specify the interval i if n > 1") @@ -95,39 +95,38 @@ PEC_sw_focus <- function(parent, rate, n = 1, i = NA, interception = match.arg(interception) - # Write to txt file if requested - header <- c("Active Substance", "Compound", "Comment", - "Mol mass a.i.", "Mol mass met.", - "Water solubility", - "KOC assessed compound", "KOC parent compound", - "DT50", - "Max. in Water", - "Max. in Soil asessed compound", # we reproduce the typo... - "App. Rate", "Number of App.", "Time between app.", "App. Type", - "DT50 soil parent compound", "DT50 soil", - "DT50 water", "DT50 sediment", - "Region / Season", - "Interception class") - add_line <- function(x) { - cat(paste0(x, "\r\n"), file = txt, append = TRUE) - } - if (file.exists(txt_file)) { - if (append) { - txt <- file(txt_file, "a") - } else { - if (overwrite) { - txt <- file(txt_file, "w") - add_line(paste(header, collapse = "\t")) + if (append | overwrite) { + # Write to txt file if requested + header <- c("Active Substance", "Compound", "Comment", + "Mol mass a.i.", "Mol mass met.", + "Water solubility", + "KOC assessed compound", "KOC parent compound", + "DT50", + "Max. in Water", + "Max. in Soil asessed compound", # we reproduce the typo... + "App. Rate", "Number of App.", "Time between app.", "App. Type", + "DT50 soil parent compound", "DT50 soil", + "DT50 water", "DT50 sediment", + "Region / Season", + "Interception class") + add_line <- function(x) { + cat(paste0(x, "\r\n"), file = txt, append = TRUE) + } + if (file.exists(txt_file)) { + if (append) { + txt <- file(txt_file, "a") } else { - stop("The file", txt_file, "already exists, and you did not request", - "appending or overwriting it") + if (overwrite) { + txt <- file(txt_file, "w") + add_line(paste(header, collapse = "\t")) + } } + } else { + txt <- file(txt_file, "w") + add_line(paste(header, collapse = "\t")) } - } else { - txt <- file(txt_file, "w") - add_line(paste(header, collapse = "\t")) + on.exit(close(txt)) } - on.exit(close(txt)) region = match.arg(region) season = match.arg(season) @@ -224,7 +223,9 @@ PEC_sw_focus <- function(parent, rate, n = 1, i = NA, sprintf("%8.2f", x))) } run_line <- paste(c(run_txt, print_numeric(run_numeric)), collapse = "\t") - add_line(run_line) + if (append | overwrite) { + add_line(run_line) + } # Rates for a single application (suffix _s) eq_rate_drift_s = mw_ratio * max_ws * rate diff --git a/R/drift_data_JKI.R b/R/drift_data_JKI.R index 3b02f43..8f78e4d 100644 --- a/R/drift_data_JKI.R +++ b/R/drift_data_JKI.R @@ -29,59 +29,12 @@ #' @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 +#' on 2015-06-11, not present any more 2024-01-31 #' #' Rautmann, D., Streloke, M and Winkler, R (2001) New basic drift values in #' the authorization procedure for plant protection products Mitt. Biol. #' Bundesanst. Land- Forstwirtsch. 383, 133-141 #' @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 frueh", "Obstbau spaet", "Weinbau frueh", "Weinbau spaet", -#' "Hopfenbau", "Flaechenkulturen > 900 l/ha", "Gleisanlagen") -#' names(JKI_crops) <- c("Field crops", "Pome/stone fruit, early", "Pome/stone fruit, late", -#' "Vines early", "Vines late", "Hops", "Areic cultures > 900 L/ha", "Railroad tracks") -#' drift_data_JKI <- list() -#' -#' for (n in 1:8) { -#' drift_data_raw <- read_excel(abdrift_path, sheet = n + 1, skip = 2) -#' drift_data <- matrix(NA, nrow = 9, ncol = length(JKI_crops)) -#' dimnames(drift_data) <- list(distance = drift_data_raw[[1]][1:9], -#' crop = JKI_crops) -#' if (n == 1) { # Values for railroad tracks only present for one application -#' drift_data[, c(1:3, 5:8)] <- as.matrix(drift_data_raw[c(2:7, 11)][1:9, ]) -#' } else { -#' drift_data[, c(1:3, 5:7)] <- as.matrix(drift_data_raw[c(2:7)][1:9, ]) -#' } -#' drift_data_JKI[[n]] <- drift_data -#' } -#' -#' # Manual data entry from the Rautmann paper -#' drift_data_JKI[[1]]["3", "Ackerbau"] <- 0.95 -#' drift_data_JKI[[1]][, "Weinbau frueh"] <- c(NA, 2.7, 1.18, 0.39, 0.2, 0.13, 0.07, 0.04, 0.03) -#' drift_data_JKI[[2]]["3", "Ackerbau"] <- 0.79 -#' drift_data_JKI[[2]][, "Weinbau frueh"] <- c(NA, 2.53, 1.09, 0.35, 0.18, 0.11, 0.06, 0.03, 0.02) -#' drift_data_JKI[[3]]["3", "Ackerbau"] <- 0.68 -#' drift_data_JKI[[3]][, "Weinbau frueh"] <- c(NA, 2.49, 1.04, 0.32, 0.16, 0.10, 0.05, 0.03, 0.02) -#' drift_data_JKI[[4]]["3", "Ackerbau"] <- 0.62 -#' drift_data_JKI[[4]][, "Weinbau frueh"] <- c(NA, 2.44, 1.02, 0.31, 0.16, 0.10, 0.05, 0.03, 0.02) -#' drift_data_JKI[[5]]["3", "Ackerbau"] <- 0.59 -#' drift_data_JKI[[5]][, "Weinbau frueh"] <- c(NA, 2.37, 1.00, 0.31, 0.15, 0.09, 0.05, 0.03, 0.02) -#' drift_data_JKI[[6]]["3", "Ackerbau"] <- 0.56 -#' drift_data_JKI[[6]][, "Weinbau frueh"] <- c(NA, 2.29, 0.97, 0.30, 0.15, 0.09, 0.05, 0.03, 0.02) -#' drift_data_JKI[[7]]["3", "Ackerbau"] <- 0.55 -#' drift_data_JKI[[7]][, "Weinbau frueh"] <- c(NA, 2.24, 0.94, 0.29, 0.15, 0.09, 0.05, 0.03, 0.02) -#' drift_data_JKI[[8]]["3", "Ackerbau"] <- 0.52 -#' drift_data_JKI[[8]][, "Weinbau frueh"] <- c(NA, 2.16, 0.91, 0.28, 0.14, 0.09, 0.04, 0.03, 0.02) -#' -#' # Save the data -#' save(drift_data_JKI, file = "data/drift_data_JKI.RData") -#' } -#' -#' # And these are the resulting data #' drift_data_JKI NULL diff --git a/R/soil_scenario_data_EFSA_2015.R b/R/soil_scenario_data_EFSA_2015.R index 660cafe..0660d40 100644 --- a/R/soil_scenario_data_EFSA_2015.R +++ b/R/soil_scenario_data_EFSA_2015.R @@ -13,28 +13,8 @@ #' EFSA guidance document for predicting environmental concentrations #' of active substances of plant protection products and transformation products of these #' active substances in soil. \emph{EFSA Journal} \bold{13}(4) 4093 -#' doi:10.2903/j.efsa.2015.4093 +#' \doi{10.2903/j.efsa.2015.4093} #' @keywords datasets #' @examples -#' \dontrun{ -#' # This is the code that was used to define the data -#' soil_scenario_data_EFSA_2015 <- data.frame( -#' Zone = rep(c("North", "Central", "South"), 2), -#' Country = c("Estonia", "Germany", "France", "Denmark", "Czech Republik", "Spain"), -#' T_arit = c(4.7, 8.0, 11.0, 8.2, 9.1, 12.8), -#' T_arr = c(7.0, 10.1, 12.3, 9.8, 11.2, 14.7), -#' Texture = c("Coarse", "Coarse", "Medium fine", "Medium", "Medium", "Medium"), -#' f_om = c(0.118, 0.086, 0.048, 0.023, 0.018, 0.011), -#' theta_fc = c(0.244, 0.244, 0.385, 0.347, 0.347, 0.347), -#' rho = c(0.95, 1.05, 1.22, 1.39, 1.43, 1.51), -#' f_sce = c(3, 2, 2, 2, 1.5, 1.5), -#' f_mod = c(2, 2, 2, 4, 4, 4), -#' stringsAsFactors = FALSE, -#' row.names = c("CTN", "CTC", "CTS", "CLN", "CLC", "CLS") -#' ) -#' save(soil_scenario_data_EFSA_2015, file = '../data/soil_scenario_data_EFSA_2015.RData') -#' } -#' -#' # And this is the resulting dataframe #' soil_scenario_data_EFSA_2015 -NULL +"soil_scenario_data_EFSA_2015" diff --git a/R/soil_scenario_data_EFSA_2017.R b/R/soil_scenario_data_EFSA_2017.R index 79ee15f..f7cbea0 100644 --- a/R/soil_scenario_data_EFSA_2017.R +++ b/R/soil_scenario_data_EFSA_2017.R @@ -13,8 +13,10 @@ #' EFSA guidance document for predicting environmental concentrations #' of active substances of plant protection products and transformation products of these #' active substances in soil. \emph{EFSA Journal} \bold{15}(10) 4982 -#' doi:10.2903/j.efsa.2017.4982 +#' \doi{10.2903/j.efsa.2017.4982} #' @keywords datasets #' @examples #' soil_scenario_data_EFSA_2017 -NULL +#' +#' waldo::compare(soil_scenario_data_EFSA_2017, soil_scenario_data_EFSA_2015) +"soil_scenario_data_EFSA_2017" |