[Draft] revive pdfetch_ONS()

R/pdfetch.R

@@ -142,7 +142,7 @@ pdfetch_EUROSTAT_GETDSD <- function(flowRef) {
 #' @export
 #' @examples
 #' \dontrun{
-#' pdfetch_EUROSTAT_DSD("namq_gdp_c")
+#' pdfetch_EUROSTAT_DSD("namq_10_gdp")
 #' }
 pdfetch_EUROSTAT_DSD <- function(flowRef) {
   results <- NULL
@@ -183,8 +183,8 @@ pdfetch_EUROSTAT_DSD <- function(flowRef) {
 #' @export
 #' @examples
 #' \dontrun{
-#' pdfetch_EUROSTAT("namq_gdp_c", FREQ="Q", S_ADJ="NSA", UNIT="MIO_EUR", 
-#'                           INDIC_NA="B1GM", GEO=c("DE","UK"))
+#' pdfetch_EUROSTAT("namq_10_gdp", FREQ="Q", S_ADJ="NSA", UNIT="CP_MEUR",
+#'                  INDIC_NA="B1GM", GEO=c("DE","UK"))
 #' }
 pdfetch_EUROSTAT <- function(flowRef, from, to, ...) {
   arguments <- list(...)
@@ -226,12 +226,13 @@ pdfetch_EUROSTAT <- function(flowRef, from, to, ...) {
   doc <- doc %>% 
     select(c("freq","ID_COLUMN","TIME_PERIOD","OBS_VALUE")) %>% 
     tidyr::pivot_wider(names_from="ID_COLUMN", values_from="OBS_VALUE") %>% 
+    mutate(TIME_PERIOD = as.character(.data$TIME_PERIOD)) %>%
     mutate(
       date=case_when(
-        freq == 'A' ~ as.Date(ISOdate(TIME_PERIOD,12,31)),
-        freq == 'Q' ~ quarter_end(as.Date(lubridate::parse_date_time2(TIME_PERIOD, orders="Y-q"))),
-        freq == 'M' ~ month_end(as.Date(lubridate::parse_date_time2(TIME_PERIOD, orders="Y-m"))),
-        TRUE ~ as.Date(TIME_PERIOD, format="%Y-%m-%d")
+        freq == 'A' ~ as.Date(ISOdate(.data$TIME_PERIOD,12,31)),
+        freq == 'Q' ~ quarter_end(as.Date(lubridate::parse_date_time2(.data$TIME_PERIOD, orders="Y-q"))),
+        freq == 'M' ~ month_end(as.Date(lubridate::parse_date_time2(.data$TIME_PERIOD, orders="Y-m"))),
+        TRUE ~ as.Date(.data$TIME_PERIOD, format="%Y-%m-%d")
       )
     )
 
@@ -460,20 +461,55 @@ pdfetch_INSEE <- function(identifiers) {
 #' pdfetch_ONS(c("LF24","LF2G"), "lms")
 #' }
 pdfetch_ONS <- function(identifiers, dataset) {
-  identifiers <- tolower(identifiers)
+  orig_identifiers <- identifiers
+  identifiers <- toupper(identifiers)
 
-  results <- list()
+  results <- vector("list", length(identifiers))
 
-  for (id in identifiers) {
-    url <- paste0("https://api.beta.ons.gov.uk/v1/datasets/",dataset,"/editions/time-series/versions/1/observations?time=*&aggregate=",id)
-
-    raw <- content(GET(url))
-    if (is.null(raw)) {
-      warning(paste0('Series ', id, ' in dataset ', dataset, ' not found.'))
-      next
+  ons_api <- "https://api.beta.ons.gov.uk/v1"
+  search_api <- paste0(
+    ons_api, "/search?q=", paste0(identifiers, collapse = "+")
+  )
+
+  if (!missing(dataset)) {
+    search_api <- paste0(search_api, "&dataset_ids=", toupper(dataset))
+  }
+
+  raw <- httr::content(httr::GET(search_api))
+
+  res <- lapply(raw$items, function(x) {
+    c(
+      title = x$title, # series label
+      uri = x$uri,
+      cdid = x$cdid
+    )
+  })
+  res <- as.data.frame(do.call("rbind", res))
+
+  ## if the input is not found in res, res$count can be 0. But if some inputs
+  ## are found, only these are returned by the search api
+  found_identifiers <- match(identifiers, res$cdid)
+  if (anyNA(found_identifiers) || raw$count < length(identifiers)) {
+    miss_identifiers <- paste(
+      orig_identifiers[is.na(found_identifiers)],
+      collapse = ", "
+    )
+    msg <- paste0('Series ', miss_identifiers)
+    if (!missing(dataset)) {
+      msg <- paste0(msg, ' in dataset ', dataset)
     }
-    print(raw)
+    msg <- paste0(msg, ' not found.')
+    warning(msg, call. = FALSE)
+  }
+
+  # output order might differ from input
+  res <- res[found_identifiers[!is.na(found_identifiers)], ]
+
+  for (id in seq_len(nrow(res))) {
 
+    url <- paste0(ons_api, "/data?uri=", res$uri[id])
+    raw <- httr::content(httr::GET(url))
+
     if (length(raw$months) > 0) {
       month <- sapply(raw$months, function(x) match(x$month, c("January","February","March","April","May","June","July","August","September","October","November","December")))
       year <- sapply(raw$months, function(x) as.numeric(x$year))
@@ -487,16 +523,16 @@ pdfetch_ONS <- function(identifiers, dataset) {
       year <- sapply(raw$years, function(x) as.numeric(x$year))
       values <- sapply(raw$years, function(x) as.numeric(x$value))
     }
-    
+
     dates <- month_end(as.Date(ISOdate(year, month, 1)))
     x <- xts(values, dates)
-    colnames(x) <- toupper(id)
+    colnames(x) <- toupper(res$cdid[id])
     results[[id]] <- x
   }
 
   if (length(results) == 0)
     return(NULL)
-  
+
   na.trim(do.call(merge.xts, results), is.na="all")
 }