tests/testthat/test-expand-design.R

In DeclareDesign/DeclareDesign: Declare and Diagnose Research Designs

context("functions in designers")

test_that("simple designer works", {
  my_designer <- function(N = 100,
                            my_inquiry_func = mean) {
    my_pop <- declare_model(N = N, Y = rnorm(N))
    my_inquiry <- declare_inquiry(inquiry = my_inquiry_func(Y))
    my_design <- my_pop + my_inquiry
    my_design
  }

  expect_length(design_list <-
    expand_design(
      designer = my_designer,
      N = c(c(20, 20, 20), c(20, 20, 20), c(20, 20, 20)),
      my_inquiry_func = c(mean, median)
    ), 18)

  expect_length(design_list <-
    expand_design(
      designer = my_designer,
      N = c(10, 50, 100),
      my_inquiry_func = c(mean, median)
    ), 6)

  expect_length(design_list <-
    expand_design(
      designer = my_designer,
      N = c(10, 50, 100),
      my_inquiry_func = list(mean, median)
    ), 6)


  expect_length(design_list <-
    expand_design(
      designer = my_designer,
      N = c(10, 50, 100),
      my_inquiry_func = mean
    ), 3)
})


test_that("designer with vector argument works", {
  my_designer <- function(N = c(100, 50),
                            my_inquiry_func = mean) {
    my_pop <- declare_model(N = min(N), Y = rnorm(N))
    my_inquiry <- declare_inquiry(inquiry = my_inquiry_func(Y))
    my_design <- my_pop + my_inquiry
    my_design
  }

  expect_length(design_list <-
    expand_design(
      designer = my_designer,
      N = list(c(20, 20, 20), c(20, 20, 20), c(20, 20, 20)),
      my_inquiry_func = c(mean, median)
    ), 6)
})




context("functions in designers")

my_designer <- function(N = 100,
                        my_inquiry_func = mean) {
  my_pop <- declare_model(N = N, Y = rnorm(N))
  my_inquiry <- declare_inquiry(inquiry = my_inquiry_func(Y))
  my_design <- my_pop + my_inquiry
  my_design
}


test_that("expand_design works", {
  design_list <-
    expand_design(
      designer = my_designer,
      N = c(c(20, 20, 20), c(20, 20, 20), c(20, 20, 20)),
      my_inquiry_func = c(mean, median)
    )
  diag <- diagnose_design(design_list, sims = 5, bootstrap_sims = FALSE)
  expect_true(all(c("N", "my_inquiry_func") %in% names(diag$diagnosands_df)))

  design_list <-
    expand_design(
      designer = my_designer,
      N = c(10, 50, 100),
      my_inquiry_func = c(mean, median)
    )
  diag <- diagnose_design(design_list, sims = 5, bootstrap_sims = FALSE)
  expect_true(all(c("N", "my_inquiry_func") %in% names(diag$diagnosands_df)))

  design_list <-
    expand_design(
      designer = my_designer,
      N = c(10, 50, 100),
      my_inquiry_func = list(mean, median)
    )
  diag <- diagnose_design(design_list, sims = 5, bootstrap_sims = FALSE)
  expect_true(all(c("N", "my_inquiry_func") %in% names(diag$diagnosands_df)))


  design_list <-
    expand_design(
      designer = my_designer,
      N = c(10, 50, 100),
      my_inquiry_func = mean
    )

  diag <- diagnose_design(design_list, sims = 5, bootstrap_sims = FALSE)
  expect_true(all(c("N", "my_inquiry_func") %in% names(diag$diagnosands_df)))
})


test_that("even more kinds of parameters can be sent, vectors and scalars, etc.", {
  my_designer <- function(N, ate) {
    pop <- declare_model(N = N, noise = rnorm(N))
    pos <- declare_model(Y ~ ate * Z + noise)
    assgn <- declare_assignment(Z = complete_ra(N, m = N / 2))
    inquiry <- declare_inquiry(ATE = mean(Y_Z_1 - Y_Z_0))
    estimator <- declare_estimator(Y ~ Z, inquiry = inquiry)
    pop + pos + assgn + inquiry + estimator
  }

  designs <- expand_design(my_designer, N = seq(30, 100, 10), ate = seq(0, .5, length.out = 3))
  expect_equal(sapply(designs, attr, "parameters"), structure(list(
    "30", "0", "40", "0", "50", "0", "60", "0", "70",
    "0", "80", "0", "90", "0", "100", "0", "30", "0.25", "40",
    "0.25", "50", "0.25", "60", "0.25", "70", "0.25", "80", "0.25",
    "90", "0.25", "100", "0.25", "30", "0.5", "40", "0.5", "50",
    "0.5", "60", "0.5", "70", "0.5", "80", "0.5", "90", "0.5",
    "100", "0.5"
  ), .Dim = c(2L, 24L), .Dimnames = list(c(
    "N",
    "ate"
  ), c(
    "design_1", "design_2", "design_3", "design_4", "design_5",
    "design_6", "design_7", "design_8", "design_9", "design_10",
    "design_11", "design_12", "design_13", "design_14", "design_15",
    "design_16", "design_17", "design_18", "design_19", "design_20",
    "design_21", "design_22", "design_23", "design_24"
  ))))


  my_designer <- function(N = 100,
                            my_inquiry_func = mean) {
    my_pop <- declare_model(N = N, Y = rnorm(N))
    my_inquiry <- declare_inquiry(inquiry = my_inquiry_func(Y))
    my_design <- my_pop + my_inquiry
    my_design
  }

  design_list <-
    expand_design(
      designer = my_designer,
      N = c(10, 50, 100),
      my_inquiry_func = c(mean, median)
    )

  expect_equal(sapply(design_list, attr, "parameters"), structure(list(
    "10", "mean", "50", "mean", "100", "mean", "10",
    "median", "50", "median", "100", "median"
  ), .Dim = c(
    2L,
    6L
  ), .Dimnames = list(c("N", "my_inquiry_func"), c(
    "design_1",
    "design_2", "design_3", "design_4", "design_5", "design_6"
  ))))

  design_list <-
    expand_design(
      designer = my_designer,
      N = c(10, 50, 100),
      my_inquiry_func = 10
    )

  expect_equal(sapply(design_list, attr, "parameters"), structure(list("10", "10", "50", "10", "100", "10"), .Dim = 2:3, .Dimnames = list(
    c("N", "my_inquiry_func"), c("design_1", "design_2", "design_3")
  )))

  design_list <-
    expand_design(
      designer = my_designer,
      N = c(10, 50, 100),
      my_inquiry_func = mean
    )

  expect_equal(sapply(design_list, attr, "parameters"), structure(list("10", "mean", "50", "mean", "100", "mean"), .Dim = 2:3, .Dimnames = list(
    c("N", "my_inquiry_func"), c("design_1", "design_2", "design_3")
  )))
})


test_that("edge case with expand but one arg works", {
  
  my_designer <- function(N = 100,
                          my_inquiry_func = mean) {
    my_pop <- declare_model(N = N, Y = rnorm(N))
    my_inquiry <- declare_inquiry(inquiry = my_inquiry_func(Y))
    my_design <- my_pop + my_inquiry
    my_design
  }
  
  expect_length(expand_design(
                    designer = my_designer, N = 5), 2)
  expect_length(expand_design(
    designer = my_designer, N = 5, expand = FALSE), 2)
})

test_that("expand with vector arguments", {
  
  my_designer <- function(N=10, z = list(1,5,9)) {
    my_pop <- declare_model(top=add_level(N = length(z), z=unlist(z)), 
                                 bottom=add_level(N=z, Y = rnorm(N)))
    my_inquiry <- declare_inquiry(inquiry = max(table(top)))
    my_design <- my_pop + my_inquiry
    my_design
  }
  
  expect_equal(
    draw_estimands(expand_design(my_designer, z=list(2)))$estimand, 2)
  
  
  zx <- list(1:4, 2:10, 9:1, list(4,9,2))
  
  dsns <- expand_design(my_designer, z=zx)
  
  expect_equivalent(
    unlist(sapply(dsns, draw_estimands)[2,]),
    sapply(zx, function(x)max(unlist(x)))
  )
  
})