CRAN v0.8.0

.github/workflows/coverage.yaml

@@ -0,0 +1,75 @@
+# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
+on:
+  push:
+    branches: [develop]
+  pull_request:
+    branches: [develop]
+
+name: test-coverage
+
+permissions: 
+  contents: write
+  checks: write
+  pull-requests: write
+
+jobs:
+  test-coverage:
+    runs-on: ubuntu-latest
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+
+    steps:
+      - uses: actions/checkout@v4
+
+      - uses: r-lib/actions/setup-r@v2
+        with:
+          use-public-rspm: true
+
+      - uses: r-lib/actions/setup-r-dependencies@v2
+        with:
+          extra-packages: any::covr, any::xml2
+          needs: coverage
+
+      - name: Test coverage
+        run: |
+          cov <- covr::package_coverage(
+            quiet = FALSE,
+            clean = FALSE,
+            install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package")
+          )
+          print(cov)
+          covr::to_cobertura(cov)
+        shell: Rscript {0}
+
+      - name: Show testthat output
+        if: always()
+        run: |
+          ## --------------------------------------------------------------------
+          find '${{ runner.temp }}/package' -name 'testthat.Rout*' -exec cat '{}' \; || true
+        shell: bash
+
+      - name: Upload test results
+        if: failure()
+        uses: actions/upload-artifact@v4
+        with:
+          name: coverage-test-failures
+          path: ${{ runner.temp }}/package
+          if-no-files-found: ignore  # Suppress warnings if no files are found
+
+      - name: Upload coverage report
+        uses: actions/upload-artifact@v4
+        with:
+          name: coverage-report
+          path: ./cobertura.xml
+
+      - name: Comment coverage
+        uses: 5monkeys/cobertura-action@master
+        with:
+          report_name: coverage-report
+          path: ./cobertura.xml
+          minimum_coverage: 10
+          show_missing: true
+          link_missing_lines: true
+
+

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: StreamCatTools
 Type: Package
 Title: 'StreamCatTools'
-Version: 0.7.0
+Version: 0.8.0
 Authors@R: c(person(given = "Marc", 
                     family = "Weber", 
                     role = c("aut", "cre"), 
@@ -22,6 +22,10 @@ Authors@R: c(person(given = "Marc",
                     family = "Rebhuhn",
                     role = "ctb",
                     email = "rebhuhnd@gmail.com"),
+             person(given = "Michael",
+                    family = "Dumelle",
+                    role = "ctb",
+                    email = "dumelle.michael@epa.gov"),       
              person(given = "Zachary",
                     family = "Smith",
                     role = "ctb"))       
@@ -55,6 +59,6 @@ URL: https://usepa.github.io/StreamCatTools/, https://github.com/USEPA/StreamCat
 BugReports: https://github.com/USEPA/StreamCatTools/issues
 VignetteBuilder: knitr,rmarkdown
 LazyData: true
-RoxygenNote: 7.3.2
+RoxygenNote: 7.3.3
 License: CC0
 NeedsCompilation: no

NAMESPACE

@@ -3,10 +3,12 @@
 export(lc_fullname)
 export(lc_get_comid)
 export(lc_get_data)
+export(lc_get_metric_names)
 export(lc_get_params)
 export(lc_nlcd)
 export(sc_fullname)
 export(sc_get_comid)
 export(sc_get_data)
+export(sc_get_metric_names)
 export(sc_get_params)
 export(sc_nlcd)

NEWS.md

@@ -1,3 +1,12 @@
+# StreamCatTools 0.8.0
+
+-   Added code coverage to the package
+-   Added two new functions - `sc_get_metric_names` and `lc_get_metric_names` 
+    to make metric names and descriptions more searchable and slightly updated 
+    parameters in both `sc_get_params` and `lc_get_params` functions
+-   Both `sc_get_data` and `lc_get_data` now accept vectors as well as comma-
+    separated strings for the metric, state, county and region parameters
+
 # StreamCatTools 0.7.0
 
 -   Updated both `sc_get_data` and `lc_get_data` to pass parameters in

R/lc_get_comid.R

@@ -27,7 +27,7 @@
 #' @return A new sf data frame with a populated 'COMID' column
 #'
 #' @examples
-#' \donttest{
+#' \dontrun{
 #' 
 #' dd <- data.frame(x = c(-89.198,-114.125,-122.044),
 #' y = c(45.502,47.877,43.730))

R/lc_get_data.R

@@ -54,7 +54,7 @@
 #' @return A tibble of desired StreamCat metrics. If data are missing for all rows of a given metric, then the column for that metric will not exist. If data are missing for only some rows, then they will be specified with NA.
 #'
 #' @examples
-#' \donttest{
+#' \dontrun{
 #' df <- lc_get_data(comid='23794487', aoi='cat', metric='fert')
 #'
 #' df <- lc_get_data(metric='pcturbmd2006', aoi='ws',
@@ -94,17 +94,29 @@ 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) & is.null(state) & is.null(county) & is.null(region) & is.null(conus)) | is.null(metric) | is.null(aoi)){
+    stop('Must provide at a minimum valid comid, metric and aoi to the function')
+  }
+  # Collapse vectors into a single string separated by a comma.
   if (!is.null(comid)){
     comid <- paste(comid, collapse = ",")
   }
+  metric <- paste(metric, collapse = ",")
+  aoi <- paste(aoi, collapse = ",")
+  if (!is.null(state)){
+    state <- paste(state, collapse = ",")
+  }
+  if (!is.null(county)){
+    county <- paste(county, collapse = ",")
+  }
+  if (!is.null(region)){
+    region <- paste(region, collapse = ",")
+  }
   # Force old and odd naming convention to behave correctly
   if (!is.null(aoi)){
     if (aoi == 'catchment') aoi <- 'cat'
     if (aoi == 'watershed') aoi <- 'ws'
   }
-  if ((is.null(comid) & is.null(state) & is.null(county) & is.null(region) & is.null(conus)) | is.null(metric) | is.null(aoi)){
-    stop('Must provide at a minimum valid comid, metric and aoi to the function')
-  }
   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')
   } 
@@ -178,7 +190,7 @@ lc_get_data <- function(comid = NULL,
 #' @return A tibble of desired StreamCat metrics
 #'
 #' @examples
-#' \donttest{
+#' \dontrun{
 #'
 #' df <- lc_nlcd(comid='23783629', year='2019', aoi='ws')
 #'

R/lc_get_params.R

@@ -8,29 +8,32 @@
 #'
 #' @param param List of available parameters in the API for the following options:
 #' name, areaofInterest, region, state, county.  State and county return a data
-#' frame that includes FIPS codes, names and state abbreviations 
+#' frame that includes FIPS codes, names and state abbreviations
 #' Syntax: param=<value1>,<value2>
 #' Values: name|area
 #'
 #' @return A list of all the current LakeCat values for a given parameter
 #' @export
 #'
 #' @examples
-#' \donttest{
+#' \dontrun{
 #' params <- lc_get_params(param='variable_info')
 #' params <- lc_get_params(param='metric_names')
-#' params <- lc_get_params(param='areaOfInterest')
+#' params <- sc_get_params(param='categories')
+#' params <- lc_get_params(param='aoi')
 #' params <- lc_get_params(param='state')
 #' params <- lc_get_params(param='county')
+#' params <- sc_get_params(param='datasets')
 #' }
 
 lc_get_params <- function(param = NULL) {
   UUID <- DATE_DOWNLOADED <- METADATA <- FINAL_TABLE<- NULL
   INDICATOR_CATEGORY <- METRIC_NAME <- AOI <- YEAR <- NULL
   WEBTOOL_NAME <- METRIC_UNITS <- METRIC_DESCRIPTION <- DSID <- NULL
   SOURCE_NAME <- SOURCE_URL <- UUID <- DATE_DOWNLOADED <- NULL
+  DSNAME <- NULL
   resp <- jsonlite::fromJSON("https://api.epa.gov/StreamCat/lakes/metrics")$items
-  if (param=='areaOfInterest'){
+  if (param=='aoi'){
     params <- strsplit(stringr::str_sub(resp$aoi_param_info[[1]]$options,2,-2),",")[[1]]
     params <- c(gsub(" ","", params),'other')
     params <- params[order(params)]
@@ -40,16 +43,30 @@ lc_get_params <- function(param = NULL) {
     params <- params[!duplicated(params)]
     params <- params[order(params)]
   } else if(param == 'variable_info') {
-    params <- httr2::request('https://api.epa.gov/StreamCat/streams/variable_info') |>
+    params <- httr2::request('https://api.epa.gov/StreamCat/lakes/variable_info') |>
       httr2::req_perform() |>
       httr2::resp_body_string() |>
-      readr::read_csv(show_col_types = FALSE) |> 
-      dplyr::select(-UUID,-DATE_DOWNLOADED,-METADATA) |> 
-      dplyr::rename(dataset=FINAL_TABLE,category=INDICATOR_CATEGORY, 
-                    metric=METRIC_NAME,aoi=AOI, year=YEAR, 
+      readr::read_csv(show_col_types = FALSE) |>
+      dplyr::select(-UUID,-DATE_DOWNLOADED,-METADATA) |>
+      dplyr::rename(dataset=FINAL_TABLE,category=INDICATOR_CATEGORY,
+                    metric=METRIC_NAME,aoi=AOI, year=YEAR,
                     short_description=WEBTOOL_NAME,units=METRIC_UNITS,
                     long_description=METRIC_DESCRIPTION, dsid=DSID,
                     source_name=SOURCE_NAME, source_URL=SOURCE_URL)
+  } else if(param == 'categories'){
+    params <- httr2::request('https://api.epa.gov/StreamCat/lakes/variable_info') |>
+      httr2::req_perform() |>
+      httr2::resp_body_string() |>
+      readr::read_csv(show_col_types = FALSE) |>
+      dplyr::select(INDICATOR_CATEGORY)
+    params <- sort(unique(params$INDICATOR_CATEGORY))
+  } else if(param == 'datasets'){
+    params <- httr2::request('https://api.epa.gov/StreamCat/lakes/variable_info') |>
+      httr2::req_perform() |>
+      httr2::resp_body_string() |>
+      readr::read_csv(show_col_types = FALSE) |>
+      dplyr::select(DSNAME)
+    params <- sort(unique(params$DSNAME[!is.na(params$DSNAME)]))
   } else if(param == 'region'){
     params <- resp$region_options[[1]][[1]]
     params <- params[order(params)]
@@ -93,3 +110,85 @@ lc_fullname <- function(metric = NULL) {
   result <- unique(resp$short_display_name[resp$metric_prefix %in% metric])
   return(result)
 }
+
+#' Get LakeCat Metric Names
+#'
+#' @description
+#' Function to filter LakeCat metrics metrics by category, area of interest,
+#' dataset or year. Use `lc_get_params(categories)` or `lc_get_params(datasets)`
+#' to see all the valid category or dataset options
+#'
+#' @author
+#' Marc Weber
+#'
+#' @param category Filter LakeCat metrics based on the metric category
+#' @param aoi Filter LakeCat metrics based on the area of interest
+#' @param year Filter LakeCat metrics based on a particular year or years
+#' @param dataset Filter LakeCat metrics based on the dataset name
+#'
+#' @return A dataframe of merics and description that match filter criteria
+# #' @importFrom rlang .data
+#' @export
+#'
+#' @examples
+#' \dontrun{
+#' metrics <- lc_get_metric_names(category='Natural')
+#' metrics <- lc_get_metric_names(category = c('Anthropogenic','Natural'),
+#' aoi=c('Cat','Ws')}
+
+
+lc_get_metric_names <- function(category = NULL,
+                                aoi = NULL,
+                                year = NULL,
+                                dataset = NULL) {
+  if (!is.null(aoi)){
+    if (any(stringr::str_detect(aoi,'catchment'))) {
+      aoi <- gsub('catchment','Cat',aoi)
+    }
+    if (any(stringr::str_detect(aoi,'watershed'))) {
+      aoi <- gsub('watershed','Ws',aoi)
+    }
+    if (any(stringr::str_detect(aoi,'riparian_catchment'))) {
+      aoi <- gsub('riparian_catchment','CatRp100',aoi)
+    }
+    if (any(stringr::str_detect(aoi,'riparian_watershed'))) {
+      aoi <- gsub('riparian_watershed','WsRp100',aoi)
+    }
+    aoi <- stringr::str_to_title(aoi)
+  }
+  resp <- params <- httr2::request('https://api.epa.gov/StreamCat/lakes/variable_info') |>
+    httr2::req_perform() |>
+    httr2::resp_body_string() |>
+    readr::read_csv(show_col_types = FALSE)
+
+  filters <- list(INDICATOR_CATEGORY = category, AOI = aoi, YEAR = year,
+                  DSNAME = dataset)
+
+  filter_data <- function(data, filters) {
+    temp_col <- col_name <- NULL
+    # Filter the data frame for each non-null filter
+    filtered_data <- purrr::reduce(
+      names(filters),
+      .init = data,
+      .f = function(df, col_name) {
+        filter_values <- filters[[col_name]]
+        if (!is.null(filter_values)) {
+          temp_col <- stringr::str_split(df[[col_name]], ",")
+          df <- df[purrr::map_lgl(temp_col, ~ any(.x %in% filter_values)), , drop = FALSE]
+        }
+        df
+      }
+    )
+    return(filtered_data)
+  }
+  results <- filter_data(resp, filters)
+  names_keep <- c("INDICATOR_CATEGORY", "METRIC_NAME", "AOI", "YEAR",
+                  "WEBTOOL_NAME", "METRIC_DESCRIPTION",
+                  "METRIC_UNITS", "SOURCE_NAME", "DSNAME")
+  results <- results[, names_keep, drop = FALSE]
+  names_new <- c("Category", "Metric", "AOI", "Year", "Short_Name",
+                 "Metric_Description", "Units", "Source", "Dataset")
+  names(results) <- names_new
+
+  return(results)
+}

R/sc_get_comid.R

@@ -24,15 +24,16 @@
 #' @return A new sf data frame with a populated 'COMID' column
 #'
 #' @examples
-#' \donttest{
+#' \dontrun{
 #' 
 #' dd <- data.frame(x = c(-122.649,-100.348,-75.186,-106.675),
 #' y = c(45.085, 35.405,42.403,38.721))
 #' 
 #' comids <- sc_get_comid(dd, xcoord='x',
 #'                        ycoord='y', crsys=4269)
 #' 
-#' dd <- sf::read_sf(system.file("shape/nc.shp", package="sf"))
+#' dd <- sf::st_point_on_surface(sf::read_sf(system.file("shape/nc.shp", package="sf")))
+#' 
 #' comids <- sc_get_comid(dd)
 #'                                   
 #' comids <- sc_get_comid(dd, xcoord='x', 
@@ -53,10 +54,10 @@ sc_get_comid <- function(dd = NULL, xcoord = NULL,
   } else {
     dd <- sf::st_as_sf(dd, coords = c(xcoord, ycoord), crs = crsys, remove = FALSE)
   }
-
+  geom_col <- attr(dd, "sf_column")
   run_for <- 1:nrow(dd)
   output <- do.call(rbind, lapply(1:nrow(dd), function(i){
-    comid <- nhdplusTools::discover_nhdplus_id(dd[i,c('geometry')])
+    comid <- nhdplusTools::discover_nhdplus_id(dd[i,c(geom_col)])
     if (length(comid)==0L) comid <- NA else comid <- comid
     return(comid)
   }))