Skip to content

Commit

Permalink
importFrom
Browse files Browse the repository at this point in the history
  • Loading branch information
acoppock committed Aug 23, 2018
1 parent b828f19 commit 4385a98
Show file tree
Hide file tree
Showing 18 changed files with 32 additions and 45 deletions.
2 changes: 0 additions & 2 deletions DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -28,8 +28,6 @@ Depends:
Imports:
rlang
Suggests:
methods,
devtools,
knitr,
testthat,
ggplot2,
Expand Down
4 changes: 3 additions & 1 deletion R/DesignLibrary.R
Original file line number Diff line number Diff line change
Expand Up @@ -6,10 +6,12 @@
#'
#' @name DesignLibrary
#'
#' @importFrom utils globalVariables
#'
#'


utils::globalVariables(
globalVariables(
names = c(
"A",
"B",
Expand Down
8 changes: 4 additions & 4 deletions R/block_cluster_two_arm_designer.R
Original file line number Diff line number Diff line change
Expand Up @@ -32,7 +32,7 @@
#' @author \href{https://declaredesign.org/}{DeclareDesign Team}
#' @concept experiment
#' @concept blocking
#' @import DeclareDesign stats utils fabricatr estimatr randomizr
#' @importFrom rlang is_integerish
#' @export
#' @examples
#' # Generate a design using default arguments:
Expand All @@ -54,9 +54,9 @@ block_cluster_two_arm_designer <- function(N_blocks = 1,
treatment_mean = control_mean + ate
){
if(any(N_blocks < 1, N_clusters_in_block < 1, N_i_in_cluster < 1) ||
any(!rlang::is_integerish(N_blocks),
!rlang::is_integerish(N_clusters_in_block),
!rlang::is_integerish(N_i_in_cluster))) stop("N_* arguments must be positive integers")
any(!is_integerish(N_blocks),
!is_integerish(N_clusters_in_block),
!is_integerish(N_i_in_cluster))) stop("N_* arguments must be positive integers")
if(sd_block < 0) stop("sd_block must be nonnegative")
if(sd_cluster < 0) stop("sd_cluster must be nonnegative")
if(sd_i_0 < 0) stop("sd_i_0 must be nonnegative")
Expand Down
1 change: 0 additions & 1 deletion R/cluster_sampling_designer.R
Original file line number Diff line number Diff line change
Expand Up @@ -18,7 +18,6 @@
#' @concept clusters
#' @concept observational
#' @concept measurement
#' @import DeclareDesign stats utils fabricatr estimatr randomizr
#' @export
#' @examples
#' # To make a design using default arguments:
Expand Down
34 changes: 17 additions & 17 deletions R/factorial_designer.R
Original file line number Diff line number Diff line change
Expand Up @@ -17,8 +17,8 @@
#'
#' @author \href{https://declaredesign.org/}{DeclareDesign Team}
#' @concept factorial
#' @importFrom rlang is_integerish expr quos sym parse_expr UQS eval_bare
#' @export
#' @import rlang
#' @examples
#'
#' # A factorial design using default arguments
Expand All @@ -45,7 +45,7 @@ factorial_designer <- function(
if(any(grepl(" ", fixed = TRUE, outcome_name))) stop("Please remove spaces from `outcome_name' strings.")
if(length(outcome_means) != 2^k || length(outcome_sds) != 2^k) stop("`outcome_means' and `outcome_sds` arguments must be the same as length of 2^(k).")
if(length(probs) != k) stop("`probs` must be the same as length of k.")
if(k < 2 || !rlang::is_integerish(k)) stop("`k' should be a positive integer > 1.")
if(k < 2 || !is_integerish(k)) stop("`k' should be a positive integer > 1.")
if(any(outcome_sds<0)) stop("`outcome_sds' should be nonnegative.")
if(any(probs <= 0)) stop("`probs' should have positive values only.")

Expand Down Expand Up @@ -80,32 +80,32 @@ factorial_designer <- function(
outcome_sds_ <- outcome_sds; means_ <- outcome_means; probs_ <- probs; N_ <- N; k_ <- k

if(is.null(fixed)) fixed <- ""
if(!"outcome_sds" %in% fixed) outcome_sds_ <- sapply(1:length(outcome_sds), function(i) rlang::expr(outcome_sds[!!i]))
if(!"outcome_means" %in% fixed) outcome_means_ <- sapply(1:length(outcome_means), function(i) rlang::expr(outcome_means[!!i]))
if(!"N" %in% fixed) N_ <- rlang::expr(N)
if(!"outcome_sds" %in% fixed) outcome_sds_ <- sapply(1:length(outcome_sds), function(i) expr(outcome_sds[!!i]))
if(!"outcome_means" %in% fixed) outcome_means_ <- sapply(1:length(outcome_means), function(i) expr(outcome_means[!!i]))
if(!"N" %in% fixed) N_ <- expr(N)


# population --------------------------------------------------------------
population_expr <- rlang::expr(declare_population(!!N_))
population_expr <- expr(declare_population(!!N_))

# potential outcomes ------------------------------------------------------
potouts <- sapply(1:length(outcome_means),
function(i) rlang::quos(!!outcome_means_[[i]] + rnorm(!!N_, 0, !!outcome_sds_[[i]])))
function(i) quos(!!outcome_means_[[i]] + rnorm(!!N_, 0, !!outcome_sds_[[i]])))
names_pos <- paste0(outcome_name, "_", assignment_string)
names(potouts) <- names_pos

potentials_expr <- rlang::expr(declare_potential_outcomes(!!!(potouts)))
potentials_expr <- expr(declare_potential_outcomes(!!!(potouts)))

# assignment --------------------------------------------------------------
Z <- rlang::sym("Z")
assignment_given_factor <- sapply(1:length(cond_row), function(i) rlang::quos(as.numeric(!!Z %in% !!cond_row[[i]])))
Z <- sym("Z")
assignment_given_factor <- sapply(1:length(cond_row), function(i) quos(as.numeric(!!Z %in% !!cond_row[[i]])))
names(assignment_given_factor) <- treatment_names

assignment_expr1 <- rlang::expr(declare_assignment(conditions = 1:(2^!!k_), prob_each = !!prob_each))
assignment_expr2 <- rlang::expr(declare_step(fabricate, !!!assignment_given_factor))
assignment_expr1 <- expr(declare_assignment(conditions = 1:(2^!!k_), prob_each = !!prob_each))
assignment_expr2 <- expr(declare_step(fabricate, !!!assignment_given_factor))

# reveal outcomes ---------------------------------------------------------
reveal_expr <- rlang::expr(declare_reveal(
reveal_expr <- expr(declare_reveal(
handler = function(data){
potential_cols <- mapply(paste, data[, !!treatment_names, drop = FALSE], sep = "_", SIMPLIFY = FALSE)
potential_cols <- do.call(paste, c(!!outcome_name, potential_cols, sep = "_"))
Expand Down Expand Up @@ -150,15 +150,15 @@ factorial_designer <- function(

d <- interaction(k)
estimand_operations <- apply(d[,(k+2):ncol(d)], 2, function(col) paste(col, "*", d$PO, collapse = " + "))
estimand_preexpr <- sapply(1:2^k, function(i) rlang::expr(mean(!!rlang::parse_expr(estimand_operations[i]))))
estimand_preexpr <- sapply(1:2^k, function(i) expr(mean(!!parse_expr(estimand_operations[i]))))
names(estimand_preexpr) <- names(estimand_operations)
estimand_expr <- rlang::expr(declare_estimand(rlang::UQS(estimand_preexpr), label = "ATE"))

estimand_expr <- expr(declare_estimand(UQS(estimand_preexpr), label = "ATE"))

# estimators --------------------------------------------------------------
estimator_formula <- formula(paste0(outcome_name, " ~ ", paste(treatment_names, collapse = "*")))

estimator_expr <- rlang::expr(
estimator_expr <- expr(
declare_estimator(
handler = tidy_estimator(function(data){
data[, names(data) %in% !!treatment_names] <- data[, names(data) %in% !!treatment_names] - 0.5
Expand Down
1 change: 0 additions & 1 deletion R/mediation_analysis_designer.R
Original file line number Diff line number Diff line change
Expand Up @@ -18,7 +18,6 @@
#' @author \href{https://declaredesign.org/}{DeclareDesign Team}
#' @concept experiment
#' @concept mediation
#' @import DeclareDesign stats utils fabricatr estimatr randomizr
#' @export
#' @examples
#' # Generate a mediation analysis design using default arguments:
Expand Down
3 changes: 1 addition & 2 deletions R/multi_arm_designer.R
Original file line number Diff line number Diff line change
Expand Up @@ -17,7 +17,6 @@
#' @author \href{https://declaredesign.org/}{DeclareDesign Team}
#' @concept experiment
#' @concept multiarm trial
#' @import DeclareDesign stats utils fabricatr estimatr randomizr rlang
#' @export
#' @examples
#'
Expand Down Expand Up @@ -64,7 +63,7 @@ multi_arm_designer <- function(N = 30,
conditions <- as.character(conditions)

f_Y <- formula(
paste0("Y ~ ",paste0(
paste0("Y ~ ", paste0(
"(", outcome_means_, " + ", error_names,
")*( Z == '", conditions, "')",
collapse = " + "), "+ u"))
Expand Down
1 change: 0 additions & 1 deletion R/pretest_posttest_designer.R
Original file line number Diff line number Diff line change
Expand Up @@ -18,7 +18,6 @@
#' @concept experiment
#' @concept difference-in-differences
#' @concept baseline
#' @import DeclareDesign stats utils fabricatr estimatr randomizr
#' @export
#' @examples
#' # Generate a pre-test post-test design using default arguments:
Expand Down
8 changes: 4 additions & 4 deletions R/process_tracing_designer.R
Original file line number Diff line number Diff line change
Expand Up @@ -34,7 +34,7 @@
#' @author \href{https://declaredesign.org/}{DeclareDesign Team}
#' @concept qualitative
#' @concept process tracing
#' @import DeclareDesign stats utils fabricatr estimatr randomizr
#' @importFrom rlang is_integerish is_character
#' @export
#' @examples
#' # Generate a process-tracing design using default arguments:
Expand Down Expand Up @@ -77,7 +77,7 @@ process_tracing_designer <- function(
label_E1 = "Smoking Gun",
label_E2 = "Straw in the Wind"
){
if(!rlang::is_integerish(N) || N < 1) stop("N must be a positive integer.")
if(!is_integerish(N) || N < 1) stop("N must be a positive integer.")
if(prob_X < 0 || prob_X > 1) stop("prob_X must be in [0,1].")
if(length(process_proportions) != 4) stop("process_proportions must be of length 4.")
if(sum(process_proportions) != 1 || any(process_proportions < 0) || any(process_proportions> 1)) stop("process_proportions must be a 3-simplex.")
Expand All @@ -93,8 +93,8 @@ process_tracing_designer <- function(
c((1 - p1) * (1 - p2) + r,p2 * (1 - p1) - r, p1 * (1 - p2) - r, p1 * p2 + r)}
if(min(test_prob(p_E1_H, p_E2_H, cor_E1E2_H)) < 0) stop("Correlation coefficient not compatible with probabilities")
if(min(test_prob(p_E1_not_H, p_E2_not_H, cor_E1E2_not_H)) < 0) stop("Correlation coefficient not compatible with probabilities")
if(!rlang::is_character(label_E1) || length(label_E1) > 1) stop("label_E1 must be a character of length 1.")
if(!rlang::is_character(label_E2) || length(label_E2) > 1) stop("label_E2 must be a character of length 1.")
if(!is_character(label_E1) || length(label_E1) > 1) stop("label_E1 must be a character of length 1.")
if(!is_character(label_E2) || length(label_E2) > 1) stop("label_E2 must be a character of length 1.")
{{{
# M: Model
population <- declare_population(
Expand Down
1 change: 0 additions & 1 deletion R/randomized_response_designer.R
Original file line number Diff line number Diff line change
Expand Up @@ -15,7 +15,6 @@
#' @author \href{https://declaredesign.org/}{DeclareDesign Team}
#' @concept experiment
#' @concept descriptive
#' @import DeclareDesign stats utils fabricatr estimatr randomizr
#' @export
#'
#' @examples
Expand Down
4 changes: 2 additions & 2 deletions R/regression_discontinuity_designer.R
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,7 @@
#' @author \href{https://declaredesign.org/}{DeclareDesign Team}
#' @concept observational
#' @concept regression discontinuity
#' @import DeclareDesign stats utils fabricatr estimatr randomizr
#' @importFrom rlang is_integerish
#' @export
#' @examples
#' # Generate a regression discontinuity design using default arguments:
Expand All @@ -34,7 +34,7 @@ regression_discontinuity_designer <- function(
){
if(cutoff <= 0 || cutoff >= 1) stop("cutoff must be in (0,1).")
if(poly_reg_order < 1) stop("poly_reg_order must be at least 1.")
if(!rlang::is_integerish(poly_reg_order)) stop("poly_reg_order must be an integer.")
if(!is_integerish(poly_reg_order)) stop("poly_reg_order must be an integer.")
if(length(control_coefs) < 1) stop("control_coefs must be a numeric vector of length > 0.")
if(length(treatment_coefs) < 1) stop("treatment_coefs must be a numeric vector of length > 0.")
if(outcome_sd < 0) stop("outcome_sd must be positive.")
Expand Down
1 change: 0 additions & 1 deletion R/simple_factorial_designer.R
Original file line number Diff line number Diff line change
Expand Up @@ -27,7 +27,6 @@
#' @return A two-by-two factorial design.
#' @author \href{https://declaredesign.org/}{DeclareDesign Team}
#' @concept experiment factorial
#' @import DeclareDesign stats utils fabricatr estimatr randomizr
#' @export
#'
#' @examples
Expand Down
1 change: 0 additions & 1 deletion R/simple_iv_designer.R
Original file line number Diff line number Diff line change
Expand Up @@ -19,7 +19,6 @@
#' @return A simple instrumental variables design.
#' @author \href{https://declaredesign.org/}{DeclareDesign Team}
#' @concept experiment
#' @import DeclareDesign stats utils fabricatr estimatr randomizr
#' @export
#'
#' @examples
Expand Down
1 change: 0 additions & 1 deletion R/simple_spillover_designer.R
Original file line number Diff line number Diff line change
Expand Up @@ -21,7 +21,6 @@
#' @author \href{https://declaredesign.org/}{DeclareDesign Team}
#' @concept experiment
#' @concept spillovers
#' @import DeclareDesign stats utils fabricatr estimatr randomizr
#' @export
#' @examples
#' # Generate a simple spillover design using default arguments:
Expand Down
1 change: 0 additions & 1 deletion R/simple_two_arm_designer.R
Original file line number Diff line number Diff line change
Expand Up @@ -20,7 +20,6 @@
#' @return A simple two-arm design.
#' @author \href{https://declaredesign.org/}{DeclareDesign Team}
#' @concept experiment
#' @import DeclareDesign stats utils fabricatr estimatr randomizr
#' @export
#'
#' @examples
Expand Down
1 change: 0 additions & 1 deletion R/two_arm_attrition_designer.R
Original file line number Diff line number Diff line change
Expand Up @@ -22,7 +22,6 @@
#' @return A post-treatment design.
#' @author \href{https://declaredesign.org/}{DeclareDesign Team}
#' @concept post-treatment
#' @import DeclareDesign stats utils fabricatr estimatr randomizr
#' @export
#' @examples
#' # To make a design using default argument (missing completely at random):
Expand Down
1 change: 0 additions & 1 deletion tests/testthat/test_designers.R
Original file line number Diff line number Diff line change
@@ -1,7 +1,6 @@

context(desc = "Testing that designers in the library work as they should")


functions <- ls("package:DesignLibrary")
designers <- functions[grepl("_designer\\b",functions)]

Expand Down
4 changes: 1 addition & 3 deletions tests/testthat/test_helpers.R
Original file line number Diff line number Diff line change
@@ -1,9 +1,7 @@
context(desc = "Testing that helpers in the library work as they should")



testthat::test_that(
desc = paste0("functions can be passed to designer and returned by construct_design_code"),
desc = "functions can be passed to designer and returned by construct_design_code",
code = {

test_designer <- function(summary_function,N){
Expand Down

0 comments on commit 4385a98

Please sign in to comment.