Story 2
Steve Phillips
2024-09-22
Story 2
Load and Clean CPI Data using Bureau of Labor Statistics API
payload <- glue('{
"seriesid":["CUUR0000SA0"],
"startyear":"2016",
"endyear":"2024",
"registrationkey":"{{api_key}}"
}',.open = "{{",.close="}}")
# POST Request
response <-POST(url,
body = payload,
content_type("application/json"),
encode = "json")
cpi2 <- content(response, "text") %>% jsonlite::fromJSON()## No encoding supplied: defaulting to UTF-8.Our Stitched Together CPI Data
cpi1 <-cpi1$Results$series$data[[1]] %>% as_tibble()
cpi2 <- cpi2$Results$series$data[[1]] %>% as_tibble()
cpi_final <- bind_rows(cpi1,cpi2) %>% distinct()head(cpi_final)## # A tibble: 6 × 6
## year period periodName value footnotes latest
## <chr> <chr> <chr> <chr> <list> <chr>
## 1 2016 M12 December 241.432 <df [1 × 0]> <NA>
## 2 2016 M11 November 241.353 <df [1 × 0]> <NA>
## 3 2016 M10 October 241.729 <df [1 × 0]> <NA>
## 4 2016 M09 September 241.428 <df [1 × 0]> <NA>
## 5 2016 M08 August 240.849 <df [1 × 0]> <NA>
## 6 2016 M07 July 240.628 <df [1 × 0]> <NA>Change the dates to a standard format
cpi_final <- cpi_final %>% mutate(date= ymd(paste(year, periodName, "01", sep = "-")))cpi_final <- cpi_final %>% mutate(value = as.numeric(value))cpi_final <- cpi_final %>% arrange(date) %>%
mutate(cpi_pct_change = (value - lag(value))/lag(value) * 100)head(cpi_final)## # A tibble: 6 × 8
## year period periodName value footnotes latest date cpi_pct_change
## <chr> <chr> <chr> <dbl> <list> <chr> <date> <dbl>
## 1 1999 M01 January 164. <df [1 × 0]> <NA> 1999-01-01 NA
## 2 1999 M02 February 164. <df [1 × 0]> <NA> 1999-02-01 0.122
## 3 1999 M03 March 165 <df [1 × 0]> <NA> 1999-03-01 0.304
## 4 1999 M04 April 166. <df [1 × 0]> <NA> 1999-04-01 0.727
## 5 1999 M05 May 166. <df [1 × 0]> <NA> 1999-05-01 0
## 6 1999 M06 June 166. <df [1 × 0]> <NA> 1999-06-01 0Take the yearly change in CPI so that inflation can be determined
cpi_yearly_change <- cpi_final %>% group_by(year) %>%
arrange(date)%>%
summarise(
cpi_start= first(value),
cpi_end = last(value),
cpi_yearly_pct_change = (cpi_end - cpi_start)/cpi_start* 100,
date = date)## `summarise()` has grouped output by 'year'. You can override using the
## `.groups` argument.cpi_yearly_change## # A tibble: 308 × 5
## # Groups: year [26]
## year cpi_start cpi_end cpi_yearly_pct_change date
## <chr> <dbl> <dbl> <dbl> <date>
## 1 1999 164. 168. 2.43 1999-01-01
## 2 1999 164. 168. 2.43 1999-02-01
## 3 1999 164. 168. 2.43 1999-03-01
## 4 1999 164. 168. 2.43 1999-04-01
## 5 1999 164. 168. 2.43 1999-05-01
## 6 1999 164. 168. 2.43 1999-06-01
## 7 1999 164. 168. 2.43 1999-07-01
## 8 1999 164. 168. 2.43 1999-08-01
## 9 1999 164. 168. 2.43 1999-09-01
## 10 1999 164. 168. 2.43 1999-10-01
## # ℹ 298 more rowsLoad and Clean Unemployment Data using Bureau of Labor Statistics API
payload <- glue('{
"seriesid":["LNS14000000"],
"startyear":"1999",
"endyear":"2017",
"registrationkey":"{{api_key}}"
}',.open = "{{",.close="}}")
# POST Request
response <-POST(url,
body = payload,
content_type("application/json"),
encode = "json")
unemp1 <- content(response, "text") %>% jsonlite::fromJSON()## No encoding supplied: defaulting to UTF-8.payload <- glue('{
"seriesid":["LNS14000000"],
"startyear":"2017",
"endyear":"2024",
"registrationkey":"{{api_key}}"
}',.open = "{{",.close="}}")
# POST Request
response <-POST(url,
body = payload,
content_type("application/json"),
encode = "json")
unemp2 <- content(response, "text") %>% jsonlite::fromJSON()## No encoding supplied: defaulting to UTF-8.unemp1 <-unemp1$Results$series$data[[1]] %>% as_tibble()
unemp2 <- unemp2$Results$series$data[[1]] %>% as_tibble()
unemp_final <- bind_rows(unemp1,unemp2) %>% distinct()unemp_final <- unemp_final %>% mutate(date= ymd(paste(year, periodName, "01", sep = "-")))Change dates to standard format
unemp_final <- unemp_final %>% mutate(value = as.numeric(value))
unemp_final <- unemp_final %>% arrange(date)unemp_final## # A tibble: 308 × 7
## year period periodName value footnotes latest date
## <chr> <chr> <chr> <dbl> <list> <chr> <date>
## 1 1999 M01 January 4.3 <df [1 × 0]> <NA> 1999-01-01
## 2 1999 M02 February 4.4 <df [1 × 0]> <NA> 1999-02-01
## 3 1999 M03 March 4.2 <df [1 × 0]> <NA> 1999-03-01
## 4 1999 M04 April 4.3 <df [1 × 0]> <NA> 1999-04-01
## 5 1999 M05 May 4.2 <df [1 × 0]> <NA> 1999-05-01
## 6 1999 M06 June 4.3 <df [1 × 0]> <NA> 1999-06-01
## 7 1999 M07 July 4.3 <df [1 × 0]> <NA> 1999-07-01
## 8 1999 M08 August 4.2 <df [1 × 0]> <NA> 1999-08-01
## 9 1999 M09 September 4.2 <df [1 × 0]> <NA> 1999-09-01
## 10 1999 M10 October 4.1 <df [1 × 0]> <NA> 1999-10-01
## # ℹ 298 more rowsLoad and Clean FED Funds Rate Data using the Federal Reserve Board API
# FRED Api key
api_key_fredr <- "b66e45b96655ee5f06f439e3419fd4bc"
fredr_set_key(api_key_fredr)
api_key <- fredr_get_key()fred_r <- fredr(series_id = "FEDFUNDS", frequency = "m", observation_start = as.Date("1999-01-01"), observation_end = as.Date("2024-09-22"))fred_r## # A tibble: 308 × 5
## date series_id value realtime_start realtime_end
## <date> <chr> <dbl> <date> <date>
## 1 1999-01-01 FEDFUNDS 4.63 2024-09-22 2024-09-22
## 2 1999-02-01 FEDFUNDS 4.76 2024-09-22 2024-09-22
## 3 1999-03-01 FEDFUNDS 4.81 2024-09-22 2024-09-22
## 4 1999-04-01 FEDFUNDS 4.74 2024-09-22 2024-09-22
## 5 1999-05-01 FEDFUNDS 4.74 2024-09-22 2024-09-22
## 6 1999-06-01 FEDFUNDS 4.76 2024-09-22 2024-09-22
## 7 1999-07-01 FEDFUNDS 4.99 2024-09-22 2024-09-22
## 8 1999-08-01 FEDFUNDS 5.07 2024-09-22 2024-09-22
## 9 1999-09-01 FEDFUNDS 5.22 2024-09-22 2024-09-22
## 10 1999-10-01 FEDFUNDS 5.2 2024-09-22 2024-09-22
## # ℹ 298 more rowsCreate a plot of the data that can be analyzed
'
par(mfrow = c(2,1), mar = c(4,4,1,1))
plot(fred_r$date, fred_r$value, type = "l", frame = TRUE, col="red", xlab = "",ylab = "Percent", ylim = c(0,15),pch= 20, lwd =2, xaxt= "n", main = "Yearly CPI Versus Federal Funds Rate" )
## Plot 1
lines(cpi_yearly_change$date, cpi_yearly_change$cpi_yearly_pct_change, col = "green", type = "l")
abline(h = 2, col = "black", lty = 2)
abline(v = as.Date("2001-01-01"), col ="black", lty = 3)
text(x = as.Date("2002-12-01"), y = 10, labels = "Dot Com Crash",
pos = 3, col = "black")
abline(v =as.Date("2007-11-01"), col = "black", lty = 3)
legend("topleft", legend = c("Federal Funds", "Yearly CPI","Target Inflation Rate"),
col = c("red", "green","black"), lty = c(1,1,2), cex = 0.8)
text(x = as.Date("2010-9-01"), y = 10, labels = "Housing Market Crash",
pos = 3, col = "black")
abline(v =as.Date("2020-2-01"), col = "black", lty = 3)
text(x = as.Date("2022-4-01"), y = 10, labels = "COVID Pandemic",
pos = 3, col = "black")
## Plot 2
plot(fred_r$date, fred_r$value, type = "l", frame = TRUE, col="red", xlab = "Date",ylab = "Percent", ylim = c(0,15),pch= 20, lwd =2, main = "Employment Rate Versus Federal Funds Rate")
lines(unemp_final$date,unemp_final$value, col= "blue", type = "l", xlab = "Date", ylab = "Percent")
abline(h = 5, col ="black", lty= 2)
abline(v = as.Date("2001-01-01"), col ="black", lty = 3)
abline(v =as.Date("2007-11-01"), col = "black", lty = 3)
abline(v =as.Date("2020-2-01"), col = "black", lty = 3)
legend("topleft", legend = c("Federal Funds", "Employment Rate","Maximum Employment Rate"),
col = c("red", "blue","black"), lty = c(1,1,2), cex = 0.8)
'## [1] "\npar(mfrow = c(2,1), mar = c(4,4,1,1))\nplot(fred_r$date, fred_r$value, type = \"l\", frame = TRUE, col=\"red\", xlab = \"\",ylab = \"Percent\", ylim = c(0,15),pch= 20, lwd =2, xaxt= \"n\", main = \"Yearly CPI Versus Federal Funds Rate\" )\n\n\n## Plot 1\nlines(cpi_yearly_change$date, cpi_yearly_change$cpi_yearly_pct_change, col = \"green\", type = \"l\")\nabline(h = 2, col = \"black\", lty = 2)\n\n\nabline(v = as.Date(\"2001-01-01\"), col =\"black\", lty = 3)\ntext(x = as.Date(\"2002-12-01\"), y = 10, labels = \"Dot Com Crash\", \n pos = 3, col = \"black\")\n\nabline(v =as.Date(\"2007-11-01\"), col = \"black\", lty = 3)\nlegend(\"topleft\", legend = c(\"Federal Funds\", \"Yearly CPI\",\"Target Inflation Rate\"),\n col = c(\"red\", \"green\",\"black\"), lty = c(1,1,2), cex = 0.8)\ntext(x = as.Date(\"2010-9-01\"), y = 10, labels = \"Housing Market Crash\", \n pos = 3, col = \"black\")\n\nabline(v =as.Date(\"2020-2-01\"), col = \"black\", lty = 3)\ntext(x = as.Date(\"2022-4-01\"), y = 10, labels = \"COVID Pandemic\", \n pos = 3, col = \"black\")\n\n\n## Plot 2\nplot(fred_r$date, fred_r$value, type = \"l\", frame = TRUE, col=\"red\", xlab = \"Date\",ylab = \"Percent\", ylim = c(0,15),pch= 20, lwd =2, main = \"Employment Rate Versus Federal Funds Rate\")\nlines(unemp_final$date,unemp_final$value, col= \"blue\", type = \"l\", xlab = \"Date\", ylab = \"Percent\")\n\nabline(h = 5, col =\"black\", lty= 2)\nabline(v = as.Date(\"2001-01-01\"), col =\"black\", lty = 3)\n\nabline(v =as.Date(\"2007-11-01\"), col = \"black\", lty = 3)\n\nabline(v =as.Date(\"2020-2-01\"), col = \"black\", lty = 3)\n\nlegend(\"topleft\", legend = c(\"Federal Funds\", \"Employment Rate\",\"Maximum Employment Rate\"),\n col = c(\"red\", \"blue\",\"black\"), lty = c(1,1,2), cex = 0.8)\n"