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

## ----setup, message = FALSE---------------------------------------------------
library(forecastdom)
library(ggplot2)

data(rossi2006)

## ----plot-fx------------------------------------------------------------------
ggplot(rossi2006, aes(date, log(fx))) +
  geom_line(colour = "#47A5C5") +
  facet_wrap(~ country, scales = "free_y") +
  labs(x = NULL, y = "log(FX)",
       title = "Log nominal exchange rates vs. USD") +
  theme_minimal()

## ----forecast-fn--------------------------------------------------------------
forecast_oos <- function(log_fx, p, scheme = c("split", "recursive", "rolling")) {

  scheme <- match.arg(scheme)

  T_full <- length(log_fx)
  dy <- diff(log_fx)
  Y  <- dy[3:(T_full - 1)]
  L1 <- dy[2:(T_full - 2)]
  L2 <- dy[1:(T_full - 3)]
  Xm <- if (p == 1) matrix(L1, ncol = 1) else cbind(L1, L2)

  n_obs <- length(Y)
  R     <- as.integer(ceiling(n_obs / 2))
  P_oos <- n_obs - R

  e_alt   <- numeric(P_oos)
  e_bench <- numeric(P_oos)

  for (j in seq_len(P_oos)) {

    idx <- switch(scheme,
      split     = seq_len(R),
      recursive = seq_len(R + j - 1),
      rolling   = j:(R + j - 1)
    )

    Z <- cbind(1, Xm[idx, , drop = FALSE])
    b <- as.numeric(solve(crossprod(Z), crossprod(Z, Y[idx])))
    pred <- as.numeric(c(1, Xm[R + j, ]) %*% b)

    e_alt[j]   <- Y[R + j] - pred
    e_bench[j] <- Y[R + j]

  }

  list(e_bench = e_bench, e_alt = e_alt, P = P_oos)

}

## ----run-table1---------------------------------------------------------------
countries <- levels(rossi2006$country)
schemes   <- c("split", "recursive", "rolling")

run_panel <- function(p) {

  out <- expand.grid(country = countries, scheme = schemes,
                     stringsAsFactors = FALSE)
  out$DM   <- NA_real_
  out$DM_p <- NA_real_

  for (i in seq_len(nrow(out))) {

    log_fx <- log(subset(rossi2006, country == out$country[i])$fx)
    fc     <- forecast_oos(log_fx, p = p, scheme = out$scheme[i])
    res    <- dm_test(fc$e_alt, fc$e_bench,
                      alternative = "two.sided", correction = FALSE)
    out$DM[i]   <- res$statistic
    out$DM_p[i] <- res$pvalue

  }

  out$cell <- sprintf("%.2f (%.2f)", out$DM, out$DM_p)
  wide <- reshape(out[, c("country", "scheme", "cell")],
                  idvar = "scheme", timevar = "country", direction = "wide")
  names(wide) <- gsub("^cell\\.", "", names(wide))

  wide

}

## ----tab-ar1------------------------------------------------------------------
knitr::kable(run_panel(1), row.names = FALSE,
             caption = "$DM_T$ statistic ($p$-value), AR(1) vs. RW")

## ----tab-ar2------------------------------------------------------------------
knitr::kable(run_panel(2), row.names = FALSE,
             caption = "$DM_T$ statistic ($p$-value), AR(2) vs. RW")

## ----japan--------------------------------------------------------------------
log_fx_jp <- log(subset(rossi2006, country == "Japan")$fx)
fc_jp     <- forecast_oos(log_fx_jp, p = 1, scheme = "recursive")

dm_test(fc_jp$e_alt, fc_jp$e_bench, alternative = "two.sided", correction = FALSE)

## ----cum-loss-----------------------------------------------------------------
loss_diff <- fc_jp$e_alt^2 - fc_jp$e_bench^2
oos_dates <- tail(unique(rossi2006$date), fc_jp$P)

ggplot(data.frame(date = oos_dates, cum = cumsum(loss_diff)),
       aes(date, cum)) +
  geom_hline(yintercept = 0, linetype = "dashed") +
  geom_line(colour = "#47A5C5", linewidth = 0.8) +
  labs(x = NULL,
       y = "Cumulative SE loss (AR(1) - RW)",
       title = "Cumulative squared-error loss differential, Japan",
       subtitle = "Above zero = RW doing better; below = AR(1) doing better") +
  theme_minimal()