tests/testthat/test-dynare.R

In qpmR: Quarterly Projection Models for Monetary Policy Analysis

# Cross-check against Dynare.
#
# golden/dynare.rds holds impulse responses and steady states produced by
# Dynare 6.0 (via MATLAB) from the .mod files that write_dynare() emits.
# Regenerate with data-raw/dynare_golden.R after any change to the
# shipped templates or the solver.

golden <- readRDS(test_path("golden", "dynare.rds"))

compare_to_dynare <- function(g) {
  sol <- qpm_solve(qpm_template(g$template))
  worst_irf <- 0
  for (s in sol$shocks) {
    ir <- irf(sol, shock = s, horizon = 21)   # 1 sd, as Dynare uses
    for (v in sol$vars) {
      d <- g$irfs[g$irfs$name == paste0(v, "_", s), , drop = FALSE]
      if (!nrow(d)) next
      d <- d[order(d$h), ]
      qv <- ir$value[ir$variable == v]        # h = 0 is impact = Dynare h = 1
      worst_irf <- max(worst_irf, max(abs(d$value - qv[seq_len(nrow(d))])))
    }
  }
  ssq <- steady_state(sol)
  shared <- intersect(g$steady$name, names(ssq))   # Dynare adds its own aux vars
  worst_ss <- max(abs(g$steady$value[match(shared, g$steady$name)] - ssq[shared]))
  list(irf = worst_irf, ss = worst_ss, n = nrow(g$irfs))
}

test_that("the canonical model matches Dynare to solver tolerance", {
  r <- compare_to_dynare(golden$bkl)
  expect_gt(r$n, 3000)              # the comparison is broad, not token
  expect_lt(r$irf, 1e-10)           # observed: 1.4e-14
  expect_lt(r$ss, 1e-10)
})

test_that("the food-block model matches Dynare", {
  # this also checks add_block(): Dynare parses the original equations and
  # builds its own auxiliary variables, so agreement is independent
  r <- compare_to_dynare(golden$bkl_food)
  expect_gt(r$n, 3000)
  expect_lt(r$irf, 1e-10)           # observed: 1.7e-14
  expect_lt(r$ss, 1e-10)
})

test_that("write_dynare emits valid Dynare syntax", {
  src <- write_dynare(qpm_template("bkl"), file = NULL, irf = 12)
  txt <- paste(src, collapse = "\n")
  expect_match(txt, "^// Generated by qpmR")
  for (kw in c("var", "varexo", "parameters", "model(linear);", "end;",
               "shocks;", "steady;", "check;", "stoch_simul"))
    expect_true(grepl(kw, txt, fixed = TRUE), info = kw)
  # lags and leads use Dynare parentheses, never R brackets
  expect_true(grepl("pi(-1)", txt, fixed = TRUE))
  expect_true(grepl("pi4(+4)", txt, fixed = TRUE))
  expect_false(grepl("[", txt, fixed = TRUE))
  # expectation wrappers are dropped, and no integer-literal suffixes leak
  expect_false(grepl("E(", txt, fixed = TRUE))
  expect_false(grepl("L)", txt, fixed = TRUE))
  # every declared object appears
  m <- qpm_template("bkl")
  for (nm in c(m$vars$name, m$shocks, names(m$params)))
    expect_true(grepl(nm, txt, fixed = TRUE), info = nm)
})

test_that("write_dynare writes a file and reports invalid identifiers", {
  f <- file.path(tempdir(), "m.mod")
  unlink(f)
  expect_invisible(write_dynare(qpm_template("bkl"), f))
  expect_true(file.exists(f))
  expect_gt(length(readLines(f)), 40)
  unlink(f)

  bad <- qpm_model(variables = vars(y.gap = "dotted"), shocks = shocks(e),
                   equations = eqs(y.gap ~ 0.5 * y.gap[-1] + e))
  expect_error(write_dynare(bad, file = NULL), "valid Dynare identifiers")
})

test_that("shock standard deviations are exported", {
  m <- qpm_calibrate(qpm_template("bkl"), sigma = c(eps_pi = 2.25))
  txt <- paste(write_dynare(m, file = NULL), collapse = "\n")
  expect_true(grepl("var eps_pi; stderr 2.25;", txt, fixed = TRUE))
})