From e25f0194736a090914c10a9f374946c0b89adc5b Mon Sep 17 00:00:00 2001
From: Johannes Ranke <jranke@uni-bremen.de>
Date: Sat, 19 Dec 2020 12:23:08 +0100
Subject: Dimethenamid data, normalisation options

---
 R/dimethenamid_2018.R | 21 +++++++++++++++++++++
 R/f_time_norm_focus.R | 24 +++++++++++++++++-------
 R/mkinds.R            |  3 ++-
 3 files changed, 40 insertions(+), 8 deletions(-)
 create mode 100644 R/dimethenamid_2018.R

(limited to 'R')

diff --git a/R/dimethenamid_2018.R b/R/dimethenamid_2018.R
new file mode 100644
index 00000000..189da618
--- /dev/null
+++ b/R/dimethenamid_2018.R
@@ -0,0 +1,21 @@
+#'  Aerobic soil degradation data on dimethenamid and dimethenamid-P from the EU assessment in 2018
+#'
+#' The datasets were extracted from the active substance evaluation dossier
+#' published by EFSA. Kinetic evaluations shown for these datasets are intended
+#' to illustrate and advance kinetic modelling. The fact that these data and
+#' some results are shown here does not imply a license to use them in the
+#' context of pesticide  registrations, as the use of the data may be
+#' constrained by data protection regulations.
+#'
+#' The R code used to create this data object is installed with this package
+#' in the 'dataset_generation' directory. In the code, page numbers are given for
+#' specific pieces of information in the comments.
+#'
+#' @format An [mkindsg] object grouping eight datasets with some meta information
+#' @source Rapporteur Member State Germany, Co-Rapporteur Member State Bulgaria (2018)
+#'   Renewal Assessment Report Dimethenamid-P Volume 3 - B.8 Environmental fate and behaviour
+#'   Rev. 2 - November 2017
+#'   \url{http://registerofquestions.efsa.europa.eu/roqFrontend/outputLoader?output=ON-5211}
+#' @examples
+#' print(dimethenamid_2018)
+"dimethenamid_2018"
diff --git a/R/f_time_norm_focus.R b/R/f_time_norm_focus.R
index 66df527e..e7c6f22e 100644
--- a/R/f_time_norm_focus.R
+++ b/R/f_time_norm_focus.R
@@ -11,7 +11,9 @@ utils::globalVariables("D24_2014")
 #' @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
+#'   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
@@ -65,7 +67,7 @@ f_time_norm_focus.numeric <- function(object,
 #' @rdname f_time_norm_focus
 #' @export
 f_time_norm_focus.mkindsg <- function(object,
-  study_moisture_ref_source = c("meta", "focus"),
+  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)
@@ -79,11 +81,19 @@ f_time_norm_focus.mkindsg <- function(object,
       meta$field_moisture)
   }
 
-  if (study_moisture_ref_source == "meta") {
-    study_moisture_ref <- meta$study_moisture_ref
+  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 {
-    study_moisture_ref <-
-      focus_soil_moisture[as.matrix(meta[c("usda_soil_type", "study_moisture_ref_type")])]
+    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)) {
@@ -99,5 +109,5 @@ f_time_norm_focus.mkindsg <- function(object,
     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)
+  invisible(object$f_time_norm)
 }
diff --git a/R/mkinds.R b/R/mkinds.R
index 0e970694..df66ab0f 100644
--- a/R/mkinds.R
+++ b/R/mkinds.R
@@ -140,6 +140,7 @@ mkindsg <- R6Class("mkindsg",
       self$f_time_norm <- f_time_norm
 
       if (!missing(meta)) {
+        rownames(meta) <- lapply(ds, function(x) x$title)
         self$meta <- meta
       }
     }
@@ -157,7 +158,7 @@ mkindsg <- R6Class("mkindsg",
 print.mkindsg <- function(x, data = FALSE, verbose = data, ...) {
   cat("<mkindsg> holding", length(x$ds), "mkinds objects\n")
   cat("Title $title: ",  x$title, "\n")
-  cat("Occurrene of observed compounds $observed_n:\n")
+  cat("Occurrence of observed compounds $observed_n:\n")
   print(x$observed_n)
   if (any(x$f_time_norm != 1)) {
     cat("Time normalisation factors $f_time_norm:\n")
-- 
cgit v1.2.1