print(paste("Started at", Sys.time()))
## [1] "Started at 2020-11-10 18:55:47"
source(paste0(dir_func,"f_wk.R"))
source(paste0(dir_func,"f_ratio.R"))
dt_hbf <- readRDS(paste0(dir_clean, "homebase_firm_ind_geo_date_2020.rds"))[firm_base_2wk==1 & st_sel_2wk==1,]
dt_hbf[,week:=f_wk(date)]
f_ndaywk("dt_hbf")
dt_hbf <- dt_hbf[week<=f_wk("2020-07-11")]
# Keep only states + DC
dt_st <- readRDS(paste0(dir_clean, "cw/cw_geo_nber_state.rds"))
dt_hbf <- merge(dt_hbf, dt_st[,c("st","stfips")],by=c("st"),all.x=T)
dt_hbf <- dt_hbf[stfips<=56,]
# Merge with state PPP category
dt_hbf <- merge(dt_hbf, readRDS(paste0(dir_clean, "ppp/ppp_stc_sel.rds"))[,c("st","loanc","loanac_0416","uic")], by=c("st"),all.x=T)
dt_pppsum <- readRDS(paste0(dir_clean, "ppp/ppp_stc_sel.rds"))[,c("st","loanc","loan_sel","pay_sel")]
dt_pppsum <- dt_pppsum[,lapply(.SD,sum,na.rm=T),by=c("loanc"),.SDcols=c("loan_sel","pay_sel")]
dt_pppsum[, loanr:=loan_sel/pay_sel]
setorderv(dt_pppsum,c("loanc"))
print(dt_pppsum)
## loanc loan_sel pay_sel loanr
## 1: Q1 2986110773 37473312 79.68633
## 2: Q2 3824711584 30214704 126.58445
## 3: Q3 2064963028 13238412 155.98268
## 4: Q4 1711721172 8024692 213.30678
print(dt_pppsum[4,loanr]/dt_pppsum[1,loanr])
## [1] 2.67683
dt_pppsum <- readRDS(paste0(dir_clean, "ppp/ppp_stc_sel.rds"))[,c("st","loanc","loan_sel","pay_sel")]
dt_pppsum[, loanr:=loan_sel/pay_sel]
dt_pppsum <- dt_pppsum[,lapply(.SD,mean,na.rm=T),by=c("loanc"),.SDcols=c("loanr")]
setorderv(dt_pppsum,c("loanc"))
print(dt_pppsum)
## loanc loanr
## 1: Q1 84.88913
## 2: Q2 126.00907
## 3: Q3 157.73123
## 4: Q4 223.72822
print(dt_pppsum[4,loanr]/dt_pppsum[1,loanr])
## [1] 2.635534
PPP
#---------------------------------------
# Group by aggregate PPP
# Aggregate to total
dt_ratio <- f_ratio(dt_hbf[ndaywk==7],var_sum="hours",var_by="loanac_0416",freq="week")
dt_ratio[, r_var:=r_hours]
dt_ratio[,lnr_var:=log(r_var)]
dt_ratio <- dt_ratio[week>=f_wk("2020-03-01")]
dt_ratio[, weekd:=f_wkdate(week)]
dt_ppp <- copy(dt_ratio)
#---------------------------------------
# Group by PPP in selected industries
# Aggregate to total
dt_ratio <- f_ratio(dt_hbf[ndaywk==7],var_sum="hours",var_by="loanc",freq="week")
dt_ratio[, r_var:=r_hours]
dt_ratio[,lnr_var:=log(r_var)]
dt_ratio <- dt_ratio[week>=f_wk("2020-03-01")]
dt_ratio[, weekd:=f_wkdate(week)]
dt_ppp2 <- copy(dt_ratio)
Aggregate PPP
## Scale for 'colour' is already present. Adding another scale for 'colour',
## which will replace the existing scale.
# Aggregate to total
dt_ratio <- f_ratio(dt_hbf[ndaywk==7],var_sum="hours",var_by="uic",freq="week")
dt_ratio[, r_var:=r_hours]
dt_ratio[,lnr_var:=log(r_var)]
dt_ratio <- dt_ratio[week>=f_wk("2020-03-01")]
dt_ratio[, weekd:=f_wkdate(week)]
dt_ui <- copy(dt_ratio)
#===============================================================================
# Combined
f_comb <- function(dt_ppp,dt_ui,vpppc) {
dti_ppp <- copy(dt_ppp)[,pppc_tmp:=get(vpppc)]
dti_ui <- copy(dt_ui)[!is.na(uic),]
ty <- "Hours Relative to Baseline"
ggout1 <- ggplot(dti_ppp, aes(x=weekd,y=r_var,color=pppc_tmp,shape=pppc_tmp)) + ggtheme +
geom_line(size=1.2) +
geom_point(size=2) +
scale_color_brewer(palette = "Set1", guide=guide_legend(nrow=2,byrow=TRUE)) +
geom_vline(xintercept = as.Date("2020-04-03"),linetype="dashed") +
geom_text(aes(x=as.Date("2020-04-07"), y=0.75, label="Application Started"), size=5, color="black", angle=90) +
geom_vline(xintercept = as.Date("2020-04-16"),linetype="dashed") +
geom_text(aes(x=as.Date("2020-04-20"), y=0.75, label="Round 1 Distributed"), size=5, color="black", angle=90) +
coord_cartesian(ylim=c(0.35,1)) +
labs(x="Week",y=ty, color="PPP Volume",shape="PPP Volume",subtitle = "Panel B: By PPP Disbursements") +
theme(legend.position = "bottom")
ggout2 <- ggplot(dti_ui, aes(x=weekd,y=r_var,color=uic,shape=uic)) + ggtheme +
geom_line(size=1.2) +
geom_point(size=2) +
scale_color_brewer(palette = "Set1", guide=guide_legend(nrow=2,byrow=TRUE)) +
coord_cartesian(ylim=c(0.35,1)) +
labs(x="Week",y=ty, color="Median UI RR",shape="Median UI RR",subtitle = "Panel A: By UI Replacement Rate") +
theme(legend.position = "bottom")
gg_grid <- gridExtra::grid.arrange(ggout2,ggout1,nrow=1)
print(gg_grid)
return(gg_grid)
}
Combined: UI + Subset of PPP
gg_grid <- f_comb(dt_ppp2,dt_ui,"loanc")
## TableGrob (1 x 2) "arrange": 2 grobs
## z cells name grob
## 1 1 (1-1,1-1) arrange gtable[layout]
## 2 2 (1-1,2-2) arrange gtable[layout]
ggsave(plot=gg_grid,paste0(dir_ofig,"P4_hours_uic_pppca_wk.png"),width=12, height=6, dpi=300)
ggsave(plot=gg_grid,paste0(dir_ofig,"P4_hours_uic_pppca_wk.eps"),width=12, height=6, dpi=300)
ggsave(plot=gg_grid,paste0(dir_ofig,"P4_hours_uic_pppca_wk.svg"),width=12, height=6, dpi=300)
fwrite(rbind(dt_ui[,c("week","weekd","uic","r_hours")],dt_ppp2[,c("week","weekd","loanc","r_hours")], fill=T),
paste0(dir_ofigd,"P4_hours_uic_pppca_wk.csv"))
print(paste("Ended at", Sys.time()))
## [1] "Ended at 2020-11-10 18:56:54"