R/get_boundary.R
In Chrisjb/rgeoportal: Fetch UK Boundary Files
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.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
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)
}
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.