From 572e435b2394ef7092a78d0eebbbeda88b66a0a8 Mon Sep 17 00:00:00 2001 From: Johannes Ranke Date: Fri, 13 Nov 2020 16:32:18 +0100 Subject: Fixes for f_time_norm_focus, still very fragile... --- R/f_time_norm_focus.R | 50 ++++++++++++++++++++++++++++--------- R/focus_soil_moisture.R | 3 +++ data/D24_2014.rda | Bin 5836 -> 5805 bytes inst/dataset_generation/D24_2014.R | 14 ++++++----- 4 files changed, 49 insertions(+), 18 deletions(-) diff --git a/R/f_time_norm_focus.R b/R/f_time_norm_focus.R index be5cf583..66df527e 100644 --- a/R/f_time_norm_focus.R +++ b/R/f_time_norm_focus.R @@ -10,6 +10,8 @@ utils::globalVariables("D24_2014") #' @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 #' @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 @@ -28,15 +30,12 @@ utils::globalVariables("D24_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 p. 184 +#' 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, f_na = 1) -#' # Moisture normalisation for the other four soils is one, as soil moisture -#' # is higher than the approximate field capacity derived from the USDA soil -#' # type +#' # 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") @@ -44,9 +43,9 @@ f_time_norm_focus <- function(object, ...) { #' @rdname f_time_norm_focus #' @export -f_time_norm_focus.numeric <- function(object, - moisture = NA, field_moisture = NA, - temperature = object, +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), @@ -65,13 +64,40 @@ f_time_norm_focus.numeric <- function(object, #' @rdname f_time_norm_focus #' @export -f_time_norm_focus.mkindsg <- function(object, Q10 = 2.58, walker = 0.7, f_na = NA, ...) { +f_time_norm_focus.mkindsg <- function(object, + study_moisture_ref_source = c("meta", "focus"), + Q10 = 2.58, walker = 0.7, f_na = NA, ...) { + + study_moisture_ref_source <- match.arg(study_moisture_ref_source) meta <- object$meta - field_moisture <- focus_soil_moisture[meta$usda_soil_type, "pF2"] - study_moisture <- meta$rel_moisture * meta$moisture_ref + + 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) + } + + if (study_moisture_ref_source == "meta") { + study_moisture_ref <- meta$study_moisture_ref + } else { + study_moisture_ref <- + focus_soil_moisture[as.matrix(meta[c("usda_soil_type", "study_moisture_ref_type")])] + } + + 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) cat("$time_norm was set to\n") print(object$f_time_norm) + return(object$f_time_norm) } diff --git a/R/focus_soil_moisture.R b/R/focus_soil_moisture.R index 7b22fbcc..ef67aec2 100644 --- a/R/focus_soil_moisture.R +++ b/R/focus_soil_moisture.R @@ -2,6 +2,9 @@ utils::globalVariables("focus_soil_moisture") #' FOCUS default values for soil moisture contents at field capacity, MWHC and 1/3 bar #' +#' The value were transcribed from p. 36. The table assumes field capacity +#' corresponds to pF2, MWHC to pF 1 and 1/3 bar to pF 2.5. +#' #' @format A matrix with upper case USDA soil classes as row names, and water tension #' ('pF1', 'pF2', 'pF 2.5') as column names #' @source Anonymous (2014) Generic Guidance for Tier 1 FOCUS Ground Water Assessment diff --git a/data/D24_2014.rda b/data/D24_2014.rda index 5777ca89..ef796e4d 100644 Binary files a/data/D24_2014.rda and b/data/D24_2014.rda differ diff --git a/inst/dataset_generation/D24_2014.R b/inst/dataset_generation/D24_2014.R index 47f9cfab..435be4a6 100644 --- a/inst/dataset_generation/D24_2014.R +++ b/inst/dataset_generation/D24_2014.R @@ -1,5 +1,8 @@ # From the Addendum to the RAR 2014, see the help file for D24_2014 -# Soil characterisation from EFSA conclusion 2014 +# Soil characterisation in the EFSA conclusion 2014 is completely different +# and does not correspond to the USDA soil types that can be derived +# from the texture data on p. 687 +library(mkin) D24_2014 <- mkindsg$new( title = "Aerobic soil degradation data on 2,4-D from the EU assessment in 2014", ds = list( @@ -60,12 +63,11 @@ D24_2014 <- mkindsg$new( ), meta = data.frame( study = c("Cohen 1991", rep("Liu and Adelfinskaya 2011", 4)), - usda_soil_type = c("Silt loam", # p. 683, EFSA conclusion p. 41/42 - "Clay loam", "Clay loam", "Sandy loam", "Sandy loam"), - moisture_ref_type = c(NA, rep("% MWHC", 4)), # p. 687 + usda_soil_type = c("Silt loam", # p. 683, 687 + "Silt loam", "Loam", "Loam", "Loamy sand"), + study_moisture_ref_type = c(NA, rep("pF1", 4)), # p. 687 rel_moisture = c(NA, 0.5, 0.5, 0.5, 0.5), # p. 687 - moisture_ref = c(NA, 65.7, 59.9, 75.3, 48.5), # p. 687 temperature = c(25, 20, 20, 20, 20) ) ) -#save(D24_2014, file = "../../data/D24_2014.rda", version = 2) +save(D24_2014, file = "../../data/D24_2014.rda", version = 2) -- cgit v1.2.1