add covidcast meta wrapper

R/constants.R

@@ -2,4 +2,4 @@
 
 version <- "1.0.0"
 http_headers <- httr::add_headers("User-Agent" = paste0("delphi_epidata", version))
-base_url <- "https://delphi.cmu.edu/epidata/"
+global_base_url <- "https://delphi.cmu.edu/epidata/"

R/covidcast.R

@@ -0,0 +1,106 @@
+
+parse_signal <- function(signal) {
+  class(signal) <- c(class(signal), "covidcast_data_signal")
+
+  #'
+  #' fetch covidcast data
+  #'
+  #' @param data_source data source to fetch
+  #' @param signals data source to fetch
+  #' @param time_type data source to fetch
+  #' @param time_values data source to fetch
+  #' @param geo_type geo_type to fetch
+  #' @param geo_values data source to fetch
+  #' @param as_of data source to fetch
+  #' @param issues data source to fetch
+  #' @param lag data source to fetch
+  #' @return an instance of epidata_call
+  signal$call <- function(geo_type,
+                          geo_values,
+                          time_values,
+                          ...) {
+    covidcast(
+      signal$source, signal$signal, signal$time_type, geo_type,
+      time_values, geo_values, ...
+    )
+  }
+  r <- list()
+  r[[signal$signal]] <- signal
+  r
+}
+
+parse_source <- function(source) {
+  class(source) <- c(class(source), "covidcast_data_source")
+  signals <- do.call(c, lapply(source$signals, parse_signal))
+  source$signals <- signals
+  signals_df <- as.data.frame(do.call(rbind, lapply(signals, function(x) {
+    sub <- x[c(
+      "source",
+      "signal",
+      "name",
+      "active",
+      "short_description",
+      "description",
+      "time_type",
+      "time_label",
+      "value_label",
+      "format",
+      "category",
+      "high_values_are",
+      "is_smoothed",
+      "is_weighted",
+      "is_cumulative",
+      "has_stderr",
+      "has_sample_size"
+    )]
+    sub$geo_types <- paste0(names(x$geo_types), collapse = ",")
+    sub
+  })))
+  rownames(signals_df) <- paste(signals_df$source, signals_df$signal, sep = ":")
+  source$signals_df <- signals_df
+  r <- list()
+  r[[source$source]] <- source
+  r
+}
+
+
+#'
+#' creates the covidcast epidata helper
+#'
+#' @param base_url optional alternative base url
+#' @importFrom httr RETRY stop_for_status content
+#' @importFrom jsonlite fromJSON
+#' @importFrom rlang abort
+#' @return TODO
+#'
+#' @export
+covidcast_epidata <- function(base_url = global_base_url) {
+  url <- join_url(base_url, "covidcast/meta")
+  res <- do_request(url, list())
+
+  httr::stop_for_status(res)
+  r <- httr::content(res, "text", encoding = "UTF-8")
+  meta <- jsonlite::fromJSON(r, simplifyVector = FALSE)
+
+  sources <- do.call(c, lapply(meta, parse_source))
+  sources_df <- as.data.frame(do.call(rbind, lapply(sources, function(x) {
+    sub <- x[c(
+      "source", "name", "description", "reference_signal", "license"
+    )]
+    sub$signals <- paste0(x$signals_df$signal, collapse = ",")
+    sub
+  })))
+  rownames(sources_df) <- sources_df$source
+
+  structure(
+    list(
+      base_url = base_url,
+      sources = sources,
+      sources_df = sources_df,
+      signals_df = as.data.frame(do.call(rbind, lapply(sources, function(x) {
+        x$signals_df
+      })))
+    ),
+    class = "covidcast_epidata"
+  )
+}

R/epidatacall.R

@@ -13,7 +13,7 @@ create_epidata_call <- function(endpoint, params, meta = NULL, only_supports_cla
     list(
       endpoint = endpoint,
       params = params,
-      base_url = base_url,
+      base_url = global_base_url,
       meta = meta,
       only_supports_classic = only_supports_classic
     ),
@@ -62,11 +62,7 @@ request_arguments <-
 
 full_url <- function(epidata_call) {
   stopifnot(inherits(epidata_call, "epidata_call"))
-  url <- epidata_call$base_url
-  if (url[length(url)] != "/") {
-    url <- paste0(url, "/")
-  }
-  paste0(url, epidata_call$endpoint)
+  join_url(epidata_call$base_url, epidata_call$endpoint)
 }
 
 #'
@@ -99,18 +95,7 @@ request_impl <- function(epidata_call, format_type, fields = NULL) {
   url <- full_url(epidata_call)
   params <- request_arguments(epidata_call, format_type, fields)
 
-  # don't retry in case of certain status codes
-  res <- httr::RETRY("GET", url,
-    query = params, http_headers,
-    terminate_on = c(400, 401, 403, 405, 414, 500)
-  )
-  if (res$status_code == 414) {
-    res <- httr::RETRY("POST", url,
-      body = params, encode = "form", http_headers,
-      terminate_on = c(400, 401, 403, 405, 414, 500)
-    )
-  }
-  res
+  do_request(url, params)
 }
 
 #'

R/request.R

@@ -0,0 +1,21 @@
+join_url <- function(url, endpoint) {
+  if (url[length(url)] != "/") {
+    url <- paste0(url, "/")
+  }
+  paste0(url, endpoint)
+}
+
+do_request <- function(url, params) {
+  # don't retry in case of certain status codes
+  res <- httr::RETRY("GET", url,
+    query = params, http_headers,
+    terminate_on = c(400, 401, 403, 405, 414, 500)
+  )
+  if (res$status_code == 414) {
+    res <- httr::RETRY("POST", url,
+      body = params, encode = "form", http_headers,
+      terminate_on = c(400, 401, 403, 405, 414, 500)
+    )
+  }
+  res
+}

R/utils.R

@@ -5,7 +5,7 @@ format_item <- function(value) {
   if (inherits(value, "EpiRange")) {
     paste0(toString(value$from), "-", toString(value$to))
   } else if (is.list(value) &&
-    "from" %in% names(value) && "to" %in% names(value)) {
+    "from" %in% names(value) && "to" %in% names(value) && length(names(value)) == 2) {
     paste0(toString(value$from), "-", toString(value$to))
   } else {
     toString(value)

vignettes/covidcast.Rmd

@@ -0,0 +1,49 @@
+---
+title: "Delphi Epidata R API Client"
+author: "Delphi Group"
+date: "`r Sys.Date()`"
+output: rmarkdown::html_vignette
+vignette: >
+  %\VignetteIndexEntry{Delphi Epidata R API Client}
+  %\VignetteEngine{knitr::rmarkdown}
+  \usepackage[utf8]{inputenc}
+---
+
+```{r setup, include=FALSE}
+knitr::opts_chunk$set(echo = TRUE)
+```
+
+# Delphi Epidata R API Client
+
+```{r libraries}
+# devtools::install_url("https://github.com/cmu-delphi/delphi-epidata-r/releases/latest/download/delphi-epidata.tar.gz")
+# install.packages('delphi.epidata')
+library('delphi.epidata')
+library('magrittr')
+```
+
+
+```{r}
+covidcast_api <- covidcast_epidata()
+epicall <- covidcast_api$sources$`fb-survey`$signals$smoothed_cli$call("nation", "us", epirange(20210405, 20210410))
+```
+
+```{r}
+epicall %>% fetch_classic()
+```
+
+```{r}
+epicall %>% fetch_json()
+```
+
+```{r}
+epicall %>% fetch_csv()
+```
+
+```{r}
+epicall %>% fetch_df()
+```
+
+```{r}
+# epicall %>% with_base_url("https://staging.delphi.cmu.edu/epidata/") %>% fetch_df()
+```