From 3b09488058c0bb8a4d1398457cc76f0b6af8375a Mon Sep 17 00:00:00 2001 From: kapsner Date: Mon, 17 Apr 2023 17:34:36 +0200 Subject: [PATCH] feat: add querying of intraday data for yahoo api addresses https://github.com/joshuaulrich/quantmod/issues/351 --- R/getSymbols.R | 150 ++++++++++++++++++++++++++++--------------------- 1 file changed, 87 insertions(+), 63 deletions(-) diff --git a/R/getSymbols.R b/R/getSymbols.R index 102aafd9..21d06ab5 100644 --- a/R/getSymbols.R +++ b/R/getSymbols.R @@ -87,7 +87,7 @@ function(Symbols=NULL, .has1sym.=.has1sym.)) if(!auto.assign) return(symbols.returned) - for(each.symbol in symbols.returned) all.symbols[[each.symbol]] <- symbol.source + for(each.symbol in symbols.returned) all.symbols[[each.symbol]] <- symbol.source } req.symbols <- names(all.symbols) all.symbols <- c(all.symbols,old.Symbols)[unique(names(c(all.symbols,old.Symbols)))] @@ -253,7 +253,7 @@ function(Symbols,env,return.class='xts',index.class="Date", default.from <- from default.to <- to - intervals <- c(daily = "1d", weekly = "1wk", monthly = "1mo") + intervals <- c(daily = "1d", weekly = "1wk", monthly = "1mo", intraday = "1m") default.periodicity <- match.arg(periodicity, names(intervals)) if(!hasArg("verbose")) verbose <- FALSE @@ -282,6 +282,18 @@ function(Symbols,env,return.class='xts',index.class="Date", to <- getSymbolLookup()[[Symbols[[i]]]]$to to <- if(is.null(to)) default.to else to + + if (periodicity == "intraday" && + difftime( + time1 = to, time2 = from, units = "days" + ) > 7) { + from <- to - 7 + warning(paste0( + "Only a maximum of 7 days is allowed for querying 1m granularity ", + "data from 'yahoo'. Setting `from` to '", from, "'." + )) + } + from.posix <- .dateToUNIX(from) to.posix <- .dateToUNIX(to) @@ -298,11 +310,24 @@ function(Symbols,env,return.class='xts',index.class="Date", y <- y$chart$result ohlcv <- unlist(y$indicators$quote[[1]], recursive = FALSE) - idx <- as.Date(.POSIXct(y$timestamp[[1]])) + if (periodicity == "intraday") { + tz <- y$meta$timezone + idx <- as.POSIXct(y$timestamp[[1]], tz=tz, origin="1970-01-01") + } else { + idx <- as.Date(.POSIXct(y$timestamp[[1]])) + } x <- xts(do.call(cbind, ohlcv), idx, src='yahoo', updated=Sys.time()) - fr <- merge(OHLCV(x), adjusted = unlist(y$indicators$adjclose)) + if (periodicity != "intraday") { + fr <- merge(OHLCV(x), adjusted = unlist(y$indicators$adjclose)) + cnames <- c("Open", "High", "Low", "Close", "Volume", "Adjusted") + } else { + fr <- OHLCV(x) + cnames <- c("Open", "High", "Low", "Close", "Volume") + } + + # convert column names to Initial Capitalization cn <- colnames(fr) @@ -318,7 +343,6 @@ function(Symbols,env,return.class='xts',index.class="Date", } # re-order column names and prefix with symbol - cnames <- c("Open", "High", "Low", "Close", "Volume", "Adjusted") corder <- pmatch(substr(cnames, 1, 3), colnames(fr)) fr <- fr[,corder] colnames(fr) <- paste(toupper(gsub("\\^","",Symbols.name)), cnames, sep=".") @@ -332,7 +356,7 @@ function(Symbols,env,return.class='xts',index.class="Date", if(is.xts(fr)) tclass(fr) <- index.class - Symbols[[i]] <-toupper(gsub('\\^','',Symbols[[i]])) + Symbols[[i]] <-toupper(gsub('\\^','',Symbols[[i]])) returnSym[[i]] <- gsub('\\^', '', returnSym[[i]]) if(auto.assign) @@ -369,11 +393,11 @@ function(Symbols,env,return.class='xts',index.class="Date", } if(!hasArg("adjust")) adjust <- FALSE - + default.return.class <- return.class default.from <- from default.to <- to - + if(!hasArg("verbose")) verbose <- FALSE if(!hasArg("auto.assign")) auto.assign <- TRUE @@ -390,11 +414,11 @@ function(Symbols,env,return.class='xts',index.class="Date", # variable name. It needs to start with YJ, and it will be appended # if it does not. symname <- toupper(Symbols[[i]]) - + # The symbol actually sent to Yahoo Japan. This is without the # starting YJ bit. symbol <- symname - + # If it starts with YJ, try looking up defaults if (grepl("^YJ", symname)) { return.class <- getSymbolLookup()[[symname]]$return.class @@ -404,25 +428,25 @@ function(Symbols,env,return.class='xts',index.class="Date", from <- if(is.null(from)) default.from else from to <- getSymbolLookup()[[symname]]$to to <- if(is.null(to)) default.to else to - + # Extract the actual symbol to be sent to Yahoo Japan symbol <- substring(symname, 3) } else { return.class <- default.return.class from <- default.from to <- default.to - + # Prepend 'YJ' to the symbol and store it in symname symname <- paste('YJ', symbol, sep="") } from.str <- format(as.Date(from), "%Y%m%d") to.str <- format(as.Date(to), "%Y%m%d") - + Symbols.name <- getSymbolLookup()[[symname]]$name Symbols.name <- ifelse(is.null(Symbols.name),symbol,Symbols.name) if(verbose) cat("downloading ",Symbols.name,".....\n\n") - + page <- 1 totalrows <- c() while (TRUE) { @@ -434,21 +458,21 @@ function(Symbols,env,return.class='xts',index.class="Date", rows <- xml2::xml_find_all(fdoc, "//table/tbody/tr") rows <- lapply(rows, function(r) { xml2::xml_text(xml2::xml_children(r)) }) rows <- rows[sapply(rows, length) >= 5] - + if (length(rows) == 0) break totalrows <- c(totalrows, rows) page <- page + 1 } if(verbose) cat("done.\n") - + if (is.null(rows)) { stop("No historical data for ", dQuote(Symbols[[i]]), ".") } # Available columns cols <- c('Open','High','Low','Close','Volume','Adjusted') - + # Handle date + OHLC, when date + OHLCVA isn't returned if (length(totalrows[[1]]) == 5) { cols <- cols[-(5:6)] @@ -465,11 +489,11 @@ function(Symbols,env,return.class='xts',index.class="Date", fr <- xts(ohlc, dates, src="yahooj", updated=Sys.time()) colnames(fr) <- paste(symname, cols, sep='.') - + fr <- convert.time.series(fr=fr,return.class=return.class) if(is.xts(fr)) tclass(fr) <- index.class - + Symbols[[i]] <- symname if(auto.assign) assign(Symbols[[i]],fr,env) @@ -477,7 +501,7 @@ function(Symbols,env,return.class='xts',index.class="Date", message("pausing 1 second between requests for more than 5 symbols") Sys.sleep(1) } - + }, silent = TRUE) if (inherits(test, "try-error")) { msg <- paste0("Unable to import ", dQuote(returnSym[[i]]), @@ -696,7 +720,7 @@ function(Symbols,env,return.class='xts', fr <- fr[paste(from, to, sep = "/")] fr <- convert.time.series(fr=fr,return.class=return.class) - Symbols[[i]] <-toupper(gsub('\\^','',Symbols[[i]])) + Symbols[[i]] <-toupper(gsub('\\^','',Symbols[[i]])) if(auto.assign) assign(Symbols[[i]],fr,env) }, silent = TRUE) @@ -743,7 +767,7 @@ function(Currencies,from=Sys.Date()-179,to=Sys.Date(), auto.assign=auto.assign,...) #} else { # getSymbols.FRED(Symbols=Currencies,env=env,verbose=verbose,warning=warning,...) - #} + #} } #}}} @@ -765,7 +789,7 @@ function(Metals,from=Sys.Date()-179,to=Sys.Date(), paste(strsplit(x,'-')[[1]][1],base.currency,sep="/") })) getSymbols.oanda(Symbols=metals,from=from,to=to,auto.assign=auto.assign, - env=env,verbose=verbose,warning=warning,...) + env=env,verbose=verbose,warning=warning,...) } #}}} @@ -811,7 +835,7 @@ function(Symbols,env, extension <- getSymbolLookup()[[Symbols[[i]]]]$extension extension <- ifelse(is.null(extension),default.extension, extension) - + if(verbose) cat("loading ",Symbols[[i]],".....") if(dir=="") { sym.file <- paste(Symbols[[i]],extension,sep=".") @@ -824,7 +848,7 @@ function(Symbols,env, next } fr <- read.csv(sym.file) - if(verbose) + if(verbose) cat("done.\n") # ensure date column is character before calling as.Date @@ -839,7 +863,7 @@ function(Symbols,env, fr <- xts(fr[,-1],do.call("as.Date", asDateArgs),src='csv',updated=Sys.time()) colnames(fr) <- paste(toupper(gsub('\\^','',Symbols[[i]])),col.names,sep='.') fr <- convert.time.series(fr=fr,return.class=return.class) - Symbols[[i]] <-toupper(gsub('\\^','',Symbols[[i]])) + Symbols[[i]] <-toupper(gsub('\\^','',Symbols[[i]])) if(auto.assign) assign(Symbols[[i]],fr,env) }, silent = TRUE) @@ -907,12 +931,12 @@ function(Symbols,env, } #fr <- read.csv(sym.file) fr <- readRDS(sym.file) - if(verbose) + if(verbose) cat("done.\n") if(!is.xts(fr)) fr <- xts(fr[,-1],as.Date(fr[,1],origin='1970-01-01'),src='rda',updated=Sys.time()) colnames(fr) <- paste(toupper(gsub('\\^','',Symbols[[i]])),col.names,sep='.') fr <- convert.time.series(fr=fr,return.class=return.class) - Symbols[[i]] <-toupper(gsub('\\^','',Symbols[[i]])) + Symbols[[i]] <-toupper(gsub('\\^','',Symbols[[i]])) if(auto.assign) assign(Symbols[[i]],fr,env) }, silent = TRUE) @@ -981,12 +1005,12 @@ function(Symbols,env, #fr <- read.csv(sym.file) local.name <- load(sym.file) assign('fr',get(local.name)) - if(verbose) + if(verbose) cat("done.\n") if(!is.xts(fr)) fr <- xts(fr[,-1],as.Date(fr[,1],origin='1970-01-01'),src='rda',updated=Sys.time()) colnames(fr) <- paste(toupper(gsub('\\^','',Symbols[[i]])),col.names,sep='.') fr <- convert.time.series(fr=fr,return.class=return.class) - Symbols[[i]] <-toupper(gsub('\\^','',Symbols[[i]])) + Symbols[[i]] <-toupper(gsub('\\^','',Symbols[[i]])) if(auto.assign) assign(Symbols[[i]],fr,env) }, silent = TRUE) @@ -1027,9 +1051,9 @@ useRTH = '1', whatToShow = 'TRADES', time.format = '1', ...) if(is.method.available("twsConnect","IBrokers")) { tws <- do.call('twsConnect',list(clientId=1001)) on.exit(do.call('twsDisconnect',list(tws))) - + if(missing(endDateTime)) endDateTime <- NULL - + returnSym <- Symbols noDataSym <- NULL @@ -1068,7 +1092,7 @@ useRTH = '1', whatToShow = 'TRADES', time.format = '1', ...) } if(auto.assign) return(setdiff(returnSym, noDataSym)) - return(fr) + return(fr) } } # }}} @@ -1177,7 +1201,7 @@ function(Symbols,env,return.class='xts', fr <- fr[paste(from, to, sep="/")] # subset to requested timespan colnames(fr) <- gsub("/",".",Symbols[[i]]) fr <- convert.time.series(fr=fr,return.class=return.class) - Symbols[[i]] <-toupper(gsub('\\^|/','',Symbols[[i]])) + Symbols[[i]] <-toupper(gsub('\\^|/','',Symbols[[i]])) if(auto.assign) assign(Symbols[[i]],fr,env) }, silent = TRUE) @@ -1198,9 +1222,9 @@ function(Symbols,env,return.class='xts', # # Download OHLC Data From Alpha Vantage -# +# # Meant to be called internally by getSymbols(). -# +# getSymbols.av <- function(Symbols, env, api.key, return.class="xts", periodicity="daily", @@ -1215,7 +1239,7 @@ getSymbols.av <- function(Symbols, env, api.key, for (var in names(list(...))) { assign(var, list(...)[[var]], this.env) } - + if (!hasArg("api.key")) { stop("getSymbols.av: An API key is required (api.key). Free registration", " at https://www.alphavantage.co/.", call.=FALSE) @@ -1223,15 +1247,15 @@ getSymbols.av <- function(Symbols, env, api.key, if (!hasArg("auto.assign")) auto.assign <- TRUE if (!hasArg("verbose")) verbose <- FALSE if (!hasArg("warnings")) warnings <- TRUE - + valid.periodicity <- c("daily", "weekly", "monthly", "intraday") periodicity <- match.arg(periodicity, valid.periodicity) interval <- match.arg(interval, c("1min", "5min", "15min", "30min", "60min")) output.size <- match.arg(output.size, c("compact", "full")) - + default.return.class <- return.class default.periodicity <- periodicity - + # # For daily, weekly, and monthly data, timestamps are "yyyy-mm-dd". # For intraday data, timestamps are "yyyy-mm-dd HH:MM:SS". @@ -1242,31 +1266,31 @@ getSymbols.av <- function(Symbols, env, api.key, else as.Date(ts) } - + downloadOne <- function(sym, default.return.class, default.periodicity) { - + return.class <- getSymbolLookup()[[sym]]$return.class return.class <- if (is.null(return.class)) default.return.class else return.class - + periodicity <- getSymbolLookup()[[sym]]$periodicity periodicity <- if (is.null(periodicity)) default.periodicity else periodicity periodicity <- match.arg(periodicity, valid.periodicity) - + if (adjusted && periodicity == "intraday") stop("getSymbols.av: Intraday data cannot be adjusted.", call.=FALSE) - + sym.name <- getSymbolLookup()[[sym]]$name sym.name <- if (is.null(sym.name)) sym else sym.name - + FUNCTION <- paste0("TIME_SERIES_", switch(periodicity, daily = if (adjusted) "DAILY_ADJUSTED" else "DAILY", weekly = if (adjusted) "WEEKLY_ADJUSTED" else "WEEKLY", monthly = if (adjusted) "MONTHLY_ADJUSTED" else "MONTHLY", intraday = "INTRADAY" )) - + if (verbose) cat("loading", sym.name, ".....") - + URL <- paste0("https://www.alphavantage.co/query", "?function=", FUNCTION, "&symbol=", sym.name, @@ -1274,7 +1298,7 @@ getSymbols.av <- function(Symbols, env, api.key, "&outputsize=", output.size, "&datatype=", data.type, "&apikey=", api.key) - + if (data.type == "json") { lst <- jsonlite::fromJSON(URL) @@ -1362,7 +1386,7 @@ getSymbols.av <- function(Symbols, env, api.key, assign(sym, mat, env) return(mat) } - + returnSym <- Symbols noDataSym <- NULL matrices <- list() @@ -1396,9 +1420,9 @@ getSymbols.alphavantage <- getSymbols.av # # Download OHLC Data From Tiingo -# +# # Meant to be called internally by getSymbols(). -# +# getSymbols.tiingo <- function(Symbols, env, api.key, return.class="xts", periodicity="daily", @@ -1406,13 +1430,13 @@ getSymbols.tiingo <- function(Symbols, env, api.key, from='2007-01-01', to=Sys.Date(), ...) { - + importDefaults("getSymbols.tiingo") this.env <- environment() for (var in names(list(...))) { assign(var, list(...)[[var]], this.env) } - + if (!hasArg("api.key")) { stop("getSymbols.tiingo: An API key is required (api.key). Register", " at https://api.tiingo.com.", call.=FALSE) @@ -1420,14 +1444,14 @@ getSymbols.tiingo <- function(Symbols, env, api.key, if (!hasArg("auto.assign")) auto.assign <- TRUE if (!hasArg("verbose")) verbose <- FALSE if (!hasArg("warnings")) warnings <- TRUE - + valid.periodicity <- c("daily", "weekly", "monthly", "annually") periodicity <- match.arg(periodicity, valid.periodicity) default.return.class <- return.class default.periodicity <- periodicity - + downloadOne <- function(sym, default.return.class, default.periodicity) { - + return.class <- getSymbolLookup()[[sym]]$return.class return.class <- if (is.null(return.class)) default.return.class else return.class periodicity <- getSymbolLookup()[[sym]]$periodicity @@ -1435,7 +1459,7 @@ getSymbols.tiingo <- function(Symbols, env, api.key, periodicity <- match.arg(periodicity, valid.periodicity) sym.name <- getSymbolLookup()[[sym]]$name sym.name <- if (is.null(sym.name)) sym else sym.name - + if (verbose) cat("loading", sym.name, ".....") from.strftime <- strftime(from, format = "%Y-%m-%d") to.strftime <- strftime(to, format = "%Y-%m-%d") @@ -1455,7 +1479,7 @@ getSymbols.tiingo <- function(Symbols, env, api.key, msg <- sub("Error: ", "", colnames(stock.data)) stop(msg, call. = FALSE) } - + tm.stamps <- as.Date(stock.data[, "date"]) if (adjust) { @@ -1473,7 +1497,7 @@ getSymbols.tiingo <- function(Symbols, env, api.key, assign(sym, xts.data, env) return(xts.data) } - + returnSym <- Symbols noDataSym <- NULL matrices <- list() @@ -1494,7 +1518,7 @@ getSymbols.tiingo <- function(Symbols, env, api.key, noDataSym <- c(noDataSym, returnSym[[i]]) } } - + if (auto.assign) { return(setdiff(returnSym, noDataSym)) } else { @@ -1538,7 +1562,7 @@ getSymbols.tiingo <- function(Symbols, env, api.key, }#}}} # removeSymbols {{{ -"removeSymbols" <- +"removeSymbols" <- function(Symbols=NULL,env=parent.frame()) { if(exists('.getSymbols',env,inherits=FALSE)) { getSymbols <- get('.getSymbols',env,inherits=FALSE) @@ -1585,7 +1609,7 @@ function(Symbols=NULL,file.path=stop("must specify 'file.path'"),env=parent.fram save(list=each.symbol, file=paste(file.path,'/',each.symbol,".RData",sep=''), envir=env) - } + } } } # }}}