Merge branch 'master' into nfultz/continous_po

NAMESPACE

@@ -11,7 +11,6 @@ S3method(str,seed_data)
 S3method(summary,design)
 S3method(summary,diagnosis)
 export(cite_design)
-export(conduct_design)
 export(declare_assignment)
 export(declare_citation)
 export(declare_design)
@@ -22,11 +21,12 @@ export(declare_population)
 export(declare_potential_outcomes)
 export(declare_reveal)
 export(declare_sampling)
+export(declare_step)
 export(delete_step)
 export(diagnose_design)
 export(draw_data)
 export(execution_st)
-export(fill_out)
+export(expand_design)
 export(get_diagnosands)
 export(get_estimands)
 export(get_estimates)
@@ -35,6 +35,7 @@ export(insert_step)
 export(redesign)
 export(replace_step)
 export(reveal_outcomes_handler)
+export(run_design)
 export(tidy_estimator)
 importFrom(estimatr,difference_in_means)
 importFrom(fabricatr,add_level)

R/DeclareDesign.R

@@ -19,10 +19,9 @@
 #' \describe{
 #'   \item{\code{\link{declare_design}}}{Declare a design from steps}
 #'   \item{\code{\link{draw_data}}}{Simulate the DGP}
-#'   \item{\code{\link{conduct_design}}}{Simulate the DGP with estimands/estimators}
+#'   \item{\code{\link{run_design}}}{Simulate the DGP with estimands/estimators}
 #'   \item{\code{\link{diagnose_design}}}{Diagnose a design}
 #'   \item{\code{\link{cite_design}}}{Cite a design}
-#'   \item{\code{\link{declare_estimator}}}{Estimator step}
 #' }
 #'
 #'
@@ -35,7 +34,7 @@
 #'
 #' @section Design Templates:
 #' \describe{
-#'   \item{\code{\link{fill_out}}}{Generate Designs from a Template}
+#'   \item{\code{\link{expand_design}}}{Generate Designs from a Template}
 #'   \item{designs}{See also the \code{designs} package for templates to use}
 #' }
 #'

R/aaa.R

@@ -1,4 +1,5 @@
-
+###############################################################################
+# Copies an environment chain
 #' @importFrom rlang env_clone
 env_deep_copy <- function(e) {
   if(environmentName(e) == "CheckExEnv") e else # Cloning the CheckExEnv causes examples to autofail, it has delayedAssign("F", stop())
@@ -7,6 +8,11 @@ env_deep_copy <- function(e) {
       env_clone(e, Recall(parent.env(e)))
 }
 
+###############################################################################
+# For set of dots, copy environment chain, reusing the new env if possible
+# to save memory
+#' @importFrom rlang env_clone
+
 dots_env_copy <- function(dots) {
   eprev <- NULL
   for(i in seq_along(dots)) {
@@ -46,13 +52,8 @@ rename_dots <- function(handler, dots, addData=TRUE){
   dots
 }
 
-
+# Returns a new function(data) which calls FUN(data, dots)
 currydata <- function(FUN, dots, addDataArg=TRUE,strictDataParam=TRUE, cloneDots=TRUE) {
-  # dots <- quos(...)
-
-  #  for(i in seq_along(dots)) {
-  #    environment(dots[[i]]) <- env_clone(dots[[i]])
-
   # heuristic to reuse deep clones
   if(cloneDots) dots <- dots_env_copy(dots)
 
@@ -74,6 +75,9 @@ currydata <- function(FUN, dots, addDataArg=TRUE,strictDataParam=TRUE, cloneDots
   }
 }
 
+# Implementation for declarations
+# captures the dots and handler, and returns a function that calls the handler with dots
+# also deals with labeling and can trigger step validation
 #' @importFrom rlang enquo
 declaration_template <- function(..., handler, label=NULL){
   #message("Declared")
@@ -102,6 +106,7 @@ declaration_template <- function(..., handler, label=NULL){
   ret
 }
 
+# data structure for steps
 build_step <- function(curried_fn, handler, dots, label, step_type, causal_type, call){
   structure(curried_fn,
             handler=handler,
@@ -113,6 +118,7 @@ build_step <- function(curried_fn, handler, dots, label, step_type, causal_type,
             class=c("design_step", "d_par","function"))
 }
 
+# generate declaration steps (eg declare_population) by setting the default handler and metadata
 make_declarations <- function(default_handler, step_type, causal_type='dgp', default_label, strictDataParam=TRUE) {
 
   declaration <- declaration_template
@@ -129,6 +135,11 @@ make_declarations <- function(default_handler, step_type, causal_type='dgp', def
 }
 
 ###############################################################################
+# internal helpers for step-specific validation code
+# set on a handler (see eg reveal_outcomes_handler)
+# called at declare time
+#
+# to debug, use debug(DeclareDesign:::validation_fn(DeclareDesign:::reveal_outcomes_handler))
 
 validation_fn <- function(f){
   attr(f, "validation_fn")
@@ -149,6 +160,7 @@ validate <- function(handler, ret, dots, label) {
 
 
 ###############################################################################
+# used to inherit roxygen docs
 
 #' @param ...      arguments to be captured, and later passed to the handler
 #' @param handler  a tidy-in, tidy-out function

R/declare_assignment.R

@@ -21,7 +21,7 @@
 #'
 #' @examples
 #'
-#' ##########################################
+#' ########################################################
 #' # Default Handler
 #' # Delegates to conduct_ra
 #'
@@ -35,7 +35,7 @@
 #'   assignment_variable = "X1"
 #' )
 #'
-#' ##########################################
+#' ########################################################
 #' #' # Custom random assignment functions
 #'
 #' my_assignment_function <- function(data) {

R/declare_design.R

@@ -1,5 +1,5 @@
 
-
+# Some testing code
 # d1 <- make_declarations(summary, step_type='summary')
 # dd <- d1()
 # dd(sleep)
@@ -16,6 +16,11 @@
 # me <- !me
 # f(mtcars)
 
+
+###############################################################################
+# In declare_design, if a step is a dplyr style call mutate(foo=bar),
+# it will fail to evaluate - we can catch that and try to curry it
+
 #' @importFrom rlang quos lang_fn lang_modify eval_tidy
 callquos_to_step <- function(step_call, label="") {
   ## this function allows you to put any R expression
@@ -139,14 +144,15 @@ declare_design <- function(...) {
 
   if(getOption("DD.debug.declare_design", FALSE)) browser()
 
+  # for each step in qs, eval, and handle edge cases (dplyr calls, non-declared functions)
   for(i in  seq_along(qs)) {
 
     #wrap step is nasty, converts partial call to curried function
     ret[[i]] <- tryCatch(
       eval_tidy(qs[[i]]),
       error = function(e) tryCatch(callquos_to_step(qs[[i]], qnames[[i]]),
                                    error = function(e) stop("Could not evaluate step ", i,
-                                                            "as either a step or call."))
+                                                            " as either a step or call."))
     )
 
     # Is it a non-declared function
@@ -172,6 +178,7 @@ declare_design <- function(...) {
     class(ret[[1]]) <- c("seed_data", class(ret[[1]]))
   }
 
+  # Assert that all labels are unique
   local({
 
     labels <- sapply(ret, attr, "label")
@@ -193,6 +200,7 @@ declare_design <- function(...) {
 
   })
 
+  # If there is a design-time validation, trigger it
   for(i in seq_along(ret)){
     step <- ret[[i]]
     callback <- attr(step, "design_validation")

R/declare_estimand.R

@@ -6,11 +6,15 @@
 #'
 #' @return a function that accepts a data.frame as an argument and returns a data.frame containing the value of the estimand.
 #'
+#' @details
+#'
+#' For the default diagnosands, the return value of the handler should have `estimand_label` and `estimand` columns.
+#'
 #' @export
 #'
 #' @examples
 #'
-#' ##########################################
+#' ########################################################
 #' # Default handler
 #'
 #' my_estimand_ATE <- declare_estimand(ATE = mean(Y_Z_1 - Y_Z_0))
@@ -30,7 +34,7 @@
 #'   label="TrueRegressionParams"
 #' )
 #'
-#' ##########################################
+#' ########################################################
 #' # Custom random assignment functions
 #'
 #' my_estimand_function <- function(data, label) {
@@ -42,7 +46,7 @@
 #' }
 #' my_estimand_custom <- declare_estimand(handler = my_estimand_function, label = "medianTE")
 #'
-#' ##########################################
+#' ########################################################
 #' # Using with estimators
 #'
 #'
@@ -73,7 +77,7 @@
 #' design_def <- insert_step(design_stub, my_estimand_ATE, before="assn")
 #' design_def <- insert_step(design_def, my_estimator, after="reveal")
 #'
-#' conduct_design(design_def)
+#' run_design(design_def)
 #'
 #' # ----------
 #' # 2. Multiple estimands
@@ -88,7 +92,7 @@
 #' design_two <- insert_step(design_two, my_estimand_ATT, after="assn")
 #' design_two <- insert_step(design_two, my_estimator_two, after="reveal")
 #'
-#' conduct_design(design_two)
+#' run_design(design_two)
 #'
 #'
 #' # For the model based estimator, specify the estimand as usual,
@@ -103,7 +107,7 @@
 #' design_double <- insert_step(design_stub, my_estimand_regression, after="po")
 #' design_double <- insert_step(design_double, my_estimator_double, after="reveal")
 #'
-#' conduct_design(design_double)
+#' run_design(design_double)
 #'
 #' # ----------
 #' # 3. Custom estimands
@@ -123,7 +127,7 @@
 #' design_cust <- insert_step(design_stub, my_estimand_custom, before="assn")
 #' design_cust <- insert_step(design_cust, my_estimator_custom, after="reveal")
 #'
-#' conduct_design(design_cust)
+#' run_design(design_cust)
 declare_estimand <- make_declarations(estimand_handler, "estimand", causal_type="estimand", default_label="my_estimand")
 
 #' @param subset a subset expression

R/declare_estimand_diagnosands.R

@@ -1,5 +1,5 @@
 # File is named so that it collates after declare_estimand
-
+# Diagnosands use the same handler as estimands
 diagnosand_handler <- estimand_handler
 validation_fn(diagnosand_handler) <- function(ret, dots, label){
 
@@ -26,7 +26,7 @@ validation_fn(diagnosand_handler) <- function(ret, dots, label){
 #' coverage = mean(estimand <= ci_upper & estimand >= ci_lower)\cr
 #' mean_estimate = mean(est)\cr
 #' sd_estimate = sd(est)\cr
-#' type_s_rate = mean((sign(est) != sign(estimand)) & p < .05)\cr
+#' type_s_rate = mean((sign(est) != sign(estimand))[p < alpha])\cr
 #' mean_estimand = mean(estimand)\cr
 #'
 #' @return a function that returns a data.frame
@@ -87,12 +87,13 @@ validation_fn(diagnosand_handler) <- function(ret, dots, label){
 #'
 declare_diagnosands <- make_declarations(diagnosand_handler, "diagnosand", "diagnosands")
 
-
+# Defaults are implemented directly.
 default_diagnosands <- function(data, alpha=.05){
 
   est      <- data$est         %||% NA
   estimand <- data$estimand    %||% NA
   p        <- data$p           %||% NA
+  se       <- data$se          %||% NA
   ci_lower <- data$ci_lower    %||% NA
   ci_upper <- data$ci_upper    %||% NA
 
@@ -103,11 +104,12 @@ default_diagnosands <- function(data, alpha=.05){
                   estimand >= ci_lower)
   mean_estimate = mean(est)
   sd_estimate = sd(est)
+  mean_se     = mean(se)
   type_s_rate = mean((sign(est) != sign(estimand))[ p < alpha ] )
   mean_estimand = mean(estimand)
 
 
-  data.frame(estimand_label = c("bias", "rmse", "power", "coverage", "mean_estimate", "sd_estimate", "type_s_rate", "mean_estimand"),
-             estimand       = c( bias ,  rmse ,  power ,  coverage ,  mean_estimate ,  sd_estimate ,  type_s_rate ,  mean_estimand ))
+  data.frame(estimand_label = c("bias", "rmse", "power", "coverage", "mean_estimate", "sd_estimate", "mean_se", "type_s_rate", "mean_estimand"),
+             estimand       = c( bias ,  rmse ,  power ,  coverage ,  mean_estimate ,  sd_estimate , mean_se,  type_s_rate ,  mean_estimand ))
 }