Unemployment Benefits and …
RN, JN, KP, DR
5/27/2020
rm(list=ls())
library(fst)
library(ggplot2)
library(data.table)
library(stargazer)
library(lfe)
library(tidycensus)
library(R.matlab)
library(rgdal)
library(rgeos)unempins <- fread("C:/Users/dratnadiwakara2/Documents/OneDrive - Louisiana State University/Raw Data/COVID19/Unemployment Insurance.csv")
fp <- fread("C:/Users/dratnadiwakara2/Documents/OneDrive - Louisiana State University/Raw Data/Crosswalk Files/us-state-ansi-fips.csv")
unempins <- merge(unempins,fp[,c("statefips","statecode")],by.x="state",by.y="statecode")
unempins <- unempins[,c("statefips","basebenefit","weeklywage","state")]
names(unempins) <- c("state","basebenefit","weeklywage","statecode")
unempins[,replacementrate:=(basebenefit+600)/weeklywage]
unempins[,growthrate:=((600)/basebenefit)]
unempins[,state:=ifelse(nchar(as.character(state))==1,paste0("0",state),as.character(state))]acs1 <- R.matlab::readMat("C:/Users/dratnadiwakara2/Documents/OneDrive - Louisiana State University/Raw Data/COVID19/mat/acs.mat")
median_age <- unlist(acs1$DP05.0018E,use.names = F)
pctwhite <- unlist(acs1$DP05.0037PE, use.names = F)
child <- unlist(acs1$DP02.0013PE, use.names = F)
medianincome <- unlist(acs1$DP03.0062E, use.names = F)
acs1 <- data.frame(median_age=median_age,pctwhite=pctwhite,child=child,medianincome=medianincome)
spatial <- R.matlab::readMat('C:/Users/dratnadiwakara2/Documents/OneDrive - Louisiana State University/Raw Data/COVID19/mat/spatial_data.mat')
fips <- unlist(spatial$FIPS, use.names=FALSE)
pop <- unlist(spatial$Pop, use.names=FALSE)
land <- unlist(spatial$Land,use.names = FALSE)
pcthome <- unlist(spatial$PctHome,use.names = F)
pcthome <- data.table(pcthome)
names(pcthome) <- paste0("week",c("01","02","03","04","05","06","07","08","09",as.character(10:15)))
acs2 <- data.frame(fips=as.numeric(fips),pop=pop,land=land)
acskp <- cbind(acs1,acs2)
acskp <- data.table(acskp)
acskp[,logdensity:=log(pop/land)]
acskp[,fips:=ifelse(nchar(fips)==4,paste0("0",fips),as.character(fips))]load(file="C:/Users/dratnadiwakara2/Documents/OneDrive - Louisiana State University/Raw Data/Presidential Election/countypres_2000-2016.RData")
election <- x
rm(x)
election <- data.table(election)
election <- election[election$year %in% c(2016)& election$party=="republican"]
election <- election[,c("year","FIPS","candidatevotes","totalvotes")]
election[,rep_pct:=election$candidatevotes/election$totalvotes]
election[,FIPS:=as.character(FIPS)]
election[,FIPS:=ifelse(nchar(FIPS)==4,paste0("0",FIPS),FIPS)]1 Descriptives
1.1 Unemployment Benefits and Wages
Due to the additional $600 of unemployment benefits provided by CARES Act, in some states unemployed receive more money than they would have typically earned in their jobs.
The graph below shows the replacement rate after CARES (red) and replacement rate before CARES (blue)
1.1.1 Point Plot
test <- unempins
test[,replacementratebeforecares:= basebenefit/weeklywage]
test <- test[,c("statecode","replacementrate","replacementratebeforecares")]
test <- test[order(-test$replacementrate)]
test <- melt(test,"statecode")
test <- test[order(-value)]
ggplot(test) + geom_point(aes(x=statecode,y=value,color=variable),size=4)+theme_minimal()+theme(legend.position = "bottom")+geom_hline(yintercept = 1)
1.1.2 Map
us_states <- readOGR("C:/Users/dratnadiwakara2/Documents/OneDrive - Louisiana State University/Raw Data/Shapefiles/US States","cb_2014_us_state_20m")## OGR data source with driver: ESRI Shapefile
## Source: "C:\Users\dratnadiwakara2\Documents\OneDrive - Louisiana State University\Raw Data\Shapefiles\US States", layer: "cb_2014_us_state_20m"
## with 52 features
## It has 9 fields
## Integer64 fields read as strings: ALAND AWATERus_states <- fortify(us_states,region="GEOID")
us_states <- data.table(us_states)
us_states <- merge(us_states,unempins[,c("replacementrate","state")],by.x="id",by.y="state")
ggplot()+
geom_polygon(data=us_states[! us_states$id %in% c("02","15","72")], aes(x=long,y=lat,group=group,fill=replacementrate),color="black")+
scale_fill_gradientn(colors=c("orange","orange3","orangered1","orangered3","orangered4"))+ theme_minimal()+
theme(axis.title=element_blank(),
axis.text=element_blank(),
axis.ticks=element_blank(),
legend.position = "bottom",panel.grid = element_blank())+ guides(fill=guide_legend(title="Replacement Rate"))
1.2 Homebase data
hb <- read_fst("C:/Users/dratnadiwakara2/Documents/OneDrive - Louisiana State University/Raw Data/COVID19/homebase/homebase2.fst",as.data.table = T)
# hb[,week_of:=as.Date(week_of)]
hb <- hb[industry %in% c("Food & Drink")]
hb <- hb[week_of>="2019-12-31"]
company_state <- hb[!duplicated(hb[,c("company_id","state")])]
company_state <- company_state[,.N,by=company_id]
company_state <- company_state[N>1]
hb <- hb[company_id %in% company_state$company_id]
hb[,hours_worked:=as.numeric(hours_worked)]
hb[,total_wages:=as.numeric(total_wages)]
hb[,hours_with_wages:= as.numeric(hours_with_wages)]
hb[,dayno:=as.numeric(week_of-as.Date("2019-12-31"))]
hb[,week:=floor(dayno/7)]
hb[,state:=substr(county_code,1,2)]
hb <- merge(hb,unempins,by="state")
hb[,county:=county_code]
hb[,weekno := week]
hb[,week:=as.factor(week)]
hb[,week:= relevel(hb$week,9)]
hb[,lowbenefit:=ifelse(replacementrate<1,1,0)]
hb[,post:=ifelse(weekno>8,1,0)]
hb[,company_week:=paste(company_id,weekno)]
hb[,wages_per_hour:=total_wages/hours_with_wages]1.2.1 Number of Employees
yvariable = "# employees"
temp <- hb[industry=="Food & Drink" & weekno<20]
temp[,yvar:=employees_with_wages]
temp <- temp[,.(yvar=mean(yvar,na.rm=T)),by=.(weekno,lowbenefit)]
temp[,lowbenefit:=ifelse(lowbenefit==1,"Replacement rate < 1","Replacement rate >=1")]
ggplot(temp,aes(x=weekno,y=yvar,color=lowbenefit))+geom_line(size=1)+theme_minimal()+theme(legend.position = "bottom",legend.title = element_blank())+ geom_vline(xintercept = 10,color = "grey",linetype="dashed",size=1)+labs(x="Week",y=yvariable)
1.2.2 Hours worked
yvariable = "Hours worked"
temp <- hb[industry=="Food & Drink" & weekno<20]
temp[,yvar:=hours_worked]
temp <- temp[,.(yvar=mean(yvar,na.rm=T)),by=.(weekno,lowbenefit)]
temp[,lowbenefit:=ifelse(lowbenefit==1,"Replacement rate < 1","Replacement rate >=1")]
ggplot(temp,aes(x=weekno,y=yvar,color=lowbenefit))+geom_line(size=1)+theme_minimal()+theme(legend.position = "bottom",legend.title = element_blank())+ geom_vline(xintercept = 10,color = "grey",linetype="dashed",size=1)+labs(x="Week",y=yvariable)
1.2.3 Hours worked
yvariable = "Total wages"
temp <- hb[industry=="Food & Drink" & weekno<20]
temp[,yvar:=total_wages]
temp <- temp[,.(yvar=mean(yvar,na.rm=T)),by=.(weekno,lowbenefit)]
temp[,lowbenefit:=ifelse(lowbenefit==1,"Replacement rate < 1","Replacement rate >=1")]
ggplot(temp,aes(x=weekno,y=yvar,color=lowbenefit))+geom_line(size=1)+theme_minimal()+theme(legend.position = "bottom",legend.title = element_blank())+ geom_vline(xintercept = 10,color = "grey",linetype="dashed",size=1)+labs(x="Week",y=yvariable)
1.2.4 Wages per hour
yvariable = "Wages per hour"
temp <- hb[industry=="Food & Drink" & weekno<20 & total_wages>0 & hours_with_wages>0]
temp[,yvar:=wages_per_hour]
temp <- temp[,.(yvar=mean(yvar,na.rm=T)),by=.(weekno,lowbenefit)]
temp[,lowbenefit:=ifelse(lowbenefit==1,"Replacement rate < 1","Replacement rate >=1")]
ggplot(temp,aes(x=weekno,y=yvar,color=lowbenefit))+geom_line(size=1)+theme_minimal()+theme(legend.position = "bottom",legend.title = element_blank())+ geom_vline(xintercept = 10,color = "grey",linetype="dashed",size=1)+labs(x="Week",y=yvariable)+ylim(7,14)
1.2.5 Coverage
No of unique companies
length(unique(hb[industry=="Food & Drink"]$company_id))## [1] 171No of states
length(unique(hb[industry=="Food & Drink"]$state))## [1] 48No of states per company
temp <- company_state[N<10]
temp <- temp[,.(nocompanies=.N), by=N]
temp <- temp[order(temp$N)]
stargazer(temp,summary = F,type="text",rownames = F)##
## =============
## N nocompanies
## -------------
## 2 164
## 3 15
## 4 4
## 5 1
## 9 1
## -------------2 Results
2.1 Regression Tables
\[ Outcome_{i,w} = \beta \times lowbenefit_{i} \times post + Company\text{ }Fixed\text{ }Effects + Week\text{ }Fixed\text{ }Effects\]
where \(post\) is a dummy variable that indicates the weeks after CARES Act was passed and \(lowbenefit\) indicates the states where unemployment benefit amount is less than the wage.
r <- list()
r[[1]] <- felm(log(employees_with_wages)~lowbenefit*post|company_id+week|0|company_id,data=hb[employees_with_wages>0 & industry=="Food & Drink"])
r[[2]] <- felm(log(hours_worked)~lowbenefit*post|company_id+week|0|company_id,data=hb[hours_worked>0 & industry=="Food & Drink"])
r[[3]] <- felm(log(1+total_wages)~lowbenefit*post|company_id+week|0|company_id,data=hb[1+total_wages>=0 & industry=="Food & Drink"])
r[[4]] <- felm(log(1+wages_per_hour)~lowbenefit*post|company_id+week|0|company_id,data=hb[1+total_wages>=0 & industry=="Food & Drink" & is.finite(wages_per_hour)])
.printtable(r,column.labels = c("log(# employees)","log(hours worked)","log(total wages)","log(Wage rate)"),lines = list(c("Fixed Effects",rep("Company, Week",4)),c("SE Cluster",rep("Company",4))))##
## ==================================================================================
## Dependent variable:
## ------------------------------------------------------------------
## log(# employees) log(hours worked) log(total wages) log(Wage rate)
## (1) (2) (3) (4)
## ----------------------------------------------------------------------------------
## lowbenefit 0.146* 0.176* 0.477*** 0.091***
## (0.087) (0.095) (0.150) (0.032)
## post
## (0.000) (0.000) (0.000) (0.000)
## lowbenefit:post -0.121* -0.203*** -0.204** -0.015
## (0.071) (0.073) (0.098) (0.011)
## ----------------------------------------------------------------------------------
## Fixed Effects Company, Week Company, Week Company, Week Company, Week
## SE Cluster Company Company Company Company
## Observations 8,041 9,318 8,208 8,040
## Adjusted R2 0.507 0.533 0.518 0.738
## ==================================================================================
## Note: *p<0.1; **p<0.05; ***p<0.01
## 2.2 Regression Plots
\[ Outcome_{i,w} = \Sigma_w\text{ } \beta_w \times w \times lowbenefit_i + Company\text{ }Fixed\text{ }Effects + Week\text{ }Fixed\text{ }Effects\]
where \(w\) is a dummy variable that indicates the week and \(lowbenefit\) indicates the states where unemployment benefit amount is less than the wage.
All the figures below plot the \(\beta_w\) estimates with the corresponding 95% confidence intervals.
2.2.1 Dep. Var: log(# Employees)
r <- list()
r[[1]] <- felm(log(employees_with_wages)~lowbenefit*week|company_id+week|0|company_id,data=hb[employees_with_wages>0 & industry=="Food & Drink"])
r[[2]] <- felm(log(hours_worked)~lowbenefit*week|company_id+week|0|company_id,data=hb[hours_worked>0 & industry=="Food & Drink"])
r[[3]] <- felm(log(1+total_wages)~lowbenefit*week|company_id+week|0|company_id,data=hb[1+total_wages>=0 & industry=="Food & Drink"])
r[[4]] <- felm(log(1+wages_per_hour)~lowbenefit*week|company_id+week|0|company_id,data=hb[1+total_wages>=0 & industry=="Food & Drink" & is.finite(wages_per_hour)])
# .printtable(r)
.coef_plot_1reg(r[[1]],"lowbenefit:week",8)+ geom_vline(xintercept = 10,color = "red",linetype="dashed")
2.2.2 Dep. Var: log(hours worked)
.coef_plot_1reg(r[[2]],"lowbenefit:week",8)+ geom_vline(xintercept = 10,color = "red",linetype="dashed")
2.2.3 Dep. Var: log(total wages)
.coef_plot_1reg(r[[3]],"lowbenefit:week",8)+ geom_vline(xintercept = 10,color = "red",linetype="dashed")
2.2.4 Dep. Var: log(Wage rate)
.coef_plot_1reg(r[[4]],"lowbenefit:week",8)+ geom_vline(xintercept = 10,color = "red",linetype="dashed")
3 Within States
hb <- read_fst("C:/Users/dratnadiwakara2/Documents/OneDrive - Louisiana State University/Raw Data/COVID19/homebase/homebase2.fst",as.data.table = T)
# hb[,week_of:=as.Date(week_of)]
hb <- hb[industry %in% c("Food & Drink")]
hb <- hb[week_of>="2019-12-31"]
hb[,hours_worked:=as.numeric(hours_worked)]
hb[,total_wages:=as.numeric(total_wages)]
hb[,hours_with_wages:= as.numeric(hours_with_wages)]
hb[,dayno:=as.numeric(week_of-as.Date("2019-12-31"))]
hb[,week:=floor(dayno/7)]
hb[,state:=substr(county_code,1,2)]
hb <- merge(hb,unempins,by="state")
hb[,county:=county_code]
hb[,weekno := week]
hb[,week:=as.factor(week)]
hb[,week:= relevel(hb$week,9)]
hb[,wages_per_hour:=total_wages/hours_with_wages]
hb[,company_location:=paste(company_id,county)]
hbjan <- hb[week_of<="2020-01-31"]
hbjan[,company_location:=paste(company_id,county)]
hbjan <- hbjan[,.(wages_per_week=mean(wages_per_hour,na.rm=T)*40,numberemployees=mean(employees_with_wages,na.rm=T)),by=company_location]
hbjan <- hbjan[numberemployees>=5 & is.finite(wages_per_week) & wages_per_week>200]
hb <- merge(hb, hbjan,by="company_location")
hb[,wagediff:=log((basebenefit+600)/wages_per_week)]
hb[,lowwage:=ifelse(wagediff>1,1,0)]
hb[,post:=ifelse(weekno>8,1,0)]
hb[,state_week:=paste(state,week)]
hb[,county_week:=paste(county,week)]r <- list()
r[[1]] <- felm(log(employees_with_wages)~lowwage*post|county_week|0|company_id,data=hb[employees_with_wages>0 & industry=="Food & Drink"])
r[[2]] <- felm(log(hours_worked)~lowwage*post|county_week|0|company_id,data=hb[hours_worked>0 & industry=="Food & Drink"])
r[[3]] <- felm(log(1+total_wages)~lowwage*post|county_week|0|company_id,data=hb[1+total_wages>=0 & industry=="Food & Drink"])
r[[4]] <- felm(log(1+wages_per_hour)~lowwage*post|county_week|0|company_id,data=hb[1+total_wages>=0 & industry=="Food & Drink" & is.finite(wages_per_hour)])
.printtable(r,column.labels = c("log(# employees)","log(hours worked)","log(total wages)","log(Wage rate)"),lines = list(c("Fixed Effects",rep("county*week",4)),c("SE Cluster",rep("Company",4))))##
## ================================================================================
## Dependent variable:
## ------------------------------------------------------------------
## log(# employees) log(hours worked) log(total wages) log(Wage rate)
## (1) (2) (3) (4)
## --------------------------------------------------------------------------------
## lowwage 0.035 0.024 -0.382*** -0.303***
## (0.022) (0.028) (0.031) (0.005)
## post
## (0.000) (0.000) (0.000) (0.000)
## lowwage:post -0.142*** -0.194*** -0.155*** 0.043***
## (0.022) (0.028) (0.034) (0.007)
## --------------------------------------------------------------------------------
## Fixed Effects county*week county*week county*week county*week
## SE Cluster Company Company Company Company
## Observations 169,510 171,373 169,883 169,454
## Adjusted R2 0.178 0.275 0.268 0.640
## ================================================================================
## Note: *p<0.1; **p<0.05; ***p<0.01
## 4 PPP Loans
sbpulse <- fread("C:/Users/dratnadiwakara2/Documents/OneDrive - Louisiana State University/Raw Data/COVID19/Small Business Pulse/national_state_comb.csv")
sbpulse <- dcast(sbpulse,ST+WEEK+INSTRUMENT_ID~ANSWER_ID,value.var="ESTIMATE_PERCENTAGE",fun.aggregate = sum)
sbpulse <- sbpulse[ST != "-"]
sbpulse <- sbpulse[INSTRUMENT_ID %in% 11:14,]
sbpulse[,question:=NA]
sbpulse[,value:=NA]
sbpulse[,question:=ifelse(INSTRUMENT_ID ==11,"missedloans",question)]
sbpulse[,value:=ifelse(INSTRUMENT_ID ==11,1 - sbpulse$`2`,value)]
sbpulse[,question:=ifelse(INSTRUMENT_ID ==12,"missedotherpayments",question)]
sbpulse[,value:=ifelse(INSTRUMENT_ID ==12,1 - sbpulse$`2`,value)]
sbpulse[,question:=ifelse(INSTRUMENT_ID ==13,"pppapplied",question)]
sbpulse[,value:=ifelse(INSTRUMENT_ID ==13,sbpulse$`1`,value)]
sbpulse[,question:=ifelse(INSTRUMENT_ID ==14,"pppreceived",question)]
sbpulse[,value:=ifelse(INSTRUMENT_ID ==14, sbpulse$`1`,value)]
sbpulse <- sbpulse[,c("ST","WEEK","question","value")]
sbpulse <- dcast(sbpulse,WEEK+ST~question)
sbpulse <- merge(sbpulse,unempins,by.x = "ST",by.y="statecode")
sbpulsesummary <- sbpulse[,.(replacementrate=mean(replacementrate),missedloans=mean(missedloans),pppapplied=mean(pppapplied),pppreceived=mean(pppreceived)),by=ST]4.1 Missed Loans
ggplot(sbpulsesummary,aes(x=replacementrate,y=missedloans))+geom_point()+geom_smooth(method="lm")+theme_minimal()+labs(x="Replacement rate",y="% missed loans")
4.2 PPP Loan Applications
ggplot(sbpulsesummary,aes(x=replacementrate,y=pppapplied))+geom_point()+geom_smooth(method="lm")+theme_minimal()+labs(x="Replacement rate",y="% PPP applied")
4.3 PPP Loan Approvals
ggplot(sbpulsesummary,aes(x=replacementrate,y=pppreceived))+geom_point()+geom_smooth(method="lm")+theme_minimal()+labs(x="Replacement rate",y="% PPP received")
4.4 Regression
r <- list()
r[[1]] <- felm(missedloans~I(replacementrate>1)|WEEK,data=sbpulse)
r[[2]] <- felm(pppapplied~I(replacementrate>1)|WEEK,data=sbpulse)
r[[3]] <- felm(pppreceived~I(replacementrate>1)|WEEK,data=sbpulse)
.printtable(r,column.labels = c("Missed loans","PPP Applied","PPP Received"),lines = list("Fixed Effects",rep("Week",3)))##
## ============================================================
## Dependent variable:
## -------------------------------------
## Missed loans PPP Applied PPP Received
## (1) (2) (3)
## ------------------------------------------------------------
## I(replacementrate > 1) -0.015*** -0.008 0.040***
## (0.004) (0.007) (0.011)
## ------------------------------------------------------------
## Fixed Effects
## Week Week Week
## Observations 204 204 204
## Adjusted R2 0.476 -0.012 0.659
## ============================================================
## Note: *p<0.1; **p<0.05; ***p<0.01
##