R/make_dates.R

In causality-loop/mnmt: Mot Nam, Mot Thang

#' @importFrom data.table ':='
.datatable.aware = TRUE

if (getRversion() >= '2.15.1')
  utils::globalVariables(c('.', 'DoW', 'Date'), utils::packageName())

make_dates <- function()
{
  year <- lubridate::year(Sys.Date())

  web_dates <-
    xml2::read_html('https://www.nyse.com/markets/hours-calendars') %>%
    rvest::html_nodes('table') %>%
    .[[1]] %>%
    rvest::html_table()

  early_close_dates <- data.table::data.table(web_dates) %>%
    .[, get(as.character(year))] %>%
    # remove non-ASCII chars
    iconv('latin1', 'ASCII', sub = '') %>%
    # keep dates with wildcards
    grep(pattern = '\\*', value = TRUE) %>%
    # remove anything in ()
    gsub(pattern = '\\s*\\([^\\)]+\\)', replacement = '') %>%
    # remove wildcards, but keep dates
    gsub(pattern='\\*', replacement='') %>%
    # remove blanks
    .[. != ''] %>%
    sapply(function(x) {
      paste0(x, ', ', year) %>%
        lubridate::mdy() %>%
        as.character()
    }) %>%
    as.Date() %>%
    unname()

  holidays <- data.table::data.table(web_dates) %>%
    .[, get(as.character(year))] %>%
    # remove non-ASCII chars
    iconv('latin1', 'ASCII', sub = '') %>%
    # remove blanks (caused by above fun)
    .[. != ''] %>%
    # remove chars with wildcards
    grep(pattern = '\\*', value = TRUE, invert = TRUE) %>%
    # remove anything in ()
    gsub(pattern = '\\s*\\([^\\)]+\\)', replacement = '') %>%
    sapply(function(x) {
      paste0(x, ', ', year) %>%
        lubridate::mdy() %>%
        as.character()
    })

  market_open_dates <- data.table::data.table(
    seq.Date(as.Date(paste0(year, '-01-01')),
             as.Date(paste0(year, '-12-31')),
             1)) %>%
    `names<-`('Date') %>%
    .[, DoW := lubridate::wday(Date,
                               label = FALSE,
                               week_start = 1)] %>%
    .[!(DoW %in% c(6,7))] %>%
    .[!(Date %in% as.Date(holidays))] %>%
    .[, Date]

  eom_dates <- xts::endpoints(market_open_dates) %>%
    {market_open_dates[.]}

  som_dates <- xts::endpoints(market_open_dates) %>%
    {.[-length(.)]} %>%
    {.+1} %>%
    {market_open_dates[.]}

  eow_dates <- xts::endpoints(market_open_dates, 'week') %>%
    {market_open_dates[.]}

  dates <- list(EOM = eom_dates, 
                SOM = som_dates, 
                EOW = eow_dates, 
                market_open_dates = market_open_dates,
                early_close_dates = early_close_dates)

  saveRDS(dates, file = paste0('data/dates.rds'))
}