fim: Fiscal Impact Measure

# 0.0 Source ----------------------------------------------------------------------------------------------------------
## Source custom  functions and packages
##NOTE: RUN THIS ONLY IF HAVER DLX IS NOT WORKING/DOES NOT HAVE THE LATEST DATA. IF HAVER IS WORKING, RUN HAVER_PULL.R AS USUAL.
Sys.setenv(TZ = 'UTC')
librarian::shelf(Haver, dplyr, tidyr, readxl, writexl, tsibble, purrr, openxlsx)

haver.path("//ESDATA01/DLX/DATA/")
devtools::load_all()

####new quarter update? (say false if it's revision)
new_quarter<- TRUE

# 0.1 Pull Raw Data---------------------------------------------------------------

START <- "01-01-1970"

# Quarterly -------------------------------------------------------------------------------------------------------

# BEA NIPAs 
names_usna <- read_excel("data/haver_names.xlsx")


#pull in sheets from data/haver_backup.xlsx. see readme sheet in workbook on how to update this 
sheets <- c("usecon", "cpi", "wla", "ctc", "state_ui", "usna")
for(i in sheets) {
  assign(paste0(i, "_currentq"), read_excel("data/haver_backup.xlsx", sheet = i, col_names = TRUE) %>% mutate(date=as.Date(date)))
}


# Economic Statistics
#THESE ARE PULLING IN OLD DATA FROM HAVER DLX. NOTE THAT THE SCRIPT IS WRITTEN ASSUMING ONLY THE CURRENT QUARTER #S ARE NOT UP TO 
#DATE ON HAVER. IF YOU'RE MANUALLY PULLING IN MULTIPLE QUARTERS OF DATA, MAKE SURE TO UPDATE THE SCRIPT AND WORKBOOK ACCORDINGLY.
usecon <- 
  pull_data(c("PCW", "GDPPOTHQ", "GDPPOTQ", "RECESSQ",
              'LASGOVA', 'LALGOVA', 'CPGS'), 
            "usecon",
            start.date = START)

cpi <- 
  pull_data(c('UI'), 'cpidata', start.date = START) %>%
  monthly_to_quarterly()


# Wages Lost Assistance Program (Monthly)
wla <- pull_data('YPTOLM',
                 'usna',
                 frequency = 'monthly',
                 start.date = START) %>%
  monthly_to_quarterly() %>%
  mutate(yptolm = na_if(yptolm, 'NaN'))
# Child Tax Credit (Monthly)

# Since Haver only pulls monthly values, you should manually input the quarterly 
# value if monthly personal income hasn't come out yet. You can find it on the 
# Effects of Selected Federal Pandemic Response Programs on Federal Government Receipts,
# Expenditures, and Saving. For example, after the release of Q1 2022 advanced estimate I ran the code chunk below to pull the monthly data, and then manually inputed the quarterly value with:
# 
# mutate_where(.data = ctc, .where = date == yearquarter('2022 Q1'), yptocm = 105.6)

ctc <- pull_data('YPTOCM',
                 'usna',
                 frequency = 'monthly',
                 start.date = START) %>%
  monthly_to_quarterly() %>% 
  mutate(yptocm = na_if(yptocm, 'NaN'))

usna <-
  pull_data(names_usna$code,
            "usna",
            start.date = START) %>%
  as_tibble()


monthly_state_ui <- c('LICL', 'LWCL', 'LUFP','LULP','LUWC','LUWP','LUBP','LUWB','LUEX','LUD','LUWBY', 'LUBPT', 'LUFPT', 'LULPT', 'LASGOVA', 'LALGOVA', 'CPGS')

state_ui <- pull_data(monthly_state_ui,
                      'usecon',
                      start.date = START) %>%
  as_tibble()

##After pulling in the DLX data, we're going to either impute the current quarters data (if it's a revision) or append the current quarter's data (if it's a new quarter)
#make sure that new_quarter at the top of this script is set to TRUE or FALSE accordingly


# check if usecon has observations for date = 12-31-2022
usecon_end_of_year <- usecon %>% 
  filter(date == as.Date("2022-12-31"))

# if usecon has observations for date = 12-31-2022, update pcw, gdp, and pce
if(nrow(usecon_end_of_year) > 0) {
  usecon <- usecon %>%
    left_join(usecon_currentq %>% filter(date == as.Date("2022-12-31")), by = c("date")) %>%
    select(-pcw_currentq, -gdp_currentq, -pce_currentq) %>%
    rename(pcw = pcw_currentq, gdp = gdp_currentq, pce = pce_currentq)
}

# if usecon does not have observations for date = 12-31-2022, append usecon_currentq
if(nrow(usecon_end_of_year) == 0) {
  usecon <- rbind(usecon, usecon_currentq %>% filter(date == as.Date("2022-12-31")))
}


usecon_imputed<-usecon

# #IMPUTING THE CURRENT QUARTER #S FROM HAVER_PULL_BACKUP
# usecon_imputed<-usecon%>% mutate_where(date == "2022-12-31",
#                                    pcw=usecon_currentq$pcw,
#                                    gdppothq=usecon_currentq$gdppothq,
#                                    gdppotq=usecon_currentq$gdppotq,
#                                    recessq=usecon_currentq$recessq,
#                                    lasgova=usecon_currentq$lasgova,
#                                    lalgova=usecon_currentq$lalgova,
#                                    cpgs=usecon_currentq$cpgs)

cpi_imputed<-cpi
# cpi_imputed<-cpi%>% mutate_where(date == "2022-12-31", ui=cpi_currentq$ui)

wla_imputed<-bind_rows(wla, wla_currentq)
                                                                
#wla_imputed<-wla%>% mutate_where(date == "2022-12-31",yptolm=wla_currentq$yptolm)
ctc_imputed<-bind_rows(ctc, ctc_currentq)

#ctc_imputed<-ctc%>% mutate_where(date == "2022-12-31",yptocm=ctc_currentq$yptocm)

state_ui_imputed<-state_ui%>% mutate_where(date == "2022-12-31",licl=state_ui_currentq$licl,
                                       lwcl=state_ui_currentq$lwcl,
                                       lufp=state_ui_currentq$lufp,
                                       lulp=state_ui_currentq$lulp,
                                       luwc=state_ui_currentq$luwc,
                                       luwp=state_ui_currentq$luwp,
                                       lubp=state_ui_currentq$lubp,
                                       luwb=state_ui_currentq$luwb,
                                       luex=state_ui_currentq$luex,
                                       lud=state_ui_currentq$lud,
                                       luwby=state_ui_currentq$luwby,
                                       lubpt=state_ui_currentq$lubpt,
                                       lufpt=state_ui_currentq$lufpt,
                                       lulpt=state_ui_currentq$lulpt,
                                       lasgova=state_ui_currentq$lasgova,
                                       lalgova=state_ui_currentq$lalgova,
                                       cpgs=state_ui_currentq$cpgs)
  write_xlsx(state_ui_imputed, 'data/monthly_state_ui.xlsx')
  
usna_imputed<-bind_rows(usna, usna_currentq)%>%
  left_join(cpi_imputed) %>%
  left_join(usecon_imputed) %>% 
  # left_join(child_tax_credit) %>% 
  # Convert SNAP from millions to billions
  mutate(gftffx = gftffx / 1e3) %>% 
  left_join(ctc_imputed, by = 'date')
                                       
# usna_imputed<-usna%>% mutate_where(date == "2022-12-31",gdp=usna_currentq$gdp,
#                                gdph=usna_currentq$gdph,
#                                jgdp=usna_currentq$jgdp,
#                                c=usna_currentq$c,
#                                ch=usna_currentq$ch,
#                                jc=usna_currentq$jc,
#                                jgf=usna_currentq$jgf,
#                                jgs=usna_currentq$jgs,
#                                jgse=usna_currentq$jgse,
#                                jgsi=usna_currentq$jgsi,
#                                yptmr=usna_currentq$yptmr,
#                                yptmd=usna_currentq$yptmd,
#                                yptu=usna_currentq$yptu,
#                                gtfp=usna_currentq$gtfp,
#                                ypog=usna_currentq$ypog,
#                                yptx=usna_currentq$yptx,
#                                ytpi=usna_currentq$ytpi,
#                                yctlg=usna_currentq$yctlg,
#                                g=usna_currentq$g,
#                                grcsi=usna_currentq$grcsi,
#                                dc=usna_currentq$dc,
#                                gf=usna_currentq$gf,
#                                gs=usna_currentq$gs,
#                                gfh=usna_currentq$gfh,
#                                gsh=usna_currentq$gsh,
#                                gfrpt=usna_currentq$gfrpt,
#                                gfrpri=usna_currentq$gfrpri,
#                                gfrcp=usna_currentq$gfrcp,
#                                gfrs=usna_currentq$gfrs,
#                                gftfp=usna_currentq$gftfp,
#                                gfeg=usna_currentq$gfeg,
#                                gsrpt=usna_currentq$gsrpt,
#                                gsrpri=usna_currentq$gsrpri,
#                                gsrcp=usna_currentq$gsrcp,
#                                gsrs=usna_currentq$gsrs,
#                                gstfp=usna_currentq$gstfp,
#                                gset=usna_currentq$gset,
#                                gfeghhx=usna_currentq$gfeghhx,
#                                gfeghdx=usna_currentq$gfeghdx,
#                                gfeigx=usna_currentq$gfeigx,
#                                gfsub=usna_currentq$gfsub,
#                                gssub=usna_currentq$gssub,
#                                gsub=usna_currentq$gsub,
#                                gftfpe=usna_currentq$gftfpe,
#                                gftfpr=usna_currentq$gftfpr,
#                                gftfpp=usna_currentq$gftfpp,
#                                gftfpv=usna_currentq$gftfpv,
#                                gfsubp=usna_currentq$gfsubp,
#                                gfsubg=usna_currentq$gfsubg,
#                                gfsube=usna_currentq$gfsube,
#                                gfsubs=usna_currentq$gfsubs,
#                                gfsubf=usna_currentq$gfsubf,
#                                gfsubv=usna_currentq$gfsubv,
#                                gfsubk=usna_currentq$gfsubk,
#                                gfegc=usna_currentq$gfegc,
#                                gfege=usna_currentq$gfege,
#                                gfegv=usna_currentq$gfegv,
#                                yptue=usna_currentq$yptue,
#                                yptup=usna_currentq$yptup,
#                                yptuc=usna_currentq$yptuc,
#                                gftfpu=usna_currentq$gftfpu,
#                                yptub=usna_currentq$yptub,
#                                yptol=usna_currentq$yptol,
#                                gfctp=usna_currentq$gfctp,
#                                gftffx=usna_currentq$gftffx,
#                                ylwsd=usna_currentq$ylwsd,
#                                yop=usna_currentq$yop,
#                                yri=usna_currentq$yri,
#                                ypiar=usna_currentq$ypiar,
#                                ycpd=usna_currentq$ycpd,
#                                gfsubr=usna_currentq$gfsubr,
#                                gfsubd=usna_currentq$gfsubd,
#                                gftfbdx=usna_currentq$gftfbdx) %>%
  # left_join(cpi_imputed) %>%
  # left_join(usecon_imputed) %>% 
  # # left_join(child_tax_credit) %>% 
  # # Convert SNAP from millions to billions
  # mutate(gftffx = gftffx / 1e3) %>% 
  # left_join(ctc_imputed, by = 'date')

national_accounts <- 
  usna_imputed %>% 
  mutate(id = 'historical') %>%
  millions_to_billions() %>%
  rename(cpiu = ui,
  ) %>% 
  # Get deflator growth
  mutate(across(starts_with('j'), ~ q_g(.x), .names = '{.col}_growth')) %>% 
  format_tsibble() %>% 
  #When adding new codes to read in from Haver, make sure to relocate them at the end of the spreadsheet using the below function:
  relocate(ylwsd:gftfbdx, .after = 'jgsi_growth') %>% 
  relocate(yptocm, .after = everything())

usethis::use_data(national_accounts, overwrite = TRUE)
devtools::load_all()

# Write Haver pivoted to corresponding sheet in the forecast workbook

haver_pivoted <-
  fim::national_accounts %>% 
  select(-id) %>% 
  pivot_longer(-date) %>% 
  as_tibble() %>% 
  pivot_wider(names_from = date,
              values_from = value) 


boldHeader <- createStyle(textDecoration = 'bold') # Makes first row bold
wb <- loadWorkbook('data/forecast.xlsx')
if (!('Haver Pivoted' %in% names(wb))) addWorksheet(wb, 'Haver Pivoted')
writeData(wb, 'Haver Pivoted', haver_pivoted, headerStyle = boldHeader)
setColWidths(wb, 'Haver Pivoted', cols = 1:ncol(haver_pivoted), widths = 'auto')
saveWorkbook(wb, 'data/forecast.xlsx', overwrite = T)
# Check values and then:
# gert::git_commit_all('Haver update')
# gert::git_push()