From 7b807680b66269ff911df137f56e26775d84e283 Mon Sep 17 00:00:00 2001
From: Johannes Ranke <jranke@uni-bremen.de>
Date: Thu, 12 Nov 2020 11:04:45 +0100
Subject: mkindsg class to hold groups of datasets

- D24_2014 dataset on aerobic soil degradation of 2,4-D from the EU
  assessment as mkindsg object with metadata
- f_time_norm_focus() to do time-step normalisation using the FOCUS
  method
- focus_soil_moisture data with default moisture contents at pF1,
  pF 2 and pF 2.5 for USDA soil types from FOCUS GW guidance
- Dataset generation scripts in inst/dataset_generation
- Depend on R >= 2.15.1 in order to facilitate the use of
  utils::globalVariables()
---
 R/mkinds.R | 117 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++-----
 1 file changed, 109 insertions(+), 8 deletions(-)

(limited to 'R/mkinds.R')

diff --git a/R/mkinds.R b/R/mkinds.R
index d6f296bf..0e970694 100644
--- a/R/mkinds.R
+++ b/R/mkinds.R
@@ -1,5 +1,5 @@
 #' A dataset class for mkin
-#' 
+#'
 #' @description
 #' At the moment this dataset class is hardly used in mkin. For example,
 #' mkinfit does not take mkinds datasets as argument, but works with dataframes
@@ -7,12 +7,11 @@
 #' provided by this package come as mkinds objects nevertheless.
 #'
 #' @importFrom R6 R6Class
-#' @seealso The S3 printing method \code{\link{print.mkinds}}
 #' @examples
-#' 
+#'
 #' mds <- mkinds$new("FOCUS A", FOCUS_2006_A)
 #' print(mds)
-#' 
+#'
 #' @export
 mkinds <- R6Class("mkinds",
   public = list(
@@ -62,15 +61,117 @@ mkinds <- R6Class("mkinds",
 )
 
 #' Print mkinds objects
-#' 
-#' @param x An \code{\link{mkinds}} object.
+#'
+#' @rdname mkinds
+#' @param x An [mkinds] object.
+#' @param data Should the data be printed?
 #' @param \dots Not used.
 #' @export
-print.mkinds <- function(x, ...) {
+print.mkinds <- function(x, data = FALSE, ...) {
   cat("<mkinds> with $title: ",  x$title, "\n")
   cat("Observed compounds $observed: ", paste(x$observed, collapse = ", "), "\n")
-  cat("Sampling times $sampling_times: ", paste(x$sampling_times, collapse = ", "), "\n")
+  cat("Sampling times $sampling_times:\n")
+  cat(paste(x$sampling_times, collapse = ", "), "\n")
   cat("With a maximum of ", x$replicates, " replicates\n")
   if (!is.na(x$time_unit)) cat("Time unit: ", x$time_unit, "\n")
   if (!is.na(x$unit)) cat("Observation unit: ", x$unit, "\n")
+  if (data) print(mkin_long_to_wide(x$data))
+}
+
+#' A class for dataset groups for mkin
+#'
+#' @description
+#' A container for working with datasets that share at least one compound,
+#' so that combined evaluations are desirable.
+#'
+#' Time normalisation factors are initialised with a value of 1 for each
+#' dataset if no data are supplied.
+#'
+#' @examples
+#'
+#' mdsg <- mkindsg$new("Experimental X", experimental_data_for_UBA_2019[6:10])
+#' print(mdsg)
+#' print(mdsg, verbose = TRUE)
+#' print(mdsg, verbose = TRUE, data = TRUE)
+#'
+#' @export
+mkindsg <- R6Class("mkindsg",
+  public = list(
+
+    #' @field title A title for the dataset group
+    title = NULL,
+
+    #' @field ds A list of mkinds objects
+    ds = NULL,
+
+    #' @field observed_n Occurrence counts of compounds in datasets
+    observed_n = NULL,
+
+    #' @field f_time_norm Time normalisation factors
+    f_time_norm = NULL,
+
+    #' @field meta A data frame with a row for each dataset,
+    #'   containing additional information in the form
+    #'   of categorical data (factors) or numerical data
+    #'   (e.g. temperature, moisture,
+    #'   or covariates like soil pH).
+    meta = NULL,
+
+    #' @description
+    #' Create a new mkindsg object
+    #' @param title The title
+    #' @param ds A list of mkinds objects
+    #' @param f_time_norm Time normalisation factors
+    #' @param meta The meta data
+    initialize = function(title = "", ds,
+      f_time_norm = rep(1, length(ds)), meta)
+    {
+      self$title <- title
+      if (all(sapply(ds, inherits, "mkinds"))) {
+        self$ds <- ds
+      } else {
+        stop("Please supply a list of mkinds objects")
+      }
+
+      all_observed <- unlist(lapply(ds, function(x) x$observed))
+      observed <- factor(all_observed, levels = unique(all_observed))
+      self$observed_n <- table(observed)
+      names(dimnames(self$observed_n)) <- NULL
+      self$f_time_norm <- f_time_norm
+
+      if (!missing(meta)) {
+        self$meta <- meta
+      }
+    }
+  )
+)
+
+#' Print mkindsg objects
+#'
+#' @rdname mkindsg
+#' @param x An [mkindsg] object.
+#' @param verbose Should the mkinds objects be printed?
+#' @param data Should the mkinds objects be printed with their data?
+#' @param \dots Not used.
+#' @export
+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")
+  print(x$observed_n)
+  if (any(x$f_time_norm != 1)) {
+    cat("Time normalisation factors $f_time_norm:\n")
+    print(x$f_time_norm)
+  }
+  if (!is.null(x$meta)) {
+    cat("Meta information $meta:\n")
+    print(x$meta)
+  }
+  if (verbose) {
+    cat("\nDatasets $ds:")
+    for (ds in x$ds) {
+      cat("\n")
+      print(ds, data = data)
+    }
+  }
 }
-- 
cgit v1.2.1