Commit e24a727d authored by Chris Jewell's avatar Chris Jewell
Browse files

Improved default values for array dimensions.

parent f8db8097
......@@ -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)
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment