diff --git a/DESCRIPTION b/DESCRIPTION index ffd781a..2fddc42 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -38,11 +38,12 @@ Imports: climaemet, dismo, dplyr, - elevatr, + elevatr (>= 1.0), exactextractr, geodata, glue, macroBiome, + methods, plyr, randomForest, sf, @@ -53,12 +54,16 @@ Suggests: covr, fs, knitr, + progress, raster, rmarkdown, testthat (>= 3.0.0), vdiffr +Remotes: + jhollist/elevatr Config/Needs/check: rcmdcheck Config/Needs/coverage: covr Config/Needs/website: pkgdown +Config/testthat/edition: 3 RoxygenNote: 7.2.3 Roxygen: list(markdown = TRUE) diff --git a/NAMESPACE b/NAMESPACE index a5a9390..fc776d8 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -18,7 +18,6 @@ importFrom(dplyr,group_by) importFrom(dplyr,summarize) importFrom(elevatr,get_elev_raster) importFrom(exactextractr,exact_extract) -importFrom(geodata,elevation_3s) importFrom(geodata,worldclim_tile) importFrom(glue,glue) importFrom(graphics,axis) @@ -28,10 +27,12 @@ importFrom(graphics,points) importFrom(graphics,strwidth) importFrom(graphics,text) importFrom(macroBiome,cliHoldridgePoints) +importFrom(methods,as) importFrom(plyr,round_any) importFrom(randomForest,importance) importFrom(randomForest,randomForest) importFrom(randomForest,varImpPlot) +importFrom(sf,"st_crs<-") importFrom(sf,as_Spatial) importFrom(sf,st_as_sf) importFrom(sf,st_bbox) @@ -42,10 +43,15 @@ importFrom(sp,SpatialPolygonsDataFrame) importFrom(stats,aggregate) importFrom(stats,sd) importFrom(terra,centroids) +importFrom(terra,colFromCell) importFrom(terra,crds) +importFrom(terra,crs) importFrom(terra,extract) +importFrom(terra,mask) importFrom(terra,mosaic) importFrom(terra,rast) +importFrom(terra,rasterize) +importFrom(terra,rowFromCell) importFrom(terra,vect) importFrom(terra,writeRaster) importFrom(terra,xyFromCell) diff --git a/R/ce_download.R b/R/ce_download.R index d3c756e..f516724 100644 --- a/R/ce_download.R +++ b/R/ce_download.R @@ -12,7 +12,7 @@ #' @param \dots Arguments to control a download from the Internet #' `download.file()`. #' -#' @return +#' @returns #' See documentation from [`chelsa()`], [`worldclim()`] and #' [`elev()`]. #' diff --git a/R/ce_extract.R b/R/ce_extract.R index 3f23961..cdea05d 100644 --- a/R/ce_extract.R +++ b/R/ce_extract.R @@ -287,7 +287,7 @@ # Assigns an 'id' if location_g is empty if (is.null(location_g)) { - message( + warning( paste( "location_g must be one of", paste(setdiff(colnames(location_df), c("coords.x1", "coords.x2")), @@ -347,7 +347,7 @@ #' @template output_c_source_param #' @template output_var_param #' -#' @return +#' @returns #' Returns a list storing matrices containing the mean and standard deviation #' of the climate and/or elevation data. Each column represents a month, each #' row represents a feature of the \code{location} \code{sp}, \code{sf} polygon diff --git a/R/chelsa.R b/R/chelsa.R index 4a4a622..f62988e 100644 --- a/R/chelsa.R +++ b/R/chelsa.R @@ -10,7 +10,7 @@ #' @param quiet,\dots Arguments to control a download from the Internet #' `download.file()`. #' -#' @return +#' @returns #' Returns four subfolders named prec, tmax, tmin and tmean. Each folder #' contains 12 GeoTiff (.tif) files, one for each month of the year for the time #' period 1981–2010. Each of the files are downloaded at a spatial diff --git a/R/data_srtm_tiles.R b/R/data_srtm_tiles.R new file mode 100644 index 0000000..5b19ab4 --- /dev/null +++ b/R/data_srtm_tiles.R @@ -0,0 +1,15 @@ +##' STRM tiles data +##' +##' SRTM tiles data. +##' +##' @docType data +##' @format{ An object of class \code{SpatialPolygonsDataFrame} with 872 rows +##' and 1 columns.} +##' @details Contains tiles to assist downloading from 'geodata'. +##' @encoding UTF-8 +##' @keywords datasets +##' @rdname srtm_tiles +##' @examples +##' data("srtm_tiles", package = "climenv") +##' head(srtm_tiles) +"srtm_tiles" diff --git a/R/elev.R b/R/elev.R index fa9b1e9..f1afaab 100644 --- a/R/elev.R +++ b/R/elev.R @@ -1,76 +1,129 @@ -.elev_geodata <- function(location, output_dir) { +#' @importFrom terra colFromCell crs rowFromCell mask +.elev_geodata <- function(location, output_dir, ...) { # create SRTM tiles - rs <- terra::rast(nrows = 24, ncols = 72, - xmin = -180, xmax = 180, - ymin = -60, ymax = 60) - rs[] <- 1:1728 - - # Intersect location and tiles + y_max <- 60 + y_min <- -60 + rs <- terra::rast(res = 5, ymin = y_min, ymax = y_max, + vals = 1:1728, crs = "+proj=longlat +datum=WGS84") + # mask out the tiles with no data + rs <- terra::mask(rs, terra::vect(climenv::srtm_tiles), touches = TRUE) + + # intersect location and tiles tiles <- unique( - terra::extract(rs, terra::vect(location), touches = TRUE)$lyr.1 + terra::extract(rs, location, touches = TRUE)$lyr.1 ) - srtm_points <- terra::xyFromCell(rs, tiles) - - # Make an empty list to fill - srtm_list <- list() - - # lats - lats <- srtm_points[, "y"] - - # Downloads the tiles and stores into that list - for (pts in 1:seq_along(lats)) { - - tile <- geodata::elevation_3s( - lon = srtm_points[pts, "x"], lat = srtm_points[pts, "y"], - path = tempfile() - ) - - srtm_list[[pts]] <- tile - + if (all(is.na(tiles))) { + return(NULL) } + cols <- formatC(terra::colFromCell(rs, tiles), width = 2, flag = 0) + rows <- formatC(terra::rowFromCell(rs, tiles), width = 2, flag = 0) + na <- cols == "NA" | rows == "NA" + srtm_id <- paste0("srtm_", cols[!na], "_", rows[!na]) + + srtm_list <- lapply(srtm_id, function(id) { + + temp_file <- tempfile("srtm_", output_dir) + on.exit(unlink(temp_file)) + + tif <- paste0(output_dir, "/", id, ".tif") + error <- if (file.exists(tif)) { + 0 + } else { + zip_url <- paste0( + "https://srtm.csi.cgiar.org/wp-content/uploads/files/srtm_5x5/TIFF/", + id, ".zip" + ) + url_status <- attr(curlGetHeaders(zip_url, verify = FALSE), "status") + error <- if (url_status == 200) { + if (tryCatch( + utils::download.file(url = zip_url, destfile = temp_file, mode = "wb", + ...), # Returns 0 on success + error = function(e) { + warning("Failed to download ", id, ": ", e) + -1 # Error code + } + ) == 0) { + if (isFALSE(tryCatch( + utils::unzip(temp_file, paste0(id, ".tif"), exdir = output_dir), + error = function(e) { + warning("Temporary file not found: ", temp_file) + FALSE + }))) { + -2 # Error code + } else { + 0 # Success code + } + } + } else { + warning("Could not download ", id, ": HTTP status ", url_status) + -1 + } + } + if (error == 0) { + rs <- terra::rast(tif) + terra::crs(rs) <- "+proj=longlat +datum=WGS84" + rs + } else { + NULL + } + }) + + srtm_list <- srtm_list[!vapply(srtm_list, is.null, logical(1))] # Mosaic the tiles in the list - if (length(lats) > 1) { + if (length(srtm_list) > 1) { srtm_list$fun <- mean srtm_mosaic <- do.call(terra::mosaic, srtm_list) + } else if (length(srtm_list) == 0) { + stop("No data downloaded.") } else { srtm_mosaic <- srtm_list[[1]] } + return(srtm_mosaic) } + #' Download elevation data #' #' @description #' `elev()` downloads elevation data the Shuttle Radar Topography Mission -#' (SRTM) , specifically the hole-filled CGIAR-SRTM (90 m resolution) for +#' (SRTM), specifically the hole-filled CGIAR-SRTM (90 m resolution) for #' latitudes between -60 and 60 or Mapzen's synthesis digital elevation product. #' #' @template output_dir_param #' @template output_location_param #' @template output_e_source_param +#' @param verbose Logical specifying whether to display verbose output when +#' downloading from Mapzen. +#' @param \dots Additional arguments to [`download.file()`]. #' -#' @return -#' Creates one subfolder named elev storing a raster (.tiff). If elevation is -#' sourced from geodata the elevation is downloaded at a spatial resolution of -#' 30 arc seconds (~1 km sq.). If elevation data is from mapzen then the -#' product will be a mosaic. Specifically, Mapzen’s product is unique as it -#' combines several sources of digital elevation models, including SRTM, the -#' ArcticDEM (covering all areas north of 60°), EUDEM (digital elevation model -#' over Europe; for review, see Mouratidis & Ampatzidis, 2019), and others into -#' a single product. The resolution of this product was set to 7, corresponding -#' to 611.5 m ground resolution at 60° latitude 864.8 m at 45° and 1223 m at 0°. +#' @returns +#' `elev()` is called for its side-effects. +#' It invisibly returns a "SpatRaster" object if files were downloaded +#' successfully, and returns `NULL` otherwise. If the elevation data is sourced +#' from geodata the SpatRaster is downloaded at a spatial resolution of 30 arc +#' seconds (~1 km sq.). If elevation data is from mapzen then the +#' SpatRaster will be a mosaic. Specifically, Mapzen’s SpatRaster is unique as +#' it combines several sources of digital elevation models, including SRTM, the +#' ArcticDEM (covering all areas north of 60°), EUDEM (digital elevation +#' model over Europe; for review, see Mouratidis & Ampatzidis, 2019), and others +#' into a single product. The resolution of this SpatRaster was set to 7, +#' corresponding to 611.5 m ground resolution at 60° latitude 864.8 m at +#' 45° and 1223 m at 0°. #' #' @author James L. Tsakalos #' @seealso A more convenient function for other climate and elevation data -#' [`ce_download()`]. +#' [`ce_download()`]. See [sf::st_polygon] to make polygons and [sf::st_as_sf] +#' to make point objects. #' @references{ Hijmans, R.J., Barbosa, M., Ghosh, A., & Mandel, A. (2023). #' geodata: Download Geographic Data. R package version 0.5-8. -#' https://CRAN.R-project.org/package=geodata +#' \url{https://CRAN.R-project.org/package=geodata} #' #' Hollister, J. (2022). elevatr: Access Elevation Data from Various -#' APIs. R package version 0.4.2. \doi{10.5281/zenodo.5809645} -#' https://CRAN.R-project.org/package=elevatr +#' APIs. R package version 1.0.0. \doi{10.5281/zenodo.5809645} +#' \url{https://CRAN.R-project.org/package=elevatr} +#' #' #' Mouratidis, A., & Ampatzidis, D. (2019). European Digital Elevation Model #' Validation against Extensive Global Navigation Satellite Systems Data and @@ -81,47 +134,68 @@ #' #' @examples #' \dontrun{ -#' # Start by loading Italy's Biom data +#' # We could do this using Italy's Biome data #' data("italy_py", package = "climenv") #' # elevation will be saved in the output_dir (i.e. output directory) #' elev(output_dir = "...Desktop/elev", location = italy_py) #' } +#' +#' # As a smaller example, we can make a polygon covering an ocean island. +#' location <- sf::st_polygon( +#' list( +#' cbind( +#' long = c(161, 161, 154, 161), +#' lat = c(-61, -49, -61, -61) +#' ) +#' ) +#' ) +#' +#' # We need to make sure that the polygon the correct class +#' location <- sf::st_geometry(location) +#' class(location) # "sfc_POLYGON" "sfc" +#' +#' # Set the coordinate reference system +#' sf::st_crs(location) = "epsg:4326" +#' +#' # We are now ready to call elev() +#' # elev(location = location, output_dir = ) +#' #' @importFrom elevatr get_elev_raster -#' @importFrom geodata elevation_3s -#' @importFrom sf as_Spatial st_geometry st_bbox st_is_longlat -#' @importFrom terra rast extract xyFromCell mosaic writeRaster rast +#' @importFrom methods as +#' @importFrom sf as_Spatial st_as_sf st_bbox st_geometry st_is_longlat st_crs<- +#' @importFrom terra extract mosaic rast rasterize vect writeRaster xyFromCell #' @export -elev <- function(output_dir, location, e_source = "mapzen") { +elev <- function(output_dir, location, e_source = "mapzen", + verbose = FALSE, ...) { e_source_id <- pmatch(tolower(e_source[1]), c("mapzen", "geodata")) if (is.na(e_source_id)) { stop("e_source must be \"mapzen\" or \"geodata\"") } - # Convert to "sfc_POLYGON" "sfc" - if ("sfg" %in% class(location)) { - location <- sf::st_geometry(location) + if (is.function(location)) { + location <- st_as_sf(location) } - - # Convert sf locations to SP - if (("sf" %in% class(location)) || ("sfc" %in% class(location))) { - location <- sf::as_Spatial(location) + if (inherits(location, c("sfc", "sfg", "SpatVector"))) { + location <- as(location, "Spatial") } + location_sf <- as(location, "sf") # Check that the bounding box coordinates - if (!sum( - sf::st_bbox(location)[c(1)] >= -180, - sf::st_bbox(location)[c(2)] >= -90, - sf::st_bbox(location)[c(3)] <= 180, - sf::st_bbox(location)[c(4)] <= 90 - ) == 4) stop( - "bounding box of location has potentially an invalid value range" - ) + bbox <- sf::st_bbox(location_sf) + if (bbox[["xmin"]] < -180 || bbox[["xmax"]] > 180) { + stop("`location` bounding box falls outside supported longitudes ", + "-180 to 180") + } + if (bbox[["ymin"]] < -90 || bbox[["ymax"]] > 90) { + stop("`location` bounding box falls outside supported latitudes ", + "-90 to 90") + } - if (is.na(sf::st_is_longlat(location)) || - !sf::st_is_longlat(location) == TRUE) stop( - "check that the location has been projected (epsg: 4326)" - ) + if (!isTRUE(sf::st_is_longlat(location_sf))) { + warning("Coordinate reference system not specified; assuming WGS84") + sf::st_crs(location_sf) <- "+proj=longlat +datum=WGS84" + } # Create elev folder if (!dir.exists(paste0(output_dir, "/elev"))) { @@ -129,24 +203,22 @@ elev <- function(output_dir, location, e_source = "mapzen") { recursive = TRUE, showWarnings = FALSE) } + file_path <- paste0(output_dir, "/elev/srtm.tif") # Saves elevation from geodata or mapzen sources - switch(e_source_id, - { # mapzen - srtm_mosaic <- terra::rast( - elevatr::get_elev_raster( - location, z = 7, override_size_check = TRUE, - progress = FALSE - ) - ) - file_path <- paste0(output_dir, "/elev/srtm.tif") - terra::writeRaster(srtm_mosaic, filename = file_path, - overwrite = TRUE) - }, - { # geodata - srtm_mosaic <- .elev_geodata(location = location) - file_path <- paste0(output_dir, "/elev/srtm.tif") - terra::writeRaster(srtm_mosaic, filename = file_path, - overwrite = TRUE) - } + switch(e_source_id, { # mapzen + elev_raster <- elevatr::get_elev_raster( + location_sf, z = 7, override_size_check = TRUE, + progress = verbose, verbose = verbose + ) + srtm_mosaic <- as(elev_raster, "SpatRaster") + terra::writeRaster(srtm_mosaic, filename = file_path, overwrite = TRUE) + }, { # geodata + srtm_mosaic <- .elev_geodata(location_sf, output_dir, ...) + if (is.null(srtm_mosaic)) { + NULL + } else { + terra::writeRaster(srtm_mosaic, filename = file_path, overwrite = TRUE) + } + } ) } diff --git a/R/plot_c.R b/R/plot_c.R index ba11c68..597938c 100644 --- a/R/plot_c.R +++ b/R/plot_c.R @@ -46,11 +46,12 @@ #' @param l_tcols List. Line position of the table columns. Must be length 5 #' corresponding to the position (left to right) for each column. #' -#' @return Returns a base R family of plot. This function uses the -#' \pkg{dismo} package to calculate isothermality (ISO), -#' temperature seasonality (TS) and precipitation seasonality (PS). It also uses -#' the \pkg{macroBiome} package to calculate mean annual biotemperature (BioT) -#' and the potential evapotranspiration ratio (PET). +#' @returns +#' Returns a base R family of plot. This function uses the \pkg{dismo} package +#' to calculate isothermality (ISO), temperature seasonality (TS) and +#' precipitation seasonality (PS). It also uses the \pkg{macroBiome} package to +#' calculate mean annual biotemperature (BioT) and the potential +#' evapotranspiration ratio (PET). #' #' @author James L. Tsakalos #' @seealso Download climate data: [`ce_download()`] @@ -58,7 +59,7 @@ #' Fernández-Avilés G. (2023). climaemet: Climate AEMET Tools. #' Comprehensive R Archive Network. \doi{10.5281/zenodo.5205573} #' -#' von Walter, H.B., & Lieth, H. (1960). Klimadiagramm-Weltatlas. VEB Gustav +#' Walter, H.B., & Lieth, H. (1960). Klimadiagramm-Weltatlas. VEB Gustav #' Fischer Verlag, Jena. #' #' } diff --git a/R/plot_h.R b/R/plot_h.R index cbc89aa..c94d454 100644 --- a/R/plot_h.R +++ b/R/plot_h.R @@ -9,7 +9,8 @@ #' @param col,pch,\dots Arguments to control point styling in #' `HoldridgePoints()`. #' -#' @return Returns a base R family of plot. This function uses the +#' @returns +#' Returns a base R family of plot. This function uses the #' \pkg{macroBiome} and \pkg{Ternary} packages to create a Holdridge simplex #' plot. #' diff --git a/R/plot_wl.R b/R/plot_wl.R index b137b9b..1aab33a 100644 --- a/R/plot_wl.R +++ b/R/plot_wl.R @@ -9,9 +9,9 @@ #' @param \dots Arguments to control styling in #' `ggclimat_walter_lieth()`. #' -#' @return Returns a base R family of plot. This function uses the -#' \pkg{climaemet} package to create the Walter and Lieth (1960) climatic -#' diagram. +#' @returns +#' Returns a base R family of plot. This function uses the \pkg{climaemet} +#' package to create the Walter and Lieth (1960) climatic diagram. #' #' @author James L. Tsakalos #' @seealso Download climate data: [`ce_download()`] @@ -19,7 +19,7 @@ #' Fernández-Avilés G. (2023). climaemet: Climate AEMET Tools. #' Comprehensive R Archive Network. \doi{10.5281/zenodo.5205573} #' -#' von Walter, H.B., & Lieth, H. (1960). Klimadiagramm-Weltatlas. VEB Gustav +#' Walter, H.B., & Lieth, H. (1960). Klimadiagramm-Weltatlas. VEB Gustav #' Fischer Verlag, Jena. #' #' } diff --git a/R/worldclim.R b/R/worldclim.R index 2cc3d01..c18ea25 100644 --- a/R/worldclim.R +++ b/R/worldclim.R @@ -60,8 +60,8 @@ #' #' @template output_dir_param #' @template output_location_param -#' @param var,\dots Arguments to control a download from the Internet -#' `download.file()`. +#' @param var,\dots Arguments to [`download.file()`] to control file download. +#' . #' #' @return #' `worldclim()` is called for its side effects and returns `NULL`. diff --git a/data/srtm_tiles.rda b/data/srtm_tiles.rda new file mode 100644 index 0000000..b08b812 Binary files /dev/null and b/data/srtm_tiles.rda differ diff --git a/man-roxygen/output_e_source_param.R b/man-roxygen/output_e_source_param.R index 8b33db5..66d5307 100644 --- a/man-roxygen/output_e_source_param.R +++ b/man-roxygen/output_e_source_param.R @@ -1,2 +1,2 @@ -#' @param e_source Character (e.g., `mapzen` or `WorldClim`). Indicating the +#' @param e_source Character (e.g., `mapzen` or `geodata`). Indicating the #' elevation data source. diff --git a/man-roxygen/output_location_g_param.R b/man-roxygen/output_location_g_param.R index 9fec503..78b5dbd 100644 --- a/man-roxygen/output_location_g_param.R +++ b/man-roxygen/output_location_g_param.R @@ -1,3 +1,4 @@ #' @param location_g Character. Informs how the zonal statistics are exported. #' Must correspond to a column of the `"location"` argument. If NULL, -#' the zonal statistics are calculated for all features of `"location"`. +#' the zonal statistics are calculated for all features of `"location"` and a +#' warning issued. diff --git a/man/ce_download.Rd b/man/ce_download.Rd index ec56728..a035c63 100644 --- a/man/ce_download.Rd +++ b/man/ce_download.Rd @@ -20,7 +20,7 @@ the data will be stored.} \item{c_source}{Character (e.g., \code{"CHELSA or WorldClim"}). Indicating the climate data source.} -\item{e_source}{Character (e.g., \code{mapzen} or \code{WorldClim}). Indicating the +\item{e_source}{Character (e.g., \code{mapzen} or \code{geodata}). Indicating the elevation data source.} \item{var}{Character. If supplied will download a subset of the climate data. diff --git a/man/ce_extract.Rd b/man/ce_extract.Rd index d595c7e..b948d39 100644 --- a/man/ce_extract.Rd +++ b/man/ce_extract.Rd @@ -25,7 +25,8 @@ objects.} \item{location_g}{Character. Informs how the zonal statistics are exported. Must correspond to a column of the \code{"location"} argument. If NULL, -the zonal statistics are calculated for all features of \code{"location"}.} +the zonal statistics are calculated for all features of \code{"location"} and a +warning issued.} \item{c_source}{Character (e.g., \code{"CHELSA or WorldClim"}). Indicating the climate data source.} diff --git a/man/elev.Rd b/man/elev.Rd index f470d1a..e8330ec 100644 --- a/man/elev.Rd +++ b/man/elev.Rd @@ -4,7 +4,7 @@ \alias{elev} \title{Download elevation data} \usage{ -elev(output_dir, location, e_source = "mapzen") +elev(output_dir, location, e_source = "mapzen", verbose = FALSE, ...) } \arguments{ \item{output_dir}{Character (e.g., \code{"../Desktop/chelsa"}). Pathway to where @@ -14,41 +14,70 @@ the data will be stored.} \link[sf:st]{sf::st_polygon} to make polygons and \link[sf:st_as_sf]{sf::st_as_sf} to make point objects.} -\item{e_source}{Character (e.g., \code{mapzen} or \code{WorldClim}). Indicating the +\item{e_source}{Character (e.g., \code{mapzen} or \code{geodata}). Indicating the elevation data source.} + +\item{verbose}{Logical specifying whether to display verbose output when +downloading from Mapzen.} + +\item{\dots}{Additional arguments to \code{\link[=download.file]{download.file()}}.} } \value{ -Creates one subfolder named elev storing a raster (.tiff). If elevation is -sourced from geodata the elevation is downloaded at a spatial resolution of -30 arc seconds (~1 km sq.). If elevation data is from mapzen then the -product will be a mosaic. Specifically, Mapzen’s product is unique as it -combines several sources of digital elevation models, including SRTM, the -ArcticDEM (covering all areas north of 60°), EUDEM (digital elevation model -over Europe; for review, see Mouratidis & Ampatzidis, 2019), and others into -a single product. The resolution of this product was set to 7, corresponding -to 611.5 m ground resolution at 60° latitude 864.8 m at 45° and 1223 m at 0°. +\code{elev()} is called for its side-effects. +It invisibly returns a "SpatRaster" object if files were downloaded +successfully, and returns \code{NULL} otherwise. If the elevation data is sourced +from geodata the SpatRaster is downloaded at a spatial resolution of 30 arc +seconds (~1 km sq.). If elevation data is from mapzen then the +SpatRaster will be a mosaic. Specifically, Mapzen’s SpatRaster is unique as +it combines several sources of digital elevation models, including SRTM, the +ArcticDEM (covering all areas north of 60°), EUDEM (digital elevation +model over Europe; for review, see Mouratidis & Ampatzidis, 2019), and others +into a single product. The resolution of this SpatRaster was set to 7, +corresponding to 611.5 m ground resolution at 60° latitude 864.8 m at +45° and 1223 m at 0°. } \description{ \code{elev()} downloads elevation data the Shuttle Radar Topography Mission -(SRTM) , specifically the hole-filled CGIAR-SRTM (90 m resolution) for +(SRTM), specifically the hole-filled CGIAR-SRTM (90 m resolution) for latitudes between -60 and 60 or Mapzen's synthesis digital elevation product. } \examples{ \dontrun{ -# Start by loading Italy's Biom data +# We could do this using Italy's Biome data data("italy_py", package = "climenv") # elevation will be saved in the output_dir (i.e. output directory) elev(output_dir = "...Desktop/elev", location = italy_py) } + +# As a smaller example, we can make a polygon covering an ocean island. +location <- sf::st_polygon( + list( + cbind( + long = c(161, 161, 154, 161), + lat = c(-61, -49, -61, -61) + ) + ) +) + +# We need to make sure that the polygon the correct class +location <- sf::st_geometry(location) +class(location) # "sfc_POLYGON" "sfc" + +# Set the coordinate reference system +sf::st_crs(location) = "epsg:4326" + +# We are now ready to call elev() +# elev(location = location, output_dir = ) + } \references{ { Hijmans, R.J., Barbosa, M., Ghosh, A., & Mandel, A. (2023). geodata: Download Geographic Data. R package version 0.5-8. -https://CRAN.R-project.org/package=geodata +\url{https://CRAN.R-project.org/package=geodata} Hollister, J. (2022). elevatr: Access Elevation Data from Various -APIs. R package version 0.4.2. \doi{10.5281/zenodo.5809645} -https://CRAN.R-project.org/package=elevatr +APIs. R package version 1.0.0. \doi{10.5281/zenodo.5809645} +\url{https://CRAN.R-project.org/package=elevatr} Mouratidis, A., & Ampatzidis, D. (2019). European Digital Elevation Model Validation against Extensive Global Navigation Satellite Systems Data and @@ -59,7 +88,8 @@ ISPRS International Journal of Geo-Information 8, 108. } \seealso{ A more convenient function for other climate and elevation data -\code{\link[=ce_download]{ce_download()}}. +\code{\link[=ce_download]{ce_download()}}. See \link[sf:st]{sf::st_polygon} to make polygons and \link[sf:st_as_sf]{sf::st_as_sf} +to make point objects. } \author{ James L. Tsakalos diff --git a/man/plot_c.Rd b/man/plot_c.Rd index 025a7b7..c6e5ba8 100644 --- a/man/plot_c.Rd +++ b/man/plot_c.Rd @@ -57,11 +57,11 @@ before wrapping to a new line.} corresponding to the position (left to right) for each column.} } \value{ -Returns a base R family of plot. This function uses the -\pkg{dismo} package to calculate isothermality (ISO), -temperature seasonality (TS) and precipitation seasonality (PS). It also uses -the \pkg{macroBiome} package to calculate mean annual biotemperature (BioT) -and the potential evapotranspiration ratio (PET). +Returns a base R family of plot. This function uses the \pkg{dismo} package +to calculate isothermality (ISO), temperature seasonality (TS) and +precipitation seasonality (PS). It also uses the \pkg{macroBiome} package to +calculate mean annual biotemperature (BioT) and the potential +evapotranspiration ratio (PET). } \description{ Creates a graph using the climate and elevation data which has @@ -101,7 +101,7 @@ par(opar) Fernández-Avilés G. (2023). climaemet: Climate AEMET Tools. Comprehensive R Archive Network. \doi{10.5281/zenodo.5205573} -von Walter, H.B., & Lieth, H. (1960). Klimadiagramm-Weltatlas. VEB Gustav +Walter, H.B., & Lieth, H. (1960). Klimadiagramm-Weltatlas. VEB Gustav Fischer Verlag, Jena. } diff --git a/man/plot_wl.Rd b/man/plot_wl.Rd index 343d19c..22747a4 100644 --- a/man/plot_wl.Rd +++ b/man/plot_wl.Rd @@ -18,9 +18,8 @@ data sets. Structured by \code{ce_extract()}.} \code{ggclimat_walter_lieth()}.} } \value{ -Returns a base R family of plot. This function uses the -\pkg{climaemet} package to create the Walter and Lieth (1960) climatic -diagram. +Returns a base R family of plot. This function uses the \pkg{climaemet} +package to create the Walter and Lieth (1960) climatic diagram. } \description{ Creates a graph using the climate and elevation data which has @@ -50,7 +49,7 @@ plot_wl(data = it_data, geo_id = "NEM") Fernández-Avilés G. (2023). climaemet: Climate AEMET Tools. Comprehensive R Archive Network. \doi{10.5281/zenodo.5205573} -von Walter, H.B., & Lieth, H. (1960). Klimadiagramm-Weltatlas. VEB Gustav +Walter, H.B., & Lieth, H. (1960). Klimadiagramm-Weltatlas. VEB Gustav Fischer Verlag, Jena. } diff --git a/man/srtm_tiles.Rd b/man/srtm_tiles.Rd new file mode 100644 index 0000000..6bef659 --- /dev/null +++ b/man/srtm_tiles.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data_srtm_tiles.R +\docType{data} +\encoding{UTF-8} +\name{srtm_tiles} +\alias{srtm_tiles} +\title{STRM tiles data} +\format{ +{ An object of class \code{SpatialPolygonsDataFrame} with 872 rows +and 1 columns.} +} +\usage{ +srtm_tiles +} +\description{ +SRTM tiles data. +} +\details{ +Contains tiles to assist downloading from 'geodata'. +} +\examples{ +data("srtm_tiles", package = "climenv") +head(srtm_tiles) +} +\keyword{datasets} diff --git a/man/worldclim.Rd b/man/worldclim.Rd index cf64fd6..7be9769 100644 --- a/man/worldclim.Rd +++ b/man/worldclim.Rd @@ -14,8 +14,8 @@ the data will be stored.} \link[sf:st]{sf::st_polygon} to make polygons and \link[sf:st_as_sf]{sf::st_as_sf} to make point objects.} -\item{var, \dots}{Arguments to control a download from the Internet -\code{download.file()}.} +\item{var, \dots}{Arguments to \code{\link[=download.file]{download.file()}} to control file download. +.} } \value{ \code{worldclim()} is called for its side effects and returns \code{NULL}. diff --git a/tests/testthat.R b/tests/testthat.R index 508353a..5a7db44 100644 --- a/tests/testthat.R +++ b/tests/testthat.R @@ -1,4 +1,4 @@ -suppressPackageStartupMessages(library("sp")) # Until 2023-10 +suppressPackageStartupMessages(library("sp", quietly = TRUE)) # Until Oct 2023 library("testthat") library("climenv") diff --git a/tests/testthat/Rplots.pdf b/tests/testthat/Rplots.pdf index 6b7b712..0a93a3d 100644 Binary files a/tests/testthat/Rplots.pdf and b/tests/testthat/Rplots.pdf differ diff --git a/tests/testthat/_snaps/elev/geo-elev.svg b/tests/testthat/_snaps/elev/geo-elev.svg new file mode 100644 index 0000000..b94ff9f --- /dev/null +++ b/tests/testthat/_snaps/elev/geo-elev.svg @@ -0,0 +1,338 @@ + + + + + + + + + + + + + + + + + + + + + + +155 +160 + + + + + + + +-60 +-58 +-56 +-54 +-52 +-50 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +50 +100 +150 +200 +250 +300 + + + + + + + + + + + + + diff --git a/tests/testthat/expected/island_srtm_py.tif b/tests/testthat/expected/island_srtm_py.tif new file mode 100644 index 0000000..ccea4e9 Binary files /dev/null and b/tests/testthat/expected/island_srtm_py.tif differ diff --git a/tests/testthat/expected/mapzen.tif b/tests/testthat/expected/mapzen.tif new file mode 100644 index 0000000..97a1701 Binary files /dev/null and b/tests/testthat/expected/mapzen.tif differ diff --git a/tests/testthat/expected/mapzen_pt.tif b/tests/testthat/expected/mapzen_pt.tif new file mode 100644 index 0000000..319d80d Binary files /dev/null and b/tests/testthat/expected/mapzen_pt.tif differ diff --git a/tests/testthat/expected/mapzen_py.tif b/tests/testthat/expected/mapzen_py.tif new file mode 100644 index 0000000..f1087cd Binary files /dev/null and b/tests/testthat/expected/mapzen_py.tif differ diff --git a/tests/testthat/expected/srtm_pt.tif b/tests/testthat/expected/srtm_pt.tif new file mode 100644 index 0000000..d5d474d Binary files /dev/null and b/tests/testthat/expected/srtm_pt.tif differ diff --git a/tests/testthat/expected/srtm_py.tif b/tests/testthat/expected/srtm_py.tif new file mode 100644 index 0000000..d5d474d Binary files /dev/null and b/tests/testthat/expected/srtm_py.tif differ diff --git a/tests/testthat/test-elev.R b/tests/testthat/test-elev.R index 7f71f3d..fb980b6 100644 --- a/tests/testthat/test-elev.R +++ b/tests/testthat/test-elev.R @@ -1,31 +1,229 @@ -library(testthat) +polygon_py <- sf::st_polygon( + list(cbind(long = c(161, 161, 154, 161), + lat = c(-61, -49, -61, -61))) + ) +polygon_py <- sf::st_geometry(polygon_py) +sf::st_crs(polygon_py) <- "epsg:4326" +points <- terra::centroids(terra::vect(polygon_py)) + +polygon_py_sm <- sf::st_polygon( + list(cbind(long = c(156, 156, 155, 156), + lat = c(-60, -59, -60, -60))) +) +polygon_py_sm <- sf::st_geometry(polygon_py_sm) +sf::st_crs(polygon_py_sm) <- "epsg:4326" +points_sm <- terra::centroids(terra::vect(polygon_py_sm)) + +skip_if_server_offline <- function(server) { + # Preferred to testthat::skip_if_offline as this runs on CRAN + # Thus we can expect notice of any breaking changes to imported packages + invisible(tryCatch( + curlGetHeaders(server, timeout = 2), + error = function(e) { + if (length(grep("Connection timed out", e$message, fixed = TRUE))) { + testthat::skip(paste("Could not connect to", server)) + } + } + )) +} test_that("elev() fails gracefully", { - expect_error( - expect_warning( - elev(), - "Error in elev() : argument location is missing, with no default" - )) + skip_if_server_offline("https://srtm.csi.cgiar.org") + tmp_dir <- tempdir() + on.exit(unlink(tmp_dir)) - flip_lat_long <- sf::st_polygon( - list(cbind(lat = c(-61, -49, -61, -61), lng = c(161, 161, 154, 161)))) + expect_error(elev(out = "", location = "", e_source = ""), + "e_source must be ") + # Invalid polygon + flip_lat_long <- sf::st_polygon(list(cbind( + lat = c(-61, -49, -61, -61), + lng = c(161, 161, 154, 161) + ))) expect_error( - expect_warning( - elev(location = flip_lat_long), - "Error in elev(location = flip_lat_long) : - bounding box of location has potentially an invalid value range" - )) + elev(location = flip_lat_long), + "bounding box falls outside supported latitudes" + ) - flip_lat_long <- sf::st_polygon( - list(cbind(long = c(161, 161, 154, 161), - lat = c(-61, -49, -61, -61))) + # No data available in the oceans + sea <- sf::st_as_sf( + data.frame(lat = c(-59, -59, -58, -59), + lng = c(-123, -124, -123, -123)), coords = 2:1) + sf::st_crs(sea) <- "wgs84" + expect_null(elev(tmp_dir, sea, "GEOdata", quiet = TRUE)) +}) + +test_that("elev() downloads tiles not containing a vertex srtm", { + + skip_if_server_offline("https://srtm.csi.cgiar.org") + tmp_dir <- tempdir() + on.exit(unlink(tmp_dir)) + + # Island example. Covers two srtm tiles (68_24 and 68_23), but the polygon + # does not cover one tile not containing a vertex. + island <- sf::st_polygon( + list(cbind(lng = c(161, 161, 154, 161), lat = c(-61, -49, -61, -61)))) + + # downloading the data for srtm + expect_warning( + geo_elev <- elev(tmp_dir, island, "GEOdata", quiet = TRUE), + "Coordinate reference system not specified" ) - expect_error( - expect_warning( - elev(location = flip_lat_long), - "Error: check that the location has been projected (epsg: 4326)" - )) + thumb_0 <- terra::aggregate(geo_elev, fact = 20) + + # Run this code manually to update the "Expected" value + if (FALSE) { + terra::writeRaster( + thumb_0, overwrite = TRUE, + test_path("expected", "island_srtm_py.tif") + ) + } + + expected <- terra::rast(test_path("expected", "island_srtm_py.tif")) + expect_true(all.equal(terra::rast(thumb_0), terra::rast(expected))) + +}) + +test_that("elev() downloads polygon from Mapzen", { + + skip_if_offline() # Requires connectivity. Automatically skips on CRAN. + # CRAN policy: Packages should not write [anywhere] apart from the + # R session’s temporary directory [...] and such usage should be cleaned up + tmp_dir <- tempdir() + on.exit(unlink(tmp_dir)) + + # download mapzen using a polygon ### + elev( + output_dir = tmp_dir, location = polygon_py_sm, e_source = "mapzen" + ) + mapzen_tile <- paste0(tmp_dir, "/elev/srtm.tif") + expect_true(file.exists(mapzen_tile)) + + # Check data matches expectation + skip_if(!file.exists(mapzen_tile[1])) + elev_mapzen <- terra::rast(mapzen_tile[1]) + thumb_1 <- terra::aggregate(elev_mapzen, fact = 64) + + # Run this code manually to update the "Expected" value + if (FALSE) { + terra::writeRaster( + thumb_1, overwrite = TRUE, + test_path("expected", "mapzen_py.tif") + ) + } + + expected <- terra::rast(test_path("expected", "mapzen_py.tif")) + expect_true(all.equal( + unname(terra::rast(thumb_1)), + unname(terra::rast(expected)) + )) + +}) + +test_that("elev() downloads points from Mapzen", { + + skip_if_offline() # Requires connectivity. Automatically skips on CRAN. + tmp_dir <- tempdir() + on.exit(unlink(tmp_dir)) + + # download mapzen using points + expect_true(inherits(elev( + output_dir = tmp_dir, location = points, e_source = "mapzen" + ), "SpatRaster")) + mapzen_tile <- paste0(tmp_dir, "/elev/srtm.tif") + expect_true(file.exists(mapzen_tile)) + + # Check data matches expectation + skip_if(!file.exists(mapzen_tile[1])) + elev_mapzen <- terra::rast(mapzen_tile[1]) + thumb_2 <- terra::aggregate(elev_mapzen, fact = 64) + + # Run this code manually to update the "Expected" value + if (FALSE) { + terra::writeRaster( + thumb_2, overwrite = TRUE, + test_path("expected", "mapzen_pt.tif") + ) + } + + expected <- terra::rast(test_path("expected", "mapzen_pt.tif")) + expect_true(all.equal( + unname(terra::rast(thumb_2)), + unname(terra::rast(expected)) + )) + +}) + +test_that("elev() downloads polygon from GeoData", { + + skip_if_server_offline("https://srtm.csi.cgiar.org") + tmp_dir <- tempdir() + on.exit(unlink(tmp_dir)) + + # download srtm using a polygon ### + expect_true(inherits(elev( + output_dir = tmp_dir, location = polygon_py_sm, + e_source = "geodata", + quiet = TRUE + ), "SpatRaster")) + + srtm_tile <- paste0(tmp_dir, "/elev/srtm.tif") + expect_true(file.exists(srtm_tile)) + + # Check data matches expectation + skip_if(!file.exists(srtm_tile[1])) + elev_srtm <- terra::rast(srtm_tile[1]) + thumb_3 <- terra::aggregate(elev_srtm, fact = 64) + + # Run this code manually to update the "Expected" value + if (FALSE) { + terra::writeRaster( + thumb_3, overwrite = TRUE, + test_path("expected", "srtm_py.tif") + ) + } + + expected <- terra::rast(test_path("expected", "srtm_py.tif")) + expect_true(all.equal( + unname(terra::rast(thumb_3)), + unname(terra::rast(expected)) + )) + +}) + +test_that("elev() downloads points from GeoData", { + + skip_if_server_offline("https://srtm.csi.cgiar.org") + tmp_dir <- tempdir() + on.exit(unlink(tmp_dir)) + + elev( + output_dir = tmp_dir, location = points_sm, e_source = "geodata", + quiet = TRUE + ) + + srtm_tile <- paste0(tmp_dir, "/elev/srtm.tif") + expect_true(file.exists(srtm_tile)) + + # Check data matches expectation + skip_if(!file.exists(srtm_tile[1])) + elev_srtm <- terra::rast(srtm_tile[1]) + thumb_4 <- terra::aggregate(elev_srtm, fact = 64) + + # Run this code manually to update the "Expected" value + if (FALSE) { + terra::writeRaster( + thumb_4, overwrite = TRUE, + test_path("expected", "srtm_pt.tif") + ) + } + + expected <- terra::rast(test_path("expected", "srtm_pt.tif")) + expect_true(all.equal( + unname(terra::rast(thumb_4)), + unname(terra::rast(expected)) + )) + }) diff --git a/tests/testthat/test-extract.R b/tests/testthat/test-extract.R index 71d16c8..f478608 100644 --- a/tests/testthat/test-extract.R +++ b/tests/testthat/test-extract.R @@ -3,6 +3,7 @@ test_that("ce_extract() works", { # Create temporary file to supply to the ce_extract temp_path <- tempfile() + on.exit(unlink(file.path(temp_path)), add = TRUE) # Create the required subdirectories dir.create(file.path(temp_path, "/elev"), recursive = TRUE) @@ -10,7 +11,6 @@ test_that("ce_extract() works", { dir.create(file.path(temp_path, "/tmax"), recursive = TRUE) dir.create(file.path(temp_path, "/tavg"), recursive = TRUE) dir.create(file.path(temp_path, "/tmin"), recursive = TRUE) - on.exit(unlink(file.path(temp_path)), add = TRUE) # Create a empty raster serving as a base r <- terra::rast(ncol = 10, nrow = 10) @@ -68,14 +68,15 @@ test_that("ce_extract() works", { #** No location group #### - #* default messages when no id provided #### - expect_silent(expect_message({ + #* default warning when no location_g provided #### + expect_silent(expect_warning( data_py <- ce_extract( path = file.path(temp_path), location = pol_py, location_g = NULL, c_source = "WorldClim", var = "all" - ) - })) + ), + "location_g must be one of: " + )) #* length / names of output data.frames #### expect_named(data_py, c("tavg_m", "tavg_sd", "tmin_m", "abmt", "tmin_sd", @@ -148,13 +149,14 @@ test_that("ce_extract() works", { #** No location group #### #* default messages when no id provided #### - expect_message({ + expect_warning( data_pt <- ce_extract( path = file.path(temp_path), location = pol_pt, location_g = NULL, c_source = "WorldClim", var = "all" - ) - }) + ), + "location_g must be one of: " + ) #* length / names of output data.frames #### expect_named(data_pt, c("tavg", "tmin", "tmax", @@ -255,6 +257,11 @@ test_that("ce_extract() works", { location_g = "grp", location_df = location_df) ) + expect_warning( + .location_helper(location = pol_pt, + location_g = NULL, + location_df = location_df) + ) # .c_source_helper expect_no_error(.c_source_helper(c_source = "CHELSA")) diff --git a/tests/testthat/test-plot.R b/tests/testthat/test-plot.R index 9432584..06046a6 100644 --- a/tests/testthat/test-plot.R +++ b/tests/testthat/test-plot.R @@ -11,10 +11,6 @@ test_that("plot_XX() fails gracefully", { }) test_that("ce_plot() works", { - - library("terra") - library("sf") - # Set testing data #### # Create temporary file to supply to the ce_extract