## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  fig.width = 7,
  fig.height = 4.5,
  fig.align = "center",
  message = FALSE,
  warning = FALSE
)

## ----setup--------------------------------------------------------------------
library(trendseries)
library(dplyr)
library(tidyr)
library(ggplot2)

## ----libs---------------------------------------------------------------------
# library(trendseries)
# library(dplyr)
# library(tidyr)

## ----theme--------------------------------------------------------------------
library(ggplot2)

theme_series <- theme_minimal(paper = "#fefefe") +
  theme(
    legend.position = "bottom",
    panel.grid.minor = element_blank(),
    strip.background = element_rect(fill = "#2c3e50"),
    strip.text = element_text(color = "#fefefe"),
    axis.ticks.x = element_line(color = "gray40", linewidth = 0.5),
    axis.line.x = element_line(color = "gray40", linewidth = 0.5),
    axis.title.x = element_blank(),
    palette.colour.discrete = c(
      "#2c3e50",
      "#e74c3c",
      "#f39c12",
      "#1abc9c",
      "#9b59b6"
    )
  )

## ----henderson-weights--------------------------------------------------------
# Compute 13-term Henderson weights from the closed-form formula
n <- 13L
m <- (n - 1L) / 2L
j <- seq_len(n) - (m + 1L)

P <- ((m + 1L)^2L - j^2L) *
     ((m + 2L)^2L - j^2L) *
     ((m + 3L)^2L - j^2L)

eta    <- sum(j^4L * P) / sum(j^2L * P)
w      <- P * (eta - j^2L)
w      <- w / sum(w)

weights_df <- data.frame(lag = j, weight = w)

ggplot(weights_df, aes(lag, weight)) +
  geom_col(aes(fill = weight > 0), width = 0.65, show.legend = FALSE) +
  geom_hline(yintercept = 0, color = "gray40", linewidth = 0.4) +
  scale_fill_manual(values = c("FALSE" = "#e74c3c", "TRUE" = "#2c3e50")) +
  scale_x_continuous(breaks = seq(-6, 6)) +
  labs(
    title    = "13-term Henderson Filter: Weight Profile",
    subtitle = "Weights sum to 1; small negative values at the outer lags stabilise turning points",
    x = "Lag (j)", y = "Weight"
  ) +
  theme_series

## ----henderson-basic----------------------------------------------------------
# Default: 13-term for monthly data
ibcbr_hend <- augment_trends(ibcbr, value_col = "index", methods = "henderson")

head(ibcbr_hend)

## ----henderson-plot-----------------------------------------------------------
ggplot(ibcbr_hend, aes(date)) +
  geom_line(aes(y = index, color = "Original"), linewidth = 0.6, alpha = 0.7) +
  geom_line(aes(y = trend_henderson, color = "Trend: 13-term Henderson"),
            linewidth = 0.9) +
  scale_x_date(date_breaks = "3 years", date_labels = "%Y") +
  labs(
    title  = "IBC-Br: 13-term Henderson Moving Average",
    x = NULL, y = "Index", color = NULL
  ) +
  theme_series

## -----------------------------------------------------------------------------
ibcbr_windows <- ibcbr |>
  filter(date >= as.Date("2015-01-01")) |>
  augment_trends(
    value_col = "index",
    methods = "henderson",
    window = c(9, 13, 23),
    .quiet = TRUE
  )

## ----henderson-windows--------------------------------------------------------
ibcbr_windows_long <- ibcbr_windows |>
  pivot_longer(
    cols = starts_with("trend_henderson_"),
    names_to = "window",
    values_to = "trend"
  ) |>
  mutate(
    window = factor(
      window,
      levels = c(
        "trend_henderson_9",
        "trend_henderson_13",
        "trend_henderson_23"
      ),
      labels = c("9-term", "13-term", "23-term")
    )
  )

ggplot(ibcbr_windows_long, aes(date, trend)) +
  geom_line(
    data = ibcbr_windows,
    aes(y = index),
    color = "#2c3e50",
    alpha = 0.5,
    linewidth = 0.5
  ) +
  geom_line(color = "#e74c3c", linewidth = 0.9, na.rm = TRUE) +
  facet_wrap(vars(window), ncol = 1) +
  scale_x_date(date_breaks = "2 years", date_labels = "%Y") +
  labs(
    title = "Henderson Filter: Effect of Window Size",
    subtitle = "Gray = original series; larger windows are smoother but lose more data at the endpoints",
    x = NULL,
    y = "Index"
  ) +
  theme_series

## ----spencer-data-------------------------------------------------------------
ibcbr_sp <- augment_trends(ibcbr, value_col = "index", methods = "spencer")

ibcbr_sp_recent <- ibcbr_sp |>
  filter(date >= as.Date("2015-01-01"))

## ----spencer-plot-------------------------------------------------------------
ggplot(ibcbr_sp_recent, aes(date)) +
  geom_line(aes(y = index, color = "Original"), linewidth = 0.6, alpha = 0.7) +
  geom_line(aes(y = trend_spencer, color = "Trend: Spencer 15-term"),
            linewidth = 0.9) +
  scale_x_date(date_breaks = "2 years", date_labels = "%Y") +
  labs(
    title = "IBC-Br: Spencer 15-term Moving Average",
    x = NULL, y = "Index", color = NULL
  ) +
  theme_series

## ----henderson-spencer-data---------------------------------------------------
ibcbr_hs <- ibcbr |>
  augment_trends(
    value_col = "index",
    methods = c("henderson", "spencer"),
    .quiet = TRUE
  )

## ----henderson-spencer-compare------------------------------------------------
ibcbr_hs_long <- ibcbr_hs |>
  filter(date >= as.Date("2015-01-01")) |>
  pivot_longer(
    cols = c(trend_henderson, trend_spencer),
    names_to = "filter",
    values_to = "trend"
  ) |>
  mutate(
    filter = recode(
      filter,
      trend_henderson = "Henderson (13-term)",
      trend_spencer = "Spencer (15-term)"
    )
  )

ggplot(ibcbr_hs_long, aes(date, trend)) +
  geom_line(
    aes(y = index),
    color = "gray70",
    linewidth = 0.5
  ) +
  geom_line(color = "#2c3e50", linewidth = 0.9, na.rm = TRUE) +
  facet_wrap(vars(filter), ncol = 2) +
  scale_x_date(date_breaks = "1 year", date_labels = "%Y") +
  labs(
    title = "Henderson vs. Spencer",
    subtitle = "Gray = original series; both filters produce very similar trends",
    x = NULL,
    y = "Index"
  ) +
  theme_series

## ----gdp-plot-----------------------------------------------------------------
ggplot(gdp_construction, aes(date, index)) +
  geom_line(linewidth = 0.7, color = "#2c3e50") +
  scale_x_date(date_breaks = "5 years", date_labels = "%Y") +
  labs(
    title = "GDP – Construction (Brazil)",
    subtitle = "Chained index, quarterly",
    x = NULL,
    y = "Index"
  ) +
  theme_series

## ----bk-filter----------------------------------------------------------------
gdp_bk <- augment_trends(
  gdp_construction,
  date_col = "date",
  value_col = "index",
  methods = "bk"
)

head(gdp_bk)

## ----bk-plot------------------------------------------------------------------
ggplot(gdp_bk, aes(date)) +
  geom_line(aes(y = index, color = "Original"), linewidth = 0.6, alpha = 0.7) +
  geom_line(
    aes(y = trend_bk, color = "Trend: Baxter-King"),
    linewidth = 0.9,
    na.rm = TRUE
  ) +
  scale_x_date(date_breaks = "5 years", date_labels = "%Y") +
  labs(
    title = "GDP Construction: Baxter-King Filter",
    subtitle = "Trend after removing business-cycle frequencies (6–32 quarters)",
    x = NULL,
    y = "Index",
    color = NULL
  ) +
  theme_series

## ----bk-cycle-data------------------------------------------------------------
gdp_cycle_bk <- gdp_bk |>
  mutate(cycle = index - trend_bk) |>
  filter(!is.na(cycle))

## ----bk-cycle-plot------------------------------------------------------------
ggplot(gdp_cycle_bk, aes(date, cycle)) +
  geom_hline(yintercept = 0, color = "gray50", linewidth = 0.5) +
  geom_line(linewidth = 0.8, color = "#e74c3c") +
  geom_area(alpha = 0.2, fill = "#e74c3c") +
  scale_x_date(date_breaks = "5 years", date_labels = "%Y") +
  labs(
    title    = "GDP Construction: Business Cycle (BK Filter)",
    subtitle = "Deviations from long-run trend; positive = above trend",
    x = NULL, y = "Cyclical component"
  ) +
  theme_series

## ----cf-bk-data---------------------------------------------------------------
gdp_bk_cf <- augment_trends(
  gdp_construction,
  date_col = "date",
  value_col = "index",
  methods = c("bk", "cf")
)

gdp_cycles_long <- gdp_bk_cf |>
  mutate(
    `Baxter-King` = index - trend_bk,
    `Christiano-Fitzgerald` = index - trend_cf
  ) |>
  pivot_longer(
    cols = c(`Baxter-King`, `Christiano-Fitzgerald`),
    names_to = "filter",
    values_to = "cycle"
  )

## ----cf-bk-compare------------------------------------------------------------
ggplot(gdp_cycles_long, aes(date, cycle)) +
  geom_hline(yintercept = 0, color = "gray50", linewidth = 0.4) +
  geom_line(color = "#e74c3c", linewidth = 0.8, na.rm = TRUE) +
  geom_area(alpha = 0.15, fill = "#e74c3c", na.rm = TRUE) +
  facet_wrap(vars(filter), ncol = 2) +
  scale_x_date(date_breaks = "5 years", date_labels = "%Y") +
  labs(
    title    = "Business Cycle: Baxter-King vs. Christiano-Fitzgerald",
    subtitle = "Both isolate cycles of 6–32 quarters; CF has no endpoint NAs",
    x = NULL, y = "Cyclical component"
  ) +
  theme_series

## ----hp-filter----------------------------------------------------------------
ibcbr_hp <- augment_trends(ibcbr, value_col = "index", methods = "hp")

head(ibcbr_hp)

## ----hp-plot------------------------------------------------------------------
ggplot(ibcbr_hp, aes(date)) +
  geom_line(aes(y = index,    color = "Original"), linewidth = 0.6, alpha = 0.7) +
  geom_line(aes(y = trend_hp, color = "Trend: HP (λ = 14,400)"),
            linewidth = 0.9) +
  scale_x_date(date_breaks = "3 years", date_labels = "%Y") +
  labs(
    title = "IBC-Br: Hodrick-Prescott Filter",
    x = NULL, y = "Index", color = NULL
  ) +
  theme_series

## ----hp-lambda-data-----------------------------------------------------------
hp_lambdas <- ibcbr |>
  filter(date >= as.Date("2010-01-01")) |>
  augment_trends(
    value_col = "index",
    methods = "hp",
    smoothing = 1600,
    .quiet = TRUE
  ) |>
  augment_trends(
    value_col = "index",
    methods = "hp",
    smoothing = 14400,
    .quiet = TRUE
  ) |>
  augment_trends(
    value_col = "index",
    methods = "hp",
    smoothing = 129600,
    .quiet = TRUE
  )

## ----hp-lambda-plot-----------------------------------------------------------
hp_lambdas_long <- hp_lambdas |>
  pivot_longer(
    cols = starts_with("trend_hp"),
    names_to = "lambda",
    values_to = "trend"
  ) |>
  mutate(
    lambda = factor(
      lambda,
      levels = c("trend_hp", "trend_hp_1", "trend_hp_2"),
      labels = c("λ = 1,600", "λ = 14,400 (default)", "λ = 129,600")
    )
  )

ggplot(hp_lambdas_long, aes(date, trend)) +
  geom_line(
    data = hp_lambdas,
    aes(y = index),
    color = "gray60",
    linewidth = 0.5
  ) +
  geom_line(color = "#2c3e50", linewidth = 0.9) +
  facet_wrap(vars(lambda), ncol = 3) +
  scale_x_date(date_breaks = "3 years", date_labels = "%Y") +
  labs(
    title = "HP Filter: Effect of the Smoothing Parameter λ",
    subtitle = "Gray = original series; larger λ → smoother trend, closer to a linear fit",
    x = NULL,
    y = "Index"
  ) +
  theme_series

## ----hamilton-filter----------------------------------------------------------
ibcbr_hamilton <- augment_trends(
  ibcbr,
  value_col = "index",
  methods = "hamilton"
)

head(ibcbr_hamilton)

## ----hamilton-plot------------------------------------------------------------
ggplot(ibcbr_hamilton, aes(date)) +
  geom_line(aes(y = index, color = "Original"), linewidth = 0.6, alpha = 0.7) +
  geom_line(
    aes(y = trend_hamilton, color = "Trend: Hamilton"),
    linewidth = 0.9,
    na.rm = TRUE
  ) +
  scale_x_date(date_breaks = "3 years", date_labels = "%Y") +
  labs(
    title = "IBC-Br: Hamilton Filter",
    subtitle = paste0(
      "Fitted values from y[t+24] ~ y[t] + ... + y[t-11]; ",
      "first 35 rows are NA (h + p - 1 = 24 + 12 - 1)"
    ),
    x = NULL,
    y = "Index",
    color = NULL
  ) +
  theme_series

## ----hamilton-cycle-----------------------------------------------------------
ibcbr_hamilton_cycle <- ibcbr_hamilton |>
  mutate(cycle = index - trend_hamilton) |>
  filter(!is.na(cycle))

ggplot(ibcbr_hamilton_cycle, aes(date, cycle)) +
  geom_hline(yintercept = 0, color = "gray50", linewidth = 0.5) +
  geom_line(linewidth = 0.8, color = "#e74c3c") +
  geom_area(alpha = 0.2, fill = "#e74c3c") +
  scale_x_date(date_breaks = "3 years", date_labels = "%Y") +
  labs(
    title    = "IBC-Br: Cyclical Component (Hamilton Filter)",
    subtitle = "Residuals from the Hamilton regression; positive = above trend",
    x = NULL, y = "Cyclical component"
  ) +
  theme_series

## ----hamilton-hp-data---------------------------------------------------------
hp_vs_ham <- ibcbr |>
  filter(date >= as.Date("2010-01-01")) |>
  augment_trends(
    value_col = "index",
    methods = c("hp", "hamilton"),
    .quiet = TRUE
  )

## ----hamilton-hp-compare------------------------------------------------------
hp_ham_long <- hp_vs_ham |>
  pivot_longer(
    cols = c(trend_hp, trend_hamilton),
    names_to = "filter",
    values_to = "trend"
  ) |>
  mutate(
    filter = recode(
      filter,
      trend_hp = "HP (λ = 14,400)",
      trend_hamilton = "Hamilton (h = 24, p = 12)"
    )
  )

ggplot(hp_ham_long, aes(date, trend)) +
  geom_line(
    data = hp_vs_ham,
    aes(y = index),
    color = "gray70",
    linewidth = 0.5
  ) +
  geom_line(color = "#2c3e50", linewidth = 0.9, na.rm = TRUE) +
  facet_wrap(vars(filter), ncol = 2) +
  scale_x_date(date_breaks = "2 years", date_labels = "%Y") +
  labs(
    title = "HP vs. Hamilton Filter on IBC-Br",
    subtitle = "Gray = original series; HP is smoother, Hamilton reacts faster and avoids endpoint distortion",
    x = NULL,
    y = "Index"
  ) +
  theme_series

## ----all-filters-data---------------------------------------------------------
ibcbr_all <- ibcbr |>
  filter(date >= as.Date("2010-01-01")) |>
  augment_trends(
    value_col = "index",
    methods = c("henderson", "spencer", "hp", "hamilton"),
    .quiet = TRUE
  )

## ----all-filters-plot---------------------------------------------------------
ibcbr_all_long <- ibcbr_all |>
  pivot_longer(
    cols = c(trend_henderson, trend_spencer, trend_hp, trend_hamilton),
    names_to = "filter",
    values_to = "trend"
  ) |>
  mutate(
    filter = factor(
      filter,
      levels = c(
        "trend_henderson",
        "trend_spencer",
        "trend_hp",
        "trend_hamilton"
      ),
      labels = c(
        "Henderson (13-term)",
        "Spencer (15-term)",
        "HP (λ = 14,400)",
        "Hamilton (h=24, p=12)"
      )
    )
  )

ggplot(ibcbr_all_long, aes(date, trend)) +
  geom_line(
    data = ibcbr_all,
    aes(y = index),
    color = "gray70",
    linewidth = 0.5
  ) +
  geom_line(color = "#2c3e50", linewidth = 0.8, na.rm = TRUE) +
  facet_wrap(vars(filter), ncol = 2) +
  scale_x_date(date_breaks = "3 years", date_labels = "%Y") +
  labs(
    title = "IBC-Br: All Filters Compared",
    subtitle = "Gray = original series",
    x = NULL,
    y = "Index"
  ) +
  theme_series