Added R6 data structures.

R/data.R

+# Data classes for sourceR models
+
+Data_ = R6::R6Class(
+  'Data',
+  public = list(
+    x = NULL,
+    initialize = function(data, ...)
+    {
+      private$pack(data, ...)
+      private$check()
+      private$sort()
+    }
+  ),
+  private = list(
+    sort = function()
+    {
+      dn = dimnames(self$x)
+      self$x = do.call('[', c(list(self$x), lapply(dn, function(a)
+        gtools::mixedorder(a))))
+    }
+  )
+)
+
+
+Y_ = R6::R6Class('Y',
+                inherit = Data_,
+                private = list(
+                  pack = function(data,
+                                  y,
+                                  type,
+                                  time = NULL,
+                                  location = NULL) {
+                    if (is.null(time)) {
+                      data$time = rep('1', nrow(data))
+                      time = 'time'
+                    }
+                    if (is.null(location)) {
+                      data$location = rep('1', nrow(data))
+                      location = 'location'
+                    }
+                    data = data[, c(y, type, time, location)]
+                    names(data) = c('y', 'type', 'time', 'location')
+                    self$x = tryCatch(
+                      reshape2::acast(data, type ~ time ~ location, value.var = 'y',drop=F),
+                      condition = function(c)
+                        stop(
+                          "Case data must have single observation for each type/time/location combination"
+                        )
+                    )
+                    names(dimnames(self$x)) = names(data)[-1]
+                  },
+                  check = function() {
+                    if (!all(isFiniteInteger(self$x)))
+                      stop('Missing values in case data.  Each type/time/location must have a value.')
+                    if (any(self$x < 0))
+                      stop('Negative value found in data')
+                  }
+                ))
+#' Constructs disease count data
+#'
+#' The Y constructor function returns an R6 Y class
+#' which feeds disease count data into sourceR models.
+#'
+#' @param data long-format data.frame containing source data
+#' @param y character string giving name of disease counts column in data
+#' @param type character string giving name of type column in data
+#' @param time optional column denoting times of disease count observations
+#' @param location optional column denoting location of disease count observations
+#'
+#' @return A Y disease count data structure for use in sourceR models
+#' @export
+Y = function(data, y, type, time = NULL, location = NULL)
+  Y_$new(data, y, type, time = NULL, location = NULL)
+
+
+X_ = R6::R6Class('X',
+                inherit = Data_,
+                private = list(
+                  pack = function(data, x, type, source, time = NULL)
+                  {
+                    if (is.null(time)) {
+                      data$time = rep('1', nrow(data))
+                      time = 'time'
+                    }
+                    data = data[, c(x, type, source, time)]
+                    names(data) = c('x', 'type', 'source', 'time')
+
+                    self$x = tryCatch(
+                      reshape2::acast(data, type ~ source ~ time, value.var = 'x', drop=F),
+                      condition = function(c)
+                        stop(
+                          "Source data must have a single observation for each source/type/time combination."
+                        )
+                    )
+                    names(dimnames(self$x)) = names(data)[-1]
+                  },
+                  check = function()
+                  {
+                    if (!all(isFiniteInteger(self$x)))
+                      stop("Missing value in source data.  Each source/type/time combination must have a value.")
+                    if (any(self$x < 0))
+                      stop("Negative value in source data.")
+                    if (any(apply(self$x, c('type', 'time'), sum) == 0))
+                      stop("Each type must have at least one source case")
+                  }
+                ))
+
+#' Constructs source data
+#'
+#' The X constructor function returns an R6 X class
+#' which feeds source data into sourceR models.
+#'
+#' @param data long-format data.frame containing source data
+#' @param x character string giving name of source counts column in data
+#' @param type character string giving name of type column in data
+#' @param source character string giving name of source column in data
+#' @param time optional column denoting times of source observation
+#'
+#' @return A X source data structure for use in sourceR models
+#' @export
+X = function(data, x, type, source, time = NULL)
+  X_$new(data, x, type, source, time)
+
+
+
+Prev_ = R6::R6Class('Prev',
+                   inherit = Data_,
+                   private = list(
+                     pack = function(data, prev, source, time = NULL)
+                     {
+                       if (is.null(time))
+                         data$time = rep('1', nrow(data))
+                       data[, c(prev, source, time)]
+                       names(data) = c('prev', 'source', 'time')
+
+                       self$x = tryCatch(
+                         acast(data, source ~ time, value.var = 'prev', drop=F),
+                         condition = function(c)
+                           stop('Prevalence must have one value per source/time')
+                       )
+                       names(dimnames(self$x)) = c('source', 'time')
+                       self$x = self$x[order(dimnames(self$x)$source),
+                                       order(dimnames(self$x)$time)]
+                     },
+                     check = function()
+                     {
+                       if (any(!is.finite(self$x)))
+                         stop('Non-finite value in prevalence')
+                       if (any(self$x <= 0 | self$x > 1))
+                         stop('Prevalence is not a probability')
+                     }
+                   ))
+
+#' Constructs prevalence data
+#'
+#' The Prev constructor function returns an R6 Prevalence class
+#' which feeds data into sourceR models.
+#'
+#' @param data long-format data.frame containing prevalence data by
+#'             source and time.
+#' @param prev character string giving name of prevalence column in data
+#' @param source character string giving name of source column in data
+#' @param time optional column denoting times of prevalence observation
+#'
+#' @return A Prev data structure for use in sourceR models
+#' @export
+Prev = function(data, prev, source, time = NULL)
+  Prev_$new(data, prev, source, time)