add VPU and download utils.

DESCRIPTION

@@ -1,13 +1,15 @@
 Package: hfsubsetR
 Type: Package
 Title: Hydrofabric Subsetter
-Description: Subset Hydrofabric Data in R
-Version: 0.3.1
+Description: Subset Hydrofabric Data in R.
+Version: 0.3.2
 Authors@R: 
     c(person(given = "Mike", 
-             family = "Johnson", role = c("aut", "cre"),
+             family = "Johnson", 
+             role = c("aut", "cre"),
              email = "[email protected]"),
-             person(given = "Justin", family = "Singh-Mohudpur", role = c("aut")))
+             person(given = "Justin", family = "Singh-Mohudpur", 
+             role = c("aut")))
 Maintainer: Mike Johnson <[email protected]>
 BugReports: https://github.com/lynker-spatial/hfsubsetR
 URL: https://github.com/lynker-spatial/hfsubsetR  
@@ -19,6 +21,7 @@ Imports:
     dplyr,
     dbplyr,
     glue,
+    httr,
     jsonlite,
     nhdplusTools,
     sf,
@@ -45,4 +48,5 @@ Collate:
     'query_subset.R'
     'sf_arrow.R'
     'sf_ogr.R'
+    'utils.R'
     'zzz.R'

NAMESPACE

@@ -8,7 +8,9 @@ export(OGRSQL)
 export(as_ogr)
 export(collect)
 export(find_origin)
+export(get_hydrofabric)
 export(get_subset)
+export(get_vpu_fabric)
 export(query)
 export(query_set_id)
 export(query_set_layers)
@@ -67,6 +69,9 @@ importFrom(dplyr,rename)
 importFrom(dplyr,select)
 importFrom(dplyr,tbl)
 importFrom(glue,glue)
+importFrom(httr,GET)
+importFrom(httr,progress)
+importFrom(httr,write_disk)
 importFrom(jsonlite,toJSON)
 importFrom(methods,callNextMethod)
 importFrom(methods,new)

R/find_origin.R

@@ -11,6 +11,7 @@ find_origin <- function(
   type = c("id", "comid", "hl_uri", "poi_id", "nldi_feature", "xy")
 ) {
 
+  hydroseq <- NULL
   type <- match.arg(type)
   query <- structure(id, class = type)
 
@@ -65,6 +66,7 @@ find_origin_query.id <- function(id, network) {
 #' @method find_origin_query comid
 #' @keywords internal
 find_origin_query.comid <- function(comid, network) {
+  hf_id <- NULL
   comid <- unclass(comid)
   dplyr::filter(network, hf_id == !!comid)
 }

R/hfsubsetR-package.R

@@ -13,4 +13,5 @@
 #' @importFrom glue glue
 #' @importFrom dplyr tbl select mutate rename if_any filter everything distinct collect any_of `%>%`
 #' @importFrom arrow open_dataset
+#' @importFrom httr GET progress write_disk
 NULL

R/query_subset.R

@@ -4,6 +4,8 @@
 #' @export
 query_subset <- function(query) {
 
+  vpuid <- NULL
+
   identifier <- query_get_id(query)
 
   origin <- find_origin(
@@ -48,7 +50,7 @@ query_subset <- function(query) {
 #' @keywords internal
 #' 
 query_extract <- function(query) {
-
+  vpuid <- poi_id <- NULL
   layers  <- query_get_layers(query)
   result  <- new.env(size = length(layers))
   outfile <- query_get_sink(query)

R/utils.R

@@ -0,0 +1,95 @@
+#' @title Get VPU Fabric
+#' @description Retrieve and Process Vector Processing Unit (VPU) Hydrofabric Layers
+#'
+#' This function retrieves and optionally filters spatial data layers from a GeoPackage (GPKG) based on a specified 
+#' Vector Processing Unit ID (VPU ID). The function can either return the filtered layers as a list or write them to an output file.
+#'
+#' @param gpkg A string specifying the path to the GeoPackage file.
+#' @param vpuid A vector of VPU IDs to filter the layers. If `NULL`, no filtering is applied. Default is `NULL`.
+#' @param outfile A string specifying the path to write the filtered layers to a new GeoPackage. If `NULL`, the layers 
+#' are returned as a list. Default is `NULL`.
+#'
+#' @return If `outfile` is `NULL`, returns a list where each element is a filtered spatial layer (`sf` object). 
+#' If `outfile` is provided, returns the path to the output GeoPackage.
+#'
+#' @details The function reads all layers from the provided GeoPackage, excluding the "error" layer. For each layer, 
+#' the data is optionally filtered by the provided `vpuid` and then processed into `sf` objects. 
+#' If an output file path is provided, the filtered layers are written to a new GeoPackage. Otherwise, 
+#' the layers are stored in a list and returned.
+#'
+#' @examples
+#' \dontrun{
+#' # Example 1: Retrieve filtered layers as a list
+#' fabric <- get_vpu_fabric("path/to/geopackage.gpkg", vpuid = c("01", "02"))
+#'
+#' # Example 2: Write filtered layers to a new GeoPackage
+#' get_vpu_fabric("path/to/geopackage.gpkg", vpuid = c("01", "02"), outfile = "output.gpkg")
+#' }
+#' @export
+
+get_vpu_fabric = function(gpkg, vpuid = NULL, outfile = NULL){
+
+  lyrs <- sf::st_layers(gpkg)$name
+  lyrs <- lyrs[lyrs != "error"]
+
+  fabric = list()
+
+  for(i in lyrs){
+    layer_data = dplyr::filter(as_ogr(gpkg, i), vpuid %in% !!vpuid) |> 
+      st_as_sf()
+
+    if (!is.null(outfile)) {
+      sf::write_sf(layer_data, outfile, i)
+    } else {
+      fabric[[i]] = layer_data
+    }
+  }
+
+  if (!is.null(outfile)) {
+    return(outfile)
+  } else {
+    return(fabric)
+  }
+}
+
+#' @title Download a Hydrofabric Geopackage
+#'
+#' @description Downloads a hydrofabric Geopackage from a specified URL and saves it to a local file.
+#'
+#' @param url A character string specifying the base URL of the hydrofabric repository. Defaults to `'https://lynker-spatial.s3-us-west-2.amazonaws.com/hydrofabric'`.
+#' @param version A character string indicating the version of the hydrofabric to download. Defaults to `'2.2'`.
+#' @param domain A character string specifying the geographic domain of the hydrofabric. Defaults to `'conus'`.
+#' @param type A character string indicating the type of hydrofabric. Defaults to `'nextgen'`.
+#' @param outfile A character string specifying the path to save the downloaded file. If `NULL`, the file will not be saved. Defaults to `NULL`.
+#' @param overwrite A logical value indicating whether to overwrite an existing file. Defaults to `FALSE`.
+#' @return The function returns the path to the downloaded file (`outfile`).
+#'
+#' @examples
+#' \dontrun{
+#' # Download the default hydrofabric file
+#' get_hydrofabric(outfile = "conus_nextgen.gpkg")
+#'
+#' # Specify a different domain and version
+#' get_hydrofabric(
+#'   version = "3.0",
+#'   domain = "hawaii",
+#'   outfile = "hawaii_nextgen.gpkg",
+#'   overwrite = TRUE
+#' )
+#' }
+#' @export
+
+get_hydrofabric = function(url = 'https://lynker-spatial.s3-us-west-2.amazonaws.com/hydrofabric',
+                           version = '2.2',
+                           domain = 'conus',
+                           type = 'nextgen',
+                           outfile = NULL,
+                           overwrite = FALSE){
+
+  httr::GET(glue('{url}/v{version}/{domain}/{domain}_{type}.gpkg'), 
+            httr::write_disk(outfile, overwrite = !!overwrite), 
+            httr::progress())
+
+  return(outfile)
+
+}