R/fetch_gadm_sfs.R

In ohvbd: One Health VBD Hub

#' @title Fetch gadm mapping shapefiles
#' @description Retrieve AREAdata gadm mapping shapefiles specified by spatial scale (GID). These vectors are cached as GeoPackage files.
#' @author Francis Windram
#'
#' @param gid the spatial scale to retrieve (0 = country-level, 1=province-level...).
#' @param cache_location path to cache location (defaults to a temporary user directory, or one set by [set_default_ohvbd_cache()]).
#' @param refresh_cache force a refresh of the relevant cached data.
#' @param basereq the url of the AREAdata database (usually generated by [ad_basereq()]). If `NA`, uses the default.
#' @param call The env from which this was called (defaults to the direct calling environment).
#'
#' @return A SpatVector (from [terra::vect()]) of the requested shapefile.
#'
#' @examplesIf interactive()
#' fetch_gadm_sfs(gid=0)
#'
#' @concept areadata
#'
#' @export
#'

fetch_gadm_sfs <- function(
  gid = 0,
  cache_location = NULL,
  refresh_cache = FALSE,
  basereq = ad_basereq(),
  call = rlang::caller_env()
) {

  if (is.null(cache_location)) {
    cache_location <- get_default_ohvbd_cache("gadmcache")
  }

  cachefiles <- c("gadm-countries", "gadm-states", "gadm-counties")
  target_file <- cachefiles[gid + 1]
  # Try to load from adcache
  outshp <- NA

  if (!refresh_cache) {
    outshp <- tryCatch(
      {
        cli::cli_progress_message("{cli::symbol$pointer} Loading gadm cache...")
        terra::vect(file.path(cache_location, paste0(target_file, ".gpkg")))
      },
      error = function(e) {
        cli::cli_alert_warning("Loading cache failed.")
        NA
      }
    )
  }

  if (any(!is.na(outshp))) {
    cli::cli_alert_success("Loaded gadm cache.")
  } else {
    refresh_cache <- TRUE
  }

  if (refresh_cache) {
    cli::cli_progress_message(
      "{cli::symbol$pointer} Caching gadm data in {.path {cache_location}}..."
    )
    final_url <- paste0(basereq, "data/gis/")
    # If not, try to retrieve from AD
    for (ext in c(".shp", ".shx", ".dbf", ".prj")) {
      cli::cli_progress_message(
        "{cli::symbol$pointer} Downloading {.file {paste0(target_file, ext)}}..."
      )
      curl::curl_download(
        paste0(final_url, target_file, ext),
        file.path(cache_location, paste0(target_file, ext)),
        quiet = TRUE
      )
    }
    outshp <- tryCatch(
      {
        cli::cli_progress_message(
          "{cli::symbol$pointer} Loading gadm cached data..."
        )
        terra::vect(file.path(cache_location, paste0(target_file, ".shp")))
      },
      error = function(e) {
        cli::cli_abort(c("x" = "Failed to load shapefile!"), call = call)
      }
    )

    cli::cli_alert_success("Loaded gadm data.")

    cli::cli_progress_message(
      "{cli::symbol$pointer} Caching {.file {paste0(target_file, '.gpkg')}} in {.path {cache_location}}..."
    )

    # Write to cache as GeoPackage (FlatGeobuf/.fgb is also a good alternative)
    terra::writeVector(outshp,
                       file.path(cache_location, paste0(target_file, ".gpkg")),
                       filetype = "GPKG",
                       overwrite = TRUE)
    cli::cli_alert_success("Cached {.file {paste0(target_file, '.gpkg')}} in {.path {cache_location}}.")

    # Remove temp files
    for (ext in c(".shp", ".shx", ".dbf", ".prj")) {
      cli::cli_progress_message(
        "{cli::symbol$pointer} Removing  {.file {paste0(target_file, ext)}}..."
      )
      unlink(file.path(cache_location, paste0(target_file, ext)))
    }
    cli::cli_alert_success("Removed temporary shapefiles.")
  }

  cli::cli_progress_done()
  return(outshp)
}