Merge branch 'mediation_analysis_branch' of https://github.com/Declar…

…eDesign/designs into mediation_analysis_branch

DESCRIPTION

@@ -18,7 +18,8 @@ Depends: DeclareDesign
 Imports:
     devtools
 Suggests: knitr,
-    testthat
+    testthat, 
+    systemfit
 Enhances:
   Matching
 RoxygenNote: 6.0.1

NAMESPACE

@@ -1,6 +1,5 @@
 # Generated by roxygen2: do not edit by hand
 
-export(audit_experiment_designer)
 export(block_cluster_two_arm_designer)
 export(cluster_sampling_designer)
 export(construct_design_code)
@@ -9,6 +8,7 @@ export(find_triple_bracket)
 export(get_design_code)
 export(match.call.defaults)
 export(mediation_analysis_designer)
+export(post_treatment_designer)
 export(pretest_posttest_designer)
 export(randomized_response_designer)
 export(regression_discontinuity_designer)

R/block_cluster_two_arm_designer.R

@@ -128,13 +128,3 @@ each containing <code>N_clusters_in_block</code> clusters. Each cluster in turn
 
 
 
-#' A two arm design with blocks and clusters
-#'
-#' Default design created with  \code{\link{block_cluster_two_arm_designer}}
-#' 
-#' @seealso \code{\link{block_cluster_two_arm_designer}} 
-#' @format A design object 
-"block_cluster_two_arm_design"
-
-
-

R/cluster_sampling_designer.R

@@ -88,16 +88,3 @@ attr(cluster_sampling_designer, "description") <- "
     <code>ICC</code>. 
 "
 
-
-
-#' A cluster random sampling design
-#'
-#' Default design created with  \code{\link{cluster_sampling_designer}}
-#' 
-#' @seealso \code{\link{cluster_sampling_designer}} 
-#' @format A design object 
-"cluster_sampling_design"
-
-
-
-

R/crossover_designer.R

@@ -1,10 +1,12 @@
 #' Create a crossover design
 #'
-#' Description here
-#' 
-#' Key limitations: Limitations here.
-#' 
-#' Note: Note here.
+#' This designer produces designs that have two treatments, A and B, 
+#' which each correspond to their own outcomes, YA and YB. 
+#' The basic premise of the design is that treatment A does not affect outcome YB, 
+#' and that treatment B does not affect outome YA. Using the crossover parameter
+#' researchers can assess robustness of the design to violations of this assumption.
+#' The \href{/library/articles/crossover.html}{vignette} shows that adding a 
+#' SUR estimator to the design can greatly increase efficiency.
 #'
 #' @param N An integer. Size of sample.
 #' @param a A number. Treatment effect of interest
@@ -18,10 +20,9 @@
 #' @export
 #' @examples
 #' # To make a design using default arguments:
-#' crossover_design <- audit_experiment_designer()
+#' crossover_design <- crossover_designer()
 #'
 
-
 crossover_designer <- function(N = 100,
                                a = .5,
                                b = .5,
@@ -31,54 +32,50 @@ crossover_designer <- function(N = 100,
   {{{
     population <- declare_population(
       N = N, 
-      noise = rnorm(N),
       u_a = rnorm(N),
       u_b = rnorm(n = N, mean = rho * u_a, sd = sqrt(1 - rho^2))
     )
     potential_outcomes_A <- declare_potential_outcomes(
-      YA_Z_T1 = noise,
-      YA_Z_T2 = noise + u_a + a,
-      YA_Z_T3 = noise + crossover * (u_b + b),
-      YA_Z_T4 = noise + u_a + a + crossover * (u_b + b)
+      YA_Z_T1 = u_a,
+      YA_Z_T2 = a + u_a,
+      YA_Z_T3 = u_a + crossover * (b + u_b),
+      YA_Z_T4 = a + u_a + crossover * (b + u_b)
     )
     potential_outcomes_B <- declare_potential_outcomes(
-      YB_Z_T1 = noise,
-      YB_Z_T2 = noise + crossover * (u_a + a),
-      YB_Z_T3 = noise + u_b + b,
-      YB_Z_T4 = noise + u_b + b + crossover * (u_a + a)
+      YB_Z_T1 = u_b,
+      YB_Z_T2 = u_b + crossover * (a + u_a),
+      YB_Z_T3 = b + u_b,
+      YB_Z_T4 = b + u_b + crossover * (a + u_a)
     )
-    estimand <- declare_estimand(a = a)
+    estimand <- declare_estimand(a = mean(YA_Z_T2 - YA_Z_T1))
     assignment <- declare_assignment(num_arms = 4)
-
-    get_AB <- function(data){
-      fabricate(data = data,
-                A = as.numeric(Z %in% c("T2", "T4")),
-                B = as.numeric(Z %in% c("T3", "T4")))
-    }
-
-    indicator_AB <- declare_assignment(handler = get_AB)
-
-    estimator_sat <- declare_estimator(YA ~ A + B,
-                                       model = lm_robust,
-                                       coefficients = "A",
-                                       estimand = estimand,
-                                       label = "Saturated estimator")
+    get_AB <- declare_step(
+      A = as.numeric(Z %in% c("T2", "T4")),
+      B = as.numeric(Z %in% c("T3", "T4")),
+      handler = fabricate)
+    reveal_YA <- declare_reveal(YA, Z) 
+    reveal_YB <-   declare_reveal(YB, Z) 
     estimator_direct <- declare_estimator(YA ~ A,
                                           model = lm_robust,
                                           coefficients = "A",
                                           estimand = estimand,
                                           label = "Direct estimator")
+    estimator_sat <- declare_estimator(YA ~ A + B,
+                                       model = lm_robust,
+                                       coefficients = "A",
+                                       estimand = estimand,
+                                       label = "Saturated estimator")
     crossover_design <- 
       population +
       potential_outcomes_A +
       potential_outcomes_B +
       estimand +
       assignment +
-      indicator_AB +
-      declare_reveal(YA, Z) +
-      declare_reveal(YB, Z) +
-      estimator_sat +
-      estimator_direct
+      get_AB +
+      reveal_YA + 
+      reveal_YB +
+      estimator_direct + 
+      estimator_sat 
   }}}
   attr(crossover_design, "code") <- 
     construct_design_code(crossover_designer, match.call.defaults())
@@ -109,20 +106,6 @@ Outcomes correlated by <code>rho</code>.
 
 
 
-#' A crossover design
-#'
-#' Default design created with  \code{\link{crossover_designer}}
-#' 
-#' @seealso \code{\link{crossover_designer}} 
-#' @format A design object 
-"crossover_design"
-
-
-
-
-
-
-
 
 
 

R/mediation_analysis_designer.R

@@ -37,6 +37,8 @@ mediation_analysis_designer <- function(N = 100,
     pos_Y <-
       declare_potential_outcomes(Y ~ d * Z + b * M + e2)
     assignment <- declare_assignment(prob = 0.5)
+    reveal_mediator <- declare_reveal(M, Z)
+    reveal_outcome <- declare_reveal(Y, Z) 
     mand_a <- declare_estimand(a = a)
     mand_b <- declare_estimand(b = b)
     mand_d <- declare_estimand(d = d)
@@ -55,17 +57,17 @@ mediation_analysis_designer <- function(N = 100,
       label = "Outcome regression"
     )
     mediation_analysis_design <-
-        population +
-        pos_M +
-        assignment +
-        declare_reveal(M, Z) +
-        pos_Y +
-        mand_a +
-        mand_b +
-        mand_d +
-        declare_reveal(Y, Z) +
-        mediator_regression +
-        outcome_regression
+      population +
+      pos_M +
+      assignment +
+      reveal_mediator +
+      pos_Y +
+      mand_a +
+      mand_b +
+      mand_d +
+      reveal_outcome +
+      mediator_regression +
+      outcome_regression
   }}}
   attr(mediation_analysis_design, "code") <- 
     construct_design_code(mediation_analysis_designer, match.call.defaults())
@@ -97,16 +99,3 @@ attr(mediation_analysis_designer,"description") <- "
 
 
 
-
-#' A mediation analysis design
-#'
-#' Default design created with  \code{\link{mediation_analysis_designer}}
-#' 
-#' @seealso \code{\link{mediation_analysis_designer}} 
-#' @format A design object 
-"mediation_analysis_design"
-
-
-
-
-