Merge pull request #151 from JedGrabman/dev_multi_geo_value

Make use of new support for multiple geo_values in one request

Author: capnrefsmmat

R-packages/covidcast/R/covidcast.R

@@ -220,10 +220,8 @@ covidcast_signal <- function(data_source, signal,
     issues <- as.Date(issues)
   }
 
-  df <- purrr::map_dfr(geo_values, function(geo_val) {
-    single_geo(data_source, signal, start_day, end_day, geo_type, geo_val,
-               as_of, issues, lag)
-  })
+  df <- covidcast_days(data_source, signal, start_day, end_day, geo_type,
+                       geo_values, as_of, issues, lag)
 
   # Drop direction column (if it still exists)
   df$direction <- NULL
@@ -473,35 +471,57 @@ summary.covidcast_meta = function(object, ...) {
 
 ##########
 
-# Helper function, not user-facing, to fetch a single geo-value.
-# covidcast_signal can then loop over multiple geos to produce its result.
-single_geo <- function(data_source, signal, start_day, end_day, geo_type,
+# Helper function, not user-facing, to loop through a sequence of days, call
+# covidcast for each one and combine the results
+covidcast_days <- function(data_source, signal, start_day, end_day, geo_type,
                        geo_value, as_of, issues, lag) {
   ndays <- as.numeric(end_day - start_day)
   dat <- list()
 
   # The API limits the number of rows that can be returned at once, so we query
   # each day separately.
   for (i in seq(ndays + 1)) {
-    day <- date_to_string(start_day + i - 1)
+    query_day <- start_day + i - 1
+    day_str <- date_to_string(query_day)
     dat[[i]] <- covidcast(data_source = data_source,
                           signal = signal,
                           time_type = "day",
                           geo_type = geo_type,
-                          time_values = day,
+                          time_values = day_str,
                           geo_value = geo_value,
                           as_of = as_of,
                           issues = issues,
                           lag = lag)
     message(sprintf("Fetched day %s: %s, %s, num_entries = %s",
-                    day, dat[[i]]$result, dat[[i]]$message,
+                    query_day,
+                    dat[[i]]$result,
+                    dat[[i]]$message,
                     nrow(dat[[i]]$epidata)))
-
-    if (dat[[i]]$message != "success") {
-      warn(paste0("Fetching ", signal, " from ", data_source, " for ", day,
-                  " in geography '", geo_value, "': ", dat[[i]]$message, "."),
-           data_source = data_source, signal = signal, day = day,
-           geo_value = geo_value, msg = dat[[i]]$message,
+    if (dat[[i]]$message == "success") {
+      returned_geo_values <- dat[[i]]$epidata$geo_value
+      missed_geos <- setdiff(tolower(geo_value), tolower(returned_geo_values))
+      if (length(missed_geos) > 0) {
+        missed_geos_str <- paste0(missed_geos, collapse = ", ")
+        warn(message =
+               sprintf("Data not fetched for some geographies on %s: %s",
+                       query_day, missed_geos_str),
+             data_source = data_source,
+             signal = signal,
+             day = query_day,
+             geo_value = geo_value,
+             msg = dat[[i]]$message,
+             class = "covidcast_missing_geo_values"
+             )
+      }
+    } else {
+      warn(paste0("Fetching ", signal, " from ", data_source, " for ",
+                  query_day, " in geography '", geo_value, "': ",
+                  dat[[i]]$message),
+           data_source = data_source,
+           signal = signal,
+           day = query_day,
+           geo_value = geo_value,
+           msg = dat[[i]]$message,
            class = "covidcast_fetch_failed")
     }
   }
@@ -548,7 +568,10 @@ covidcast <- function(data_source, signal, time_type, geo_type, time_values,
     time_values = .list(time_values),
     geo_value = geo_value
   )
-
+  if (length(params$geo_value) > 1) {
+    params$geo_values <- paste0(params$geo_value, collapse = ",") #convert to string
+    params$geo_value <- NULL
+  }
   if (!is.null(as_of)) {
     params$as_of <- date_to_string(as_of)
   }