From aa16d1e11fc96d47efe490786e6667f6e2daa9d2 Mon Sep 17 00:00:00 2001 From: 16EAGLE Date: Mon, 4 Nov 2024 14:39:42 +0100 Subject: [PATCH] streamlined spatialization and compositing, dropped two dependencies --- DESCRIPTION | 10 ++++---- NAMESPACE | 9 ++++---- NEWS.md | 15 ++++++++++++ R/internal.R | 64 ++++++++++++++++++++++++++++++++++++---------------- 4 files changed, 69 insertions(+), 29 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index a87ef8e..84132b3 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: basemaps Type: Package Title: Accessing Spatial Basemaps in R -Version: 0.0.8 +Version: 0.1.0 Depends: R (>= 3.5.0) Date: 2024-10-31 @@ -14,15 +14,14 @@ Imports: sf, slippymath, httr, - curl, + magick, terra, - stars, pbapply, - magick, utils, grDevices, methods Suggests: + stars, raster, ggplot2, png, @@ -31,4 +30,5 @@ Suggests: testthat, covr BugReports: https://github.com/16eagle/basemaps/issues -RoxygenNote: 7.3.1 +URL: https://jakob.schwalb-willmann.de/basemaps/ +RoxygenNote: 7.3.2 diff --git a/NAMESPACE b/NAMESPACE index bee79d8..750572b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -18,19 +18,22 @@ export(get_maptypes) export(gg_raster) export(reset_defaults) export(set_defaults) -importFrom(curl,curl_download) importFrom(grDevices,col2rgb) importFrom(grDevices,topo.colors) importFrom(graphics,plot) importFrom(httr,GET) importFrom(httr,http_error) +importFrom(httr,stop_for_status) +importFrom(httr,write_disk) importFrom(magick,image_convert) +importFrom(magick,image_info) importFrom(magick,image_read) importFrom(magick,image_write) importFrom(methods,as) importFrom(pbapply,pbapply) importFrom(pbapply,pboptions) importFrom(sf,"st_crs<-") +importFrom(sf,gdal_utils) importFrom(sf,st_as_sfc) importFrom(sf,st_bbox) importFrom(sf,st_crop) @@ -38,13 +41,11 @@ importFrom(sf,st_crs) importFrom(sf,st_transform) importFrom(slippymath,bbox_to_tile_grid) importFrom(slippymath,tile_bbox) -importFrom(stars,read_stars) -importFrom(stars,st_mosaic) -importFrom(stars,st_set_bbox) importFrom(terra,"RGB<-") importFrom(terra,"ext<-") importFrom(terra,aggregate) importFrom(terra,as.array) +importFrom(terra,as.raster) importFrom(terra,crop) importFrom(terra,ext) importFrom(terra,extend) diff --git a/NEWS.md b/NEWS.md index 5705711..3a5aa70 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,20 @@ *** +## basemaps 0.1.0 +Decreasing dependencies, minor improvements + +**Changes:** + +* updated partly outdated documentation examples +* updated `README` to include an animated map type preview +* changed the way raster tiles are geo-located and mosaiced +* tidied up the dependency tree, removed two dependencies + +
+ + +*** + ## basemaps 0.0.8 New map service *Maptiler*, minor improvements diff --git a/R/internal.R b/R/internal.R index 7cb1a36..39a4811 100644 --- a/R/internal.R +++ b/R/internal.R @@ -1,8 +1,12 @@ #' Suppress messages and warnings #' @keywords internal #' @noRd -quiet <- function(expr){ +quiet <- function(expr, no_cat = FALSE){ #return(expr) + if(no_cat){ + sink(tempfile(), type = "out") + on.exit(sink()) + } return(suppressWarnings(suppressMessages(expr))) } @@ -112,12 +116,11 @@ out <- function(input, type = 1, ll = NULL, msg = FALSE, sign = "", verbose = ge #' get map #' @importFrom slippymath bbox_to_tile_grid tile_bbox -#' @importFrom magick image_read image_write image_convert -#' @importFrom curl curl_download -#' @importFrom httr http_error GET -#' @importFrom sf st_transform st_bbox st_as_sfc st_crs st_crs<- st_crop -#' @importFrom stars read_stars st_set_bbox st_mosaic -#' @importFrom terra rast ext ext<- mosaic project crop writeRaster extend merge RGB<- +#' @importFrom magick image_read image_write image_convert image_info +#' @importFrom httr http_error GET write_disk stop_for_status +#' @importFrom sf st_transform st_bbox st_as_sfc st_crs st_crs<- st_crop gdal_utils +#' @importFrom terra rast ext ext<- mosaic project crop writeRaster extend merge RGB<- as.raster +#' @importFrom grDevices col2rgb #' @importFrom methods as #' @keywords internal #' @noRd @@ -197,7 +200,11 @@ out <- function(input, type = 1, ll = NULL, msg = FALSE, sign = "", verbose = ge if(all(status == 403, any(map_service == "osm_thunderforest", map_service == "maptiler"))) out("Authentification failed. Is your map_token correct?", type = 3) } if(!file.exists(file)){ - tryCatch(curl_download(url = url, destfile = file), error = function(e) out(paste0("Tile download failed: ", e$message), type = 3)) + #tryCatch(curl_download(url = url, destfile = file), error = function(e) out(paste0("Tile download failed: ", e$message), type = 3)) + tryCatch({ + result <- GET(url = url, write_disk(file, overwrite=TRUE)) + httr::stop_for_status(result) + }, error = function(e) out(paste0("Tile download failed: ", e$message), type = 3)) }#utils::download.file(url = url, destfile = file, quiet = T) # test if file can be loaded @@ -217,19 +224,19 @@ out <- function(input, type = 1, ll = NULL, msg = FALSE, sign = "", verbose = ge return(file) }) - # create composite + # spatialize PNG and create TIF composite - ## STARS VERSION - r <- mapply(img = images, x = tg$tiles$x, y = tg$tiles$y, function(img, x, y){ - box <- tile_bbox(x, y, tg$zoom) - img_st <- read_stars(img) - img_st <- st_set_bbox(img_st, box) - st_crs(img_st) <- tg$crs - return(img_st) - }, SIMPLIFY = F) - r <- do.call(stars::st_mosaic, r) - r <- as(r, "SpatRaster") - RGB(r) <- 1:3 + ## STARS VERSION -- works, but dependencies + # r <- mapply(img = images, x = tg$tiles$x, y = tg$tiles$y, function(img, x, y){ + # box <- tile_bbox(x, y, tg$zoom) + # img_st <- read_stars(img) + # img_st <- st_set_bbox(img_st, box) + # st_crs(img_st) <- tg$crs + # return(img_st) + # }, SIMPLIFY = F) + # r <- do.call(stars::st_mosaic, r) + # r <- as(r, "SpatRaster") + # RGB(r) <- 1:3 ## TERRA VERSION # r <- mapply(img = images, x = tg$tiles$x, y = tg$tiles$y, function(img, x, y){ @@ -253,6 +260,23 @@ out <- function(input, type = 1, ll = NULL, msg = FALSE, sign = "", verbose = ge # RGB(r) <- 1:3 # # end temp FIX + ## TERRA VERSION + images_tif <- mapply(img = images, x = tg$tiles$x, y = tg$tiles$y, function(img, x, y){ + box <- tile_bbox(x, y, tg$zoom) + img_mgc <- magick::image_read(img) + img_inf <- magick::image_info(img_mgc) + img_rst <- terra::rast(aperm(array(grDevices::col2rgb(terra::as.raster(img_mgc)), c(3,as.numeric(img_inf["width"]),as.numeric(img_inf["height"]))), c(3,2,1))) + terra::crs(img_rst) <- as.character(tg$crs$wkt) + terra::ext(img_rst) <- c(box[c("xmin", "xmax", "ymin", "ymax")]) + + img_tif <- gsub(".png", ".tif", img) + terra::writeRaster(img_rst, filename = img_tif, overwrite = T, datatype = "INT1U") #0-255 + return(img_tif) + }, SIMPLIFY = F, USE.NAMES = F) + + gdal_utils("buildvrt", unlist(images_tif), file_comp, options = c("-vrtnodata", "-9999", "-srcnodata", "nan"),) + r <- terra::rast(file_comp) + if(isFALSE(no_transform)){ ## needed? if(as.numeric(tg$crs$epsg) != 3857){ #r <- st_transform(r, crs = tg$crs)