Skip to content

Commit

Permalink
allow spatvect inputs #67
Browse files Browse the repository at this point in the history
  • Loading branch information
mikejohnson51 committed Jul 19, 2023
1 parent 6261e3b commit a1daed9
Show file tree
Hide file tree
Showing 5 changed files with 37 additions and 18 deletions.
2 changes: 1 addition & 1 deletion R/climater_filter.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
})
Expand Down
24 changes: 10 additions & 14 deletions R/dap.R
Original file line number Diff line number Diff line change
@@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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]])))
})
})
}
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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))
Expand Down
4 changes: 1 addition & 3 deletions R/extract-sites.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
8 changes: 8 additions & 0 deletions R/utils.R
Original file line number Diff line number Diff line change
@@ -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
Expand Down
17 changes: 17 additions & 0 deletions tests/testthat/test-climateR.R
Original file line number Diff line number Diff line change
@@ -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)
Expand Down

0 comments on commit a1daed9

Please sign in to comment.