move arguments from ... into shape's explicit signature

It's a long sig but makes documentation and usage clearer. Also rename
the `target_proportion_name` of `shape()` and the `prop_name` argument
of `poststratify` for consistency -> `proportion_name`.

Author: jamesdunham

R/class-control.r

@@ -1,31 +1,29 @@
 setClass("Control",
-         slots = list(constant_item = "logical",
+         slots = list(# item data
+                      item_names = "character",
+                      time_name = "character",
                       geo_name = "character",
-                      geo_filter = "character",
                       group_names = "ANY",
-                      item_names = "character",
                       id_vars = "ANY",
-                      aggregate_item_names = "ANY",
-                      min_survey_filter = "numeric",
+                      # restrictions
+                      time_filter = "ANY",
+                      geo_filter = "ANY",
                       min_t_filter = "numeric",
-                      modifier_names = "character",
-                      prop_name = "character",
+                      min_survey_filter = "numeric",
+                      survey_name = "ANY",
+                      # aggregate data
+                      aggregate_item_names = "ANY",
+                      # modifier data
+                      modifier_names = "ANY",
+                      t1_modifier_names = "ANY",
+                      standardize = "logical",
+                      # target data
                       raking = "ANY",
+                      weight_name = "ANY",
+                      proportion_name = "character",
                       rake_names = "character",
-                      standardize = "logical",
-                      sample_margins = "list",
-                      survey_name = "ANY",
-                      target_group_names = "character",
-                      target_proportion_name = "character",
-                      t1_modifier_names = "character",
-                      time_name = "character",
-                      time_filter = "numeric",
-                      weight_name = "ANY"),
-         prototype = prototype(constant_item = TRUE,
-                               min_t_filter = 1L,
-                               min_survey_filter = 1L,
-                               standardize = TRUE,
-                               prop_name = "proportion"),
+                      # modeling options
+                      constant_item = "logical"),
          validity = function(object) {
            if (!length(object@time_name) == 1L)
              "\"time_name\" should be a single variable name"
@@ -37,8 +35,16 @@ setClass("Control",
              "if specified \"survey_name\" should be a single variable name"
            else if (length(object@group_names) && !is.character(object@group_names))
              "if specified \"group_names\" should give variable names in a character vector"
+           else if (length(object@modifier_names) && !is.character(object@modifier_names))
+             "if specified \"modifier_names\" should give variable names in a character vector"
+           else if (length(object@t1_modifier_names) && !is.character(object@t1_modifier_names))
+             "if specified \"t1_modifier_names\" should give variable names in a character vector"
            else if (length(object@id_vars) && !is.character(object@id_vars))
              "if specified \"id_vars\" should give variable names in a character vector"
+           else if (length(object@time_filter) && !is.numeric(object@time_filter))
+             "if specified \"time_filter\" should give numeric values of the `time_name` variable"
+           else if (length(object@geo_filter) && !is.character(object@geo_filter))
+             "if specified \"geo_filter\" should give character values of the `geo_name` variable"
            else if (length(object@aggregate_item_names) && !is.character(object@aggregate_item_names))
              "if specified \"aggregate_item_names\" should give values in an \"item\" column of aggregate_data"
            else if (!length(object@standardize) == 1L)
@@ -47,6 +53,8 @@ setClass("Control",
              "if specified \"weight_name\" should be a single variable name"
            else if (length(object@weight_name) > 1)
              "if specified \"weight_name\" should be a single variable name"
+           else if (length(object@proportion_name) && length(object@proportion_name) != 1L)
+             "if specified \"proportion_name\" should be a single variable name"
            else if (length(object@raking) && !is.list(object@raking) &
                     !"formula" %in% class(object@raking))
              "\"raking\" should be a formula or a list of formulas"
@@ -64,8 +72,6 @@ setClass("Control",
              "\"min_survey_filter\" should be a positive integer"
            else if (!length(object@min_t_filter) == 1L && object@min_t_filter > 0L)
              "\"min_t_filter\" should be a positive integer"
-           else if (length(object@sample_margins) && !is.list(object@sample_margins))
-             "\"sample_margins\" should be a list of formulas or data frames"
            else 
              TRUE
          })

R/constants.r

@@ -29,7 +29,7 @@ var_types <- list(group_names = c("character", "factor"),
                   survey_name = c("character", "factor"),
                   weight_name = "numeric",
                   strata_names = c("character", "factor", "integer", "numeric"),
-                  target_proportion_name = "numeric",
+                  proportion_name = "numeric",
                   modifier_names = c("integer", "numeric"),
                   t1_modifier_names = c("integer", "numeric"),
                   item = c("character", "factor"),

R/methods-control.r

@@ -2,24 +2,55 @@
 `%chin%` <- data.table::`%chin%`
 
 # Constructor for Control
-init_control <- function(item_data,
-                         item_names,
-                         time_name,
-                         geo_name,
-                         group_names,
-                         weight_name,
-                         survey_name,
-                         raking,
-                         id_vars,
-                         aggregate_data,
-                         aggregate_item_names,
+init_control <- function(item_data = item_data,
+                         item_names = item_names,
+                         time_name = time_name,
+                         geo_name = geo_name,
+                         group_names = group_names,
+                         id_vars = id_vars,
+                         time_filter = time_filter,
+                         geo_filter = geo_filter,
+                         min_t_filter = min_t_filter,
+                         min_survey_filter = min_survey_filter,
+                         survey_name = survey_name,
+                         aggregate_data = aggregate_data,
+                         aggregate_item_names = aggregate_item_names,
+                         modifier_data = modifier_data,
+                         modifier_names = modifier_names,
+                         t1_modifier_names = t1_modifier_names,
+                         standardize = standardize,
+                         target_data = target_data,
+                         raking = raking,
+                         weight_name = weight_name,
+                         proportion_name = proportion_name,
+                         constant_item = constant_item,
                          ...) {
-  ctrl <- new("Control", item_names = item_names,
-                 time_name = time_name, geo_name = geo_name, group_names =
-                   group_names, weight_name = weight_name, survey_name =
-                   survey_name, raking = raking, id_vars = id_vars, 
-                 aggregate_item_names = aggregate_item_names, ...)
-
+  ctrl <- new("Control",
+              # item data
+              item_names = item_names,
+              time_name = time_name,
+              geo_name = geo_name,
+              group_names = group_names,
+              id_vars = id_vars,
+              # restrictions
+              time_filter = time_filter,
+              geo_filter = geo_filter,
+              min_t_filter = min_t_filter,
+              min_survey_filter = min_survey_filter,
+              survey_name = survey_name,
+              # aggregate data
+              aggregate_item_names = aggregate_item_names,
+              # modifier data
+              modifier_names = modifier_names,
+              t1_modifier_names = t1_modifier_names,
+              standardize = standardize,
+              # target data
+              raking = raking,
+              weight_name = weight_name,
+              proportion_name = proportion_name,
+              # modeling options
+              constant_item = constant_item,
+              ...)
   is_item_name <- valid_names(item_data, ctrl, 1L)
   is_item_name(c("time_name", "geo_name"))
   has_type(c("time_name", "geo_name"), item_data, ctrl)
@@ -34,6 +65,12 @@ init_control <- function(item_data,
     }
   }
 
+  if (length(ctrl@modifier_names)) {
+    if (!length(ctrl@t1_modifier_names)) {
+      ctrl@t1_modifier_names <- ctrl@modifier_names
+    }
+  }
+
   if (!length(ctrl@time_filter)) {
     ctrl@time_filter <- sort(unique(item_data[[ctrl@time_name]]))
     if (length(aggregate_data)) {
@@ -50,7 +87,6 @@ init_control <- function(item_data,
     }
   }
 
-
   if (length(raking)) {
     if (is.list(ctrl@raking)) {
       ctrl@rake_names = unlist(lapply(ctrl@raking, all.vars))

R/methods-dgirtfit-poststratify.r

@@ -16,7 +16,7 @@ utils::globalVariables(c("value", "scaled_prop"))
 #' @param ... Additional arguments to methods.
 setGeneric("poststratify", signature = "x",
            function(x, target_data, strata_names, aggregated_names,
-                    prop_name = "proportion", ...)
+                    proportion_name = "proportion", ...)
              standardGeneric("poststratify"))
 
 #' @param pars Selected parameter names.
@@ -38,9 +38,9 @@ setGeneric("poststratify", signature = "x",
 #' @export
 setMethod("poststratify", c("dgo_fit"),
   function(x, target_data, strata_names, aggregated_names,
-           prop_name = "proportion", pars = "theta_bar") {
+           proportion_name = "proportion", pars = "theta_bar") {
     x <- as.data.frame(x, pars = pars)
-    callGeneric(x, target_data, strata_names, aggregated_names, prop_name)
+    callGeneric(x, target_data, strata_names, aggregated_names, proportion_name)
 })
 
 #' @param x A \code{data.frame} or \code{dgo_fit} object.
@@ -50,19 +50,19 @@ setMethod("poststratify", c("dgo_fit"),
 #' population strata.
 #' @param aggregated_names Names of variables to be aggregated over in
 #' poststratification. 
-#' @param prop_name Name of the column in \code{target_data} that gives
+#' @param proportion_name Name of the column in \code{target_data} that gives
 #' strata proportions.
 #' @return A table of poststratified estimates.
 #' @rdname poststratify
 #' @importFrom stats pnorm
 #' @export
 setMethod("poststratify", "data.frame",
           function(x, target_data, strata_names, aggregated_names,
-                   prop_name = "proportion", pars = "theta_bar") {
+                   proportion_name = "proportion", pars = "theta_bar") {
   assert(is.data.frame(target_data))
   assert(all_strings(strata_names))
   assert(all_strings(strata_names))
-  assert(assertthat::is.string(prop_name))
+  assert(assertthat::is.string(proportion_name))
   assert(all_strings(pars))
 
   x <- data.table::setDT(data.table::copy(x))
@@ -103,7 +103,7 @@ setMethod("poststratify", "data.frame",
     }
 
   extra_cols <- setdiff(names(targets), c(strata_names, aggregated_names,
-                                          prop_name))
+                                          proportion_name))
   if (length(extra_cols)) {
     targets[, c(extra_cols) := NULL]
   }
@@ -118,7 +118,7 @@ setMethod("poststratify", "data.frame",
             "and this may indicate a larger problem.")
   }
 
-  props <- scale_props(props, prop_name, strata_names)
+  props <- scale_props(props, proportion_name, strata_names)
 
   check_proportions(props, strata_names)
   res <- props[, list(value = sum(value * scaled_prop)), by = strata_names] 
@@ -130,11 +130,11 @@ check_estimates <- function(estimates, strata_names) {
   estimates
 }
 
-scale_props <- function(props, prop_name, strata_names) {
-  strata_sums <- props[, list(strata_sum = sum(get(prop_name))),
+scale_props <- function(props, proportion_name, strata_names) {
+  strata_sums <- props[, list(strata_sum = sum(get(proportion_name))),
                        by = strata_names]
   props <- merge(props, strata_sums, all = FALSE, by = strata_names)
-  props[, c("scaled_prop") := get(prop_name) / get("strata_sum")]
+  props[, c("scaled_prop") := get(proportion_name) / get("strata_sum")]
   return(props)
 }
 

R/reweight_item_responses.r

@@ -26,7 +26,7 @@ rake_weights <- function(item_data, target_data, control) {
   item_design <- survey::svydesign(ids = ~1, data = item_data,
                           weights = formula(paste0("~", control@weight_name)))
   target_design <- survey::svydesign(ids = ~1, data = target_data,
-    weights = formula(paste0("~", control@target_proportion_name)))
+    weights = formula(paste0("~", control@proportion_name)))
   target_tables <- lapply(formulas, survey::svytable,
                           design = target_design)
   raked_design <- rake_partial(design = item_design,