Merge pull request #33 from USEPA/LakeCat

Lake cat

R/lc_get_data.R

@@ -0,0 +1,203 @@
+#' @title Get LakeCat data
+#'
+#' @description
+#' Function to return LakeCat metrics using the StreamCat API.  The function allows a user to get
+#' specific metric data aggregated by area of interest, returned by comid(s), hydroregion(s), state(s), or county(ies).
+#'
+#' @author
+#' Marc Weber
+#'
+#' @param metric Name(s) of metrics to query
+#' Syntax: name=<name1>,<name2>
+#'
+#' @param aoi Specify the area of interest described by a metric. By default, all available areas of interest
+#' for a given metric are returned.
+#' Syntax: areaOfInterest=<value1>,<value2>
+#' Values: catchment|watershed|
+#'
+#' @param comid Return metric information for specific COMIDs.  Needs to be a character string
+#' and function will convert to this format if needed.
+#' Syntax: comid=<comid1>,<comid2>
+#'
+#' @param showAreaSqKm Return the area in square kilometers of a given area of interest.
+#' The default value is false.
+#' Values: true|false
+#'
+#' @param showPctFull Return the pctfull for each dataset. The default value is false.
+#' Values: true|false
+#'
+#' @param countOnly Return a CSV containing only the row count (ROWCOUNT) and the column
+#' count (COLUMNCOUNT) that the server expects to return in a request. The default value is false.
+#' Values: true|false
+#'
+#' @return A tibble of desired StreamCat metrics
+#'
+#' @examples
+#' \donttest{
+#' df <- lc_get_data(comid='23794487', aoi='catchment', metric='fert')
+#'
+#' df <- lc_get_data(metric='PctUrbMd2006', aoi='watershed',
+#' comid='24083377')
+#'
+#' df <- lc_get_data(metric='PctUrbMd2006', aoi='watershed',
+#' comid='24083377', showAreaSqKm=FALSE, showPctFull=TRUE)
+#'
+#' df <- lc_get_data(metric='PctUrbMd2006,DamDens',
+#' aoi='catchment,watershed', comid='23783629,23794487,23812618')
+#'
+#' df <- lc_get_data(metric='PctUrbMd2006,DamDens',
+#' aoi='catchment,watershed', comid='23783629,23794487,23812618',
+#' countOnly=TRUE)
+#'
+#'  }
+#' @export
+
+lc_get_data <- function(metric = NULL,
+                        aoi = NULL,
+                        comid = NULL,
+                        showAreaSqKm = NULL,
+                        showPctFull = NULL,
+                        conus = NULL,
+                        countOnly = NULL) {
+  # Base API URL.
+  req <- httr2::request("https://java.epa.gov/StreamCAT/LakeCat/metrics?")
+  # Collapse comids into a single string separated by a comma.
+  if (!is.null(comid))
+    comid <- paste(comid, collapse = ",")
+  # Create the query based on user inputs.
+  # req_url_query silently ignores NULLs.
+  query <-  httr2::req_url_query(
+    .req = req,
+    name = metric,
+    comid = comid,
+    areaOfInterest = aoi,
+    showAreaSqKm = showAreaSqKm,
+    showPctFull = showPctFull,
+    conus = conus,
+    countOnly = countOnly
+  )
+  # Send HTTP request
+  resp <- httr2::req_perform(req = query)
+  # Extract the body of the response.
+  resp_body <- httr2::resp_body_string(resp, encoding = "UTF-8")
+  # Transform the string response into a data frame.
+  final_df <- utils::read.csv(text = resp_body,
+                              fileEncoding = "UTF8")
+  # End of function. Return a data frame.
+  return(final_df)
+}
+
+#' @title Get NLCD Data
+#'
+#' @description
+#' Function to specifically retrieve all NLCD metrics for a given year using the StreamCat API.
+#'
+#' @author
+#' Marc Weber
+#'
+#' @param year Years(s) of NLCD metrics to query.
+#' Only valid NLCD years are accepted (i.e. 2001, 2004, 2006, 2008,
+#' 2011, 2013, 2016, 2019)
+#' Syntax: year=<year1>,<year2>
+#'
+#' @param aoi Specify the area of interest described by a metric. By default, all available areas of interest
+#' for a given metric are returned.
+#' Syntax: areaOfInterest=<value1>,<value2>
+#' Values: catchment|watershed|riparian_catchment|riparian_watershed|other
+#'
+#' @param comid Return metric information for specific COMIDs
+#' Syntax: comid=<comid1>,<comid2>
+#'
+#' @param showAreaSqKm Return the area in square kilometers of a given area of interest.
+#' The default value is false.
+#' Values: true|false
+#'
+#' @param showPctFull Return the pctfull for each dataset. The default value is false.
+#' Values: true|false
+#'
+#' @param countOnly Return a CSV containing only the row count (ROWCOUNT) and the column
+#' count (COLUMNCOUNT) that the server expects to return in a request. The default value is false.
+#' Values: true|false
+#'
+#' @return A tibble of desired StreamCat metrics
+#'
+#' @examples
+#' \donttest{
+#'
+#' df <- lc_nlcd(comid='23783629', year='2019', aoi='watershed')
+#'
+#' df <- lc_nlcd(year='2016', aoi='catchment',
+#' comid='23783629,23794487,23812618', showAreaSqKm=FALSE, showPctFull=TRUE)
+#'
+#' df <- lc_nlcd(year='2016', aoi='catchment',
+#' comid='23783629,23794487,23812618', countOnly=TRUE)
+#'
+#' df <- lc_nlcd(year='2016, 2019', aoi='catchment,watershed',
+#' comid='23783629,23794487,23812618')
+#' }
+#' @export
+
+
+lc_nlcd <- function(year = '2019', aoi = NULL, comid = NULL,
+                    showAreaSqKm = NULL, showPctFull = NULL,
+                    countOnly = NULL) {
+  # year must be a character string.
+  year_chr <-  as.character(year)
+  # split multiple years supplied as a single string into
+  # a vector of years.
+  year_vec <- unlist(strsplit(x = year_chr,
+                              split = ",|, "))
+  # Vector of valid NLCD years to check inputs against.
+  valid_years <- c('2001',
+                   '2004',
+                   '2006',
+                   '2008',
+                   '2011',
+                   '2013',
+                   '2016',
+                   '2019')
+  # Stop early if any of the year(s) supplied are not found in the valid
+  # years vec.
+  stopifnot(
+    "year must be a valid NLCD land cover year: 2001, 2004,
+         2006, 2008, 2011, 2013, or 2019" = any(year_vec %in% valid_years)
+  )
+  # Vector of NLCD metric names.
+  nlcd <- c(
+    'PctMxFst',
+    'PctOw',
+    'PctShrb',
+    'PctUrbHi',
+    'PctUrbLo',
+    'PctUrbMd',
+    'PctUrbOp',
+    'PctWdWet',
+    'PctBl',
+    'PctConif',
+    'PctCrop',
+    'PctDecid',
+    'PctGrs',
+    'PctHay',
+    'PctHbWet',
+    'PctIce'
+  )
+  # Create a data frame of all NLCD Metric and year combinations.
+  all_comb <- expand.grid(nlcd, year_vec)
+  # Concatenate the NLCD metric name with the supplied year(s) to create
+  # valid metric names to submit to the API.
+  nlcd_mets <- paste0(all_comb$Var1,
+                      all_comb$Var2,
+                      collapse = ",",
+                      recycle0 = TRUE)
+  # Query the API.
+  final_df <- lc_get_data(
+    metric = nlcd_mets,
+    aoi = aoi,
+    comid = comid,
+    showAreaSqKm = showAreaSqKm,
+    showPctFull = showPctFull,
+    countOnly = countOnly
+  )
+  # End of function. Return a data frame.
+  return(final_df)
+}

R/lc_get_params.R

@@ -0,0 +1,50 @@
+#' @title Get LakeCat Parameters
+#'
+#' @description
+#' Function to return available LakeCat parameters using the StreamCat API.
+#'
+#' @author
+#' Marc Weber
+#'
+#' @param param Either name or area to grab JSON of parameters in API
+#' Syntax: param=<value1>,<value2>
+#' Values: name|area
+#'
+#' @return A list of all the current LakeCat values for a given parameter
+#' @export
+#'
+#' @examples
+#' params <- lc_get_params(param='name')
+#' params <- lc_get_params(param='areaOfInterest')
+
+lc_get_params <- function(param = NULL) {
+  resp <- jsonlite::fromJSON("https://java.epa.gov/StreamCAT/LakeCat/metrics")
+  if (param=='areaOfInterest') params <- resp$parameters$areaOfInterest$options else{
+    params <- resp$parameters$name$options
+  }
+  return(params)
+}
+
+#' @title Lookup Full Metric Name
+#'
+#' @description
+#' Function to retrieve a full metric name based on the short name using the LakeCat API.
+#'
+#' @author
+#' Marc Weber
+#'
+#' @param metric Short metric name
+#' Syntax: metric=value1
+#' Values: metric
+#'
+#' @return A lookup of the full name for a given LakeCat metric
+#' @export
+#'
+#' @examples
+#' fullname <- lc_fullname(metric='name')
+
+lc_fullname <- function(metric = NULL) {
+  resp <- as.data.frame(jsonlite::fromJSON("https://java.epa.gov/StreamCAT/LakeCat/metrics/datadictionary"))
+  result <- resp[resp$dictionary.metric_prefix==metric,1]
+  return(result)
+}

R/sc_get_data.R

@@ -58,6 +58,14 @@
 #'
 #' df <- sc_get_data(metric='PctUrbMd2006,DamDens',
 #' aoi='catchment,watershed', comid='179,1337,1337420')
+#'
+#' df <- sc_get_data(metric='PctUrbMd2006,DamDens',
+#' aoi='catchment,watershed', comid='179,1337,1337420',
+#' showAreaSqKm=FALSE, showPctFull=TRUE)
+#'
+#' df <- sc_get_data(metric='PctUrbMd2006,DamDens',
+#' aoi='catchment,watershed', comid='179,1337,1337420', countOnly=TRUE)
+#'
 #'  }
 #' @export
 
@@ -155,7 +163,13 @@ sc_get_data <- function(metric = NULL,
 #' \donttest{
 #' df <- sc_nlcd(year='2001', aoi='catchment',comid='179,1337,1337420')
 #'
-#' df <- sc_nlcd(year='2001', aoi='watershed', region='01')
+#' df <- sc_nlcd(comid='1337420', year='2001', aoi='watershed', region='01')
+#'
+#' df <- sc_nlcd(year='2001', aoi='watershed', region='01',
+#' countOnly=TRUE)
+#'
+#' df <- sc_nlcd(year='2001', aoi='watershed', region='01',
+#' showAreaSqKm=FALSE, showPctFull=TRUE)
 #'
 #' df <- sc_nlcd(year='2001, 2006', aoi='catchment,watershed',
 #' comid='179,1337,1337420')

R/sc_get_params.R

@@ -1,21 +1,21 @@
 #' @title Get StreamCat Parameters
-#' 
-#' @description 
-#' Function to return available StreamCat parameters using the StreamCat API.  
-#' 
-#' @author 
+#'
+#' @description
+#' Function to return available StreamCat parameters using the StreamCat API.
+#'
+#' @author
 #' Marc Weber
-#' 
+#'
 #' @param param Either name or area to grab JSON of parameters in API
 #' Syntax: param=<value1>,<value2>
 #' Values: name|area
-#'  
+#'
 #' @return A list of all the current StreamCat values for a given parameter
 #' @export
 #'
 #' @examples
 #' params <- sc_get_params(param='name')
-#' params <- sc_get_params(param='area')
+#' params <- sc_get_params(param='areaOfInterest')
 
 sc_get_params <- function(param = NULL) {
   resp <- jsonlite::fromJSON("https://java.epa.gov/StreamCAT/metrics")
@@ -26,17 +26,17 @@ sc_get_params <- function(param = NULL) {
 }
 
 #' @title Lookup Full Metric Name
-#' 
-#' @description 
-#' Function to retrieve a full metric name based on the short name using the StreamCat API.  
-#' 
-#' @author 
+#'
+#' @description
+#' Function to retrieve a full metric name based on the short name using the StreamCat API.
+#'
+#' @author
 #' Marc Weber
-#' 
+#'
 #' @param metric Short metric name
 #' Syntax: metric=value1
 #' Values: metric
-#'  
+#'
 #' @return A lookup of the full name for a given StreamCat metric
 #' @export
 #'

tests/testthat/test-lc_get_params.R

@@ -0,0 +1,16 @@
+context("Test that lc_get_params is pulling in StreamCat API parameters")
+
+
+test_that("lc_get_params for region parameters", {
+  params <- lc_get_params(param='areaOfInterest')
+  expect_true(exists("params"))
+  expect_equal(params,c("catchment","watershed",
+                        "riparian_catchment",
+                        "riparian_watershed","other"))
+})
+
+test_that("lc_get_params for name parameters", {
+  params <- lc_get_params(param='name')
+  expect_true(exists("params"))
+  expect_equal(length(params),496)
+})

tests/testthat/test-lc_getdata.R

@@ -0,0 +1,19 @@
+context("Test that sc_get_data is pulling in StreamCat API data")
+
+
+test_that("lc_get_data for a sample COMID returns a data frame", {
+            df <- lc_get_data(metric='PctUrbMd2006,pctconif2008,
+                              rddens', aoi='catchment,watershed',
+                              comid='23783629,23794487,23812618')
+            expect_true(exists("df"))
+            expect_equal(nrow(df), 3)
+            expect_equal(ncol(df), 9)
+})
+
+test_that("lc_get_data for a county and ws metrics returns a data frame", {
+            df <- lc_get_data(metric='pctwdwet2006', aoi='watershed',
+                              comid='23794487',showAreaSqKm=FALSE, showPctFull=TRUE)
+            expect_true(exists("df"))
+            expect_equal(nrow(df), 1)
+            expect_equal(ncol(df), 4)
+          })

tests/testthat/test-lc_nlcd.R

@@ -0,0 +1,18 @@
+context("Test that lc_nlcd is pulling in StreamCat API data")
+
+
+test_that("lc_get_data for a sample COMID returns a data frame", {
+            df <- lc_nlcd(year='2001', aoi='catchment',
+                              comid='23783629,23794487,23812618')
+            expect_true(exists("df"))
+            expect_equal(nrow(df), 3)
+            expect_equal(ncol(df), 19)
+})
+
+test_that("lc_get_data for a county and ws metrics returns a data frame", {
+  df <- lc_nlcd(year='2006, 2019', aoi='watershed',
+                comid='23794487',showAreaSqKm=FALSE, showPctFull=TRUE)
+            expect_true(exists("df"))
+            expect_equal(nrow(df), 1)
+            expect_equal(ncol(df), 36)
+          })