## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  fig.width = 6.5,
  fig.height = 3.8
)
set.seed(2024)
library(bridgr)
`%m+%` <- lubridate::`%m+%`

## ----data---------------------------------------------------------------------
gdp_growth <- suppressMessages(tsbox::ts_na_omit(tsbox::ts_pc(gdp)))

# Evaluation window: the most recent 10 completed quarters.
n_q <- nrow(gdp_growth)
eval_indices <- (n_q - 11):(n_q - 2)
eval_quarters <- gdp_growth$time[eval_indices]
range(eval_quarters)

## ----helpers------------------------------------------------------------------
fit_at_vintage <- function(target_q, vintage, aggregator) {
  train_target <- gdp_growth |>
    dplyr::filter(.data$time < target_q)

  cutoff_month <- target_q %m+% lubridate::period(num = vintage, units = "month")
  train_indic <- baro |>
    dplyr::filter(.data$time < cutoff_month)

  solver <- if (aggregator == "expalmon") {
    list(seed = 1, n_starts = 1, maxiter = 50)
  } else {
    NULL
  }

  mf_model(
    target = train_target,
    indic = train_indic,
    indic_predict = "last",
    indic_aggregators = aggregator,
    target_lags = 1,
    h = 1,
    solver_options = solver
  )
}

## ----single-quarter-----------------------------------------------------------
demo_q <- eval_quarters[length(eval_quarters) - 2]
demo_truth <- gdp_growth$values[gdp_growth$time == demo_q]

demo_methods <- c("mean", "unrestricted", "expalmon")
demo_rows <- list()
for (m in demo_methods) {
  for (v in 0:2) {
    fit <- fit_at_vintage(demo_q, v, m)
    fc <- as.numeric(forecast(fit)$mean)[[1]]
    demo_rows[[length(demo_rows) + 1]] <- dplyr::tibble(
      method = m, vintage = v, forecast = fc
    )
  }
}
demo_df <- dplyr::bind_rows(demo_rows)

ggplot2::ggplot(
  demo_df,
  ggplot2::aes(x = .data$vintage, y = .data$forecast, color = .data$method)
) +
  ggplot2::geom_line(linewidth = 0.8) +
  ggplot2::geom_point(size = 2) +
  ggplot2::geom_hline(
    yintercept = demo_truth,
    linetype = "dashed",
    color = "grey40"
  ) +
  ggplot2::scale_x_continuous(breaks = 0:2) +
  ggplot2::labs(
    title = paste0(
      "Nowcasting ", format(demo_q, "%Y Q%q"),
      " across three vintages (dashed = realized value)"
    ),
    x = "Vintage (months of indicator observed inside the target quarter)",
    y = "GDP growth forecast"
  ) +
  theme_bridgr()

## ----loop---------------------------------------------------------------------
methods <- c("mean", "unrestricted", "expalmon")
results <- list()

for (q_idx in seq_along(eval_quarters)) {
  target_q <- eval_quarters[[q_idx]]
  truth <- gdp_growth$values[gdp_growth$time == target_q]
  for (v in 0:2) {
    for (m in methods) {
      fit <- fit_at_vintage(target_q, v, m)
      fc <- as.numeric(forecast(fit)$mean)[[1]]
      results[[length(results) + 1]] <- dplyr::tibble(
        target_q = target_q,
        vintage = v,
        method = m,
        forecast = fc,
        actual = truth,
        error = fc - truth
      )
    }
  }
}

# Sample-mean benchmark: prevailing-mean of in-sample target growth.
for (q_idx in seq_along(eval_quarters)) {
  target_q <- eval_quarters[[q_idx]]
  truth <- gdp_growth$values[gdp_growth$time == target_q]
  bench <- mean(gdp_growth$values[gdp_growth$time < target_q])
  for (v in 0:2) {
    results[[length(results) + 1]] <- dplyr::tibble(
      target_q = target_q,
      vintage = v,
      method = "sample mean",
      forecast = bench,
      actual = truth,
      error = bench - truth
    )
  }
}

results_df <- dplyr::bind_rows(results)

## ----scoreboard---------------------------------------------------------------
scoreboard <- results_df |>
  dplyr::group_by(.data$method, .data$vintage) |>
  dplyr::summarise(
    rmse = sqrt(mean(.data$error^2)),
    mae = mean(abs(.data$error)),
    .groups = "drop"
  ) |>
  dplyr::arrange(.data$method, .data$vintage)

scoreboard

## ----scoreboard-plot----------------------------------------------------------
ggplot2::ggplot(
  scoreboard,
  ggplot2::aes(x = .data$vintage, y = .data$rmse, color = .data$method)
) +
  ggplot2::geom_line(linewidth = 0.8) +
  ggplot2::geom_point(size = 2) +
  ggplot2::scale_x_continuous(breaks = 0:2) +
  ggplot2::labs(
    title = "Nowcast RMSE by vintage",
    x = "Vintage (months of indicator observed inside the target quarter)",
    y = "RMSE",
    color = NULL
  ) +
  theme_bridgr()

## ----fc-vs-actual-------------------------------------------------------------
ggplot2::ggplot(
  results_df,
  ggplot2::aes(x = .data$actual, y = .data$forecast, color = .data$method)
) +
  ggplot2::geom_abline(slope = 1, intercept = 0, color = "grey50") +
  ggplot2::geom_point(alpha = 0.8) +
  ggplot2::facet_wrap(~ .data$vintage, labeller = ggplot2::label_both) +
  ggplot2::labs(
    title = "Forecasts vs. realizations by vintage",
    x = "Realized GDP growth",
    y = "Nowcast"
  ) +
  theme_bridgr()