print(paste("Started at", Sys.time()))
## [1] "Started at 2020-07-24 09:19:53"
source(paste0(dir_func,"f_readhb.R"))
source(paste0(dir_func,"f_wk.R"))
source(paste0(dir_func,"f_ratio.R"))
max_date <- as.Date("2020-07-11")
dt_hbf <- readRDS(paste0(dir_clean, "homebase_firm_ind_geo_date_2020.rds"))
# List state that we exclude:
print(paste0("States with less than 50 firms: ", paste(unique(dt_hbf[st_sel_2wk==0,st]), collapse = " ")))
## [1] "States with less than 50 firms: VI AS"
dt_hbf <- dt_hbf[firm_base_2wk==1 & st_sel_2wk==1,]
dt_hbf[,week:=f_wk(date)]
# 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,]
# Aggregate to total
dt_hbf[,agg:=1]
dt_ratio <- f_ratio(dt_hbf,var_sum="hours",var_by="agg")
dt_ratio[, r_var:=r_hours]
dt_ratio[,lnr_var:=log(r_var)]
# dt_ratio <- dt_ratio[week>=f_wk("2020-03-01")]
# Find the largest single day drop in March
setorder(dt_ratio,date)
dt_ratio[, l1_r_var:=c(NA,r_var[-.N])]
dt_ratio[, dl1_r_var:=r_var-l1_r_var]
dt_ratioo <- dt_ratio[date>=as.Date("2020-03-01")]
print(dt_ratioo[dl1_r_var==max(dl1_r_var, na.rm=T)])
## agg wkd date week hours hoursb r_hours r_var lnr_var
## 1: 1 2 2020-05-26 22 1033546 1538769 0.6716704 0.6716704 -0.3979876
## l1_r_var dl1_r_var
## 1: 0.4217385 0.2499318
rm(dt_ratioo)
#===============================================================================
# Adding other data sets
print(sys_user)
## [1] "homebase"
#---------------------------------------
# Kronos
dt_kr <- readRDS(paste0(dir_clean,"misc/kronos_overall.rds"))
#---------------------------------------
# CES
dt_ces <- data.table(readxl::read_excel(paste0(dir_raw,"misc/SeriesReport-20200708035331_30a874.xlsx"),
sheet = "BLS Data Series", range = "A13:G27"))
setnames(dt_ces, names(dt_ces), c("year",paste0("m",c(1:6))))
dt_ces <- melt(dt_ces, id.vars = "year", variable.name = "month", variable.factor = F, value.name = "iemp_ces")
dt_ces <- dt_ces[year==2020]
dt_ces[,month:=as.integer(sub("m(\\d)","\\1",month))]
dt_ces[, date:=as.Date(paste(year,month,"15",sep="-"))]
dt_ces[, remp_ces:=iemp_ces/dt_ces[year==2020 & month==1, iemp_ces]]
#---------------------------------------
# CPS
dt_cps <- data.table(readxl::read_excel(paste0(dir_raw,"misc/total_employment.xlsx"),
sheet = "Sheet1", range = "A3:B9"))
setnames(dt_cps, names(dt_cps), c("ym","iemp_cps"))
dt_cps[, date:=as.Date(paste(ym,"15",sep="-"))]
dt_cps[, iemp_cps:=as.numeric(iemp_cps)]
dt_cps[, remp_cps:=iemp_cps/dt_cps[ym=="2020-01", iemp_cps]]
#---------------------------------------
ty <- "Relative to Baseline"
rm(ldt)
## Warning in rm(ldt): object 'ldt' not found
ldt <- as.factor(c(1:4))
levels(ldt) <- c("Small Firms (Homebase)","Large Firms (Kronos)","Payroll Employment (CES)","Employees (CPS)")
dt_ratioa <- copy(dt_ratio)[,c("data","r_var"):=list(ldt[1],r_hours)]
dt_kr2 <- copy(dt_kr)[,date:=date-3]
dt_kr2[,c("data","r_var"):=list(ldt[2],remp_g100)]
dt_cesa <- copy(dt_ces)[,c("data","r_var"):=list(ldt[3],remp_ces)]
dt_cpsa <- copy(dt_cps)[,c("data","r_var"):=list(ldt[4],remp_cps)]
dt_out <- rbind(dt_ratioa[,.SD,.SDcols=c("data","date","r_var")],
dt_kr2[,.SD,.SDcols=c("data","date","r_var")],
dt_cesa[,.SD,.SDcols=c("data","date","r_var")],
dt_cpsa[,.SD,.SDcols=c("data","date","r_var")])
dt_out <- dt_out[date>=as.Date("2020-01-19") & date<=max_date]
gg_out <- ggplot(dt_out, aes(x=date, y=r_var, color=data, linetype=data, shape=data)) + ggtheme +
geom_rect(data=NULL,aes(xmin=as.Date("2020-04-11"), xmax=as.Date("2020-04-13"), ymin=-Inf, ymax=Inf), alpha=0.5, color=NA, fill="grey90") +
geom_rect(data=NULL,aes(xmin=as.Date("2020-05-23"), xmax=as.Date("2020-05-26"), ymin=-Inf, ymax=Inf), alpha=0.5, color=NA, fill="grey90") +
geom_rect(data=NULL,aes(xmin=as.Date("2020-07-03"), xmax=as.Date("2020-07-06"), ymin=-Inf, ymax=Inf), alpha=0.5, color=NA, fill="grey90") +
geom_line(size=1.2) +
geom_point(aes(size=data),stroke=2) +
scale_size_manual(values = c(0,2,5,5), guide=guide_legend(nrow=2, byrow=T)) +
scale_shape_manual(values = c(NA,16,3,4), guide=guide_legend(nrow=2, byrow=T)) +
scale_linetype_manual(values = c("solid","solid","blank","blank"), guide=guide_legend(nrow=2, byrow=T)) +
scale_color_brewer(palette = "Set1", guide=guide_legend(nrow=2, byrow=T)) +
labs(x="Date",y=ty, color="",linetype="",shape="",size="",stroke="") +
theme(panel.grid.major.x = element_blank()) +
guides(color=guide_legend(override.aes=list(fill=NA)))
print(gg_out)
## Warning: Removed 175 rows containing missing values (geom_point).
ggsave(plot=gg_out,paste0(dir_ofig,"P1_hours_reduction_add.png"),width=9, height=6, dpi=300)
## Warning: Removed 175 rows containing missing values (geom_point).
fwrite(dt_out,paste0(dir_ofigd,"P1_hours_reduction_add.csv"))
print(paste("Ended at", Sys.time()))
## [1] "Ended at 2020-07-24 09:20:22"
# End of R script