Skip to content

Commit 78c381f

Browse files
authored
Merge pull request #220 from cmu-delphi/ndefries/parse-date-cols
Correctly parse issue field for `pub_covid_hosp_state_timeseries`
2 parents c97093c + 8e4fb6c commit 78c381f

File tree

5 files changed

+123
-6
lines changed

5 files changed

+123
-6
lines changed

R/endpoints.R

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -513,7 +513,6 @@ pub_covid_hosp_state_timeseries <- function(
513513
create_epidata_field_info("state", "text"),
514514
create_epidata_field_info("issue", "date"),
515515
create_epidata_field_info("date", "date"),
516-
create_epidata_field_info("issue", "date"),
517516
create_epidata_field_info("critical_staffing_shortage_today_yes", "bool"),
518517
create_epidata_field_info("critical_staffing_shortage_today_no", "bool"),
519518
create_epidata_field_info("critical_staffing_shortage_today_not_reported", "bool"),

R/epidatacall.R

Lines changed: 26 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -41,12 +41,38 @@
4141
#' @return
4242
#' - For `create_epidata_call`: an `epidata_call` object
4343
#'
44+
#' @importFrom purrr map_chr map_lgl
4445
create_epidata_call <- function(endpoint, params, meta = NULL,
4546
only_supports_classic = FALSE) {
4647
stopifnot(is.character(endpoint), length(endpoint) == 1)
4748
stopifnot(is.list(params))
4849
stopifnot(is.null(meta) || is.list(meta))
50+
stopifnot(all(map_lgl(meta, ~ inherits(.x, "EpidataFieldInfo"))))
4951
stopifnot(is.logical(only_supports_classic), length(only_supports_classic) == 1)
52+
53+
if (length(unique(meta)) != length(meta)) {
54+
cli::cli_abort(
55+
c(
56+
"List of expected epidata fields contains duplicate entries",
57+
"i" = "duplicates in meta can cause problems parsing fetched data",
58+
"Please fix in `endpoints.R`"
59+
),
60+
class = "epidatr__duplicate_meta_entries"
61+
)
62+
}
63+
64+
meta_field_names <- map_chr(meta, "name")
65+
if (length(meta_field_names) != length(unique(meta_field_names))) {
66+
cli::cli_abort(
67+
c(
68+
"List of expected epidata fields contains duplicate names",
69+
"i" = "duplicates in meta can cause problems parsing fetched data",
70+
"Please fix in `endpoints.R`"
71+
),
72+
class = "epidatr__duplicate_meta_names"
73+
)
74+
}
75+
5076
if (is.null(meta)) {
5177
meta <- list()
5278
}

R/model.R

Lines changed: 19 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -122,9 +122,9 @@ parse_value <- function(info, value, disable_date_parsing = FALSE) {
122122

123123
if (is.null(value)) {
124124
return(value)
125-
} else if (info$type == "date" && !disable_date_parsing) {
125+
} else if (info$type == "date" && !disable_date_parsing && !inherits(value, "Date")) {
126126
return(parse_api_date(value))
127-
} else if (info$type == "epiweek" && !disable_date_parsing) {
127+
} else if (info$type == "epiweek" && !disable_date_parsing && !inherits(value, "Date")) {
128128
return(parse_api_week(value))
129129
} else if (info$type == "bool") {
130130
return(as.logical(value))
@@ -138,13 +138,30 @@ parse_value <- function(info, value, disable_date_parsing = FALSE) {
138138
value
139139
}
140140

141+
#' @importFrom purrr map_chr
141142
parse_data_frame <- function(epidata_call, df, disable_date_parsing = FALSE) {
142143
stopifnot(inherits(epidata_call, "epidata_call"))
143144
meta <- epidata_call$meta
144145
df <- as.data.frame(df)
146+
145147
if (length(meta) == 0) {
146148
return(df)
147149
}
150+
151+
meta_field_names <- map_chr(meta, "name")
152+
missing_fields <- setdiff(names(df), meta_field_names)
153+
if (
154+
length(missing_fields) != 0
155+
) {
156+
cli::cli_warn(
157+
c(
158+
"Not all return columns are specified as expected epidata fields",
159+
"i" = "Unspecified fields {missing_fields} may need to be manually converted to more appropriate classes"
160+
),
161+
class = "epidatr__missing_meta_fields"
162+
)
163+
}
164+
148165
columns <- colnames(df)
149166
for (i in seq_len(length(meta))) {
150167
info <- meta[[i]]

tests/testthat/test-epidatacall.R

Lines changed: 50 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -160,3 +160,53 @@ test_that("classic only fetch", {
160160
# making sure that fetch_tbl and throws the expected error on classic only
161161
expect_error(epidata_call %>% fetch_tbl(), class = "only_supports_classic_format")
162162
})
163+
164+
test_that("create_epidata_call basic behavior", {
165+
endpoint <- "endpoint"
166+
params <- list()
167+
168+
# Success
169+
meta <- list(
170+
create_epidata_field_info("time_value", "date"),
171+
create_epidata_field_info("value", "float")
172+
)
173+
expected <- list(
174+
endpoint = endpoint,
175+
params = params,
176+
base_url = "https://api.delphi.cmu.edu/epidata/",
177+
meta = meta,
178+
only_supports_classic = FALSE
179+
)
180+
class(expected) <- "epidata_call"
181+
expect_identical(create_epidata_call(endpoint, params, meta = meta), expected)
182+
183+
expected$meta <- list()
184+
expect_identical(create_epidata_call(endpoint, params, meta = NULL), expected)
185+
expect_identical(create_epidata_call(endpoint, params, meta = list()), expected)
186+
})
187+
188+
189+
test_that("create_epidata_call fails when meta arg contains duplicates", {
190+
endpoint <- "endpoint"
191+
params <- list()
192+
193+
# Duplicate names
194+
meta <- list(
195+
create_epidata_field_info("time_value", "date"),
196+
create_epidata_field_info("time_value", "int")
197+
)
198+
expect_error(
199+
create_epidata_call(endpoint, params, meta = meta),
200+
class = "epidatr__duplicate_meta_names"
201+
)
202+
203+
# Duplicate entries
204+
meta <- list(
205+
create_epidata_field_info("time_value", "date"),
206+
create_epidata_field_info("time_value", "date")
207+
)
208+
expect_error(
209+
create_epidata_call(endpoint, params, meta = meta),
210+
class = "epidatr__duplicate_meta_entries"
211+
)
212+
})

tests/testthat/test-model.R

Lines changed: 28 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -69,7 +69,32 @@ test_that("null parsing", {
6969
})
7070

7171
test_that("parse invalid time", {
72-
vale <- list(3)
73-
vale$class <- "my nonexistant class"
74-
expect_error(parse_timeset_input(vale))
72+
value <- list(3)
73+
value$class <- "my nonexistant class"
74+
expect_error(parse_timeset_input(value))
75+
})
76+
77+
test_that("parse_data_frame warns when df contains fields not listed in meta", {
78+
epidata_call <- pub_flusurv(
79+
locations = "ca",
80+
epiweeks = 202001,
81+
fetch_args = fetch_args_list(dry_run = TRUE)
82+
)
83+
# see generate_test_data.R
84+
mock_df <- as.data.frame(readr::read_rds(testthat::test_path("data/flusurv-epiweeks.rds")))
85+
86+
# Success when meta and df fields match exactly
87+
expect_no_warning(parse_data_frame(epidata_call, mock_df))
88+
89+
# Warning when df contains extra fields
90+
mock_df$extra <- 5
91+
expect_warning(
92+
parse_data_frame(epidata_call, mock_df),
93+
class = "epidatr__missing_meta_fields"
94+
)
95+
mock_df$extra <- NULL
96+
97+
# Success when meta contains extra fields
98+
mock_df$rate_age_0 <- NULL
99+
expect_no_warning(parse_data_frame(epidata_call, mock_df))
75100
})

0 commit comments

Comments
 (0)