tests/testthat/test-plot-plbandwidth-bias-center-contract.R

In np: Nonparametric Kernel Smoothing Methods for Mixed Data Types

test_that("partially linear bootstrap bias centers are component-specific", {
  set.seed(42)
  n <- 80L
  x1 <- rnorm(n)
  x2 <- factor(rbinom(n, 1L, 0.5))
  z1 <- factor(rbinom(n, 1L, 0.5))
  z2 <- rnorm(n)
  y <- 1 + x1 + as.integer(x2) + as.integer(z1) + sin(z2) + rnorm(n)

  model <- npplreg(
    y ~ x1 + x2 | z1 + z2,
    regtype = "lp",
    degree = 0L,
    nmulti = 1L
  )

  for (boot in c("wild", "inid", "fixed", "geom")) {
    set.seed(123)
    out <- suppressWarnings(plot(
      model,
      center = "bias-corrected",
      errors = "bootstrap",
      bootstrap = boot,
      band = "pointwise",
      B = 19L,
      data_overlay = FALSE,
      output = "data"
    ))

    expect_length(out, 4L)
    bc.lengths <- vapply(out, function(x) length(x$bias.corrected), integer(1L))
    mean.lengths <- vapply(out, function(x) length(x$mean), integer(1L))
    expect_equal(bc.lengths, mean.lengths)
    expect_true(all(vapply(out, function(x) all(is.finite(x$bias.corrected)), logical(1L))))

    continuous.panels <- vapply(out, function(x) length(x$bias.corrected) > 2L, logical(1L))
    expect_equal(sum(continuous.panels), 2L)
    continuous.centers <- lapply(out[continuous.panels], `[[`, "bias.corrected")
    expect_false(isTRUE(all.equal(continuous.centers[[1L]], continuous.centers[[2L]])))
  }
})

test_that("partially linear bias-corrected plot renders continuous and factor panels", {
  set.seed(42)
  n <- 80L
  x1 <- rnorm(n)
  x2 <- factor(rbinom(n, 1L, 0.5))
  z1 <- factor(rbinom(n, 1L, 0.5))
  z2 <- rnorm(n)
  y <- 1 + x1 + as.integer(x2) + as.integer(z1) + sin(z2) + rnorm(n)

  model <- npplreg(
    y ~ x1 + x2 | z1 + z2,
    regtype = "lp",
    degree = 0L,
    nmulti = 1L
  )

  pdf.file <- tempfile(fileext = ".pdf")
  grDevices::pdf(pdf.file)
  on.exit(grDevices::dev.off(), add = TRUE)

  options(plot.par.mfrow = FALSE)
  old.par <- graphics::par(no.readonly = TRUE)
  on.exit(graphics::par(old.par), add = TRUE)
  graphics::par(mfrow = c(2L, 2L))

  expect_error(
    suppressWarnings(plot(
      model,
      center = "bias-corrected",
      errors = "bootstrap",
      bootstrap = "wild",
      band = "simultaneous",
      B = 29L,
      data_overlay = FALSE
    )),
    NA
  )
})