Skip to content

Commit 5160ad9

Browse files
sgratzlsgratzl
authored
Merge pull request #12 from cmu-delphi/sgratzl/meta
add covidcast meta wrapper
2 parents ce8c76d + 5a2513a commit 5160ad9

File tree

7 files changed

+244
-32
lines changed

7 files changed

+244
-32
lines changed

‎R/constants.R

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,4 +2,4 @@
22

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

‎R/covidcast.R

Lines changed: 154 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,154 @@
1+
2+
parse_signal <- function(signal, base_url) {
3+
class(signal) <- c("covidcast_data_signal", class(signal))
4+
signal$key <- paste(signal$source, signal$signal, sep = ":")
5+
6+
#'
7+
#' fetch covidcast data
8+
#'
9+
#' @param data_source data source to fetch
10+
#' @param signals data source to fetch
11+
#' @param time_type data source to fetch
12+
#' @param time_values data source to fetch
13+
#' @param geo_type geo_type to fetch
14+
#' @param geo_values data source to fetch
15+
#' @param as_of data source to fetch
16+
#' @param issues data source to fetch
17+
#' @param lag data source to fetch
18+
#' @return an instance of epidata_call
19+
signal$call <- function(geo_type,
20+
geo_values,
21+
time_values,
22+
...) {
23+
epicall <- covidcast(
24+
signal$source, signal$signal, signal$time_type, geo_type,
25+
time_values, geo_values, ...
26+
)
27+
epicall$base_url <- base_url
28+
epicall
29+
}
30+
r <- list()
31+
r[[signal$signal]] <- signal
32+
r
33+
}
34+
35+
print.covidcast_data_signal <- function(signal, ...) {
36+
print(signal$name)
37+
print(signal$key)
38+
print(signal$short_description)
39+
}
40+
41+
parse_source <- function(source, base_url) {
42+
class(source) <- c("covidcast_data_source", class(source))
43+
signals <- do.call(c, lapply(source$signals, parse_signal, base_url = base_url))
44+
class(signals) <- c("covidcast_data_signal_list", class(signals))
45+
source$signals <- signals
46+
r <- list()
47+
r[[source$source]] <- source
48+
r
49+
}
50+
51+
52+
as.data.frame.covidcast_data_signal_list <- function(signals, ...) {
53+
as.data.frame(do.call(rbind, lapply(signals, function(x) {
54+
sub <- x[c(
55+
"source",
56+
"signal",
57+
"name",
58+
"active",
59+
"short_description",
60+
"description",
61+
"time_type",
62+
"time_label",
63+
"value_label",
64+
"format",
65+
"category",
66+
"high_values_are",
67+
"is_smoothed",
68+
"is_weighted",
69+
"is_cumulative",
70+
"has_stderr",
71+
"has_sample_size"
72+
)]
73+
sub$geo_types <- paste0(names(x$geo_types), collapse = ",")
74+
sub
75+
})), row.names = sapply(signals, function(x) {
76+
x$key
77+
}), ...)
78+
}
79+
80+
81+
print.covidcast_data_source <- function(source, ...) {
82+
print(source$name, ...)
83+
print(source$source, ...)
84+
print(source$description, ...)
85+
signals <- as.data.frame(source$signals)
86+
print(signals[, c("signal", "name", "short_description")], ...)
87+
}
88+
89+
#'
90+
#' creates the covidcast epidata helper
91+
#'
92+
#' @param base_url optional alternative base url
93+
#' @importFrom httr RETRY stop_for_status content
94+
#' @importFrom jsonlite fromJSON
95+
#' @importFrom rlang abort
96+
#' @return an instance of covidcast_epidata
97+
#'
98+
#' @export
99+
covidcast_epidata <- function(base_url = global_base_url) {
100+
url <- join_url(base_url, "covidcast/meta")
101+
res <- do_request(url, list())
102+
103+
httr::stop_for_status(res)
104+
r <- httr::content(res, "text", encoding = "UTF-8")
105+
meta <- jsonlite::fromJSON(r, simplifyVector = FALSE)
106+
107+
sources <- do.call(c, lapply(meta, parse_source, base_url = base_url))
108+
class(sources) <- c("covidcast_data_source_list", class(sources))
109+
110+
all_signals <- do.call(c, lapply(sources, function(x) {
111+
l <- c(x$signals)
112+
names(l) <- paste(x$source, names(l), sep = ":")
113+
l
114+
}))
115+
class(all_signals) <- c("covidcast_data_signal_list", class(all_signals))
116+
structure(
117+
list(
118+
sources = sources,
119+
signals = all_signals
120+
),
121+
class = "covidcast_epidata"
122+
)
123+
}
124+
125+
126+
as.data.frame.covidcast_data_source_list <- function(sources, ...) {
127+
as.data.frame(do.call(rbind, lapply(sources, function(x) {
128+
sub <- x[c(
129+
"source", "name", "description", "reference_signal", "license"
130+
)]
131+
sub$signals <- paste0(sapply(x$signals, function(y) {
132+
y$signal
133+
}), collapse = ",")
134+
sub
135+
})), row.names = sapply(sources, function(x) {
136+
x$source
137+
}), ...)
138+
}
139+
140+
print.covidcast_epidata <- function(epidata, ...) {
141+
print("COVIDcast Epidata Fetcher")
142+
print("Sources:")
143+
sources <- as.data.frame(epidata$sources)
144+
print(sources[1:5, c("source", "name")], ...)
145+
if (nrow(sources) > 5) {
146+
print(paste0((nrow(sources) - 5), " more..."))
147+
}
148+
print("Signals")
149+
signals <- as.data.frame(epidata$signals)
150+
print(signals[1:5, c("source", "signal", "name")], ...)
151+
if (nrow(signals) > 5) {
152+
print(paste0((nrow(signals) - 5), " more..."))
153+
}
154+
}

‎R/epidatacall.R

Lines changed: 9 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,8 @@
11

22

33

4-
create_epidata_call <- function(endpoint, params, meta = NULL, only_supports_classic = FALSE) {
4+
create_epidata_call <- function(endpoint, params, meta = NULL,
5+
only_supports_classic = FALSE) {
56
stopifnot(is.character(endpoint), length(endpoint) == 1)
67
stopifnot(is.list(params))
78
stopifnot(is.null(meta) || is.list(meta))
@@ -13,7 +14,7 @@ create_epidata_call <- function(endpoint, params, meta = NULL, only_supports_cla
1314
list(
1415
endpoint = endpoint,
1516
params = params,
16-
base_url = base_url,
17+
base_url = global_base_url,
1718
meta = meta,
1819
only_supports_classic = only_supports_classic
1920
),
@@ -62,11 +63,7 @@ request_arguments <-
6263

6364
full_url <- function(epidata_call) {
6465
stopifnot(inherits(epidata_call, "epidata_call"))
65-
url <- epidata_call$base_url
66-
if (url[length(url)] != "/") {
67-
url <- paste0(url, "/")
68-
}
69-
paste0(url, epidata_call$endpoint)
66+
join_url(epidata_call$base_url, epidata_call$endpoint)
7067
}
7168

7269
#'
@@ -99,18 +96,7 @@ request_impl <- function(epidata_call, format_type, fields = NULL) {
9996
url <- full_url(epidata_call)
10097
params <- request_arguments(epidata_call, format_type, fields)
10198

102-
# don't retry in case of certain status codes
103-
res <- httr::RETRY("GET", url,
104-
query = params, http_headers,
105-
terminate_on = c(400, 401, 403, 405, 414, 500)
106-
)
107-
if (res$status_code == 414) {
108-
res <- httr::RETRY("POST", url,
109-
body = params, encode = "form", http_headers,
110-
terminate_on = c(400, 401, 403, 405, 414, 500)
111-
)
112-
}
113-
res
99+
do_request(url, params)
114100
}
115101

116102
#'
@@ -119,9 +105,8 @@ request_impl <- function(epidata_call, format_type, fields = NULL) {
119105
#' @param epidata_call and instance of epidata_call
120106
#' @param fields filter fields
121107
#' @param disable_date_parsing disable automatic date parsing
122-
#' @importFrom httr RETRY stop_for_status content http_error
108+
#' @importFrom httr stop_for_status content http_error
123109
#' @importFrom jsonlite fromJSON
124-
#' @importFrom MMWRweek MMWRweek2Date
125110
#' @return parsed json message
126111
#'
127112
#' @export
@@ -149,9 +134,8 @@ fetch_classic <- function(epidata_call, fields = NULL, disable_date_parsing = FA
149134
#' @param epidata_call and instance of epidata_call
150135
#' @param fields filter fields
151136
#' @param disable_date_parsing disable automatic date parsing
152-
#' @importFrom httr RETRY stop_for_status content
137+
#' @importFrom httr stop_for_status content
153138
#' @importFrom jsonlite fromJSON
154-
#' @importFrom MMWRweek MMWRweek2Date
155139
#' @importFrom rlang abort
156140
#' @return parsed json message
157141
#'
@@ -177,7 +161,7 @@ fetch_json <- function(epidata_call, fields = NULL, disable_date_parsing = FALSE
177161
#'
178162
#' @param epidata_call and instance of epidata_call
179163
#' @param fields filter fields
180-
#' @importFrom httr RETRY stop_for_status content
164+
#' @importFrom httr stop_for_status content
181165
#' @importFrom rlang abort
182166
#' @return CSV text
183167
#'
@@ -238,8 +222,7 @@ info_to_type <- function(info, disable_date_parsing = FALSE) {
238222
#' @param fields filter fields
239223
#' @param disable_date_parsing disable automatic date parsing
240224
#' @importFrom readr read_csv
241-
#' @importFrom httr RETRY stop_for_status content
242-
#' @importFrom MMWRweek MMWRweek2Date
225+
#' @importFrom httr stop_for_status content
243226
#' @importFrom rlang abort
244227
#' @return tibble
245228
#'
@@ -293,10 +276,6 @@ fetch_tbl <- function(epidata_call, fields = NULL, disable_date_parsing = FALSE)
293276
#' @param epidata_call and instance of epidata_call
294277
#' @param fields filter fields
295278
#' @param disable_date_parsing disable automatic date parsing
296-
#' @importFrom readr read_csv
297-
#' @importFrom httr RETRY stop_for_status content
298-
#' @importFrom MMWRweek MMWRweek2Date
299-
#' @importFrom rlang abort
300279
#' @return data.frame
301280
#'
302281
#' @export

‎R/parse.R

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,12 @@ parse_api_date <- function(value) {
33
as.Date(as.character(value), format = "%Y%m%d")
44
}
55

6+
7+
8+
#'
9+
#' parses a week
10+
#' @importFrom MMWRweek MMWRweek2Date
11+
#' @return a date
612
parse_api_week <- function(value) {
713
v <- as.integer(value)
814
years <- floor(v / 100)

‎R/request.R

Lines changed: 24 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,24 @@
1+
join_url <- function(url, endpoint) {
2+
if (url[length(url)] != "/") {
3+
url <- paste0(url, "/")
4+
}
5+
paste0(url, endpoint)
6+
}
7+
8+
#'
9+
#' performs the request
10+
#' @importFrom httr RETRY
11+
do_request <- function(url, params) {
12+
# don't retry in case of certain status codes
13+
res <- httr::RETRY("GET", url,
14+
query = params, http_headers,
15+
terminate_on = c(400, 401, 403, 405, 414, 500)
16+
)
17+
if (res$status_code == 414) {
18+
res <- httr::RETRY("POST", url,
19+
body = params, encode = "form", http_headers,
20+
terminate_on = c(400, 401, 403, 405, 414, 500)
21+
)
22+
}
23+
res
24+
}

‎R/utils.R

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,7 @@ format_item <- function(value) {
55
if (inherits(value, "EpiRange")) {
66
paste0(toString(value$from), "-", toString(value$to))
77
} else if (is.list(value) &&
8-
"from" %in% names(value) && "to" %in% names(value)) {
8+
"from" %in% names(value) && "to" %in% names(value) && length(names(value)) == 2) {
99
paste0(toString(value$from), "-", toString(value$to))
1010
} else {
1111
toString(value)

‎vignettes/covidcast.Rmd

Lines changed: 49 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,49 @@
1+
---
2+
title: "COVIDcast API Client"
3+
author: "Delphi Group"
4+
date: "`r Sys.Date()`"
5+
output: rmarkdown::html_vignette
6+
vignette: >
7+
%\VignetteIndexEntry{COVIDcast API Client}
8+
%\VignetteEngine{knitr::rmarkdown}
9+
\usepackage[utf8]{inputenc}
10+
---
11+
12+
```{r setup, include=FALSE}
13+
knitr::opts_chunk$set(echo = TRUE)
14+
```
15+
16+
# Delphi Epidata R API Client
17+
18+
```{r libraries}
19+
# devtools::install_url("https://github.com/cmu-delphi/delphi-epidata-r/releases/latest/download/delphi-epidata.tar.gz")
20+
# install.packages('delphi.epidata')
21+
library('delphi.epidata')
22+
library('magrittr')
23+
```
24+
25+
26+
```{r}
27+
covidcast_api <- covidcast_epidata()
28+
epicall <- covidcast_api$sources$`fb-survey`$signals$smoothed_cli$call("nation", "us", epirange(20210405, 20210410))
29+
```
30+
31+
```{r}
32+
epicall %>% fetch_classic()
33+
```
34+
35+
```{r}
36+
epicall %>% fetch_json()
37+
```
38+
39+
```{r}
40+
epicall %>% fetch_csv()
41+
```
42+
43+
```{r}
44+
epicall %>% fetch_df()
45+
```
46+
47+
```{r}
48+
# epicall %>% with_base_url("https://staging.delphi.cmu.edu/epidata/") %>% fetch_df()
49+
```

0 commit comments

Comments
 (0)