tests/testthat/test-rolling-graphical-var.R

In idiographic: Person-Specific (Idiographic) and Heterogeneous Complex Networks

test_that("fit_rolling_graphical_var returns tidy windowed graphical VAR estimates", {
  d <- synth_single(n_t = 100, vars = c("A", "B", "C"), seed = 801)
  tv <- fit_rolling_graphical_var(
    d, vars = c("A", "B", "C"), id = "id", day = "day", beep = "beep",
    window_size = 50, step = 25, scale = FALSE, center_within = FALSE,
    n_lambda = 5
  )

  expect_s3_class(tv, "rolling_gvar_result")
  expect_equal(tv$n_windows, 3L)
  expect_named(tv$windows,
               c("subject", "window", "start_row", "end_row", "start_day",
                 "end_day", "start_beep", "end_beep"))
  expect_named(tv$estimates,
               c("subject", "window", "start_row", "end_row", "start_day",
                 "end_day", "start_beep", "end_beep",
                 "network", "from", "to", "weight"))
  expect_true(all(c("temporal", "contemporaneous") %in%
                    unique(tv$estimates$network)))
  expect_output(print(tv), "Rolling Graphical VAR Result")
  expect_equal(as.data.frame(tv), tv$estimates)
})

test_that("fit_rolling_graphical_var window estimates equal direct graphical_var calls", {
  d <- synth_single(n_t = 100, vars = c("A", "B", "C"), seed = 802)
  vars <- c("A", "B", "C")
  tv <- fit_rolling_graphical_var(
    d, vars = vars, id = "id", day = "day", beep = "beep",
    window_size = 50, step = 25, scale = FALSE, center_within = FALSE,
    n_lambda = 5
  )

  direct <- fit_graphical_var(d[1:50, , drop = FALSE], vars = vars, id = "id",
                          day = "day", beep = "beep",
                          scale = FALSE, center_within = FALSE,
                          n_lambda = 5)
  got <- subset(tv$estimates, window == 1,
                select = c("network", "from", "to", "weight"))
  expect_equal(got, coefs(direct), tolerance = 1e-12, ignore_attr = TRUE)
})

test_that("fit_rolling_graphical_var detects a planted changing lagged effect", {
  set.seed(603)
  n <- 180
  A <- numeric(n)
  B <- numeric(n)
  A[1] <- stats::rnorm(1)
  B[1] <- stats::rnorm(1)
  for (t in 2:n) {
    lag_effect <- if (t <= 90) 0.65 else -0.65
    A[t] <- 0.45 * A[t - 1L] + stats::rnorm(1, sd = 0.4)
    B[t] <- lag_effect * A[t - 1L] + 0.35 * B[t - 1L] +
      stats::rnorm(1, sd = 0.4)
  }
  d <- data.frame(id = 1, day = 1, beep = seq_len(n), A = A, B = B)

  tv <- fit_rolling_graphical_var(
    d, vars = c("A", "B"), id = "id", day = "day", beep = "beep",
    window_size = 70, step = 50, scale = FALSE, center_within = FALSE,
    lambda_beta = 0.02, lambda_kappa = 0.02, n_lambda = 5
  )
  ab <- subset(tv$estimates, network == "temporal" & from == "A" & to == "B")

  expect_gt(ab$weight[ab$window == 1], 0.45)
  expect_lt(ab$weight[ab$window == 3], -0.35)
})

test_that("fit_rolling_graphical_var validates window geometry and filters subjects", {
  d <- synth_panel(n_id = 3, days = 2, beeps = 12, vars = c("A", "B"),
                   seed = 803)
  one <- fit_rolling_graphical_var(
    d, vars = c("A", "B"), id = "id", day = "day", beep = "beep",
    window_size = 16, step = 8, subject = 2, scale = FALSE, n_lambda = 5
  )

  expect_equal(unique(one$windows$subject), "2")
  expect_error(
    fit_rolling_graphical_var(d, vars = c("A", "B"), id = "id", day = "day",
                          beep = "beep", window_size = 200),
    "No rolling graphical VAR windows"
  )
})