Sliding calculations of risks of federal reserve rate reductions R-Bloggers

Bank of America warned that the Federal Reserve runs the risk of making a policy error if it starts to lower the rates next month.

They indicated that economic activity has increased after a delay in the first half of the year, and if that is accurate, the labor market will probably also recover.

The rolling average graph shows the cutbacks on the rate after the significant one on packaging of unemployment, and we cannot see that it is recently increasing.

Source code:

library(tidyverse)
library(timetk)

#U.S. Unemployment Rate
df_unemployment <- 
  read.delim("https://raw.githubusercontent.com/mesdi/blog/refs/heads/main/unemployment") %>% 
  as_tibble() %>% 
  janitor::clean_names() %>% 
  #removing parentheses and the text within
  mutate(release_date = str_remove(release_date, " \\(.*\\)"),
         actual = str_remove(actual, "%")) %>% 
  mutate(release_date = parse_date(release_date, "%b %d, %Y")) %>% 
  mutate(release_date = floor_date(release_date, "month") %m-% months(1),
         actual = as.numeric(actual)) %>%
  select(date = release_date, 'U.S. Unemployment Rate' = actual) %>% 
  drop_na()


#Fed Interest Rate
df_fed_rates <- 
  read.delim("https://raw.githubusercontent.com/mesdi/blog/refs/heads/main/fed_rates.txt") %>% 
  as_tibble() %>% 
  janitor::clean_names() %>% 
  #removing parentheses and the text within
  mutate(release_date = str_remove(release_date, " \\(.*\\)"),
         actual = str_remove(actual, "%")) %>% 
  mutate(release_date = parse_date(release_date, "%b %d, %Y")) %>% 
  mutate(release_date = floor_date(release_date, "month"),
         actual = as.numeric(actual)) %>%
  select(date = release_date, 'Fed Interest Rate' = actual) %>% 
  #makes regular time series by filling the time gaps
  pad_by_time(date, .by = "month") %>% 
  fill('Fed Interest Rate', .direction = "down") %>%
  drop_na()

#Survey data
df_survey <- 
  df_unemployment %>% 
  left_join(df_fed_rates) %>% 
  drop_na() %>% 
  pivot_longer(2:3,
               names_to = "symbol",
               values_to = "value")

#Sliding (Rolling) Calculations
# Make the rolling function
roll_avg_6 <- 
  slidify(.f = mean, 
          .period = 6, 
          .align = "center", 
          .partial = TRUE)

# Apply the rolling function
df_survey %>%
  select(symbol,
         date, 
         value) %>%
  group_by(symbol) %>%
  # Apply Sliding Function
  mutate(rolling_avg_6 = roll_avg_6(value)) %>%
  tidyr::pivot_longer(cols = c(value, rolling_avg_6)) %>%
  plot_time_series(date, 
                   value/100, 
                   .color_var = name,
                   .line_size = 1.2,
                   .facet_ncol = 1, 
                   .smooth = FALSE, 
                   .interactive = FALSE) +
  labs(title = "6-month Smoothing Line", 
       y = "", 
       x = "") + 
  scale_y_continuous(labels = scales::percent_format()) +
  theme_tq(base_family = "Roboto Slab", base_size = 16) +
  theme(plot.title = ggtext::element_markdown(face = "bold"),
        plot.background = element_rect(fill = "azure"),
        strip.text = element_text(face = "bold", color = "snow"),
        strip.background = element_rect(fill =  "orange"),
        axis.text = element_text(face = "bold"),
        legend.position = "none")

Related