R/esp_get_munic.R

In mapSpain: Administrative Boundaries of Spain

#' Get municipalities of Spain as \pkg{sf} polygons
#'
#' @description
#' Returns municipalities of Spain as polygons at a specified scale.
#'
#' * [esp_get_munic()] uses GISCO (Eurostat) as source. Please use
#'   [giscoR::gisco_attributions()]
#'
#' @family political
#' @family municipalities
#' @seealso [giscoR::gisco_get_lau()], [base::regex()].
#'
#' @return A \pkg{sf} polygon
#'
#' @export
#'
#' @source [GISCO API](https://gisco-services.ec.europa.eu/distribution/v2/)
#'
#'
#'
#'
#' @param year Release year. See **Details** for years available.

#' @param region A vector of names and/or codes for provinces
#'  or `NULL` to get all the municipalities. See **Details**.
#'
#' @param munic A name or [`regex`][base::grep()] expression with the names of
#'   the required municipalities. `NULL` would not produce any filtering.
#'
#' @inheritParams esp_get_nuts
#'
#' @inheritSection  esp_get_nuts About caching
#'
#' @inheritSection  esp_get_nuts  Displacing the Canary Islands
#'
#' @details
#'
#' The years available are:
#' * [esp_get_munic()]:  `year` could be one of "2001", "2004", "2006", "2008",
#'    "2010", "2013" and any year between 2016 and 2019.
#'    See [giscoR::gisco_get_lau()], [giscoR::gisco_get_communes()].
#'
#' * [esp_get_munic_siane()]: `year` could be passed as a single year ("YYYY"
#'   format, as end of year) or as a specific date ("YYYY-MM-DD" format).
#'   Historical information starts as of 2005.
#'
#' When using `region` you can use and mix names and NUTS codes
#' (levels 1, 2 or 3), ISO codes (corresponding to level 2 or 3) or
#' "cpro" (see [esp_codelist]).
#'
#' When calling a superior level (Province, Autonomous Community or NUTS1) ,
#' all the municipalities of that level would be added.
#'
#' @examples
#' \donttest{
#' # Get munics
#' Base <- esp_get_munic(year = "2019", region = "Castilla y Leon")
#'
#' # Provs for delimiting
#' provs <- esp_get_prov(prov = "Castilla y Leon")
#'
#' # Load population data
#' data("pobmun19")
#'
#' # Arrange and create breaks
#'
#' Base_pop <- merge(Base, pobmun19,
#'   by = c("cpro", "cmun"),
#'   all.x = TRUE
#' )
#'
#' br <- sort(c(
#'   0, 50, 100, 200, 500,
#'   1000, 5000, 50000, 100000,
#'   Inf
#' ))
#'
#' Base_pop$cuts <- cut(Base_pop$pob19, br, dig.lab = 20)
#'
#' # Plot
#' library(ggplot2)
#'
#'
#' ggplot(Base_pop) +
#'   geom_sf(aes(fill = cuts), color = NA) +
#'   geom_sf(data = provs, fill = NA, color = "grey70") +
#'   scale_fill_manual(values = hcl.colors(length(br), "cividis")) +
#'   labs(
#'     title = "Population in Castilla y Leon",
#'     subtitle = "INE, 2019",
#'     fill = "Persons"
#'   ) +
#'   theme_void()
#' }
esp_get_munic <- function(year = "2019",
                          epsg = "4258",
                          cache = TRUE,
                          update_cache = FALSE,
                          cache_dir = NULL,
                          verbose = FALSE,
                          region = NULL,
                          munic = NULL,
                          moveCAN = TRUE) {
  init_epsg <- as.character(epsg)
  year <- as.character(year)

  yearsav <-
    c(
      "2001",
      "2004",
      "2006",
      "2008",
      "2010",
      "2013",
      "2016",
      "2017",
      "2018",
      "2019"
    )

  if (!year %in% yearsav) {
    stop(
      "year ",
      year,
      " not available, try ",
      paste0("'", yearsav, "'", collapse = ", ")
    )
  }

  cache_dir <- esp_hlp_cachedir(cache_dir)

  if (init_epsg == "4258") {
    epsg <- "4326"
  }

  dwnload <- TRUE


  if (year == "2019" &&
    epsg == "4326" &&
    isFALSE(update_cache)) {
    if (verbose) {
      message("Reading from esp_munic.sf")
    }
    data_sf <- mapSpain::esp_munic.sf


    dwnload <- FALSE
  }

  if (dwnload) {
    if (year >= "2016") {
      data_sf <- giscoR::gisco_get_lau(
        year = year,
        epsg = epsg,
        cache = cache,
        update_cache = update_cache,
        cache_dir = cache_dir,
        verbose = verbose,
        country = "ES"
      )
    } else {
      data_sf <- giscoR::gisco_get_communes(
        year = year,
        epsg = epsg,
        cache = cache,
        update_cache = update_cache,
        cache_dir = cache_dir,
        verbose = verbose,
        country = "ES",
        spatialtype = "RG"
      )
    }

    # Create dataframe

    df <- data_sf

    # Names management

    if ("LAU_ID" %in% colnames(df)) {
      df$LAU_CODE <- df$LAU_ID
    }

    if ("NSI_CODE" %in% colnames(df)) {
      df$LAU_CODE <- df$NSI_CODE
    }

    if ("LAU_NAME" %in% colnames(df)) {
      df$name <- df$LAU_NAME
    }

    if ("COMM_NAME" %in% colnames(df)) {
      df$name <- df$COMM_NAME
    }

    if ("SABE_NAME" %in% colnames(df)) {
      df$name <- df$SABE_NAME
    }

    df <- df[, c("LAU_CODE", "name")]


    df$LAU_CODE <- gsub("ES", "", df$LAU_CODE)

    df$cpro <- substr(df$LAU_CODE, 1, 2)
    df$cmun <- substr(df$LAU_CODE, 3, 8)

    df <- df[, c("cpro", "cmun", "name", "LAU_CODE")]

    cod <-
      unique(mapSpain::esp_codelist[, c(
        "codauto",
        "ine.ccaa.name",
        "cpro", "ine.prov.name"
      )])

    df2 <- merge(df,
      cod,
      by = "cpro",
      all.x = TRUE,
      no.dups = TRUE
    )


    df2 <-
      df2[, c(
        "codauto",
        "ine.ccaa.name",
        "cpro",
        "ine.prov.name",
        "cmun",
        "name",
        "LAU_CODE"
      )]


    data_sf <- df2
  }

  if (!is.null(munic)) {
    munic <- paste(munic, collapse = "|")
    data_sf <- data_sf[grep(munic, data_sf$name, ignore.case = TRUE), ]
  }



  if (!is.null(region)) {
    tonuts <- esp_hlp_all2prov(region)

    # toprov
    df <- unique(mapSpain::esp_codelist[, c("nuts3.code", "cpro")])
    df <- df[df$nuts3.code %in% tonuts, "cpro"]
    toprov <- unique(df)

    data_sf <- data_sf[data_sf$cpro %in% toprov, ]
  }

  if (nrow(data_sf) == 0) {
    stop(
      "The combination of region and/or munic does ",
      "not return any result"
    )
  }



  # Move CAN

  # Checks

  moving <- FALSE
  moving <- isTRUE(moveCAN) | length(moveCAN) > 1


  if (moving) {
    if (length(grep("05", data_sf$codauto)) > 0) {
      offset <- c(550000, 920000)

      if (length(moveCAN) > 1) {
        coords <- sf::st_point(moveCAN)
        coords <- sf::st_sfc(coords, crs = sf::st_crs(4326))
        coords <- sf::st_transform(coords, 3857)
        coords <- sf::st_coordinates(coords)
        offset <- offset + as.double(coords)
      }

      data_sf <- sf::st_transform(data_sf, 3857)
      penin <- data_sf[-grep("05", data_sf$codauto), ]
      can <- data_sf[grep("05", data_sf$codauto), ]

      # Move CAN
      can <- sf::st_sf(
        sf::st_drop_geometry(can),
        geometry = sf::st_geometry(can) + offset,
        crs = sf::st_crs(can)
      )

      # Regenerate
      if (nrow(penin) > 0) {
        data_sf <- rbind(penin, can)
      } else {
        data_sf <- can
      }
    }
  }

  data_sf <- sf::st_transform(data_sf, as.double(init_epsg))
  data_sf <-
    data_sf[order(data_sf$codauto, data_sf$cpro, data_sf$cmun), ]

  return(data_sf)
}


#' @rdname esp_get_munic
#'
#'
#' @description
#' * [esp_get_munic_siane()] uses CartoBase ANE as source, provided by
#'   Instituto Geografico Nacional (IGN), <http://www.ign.es/web/ign/portal>.
#'   Years available are 2005 up to today.
#'
#' @source
#' IGN data via a custom CDN (see
#' <https://github.com/rOpenSpain/mapSpain/tree/sianedata>).
#'
#' @param resolution Resolution of the polygon. Values available are
#'   `"3"`, `"6.5"` or  `"10"`.
#'
#' @inheritParams esp_get_ccaa_siane
#'
#'
#' @export
esp_get_munic_siane <- function(year = Sys.Date(),
                                epsg = "4258",
                                cache = TRUE,
                                update_cache = FALSE,
                                cache_dir = NULL,
                                verbose = FALSE,
                                resolution = 3,
                                region = NULL,
                                munic = NULL,
                                moveCAN = TRUE,
                                rawcols = FALSE) {
  init_epsg <- as.character(epsg)
  year <- as.character(year)

  if (!init_epsg %in% c("4326", "4258", "3035", "3857")) {
    stop("epsg value not valid. It should be one of 4326, 4258, 3035 or 3857")
  }

  # Get Data from SIANE
  data_sf <- esp_hlp_get_siane(
    "munic",
    resolution,
    cache,
    cache_dir,
    update_cache,
    verbose,
    year
  )

  colnames_init <- colnames(sf::st_drop_geometry(data_sf))
  df <- data_sf

  # Name management
  df$LAU_CODE <- df$id_ine
  df$name <- df$rotulo
  df$cpro <- df$id_prov

  idprov <- sort(unique(mapSpain::esp_codelist$cpro))
  df$cmun <- ifelse(substr(df$LAU_CODE, 1, 2) %in% idprov,
    substr(df$LAU_CODE, 3, 8),
    NA
  )

  cod <-
    unique(mapSpain::esp_codelist[, c(
      "codauto",
      "ine.ccaa.name",
      "cpro", "ine.prov.name"
    )])

  df2 <- merge(df,
    cod,
    by = "cpro",
    all.x = TRUE,
    no.dups = TRUE
  )

  data_sf <- df2

  if (!is.null(munic)) {
    munic <- paste(munic, collapse = "|")
    data_sf <- data_sf[grep(munic, data_sf$name, ignore.case = TRUE), ]
  }

  if (!is.null(region)) {
    tonuts <- esp_hlp_all2prov(region)
    # toprov
    df <- unique(mapSpain::esp_codelist[, c("nuts3.code", "cpro")])
    df <- df[df$nuts3.code %in% tonuts, "cpro"]
    toprov <- unique(df)
    data_sf <- data_sf[data_sf$cpro %in% toprov, ]
  }

  if (nrow(data_sf) == 0) {
    stop(
      "The combination of region and/or munic does ",
      "not return any result"
    )
  }
  # Move CAN

  # Checks
  moving <- FALSE
  moving <- isTRUE(moveCAN) | length(moveCAN) > 1

  if (moving) {
    if (length(grep("05", data_sf$codauto)) > 0) {
      offset <- c(550000, 920000)

      if (length(moveCAN) > 1) {
        coords <- sf::st_point(moveCAN)
        coords <- sf::st_sfc(coords, crs = sf::st_crs(4326))
        coords <- sf::st_transform(coords, 3857)
        coords <- sf::st_coordinates(coords)
        offset <- offset + as.double(coords)
      }

      data_sf <- sf::st_transform(data_sf, 3857)
      penin <- data_sf[-grep("05", data_sf$codauto), ]
      can <- data_sf[grep("05", data_sf$codauto), ]

      # Move CAN
      can <- sf::st_sf(
        sf::st_drop_geometry(can),
        geometry = sf::st_geometry(can) + offset,
        crs = sf::st_crs(can)
      )

      # Regenerate
      if (nrow(penin) > 0) {
        data_sf <- rbind(penin, can)
      } else {
        data_sf <- can
      }
    }
  }

  data_sf <- sf::st_transform(data_sf, as.double(init_epsg))
  data_sf <-
    data_sf[order(data_sf$codauto, data_sf$cpro, data_sf$cmun), ]

  namesend <- unique(c(
    colnames_init,
    c(
      "codauto",
      "ine.ccaa.name",
      "cpro",
      "ine.prov.name",
      "cmun",
      "name",
      "LAU_CODE"
    ),
    colnames(data_sf)
  ))

  data_sf <- data_sf[, namesend]

  if (isFALSE(rawcols)) {
    data_sf <- data_sf[, c(
      "codauto",
      "ine.ccaa.name",
      "cpro",
      "ine.prov.name",
      "cmun",
      "name",
      "LAU_CODE"
    )]
  }
  return(data_sf)
}