DATA 608 Story 2: Can the FED Control Inflation and Maintain Full Employment

Introduction

Within this story, I intend to evaluate whether the Federal Reserve has the power to control inflation while maintaining low unemployment over the last 25 years. Due to the fact that I used excel and python libraries last story, I now will use official APIs to import monthly CPI (BLS), Unemployment Rate (BLS), and the Effective Federal Funds Rate (FRED), then align the series to examine timing (policy reacts to inflation; labor responds with a lag) and long term tradeoffs.

Data Import

The goal here for importing is by pulling the three required macro series directly from their official APIs (again, not using excel since I used that last Story assignment). The code loads the packages, registers your API keys, and defines the 25-year window. It then builds a robust helper, bls_fetch(), that queries the BLS v2 API via GET, works around the ~20-year per-request limit by splitting the call, filters out the non-monthly “M13” annual averages, converts year/period into a real date, and returns a tidy two-column table. Using that helper, the code imports CPI-U All Items and the Unemployment Rate, renames the value columns to cpi_index and unemp_rate, and prints quick checks (row counts, date ranges, summaries) so you can verify the API calls succeeded.

library(fredr)

## Warning: package 'fredr' was built under R version 4.4.3

library(rlang)
library(tibble)
library(httr)

## Warning: package 'httr' was built under R version 4.4.3

library(jsonlite)

## 
## Attaching package: 'jsonlite'

## The following objects are masked from 'package:rlang':
## 
##     flatten, unbox

library(dplyr)

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

library(lubridate)

## 
## Attaching package: 'lubridate'

## The following objects are masked from 'package:base':
## 
##     date, intersect, setdiff, union

library(tidyr)

# Initial Setup with API keys
fredr_set_key(Sys.getenv("FRED_API_KEY"))
bls_key <- Sys.getenv("BLS_API_KEY")

end_y   <- lubridate::year(Sys.Date())
start_y <- end_y - 24

bls_fetch <- function(series_id, start_year, end_year) {
  base <- "https://api.bls.gov/publicAPI/v2/timeseries/data/"

  get_chunk <- function(a, b) {
    url <- paste0(base, series_id)
    q   <- list(startyear = as.character(a), endyear = as.character(b))
    if (nzchar(bls_key)) q$registrationKey <- trimws(bls_key)

    res <- httr::GET(url, query = q)
    httr::stop_for_status(res)

    js <- jsonlite::fromJSON(httr::content(res, "text", encoding = "UTF-8"),
                             simplifyVector = FALSE)
    status  <- js$status %||% "UNKNOWN"
    msg     <- paste(js$message, collapse = " | ")
    cat(sprintf("BLS %s %s %s–%s : %s\n", series_id, status, a, b,
                ifelse(nchar(msg), msg, "")))

    if (!identical(status, "REQUEST_SUCCEEDED"))
      stop(sprintf("BLS request failed: %s", msg))

    dat <- js$Results$series[[1]]$data
    if (length(dat) == 0) return(tibble(date = as.Date(character()), value = numeric()))

    year   <- vapply(dat, `[[`, "", "year")
    period <- vapply(dat, `[[`, "", "period")
    value  <- vapply(dat, `[[`, "", "value")

    tibble(
      year   = as.integer(year),
      period = as.character(period),
      value  = suppressWarnings(as.numeric(value))
    ) |>
      # keep only real months
      filter(grepl("^M(0[1-9]|1[0-2])$", .data$period)) |>
      mutate(
        month = as.integer(sub("^M","", .data$period)),
        date  = as.Date(sprintf("%d-%02d-01", .data$year, .data$month))
      ) |>
      arrange(.data$date) |>
      select(date, value)
  }

  if ((end_year - start_year + 1) > 20) {
    bind_rows(
      get_chunk(end_year - 19, end_year),
      get_chunk(start_year, end_year - 20)
    ) |>
      distinct(.data$date, .keep_all = TRUE) |>
      arrange(.data$date)
  } else {
    get_chunk(start_year, end_year)
  }
}

cpi_id    <- "CUUR0000SA0"
unemp_id  <- "LNS14000000"
cpi_raw   <- bls_fetch(cpi_id,   start_y, end_y) |> rename(cpi_index  = value)

## BLS CUUR0000SA0 REQUEST_SUCCEEDED 2006–2025 : 
## BLS CUUR0000SA0 REQUEST_SUCCEEDED 2001–2005 :

unemp_raw <- bls_fetch(unemp_id, start_y, end_y) |> rename(unemp_rate = value)

## BLS LNS14000000 REQUEST_SUCCEEDED 2006–2025 : 
## BLS LNS14000000 REQUEST_SUCCEEDED 2001–2005 :

nrow(cpi_raw); nrow(unemp_raw)

## [1] 296

## [1] 296

head(cpi_raw); head(unemp_raw)

range(cpi_raw$date); range(unemp_raw$date)

## [1] "2001-01-01" "2025-08-01"

## [1] "2001-01-01" "2025-08-01"

summary(cpi_raw$cpi_index); summary(unemp_raw$unemp_rate)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   175.1   205.0   232.9   234.7   256.2   324.0

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   3.400   4.200   5.100   5.724   6.525  14.800

Afterwards, the result here is to get the Effective Federal Funds Rate from FRED (FEDFUNDS) and keeps just date and fedfunds. It then creates a monthly “skeleton” sequence from the start year to the current month and left-joins CPI, unemployment, and Fed Funds onto that skeleton; this guarantees a continuous monthly index and prevents mismatches across sources. The result of glimpse() shows us that the three series were ingested and aligned correctly across the last 25 years, yielding a single, clean table that’s ready for transformation and for the rest of the assignment.

# Fed funds
fedfunds_raw <- fredr::fredr(
  series_id = "FEDFUNDS",
  observation_start = as.Date(paste0(start_y, "-01-01")),
  observation_end   = Sys.Date()
) |> transmute(date, fedfunds = value)
skeleton <- tibble(
  date = seq.Date(as.Date(paste0(start_y, "-01-01")),
                  lubridate::floor_date(Sys.Date(), "month"),
                  by = "month")
)

macro_25y <- skeleton |>
  left_join(cpi_raw,      by = "date") |>
  left_join(unemp_raw,    by = "date") |>
  left_join(fedfunds_raw, by = "date") |>
  arrange(date)

dplyr::glimpse(macro_25y)

## Rows: 298
## Columns: 4
## $ date       <date> 2001-01-01, 2001-02-01, 2001-03-01, 2001-04-01, 2001-05-01…
## $ cpi_index  <dbl> 175.1, 175.8, 176.2, 176.9, 177.7, 178.0, 177.5, 177.5, 178…
## $ unemp_rate <dbl> 4.2, 4.2, 4.3, 4.4, 4.3, 4.5, 4.6, 4.9, 5.0, 5.3, 5.5, 5.7,…
## $ fedfunds   <dbl> 5.98, 5.49, 5.31, 4.80, 4.21, 3.97, 3.77, 3.65, 3.07, 2.49,…

Data Transformation

In order to find out “Can the FED Control Inflation and Maintain Full Employment,” I transform the raw series into interpretable metrics such as compute CPI year-over-year inflation, align all series to a common monthly index, and add lag variables to reflect policy lags. Afterwards, I can then safely start plotting and visualizing the data to “paint the bigger picture.”

macro <- macro_25y %>%
  arrange(date) %>%
  mutate(
    # policy target: YoY inflation from CPI index
    cpi_yoy = (cpi_index / lag(cpi_index, 12) - 1) * 100,
    # convenient short names
    unemp    = unemp_rate,
    ffr      = fedfunds,
    # simple month-to-month rate change (optional)
    ffr_d1   = ffr - lag(ffr, 1),
    # outcomes shifted forward to reflect lags (t → t+6 / t+12)
    cpi_yoy_in_6m = lead(cpi_yoy, 6),
    unemp_in_12m  = lead(unemp, 12)
  )

# Tidy panel for faceted plots
panel_df <- macro %>%
  select(date,
         `CPI Inflation (YoY %)` = cpi_yoy,
         `Unemployment Rate (%)` = unemp,
         `Fed Funds Rate (%)`    = ffr) %>%
  pivot_longer(-date, names_to = "series", values_to = "value")

# Mandate scorecard and thresholds to keep track of
targets <- list(inflation_max = 3, unemployment_max = 5)
mandate_eval <- macro %>%
  transmute(date,
            hit_infl = cpi_yoy <= targets$inflation_max,
            hit_unem = unemp   <= targets$unemployment_max,
            hit_both = hit_infl & hit_unem)

mandate_summary <- summarise(mandate_eval,
  pct_months_meeting_both = mean(hit_both, na.rm = TRUE) * 100)
mandate_summary

Based on the Fed mandate, inflation is roughly less than or equal to 3% and unemployment is about less than or equal to 5% about 28.57143% of months met both conditions simultaneously using targets <- list(inflation_max = 3, unemployment_max = 5)

Data Visualization

Trend

Purpose: First visualization here is to show CPI inflation, the Fed funds rate, and unemployment on the same monthly timeline to see how policy reacts to inflation and how jobs respond with a lag.

library(ggplot2)
library(scales)

rec <- tibble::tibble(
  start = as.Date(c("2001-03-01","2007-12-01","2020-02-01")),
  end   = as.Date(c("2001-11-01","2009-06-01","2020-04-01"))
)

series_cols <- c(
  "CPI Inflation (YoY %)"   = "#D62728",  # red
  "Fed Funds Rate (%)"      = "#1F77B4",  # blue
  "Unemployment Rate (%)"   = "#2CA02C"   # green
)

ref_lines <- rbind(
  data.frame(series = "CPI Inflation (YoY %)", y = 2),
  data.frame(series = "Unemployment Rate (%)", y = 5),
  data.frame(series = "Fed Funds Rate (%)", y = 0)
)

ggplot(panel_df, aes(date, value)) +
  # Shading in Recession periods
  geom_rect(data = rec, aes(xmin = start, xmax = end, ymin = -Inf, ymax = Inf),
            inherit.aes = FALSE, fill = "grey92") +
  geom_hline(data = ref_lines, aes(yintercept = y),
             linetype = "dashed", colour = "grey40", linewidth = 0.5) +

  geom_line(aes(color = series), linewidth = 0.9) +
  scale_color_manual(values = series_cols, guide = "none") +
  facet_wrap(~ series, ncol = 1, scales = "free_y") +
  scale_x_date(date_breaks = "5 years", date_labels = "%Y", expand = expansion(mult = c(.01, .02))) +
  labs(
    title    = "Inflation, Fed Funds, and Unemployment (Last 25 Years)",
    subtitle = "Threshold is 2% CPI proxy for PCE target and 5% low-unemployment (Dash lines). Recessions (shaded regions)",
    x = NULL, y = NULL
  ) +
  theme_minimal(base_size = 10) +
  theme(
    strip.text = element_text(face = "bold"),
    panel.grid.minor = element_blank()
  )

## Warning: Removed 17 rows containing missing values or values outside the scale range
## (`geom_line()`).

Result: During 2021 and 2022 CPI inflation increases rapidly which was then followed by sharp rate hikes, while unemployment rose mainly after recessions and lagged policy. Today inflation has been reduced toward an estimated 3% however with rates still high and unemployment somewhat low.

Lead–lag overlays

Purpose: Visualization will now include whether today’s rate moves foreshadow later outcomes by overlaying the Fed funds rate with future CPI (6 months) and future unemployment (12 months).

cor_cpi  <- cor(macro$ffr, macro$cpi_yoy_in_6m,  use = "complete.obs")
cor_unem <- cor(macro$ffr, macro$unemp_in_12m,   use = "complete.obs")
cols_ffr_cpi  <- c("Fed Funds Rate (%)"      = "#1F77B4",
                   "Future CPI (YoY, +6m)"   = "#D62728")
cols_ffr_une  <- c("Fed Funds Rate (%)"      = "#1F77B4",
                   "Future Unemployment (+12m)" = "#2CA02C")
# Fed Funds vs future CPI for 6 months
df_cpi <- macro |>
  select(date,
         `Fed Funds Rate (%)`    = ffr,
         `Future CPI (YoY, +6m)` = cpi_yoy_in_6m) |>
  pivot_longer(-date, names_to = "series", values_to = "value") |>
  drop_na(value)

ggplot(df_cpi, aes(date, value, color = series)) +
  geom_rect(data = rec,
            aes(xmin = start, xmax = end, ymin = -Inf, ymax = Inf),
            inherit.aes = FALSE, fill = "grey92") +
  geom_hline(yintercept = 2, linetype = "dashed", colour = "grey40") +  # 2% CPI target proxy
  geom_line(linewidth = 0.9) +
  scale_color_manual(values = cols_ffr_cpi, name = NULL) +
  scale_x_date(date_breaks = "5 years", date_labels = "%Y") +
  labs(
    title    = "Policy Timing: Fed Funds vs Future CPI",
    subtitle = sprintf("FFR vs CPI six months ahead r = %.2f and Dashed line is 2%% target proxy", cor_cpi),
    x = NULL, y = "Percent"
  ) +
  theme_minimal(base_size = 13) +
  theme(panel.grid.minor = element_blank(),
        legend.position = "top")

Result: The funds rate aligns with CPI six months later (r = 0.16), with long stretches, for example 2008-2009 and 2021–2023 where inflation stays above an estimated 2%.

# Overlay: Fed Funds vs future Unemployment for 12+ months
df_unem <- macro |>
  select(date,
         `Fed Funds Rate (%)`         = ffr,
         `Future Unemployment (+12m)` = unemp_in_12m) |>
  pivot_longer(-date, names_to = "series", values_to = "value") |>
  drop_na(value)

ggplot(df_unem, aes(date, value, color = series)) +
  geom_rect(data = rec,
            aes(xmin = start, xmax = end, ymin = -Inf, ymax = Inf),
            inherit.aes = FALSE, fill = "grey92") +
  geom_hline(yintercept = 5, linetype = "dashed", colour = "grey40") +  # 5% low-unemployment threshold
  geom_line(linewidth = 0.9) +
  scale_color_manual(values = cols_ffr_une, name = NULL) +
  scale_x_date(date_breaks = "5 years", date_labels = "%Y") +
  labs(
    title    = "Policy Timing: Fed Funds vs Future Unemployment",
    subtitle = sprintf("FFR vs Unemployment twelve months ahead r = %.2f and Dashed line is 5%% threshold", cor_unem),
    x = NULL, y = "Percent"
  ) +
  theme_minimal(base_size = 13) +
  theme(panel.grid.minor = element_blank(),
        legend.position = "top")

Result: The relationship is negative (r =-0.25) and tightening cycles within the plot are generally followed by higher unemployment roughly a year later.

Fed Mandate Scorecard

Purpose: This scorecard quantifies how often, over the last 25 years, the Fed’s targets were met by using the previous thresholds of CPI YoY less than or equal to 3% and unemployment less than or equal to 5%

scores <- mandate_eval |>
  summarise(
    `Inflation ≤ threshold`   = mean(hit_infl, na.rm = TRUE) * 100,
    `Unemployment ≤ threshold`= mean(hit_unem, na.rm = TRUE) * 100,
    `Both goals met`          = mean(hit_both, na.rm = TRUE) * 100
  )
scores$`Neither met` <- 100 - scores$`Inflation ≤ threshold` - scores$`Unemployment ≤ threshold` + scores$`Both goals met`

scores_long <- tibble::enframe(unlist(scores)) |>
  dplyr::rename(metric = name, pct = value) |>
  dplyr::mutate(kind = dplyr::case_when(
    metric == "Both goals met"           ~ "both",
    metric == "Neither met"              ~ "neither",
    TRUE                                 ~ "single"
  ))

ggplot(scores_long, aes(pct, forcats::fct_rev(metric), fill = kind)) +
  geom_col(width = 0.6) +
  geom_text(aes(label = sprintf("%.1f%%", pct)), hjust = -0.1, size = 4.6) +
  scale_x_continuous(labels = label_percent(scale = 1), limits = c(0, 100)) +
  scale_fill_manual(values = c(single = "#7FB3D5", both = "#2C7FBB", neither = "grey80"), guide = "none") +
  labs(
    title    = "How Often Were the Targets Met?",
    x = "% of months", y = NULL
  ) +
  theme_minimal(base_size = 12) +
  theme(panel.grid.major.y = element_blank())

Result: Inflation met its threshold in ~71% of months and unemployment at 48.6%, but both were achieved together only 28.6% of the time, showing that hitting both goals simultaneously has been uncommon and neither being only 8.8%.

Conclusion

To conclude this story, I switched over to R and R libraries this time as well as pull API keys in order to gain access to 25 years of monthly CPI, unemployment, and the effective federal funds rate directly from the BLS and FRED APIs, aligned them to a common monthly timeline, converted CPI to year-over-year inflation, and built lagged views to reflect that policy reacts first and the economy responds later. Trend plots and lead-lag overlays showed rate increases are followed by softer inflation and, with a longer delay, higher unemployment. A simple scorecard using CPI less than or equal to 3% and unemployment less than or equal to 5% found inflation met its threshold in about 71.1% of months, unemployment in about 48.6%, and both together 28.8%, with neither met 8.8%. Reffering back to the question, “can the Fed control inflation and maintain full employment?” based on the results, the Fed can technically influence both, BUT achieving the two goals at the same time seems to be mutually exclusive in practice due to lags and shocks, meaning the mandate is met intermittently rather than consistently.

---