Number of Orders
dt_stc <- readRDS(paste0(dir_clean,"date/cw_date_st_reg.rds"))
dt_st <- readRDS(paste0(dir_clean,"cw/cw_geo_nber_state.rds"))
dt_stc <- merge(dt_stc,dt_st[,c("st","stfips")],by=c("st"),all.x=T)
f_nst <- function(dt_stc,vby=c("date")) {
# Keep only states
dt_stc <- dt_stc[stfips<=56,]
dt_stc[, ngap:=dreop-dstay]
dt_date <- data.table(date=seq(as.Date("2020-03-01"), as.Date("2020-06-15"), 1))
dt_out <- merge(dt_date[, c(.SD, id=1)], dt_stc[, c(.SD, id=1)], by=c("id"), allow.cartesian = T)
dt_out[date>=dstay, n_stay:=1]
dt_out[date>=dreop & !is.na(dstay), n_reop:=1] # Requiring a shutdown order
dt_out[(date>=dstay & date<dreop) | (date>=dstay & is.na(dreop)), n_active:=1]
dt_out <- dt_out[, lapply(.SD, sum, na.rm=T), by=vby, .SDcols=patterns("^n_")]
return(dt_out)
}
f_nstfig <- function(dt_in,vby=c("date")) {
dt_fig <- melt(dt_in, id.vars = c(vby), variable.name = "vars", value.name = "n_st", variable.factor = F)
dt_fig[vars=="n_stay", var:=1]
dt_fig[vars=="n_reop", var:=2]
dt_fig[vars=="n_active", var:=3]
dt_fig[, var:=factor(var)]
setattr(dt_fig$var, "levels", c("Ever Shutdown","Ever Reopen","Active Order"))
return(dt_fig)
}
dt_out <- f_nst(dt_stc,vby=c("date"))
dt_fig <- f_nstfig(dt_out,vby=c("date"))
ggplot(dt_fig[var=="Active Order"], aes(x=date, y=n_st, color=var)) + ggtheme +
geom_line(size=1.5) +
scale_color_manual(values=RColorBrewer::brewer.pal(3, name="Set1")[2]) +
labs(x="Date",y="Number of States",color="Status") +
theme(legend.position = "off", legend.title=element_text(size=16), legend.text=element_text(size=16))
ggsave(paste0(dir_ofig, "P3_order_timing.png"),width=9, height=6, dpi=300)
fwrite(dt_fig[var=="Active Order"],paste0(dir_ofigd, "P3_order_timing.csv"))
print(paste("Started at", Sys.time()))
## [1] "Started at 2020-07-21 12:46:47"
dt_info <- data.table(lhs=c("hours","visit","case","hits"),
lhst=c("ln(Hours)","ln(Visits)","ln(Cases per capita)","Google Trends Index"),
lhsf=factor(c(1:4)))
setattr(dt_info$lhsf, "levels", dt_info$lhst)
if (any(as.character(dt_info$lhsf)!=dt_info$lhst)) {
print("ERROR: LEVEL NOT MATCHED")
}
#-------------------------------------------------------------------------------
# Functions for figures
# dt_fig <- dt_res[lhs %in% c("hours","visit")]
# xtitle <- "Days Since Order"
# ttitle <- "Order"
f_lineci2 <- function(dt_fig, xtitle="", ttitle="", plegend="off") {
dti_fig <- copy(dt_fig)[nd_order>=-15 & nd_order<=35]
gg_return <- ggplot(NULL) + ggtheme +
geom_ribbon(data=dti_fig[order=="Shut-Down"],aes(x=nd_order,ymin=ci_lb,ymax=ci_ub),fill="grey75",alpha=0.25) +
geom_ribbon(data=dti_fig[order=="Reopen"],aes(x=nd_order,ymin=ci_lb,ymax=ci_ub),fill="grey75",alpha=0.25) +
geom_ribbon(data=dti_fig[order=="School Closure"],aes(x=nd_order,ymin=ci_lb,ymax=ci_ub),fill="grey75",alpha=0.25) +
geom_ribbon(data=dti_fig[order=="End of Shut-Down"],aes(x=nd_order,ymin=ci_lb,ymax=ci_ub),fill="grey75",alpha=0.25) +
geom_line(data=dti_fig,aes(x=nd_order, y=coef, color=order, linetype=order), size=1.5) +
scale_linetype_manual(values=c("solid","longdash")) +
scale_color_manual(values = brewer.pal(3,"Set1")[c(1,2)]) +
geom_vline(xintercept = 0, linetype="dashed") +
geom_hline(yintercept = 0, linetype="dashed") +
facet_wrap(facets=vars(lhsf), scale="free") +
coord_cartesian(xlim=c(-10,30)) +
labs(x=xtitle,y="Coefficients",title=ttitle, color="Order Type",linetype="Order Type") +
theme(legend.position = plegend, strip.text.x = element_text(size = 22),legend.key.width=unit(0.8,"inch"))
gg_return
return(gg_return)
}
f_linedfe <- function(dt_fig,ttitle="Calendar Day Fixed-Effects",xtitle="Date",wlegend=T) {
gg_return <- ggplot(dt_fig, aes(x=date, y=coef, color=order)) + ggtheme +
geom_line(aes(linetype=order),size=1.5) +
scale_color_brewer(palette = "Set1") +
scale_linetype_manual(values=c("solid","longdash")) +
scale_x_date(date_breaks = "1 month", date_labels = "%h") +
facet_wrap(facets=vars(lhsf), scale="free") +
labs(x=xtitle,y="Coefficients",color="Order Type",linetype="Order Type",title = ttitle) +
theme(strip.text.x = element_text(size = 22),legend.key.width=unit(0.8,"inch"))
if (wlegend) {
gg_return <- gg_return + theme(legend.position = "bottom")
} else {
gg_return <- gg_return + theme(legend.position = "off")
}
return(gg_return)
}
Restricted Event Studies
#---------------------------------------
# Restricted Event Studies
itype <- "res"
istdate <- T
dt_res<- data.table()
for (iordrt in c("stay","reop","stay_end","school")) {
for (ilhs in c("hours","visit")) {
dt_res <- rbind(dt_res, f_reades(reg_type=itype,reg_ord=iordrt,reg_lhs=ilhs,reg_stdate=istdate,dir_es=dir_es))
}
}
dt_res <- merge(dt_res, dt_info, by=c("lhs"), all.x=T)
#---------------------------------------
# Calendar FE (adjust for linear trend)
itype <- "res"
istdate <- T
dt_resfe <- data.table()
for (ilhs in c("hours","visit")) {
dt_resfe <- rbind(dt_resfe, f_readesdfe(reg_type=itype,reg_lhs=ilhs,reg_lord=c("stay","reop","stay_end","school"),reg_stdate=istdate,dir_es=dir_es))
}
## [1] "Adjustment for reop"
## [1] "Date for adjustment: 2020-04-13"
## [1] "Adjustment for stay_end"
## [1] "Date for adjustment: 2020-04-13"
## [1] "Adjustment for reop"
## [1] "Date for adjustment: 2020-04-13"
## [1] "Adjustment for stay_end"
## [1] "Date for adjustment: 2020-04-13"
dt_resfe <- merge(dt_resfe, dt_info, by=c("lhs"), all.x=T)
gg_coef <- f_lineci2(dt_res[lhs %in% c("hours","visit") & !ord %in% c("school","stay_end")],
xtitle="Days Since Order",ttitle="Panel A: Days Since Shut-Down and Reopen Orders")
gg_dfe <- f_linedfe(dt_resfe[lhs %in% c("hours","visit") & !ord %in% c("school","stay_end")],
ttitle="Panel B: Calendar Day Fixed-Effects")
gg_out2 <- grid.arrange(gg_coef,gg_dfe)
gg_out2
## TableGrob (2 x 1) "arrange": 2 grobs
## z cells name grob
## 1 1 (1-1,1-1) arrange gtable[layout]
## 2 2 (2-2,1-1) arrange gtable[layout]
ggsave(plot=gg_out2,paste0(dir_ofig,"P3_res_coef_fde_4p.png"),width=12, height=10, dpi=300)
fwrite(dt_res[lhs %in% c("hours","visit") & !order %in% c("School Closure")], paste0(dir_ofigd,"P3_res_coef_fde_4p_coef.csv"))
fwrite(dt_resfe[lhs %in% c("hours","visit") & !order %in% c("School Closure")], paste0(dir_ofigd,"P3_res_coef_fde_4p_coeffe.csv"))
Restricted Event Studies without State-Specific Trends
#---------------------------------------
# Restricted Event Studies
itype <- "res"
istdate <- F
dt_res<- data.table()
for (iordrt in c("stay","reop")) {
for (ilhs in c("hours","visit")) {
dt_res <- rbind(dt_res, f_reades(reg_type=itype,reg_ord=iordrt,reg_lhs=ilhs,reg_stdate=istdate,dir_es=dir_es))
}
}
dt_res <- merge(dt_res, dt_info, by=c("lhs"), all.x=T)
#---------------------------------------
# Calendar FE (adjust for linear trend)
itype <- "res"
istdate <- F
dt_resfe <- data.table()
for (ilhs in c("hours","visit")) {
dt_resfe <- rbind(dt_resfe, f_readesdfe(reg_type=itype,reg_lhs=ilhs,reg_lord=c("stay","reop","stay_end","school"),reg_stdate=istdate,dir_es=dir_es))
}
## [1] "Adjustment for reop"
## [1] "Date for adjustment: 2020-04-13"
## [1] "Adjustment for reop"
## [1] "Date for adjustment: 2020-04-13"
dt_resfe <- merge(dt_resfe, dt_info, by=c("lhs"), all.x=T)
gg_coef <- f_lineci2(dt_res[lhs %in% c("hours","visit") & !ord %in% c("school","stay_end")],
xtitle="Days Since Order",ttitle="Panel A: Days Since Shut-Down and Reopen Orders")
gg_dfe <- f_linedfe(dt_resfe[lhs %in% c("hours","visit") & !ord %in% c("school","stay_end")],
ttitle="Panel B: Calendar Day Fixed-Effects")
gg_out2 <- grid.arrange(gg_coef,gg_dfe)
gg_out2
## TableGrob (2 x 1) "arrange": 2 grobs
## z cells name grob
## 1 1 (1-1,1-1) arrange gtable[layout]
## 2 2 (2-2,1-1) arrange gtable[layout]
ggsave(plot=gg_out2,paste0(dir_ofig,"P3_res_coef_fde_4p_nostdate.png"),width=12, height=10, dpi=300)
fwrite(dt_res[lhs %in% c("hours","visit") & !order %in% c("School Closure")], paste0(dir_ofigd,"P3_res_coef_fde_4p_coef_nostdate.csv"))
fwrite(dt_resfe[lhs %in% c("hours","visit") & !order %in% c("School Closure")], paste0(dir_ofigd,"P3_res_coef_fde_4p_coeffe_nostdate.csv"))
Additional Event study: Shut-Down and School Closure in the Same Model
#===============================================================================
vlhsrt <- "hours"
vlhs <- "ln_r_hours"
f_regadd <- function(vlhsrt,vlhs="") {
if (vlhs=="") {
vlhs <- paste0("ln_r_",vlhsrt)
}
dt_reg1 <- readRDS(paste0(dir_es,"dt_reg/esreg_data_res_stay_",vlhsrt,"_stdate.rds"))
dt_reg2 <- readRDS(paste0(dir_es,"dt_reg/esreg_data_res_school_",vlhsrt,"_stdate.rds"))
dt_in <- merge(dt_reg1, dt_reg2[,.SD,.SDcols=patterns("^st$|^date$|ie_school_nd")], by=c("st","date"), all=T)
ldum <- names(dt_in)
ldumreg <- c() # The list of event day dummy to keep
ldumreg <- c(ldumreg,ldum[grepl(paste0("ie_stay_nd_"), ldum)])
ldumreg <- c(ldumreg,ldum[grepl(paste0("ie_school_nd_"), ldum)])
for (idum in ldumreg) {
if (grepl("_n\\d+$",idum)) {
idumd <- as.integer(sub("^.*?_n(\\d+)$","\\1",idum))
if (idumd>7) {
ldumreg <- ldumreg[ldumreg!=idum]
}
}
}
lstdate <- names(dt_in)
lstdate <- lstdate[grepl("stdate_", lstdate) & lstdate!="stdate_CA"] # CA as baseline
ldumreg <- c(ldumreg, lstdate)
lm_f <- paste0(vlhs, " ~ ", paste(c(ldumreg,"st","datef"),collapse = "+"))
print(lm_f)
lm_out <- lm(formula = as.formula(lm_f), data=dt_in)
dt_out <- f_reades(reg_type="",reg_ord="",reg_lhs=vlhsrt,reg_stdate=T,lm_out=lm_out,dir_es=dir_es)
dt_outfe <- rbind(f_readesdfe(reg_type="",reg_lhs=vlhsrt,reg_stdate=T,lm_out=lm_out,reg_lord="stay",dir_es=dir_es),
f_readesdfe(reg_type="",reg_lhs=vlhsrt,reg_stdate=T,lm_out=lm_out,reg_lord="school",dir_es=dir_es))
return(list(dt_out,dt_outfe))
}
ldt1 <- f_regadd("hours")
## [1] "ln_r_hours ~ ie_stay_nd_n7+ie_stay_nd_n6+ie_stay_nd_n5+ie_stay_nd_n4+ie_stay_nd_n3+ie_stay_nd_n2+ie_stay_nd_n1+ie_stay_nd_0+ie_stay_nd_1+ie_stay_nd_2+ie_stay_nd_3+ie_stay_nd_4+ie_stay_nd_5+ie_stay_nd_6+ie_stay_nd_7+ie_stay_nd_8+ie_stay_nd_9+ie_stay_nd_10+ie_stay_nd_11+ie_stay_nd_12+ie_stay_nd_13+ie_stay_nd_14+ie_stay_nd_15+ie_stay_nd_16+ie_stay_nd_17+ie_stay_nd_18+ie_stay_nd_19+ie_stay_nd_20+ie_stay_nd_21+ie_stay_nd_22+ie_stay_nd_23+ie_stay_nd_24+ie_stay_nd_25+ie_stay_nd_26+ie_stay_nd_27+ie_stay_nd_28+ie_stay_nd_29+ie_stay_nd_30+ie_stay_nd_31+ie_school_nd_n7+ie_school_nd_n6+ie_school_nd_n5+ie_school_nd_n4+ie_school_nd_n3+ie_school_nd_n2+ie_school_nd_n1+ie_school_nd_0+ie_school_nd_1+ie_school_nd_2+ie_school_nd_3+ie_school_nd_4+ie_school_nd_5+ie_school_nd_6+ie_school_nd_7+ie_school_nd_8+ie_school_nd_9+ie_school_nd_10+ie_school_nd_11+ie_school_nd_12+ie_school_nd_13+ie_school_nd_14+ie_school_nd_15+ie_school_nd_16+ie_school_nd_17+ie_school_nd_18+ie_school_nd_19+ie_school_nd_20+ie_school_nd_21+ie_school_nd_22+ie_school_nd_23+ie_school_nd_24+ie_school_nd_25+ie_school_nd_26+ie_school_nd_27+ie_school_nd_28+ie_school_nd_29+ie_school_nd_30+ie_school_nd_31+ie_school_nd_32+ie_school_nd_33+ie_school_nd_34+stdate_AL+stdate_AK+stdate_AZ+stdate_AR+stdate_CO+stdate_CT+stdate_DE+stdate_DC+stdate_FL+stdate_GA+stdate_HI+stdate_ID+stdate_IL+stdate_IN+stdate_IA+stdate_KS+stdate_KY+stdate_LA+stdate_ME+stdate_MD+stdate_MA+stdate_MI+stdate_MN+stdate_MS+stdate_MO+stdate_MT+stdate_NE+stdate_NV+stdate_NH+stdate_NJ+stdate_NM+stdate_NY+stdate_NC+stdate_ND+stdate_OH+stdate_OK+stdate_OR+stdate_PA+stdate_RI+stdate_SC+stdate_SD+stdate_TN+stdate_TX+stdate_UT+stdate_VT+stdate_VA+stdate_WA+stdate_WV+stdate_WI+stdate_WY+st+datef"
ldt2 <- f_regadd("visit","ln_r_visit")
## [1] "ln_r_visit ~ ie_stay_nd_n7+ie_stay_nd_n6+ie_stay_nd_n5+ie_stay_nd_n4+ie_stay_nd_n3+ie_stay_nd_n2+ie_stay_nd_n1+ie_stay_nd_0+ie_stay_nd_1+ie_stay_nd_2+ie_stay_nd_3+ie_stay_nd_4+ie_stay_nd_5+ie_stay_nd_6+ie_stay_nd_7+ie_stay_nd_8+ie_stay_nd_9+ie_stay_nd_10+ie_stay_nd_11+ie_stay_nd_12+ie_stay_nd_13+ie_stay_nd_14+ie_stay_nd_15+ie_stay_nd_16+ie_stay_nd_17+ie_stay_nd_18+ie_stay_nd_19+ie_stay_nd_20+ie_stay_nd_21+ie_stay_nd_22+ie_stay_nd_23+ie_stay_nd_24+ie_stay_nd_25+ie_stay_nd_26+ie_stay_nd_27+ie_stay_nd_28+ie_stay_nd_29+ie_stay_nd_30+ie_stay_nd_31+ie_school_nd_n7+ie_school_nd_n6+ie_school_nd_n5+ie_school_nd_n4+ie_school_nd_n3+ie_school_nd_n2+ie_school_nd_n1+ie_school_nd_0+ie_school_nd_1+ie_school_nd_2+ie_school_nd_3+ie_school_nd_4+ie_school_nd_5+ie_school_nd_6+ie_school_nd_7+ie_school_nd_8+ie_school_nd_9+ie_school_nd_10+ie_school_nd_11+ie_school_nd_12+ie_school_nd_13+ie_school_nd_14+ie_school_nd_15+ie_school_nd_16+ie_school_nd_17+ie_school_nd_18+ie_school_nd_19+ie_school_nd_20+ie_school_nd_21+ie_school_nd_22+ie_school_nd_23+ie_school_nd_24+ie_school_nd_25+ie_school_nd_26+ie_school_nd_27+ie_school_nd_28+ie_school_nd_29+ie_school_nd_30+ie_school_nd_31+ie_school_nd_32+ie_school_nd_33+ie_school_nd_34+stdate_AL+stdate_AK+stdate_AZ+stdate_AR+stdate_CO+stdate_CT+stdate_DE+stdate_DC+stdate_FL+stdate_GA+stdate_HI+stdate_ID+stdate_IL+stdate_IN+stdate_IA+stdate_KS+stdate_KY+stdate_LA+stdate_ME+stdate_MD+stdate_MA+stdate_MI+stdate_MN+stdate_MS+stdate_MO+stdate_MT+stdate_NE+stdate_NV+stdate_NH+stdate_NJ+stdate_NM+stdate_NY+stdate_NC+stdate_ND+stdate_OH+stdate_OK+stdate_OR+stdate_PA+stdate_RI+stdate_SC+stdate_SD+stdate_TN+stdate_TX+stdate_UT+stdate_VT+stdate_VA+stdate_WA+stdate_WV+stdate_WI+stdate_WY+st+datef"
dt_resa <- rbind(ldt1[[1]],ldt2[[1]])
dt_resafe <- rbind(ldt1[[2]],ldt2[[2]])
dt_resa <- merge(dt_resa, dt_info, by=c("lhs"), all.x=T)
dt_resafe <- merge(dt_resafe, dt_info, by=c("lhs"), all.x=T)
gg_coef <- f_lineci2(dt_resa,
"Days Since Order","Panel A: Days Since Order",plegend="bottom")
gg_dfe <- f_linedfe(dt_resafe[ord=="stay"],ttitle="Panel B: Calendar Day Fixed-Effects", wlegend=F)
gg_out <- grid.arrange(gg_coef,gg_dfe)
gg_out
## TableGrob (2 x 1) "arrange": 2 grobs
## z cells name grob
## 1 1 (1-1,1-1) arrange gtable[layout]
## 2 2 (2-2,1-1) arrange gtable[layout]
ggsave(plot=gg_out,paste0(dir_ofig,"P3_res_coef_fde_4p_stay_school.png"),width=12, height=10, dpi=300)
fwrite(dt_resa, paste0(dir_ofigd,"P3_res_coef_fde_4p_stay_school_coef.csv"))
fwrite(dt_resafe[ord=="stay"], paste0(dir_ofigd,"P3_res_coef_fde_4p_stay_school_coeffe.csv"))
Event study for UI
#===============================================================================
ireg <- "es"
dt_ui <- data.table()
for (iordrt in c("pua","fpuc")) {
for (ilhs in c("hours","visit")) {
dt_ui <- rbind(dt_ui, f_reades(reg_type=ireg,reg_ord=iordrt,reg_lhs=ilhs,dir_es=dir_es))
}
}
## [1] "Added Day"
## order nd_order
## 1: PUA -1
## [1] "Added Day"
## order nd_order
## 1: PUA -1
## [1] "Added Day"
## order nd_order
## 1: FPUC -8
## 2: FPUC -1
## [1] "Added Day"
## order nd_order
## 1: FPUC -8
## 2: FPUC -1
dt_ui <- merge(dt_ui, dt_info, by=c("lhs"), all.x=T)
dt_ui[,order:=droplevels(order)]
gg_return <- ggplot(dt_ui[lhs=="hours" & nd_order>=-25 & nd_order<=35,]) + ggtheme +
geom_line(aes(x=nd_order, y=coef, color=order), size=1.5) +
scale_color_brewer(palette = "Set1") +
geom_ribbon(aes(x=nd_order,ymin=ci_lb,ymax=ci_ub),fill="grey75",alpha=0.25) +
geom_vline(xintercept = 0, linetype="dashed") +
geom_hline(yintercept = 0, linetype="dashed") +
facet_wrap(facets=vars(order)) +
coord_cartesian(xlim=c(-20,30)) +
labs(x="Days Since Payment",y=paste0("Coefficients"),color="UI Type") +
theme(legend.position = "off",strip.text.x = element_text(size = 22),legend.key.width=unit(0.8,"inch"))
gg_return
ggsave(plot=gg_return,paste0(dir_ofig, "P3_es_ui_hrs.png"),width=12, height=6, dpi=300)
fwrite(dt_ui[lhs=="hours" & nd_order>=-25 & nd_order<=35,], paste0(dir_ofigd,"P3_es_ui_hrs_coef.csv"))
print(paste("Ended at", Sys.time()))
## [1] "Ended at 2020-07-21 12:47:16"