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)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)]files <- list.files(path = "C:/Users/dratnadiwakara2/Documents/OneDrive - Louisiana State University/Raw Data/COVID19/social distancing",pattern = '\\.fst',full.names = TRUE)
sd = lapply(files, read_fst, as.data.table = TRUE)
sd <- do.call(rbind , sd)
sd[,county:=substr(origin_census_block_group,1,5)]
sd[,dayno:=as.numeric(day-as.Date("2019-12-31"))]
sd[,week:=floor(dayno/7)]
sd <- sd[,.(device_count=sum(device_count,na.rm = T),
distance_traveled_from_home=mean(distance_traveled_from_home,na.rm=T),
completely_home_device_count=sum(completely_home_device_count,na.rm = T),
part_time_work_behavior_devices=sum(part_time_work_behavior_devices,na.rm = T),
full_time_work_behavior_devices=sum(full_time_work_behavior_devices,na.rm = T)),
by=.(week,county)]
sd[,state:=substr(county,1,2)]
# sd[,county:=substr(tract,1,5)]
sd[,pcthome:=completely_home_device_count*100/device_count]
sd[,pctparttime:=part_time_work_behavior_devices*100/device_count]
sd[,pctfulltime:=full_time_work_behavior_devices*100/device_count]
sd <- merge(sd,unempins,by="state")
sd <- merge(sd,acskp,by.x="county",by.y="fips")
sd <- merge(sd,election[,c("FIPS","rep_pct")],by.x="county",by.y="FIPS")
sd[,weekno := week]
sd[,week:=as.factor(week)]
sd[,week:= relevel(sd$week,9)]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)
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)
2 Empirical Specification
\[ Outcome_w = \Sigma_w\text{ } \beta_w \times w \times HighBenefits + County\text{ }Fixed\text{ }Effects + Week\text{ }Fixed\text{ }Effects\]
where \(w\) is a dummy variable that indicates the week and \(HighBenefits\) indicates the states where unemployment benefit amount is more than the wage.
All the figures below plot the \(\beta_w\) estimates with the corresponding 95% confidence intervals.
3 Foot Traffic
3.1 Pct Full-Time
3.1.1 By Income
r <- list()
r[[1]] <- felm(log(1+pctfulltime)~I(replacementrate>1)*factor(week)|county+week|0|county,data=sd[sd$medianincome<50000])
r[[2]] <- felm(log(1+pctfulltime)~I(replacementrate>1)*factor(week)|county+week|0|county,data=sd[sd$medianincome>=50000])
.coef_plot_2reg(r[[1]],"Income less than 50k",r[[2]],"Income greater than 50k","I(replacementrate > 1)TRUE:factor(week)",8)+ geom_vline(xintercept = 9,color = "grey",linetype="dashed")
3.1.2 By Political Affiliation
r <- list()
r[[1]] <- felm(log(1+pctfulltime)~I(replacementrate>1)*factor(week)|county+week|0|county,data=sd[sd$rep_pct<0.5])
r[[2]] <- felm(log(1+pctfulltime)~I(replacementrate>1)*factor(week)|county+week|0|county,data=sd[sd$rep_pct>=0.5])
.coef_plot_2reg(r[[1]],"Democratic",r[[2]],"Republican","I(replacementrate > 1)TRUE:factor(week)",8)+ geom_vline(xintercept = 9,color = "grey",linetype="dashed")
3.2 Pct Part-Time
3.2.1 By Income
r <- list()
r[[1]] <- felm(log(1+pctparttime)~I(replacementrate>1)*factor(week)|county+week|0|county,data=sd[sd$medianincome<50000])
r[[2]] <- felm(log(1+pctparttime)~I(replacementrate>1)*factor(week)|county+week|0|county,data=sd[sd$medianincome>=50000])
.coef_plot_2reg(r[[1]],"Income less than 50k",r[[2]],"Income greater than 50k","I(replacementrate > 1)TRUE:factor(week)",8)+ geom_vline(xintercept = 9,color = "grey",linetype="dashed")
3.2.2 By Political Affiliation
r <- list()
r[[1]] <- felm(log(1+pctparttime)~I(replacementrate>1)*factor(week)|county+week|0|county,data=sd[sd$rep_pct<0.5])
r[[2]] <- felm(log(1+pctparttime)~I(replacementrate>1)*factor(week)|county+week|0|county,data=sd[sd$rep_pct>=0.5])
.coef_plot_2reg(r[[1]],"Democratic",r[[2]],"Republican","I(replacementrate > 1)TRUE:factor(week)",8)+ geom_vline(xintercept = 9,color = "grey",linetype="dashed")
3.3 Pct at Home (SG)
3.3.1 By Income
r <- list()
r[[1]] <- felm(log(pcthome)~I(replacementrate>1)*factor(week)|county+week|0|county,data=sd[sd$medianincome<50000])
r[[2]] <- felm(log(pcthome)~I(replacementrate>1)*factor(week)|county+week|0|county,data=sd[sd$medianincome>=50000])
.coef_plot_2reg(r[[1]],"Income less than 50k",r[[2]],"Income greater than 50k","I(replacementrate > 1)TRUE:factor(week)",8)+ geom_vline(xintercept = 9,color = "grey",linetype="dashed")
3.3.2 By Political Affiliation
r <- list()
r[[1]] <- felm(log(pcthome)~I(replacementrate>1)*factor(week)|county+week|0|county,data=sd[sd$rep_pct<0.5])
r[[2]] <- felm(log(pcthome)~I(replacementrate>1)*factor(week)|county+week|0|county,data=sd[sd$rep_pct>=0.5])
.coef_plot_2reg(r[[1]],"Democratic",r[[2]],"Republican","I(replacementrate > 1)TRUE:factor(week)",8)+ geom_vline(xintercept = 9,color = "grey",linetype="dashed")
4 log(Spending)
zip_county <- fread("C:/Users/dratnadiwakara2/Documents/OneDrive - Louisiana State University/Raw Data/Crosswalk Files/ZIP_COUNTY_092016.csv")
zip_county<- zip_county[order(zip_county$ZIP,-zip_county$RES_RATIO)]
zip_county <- zip_county[!duplicated(zip_county$ZIP),c("ZIP","COUNTY")]trans <- fread("C:/Users/dratnadiwakara2/Documents/OneDrive - Louisiana State University/Raw Data/COVID19/sg_trans/cut-1-daily-spend-by-zip-20170101-20200503.csv.gz")
names(trans) <- c("day","zip","nocards","notrans","totalspent")
trans[,day:=as.Date(day)]
trans <- trans[day>="2020-01-01"]
trans <- merge(trans,zip_county,by.x="zip",by.y="ZIP")
trans[,dayno:=as.numeric(day-as.Date("2019-12-31"))]
trans[,week:=floor(dayno/7)]
trans <- trans[,.(nocards=sum(nocards,na.rm = T),
notrans=sum(notrans,na.rm=T),
totalspent=sum(totalspent,na.rm=T)),
by=.(COUNTY,week)]
names(trans) <- c("county","week","nocards","notrans","totalspent")
trans[,county:=ifelse(nchar(county)==4,paste0("0",county),paste0(county))]
trans[,state:=substr(county,1,2)]
trans <- merge(trans,election[,c("FIPS","rep_pct")],by.x="county",by.y="FIPS")
trans <- merge(trans,acskp,by.x="county",by.y="fips")
trans <- merge(trans,unempins,by="state")
trans[,weekno := week]
trans[,week:=as.factor(week)]
trans[,week:= relevel(trans$week,9)]r <- list()
r[[1]] <- felm(log(1+totalspent)~I(replacementrate>1)*week|county+week|0|county,data=trans[trans$medianincome>30000 & trans$medianincome<50000 & (replacementrate>quantile(unempins$replacementrate,0.75) | replacementrate<quantile(unempins$replacementrate,0.25)) & weekno>4 ])
r[[2]] <- felm(log(1+totalspent)~I(replacementrate>1)*week|county+week|0|county,data=trans[trans$medianincome>=50000 & (replacementrate>quantile(unempins$replacementrate,0.75) | replacementrate<quantile(unempins$replacementrate,0.25)) & weekno>4 ])
.coef_plot_2reg(r[[1]],"Income less than 50k",r[[2]],"Income greater than 50k","I(replacementrate > 1)TRUE:week",8)+ geom_vline(xintercept = 9,color = "grey",linetype="dashed")
5 Employment (HB)
hb <- read_fst("C:/Users/dratnadiwakara2/Documents/OneDrive - Louisiana State University/Raw Data/COVID19/homebase/homebase.fst",as.data.table = T)
hb[,week_of:=as.Date(week_of)]
hb[,hours_worked:=as.numeric(hours_worked)]
hb[,total_wages:=as.numeric(total_wages)]
hb <- hb[,.(
employees_with_wages=sum(employees_with_wages,na.rm=T),
hours_worked=sum(hours_worked,na.rm=T),
total_wages=sum(total_wages,na.rm=T)),
by=.(week_of,county_code,industry)]
hb <- hb[week_of>="2019-12-31"]
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,election[,c("FIPS","rep_pct")],by.x="county_code",by.y="FIPS")
hb <- merge(hb,acskp,by.x="county_code",by.y="fips")
hb <- merge(hb,unempins,by="state")
hb[,county:=county_code]
hb[,weekno := week]
hb[,week:=as.factor(week)]
hb[,week:= relevel(hb$week,9)]5.1 log(Number of Employees)
5.1.1 Food & Drink Industry
r <- list()
r[[1]] <- felm(log(employees_with_wages)~I(replacementrate>1)*week|county+week|0|county,data=hb[hb$medianincome<50000 & employees_with_wages>0 & industry=="Food & Drink"])
r[[2]] <- felm(log(employees_with_wages)~I(replacementrate>1)*week|county+week|0|county,data=hb[hb$medianincome>=50000 & employees_with_wages>0 & industry=="Food & Drink"])
.coef_plot_2reg(r[[1]],"Income less than 50k",r[[2]],"Income greater than 50k","I(replacementrate > 1)TRUE:week",8)+ geom_vline(xintercept = 9,color = "grey",linetype="dashed")
5.1.2 Retail Industry
r <- list()
r[[1]] <- felm(log(employees_with_wages)~I(replacementrate>1)*week|county+week|0|county,data=hb[hb$medianincome<50000 & employees_with_wages>0 & industry=="Retail"])
r[[2]] <- felm(log(employees_with_wages)~I(replacementrate>1)*week|county+week|0|county,data=hb[hb$medianincome>=50000 & employees_with_wages>0 & industry=="Retail"])
.coef_plot_2reg(r[[1]],"Income less than 50k",r[[2]],"Income greater than 50k","I(replacementrate > 1)TRUE:week",8)+ geom_vline(xintercept = 9,color = "grey",linetype="dashed")
5.2 log(Hours Worked)
5.2.1 Food & Drink Industry
r <- list()
r[[1]] <- felm(log(hours_worked)~I(replacementrate>1)*week|county+week|0|county,data=hb[hb$medianincome<50000 & hours_worked>0 & industry=="Food & Drink"])
r[[2]] <- felm(log(hours_worked)~I(replacementrate>1)*week|county+week|0|county,data=hb[hb$medianincome>=50000 & hours_worked>0 & industry=="Food & Drink"])
.coef_plot_2reg(r[[1]],"Income less than 50k",r[[2]],"Income greater than 50k","I(replacementrate > 1)TRUE:week",8)+ geom_vline(xintercept = 9,color = "grey",linetype="dashed")
5.2.2 Retail Industry
r <- list()
r[[1]] <- felm(log(hours_worked)~I(replacementrate>1)*week|county+week|0|county,data=hb[hb$medianincome<50000 & hours_worked>0 & industry=="Retail"])
r[[2]] <- felm(log(hours_worked)~I(replacementrate>1)*week|county+week|0|county,data=hb[hb$medianincome>=50000 & hours_worked>0 & industry=="Retail"])
.coef_plot_2reg(r[[1]],"Income less than 50k",r[[2]],"Income greater than 50k","I(replacementrate > 1)TRUE:week",8)+ geom_vline(xintercept = 9,color = "grey",linetype="dashed")
5.3 log(Total Wages)
5.3.1 Food & Drink Industry
r <- list()
r[[1]] <- felm(log(1+total_wages)~I(replacementrate>1)*week|county+week|0|county,data=hb[hb$medianincome<50000 & hours_worked>0 & industry=="Food & Drink"])
r[[2]] <- felm(log(1+total_wages)~I(replacementrate>1)*week|county+week|0|county,data=hb[hb$medianincome>=50000 & hours_worked>0 & industry=="Food & Drink"])
.coef_plot_2reg(r[[1]],"Income less than 50k",r[[2]],"Income greater than 50k","I(replacementrate > 1)TRUE:week",8)+ geom_vline(xintercept = 9,color = "grey",linetype="dashed")
5.3.2 Retail Industry
r <- list()
r[[1]] <- felm(log(1+total_wages)~I(replacementrate>1)*week|county+week|0|county,data=hb[hb$medianincome<50000 & hours_worked>0 & industry=="Retail"])
r[[2]] <- felm(log(1+total_wages)~I(replacementrate>1)*week|county+week|0|county,data=hb[hb$medianincome>=50000 & hours_worked>0 & industry=="Retail"])
.coef_plot_2reg(r[[1]],"Income less than 50k",r[[2]],"Income greater than 50k","I(replacementrate > 1)TRUE:week",8)+ geom_vline(xintercept = 9,color = "grey",linetype="dashed")