R/get_prices.R

In rengelke/tradr:

#' Download Historical Price Data
#'
#' @param symbol character vector specifying notation symbol or id to be downloaded
#' @param src character string specifying sourcing method
#'
#' @return returns an xts object containing historical price data for specified symbol
#' @export
#'
#' @import xts
#' @importFrom magrittr %<>%
#'
#' @examples get_prices("155884297", src = "onvista")
get_prices <- function(symbol, src = c("onvista", "onvista_bx", "wikifolio")) {

  src %<>% match.arg(c("onvista", "onvista_bx", "wikifolio"), several.ok = FALSE)

  namekey <- c(Datum = "Date", Eröffnung = "Open", Eroeffnung = "Open",
               Hoch = "High", Tief = "Low", Schluss = "Close", Volumen = "Volume",
               `Begin date` = "Date", `Time interval (min)` = "Interval",
               Open = "Open", Close = "Close", High = "High", Low = "Low")

  # # wikifolio ------------------------------------------------------------
  if (src == "wikifolio") {

    yesterday <- paste0(
      strsplit(as.character(Sys.Date() - 1), "-")[[1]][3], ".",
      strsplit(as.character(Sys.Date() - 1), "-")[[1]][2], ".",
      strsplit(as.character(Sys.Date() - 1), "-")[[1]][1]
      )

    url <- paste0(
      "https://www.wikifolio.com/dynamic/de/de/invest/download?type=daily&name=",
      symbol, "&dateFrom=01.01.2010&dateTo=", yesterday
      )

    prices <- NULL
    while (is.null(prices)) {
      try({
        tmp <- tempfile()
        download.file(url, destfile = tmp, method = "libcurl")
        prices <- read.csv2(tmp,
                            fileEncoding = c("UCS-4-INTERNAL"),
                            skip = 5,
                            sep = ";",
                            colClasses = c("my_date_hr", rep("my_num", 5)),
                            allowEscapes = TRUE
        )
        unlink(tmp)
      })
    }

    prices %<>% do.call(rbind, .)
    names(prices) <- namekey[names(prices)]
    prices %<>% dplyr::select(Date, Open, High, Low, Close, Volume)
    prices <- prices[!is.na(prices$Date), ]
    prices <- as.xts(prices[, -1],
                     order.by = prices[, "Date"],
                     dateFormat = "Date")
    prices <- prices[!(weekdays(index(prices)) %in% c("Saturday", "Sunday")), ]
  } # # --------------------------------------------------------------------


  # # onvista --------------------------------------------------------------
  if (src == "onvista") {

    date_range <- c("01.01.2005", "01.01.2010", "01.01.2015", "01.01.2020")
    prices <- lapply(date_range, function (x) {
      url <- paste0("https://www.onvista.de/etf/snapshotHistoryCSV?idNotation=",
                    symbol, "&datetimeTzStartRange=", x,
                    "&timeSpan=5Y&codeResolution=1D")
      prices_range <- NULL
      while (is.null(prices_range)) {
        try({
          tmp <- tempfile()
          download.file(url, destfile = tmp, method = "libcurl")
          prices_range <- read.csv2(tmp,
                                    fileEncoding = c("UTF-8"),
                                    sep = ";",
                                    colClasses = c("my_date", rep("my_num", 5)),
                                    allowEscapes = TRUE
                                     )
          unlink(tmp)
        })
        }
      prices_range
    })

    prices %<>% do.call(rbind, .)
    names(prices) <- namekey[names(prices)]
    prices %<>% dplyr::select(Date, Open, High, Low, Close, Volume)
    prices <- prices[!is.na(prices$Date), ]
    prices <- as.xts(prices[, -1],
                     order.by = prices[, "Date"],
                     dateFormat = "Date")
    prices <- prices[!(weekdays(index(prices)) %in% c("Saturday", "Sunday")), ]
  } # # --------------------------------------------------------------------


  # # onvista_bx ------------------------------------------------------------
  if (src == "onvista_bx") {

    date_range <- c("01.01.2005", "01.01.2010", "01.01.2015", "01.01.2020")
    prices <- lapply(date_range, function (x) {
      url <- paste0("https://www.onvista.de/onvista/boxes/historicalquote/export.csv?notationId=",
                    symbol, "&dateStart=", x, "&interval=Y5")
      prices_range <- NULL
      while (is.null(prices_range)) {
        try({
          tmp <- tempfile()
          download.file(url, destfile = tmp, method = "libcurl")
          prices_range <- read.csv2(tmp,
                                    fileEncoding = c("UTF-8"),
                                    sep = ";",
                                    colClasses = c("my_date", rep("my_num", 5)),
                                    allowEscapes = TRUE
          )
          unlink(tmp)
        })
      }
      prices_range
    })

    prices %<>% do.call(rbind, .)
    names(prices) <- namekey[names(prices)]
    prices %<>% dplyr::select(Date, Open, High, Low, Close, Volume)
    prices <- prices[!is.na(prices$Date), ]
    prices <- as.xts(prices[, -1],
                     order.by = prices[, "Date"],
                     dateFormat = "Date")
    prices <- prices[!(weekdays(index(prices)) %in% c("Saturday", "Sunday")), ]
  } # # --------------------------------------------------------------------

  # fix if data has close price only
  if (all(diff(as.numeric(prices[1,])) == 0)) {
    prices$Open <- lag(prices$Open, k=1, na.pad = TRUE)
    prices <- prices[-1, ]
    prices$High <- apply(cbind.xts(prices$Open, prices$Close), 1, max)
    prices$Low <- apply(cbind.xts(prices$Open, prices$Close), 1, min)
  }

  prices
}