From deb869f632e5d39c03ecb0030254b9c8b07d227a Mon Sep 17 00:00:00 2001 From: mps9506 Date: Wed, 22 Oct 2025 14:23:48 -0400 Subject: [PATCH 1/2] download_dem --- NAMESPACE | 3 + R/SELECTRdata-package.R | 2 + R/download_dem.R | 126 ++++++++++++++++++++++++++++++++++++++++ man/download_dem.Rd | 37 ++++++++++++ 4 files changed, 168 insertions(+) create mode 100644 R/download_dem.R create mode 100644 man/download_dem.Rd diff --git a/NAMESPACE b/NAMESPACE index 3e1f522..967bd6e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,6 +4,7 @@ export(download_NPDES_permits) export(download_buildings) export(download_census_blocks) export(download_counties) +export(download_dem) export(download_nass_census) export(download_nass_livestock) export(download_nlcd) @@ -26,6 +27,7 @@ importFrom(httr2,req_url_path_append) importFrom(httr2,req_url_query) importFrom(httr2,resp_body_json) importFrom(httr2,resp_body_string) +importFrom(httr2,resp_body_xml) importFrom(lifecycle,deprecated) importFrom(rlang,"!!!") importFrom(rlang,abort) @@ -44,3 +46,4 @@ importFrom(terra,setGDALconfig) importFrom(terra,vect) importFrom(terra,writeRaster) importFrom(terra,writeVector) +importFrom(xml2,as_list) diff --git a/R/SELECTRdata-package.R b/R/SELECTRdata-package.R index 8e9fb75..fb1e0c5 100644 --- a/R/SELECTRdata-package.R +++ b/R/SELECTRdata-package.R @@ -17,6 +17,7 @@ #' @importFrom httr2 req_url_query #' @importFrom httr2 resp_body_json #' @importFrom httr2 resp_body_string +#' @importFrom httr2 resp_body_xml #' @importFrom lifecycle deprecated #' @importFrom rlang !!! #' @importFrom rlang abort @@ -34,5 +35,6 @@ #' @importFrom terra vect #' @importFrom terra writeRaster #' @importFrom terra writeVector +#' @importFrom xml2 as_list ## usethis namespace: end NULL diff --git a/R/download_dem.R b/R/download_dem.R new file mode 100644 index 0000000..b40fcb9 --- /dev/null +++ b/R/download_dem.R @@ -0,0 +1,126 @@ +#' Download digital elevation model +#' +#' Downloads a 1/3 arc-second high resolution seamless USGS DEM raster. Standard DEMs represent the topographic surface of the earth and contain flattened water surfaces. +#' +#' @param x Either a SpatVector, SpatRaster, or SpatExtent. Or object that a SpatExtent can be retrieved from. +#' @param srs character in : format of the spatial reference system used in `x` if it is a SpatExtent object. Defaults NULL, can be left NULL if x is a SpatVector or SpatRaster. +#' @param output A character file path specifying where the raster file should be stored. Defaults to a temporary file. +#' +#' @return A SpatRaster object. +#' @export +#' +#' @seealso [terra::SpatExtent()] +#' @examples +#' library(terra) +#' location_of_interest <- system.file("extdata", "thompsoncreek.tif", package = "SELECTRdata") +#' location_of_interest <- terra::rast(location_of_interest) +#' extent <- ext(location_of_interest) +#' extent <- vect(extent, crs = crs(location_of_interest)) +#' extent <- project(extent, "EPSG:6579") +#' auth <- crs(extent, describe = TRUE) +#' auth <- paste0(auth$authority, ":", auth$code) +#' extent <- ext(extent) +#' example_dem <- download_dem(x = extent, srs = auth) +#' plot(example_dem) + +download_dem <- function(x, + srs = NULL, + output = tempfile(fileext = ".tiff")) { + + ## see https://github.com/ropensci/terrainr and https://apps.nationalmap.gov/services/ + + ## are we online? + ## check connectivity + if (!isTRUE(check_connectivity("elevation.nationalmap.gov"))) { + return(invisible(NULL)) + } + + ## if extent, we need the crs + ## if SpatVector or SpatRaster we can use crs(x, describe = TRUE) + if (inherits(x, c("SpatExtent"))) { + if (is.null(srs)) { + cli::cli_abort("A valid srs must be supplied to {.arg srs} when {.arg x} is a {.cls SpatExtent} object. Use the : notation, for example 'epsg:3857'.") + } + } + if (inherits(x, c("SpatRaster", "SpatVector"))) { + if (is.null(srs)) { + srs <- crs(x, describe = TRUE) + srs <- paste0(srs$authority, ":", srs$code) + ## convert to extent + x <- terra::ext(x) + } else { + ## check that srs is in the correct format : + if(!grepl("^epsg:\\d+$", srs, ignore.case = TRUE)) { + cli::cli_abort("A valid srs must be supplied to {.arg srs} when {.arg x} is a {.cls SpatExtent} object. Use the : notation, for example 'epsg:3857' or NULL when {.arg x} is a {.cls SpatRaster} or {.cls SpatVector} object.") + } + } + } + + ## call api + x <- request_dem_download(extent = x, + crs = srs, + download_path = output) + return(x) + + + } + + + +request_dem_download <- function(resource = "https://elevation.nationalmap.gov/arcgis/rest/services/3DEPElevation/ImageServer/exportImage", + extent, + crs, #input crs in : format + download_path, + ...) { + check_is_extent(extent) + + ## return bbox as string: BBOX=xmin,ymin,xmax,ymax from SpatExtent + bbox = paste0(as.vector(extent)["xmin"], + ",", + as.vector(extent)["ymin"], + ",", + as.vector(extent)["xmax"], + ",", + as.vector(extent)["ymax"]) + + bboxSR <- sub("^EPSG:", "", crs, ignore.case = TRUE) + + + req <- httr2::request(resource) + + query_list <- list( + bbox = bbox, + format = "tiff", + f = "image", # response format + bboxSR = bboxSR, ## use crs arg + imageSR = bboxSR, ## not sure if we have to return 3857 or can return the same as the input crs + pixelType = "F32", + noDataInterpretation = "esriNoDataMatchAny", + interpolation = "+RSP_BilinearInterpolation" + ) + + + req <- httr2::req_url_query(req, !!!query_list) + + download_path <- tempfile(fileext = ".tif") + + + x_resp <- httr2::req_perform(req, path = download_path) + + ## to do, check http status and return msg and invisible null as needed + + ## check the output type, if xml then need to return message and invisible null + ## else move on to loading raster as terra rast object + + if(httr2::resp_content_type(x_resp) != "image/tiff") { + msg <- httr2::resp_body_xml(x_resp, check_type = FALSE) + msg <- xml2::as_list(msg) + cli::cli_alert(msg) + return(invisible(NULL)) + } + + ## make into a terra raster + dem <- terra::rast(download_path) + return(dem) + +} diff --git a/man/download_dem.Rd b/man/download_dem.Rd new file mode 100644 index 0000000..6dfea9d --- /dev/null +++ b/man/download_dem.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/download_dem.R +\name{download_dem} +\alias{download_dem} +\title{Download digital elevation model} +\usage{ +download_dem(x, srs = NULL, output = tempfile(fileext = ".tiff")) +} +\arguments{ +\item{x}{Either a SpatVector, SpatRaster, or SpatExtent. Or object that a SpatExtent can be retrieved from.} + +\item{srs}{character in \if{html}{\out{}}:\if{html}{\out{}} format of the spatial reference system used in \code{x} if it is a SpatExtent object. Defaults NULL, can be left NULL if x is a SpatVector or SpatRaster.} + +\item{output}{A character file path specifying where the raster file should be stored. Defaults to a temporary file.} +} +\value{ +A SpatRaster object. +} +\description{ +Downloads a 1/3 arc-second high resolution seamless USGS DEM raster. Standard DEMs represent the topographic surface of the earth and contain flattened water surfaces. +} +\examples{ +library(terra) +location_of_interest <- system.file("extdata", "thompsoncreek.tif", package = "SELECTRdata") +location_of_interest <- terra::rast(location_of_interest) +extent <- ext(location_of_interest) +extent <- vect(extent, crs = crs(location_of_interest)) +extent <- project(extent, "EPSG:6579") +auth <- crs(extent, describe = TRUE) +auth <- paste0(auth$authority, ":", auth$code) +extent <- ext(extent) +example_dem <- download_dem(x = extent, srs = auth) +plot(example_dem) +} +\seealso{ +\code{\link[terra:SpatExtent-class]{terra::SpatExtent()}} +} From d179961729471e5f6c667ee7e96b776e0a27708b Mon Sep 17 00:00:00 2001 From: mps9506 Date: Wed, 22 Oct 2025 14:58:05 -0400 Subject: [PATCH 2/2] document --- DESCRIPTION | 2 +- NEWS.md | 6 ++++++ R/download_dem.R | 2 +- man/download_dem.Rd | 2 +- 4 files changed, 9 insertions(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 2654ddb..a3fbf0a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ Type: Package Package: SELECTRdata Title: Download and Format Spatially Explicit Load Enrichment Calculation Tool ('SELECT') Data -Version: 0.1.1 +Version: 0.1.2 Authors@R: person("Michael", "Schramm", , "mpschramm@gmail.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0003-1876-6592")) diff --git a/NEWS.md b/NEWS.md index 01c7e1e..3218b7b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,9 @@ +# SELECTRdata 0.1.2 (2025-10-22) + +## New Features + + * Download USGS seamless DEMs with `download_dem()` + # SELECTRdata 0.1.1 (2025-10-01) ## Bug Fixes diff --git a/R/download_dem.R b/R/download_dem.R index b40fcb9..a38fab2 100644 --- a/R/download_dem.R +++ b/R/download_dem.R @@ -3,7 +3,7 @@ #' Downloads a 1/3 arc-second high resolution seamless USGS DEM raster. Standard DEMs represent the topographic surface of the earth and contain flattened water surfaces. #' #' @param x Either a SpatVector, SpatRaster, or SpatExtent. Or object that a SpatExtent can be retrieved from. -#' @param srs character in : format of the spatial reference system used in `x` if it is a SpatExtent object. Defaults NULL, can be left NULL if x is a SpatVector or SpatRaster. +#' @param srs character in `:` format of the spatial reference system used in `x` if it is a SpatExtent object. Defaults NULL, can be left NULL if x is a SpatVector or SpatRaster. #' @param output A character file path specifying where the raster file should be stored. Defaults to a temporary file. #' #' @return A SpatRaster object. diff --git a/man/download_dem.Rd b/man/download_dem.Rd index 6dfea9d..392ec33 100644 --- a/man/download_dem.Rd +++ b/man/download_dem.Rd @@ -9,7 +9,7 @@ download_dem(x, srs = NULL, output = tempfile(fileext = ".tiff")) \arguments{ \item{x}{Either a SpatVector, SpatRaster, or SpatExtent. Or object that a SpatExtent can be retrieved from.} -\item{srs}{character in \if{html}{\out{}}:\if{html}{\out{}} format of the spatial reference system used in \code{x} if it is a SpatExtent object. Defaults NULL, can be left NULL if x is a SpatVector or SpatRaster.} +\item{srs}{character in \verb{:} format of the spatial reference system used in \code{x} if it is a SpatExtent object. Defaults NULL, can be left NULL if x is a SpatVector or SpatRaster.} \item{output}{A character file path specifying where the raster file should be stored. Defaults to a temporary file.} }