tests/testthat/test-dcee-numeric-golden-lm.R

In MRTAnalysis: Assessing Proximal, Distal, and Mediated Causal Excursion Effects for Micro-Randomized Trials

test_that("dcee: numeric outputs are stable on a tiny deterministic DGM (lm)", {
    skip_on_cran()

    set.seed(42)

    # ----- Tiny generative model (fast + simple) --------------------------------
    # Structure matches distal format: multiple rows per id, Y is distal (constant within id)
    n <- 60 # subjects
    Tt <- 4 # decision points per subject

    df <- data.frame(
        userid = rep(seq_len(n), each = Tt),
        dp     = rep(seq_len(Tt), times = n)
    )

    # Availability and randomization probability
    df$avail <- 1L
    df$prob_A <- 0.5

    # Time-varying covariates and treatment
    df$X <- rnorm(n * Tt, 0, 1)
    df$Z <- rbinom(n * Tt, 1, 0.4)
    df$A <- rbinom(n * Tt, 1, df$prob_A) * df$avail

    # Distal outcome Y (constant per subject).
    # Simple, linear signal tied to X and A*X so the moderator example is meaningful.
    # Y_i = c0 + c1*mean(X_i.) + c2*mean(A_i.) + c3*mean(A_i.*X_i.) + eps
    c0 <- 0.3
    c1 <- 0.8
    c2 <- 0.5
    c3 <- 1.2
    dY <- aggregate(cbind(X, A) ~ userid, data = df, FUN = mean)
    dAX <- aggregate(I(A * X) ~ userid, data = df, FUN = mean)
    dY <- merge(dY, dAX, by = "userid")
    names(dY) <- c("userid", "mX", "mA", "mAX")
    dY$eps <- rnorm(n, 0, 0.15)
    dY$Y <- with(dY, c0 + c1 * mX + c2 * mA + c3 * mAX + eps)

    df <- merge(df, dY[c("userid", "Y")], by = "userid", all.x = TRUE)

    # ----- Fit 1: Marginal effect (no moderators) -------------------------------
    fit_mar <- dcee(
        data = df,
        id = "userid", outcome = "Y", treatment = "A", rand_prob = "prob_A",
        moderator_formula = ~1,
        control_formula = ~X, # nuisance model uses X (linear)
        availability = "avail",
        control_reg_method = "lm",
        cross_fit = FALSE,
        verbose = FALSE
    )

    # Current "golden" values: run once, print, and paste below.
    # cat("beta_hat (marginal) =", dput(unclass(fit_mar$fit$beta_hat)))
    # cat("beta_se  (marginal) =", dput(unclass(fit_mar$fit$beta_se)))
    # cat("beta_V   (marginal) =", dput(unclass(fit_mar$fit$beta_varcov)))

    # ---- TODO: paste the numbers you get on first run here ---------------------
    expected_beta_mar <- structure(
        c(
            0.0580563073126 # Intercept
        ),
        .Names = "Intercept"
    )
    expected_se_mar <- structure(
        c(0.0657496189214),
        .Names = "Intercept"
    )
    expected_V_mar <- matrix(
        c(0.00432301238831),
        nrow = 1, dimnames = list("Intercept", "Intercept")
    )
    # ---------------------------------------------------------------------------

    # Check numeric equality with tight tolerances (adjust if needed)
    expect_equal(unclass(fit_mar$fit$beta_hat), expected_beta_mar, tolerance = 1e-8)
    expect_equal(unclass(fit_mar$fit$beta_se), expected_se_mar, tolerance = 1e-8)
    expect_equal(fit_mar$fit$beta_varcov, expected_V_mar, tolerance = 1e-8)

    # Also check CI agrees with beta ± t_crit * se using df from object
    df_mar <- fit_mar$df
    tcrit <- stats::qt(0.975, df = df_mar)
    ci_low <- expected_beta_mar - tcrit * expected_se_mar
    ci_high <- expected_beta_mar + tcrit * expected_se_mar
    got_ci <- fit_mar$fit$conf_int_tquantile
    expect_equal(as.numeric(got_ci[, 1]), as.numeric(ci_low), tolerance = 1e-8)
    expect_equal(as.numeric(got_ci[, 2]), as.numeric(ci_high), tolerance = 1e-8)

    # ----- Fit 2: Moderated effect (moderator = X) ------------------------------
    fit_mod <- dcee(
        data = df,
        id = "userid", outcome = "Y", treatment = "A", rand_prob = "prob_A",
        moderator_formula = ~X, # estimate intercept + effect moderated by X
        control_formula = ~X, # nuisance model uses X (linear)
        availability = "avail",
        control_reg_method = "lm",
        cross_fit = FALSE,
        verbose = FALSE
    )

    # cat("beta_hat (moderated) =", dput(unclass(fit_mod$fit$beta_hat)))
    # cat("beta_se  (moderated) =", dput(unclass(fit_mod$fit$beta_se)))
    # cat("beta_V   (moderated) =", dput(unclass(fit_mod$fit$beta_varcov)))

    # ---- TODO: paste the numbers you get on first run here ---------------------
    expected_beta_mod <- structure(
        c(
            0.0632080918257, # Intercept
            0.1334112843198
        ), # X
        .Names = c("Intercept", "X")
    )
    expected_se_mod <- structure(
        c(
            0.0646006154111,
            0.0758280636588
        ),
        .Names = c("Intercept", "X")
    )
    expected_V_mod <- matrix(
        c(
            0.004173239511498, 0.000404412691711,
            0.000404412691711, 0.005749895238241
        ),
        nrow = 2, byrow = TRUE,
        dimnames = list(c("Intercept", "X"), c("Intercept", "X"))
    )
    # ---------------------------------------------------------------------------

    expect_equal(unclass(fit_mod$fit$beta_hat), expected_beta_mod, tolerance = 1e-8)
    expect_equal(unclass(fit_mod$fit$beta_se), expected_se_mod, tolerance = 1e-8)
    expect_equal(fit_mod$fit$beta_varcov, expected_V_mod, tolerance = 1e-8)

    # summary() lincomb: test L = [0,1] to extract the X effect
    s <- summary(fit_mod, lincomb = c(0, 1), conf_level = 0.95)
    estL <- as.numeric(expected_beta_mod["X"])
    seL <- as.numeric(expected_se_mod["X"])
    dfL <- fit_mod$df
    tcritL <- stats::qt(0.975, df = dfL)
    expect_equal(as.numeric(s$lincomb$Estimate), estL, tolerance = 1e-8)
    expect_equal(as.numeric(s$lincomb$`Std. Error`), seL, tolerance = 1e-8)
    expect_equal(s$lincomb$df, dfL)
    # CIs
    LCL_col <- grep("LCL$", names(s$lincomb), value = TRUE)
    UCL_col <- grep("UCL$", names(s$lincomb), value = TRUE)
    expect_equal(as.numeric(s$lincomb[[LCL_col]]), estL - tcritL * seL, tolerance = 1e-8)
    expect_equal(as.numeric(s$lincomb[[UCL_col]]), estL + tcritL * seL, tolerance = 1e-8)
})