Setup

Load all of our usual packages. Add fredr.

library(tidyverse)

## ── Attaching packages ────────────────── tidyverse 1.2.1 ──

## ✔ ggplot2 3.2.1     ✔ purrr   0.3.3
## ✔ tibble  2.1.3     ✔ dplyr   0.8.3
## ✔ tidyr   1.0.0     ✔ stringr 1.4.0
## ✔ readr   1.3.1     ✔ forcats 0.4.0

## ── Conflicts ───────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()

library(plotly)

## 
## Attaching package: 'plotly'

## The following object is masked from 'package:ggplot2':
## 
##     last_plot

## The following object is masked from 'package:stats':
## 
##     filter

## The following object is masked from 'package:graphics':
## 
##     layout

library(lubridate)

## 
## Attaching package: 'lubridate'

## The following object is masked from 'package:base':
## 
##     date

library(fredr)

FRED API

Supply an API key to get access to the FRED data.

Count of Employed Persons

series_id = "CE16OV"
frequency = "m"
units = ""

# The following code is generic and uses the values in the lines above.

rm(df)

## Warning in rm(df): object 'df' not found

df = fredr_series_observations(
  series_id = series_id,
  observation_start = as.Date("1980-01-01"),
  frequency = frequency,
  units = units)

date = df$date
empPop = df$value
head(df)

## # A tibble: 6 x 3
##   date       series_id value
##   <date>     <chr>     <dbl>
## 1 1980-01-01 CE16OV    99879
## 2 1980-02-01 CE16OV    99995
## 3 1980-03-01 CE16OV    99713
## 4 1980-04-01 CE16OV    99233
## 5 1980-05-01 CE16OV    98945
## 6 1980-06-01 CE16OV    98682

Population Level

series_id = "CNP16OV"
frequency = "m"
units = ""

# The following code is generic and uses the values in the lines above.

rm(df)
df = fredr_series_observations(
  series_id = series_id,
  observation_start = as.Date("1980-01-01"),
  frequency = frequency,
  units = units)

civPop = df$value


head(civPop)

## [1] 166544 166759 166984 167197 167407 167643

tail(civPop)

## [1] 259845 260020 260181 259502 259628 259758

Payroll Employment

series_id = "PAYEMS"
frequency = "m"
units = ""

# The following code is generic and uses the values in the lines above.

rm(df)
df = fredr_series_observations(
  series_id = series_id,
  observation_start = as.Date("1980-01-01"),
  frequency = frequency,
  units = units)

payrollEmp = df$value

Labor Force

series_id = "CLF16OV"
frequency = "m"
units = ""

# The following code is generic and uses the values in the lines above.

rm(df)
df = fredr_series_observations(
  series_id = series_id,
  observation_start = as.Date("1980-01-01"),
  frequency = frequency,
  units = units)

laborForce = df$value

Gather

rm(jobs.df)

## Warning in rm(jobs.df): object 'jobs.df' not found

jobs.df = tibble(date, 
                     laborForce,
                     payrollEmp,
                     civPop,
                     empPop)
head(jobs.df)

## # A tibble: 6 x 5
##   date       laborForce payrollEmp civPop empPop
##   <date>          <dbl>      <dbl>  <dbl>  <dbl>
## 1 1980-01-01     106562      90800 166544  99879
## 2 1980-02-01     106697      90883 166759  99995
## 3 1980-03-01     106442      90994 166984  99713
## 4 1980-04-01     106591      90849 167197  99233
## 5 1980-05-01     106929      90420 167407  98945
## 6 1980-06-01     106780      90101 167643  98682

tail(jobs.df)

## # A tibble: 6 x 5
##   date       laborForce payrollEmp civPop empPop
##   <date>          <dbl>      <dbl>  <dbl>  <dbl>
## 1 2019-10-01     164401     151553 259845 158544
## 2 2019-11-01     164347     151814 260020 158536
## 3 2019-12-01     164556     151998 260181 158803
## 4 2020-01-01     164606     152212 259502 158714
## 5 2020-02-01     164546     152487 259628 158759
## 6 2020-03-01     162913     151786 259758 155772

Payroll Employment and Employed People

compare_emp = jobs.df %>% 
  select(date,payrollEmp,empPop) %>% 
  mutate(ratio = empPop/payrollEmp,
         dpayrollemp = payrollEmp - lag(payrollEmp),
         dempPop = empPop - lag(empPop))

Examine Ratio

summary(compare_emp$ratio)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   1.026   1.052   1.060   1.068   1.088   1.127

compare_emp %>% 
  ggplot(aes(x=date,y=ratio)) +
  geom_point(size=.3) + 
  ggtitle("Ratio of Employed People to Payroll Employment") -> ratio_graph
ggplotly(ratio_graph)

Relationship of Deltas

compare_emp %>% 
  na.omit() %>% 
  ggplot(aes(x=dpayrollemp,
             y=dempPop,
             group=date)) +
      geom_point(size=.3) + 
      ggtitle("Deltas Relationship") -> Deltas_graph
ggplotly(Deltas_graph)

Linear Model

deltas_model = lm(dempPop ~ dpayrollemp, data = compare_emp)
summary(deltas_model)

## 
## Call:
## lm(formula = dempPop ~ dpayrollemp, data = compare_emp)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -2438.27  -163.77    10.23   158.22  1834.52 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 14.33028   16.48676   0.869    0.385    
## dpayrollemp  0.80323    0.06737  11.924   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 309.8 on 480 degrees of freedom
##   (1 observation deleted due to missingness)
## Multiple R-squared:  0.2285, Adjusted R-squared:  0.2269 
## F-statistic: 142.2 on 1 and 480 DF,  p-value: < 2.2e-16

Analysis of Rates

jobs.df = jobs.df %>% 
  mutate(lfpr = laborForce/civPop,
         emprate = empPop/civPop,
         unemployed = laborForce - empPop,
         unrate = unemployed/laborForce)

jobs.df %>% 
  ggplot(aes(x=date,y=lfpr)) + 
  geom_point() + ggtitle("Labor Force Participation Rate") -> lfpr_graph
ggplotly(lfpr_graph)

jobs.df %>% 
  ggplot(aes(x=date,y=unrate)) + 
  geom_point() + 
  ggtitle("Unemployment Rate") -> unrate_graph
ggplotly(unrate_graph)

jobs.df %>% 
  ggplot(aes(x=date,y=emprate)) + 
  geom_point(size=.2) + ggtitle("Employment Rate") -> emprate_graph
ggplotly(emprate_graph)