Merge 2d7be3f into d614ec8

DeclareDesign · Jun 8, 2018 · 5821395 · 5821395
2 parents d614ec8 + 2d7be3f
commit 5821395
Show file tree

Hide file tree

Showing 95 changed files with 1,746 additions and 1,536 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,10 +1,10 @@
 Package: DeclareDesign
 Title: Declare and Diagnose Research Designs to Understand and Improve Them
-Version: 0.6.0
+Version: 0.8.0
 Date: 2018-04-02
 Authors@R: c(person("Graeme", "Blair", email = "graeme.blair@ucla.edu", role = c("aut", "cre")),
-             person("Jasper", "Cooper", email = "jjc2247@columbia.edu", role = c("aut")),
-             person("Alexander", "Coppock", email = "alex.coppock@yale.edu", role = c("aut")),
+             person("Jasper", "Cooper", email = "jaspercooper@gmail.com", role = c("aut")),
+             person("Alexander", "Coppock", email = "acoppock@gmail.com", role = c("aut")),
              person("Macartan", "Humphreys", email = "macartan@gmail.com", role = c("aut")),
              person("Neal", "Fultz", email = "nfultz@gmail.com", role = c("aut")))
 Description: Researchers can characterize and learn about the properties of
@@ -16,9 +16,9 @@ Description: Researchers can characterize and learn about the properties of
     easier for designs to be shared, replicated, and critiqued.
 Depends:
     R (>= 3.4.0),
-    randomizr (>= 0.12.0),
+    randomizr (>= 0.16.0),
     fabricatr (>= 0.4.0),
-    estimatr (>= 0.6.0)
+    estimatr (>= 0.8.0)
 Imports:
     rlang, methods
 License: MIT + file LICENSE

diff --git a/NAMESPACE b/NAMESPACE
@@ -1,6 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
-S3method("/",d_par)
+S3method("+",dd)
 S3method(print,design)
 S3method(print,design_step)
 S3method(print,diagnosis)
@@ -40,6 +40,7 @@ export(reveal_outcomes_handler)
 export(run_design)
 export(simulate_design)
 export(tidy_estimator)
+export(tidy_step)
 importFrom(estimatr,difference_in_means)
 importFrom(fabricatr,add_level)
 importFrom(fabricatr,fabricate)
@@ -59,8 +60,10 @@ importFrom(rlang,as_quosure)
 importFrom(rlang,call_args)
 importFrom(rlang,enexpr)
 importFrom(rlang,enquo)
+importFrom(rlang,enquos)
 importFrom(rlang,env_clone)
 importFrom(rlang,eval_tidy)
+importFrom(rlang,expr_deparse)
 importFrom(rlang,expr_text)
 importFrom(rlang,f_env)
 importFrom(rlang,f_rhs)
@@ -70,6 +73,8 @@ importFrom(rlang,is_empty)
 importFrom(rlang,is_formula)
 importFrom(rlang,is_lang)
 importFrom(rlang,is_list)
+importFrom(rlang,is_missing)
+importFrom(rlang,is_null)
 importFrom(rlang,is_quosure)
 importFrom(rlang,lang_args)
 importFrom(rlang,lang_fn)

diff --git a/R/aaa.R b/R/aaa.R
@@ -2,10 +2,10 @@
 # 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())
-  if(identical(e, emptyenv())) emptyenv() else
-    if(identical(e, globalenv())) env_clone(e) else # don't clone attached packages
-      env_clone(e, Recall(parent.env(e)))
+  if (environmentName(e) == "CheckExEnv") e else # Cloning the CheckExEnv causes examples to autofail, it has delayedAssign("F", stop())
+    if (identical(e, emptyenv())) emptyenv() else
+      if (identical(e, globalenv())) env_clone(e) else # don't clone attached packages
+        env_clone(e, Recall(parent.env(e)))
 }
 
 ###############################################################################
@@ -15,10 +15,10 @@ env_deep_copy <- function(e) {
 
 dots_env_copy <- function(dots) {
   eprev <- NULL
-  for(i in seq_along(dots)) {
+  for (i in seq_along(dots)) {
     ecurrent <- environment(dots[[i]])
-    if(!is.null(ecurrent)) {
-      if(!identical(ecurrent, eprev) ) {
+    if (!is.null(ecurrent)) {
+      if (!identical(ecurrent, eprev)) {
         eprev <- ecurrent
         eclone <- env_deep_copy(ecurrent)
       }
@@ -32,45 +32,53 @@ dots_env_copy <- function(dots) {
 # Given a function and dots, rename dots based on how things will positionally match
 #' @importFrom rlang is_empty
 rename_dots <- function(handler, dots, addData=TRUE){
-  if(is_empty(dots)) return(dots)
+  if (is_empty(dots)) {
+    return(dots)
+  }
+
   f <- function(...) as.list(match.call(handler)[-1])
-
+  
   d_idx <- setNames(seq_along(dots), names(dots))
-
-  if(addData) d_idx["data"] <- list(NULL)
-
+
+  if (addData) {
+    d_idx["data"] <- list(NULL)
+  }
+
   d_idx <- eval_tidy(quo(f(!!!d_idx)))
-
-  if(addData) d_idx$data <- NULL
-
+
+  if (addData) {
+    d_idx$data <- NULL
+  }
+
   d_idx <- unlist(d_idx)
-
+  
   d_idx <- d_idx[names(d_idx) != "" ]
-
+  
   names(dots)[d_idx] <- names(d_idx)
-
+  
   dots
 }
 
 # Returns a new function(data) which calls FUN(data, dots)
-currydata <- function(FUN, dots, addDataArg=TRUE,strictDataParam=TRUE, cloneDots=TRUE) {
+currydata <- function(FUN, dots, addDataArg = TRUE, strictDataParam = TRUE, cloneDots = TRUE) {
   # heuristic to reuse deep clones
-  if(cloneDots) dots <- dots_env_copy(dots)
-
+  if (cloneDots) {
+    dots <- dots_env_copy(dots)
+  }
+
   quoNoData <- quo((FUN)(!!!dots))
-
-  if(addDataArg && !'data' %in% names(dots) && !'.data' %in% names(dots)){
-
-    dots <- append(dots, list(data=quote(data)), after=FALSE)
+
+  if (addDataArg && !'data' %in% names(dots) && !'.data' %in% names(dots)) {
+    dots <- append(dots, list(data = quote(data)), after = FALSE)
   }
-
+  
   quo <- quo((FUN)(!!!dots))
-
-  if(isTRUE(strictDataParam)) function(data) eval_tidy(quo, data=list(data=data))
+  
+  if (isTRUE(strictDataParam)) function(data) eval_tidy(quo, data = list(data = data))
   else  function(data=NULL){
     #message(quo)
     #used for declare_population with no seed data provided
-    res <- if(is.null(data)) eval_tidy(quoNoData) else eval_tidy(quo, data=list(data=data))
+    res <- if (is.null(data)) eval_tidy(quoNoData) else eval_tidy(quo, data = list(data = data))
     res
   }
 }
@@ -81,57 +89,67 @@ currydata <- function(FUN, dots, addDataArg=TRUE,strictDataParam=TRUE, cloneDots
 #' @importFrom rlang enquo
 declaration_template <- function(..., handler, label=NULL){
   #message("Declared")
-
-  dots <- quos(...,label=!!label)
+  
+  dots <- quos(..., label = !!label)
   this <- attributes(sys.function())
-
-  if(!"label" %in% names(formals(handler))){
+  
+  if (!"label" %in% names(formals(handler))) {
     dots$label <- NULL
   }
-
+  
   dots <- rename_dots(handler, dots, this$strictDataParam)
   dots <- dots_env_copy(dots)
-
-
-  ret <- build_step(currydata(handler, dots, strictDataParam=this$strictDataParam, cloneDots = FALSE),
-            handler=handler,
-            dots=dots,
-            label=label,
-            step_type=this$step_type,
-            causal_type=this$causal_type,
-            call=match.call())
-
-  if(has_validation_fn(handler)) ret <- validate(handler, ret,  dots, label)
+
+
+  ret <- build_step(currydata(handler,
+                              dots,
+                              strictDataParam = this$strictDataParam,
+                              cloneDots = FALSE),
+                    handler = handler,
+                    dots = dots,
+                    label = label,
+                    step_type = this$step_type,
+                    causal_type = this$causal_type,
+                    call = match.call())
+
+  if (has_validation_fn(handler)) {
+    ret <- validate(handler, ret,  dots, label)
+  }
 
   ret
 }
 
 # data structure for steps
 build_step <- function(curried_fn, handler, dots, label, step_type, causal_type, call){
-  structure(curried_fn,
-            handler=handler,
-            dots=dots,
-            label=label,
-            step_type=step_type,
-            causal_type=causal_type,
-            call=call,
-            class=c("design_step", "d_par","function"))
+  structure(
+    curried_fn,
+    handler = handler,
+    dots = dots,
+    label = label,
+    step_type = step_type,
+    causal_type = causal_type,
+    call = call,
+    class = c("design_step", "dd", "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
-
-
+
   formals(declaration)$handler <- substitute(default_handler)
-  if(!missing(default_label)) formals(declaration)$label <- default_label
-
-  structure(declaration,
-            class=c('declaration', 'function'),
-            step_type=step_type,
-            causal_type=causal_type,
-            strictDataParam=strictDataParam)
+  if (!missing(default_label)) {
+    formals(declaration)$label <- default_label
+  }
+
+  structure(
+    declaration,
+    class = c('declaration', 'function'),
+    step_type = step_type,
+    causal_type = causal_type,
+    strictDataParam = strictDataParam
+  )
 }
 
 ###############################################################################