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

Added R6 data structures.

parent ac4ddc93
# 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)
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