R/get_lhz.R

Defines functions get_lhz get_lhz_name download_lhz_shapefiles

Documented in download_lhz_shapefiles get_lhz get_lhz_name

################################################################################
#
#'
#' Download Malawi livelihood zones shapefiles from Humanitarian Data Exchange
#'
#' @param .unzip Logical. Should zip file be unzipped and extracted? Default to
#'   TRUE
#'
#' @return If `.unzip`, list of shapefiles within the downloaded zip file else
#'   path to downloaded zip file. (Invisible) Shapefiles zip file downloaded to
#'   specified folder.
#'
#' @examples
#' download_lhz_shapefiles()
#'
#' @export
#'
#
################################################################################

download_lhz_shapefiles <- function(.unzip = TRUE) {
  base_url <- "https://geonode.wfp.org/geoserver/wfs?"
  format_options <- "format_options=charset:UTF-8"
  typename <- "typename=geonode:mwi_phy_predlhz_geonode_20140612"
  outputFormat <- "outputFormat=SHAPE-ZIP"
  version <- "version=1.0"
  service <- "service=WFS"
  request <- "request=GetFeature"

  .url <- paste0(
    base_url,
    paste(
      format_options,
      typename,
      outputFormat,
      version,
      service,
      request,
      sep = "&"
    )
  )

  ## Perform URL check
  urltest <- RCurl::url.exists(.url)

  if (urltest) {
    zipfile <- tempfile()

    utils::download.file(url = .url, destfile = zipfile, mode = "wb")

    ## Unzip file?
    if (.unzip) {
      shp_files <- utils::unzip(
        zipfile = zipfile, list = TRUE, exdir = tempdir()
      )
      utils::unzip(zipfile = zipfile, exdir = tempdir())
    } else {
      shp_files <- zipfile
    }

    ## Return
    shp_files
  } else {
    warning(
      "The WFP geonode server is currently unavailable. Try again later.",
      call. = TRUE
    )
  }
}


################################################################################
#
#'
#' Get livelihoods zones layer name
#'
#' @param files List of shapefiles within a downloaded zip file
#'
#' @return Layer name for livelihood zones shapefile
#'
#' @examples
#' get_lhz_name()
#'
#' @export
#'
#
################################################################################

get_lhz_name <- function(files = download_lhz_shapefiles()) {
  if (is.data.frame(files)) {
    ## Get layer name
    layer_names <- files[["Name"]] %>%
      stringr::str_split(pattern = "\\.", simplify = TRUE)

    layer_name <- layer_names[[1]]

    ## Return
    layer_name
  } else {
    files
  }
}


################################################################################
#
#'
#' Retrieve Malawi livelihood zones
#'
#' @param layer Name of layer for livelihood zones
#'
#' @return An sf object for the livelihood zones of Malawi
#'
#' @examples
#' get_lhz()
#'
#' @export
#'
#
################################################################################

get_lhz <- function(layer = get_lhz_name()) {
  if (!stringr::str_detect(layer, pattern = "geonode")) {
    ## Read lhz shapefile
    sf::st_read(dsn = tempdir(), layer = layer)
  } else {
    layer
  }
}


#http://shapefiles.fews.net/LHZ/MW_LHZ_2015.zip
spatialworks/malawi documentation built on April 28, 2023, 3:53 p.m.