Updated download_data() to confirm with new Yahoo Finance API.

DESCRIPTION

@@ -36,9 +36,12 @@ Depends:
 Imports: 
     checkmate,
     cli,
+    curl,
     foreach,
     graphics,
     grDevices,
+    httr,
+    jsonlite,
     MASS,
     oeli (>= 0.3.0),
     padr,

NAMESPACE

@@ -60,6 +60,7 @@ importFrom(checkmate,test_numeric)
 importFrom(checkmate,test_scalar_na)
 importFrom(checkmate,test_string)
 importFrom(cli,style_hyperlink)
+importFrom(curl,has_internet)
 importFrom(foreach,"%dopar%")
 importFrom(grDevices,adjustcolor)
 importFrom(grDevices,col2rgb)
@@ -78,6 +79,10 @@ importFrom(graphics,plot.new)
 importFrom(graphics,points)
 importFrom(graphics,text)
 importFrom(graphics,title)
+importFrom(httr,GET)
+importFrom(httr,content)
+importFrom(httr,http_error)
+importFrom(jsonlite,fromJSON)
 importFrom(padr,pad)
 importFrom(pracma,hessian)
 importFrom(stats,AIC)

NEWS.md

@@ -2,6 +2,8 @@
 
 * Removed stale import of `oeli::check_date()`.
 
+* Updated `download_data()` to confirm with new Yahoo Finance API.
+
 # fHMM 1.4.0
 
 * Fixed a bug around the `period` control (#93, thanks to @dongsen86).

R/download_data.R

@@ -58,9 +58,22 @@ download_data <- function(
     symbol, from = "1902-01-01", to = Sys.Date(), fill_dates = FALSE,
     columns = c("Date", "Open", "High", "Low", "Close", "Adj.Close", "Volume")
 ) {
+  ### check inputs
+  if (!curl::has_internet()) {
+    stop("This function requires an internet connection.", call. = FALSE)
+  }
   if (missing(symbol) || !is.character(symbol) || length(symbol) != 1) {
     stop("'symbol' must be a single character.", call. = FALSE)
   }
+  if (!isTRUE(fill_dates) && !isFALSE(fill_dates)) {
+    stop("'fill_dates' must be TRUE or FALSE.", call. = FALSE)
+  }
+  if (!is.character(columns)) {
+    stop("'columns' must be a character vector.", call. = FALSE)
+  }
+  columns <- match.arg(columns, several.ok = TRUE)
+
+  ### check range
   from <- check_date(from)
   min_date <- as.Date("1902-01-01")
   if (from < min_date) {
@@ -71,52 +84,54 @@ download_data <- function(
   if (to < from) {
     stop("'to' must not be earlier than 'from'.", call. = FALSE)
   }
-  if (!isTRUE(fill_dates) && !isFALSE(fill_dates)) {
-    stop("'fill_dates' must be TRUE or FALSE.", call. = FALSE)
-  }
-  if (!is.character(columns)) {
-    stop("'columns' must be a character vector.", call. = FALSE)
+  if (to > Sys.Date()) {
+    stop("'to' cannot be in the future.", call. = FALSE)
   }
-  columns <- match.arg(columns, several.ok = TRUE)
-  create_url <- function(symbol, from, to) {
-    t1 <- as.integer(ISOdate(as.numeric(format(from, format = "%Y")),
-                             as.numeric(format(from, format = "%m")),
-                             as.numeric(format(from, format = "%d")),
-                             hour = 0
-    ))
-    t2 <- as.integer(ISOdate(as.numeric(format(to, format = "%Y")),
-                             as.numeric(format(to, format = "%m")),
-                             as.numeric(format(to, format = "%d")),
-                             hour = 24
-    ))
-    paste("https://query1.finance.yahoo.com/v7/finance/download/",
-          symbol, "?period1=", t1, "&period2=", t2,
-          "&interval=1d&events=history",
-          sep = ""
-    )
-  }
-  destfile <- tempfile()
-  download_try <- suppressWarnings(
-    try(utils::download.file(
-      url = create_url(symbol, from, to), destfile = destfile, quiet = TRUE),
-      silent = TRUE
+
+  ### API request
+  url <- paste0("https://query2.finance.yahoo.com/v8/finance/chart/", symbol)
+  resp <- httr::GET(
+    url = url, 
+    query = list(
+      period1 = as.numeric(as.POSIXct(from, tz = "UTC")), 
+      period2 = as.numeric(as.POSIXct(to + 1, tz = "UTC")), 
+      interval = "1d"
     )
   )
-  if (inherits(download_try, "try-error")) {
+  if (httr::http_error(resp)) {
     stop(
-      "Download failed. This can have different reasons:\n",
+      "Yahoo Finance API request failed. This can have different reasons:\n",
       "- Maybe 'symbol' is unknown.\n",
       "- Or there is no data for the specified time interval.", 
       call. = FALSE
     )
-  } 
-  data <- utils::read.csv(
-    file = destfile, header = TRUE, sep = ",", na.strings = "null"
+  }
+  parsed <- jsonlite::fromJSON(
+    httr::content(resp, "text", encoding = "UTF-8"), simplifyVector = FALSE
+  )
+
+  ### shape data
+  data <- parsed[["chart"]][["result"]][[1]]
+  date <- format(as.POSIXct(unlist(data$timestamp)), format = "%Y-%m-%d")
+  indicators <- data$indicators$quote[[1]]
+  adjclose <- data$indicators$adjclose[[1]][["adjclose"]]
+  data <- data.frame(
+    Date = date,
+    Open = list_to_vector(indicators$open),
+    High = list_to_vector(indicators$high),
+    Low  = list_to_vector(indicators$low),
+    Close = list_to_vector(indicators$close),
+    Adj.Close = list_to_vector(adjclose),
+    Volume = list_to_vector(indicators$volume)
   )
+
+  ### fill dates (if requested)
   if (fill_dates) {
     data$Date <- as.Date(data$Date)
     data <- padr::pad(data, interval = "day", start_val = from, end_val = to)
     data$Date <- as.character(data$Date)
   }
+
+  ### select columns
   data[, columns, drop = FALSE]
 }

R/fHMM-package.R

@@ -30,6 +30,7 @@
 #' @importFrom checkmate test_scalar_na
 #' @importFrom checkmate test_string
 #' @importFrom cli style_hyperlink
+#' @importFrom curl has_internet
 #' @importFrom foreach %dopar%
 #' @importFrom graphics abline
 #' @importFrom graphics axis
@@ -48,6 +49,10 @@
 #' @importFrom grDevices col2rgb
 #' @importFrom grDevices colorRampPalette
 #' @importFrom grDevices rgb
+#' @importFrom httr content
+#' @importFrom httr GET
+#' @importFrom httr http_error
+#' @importFrom jsonlite fromJSON
 #' @importFrom MASS ginv
 #' @importFrom padr pad
 #' @importFrom pracma hessian

R/helpers.R

@@ -24,7 +24,7 @@ check_date <- function(date) {
 #' Find closest year
 #'
 #' @description
-#' This function takes a date as input and returns the closest year.
+#' This function takes a \code{date} as input and returns the closest year.
 #'
 #' @param date \[`character(1)`\]\cr
 #' The date in format \code{"YYYY-MM-DD"}.
@@ -43,3 +43,21 @@ find_closest_year <- function(date) {
   )
 }
 
+#' List to vector
+#' 
+#' @description
+#' This function produces a \code{vector} from a \code{list} structure and 
+#' replaces \code{NULL} elements by \code{NA}.
+#' 
+#' @param x \[`list()`\]\cr
+#' A \code{list}.
+#' 
+#' @return 
+#' A \code{numeric}.
+#' 
+#' @keywords internal
+
+list_to_vector <- function(x) {
+  stopifnot(is.list(x))
+  unlist(lapply(x, function(m) ifelse(is.null(m), NA, m)))
+}

renv.lock

@@ -1,6 +1,6 @@
 {
   "R": {
-    "Version": "4.4.1",
+    "Version": "4.4.0",
     "Repositories": [
       {
         "Name": "CRAN",

tests/testthat/test-download_data.R

@@ -33,7 +33,7 @@ test_that("input checks for download_data() work", {
   )
   expect_error(
     download_data(symbol = "wrong_symbol"),
-    "Download failed."
+    "Yahoo Finance API request failed."
   )
 })
 

tests/testthat/test-helpers.R

@@ -34,4 +34,11 @@ test_that("finding closest year works", {
     find_closest_year(as.Date("2022-12-31")),
     2023
   )
-})
+})
+
+test_that("list to vector works", {
+  expect_equal(
+    list_to_vector(list(1, 2, NA, NULL)),
+    c(1, 2, NA, NA)
+  )
+})