R/gisco_get_nuts.R

In dieghernan/giscoR: Download Map Data from GISCO API - Eurostat

#' Get GISCO NUTS [`sf`][sf::st_sf] polygons, points and lines
#'
#' @description
#' Returns
#'
#' ```{r, echo=FALSE, results='asis'}
#'
#' cat(paste0(" [NUTS regions]",
#'       "(https://en.wikipedia.org/wiki/Nomenclature_of_Territorial_",
#'       "Units_for_Statistics) "))
#'
#' ```
#' polygons, lines and points at a specified scale, as provided by GISCO.
#'
#' NUTS are provided at three different levels:
#' * `"0"`: Country level
#' * `"1"`: Groups of states/regions
#' * `"2"`: States/regions
#' * `"3"`: Counties/provinces/districts
#'
#' Note that NUTS-level definition may vary across countries. See also
#' ```{r, echo=FALSE, results='asis'}
#'
#' cat(
#'   paste0(" <https://ec.europa.eu/eurostat/web/gisco/geodata",
#'       "//statistical-units/territorial-units-statistics>.")
#'    )
#'
#' ```
#'
#' @family political
#'
#' @return A [`sf`][sf::st_sf] object specified by `spatialtype`. The resulting
#' [`sf`][sf::st_sf] object would present an additional column `geo` (equal to
#' `NUTS_ID`) for improving compatibility with \CRANpkg{eurostat} package. See
#' [eurostat::get_eurostat_geospatial()]).
#'
#' See also [gisco_nuts] to understand the columns and values provided.
#'
#' @param year Release year of the file. One
#'   of `r gsc_helper_year_docs("nuts")`.
#'
#' @param spatialtype Type of geometry to be returned:
#'  * `"BN"`: Boundaries - `LINESTRING` object.
#'  * `"LB"`: Labels - `POINT` object.
#'  * `"RG"`: Regions - `MULTIPOLYGON/POLYGON` object.
#'
#'  **Note that** parameters `country`, `nuts_level` and `nuts_id` would be only
#'  applied when `spatialtype` is `"BN"` or `"RG"`.
#'
#' @param nuts_level NUTS level. One of `"0"`, `"1"`, `"2"` or `"3"`.
#' See **Description**.
#'
#' @param nuts_id Optional. A character vector of NUTS IDs.
#'
#' @inheritParams gisco_get_countries
#'
#' @inheritSection gisco_get_countries About caching
#'
#' @seealso [gisco_nuts], [gisco_get_countries()],
#' [eurostat::get_eurostat_geospatial()]
#'
#' @source <https://gisco-services.ec.europa.eu/distribution/v2/>
#'
#' @export
#'
#' @examples
#' nuts2 <- gisco_get_nuts(nuts_level = 2)
#'
#' library(ggplot2)
#'
#' ggplot(nuts2) +
#'   geom_sf() +
#'   # ETRS89 / ETRS-LAEA
#'   coord_sf(
#'     crs = 3035, xlim = c(2377294, 7453440),
#'     ylim = c(1313597, 5628510)
#'   ) +
#'   labs(title = "NUTS-2 levels")
#' \donttest{
#' # NUTS-3 for Germany
#' germany_nuts3 <- gisco_get_nuts(nuts_level = 3, country = "Germany")
#'
#' ggplot(germany_nuts3) +
#'   geom_sf() +
#'   labs(
#'     title = "NUTS-3 levels",
#'     subtitle = "Germany",
#'     caption = gisco_attributions()
#'   )
#'
#'
#' # Select specific regions
#' select_nuts <- gisco_get_nuts(nuts_id = c("ES2", "FRJ", "FRL", "ITC"))
#'
#' ggplot(select_nuts) +
#'   geom_sf(aes(fill = CNTR_CODE)) +
#'   scale_fill_viridis_d()
#' }
gisco_get_nuts <- function(year = "2016", epsg = "4326", cache = TRUE,
                           update_cache = FALSE, cache_dir = NULL,
                           verbose = FALSE, resolution = "20",
                           spatialtype = "RG", country = NULL,
                           nuts_id = NULL, nuts_level = "all") {
  ext <- "geojson"

  nuts_level <- as.character(nuts_level)

  api_entry <- gsc_api_url(
    id_giscoR = "nuts", year = year, epsg = epsg,
    resolution = resolution, spatialtype = spatialtype, ext = ext,
    nuts_level = nuts_level, level = NULL, verbose = verbose
  )

  filename <- basename(api_entry)

  # Check if data is already available
  checkdata <- grep("NUTS_RG_20M_2016_4326", filename)
  if (isFALSE(update_cache) && length(checkdata)) {
    dwnload <- FALSE
    data_sf <- giscoR::gisco_nuts

    gsc_message(
      verbose,
      "Loaded from gisco_nuts dataset. Use update_cache = TRUE to load",
      " the shapefile from the .geojson file"
    )

    if (nuts_level %in% c("0", "1", "2", "3")) {
      data_sf <- data_sf[data_sf$LEVL_CODE == nuts_level, ]
    }
  } else {
    dwnload <- TRUE
  }
  if (dwnload) {
    # Speed up if requesting units
    if (!is.null(nuts_id) && spatialtype %in% c("RG", "LB")) {
      data_sf <- gisco_get_units(
        id_giscoR = "nuts", unit = nuts_id,
        mode = "sf", year = year, epsg = epsg, cache = cache,
        cache_dir = cache_dir, update_cache = update_cache, verbose = verbose,
        resolution = resolution, spatialtype = spatialtype
      )
    } else {
      if (cache) {
        # Guess source to load
        namefileload <- gsc_api_cache(
          api_entry, filename, cache_dir,
          update_cache, verbose
        )
      } else {
        namefileload <- api_entry
      }

      if (is.null(namefileload)) {
        return(NULL)
      }
      # Load - geojson only so far
      data_sf <- gsc_api_load(namefileload, epsg, ext, cache, verbose)
    }
  }
  if (!is.null(country) && "CNTR_CODE" %in% names(data_sf)) {
    # Convert ISO3 to EUROSTAT thanks to Vincent Arel-Bundock (countrycode)
    country <- gsc_helper_countrynames(country, "eurostat")
    data_sf <- data_sf[data_sf$CNTR_CODE %in% country, ]
  }

  if (!is.null(nuts_id) && "NUTS_ID" %in% names(data_sf)) {
    data_sf <- data_sf[data_sf$NUTS_ID %in% nuts_id, ]
  }

  # Add geo field for compatibility with eurostat
  if ("NUTS_ID" %in% names(data_sf)) {
    data_sf$geo <- data_sf$NUTS_ID

    # Recompute position
    allnams <- names(data_sf)
    geo_col <- attr(data_sf, "sf_column")
    # geo_col last
    neword <- unique(c(setdiff(allnams, geo_col), geo_col))

    data_sf <- data_sf[, neword]
  }
  return(data_sf)
}