R/get_symbols.R

In rengelke/tradr:

#' Download OHLC Data from Yahoo Finance
#'
#' @param symbol a character vector specifying the name of the symbol to be loaded
#' @param ... additional parameters
#' @return returns a xts object containing historical price data
#' @export
#'
#' @examples get_symbols2("^GDAXI")
#'
get_symbols2 <- function(symbol, ...) {
  data <- NULL
  while (is.null(data)) {
    try(
      suppressWarnings(
        data <- quantmod::getSymbols(symbol,
          src = "yahoo",
          auto.assign = FALSE,
          warnings = FALSE
        )
      ),
      silent = FALSE
    )
  }

  #data <- quantmod::na.approx(data, na.rm = TRUE)
  #data <- quantmod::OHLC(data)
}

#' Download or Read Price Data
#'
#' @param symbol_table table containing columns with stock ticker ("Symbol") and ISIN ("ISIN")
#' @param column which ticker symbols column to use for download; "Symbol" mainstock exchange, "Symbol_FRA" Frankfurt stock exchange, "Symbol_XETRA"
#' @param update logical, TRUE if prices should be downloaded, FALSE if prices should be loaded from local archive
#' @param folder archive folder directory
#'
#' @return returns a list of xts objects containing price data
#' @export
#' @import magrittr
#' @import xts
#'
#' @examples stock_table %>% get_symbols_csv(update = FALSE)
#'
get_symbols_csv <- function (symbol_table, column = "Symbol", update = FALSE,
          folder = "/Users/admin/Documents/RSudio.wd/#projects/@price_data") {

  assertive.types::assert_is_a_bool(update)
  assertive.types::assert_is_character(column)
  if (!assertthat::has_name(symbol_table, column))
    stop(paste0("Can't find `", column, "` column in stock data."))

  symbol_table %>% apply(., 1, function (x) {

    incoming <- paste0(folder, "/incoming")
    archive <- paste0(folder, "/archive")

    isin <- x["ISIN"]
    ticker <- x[column] %>% as.character()

    if (is.na(ticker)) {
      price_data <- NULL
    } else {

      price_file <- list.files(archive, full.names = TRUE) %>%
        .[grepl(paste0(isin, "_"), .)] %>%
        .[grepl(paste0("_", ticker, ".csv"), .)]
      if (length(price_file) == 0) {
        price_exists <- FALSE
      } else {
        price_exists <- TRUE
      }

      if (update) {
        price_data <- tryCatch(
          {
            suppressWarnings(
              price_data <- quantmod::getSymbols(ticker,
                                                 src = "yahoo",
                                                 auto.assign = FALSE,
                                                 warnings = FALSE
              )
            )
            price_data %>%
              zoo::write.zoo(paste0(incoming, "/", isin, "_", ticker, ".csv"))
            price_data
          },
          error = function (e) {
            message(paste("Ticker ", ticker, " does not seem to exist"))
            message("Original error message: ")
            message(e)
            if(price_exists) {
              price_data <<- zoo::read.zoo(paste0(archive, "/", isin, "_", ticker, ".csv"),
                                           index.column = 1, format = "%Y-%m-%d",
                                           header = TRUE) %>%
                xts::xts(dateFormat = "Date")
              price_data %>%
                zoo::write.zoo(paste0(incoming, "/", isin, "_", ticker, ".csv"))
            } else {
              price_data <- matrix(rep(100, 6), nrow = 1) %>%
                as.xts(., order.by = date_seq[which(date_seq == save_date)-1],
                       dateFormat = "Date") %>%
                `colnames<-`(paste(
                  ticker,
                  c("Open", "High", "Low", "Close", "Volume", "Adjusted"),
                  sep = "."))
              price_data %>%
                zoo::write.zoo(paste0(incoming, "/", isin, "_", ticker, ".csv"))
            }
            return(price_data)
          }
        )

        if (price_exists) {
          #verify old vs new
          price_archived <- zoo::read.zoo(paste0(archive, "/", isin, "_", ticker, ".csv"),
                                          index.column = 1, format = "%Y-%m-%d",
                                          header = TRUE) %>%
            xts::xts(dateFormat = "Date")

          pa <- price_archived %>% quantmod::Cl() %>% zoo::na.locf() %>% as.numeric()
          pd <- price_data[zoo::index(price_archived), ] %>% quantmod::Cl() %>% zoo::na.locf() %>% as.numeric()
          price_equal <- (pa == pd | (pa/pd < 1.02 & pa/pd > 0.98)) %>%
            zoo::na.trim(sides = "left")
          if (price_equal %>% all() %>% isTRUE() %>% `!`) {
            price_diff <- length(price_equal[price_equal == TRUE])/length(price_equal)
            if (price_diff > 0.98) price_equal <- TRUE
          } else {
            price_equal <- price_equal %>% all() %>% isTRUE()
          }

          #if equal then also save to archive / delete from incoming
          if (price_equal) {
            price_data %>% zoo::write.zoo(paste0(archive, "/", isin, "_", ticker, ".csv"))
            file.remove(paste0(incoming, "/", isin, "_", ticker, ".csv"))
          }
          if (!price_equal) {
            warning("Downloaded price data `", isin, "_", ticker, "` differs from archived data!")
          }
        }

        if (!price_exists) {
          if (nrow(price_data) == 1) {
            price_data %>% zoo::write.zoo(paste0(incoming, "/", isin, "_", ticker, ".csv"))
          } else {
            price_data %>% zoo::write.zoo(paste0(archive, "/", isin, "_", ticker, ".csv"))
            file.remove(paste0(incoming, "/", isin, "_", ticker, ".csv"))
          }

        }

      } #update

      if (!update) {
        if (!price_exists) {
          suppressWarnings(
            price_data <- quantmod::getSymbols(ticker,
                                               src = "yahoo",
                                               auto.assign = FALSE,
                                               warnings = FALSE
            )
          )
          price_data %>% zoo::write.zoo(paste0(archive, "/", isin, "_", ticker, ".csv"))
        }
        if (price_exists) {
          price_data <- zoo::read.zoo(paste0(archive, "/", isin, "_", ticker, ".csv"),
                                      index.column = 1, format = "%Y-%m-%d", header = TRUE) %>%
            xts::xts(dateFormat = "Date")
        }
      }
    }
    price_data

  }) %>%
    `names<-`(symbol_table[, column] %>% unlist() %>% as.character()) %>%
    .[purrr::map_lgl(., ~ !is.null(.x))]

}