#' A class for data ready to model
#'
#' \code{shape()} generates objects of class \code{dgirtIn} for modeling with
#' \code{dgirt()} and \code{dgmrp()}.
#'
#' @aliases dgirtin-class, get_item_n, get_item_names, get_n, dgirtIn-method,
#' print.dgirtIn,
#' @name dgirtin-class
#' @include constants.r
#' @import R6
#' @examples
#' data(toy_dgirt_in)
#' get_item_names(toy_dgirt_in)
#' get_n(toy_dgirt_in)
#' get_n(toy_dgirt_in, by = "year")
#' get_n(toy_dgirt_in, by = "source")
#' get_item_n(toy_dgirt_in)
#' get_item_n(toy_dgirt_in, by = "year")
NULL
setOldClass("dgirtIn", "R6")
dgirtIn <- R6::R6Class("dgirtIn",
public = c(
# model objects (N, G, T, ...) and shape objects (item_data, etc.) are
# public and initially NULL
setNames(lapply(c(model_objects, shape_objects), function(x) NULL),
c(model_objects, shape_objects)),
# the class is instantiated from a Control object
initialize = function(ctrl) {
if (length(ctrl@constant_item)) {
self$constant_item <- ctrl@constant_item
}
self$mod_par_names <- c(ctrl@geo_name, ctrl@time_name)
self$unmod_par_names <- ctrl@group_names
},
# the as_list method extracts attributes used in modeling as expected by
# rstan. its arguments will be passed from a dgirt or dgmrp call
as_list = function(separate_t, delta_tbar_prior_mean, delta_tbar_prior_sd,
innov_sd_delta_scale, innov_sd_theta_scale, hierarchical_model) {
# model_objects is a character vector of attribute names for rstan data
d_in_list <- Map(function(x) self[[x]], private$model_objects)
# separate_t is a boolean in the stan code
if (length(separate_t) != 1L || !is.logical(separate_t)) {
stop("\"separate_t\" should be a single logical value")
}
d_in_list$separate_t <- separate_t
# hierarchical_model is also boolean in the stan code
if (length(hierarchical_model) != 1L || !is.logical(hierarchical_model)) {
stop("\"hierarchical_model\" should be a single logical value")
}
d_in_list$hierarchical_model <- hierarchical_model
if (length(delta_tbar_prior_mean) != 1L || !is.numeric(delta_tbar_prior_mean)) {
stop("\"delta_tbar_prior_mean\" should be a single real value")
}
d_in_list$delta_tbar_prior_mean <- delta_tbar_prior_mean
if (length(delta_tbar_prior_sd) != 1L || !is.numeric(delta_tbar_prior_sd)
|| delta_tbar_prior_sd < 0)
{
stop("\"delta_tbar_prior_sd\" should be a single positive real value")
}
d_in_list$delta_tbar_prior_sd <- delta_tbar_prior_sd
if (length(innov_sd_delta_scale) != 1L ||
!is.numeric(innov_sd_delta_scale) || innov_sd_delta_scale < 0) {
stop("\"innov_sd_delta_scale\" should be a single real value")
}
d_in_list$innov_sd_delta_scale <- innov_sd_delta_scale
if (length(innov_sd_theta_scale ) != 1L ||
!is.numeric(innov_sd_theta_scale) || innov_sd_theta_scale < 0) {
stop("\"innov_sd_theta_scale\" should be a single positive real value")
}
d_in_list$innov_sd_theta_scale <- innov_sd_theta_scale
d_in_list
}),
# keep track of which items will be used in modeling
private = list(model_objects = model_objects, shape_objects = shape_objects))
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.