## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment  = "#>",
  fig.width  = 7,
  fig.height = 4
)

## ----setup, message = FALSE---------------------------------------------------
library(forecastdom)
data(gw2006)
str(gw2006)

## ----table-horizons-----------------------------------------------------------
run_h <- function(h) {

  spf_col <- paste0("spf_h", h)
  ok <- complete.cases(gw2006[, c("infl", spf_col, "infl_lag")])
  d  <- gw2006[ok, ]
  e_spf <- d$infl - d[[spf_col]] # SPF errors
  e_rw  <- d$infl - d$infl_lag   # random-walk errors
  r <- gw_test(e_spf, e_rw)      # default: constant + lagged loss diff

  data.frame(h = h, n = nrow(d),
             mse_spf = mean(e_spf^2),
             mse_rw  = mean(e_rw^2),
             wald    = unname(r$statistic),
             pvalue  = unname(r$pvalue),
             reject  = unname(r$pvalue) < 0.05)

}

tab <- do.call(rbind, lapply(0:4, run_h))

knitr::kable(
  tab, digits = 3, row.names = FALSE,
  col.names = c("$h$", "$n$",
                "$MSE_{SPF}$", "$MSE_{RW}$",
                "Wald", "$p$-value", "Reject"))

## ----instrument-comparison----------------------------------------------------
h <- 1L
ok <- complete.cases(gw2006[, c("infl", paste0("spf_h", h), "infl_lag")])
d  <- gw2006[ok, ]
e_spf <- d$infl - d[[paste0("spf_h", h)]]
e_rw  <- d$infl - d$infl_lag

# Default: constant + lagged loss differential
r_default <- gw_test(e_spf, e_rw)

# Custom: constant + lagged inflation level (padded with NA at t = 1
# so that nrow(W) matches length(e1)).
W_infl <- cbind(1, c(NA, head(d$infl_lag, -1)))
keep   <- !is.na(W_infl[, 2])
r_infl <- gw_test(e_spf[keep], e_rw[keep],
                  instruments = W_infl[keep, , drop = FALSE])

# Absolute-error loss instead of squared-error
r_ae <- gw_test(e_spf, e_rw, loss = "AE")

tab2 <- data.frame(
  spec = c("Default (const + lagged Δloss)",
           "Const + lagged inflation",
           "Absolute-error loss"),
  wald   = c(r_default$statistic, r_infl$statistic, r_ae$statistic),
  df     = c(r_default$df,        r_infl$df,        r_ae$df),
  pvalue = c(r_default$pvalue,    r_infl$pvalue,    r_ae$pvalue)
)

knitr::kable(
  tab2, digits = 3, row.names = FALSE,
  col.names = c("Specification", "Wald", "df", "$p$-value"))