Improved default values for array dimensions.

R/data.R

@@ -30,13 +30,11 @@ Y_ = R6::R6Class('Y',
                                   type,
                                   time = NULL,
                                   location = NULL) {
-                    if (is.null(time)) {
+                    if (is.null(data$time)) {
                       data$time = rep('1', nrow(data))
-                      time = 'time'
                     }
-                    if (is.null(location)) {
+                    if (is.null(data$location)) {
                       data$location = rep('1', nrow(data))
-                      location = 'location'
                     }
                     data = data[, c(y, type, time, location)]
                     names(data) = c('y', 'type', 'time', 'location')
@@ -72,7 +70,7 @@ Y_ = R6::R6Class('Y',
 #'
 #' @return A Y disease count data structure for use in sourceR models
 #' @export
-Y = function(data, y, type, time = NULL, location = NULL)
+Y = function(data, y = 'y', type = 'type', time = 'time', location = 'location')
   Y_$new(data, y, type, time, location)
 
 
@@ -81,9 +79,8 @@ X_ = R6::R6Class('X',
                 private = list(
                   pack = function(data, x, type, source, time = NULL)
                   {
-                    if (is.null(time)) {
+                    if (is.null(data$time)) {
                       data$time = rep('1', nrow(data))
-                      time = 'time'
                     }
                     data = data[, c(x, type, source, time)]
                     names(data) = c('x', 'type', 'source', 'time')
@@ -123,7 +120,7 @@ X_ = R6::R6Class('X',
 #'
 #' @return A X source data structure for use in sourceR models
 #' @export
-X = function(data, x, type, source, time = NULL)
+X = function(data, x = 'x', type = 'type', source = 'source', time = 'time')
   X_$new(data, x, type, source, time)
 
 
@@ -131,11 +128,10 @@ X = function(data, x, type, source, time = NULL)
 Prev_ = R6::R6Class('Prev',
                    inherit = Data_,
                    private = list(
-                     pack = function(data, prev, source, time = NULL)
+                     pack = function(data, prev, source, time)
                      {
-                       if (is.null(time)) {
+                       if (is.null(data$time)) {
                          data$time = rep('1', nrow(data))
-                         time = 'time'
                        }
                        data = data[, c(prev, source, time)]
                        names(data) = c('prev', 'source', 'time')
@@ -170,5 +166,53 @@ Prev_ = R6::R6Class('Prev',
 #'
 #' @return A Prev data structure for use in sourceR models
 #' @export
-Prev = function(data, prev, source, time = NULL)
+Prev = function(data, prev = 'prev', source = 'source', time = 'time')
   Prev_$new(data, prev, source, time)
+
+#' Alpha prior hyperparameter class
+PriorAlpha_ = R6::R6Class('Alpha',
+                    inherit = Data_,
+                    private = list(
+                      pack = function(data, alpha, source, time, location)
+                      {
+                        if (is.null(data$time)) {
+                          data$time = rep('1', nrow(data))
+                        }
+                        if(is.null(data$location)) {
+                          data$time = rep('1', nrow(data))
+                        }
+                        data = data[, c(alpha, source, time, location)]
+                        names(data) = c('alpha', 'source', 'time', 'location')
+                        data[, c(source, time, location)] = as.character(data[,c(source, time, location)])
+                        self$x = tryCatch(
+                          reshape2::acast(data, source ~ time ~ location, value.var = 'prev', drop=F),
+                          condition = function(c)
+                            stop('Alpha must have one value per source/time/location')
+                        )
+                        names(dimnames(self$x)) = c('source', 'time')
+                      },
+                      check = function()
+                      {
+                        if (any(!is.finite(self$x)))
+                          stop('Non-finite value in alpha')
+                        if (any(self$x <= 0))
+                          stop('Alpha must be strictly positive')
+                      }
+                    ))
+
+#' Constructs alpha prior
+#'
+#' The Alpha constructure function returns an R6 Alpha_
+#' class which feeds sanitised prior or initialisation values for alpha into the model.
+#'
+#' @param data long-format data.frame containing Dirichlet prior hyperparameter, source, time, and location columns
+#' @param alpha name of hyperparameter column
+#' @param source name of source column
+#' @param time name of optional time column
+#' @param location name of optional location column
+#'
+#' @return An Alpha_ data structure for use in sourceR models
+#' @export
+Alpha = function(data, alpha = 'alpha', source = 'source', time = 'time', location = 'location')
+  Alpha_$new(data, alpha, source, time, location)
+