From 396b38a534a306f4dff39513dff819403978eaa3 Mon Sep 17 00:00:00 2001 From: Lily Medina Date: Tue, 18 Dec 2018 15:04:42 +0100 Subject: [PATCH 1/6] add mediation and test (covr is too low) --- R/mediation_analysis_designer.R | 249 ++++++++++++++++++++++++-------- tests/testthat/test_designers.R | 3 + 2 files changed, 191 insertions(+), 61 deletions(-) diff --git a/R/mediation_analysis_designer.R b/R/mediation_analysis_designer.R index 9d5d2644..278d97a7 100644 --- a/R/mediation_analysis_designer.R +++ b/R/mediation_analysis_designer.R @@ -1,76 +1,166 @@ #' Create a design for mediation analysis -#' -#' A mediation analysis design that examines the effect of treatment (Z) on mediator (M) and the effect of mediator (M) on outcome (Y) (given Z=0) -#' as well as direct effect of treatment (Z) on outcome (Y) (given M=0). Analysis is implemented using an interacted regression model. -#' Note this model is not guaranteed to be unbiased despite randomization of Z because of possible violations of sequential ignorability. #' -#' @details +#' A mediation analysis design that examines the effect of (Z) on mediator (M), the natural and controlled direct effect of treatment (Z) on outcome (Y) as well as the natural and controlled indirect effect of treatment (Z) on outcome (Y) through mediator (M). +#' Analysis is implemented using a set of two linear structural models: a first stage model and a interacted model. Note estimates are not guaranteed to be unbiased despite randomization of Z because of possible violations of sequential ignorability. #' +#' +#' @details #' See \href{https://declaredesign.org/library/articles/mediation_analysis.html}{vignette online}. #' #' @param N An integer. Size of sample. -#' @param a A number. Parameter governing effect of treatment (Z) on mediator (M). -#' @param b A number. Effect of mediator (M) on outcome (Y) when Z = 0. -#' @param c A number. Interaction between mediator (M) and (Z) for outcome (Y). -#' @param d A number. Direct effect of treatment (Z) on outcome (Y), when M = 0. +#' @param Z_on_M A number. Parameter governing effect of treatment (Z) on mediator (M). +#' @param M_on_Y_Z0 A number. Effect of mediator (M) on outcome (Y) when Z = 0. +#' @param M_on_Y_Z1 A number. Interaction between mediator (M) and (Z) for outcome (Y). +#' @param Z_on_Y_M0 A number. Effect of treatment (Z) on outcome (Y), when M = 0. #' @param rho A number in [-1,1]. Correlation between mediator (M) and outcome (Y) error terms. Non zero correlation implies a violation of sequential ignorability. +#' @param mediation_package A logical value. If 'TRUE' direct and indirect effects are estimated using \code{mediate} function from \code{mediation} package. Default is 'FALSE'. #' @return A mediation analysis design. #' @author \href{https://declaredesign.org/}{DeclareDesign Team} #' @concept experiment #' @concept mediation -#' @importFrom DeclareDesign declare_assignment declare_estimands declare_estimator declare_population declare_potential_outcomes declare_reveal declare_step diagnose_design draw_estimands +#' @importFrom DeclareDesign declare_assignment declare_estimands declare_estimator declare_population declare_potential_outcomes declare_reveal declare_step diagnose_design get_estimands #' @importFrom fabricatr fabricate fabricate -#' @importFrom randomizr conduct_ra -#' @importFrom estimatr lm_robust +#' @importFrom randomizr conduct_ra +#' @importFrom mediation mediate +#' @importFrom stats lm +#' @importFrom estimatr tidy lm_robust #' @export #' @examples #' # Generate a mediation analysis design using default arguments: #' mediation_1 <- mediation_analysis_designer() -#' draw_estimands(mediation_1) +#' get_estimands(mediation_1) #' \dontrun{ #' diagnose_design(mediation_1, sims = 1000) #' } #' #' # A design with a violation of sequential ignorability and heterogeneous effects: -#' mediation_2 <- mediation_analysis_designer(a = 1, rho = .5, c = 1, d = .75) -#' draw_estimands(mediation_2) +#' mediation_2 <- mediation_analysis_designer(Z_on_M =1, rho = .5, M_on_Y_Z1 = 1, Z_on_Y_M0 =.75) +#' get_estimands(mediation_2) #' \dontrun{ #' diagnose_design(mediation_2, sims = 1000) #' } #' -mediation_analysis_designer <- function(N = 200, a = 1, b = .4, c = 0, d = .5, rho = 0) +#' +mediation_analysis_designer <- function(N = 200, + Z_on_M = 1, + M_on_Y_Z0 = .4, + M_on_Y_Z1 = 0, + Z_on_Y_M0 = .5, + rho = 0, + mediation_package = FALSE) + { if(abs(rho) > 1) stop("rho must be in [-1, 1]") + + mediation_analysis_expr <- mediate_estimator_expr <- NULL + + # I: Inquiry + + estimands_expr <- rlang::expr( + estimands <- declare_estimands( + FirstStage = mean(M_Z_1 - M_Z_0), + natural_indirect_0 = mean(Y_nat1_Z_0 - Y_nat0_Z_0), + natural_direct_0 = mean(Y_nat0_Z_1 - Y_nat0_Z_0), + natural_direct_1 = mean(Y_nat1_Z_1 - Y_nat1_Z_0), + controlled_indirect_0 = mean(Y_M_1_Z_0 - Y_M_0_Z_0), + controlled_direct_0 = mean(Y_M_0_Z_1 - Y_M_0_Z_0), + controlled_direct_1 = mean(Y_M_1_Z_1 - Y_M_1_Z_0) + ) + ) + + # Design + + mediation_design_expr <- rlang::expr( + mediation_analysis_design <- population + + POs_M + POs_Y + POs_Y_nat_0 + POs_Y_nat_1 + + estimands + assignment + + reveal_M + reveal_Y + reveal_nat0 + reveal_nat1 + manipulation + + mediator_regression + stage2_1 + stage2_2 + stage2_3 + ) + + if(mediation_package){ + + # I: Inquiry + estimands_expr <- rlang::expr( + estimands <- declare_estimands( + FirstStage = mean(M_Z_1 - M_Z_0), + natural_indirect_0 = mean(Y_nat1_Z_0 - Y_nat0_Z_0), + natural_indirect_1 = mean(Y_nat1_Z_1 - Y_nat0_Z_1), + natural_direct_0 = mean(Y_nat0_Z_1 - Y_nat0_Z_0), + natural_direct_1 = mean(Y_nat1_Z_1 - Y_nat1_Z_0), + controlled_indirect_0 = mean(Y_M_1_Z_0 - Y_M_0_Z_0) , + controlled_indirect_1 = mean(Y_M_1_Z_1 - Y_M_0_Z_1), + controlled_direct_0 = mean(Y_M_0_Z_1 - Y_M_0_Z_0), + controlled_direct_1 = mean(Y_M_1_Z_1 - Y_M_1_Z_0) + ) + ) + + # A: Answer Strategy + + mediation_analysis_expr <- rlang::expr( + + # QBA: Quasi-Bayesian Approximation + mediation_analysis <- function(data){ + e1 <- lm(M ~ Z, data = data) + e2 <- lm(Y ~ M + Z + M:Z, data = data) + m <- mediation::mediate(e1, e2, sims = 50, treat = "Z", mediator = "M") + out <- broom::tidy(m, conf.int = TRUE) + out + }) + + mediate_estimator_expr <- rlang::expr( + mediate_estimator <- declare_estimator(handler = function(data){ + estimates <- mediation_analysis(data) + estimates <- rbind(estimates, estimates) + estimates$estimator_label <- rep(c("qba - indirect_0", "qba - indirect_1", "qba - direct_0", "qba - direct_1") , 2) + estimates$estimand_label <- c("natural_indirect_0", "natural_indirect_1", "natural_direct_0", "natural_direct_1", + c("controlled_indirect_0", "controlled_indirect_1", "controlled_direct_0", "controlled_direct_1") ) + estimates$outcome <- rep("Y", 4) + estimates$term <- rep(c("indirect_0", "indirect_1", "direct_0", "direct_1"), 2) + as.data.frame(estimates) + }, + label = "mediate")) + + # Design + mediation_design_expr <- rlang::expr( + population + + POs_M + POs_Y + POs_Y_nat_0 + POs_Y_nat_1 + + estimands + assignment + + reveal_M + reveal_Y + reveal_nat0 + reveal_nat1 + manipulation + + mediator_regression + stage2_1 + stage2_2 + stage2_3 + mediate_estimator + ) + } + + + {{{ + # M: Model + population <- declare_population( N = N, e1 = rnorm(N), - e2 = rnorm(n = N, mean = rho * e1, sd = 1 - rho^2) + e2 = rnorm(n = N, mean = rho * e1, sd = sqrt(1 - rho^2)) ) - POs_M <- declare_potential_outcomes(M ~ 1*(a * Z + e1 > 0)) - POs_Y <- declare_potential_outcomes(Y ~ d * Z + b * M + c * M * Z + e2, + + POs_M <- declare_potential_outcomes(M ~ 1 * (Z_on_M * Z + e1 > 0)) + POs_Y <- declare_potential_outcomes(Y ~ Z_on_Y_M0 * Z + M_on_Y_Z0 * M + M_on_Y_Z1 * M * Z + e2, conditions = list(M = 0:1, Z = 0:1)) + POs_Y_nat_0 <- declare_potential_outcomes( - Y_nat0_Z_0 = b * M_Z_0 + e2, - Y_nat0_Z_1 = d + b * M_Z_0 + c * M_Z_0 + e2) + Y_nat0_Z_0 = M_on_Y_Z0 * M_Z_0 + e2, + Y_nat0_Z_1 = Z_on_Y_M0 + M_on_Y_Z0 * M_Z_0 + M_on_Y_Z1 * M_Z_0 + e2) POs_Y_nat_1 <- declare_potential_outcomes( - Y_nat1_Z_0 = b * M_Z_1 + e2, - Y_nat1_Z_1 = d + b * M_Z_1 + c * M_Z_1 + e2) + Y_nat1_Z_0 = M_on_Y_Z0 * M_Z_1 + e2, + Y_nat1_Z_1 = Z_on_Y_M0 + M_on_Y_Z0 * M_Z_1 + M_on_Y_Z1 * M_Z_1 + e2) # I: Inquiry - estimands <- declare_estimands( - FirstStage = mean(M_Z_1 - M_Z_0), - Indirect_0 = mean(Y_M_1_Z_0 - Y_M_0_Z_0), - Indirect_1 = mean(Y_M_1_Z_1 - Y_M_0_Z_1), - Controlled_Direct_0 = mean(Y_M_0_Z_1 - Y_M_0_Z_0), - Controlled_Direct_1 = mean(Y_M_1_Z_1 - Y_M_1_Z_0), - Natural_Direct_0 = mean(Y_nat0_Z_1 - Y_nat0_Z_0), - Natural_Direct_1 = mean(Y_nat1_Z_1 - Y_nat1_Z_0) - ) + + rlang::eval_bare(estimands_expr) # D: Data strategy + assignment <- declare_assignment() reveal_M <- declare_reveal(M, Z) reveal_Y <- declare_reveal(Y, assignment_variable = c("M","Z")) @@ -79,60 +169,99 @@ mediation_analysis_designer <- function(N = 200, a = 1, b = .4, c = 0, d = .5, r manipulation <- declare_step(Not_M = 1 - M, handler = fabricate) # A: Answer Strategy + mediator_regression <- declare_estimator( M ~ Z, model = lm_robust, - estimand = "FirstStage", - label = "Stage 1") + label = "Stage 1", + estimand = "FirstStage" + ) + + stage2_1 <- declare_estimator( - Y ~ Z * M, + Y ~ Z * M, model = lm_robust, term = c("M"), - estimand = c("Indirect_0"), - label = "Stage 2" + label = "Stage 2", + estimand = c( "natural_indirect_0", "controlled_indirect_0") ) + stage2_2 <- declare_estimator( - Y ~ Z * M, + Y ~ Z * M, model = lm_robust, term = c("Z"), - estimand = c("Controlled_Direct_0", "Natural_Direct_0"), - label = "Direct_0" + label = "Direct_0", + estimand = c("natural_direct_0", "controlled_direct_0") ) + stage2_3 <- declare_estimator( - Y ~ Z * Not_M, + Y ~ Z * Not_M, model = lm_robust, term = c("Z"), - estimand = c("Controlled_Direct_1", "Natural_Direct_1"), - label = "Direct_1" + label = "Direct_1", + estimand = c("natural_direct_1", "controlled_direct_1") ) + + rlang::eval_bare(mediation_analysis_expr) + rlang::eval_bare(mediate_estimator_expr) + # Design - mediation_analysis_design <- population + - POs_M + POs_Y + POs_Y_nat_0 + POs_Y_nat_1 + - estimands + assignment + - reveal_M + reveal_Y + reveal_nat0 + reveal_nat1 + manipulation + - mediator_regression + stage2_1 + stage2_2 + stage2_3 + + mediation_analysis_design <- rlang::eval_bare(mediation_design_expr) + mediation_analysis_design }}} - attr(mediation_analysis_design, "code") <- - construct_design_code(mediation_analysis_designer, match.call.defaults()) - mediation_analysis_design + design_code <- + construct_design_code( + mediation_analysis_designer, + match.call.defaults(), + arguments_as_values = TRUE, + exclude_args = "mediation_package" + ) + + if(mediation_package) + substitutes <- list(rlang::quo_text(mediation_analysis_expr), rlang::quo_text(mediate_estimator_expr)) + else + substitutes <- list("", "") + + + design_code <- + gsub("rlang::eval_bare\\(mediation_analysis_expr\\)", substitutes[[1]], design_code) + design_code <- + gsub("rlang::eval_bare\\(mediate_estimator_expr\\)", substitutes[[2]], design_code) + + design_code <- + gsub("rlang::eval_bare\\(mediation_design_expr\\)", rlang::quo_text(mediation_design_expr), design_code) + design_code <- + gsub("rlang::eval_bare\\(estimands_expr\\)", rlang::quo_text(estimands_expr), design_code) + + attr(mediation_analysis_design, "code") <- design_code + return(mediation_analysis_design) + } + attr(mediation_analysis_designer,"shiny_arguments") <- list( N = c(100, 50, 1000), - a = seq(from = .5, to = -.5, by = -.5), - b = seq(from = .5, to = -.5, by = -.5), - d = seq(from = .5, to = -.5, by = -.5), - rho = c(.2, seq(from = -1, to = 1, by = .5)) + Z_on_M = seq(from = .5, to = -.5, by = -.5), + M_on_Y_Z0 = seq(from = .5, to = -.5, by = -.5), + M_on_Y_Z1 = seq(from = .5, to = -.5, by = -.5), + Z_on_Y_M0 = seq(from = .5, to = -.5, by = -.5), + rho = c(.2, seq(from = -1, to = 1, by = .5)), + mediation_package = c(FALSE, TRUE) ) + attr(mediation_analysis_designer,"tips") <- c( N = "Size of sample", - a = "Effect of treatment (Z) on mediator (M)", - b = "Effect of mediator (M) on outcome (Y)", - d = "Direct effect of treatment (Z) on outcome (Y)", - rho = "Correlation of mediator (M) and outcome (Y) error terms" + Z_on_M = "Effect of treatment (Z) on mediator (M)", + M_on_Y_Z0 = "Effect of mediator (M) on outcome (Y) when Z = 0", + M_on_Y_Z1 = "Interaction between mediator (M) and (Z) for outcome (Y)", + Z_on_Y_M0 = "Effect of treatment (Z) on outcome (Y), when M = 0", + rho = "Correlation between mediator (M) and outcome (Y) error terms", + mediation_package = "If 'TRUE' direct and indirect effects are estimated using mediation::mediate()" ) + attr(mediation_analysis_designer,"description") <- "

A mediation analysis design with sample size N that examines the effect of treatment (Z) on mediator (M) and the effect of mediator (M) on @@ -143,5 +272,3 @@ outcome (Y) (given Z=0) as well as direct effect of treatment (Z) on outcome

Error terms on mediator (M) and outcome (Y) correlated by rho " - - diff --git a/tests/testthat/test_designers.R b/tests/testthat/test_designers.R index 5b51cc64..fd56283a 100644 --- a/tests/testthat/test_designers.R +++ b/tests/testthat/test_designers.R @@ -126,8 +126,11 @@ test_that(desc = "two_arm_designer errors when it should", test_that(desc = "mediation_analysis_designer errors when it should", code = { expect_error(mediation_analysis_designer(rho = 10)) + expect_error(mediation_analysis_designer(mediation_package = "true")) }) + + test_that(desc = "spillover_designer errors when it should", code = { expect_error(spillover_designer(sd_i = -10)) From 16966a191d0ceb1e668c1819092adffc079d88f5 Mon Sep 17 00:00:00 2001 From: Lily Medina Date: Wed, 19 Dec 2018 17:41:33 +0100 Subject: [PATCH 2/6] check not passing yet check() --- DESCRIPTION | 5 +++-- NAMESPACE | 3 +++ R/mediation_analysis_designer.R | 29 ++++++++++++++--------------- man/mediation_analysis_designer.Rd | 27 +++++++++++++++------------ tests/testthat.R | 1 + tests/testthat/test_designers.R | 10 ++++++++-- vignettes/mediation_analysis.Rmd | 4 ++-- 7 files changed, 46 insertions(+), 33 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index c17f897c..828c4705 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -27,7 +27,8 @@ Depends: estimatr (>= 0.14.0) Imports: generics, - rlang + rlang, + mediation Suggests: - testthat + testthat, RoxygenNote: 6.1.1 diff --git a/NAMESPACE b/NAMESPACE index 78cfc7d2..00acde2f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -34,6 +34,7 @@ importFrom(DeclareDesign,diagnose_design) importFrom(DeclareDesign,draw_data) importFrom(DeclareDesign,draw_estimands) importFrom(DeclareDesign,draw_estimates) +importFrom(DeclareDesign,get_estimands) importFrom(DeclareDesign,redesign) importFrom(DeclareDesign,set_diagnosands) importFrom(DeclareDesign,tidy_estimator) @@ -47,6 +48,7 @@ importFrom(fabricatr,draw_normal_icc) importFrom(fabricatr,draw_ordered) importFrom(fabricatr,fabricate) importFrom(generics,tidy) +importFrom(mediation,mediate) importFrom(randomizr,conduct_ra) importFrom(randomizr,draw_rs) importFrom(rlang,UQS) @@ -60,6 +62,7 @@ importFrom(rlang,quo_text) importFrom(rlang,quos) importFrom(rlang,sym) importFrom(stats,formula) +importFrom(stats,lm) importFrom(stats,poly) importFrom(stats,qnorm) importFrom(stats,rbinom) diff --git a/R/mediation_analysis_designer.R b/R/mediation_analysis_designer.R index 278d97a7..0aaebb86 100644 --- a/R/mediation_analysis_designer.R +++ b/R/mediation_analysis_designer.R @@ -98,20 +98,18 @@ mediation_analysis_designer <- function(N = 200, # A: Answer Strategy - mediation_analysis_expr <- rlang::expr( - - # QBA: Quasi-Bayesian Approximation - mediation_analysis <- function(data){ + + + + mediate_estimator_expr <- rlang::expr( + mediate_estimator <- declare_estimator(handler = function(data){ + + # QBA: Quasi-Bayesian Approximation e1 <- lm(M ~ Z, data = data) e2 <- lm(Y ~ M + Z + M:Z, data = data) - m <- mediation::mediate(e1, e2, sims = 50, treat = "Z", mediator = "M") - out <- broom::tidy(m, conf.int = TRUE) - out - }) - - mediate_estimator_expr <- rlang::expr( - mediate_estimator <- declare_estimator(handler = function(data){ - estimates <- mediation_analysis(data) + m <- mediate(e1, e2, sims = 100, treat = "Z", mediator = "M") + + estimates <- tidy(m, conf.int = TRUE) estimates <- rbind(estimates, estimates) estimates$estimator_label <- rep(c("qba - indirect_0", "qba - indirect_1", "qba - direct_0", "qba - direct_1") , 2) estimates$estimand_label <- c("natural_indirect_0", "natural_indirect_1", "natural_direct_0", "natural_direct_1", @@ -120,7 +118,8 @@ mediation_analysis_designer <- function(N = 200, estimates$term <- rep(c("indirect_0", "indirect_1", "direct_0", "direct_1"), 2) as.data.frame(estimates) }, - label = "mediate")) + label = "mediate") + ) # Design mediation_design_expr <- rlang::expr( @@ -202,13 +201,13 @@ mediation_analysis_designer <- function(N = 200, estimand = c("natural_direct_1", "controlled_direct_1") ) - rlang::eval_bare(mediation_analysis_expr) + rlang::eval_bare(mediate_estimator_expr) # Design mediation_analysis_design <- rlang::eval_bare(mediation_design_expr) - mediation_analysis_design + }}} diff --git a/man/mediation_analysis_designer.Rd b/man/mediation_analysis_designer.Rd index a8b83fdf..35fcf33f 100644 --- a/man/mediation_analysis_designer.Rd +++ b/man/mediation_analysis_designer.Rd @@ -4,29 +4,31 @@ \alias{mediation_analysis_designer} \title{Create a design for mediation analysis} \usage{ -mediation_analysis_designer(N = 200, a = 1, b = 0.4, c = 0, - d = 0.5, rho = 0) +mediation_analysis_designer(N = 200, Z_on_M = 1, M_on_Y_Z0 = 0.4, + M_on_Y_Z1 = 0, Z_on_Y_M0 = 0.5, rho = 0, + mediation_package = FALSE) } \arguments{ \item{N}{An integer. Size of sample.} -\item{a}{A number. Parameter governing effect of treatment (Z) on mediator (M).} +\item{Z_on_M}{A number. Parameter governing effect of treatment (Z) on mediator (M).} -\item{b}{A number. Effect of mediator (M) on outcome (Y) when Z = 0.} +\item{M_on_Y_Z0}{A number. Effect of mediator (M) on outcome (Y) when Z = 0.} -\item{c}{A number. Interaction between mediator (M) and (Z) for outcome (Y).} +\item{M_on_Y_Z1}{A number. Interaction between mediator (M) and (Z) for outcome (Y).} -\item{d}{A number. Direct effect of treatment (Z) on outcome (Y), when M = 0.} +\item{Z_on_Y_M0}{A number. Effect of treatment (Z) on outcome (Y), when M = 0.} \item{rho}{A number in [-1,1]. Correlation between mediator (M) and outcome (Y) error terms. Non zero correlation implies a violation of sequential ignorability.} + +\item{mediation_package}{A logical value. If 'TRUE' direct and indirect effects are estimated using \code{mediate} function from \code{mediation} package. Default is 'FALSE'.} } \value{ A mediation analysis design. } \description{ -A mediation analysis design that examines the effect of treatment (Z) on mediator (M) and the effect of mediator (M) on outcome (Y) (given Z=0) -as well as direct effect of treatment (Z) on outcome (Y) (given M=0). Analysis is implemented using an interacted regression model. -Note this model is not guaranteed to be unbiased despite randomization of Z because of possible violations of sequential ignorability. +A mediation analysis design that examines the effect of (Z) on mediator (M), the natural and controlled direct effect of treatment (Z) on outcome (Y) as well as the natural and controlled indirect effect of treatment (Z) on outcome (Y) through mediator (M). +Analysis is implemented using a set of two linear structural models: a first stage model and a interacted model. Note estimates are not guaranteed to be unbiased despite randomization of Z because of possible violations of sequential ignorability. } \details{ See \href{https://declaredesign.org/library/articles/mediation_analysis.html}{vignette online}. @@ -34,18 +36,19 @@ See \href{https://declaredesign.org/library/articles/mediation_analysis.html}{vi \examples{ # Generate a mediation analysis design using default arguments: mediation_1 <- mediation_analysis_designer() -draw_estimands(mediation_1) +get_estimands(mediation_1) \dontrun{ diagnose_design(mediation_1, sims = 1000) } # A design with a violation of sequential ignorability and heterogeneous effects: -mediation_2 <- mediation_analysis_designer(a = 1, rho = .5, c = 1, d = .75) -draw_estimands(mediation_2) +mediation_2 <- mediation_analysis_designer(Z_on_M =1, rho = .5, M_on_Y_Z1 = 1, Z_on_Y_M0 =.75) +get_estimands(mediation_2) \dontrun{ diagnose_design(mediation_2, sims = 1000) } + } \author{ \href{https://declaredesign.org/}{DeclareDesign Team} diff --git a/tests/testthat.R b/tests/testthat.R index 66f95a21..d43abf9d 100644 --- a/tests/testthat.R +++ b/tests/testthat.R @@ -1,5 +1,6 @@ library(testthat) library(DesignLibrary) +library(mediation) test_check(package = "DesignLibrary") diff --git a/tests/testthat/test_designers.R b/tests/testthat/test_designers.R index fd56283a..7ad36608 100644 --- a/tests/testthat/test_designers.R +++ b/tests/testthat/test_designers.R @@ -1,6 +1,4 @@ - context(desc = "Testing that designers in the library work as they should") - functions <- ls("package:DesignLibrary") designers <- functions[grepl("_designer\\b",functions)] designers <- designers[!grepl("simple",designers)] @@ -127,9 +125,17 @@ test_that(desc = "mediation_analysis_designer errors when it should", code = { expect_error(mediation_analysis_designer(rho = 10)) expect_error(mediation_analysis_designer(mediation_package = "true")) + }) +test_that(desc = "mediation_analysis_designer with mediate package errors", + code = { + med_design <- mediation_analysis_designer(mediation_package = TRUE) + expect_true("design" %in% class(med_design)) + expect_true( class(draw_estimates(med_design)) == "data.frame") + }) + test_that(desc = "spillover_designer errors when it should", code = { diff --git a/vignettes/mediation_analysis.Rmd b/vignettes/mediation_analysis.Rmd index 4fa861e2..c63989af 100644 --- a/vignettes/mediation_analysis.Rmd +++ b/vignettes/mediation_analysis.Rmd @@ -92,11 +92,11 @@ In R, you can generate a mediation_analysis design using the template function ` library(DesignLibrary) ``` -We can then create specific designs by defining values for each argument. For example, we create a design called `my_mediation_analysis_design` with `N`, `a`, `b`, `d` and `rho` set to 500, .2, .4, .2, and .15, respectively, by running the lines below. +We can then create specific designs by defining values for each argument. For example, we create a design called `my_mediation_analysis_design` with `N`, `Z_on_M `, `M_on_Y_Z0`, `M_on_Y_Z1` and `rho` set to 500, .2, .4, .2, and .15, respectively, by running the lines below. ```{r, eval=FALSE} mediation_analysis_design <- mediation_analysis_designer( - N = 500, a = .2, b = .4, d = .2, rho = .15) + N = 500, Z_on_M = .2, M_on_Y_Z0 = .4, M_on_Y_Z1 = .2, rho = .15) ``` You can see more details on the `mediation_analysis_designer()` function and its arguments by running the following line of code: From cd55d37295b532e973fcc2e45dc4a41a70133757 Mon Sep 17 00:00:00 2001 From: Lily Medina Date: Tue, 15 Jan 2019 17:39:53 +0100 Subject: [PATCH 3/6] tests checks and coverage looking good --- DESCRIPTION | 3 ++- NAMESPACE | 1 + R/mediation_analysis_designer.R | 13 +++++++------ tests/testthat.R | 1 + tests/testthat/test_designers.R | 10 +++++----- 5 files changed, 16 insertions(+), 12 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 828c4705..1840c6ea 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -28,7 +28,8 @@ Depends: Imports: generics, rlang, - mediation + mediation, + broom (>= 0.5.0.9) Suggests: testthat, RoxygenNote: 6.1.1 diff --git a/NAMESPACE b/NAMESPACE index 00acde2f..cda09ae4 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -38,6 +38,7 @@ importFrom(DeclareDesign,get_estimands) importFrom(DeclareDesign,redesign) importFrom(DeclareDesign,set_diagnosands) importFrom(DeclareDesign,tidy_estimator) +importFrom(broom,tidy) importFrom(estimatr,difference_in_means) importFrom(estimatr,iv_robust) importFrom(estimatr,lm_robust) diff --git a/R/mediation_analysis_designer.R b/R/mediation_analysis_designer.R index 0aaebb86..f184b86e 100644 --- a/R/mediation_analysis_designer.R +++ b/R/mediation_analysis_designer.R @@ -24,6 +24,7 @@ #' @importFrom mediation mediate #' @importFrom stats lm #' @importFrom estimatr tidy lm_robust +#' @importFrom broom tidy #' @export #' @examples #' # Generate a mediation analysis design using default arguments: @@ -98,11 +99,11 @@ mediation_analysis_designer <- function(N = 200, # A: Answer Strategy - - mediate_estimator_expr <- rlang::expr( - mediate_estimator <- declare_estimator(handler = function(data){ + + mediate_estimator_expr <- rlang::expr( + mediate_estimator <- declare_estimator(handler = function(data){ # QBA: Quasi-Bayesian Approximation e1 <- lm(M ~ Z, data = data) @@ -118,8 +119,8 @@ mediation_analysis_designer <- function(N = 200, estimates$term <- rep(c("indirect_0", "indirect_1", "direct_0", "direct_1"), 2) as.data.frame(estimates) }, - label = "mediate") - ) + label = "mediate") + ) # Design mediation_design_expr <- rlang::expr( @@ -207,7 +208,7 @@ mediation_analysis_designer <- function(N = 200, # Design mediation_analysis_design <- rlang::eval_bare(mediation_design_expr) - + }}} diff --git a/tests/testthat.R b/tests/testthat.R index d43abf9d..ef196d6d 100644 --- a/tests/testthat.R +++ b/tests/testthat.R @@ -1,5 +1,6 @@ library(testthat) library(DesignLibrary) +library(DeclareDesign) library(mediation) test_check(package = "DesignLibrary") diff --git a/tests/testthat/test_designers.R b/tests/testthat/test_designers.R index 7ad36608..c345c052 100644 --- a/tests/testthat/test_designers.R +++ b/tests/testthat/test_designers.R @@ -123,17 +123,17 @@ test_that(desc = "two_arm_designer errors when it should", test_that(desc = "mediation_analysis_designer errors when it should", code = { - expect_error(mediation_analysis_designer(rho = 10)) - expect_error(mediation_analysis_designer(mediation_package = "true")) - - }) + expect_error(mediation_analysis_designer(rho = 10)) + expect_error(mediation_analysis_designer(mediation_package = "true")) + + }) test_that(desc = "mediation_analysis_designer with mediate package errors", code = { med_design <- mediation_analysis_designer(mediation_package = TRUE) expect_true("design" %in% class(med_design)) - expect_true( class(draw_estimates(med_design)) == "data.frame") + expect_true("data.frame" %in% class(draw_estimates(med_design))) }) From 75ba9606c4d23d292e66502dbc5afdb54f5a3b3c Mon Sep 17 00:00:00 2001 From: Lily Medina Date: Wed, 16 Jan 2019 10:22:34 +0100 Subject: [PATCH 4/6] suggest mediation --- .travis.yml | 2 +- DESCRIPTION | 2 +- NAMESPACE | 2 -- R/mediation_analysis_designer.R | 10 +++++----- man/mediation_analysis_designer.Rd | 4 ++-- 5 files changed, 9 insertions(+), 11 deletions(-) diff --git a/.travis.yml b/.travis.yml index f8df881e..006c5c74 100644 --- a/.travis.yml +++ b/.travis.yml @@ -13,7 +13,7 @@ matrix: - DeclareDesign/DeclareDesign - os: linux - r: 3.4 + r: 3.5 after_success: - echo skipping source packaging on linux/oldrel r_github_packages: diff --git a/DESCRIPTION b/DESCRIPTION index 1840c6ea..41d7494d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -28,8 +28,8 @@ Depends: Imports: generics, rlang, - mediation, broom (>= 0.5.0.9) Suggests: testthat, + mediation RoxygenNote: 6.1.1 diff --git a/NAMESPACE b/NAMESPACE index cda09ae4..45c09624 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -34,7 +34,6 @@ importFrom(DeclareDesign,diagnose_design) importFrom(DeclareDesign,draw_data) importFrom(DeclareDesign,draw_estimands) importFrom(DeclareDesign,draw_estimates) -importFrom(DeclareDesign,get_estimands) importFrom(DeclareDesign,redesign) importFrom(DeclareDesign,set_diagnosands) importFrom(DeclareDesign,tidy_estimator) @@ -49,7 +48,6 @@ importFrom(fabricatr,draw_normal_icc) importFrom(fabricatr,draw_ordered) importFrom(fabricatr,fabricate) importFrom(generics,tidy) -importFrom(mediation,mediate) importFrom(randomizr,conduct_ra) importFrom(randomizr,draw_rs) importFrom(rlang,UQS) diff --git a/R/mediation_analysis_designer.R b/R/mediation_analysis_designer.R index f184b86e..31d6f0e9 100644 --- a/R/mediation_analysis_designer.R +++ b/R/mediation_analysis_designer.R @@ -18,10 +18,9 @@ #' @author \href{https://declaredesign.org/}{DeclareDesign Team} #' @concept experiment #' @concept mediation -#' @importFrom DeclareDesign declare_assignment declare_estimands declare_estimator declare_population declare_potential_outcomes declare_reveal declare_step diagnose_design get_estimands +#' @importFrom DeclareDesign declare_assignment declare_estimands declare_estimator declare_population declare_potential_outcomes declare_reveal declare_step diagnose_design draw_estimands #' @importFrom fabricatr fabricate fabricate #' @importFrom randomizr conduct_ra -#' @importFrom mediation mediate #' @importFrom stats lm #' @importFrom estimatr tidy lm_robust #' @importFrom broom tidy @@ -29,14 +28,14 @@ #' @examples #' # Generate a mediation analysis design using default arguments: #' mediation_1 <- mediation_analysis_designer() -#' get_estimands(mediation_1) +#' draw_estimands(mediation_1) #' \dontrun{ #' diagnose_design(mediation_1, sims = 1000) #' } #' #' # A design with a violation of sequential ignorability and heterogeneous effects: #' mediation_2 <- mediation_analysis_designer(Z_on_M =1, rho = .5, M_on_Y_Z1 = 1, Z_on_Y_M0 =.75) -#' get_estimands(mediation_2) +#' draw_estimands(mediation_2) #' \dontrun{ #' diagnose_design(mediation_2, sims = 1000) #' } @@ -81,6 +80,7 @@ mediation_analysis_designer <- function(N = 200, ) if(mediation_package){ + stopifnot(requireNamespace("mediation")) # I: Inquiry estimands_expr <- rlang::expr( @@ -108,7 +108,7 @@ mediation_analysis_designer <- function(N = 200, # QBA: Quasi-Bayesian Approximation e1 <- lm(M ~ Z, data = data) e2 <- lm(Y ~ M + Z + M:Z, data = data) - m <- mediate(e1, e2, sims = 100, treat = "Z", mediator = "M") + m <- mediation::mediate(e1, e2, sims = 100, treat = "Z", mediator = "M") estimates <- tidy(m, conf.int = TRUE) estimates <- rbind(estimates, estimates) diff --git a/man/mediation_analysis_designer.Rd b/man/mediation_analysis_designer.Rd index 35fcf33f..2aeaa5e3 100644 --- a/man/mediation_analysis_designer.Rd +++ b/man/mediation_analysis_designer.Rd @@ -36,14 +36,14 @@ See \href{https://declaredesign.org/library/articles/mediation_analysis.html}{vi \examples{ # Generate a mediation analysis design using default arguments: mediation_1 <- mediation_analysis_designer() -get_estimands(mediation_1) +draw_estimands(mediation_1) \dontrun{ diagnose_design(mediation_1, sims = 1000) } # A design with a violation of sequential ignorability and heterogeneous effects: mediation_2 <- mediation_analysis_designer(Z_on_M =1, rho = .5, M_on_Y_Z1 = 1, Z_on_Y_M0 =.75) -get_estimands(mediation_2) +draw_estimands(mediation_2) \dontrun{ diagnose_design(mediation_2, sims = 1000) } From 21109b7f77134b3bc637b45feeb07d2fc09da5a4 Mon Sep 17 00:00:00 2001 From: Lily Medina Date: Tue, 22 Jan 2019 16:27:55 +0100 Subject: [PATCH 5/6] namespace --- tests/testthat/test_designers.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test_designers.R b/tests/testthat/test_designers.R index c345c052..193909c3 100644 --- a/tests/testthat/test_designers.R +++ b/tests/testthat/test_designers.R @@ -123,6 +123,7 @@ test_that(desc = "two_arm_designer errors when it should", test_that(desc = "mediation_analysis_designer errors when it should", code = { + expect_error(mediation_analysis_designer(rho = 10)) expect_error(mediation_analysis_designer(mediation_package = "true")) @@ -131,9 +132,10 @@ test_that(desc = "mediation_analysis_designer errors when it should", test_that(desc = "mediation_analysis_designer with mediate package errors", code = { + if(isNamespaceLoaded("mediation")) { med_design <- mediation_analysis_designer(mediation_package = TRUE) expect_true("design" %in% class(med_design)) - expect_true("data.frame" %in% class(draw_estimates(med_design))) + expect_true("data.frame" %in% class(draw_estimates(med_design)))} }) From e45b9ee7cf96c73cb299c1b55657ca8c61e93605 Mon Sep 17 00:00:00 2001 From: Lily Medina Date: Mon, 11 Feb 2019 17:25:30 +0100 Subject: [PATCH 6/6] solve mediation conflicts manually --- R/mediation_analysis_designer.R | 24 ++++++++++++++++-------- 1 file changed, 16 insertions(+), 8 deletions(-) diff --git a/R/mediation_analysis_designer.R b/R/mediation_analysis_designer.R index 31d6f0e9..36dac55b 100644 --- a/R/mediation_analysis_designer.R +++ b/R/mediation_analysis_designer.R @@ -252,14 +252,22 @@ attr(mediation_analysis_designer,"shiny_arguments") <- list( mediation_package = c(FALSE, TRUE) ) -attr(mediation_analysis_designer,"tips") <- c( - N = "Size of sample", - Z_on_M = "Effect of treatment (Z) on mediator (M)", - M_on_Y_Z0 = "Effect of mediator (M) on outcome (Y) when Z = 0", - M_on_Y_Z1 = "Interaction between mediator (M) and (Z) for outcome (Y)", - Z_on_Y_M0 = "Effect of treatment (Z) on outcome (Y), when M = 0", - rho = "Correlation between mediator (M) and outcome (Y) error terms", - mediation_package = "If 'TRUE' direct and indirect effects are estimated using mediation::mediate()" + +attr(mediation_analysis_designer,"definitions") <- data.frame( + names = c("N", "Z_on_M", "M_on_Y_Z0 ", "M_on_Y_Z1", "Z_on_Y_M0", "rho", "mediation_package"), + tips = c("Size of sample", + "Effect of treatment (Z) on mediator (M)", + "Effect of mediator (M) on outcome (Y) when Z = 0.", + "Interaction between mediator (M) and (Z) for outcome (Y)", + "Effect of treatment (Z) on outcome (Y), when M = 0", + "Correlation of mediator (M) and outcome (Y) error terms", + "If 'TRUE' direct and indirect effects are estimated using mediation::mediate()"), + class = c("integer", rep("numeric", 5), "logical"), + min = c(1, rep(-Inf, 4), -1, 0), + max = c(1, rep(Inf, 4), 1, 1), + inspector_min = c(100, rep(0, 4), -1, 0), + inspector_step = c(50, 0.1, .2, 0.3, 0.4, 0.2, 0), + stringsAsFactors = FALSE ) attr(mediation_analysis_designer,"description") <- "