refactor almost done...

.Rbuildignore

@@ -26,3 +26,4 @@ bugs/
 ^revdep$
 contributions/
 ^TODO.md$
+^LICENSE\.md$

DESCRIPTION

@@ -28,11 +28,10 @@ Imports:
     future,
     furrr,
     purrr,
-    methods,
     units,
     slippymath,
     curl
-License: MIT
+License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: true
 RoxygenNote: 7.2.3

LICENSE

@@ -0,0 +1,2 @@
+YEAR: 2023
+COPYRIGHT HOLDER: Jeffrey W. Hollister

LICENSE.md

@@ -0,0 +1,21 @@
+# MIT License
+
+Copyright (c) 2023 Jeffrey W. Hollister
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

NEWS.md

@@ -6,6 +6,13 @@ elevatr 1.0.0 (????-??-??)
 - All sf
 - Terra
 
+# Vignette
+- Add location clip example 
+- cleaned up examples (e.g. plot was throwing warning, now max.plot = 1)
+
+# Other Changes
+- Switched to MIT from CCO
+
 elevatr 0.4.4 (2023-05-30)
 =============
 

R/get_elev_point.R

@@ -241,7 +241,7 @@ get_epqs <- function(locations, units = c("meters","feet"),
   #elev_column_name <- make.unique(c(names(locations), "elevation"))
   #elev_column_name <- elev_column_name[!elev_column_name %in% names(locations)]
   elev_column_name <- "elevation"
-  browser()
+
   message("Downloading point elevations:")
 
   progressr::handlers(
@@ -307,8 +307,12 @@ get_aws_points <- function(locations, z = 5, units = c("meters", "feet"),
                            verbose = TRUE, ...){
   units <- match.arg(units)
   dem <- get_elev_raster(locations, z, verbose  = verbose, ...)
-  elevation <- terra::extract(dem, locations)
-  if(units == "feet") {elevation <- elevation * 3.28084}
+  elevation <- units::set_units(terra::extract(dem, locations)[,2], "m")
+  if(units == "feet"){
+    elevation <- as.numeric(units::set_units(elevation, "ft"))
+  } else {
+    elevation <- as.numeric(elevation)
+  }
   locations$elevation <- round(elevation, 2)
   location_list <- list(locations, units)
   location_list

R/internal.R

@@ -40,7 +40,7 @@ get_tilexy <- function(bbx,z){
 #' SpatialPointsDataFrame for point elevation and bbx for raster.
 #' @keywords internal
 loc_check <- function(locations, prj = NULL){
-  
+
   if(is.null(nrow(locations))){
     nfeature <- length(locations) 
   } else {
@@ -67,11 +67,11 @@ loc_check <- function(locations, prj = NULL){
   } else if(any(class(locations) %in% c("SpatRaster", "SpatVector"))){
 
     sf_crs <- sf::st_crs(locations)
-    locations <- sf::st_as_sf(as.points(locations), 
+    locations <- sf::st_as_sf(terra::as.points(locations, values = FALSE), 
                               coords = terra::crds(locations, df = TRUE),
-                              crs = st_as_sf)
+                              crs = sf_crs)
     locations$elevation <- vector("numeric", nrow(locations))
-    if(is.null(prj) |is.null(sf_crs) | is.na(sf_crs)){
+    if((is.null(sf_crs) | is.na(sf_crs)) & is.null(prj)){
       stop("Please supply a valid sf crs via locations or prj.")
     }
   }

tests/testthat/test-internal.R

@@ -51,23 +51,20 @@ test_that("proj_expand works",{
 })
 
 test_that("loc_check errors correctly", {
-
+  empty_rast <- rast(nrow = 1, ncol =1)
   expect_error(get_elev_point(locations = pt_df), 
                "Please supply a valid sf crs via locations or prj.")
   expect_error(get_elev_point(locations = rast_na),
                "Please supply a valid sf crs via locations or prj.")
   expect_error(get_elev_point(locations = sf_sm_na),
                "Please supply an sf object with a valid crs.")
-  expect_error(get_elev_point(locations = rast(), prj = ll_prj),
-               "No distinct points, all values NA.")
 })
 
 test_that("Z of 1 or 0 works in get_tilexy",{
+
+  sf_sm_1 <- get_elev_raster(sf_sm, z = 1, clip = "bbox")
+  sf_sm_0 <- get_elev_raster(sf_sm, z = 0, clip = "bbox")
 
-  suppressWarnings({
-  sf_sm_1 <- get_elev_raster(sf_sm_prj, z = 1, clip = "bbox")
-  sf_sm_0 <- get_elev_raster(sf_sm_prj, z = 0, clip = "bbox")
-  })
   expect_gt(max(res(sf_sm_1)), 0.27)
   expect_gt(max(res(sf_sm_0)), 0.54)
 })

vignettes/introduction_to_elevatr.R

@@ -2,7 +2,7 @@
 ################################################################################
 #Load packages
 ################################################################################
-library("raster")
+library("terra")
 library("knitr")
 library("elevatr")
 library("httr")
@@ -64,26 +64,44 @@ everest_aws_elev
 data(lake)
 elevation <- get_elev_raster(lake, z = 9)
 plot(elevation)
-plot(lake, add=TRUE)
+plot(st_geometry(lake), add = TRUE, col = "blue")
 
 # data.frame example
 elevation_df <- get_elev_raster(examp_df, prj=crs_dd, z = 5)
 plot(elevation_df)
-plot(examp_sf, add = TRUE, col = "black", pch = 19)
+plot(examp_sf, add = TRUE, col = "black", pch = 19, max.plot = 1)
 
 ## ----expand-------------------------------------------------------------------
 # Bounding box on edge
 elev_edge<-get_elev_raster(lake, z = 10)
 plot(elev_edge)
-plot(lake, add = TRUE)
+plot(st_geometry(lake), add = TRUE, col = "blue")
 
 # Use expand to grab additional tiles
 elev_expand<-get_elev_raster(lake, z = 10, expand = 15000)
 plot(elev_expand)
-plot(lake, add = TRUE)
+plot(st_geometry(lake), add = TRUE, col = "blue")
+
+## ----clip_it------------------------------------------------------------------
+lake_buffer <- st_buffer(lake, 1000)
+
+lake_buffer_elev <- get_elev_raster(lake_buffer, z = 9, clip = "locations")
+plot(lake_buffer_elev)
+plot(st_geometry(lake), add = TRUE, col = "blue")
+plot(st_geometry(lake_buffer), add = TRUE)
 
 ## ----timeout------------------------------------------------------------------
 library(httr)
 # Increase timeout:
-get_elev_raster(lake, z = 5, config = timeout(5))
+get_elev_raster(lake, z = 5, config = timeout(100))
+
+## ----timeout_verbose----------------------------------------------------------
+library(httr)
+# Increase timeout:
+get_elev_raster(lake, z = 5, config = c(verbose(),timeout(5)))
+
+## ---- eval=FALSE--------------------------------------------------------------
+#  lake_srtmgl1 <- get_elev_raster(lake, src = "gl1", clip = "bbox", expand = 1000)
+#  plot(lake_srtmgl1)
+#  plot(st_geometry(lake), add = TRUE, col = "blue")
 

vignettes/introduction_to_elevatr.Rmd

@@ -20,7 +20,7 @@ editor_options:
 ################################################################################
 #Load packages
 ################################################################################
-library("raster")
+library("terra")
 library("knitr")
 library("elevatr")
 library("httr")
@@ -145,12 +145,12 @@ There is no difference in using the `sp` and `raster` input data types.  The dat
 data(lake)
 elevation <- get_elev_raster(lake, z = 9)
 plot(elevation)
-plot(lake, add=TRUE)
+plot(st_geometry(lake), add = TRUE, col = "blue")
 
 # data.frame example
 elevation_df <- get_elev_raster(examp_df, prj=crs_dd, z = 5)
 plot(elevation_df)
-plot(examp_sf, add = TRUE, col = "black", pch = 19)
+plot(examp_sf, add = TRUE, col = "black", pch = 19, max.plot = 1)
 ```
 
 The zoom level determines the resolution of the output raster.  More details on resolution and zoom level is still available in the [Mapzen Documentation on ground resolution](https://github.com/tilezen/joerd/blob/master/docs/data-sources.md#what-is-the-ground-resolution).
@@ -161,20 +161,31 @@ In addition the the required arguments (`locations`, `z`, and  `prj` for data fr
 # Bounding box on edge
 elev_edge<-get_elev_raster(lake, z = 10)
 plot(elev_edge)
-plot(lake, add = TRUE)
+plot(st_geometry(lake), add = TRUE, col = "blue")
 
 # Use expand to grab additional tiles
 elev_expand<-get_elev_raster(lake, z = 10, expand = 15000)
 plot(elev_expand)
-plot(lake, add = TRUE)
+plot(st_geometry(lake), add = TRUE, col = "blue")
+```
+
+Second, the `clip` argument provides some control over the extent and shape of the elevation raster that is returned.  The default value returns the entire tile for the "aws" `src`.  The default value for the OpenTopography is also tile, but as these datasets are not served by tile, the "tile" and "bbox" clip return the same elevation raster.  The "locations" clip option will clip the elevation raster to the locations themselves.  If the input locations are points, this is no different that "bbox", however if the input locations are a polygon, the elevation raster will be clipped to the boudary of that polygon.  For example:
+
+```{r clip_it}
+lake_buffer <- st_buffer(lake, 1000)
+
+lake_buffer_elev <- get_elev_raster(lake_buffer, z = 9, clip = "locations")
+plot(lake_buffer_elev)
+plot(st_geometry(lake), add = TRUE, col = "blue")
+plot(st_geometry(lake_buffer), add = TRUE)
 ```
 
 Lastly, `...` provides the ability to pass additional arguments to `httr::GET` which is used to access the API endpoints.  While any `httr::GET` arguments may be used, this will most likely be used to pass on configuration arguments such as `httr::timeout()` or `httr::verbose()` via a named argument, `config` to `httr::GET`.  The `httr::timeout()` can be used to increase the timeout if downloads are timing out.  For instance:
 
 ```{r timeout}
 library(httr)
 # Increase timeout:
-get_elev_raster(lake, z = 5, config = timeout(5))
+get_elev_raster(lake, z = 5, config = timeout(100))
 ```
 
 Lastly, multiple configurations may be passed.  Below is an example combining `httr::timeout()` with `httr::verbose()`.
@@ -200,5 +211,5 @@ Below is an example for grabbing the OpenTopography SRTM data.
 ```{r, eval=FALSE}
 lake_srtmgl1 <- get_elev_raster(lake, src = "gl1", clip = "bbox", expand = 1000)
 plot(lake_srtmgl1)
-plot(lake, add = TRUE)
+plot(st_geometry(lake), add = TRUE, col = "blue")
 ```