tests/testthat/test-gate.R

In interflex: Estimation, Diagnostics and Visualization of Conditional Marginal Effects

# test-gate.R — Unified GATE tests across estimators
# Generated from test-spec.md (GATE-001)

# Shared DGP
make_gate_data <- function() {
  set.seed(1234)
  n <- 500
  X <- sample(1:4, n, replace = TRUE, prob = c(0.25, 0.25, 0.25, 0.25))
  Z1 <- rnorm(n)
  Z2 <- runif(n, -1, 1)
  D_binary <- rbinom(n, 1, plogis(0.3 * Z1 - 0.2 * Z2))
  D_continuous <- 2 + 0.5 * Z1 + rnorm(n)

  true_gate <- c(`1` = 2, `2` = 4, `3` = 6, `4` = 3)
  tau_i <- true_gate[as.character(X)]

  e <- rnorm(n, sd = 1.5)
  Y_binary <- 3 + tau_i * D_binary + 0.8 * Z1 - 0.5 * Z2 + e
  Y_continuous <- 3 + tau_i * D_continuous + 0.8 * Z1 - 0.5 * Z2 + e

  data.frame(Y_bin = Y_binary, Y_cont = Y_continuous,
             D_bin = D_binary, D_cont = D_continuous,
             X = X, Z1 = Z1, Z2 = Z2)
}

# --- T1. Linear + gate=TRUE + binary D ---
test_that("T1: Linear + gate=TRUE + binary D produces correct GATE", {
  skip_on_cran()
  dat <- make_gate_data()
  true_gate <- c(`1` = 2, `2` = 4, `3` = 6, `4` = 3)

  out <- suppressWarnings(suppressMessages(
    interflex(estimator = "linear", data = dat,
              Y = "Y_bin", D = "D_bin", X = "X", Z = c("Z1", "Z2"),
              gate = TRUE, figure = FALSE, nboots = 50, CI = TRUE)
  ))

  expect_s3_class(out, "interflex")
  expect_true(!is.null(out$g.est))
  expect_true(is.list(out$g.est))
  expect_true(length(out$g.est) >= 1)

  # Check structure of each element
  for (i in seq_along(out$g.est)) {
    df <- out$g.est[[i]]
    expect_true(is.data.frame(df))
    expect_true("X" %in% names(df))
    expect_true("ME" %in% names(df))
    expect_equal(nrow(df), 4)
  }

  # Check GATE estimates within tolerance (abs < 3)
  df <- out$g.est[[1]]
  for (j in seq_len(nrow(df))) {
    x_val <- as.character(df$X[j])
    expect_true(abs(df$ME[j] - true_gate[x_val]) < 3,
                info = paste("GATE for X =", x_val, ": ME =", df$ME[j],
                             ", true =", true_gate[x_val]))
  }

  # Smooth CME curve still produced
  expect_true(!is.null(out$est.lin))
})

# --- T2. Linear + gate=TRUE + continuous D ---
test_that("T2: Linear + gate=TRUE + continuous D", {
  skip_on_cran()
  dat <- make_gate_data()

  out <- suppressWarnings(suppressMessages(
    interflex(estimator = "linear", data = dat,
              Y = "Y_cont", D = "D_cont", X = "X", Z = c("Z1", "Z2"),
              gate = TRUE, figure = FALSE, nboots = 50, CI = TRUE)
  ))

  expect_true(!is.null(out$g.est))
  expect_true(is.list(out$g.est))
  for (i in seq_along(out$g.est)) {
    df <- out$g.est[[i]]
    expect_true("X" %in% names(df))
    expect_true("ME" %in% names(df))
  }
  expect_true(!is.null(out$est.lin))
})

# --- T3. GRF + gate=TRUE + binary D ---
test_that("T3: GRF + gate=TRUE + binary D", {
  skip_on_cran()
  dat <- make_gate_data()

  out <- suppressWarnings(suppressMessages(
    interflex(estimator = "grf", data = dat,
              Y = "Y_bin", D = "D_bin", X = "X", Z = c("Z1", "Z2"),
              gate = TRUE, figure = FALSE)
  ))

  expect_true(!is.null(out$g.est))
  expect_true(is.list(out$g.est))
  for (i in seq_along(out$g.est)) {
    df <- out$g.est[[i]]
    expect_true(is.data.frame(df))
    expect_true("X" %in% names(df))
    expect_true("ME" %in% names(df))
    expect_equal(nrow(df), 4)
  }
  expect_true(!is.null(out$est.grf))
})

# --- T4. DML + gate=TRUE — regression test ---
test_that("T4: DML + gate=TRUE regression test", {
  skip_on_cran()
  dat <- make_gate_data()

  out <- suppressWarnings(suppressMessages(
    interflex(estimator = "dml", data = dat,
              Y = "Y_bin", D = "D_bin", X = "X", Z = c("Z1", "Z2"),
              gate = TRUE, figure = FALSE,
              model.y = "linear", model.t = "linear")
  ))

  expect_true(!is.null(out$g.est))
  expect_true(is.list(out$g.est))
  expect_true(!is.null(out$g.est.dml))
  expect_true(is.list(out$g.est.dml))

  # g.est and g.est.dml should contain the same data
  for (i in seq_along(out$g.est)) {
    expect_equal(out$g.est[[i]], out$g.est.dml[[i]])
  }

  for (i in seq_along(out$g.est)) {
    df <- out$g.est[[i]]
    expect_true("X" %in% names(df))
    expect_true("ME" %in% names(df))
  }
})

# --- T5. Lasso + gate=TRUE ---
test_that("T5: Lasso + gate=TRUE explicit", {
  skip_on_cran()
  dat <- make_gate_data()

  out <- suppressWarnings(suppressMessages(
    interflex(estimator = "lasso", data = dat,
              Y = "Y_bin", D = "D_bin", X = "X", Z = c("Z1", "Z2"),
              gate = TRUE, figure = FALSE, CI = TRUE, nboots = 50)
  ))

  expect_true(!is.null(out$g.est))
  expect_true(!is.null(out$est.lasso))
  expect_s3_class(out, "interflex")
})

# --- T6. Plot by.group=TRUE — linear ---
test_that("T6: Plot by.group=TRUE works for linear", {
  skip_on_cran()
  dat <- make_gate_data()

  out <- suppressWarnings(suppressMessages(
    interflex(estimator = "linear", data = dat,
              Y = "Y_bin", D = "D_bin", X = "X", Z = c("Z1", "Z2"),
              gate = TRUE, figure = FALSE, nboots = 50, CI = TRUE)
  ))

  p <- suppressWarnings(suppressMessages(
    plot(out, by.group = TRUE)
  ))
  expect_true(!is.null(p))
})

# --- T7. Plot by.group=TRUE — grf ---
test_that("T7: Plot by.group=TRUE works for grf", {
  skip_on_cran()
  dat <- make_gate_data()

  out <- suppressWarnings(suppressMessages(
    interflex(estimator = "grf", data = dat,
              Y = "Y_bin", D = "D_bin", X = "X", Z = c("Z1", "Z2"),
              gate = TRUE, figure = FALSE)
  ))

  p <- suppressWarnings(suppressMessages(
    plot(out, by.group = TRUE)
  ))
  expect_true(!is.null(p))
})

# --- T8. Plot by.group=TRUE — dml ---
test_that("T8: Plot by.group=TRUE works for dml", {
  skip_on_cran()
  dat <- make_gate_data()

  out <- suppressWarnings(suppressMessages(
    interflex(estimator = "dml", data = dat,
              Y = "Y_bin", D = "D_bin", X = "X", Z = c("Z1", "Z2"),
              gate = TRUE, figure = FALSE,
              model.y = "linear", model.t = "linear")
  ))

  p <- suppressWarnings(suppressMessages(
    plot(out, by.group = TRUE)
  ))
  expect_true(!is.null(p))
})

# --- T9. Plot by.group=TRUE — lasso ---
test_that("T9: Plot by.group=TRUE works for lasso", {
  skip_on_cran()
  dat <- make_gate_data()

  out <- suppressWarnings(suppressMessages(
    interflex(estimator = "lasso", data = dat,
              Y = "Y_bin", D = "D_bin", X = "X", Z = c("Z1", "Z2"),
              gate = TRUE, figure = FALSE, CI = TRUE, nboots = 50)
  ))

  p <- suppressWarnings(suppressMessages(
    plot(out, by.group = TRUE)
  ))
  expect_true(!is.null(p))
})

# --- E1. gate=TRUE + kernel -> works (evaluates at discrete X levels) ---
test_that("E1: gate=TRUE + kernel produces g.est", {
  skip_on_cran()
  dat <- make_gate_data()

  out <- suppressWarnings(suppressMessages(
    interflex(estimator = "kernel", data = dat,
              Y = "Y_bin", D = "D_bin", X = "X", Z = c("Z1", "Z2"),
              gate = TRUE, figure = FALSE, CI = FALSE)
  ))
  expect_s3_class(out, "interflex")
  expect_true(!is.null(out$g.est))
  expect_equal(nrow(out$g.est[[1]]), 4)
})

# --- E2. gate=TRUE + binning -> error ---
test_that("E2: gate=TRUE + binning errors", {
  skip_on_cran()
  dat <- make_gate_data()

  expect_error(
    interflex(estimator = "binning", data = dat,
              Y = "Y_bin", D = "D_bin", X = "X", gate = TRUE),
    "gate = TRUE is not supported"
  )
})

# --- E3. gate=TRUE + continuous X -> error ---
test_that("E3: gate=TRUE + continuous X errors", {
  skip_on_cran()
  dat <- make_gate_data()
  dat_cont_x <- dat
  dat_cont_x$X <- rnorm(nrow(dat))

  expect_error(
    interflex(estimator = "linear", data = dat_cont_x,
              Y = "Y_bin", D = "D_bin", X = "X", gate = TRUE),
    "discrete moderator|continuous"
  )
})

# --- E4. gate=FALSE (default) — no g.est ---
test_that("E4: gate=FALSE produces no g.est", {
  skip_on_cran()
  dat <- make_gate_data()

  out <- suppressWarnings(suppressMessages(
    interflex(estimator = "linear", data = dat,
              Y = "Y_bin", D = "D_bin", X = "X", figure = FALSE)
  ))

  expect_null(out$g.est)
})

# --- Property-based invariants ---
test_that("P1-P4: Property-based invariants for GATE output", {
  skip_on_cran()
  dat <- make_gate_data()

  out <- suppressWarnings(suppressMessages(
    interflex(estimator = "linear", data = dat,
              Y = "Y_bin", D = "D_bin", X = "X", Z = c("Z1", "Z2"),
              gate = TRUE, figure = FALSE, nboots = 50, CI = TRUE)
  ))

  for (i in seq_along(out$g.est)) {
    df <- out$g.est[[i]]

    # P1: Structure consistency
    expect_true(is.data.frame(df))
    expect_true(all(c("X", "ME") %in% names(df)))

    # P2: Level coverage
    expect_true(all(sort(unique(dat$X)) %in% df$X))

    # P3: Sign consistency (all true effects positive)
    expect_true(all(df$ME > 0), info = paste("Negative ME found:", paste(df$ME, collapse = ", ")))

    # P4: CI monotonicity
    if ("lower CI(95%)" %in% names(df) && "upper CI(95%)" %in% names(df)) {
      expect_true(all(df[["lower CI(95%)"]] <= df$ME))
      expect_true(all(df$ME <= df[["upper CI(95%)"]]))
    }
  }
})