Nothing
#' Get spatial objects through reverse geocoding
#'
#' @description
#' This function allows you extract the spatial object located on a known pair
#' of coordinates (lat, long). Latitudes must be between -90 and 90 and
#' longitudes must be between -180 and 180.
#'
#'
#' @inheritParams reverse_geo_lite
#' @inheritParams geo_lite_sf
#'
#' @details
#' See <https://nominatim.org/release-docs/develop/api/Reverse/> for additional
#' parameters to be passed to `custom_query`.
#'
#' Use the option `custom_query = list(zoom = 3)` to adjust the output. Some
#' equivalences on terms of zoom:
#'
#'
#' ```{r, echo=FALSE}
#'
#' t <- tibble::tribble(
#' ~zoom, ~address_detail,
#' 3, "country",
#' 5, "state",
#' 8, "county",
#' 10, "city",
#' 14, "suburb",
#' 16, "major streets",
#' 17, "major and minor streets",
#' 18, "building"
#' )
#'
#' knitr::kable(t)
#'
#'
#' ```
#'
#' @return A `sf` object with the results.
#'
#' @examplesIf nominatim_check_access()
#' \donttest{
#' library(ggplot2)
#'
#'
#' Coliseum <- geo_lite("Coliseo, Rome, Italy")
#'
#' # Coliseum
#' Col_sf <- reverse_geo_lite_sf(
#' lat = Coliseum$lat,
#' lon = Coliseum$lon,
#' points_only = FALSE
#' )
#'
#' ggplot(Col_sf) +
#' geom_sf()
#'
#' # City of Rome - Zoom 10
#'
#' Rome_sf <- reverse_geo_lite_sf(
#' lat = Coliseum$lat,
#' lon = Coliseum$lon,
#' custom_query = list(zoom = 10),
#' points_only = FALSE
#' )
#'
#' ggplot(Rome_sf) +
#' geom_sf()
#'
#' # County - Zoom 8
#'
#' County_sf <- reverse_geo_lite_sf(
#' lat = Coliseum$lat,
#' lon = Coliseum$lon,
#' custom_query = list(zoom = 8),
#' points_only = FALSE
#' )
#'
#' ggplot(County_sf) +
#' geom_sf()
#' }
#' @export
#'
#' @seealso [reverse_geo_lite()]
#' @family spatial
reverse_geo_lite_sf <- function(lat,
long,
address = "address",
full_results = FALSE,
return_coords = TRUE,
verbose = FALSE,
custom_query = list(),
points_only = TRUE) {
# Check inputs
if (!is.numeric(lat) || !is.numeric(long)) {
stop("lat and long must be numeric")
}
if (length(lat) != length(long)) {
stop("lat and long should have the same number of elements")
}
# Lat
lat_cap <- pmin(lat, 90)
lat_cap <- pmax(lat_cap, -90)
if (!all(lat_cap == lat)) {
message("latitudes have been restricted to [-90, 90]")
}
# Lon
long_cap <- pmin(long, 180)
long_cap <- pmax(long_cap, -180)
if (!all(long_cap == long)) {
message("longitudes have been restricted to [-180, 180]")
}
# Loop
all_res <- NULL
for (i in seq_len(length(long_cap))) {
res_single <- reverse_geo_lite_sf_single(
lat_cap[i],
long_cap[i],
address,
full_results,
return_coords,
verbose,
custom_query,
points_only
)
all_res <- dplyr::bind_rows(all_res, res_single)
}
return(all_res)
}
#' @noRd
#' @inheritParams reverse_geo_lite_sf
reverse_geo_lite_sf_single <- function(lat_cap,
long_cap,
address = "address",
full_results = TRUE,
return_coords = TRUE,
verbose = TRUE,
custom_query = list(),
points_only = FALSE) {
api <- "https://nominatim.openstreetmap.org/reverse?"
url <- paste0(
api, "lat=",
lat_cap,
"&lon=",
long_cap,
"&format=geojson"
)
if (!isTRUE(points_only)) {
url <- paste0(url, "&polygon_geojson=1")
}
if (isFALSE(full_results)) {
url <- paste0(url, "&addressdetails=0")
}
if (length(custom_query) > 0) {
opts <- NULL
for (i in seq_len(length(custom_query))) {
nlist <- names(custom_query)[i]
val <- paste0(custom_query[[i]], collapse = ",")
opts <- paste0(opts, "&", nlist, "=", val)
}
url <- paste0(url, opts)
}
# Download
json <- tempfile(fileext = ".geojson")
res <- api_call(url, json, quiet = isFALSE(verbose))
# nocov start
if (isFALSE(res)) {
message(url, " not reachable.")
result_out <- tibble::tibble(ad = NA)
names(result_out) <- address
coords <- data.frame(lat = lat_cap, lon = long_cap)
geometry <- sf::st_as_sf(coords, coords = c("lon", "lat"), crs = 4326)
geometry <- sf::st_geometry(geometry)
if (return_coords) {
result_out <- dplyr::bind_cols(result_out, coords)
}
result_out <- sf::st_sf(result_out, geometry)
return(invisible(result_out))
}
# nocov end
sfobj <- tryCatch(
sf::st_read(
json,
stringsAsFactors = FALSE,
quiet = isFALSE(verbose)
),
error = function(e) {
return(FALSE)
},
# nocov start
warning = function(e) {
return(FALSE)
}
# nocov end
)
# Handle errors
if (!"sf" %in% class(sfobj)) {
message(
"No results for query lon=",
long_cap,
", lat=",
lat_cap
)
result_out <- tibble::tibble(ad = NA)
names(result_out) <- address
coords <- data.frame(lat = lat_cap, lon = long_cap)
geometry <- sf::st_as_sf(coords, coords = c("lon", "lat"), crs = 4326)
geometry <- sf::st_geometry(geometry)
if (return_coords) {
result_out <- dplyr::bind_cols(result_out, coords)
}
result_out <- sf::st_sf(result_out, geometry)
return(invisible(result_out))
}
# Prepare output
df_sf <- tibble::as_tibble(sf::st_drop_geometry(sfobj))
# Rename original address
names(df_sf) <-
gsub(
paste0("^", address, "$"),
paste0("osm.", address),
names(df_sf)
)
nmes <- names(df_sf)
nmes[nmes == "display_name"] <- address
names(df_sf) <- nmes
df_sf$lat <- as.double(lat_cap)
df_sf$lon <- as.double(long_cap)
# Prepare output
result_out <- df_sf[address]
if (return_coords || full_results) {
disp_coords <- df_sf[c("lat", "lon")]
result_out <- cbind(result_out, disp_coords)
}
# If full
if (full_results) {
rest_cols <- df_sf[, !names(df_sf) %in% c(address, "lon", "lat")]
result_out <- cbind(result_out, rest_cols)
}
result_out <-
sf::st_sf(result_out, geometry = sf::st_geometry(sfobj))
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.