tests/testthat/test-selection.R

In insight: Easy Access to Model Information for Various Model Objects

skip_on_os("mac")
skip_on_cran()
skip_if_not_installed("sampleSelection")
skip_if_not_installed("mvtnorm")

set.seed(0)
vc <- diag(3)
vc[lower.tri(vc)] <- c(0.9, 0.5, 0.1)
vc[upper.tri(vc)] <- vc[lower.tri(vc)]
eps <- mvtnorm::rmvnorm(500, c(0, 0, 0), vc)
xs <- runif(500)
ys <- xs + eps[, 1] > 0
xo1 <- runif(500)
yo1 <- xo1 + eps[, 2]
xo2 <- runif(500)
yo2 <- xo2 + eps[, 3]
yo <- ifelse(ys, yo2, yo1)
ys <- as.numeric(ys) + 1
dat_sel <<- data.frame(ys, yo, yo1, yo2, xs, xo1, xo2)
m1 <- sampleSelection::selection(ys ~ xs, list(yo1 ~ xo1, yo2 ~ xo2), data = dat_sel)

set.seed(0)
xs1 <- runif(500)
xs2 <- runif(500)
ys <- xs1 + xs2 + eps[, 1] > 0
xo11 <- runif(500)
xo12 <- runif(500)
yo1 <- xo11 + xo12 + eps[, 2]
xo2 <- runif(500)
yo2 <- xo2 + eps[, 3]
yo <- ifelse(ys, yo2, yo1)
ys <- as.numeric(ys) + 1
dat_sel2 <<- data.frame(ys, yo, yo1, yo2, xs1, xs2, xo11, xo12, xo2)
m3 <- sampleSelection::selection(
  ys ~ xs1 + xs2,
  list(yo1 ~ xo11 + xo12, yo2 ~ xo2),
  data = dat_sel2
)

data(Mroz87, package = "sampleSelection")
Mroz87$kids  <- (Mroz87$kids5 + Mroz87$kids618 > 0)
m2 <- sampleSelection::selection(
  lfp ~ age + I(age^2) + faminc + kids + educ,
  wage ~ exper + I(exper^2) + educ + city,
  data = Mroz87
)


test_that("model_info", {
  expect_true(model_info(m1)$is_linear)
  expect_true(model_info(m2)$is_linear)
})

test_that("find_predictors", {
  expect_identical(
    find_predictors(m1),
    list(conditional = list(selection = "xs", outcome = list(yo1 = "xo1", yo2 = "xo2")))
  )
  expect_identical(
    find_predictors(m3),
    list(
      conditional = list(
        selection = c("xs1", "xs2"),
        outcome = list(yo1 = c("xo11", "xo12"), yo2 = "xo2")
      )
    )
  )
  expect_identical(
    find_predictors(m2),
    list(
      conditional = list(
        selection = c("age", "faminc", "kids", "educ"),
        outcome = c("exper", "educ", "city")
      )
    )
  )
})

test_that("find_response", {
  expect_identical(find_response(m1), c("ys", "yo1", "yo2"))
  expect_identical(find_response(m3), c("ys", "yo1", "yo2"))
  expect_identical(find_response(m2), c("lfp", "wage"))
})

test_that("get_response", {
  expect_equal(get_response(m1), dat_sel[c("ys", "yo1", "yo2")], ignore_attr = TRUE)
  expect_equal(get_response(m3), dat_sel2[c("ys", "yo1", "yo2")], ignore_attr = TRUE)
})

test_that("get_predictors", {
  expect_named(get_predictors(m1), c("xs", "xo1", "xo2"))
  expect_named(get_predictors(m3), c("xs1", "xs2", "xo11", "xo12", "xo2"))
})

test_that("get_data", {
  expect_equal(nrow(get_data(m1, verbose = FALSE)), 500)
  expect_named(get_data(m1, verbose = FALSE), c("ys", "yo1", "yo2", "xs", "xo1", "xo2"))
  expect_named(get_data(m3, verbose = FALSE), c("ys", "yo1", "yo2", "xs1", "xs2", "xo11", "xo12", "xo2"))
})

test_that("find_formula", {
  expect_length(find_formula(m1), 1)
  expect_equal(
    find_formula(m1),
    list(
      conditional = list(
        selection = ys ~ xs,
        outcome = list(yo1 ~ xo1, yo2 ~ xo2)
      )
    ),
    ignore_attr = TRUE
  )
  expect_equal(
    find_formula(m3),
    list(
      conditional = list(
        selection = ys ~ xs1 + xs2,
        outcome = list(yo1 ~ xo11 + xo12, yo2 ~ xo2)
      )
    ),
    ignore_attr = TRUE
  )
  expect_equal(
    find_formula(m2),
    list(
      conditional = list(
        selection = lfp ~ age + I(age^2) + faminc + kids + educ,
        outcome = wage ~ exper + I(exper^2) + educ + city
      )
    ),
    ignore_attr = TRUE
  )
})

test_that("find_terms", {
  expect_equal(
    find_terms(m1),
    list(conditional = list(selection = "ys  xs", outcome = c("yo1  xo1", "yo2  xo2")))
  )
  expect_equal(
    find_terms(m1, flatten = TRUE),
    c("ys  xs", "yo1  xo1", "yo2  xo2")
  )
  expect_equal(
    find_terms(m2),
    list(
      conditional = list(
        selection = c("lfp  age", "I(age^2)", "faminc", "kids", "educ"),
        outcome = c("wage  exper", "I(exper^2)", "educ", "city")
      )
    )
  )
})

test_that("n_obs", {
  expect_equal(n_obs(m1), 500)
})

test_that("find_parameters", {
  expect_equal(
    find_parameters(m1),
    list(
      selection = c("(Intercept)", "xs"),
      outcome = c("(Intercept)", "xo1", "(Intercept)", "xo2"),
      auxiliary = c("sigma1", "rho1", "sigma2", "rho2")
    )
  )
  expect_equal(
    find_parameters(m2),
    list(
      selection = c("(Intercept)", "age", "I(age^2)", "faminc", "kidsTRUE", "educ"),
      outcome = c("(Intercept)", "exper", "I(exper^2)", "educ", "city"),
      auxiliary = c("sigma", "rho")
    )
  )
})

test_that("get_parameters", {
  out <- get_parameters(m1)
  expect_identical(
    out$Component,
    c(
      "selection", "selection", "outcome", "outcome", "auxiliary",
      "auxiliary", "outcome", "outcome", "auxiliary", "auxiliary"
    )
  )
  out <- get_parameters(m2)
  expect_identical(
    out$Component,
    c(
      "selection", "selection", "selection", "selection", "selection", "selection",
      "outcome", "outcome", "outcome", "outcome", "outcome", "auxiliary", "auxiliary"
    )
  )
})

test_that("is_multivariate", {
  expect_false(is_multivariate(m1))
})

test_that("find_statistic", {
  expect_identical(find_statistic(m1), "t-statistic")
})

test_that("get_statistic", {
  out <- get_statistic(m1)
  expect_identical(
    out$Component,
    c(
      "selection", "selection", "outcome", "outcome", "auxiliary",
      "auxiliary", "outcome", "outcome", "auxiliary", "auxiliary"
    )
  )
  expect_equal(
    out$Statistic,
    as.vector(summary(m1)$estimate[, 3]),
    ignore_attr = TRUE,
    tolerance = 1e-4
  )
  out <- get_statistic(m2)
  expect_identical(
    out$Component,
    c(
      "selection", "selection", "selection", "selection", "selection", "selection",
      "outcome", "outcome", "outcome", "outcome", "outcome", "auxiliary", "auxiliary"
    )
  )
  expect_equal(
    out$Statistic,
    as.vector(summary(m2)$estimate[, 3]),
    ignore_attr = TRUE,
    tolerance = 1e-4
  )
})