allow spatvect inputs #67

mikejohnson51 · Jul 19, 2023 · a1daed9 · a1daed9
1 parent 6261e3b
commit a1daed9
Show file tree

Hide file tree

Showing 5 changed files with 37 additions and 18 deletions.
diff --git a/R/climater_filter.R b/R/climater_filter.R
@@ -170,7 +170,7 @@ climater_filter <- function(id = NULL,
     gid = sapply(1:nrow(catalog), function(x) {
       suppressWarnings({
         tryCatch({
-          nrow(intersect(make_vect(cat = catalog[x, ]), project(vect(AOI), crs(catalog$crs[x])))) > 0
+          nrow(intersect(make_vect(cat = catalog[x, ]), project(spatAOI(AOI), crs(catalog$crs[x])))) > 0
         }, error = function(e) {
           FALSE
         })

diff --git a/R/dap.R b/R/dap.R
@@ -1,3 +1,8 @@
+getExtension = function(x) {
+  pos <- regexpr("\\.([[:alnum:]]+)$", x)
+  ifelse(pos > -1L, substring(x, pos + 1L), "")
+}
+
 #' Parse Dates from duration and interval
 #' @param duration time duration
 #' @param interval time interval
@@ -28,12 +33,6 @@ parse_date <- function(duration, interval) {
 
   }
 
-
-getExtension = function(x) {
-  pos <- regexpr("\\.([[:alnum:]]+)$", x)
-  ifelse(pos > -1L, substring(x, pos + 1L), "")
-}
-
 #' @title Get Data (Data Access Protocol)
 #' @description this function provides a consistent data access protocol (dap) to a wide
 #' range of local and remote resources including VRT, TDS, NetCDF
@@ -155,13 +154,11 @@ vrt_crop_get = function(URL = NULL,
   }
 
   if (!is.null(AOI) & flag) {
-    AOIv =  vect(AOI)
-
     fin = tryCatch({
-      crop(fin, project(AOIv, crs(fin[[1]])))
+      crop(fin, project(spatAOI(AOI), crs(fin[[1]])))
     }, error = function(e) {
       lapply(1:length(fin), function(x) {
-        crop(fin[[x]], project(AOIv, crs(fin[[x]])))
+        crop(fin[[x]], project(spatAOI(AOI), crs(fin[[x]])))
       })
     })
   }
@@ -274,11 +271,10 @@ dap_crop <- function(URL = NULL,
     catalog$X <- paste0("[0:1:", catalog$ncols - 1, "]")
     catalog$Y <- paste0("[0:1:", catalog$nrows - 1, "]")
   } else {
-    AOIspat <- vect(AOI)
 
     out <- lapply(1:nrow(catalog), function(i) {
       tryCatch({
-        ext(intersect(project(AOIspat, catalog$crs[i]), make_ext(catalog[i,])))
+        ext(intersect(project(spatAOI(AOI), catalog$crs[i]), make_ext(catalog[i,])))
       },
       error = function(e) {
         NULL
@@ -560,13 +556,13 @@ read_ftp = function(URL, cat, lyrs = 1, AOI, ext = NULL, crs = NULL, dates = NUL
     ext(o) = ext
   }
 
-  e =  align(ext(project(vect(AOI), crs(o))), o)
+  e =  align(ext(project(spatAOI(AOI), crs(o))), o)
 
   if(cat$toptobottom){
     z = crop(o, e)
   } else {
 
-    e =  align(ext(project(vect(AOI), crs(o))), o)
+    e =  align(ext(project(spatAOI(AOI), crs(o))), o)
 
     ymax <- ymax(o) - (e$ymin - ymin(o))
     ymin <- ymax(o) - (e$ymax - ymin(o))

diff --git a/R/extract-sites.R b/R/extract-sites.R
@@ -10,9 +10,7 @@
 
 extract_sites = function(r, pts, id){
 
-  if(inherits(pts, "sf")){
-    pts = vect(pts)
-  }
+  pts = spatAOI(pts)
 
   flip = function(x, r, pts, id){
     df = data.frame(t(extract(r[[x]], pts, ID = FALSE)), row.names = NULL)

diff --git a/R/utils.R b/R/utils.R
@@ -1,3 +1,11 @@
+spatAOI = function(AOI){
+  if(inherits(AOI, "sf")){ 
+    terra::vect(AOI) 
+  } else { 
+    AOI
+  }
+}
+
 omit.na <- function(x) { x[!is.na(x)] }
 
 #' Merge List of SpatRaster's across time

diff --git a/tests/testthat/test-climateR.R b/tests/testthat/test-climateR.R
@@ -1,6 +1,23 @@
 library(AOI)
 library(terra)
 
+test_that("AOI input type", { 
+
+  out = getTerraClimNormals(AOI = AOI::aoi_get(state = "CO"),
+                            varname = "tmin",
+                            month = 4)
+
+
+  out2 = getTerraClimNormals(AOI = vect(AOI::aoi_get(state = "CO")),
+                            varname = "tmin",
+                            month = 4)
+
+  expect_identical(nrow(out$tmin), nrow(out2$tmin))
+  expect_identical(ncol(out$tmin), ncol(out2$tmin))
+  expect_identical(nlyr(out$tmin), nlyr(out2$tmin))
+  expect_identical(crs(out$tmin),  crs(out2$tmin))
+
+})
 
 test_that("climater_filter", {
   expect_equal(nrow(climater_filter(asset = '2019 Land Cover L48')), 1)