tests/testthat/test-lm-interaction-swap.R

In aterui/avpc: Average Predictive Comparison

# setup -------------------------------------------------------------------

  context("test lm interaction test (terms swapped)")

  pacman::p_load(tidyverse)
  ilogit <- function(x) 1 / (1 + exp(-x))


# test dataset ------------------------------------------------------------

  n_sample <- 100

  x1 <- rnorm(n = n_sample)
  x2 <- rnorm(n = n_sample)
  x3 <- sample(letters[1:5], size = n_sample, replace = TRUE)
  mat <- stats::model.matrix(model.frame(~ x1 + x2 * x3))
  v_b <- runif(n = ncol(mat), -1, 1)
  y <- rnorm(n = n_sample, mean = mat %*% v_b, sd = 1)


# run model ---------------------------------------------------------------

  m <- lm(y ~ x1 + x3 * x2)
  beta <- coef(m)
  names(beta) <- NULL


# average predictive comparison -------------------------------------------

  b_x1 <- apcomp(m, u = "x1")$estimate

  re <- apcomp(m, u = "x2")
  b_x2 <- re$estimate
  df_u2 <- re$df_u2v1
  int_terms <- re$interaction_term

  u2 <- df_u2 %>% dplyr::select("x2") %>% pull()
  vs <- df_u2 %>%
    dplyr::select(dplyr::starts_with("x3") & dplyr::ends_with(letters[2:5]))

  df_test1 <- as_tibble(u2 * vs) %>%
    rename_with(.fn = ~ paste0(.x, ":x2"))
  df_test2 <- df_u2 %>%
    dplyr::select(dplyr::all_of(int_terms))


# test --------------------------------------------------------------------

  test_that("compare coefficients", {
    expect_equal(b_x1, beta[2])
    expect_equal(df_test1, df_test2)
  })