jranke / mkin
1
#' A dataset class for mkin
2
#'
3
#' @description
4
#' At the moment this dataset class is hardly used in mkin. For example,
5
#' mkinfit does not take mkinds datasets as argument, but works with dataframes
6
#' such as the on contained in the data field of mkinds objects. Some datasets
7
#' provided by this package come as mkinds objects nevertheless.
8
#'
9
#' @importFrom R6 R6Class
10
#' @examples
11
#'
12
#' mds <- mkinds$new("FOCUS A", FOCUS_2006_A)
13
#' print(mds)
14
#'
15
#' @export
16
mkinds <- R6Class("mkinds",
17
  public = list(
18

19
    #' @field title A full title for the dataset
20
    title = NULL,
21

22
    #' @field sampling_times The sampling times
23
    sampling_times = NULL,
24

25
    #' @field time_unit The time unit
26
    time_unit = NULL,
27

28
    #' @field observed Names of the observed variables
29
    observed = NULL,
30

31
    #' @field unit The unit of the observations
32
    unit = NULL,
33

34
    #' @field replicates The maximum number of replicates per sampling time
35
    replicates = NULL,
36

37
    #' @field data A data frame with at least the columns name, time
38
    #' and value in order to be compatible with mkinfit
39
    data = NULL,
40

41
    #' @description
42
    #' Create a new mkinds object
43
    #' @param title The dataset title
44
    #' @param data The data
45
    #' @param time_unit The time unit
46
    #' @param unit The unit of the observations
47
    initialize = function(title = "", data, time_unit = NA, unit = NA) {
48

49 1
      self$title <- title
50 1
      self$sampling_times <- sort(unique(data$time))
51 1
      self$time_unit <- time_unit
52 1
      self$observed <- unique(data$name)
53 1
      self$unit <- unit
54 1
      self$replicates <- max(by(data, list(data$name, data$time), nrow))
55 1
      if (is.null(data$override)) data$override <- NA
56 1
      if (is.null(data$err)) data$err <- 1
57 1
      self$data <- data
58

59
    }
60
  )
61
)
62

63
#' Print mkinds objects
64
#'
65
#' @rdname mkinds
66
#' @param x An [mkinds] object.
67
#' @param data Should the data be printed?
68
#' @param \dots Not used.
69
#' @export
70
print.mkinds <- function(x, data = FALSE, ...) {
71 1
  cat("<mkinds> with $title: ",  x$title, "\n")
72 1
  cat("Observed compounds $observed: ", paste(x$observed, collapse = ", "), "\n")
73 1
  cat("Sampling times $sampling_times:\n")
74 1
  cat(paste(x$sampling_times, collapse = ", "), "\n")
75 1
  cat("With a maximum of ", x$replicates, " replicates\n")
76 1
  if (!is.na(x$time_unit)) cat("Time unit: ", x$time_unit, "\n")
77 1
  if (!is.na(x$unit)) cat("Observation unit: ", x$unit, "\n")
78 0
  if (data) print(mkin_long_to_wide(x$data))
79
}
80

81
#' A class for dataset groups for mkin
82
#'
83
#' @description
84
#' A container for working with datasets that share at least one compound,
85
#' so that combined evaluations are desirable.
86
#'
87
#' Time normalisation factors are initialised with a value of 1 for each
88
#' dataset if no data are supplied.
89
#'
90
#' @examples
91
#'
92
#' mdsg <- mkindsg$new("Experimental X", experimental_data_for_UBA_2019[6:10])
93
#' print(mdsg)
94
#' print(mdsg, verbose = TRUE)
95
#' print(mdsg, verbose = TRUE, data = TRUE)
96
#'
97
#' @export
98
mkindsg <- R6Class("mkindsg",
99
  public = list(
100

101
    #' @field title A title for the dataset group
102
    title = NULL,
103

104
    #' @field ds A list of mkinds objects
105
    ds = NULL,
106

107
    #' @field observed_n Occurrence counts of compounds in datasets
108
    observed_n = NULL,
109

110
    #' @field f_time_norm Time normalisation factors
111
    f_time_norm = NULL,
112

113
    #' @field meta A data frame with a row for each dataset,
114
    #'   containing additional information in the form
115
    #'   of categorical data (factors) or numerical data
116
    #'   (e.g. temperature, moisture,
117
    #'   or covariates like soil pH).
118
    meta = NULL,
119

120
    #' @description
121
    #' Create a new mkindsg object
122
    #' @param title The title
123
    #' @param ds A list of mkinds objects
124
    #' @param f_time_norm Time normalisation factors
125
    #' @param meta The meta data
126
    initialize = function(title = "", ds,
127
      f_time_norm = rep(1, length(ds)), meta)
128
    {
129 1
      self$title <- title
130 1
      if (all(sapply(ds, inherits, "mkinds"))) {
131 1
        self$ds <- ds
132
      } else {
133 0
        stop("Please supply a list of mkinds objects")
134
      }
135

136 1
      all_observed <- unlist(lapply(ds, function(x) x$observed))
137 1
      observed <- factor(all_observed, levels = unique(all_observed))
138 1
      self$observed_n <- table(observed)
139 1
      names(dimnames(self$observed_n)) <- NULL
140 1
      self$f_time_norm <- f_time_norm
141

142 1
      if (!missing(meta)) {
143 0
        rownames(meta) <- lapply(ds, function(x) x$title)
144 0
        self$meta <- meta
145
      }
146
    }
147
  )
148
)
149

150
#' Print mkindsg objects
151
#'
152
#' @rdname mkindsg
153
#' @param x An [mkindsg] object.
154
#' @param verbose Should the mkinds objects be printed?
155
#' @param data Should the mkinds objects be printed with their data?
156
#' @param \dots Not used.
157
#' @export
158
print.mkindsg <- function(x, data = FALSE, verbose = data, ...) {
159 1
  cat("<mkindsg> holding", length(x$ds), "mkinds objects\n")
160 1
  cat("Title $title: ",  x$title, "\n")
161 1
  cat("Occurrence of observed compounds $observed_n:\n")
162 1
  print(x$observed_n)
163 1
  if (any(x$f_time_norm != 1)) {
164 0
    cat("Time normalisation factors $f_time_norm:\n")
165 0
    print(x$f_time_norm)
166
  }
167 1
  if (!is.null(x$meta)) {
168 0
    cat("Meta information $meta:\n")
169 0
    print(x$meta)
170
  }
171 1
  if (verbose) {
172 0
    cat("\nDatasets $ds:")
173 0
    for (ds in x$ds) {
174 0
      cat("\n")
175 0
      print(ds, data = data)
176
    }
177
  }
178
}

Read our documentation on viewing source code .

Loading