tests/testthat/test-rbfmvar.R

In rbfmvar: Residual-Based Fully Modified Vector Autoregression

# Tests for rbfmvar package

test_that("rbfmvar estimates a basic model", {
  set.seed(123)
  n <- 100
  e <- matrix(rnorm(n * 3), n, 3)
  y <- matrix(0, n, 3)
  colnames(y) <- c("y1", "y2", "y3")

  for (t in 3:n) {
    y[t, ] <- 0.3 * y[t - 1, ] + 0.2 * y[t - 2, ] + e[t, ]
  }

  fit <- rbfmvar(y, lags = 2)

  expect_s3_class(fit, "rbfmvar")
  expect_equal(fit$n_vars, 3)
  expect_equal(fit$p_lags, 2)
  expect_true(fit$T_eff > 0)
  expect_true(fit$bandwidth > 0)
})

test_that("rbfmvar validates inputs correctly", {
  # Less than 2 variables
  expect_error(rbfmvar(matrix(rnorm(100), 100, 1)), "At least 2 variables")

  # Invalid lags
  expect_error(rbfmvar(matrix(rnorm(200), 100, 2), lags = 0), "at least 1")

  # Invalid kernel
  expect_error(rbfmvar(matrix(rnorm(200), 100, 2), kernel = "invalid"),
               "bartlett.*parzen.*qs")

  # Invalid IC
  expect_error(rbfmvar(matrix(rnorm(200), 100, 2), ic = "invalid"),
               "aic.*bic.*hq.*none")

  # Insufficient observations
  expect_error(rbfmvar(matrix(rnorm(30), 15, 2)), "Insufficient observations")
})

test_that("different kernels work", {
  set.seed(456)
  y <- matrix(rnorm(200), 100, 2)
  colnames(y) <- c("x", "y")

  fit_bart <- rbfmvar(y, lags = 2, kernel = "bartlett")
  fit_parz <- rbfmvar(y, lags = 2, kernel = "parzen")
  fit_qs <- rbfmvar(y, lags = 2, kernel = "qs")

  expect_equal(fit_bart$kernel, "bartlett")
  expect_equal(fit_parz$kernel, "parzen")
  expect_equal(fit_qs$kernel, "qs")

  # Bandwidths should be positive
  expect_true(fit_bart$bandwidth > 0)
  expect_true(fit_parz$bandwidth > 0)
  expect_true(fit_qs$bandwidth > 0)
})

test_that("lag selection via IC works", {
  skip_on_cran()  # May be slow

  set.seed(789)
  n <- 150
  e <- matrix(rnorm(n * 2), n, 2)
  y <- matrix(0, n, 2)
  colnames(y) <- c("x", "y")

  for (t in 4:n) {
    y[t, ] <- 0.5 * y[t - 1, ] + 0.2 * y[t - 2, ] + e[t, ]
  }

  fit_aic <- suppressMessages(rbfmvar(y, max_lags = 4, ic = "aic"))
  fit_bic <- suppressMessages(rbfmvar(y, max_lags = 4, ic = "bic"))

  expect_true(fit_aic$p_lags >= 1)
  expect_true(fit_bic$p_lags >= 1)
  expect_equal(fit_aic$ic, "aic")
  expect_equal(fit_bic$ic, "bic")
})

test_that("summary method works", {
  set.seed(111)
  y <- matrix(rnorm(200), 100, 2)
  colnames(y) <- c("x", "y")

  fit <- rbfmvar(y, lags = 2)
  summ <- summary(fit)

  expect_s3_class(summ, "summary.rbfmvar")
  expect_true("coefficients" %in% names(summ))
  expect_equal(length(summ$coefficients), 2)
})

test_that("coef, residuals, fitted methods work", {
  set.seed(222)
  y <- matrix(rnorm(200), 100, 2)
  colnames(y) <- c("x", "y")

  fit <- rbfmvar(y, lags = 2)

  cf <- coef(fit)
  expect_true(is.matrix(cf))

  res <- residuals(fit)
  expect_true(is.matrix(res))
  expect_equal(ncol(res), 2)

  ft <- fitted(fit)
  expect_true(is.matrix(ft))
  expect_equal(ncol(ft), 2)
})

test_that("Granger causality test works", {
  set.seed(333)
  n <- 150
  e <- matrix(rnorm(n * 2), n, 2)
  y <- matrix(0, n, 2)
  colnames(y) <- c("x", "y")

  # x causes y
  for (t in 3:n) {
    y[t, "x"] <- 0.5 * y[t - 1, "x"] + e[t, 1]
    y[t, "y"] <- 0.3 * y[t - 1, "y"] + 0.4 * y[t - 1, "x"] + e[t, 2]
  }

  fit <- rbfmvar(y, lags = 2)
  test <- granger_test(fit, cause = "x", effect = "y")

  expect_s3_class(test, "rbfmvar_granger")
  expect_true(test$statistic >= 0)
  expect_true(test$p.value >= 0 && test$p.value <= 1)
  expect_true(test$df >= 1)
})

test_that("IRF computation works", {
  set.seed(444)
  y <- matrix(rnorm(200), 100, 2)
  colnames(y) <- c("x", "y")

  fit <- rbfmvar(y, lags = 2)
  ir <- irf(fit, horizon = 10)

  expect_s3_class(ir, "rbfmvar_irf")
  expect_equal(ir$horizon, 10)
  expect_true(is.array(ir$irf))
  expect_equal(dim(ir$irf)[1], 11)  # horizon + 1
})

test_that("FEVD computation works", {
  set.seed(555)
  y <- matrix(rnorm(200), 100, 2)
  colnames(y) <- c("x", "y")

  fit <- rbfmvar(y, lags = 2)
  fv <- fevd(fit, horizon = 10)

  expect_s3_class(fv, "rbfmvar_fevd")
  expect_equal(fv$horizon, 10)
  expect_true(is.array(fv$fevd))

  # FEVD should sum to 1 for each variable at each horizon
  for (h in 1:11) {
    for (i in 1:2) {
      total <- sum(fv$fevd[h, i, ])
      expect_equal(total, 1, tolerance = 1e-6)
    }
  }
})

test_that("forecast method works", {
  set.seed(666)
  y <- matrix(rnorm(200), 100, 2)
  colnames(y) <- c("x", "y")

  fit <- rbfmvar(y, lags = 2)
  fc <- forecast(fit, h = 5)

  expect_s3_class(fc, "rbfmvar_forecast")
  expect_equal(fc$horizon, 5)
  expect_true(is.matrix(fc$mean))
  expect_equal(ncol(fc$mean), 5)
  expect_equal(nrow(fc$mean), 2)

  # Lower bound should be less than upper
  expect_true(all(fc$lower <= fc$upper))
})

test_that("Granger matrix works", {
  set.seed(777)
  y <- matrix(rnorm(300), 100, 3)
  colnames(y) <- c("x", "y", "z")

  fit <- rbfmvar(y, lags = 2)
  gm <- granger_matrix(fit)

  expect_true(is.matrix(gm))
  expect_equal(nrow(gm), 3)
  expect_equal(ncol(gm), 3)

  # Diagonal should be NA
  expect_true(all(is.na(diag(gm))))

  # Off-diagonal should be valid p-values
  off_diag <- gm[!is.na(gm)]
  expect_true(all(off_diag >= 0 & off_diag <= 1))
})