Large requests (#69)

* added functionality to accept gt 700 COMIDs in POST header

* incremented package version (minor update)

* updates to accomodate changes for large number of COMIDs in POST header

Author: mhweber

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: StreamCatTools
 Type: Package
 Title: Tools to Work with the StreamCat API Within R and Access the Full Suite of StreamCat and LakeCat Metrics
-Version: 0.5.0
+Version: 0.6.0
 Authors@R: c(person(given = "Marc", 
                     family = "Weber", 
                     role = c("aut", "cre"), 
@@ -47,7 +47,8 @@ Suggests:
   magrittr,
   readr,
   tidyr,
-  stringr
+  stringr,
+  purrr
 Encoding: UTF-8
 URL: https://usepa.github.io/StreamCatTools/, https://github.com/USEPA/StreamCatTools
 VignetteBuilder: knitr,rmarkdown

NEWS.md

@@ -1,3 +1,5 @@
+# StreamCatTools 0.6.0
+
 # StreamCatTools 0.5.0
 -   Overhauled `sc_get_data` and `lc_get_data` functions to be able to pull all metrics from StreamCat or LakeCat for an area of interest
 -   Updated `sc_get_data` and `lc_get_data` to be able to pass hundreds of COMIDs at a time as a function parameter and not error out in call to server

R/lc_get_data.R

@@ -69,7 +69,6 @@
 #' aoi='cat,ws', comid='23783629,23794487,23812618',
 #' countOnly=TRUE)
 #' 
-#' df <- lc_get_data(comid='23783629', aoi='ws', metric='all')
 #'
 #'  }
 #' @export
@@ -87,8 +86,12 @@ lc_get_data <- function(comid = NULL,
   # Base API URL.
   req <- httr2::request('https://api.epa.gov/StreamCat/lakes/metrics')
   # Collapse comids into a single string separated by a comma.
-  if (!is.null(comid))
+  if (!is.null(comid)){
     comid <- paste(comid, collapse = ",")
+    if (length(strsplit(comid, ",")[[1]]) > 700){
+      comids_split <- split(comid, ceiling(seq_along(comid)/700))
+    }
+  }
   # Force old and odd naming convention to behave correctly
   if (!is.null(aoi)){
     if (aoi == 'catchment') aoi <- 'cat'
@@ -100,39 +103,68 @@ lc_get_data <- function(comid = NULL,
   if (!is.null(conus) & metric=='all'){
     stop('If you are requesting all metrics please request for regions, states or counties rather than all of conus')
   } 
+  if (metric=='all'){
+    message("Using metric='all' with a large aoi may take a considerable amount of time to return results - request may timeout if multiple AOIs are requested")
+  }
   metric = tolower(metric)
   items = unlist(strsplit(metric,','))
   items = gsub(" ","",items)
   items = gsub("\n","",items)
   params <- sc_get_params(param='metric_names')
   if (metric != 'all' & !all(items %in% params)){
-    stop("One or more of the provided metric names do not match the expected metric names in StreamCat.  Use sc_get_params(param='name') to list valid metric names for StreamCat")
+    message("One or more of the provided metric names do not match the expected metric names in StreamCat.  Use sc_get_params(param='name') to list valid metric names for StreamCat")
   }
   metric = tolower(metric)
   items = unlist(strsplit(metric,','))
   items = gsub(" ","",items)
   items = gsub("\n","",items)
   params <- sc_get_params(param='metric_names')
   if (metric != 'all' & !all(items %in% params)){
-    stop("One or more of the provided metric names do not match the expected metric names in StreamCat.  Use sc_get_params(param='name') to list valid metric names for StreamCat")
+    message("One or more of the provided metric names do not match the expected metric names in StreamCat.  Use sc_get_params(param='name') to list valid metric names for StreamCat")
   }
-  df <- req |>
-    httr2::req_method("POST") |>
-    httr2::req_headers(comid=comid,aoi=aoi,name=metric,showareasqkm=showAreaSqKm,
-                       showpctfull=showPctFull,state=state,county=county,region=region,
-                       conus=conus,countOnly=countOnly) |>
-    httr2::req_method("POST") |>
-    httr2::req_throttle(rate = 30 / 60) |> 
-    httr2::req_retry(backoff = ~ 5, max_tries = 3) |>  
-    httr2::req_perform() |> 
-    httr2::resp_body_string() |> 
-    jsonlite::fromJSON()
-  # Return a data frame
-  if (is.null(countOnly)){
-    df <- df$items  |> 
-      dplyr::select(comid, dplyr::everything())
+  if (exists('comid_split')){
+    create_post_request <- function(comids) {
+      df <- req |>
+        httr2::req_method("POST") |>
+        httr2::req_headers(comid=comids,aoi=aoi,name=metric,showareasqkm=showAreaSqKm,
+                           showpctfull=showPctFull,state=state,county=county,region=region,
+                           conus=conus,countOnly=countOnly) |>
+        httr2::req_method("POST") |>
+        httr2::req_throttle(rate = 30 / 60) |> 
+        httr2::req_retry(backoff = ~ 5, max_tries = 3) |>  
+        httr2::req_perform() |> 
+        httr2::resp_body_string() |> 
+        jsonlite::fromJSON() 
+      # Return a data frame
+      if (is.null(countOnly)){
+        df <- df$items  |> 
+          dplyr::select(comid, dplyr::everything())
+        return(df)
+      } else return(df$items)
+    }
+    # Create a list of requests using purrr::map()
+    df <- purrr::map_dfr(comids_split, create_post_request)
     return(df)
-  } else return(df$items)
+    
+  } else {
+    df <- req |>
+      httr2::req_method("POST") |>
+      httr2::req_headers(comid=comid,aoi=aoi,name=metric,showareasqkm=showAreaSqKm,
+                         showpctfull=showPctFull,state=state,county=county,region=region,
+                         conus=conus,countOnly=countOnly) |>
+      httr2::req_method("POST") |>
+      httr2::req_throttle(rate = 30 / 60) |> 
+      httr2::req_retry(backoff = ~ 5, max_tries = 3) |>  
+      httr2::req_perform() |> 
+      httr2::resp_body_string() |> 
+      jsonlite::fromJSON()
+    # Return a data frame
+    if (is.null(countOnly)){
+      df <- df$items  |> 
+        dplyr::select(comid, dplyr::everything())
+      return(df)
+    } else return(df$items)
+  }
 }
 
 #' @title Get NLCD Data

R/lc_get_params.R

@@ -88,7 +88,6 @@ lc_get_params <- function(param = NULL) {
 
 lc_fullname <- function(metric = NULL) {
   resp <- jsonlite::fromJSON("https://api.epa.gov/StreamCat/lakes/datadictionary")$items
-  resp <- as.data.frame(resp$dictionary)
-  result <- unique(resp[resp$metric_prefix %in% unlist(strsplit(metric, split = ',')), 1])
+  result <- unique(resp$short_display_name[resp$metric_prefix==metric])
   return(result)
 }

R/sc_get_data.R

@@ -96,6 +96,9 @@ sc_get_data <- function(comid = NULL,
   # Collapse comids into a single string separated by a comma.
   if (!is.null(comid)){
     comid <- paste(comid, collapse = ",")
+    if (length(strsplit(comid, ",")[[1]]) > 700){
+      comids_split <- split(comid, ceiling(seq_along(comid)/700))
+    }
   }
   # Force old and odd naming convention to behave correctly
   if (!is.null(aoi)){
@@ -119,16 +122,41 @@ sc_get_data <- function(comid = NULL,
     stop('If you are requesting all metrics please request for regions, states or counties rather than all of conus')
   } 
   if (metric=='all'){
-    warning("Using metric='all' with a large aoi may take a considerable amount of time to return results - request may timeout if multiple AOIs are requested")
+    message("Using metric='all' with a large aoi may take a considerable amount of time to return results - request may timeout if multiple AOIs are requested")
   }
   metric = tolower(metric)
   items = unlist(strsplit(metric,','))
   items = gsub(" ","",items)
   items = gsub("\n","",items)
   params <- sc_get_params(param='metric_names')
   if (metric != 'all' & !all(items %in% params)){
-    warning("One or more of the provided metric names do not match the expected metric names in StreamCat.  Use sc_get_params(param='name') to list valid metric names for StreamCat")
+    message("One or more of the provided metric names do not match the expected metric names in StreamCat.  Use sc_get_params(param='name') to list valid metric names for StreamCat")
   }
+  if (exists('comid_split')){
+    create_post_request <- function(comids) {
+      df <- req |>
+        httr2::req_method("POST") |>
+        httr2::req_headers(comid=comids,aoi=aoi,name=metric,showareasqkm=showAreaSqKm,
+                           showpctfull=showPctFull,state=state,county=county,region=region,
+                           conus=conus,countOnly=countOnly) |>
+        httr2::req_method("POST") |>
+        httr2::req_throttle(rate = 30 / 60) |> 
+        httr2::req_retry(backoff = ~ 5, max_tries = 3) |>  
+        httr2::req_perform() |> 
+        httr2::resp_body_string() |> 
+        jsonlite::fromJSON() 
+      # Return a data frame
+      if (is.null(countOnly)){
+        df <- df$items  |> 
+          dplyr::select(comid, dplyr::everything())
+        return(df)
+      } else return(df$items)
+    }
+    # Create a list of requests using purrr::map()
+    df <- purrr::map_dfr(comids_split, create_post_request)
+    return(df)
+    
+  } else {
   df <- req |>
     httr2::req_method("POST") |>
     httr2::req_headers(comid=comid,aoi=aoi,name=metric,showareasqkm=showAreaSqKm,
@@ -146,6 +174,7 @@ sc_get_data <- function(comid = NULL,
         dplyr::select(comid, dplyr::everything())
       return(df)
     } else return(df$items)
+  }
 }
 
 

R/sc_get_params.R

@@ -87,6 +87,6 @@ sc_get_params <- function(param = NULL) {
 
 sc_fullname <- function(metric = NULL) {
   resp <- jsonlite::fromJSON("https://api.epa.gov/StreamCat/streams/datadictionary")$items
-  result <- unique(resp[resp$metric_prefix %in% unlist(strsplit(metric, split = ',')), 1])
+  result <- unique(resp$short_display_name[resp$metric_prefix==metric])
   return(result)
 }

man/lc_get_data.Rd

@@ -19,7 +19,7 @@ test_that("lc_get_params for region parameters", {
 test_that("lc_get_params for name parameters", {
   params <- lc_get_params(param='metric_names')
   expect_true(exists("params"))
-  expect_equal(length(params),497)
+  expect_equal(length(params),517)
 })
 
 test_that("lc_get_params for state parameters", {

tests/testthat/test-lc_get_params.R

@@ -99,13 +99,6 @@ df <- lc_get_data(metric='pctwdwet2006', aoi='ws', county='41003')
 knitr::kable(head(df))
 ```
 
-## Get all metrics for COMIDs or an Area of Interest
-We can also get all LakeCat metrics for a set of COMIDs or an area of interest.  **Please do not request all metrics for conus in order not to overload requests to the server.**
-```{r all}
-df <- lc_get_data(comid='23783629', aoi='ws', metric='all')
-knitr::kable(head(df))
-```
-
 ## Get NLCD data
 
 In this example we access National Land Cover Dataset (NLCD) data for 2019, just at the catchment level for several COMIDs using the `lc_nlcd` function. Loads data into a tibble we can view.