-
Notifications
You must be signed in to change notification settings - Fork 4
/
f_time_norm_focus.R
112 lines (103 loc) · 4.22 KB
/
f_time_norm_focus.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
utils::globalVariables("D24_2014")
#' Normalisation factors for aerobic soil degradation according to FOCUS guidance
#'
#' Time step normalisation factors for aerobic soil degradation as described
#' in Appendix 8 to the FOCUS kinetics guidance (FOCUS 2014, p. 369).
#'
#' @param object An object containing information used for the calculations
#' @param temperature Numeric vector of temperatures in °C
#' @param moisture Numeric vector of moisture contents in \\% w/w
#' @param field_moisture Numeric vector of moisture contents at field capacity
#' (pF2) in \\% w/w
#' @param study_moisture_ref_source Source for the reference value
#' used to calculate the study moisture. If 'auto', preference is given
#' to a reference moisture given in the meta information, otherwise
#' the focus soil moisture for the soil class is used
#' @param Q10 The Q10 value used for temperature normalisation
#' @param walker The Walker exponent used for moisture normalisation
#' @param f_na The factor to use for NA values. If set to NA, only factors
#' for complete cases will be returned.
#' @param \dots Currently not used
#' @references
#' FOCUS (2006) \dQuote{Guidance Document on Estimating Persistence
#' and Degradation Kinetics from Environmental Fate Studies on Pesticides in
#' EU Registration} Report of the FOCUS Work Group on Degradation Kinetics,
#' EC Document Reference Sanco/10058/2005 version 2.0, 434 pp,
#' \url{http://esdac.jrc.ec.europa.eu/projects/degradation-kinetics}
#' FOCUS (2014) \dQuote{Generic guidance for Estimating Persistence
#' and Degradation Kinetics from Environmental Fate Studies on Pesticides in
#' EU Registration} Report of the FOCUS Work Group on Degradation Kinetics,
#' Version 1.1, 18 December 2014
#' \url{http://esdac.jrc.ec.europa.eu/projects/degradation-kinetics}
#' @seealso [focus_soil_moisture]
#' @examples
#' f_time_norm_focus(25, 20, 25) # 1.37, compare FOCUS 2014 p. 184
#'
#' D24_2014$meta
#' # No moisture normalisation in the first dataset, so we use f_na = 1 to get
#' # temperature only normalisation as in the EU evaluation
#' f_time_norm_focus(D24_2014, study_moisture_ref_source = "focus", f_na = 1)
#' @export
f_time_norm_focus <- function(object, ...) {
UseMethod("f_time_norm_focus")
}
#' @rdname f_time_norm_focus
#' @export
f_time_norm_focus.numeric <- function(object,
moisture = NA, field_moisture = NA,
temperature = object,
Q10 = 2.58, walker = 0.7, f_na = NA, ...)
{
f_temp <- ifelse(is.na(temperature),
f_na,
ifelse(temperature <= 0,
0,
Q10^((temperature - 20)/10)))
f_moist <- ifelse(is.na(moisture),
f_na,
ifelse(moisture >= field_moisture,
1,
(moisture / field_moisture)^walker))
f_time_norm <- f_temp * f_moist
f_time_norm
}
#' @rdname f_time_norm_focus
#' @export
f_time_norm_focus.mkindsg <- function(object,
study_moisture_ref_source = c("auto", "meta", "focus"),
Q10 = 2.58, walker = 0.7, f_na = NA, ...) {
study_moisture_ref_source <- match.arg(study_moisture_ref_source)
meta <- object$meta
if (is.null(meta$field_moisture)) {
field_moisture <- focus_soil_moisture[meta$usda_soil_type, "pF2"]
} else {
field_moisture <- ifelse(is.na(meta$field_moisture),
focus_soil_moisture[meta$usda_soil_type, "pF2"],
meta$field_moisture)
}
study_moisture_ref_focus <-
focus_soil_moisture[as.matrix(meta[c("usda_soil_type", "study_moisture_ref_type")])]
if (study_moisture_ref_source == "auto") {
study_moisture_ref <- ifelse (is.na(meta$study_ref_moisture),
study_moisture_ref_focus,
meta$study_ref_moisture)
} else {
if (study_moisture_ref_source == "meta") {
study_moisture_ref <- meta$study_moisture_ref
} else {
study_moisture_ref <- study_moisture_ref_focus
}
}
if ("study_moisture" %in% names(meta)) {
study_moisture <- ifelse(is.na(meta$study_moisture),
meta$rel_moisture * study_moisture_ref,
meta$study_moisture)
} else {
study_moisture <- meta$rel_moisture * study_moisture_ref
}
object$f_time_norm <- f_time_norm_focus(meta$temperature,
moisture = study_moisture, field_moisture = field_moisture,
Q10 = Q10, walker = walker, f_na = f_na)
message("$f_time_norm was (re)set to normalised values")
invisible(object$f_time_norm)
}