aboutsummaryrefslogtreecommitdiff
path: root/inst/data_generation
diff options
context:
space:
mode:
authorRanke Johannes <johannes.ranke@agroscope.admin.ch>2024-01-31 13:16:17 +0100
committerRanke Johannes <johannes.ranke@agroscope.admin.ch>2024-01-31 13:27:50 +0100
commitaed160d7f0eaf5865e2bd9bf6c4b1c9d7b13d911 (patch)
tree7ca136834857c12449f50a1e086a589cc9b79e2e /inst/data_generation
parent64f629efbe666bae56f48a309adf33d1eb09c358 (diff)
Reorganise data generation
- Use inst/data_generation for R code generating data as in some of my other packages - data/*.RData files were checked using https://github.com/jranke/dotfiles/blob/main/bin/rda_diff contents were not changed - Remove ChangeLog, the history is in the git logs - Update docs and some links contained therein - use \doi{} markup - Move logs to log directory
Diffstat (limited to 'inst/data_generation')
-rw-r--r--inst/data_generation/EFSA_GW_interception.R29
-rw-r--r--inst/data_generation/EFSA_washoff_2017.R29
-rw-r--r--inst/data_generation/FOCUS_GW_scenarios_2012.R63
-rw-r--r--inst/data_generation/PEC_sw_exposit.R34
-rw-r--r--inst/data_generation/drift_data_JKI.R47
-rw-r--r--inst/data_generation/drift_parameters_Rautmann.R5
-rw-r--r--inst/data_generation/soil_scenario_data_EFSA.R40
7 files changed, 247 insertions, 0 deletions
diff --git a/inst/data_generation/EFSA_GW_interception.R b/inst/data_generation/EFSA_GW_interception.R
new file mode 100644
index 0000000..353b676
--- /dev/null
+++ b/inst/data_generation/EFSA_GW_interception.R
@@ -0,0 +1,29 @@
+library(here)
+
+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 = here("data/EFSA_GW_interception_2014.RData"))
+
diff --git a/inst/data_generation/EFSA_washoff_2017.R b/inst/data_generation/EFSA_washoff_2017.R
new file mode 100644
index 0000000..cbe43c6
--- /dev/null
+++ b/inst/data_generation/EFSA_washoff_2017.R
@@ -0,0 +1,29 @@
+library(here)
+
+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 = here("data/EFSA_washoff_2017.RData"))
+
diff --git a/inst/data_generation/FOCUS_GW_scenarios_2012.R b/inst/data_generation/FOCUS_GW_scenarios_2012.R
new file mode 100644
index 0000000..1358b8d
--- /dev/null
+++ b/inst/data_generation/FOCUS_GW_scenarios_2012.R
@@ -0,0 +1,63 @@
+library(here)
+
+# FOCUS 2012 p. 46 ff
+FOCUS_GW_scenarios_2012 = list()
+
+n_layers = c(7, 6, 6, 5, 5, 6, 4, 6, 6)
+acronyms = c("Cha", "Ham", "Jok", "Kre", "Oke", "Pia", "Por", "Sev", "Thi")
+FOCUS_GW_scenarios_2012$names = c("Ch\u00e2teadun", "Hamburg", "Jokioinen",
+ "Kremsm\u00fcnster", "Okehampton",
+ "Piacenza", "Porto", "Sevilla", "Thiva")
+
+names(FOCUS_GW_scenarios_2012$names) = acronyms
+FOCUS_GW_scenarios_2012$soils <- data.frame(
+ location= rep(acronyms, times = n_layers),
+ horizon = c("Ap", "B1", "B2", "II C1", "II C1", "II C2", "M",
+ "Ap", "BvI", "BvII", "Bv/Cv", "Cv", "Cv",
+ "Ap", "Bs", "BC1", "BC2", "BC2", "Cg",
+ rep(NA, 5),
+ "A", "Bw1", "BC", "C", "C",
+ "Ap", "Ap", "Bw", "Bw", "2C", "2C",
+ rep(NA, 4),
+ rep(NA, 6),
+ "Ap1", "Ap2", "Bw", "Bw", "Ck1", "Ck1"),
+ number = unlist(sapply(n_layers, function(x) 1:x)),
+ pH_H2O = c(8.0, 8.1, 8.2, 8.5, 8.5, 8.5, 8.3,
+ 6.4, 5.6, 5.6, 5.7, 5.5, 5.5,
+ 6.2, 5.6, 5.4, 5.4, 5.4, 5.3,
+ 7.7, 7.0, 7.1, 7.1, 7.1,
+ 5.8, 6.3, 6.5, 6.6, 6.6,
+ 7, 7, 6.3, 6.3, 6.4, 6.4,
+ 4.9, 4.8, 4.8, 4.8,
+ 7.3, 7.3, 7.8, 8.1, 8.1, 8.2,
+ 7.7, 7.7, 7.8, 7.8, 7.8, 7.8),
+ perc_clay = c(30, 31, 25, 26, 26, 24, 31,
+ 7.2, 6.7, 0.9, 0, 0, 0,
+ 3.6, 1.8, 1.2, 1.7, 1.7, 1.9,
+ 14, 25, 27, 27, 27,
+ 18, 17, 14, 9, 9,
+ 15, 15, 7, 7, 0, 0,
+ 10, 8, 8, 8,
+ 14, 13, 15, 16, 16, 22,
+ 25.3, 25.3, 29.6, 31.9, 32.9, 32.9),
+ perc_oc = c(1.39, 0.93, 0.7, 0.3, 0.3, 0.27, 0.21,
+ 1.5, 1, 0.2, 0, 0, 0,
+ 4.06, 0.84, 0.36, 0.29, 0.29, 0.21,
+ 3.6, 1.0, 0.5, 0.5, 0.5,
+ 2.2, 0.7, 0.4, 0.1, 0.1,
+ 1.26, 1.26, 0.47, 0.47, 0, 0,
+ 1.42, 0.78, 0.78, 0.78,
+ 0.93, 0.93, 0.70, 0.58, 0.58, 0.49,
+ 0.74, 0.74, 0.57, 0.31, 0.18, 0.18),
+ rel_deg = c(1, 0.5, 0.5, 0.3, 0, 0, 0,
+ 1, 0.5, 0.3, 0.3, 0.3, 0,
+ 1, 0.5, 0.3, 0.3, 0, 0,
+ 1, 0.5, 0.5, 0.3, 0,
+ 1, 0.5, 0.3, 0.3, 0,
+ 1, 0.5, 0.5, 0.3, 0.3, 0,
+ 1, 0.5, 0.3, 0,
+ 1, 1, 0.5, 0.3, 0, 0,
+ 1, 0.5, 0.5, 0.3, 0.3, 0))
+
+save(FOCUS_GW_scenarios_2012,
+ file = here("data/FOCUS_GW_scenarios_2012.RData"))
diff --git a/inst/data_generation/PEC_sw_exposit.R b/inst/data_generation/PEC_sw_exposit.R
new file mode 100644
index 0000000..f7d9737
--- /dev/null
+++ b/inst/data_generation/PEC_sw_exposit.R
@@ -0,0 +1,34 @@
+library(here)
+
+# Runoff percentages
+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
+
+# Runoff reduction percentages
+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"))
+)
+
+save(perc_runoff_exposit, perc_runoff_reduction_exposit,
+ file = here("data/perc_runoff.RData"))
diff --git a/inst/data_generation/drift_data_JKI.R b/inst/data_generation/drift_data_JKI.R
new file mode 100644
index 0000000..d28409c
--- /dev/null
+++ b/inst/data_generation/drift_data_JKI.R
@@ -0,0 +1,47 @@
+library(here)
+
+# The following code was in the example code of the help page of the data object up to pfm version 0.6.0
+# It was not executed after migrating it to this directory (inst/data_generation), because
+# the spreadsheet is not available at the JKI website any more.
+library(readxl)
+abdrift_path <- here("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 = here("data/drift_data_JKI.RData"))
diff --git a/inst/data_generation/drift_parameters_Rautmann.R b/inst/data_generation/drift_parameters_Rautmann.R
new file mode 100644
index 0000000..2dea272
--- /dev/null
+++ b/inst/data_generation/drift_parameters_Rautmann.R
@@ -0,0 +1,5 @@
+library(here)
+
+save(drift_parameters_Rautmann,
+ file = "../data/drift_parameters_Rautmann.RData")
+
diff --git a/inst/data_generation/soil_scenario_data_EFSA.R b/inst/data_generation/soil_scenario_data_EFSA.R
new file mode 100644
index 0000000..80b5ce2
--- /dev/null
+++ b/inst/data_generation/soil_scenario_data_EFSA.R
@@ -0,0 +1,40 @@
+library(here)
+
+# Data from 2015
+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 = here('data/soil_scenario_data_EFSA_2015.RData'))
+
+# Data from 2017
+soil_scenario_data_EFSA_2017 <- data.frame(
+ Zone = rep(c("North", "Central", "South"), 2),
+ Country = c("Estonia", "Poland", "France", "Denmark", "Austria", "Spain"),
+ T_arit = c(5.7, 7.4, 10.2, 8.0, 9.3, 15.4),
+ T_arr = c(7.6, 9.3, 11.7, 9.2, 11.3, 16.7),
+ Texture = c("Coarse", "Coarse", "Medium", "Medium", "Medium", "Medium"),
+ f_om = c(0.220, 0.122, 0.070, 0.025, 0.018, 0.010),
+ theta_fc = c(0.244, 0.244, 0.349, 0.349, 0.349, 0.349),
+ rho = c(0.707, 0.934, 1.117, 1.371, 1.432, 1.521),
+ f_sce = rep(c(1.4, 1.6), each = 3),
+ f_mod = rep(c(3, 4), each = 3),
+ FOCUS_zone = c("Hamburg", "Hamburg", "Hamburg", "Hamburg", "Ch\u00e2teaudun", "Sevilla"),
+ prec = c(639, 617, 667, 602, 589, 526),
+ stringsAsFactors = FALSE,
+ row.names = c("CTN", "CTC", "CTS", "CLN", "CLC", "CLS")
+)
+
+save(soil_scenario_data_EFSA_2017,
+ file = here('data/soil_scenario_data_EFSA_2017.RData'))

Contact - Imprint