From 24644a4ed688f0378e52b78ea269d6e50634bb6b Mon Sep 17 00:00:00 2001 From: "Jeffrey W. Hollister" Date: Mon, 5 Jun 2023 12:31:48 -0400 Subject: [PATCH] all raster and sp functions replaced. --- R/get_elev_point.R | 2 +- R/get_elev_raster.R | 6 +-- R/internal.R | 58 +++------------------------ R/zzz.R | 5 --- tests/testthat/test-get_elev_raster.R | 6 +-- 5 files changed, 13 insertions(+), 64 deletions(-) diff --git a/R/get_elev_point.R b/R/get_elev_point.R index 916174a..6a5d812 100644 --- a/R/get_elev_point.R +++ b/R/get_elev_point.R @@ -303,7 +303,7 @@ 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 <- raster::extract(dem, locations) + elevation <- terra::extract(dem, locations) if(units == "feet") {elevation <- elevation * 3.28084} locations$elevation <- round(elevation, 2) location_list <- list(locations, units) diff --git a/R/get_elev_raster.R b/R/get_elev_raster.R index 1e10c76..e9d59d7 100644 --- a/R/get_elev_raster.R +++ b/R/get_elev_raster.R @@ -300,8 +300,8 @@ merge_rasters <- function(raster_list, target_prj, method = "bilinear", returnR files <- unlist(raster_list) if(is.null(target_prj)){ - r <- raster::raster(files[1]) - target_prj <- raster::crs(r) + r <- terra::rast(files[1]) + target_prj <- terra::crs(r) } sf::gdal_utils(util = "warp", @@ -320,7 +320,7 @@ merge_rasters <- function(raster_list, target_prj, method = "bilinear", returnR ) if(returnRaster){ - raster::raster(destfile2) + terra::rast(destfile2) } else { destfile2 } diff --git a/R/internal.R b/R/internal.R index 473ec43..3f9e056 100644 --- a/R/internal.R +++ b/R/internal.R @@ -35,20 +35,6 @@ get_tilexy <- function(bbx,z){ return(expand.grid(x_all,y_all)) } -#' function to get a data.frame of all xyz tiles to download -# @keywords internal -#get_tilexy_coords <- function(locations,z){ -# coords <- sp::coordinates(locations) -# -# tiles <- latlong_to_tilexy(coords[,1],coords[,2],z) -# tiles <- matrix(tiles, nrow = nrow(coords), ncol = 2) -# tiles <- floor(tiles) -# tiles <- unique(tiles) -# -# tiles -#} - - #' function to check input type and projection. All input types convert to a #' SpatialPointsDataFrame for point elevation and bbx for raster. @@ -78,39 +64,7 @@ loc_check <- function(locations, prj = NULL){ stop("Please supply an sf object with a valid crs.") } - } else if(attributes(class(locations)) %in% c("raster")){ - - raster_crs <- raster::crs(locations) - - if((is.null(raster_crs) | is.na(raster_crs))){ - stop("Please supply a valid sf crs via locations or prj.") - } - - if(is.null(raster_crs) | is.na(raster_crs)){ - if(attributes(class(locations)) == "raster"){ - if(sum(!is.na(raster::getValues(locations))) == 0){ - stop("No distinct points, all values NA.") - } else { - browser() - locations <- unique(data.frame(raster::rasterToPoints(locations))) - locations$elevation <- vector("numeric", nrow(locations)) - locations<-sf::st_as_sf(x = locations, coords = c("x", "y"), - crs = sf::st_crs(prj)) - } - } - } else if(attributes(class(locations)) %in% c("raster")){ - - if(sum(!is.na(raster::getValues(locations))) == 0){ - stop("No distinct points, all values NA.") - } else { - browser() - locations <- unique(data.frame(raster::rasterToPoints(locations))) - locations$elevation <- vector("numeric", nrow(locations)) - locations <- sf::st_as_sf(x = locations, coords = c("x", "y"), - crs = raster_crs) - } - } - } + } #check for long>180 if(is.null(prj)){ @@ -195,13 +149,13 @@ proj_expand <- function(locations,prj,expand){ #' function to clip the DEM #' @keywords internal clip_it <- function(rast, loc, expand, clip){ - loc_wm <- sf::st_transform(loc, crs = raster::crs(rast)) + loc_wm <- sf::st_transform(loc, crs = terra::crs(rast)) if(clip == "locations" & !grepl("sfc_POINT", class(sf::st_geometry(loc_wm))[1])){ - dem <- raster::mask(raster::crop(rast,loc_wm), loc_wm) + dem <- terra::mask(terra::crop(rast,loc_wm), loc_wm) } else if(clip == "bbox" | grepl("sfc_POINT", class(sf::st_geometry(loc_wm))[1])){ - bbx <- proj_expand(loc_wm, as.character(raster::crs(rast)), expand) - bbx_sf <- sf::st_transform(bbox_to_sf(bbx), crs = raster::crs(rast)) - dem <- raster::mask(raster::crop(rast,bbx_sf), bbx_sf) + bbx <- proj_expand(loc_wm, as.character(terra::crs(rast)), expand) + bbx_sf <- sf::st_transform(bbox_to_sf(bbx), crs = terra::crs(rast)) + dem <- terra::mask(terra::crop(rast,bbx_sf), bbx_sf) } dem } diff --git a/R/zzz.R b/R/zzz.R index 6c91cf7..c52c345 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -1,10 +1,5 @@ op <- options() -.onLoad <- function(libname, pkgname){ - options("rgdal_show_exportToProj4_warnings"="thin") - invisible() -} - .onUnload <- function(libname, pkgname){ options(op) invisible() diff --git a/tests/testthat/test-get_elev_raster.R b/tests/testthat/test-get_elev_raster.R index 7a1d6dc..c61cde5 100644 --- a/tests/testthat/test-get_elev_raster.R +++ b/tests/testthat/test-get_elev_raster.R @@ -35,11 +35,11 @@ test_that("get_elev_raster clip argument works", { bbox_clip <- get_elev_raster(lake, z = 5, clip = "bbox") locations_clip <- get_elev_raster(lake, z = 5, clip = "locations") - default_values <- raster::getValues(default_clip) + default_values <- terra::values(default_clip) num_cell_default <- length(default_values[!is.na(default_values)]) - bbox_values <- raster::getValues(bbox_clip) + bbox_values <- terra::values(bbox_clip) num_cell_bbox <- length(bbox_values[!is.na(bbox_values)]) - locations_values <- raster::getValues(locations_clip) + locations_values <- terra::values(locations_clip) num_cell_locations <- length(locations_values[!is.na(locations_values)]) expect_true(num_cell_default > num_cell_bbox)