tests/testthat/test-weights.R

In rbw: Residual Balancing Weights for Marginal Structural Models

test_that("base weights are the same length as data", {
  # Create a vector of base weights with random numbers whose length differs from the lengths of the data sets
  bweights <- rnorm(10)
  # Point Treatment
  expect_error(rbwPoint(treatment = treat,
                      baseline_x = c(log_TotalPop, PercentOver65, log_Inc,PercentHispanic, PercentBlack, density,per_collegegrads, CanCommute),
                      data = advertisement, base_weights = bweights),
               "'base_weights' must be numeric and have the same length as 'data'.")
  # Mediation Analysis
  m1 <- lm(threatc ~ ally + trade + h1 + i1 + p1 + e1 + r1 +
             male + white + age + ed4 + democ, data = peace)
  m2 <- lm(cost ~ ally + trade + h1 + i1 + p1 + e1 + r1 +
             male + white + age + ed4 + democ, data = peace)
  m3 <- lm(successc ~ ally + trade + h1 + i1 + p1 + e1 + r1 +
             male + white + age + ed4 + democ, data = peace)
  zmodels <- list(m1, m2, m3)
  expect_error(rbwMed(treatment = democ, mediator = immoral,
                      zmodels = zmodels, interact = TRUE,
                      baseline_x = c(ally, trade, h1, i1, p1, e1, r1, male, white, age, ed4),
                      data = peace, base_weights = bweights),
               "'base_weights' must be numeric and have the same length as 'data'.")
  # Time-Varying Treatment
  m1 <- lm(dem.polls ~ (d.gone.neg.l1 + dem.polls.l1 + undother.l1) * factor(week),
           data = campaign_long)
  m2 <- lm(undother ~ (d.gone.neg.l1 + dem.polls.l1 + undother.l1) * factor(week),
           data = campaign_long)
  xmodels <- list(m1, m2)
  expect_error(rbwPanel(treatment = d.gone.neg, xmodels = xmodels, id = id,
                        time = week, data = campaign_long, base_weights = bweights),
               "'base_weights' must be numeric and have the same length as 'data'.")
})