## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(message = FALSE, warning = TRUE, fig.width = 7,
                      fig.height = 7)

library(tsgc)
library(dplyr)
library(ggplot2)
library(ggthemes)
library(zoo)
library(xts)
theme_set(theme_economist_white(gray_bg = FALSE, base_size = 16))

## ----load-gauteng-xts---------------------------------------------------------
data(gauteng, package = "tsgc")

## ----convert-gauteng----------------------------------------------------------
conv <- xts_to_idx(gauteng)
gauteng_idx <- conv$series
gauteng_cal <- conv$calendar
gauteng_cal$anchor_name <- "first recorded case"

## ----make-fig-1, fig.cap="Figure 1: New Cases and their centered 7-day moving average for Gauteng province in South Africa between 10 March 2020 and 5 January 2022."----
mod_all <- SSModelDynamicGompertz(Y = gauteng_idx, calendar = gauteng_cal)
plot(mod_all, series.name = "daily cases", MA_period = 7)

## ----set_options--------------------------------------------------------------
Y <- gauteng_idx
cal <- gauteng_cal

estimation.pos.start <- idx_to_pos(cal, "2021-02-01")
estimation.pos.end   <- idx_to_pos(cal, "2021-05-03")
n.forecasts <- 14
q <- 0.005
confidence.level <- 0.68
plt.length <- 30

## ----model_est_free_q---------------------------------------------------------
model_q <- SSModelDynamicGompertz(Y = Y, sea.period = 7,
                                  start = estimation.pos.start,
                                  end = estimation.pos.end,
                                  calendar = cal)
res_q <- estimate(model_q)

## ----model_est_fix_q----------------------------------------------------------
model <- SSModelDynamicGompertz(Y = Y, q = q, sea.period = 7,
                                start = estimation.pos.start,
                                end = estimation.pos.end,
                                calendar = cal)
res <- estimate(model)

## ----model-diagnostics--------------------------------------------------------
summary(res)
tsgc::print_model_diagnostics(res)

## ----fig-2, fig.cap="Figure 2: Fourteen-day forecast of $ln(g_t)$ from 4 May 2021, for Gauteng province in South Africa."----
tsgc::plot_log_forecast(
  res = res,
  Y = Y,
  n.ahead = n.forecasts,
  plt.start = tail(res$index, 1) - plt.length
)

## ----fig-3, fig.cap = "Figure 3: Fourteen-day forecast of new cases from 4 May 2021 for Gauteng province in South Africa. The shaded region is a state-implied forecast band obtained by propagating uncertainty in the latent log growth rate."----
tsgc::plot_forecast(
  res = res,
  n.ahead = n.forecasts,
  confidence.level = confidence.level,
  plt.start = tail(res$index, 1) - plt.length,
  series.name = "cases"
)

## ----fig-4, fig.cap = "Figure 4: Accuracy of the fourteen-day forecast of new cases from 20 April 2021 for Gauteng province in South Africa."----
# Update estimation end position
estimation.pos.end <- idx_to_pos(cal, "2021-04-19")

# Reestimate the model
model <- SSModelDynamicGompertz$new(Y = Y, q = q, sea.period = 7,
                                    start = estimation.pos.start,
                                    end = estimation.pos.end,
                                    calendar = cal)
res_eval <- estimate(model)

tsgc::plot_holdout(
  res = res_eval,
  Y = Y,
  n.ahead = 14,
  confidence.level = 0.68,
  series.name = "cases"
)

## ----calc_rt------------------------------------------------------------------
gen_int <- 4
r.t <- estimate_r0(res, gen_int, n.ahead = 7)
r.t

## ----fig-5, fig.cap = "Figure 5: Reproduction numbers for the 7-day period to 3 May 2021, for Gauteng province in South Africa."----
plot_r0(res, gen_int = gen_int, n.ahead = 7,
        title = "Reproduction numbers for the 7-day period to 3 May 2021")

## ----write_results, eval=F----------------------------------------------------
# res.dir <- here::here(here::here(), "results")
# 
# tsgc::write_results(
#  res = res,
#  res.dir = res.dir,
#  n.ahead = n.forecasts,
#  confidence.level = confidence.level
# )

## ----change-est-date-end------------------------------------------------------
estimation.pos.end <- idx_to_pos(cal, "2021-06-25")

## ----fig-6, fig.cap = "Figure 6: Trigger for reinitialization: reinitialization is triggered when the two-standard-error lower threshold of the smoothed slope (slope - 2*se) crosses zero. Lines shown are k-SE thresholds, not confidence bands around the slope. Reset date selected from a single retrospective episode; not a validated general rule."----
# Re-estimate model
model <- SSModelDynamicGompertz$new(Y = Y, q = q, sea.period = 7,
                                    start = estimation.pos.start,
                                    end = estimation.pos.end,
                                    calendar = cal)
res <- estimate(model)

# Extract the smoothed slope and its standard deviation as idx_series,
# then convert to a data.frame with real dates for plotting.
smoothed.slope.full <- idx_series(res$output$alphahat[, "slope"], start = res$index[1])
V.smoothed <- get_V(res$output)
i.slope <- grep("slope", colnames(res$output$alphahat))
smoothed.P.slope <- idx_series(V.smoothed[i.slope, i.slope, ], start = res$index[1])

common_pos <- idx_positions(smoothed.slope.full)
d2 <- idx_series(
  cbind(
    smoothed.slope = idx_values(smoothed.slope.full),
    sd.smoothed.slope = sqrt(idx_values(smoothed.P.slope)),
    sd.smoothed.slope.1.5 = 1.5 * sqrt(idx_values(smoothed.P.slope)),
    sd.smoothed.slope.2 = 2 * sqrt(idx_values(smoothed.P.slope))
  ),
  start = common_pos[1]
)

d2.mat <- as.matrix(idx_values(d2))
d2.df <- data.frame(
  Date = idx_to_date(cal, idx_positions(d2)),
  smoothed.slope = d2.mat[, "smoothed.slope"],
  sd.smoothed.slope = d2.mat[, "sd.smoothed.slope"],
  sd.smoothed.slope.1.5 = d2.mat[, "sd.smoothed.slope.1.5"],
  sd.smoothed.slope.2 = d2.mat[, "sd.smoothed.slope.2"]
)

d2.df <- d2.df[d2.df$Date >= as.Date("2021-02-15"), ]

# zt = smoothed slope minus its own two-standard-error threshold (the
# lower bound of the two-SE interval).
d2.df$zt <- d2.df$smoothed.slope - d2.df$sd.smoothed.slope.2

trigger.df <- d2.df %>%
  mutate(prev_zt = lag(zt)) %>%
  filter(zt > 0 & prev_zt <= 0)
# Triggered when the two-SE lower bound of the smoothed slope crosses zero

reinit_zero.df <- d2.df %>%
  mutate(prev_smoothed.slope = dplyr::lag(smoothed.slope)) %>%
  filter(Date < min(trigger.df$Date) &
           (smoothed.slope > 0 & prev_smoothed.slope < 0)) %>%
  arrange(desc(Date)) %>%
  slice(1)
# Reinitialisation on April 21.

# Create plot
ggplot(data = d2.df,
      aes(x = Date)) +
  geom_line(aes(y = smoothed.slope,
                color = "smoothed.slope"), linewidth=.5) +
  geom_line(aes(y = sd.smoothed.slope,
                color = "sd.smoothed.slope"),
            linetype = "solid",
            linewidth=.25) +
  geom_line(aes(y = sd.smoothed.slope.1.5,
                color = "sd.smoothed.slope.1.5"),
            linetype = "solid",
            linewidth=.25) +
  geom_line(aes(y = sd.smoothed.slope.2,
                color = "sd.smoothed.slope.2"),
            linetype = "solid",
            linewidth=.5) +
  scale_y_continuous(n.breaks = 10) +
  geom_hline(yintercept = 0,
             linetype = "solid",
             color = "black",linewidth = 1)+
  geom_vline(data = trigger.df,
             aes(xintercept = Date),
             linetype = "solid", linewidth = .5,
             color = "black")+
  ylab("Slope") +
  scale_x_date(date_breaks = "10 days") +
  scale_color_manual(name='',
                     values=c('smoothed.slope'='red',
                              'sd.smoothed.slope'='blue',
                              'sd.smoothed.slope.1.5'='green',
                              'sd.smoothed.slope.2'='black'))+
  theme_light(base_size = 11)+
  #theme(legend.position = c(.88, 0.25))+
  theme(legend.title=element_text(size=2),
        legend.text=element_text(size=6))+
  theme(axis.text.x = element_text(angle = 45, hjust = 1, size = 8),
        plot.title = element_text(face = "bold"))

## ----set_reinit_date----------------------------------------------------------
reinit.pos <- idx_to_pos(cal, "2021-04-21")

## ----reinit_estim-------------------------------------------------------------
model <- SSModelDynamicGompertz$new(
  Y = Y, q = q, sea.period = 7,
  start = estimation.pos.start,
  end = estimation.pos.end,
  reinit.idx = reinit.pos,
  calendar = cal
)
res.reinit <- estimate(model)

## ----fig-7, fig.cap = "Figure 7: Forecast of $ln(g_t)$ after reinitialization."----
tsgc::plot_log_forecast(
    res = res.reinit,
    Y = Y,
    n.ahead = n.forecasts,
    plt.start = tail(res.reinit$index, 1) - plt.length,
    title='Forecast of log growth rate after reinitialization.'
)

## ----fig-8, fig.cap = "Figure 8: Forecast accuracy of the model without reinitialization over the hold-out sample period: 14 days from 25 June 2021."----
tsgc::plot_holdout(
  res = res,
  Y = Y,
  n.ahead = 14,
  confidence.level = 0.68,
  series.name = "cases"
)

## ----fig-9, fig.cap = "Figure 9: Forecast accuracy of the model with reinitialization over the hold-out sample period: 14 days from 25 June 2021."----
tsgc::plot_holdout(
  res = res.reinit,
  Y = Y,
  n.ahead = 14,
  confidence.level = 0.68,
  series.name = "cases"
)

## ----fig-10, fig.cap = "Figure 10: Comparison of standard (green) and reinitialized (blue) forecasts"----
tsgc::plot_compare_forecast(
  results = list(res.reinit, res),
  n.ahead = 14,
  actual = Y
)

## ----li-setup-----------------------------------------------------------------
data(england, package = "tsgc")

conv <- xts_to_idx(england[, 1:2])
eng <- conv$series
eng_cal <- conv$calendar

est.start.eng <- idx_to_pos(eng_cal, "2021-04-30")
est.end.eng   <- idx_to_pos(eng_cal, "2021-07-24")
n.lag.eng     <- 4
n.forecasts.eng <- 7
plt.length.eng  <- 14

## ----li-plot, fig.cap = "Figure 11: Daily COVID cases and hospitalisations, England."----
mod.eng.plot <- SSModelLeadingIndicator$new(eng, n.lag = n.lag.eng, calendar = eng_cal)
plot(
  mod.eng.plot,
  title = "Daily COVID cases and hospitalisations (England)",
  series.name.lead = "Cases",
  series.name.target = "Hospitalisations",
  take.log = TRUE
)

## ----li-estimate--------------------------------------------------------------
mod.eng <- SSModelLeadingIndicator$new(
  Y = eng,
  n.lag = n.lag.eng,
  LeadIndCol = 1,
  sea.period = 7,
  start = est.start.eng,
  end = est.end.eng,
  calendar = eng_cal
)
res.eng <- estimate(mod.eng)

## ----li-diagnostics-----------------------------------------------------------
summary(res.eng)
tsgc::print_model_diagnostics(res.eng)

## ----fig-li-log, fig.cap = "Figure 12: Forecast of log growth rate of hospitalisations, England."----
tsgc::plot_log_forecast(
  res.eng,
  Y = eng,
  n.ahead = n.forecasts.eng,
  plt.start = est.end.eng - plt.length.eng,
  title = "Forecast of log growth rate of hospitalisations (England)"
)

## ----fig-li-forecast, fig.cap = "Figure 13: Forecast of hospitalisations, England."----
tsgc::plot_forecast(
  res.eng,
  n.ahead = n.forecasts.eng,
  plt.start = est.end.eng - plt.length.eng,
  series.name = "Hospitalisations",
  title = "Forecast of hospitalisations (England)"
)

## ----fig-li-holdout, fig.cap = "Figure 14: Accuracy of the seven-day forecast of hospitalisations, England."----
tsgc::plot_holdout(
  res.eng,
  Y = eng,
  n.ahead = n.forecasts.eng,
  series.name = "Hospitalisations",
  title = "Accuracy: forecast of hospitalisations (England)"
)

## ----li-xpred-----------------------------------------------------------------
data(england_weather_2021, package = "tsgc")

conv <- xts_to_idx(england_weather_2021[, 1:4],
                    start.pos = idx_to_pos(eng_cal, zoo::index(england_weather_2021)[1]))
england_weather_idx <- conv$series

xpred_lead <- xpred_targ <- england_weather_idx

mod.eng.x <- SSModelLeadingIndicator$new(
  eng,
  n.lag = n.lag.eng,
  xpred_lead = xpred_lead,
  xpred_targ = xpred_targ,
  sea.period = 7,
  start = est.start.eng,
  end = est.end.eng,
  calendar = eng_cal
)
res.eng.x <- estimate(mod.eng.x)
res.eng.x$xpred_lead.new <- england_weather_idx
res.eng.x$xpred_targ.new <- england_weather_idx

## ----fig-li-x-forecast, fig.cap = "Figure 15: Forecast of hospitalisations with weather regressors (weather, oracle/realised), England."----
tsgc::plot_forecast(
  res.eng.x,
  n.ahead = n.forecasts.eng,
  plt.start = est.end.eng - plt.length.eng,
  title = "Forecast of hospitalisations\nwith regressors (weather, oracle/realised)",
  series.name = "Hospitalisations"
)

## ----cv-setup-----------------------------------------------------------------
data(ukitaly, package = "tsgc")

conv <- xts_to_idx(ukitaly)
ukitaly_idx <- conv$series
ukitaly_cal <- conv$calendar

n.forecasts.uk <- 14
plt.length.uk  <- 30
q.uk   <- 0.005

est.start.uk <- idx_to_pos(ukitaly_cal, "2020-02-25")
est.end.uk   <- idx_to_pos(ukitaly_cal, "2020-04-01")
Yuk          <- idx_series(idx_values(ukitaly_idx)[, "UK"], start = ukitaly_idx$start)

## ----fig-uk-italy, fig.cap = "Figure 16: Daily COVID cases in UK and Italy."----
mod.ukit.plot <- SSModelLeadingIndicator$new(ukitaly_idx, n.lag = 4, calendar = ukitaly_cal)
plot(
  mod.ukit.plot,
  title = "Daily COVID cases in UK and Italy",
  series.name.lead = "Italy",
  series.name.target = "UK",
  take.log = FALSE
)

## ----uk-gompertz--------------------------------------------------------------
mod.uk.gomp <- SSModelDynamicGompertz$new(
  Y = Yuk, q = q.uk, sea.period = 7,
  start = est.start.uk, end = est.end.uk,
  calendar = ukitaly_cal
)
res.uk.gomp <- estimate(mod.uk.gomp)

## ----uk-lead------------------------------------------------------------------
n.lag.uk <- 14
mod.uk.lead <- SSModelLeadingIndicator$new(
  Y = ukitaly_idx, n.lag = n.lag.uk, sea.period = 7,
  start = est.start.uk, end = est.end.uk,
  calendar = ukitaly_cal
)
res.uk.lead <- estimate(mod.uk.lead)

## ----fig-uk-compare, fig.cap = "Figure 17: Comparison of dynamic Gompertz and leading-indicator forecasts, UK daily cases."----
tsgc::plot_compare_forecast(
  list(res.uk.gomp, res.uk.lead),
  actual = Yuk,
  n.ahead = n.forecasts.uk
)

## ----fig-uk-holdout, fig.cap = "Figure 18: Accuracy of the leading-indicator forecast, UK daily cases."----
tsgc::plot_holdout(
  res.uk.lead, Y = ukitaly_idx, n.ahead = n.forecasts.uk,
  title = "Accuracy: leading-indicator forecast of UK cases",
  series.name = "UK cases"
)

## ----cv-models----------------------------------------------------------------
est.end.cv.uk <- idx_to_pos(ukitaly_cal, "2020-04-15")

cv_models <- list()

cv_models[["Naive_last_value"]] <- SSModelDynamicGompertz$new(
  Y = Yuk, q = 0, sea.period = 7,
  start = est.start.uk, end = est.end.cv.uk,
  calendar = ukitaly_cal
)

cv_models[["RW_growth"]] <- SSModelDynamicGompertz$new(
  Y = Yuk, q = q.uk, sea.period = 0,
  start = est.start.uk, end = est.end.cv.uk,
  calendar = ukitaly_cal
)

cv_models[["Vanilla_q"]] <- SSModelDynamicGompertz$new(
  Y = Yuk, q = q.uk, sea.period = 7,
  start = est.start.uk, end = est.end.cv.uk,
  calendar = ukitaly_cal
)

cv_models[["Vanilla_ar1"]] <- SSModelDynamicGompertz$new(
  Y = Yuk, sea.period = 7,
  start = est.start.uk, end = est.end.cv.uk, ar1 = TRUE,
  calendar = ukitaly_cal
)

for (i in c(7, 10, 14, 16, 18, 21)) {
  cv_models[[paste0("Lag", i)]] <- SSModelLeadingIndicator$new(
    Y = ukitaly_idx, sea.period = 7,
    start = est.start.uk, end = est.end.cv.uk, n.lag = i,
    calendar = ukitaly_cal
  )
}

## ----cv-run-------------------------------------------------------------------
n.ahead.cv  <- 5
gap.cv      <- n.ahead.cv   # non-overlapping horizons
n.select.cv <- 2
n.report.cv <- 1

report.end.cv <- est.end.cv.uk - (n.report.cv - 1) * gap.cv - n.ahead.cv
# The last SELECTION origin is select.end.cv + (n.select.cv-1)*gap.cv,
# with its forecast horizon reaching + n.ahead.cv further. Requiring
# that to finish strictly before the REPORTING origin (report.end.cv)
# means subtracting n.select.cv * gap.cv.
select.end.cv <- report.end.cv - n.select.cv * gap.cv - n.ahead.cv
stopifnot(select.end.cv > est.start.uk)

# Explicit disjointness check: the last SELECTION fold's forecast
# horizon must end strictly before the REPORTING block's origin.
last_selection_origin      <- select.end.cv + (n.select.cv - 1) * gap.cv
last_selection_horizon_end <- last_selection_origin + n.ahead.cv
stopifnot(last_selection_horizon_end < report.end.cv)

# Feasibility check for the highest lag tested: SSModelLeadingIndicator's
# estimate() needs at least n.lag + 2 usable positions from est.start.uk
# before the SELECTION block's origin (n.lag positions consumed by the
# forward lag-shift, plus at least 1-2 more lost to differencing/NA
# trimming).
max_lag_cv <- 21
stopifnot(select.end.cv - est.start.uk > max_lag_cv + 1)

cv_selection <- cross_val(
  Y = ukitaly_idx,
  model_list = cv_models,
  est.end = select.end.cv,
  criterion = "smape",
  n.ahead = n.ahead.cv,
  n.estimate = n.select.cv,
  gap = gap.cv
)
cv_selection

lag_rows <- cv_selection[grepl("^Lag", cv_selection$Model), ]
lag_rows$mean_smape <- rowMeans(lag_rows[, -1, drop = FALSE])
selected_lag_name <- lag_rows$Model[which.min(lag_rows$mean_smape)]
selected_lag_name

cv_report_models <- cv_models[c(
  "Naive_last_value", "RW_growth", "Vanilla_q", "Vanilla_ar1", selected_lag_name
)]
cv_reporting <- cross_val(
  Y = ukitaly_idx,
  model_list = cv_report_models,
  est.end = report.end.cv,
  criterion = "smape",
  n.ahead = n.ahead.cv,
  n.estimate = n.report.cv,
  gap = gap.cv
)
cv_reporting

## ----freq-quarterly-----------------------------------------------------------
data(nintendo_sales, package = "tsgc")

y_q_xts <- nintendo_sales[, c("wii", "switch_all")]

nintendo_idx <- idx_series(zoo::coredata(y_q_xts), start = 1L)
nintendo_cal <- idx_calendar(
  anchor = as.Date(zoo::index(y_q_xts)[1]),
  anchor_pos = 1L,
  amount = 1, unit = "quarters",
  posixct = TRUE
)

n.lag.q <- idx_to_pos(nintendo_cal, "2017-01-01") - idx_to_pos(nintendo_cal, "2006-10-01")

mod.q <- SSModelLeadingIndicator$new(
  Y = nintendo_idx,
  sea.period = 4,
  n.lag = n.lag.q,
  start = idx_to_pos(nintendo_cal, "2017-01-01"),
  end = idx_to_pos(nintendo_cal, "2019-10-01"),
  calendar = nintendo_cal
)
res.q <- estimate(mod.q)

## ----fig-freq-q, fig.cap = "Figure 19: Log forecasts of quarterly Switch sales, using Wii sales as a leading indicator."----
tsgc::plot_log_forecast(
  res.q, Y = nintendo_idx, n.ahead = 8,
  title = "Log forecasts of Switch sales"
)

## ----freq-monthly-------------------------------------------------------------
data(etrading_apps, package = "tsgc")

y_m_xts <- etrading_apps[, c("DEGIRO", "AvaTrade")]

etrading_idx <- idx_series(zoo::coredata(y_m_xts), start = 1L)
etrading_cal <- idx_calendar(
  anchor = as.Date(zoo::index(y_m_xts)[1]),
  anchor_pos = 1L,
  amount = 1, unit = "months",
  posixct = TRUE
)

n.lag.m <- idx_to_pos(etrading_cal, "2017-07-01") - idx_to_pos(etrading_cal, "2017-01-01")

mod.m <- SSModelLeadingIndicator$new(
  Y = etrading_idx,
  sea.period = 12,
  n.lag = n.lag.m,
  start = idx_to_pos(etrading_cal, "2017-07-01"),
  end = idx_to_pos(etrading_cal, "2021-02-01"),
  calendar = etrading_cal
)
res.m <- estimate(mod.m)

## ----fig-freq-m, fig.cap = "Figure 20: Forecasts of monthly AvaTrade downloads, using DEGIRO downloads as a leading indicator."----
tsgc::plot_forecast(
  res.m, n.ahead = 4,
  title = "AvaTrade monthly downloads",
  series.name = "Downloads"
)

## ----fit-res-weather----------------------------------------------------------
data(gauteng_weather_2021, package = "tsgc")
gauteng_weather_idx <- xts_to_idx(
  gauteng_weather_2021[, c(1, 3)],
  start.pos = idx_to_pos(cal, zoo::index(gauteng_weather_2021)[1])
)$series

weather.pos.start <- estimation.pos.start
weather.pos.end   <- idx_to_pos(cal, "2021-05-03")

gauteng_weather_est <- get_timeframe(
  gauteng_weather_idx, weather.pos.start, weather.pos.end
)

model_weather <- SSModelDynamicGompertz(
  Y = Y, xpred = gauteng_weather_est, q = q,
  start = weather.pos.start, end = weather.pos.end,
  calendar = cal
)
res_weather <- estimate(model_weather)

## ----xpred-csv-example, eval = F----------------------------------------------
# # This inline CSV block demonstrates the expected format of a file
# # containing future values of the external regressors.
# txt <- "
# Date,windspd_mtrs_p_sec,temperature_C
# 2021-05-04,2.03,14.61
# 2021-05-05,1.54,15.51
# 2021-05-06,1.94,16.42
# 2021-05-07,2.38,15.54
# 2021-05-08,2.57,14.18
# 2021-05-09,2.65,13.55
# 2021-05-10,2.19,14.84
# 2021-05-11,2.08,15.55
# 2021-05-12,2.07,15.97
# 2021-05-13,1.92,15.86
# 2021-05-14,1.85,15.79
# 2021-05-15,2.86,15.57
# 2021-05-16,3.46,16.42
# 2021-05-17,2.39,13.53
# "
# 
# # Read the demonstration CSV text into a data frame.
# gauteng_weather_future_csv <- read.csv(
#   text = txt,
#   stringsAsFactors = FALSE
# )
# 
# gauteng_weather_future_csv$Date <-
#   as.Date(gauteng_weather_future_csv$Date)
# 
# # Convert the data frame to xts first...
# gauteng_weather_future_xts <- xts::xts(
#   gauteng_weather_future_csv[, -1],
#   order.by = gauteng_weather_future_csv$Date
# )
# 
# # ...then to an idx_series, anchored on the fitted model's own calendar
# # so that the resulting positions line up with res_weather$calendar.
# gauteng_weather_future_idx <- xts_to_idx(
#   gauteng_weather_future_xts,
#   start.pos = idx_to_pos(res_weather$calendar,
#                          zoo::index(gauteng_weather_future_xts)[1])
# )$series
# 
# # Supply the future regressors directly on the fitted results object.
# res_weather$xpred.new <- gauteng_weather_future_idx

## ----xpred-csv-file, eval = F-------------------------------------------------
# # Read future regressors from a CSV file.
# gauteng_weather_future_csv <- read.csv(
#   "gauteng_weather_future.csv",
#   stringsAsFactors = FALSE
# )
# 
# gauteng_weather_future_csv$Date <-
#   as.Date(gauteng_weather_future_csv$Date)
# 
# # Convert to xts, then to idx_series on the model's calendar.
# gauteng_weather_future_xts <- xts::xts(
#   gauteng_weather_future_csv[, -1],
#   order.by = gauteng_weather_future_csv$Date
# )
# gauteng_weather_future_idx <- xts_to_idx(
#   gauteng_weather_future_xts,
#   start.pos = idx_to_pos(res_weather$calendar,
#                          zoo::index(gauteng_weather_future_xts)[1])
# )$series
# 
# # Supply the future regressors directly on the fitted results object.
# res_weather$xpred.new <- gauteng_weather_future_idx

## ----axis-showcase-setup------------------------------------------------------
# res/model/estimation.pos.end are re-used, generically-named objects
# earlier in this vignette.
res.axis.demo <- estimate(
  SSModelDynamicGompertz$new(Y = Y, q = q, sea.period = 7,
                             start = estimation.pos.start,
                             end = idx_to_pos(cal, "2021-05-03"),
                             calendar = cal)
)

showcase_axis_plot <- function(axis = NULL) {
  tsgc::plot_forecast(
    res = res.axis.demo,
    n.ahead = n.forecasts,
    confidence.level = confidence.level,
    plt.start = tail(res.axis.demo$index, 1) - plt.length,
    series.name = "cases",
    axis = axis
  )
}

## ----fig-axis-date, fig.cap = "Real calendar dates (mode = \"date\")."--------
showcase_axis_plot(idx_axis_opts(mode = "date"))

## ----fig-axis-position, fig.cap = "Raw integer positions (mode = \"position\")."----
showcase_axis_plot(idx_axis_opts(mode = "position"))

## ----fig-axis-steps, fig.cap = "Steps from the anchor (mode = \"steps\")."----
showcase_axis_plot(idx_axis_opts(mode = "steps"))

## ----fig-axis-time-since, fig.cap = "Time since the anchor, in calendar units (mode = \"time_since\")."----
showcase_axis_plot(idx_axis_opts(mode = "time_since"))

## ----fig-axis-infobox, fig.cap = "Steps from anchor, with an info box summarising the calendar."----
showcase_axis_plot(idx_axis_opts(mode = "steps", info_box = TRUE))

## ----fig-axis-infobox-truncated, fig.cap = "Info box with pattern truncated to its first 3 values via pattern_n."----
showcase_axis_plot(idx_axis_opts(mode = "steps", info_box = TRUE, pattern_n = 3))

## ----appendix-idx-step--------------------------------------------------------
qtr_step <- idx_step(quarters = 1, seconds = 3)
qtr_step

cal_step <- idx_calendar_step(
  anchor = as.POSIXct("2024-01-01 00:00:03", tz = "UTC"),
  step = qtr_step,
  posixct = TRUE
)
idx_to_date(cal_step, 1:4)

## ----appendix-idx-step-inverse------------------------------------------------
idx_to_pos(cal_step, idx_to_date(cal_step, 4))

## ----appendix-multi-step------------------------------------------------------
cal_multi <- idx_calendar_multi_step(
  anchor = as.Date("2024-01-01"),
  multi_step = multi_step_pattern(
    idx_step(days = 3), idx_step(days = 3), idx_step(months = 1)
  ),
  posixct = TRUE
)
idx_to_date(cal_multi, 1:6)

## ----appendix-multi-step-inverse----------------------------------------------
idx_to_pos(cal_multi, "2024-02-07")

## ----appendix-offset-to-pos---------------------------------------------------
cal_ps <- idx_calendar(anchor = 0, anchor_pos = 1L, amount = 2.5,
                       unit = "picoseconds")
idx_offset_to_pos(cal_ps, 12.5)