feat/fix: add a flip arg for jpg files, add a retina arg for high res…

… tiles fix #35 fix #34
riatelab · Jan 29, 2025 · 6de1ecc · 6de1ecc
1 parent c49ec70
commit 6de1ecc
Show file tree

Hide file tree

Showing 4 changed files with 122 additions and 55 deletions.
diff --git a/R/get_tiles.R b/R/get_tiles.R
@@ -1,7 +1,8 @@
 #' @title Get basemap tiles from map servers
 #' @name get_tiles
 #' @description Get map tiles based on a spatial object extent. Maps can be
-#' fetched from various map servers.
+#' fetched from various map servers ('OpenStreetMap', 'Stadia', 'Esri', 'CARTO',
+#' or 'Thunderforest').
 #' @param x sf, sfc, bbox, SpatRaster, SpatVector or SpatExtent object.
 #' If \code{x} is a SpatExtent it
 #' must express coordinates in lon/lat WGS84 (epsg:4326).
@@ -20,32 +21,42 @@
 #' @param cachedir name of a folder used to cache tiles. If not set, tiles
 #' are cached in a \link[base:tempfile]{tempdir} folder.
 #' @param forceDownload if TRUE, existing cached tiles may be overwritten.
+#' @param flip if TRUE, tiles are vertically flipped. The default is TRUE for
+#' providers serving JPG files and FALSE for others.
+#' @param retina if TRUE, tiles are downloaded in high resolution if they exist.
+#' Stadia and CARTO provide such tiles.
 #' @details
 #' Zoom levels are described in the OpenStreetMap wiki:
 #' \url{https://wiki.openstreetmap.org/wiki/Zoom_levels}. \cr\cr
-#' Providers: \cr
+#'
+#' Here is the complete list of builtin providers: \cr
+#'
 #' "OpenStreetMap", "OpenStreetMap.DE", "OpenStreetMap.France",
-#' "OpenStreetMap.HOT", "OpenTopoMap", \cr
+#' "OpenStreetMap.HOT", "OpenTopoMap",
+#'
+#' "Stadia.AlidadeSmooth", "Stadia.AlidadeSmoothDark",
+#' "Stadia.OSMBright", "Stadia.Outdoors",
 #' "Stadia.StamenToner", "Stadia.StamenTonerBackground",
-#' "Stadia.StamenTonerLines", "Stadia.StamenTonerLabels",
-#' "Stadia.StamenTonerLite",
-#' "Stadia.StamenWatercolor", "Stadia.StamenTerrain",
-#' "Stadia.StamenTerrainBackground",
-#' "Stadia.StamenTerrainLabels", \cr
-#' "Esri.WorldStreetMap",
-#' "Esri.WorldTopoMap", "Esri.WorldImagery", "Esri.WorldTerrain",
-#' "Esri.WorldShadedRelief", "Esri.OceanBasemap", "Esri.NatGeoWorldMap",
-#' "Esri.WorldGrayCanvas", \cr
-#' "CartoDB.Positron", "CartoDB.PositronNoLabels",
-#' "CartoDB.PositronOnlyLabels", "CartoDB.DarkMatter",
-#' "CartoDB.DarkMatterNoLabels",
-#' "CartoDB.DarkMatterOnlyLabels", "CartoDB.Voyager", "CartoDB.VoyagerNoLabels",
-#' "CartoDB.VoyagerOnlyLabels", \cr
+#' "Stadia.StamenTonerLines",
+#' "Stadia.StamenTonerLabels", "Stadia.StamenTonerLite",
+#' "Stadia.StamenWatercolor",
+#' "Stadia.StamenTerrain", "Stadia.StamenTerrainBackground",
+#' "Stadia.StamenTerrainLabels",
+#'
+#' "Esri.WorldStreetMap", "Esri.WorldTopoMap", "Esri.WorldImagery",
+#' "Esri.WorldTerrain", "Esri.WorldShadedRelief", "Esri.OceanBasemap",
+#' "Esri.NatGeoWorldMap", "Esri.WorldGrayCanvas", "CartoDB.Positron",
+#'
+#' "CartoDB.PositronNoLabels", "CartoDB.PositronOnlyLabels",
+#' "CartoDB.DarkMatter",
+#' "CartoDB.DarkMatterNoLabels", "CartoDB.DarkMatterOnlyLabels",
+#' "CartoDB.Voyager", "CartoDB.VoyagerNoLabels", "CartoDB.VoyagerOnlyLabels",
+#'
 #' "Thunderforest.OpenCycleMap", "Thunderforest.Transport",
-#' "Thunderforest.TransportDark", "Thunderforest.SpinalMap",
-#' "Thunderforest.Landscape",
-#' "Thunderforest.Outdoors", "Thunderforest.Pioneer",
-#' "Thunderforest.MobileAtlas",
+#' "Thunderforest.TransportDark",
+#' "Thunderforest.SpinalMap", "Thunderforest.Landscape",
+#' "Thunderforest.Outdoors",
+#' "Thunderforest.Pioneer", "Thunderforest.MobileAtlas",
 #' "Thunderforest.Neighbourhood"
 #' @export
 #' @return A SpatRaster is returned.
@@ -85,7 +96,9 @@ get_tiles <- function(x,
                       verbose = FALSE,
                       apikey,
                       cachedir,
-                      forceDownload = FALSE) {
+                      forceDownload = FALSE,
+                      retina = TRUE,
+                      flip) {
   # test input valididy
   test_input(x)
 
@@ -104,11 +117,11 @@ get_tiles <- function(x,
   # get file name
   filename <- get_filename(
     res$bbox_input, zoom, crop, project, cachedir,
-    param$q
+    param$q, retina, flip
   )
 
   # display info
-  display_infos(verbose, zoom, param$cit, cachedir = cachedir)
+  display_infos(verbose, zoom, param$cit, cachedir)
 
   # get cached raster if it already exists
   ras <- get_cached_raster(filename, forceDownload, verbose)
@@ -122,11 +135,11 @@ get_tiles <- function(x,
   # download images
   images <- download_tiles(
     tile_grid, param, apikey, verbose,
-    cachedir, forceDownload
+    cachedir, forceDownload, retina
   )
 
   # compose images
-  ras <- compose_tiles(tile_grid, images)
+  ras <- compose_tiles(tile_grid, images, flip)
 
 
   # project if needed

diff --git a/R/utils.R b/R/utils.R
@@ -140,8 +140,16 @@ get_cachedir <- function(cachedir, src) {
 }
 
 # create a filename with hash
-get_filename <- function(bbox, zoom, crop, project, cachedir, url) {
-  filename <- digest::digest(paste0(bbox, zoom, crop, project, cachedir, url),
+get_filename <- function(bbox, zoom, crop, project, cachedir,
+                         url, retina, flip) {
+  if (missing(flip)) {
+    flip <- ""
+  }
+  filename <- digest::digest(
+    paste0(
+      bbox, zoom, crop, project,
+      cachedir, url, retina, flip
+    ),
     algo = "md5", serialize = FALSE
   )
   full_filename <- file.path(cachedir, paste0(filename, ".tif"))
@@ -174,7 +182,7 @@ get_cached_raster <- function(filename, forceDownload, verbose) {
 
 # get the tiles according to the grid
 download_tiles <- function(tile_grid, param, apikey, verbose, cachedir,
-                           forceDownload) {
+                           forceDownload, retina) {
   images <- vector("list", length = nrow(tile_grid$tiles))
   zoom <- tile_grid$zoom
   ext <- param$ext
@@ -193,9 +201,11 @@ download_tiles <- function(tile_grid, param, apikey, verbose, cachedir,
   for (i in seq_along(images)) {
     x <- tile_grid$tiles[i, ]
     x <- trimws(x)
+    is_retina <- grepl(pattern = "{r}", x = param$q, fixed = TRUE)
+    ret <- ifelse(isTRUE(retina) && isTRUE(is_retina), "@2x", "")
     outfile <- paste0(
       cachedir, "/", src, "_", zoom, "_", x[1], "_",
-      x[2], ".", ext
+      x[2], "_", ret, ".", ext
     )
     if (!file.exists(outfile) || isTRUE(forceDownload)) {
       q <- gsub(
@@ -207,6 +217,12 @@ download_tiles <- function(tile_grid, param, apikey, verbose, cachedir,
       q <- gsub(pattern = "{z}", replacement = zoom, x = q, fixed = TRUE)
       q <- gsub(pattern = "{apikey}", replacement = apikey, x = q, fixed = TRUE)
 
+      if (isTRUE(retina)) {
+        q <- gsub(pattern = "{r}", replacement = "@2x", x = q, fixed = TRUE)
+      } else {
+        q <- gsub(pattern = "{r}", replacement = "", x = q, fixed = TRUE)
+      }
+
       e <- try(curl::curl_download(url = q, destfile = outfile), silent = TRUE)
 
       if (inherits(e, "try-error")) {
@@ -225,15 +241,24 @@ download_tiles <- function(tile_grid, param, apikey, verbose, cachedir,
   if (verbose) {
     ntiles <- length(images)
     message(ntiles, " tile", ifelse(ntiles > 1, "s", ""))
+
     if (cpt != length(images)) {
       message("The resulting raster is built with previously cached tiles.")
+    } else {
+      if (isTRUE(retina)) {
+        if (isTRUE(is_retina)) {
+          message("The resulting raster uses high resolution tiles.")
+        } else {
+          message("High resolution tiles are unavailable on this server.")
+        }
+      }
     }
   }
   return(images)
 }
 
 # compose tiles
-compose_tiles <- function(tile_grid, images) {
+compose_tiles <- function(tile_grid, images, flip) {
   bricks <- vector("list", nrow(tile_grid$tiles))
   ext <- unique(tools::file_ext(images))[1]
   for (i in seq_along(bricks)) {
@@ -261,6 +286,19 @@ compose_tiles <- function(tile_grid, images) {
 
     # warning is: [rast] unknown extent
     r_img <- suppressWarnings(terra::rast(img))
+
+    # flip tiles
+    if (missing(flip)) {
+      flip <- FALSE
+      if (ext == "jpg") {
+        flip <- TRUE
+      }
+    }
+    if (isTRUE(flip)) {
+      r_img <- terra::flip(r_img)
+    }
+
+
     # add RGB info
     if (is.null(terra::RGB(r_img))) {
       terra::RGB(r_img) <- c(1, 2, 3)

diff --git a/inst/tinytest/test_maptiles.R b/inst/tinytest/test_maptiles.R
@@ -130,8 +130,9 @@ expect_true(dir.exists(file.path(tempdir(), "pop")))
 # get_filename() ----
 expect_equal(maptiles:::get_filename(bbox = nc_bbox, zoom = 7, crop = TRUE,
                                      project = FALSE,
-                                     cachedir = "/dummy/folder", url = osm$q),
-             "/dummy/folder/cf34f67f2c00b60def2ecea6a61976d7.tif")
+                                     cachedir = "/dummy/folder",
+                                     url = osm$q, retina = TRUE, flip = FALSE),
+             "/dummy/folder/b65a2ceb6cb4f13a626b86d05438ce96.tif")
 
 
 # display_infos() ----

diff --git a/man/get_tiles.Rd b/man/get_tiles.Rd