tests/testthat/test-model.R

In DeclareDesign/DeclareDesign: Declare and Diagnose Research Designs

context("model estimator")
library(DeclareDesign)
library(testthat)

my_population <- declare_model(N = 500, noise = rnorm(N))
my_potential_outcomes <-
  declare_potential_outcomes(
    Y_Z_0 = draw_binary(latent = noise, link = "probit"),
    Y_Z_1 = draw_binary(latent = noise + 2, link = "probit")
  )
my_assignment <- declare_assignment(Z = complete_ra(N, prob = 0.5))
my_measurement <- declare_measurement(Y = reveal_outcomes(Y ~ Z)) 
my_design <- my_population +
  my_potential_outcomes +
  my_assignment +
  my_measurement
dat <- draw_data(my_design)

test_that("test default term Z, lm", {
  # lm
  estimator_lm <-
    declare_estimator(Y ~ Z, .method = lm, term = "Z")
  estimator_lm_nocoef <- declare_estimator(Y ~ Z, .method = lm)

  expect_equal(
    estimator_lm(dat),
    estimator_lm_nocoef(dat)
  )

  estimator_lm_robust <-
    declare_estimator(Y ~ Z,
      .method = lm_robust,
      term = "Z"
    )
  expect_equivalent(
    estimator_lm(dat),
    estimator_lm_robust(dat)[, 1:8]
  )
})

test_that("test estimators, labels, quoted Z", {
  estimator_lm <-
    declare_estimator(Y ~ Z,
      .method = lm,
      term = "Z",
      label = "my_lm"
    )
  estimator_lm_nocoef <-
    declare_estimator(Y ~ Z, .method = lm, label = "my_lm")

  expect_identical(
    estimator_lm(dat),
    estimator_lm_nocoef(dat)
  )
})

test_that("test GLM estimators, default vs explicit Z", {
  estimator_glm <-
    declare_estimator(Y ~ Z, .method = glm, term = "Z")

  estimator_glm_nocoef <- declare_estimator(Y ~ Z, .method = glm)

  expect_identical(
    estimator_glm(dat),
    estimator_glm_nocoef(dat)
  )
})

test_that("test GLM estimators with label", {
  estimator_glm <-
    declare_estimator(Y ~ Z,
      .method = glm,
      term = "Z",
      label = "my_glm"
    )
  estimator_glm_nocoef <-
    declare_estimator(Y ~ Z, .method = glm, label = "my_glm")

  expect_identical(
    estimator_glm(dat),
    estimator_glm_nocoef(dat)
  )
})

test_that("test logit default vs explicit Z", {

  # logit
  estimator_logit <-
    declare_estimator(Y ~ Z,
      .method = glm,
      family = binomial,
      term = "Z"
    )
  estimator_logit_nocoef <-
    declare_estimator(Y ~ Z, .method = glm, family = binomial)

  expect_identical(
    estimator_logit(dat),
    estimator_logit_nocoef(dat)
  )

  estimator_logit <-
    declare_estimator(
      Y ~ Z,
      .method = glm,
      family = binomial,
      term = "Z",
      label = "my_logit"
    )
  estimator_logit_nocoef <-
    declare_estimator(Y ~ Z,
      .method = glm,
      family = binomial,
      label = "my_logit"
    )

  expect_identical(
    estimator_logit(dat),
    estimator_logit_nocoef(dat)
  )

  # probit
  estimator_probit <-
    declare_estimator(
      Y ~ Z,
      .method = glm,
      family = binomial(link = "probit"),
      term = "Z"
    )
  estimator_probit_nocoef <-
    declare_estimator(Y ~ Z, .method = glm, family = binomial(link = "probit"))

  expect_identical(
    estimator_probit(dat),
    estimator_probit_nocoef(dat)
  )

  estimator_probit <-
    declare_estimator(
      Y ~ Z,
      .method = glm,
      family = binomial(link = "probit"),
      term = "Z",
      label = "my_probit"
    )
  estimator_probit_nocoef <-
    declare_estimator(
      Y ~ Z,
      .method = glm,
      family = binomial(link = "probit"),
      label = "my_probit"
    )

  estimator_probit(dat)
  estimator_probit_nocoef(dat)
})





dat <-
  data.frame(
    Y = rep(1:5, 20),
    Y_fac = factor(rep(1:5, 20)),
    Z = rep(c(0, 1), c(50, 50)),
    D = rep(c(0, 1, 0, 1), c(20, 30, 10, 40)),
    D2 = rep(c(0.1, .9, 0.1, .9), c(20, 30, 10, 40))
  )


pop <- declare_model(dat)



test_that("custom tidy method", {
  model_function <- function(data){
    return(structure(list(est = 1), class = "my_modelr"))
  }
  
  des <- pop + declare_estimator(.method = model_function)
  
  expect_error(draw_estimates(des), "We were unable to tidy the output")

  tidy.my_modelr <- function(fit, conf.int = TRUE){
    return(data.frame(term = "my-term", est = 1, stringsAsFactors = TRUE))
  }
  
  # this is an ugly hack per https://github.com/r-lib/testthat/issues/720
  assign("tidy.my_modelr", tidy.my_modelr, envir = .GlobalEnv)
  
  des <- pop + declare_estimator(.method = model_function)
  
  expect_equal(draw_estimates(des), structure(list(estimator = "estimator", term = structure(1L, .Label = "my-term", class = "factor"), 
                                                   est = 1), row.names = c(NA, -1L), class = "data.frame"))
  
})

library(broom)

test_that("AER", {
  skip_if_not_installed(c("AER", "broom"))
  library(broom)
  des <- pop + declare_estimator(Y ~ D | Z, .method = AER::ivreg)
  expect_equal(ncol(draw_estimates(des)), 8)
})

test_that("lm", {
  des <- pop + declare_estimator(Y ~ Z, .method = lm)
  expect_equal(ncol(draw_estimates(des)), 8)
})

test_that("glm", {
  des <- pop + declare_estimator(D ~ Z, .method = glm, family = binomial(link = "probit"))
  expect_equal(ncol(draw_estimates(des)), 8)
  des <- pop + declare_estimator(D ~ Z, .method = glm, family = binomial(link = "logit"))
  expect_equal(ncol(draw_estimates(des)), 8)
})


test_that("betareg", {
  skip_if_not_installed(c("betareg", "broom"))
  des <- pop + declare_estimator(D2 ~ Z, .method = betareg::betareg)
  if(packageVersion("broom") <= "0.5.0") {
    expect_error(draw_estimates(des))
  } else {
    expect_equal(ncol(draw_estimates(des)), 9)
  }
})

test_that("biglm", {
  skip_if_not_installed(c("biglm", "broom"))
  des <- pop + declare_estimator(Y ~ Z, .method = biglm::biglm)
  if(packageVersion("broom") <= "0.5.0") {
    expect_error(draw_estimates(des))
  } else {
    expect_equal(ncol(draw_estimates(des)), 7)
  }
})

test_that("gam", {
  skip_if_not_installed(c("gam", "broom"))
  des <- pop + declare_estimator(Y ~ Z, .method = gam::gam)
  if(packageVersion("broom") <= "0.5.0") {
    expect_error(draw_estimates(des))
  } else if(packageVersion("gam") < "1.16") {
    expect_warning(expect_equal(ncol(draw_estimates(des)), 7))
  } else {
    expect_equal(ncol(draw_estimates(des)), 7)
  }
  
  
})


test_that("polr", {
  skip_if_not_installed(c("MASS", "broom"))
  des <- pop + declare_estimator(Y_fac ~ Z, .method = MASS::polr)
  suppressWarnings(expect_error(draw_estimates(des)))
})