Merge pull request #89 from rOpenSpain/hlpprov

Add esp_make_provider

NAMESPACE

@@ -34,6 +34,7 @@ export(esp_get_rivers)
 export(esp_get_roads)
 export(esp_get_simpl_ccaa)
 export(esp_get_simpl_prov)
+export(esp_make_provider)
 export(esp_set_cache_dir)
 export(layer_spatraster)
 export(providerEspTileOptions)

NEWS.md

@@ -9,6 +9,8 @@
         `esp_tiles_providers`.
     -   You can use a custom url with the `type` argument in `esp_getTiles()`
         #88 .
+    -   Add new function `esp_make_provider()` that helps to create custom
+        providers.
 
 # mapSpain 0.6.2
 

R/esp_getTiles.R

@@ -27,7 +27,7 @@
 #'   - The name of one of the  pre-defined providers
 #'     (see [esp_tiles_providers]).
 #'   - A list with two named elements `id` and `q` with your own parameters.
-#'     See **Details** and examples.
+#'     See [esp_make_provider()] and examples.
 #' @param zoom Zoom level. If `NULL`, it is determined automatically. If set,
 #'   it overrides `zoommin`. Only valid for WMTS tiles. On a single point it
 #'   applies a buffer to the point and on `zoom = NULL` the function set a zoom
@@ -90,54 +90,6 @@
 #'
 #' `x <- sf::st_transform(x, 3857)`
 #'
-#'  ## Custom tile providers
-#'
-#'  You can pass a named list to the `type` parameter to download any type of
-#'  tile provided as of the
-#'  [OGC Standard](http://opengeospatial.github.io/e-learning/wms/text/operations.html#getmap).
-#'
-#'  As an example, a valid list for a WMS provider would be:
-#'
-#' ```r
-#' x <- esp_get_prov("Segovia")
-#'
-#' custom_prov <- list(
-#'   id = "an_id_for_caching",
-#'   q = paste0(
-#'     "https://idecyl.jcyl.es/geoserver/ge/wms?request=GetMap",
-#'     "&service=WMS&version=1.3.0",
-#'     "&format=image/png",
-#'     "&CRS=epsg:3857",
-#'     "&layers=geolog_cyl_litologia",
-#'     "&styles="
-#'   )
-#' )
-#' custom_tile <- esp_getTiles(x, custom_prov)
-#'
-#' ```
-#' In the case of a WMTS provider, a valid list would be:
-#'
-#' ```r
-#' x <- esp_get_prov("Segovia")
-#'
-#' custom_wmts <- list(
-#'   id = "cyl_wmts",
-#'   q = paste0(
-#'     "https://www.ign.es/wmts/ign-base?",
-#'     "request=GetTile&service=WMTS&version=1.0.0",
-#'     "&format=image/png",
-#'     "&tilematrixset=GoogleMapsCompatible",
-#'     "&layer=IGNBaseTodo&style=default"
-#'   )
-#' )
-#' seg_tile <- esp_getTiles(x, custom_wmts)
-
-#' ```
-#' Note that:
-#' - \pkg{mapSpain} would not provide advice on the parameter `q` to be
-#'   provided.
-#' - Currently, on **WMTS** requests only services with
-#'   `tilematrixset=GoogleMapsCompatible` are supported.
 #'
 #' @examples
 #' \dontrun{
@@ -164,16 +116,13 @@
 #'
 #' # A custom WMS provided
 #'
-#' custom_wms <- list(
+#' custom_wms <- esp_make_provider(
 #'   id = "an_id_for_caching",
-#'   q = paste0(
-#'     "https://idecyl.jcyl.es/geoserver/ge/wms?request=GetMap",
-#'     "&service=WMS&version=1.3.0",
-#'     "&format=image/png",
-#'     "&CRS=epsg:3857",
-#'     "&layers=geolog_cyl_litologia",
-#'     "&styles="
-#'   )
+#'   q = "https://idecyl.jcyl.es/geoserver/ge/wms?",
+#'   service = "WMS",
+#'   version = "1.3.0",
+#'   format = "image/png",
+#'   layers = "geolog_cyl_litologia"
 #' )
 #'
 #' custom_wms_tile <- esp_getTiles(segovia, custom_wms)
@@ -183,18 +132,13 @@
 #'
 #' # A custom WMTS provider
 #'
-#' custom_wmts <- list(
+#' custom_wmts <- esp_make_provider(
 #'   id = "cyl_wmts",
-#'   q = paste0(
-#'     "https://www.ign.es/wmts/pnoa-ma?",
-#'     "request=GetTile&service=WMTS&version=1.0.0",
-#'     "&format=image/jpeg",
-#'     "&tilematrixset=GoogleMapsCompatible",
-#'     "&layer=OI.OrthoimageCoverage&style=default"
-#'   )
+#'   q = "https://www.ign.es/wmts/pnoa-ma?",
+#'   service = "WMTS",
+#'   layer = "OI.OrthoimageCoverage"
 #' )
 #'
-#'
 #' custom_wmts_tile <- esp_getTiles(segovia, custom_wmts)
 #'
 #' autoplot(custom_wmts_tile) +

R/esp_make_provider.R

@@ -0,0 +1,119 @@
+#' Create a custom tile provider
+#'
+#' @description
+#' Helper function for [esp_getTiles()] that helps to create a custom provider.
+#'
+#' @family imagery utilities
+#' @seealso [esp_getTiles()].
+#'
+#' For a list of potential providers from Spain check
+#' [IDEE Directory](https://www.idee.es/segun-tipo-de-servicio).
+#'
+#'
+#' @return
+#' A named list with two elements `id` and `q`.
+#'
+#' @export
+#'
+#' @param id An identifier for the user. Would be used also for identifying
+#'   cached tiles.
+#'
+#' @param q The base url of the service
+#'
+#' @param service The type of tile service, either `"WMS"` or `"WMTS"`.
+#'
+#' @param layers The name of the layer to retrieve
+#'
+#' @param ... Additional parameters to the query, like `version`, `format`,
+#'   `crs/srs`, `style`, ... depending on the capabilities of the service.
+#'
+#' @details
+#' This function is meant to work with services provided as of the
+#'  [OGC Standard](http://opengeospatial.github.io/e-learning/wms/text/operations.html#getmap).
+#'
+#' Note that:
+#' - \pkg{mapSpain} would not provide advice on the parameter `q` to be
+#'   provided.
+#' - Currently, on **WMTS** requests only services with
+#'   `tilematrixset=GoogleMapsCompatible` are supported.
+#'
+#' @examples
+#' \dontrun{
+#' # This script downloads tiles to your local machine
+#' # Run only if you are online
+#'
+#' custom_wms <- esp_make_provider(
+#'   id = "an_id_for_caching",
+#'   q = "https://idecyl.jcyl.es/geoserver/ge/wms?",
+#'   service = "WMS",
+#'   layers = "geolog_cyl_litologia"
+#' )
+#'
+#' x <- esp_get_ccaa("Castilla y León", epsg = 3857)
+#'
+#' mytile <- esp_getTiles(x, type = custom_wms)
+#'
+#' tidyterra::autoplot(mytile) +
+#'   ggplot2::geom_sf(data = x, fill = NA)
+#' }
+esp_make_provider <- function(id, q, service, layers, ...) {
+  dots <- list(...)
+  names(dots) <- tolower(names(dots))
+
+  # Ignore tilematrixset
+  dots <- dots[names(dots) != "tilematrixset"]
+
+  # Minimal for WMS
+
+  if (toupper(service) == "WMS") {
+    def_params <- list(
+      q = q,
+      request = "GetMap",
+      service = "WMS",
+      version = "1.0.0",
+      format = "image/png",
+      layers = layers,
+      styles = ""
+    )
+  } else {
+    def_params <- list(
+      q = q,
+      request = "GetTile",
+      service = "WMTS",
+      version = "1.0.0",
+      format = "image/png",
+      layer = layers,
+      style = "",
+      tilematrixset = "GoogleMapsCompatible"
+    )
+  }
+
+  # Modify
+  end <- modifyList(def_params, dots)
+
+  # Here adjust crs values
+
+  if (end$service == "WMS") {
+    if (end$version < "1.3.0") {
+      names(end) <- gsub("crs", "srs", names(end))
+      end$srs <- ifelse(is.null(end$srs), "EPSG:3857", end$srs)
+    } else {
+      names(end) <- gsub("srs", "crs", names(end))
+      end$crs <- ifelse(is.null(end$crs), "EPSG:3857", end$crs)
+    }
+  }
+
+
+  # Create final list
+  final <- list(id = id)
+
+  # Create query
+  q <- gsub("\\?\\?$", "?", paste0(end$q, "?"))
+  rest <- end[names(end) != "q"]
+  q_end <- paste0(q, paste0(names(rest), "=", rest, collapse = "&"))
+
+  final$q <- q_end
+
+
+  return(final)
+}

codemeta.json

@@ -233,7 +233,7 @@
   "applicationCategory": "cartography",
   "isPartOf": "https://ropenspain.es/",
   "keywords": ["rOpenSpain", "tiles", "r", "maps", "spatial", "rstats", "r-package", "municipalities", "Spain", "gisco", "provinces", "ign", "administrative-boundaries", "ccaa", "static-tiles", "spain", "cran", "ropenspain", "ggplot2", "gis"],
-  "fileSize": "2729.047KB",
+  "fileSize": "2732.728KB",
   "citation": [
     {
       "@type": "SoftwareSourceCode",

inst/WORDLIST

@@ -60,6 +60,7 @@ HOTFIX
 Hernangomez
 Hexbin
 Hypsometry
+IDEE
 IDERioja
 IGN
 INE