Nothing
## ---------------------------------------------------------
## Tests derived from Quarto book documentation claims
## Each test validates a specific assertion made in the user-facing docs.
## ---------------------------------------------------------
## =========================================================
## Shared fixtures (computed once, reused across test blocks)
## =========================================================
## DGP helper: two-way FE + optional factors + optional covariates
make_panel <- function(N = 40, TT = 20, T0 = 12, Ntr = 12,
tau = 3.0, r = 0, beta_x = 0,
mean_shift = 0, seed = 8001,
stagger = FALSE, reversals = FALSE,
add_Z = FALSE, add_group = FALSE) {
set.seed(seed)
alpha_i <- rnorm(N, 0, 2)
xi_t <- rnorm(TT, 0, 1)
## factors
FL <- matrix(0, TT, N)
if (r > 0) {
Fmat <- matrix(rnorm(TT * r), TT, r)
Lmat <- matrix(rnorm(N * r), N, r)
FL <- Fmat %*% t(Lmat)
}
## treatment assignment
D <- matrix(0L, TT, N)
tr_units <- 1:Ntr
if (stagger) {
## 3 cohorts
for (i in tr_units) {
cohort <- ((i - 1) %% 3) + 1
t0_i <- T0 + (cohort - 1) * 2
if (t0_i < TT) D[(t0_i + 1):TT, i] <- 1L
}
} else {
D[(T0 + 1):TT, tr_units] <- 1L
}
if (reversals) {
## flip last 2 periods off for first 3 treated
for (i in 1:min(3, Ntr)) {
D[(TT - 1):TT, i] <- 0L
}
}
## covariates
X1 <- matrix(rnorm(N * TT, 0, 1), TT, N)
eps <- matrix(rnorm(N * TT, 0, 1), TT, N)
Y <- mean_shift +
outer(xi_t, rep(1, N)) +
outer(rep(1, TT), alpha_i) +
FL +
beta_x * X1 +
tau * D +
eps
df <- data.frame(
id = rep(1:N, each = TT),
time = rep(1:TT, N),
Y = as.vector(Y),
D = as.vector(D),
X1 = as.vector(X1)
)
if (add_Z) {
## time-invariant covariate (same across all periods for a unit)
Z_vals <- rnorm(N, 0, 1)
df$Z <- rep(Z_vals, each = TT)
}
if (add_group) {
## group variable: 3 groups by unit
df$grp <- rep(((1:N - 1) %% 3) + 1, each = TT)
}
df
}
## =========================================================
## Section A: Method Equivalences (Book: index.qmd, 04-gsynth.Rmd)
## =========================================================
test_that("A1: gsynth == ife + time.component.from='nevertreated' (exact)", {
skip_on_cran()
d <- make_panel(N = 50, TT = 20, T0 = 12, Ntr = 10, r = 2, seed = 8010)
out_g <- fect(Y ~ D + X1, data = d, index = c("id", "time"),
method = "gsynth", r = 2, se = FALSE, CV = FALSE)
out_i <- fect(Y ~ D + X1, data = d, index = c("id", "time"),
method = "ife", time.component.from = "nevertreated",
r = 2, se = FALSE, CV = FALSE)
expect_equal(out_g$att.avg, out_i$att.avg, tolerance = 1e-8)
expect_equal(as.vector(out_g$eff), as.vector(out_i$eff), tolerance = 1e-8)
})
test_that("A2: IFE(r=0) == FE (exact equivalence)", {
skip_on_cran()
d <- make_panel(N = 30, TT = 15, T0 = 10, Ntr = 10, r = 0, seed = 8020)
out_fe <- fect(Y ~ D + X1, data = d, index = c("id", "time"),
method = "fe", se = FALSE, CV = FALSE)
out_ife <- fect(Y ~ D + X1, data = d, index = c("id", "time"),
method = "ife", r = 0, se = FALSE, CV = FALSE)
expect_equal(out_fe$att.avg, out_ife$att.avg, tolerance = 1e-6)
expect_equal(as.vector(out_fe$eff), as.vector(out_ife$eff), tolerance = 1e-6)
})
## =========================================================
## Section B: force Parameter Variations (Book: 02-fect.Rmd)
## =========================================================
test_that("B1: force='unit' runs without error", {
skip_on_cran()
d <- make_panel(N = 30, TT = 15, T0 = 10, Ntr = 10, seed = 8030)
out <- fect(Y ~ D, data = d, index = c("id", "time"),
method = "fe", force = "unit", se = FALSE, CV = FALSE)
expect_true(is.numeric(out$att.avg))
expect_false(is.na(out$att.avg))
})
test_that("B2: force='time' runs without error", {
skip_on_cran()
d <- make_panel(N = 30, TT = 15, T0 = 10, Ntr = 10, seed = 8031)
out <- fect(Y ~ D, data = d, index = c("id", "time"),
method = "fe", force = "time", se = FALSE, CV = FALSE)
expect_true(is.numeric(out$att.avg))
expect_false(is.na(out$att.avg))
})
test_that("B3: force='none' runs without error", {
skip_on_cran()
d <- make_panel(N = 30, TT = 15, T0 = 10, Ntr = 10, seed = 8032)
out <- fect(Y ~ D, data = d, index = c("id", "time"),
method = "fe", force = "none", se = FALSE, CV = FALSE)
expect_true(is.numeric(out$att.avg))
expect_false(is.na(out$att.avg))
})
test_that("B4: force variations work for IFE with r > 0", {
skip_on_cran()
d <- make_panel(N = 40, TT = 20, T0 = 12, Ntr = 12, r = 1, seed = 8033)
for (f in c("unit", "time", "none", "two-way")) {
out <- fect(Y ~ D, data = d, index = c("id", "time"),
method = "ife", r = 1, force = f, se = FALSE, CV = FALSE)
expect_true(is.numeric(out$att.avg),
info = paste("force =", f))
}
})
## =========================================================
## Section C: Diagnostic Tests (Book: 02-fect.Rmd)
## =========================================================
test_that("C1: placeboTest produces p-value and test output", {
skip_on_cran()
d <- make_panel(N = 40, TT = 20, T0 = 12, Ntr = 12, seed = 8040)
out <- fect(Y ~ D, data = d, index = c("id", "time"),
method = "fe", se = TRUE, nboots = 50,
placeboTest = TRUE, placebo.period = c(-2, 0),
CV = FALSE)
## Book: placebo p-value should exist
expect_true(!is.null(out$placebo.p))
expect_true(is.numeric(out$placebo.p))
})
test_that("C2: carryoverTest produces test output", {
skip_on_cran()
d <- make_panel(N = 40, TT = 20, T0 = 12, Ntr = 12,
reversals = TRUE, seed = 8041)
out <- fect(Y ~ D, data = d, index = c("id", "time"),
method = "fe", se = TRUE, nboots = 50,
carryoverTest = TRUE, carryover.period = c(1, 2),
CV = FALSE)
expect_true(!is.null(out$carryover.p))
expect_true(is.numeric(out$carryover.p))
})
test_that("C3: loo=TRUE produces pre-trend leave-one-out estimates", {
skip_on_cran()
d <- make_panel(N = 40, TT = 20, T0 = 12, Ntr = 12, seed = 8042)
out <- fect(Y ~ D, data = d, index = c("id", "time"),
method = "fe", se = TRUE, nboots = 50,
loo = TRUE, CV = FALSE)
## LOO test output should exist
expect_true(!is.null(out$loo.test.out))
expect_true(!is.null(out$loo.test.out$f.stat))
expect_true(!is.null(out$loo.test.out$f.p))
})
test_that("C4: equivalence test output (pre-trend F-test)", {
skip_on_cran()
d <- make_panel(N = 40, TT = 20, T0 = 12, Ntr = 12, seed = 8043)
out <- fect(Y ~ D, data = d, index = c("id", "time"),
method = "fe", se = TRUE, nboots = 50, loo = TRUE, CV = FALSE)
## F-test lives inside loo.test.out
expect_true(!is.null(out$loo.test.out$f.p))
expect_true(is.numeric(out$loo.test.out$f.p))
## Book: p > 0.05 means good pre-trend fitting; for clean DGP expect pass
expect_true(out$loo.test.out$f.p > 0.01,
info = "Pre-trend F-test should not reject for clean DGP")
})
## =========================================================
## Section D: Output Structure (Book: 02-fect.Rmd, 04-gsynth.Rmd)
## =========================================================
test_that("D1: est.att structure (periods × 6 columns)", {
skip_on_cran()
d <- make_panel(N = 40, TT = 20, T0 = 12, Ntr = 12, seed = 8050)
out <- fect(Y ~ D, data = d, index = c("id", "time"),
method = "fe", se = TRUE, nboots = 50, CV = FALSE)
expect_true(!is.null(out$est.att))
expect_true(is.matrix(out$est.att) || is.data.frame(out$est.att))
## Book: columns include ATT, S.E., CI.lower, CI.upper, p.value, count
cnames <- colnames(out$est.att)
expect_true("ATT" %in% cnames)
expect_true("S.E." %in% cnames)
expect_true("CI.lower" %in% cnames)
expect_true("CI.upper" %in% cnames)
expect_true("count" %in% cnames)
})
test_that("D2: est.avg vs est.avg.unit differ with unequal exposure", {
skip_on_cran()
## staggered adoption → unequal treated-period counts
d <- make_panel(N = 40, TT = 20, T0 = 10, Ntr = 12,
stagger = TRUE, seed = 8051)
out <- fect(Y ~ D, data = d, index = c("id", "time"),
method = "fe", se = FALSE, CV = FALSE)
## Book: est.avg weights observations equally; est.avg.unit weights units equally
## With staggered adoption these should differ
expect_true(is.numeric(out$att.avg))
expect_true(!is.null(out$att.avg.unit))
## They won't be exactly equal due to stagger
expect_false(isTRUE(all.equal(out$att.avg, out$att.avg.unit)),
info = "est.avg and est.avg.unit should differ under staggered adoption")
})
test_that("D3: eff.boot dimensions = periods × treated × nboots", {
skip_on_cran()
d <- make_panel(N = 30, TT = 15, T0 = 10, Ntr = 8, seed = 8052)
nboots <- 30
out <- fect(Y ~ D, data = d, index = c("id", "time"),
method = "fe", se = TRUE, nboots = nboots,
keep.sims = TRUE, CV = FALSE)
## Book: eff.boot is array(periods × treated × nboots)
expect_true(!is.null(out$eff.boot))
expect_true(is.array(out$eff.boot))
dims <- dim(out$eff.boot)
expect_equal(length(dims), 3)
## dim 3 should be nboots
expect_equal(dims[3], nboots)
})
test_that("D4: est.beta present with covariates", {
skip_on_cran()
d <- make_panel(N = 40, TT = 20, T0 = 12, Ntr = 12,
beta_x = 1.5, seed = 8053)
out <- fect(Y ~ D + X1, data = d, index = c("id", "time"),
method = "fe", se = FALSE, CV = FALSE)
## Book: beta reports time-varying covariate coefficients
expect_true(!is.null(out$beta))
expect_true(is.numeric(out$beta))
})
test_that("D5: sigma2 is estimated error variance", {
skip_on_cran()
d <- make_panel(N = 50, TT = 20, T0 = 12, Ntr = 15, seed = 8054)
out <- fect(Y ~ D, data = d, index = c("id", "time"),
method = "fe", se = FALSE, CV = FALSE)
## DGP has eps ~ N(0,1) so sigma2 should be close to 1
expect_true(!is.null(out$sigma2))
expect_true(out$sigma2 > 0)
expect_true(out$sigma2 < 3,
info = "sigma2 should be in reasonable range for sd=1 DGP")
})
test_that("D6: wgt.implied dimensions = Nco × Ntr for gsynth", {
skip_on_cran()
d <- make_panel(N = 50, TT = 20, T0 = 12, Ntr = 10, r = 1, seed = 8055)
out <- fect(Y ~ D, data = d, index = c("id", "time"),
method = "gsynth", r = 1, se = FALSE, CV = FALSE)
if (!is.null(out$wgt.implied)) {
## Book: dimensions = N_co × N_tr
expect_equal(ncol(out$wgt.implied), 10) ## Ntr
expect_equal(nrow(out$wgt.implied), 40) ## N - Ntr
## Book: weights can be positive and negative
expect_true(any(out$wgt.implied > 0))
}
})
## =========================================================
## Section E: Edge Cases from Book (02-fect.Rmd, 04-gsynth.Rmd)
## =========================================================
test_that("E1: single treated unit + parametric bootstrap", {
skip_on_cran()
d <- make_panel(N = 30, TT = 20, T0 = 12, Ntr = 1, r = 1, seed = 8060)
## Book: parametric bootstrap works even with Ntr = 1
out <- suppressWarnings(fect(
Y ~ D, data = d, index = c("id", "time"),
method = "gsynth", r = 1, se = TRUE,
vartype = "parametric", nboots = 30, CV = FALSE
))
expect_true(is.numeric(out$att.avg))
expect_false(is.na(out$att.avg))
## CI should exist
expect_true(!is.null(out$est.att))
})
test_that("E2: missing Y allowed, missing D errors", {
skip_on_cran()
d <- make_panel(N = 30, TT = 15, T0 = 10, Ntr = 8, seed = 8061)
## Introduce missing Y
d$Y[sample(nrow(d), 10)] <- NA
out <- suppressWarnings(fect(
Y ~ D, data = d, index = c("id", "time"),
method = "fe", se = FALSE, CV = FALSE, na.rm = TRUE
))
expect_true(is.numeric(out$att.avg))
## Missing D should error
d2 <- make_panel(N = 30, TT = 15, T0 = 10, Ntr = 8, seed = 8062)
d2$D[5] <- NA
expect_error(
fect(Y ~ D, data = d2, index = c("id", "time"),
method = "fe", se = FALSE, CV = FALSE),
info = "Missing D should produce an error"
)
})
test_that("E3: unbalanced panel (missing time periods) works", {
skip_on_cran()
d <- make_panel(N = 40, TT = 20, T0 = 12, Ntr = 12, seed = 8063)
## Drop ~10% of observations to create unbalanced panel
keep <- sample(nrow(d), round(nrow(d) * 0.9))
d_unbal <- d[keep, ]
out <- suppressWarnings(fect(
Y ~ D, data = d_unbal, index = c("id", "time"),
method = "ife", r = 1, se = FALSE, CV = FALSE
))
expect_true(is.numeric(out$att.avg))
expect_false(is.na(out$att.avg))
})
test_that("E4: balance.period restricts included units", {
skip_on_cran()
d <- make_panel(N = 40, TT = 20, T0 = 10, Ntr = 12,
stagger = TRUE, seed = 8064)
out_full <- fect(Y ~ D, data = d, index = c("id", "time"),
method = "fe", se = FALSE, CV = FALSE)
out_bal <- fect(Y ~ D, data = d, index = c("id", "time"),
method = "fe", se = FALSE, CV = FALSE,
balance.period = c(-3, 3))
## Balanced subset should have fewer or equal treated obs
expect_true(sum(out_bal$count, na.rm = TRUE) <=
sum(out_full$count, na.rm = TRUE))
})
test_that("E5: min.T0 drops units with few control observations", {
skip_on_cran()
d <- make_panel(N = 40, TT = 20, T0 = 12, Ntr = 12, seed = 8065)
out5 <- fect(Y ~ D, data = d, index = c("id", "time"),
method = "fe", se = FALSE, CV = FALSE, min.T0 = 5)
out10 <- fect(Y ~ D, data = d, index = c("id", "time"),
method = "fe", se = FALSE, CV = FALSE, min.T0 = 10)
## Stricter min.T0 should drop more or equal treated units
expect_true(sum(out10$count, na.rm = TRUE) <=
sum(out5$count, na.rm = TRUE))
})
test_that("E6: seed produces reproducible results", {
skip_on_cran()
d <- make_panel(N = 30, TT = 15, T0 = 10, Ntr = 8, seed = 8066)
out1 <- fect(Y ~ D, data = d, index = c("id", "time"),
method = "fe", se = TRUE, nboots = 30, seed = 1234, CV = FALSE)
out2 <- fect(Y ~ D, data = d, index = c("id", "time"),
method = "fe", se = TRUE, nboots = 30, seed = 1234, CV = FALSE)
expect_equal(out1$att.avg, out2$att.avg, tolerance = 1e-10)
expect_equal(out1$est.att, out2$est.att, tolerance = 1e-10)
})
## =========================================================
## Section F: MC Method (Book: 04-gsynth.Rmd cheatsheet)
## =========================================================
test_that("F1: method='mc' basic functionality", {
skip_on_cran()
d <- make_panel(N = 40, TT = 20, T0 = 12, Ntr = 12, r = 1, seed = 8070)
out <- fect(Y ~ D, data = d, index = c("id", "time"),
method = "mc", se = FALSE, CV = FALSE)
expect_true(is.numeric(out$att.avg))
expect_false(is.na(out$att.avg))
## ATT should be in reasonable range of true tau=3.0
expect_true(abs(out$att.avg - 3.0) < 2.0)
})
test_that("F2: mc rejects time.component.from='nevertreated'", {
skip_on_cran()
d <- make_panel(N = 30, TT = 15, T0 = 10, Ntr = 8, seed = 8071)
expect_error(
fect(Y ~ D, data = d, index = c("id", "time"),
method = "mc", time.component.from = "nevertreated",
se = FALSE, CV = FALSE)
)
})
test_that("F3: mc with CV selects lambda", {
skip_on_cran()
d <- make_panel(N = 40, TT = 20, T0 = 12, Ntr = 12, r = 1, seed = 8072)
out <- fect(Y ~ D, data = d, index = c("id", "time"),
method = "mc", se = FALSE, CV = TRUE)
## Should have selected a lambda
expect_true(!is.null(out$lambda.cv) || !is.null(out$lambda))
})
## =========================================================
## Section G: CFE Features (Book: 07-cfe.Rmd)
## =========================================================
test_that("G1: CFE with unit-specific linear time trend (Q.type)", {
skip_on_cran()
d <- make_panel(N = 200, TT = 20, T0 = 12, Ntr = 60, seed = 8080)
out <- fect(Y ~ D + X1, data = d, index = c("id", "time"),
method = "cfe", r = 0, se = FALSE, CV = FALSE,
Q.type = "linear")
expect_true(is.numeric(out$att.avg))
expect_false(is.na(out$att.avg))
})
test_that("G2: CFE with time-invariant covariate Z and gamma", {
skip_on_cran()
d <- make_panel(N = 40, TT = 20, T0 = 12, Ntr = 12,
add_Z = TRUE, seed = 8081)
## Create time group for gamma: early vs late
d$time_group <- ifelse(d$time <= 10, 1, 2)
out <- fect(Y ~ D + X1, data = d, index = c("id", "time"),
method = "cfe", r = 0, se = FALSE, CV = FALSE,
Z = "Z", gamma = "time_group")
expect_true(is.numeric(out$att.avg))
expect_false(is.na(out$att.avg))
})
test_that("G3: CFE with extra group FE via index[3]", {
skip_on_cran()
d <- make_panel(N = 40, TT = 20, T0 = 12, Ntr = 12,
add_group = TRUE, seed = 8082)
## Book: extra FE specified via index with 3+ elements
out <- fect(Y ~ D + X1, data = d, index = c("id", "time", "grp"),
method = "cfe", r = 0, se = FALSE, CV = FALSE)
expect_true(is.numeric(out$att.avg))
expect_false(is.na(out$att.avg))
})
test_that("G4: CFE defaults to time.component.from='notyettreated'", {
skip_on_cran()
d <- make_panel(N = 40, TT = 20, T0 = 12, Ntr = 12, seed = 8083)
out <- fect(Y ~ D, data = d, index = c("id", "time"),
method = "cfe", r = 0, se = FALSE, CV = FALSE)
## Book: CFE defaults to notyettreated, unlike gsynth
expect_equal(out$time.component.from, "notyettreated")
})
test_that("G5: CFE with r > 0 adds latent factors", {
skip_on_cran()
d <- make_panel(N = 50, TT = 20, T0 = 12, Ntr = 10,
r = 2, seed = 8084)
out <- fect(Y ~ D, data = d, index = c("id", "time"),
method = "cfe", r = 2, se = FALSE, CV = FALSE,
time.component.from = "nevertreated")
expect_true(is.numeric(out$att.avg))
## ATT should be in reasonable range
expect_true(abs(out$att.avg - 3.0) < 2.0)
})
## =========================================================
## Section H: Inference Methods (Book: cheatsheet, 02-fect.Rmd)
## =========================================================
test_that("H1: vartype='parametric' only for gsynth/nevertreated", {
skip_on_cran()
d <- make_panel(N = 50, TT = 20, T0 = 12, Ntr = 10, r = 1, seed = 8090)
## Book: parametric specific to gsynth
out <- suppressWarnings(fect(Y ~ D, data = d, index = c("id", "time"),
method = "gsynth", r = 1, se = TRUE,
vartype = "parametric", nboots = 30, CV = FALSE))
expect_true(!is.null(out$est.att))
## Also works for ife with time.component.from='nevertreated' (Phase 3 unlocked)
out2 <- suppressWarnings(fect(Y ~ D, data = d, index = c("id", "time"),
method = "ife", time.component.from = "nevertreated",
r = 1, se = TRUE, vartype = "parametric",
nboots = 30, CV = FALSE))
expect_true(!is.null(out2$est.att))
})
test_that("H2: vartype='jackknife' works for FE and IFE", {
skip_on_cran()
d <- make_panel(N = 30, TT = 15, T0 = 10, Ntr = 8, seed = 8091)
out_fe <- fect(Y ~ D, data = d, index = c("id", "time"),
method = "fe", se = TRUE, vartype = "jackknife", CV = FALSE)
expect_true(!is.null(out_fe$est.att))
out_ife <- fect(Y ~ D, data = d, index = c("id", "time"),
method = "ife", r = 0, se = TRUE,
vartype = "jackknife", CV = FALSE)
expect_true(!is.null(out_ife$est.att))
})
test_that("H3: nboots default is 200", {
skip_on_cran()
## Check default via formals
defs <- formals(fect)
expect_equal(defs$nboots, 200)
})
## =========================================================
## Section I: Plot Types (Book: 03-plots.Rmd, 04-gsynth.Rmd)
## =========================================================
test_that("I1: gap plot (default) returns ggplot", {
skip_on_cran()
d <- make_panel(N = 30, TT = 15, T0 = 10, Ntr = 8, seed = 8100)
out <- fect(Y ~ D, data = d, index = c("id", "time"),
method = "fe", se = TRUE, nboots = 30, CV = FALSE)
p <- plot(out, type = "gap")
expect_true(inherits(p, "gg") || inherits(p, "ggplot"))
})
test_that("I2: counterfactual plot returns ggplot", {
skip_on_cran()
d <- make_panel(N = 30, TT = 15, T0 = 10, Ntr = 8, seed = 8101)
out <- fect(Y ~ D, data = d, index = c("id", "time"),
method = "fe", se = TRUE, nboots = 30, CV = FALSE)
p <- plot(out, type = "ct", id = 1)
expect_true(inherits(p, "gg") || inherits(p, "ggplot") || is.list(p))
})
test_that("I3: equivalence plot returns ggplot", {
skip_on_cran()
d <- make_panel(N = 30, TT = 15, T0 = 10, Ntr = 8, seed = 8102)
out <- fect(Y ~ D, data = d, index = c("id", "time"),
method = "fe", se = TRUE, nboots = 30, CV = FALSE)
p <- plot(out, type = "equiv")
expect_true(inherits(p, "gg") || inherits(p, "ggplot") || is.list(p))
})
test_that("I4: status plot returns ggplot", {
skip_on_cran()
d <- make_panel(N = 30, TT = 15, T0 = 10, Ntr = 8, seed = 8103)
out <- fect(Y ~ D, data = d, index = c("id", "time"),
method = "fe", se = FALSE, CV = FALSE)
p <- plot(out, type = "status")
expect_true(inherits(p, "gg") || inherits(p, "ggplot") || is.list(p))
})
test_that("I5: gsynth factor and loading plots", {
skip_on_cran()
d <- make_panel(N = 50, TT = 20, T0 = 12, Ntr = 10, r = 2, seed = 8104)
out <- fect(Y ~ D, data = d, index = c("id", "time"),
method = "gsynth", r = 2, se = FALSE, CV = FALSE)
pf <- plot(out, type = "factors")
expect_true(inherits(pf, "gg") || inherits(pf, "ggplot") || is.list(pf))
pl <- plot(out, type = "loadings")
expect_true(inherits(pl, "gg") || inherits(pl, "ggplot") ||
inherits(pl, "ggmatrix") || is.list(pl))
})
## =========================================================
## Section J: CV and Criterion Selection (Book: 02-fect.Rmd)
## =========================================================
test_that("J1: CV selects r minimizing MSPE", {
skip_on_cran()
d <- make_panel(N = 50, TT = 20, T0 = 12, Ntr = 10, r = 2, seed = 8110)
out <- fect(Y ~ D, data = d, index = c("id", "time"),
method = "ife", r = c(0, 5), se = FALSE, CV = TRUE)
## Should have selected an r
expect_true(!is.null(out$r.cv))
expect_true(out$r.cv >= 0 && out$r.cv <= 5)
})
test_that("J2: criterion='pc' runs and may select different r", {
skip_on_cran()
d <- make_panel(N = 50, TT = 20, T0 = 12, Ntr = 10, r = 2, seed = 8111)
out_mspe <- fect(Y ~ D, data = d, index = c("id", "time"),
method = "ife", r = c(0, 5), se = FALSE,
CV = TRUE, criterion = "mspe")
out_pc <- fect(Y ~ D, data = d, index = c("id", "time"),
method = "ife", r = c(0, 5), se = FALSE,
CV = TRUE, criterion = "pc")
## Both should produce valid r.cv
expect_true(!is.null(out_mspe$r.cv))
expect_true(!is.null(out_pc$r.cv))
})
## =========================================================
## Section K: Bundled Dataset Properties (Book: 01-start.Rmd)
## =========================================================
test_that("K1: simdata has 200 units and 30+ time periods", {
skip_on_cran()
data(simdata, package = "fect")
expect_equal(length(unique(simdata$id)), 200)
expect_true(length(unique(simdata$time)) >= 30)
})
test_that("K2: simdata has treatment reversals", {
skip_on_cran()
data(simdata, package = "fect")
## Check that some units switch D from 1 back to 0
has_reversal <- FALSE
for (uid in unique(simdata$id)) {
dvec <- simdata$D[simdata$id == uid]
diffs <- diff(dvec)
if (any(diffs == -1)) {
has_reversal <- TRUE
break
}
}
expect_true(has_reversal, info = "simdata should contain treatment reversals")
})
test_that("K3: simgsynth has 5 treated, 45 control, 30 periods", {
skip_on_cran()
data(simgsynth, package = "fect")
uid <- unique(simgsynth$id)
expect_equal(length(uid), 50)
expect_equal(length(unique(simgsynth$time)), 30)
## 5 treated units (check treatment ever on)
ever_treated <- tapply(simgsynth$D, simgsynth$id, max)
expect_equal(sum(ever_treated == 1), 5)
expect_equal(sum(ever_treated == 0), 45)
})
test_that("K4: simgsynth treatment starts at period 21", {
skip_on_cran()
data(simgsynth, package = "fect")
## For treated units, first treatment period should be 21
ever_treated <- tapply(simgsynth$D, simgsynth$id, max)
tr_ids <- names(ever_treated[ever_treated == 1])
for (uid in tr_ids) {
subset <- simgsynth[simgsynth$id == uid, ]
first_treat <- min(subset$time[subset$D == 1])
expect_equal(first_treat, 21,
info = paste("Unit", uid, "first treatment at", first_treat))
}
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.