Overall trend
plot_ly(data, x = ~date) %>%
add_lines(y = ~inflation, name = "Inflation (%)",
line = list(color = "gold")) %>%
add_lines(y = ~fed_funds, name = "Fed Funds Rate (%)",
line = list(color = "green")) %>%
add_lines(y = ~unemployment, name = "Unemployment (%)",
line = list(color = "blue")) %>%
layout(
title = list(
text = "Federal Reserve Dual Mandates: Success Appears Situational",
x = 0,
xanchor = "left"
),
yaxis = list(title = "Percent"),
xaxis = list(title = ""),
shapes = list(
list(type = "line",
x0 = as.Date("2001-03-01"), x1 = as.Date("2001-03-01"),
y0 = 0, y1 = 1,
xref = "x", yref = "paper",
line = list(color = "rgba(0,0,0,0.35)", dash = "dot")),
list(type = "line",
x0 = as.Date("2007-12-01"), x1 = as.Date("2007-12-01"),
y0 = 0, y1 = 1,
xref = "x", yref = "paper",
line = list(color = "rgba(0,0,0,0.35)", dash = "dot")),
list(type = "line",
x0 = as.Date("2020-02-01"), x1 = as.Date("2020-02-01"),
y0 = 0, y1 = 1,
xref = "x", yref = "paper",
line = list(color = "rgba(0,0,0,0.35)", dash = "dot"))
),
annotations = list(
list(x = as.Date("2001-03-01"),
y = 0.95,
xref = "x", yref = "paper",
text = "2001 Crisis",
showarrow = FALSE,
xanchor = "left",
yanchor = "top"),
list(x = as.Date("2007-12-01"),
y = 0.95,
xref = "x", yref = "paper",
text = "2008 Crisis",
showarrow = FALSE,
xanchor = "left",
yanchor = "top"),
list(x = as.Date("2020-02-01"),
y = 0.95,
xref = "x", yref = "paper",
text = "2020 Pandemic",
showarrow = FALSE,
xanchor = "right",
yanchor = "top")
),
legend = list(
orientation = "h", # horizontal
x = 0, # left-align
xanchor = "left",
y = -0.2, # below plot
yanchor = "top"
)
)
# Policy Classification & 12-Month Lag
data_lagged <- data %>%
arrange(date) %>%
mutate(
d_fed = fed_funds - lag(fed_funds),
d_infl = inflation - lag(inflation),
d_unemp = unemployment - lag(unemployment),
infl_lag6 = lead(d_infl, 12),
unemp_lag6 = lead(d_unemp, 12),
policy = case_when(
d_fed > 0 ~ "Rate Hike",
d_fed < 0 ~ "Rate Cut",
TRUE ~ "Neutral"
)
)
# Line plot function
create_policy_plot <- function(df, title_text) {
df <- df %>%
mutate(group = cumsum(policy != lag(policy, default = first(policy))))
periods <- df %>%
filter(policy != "Neutral") %>%
group_by(group, policy) %>%
summarise(start = min(date),
end = max(date),
.groups = "drop")
shapes <- lapply(seq_len(nrow(periods)), function(i) {
list(
type = "rect",
xref = "x",
yref = "paper",
x0 = periods$start[i],
x1 = periods$end[i],
y0 = 0, y1 = 1,
fillcolor = ifelse(periods$policy[i] == "Rate Hike",
"rgba(0,200,0,0.09)",
"rgba(200,0,0,0.09)"),
line = list(width = 0)
)
})
p <- plot_ly(df, x = ~date) %>%
# Economic lines
add_lines(y = ~inflation,
name = "Inflation (%)",
line = list(color = "gold")) %>%
add_lines(y = ~unemployment,
name = "Unemployment (%)",
line = list(color = "blue")) %>%
# Dummy legend entries for Rate Hike / Rate Cut
add_trace(x = min(df$date),
y = min(df$inflation, na.rm = TRUE),
type = "scatter",
mode = "markers",
marker = list(size = 12, color = "rgba(0,200,0,0.4)"),
name = "Rate Hike",
hoverinfo = "skip",
showlegend = TRUE) %>%
add_trace(x = min(df$date),
y = min(df$inflation, na.rm = TRUE),
type = "scatter",
mode = "markers",
marker = list(size = 12, color = "rgba(200,0,0,0.4)"),
name = "Rate Cut",
hoverinfo = "skip",
showlegend = TRUE)
p %>%
layout(
title = list(
text = title_text,
x = 0,
xanchor = "left"
),
yaxis = list(
title = "Percent",
range = c(0, 15)
),
xaxis = list(title = ""),
shapes = shapes,
legend = list(orientation = "h")
)
}
# Bar plot function
create_bar_plot <- function(start_date, end_date, title_text) {
summary_df <- data_lagged %>%
filter(date >= as.Date(start_date),
date <= as.Date(end_date),
policy != "Neutral") %>%
group_by(policy) %>%
summarise(
Inflation = mean(infl_lag6, na.rm = TRUE),
Unemployment = mean(unemp_lag6, na.rm = TRUE),
.groups = "drop"
) %>%
pivot_longer(cols = c(Inflation, Unemployment),
names_to = "Variable",
values_to = "Value")
plot_ly(summary_df,
x = ~policy,
y = ~Value,
color = ~Variable,
colors = c("gold", "blue"),
type = "bar",
barmode = "group") %>%
layout(
title = list(text = title_text, x = 0, xanchor = "left"),
xaxis = list(
title = "",
tickvals = c("Rate Hike", "Rate Cut"),
ticktext = c(
"Rate Hike<br><span style='font-size:11px'>Expected: Inflation ↓ | Unemployment ↑</span>",
"Rate Cut<br><span style='font-size:11px'>Expected: Inflation ↑ | Unemployment ↓</span>"
)
),
yaxis = list(
title = "Average 12-Month Change (pp)",
range = c(-0.3, 0.3)
),
legend = list(
orientation = "h",
x = 0,
xanchor = "left",
y = -0.2,
yanchor = "top"
)
)
}
# Periods
periods <- list(
pregfc = c("2000-01-01", "2007-01-31"),
gfc = c("2007-02-01", "2010-12-31"),
expansion = c("2011-01-01", "2019-12-31"),
covid = c("2020-01-01", "2025-12-31")
)