R/get_boundary.R

Defines functions get_boundary

Documented in get_boundary

#' Fetch boundary data from the geoportal API
#'
#' Gets geoportal boundary data using either: \cr
#'   * a bounding box of coordinates in the form c(xmin,ymin,xmax,ymax) within which to get shapes
#'   * using a point in the form x,y and a radius distance from that point in meters
#'   * using an sf polygon within which to get all intersecting boundaries
#'   * using the exact name of the boundary area
#'   * using a partial name of the bounding area
#'
#'
#' @md
#' @import httr
#' @import sf
#' @import dplyr
#' @import stringr
#' @importFrom geojsonio geojson_json
#' @importFrom jsonlite fromJSON toJSON
#' @importFrom urltools url_encode
#' @export
#'
#' @param boundary_type category of boundary to fetch. Options are: "administrative", "census", "electoral", "eurostat", "health", "other", or "postcodes".
#' @param boundary_name boundary name. If not specified, will return a list of available boundary names for the chosen boundary type.
#' @param bbox if specified will only return results within the specified bounding box. Bounding box should either be in the format 'xmin,ymin,xmax,ymax', or be an object of class 'bbox' as generated by sf::st_bbox().
#' @param radius radius in meters. If specified, will only return results within a given radius of the point. Point must be specified for radius to take effect.
#' @param point a longitude,latitude string in the form 'lng,lat'. Point and radius must be specified together to return boundaries within given radius to the point.
#' @param names_like a vector of names that we want the name column to partially match.
#' @param names_equal a vector of names that we want the name column to exactly match.
#' @param custom_polygon a custom sf polygon. The function will return all boundaries that intersect the custom polygon.
#' @return a data.frame of the full player data and history.
#'
#' @examples
#' # get available boundary names for the type 'census'
#' census_options <- get_boundary('census')
#'
#' # get all MSOA boundaries where the msoa name contains 'Dartford' or 'Gravesham':
#' msoa_boundaries_like <- get_boundary('census','Middle_Super_Output_Areas_December_2011_Boundaries',
#'  names_like=c('Dartford','Gravesham'))
#'
#'# get all local authority boundaries where the name is either 'Tower Hamlets' or 'Southwark'
#' la_boundaries_exact <- get_boundary('admin','Local_Authority_Districts_April_2019_Boundaries_UK_BGC',
#'  names_equal=c('Tower Hamlets','Southwark'))
#'
#'# get all wards  within a specified bounding box
#' la_bbox <- sf::st_bbox(la_boundaries_exact)
#' ward_boundaries_bbox <- get_boundary('administrative','Wards_May_2019_Boundaries_UK_BGC', bbox=la_bbox)
#'
#'
#'# get all LSOA boundaries within a 1km radius of a given point
#' point <- '-0.1577,51.507'
#' lsoa_boundaries_radius <- get_boundary('census','Lower_Super_Output_Areas_December_2011_Boundaries',
#'  point=point, radius=1000)

get_boundary <- function(boundary_type = c('administrative', 'census', 'electoral',
                                           'eurostat', 'health', 'other', 'postcodes'),
                         boundary_name = NA,
                         bbox = NA,
                         radius = NA,
                         point = NA,
                         names_like = NA,
                         names_equal = NA,
                         custom_polygon = NA,
                         verbose=FALSE) {

  boundary_type <- match.arg(boundary_type)

  my_boundary <- switch(boundary_type,
         'administrative' = "Administrative_Boundaries",
         'census' =  "Census_Boundaries",
         'electoral' = "Electoral_Boundaries",
         'eurostat' = "Eurostat_Boundaries",
         'health' = "Health_Boundaries",
         'other' = "Other_Boundaries",
         'postcodes' = "Postcodes"
         )


  if(is.na(boundary_name)){
    top_level <- httr::GET(paste0('https://ons-inspire.esriuk.com/arcgis/rest/services/',my_boundary,'?f=pjson'))
    boundary_options <- httr::content(top_level, type='application/json', simplifyVector=TRUE)
    boundary_names <- boundary_options$services
    boundary_names <- boundary_names[boundary_names$type == 'MapServer','name',FALSE]

    boundary_names$name <- stringr::str_extract(boundary_names$name, '(?<=\\/)(.+)')
    return(boundary_names)

  } else if(!is.na(bbox)){
    # bbox query
    if('bbox' %in% class(bbox)){
      bbox <- paste0(round(bbox,6), collapse=',')
    } else {
      bbox <- stringr::str_trim(stringr::str_replace_all(bbox,' ',''))
    }
    # make query using bbox
    mapserver <- paste0(my_boundary,'/',boundary_name)
    path <- paste0('https://ons-inspire.esriuk.com/arcgis/rest/services/',mapserver,'/MapServer/0/query?where=1%3D1&outFields=*&geometry=',bbox,'&geometryType=esriGeometryEnvelope&inSR=4326&spatialRel=esriSpatialRelIntersects&outSR=4326&f=json')
    if(verbose) message(path)
    shape <- httr::GET(path)
    res <- sf::read_sf(httr::content(shape, type='text', encoding='UTF-8'))
    return(res)
  } else if(!all(is.na(names_like))){
    # name search query
    ## first get field names
    feature <- paste0(my_boundary,'/',boundary_name)
    my_field_req <- httr::GET(paste0('https://ons-inspire.esriuk.com/arcgis/rest/services/',feature,'/FeatureServer/0?f=pjson'))
    my_field_res <- httr::content(my_field_req,type='application/json', simplifyVector=TRUE )
    my_fields <- my_field_res$fields
    name_field <- grep('nm',my_fields$name, value = TRUE)[1]
    if(length(name_field) == 0 ) stop('could not find name field')
    #make request
    where_query <- paste0(name_field,"%20like%20","%27%25",urltools::url_encode(names_like),"%25%27",collapse="%20OR%20")
    path <- paste0("https://ons-inspire.esriuk.com/arcgis/rest/services/",feature,"/MapServer/0/query?where=",where_query,"&outFields=*&outSR=4326&f=geojson")
    if(verbose) message(path)
    shape <- httr::GET(path)
    res <- sf::read_sf(httr::content(shape,type='text',encoding='UTF-8'))

    return(res)


  }else if(!all(is.na(names_equal))){
    # name query
    ## first get field names
    feature <- paste0(my_boundary,'/',boundary_name)
    my_field_req <- httr::GET(paste0('https://ons-inspire.esriuk.com/arcgis/rest/services/',feature,'/FeatureServer/0?f=pjson'))
    my_field_res <- httr::content(my_field_req,type='application/json', simplifyVector=TRUE )
    my_fields <- my_field_res$fields
    name_field <- grep('nm',my_fields$name, value = TRUE)[1]
    if(length(name_field) == 0 ) stop('could not find name field')
    #make request
    names_equal <-  paste0("'",names_equal,"'")
    names_equal <- paste0(names_equal, collapse=',')
    where_query <- urltools::url_encode(paste0(name_field," IN ","(",names_equal,")"))
    path <- paste0("https://ons-inspire.esriuk.com/arcgis/rest/services/",feature,"/MapServer/0/query?where=",where_query,"&outFields=*&outSR=4326&f=geojson")
    if(verbose) message(path)
    shape <- httr::GET(path)
    res <- sf::read_sf(httr::content(shape,type='text',encoding='UTF-8'))

    return(res)
  } else if(!is.na(radius)){
    # radius query
    if(is.na(point)) stop('point must be specified if radius is set.')
    feature <- paste0(my_boundary,'/',boundary_name)
    point<-urltools::url_encode(point)
    # make request
    path <- paste0("https://ons-inspire.esriuk.com/arcgis/rest/services/",feature,"/MapServer/0/query?where=1%3D1&outfields=*&geometry=",
                   point,"&geometryType=esriGeometryPoint&distance=",radius,"&units=esriSRUnit_Meter","&inSR=4326&spatialRel=esriSpatialRelIntersects&outSR=4326&f=json")
    if(verbose) message(path)
    shape <- httr::GET(path)
    res <- sf::read_sf(httr::content(shape,type='text',encoding='UTF-8'))

    return(res)
  } else if(all(!is.na(custom_polygon))){

    feature <- paste0(my_boundary,'/',boundary_name)

    my_polygon_cast <- custom_polygon %>%
      st_union()  %>%
      st_cast('POLYGON')
    if(length(my_polygon_cast)>1)  warning(paste0('entered polygon has more than one part, only using first part.'))
    my_polygon <- my_polygon_cast[1] %>%
      geojsonio::geojson_json()

    my_coords <- jsonlite::fromJSON(my_polygon)['coordinates']$coordinates
    my_geom <- jsonlite::toJSON(list(rings = my_coords,
                                     spatialReference = list("wkid" = 4326)),
                                auto_unbox = TRUE)

    req <- httr::POST(url = paste0('https://ons-inspire.esriuk.com/arcgis/rest/services/',feature,"/MapServer/0/query"),
               body = list(where= "1=1",
                           outfields="*",
                           geometry = my_geom,
                           geometryType='esriGeometryPolygon',
                           inSR = '4326',
                           spatialRel ='esriSpatialRelIntersects',
                           outSR = '4326',
                           f='json'),
               encode='form')

    res <- sf::read_sf(httr::content(req,type='text',encoding='UTF-8'))
    res
  } else {

    feature <- paste0(my_boundary,'/',boundary_name)
    #make request
    path <- paste0("https://ons-inspire.esriuk.com/arcgis/rest/services/",feature,"/MapServer/0/query?where=1%3d1&outFields=*&outSR=4326&f=geojson")
    if(verbose) message(path)
    shape <- httr::GET(path)
    res <- sf::read_sf(httr::content(shape,type='text',encoding='UTF-8'))

    return(res)


  }



}
Chrisjb/rgeoportal documentation built on Sept. 29, 2020, 12:46 a.m.